summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarcin Borkowski <mbork@mbork.pl>2017-12-07 14:24:57 +0100
committerMarcin Borkowski <mbork@mbork.pl>2017-12-07 14:24:57 +0100
commit0e3c10ce34c84d24013a84a725c6275ad87b1530 (patch)
treec37c89b1087a00e4d4799e6f4123c48ffca30270
parentab5fc7c8215e1066449da4eb0e027f8250cc9f49 (diff)
parentd4db37b283daffa0f8c942a5b526b6444edc34c5 (diff)
downloademacs-0e3c10ce34c84d24013a84a725c6275ad87b1530.tar.gz
Merge branch 'master' into fix/bug-20871
-rw-r--r--.clang-format27
-rw-r--r--.dir-locals.el4
-rw-r--r--.gitattributes2
-rw-r--r--.gitignore4
-rw-r--r--.gitlab-ci.yml8
-rw-r--r--BUGS4
-rw-r--r--CONTRIBUTE207
-rw-r--r--COPYING8
-rw-r--r--ChangeLog.188
-rw-r--r--ChangeLog.2298
-rw-r--r--ChangeLog.329666
-rw-r--r--GNUmakefile9
-rw-r--r--INSTALL43
-rw-r--r--INSTALL.REPO6
-rw-r--r--Makefile.in17
-rw-r--r--README11
-rw-r--r--admin/CPP-DEFINES3
-rw-r--r--admin/ChangeLog.14
-rw-r--r--admin/MAINTAINERS1
-rw-r--r--admin/README2
-rw-r--r--admin/admin.el24
-rw-r--r--admin/alloc-colors.c2
-rw-r--r--admin/authors.el37
-rwxr-xr-xadmin/build-configs3
-rw-r--r--admin/bzrmerge.el2
-rw-r--r--admin/charsets/Makefile.in2
-rw-r--r--admin/charsets/big5.awk4
-rw-r--r--admin/charsets/compact.awk2
-rw-r--r--admin/charsets/cp51932.awk2
-rw-r--r--admin/charsets/cp932.awk3
-rw-r--r--admin/charsets/eucjp-ms.awk2
-rw-r--r--admin/charsets/gb180302.awk2
-rw-r--r--admin/charsets/gb180304.awk2
-rwxr-xr-xadmin/charsets/mapconv2
-rw-r--r--admin/charsets/mapfiles/README2
-rw-r--r--admin/charsets/mule-charsets.el3
-rw-r--r--admin/cus-test.el2
-rwxr-xr-xadmin/diff-tar-files2
-rw-r--r--admin/find-gc.el2
-rw-r--r--admin/gitmerge.el84
-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.by4
-rw-r--r--admin/grammars/python.wy2
-rw-r--r--admin/grammars/scheme.by3
-rw-r--r--admin/grammars/srecode-template.wy2
-rw-r--r--admin/last-chance.el2
-rwxr-xr-xadmin/make-emacs2
-rw-r--r--admin/make-tarball.txt29
-rwxr-xr-xadmin/merge-gnulib18
-rwxr-xr-xadmin/merge-pkg-config2
-rw-r--r--admin/notes/bugtracker43
-rw-r--r--admin/notes/copyright24
-rw-r--r--admin/notes/documentation12
-rw-r--r--admin/notes/elpa2
-rw-r--r--admin/notes/font-backend2
-rw-r--r--admin/notes/git-workflow26
-rw-r--r--admin/notes/hydra27
-rw-r--r--admin/notes/multi-tty2
-rw-r--r--admin/notes/repo4
-rw-r--r--admin/notes/spelling11
-rw-r--r--admin/notes/tags2
-rw-r--r--admin/notes/unicode5
-rw-r--r--admin/notes/versioning3
-rw-r--r--admin/notes/www2
-rw-r--r--admin/notes/years2
-rw-r--r--admin/nt/README-UNDUMP.W324
-rw-r--r--admin/nt/README-ftp-server8
-rw-r--r--admin/nt/dist-build/README-scripts92
-rw-r--r--admin/nt/dist-build/README-windows-binaries45
-rwxr-xr-xadmin/nt/dist-build/build-dep-zips.py232
-rwxr-xr-xadmin/nt/dist-build/build-zips.sh210
-rw-r--r--admin/nt/dist-build/emacs.nsi88
-rwxr-xr-xadmin/quick-install-emacs7
-rw-r--r--admin/release-process4
-rw-r--r--admin/unidata/BidiBrackets.txt8
-rw-r--r--admin/unidata/BidiMirroring.txt24
-rw-r--r--admin/unidata/Blocks.txt17
-rw-r--r--admin/unidata/IVD_Sequences.txt34
-rw-r--r--admin/unidata/Makefile.in3
-rw-r--r--admin/unidata/NormalizationTest.txt30
-rw-r--r--admin/unidata/README18
-rw-r--r--admin/unidata/SpecialCasing.txt8
-rw-r--r--admin/unidata/UnicodeData.txt1028
-rwxr-xr-xadmin/unidata/blocks.awk4
-rw-r--r--admin/unidata/unidata-gen.el96
-rw-r--r--admin/unidata/uvs.el2
-rwxr-xr-xadmin/update-copyright2
-rwxr-xr-xadmin/update_autogen2
-rwxr-xr-xautogen.sh72
-rwxr-xr-xbuild-aux/config.guess84
-rwxr-xr-xbuild-aux/config.sub46
-rwxr-xr-xbuild-aux/git-hooks/commit-msg27
-rwxr-xr-xbuild-aux/git-hooks/pre-commit4
-rwxr-xr-xbuild-aux/gitlog-to-changelog6
-rwxr-xr-xbuild-aux/gitlog-to-emacslog6
-rwxr-xr-xbuild-aux/install-sh20
-rwxr-xr-xbuild-aux/make-info-dir2
-rwxr-xr-xbuild-aux/move-if-change6
-rwxr-xr-xbuild-aux/msys-to-w322
-rwxr-xr-xbuild-aux/update-copyright4
-rwxr-xr-xbuild-aux/update-subdirs2
-rw-r--r--config.bat26
-rw-r--r--configure.ac435
-rw-r--r--doc/emacs/ChangeLog.14
-rw-r--r--doc/emacs/Makefile.in4
-rw-r--r--doc/emacs/abbrevs.texi4
-rw-r--r--doc/emacs/ack.texi6
-rw-r--r--doc/emacs/anti.texi322
-rw-r--r--doc/emacs/basic.texi3
-rw-r--r--doc/emacs/buffers.texi32
-rw-r--r--doc/emacs/building.texi6
-rw-r--r--doc/emacs/cmdargs.texi20
-rw-r--r--doc/emacs/custom.texi10
-rw-r--r--doc/emacs/dired.texi73
-rw-r--r--doc/emacs/display.texi103
-rw-r--r--doc/emacs/doclicense.texi4
-rw-r--r--doc/emacs/emacs.texi33
-rw-r--r--doc/emacs/files.texi148
-rw-r--r--doc/emacs/fixit.texi15
-rw-r--r--doc/emacs/frames.texi30
-rw-r--r--doc/emacs/glossary.texi14
-rw-r--r--doc/emacs/gnu.texi8
-rw-r--r--doc/emacs/gpl.texi8
-rw-r--r--doc/emacs/help.texi18
-rw-r--r--doc/emacs/killing.texi4
-rw-r--r--doc/emacs/macos.texi2
-rw-r--r--doc/emacs/maintaining.texi56
-rw-r--r--doc/emacs/mark.texi4
-rw-r--r--doc/emacs/mini.texi24
-rw-r--r--doc/emacs/misc.texi13
-rw-r--r--doc/emacs/modes.texi8
-rw-r--r--doc/emacs/msdos-xtra.texi2
-rw-r--r--doc/emacs/msdos.texi2
-rw-r--r--doc/emacs/mule.texi67
-rw-r--r--doc/emacs/package.texi2
-rw-r--r--doc/emacs/programs.texi25
-rw-r--r--doc/emacs/regs.texi5
-rw-r--r--doc/emacs/rmail.texi4
-rw-r--r--doc/emacs/search.texi50
-rw-r--r--doc/emacs/text.texi43
-rw-r--r--doc/emacs/trouble.texi42
-rw-r--r--doc/emacs/vc1-xtra.texi26
-rw-r--r--doc/emacs/xresources.texi5
-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/doclicense.texi4
-rw-r--r--doc/lispintro/drawers.eps20
-rw-r--r--doc/lispintro/emacs-lisp-intro.texi18
-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.112
-rw-r--r--doc/lispref/Makefile.in2
-rw-r--r--doc/lispref/README4
-rw-r--r--doc/lispref/anti.texi188
-rw-r--r--doc/lispref/backups.texi4
-rw-r--r--doc/lispref/buffers.texi15
-rw-r--r--doc/lispref/commands.texi12
-rw-r--r--doc/lispref/compile.texi10
-rw-r--r--doc/lispref/control.texi11
-rw-r--r--doc/lispref/customize.texi2
-rw-r--r--doc/lispref/debugging.texi2
-rw-r--r--doc/lispref/display.texi217
-rw-r--r--doc/lispref/doclicense.texi4
-rw-r--r--doc/lispref/edebug.texi66
-rw-r--r--doc/lispref/elisp.texi9
-rw-r--r--doc/lispref/errors.texi7
-rw-r--r--doc/lispref/eval.texi125
-rw-r--r--doc/lispref/files.texi314
-rw-r--r--doc/lispref/frames.texi624
-rw-r--r--doc/lispref/functions.texi45
-rw-r--r--doc/lispref/gpl.texi8
-rw-r--r--doc/lispref/help.texi80
-rw-r--r--doc/lispref/hooks.texi5
-rw-r--r--doc/lispref/internals.texi4
-rw-r--r--doc/lispref/lists.texi42
-rw-r--r--doc/lispref/loading.texi49
-rw-r--r--doc/lispref/minibuf.texi95
-rw-r--r--doc/lispref/modes.texi13
-rw-r--r--doc/lispref/nonascii.texi2
-rw-r--r--doc/lispref/numbers.texi18
-rw-r--r--doc/lispref/objects.texi68
-rw-r--r--doc/lispref/os.texi47
-rw-r--r--doc/lispref/package.texi2
-rw-r--r--doc/lispref/positions.texi11
-rw-r--r--doc/lispref/processes.texi18
-rw-r--r--doc/lispref/searching.texi6
-rw-r--r--doc/lispref/sequences.texi7
-rw-r--r--doc/lispref/strings.texi33
-rw-r--r--doc/lispref/symbols.texi6
-rw-r--r--doc/lispref/syntax.texi13
-rw-r--r--doc/lispref/text.texi278
-rw-r--r--doc/lispref/tips.texi31
-rw-r--r--doc/lispref/two-volume-cross-refs.txt2
-rw-r--r--doc/lispref/two-volume.make2
-rw-r--r--doc/lispref/variables.texi42
-rw-r--r--doc/lispref/windows.texi178
-rw-r--r--doc/man/ChangeLog.12
-rw-r--r--doc/man/emacs.1.in6
-rw-r--r--doc/man/emacsclient.16
-rw-r--r--doc/misc/ChangeLog.12
-rw-r--r--doc/misc/Makefile.in2
-rw-r--r--doc/misc/autotype.texi2
-rw-r--r--doc/misc/calc.texi2
-rw-r--r--doc/misc/cc-mode.texi17
-rw-r--r--doc/misc/cl.texi8
-rw-r--r--doc/misc/doclicense.texi4
-rw-r--r--doc/misc/ebrowse.texi2
-rw-r--r--doc/misc/ede.texi6
-rw-r--r--doc/misc/efaq-w32.texi28
-rw-r--r--doc/misc/efaq.texi71
-rw-r--r--doc/misc/emacs-gnutls.texi8
-rw-r--r--doc/misc/emacs-mime.texi2
-rw-r--r--doc/misc/erc.texi4
-rw-r--r--doc/misc/ert.texi127
-rw-r--r--doc/misc/eshell.texi35
-rw-r--r--doc/misc/flymake.texi1132
-rw-r--r--doc/misc/gnus-faq.texi8
-rw-r--r--doc/misc/gnus-news.el4
-rw-r--r--doc/misc/gnus-news.texi6
-rw-r--r--doc/misc/gnus.texi29
-rw-r--r--doc/misc/gpl.texi8
-rw-r--r--doc/misc/htmlfontify.texi7
-rw-r--r--doc/misc/message.texi2
-rw-r--r--doc/misc/mh-e.texi38
-rw-r--r--doc/misc/newsticker.texi14
-rw-r--r--doc/misc/org.texi10524
-rw-r--r--doc/misc/pcl-cvs.texi2
-rw-r--r--doc/misc/reftex.texi4
-rw-r--r--doc/misc/sem-user.texi2
-rw-r--r--doc/misc/ses.texi31
-rw-r--r--doc/misc/smtpmail.texi4
-rw-r--r--doc/misc/srecode.texi2
-rw-r--r--doc/misc/texinfo.tex97
-rw-r--r--doc/misc/tramp.texi426
-rw-r--r--doc/misc/trampver.texi2
-rw-r--r--doc/misc/url.texi6
-rw-r--r--doc/misc/woman.texi6
-rw-r--r--etc/CALC-NEWS2
-rw-r--r--etc/CENSORSHIP2
-rw-r--r--etc/COPYING8
-rw-r--r--etc/ChangeLog.18
-rw-r--r--etc/DEBUG13
-rw-r--r--etc/DISTRIB8
-rw-r--r--etc/ERC-NEWS6
-rw-r--r--etc/ETAGS.EBNF2
-rw-r--r--etc/ETAGS.README2
-rw-r--r--etc/FTP4
-rw-r--r--etc/GNUS-NEWS4
-rw-r--r--etc/HELLO2
-rw-r--r--etc/HISTORY6
-rw-r--r--etc/LINUX-GNU2
-rw-r--r--etc/MACHINES4
-rw-r--r--etc/MH-E-NEWS6
-rw-r--r--etc/NEWS1364
-rw-r--r--etc/NEWS.1-172
-rw-r--r--etc/NEWS.184
-rw-r--r--etc/NEWS.194
-rw-r--r--etc/NEWS.202
-rw-r--r--etc/NEWS.214
-rw-r--r--etc/NEWS.222
-rw-r--r--etc/NEWS.232
-rw-r--r--etc/NEWS.244
-rw-r--r--etc/NEWS.2532
-rw-r--r--etc/NEWS.262046
-rw-r--r--etc/NEXTSTEP2
-rw-r--r--etc/NXML-NEWS2
-rw-r--r--etc/ORG-NEWS1886
-rw-r--r--etc/PROBLEMS114
-rw-r--r--etc/TERMS2
-rw-r--r--etc/THE-GNU-PROJECT2
-rw-r--r--etc/TODO64
-rw-r--r--etc/WHY-FREE2
-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.xml4
-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.txt2
-rw-r--r--etc/images/checked.xpm2
-rw-r--r--etc/images/gnus/gnus.svg6
-rw-r--r--etc/images/icons/hicolor/scalable/apps/emacs.icobin0 -> 85182 bytes
-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/splash.bmpbin0 -> 154542 bytes
-rw-r--r--etc/images/splash.svg4
-rw-r--r--etc/images/unchecked.xpm2
-rw-r--r--etc/org/OrgOdtStyles.xml20
-rw-r--r--etc/org/README2
-rw-r--r--etc/ps-prin0.ps2
-rw-r--r--etc/ps-prin1.ps2
-rw-r--r--etc/refcards/Makefile2
-rw-r--r--etc/refcards/README6
-rw-r--r--etc/refcards/calccard.tex5
-rw-r--r--etc/refcards/cs-dired-ref.tex4
-rw-r--r--etc/refcards/cs-refcard.tex4
-rw-r--r--etc/refcards/cs-survival.tex4
-rw-r--r--etc/refcards/de-refcard.tex5
-rw-r--r--etc/refcards/dired-ref.tex7
-rw-r--r--etc/refcards/fr-dired-ref.tex4
-rw-r--r--etc/refcards/fr-refcard.tex4
-rw-r--r--etc/refcards/fr-survival.tex4
-rw-r--r--etc/refcards/gnus-logo.eps2
-rw-r--r--etc/refcards/gnus-refcard.tex2
-rw-r--r--etc/refcards/orgcard.tex26
-rw-r--r--etc/refcards/pdflayout.sty2
-rw-r--r--etc/refcards/pl-refcard.tex5
-rw-r--r--etc/refcards/pt-br-refcard.tex4
-rw-r--r--etc/refcards/refcard.tex5
-rw-r--r--etc/refcards/ru-refcard.tex6
-rw-r--r--etc/refcards/sk-dired-ref.tex4
-rw-r--r--etc/refcards/sk-refcard.tex4
-rw-r--r--etc/refcards/sk-survival.tex4
-rw-r--r--etc/refcards/survival.tex5
-rw-r--r--etc/refcards/vipcard.tex5
-rw-r--r--etc/refcards/viperCard.tex5
-rw-r--r--etc/schema/locate.rnc6
-rw-r--r--etc/schema/od-manifest-schema-v1.2-os.rnc88
-rw-r--r--etc/schema/od-schema-v1.2-os.rnc6280
-rw-r--r--etc/schema/relaxng.rnc8
-rw-r--r--etc/schema/schemas.xml8
-rw-r--r--etc/ses-example.ses2
-rw-r--r--etc/srecode/c.srt4
-rw-r--r--etc/srecode/cpp.srt6
-rw-r--r--etc/srecode/default.srt4
-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.srt4
-rw-r--r--etc/srecode/getset-cpp.srt3
-rw-r--r--etc/srecode/java.srt6
-rw-r--r--etc/srecode/make.srt2
-rw-r--r--etc/srecode/template.srt2
-rw-r--r--etc/srecode/test.srt4
-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.el13
-rw-r--r--etc/themes/light-blue-theme.el2
-rw-r--r--etc/themes/manoj-dark-theme.el12
-rw-r--r--etc/themes/misterioso-theme.el2
-rw-r--r--etc/themes/tango-dark-theme.el12
-rw-r--r--etc/themes/tango-theme.el12
-rw-r--r--etc/themes/tsdh-dark-theme.el12
-rw-r--r--etc/themes/tsdh-light-theme.el13
-rw-r--r--etc/themes/wheatgrass-theme.el15
-rw-r--r--etc/themes/whiteboard-theme.el12
-rw-r--r--etc/themes/wombat-theme.el2
-rw-r--r--etc/tutorials/TUTORIAL18
-rw-r--r--etc/tutorials/TUTORIAL.bg2
-rw-r--r--etc/tutorials/TUTORIAL.cn4
-rw-r--r--etc/tutorials/TUTORIAL.he14
-rw-r--r--etc/tutorials/TUTORIAL.nl2
-rw-r--r--etc/tutorials/TUTORIAL.sl2
-rw-r--r--etc/tutorials/TUTORIAL.sv18
-rw-r--r--etc/tutorials/TUTORIAL.zh4
-rw-r--r--leim/COPYING8
-rw-r--r--leim/ChangeLog.14
-rw-r--r--leim/Makefile.in2
-rw-r--r--leim/README2
-rw-r--r--leim/leim-ext.el2
-rw-r--r--lib-src/COPYING8
-rw-r--r--lib-src/ChangeLog.124
-rw-r--r--lib-src/Makefile.in2
-rw-r--r--lib-src/ebrowse.c10
-rw-r--r--lib-src/emacsclient.c89
-rw-r--r--lib-src/etags.c85
-rw-r--r--lib-src/hexl.c4
-rw-r--r--lib-src/make-docfile.c23
-rw-r--r--lib-src/movemail.c6
-rw-r--r--lib-src/ntlib.c71
-rw-r--r--lib-src/ntlib.h6
-rw-r--r--lib-src/pop.c2
-rw-r--r--lib-src/pop.h2
-rw-r--r--lib-src/profile.c4
-rwxr-xr-xlib-src/rcs2log4
-rw-r--r--lib-src/update-game-score.c5
-rw-r--r--lib/COPYING8
-rw-r--r--lib/Makefile.in2
-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.h4
-rw-r--r--lib/arg-nonnull.h2
-rw-r--r--lib/at-func.c2
-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.h6
-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/careadlinkat.c2
-rw-r--r--lib/careadlinkat.h2
-rw-r--r--lib/cloexec.c83
-rw-r--r--lib/cloexec.h38
-rw-r--r--lib/close-stream.c2
-rw-r--r--lib/count-leading-zeros.h5
-rw-r--r--lib/count-one-bits.h2
-rw-r--r--lib/count-trailing-zeros.h5
-rw-r--r--lib/diffseq.h10
-rw-r--r--lib/dirent.in.h2
-rw-r--r--lib/dirfd.c2
-rw-r--r--lib/dosname.h2
-rw-r--r--lib/dtotimespec.c2
-rw-r--r--lib/dup2.c4
-rw-r--r--lib/errno.in.h2
-rw-r--r--lib/euidaccess.c2
-rw-r--r--lib/execinfo.in.h2
-rw-r--r--lib/explicit_bzero.c48
-rw-r--r--lib/faccessat.c62
-rw-r--r--lib/fcntl.c2
-rw-r--r--lib/fcntl.in.h7
-rw-r--r--lib/fdatasync.c2
-rw-r--r--lib/fdopendir.c2
-rw-r--r--lib/filemode.c2
-rw-r--r--lib/filemode.h2
-rw-r--r--lib/filevercmp.c4
-rw-r--r--lib/filevercmp.h2
-rw-r--r--lib/flexmember.h21
-rw-r--r--lib/fpending.c6
-rw-r--r--lib/fpending.h2
-rw-r--r--lib/fstatat.c18
-rw-r--r--lib/fsusage.c287
-rw-r--r--lib/fsusage.h40
-rw-r--r--lib/fsync.c6
-rw-r--r--lib/ftoastr.c4
-rw-r--r--lib/ftoastr.h4
-rw-r--r--lib/get-permissions.c2
-rw-r--r--lib/getdtablesize.c4
-rw-r--r--lib/getgroups.c2
-rw-r--r--lib/getloadavg.c2
-rw-r--r--lib/getopt-cdefs.in.h6
-rw-r--r--lib/getopt-core.h2
-rw-r--r--lib/getopt-ext.h2
-rw-r--r--lib/getopt-pfx-core.h6
-rw-r--r--lib/getopt-pfx-ext.h6
-rw-r--r--lib/getopt.c2
-rw-r--r--lib/getopt.in.h6
-rw-r--r--lib/getopt1.c2
-rw-r--r--lib/getopt_.h285
-rw-r--r--lib/getopt_int.h2
-rw-r--r--lib/gettext.h5
-rw-r--r--lib/gettime.c2
-rw-r--r--lib/gettimeofday.c2
-rw-r--r--lib/gnulib.mk.in130
-rw-r--r--lib/group-member.c2
-rw-r--r--lib/ignore-value.h2
-rw-r--r--lib/intprops.h8
-rw-r--r--lib/inttypes.in.h2
-rw-r--r--lib/limits.in.h2
-rw-r--r--lib/localtime-buffer.c2
-rw-r--r--lib/localtime-buffer.h2
-rw-r--r--lib/lstat.c41
-rw-r--r--lib/md5.c2
-rw-r--r--lib/md5.h2
-rw-r--r--lib/memrchr.c2
-rw-r--r--lib/minmax.h2
-rw-r--r--lib/mkostemp.c2
-rw-r--r--lib/mktime-internal.h2
-rw-r--r--lib/mktime.c2
-rw-r--r--lib/nstrftime.c (renamed from lib/strftime.c)2
-rw-r--r--lib/open.c208
-rw-r--r--lib/openat-priv.h2
-rw-r--r--lib/openat-proc.c2
-rw-r--r--lib/openat.h2
-rw-r--r--lib/pipe2.c2
-rw-r--r--lib/pselect.c2
-rw-r--r--lib/pthread_sigmask.c2
-rw-r--r--lib/putenv.c2
-rw-r--r--lib/qcopy-acl.c2
-rw-r--r--lib/readlink.c2
-rw-r--r--lib/readlinkat.c2
-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/secure_getenv.c54
-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/signal.in.h4
-rw-r--r--lib/stat-time.h47
-rw-r--r--lib/stdalign.in.h4
-rw-r--r--lib/stddef.in.h20
-rw-r--r--lib/stdint.in.h2
-rw-r--r--lib/stdio-impl.h14
-rw-r--r--lib/stdio.in.h10
-rw-r--r--lib/stdlib.in.h23
-rw-r--r--lib/stpcpy.c2
-rw-r--r--lib/strftime.h2
-rw-r--r--lib/string.in.h19
-rw-r--r--lib/strtoimax.c2
-rw-r--r--lib/strtol.c2
-rw-r--r--lib/strtoll.c2
-rw-r--r--lib/symlink.c2
-rw-r--r--lib/sys_select.in.h2
-rw-r--r--lib/sys_stat.in.h2
-rw-r--r--lib/sys_time.in.h2
-rw-r--r--lib/sys_types.in.h2
-rw-r--r--lib/tempname.c5
-rw-r--r--lib/tempname.h2
-rw-r--r--lib/time-internal.h2
-rw-r--r--lib/time.in.h2
-rw-r--r--lib/time_r.c2
-rw-r--r--lib/time_rz.c2
-rw-r--r--lib/timegm.c2
-rw-r--r--lib/timespec-add.c2
-rw-r--r--lib/timespec-sub.c2
-rw-r--r--lib/timespec.h24
-rw-r--r--lib/u64.h2
-rw-r--r--lib/unistd.in.h27
-rw-r--r--lib/unlocked-io.h136
-rw-r--r--lib/utimens.c12
-rw-r--r--lib/utimens.h2
-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/COPYING8
-rw-r--r--lisp/ChangeLog.12
-rw-r--r--lisp/ChangeLog.102
-rw-r--r--lisp/ChangeLog.114
-rw-r--r--lisp/ChangeLog.122
-rw-r--r--lisp/ChangeLog.1312
-rw-r--r--lisp/ChangeLog.142
-rw-r--r--lisp/ChangeLog.1530
-rw-r--r--lisp/ChangeLog.1648
-rw-r--r--lisp/ChangeLog.1766
-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.64
-rw-r--r--lisp/ChangeLog.72
-rw-r--r--lisp/ChangeLog.82
-rw-r--r--lisp/ChangeLog.94
-rw-r--r--lisp/Makefile.in10
-rw-r--r--lisp/abbrev.el2
-rw-r--r--lisp/align.el2
-rw-r--r--lisp/allout-widgets.el5
-rw-r--r--lisp/allout.el6
-rw-r--r--lisp/ansi-color.el121
-rw-r--r--lisp/apropos.el44
-rw-r--r--lisp/arc-mode.el10
-rw-r--r--lisp/array.el2
-rw-r--r--lisp/auth-source-pass.el19
-rw-r--r--lisp/auth-source.el40
-rw-r--r--lisp/autoarg.el2
-rw-r--r--lisp/autoinsert.el18
-rw-r--r--lisp/autorevert.el58
-rw-r--r--lisp/avoid.el2
-rw-r--r--lisp/battery.el2
-rw-r--r--lisp/bindings.el6
-rw-r--r--lisp/bookmark.el2
-rw-r--r--lisp/bs.el2
-rw-r--r--lisp/buff-menu.el2
-rw-r--r--lisp/button.el6
-rw-r--r--lisp/calc/calc-aent.el6
-rw-r--r--lisp/calc/calc-alg.el4
-rw-r--r--lisp/calc/calc-arith.el20
-rw-r--r--lisp/calc/calc-bin.el10
-rw-r--r--lisp/calc/calc-comb.el2
-rw-r--r--lisp/calc/calc-cplx.el2
-rw-r--r--lisp/calc/calc-embed.el2
-rw-r--r--lisp/calc/calc-ext.el2
-rw-r--r--lisp/calc/calc-fin.el2
-rw-r--r--lisp/calc/calc-forms.el2
-rw-r--r--lisp/calc/calc-frac.el8
-rw-r--r--lisp/calc/calc-funcs.el50
-rw-r--r--lisp/calc/calc-graph.el2
-rw-r--r--lisp/calc/calc-help.el2
-rw-r--r--lisp/calc/calc-incom.el2
-rw-r--r--lisp/calc/calc-keypd.el2
-rw-r--r--lisp/calc/calc-lang.el2
-rw-r--r--lisp/calc/calc-macs.el2
-rw-r--r--lisp/calc/calc-map.el10
-rw-r--r--lisp/calc/calc-math.el40
-rw-r--r--lisp/calc/calc-menu.el2
-rw-r--r--lisp/calc/calc-misc.el2
-rw-r--r--lisp/calc/calc-mode.el2
-rw-r--r--lisp/calc/calc-mtx.el2
-rw-r--r--lisp/calc/calc-nlfit.el2
-rw-r--r--lisp/calc/calc-poly.el2
-rw-r--r--lisp/calc/calc-prog.el2
-rw-r--r--lisp/calc/calc-rewr.el54
-rw-r--r--lisp/calc/calc-rules.el2
-rw-r--r--lisp/calc/calc-sel.el8
-rw-r--r--lisp/calc/calc-stat.el2
-rw-r--r--lisp/calc/calc-store.el2
-rw-r--r--lisp/calc/calc-stuff.el2
-rw-r--r--lisp/calc/calc-trail.el2
-rw-r--r--lisp/calc/calc-undo.el4
-rw-r--r--lisp/calc/calc-units.el74
-rw-r--r--lisp/calc/calc-vec.el2
-rw-r--r--lisp/calc/calc-yank.el2
-rw-r--r--lisp/calc/calc.el2
-rw-r--r--lisp/calc/calcalg2.el4
-rw-r--r--lisp/calc/calcalg3.el74
-rw-r--r--lisp/calc/calccomp.el2
-rw-r--r--lisp/calc/calcsel2.el2
-rw-r--r--lisp/calculator.el2
-rw-r--r--lisp/calendar/appt.el2
-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.el97
-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.el4
-rw-r--r--lisp/calendar/cal-move.el2
-rw-r--r--lisp/calendar/cal-persia.el2
-rw-r--r--lisp/calendar/cal-tex.el62
-rw-r--r--lisp/calendar/cal-x.el2
-rw-r--r--lisp/calendar/calendar.el35
-rw-r--r--lisp/calendar/diary-lib.el510
-rw-r--r--lisp/calendar/holidays.el2
-rw-r--r--lisp/calendar/icalendar.el2
-rw-r--r--lisp/calendar/lunar.el2
-rw-r--r--lisp/calendar/parse-time.el2
-rw-r--r--lisp/calendar/solar.el23
-rw-r--r--lisp/calendar/time-date.el2
-rw-r--r--lisp/calendar/timeclock.el2
-rw-r--r--lisp/calendar/todo-mode.el695
-rw-r--r--lisp/case-table.el2
-rw-r--r--lisp/cdl.el2
-rw-r--r--lisp/cedet/ChangeLog.14
-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.el4
-rw-r--r--lisp/cedet/cedet.el2
-rw-r--r--lisp/cedet/data-debug.el2
-rw-r--r--lisp/cedet/ede.el4
-rw-r--r--lisp/cedet/ede/auto.el2
-rw-r--r--lisp/cedet/ede/autoconf-edit.el2
-rw-r--r--lisp/cedet/ede/base.el2
-rw-r--r--lisp/cedet/ede/config.el2
-rw-r--r--lisp/cedet/ede/cpp-root.el2
-rw-r--r--lisp/cedet/ede/custom.el2
-rw-r--r--lisp/cedet/ede/detect.el7
-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.el2
-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.el2
-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.el2
-rw-r--r--lisp/cedet/ede/project-am.el2
-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.el2
-rw-r--r--lisp/cedet/mode-local.el2
-rw-r--r--lisp/cedet/pulse.el6
-rw-r--r--lisp/cedet/semantic.el7
-rw-r--r--lisp/cedet/semantic/analyze.el16
-rw-r--r--lisp/cedet/semantic/analyze/complete.el2
-rw-r--r--lisp/cedet/semantic/analyze/debug.el2
-rw-r--r--lisp/cedet/semantic/analyze/fcn.el2
-rw-r--r--lisp/cedet/semantic/analyze/refs.el7
-rw-r--r--lisp/cedet/semantic/bovine.el2
-rw-r--r--lisp/cedet/semantic/bovine/c.el2
-rw-r--r--lisp/cedet/semantic/bovine/debug.el2
-rw-r--r--lisp/cedet/semantic/bovine/el.el2
-rw-r--r--lisp/cedet/semantic/bovine/gcc.el2
-rw-r--r--lisp/cedet/semantic/bovine/grammar.el4
-rw-r--r--lisp/cedet/semantic/bovine/make.el2
-rw-r--r--lisp/cedet/semantic/bovine/scm.el2
-rw-r--r--lisp/cedet/semantic/chart.el2
-rw-r--r--lisp/cedet/semantic/complete.el4
-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.el4
-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.el2
-rw-r--r--lisp/cedet/semantic/db.el4
-rw-r--r--lisp/cedet/semantic/debug.el2
-rw-r--r--lisp/cedet/semantic/decorate.el2
-rw-r--r--lisp/cedet/semantic/decorate/include.el4
-rw-r--r--lisp/cedet/semantic/decorate/mode.el2
-rw-r--r--lisp/cedet/semantic/dep.el2
-rw-r--r--lisp/cedet/semantic/doc.el2
-rw-r--r--lisp/cedet/semantic/ede-grammar.el2
-rw-r--r--lisp/cedet/semantic/edit.el4
-rw-r--r--lisp/cedet/semantic/find.el2
-rw-r--r--lisp/cedet/semantic/format.el2
-rw-r--r--lisp/cedet/semantic/fw.el2
-rw-r--r--lisp/cedet/semantic/grammar-wy.el2
-rw-r--r--lisp/cedet/semantic/grammar.el4
-rw-r--r--lisp/cedet/semantic/html.el2
-rw-r--r--lisp/cedet/semantic/ia-sb.el2
-rw-r--r--lisp/cedet/semantic/ia.el6
-rw-r--r--lisp/cedet/semantic/idle.el2
-rw-r--r--lisp/cedet/semantic/imenu.el4
-rw-r--r--lisp/cedet/semantic/java.el2
-rw-r--r--lisp/cedet/semantic/lex-spp.el2
-rw-r--r--lisp/cedet/semantic/lex.el9
-rw-r--r--lisp/cedet/semantic/mru-bookmark.el4
-rw-r--r--lisp/cedet/semantic/sb.el2
-rw-r--r--lisp/cedet/semantic/scope.el2
-rw-r--r--lisp/cedet/semantic/senator.el6
-rw-r--r--lisp/cedet/semantic/sort.el2
-rw-r--r--lisp/cedet/semantic/symref.el2
-rw-r--r--lisp/cedet/semantic/symref/cscope.el2
-rw-r--r--lisp/cedet/semantic/symref/filter.el4
-rw-r--r--lisp/cedet/semantic/symref/global.el2
-rw-r--r--lisp/cedet/semantic/symref/grep.el101
-rw-r--r--lisp/cedet/semantic/symref/idutils.el2
-rw-r--r--lisp/cedet/semantic/symref/list.el2
-rw-r--r--lisp/cedet/semantic/tag-file.el2
-rw-r--r--lisp/cedet/semantic/tag-ls.el2
-rw-r--r--lisp/cedet/semantic/tag-write.el2
-rw-r--r--lisp/cedet/semantic/tag.el2
-rw-r--r--lisp/cedet/semantic/texi.el2
-rw-r--r--lisp/cedet/semantic/util-modes.el2
-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.el4
-rw-r--r--lisp/cedet/semantic/wisent/java-tags.el4
-rw-r--r--lisp/cedet/semantic/wisent/javascript.el2
-rw-r--r--lisp/cedet/semantic/wisent/python.el2
-rw-r--r--lisp/cedet/semantic/wisent/wisent.el2
-rw-r--r--lisp/cedet/srecode.el2
-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.el5
-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.el3
-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.el5
-rw-r--r--lisp/cedet/srecode/mode.el2
-rw-r--r--lisp/cedet/srecode/semantic.el2
-rw-r--r--lisp/cedet/srecode/srt-mode.el2
-rw-r--r--lisp/cedet/srecode/srt.el2
-rw-r--r--lisp/cedet/srecode/table.el3
-rw-r--r--lisp/cedet/srecode/template.el2
-rw-r--r--lisp/cedet/srecode/texi.el2
-rw-r--r--lisp/char-fold.el4
-rw-r--r--lisp/chistory.el2
-rw-r--r--lisp/cmuscheme.el2
-rw-r--r--lisp/color.el44
-rw-r--r--lisp/comint.el4
-rw-r--r--lisp/completion.el2
-rw-r--r--lisp/composite.el21
-rw-r--r--lisp/cus-dep.el2
-rw-r--r--lisp/cus-edit.el13
-rw-r--r--lisp/cus-face.el2
-rw-r--r--lisp/cus-start.el49
-rw-r--r--lisp/cus-theme.el2
-rw-r--r--lisp/custom.el2
-rw-r--r--lisp/dabbrev.el2
-rw-r--r--lisp/delim-col.el6
-rw-r--r--lisp/delsel.el23
-rw-r--r--lisp/descr-text.el22
-rw-r--r--lisp/desktop.el32
-rw-r--r--lisp/dframe.el2
-rw-r--r--lisp/dired-aux.el303
-rw-r--r--lisp/dired-x.el31
-rw-r--r--lisp/dired.el377
-rw-r--r--lisp/dirtrack.el2
-rw-r--r--lisp/disp-table.el2
-rw-r--r--lisp/display-line-numbers.el106
-rw-r--r--lisp/dnd.el4
-rw-r--r--lisp/doc-view.el4
-rw-r--r--lisp/dom.el4
-rw-r--r--lisp/dos-fns.el2
-rw-r--r--lisp/dos-vars.el2
-rw-r--r--lisp/dos-w32.el2
-rw-r--r--lisp/double.el2
-rw-r--r--lisp/dynamic-setting.el3
-rw-r--r--lisp/ebuff-menu.el2
-rw-r--r--lisp/echistory.el2
-rw-r--r--lisp/ecomplete.el4
-rw-r--r--lisp/edmacro.el25
-rw-r--r--lisp/ehelp.el2
-rw-r--r--lisp/elec-pair.el15
-rw-r--r--lisp/electric.el128
-rw-r--r--lisp/elide-head.el4
-rw-r--r--lisp/emacs-lisp/advice.el4
-rw-r--r--lisp/emacs-lisp/autoload.el26
-rw-r--r--lisp/emacs-lisp/avl-tree.el19
-rw-r--r--lisp/emacs-lisp/backquote.el2
-rw-r--r--lisp/emacs-lisp/benchmark.el10
-rw-r--r--lisp/emacs-lisp/bindat.el2
-rw-r--r--lisp/emacs-lisp/byte-opt.el7
-rw-r--r--lisp/emacs-lisp/byte-run.el13
-rw-r--r--lisp/emacs-lisp/bytecomp.el176
-rw-r--r--lisp/emacs-lisp/cconv.el2
-rw-r--r--lisp/emacs-lisp/chart.el2
-rw-r--r--lisp/emacs-lisp/check-declare.el2
-rw-r--r--lisp/emacs-lisp/checkdoc.el156
-rw-r--r--lisp/emacs-lisp/cl-extra.el41
-rw-r--r--lisp/emacs-lisp/cl-generic.el87
-rw-r--r--lisp/emacs-lisp/cl-indent.el2
-rw-r--r--lisp/emacs-lisp/cl-lib.el12
-rw-r--r--lisp/emacs-lisp/cl-macs.el214
-rw-r--r--lisp/emacs-lisp/cl-preloaded.el2
-rw-r--r--lisp/emacs-lisp/cl-print.el34
-rw-r--r--lisp/emacs-lisp/cl-seq.el2
-rw-r--r--lisp/emacs-lisp/cl.el3
-rw-r--r--lisp/emacs-lisp/copyright.el7
-rw-r--r--lisp/emacs-lisp/crm.el2
-rw-r--r--lisp/emacs-lisp/cursor-sensor.el2
-rw-r--r--lisp/emacs-lisp/debug.el207
-rw-r--r--lisp/emacs-lisp/derived.el10
-rw-r--r--lisp/emacs-lisp/disass.el2
-rw-r--r--lisp/emacs-lisp/easy-mmode.el12
-rw-r--r--lisp/emacs-lisp/easymenu.el2
-rw-r--r--lisp/emacs-lisp/edebug.el257
-rw-r--r--lisp/emacs-lisp/eieio-base.el40
-rw-r--r--lisp/emacs-lisp/eieio-compat.el5
-rw-r--r--lisp/emacs-lisp/eieio-core.el12
-rw-r--r--lisp/emacs-lisp/eieio-custom.el2
-rw-r--r--lisp/emacs-lisp/eieio-datadebug.el2
-rw-r--r--lisp/emacs-lisp/eieio-opt.el2
-rw-r--r--lisp/emacs-lisp/eieio-speedbar.el2
-rw-r--r--lisp/emacs-lisp/eieio.el71
-rw-r--r--lisp/emacs-lisp/eldoc.el57
-rw-r--r--lisp/emacs-lisp/elint.el16
-rw-r--r--lisp/emacs-lisp/elp.el14
-rw-r--r--lisp/emacs-lisp/ert-x.el59
-rw-r--r--lisp/emacs-lisp/ert.el230
-rw-r--r--lisp/emacs-lisp/ewoc.el2
-rw-r--r--lisp/emacs-lisp/faceup.el1180
-rw-r--r--lisp/emacs-lisp/find-func.el2
-rw-r--r--lisp/emacs-lisp/float-sup.el2
-rw-r--r--lisp/emacs-lisp/generator.el19
-rw-r--r--lisp/emacs-lisp/generic.el2
-rw-r--r--lisp/emacs-lisp/gv.el23
-rw-r--r--lisp/emacs-lisp/helper.el2
-rw-r--r--lisp/emacs-lisp/inline.el6
-rw-r--r--lisp/emacs-lisp/let-alist.el2
-rw-r--r--lisp/emacs-lisp/lisp-mnt.el9
-rw-r--r--lisp/emacs-lisp/lisp-mode.el44
-rw-r--r--lisp/emacs-lisp/lisp.el8
-rw-r--r--lisp/emacs-lisp/macroexp.el2
-rw-r--r--lisp/emacs-lisp/map-ynp.el2
-rw-r--r--lisp/emacs-lisp/map.el24
-rw-r--r--lisp/emacs-lisp/nadvice.el14
-rw-r--r--lisp/emacs-lisp/package-x.el2
-rw-r--r--lisp/emacs-lisp/package.el117
-rw-r--r--lisp/emacs-lisp/pcase.el17
-rw-r--r--lisp/emacs-lisp/pp.el2
-rw-r--r--lisp/emacs-lisp/radix-tree.el2
-rw-r--r--lisp/emacs-lisp/re-builder.el6
-rw-r--r--lisp/emacs-lisp/regexp-opt.el2
-rw-r--r--lisp/emacs-lisp/regi.el2
-rw-r--r--lisp/emacs-lisp/ring.el2
-rw-r--r--lisp/emacs-lisp/rmc.el201
-rw-r--r--lisp/emacs-lisp/rx.el58
-rw-r--r--lisp/emacs-lisp/seq.el2
-rw-r--r--lisp/emacs-lisp/shadow.el2
-rw-r--r--lisp/emacs-lisp/smie.el6
-rw-r--r--lisp/emacs-lisp/subr-x.el281
-rw-r--r--lisp/emacs-lisp/syntax.el109
-rw-r--r--lisp/emacs-lisp/tabulated-list.el49
-rw-r--r--lisp/emacs-lisp/tcover-ses.el2
-rw-r--r--lisp/emacs-lisp/tcover-unsafep.el2
-rw-r--r--lisp/emacs-lisp/testcover.el704
-rw-r--r--lisp/emacs-lisp/thunk.el70
-rw-r--r--lisp/emacs-lisp/timer-list.el30
-rw-r--r--lisp/emacs-lisp/timer.el2
-rw-r--r--lisp/emacs-lisp/tq.el2
-rw-r--r--lisp/emacs-lisp/trace.el2
-rw-r--r--lisp/emacs-lisp/unsafep.el2
-rw-r--r--lisp/emacs-lisp/warnings.el2
-rw-r--r--lisp/emacs-lock.el2
-rw-r--r--lisp/emulation/cua-base.el2
-rw-r--r--lisp/emulation/cua-gmrk.el2
-rw-r--r--lisp/emulation/cua-rect.el2
-rw-r--r--lisp/emulation/edt-lk201.el2
-rw-r--r--lisp/emulation/edt-mapper.el2
-rw-r--r--lisp/emulation/edt-pc.el2
-rw-r--r--lisp/emulation/edt-vt100.el2
-rw-r--r--lisp/emulation/edt.el2
-rw-r--r--lisp/emulation/keypad.el2
-rw-r--r--lisp/emulation/viper-cmd.el2
-rw-r--r--lisp/emulation/viper-ex.el101
-rw-r--r--lisp/emulation/viper-init.el6
-rw-r--r--lisp/emulation/viper-keym.el2
-rw-r--r--lisp/emulation/viper-macs.el2
-rw-r--r--lisp/emulation/viper-mous.el2
-rw-r--r--lisp/emulation/viper-util.el2
-rw-r--r--lisp/emulation/viper.el2
-rw-r--r--lisp/env.el2
-rw-r--r--lisp/epa-dired.el2
-rw-r--r--lisp/epa-file.el2
-rw-r--r--lisp/epa-hook.el2
-rw-r--r--lisp/epa-mail.el2
-rw-r--r--lisp/epa.el4
-rw-r--r--lisp/epg-config.el34
-rw-r--r--lisp/epg.el30
-rw-r--r--lisp/erc/ChangeLog.12
-rw-r--r--lisp/erc/ChangeLog.24
-rw-r--r--lisp/erc/erc-autoaway.el5
-rw-r--r--lisp/erc/erc-backend.el32
-rw-r--r--lisp/erc/erc-button.el5
-rw-r--r--lisp/erc/erc-capab.el8
-rw-r--r--lisp/erc/erc-compat.el5
-rw-r--r--lisp/erc/erc-dcc.el16
-rw-r--r--lisp/erc/erc-desktop-notifications.el6
-rw-r--r--lisp/erc/erc-ezbounce.el6
-rw-r--r--lisp/erc/erc-fill.el5
-rw-r--r--lisp/erc/erc-goodies.el16
-rw-r--r--lisp/erc/erc-ibuffer.el3
-rw-r--r--lisp/erc/erc-identd.el6
-rw-r--r--lisp/erc/erc-imenu.el4
-rw-r--r--lisp/erc/erc-join.el6
-rw-r--r--lisp/erc/erc-lang.el4
-rw-r--r--lisp/erc/erc-list.el8
-rw-r--r--lisp/erc/erc-log.el5
-rw-r--r--lisp/erc/erc-match.el5
-rw-r--r--lisp/erc/erc-menu.el6
-rw-r--r--lisp/erc/erc-netsplit.el8
-rw-r--r--lisp/erc/erc-networks.el2
-rw-r--r--lisp/erc/erc-notify.el5
-rw-r--r--lisp/erc/erc-page.el6
-rw-r--r--lisp/erc/erc-pcomplete.el8
-rw-r--r--lisp/erc/erc-replace.el6
-rw-r--r--lisp/erc/erc-ring.el5
-rw-r--r--lisp/erc/erc-services.el60
-rw-r--r--lisp/erc/erc-sound.el6
-rw-r--r--lisp/erc/erc-speedbar.el3
-rw-r--r--lisp/erc/erc-spelling.el8
-rw-r--r--lisp/erc/erc-stamp.el6
-rw-r--r--lisp/erc/erc-track.el5
-rw-r--r--lisp/erc/erc-truncate.el6
-rw-r--r--lisp/erc/erc-xdcc.el6
-rw-r--r--lisp/erc/erc.el114
-rw-r--r--lisp/eshell/em-alias.el6
-rw-r--r--lisp/eshell/em-banner.el2
-rw-r--r--lisp/eshell/em-basic.el8
-rw-r--r--lisp/eshell/em-cmpl.el56
-rw-r--r--lisp/eshell/em-dirs.el2
-rw-r--r--lisp/eshell/em-glob.el2
-rw-r--r--lisp/eshell/em-hist.el10
-rw-r--r--lisp/eshell/em-ls.el80
-rw-r--r--lisp/eshell/em-pred.el2
-rw-r--r--lisp/eshell/em-prompt.el19
-rw-r--r--lisp/eshell/em-rebind.el2
-rw-r--r--lisp/eshell/em-script.el2
-rw-r--r--lisp/eshell/em-smart.el2
-rw-r--r--lisp/eshell/em-term.el2
-rw-r--r--lisp/eshell/em-tramp.el2
-rw-r--r--lisp/eshell/em-unix.el4
-rw-r--r--lisp/eshell/em-xtra.el2
-rw-r--r--lisp/eshell/esh-arg.el2
-rw-r--r--lisp/eshell/esh-cmd.el34
-rw-r--r--lisp/eshell/esh-ext.el2
-rw-r--r--lisp/eshell/esh-io.el2
-rw-r--r--lisp/eshell/esh-mode.el6
-rw-r--r--lisp/eshell/esh-module.el2
-rw-r--r--lisp/eshell/esh-opt.el2
-rw-r--r--lisp/eshell/esh-proc.el2
-rw-r--r--lisp/eshell/esh-util.el4
-rw-r--r--lisp/eshell/esh-var.el2
-rw-r--r--lisp/eshell/eshell.el2
-rw-r--r--lisp/expand.el2
-rw-r--r--lisp/ezimage.el2
-rw-r--r--lisp/face-remap.el2
-rw-r--r--lisp/facemenu.el2
-rw-r--r--lisp/faces.el56
-rw-r--r--lisp/ffap.el8
-rw-r--r--lisp/filecache.el220
-rw-r--r--lisp/filenotify.el14
-rw-r--r--lisp/files-x.el2
-rw-r--r--lisp/files.el916
-rw-r--r--lisp/filesets.el2
-rw-r--r--lisp/find-cmd.el2
-rw-r--r--lisp/find-dired.el10
-rw-r--r--lisp/find-file.el2
-rw-r--r--lisp/find-lisp.el4
-rw-r--r--lisp/finder.el6
-rw-r--r--lisp/flow-ctrl.el2
-rw-r--r--lisp/foldout.el2
-rw-r--r--lisp/follow.el5
-rw-r--r--lisp/font-core.el2
-rw-r--r--lisp/font-lock.el2
-rw-r--r--lisp/format-spec.el2
-rw-r--r--lisp/format.el4
-rw-r--r--lisp/forms.el2
-rw-r--r--lisp/frame.el97
-rw-r--r--lisp/frameset.el25
-rw-r--r--lisp/fringe.el2
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/ChangeLog.12
-rw-r--r--lisp/gnus/ChangeLog.22
-rw-r--r--lisp/gnus/ChangeLog.320
-rw-r--r--lisp/gnus/canlock.el2
-rw-r--r--lisp/gnus/deuglify.el2
-rw-r--r--lisp/gnus/gmm-utils.el2
-rw-r--r--lisp/gnus/gnus-agent.el14
-rw-r--r--lisp/gnus/gnus-art.el143
-rw-r--r--lisp/gnus/gnus-async.el2
-rw-r--r--lisp/gnus/gnus-bcklg.el6
-rw-r--r--lisp/gnus/gnus-bookmark.el2
-rw-r--r--lisp/gnus/gnus-cache.el4
-rw-r--r--lisp/gnus/gnus-cite.el2
-rw-r--r--lisp/gnus/gnus-cloud.el6
-rw-r--r--lisp/gnus/gnus-cus.el8
-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.el2
-rw-r--r--lisp/gnus/gnus-gravatar.el2
-rw-r--r--lisp/gnus/gnus-group.el29
-rw-r--r--lisp/gnus/gnus-html.el8
-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.el5
-rw-r--r--lisp/gnus/gnus-msg.el2
-rw-r--r--lisp/gnus/gnus-notifications.el4
-rw-r--r--lisp/gnus/gnus-picon.el2
-rw-r--r--lisp/gnus/gnus-range.el16
-rw-r--r--lisp/gnus/gnus-registry.el2
-rw-r--r--lisp/gnus/gnus-rfc1843.el2
-rw-r--r--lisp/gnus/gnus-salt.el2
-rw-r--r--lisp/gnus/gnus-score.el30
-rw-r--r--lisp/gnus/gnus-sieve.el2
-rw-r--r--lisp/gnus/gnus-spec.el2
-rw-r--r--lisp/gnus/gnus-srvr.el12
-rw-r--r--lisp/gnus/gnus-start.el2
-rw-r--r--lisp/gnus/gnus-sum.el29
-rw-r--r--lisp/gnus/gnus-topic.el4
-rw-r--r--lisp/gnus/gnus-undo.el2
-rw-r--r--lisp/gnus/gnus-util.el5
-rw-r--r--lisp/gnus/gnus-uu.el2
-rw-r--r--lisp/gnus/gnus-vm.el2
-rw-r--r--lisp/gnus/gnus-win.el2
-rw-r--r--lisp/gnus/gnus.el464
-rw-r--r--lisp/gnus/gssapi.el2
-rw-r--r--lisp/gnus/legacy-gnus-agent.el2
-rw-r--r--lisp/gnus/mail-source.el18
-rw-r--r--lisp/gnus/message.el129
-rw-r--r--lisp/gnus/mm-archive.el2
-rw-r--r--lisp/gnus/mm-bodies.el2
-rw-r--r--lisp/gnus/mm-decode.el20
-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.el4
-rw-r--r--lisp/gnus/mm-view.el6
-rw-r--r--lisp/gnus/mml-sec.el2
-rw-r--r--lisp/gnus/mml-smime.el2
-rw-r--r--lisp/gnus/mml.el2
-rw-r--r--lisp/gnus/mml1991.el2
-rw-r--r--lisp/gnus/mml2015.el2
-rw-r--r--lisp/gnus/nnagent.el2
-rw-r--r--lisp/gnus/nnbabyl.el2
-rw-r--r--lisp/gnus/nndiary.el4
-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.el2
-rw-r--r--lisp/gnus/nngateway.el2
-rw-r--r--lisp/gnus/nnheader.el2
-rw-r--r--lisp/gnus/nnimap.el7
-rw-r--r--lisp/gnus/nnir.el4
-rw-r--r--lisp/gnus/nnmail.el4
-rw-r--r--lisp/gnus/nnmaildir.el4
-rw-r--r--lisp/gnus/nnmairix.el2
-rw-r--r--lisp/gnus/nnmbox.el2
-rw-r--r--lisp/gnus/nnmh.el2
-rw-r--r--lisp/gnus/nnml.el2
-rw-r--r--lisp/gnus/nnnil.el2
-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/nnspool.el2
-rw-r--r--lisp/gnus/nntp.el2
-rw-r--r--lisp/gnus/nnvirtual.el2
-rw-r--r--lisp/gnus/nnweb.el2
-rw-r--r--lisp/gnus/score-mode.el4
-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.el4
-rw-r--r--lisp/help-at-pt.el2
-rw-r--r--lisp/help-fns.el138
-rw-r--r--lisp/help-macro.el2
-rw-r--r--lisp/help-mode.el6
-rw-r--r--lisp/help.el276
-rw-r--r--lisp/hex-util.el2
-rw-r--r--lisp/hexl.el2
-rw-r--r--lisp/hfy-cmap.el2
-rw-r--r--lisp/hi-lock.el12
-rw-r--r--lisp/hilit-chg.el2
-rw-r--r--lisp/hippie-exp.el2
-rw-r--r--lisp/hl-line.el2
-rw-r--r--lisp/htmlfontify.el6
-rw-r--r--lisp/ibuf-ext.el17
-rw-r--r--lisp/ibuf-macs.el18
-rw-r--r--lisp/ibuffer.el3
-rw-r--r--lisp/icomplete.el2
-rw-r--r--lisp/ido.el16
-rw-r--r--lisp/ielm.el2
-rw-r--r--lisp/iimage.el2
-rw-r--r--lisp/image-dired.el14
-rw-r--r--lisp/image-file.el2
-rw-r--r--lisp/image-mode.el2
-rw-r--r--lisp/image.el11
-rw-r--r--lisp/image/compface.el2
-rw-r--r--lisp/image/gravatar.el8
-rw-r--r--lisp/imenu.el2
-rw-r--r--lisp/indent.el2
-rw-r--r--lisp/info-look.el8
-rw-r--r--lisp/info-xref.el2
-rw-r--r--lisp/info.el53
-rw-r--r--lisp/informat.el2
-rw-r--r--lisp/international/ccl.el2
-rw-r--r--lisp/international/characters.el24
-rw-r--r--lisp/international/fontset.el6
-rw-r--r--lisp/international/isearch-x.el2
-rw-r--r--lisp/international/iso-ascii.el2
-rw-r--r--lisp/international/iso-cvt.el2
-rw-r--r--lisp/international/iso-transl.el2
-rw-r--r--lisp/international/ja-dic-cnv.el63
-rw-r--r--lisp/international/ja-dic-utl.el2
-rw-r--r--lisp/international/kinsoku.el2
-rw-r--r--lisp/international/kkc.el2
-rw-r--r--lisp/international/latexenc.el2
-rw-r--r--lisp/international/latin1-disp.el2
-rw-r--r--lisp/international/mule-cmds.el70
-rw-r--r--lisp/international/mule-conf.el6
-rw-r--r--lisp/international/mule-diag.el6
-rw-r--r--lisp/international/mule-util.el79
-rw-r--r--lisp/international/mule.el4
-rw-r--r--lisp/international/ogonek.el11
-rw-r--r--lisp/international/quail.el10
-rw-r--r--lisp/international/rfc1843.el6
-rw-r--r--lisp/international/robin.el6
-rw-r--r--lisp/international/titdic-cnv.el10
-rw-r--r--lisp/international/ucs-normalize.el2
-rw-r--r--lisp/international/utf-7.el4
-rw-r--r--lisp/international/utf7.el2
-rw-r--r--lisp/isearch.el9
-rw-r--r--lisp/isearchb.el2
-rw-r--r--lisp/jit-lock.el4
-rw-r--r--lisp/jka-cmpr-hook.el2
-rw-r--r--lisp/jka-compr.el11
-rw-r--r--lisp/json.el74
-rw-r--r--lisp/kermit.el2
-rw-r--r--lisp/kmacro.el91
-rw-r--r--lisp/language/burmese.el3
-rw-r--r--lisp/language/cham.el2
-rw-r--r--lisp/language/china-util.el2
-rw-r--r--lisp/language/chinese.el2
-rw-r--r--lisp/language/cyril-util.el2
-rw-r--r--lisp/language/cyrillic.el2
-rw-r--r--lisp/language/czech.el2
-rw-r--r--lisp/language/english.el2
-rw-r--r--lisp/language/ethio-util.el2
-rw-r--r--lisp/language/ethiopic.el2
-rw-r--r--lisp/language/european.el2
-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.el2
-rw-r--r--lisp/language/ind-util.el2
-rw-r--r--lisp/language/indian.el8
-rw-r--r--lisp/language/japan-util.el2
-rw-r--r--lisp/language/japanese.el10
-rw-r--r--lisp/language/khmer.el2
-rw-r--r--lisp/language/korea-util.el2
-rw-r--r--lisp/language/korean.el2
-rw-r--r--lisp/language/lao-util.el2
-rw-r--r--lisp/language/lao.el2
-rw-r--r--lisp/language/misc-lang.el67
-rw-r--r--lisp/language/romanian.el2
-rw-r--r--lisp/language/sinhala.el4
-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-word.el2
-rw-r--r--lisp/language/thai.el2
-rw-r--r--lisp/language/tibet-util.el2
-rw-r--r--lisp/language/tibetan.el2
-rw-r--r--lisp/language/tv-util.el5
-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.el1484
-rw-r--r--lisp/leim/quail/arabic.el2
-rw-r--r--lisp/leim/quail/croatian.el2
-rw-r--r--lisp/leim/quail/cyril-jis.el2
-rw-r--r--lisp/leim/quail/cyrillic.el116
-rw-r--r--lisp/leim/quail/czech.el2
-rw-r--r--lisp/leim/quail/ethiopic.el2
-rw-r--r--lisp/leim/quail/georgian.el2
-rw-r--r--lisp/leim/quail/greek.el2
-rw-r--r--lisp/leim/quail/hangul.el2
-rw-r--r--lisp/leim/quail/hanja-jis.el2
-rw-r--r--lisp/leim/quail/hanja.el2
-rw-r--r--lisp/leim/quail/hanja3.el2
-rw-r--r--lisp/leim/quail/hebrew.el2
-rw-r--r--lisp/leim/quail/indian.el2
-rw-r--r--lisp/leim/quail/ipa-praat.el2
-rw-r--r--lisp/leim/quail/ipa.el2
-rw-r--r--lisp/leim/quail/japanese.el2
-rw-r--r--lisp/leim/quail/lao.el2
-rw-r--r--lisp/leim/quail/latin-alt.el18
-rw-r--r--lisp/leim/quail/latin-ltx.el38
-rw-r--r--lisp/leim/quail/latin-post.el2
-rw-r--r--lisp/leim/quail/latin-pre.el2
-rw-r--r--lisp/leim/quail/lrt.el2
-rw-r--r--lisp/leim/quail/persian.el4
-rw-r--r--lisp/leim/quail/programmer-dvorak.el2
-rw-r--r--lisp/leim/quail/py-punct.el2
-rw-r--r--lisp/leim/quail/pypunct-b5.el2
-rw-r--r--lisp/leim/quail/rfc1345.el2
-rw-r--r--lisp/leim/quail/sgml-input.el2
-rw-r--r--lisp/leim/quail/sisheng.el2
-rw-r--r--lisp/leim/quail/slovak.el2
-rw-r--r--lisp/leim/quail/symbol-ksc.el2
-rw-r--r--lisp/leim/quail/tamil-dvorak.el2
-rw-r--r--lisp/leim/quail/thai.el2
-rw-r--r--lisp/leim/quail/tibetan.el2
-rw-r--r--lisp/leim/quail/uni-input.el2
-rw-r--r--lisp/leim/quail/viqr.el2
-rw-r--r--lisp/leim/quail/vntelex.el2
-rw-r--r--lisp/leim/quail/vnvni.el2
-rw-r--r--lisp/leim/quail/welsh.el2
-rw-r--r--lisp/linum.el2
-rw-r--r--lisp/loadhist.el107
-rw-r--r--lisp/loadup.el5
-rw-r--r--lisp/locate.el2
-rw-r--r--lisp/lpr.el2
-rw-r--r--lisp/ls-lisp.el72
-rw-r--r--lisp/macros.el32
-rw-r--r--lisp/mail/binhex.el2
-rw-r--r--lisp/mail/blessmail.el2
-rw-r--r--lisp/mail/emacsbug.el6
-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.el2
-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/metamail.el2
-rw-r--r--lisp/mail/mspools.el2
-rw-r--r--lisp/mail/qp.el2
-rw-r--r--lisp/mail/reporter.el2
-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.el2
-rw-r--r--lisp/mail/rmail-spam-filter.el2
-rw-r--r--lisp/mail/rmail.el8
-rw-r--r--lisp/mail/rmailedit.el82
-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.el2
-rw-r--r--lisp/mail/rmailsort.el2
-rw-r--r--lisp/mail/rmailsum.el2
-rw-r--r--lisp/mail/sendmail.el17
-rw-r--r--lisp/mail/smtpmail.el2
-rw-r--r--lisp/mail/supercite.el4
-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.el2
-rw-r--r--lisp/mail/yenc.el2
-rw-r--r--lisp/makesum.el2
-rw-r--r--lisp/man.el26
-rw-r--r--lisp/master.el2
-rw-r--r--lisp/mb-depth.el2
-rw-r--r--lisp/md4.el2
-rw-r--r--lisp/menu-bar.el70
-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.el2
-rw-r--r--lisp/mh-e/mh-buffers.el2
-rw-r--r--lisp/mh-e/mh-comp.el2
-rw-r--r--lisp/mh-e/mh-compat.el2
-rw-r--r--lisp/mh-e/mh-e.el6
-rw-r--r--lisp/mh-e/mh-folder.el2
-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.el2
-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.el15
-rw-r--r--lisp/mh-e/mh-limit.el2
-rw-r--r--lisp/mh-e/mh-mime.el4
-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.el2
-rw-r--r--lisp/mh-e/mh-seq.el2
-rw-r--r--lisp/mh-e/mh-show.el2
-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.el2
-rw-r--r--lisp/mh-e/mh-xface.el2
-rw-r--r--lisp/midnight.el2
-rw-r--r--lisp/minibuf-eldef.el2
-rw-r--r--lisp/minibuffer.el49
-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.el2
-rw-r--r--lisp/mouse.el477
-rw-r--r--lisp/mpc.el44
-rw-r--r--lisp/msb.el2
-rw-r--r--lisp/mwheel.el3
-rw-r--r--lisp/net/ange-ftp.el60
-rw-r--r--lisp/net/browse-url.el4
-rw-r--r--lisp/net/dbus.el2
-rw-r--r--lisp/net/dig.el2
-rw-r--r--lisp/net/dns.el2
-rw-r--r--lisp/net/eudc-bob.el2
-rw-r--r--lisp/net/eudc-export.el2
-rw-r--r--lisp/net/eudc-hotlist.el2
-rw-r--r--lisp/net/eudc-vars.el2
-rw-r--r--lisp/net/eudc.el2
-rw-r--r--lisp/net/eudcb-bbdb.el2
-rw-r--r--lisp/net/eudcb-ldap.el2
-rw-r--r--lisp/net/eudcb-mab.el2
-rw-r--r--lisp/net/eww.el41
-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.el2
-rw-r--r--lisp/net/ldap.el2
-rw-r--r--lisp/net/mailcap.el146
-rw-r--r--lisp/net/mairix.el2
-rw-r--r--lisp/net/net-utils.el2
-rw-r--r--lisp/net/netrc.el2
-rw-r--r--lisp/net/network-stream.el2
-rw-r--r--lisp/net/newst-backend.el348
-rw-r--r--lisp/net/newst-plainview.el2
-rw-r--r--lisp/net/newst-reader.el2
-rw-r--r--lisp/net/newst-ticker.el4
-rw-r--r--lisp/net/newst-treeview.el2
-rw-r--r--lisp/net/newsticker.el2
-rw-r--r--lisp/net/nsm.el4
-rw-r--r--lisp/net/ntlm.el2
-rw-r--r--lisp/net/pinentry.el460
-rw-r--r--lisp/net/pop3.el2
-rw-r--r--lisp/net/puny.el2
-rw-r--r--lisp/net/quickurl.el10
-rw-r--r--lisp/net/rcirc.el73
-rw-r--r--lisp/net/rfc2104.el2
-rw-r--r--lisp/net/rlogin.el4
-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.el2
-rw-r--r--lisp/net/secrets.el2
-rw-r--r--lisp/net/shr-color.el2
-rw-r--r--lisp/net/shr.el144
-rw-r--r--lisp/net/sieve-manage.el2
-rw-r--r--lisp/net/sieve-mode.el2
-rw-r--r--lisp/net/sieve.el2
-rw-r--r--lisp/net/snmp-mode.el2
-rw-r--r--lisp/net/soap-client.el2
-rw-r--r--lisp/net/soap-inspect.el2
-rw-r--r--lisp/net/socks.el2
-rw-r--r--lisp/net/starttls.el4
-rw-r--r--lisp/net/telnet.el2
-rw-r--r--lisp/net/tls.el4
-rw-r--r--lisp/net/tramp-adb.el177
-rw-r--r--lisp/net/tramp-cache.el14
-rw-r--r--lisp/net/tramp-cmds.el4
-rw-r--r--lisp/net/tramp-compat.el65
-rw-r--r--lisp/net/tramp-ftp.el10
-rw-r--r--lisp/net/tramp-gvfs.el146
-rw-r--r--lisp/net/tramp-sh.el532
-rw-r--r--lisp/net/tramp-smb.el295
-rw-r--r--lisp/net/tramp-uu.el2
-rw-r--r--lisp/net/tramp.el783
-rw-r--r--lisp/net/trampver.el12
-rw-r--r--lisp/net/webjump.el8
-rw-r--r--lisp/net/zeroconf.el2
-rw-r--r--lisp/newcomment.el49
-rw-r--r--lisp/notifications.el2
-rw-r--r--lisp/novice.el2
-rw-r--r--lisp/nxml/nxml-enc.el4
-rw-r--r--lisp/nxml/nxml-maint.el2
-rw-r--r--lisp/nxml/nxml-mode.el2
-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.el7
-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.el2
-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.el4
-rw-r--r--lisp/obsolete/cc-compat.el8
-rw-r--r--lisp/obsolete/cl-compat.el2
-rw-r--r--lisp/obsolete/complete.el4
-rw-r--r--lisp/obsolete/crisp.el2
-rw-r--r--lisp/obsolete/cust-print.el2
-rw-r--r--lisp/obsolete/erc-hecomplete.el3
-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.el (renamed from lisp/net/html2text.el)9
-rw-r--r--lisp/obsolete/iswitchb.el2
-rw-r--r--lisp/obsolete/landmark.el4
-rw-r--r--lisp/obsolete/lazy-lock.el2
-rw-r--r--lisp/obsolete/ledit.el2
-rw-r--r--lisp/obsolete/levents.el4
-rw-r--r--lisp/obsolete/lmenu.el2
-rw-r--r--lisp/obsolete/longlines.el2
-rw-r--r--lisp/obsolete/lucid.el2
-rw-r--r--lisp/obsolete/messcompat.el2
-rw-r--r--lisp/obsolete/mouse-sel.el2
-rw-r--r--lisp/obsolete/old-emacs-lock.el2
-rw-r--r--lisp/obsolete/old-whitespace.el2
-rw-r--r--lisp/obsolete/options.el2
-rw-r--r--lisp/obsolete/otodo-mode.el4
-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/sregex.el2
-rw-r--r--lisp/obsolete/sup-mouse.el2
-rw-r--r--lisp/obsolete/terminal.el2
-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/vc-arch.el2
-rw-r--r--lisp/obsolete/vip.el2
-rw-r--r--lisp/obsolete/ws-mode.el2
-rw-r--r--lisp/obsolete/xesam.el2
-rw-r--r--lisp/obsolete/yow.el2
-rw-r--r--lisp/org/ChangeLog.112
-rw-r--r--lisp/org/ob-C.el446
-rw-r--r--lisp/org/ob-J.el186
-rw-r--r--lisp/org/ob-R.el272
-rw-r--r--lisp/org/ob-abc.el90
-rw-r--r--lisp/org/ob-asymptote.el48
-rw-r--r--lisp/org/ob-awk.el49
-rw-r--r--lisp/org/ob-calc.el22
-rw-r--r--lisp/org/ob-clojure.el193
-rw-r--r--lisp/org/ob-comint.el111
-rw-r--r--lisp/org/ob-coq.el78
-rw-r--r--lisp/org/ob-core.el2873
-rw-r--r--lisp/org/ob-css.el10
-rw-r--r--lisp/org/ob-ditaa.el38
-rw-r--r--lisp/org/ob-dot.el19
-rw-r--r--lisp/org/ob-ebnf.el81
-rw-r--r--lisp/org/ob-emacs-lisp.el78
-rw-r--r--lisp/org/ob-eval.el36
-rw-r--r--lisp/org/ob-exp.el535
-rw-r--r--lisp/org/ob-forth.el87
-rw-r--r--lisp/org/ob-fortran.el63
-rw-r--r--lisp/org/ob-gnuplot.el80
-rw-r--r--lisp/org/ob-groovy.el116
-rw-r--r--lisp/org/ob-haskell.el59
-rw-r--r--lisp/org/ob-hledger.el70
-rw-r--r--lisp/org/ob-io.el48
-rw-r--r--lisp/org/ob-java.el48
-rw-r--r--lisp/org/ob-js.el30
-rw-r--r--lisp/org/ob-keys.el9
-rw-r--r--lisp/org/ob-latex.el161
-rw-r--r--lisp/org/ob-ledger.el9
-rw-r--r--lisp/org/ob-lilypond.el188
-rw-r--r--lisp/org/ob-lisp.el96
-rw-r--r--lisp/org/ob-lob.el195
-rw-r--r--lisp/org/ob-lua.el403
-rw-r--r--lisp/org/ob-makefile.el10
-rw-r--r--lisp/org/ob-matlab.el4
-rw-r--r--lisp/org/ob-maxima.el27
-rw-r--r--lisp/org/ob-mscgen.el12
-rw-r--r--lisp/org/ob-ocaml.el87
-rw-r--r--lisp/org/ob-octave.el84
-rw-r--r--lisp/org/ob-org.el10
-rw-r--r--lisp/org/ob-perl.el33
-rw-r--r--lisp/org/ob-picolisp.el16
-rw-r--r--lisp/org/ob-plantuml.el57
-rw-r--r--lisp/org/ob-processing.el195
-rw-r--r--lisp/org/ob-python.el113
-rw-r--r--lisp/org/ob-ref.el232
-rw-r--r--lisp/org/ob-ruby.el130
-rw-r--r--lisp/org/ob-sass.el11
-rw-r--r--lisp/org/ob-scala.el124
-rw-r--r--lisp/org/ob-scheme.el177
-rw-r--r--lisp/org/ob-screen.el22
-rw-r--r--lisp/org/ob-sed.el105
-rw-r--r--lisp/org/ob-sh.el217
-rw-r--r--lisp/org/ob-shell.el283
-rw-r--r--lisp/org/ob-shen.el11
-rw-r--r--lisp/org/ob-sql.el262
-rw-r--r--lisp/org/ob-sqlite.el30
-rw-r--r--lisp/org/ob-stan.el84
-rw-r--r--lisp/org/ob-table.el46
-rw-r--r--lisp/org/ob-tangle.el399
-rw-r--r--lisp/org/ob-vala.el117
-rw-r--r--lisp/org/ob.el4
-rw-r--r--lisp/org/org-agenda.el4131
-rw-r--r--lisp/org/org-archive.el430
-rw-r--r--lisp/org/org-attach.el230
-rw-r--r--lisp/org/org-bbdb.el147
-rw-r--r--lisp/org/org-bibtex.el176
-rw-r--r--lisp/org/org-capture.el1461
-rw-r--r--lisp/org/org-clock.el2154
-rw-r--r--lisp/org/org-colview.el2334
-rw-r--r--lisp/org/org-compat.el900
-rw-r--r--lisp/org/org-crypt.el143
-rw-r--r--lisp/org/org-ctags.el103
-rw-r--r--lisp/org/org-datetree.el297
-rw-r--r--lisp/org/org-docview.el34
-rw-r--r--lisp/org/org-duration.el448
-rw-r--r--lisp/org/org-element.el5804
-rw-r--r--lisp/org/org-entities.el1010
-rw-r--r--lisp/org/org-eshell.el11
-rw-r--r--lisp/org/org-eww.el175
-rw-r--r--lisp/org/org-faces.el557
-rw-r--r--lisp/org/org-feed.el165
-rw-r--r--lisp/org/org-footnote.el1208
-rw-r--r--lisp/org/org-gnus.el327
-rw-r--r--lisp/org/org-habit.el124
-rw-r--r--lisp/org/org-id.el33
-rw-r--r--lisp/org/org-indent.el297
-rw-r--r--lisp/org/org-info.el103
-rw-r--r--lisp/org/org-inlinetask.el54
-rw-r--r--lisp/org/org-irc.el45
-rw-r--r--lisp/org/org-lint.el1242
-rw-r--r--lisp/org/org-list.el1551
-rw-r--r--lisp/org/org-macro.el321
-rw-r--r--lisp/org/org-macs.el305
-rw-r--r--lisp/org/org-mhe.el45
-rw-r--r--lisp/org/org-mobile.el309
-rw-r--r--lisp/org/org-mouse.el170
-rw-r--r--lisp/org/org-pcomplete.el110
-rw-r--r--lisp/org/org-plot.el235
-rw-r--r--lisp/org/org-protocol.el374
-rw-r--r--lisp/org/org-rmail.el28
-rw-r--r--lisp/org/org-src.el1580
-rw-r--r--lisp/org/org-table.el4841
-rw-r--r--lisp/org/org-timer.el378
-rw-r--r--lisp/org/org-version.el10
-rw-r--r--lisp/org/org-w3m.el18
-rw-r--r--lisp/org/org.el20097
-rw-r--r--lisp/org/ox-ascii.el1255
-rw-r--r--lisp/org/ox-beamer.el434
-rw-r--r--lisp/org/ox-html.el2544
-rw-r--r--lisp/org/ox-icalendar.el540
-rw-r--r--lisp/org/ox-latex.el2587
-rw-r--r--lisp/org/ox-man.el499
-rw-r--r--lisp/org/ox-md.el457
-rw-r--r--lisp/org/ox-odt.el1808
-rw-r--r--lisp/org/ox-org.el157
-rw-r--r--lisp/org/ox-publish.el1247
-rw-r--r--lisp/org/ox-texinfo.el1210
-rw-r--r--lisp/org/ox.el4913
-rw-r--r--lisp/outline.el2
-rw-r--r--lisp/paren.el30
-rw-r--r--lisp/password-cache.el32
-rw-r--r--lisp/pcmpl-cvs.el2
-rw-r--r--lisp/pcmpl-gnu.el2
-rw-r--r--lisp/pcmpl-linux.el2
-rw-r--r--lisp/pcmpl-rpm.el2
-rw-r--r--lisp/pcmpl-unix.el2
-rw-r--r--lisp/pcmpl-x.el2
-rw-r--r--lisp/pcomplete.el4
-rw-r--r--lisp/pixel-scroll.el190
-rw-r--r--lisp/play/5x5.el2
-rw-r--r--lisp/play/animate.el2
-rw-r--r--lisp/play/blackbox.el2
-rw-r--r--lisp/play/bubbles.el2
-rw-r--r--lisp/play/cookie1.el2
-rw-r--r--lisp/play/decipher.el2
-rw-r--r--lisp/play/dissociate.el2
-rw-r--r--lisp/play/doctor.el2
-rw-r--r--lisp/play/dunnet.el2
-rw-r--r--lisp/play/fortune.el2
-rw-r--r--lisp/play/gamegrid.el180
-rw-r--r--lisp/play/gametree.el2
-rw-r--r--lisp/play/gomoku.el4
-rw-r--r--lisp/play/handwrite.el2
-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.el2
-rw-r--r--lisp/play/spook.el2
-rw-r--r--lisp/play/tetris.el2
-rw-r--r--lisp/play/zone.el2
-rw-r--r--lisp/plstore.el9
-rw-r--r--lisp/printing.el16
-rw-r--r--lisp/proced.el13
-rw-r--r--lisp/profiler.el2
-rw-r--r--lisp/progmodes/ada-mode.el2
-rw-r--r--lisp/progmodes/ada-prj.el2
-rw-r--r--lisp/progmodes/ada-stmt.el2
-rw-r--r--lisp/progmodes/ada-xref.el2
-rw-r--r--lisp/progmodes/antlr-mode.el4
-rw-r--r--lisp/progmodes/asm-mode.el2
-rw-r--r--lisp/progmodes/autoconf.el2
-rw-r--r--lisp/progmodes/bat-mode.el8
-rw-r--r--lisp/progmodes/bug-reference.el8
-rw-r--r--lisp/progmodes/cc-align.el34
-rw-r--r--lisp/progmodes/cc-awk.el6
-rw-r--r--lisp/progmodes/cc-bytecomp.el5
-rw-r--r--lisp/progmodes/cc-cmds.el74
-rw-r--r--lisp/progmodes/cc-defs.el132
-rw-r--r--lisp/progmodes/cc-engine.el480
-rw-r--r--lisp/progmodes/cc-fonts.el265
-rw-r--r--lisp/progmodes/cc-guess.el5
-rw-r--r--lisp/progmodes/cc-langs.el87
-rw-r--r--lisp/progmodes/cc-menus.el4
-rw-r--r--lisp/progmodes/cc-mode.el445
-rw-r--r--lisp/progmodes/cc-styles.el3
-rw-r--r--lisp/progmodes/cc-vars.el20
-rw-r--r--lisp/progmodes/cfengine.el2
-rw-r--r--lisp/progmodes/cmacexp.el2
-rw-r--r--lisp/progmodes/compile.el94
-rw-r--r--lisp/progmodes/cperl-mode.el33
-rw-r--r--lisp/progmodes/cpp.el21
-rw-r--r--lisp/progmodes/cwarn.el2
-rw-r--r--lisp/progmodes/dcl-mode.el2
-rw-r--r--lisp/progmodes/ebnf-abn.el6
-rw-r--r--lisp/progmodes/ebnf-bnf.el6
-rw-r--r--lisp/progmodes/ebnf-dtd.el6
-rw-r--r--lisp/progmodes/ebnf-ebx.el6
-rw-r--r--lisp/progmodes/ebnf-iso.el6
-rw-r--r--lisp/progmodes/ebnf-otz.el6
-rw-r--r--lisp/progmodes/ebnf-yac.el6
-rw-r--r--lisp/progmodes/ebnf2ps.el104
-rw-r--r--lisp/progmodes/ebrowse.el4
-rw-r--r--lisp/progmodes/elisp-mode.el209
-rw-r--r--lisp/progmodes/etags.el64
-rw-r--r--lisp/progmodes/executable.el38
-rw-r--r--lisp/progmodes/f90.el36
-rw-r--r--lisp/progmodes/flymake-proc.el1208
-rw-r--r--lisp/progmodes/flymake.el2562
-rw-r--r--lisp/progmodes/fortran.el2
-rw-r--r--lisp/progmodes/gdb-mi.el23
-rw-r--r--lisp/progmodes/glasses.el2
-rw-r--r--lisp/progmodes/grep.el109
-rw-r--r--lisp/progmodes/gud.el4
-rw-r--r--lisp/progmodes/hideif.el6
-rw-r--r--lisp/progmodes/hideshow.el2
-rw-r--r--lisp/progmodes/icon.el2
-rw-r--r--lisp/progmodes/idlw-complete-structtag.el10
-rw-r--r--lisp/progmodes/idlw-help.el2
-rw-r--r--lisp/progmodes/idlw-shell.el2
-rw-r--r--lisp/progmodes/idlw-toolbar.el2
-rw-r--r--lisp/progmodes/idlwave.el4
-rw-r--r--lisp/progmodes/inf-lisp.el2
-rw-r--r--lisp/progmodes/js.el36
-rw-r--r--lisp/progmodes/ld-script.el11
-rw-r--r--lisp/progmodes/m4-mode.el2
-rw-r--r--lisp/progmodes/make-mode.el2
-rw-r--r--lisp/progmodes/mantemp.el2
-rw-r--r--lisp/progmodes/meta-mode.el2
-rw-r--r--lisp/progmodes/mixal-mode.el4
-rw-r--r--lisp/progmodes/octave.el12
-rw-r--r--lisp/progmodes/opascal.el2
-rw-r--r--lisp/progmodes/pascal.el2
-rw-r--r--lisp/progmodes/perl-mode.el127
-rw-r--r--lisp/progmodes/prog-mode.el12
-rw-r--r--lisp/progmodes/project.el8
-rw-r--r--lisp/progmodes/prolog.el14
-rw-r--r--lisp/progmodes/ps-mode.el2
-rw-r--r--lisp/progmodes/python.el212
-rw-r--r--lisp/progmodes/ruby-mode.el136
-rw-r--r--lisp/progmodes/scheme.el2
-rw-r--r--lisp/progmodes/sh-script.el116
-rw-r--r--lisp/progmodes/simula.el2
-rw-r--r--lisp/progmodes/sql.el228
-rw-r--r--lisp/progmodes/subword.el2
-rw-r--r--lisp/progmodes/tcl.el7
-rw-r--r--lisp/progmodes/vera-mode.el2
-rw-r--r--lisp/progmodes/verilog-mode.el368
-rw-r--r--lisp/progmodes/vhdl-mode.el4
-rw-r--r--lisp/progmodes/which-func.el2
-rw-r--r--lisp/progmodes/xref.el133
-rw-r--r--lisp/progmodes/xscheme.el27
-rw-r--r--lisp/ps-bdf.el2
-rw-r--r--lisp/ps-def.el6
-rw-r--r--lisp/ps-mule.el6
-rw-r--r--lisp/ps-print.el14
-rw-r--r--lisp/ps-samp.el6
-rw-r--r--lisp/recentf.el2
-rw-r--r--lisp/rect.el6
-rw-r--r--lisp/register.el13
-rw-r--r--lisp/registry.el2
-rw-r--r--lisp/repeat.el2
-rw-r--r--lisp/replace.el424
-rw-r--r--lisp/reposition.el2
-rw-r--r--lisp/reveal.el2
-rw-r--r--lisp/rfn-eshadow.el2
-rw-r--r--lisp/rot13.el2
-rw-r--r--lisp/rtree.el2
-rw-r--r--lisp/ruler-mode.el33
-rw-r--r--lisp/savehist.el2
-rw-r--r--lisp/saveplace.el2
-rw-r--r--lisp/sb-image.el2
-rw-r--r--lisp/scroll-all.el2
-rw-r--r--lisp/scroll-bar.el2
-rw-r--r--lisp/scroll-lock.el2
-rw-r--r--lisp/select.el7
-rw-r--r--lisp/server.el52
-rw-r--r--lisp/ses.el290
-rw-r--r--lisp/shadowfile.el2
-rw-r--r--lisp/shell.el6
-rw-r--r--lisp/simple.el337
-rw-r--r--lisp/skeleton.el2
-rw-r--r--lisp/sort.el4
-rw-r--r--lisp/soundex.el15
-rw-r--r--lisp/speedbar.el2
-rw-r--r--lisp/startup.el39
-rw-r--r--lisp/strokes.el2
-rw-r--r--lisp/subr.el152
-rw-r--r--lisp/svg.el32
-rw-r--r--lisp/t-mouse.el2
-rw-r--r--lisp/tabify.el2
-rw-r--r--lisp/talk.el2
-rw-r--r--lisp/tar-mode.el6
-rw-r--r--lisp/tempo.el2
-rw-r--r--lisp/term.el108
-rw-r--r--lisp/term/AT386.el2
-rw-r--r--lisp/term/README2
-rw-r--r--lisp/term/common-win.el2
-rw-r--r--lisp/term/internal.el2
-rw-r--r--lisp/term/iris-ansi.el2
-rw-r--r--lisp/term/konsole.el12
-rw-r--r--lisp/term/news.el2
-rw-r--r--lisp/term/ns-win.el31
-rw-r--r--lisp/term/pc-win.el2
-rw-r--r--lisp/term/rxvt.el2
-rw-r--r--lisp/term/sun.el2
-rw-r--r--lisp/term/tty-colors.el2
-rw-r--r--lisp/term/tvi970.el10
-rw-r--r--lisp/term/vt100.el2
-rw-r--r--lisp/term/w32-win.el7
-rw-r--r--lisp/term/w32console.el2
-rw-r--r--lisp/term/wyse50.el2
-rw-r--r--lisp/term/x-win.el6
-rw-r--r--lisp/term/xterm.el39
-rw-r--r--lisp/textmodes/artist.el4
-rw-r--r--lisp/textmodes/bib-mode.el2
-rw-r--r--lisp/textmodes/bibtex-style.el2
-rw-r--r--lisp/textmodes/bibtex.el2
-rw-r--r--lisp/textmodes/conf-mode.el94
-rw-r--r--lisp/textmodes/css-mode.el40
-rw-r--r--lisp/textmodes/dns-mode.el5
-rw-r--r--lisp/textmodes/enriched.el22
-rw-r--r--lisp/textmodes/fill.el2
-rw-r--r--lisp/textmodes/flyspell.el4
-rw-r--r--lisp/textmodes/ispell.el141
-rw-r--r--lisp/textmodes/less-css-mode.el232
-rw-r--r--lisp/textmodes/makeinfo.el2
-rw-r--r--lisp/textmodes/mhtml-mode.el31
-rw-r--r--lisp/textmodes/nroff-mode.el4
-rw-r--r--lisp/textmodes/page-ext.el77
-rw-r--r--lisp/textmodes/page.el2
-rw-r--r--lisp/textmodes/paragraphs.el2
-rw-r--r--lisp/textmodes/picture.el4
-rw-r--r--lisp/textmodes/po.el2
-rw-r--r--lisp/textmodes/refbib.el2
-rw-r--r--lisp/textmodes/refer.el2
-rw-r--r--lisp/textmodes/refill.el2
-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.el4
-rw-r--r--lisp/textmodes/reftex-parse.el2
-rw-r--r--lisp/textmodes/reftex-ref.el6
-rw-r--r--lisp/textmodes/reftex-sel.el2
-rw-r--r--lisp/textmodes/reftex-toc.el4
-rw-r--r--lisp/textmodes/reftex-vars.el4
-rw-r--r--lisp/textmodes/reftex.el11
-rw-r--r--lisp/textmodes/remember.el14
-rw-r--r--lisp/textmodes/rst.el67
-rw-r--r--lisp/textmodes/sgml-mode.el10
-rw-r--r--lisp/textmodes/table.el2
-rw-r--r--lisp/textmodes/tex-mode.el68
-rw-r--r--lisp/textmodes/texinfmt.el4
-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.el2
-rw-r--r--lisp/textmodes/underline.el2
-rw-r--r--lisp/thingatpt.el34
-rw-r--r--lisp/thumbs.el17
-rw-r--r--lisp/time-stamp.el2
-rw-r--r--lisp/time.el35
-rw-r--r--lisp/timezone.el2
-rw-r--r--lisp/tmm.el2
-rw-r--r--lisp/tool-bar.el2
-rw-r--r--lisp/tooltip.el23
-rw-r--r--lisp/tree-widget.el4
-rw-r--r--lisp/tutorial.el2
-rw-r--r--lisp/type-break.el10
-rw-r--r--lisp/uniquify.el2
-rw-r--r--lisp/url/ChangeLog.14
-rw-r--r--lisp/url/url-about.el2
-rw-r--r--lisp/url/url-auth.el2
-rw-r--r--lisp/url/url-cache.el4
-rw-r--r--lisp/url/url-cid.el2
-rw-r--r--lisp/url/url-cookie.el147
-rw-r--r--lisp/url/url-dav.el2
-rw-r--r--lisp/url/url-dired.el2
-rw-r--r--lisp/url/url-domsuf.el2
-rw-r--r--lisp/url/url-expand.el4
-rw-r--r--lisp/url/url-file.el2
-rw-r--r--lisp/url/url-ftp.el2
-rw-r--r--lisp/url/url-future.el2
-rw-r--r--lisp/url/url-gw.el8
-rw-r--r--lisp/url/url-handlers.el6
-rw-r--r--lisp/url/url-history.el11
-rw-r--r--lisp/url/url-http.el5
-rw-r--r--lisp/url/url-imap.el2
-rw-r--r--lisp/url/url-irc.el2
-rw-r--r--lisp/url/url-ldap.el2
-rw-r--r--lisp/url/url-mailto.el4
-rw-r--r--lisp/url/url-methods.el2
-rw-r--r--lisp/url/url-misc.el2
-rw-r--r--lisp/url/url-news.el2
-rw-r--r--lisp/url/url-nfs.el2
-rw-r--r--lisp/url/url-ns.el2
-rw-r--r--lisp/url/url-parse.el5
-rw-r--r--lisp/url/url-privacy.el2
-rw-r--r--lisp/url/url-proxy.el2
-rw-r--r--lisp/url/url-queue.el4
-rw-r--r--lisp/url/url-tramp.el60
-rw-r--r--lisp/url/url-util.el4
-rw-r--r--lisp/url/url-vars.el2
-rw-r--r--lisp/url/url.el9
-rw-r--r--lisp/userlock.el2
-rw-r--r--lisp/vc/add-log.el2
-rw-r--r--lisp/vc/compare-w.el2
-rw-r--r--lisp/vc/cvs-status.el2
-rw-r--r--lisp/vc/diff-mode.el96
-rw-r--r--lisp/vc/diff.el2
-rw-r--r--lisp/vc/ediff-diff.el2
-rw-r--r--lisp/vc/ediff-help.el2
-rw-r--r--lisp/vc/ediff-hook.el2
-rw-r--r--lisp/vc/ediff-init.el2
-rw-r--r--lisp/vc/ediff-merg.el2
-rw-r--r--lisp/vc/ediff-mult.el2
-rw-r--r--lisp/vc/ediff-ptch.el2
-rw-r--r--lisp/vc/ediff-util.el2
-rw-r--r--lisp/vc/ediff-vers.el2
-rw-r--r--lisp/vc/ediff-wind.el243
-rw-r--r--lisp/vc/ediff.el127
-rw-r--r--lisp/vc/log-edit.el4
-rw-r--r--lisp/vc/log-view.el16
-rw-r--r--lisp/vc/pcvs-defs.el4
-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.el2
-rw-r--r--lisp/vc/smerge-mode.el70
-rw-r--r--lisp/vc/vc-annotate.el2
-rw-r--r--lisp/vc/vc-bzr.el2
-rw-r--r--lisp/vc/vc-cvs.el2
-rw-r--r--lisp/vc/vc-dav.el2
-rw-r--r--lisp/vc/vc-dir.el2
-rw-r--r--lisp/vc/vc-dispatcher.el2
-rw-r--r--lisp/vc/vc-filewise.el2
-rw-r--r--lisp/vc/vc-git.el36
-rw-r--r--lisp/vc/vc-hg.el54
-rw-r--r--lisp/vc/vc-hooks.el4
-rw-r--r--lisp/vc/vc-mtn.el2
-rw-r--r--lisp/vc/vc-rcs.el6
-rw-r--r--lisp/vc/vc-sccs.el2
-rw-r--r--lisp/vc/vc-src.el4
-rw-r--r--lisp/vc/vc-svn.el6
-rw-r--r--lisp/vc/vc.el3
-rw-r--r--lisp/vcursor.el2
-rw-r--r--lisp/version.el2
-rw-r--r--lisp/view.el4
-rw-r--r--lisp/vt-control.el2
-rw-r--r--lisp/vt100-led.el2
-rw-r--r--lisp/w32-fns.el2
-rw-r--r--lisp/w32-vars.el2
-rw-r--r--lisp/wdired.el2
-rw-r--r--lisp/whitespace.el11
-rw-r--r--lisp/wid-browse.el2
-rw-r--r--lisp/wid-edit.el24
-rw-r--r--lisp/widget.el2
-rw-r--r--lisp/windmove.el4
-rw-r--r--lisp/window.el763
-rw-r--r--lisp/winner.el17
-rw-r--r--lisp/woman.el25
-rw-r--r--lisp/x-dnd.el2
-rw-r--r--lisp/xdg.el193
-rw-r--r--lisp/xml.el2
-rw-r--r--lisp/xt-mouse.el16
-rw-r--r--lisp/xwidget.el2
-rw-r--r--lwlib/COPYING8
-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-Xm.h2
-rw-r--r--lwlib/lwlib-int.h2
-rw-r--r--lwlib/lwlib-utils.c2
-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/alloca.m44
-rw-r--r--m4/d-type.m432
-rw-r--r--m4/dirfd.m49
-rw-r--r--m4/explicit_bzero.m422
-rw-r--r--m4/extensions.m412
-rw-r--r--m4/extern-inline.m48
-rw-r--r--m4/faccessat.m410
-rw-r--r--m4/fstatat.m421
-rw-r--r--m4/fsusage.m4336
-rw-r--r--m4/getdtablesize.m454
-rw-r--r--m4/getgroups.m42
-rw-r--r--m4/gettimeofday.m44
-rw-r--r--m4/gnulib-common.m46
-rw-r--r--m4/gnulib-comp.m4112
-rw-r--r--m4/lstat.m411
-rw-r--r--m4/manywarnings.m442
-rw-r--r--m4/mktime.m414
-rw-r--r--m4/mode_t.m426
-rw-r--r--m4/nstrftime.m4 (renamed from m4/strftime.m4)0
-rw-r--r--m4/open-cloexec.m421
-rw-r--r--m4/open.m495
-rw-r--r--m4/pselect.m45
-rw-r--r--m4/putenv.m44
-rw-r--r--m4/secure_getenv.m426
-rw-r--r--m4/std-gnu11.m46
-rw-r--r--m4/stdalign.m42
-rw-r--r--m4/stdint.m4108
-rw-r--r--m4/stdlib_h.m412
-rw-r--r--m4/string_h.m414
-rw-r--r--m4/strtoimax.m412
-rw-r--r--m4/sys_types_h.m46
-rw-r--r--m4/unistd_h.m43
-rw-r--r--m4/unlocked-io.m441
-rw-r--r--m4/utimes.m422
-rw-r--r--m4/vararrays.m42
-rw-r--r--m4/warnings.m449
-rwxr-xr-xmake-dist14
-rwxr-xr-xmodules/modhelp.py2
-rw-r--r--msdos/COPYING8
-rw-r--r--msdos/ChangeLog.12
-rw-r--r--msdos/INSTALL2
-rw-r--r--msdos/README2
-rw-r--r--msdos/autogen/config.in7
-rw-r--r--msdos/depfiles.bat4
-rw-r--r--msdos/inttypes.h2
-rw-r--r--msdos/mainmake.v22
-rw-r--r--msdos/sed1v2.inp40
-rw-r--r--msdos/sed2v2.inp35
-rw-r--r--msdos/sed3v2.inp6
-rw-r--r--msdos/sedlibmk.inp123
-rw-r--r--msdos/sedlisp.inp1
-rw-r--r--nextstep/ChangeLog.12
-rw-r--r--nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html2
-rw-r--r--nextstep/INSTALL18
-rw-r--r--nextstep/Makefile.in2
-rw-r--r--nextstep/README2
-rw-r--r--nextstep/templates/Info.plist.in2
-rw-r--r--nt/COPYING8
-rw-r--r--nt/ChangeLog.120
-rw-r--r--nt/INSTALL21
-rw-r--r--nt/INSTALL.W6491
-rw-r--r--nt/Makefile.in2
-rw-r--r--nt/README12
-rw-r--r--nt/README.W3212
-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/epaths.nt3
-rw-r--r--nt/gnulib-cfg.mk6
-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.h17
-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.site1
-rw-r--r--nt/preprep.c2
-rw-r--r--nt/runemacs.c2
-rw-r--r--oldXMenu/Activate.c3
-rw-r--r--oldXMenu/ChangeLog.14
-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/.gdbinit61
-rw-r--r--src/COPYING8
-rw-r--r--src/ChangeLog.12
-rw-r--r--src/ChangeLog.104
-rw-r--r--src/ChangeLog.1124
-rw-r--r--src/ChangeLog.12178
-rw-r--r--src/ChangeLog.13138
-rw-r--r--src/ChangeLog.22
-rw-r--r--src/ChangeLog.32
-rw-r--r--src/ChangeLog.44
-rw-r--r--src/ChangeLog.54
-rw-r--r--src/ChangeLog.62
-rw-r--r--src/ChangeLog.74
-rw-r--r--src/ChangeLog.82
-rw-r--r--src/ChangeLog.92
-rw-r--r--src/Makefile.in16
-rw-r--r--src/README2
-rw-r--r--src/alloc.c610
-rw-r--r--src/atimer.c4
-rw-r--r--src/atimer.h2
-rw-r--r--src/bidi.c45
-rw-r--r--src/blockinput.h2
-rw-r--r--src/buffer.c143
-rw-r--r--src/buffer.h10
-rw-r--r--src/bytecode.c24
-rw-r--r--src/callint.c9
-rw-r--r--src/callproc.c6
-rw-r--r--src/casefiddle.c6
-rw-r--r--src/casetab.c2
-rw-r--r--src/category.c2
-rw-r--r--src/category.h2
-rw-r--r--src/ccl.c4
-rw-r--r--src/ccl.h2
-rw-r--r--src/character.c19
-rw-r--r--src/character.h20
-rw-r--r--src/charset.c96
-rw-r--r--src/charset.h2
-rw-r--r--src/chartab.c2
-rw-r--r--src/cm.c16
-rw-r--r--src/cm.h2
-rw-r--r--src/cmds.c24
-rw-r--r--src/coding.c10
-rw-r--r--src/coding.h2
-rw-r--r--src/commands.h2
-rw-r--r--src/composite.c17
-rw-r--r--src/composite.h2
-rw-r--r--src/conf_post.h26
-rw-r--r--src/cygw32.c2
-rw-r--r--src/cygw32.h2
-rw-r--r--src/data.c126
-rw-r--r--src/dbusbind.c8
-rw-r--r--src/decompress.c2
-rw-r--r--src/deps.mk2
-rw-r--r--src/dired.c166
-rw-r--r--src/dispextern.h67
-rw-r--r--src/dispnew.c84
-rw-r--r--src/disptab.h2
-rw-r--r--src/doc.c8
-rw-r--r--src/doprnt.c4
-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.c78
-rw-r--r--src/emacs-icon.h2
-rw-r--r--src/emacs-module.c49
-rw-r--r--src/emacs-module.h.in5
-rw-r--r--src/emacs.c29
-rw-r--r--src/emacsgtkfixed.c4
-rw-r--r--src/emacsgtkfixed.h2
-rw-r--r--src/epaths.in3
-rw-r--r--src/eval.c245
-rw-r--r--src/fileio.c704
-rw-r--r--src/filelock.c20
-rw-r--r--src/firstfile.c2
-rw-r--r--src/floatfns.c2
-rw-r--r--src/fns.c190
-rw-r--r--src/font.c36
-rw-r--r--src/font.h8
-rw-r--r--src/fontset.c4
-rw-r--r--src/fontset.h2
-rw-r--r--src/frame.c879
-rw-r--r--src/frame.h87
-rw-r--r--src/fringe.c2
-rw-r--r--src/ftcrfont.c8
-rw-r--r--src/ftfont.c2
-rw-r--r--src/ftfont.h2
-rw-r--r--src/ftxfont.c2
-rw-r--r--src/getpagesize.h2
-rw-r--r--src/gfilenotify.c4
-rw-r--r--src/gmalloc.c112
-rw-r--r--src/gnutls.c1030
-rw-r--r--src/gnutls.h8
-rw-r--r--src/gtkutil.c133
-rw-r--r--src/gtkutil.h7
-rw-r--r--src/image.c209
-rw-r--r--src/indent.c100
-rw-r--r--src/indent.h2
-rw-r--r--src/inotify.c2
-rw-r--r--src/insdel.c2
-rw-r--r--src/intervals.c71
-rw-r--r--src/intervals.h17
-rw-r--r--src/keyboard.c144
-rw-r--r--src/keyboard.h5
-rw-r--r--src/keymap.c4
-rw-r--r--src/keymap.h2
-rw-r--r--src/kqueue.c6
-rw-r--r--src/lastfile.c5
-rw-r--r--src/lcms.c604
-rw-r--r--src/lisp.h392
-rw-r--r--src/lread.c545
-rw-r--r--src/macfont.h6
-rw-r--r--src/macfont.m26
-rw-r--r--src/macros.c2
-rw-r--r--src/macros.h2
-rw-r--r--src/marker.c2
-rw-r--r--src/menu.c98
-rw-r--r--src/menu.h3
-rw-r--r--src/minibuf.c55
-rw-r--r--src/module-env-25.h2
-rw-r--r--src/msdos.c23
-rw-r--r--src/msdos.h5
-rw-r--r--src/nsfns.m149
-rw-r--r--src/nsfont.m4
-rw-r--r--src/nsgui.h2
-rw-r--r--src/nsimage.m189
-rw-r--r--src/nsmenu.m11
-rw-r--r--src/nsselect.m2
-rw-r--r--src/nsterm.h77
-rw-r--r--src/nsterm.m605
-rw-r--r--src/print.c65
-rw-r--r--src/process.c142
-rw-r--r--src/process.h4
-rw-r--r--src/profiler.c2
-rw-r--r--src/puresize.h2
-rw-r--r--src/ralloc.c2
-rw-r--r--src/regex.c46
-rw-r--r--src/regex.h4
-rw-r--r--src/region-cache.c2
-rw-r--r--src/region-cache.h2
-rw-r--r--src/scroll.c4
-rw-r--r--src/search.c2
-rw-r--r--src/sheap.c2
-rw-r--r--src/sheap.h2
-rw-r--r--src/sound.c5
-rw-r--r--src/syntax.c2
-rw-r--r--src/syntax.h2
-rw-r--r--src/sysdep.c159
-rw-r--r--src/sysselect.h7
-rw-r--r--src/syssignal.h2
-rw-r--r--src/sysstdio.h43
-rw-r--r--src/systhread.c20
-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.c73
-rw-r--r--src/termcap.c2
-rw-r--r--src/termchar.h2
-rw-r--r--src/termhooks.h10
-rw-r--r--src/terminal.c2
-rw-r--r--src/terminfo.c2
-rw-r--r--src/termopts.h2
-rw-r--r--src/textprop.c2
-rw-r--r--src/thread.c43
-rw-r--r--src/thread.h29
-rw-r--r--src/tparam.c9
-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.c29
-rw-r--r--src/unexmacosx.c2
-rw-r--r--src/unexw32.c28
-rw-r--r--src/vm-limit.c2
-rw-r--r--src/w16select.c2
-rw-r--r--src/w32.c145
-rw-r--r--src/w32.h2
-rw-r--r--src/w32common.h2
-rw-r--r--src/w32console.c6
-rw-r--r--src/w32fns.c80
-rw-r--r--src/w32font.c7
-rw-r--r--src/w32font.h2
-rw-r--r--src/w32gui.h2
-rw-r--r--src/w32heap.c8
-rw-r--r--src/w32heap.h2
-rw-r--r--src/w32inevt.c4
-rw-r--r--src/w32inevt.h2
-rw-r--r--src/w32menu.c2
-rw-r--r--src/w32notify.c8
-rw-r--r--src/w32proc.c99
-rw-r--r--src/w32reg.c2
-rw-r--r--src/w32select.c2
-rw-r--r--src/w32select.h2
-rw-r--r--src/w32term.c157
-rw-r--r--src/w32term.h27
-rw-r--r--src/w32uniscribe.c2
-rw-r--r--src/w32xfns.c2
-rw-r--r--src/widget.c15
-rw-r--r--src/widget.h4
-rw-r--r--src/widgetprv.h2
-rw-r--r--src/window.c250
-rw-r--r--src/window.h204
-rw-r--r--src/xdisp.c978
-rw-r--r--src/xfaces.c27
-rw-r--r--src/xfns.c162
-rw-r--r--src/xfont.c7
-rw-r--r--src/xftfont.c2
-rw-r--r--src/xgselect.c2
-rw-r--r--src/xgselect.h2
-rw-r--r--src/xmenu.c7
-rw-r--r--src/xml.c39
-rw-r--r--src/xrdb.c9
-rw-r--r--src/xselect.c2
-rw-r--r--src/xsettings.c6
-rw-r--r--src/xsettings.h2
-rw-r--r--src/xsmfns.c6
-rw-r--r--src/xterm.c177
-rw-r--r--src/xterm.h31
-rw-r--r--src/xwidget.c14
-rw-r--r--src/xwidget.h6
-rw-r--r--test/ChangeLog.14
-rw-r--r--test/Makefile.in40
-rw-r--r--test/README2
-rw-r--r--test/data/emacs-module/mod-test.c25
-rw-r--r--test/data/mailcap/mime.types5
-rw-r--r--test/data/xdg/l10n.desktop5
-rw-r--r--test/data/xdg/malformed.desktop4
-rw-r--r--test/data/xdg/mimeapps.list9
-rw-r--r--test/data/xdg/mimeinfo.cache4
-rw-r--r--test/data/xdg/test.desktop5
-rw-r--r--test/data/xdg/wrong.desktop2
-rw-r--r--test/file-organization.org2
-rw-r--r--test/lib-src/emacsclient-tests.el59
-rw-r--r--test/lisp/abbrev-tests.el2
-rw-r--r--test/lisp/arc-mode-tests.el37
-rw-r--r--test/lisp/auth-source-pass-tests.el7
-rw-r--r--test/lisp/auth-source-tests.el65
-rw-r--r--test/lisp/autorevert-tests.el2
-rw-r--r--test/lisp/buff-menu-tests.el4
-rw-r--r--test/lisp/calc/calc-tests.el6
-rw-r--r--test/lisp/calendar/icalendar-tests.el2
-rw-r--r--test/lisp/calendar/parse-time-tests.el2
-rw-r--r--test/lisp/calendar/todo-mode-resources/todo-test-1.toda6
-rw-r--r--test/lisp/calendar/todo-mode-resources/todo-test-1.todo14
-rw-r--r--test/lisp/calendar/todo-mode-tests.el504
-rw-r--r--test/lisp/char-fold-tests.el10
-rw-r--r--test/lisp/color-tests.el251
-rw-r--r--test/lisp/comint-tests.el2
-rw-r--r--test/lisp/dabbrev-tests.el2
-rw-r--r--test/lisp/descr-text-tests.el2
-rw-r--r--test/lisp/dired-aux-tests.el98
-rw-r--r--test/lisp/dired-tests.el393
-rw-r--r--test/lisp/dired-x-tests.el4
-rw-r--r--test/lisp/dom-tests.el7
-rw-r--r--test/lisp/electric-tests.el170
-rw-r--r--test/lisp/emacs-lisp/benchmark-tests.el2
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el34
-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.el26
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el34
-rw-r--r--test/lisp/emacs-lisp/cl-macs-tests.el500
-rw-r--r--test/lisp/emacs-lisp/cl-print-tests.el4
-rw-r--r--test/lisp/emacs-lisp/cl-seq-tests.el6
-rw-r--r--test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el134
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el917
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el4
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el36
-rw-r--r--test/lisp/emacs-lisp/eieio-tests/eieio-tests.el24
-rw-r--r--test/lisp/emacs-lisp/ert-tests.el21
-rw-r--r--test/lisp/emacs-lisp/ert-x-tests.el2
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el76
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el32
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/files/test1.txt15
-rw-r--r--test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup15
-rw-r--r--test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el269
-rw-r--r--test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el63
-rw-r--r--test/lisp/emacs-lisp/generator-tests.el12
-rw-r--r--test/lisp/emacs-lisp/gv-tests.el147
-rw-r--r--test/lisp/emacs-lisp/let-alist-tests.el2
-rw-r--r--test/lisp/emacs-lisp/lisp-mode-tests.el28
-rw-r--r--test/lisp/emacs-lisp/lisp-tests.el33
-rw-r--r--test/lisp/emacs-lisp/map-tests.el20
-rw-r--r--test/lisp/emacs-lisp/nadvice-tests.el2
-rw-r--r--test/lisp/emacs-lisp/package-tests.el2
-rw-r--r--test/lisp/emacs-lisp/pcase-tests.el2
-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.el41
-rw-r--r--test/lisp/emacs-lisp/rx-tests.el12
-rw-r--r--test/lisp/emacs-lisp/seq-tests.el2
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el315
-rw-r--r--test/lisp/emacs-lisp/tabulated-list-test.el2
-rw-r--r--test/lisp/emacs-lisp/testcover-resources/testcases.el50
-rw-r--r--test/lisp/emacs-lisp/testcover-tests.el14
-rw-r--r--test/lisp/emacs-lisp/thunk-tests.el52
-rw-r--r--test/lisp/emacs-lisp/timer-tests.el2
-rw-r--r--test/lisp/emulation/viper-tests.el2
-rw-r--r--test/lisp/epg-tests.el15
-rw-r--r--test/lisp/erc/erc-track-tests.el2
-rw-r--r--test/lisp/eshell/em-hist-tests.el39
-rw-r--r--test/lisp/eshell/em-ls-tests.el98
-rw-r--r--test/lisp/eshell/eshell-tests.el4
-rw-r--r--test/lisp/faces-tests.el2
-rw-r--r--test/lisp/ffap-tests.el8
-rw-r--r--test/lisp/filenotify-tests.el17
-rw-r--r--test/lisp/files-tests.el130
-rw-r--r--test/lisp/files-x-tests.el2
-rw-r--r--test/lisp/gnus/gnus-tests.el2
-rw-r--r--test/lisp/gnus/message-tests.el2
-rw-r--r--test/lisp/help-fns-tests.el11
-rw-r--r--test/lisp/hi-lock-tests.el16
-rw-r--r--test/lisp/htmlfontify-tests.el2
-rw-r--r--test/lisp/ibuffer-tests.el95
-rw-r--r--test/lisp/ido-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/mule-tests.el2
-rw-r--r--test/lisp/international/mule-util-tests.el2
-rw-r--r--test/lisp/international/ucs-normalize-tests.el249
-rw-r--r--test/lisp/isearch-tests.el2
-rw-r--r--test/lisp/jit-lock-tests.el2
-rw-r--r--test/lisp/json-tests.el6
-rw-r--r--test/lisp/kmacro-tests.el5
-rw-r--r--test/lisp/ls-lisp-tests.el94
-rw-r--r--test/lisp/mail/rmail-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.el34
-rw-r--r--test/lisp/mouse-tests.el2
-rw-r--r--test/lisp/net/dbus-tests.el2
-rw-r--r--test/lisp/net/gnutls-tests.el295
-rw-r--r--test/lisp/net/mailcap-tests.el69
-rw-r--r--test/lisp/net/network-stream-tests.el9
-rw-r--r--test/lisp/net/newsticker-tests.el2
-rw-r--r--test/lisp/net/puny-tests.el2
-rw-r--r--test/lisp/net/sasl-scram-rfc-tests.el2
-rw-r--r--test/lisp/net/shr-tests.el2
-rw-r--r--test/lisp/net/tramp-tests.el1835
-rw-r--r--test/lisp/obarray-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.el2
-rw-r--r--test/lisp/progmodes/elisp-mode-tests.el58
-rw-r--r--test/lisp/progmodes/etags-tests.el36
-rw-r--r--test/lisp/progmodes/f90-tests.el44
-rw-r--r--test/lisp/progmodes/flymake-resources/Makefile4
-rw-r--r--test/lisp/progmodes/flymake-resources/errors-and-warnings.c13
-rw-r--r--test/lisp/progmodes/flymake-resources/no-problems.h1
-rw-r--r--test/lisp/progmodes/flymake-resources/some-problems.h5
-rw-r--r--test/lisp/progmodes/flymake-resources/test.pl2
-rw-r--r--test/lisp/progmodes/flymake-resources/test.rb5
-rw-r--r--test/lisp/progmodes/flymake-tests.el361
-rw-r--r--test/lisp/progmodes/js-tests.el21
-rw-r--r--test/lisp/progmodes/python-tests.el49
-rw-r--r--test/lisp/progmodes/ruby-mode-tests.el2
-rw-r--r--test/lisp/progmodes/sql-tests.el12
-rw-r--r--test/lisp/progmodes/subword-tests.el8
-rw-r--r--test/lisp/progmodes/xref-tests.el2
-rw-r--r--test/lisp/ps-print-tests.el2
-rw-r--r--test/lisp/register-tests.el43
-rw-r--r--test/lisp/replace-tests.el28
-rw-r--r--test/lisp/rot13-tests.el2
-rw-r--r--test/lisp/ses-tests.el175
-rw-r--r--test/lisp/shell-tests.el2
-rw-r--r--test/lisp/simple-tests.el69
-rw-r--r--test/lisp/sort-tests.el2
-rw-r--r--test/lisp/soundex-tests.el43
-rw-r--r--test/lisp/subr-tests.el41
-rw-r--r--test/lisp/tar-mode-tests.el36
-rw-r--r--test/lisp/textmodes/css-mode-tests.el23
-rw-r--r--test/lisp/textmodes/dns-mode-tests.el2
-rw-r--r--test/lisp/textmodes/mhtml-mode-tests.el2
-rw-r--r--test/lisp/textmodes/reftex-tests.el2
-rw-r--r--test/lisp/textmodes/sgml-mode-tests.el2
-rw-r--r--test/lisp/textmodes/tildify-tests.el2
-rw-r--r--test/lisp/thingatpt-tests.el32
-rw-r--r--test/lisp/url/url-auth-tests.el2
-rw-r--r--test/lisp/url/url-expand-tests.el2
-rw-r--r--test/lisp/url/url-future-tests.el2
-rw-r--r--test/lisp/url/url-parse-tests.el2
-rw-r--r--test/lisp/url/url-tramp-tests.el83
-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.el6
-rw-r--r--test/lisp/vc/ediff-diff-tests.el2
-rw-r--r--test/lisp/vc/ediff-ptch-tests.el54
-rw-r--r--test/lisp/vc/smerge-mode-tests.el34
-rw-r--r--test/lisp/vc/vc-bzr-tests.el8
-rw-r--r--test/lisp/vc/vc-hg-tests.el2
-rw-r--r--test/lisp/vc/vc-tests.el2
-rw-r--r--test/lisp/whitespace-tests.el2
-rw-r--r--test/lisp/xdg-tests.el80
-rw-r--r--test/lisp/xml-tests.el2
-rw-r--r--test/lisp/xt-mouse-tests.el2
-rw-r--r--test/manual/BidiCharacterTest.txt6
-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-ia-utest.el4
-rw-r--r--test/manual/cedet/semantic-tests.el14
-rw-r--r--test/manual/cedet/semantic-utest-c.el2
-rw-r--r--test/manual/cedet/semantic-utest.el2
-rw-r--r--test/manual/cedet/srecode-tests.el2
-rw-r--r--test/manual/cedet/tests/test.c9
-rw-r--r--test/manual/cedet/tests/test.el2
-rw-r--r--test/manual/cedet/tests/test.make4
-rw-r--r--test/manual/cedet/tests/testdoublens.cpp3
-rw-r--r--test/manual/cedet/tests/testdoublens.hpp5
-rw-r--r--test/manual/cedet/tests/testjavacomp.java2
-rw-r--r--test/manual/cedet/tests/testpolymorph.cpp2
-rw-r--r--test/manual/cedet/tests/testspp.c3
-rw-r--r--test/manual/cedet/tests/testsppreplace.c3
-rw-r--r--test/manual/cedet/tests/testsppreplaced.c2
-rw-r--r--test/manual/cedet/tests/testsubclass.cpp3
-rw-r--r--test/manual/cedet/tests/testsubclass.hh7
-rw-r--r--test/manual/cedet/tests/testtypedefs.cpp3
-rw-r--r--test/manual/cedet/tests/testvarnames.c2
-rw-r--r--test/manual/etags/CTAGS.good8
-rw-r--r--test/manual/etags/ETAGS.good_126
-rw-r--r--test/manual/etags/ETAGS.good_226
-rw-r--r--test/manual/etags/ETAGS.good_326
-rw-r--r--test/manual/etags/ETAGS.good_426
-rw-r--r--test/manual/etags/ETAGS.good_526
-rw-r--r--test/manual/etags/ETAGS.good_626
-rw-r--r--test/manual/etags/Makefile3
-rw-r--r--test/manual/etags/c-src/emacs/src/gmalloc.c20
-rw-r--r--test/manual/etags/c-src/emacs/src/keyboard.c2
-rw-r--r--test/manual/etags/c-src/emacs/src/lisp.h4
-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/el-src/TAGTEST.EL1
-rw-r--r--test/manual/etags/el-src/emacs/lisp/progmodes/etags.el2
-rw-r--r--test/manual/etags/html-src/software.html8
-rw-r--r--test/manual/etags/html-src/softwarelibero.html10
-rw-r--r--test/manual/etags/scm-src/test.scm20
-rw-r--r--test/manual/etags/tex-src/gzip.texi2
-rw-r--r--test/manual/image-size-tests.el12
-rw-r--r--test/manual/indent/css-mode.css10
-rw-r--r--test/manual/indent/js-indent-align-list-continuation-nil.js20
-rw-r--r--test/manual/indent/js.js9
-rw-r--r--test/manual/indent/less-css-mode.less29
-rw-r--r--test/manual/indent/octave.m2
-rw-r--r--test/manual/indent/pascal.pas2
-rwxr-xr-xtest/manual/indent/perl.perl8
-rw-r--r--test/manual/redisplay-testsuite.el3
-rw-r--r--test/manual/rmailmm.el2
-rw-r--r--test/manual/scroll-tests.el2
-rw-r--r--test/src/alloc-tests.el2
-rw-r--r--test/src/buffer-tests.el7
-rw-r--r--test/src/callproc-tests.el2
-rw-r--r--test/src/casefiddle-tests.el2
-rw-r--r--test/src/charset-tests.el2
-rw-r--r--test/src/chartab-tests.el2
-rw-r--r--test/src/cmds-tests.el2
-rw-r--r--test/src/coding-tests.el2
-rw-r--r--test/src/data-tests.el23
-rw-r--r--test/src/decompress-tests.el2
-rw-r--r--test/src/doc-tests.el2
-rw-r--r--test/src/editfns-tests.el10
-rw-r--r--test/src/emacs-module-tests.el97
-rw-r--r--test/src/eval-tests.el22
-rw-r--r--test/src/fileio-tests.el97
-rw-r--r--test/src/floatfns-tests.el2
-rw-r--r--test/src/fns-tests.el38
-rw-r--r--test/src/font-tests.el2
-rw-r--r--test/src/inotify-tests.el2
-rw-r--r--test/src/keyboard-tests.el36
-rw-r--r--test/src/keymap-tests.el2
-rw-r--r--test/src/lcms-tests.el161
-rw-r--r--test/src/lread-tests.el27
-rw-r--r--test/src/marker-tests.el2
-rw-r--r--test/src/minibuf-tests.el2
-rw-r--r--test/src/print-tests.el2
-rw-r--r--test/src/process-tests.el2
-rw-r--r--test/src/regex-tests.el2
-rw-r--r--test/src/syntax-tests.el2
-rw-r--r--test/src/textprop-tests.el2
-rw-r--r--test/src/thread-tests.el2
-rw-r--r--test/src/undo-tests.el6
-rw-r--r--test/src/xml-tests.el2
2596 files changed, 140019 insertions, 64738 deletions
diff --git a/.clang-format b/.clang-format
new file mode 100644
index 00000000000..7895ada36da
--- /dev/null
+++ b/.clang-format
@@ -0,0 +1,27 @@
+Language: Cpp
+BasedOnStyle: LLVM
+AlignEscapedNewlinesLeft: true
+AlwaysBreakAfterReturnType: TopLevelDefinitions
+BreakBeforeBinaryOperators: All
+BreakBeforeBraces: GNU
+ColumnLimit: 80
+ContinuationIndentWidth: 2
+ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE]
+IncludeCategories:
+ - Regex: '^<config\.h>$'
+ Priority: -1
+ - Regex: '^<'
+ Priority: 1
+ - Regex: '^"lisp\.h"$'
+ Priority: 2
+ - Regex: '.*'
+ Priority: 3
+KeepEmptyLinesAtTheStartOfBlocks: false
+MaxEmptyLinesToKeep: 1
+PenaltyBreakBeforeFirstCallParameter: 2000
+SpaceAfterCStyleCast: true
+SpaceBeforeParens: Always
+
+# Local Variables:
+# mode: yaml
+# End:
diff --git a/.dir-locals.el b/.dir-locals.el
index 8a4a348ebd4..68eb58fa18b 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -2,13 +2,13 @@
(sentence-end-double-space . t)
(fill-column . 70)))
(c-mode . ((c-file-style . "GNU")
- (c-noise-macro-names . ("UNINIT"))))
+ (c-noise-macro-names . ("UNINIT" "CALLBACK" "ALIGN_STACK"))))
(objc-mode . ((c-file-style . "GNU")))
(log-edit-mode . ((log-edit-font-lock-gnu-style . t)
(log-edit-setup-add-author . t)))
(change-log-mode . ((add-log-time-zone-rule . t)
(fill-column . 74)
- (bug-reference-url-format . "http://debbugs.gnu.org/%s")
+ (bug-reference-url-format . "https://debbugs.gnu.org/%s")
(mode . bug-reference)))
(diff-mode . ((mode . whitespace)))
(emacs-lisp-mode . ((indent-tabs-mode . nil))))
diff --git a/.gitattributes b/.gitattributes
index d523e13f3c2..df75c9a1ad1 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# A few files use CRLF endings, even on non-Microsoft platforms.
# Do not warn about trailing whitespace with these files.
diff --git a/.gitignore b/.gitignore
index 46ed4a137de..7426082906c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Currently we assume only Git 1.7.1 (April 2010) or later, so this
@@ -111,7 +111,6 @@ lisp/mh-e/mh-autoloads.el
lisp/subdirs.el
# Dependencies.
-.deps/
deps/
# Logs and temporaries.
@@ -138,6 +137,7 @@ gmon.out
oo/
oo-spd/
src/*.map
+vgcore.*[0-9]
# Tests.
test/manual/biditest.txt
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 9b25ead37f1..08dd74ed087 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -13,7 +13,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# GNU Emacs support for the GitLab protocol for CI
@@ -24,11 +24,11 @@
# Maintainer: tzz@lifelogs.com
# URL: https://gitlab.com/emacs-ci/emacs
-image: debian:unstable
+image: debian:stretch
before_script:
- apt update -qq
- - apt install -y -qq build-essential autoconf automake libncurses-dev gnutls-dev
+ - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc make autoconf automake libncurses-dev gnutls-dev
stages:
- test
@@ -36,6 +36,6 @@ stages:
test:
stage: test
script:
- - ./autogen.sh
+ - ./autogen.sh autoconf
- ./configure --without-makeinfo
- make check
diff --git a/BUGS b/BUGS
index 30bf10ed94f..ee473213c89 100644
--- a/BUGS
+++ b/BUGS
@@ -7,7 +7,7 @@ Bugs section of the Emacs manual for advice on
You can read the Bugs section of the manual from inside Emacs.
Start Emacs, and press
C-h r (to view the Emacs manual)
- m Bugs RET (to go to the section on Bugs)
+ m Bugs RET (to go to the section on Bugs)
Or you can use the standalone Info program:
info emacs
m Bugs RET
@@ -15,7 +15,7 @@ Or you can use the standalone Info program:
Emacs distribution.)
Printed copies of the Emacs manual can be purchased from the Free
-Software Foundation's online store at <http://shop.fsf.org/>.
+Software Foundation's online store at <https://shop.fsf.org/>.
If necessary, you can read the manual without an info program:
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 3ed587c6918..c324375bb07 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -1,7 +1,7 @@
* How developers contribute to GNU Emacs
Here is how software developers can contribute to Emacs. (Non-developers: see
-http://www.gnu.org/software/emacs/manual/html_node/emacs/Contributing.html
+https://www.gnu.org/software/emacs/manual/html_node/emacs/Contributing.html
or run the shell command 'info "(emacs)Contributing"'.)
** The Emacs repository
@@ -14,7 +14,7 @@ Briefly, the following shell commands build and run Emacs from scratch:
git config --global transfer.fsckObjects true
git clone git://git.sv.gnu.org/emacs.git
cd emacs
- ./autogen.sh all
+ ./autogen.sh
./configure
make
src/emacs
@@ -26,20 +26,101 @@ admin/notes/git-workflow.
** Getting involved with development
-You can subscribe to the emacs-devel@gnu.org mailing list, paying
-attention to postings with subject lines containing "emacs-announce",
-as these discuss important events like feature freezes. See
-http://lists.gnu.org/mailman/listinfo/emacs-devel for mailing list
+Discussion about Emacs development takes place on emacs-devel@gnu.org.
+You can subscribe to the emacs-devel@gnu.org mailing list.
+If you want to get only the important mails (for things like
+feature freezes), choose to receive only the 'emacs-announce' topic
+(although so far this feature has not been well or consistently used).
+See https://lists.gnu.org/mailman/listinfo/emacs-devel for mailing list
instructions and archives. You can develop and commit changes in your
own copy of the repository, and discuss proposed changes on the
mailing list. Frequent contributors to Emacs can request write access
there.
-** Committing changes by others
+Bug reports and fixes, feature requests and patches/implementations
+should be sent to bug-gnu-emacs@gnu.org, the bug/feature list. This
+is coupled to the https://debbugs.gnu.org tracker. It is best to use
+the command 'M-x report-emacs-bug RET' to report issues to the tracker
+(described below). Be prepared to receive comments and requests for
+changes in your patches, following your submission.
-If committing changes written by someone else, commit in their name,
-not yours. You can use 'git commit --author="AUTHOR"' to specify a
-change's author.
+The Savannah info page https://savannah.gnu.org/mail/?group=emacs
+describes how to subscribe to the mailing lists, or see the list
+archives.
+
+To email a patch you can use a shell command like 'git format-patch -1'
+to create a file, and then attach the file to your email. This nicely
+packages the patch's commit message and changes. To send just one
+such patch without additional remarks, you can use a command like
+'git send-email --to=bug-gnu-emacs@gnu.org 0001-DESCRIPTION.patch'.
+
+** Issue tracker (a.k.a. "bug tracker")
+
+The Emacs issue tracker at https://debbugs.gnu.org lets you view bug
+reports and search the database for bugs matching several criteria.
+Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned
+above, are recorded by the tracker with the corresponding bugs/issues.
+
+GNU ELPA has a 'debbugs' package that allows accessing the tracker
+database from Emacs.
+
+Bugs needs regular attention. A large backlog of bugs is
+disheartening to the developers, and a culture of ignoring bugs is
+harmful to users, who expect software that works. Bugs have to be
+regularly looked at and acted upon. Not all bugs are critical, but at
+the least, each bug needs to be regularly re-reviewed to make sure it
+is still reproducible.
+
+The process of going through old or new bugs and acting on them is
+called bug triage. This process is described in the file
+admin/notes/bug-triage.
+
+** Documenting your changes
+
+Any change that matters to end-users should have an entry in etc/NEWS.
+
+Doc-strings should be updated together with the code.
+
+Think about whether your change requires updating the manuals. If you
+know it does not, mark the NEWS entry with "---". If you know
+that *all* the necessary documentation updates have been made as part
+of your changes or those by others, mark the entry with "+++".
+Otherwise do not mark it.
+
+If your change requires updating the manuals to document new
+functions/commands/variables/faces, then use the proper Texinfo
+command to index them; for instance, use @vindex for variables and
+@findex for functions/commands. For the full list of predefine indices, see
+https://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html
+or run the shell command 'info "(texinfo)Predefined Indices"'.
+
+We prefer American English both in doc strings and in the manuals.
+That includes both spelling (e.g., "behavior", not "behaviour") and
+the convention of leaving 2 spaces between sentences.
+
+For more specific tips on Emacs's doc style, see
+https://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html
+Use 'checkdoc' to check for documentation errors before submitting a patch.
+
+** Testing your changes
+
+Please test your changes before committing them or sending them to the
+list. If possible, add a new test along with any bug fix or new
+functionality you commit (of course, some changes cannot be easily
+tested).
+
+Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See
+https://www.gnu.org/software/emacs/manual/html_node/ert/
+or run 'info "(ert)"' for more information on writing and running
+tests.
+
+If your test lasts longer than some few seconds, mark it in its
+'ert-deftest' definition with ":tags '(:expensive-test)".
+
+To run tests on the entire Emacs tree, run "make check" from the
+top-level directory. Most tests are in the directory "test/". From
+the "test/" directory, run "make <filename>" to run the tests for
+<filename>.el(c). See "test/README" for more information.
** Commit messages
@@ -95,6 +176,9 @@ them right the first time, so here are guidelines for formatting them:
bug number NNNNN in the debbugs database. This string is often
parenthesized, as in "(Bug#19003)".
+- When citing URLs, prefer https: to http: when either will do. In
+ particular, gnu.org and fsf.org URLs should start with "https:".
+
- Commit messages should contain only printable UTF-8 characters.
- Commit messages should not contain the "Signed-off-by:" lines that
@@ -109,7 +193,7 @@ them right the first time, so here are guidelines for formatting them:
between the summary line and the file entries.
- Emacs generally follows the GNU coding standards for ChangeLogs: see
- http://www.gnu.org/prep/standards/html_node/Change-Logs.html
+ https://www.gnu.org/prep/standards/html_node/Change-Logs.html
or run 'info "(standards)Change Logs"'. One exception is that
commits still sometimes quote `like-this' (as the standards used to
recommend) rather than 'like-this' or ‘like this’ (as they do now),
@@ -119,8 +203,10 @@ them right the first time, so here are guidelines for formatting them:
to ChangeLog entries: they must be in English, and be complete
sentences starting with a capital and ending with a period (except
the summary line should not end in a period). See
- http://www.gnu.org/prep/standards/html_node/Comments.html
- or run 'info "(standards)Comments"'.
+ https://www.gnu.org/prep/standards/html_node/Comments.html
+ or run 'info "(standards)Comments"'. American English is preferred
+ in Emacs; that includes spelling and leaving 2 blanks between
+ sentences.
They are preserved indefinitely, and have a reasonable chance of
being read in the future, so it's better that they have good
@@ -159,7 +245,7 @@ them right the first time, so here are guidelines for formatting them:
** Generating ChangeLog entries
- You can use Emacs functions to write ChangeLog entries; see
- http://www.gnu.org/software/emacs/manual/html_node/emacs/Change-Log-Commands.html
+ https://www.gnu.org/software/emacs/manual/html_node/emacs/Change-Log-Commands.html
or run 'info "(emacs)Change Log Commands"'.
- If you use Emacs VC, one way to format ChangeLog entries is to create
@@ -176,6 +262,12 @@ them right the first time, so here are guidelines for formatting them:
with Emacs commands like 'C-x 4 a', and commit the change using the
shell command 'vc-dwim --commit'. Type 'vc-dwim --help' for more.
+** Committing changes by others
+
+If committing changes written by someone else, commit in their name,
+not yours. You can use 'git commit --author="AUTHOR"' to specify a
+change's author.
+
** Branches
Future development normally takes place on the master branch.
@@ -218,95 +310,14 @@ This repository does not contain the Emacs Lisp package archive
(elpa.gnu.org). See admin/notes/elpa for how to access the GNU ELPA
repository.
-** Emacs Mailing lists.
-
-Discussion about Emacs development takes place on emacs-devel@gnu.org.
-
-Bug reports and fixes, feature requests and implementations should be
-sent to bug-gnu-emacs@gnu.org, the bug/feature list. This is coupled
-to the http://debbugs.gnu.org tracker.
-
-The Savannah info page http://savannah.gnu.org/mail/?group=emacs
-describes how to subscribe to the mailing lists, or see the list
-archives.
-
-To email a patch you can use a shell command like 'git format-patch -1'
-to create a file, and then attach the file to your email. This nicely
-packages the patch's commit message and changes. To send just one
-such patch without additional remarks, you can use a command like
-'git send-email --to=bug-gnu-emacs@gnu.org 0001-DESCRIPTION.patch'.
-
-** Issue tracker (a.k.a. "bug tracker")
-
-The Emacs issue tracker at http://debbugs.gnu.org lets you view bug
-reports and search the database for bugs matching several criteria.
-Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned
-above, are recorded by the tracker with the corresponding bugs/issues.
-
-GNU ELPA has a 'debbugs' package that allows accessing the tracker
-database from Emacs.
-
-Bugs needs regular attention. A large backlog of bugs is
-disheartening to the developers, and a culture of ignoring bugs is
-harmful to users, who expect software that works. Bugs have to be
-regularly looked at and acted upon. Not all bugs are critical, but at
-the least, each bug needs to be regularly re-reviewed to make sure it
-is still reproducible.
-
-The process of going through old or new bugs and acting on them is
-called bug triage. This process is described in the file
-admin/notes/bug-triage.
-
-** Documenting your changes
-
-Any change that matters to end-users should have an entry in etc/NEWS.
-
-Doc-strings should be updated together with the code.
-
-Think about whether your change requires updating the manuals. If you
-know it does not, mark the NEWS entry with "---". If you know
-that *all* the necessary documentation updates have been made, mark
-the entry with "+++". Otherwise do not mark it.
-
-If your change requires updating the manuals to document new
-functions/commands/variables/faces, then use the proper Texinfo
-command to index them; for instance, use @vindex for variables and
-@findex for functions/commands. For the full list of predefine indices, see
-http://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html
-or run the shell command 'info "(texinfo)Predefined Indices"'.
-
-For more specific tips on Emacs's doc style, see
-http://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html
-Use 'checkdoc' to check for documentation errors before submitting a patch.
-
-** Testing your changes
-
-Please test your changes before committing them or sending them to the
-list. If possible, add a new test along with any bug fix or new
-functionality you commit (of course, some changes cannot be easily
-tested).
-
-Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See
-http://www.gnu.org/software/emacs/manual/html_node/ert/
-or run 'info "(ert)"' for for more information on writing and running
-tests.
-
-If your test lasts longer than some few seconds, mark it in its
-'ert-deftest' definition with ":tags '(:expensive-test)".
-
-To run tests on the entire Emacs tree, run "make check" from the
-top-level directory. Most tests are in the directory "test/". From
-the "test/" directory, run "make <filename>" to run the tests for
-<filename>.el(c). See "test/README" for more information.
-
** Understanding Emacs internals
The best way to understand Emacs internals is to read the code. Some
source files, such as xdisp.c, have extensive comments describing the
design and implementation. The following resources may also help:
-http://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html
-http://www.gnu.org/software/emacs/manual/html_node/elisp/GNU-Emacs-Internals.html
+https://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html
+https://www.gnu.org/software/emacs/manual/html_node/elisp/GNU-Emacs-Internals.html
or run 'info "(elisp)Tips"' or 'info "(elisp)GNU Emacs Internals"'.
@@ -365,7 +376,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
mode: outline
diff --git a/COPYING b/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/COPYING
+++ b/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/ChangeLog.1 b/ChangeLog.1
index eeb6da4265b..2fcf7aafa25 100644
--- a/ChangeLog.1
+++ b/ChangeLog.1
@@ -33,7 +33,7 @@
Fix 'commit-msg' to cite 'CONTRIBUTE'
As suggested in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00947.html
+ https://lists.gnu.org/r/emacs-devel/2015-03/msg00947.html
Also, have the two files match better.
* CONTRIBUTE: Match what's in build-aux/git-hooks/commit-msg.
* build-aux/git-hooks/commit-msg: Mention 'CONTRIBUTE'.
@@ -145,7 +145,7 @@
* configure.ac (HAVE_W32): Abort with error message if
--without-toolkit-scroll-bars was specified. See
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00525.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00525.html
for the details.
2015-01-27 Paul Eggert <eggert@cs.ucla.edu>
@@ -156,7 +156,7 @@
configuration. The downside is that patch applications won't be
checked, but that's better than autogen.sh failing.
Problem reported by Sam Steingold in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00898.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00898.html
2015-01-26 Paul Eggert <eggert@cs.ucla.edu>
@@ -184,7 +184,7 @@
Give up on -Wsuggest-attribute=const
The attribute doesn't help performance significantly, and the
warning seems to be more trouble than it's worth. See the thread at:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00361.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00361.html
* configure.ac (WERROR_CFLAGS): Don't use -Wsuggest-attribute=const.
2015-01-11 Paul Eggert <eggert@cs.ucla.edu>
@@ -297,7 +297,7 @@
2014-12-13 Paul Eggert <eggert@cs.ucla.edu>
Port commit-msg to mawk. Reported by Ted Zlatanov in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg01093.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg01093.html
* build-aux/git-hooks/commit-msg (space, non_space, non_print):
New vars. Use them as approximations to POSIX bracket expressions,
on implementations like mawk that do not support POSIX regexps.
@@ -313,7 +313,7 @@
Port commit-message checking to FreeBSD 9.
Reported by Jan Djärv in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00704.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg00704.html
along with some other issues I noticed while testing with FreeBSD.
* build-aux/git-hooks/commit-msg: Prefer gawk if available.
Prefer en_US.UTF-8 to en_US.utf8, as it's more portable.
@@ -391,7 +391,7 @@
Add a.out to .gitignore.
Suggested by Lee Duhem in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg01665.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg01665.html
* .gitignore: Add a.out.
Move *.log next to *.tmp, since it's generic.
Put *.exe before non-generics.
@@ -442,7 +442,7 @@
Restore 'Bug#' -> 'debbugs:' rewrite in log-edit-mode.
* .dir-locals.el (log-edit-mode): Restore the (log-edit-rewrite-fixes
"[ \n](bug#\\([0-9]+\\))" . "debbugs:\\1"). See Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg01187.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg01187.html
Simplify and fix doc-related .gitignore files.
This fixes some unwanted 'git status' output after 'make docs'.
@@ -913,7 +913,7 @@
Omit redundant extern decls.
Most of this patch is from Dmitry Antipov, in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00263.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00263.html
* configure.ac (WERROR_CFLAGS): Add -Wredundant-decls.
Merge from gnulib, incorporating:
@@ -969,7 +969,7 @@
Rely on AC_CANONICAL_HOST to detect whether we're using mingw.
See the thread containing:
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00206.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00206.html
* configure.ac (AC_CANONICAL_HOST): Invoke this as early as we
can, which is just after AM_INIT_AUTOMAKE. Then check for mingw
just after that.
@@ -1045,7 +1045,7 @@
2014-05-29 Paul Eggert <eggert@cs.ucla.edu>
* configure.ac (pthread_sigmask): Look in LIB_PTHREAD too (Bug#17561).
- Fixes configuration glitch found in <http://bugs.gnu.org/17561#59>.
+ Fixes configuration glitch found in <https://bugs.gnu.org/17561#59>.
2014-05-29 Eli Zaretskii <eliz@gnu.org>
@@ -1517,7 +1517,7 @@
* configure.ac (LIBXML2_CFLAGS): Fix xcrun-related quoting problem.
Reported by YAMAMOTO Mitsuharu in:
- http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00995.html
+ https://lists.gnu.org/r/emacs-devel/2013-12/msg00995.html
2013-12-28 Jan Djärv <jan.h.d@swipnet.se>
@@ -1529,7 +1529,7 @@
* configure.ac: Don't set MAKE unless 'make' doesn't work.
Set it only in the environment, not in the makefile.
Reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00969.html
+ https://lists.gnu.org/r/emacs-devel/2013-12/msg00969.html
2013-12-27 Paul Eggert <eggert@cs.ucla.edu>
@@ -1635,7 +1635,7 @@
Remove the option of using libcrypto.
This scorches the earth and waits for spring;
see Ted Zlatanov and Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00323.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-12/msg00323.html>.
* configure.ac (with_openssl_default, HAVE_LIB_CRYPTO): Remove.
Do not say whether Emacs is configured to use a crypto library,
since it's no longer an option.
@@ -1666,7 +1666,7 @@
On commonly used platform libcrypto uses architecture-specific
assembly code, which is significantly faster than the C code we
were using. See Pádraig Brady's note in
- <http://lists.gnu.org/archive/html/bug-gnulib/2013-12/msg00000.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2013-12/msg00000.html>.
Merge from gnulib, incorporating:
2013-12-07 md5, sha1, sha256, sha512: add gl_SET_CRYPTO_CHECK_DEFAULT
2013-12-07 md5, sha1, sha256, sha512: add 'auto', and set-default method
@@ -1987,7 +1987,7 @@
Work around performance bug on OS X 10.8 and earlier.
Perhaps Apple will fix this bug some day.
See the thread starting with Daniel Colascione's email in:
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00343.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00343.html
* configure.ac (FORTIFY_SOUR): New verbatim section.
2013-09-19 Paul Eggert <eggert@cs.ucla.edu>
@@ -2003,9 +2003,9 @@
* configure.ac <srcdir> [MINGW32]: Make sure the value of 'srcdir'
is in the full /d/foo/bar form. See the discussion in
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00210.html,
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00210.html,
and in particular
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00252.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00252.html
and its followups, for the details.
2013-09-17 Dmitry Antipov <dmantipov@yandex.ru>
@@ -2617,7 +2617,7 @@
Merge from gnulib, incorporating:
2013-03-29 stdalign: port to stricter ISO C11
This helps to run 'configure' on MS-Windows; see Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00999.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-03/msg00999.html>.
2013-03-27 Paul Eggert <eggert@cs.ucla.edu>
@@ -2812,7 +2812,7 @@
Enable conservative stack scanning for all architectures.
Suggested by Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00183.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-01/msg00183.html>.
* configure.ac (GC_MARK_STACK): Remove.
2013-01-11 Paul Eggert <eggert@cs.ucla.edu>
@@ -3182,7 +3182,7 @@
Check more robustly for timer_settime.
This should fix an OS X build problem reported by Ivan Andrus in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00671.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00671.html>.
* configure.ac (gl_THREADLIB): Define to empty, since Emacs
does threads its own way.
* lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
@@ -3196,7 +3196,7 @@
* Makefile.in (bootstrap): Simplify build procedure.
Suggested by Wolfgang Jenker in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00456.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00456.html>.
Merge from gnulib, incorporating:
2012-09-22 sockets, sys_stat: remove AC_C_INLINE in MSVC-only cases
@@ -3216,14 +3216,14 @@
* Makefile.in: Fix build error on FreeBSD.
($(MAKEFILE_NAME)): Pass MAKE='$(MAKE)' to config.status's env.
Suggested by Wolfgang Jenker in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00430.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00430.html>.
(MAKE_CONFIG_STATUS): Remove. Remaining use expanded.
This undoes part of the 2012-09-10 patch.
(bootstrap): Run ./configure, rather than trying to run config.status
if it exists. That builds src/epaths.h more reliably.
Run autogen/copy_autogen if autogen.sh fails,
to create 'configure'. Reported by Andreas Schwab in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00438.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00438.html>.
* autogen.sh: Exit with status 1 when failing due to missing tools,
reverting the 2012-09-10 change to this file.
* autogen/copy_autogen: Fail if one of the subsidiary actions fail.
@@ -3360,7 +3360,7 @@
* configure.ac (WARN_CFLAGS): Omit -Wjump-misses-init.
It generates false alarms in doc.c, regex.c, xdisp.c. See
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00040.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00040.html>.
Merge from gnulib, incorporating:
2012-08-29 stdbool: be more compatible with mixed C/C++ compiles
@@ -3375,7 +3375,7 @@
* configure.ac (_FORTIFY_SOURCE): Define only when optimizing.
This ports to glibc 2.15 or later, when configured with
--enable-gcc-warnings. See Eric Blake in
- <http://lists.gnu.org/archive/html/bug-grep/2012-09/msg00000.html>.
+ <https://lists.gnu.org/r/bug-grep/2012-09/msg00000.html>.
2012-09-01 Daniel Colascione <dan.colascione@gmail.com>
@@ -3812,7 +3812,7 @@
Improve static checking when configured --with-ns.
See Samuel Bronson's remarks in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00146.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00146.html>.
* configure.in (WARN_CFLAGS): Omit -Wunreachable-code, as it's
a no-op with recent GCC and harmful in earlier ones.
Omit -Wsync-nand, as it's irrelevant to Emacs and provokes a
@@ -4072,7 +4072,7 @@
Remove --disable-maintainer-mode option from 'configure'. (Bug#11555)
It is confusingly named and rarely useful. See, for example,
- <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00089.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-12/msg00089.html>.
* INSTALL.BZR: Don't mention --disable-maintainer-mode.
* Makefile.in (MAINTAINER_MODE_FLAG): Remove; all uses removed.
* configure.in: Remove --disable-maintainer-mode.
@@ -4555,7 +4555,7 @@
Check pkg-config exit status when configuring (Bug#10626).
* configure.in (PKG_CHECK_MODULES): Do not assume that pkg-config
works; check its exit status. Reported by Jordi Gutiérrez Hermoso in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00787.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-01/msg00787.html>.
2012-04-07 Glenn Morris <rgm@gnu.org>
@@ -4628,7 +4628,7 @@
* configure.in (HAVE_PTHREAD): Check for pthread_atfork if linking
to gmalloc.c. This should prevent a MirBSD 10 build failure reported
by Nelson H. F. Beebe in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00065.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-12/msg00065.html>.
2011-12-10 Juanma Barranquero <lekktu@gmail.com>
@@ -4775,7 +4775,7 @@
Merge from gnulib, improving some licensing wording.
This clarifies and fixes some licensing issues raised by Glenn Morris
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00397.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-09/msg00397.html>.
It also merges the latest version of texinfo.tex and has some
MSVC-related changes that don't affect Emacs.
* Makefile.in (GNULIB_TOOL_FLAGS): Avoid msvc-inval, msvc-nothrow,
@@ -4944,7 +4944,7 @@
test, which runs afoul of Automake installations where, for example,
/usr/share/aclocal contains a copy of gl_THREADLIB.
Reported by Sven Joachim in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-07/msg00529.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-07/msg00529.html>.
This is just a quick temporary fix, specific to Emacs; I'll work
with the other gnulib maintainers to get a more-permanent fix.
@@ -5556,7 +5556,7 @@
* arg-nonnull.h, c++defs.h, warn-on-use.h: Fix licenses.
Sync from gnulib, which has been patched to fix the problem
with the license notices. Reported by Glenn Morris in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-02/msg00403.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-02/msg00403.html>.
2011-02-09 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -5590,7 +5590,7 @@
gnulib: adjust to upstream _HEADERS change
* lib/Makefile.am (EXTRA_HEADERS, nodist_pkginclude_HEADERS):
New empty macros, to accommodate recent changes to gnulib. See
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-02/msg00068.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-02/msg00068.html>.
* c++defs.h, lib/Makefile.in, lib/ftoastr.h, lib/getopt.in.h:
* lib/gnulib.mk, lib/ignore-value.h, lib/stdbool.in.h, lib/stddef.in.h:
* lib/time.in.h, lib/unistd.in.h:
@@ -5664,7 +5664,7 @@
* lib/mktime.c (long_int_is_wide_enough): Move this assertion to
the top level, to make it clearer that the assumption about
long_int width is being checked. See
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-01/msg00554.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-01/msg00554.html>.
2011-01-29 Paul Eggert <eggert@cs.ucla.edu>
@@ -5673,7 +5673,7 @@
negative number, which the C Standard says has undefined behavior.
In practice this is not a problem, but might as well do it by the book.
Reported by Rich Felker and Eric Blake; see
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-01/msg00493.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-01/msg00493.html>.
* m4/mktime.m4 (AC_FUNC_MKTIME): Likewise.
* lib/mktime.c (TYPE_MAXIMUM): Redo slightly to match the others.
@@ -5691,7 +5691,7 @@
mktime: fix some integer overflow issues and sidestep the rest
This was prompted by a bug report by Benjamin Lindner for MinGW
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-01/msg00472.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-01/msg00472.html>.
His bug is due to signed integer overflow (0 - INT_MIN), and I
I scanned through mktime.c looking for other integer overflow
problems, fixing all the bugs I found.
@@ -5710,7 +5710,7 @@
no need to test for alternatives. All uses removed.
(TYPE_MAXIMUM): Don't rely here on overflow behavior not defined by
the C standard. Reported by Rich Felker in
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-01/msg00488.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-01/msg00488.html>.
(twos_complement_arithmetic): Also check long_int and time_t.
(time_t_avg, time_t_add_ok, time_t_int_add_ok): New functions.
(guess_time_tm, ranged_convert, __mktime_internal): Use them.
@@ -5810,7 +5810,7 @@
aclocal.m4: put this file back into repository
This way, we don't have to assume that the maintainer has
the automake package installed. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00746.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00746.html>.
* .bzrignore: Remove aclocal.m4, undoing the previous change.
* Makefile.in (top_maintainer_clean): Do not remove aclocal.m4,
undoing the previous change.
@@ -5837,7 +5837,7 @@
aclocal.m4: tweaks to regenerate more conveniently
This attempts to act better when the source is in a weird state. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00734.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00734.html>.
* Makefile.in (am--refresh): Add aclocal.m4, configure, config.in.
* .bzrignore: Add aclocal.m4.
@@ -5848,12 +5848,12 @@
the most recent change here.
* aclocal.m4: Remove from bzr repository. This file is
auto-generated and isn't needed to run 'configure'. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00698.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00698.html>.
2011-01-19 Paul Eggert <eggert@cs.ucla.edu>
Minor Makefile.in tweaks to build from gnulib better.
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00673.html>
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00673.html>
* Makefile.in (sync-from-gnulib): Also run autoreconf -I m4.
(top_maintainer_clean): Don't remove aclocal.m4.
@@ -5881,7 +5881,7 @@
* Makefile.in (GNULIB_MODULES): Change ftoastr to dtoastr.
This avoids building ftoastr and ldtoastr, which aren't needed. See
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-01/msg00199.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2011-01/msg00199.html>.
* .bzrignore: Add .h files that are host-dependent.
Add lib/.deps/, lib/arg-nonnull.h, lib/c++defs.h, lib/getopt.h,
@@ -14715,4 +14715,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/ChangeLog.2 b/ChangeLog.2
index 96a647d9b44..bf85406b1f9 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -1,3 +1,17 @@
+2017-09-11 Eli Zaretskii <eliz@gnu.org>
+
+ * etc/NEWS: Document the vulnerability and its resolution.
+ Include a workaround. Suggested by Charles A. Roelli
+ <charles@aurox.ch>.
+
+ * lisp/gnus/mm-view.el (mm-inline-text): Disable decoding of
+ "enriched" and "richtext" MIME objects. Suggested by Lars
+ Ingebrigtsen <larsi@gnus.org>.
+
+ * lisp/textmodes/enriched.el (enriched-decode-display-prop):
+ Don't produce 'display' properties. (Bug#28350)
+
+
2017-04-20 Nicolas Petton <nicolas@petton.fr>
* Version 25.2 released.
@@ -104,7 +118,7 @@
org-src fontify buffers" the hooks were enabled also for modifications
to the original org buffer. This causes fontification errors when
combined with certain packages, as reported in
- http://lists.gnu.org/archive/html/emacs-orgmode/2017-03/msg00420.html.
+ https://lists.gnu.org/r/emacs-orgmode/2017-03/msg00420.html.
* lisp/org/org-src.el (org-src-font-lock-fontify-block): Reduce scope
of inhibit-modification-hooks let-binding.
@@ -762,7 +776,7 @@
* lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Fix docstring
so that it matches the actual implementation.
- See https://lists.gnu.org/archive/html/help-gnu-emacs/2016-04/msg00071.html
+ See https://lists.gnu.org/r/help-gnu-emacs/2016-04/msg00071.html
2016-12-07 Noam Postavsky <npostavs@gmail.com>
@@ -1494,7 +1508,7 @@
This should make ralloc-related bugs less likely on GNU/Linux
systems with bleeding-edge glibc. See the email thread containing:
- http://lists.gnu.org/archive/html/emacs-devel/2016-10/msg00801.html
+ https://lists.gnu.org/r/emacs-devel/2016-10/msg00801.html
Do not merge to master.
* configure.ac (REL_ALLOC): Default to 'no' on all platforms, not
merely on platforms with Doug Lea malloc. Although bleeding-edge
@@ -2032,7 +2046,7 @@
See this thread for discussion:
- https://lists.gnu.org/archive/html/emacs-devel/2016-09/threads.html#00329
+ https://lists.gnu.org/r/emacs-devel/2016-09/threads.html#00329
From: Karl Fogel
To: Emacs Devel
Subject: Question about intended behavior of 'insert-for-yank-1'.
@@ -2367,7 +2381,7 @@
parameters restored by desktop.el take precedence over the
customizations in the init file, and explain how to countermand
that. For the details of the issue, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00318.html.
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00318.html.
2016-09-15 Nicolas Petton <nicolas@petton.fr>
@@ -2410,7 +2424,7 @@
* lisp/url/url-http.el (url-http-create-request): Make sure the
cookie headers are a unibyte string. For the details, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00202.html.
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00202.html.
2016-09-08 Martin Rudalics <rudalics@gmx.at>
@@ -2931,9 +2945,9 @@
* src/indent.c (Fvertical_motion): Don't return uninitialized
value in non-interactive session. This fixes random errors in
batch mode, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00609.html
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00609.html
and
- http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg00500.html
+ https://lists.gnu.org/r/emacs-devel/2016-07/msg00500.html
for the details.
2016-07-10 Andreas Schwab <schwab@linux-m68k.org>
@@ -3273,7 +3287,7 @@
* src/xfns.c (x_get_monitor_attributes_xrandr): Use #if, not #ifdef.
This ports to systems that predate xrandr 1.3. See Christian Lynbech in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00198.html
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00198.html
(cherry picked from commit dce99f222f1ca33265cd56ddb157817be1dc078e)
@@ -3291,7 +3305,7 @@
* lisp/calendar/todo-mode.el (todo-read-category): Use
set-keymap-parent instead of copy-keymap, and default (as
previously) to the global binding (for rationale, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00217.html).
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00217.html).
2016-06-14 Stephen Berman <stephen.berman@gmx.net>
@@ -3875,7 +3889,7 @@
* lisp/replace.el (replace-char-fold): Rename from replace-character-fold.
* test/automated/char-fold-tests.el: Rename from character-fold-tests.el.
- http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00529.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg00529.html
2016-05-17 Nicolas Petton <nicolas@petton.fr>
@@ -4401,7 +4415,7 @@
2016-05-01 Lars Ingebrigtsen <larsi@gnus.org>
- Document mode mode line variables
+ Document mode line variables
* doc/lispref/modes.texi (Mode Line Variables): Document
`mode-line-front-space, `mode-line-misc-info',
@@ -4794,7 +4808,7 @@
Link from (emacs)Exiting to (lisp)Killing Emacs
* doc/emacs/entering.texi (Exiting): Link to the lispref
- manual for further customisations (bug#15445).
+ manual for further customizations (bug#15445).
(cherry picked from commit bc5f27aa099cdde02ca66e71501b89300685ab28)
@@ -5033,7 +5047,7 @@
* lisp/faces.el (variable-pitch) [w32]: Name a variable-pitch font
explicitly, to avoid Emacs picking up a bold-italic variant on
some MS-Windows systems. See this thread for details:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00746.html.
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00746.html.
2016-04-29 Alan Mackenzie <acm@muc.de>
@@ -5447,8 +5461,8 @@
buffer text was overwritten with binary nulls, because
mmap_realloc copied only part of buffer text when extending it.
See
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00325.html
- and http://debbugs.gnu.org/cgi/bugreport.cgi?bug=23223#55 for two
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00325.html
+ and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=23223#55 for two
examples of the related problems.
2016-04-14 Michael Albinus <michael.albinus@gmx.de>
@@ -5482,7 +5496,7 @@
* lisp/cedet/semantic/symref/grep.el
(semantic-symref-filepattern-alist):
Add entry for lisp-interaction-mode
- (http://debbugs.gnu.org/cgi/bugreport.cgi?bug=23223#47)
+ (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=23223#47)
2016-04-12 Dmitry Gutov <dgutov@yandex.ru>
@@ -5692,7 +5706,7 @@
fixing most of Bug#20202. The only part of the change that is
still reverted is the change to M-x term, where compatibility with
current Bash constrains us from moving too quickly (Bug#20484).
- Problem reported by Phillip Lord in: http://bugs.gnu.org/20484#108
+ Problem reported by Phillip Lord in: https://bugs.gnu.org/20484#108
* etc/NEWS: Document this.
* lisp/comint.el (comint-exec-1):
* lisp/net/tramp-sh.el (tramp-remote-process-environment):
@@ -6017,7 +6031,7 @@
* lisp/progmodes/prog-mode.el: (prog-indentation-context)
(prog-first-column, prog-widen): Remove, as discussed in
- http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg01425.html.
+ https://lists.gnu.org/r/emacs-devel/2016-03/msg01425.html.
* doc/lispref/text.texi (Mode-Specific Indent): Remove references
to them.
@@ -6648,7 +6662,7 @@
* etc/NEWS, nextstep/README: Prefer curved quotes in the
recently-changed text documentation. See:
- http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg00860.html
+ https://lists.gnu.org/r/emacs-devel/2016-03/msg00860.html
2016-03-14 Paul Eggert <eggert@cs.ucla.edu>
@@ -7266,7 +7280,7 @@
* lisp/progmodes/xref.el (xref--xref-buffer-mode):
Uncomment the next-error-function integration
- (http://debbugs.gnu.org/cgi/bugreport.cgi?bug=20489#110).
+ (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=20489#110).
2016-02-29 Dmitry Gutov <dgutov@yandex.ru>
@@ -7509,11 +7523,11 @@
2016-02-23 Jan Tatarik <jan.tatarik@gmail.com>
- Don't bug out on localised dates in gnus-icalendar
+ Don't bug out on localized dates in gnus-icalendar
* lisp/gnus/gnus-icalendar.el
(gnus-icalendar-event:org-timestamp): Don't bug out on
- localised dates.
+ localized dates.
2016-02-23 Drew Adams <drew.adams@oracle.com>
@@ -7580,7 +7594,7 @@
* lisp/progmodes/ruby-mode.el (ruby-mode-syntax-table): Change the
syntax classes of $, : and @ to "prefix character"
- (http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00272.html).
+ (https://lists.gnu.org/r/emacs-devel/2016-01/msg00272.html).
(ruby-syntax-propertize): Undo that specifically for colons
followed by an opening paren or bracket.
(ruby-font-lock-keyword-beg-re): Include colon character.
@@ -7676,7 +7690,7 @@
(xref-show-location-at-point): Make an effort to avoid the
original window when showing the location.
(xref-goto-xref): Don't quit the xref window (bug#20487 and
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01133.html).
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg01133.html).
(xref--query-replace-1): Use xref--with-dedicated-window as well.
(xref--next-error-function): Call xref--show-location instead of
xref--pop-to-location.
@@ -7831,7 +7845,7 @@
2016-02-20 Lars Ingebrigtsen <larsi@gnus.org>
- Allow customising the article mode cursor behavior
+ Allow customizing the article mode cursor behavior
* doc/misc/gnus.texi (HTML): Mention gnus-article-show-cursor.
@@ -8521,7 +8535,7 @@
Port to FreeBSD 11-CURRENT i386
Problem reported by Herbert J. Skuhra in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg00354.html
+ https://lists.gnu.org/r/emacs-devel/2016-02/msg00354.html
Instead of trying
* src/alloc.c (lmalloc, lrealloc, laligned): New functions.
(xmalloc, xzalloc, xrealloc, lisp_malloc): Use them.
@@ -8567,7 +8581,7 @@
Fix test for dladdr
Problem reported by Andreas Schwab in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg00327.html
+ https://lists.gnu.org/r/emacs-devel/2016-02/msg00327.html
* configure.ac (dladdr): Link with LIBMODULES when checking for
this function.
@@ -8906,7 +8920,7 @@
Remove 'def X' from the example
* test/etags/ruby-src/test1.ru (A::B): Remove 'def X'
- (http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg00167.html).
+ (https://lists.gnu.org/r/emacs-devel/2016-02/msg00167.html).
* test/etags/CTAGS.good:
* test/etags/ETAGS.good_1:
* test/etags/ETAGS.good_2:
@@ -9258,7 +9272,7 @@
my edits today to http://www.emacswiki.org/emacs/GitForEmacsDevs and
to emacswiki.org/emacs/GitQuickStartForEmacsDevs. See also the thread
"Recommend these .gitconfig settings for git integrity." at
- https://lists.gnu.org/archive/html/emacs-devel/2016-01/threads.html#01802.
+ https://lists.gnu.org/r/emacs-devel/2016-01/threads.html#01802.
2016-02-01 Martin Rudalics <rudalics@gmx.at>
@@ -9340,7 +9354,7 @@
autogen.sh now arranges for git to check hashes
Suggested by Karl Fogel in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01802.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg01802.html
* autogen.sh: Do "git config transfer.fsckObjects true".
2016-01-31 Paul Eggert <eggert@cs.ucla.edu>
@@ -9632,7 +9646,7 @@
(project-find-file-in): Use it.
(project-file-completion-table): Move the default
implementation inside the cl-defgeneric form.
- (http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01720.html)
+ (https://lists.gnu.org/r/emacs-devel/2016-01/msg01720.html)
2016-01-30 Dmitry Gutov <dgutov@yandex.ru>
@@ -9681,7 +9695,7 @@
Correct a whole bunch of bugs coming with renamed cell relocation.
This is the same change as commit on master branch. See
- http://git.savannah.gnu.org/cgit/emacs.git/commit/?id=badcd38aa86ed7973f2be2743c405710973a0bdd
+ https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=badcd38aa86ed7973f2be2743c405710973a0bdd
* lisp/ses.el (ses-localvars): rename variable
`ses--renamed-cell-symb-list' into `ses--in-killing-named-cell-list'
@@ -9763,8 +9777,8 @@
* doc/lispref/control.texi (Pattern matching case statement):
Improve the documentation of 'pcase' per comments. See two
discussion threads on emacs-devel@gnu.org for the details:
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01335.html
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01336.html.
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg01335.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg01336.html.
2016-01-29 Glenn Morris <rgm@gnu.org>
@@ -10033,7 +10047,7 @@
Port "$@" to OpenIndiana ksh93
- In http://lists.gnu.org/archive/html/bug-autoconf/2015-12/msg00000.html
+ In https://lists.gnu.org/r/bug-autoconf/2015-12/msg00000.html
Pavel Raiskup reports that ${1+"$@"} runs afoul of a bug in /bin/sh
(derived from ksh 93t+ 2010-03-05). ${1+"$@"} works around an ancient
bug in long-dead shells, so remove the workaround.
@@ -10183,7 +10197,7 @@
* lisp/progmodes/xref.el(xref-query-replace):
Rename to xref-query-replace-in-results.
- (http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01240.html)
+ (https://lists.gnu.org/r/emacs-devel/2016-01/msg01240.html)
* lisp/progmodes/xref.el (xref--xref-buffer-mode-map):
* lisp/dired-aux.el (dired-do-find-regexp-and-replace):
@@ -10206,7 +10220,7 @@
* lisp/progmodes/xref.el (xref--xref-buffer-mode):
Comment out next-error-function integration
- (http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01286.html).
+ (https://lists.gnu.org/r/emacs-devel/2016-01/msg01286.html).
2016-01-23 John Wiegley <johnw@newartisans.com>
@@ -10275,7 +10289,7 @@
Pacify --enable-gcc-warnings --with-cairo
Problem reported by Alexander Kuleshov in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01289.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg01289.html
* src/gtkutil.c (xg_get_page_setup):
Use switch rather than if-then-else.
* src/image.c (COLOR_TABLE_SUPPORT):
@@ -10515,7 +10529,7 @@
No need to configure gobject-introspection
It wasn’t needed for the recently-installed xwidget_mvp code; see:
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg01154.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg01154.html
* configure.ac (DOES_XWIDGETS_USE_GIR, GIR_REQUIRED, GIR_MODULES):
(HAVE_GIR):
* src/Makefile.in (GIR_LIBS, GIR_CFLAGS):
@@ -10797,7 +10811,7 @@
* lisp/dired-aux.el (dired-do-find-regexp)
(dired-do-find-regexp-and-replace): New commands.
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00864.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00864.html
* lisp/dired.el (dired-mode-map): Change bindings for `A' and
`Q' to the new commands.
@@ -10820,7 +10834,7 @@
* doc/emacs/maintaining.texi (Xref, Find Identifiers)
(Looking Up Identifiers, Identifier Search, List Identifiers):
Adjudicate comments by Dmitry Gutov <dgutov@yandex.ru>. See
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00650.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00650.html
for the details.
2016-01-18 Eli Zaretskii <eliz@gnu.org>
@@ -10995,7 +11009,7 @@
Use it instead of the literal MB_ERR_INVALID_CHARS.
(maybe_load_unicows_dll): Initialize multiByteToWideCharFlags as
appropriate for the underlying OS version. For details, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00835.html.
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00835.html.
* src/w32.h: Declare multiByteToWideCharFlags.
* src/w32fns.c (Fx_file_dialog, Fw32_shell_execute)
(add_tray_notification): Use multiByteToWideCharFlags instead of
@@ -11011,7 +11025,7 @@
* etc/PROBLEMS (MS-Windows): Mention the problem with Shell32.dll
on Windows NT4. For the details, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00835.html.
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00835.html.
2016-01-16 Jussi Lahdenniemi <jussi@aprikoodi.fi> (tiny change)
@@ -11021,7 +11035,7 @@
special functions on Windows 9X. Refuse to dump Emacs on Windows 9X.
(malloc_after_dump_9x, realloc_after_dump_9x)
(free_after_dump_9x): New functions. (Bug#22379) See also
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00852.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00852.html
for more details about the original problem.
* nt/inc/ms-w32.h (malloc_after_dump_9x, realloc_after_dump_9x)
@@ -11166,7 +11180,7 @@
Un-obsolete tags-loop-continue
* lisp/progmodes/etags.el (tags-loop-continue): Un-obsolete.
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00682.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00682.html
2016-01-13 Eli Zaretskii <eliz@gnu.org>
@@ -11388,7 +11402,7 @@
(vc-hg-annotate-extract-revision-at-line-with-filename)
(vc-hg-annotate-extract-revision-at-line-with-both):
Don't refer to source-directory.
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00755.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00755.html
2016-01-11 Michael Albinus <michael.albinus@gmx.de>
@@ -11455,7 +11469,7 @@
This use of 'noexcept' runs afoul of the C++11 standard.
Problem reported by Philipp Stephani in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00706.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00706.html
* src/emacs-module.c (emacs_finalizer_function):
Move this typedef here ...
* src/emacs-module.h: ... from here, and use only the C
@@ -11619,7 +11633,7 @@
Fix (error ...) error
Problem reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00561.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00561.html
* lisp/vc/add-log.el (change-log-goto-source): Fix typos
introduced in my Aug 28 change, where I got confused by the
two meanings of (error ...).
@@ -11770,7 +11784,7 @@
* src/xdisp.c (message_to_stderr): If coding-system-for-write has
a non-nil value, use it to encode output in preference to
locale-coding-system. See the discussions in
- http://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00048.html
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00048.html
for the details.
* doc/lispref/os.texi (Terminal Output): Document how to send
@@ -11784,7 +11798,7 @@
* doc/misc/efaq.texi (Packages that do not come with Emacs):
Update the URI of MELPA and marmalade-repo. Reported by CHENG Gao
<chenggao@royau.me> in
- https://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00390.html.
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00390.html.
2016-01-06 Maksim Golubev <maksim.golubev72@gmail.com> (tiny change)
@@ -12405,7 +12419,7 @@
* lisp/mail/emacsbug.el (report-emacs-bug): Future-proof the
recent "built on" change to deterministic builds where
emacs-build-system will be nil. See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg01369.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg01369.html
2015-12-29 Jose A. Ortega Ruiz <jao@gnu.org> (tiny change)
@@ -12605,7 +12619,7 @@
* lisp/startup.el (initial-scratch-message):
Reword to avoid apostrophes, and to make it shorter.
See the thread starting in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg01241.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg01241.html
2015-12-26 Leo Liu <sdl.web@gmail.com>
@@ -13429,7 +13443,7 @@
commands for interactive Python and Guile interpreters.
(gdb-send): Recognize various ways of exiting from Python and
Guile interpreters and returning to GDB. For details, see
- http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00693.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg00693.html
and http://stackoverflow.com/questions/31514741.
2015-12-16 Paul Eggert <eggert@cs.ucla.edu>
@@ -13438,7 +13452,7 @@
C11 threads are not needed for Emacs now, and their use is causing
hassles on FreeBSD 10.x. Problem reported by Ashish SHUKLA in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00648.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg00648.html
* configure.ac: Do not check for C11 threads. Remove unnecessary
fiddling with CPPFLAGS when configuring pthreads.
* src/emacs-module.c (main_thread, check_main_thread)
@@ -13599,7 +13613,7 @@
Fix performance regression with gcc -O0
This fixes the smaller performance hit that I noted in:
- https://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00357.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg00357.html
* src/alloc.c (macro_XPNTR_OR_SYMBOL_OFFSET, macro_XPNTR):
* src/puresize.h (puresize_h_PURE_P)
(puresize_h_CHECK_IMPURE):
@@ -13977,7 +13991,7 @@
* src/lisp.h (XSYMBOL): Remove eassert incorrectly added in
previous change. It breaks on MS-Windows --with-wide-int.
Problem reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00275.html
+ https://lists.gnu.org/r/emacs-devel/2015-12/msg00275.html
2015-12-06 Paul Eggert <eggert@cs.ucla.edu>
@@ -14412,7 +14426,7 @@
* lisp/progmodes/xref.el (xref-backend-functions):
Use APPEND when adding the default element
- (http://lists.gnu.org/archive/html/emacs-devel/2015-12/msg00061.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-12/msg00061.html).
2015-12-01 Eli Zaretskii <eliz@gnu.org>
@@ -14904,7 +14918,7 @@
Matches". Improve wording. Fix lost extra whitespace.
(Search Customizations): Improve wording. (Bug#22036)
See also comments in
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02376.html.
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg02376.html.
* lisp/replace.el (query-replace, query-replace-regexp)
(query-replace-regexp-eval, replace-string, replace-regexp):
@@ -15007,7 +15021,7 @@
(module_non_local_exit_signal_1, module_non_local_exit_throw_1):
Do nothing and return with failure indication immediately, if some
previous module call signaled an error or wants to throw. See
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02133.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg02133.html
for the relevant discussions.
2015-11-27 Eli Zaretskii <eliz@gnu.org>
@@ -15201,7 +15215,7 @@
* src/emacs-module.c (module_format_fun_env):
exprintf doesn’t support %p, so use %x. Reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02122.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg02122.html
2015-11-25 Paul Eggert <eggert@cs.ucla.edu>
@@ -15210,7 +15224,7 @@
* lisp/help-fns.el (describe-variable): Quote the
variable’s value if it is a symbol other than t or nil.
See: T.V Raman in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02147.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg02147.html
2015-11-25 Dmitry Gutov <dgutov@yandex.ru>
@@ -15687,7 +15701,7 @@
Although the patch does fix Bug#21688 and prevents a core dump,
it also makes the message-mode-propertize test fail; see:
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01667.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg01667.html
Perhaps someone else can come up with a better fix some day.
* src/syntax.c (update_syntax_table_forward):
Propertize even when truncated.
@@ -15988,7 +16002,7 @@
Message-ID: \
<CAAdUY-KN06pvCMy5bt3+Buk3yeKjf6n9iB2FaSTTOPpCqPwyhA@mail.gmail.com>
- https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01707.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg01707.html
2015-11-20 Paul Eggert <eggert@cs.ucla.edu>
@@ -16258,7 +16272,7 @@
Be more systematic about quoting symbols `like-this' rather than
`like-this or 'like-this' in docstrings. This follows up Artur
Malabarba's email in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01647.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg01647.html
2015-11-18 Peder O. Klingenberg <peder@klingenberg.no>
@@ -16318,7 +16332,7 @@
Fix docstring quoting problems with ‘ '’
Problem reported by Artur Malabarba in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01513.html
+ https://lists.gnu.org/r/emacs-devel/2015-11/msg01513.html
Most of these fixes are to documentation; many involve fixing
longstanding quoting glitches that are independent of the
recent substitute-command-keys changes. The changes to code are:
@@ -16541,7 +16555,7 @@
* lisp/faces.el (faces--attribute-at-point): Fix an issue
Previous code would signal an error when the face at point was
- a manually built list of attributes such as '(:foregroud "white").
+ a manually built list of attributes such as '(:foreground "white").
* test/automated/faces-tests.el (faces--test-color-at-point): Add a test
@@ -17348,7 +17362,7 @@
Date: Wed, 28 Oct 2015 18:45:29 -0700
Message-ID: <m2y4emqwg6.fsf@newartisans.com>
- https://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02372.html
+ https://lists.gnu.org/r/emacs-devel/2015-10/msg02372.html
2015-11-10 David Reitter <david.reitter@gmail.com>
@@ -17764,7 +17778,7 @@
* lisp/progmodes/project.el (project-library-roots):
Remove directories inside the project roots from the result.
- (http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00536.html)
+ (https://lists.gnu.org/r/emacs-devel/2015-11/msg00536.html)
2015-11-08 Dmitry Gutov <dgutov@yandex.ru>
@@ -17976,7 +17990,7 @@
Avoid division by zero crash observed by Yuan MEI
- See http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html.
+ See https://lists.gnu.org/r/emacs-devel/2015-11/msg00194.html.
* src/dispnew.c (required_matrix_height, required_matrix_width):
Avoid division by zero.
@@ -18310,7 +18324,7 @@
* etc/PROBLEMS: Describe the problem with pinning Emacs to taskbar
on Windows 10. For the details, see the discussion starting at
- http://lists.gnu.org/archive/html/help-emacs-windows/2015-09/msg00000.html.
+ https://lists.gnu.org/r/help-emacs-windows/2015-09/msg00000.html.
2015-10-30 Artur Malabarba <bruce.connor.am@gmail.com>
@@ -18376,7 +18390,7 @@
* lisp/ielm.el (ielm-indent-line): Use non-nil arg of comint-bol
to go to the beginning of text line instead of command line.
- http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02360.html
+ https://lists.gnu.org/r/emacs-devel/2015-10/msg02360.html
2015-10-29 Eli Zaretskii <eliz@gnu.org>
@@ -18507,7 +18521,7 @@
* src/fileio.c (unhandled-file-name-directory): Default to calling
`file-name-as-directory'
- (http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02294.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-10/msg02294.html).
2015-10-28 Artur Malabarba <bruce.connor.am@gmail.com>
@@ -18670,7 +18684,7 @@
* lisp/vc/vc-hg.el (vc-hg-log-format): Pipe commit description
through 'tabindent'.
(vc-hg-log-view-mode): Set tab-width to 2 locally.
- (http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02259.html)
+ (https://lists.gnu.org/r/emacs-devel/2015-10/msg02259.html)
2015-10-27 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -18738,7 +18752,7 @@
* lisp/vc/vc-hg.el (vc-hg-log-format): New variable.
(vc-hg-print-log, vc-hg-expanded-log-entry): Use it.
- (http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02191.html)
+ (https://lists.gnu.org/r/emacs-devel/2015-10/msg02191.html)
2015-10-27 Nicolas Petton <nicolas@petton.fr>
@@ -20030,7 +20044,7 @@
(/ N) now returns the reciprocal of N
This is more compatible with Common Lisp and XEmacs (Bug#21690). See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-10/msg01053.html
+ https://lists.gnu.org/r/emacs-devel/2015-10/msg01053.html
* lisp/color.el (color-hue-to-rgb, color-hsl-to-rgb)
(color-xyz-to-srgb, color-xyz-to-lab):
* lisp/emacs-lisp/cl-extra.el (cl-float-limits):
@@ -20083,7 +20097,7 @@
Add an entry for the default directory compression (to *.tar.g).
(dired-compress-file): Update.
- See https://lists.gnu.org/archive/html/emacs-devel/2015-10/msg00949.html.
+ See https://lists.gnu.org/r/emacs-devel/2015-10/msg00949.html.
2015-10-20 Michael Sperber <mike@xemacs.org>
@@ -21438,7 +21452,7 @@
Fix a few problems with directed quotes
This is in response to a problem report by Kaushal Modi in:
- http://bugs.gnu.org/21588#25
+ https://bugs.gnu.org/21588#25
* lisp/cedet/mode-local.el (describe-mode-local-overload):
* lisp/emacs-lisp/bytecomp.el (byte-compile-fix-header):
* lisp/info-xref.el (info-xref-check-all-custom):
@@ -21625,7 +21639,7 @@
* src/window.c (Fpos_visible_in_window_p): Clarify the meaning of
t for POS. See
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg01040.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg01040.html
for the original report.
* doc/lispref/windows.texi (Window Start and End): Clarify the
@@ -22126,7 +22140,7 @@
Improve git diff hunk headers for .el, .texi
Problem reported by Alan Mackenzie in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00826.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00826.html
* .gitattributes (*.el, *.texi): New patterns.
* autogen.sh: Configure diff.elisp.xfuncname and
diff.texinfo.xfuncname if using Git.
@@ -22401,7 +22415,7 @@
a revision to checkin.
* lisp/vc/vc.el (vc-next-action): Allow to optionally specify the
revision when checking in files.
- See http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00688.html
+ See https://lists.gnu.org/r/emacs-devel/2015-09/msg00688.html
for the details.
2015-09-18 Wilson Snyder <wsnyder@wsnyder.org>
@@ -22586,7 +22600,7 @@
winner no longer holds on to dead frames
* lisp/winner.el (winner-change-fun): Cull dead frames.
This prevents a potentially massive memory leak. See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00619.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00619.html
2015-09-16 Michael Albinus <michael.albinus@gmx.de>
@@ -23021,7 +23035,7 @@
Port Unicode char detection to FreeBSD+svgalib
Problem reported by Ashish SHUKLA in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00531.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00531.html
* configure.ac: Check for struct unipair.unicode instead of for
<linux/kd.h>, since that’s more specific to what the code
actually needs.
@@ -23156,7 +23170,7 @@
Revert some stray curved quotes I missed earlier
Problem reported by David Kastrup in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00440.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00440.html
* lisp/international/mule-cmds.el (leim-list-header):
Use format-message with an ASCII-only format.
@@ -23186,12 +23200,12 @@
Add patch-sending instructions to git-workflow
From a suggestion by Mitchel Humpherys in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00421.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00421.html
* admin/notes/git-workflow (Sending patches): New section.
Port to GIFLIB 5.0.6 and later
Problem reported by Mitchel Humpherys in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00420.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00420.html
* src/image.c (HAVE_GIFERRORSTRING) [HAVE_GIF]: New macro.
(GifErrorString, init_gif_functions) [HAVE_GIF && WINDOWSNT]:
(gif_load) [HAVE_GIF]: Use it.
@@ -23209,7 +23223,7 @@
Refix movemail GCC pacification
Problem reported by Ken Brown in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00406.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00406.html
* lib-src/movemail.c (main): Fix previous change.
2015-09-09 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -23268,7 +23282,7 @@
Define internal-char-font even if --without-x
The function is used now even in non-graphical environments.
Problem reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00401.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00401.html
* src/font.c (Finternal_char_font): Move here ...
* src/fontset.c (Finternal_char_font): ... from here.
@@ -23310,7 +23324,7 @@
Also, undo the recent change that caused text-quoting-style to
affect quote display on terminals, so that the two features are
independent. See Alan Mackenzie in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00244.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00244.html
Finally, add a style parameter to startup--setup-quote-display,
so that this function can also be invoked after startup, with
different styles depending on user preference at the time.
@@ -23980,7 +23994,7 @@
Follow text-quoting-style in display table init
This attempts to fix a problem reported by Alan Mackenzie in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-09/msg00112.html
+ https://lists.gnu.org/r/emacs-devel/2015-09/msg00112.html
* doc/lispref/display.texi (Active Display Table):
Mention how text-quoting-style affects it.
* doc/lispref/help.texi (Keys in Documentation):
@@ -24348,7 +24362,7 @@
Make ‘text-quoting-style’ a plain defvar
It doesn’t need customization, as it’s likely useful only by experts.
Suggested by Stefan Monnier in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg01020.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg01020.html
* lisp/cus-start.el: Remove doc.c section for builtin customized vars.
Quoting fixes in lisp/textmodes
@@ -24631,7 +24645,7 @@
Assume GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS
This removes the need for GCPRO1 etc. Suggested by Stefan Monnier in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00918.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00918.html
* doc/lispref/internals.texi (Writing Emacs Primitives):
* etc/NEWS:
Document the change.
@@ -24808,7 +24822,7 @@
That way, the caller doesn’t have to use curved quotes to
get diagnostics that match the text-quoting-style preferences.
Suggested by Dmitry Gutov in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00893.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00893.html
This means we no longer need %qs, so remove that format.
While we’re at it, fix an unlikely bug and lessen the pressure
on the garbage collector by processing the string once rather
@@ -24965,7 +24979,7 @@
This is simpler and easier to explain, and should encourage better
typography. Do this in Electric Quote mode and when translating
quotes in docstrings. Inspired by a suggestion by Dmitry Gutov in:
- https://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00806.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00806.html
* doc/emacs/text.texi (Quotation Marks):
* doc/lispref/help.texi (Keys in Documentation):
* etc/NEWS:
@@ -25115,8 +25129,8 @@
and using the new function instead of ‘format’ only in contexts
where this seems appropriate.
Problem reported by Dmitry Gutov and Andreas Schwab in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00826.html
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00827.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00826.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00827.html
* doc/lispref/commands.texi (Using Interactive):
* doc/lispref/control.texi (Signaling Errors, Signaling Errors):
* doc/lispref/display.texi (Displaying Messages, Progress):
@@ -26208,7 +26222,7 @@
When run with --batch, check that curved quotes are compatible with
the system locale before outputting them in diagnostics.
Problem reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00594.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00594.html
* lisp/startup.el (command-line): Set internal--text-quoting-flag
after the standard display table is initialized.
* src/doc.c (default_to_grave_quoting_style): New function.
@@ -26640,7 +26654,7 @@
Introduce new macros to cover Emacs's new names in cl-lib.el
This also eliminates `mapcan' warnings in XEmacs.
* lisp/progmodes/cc-defs.el (c--mapcan-status): New variable to
- characterise [X]Emacs versions.
+ characterize [X]Emacs versions.
(top-level): Require either 'cl or 'cl-lib, depending on
c--mapcan-status.
Change this back to cc-external-require from an eval-when-compile
@@ -26799,7 +26813,7 @@
unread-command-events and unread-post-input-method-events are
always recorded by record_char. Reported by David Kastrup
<dak@gnu.org>, see
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00193.html.
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00193.html.
2015-08-10 Samer Masterson <samer@samertm.com>
@@ -26855,7 +26869,7 @@
ChangeLog.2 ignores remote-tracking merges
* build-aux/gitlog-to-emacslog: Ignore commit logs matching
"Merge remote-tracking branch '.*'" too. See Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00384.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00384.html
2015-08-09 Nicolas Richard <youngfrog@members.fsf.org>
@@ -27082,7 +27096,7 @@
Preserve window point in xref-find-definitions-other-window
Fix the problem reported by Ingo Logmar in
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00152.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00152.html
* lisp/progmodes/xref.el (xref--goto-char): Extract from
xref--goto-location.
(xref--pop-to-location): Use it. Replace xref--goto-location with
@@ -27168,9 +27182,9 @@
Rename help-quote-translation to text-quoting-style,
and use symbols rather than characters as values.
This follows suggestions along these lines by Alan Mackenzie in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-06/msg00343.html
+ https://lists.gnu.org/r/emacs-devel/2015-06/msg00343.html
and by Drew Adams in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00048.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00048.html
* doc/lispref/help.texi (Keys in Documentation)
* etc/NEWS:
* lisp/cus-start.el (standard):
@@ -27200,7 +27214,7 @@
Also mention "curly quotes"
See Drew Adams's email in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-08/msg00040.html
+ https://lists.gnu.org/r/emacs-devel/2015-08/msg00040.html
* doc/lispref/help.texi (Keys in Documentation):
Add index entry "curly quotes".
* etc/NEWS: Use the phrase "curly quotes" too.
@@ -27470,7 +27484,7 @@
Don't worry about $ac_cv_header_sys_resource_h and
$ac_cv_func_getrlimit, as they're no longer needed for this.
Problem reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-07/msg00443.html
+ https://lists.gnu.org/r/emacs-devel/2015-07/msg00443.html
2015-07-28 Andy Moreton <andrewjmoreton@gmail.com> (tiny change)
@@ -27852,7 +27866,7 @@
(xref-pulse-momentarily): Rename from xref--maybe-pulse.
(xref--pop-to-location, xref--display-position)
(xref-pop-marker-stack): Use the new hooks, as requested in
- http://lists.gnu.org/archive/html/emacs-devel/2015-07/msg00213.html
+ https://lists.gnu.org/r/emacs-devel/2015-07/msg00213.html
2015-07-19 Bozhidar Batsov <bozhidar@batsov.com>
@@ -27939,7 +27953,7 @@
Fix hang with large yanks This should fix the bug fixed by Mike
Crowe's patch in:
- https://lists.gnu.org/archive/html/emacs-devel/2015-07/msg00106.html
+ https://lists.gnu.org/r/emacs-devel/2015-07/msg00106.html
A problem in this area has been reported by several users; see
Bug#16737, Bug#17101, Bug#17026, Bug#17172, Bug#19320, Bug#20283.
This fix differs from Mike Crowe's patch in that it should avoid a
@@ -28657,7 +28671,7 @@
* src/frame.c (x_set_font): If font_spec_from_name returns nil,
don't barf; instead, request a new fontset to be generated. This
avoids unnecessarily rejecting fonts named against XLFD rules. See
- http://lists.gnu.org/archive/html/help-emacs-windows/2015-06/msg00001.html,
+ https://lists.gnu.org/r/help-emacs-windows/2015-06/msg00001.html,
for the description of the original problem.
* lisp/faces.el (set-face-attribute): Don't be fooled too easily
by a hyphen in a font's name.
@@ -28831,7 +28845,7 @@
* src/font.c (font_load_for_lface): If the font-spec didn't match
any available fonts, try again without interpreting trailing "-NN"
as the font size. For the description of the original problem, see
- http://lists.gnu.org/archive/html/help-emacs-windows/2015-06/msg00001.html
+ https://lists.gnu.org/r/help-emacs-windows/2015-06/msg00001.html
.gdbinit followup to changes in !USE_LSB_TAG
* src/.gdbinit (xgetsym): Don't left-shift $ptr even under
@@ -28921,7 +28935,7 @@
Improve docstring for macroexp-let2
* lisp/emacs-lisp/macroexp.el (macroexp-let2):
Improve as per suggestion by RMS in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-06/msg00621.html
+ https://lists.gnu.org/r/emacs-devel/2015-06/msg00621.html
Also, rename args to match new doc string.
2015-06-27 Eli Zaretskii <eliz@gnu.org>
@@ -29011,7 +29025,7 @@
* lisp/term/w32console.el (terminal-init-w32console):
* src/doc.c (Fsubstitute_command_keys, Vhelp_quote_translation):
If ‘ is not displayable, transliterate it to `, not to '. See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-06/msg00542.html
+ https://lists.gnu.org/r/emacs-devel/2015-06/msg00542.html
Fix C99 incompatibilities in Cairo code
* src/image.c (xpm_load) [USE_CAIRO]:
@@ -29797,7 +29811,7 @@
* lisp/emacs-lisp/derived.el (derived-mode-make-docstring):
Nest regexp-quote inside format, not the reverse.
Problem reported by Artur Malabarba in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-06/msg00206.html
+ https://lists.gnu.org/r/emacs-devel/2015-06/msg00206.html
2015-06-15 Eli Zaretskii <eliz@gnu.org>
@@ -30829,7 +30843,7 @@
use CRLF (or CR!) termination for lines.
Update .gitattributes to match current sources
- http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00879.html
+ https://lists.gnu.org/r/emacs-devel/2015-05/msg00879.html
* .gitattributes: Accommodate tests that insist on DOS format.
Remove test/automated/data/decompress/foo-gzipped.
Add etc/e/eterm-color.
@@ -30854,7 +30868,7 @@
Use list for the tags completion table, not obarray
* lisp/progmodes/etags.el (etags-tags-completion-table): Return a
list instead of an obarray
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00876.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-05/msg00876.html).
(tags-completion-table): Combine those lists.
(tags-completion-table): Update the docstring.
@@ -31769,7 +31783,7 @@
Revert doc string changes to f90.el
Problem reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00596.html
+ https://lists.gnu.org/r/emacs-devel/2015-05/msg00596.html
* lisp/progmodes/f90.el (f90-mode, f90-abbrev-start):
Revert recent changes to doc strings, as it's intended that they
use grave accent, not quote.
@@ -31855,7 +31869,7 @@
Prefer "this" to “this” in doc strings
This mostly just straightens quotes introduced in my previous patch.
Suggested by Dmitry Gutov in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00565.html
+ https://lists.gnu.org/r/emacs-devel/2015-05/msg00565.html
* lisp/faces.el, lisp/gnus/gnus-group.el, lisp/ldefs-boot.el:
* lisp/mail/supercite.el, lisp/net/tramp.el, lisp/recentf.el:
* lisp/textmodes/artist.el, lisp/textmodes/rst.el:
@@ -31965,8 +31979,8 @@
New command icomplete-force-complete-and-exit
* lisp/icomplete.el (icomplete-force-complete-and-exit):
New command
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00461.html)
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00516.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-05/msg00461.html)
+ (https://lists.gnu.org/r/emacs-devel/2015-05/msg00516.html).
(icomplete-minibuffer-map): Bind C-j to it.
(icomplete-forward-completions, icomplete-backward-completions):
Mention the new command in the docstring.
@@ -32017,10 +32031,10 @@
2015-05-18 Dmitry Gutov <dgutov@yandex.ru>
- Add a test case for Maven warning ouput
+ Add a test case for Maven warning output
* test/automated/compile-tests.el
(compile-tests--test-regexps-data): Add a case for Maven warning
- ouput.
+ output.
(compile--test-error-line): Check the compilation message type, if
it's specified in the test data.
@@ -32114,7 +32128,7 @@
eshell: Introduce new buffer syntax
The new buffer syntax '#<buffer-name>' is equivalent to '#<buffer
buffer-name>'. Remove `eshell-buffer-shorthand', as it is no longer
- needed (Bug#19319).
+ needed (Bug#19391).
* lisp/eshell/esh-io.el (eshell-buffer-shorthand): Remove.
(eshell-get-target): Remove shorthand-specific code.
* lisp/eshell/esh-arg.el (eshell-parse-special-reference): Parse
@@ -32142,7 +32156,7 @@
(xpm_load): Call the above functions. Handle XPM without mask
when USE_CAIRO.
(png_load_body): Handle USE_CAIRO case.
- (png_load): Remove USE_CAIRO specific fuction, modify png_load_body
+ (png_load): Remove USE_CAIRO specific function, modify png_load_body
instead.
(jpeg_load_body): Call create_cairo_image_surface.
(gif_load, svg_load_image): Handle specified background, call
@@ -32793,7 +32807,7 @@
Fix tagging of symbols in C enumerations
* lib-src/etags.c (consider_token): Don't tag symbols in
expressions that assign values to enum constants. See
- http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00291.html
+ https://lists.gnu.org/r/emacs-devel/2015-05/msg00291.html
for details.
(C_entries): Reset fvdef to fvnone after processing a preprocessor
conditional and after a comma outside of parentheses.
@@ -32952,7 +32966,7 @@
Remove tag-symbol-match-p from etags-xref-find-definitions-tag-order
* lisp/progmodes/etags.el (etags-xref-find-definitions-tag-order):
Remove tag-symbol-match-p from the default value
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00292.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-05/msg00292.html).
Declare find-tag obsolete
* lisp/progmodes/etags.el (find-tag): Declare obsolete in favor of
@@ -33148,7 +33162,7 @@
* lisp/cedet/pulse.el (pulse-momentary-unhighlight): Only cancel
timer when it is non-nil
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00223.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-05/msg00223.html).
2015-05-06 Glenn Morris <rgm@gnu.org>
@@ -33248,7 +33262,7 @@
* lisp/cedet/pulse.el (pulse-momentary-stop-time): New variable.
(pulse-momentary-highlight-overlay): Set up the timer instead of
calling `pulse'
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/).
+ (https://lists.gnu.org/r/emacs-devel/2015-05/).
(pulse-tick): New function.
(pulse-momentary-unhighlight): Cut off the stop time.
(pulse-delay): Update the docstring WRT to not using sit-for.
@@ -33441,7 +33455,7 @@
(pulse-momentary-highlight-region): Add autoload cookie.
* lisp/progmodes/xref.el (xref--maybe-pulse): Don't highlight the
indentation, or the newline, if the line's non-empty
- (http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00118.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-05/msg00118.html).
2015-05-04 Daniel Colascione <dancol@dancol.org>
@@ -33808,7 +33822,7 @@
* lisp/progmodes/xref.el (xref--xref-buffer-mode):
Set `next-error-function' and `next-error-last-buffer'.
(xref--next-error-function): New function.
- (http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg01311.html)
+ (https://lists.gnu.org/r/emacs-devel/2015-04/msg01311.html)
2015-04-29 Fabián Ezequiel Gallina <fgallina@gnu.org>
@@ -34082,7 +34096,7 @@
Introduce xref-prompt-for-identifier
* lisp/progmodes/xref.el (xref-prompt-for-identifier): New option.
(xref--read-identifier): Use it
- (http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg01205.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-04/msg01205.html).
2015-04-26 João Távora <joaotavora@gmail.com>
@@ -34099,7 +34113,7 @@
Pass `id' to `completing-read' as def instead of initial input
* lisp/progmodes/xref.el (xref--read-identifier): Pass `id' to
`completing-read' as the default value instead of initial input
- (http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg01182.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-04/msg01182.html).
2015-04-25 Paul Eggert <eggert@cs.ucla.edu>
@@ -34710,7 +34724,7 @@
Standardize names of ChangeLog history files
Suggested by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00678.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00678.html
* Makefile.in (install-man): Don't treat ChangeLog.1 as a man page.
* doc/man/ChangeLog.1: Rename back from doc/man/ChangeLog.01.
* lisp/erc/ChangeLog.1: New file, containing the old contents of ...
@@ -34723,7 +34737,7 @@
This more clearly distingiushes pre-April-7 ChangeLog entries (which
are for top-level files only) from post-April-7 entries (which are
about files at all levels. Problem reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00678.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00678.html
* ChangeLog.1: Move post-April-7 entries from here ...
* ChangeLog.2: ... to this new file.
* Makefile.in (CHANGELOG_HISTORY_INDEX_MAX): Bump to 2.
@@ -35117,7 +35131,7 @@
* doc/man/ChangeLog.01: Rename from doc/man/ChangeLog.1.
That way, 'make install' won't think it's a man page.
Reported by Ashish SHUKLA in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00656.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00656.html
Improve 'make change-history' prereq tests
* Makefile.in (gen_origin): Fix to match what's in the master branch.
@@ -35306,7 +35320,7 @@
Port commit-msg to MSYS Bash+Gawk
See Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00610.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00610.html
* build-aux/git-hooks/commit-msg (cent_sign_utf8_format)
(cent_sign, print_at_sign, at_sign): Revert previous change.
(print_at_sign): Prepend "BEGIN".
@@ -35316,7 +35330,7 @@
* build-aux/git-hooks/commit-msg (cent_sign):
Just use UTF-8 here rather than ASCII + printf, as the latter fails
on a broken MS-Windows shell. Reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00592.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00592.html
2015-04-11 Chris Zheng <chriszheng99@gmail.com> (tiny change)
@@ -35351,7 +35365,7 @@
Add a FIXME comment.
(log-edit-changelog-entries): Extract from
`log-edit-changelog-entries', handle FILE being a directory
- (http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00555.html).
+ (https://lists.gnu.org/r/emacs-devel/2015-04/msg00555.html).
2015-04-10 Paul Eggert <eggert@cs.ucla.edu>
@@ -35363,19 +35377,19 @@
* build-aux/git-hooks/commit-msg:
Ignore every line after a scissors line, such as a line generated
by 'git commit -v'. Problem reported by Johan Bockgård in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00580.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00580.html
port commit-msg to Gawk 3.0.4 (1999)
* build-aux/git-hooks/commit-msg (cent_sign_utf8_format, cent_sign)
(print_at_sign, at_sign): New vars. Use them to avoid problems
Eli Zaretskii encountered with Gawk 3.0.4 (1999) on MSYS. See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00566.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00566.html
Have commit-msg report commit failure
* build-aux/git-hooks/commit-msg: If the commit is aborted,
say so. Simplify by doing this at the end. Problem reported
by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00566.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00566.html
2015-04-10 Thomas Fitzsimmons <fitzsim@fitzsim.org>
@@ -35449,7 +35463,7 @@
vmotion, for the same reason. Fix the clipping of the argument
value to support scroll-margin in all cases and avoid unwarranted
recentering. Reported by Milan Stanojević <milanst@gmail.com> in
- http://lists.gnu.org/archive/html/help-gnu-emacs/2015-04/msg00092.html,
+ https://lists.gnu.org/r/help-gnu-emacs/2015-04/msg00092.html,
which see.
2015-04-09 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -35540,7 +35554,7 @@
for copyright notice prototype, so that we get a proper "coding:"
cookie. Use 'mv -i' to avoid unconditionally overwriting an
existing ChangeLog. Problems reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-04/msg00504.html
+ https://lists.gnu.org/r/emacs-devel/2015-04/msg00504.html
Merge from gnulib
* build-aux/gitlog-to-changelog: Update from gnulib, incorporating:
@@ -35788,4 +35802,4 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/ChangeLog.3 b/ChangeLog.3
index 9f43511991c..46d98d80262 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1,3 +1,28682 @@
+2017-10-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Format shell commands in tramp.texi
+
+ * doc/misc/tramp.texi (Obtaining Tramp, Remote shell setup):
+ Format shell commands better.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Unbreak the button in the Flymake diagnostics buffer again
+
+ Adding the 'keymap' property enabled RET but broke the mouse-action.
+
+ * lisp/progmodes/flymake.el
+ (flymake--diagnostics-buffer-entries): Use 'action' instead of 'keymap'.
+
+2017-10-10 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add mode map to Flymake diagnostic button
+
+ * lisp/progmodes/flymake.el (flymake--diagnostics-buffer-entries): Add
+ keymap propery.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Tweak the Flymake diagnostics buffer again
+
+ * lisp/progmodes/flymake.el
+ (flymake-diagnostics-buffer-mode-map): Don't bind [mouse-1].
+ (flymake-show-diagnostic): Rename from
+ flymake-show-diagnostic-at-point. Really use another window.
+ (flymake-goto-diagnostic): Rename from
+ flymake-goto-diagnostic-at-point.
+ (flymake--diagnostics-buffer-entries): Use a button just for
+ the message bit.
+
+2017-10-10 Mark Oteiza <mvoteiza@udel.edu>
+
+ Simplify Flymake diagnostics buffer UX
+
+ Don't create text-buttons unnecessarily, just bind RET and SPC in the
+ diagnostics buffer to a command that figures out which diagnostic it
+ was invoked on.
+
+ * lisp/progmodes/flymake.el
+ (flymake--diagnostics-buffer-mode-keymap): Renamed from
+ flymake--diagnostics-buffer-button-keymap.
+ (flymake-show-diagnostic-at-point): Don't take a button.
+ (flymake-goto-diagnostic-at-point): Don't pass button to
+ flymake-show-diagnostic-at-point.
+ (flymake--diagnostics-buffer-entries): Simplify.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ First stab at a Flymake diagnostics buffer
+
+ The diagnostics buffer summarizes the diagnostics of a buffer in a
+ tabulated list and is permanently updated after each Flymake check.
+
+ * lisp/progmodes/flymake.el (flymake--handle-report): Call
+ flymake-show-diagnostics-buffer under certain conditions.
+ (flymake-menu, flymake--diagnostics-buffer-source)
+ (flymake--diagnostics-buffer-button-keymap)
+ (flymake-show-diagnostic-at-point)
+ (flymake-goto-diagnostic-at-point)
+ (flymake--diagnostics-buffer-entries)
+ (flymake-diagnostics-buffer-mode)
+ (flymake--diagnostics-buffer-name)
+ (flymake-show-diagnostics-buffer): New definitions.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ * etc/NEWS (Flymake): Rewrite entry.
+
+2017-10-10 Eli Zaretskii <eliz@gnu.org>
+
+ Improve the Flymake manual
+
+ * doc/misc/flymake.texi: Add a 'coding' cookie. Add a
+ @syncodeindex directive for @vindex. Use 2 spaces between
+ sentences. Lower-case @cindex entries.
+ (Overview of Flymake): Fix use of @itemize and @pxref. Fix
+ punctuation and markup.
+ (Backend exceptions): Use @emph instead of @dfn. Add more
+ indexing.
+ (Customizable variables, Extending Flymake): Improve wording.
+ (Flymake error types): Fix usage of @itemize. Improve wording.
+ (Backend functions): Fix punctuation. Fix markup. Add a
+ cross-reference to ELisp manual.
+ (Flymake utility functions): Add a cross-reference to ELisp manual.
+ (An annotated example backend): Fix punctuation and typos.
+ (Flymake mode, Running the syntax check)
+ (Navigating to error lines, Backend exceptions)
+ (Customizable variables, Flymake error types, Backend functions)
+ (Flymake utility functions, Proc customization variables)
+ (Locating a master file, Locating the buildfile)
+ (Starting the syntax check process, Parsing the output)
+ (Interaction with other modes): Fix indexing. Add index entries
+ for functions, variables, and concepts.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Fix two Flymake bugs
+
+ * lisp/progmodes/flymake.el (define-fringe-bitmap): Protect
+ against --without-x.
+ (flymake--mode-line-format): Ensure mode-line's mouse-4 and mouse-5 work
+ in their own windows.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Don't log "emergencies" in the Flymake legacy backend
+
+ * lisp/progmodes/flymake-proc.el (flymake-proc--panic)
+ (flymake-proc-legacy-flymake): Don't log "emergencies"
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Add full documentation on new Flymake API
+
+ Also, as a minor addition to this API, set flymake-text
+ on the diagnostic overlay. This enables a good example in
+ the section "Customization Flymake annotations".
+
+ * doc/misc/flymake.texi (Overview of Flymake)
+ (Syntax check statuses): Rework.
+ (Backend exceptions): Rename from "Troubleshooting"
+ (Customizable variables): Add flymake-start-on-flymake-mode. Rework.
+ (Extending Flymake): Write chapter.
+ (Customizing Flymake annotations, Flymake backends)
+ (Flymake utility functions, An annotated example backend):
+ New sections and subsections
+
+ * lisp/progmodes/flymake.el (flymake-diagnostic-functions)
+ (flymake-diagnostic-types-alist): Rework docstring.
+ (flymake--highlight-line): Set and use flymake-text property in overlay.
+ (flymake-goto-next-error, flymake-goto-prev-error): Fix funny quotes.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Fix some Flymake docstrings and messages
+
+ * lisp/progmodes/flymake.el
+ (flymake-start-on-flymake-mode): fix typo.
+ (flymake-mode): Add docstring.
+ (flymake-mode-line-format): Fix help-echo indications. mouse-2
+ describes flymake-mode.
+
+2017-10-10 João Távora <joaotavora@gmail.com>
+
+ Make three new Flymake commands for debugging common problems
+
+ * lisp/progmodes/flymake.el (flymake-running-backends)
+ (flymake-disabled-backends)
+ (flymake-reporting-backends): Make interactive.
+ (flymake--collect): Take optional arg.
+
+2017-10-09 Nicolas Petton <nicolas@petton.fr>
+
+ * admin/authors.el (authors-renamed-files-alist): addition.
+
+2017-10-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix PWD check on DOS_NT
+
+ * src/sysdep.c (get_current_dir_name_or_unreachable):
+ Do not consider a file name like "a:b" to be absolute on DOS_NT.
+
+2017-10-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix unlikely overflows with wd length
+
+ * src/sysdep.c (get_current_dir_name_or_unreachable):
+ Avoid integer overflow if working directory name is absurdly long.
+ When allocating memory for getcwd, do not exceed MAXPATHLEN.
+
+2017-10-09 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/gnus/message.el: Improve last commit
+
+ (message-clone-locals): Don't mistakenly match other variables whose
+ name happens to include "message-default-charset".
+
+2017-10-09 Ken Olum <kdo@cosmos.phy.tufts.edu>
+
+ Fix problems when editing raw undecoded message (Bug#28671)
+
+ * lisp/mail/rmailedit.el (rmail-cease-edit): If rmail-old-mime-state
+ is set, meaning that we are editing the raw message, do not
+ encode it again. Delete old body after, not before, inserting
+ new, to avoid moving marker at beginning of next message.
+
+2017-10-09 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid encoding errors in message.el
+
+ * lisp/gnus/message.el (message-clone-locals): Don't clone
+ message-default-charset. (Bug#25645)
+
+2017-10-09 Eli Zaretskii <eliz@gnu.org>
+
+ Improve doc string and prompt of 'grep-read-files'
+
+ * lisp/progmodes/grep.el (grep-read-files): Clarify in the doc
+ string and in the prompt that shell wildcards can be used.
+ Suggested by Allen Li <vianchielfaura@gmail.com>. (Bug#28615)
+
+2017-10-09 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violations when line numbers are displayed
+
+ * src/xdisp.c (redisplay_window): Clear the window's desired glyph
+ matrix before calling try_window with the same starting point.
+ This avoids assertion violations when switching from a buffer
+ without line numbers to a buffer with line numbers. (Bug28710)
+
+2017-10-09 João Távora <joaotavora@gmail.com>
+
+ Be lazy when starting Flymake checks
+
+ Don't start the check immediately if the buffer is not being
+ displayed. Wait until it is, using window-configuration-change-hook.
+
+ This enables the user to batch-enable flymake-mode on many buffers and
+ not have that operation exhaust system resources for checking each
+ one. Likewise, an editing or save operation in a currently
+ non-displayed buffer does not immediately start a check.
+
+ * lisp/progmodes/flymake.el (flymake-start-on-flymake-mode):
+ Rename from flymake-start-syntax-check-on-find-file.
+ (flymake-start-syntax-check-on-find-file): Obsolete alias for
+ flymake-start-on-flymake-mode.
+ (flymake-start): Redesign. Affect the global post-command-hook
+ and local window-configuraiton-change-hook.
+ (flymake--schedule-timer-maybe)
+ (flymake-after-change-function, flymake-after-save-hook): Pass
+ t to flymake-start.
+
+ * test/lisp/progmodes/flymake-tests.el (flymake-tests--call-with-fixture)
+ (dummy-backends, recurrent-backend): Start flymake check
+ explicitly and immediately.
+
+2017-10-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change in frameset.el
+
+ * lisp/frameset.el (frameset-filter-font-param): Fix a thinko in
+ filtering the 'font' parameter. (Bug#17352)
+
+2017-10-09 Martin Rudalics <rudalics@gmx.at>
+
+ Describe how window dividers can replicate vertical borders (Bug#27830)
+
+ * doc/emacs/frames.texi (Scroll Bars): Describe how window
+ dividers can be used to replicate vertical borders when scroll
+ bars are disabled (Bug#27830).
+ * doc/emacs/frames.texi (Window Dividers): Mention their use
+ in replicating vertical borders.
+
+2017-10-09 Alexander Gramiak <agrambot@gmail.com>
+
+ Add line-number faces to the display-line-numbers group
+
+ See https://lists.gnu.org/r/emacs-devel/2017-10/msg00151.html
+ and its resulting thread.
+
+ * lisp/display-line-numbers.el (display-line-numbers): Add to the
+ convenience group.
+ * lisp/faces.el (line-number):
+ (line-number-current-line): Add to the display-line-numbers group.
+
+2017-10-09 Alexander Gramiak <agrambot@gmail.com>
+
+ Increase xterm click count only within double-click-fuzz
+
+ * lisp/xt-mouse.el (xterm-mouse-event): Save the last click's position
+ and check it against the current click's position. (Bug#28658)
+
+2017-10-08 Alan Third <alan@idiocy.org>
+
+ Change pause in fullscreen toggling for NS port (bug#28496)
+
+ * lisp/frame.el (toggle-frame-fullscreen): Replace sit-for with
+ sleep-for, and reduce time.
+
+2017-10-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Handle PARENTS properly in tramp-*-handle-make-directory
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-make-directory):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-make-directory):
+ Handle PARENTS properly.
+
+ * test/lisp/net/tramp-tests.el (tramp-test13-make-directory):
+ Extend test.
+
+2017-10-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve test for unreachable dirs
+
+ * src/sysdep.c (get_current_dir_name_or_unreachable):
+ New function, with most of the old contents of
+ emacs_get_current_dir_name.
+ (emacs_get_current_dir_name): Use it. Use a simpler
+ test for unreachable directory strings, and also apply
+ it to getcwd etc. (Bug#27871)
+
+2017-10-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/xsmfns.c (x_session_initialize): Fix memory leak.
+
+2017-10-08 K. Handa <handa@gnu.org>
+
+ New option for handling ZWNJ in Arabic text rendering
+
+ Provide a new option 'arabic-shaper-ZWNJ-handling' that controls how
+ to display ZWNJ in Arabic text rendering (Bug#28339).
+ * lisp/language/misc-lang.el: Register arabic-shape-gstring in
+ composition-function-table.
+ (arabic-shaper-ZWNJ-handling): New variable.
+ (arabic-shape-log): New variable.
+ (arabic-shape-gstring): New function.
+ * lisp/composite.el (lgstring-remove-glyph): New function.
+
+2017-10-08 Noam Postavsky <npostavs@gmail.com>
+
+ Make python prettify symbols into a defvar (Bug#28713)
+
+ * lisp/progmodes/python.el (python-prettify-symbols-alist): New
+ variable.
+ (python--prettify-symbols-alist): Make into obsolete alias for
+ `python-prettify-symbols-alist'.
+
+2017-10-07 Alan Third <alan@idiocy.org>
+
+ Fix fullscreen crash on macOS (bug#28496)
+
+ * lisp/frame.el (toggle-frame-fullscreen): Wait for animation to
+ complete on macOS.
+
+2017-10-07 Alan Third <alan@idiocy.org>
+
+ Fix crash when closing fullscreen frame on macOS (bug#28661)
+
+ * src/nsterm.m (EmacsView::windowWillResize): Return new frame size
+ unmodified if the frame isn't live.
+
+2017-10-07 Michael Albinus <michael.albinus@gmx.de>
+
+ Support gio tool in Tramp
+
+ "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
+ must use "gio <command>" tool instead.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-gio-mapping): New defconst.
+ (tramp-gvfs-handle-file-notify-add-watch): Support also "gio monitor"
+ (tramp-gvfs-gio-tool-p): New defun.
+ (tramp-gvfs-send-command): Use it. Call gio tool if available.
+
+2017-10-07 João Távora <joaotavora@gmail.com>
+
+ Fix flymake-goto-next-error when message has %-constructs
+
+ * lisp/progmodes/flymake.el (flymake-goto-next-error): Fix
+ message call. Add missing period in docstring.
+
+2017-10-07 Piotr Trojanek <piotr.trojanek@gmail.com>
+
+ * src/gnutls.c (syms_of_gnutls): Remove duplicated call to DEFSYM.
+
+2017-10-07 Eli Zaretskii <eliz@gnu.org>
+
+ Move the entry about 'format' into Incompatible Lisp Changes
+
+ * etc/NEWS: Move the entry about 'format' refraining from allocating
+ new strings into Incompatible Lisp Changes. (Bug#28625)
+
+2017-10-07 Eli Zaretskii <eliz@gnu.org>
+
+ Fix glitches in displaying TTY menus
+
+ * src/dispnew.c (update_frame_line): Accept an additional argument
+ UPDATING_MENU_P; if non-zero, home the cursor before updating a
+ frame's line. All callers changed.
+ (update_frame_1): Accept an additional argument UPDATING_MENU_P,
+ and pass it to update_frame_line. All callers changed.
+ (update_frame_with_menu): Call update_frame_1 with last argument
+ non-zero. (Bug#17497)
+
+2017-10-06 Gemini Lasswell <gazally@runbox.com>
+
+ Create new Edebug spec for docstrings and use it in closures
+
+ Since (:documentation FORM) can be used to create a docstring
+ when lexical-binding is on, allow for that possibility in Edebug
+ specs (bug#24773).
+ * lisp/emacs-lisp/edebug.el: Define an Edebug spec for docstrings
+ called lambda-doc and modify the Edebug specs for defun and
+ defmacro to use it.
+ (edebug-instrument-function): Check for generic functions first,
+ to fix bug where edebug-step-in didn't work on methods now that
+ cl-defgeneric has an Edebug spec.
+ * lisp/subr.el (lambda): Modify Edebug spec to use lambda-doc.
+ * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Add Edebug spec
+ (bug#27747).
+ (cl-defmethod): Use lambda-doc in Edebug spec.
+ * lisp/emacs-lisp/cl-macs.el: Modify Edebug spec for
+ cl-declarations-or-string to use lambda-doc, and modify Edebug
+ spec for cl-lambda-expr to use cl-declarations-or-string.
+ * lisp/emacs-lisp/pcase.el (pcase-lambda): Modify Edebug spec to
+ use lambda-doc, as well as &define and def-body which are
+ necessary for using Edebug on code wrapped by lambda.
+ * lisp/emacs-lisp/generator.el (iter-defun, iter-lambda): Add
+ Edebug specs.
+
+2017-10-06 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid byte-compilation warnings in message.el
+
+ * lisp/gnus/message.el: Require 'subr-x' when compiling, to
+ avoid compiler warnings.
+
+2017-10-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug in recent styled_format change
+
+ Problem reported by Kaushal Modi in:
+ https://lists.gnu.org/r/emacs-devel/2017-10/msg00141.html
+ * src/editfns.c (styled_format): Fix bug where USE_SAFE_ALLOCA was
+ not always followed by SAFE_FREE. This bug was introduced in my
+ patch 2017-09-26T23:31:57Z!eggert@cs.ucla.edu entitled "Avoid some
+ unnecessary copying in Fformat etc."
+
+2017-10-06 João Távora <joaotavora@gmail.com>
+
+ Cleanup emacs-lisp-mode's use of Flymake
+
+ * lisp/progmodes/elisp-mode.el (elisp-flymake--checkdoc-1):
+ Delete.
+ (elisp-flymake-checkdoc): Incorporate old
+ elisp-flymake--checkdoc-1.
+ (elisp-flymake--byte-compile-done): Simplify. Don't cleanup
+ here.
+ (elisp-flymake-byte-compile): Remove spurious interactive spec.
+ Simplify. Cleanup on every possible exit.
+
+2017-10-06 João Távora <joaotavora@gmail.com>
+
+ Fix @include directive in Flymake doc
+
+ * doc/misc/flymake.texi: Don't @include a relative path.
+
+2017-10-06 Mark Oteiza <mvoteiza@udel.edu>
+
+ Move read-multiple-choice to its own library
+
+ * lisp/emacs-lisp/rmc.el: New file.
+ * lisp/emacs-lisp/subr-x.el (read-multiple-choice): Remove.
+ * lisp/gnus/message.el:
+ * lisp/net/nsm.el: Change required library.
+
+2017-10-06 Piotr Trojanek <piotr.trojanek@gmail.com>
+
+ * src/process.c (syms_of_process): Remove duplicated call to DEFSYM.
+
+ Fixes: Bug#28721
+
+2017-10-06 Lele Gaifax <lele@metapensiero.it>
+
+ Fix typos in Flymake documentation
+
+ * doc/misc/flymake.texi (Syntax check statuses)
+ (Adding support for a new syntax check tool)
+ (Implementation overview, Locating the buildfile): Fix typos.
+
+ * lisp/progmodes/flymake-proc.el (flymake-proc--report-fn)
+ (flymake-proc--find-possible-master-files):Fix typos.
+ (flymake-proc--panic)
+ (flymake-proc-legacy-flymake): Fix function reference in doc.
+
+ * lisp/progmodes/flymake.el (flymake-error)
+ (flymake-diagnostic-functions): Fix typos.
+ (flymake-diagnostic-types-alist): Rephrase and fix typos.
+ (flymake--backend-state): Fix typos and rephrase.
+ (flymake--handle-report): Delete empty line.
+ (flymake--disable-backend)
+ (flymake--run-backend): Fix typos.
+ (flymake-goto-next-error, flymake-goto-prev-error): Rephrase.
+
+2017-10-06 Eli Zaretskii <eliz@gnu.org>
+
+ Revert last change in 'shr-descend'
+
+ * lisp/net/shr.el (shr-descend): Revert the part of the last
+ change which introduced calls to shr-indirect-call into this
+ function. Add a comment explaining the rationale for that.
+ (Bug#28402)
+
+2017-10-06 João Távora <joaotavora@gmail.com>
+
+ Don't error when turning on Flymake with no known backends
+
+ Leave it to the mode line indicator to inform the user that there
+ is still some configuration to do.
+
+ * lisp/progmodes/flymake.el (flymake-mode): Simplify.
+
+2017-10-06 João Távora <joaotavora@gmail.com>
+
+ Delete a Flymake obsolete alias that can't possibly work
+
+ The function `flymake-ler-make-ler' can't possibly work as an backward
+ compatible interface to existing extensinos (even purely hypothetical
+ ones, since none are known). This is because every diagnostic
+ considered by Flymake has to passed to a report-fn function.
+
+ * lisp/progmodes/flymake.el (flymake-ler-make-ler): Delete.
+
+2017-10-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug with unmounted directory on GNU/Linux
+
+ * src/sysdep.c (emacs_get_current_dir_name): Do not use
+ get_current_dir_name result unless it is absolute (Bug#27871).
+
+
+2017-10-05 Nicolas Petton <nicolas@petton.fr>
+
+ Update authors.el
+
+ * admin/authors.el (authors-renamed-files-alist)
+ (authors-valid-file-names): Additions.
+
+2017-10-05 Gemini Lasswell <gazally@runbox.com>
+
+ Fix dynamic binding wrapper in iter-lambda (bug#25965)
+
+ * lisp/emacs-lisp/generator.el (cps--make-dynamic-binding-wrapper):
+ Remove extra evaluation of form.
+ * test/lisp/emacs-lisp/generator-tests.el
+ (cps-iter-lambda-with-dynamic-binding): New test.
+
+2017-10-05 Rasmus <rasmus@gmx.us>
+
+ Update Org to v9.1.2
+
+ Please note this is a bugfix release. See etc/ORG-NEWS for details.
+
+2017-10-05 Alan Mackenzie <acm@muc.de>
+
+ Fix irregularities with CC Mode fontification, particularly with "known types"
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-declarators): Introduce a new
+ optional parameter, template-class. In "class <X = Y>", fontify "Y" as a
+ type.
+ (c-font-lock-single-decl): New variable template-class, set to non-nil when we
+ have a construct like the above. Pass this as argument to
+ c-font-lock-declarators.
+ (c-font-lock-cut-off-declarators): Check more rigorously that a declaration
+ being processed starts before the function's starting position.
+ (c-complex-decl-matchers): Remove the redundant clause which fontified "types
+ preceded by, e.g., "struct"".
+
+ * lisp/progmodes/cc-langs.el (c-template-typename-kwds)
+ (c-template-typename-key): New lang defconsts and defvar.
+
+2017-10-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix breakage due to recent change in tabulated-list-print-entry
+
+ * lisp/emacs-lisp/tabulated-list.el (tabulated-list-printer):
+ Update the doc string.
+ (tabulated-list-print-entry): Revert to using only 2 arguments.
+ Update the doc string.
+ (tabulated-list-entry-lnum-width): New defvar.
+ (tabulated-list-print): Compute the width of line-number display
+ once, then store that value in tabulated-list-entry-lnum-width,
+ for tabulated-list-printer to use. (Bug#28704)
+
+2017-10-05 Gemini Lasswell <gazally@runbox.com>
+
+ * lisp/ses.el (ses-print-cell): Fix alignment of text cells. (Bug#27653)
+
+2017-10-05 Alexander Gramiak <agrambot@gmail.com>
+
+ Set xterm click count to 1 even with no last click
+
+ * lisp/xt-mouse.el (xterm-mouse-event): Move the check for
+ the last click so that click-count is initialized properly.
+ Handle the value of t for double-click-time.
+ (Bug#28658)
+
+2017-10-05 Vasilij Schneidermann <mail@vasilij.de>
+
+ Support indirection for all shr-tag-* calls
+
+ The 'shr-external-rendering-functions' variable was previously only
+ honored in the shr-descend function, now all direct calls to the
+ shr-tag-* functions have been replaced by a call to
+ 'shr-indirect-call' which tries using an alternative rendering
+ function first.
+
+ * lisp/net/shr.el (shr-indirect-call): New helper function.
+ (shr-descend, shr-tag-object, shr-tag-video):
+ (shr-collect-extra-strings-in-table): Fix callers to call via
+ shr-indirect-call. (Bug#28402)
+
+2017-10-05 Eli Zaretskii <eliz@gnu.org>
+
+ Speed up list-packages when 'visual' line numbers are displayed
+
+ * lisp/emacs-lisp/tabulated-list.el (tabulated-list-printer):
+ Update the doc string.
+ (tabulated-list-print-entry): Accept an additional optional
+ argument INDENT. Update the doc string.
+ (tabulated-list-print): Compute the width of line-number display
+ once, then call tabulated-list-printer with that value as 3rd
+ argument. (Bug#28704)
+
+2017-10-05 João Távora <joaotavora@gmail.com>
+
+ Misc. minor adjustments to Flymake
+
+ - Add a half-decent minor-mode menu;
+ - Fix "waiting for backends" mode line message;
+ - Adjust the flymake-diag-region API;
+ - Autoload the flymake-log macro;
+ - Auto-disable the legacy backend in more situations;
+ - Fix a couple of warnings in legacy backend.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Use new
+ flymake-diag-region.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc-legacy-flymake): Do error when no
+ buffer-file-name or not writable.
+ (flymake-proc-legacy-flymake)
+ (flymake-proc-simple-cleanup): Don't reference flymake-last-change-time
+
+ * lisp/progmodes/flymake.el (flymake-diag-region):
+ Autoload. Take buffer as first argument.
+
+ * lisp/progmodes/flymake.el (flymake-switch-to-log-buffer):
+ New command.
+ (flymake-menu): Add a simple menu.
+ (flymake--mode-line-format): Use menu. Fix message. Switch to
+ log buffer when clicking exceptional warnings.
+
+2017-10-05 Johan Bockgård <bojohan@gnu.org>
+
+ Fix search for ~/.Xdefaults-HOSTNAME
+
+ * src/xrdb.c (get_environ_db): Fix typo when handling
+ ~/.Xdefaults-HOSTNAME (Bug#28708).
+
+2017-10-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Speed up (format "%s" STRING) and the like
+
+ Although the Lisp manual said that ‘format’ returns a
+ newly-allocated string, this was not true for a few cases like
+ (format "%s" ""), and fixing the documentation to allow reuse of
+ arguments lets us improve performance in common cases like
+ (format "foo") and (format "%s" "foo") (Bug#28625).
+ * doc/lispref/strings.texi (Formatting Strings):
+ * etc/NEWS:
+ Say that the result of ‘format’ might not be newly allocated.
+ * src/callint.c (Fcall_interactively):
+ * src/dbusbind.c (XD_OBJECT_TO_STRING):
+ * src/editfns.c (Fmessage, Fmessage_box):
+ * src/xdisp.c (vadd_to_log, Ftrace_to_stderr):
+ Just use Fformat or Fformat_message, as that’s simpler and no
+ longer makes unnecessary copies.
+ * src/editfns.c (styled_format): Remove last argument, as it
+ is no longer needed: all callers now want it to behave as if it
+ were true. All remaining callers changed. Make this function
+ static again. Simplify the function now that we no longer
+ need to worry about whether the optimization is allowed.
+
+2017-10-04 Alan Mackenzie <acm@muc.de>
+
+ Fontify untyped function declarations in C Mode correctly.
+
+ Also correct two bugs where deleting WS at a BOL could leave an untyped
+ function declaration unfontified.
+
+ * lisp/progmodes/cc-engine.el (c-find-decl-spots): Don't set the flag
+ "top-level" when we're in a macro.
+ (c-forward-decl-or-cast-1): Recognize top-level "foo(bar)" or "foo()" in C
+ Mode as a implicitly typed function declaration.
+ (c-just-after-func-arglist-p): Don't get confused by "defined (foo)" inside a
+ macro. It's not a function plus arglist.
+
+ * lisp/progmodes/cc-langs.el (c-cpp-expr-functions-key): New defconst and
+ defvar.
+
+ * lisp/progmodes/cc-mode.el (c-fl-decl-end): After c-forward-declarator, move
+ over any following parenthesis expression (i.e. parameter list).
+ (c-change-expand-fl-region): When c-new-END is at a BOL, include that line in
+ the returned region, to cope with deletions at column 0.
+
+2017-10-04 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp.el (tramp-tramp-file-p): Use `string-match-p'.
+
+ Reported by Clément Pit-Claudel <cpitclaudel@gmail.com>.
+
+2017-10-04 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes on C-g when several threads wait for input
+
+ * src/thread.h (m_getcjmp): New member of 'struct thread_state'.
+ (getcjmp): Define to current thread's 'm_getcjmp'.
+ * src/thread.c (maybe_reacquire_global_lock): Switch to main
+ thread, since this is called from a SIGINT handler, which always
+ runs in the context of the main thread.
+ * src/lisp.h (sys_jmp_buf, sys_setjmp, sys_longjmp): Move the
+ definitions before thread.h is included, as thread.h now uses
+ sys_jmp_buf.
+ * src/keyboard.c (getcjmp): Remove declaration.
+ (read_char): Don't call maybe_reacquire_global_lock here.
+ (handle_interrupt): Call maybe_reacquire_global_lock here, if
+ invoked from the SIGINT handler, to make sure
+ quit_throw_to_read_char runs with main thread's Lisp bindings and
+ uses the main thread's jmp_buf buffer. (Bug#28630)
+
+2017-10-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Warn if --without-pop is now the default
+
+ * configure.ac (with_pop): Set to no-by-default if defaulting to "no".
+ Warn about the change if defaulting to "no". Update URLs.
+
+2017-10-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ --with-pop is now the default only on MS-Windows
+
+ Problem reported by N. Jackson (Bug#28597).
+ This improves an earlier suggestion by Robert Pluim (Bug#28597#47).
+ * INSTALL, configure.ac, etc/NEWS:
+ Make --with-pop the default only on native MS-Windows.
+
+2017-10-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Add support for `file-system-info' in Tramp
+
+ * lisp/net/tramp.el (tramp-file-name-for-operation):
+ Add `file-system-info'.
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-file-system-info): New defun.
+ (tramp-adb-file-name-handler-alist): Use it.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-file-system-attributes)
+ (tramp-gvfs-file-system-attributes-regexp): New defconst.
+ (tramp-gvfs-handle-file-system-info): New defun.
+ (tramp-gvfs-file-name-handler-alist): Use it.
+ (tramp-gvfs-get-directory-attributes): Fix property name.
+ (tramp-gvfs-get-root-attributes): Support also file system attributes.
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-file-system-info): New defun.
+ (tramp-sh-file-name-handler-alist): Use it.
+ (tramp-sh-handle-insert-directory): Insert size information.
+ (tramp-get-remote-df): New defun.
+
+ * lisp/net/tramp-smb.el (tramp-smb-handle-file-system-info): New defun.
+ (tramp-smb-file-name-handler-alist): Use it.
+ (tramp-smb-handle-insert-directory): Insert size information.
+
+ * test/lisp/net/tramp-tests.el (tramp-test37-file-system-info):
+ New test.
+ (tramp-test38-asynchronous-requests)
+ (tramp-test39-recursive-load, tramp-test40-remote-load-path)
+ (tramp-test41-unload): Rename.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Merge branch 'scratch/flymake-refactor-clean-for-emacs-26' into emacs-26
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Start rewriting Flymake manual
+
+ Missing the parts pertaining to the new customization API.
+
+ * doc/misc/flymake.texi (Overview of Flymake): Rewrite a bit.
+ (Installing Flymake): Delete most of this.
+ (Running the syntax check): Mention flymake-start.
+ (Navigating to error lines): Rewrite.
+ (Viewing error messages): Commente out.
+ (Syntax check statuses, Troubleshooting): Rewrite a bit.
+ (Customizable variables): New section under "Using
+ Flymake". Don't mention any proc variables here.
+ (Configuring Flymake): Delete
+ (Proc backend): New chapter
+ (Proc customization variables): New chapter.
+
+ * doc/misc/flymake.texi (Overview of Flymake): Rewrite a bit.
+ (Installing Flymake): Mostly scratch. Flymake comes with Emacs.
+ (Running the syntax check): Simplify.
+ (Viewing error messages): Dekete,
+ (Syntax check statuses): Rewrite.
+ (Troubleshooting): Simplify.
+ (Customizable variables): Rewrite.
+ (Extending Flymake): New chapter, empty for now.
+ (The legacy Proc backend): New chapter.
+ (Proc customizable variables)
+ (Adding support for a new syntax check tool)
+ (Implementation overview)
+ (Making a temporary copy)
+ (Locating a master file)
+ (Getting the include directories)
+ (Locating the buildfile)
+ (Starting the syntax check process)
+ (Parsing the output)
+ (Interaction with other modes)
+ (Example---Configuring a tool called via make)
+ (Example---Configuring a tool called directly): Rewrite a bit.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Minimal tweak as an attempt to future-proof Flymake API
+
+ Discussed with Stefan that this should allow Flymake to request more
+ from backends in the future, while also allowing backends to report
+ more accurately.
+
+ * lisp/progmodes/elisp-mode.el (elisp-flymake-checkdoc)
+ (elisp-flymake-byte-compile): Adjust to new API.
+
+ * lisp/progmodes/flymake-proc.el ()
+ (flymake-proc-legacy-flymake): Adjust to new API.
+
+ * lisp/progmodes/flymake.el (flymake-diagnostic-functions):
+ Review API again.
+ (flymake--handle-report): Allow other keys. Change ACTION to
+ REPORT-ACTION.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Integrate Flymake elisp checkers into elisp-mode.el directly
+
+ * lisp/progmodes/elisp-mode.el (emacs-lisp-mode): Use
+ elisp-flymake-checkdoc and elisp-flymake-byte-compile.
+ (elisp-flymake--checkdoc-1, elisp-flymake-checkdoc)
+ (elisp-flymake--byte-compile-done)
+ (elisp-flymake--byte-compile-process)
+ (elisp-flymake-byte-compile): Rename from flymake-elisp
+ counterparts in deleted flymake-elisp.el
+ (elisp-flymake--batch-compile-for-flymake): New helper.
+ (checkdoc-create-error-function)
+ (checkdoc-autofix-flag)
+ (checkdoc-generate-compile-warnings-flag)
+ (checkdoc-diagnostic-buffer): Forward declare.
+
+ * lisp/progmodes/flymake-elisp.el: Delete.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Hook Flymake onto proper checkdoc and byte-compile interfaces
+
+ The interfaces in bytecomp.el and checkdoc.el are mostly boilerplate,
+ with little knowledge of actual internals or thought given to the
+ usefulness of said interfaces in contexts other than Flymake's.
+
+ * lisp/emacs-lisp/bytecomp.el
+ (byte-compile-log-warning-function): New variable.
+ (byte-compile-log-warning): Use it.
+ (byte-compile--log-warning-for-byte-compile): New function.
+
+ * lisp/emacs-lisp/checkdoc.el
+ (checkdoc-create-error-function): New variable.
+ (checkdoc-create-error): Use it.
+ (checkdoc--create-error-for-checkdoc): New function.xo
+
+ * lisp/progmodes/flymake-elisp.el (flymake-elisp--checkdoc-1):
+ Use checkdoc-create-error-function.
+ (flymake-elisp--batch-byte-compile): Use
+ byte-compile-log-warning-function.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Tweak Flymake autoloads and dependencies
+
+ * lisp/progmodes/elisp-mode.el (emacs-lisp-mode): Add to
+ flymake-diagnostic-functions here.
+
+ * lisp/progmodes/flymake-elisp.el[top]: Don't add to
+ emacs-lisp-mode-hook. Don't call flymake-elisp-setup-backends in
+ every buffer. (flymake-elisp-checkdoc) (flymake-elisp-byte-compile):
+ Autoload. (flymake-elisp-setup-backends): Remove.
+
+ * lisp/progmodes/flymake.el: Add some top-level comments.
+ (flymake-make-diagnostic)
+ (flymake-mode, flymake-mode-on, flymake-mode-off): Add autoloads
+
+ Where to fixup this shit?
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Capitalize "Flymake" in docstrings and comments
+
+ * lisp/progmodes/flymake-elisp.el (flymake-elisp-checkdoc)
+ (flymake-elisp-setup-backends): Capitalize "Flymake"
+
+ * lisp/progmodes/flymake-proc.el:
+ (flymake-proc-reformat-err-line-patterns-from-compile-el)
+ (flymake-proc--panic, flymake-proc-legacy-flymake)
+ (flymake-start-syntax-check, flymake-proc-compile)
+ (define-obsolete-variable-alias): Capitalize "Flymake"
+
+ * lisp/progmodes/flymake.el (flymake-fringe-indicator-position)
+ (flymake-make-diagnostic, flymake-delete-own-overlays)
+ (flymake-diagnostic-functions)
+ (flymake-diagnostic-types-alist, flymake-is-running)
+ (flymake-make-report-fn, flymake-mode-on, flymake-mode-off)
+ (flymake-goto-next-error, flymake-goto-prev-error): Capitalize "Flymake"
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake backends can report multiple times per check
+
+ Rewrote a significant part of the Flymake backend API. Flymake now
+ ignores the return value of backend functions: a function can either
+ returns or errors. If it doesn't error, a backend is no longer
+ constrained to call REPORT-FN exactly once. It may do so any number
+ of times, cumulatively reporting diagnostics. Flymake keeps track of
+ outdated REPORT-FN instances and disconsiders obsolete reports.
+ Backends should avoid reporting obsolete data by canceling any
+ ongoing processing at every renewed call to the backend function.
+
+ Consolidated flymake.el internal data structures to require less
+ buffer-local variables. Adjusted Flymake's mode-line indicator to the
+ new semantics.
+
+ Adapted and simplified the implementation of elisp and legacy
+ backends, fixing potential race conditions when calling backends in
+ rapid succession.
+
+ Added a new test for a backend that calls REPORT-FN multiple
+ times. Simplify test infrastructure.
+
+ * lisp/progmodes/flymake-elisp.el (flymake-elisp-checkdoc)
+ (flymake-elisp-byte-compile): Error instead of returning nil
+ if not in emacs-lisp-mode.
+ (flymake-elisp--byte-compile-process): New buffer-local variable.
+ (flymake-elisp-byte-compile): Mark (and kill) previous process
+ obsolete process before starting a new one. Don't report if
+ obsolete process.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--current-process): New buffer-local variable.
+ (flymake-proc--processes): Remove.
+ (flymake-proc--process-filter): Don't bind
+ flymake-proc--report-fn.
+ (flymake-proc--process-sentinel): Rewrite. Don't report if
+ obsolete process.
+ (flymake-proc-legacy-flymake): Rewrite. Mark (and kill)
+ previous process obsolete process before starting a new
+ one. Integrate flymake-proc--start-syntax-check-process
+ helper.
+ (flymake-proc--start-syntax-check-process): Delete.
+ (flymake-proc-stop-all-syntax-checks): Don't use
+ flymake-proc--processes, iterate buffers.
+ (flymake-proc-compile):
+
+ * lisp/progmodes/flymake.el (subr-x): Require it
+ explicitly.
+ (flymake-diagnostic-functions): Reword docstring.
+ (flymake--running-backends, flymake--disabled-backends)
+ (flymake--diagnostics-table): Delete.
+ (flymake--backend-state): New buffer-local variable and new defstruct.
+ (flymake--with-backend-state, flymake--collect)
+ (flymake-running-backends, flymake-disabled-backends)
+ (flymake-reporting-backends): New helpers.
+ (flymake-is-running): Use flymake-running-backends.
+ (flymake--handle-report): Rewrite.
+ (flymake-make-report-fn): Ensure REPORT-FN runs in the correct
+ buffer or not at all.
+ (flymake--disable-backend, flymake--run-backend): Rewrite.
+ (flymake-start): Rewrite.
+ (flymake-mode): Set flymake--backend-state.
+ (flymake--mode-line-format): Rewrite.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--wait-for-backends): New helper.
+ (flymake-tests--call-with-fixture): Use it.
+ (included-c-header-files): Fix whitespace.
+ (flymake-tests--diagnose-words): New helper.
+ (dummy-backends): Rewrite for new semantics. Use cl-letf.
+ (flymake-tests--assert-set): Use quote.
+ (recurrent-backend): New test.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake uses proper idle timers
+
+ Also, flymake-no-changes-timeout can be set to nil to disable
+ automatic periodic checks. But even in that situation the idle timer
+ still runs at a reduced rate to detect changes in the variable and
+ revert that decision.
+
+ * lisp/progmodes/flymake.el (flymake-no-changes-timeout): Improve doc.
+ (flymake-last-change-time): Delete.
+ (flymake--schedule-timer-maybe): New helper.
+ (flymake-after-change-function): Use it.
+ (flymake-on-timer-event): Delete
+ (flymake-mode): Don't scheduler timer.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake variable flymake-diagnostic-functions now a special hook
+
+ * lisp/progmodes/flymake-proc.el: Use add-hook to affect
+ flymake-diagnostic-functions.
+
+ * lisp/progmodes/flymake-elisp.el
+ (flymake-elisp-setup-backends): Use add-hook.
+
+ * lisp/progmodes/flymake.el (flymake-diagnostic-functions):
+ Revise docstring.
+ (flymake-start): Use run-hook-wrapped.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Batch of minor Flymake cleanup actions agreed to with Stefan
+
+ Discussed with Stefan, in no particular order
+
+ - Remove aliases for symbols thought to be internal to flymake-proc.el
+ - Don’t need :group in defcustom and defface in flymake.el
+ - Fix docstring of flymake-make-diagnostic
+ - Fix docstring of flymake-diagnostic-functions to clarify keywords.
+ - Mark overlays with just the property ’flymake, not ’flymake-overlay
+ - Tune flymake-overlays for performance
+ - Make flymake-mode-on and flymake-mode-off obsolete
+ - Don’t use hash-table-keys unless necessary.
+ - Copyright notice in flymake-elisp.
+
+ Added some more
+
+ - Clarify docstring of flymake-goto-next-error
+ - Clarify a comment in flymake--run-backend complaining about ert-deftest.
+ - Prevent compilation warnings in flymake-proc.el
+ - Remove doctring from obsolete aliases
+
+ Now the changelog:
+
+ * lisp/progmodes/flymake-elisp.el: Proper copyright notice.
+
+ * lisp/progmodes/flymake-proc.el (flymake-warning-re)
+ (flymake-proc-diagnostic-type-pred)
+ (flymake-proc-default-guess)
+ (flymake-proc--get-file-name-mode-and-masks): Move up to
+ beginning of file to shoosh compiler warnings
+ (define-obsolete-variable-alias): Delete many obsolete aliases.
+
+ * lisp/progmodes/flymake.el (flymake-error-bitmap)
+ (flymake-warning-bitmap, flymake-note-bitmap)
+ (flymake-fringe-indicator-position)
+ (flymake-start-syntax-check-on-newline)
+ (flymake-no-changes-timeout, flymake-gui-warnings-enabled)
+ (flymake-start-syntax-check-on-find-file, flymake-log-level)
+ (flymake-wrap-around, flymake-error, flymake-warning)
+ (flymake-note): Don't need :group in these defcustom and defface.
+ (flymake--run-backend): Clarify comment
+ (flymake-mode-map): Remove.
+ (flymake-make-diagnostic): Fix docstring.
+ (flymake--highlight-line, flymake--overlays): Identify flymake
+ overlays with just ’flymake.
+ (flymake--overlays): Reverse order of invocation for
+ cl-remove-if-not and cl-sort.
+ (flymake-mode-on)
+ (flymake-mode-off): Make obsolete.
+ (flymake-goto-next-error, flymake-goto-prev-error): Fix docstring.
+ (flymake-diagnostic-functions): Clarify keyword arguments in
+ docstring.
+
+ Maybe squash in that one where I remove many obsoletes
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Explicitly add a(n empty) keymap for Flymake
+
+ Too early to decide what will be in it, if anything. Though "M-n" and
+ "M-p" would be great.
+
+ * lisp/progmodes/flymake-ui.el (flymake-mode-map): New variable
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake uses some new fringe bitmaps
+
+ Also fix behaviour whereby flymake wouldn't react to a change in the
+ variable.
+
+ * lisp/progmodes/flymake-ui.el (flymake-error-bitmap)
+ (flymake-warning-bitmap): Update bitmaps.
+ (flymake-note-bitmap): New defcustom.
+ (flymake-double-exclamation-mark): New bitmap.
+ (flymake-error, flymake-warning, flymake-note)
+ (flymake--highlight-line): 'bitmap property must be a symbol.
+ Also set default face to flymake-error.
+ (flymake--fringe-overlay-spec): Bitmap property can be a
+ variable symbol.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Remove old flymake-display-err-menu-for-current-line, it's useless
+
+ See https://lists.gnu.org/r/emacs-devel/2017-09/msg00949.html
+
+ * lisp/progmodes/flymake-ui.el
+ (flymake-popup-current-error-menu): Remove.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Treat Flymake errors as just another type of diagnostic
+
+ * lisp/progmodes/flymake.el (flymake--diag-errorp): Remove.
+ (flymake--handle-report, flymake-popup-current-error-menu):
+ Don't use it.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Fix three Flymake bugs when checking C header files
+
+ The first of these problems is longstanding: if an error-less B.h is
+ included from error-ridden A.h, flymake's legacy parser will panic
+ (and disable itself) since it sees a non-zero exit for a clean file.
+ To fix this, recommend returning 'true' in the documentation for the
+ check-syntax target.
+
+ Another problem was introduced by the parser rewrite. For error
+ patterns spanning more than one line, point may be left in the middle
+ of a line and thus render other patterns useless. Those patterns were
+ written for the old line-by-line parser. To make them useful again,
+ move to the beginning of line in those situations.
+
+ The third problem was also longstanding and happened on newer GCC's:
+ The "In file included from" prefix confused
+ flymake-proc-get-real-file-name. Fix this.
+
+ Also updated flymake--diag-region to fallback to highlighting a full
+ line less often.
+
+ Add automatic tests to check this.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Fix bug when patterns
+ accidentally spans more than one line. Don't create
+ diagnostics without error messages.
+ (flymake-proc-real-file-name-considering-includes): New
+ helper.
+ (flymake-proc-allowed-file-name-masks): Use it.
+
+ * lisp/progmodes/flymake.el (flymake-diag-region): Make COL
+ argument explicitly optional. Only fall back to full line in extreme
+ cases.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (included-c-header-files): New test.
+ (different-diagnostic-types): Update.
+
+ * test/lisp/progmodes/flymake-resources/Makefile
+ (check-syntax): Always return success (0) error code.
+ (CC_OPTS): Add -Wextra
+
+ * test/lisp/progmodes/flymake-resources/errors-and-warnings.c
+ (main): Rewrite comments.
+
+ * test/lisp/progmodes/flymake-resources/errors-and-warnings.c:
+ Include some dummy header files.
+
+ * test/lisp/progmodes/flymake-resources/no-problems.h: New file.
+
+ * test/lisp/progmodes/flymake-resources/some-problems.h: New file.
+
+ * doc/misc/flymake.texi (Example---Configuring a tool called
+ via make): Recommend adding "|| true" to the check-syntax target.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Add interactive flymake-start function
+
+ * lisp/progmodes/flymake.el (flymake-on-timer-event)
+ (flymake-after-change-function, flymake-mode): Call
+ flymake-start.
+ (flymake-start): Rename from flymake--start-syntax-check.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ A couple of Flymake backends for emacs-lisp-mode
+
+ Loading flymake-elisp.el doesn't setup flymake-mode to turn on
+ automatically, but it affects emacs-lisp-mode-hook so that
+ flymake-diagnostic-functions is setup with a suitable buffer-local
+ value. The variable flymake-diagnostic-funtions in every live
+ emacs-lisp-mode buffer is also adjusted.
+
+ * lisp/progmodes/flymake.el (top): Require flymake-elisp.
+
+ * lisp/progmodes/flymake-elisp.el: New file.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Fancy Flymake mode-line construct displays status
+
+ Imitates compilation-mode's mode-line a bit, and uses its faces.
+
+ * lisp/progmodes/flymake.el
+ (flymake-error, flymake-warning, flymake-note): Add
+ mode-line-face to these flymake error types.
+ (flymake-note): Notes don't need a noisy fringe bitmap.
+ (flymake-lighter): Delete.
+ (flymake--update-lighter): Delete.
+ (flymake--mode-line-format): New function and variable.
+ (flymake--diagnostics-table): New buffer-local variable.
+ (flymake--handle-report): Don't update "lighters". Affect
+ flymake--diagnostics-table.
+ (flymake--run-backend): Init flymake--diagnostics-table for backend.
+ (flymake-mode): Use flymake--mode-line-format.
+ (flymake-mode): Don't update lighter.
+ (flymake--highlight-line): Be more careful when overriding a
+ nil default overlay property.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Tweak Flymake commands flymake-goto-[next/prev]-error
+
+ Add filters, useful for backends like the upcoming
+ flymake-elisp-checkdoc backend, for example, which litters everything
+ with low-priority notes.
+
+ Also re-implement wraparound for flymake-goto-next-error. Manual
+ mentions this, so it's probably a good idea to keep it. Added a new
+ customization variable flymake-wrap-around to control it.
+
+ * lisp/progmodes/flymake.el (flymake-goto-prev-error)
+ (flymake-goto-next-error): Accept FILTER argument.
+ (flymake-wrap-around): New variable.
+ (flymake-goto-next-error): Wrap around according to flymake-wrap-around.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (different-diagnostic-types, dummy-backends): Pass FILTER to
+ flymake-goto-prev-error.
+ (different-diagnostic-types)
+ (dummy-backends): Use flymake-wrap-around.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake's flymake-proc.el backend slightly easier to debug
+
+ Misc cleanup in flymake-proc.el
+
+ Improve description of what this file contains.
+
+ Better name for the backend function. Fix the case where it is run
+ interactively.
+
+ Keep the output buffer alive iff the external process panics.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc-legacy-flymake): Rename from
+ flymake-proc-start-syntax-check. Allow running interactively.
+ (flymake-start-syntax-check): Obsolete alias for
+ flymake-proc-legacy-flymake.
+ (flymake-proc-start-syntax-check): Delete.
+ (flymake-diagnostic-functions): Include flymake-proc-legacy-flymake
+ (flymake-proc--process-sentinel): Keep output buffer alive.
+ Clarify with comments.
+ (flymake-proc--diagnostics-for-pattern)
+ (flymake-proc--process-sentinel)
+ (flymake-proc--safe-delete-directory)
+ (flymake-proc--start-syntax-check-process): Use condition-case-unless-debug.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Simplify Flymake logging and erroring
+
+ Use display-warning and a dedicated *Flymake log* buffer.
+
+ To ease readability, flymake log messages are now prefixed with a
+ common prefix and the buffer that originated them.
+
+ Some situations of over-zealous logging are fixed.
+
+ Use byte-compiler info, if available, to determine whence the
+ flymake-related log message is coming.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Improve log message.
+ (flymake-proc--panic): Always flymake-log an error
+ (flymake-proc--safe-delete-file)
+ (flymake-proc--safe-delete-directory):
+ Downgrade warning
+ (flymake-proc-start-syntax-check): Simplify slightly.
+ (flymake-proc--start-syntax-check-process): Simplify.
+ (flymake-proc--init-find-buildfile-dir)
+ (flymake-proc--init-create-temp-source-and-master-buffer-copy):
+ No need to warn twice.
+
+ * lisp/progmodes/flymake.el (flymake-log): Convert to macro.
+ (flymake--log-1): New helper.
+ (flymake-log-level): Deprecate.
+ (flymake-error): New helper.
+ (flymake-ler-make-ler, flymake--handle-report, flymake-mode):
+ Use flymake-error.
+ (flymake-on-timer-event)
+ (flymake--handle-report, flymake--disable-backend)
+ (flymake--run-backend, flymake-start, flymake-mode-on)
+ (flymake-mode-off, flymake-after-change-function)
+ (flymake-after-save-hook, flymake-find-file-hook): Adjust
+ flymake-log calls.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--call-with-fixture): Only log errors.
+
+2017-10-03 Philipp Stephani <phst@google.com>
+
+ Work around deprecation of gtk_style_context_get_background_color
+
+ * src/gtkutil.c (xg_check_special_colors): Replace call to
+ gtk_style_context_get_background_color with its definition.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ New Flymake API variable flymake-diagnostic-functions
+
+ Lay groundwork for multiple active backends in the same buffer.
+
+ Backends are lisp functions called when flymake-mode sees fit. They
+ are responsible for examining the current buffer and telling
+ flymake.el, via return value, if they can syntax check it.
+ Backends should return quickly and inexpensively, but they are also
+ passed a REPORT-FN argument which they may or may not call
+ asynchronously after performing more expensive work.
+
+ REPORT-FN's calling convention stipulates that a backend calls it with
+ a list of diagnostics as argument, or, alternatively, with a symbol
+ denoting an exceptional situation, usually some panic resulting from a
+ misconfigured backend. In keeping with legacy behaviour,
+ flymake.el's response to a panic is to disable the issuing backend.
+
+ The flymake--diag object representing a diagnostic now also keeps
+ information about its source backend. Among other uses, this allows
+ flymake to selectively cleanup overlays based on which backend is
+ updating its diagnostics.
+
+ * lisp/progmodes/flymake-proc.el (flymake-proc--report-fn):
+ New dynamic variable.
+ (flymake-proc--process): New variable.
+ (flymake-can-syntax-check-buffer): Remove.
+ (flymake-proc--process-sentinel): Simplify. Use
+ unwind-protect. Affect flymake-proc--processes here.
+ Bind flymake-proc--report-fn.
+ (flymake-proc--process-filter): Bind flymake-proc--report-fn.
+ (flymake-proc--post-syntax-check): Delete
+ (flymake-proc-start-syntax-check): Take mandatory
+ report-fn. Rewrite. Bind flymake-proc--report-fn.
+ (flymake-proc--process-sentinel): Rewrite and simplify.
+ (flymake-proc--panic): New helper.
+ (flymake-proc--start-syntax-check-process): Record report-fn
+ in process. Use flymake-proc--panic.
+ (flymake-proc-stop-all-syntax-checks): Use mapc. Don't affect
+ flymake-proc--processes here. Record interruption reason.
+ (flymake-proc--init-find-buildfile-dir)
+ (flymake-proc--init-create-temp-source-and-master-buffer-copy):
+ Use flymake-proc--panic.
+ (flymake-diagnostic-functions): Add
+ flymake-proc-start-syntax-check.
+ (flymake-proc-compile): Call
+ flymake-proc-stop-all-syntax-checks with a reason.
+
+ * lisp/progmodes/flymake.el (flymake-backends): Delete.
+ (flymake-check-was-interrupted): Delete.
+ (flymake--diag): Add backend slot.
+ (flymake-delete-own-overlays): Take optional filter arg.
+ (flymake-diagnostic-functions): New user-visible variable.
+ (flymake--running-backends, flymake--disabled-backends): New
+ buffer-local variables.
+ (flymake-is-running): Now a function, not a variable.
+ (flymake-mode-line, flymake-mode-line-e-w)
+ (flymake-mode-line-status): Delete.
+ (flymake-lighter): flymake's minor-mode "lighter".
+ (flymake-report): Delete.
+ (flymake--backend): Delete.
+ (flymake--can-syntax-check-buffer): Delete.
+ (flymake--handle-report, flymake--disable-backend)
+ (flymake--run-backend, flymake--run-backend): New helpers.
+ (flymake-make-report-fn): Make a lambda.
+ (flymake--start-syntax-check): Iterate
+ flymake-diagnostic-functions.
+ (flymake-mode): Use flymake-lighter. Simplify. Initialize
+ flymake--running-backends and flymake--disabled-backends.
+ (flymake-find-file-hook): Simplify.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--call-with-fixture): Use flymake-is-running the
+ function. Check if flymake-mode already active before activating it.
+ Add a thorough test for flymake multiple backends
+
+ * lisp/progmodes/flymake.el (flymake--start-syntax-check):
+ Don't use condition-case-unless-debug, use condition-case
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--assert-set): New helper macro.
+ (dummy-backends): New test.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ More Flymake cleanup before advancing to backend redesign
+
+ Diagnostics are reported for buffers, not necessarily files. It’s the
+ backend’s responsibility to compute the buffer where the diagnostic is
+ applicable. For now, this has to match the buffer where flymake-mode
+ is active and which is at the origin of the backend call.
+
+ flymake.el knows nothing about line/column diagnostics (except for
+ backward-compatible flymake-ler-make-ler, which must yet be tested).
+ It’s also the backend’s reponsibility to compute a BEG and END
+ positions for the diagnostic in the relevant buffer.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Convert LINE/COL to
+ region here. Check file buffer here.
+ (flymake-proc--process-sentinel): Don’t kill output buffer if
+ high enough log level.
+
+ * lisp/progmodes/flymake.el (flymake-diag-region): Make this a utility
+ function. (flymake--highlight-line): Diagnostic has region now.
+ (flymake-popup-current-error-menu): Don’t add file and line numbers to
+ already this silly menu. (flymake--fix-line-numbers): Remove.
+ (flymake-report): No need to fix diagnostics here.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Protect Flymake's eager checks against commands like fill-paragraph
+
+ If flymake-start-syntax-check-on-newline is t, check should start as
+ soon as a newline is seen by after-change-functions. But don't rush
+ it: since the buffer state might not be final, we might end up with
+ invalid diagnostic regions after some commands silently insert and
+ delete newlines (looking at you, fill-paragraph).
+
+ * lisp/progmodes/flymake.el (flymake-after-change-function): Pass
+ `deferred' to flymake--start-syntax-check.
+ (flymake--start-syntax-check): Take optional `deferred' arg.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake highlights GCC info/notes as detected by flymake-proc.el
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Rewrite (using cl-loop) to
+ honour more sophisticated flymake-proc-diagnostic-type-pred.
+ (flymake-warning-re): Is now an obsolete alias for
+ flymake-proc-diagnostic-type-pred.
+ (flymake-proc-diagnostic-type-pred): Rename and augment from
+ flymake-proc-warning-predicate. (flymake-proc-warning-predicate):
+ Delete.
+
+ * lisp/progmodes/flymake.el (flymake-note): New face.
+ (flymake-diagnostic-types-alist): Simplify.
+ (flymake-note): New overlay category.
+ (flymake--lookup-type-property): Only lookup single keys, not lists.
+ (flymake--diag-errorp): Rewrite.
+ (flymake--highlight-line): Use flymake--lookup-type-property.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (different-diagnostic-types): Rename from errors-and-warnings.
+ Check notes.
+ (flymake-tests--call-with-fixture): Use
+ flymake-proc-diagnostic-type-pred.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake checks file names before considering diagnostics
+
+ The error patterns for gcc picked up errors for the Makefile itself,
+ for example. These shouldn't count as actual errors.
+
+ * lisp/progmodes/flymake.el (flymake-report): Check
+ matching file names.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Echo Flymake error messages when navigating errors interactively
+
+ Perhaps binding M-n and M-p to flymake-goto-next-error and
+ flymake-goto-prev-error also wouldn't be a bad idea.
+
+ * lisp/progmodes/flymake.el (flymake-goto-next-error): Use
+ target overlay's help-echo.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Add a new Flymake test for multiple errors and warnings
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--call-with-fixture): Save excursion.
+ (errors-and-warnings): New test.
+
+ * test/lisp/progmodes/flymake-resources/errors-and-warnings.c:
+ New test fixture.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake warning face easier to distinguish
+
+ A orange wavy underline is very hard to tell from a red wavy
+ underline.
+
+ * lisp/progmodes/flymake.el (flymake-warning): Change color to
+ "deep sky blue"
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake's flymake-proc.el parses column numbers from gcc/javac errors
+
+ Column numbers are not a great way of marking diagnostic regions, but
+ that's probably all that can be expected from the flymake-proc.el
+ backend. For now, try (end-of-thing 'sexp) to discover the
+ diagnostic's end position.
+
+ * lisp/progmodes/flymake-proc.el ()
+ (flymake-proc-err-line-patterns): Also parse column numbers,
+ if available, for gcc/javac warnings.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ New Flymake variable flymake-diagnostic-types-alist and much cleanup
+
+ A new user-visible variable is introduced where different diagnostic
+ types can be categorized. Flymake backends can also contribute to
+ this variable. Anything that doesn’t match an existing error type
+ is considered.
+
+ The variable’s alists are used to propertize the overlays pertaining
+ to each error type. The user can override the built-in properties by
+ either by modifying the alist, or by modifying the properties of a
+ special "category" symbol, named by the `flymake-category' entry in
+ the alist.
+
+ The `flymake-category' entry is especially useful for, say, the author
+ of foo-flymake-backend, who issues diagnostics of type :foo-note, that
+ should behave like notes, except with no fringe bitmap:
+
+ (add-to-list 'flymake-diagnostic-types-alist
+ '(:foo-note
+ . ((flymake-category . flymake-note)
+ (bitmap . nil))))
+
+ For essential properties like `severity', `priority', etc, a default
+ value is produced. Some properties like `evaporate' cannot be
+ overriden.
+
+ * lisp/progmodes/flymake.el (flymake--diag): Rename from
+ flymake-ler.
+ (flymake-ler-make): Obsolete alias for flymake-diagnostic-make
+ (flymake-ler-errorp): Rewrite using flymake--severity.
+ (flymake--place-overlay): Delete.
+ (flymake--overlays): Now a cl-defun with &key args. Document.
+ Use `overlays-at' if BEG is non-nil and END is nil.
+ (flymake--lookup-type-property): New helper.
+ (flymake--highlight-line): Rewrite.
+ (flymake-diagnostic-types-alist): New API variable.
+ (flymake--diag-region)
+ (flymake--severity, flymake--face)
+ (flymake--fringe-overlay-spec): New helper.
+ (flymake-popup-current-error-menu): Use new flymake-overlays.
+ (flymake-popup-current-error-menu, flymake-report): Use
+ flymake--diag-errorp.
+ (flymake--fix-line-numbers): Use flymake--diag-line.
+ (flymake-goto-next-error): Pass :key to flymake-overlays
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Use flymake-diagnostic-make.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Refactor Flymake tests in preparation for more tests
+
+ Introduce a slightly more generic fixture macro.
+
+ Also make flymake-tests.el friendlier to interactive runs, by not
+ killing buffers visited by the user.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--call-with-fixture): New helper from
+ flymake-tests--current-face. Don't kill file buffers already
+ being visited before the test starts.
+ (flymake-tests--with-flymake): New macro.
+ (flymake-tests--current-face): Delete.
+ (warning-predicate-rx-gcc, warning-predicate-function-gcc)
+ (warning-predicate-rx-perl, warning-predicate-function-perl):
+ Use flymake-test--with-flymake.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Allow running Flymake tests from interactive sessions
+
+ * test/lisp/progmodes/flymake-tests.el (flymake-tests-data-directory):
+ Expand to reasonable value if no
+ EMACS_TEST_DIRECTORY. (flymake-tests--current-face): Work around
+ "weirdness" of bug 17647 with read-event.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake diagnostics now apply to arbitrary buffer regions
+
+ Make Flymake UI some 150 lines lighter
+
+ Strip away much of the original implementation's complexity in
+ manipulating objects representing diagnostics as well as creating and
+ navigating overlays.
+
+ Lay some groundwork for a more flexible approach that allows for
+ different classes of diagnostics, not necessarily line-based.
+ Importantly, one overlay per diagnostic is created, whereas the
+ original implementation had one per line, and on it it concatenated
+ the results of errors and warnings.
+
+ This means that currently, an error and warning on the same line are
+ problematic and the warning might be overlooked but this will soon be
+ fixed by setting appropriate priorities.
+
+ Since diagnostics can highlight arbitrary regions, not just lines, the
+ faces were renamed.
+
+ Tests pass and backward compatibility with interactive functions is
+ maintained, but probably any third-party extension or customization
+ relying on more than a trivial set of flymake.el internals has stopped
+ working.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--diagnostics-for-pattern): Use new flymake-ler-make
+ constructor syntax.
+
+ * lisp/progmodes/flymake.el (flymake-ins-after)
+ (flymake-set-at, flymake-er-make-er, flymake-er-get-line)
+ (flymake-er-get-line-err-info-list, flymake-ler-set-file)
+ (flymake-ler-set-full-file, flymake-ler-set-line)
+ (flymake-get-line-err-count, flymake-get-err-count)
+ (flymake-highlight-err-lines, flymake-overlay-p)
+ (flymake-make-overlay, flymake-region-has-flymake-overlays)
+ (flymake-find-err-info)
+ (flymake-line-err-info-is-less-or-equal)
+ (flymake-add-line-err-info, flymake-add-err-info)
+ (flymake-get-first-err-line-no)
+ (flymake-get-last-err-line-no, flymake-get-next-err-line-no)
+ (flymake-get-prev-err-line-no, flymake-skip-whitespace)
+ (flymake-goto-line, flymake-goto-next-error)
+ (flymake-goto-prev-error, flymake-patch-err-text): Delete
+ functions no longer used.
+ (flymake-goto-next-error, flymake-goto-prev-error): Rewrite.
+ (flymake-report): Rewrite.
+ (flymake-popup-current-error-menu): Rewrite.
+ (flymake--highlight-line): Rename from
+ flymake-highlight-line. Call `flymake--place-overlay.
+ (flymake--place-overlay): New function.
+ (flymake-ler-errorp): New predicate.
+ (flymake-ler): Simplify.
+ (flymake-error): Rename from
+ flymake-errline.
+ (flymake-warning): Rename from flymake-warnline.
+ (flymake-warnline, flymake-errline): Obsoletion aliases.
+
+ * test/lisp/progmodes/flymake-tests.el (warning-predicate-rx-gcc)
+ (warning-predicate-function-gcc, warning-predicate-rx-perl)
+ (warning-predicate-function-perl): Use face `flymake-warning'.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Move symbols in flymake-proc.el to separate namespace
+
+ Every symbol in this flymake now starts with the prefix flymake-proc-.
+
+ Make obsolete aliases for (almost?) every symbol.
+
+ Furthermore, many flymake-proc.el symbols are prefixed with
+ "flymake-proc--", that is they were considered internal.
+
+ Some customization variables, interactive functions, and other symbols
+ considered useful to user customizations or third-party libraries are
+ considered "public" or "external" and so use a "flymake-proc-" prefix.
+
+ * lisp/progmodes/flymake-proc.el: Every symbol renamed.
+
+ * test/lisp/progmodes/flymake-tests.el
+ (flymake-tests--current-face): Use
+ flymake-proc-warning-predicate, not flymake-warning-predicate.
+
+ * lisp/progmodes/flymake-proc.el
+ (flymake-proc--get-project-include-dirs-function)
+ (flymake-proc--get-project-include-dirs-imp)
+ (flymake-proc--get-include-dirs-dot) (flymake-proc--get-tex-args)
+ (flymake-proc--find-make-buildfile)
+ (flymake-proc--get-syntax-check-program-args)
+ (flymake-proc--init-create-temp-source-and-master-buffer-copy)
+ (flymake-proc--init-find-buildfile-dir)
+ (flymake-proc--get-full-nonpatched-file-name)
+ (flymake-proc--get-full-patched-file-name) (flymake-proc--base-dir,
+ flymake-proc--temp-master-file-name) (flymake-proc--master-file-name)
+ (flymake-proc--temp-source-file-name)
+ (flymake-proc--delete-temp-directory) (flymake-proc--kill-process)
+ (flymake-proc--start-syntax-check-process)
+ (flymake-proc--compilation-is-running)
+ (flymake-proc--safe-delete-directory) (flymake-proc--safe-delete-file)
+ (flymake-proc--get-program-dir) (flymake-proc--restore-formatting)
+ (flymake-proc--clear-project-include-dirs-cache)
+ (flymake-proc--project-include-dirs-cache)
+ (flymake-proc--get-system-include-dirs)
+ (flymake-proc--get-project-include-dirs)
+ (flymake-proc--add-project-include-dirs-to-cache)
+ (flymake-proc--get-project-include-dirs-from-cache)
+ (flymake-proc--post-syntax-check) (flymake-proc--process-sentinel)
+ (flymake-proc--process-filter) (flymake-proc--create-master-file)
+ (flymake-proc--find-buffer-for-file)
+ (flymake-proc--copy-buffer-to-temp-buffer)
+ (flymake-proc--read-file-to-temp-buffer)
+ (flymake-proc--save-buffer-in-file) (flymake-proc--replace-region,
+ flymake-proc--check-include)
+ (flymake-proc--check-patch-master-file-buffer)
+ (flymake-proc--master-file-compare)
+ (flymake-proc--find-possible-master-files)
+ (flymake-proc--included-file-name, flymake-proc--same-files)
+ (flymake-proc--fix-file-name, flymake-proc--find-buildfile)
+ (flymake-proc--clear-buildfile-cache)
+ (flymake-proc--add-buildfile-to-cache)
+ (flymake-proc--get-buildfile-from-cache)
+ (flymake-proc--find-buildfile-cache)
+ (flymake-proc--get-real-file-name-function)
+ (flymake-proc--get-cleanup-function) (flymake-proc--get-init-function)
+ (flymake-proc--get-file-name-mode-and-masks)
+ (flymake-proc--processes): Rename to internal symbol from
+ flymake-proc- version.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Completely rewrite Flymake's subprocess output processing
+
+ Instead of parsing and matching regexps line-by-line, insert
+ subprocess output in a separate buffer and parse using
+ `search-forward-regexp'. This eventually enables multi-line error
+ patterns and simplifies code all around. Store per-check information
+ in the subprocess using `process-get' and `process-put'. Treat error
+ messages, warnings, etc. more generically as "diagnostics". Create
+ these objects as soon as possible, reusing existing `flymake-ler'
+ structure. Fix some whitespace.
+
+ * lisp/progmodes/flymake.el (cl-lib): Require also when
+ loading.
+ (flymake--fix-line-numbers): Rename from
+ flymake-fix-line-numbers. Simplify.
+ (flymake-report): Call flymake--fix-line-numbers. Rearrange
+ plain diagnostics list into alist format expected by
+ flymake-highlight-err-lines.
+
+ * lisp/progmodes/flymake-proc.el (flymake-process-filter): Insert
+ process output and parse in dedicated output buffer.
+ (flymake-proc--diagnostics-for-pattern): New helper function.
+ (flymake-process-sentinel): Call flymake-post-syntax-check with
+ collected diagnostics. Kill output buffer.
+ (flymake-post-syntax-check): Receive diagnostics as third argument.
+ (flymake-parse-output-and-residual, flymake-new-err-info)
+ (flymake-parse-residual, flymake-parse-err-lines)
+ (flymake-split-output, flymake-proc-parse-line)
+ (flymake-output-residual): Delete.
+ (flymake-start-syntax-check-process): Use make-process. Setup
+ dedicated an output buffer
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Flymake provides flymake-report re-entry point for backends
+
+ * lisp/progmodes/flymake-proc.el (flymake-post-syntax-check):
+ Simplify. Call flymake-report.
+
+ * lisp/progmodes/flymake.el (flymake-report): New function.
+
+2017-10-03 João Távora <joaotavora@gmail.com>
+
+ Split Flymake into flymake.el into flymake-proc.el (again!)
+
+ After deciding that this work would continue on master only, which
+ caused two commits named
+
+ Revert "Split flymake.el into flymake-proc.el and flymake-ui.el"
+
+ and
+
+ Revert "Add flymake-backends defcustom"
+
+ to be added to the emacs-26 branch, further discussion reversed that
+ decision.
+
+ See:
+
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg01020.html
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg01030.html
+
+ This means that those two commits MUST be merged to master AFTER ALL.
+
+ flymke-proc.el contains the main syntax-checking backend, while
+ flymake.el keeps mostly the UI part.
+
+ * lisp/progmodes/flymake-proc.el: New file. Require flymake.
+
+ * lisp/progmodes/flymake.el: Require flymake-proc.el at the end.
+
+2017-10-03 Nicolas Petton <nicolas@petton.fr>
+
+ Update authors.el
+
+ * admin/authors.el (authors-ignored-files, authors-valid-file-names)
+ (authors-renamed-files-alist): Additions.
+
+2017-10-03 Noam Postavsky <npostavs@gmail.com>
+
+ Give more helpful messages for python completion setup failures
+
+ * lisp/progmodes/python.el (python-shell-completion-native-setup): In
+ case the completion setup failed with some exception, print out the
+ exception type and message. If libedit is detected, raise an
+ exception, since this is known to fail.
+
+2017-10-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the --without-x build
+
+ * src/frame.c (Ficonify_frame) [HAVE_WINDOW_SYSTEM]: Use
+ frame_parent only in GUI builds to avoid compilation errors in
+ --without-x builds. (Bug#28611)
+
+2017-10-02 Paul Eggert <eggert@day>
+
+ Fix customization of zoneinfo-style-world-list
+
+ A customizable variable's initial value cannot depend on that of
+ another customizable variable, since the variables are initialized
+ in other than textual order. Problem reported by N. Jackson
+ (Bug#24291).
+ * lisp/time.el (display-time-world-list): Default to t,
+ a special value that expands to zoneinfo-style-word-list
+ if that works, and to legacy-style-word-list otherwise.
+ (time--display-world-list): New function.
+ (display-time-world, display-time-world-timer): Use it.
+
+2017-10-02 Alan Mackenzie <acm@muc.de>
+
+ Fix a CC Mode brace stack cache bug.
+
+ * lisp/progmodes/cc-engine.el (c-update-brace-stack): Call
+ c-beginning-of-current-token after a failing search operation, to ensure we
+ don't cache a point inside a token.
+
+2017-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/PROBLEMS: Document Bug#26638.
+
+2017-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer HTTPS to HTTP for gnu.org
+
+ This fixes some URLs I omitted from my previous pass,
+ notably those in lists.gnu.org. Although lists.gnu.org
+ does not yet support TLS 1.1, TLS 1.0 is better than nothing.
+ * lisp/erc/erc.el (erc-official-location):
+ * lisp/mail/emacsbug.el (report-emacs-bug):
+ Use https:, not http:.
+
+2017-10-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from Gnulib
+
+ This is mostly to change http: to https: in licenses.
+ * COPYING, build-aux/config.guess, build-aux/config.sub:
+ * doc/emacs/doclicense.texi, doc/emacs/gpl.texi:
+ * doc/lispintro/doclicense.texi, doc/lispref/doclicense.texi:
+ * doc/lispref/gpl.texi, doc/misc/doclicense.texi:
+ * doc/misc/gpl.texi, etc/COPYING, leim/COPYING:
+ * lib-src/COPYING, lib/COPYING, lisp/COPYING, lwlib/COPYING:
+ * msdos/COPYING, nt/COPYING, src/COPYING:
+ Copy from Gnulib.
+
+2017-10-01 Simen Heggestøyl <simenheg@gmail.com>
+
+ Keep eww buffer current when looking up CSS on MDN
+
+ * lisp/textmodes/css-mode.el (css-lookup-symbol): Keep the eww buffer
+ current when looking up CSS documentation on MDN. This fixes a bug
+ where the eww buffer's content sometimes get mangled when switching
+ buffers mid-render.
+
+2017-10-01 Charles A. Roelli <charles@aurox.ch>
+
+ Workaround for faulty localtime() under macOS 10.6
+
+ * lisp/org/org-clock.el (org-clock--oldest-date): Only execute
+ 'decode-time' on times later than year -2**31 under macOS 10.6.
+ See Bug#27706.
+
+2017-10-01 Alan Mackenzie <acm@muc.de>
+
+ Doc amendment for syntax-ppss.
+
+ * doc/lispref/syntax.texi (Position Parse): Note, twice, that syntax-ppss is
+ equivalent to parse-partial-sexp from the beginning of THE VISIBLE PART OF the
+ buffer. Final part of the fix for bug #22983.
+
+2017-10-01 Charles A. Roelli <charles@aurox.ch>
+
+ Remove incorrect NEWS entry about 'find-library'
+
+ * etc/NEWS (Changes in Emacs 26.1): Remove an entry about
+ 'find-library' taking a prefix argument to pop to a different
+ window. This behavior was added in "Allow a prefix argument to
+ find-library to pop to a different window" (commit e1f2d14a), and
+ then removed in "New commands: find-library-other-window,
+ find-library-other-frame" (commit 021430f4).
+
+2017-10-01 Alan Mackenzie <acm@muc.de>
+
+ Remove inadvertent changes to syntax.texi in last commit.
+
+ * doc/lispref/syntax.texi (Position Parse): revert changes.
+
+2017-10-01 Alan Mackenzie <acm@muc.de>
+
+ Amend documentation for text-quoting-style becoming a user option.
+
+ * doc/lispref/control.texi (Signaling Errors):
+ * doc/lispref/display.texi (Displaying Messages):
+ * doc/lispref/strings.texi (Formatting Strings):
+ Edit for brevity, farming out the details to the new
+ Text Quoting Style node.
+ * doc/lispref/help.texi (Text Quoting Style): New section.
+ Move detailed discussion of text-quoting-style here.
+ Add discussion about how to output grave accent and apostrophe in
+ documentation and messages. Adjust xrefs to point to this section
+ when appropriate.
+ * etc/NEWS: text-quoting-style semantics have not changed.
+
+2017-10-01 Alan Mackenzie <acm@muc.de>
+
+ Make the value nil in text-quoting-style mean what it does in Emacs 25.
+
+ This is a partial reversion of yesterday's commit by the same author, which
+ changed the meaning of nil and introduced the new value t.
+
+ * src/doc.c (text_quoting_style, text-quoting-style)
+ (internal--text-quoting-flag): Revert yesterday's changes.
+
+ * lisp/cus-start.el: (top level): Amend the entry for text-quoting-style.
+
+ * etc/NEWS: Amend the entry for text-quoting-style.
+
+ * doc/lispref/control.texi (Signalling Errors)
+ * doc/lispref/display.texi (Displaying Messages)
+ * doc/lispref/strings.texi (Formatting Strings): Bind text-quoting-style to
+ grave rather than nil to inhibit translation of quotes.
+
+ * doc/lispref/help.texi (Keys in Documentation): Revert the description of the
+ proposed new default, t.
+
+2017-10-01 Alan Mackenzie <acm@muc.de>
+
+ Make text-quoting-style customizable. Introduce t and new meaning for nil.
+
+ A value of nil for text-quoting-style now means "no translation". t means
+ "Use curved quotes if displayable".
+
+ * src/doc.c (text-quoting-style (function)): modify for new semantics.
+ (text-quoting-style (variable)): Amend the doc string, set the default value
+ to t.
+
+ * lisp/cus-start.el: (top level): Create a customize entry for
+ text-quoting-style in group display.
+
+ * etc/NEWS: Amend the entry for text-quoting-style.
+
+ * doc/emacs/display.texi (Text Display): Describe the translation of ASCII
+ quotes to curved quotes, and how to influence or inhibit it.
+
+ * doc/lispref/control.texi (Signalling Errors)
+ * doc/lispref/display.texi (Displaying Messages)
+ * doc/lispref/strings.texi (Formatting Strings): Describe binding
+ text-quoting-style to nil to inhibit unwanted quote translation.
+
+ * doc/lispref/help.texi (Keys in Documentation): Change text-quoting-style
+ from a variable to a user option. Describe its changed set of values. State
+ that it can be customized freely.
+
+2017-10-01 Michael Albinus <michael.albinus@gmx.de>
+
+ eshell.texi improvements
+
+ * doc/misc/eshell.texi (Built-ins): eshell/sudo is a compiled
+ Lisp function in `em-tramp.el'. Mention also $*, $1, $2, ...
+ (Aliases): Add $*, $1, $2, ... to the variable index.
+
+2017-08-15 Alan Third <alan@breton-build.holly.idiocy.org>
+
+ Fix ns-win.el on GNUstep
+
+ * lisp/term/ns-win.el: Appkit version check only works on macOS, so
+ don't try it when not using Cocoa.
+
+2017-10-01 Martin Rudalics <rudalics@gmx.at>
+
+ Fix reference style in org.texi
+
+ * doc/misc/org.texi (A Texinfo example): Fix reference style.
+
+2017-10-01 Martin Rudalics <rudalics@gmx.at>
+
+ Improve handling of iconification of child frames (Bug#28611)
+
+ * src/frame.c (Ficonify_frame): Handle `iconify-child-frame' option.
+ (syms_of_frame): New symbols Qiconify_top_level and Qmake_invisible.
+ (iconify_child_frame): New option.
+ * lisp/cus-start.el (iconify-child-frame): Add customization
+ properties.
+ * doc/lispref/frames.texi (Child Frames): Describe new option
+ `iconify-child-frame'. Don't index "top-level frame" twice.
+
+2017-10-01 Noam Postavsky <npostavs@gmail.com>
+
+ Revert "Don't lose arguments to eshell aliases (Bug#27954)"
+
+ It broke the established argument handling methods provided by eshell
+ aliases (Bug#28568).
+ * doc/misc/eshell.texi (Aliases): Fix example, call out use of
+ arguments in aliases.
+ * lisp/eshell/em-alias.el (eshell-maybe-replace-by-alias): Ignore
+ ARGS.
+
+2017-10-01 Noam Postavsky <npostavs@gmail.com>
+
+ Make "unsafe directory" error message more informative (Bug#865)
+
+ * lisp/server.el (server-ensure-safe-dir): Produce a description for
+ each "unsafe" condition.
+
+2017-10-01 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Fix slot typecheck in eieio-persistent
+
+ * lisp/emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p):
+ An `or' form can specify multiple potential classes (or null) as
+ valid types for a slot, but previously only the final element of the
+ `or' was actually checked. Now returns all valid classes in the `or'
+ form.
+ (eieio-persistent-validate/fix-slot-value): Check if proposed value
+ matches any of the valid classes.
+ * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+ (eieio-test-multiple-class-slot): Test this behavior.
+
+2017-09-30 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix semantic-ia-fast-jump
+
+ * lisp/cedet/semantic/ia.el (semantic-ia--fast-jump-helper):
+ Use `pop-to-buffer-same-window' (bug#28645).
+
+2017-09-30 Kaushal Modi <kaushal.modi@gmail.com>
+
+ Bind vc-region-history
+
+ * lisp/vc/vc-hooks.el (vc-prefix-map):
+ Bind `vc-region-history' to 'C-x v h', which was earlier bound to
+ `vc-insert-headers' (Bug#27644).
+ * doc/emacs/maintaining.texi (VC Change Log): Mention the new binding.
+ * doc/emacs/vc1-xtra.texi (Version Headers): Remove the association of
+ 'C-x v h' with `vc-insert-headers'.
+ (https://lists.gnu.org/r/emacs-devel/2017-09/msg00957.html)
+
+2017-09-30 Allen Li <vianchielfaura@gmail.com> (tiny change)
+
+ Exit macro definition on undefined keys
+
+ * lisp/subr.el (undefined): Error out of kmacro definition, if any.
+ (Bug#28008)
+
+2017-09-30 Tim Landscheidt <tim@tim-landscheidt.de> (tiny change)
+
+ Reset bidi-paragraph-direction on article rendering
+
+ * lisp/gnus/gnus-art.el (gnus-request-article-this-buffer): Reset
+ bidi-paragraph-direction on article rendering. (Bug#28454)
+
+2017-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ Fix url-http use of url-current-object
+
+ * lisp/url/url-http.el (url-http): Bind url-current-object before
+ calling url-http-find-free-connection. (Bug#28515)
+
+2017-09-30 Andy Moreton <andrewjmoreton@gmail.com>
+
+ Avoid assertions in vc-hg.el on MS-Windows
+
+ * lisp/vc/vc-hg.el (vc-hg--pcre-to-elisp-re)
+ (vc-hg--slurp-hgignore, vc-hg--read-repo-requirements)
+ (vc-hg-state-fast): Use file-name-absolute-p and directory-name-p
+ instead of relying on Unix file-name syntax. This avoids
+ assertion violations on MS-Windows.
+
+2017-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'copy-sequence'
+
+ * src/fns.c (Fcopy_sequence):
+ * doc/lispref/sequences.texi (Sequence Functions): Mention the
+ exception when copying an empty sequence. (Bug#28627)
+
+2017-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ Minor update of ack.texi
+
+ * doc/emacs/ack.texi (Acknowledgments): Update Eli Zaretskii's
+ contributions.
+
+2017-09-30 N. Jackson <nljlistbox2@gmail.com> (tiny change)
+
+ * doc/emacs/emacs.texi (Acknowledgments): Add more contributors.
+
+2017-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ Improve indexing of multi-file/buffer Isearch commands
+
+ * doc/emacs/maintaining.texi (Identifier Search): Change wording
+ of index entries to make them different from those for multi-file
+ isearch commands. (Bug#28584)
+ * doc/emacs/search.texi (Other Repeating Search): Index the
+ multi-* commands. (Bug#28584) Rearrange the indexing to keep
+ each index entry close to its subject.
+
+2017-09-30 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add CAM02 JCh and CAM02-UCS J'a'b' conversions
+
+ * src/lcms.c (rad2deg, parse_jch_list, parse_jab_list, xyz_to_jch):
+ (jch_to_xyz, jch_to_jab, jab_to_jch): New functions.
+ (lcms-jch->xyz, lcms-jch->xyz, lcms-jch->jab, lcms-jab->jch): New Lisp
+ functions.
+ (lcms-cam02-ucs): Refactor.
+ (syms_of_lcms2): Declare new functions.
+ * test/src/lcms-tests.el (lcms-roundtrip, lcms-ciecam02-gold):
+ (lcms-jmh->cam02-ucs-silver): New tests.
+ * etc/NEWS: Mention new functions.
+
+2017-09-30 Eli Zaretskii <eliz@gnu.org>
+
+ Fix uses of @kindex in the Emacs manual
+
+ * doc/emacs/programs.texi (Expressions, Semantic, Hungry Delete):
+ * doc/emacs/mark.texi (Global Mark Ring)
+ (Disabled Transient Mark):
+ * doc/emacs/buffers.texi (Select Buffer):
+ * doc/emacs/mule.texi (File Name Coding): Fix @kindex entries
+ which used @key. Reported by Marcin Borkowski <mbork@mbork.pl>.
+
+2017-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-09-28 string: code style
+ 2017-09-25 sys_types: update URL
+ 2017-09-23 install-sh: do not assume / = //
+ 2017-09-21 mktime: port to OpenVMS
+ * build-aux/install-sh, m4/mktime.m4, m4/string_h.m4:
+ * m4/sys_types_h.m4: Copy from Gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-09-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer HTTPS to HTTP for gnu.org
+
+ This catches some URLs I missed in my previous scan,
+ or perhaps were added after the scan.
+
+2017-09-30 Noam Postavsky <npostavs@gmail.com>
+
+ Wait for frame visibility with timeout in w32term too
+
+ * src/w32term.c (syms_of_w32term) [x-wait-for-event-timeout]: New
+ variable.
+ (x_make_frame_visible): Wait for frame to become visible according to
+ its value.
+ (input_signal_count): Remove.
+
+2017-09-30 Noam Postavsky <npostavs@gmail.com>
+
+ Bring back the busy wait after x_make_frame_visible (Bug#25521)
+
+ But wait specfically for a MapNotify event, and only for a
+ configurable amount of time.
+ * src/xterm.c (syms_of_xterm) [x-wait-for-event-timeout]: New
+ variable.
+ (x_wait_for_event): Use it instead of hardcoding the wait to 0.1s.
+ (x_make_frame_visible): Call x_wait_for_event at the end.
+ * etc/NEWS: Announce x_wait_for_event.
+
+2017-09-29 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last doc string change in simple.el
+
+ * lisp/simple.el (shell-command-saved-pos)
+ (region-extract-function, region-bounds): Doc fixes. (Bug#28609)
+
+2017-09-29 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "bug#28609: simple.el"
+
+ This reverts commit a75ab3b3fb8ab69ef38a94403d061f88f3b5b63e.
+
+2017-09-29 Devon Sean McCullough <Emacs-Hacker2017@jovi.net>
+
+ bug#28609: simple.el
+
+ Correct grammar; also, call a pair a pair.
+
+ (cherry picked from commit 25ef543a97a80718cc4eb33734d393420a43f41e)
+
+2017-09-29 Rasmus <rasmus@gmx.us>
+
+ Merge branch 'emacs-26' into scratch/org-mode-merge
+
+2017-09-29 Noam Postavsky <npostavs@gmail.com>
+
+ Fix ert backtrace saving for non-`signal'ed errors (Bug#28333)
+
+ * lisp/emacs-lisp/ert.el (ert--run-test-debugger): Take the frames
+ above the `debugger' frame, rather than assuming there will be a
+ `signal' frame.
+
+2017-09-28 Alan Third <alan@idiocy.org>
+
+ Revert "Fix build on macOS (bug#28571)"
+
+ This reverts commit fec63089d53d2196b0348086aeed70277fbc02c0.
+
+ Prematurely pushed.
+
+2017-09-28 Alan Third <alan@idiocy.org>
+
+ Fix build on macOS (bug#28571)
+
+ * src/conf_post.h (HAVE_FUTIMENS, HAVE_FUTIMESAT, HAVE_UTIMENSAT)
+ [DARWIN_OS]: Undefine.
+
+2017-09-28 Simen Heggestøyl <simenheg@gmail.com>
+
+ Add tests for `css-current-defun-name'
+
+ * test/lisp/textmodes/css-mode-tests.el (css-test-current-defun-name)
+ (css-test-current-defun-name-nested)
+ (css-test-current-defun-name-complex): New tests for
+ `css-current-defun-name'.
+
+2017-09-28 Martin Rudalics <rudalics@gmx.at>
+
+ In w32fullscreen_hook don't add decorations to undecorated frames
+
+ * src/w32term.c (w32fullscreen_hook): Do not add (or try to
+ remove) decorations for undecorated frames.
+
+2017-09-28 João Távora <joaotavora@gmail.com>
+
+ Revert "Split flymake.el into flymake-proc.el and flymake-ui.el"
+
+ In other words, re-coalesce the two files,
+ lisp/progmodes/flymake-proc.el and lisp/progmodes/flymake-ui.el, back
+ into a single one, lisp/progmodes/flymake.el.
+
+ The changesets "Prefer HTTPS to FTP and HTTP in documentation" and
+ "allow nil init in flymake-allowed-file-name-masks to disable flymake"
+ are kept in place in the new lisp/progmodes/flymake.el.
+
+ This reverts Git commit eb34f7f5a29e7bf62326ecb6e693f28878be28cd.
+
+ Don't merge this back to master as development happening there builds
+ upon this work. See also
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00932.html.
+
+2017-09-28 João Távora <joaotavora@gmail.com>
+
+ Revert "Add flymake-backends defcustom"
+
+ This reverts Git commit 13993c46a21495167517f76d2e36b6c09ac5e89e.
+
+ Don't merge this back to master as development happening there builds
+ upon this work. See also
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00932.html
+
+2017-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/editfns.c (styled_format): Fix typo in previous change.
+
+2017-09-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid some unnecessary copying in Fformat etc.
+
+ This patch is just for performance; it should not affect behavior.
+ On my platform, it made the microbenchmark (format "%S" load-path)
+ run about 45% faster. It should also speed up calls like (message
+ "%s" STRING).
+ * src/callint.c (Fcall_interactively):
+ * src/dbusbind.c (XD_OBJECT_TO_STRING):
+ * src/editfns.c (Fmessage, Fmessage_box):
+ * src/xdisp.c (vadd_to_log, Ftrace_to_stderr):
+ Use styled_format instead of Fformat or Fformat_message,
+ to avoid unnecessary copying.
+ * src/editfns.c (styled_format): New arg NEW_RESULT.
+ All uses changed. Reuse an input string if it has the
+ right value and if !NEW_RESULT.
+ * src/lisp.h (style_format): New decl.
+
+2017-09-26 John Wiegley <johnw@newartisans.com>
+
+ lisp/simple.el: Indicate when a list of pairs is meant in a docstring
+
+2017-09-26 Devon Sean McCullough <Emacs-Hacker2017@jovi.net>
+
+ bug#28609: simple.el
+
+ Correct grammar; also, call a pair a pair.
+
+2017-09-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ Use a separate syntax-ppss cache for narrowed buffers
+
+ * lisp/emacs-lisp/syntax.el (syntax-ppss-wide):
+ New variable, to contain the data from `syntax-ppss-last' and
+ `syntax-ppss-cache'.
+ (syntax-ppss-cache, syntax-ppss-last): Remove.
+ (syntax-ppss-narrow, syntax-ppss-narrow-start): New variables.
+ (syntax-ppss-flush-cache): Flush both caches.
+ (syntax-ppss--data): Return the appropriate last result and
+ buffer cache for the current restriction.
+ (syntax-ppss, syntax-ppss-debug): Use it (bug#22983).
+
+2017-09-26 Joerg Behrmann <behrmann@physik.fu-berlin.de> (tiny change)
+
+ Improve python3-compatibility of fallback completion (Bug#28499)
+
+ * lisp/progmodes/python.el (python-eldoc-setup-code): Use
+ inspect.getfullargspec instead of inspect.getargspec to avoid a
+ deprecation warning on every usage of eldoc in python-mode.
+
+2017-09-26 Noam Postavsky <npostavs@gmail.com>
+
+ Fix subr-x-tests when running from elc
+
+ * test/lisp/emacs-lisp/subr-x-tests.el (subr-x-and-let*-test-group-1):
+ Use `eval' around the `should-error' cases.
+
+2017-09-26 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/eshell/esh-util.el (eshell-condition-case): Add debug declaration.
+
+2017-09-26 Noam Postavsky <npostavs@gmail.com>
+
+ Make sh-indentation into an alias for sh-basic-offset (Bug#21751)
+
+ * lisp/progmodes/sh-script.el (sh-indentation): Redefine as obsolete
+ variable alias for `sh-basic-offset'.
+ (sh-mode, sh-smie--indent-continuation)
+ (sh-smie-rc-rules, sh-basic-indent-line): Replace `sh-indentation'
+ with `sh-basic-offset'.
+
+2017-09-26 Noam Postavsky <npostavs@gmail.com>
+
+ Fix loading of smie-config rules (Bug#24848)
+
+ * lisp/emacs-lisp/smie.el (smie-config--setter): Use `set-default'
+ instead of `setq-default'.
+ (smie-config): Use `custom-initialize-set' instead of
+ `custom-initialize-default' as the :initialize argument.
+
+ * lisp/progmodes/sh-script.el (sh-learn-buffer-indent): Mention that
+ we call `smie-config-guess' so that the user will have a chance to
+ find the correct docstring to consult. Remove hedging comments
+ regarding use of abnormal hooks.
+
+2017-09-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ Reset default-directory inside *xref-grep* buffer
+
+ * lisp/progmodes/xref.el (xref-collect-matches):
+ Reset default-directory, too. (Bug#28575)
+
+2017-09-25 Michael Albinus <michael.albinus@gmx.de>
+
+ * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Special
+ code for smb.
+
+2017-09-25 Mark Oteiza <mvoteiza@udel.edu>
+
+ Loosen strict parsing requirement for desktop files
+
+ There are other desktop-looking files, for instance those having to do
+ with MIME typess, that would benefit from being able to be read by this
+ function. It helps to have some flexibility.
+ * lisp/xdg.el (xdg-desktop-read-file): Remove an error condition.
+ * test/lisp/xdg-tests.el: Remove a test.
+
+2017-09-25 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/xdg.el (xdg-thumb-uri): Fix doc string.
+
+2017-09-25 Martin Rudalics <rudalics@gmx.at>
+
+ Fix documentation of `make-frame' and related variables and hooks
+
+ * lisp/frame.el (before-make-frame-hook)
+ (after-make-frame-functions, frame-inherited-parameters)
+ (make-frame): Fix doc-strings.
+ * doc/lispref/frames.texi (Creating Frames): Fix description
+ of `make-frame' and related variables and hooks.
+
+2017-09-24 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Accept new `always' value for option `buffer-offer-save'
+
+ Also revert ee512e9a82
+
+ * lisp/files.el (buffer-offer-save): In addition to nil and t, now
+ allows a third symbol value, `always'. A buffer where this option is
+ set to `always' will always be offered for save by
+ `save-some-buffers'.
+ (save-some-buffers): Check the exact value of this buffer-local
+ variable. No longer check the buffer name, or the value of
+ `write-contents-functions'.
+ * doc/lispref/buffers.texi (Killing Buffers): Note change in manual.
+ * doc/lispref/files.texi (Saving Buffers): Remove note about buffer
+ names.
+ * etc/NEWS: Mention in NEWS.
+
+2017-09-24 Alan Third <alan@idiocy.org>
+
+ Improve new NS scrolling variable names
+
+ * src/nsterm.m (ns-use-system-mwheel-acceleration): Replace with
+ 'ns-use-mwheel-acceleration'.
+ (ns-touchpad-scroll-line-height): Replace with
+ 'ns-mwheel-line-height'.
+ (ns-touchpad-use-momentum): Replace with 'ns-use-mwheel-momentum'.
+ * etc/NEWS: Change variable names.
+
+2017-09-24 Philipp Stephani <phst@google.com>
+
+ Document 'replace-buffer-contents' in the manual.
+
+ * doc/lispref/text.texi (Replacing): New node.
+
+2017-09-23 Alan Third <alan@idiocy.org>
+
+ Fix undecorated frame resizing issues on NS (bug#28512)
+
+ * src/nsterm.m (EmacsView::updateFrameSize): Don't wait for the
+ toolbar on undecorated frames.
+ (EmacsView::initFrameFromEmacs): Group window flags correctly.
+
+2017-09-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix doc string of 'dired-listing-switches'
+
+ * lisp/dired.el (dired-listing-switches): Fix the quoting
+ example. (Bug#28569)
+
+2017-09-23 Eli Zaretskii <eliz@gnu.org>
+
+ Documentation improvements for 'display-line-numbers'
+
+ * doc/emacs/display.texi (Display Custom): Document a few more
+ options for display-line-numbers. (Bug#28533) Fix a typo.
+
+2017-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change in bat-mode.el
+
+ * lisp/progmodes/bat-mode.el (bat-font-lock-keywords): Fix last
+ change. (Bug#28311)
+
+2017-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ Fix restoring in GUI sessions desktop saved in TTY sessions
+
+ * lisp/frameset.el (frameset-filter-font-param): New function.
+ (frameset-persistent-filter-alist): Use it for processing the
+ 'font' frame parameter. (Bug#17352)
+
+2017-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ Improve syntax highlighting in bat-mode
+
+ * lisp/progmodes/bat-mode.el (bat-font-lock-keywords): Improve
+ font-locking of environment variables. Suggested by Achim Gratz
+ <Stromeko@nexgo.de>. (Bug#28311) (Bug#18405)
+
+2017-09-22 Eli Zaretskii <eliz@gnu.org>
+
+ Document the 'list-FOO' convention
+
+ * doc/lispref/tips.texi (Coding Conventions): Document the
+ list-FOO convention.
+
+2017-09-22 Mark Oteiza <mvoteiza@udel.edu>
+
+ Expose viewing conditions in CAM02-UCS metric
+
+ Also add tests from the colorspacious library. Finally, catch an
+ errant calculation, where degrees were not being converted to radians.
+ * src/lcms.c (deg2rad, default_viewing_conditions):
+ (parse_viewing_conditions): New functions.
+ (lcms-cam02-ucs): Add comments pointing to references used. Expand
+ the docstring and explain viewing conditions. JCh hue is given in
+ degrees and needs to be converted to radians.
+ (lcms-d65-xyz): Remove. No need to duplicate this in Lisp or make the
+ API needlessly impure.
+ * test/src/lcms-tests.el: Reword commentary.
+ (lcms-rgb255->xyz): New function.
+ (lcms-cri-cam02-ucs): Fix let-binding.
+ (lcms-dE-cam02-ucs-silver): New test, assimilated from colorspacious.
+
+2017-09-21 Alan Third <alan@idiocy.org>
+
+ Revert "Set frame size to actual requested size (bug#18215)"
+
+ This reverts commit d31cd79b40dbd5459b16505a4ee4340210499277.
+
+ See bug#28536. I misunderstood bug#18215. It wasn't a bug.
+
+2017-09-21 Gemini Lasswell <gazally@runbox.com>
+
+ Add tests for Edebug
+
+ * test/lisp/emacs-lisp/edebug-tests.el: New file.
+ * test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el: New file.
+
+2017-09-21 Gemini Lasswell <gazally@runbox.com>
+
+ Catch more messages in ert-with-message-capture
+
+ * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): Capture
+ messages from prin1, princ and print.
+ (ert--make-message-advice): New function.
+ (ert--make-print-advice): New function.
+
+2017-09-21 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
+
+ Support setting region from secondary selection and vice versa
+
+ * lisp/mouse.el (secondary-selection-exist-p): New function to
+ allow callers to tell existence of the secondary selection
+ in current buffer.
+ (secondary-selection-to-region): New function to set
+ beginning and end of the region from those of the secondary
+ selection.
+ (secondary-selection-from-region): New function to set
+ beginning and end of the secondary selection from those of
+ the region. (Bug#27530)
+
+ * etc/NEWS: Mention the new functions.
+
+2017-09-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix new copy-directory bug with empty dirs
+
+ Problem reported by Afdam Plaice (Bug#28520) and by Eli Zaretskii
+ (Bug#28483#34). This is another bug that I introduced in my
+ recent copy-directory changes.
+ * lisp/files.el (copy-directory): Work with empty subdirectories, too.
+ * test/lisp/files-tests.el (files-tests--copy-directory):
+ Test for this bug.
+
+2017-09-20 Eli Zaretskii <eliz@gnu.org>
+
+ * doc/lispref/strings.texi (Formatting Strings): Improve indexing.
+
+2017-09-20 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 2 testsuite tests for MS-Windows
+
+ * test/lisp/ibuffer-tests.el (test-buffer-list): Don't try to
+ create files with "*" in their names.
+ * test/src/editfns-tests.el (format-time-string-with-zone): Adapt
+ results to MS-Windows build. Reported by Fabrice Popineau
+ <fabrice.popineau@gmail.com>.
+
+2017-09-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Rename timer-list to list-timers
+
+ * doc/emacs/anti.texi (Antinews):
+ * doc/lispref/os.texi (Timers):
+ * etc/NEWS:
+ * lisp/emacs-lisp/timer-list.el:
+ (timer-list-mode): Rename timer-list to list-timers.
+
+2017-09-19 Alan Third <alan@idiocy.org>
+
+ Provide native touchpad scrolling on macOS
+
+ * etc/NEWS: Describe changes.
+ * lisp/term/ns-win.el (mouse-wheel-scroll-amount,
+ mouse-wheel-progressive-speed): Set to smarter values for macOS
+ touchpads.
+ * src/nsterm.m (emacsView::mouseDown): Use precise scrolling deltas to
+ calculate scrolling for touchpads and mouse wheels.
+ (syms_of_nsterm): Add variables 'ns-use-system-mwheel-acceleration',
+ 'ns-touchpad-scroll-line-height' and 'ns-touchpad-use-momentum'.
+ * src/keyboard.c (make_lispy_event): Pass on .arg when relevant.
+ * src/termhooks.h (event_kind): Update comments re. WHEEL_EVENT.
+ * lisp/mwheel.el (mwheel-scroll): Use line count.
+ * lisp/subr.el (event-line-count): New function.
+
+2017-09-19 Eli Zaretskii <eliz@gnu.org>
+
+ Fix MinGW64 build broken by recent MinGW64 import libraries
+
+ * configure.ac (W32_LIBS): Put -lusp10 before -lgdi32, as latest
+ MinGW64 import libraries require that. (Bug#28493)
+
+ * src/Makefile.in: Adjust commentary to the new order of w32
+ libraries.
+
+2017-09-19 Eli Zaretskii <eliz@gnu.org>
+
+ Fix crashes in 'move-point-visually' in minibuffer windows
+
+ * src/xdisp.c (Fmove_point_visually): Fix off-by-one error in
+ comparing against the last valid glyph_row of a window glyph
+ matrix. (Bug#28505)
+
+2017-09-19 Eli Zaretskii <eliz@gnu.org>
+
+ * src/emacs.c (usage_message): Don't mention 'find-file'.
+
+2017-09-19 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a minor inaccuracy in the Emacs manual
+
+ * doc/emacs/cmdargs.texi (Action Arguments): Don't mention
+ 'find-file', as the implementation has changed. Reported by
+ Everton J. Carpes <everton.carpes@gmail.com> in
+ https://lists.gnu.org/r/help-gnu-emacs/2017-09/msg00146.html.
+
+2017-09-19 Eli Zaretskii <eliz@gnu.org>
+
+ Fix errors in flyspell-post-command-hook
+
+ * lisp/textmodes/ispell.el (ispell-get-decoded-string): Handle the
+ case of a nil Nth element of the language dictionary slot. This
+ avoids errors in 'flyspell-post-command-hook' when switching
+ dictionaries with some spell-checkers. (Bug#28501)
+
+2017-09-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Work on Tramp's file-truename
+
+ * lisp/net/tramp-sh.el (tramp-perl-file-truename):
+ Check also for symlinks.
+ (tramp-sh-handle-file-truename): Move check for a symlink
+ cycle to the end. Do not blame symlinks which look like a
+ remote file name.
+
+ * lisp/net/tramp.el (tramp-handle-file-truename): Expand result.
+
+2017-09-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug with make-directory on MS-Windows root
+
+ * lisp/files.el (files--ensure-directory): Treat any error, not
+ just file-already-exists, as an opportunity to check whether DIR
+ is already a directory (Bug#28508).
+
+2017-09-19 Tom Tromey <tom@tromey.com>
+
+ Fix log-view-diff-common when point is after last entry
+
+ Bug#28466
+ * lisp/vc/log-view.el (log-view-diff-common): If point is after last
+ entry, look at the previous revision.
+
+2017-09-18 Ken Brown <kbrown@cornell.edu>
+
+ Adapt fileio-tests--symlink-failure to Cygwin
+
+ * test/src/fileio-tests.el (fileio-tests--symlink-failure)
+ [CYGWIN]: Skip the case of a symlink target starting with '\';
+ this is treated specially on Cygwin.
+
+2017-09-18 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Ignore buffers whose name begins with a space in save-some-buffers
+
+ * lisp/files.el (save-some-buffers): Consider these buffers
+ "internal", and don't prompt the user to save them.
+ * doc/lispref/files.texi: Document.
+
+2017-09-18 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve tramp-interrupt-process robustness
+
+ * lisp/net/tramp.el (tramp-interrupt-process): Wait, until the
+ process has disappeared.
+
+2017-09-18 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor Tramp doc update
+
+ * doc/misc/tramp.texi (Frequently Asked Questions):
+ Mention `vc-handled-backends'.
+
+2017-09-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Fix gensym
+
+ * lisp/subr.el (gensym): Actually implement the default prefix.
+ * test/lisp/subr-tests.el (subr-tests--gensym): New test.
+
+2017-09-18 Rasmus <rasmus@gmx.us>
+
+ Update Org to v9.1.1
+
+ Please see etc/ORG-NEWS for major changes.
+
+2017-09-18 Michael Albinus <michael.albinus@gmx.de>
+
+ Cleanup in files-tests.el
+
+ * test/lisp/files-tests.el (files-tests--make-directory)
+ (files-tests--copy-directory): Cleanup temporary directories.
+
+2017-09-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove old cl-assert calls in 'newline'
+
+ * lisp/simple.el (newline): Remove cl-assert calls
+ that didn't seem to be helping us debug Bug#18913,
+ and that caused problems as reported in Bug#28280.
+ Suggested by Glenn Morris (Bug#28280#8).
+
+2017-09-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid crash with C-g C-g in GC
+
+ Problem reported by Richard Stallman (Bug#17406).
+ Based on fix suggested by Eli Zaretskii (Bug#28279#16).
+ * src/term.c (tty_send_additional_strings):
+ Use only safe accessors, to avoid crash when C-g C-g in GC.
+
+2017-09-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix format-time-string %Z bug with negative tz
+
+ * src/editfns.c (tzlookup): Fix sign error in %Z when a purely
+ numeric zone is negative (Bug#28746).
+ * test/src/editfns-tests.el (format-time-string-with-zone):
+ Add test for this bug.
+
+2017-09-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ message-citation-line-format %Z is now tz name
+
+ * etc/NEWS:
+ * lisp/gnus/message.el (message-citation-line-format):
+ Fix doc to match new behavior (Bug#28476).
+
+2017-09-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Use doc-view or pdf-tools on any window-system
+
+ * lisp/net/mailcap.el (mailcap-mime-data): Simply check for
+ window-system.
+
+2017-09-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug with min and max and NaNs
+
+ * src/data.c (minmax_driver): Fix bug with (min 0 NaN), which
+ mistakenly yielded 0. Also, pacify GCC in a better way.
+ * test/src/data-tests.el (data-tests-min): Test for the bug.
+
+2017-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix recently-introduced copy-directory bug
+
+ Problem reported by Andrew Christianson (Bug#28451):
+ * lisp/files.el (copy-directory): If COPY-CONTENTS, make the
+ destination directory if it does not exist, even if it is a
+ directory name. Simplify, and omit unnecessary test for an
+ already-existing non-directory target, since make-directory
+ diagnoses that for us now.
+ * test/lisp/files-tests.el (files-tests--copy-directory):
+ Test for this bug.
+
+2017-09-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from Gnulib
+
+ This incorporates:
+ 2017-09-16 manywarnings: port to GCC on 64-bit MS-Windows
+ 2017-09-13 all: Replace many more http URLs by https URLs
+ * build-aux/config.guess, build-aux/config.sub:
+ * build-aux/gitlog-to-changelog, doc/misc/texinfo.tex:
+ * lib/allocator.h, lib/count-leading-zeros.h:
+ * lib/count-trailing-zeros.h, lib/dup2.c, lib/filevercmp.c:
+ * lib/fstatat.c, lib/fsync.c, lib/ftoastr.c, lib/ftoastr.h:
+ * lib/intprops.h, lib/signal.in.h, lib/stdio-impl.h, lib/stdio.in.h:
+ * lib/unistd.in.h, lib/utimens.c, m4/alloca.m4, m4/extern-inline.m4:
+ * m4/fstatat.m4, m4/gnulib-common.m4, m4/manywarnings.m4:
+ * m4/std-gnu11.m4, m4/sys_types_h.m4, m4/vararrays.m4:
+ Copy from Gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-09-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix compatibility problem in Tramp
+
+ * lisp/net/tramp.el (tramp-interrupt-process): Better error handling.
+
+ * lisp/net/tramp-compat.el (default-toplevel-value): Move up.
+ (top): Do not call `tramp-change-syntax' anymore.
+ (tramp-compat-directory-name-p): New defalias.
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-copy-file): Use it.
+
+ * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process):
+ Modify test.
+
+2017-09-17 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid GCC 7 compilation warning in eval.c
+
+ * src/eval.c (push_handler_nosignal): Use CACHEABLE to work around
+ GCC compilation warning. Suggested by Paul Eggert <eggert@cs.ucla.edu>
+ in https://lists.gnu.org/r/emacs-devel/2017-09/msg00492.html.
+
+2017-09-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Adapt Tramp version. Do not merge
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.3.3.26.1".
+ (customize-package-emacs-version-alist): Add Tramp version
+ integrated in Emacs 26.1.
+
+2017-09-17 Tom Tromey <tom@tromey.com>
+
+ Search for Syntax section when viewing MDN
+
+ * lisp/textmodes/css-mode.el (css--mdn-after-render): Also search for
+ "Syntax" section.
+
+2017-09-17 Tom Tromey <tom@tromey.com>
+
+ Allow smerge-keep-current to work for empty hunks
+
+ Bug#25555
+ * lisp/vc/smerge-mode.el (smerge-get-current): Allow point to be at
+ match-end.
+ * test/lisp/vc/smerge-mode-tests.el: New file.
+
+2017-09-17 Tom Tromey <tom@tromey.com>
+
+ Call vc-setup-buffer in vc-git-log-{in,out}going
+
+ Bug#28427:
+ * lisp/vc/vc-git.el (vc-git-log-incoming, vc-git-log-outgoing): Call
+ vc-setup-buffer.
+
+2017-09-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Fix last change to textmodes/page-ext.el
+
+ * lisp/textmodes/page-ext.el (pages-directory): Make buffer writable
+ while we build it (bug#28431).
+
+2017-09-16 Glenn Morris <rgm@gnu.org>
+
+ * test/src/lcms-tests.el (lcms-cri-cam02-ucs): Skip if lcms2 not present.
+
+2017-09-16 Glenn Morris <rgm@gnu.org>
+
+ * test/src/lcms-tests.el (lcms-whitepoint): Skip if lcms2 not present.
+
+ (cherry picked from commit 8081df26911c63aadfce4ee8f6a7223d814baeaf)
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation warning in etags.c
+
+ * lib-src/etags.c (etags_mktmp) [DOS_NT]: Don't dereference a NULL
+ pointer. Reported by Richard Copley <rcopley@gmail.com>.
+
+2017-09-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add lisp variable lcms-d65-xyz
+
+ This serves as the default optional argument for functions in this
+ library.
+ * src/lcms.c (lcms-d65-xyz): New variable.
+ (lcms-cam02-ucs): Use it. Use better word in docstring. Fix bug
+ color1 -> color2.
+ * test/src/lcms-tests.el: Add some tests for lcms-cri-cam02-ucs.
+ (lcms-colorspacious-d65): New variable.
+
+2017-09-16 Gemini Lasswell <gazally@runbox.com>
+
+ * lisp/emacs-lisp/cl-macs.el (cl-letf): Fix Edebug spec (bug#24765)
+
+2017-09-16 Andy Moreton <andrewjmoreton@gmail.com>
+
+ Avoid MinGW64 compiler warnings in unexw32.c
+
+ * src/unexw32.c (pDWP) [MINGW_W64]: Define to "16llx" only for the
+ 64-bit build.
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Start emacs-26 release branch
+
+ * configure.ac:
+ * nt/README.W32:
+ * README:
+ * msdos/sed2v2.inp: Increment Emacs version to 26.0.60.
+
+ * lisp/cus-edit.el (customize-changed-options-previous-release):
+ Update value to "25.3".
+
+2017-09-16 Alan Mackenzie <acm@muc.de>
+
+ Cope better with C++ and Objective-C protection keywords in class declarations
+
+ This fix fixes the fontification of a method inside a class at the time it is
+ typed, when there is a protection keyword clause preceding it.
+
+ * lisp/progmodes/cc-engine.el (c-forward-keyword-clause): Handle protection
+ keywords.
+ (c-looking-at-decl-block): Avoid scanning forward over protection keyword
+ clauses too eagerly.
+
+ * lisp/progmodes/cc-langs.el (c-protection-key c-post-protection-token): New
+ lang defconsts and defvars.
+
+ * lisp/progmodes/cc-mode.el (c-fl-decl-start): When we encounter a protection
+ keyword following a semicolon or brace, move forward over it before attempting
+ to parse a type.
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix order of sorted overlays returned by 'overlays-at'
+
+ * src/buffer.c (Foverlays_at): If SORTED is non-nil, reverse the
+ list of results, to have their order as per the documentation.
+ (Bug#28390)
+
+ * etc/NEWS: Mention the change in the behavior of overlays-at.
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Disable execution of unsafe Lisp by Enriched Text mode
+
+ * src/xdisp.c (handle_display_spec): If the display property is
+ wrapped in 'disable-eval' form, disable Lisp evaluation while
+ processing this property.
+ (handle_single_display_spec): Accept new argument ENABLE_EVAL_P.
+ If that argument is false, don't evaluate Lisp while processing
+ display properties.
+
+ * lisp/textmodes/enriched.el
+ (enriched-allow-eval-in-display-props): New defcustom.
+ (enriched-decode-display-prop): If
+ enriched-allow-eval-in-display-props is nil, wrap the display
+ property with 'disable-eval' to disable Lisp evaluation when the
+ display property is processed for display. (Bug#28350)
+ * lisp/gnus/mm-view.el (mm-inline-text): Re-enable processing of
+ enriched text.
+
+ * doc/lispref/display.texi (Display Property): Document the
+ 'disable-eval' wrapping of 'display' properties.
+ * doc/emacs/text.texi (Enriched Properties): Document
+ 'enriched-allow-eval-in-display-props'.
+
+ * etc/NEWS: Describe the security issues with Enriched Text mode
+ and their solution.
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid MinGW64 compilation warning in w32.c
+
+ * src/w32.c (sys_strerror): Provide a prototype for MinGW64.
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix MS-Windows build broken by recent changes in lcms.c
+
+ * src/lcms.c [WINDOWSNT]: Define types for cmsWhitePointFromTemp
+ and cmsxyY2XYZ function pointers.
+ (init_lcms_functions) [WINDOWSNT]: Load cmsWhitePointFromTemp and
+ cmsxyY2XYZ from liblcms2.
+ (cmsWhitePointFromTemp, cmsxyY2XYZ) [WINDOWSNT]: Redirect to the
+ corresponding function pointers.
+ (Flcms_temp_to_white_point): Minor stylistic changes. Doc fix.
+ (syms_of_lcms2): Defsubr Slcms_temp_to_white_point.
+
+2017-09-16 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid GCC 7 compilation warning in data.c
+
+ * src/data.c (minmax_driver): Use UNINIT to avoid compilation
+ warnings. Reported by Fabrice Popineau
+ <fabrice.popineau@centralesupelec.fr>.
+
+2017-09-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add lcms-temp->white-point and initial tests
+
+ * src/lcms.c (lcms-temp->white-point): New function.
+ * test/src/lcms-tests.el: New file.
+
+2017-09-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Use cl-print in timer list
+
+ * lisp/emacs-lisp/timer-list.el (timer-list): Use cl-print
+ for handling functions.
+ (timer-list-mode): Capitalize major mode name. Set bidi direction
+ as in tabulated-list-mode.
+
+2017-09-15 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Make landscape layout with geometry package rather than a PostScript special.
+
+ * lisp/calendar/cal-tex.el (cal-tex-preamble): Make 12pt the
+ default class option.
+ (cal-tex-year, cal-tex-cursor-month-landscape): Pass landscape
+ request to `cal-tex-insert-preamble' function call within the
+ class option string.
+ (cal-tex-cursor-month): Don't pass any longer "12pt" argument
+ to `cal-tex-insert-preamble' function, as it is default.
+ (cal-tex-insert-preamble): Suppress landscape and size
+ argument, and replace them by a class-options string
+ argument. Do not insert any longer "\special{landscape}" in
+ case of landscape layout, as the job is made by the geometry
+ package.
+
+2017-09-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/json.el (json-read-keyword): Revert previous change to catch EOL.
+
+2017-09-15 Eli Zaretskii <eliz@gnu.org>
+
+ One more attempt to avoid GCC 7 warnings in dispnew.c
+
+ * src/dispnew.c (adjust_glyph_matrix): Use eassume instead of
+ eassert, to avoid compilation warnings about NULL pointer
+ dereferences.
+
+2017-09-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Fix color-distance docstring
+
+ Also feed the translated color to the metric argument.
+ * src/xfaces.c (color-distance): Reword docstring to be more helpful.
+ Avoid duplicating effort in lcms2 by passing the translated 16 bit RGB
+ instead of the function's color arguments.
+
+2017-09-15 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve Tramp behaviour according to bug#27986
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-copy-file): Check, that NEWNAME is a
+ directory name when existing. Use `file-name-as-directory'
+ where appropriate.
+
+2017-09-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ More JSON optimization
+
+ Last I checked, inlining json-skip-whitespace didn't make much
+ difference. However, changing defsubsts to define-inline results
+ in roughly 15% reduction in read time on a 200K file.
+ * lisp/json.el (json-advance, json-peek, json-pop):
+ (json-skip-whitespace): Inline with define-inline.
+ (json-read-keyword): Don't use whitespace syntax.
+ (json-add-to-object): Simpler condition.
+
+2017-09-15 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes due to invalid error forms from sentinels/filters
+
+ * src/process.c (exec_sentinel_error_handler): Make sure the error
+ form passed to cmd_error_internal is a cons cell. (Bug#28430)
+
+2017-09-15 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compilation warnings with GCC 7 on MS-Windows
+
+ * src/w32term.c (w32_setup_relief_color, construct_mouse_click)
+ (w32_read_socket): Initialize variables to shut up bogus
+ compilation warnings from GCC 7.
+ * src/unexw32.c (COPY_CHUNK, COPY_PROC_CHUNK): Cast to DWORD_PTR
+ to avoid compiler warnings about printing signed values using %x
+ format spec.
+ * src/dispnew.c (adjust_glyph_matrix): Add eassert to avoid
+ compiler warning about possible NULL pointer dereference.
+ * src/lisp.h (pI): Tweak the definition some more for MinGW64.
+
+2017-09-15 Martin Rudalics <rudalics@gmx.at>
+
+ Define gnutls_rnd for WINDOWSNT and HAVE_GNUTLS3 case only
+
+ * src/fns.c (gnutls_rnd): Define for WINDOWSNT and HAVE_GNUTLS3
+ case only to avoid unused macros warning otherwise.
+
+2017-09-15 Martin Rudalics <rudalics@gmx.at>
+
+ In w32heap.c bump up DUMPED_HEAP_SIZE
+
+ * src/w32heap.c (DUMPED_HEAP_SIZE): Bump up DUMPED_HEAP_SIZE
+ to 13*1024*1024 for 32-bit non-wide-integer builds.
+
+2017-09-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Bind n,p in timer-list
+
+ * lisp/emacs-lisp/timer-list.el (timer-list-mode-map): Bind n and p
+ to next- and previous-line, respectively.
+
+2017-09-14 Glenn Morris <rgm@gnu.org>
+
+ * lisp/net/tls.el (tls-program): Fix :version.
+
+2017-09-14 Eli Zaretskii <eliz@gnu.org>
+
+ * configure.ac (--with-lcms2, --without-lcms2): New options.
+
+2017-09-14 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid 64-bit compilation warnings in unexw32.c
+
+ * src/unexw32.c (pDWP): New macro.
+ (COPY_CHUNK, COPY_PROC_CHUNK): Declare 'count' as DWORD_PTR. Use
+ pDWP for printing values that can be either 32-bit or 64-bit wide.
+
+2017-09-14 Eli Zaretskii <eliz@gnu.org>
+
+ Fix warnings about formats in printf-like functions on MS-Windows
+
+ * src/lisp.h (pI) [__MINGW32__]: Provide definition that will
+ hopefully DTRT with both MinGW64 and mingw.org's MinGW. See
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00171.html
+ for the details.
+ * src/conf_post.h (PRINTF_ARCHETYPE) [MINGW_W64]: Separate
+ definition specific to MinGW64.
+ (PRINTF_ARCHETYPE) [__MINGW32__]: For mingw.org's MinGW, use
+ __mingw_printf__ in ANSI-compatible mode.
+
+2017-09-14 Eli Zaretskii <eliz@gnu.org>
+
+ Support lcms2 in MS-Windows builds
+
+ * lisp/term/w32-win.el (dynamic-library-alist): Include
+ association for the lcms2 library.
+
+ * src/lcms.c [WINDOWSNT]: Include windows.h and w32.h. Use
+ DEF_DLL_FN to define pointers to dynamically loaded lcms2
+ functions.
+ (cmsCIE2000DeltaE, cmsCIECAM02Init, cmsCIECAM02Forward)
+ (cmsCIECAM02Done): New macros.
+ (init_lcms_functions, Flcms2_available_p): New functions.
+ (Flcms_cie_de2000, Flcms_cam02_ucs) [WINDOWSNT]: Call
+ init_lcms_functions.
+ (syms_of_lcms2): Defsubr lcms2-available-p.
+ * src/w32fns.c (syms_of_w32fns): DEFSYM Qlcms2.
+
+ * configure.ac: Include lcms2 in the final report and in
+ emacs_config_features.
+
+ * nt/INSTALL:
+ * nt/INSTALL.W64: Update with the information about lcms2 library.
+
+2017-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port renameat_noreplace to openSUSE 12.3
+
+ Problem reported by M. Nomiya in:
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00363.html
+ * src/sysdep.c (renameat_noreplace):
+ Call renameat2 only if CYGWIN.
+
+2017-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer HTTPS to FTP and HTTP in documentation
+
+ Most of this change is to boilerplate commentary such as license URLs.
+ This change was prompted by ftp://ftp.gnu.org's going-away party,
+ planned for November. Change these FTP URLs to https://ftp.gnu.org
+ instead. Make similar changes for URLs to other organizations moving
+ away from FTP. Also, change HTTP to HTTPS for URLs to gnu.org and
+ fsf.org when this works, as this will further help defend against
+ man-in-the-middle attacks (for this part I omitted the MS-DOS and
+ MS-Windows sources and the test tarballs to keep the workload down).
+ HTTPS is not fully working to lists.gnu.org so I left those URLs alone
+ for now.
+
+2017-09-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer HTTPS to HTTP for gnu.org
+
+ This patch just changes code files; a followup companion patch
+ (much larger) will affect the commentary. This part is
+ separated out to make it easier to review.
+ * .dir-locals.el (change-log-mode):
+ * lisp/org/org-info.el (org-info-other-documents)
+ (org-info-map-html-url):
+ * lisp/org/ox-html.el (org-html-creator-string):
+ * lisp/startup.el (fancy-startup-text, fancy-about-text)
+ (fancy-splash-head):
+ * test/lisp/ffap-tests.el (ffap-other-window--bug-25352):
+ * test/lisp/thingatpt-tests.el (thing-at-point-test-data):
+ Use HTTPS instead of HTTP.
+
+2017-09-13 Simen Heggestøyl <simenheg@gmail.com>
+
+ Add tests for color.el
+
+ * lisp/color.el (color-name-to-rgb, color-complement): Clarify in
+ docstrings that RGB triplets should use four digits per component.
+ (color-rgb-to-hsl): Break line to avoid "Hidden behind deeper element"
+ warning.
+
+ * test/lisp/color-tests.el: New file.
+
+2017-09-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make gnutls-verify-error work again with url-retrieve-synchronously
+
+ * lisp/url/url-gw.el (url-open-stream): Only use :nowait if
+ we're doing async connections (bug#26835).
+
+ * lisp/url/url-parse.el (url): Add an asynchronous slot.
+
+ * lisp/url/url.el (url-asynchronous): New variable.
+ (url-retrieve-internal): Store the value.
+ (url-retrieve-synchronously): Bind the variable.
+
+2017-09-13 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve backward compatibility of tramp-tests
+
+ * test/lisp/net/tramp-tests.el (seq): Don't require.
+ (tramp--test-emacs26-p): New defun.
+ (tramp-test10-write-region, tramp-test11-copy-file)
+ (tramp-test12-rename-file, tramp-test15-copy-directory)
+ (tramp-test21-file-links): Use it.
+ (tramp-test16-file-expand-wildcards): Use `copy-sequence'.
+
+2017-09-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/trampver.el (customize-package-emacs-version-alist):
+
+ Add Tramp version integrated in Emacs 25.3.
+
+2017-09-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add clarification to if-let* docstring
+
+ Also make its behaviour consistent with and-let* in that empty bindings
+ results in success, not failure.
+ * lisp/emacs-lisp/subr-x.el: Edit docstring, change else to then.
+
+2017-09-13 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make fully qualified domain names more fully qualified
+
+ * lisp/gnus/message.el (message-make-fqdn): Don't try to use a
+ system-name without any periods as a fully qualified domain name.
+
+2017-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unused file lib/getopt_.h
+
+ * lib/getopt_.h: Remove. It was renamed to lib/getopt.in.h etc.
+ on 2011-01-08, but I forgot to remove the old file.
+
+2017-09-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Remove "baroque" use of prefix argument from gensym
+
+ 'cl-gensym' was simply moved here, but let us take an opportunity to
+ shed some historical baggage.
+ * lisp/subr.el (gensym): Remove special treatment of PREFIX as a
+ number. Use "g" as prefix to differentiate from cl-gensym defaults.
+ * doc/lispref/symbols.texi (Creating Symbols): Update accordingly.
+ * lisp/emacs-lisp/cl-macs.el (cl--gensym-counter, cl-gensym): Restore.
+
+2017-09-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Provide an lcms2 feature
+
+ * src/lcms.c (syms_of_lcms2): Provide "lcms2".
+
+2017-09-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add lcms2 interface
+
+ configure.ac: Add boilerplate for configuring and detecting liblcms2.
+ etc/NEWS: Mention new configure option and color-distance change.
+ src/Makefile.in: Add references to lcms.c and liblcms.
+ src/emacs.c: Define lcms2 symbols.
+ src/lcms.c: New file.
+ src/lisp.h: Add declaration for lcms2.
+ src/xfaces.c: Add optional METRIC argument.
+
+2017-09-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add other D series white points and some simple conversions
+
+ * lisp/color.el (color-d75-xyz, color-d55-xyz, color-d50-xyz): New
+ constants.
+ (color-xyz-to-xyy, color-xyy-to-xyz, color-lab-to-lch):
+ (color-lch-to-lab): New functions.
+
+2017-09-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Permit non-integral color gradients
+
+ * lisp/color.el (color-gradient): Float the step-number.
+
+2017-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Protect against malformed MIME messages that cause inf-loop (bugfix)
+
+ * lisp/gnus/gnus-art.el (gnus-article-mime-handles):
+ Protect against malformed MIME messages that cause inf-loop.
+
+2017-09-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from Gnulib
+
+ This incorporates:
+ 2017-09-13 all: prefer https: URLs
+ This just changes http: to https: in comments,
+ in files copied from Gnulib.
+
+2017-09-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ Call vc-resynch-buffer in vc-git-resolve-when-done
+
+ * lisp/vc/vc-git.el (vc-git-resolve-when-done):
+ Call vc-resynch-buffer on the current file (bug#28121).
+ Move its autoload to before this function.
+
+2017-09-13 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Allow write-contents-functions to short-circuit buffer save
+
+ Bug#28412
+
+ * lisp/files.el (basic-save-buffer): Re-arrange function so that
+ write-contents-functions are run earlier. If they return non-nil,
+ consider the buffer saved without requiring the buffer to be
+ visiting a file.
+ (save-some-buffers): This function should consider any buffer with a
+ buffer-local value for write-contents-functions eligible for
+ saving.
+ * test/lisp/files-tests.el (files-test-no-file-write-contents): New
+ test.
+ * doc/lispref/files.texi (Saving Buffers): Mention in docs.
+ * etc/NEWS: And in NEWS.
+
+2017-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/NEWS.25: Copy from emacs-25 etc/NEWS.
+
+2017-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Less chatter for ’make info/dir’
+
+ * Makefile.in (${srcdir}/info/dir): Tweak shell command so
+ that an ordinary make says just "GEN info/dir" rather than
+ also having a seemingly-unrelated mv line.
+
+2017-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Tweak Gnus doc re gnus-copy-file
+
+ * doc/misc/gnus.texi (Saving Articles):
+ Document behavior with directory name targets (Bug#27986).
+ Problem reported by Katsumi Yamaoka in:
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00216.html
+
+2017-09-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Update uses of if-let and when-let
+
+ * lisp/dom.el (dom-previous-sibling):
+ * lisp/emacs-lisp/package.el (package--with-work-buffer):
+ (package--sort-deps-in-alist, package--sort-by-dependence):
+ (package-install-from-archive, package-install):
+ (package-menu-execute, package-menu--populate-new-package-list):
+ * lisp/filenotify.el (file-notify--rm-descriptor):
+ (file-notify--event-watched-file, file-notify--event-file-name):
+ (file-notify--event-file1-name, file-notify-rm-watch):
+ (file-notify-valid-p):
+ * lisp/gnus/message.el (message-toggle-image-thumbnails):
+ * lisp/gnus/nnimap.el (nnimap-request-move-article):
+ * lisp/ibuf-ext.el (ibuffer-repair-saved-filters):
+ * lisp/mpc.el (mpc-format):
+ * lisp/net/eww.el (eww-tag-meta, eww-process-text-input):
+ (eww-save-history):
+ * lisp/net/shr.el (shr-tag-base, shr-tag-object, shr-make-table-1):
+ * lisp/progmodes/prog-mode.el (prettify-symbols--post-command-hook):
+ * lisp/svg.el (svg-remove):
+ * lisp/textmodes/css-mode.el (css--named-color):
+ (css--colon-inside-funcall):
+ * lisp/textmodes/sgml-mode.el (html-current-buffer-classes):
+ (html-current-buffer-ids): Use if-let* and when-let* instead.
+
+2017-09-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Implement and-let*
+
+ This also includes changes to if-let and when-let. The single tuple
+ special case is ambiguous, and binding a symbol to nil is not as
+ useful as binding it to its value outside the lexical scope of the
+ binding. (Bug#28254)
+ * etc/NEWS: Mention.
+ * lisp/emacs-lisp/subr-x.el (internal--listify):
+ (internal--build-binding-value-form): Extend to account for
+ solitary symbols and (EXPR) items in binding varlist.
+ (if-let*, when-let*): Nix single tuple case and incumbent
+ bind-symbol-to-nil behavior.
+ (and-let*): New macro.
+ (if-let, when-let): Mark obsolete. Redefine in terms of if-let*, so
+ they implicitly gain the new features without breaking existing code.
+ * test/lisp/emacs-lisp/subr-x-tests.el: Adjust tests for: lack of
+ single-tuple special case, lack of binding solitary symbols to nil,
+ and the introduction of uninterned symbols for (EXPR) bindings. Add
+ SRFI-2 test suite adapted to Elisp.
+
+2017-09-12 Eli Zaretskii <eliz@gnu.org>
+
+ Fix minor typos in the Emacs manual
+
+ * doc/emacs/text.texi (Org Organizer):
+ * doc/emacs/ack.texi (Acknowledgments): Fix spelling of Org nodes.
+
+2017-09-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge Emacs 25.3 fixes
+
+ The security patches released for Emacs 25.3 were less drastic
+ than what we had immediately put into master. Adjust master to
+ match 25.3 (Bug#28350).
+ * lisp/textmodes/enriched.el (enriched-translations):
+ Re-enable FUNCTION and display translations that are safe.
+ (enriched-handle-display-prop): Bring back.
+ (enriched-decode-display-prop): Bring back, but disable
+ the unsafe part.
+
+2017-09-12 Alan Mackenzie <acm@muc.de>
+
+ Don't match C++ template delims starting within a token. FIxes bug #28418.
+
+ * lisp/progmodes/cc-engine.el (c-restore-<>-properties): After failing an
+ attempted match from the start of a token (in particular, "<<"), move to the
+ next token rather than the nex character before searching for the next "<".
+
+2017-09-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Move gensym to core Elisp
+
+ * doc/lispref/symbols.texi (Creating Symbols): Mention gensym right
+ after make-symbol.
+ * etc/NEWS: Mention.
+ * lisp/emacs-lisp/cl-macs.el (cl--gensym-counter): Alias to
+ gensym-counter.
+ (cl-gensym): Alias to gensym.
+ * lisp/emacs-lisp/cl.el: Remove gensym from list of aliases.
+ * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper):
+ * lisp/emacs-lisp/ert-x.el (ert-with-message-capture):
+ (ert--expand-should-1, ert--expand-should):
+ (ert--should-error-handle-error):
+ * lisp/emacs-lisp/generator.el (cps--gensym):
+ * lisp/emacs-lisp/gv.el (setf):
+ * lisp/emacs-lisp/inline.el (inline--do-letlisteval):
+ * lisp/emacs-lisp/pcase.el (pcase--make-docstring, pcase-dolist):
+ (pcase--funcall, pcase--u1): Use gensym.
+ * lisp/subr.el (gensym-counter): New variable.
+ (gensym): New function, assimilated from cl-lib.
+
+2017-09-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Fix cl-gentemp
+
+ * lisp/emacs-lisp/cl-macs.el (cl--gentemp-counter): New variable.
+ (cl-gentemp): Use it. Change prefix to "T".
+
+2017-09-12 Sam Steingold <sds@gnu.org>
+
+ gnus-score-file-name: Do not append empty suffix.
+
+2017-09-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Extend tramp-tests according to bug#27986
+
+ * test/lisp/net/tramp-tests.el (tramp-test11-copy-file)
+ (tramp-test12-rename-file, tramp-test15-copy-directory)
+ (tramp-test21-file-links): Extend tests.
+ (tramp-test13-make-directory, tramp-test14-delete-directory):
+ Specifiy error symbol in `should-error'.
+
+2017-09-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add cl-print method for hash tables
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-object): New method.
+
+2017-09-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add docstrings to cl-print entry points
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-compiled): Fix docstring.
+ (cl-prin1, cl-prin1-to-string): Add docstrings.
+
+2017-09-12 Glenn Morris <rgm@gnu.org>
+
+ Improve reproducibility of generated leim-list.el
+
+ * lisp/international/quail.el (quail-update-leim-list-file):
+ Sort the quail directory listing, for more stable output.
+
+2017-09-11 Mark Oteiza <mvoteiza@udel.edu>
+
+ Include sxhash of object with printed bytecode
+
+ This printing, while succint, is rather opaque. At least give an
+ immediate clue of whether different byte code printouts are for the
+ same or different byte code objects.
+ * lisp/emacs-lisp/cl-print.el (cl-print-object): Add object sxhash to
+ printed token "#<bytecode>".
+
+2017-09-11 Eli Zaretskii <eliz@gnu.org>
+
+ Update documentation of 'max-lisp-eval-depth'
+
+ * doc/lispref/eval.texi (Eval): Update the documented default
+ value of 'max-lisp-eval-depth'.
+
+2017-09-11 Eli Zaretskii <eliz@gnu.org>
+
+ Another place to produce debugging output in etags
+
+ * lib-src/etags.c (Ruby_functions): One more place to print
+ debugging output under --debug.
+
+2017-09-11 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of etags-related features
+
+ * doc/emacs/maintaining.texi (Looking Up Identifiers): Document
+ 'xref-prompt-for-identifier'. (Bug#28403)
+ (Etags Regexps): Document \D back references in etags regexps.
+
+2017-09-11 Alan Third <alan@idiocy.org>
+
+ Fix macOS compatibility versions for vibrant dark theme (bug#28415)
+
+ * src/nsterm.m (ns_set_appearance, EmacsView::initFrameFromEmacs):
+ Change macOS compatibility from 10.9 to 10.10.
+
+2017-09-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Further optimization in Tramp's file name decomposition
+
+ * lisp/net/tramp.el (tramp-syntax): Recompute all file name
+ components. Call `custom-set-variables' after loading.
+ (tramp-build-prefix-format, tramp-build-prefix-regexp)
+ (tramp-build-method-regexp)
+ (tramp-build-postfix-method-format)
+ (tramp-build-postfix-method-regexp)
+ (tramp-build-prefix-ipv6-format)
+ (tramp-build-prefix-ipv6-regexp)
+ (tramp-build-postfix-ipv6-format)
+ (tramp-build-postfix-ipv6-regexp)
+ (tramp-build-postfix-host-format)
+ (tramp-build-postfix-host-regexp)
+ (tramp-build-file-name-regexp)
+ (tramp-build-completion-file-name-regexp): New defuns.
+ (tramp-prefix-format, tramp-prefix-regexp)
+ (tramp-method-regexp, tramp-postfix-method-format)
+ (tramp-postfix-method-regexp, tramp-prefix-ipv6-format)
+ (tramp-prefix-ipv6-regexp, tramp-postfix-ipv6-format)
+ (tramp-postfix-ipv6-regexp, tramp-postfix-host-format)
+ (tramp-postfix-host-regexp)
+ (tramp-remote-file-name-spec-regexp)
+ (tramp-file-name-structure, tramp-file-name-regexp)
+ (tramp-completion-file-name-regexp): Convert defuns into defvars.
+ (tramp-prefix-regexp-alist)
+ (tramp-postfix-method-regexp-alist)
+ (tramp-prefix-ipv6-regexp-alist)
+ (tramp-postfix-ipv6-regexp-alist)
+ (tramp-postfix-host-regexp-alist)
+ (tramp-remote-file-name-spec-regexp-alist): Remove.
+ (tramp-build-remote-file-name-spec-regexp)
+ (tramp-build-file-name-structure): Simplify.
+ (tramp-completion-file-name-regexp-alist): New defconst.
+ (tramp-tramp-file-p, tramp-dissect-file-name)
+ (tramp-make-tramp-file-name)
+ (tramp-completion-make-tramp-file-name)
+ (tramp-rfn-eshadow-update-overlay-regexp)
+ (tramp-register-file-name-handlers)
+ (tramp-completion-handle-file-name-all-completions)
+ (tramp-completion-dissect-file-name, tramp-clear-passwd):
+ * lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered)
+ (tramp-compute-multi-hops): Use variables but functions for
+ file name components.
+
+ * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion):
+ Use variables but functions for file name components.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port tramp-tests to new copy-directory behavior
+
+ * test/lisp/net/tramp-tests.el (tramp-test15-copy-directory):
+ Use directory name as arg for copy-directory when we want
+ the special behavior.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Adjust thumbs to new rename-file behavior
+
+ * etc/NEWS: Mention this.
+ * lisp/thumbs.el (thumbs-rename-images): Treat the destination
+ as special only if it is a directory name. When there is
+ a marked list, turn the destination into a directory name
+ if it is not already.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Adjust ob-tangle to new copy-file behavior
+
+ * lisp/org/ob-tangle.el (org-babel-tangle-publish):
+ Port to new copy-file behavior.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make gnus-copy-file act like copy-file etc.
+
+ * etc/NEWS: Mention this.
+ * lisp/gnus/gnus-util.el (gnus-copy-file): Treat the destination
+ as special only if it is a directory name.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make write-file act like copy-file etc.
+
+ Change write-file to be consistent with the new behavior
+ of copy-file, etc.
+ * etc/NEWS: Mention this.
+ * lisp/files.el (write-file): Treat the destination as special
+ only if it is a directory name.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make copy-directory act like copy-file etc.
+
+ Do the special dance with the destination only if it is a
+ directory name, for consistency with copy-file etc. (Bug#27986).
+ * doc/emacs/files.texi (Copying and Naming):
+ * doc/lispref/files.texi (Create/Delete Dirs):
+ * etc/NEWS: Document this.
+ * lisp/files.el (copy-directory): Treat NEWNAME as special
+ only if it is a directory name.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix some make-directory bugs
+
+ * lisp/files.el (files--ensure-directory): New function.
+ (make-directory): Use it to avoid bugs when (make-directory FOO t)
+ is invoked on a non-directory, or on a directory hierarchy that
+ is being built by some other process while Emacs is running.
+ * test/lisp/files-tests.el (files-tests--make-directory): New test.
+
+2017-09-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix race with rename-file etc. with dir NEWNAME
+
+ This changes the behavior of rename-file etc. slightly.
+ The old behavior mostly disagreed with the documentation, and had
+ a race condition bug that could allow attackers to modify victims'
+ write-protected directories (Bug#27986).
+ * doc/lispref/files.texi (Changing Files): Document that in
+ rename-file etc., NEWFILE is special if it is a directory name.
+ * etc/NEWS: Document the change in behavior.
+ * src/fileio.c (directory_like): Remove. All uses removed.
+ (expand_cp_target): Test only whether NEWNAME is a directory name,
+ not whether it is currently a directory. This avoids a race.
+ (Fcopy_file, Frename_file, Fadd_name_to_file, Fmake_symbolic_link):
+ Document behavior if NEWNAME is a directory name.
+ (Frename_file): Simplify now that the destdir behavior occurs
+ only when NEWNAME is a directory name.
+ * test/lisp/net/tramp-tests.el (tramp-test11-copy-file)
+ (tramp-test12-rename-file, tramp--test-check-files):
+ Adjust tests to match new behavior.
+
+2017-09-10 Eli Zaretskii <eliz@gnu.org>
+
+ Extend --debug printouts in etags
+
+ * lib-src/etags.c (regex_tag_multiline, readline): Under
+ "--debug", print tags found via regexps.
+
+2017-09-10 Eli Zaretskii <eliz@gnu.org>
+
+ Add --debug option to etags
+
+ * lib-src/etags.c (make_tag): Print found tags under --debug.
+ (longopts): Add --debug.
+
+2017-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes
+
+ * lisp/progmodes/cc-langs.el:
+ (c-ambiguous-overloadable-or-identifier-prefixes): Rename from
+ c-ambiguous-overloadable-or-identifier-prefices. Caller changed.
+
+2017-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-09-08 stddef: Avoid conflict with system-defined max_align_t
+ 2017-08-24 warnings: fix compilation with old autoconf
+ 2017-08-23 glob: merge from glibc with Zanella glob changes
+ 2017-08-17 random: Fix test compilation failure on Cygwin 1.5.25
+ * doc/misc/texinfo.tex, lib/flexmember.h, lib/stddef.in.h:
+ * lib/stdlib.in.h, m4/manywarnings.m4, m4/stdlib_h.m4:
+ * m4/warnings.m4:
+ Copy from Gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-09-10 Ken Brown <kbrown@cornell.edu>
+
+ Implement renameat_noreplace on recent Cygwin
+
+ * src/sysdep.c [CYGWIN]: Include cygwin/fs.h.
+ (renameat_noreplace) [RENAME_NOREPLACE]: Use renameat2.
+ (Bug#27986)
+
+2017-09-10 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid warnings about file names in autoloads on MS-Windows
+
+ * configure.ac (srcdir) [mingw32]: Downcase the drive letter, to
+ avoid warnings from find-file-noselect when making autoloads. For
+ the details, see
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00049.html.
+
+2017-09-10 Mark Oteiza <mvoteiza@udel.edu>
+
+ Avoid looking at localized strings
+
+ * lisp/xdg.el (xdg-desktop-read-group): Add condition to catch
+ localized strings.
+ * test/lisp/xdg-tests.el (xdg-desktop-parsing): Add test to ensure
+ parsing l10n strings doesn't error but is essentially a no-op.
+
+2017-09-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/NEWS.25: Document 25.3 changes.
+
+2017-09-10 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Remove unsafe enriched mode translations
+
+ * lisp/gnus/mm-view.el (mm-inline-text):
+ Do not worry about enriched or richtext type.
+ * lisp/textmodes/enriched.el (enriched-translations):
+ Remove translations for FUNCTION, display (Bug#28350).
+ (enriched-handle-display-prop, enriched-decode-display-prop): Remove.
+
+2017-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Be more consistent about "directory name" in manual
+
+ This clarifies the documentation, partly in response to the
+ discussion in Bug#27986.
+
+2017-09-09 Eli Zaretskii <eliz@gnu.org>
+
+ Remove more compilation warnings in MinGW64 build
+
+ * src/w32.c (faccessat, map_w32_filename):
+ * src/w32fns.c (w32_wnd_proc):
+ * src/w32term.c (w32_horizontal_scroll_bar_handle_click)
+ (w32_scroll_bar_handle_click): Use FALLTHROUGH to avoid compiler
+ warnings with GCC 7 and later.
+
+2017-09-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve --enable-gcc-warnings for MinGW64
+
+ This partially reverts my 2016-05-30 patch. Apparently MinGW64
+ still requires pacifications that GCC 7.1.1 x86-64 (Fedora 26)
+ does not. Also, pacify tparam.c, which isn’t used on Fedora.
+ * lib-src/etags.c (process_file_name, TeX_commands):
+ * src/buffer.c (fix_overlays_before):
+ * src/data.c (Fmake_variable_buffer_local, cons_to_unsigned)
+ (cons_to_signed):
+ * src/editfns.c (Ftranslate_region_internal):
+ Prefer UNINIT to some stray value, as this simplifies
+ code-reading later.
+ * src/eval.c (CACHEABLE): New macro.
+ (internal_lisp_condition_case): Use it.
+ * src/tparam.c (tparam1): Use FALLTHROUGH to pacify GCC.
+
+2017-09-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix font-lock in Compilation mode
+
+ * lisp/progmodes/compile.el (compilation-face): Restore function
+ lost during recent changes. (Bug#28349)
+
+2017-09-09 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add function to read all entries in a group
+
+ Use that to extend xdg-desktop-read-file. Also fix a bug where all
+ entries in all groups were read and returned by xdg-desktop-read-file.
+ * lisp/xdg.el (xdg-desktop-read-group): New function.
+ (xdg-desktop-read-file): Use it.
+ * test/data/xdg/malformed.desktop: New file.
+ * test/data/xdg/test.desktop: Add another section.
+ * test/lisp/xdg-tests.el (xdg-desktop-parsing): Test presence of a key
+ in another group. Test reading a prescribed group. Test detecting a
+ malformed key=value.
+
+2017-09-09 Gemini Lasswell <gazally@runbox.com>
+
+ Reduce Tramp's memory usage
+
+ Construct Tramp syntax strings and regular expressions once instead
+ of every time they are used, and store them in alists keyed by Tramp
+ syntax.
+ * lisp/net/tramp.el (tramp-build-remote-file-name-spec-regexp)
+ (tramp-build-file-name-structure): New functions.
+ (tramp-prefix-format-alist, tramp-prefix-regexp-alist)
+ (tramp-method-regexp-alist)
+ (tramp-postfix-method-format-alist)
+ (tramp-postfix-method-regexp-alist)
+ (tramp-prefix-ipv6-format-alist, tramp-prefix-ipv6-regexp-alist)
+ (tramp-postfix-ipv6-format-alist)
+ (tramp-postfix-ipv6-regexp-alist)
+ (tramp-postfix-host-format-alist)
+ (tramp-postfix-host-regexp-alist)
+ (tramp-remote-file-name-spec-regexp-alist)
+ (tramp-file-name-structure-alist): New constants.
+ (tramp-lookup-syntax): New function.
+ (tramp-prefix-format, tramp-prefix-regexp, tramp-method-regexp)
+ (tramp-postfix-method-format, tramp-postfix-method-regexp)
+ (tramp-prefix-ipv6-format, tramp-prefix-ipv6-regexp)
+ (tramp-postfix-ipv6-format, tramp-postfix-ipv6-regexp)
+ (tramp-postfix-host-format, tramp-postfix-host-regexp)
+ (tramp-remote-file-name-spec-regexp, tramp-file-name-structure):
+ Use it.
+
+2017-09-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation warnings in MinGW64 build using GCC 7
+
+ Reported by Richard Copley <rcopley@gmail.com>.
+ * src/w32heap.c (init_heap): Declare enable_lfh only for
+ mingw.org's MinGW build.
+
+ * src/w32console.c (w32con_write_glyphs):
+ * src/unexw32.c (get_section_info, COPY_CHUNK, unexec): Fix some
+ mismatches of data type vs format spec.
+
+ * src/w32fns.c (compute_tip_xy):
+ * src/w32proc.c (stop_timer_thread):
+ * src/w32notify.c (remove_watch):
+ * src/eval.c (internal_lisp_condition_case):
+ * src/editfns.c (Ftranslate_region_internal):
+ * src/data.c (Fmake_variable_buffer_local, cons_to_unsigned)
+ (cons_to_signed):
+ * src/buffer.c (fix_overlays_before): Initialize variables to
+ avoid compiler warnings.
+
+ * lib-src/etags.c (TeX_commands, process_file_name): Initialize
+ variables to avoid compilation warnings.
+
+2017-09-09 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid infloop when scrolling under scroll-preserve-screen-position
+
+ * src/window.c (window_scroll_pixel_based): If screen position is
+ to be preserved, make sure its recorded Y coordinate is outside
+ the scroll margin. (Bug#28342)
+
+2017-09-09 Michael Albinus <michael.albinus@gmx.de>
+
+ Clarification in tramp-texi
+
+ * doc/misc/tramp.texi (Connection caching): Two connections are
+ regarded as different now when they differ in the port number only.
+
+2017-09-09 Miles Bader <miles@gnu.org>
+
+ * admin/quick-install-emacs: Tweak configure.ac parsing
+
+2017-09-09 Miles Bader <miles@gnu.org>
+
+ Use text-property buttons in rcirc-markup-urls
+
+ * lisp/net/rcirc.el (rcirc-markup-urls): Use `make-text-button'
+ instead of `make-button'; the former is much more efficient in large
+ buffers, and for the purposes of rcirc, changes no functionality.
+
+2017-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ Fix line-pixel-height for lines of variable height
+
+ * src/xdisp.c (Fline_pixel_height): Start moving from the
+ beginning of the screen line, to capture the full metrics of the
+ line. (Bug#28391)
+
+2017-09-08 Alex Branham <branham@utexas.edu> (tiny change)
+
+ New variable 'dired-confirm-killing-deleted-buffers'
+
+ * lisp/dired-x.el (dired-clean-confirm-killing-deleted-buffers):
+ New variable.
+ * lisp/dired.el (dired-clean-up-after-deletion): Kill buffers
+ visiting deleted files without confirming if
+ dired-clean-confirm-killing-deleted-buffers is nil. (Bug#28373)
+ * etc/NEWS: Document the change.
+
+2017-09-08 Alfred M. Szmidt <ams@gnu.org> (tiny change)
+
+ Support SVN files with svn:externals property
+
+ * lisp/vc/vc-svn.el (vc-svn-parse-status): Don't ignore files
+ marked with the svn:externals property.
+
+2017-09-08 Alfred M. Szmidt <ams@gnu.org> (tiny change)
+
+ List locally removed files in vc-dir with SVN back-end
+
+ * lisp/vc/vc-svn.el (vc-svn-after-dir-status): List files marked
+ with ?! as needs-update.
+
+2017-09-08 Ken Olum <kdo@cosmos.phy.tufts.edu>
+
+ Fix Rmail editing with reapplying encoding to message body
+
+ * lisp/mail/rmailedit.el (rmail-cease-edit): If no
+ content-type in edited headers, look for one in original
+ headers and add it to edited headers. (Bug #26918)
+ Use a marker to track start of new body, so that
+ content-transfer-encoding gets applied only to body. (Bug #27353).
+ Ensure blank line at end of message after encoding, not
+ before.
+
+2017-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ Document last change in dired.el
+
+ * etc/NEWS (Dired): Document the last change in dired.el.
+ (Bug#27435)
+
+2017-09-08 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
+
+ Make mouse clicks in Dired more customizable
+
+ * lisp/dired.el (dired-mouse-find-file): Allow callers to
+ specify functions to visit file/directory.
+ (dired-mouse-find-file-other-window)
+ (dired-mouse-find-file-other-frame): New functions to visit
+ files in another window/frame. (Bug#27435)
+
+2017-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compiler warnings on MS-Windows with GCC 6 and 7
+
+ * src/w32font.c (SUBRANGE): Use unsigned arithmetic for
+ bit-shifting, to avoid compiler warnings.
+ (w32font_text_extents): Tell GCC NGLYPHS is non-negative, to avoid
+ a warning. For details of the warning, see
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00093.html.
+ * src/term.c (keys) [WINDOWSNT]: Don't define, as it is not used
+ in that build.
+ * src/sound.c (sound_perror): Ifdef away on WINDOWSNT, as this
+ function is not used in that build.
+
+ * configure.ac: Disable -Wsuggest-attribute=format on MS-Windows.
+
+2017-09-08 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'directory-file-name' on DOS_NT systems as well
+
+ * src/fileio.c (directory_file_name) [DOS_NT]: Fix the DOS_NT case
+ to be consistent with last change.
+
+ * test/src/fileio-tests.el (fileio-tests--odd-symlink-chars):
+ Disable on MS-Windows.
+ (fileio-tests--directory-file-name-dos-nt)
+ (fileio-tests--file-name-as-directory-dos-nt): New tests.
+
+2017-09-08 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Fix various verilog-mode.el issues.
+
+ * lisp/progmodes/verilog-mode.el (verilog-expand-dirnames): Fix expanding
+ "*/*", msg2284. Reported by Jonathan Ferguson.
+ (ignore-errors): Fix ignore-errors error on Emacs 22.3, bug1177. Reported
+ by Victor Lau.
+ (verilog-getopt, verilog-getopt-file) (verilog-library-flags,
+ verilog-substitute-file-name-path): Support -F in verilog getopt files,
+ bug1171. Reported by George Cuan.
+ (verilog-do-indent): Fix misindenting symbols starting with t,
+ bug1169. Reported by Hoai Tran.
+ (verilog-read-auto-template-middle): Fix slow template matching on
+ AUTOINST. Reported by Jeffrey Huynh.
+ (verilog-pretty-expr): The extra whitespace addition before "=" operators
+ is now done only if the whole assignment block contains the 2-character
+ "<=" operator. Remove the unused argument _myre. Use `unless',
+ `save-excursion' and `when' functions where possible. Internal variables
+ refactored for clarity. Follow elisp convention for closing parentheses.
+ By Kaushal Modi.
+ (verilog-get-lineup-indent-2): Update docstring. Internal variables
+ refactored for clarity. Earlier EDPOS argument was expected to be a
+ marker; it is now renamed to END and is now expected to be a position.
+ Use `when' instead of `if'. By Kaushal Modi.
+ (electric-verilog-terminate-line): Remove the unused second argument from
+ `verilog-pretty-expr' call. By Kaushal Modi.
+ (verilog-calc-1): Fix indentation of a virtual class definition after a
+ typedef class, bug1080. By Kaushal Modi.
+
+2017-09-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Don't use summary window to visit group buffer (bugfix)
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-jump-to-group): Make sure that
+ the window to open the group buffer doesn't visit the summary buffer.
+ This fixes a bug: `gnus-summary-next-article' sometimes causes an error
+ by trying to select nonexistent summary window.
+
+2017-09-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug: (directory-file-name "///") returned "//"
+
+ * src/fileio.c (directory_file_name): For "///" and longer,
+ return "/", not "//", as per POSIX.
+ * test/src/fileio-tests.el (fileio-tests--directory-file-name)
+ (fileio-tests--file-name-as-directory): New tests.
+
+2017-09-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove obsolete vc-mistrust-permissions doc
+
+ * doc/emacs/vc1-xtra.texi (RCS and SCCS): Remove documentation
+ for vc-mistrust-permissions, which no longer exists.
+
+2017-09-07 Alan Third <alan@idiocy.org>
+
+ Set frame size to actual requested size (bug#18215)
+
+ * src/nsterm.m (x_set_window_size): Don't use
+ FRAME_TEXT_TO_PIXEL_WIDTH or FRAME_TEXT_TO_PIXEL_HEIGHT.
+
+2017-09-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ autogen.sh: omit bogus chatter if no .git
+
+ Problem reported by Angelo Graziosi in:
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00045.html
+ * autogen.sh (git_config): Do not execut 'git' if $do_git fails.
+
+2017-09-07 Glenn Morris <rgm@gnu.org>
+
+ Skip emacsclient tests if --enable-profiling was used
+
+ * test/lib-src/emacsclient-tests.el
+ (emacsclient-test-call-emacsclient): Make it a macro.
+ Handle "Profiling timer expired" return from emacsclient. (Bug#28319)
+ (emacsclient-test-alternate-editor-allows-arguments)
+ (emacsclient-test-alternate-editor-allows-quotes): Update for above.
+
+2017-09-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a minor markup problem in ELisp manual
+
+ * doc/lispref/functions.texi (Mapping Functions): Fix the order of
+ @example and @group. For the details, see
+ https://lists.gnu.org/r/bug-texinfo/2017-09/msg00007.html.
+
+2017-09-06 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add XDG desktop file parsing and tests
+
+ * lisp/xdg.el: Add support for Desktop Entry Specification.
+ (xdg--user-dirs-parse-line): Check if file is readable.
+ (xdg-desktop-group-regexp, xdg-desktop-entry-regexp): New variables.
+ (xdg--desktop-parse-line, xdg-desktop-read-file, xdg-desktop-strings):
+ New functions.
+ * test/lisp/xdg-tests.el:
+ * test/data/xdg/test.desktop:
+ * test/data/xdg/wrong.desktop: New files.
+
+2017-09-06 Glenn Morris <rgm@gnu.org>
+
+ Allow for adjusting line length of test backtraces
+
+ * test/Makefile.in (TEST_BACKTRACE_LINE_LENGTH): New option.
+ (%.log): Respect backtrace line length.
+
+2017-09-06 Glenn Morris <rgm@gnu.org>
+
+ Allow customizing line length of ert backtraces in batch mode
+
+ * lisp/emacs-lisp/ert.el (ert-batch-backtrace-right-margin):
+ Make it a user option.
+ (ert-run-tests-batch): Handle ert-batch-backtrace-right-margin nil.
+
+2017-09-06 Glenn Morris <rgm@gnu.org>
+
+ Minor emacsclient-tests simplification
+
+ * test/lib-src/emacsclient-tests.el (emacsclient-test-emacs):
+ Simplify. Also work when running installed.
+
+2017-09-06 Alan Third <alan@idiocy.org>
+
+ Revert "Force screen update after drawing cursor glyph (bug#23774)"
+
+ This reverts commit 1b492fa5456e2b6face8d0856f11d17e432693b0.
+
+ See bug#28358
+
+2017-09-05 Mark Oteiza <mvoteiza@udel.edu>
+
+ Refactor some loops in mailcap.el
+
+ * lisp/net/mailcap.el (mailcap-mime-types):
+ (mailcap-file-default-commands): Convert nested maps to loops.
+
+2017-09-05 Glenn Morris <rgm@gnu.org>
+
+ emacsclient-tests: remove some debug statements
+
+ * test/lib-src/emacsclient-tests.el
+ (emacsclient-test-call-emacsclient): Remove debug statements.
+
+2017-09-05 Simen Heggestøyl <simenheg@gmail.com>
+
+ Handle non-zero exit status from psql more gracefully
+
+ * lisp/progmodes/sql.el (sql-postgres-list-databases): Handle non-zero
+ exit statuses from `psql -ltX' more gracefully by returning nil.
+
+ * test/lisp/progmodes/sql-tests.el
+ (sql-tests-postgres-list-databases-error): New test.
+
+2017-09-05 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid losing Ctrl-C keystrokes in compilation mode on MS-Windows
+
+ * src/w32proc.c (sys_kill): Preserve the up/down state of the
+ Ctrl key across the simulated Ctrl-C keystroke. (Bug#28348)
+
+2017-09-05 Andreas Schwab <schwab@linux-m68k.org>
+
+ * src/image.c (Fimagemagick_types): Doc fix.
+
+2017-09-05 Mark Oteiza <mvoteiza@udel.edu>
+
+ Move soundex.el test to a proper test
+
+ * test/lisp/soundex-tests.el: New file.
+ * lisp/soundex.el: Use lexical-binding. Remove commented test.
+
+2017-09-05 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add tests for mailcap.el
+
+ * test/data/mailcap/mime.types: New file.
+ * test/lisp/net/mailcap-tests.el: New file.
+
+2017-09-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Doc precisment about remote link targets
+
+ * doc/lispref/files.texi (Truenames): Explain handling of
+ targets of `file-truename' and `make-symbolic-link', which
+ look like a remote file name.
+
+ * etc/NEWS: Precise examples for symlinks which look like
+ remote file names. MUSTBENEW of `write-region' is not
+ propagated to file name handlers.
+
+2017-09-05 John Wiegley <johnw@newartisans.com>
+
+ Remove an opinionated section on "What Eshell is not"
+
+ I don't find this information to accurately reflect possible use cases
+ for Eshell; plus, it doesn't offer much in the way of information,
+ just opinion.
+
+2017-09-05 Ken Brown <kbrown@cornell.edu>
+
+ Fix configure test for Xpm
+
+ Problem reported by Ashish Shukla in
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00020.html.
+ * configure.ac (HAVE_XPM) [HAVE_X11]: Include X11/xpm.h instead of
+ noX/xpm.h in configure test.
+
+2017-09-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revert recent float→double Motif change
+
+ Problem reported by Martin Rudalics in:
+ https://lists.gnu.org/r/emacs-devel/2017-09/msg00014.html
+ * src/xterm.c (xm_scroll_callback, xaw_jump_callback)
+ (x_set_toolkit_scroll_bar_thumb)
+ (x_set_toolkit_horizontal_scroll_bar_thumb):
+ Go back to using ‘float’ temporaries rather than ‘double’.
+ Although quite possibly this masks an underlying bug,
+ we lack time to look into that now.
+
+2017-09-04 Glenn Morris <rgm@gnu.org>
+
+ emacsclient-tests: add some debug statements
+
+ * test/lib-src/emacsclient-tests.el
+ (emacsclient-test-call-emacsclient): Add debug statements.
+
+2017-09-04 Michael Albinus <michael.albinus@gmx.de>
+
+ Work on Tramp's (symbolic) links
+
+ * doc/misc/tramp.texi (Traces and Profiles): Mention the
+ backtrace when tramp-verbose is greater than or equal to 10.
+
+ * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ Use `tramp-handle-add-name-to-file'.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use
+ `tramp-handle-add-name-to-file' and `tramp-handle-file-truename'.
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): Improve.
+
+ * lisp/net/tramp-smb.el (tramp-smb-errors):
+ Add "NT_STATUS_CONNECTION_DISCONNECTED" and
+ "NT_STATUS_OBJECT_PATH_SYNTAX_BAD".
+ (tramp-smb-file-name-handler-alist): Use `tramp-handle-file-truename'.
+ (tramp-smb-do-file-attributes-with-stat): Return non-nil only
+ if one of the attributes is non-nil.
+ (tramp-smb-handle-file-local-copy): Use `file-truename'.
+ (tramp-smb-handle-file-truename): Move to tramp.el.
+ (tramp-smb-handle-insert-directory): Show symlinks.
+ (tramp-smb-handle-make-symbolic-link): Improve.
+ (tramp-smb-read-file-entry): Handle extended file modes in Samba.
+
+ * lisp/net/tramp.el (tramp-handle-add-name-to-file)
+ (tramp-handle-file-truename): New defuns.
+
+ * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Extend test.
+ (tramp--test-check-files): Make check for "smb".
+
+2017-09-04 Mark Oteiza <mvoteiza@udel.edu>
+
+ Embed JSON readtable into json-read
+
+ Also unroll dispatch into a cond.
+ * lisp/json.el (json-readtable): Remove.
+ (json-readtable-dispatch): New macro. Assimilate json-readtable.
+ (json-read): Use the macro.
+
+2017-09-04 Mark Oteiza <mvoteiza@udel.edu>
+
+ Hexify strings in EWW search queries
+
+ Previously, inputting "cats & dogs" would lose dogs because the
+ ampersand signifies a query parameter. Instead, hexify each word while
+ preserving quotes with split-string.
+ * lisp/net/eww.el (eww--dwim-expand-url): Join hexified words together
+ with + separators, instead of replacing whitespace with +.
+
+2017-09-03 Glenn Morris <rgm@gnu.org>
+
+ emacsclient-tests: call-process may return non-integer
+
+ * test/lib-src/emacsclient-tests.el
+ (emacsclient-test-alternate-editor-allows-arguments)
+ (emacsclient-test-alternate-editor-allows-quotes):
+ Handle non-integer return from call-process.
+
+2017-09-03 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/simple.el (visual-line-mode): Doc fix. (Bug#28337)
+
+2017-09-03 Alan Third <alan@idiocy.org>
+
+ Force screen update after drawing cursor glyph (bug#23774)
+
+ * src/nsterm.m (ns_draw_window_cursor): Force a screen update after
+ drawing the glyph over the cursor.
+
+2017-09-03 Alan Mackenzie <acm@muc.de>
+
+ Correct the fontification of quote marks after buffer changes in CC Mode.
+
+ * lisp/progmodes/cc-defs.el
+ (c-search-forward-char-property-with-value-on-char): New macro.
+
+ * lisp/progmodes/cc-mode.el (c-parse-quotes-before-change)
+ (c-parse-quotes-after-change): Rewrite the functions, simplifying
+ considerably, and removing unnecessary optimizations.
+ Invalidate two caches after manipulating text properties.
+
+2017-09-03 Alan Mackenzie <acm@muc.de>
+
+ Fix fontification of "operator~" in C++ Mode.
+
+ * lisp/progmodes/cc-langs.el (c-ambiguous-overloadable-or-identifier-prefices)
+ (c-ambiguous-overloadable-or-identifier-prefix-re): New c-lang-defconsts/vars.
+
+ * lisp/progmodes/cc-engine.el (c-forward-name): Do not try to parse "~" (and
+ two other symbols) as a cast without good evidence. Prefer an overloaded
+ operator in ambiguous cases.
+
+2017-09-03 Martin Rudalics <rudalics@gmx.at>
+
+ In delete_frame do not delete terminal for any toolkit build
+
+ * src/frame.c (delete_frame): Neither delete terminal for
+ non-GTK toolkit builds (Bug#5802, Bug#21509, Bug#23499,
+ Bug#27816).
+
+2017-09-02 Philipp Stephani <phst@google.com>
+
+ Improve error messages for improper plists (Bug#27726)
+
+ * src/fns.c (Fplist_put, Flax_plist_get, Flax_plist_put)
+ (Fplist_member, syms_of_fns): Use ‘plistp’ as pseudo-predicate for
+ improper plists instead of ‘listp.’
+
+ * test/src/fns-tests.el (plist-get/odd-number-of-elements)
+ (lax-plist-get/odd-number-of-elements)
+ (plist-put/odd-number-of-elements)
+ (lax-plist-put/odd-number-of-elements)
+ (plist-member/improper-list): Add unit tests.
+
+2017-09-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix decrypting in plstore.el on MS-Windows
+
+ * lisp/plstore.el (plstore-open): Bind coding-system-for-read to
+ raw-text, instead of using insert-file-contents-literally.
+ (Bug#28114)
+
+2017-09-02 Eli Zaretskii <eliz@gnu.org>
+
+ * src/fileio.c (Fexpand_file_name): Doc fix. (Bug#27982)
+
+2017-09-02 Eli Zaretskii <eliz@gnu.org>
+
+ Rewrite Antinews for Emacs 26
+
+ * doc/lispref/anti.texi (Antinews): Rewrite for Emacs 26.
+ * doc/lispref/elisp.texi (Top): Update the top-level menu's
+ Antinews entry.
+ * doc/emacs/anti.texi (Antinews): Rewrite for Emacs 26.
+ * doc/emacs/emacs.texi (Top): Update the top-level menu's Antinews
+ entry.
+
+ * etc/NEWS: Rearrange some entries in a more reasonable order.
+
+2017-09-02 Reuben Thomas <rrt@sc3d.org>
+
+ Fix a mis-binding in a test
+
+ * test/lisp/progmodes/python-tests.el
+ (python-shell-calculate-process-environment-3): Fix binding of
+ process-environment. A level of parens was missing.
+
+ This was found after Glenn Morris noticed a similar problem with the
+ patch for Bug#28319.
+
+2017-09-02 Reuben Thomas <rrt@sc3d.org>
+
+ Fix a mis-binding and a bad defun name in a test (Bug#28319)
+
+ test/lib-src/emacs-client-tests.el (call-emacsclient): Rename
+ emacsclient-test-call-emacsclient.
+ (emacsclient-test-alternate-editor-allows-arguments)
+ (emacsclient-test-alternate-editor-allows-quotes): Fix let-binding of
+ process-environment.
+
+ Thanks to Glenn Morris for noticing these errors.
+
+2017-09-02 Glenn Morris <rgm@gnu.org>
+
+ * test/Makefile.in (check-no-automated-subdir): Silence by default.
+
+ * test/Makefile.in (ELFILES): Sort, for a reproducible order.
+
+2017-09-01 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn off checkdoc complaint about default argument order
+
+ * etc/NEWS: Mention change.
+ * lisp/emacs-lisp/checkdoc.el (checkdoc-arguments-in-order-flag):
+ Disable by default, note version.
+
+2017-09-01 Reuben Thomas <rrt@sc3d.org>
+
+ Stop emacsclient tests hanging (Bug#28319)
+
+ * test/lib-src/emacsclient-tests.el
+ (emacsclient-test-alternate-editor-allows-arguments): Use a
+ non-existent file to communicate with server, so that any existing
+ default server will not be hijacked (in fact, the test does
+ not need a server).
+ (emacsclient-test-alternate-editor-allows-quotes): Likewise.
+
+2017-09-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/obsolete/html2text.el: Don't require CL
+
+ (html2text-clean-anchor): Mark unused arg.
+
+2017-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Don't remove undisplayers from inlined MIME parts (bugfix)
+
+ * lisp/gnus/gnus-art.el (gnus-mime-buttonize-attachments-in-header):
+ Don't remove undisplayers from inlined MIME parts (bugfix);
+ Simplify criterion that finds attachments.
+
+2017-08-31 Mark Oteiza <mvoteiza@udel.edu>
+
+ Make ucs-names a hash table (Bug#28302)
+
+ * etc/NEWS: Mention the type change.
+ * lisp/descr-text.el (describe-char): Use gethash to access ucs-names.
+ Hardcode BEL's name into the function instead of needlessly mapping
+ over the hash table in the spirit of rassoc.
+ * lisp/international/mule-cmds.el (ucs-names): Fix variable and
+ function docstrings. Initialize a hash table for ucs-names--the
+ number of entries is 42845 here. Switch to hash-table
+ getters/setters.
+ (mule--ucs-names-annotation): Use hash-table getter.
+ (char-from-name): Upcase the string if ignore-case is truthy.
+ * lisp/leim/quail/latin-ltx.el: Use maphash instead of dolist.
+
+2017-08-31 Alan Third <alan@idiocy.org>
+
+ Remove unneeded version checks (bug#28222)
+
+ * src/macfont.h (CGContextSetFontSmoothingStyle): Remove version
+ check.
+ * src/macfont.m (macfont_draw): Remove version check, and test for
+ existence of CGContextSetFontSmoothingStyle.
+
+2017-08-31 Alan Mackenzie <acm@muc.de>
+
+ Fix a glitch in CC Mode's syntactic whitespace cache.
+
+ * lisp/progmodes/cc-engine.el (c-forward-sws): Deal correctly with a block
+ comment close at the end of a macro.
+
+2017-08-31 Alan Mackenzie <acm@muc.de>
+
+ Correct the fontification of C++ Mode enclosed declarations.
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-enclosing-decls): abolish the
+ spurious check that the character before the start of an enclosed declaration
+ must be ; or }. It might also be {.
+
+2017-08-31 Martin Rudalics <rudalics@gmx.at>
+
+ In xterm.c fix some recently introduced compiler warnings
+
+ * src/xterm.c (xaw_jump_callback)
+ (x_set_toolkit_scroll_bar_thumb): Fix some recently introduced
+ -Wdouble-promotion warnings.
+
+2017-08-31 Martin Rudalics <rudalics@gmx.at>
+
+ Restrict fix of Bug#24963 and Bug#25887 to GTK builds
+
+ * src/xterm.c (handle_one_xevent): Restrict earlier fix of
+ Bug#24963 and Bug#25887 to avoid that a non-GTK Emacs won't
+ react to state changes received via ConfigureNotify.
+
+2017-08-31 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Respect directory a user enters (bug#28299)
+
+ * lisp/gnus/mm-decode.el (mm-save-part):
+ Respect directory a user enters (bug#28299).
+
+2017-08-31 Samuel Freilich <sfreilich@google.com>
+
+ Do not split line before width of fill-prefix
+
+ When auto-filling a paragraph, don't split a line before the width of the
+ fill-prefix, creating a subsequent line that is as long or longer (Bug#20774).
+ * lisp/simple.el (do-auto-fill): Only consider break-points that are later in
+ the line than the width of the fill-prefix. This is a more general solution
+ than the previous logic, which only skipped over the exact fill-prefix. The
+ fill-prefix doesn't necessarily match the prefix of the first line of a
+ paragraph in adaptive-fill-mode.
+
+2017-08-31 Noam Postavsky <npostavs@gmail.com>
+
+ Support lazy loading for autogenerated usage docstrings too (Bug#27748)
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble):
+ Consider any documentation that ended up in code as a docstring (e.g.,
+ autogenerated (fn ARG1 ARG2) type things), not just what the user
+ passed.
+
+2017-08-31 Noam Postavsky <npostavs@gmail.com>
+
+ Drop docstrings from cl-defsubst produced inline bodies (Bug#27748)
+
+ * lisp/emacs-lisp/cl-macs.el (cl-defsubst): Use macroexp-parse-progn
+ to drop the docstring. Add a simple docstring to the compiler-macro.
+
+2017-08-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Quote file-truename symlink to "../foo:bar:"
+
+ Problem reported by Michael Albinus (Bug#28264#19).
+ * lisp/files.el (files--splice-dirname-file): Fix bug where
+ a relative symlink to "../foo:bar:" did not quote the result.
+
+2017-08-30 Reuben Thomas <rrt@sc3d.org>
+
+ Add support for arguments in emacsclient's ALTERNATE_EDITOR (Bug #25082)
+
+ * lib-src/emacsclient.c (fail): Parse ALTERNATE_EDITOR, or
+ corresponding command-line argument, into quote- or space-separated
+ tokens. If a token starts with a quote, then it naturally is expected
+ to end with a quote; escaping is not supported. This is enough to cope
+ with the typical case of requiring the initial path to be quoted,
+ common on Windows where it may contain spaces.
+ * etc/NEWS: Document.
+ * doc/emacs/misc.texi: Likewise.
+ * doc/man/emacsclient.1: Tweak to remove the implication that only an
+ editor can be specified (the manual already mentions a “command”).
+ Fix a small error where “EDITOR” is referred to rather than
+ “ALTERNATE_EDITOR”.
+ * test/lib-src/emacsclient-tests.el: Add tests.
+
+2017-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/man.el (Man-softhyphen-to-minus): Avoid string-as-multibyte.
+
+2017-08-30 Devon Sean McCullough <Emacs-Hacker2017@jovi.net> (tiny change)
+
+ Correct "hide others" shortcut on macOS (bug#28215)
+
+ * lisp/term/ns-win.el: Fix shortcut for ns-do-hide-others.
+
+2017-08-30 Eli Zaretskii <eliz@gnu.org>
+
+ Sync NEWS with the documentation
+
+ * etc/NEWS: Mark entries according to documentation.
+
+ * doc/lispref/functions.texi (Mapping Functions): Document 'mapcan'.
+
+2017-08-30 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve symlinks for Tramp
+
+ * lisp/files.el (files--splice-dirname-file): Quote whole file.
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link):
+ Do not expand TARGET, it could be remote.
+ (tramp-sh-handle-file-truename): Check for cyclic symlink also
+ in case of readlink. Quote result if it looks remote.
+ (tramp-sh-handle-file-local-copy): Use `file-truename'.
+
+ * test/lisp/net/tramp-tests.el (tramp-test08-file-local-copy)
+ (tramp-test09-insert-file-contents): Test also file missing.
+ (tramp-test21-file-links): Extend test.
+
+2017-08-30 Martin Rudalics <rudalics@gmx.at>
+
+ Preserve display's foreground color when clearing internal borders (Bug#28278)
+
+ * src/xterm.c (x_after_update_window_line): Preserve display's
+ foreground color when clearing internal borders (Bug#28278).
+
+2017-08-30 Noam Postavsky <npostavs@gmail.com>
+
+ Use cl-print for all values printed by `describe-variable'
+
+ * lisp/help-fns.el (describe-variable): Use cl-prin1 for original and
+ global values too.
+
+2017-08-30 Noam Postavsky <npostavs@gmail.com>
+
+ Minor simplification for byte-compile-constant-push
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-constant): Move the meat
+ of the code from here...
+ (byte-compile-constant-push): ... to here. No need to bind
+ byte-compile--for-effect anymore.
+
+2017-08-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer file-name-quote to concat "/:"
+
+ Suggested by Michael Albinus (Bug#28264#13).
+ * lisp/files.el (files--splice-dirname-file): Use file-name-quote
+ rather than attempting to do it by hand.
+
+2017-08-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac: fix typo in previous change
+
+2017-08-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Be more conservative in link time optimization doc
+
+ While testing --enable-link-time-optimization with GCC 7.1.1
+ I ran into a serious GCC code-generation bug which makes me
+ think that --enable-link-time-optimization should be
+ discouraged for typical installs (Bug#28213). See:
+ https://bugzilla.redhat.com/show_bug.cgi?id=1486455
+
+2017-08-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make garbage collection more conservative
+
+ Check for a pointer anywhere within the object, as opposed to just
+ the start of the object. This is needed for gcc -Os -flto on
+ x86-64 (Bug#28213). This change means that the garbage collector
+ is more conservative, and will incorrectly keep objects that it
+ does not need to, but that is better than incorrectly discarding
+ objects that should be kept.
+ * src/alloc.c (ADVANCE, VINDEX): Now functions, not macros;
+ this is easier to debug.
+ (setup_on_free_list): Rename from SETUP_ON_FREE_LIST.
+ Now a function with two args, not a macro with three.
+ All callers changed.
+ (live_string_holding, live_cons_holding, live_symbol_holding)
+ (live_misc_holding, live_vector_holding, live_buffer_holding):
+ New functions, which check for any object containing the addressed
+ byte, not just for an object at the given address.
+ (live_string_p, live_cons_p, live_symbol_p, live_misc_p)
+ (live_vector_p, live_buffer_p):
+ Redefine in terms of the new functions.
+ (live_float_p): Refactor slightly to match the new functions.
+ (mark_maybe_object, mark_maybe_pointer): Use the new functions.
+ Don’t bother checking mark bits, as mark_object already does that,
+ and omitting the checks here simplifies the code. Although
+ mark_maybe_object can continue to insist that tagged pointers
+ still address the start of the object, mark_maybe_pointer now is
+ more conservative and checks for pointers anywhere into an object.
+
+2017-08-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve stack-top heuristic
+
+ This is needed for gcc -Os -flto on x86-64; otherwise, GC misses part
+ of the stack when scanning for heap roots, causing Emacs to crash
+ later (Bug#28213). The problem is that Emacs's hack for getting an
+ address near the stack top does not work when link-time optimization
+ moves stack variables around.
+ * configure.ac (HAVE___BUILTIN_FRAME_ADDRESS): New macro.
+ * lib-src/make-docfile.c (DEFUN_noinline): New constant.
+ (write_globals, scan_c_stream): Support noinline.
+ * src/alloc.c (NEAR_STACK_TOP): New macro.
+ (SET_STACK_TOP_ADDRESS): Use it.
+ (flush_stack_call_func, Fgarbage_collect): Now noinline.
+
+2017-08-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Align stack bottom properly.
+
+ This is needed for gcc -Os -flto on x86-64 (Bug#28213).
+ * src/emacs.c (main): Align stack-bottom variable as a pointer,
+ since mark_memory requires this.
+
+2017-08-29 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid spinning waiting for git-gui.exe on Windows
+
+ * src/w32proc.c (waitpid): If GetExitCodeProcess returns
+ STILL_ACTIVE, and we were called with WNOHANG, pretend that the
+ process exited. (Bug#28268)
+
+2017-08-29 Eli Zaretskii <eliz@gnu.org>
+
+ Document '--module-assertions'
+
+ * doc/emacs/cmdargs.texi (Initial Options): Document the
+ '--module-assertions' command-line option.
+ * doc/lispref/loading.texi (Dynamic Modules): Add a
+ cross-reference to the description of '--module-assertions'.
+
+ * etc/NEWS: Update the NEWS entry for --module-assertions.
+
+2017-08-29 Alan Third <alan@idiocy.org>
+
+ Add news entry about new macOS features
+
+ * etc/NEWS: Add entry about ns-appearance, ns-transparent-titlebar and
+ ns-use-thin-smoothing.
+
+2017-08-29 Alan Third <alan@idiocy.org>
+
+ Fix cross macOS version building (bug#28222)
+
+ * src/macfont.h (CGContextSetFontSmoothingStyle): Function
+ declaration.
+ * src/macfont.m (macfont_draw): Limit new code to macOS 10.8 and up.
+
+2017-08-29 Ben Bonfil <bonfil@gmail.com> (tiny change)
+
+ Enable thin font smoothing in macOS (bug#28222)
+
+ * src/nsterm.m (syms_of_nsterm): Define var ns-use-thin-smoothing.
+ * src/macfont.m (macfont_draw): Use font smoothing.
+
+2017-08-29 Eli Zaretskii <eliz@gnu.org>
+
+ Minor improvement in documentation of display-line-numbers
+
+ * doc/emacs/display.texi (Display Custom): Document the
+ display-line-numbers-mode and related options.
+
+2017-08-29 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid aborting in 'waitpid' on MS-Windows
+
+ * src/w32proc.c (waitpid): Don't allow quitting if called with
+ WNOHANG in OPTIONS. (Bug#28268)
+
+2017-08-29 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/sh-script.el: Test "in-string" of the right char!
+
+ (sh-syntax-propertize-function): Fix off-by-one error.
+ Fixes bug#23526.
+
+2017-08-29 Rasmus <rasmus@gmx.us>
+
+ Update Org to v9.0.10
+
+ Please see etc/ORG-NEWS for major changes. Note, this is a bugfix
+ release.
+
+2017-08-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Silence false alarms for symlinks to sources
+
+ Problem reported by Glenn Morris (Bug#28264).
+ * lisp/files.el (files--splice-dirname-file): New function.
+ (file-truename, file-chase-links): Use it.
+
+2017-08-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify remove_slash_colon
+
+ * src/process.c (remove_slash_colon): Simplify
+ and avoid a special case for "/:" by itself.
+
+2017-08-28 Tassilo Horn <tsdh@gnu.org>
+
+ Remove font family from minibuffer-prompt face
+
+ * etc/themes/tsdh-light-theme.el (tsdh-light): Remove font family from
+ minibuffer-prompt face.
+
+2017-08-28 Michael Albinus <michael.albinus@gmx.de>
+
+ Further fixes in tramp-smb.el
+
+ * lisp/net/tramp-smb.el (tramp-smb-handle-file-truename): New defun.
+ (tramp-smb-file-name-handler-alist): Use it.
+ (tramp-smb-handle-make-symbolic-link): Unquote target.
+
+ * test/lisp/net/tramp-tests.el
+ (tramp--test-ignore-make-symbolic-link-error): New defmacro.
+ (tramp-test18-file-attributes, tramp-test21-file-links)
+ (tramp--test-check-files): Use it.
+
+2017-08-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t assume -g3 in .gdbinit
+
+ * src/.gdbinit (EMACS_INT_WIDTH, USE_LSB_TAG):
+ Use reasonable defaults if not in the symbol table.
+
+2017-08-28 Robert Pluim <rpluim@gmail.com> (tiny change)
+
+ Use string-match to check for dotfiles in ido
+
+ * lisp/ido.el (ido-make-file-list): Use string-match to check
+ for dotfiles instead of substring, as when using tramp
+ simplified syntax ido-temp-list may contain empty strings.
+
+2017-08-28 Mark Oteiza <mvoteiza@udel.edu>
+
+ Font-lock FDO desktop files correctly
+
+ Single and double quotes do not have a special meaning in
+ desktop files.
+ https://standards.freedesktop.org/desktop-entry-spec/latest/
+ * etc/NEWS: Mention new mode.
+ * lisp/files.el (auto-mode-alist): Split out an entry for handling
+ the .desktop extension with conf-desktop-mode.
+ * lisp/textmodes/conf-mode.el (conf-desktop-font-lock-keywords): New
+ variable with rules for booleans and format specifiers.
+ (conf-unix-mode): Remove desktop file entry example from docstring.
+ (conf-desktop-mode): New derived major mode.
+
+2017-08-27 Tom Tromey <tom@tromey.com>
+
+ Fix auto-fill bug in js-mode
+
+ * lisp/progmodes/js.el (js-do-auto-fill): New function.
+ (js-mode): Set normal-auto-fill-function.
+ * test/lisp/progmodes/js-tests.el (js-mode-fill-comment-bug): New
+ test.
+
+2017-08-27 Noam Postavsky <npostavs@gmail.com>
+
+ Disable completion while entering python multiline statements
+
+ The "legacy" completion mechanism sends newlines to the running python
+ process to get the list of completions, which confuses things if the
+ user is in the middle of entering a multiline statement (Bug#28051).
+ It's better to disable completion in this case.
+ * lisp/progmodes/python.el (python-shell--block-prompt): New variable.
+ (python-shell-prompt-set-calculated-regexps): Set it.
+ (python-shell-completion-at-point): Return 'ignore' as the completion
+ function when the current prompt is a block prompt.
+
+2017-08-27 Michael Albinus <michael.albinus@gmx.de>
+
+ Tramp cleanup
+
+ * lisp/net/tramp-sh.el (tramp-sh-extra-args): Remove compat code.
+ (tramp-sh-handle-make-symbolic-link): More robust check for
+ TARGET remoteness.
+
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory):
+ Disable copying by tar temporarily, it doesn't work reliably.
+ (tramp-smb-do-file-attributes-with-stat): Resolve symlink.
+ (tramp-smb-handle-make-symbolic-link): Fix implementation.
+
+ * lisp/net/tramp.el (tramp-handle-file-symlink-p): Simplify.
+
+ * test/lisp/net/tramp-tests.el (tramp-test21-file-links):
+ Extend test.
+
+2017-08-27 Glenn Morris <rgm@gnu.org>
+
+ Fix previous xterm.h change for non-gtk builds
+
+ * src/xterm.h (GTK_CHECK_VERSION) [!USE_GTK]: Define it.
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ Fix GdkSettings-related deprecation warnings
+
+ * src/gtkutil.c (xg_initialize): Don’t set deprecated and ignored
+ gtk-menu-bar-accel setting in new versions of GTK+. Use g_object_set
+ instead of deprecated gtk_settngs_set_string_property otherwise.
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ Always use gtk_window_move in new versions
+
+ * src/gtkutil.c (my_log_handler): Don’t define in new versions of
+ GTK+.
+ (xg_set_geometry): Always use gtk_window_move in new versions of GTK+.
+
+ * src/xterm.c (syms_of_xterm): Document that x-gtk-use-window-move
+ is ignored.
+
+ * lisp/subr.el (x-gtk-use-window-move): Make obsolete.
+
+2017-08-27 Charles A. Roelli <charles@aurox.ch>
+
+ Fix 'diff-goto-source' when buffer is narrowed (Bug#21262)
+
+ * lisp/vc/diff-mode.el (diff-find-file-name): Save the current
+ narrowing, and widen the buffer before searching for the name of the
+ file corresponding to the diff.
+
+ With thanks to Noam Postavsky.
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ Remove use of a deprecated GTK+ function in new versions
+
+ * src/gtkutil.c (xg_make_tool_item): Use gtk_widget_set_focus_on_click
+ if available
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ Stop using deprecated GdkScreen monitor functions in newer GDK
+
+ * src/xfns.c (Fx_display_monitor_attributes_list): Use GdkMonitor
+ objects instead of the deprecated GdkScreen functions in GDK 3.22+
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ Use GdkSeat in new GDK versions
+
+ * src/gtkutil.c (xg_event_is_for_scrollbar): Use GdkSeat instead of
+ GdkDeviceManager in GDK 3.20+
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ * src/xterm.c (XTflash): Don’t use gdk_cairo_create in GDK 3.22+
+
+2017-08-27 Philipp Stephani <phst@google.com>
+
+ Remove call of deprecated GDK function
+
+ * src/xterm.h (XSync): Don’t call gdk_window_process_all_updates in
+ GDK 3.22 or later.
+
+2017-08-27 Alan Mackenzie <acm@muc.de>
+
+ Amend the CC Mode macro cache to cope with changes at the macro start
+
+ Fixes bug #28233.
+
+ * lisp/progmodes/cc-engine.el (c-invalidate-macro-cache): Fix an off-by-1
+ error.
+
+2017-08-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix over-protection of byte-compiled files
+
+ Problem reported by Sven Joachim (Bug#28244).
+ Also, fix similar problem for autoload files.
+ * lisp/emacs-lisp/autoload.el (autoload--save-buffer):
+ Set temp file modes to the buffer-file-name file modes (or 666
+ if not available) as adjusted by umask.
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-file):
+ Set temp file modes to 666 as adjusted by umask.
+
+2017-08-27 Tom Tromey <tom@tromey.com>
+
+ Refine conf-toml-mode font-lock
+
+ Bug#28218
+ * lisp/textmodes/conf-mode.el (conf-toml-font-lock-keywords): Use
+ conf-toml-recognize-section. Use \s- in variable regexp.
+ (conf-toml-recognize-section): New function.
+
+2017-08-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not munge contents of local symbolic links
+
+ This lets Emacs deal with arbitrary local symlinks without
+ mishandling their contents (Bug#28156). For example,
+ (progn (shell-command "ln -fs '~' 'x'") (rename-file "x" "/tmp/x"))
+ now consistently creates a symbolic link from '/tmp/x' to '~'.
+ Formerly, it did that only if the working directory was on the
+ same filesystem as /tmp; otherwise, it expanded the '~' to
+ the user's home directory.
+ * lisp/dired.el (dired-get-filename): Use files--name-absolute-system-p
+ instead of rolling our own code.
+ * lisp/files.el (files--name-absolute-system-p): New function.
+ (file-truename, file-chase-links): Use it to avoid mishandling
+ symlink contents that begin with ~.
+ (copy-directory, move-file-to-trash):
+ Use concat rather than expand-file-name, to avoid mishandling
+ symlink contents that begin with ~.
+ * src/fileio.c (Fmake_symbolic_link): Do not expand leading "~" in the
+ target unless interactive. Strip leading "/:" if interactive.
+ (emacs_readlinkat): Do not prepend "/:" to the link target if
+ it starts with "/" and contains ":" before NUL.
+ * test/src/fileio-tests.el (try-link): Rename from try-char,
+ and accept a string instead of a char. All uses changed.
+ (fileio-tests--symlink-failure): Also test leading ~, and "/:",
+ to test the new behavior.
+
+2017-08-27 Reuben Thomas <rrt@sc3d.org>
+
+ Remove invalid regexp for shell builtins for wksh
+
+ * lisp/progmodes/sh-script.el (sh-builtins): Shell built-ins have to
+ be literal strings, so remove a regexp for wksh. In any case, it’s a
+ defunct proprietary shell.
+
+2017-08-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve doc for file-name-absolute-p.
+
+2017-08-26 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Tramp part of Bug#28156
+
+ * lisp/files.el (file-name-non-special): Use `file-name-quote'
+ instead prefixing "/:", the file could already be quoted.
+
+ * lisp/net/tramp.el (tramp-error): Handle null arguments.
+ (tramp-handle-make-symbolic-link):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link)
+ (tramp-sh-handle-add-name-to-file):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-add-name-to-file)
+ (tramp-smb-handle-make-symbolic-link): Adapt implementation to
+ stronger semantics in Emacs. (Bug#28156)
+
+ * test/lisp/net/tramp-tests.el (tramp-test21-file-links):
+ Extend test.
+
+2017-08-26 Eli Zaretskii <eliz@gnu.org>
+
+ Fix bugs merged with bug#25428
+
+ * lisp/simple.el (auto-fill-mode, visual-line-mode): Doc fix.
+ (Bug#13926) (Bug#25434) (Bug#25435)
+
+2017-08-26 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of Info virtual files and nodes
+
+ * lisp/info.el (Info-virtual-files, Info-virtual-nodes): Doc fix.
+ (Bug#28237)
+
+2017-08-26 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/delsel.el (delete-selection-mode): Doc fix. (Bug#25428)
+
+2017-08-26 Grégory Mounié <Gregory.Mounie@imag.fr> (tiny change)
+
+ Support multi-lingual detection of SEE ALSO man sections
+
+ * lisp/man.el (Man-see-also-regexp): Add support for SEE ALSO
+ section detection in several langages: French, German, Spanish,
+ Portugese, Italian, Polish, Turkish, Japanese, Chinese. (Bug#28142)
+
+2017-08-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve expand-file-name doc
+
+ * doc/lispref/files.texi (Relative File Names, Directory Names)
+ (File Name Expansion):
+ * doc/lispref/minibuf.texi (Reading File Names):
+ Document expand-file-name behavior with ~ more clearly
+ and accurately.
+ * doc/misc/org.texi (Batch execution): Simplify example
+ script so that it does not need expand-file-name and thus
+ will not mishandle file names with leading ~.
+
+2017-08-26 Jefferson Carpenter <jeffersoncarpenter2@gmail.com> (tiny change)
+
+ Support all perl variable declarators and prefixes (Bug#27613)
+
+ * lisp/progmodes/perl-mode.el (perl-imenu-generic-expression)
+ (perl-font-lock-keywords-2): Match declators 'anon', 'argument', 'has',
+ 'local', 'state', 'supersede', 'let', and 'temp'.
+
+2017-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix file-attributes race on GNU hosts
+
+ * doc/lispref/files.texi (File Attributes):
+ Document file-attributes atomicity.
+ * etc/NEWS: Document the fix.
+ * src/dired.c (file_attributes): New args DIRNAME and FILENAME,
+ for diagnostics. All callers changed. On platforms like
+ GNU/Linux that support O_PATH, fix a race condition in
+ file-attributes and similar functions, so that these functions do
+ not return nonsense if a directory entry is replaced while getting
+ its attributes. On non-GNU platforms, do a better (though not
+ perfect) job of detecting the race, and return nil if detected.
+
+2017-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify expand_and_dir_to_file
+
+ * src/fileio.c (expand_and_dir_to_file): Simplify by omitting 2nd
+ argument, since in practice it always has the default value. All
+ callers changed. Prefer C99 style decls in nearby code.
+
+2017-08-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix file-name completion on network shares
+
+ * src/w32.c (faccessat): Don't assume that F_OK is non-zero.
+ (Bug#28207)
+
+2017-08-25 Reuben Thomas <rrt@sc3d.org>
+
+ Fix a FIXME with an exegetical comment
+
+ * lisp/progmodes/sh-script.el (sh-builtins): Explain why we have a
+ regexp for wksh builtins.
+
+2017-08-25 Reuben Thomas <rrt@sc3d.org>
+
+ Minor docstring language fix
+
+ * lisp/progmodes/sh-script.el (sh-show-indent): Remove spurious “the”.
+
+2017-08-25 Reuben Thomas <rrt@sc3d.org>
+
+ Remove old commented code from sh-script.el
+
+ * lisp/progmodes/sh-script.el (sh-abbrevs): Remove commented function
+ and variable, commented since 2001.
+
+2017-08-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/package.el: Don't let failure stop us
+
+ (package-activate-1): Don't throw an error for missing deps.
+ (package-unpack): Don't bother compiling if activation failed.
+ (package-initialize): Report failures but keep activating other packages.
+
+2017-08-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Prefer ‘double’ for FP temps in xterm.c
+
+ * src/xterm.c (xm_scroll_callback, xaw_jump_callback)
+ (x_set_toolkit_scroll_bar_thumb)
+ (x_set_toolkit_horizontal_scroll_bar_thumb): Prefer ‘double’ to
+ ‘float’ for individual local floating-point temporaries.
+
+2017-08-24 Reuben Thomas <rrt@sc3d.org>
+
+ Avoid using string-to-multibyte in ispell.el
+
+ * lisp/textmodes/ispell.el (ispell-get-decoded-string): Use
+ decode-coding-string instead. Note that decode-coding-string returns a
+ string that satisfies multibyte-string-p even if its input is pure
+ ASCII and the third argument is t, so the result of
+ ispell-get-decoded-string is always a multibyte string.
+
+2017-08-24 Tino Calancha <tino.calancha@gmail.com>
+
+ Store the regexp just when there are matches
+
+ * lisp/hi-lock.el (hi-lock-set-pattern): When font-lock-mode is
+ disabled and there are no matches do not store REGEXP
+ in hi-lock-interactive-patterns.
+
+2017-08-24 Tino Calancha <tino.calancha@gmail.com>
+
+ Keep face available if there are no matches
+
+ If font-lock-mode is disabled in the current buffer, and
+ there are no matches for REGEXP, then keep FACE available
+ for a next search.
+ * lisp/hi-lock.el (hi-lock-set-pattern): Add FACE into
+ hi-lock--unused-faces if font-lock-mode is disabled and
+ there are no matches.
+ * test/lisp/hi-lock-tests.el (hi-lock-test-set-pattern): Add test.
+
+2017-08-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor improvements for tramp-interrupt-process, documentation
+
+ * doc/lispref/processes.texi (Signals to Processes):
+ * etc/NEWS: Document interrupt-process-functions.
+
+ * lisp/net/tramp.el (tramp-interrupt-process): Test also for
+ `process-live-p'.
+
+ * src/process.c (Vinterrupt_process_functions): Fix docstring.
+
+ * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process):
+ Extend test.
+
+2017-08-24 Reuben Thomas <rrt@sc3d.org>
+
+ Fix a comment whitespace typo.
+
+ src/fileio.c: A double space was added after "..", used in a code
+ example. Make it a single space.
+
+2017-08-24 Reuben Thomas <rrt@sc3d.org>
+
+ Remove old commented code and obsolete comments
+
+ * lisp/files.el (locate-dominating-files): Remove old commented
+ implementation from 9 years ago. Since the current version
+ appears (at least to me) not just more efficient but clearer than the
+ version removed, also delete a comment in the new version referring to
+ the old version. Remove old commented heuristic code,
+ and explanatory comments.
+
+2017-08-24 Reuben Thomas <rrt@sc3d.org>
+
+ Remove old duplicate commented code
+
+ * lisp/files.el (file-relative-name): Remove old commented version,
+ replaced 14 years ago in commit 753ad9889.
+
+2017-08-24 Tom Tromey <tom@tromey.com>
+
+ Add conf-toml-mode
+
+ * etc/NEWS: Mention conf-toml-mode.
+ * lisp/files.el (auto-mode-alist): Add entry for .toml.
+ * lisp/textmodes/conf-mode.el (conf-toml-mode-syntax-table)
+ (conf-toml-font-lock-keywords): New defvars.
+ (conf-toml-mode): New mode.
+
+2017-08-23 Alan Third <alan@idiocy.org>
+
+ Use lisp type in log message (bug#28176)
+
+ * src/nsimage.m (ns_load_image): Use make_number on index.
+
+2017-08-23 Alan Third <alan@idiocy.org>
+
+ Fix PNGs on macOS (bug#28176)
+
+ * src/nsimage.m (ns_load_image): Remove index check.
+ (EmacsImage::getAnimatedBitmapImageRep): New function.
+ (EmacsImage::getMetadata): Use getAnimatedBitmapImageRep.
+ (EmacsImage::setFrame): Use getAnimatedBitmapImageRep and check index
+ is valid.
+
+2017-08-23 Alan Third <alan@idiocy.org>
+
+ Add ability to change macOS WM theme (bug#27973)
+
+ * src/frame.c (make_frame, frame_parms, syms_of_frame)
+ [NS_IMPL_COCOA]: Add ns-appearance and ns-transparent-titlebar
+ options.
+ * src/frame.h (ns_appearance_type) [NS_IMPL_COCOA]: Add enum to
+ represent NSAppearance options.
+ (struct frame) [NS_IMPL_COCOA]: Add ns_appearance and
+ ns_transparent_titlebar frame parameters.
+ * src/nsfns.m (ns_frame_parm_handlers) [NS_IMPL_COCOA]: Add
+ ns_set_appearance and ns_set_transparent_titlebar handlers.
+ (Sx_create_frame): Handle ns-appearance and ns-transparent-titlebar
+ frame parameters.
+ (Qdark): Add new symbol for use with ns-appearance.
+ * src/nsterm.h (ns_set_appearance, ns_set_transparent_titlebar)
+ [NS_IMPL_COCOA]: Add prototypes.
+ * src/nsterm.m (ns_set_appearance, ns_set_transparent_titlebar)
+ [NS_IMPL_COCOA]: New functions.
+ (initFrameFromEmacs) [NS_IMPL_COCOA]: Handle ns-appearance and
+ ns-transparent-titlebar frame parameters.
+ * doc/lispref/frames.texi (Window Management Parameters): Document
+ ns-apperance and ns-transparent-titlebar.
+
+2017-08-22 Alan Mackenzie <acm@muc.de>
+
+ When looking for the end of a declarator, prevent macros fouling up the search
+
+ The practical implication of this bug was a random jit-lock chunk remaining
+ entirely unfontified.
+
+ * lisp/progmodes/cc-mode.el (c-fl-decl-end): If point starts inside a macro,
+ restrict two forward searches to the end of that macro.
+
+2017-08-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Test `file-expand-wildcards' for Tramp
+
+ * lisp/net/tramp-compat.el (tramp-advice-file-expand-wildcards):
+ Remove, not needed anymore.
+
+ * test/lisp/net/tramp-tests.el (top): Require seq.el.
+ (tramp-test16-directory-files): Simplify.
+ (tramp-test16-file-expand-wildcards): New test.
+ (tramp-test28-interrupt-process): Skip for older Emacsen.
+
+2017-08-22 Alexander Gramiak <agrambot@gmail.com>
+
+ Add tests for cl-macs.el (Bug#27559)
+
+ * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-test-loop): Remove
+ duplicate.
+ (cl-loop-destructuring-with): Move to cl-macs-tests.el.
+ * test/lisp/emacs-lisp/cl-macs-tests.el: New file.
+
+2017-08-22 Noam Postavsky <npostavs@gmail.com>
+
+ Optimize skkdic conversion (Bug#28043)
+
+ The primary speedup comes from the optimizing lookup-nested-alist and
+ set-nested-alist for the case where the key is a string. This brings
+ the time down to less than half the original.
+
+ * lisp/international/mule-util.el (lookup-nested-alist)
+ (set-nested-alist): Use `assq' instead of `assoc' when KEYSEQ is a
+ string.
+
+ * lisp/international/ja-dic-cnv.el (skkdic-collect-okuri-nasi)
+ (skkdic-convert-okuri-nasi): Use progress-reporter functions instead
+ of calculating ratio of work done inline.
+
+ (skkdic-reduced-candidates): Call `char-category-set' on the first
+ character of the string directly, instead of using a regexp for the
+ character category.
+ (skkdic--japanese-category-set): New constant.
+ (skkdic-collect-okuri-nasi): Just set
+ `skkdic-okuri-nasi-entries-count' at once at the end rather than
+ updating it throughout the loop.
+
+ (skkdic-convert-postfix skkdic-convert-prefix)
+ skkdic-get-candidate-list, skkdic-collect-okuri-nasi)
+ (skkdic-extract-conversion-data): Use `match-string-no-properties'
+ instead of `match-string'.
+
+2017-08-22 Reuben Thomas <rrt@sc3d.org>
+
+ Treat tests in lib-src like tests in src
+
+ * test/Makefile.in (test_template): Depend on a .c source file for a
+ test under lib-src, as for src. (Thanks, Glenn Morris for pointing me
+ in the right direction.)
+
+2017-08-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port /bin/sh scripts to Solaris 10
+
+ Its /bin/sh builtin ‘test’ command does not support -e.
+ * autogen.sh, build-aux/git-hooks/pre-commit:
+ * build-aux/gitlog-to-emacslog, make-dist:
+ Use test -r, not test -e.
+
+2017-08-21 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid losing the buffer restriction in flyspell-mode
+
+ * src/intervals.c (get_local_map): Don't allow C-g to quit as long
+ as we have the buffer widened, to make sure the restriction is
+ preserved. (Bug#28161)
+
+2017-08-21 Sven Joachim <svenjoac@gmx.de>
+
+ Fix the 'versionclean' target in src/Makefile
+
+ * src/Makefile.in (versionclean): Don't accidentally remove
+ emacs-module.h. (Bug#28169)
+
+2017-08-21 Michael Albinus <michael.albinus@gmx.de>
+
+ Implement `interrupt-process-functions'
+
+ * lisp/net/tramp.el (tramp-interrupt-process): Rename from
+ `tramp-advice-interrupt-process'. Adapt according to changed API.
+ (top): Add it to `interrupt-process-functions'.
+
+ * src/process.c (Finternal_default_interrupt_process): New defun.
+ (Finterrupt_process): Change implementation, based on
+ Vinterrupt_process_functions.
+ (Vinterrupt_process_functions): New defvar.
+
+ * test/lisp/net/tramp-tests.el (tramp-test40-unload): Do not
+ test removal of advice.
+
+2017-08-21 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid floating-point exceptions while drawing underwave
+
+ * src/w32term.c (x_get_scale_factor):
+ * src/xterm.c (x_get_scale_factor): Don't let the scale factors
+ become less than 1. Reported by Yuri D'Elia <wavexx@thregr.org> in
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00459.html.
+
+2017-08-21 Sam Steingold <sds@gnu.org>
+
+ mark flymake-mode as safe local variable when the value is nil
+
+2017-08-21 Sam Steingold <sds@gnu.org>
+
+ allow nil init in flymake-allowed-file-name-masks to disable flymake
+
+ (flymake-allowed-file-name-masks): Update doc and :type.
+ (flymake-get-file-name-mode-and-masks): Handle nil init.
+
+2017-08-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ Remove the workaround for bug#20719
+
+ * lisp/cedet/semantic/symref/grep.el
+ (semantic-symref-grep-use-template): Remove the workaround for
+ bug#20719, it's been fixed for a while now.
+
+2017-08-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix byte-compilation warnings in semantic/symref/grep
+
+ * lisp/cedet/semantic/symref/grep.el (greppattern): Remove.
+ (grepflags): Rename to semantic-symref-grep-flags.
+ (semantic-symref-grep-expand-keywords): Update accordingly.
+ (semantic-symref-grep-use-template): Remove the last two
+ arguments to make sure they don't shadow the (not renamed)
+ global variables.
+ (semantic-symref-perform-search)
+ (semantic-symref-parse-tool-output-one-line): Use slot names
+ instead of keywords, like the byte-compiler wants us to.
+
+2017-08-20 Dmitry Gutov <dgutov@yandex.ru>
+
+ Simplify eldoc-message
+
+ * lisp/emacs-lisp/eldoc.el (eldoc-message): Simplify.
+ Don't use ARGS because no callers pass them. Discussed in bug#27230.
+
+2017-08-20 Noam Postavsky <npostavs@gmail.com>
+
+ Work around w32-python-2.x bug to fix prompt detection (Bug#21376)
+
+ * lisp/progmodes/python.el (python-shell-prompt-detect): Don't put
+ carriage returns into the temporary file when running in unbuffered
+ mode, the w32 build of python 2.7 chokes on them.
+
+2017-08-20 Reuben Thomas <rrt@sc3d.org>
+
+ Add missing require
+
+ * lisp/textmodes/ispell.el: Require subr-x. (Thanks, Eli Zaretskii.)
+
+2017-08-20 Michael Albinus <michael.albinus@gmx.de>
+
+ Implement `interrupt-process' for remote processes (Bug#28066)
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-start-file-process):
+ Support sending signals remotely.
+ (tramp-open-connection-setup-interactive-shell):
+ Trace "remote-tty" connection property.
+
+ * lisp/net/tramp.el (tramp-advice-interrupt-process): New defun.
+ (top): Add advice to `interrupt-process'. (Bug#28066)
+
+ * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process):
+ New test.
+ (tramp-test29-shell-command)
+ (tramp-test30-environment-variables)
+ (tramp-test30-environment-variables-and-port-numbers)
+ (tramp-test31-explicit-shell-file-name)
+ (tramp-test32-vc-registered)
+ (tramp-test33-make-auto-save-file-name)
+ (tramp-test34-make-nearby-temp-file)
+ (tramp-test35-special-characters)
+ (tramp-test35-special-characters-with-stat)
+ (tramp-test35-special-characters-with-perl)
+ (tramp-test35-special-characters-with-ls, tramp-test36-utf8)
+ (tramp-test36-utf8-with-stat, tramp-test36-utf8-with-perl)
+ (tramp-test36-utf8-with-ls)
+ (tramp-test37-asynchronous-requests)
+ (tramp-test38-recursive-load, tramp-test39-remote-load-path)
+ (tramp-test40-unload): Rename.
+ (tramp-test40-unload): Test also removal of advice.
+
+2017-08-20 Reuben Thomas <rrt@sc3d.org>
+
+ Document Enchant support
+
+ * doc/emacs/fixit.texi: Mention Enchant.
+ * doc/misc/efaq.texi: Likewise.
+ * etc/NEWS: Add an item on Enchant support.
+
+2017-08-20 Reuben Thomas <rrt@sc3d.org>
+
+ Remove old comments and a redundant FIXME
+
+ * lisp/textmodes/ispell.el (ispell-process-line): Remove some old
+ commented code, a redundant FIXME, and outdated usage instructions.
+
+2017-08-20 Reuben Thomas <rrt@sc3d.org>
+
+ Add Enchant support to ispell.el (Bug#17742)
+
+ * lisp/textmodes/ispell.el (ispell-program-name): Add “enchant”.
+ (ispell-really-enchant): Add variable.
+ (ispell-check-version): If using Enchant, check it’s new enough (at
+ least 1.6.1). (Like the ispell check, this is absolute: cannot work
+ without.)
+ (ispell-enchant-dictionary-alist): Add variable.
+ (ispell-find-enchant-dictionaries): Add function, based on
+ ispell-find-aspell-dictionaries.
+ (ispell-set-spellchecker-params): Allow dictionary auto-detection for
+ Enchant, and call ispell-find-enchant-dictionaries to find them. Use
+ old ispell name to locale mapping code for Enchant too.
+ (ispell-send-replacement): Make it work with Enchant.
+
+2017-08-20 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/term.el (term-mode): Use `window-text-height' (Bug#5615).
+
+2017-08-20 Noam Postavsky <npostavs@gmail.com>
+
+ Stop printing '4' in .elc files after 'define-symbol-prop' calls
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-define-symbol-prop):
+ Return nil in case we have compiled the form, to prevent a redundant
+ constant from getting added to the compiled output.
+
+2017-08-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Change recent symlink tests to just test ASCII
+
+ * test/src/fileio-tests.el (fileio-tests--symlink-failure):
+ Be less ambitious about testing non-ASCII chars and encoding
+ errors, as there are too many portability issues.
+
+2017-08-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t adjust CRLF in file names
+
+ * doc/misc/gnus.texi (Non-ASCII Group Names):
+ * etc/NEWS:
+ * test/lisp/net/tramp-tests.el (tramp--test-utf8):
+ Use utf-8-unix, not utf-8, for default-file-name-coding-system, so
+ that CRLF in file names is left alone.
+ * lisp/international/mule-cmds.el (set-default-coding-systems):
+ Do not alter CRLF in file name coding systems.
+ (prefer-coding-system): Ignore differences in CRLF processing when
+ checking whether we used the user-specified file name coding system.
+ * test/src/fileio-tests.el: New file.
+
+2017-08-19 Eli Zaretskii <eliz@gnu.org>
+
+ Make list-processes support display-line-numbers
+
+ * lisp/simple.el (process-menu-mode): Move the call to
+ tabulated-list-init-header from here...
+ (list-processes--refresh): ...to here. (Bug#27895)
+
+2017-08-19 Eli Zaretskii <eliz@gnu.org>
+
+ Improve support of display-line-numbers in package.el
+
+ * lisp/emacs-lisp/package.el (package-menu--refresh): Redisplay
+ the header. (Bug#27895)
+ * lisp/emacs-lisp/tabulated-list.el
+ (tabulated-list-line-number-width): Fix the case when
+ display-line-numbers is nil.
+
+2017-08-19 Eli Zaretskii <eliz@gnu.org>
+
+ Improve support of display-line-numbers in tabulated-list-mode
+
+ * lisp/emacs-lisp/tabulated-list.el
+ (tabulated-list-line-number-width): New function.
+ (tabulated-list-init-header, tabulated-list-print-entry): Use it.
+ (Bug#27895)
+
+2017-08-19 Martin Rudalics <rudalics@gmx.at>
+
+ Fix one more issue reported by Alex (Bug#27999)
+
+ * doc/lispref/windows.texi (Preserving Window Sizes)
+ (Window Parameters): Use the term `window-preserved-size'
+ instead of `preserved-size' (Bug#27999).
+
+2017-08-19 Martin Rudalics <rudalics@gmx.at>
+
+ Rename `no-delete-other-window' to `no-delete-other-windows'
+
+2017-08-19 Martin Rudalics <rudalics@gmx.at>
+
+ Fix two side window problems noted by Alex (Bug#27999)
+
+ * lisp/window.el (display-buffer-in-side-window): Fix doc-string
+ typo.
+ (delete-other-windows): Rename the `no-delete-other-window'
+ parameter to `no-delete-other-windows' (see the discussion in
+ Bug#27999 for the rationale of this change).
+ * doc/lispref/windows.texi (Deleting Windows)
+ (Frame Layouts with Side Windows, Window Parameters): Rename
+ `no-delete-other-window' to `no-delete-other-windows'.
+
+2017-08-19 Alex Schroeder <alex@gnu.org>
+
+ Use define-minor-mode for rcirc-omit-mode
+
+2017-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clarify behavior of symlinks and directories
+
+ * doc/lispref/files.texi (Saving Buffers): Document how functions
+ like rename-file work with symlinks and directories. This patch
+ attempts to document the current behavior better, in preparation
+ for possibly changing it. See Bug#27986.
+
+2017-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix recently-introduced file descriptor leak
+
+ * src/fileio.c (Fmake_temp_file_internal):
+ Don’t leak a file descriptor if write_region signals an error.
+
+2017-08-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve make-temp-file performance on local files
+
+ * lisp/files.el (make-temp-file): Let make-temp-file-internal do
+ the work of inserting the text.
+ * src/fileio.c (Fmake_temp_file_internal): New arg TEXT.
+ All callers changed.
+
+2017-08-19 Noam Postavsky <npostavs@gmail.com>
+
+ Don't lose arguments to eshell aliases (Bug#27954)
+
+ * lisp/eshell/em-alias.el (eshell-maybe-replace-by-alias): Use ARGS.
+
+2017-08-19 Ted Zlatanov <tzz@lifelogs.com>
+
+ * lisp/files.el (make-temp-file): Fix directory use case.
+
+2017-08-19 Ted Zlatanov <tzz@lifelogs.com>
+
+ Fix and document make-temp-file optional text parameter
+
+ * lisp/files.el (make-temp-file): Fix initial TEXT parameter.
+ (files--make-magic-temp-file): Support optional TEXT parameter.
+ * etc/NEWS: Document it.
+ * doc/lispref/files.texi: Document it.
+ * test/lisp/auth-source-tests.el: Minor reformat.
+
+2017-08-19 Ted Zlatanov <tzz@lifelogs.com>
+
+ * test/lisp/auth-source-tests.el: Avoid `string-join' to be simple.
+
+ * test/lisp/auth-source-tests.el: Minor cleanups to use CL.
+
+2017-08-19 João Távora <joaotavora@gmail.com>
+
+ Fix default value of electric-pair-pairs and electric-pair-text-pairs
+
+ (Bug#24901)
+
+ A previous change, titled "Add support for curly quotation marks to
+ electric-pair-mode", attempted to add these characters to the default
+ value of these variables. But it did so in a quoted list, preventing
+ evaluation of the relevant expressions and resulting in an invalid
+ format.
+
+ * lisp/elec-pair.el (electric-pair-pairs, electric-pair-text-pairs):
+ Use backquote and comma.
+
+2017-08-19 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/elec-pair.el (electric-pair-text-pairs): Don't autoload (Bug#24901).
+
+ * lisp/progmodes/elisp-mode.el (emacs-lisp-mode): Require `elec-pair'
+ explicitly in the interactive case.
+
+2017-08-19 Mats Lidell <mats.lidell@cag.se>
+
+ * etc/tutorials/TUTORIAL.sv: synced with TUTORIAL
+
+2017-08-19 Ted Zlatanov <tzz@lifelogs.com>
+
+ Add auth-source tests and codify its API better
+
+ The auth-source behavior was unclear in some API use cases, so these
+ extra tests codify and test it. For details see
+ https://github.com/DamienCassou/auth-password-store/issues/29
+
+ * lisp/files.el (make-temp-file): Add new initial TEXT parameter.
+ * test/lisp/auth-source-tests.el (auth-source-test-searches): Add
+ auth-source tests and simplify them with the new `make-temp-file'.
+
+2017-08-18 Eli Zaretskii <eliz@gnu.org>
+
+ Don't call the same hook twice due to obsolete aliases
+
+ * lisp/international/robin.el (robin-activate):
+ * lisp/international/quail.el (quail-activate):
+ * lisp/international/mule-cmds.el (deactivate-input-method):
+ * lisp/emulation/viper-init.el (viper-deactivate-input-method):
+ Don't call the same hook twice, when the obsolete and the
+ advertised symbols are aliased. (Bug#28118)
+
+2017-08-18 Felipe Ochoa <felipe@fov.space> (tiny change)
+
+ A new face for show-paren in expression mode
+
+ * lisp/faces.el (show-paren-match-expression): Define the new face.
+ * lisp/paren.el (show-paren-function): Apply the different face
+ when in expression mode. (Bug#28047)
+
+2017-08-18 Eli Zaretskii <eliz@gnu.org>
+
+ Non-ASCII support for man page section and header names
+
+ * lisp/man.el (Man-name-regexp, Man-page-header-regexp)
+ (Man-heading-regexp): Replace ASCII character classes by
+ equivalent classes that allow non-ASCII characters. Suggested by
+ Grégory Mounié <Gregory.Mounie@imag.fr>. (Bug#27978)
+
+2017-08-18 Eli Zaretskii <eliz@gnu.org>
+
+ Implement HiDPI support for underwave on MS-Windows
+
+ * src/w32term.c (x_get_scale_factor): New function.
+ (w32_draw_underwave): Use it.
+ * src/xterm.c (x_draw_underwave): Offset the wave starting point
+ to make it identical with original code.
+
+2017-08-18 Stephen Pegoraro <spegoraro@tutive.com> (tiny change)
+
+ Support HiDPI displays for wave style underlines
+
+ * src/xterm.c (x_draw_underwave): Compute height, length and thickness
+ based on scale factor.
+ (x_get_scale_factor): New function.
+
+2017-08-18 Bastien <bzg@gnu.org>
+
+ Delete library-of-babel.org
+
+ * etc/org/library-of-babel.org: Delete file.
+
+2017-08-18 Glenn Morris <rgm@gnu.org>
+
+ * doc/emacs/files.texi (Copying and Naming): Avoid confusing texi2pdf.
+
+2017-08-18 Noam Postavsky <npostavs@gmail.com>
+
+ Remove custom version parsing from epg-config.el (Bug#27963)
+
+ * lisp/epg-config.el (epg-config--compare-version)
+ (epg-config--parse-version): Remove.
+ (epg-check-configuration): Use `version<=' instead.
+
+2017-08-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Treat control characters in JSON strings as invalid
+
+ * lisp/json.el (json-peek): Reduce to following-char.
+ (json-pop, json-read): Zero (null char) means end of file.
+ (json-read-escaped-char): Delimit URL properly.
+ (json-read-string): Signal error for ASCII control characters.
+ * test/lisp/json-tests.el (test-json-peek): Check for zero instead of
+ :json-eof symbol.
+ (test-json-read-string): New test for control characters in JSON
+ strings.
+
+2017-08-17 Eli Zaretskii <eliz@gnu.org>
+
+ Support Posix semantics of 'rename' on MS-Windows
+
+ * src/w32.c (sys_rename_replace): Support Posix semantics of
+ 'rename': return an error if OLD is a directory while NEW is not,
+ or vice versa.
+
+2017-08-17 Eli Zaretskii <eliz@gnu.org>
+
+ * src/w32.c (sys_rename_replace): Support renaming a directory.
+
+2017-08-17 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build
+
+ * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_open): Omit Gnulib module
+ 'open'.
+
+ * lib-src/etags.c (O_CLOEXEC) [WINDOWSNT]: Restore definition.
+
+2017-08-17 João Távora <joaotavora@gmail.com>
+
+ Add flymake-backends defcustom
+
+ * lisp/progmodes/flymake-proc.el (flymake-proc-can-syntax-check-buffer):
+ Rename from flymake-can-syntax-check-file. Suitable for adding to
+ flymake-backends.
+ (flymake-proc-start-syntax-check): Rename from
+ flymake-start-syntax-check. Don't check again if buffer can be
+ checked.
+ (add-to-list flymake-backends): Hook only flymake-ui.el
+
+ * lisp/progmodes/flymake-ui.el (flymake-backends): New
+ defcustom.
+ (flymake-on-timer-event, flymake-after-change-function)
+ (flymake-after-save-hook, flymake-find-file-hook): Call new
+ flymake--start-syntax-check-buffer and
+ flymake--can-syntax-check-buffer.
+ (flymake-mode): Call flymake--can-syntax-check-buffer and set
+ flymake-backend.
+ (flymake--backend): New buffer-local variable.
+
+2017-08-17 João Távora <joaotavora@gmail.com>
+
+ Split flymake.el into flymake-proc.el and flymake-ui.el
+
+ flymake.el is now a stub that requires both files.
+
+ * lisp/progmodes/flymake-proc.el: New file.
+
+ * lisp/progmodes/flymake-ui.el: New file.
+
+ * lisp/progmodes/flymake.el: Split into flymake-ui.el and
+ flymake-proc.el. Require both files.
+
+2017-08-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Set `default-directory' for watchdog in tramp-test.el
+
+ * test/lisp/net/tramp-tests.el (tramp-test36-asynchronous-requests):
+ Set `default-directory' for watchdog.
+
+2017-08-17 Andreas Schwab <schwab@suse.de>
+
+ * lisp/term/konsole.el: New file.
+
+2017-08-17 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/woman.el (woman-push, woman-pop): Remove. (Bug#27962)
+
+ (woman2-RS): Use plain `push' instead of `woman-push'.
+ (woman2-RE): Conditionally `pop' instead of `woman-pop'.
+
+2017-08-16 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ Merge from Gnulib; use ‘open’ for O_CLOEXEC
+
+ This incorporates:
+ 2017-08-15 renameat: ensure declaration in <stdio.h> on NetBSD
+ 2017-08-15 extensions: enable NetBSD specific extensions
+ 2017-08-14 open: support O_CLOEXEC
+ 2017-08-13 reallocarray: new module
+ * admin/merge-gnulib (AVOIDED_MODULES): Remove ‘open’, since
+ it now supports O_CLOEXEC and this simplifies Emacs.
+ * build-aux/config.guess, lib/fcntl.in.h, lib/stdio.in.h:
+ * lib/stdlib.in.h, m4/extensions.m4, m4/stdlib_h.m4:
+ Copy from Gnulib.
+ * lib/cloexec.c, lib/cloexec.h, lib/open.c:
+ * m4/mode_t.m4, m4/open-cloexec.m4, m4/open.m4:
+ New files, copied from Gnulib.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib-src/etags.c (O_CLOEXEC) [WINDOWSNT]:
+ Remove, as Gnulib does this for us.
+ * src/filelock.c (create_lock_file):
+ * src/sysdep.c (emacs_open, emacs_pipe):
+ Don’t worry about O_CLOEXEC == 0, as Gnulib no longer sets it to 0.
+
+2017-08-16 Alan Third <alan@idiocy.org>
+ Charles A. Roelli <charles@aurox.ch>
+
+ Allow use of run-time OS version checks on macOS (bug#27810)
+
+ * src/nsterm.h (NSWindowTabbingMode): Define in pre-Sierra macOS.
+ (MAC_OS_X_VERSION_10_6, MAC_OS_X_VERSION_10_7, MAC_OS_X_VERSION_10_8,
+ MAC_OS_X_VERSION_10_9, MAC_OS_X_VERSION_10_12, HAVE_NATIVE_FS): Remove
+ defines.
+ (NSWindowStyleMaskFullScreen,
+ NSWindowCollectionBehaviorFullScreenPrimary,
+ NSApplicationPresentationFullScreen,
+ NSApplicationPresentationAutoHideToolbar): Define in macOS 10.6.
+ * src/nsterm.m (colorForEmacsRed, colorUsingDefaultColorSpace,
+ check_native_fs, ns_read_socket, ns_select, runAlertPanel,
+ initFrameFromEmacs, windowDidMiniaturize, windowDidEnterFullScreen,
+ windowDidExitFullScreen, isFullscreen, updateCollectionBehavior,
+ toggleFullScreen, constrainFrameRect, scrollerWidth, syms_of_nsterm):
+ Allow use of run-time checks and replace version check macros.
+ * src/nsfns.m (ns_screen_name): Use run-time OS version checks.
+ * src/macfont.m (macfont_draw): Use run-time OS version checks.
+ * src/nsmenu.m (menuWillOpen): Use run-time OS version checks.
+
+2017-08-16 Alan Third <alan@idiocy.org>
+
+ Add multiframe image support to NS port (bug#21714)
+
+ * src/nsimage.m (ns_load_image): Handle multiple frames.
+ (EmacsImage::getMetadata, EmacsImage::setFrame): New functions.
+ * src/nsterm.h (EmacsImage::getMetadata, EmacsImage::setFrame): New
+ function prototypes.
+
+2017-08-16 Tino Calancha <tino.calancha@gmail.com>
+
+ files-tests.el: Remove unused lexical variable
+
+ * test/lisp/files-tests.el (file-test--do-local-variables-test);
+ Remove unused var 'files-test-queried'.
+
+2017-08-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/emacs/files.texi (Copying and Naming): Mention
+
+ restrictions to add-name-to-file and make-symbolic-link on
+ remote systems.
+
+2017-08-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/ange-ftp.el (ange-ftp-skip-msgs): Further support ftp-ssl.
+
+2017-08-16 Noam Postavsky <npostavs@gmail.com>
+
+ Add tests for previous commit
+
+ * test/lisp/progmodes/elisp-mode-tests.el
+ (elisp-mode-tests--face-propertized-string): New function.
+ (elisp--highlight-function-argument-indexed)
+ (elisp--highlight-function-argument-keyed-1)
+ (elisp--highlight-function-argument-keyed-2): New tests.
+
+2017-08-16 Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+ Fix eldoc highlighting for &key args (Bug#27272)
+
+ * lisp/progmodes/elisp-mode.el (elisp--highlight-function-argument):
+ Only switch to keyword-based searching if INDEX point beyond `&key' in
+ the argument list. All arguments prior to the `&key' are position
+ based. Additionally, be more strict about what is a keyword when
+ searching for the current keyword.
+
+2017-08-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not assume regular Git .git/hooks dir
+
+ Apparently Gitlab doesn’t create .git/hooks, like regular Git does.
+ Problem reported by Ted Zlatanov in:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00380.html
+ * autogen.sh (git_sample_hook_src): New function. Use it to work
+ even if .git/hooks or its samples do not exist.
+
+2017-08-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ New manual section "Copying and Naming"
+
+ * doc/emacs/files.texi (Copying and Naming):
+ New section, split off from Misc File Ops and containing the
+ operations that copy, name or rename files. This fixes some
+ confusion caused by the incorrect phrase "The same rule applies
+ to all the remaining commands in this section" in the old manual.
+ This change does not affect the confusion about directories (see
+ Bug#27986 for ongoing discussion).
+
+2017-08-15 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build
+
+ * src/fileio.c (Frename_file): Don't use ENOTSUP if it is equal to
+ ENOSYS. (Bug#28097) (Bug#27986)
+
+2017-08-15 Ted Zlatanov <tzz@lifelogs.com>
+
+ * .gitlab-ci.yml: run "autogen.sh autoconf" to avoid Git.
+
+ * .gitlab-ci.yml: add Git to the installed packages.
+
+2017-08-15 Simen Heggestøyl <simenheg@gmail.com>
+
+ Support indentation of detached Less CSS rulesets
+
+ * lisp/textmodes/css-mode.el (css-smie-rules): Provide better support
+ for indentation of detached rulesets passed to Less mixins.
+
+ * test/manual/indent/less-css-mode.less: New file.
+
+2017-08-15 Simen Heggestøyl <simenheg@gmail.com>
+
+ Fixes and tweaks for the new Less CSS mode
+
+ * etc/NEWS: Add an entry for the new mode.
+
+ * lisp/textmodes/less-css-mode.el (less-css): Tweak docstring.
+ (less-css-lessc-command): Tweak docstring. Don't mark it as
+ safe. Don't autoload.
+ (less-css-compile-at-save, less-css-lessc-options)
+ (less-css-output-directory): Tweak docstrings. Don't autoload.
+ (less-css-output-file-name): Tweak docstring. Don't mark it as safe.
+ (less-css-input-file-name): Tweak docstring. Don't autoload.
+ (less-css-compile-maybe): Use `when' for one-armed `if'.
+ (less-css--output-path): Tweak docstring.
+ (less-css--maybe-shell-quote-command): Remove function.
+ (less-css-compile): Don't autoload. Tweak docstring and message. Fix
+ compiler warning. Use `string-join' instead of `mapconcat'.
+ (less-css-font-lock-keywords): Use `font-lock-variable-name-face' for
+ variables.
+ (less-css-mode-syntax-table, less-css-mode-map): New variables.
+ (less-css-mode): Change status line mode name from "LESS" to
+ "Less". Tweak docstring. Move syntax table definitions to
+ `less-css-mode-syntax-table'.
+ (less-css-indent-line): Remove function.
+
+2017-08-15 Steve Purcell <steve@sanityinc.com>
+
+ New major mode: Less CSS mode
+
+ * lisp/textmodes/less-css-mode.el: New file.
+
+2017-08-15 Tino Calancha <tino.calancha@gmail.com>
+
+ archive-int-to-mode: Fix order of testing S_ISUID, S_ISGID bits
+
+ * lisp/arc-mode.el (archive-int-to-mode):
+ Swap order of 2048 and 1024 tests (Bug#28092).
+ * test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode):
+ Update test.
+
+2017-08-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve rename-file port to macOS
+
+ * src/fileio.c (Frename_file): On macOS, renameat_noreplace can
+ fail with errno == ENOTSUP on file systems where it is not
+ supported, according to the Apple documentation.
+
+2017-08-15 Noam Postavsky <npostavs@gmail.com>
+
+ Speed up ./configure with more caching (Bug#27960)
+
+ * configure.ac: Cache the 'GTK compiles', 'GSettings is in gio',
+ 'LN_S', '-znocombreloc', 'sysinfo', 'gcc autodepends', '-b link',
+ 'Xkb', 'Xpm preprocessor', 'tputs library' 'GLib', 'signals via
+ characters', and 'Windows API header' checks. Remove pause after
+ warning about GTK bug.
+
+2017-08-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve rename-file behavior on macOS
+
+ Problem reported by Philipp Stephani (Bug#27986).
+ * src/fileio.c (Frename_file):
+ Worry about file name case sensitivity only if CYGWIN or DOS_NT.
+ * src/sysdep.c (renameat_noreplace): Use renameatx_np on macOS,
+ since this provides the necessary atomicity guarantees.
+
+2017-08-14 Glenn Morris <rgm@gnu.org>
+
+ Clean up temp files after some tests
+
+ * test/lisp/emacs-lisp/bytecomp-tests.el
+ (bytecomp-tests--with-temp-file): Also delete .elc file if present.
+ * test/lisp/progmodes/etags-tests.el
+ (etags-buffer-local-tags-table-list): Delete temp file at end.
+
+2017-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ Implement renameat_noreplace for MS-Windows
+
+ * src/sysdep.c (renameat_noreplace) [WINDOWSNT]: Implement minimal
+ emulation for MS-Windows. (Bug#27986)
+
+2017-08-14 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'rename' on MS-Windows
+
+ * src/w32.c (sys_rename_replace): Use the FORCE argument only if
+ the primitive rename errors out with EEXIST.
+
+2017-08-14 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/ange-ftp.el (ange-ftp-skip-msgs): Support ftp-ssl.
+
+2017-08-14 Mark Oteiza <mvoteiza@udel.edu>
+
+ Tiny JSON performance improvement
+
+ Get rid of some needless uses of apply. Measuring with
+ (benchmark-run 10 (json-read-file "test.json"))
+ showed 1.5-2.5% reduction of execution time.
+ * lisp/json.el (json-peek): Nix let-binding.
+ (json-read-string): Use concat for making a string from chars.
+ (json-read-array): Use cond and more appropriate conversion instead
+ of blindly applying.
+
+2017-08-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Be consistent in spelling 'ok-if-already-exists'.
+
+2017-08-13 Alexander Gramiak <agrambot@gmail.com>
+
+ Use 'header-line-highlight' face in proced and erc
+
+ * lisp/erc/erc-list.el (erc-list-button):
+ * lisp/proced.el (proced-format): Use the 'header-line-highlight
+ face. (Bug#28033)
+
+2017-08-13 Ulf Jasper <ulf.jasper@web.de>
+
+ Remove feeds with dead uris from newsticker--raw-url-list-defaults
+
+ * lisp/net/newst-backend.el (newsticker--raw-url-list-defaults):
+ Remove feeds with dead uris.
+
+2017-08-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix vertical cursor motion when cursor is on the fringe
+
+ * lisp/simple.el (line-move-visual): Fix an off-by-one error in
+ setting temporary-goal-column when newline overflows into the
+ fringe. Support that use case in R2L paragraphs as well.
+
+2017-08-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix vertical cursor motion across too wide images
+
+ * src/indent.c (Fvertical_motion): If lines are truncated and we
+ end up beyond the right margin of the window, don't assume we are
+ in the next screen line, unless VPOS actually says so. (Bug#28071)
+
+2017-08-13 Tino Calancha <tino.calancha@gmail.com>
+
+ Add test suites for arc-mode and tar-mode
+
+ * test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode)
+ * test/lisp/tar-mode-tests.el (tar-mode-test-tar-grind-file-mode):
+ New tests.
+
+2017-08-13 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/tar-mode.el (tar-grind-file-mode): Fix docstring
+
+2017-08-13 Ulf Jasper <ulf.jasper@web.de>
+
+ Fix uri of Emacs Wiki
+
+ * lisp/net/newst-backend.el (newsticker--raw-url-list-defaults): Fix
+ uri of Emacs Wiki. (Bug#27981)
+
+2017-08-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix make-temp-file bug with ""/"."/".." prefix
+
+ The bug with "." and ".." has been present for a while; I
+ introduced the bug with "" earlier today in my patch for Bug#28023.
+ * lisp/files.el (make-temp-file): Do not use expand-file-name if
+ PREFIX is empty or "." or "..", as it does the wrong thing.
+ Compute absolute-prefix here ...
+ (files--make-magic-temp-file): ... instead of here ...
+ * src/fileio.c (Fmake_temp_file_internal): ... or here.
+
+ * lisp/files.el (make-temp-file): If the prefix is empty, append
+ "/" to the absolute prefix so that the new files are children
+ rather than siblings of temporary-file-directory. This fixes a
+ bug introduced in the previous change.
+ * test/lisp/files-tests.el (files-test-make-temp-file-empty-prefix):
+ New test, for the bug.
+
+2017-08-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve make-temp-file performance on local files
+
+ For the motivation behind this patch, please see Bug#28023 and:
+ http://emacshorrors.com/posts/make-temp-name.html
+ Although, given the recent changes to Tramp, the related security
+ problem in make-temp-file is already fixed, make-temp-file still has
+ several unnecessary system calls. In the typical case on GNU/Linux,
+ this patch replaces 8 syscalls (symlink, open, close, readlinkat, uname,
+ getpid, unlink, umask) by 2 (open, close).
+ * admin/merge-gnulib (GNULIB_MODULES): Add tempname, now
+ that Emacs is using it directly.
+ * configure.ac (AUTO_DEPEND): Remove AC_SYS_LONG_FILE_NAMES;
+ no longer needed.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lisp/files.el (files--make-magic-temp-file): Rename from
+ make-temp-file.
+ (make-temp-file): Use make-temp-file-internal for
+ non-magic file names.
+ * src/fileio.c: Include tempname.h.
+ (make_temp_name_tbl, make_temp_name_count)
+ (make_temp_name_count_initialized_p, make_temp_name): Remove.
+ (Fmake_temp_file_internal): New function.
+ (Fmake_temp_name): Use it.
+ * src/filelock.c (get_boot_time): Use Fmake_temp_file_internal
+ instead of make_temp_name.
+
+2017-08-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Document internal-use naming conventions
+
+ * doc/lispref/functions.texi (Function Names):
+ * doc/lispref/variables.texi (Tips for Defining):
+ Document naming conventions for internal-use functions and vars.
+ See Bug#28023#59.
+
+2017-08-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify re and document 'autoconf.sh all'
+
+ * GNUmakefile (ALL_IF_GIT): Remove; no longer needed, now that
+ ./autogen.sh defaults to "all". All uses removed.
+ * README: Mention autoconf.sh's effect on Git configuration.
+
+2017-08-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Default autogen.sh to 'all'
+
+ This addresses a problem noted by RMS in:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00052.html
+ * autogen.sh (do_git): Set to true if this script is invoked
+ with no arguments and there is a .git subdirectory.
+
+2017-08-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Adjust jka-compr to recent Tramp changes.
+
+ * lisp/jka-compr.el (jka-compr-write-region):
+ Two new args LOCKNAME and MUSTBENEW.
+
+2017-08-12 Eli Zaretskii <eliz@gnu.org>
+
+ Improve doc strings of 2 functions in simple.el
+
+ * lisp/simple.el (beginning-of-visual-line)
+ (move-beginning-of-line): Doc fix. Reported by
+ Justin Burkett <justin@burkett.cc>.
+
+2017-08-12 Eli Zaretskii <eliz@gnu.org>
+
+ Fix completion on directory names on MS-DOS/MS-Windows
+
+ * src/msdos.c (faccessat):
+ * src/w32.c (faccessat): Support relative file names, and add D_OK
+ to 'mode' if the argument is a directory. This unbreaks file-name
+ completion when the completion result is a directory.
+
+2017-08-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Implement EXCL of write-region for Tramp
+
+ * lisp/net/ange-ftp.el (ange-ftp-write-region):
+ * lisp/net/tramp-adb.el (tramp-adb-handle-write-region)
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-write-region)
+ * lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
+ Implement MUSTBENEW.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file)
+ * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link)
+ (tramp-sh-handle-add-name-to-file)
+ (tramp-do-copy-or-rename-file)
+ * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link):
+ Adapt error message for `file-already-exists'.
+
+ * src/lisp.h:
+ * src/eval.c (call8): New function.
+
+ * src/fileio.c (write_region): Pass also lockname and
+ mustbenew to the file name handler.
+
+ * test/lisp/net/tramp-tests.el (tramp-test10-write-region):
+ Add tests for MUSTBENEW.
+
+2017-08-12 Eli Zaretskii <eliz@gnu.org>
+
+ Adapt Proced display to display-line-numbers
+
+ * lisp/proced.el (proced-header-line): Account for the width taken
+ by display-line-numbers. (Bug#27895)
+
+2017-08-12 Eli Zaretskii <eliz@gnu.org>
+
+ Adapt tabulated list when display-line-number is turned on
+
+ * lisp/emacs-lisp/tabulated-list.el (tabulated-list-mode): Add
+ a hook to revert the display when display-line-numbers is turned
+ on. (Bug#27895)
+
+2017-08-12 Eli Zaretskii <eliz@gnu.org>
+
+ Use Gnulib 'tempname' on MS-Windows
+
+ * lib-src/ntlib.h (mkdir, open): Remove redefinitions. They are
+ now in nt/inc/ms-w32.h.
+ * lib-src/ntlib.c (sys_mkdir, sys_open): New functions.
+ (mkostemp): Remove.
+
+ * src/w32.c (mkostemp): Remove.
+ (sys_mkdir): Accept a second (unused) argument.
+ * src/fileio.c (Fmake_directory_internal): Remove the WINDOWSNT
+ specific call to mkdir. (Bug#28023)
+
+ * nt/inc/ms-w32.h (mkdir): Remove from "#ifdef emacs" and redefine
+ to accept 2 arguments.
+ (open): Remove from "#ifdef emacs".
+ * nt/mingw-cfg.site (ac_cv_func_mkostemp): Remove.
+ * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_mkostemp)
+ (OMIT_GNULIB_MODULE_tempname): Remove.
+
+2017-08-12 Alexander Gramiak <agrambot@gmail.com>
+
+ Add new face 'header-line-highlight'
+
+ * lisp/faces.el: Define the face.
+ * lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header):
+ * lisp/info.el (Info-fontify-node): Use the new face.
+ * doc/emacs/display.texi (Standard Faces):
+ * etc/NEWS: Document the new face. (Bug#28033)
+
+2017-08-12 Arash Esbati <arash@gnu.org>
+
+ Make a case-sensitive match for strings
+
+ * lisp/textmodes/reftex.el (reftex-typekey-check): Temporarily
+ let-bind `case-fold-search' to nil in order to be case-sensitive
+ when matching a string. (Bug#27518)
+
+2017-08-11 Stephen Berman <steve@rosalinde.fritz.box>
+
+ Fix a minor todo-mode regression
+
+ * lisp/calendar/todo-mode.el (todo-get-overlay): Wrap in
+ save-excursion. This fixes a regression introduced by the fix
+ for bug#27609, whereby trying to raise the priority of the
+ first item or lower the priority of the last item, which
+ should be noops, moves point to the item's start. Clarify
+ comment.
+
+ * test/lisp/calendar/todo-mode-tests.el
+ (todo-test-raise-lower-priority): Add test cases for trying to
+ raise first item and lower last item.
+ (with-todo-test): Clear abbreviated-home-dir, since we change HOME.
+ (todo-test-toggle-item-header02): Remove ":expected-result
+ :failed" and tests of point after todo-next-item, since the
+ effect when using Todo mode is not reproducible in the test
+ environment. Add commentary about this.
+
+2017-08-11 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve performance for rename-file etc.
+
+ Although this does not fix Bug#27986, it is a step forward.
+ I plan to propose a more-significant patch later.
+ * lisp/files.el (directory-name-p): Move from here ...
+ * src/fileio.c (Fdirectory_name_p): ... to here.
+ (directory_like, cp_like_target): New static functions.
+ (Fcopy_file, Frename_file, Fadd_name_to_file)
+ (Fmake_symbolic_link):
+ Use them, to avoid directory-testing syscalls on file names that
+ must be directories if they exist. Omit unnecessary
+ initializations and CHECK_STRING calls.
+ (Frename_file): Don't call file_name_case_insensitive_p
+ twice on the same file. Compare both file names expanded, instead
+ of the old name expanded and the new one unexpanded.
+
+2017-08-11 Noam Postavsky <npostavs@gmail.com>
+
+ Respect buffer-local value of tags-table-list (Bug#27772)
+
+ * lisp/progmodes/etags.el (visit-tags-table-buffer): Save the current
+ buffer around the `tags-table-including' calls so as to get buffer
+ local variables from the right buffer later.
+ * test/lisp/progmodes/etags-tests.el (etags-visit-tags-table-buffer):
+ New test.
+ * test/lisp/progmodes/etags-tests.el (etags-tests--test-dir): New
+ constant.
+ (etags-bug-158, etags-bug-23164): Use it so that when running the test
+ interactively, setting EMACS_TEST_DIRECTORY is not needed.
+
+2017-08-10 Tom Tromey <tom@tromey.com>
+
+ Fix auto-filling regression
+
+ Bug#28003
+ * lisp/newcomment.el (comment-indent-new-line): Check
+ comment-auto-fill-only-comments. Reverts earlier change.
+ * lisp/simple.el (internal-auto-fill): Call auto-fill-function, not
+ do-auto-fill.
+
+2017-08-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-08-09 tempname: do not depend on secure_getenv
+ 2017-08-08 extensions: add _OPENBSD_SOURCE
+ 2017-08-06 manywarnings: Add support for C++
+ 2017-08-06 warnings, manywarnings: Add support for multiple languages
+ * admin/merge-gnulib: Don't use m4/manywarnings-c++.m4.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib/secure_getenv.c, m4/secure_getenv.m4: Remove.
+ * lib/tempname.c, m4/extensions.m4, m4/manywarnings.m4, m4/warnings.m4:
+ Copy from gnulib.
+
+2017-08-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix crashing emacs-module tests on MS-Windows
+
+ * src/w32fns.c (syms_of_w32fns) <w32-disable-abort-dialog>: New
+ variable.
+ (emacs_abort): If w32-disable-abort-dialog is non-nil, abort right
+ away, without displaying the Abort dialog, which waits for the user.
+
+ * test/src/emacs-module-tests.el (module--test-assertion): Run the
+ inferior Emacs with the w32 abort dialog disabled. Expect the
+ status of the aborted Emacs sub-process to be 3 on MS-Windows and
+ 2 on MS-DOS.
+
+2017-08-09 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-delete-file: Dont't ask for empty dirs
+
+ * lisp/dired.el (dired--yes-no-all-quit-help): New defun.
+ (dired-delete-file): Use it. Dont't ask for empty dirs (Bug#27940).
+
+ * test/lisp/dired-tests.el (dired-test-with-temp-dirs):
+ New auxiliar macro.
+ (dired-test-bug27940): Add new test.
+
+2017-08-09 Tino Calancha <tino.calancha@gmail.com>
+
+ Ask files for deletion in buffer order: top first, botton later
+
+ * lisp/dired.el (dired-do-flagged-delete, dired-do-delete):
+ Call `nreverse' t invert the output of `dired-map-over-marks'.
+
+2017-08-09 Alexander Gramiak <agrambot@gmail.com>
+
+ Use help-mode xrefs in describe-font
+
+ * lisp/international/mule-diag.el (describe-font): Use help-setup-xref
+ (Bug#27890).
+
+2017-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Don't try to jump to non-existent part (bug#28013)
+
+ * lisp/gnus/gnus-art.el (gnus-article-edit-part): Don't try to jump to
+ the next part if there is the only one part in the article (bug#28013).
+
+2017-08-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace some uses of eval
+
+ There are a number of places where eval is used unnecessarily to get
+ or set the value of a symbol.
+ * lisp/calendar/calendar.el (diary-date-forms): Use default-value in
+ custom setter.
+ * lisp/desktop.el (desktop-clear): Use set-default instead.
+ * lisp/international/ogonek.el (ogonek-read-encoding): Use
+ symbol-value.
+
+2017-08-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Convert uses of looking-at in viper-ex to following-char
+
+ * lisp/emulation/viper-ex.el (viper-get-ex-token): Bind
+ (following-char) and use it in the subsequent cond's clauses.
+ (viper-ex, ex-quit, viper-get-ex-file): Use following-char instead.
+ Convert single branch ifs to when
+
+2017-08-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Some cleanup in message.el
+
+ * lisp/gnus/message.el (message-cross-post-insert-note):
+ (message-strip-forbidden-properties): Mark unused args.
+ (message-canlock-generate): Remove extinct variable
+ sha1-maximum-internal-length.
+ (message-make-mail-followup-to): Use loop's thereis clause.
+
+2017-08-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Document make-temp-name magic limitations
+
+ * doc/lispref/files.texi (Unique File Names):
+ * src/fileio.c (Fmake_temp_name): Document that make-temp-name
+ does not guarantee uniqueness on magic file names.
+
+2017-08-08 Tom Tromey <tom@tromey.com>
+
+ Show number of errors in compilation-mode mode-line
+
+ Bug#25354
+ * lisp/progmodes/compile.el (compilation-num-errors-found): Provide
+ default value.
+ (compilation-num-warnings-found, compilation-num-infos-found): New
+ defvars.
+ (compilation-mode-line-errors): New defconst.
+ (compilation-face): Remove.
+ (compilation-type, compilation--note-type): New functions.
+ (compilation-parse-errors): Call compilation--note-type.
+ (compilation-start): Include compilation-mode-line-errors in
+ mode-line-process.
+ (compilation-setup): Initialize compilation-num-* variables to 0.
+ (compilation-handle-exit): Include compilation-mode-line-errors in
+ mode-line-process.
+ * doc/emacs/building.texi (Compilation): Document new feature.
+
+2017-08-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Do some cleanup in mailcap.el
+
+ * lisp/net/mailcap.el: Use lexical-binding.
+ (mailcap--set-user-mime-data, mailcap-possible-viewers): Use pcase
+ destructuring.
+ (mailcap-mime-data): Remove some entries for ancient functions.
+ (mailcap-parse-mailcaps, mailcap-mime-info): Nix single-branch ifs.
+ (mailcap-parse-mimetype-file): Just use append.
+ (mailcap-command-p): Remove unused function.
+
+2017-08-08 Tino Calancha <tino.calancha@gmail.com>
+
+ query-replace: Undo replacements performed with 'comma
+
+ During a `query-replace', the char ',' replaces the character
+ at point and doesn't move point; right after, the char 'u'
+ must undo such replacement (Bug#27268).
+ * lisp/replace.el (replace--push-stack):
+ New macro extracted from `perform-replace'.
+ (perform-replace): Use it.
+ * test/lisp/replace-tests.el (query-replace--undo): Add test.
+
+2017-08-08 Noam Postavsky <npostavs@gmail.com>
+
+ Don't define gv expanders in compiler's runtime (Bug#27016)
+
+ This prevents definitions being compiled from leaking into the current
+ Emacs doing the compilation.
+ * lisp/emacs-lisp/gv.el (gv-define-expander): Use function-put instead
+ of `put' with `eval-and-compile'.
+ * test/lisp/emacs-lisp/gv-tests.el: New tests.
+
+2017-08-08 Noam Postavsky <npostavs@gmail.com>
+
+ Let the cl-typep effects of defclass work during compilation (Bug#27718)
+
+ * lisp/emacs-lisp/eieio.el (defclass): Use `define-symbol-prop'
+ instead of `put'.
+ * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+ (eieio-tests--dummy-function): Remove.
+ (eieio-test-25-slot-tests, eieio-test-23-inheritance-check): Don't
+ expect to fail if compiled.
+
+2017-08-08 Stefan Monnier <monnier@IRO.UMontreal.CA>
+ Noam Postavsky <npostavs@gmail.com>
+
+ Let `define-symbol-prop' take effect during compilation
+
+ * src/fns.c (syms_of_fns): New variable `overriding-plist-environment'.
+ (Fget): Consult it.
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-close-variables): Let-bind
+ it to nil.
+ (byte-compile-define-symbol-prop): New function, handles compilation
+ of top-level `define-symbol-prop' and `function-put' calls by putting
+ the symbol setting into `overriding-plist-environment'.
+
+2017-08-08 Gemini Lasswell <gazally@runbox.com>
+
+ Add a test of handling of circular values to testcover-tests
+
+ * test/lisp/emacs-lisp-testcover-resources/testcases.el
+ (testcover-testcase-cyc1): New function.
+ (testcover-tests-circular-lists-bug-24402): New test.
+
+2017-08-08 Noam Postavsky <npostavs@gmail.com>
+
+ Don't error on circular values in testcover
+
+ * lisp/emacs-lisp/testcover.el (testcover-after, testcover-1value):
+ Consider circular lists to be non-equal instead of signaling error.
+
+2017-08-08 Alexander Gramiak <agrambot@gmail.com>
+
+ Catch argument and macroexpansion errors in ert
+
+ This kludge catches errors caused by evaluating arguments in ert's
+ should, should-not, and should-error macros; it also catches
+ macroexpansion errors inside of the above macros (Bug#24402).
+
+ * lisp/emacs-lisp/ert.el: (ert--should-signal-hook): New function.
+ (ert--expand-should-1): Catch macroexpansion errors.
+ * test/lisp/emacs-lisp/ert-tests.el (ert-test-should-error-argument)
+ (ert-test-should-error-macroexpansion): Tests for argument and
+ expansion errors.
+
+2017-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ Revert "Add Enchant support to ispell.el (Bug#17742)"
+
+ This reverts commit 7136e6723d87b51ae3089f5ceef6b14621bfaf87.
+
+2017-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ Revert "Add support for arguments in ALTERNATE_EDITOR to emacsclient"
+
+ This reverts commit 28f1fe97daa13e13714e6c43c9a6fbb0c0e99a26.
+
+2017-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ Add support for arguments in ALTERNATE_EDITOR to emacsclient
+
+ * lib-src/emacsclient.c (fail): Parse ALTERNATE_EDITOR, or
+ corresponding command-line argument, into space-separated tokens.
+ * etc/NEWS: Document.
+ * test/lib-src/emacsclient-tests.el: Add a test.
+
+2017-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ Add Enchant support to ispell.el (Bug#17742)
+
+ * lisp/textmodes/ispell.el (ispell-program-name): Add “enchant”.
+ (ispell-really-enchant): Add variable.
+ (ispell-check-version): If using Enchant, check it’s new enough (at
+ least 1.6.1). (Like the ispell check, this is absolute: cannot work
+ without.)
+ (ispell-enchant-dictionary-alist): Add variable.
+ (ispell-find-enchant-dictionaries): Add function, based on
+ ispell-find-aspell-dictionaries.
+ (ispell-set-spellchecker-params): Allow dictionary auto-detection for
+ Enchant, and call ispell-find-enchant-dictionaries to find them. Use
+ old ispell name to locale mapping code for Enchant too.
+ (ispell-send-replacement): Make it work with Enchant.
+
+2017-08-07 Reuben Thomas <rrt@sc3d.org>
+
+ Allow async command output buffer to be shown only on output
+
+ * lisp/simple.el (async-shell-command-display-buffer): Add
+ defcustom.
+ (shell-command): Use the new defcustom to determine whether to show
+ the buffer immediately, or add a process filter that shows it only
+ when there is some output.
+ * etc/NEWS: Document the new variable.
+ * doc/emacs/misc.texi: Likewise.
+
+ Thanks to Juri Linkov and Eli Zaretskii for advice and guidance.
+
+2017-08-07 Eli Zaretskii <eliz@gnu.org>
+
+ Fix infinite recursion under prettify-symbols-mode and linum-mode
+
+ * src/xdisp.c (get_overlay_strings_1)
+ (handle_single_display_spec, push_prefix_prop): Invalidate the
+ composition information before starting to iterate on a string.
+ Otherwise we might think in set_iterator_to_next that we are
+ delivering characters from a composition, and do all kinds of
+ nonsensical things, like over-step the string end. (Bug#27761)
+
+2017-08-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/gnus/gnus-bcklg.el (gnus-backlog-request-article): Fix thinko.
+
+2017-08-07 Martin Rudalics <rudalics@gmx.at>
+
+ Fix doc-string of `delete-other-windows'
+
+ * lisp/window.el (delete-other-windows): Fix doc-string.
+
+2017-08-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix a couple more make-temp-file races
+
+ * lisp/files.el (basic-save-buffer-2, move-file-to-trash):
+ Use make-temp-name, not make-temp-file with retry.
+ (basic-save-buffer-2): Use condition-case, instead of
+ unwind-protect with a success flag.
+
+2017-08-07 Noam Postavsky <npostavs@gmail.com>
+
+ Merge null and without-null regexp alists (Bug#27840, Bug#27873)
+
+ * lisp/progmodes/grep.el (grep-mode-font-lock-keywords): Allow for NUL
+ characters following filename in grep context lines.
+ (grep--regexp-alist-column, grep--regexp-alist-bin-matcher)
+ (grep-with-null-regexp-alist, grep-fallback-regexp-alist): Remove.
+ (grep-regexp-alist): Recombine their contents here.
+ (grep-mode):
+ * lisp/cedet/semantic/symref/grep.el
+ (semantic-symref-parse-tool-output-one-line):
+ * lisp/progmodes/xref.el (xref-collect-matches): Use the variable
+ `grep-regexp-alist' rather than the function.
+
+2017-08-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix some crashes on self-modifying Elisp code
+
+ Prompted by a problem report by Alex in:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00143.html
+ * src/eval.c (For, Fprogn, Fsetq, FletX, eval_sub):
+ Compute XCDR (x) near XCAR (x); although this doesn't fix any bugs,
+ it is likely to run a bit faster with typical hardware caches.
+ (Fif): Use Fcdr instead of XCDR, to avoid crashing on
+ self-modifying S-expressions.
+ (Fsetq, Flet, eval_sub): Count the number of arguments as we go
+ instead of trusting an Flength prepass, to avoid problems when the
+ code is self-modifying.
+ (Fquote, Ffunction, Fdefvar, Fdefconst): Prefer !NILP to CONSP
+ where either will do. This is mostly to document the fact that
+ the value must be a proper list. It's also a tiny bit faster on
+ typical machines nowadays.
+ (Fdefconst, FletX): Prefer XCAR+XCDR to Fcar+Fcdr when either will do.
+ (eval_sub): Check that the args are a list as opposed to some
+ other object that has a length. This prevents e.g. (if . "string")
+ from making Emacs dump core in some cases.
+ * test/src/eval-tests.el (eval-tests--if-dot-string)
+ (eval-tests--let-with-circular-defs, eval-tests--mutating-cond):
+ New tests.
+
+2017-08-06 Eli Zaretskii <eliz@gnu.org>
+
+ * etc/tutorials/TUTORIAL.he: Update to match recent changes to TUTORIAL.
+
+2017-08-06 Tino Calancha <tino.calancha@gmail.com>
+
+ Minor tweak in a dired test
+
+ * test/lisp/dired-tests.el (dired-test-bug27968):
+ Ensure the new header has different length than the original one.
+
+2017-08-06 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-delete-file: Do not TAB complete the user answer
+
+ This action might delete directories containing valuable information.
+ Before previous commit, we prompted users with `yes-or-no-p'
+ which doesn't TAB complete the user answer. Let's play safe and
+ keep requiring full answers.
+ * lisp/dired.el (dired-delete-file): Use `read-string'
+ instead of `completing-read' to read the user answers.
+
+2017-08-06 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-do-delete: Allow to delete dirs recursively without prompts
+
+ * lisp/dired.el (dired-delete-file): Accept 2 additional answers:
+ 'all', to delete all directories recursively and no prompt anymore.
+ 'quit', to cancel directory deletions (Bug#27940).
+ Show help message when user inputs 'help'.
+ (dired-do-flagged-delete): Bind locally dired-recursive-deletes
+ so that we can overwrite its global value.
+ Wrapp the loop within a catch '--delete-cancel to catch when
+ the user abort the directtry deletion.
+ * doc/emacs/dired.texi (Dired Deletion): Update manual.
+ * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 26.1):
+ Announce this change.
+
+2017-08-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix a couple of make-temp-file races
+
+ * lisp/emacs-lisp/autoload.el (autoload--save-buffer):
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-file):
+ Use make-temp-file, not make-temp-name, to avoid an unlikely race
+ that could lose data. Remove the deletion hook as quickly as
+ possible after the file is renamed; though a race still remains
+ here, it is smaller than before.
+
+2017-08-06 Tino Calancha <tino.calancha@gmail.com>
+
+ Dired w/ eshell-ls: Handle shell wildcards in file name
+
+ * lisp/eshell/em-ls.el (eshell-ls--insert-directory):
+ Use eshell-extended-glob (Bug#27844).
+ * test/lisp/dired-tests.el (dired-test-bug27844): Add test.
+
+2017-08-06 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-revert: save line numbers instead of positions
+
+ Positions might change if the length of one dired header line
+ changes; this happen, for instance, if we add new files.
+ Instead, line numbers are invariant under shrinks/enlargements
+ of the file header.
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg01092.html
+ * lisp/dired.el (dired-save-positions): Save the line numbers at point.
+ (dired-restore-positions): Use forward-line to restore the original
+ position (Bug#27968).
+ * test/lisp/dired-tests.el (dired-test-bug27968): Add test.
+
+2017-08-06 Tom Tromey <tom@tromey.com>
+
+ Respect comment-auto-fill-only-comments
+
+ Respect comment-auto-fill-only-comments when auto-filling and a
+ comment syntax is defined.
+
+ * lisp/newcomment.el (comment-indent-new-line): Do not check
+ comment-auto-fill-only-comments.
+ * lisp/simple.el (internal-auto-fill): New defun.
+ * src/cmds.c (internal_self_insert): Call Qinternal_auto_fill, not
+ auto_fill_function.
+ (syms_of_cmds): Define Qinternal_auto_fill.
+
+2017-08-05 Richard Stallman <rms@gnu.org>
+
+ * etc/tutorials/TUTORIAL: Update.
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Unify CNS11643-15 in a way that avoids segfaults
+
+ * lisp/international/mule-conf.el: Redo unification of
+ cns11643-15. (Bug#27964)
+ (chinese-cns11643-15): Add the missing :unify-map attribute.
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid segfaults while producing Punct.el
+
+ * lisp/international/mule-conf.el: Undo unification of
+ cns11643-15, as that causes segfaults during bootstrap.
+ (Bug#27964)
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Make header line in some modes be sensitive to display-line-numbers
+
+ * lisp/ruler-mode.el (ruler-mode-ruler, ruler-mode-window-col):
+ * lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header)
+ (tabulated-list-print-entry): Account for the width taken by
+ line-number display. (Bug#27895)
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a bug in 'generate-new-buffer-name'
+
+ * src/buffer.c (Fgenerate_new_buffer_name): Test IGNORE for being
+ nil before calling string-equal, since the latter will compare
+ "nil and 'nil' as equal. (Bug#27966)
+
+ * test/src/buffer-tests.el
+ (test-generate-new-buffer-name-bug27966): New test.
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Unify CNS11643-15
+
+ * lisp/international/mule-conf.el (chinese-cns11643-15): Add a
+ unify-charset form for it. (Bug#27964)
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Improve test of error message when Emacs cannot be suspended
+
+ * lisp/term/x-win.el (x-win-suspend-error):
+ * lisp/term/ns-win.el (ns-suspend-error): Improve the error
+ message. (Bug#27901)
+
+2017-08-05 Alexander Gramiak <agrambot@gmail.com>
+
+ Make "C-h o" show faces as well as variables
+
+ * lisp/faces.el (describe-face): Return (buffer-string). Reorder
+ the placement of variables/faces in describe-symbol, to put more
+ emphasis on the variable entry rather than the face. (Bug#24543)
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix files-tests.el for MS-Windows
+
+ * test/lisp/files-tests.el
+ (files-tests--file-name-non-special--subprocess): Fix this test
+ for MS-Windows.
+
+2017-08-05 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'region-extract-function'
+
+ * lisp/simple.el (region-extract-function): Rename the argument to
+ METHOD. Doc fix. (Bug#27927)
+
+2017-08-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-08-04 manywarnings: port to 64-bit GCC builds of Emacs
+ 2017-08-01 manywarnings: port to 32-bit GCC bug
+ * lib/gnulib.mk.in: Regenerate.
+ * m4/manywarnings.m4: Copy from gnulib.
+
+2017-08-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port recent rename changes to Ubuntu 14.04
+
+ * src/sysdep.c (renameat_noreplace) [!RENAME_NOREPLACE]:
+ Don’t use syscall. Problem reported by Tino Calancha (Bug#27946#10).
+
+2017-08-05 Tino Calancha <tino.calancha@gmail.com>
+
+ insert-directory-wildcard-in-dir-p: Tweak regexp
+
+ This function must return non-nil for a wildcard like '/*/*.txt'.
+ * lisp/files.el (insert-directory-wildcard-in-dir-p): Adjust regexp.
+ * test/lisp/files-tests.el (files-tests--insert-directory-wildcard-in-dir-p):
+ Add test.
+
+2017-08-04 Toby S. Cubitt <tsc25@cantab.net>
+
+ Implement iterator generator for avl-trees.
+
+ * lisp/emacs-lisp/avl-tree.el (avl-tree-iter): New iter-defun.
+
+2017-08-04 Tino Calancha <tino.calancha@gmail.com>
+
+ ls-lisp: Drop eshell dependencies
+
+ Use 'file-expand-wildcards' instead of 'eshell-extended-glob' to
+ expand the wildcards.
+ Suggested by Fabrice Popineau in:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00108.html
+ * lisp/ls-lisp.el (ls-lisp--dired): Use file-expand-wildcards.
+
+2017-08-04 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix dired-test-bug27631 on MS-Windows
+
+ Skip the test if Dired use 'ls' emulation with lisp. The same
+ bug is tested in their respective test suites: ls-lisp-tests.el
+ and em-ls-tests.el.
+ * test/lisp/dired-tests.el (dired-test-bug27631): Skip test if 'ls-lisp'
+ or 'eshell' features are enabled.
+
+2017-08-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix dired-test-bug25609 on MS-Windows
+
+ * test/lisp/dired-tests.el (dired-test-bug25609): On MS-Windows,
+ pass temporary files through file-truename, to avoid bogus
+ failures due to file-name comparison as strings.
+
+2017-08-04 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix 2 tests that fail in MS-Windows
+
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00018.html
+ * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
+ Add comments to explain the test logic.
+ Pass '--binary' option to 'patch' program in windows environments.
+ Check explicitly that a backup is created before compare file contents.
+
+ * test/lisp/dired-tests.el (dired-test-bug25609):
+ Declare variable 'dired-dwim-target' right before the test.
+ Add comments to explain the test logic.
+ Ensure, before test the bug condition, that we are displaying the
+ 2 dired buffers created in this test, and no other dired buffer
+ is shown.
+
+2017-08-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/shell.el (explicit-shell-file-name): Mention shell-file-name
+
+ * lisp/files.el (insert-directory): Don't hardcode "-c".
+ * lisp/term.el (term, ansi-term): Use shell-file-name.
+
+2017-08-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix version numbers for some GnuTLS features
+
+ Problem reported by Glenn Morris (Bug#27708#58).
+ * src/gnutls.c (HAVE_GNUTLS_X509_SYSTEM_TRUST):
+ New macro. Use it instead of low-level version number checks.
+ (HAVE_GNUTLS_AEAD): Move here from gnutls.h, and rename from
+ HAVE_GNUTLS3_AEAD. All uses changed. Indent preprocessor lines.
+ * src/gnutls.h (HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_DIGEST)
+ (HAVE_GNUTLS3_HMAC): Remove, since these were available
+ before GnuTLS 3.0.0 and the code checks them only if HAVE_GNUTLS3
+ is defined. Remove all uses; this simplifies the code a bit.
+
+2017-08-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port recent rename changes to RHEL 7 + NFS
+
+ Problem reported by Ted Zlatanov in:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00082.html
+ * src/fileio.c (Frename_file): On RHEL 7 + NFS, renameat2 can fail
+ with errno == EINVAL when it is not supported. So treat that case
+ like errno == ENOSYS. Also, when ok_if_already_exists is neither
+ nil nor an integer, just call plain rename; this avoids an extra
+ syscall to renameat2 when the latter fails with errno == EINVAL or
+ ENOSYS or ENOENT.
+
+2017-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port GnuTLS usage to Ubuntu 16.04.2 LTS
+
+ * src/gnutls.h (HAVE_GNUTLS3_AEAD): Define only if GnuTLS 3.5.1 or
+ later, as opposed to the old 3.4.0 or later.
+
+2017-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify configuration of HAVE_GNUTLS3 etc.
+
+ There's only one GnuTLS, so configuring these symbols at
+ 'configure' time is overkill. Simplify things by moving their
+ configuration to src/gnutls.h (Bug#27708).
+ * configure.ac (HAVE_GNUTLS3, HAVE_GNUTLS3_HMAC, HAVE_GNUTLS3_AEAD)
+ (HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_DIGEST): Move these definitions
+ from here ...
+ * src/gnutls.h: ... to here, and simplify.
+
+2017-08-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Default to --with-mailutils if it is installed
+
+ * configure.ac (with_mailutils): Default to 'yes' if GNU Mailutils
+ is installed. See:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00054.html
+
+2017-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clarify when autogen.sh should run only autoconf
+
+ * Makefile.in (configure, bootstrap): Run ‘./autogen.sh autoconf’,
+ not plain ‘./autogen.sh’, to make it clear that only
+ autoconf-related tools should be run here.
+
+2017-08-02 Toon Claes <toon@iotcl.com>
+
+ .gitlab-ci.yml: Use stretch Debian image instead of unstable
+
+2017-08-02 Stephen Berman <stephen.berman@gmx.net>
+
+ Add debugging messages to a Dired test
+
+ * test/lisp/dired-tests.el (dired-test-bug27243-01): Log
+ positions saved and restored by dired-revert to try and find
+ out why the test fails on Hydra.
+
+2017-08-02 Tino Calancha <tino.calancha@gmail.com>
+
+ ls-lisp: Autoload call instead of cookie
+
+ * lisp/ls-lisp.el (eshell-extended-glob): autoload call instead of cookie.
+
+2017-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ When renaming a file, ask only if EEXIST or ENOSYS
+
+ * src/fileio.c (Frename_file): Avoid calling Ffile_directory_p
+ more than once on FILE. Use renameat_noreplace, so that we can
+ ask the user (and unlink and retry) only if this fails with errno
+ == EEXIST or ENOSYS. This avoids the need to ask the user for
+ permission to do an operation that will fail anyway. Simplify
+ computation of ok_if_already_exists for subsidiary functions.
+ * src/filelock.c (rename_lock_file): Prefer renameat_noreplace
+ if it works, as this avoids the need to link and unlink.
+ * src/lisp.h (renameat_noreplace): New decl.
+ * src/sysdep.c [HAVE_LINUX_FS_H]: Include linux/fs.h and sys/syscall.h.
+ (renameat_noreplace): New function.
+
+2017-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ When creating a link, ask only if EEXIST
+
+ * src/fileio.c (Fadd_name_to_file, Fmake_symbolic_link):
+ Ask the user (and unlink and retry) only if link creation fails
+ with errno == EEXIST. This avoids the need to ask the user for
+ permission to do an operation that will fail anyway.
+
+2017-08-02 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-align-file: Inherit text properties in inserted spaces
+
+ * lisp/dired.el (dired-align-file): Inherit text
+ properties in inserted spaces (Bug#27899).
+ * test/lisp/dired-tests.el (dired-test-bug27899): Add test.
+
+2017-08-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Don't assume /bin/sh as the 'sh' location in the local host
+
+ * lisp/dired.el (dired-insert-directory): Use executable-find in
+ a local host.
+
+2017-08-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Move dired tests using ls emulation to different files
+
+ Suggested in:
+ https://lists.gnu.org/r/emacs-devel/2017-08/msg00018.html
+ * test/lisp/dired-tests.el (dired-test-bug27693)
+ (dired-test-bug27762, dired-test-bug27817)
+ (dired-test-bug27631, dired-test-bug27843): Delete those
+ parts requiring either ls-lisp or eshell-ls.
+
+ * test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27762)
+ (ls-lisp-test-bug27631, ls-lisp-test-bug27693):
+ Add all dired tests using ls-lisp here.
+
+ * test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631)
+ (em-ls-test-bug27817, em-ls-test-bug27843): New test file. Add
+ all dired tests using eshell-ls here.
+
+2017-08-02 Tino Calancha <tino.calancha@gmail.com>
+
+ * test/lisp/ls-lisp-tests.el: Rename it from ls-lisp.el
+
+2017-08-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/gnus/mm-uu.el (mm-uu-org-src-code-block-extract):
+ Say the handle is already decoded.
+ cf. <yw.87lgnh5cfv.fsf@alex.chromebook> in the info-gnus-english list.
+
+2017-08-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t worry about unlink if errno == ENOENT
+
+ * src/fileio.c (Fdelete_file):
+ * src/keyboard.c (Fopen_dribble_file): Do not report failure to
+ remove a file if unlink fails with errno == ENOENT. This can
+ happen even if Emacs is the only program removing the file, in
+ case an NFS cache overflows. The file does not exist if errno ==
+ ENOENT, so it is OK to proceed.
+
+2017-08-01 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix misalignment in Dired when dired-directory is a cons
+
+ * lisp/dired.el (dired--need-align-p, dired--align-all-files):
+ New defuns.
+ (dired-internal-noselect): Call dired--align-all-files when
+ dired-directory is a cons (Bug#27762).
+ * test/lisp/dired-tests.el (dired-test-bug27762): Test should pass.
+
+2017-08-01 Eli Zaretskii <eliz@gnu.org>
+
+ Fix some dired-tests.el on MS-Windows
+
+ * test/lisp/dired-tests.el (dired-test-bug27243-01)
+ (dired-test-bug27243-02): On MS-Windows, pass test-dir through
+ file-truename, to avoid bogus failures due to file-name comparison
+ as strings.
+
+2017-08-01 Tino Calancha <tino.calancha@gmail.com>
+
+ Insert subdir content if dir-or-list is a string w/o wildcards
+
+ * lisp/eshell/em-ls.el (eshell-ls--insert-directory):
+ Append '("-d") into 'eshell-ls-dired-initial-args'
+ if 'dired-directory' is a cons or there are wildcars (Bug#27843).
+ * test/lisp/dired-tests.el (dired-test-bug27843): Add test.
+
+2017-08-01 Stephen Berman <stephen.berman@gmx.net>
+
+ Update todo-mode defcustoms in a less hideous way
+
+ * lisp/calendar/todo-mode.el (todo-reevaluate-filelist-defcustoms)
+ (todo-reevaluate-default-file-defcustom)
+ (todo-reevaluate-category-completions-files-defcustom)
+ (todo-reevaluate-filter-files-defcustom): Delete these functions.
+ (todo-update-filelist-defcustoms): New function. This replaces
+ todo-reevaluate-filelist-defcustoms, using the 'custom-type'
+ property instead of re-evaluating the defcustoms.
+ (todo-add-file, todo-rename-file, todo-delete-file)
+ (todo-delete-category, todo-move-category)
+ (todo-convert-legacy-files, todo-check-file): Replace call of
+ todo-reevaluate-filelist-defcustoms by
+ todo-update-filelist-defcustoms.
+ (todo-show, todo-category-completions): Replace call of
+ todo-reevaluate-* function by use of 'custom-type' property.
+
+2017-08-01 Tino Calancha <tino.calancha@gmail.com>
+
+ Add more should form calls in a failing dired test
+
+ Some dired tests fail intermittently in hydra. Add few
+ more should form calls for debugging.
+ See:
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg01092.html
+ * test/lisp/dired-tests.el (dired-test-bug27243-01): Add few more should
+ forms for debugging.
+
+2017-08-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Follow SAUNA recommendations for display-line-numbers-type
+
+ * lisp/display-line-numbers.el (display-line-numbers-type): Do not autoload.
+
+ * lisp/menu-bar.el (display-line-numbers-type): Declare.
+
+2017-07-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid most stat calls when completing file names
+
+ * admin/merge-gnulib (GNULIB_MODULES): Add d-type.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * m4/d-type.m4: New file, copied from gnulib.
+ * src/dired.c (DT_UNKNOWN, DT_DIR, DT_LINK)
+ [!HAVE_STRUCT_DIRENT_D_TYPE]: New constants.
+ (dirent_type): New function.
+ (file_name_completion): Use it, to avoid unnecessary calls to
+ stat-like functions on GNU/Linux and other platforms with d_type.
+ (file_name_completion_stat): Just follow the link; there is no
+ need to try first with AT_SYMLINK_NOFOLLOW since the directory
+ entry was already checked to exist.
+
+2017-07-31 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-tests: Unload tested features after test them
+
+ Some tests are for Dired with ls-lisp or eshell-ls.
+ Requiring these features add an advice on `dired' and
+ might affect other tests.
+ Do not require these features at the top of the file; require
+ then inside the tests and unload then at the end.
+ * test/lisp/dired-tests.el (dired-test-bug27693)
+ (dired-test-bug7131, dired-test-bug27817, dired-test-bug27631):
+ require ls-lisp and/or eshell-ls inside the test; unload the
+ features at the end.
+
+2017-07-31 Michael Albinus <michael.albinus@gmx.de>
+
+ Small adaptions for directory wildcards
+
+ * lisp/dired.el (dired-insert-directory): Remove "--dired"
+ when there are wildcards, and the directory is remote.
+
+ * test/lisp/net/tramp-tests.el (tramp--test-make-temp-name):
+ Adapt docstring.
+ (tramp-test17-dired-with-wildcards): Skip for all methods but
+ those from tamp-sh.p.
+
+2017-07-31 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/dired.el (dired-trivial-filenames): Use \` and \' to match
+ string bounds.
+
+2017-07-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-07-30 Don't interpret EOVERFLOW to mean nonexistence
+ * lib/tempname.c: Copy from gnulib.
+
+2017-07-30 Tino Calancha <tino.calancha@gmail.com>
+
+ ls-lisp: Do not require em-glob at top of the file
+
+ Require em-glob inside 'ls-lisp--dired'. This is necessary to
+ not break the Emacs build.
+ See following thread for details:
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg01083.html
+ * lisp/ls-lisp.el (dired-goto-next-file)
+ (dired-read-dir-and-switches, eshell-extended-glob):
+ Add function declarations.
+ * lisp/eshell/em-ls.el (dired-goto-next-file): Fix function declaration.
+
+2017-07-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/dired.el (dired-insert-directory): Move `file-remote-p' check up.
+
+ * test/lisp/net/tramp-tests.el (tramp-test17-dired-with-wildcards): New test.
+
+2017-07-30 Simen Heggestøyl <simenheg@gmail.com>
+
+ Change default CSS property face
+
+ * lisp/textmodes/css-mode.el (css-property): Inherit from
+ `font-lock-keyword-face' instead of `font-lock-variable-name-face' to
+ distinguish CSS properties from variables.
+
+2017-07-30 Tino Calancha <tino.calancha@gmail.com>
+
+ Dired: Handle posix wildcards in directory part
+
+ Allow Dired to handle calls like
+ \(dired \"~/foo/*/*.el\"), that is, with wildcards within
+ the directory part of the file argument (Bug#27631).
+ * lisp/files.el (insert-directory-wildcard-in-dir-p): New predicate.
+ (insert-directory-clean): New defun extracted from insert-directory.
+ (insert-directory)
+ * lisp/dired.el (dired-internal-noselect)
+ (dired-insert-directory): Use the new predicate; when it's true,
+ handle the directory wildcards with a shell call.
+ * lisp/eshell/em-ls.el (eshell-ls-use-in-dired): Add/remove both advices.
+ (eshell-ls-unload-hook): New defun. Use it in
+ eshell-ls-unload-hook instead of an anonymous function.
+ (eshell-ls--dired)
+ * lisp/ls-lisp.el (ls-lisp--dired):
+ Advice dired to handle wildcards in the directory part with both
+ eshell-ls and ls-lisp.
+ * etc/NEWS: Announce it.
+ * doc/emacs/dired.texi (Dired Enter): Update manual.
+ * test/lisp/dired-tests.el (dired-test-bug27631): Add test.
+
+2017-07-29 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/find-lisp.el: Enable lexical binding
+
+ * lisp/find-dired.el: Enable lexical binding
+
+2017-07-29 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/kmacro.el: Use lexical binding.
+
+2017-07-29 Mark Oteiza <mvoteiza@udel.edu>
+
+ Use lexical-binding in dired-aux.el
+
+ * lisp/dired.el: Use lexical binding.
+ (dired-do-shell-command): Remove unused bindings.
+
+2017-07-29 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/ido.el: Use lexical binding.
+
+ * lisp/whitespace.el: Use lexical binding.
+
+2017-07-29 Stephen Berman <stephen.berman@gmx.net>
+
+ artist.el: Avoid error with keyboard command invocation
+
+ * lisp/textmodes/artist.el (artist-mouse-choose-operation):
+ Call x-popup-menu with t instead of last-nonmenu-event as the
+ value of the position argument; this allows invoking the
+ command from the keyboard without raising an error (bug#27819).
+
+2017-07-29 Stephen Berman <stephen.berman@gmx.net>
+
+ Preserve point under 'dired-auto-revert-buffer' (third case)
+
+ * lisp/files.el (find-file): Use pop-to-buffer-same-window
+ instead of switch-to-buffer. This preserves Dired window
+ point when dired-auto-revert-buffer is non-nil. (Bug#27243)
+
+ * test/lisp/dired-tests.el (dired-test-bug27243-01)
+ (dired-test-bug27243-02, dired-test-bug27243-03): New tests.
+ The first two replace a previous test that combined them; that
+ test intermittently fails in the Hydra build system, so maybe
+ separating the two cases will help locate the point of
+ failure. The third test involves find-file but is here
+ because it, like the others, is testing the effect of
+ dired-auto-revert-buffer.
+
+2017-07-29 Allen Li <vianchielfaura@gmail.com> (tiny change)
+
+ Do not unset user key remaps in dired-x
+
+ * lisp/dired-x.el (dired-x-bind-find-file): Don't map any keys if user
+ sets dired-x-hands-off-my-keys. (Bug#27828)
+
+2017-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'occur'
+
+ * doc/emacs/search.texi (Other Repeating Search):
+ * lisp/replace.el (occur): Make the documentation of 'occur' be
+ more accurate when matches overlap. (Bug#27818)
+
+2017-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ Minor copyedits of comments in faces.el
+
+ * lisp/faces.el (face-font-family-alternatives): More info about
+ requirements from "Monospace Serif".
+
+2017-07-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not worry about paxctl on newer NetBSD
+
+ Problem reported privately by Thomas Klausner.
+ * configure.ac (emacs_uname_r): New var. Use it to avoid paxctl
+ on newer NetBSD platforms, where it is not needed. Also use it to
+ simplify Cygwin diagnostic.
+
+2017-07-29 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify documentation of ':inherit' face attribute
+
+ * doc/lispref/display.texi (Face Attributes): Document the special
+ treatment of 'unspecified' in the ':inherit' attribute.
+
+2017-07-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/password-cache.el (password-data): Use a hash-table
+
+ * lisp/auth-source.el (auth-source-magic): Remove.
+ (auth-source-forget+, auth-source-forget-all-cached): Adjust to new
+ format of password-data.
+ (auth-source-format-cache-entry): Just use a cons.
+
+ (password-cache-remove, password-cache-add, password-reset)
+ (password-read-from-cache, password-in-cache-p): Adjust accordingly.
+
+ (Bug#26699)
+
+2017-07-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/subr.el (define-symbol-prop): New function
+
+ (symbol-file): Make it find symbol property definitions.
+
+ * lisp/emacs-lisp/pcase.el (pcase-defmacro):
+ * lisp/emacs-lisp/ert.el (ert-set-test): Use it instead of `put'.
+ (ert-describe-test): Adjust call to symbol-file accordingly.
+
+2017-07-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/subr.el (method-files): Move function to cl-generic.el
+
+ * lisp/emacs-lisp/cl-generic.el (cl-generic-p): New function.
+ (cl--generic-method-files): New function, moved from subr.el.
+ * lisp/emacs-lisp/edebug.el (edebug-instrument-function): Use them.
+ * test/lisp/emacs-lisp/cl-generic-tests.el:
+ * test/lisp/subr-tests.el: Move and adjust method-files tests accordingly.
+
+2017-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ Preserve this-command-keys across recursive-edit invocations
+
+ * src/minibuf.c (read_minibuf, read_minibuf_unwind): Save and
+ restore this-command-keys, to preserve it across recursive-edit.
+ (Bug#27470)
+
+2017-07-28 Eli Zaretskii <eliz@gnu.org>
+
+ Improve doc string of 'locate-dominating-file'
+
+ * lisp/files.el (locate-dominating-file): Doc fix. (Bug#27798)
+
+2017-07-28 Drew Adams <drew.adams@oracle.com>
+
+ New commands 'apropos-local-variable', 'apropos-local-value'
+
+ * lisp/apropos.el (apropos-local-variable, apropos-local-value):
+ New functions. (Bug#27424)
+
+ * doc/emacs/help.texi (Apropos): Document 'apropos-local-variable'
+ and 'apropos-local-value'.
+ * etc/NEWS: Mention the new commands.
+
+2017-07-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/loadhist.el (unload-feature): Remove ad-hoc ELP code
+
+ * lisp/emacs-lisp/elp.el (loadhist-unload-element): Un-instrument functions.
+
+2017-07-27 Alan Mackenzie <acm@muc.de>
+
+ Fix C++ class initializers not always being fontified at mode start.
+
+ The problem here happened when an "outer list" of declarations moved beyond an
+ "inner list" containing class initializers. These weren't being checked for
+ by the code.
+
+ Also, fix places in c-get-fontification-context where point is undefined.
+
+ * lisp/progmodes/cc-fonts.el (c-get-fontification-context): when argument
+ not-front-decl is set, test for class initializers. Also, anchor point in
+ places where it is moved and is otherwise undefined.
+
+2017-07-27 Alan Mackenzie <acm@muc.de>
+
+ Fix variables in C++ "for" statement not always being fontified.
+
+ The error happened when there was a comma inside template delimiters.
+
+ * lisp/progmodes/cc-fonts.el (c-get-fontification-context): In "for"
+ statements, recognize template delimiters containing "," and "&".
+
+2017-07-27 Michael Albinus <michael.albinus@gmx.de>
+
+ Add watchdog process to tramp-test36-asynchronous-requests
+
+ * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler):
+ New defun.
+ (tramp-test36-asynchronous-requests): Use a watchdog process,
+ listening for SIGUSR1.
+
+2017-07-27 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Fix declarator being cut off from terminator by end of jit-lock chunk
+
+ If a declarator is so cut off, extend the fontification chunk to include it.
+
+ * lisp/progmodes/cc-mode.el (c-fl-decl-end): New function.
+ (c-change-expand-fl-region, c-context-expand-fl-region): Use the new function.
+
+2017-07-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/vc/smerge-mode.el: Avoid N² blow up in degenerate cases
+
+ (smerge--refine-long-words): New var.
+ (smerge--refine-chopup-region): Use it.
+
+2017-07-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/url/url-cookie.el: Use lexical-binding
+
+ (url-cookie-host-can-set-p): Remove unused var `last'.
+ Use string-suffix-p.
+ (url-cookie-list): De morgan.
+ (url-cookie-quit): Remove.
+ (url-cookie-mode): Inherit from special-mode.
+ (url-cookie-mode-map): Simplify accordingly.
+
+2017-07-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/calendar/todo-mode.el (todo-print-buffer-function): Rework docstring.
+
+ * lisp/ruler-mode.el (ruler-mode-ruler): Document problem.
+
+2017-07-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-generic.el (cl-generic-define-method):
+
+ Record this as the function's definition site if it's the first def.
+
+2017-07-26 Glenn Morris <rgm@gnu.org>
+
+ * doc/lispref/loading.texi (When to Autoload): New section.
+
+2017-07-26 Glenn Morris <rgm@gnu.org>
+
+ Stop using unibyte buffers for ert backtraces
+
+ * lisp/emacs-lisp/ert.el
+ (ert-results-pop-to-backtrace-for-test-at-point):
+ Set multibyte true, not false. This copies a
+ debugger-setup-buffer change from 2009-08-30, and stops the
+ "Backtrace for" header line containing ^X and ^Y.
+
+2017-07-26 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix semantic-symref-parse-tool-output-one-line after 644cdd1aa0
+
+ * lisp/cedet/semantic/symref/grep.el
+ (semantic-symref-grep--line-re): Delete.
+ (semantic-symref-parse-tool-output-one-line):
+ Use regexp and group numbers from (grep-regexp-alist).
+
+2017-07-26 Grégoire Jadi <daimrod@omecha.info>
+
+ Fix cl-defmethod indentation
+
+ * lisp/emacs-lisp/cl-generic.el (cl-defmethod):
+ Declare (indent defun). Fixes bug#23994.
+
+2017-07-26 Martin Rudalics <rudalics@gmx.at>
+
+ Fix two customization types in frame.el
+
+ * lisp/frame.el (window-divider-default-bottom-width)
+ (window-divider-default-right-width): Fix customization types.
+
+2017-07-26 Tino Calancha <tino.calancha@gmail.com>
+
+ Dired: Support eshell-ls from the beginning if the user wants to
+
+ * lisp/dired.el (dired-insert-directory): Check for eshell-ls
+ as well (Bug#27817).
+ * test/lisp/dired-tests.el (dired-test-bug27817): Add test.
+
+2017-07-26 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/progmodes/sh-script.el (sh-mode): Recognize mkshrc.
+
+2017-07-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/eieio-compat.el (eieio--defgeneric-init-form):
+
+ Adjust to change in cl-generic-ensure-function.
+
+2017-07-25 Tino Calancha <tino.calancha@gmail.com>
+
+ ls-lisp: Add an unload function and enable lexical binding
+
+ Enable lexical binding.
+ * lisp/ls-lisp.el (ls-lisp-unload-function): New defun.
+ * test/lisp/ls-lisp-tests.el (ls-lisp-unload): Add test.
+
+2017-07-25 Tino Calancha <tino.calancha@gmail.com>
+
+ register-read-with-preview: Quit if user input C-g or ESC
+
+ * lisp/register.el (register-read-with-preview):
+ Quit if user input C-g or ESC (bug#27634).
+ * doc/emacs/regs.texi (Registers): Update manual.
+ * test/lisp/register-tests.el (register-test-bug27634): Add test.
+
+2017-07-25 Mark Oteiza <mvoteiza@udel.edu>
+
+ Recognize MirBSD Korn shell rc file
+
+ * lisp/files.el (auto-mode-alist): Add .mkshrc to the list.
+
+2017-07-25 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac: Be explicit about ImageMagick version in summary.
+
+2017-07-25 Andreas Schwab <schwab@linux-m68k.org>
+
+ Properly align global lispsym
+
+ * lib-src/make-docfile.c (close_emacs_globals): Wrap struct
+ Lisp_Symbols inside struct.
+ * src/alloc.c (sweep_symbols): Update use of lispsym.
+ * src/lisp.h (builtin_lisp_symbol): Likewise.
+
+2017-07-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not use ImageMagick 7 and later
+
+ Suggested by Glenn Morris (Bug#25967#15).
+ * configure.ac (IMAGEMAGICK_MODULE): Reject 7 and later.
+
+2017-07-25 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/perl-mode.el: Add support for indented here docs
+
+ * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function):
+ Recognize the new <<~ syntax for indented here docs.
+ (perl-syntax-propertize-special-constructs): Adjust search of the
+ end of here docs accordingly.
+
+ * test/manual/indent/perl.perl: Add test for indented here docs.
+
+2017-07-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ (loadhist-unload-element): Move ERT and cl-generic methods
+
+ * lisp/loadhist.el (loadhist-unload-element): Don't define cl-generic
+ and ert methods here.
+ (loadhist-unload-element) <(head define-type)>: Remove unused var `slots'.
+
+ * lisp/emacs-lisp/cl-generic.el (loadhist-unload-element): Define
+ unload method for cl-defmethod.
+ (cl-generic-ensure-function): Remove redundant `defalias'.
+
+ * lisp/emacs-lisp/ert.el (ert-set-test): Move the current-load-list
+ setting here...
+ (ert-deftest): ...from here.
+ (loadhist-unload-element): Define unload method for ert-deftest.
+
+2017-07-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#27371
+
+ * lisp/loadhist.el (loadhist-unload-element): Declare for
+ different entry types of `load-history'.
+ (loadhist--restore-autoload): New variable.
+ (loadhist--unload-function): New defun.
+ (unload-feature): Use `loadhist-unload-element'. Recommended by
+ Stefan Monnier. (Bug#27371)
+
+ * test/lisp/net/tramp-tests.el (tramp-test39-unload):
+ Check, that the `tramp-file-name' structure has been unloaded.
+
+2017-07-24 Grégoire Jadi <gjadi@omecha.info>
+
+ Ensure that we parse images right in shr.el
+
+ * lisp/net/shr.el (shr-image-fetched): Go back to the
+ beginning of the buffer before trying to parse the image
+ fetched.
+
+2017-07-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .gitignore for Valgrind and no Automake
+
+ * .gitignore: Remove .deps/ since we no longer use Automake.
+ Add vgcore.*[0-9], for debugging Emacs with Valgrind+GDB.
+
+2017-07-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-07-23 Rename module 'strftime' to 'nstrftime'
+ * admin/merge-gnulib (GNULIB_MODULES): Add nstrftime, remove strftime.
+ * build-aux/config.guess: Copy from gnulib.
+ * lib/nstrftime.c: Rename from lib/strftime.c.
+ * m4/nstrftime.m4: Rename from m4/strftime.m4.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+
+2017-07-23 Philipp Stephani <phst@google.com>
+
+ Add 'rx' pattern for pcase.
+
+ * lisp/emacs-lisp/rx.el (rx): New pcase macro.
+ * test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add unit test.
+
+2017-07-23 Mark Oteiza <mvoteiza@udel.edu>
+
+ Use a named function for global minor mode turn-on argument
+
+ * lisp/display-line-numbers.el (turn-on-display-line-numbers-mode):
+ New function.
+ (global-display-line-numbers-mode): Use it.
+
+2017-07-23 Charles A. Roelli <charles@aurox.ch>
+
+ Enable GUI Emacs without 'make install' on macOS (Bug #27645)
+
+ * nextstep/INSTALL: Correct it, and mention that Emacs can be run
+ from 'src/emacs'.
+
+ * src/nsterm.m (applicationDidFinishLaunching:): When Emacs is
+ launched outside of a macOS application bundle, change its
+ activation policy from the default 'prohibited' to 'regular'.
+
+2017-07-23 Alan Mackenzie <acm@muc.de>
+
+ Convert CC Mode's c-found-types from an obarray to a hash table.
+
+ * lisp/progmodes/cc-engine.el (c-clear-found-types): create a hash table
+ rather than an obarray.
+ (c-copy-found-types): Remove.
+ (c-add-type, c-unfind-type, c-check-type, c-list-found-types): Amend to use
+ the new hash table.
+ (c-forward-<>-arglist): Use copy-hash-table rather than c-copy-found-types.
+
+2017-07-23 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix image/svg+xml display in shr
+
+ * lisp/net/shr.el (shr-put-image): Display svg images as svg
+ (bug#27799). I suspect the previous change was checked in by
+ accident in conjuction with some other svg changes.
+
+2017-07-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/display-line-numbers.el (display-line-numbers-type): Autoload it.
+
+2017-07-23 Glenn Morris <rgm@gnu.org>
+
+ Don't automatically enable Gconf if Gsettings was found
+
+ * configure.ac (HAVE_GCONF) [HAVE_GSETTINGS]:
+ Don't test for Gconf unless specifically requested.
+ Gconf was deprecated in favor of Gsettings several years ago.
+
+2017-07-23 Glenn Morris <rgm@gnu.org>
+
+ * configure.ac (MODULES_SUFFIX): Always give it a value.
+
+ This prevents a Makefile thinko like "rm *${MODULE_SUFFIX}".
+
+2017-07-23 Glenn Morris <rgm@gnu.org>
+
+ * doc/emacs/frames.texi (Fonts): Mention Gsettings.
+
+2017-07-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Add line numbers display to the Options menu
+
+ * lisp/menu-bar.el (toggle-display-line-numbers): Remove.
+ (menu-bar-display-line-numbers-mode): New defun.
+ (menu-bar-showhide-line-numbers-menu): New defvar.
+ (menu-bar-showhide-menu): Use `menu-bar-showhide-line-numbers-menu'
+
+2017-07-22 Noam Postavsky <npostavs@gmail.com>
+
+ Signal error for symbol names with strange quotes (Bug#2967)
+
+ * src/lread.c (read1): Signal an error when a symbol starts with a
+ non-escaped quote-like character.
+ * test/src/lread-tests.el (lread-tests--funny-quote-symbols): New
+ test.
+ * etc/NEWS: Announce change.
+
+2017-07-22 Noam Postavsky <npostavs@gmail.com>
+
+ Revert "Let delete-selection-mode work with popup-menu commands (Bug#27569)"
+
+ It turns out that this change is not needed, and it leaves several
+ command loops settings not done.
+
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00757.html
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00840.html
+
+2017-07-22 Alexander Gramiak <agrambot@gmail.com>
+
+ Add a minor mode interface for display-line-numbers
+
+ * lisp/cus-start.el: Use the new display-line-numbers group.
+ * lisp/display-line-numbers.el: New file.
+
+ * doc/emacs/custom.texi (Init Rebinding): Re-add entry that used to
+ belong to linum-mode.
+ * doc/emacs/modes.texi (Minor Modes): Summarize the mode.
+ * etc/NEWS: Document display-line-numbers-mode and its customization
+ variables, and mention that display-line-numbers-width is
+ buffer-local.
+
+ * src/xdisp.c (syms_of_xdisp) <display-line-numbers-width>: Fix a
+ typo.
+
+2017-07-22 vividsnow <vividsnow@gmail.com> (tiny change)
+
+ Support indented HERE-DOCs in cperl-mode
+
+ * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Support
+ indented here-docs. (Bug#27254) (Bug#27697)
+
+2017-07-22 Eli Zaretskii <eliz@gnu.org>
+
+ Document the support for "scrollBar" X resource
+
+ * doc/emacs/xresources.texi (Table of Resources): Document the new
+ 'scrollBar' setting.
+ * etc/NEWS: Document the new 'scrollBar' setting.
+
+2017-07-22 Matthew Bauer <mjbauer95@gmail.com> (tiny change)
+
+ Add 'scroll-bar-mode' to settings in 'x-apply-session-resources'
+
+ * lisp/startup.el (x-apply-session-resources): Add scroll-bar-mode
+ settings.
+
+2017-07-22 Alexander Kuleshov <kuleshovmail@gmail.com>
+
+ Update ld-script mode (bug#27629)
+
+ * lisp/progmodes/ld-script.el: (ld-script-keywords): New commands
+ NOCROSSREFS_TO and HIDDEN added. Fix documentation sections
+ numbers for PROVIDE/PROVIDE_HIDDEN commands.
+ (ld-script-builtins): New builtin function LOG2CEIL added.
+
+2017-07-22 Eli Zaretskii <eliz@gnu.org>
+
+ Index 'rectangle' in the ELisp manual
+
+ * doc/lispref/text.texi (Registers): Index the "rectangle" value.
+ (Bug#27541)
+
+2017-07-22 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/subr.el (add-to-history): Doc fix. (Bug#27494)
+
+2017-07-22 Eli Zaretskii <eliz@gnu.org>
+
+ Doc fixes for kmacro.el functions
+
+ * lisp/kmacro.el (kmacro-start-macro, kmacro-call-macro)
+ (kmacro-end-and-call-macro): Don't use "permanent name", as that
+ could be misinterpreted. (Bug#27492)
+
+2017-07-22 Charles A. Roelli <charles@aurox.ch>
+
+ ElDoc: add docstrings and minor refactoring
+
+ * lisp/emacs-lisp/eldoc.el (eldoc-edit-message-commands): Add
+ docstring.
+ (turn-on-eldoc-mode): Fix capitalization.
+ (eldoc--supported-p): Add docstring.
+ (eldoc-schedule-timer): Add docstring and use
+ 'eldoc--supported-p'.
+ (eldoc-message): Add docstring and make calling convention
+ clearer.
+ (eldoc--message-command-p):
+ (eldoc-pre-command-refresh-echo-area):
+ (eldoc-display-message-p):
+ (eldoc-display-message-no-interference-p):
+ (eldoc-print-current-symbol-info):
+ (eldoc-docstring-format-sym-doc):
+ (eldoc-add-command, eldoc-add-command-completions):
+ (eldoc-remove-command, eldoc-remove-command-completions):
+ Add docstring. (Bug#27230)
+
+2017-07-22 Fabrice Bauzac <libnoon@gmail.com> (tiny change)
+
+ Mention 'C-M-i' as key binding for 'ispell-complete-word'
+
+ * doc/emacs/fixit.texi (Spelling): ispell-complete-word
+ can also be invoked by C-M-i. (Bug#27349)
+
+2017-07-22 Fabrice Bauzac <libnoon@gmail.com> (tiny change)
+
+ Fix the eww-search-words description in the Emacs manual
+
+ * doc/emacs/search.texi (Word Search):
+ Include the key binding for eww-search-words in the manual.
+ Fix the spelling of the 'eww-search-words' command.
+
+2017-07-22 Andrew L. Moore <slewsys@gmail.com>
+
+ Introduce defcustom 'executable-prefix-env'
+
+ * lisp/progmodes/executable.el (executable-prefix): Update the doc
+ string.
+ (executable-prefix-env): New defcustom.
+ (executable-set-magic): Use executable-prefix-env.
+
+ * etc/NEWS: Document the new variable.
+
+2017-07-22 Glenn Morris <rgm@gnu.org>
+
+ * test/lisp/ibuffer-tests.el: Delete temporary files.
+
+2017-07-21 Glenn Morris <rgm@gnu.org>
+
+ Further attempt to avoid hang in network-stream-tests
+
+ * test/lisp/net/network-stream-tests.el (connect-to-tls-ipv6-nowait):
+ Limit the time we wait for the external process.
+
+2017-07-21 Glenn Morris <rgm@gnu.org>
+
+ Stop skipping many ibuffer tests by default
+
+ * test/lisp/ibuffer-tests.el (ibuffer-0autoload):
+ Rename so it sorts first.
+ (ibuffer-save-filters, ibuffer-filter-inclusion-1)
+ (ibuffer-filter-inclusion-2, ibuffer-filter-inclusion-3)
+ (ibuffer-filter-inclusion-4, ibuffer-filter-inclusion-5)
+ (ibuffer-filter-inclusion-6, ibuffer-filter-inclusion-7)
+ (ibuffer-filter-inclusion-8, ibuffer-decompose-filter)
+ (ibuffer-and-filter, ibuffer-or-filter, ibuffer-format-qualifier)
+ (ibuffer-unary-operand): Require ibuf-ext so tests not skipped.
+
+2017-07-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use lexical-binding in todo-mode.el
+
+ Adjust code accordingly and make various minor improvements.
+
+ * lisp/calendar/todo-mode.el: Enable lexical-binding.
+ (dayname, monthname, day, month, year): Make forward defvars
+ of these keywords from macros defined in calendar.el; wrap
+ them in with-no-warnings.
+ (todo-files, todo-files-function, todo-date-pattern)
+ (todo-mode-line-function, todo-show, todo-forward-category)
+ (todo-edit-item--header, todo-set-category-number)
+ (todo-adjusted-category-label-length)
+ (todo-total-item-counts, todo-filter-items)
+ (todo-print-buffer-function, todo-convert-legacy-date-time)
+ (todo-category-number, todo-category-completions)
+ (todo-read-file-name, todo-read-category)
+ (todo-validate-name, todo-read-date)
+ (todo-set-show-current-file, todo-modes-set-1)
+ (todo-modes-set-2, todo-modes-set-3, todo-mode):
+ Use #' instead of ' to quote functions.
+ (todo-files): Use \' instead of $ in regexp.
+ (todo--files-type-list): New function.
+ (todo-default-todo-file, todo-category-completions-files)
+ (todo-filter-files, todo-multiple-filter-files)
+ (todo-reevaluate-default-file-defcustom)
+ (todo-reevaluate-category-completions-files-defcustom)
+ (todo-reevaluate-filter-files-defcustom): Use it.
+ (todo-show, todo-rename-file, todo-move-category)
+ (todo-edit-item--text, todo-edit-quit, todo-edit-item--header)
+ (todo-item-undone, todo-unarchive-items, todo-search)
+ (todo-filter-items, todo-filter-items-1, todo-find-item)
+ (todo-category-select, todo-read-date)
+ (todo-nondiary-marker-matcher, todo-date-string-matcher)
+ (todo-diary-expired-matcher, todo-convert-legacy-files)
+ (todo-read-category): Reformat to avoid code hiding behind a
+ more deeply embedded element.
+ (todo-forward-category, todo-set-category-number):
+ Use 'funcall' instead of 'apply'.
+ (todo-toggle-mark-item, todo-edit-item--diary-inclusion)
+ (todo-edit-category-diary-inclusion)
+ (todo-insert-sort-button, todo-insert-category-line)
+ (todo-multiple-filter-files): Mark unused local variables.
+ (todo-edit-item--header, todo-move-item, todo-print-buffer)
+ (todo-edit-item--header, todo-move-item, todo-check-file)
+ (todo-edit-item--next-key): Remove unused local variables.
+ (todo-insert-sort-button, todo-insert-category-line):
+ Use a closure instead of a backquoted lambda.
+ (todo-update-categories-display, todo-print-buffer): Simplify code.
+ (todo-print-buffer-function): Document calling convention.
+ (todo-category-completions): Use cl-pushnew instead of add-to-list.
+ (todo-mode-map, todo-archive-mode-map)
+ (todo-categories-mode-map, todo-filtered-items-mode-map):
+ Remove superfluous call of suppress-keymap, since it's already
+ in the parent special-mode-map.
+
+2017-07-21 Tino Calancha <tino.calancha@gmail.com>
+
+ dired: Revert buffer when DIRNAME is a cons
+
+ * lisp/dired.el (dired-internal-noselect): Revert buffer if DIR-OR-LIST
+ is a cons, or dired-directory is a cons and DIR-OR-LIST a string (Bug#7131).
+ Update the comments.
+ * test/lisp/dired-tests.el (dired-test-bug7131): Test should pass.
+
+2017-07-21 Tino Calancha <tino.calancha@gmail.com>
+
+ Handle when dired-directory is a cons in some Dired functions
+
+ * lisp/dired-aux.el (dired-rename-subdir-1)
+ * lisp/dired-x.el (dired-mark-omitted):
+ Handle when dired-directory is a cons.
+
+2017-07-21 Noam Postavsky <npostavs@gmail.com>
+
+ Make eshell-next-prompt more reliable (Bug#27405)
+
+ * lisp/eshell/em-prompt.el (eshell-next-prompt): Search for
+ `eshell-prompt-regexp' (and `read-only' text-property if
+ `eshell-highlight-prompt' is set) rather than trying to use
+ `forward-paragraph'.
+ (eshell-previous-prompt): Don't count prompt on current line.
+
+2017-07-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify recent gnutls.c changes
+
+ * src/gnutls.c (clear_storage) [HAVE_GNUTLS3_AEAD]: Remove.
+ All uses replaced by calls to explicit_bzero; that’s clear enough.
+ (gnutls_symmetric_aead) [HAVE_GNUTLS3_AEAD]: Simplify by
+ coalescing duplicate actions. There is no need to invoke
+ SAFE_FREE before calling ‘error’.
+
+2017-07-20 Michael Albinus <michael.albinus@gmx.de>
+
+ Stylistic changes in tramp-cache.el
+
+ * lisp/net/tramp-cache.el (tramp-get-file-property)
+ (tramp-set-file-property): Use `bound-and-true-p'. Add
+ counter variables to `tramp-cache-unload-hook'.
+
+2017-07-20 Glenn Morris <rgm@gnu.org>
+
+ * admin/notes/hydra: Small updates.
+
+2017-07-20 Glenn Morris <rgm@gnu.org>
+
+ Make tramp unloading handle debug counter variables
+
+ * lisp/net/tramp-cache.el (tramp-get-file-property)
+ (tramp-set-file-property): Add counter variables to tramp-unload-hook.
+
+2017-07-20 Eli Zaretskii <eliz@gnu.org>
+
+ Fix hscrolling calculations when display-line-numbers is set
+
+ * src/xdisp.c (move_it_in_display_line_to): Account for line
+ numbers in hscrolled lines. (Bug#27756)
+
+2017-07-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Fix the bogus change made 13 years ago (bug#27084)
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-toggle-header):
+ Fix the way to test if there is no visible header (bug#27084).
+
+2017-07-20 Noam Postavsky <npostavs@gmail.com>
+
+ Use grep's --null option (Bug#6843)
+
+ * lisp/progmodes/grep.el (grep-use-null-filename-separator): New option.
+ (grep--regexp-alist-column, grep--regexp-alist-bin-matcher)
+ (grep-with-null-regexp-alist, grep-fallback-regexp-alist): New
+ constants, replacing `grep-regexp-alist'.
+ (grep-regex-alist): Mark the variable obsolete, add a new function of
+ the same name to replace it.
+ (grep-compute-defaults): Compute default for
+ `grep-use-null-filename-separator'.
+ (grep-mode): Set compilation-error-regexp-alist (buffer locally) to the
+ value of `grep-with-null-regexp-alist' or `grep-fallback-regexp-alist'
+ according to `grep-use-null-filename-separator'.
+ * lisp/progmodes/xref.el (xref-collect-matches): Call
+ `grep-regex-alist' instead of the obsolete variable. Don't hardcode
+ grep-regexp-alist match groups.
+ * etc/NEWS: Announce new use of --null. Move 'grep-save-buffers'
+ item under "Grep" heading as well.
+
+2017-07-19 Philipp Stephani <phst@google.com>
+
+ * src/gnutls.c (clear_storage): Define only if needed.
+
+2017-07-19 Stephen Berman <stephen.berman@gmx.net>
+
+ Adjust todo-quit to recent change in dired
+
+ * lisp/calendar/todo-mode.el (todo-quit): Use quit-window instead of
+ bury-buffer to exit todo-mode. This restores the desired behavior
+ of not immediately returning to the exited todo-mode buffer on
+ quitting another buffer, which a dired bug fix had changed (see
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00739.html).
+
+2017-07-19 Tino Calancha <tino.calancha@gmail.com>
+
+ Add test for bugs 7131, 27762
+
+ Require 'ls-lisp' at top of the file.
+ * test/lisp/dired-tests.el (dired-test-bug7131, dired-test-bug27762):
+ New tests.
+ (dired-test-bug27693): Delete Dired buffer at the end.
+
+2017-07-18 Michael Albinus <michael.albinus@gmx.de>
+
+ * admin/notes/hydra: Mention environment variable EMACS_HYDRA_CI.
+
+2017-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/nadvice.el (advice--defalias-fset): Strip advices
+
+ This tries to make sure that (defalias F (symbol-function F)) stays a no-op.
+
+2017-07-18 Glenn Morris <rgm@gnu.org>
+
+ Use a more specific test for running on hydra.nixos.org
+
+ * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit):
+ * test/Makefile.in (WRITE_LOG):
+ * test/lisp/filenotify-tests.el:
+ * test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+ (eieio-test-method-order-list-6):
+ * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+ (eieio-test-37-obsolete-name-in-constructor):
+ * test/lisp/net/tramp-tests.el: Replace NIX_STORE with EMACS_HYDRA_CI.
+
+2017-07-18 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid infloop due to Eshell's "smart" redisplay
+
+ * src/xdisp.c (pos_visible_p): Save and restore the window's
+ mode-line and header-line height. (Bug#27752)
+
+2017-07-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-lib.el (cl--old-struct-type-of): Accept `[]'
+
+2017-07-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix indentation when display-line-numbers is non-nil
+
+ * src/xdisp.c (x_produce_glyphs): Fix a typo in deciding whether
+ to go one more tab stop to display a TAB. (Bug#27743)
+
+2017-07-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Don't use gtk_widget_get_scale_factor on old GTK3 versions
+
+ * src/gtkutil.c (xg_get_scale): gtk_widget_get_scale_factor is
+ only present since GTK 3.10.
+
+2017-07-18 Noam Postavsky <npostavs@gmail.com>
+
+ Let delete-selection-mode work with popup-menu commands (Bug#27569)
+
+ * lisp/menu-bar.el (popup-menu): Run `pre-command-hook' with
+ `this-command' set to the selected command.
+
+2017-07-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port gnutls.c to older (buggier?) GnuTLS
+
+ Problem reported for GnuTLS 3.2.1 by Glenn Morris in:
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00716.html
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00742.html
+ Although I don't see how this bug can occur with vanilla GnuTLS 3.2.1,
+ perhaps hydra was using a modified GnuTLS.
+ * src/gnutls.c (Fgnutls_ciphers): Don't assume GNUTLS_CIPHER_NULL
+ is at the end of the list returned by gnutls_cipher_list,
+ or that the earlier ciphers all have non-null names.
+
+2017-07-17 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Fix relocation with named cell referred to by a one-symbol formula.
+
+ * lisp/ses.el (ses-replace-name-in-formula): Fix bug for it to
+ work also with one symbol formulas.
+
+ * test/lisp/ses-tests.el
+ (ses-tests-renaming-cell-with-one-symbol-formula): Add new
+ test for renaming with relocating a one symbol formula.
+
+2017-07-17 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Fix symbol completion and document it.
+
+ * doc/misc/ses.texi (Configuring what printer function
+ applies): Add description of keys for completing local printer
+ symbols and listing local printers in a help buffer.
+ (Formulas): Add decription for key to list the named cell
+ symbols in a help buffer.
+
+ * lisp/ses.el (ses-completion-keys): New constant.
+ (ses--completion-table): New defvar.
+ (ses--list-orig-buffer): New defvar.
+ (ses-mode-edit-map): Fixed for symbol completion, plus add
+ help functions to list named cells or local printers.
+ (ses-edit-cell-complete-symbol)
+ (ses--edit-cell-completion-at-point-function): New defuns for
+ completion during formula edition.
+ (ses-edit-cell): Redefine dynamically edit keymap for
+ completion keys to point at the right function.
+ (ses-read-printer-complete-symbol)
+ (ses--read-printer-completion-at-point-function): New defuns
+ for completion during printer edition.
+ (ses-read-printer): Redefine dynamically edit keymap for
+ completion keys to point at the right function.
+ (ses-list-local-printers): New defun.
+ (ses-list-named-cells): New defun.
+
+2017-07-17 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Move comments around
+
+2017-07-17 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make scaling work (?) on pre-GTK3 systems
+
+ * src/gtkutil.c (xg_get_gdk_scale): Reinstate function.
+ (xg_get_scale): Use it on non-GTK3 systems.
+
+2017-07-17 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Always return the GDK scale
+
+ * src/gtkutil.c (xg_get_scale): Return the GDK scale always.
+
+2017-07-17 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Remove usage of the GDK_SCALE variable
+
+ * src/gtkutil.c (xg_get_gdk_scale): Remove.
+ (xg_get_default_scrollbar_height)
+ (xg_get_default_scrollbar_width): Pass in a frame to check for
+ scaling.
+ (xg_frame_set_char_size): Use the API for querying scale
+ instead of looking at the GDK_SCALE variable.
+ (xg_get_default_scrollbar_width): Ditto.
+ (xg_get_default_scrollbar_height): Ditto.
+ (xg_update_scrollbar_pos): Ditto.
+
+ * src/xfns.c (x_set_scroll_bar_default_height): Pass in the
+ frame to get the width.
+
+2017-07-17 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Get positions of menus and tooltips right on HiDPI
+
+ * src/gtkutil.c (xg_get_scale): New function.
+ (xg_show_tooltip): Use it.
+
+ * src/xmenu.c (create_and_show_popup_menu): Put menus in the
+ right place.
+
+2017-07-17 Eli Zaretskii <eliz@gnu.org>
+
+ Allow user control on what starts and ends a paragraph for bidi
+
+ * src/buffer.h (struct buffer): New members
+ bidi_paragraph_separate_re_ and bidi_paragraph_start_re_.
+ * src/buffer.c (bset_bidi_paragraph_start_re)
+ (bset_bidi_paragraph_separate_re): New setters/
+ (Fbuffer_swap_text): Swap the values of bidi-paragraph-start-re and
+ bidi-paragraph-separate-re.
+ (init_buffer_once): Init the values of bidi-paragraph-start-re and
+ bidi-paragraph-separate-re.
+ (syms_of_buffer) <bidi-paragraph-start-re, bidi-paragraph-separate-re>:
+ New per-buffer variables.
+ * src/bidi.c (bidi_at_paragraph_end, bidi_find_paragraph_start):
+ Support bidi-paragraph-start-re and bidi-paragraph-separate-re.
+ (bidi_move_to_visually_next): Handle correctly the case when the
+ separator matches an empty string. (Bug#27526)
+
+ * doc/emacs/mule.texi (Bidirectional Editing):
+ * doc/lispref/display.texi (Bidirectional Display): Document
+ bidi-paragraph-start-re and bidi-paragraph-separate-re.
+
+ * etc/NEWS: Mention bidi-paragraph-start-re and
+ bidi-paragraph-separate-re.
+
+2017-07-17 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/emacs-lisp/map.el (map-put): Fix redundancy in docstring.
+
+2017-07-17 Tino Calancha <tino.calancha@gmail.com>
+
+ alist-get: Add optional arg TESTFN
+
+ If TESTFN is non-nil, then it is the predicate to lookup
+ the alist. Otherwise, use 'eq' (Bug#27584).
+ * lisp/subr.el (alist-get): Add optional arg FULL.
+ * lisp/emacs-lisp/map.el (map-elt, map-put): Add optional arg TESTFN.
+ * lisp/emacs-lisp/gv.el (alist-get): Update expander.
+ * doc/lispref/lists.texi (Association Lists): Update manual.
+ * etc/NEWS: Announce the changes.
+ * test/lisp/emacs-lisp/map-tests.el (test-map-put-testfn-alist)
+ (test-map-elt-testfn): New tests.
+
+2017-07-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix `tramp-test39-unload'
+
+ * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case-p)
+ (tramp--test-instrument-test-case): Rename. Adapt all callees.
+ (tramp-test36-asynchronous-requests): Bind `timer-max-repeats'.
+ (tramp-test39-unload): Expect it to pass. Ignore buffer-local
+ variables and autoload functions; they are not removed. Check
+ also for `-function(s)'.
+
+2017-07-17 Stephen Berman <stephen.berman@gmx.net>
+
+ Preserve point under 'dired-auto-revert-buffer' (second case)
+
+ * lisp/dired.el (dired): Use pop-to-buffer-same-window instead
+ of switch-to-buffer. This preserves Dired window point when
+ dired-auto-revert-buffer is non-nil. (Bug#27243)
+
+ * test/lisp/dired-tests.el (dired-test-bug27243): New test.
+
+2017-07-17 Martin Rudalics <rudalics@gmx.at>
+
+ Have Fgnutls_available_p return Qnil when GNUTLS is undefined
+
+ * src/gnutls.c (Fgnutls_available_p): Return Qnil when GNUTLS is
+ undefined to allow --with-gnutls=no builds to proceed.
+
+2017-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/gnutls.c: Restore some comments.
+
+2017-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use memset, not bzero
+
+ * src/ftcrfont.c (ftcrfont_glyph_extents): Use memset instead
+ of the (less-portable) bzero.
+
+2017-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use explicit_bzero to clear GnuTLS keys
+
+ * admin/merge-gnulib (GNULIB_MODULES): Add explicit_bzero.
+ * lib/explicit_bzero.c, m4/explicit_bzero.m4: New files.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * src/gnutls.c (clear_storage): New function.
+ (gnutls_symmetric_aead): Use it instead of memset.
+
+2017-07-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-07-16 explicit_bzero: new module
+ 2017-07-15 getdtablesize: Add minimal support for OpenVMS.
+ * lib/getdtablesize.c, lib/string.in.h, m4/getdtablesize.m4:
+ * m4/string_h.m4:
+ Copy from Gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-07-17 Dieter Deyke <dieter.deyke@gmail.com>
+
+ Fix vc-src-dir-status-files
+
+ * lisp/vc/vc-src.el (vc-src-dir-status-files): Fix broken
+ copy-paste from b1a765b3 (bug#27641).
+
+2017-07-16 Wilfred Hughes <me@wilfred.me.uk>
+
+ Fix mismatched parens
+
+ * etc/NEWS.21: Remove excess parenthesis in code example
+
+2017-07-16 Alan Third <alan@idiocy.org>
+
+ Add missing declare-function for new function
+
+ * lisp/frame.el: Add declare function for
+ ns-mouse-absolute-pixel-position.
+
+2017-07-16 R. Bernstein <rocky@gnu.org>
+
+ Realgud for tango themes
+
+2017-07-16 Noam Postavsky <npostavs@gmail.com>
+
+ Fix test when running from test/lisp/subr-tests.elc
+
+ * test/lisp/subr-tests.el (subr-test-backtrace-simple-tests): Don't
+ assume a lambda expression will be `equal' to its quoted form. That's
+ not true if the lambda expression has been compiled.
+
+2017-07-15 Alan Third <alan@idiocy.org>
+
+ Fix some frame handling issues on NS
+
+ * lisp/frame.el (mouse-absolute-pixel-position): Use new NS function.
+ * src/nsfns.m (Sns_mouse_absolute_pixel_position): New function.
+ * src/nsterm.m (x_make_frame_visible): Re-establish parent-child
+ relationship if it's broken.
+
+2017-07-15 Tino Calancha <tino.calancha@gmail.com>
+
+ ls-lisp: Fix file size format
+
+ * lisp/ls-lisp.el (ls-lisp-filesize-d-fmt, ls-lisp-filesize-f-fmt)
+ (ls-lisp-filesize-b-fmt): Add space in front (Bug#27693).
+ * test/lisp/dired-tests.el (dired-test-bug27693): Add test.
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid link errors with older versions of GnuTLS
+
+ * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead)
+ (Fgnutls_macs, Fgnutls_digests): Conditionally compile code that
+ calls GnuTLS functions which might be unavailable in older
+ versions of GnuTLS.
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Improve comments in faces.el
+
+ * lisp/faces.el (face-font-family-alternatives): Improve
+ commentary.
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Improve some GnuTL error messages
+
+ * src/gnutls.c (gnutls_symmetric_aead, gnutls_symmetric):
+ * src/fns.c (Fsecure_hash_algorithms): Fix error messages.
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the Elisp manual wrt GnuTL cryptography
+
+ * doc/lispref/elisp.texi (Top): Update the master menu.
+ * doc/lispref/text.texi (GnuTLS Cryptography): Add a @menu, to
+ avoid errors in makeinfo.
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation of gnutls.c with older GnuTLS
+
+ * src/gnutls.c (syms_of_gnutls): Condition some defsubr's
+ on HAVE_GNUTLS3, to avoid compilation errors when GnuTLS
+ v3.X is not available. Reported by Colin Baxter <m43cap@yandex.com>.
+
+2017-07-15 rocky <rb@dustyfeet.com>
+
+ Realgud for two more light themes
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Rearrange MS-Windows code that dynamically loads GnuTLS functions
+
+ * src/gnutls.c [WINDOWSNT]: Reorganize definitions and loading
+ of functions using the same preprocessing directives as in the code.
+
+2017-07-15 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build broken in gnutls.c
+
+ * src/gnutls.c (Fgnutls_available_p) [WINDOWSNT]: Move the DLL
+ loading code to after 'capabilities' has been calculated. Remove
+ redundant comments.
+
+2017-07-15 Lars Ingebrigtsen <larsi@gnus.org>
+
+ src/image.c (compute_image_size): Remove superfluous checks.
+
+ * src/image.c (compute_image_size): Remove superfluous checks.
+
+2017-07-15 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make combinations of :width/:max-height image specs work reliably
+
+ * doc/lispref/display.texi (ImageMagick Images): Document
+ :width/:max-height combinations (etc) (bug #25583).
+
+ * src/image.c (compute_image_size): Handle :width/:max-height
+ (etc) combinations consistently (by letting "max" win and
+ preserve ratio).
+
+ * test/manual/image-size-tests.el (image-size-tests): Add
+ tests for :width/:max-height (etc) combinations.
+
+2017-07-15 Glenn Morris <rgm@gnu.org>
+
+ Fix recent theme changes
+
+ * etc/themes/manoj-dark-theme.el, etc/themes/tsdh-dark-theme.el:
+ Fix typos in recent changes.
+
+2017-07-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ GnuTLS integer-overflow and style fixes
+
+ This tweaks the recently-added GnuTLS improvements so that
+ they avoid some integer-overflow problems and follow typical
+ Emacs style a bit better.
+ * configure.ac (HAVE_GNUTLS3_HMAC, HAVE_GNUTLS3_AEAD)
+ (HAVE_GNUTLS3_CIPHER): Use AC_CACHE_CHECK so that the
+ configure-time results are displayed.
+ * src/fns.c (extract_data_from_object): Return char *, not char
+ const *, since one gnutls caller wants a non-const pointer. Use
+ CONSP rather than !NILP when testing for conses. Use CAR_SAFE
+ instead of rolling our own code. Prefer signed types to unsigned
+ when either will do. Report problems for lengths out of range,
+ instead of silently mishandling them.
+ * src/gnutls.c (emacs_gnutls_strerror): New function, to simplify
+ callers. All callers of gnutls_sterror changed.
+ (Fgnutls_boot): Check for integers out of range rather than
+ silently truncating them.
+ (gnutls_symmetric_aead): Check for integer overflow in size
+ calculations.
+ (gnutls_symmetric_aead, Fgnutls_macs, Fgnutls_digests):
+ Prefer signed to unsigned integers where either will do.
+ (gnutls_symmetric_aead, gnutls_symmetric):
+ Work even if ptrdiff_t is wider than ‘long’.
+ (gnutls_symmetric, Fgnutls_hash_mac, Fgnutls_hash_digest):
+ Check for integer overflow in algorithm selection.
+
+2017-07-14 Noam Postavsky <npostavs@gmail.com>
+
+ * .gitlab-ci.yml: Don't install a C++ compiler. Suppress apt interaction.
+
+2017-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build due to added GnuTLS functions
+
+ * src/gnutls.c [WINDOWSNT]: Add DEF_DLL_FN for new functions.
+ (init_gnutls_functions) [WINDOWSNT]: Add LOAD_DLL_FN for new
+ functions. Add #define redirections for new functions.
+ (gnutls_symmetric_aead): Fix format specs to be more portable when
+ printing ptrdiff_t arguments.
+ * src/fns.c (gnutls_rnd) [WINDOWSNT]: Redirect to w32_gnutls_rnd
+ wrapper.
+ * src/gnutls.h [WINDOWSNT]: Add prototype for w32_gnutls_rnd.
+
+ * test/lisp/net/gnutls-tests.el (gnutls-tests-tested-macs)
+ (gnutls-tests-tested-digests, gnutls-tests-tested-ciphers): Call
+ gnutls-available-p, otherwise GnuTLS functions might not be loaded
+ from the DLL on MS-Windows.
+
+2017-07-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/bytecomp.el: Fix bug#14860.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile--function-signature): New fun.
+ Dig into advice wrappers to find the "real" signature.
+ (byte-compile-callargs-warn, byte-compile-arglist-warn): Use it.
+ (byte-compile-arglist-signature): Don't bother with "new-style" arglists,
+ since bytecode functions are now handled in byte-compile--function-signature.
+
+ * lisp/files.el (create-file-buffer, insert-directory):
+ Remove workaround introduced for (bug#14860).
+
+ * lisp/help-fns.el (help-fns--analyse-function): `nadvice` is preloaded.
+
+ * lisp/help.el (help-function-arglist):
+ Dig into advice wrappers to find the "real" signature.
+
+2017-07-14 Ted Zlatanov <tzz@lifelogs.com>
+
+ GnuTLS HMAC and symmetric cipher support
+
+ * etc/NEWS: Add news for new feature.
+
+ * doc/lispref/text.texi (GnuTLS Cryptography): Add
+ documentation.
+
+ * configure.ac: Add macros HAVE_GNUTLS3_DIGEST,
+ HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_AEAD, HAVE_GNUTLS3_HMAC.
+
+ * src/fns.c (Fsecure_hash_algorithms): Add function to list
+ supported `secure-hash' algorithms.
+ (extract_data_from_object): Add data extraction function that
+ can operate on buffers and strings.
+ (secure_hash): Use it.
+ (Fsecure_hash): Mention `secure-hash-algorithms'.
+
+ * src/gnutls.h: Include gnutls/crypto.h.
+
+ * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead)
+ (gnutls_symmetric, Fgnutls_symmetric_encrypt, Fgnutls_symmetric_decrypt)
+ (Fgnutls_macs, Fgnutls_digests, Fgnutls_hash_mac, Fgnutls_hash_digest)
+ (Fgnutls_available_p): Implement GnuTLS cryptographic integration.
+
+ * test/lisp/net/gnutls-tests.el: Add tests.
+
+2017-07-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-lib.el (cl--random-time): Remove as well
+
+ It's also defined in cl-extra.el.
+
+2017-07-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not convert ij and IJ to compatibility chars
+
+ * lisp/leim/quail/latin-alt.el: Omit lines for ij and IJ in Dutch.
+ Problem reported by James Cloos (Bug#518#10).
+
+2017-07-14 Toon Claes <toon@iotcl.com>
+
+ Remove Turkish ligatures from Dutch input method
+
+ * lisp/leim/quail/latin-alt.el: Remove Turkish ligatures (Bug#518).
+
+2017-07-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve stack-overflow heuristic on GNU/Linux
+
+ Problem reported by Steve Kemp (Bug#27585).
+ * src/eval.c (near_C_stack_top): Remove. All uses replaced
+ by current_thread->stack_top.
+ (record_in_backtrace): Set current_thread->stack_top.
+ This is for when the Lisp interpreter calls itself.
+ * src/lread.c (read1): Set current_thread->stack_top.
+ This is for recursive s-expression reads.
+ * src/print.c (print_object): Set current_thread->stack_top.
+ This is for recursive s-expression printing.
+ * src/thread.c (mark_one_thread): Get stack top first.
+ * src/thread.h (struct thread_state.stack_top): Now void *, not char *.
+
+2017-07-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove duplicate cl--random-state definition
+
+ * lisp/emacs-lisp/cl-lib.el (cl--random-state): Remove.
+ This variable is now defined in cl-extra.el (Bug#27617).
+
+2017-07-14 Michael Albinus <michael.albinus@gmx.de>
+
+ Adjust timer in tramp-test36-asynchronous-requests
+
+ * test/lisp/net/tramp-tests.el (tramp-test36-asynchronous-requests):
+ Adjust timer if it takes too much time.
+
+2017-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ Always display rmail progress report under user control
+
+ * lisp/mail/rmail.el (rmail-show-message-1): Delete the second
+ copy of '(message "Showing message %d..." msg)'. (Bug#27535)
+
+2017-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid byte-compilation warnings for advised functions
+
+ * lisp/files.el (insert-directory, create-file-buffer): Add an
+ advertised-calling-convention form to shut up byte-compilation
+ warnings. (Bug#14860)
+
+2017-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ Add assertion related to display-line-numbers
+
+ * src/xdisp.c (maybe_produce_line_number): Add assertion for the
+ condition regarding IT->glyph_row->used[TEXT_AREA] expected by the
+ code. (Bug#27668)
+
+2017-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ Prevent display corruption when display-line-numbers is set
+
+ * src/xdisp.c (try_window_reusing_current_matrix): If giving up
+ due to display-line-numbers, clear the window's desired glyph
+ matrix before returning, as the following call to try_window will
+ call display_line, which expects rows of the desired matrix
+ cleared. (Bug#27668)
+
+2017-07-14 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "Use fixed-pitch font for display-line-numbers"
+
+ This reverts commit d014a5e15c1110af77e7a96f06ccd0f0cafb099f.
+ * lisp/faces.el (line-number): Don't use a fixed-pitch font, by
+ popular demand. For relevant discussions, see
+
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00433.html
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00445.html
+
+2017-07-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-07-13 Improve cross-compilation guesses for native Windows
+ 2017-07-11 More systematic m4 quoting and indentation
+ 2017-07-10 Make sure $host and $host_os are defined when used
+ 2017-07-03 stdioext: Port to OpenVMS
+ 2017-06-24 xalloc-oversized: port to icc
+ * doc/misc/texinfo.tex, lib/fpending.c, lib/stdio-impl.h:
+ * lib/xalloc-oversized.h, m4/dirfd.m4, m4/gettimeofday.m4:
+ * m4/lstat.m4, m4/mktime.m4, m4/pselect.m4, m4/putenv.m4:
+ * m4/stdint.m4, m4/strtoimax.m4, m4/utimes.m4:
+ Copy from Gnulib.
+
+2017-07-13 Alan Mackenzie <acm@muc.de>
+
+ C++ Mode. Fix anomaly occurring when a ">" is deleted then reinserted.
+
+ This fontification anomaly happened because after deleting the ">",
+ c-forward-<>-arglist parses the preceding identifier as a putative type but
+ stores it in c-found-types before it becomes clear it is not an unambiguous
+ type. c-forward-<>-arglist fails, leaving the spurious type id in
+ c-found-types. Fix this by "binding" c-found-types "to itself" in
+ c-forward-<>-arglist, and restoring the original value when that function call
+ fails.
+
+ * lisp/progmodes/cc-engine.el (c-copy-found-types): New function.
+ (c-forward-<>-arglist): Record the original value of c-found-types at the
+ beginning of the function, and restore it at the end on failure.
+
+ * lisp/progmodes/cc-mode.el (c-unfind-coalesced-tokens): Rewrite more
+ accurately.
+
+2017-07-13 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Add tests for SES, and fix one more cell renaming bug.
+
+ * lisp/ses.el (ses-relocate-all): In case of insertion, do not
+ relocate value for named cells as they keep the same symbol.
+ (ses-rename-cell): Set new cell name symbol to cell value --- do not
+ rely on recalculating. Push cells with updated data --- cell name,
+ cell reference list, or cell formula --- to deferred write list.
+
+ * test/lisp/ses-tests.el: New file, with 7 tests for SES.
+
+2017-07-12 Alan Mackenzie <acm@muc.de>
+
+ Fix some bugs in c-defun-name. This fixes bug #25623.
+
+ * lisp/progmodes/cc-cmds.el (c-defun-name): Fix some bugs to do with structs,
+ etc.
+
+2017-07-12 Vasilij Schneidermann <mail@vasilij.de>
+
+ Make prog-mode-map the parent of c-mode-base-map. Fixes bug #26658.
+
+ * lisp/progmodes/cc-mode.el (top level): Make prog-mode-map the parent of
+ c-mode-base-map if possible.
+
+2017-07-12 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: create and use c-set-keymap-parent.
+
+ * lisp/progmodes/cc-defs.el (c-set-keymap-parent): New macro.
+
+ * lisp/progmodes/cc-mode.el (top-level): Remove cc-bytecomp-defun for
+ set-keymap-parents.
+ (c-make-inherited-keymap): Use c-set-keymap-parent in place of inline code.
+
+2017-07-12 Martin Rudalics <rudalics@gmx.at>
+
+ Minor tweaks of new line number display variables
+
+ * src/xdisp.c (Vdisplay_line_numbers): Tweak doc-string.
+ (Vdisplay_line_number_width): Rename to
+ Vdisplay_line_numbers_width.
+ (maybe_produce_line_number): Comply with above rename.
+ * lisp/cus-start.el (standard):
+ * lisp/frame.el (top-level):
+ * etc/NEWS: Comply with renaming of
+ `display-line-number-width' to `display-line-numbers-width'.
+
+2017-07-12 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid assertion violations in close_infile_unwind
+
+ * src/lread.c (close_infile_unwind): A temporary band-aid solution
+ for bug#27642: allow 'infile' be NULL.
+
+2017-07-11 Eli Zaretskii <eliz@gnu.org>
+
+ Use fixed-pitch font for display-line-numbers
+
+ * lisp/faces.el (line-number): Use a fixed-pitch font by default,
+ even if the default face uses a variable-pitch font. Reported by
+ James Cloos <cloos@jhcloos.com>.
+
+2017-07-11 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of display-line-numbers
+
+ * src/xdisp.c (syms_of_xdisp) <display-line-numbers>: Improve the
+ doc string. Suggested by Alex <agrambot@gmail.com>.
+
+2017-07-11 Nicolas Petton <nicolas@petton.fr>
+
+ Add an optional testfn parameter to assoc
+
+ * src/fns.c (assoc): New optional testfn parameter used for comparison
+ when provided.
+ * test/src/fns-tests.el (test-assoc-testfn): Add tests for the new
+ 'testfn' parameter.
+ * src/buffer.c:
+ * src/coding.c:
+ * src/dbusbind.c:
+ * src/font.c:
+ * src/fontset.c:
+ * src/gfilenotify.c:
+ * src/image.c:
+ * src/keymap.c:
+ * src/process.c:
+ * src/w32fns.c:
+ * src/w32font.c:
+ * src/w32notify.c:
+ * src/w32term.c:
+ * src/xdisp.c:
+ * src/xfont.c: Add a third argument to Fassoc calls.
+ * etc/NEWS:
+ * doc/lispref/lists.texi: Document the new 'testfn' parameter.
+
+2017-07-10 Michael Albinus <michael.albinus@gmx.de>
+
+ Use `with-demoted-errors' in Tramp
+
+ * lisp/net/tramp.el (tramp-with-demoted-errors): New defmacro.
+
+ * lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered): Use it.
+
+2017-07-10 Michael Albinus <michael.albinus@gmx.de>
+
+ Add Quick Start Guide to Tramp manual
+
+ * doc/misc/tramp.texi: Use consequently "@value{tramp}" and
+ "MS Windows".
+ (Quick Start Guide): New node.
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.3.3-pre".
+
+2017-07-10 Glenn Morris <rgm@gnu.org>
+
+ Fix failing module tests on GNU/Linux
+
+ * test/src/emacs-module-tests.el
+ (module--test-assertions--load-non-live-object)
+ (module--test-assertions--call-emacs-from-gc):
+ Avoid test failures due to backtraces.
+
+2017-07-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix core dump in substitute-object-in-subtree
+
+ Without this fix, (substitute-object-in-subtree #0=(#0# 'a) 'a)
+ would dump core, since the C code would recurse indefinitely through
+ the infinite structure. This patch adds an argument to the function,
+ and renames it to lread--substitute-object-in-subtree as the function
+ is not general-purpose and should not be relied on by outside code.
+ See Bug#23660.
+ * src/intervals.c (traverse_intervals_noorder): ARG is now void *,
+ not Lisp_Object, so that callers need not cons unnecessarily.
+ All callers changed. Also, remove related #if-0 code that was
+ “temporary” in the early 1990s and has not been compilable for
+ some time.
+ * src/lread.c (struct subst): New type, for substitution closure data.
+ (seen_list): Remove this static var, as this info is now part of
+ struct subst. All uses removed.
+ (Flread__substitute_object_in_subtree): Rename from
+ Fsubstitute_object_in_subtree, and give it a 3rd arg so that it
+ doesn’t dump core when called from the top level with an
+ already-cyclic structure. All callers changed.
+ (SUBSTITUTE): Remove. All callers expanded and then simplified.
+ (substitute_object_recurse): Take a single argument SUBST rather
+ than a pair OBJECT and PLACEHOLDER, so that its address can be
+ passed around as part of a closure; this avoids the need for an
+ AUTO_CONS call. All callers changed. If the COMPLETED component
+ is t, treat every subobject as potentially circular.
+ (substitute_in_interval): Take a struct subst * rather than a
+ Lisp_Object, for the closure data. All callers changed.
+ * test/src/lread-tests.el (lread-lread--substitute-object-in-subtree):
+ New test, to check that the core dump does not reoccur.
+
+2017-07-10 Philipp Stephani <phst@google.com>
+
+ Minor simplification of module_free_global_ref
+
+ * src/emacs-module.c (module_free_global_ref): Remove unused variable
+ 'hashcode'. Inline variable 'value' that's only used once.
+
+2017-07-10 Philipp Stephani <phst@google.com>
+
+ Re-add a useful assertion
+
+ * src/emacs-module.c (module_free_global_ref): Re-add assertion that
+ the reference count is zero. This assertion was removed in commit
+ 8afaa1321f8088bfb877fe4b6676e8517adb0bb7, but it's not included in the
+ test performed by XFASTINT before, because the previous reference
+ count could have been zero already in the case of a buggy
+ implementation. This assertion might have detected Bug#27587.
+
+2017-07-10 Valentin Gatien-Baron <vgatien-baron@janestreet.com> (tiny change)
+
+ Fix bug in module_free_global_ref (Bug#27587)
+
+ * src/emacs-module.c (module_free_global_ref): Actually remove entry
+ from hash table.
+
+2017-07-09 Philipp Stephani <phst@google.com>
+
+ Further improve electric quote support for Markdown (Bug#24709)
+
+ Markdown sets both 'comment-start' and 'comment-use-syntax' to non-nil
+ values. Therefore 'electric-quote-mode' recognized it as a
+ programming mode. Fix this by first checking whether the current
+ major mode is derived from 'text-mode'.
+
+ * lisp/electric.el (electric-quote-post-self-insert-function): Treat
+ 'text-mode' as stronger signal than comment syntax.
+
+ * test/lisp/electric-tests.el (electric-quote-markdown-in-text)
+ (electric-quote-markdown-in-code): Adapt unit tests.
+
+2017-07-09 Philipp Stephani <phst@google.com>
+
+ Remove pointless code in 'electric-quote-mode'
+
+ * lisp/electric.el (electric-quote-post-self-insert-function): Remove
+ pointless form.
+
+2017-07-09 Philipp Stephani <phst@google.com>
+
+ Refactor 'electric-quote-mode'
+
+ * lisp/electric.el (electric-quote-post-self-insert-function): Remove
+ local variable 'start', which was misnamed and only used once.
+
+2017-07-09 Saulius Menkevičius <saulius.menkevicius@gmail.com> (tiny change)
+
+ Avoid crashes on MS-Windows starting 64-bit .NET executables
+
+ * src/w32proc.c (w32_executable_type): Don't assume that the
+ import directory in a DLL will always be non-NULL. (Bug#27527)
+
+2017-07-09 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compilation warning in files.el
+
+ * lisp/files.el (auto-save-visited-file-name): Avoid obsoletion
+ warning due to its use in auto-save-visited-mode.
+
+2017-07-09 Eli Zaretskii <eliz@gnu.org>
+
+ Improve indexing of VC-related stuff in the Emacs manual
+
+ * doc/emacs/maintaining.texi (Version Control): Add a "VC" index
+ entry. (Bug#27627)
+
+2017-07-09 Eli Zaretskii <eliz@gnu.org>
+
+ Speed up display of line numbers for very large buffers
+
+ * src/xdisp.c (maybe_produce_line_number): Speed up line counting
+ using values cached by mode-line display of line numbers.
+ (Bug#27622)
+
+2017-07-09 Alexander Kuleshov <kuleshovmail@gmail.com>
+
+ Define internal_border_parts for window systems only (Bug#27615)
+
+ * src/keyboard.c: (internal_border_parts): Define only
+ when HAVE_WINDOW_SYSTEM is enabled. (Bug#27615)
+
+2017-07-09 R. Bernstein <rocky@gnu.org>
+
+ Add realgud faces faces to whiteboard...
+
+ Adjust wheatgrass to use underline for enabled/disabled breakpoints
+
+2017-07-08 Noam Postavsky <npostavs@gmail.com>
+
+ Optimize UCS normalization tests
+
+ Brings the the time for `ucs-normalize-part1' from 200s down to 130s.
+ * test/lisp/international/ucs-normalize-tests.el
+ (ucs-normalize-tests--parse-column): Use character instead of string
+ of length 1 for terminator. Convert return value into string since
+ all callers need that form anyway.
+ (ucs-normalize-tests--normalization-equal-p): Rename from
+ ucs-normalize-tests--normalize. Use dedicated buffer instead of
+ messing with narrowing. Take string to compare against and insert it
+ into buffer so that compare-buffer-substrings can be used instead of
+ allocating a new string from buffer contents.
+ (ucs-normalize-tests--normalization-chareq-p): New macro, specialized
+ for comparing single character.
+ (ucs-normalize-tests--rule1-holds-p)
+ (ucs-normalize-tests--rule2-holds-p): Turn into defsubst.
+ (ucs-normalize-tests--rule1-failing-for-partX): Use `eq' instead of
+ `='.
+
+2017-07-08 Noam Postavsky <npostavs@gmail.com>
+
+ Update failing lines for UCS normalize tests
+
+ * test/lisp/international/ucs-normalize-tests.el
+ (ucs-normalize-tests--failing-lines-part2): Update for new
+ admin/unidata/NormalizationTest.txt version.
+
+2017-07-08 Noam Postavsky <npostavs@gmail.com>
+
+ Semi-automate the procedure for updating UCS normalize test bad lines
+
+ * test/lisp/international/ucs-normalize-tests.el: Remove incorrect
+ commentary describing a manual procedure for producing the updated
+ failing lines, it did not actually work. Replace it with pointer to
+ new function which prints the updated values.
+ (ucs-normalize-tests--rule1-holds-p): Renamed from
+ ucs-normalize-tests--invariants-hold-p.
+ (ucs-normalize-tests--rule2-holds-p): Renamed from
+ ucs-normalize-tests--invariants-rule2-hold-p.
+ (ucs-normalize-tests--rule1-failing-for-partX): Renamed from
+ ucs-normalize-tests--invariants-failing-for-part.
+ (ucs-normalize-tests--rule1-failing-for-lines): Renamed from
+ ucs-normalize-tests--invariants-failing-for-lines.
+ (ucs-normalize-tests--part2-rule1-failed-lines): New variable.
+ (ucs-normalize-part2): Set it.
+ (ucs-normalize-part1): Always run through to end of test before
+ checking for failures.
+ (ucs-normalize-tests--insert-failing-lines)
+ (ucs-normalize-check-failing-lines): New functions, used to update
+ the *--failing-lines-part* variables.
+
+2017-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp/cus-start.el (standard): Spelling fix.
+
+2017-07-08 Philipp Stephani <phst@google.com>
+
+ Module assertions: check for garbage collections
+
+ It's technically possible to write a user pointer finalizer that calls
+ into Emacs module functions. This would be disastrous because it
+ would allow arbitrary Lisp code to run during garbage collection.
+ Therefore extend the module assertions to check for this case.
+
+ * src/emacs-module.c (module_assert_thread): Also check whether a
+ garbage collection is in progress.
+
+ * test/data/emacs-module/mod-test.c (invalid_finalizer)
+ (Fmod_test_invalid_finalizer): New test module functions.
+ (emacs_module_init): Register new test function.
+
+ * test/src/emacs-module-tests.el (module--test-assertion)
+ (module--with-temp-directory): New helper macros.
+ (module--test-assertions--load-non-live-object): Rename existing
+ unit test, use helper macros.
+ (module--test-assertions--call-emacs-from-gc): New unit test.
+
+2017-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ Capitalize the menu entry for display-line-numbers
+
+ * lisp/menu-bar.el (menu-bar-showhide-menu): Capitalize menu item
+ for display-line-numbers. Suggested by Martin Rudalics
+ <rudalics@gmx.at>.
+
+2017-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ Update Unicode data and files to Unicode 10.0
+
+ * admin/notes/unicode:
+ * admin/unidata/README:
+ * admin/unidata/BidiBrackets.txt:
+ * admin/unidata/BidiMirroring.txt:
+ * admin/unidata/Blocks.txt:
+ * admin/unidata/IVD_Sequences.txt:
+ * admin/unidata/NormalizationTest.txt:
+ * admin/unidata/SpecialCasing.txt:
+ * admin/unidata/UnicodeData.txt:
+ * lisp/international/characters.el:
+ * lisp/international/fontset.el (script-representative-chars):
+ * lisp/international/mule-cmds.el (ucs-names): Update per Unicode 10.0.
+
+2017-07-08 Alexander Gramiak <agrambot@gmail.com>
+
+ Support '=' in Scheme and Lisp tags in 'etags'
+
+ * lib-src/etags.c (get_lispy_tag): New function.
+ (L_getit, Scheme_functions): Use get_lispy_tag (Bug#5624).
+ * test/manual/etags/CTAGS.good:
+ * test/manual/etags/ETAGS.good_1:
+ * test/manual/etags/ETAGS.good_2:
+ * test/manual/etags/ETAGS.good_3:
+ * test/manual/etags/ETAGS.good_4:
+ * test/manual/etags/ETAGS.good_5:
+ * test/manual/etags/ETAGS.good_6:
+ * test/manual/etags/Makefile:
+ * test/manual/etags/el-src/TAGTEST.EL: Update tests.
+ * test/manual/etags/scm-src/test.scm: New tests for Scheme.
+
+2017-07-08 Alexander Kuleshov <kuleshovmail@gmail.com>
+
+ Avoid compiler warnings in xdisp.c debugging code
+
+ * src/xdisp.c (dump_glyph, dump_glyph_row, Fdump_glyph_matrix):
+ Use pD directives for ptrdiff_t values instead of pI, to avoid
+ compilation warnings on 64-bit hosts. (Bug#27597)
+
+2017-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ Commentary enhancement in frame.el
+
+ * lisp/frame.el: Explain how to test whether a variable needs to
+ be added to the list of those which are watched for buffer
+ redisplay.
+
+2017-07-08 Eli Zaretskii <eliz@gnu.org>
+
+ Support display of line numbers natively
+
+ This merges branch 'line-numbers'.
+ * src/buffer.c (disable_line_numbers_overlay_at_eob): New
+ function.
+ * src/lisp.h (disable_line_numbers_overlay_at_eob): Add prototype.
+ * src/dispextern.h (struct it): New members pt_lnum, lnum,
+ lnum_bytepos, lnum_width, and lnum_pixel_width.
+ * src/indent.c (line_number_display_width): New function,
+ refactored from line-number width calculations in vertical-motion.
+ (Fvertical_motion): Call line_number_display_width when the width
+ of line-number display is needed.
+ (Fline_number_display_width): New defun.
+ (syms_of_indent): Defsubr it.
+ * src/indent.c (Fvertical_motion): Help C-n/C-p estimate correctly
+ the width used up by line numbers by looking near the window-start
+ point. If window-start is outside of the accessible portion,
+ temporarily widen the buffer.
+ * src/term.c (produce_glyphs): Adjust tab stops for the horizontal
+ space taken by the line-number display.
+ * src/xdisp.c (display_count_lines_logically)
+ (display_count_lines_visually, maybe_produce_line_number)
+ (should_produce_line_number, row_text_area_empty): New functions.
+ (try_window_reusing_current_matrix): Don't use this method when
+ display-line-numbers is in effect.
+ (try_window_id, try_cursor_movement): Disable these optimizations
+ when the line-number-current-line face is different from
+ line-number face and for relative line numbers.
+ (try_window_id, redisplay_window, try_cursor_movement): For
+ visual line-number display, disable the same redisplay
+ optimizations as for relative.
+ (x_produce_glyphs): Adjust tab stops for the horizontal
+ space taken by the line-number display.
+ (hscroll_window_tree): Adjust hscroll calculations to line-number
+ display.
+ (DISP_INFINITY): Renamed from INFINITY to avoid clashes with
+ math.h; all users changed.
+ (set_cursor_from_row): Fix calculation of cursor X coordinate in
+ R2L rows with display-produced glyphs at the beginning.
+ (display_line): Use should_produce_line_number to determine
+ whether a line number should be produced for each glyph row, and
+ maybe_produce_line_number to produce line numbers.
+ Don't display line numbers in the minibuffer and in tooltip
+ frames.
+ Call row_text_area_empty to verify that a glyph
+ row's text area is devoid of any glyphs that came from a buffer or
+ a string. This fixes a bug with empty-lines indication
+ disappearing when line numbers or line-prefix are displayed.
+ (syms_of_xdisp) <display-line-numbers, display-line-numbers-widen>
+ <display-line-number-width>: New buffer-local variables.
+ <display-line-numbers-current-absolute>: New variable.
+
+ * lisp/cus-start.el (standard): Provide customization forms for
+ display-line-numbers and its sub-features.
+ * lisp/faces.el (line-number, line-number-current-line): New faces.
+ * lisp/frame.el: Add display-line-numbers, display-line-numbers-widen,
+ display-line-numbers-current-absolute, and
+ display-line-number-width to the list of variables that should
+ trigger redisplay of the current buffer.
+ * lisp/menu-bar.el (menu-bar-showhide-menu): Add menu-bar item to
+ turn display-line-numbers on and off.
+ (toggle-display-line-numbers): New function.
+ * lisp/simple.el (last--line-number-width): New internal variable.
+ (line-move-visual): Use it to adjust temporary-goal-column when
+ line-number display changes its width.
+
+ * doc/emacs/basic.texi (Position Info): Add cross-reference to
+ "Display Custom", for line-number display.
+ * doc/emacs/custom.texi (Init Rebinding):
+ * doc/emacs/modes.texi (Minor Modes): Remove references to
+ linum-mode.
+ * doc/emacs/display.texi (Display Custom): Describe the
+ line-number display.
+ * doc/lispref/display.texi (Size of Displayed Text): Document
+ line-number-display-width.
+
+ * etc/NEWS: Document display-line-numbers and its customizations.
+
+2017-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix more ungetc bugs with encoding errors
+
+ * src/lread.c (infile): New variable, replacing ...
+ (instream): ... this. All uses changed.
+ (readbyte_from_stdio): New function, which deals with lookahead.
+ (readbyte_from_file, Fget_file_char): Use it.
+ (Fget_file_char): When misused, signal an error instead of
+ relying on undefined behavior.
+ (close_infile_unwind): New function.
+ (Fload): Use it.
+ (readevalloop): 2nd arg is now struct infile *, not FILE *.
+ All callers changed.
+ (read1): Handle lookahead when copying doc strings with
+ encoding errors.
+
+2017-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid ungetc when loading charset maps from files
+
+ * src/charset.c (read_hex): New args LOOKAHEAD and TERMINATOR,
+ replacing the old EOF. All callers changed. This avoids the
+ need to call ungetc.
+
+2017-07-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix ungetc bug when reading an encoding error
+
+ * src/lread.c (readchar, read_emacs_mule_char): Fix off-by-one
+ error when reading an encoding error from a file, e.g., a symbol
+ in an .elc file whose name is "\360\220\200\360".
+
+2017-07-07 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/wid-edit.el (widget-color--choose-action): Use a closure
+
+ * lisp/window.el (display-buffer--special-action): Use a closure.
+
+2017-07-07 Stephen Berman <stephen.berman@gmx.net>
+
+ Add new todo-mode.el tests
+
+ * test/lisp/calendar/todo-mode-tests.el (with-todo-test):
+ Declare an Edebug spec. Restore pre-test-run state of test files.
+ (todo-test--show, todo-test--move-item)
+ (todo-test--insert-item): New functions.
+ (todo-test-get-archive): Remove, as subsumed by
+ todo-test--show. Adjust all callers.
+ (todo-test--is-current-buffer): Rename from
+ todo-test-is-current-buffer and adjust uses.
+ (todo-test-item-highlighting): Use todo-test--show.
+ (todo-test-revert-buffer01, todo-test-revert-buffer02)
+ (todo-test-raise-lower-priority)
+ (todo-test-todo-mark-unmark-category, todo-test-move-item01)
+ (todo-test-move-item02, todo-test-move-item03)
+ (todo-test-move-item04, todo-test-move-item05)
+ (todo-test-toggle-item-header01)
+ (todo-test-toggle-item-header02)
+ (todo-test-toggle-item-header03)
+ (todo-test-toggle-item-header04)
+ (todo-test-toggle-item-header05)
+ (todo-test-toggle-item-header06)
+ (todo-test-toggle-item-header07): New tests.
+
+ * test/lisp/calendar/todo-mode-resources/todo-test-1.toda:
+ * test/lisp/calendar/todo-mode-resources/todo-test-1.todo:
+ Modify to accommodate new tests.
+
+2017-07-07 Stephen Berman <stephen.berman@gmx.net>
+
+ todo-mode.el: Fix handling of hidden item headers (bug#27609)
+
+ * lisp/calendar/todo-mode.el (todo--item-headers-hidden): New variable.
+ (todo-toggle-item-header): Use it. Make this command a noop
+ if the file has no items.
+ (todo-move-item, todo-item-done): Instead of concatenating the
+ items to move into one string, make a list of them to
+ facilitate handling hidden headers. Adjust insertion accordingly.
+ (todo-archive-done-item): Handle hidden headers in archive file.
+ (todo-unarchive-items): Handle hidden headers in todo file.
+ (todo-backward-item): Use todo--item-headers-hidden and handle
+ moving backward work when item date-time headers are hidden.
+ (todo-remove-item): Delete date-time header overlay.
+ (todo-get-overlay, todo-insert-with-overlays): Make them work
+ with hidden date-time headers.
+ (todo-modes-set-2): Make todo--item-headers-hidden buffer local.
+
+2017-07-07 Stephen Berman <stephen.berman@gmx.net>
+
+ Fix several todo-mode bugs found while debugging bug#27609
+
+ * lisp/calendar/todo-mode.el (todo-toggle-mark-item): Calculate
+ current category only once.
+ (todo-mark-category): Update number of marked items to avoid
+ spurious duplication in todo-categories-with-marks alist and
+ corruption of the todo-categories alist. Handle empty line
+ when there are no todo items and done items are shown.
+ (todo-set-item-priority): Make noop if called from
+ todo-raise-item-priority or todo-lower-item-priority when
+ point is on a done todo item or an empty line.
+ (todo-move-item): Use markers instead of integer positions to
+ correctly handle deleting the now moved items from the source
+ category (without markers an infinite loop arises when moving
+ marked item to a preceding category).
+ (todo-unarchive-items): Put point on the (first) restored done
+ item, instead of leaving it at the end of the done items
+ separator string.
+ (todo-revert-buffer): Ensure buffer remains read-only after
+ reverting.
+
+2017-07-07 Eli Zaretskii <eliz@gnu.org>
+
+ Exclude blank columns from value of line-number-display-width
+
+ * src/indent.c (Fline_number_display_width): Don't add 2 to the
+ number of columns we return, to make this consistent with
+ display-line-number-width.
+
+2017-07-07 Eli Zaretskii <eliz@gnu.org>
+
+ Fix vertical-motion across the place where line-number width changes
+
+ * src/indent.c (line_number_display_width): New function,
+ refactored from line-number width calculations in vertical-motion.
+ (Fvertical_motion): Call line_number_display_width when the width
+ of line-number display is needed.
+ (Fline_number_display_width): New defun.
+ (syms_of_indent): Defsubr it.
+
+ * doc/lispref/display.texi (Size of Displayed Text): Document
+ line-number-display-width.
+
+ * etc/NEWS: Mention line-number-display-width.
+
+ * lisp/simple.el (last--line-number-width): New internal variable.
+ (line-move-visual): Use it to adjust temporary-goal-column when
+ line-number display changes its width.
+
+2017-07-07 Martin Rudalics <rudalics@gmx.at>
+
+ Remove Vwindow_text_change_functions and related code
+
+ Vwindow_text_change_functions had been provided for implementing
+ line numbers but apparently was never functional or in use.
+
+ * src/xdisp.c (redisplay_window): Remove handling of
+ Vwindow_text_change_functions.
+ (syms_of_xdisp): Remove Qwindow_text_change_functions.
+ (Vwindow_text_change_functions): Remove variable.
+ * doc/lispref/hooks.texi (Standard Hooks): Remove entry for
+ `window-text-change-functions'.
+
+2017-07-07 Mark Oteiza <mvoteiza@udel.edu>
+
+ Convert more uses of looking-at to following-char
+
+ More followup to Karl Fogel's commit a84da83c1.
+ * lisp/dired-aux.el (dired-add-entry, dired-subdir-hidden-p):
+ * lisp/dired-x.el (dired-mark-unmarked-files, dired-mark-sexp):
+ * lisp/help-fns.el (doc-file-to-man, doc-file-to-info):
+ * lisp/proced.el (proced-toggle-marks):
+ * lisp/progmodes/f90.el (f90-indent-line):
+ * lisp/ses.el (ses-load):
+ * lisp/tar-mode.el (tar-expunge): Replace instances of looking-at with
+ char comparisons using following-char.
+
+2017-07-07 Noam Postavsky <npostavs@gmail.com>
+
+ Don't skip epg tests (Bug#23561)
+
+ * test/lisp/epg-tests.el (with-epg-tests): Ignore REQUIRE-PASSPHRASE
+ parameter, since we supply the passphrase via pinentry-program for all
+ GPG versions (as of 2017-02-28 "Fix epg-tests with dummy-pinentry
+ program (Bug#23619)").
+ (epg-tests-program-alist-for-passphrase-callback): Remove.
+
+2017-07-06 Eli Zaretskii <eliz@gnu.org>
+
+ Implement line numbers that disregard narrowing
+
+ * src/xdisp.c (display_count_lines_logically): New function,
+ counts line numbers disregarding narrowing. Suggested by Andy
+ Moreton <andrewjmoreton@gmail.com>.
+ (maybe_produce_line_number): Call display_count_lines_logically
+ instead of display_count_lines. Adapt BEGV, ZV, etc. to
+ display-line-numbers-widen.
+ (syms_of_xdisp) <display-line-numbers-widen>: New buffer-local
+ variable.
+
+ * lisp/cus-start.el (standard): Provide a customization form for
+ display-line-numbers-widen.
+ * lisp/frame.el: Add display-line-numbers-widen,
+ display-line-numbers-current-absolute, and
+ display-line-number-width to the list of variables that should
+ trigger redisplay of the current buffer.
+
+ * doc/emacs/display.texi (Display Custom): Document
+ display-line-numbers-widen.
+
+2017-07-06 Noam Postavsky <npostavs@gmail.com>
+
+ Fix lisp-comment-indent for single-semicolon case
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-comment-indent): Only check for
+ open paren if we're looking at multiple comment characters.
+ * test/lisp/emacs-lisp/lisp-mode-tests.el (lisp-comment-indent-1)
+ (lisp-comment-indent-2): New tests.
+
+2017-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes
+
+ * lisp/org/org-table.el (org-table-sort-lines):
+ Fix misspelling in prompt.
+ * lisp/org/ox-ascii.el (org-ascii--describe-datum):
+ Fix misspelling in call to org-element-lineage.
+
+2017-07-06 Noam Postavsky <npostavs@gmail.com>
+
+ Don't put whitespace between open paren and comment in Lisp modes (Bug#19740)
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-comment-indent): If current
+ line's code ends in open paren, set comment indentation exactly to
+ column following it.
+ (lisp-mode-variables): Set `comment-indent-function' to
+ `lisp-comment-indent'.
+
+2017-07-06 Noam Postavsky <npostavs@gmail.com>
+
+ Allow comment-indent-functions to specify exact indentation (Bug#385)
+
+ * lisp/newcomment.el (comment-choose-indent): Interpret a cons of two
+ integers as indicating a range of acceptable indentation.
+ (comment-indent): Don't apply `comment-inline-offset',
+ `comment-choose-indent' already does that.
+ (comment-indent-function):
+ * doc/emacs/programs.texi (Options for Comments): Document new
+ acceptable return values.
+ * etc/NEWS: Announce it.
+
+2017-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check for integer overflow in xbm images
+
+ * src/image.c (XBM_TK_OVERFLOW): New constant.
+ (xbm_scan): Check for integer overflow instead of relying on
+ undefined behavior. Check that octal digits are actually octal.
+
+2017-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Convert hex digits more systematically
+
+ This makes the code a bit smaller and presumably faster, as
+ it substitutes a single lookup for conditional jumps.
+ * src/character.c (hexdigit): New constant.
+ (syms_of_character) [HEXDIGIT_IS_CONST]: Initialize it.
+ * src/character.h (HEXDIGIT_CONST, HEXDIGIT_IS_CONST): New macros.
+ (hexdigit): New decl.
+ (char_hexdigit): New inline function.
+ * src/charset.c: Do not include c-ctype.h.
+ * src/charset.c (read_hex):
+ * src/editfns.c (styled_format):
+ * src/image.c (xbm_scan):
+ * src/lread.c (read_escape):
+ * src/regex.c (ISXDIGIT) [emacs]:
+ Use char_hexdigit insted of doing it by hand.
+
+2017-07-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t use -Woverride-init
+
+ I have some further changes in mind that would also need to
+ disable the -Woverride-init warnings. In practice these warnings
+ seem to be more trouble than they’re worth, so disable them in the
+ cc command line.
+ * configure.ac: Disable -Woverride-init here ...
+ * src/bytecode.c: ... rather than here.
+
+2017-07-05 Glenn Morris <rgm@gnu.org>
+
+ * lisp/progmodes/python.el (auto-mode-alist): Add .pyi. (Bug#27847)
+
+ * lisp/org/ox-html.el (org-html-infojs-template): Update copyright.
+
+2017-07-05 Glenn Morris <rgm@gnu.org>
+
+ Small fix for bug-reference.el
+
+ * lisp/progmodes/bug-reference.el (bug-reference-bug-regexp):
+ Autoload safety property. (Bug#27481)
+
+2017-07-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Suppress timers in Tramp
+
+ * lisp/net/tramp.el (tramp-file-name-handler): Don't trigger timers.
+
+ * test/lisp/net/tramp-tests.el
+ (tramp-test36-asynchronous-requests): Trigger timers.
+ (tramp-test37-recursive-load, tramp-test38-remote-load-path):
+ Set `default-directory' to a trustworthy value.
+
+2017-07-05 rocky <rb@dustyfeet.com>
+
+ Add realgud face definitions
+
+ Add realgud faces to tdsh-dark-theme
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-awk.el: Mark unused args
+
+ * lisp/progmodes/cc-bytecomp.el: Mark unused args
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-defs.el (lookup-syntax-properties): Move ...
+
+ ... before first use
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-vars.el: Mark unused args
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-langs.el: Mark unused args
+
+ (c-primary-expr-regexp): Remove unused vars ambiguous-prefix-ops and
+ unambiguous-prefix-ops.
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-engine.el: Mark unused args
+
+ (c-beginning-of-statement-1, c-guess-basic-syntax):
+ Remove unused var c-in-literal-cache.
+ (c-debug-sws-msg): Silence byte-compiler, even if we don't use the arg.
+ (c-append-to-state-cache): Remove unused var `bra+1s'.
+ (c-remove-stale-state-cache): Remove unused var `pps-point-state'.
+ (c-invalidate-state-cache-1): Remove unused var `pa'.
+ (c-forward-decl-or-cast-1): Change comments so they don't look like
+ outline headers.
+ (c-restricted-<>-arglists, c-parse-and-markup-<>-arglists):
+ Declare before first use.
+ (c-forward-decl-or-cast-1): Remove unused var `backup-kwd-sym'.
+ (c-backward-over-enum-header): Remove unused var `up-sexp-pos'.
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-cmds.el: Remove unused vars
+
+ (c-syntactic-context): Declare as dynbound.
+ (c-beginning-of-defun, c-end-of-defun): Remove unused var `start'.
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-guess.el: Remove unused var
+
+ (c-guess-view-reorder-offsets-alist-in-style): Remove redundantly bound
+ and computed variable `guessed-syntactic-symbols'.
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-align.el: Mark unused arguments
+
+2017-07-05 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-mode.el: Mark unused arguments
+
+ (c-parse-quotes-before-change, c-parse-quotes-after-change):
+ Remove unused vars.
+
+2017-07-05 Noam Postavsky <npostavs@gmail.com>
+
+ Mention `ffap-url-unwrap-local' in find-file-at-point's docstring (Bug#27564)
+
+ * lisp/ffap.el (find-file-at-point): Mention `ffap-url-unwrap-local'
+ and `ffap-url-unwrap-remote'.
+
+2017-07-05 Noam Postavsky <npostavs@gmail.com>
+
+ Fix infloop in uncomment-region-default (Bug#27112)
+
+ When `comment-continue' has only blanks, `comment-padright' produces a
+ regexp that matches the empty string, so `uncomment-region-default'
+ will loop infinitely.
+ * lisp/newcomment.el (comment-padright): Only return a regexp if STR
+ has nonblank characters.
+
+2017-07-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of current line number in visual mode
+
+ * src/xdisp.c (maybe_produce_line_number): Fix visual-mode display
+ of current line when line-number-current-line face was customized.
+ Reported by Filipe Silva <filipe.silva@gmail.com>.
+
+2017-07-03 Philipp Stephani <phst@google.com>
+
+ Use hook instead of face list to inhibit electric quoting
+
+ This is more flexible and doesn't couple electric quoting to font
+ locking.
+ Give that 'electric-quote-code-faces' was just introduced, remove it
+ without formal deprecation.
+
+ * lisp/electric.el (electric-quote-inhibit-functions): New abnormal
+ hook variable.
+ (electric-quote-post-self-insert-function): Run the hook. Remove
+ use of old 'electric-quote-code-faces' variable.
+
+ * test/lisp/electric-tests.el (electric-quote-markdown-in-text)
+ (electric-quote-markdown-in-code): Adapt unit tests.
+
+2017-07-03 Ingo Lohmar <i.lohmar@gmail.com>
+
+ Offer non-aligned indentation in lists in js-mode (Bug#27503)
+
+ * lisp/progmodes/js.el (js--proper-indentation):
+ New customization option 'js-indent-align-list-continuation'.
+ Affects argument lists as well as arrays and object properties.
+ * test/manual/indent/js-indent-align-list-continuation-nil.js:
+ Test the change.
+
+2017-07-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid errors in vertical-motion when buffer is narrowed
+
+ * src/indent.c (Fvertical_motion): If need to start from
+ window-start, and it is outside of the accessible portion,
+ temporarily widen the buffer. This avoids errors in evil-mode.
+ Reported by James Nguyen <james@jojojames.com>.
+
+2017-07-03 Michael Albinus <michael.albinus@gmx.de>
+
+ (Re-)activate remote tests of filenotify-tests.el
+
+ * test/lisp/filenotify-tests.el
+ (file-notify-test-remote-temporary-file-directory):
+ Declare default host for mock method. Offer home directory
+ for mock method if it doesn't exist.
+ (file-notify-test09-watched-file-in-watched-dir-remote):
+ Remove, it doesn't work reliably.
+
+2017-07-03 Noam Postavsky <npostavs@gmail.com>
+
+ Reset ansi escape context before printing eshell prompt (Bug#27407)
+
+ * lisp/eshell/em-prompt.el (eshell-emit-prompt): Reset
+ `ansi-color-context-region'.
+
+2017-07-03 Noam Postavsky <npostavs@gmail.com>
+
+ Let ansi-color overlay hooks work in eshell (Bug#27407)
+
+ * lisp/ansi-color.el (ansi-color-make-extent): Add
+ `ansi-color-freeze-overlay' to `insert-behind-hooks' as well.
+ * lisp/eshell/esh-mode.el (eshell-output-filter): Let-bind
+ `inhibit-modification-hooks' to nil while inserting the string.
+
+2017-07-03 Noam Postavsky <npostavs@gmail.com>
+
+ Fix and simplify ansi escape detection (Bug#21381)
+
+ * lisp/ansi-color.el (ansi-color-regexp, ansi-color-drop-regexp):
+ Remove.
+ (ansi-color-control-seq-regexp): New constant, matches all escape
+ sequences.
+ (ansi-color-filter-apply, ansi-color-apply)
+ (ansi-color-filter-region, ansi-color-apply-on-region): Use it instead
+ of matching color sequences separately from ignored sequences.
+ Differentiate color sequences simply by checking the last character.
+
+2017-07-03 Damien Cassou <damien@cassou.me>
+
+ Add absolute optional parameter to line-number-at-pos (Bug#26417)
+
+ * lisp/simple.el (line-number-at-pos): Add a second optional
+ argument 'absolute'.
+ * test/lisp/simple-tests.el: Add tests for 'line-number-at-pos'.
+
+2017-07-03 R. Bernstein <rocky@gnu.org>
+
+ Add realgud faces
+
+2017-07-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix tramp-tests.el for hydra
+
+ * test/Makefile.in: Remove instrumentation for tramp-tests.
+
+ * test/lisp/net/tramp-tests.el (tramp-test36-asynchronous-requests):
+ Remove instrumentation. Wrap with a timeout. Give hydra
+ another timer value. Set `default-directory' in timer.
+
+2017-07-03 Bastien <bzg@gnu.org>
+
+ Merge branch 'master' into scratch/org-mode-merge
+
+ Merge branch 'master' into scratch/org-mode-merge
+
+2017-07-03 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-do-shell-command: Fix check for wildcards
+
+ * lisp/dired-aux.el (dired-do-shell-command): Replace just '?', '*'
+ and '`?' i.e., keep the whitespaces.
+ * test/lisp/dired-aux-tests.el (dired-test-bug27496): Add test.
+
+2017-07-02 Noam Postavsky <npostavs@gmail.com>
+
+ Split shr-copy-url dwim behavior into separate functions (Bug#26826)
+
+ * lisp/net/shr.el (shr-url-at-point, shr-probe-url)
+ (shr-probe-and-copy-url, shr-maybe-probe-and-copy-url): New functions,
+ split out from `shr-copy-url'.
+ (shr-copy-url): Only copy the url, don't fetch it.
+ (shr-map): Bind 'w' and 'u' to `shr-maybe-probe-and-copy-url', which
+ has the same behavior as the old `shr-copy-url'.
+ * etc/NEWS: Announce changes.
+
+2017-07-02 Alex Branham <branham@utexas.edu> (tiny change)
+
+ Make eww-search-words prompt for query if nothing selected
+
+ * lisp/net/eww.el (eww-search-words): Make eww-search-words prompt the
+ user for a search query if the region is inactive or if the region is
+ just whitespace.
+
+2017-07-02 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-compiled-button): t by default.
+
+ * lisp/emacs-lisp/debug.el (debugger-insert-backtrace):
+ * lisp/help-fns.el (describe-variable): No need to let-bind
+ `cl-print-compiled-button' to t anymore.
+
+2017-07-02 Philipp Stephani <phst@google.com>
+
+ Electric quotes: Improve support for Markdown mode (Bug#24709)
+
+ Introduce a new user option 'electric-quote-context-sensitive'. If
+ non-nil, have ' insert an opening quote if sensible.
+
+ Also introduce a new variable 'electric-quote-code-faces'. Major
+ modes such as 'markdown-mode' can add faces to this list to treat text
+ as inline code and disable electric quoting.
+
+ * lisp/electric.el (electric-quote-context-sensitive): New user
+ option.
+ (electric-quote-code-faces): New variable.
+ (electric-quote-post-self-insert-function): Treat ' as ` if
+ desired and applicable; disable electric quoting for given faces.
+
+ * test/lisp/electric-tests.el (electric-quote-opening-single)
+ (electric-quote-closing-single, electric-quote-opening-double)
+ (electric-quote-closing-double)
+ (electric-quote-context-sensitive-backtick)
+ (electric-quote-context-sensitive-bob-single)
+ (electric-quote-context-sensitive-bob-double)
+ (electric-quote-context-sensitive-bol-single)
+ (electric-quote-context-sensitive-bol-double)
+ (electric-quote-context-sensitive-after-space-single)
+ (electric-quote-context-sensitive-after-space-double)
+ (electric-quote-context-sensitive-after-letter-single)
+ (electric-quote-context-sensitive-after-letter-double)
+ (electric-quote-context-sensitive-after-paren-single)
+ (electric-quote-context-sensitive-after-paren-double)
+ (electric-quote-markdown-in-text)
+ (electric-quote-markdown-in-code): New unit tests.
+
+2017-07-02 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/misc/tramp.texi: Replace ftp:// and http:// URLs by https://.
+
+2017-07-02 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid off-by-one errors in column C-n/C-p calculations
+
+ * src/indent.c (Fvertical_motion): Help C-n/C-p estimate correctly
+ the width used up by line numbers by looking near the window-start
+ point.
+
+2017-07-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Ask confirmation for all suspicious wildcards
+
+ * lisp/dired-aux.el (dired-do-shell-command): Check that all
+ the wildcards are right. Otherwise, ask for confirmation (Bug#27496).
+
+2017-07-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Extend dired-do-shell-command substitutions
+
+ Substitute "`?`" inside command with the current file name.
+ See details in:
+ https://lists.gnu.org/r/emacs-devel/2017-06/msg00618.html
+ * lisp/dired-aux.el (dired-quark-subst-regexp, dired-star-subst-regexp):
+ Mark as obsolete.
+ (dired-isolated-string-re): New defun.
+ (dired--star-or-qmark-p): New predicate.
+ (dired-do-shell-command): Use dired--star-or-qmark-p. Substitute "`?`"
+ with the current file name.
+ * doc/emacs/dired.texi (Shell Commands in Dired): Update manual.
+
+2017-07-02 Alan Mackenzie <acm@muc.de>
+
+ Fix bug in yesterday's CC Mode commit.
+
+ * lisp/progmodes/cc-mode.el (c-quoted-number-head-before-point): Check a
+ search has succeded before using the match data.
+ (c-quoted-number-head-before-point, c-quoted-number-head-after-point):
+ Specify that the position of the extremity of the head or tail is in the
+ match data.
+
+2017-07-02 Philipp Stephani <phst@google.com>
+
+ Remove FIXME comments about sentinel values
+
+ These FIXMEs can't be addressed because they would require breaking
+ changes to the module API. Furthermore, other module functions don't
+ return sentinel values as well, so users generally have to call
+ non_local_exit_check anyway.
+
+ * src/emacs-module.c (module_set_user_ptr)
+ (module_set_user_finalizer, module_vec_set, module_vec_size): Remove
+ FIXME comments.
+
+2017-07-02 Philipp Stephani <phst@google.com>
+
+ Adapt Lisp reference to reader changes
+
+ The reader now warns about some unescaped character literals, but
+ still allows them for compatibility reasons. Slightly adapt the
+ manual to forbid them officially.
+
+ * doc/lispref/objects.texi (Basic Char Syntax): Document that
+ backslashes are now required before some characters.
+
+2017-07-02 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#27502
+
+ * lisp/autorevert.el (auto-revert-find-file-function): New defun.
+ (find-file-hook): Use it. (Bug#27502)
+ (auto-revert-remove-current-buffer): New defun.
+ (auto-revert-mode, auto-revert-buffers): Use it.
+
+2017-07-02 Noam Postavsky <npostavs@gmail.com>
+
+ Let test summary go through even if some logs were not generated
+
+ * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): Check
+ for existence of log files before reading.
+
+2017-07-01 Philipp Stephani <phst@google.com>
+
+ * src/module-env-25.h (copy_string_contents): Fix comment.
+
+2017-07-01 Philipp Stephani <phst@google.com>
+
+ Also mark module init function as noexcept if possible
+
+ * src/emacs-module.h.in (emacs_module_init): Mark as noexcept if
+ possible.
+
+2017-07-01 Philipp Stephani <phst@google.com>
+
+ Improve C++98 compatibility
+
+ * src/emacs-module.h.in (emacs_funcall_exit): Lose trailing comma.
+ C++98 doesn't allow trailing commas in enumerations.
+
+2017-07-01 Eli Zaretskii <eliz@gnu.org>
+
+ Minor copyedits of manuals regarding bidi conformance
+
+ * doc/emacs/mule.texi (Bidirectional Editing):
+ * doc/lispref/display.texi (Bidirectional Display): Update the
+ bidi conformance text.
+
+2017-07-01 Alan Mackenzie <acm@muc.de>
+
+ Make C++ digit separators work. Amend the handling of single quotes generally
+
+ Single quotes, even in strings and comments, are now marked with the
+ "punctuation" syntax-table property, except where they are validly bounding a
+ character literal. They are font locked with font-lock-warning-face except
+ where they are valid. This is done in C, C++, ObjC, and Java Modes.
+
+ * lisp/progmodes/cc-defs.el (c-clear-char-property-with-value-on-char-function)
+ (c-clear-char-property-with-value-on-char, c-put-char-properties-on-char): New
+ functions/macros.
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-invalid-single-quotes): New function.
+ (c-basic-matchers-before): invoke c-font-lock-invalid-single-quotes.
+
+ * lisp/progmodes/cc-langs.el (c-get-state-before-change-functions): Remove
+ c-before-after-change-digit-quote from wherever it occurs. Insert
+ c-parse-quotes-before-change into the entries for the languages where it is
+ needed.
+ (c-before-font-lock-functions): Remove c-before-after-change-digit-quote from
+ wherever it occurs. Insert c-parse-quotes-after-change into the entries for
+ the languages which need it.
+ (c-has-quoted-numbers): New lang-defconst/-defvar.
+
+ * lisp/progmodes/cc-mode.el (c-before-after-change-digit-quote): Remove.
+ (c-maybe-quoted-number-head, c-maybe-quoted-number-tail)
+ (c-maybe-quoted-number): New defconsts.
+ (c-quoted-number-head-before-point, c-quoted-number-tail-after-point)
+ (c-quoted-number-straddling-point, c-parse-quotes-before-change)
+ (c-parse-quotes-after-change): New functions.
+
+2017-07-01 Noam Postavsky <npostavs@gmail.com>
+
+ Ignore mouse-movement for describe-key-briefly (Bug#12204)
+
+ * lisp/help.el (help-read-key-sequence): Add optional argument ot
+ ignore `mouse-movement' events.
+ (describe-key-briefly): Use it.
+ * doc/emacs/help.texi (Key Help):
+ * etc/NEWS: Mention that mouse movement is ignored.
+
+2017-07-01 Noam Postavsky <npostavs@gmail.com>
+
+ Refactor key describing commands
+
+ * lisp/help.el (help-read-key-sequence, help--analyze-key): New
+ functions, extracted from `describe-key' and `describe-key-briefly'.
+ (describe-key, describe-key-briefly): Use them.
+
+2017-07-01 Eli Zaretskii <eliz@gnu.org>
+
+ Improve display of tabs with line numbers
+
+ * src/xdisp.c (x_produce_glyphs): Improve calculation of next tab
+ stop in hscrolled lines. Prevent aborts in compute_line_metrics.
+
+2017-07-01 Alan Third <alan@idiocy.org>
+
+ Fix threads on NS (bug#25265)
+
+ src/nsterm.h (ns_select): Compiler doesn't like sigmask being const.
+ (ns_run_loop_break) [HAVE_PTHREAD]: New function.
+ src/nsterm.m (ns_select): Call thread_select from within ns_select.
+ (ns_run_loop_break) [HAVE_PTHREAD]: New function.
+ (ns_send_appdefined): Don't wait for main thread when sending app
+ defined event.
+ src/process.c (wait_reading_process_output): Call thread_select from
+ within ns_select.
+ src/systhread.c (sys_cond_broadcast) [HAVE_NS]: Break ns_select out of
+ its event loop using ns_run_loop_break.
+
+2017-07-01 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid slow redisplay under 'visual' mode of line numbers
+
+ * src/xdisp.c (display_count_lines_visually): Avoid very slow
+ redisplay when this function is invoked very far from point.
+ Reported by Alex <agrambot@gmail.com>.
+
+2017-07-01 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/help-fns.el (describe-variable): Let-bind cl-print-compiled-button.
+
+2017-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-extra.el (cl--random-state): New defstruct
+
+ (cl--random-state, cl--random-time): Move from cl-lib.el.
+ (cl-random): Use struct accessors.
+ (cl-random-state-p): Remove, provided by the defstruct.
+ (cl-make-random-state): Rewrite to struct constructor.
+
+2017-07-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/debug.el (debugger-list-functions): Remove obsolete msg
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of faces related to display-line-numbers
+
+ * lisp/faces.el (line-number, line-number-current-line): Warn
+ against using non-monospaced fonts.
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Fix relative-number display with non-nil display-line-number-width
+
+ * src/xdisp.c (maybe_produce_line_number): Don't treat a zero
+ value of display-line-number-width as acceptable.
+ Handle the case of 'relative' with display-line-number-width
+ non-nil and smaller than the absolute line number requires.
+ Reported by Alex <agrambot@gmail.com>.
+
+2017-06-30 Michael Albinus <michael.albinus@gmx.de>
+
+ Release Tramp 2.3.2
+
+ * doc/misc/tramp.texi (Android shell setup): Show default file name.
+ Structure section.
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.3.2".
+
+ * test/lisp/net/tramp-tests.el (tramp-test-temporary-file-directory):
+ Offer home directory for mock method if it doesn't exist.
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Add documentation for display-line-numbers
+
+ * doc/emacs/custom.texi (Init Rebinding):
+ * doc/emacs/modes.texi (Minor Modes): Remove references to
+ linum-mode.
+ * doc/emacs/display.texi (Display Custom): Describe the
+ line-number display.
+ (Optional Mode Line): Fix the index entry to not conflict with
+ that in "Display Custom".
+ * doc/emacs/basic.texi (Position Info): Add cross-reference to
+ "Display Custom", for line-number display.
+
+ * src/xdisp.c (syms_of_xdisp): <display-line-numbers>: Mention
+ display-line-numbers-disable in the doc string.
+
+ * lisp/cus-start.el (standard): Fix lst change.
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Support displaying zero as the number of the current line
+
+ * src/xdisp.c (syms_of_xdisp)
+ <display-line-numbers-current-absolute>: New variable.
+ <display-line-numbers>: Doc fix.
+ (maybe_produce_line_number): Support nil value of
+ display-line-numbers-current-absolute.
+
+ * lisp/cus-start.el (standard): Add customization form for
+ display-line-numbers-current-absolute.
+
+ * etc/NEWS: Document recently introduced features.
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Speed up the visual-mode relative line numbers
+
+ * src/xdisp.c (display_count_lines_visually): Introduce a
+ shortcut: if a relative line number was already calculated for
+ this iterator object, just increase it instead of the
+ expensive call to move_it_to. Argument list changed to pass a
+ pointer to the iterator object.
+ (maybe_produce_line_number): Adjust for change in signature of
+ display_count_lines_visually. Record the relative line number and
+ the corresponding byte position in the iterator object also in the
+ 'visual' mode.
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Fix hscrolling with line numbers on TTY frames
+
+ * src/xdisp.c (hscroll_window_tree): Correct the X offset
+ calculations on TTY frames.
+ * src/term.c (produce_glyphs): Use it->lnum_pixel_width instead of
+ a kludge using it->lnum_width.
+
+2017-06-30 Eli Zaretskii <eliz@gnu.org>
+
+ Fix TAB display when the line-number face uses a smaller/larger font
+
+ * src/dispextern.h (struct it): New member lnum_pixel_width.
+ * src/xdisp.c (maybe_produce_line_number): Compute the width of
+ the line-number display in pixels.
+ (x_produce_glyphs): Use it->lnum_pixel_width instead of a kludge
+ that used it->lnum_width and made assumptions about pixel width.
+
+2017-06-30 Noam Postavsky <npostavs@gmail.com>
+
+ Escape NUL bytes in X selections (Bug#6991)
+
+ * lisp/term/w32-win.el (w32--set-selection):
+ * lisp/select.el (xselect--encode-string): Replace NUL bytes with
+ "\0".
+ * doc/emacs/killing.texi: Document new behavior.
+ * etc/NEWS (times): Announce it.
+
+2017-06-30 Noam Postavsky <npostavs@gmail.com>
+
+ Hide byte code in backtraces (Bug#6991)
+
+ * lisp/emacs-lisp/debug.el (debugger-print-function): New defcustom,
+ defaulting to `cl-print'.
+ (debugger-insert-backtrace, debugger-setup-buffer): Use it instead of
+ `prin1'.
+ * etc/NEWS: Announce it.
+
+2017-06-30 Noam Postavsky <npostavs@gmail.com>
+
+ Don't redundantly cl-print arglist in function docstring again
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-object): Don't print arglist
+ part of docstring.
+ * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-1): Update
+ test accordingly.
+
+2017-06-30 Noam Postavsky <npostavs@gmail.com>
+
+ Escape control characters in backtraces (Bug#6991)
+
+ * src/print.c (syms_of_print): Add new variable,
+ print-escape-control-characters.
+ (print_object): Print control characters with octal escape codes when
+ print-escape-control-characters is true.
+ * lisp/subr.el (backtrace):
+ * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Bind
+ `print-escape-control-characters' to t.
+
+2017-06-30 Noam Postavsky <npostavs@gmail.com>
+
+ Improve ert backtrace recording
+
+ Change ert to use the new `backtrace-frames' function instead of
+ collecting frames one by one with `backtrace-frame'. Additionally,
+ collect frames starting from `signal' instead the somewhat arbitrary
+ "6 from the bottom". Skipping 6 frames would skip the expression that
+ actually caused the signal that triggered the debugger. Possibly 6
+ was chosen because in the case of a failed test, the triggering frame
+ is an `ert-fail' call, which is not so interesting. But in case of a
+ test throwing an error, this drops the `error' call which is too much.
+
+ * lisp/emacs-lisp/debug.el (debugger-make-xrefs): Remove.
+ * lisp/emacs-lisp/ert.el (ert--make-xrefs-region): Bring in relevant
+ code from `debugger-make-xrefs'.
+ (ert--print-backtrace): Add DO-XREFS parameter, delegate to
+ `debugger-insert-backtrace'.
+ (ert--run-test-debugger): Record the backtrace frames starting from
+ the instigating `signal' call.
+ (ert-run-tests-batch): Pass nil for `ert--print-backtrace's new
+ DO-XREFS parameter.
+ (ert-results-pop-to-backtrace-for-test-at-point): Pass t as DO-XREFS
+ to `ert--print-backtrace' and remove call to `debugger-make-xrefs'.
+ * test/lisp/emacs-lisp/ert-tests.el (ert-test-record-backtrace): Check
+ the backtrace list instead of comparing its string representation.
+ Expect `signal' to be the first frame.
+
+2017-06-30 Noam Postavsky <npostavs@gmail.com>
+
+ Operate on frame list instead of printed backtrace
+
+ * lisp/emacs-lisp/debug.el (debugger-insert-backtrace): New function,
+ prints the given backtrace frames.
+ (debugger-setup-buffer): Use it instead of editing the backtrace
+ buffer text.
+
+2017-06-29 Eli Zaretskii <eliz@gnu.org>
+
+ Minor fixes
+
+ * src/xdisp.c (maybe_produce_line_number): Fix bug that caused
+ line numbers to be displayed in empty lines beyond ZV.
+ (x_produce_glyphs): Start fixing TAB display in truncated lines.
+
+2017-06-29 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve timer handling when Tramp accepts output
+
+ * lisp/net/tramp-compat.el: Avoid compiler warning.
+
+ * lisp/net/tramp-sh.el (tramp-sh-file-name-handler):
+ Remove lock machinery.
+
+ * lisp/net/tramp.el (tramp-locked, tramp-locker): Move up.
+ (tramp-file-name-handler): Add lock machinery from
+ `tramp-sh-file-name-handler'. Allow timers to run.
+ (tramp-accept-process-output): Remove nasty workaround.
+ Suppress timers.
+
+ * test/lisp/net/tramp-tests.el (shell-command-sentinel):
+ Suppress run in tests.
+ (tramp--instrument-test-case-p): New defvar.
+ (tramp--instrument-test-case): Use it in order to allow nested calls.
+ (tramp--test-message, tramp--test-backtrace): New defsubst,
+ will be used for occasional test instrumentation.
+ (tramp-test00-availability, tramp-test31-vc-registered): Use them.
+ (tramp-test28-shell-command)
+ (tramp--test-shell-command-to-string-asynchronously): Suppress
+ nasty messages. Don't overwrite sentinel.
+ (tramp-test36-asynchronous-requests): Rewrite major parts.
+ Expect :passed.
+
+2017-06-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/url/url-history.el: Use lexical-binding
+
+ (url-completion-function): Mark as obsolete.
+ Mark unused args accordingly.
+
+2017-06-28 Noam Postavsky <npostavs@gmail.com>
+
+ Don't assume url structs are vectors (Bug#27333)
+
+ * lisp/url/url-history.el (url-history-update-url): Use `url-p'
+ instead of `vectorp'.
+
+2017-06-28 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace with dolist some uses of while
+
+ * lisp/calc/calc-units.el (calc-permanent-units):
+ (math-compare-unit-names, math-simplify-units-quotient):
+ (math-build-units-table-buffer): Use dolist to replace extra bindings
+ and some while loops.
+
+2017-06-28 Noam Postavsky <npostavs@gmail.com>
+
+ Make tcl-auto-fill-mode obsolete (Bug#10772)
+
+ * lisp/progmodes/tcl.el (tcl-auto-fill-mode): Declare obsolete.
+ * etc/NEWS: Announce it.
+
+2017-06-28 Noam Postavsky <npostavs@gmail.com>
+
+ Don't read eshell/which output from *Help* buffer (Bug#26894)
+
+ * lisp/help-fns.el (help-fns--analyse-function)
+ (help-fns-function-description-header): New functions, extracted from
+ describe-function-1.
+ (describe-function-1): Use them.
+ * lisp/eshell/esh-cmd.el (eshell/which): Use
+ `help-fns-function-description-header' instead of
+ `describe-function-1'.
+
+2017-06-27 Eli Zaretskii <eliz@gnu.org>
+
+ Support default-text-properties
+
+ * src/xdisp.c (should_produce_line_number): Call get-char-property
+ at ZV as well, to support default-text-properties.
+
+2017-06-27 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid segfaults when some display vector is an empty string
+
+ * src/xdisp.c (next_element_from_display_vector): Don't try
+ accessing the dpvec[] array if its size is zero. (Bug#27504)
+
+2017-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ Initial support for visually-relative line numbers
+
+ Works very slowly.
+
+ * src/xdisp.c (display_count_lines_visually): New function.
+ (maybe_produce_line_number): Support 'visual' mode of line-number
+ display.
+ * src/xdisp.c (maybe_produce_line_number): Update IT's metrics
+ also when glyph_row is NULL. This is important for move_it_*
+ functions.
+ (syms_of_xdisp) <display-line-number-width>: Now buffer-local.
+ (try_window_id, redisplay_window, try_cursor_movement): For
+ 'visual' line-number display, disable the same redisplay
+ optimizations as for 'relative'.
+
+ * lisp/cus-start.el (standard): Add new value for the
+ customization form of display-line-numbers.
+
+2017-06-26 Eli Zaretskii <eliz@gnu.org>
+
+ Update IT's metrics while simulating display
+
+ * src/xdisp.c (maybe_produce_line_number): Update IT's metrics
+ also when glyph_row is NULL. This is important for move_it_*
+ functions.
+
+2017-06-26 Teemu Likonen <tlikonen@iki.fi>
+
+ Fix bug in handling GnuPG's TRUST_MARGINAL status
+
+ * lisp/epg.el (epg--status-TRUST_MARGINAL): Change symbol `marginal'
+ to `good'.
+
+2017-06-26 Tino Calancha <tino.calancha@gmail.com>
+
+ Prefer `when' instead of 1-branch `if'
+
+ * lisp/dired-aux.el (dired-do-shell-command): Store condition value
+ in local variable ok.
+ Use `when' instead of 1-branch `if'.
+
+2017-06-26 Tino Calancha <tino.calancha@gmail.com>
+
+ Use #' instead of (function ...)
+
+ * lisp/dired-aux.el (dired-do-chxxx, dired-clean-directory)
+ (dired-mark-confirm, dired-query, dired-byte-compile)
+ (dired-load, dired-update-file-line, dired-after-subdir-garbage)
+ (dired-relist-file, dired-rename-subdir, dired-do-create-files)
+ (dired-mark-read-file-name, dired-do-copy, dired-do-symlink)
+ (dired-do-hardlink, dired-do-rename, dired-do-rename-regexp)
+ (dired-do-copy-regexp, dired-do-hardlink-regexp)
+ (dired-do-symlink-regexp, dired-create-files-non-directory)
+ (dired-upcase, dired-downcase)
+
+ * lisp/dired.el (dired-mode, dired-copy-filename-as-kill)
+ (dired-internal-do-deletions, dired-internal-do-deletions):
+ Prefer #' instead of (function ...).
+
+2017-06-26 Tino Calancha <tino.calancha@gmail.com>
+
+ Don't quote lambda forms
+
+ * lisp/dired.el (dired-re-maybe-mark, dired-map-over-marks)
+ (dired-mark, dired-desktop-buffer-misc-data)
+
+ * lisp/dired-aux.el (dired-do-create-files, dired-do-create-files-regexp)
+ (dired-create-files-non-directory, dired-insert-subdir-validate)
+ (dired-alist-sort, dired-do-shell-command): Don't quote lambda forms.
+
+2017-06-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/cc-fonts.el: Remove/mark unused vars
+
+ (c-font-lock-declarators): Remove unused vars `id-end', `paren-depth',
+ and `brackets-after-id'.
+ (c-font-lock-objc-methods): Mark unused args.
+
+2017-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Omit null-pointer test in intervals.h FRAME
+
+ * src/intervals.h (ROOT_INTERVAL_P, ONLY_INTERVAL_P)
+ (INTERVAL_LAST_POS): Omit unnecessary parens.
+ (LENGTH): Omit test for null pointer. The argument is never null.
+ The unnecessary test causes GCC 7.1.0 to assume that the argument
+ might be null, and therefore to issue false alarms when the
+ argument is dereferenced in other expressions.
+
+2017-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Parenthesize frame.h macro definitions
+
+ * src/frame.h (FRAME_TOOL_BAR_POSITION)
+ (FRAME_VERTICAL_SCROLL_BAR_TYPE, FRAME_HAS_VERTICAL_SCROLL_BARS)
+ (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT)
+ (FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT)
+ (FRAME_OVERRIDE_REDIRECT, FRAME_UNDECORATED, FRAME_PARENT_FRAME)
+ (FRAME_SKIP_TASKBAR, FRAME_NO_FOCUS_ON_MAP)
+ (FRAME_NO_ACCEPT_FOCUS, FRAME_NO_SPECIAL_GLYPHS, FRAME_Z_GROUP)
+ (FRAME_Z_GROUP_NONE, FRAME_Z_GROUP_ABOVE, FRAME_Z_GROUP_BELOW)
+ (FRAME_HAS_HORIZONTAL_SCROLL_BARS): Parenthesize macro definiens
+ to allow arbitrary expression arguments.
+
+2017-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port recent frame changes to GCC 7
+
+ * src/frame.c (keep_ratio): New arg P. Caller changed. Since it
+ is non-null, it avoids a GCC 7 warning that FRAME_PARENT_FRAME
+ might return null. This also avoids a run-time test.
+
+2017-06-25 Eli Zaretskii <eliz@gnu.org>
+
+ Minor aesthetic fix of last change.
+
+2017-06-25 Eli Zaretskii <eliz@gnu.org>
+
+ Allow to disable display of line numbers beyond EOB
+
+ * src/buffer.c (disable_line_numbers_overlay_at_eob): New
+ function.
+ * src/lisp.h (disable_line_numbers_overlay_at_eob): Add prototype.
+ * src/xdisp.c (should_produce_line_number): When at ZV, call
+ disable_line_numbers_overlay_at_eob to determine whether line
+ numbers should be displayed beyond ZV.
+
+2017-06-25 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Android 6/7 problems in Tramp
+
+ * lisp/net/tramp-adb.el (tramp-adb-ls-toolbox-regexp): Fix link part.
+ (tramp-adb-handle-directory-files-and-attributes)
+ (tramp-adb-handle-file-name-all-completions): Insert "." and
+ ".." only when needed.
+ (tramp-adb-get-ls-command): Force one column output for toybox.
+
+2017-06-25 Stefan-W. Hahn <stefan.hahn@s-hahn.de> (tiny change)
+
+ * lisp/subr.el (setq-local): Add debug declaration (Bug#27408).
+
+2017-06-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix line number display for overlay/display strings with newlines
+
+ * src/xdisp.c (maybe_produce_line_number): Fix the condition for
+ producing space glyphs instead of a line number to include the
+ case of display strings and overlays.
+
+2017-06-25 Alan Mackenzie <acm@muc.de>
+
+ Make CC Mode load cl-lib rather than cl in Emacs 26.
+
+ * lisp/progmodes/cc-cmds.el (c-declaration-limits): Remove unused local
+ variable.
+
+ * lisp/progmodes/cc-defs.el (c--mapcan-status): Remove.
+ (c--cl-library): New variable.
+ (Top level): Amend the form which requires library cl or cl-lib.
+ (c--mapcan, c--set-difference, c--intersection, c--macroexpand-all)
+ (c--delete-duplicate): Amend to use c--cl-library instead of
+ c--mapcan-status.
+
+ * lisp/progmodes/cc-engine.el (c-syntactic-skip-backward)
+ (c-back-over-compound-identifier): Remove unused local variables.
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-declarations): Remove an unused
+ local variable.
+
+ * lisp/progmodes/cc-langs.el (Top level): Amend to use c--cl-library instead
+ of c--mapcan-status.
+
+ * lisp/progmodes/cc-styles.el (Top level): Add a cc-bytecomp-defun to try to
+ silence a compiler warning.
+
+2017-06-25 Martin Rudalics <rudalics@gmx.at>
+
+ Provide additional support for child frames
+
+ Provide mouse dragging and resizing of frames. Allow resizing
+ frames proportionally. Provide additional functionality for
+ child frames. Minor bug fixes.
+
+ * lisp/frame.el (frame-border-width, frame-pixel-width)
+ (frame-pixel-height): Alias to `frame-internal-border-width',
+ `frame-native-width' and `frame-native-height'.
+ (frame-inner-width, frame-inner-height, frame-outer-width)
+ (frame-outer-height): New functions.
+ * lisp/minibuffer.el (completion-auto-help): Fix typo.
+ * lisp/mouse.el (mouse-drag-line, mouse-drag-mode-line)
+ (mouse-drag-header-line): Allow moving a frame by dragging the
+ mode line of its bottommost window (on a minibuffer-less frame)
+ or the header line of its topmost window.
+ (mouse-drag-vertical-line): Mention argument in doc-string.
+ (mouse-resize-frame, mouse-drag-frame, mouse-drag-left-edge)
+ (mouse-drag-top-left-corner, mouse-drag-top-edge)
+ (mouse-drag-top-right-corner, mouse-drag-right-edge)
+ (mouse-drag-bottom-right-corner, mouse-drag-bottom-edge)
+ (mouse-drag-bottom-left-corner): New functions for resizing a
+ frame by dragging its internal border together with
+ corresponding key bindings.
+ * lisp/tooltip.el (tooltip-frame-parameters): Add
+ 'no-special-glyphs' to default parameters and update version
+ tag.
+ * lisp/window.el (frame-auto-hide-function): Add choice to make
+ frame invisible and update version tag.
+ (window--delete): Handle 'auto-hide-function' frame parameter.
+ (window--maybe-raise-frame): Respect 'no-focus-on-map' and
+ 'no-accept-focus' frame parameters.
+ (display-buffer--action-function-custom-type): Add
+ `display-buffer-in-child-frame'.
+ (display-buffer): Mention `display-buffer-in-child-frame' in
+ doc-string.
+ (display-buffer-in-child-frame): New action function for
+ `display-buffer'.
+ (window--sanitize-margin): Return zero when MARGIN cannot be
+ sanitized.
+ (fit-frame-to-buffer): Major rewrite to handle child frames and
+ 'fit-frame-to-buffer-sizes' and 'fit-frame-to-buffer-margins'
+ frame parameters.
+ (window-largest-empty-rectangle--maximums-1)
+ (window-largest-empty-rectangle--maximums)
+ (window-largest-empty-rectangle--disjoint-maximums)
+ (window-largest-empty-rectangle): New functions.
+
+ * src/dispextern.h (WINDOW_WANTS_MODELINE_P)
+ (WINDOW_WANTS_HEADER_LINE_P): Remove. Functionality is now
+ provided by corresponding functions window_wants_modeline and
+ window_wants_header_line in window.c. Adjust users.
+ * src/dispnew.c (adjust_glyph_matrix)
+ (buffer_posn_from_coords): Use window_wants_modeline and
+ window_wants_header_line instead of WINDOW_WANTS_MODELINE_P and
+ WINDOW_WANTS_HEADER_LINE_P.
+ * src/frame.c (keep_ratio): New function.
+ (adjust_frame_size): Call keep_ratio for each of F's child
+ frames.
+ (make_frame): Initialize no_special_glyphs slot.
+ (frame_internal_border_part): New function.
+ (Fframe_pixel_width, Fframe_pixel_height, Fborder_width): Rename
+ to Fframe_native_width, Fframe_native_height mand
+ Fframe_internal_border_width.
+ (frame_parm_table): Add Qno_special_glyphs entry.
+ (frame_float_type): New enumeration type.
+ (frame_float): New function to handle frame size and position
+ ratios.
+ (x_set_frame_parameters): Handle size and position ratios.
+ (x_set_no_special_glyphs): New function
+ (x_figure_window_size): Handle size and position ratios.
+ (syms_of_frame): Add Qdisplay_monitor_attributes_list,
+ Qno_special_glyphs, Qframe_edges, Qkeep_ratio, Qwidth_only,
+ Qheight_only, Qleft_only and Qtop_only.
+ * src/frame.h (internal_border_part): New enumeration type.
+ (struct frame): New slot no_special_glyphs.
+ (FRAME_NO_SPECIAL_GLYPHS): New macro.
+ * src/gtkutil.c (xg_frame_restack): Return immediately for
+ GTK versions before 2.18.0.
+ * src/keyboard.c (internal_border_parts): New array constant.
+ (make_lispy_position): For frames with border dragging enabled
+ return internal border part.
+ (syms_of_keyboard): New symbols Qdrag_internal_border,
+ Qleft_edge, Qtop_left_corner, Qtop_edge, Qtop_right_corner,
+ Qright_edge, Qbottom_right_corner, Qbottom_edge and
+ Qbottom_left_corner.
+ * src/minibuf.c (read_minibuf_unwind): When exiting the
+ minibuffer deal with frames that have the 'minibuffer-exit'
+ parameter set.
+ (syms_of_minibuf): New symbol Qminibuffer_exit.
+ * src/nsfns.m (frame_parm_handler): Add entry for
+ x_set_no_special_glyphs.
+ (Fx_create_frame): Handle 'no-special-glyphs' parameter.
+ Intitialize new cursor types for dragging frame borders.
+ * src/nsterm.h (struct ns_output): Add new cursor types for
+ dragging frame borders.
+ * src/w32fns.c (w32_frame_parm_handlers): Add entry for
+ x_set_no_special_glyphs.
+ (Fx_create_frame): Handle 'no-special-glyphs' parameter.
+ Intitialize new cursor types for dragging frame borders.
+ * src/w32term.h (struct w32_output): Add new cursor types for
+ dragging frame borders.
+ * src/window.c (coordinates_in_window)
+ (Fwindow_line_height, window_internal_height): Use
+ window_wants_modeline and window_wants_header_line instead of
+ WINDOW_WANTS_MODELINE_P and WINDOW_WANTS_HEADER_LINE_P.
+ (Fwindow_lines_pixel_dimensions): New function.
+ (window_parameter): New function.
+ (Fwindow_parameter): Call window_parameter.
+ (window_wants_mode_line, window_wants_header_line): New
+ functions replacing the macros WINDOW_WANTS_MODELINE_P and
+ WINDOW_WANTS_HEADER_LINE_P from dispextern.h.
+ (syms_of_window): New symbols Qmode_line_format and
+ Qheader_line_format.
+ * src/window.h: Reorganize and re-comment macros. Use
+ window_wants_modeline and window_wants_header_line instead of
+ WINDOW_WANTS_MODELINE_P and WINDOW_WANTS_HEADER_LINE_P.
+ (MINI_NON_ONLY_WINDOW_P, MINI_ONLY_WINDOW_P): Minor rewrite.
+ (WINDOW_BUFFER): New macro.
+ (WINDOW_BOX_LEFT_EDGE_COL, WINDOW_BOX_RIGHT_EDGE_COL): Remove.
+ * src/xdisp.c (window_text_bottom_y, window_box_height)
+ (window_box, start_display)
+ (compute_window_start_on_continuation_line)
+ (try_cursor_movement, redisplay_window)
+ (try_window_reusing_current_matrix, try_window_id)
+ (display_line, expose_window): Use window_wants_modeline and
+ window_wants_header_line instead of WINDOW_WANTS_MODELINE_P and
+ WINDOW_WANTS_HEADER_LINE_P.
+ (pos_visible_p, display_mode_lines): Respect W's
+ 'mode-line-format' and 'header-line-format' window parameters.
+ (init_iterator): Use window_wants_modeline and
+ window_wants_header_line instead of WINDOW_WANTS_MODELINE_P and
+ WINDOW_WANTS_HEADER_LINE_P. For tip frames respect
+ no_special_glyphs value.
+ (note_mouse_highlight): Set frame border cursors when on
+ internal border.
+ (x_draw_right_divider, x_draw_bottom_divider): Try to improve
+ drawing of window dividers.
+ * src/xfns.c (mouse_cursor): Add entries for border parts.
+ (mouse_cursor_types): Add entries for cursor types to drag
+ frame borders.
+ (INSTALL_CURSOR): Add entries for new cursor types to drag
+ frame borders.
+ (Fx_create_frame): Handle 'no-special-glyphs' parameter.
+ (x_frame_parm_handlers): Add entry for
+ x_set_no_special_glyphs.
+ (Vx_window_left_edge_shape, Vx_window_top_left_corner_shape)
+ (Vx_window_top_edge_shape, Vx_window_top_right_corner_shape)
+ (Vx_window_right_edge_shape)
+ (Vx_window_bottom_right_corner_shape)
+ (Vx_window_bottom_edge_shape)
+ (Vx_window_bottom_left_corner_shape): New variables.
+ (x_frame_restack): Call xg_frame_restack only for GTK versions
+ starting with 2.18.0.
+ * src/xterm.c (x_free_frame_resources): Remove new cursors for
+ dragging frame borders.
+ * src/xterm.h (struct x_output): Add new cursor types for
+ dragging frame borders.
+
+ * doc/lispref/display.texi (Size of Displayed Text): Document
+ `window-lines-pixel-dimensions'.
+ * doc/lispref/elisp.texi (Top): Add entry for "Mouse Dragging
+ Parameters".
+ * doc/lispref/frames.texi (Frame Size): Replace
+ frame-pixel-width/-height by frame-native-width/-height. Add
+ frame-inner-width/-height and frame-outer-width/-height docs.
+ (Position Parameters): Describe specifying position as ratios.
+ Clarify remark about positions relative to bottom/ridge display
+ edge.
+ (Size Parameters): Describe specifying sizes as ratios.
+ Describe 'fit-frame-to-buffer-margins' and
+ 'fit-frame-to-buffer-sizes' parameters.
+ (Layout Parameters): Describe 'no-special-glyphs' parameter.
+ (Frame Interaction Parameters): Describe 'auto-hide-function',
+ 'minibuffer-exit' and 'keep-ratio' parameters.
+ (Mouse Dragging Parameters): New section describing
+ 'drag-internal-border', 'drag-with-header-line',
+ 'drag-with-mode-line', 'snap-width', 'top-visible' and
+ 'bottom-visible' parameters.
+ (Management Parameters): Mention that `override-redirect' has
+ no effect on MS Windows.
+ (Font and Color Parameters): Mention child frames for `alpha'
+ parameter.
+ (Child Frames): Rewrite section with description and cross
+ references to new frame parameters added.
+ * doc/lispref/modes.texi (Mode Line Basics): Mention
+ 'mode-line-format' and 'header-line-format' window parameters.
+ * doc/lispref/windows.texi (Resizing Windows): Mention effect
+ of `fit-frame-to-buffer-margins' for child frames.
+ (Display Action Functions): New action function
+ `display-buffer-in-child-frame'.
+ (Quitting Windows): Mention `make-frame-invisible' as optional
+ value of `frame-auto-hide-function' and `auto-hide-function'
+ frame paameter.
+ (Coordinates and Windows): Describe new function
+ `window-largest-empty-rectangle'.
+ (Window Parameters): Describe new parameters 'mode-line-format'
+ and 'header-line-format'. Index all window parameters described
+ in this section.
+
+2017-06-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Adjust lm-verify to accept current notices
+
+ Problem reported by Mike Kupfer in:
+ https://lists.gnu.org/r/emacs-devel/2017-06/msg00512.html
+ * lisp/emacs-lisp/lisp-mnt.el (lm-crack-copyright):
+ Do not require later lines in a copyright notice to have more
+ indentation than earlier lines.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Minor change in NEWS.
+
+ Improve documentation in NEWS.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Move additional hscrolling code into a suitable 'if'
+
+ * src/xdisp.c (hscroll_window_tree): Make additional calculations
+ regarding glyphs produced for line numbers conditional on
+ line-number display.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Partial fix of hscroll of truncated lines with line numbers
+
+ * src/xdisp.c (x_produce_glyphs, hscroll_window_tree): Adjust
+ hscroll calculations to line-number display.
+ * src/term.c (produce_glyphs): Adjust tab stop to window's
+ hscroll. These two changes fix horizontal scrolling when line
+ numbers are displayed. But there's still a bug: the horizontal
+ shift of lines that begin with a TAB is different from the rest.
+ * src/xdisp.c (move_it_in_display_line_to): Call
+ should_produce_line_number to determine whether a line number
+ should be produced for this screen line.
+
+2017-06-24 Noam Postavsky <npostavs@gmail.com>
+
+ Don't change byte-compile-delete-errors at runtime (Bug#27340)
+
+ * lisp/emacs-lisp/eieio-core.el: Confine `cl-declaim' calls to compile
+ time.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Allow Lisp program to disable line-number display for specific lines
+
+ * etc/NEWS: Update the documentation.
+
+ * src/xdisp.c (syms_of_xdisp) <display-line-numbers-disable>: New
+ symbol.
+ (should_produce_line_number): New function.
+ (display_line): Use should_produce_line_number to determine
+ whether a line number should be produced for each glyph row.
+
+2017-06-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/net/html2text.el: Move to obsolete/.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Support a separate face for displaying the current line's number
+
+ * lisp/faces.el (line-number-current-line): New face.
+
+ * src/xdisp.c (syms_of_xdisp) <line-number-current-line>: New
+ symbol.
+ (try_window_id, try_cursor_movement): Disable these optimizations
+ when the line-number-current-line face is different from
+ line-number face.
+ (maybe_produce_line_number): Display the current line in the
+ line-number-current-line face, if it's different from line-number.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Change display of current line in relative mode
+
+ * src/xdisp.c (maybe_produce_line_number): In relative mode
+ display the current line number as its absolute value, not as zero.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Rename display-line-width
+
+ * etc/NEWS:
+ * src/xdisp.c (syms_of_xdisp, maybe_produce_line_number):
+ * lisp/cus-start.el: Rename display-line-width to
+ display-line-number-width.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix tab stops when line numbers are displayed
+
+ * src/xdisp.c (x_produce_glyphs):
+ * src/term.c (produce_glyphs): Adjust tab stops for the horizontal
+ space taken by the line-number display.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix crashes on TTY frames due to negative lnum_width.
+
+ Don't display line numbers in the minibuffer and in tooltip frames.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix problems with line-number updates in Follow mode
+
+ * src/xdisp.c (redisplay_window): If forced window-start requires
+ to move a window's point, and the window is under relative
+ line-number display, force another round of redisplay to update
+ the relative line numbers. This fixes follow-mode "redisplay" of
+ its window group.
+
+ * lisp/frame.el: Add display-line-numbers to the list of variables
+ that should trigger redisplay of the current buffer.
+
+2017-06-24 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of line numbers with fonts larger than the default
+
+ * src/xdisp.c (maybe_produce_line_number): Update the metrics in
+ IT, not in IT->glyph_row, since the latter gets overwritten in
+ display_line. Fixes display of line numbers when the font used
+ for them is larger than that of the default face.
+
+2017-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix background color beyond EOB and cursor display
+
+ * src/xdisp.c: (maybe_produce_line_number): Use the default face
+ for background of the blank glyphs in the line-number area which
+ are drawn beyond EOB.
+ (display_line): Reset the glyph row's displays_text_p flag only on
+ empty lines that don't display line numbers. This fixes cursor
+ display beyond EOB. Fix the bidi information in the glyphs
+ produced for line numbers. Set the avoid_cursor_p flag of glyphs
+ produced for line numbers.
+
+2017-06-23 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of indicate-empty-lines when line numbers are displayed
+
+ * src/xdisp.c (row_text_area_empty): New function.
+ (display_line): Call row_text_area_empty to verify that a glyph
+ row's text area is devoid of any glyphs that came from a buffer or
+ a string. This fixes a bug with empty-lines indication
+ disappearing when line numbers or line-prefix are displayed.
+ (display_line): Delete the argument FORCE; all callers changed.
+ Remove the condition for actually producing the glyphs for the
+ line number, as even if the number didn't change we need to
+ produce empty space.
+
+2017-06-23 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Fix symbol relocation when the relocated cell is renamed.
+
+ * lisp/ses.el (ses-sym-rowcol): Check that the renamed cell
+ hashmap has been instantiated before getting data from it. When
+ editing several spreadsheets, and you have spreadsheet #1 with a
+ cell named `foo', and no renamed cell in spreadsheet #2, then if
+ you make a formula with `foo' in spreadsheet #2, not doing this
+ check will make an error.
+ (ses-cell-set-formula): Robustify versus incorrect cell references
+ given in the user provided formula. An explicit error message is
+ provided after the action when the user gives an incorrect cell
+ reference, but the formula edition is not changed. This means that
+ if the incorrect reference is to a cell that is created someday,
+ then this new cell will not have the edited cell in its reference
+ list. Fixing this can still be done by editing again the first
+ cell formula.
+ (ses-relocate-symbol): Do not create symbol of referred-to cell
+ when this is a renamed cell.
+
+2017-06-23 Rasmus <rasmus@gmx.us>
+
+ Synchronize with the "emacs-sync" branch from Org
+
+2017-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove getc_unlocked configure-time check
+
+ * configure.ac (getc_unlocked): Remove check, as unlocked-io now
+ does this for us.
+
+2017-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use unlocked stdio more systematically
+
+ This can improve performance significantly on stdio-bottlenecked code.
+ E.g., make-docfile is 3x faster on my Fedora 25 x86-64 desktop.
+ * admin/merge-gnulib (GNULIB_MODULES): Add unlocked-io.
+ * lib-src/ebrowse.c, lib-src/emacsclient.c, lib-src/etags.c:
+ * lib-src/hexl.c, lib-src/make-docfile.c, lib-src/movemail.c:
+ * lib-src/profile.c, lib-src/update-game-score.c:
+ Include unlocked-io.h instead of stdio.h, since these programs are
+ single-threaded.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib/unlocked-io.h, m4/unlocked-io.m4: New files, copied from Gnulib.
+ * src/charset.c, src/cm.c, src/emacs.c, src/image.c, src/keyboard.c:
+ * src/lread.c, src/term.c:
+ Include sysstdio.h, possibly instead of stdio.h, to define
+ the unlocked functions if the system does not provide them.
+ * src/charset.c, src/lread.c (getc_unlocked):
+ Remove, since sysstdio.h now defines it if needed.
+ * src/cm.c (cmputc, cmcheckmagic):
+ * src/dispnew.c (update_frame, update_frame_with_menu)
+ (update_frame_1, Fsend_string_to_terminal, Fding, bitch_at_user):
+ * src/emacs.c (main, Fdump_emacs):
+ * src/fileio.c (Fdo_auto_save, Fset_binary_mode):
+ * src/image.c (slurp_file, png_read_from_file, png_load_body)
+ (our_stdio_fill_input_buffer):
+ * src/keyboard.c (record_char, kbd_buffer_get_event, handle_interrupt):
+ * src/lread.c (readbyte_from_file):
+ * src/minibuf.c (read_minibuf_noninteractive):
+ * src/print.c (printchar_to_stream, strout)
+ (Fredirect_debugging_output):
+ * src/sysdep.c (reset_sys_modes, procfs_ttyname)
+ (procfs_get_total_memory):
+ * src/term.c (tty_ring_bell, tty_send_additional_strings)
+ (tty_set_terminal_modes, tty_reset_terminal_modes)
+ (tty_update_end, tty_clear_end_of_line, tty_write_glyphs)
+ (tty_write_glyphs_with_face, tty_insert_glyphs)
+ (tty_menu_activate):
+ * src/xfaces.c (Fx_load_color_file):
+ Use unlocked stdio when it should be safe.
+ * src/sysstdio.h (clearerr_unlocked, feof_unlocked, ferror_unlocked)
+ (fflush_unlocked, fgets_unlocked, fputc_unlocked, fputs_unlocked)
+ (fread_unlocked, fwrite_unlocked, getc_unlocked, getchar_unlocked)
+ (putc_unlocked, putchar_unloced): Provide substitutes if not declared.
+
+2017-06-22 Glenn Morris <rgm@gnu.org>
+
+ * lisp/net/shr.el (shr-fill-text): Actually fill the text. (Bug#27399)
+
+2017-06-22 Michal Nazarewicz <mina86@mina86.com>
+
+ unidata: don’t check special casing in unidata-check (bug#26656)
+
+ * admin/unidata/unidata-gen.el (unidata-check): Do not test special
+ casing mapping of characters since that mapping is not constructed from
+ the unidata.txt file.
+ Also, check for integer decoder and cons char earlier so that less
+ unnecessary processing is performed.
+
+2017-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/descr-text.el (describe-char): Avoid string-*-multibyte
+
+ Avoid string-to-multibyte and string-as-unibyte.
+ Don't make *Help* unibyte just because the char was in a unibyte buffer.
+
+2017-06-22 Rasmus <rasmus@gmx.us>
+
+ Add Org schemas.xml contents to Emacs schemas.xml
+
+ Entries from the Org version of schemas.xml have been added to
+ the Emacs version of schemas.xml.
+
+2017-06-22 Rasmus <rasmus@gmx.us>
+
+ Update Org to v9.0.9
+
+ Please see etc/ORG-NEWS for details.
+
+2017-06-22 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Do not hard code A1 cell reference, as it may be renamed.
+
+ * lisp/ses.el (ses-recalculate-all): `A1' -> `(ses-cell-symbol 0 0)'
+
+2017-06-22 Martin Rudalics <rudalics@gmx.at>
+
+ Fix make_hash_table calls in lread.c
+
+ * src/lread.c (readevalloop, read_internal_start): Fix
+ make_hash_table calls to make build succeed.
+
+2017-06-22 Ken Raeburn <raeburn@raeburn.org>
+
+ Merge several Lisp reader speedups.
+
+2017-06-22 Ken Raeburn <raeburn@raeburn.org>
+
+ Create less garbage to collect while reading symbols.
+
+ * src/lread.c (read1): When interning a symbol, only create a new
+ string object for the name if we're going to use it for a new symbol
+ object.
+
+2017-06-22 Ken Raeburn <raeburn@raeburn.org>
+
+ Replace read_objects assoc list with two hash tables.
+
+ For larger input files with lots of shared data structures, an
+ association list is too slow.
+
+ * src/lread.c (read_objects_map, read_objects_completed): New
+ variables, replacing read_objects.
+ (readevalloop): Initialize them with hash tables before starting a
+ top-level read, if they're not already empty hash tables, and reset
+ them to Qnil afterwards if something was added to the hash tables.
+ (read_internal_start): Likewise.
+ (read1): Store first the placeholder and later the newly read object
+ into read_objects_map under the specified object number. If the new
+ object can contain a reference to itself, store it in
+ read_objects_completed.
+ (substitute_objects_recurse): Check read_objects_completed instead of
+ read_objects for the known possibly-recursive objects.
+ (syms_of_lread): Update initializations.
+
+2017-06-22 Ken Raeburn <raeburn@raeburn.org>
+
+ Use getc_unlocked.
+
+ * configure.ac: Check for getc_unlocked.
+ * src/charset.c (read_hex, load_charset_map_from_file): Use
+ getc_unlocked instead of getc.
+ (getc_unlocked) [!HAVE_GETC_UNLOCKED]: Fall back to getc.
+ * src/lread.c (readbyte_from_file, Fget_file_char, read1,
+ getc_unlocked): Likewise.
+
+2017-06-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Reduce lread substitutions.
+
+ * src/lread.c (read1): After reading an object using the "#n=" syntax,
+ if the read object is a cons cell, instead of recursively substituting
+ the placeholder with the new object, mutate the placeholder cons cell
+ itself to have the correct car and cdr values.
+
+2017-06-22 Ken Raeburn <raeburn@raeburn.org>
+
+ Short-circuit substitutions for some simple types.
+
+ Values that don't contain other values cannot be circular, so checking
+ for circular objects is a waste of cycles.
+
+ * src/lread.c (substitute_object_recurse): If the subtree being
+ examined is a symbol, number, or property-less string, just return
+ it.
+
+2017-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Limit style_format to MAX_ALLOCA
+
+ * src/editfns.c (styled_format): Subtract initial buffer size
+ from sa_avail, since it is nontrivial.
+
+2017-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Limit bidi_find_bracket_pairs to MAX_ALLOCA
+
+ * src/bidi.c (MAX_BPA_STACK): Now a constant, not a macro.
+ Shrink it to allow for the two struct bidi_it objects in
+ the same frame.
+ (PUSH_BPA_STACK): Avoid integer overflow with enormous bidi cache.
+ (bidi_find_bracket_pairs): Use compile-time check instead of runtime.
+
+2017-06-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Limit insert-file-contents to MAX_ALLOCA
+
+ * src/fileio.c (READ_BUF_SIZE): Don’t allocate more than
+ MAX_ALLOCA bytes in a single stack array.
+
+2017-06-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove malloc_find_address relic
+
+ * src/gmalloc.c (register_heapinfo, _malloc_internal_nolock):
+ Omit unnecessary initialization.
+
+2017-06-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix temacs hybrid_malloc core dump
+
+ Without this patch, ./temacs would dump core sometimes on Fedora
+ 25 x86-64. The problem was that the hybrid allocator assumed that
+ all pointers into bss_sbrk_buffer are allocated via gmalloc. This
+ assumption is not true on Fedora, because the standard memory
+ allocator calls gdefault_morecore, which means its blocks are
+ interleaved with our blocks. Usually the code happened to work,
+ because our data structures agreed with the glibc data structures,
+ but this was merely luck due to a shared pedigree, and as glibc
+ mutates our luck has run out.
+ * src/gmalloc.c (ALLOCATED_BEFORE_DUMPING) [HYBRID_MALLOC]:
+ Remove; no longer needed.
+ (BLOCK): Use unsigned division, as that does the right thing near zero.
+ (register_heapinfo, __malloc_internal_nolock, __free_internal_nolock)
+ (_realloc_internal_nolock):
+ Big blocks now have type -1, not 0, as 0 now means the block is
+ not ours.
+ (morecore_nolock): Omit now-unnecessary casts to size_t.
+ (allocated_via_gmalloc) [HYBRID_MALLOC]: New function.
+ (hybrid_free, hybrid_realloc) [HYBRID_MALLOC]: Use it, to
+ avoid calling the wrong free or realloc function in some cases.
+
+2017-06-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Make gnus-article-date-user work
+
+ * lisp/gnus/gnus-art.el (article-date-ut):
+ Work for unfolded multi-line Date header.
+ (article-transform-date):
+ Refactor; add header name if it is missing in user-defined date line.
+ (article-date-user): Fix name of date type.
+
+2017-06-21 Noam Postavsky <npostavs@gmail.com>
+
+ Keep order of completion candidates (Bug#25995, Bug#24676)
+
+ * lisp/minibuffer.el (completion-pcm--filename-try-filter)
+ (completion-pcm--all-completions): Use nreverse to undo the reversing
+ caused by using push in the loop.
+
+2017-06-21 Glenn Morris <rgm@gnu.org>
+
+ * src/lread.c (syms_of_lread) <load-history>: Doc fix.
+
+2017-06-21 Alex Gramiak <agrambot@gmail.com>
+
+ Mark prolog indent variables as safe (bug#27369)
+
+ * lisp/progmodes/prolog.el (prolog-indent-width)
+ (prolog-left-indent-regexp, prolog-paren-indent-p)
+ (prolog-paren-indent): Add :safe property.
+
+2017-06-20 Simen Heggestøyl <simenheg@gmail.com>
+
+ Remove `:options' from `css-electric-keys'
+
+ * lisp/textmodes/css-mode.el (css-electric-keys): Remove `:options`
+ since it just duplicates the default value.
+
+2017-06-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix crash when built by GNU Gold linker on x86
+
+ Problem reported by Andrés Musetti (Bug#27248).
+ * src/widget.c (emacsFrameClassRec): Do not initialize superclass here.
+ (emacsFrameClass): Now a function (which initializes the
+ superclass) instead of a variable. All uses changed.
+
+2017-06-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify autogen.sh version checking
+
+ * autogen.sh (get_version): Simplify and make more reliable
+ by using expr rather than echo | sed. Check exit status of program.
+ Run program in subshell in case it cannot be executed.
+ (check_version): Check exit status of command rather than its output.
+ Check return status of get_version.
+
+2017-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Delete old Date header in a simple way
+
+ * lisp/gnus/gnus-art.el (article-date-ut): Don't rely on text prop
+ when searching the old Date header boundary in order to delete it.
+
+2017-06-20 Bastien <bzg@gnu.org>
+
+ Revert "Don't bind org-agenda key to an anonymous function"
+
+ This reverts commit 49c0ff29c2e0243ba35ec17e3e3af49369be43db.
+
+2017-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Bind enable-local-variables to nil globally (fix dbe3e41)
+
+ * lisp/gnus/mm-view.el (mm-display-inline-fontify):
+ Bind enable-local-variables to nil globally instead of making it
+ buffer-local; remove let-bind of local-enable-local-variables.
+ cf. <b4mtw3bbfp5.fsf@jpl.org> in the emacs-devel list.
+
+2017-06-20 Glenn Morris <rgm@gnu.org>
+
+ kill-matching-buffers to optionally not confirm
+
+ * lisp/files.el (kill-matching-buffers):
+ Add option to not confirm killing. (Bug#27286)
+
+2017-06-20 Glenn Morris <rgm@gnu.org>
+
+ * lisp/files.el (local-enable-local-variables): Doc fix.
+
+2017-06-20 Glenn Morris <rgm@gnu.org>
+
+ autogen.sh: try to check for tool being present but broken
+
+ * autogen.sh (get_version): Check return status of "--version".
+ (check_version): Try to distinguish between a missing tool
+ and a broken one. (Bug#27288)
+
+2017-06-19 Glenn Morris <rgm@gnu.org>
+
+ Avoid a custom-variable-type error (bug#27363)
+
+ * lisp/cus-edit.el (custom-variable-type):
+ Avoid an error due to plist-put becoming stricter of late.
+
+2017-06-19 Glenn Morris <rgm@gnu.org>
+
+ Don't put deleted packages in the trash (bug#14967)
+
+ * lisp/emacs-lisp/package.el (package-delete):
+ Don't pay attention to delete-by-moving-to-trash.
+
+2017-06-19 Nicolas Petton <nicolas@petton.fr>
+
+ Revert "Add current-line in simple.el"
+
+ This reverts commit ae98cdf9431604d0f722f1db217ca06debfbb7b6.
+
+2017-06-19 Damien Cassou <damien@cassou.me>
+
+ Add current-line in simple.el
+
+ * lisp/simple.el (current-line): New function.
+ * test/lisp/simple-tests.el: Add tests for current-line.
+
+2017-06-19 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Don't try to eval local variables in Gnus article
+
+ * lisp/gnus/mm-view.el (mm-display-inline-fontify): Disable local vars.
+
+2017-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix emacs-module.h cleaning
+
+ * src/Makefile.in (clean): Do not remove emacs-module.h.in.
+ (bootstrap-clean): Remove emacs-module.h.
+
+2017-06-18 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp/url/url-util.el (url-get-url-at-point): Add missing group
+ in regex.
+
+2017-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lib/gettext.h: Merge from gnulib.
+
+2017-06-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This (and my previous patch) incorporate:
+ 2017-06-17 diffseq: port to GCC 7 with --enable-gcc-warnings
+ 2017-06-15 gettext-h: Update comment
+ * lib/diffseq.h: Copy from gnulib.
+
+2017-06-17 Noam Postavsky <npostavs@gmail.com>
+
+ * test/Makefile.in: Don't suppress test failure for single tests.
+
+2017-06-17 Philipp Stephani <phst@google.com>
+
+ emacs-module.h: Create emacs_env_26
+
+ This was part of the original design of the module
+ API (https://lists.gnu.org/r/emacs-devel/2015-02/msg00960.html),
+ but I didn't take it into account when adding the should_quit
+ function.
+
+ Instead of duplicating the environment fields or using the C
+ preprocessor, use configure to build emacs-module.h.
+
+ * configure.ac: Expand emacs-module.h template.
+
+2017-06-17 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of replace-buffer-contents
+
+ * etc/NEWS (replace-buffer-contents): Fix formatting.
+
+ * src/editfns.c (Freplace_buffer_contents): Doc fix.
+
+2017-06-17 Eli Zaretskii <eliz@gnu.org>
+
+ Finish up native display of line numbers
+
+ * src/xdisp.c (maybe_produce_line_number): Produce a blank before
+ the number, for R2L rows. Increment 'g' in the loop even if
+ glyph_row is NULL. Accept 2nd argument FORCE and produce the
+ line-number glyphs if it is non-zero.
+ (move_it_in_display_line_to): Account for the space taken by the
+ line-number glyphs. Call maybe_produce_line_number with 2nd
+ argument non-zero.
+ (set_cursor_from_row): Fix calculation of cursor X coordinate in
+ R2L rows with display-produced glyphs at the beginning.
+ (syms_of_xdisp) <line-number>: New face symbol.
+ <relative, display-line-width>: New symbols.
+ (maybe_produce_line_number): Use the line-number face for
+ displaying line numbers. Support relative line-number display.
+ Support user-defined width for displaying line numbers.
+ (try_cursor_movement, try_window_id): Disable these optimizations
+ when displaying relative line numbers.
+ * src/dispextern.h (struct it): New member 'pt_lnum'.
+
+ * lisp/faces.el (line-number): New face.
+ * lisp/cus-start.el (standard): Provide customization forms for
+ display-line-numbers and display-line-width.
+ * lisp/menu-bar.el (menu-bar-showhide-menu): Add menu-bar item to
+ turn display-line-numbers on and off.
+
+ * etc/NEWS: Document the new feature.
+
+2017-06-17 Philipp Stephani <phst@google.com>
+
+ Allow local variables section to begin with a square bracket
+
+ Fixes Bug#27391.
+
+ * lisp/international/mule.el (find-auto-coding): Fix regular
+ expression for "Local Variables" section.
+
+ * test/lisp/international/mule-tests.el (find-auto-coding--bug27391):
+ Add unit test.
+
+2017-06-17 Philipp Stephani <phst@google.com>
+
+ Remove unnecessary point motion
+
+ * src/editfns.c (Freplace_buffer_contents): Remove unnecessary point
+ motion.
+
+2017-06-17 Philipp Stephani <phst@google.com>
+
+ Add command to replace buffer contents
+
+ Add a new command 'replace-buffer-contents' that uses the Myers diff
+ algorithm to non-destructively replace the accessible portion of the
+ current buffer. The Myers algorithm is implemented in Gnulib.
+
+ * src/editfns.c (Freplace_buffer_contents): New command.
+ (set_bit, bit_is_set, buffer_chars_equal): New helper functions.
+ (syms_of_editfns): Define new command.
+
+ * test/src/editfns-tests.el (replace-buffer-contents-1)
+ (replace-buffer-contents-2): New unit tests.
+
+ * src/buffer.h (BUF_FETCH_CHAR_AS_MULTIBYTE): New helper macro.
+
+ * admin/merge-gnulib (GNULIB_MODULES): Add diffseq.h and minmax.h.
+
+2017-06-17 Andreas Schwab <schwab@linux-m68k.org>
+
+ * lisp/international/characters.el: Update list of zero and full
+ width characters according to Unicode 9.0.0.
+
+2017-06-17 Simen Heggestøyl <simenheg@gmail.com>
+
+ Complete CSS property values less eagerly (Bug#27392)
+
+ * lisp/textmodes/css-mode.el (css--complete-property-value): Be less
+ eager by looking for a colon after the property which values are being
+ completed for.
+
+ * test/lisp/textmodes/css-mode-tests.el (css-test-complete-property):
+ Add a test case ensuring that properties that are prefixes of other
+ properties don't hinder further completion.
+
+2017-06-17 Noam Postavsky <npostavs@gmail.com>
+
+ Handle integer indices for eshell variables (Bug#26055)
+
+ * lisp/eshell/esh-var.el (eshell-index-value): Convert index to number
+ if it's been marked as one, just like `eshell-lisp-command' does.
+
+2017-06-17 Mark Oteiza <mvoteiza@udel.edu>
+
+ Don't bind org-agenda key to an anonymous function
+
+ * lisp/org/org-agenda.el: Bind "g" to named command.
+ (org-agenda-redo-all): New command. Extend the previous functionality
+ through a prefix argument.
+
+2017-06-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ Add test for the fix in the parent commit
+
+ * test/src/undo-tests.el (undo-test-skip-invalidated-markers):
+ New test, for the fix in the parent commit.
+
+2017-06-17 Nitish Chandra <nitishchandrachinta@gmail.com> (tiny change)
+
+ primitive-undo: Update only the currently valid markers
+
+ * lisp/simple.el (primitive-undo):
+ Update only the currently valid markers (bug#25599).
+
+2017-06-16 Eli Zaretskii <eliz@gnu.org>
+
+ Initial version of native display of line numbers
+
+ * src/xdisp.c (syms_of_xdisp) <display-line-numbers>: New
+ buffer-local variable.
+ Include <math.h>.
+ (maybe_produce_line_number): New function.
+ (DISP_INFINITY): Rename from INFINITY, since math.h defines INFINITY.
+ (try_window_reusing_current_matrix): Don't use this method when
+ display-line-numbers is in effect.
+ * src/dispextern.h (struct it): New members 'lnum'.
+
+2017-06-16 Philipp Stephani <phst@google.com>
+
+ Correctly detect URLs surrounded by parentheses in comments
+
+ * lisp/thingatpt.el (thing-at-point--bounds-of-well-formed-url):
+ Make parentheses match work inside comments.
+
+ * test/lisp/thingatpt-tests.el (thing-at-point-url-in-comment): Add
+ unit test.
+
+2017-06-16 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix load-path issue when it contains remote directories
+
+ * lisp/net/tramp.el (tramp-file-name-handler): Use `autoloadp'.
+ (tramp-use-absolute-autoload-file-names): New defun. Call it
+ after loading tramp.el.
+
+ * test/lisp/net/tramp-tests.el (tramp-test38-remote-load-path):
+ New test.
+ (tramp-test39-unload): Rename.
+
+2017-06-16 Alan Mackenzie <acm@muc.de>
+
+ Ensure C++ initializer lists don't get fontified.
+
+ * lisp/progmodes/cc-cmds.el (c-block-comment-flag): Move declaration to solve
+ compiler warning.
+
+ * lisp/progmodes/cc-fonts.el (c-get-fontification-context): Add an extra
+ clause to handle C++ member initialization lists.
+ (c-font-lock-single-decl): New function, extracted from
+ c-font-lock-declarations.
+ (c-font-lock-declarations): Call c-font-lock-single-decl in place of inline
+ code.
+ (c-font-lock-cut-off-declarators): Make more rigorous by calling
+ c-get-fontification-context, c-forward-decl-or-cast-1, and
+ c-font-lock-single-decl in place of rather approximate code.
+
+2017-06-16 Alan Mackenzie <acm@muc.de>
+
+ Fix hang in CC Mode when ":" is typed after identifier at EOB.
+
+ * lisp/progmodes/cc-engine.el (c-forward-declarator): Fix coding error
+ confusing ":" and EOB.
+
+2017-06-15 Alan Mackenzie <acm@muc.de>
+
+ Create a toggle between block and line comments in CC Mode.
+
+ Also (unrelated change) initialize the modes' keymaps at each loading.
+
+ * lisp/progmodes/cc-cmds.el (c-update-modeline): amend for the new information
+ on the modeline.
+ (c-block-comment-flag): New variable.
+ (c-toggle-comment-style): New function.
+
+ * lisp/progmodes/cc-langs.el (c-block-comment-starter)
+ (c-line-comment-starter): Make them c-lang-defvars.
+ (c-block-comment-is-default): New c-lang-defvar.
+ (comment-start, comment-end): Make the default values dependent on
+ c-block-comment-is-default.
+
+ * lisp/progmodes/cc-mode.el (c-mode-base-map): Define C-c C-k in this map.
+ (c-basic-common-init): Initialize c-block-comment-flag.
+ (c-mode-map, c++-mode-map, objc-mode-map, java-mode-map, idl-mode-map)
+ (pike-mode-map, awk-mode-map): Make entries in these key maps each time the
+ mode is loaded rather than just once per Emacs session.
+
+ * doc/misc/cc-mode.texi (Comment Commands): Introduce the notion of comment
+ style.
+ (Minor Modes): Define comment style. Describe how comment style influences
+ the information displayed on the modeline. Document c-toggle-comment-style.
+ (FAQ): Add a question about toggling the comment style.
+
+2017-06-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify clang without munging C source
+
+ * configure.ac (WARN_CFLAGS): With Clang, use
+ -Wno-tautological-compare regardless of --enable-gcc-warnings.
+ (WERROR_CFLAGS): Simplify assignments, and guarantee it’s always set.
+ * lib/strftime.c: Copy from gnulib, reverting Clang-specific
+ change which I hope is no longer needed.
+ * src/emacs.c (main): Revert rlim_t change, as rlim_t is signed on
+ some older non-POSIX hosts.
+
+2017-06-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ No need to complicate make-docfile.c for Clang
+
+ * lib-src/make-docfile.c (put_filename): Undo recent change.
+ The Clang false alarm occurs only with CFLAGS=-save-temps and
+ we needn’t worry about pacifying unusual compiler configurations.
+
+2017-06-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port './configure CC=clang' to Fedora 25
+
+ * configure.ac (HAVE_IMAGEMAGICK): Disable if even a
+ standard function like MagickRelinquishMemory does not link.
+
+2017-06-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t worry about __STDC_VERSION__ in emacs-module
+
+ * src/emacs-module.h: Remove __STDC_VERSION__ check. In the past
+ we’ve found that some compilers do not define this symbol even
+ when they work well enough. If necessary features like stdbool.h
+ are missing the compiler will complain eventually anyway.
+
+2017-06-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port cleanup check to Oracle Studio 12.5
+
+ * src/conf_post.h (__has_attribute_cleanup): Resurrect.
+ * src/emacs-module.c: Verify __has_attribute (cleanup), but in an
+ #if this time.
+
+2017-06-14 Bastien <bzg@gnu.org>
+
+ Fix misformatted changelog entry
+
+2017-06-14 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compiler warning in image.c on MS-Windows
+
+ * src/image.c (x_create_x_image_and_pixmap) [HAVE_NTGUI]: Avoid
+ compilation warning under -Warray-bounds by temporarily disabling
+ the -Warray-bounds option.
+
+2017-06-14 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#27315
+
+ * lisp/net/tramp-cache.el (tramp-cache-read-persistent-data):
+ New defvar.
+ (top): Use it.
+
+ * lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p):
+ Check for connected, not for connectable. (Bug#27315)
+ (tramp-process-actions):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
+ Use `tramp-cache-read-persistent-data'.
+
+ * test/lisp/net/tramp-tests.el (top): Set also
+ `tramp-cache-read-persistent-data'.
+
+2017-06-14 Noam Postavsky <npostavs@gmail.com>
+
+ Give a fixed default value for icomplete-prospects-height (Bug#26939)
+
+ * lisp/icomplete.el (icomplete-prospects-height): Default to 2.
+ (icomplete-prospects-length): Remove.
+ * etc/NEWS: Announce removal.
+
+2017-06-14 Philipp Stephani <phst@google.com>
+
+ Remove some tautological comparisons involving rlim_t
+
+ Clang on macOS warns about these with -Wtautological-compare. POSIX
+ guarantees that rlim_t is
+ unsigned (cf.
+ http://pubs.opengroup.org/onlinepubs/009695399/basedefs/sys/resource.h.html),
+ so these resource limits can never be negative.
+
+ * src/emacs.c (main): Remove tautological comparisons.
+
+2017-06-14 Philipp Stephani <phst@google.com>
+
+ Use --module-assertions if modules are available
+
+ Using --module-assertions helps us find bugs in the test module. But
+ we can use it only if Emacs was compiled with module support.
+
+ * test/Makefile.in (MODULES_EMACSOPT): New variable.
+ (emacs): Use it.
+
+2017-06-14 Philipp Stephani <phst@google.com>
+
+ Define --module-assertions only of modules are available
+
+ Fixes Bug#27352.
+
+ * src/emacs.c (usage_message, standard_args): Define
+ --module-assertions only if Emacs has been compiled with module
+ support.
+
+2017-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ gnus-article-read-summary-keys: Don't move point for WDD and WDW commands
+
+ * lisp/gnus/gnus-art.el (gnus-article-read-summary-keys):
+ No need to restore window config for WDD and WDW commands.
+
+2017-06-14 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ lisp/net/soap-client.el: Bump version to 3.1.3
+
+ * lisp/net/soap-client.el: Bump version to 3.1.3.
+ (soap-name-p): Fix checkdoc issue.
+
+2017-06-14 Alex Harsanyi <AlexHarsanyi@gmail.com>
+
+ Fix an HTTP encoding error in soap-client.el
+
+ * lisp/net/soap-client.el (soap-invoke-internal): Make
+ SOAPAction header a UTF-8 encoded string.
+
+2017-06-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port cleanup attribute to Oracle Studio 12.5
+
+ * INSTALL (--with-modules): List cleanup attribute as prereq.
+ * src/conf_post.h (__has_attribute_cleanup): Remove; no longer needed.
+ * src/emacs-module.c (MODULE_SETJMP_1): Don’t attempt to verify
+ (__has_attribute (cleanup)), as Oracle Studio 12.5 supports
+ __has_attribute only inside preprocessor expressions. The C
+ compiler should check the cleanup attribute in the next line anyway.
+ (module_reset_handlerlist): Remove an unnecessary ‘const’
+ that causes Oracle Studio 12.5 to refuse to compile.
+
+2017-06-14 Glenn Morris <rgm@gnu.org>
+
+ Fix running tests in without-modules builds
+
+ * test/Makefile.in (EMACSOPT): Remove option that is only defined
+ with-modules. emacs-module-tests.el passes it where needed.
+
+2017-06-13 Glenn Morris <rgm@gnu.org>
+
+ * test/Makefile.in (src/emacs-module-tests.log): Out-of-tree fix.
+
+2017-06-13 Philipp Stephani <phst@google.com>
+
+ Inline test module Makefile into main test Makefile
+
+ The test/data/emacs-module/Makefile only built a single target, and
+ inlining it into test/Makefile simplifies dependency tracking and
+ reduces code duplication.
+
+ * configure.ac: Don't build test/data/emacs-module/Makefile.
+
+ * Makefile.in ($(test_module)): Inline compilation.
+ (clean): Also clean test module outputs.
+
+2017-06-13 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp-sh.el (tramp-set-file-uid-gid): Do not handle locally on w32.
+
+2017-06-13 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor tweaks in Tramp manual
+
+ * doc/misc/trampver.texi: Add prefixwithspace flag.
+
+ * doc/misc/tramp.texi (Password handling): Harmonize example.
+ (File name completion): Use prefixwithspace flag.
+ (Frequently Asked Questions): Explain `tramp-histfile-override'.
+
+2017-06-13 Philipp Stephani <phst@google.com>
+
+ Silence two Clang warnings by introducing additional local variables
+
+ * lib/strftime.c (libc_hidden_def):
+ * lib-src/make-docfile.c (put_filename): Introduce local variables to
+ silence Clang warnings.
+
+2017-06-13 Noam Postavsky <npostavs@gmail.com>
+
+ Fix wrong indentation after string literal (Bug#27306)
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-indent-state)
+ (lisp-indent-calc-next): Remove `depth' field, use (car ppss) instead.
+ * test/lisp/emacs-lisp/lisp-mode-tests.el
+ (lisp-indent-region-after-string-literal): New test.
+
+2017-06-13 Philipp Stephani <phst@google.com>
+
+ Fix version checks for emacs-module.h
+
+ We don't need C11 or C++11 because stdbool.h is in C99, and for C++ we
+ don't need it at all.
+
+2017-06-13 Noam Postavsky <npostavs@gmail.com>
+
+ Buttonize #<bytecode> part of printed functions (Bug#25226)
+
+ * lisp/emacs-lisp/cl-print.el: Autoload `disassemble-1'.
+ (cl-print-compiled-button): New variable.
+ (help-byte-code): New button type, calls `disassemble' in its action.
+ (cl-print-object): Use it if `cl-print-compiled-button' is
+ non-nil.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Print module structure sizes when initializing test module
+
+ * test/data/emacs-module/mod-test.c (emacs_module_init): Print
+ compile-time and runtime sizes of module structures to ease debugging
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Small portability fix for emacs-module.h (bug#27346)
+
+ * src/emacs-module.h (EMACS_ATTRIBUTE_NONNULL) [!__has_attribute]:
+ Avoid 'error: missing binary operator before token "("'.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Give a more informative failure in module assertion test
+
+ * test/src/emacs-module-tests.el (module--test-assertions):
+ Rephrase final check to give a more informative failure.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Fix off-by-one error
+
+ * test/data/emacs-module/mod-test.c (emacs_module_init): Fix
+ off-by-one error.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Clean up after module assertion tests
+
+ * test/src/emacs-module-tests.el (module--test-assertions):
+ Use a temporary directory to contain any core dumps.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Small improvement for module assertion test
+
+ * test/src/emacs-module-tests.el (module--test-assertions):
+ Don't rely on the precise form of an "Abort" message.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Improve previous test/data/emacs-module/Makefile change
+
+ * test/data/emacs-module/Makefile.in (clean):
+ Avoid doing unpleasant things if run in a build without modules.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Small improvements for test/data/emacs-module/Makefile
+
+ * test/data/emacs-module/Makefile.in (%.o):
+ Fix emacs-module dependency.
+ (SECONDARY): Stop make automatically deleting *.o.
+ (clean): New rule.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: Skip some more generated files in test/.
+
+2017-06-12 Alan Third <alan@idiocy.org>
+
+ Note how fullscreen differs on the NS port
+
+ doc/lispref/frames.texi (Size Parameters):
+ doc/emacs/frames.texi (Tool Bars): Add a description of how macOS
+ hides the tool-bar and menu-bar in fullscreen.
+
+2017-06-12 Alan Third <alan@idiocy.org>
+
+ Add no-focus-on-map to NS build (bug#25408)
+
+ * src/nsfns.m (ns_frame_parm_handlers): Add x_set_no_focus_on_map.
+ (x-create-frame): Check for no-focus-on-map.
+ * src/nsterm.h (x_set_no_focus_on_map): New function.
+ * src/nsterm.m (x_set_no_focus_on_map): New function.
+ (ns_raise_frame): Add parameter for specifying whether to focus the
+ frame.
+ (ns_frame_raise_lower):
+ (x_make_frame_visible): Handle new parameter for ns_raise_frame.
+
+2017-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ _Noreturn not noreturn
+
+ _Noreturn is more portable to non-C11 platforms. See:
+ https://www.gnu.org/software/gnulib/manual/html_node/stdnoreturn_002eh.html
+ * src/emacs-module.c: Use _Noreturn, not noreturn. No need to
+ include <stdnoreturn.h>. Reindent to fit in 80 columns.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Update make-dist for recent test/ changes
+
+ * make-dist: No longer distribute test/data/emacs-module/Makefile.
+
+2017-06-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Handle port and domain in Tramp's password cache
+
+ * doc/misc/tramp.texi (Password handling): Explain port and
+ domain handling in authinfo.
+
+ * lisp/net/tramp.el (tramp-process-actions, tramp-clear-passwd):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handler-askpassword):
+ * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-maybe-open-connection):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl)
+ (tramp-smb-maybe-open-connection): Handle also domain and port.
+
+2017-06-12 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compilation warnings with pre-C99 libc
+
+ * src/emacs-module.c (module_free_global_ref)
+ (module_assert_runtime, module_assert_env, value_to_lisp): Use 'pD'
+ instead of C99 't' format descriptor.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Flush all output streams before aborting
+
+ Maybe the stdout buffer still contains something interesting that
+ should be flushed.
+
+ * src/emacs-module.c (module_abort): Flush all output streams before
+ aborting.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Remove an assertion that doesn't test Emacs invariants
+
+ * src/emacs-module.c (module_copy_string_contents): Remove an
+ assertion that doesn't test Emacs invariants.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Test module: add necessary version checks
+
+ * test/data/emacs-module/mod-test.c (emacs_module_init): Add necessary
+ version checks.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Use additional CFLAGS from configure
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Use Autoconf to generate the test module Makefile
+
+ This makes it easier to pass compilation flags around.
+
+ * configure.ac: Also build test module Makefile.
+
+ * test/data/emacs-module/Makefile.in: New makefile template.
+
+ * test/Makefile.in ($(test_module)): No longer necessary to pass
+ @MODULES_SUFFIX@ around.
+
+ * .gitignore: Test module Makefile can now be ignored.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Also compile test module as C11
+
+ * test/data/emacs-module/Makefile (CFLAGS): Compile test module as C11
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Implement module assertions for users
+
+ Add a new command-line option '-module-assertions' that users can
+ enable developing or debugging a module. If this option is present,
+ Emacs performs additional checks to verify that modules fulfill their
+ requirements. These checks are expensive and crash Emacs if modules
+ are invalid, so disable them by default.
+
+ This is a command-line option instead of an ordinary variable because
+ changing it while Emacs is running would cause data structure
+ imbalances.
+
+ * src/emacs.c (main): New command line option '-module-assertions'.
+
+ * src/emacs-module.c (module_assert_main_thread)
+ (module_assert_runtime, module_assert_env, module_assert_value):
+ New functions to assert module requirements.
+ (syms_of_module): New uninterned variable 'module-runtimes'.
+ (init_module_assertions, in_main_thread, module_abort): New helper
+ functions.
+ (initialize_environment): Initialize value list. If assertions are
+ enabled, use a heap-allocated environment object.
+ (finalize_environment): Add assertion that environment list is never
+ empty.
+ (finalize_runtime_unwind): Pop module runtime object stack.
+ (value_to_lisp): Assert that the value is valid.
+ (lisp_to_value): Record new value if assertions are enabled.
+ (mark_modules): Mark allocated object list.
+ (MODULE_FUNCTION_BEGIN_NO_CATCH)
+ (module_non_local_exit_check, module_non_local_exit_clear)
+ (module_non_local_exit_get, module_non_local_exit_signal)
+ (module_non_local_exit_throw): Assert thread and environment.
+ (module_get_environment): Assert thread and runtime.
+ (module_make_function, module_funcall, module_intern)
+ (module_funcall, module_make_integer, module_make_float)
+ (module_make_string, module_make_user_ptr, module_vec_get)
+ (funcall_module, Fmodule_load): Adapt callers.
+ (module_make_global_ref): If assertions are enabled, use the global
+ environment to store global values.
+ (module_free_global_ref): Remove value from global value list.
+
+ * test/Makefile.in (EMACSOPT): Enable module assertions when testing
+ modules.
+
+ * test/data/emacs-module/mod-test.c (Fmod_test_invalid_store)
+ (Fmod_test_invalid_load): New functions to test module assertions.
+ (emacs_module_init): Bind the new functions.
+
+ * test/src/emacs-module-tests.el (mod-test-emacs): New constant for
+ the Emacs binary file.
+ (mod-test-file): New constant for the test module file name.
+ (module--test-assertions): New unit test.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ emacs-module: Use __attribute__((nonnull))
+
+ Annotate all parameters with __attribute__((nonnull)) that may not be
+ NULL.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Explicitly require C11 or C++11 in emacs-module.h
+
+ We already implicitly require them by including stdbool.h. Just make
+ the error message a bit clearer, and remove an unnecessary version
+ comparison.
+
+2017-06-12 Philipp Stephani <phst@google.com>
+
+ Add missing 'require' forms to prevent compiler warnings.
+
+ * lisp/eshell/esh-ext.el (esh-arg, esh-proc): Add missing
+ requirements.
+
+2017-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-06-11 getopt-posix: port to glibc 2.25.90
+ 2017-06-04 same-inode: port better to VMS 8.2 and later
+ * doc/misc/texinfo.tex, lib/getopt-pfx-core.h, lib/getopt-pfx-ext.h:
+ * m4/sys_types_h.m4: Copy from gnulib.
+
+2017-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove Lisp_Misc_Float
+
+ * src/data.c (Ftype_of): Do not worry about Lisp_Misc_Float.
+ * src/lisp.h (Lisp_Misc_Float): Remove. This placeholder has been
+ unused for two decades; if we ever want to change floats to be a
+ misc type we can bring it back then.
+
+2017-06-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make two symbols private to emacs-module.c
+
+ * src/lisp.h (allocate_module_function, XSET_MODULE_FUNCTION):
+ Move from here ...
+ * src/emacs-module.c: ... to here.
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Merge from origin/emacs-25
+
+ da62c1532e4 (origin/emacs-25) Improve the documentation of filesets
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Merge from origin/emacs-25
+
+ e80f6a210b0 Describe problems with Microsoft Intellipoint
+ a73ec1edb07 More accurate documentation of the ':box' face attribute
+
+2017-06-12 Glenn Morris <rgm@gnu.org>
+
+ Merge from origin/emacs-25
+
+ eaa00584ceb Improve documentation of 'gnutls-verify-error'
+ 908498cc01b ; etc/PROBLEMS: Describe GTK-related crashes on elementar...
+ 741daec617e ; Describe the problem with ksh when resizing shell window
+
+2017-06-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Some further improvements for tramp-gvfs.el
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name)
+ (tramp-gvfs-get-file-attributes)
+ (tramp-gvfs-maybe-open-connection): Handle davs? properly.
+ (tramp-gvfs-handler-askquestion): Improve `yes-or-no-p' prompt.
+ Show question also in batch mode. Cache result.
+
+ * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion):
+ Support completion for host names and ports.
+
+2017-06-11 Simen Heggestøyl <simenheg@gmail.com>
+
+ Fix highlighting of CSS selectors with double hyphens
+
+ * lisp/textmodes/css-mode.el (css--font-lock-keywords): Fix
+ highlighting of selectors that contain double hyphens. They would be
+ mistaken for a variable.
+
+2017-06-11 Philipp Stephani <phst@google.com>
+
+ Support threads in modules
+
+ Rather than checking for the main thread, check for the current
+ thread.
+
+ * src/emacs-module.c (check_thread): New function.
+ (MODULE_FUNCTION_BEGIN_NO_CATCH, module_get_environment)
+ (module_non_local_exit_check, module_non_local_exit_clear)
+ (module_non_local_exit_get, module_non_local_exit_signal)
+ (module_non_local_exit_throw, module_is_not_nil, module_eq): Use it.
+
+2017-06-11 Philipp Stephani <phst@google.com>
+
+ Allow non-local exits in module initializers
+
+ Previously signals, throws, and quits from module initialization
+ functions were ignored. These function aren't special, and better
+ errors can be reported using signals than with the initialization
+ return code, so allow non-local exits.
+
+ * src/emacs-module.c (module_signal_or_throw): New helper function.
+ (Fmodule_load, funcall_module): Use it.
+ (Fmodule_load): Also allow quitting.
+
+2017-06-11 Noam Postavsky <npostavs@gmail.com>
+
+ Let eshell/sudo handle absolute command names (Bug#27167)
+
+ * lisp/eshell/esh-ext.el (eshell-find-interpreter): Don't change
+ absolute paths into relative ones.
+
+2017-06-10 Alan Third <alan@idiocy.org>
+
+ Don't wait for toolbar in NS native fullscreen
+
+ * src/nsterm.m (EmacsView:updateFrameSize): Don't short-circuit the
+ function when in fullscreen.
+
+2017-06-10 Alexander Gramiak <agrambot@gmail.com>
+
+ Fix the placement of GTK menus on multi-monitor systems
+
+ menu_position_func did not properly use the current monitor's
+ resolution. Also see commit '2016-02-06 22:12:53 +0100'.
+
+ * lisp/frame.el (frame-monitor-attribute, frame-monitor-geometry)
+ (frame-monitor-workarea): New functions.
+
+ * src/xmenu.c (menu_position_func): Take into account the workarea of
+ the monitor that contains the mouse. (Bug#23568)
+
+2017-06-10 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify documentation of 'face-spec-set'
+
+ * lisp/faces.el (face-spec-set): Clarify the description of
+ SPEC-TYPE in the doc string.
+
+ * doc/lispref/display.texi (Defining Faces): Clarify the
+ description of 'face-spec-set's SPEC-TYPE argument. (Bug#27246)
+
+2017-06-10 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix domain port and handling in tramp-gvfs.el
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-dbus-byte-array-to-string):
+ Return nil if BYTE-ARRAY is nil.
+ (tramp-gvfs-url-file-name, tramp-gvfs-handler-mounted-unmounted)
+ (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec):
+ Fix domain and port handling.
+
+ * lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p):
+ Ignore errors.
+
+2017-06-10 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'face-spec-set-2'
+
+ * lisp/faces.el (face-spec-recalc, face-spec-set-2): Rename 'spec'
+ to 'face-attrs'.
+ (face-spec-choose, face-spec-set-2): Doc fix. (Bug#27238)
+
+2017-06-10 Eli Zaretskii <eliz@gnu.org>
+
+ Fix handling of Python/Guile commands with arguments in gdb-mi.el
+
+ * lisp/progmodes/gdb-mi.el (gdb-python-guile-commands-regexp): New
+ variable.
+ (gdb-control-commands-regexp): Use it.
+ (gdb-send): Don't increment gdb-control-level if the command
+ matches gdb-python-guile-commands-regexp and has non-empty
+ arguments. Reported by David Boles <boles@ieee.org> in
+ https://lists.gnu.org/r/emacs-devel/2017-06/msg00009.html.
+
+2017-06-10 Eli Zaretskii <eliz@gnu.org>
+
+ Preserve point in Dired windows under 'dired-auto-revert-buffer'
+
+ * lisp/dired.el (dired-find-file): When dired-auto-revert-buffer
+ is non-nil, bind switch-to-buffer-preserve-window-point to nil
+ while calling find-file. (Bug#27243)
+
+2017-06-09 Philipp Stephani <phst@google.com>
+
+ Give test files a -tests.el suffix
+
+ Rename a couple of test files that have the same name as the library
+ they test. This harmonizes the naming pattern and makes it possible
+ to have the tests directories in the load path.
+
+2017-06-09 Philipp Stephani <phst@google.com>
+
+ Fix another compiler warning on macOS
+
+ * src/image.c (x_query_frame_background_color): Don't define if we
+ have NextStep but no image support.
+
+2017-06-09 Philipp Stephani <phst@google.com>
+
+ Add garbage collection support for module environments
+
+ * src/emacs-module.c (mark_modules): New function.
+ (initialize_environment): Properly initialize Lisp objects.
+ * src/alloc.c (garbage_collect_1): Call it.
+
+2017-06-08 Glenn Morris <rgm@gnu.org>
+
+ Make autogen.sh report relevant environment variables
+
+ * autogen.sh (check_version):
+ Indicate if using an environment variable.
+
+2017-06-08 Noam Postavsky <npostavs@gmail.com>
+
+ Split variable macro env from function env
+
+ * lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand): Remove.
+ (cl-symbol-macrolet): Instead of adding each binding directly into the
+ main environment with a special key format, put all symbol macro
+ bindings into a single entry in the main environment under
+ `:cl-symbol-macros'.
+ (cl--sm-macroexpand): Look up symbol bindings in the
+ `:cl-symbol-macros' entry of the environment.
+
+2017-06-07 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: Directory modules/mod-test no longer exists.
+
+2017-06-07 Glenn Morris <rgm@gnu.org>
+
+ More authors.el updates
+
+ * admin/authors.el (authors-ignored-files, authors-valid-file-names)
+ (authors-renamed-files-alist): Additions.
+
+2017-06-07 Glenn Morris <rgm@gnu.org>
+
+ * make-dist: Check a release has a ChangeLog with a release notice.
+
+ * make-dist: Use existing ChangeLog if present.
+
+2017-06-07 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Fix port handling.
+
+2017-06-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ (url-cookie-host-can-set-p): Protect against zero-length domains
+
+ * lisp/url/url-cookie.el (url-cookie-host-can-set-p): Protect
+ against zero-length domains.
+
+ Backtrace of a real-world site that triggers a bug:
+
+ Debugger entered--Lisp error: (args-out-of-range "" 0)
+ url-cookie-host-can-set-p("www.washingtonpost.com" "")
+ url-cookie-handle-set-cookie("utm_term=0;Expires=Thursday,
+ 01-January-1970 00:00:00 GMT; path=/; domain=")
+ url-http-handle-cookies()
+
+2017-06-06 Glenn Morris <rgm@gnu.org>
+
+ More authors.el updates
+
+ * admin/authors.el (authors-obsolete-files-regexps)
+ (authors-valid-file-names, authors-renamed-files-alist)
+ (authors-renamed-files-regexps): Additions.
+
+2017-06-06 Glenn Morris <rgm@gnu.org>
+
+ More small authors.el updates
+
+ * admin/authors.el (authors-aliases): Fix recent addition.
+ (authors-obsolete-files-regexps, authors-no-scan-regexps)
+ (authors-ignored-files, authors-valid-file-names)
+ (authors-renamed-files-alist): Additions.
+
+2017-06-06 Glenn Morris <rgm@gnu.org>
+
+ Make authors.el report names that were ignored
+
+ * admin/authors.el (authors-ignored-names): New.
+ (authors-canonical-author-name): Add file and position arguments.
+ Record ignored authors.
+ (authors-scan-change-log, authors-scan-el):
+ Pass file and position to authors-canonical-author-name.
+ (authors): Also print authors that were ignored.
+
+2017-06-06 Glenn Morris <rgm@gnu.org>
+
+ * admin/authors.el (authors-aliases): Additions.
+
+2017-06-06 Tino Calancha <tino.calancha@gmail.com>
+
+ * test/lisp/subr-tests.el (subr-tests-bug22027): Add test.
+
+2017-06-06 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/subr.el (read-passwd): Don't delete return value (Bug#22027).
+
+2017-06-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ Enable ElDoc messages after the newline command
+
+ * lisp/emacs-lisp/eldoc.el:
+ Add "newline" to the eldoc-add-command-completions call (bug#27228).
+
+2017-06-06 Dmitry Gutov <dgutov@yandex.ru>
+
+ Enable eldoc-mode explicitly inside read--expression
+
+ * lisp/simple.el (read--expression): Call eldoc-mode (bug#27202).
+
+2017-06-06 Andy Moreton <andrewjmoreton@gmail.com>
+
+ Fix check for package-unsigned-archives during retrieval
+
+ * lisp/emacs-lisp/package.el (package--download-one-archive):
+ Fix check for package-unsigned-archives.
+
+2017-06-05 Noah Friedman <friedman@splode.com>
+
+ Merge etc/emacs-buffer.gdb from emacs-25 to master.
+
+2017-06-05 Philipp Stephani <phst@google.com>
+
+ Fix undefined behavior in mapbacktrace
+
+ * src/eval.c (Fmapbacktrace): Don't assume that PDL is still valid.
+
+2017-06-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix emacs-module-tests on MS-Windows
+
+ * src/print.c (print_vectorlike): Make sure module function's
+ address prints with a leading "0x". This fixes emacs-module-tests
+ on MS-Windows. Fix whitespace.
+ * src/dynlib.c (dynlib_addr): Remove unused variable. Update
+ commentary.
+
+2017-06-05 Philipp Stephani <phst@google.com>
+
+ Use unwind protection to clean up data structures in modules
+
+ Reuse existing functionality and simplify the code a bit.
+
+ * src/emacs-module.c (Fmodule_load): Use unwind protection to clean up
+ runtime object.
+ (funcall_module): Use unwind protection to clean up environment
+ object.
+ (finalize_environment): Simplify signature.
+ (finalize_environment_unwind, finalize_runtime_unwind): New functions.
+
+2017-06-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Some minor tweaks in tramp-tests.el
+
+ * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name-relative):
+ Let it pass for all gfvs based methods.
+ (tramp-test24-file-name-completion): Run method and host
+ completion for all syntaxes only when expensive tests are enabled.
+ Do not check host completion for gvfs based methods.
+ (tramp--test-gvfs-p): Add optional METHOD argument.
+ (tramp--test-afp-or-smb-p): Remove.
+
+2017-06-05 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix error in Tramp rsync method
+
+ * lisp/net/tramp-sh.el (tramp-methods) <rsync>: Add "-c" argument.
+ Otherwise, `tramp-test10-write-region' could fail.
+
+2017-06-05 Philipp Stephani <phst@google.com>
+
+ Inline module_has_cleanup
+
+ This constant is only used once, and we fail compilation anyway if
+ it's false.
+
+ * src/emacs-module.c (MODULE_SETJMP_1): Inline __has_attribute.
+
+2017-06-05 Philipp Stephani <phst@google.com>
+
+ Add missing dependency to test module source file
+
+2017-06-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Omit space that broke ‘make check’
+
+ * src/print.c (print_vectorlike): Omit stray space.
+
+2017-06-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove easserts etc. from emacs-module.c
+
+ Most of these seem to run afoul of the comment "Do NOT use
+ 'eassert' for checking validity of user code in the module."
+ * src/emacs-module.c (MODULE_FUNCTION_BEGIN_NO_CATCH)
+ (module_non_local_exit_check, module_non_local_exit_clear)
+ (module_non_local_exit_get, module_non_local_exit_signal)
+ (module_non_local_exit_throw, module_make_string):
+ Remove unnecessary easserts that pointers are nonnull.
+ Hardware checks this for us nowadays, and the checks
+ just clutter up the code.
+ (module_extract_integer): Remove unnecessary verify that
+ a C signed integer is in the range INTMAX_MIN..INTMAX_MAX.
+ The C standard guarantees this.
+ (module_copy_string_contents): Remove unnecessary eassert
+ that Lisp strings are null-terminated.
+ (module_function_arity): Remove unnecessary easserts that
+ function arities are in range.
+
+2017-06-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unnecessary checking in emacs-module.c
+
+ * src/emacs-module.c (module_copy_string_contents):
+ Remove checking, as string lengths are always nonnegative and less
+ than STRING_BYTES_BOUND, and this is checked elsewhere.
+ (module_make_string): Check length against STRING_BYTES_BOUND, a
+ tighter bound than MOST_POSITIVE_FIXNUM. (funcall_module): Don't
+ assume that an out-of-range integer is nonnegative.
+
+2017-06-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ SCHARS and STRING_BYTES are nonnegative
+
+ Tell the compiler that SCHARS and STRING_BYTES are nonnegative, in
+ the hopes that this will optimize a bit better. Also, check this
+ at runtime if ENABLE_CHECKING.
+ * src/lisp.h (SCHARS, STRING_BYTES):
+ eassume that these functions return nonnegative values.
+ (STRING_SET_CHARS) [ENABLE_CHECKING]:
+ eassert that newsize is nonnegative.
+
+2017-06-05 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/desktop.el (desktop-clear): Skip the daemon's frame (Bug#26912).
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Remove an unused error symbol
+
+ * src/emacs-module.c (syms_of_module): Remove unused error symbol
+ 'invalid-module-call'.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Support quitting in modules
+
+ The idea is that modules should call env->should_quit from time to
+ time and return as quickly as possible if it returns true.
+
+ * src/emacs-module.c (module_should_quit): New module function.
+ (initialize_environment): Use it.
+ (funcall_module): Process potential pending quit.
+
+ * src/eval.c (maybe_quit): Add reference to module_should_quit.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Use more specific errors for module load failure
+
+ * src/emacs-module.c (syms_of_module): Add more specific error
+ symbols.
+ (Fmodule_load): Use them.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Remove an unneeded assertion
+
+ * src/emacs-module.c (module_copy_string_contents): Remove unneeded
+ assertion. If this assertion triggers, we raise an error anyway.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Guard against signed integer overflows
+
+ * src/emacs-module.c (module_extract_integer)
+ (module_copy_string_contents, module_make_string): Guard against
+ signed integer overflows.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Add a couple more assertions to the module code
+
+ These can help module authors debug crashes.
+
+ * src/emacs-module.c (module_non_local_exit_check)
+ (module_non_local_exit_clear, module_non_local_exit_get)
+ (module_non_local_exit_signal, module_non_local_exit_throw)
+ (module_copy_string_contents, module_make_string)
+ (funcall_module, initialize_environment): Add assertions
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Use ATTRIBUTE_MAY_ALIAS where alias violations are likely
+
+ In particular, alias violations are likely for the return values of
+ dlsym(3), which get cast around arbitrarily.
+
+ * src/emacs-module.c (Fmodule_load): Use ATTRIBUTE_MAY_ALIAS.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Simplify interface of dynlib_attr.
+
+ Instead of returning bool, set the argument pointers to NULL if the
+ information is not available.
+
+ * src/dynlib.c (dynlib_addr): Don't return bool.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Rationalize environment lifetime management functions
+
+ * src/emacs-module.c (Fmodule_load, funcall_module): Adapt callers.
+ (finalize_environment): Add parameter for public part of the
+ environment, like 'initialize_environment'. Add assertions.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Rework printing of module functions
+
+ Fix a FIXME in emacs-module.c. Put the printing into print.c, like
+ other types.
+
+ * src/print.c (print_vectorlike): Add code to print module functions.
+
+ * src/emacs-module.c (funcall_module): Stop calling
+ 'module_format_fun_env'. Now that module functions are first-class
+ objects, they can be added to signal data directly.
+ (module_handle_signal): Remove now-unused function
+ 'module_format_fun_env'.
+
+ * test/src/emacs-module-tests.el (mod-test-sum-test): Adapt unit test.
+
+ * src/eval.c (funcall_lambda): Adapt call to changed signature of
+ 'funcall_module'.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Define helper macro to reduce code duplication
+
+ * src/emacs-module.c (MODULE_FUNCTION_BEGIN_NO_CATCH): New helper
+ macro.
+ (MODULE_FUNCTION_BEGIN, module_type_of, module_is_not_nil, module_eq):
+ Use it.
+
+2017-06-04 Philipp Stephani <phst@google.com>
+
+ Remove two FIXMEs that can't be fixed
+
+2017-06-04 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid slow startup in daemon mode when global-linum-mode is on
+
+ * lisp/linum.el (linum-on): Don't turn on linum-mode in a
+ non-client frame of a daemon session. (Bug#27210)
+
+2017-06-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix eldoc bug with curved quote
+
+ * lisp/progmodes/elisp-mode.el (elisp-get-fnsym-args-string):
+ Substitute quotes in documentation before returning it (Bug#27159).
+
+2017-06-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Tune ‘format’ after recent fix
+
+ * doc/lispref/strings.texi (Formatting Strings):
+ * src/editfns.c (Fformat): Format field numbers no longer need
+ to be unique, reverting the previous doc change since that has
+ now been fixed. Also, document that %% should not have modifiers.
+ * src/editfns.c (styled_format): Improve performance. Remove
+ the need for the new prepass over the format string, by using
+ a typically-more-generous bound for the info array size.
+ Initialize the info array lazily. Move string inspection to
+ the same area to help caching. Avoid the need for a
+ converted_to_string bitfield by using EQ. Cache arg in a
+ local and avoid some potential aliasing issues to help the
+ compiler. Info array is now 0-origin, not 1-origin.
+
+2017-06-04 Nikolay Kudryavtsev <nikolay.kudryavtsev@gmail.com>
+
+ Improve of file-local-name use in vc-git-checkin
+
+ * lisp/vc/vc-git.el (vc-git-checkin): Use file-local-name only
+ when calling git commit.
+
+2017-06-03 Simen Heggestøyl <simenheg@gmail.com>
+
+ Support a new CSS indentation style
+
+ * lisp/textmodes/css-mode.el (css-smie-rules): Indent after property
+ immediately followed by a newline.
+
+ * test/manual/indent/css-mode.css: Add test for the change above.
+
+ * test/manual/indent/scss-mode.scss: Ditto.
+
+2017-06-03 Philipp Stephani <phst@google.com>
+
+ Fix a bug when using format field numbers
+
+ Previously styled_format overwrite the argument vector. This is no
+ longer possible because there might be more than one specification per
+ argument. Use the existing auxiliary info array instead.
+
+ * src/editfns.c (styled_format): Record arguments in the info
+ structure instead of overwriting them.
+ * test/src/editfns-tests.el (format-with-field): Add unit test.
+
+2017-06-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Document uniqueness limitation of ‘format’
+
+ * doc/lispref/strings.texi (Formatting Strings):
+ * src/editfns.c (Fformat):
+ Document that field numbers should be unique within a format.
+
+2017-06-03 Glenn Morris <rgm@gnu.org>
+
+ Small rmailmm fix (bug#27203)
+
+ * lisp/mail/rmailmm.el (rmail-mime-insert-bulk):
+ Fall back to HOME if no match in rmail-mime-attachment-dirs-alist.
+
+2017-06-03 Glenn Morris <rgm@gnu.org>
+
+ * admin/authors.el (authors-aliases): Addition.
+
+2017-06-03 Glenn Morris <rgm@gnu.org>
+
+ Add watch for password back to inferior python comint filter
+
+ It was removed along with other items for speed (bug#16875),
+ but doesn't seem to have been causing an issue, and it's useful to
+ have it there (bug#27154).
+ * lisp/progmodes/python.el (inferior-python-mode):
+ Add comint-watch-for-password-prompt to comint-output-filter-functions.
+
+2017-06-03 Ryan <rct@thompsonclan.org> (tiny change)
+
+ Use completing-read-default in tmm-prompt
+
+ tmm uses completing-read, but customizes its behavior so much
+ that any alternative completing-read-function will almost
+ certainly break it. For example, both ido-ubiquitous and ivy have
+ special code to deactivate themselves for tmm.
+ * lisp/tmm.el (tmm-prompt): Use completing-read-default instead of
+ completing-read. (Bug#27193)
+
+2017-06-02 Mats Lidell <mats.lidell@cag.se>
+
+ * etc/tutorials/TUTORIAL.sv: synced with TUTORIAL (Bug#20371)
+
+2017-06-02 Glenn Morris <rgm@gnu.org>
+
+ Fix with-todo-test
+
+ * test/lisp/calendar/todo-mode-tests.el (with-todo-test):
+ HOME should be a directory, not a file. Delete it when finished.
+
+2017-06-02 Lele Gaifax <lele@metapensiero.it> (tiny change)
+
+ Update TUTORIAL.it
+
+ * etc/tutorials/TUTORIAL.it: Adjust to recent changes in TUTORIAL.
+
+2017-06-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix cursor position in Dired buffers after dired-sort-toggle
+
+ * src/xdisp.c (display_and_set_cursor): Record cursor coordinates
+ even if the frame is marked as garbaged. (Bug#27187)
+
+2017-06-02 Eli Zaretskii <eliz@gnu.org>
+
+ Update TUTORIAL.he
+
+ * etc/tutorials/TUTORIAL.he: Adjust to recent changes in TUTORIAL.
+
+2017-06-02 Noam Postavsky <npostavs@gmail.com>
+
+ * etc/tutorials/TUTORIAL: Explain how to stop the tutorial (Bug#20371).
+
+2017-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Limit format fields to more POSIX-like spec
+
+ * doc/lispref/strings.texi (Formatting Strings):
+ Don’t allow mixing numbered with unnumbered format specs.
+ * src/editfns.c (styled_format): Don’t bother checking for field 0,
+ since it doesn’t crash and the behavior is not specified.
+ * test/src/editfns-tests.el (format-with-field): Adjust tests to
+ match current doc. Add more tests for out-of-range fields.
+
+2017-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve performance by avoiding strtoumax
+
+ This made (string-to-number "10") 20% faster on my old desktop,
+ an AMD Phenom II X4 910e running Fedora 25 x86-64.
+ * admin/merge-gnulib (GNULIB_MODULES): Remove strtoumax.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib/strtoul.c, lib/strtoull.c, lib/strtoumax.c, m4/strtoull.m4:
+ * m4/strtoumax.m4: Remove.
+ * src/editfns.c (str2num): New function.
+ (styled_format): Use it instead of strtoumax. Use ptrdiff_t
+ instead of uintmax_t. Check for integer overflow.
+ * src/lread.c (LEAD_INT, DOT_CHAR, TRAIL_INT, E_EXP):
+ Move to private scope and make them enums.
+ (string_to_number): Compute integer value directly during
+ first pass instead of revisiting it with strtoumax later.
+
+2017-06-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor improvements to format field numbers
+
+ * src/editfns.c (styled_format): Allow field numbers in a %% spec.
+ No need for a special diagnostic for field numbers greater than
+ PTRDIFF_MAX. Reword diagnostic for field 0.
+ * test/src/editfns-tests.el (format-with-field): Adjust to match.
+
+2017-06-02 Philipp Stephani <phst@google.com>
+
+ Implement field numbers in format strings
+
+ A field number explicitly specifies the argument to be formatted.
+ This is especially important for potential localization work, since
+ grammars of various languages dictate different word orders.
+
+ * src/editfns.c (Fformat): Update documentation.
+ (styled_format): Implement field numbers.
+
+ * doc/lispref/strings.texi (Formatting Strings): Document field numbers.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-format-warn): Adapt.
+
+ * test/src/editfns-tests.el (format-with-field): New unit test.
+
+2017-06-01 Alexander Gramiak <agrambot@gmail.com>
+
+ Limit scope of local overriding-terminal-local-map
+
+ The function `binding' may call isearch-done, which globally sets
+ overriding-terminal-local-map to nil (Bug#23007).
+ * lisp/isearch.el (isearch-mouse-2): Don't bind
+ overriding-terminal-local-map around the call to `binding'.
+
+2017-06-01 Stephen Berman <stephen.berman@gmx.net>
+
+ Correct and isolate the todo-mode test environment
+
+ This avoids having to set todo-mode variables globally in the test
+ file and prevents any exisiting user todo-mode files from influencing
+ the tests.
+
+ * test/lisp/calendar/todo-mode-tests.el:
+ (with-todo-test): New macro.
+ (todo-test-todo-quit01, todo-test-todo-quit02)
+ (todo-test-item-highlighting): Use it.
+
+2017-06-01 Alan Third <alan@idiocy.org>
+
+ Fix build errors on macOS 10.6 (bug#27059)
+
+ * src/nsfns.m (compute_tip_xy): Don't use CGRectContainsPoint.
+
+2017-06-01 Eli Zaretskii <eliz@gnu.org>
+
+ Improve testing of octal and hex display of raw bytes
+
+ * test/manual/redisplay-testsuite.el (test-redisplay-5-toggle)
+ (test-redisplay-5): Add a test with a large codepoint.
+
+2017-06-01 Vasilij Schneidermann <mail@vasilij.de>
+
+ Add customizable to display raw bytes as hex
+
+ * src/xdisp.c (get_next_display_element): Dispatch used format string
+ for unprintables based on new display-raw-bytes-as-hex variable.
+ (display-raw-bytes-as-hex): New variable. (Bug#27122)
+
+ * lisp/cus-start.el: Add defcustom form for display-raw-bytes-as-hex.
+
+ * doc/emacs/display.texi: Document the new variable.
+ * etc/NEWS: Mention display-raw-bytes-as-hex.
+
+ * test/manual/redisplay-testsuite.el (test-redisplay-5-toggle)
+ (test-redisplay-5): New tests.
+ (test-redisplay): Call test-redisplay-5.
+
+2017-06-01 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "Add customizable to display raw bytes as hex"
+
+ This reverts commit 7c9ac111c5e5d92e620b666893993d5dc562e483.
+
+2017-06-01 Eli Zaretskii <eliz@gnu.org>
+
+ Add customizable to display raw bytes as hex
+
+ * src/xdisp.c (get_next_display_element): Dispatch used format string
+ for unprintables based on new display-raw-bytes-as-hex variable.
+ (display-raw-bytes-as-hex): New variable. (Bug#27122)
+
+ * lisp/cus-start.el: Add defcustom form for display-raw-bytes-as-hex.
+
+ * doc/emacs/display.texi: Document the new variable.
+ * etc/NEWS: Mention display-raw-bytes-as-hex.
+
+ * test/manual/redisplay-testsuite.el (test-redisplay-5-toggle)
+ (test-redisplay-5): New tests.
+ (test-redisplay): Call test-redisplay-5.
+
+2017-06-01 Eli Zaretskii <eliz@gnu.org>
+
+ Fix linum under text-scaling when leuven-theme is used
+
+ * etc/themes/leuven-theme.el (linum): Make the 'linum' face
+ inherit from 'default' and 'shadow', so that margins are enlarged
+ as expected under text-scaling.
+
+2017-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Free cwd when no longer needed
+
+ * lib-src/emacsclient.c (main): Don’t dally when freeing cwd.
+
+2017-06-01 Anders Waldenborg <anders@0x63.nu> (tiny change)
+
+ Fix memory leak of cwd string in emacsclient (Bug#26628)
+
+ * lib-src/emacsclient.c (main): emacsclient retrieves the current
+ working directory using get_current_dir_name which returns a newly
+ allocated string. Make sure this string is freed before exiting.
+
+2017-06-01 Glenn Morris <rgm@gnu.org>
+
+ Quieten compilation of some test files
+
+ * test/lisp/dired-tests.el (dired-test-bug25609): Mark unused args.
+ * test/src/data-tests.el (binding-test-set-constant-t)
+ (binding-test-set-constant-nil, binding-test-set-constant-keyword)
+ (binding-test-set-constant-nil): Silence compiler.
+ * test/src/regex-tests.el (regex-tests-BOOST): Escape char literal.
+
+2017-06-01 Glenn Morris <rgm@gnu.org>
+
+ Use true names for invocation- and source-directory
+
+ * src/emacs.c (init_cmdargs) <Vinvocation_directory>:
+ * src/lread.c (init_lread) <Vsource_directory>: Use true names.
+
+2017-06-01 Glenn Morris <rgm@gnu.org>
+
+ Avoid elisp-mode test failures when source dir has multiple names
+
+ * test/lisp/progmodes/elisp-mode-tests.el (emacs-test-dir):
+ Use the true name of the directory.
+
+2017-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bug with "%%" in error format
+
+ * src/doprnt.c (doprnt): Format "%%" correctly.
+ Problem reported by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00901.html
+
+2017-06-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/editfns.c (Fmessage): Improve doc string (Bug#23425#130).
+
+2017-06-01 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Revert mml-generate-mime-1 (bug#27141)
+
+ * lisp/gnus/mml.el (mml-generate-mime-1): Reverted to emacs-25 version
+ with slight modernizations (bug#27141).
+
+2017-05-31 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#27108
+
+ * lisp/recentf.el (recentf-load-list): Bind `non-essential',
+ in order to avoid Tramp password requests during Emacs
+ startup. (Bug#27108)
+
+2017-05-31 Glenn Morris <rgm@gnu.org>
+
+ * test/Makefile.in (.SECONDARY): Stop make deleting .elc files.
+
+2017-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ Document current-line hscrolling in ELisp manual
+
+ * doc/lispref/windows.texi (Horizontal Scrolling): Document the
+ new mode of auto-hscrolling only the current line.
+
+2017-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ Support lower bound on hscrolling when only current line scrolls
+
+ * doc/emacs/display.texi (Horizontal Scrolling): Document the new
+ mode of auto-hscrolling only the current line.
+
+ * src/xdisp.c (init_iterator): When hscrolling only the
+ current line, apply the window's min_hscroll here, so that
+ non-current lines will be hscrolled by that minimum.
+ Suggested by Stephen Berman <stephen.berman@gmx.net>.
+ (hscroll_window_tree): Account for window's min_hscroll when
+ deciding whether to recompute the hscroll.
+ (display_line): Subtract window's min_hscroll from x_incr, as that
+ was already accounted for in init_iterator. (Bug#27008)
+
+2017-05-31 Noam Postavsky <npostavs@gmail.com>
+
+ cl-print: handle circular objects when `print-circle' is nil (Bug#27117)
+
+ * lisp/emacs-lisp/cl-print.el (cl-print--currently-printing): New variable.
+ (cl-print-object): When `print-circle' is nil, bind it to a list of
+ objects that are currently printing to avoid printing the same object
+ endlessly.
+ * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-circle): New test.
+
+2017-05-31 Noam Postavsky <npostavs@gmail.com>
+
+ Further simplify test/Makefile, optionally load elc tests
+
+ * test/Makefile.in: Use make's error ignoring feature instead of
+ suppressing test errors with shell. Compile test files in the main
+ make invocation instead of a recursive 'make' call. Optionally load
+ .elc test files if TEST_LOAD_EL is set to something other than 'yes'.
+ Remove obsolete commentary.
+
+2017-05-31 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid inflooping in redisplay due to Spacemacs and linum-mode
+
+ * src/xdisp.c (redisplay_internal): Limit the number of redisplay
+ retries when a frame becomes garbaged as result of redisplaying
+ it. (Bug#27115)
+
+2017-05-31 Tino Calancha <tino.calancha@gmail.com>
+
+ * src/editfns.c (decode-time): Fix docstring.
+
+2017-05-31 Glenn Morris <rgm@gnu.org>
+
+ * admin/update_autogen: Remove bzr support.
+
+2017-05-31 Glenn Morris <rgm@gnu.org>
+
+ Avoid subr test failure when source dir has multiple names
+
+ * test/lisp/subr-tests.el (subr-tests--this-file):
+ Use the true name of the file. The following test does a string
+ comparison of this value with that from method-files, which uses
+ load-history, which contains true names.
+
+2017-05-31 Dmitry Gutov <dgutov@yandex.ru>
+
+ Extract eldoc--supported-p
+
+ * lisp/emacs-lisp/eldoc.el (eldoc--supported-p): New function.
+ (turn-on-eldoc-mode, eldoc-mode): Use it.
+ (https://lists.gnu.org/r/emacs-devel/2017-05/msg00865.html)
+
+2017-05-30 Glenn Morris <rgm@gnu.org>
+
+ Make "make check" less verbose by default
+
+ * test/Makefile.in (AM_DEFAULT_VERBOSITY, AM_V_ELC, am__v_ELC_)
+ (am__v_ELC_0, am__v_ELC_1, AM_V_GEN, am__v_GEN_, am__v_GEN_0)
+ (am__v_GEN_1, AM_V_at, am__v_at_, am__v_at_0, am__v_at_1):
+ New, copied from lisp/Makefile.in.
+ (%.elc, %.log): Simplify and quieten.
+
+2017-05-30 Alan Mackenzie <acm@muc.de>
+
+ Mode line "%q" construct: Just use one number when both would be the same.
+
+ * src/xdisp.c (decode_mode_spec): recode the "%q" bit appropriately.
+
+2017-05-30 Alan Mackenzie <acm@muc.de>
+
+ Merge branch 'master' of /home/acm/emacs/emacs.git/master
+
+2017-05-30 Alan Mackenzie <acm@muc.de>
+
+ c-defun-name: Return fully qualified method names when wanted in C++, etc.
+
+ * lisp/progmodes/cc-cmds.el (c-defun-name): Use
+ c-back-over-compound-identifier in place of c-backward-token-2 near the end
+ of the function.
+
+2017-05-30 Glenn Morris <rgm@gnu.org>
+
+ Reduce scope of recent test/Makefile HOME change
+
+ * test/Makefile.in (%.log): Move setting of HOME here from top-level.
+
+2017-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Skip .#* temporaries when finding sources
+
+ Without this patch, ‘make check’ can fail with the diagnostic
+ ‘invalid syntax in conditional’ if there is an Emacs temporary
+ file whose name starts with ‘.#’, because the ‘#’ is treated as
+ the start of a Make comment.
+ * lisp/Makefile.in (loaddefs, tagsfiles, check-defun-deps):
+ * test/Makefile.in (ELFILES):
+ Skip files starting with ‘.’, so that the .#* files do not cause
+ trouble. (We cannot easily skip just files starting with ‘.#’,
+ since ‘#’ starts a Make comment!)
+
+2017-05-30 Alan Mackenzie <acm@muc.de>
+
+ Merge branch 'master' of /home/acm/emacs/emacs.git/master
+
+2017-05-30 Alan Mackenzie <acm@muc.de>
+
+ Fix the mouse help/key map on the "%p" part of the mode line.
+
+ * lisp/bindings.el (mode-line-percent-position): give it a
+ `risky-local-variable' property.
+ (mode-line-position): correct the quoting on the mode-line-percent-position
+ part of the variable, allowing the properties to be properly recognized.
+
+2017-05-30 Alan Mackenzie <acm@muc.de>
+
+ Fix the mouse help/key map on the "%p" part of the mode line.
+
+ * lisp/bindings.el (mode-line-percent-position): give it a
+ `risky-local-variable' property.
+ (mode-line-position): correct the quoting on the mode-line-percent-position
+ part of the variable, allowing the properties to be properly recognized.
+
+2017-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ * build-aux/config.guess: Copy from gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-05-30 Glenn Morris <rgm@gnu.org>
+
+ Stop make check interacting with HOME
+
+ * test/Makefile.in (HOME): Export a non-existent value.
+
+2017-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update .gitattributes to match sources better
+
+ * .gitattributes: Remove nt/nmake.defs. Move dostorture.c, c.C,
+ algrthms.html. Use pattern for todo-mode. Improve patterns for
+ Ada, C, ObjC, shell. Add Pascal. Remove unused pattern *.ruby.
+ Add config.guess and config.sub as shell files.
+
+2017-05-30 Noam Postavsky <npostavs@gmail.com>
+
+ Rename '--new-daemon' to 'fg-daemon' and '--old-daemon' to '--bg-daemon'
+
+ * doc/emacs/cmdargs.texi (Initial Options):
+ * doc/lispref/os.texi (Startup Summary):
+ * etc/NEWS:
+ * etc/emacs.service:
+ * src/emacs.c (main):
+ * src/lisp.h: Rename '--new-daemon' to 'fg-daemon' and '--old-daemon' to
+ '--bg-daemon'.
+
+2017-05-30 Glenn Morris <rgm@gnu.org>
+
+ todo-mode: don't assume an ordering of tests
+
+ * test/lisp/calendar/todo-mode-tests.el (todo-test-todo-quit02)
+ (todo-test-item-highlighting): Avoid prompting for input file.
+
+2017-05-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve .gdbinit Lisp value pretty-printing
+
+ * src/.gdbinit (to_string): Use an unsigned representation for
+ Lisp values, as requested by Eli Zaretskii (Bug#27098).
+ Also, use "make_number(N)" for Lisp integers.
+
+2017-05-30 Dmitry Gutov <dgutov@yandex.ru>
+
+ Turn global-eldoc-mode into a globalized minor mode
+
+ * lisp/emacs-lisp/eldoc.el (global-eldoc-mode):
+ Turn into globalized mode (bug#19853).
+ (turn-on-eldoc-mode): Make it into a wrapper instead of alias.
+ (eldoc-mode): Only show the message when called interactively.
+
+2017-05-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ Use regexp matching instead of checking exit status
+
+ * lisp/progmodes/xref.el (xref-collect-matches):
+ See if the output buffer contents look like Grep output
+ instead of checking exit status (bug#23451).
+
+2017-05-29 Stephen Berman <stephen.berman@gmx.net>
+
+ Add initial tests for todo-mode.el
+
+ *test/lisp/calendar/todo-mode-tests.el:
+ *test/lisp/calendar/todo-mode-resources/todo-test-1.toda:
+ *test/lisp/calendar/todo-mode-resources/todo-test-1.todo: New files.
+
+ * .gitattributes: Ignore trailing whitespace in todo-mode test
+ data files, since it is part of the todo-mode file format.
+
+2017-05-29 Stephen Berman <stephen.berman@gmx.net>
+
+ Make `todo-toggle-item-highlighting' work on multiline items (bug#27133)
+
+ * lisp/calendar/todo-mode.el (todo-hl-line-range): New named function,
+ replacing an anonymous function for the sake of `describe-variable'.
+ (todo-modes-set-2): Use it as buffer-local value of hl-line-range-function
+ and remove boundp test of this variable, so its value is available on
+ invoking `todo-toggle-item-highlighting'.
+
+2017-05-29 Alan Third <alan@idiocy.org>
+
+ Fix build error on macOS 10.6
+
+ * src/nsfns.m (compute_tip_xy): Cast NSRect to CGRect and NSPoint to
+ CGPoint.
+
+2017-05-29 Jules Tamagnan <jtamagnan@gmail.com> (tiny change)
+
+ Comply with pep 8 style guide for backslash in assignment (Bug#24809)
+
+ * lisp/progmodes/python.el (python-indent--calculate-indentation):
+ Increase indent by `python-indent-offset' after
+ `:after-backslash-assignment-continuation'.
+
+2017-05-29 Wilfred Hughes <me@wilfred.me.uk>
+
+ Add suggestion to docstring
+
+ * lisp/subr.el (interactive-p): Mention commandp, as this is often
+ what users are actually looking for.
+
+2017-05-29 Wilfred Hughes <me@wilfred.me.uk>
+
+ Ensure button-get works in any buffer
+
+ * lisp/button.el (button-get): Previously we assumed that button-get
+ was called in the buffer containing the button. In other buffers,
+ button-get always returned nil. Fix this by passing the relevant
+ buffer from the marker.
+
+2017-05-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ Signal error if find-grep returns a nonzero status
+
+ * lisp/progmodes/xref.el (xref-collect-matches): Signal error
+ if find-grep returns a nonzero status (bug#23451). Remove the
+ comment: even if some output is present, a non-zero status
+ means something went wrong and it can't be relied upon.
+
+2017-05-29 Stephen Berman <stephen.berman@gmx.net>
+
+ Make sure exiting todo-mode buffer buries it (bug#27121)
+
+ This failed due to commit ea3ae33b from 2013-05-16, which prevented
+ quitting todo-mode buffer after visiting todo-archive buffer from
+ making the archive buffer current again. Avoid this now by simply
+ killing the archive buffer, since there's no need to keep it a live
+ buffer. Consequently, quitting a todo-mode buffer can now use
+ bury-buffer without an argument, which ensures that is will not
+ becomes current on quitting the buffer that replaced it in the window.
+
+ * lisp/calendar/todo-mode.el (todo-quit): Kill todo-archive-mode
+ buffer instead of burying it. This now allows exiting the
+ todo-mode buffer by bury-buffer without an argument, so do that.
+
+2017-05-28 Michael Albinus <michael.albinus@gmx.de>
+
+ Some tweaks, almost all for Tramp adb method
+
+ * lisp/net/tramp-adb.el (tramp-adb-parse-device-names):
+ Use `make-tramp-file-name'.
+ (tramp-adb-get-device): Use `tramp-file-name-port-or-default'.
+ (tramp-adb-maybe-open-connection): Set "prompt" property.
+ (tramp-adb-wait-for-output): Use it.
+
+ * lisp/net/tramp-cache.el (tramp-cache-print): Use `elt'.
+ (tramp-dump-connection-properties): Check also that there are
+ properties to be saved. Don't save "started" property of
+ "ftp" method.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name):
+ Use `make-tramp-file-name'.
+
+ * lisp/net/tramp.el (tramp-remote-file-name-spec-regexp):
+ Host could be empty.
+ (tramp-file-name-port-or-default): New defun.
+ (tramp-dissect-file-name): Simplify `make-tramp-file-name' call.
+ (tramp-handle-file-name-case-insensitive-p): Use a progress reporter.
+ (tramp-call-process, tramp-call-process-region):
+ Use `make-tramp-file-name'.
+
+ * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults):
+ Revert change from 2017-05-24.
+ (tramp-test05-expand-file-name-relative): Let it also pass for
+ "adb" method.
+
+2017-05-28 Jürgen Hötzel <juergen@archlinux.org>
+
+ Fix Tramp for Android 7
+
+ * lisp/net/tramp-adb.el (tramp-adb-ls-toolbox-regexp):
+ Username part of prompt is empty on Android 7.
+ (tramp-adb-ls-toolbox-regexp):
+ Ignore addition links column on Android 7.
+ (tramp-adb-get-ls-command):
+ Dont use --color=none when using toybox (Android 7). It's not
+ possible to disable coloring explicitly for toybox ls.
+
+2017-05-27 Svante Carl v. Erichsen <Svante.v.Erichsen@web.de> (tiny change)
+
+ Fix cl-indent for `loop' with :keywords (Bug#15543)
+
+ * lisp/emacs-lisp/cl-indent.el (lisp-extended-loop-p): Allow for
+ ":keywords".
+
+2017-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Depromiscuify inotify with IN_MASK_ADD
+
+ Use IN_MASK_ADD instead of using a no-longer-promiscuous-enough
+ mask. This simplifies the code and restores the ability to
+ use IN_ACCESS, IN_CLOSE_WRITE, IN_CLOSE_NOWRITE, and IN_OPEN
+ in some cases (Bug#26973).
+ * src/inotify.c (INOTIFY_DEFAULT_MASK): Remove.
+ (Finotify_add_watch): Use IN_MASK_ADD instead.
+
+2017-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore inotify onlydir support
+
+ There was no need to remove it in the 2017-03-26 inotify change,
+ as it is like IN_DONT_FOLLOW and does not affect other watchers
+ for the same file.
+ * src/inotify.c (symbol_to_inotifymask, Finotify_add_watch)
+ (syms_of_inotify): Bring back onlydir.
+
+2017-05-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify computation of inotify mask
+
+ * src/inotify.c (add_watch): Accept uint32_t imask instead
+ of Lisp_Object aspect. Caller changed.
+ (Finotify_add_watch): Use aspect_to_inotifymask earlier, to
+ simplify the code.
+
+2017-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ Improve the documentation of filesets
+
+ * doc/emacs/files.texi (Filesets): Fix the description of
+ fileset-init's effect on the menu bar. (Bug#27015)
+
+2017-05-27 Philipp Stephani <phst@google.com>
+
+ Don't attempt to recover from undefined behavior in some cases
+
+ These functions can only be run in batch mode and exit Emacs on
+ return, so nothing can be recovered. Disable unsafe recover
+ mechanisms so that we get real failures and good stack traces on
+ fatal signals.
+
+ * lisp/emacs-lisp/bytecomp.el (batch-byte-compile)
+ (batch-byte-recompile-directory):
+ * lisp/emacs-lisp/ert.el (ert-run-tests-batch-and-exit)
+ (ert-summarize-tests-batch-and-exit): Don't attempt to recover
+ from undefined behavior.
+
+2017-05-27 Philipp Stephani <phst@google.com>
+
+ Avoid another compiler warning on macOS
+
+ When configured with --without-ns, HAVE_NS is not defined on macOS,
+ thus 'memory-limit' calls the deprecated sbrk(2) function. Avoid that
+ by using the pre-defined __APPLE__ preprocessor macro.
+
+ * src/alloc.c (Fmemory_limit): Never use sbrk(2) on macOS.
+
+2017-05-27 Luke Yen-Xun Lee <luke.yx.lee@gmail.com>
+
+ Fix ruler-mode text-scaling issues
+
+ * lisp/ruler-mode.el (ruler-mode-text-scaled-width): New function
+ for computing scaled text width.
+ (ruler-mode-text-scaled-window-hscroll)
+ (ruler-mode-text-scaled-window-width): Compute text scaled
+ `window-width' value.
+ (ruler-mode-mouse-grab-any-column, ruler-mode-mouse-add-tab-stop)
+ (ruler-mode-ruler): Change `window-hscroll' into
+ `ruler-mode-text-scaled-window-hscroll', and change `window-width'
+ into `ruler-mode-text-scaled-window-width'.
+
+2017-05-27 Martin Rudalics <rudalics@gmx.at>
+
+ Minor doc and doc-string fixes (Bug#27091)
+
+ * src/window.c (Fset_window_scroll_bars): Fix doc-string.
+
+ * doc/lispref/display.texi (Fringe Size/Pos, Scroll Bars)
+ (Display Margins): Mention that `set-window-buffer' may override
+ settings made by `set-window-fringes', `set-window-scroll-bars'
+ and `set-window-margins'.
+ * doc/lispref/windows.texi (Buffers and Windows): Fix doc of
+ `set-window-buffer'.
+
+2017-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid args-out-of-range errors on fringe clicks after "C-h k"
+
+ * src/keyboard.c (echo_truncate): Don't call Ftruncate if the echo
+ message is already shorter than NCHARS. (Bug#27040)
+
+2017-05-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix GUD "Stop" display when running pdb
+
+ * lisp/progmodes/gud.el (gud-menu-map): Don't call gdb-show-stop-p
+ when GUD mode is 'pdb'. (Bug#27024)
+
+2017-05-27 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
+
+ Support drag and drop of region by mouse (Bug#26725)
+
+ * doc/emacs/frames.texi (Drag and Drop): Document support of drag
+ and drop region by mouse.
+ * lisp/mouse.el (mouse-drag-region): Call mouse-drag-and-drop-region
+ when start-event is on region.
+ (mouse-drag-and-drop-region): New function, moves the region by
+ (mouse-drag-and-drop-region): New defcustom.
+ * etc/NEWS: Mention mouse-drag-and-drop-region.
+
+2017-05-27 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/emacs-lisp/eieio.el (defclass): Fix quote in warning message.
+
+2017-05-27 Alan Third <alan@idiocy.org>
+
+ Check if instancetype supported in ObjC
+
+ * configure.ac: Add check for instancetype.
+ * src/nsterm.h [!NATIVE_OBJC_INSTANCETYPE]: Define instancetype.
+
+2017-05-26 Wilfred Hughes <me@wilfred.me.uk>
+
+ Mark keywordp as a safe, error-free function
+
+ * lisp/emacs-lisp/byte-opt.el: Add keywordp to
+ side-effect-and-error-free-fns.
+
+2017-05-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/inotify.c: Add FIXME comments.
+
+2017-05-26 Andreas Politz <politza@hochschule-trier.de>
+
+ Fix Bug#26973
+
+ * src/inotify.c (INOTIFY_DEFAULT_MASK): Removing ACCESS, OPEN
+ and CLOSE events on order do let other processes also reading
+ from their descriptors. (Bug#26973).
+
+2017-05-26 Michael Albinus <michael.albinus@gmx.de>
+
+ Remove Emacs 23 compat code from Tramp
+
+ * doc/misc/tramp.texi (Remote processes): Don't mention
+ Emacs 24 explicitly.
+ (Frequently Asked Questions): Remove Emacs 23 from
+ compatibility list.
+
+ * lisp/net/tramp.el:
+ * lisp/net/tramp-adb.el:
+ * lisp/net/tramp-cache.el:
+ * lisp/net/tramp-gvfs.el:
+ * lisp/net/tramp-sh.el:
+ * lisp/net/tramp-smb.el: Replace compat function calls.
+
+ * lisp/net/tramp-compat.el (remote-file-name-inhibit-cache)
+ (tramp-compat-condition-case-unless-debug)
+ (tramp-compat-copy-file, tramp-compat-copy-directory)
+ (tramp-compat-delete-file, tramp-compat-delete-directory)
+ (tramp-compat-process-live-p): Remove them.
+
+ * lisp/net/trampver.el: Make version check fit for Emacs 24.
+
+2017-05-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Work for application/x-tar-gz and image/svg+xml
+
+ ;; Try inlining the attachment in the article <87wp94dzj6.fsf@gmail.com>
+ ;; of bug#27078 in the Emacs bug list using Gnus.
+
+ * lisp/gnus/mm-archive.el (mm-archive-decoders):
+ Add a decoder for application/x-tar-gz.
+ (mm-dissect-archive): Error out if a decoder is not found.
+
+ * lisp/gnus/mm-decode.el (mm-get-image): Allow image/svg+xml.
+
+2017-05-26 Tino Calancha <tino.calancha@gmail.com>
+
+ test-calc-23889: Skip test on 32-bit platforms
+
+ This test fails on some 32-bit platforms as mentioned in
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00737.html
+ * test/lisp/calc/calc-tests.el (test-calc-23889): Skip when
+ the Lisp integer is not big enough.
+
+2017-05-25 Alan Third <alan@idiocy.org>
+
+ Fix NS tooltips showing in the wrong place (bug#27053)
+
+ * src/nsfns.m (compute_tip_xy): Get current mouse position instead of
+ last recorded position.
+
+2017-05-25 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ lisp/net/soap-client.el: Bump version to 3.1.2
+
+ * lisp/net/soap-client.el: Bump version to 3.1.2.
+
+2017-05-25 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ Fix soap-inspect.el doc strings
+
+ * lisp/net/soap-inspect.el (soap-inspect-xs-attribute): Fix doc
+ string.
+ (soap-inspect-xs-attribute-group): Likewise.
+
+2017-05-25 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ Fix two soap-client.el byte compilation warnings
+
+ * lisp/net/soap-client.el (url-http-response-status): Add defvar.
+ (soap-fetch-xml-from-url): Remove special declaration of
+ url-http-response-status.
+ (soap-invoke-internal): Likewise.
+
+2017-05-25 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+
+ lisp/net/soap-client.el: Require cl-lib version 0.6.1
+
+ * lisp/net/soap-client.el: Require cl-lib version 0.6.1.
+
+2017-05-25 Thomas Fitzsimmons <fitzsim@fitzsim.org>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ lisp/net/soap-client.el: Shorten some long lines
+
+ * lisp/net/soap-client.el (soap-encode-xs-element): Remove
+ unnecessary progn.
+ (soap-xs-add-union): Wrap long line.
+
+2017-05-25 Alex Harsanyi <AlexHarsanyi@gmail.com>
+ Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Remove cl dependency in soap-client.el and soap-inspect.el
+
+ * lisp/net/soap-inspect.el: Replace cl library with cl-lib, case
+ with cl-case, destructuring-bind with cl-destructuring-bind and
+ loop with cl-loop.
+
+ * lisp/net/soap-client.el: Replace cl library with cl-lib,
+ defstruct with cl-defstruct, assert with cl-assert, case with
+ cl-case, ecase with cl-ecase, loop with cl-loop and
+ destructuring-bind with cl-destructuring-bind.
+
+2017-05-25 Michael Albinus <michael.albinus@gmx.de>
+
+ Switch Tramp to cl-lib
+
+ * lisp/net/tramp-compat.el (cl-lib): Require it rather than cl.
+
+ * lisp/net/tramp-ftp.el: Don't require cl.
+
+ * lisp/net/tramp-gvfs.el: Don't require cl.
+ (tramp-gvfs-handler-mounted-unmounted)
+ (tramp-gvfs-connection-mounted-p): Use `cl-*' macros.
+
+ * lisp/net/tramp-sh.el: Don't require cl.
+ (tramp-set-file-uid-gid): Use `shell-quote-argument'.
+ (tramp-sh-gvfs-monitor-dir-process-filter)
+ (tramp-sh-inotifywait-process-filter): Use `cl-*' macros.
+
+ * lisp/net/tramp-smb.el: Don't require cl.
+ (tramp-smb-read-file-entry): Use `cl-*' macros.
+
+ * lisp/net/tramp.el (cl-lib): Require it rather than cl.
+ (tramp-parse-file, tramp-parse-shostkeys-sknownhosts)
+ (tramp-parse-passwd, tramp-parse-etc-group)
+ (tramp-parse-putty): Use `cl-*' macros.
+
+2017-05-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ * CONTRIBUTE: Suggest autogen.sh's 'all' operand.
+
+2017-05-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port ATTRIBUTE_MAY_ALIAS to recent icc
+
+ * src/conf_post.h (ATTRIBUTE_MAY_ALIAS) [__ICC]:
+ Define to empty. Otherwise, icc (ICC) 17.0.4 20170411 says
+ “warning #2621: attribute "__may_alias__" does not apply here”
+ for constructs like ‘struct sockaddr *sa = (whatever);
+ struct sockaddr_in __attribute__ ((__may_alias__)) *sin
+ = (struct sockaddr_in *) sa;’.
+
+2017-05-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-05-25 port to recent icc
+ * lib/intprops.h: Copy from gnulib.
+
+2017-05-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Tramp for python.el
+
+ * lisp/net/tramp.el (tramp-get-connection-process): Check,
+ that VEC is a `tramp-file-name' structure.
+
+2017-05-24 Alan Third <alan@idiocy.org>
+
+ Raise version of macOS we define instancetype for (bug#27059)
+
+ * src/nsterm.m: Increase supported version number.
+
+2017-05-24 Alan Third <alan@idiocy.org>
+
+ Define new types on macOS 10.6 (bug#27041)
+
+ * src/nsterm.h: Enable instancetype typedef for older macOS, and use
+ correct NSUInteger instead of int.
+
+2017-05-24 Glenn Morris <rgm@gnu.org>
+
+ Don't autoload new dns-mode command
+
+ * lisp/textmodes/dns-mode.el (dns-mode-ipv6-to-nibbles):
+ Remove autoload cookie.
+
+2017-05-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * src/fns.c (sxhash): Fix records hashing (bug#27057, bug#26639)
+
+ (sxhash_vector): Make it work on pseudo vectors as well.
+ (sxhash): Treat records like vectors.
+
+2017-05-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Adapt tramp-tests.el according to new defstruct
+
+ * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults):
+ Fix test according to new defstruct.
+ (tramp-test29-environment-variables-and-port-numbers):
+ Expect it now as passed. Cleanup at the end.
+
+2017-05-24 Michael Albinus <michael.albinus@gmx.de>
+
+ Introduce a defstruct `tramp-file-name' as central data structure.
+
+ This solves also Bug#27009.
+
+ * lisp/net/tramp.el (tramp-current-domain)
+ (tramp-current-port): New defvars.
+ (tramp-file-name): New defstruct.
+ (tramp-file-name-user-domain, tramp-file-name-host-port)
+ (tramp-file-name-equal-p): New defuns.
+ (tramp-file-name-p, tramp-file-name-method)
+ (tramp-file-name-user, tramp-file-name-host)
+ (tramp-file-name-localname, tramp-file-name-hop)
+ (tramp-file-name-real-user, tramp-file-name-domain)
+ (tramp-file-name-real-host, tramp-file-name-port):
+ Remove defuns. They are provided by the defstruct, or not
+ needed anymore.
+ (tramp-dissect-file-name, tramp-buffer-name)
+ (tramp-make-tramp-file-name, tramp-get-buffer)
+ (tramp-set-connection-local-variables)
+ (tramp-debug-buffer-name, tramp-message)
+ (tramp-error-with-buffer, with-parsed-tramp-file-name)
+ (tramp-completion-dissect-file-name1)
+ (tramp-handle-file-name-as-directory)
+ (tramp-handle-file-name-directory)
+ (tramp-handle-file-remote-p, tramp-handle-file-symlink-p)
+ (tramp-handle-find-backup-file-name)
+ (tramp-handle-insert-file-contents, tramp-process-actions)
+ (tramp-check-cached-permissions, tramp-local-host-p)
+ (tramp-get-remote-tmpdir, tramp-call-process)
+ (tramp-call-process-region, tramp-read-passwd)
+ (tramp-clear-passwd):
+ * lisp/net/tramp-adb.el (tramp-adb-parse-device-names)
+ (tramp-adb-handle-expand-file-name)
+ (tramp-adb-handle-file-truename, tramp-adb-handle-copy-file)
+ (tramp-adb-handle-process-file)
+ (tramp-adb-maybe-open-connection):
+ * lisp/net/tramp-cache.el (tramp-get-hash-table)
+ (tramp-get-file-property, tramp-set-file-property)
+ (tramp-flush-file-property, tramp-flush-directory-property)
+ (tramp-get-connection-property)
+ (tramp-set-connection-property, tramp-connection-property-p)
+ (tramp-flush-connection-property, tramp-cache-print)
+ (tramp-list-connections, tramp-dump-connection-properties)
+ (tramp-parse-connection-properties):
+ * lisp/net/tramp-cmds.el (tramp-cleanup-connection):
+ * lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-expand-file-name)
+ (tramp-gvfs-url-file-name, tramp-gvfs-handler-askpassword)
+ (tramp-gvfs-handler-mounted-unmounted)
+ (tramp-gvfs-mount-spec, tramp-gvfs-get-remote-uid)
+ (tramp-gvfs-get-remote-gid)
+ (tramp-gvfs-maybe-open-connection):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-file-truename)
+ (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-sh-handle-expand-file-name)
+ (tramp-sh-handle-start-file-process)
+ (tramp-sh-handle-process-file, tramp-compute-multi-hops)
+ (tramp-maybe-open-connection)
+ (tramp-make-copy-program-file-name, tramp-get-remote-path)
+ (tramp-get-inline-coding):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-expand-file-name)
+ (tramp-smb-handle-file-acl, tramp-smb-handle-process-file)
+ (tramp-smb-handle-set-file-acl)
+ (tramp-smb-maybe-open-connection): Adapt according to defstruct.
+
+2017-05-24 Stephen Berman <steve@rosalinde.fritz.box>
+
+ Fix and improve UI of scroll bar menu (bug#27047)
+
+ In addition, since the Emacs manual writes "scroll bar", "tool
+ bar" and "menu bar", use this convention in the Show/Hide menues
+ and tooltips as well.
+
+ * lisp/menu-bar.el (menu-bar-showhide-scroll-bar-menu): Make
+ pressing a radio button in the menu actually show that it was
+ pressed. Replace the two radio buttons to turn the horizontal
+ scroll bar on and off with a single check-box toggle and add a
+ separator between this and the vertical scroll bar radio
+ buttons. Use conventional spelling.
+ (menu-bar-horizontal-scroll-bar)
+ (menu-bar-no-horizontal-scroll-bar): Remove, since now unused.
+ (menu-bar-showhide-tool-bar-menu, menu-bar-showhide-menu)
+ (menu-bar-mode): Use conventional spelling.
+
+2017-05-24 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Remove string-as-unibyte
+
+ * lisp/gnus/canlock.el (canlock-sha1): Remove useless variable.
+ (canlock-make-cancel-key): No need to use string-as-unibyte.
+
+2017-05-24 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix concatenation of "^" with diff-file-junk-re
+
+ This regexp contains "\\|", thus a concatenation
+ of "^" with it just matches the beginning of line for the
+ first alternative in diff-file-junk-re.
+ * lisp/vc/ediff-ptch.el (ediff-map-patch-buffer): Concat "^" with
+ diff-file-junk-re wrapped in a shy group.
+
+2017-05-24 Glenn Morris <rgm@gnu.org>
+
+ Suppress intermittent test failure on hydra
+
+ * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+ (eieio-test-37-obsolete-name-in-constructor): Skip on hydra.
+
+2017-05-24 Peder O. Klingenberg <peder@klingenberg.no>
+
+ New dns-mode command for IPv6 address conversion
+
+ This converts IPv6 addresses to a format suitable for
+ reverse lookup zone files. (Bug#26820)
+ * lisp/textmodes/dns-mode.el (dns-mode-map, dns-mode-menu):
+ Add dns-mode-ipv6-to-nibbles.
+ (dns-mode-ipv6-to-nibbles, dns-mode-reverse-and-expand-ipv6):
+ New functions.
+ * test/lisp/dns-mode-tests.el: New file.
+
+2017-05-24 Noam Postavsky <npostavs@gmail.com>
+
+ Protect *Backtrace* from being killed (Bug#26650)
+
+ * lisp/emacs-lisp/debug.el (debugger-mode): Call `top-level' in
+ `kill-buffer-hook'.
+
+2017-05-24 Noam Postavsky <npostavs@gmail.com>
+
+ Give a name to lisp-mode's adaptive-fill-function (Bug#22730)
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-adaptive-fill): New function.
+ (lisp-mode-variables): Use it.
+
+2017-05-23 Philipp Stephani <phst@google.com>
+
+ vc-hg.el: Silence byte compiler warning
+
+ * lisp/vc/vc-hg.el (compilation-arguments): Forward-declare.
+
+2017-05-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't warn about missing brances on macOS
+
+ On macOS, removing -Wmissing-braces is not enough; the warning has to
+ be disabled explicitly.
+
+2017-05-23 Wilfred Hughes <me@wilfred.me.uk>
+
+ Don't treat ' as a string delimiter in RPM spec files
+
+ ' is commonly used as an apostrophe in the prose sections of spec
+ files, which was erroneously highlighted as strings. See for example
+ http://kmymoney2.sourceforge.net/phb/rpm-example.html
+
+ * lisp/progmodes/sh-script.el (sh-mode-syntax-table): Treat ' as
+ punctuation in RPM spec files.
+
+2017-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-indent.el: Don't require CL. Use lexical-binding.
+
+ (common-lisp-indent-function-1): Remove unused var `last-point`.
+ (lisp-indent-error-function): Move defvar before first use.
+
+2017-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/international/rfc1843.el: Don't require CL. Use lexical-binding.
+
+ * lisp/international/utf7.el: Don't require CL. Use lexical-binding.
+
+ * lisp/net/shr.el: Use cl-lib instead of cl.
+
+2017-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * test/src/fns-tests.el, test/src/data-tests.el: Don't use `cl`
+
+ * test/src/data-tests.el (binding-test-manual, binding-test-setq-default)
+ (binding-test-makunbound, data-tests-varalias-watchers)
+ (data-tests-local-variable-watchers): Silence compiler warnings.
+
+2017-05-23 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/vc/vc-hg.el (compilation-directory): Silence byte-compiler.
+
+2017-05-23 Alan Third <alan@idiocy.org>
+
+ Fix GNUstep build
+
+ * src/nsterm.h [NS_IMPL_GNUSTEP]: Add typedefs for Cocoa-only types.
+ (NSWindowStyleMaskUtilityWindow): #define to NSUtilityWindowMask in
+ GNUstep and old versions of macOS.
+ * src/nsfns.m (ns-set-mouse-absolute-pixel-position): Function only
+ works in cocoa, not GNUstep.
+
+2017-05-23 Michael Albinus <michael.albinus@gmx.de>
+
+ Add test for Bug#27009 in tramp-tests.el
+
+ * lisp/net/tramp-sh.el (tramp-compute-multi-hops):
+ Check `tramp-file-name-real-host' for being a local host.
+
+ * lisp/net/tramp.el (tramp-postfix-host-regexp): Fix docstring.
+
+ * test/lisp/net/tramp-tests.el (tramp-test-temporary-file-directory):
+ Declare default host for mock method.
+ (tramp-test29-environment-variables-and-port-numbers): New test.
+
+2017-05-23 Glenn Morris <rgm@gnu.org>
+
+ Don't advertise s_client in tls.el docs
+
+ * lisp/net/tls.el (tls-end-of-info, tls-success, tls-untrusted):
+ Don't mention s_client in docs.
+
+ (cherry picked from commit 622c24a2b75a564b9861fc3ca7a7878741e8568d)
+
+2017-05-23 Rob Browning <rlb@defaultvalue.org>
+
+ Remove s_client usage from tls.el
+
+ * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client.
+ Ref http://bugs.debian.org/766397
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html
+
+
+ (cherry picked from commit 6e45de6bacc508db11b15b2c8ba86aad8c0570df)
+
+2017-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/mail/rfc2047.el (rfc2047-decode-encoded-words): Set `words` to nil.
+
+2017-05-22 Sam Steingold <sds@gnu.org>
+
+ Fix "g" in hg&git push&pull buffers
+
+ lisp/vc/vc-git.el (vc-git--pushpull): Set locally
+ `compilation-directory' and `compilation-arguments'.
+ lisp/vc/vc-hg.el (vc-hg--pushpull): Likewise.
+
+2017-05-22 Eli Zaretskii <eliz@gnu.org>
+
+ Fix current-line hscrolling in buffers with header-line
+
+ * src/xdisp.c (display_line): When testing the glyph row's
+ vertical position against the cursor position, account for header
+ line, if any. (Bug#27014)
+
+2017-05-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/mail/rfc2047.el: Use cl-lib & lexical-binding, silence warning
+
+ (rfc2047-decode-encoded-words): Use dolist.
+ (rfc2047-decode-string): Avoid string-to-multibyte.
+ (rfc2047-pad-base64): Use pcase.
+
+2017-05-21 Dima Kogan <dima@secretsauce.net>
+
+ Make ff-find-other-file symmetric for C++ (Bug#20192)
+
+ `cc-other-file-alist' has a mapping of file extensions to switch
+ between headers and sources, but the mappings weren't completely
+ symmetric. In particular .cpp would map to .hh, but .hh would NOT map
+ to .cpp.
+
+ * lisp/find-file.el (cc-other-file-alist): Map ".hh" and ".h" to all
+ C++ extensions to make them symmetric with the C++ extensions that map
+ to them. This lets repeated invocations of `ff-find-other-file'
+ toggle between all pairs of sources/headers.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Fix definition of whitespace in JSON
+
+ See
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00115.html.
+
+ * lisp/json.el (json-skip-whitespace): Fix definition.
+ * test/lisp/json-tests.el (test-json-skip-whitespace): Adapt unit
+ test.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Improve module function terminology
+
+ Module functions were previously called "function environments" when
+ the functions created by module_make_functions were lambdas. Now we
+ can adapt the terminology and rename "function environments" to
+ "module functions" everywhere. This also removes the name clash
+ between "function environments" and "module environments."
+
+ * src/emacs-module.c (module_make_function): Adapt comment to reality;
+ stop using "function environment" terminology.
+ (funcall_module): Stop using "function environment" terminology.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Avoid uninitialized read
+
+ * src/nsterm.m (ns_read_socket): Don't read uninitialized variable 'nevents'.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Fix call of registerServicesMenuSendTypes
+
+ * src/nsterm.m (initFrameFromEmacs:): nil is not allowed for
+ returnTypes; pass an empty array instead.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Clean up code around 'ns-list-services'
+
+ * src/nsfns.m (Fns_list_services): Remove unreachable code. In this
+ branch NS_IMPL_COCOA cannot be defined.
+ (interpret_services_menu): Define only if called to avoid compiler
+ warnings about unused static functions.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Remove unused automatic variables
+
+ * src/nsterm.m (ns_read_socket):
+ * src/macfont.m (macfont_open): Remove unused automatic variables.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Nextstep: Replace deprecated enumerators
+
+ * src/nsmenu.m (initWithContentRect:styleMask:backing:defer:): Replace
+ deprecated enumerator.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Nextstep: remove some deprecated method calls
+
+ * src/nsterm.m (mouseDown:):
+ * src/nsmenu.m (runMenuAt:forFrame:keymaps:): Remove call to
+ deprecated method. The return value is always nil.
+ * src/macfont.m (mac_font_shape_1): Replace call to deprecated method.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Remove trailing semicolons in method definitions
+
+ These semicolons are ignored and cause compiler warnings.
+
+ * src/nsimage.m (setPixelAtX:Y:toRed:green:blue:alpha:):
+ * src/nsterm.m (init, updateFrameSize:):
+ (setFrame:): Remove trailing semicolon.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Remove calls to deprecated setUsesScreenFonts
+
+ * src/macfont.m (mac_screen_font_get_metrics): Don't call setUsesScreenFonts.
+ (mac_font_shape_1): Remove screen_font_p parameter.
+ (mac_screen_font_shape): Remove screen_font_p argument.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Make a function static that isn't used outside this file
+
+ * src/kqueue.c (kqueue_directory_listing): Make static.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Use NSCharacterCollection instead of CTCharacterCollection
+
+ This should not cause behavior changes, but fixes a compiler warning
+ due to implicit conversions between the enums.
+
+ * src/macfont.m (macfont_cache, macfont_lookup_cache)
+ (macfont_get_glyph_for_cid, macfont_get_uvs_table)
+ (macfont_variation_glyphs): Use NSCharacterCollection.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Remove unused function print_regions
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Declare Nextstep unexec functions in lisp.h
+
+ This removes compiler warnings about missing prototypes on macOS.
+
+2017-05-21 Philipp Stephani <phst@google.com>
+
+ Nextstep: Use instancetype explicit return type
+
+ This removes compiler warnings on macOS and improves type safety.
+
+ * src/nsterm.m (initFrameFromEmacs:):
+ (menuDown:):
+ (toolbarClicked:):
+ (toggleToolbar:):
+ (setMiniwindowImage:):
+ (initFrame:window:):
+ (condemn, reprieve, setPosition:portion:whole:):
+ (repeatScroll:):
+ * src/nsmenu.m (initWithTitle:):
+ (initWithTitle:frame:):
+ (initForView:withIdentifier:):
+ (init, initWithContentRect:styleMask:backing:defer:):
+ (initFromContents:isQuestion:):
+ * src/nsimage.m (allocInitFromFile:):
+ (initFromXBM:width:height:fg:bg:):
+ (setXBMColor:):
+ (initForXPMWithDepth:width:height:): Use instancetype as return
+ type instead of implicit id.
+
+2017-05-21 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/emacs-lisp/package.el (package-delete): Delete readme file as well.
+
+2017-05-21 Alan Mackenzie <acm@muc.de>
+
+ Enhance mode-line percentage offset facility, with "%o" and "%q"
+
+ "%o" will display the percentage "travel" of the window through the buffer.
+ "%q" will display a combination of the percentage offsets of the top and
+ bottom of the window. The new user option mode-line-percent-position will
+ facilitate selecting a setting for this part of the mode line.
+
+ * lisp/bindings.el (mode-line-percent-position): New customizable user option.
+ (mode-line-position): Use mode-line-percent-position in place of "%p", etc.
+
+ * src/xdisp.c (decode_mode_spec): Add handlers for "%o" and "%q".
+
+ * doc/lispref/modes.texi (Mode Line Variables): Document
+ mode-line-percent-position.
+ (%-Constructs): Document %o and %q.
+
+ * etc/NEWS: Add an entry for these new facilities.
+
+2017-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Work around macOS bug in create_process, too
+
+ * src/process.c (create_process) [DARWIN_OS]:
+ Reset SIGCHLD after vfork here, too.
+
+2017-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Work around macOS bug with vforked child
+
+ * src/callproc.c (call_process) [DARWIN_OS]:
+ Include workaround for apparent macOS bug.
+
+2017-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify --enable-gcc-warnings without modules
+
+ * src/print.c (print_vectorlike): New function, taken from
+ part of print_object. This one is indented properly, and
+ pacifies --enable-gcc-warnings by using a default case
+ instead of listing all the enum values, sometimes
+ incompletely.
+ (print_object): Use it.
+
+2017-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove DARWIN_OS_CASE_SENSITIVE_FIXME code
+
+ It does not appear to be needed (Bug#24441).
+ * etc/PROBLEMS: Remove DARWIN_OS_CASE_SENSITIVE_FIXME stuff.
+ * src/fileio.c (file_name_case_insensitive_p):
+ Remove DARWIN_OS_CASE_SENSITIVE_FIXME code.
+
+2017-05-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Narrow DARWIN_OS_CASE_SENSITIVE_FIXME to 1 choice
+
+ * etc/PROBLEMS: Document this (Bug#24441).
+ * src/fileio.c (file_name_case_insensitive_p): Prefer pathconf
+ with _PC_CASE_SENSITIVE, if it works, to
+ DARWIN_OS_CASE_SENSITIVE_FIXME code.
+ Support just one method for DARWIN_OS_CASE_SENSITIVE_FIXME,
+ which matches the Apple documentation more precisely.
+
+2017-05-21 Tom Tromey <tom@tromey.com>
+
+ Fix mhtml-mode fontification bug
+
+ Bug#26922
+ * lisp/textmodes/mhtml-mode.el (mhtml-syntax-propertize): Call
+ sgml-syntax-propertize-inside if not in a submode.
+ * test/manual/indent/html-multi-4.html: New file.
+
+2017-05-21 Ryan <rct@thompsonclan.org> (tiny change)
+
+ Fix ido-enable-dot-prefix for empty choice (Bug#26997)
+
+ * lisp/ido.el (ido-set-matches-1): Only check first character of
+ item if it's non-empty.
+
+2017-05-21 Ari Roponen <ari.roponen@gmail.com>
+
+ * lisp/svg.el (svg-line): Fix x/y typo. (Bug#26953)
+
+2017-05-21 Glenn Morris <rgm@gnu.org>
+
+ Prevent loading vc-bzr writing to ~/.bzr.log
+
+ * lisp/vc/vc-bzr.el (vc-bzr-status-switches): Disable bzr logging.
+
+2017-05-21 Glenn Morris <rgm@gnu.org>
+
+ Prevent running vc-tests writing to ~/.bzr.log
+
+ * test/lisp/vc/vc-tests.el (vc-test--create-repo)
+ (vc-test--register, vc-test--working-revision)
+ (vc-test--checkout-model): Set temporary BZR_HOME, to disable logging.
+
+2017-05-21 Noam Postavsky <npostavs@gmail.com>
+
+ Don't end non-hook variable with "-hook" (Bug#26623)
+
+ * lisp/follow.el (follow-inside-post-command-hook-call): Renamed from
+ follow-inside-post-command-hook, update uses.
+
+2017-05-21 Charles A. Roelli <charles@aurox.ch>
+
+ Fix macOS mouse movement
+
+ * lisp/frame.el (ns-set-mouse-absolute-pixel-position): New
+ function (Lisp).
+ (set-mouse-absolute-pixel-position): Change it to call
+ `ns-set-mouse-absolute-pixel-position' on macOS.
+ * src/nsfns.m (Fns_set_mouse_absolute_pixel_position): New
+ function.
+ * src/nsterm.h (NS_PARENT_WINDOW_TOP_POS): Use the primary
+ screen's height as a base for calculating global coordinates.
+ * src/nsterm.m (frame_set_mouse_pixel_position): Fix it in macOS.
+ * test/lisp/mouse-tests.el (bug26816-mouse-frame-movement): Test
+ movement of mouse relative to frame.
+
+2017-05-21 Alan Third <alan@idiocy.org>
+
+ Show tooltip on correct screen (bug#26905)
+
+ * src/nsfns.m (compute_tip_xy): Find the correct screen for the
+ tooltip and constrain it to that screen.
+
+2017-05-21 Andreas Politz <politza@hochschule-trier.de>
+
+ Don't save unrelated buffers before recompiling directory (Bug#25964)
+
+ * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Only save
+ buffers visiting lisp files under the directory being compiled.
+
+2017-05-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor fixes for arity ranges in emacs modules
+
+ * src/emacs-module.c (module_make_function):
+ Check that arities fit into fixnums, for func-arity’s benefit.
+ (funcall_module): Avoid unnecessary conversion to EMACS_INT.
+ (module_function_arity): Allow arities greater than SHRT_MAX.
+
+2017-05-20 Philipp Stephani <phst@google.com>
+
+ Reimplement module functions
+
+ Instead of a lambda, create a new type containing all data required to
+ call the function, and support it in the evaluator. Because this type
+ now also needs to store the function documentation, it is too big for
+ Lisp_Misc; use a pseudovector instead. That also has the nice benefit
+ that we don't have to add special support to the garbage collector.
+
+ Since the new type is user-visible, give it a predicate.
+
+ Now we can easily support 'help-function-args' and 'func-arity'; add
+ unit tests for these.
+
+ * src/lisp.h (allocate_module_function, MODULE_FUNCTIONP)
+ (XMODULE_FUNCTION): New pseudovector type 'module function'.
+
+ * src/eval.c (FUNCTIONP): Also treat module functions as functions.
+ (funcall_lambda, Ffuncall, eval_sub): Add support for calling module
+ functions.
+ (Ffunc_arity): Add support for detecting the arity of module
+ functions.
+
+ * src/emacs-module.c (module_make_function): Adapt to new structure.
+ Return module function object directly instead of wrapping it in a
+ lambda; remove FIXME.
+ (funcall_module): New function to call module functions. Replaces
+ `internal--module-call' and is called directly from eval.c.
+ (syms_of_module): Remove internal helper function, which is no longer
+ needed.
+ (module_function_arity): New helper function.
+
+ * src/data.c (Ftype_of): Adapt to new implementation.
+ (Fmodule_function_p, syms_of_data): New user-visible function. Now
+ that module functions are first-class objects, they deserve a
+ predicate. Define it even if not compiled with --enable-modules so
+ that Lisp code doesn't have to check for the function's existence.
+
+ * src/doc.c (Fdocumentation): Support module functions.
+
+ * src/print.c (print_object): Adapt to new implementation.
+
+ * src/alloc.c (mark_object): Specialized garbage collector support is
+ no longer needed.
+
+ * lisp/help.el (help-function-arglist): Support module functions.
+ While there, simplify the arity calculation by using `func-arity',
+ which does the right thing for all kinds of functions.
+
+ * test/data/emacs-module/mod-test.c: Amend docstring so we can test
+ the argument list.
+
+ * test/src/emacs-module-tests.el (mod-test-sum-docstring): Adapt to
+ new docstring.
+ (mod-test-non-local-exit-signal-test): Because `internal--module-call'
+ is gone, the backtrace has changed and no longer leaks the
+ implementation.
+ (module--func-arity): New test for `func-arity'.
+ (module--help-function-arglist): New test for `help-function-arglist'.
+
+2017-05-20 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes in GC due to unescaped characters warning
+
+ * src/lread.c (load_warn_unescaped_character_literals): Don't cons
+ Lisp objects from stack-based variables. (Bug#26961)
+
+2017-05-20 Charles A. Roelli <charles@aurox.ch>
+
+ New commands: find-library-other-window, find-library-other-frame
+
+ * lisp/emacs-lisp/find-func.el (find-library-other-window)
+ (find-library-other-frame): New commands to complement the
+ existing 'find-library' command. (Bug#26712)
+ (read-library-name): New function to read a library name.
+ * etc/NEWS: Mention 'find-library-other-window' and
+ 'find-library-other-frame'.
+
+2017-05-20 Eli Zaretskii <eliz@gnu.org>
+
+ Fix automatic hscrolling of only the current line
+
+ * src/xdisp.c (display_line): When hscrolling only the current
+ line, increment iterator's first_visible_x and last_visible_x
+ values to account for the hscroll. This propagates the hscroll
+ effect on the iterator geometry all the way down to the
+ subroutines called by display_line, and avoids scrolling bugs
+ under large hscroll values. (Bug#26994)
+
+2017-05-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add handlerlist assertion to module code
+
+ * src/emacs-module.c (module_reset_handlerlist):
+ Check handlerlist. Suggested by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00521.html
+
+2017-05-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port --enable-gcc-warnings to clang 3.9.1
+
+ * configure.ac (WERROR_CFLAGS): Omit -Wmissing-braces for Clang,
+ to shut off a false alarm. Problem reportd by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00521.html
+
+2017-05-20 Noam Postavsky <npostavs@gmail.com>
+
+ Limit integers printed as characters (Bug#16828)
+
+ * lisp/simple.el (eval-expression-print-maximum-character): New
+ variable.
+ (eval-expression-print-format): Only display value as character if
+ it's less than or equal to `eval-expression-print-maximum-character'.
+ (eval-expression-get-print-arguments): Check
+ eval-expression-print-maximum-character, allow negative arg to
+ override it.
+ (eval-expression):
+ * lisp/progmodes/elisp-mode.el (elisp--eval-last-sexp):
+ (elisp--eval-last-sexp-print-value): Handle new variable.
+ * doc/emacs/building.texi (Lisp Eval): Document new variable and
+ behavior.
+ * etc/NEWS: Announce it.
+ * test/lisp/progmodes/elisp-mode-tests.el
+ (eval-last-sexp-print-format-small-int)
+ (eval-last-sexp-print-format-small-int-echo)
+ (eval-last-sexp-print-format-large-int)
+ (eval-last-sexp-print-format-large-int-echo):
+ * test/lisp/simple-tests.el (eval-expression-print-format-small-int)
+ (eval-expression-print-format-small-int-echo)
+ (eval-expression-print-format-large-int)
+ (eval-expression-print-format-large-int-echo): New tests.
+
+2017-05-20 Noam Postavsky <npostavs@gmail.com>
+
+ Refactor lisp eval result printing
+
+ * lisp/simple.el (eval-expression-print-format): Don't check
+ `standard-output' or `current-prefix-arg'.
+ (eval-expression-get-print-arguments): New function, centralizes
+ decision about how to print results of `eval-expression' and
+ `eval-last-sexp'.
+ (eval-expression):
+ * lisp/progmodes/elisp-mode.el (elisp--eval-last-sexp-print-value):
+ Use it.
+
+2017-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check that signed right shift is arithmetic
+
+ * src/data.c (ash_lsh_impl): Verify that signed right shift is
+ arithmetic; if we run across a compiler that uses a logical shift
+ we’ll need to complicate the code before removing this
+ compile-time check. Help the compiler do common subexpression
+ elimination better.
+
+2017-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor .gitignore fixes
+
+ * .gitignore: modules/mod-test/Makefile was renamed to
+ test/data/emacs-module/Makefile.
+ Omit [0-9]*.core, subsumed by *.core.
+ test/indent/*.new was renamed to test/manual/indent/*.new.
+ Add *.swp, for Vim.
+
+2017-05-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/package.el: Quote `package-desc' in docstrings
+
+2017-05-19 Eli Zaretskii <eliz@gnu.org>
+
+ Describe problems with Microsoft Intellipoint
+
+ * etc/PROBLEMS: Describe problems with Microsoft Intellipoint and
+ mouse-2 events. For the details, see
+ https://lists.gnu.org/r/help-emacs-windows/2017-05/msg00009.html.
+
+2017-05-19 Nick Helm <nick@tenpoint.co.nz> (tiny change)
+
+ Fix turning off whitespace-mode
+
+ * lisp/whitespace.el (whitespace-display-char-on): Correct the way
+ the original buffer-display-table is saved and restored when
+ global-whitespace-mode is active. (Bug#26892)
+
+ * test/lisp/whitespace-tests.el
+ (whitespace-tests-whitespace-mode-on): New function.
+ (whitespace-tests-display-tables): New test.
+
+2017-05-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Minor tweaks in tramp-tests.el
+
+ * test/lisp/net/tramp-tests.el (tramp--test-afp-or-smb-p): New defun.
+ (tramp-test05-expand-file-name-relative): Use it.
+ (tramp-test38-unload): Run only in batch mode.
+
+2017-05-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix a problem with OpenSSH 7 in Tramp
+
+ * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): Set also
+ "ConnectTimeout" during test. Otherwise, OpenSSH 7 will hang.
+
+2017-05-19 Jean-Christophe Helary <jean.christophe.helary@gmail.com>
+
+ Improve documentation of 'split-string'
+
+ * doc/lispref/strings.texi (Creating Strings): Rearrange text to
+ make it more readable. (Bug#26925)
+
+2017-05-19 Ruslan Bekenev <furyinbox@gmail.com>
+
+ Fix typos in doc strings
+
+ * lisp/mail/rfc2231.el (rfc2231-encode-string):
+ * lisp/mail/rfc2047.el (rfc2047-encode-parameter):
+ * lisp/mail/rfc2045.el (rfc2045-encode-string): Fix typos in doc
+ strings. (Bug#26103)
+
+2017-05-19 Philipp Stephani <phst@google.com>
+
+ Fix module tests on some systems
+
+ If dladdr(3) isn't available or didn't work, the printed
+ representation of a module function will not include the file name,
+ but only the address. Make the tests pass in that case.
+
+ * test/src/emacs-module-tests.el (module-function-object): Fix match for
+ module function printed representation
+
+2017-05-19 Jean-Christophe Helary <jean.christophe.helary@gmail.com>
+
+ Add an optional arguments to string-trim
+
+ * lisp/emacs-lisp/subr-x.el (string-trim-left, string-trim-right)
+ (string-trim): Add optional args that serve as defaults per the
+ original behavior. (Bug#26908)
+
+2017-05-19 Stephen Berman <steve@rosalinde.fritz.box>
+
+ Fix typo in last change to auto-hscroll-mode
+
+ * lisp/cus-start.el (standard): Fix typo in value of auto-hscroll-mode.
+
+2017-05-19 Eli Zaretskii <eliz@gnu.org>
+
+ Support remote editing in emacsclient via Tramp
+
+ * lib-src/emacsclient.c (main, decode_options)
+ (print_help_and_exit, longopts): New option '--tramp' / '-T' which
+ specifies how emacs should use tramp to find remote files.
+
+ * doc/emacs/misc.texi (TCP Emacs server): New subsection describing
+ the various knobs to tune server.el for TCP opereation.
+ (emacsclient Options): Reference "TCP Emacs server" from description of
+ --server-file. Document the new '--tramp' / '-T' options.
+ * doc/emacs/emacs.texi (Top): Update the top-level menu.
+
+ * etc/NEWS: Mention the new option.
+
+2017-05-19 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/replace.el (query-replace-regexp-eval): Doc fix.
+
+2017-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Attempt to work around macOS vfork bug
+
+ Problem reported by YAMAMOTO Mitsuharu in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
+ This is related to the fix for Bug#26397.
+ * src/callproc.c (call_process_cleanup, call_process) [!MSDOS]:
+ Report internal error if wait_for_termination fails.
+ * src/sysdep.c (get_child_status): Return -1 if waitpid is
+ buggy, instead of aborting.
+ (wait_for_termination): Return bool success value.
+ All callers changed.
+
+2017-05-19 Eli Zaretskii <eliz@gnu.org>
+
+ Adjust defcustom form for 'auto-hscroll-mode'
+
+ * lisp/cus-start.el (standard) <auto-hscroll-mode>: Adjust the
+ defcustom form. Suggested by Stephen Berman <stephen.berman@gmx.net>.
+
+2017-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix DARWIN_OS_CASE_SENSITIVE_FIXME==2 false alarm
+
+ * src/fileio.c (file_name_case_insensitive_p):
+ Don’t compile the (DARWIN_OS_CASE_SENSITIVE_FIXME == 2)
+ code unless DARWIN_OS_CASE_SENSITIVE_FIXME is 2.
+ Problem reported by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00495.html
+
+2017-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port --enable-gcc-warnings to clang 3.9.1
+
+ * configure.ac (WERROR_CFLAGS): Omit -Wdouble-promotion if clang.
+ Problem reported by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00495.html
+
+2017-05-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clean up compiler warning in emacs-module.c
+
+ * src/emacs-module.c (MODULE_SETJMP_1): Use the local var
+ instead of leaving it unused, to pacify picky compilers.
+ (module_reset_handlerlist): Now takes a dummy pointer to a struct
+ handler *, instead of a dummy pointer to an int. All uses changed.
+
+2017-05-19 Philipp Stephani <phst@google.com>
+
+ Clean up some compiler warnings
+
+ * src/sysdep.c (system_process_attributes) [DARWIN_OS]:
+ Remove unused locals.
+
+2017-05-18 Eli Zaretskii <eliz@gnu.org>
+
+ Support hscrolling only the current line
+
+ * src/xdisp.c (hscrolling_current_line_p): New function.
+ (init_iterator): If auto-hscrolling just the current line, don't
+ increment the iterator's first_visible_x and last_visible_x
+ variables.
+ (hscroll_window_tree): Recompute window's hscroll when moving
+ vertically to another screen line.
+ (redisplay_window): If we are hscrolling only the current line,
+ disable the optimizations that rely on the current matrix being
+ up-to-date.
+ (display_line): Accept an additional argument CURSOR_VPOS, the
+ vertical position of the current screen line which might need
+ hscrolling; all callers changed. Compute first_visible_x and
+ last_visible_x specially when auto-hscrolling current line, by
+ repeating the calculation that is done in init_iterator in other
+ modes.
+ (syms_of_xdisp) <auto-hscroll-mode>: No longer boolean, it can now
+ accept a 3rd value 'current-line, to turn on the mode where
+ only the current line is hscrolled.
+
+ * etc/NEWS: Mention the new auto-hscroll-mode value.
+
+2017-05-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change in line-move-finish
+
+ * lisp/simple.el (line-move-finish): Fix last change. This corrects a
+ regression in C-n and C-p when lines are truncated, introduced by the
+ change in 2017-05-10.
+
+2017-05-18 Simen Heggestøyl <simenheg@gmail.com>
+
+ Expand docstring for CSS mode
+
+ * lisp/textmodes/css-mode.el (css-completion-at-point, css-mode):
+ Expand docstrings.
+
+2017-05-18 Tino Calancha <tino.calancha@gmail.com>
+
+ Use the expression angle units while simplifying it
+
+ Don't use the angle mode, use the angle units included
+ in the expression instead (Bug#23889).
+ * lisp/calc/calc-alg.el (calc-input-angle-units): New defun.
+ (math-simplify): Use it.
+ * lisp/calc/calc-forms.el (math-to-hms, math-from-hms):
+ Don't use calc-angle-mode if math-simplifying-units is non-nil.
+ * lisp/calc/calc-math.el (calcFunc-nroot, math-from-radians)
+ (math-to-radians-2, math-from-radians-2): Don't convert angle
+ to radians if math-simplifying-units is non-nil.
+ * test/lisp/calc/calc-tests.el (test-calc-23889): Add test.
+
+2017-05-18 Tino Calancha <tino.calancha@gmail.com>
+
+ Revert "Ignore angle mode while simplifying units"
+
+ This reverts commit 713e922243fb60d850f7b0ff83f3e2a3682f1832.
+ This commit causes Bug#25652.
+
+2017-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Avoid undefined behavior in struct sockaddr
+
+ Problem noted by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00391.html
+ * src/conf_post.h (ATTRIBUTE_MAY_ALIAS, DECLARE_POINTER_ALIAS):
+ New macros.
+ * src/process.c (conv_sockaddr_to_lisp, conv_lisp_to_sockaddr)
+ (connect_network_socket, network_interface_info)
+ (server_accept_connection): Use it when aliasing non-char objects.
+
+2017-05-17 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/vc/smerge-mode.el (smerge-refine-regions): Work in multi-bufs
+
+ Rename from smerge-refine-subst. Allow the `beg's to be markers.
+ Add autoload cookie.
+ (smerge--refine-forward): Rename from smerge-refine-forward.
+ (smerge--refine-chopup-region): Rename from smerge-refine-chopup-region.
+ Assume that its `beg` arg is a marker.
+ (smerge--refine-highlight-change): Rename from
+ smerge-refine-highlight-change. Remove `buf` arg.
+ (smerge-refine-subst): Redefine as an obsolete alias.
+
+2017-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Work around AddressSanitizer bug with vfork
+
+ Problem reported by Jim Meyering in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00246.html
+ * src/conf_post.h (vfork) [ADDRESS_SANITIZER]: Define to fork.
+ Unfortunately with the AddressSanitizer in Fedora 25 x86-64, the
+ vforked child messes up the parent’s shadow memory. This is too
+ bad, as we’d rather have AddressSanitizer catch memory-access bugs
+ related to vfork.
+
+2017-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Catch IPv4/IPv6 issues at compile time
+
+ * src/process.c (connect_network_socket): Use verify,
+ not eassert, so that any problems are caught at compile-time.
+ Avoid dodgy cast by using a local var of the correct type.
+
+2017-05-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify --enable-gcc-warnings --with-x-toolkit=no
+
+ * src/composite.c (autocmp_chars) [!HAVE_WINDOW_SYSTEM]:
+ Avoid unused local.
+
+2017-05-17 Glenn Morris <rgm@gnu.org>
+
+ * admin/update_autogen (commit): Pull before push.
+
+2017-05-17 Glenn Morris <rgm@gnu.org>
+
+ autoload-rubric no longer provides a feature by default
+
+ * lisp/emacs-lisp/autoload.el (autoload-rubric):
+ Stop providing a feature unless explicitly requested.
+ (autoload-find-generated-file): Update autoload-rubric call.
+
+2017-05-17 Eli Zaretskii <eliz@gnu.org>
+
+ Remove redundant code in connect_network_socket
+
+ * src/process.c (connect_network_socket) [HAVE_GETSOCKNAME]:
+ Remove redundant type-casting and variables. Don't call
+ 'getsockname' to find the port for AF_LOCAL sockets.
+ [AF_INET6]: Add an assertion to verify that the ports in the IPv4
+ and IPv6 structures are at the same offset and have the same size.
+
+2017-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix minor timezone memory leak
+
+ * src/editfns.c (wall_clock_tz): Remove; unused.
+
+2017-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not discard AddressSanitizer stderr
+
+ * src/emacs.c (close_output_streams) [ADDRESS_SANITIZER]:
+ Do not close stderr.
+
+2017-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify procname code to avoid GCC bug
+
+ * src/process.c (server_accept_connection): Simplify and avoid
+ multiple calls and struct literals in the last case of a switch.
+ The old code ran afoul of GCC bug 80659, which caused an internal
+ compiler error. Problem reported by Jim Meyering in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00182.html
+ https://gcc.gnu.org/bugzilla/show_bug.cgi?id=80659
+
+2017-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify GCC 7 with --enable-gcc-warnings
+
+ * src/regex.c (regex_compile): Swap labels, so that the
+ FALLTHROUGH immediately precedes the case label.
+
+2017-05-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge with gnulib, pacifying GCC 7
+
+ This incorporates:
+ 2017-05-16 manywarnings: update for GCC 7
+ 2017-05-15 sys_select: Avoid "was expanded before it was required"
+ * configure.ac (nw): Suppress GCC 7’s new -Wduplicated-branches and
+ -Wformat-overflow=2 options, due to too many false alarms.
+ * doc/misc/texinfo.tex, lib/strftime.c, m4/manywarnings.m4:
+ Copy from gnulib.
+ * m4/gnulib-comp.m4: Regenerate.
+ * src/coding.c (decode_coding_iso_2022):
+ Fix bug uncovered by -Wimplicit-fallthrough.
+ * src/conf_post.h (FALLTHROUGH): New macro.
+ Use it to mark all switch cases that fall through.
+ * src/editfns.c (styled_format): Use !, not ~, on bool.
+ * src/gtkutil.c (xg_check_special_colors):
+ When using sprintf, don’t trust Gtk to output colors in [0, 1] range.
+ (xg_update_scrollbar_pos): Avoid use of possibly-uninitialized bool;
+ this bug was actually caught by Clang.
+ * src/search.c (boyer_moore):
+ Tell GCC that CHAR_BASE, if nonzero, must be a non-ASCII character.
+ * src/xterm.c (x_draw_glyphless_glyph_string_foreground):
+ Tell GCC that glyph->u.glyphless.ch must be a character.
+
+2017-05-16 Michael Albinus <michael.albinus@gmx.de>
+
+ Make autoloading Tramp more robust
+
+ * lisp/net/tramp.el (tramp-file-name-for-operation):
+ Use `default-directory' where appropriate.
+ (tramp-file-name-handler): Do not autoload.
+ (tramp-autoload-file-name-handler): Reintroduce function.
+ (tramp-register-autoload-file-name-handlers): Use it.
+
+2017-05-16 Michael Albinus <michael.albinus@gmx.de>
+
+ Extend tramp-tests.el
+
+ * test/lisp/net/tramp-tests.el (tramp-change-syntax):
+ Remove declaration, not needed anymore.
+ (tramp-test05-expand-file-name-relative): New test.
+ (tramp-test10-write-region): Extend test.
+
+2017-05-16 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp.el: Avoid recursive load of Tramp. (Bug#26943)
+
+2017-05-16 Noam Postavsky <npostavs@gmail.com>
+
+ Make `indent-line-to' respect field boundaries (Bug#26891)
+
+ * lisp/indent.el (indent-line-to): Use `back-to-indentation' instead
+ of `backward-to-indentation'.
+
+2017-05-16 Noam Postavsky <npostavs@gmail.com>
+
+ Make sure indent-sexp stops at end of sexp (Bug#26878)
+
+ * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Check endpos before
+ indenting.
+ * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp-stop): New
+ test.
+
+2017-05-16 Glenn Morris <rgm@gnu.org>
+
+ Stop some epg tests failing on rhel7 with gpg 2.0.22 (bug#23619)
+
+ * test/lisp/epg-tests.el (with-epg-tests):
+ Also set GNUPGHOME in the environment of child processes.
+ This avoids problems if gpg does not pass --homedir to spawned agent.
+
+2017-05-16 Glenn Morris <rgm@gnu.org>
+
+ Add oldxmenu to system-configuration-features
+
+ * configure.ac (HAVE_OLDXMENU): New.
+ (emacs_config_features): Add oldxmenu.
+
+2017-05-15 Ted Zlatanov <tzz@lifelogs.com>
+
+ * .gitlab-ci.yml: Adjust disclaimer as per RMS.
+
+2017-05-15 Eli Zaretskii <eliz@gnu.org>
+
+ Remove unneeded stuff from nt/inc/sys/time.h
+
+ * nt/inc/sys/time.h (_TIMEVAL_DEFINED, struct timevat, timerisset)
+ (timercmp, timerclear): Don't define. Instead, include the system
+ header sys/time.h, and add only the interval timers stuff. This
+ avoids compiler warnings about 'gettimeofday's prototype, and also
+ avoids redefinition of macros from system headers.
+
+2017-05-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix address violation found by AddressSanitizer
+
+ * src/process.c (connect_network_socket):
+ Use struct sockaddr_storage, not struct sockaddr_in, to store info
+ about a socket address. Problem reported by Philipp Stephani in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00314.html
+ This fix is based on a patch by Philipp in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00357.html
+
+2017-05-14 Gemini Lasswell <gazally@runbox.com>
+
+ Make edebug-step-in work on generic methods (Bug#22294)
+
+ * lisp/emacs-lisp/edebug.el (edebug-match-cl-generic-method-args):
+ New function to implement the edebug-form-spec property of
+ the symbol cl-generic-method-args.
+ (edebug-instrument-function): If the function is a generic
+ function, find and instrument all of its methods. Return a list
+ instead of a single symbol.
+ (edebug-instrument-callee): Now returns a list. Update docstring.
+ (edebug-step-in): Handle the list returned by edebug-instrument-callee.
+ * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Use name and
+ cl-generic-method-args in its Edebug spec.
+ * lisp/emacs-lisp/eieio-compat.el (defmethod): Use name and
+ cl-generic-method-args in its Edebug spec.
+ * lisp/subr.el (method-files): New function.
+ * test/lisp/subr-tests.el (subr-tests--method-files--finds-methods)
+ (subr-tests--method-files--nonexistent-methods): New tests.
+
+2017-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-05-14 same-inode: Adapt for windows-stat-inodes
+ 2017-05-14 windows-stat-inodes: New module
+ 2017-05-14 stat-time: Adapt for windows-stat-timespec
+ * lib/gnulib.mk.in: Regenerate.
+ * lib/stat-time.h, lib/sys_types.in.h, m4/sys_types_h.m4:
+ Copy from gnulib.
+
+2017-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ Remove gettimeofday from w32 sources
+
+ * lib-src/ntlib.c (gettimeofday):
+ * nt/inc/sys/time.h (gettimeofday, struct timezone): Remove unused
+ function 'gettimeofday' and all of its supporting code.
+
+2017-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build
+
+ * nt/inc/sys/time.h (gettimeofday):
+ * src/w32.c (gettimeofday): Adjust signature to match Gnulib.
+
+2017-05-14 Eli Zaretskii <eliz@gnu.org>
+
+ More accurate documentation of the ':box' face attribute
+
+ * doc/lispref/display.texi (Face Attributes): Fix the description
+ of negative width of the ':box' attribute. (Bug#26920)
+
+2017-05-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-05-13 largefile: Simplify
+ 2017-05-13 largefile: Improve and document
+ 2017-05-13 truncate: New module
+ 2017-05-13 windows-stat-timespec: New module
+ 2017-05-13 windows-stat-override: New module
+ 2017-05-11 getopt-posix: port to mingw
+ 2017-05-11 gettimeofday: Increase precision on mingw
+ 2017-05-10 time: Fix missing initialization of HAVE_TIMEZONE_T
+ 2017-05-10 Implement a way to opt out from MSVC support
+ 2017-05-09 tzset: Expand comment about TZ problem on native Windows
+ * build-aux/config.guess, lib/dup2.c, lib/fcntl.c, lib/fsync.c:
+ * lib/getdtablesize.c, lib/getopt.c, lib/gettimeofday.c:
+ * lib/mktime.c, lib/stat-time.h, lib/sys_stat.in.h, lib/unistd.in.h:
+ * lib/utimens.c, m4/gettimeofday.m4, m4/largefile.m4:
+ * m4/sys_stat_h.m4, m4/sys_time_h.m4, m4/time_h.m4, m4/time_rz.m4:
+ * m4/unistd_h.m4: Copy from gnulib.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+
+2017-05-14 Marcin Borkowski <mbork@mbork.pl>
+
+ Merge branch 'fix/bug-21072'
+
+2017-05-14 Ted Zlatanov <tzz@lifelogs.com>
+
+ * .gitlab-ci.yml: Add setup for GitLab CI builds.
+
+2017-05-13 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
+
+ New minor mode 'pixel-scroll-mode'
+
+ * lisp/pixel-scroll.el: New file.
+
+ * etc/NEWS: Mention pixel-scroll-mode.
+
+2017-05-13 Philipp <phst@google.com>
+
+ Make `old-style-backquotes' variable internal
+
+ * src/lread.c (load_warn_old_style_backquotes, Fload, read1)
+ (syms_of_lread): Rename `old-style-backquotes' to
+ `lread--old-style-backquotes', and clarify that it's for internal
+ use only.
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Rename
+ variable.
+ * test/src/lread-tests.el (lread-tests--old-style-backquotes): Add
+ unit test.
+ * test/lisp/emacs-lisp/bytecomp-tests.el
+ (bytecomp-tests--old-style-backquotes): Add unit test.
+
+2017-05-13 Philipp Stephani <phst@google.com>
+
+ Improve unescaped character literal warnings
+
+ * src/lread.c (load_warn_unescaped_character_literals)
+ (syms_of_lread):
+ lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Improve
+ formatting of unescaped character literal warnings.
+
+ * test/src/lread-tests.el (lread-tests--unescaped-char-literals):
+ test/lisp/emacs-lisp/bytecomp-tests.el
+ (bytecomp-tests--unescaped-char-literals): Adapt unit tests.
+
+2017-05-12 Alan Mackenzie <acm@muc.de>
+
+ Fontify C++ for loop variable as variable, even when followed by parentheses
+
+ In the following: "for (auto *Friend : Class->friends()) {", "Friend" was
+ getting fontified as a function, due to insufficient checking of the tokens
+ between it and "()".
+
+ * lisp/progmodes/cc-langs.el (c-:-op-cont-tokens, c-:-op-cont-regexp): New
+ lang-consts/vars.
+
+ * lisp/progmodes/cc-engine.el (c-forward-declarator): After finding a putative
+ declarator's identifier, check for a ":" token inside a for's parentheses, and
+ abort the search for "(" if this is found.
+
+2017-05-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Make Tramp backward compatible
+
+ * lisp/net/tramp-cmds.el (tramp-change-syntax):
+ Set tramp-autoload cookie.
+
+ * lisp/net/tramp-compat.el: Run `tramp-change-syntax' at
+ startup, if necessary.
+
+ * lisp/net/tramp.el (tramp-syntax): Use `tramp-compat-user-error'.
+ (tramp-register-autoload-file-name-handlers): Do not mark
+ `operations' for `tramp-file-name-handler'.
+ (tramp-register-file-name-handlers): Remove also
+ `tramp-autoload-file-name-handler' for backward compatibility.
+ (tramp-register-foreign-file-name-handler): Use `delete-dups'.
+
+ * test/lisp/net/tramp-tests.el (tramp-change-syntax): Declare.
+
+2017-05-12 Noam Postavsky <npostavs@gmail.com>
+
+ Modify `beginning-of-defun-comments'
+
+ * lisp/emacs-lisp/lisp.el (beginning-of-defun-comments): Try not to stop
+ in the middle of a multiline comment.
+
+2017-05-12 Noam Postavsky <npostavs@gmail.com>
+
+ Fix elisp-tests-with-temp-buffer compilation
+
+ * test/lisp/emacs-lisp/lisp-tests.el (elisp-tests-with-temp-buffer):
+ Don't refer to the =!NAME= as "markers" since they produce variables
+ with just plain positions, not marker objects. Explicitly specify
+ that CONTENTS is evaluated at compile time. Don't re-evaluate
+ CONTENTS at runtime. Fix debug specification. Suppress warnings due
+ to BODY not using =!NAME= variables.
+ (elisp-test-point-position-regex): Rename from
+ `elisp-test-point-marker-regex'.
+ (mark-defun-test-buffer): Wrap in `eval-and-compile'.
+
+2017-05-12 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/emacs-lisp/lisp.el (mark-defun): Simplify moving the point.
+
+2017-05-12 Marcin Borkowski <mbork@mbork.pl>
+
+ Fix Bug#21072 and rework `mark-defun'
+
+ * test/lisp/progmodes/elisp-mode-tests.el (mark-defun-test-buffer):
+ New variable
+ (mark-defun-no-arg-region-inactive)
+ (mark-defun-no-arg-region-active)
+ (mark-defun-arg-region-active)
+ (mark-defun-pos-arg-region-inactive)
+ (mark-defun-neg-arg-region-inactive, mark-defun-bob): Add tests for
+ the new `mark-defun'.
+
+ * lisp/emacs-lisp/lisp.el (beginning-of-defun--in-emptyish-line-p):
+ New function.
+ (beginning-of-defun-comments): New function.
+ (mark-defun): Fix bug#21072, also rewrite large parts of `mark-defun'
+ to accept a numerical prefix argument.
+
+2017-05-12 Alfred M. Szmidt <ams@gnu.org>
+
+ * lisp/mail/rmail.el (rmail-ignored-headers): Add 3 headers to ignore.
+
+2017-05-12 Eli Zaretskii <eliz@gnu.org>
+
+ Improve doc strings in net-utils.el
+
+ * lisp/net/net-utils.el (ifconfig, iwconfig, netstat, arp)
+ (route, traceroute, nslookup, ftp, smbclient)
+ (smbclient-list-shares, finger, whois)
+ (network-connection-to-service, network-service-connection)
+ (network-connection-reconnect): Improve doc strings.
+
+2017-05-12 Andrew Robbins <contact@andrewrobbins.info>
+
+ Extend DNS lookup commands to allow specifying the name server
+
+ * lisp/net/net-utils.el (ffap-string-at-point): Removed due to
+ 'net-utils-machine-at-point' obviating this autoloaded
+ function (Bug#25426).
+ (dig-program-options): New customization variable.
+ (nslookup-host, dns-lookup-host, run-dig): Can now specify
+ optional name server argument interactively (by prefix arg) and
+ non-interactively.
+
+ * etc/NEWS: Mention the extension of DNS lookup commands.
+
+2017-05-12 Glenn Morris <rgm@gnu.org>
+
+ Don't hard-code loaddefs files in lisp/Makefile
+
+ * lisp/Makefile.in (loaddefs): New variable.
+ (AUTOGENEL): Use $loaddefs, and include directory.
+ (bootstrap-clean): Update for AUTOGENEL change.
+
+2017-05-11 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Kill modified buffers silently when quitting (bug#26862)
+
+ * lisp/gnus/gnus-start.el (gnus-clear-system): Run do-auto-save to make
+ sure that latest drafts are saved, and kill modified buffers silently.
+
+2017-05-10 Perry E. Metzger <perry@piermont.com>
+
+ Implement 1-based column numbering in mode line
+
+ * src/xdisp.c (decode_mode_spec): Implement the %C construct.
+
+ * lisp/bindings.el (column-number-indicator-zero-based): New
+ defcustom.
+ (mode-line-position): Use %C when
+ column-number-indicator-zero-based is nil.
+
+ * src/xdisp.c (syms_of_xdisp) <frame-title-format>:
+ * src/buffer.c (syms_of_buffer) <mode-line-format>:
+ * doc/lispref/modes.texi (%-Constructs):
+ * doc/lispref/frames.texi (Frame Titles): Document the %C
+ construct.
+
+ * doc/emacs/display.texi (Optional Mode Line): Document
+ 'column-number-indicator-zero-based'.
+
+ * etc/NEWS: Mention 'column-number-indicator-zero-based' and the
+ %C construct.
+
+2017-05-10 Eli Zaretskii <eliz@gnu.org>
+
+ Ensure cursor's foreground color is in sync with 'default' face
+
+ * src/w32term.c (x_set_cursor_gc): Don't reuse cursor GC if its
+ foreground color is different from the background of the glyph
+ string's face. (Bug#26851)
+
+2017-05-10 Eli Zaretskii <eliz@gnu.org>
+
+ Fix vertical cursor motion when columns are of unequal size
+
+ * lisp/simple.el (line-move-finish): In line-move-visual mode, use
+ vertical-motion to move to the goal column, as the goal column
+ should in that case be interpreted in units of frame's canonical
+ character width. (Bug#26852)
+
+2017-05-10 Glenn Morris <rgm@gnu.org>
+
+ Fix finding test .el files
+
+ * test/Makefile.in (ELFILES): Exclude the data/ directory.
+ * test/src/lread-tests.el (lread-test-bug26837): Revert previous.
+
+2017-05-10 Tino Calancha <tino.calancha@gmail.com>
+
+ Tweak a recent test
+
+ This test fails in my local machine because the data files
+ are compiled, and the test doesn't expect that.
+ * test/src/lread-tests.el (lread-test-bug26837): Match a suffix
+ ending with '.elc' when the data files are compiled.
+
+2017-05-10 Glenn Morris <rgm@gnu.org>
+
+ Put license information in each generated uni-*.el
+
+ * admin/unidata/unidata-gen.el (unidata-gen-file):
+ Get Copyright line from copyright.html.
+ Put information in file header, not separate README.
+ (unidata-gen-charprop): Mention the source location.
+ * lisp/international/README: Remove file.
+
+2017-05-10 Noam Postavsky <npostavs@gmail.com>
+
+ Fix lisp-indent-region and indent-sexp (Bug#26619)
+
+ The new lisp-indent-region introduced in 2017-04-22 "Add new
+ `lisp-indent-region' that doesn't reparse the code." is broken because
+ it doesn't save the calculated indent amounts for already seen sexp
+ depths. Fix this by unifying the indent-sexp and lisp-indent-region
+ code. Furthermore, only preserve position 2 of the running parse
+ when the depth doesn't change.
+ * lisp/emacs-lisp/lisp-mode.el (lisp-ppss): Use an OLDSTATE that
+ corresponds with the start point when calling parse-partial-sexp.
+ (lisp-indent-state): New struct.
+ (lisp-indent-calc-next): New function, extracted from indent-sexp.
+ (indent-sexp, lisp-indent-region): Use it.
+ (lisp-indent-line): Take indentation, instead of parse state.
+ * test/lisp/emacs-lisp/lisp-mode-tests.el
+ (lisp-mode-tests--correctly-indented-sexp): New constant.
+ (lisp-indent-region, lisp-indent-region-defun-with-docstring):
+ (lisp-indent-region-open-paren, lisp-indent-region-in-sexp): New
+ tests.
+
+2017-05-10 Dmitry Gutov <dgutov@yandex.ru>
+
+ Simplify url-encode-url and add a test
+
+ * lisp/url/url-util.el (url-encode-url): Simplify.
+ url-generic-parse-url copes with multibyte strings just fine
+ (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24117#185).
+
+ * test/lisp/url/url-parse-tests.el
+ (url-generic-parse-url/multibyte-host-and-path): New test.
+
+2017-05-10 Glenn Morris <rgm@gnu.org>
+
+ More informative error when required feature missing
+
+ * src/fns.c (Frequire): Include file name in missing feature error.
+ * doc/lispref/loading.texi (Named Features): Don't quote actual error.
+
+2017-05-10 Glenn Morris <rgm@gnu.org>
+
+ Put re-loaded file back at start of load-history (bug#26837)
+
+ * src/lread.c (readevalloop): Fix the "whole buffer" check to
+ operate in the correct buffer.
+ (Feval_buffer): Move point back to the start after checking
+ for lexical binding.
+ * test/src/lread-tests.el (lread-test-bug26837): New test.
+ * test/data/somelib.el, test/data/somelib2.el: New test data files.
+
+2017-05-09 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'gnutls-verify-error'
+
+ * lisp/net/gnutls.el (gnutls-verify-error): Improve and expand
+ doc string. (Bug#26845)
+
+2017-05-09 Glenn Morris <rgm@gnu.org>
+
+ Don't duplicate autoload code in package.el
+
+ * lisp/emacs-lisp/autoload.el (autoload-rubric): Add a package option.
+ * lisp/emacs-lisp/package.el (autoload-rubric): Declare.
+ (package-autoload-ensure-default-file): Use autoload-rubric.
+
+2017-05-09 Michael Albinus <michael.albinus@gmx.de>
+
+ * test/lisp/net/tramp-tests.el: Keep additional test.
+
+2017-05-09 Marcin Borkowski <mbork@mbork.pl>
+
+ Add elisp-tests-with-temp-buffer, a new testing macro
+
+ * test/lisp/emacs-lisp/lisp-tests.el
+ (elisp-test-point-marker-regex) New variable.
+ (elisp-tests-with-temp-buffer): New macro to help test functions
+ moving the point and/or mark.
+
+2017-05-09 Noam Postavsky <npostavs@gmail.com>
+
+ Revert "Output number of characters added to file (Bug#354)"
+
+ The extra message text turned out to be quite annoying in practice,
+ and is generally more trouble than it's worth. Also revert several
+ related changes.
+
+ Partially revert "Handle `write-region' messages in Tramp properly"
+ Revert "New var write-region-verbose, default nil"
+ Revert "* src/fileio.c (write_region): Don't say "1 characters". (Bug#26796)"
+ Revert "Minor tuneup of write-region change"
+ Revert "Adjust write-region so file name is at the beginning again"
+ Revert "Fix handling of non-integer START param to write-region"
+ Revert "Output number of characters added to file (Bug#354)"
+
+ * doc/emacs/files.texi (Misc File Ops):
+ * etc/NEWS:
+ * lisp/epa-file.el (epa-file-write-region):
+ * lisp/gnus/mm-util.el (mm-append-to-file):
+ * lisp/jka-compr.el (jka-compr-write-region):
+ * lisp/net/ange-ftp.el (ange-ftp-write-region):
+ * lisp/net/tramp-adb.el (tramp-adb-handle-write-region):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
+ * lisp/net/tramp.el (tramp-handle-write-region-message):
+ * src/fileio.c (write_region, syms_of_fileio):
+ * test/lisp/net/tramp-tests.el (tramp-test10-write-region): Remove
+ extra characters from file writing messages.
+
+2017-05-09 Noah Friedman <friedman@splode.com>
+
+ (ybuffer-list): $alist must be ptr-unmasked at the end of the loop,
+ because $ptr is modified by ygetptr and we use $ptr immediately at the
+ beginning.
+
+2017-05-08 Ken Brown <kbrown@cornell.edu>
+
+ Skip a test from filenotify-tests.el on Cygwin
+
+ * test/lisp/filenotify-tests.el (file-notify-test02-rm-watch):
+ Skip the last part of the test on Cygwin; it fails due to timing
+ issues.
+ (file-notify--test-read-event): Remove `sit-for' that was added
+ for Cygwin.
+
+2017-05-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-05-08 intprops: don’t depend on ‘verify’
+ 2017-05-07 utimens: on native Windows, improve resolution if fd < 0
+ 2017-05-07 utimens: Improve error code on native Windows
+ * lib/intprops.h, lib/utimens.c: Copy from gnulib.
+
+2017-05-08 Wilson Snyder <wsnyder@wsnyder.org>
+
+ Fix various verilog-mode.el issues.
+
+ * lisp/progmodes/verilog-mode.el (verilog-read-decls): Fix SystemVerilog
+ 2012 import breaking AUTOINST. Reported by Johannes Schaefer.
+ (verilog-auto-wire-type, verilog-insert-definition): Fix AUTOWIRE using
+ logic in top-level non-SystemVerilog module, bug1142. Reported by Marcin K.
+ (verilog-define-abbrev-table) (verilog-mode-abbrev-table): Don't expand
+ abbrev inside comment/strings, bug1102. Reported by Slava Yuzhaninov.
+ (verilog-auto): Fix AUTORESET widths pulling from AUTOREGINPUT,
+ msg2143. Reported by Galen Seitz.
+ (verilog-modify-compile-command): Fix expansion of __FLAGS__ when
+ compile-command is globally set, bug1119. Reported by Galen Seitz.
+
+2017-05-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Handle `write-region' messages in Tramp properly
+
+ * lisp/net/tramp.el (tramp-handle-write-region-message): New defsubst.
+ * lisp/net/tramp-adb.el (tramp-adb-handle-write-region):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Use it.
+
+ * lisp/net/tramp.el (tramp-password-prompt-regexp)
+ (tramp-completion-mode-p):
+ * lisp/net/tramp-cmds.el (tramp-reporter-dump-variable)
+ (tramp-append-tramp-buffers):
+ * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection):
+ Use `bound-and-true-p'.
+
+ * lisp/net/tramp-compat.el (tramp-compat-delete-file):
+ Don't check for `boundp' anymore.
+
+ * test/lisp/net/tramp-tests.el (ert-x): Require it.
+ (tramp--test-messages): New defvar.
+ (tramp-test10-write-region): Extend test.
+
+2017-05-08 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ Fix glyph string generation for multi-font compositions (Bug#26742)
+
+ * src/xdisp.c (glyph_string_containing_background_width): New function.
+ (draw_glyphs): Use it to get correct background width.
+ (compute_overhangs_and_x): Don't change x in the middle of composite
+ characters.
+
+2017-05-07 Philipp Stephani <phst@google.com>
+
+ Fix all unescaped character literals
+
+2017-05-07 Alan Mackenzie <acm@muc.de>
+
+ CC Mode internal cache: Handle a cache pos being inside a two-char construct.
+
+ Cache c-state-semi-nonlit-pos-cache was failing when a cache position was,
+ e.g., between the two characters of an opening comment "/*", and additionally
+ there were an odd number of quote marks (apostrophes) in the comment. This
+ happened in .../src/xdisp.c in the Emacs master branch around 2017-05-02 at
+ buffer position 615001.
+
+ * lisp/progmodes/cc-defs.el (c-emacs-features): Repurpose symbol
+ pps-extended-state to mean that there are at least 11 elements in the parser
+ state.
+
+ * lisp/progmodes/cc-engine.el (c-cache-to-parse-ps-state)
+ (c-parse-ps-state-to-cache): Rewrite these to use enhanced cache element list
+ types which indicate potentially being inside two-char constructs.
+ (c-parse-ps-state-below): Rewrite to use the new versions of the above two
+ functions.
+
+2017-05-07 Glenn Morris <rgm@gnu.org>
+
+ Silence an mh-compat compiler warning
+
+ * lisp/mh-e/mh-compat.el (mh-url-unreserved-chars): Always define.
+
+2017-05-07 Glenn Morris <rgm@gnu.org>
+
+ Evaluate mh-require when compiling
+
+ * lisp/mh-e/mh-alias.el, lisp/mh-e/mh-folder.el:
+ * lisp/mh-e/mh-gnus.el, lisp/mh-e/mh-search.el:
+ Evaluate mh-require when compiling, as require is automatically.
+ * lisp/mh-e/mh-gnus.el: No longer disable byte-compilation.
+
+2017-05-07 Glenn Morris <rgm@gnu.org>
+
+ Remove obsolete method of changing byte-compile-dest-file
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-dest-file):
+ Define unconditionally.
+
+2017-05-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ New var write-region-verbose, default nil
+
+ By popular demand, write-region char counts are now off by default
+ (Bug#26796).
+ * src/fileio.c (write-region-verbose): New Lisp var.
+ (write_region): Output char count only if the var is non-nil.
+ * doc/emacs/files.texi (Misc File Ops), etc/NEWS: Document this.
+
+2017-05-07 Glenn Morris <rgm@gnu.org>
+
+ Write autoloads file atomically
+
+ * lisp/emacs-lisp/autoload.el (autoload--save-buffer):
+ New function, to save buffer atomically.
+ (autoload-save-buffers, update-directory-autoloads):
+ Use autoload--save-buffer.
+ * lisp/Makefile.in ($(lisp)/loaddefs.el):
+ No longer write to a temp file by hand.
+
+2017-05-07 Glenn Morris <rgm@gnu.org>
+
+ Write autoloads file once only
+
+ * lisp/emacs-lisp/autoload.el (autoload-find-generated-file):
+ Simplify. Don't bother about ensuring the output file exists.
+ (autoload-generated-file): Add doc.
+ (autoload-ensure-writable): Update doc.
+ (autoload-ensure-file-writeable): Handle non-existing file.
+ (autoload-ensure-default-file): Remove function.
+
+2017-05-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port .gdbinit to GDB 7.11.1 + Python 2.7.12
+
+ * src/.gdbinit (Lisp_Object_Printer.to_string):
+ Explicitly convert integer val to 'int', so that
+ older GDBs do not complain about the conversion.
+ * src/lisp.h (Lisp_Object) [CHECK_LISP_OBJECT_TYPE]:
+ Give the struct a tag, so that older GDB pretty-printers have a
+ tag to hang their hat on.
+
+2017-05-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pretty-print const Lisp_Objects in .gdbinit
+
+ * src/.gdbinit (Emacs_Pretty_Printers.__call__):
+ Compare unqualified type to Lisp_Object, to do the right thing
+ when the expression has type ‘Lisp_Object const’.
+ Problem reported by Eli Zaretskii in:
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00138.html
+
+2017-05-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify GCC setjmp/longjmp warning
+
+ * src/eval.c (internal_lisp_condition_case): Do not modify local
+ var VAR, to pacify GCC’s setjmp/longjmp warning which in some
+ cases mistakenly diagnoses VAR possibly being modified between a
+ setjmp and a longjmp.
+
+2017-05-06 Philipp <phst@google.com>
+
+ Fix bootstrap build of files.el
+
+ * lisp/files.el (file-name-non-special): Don't use cl-letf.
+
+2017-05-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change for MS-Windows
+
+ * test/src/emacs-module-tests.el (module-function-object): Port to
+ MS-Windows.
+
+2017-05-06 Philipp Stephani <phst@google.com>
+
+ Introduce new misc type for module function
+
+ This resolves a couple of FIXMEs in emacs-module.c.
+
+ * src/lisp.h (MODULE_FUNCTIONP, XMODULE_FUNCTION): New functions.
+
+ * src/alloc.c (make_module_function): New function.
+ (mark_object): GC support.
+
+ * src/data.c (Ftype_of, syms_of_data): Handle module function type.
+
+ * src/print.c (print_object): Print support for new type.
+
+ * src/emacs-module.c (module_make_function, Finternal_module_call):
+ Use new module function type, remove FIXMEs.
+ (module_format_fun_env): Adapt and give it external linkage.
+
+ * test/src/emacs-module-tests.el (module-function-object): Add unit
+ test.
+
+2017-05-06 Philipp Stephani <phst@google.com>
+
+ Fix quoted files for 'verify-visited-file-modtime'
+
+ Fixes Bug#25951.
+
+ * lisp/files.el (file-name-non-special): Set the file name for the
+ correct buffer.
+
+ * test/lisp/files-tests.el (files-tests--file-name-non-special--buffers):
+ Add unit test.
+ (files-tests--with-advice, files-tests--with-temp-file): New helper
+ macros.
+
+2017-05-06 Eli Zaretskii <eliz@gnu.org>
+
+ * src/fileio.c (write_region): Don't say "1 characters". (Bug#26796)
+
+2017-05-06 Eli Zaretskii <eliz@gnu.org>
+
+ Turn on GC_CHECK_MARKED_OBJECTS by default under ENABLE_CHECKING
+
+ * src/alloc.c (GC_CHECK_MARKED_OBJECTS): Define to 1 by default of
+ ENABLE_CHECKING is defined.
+ (mark_object): Test for GC_CHECK_MARKED_OBJECTS being non-zero,
+ instead of being defined.
+
+2017-05-06 Tom Tromey <tom@tromey.com>
+
+ Fix erc-join with channel password
+
+ Bug#25349
+ * lisp/erc/erc-join.el (erc-autojoin-after-ident): Switch order of
+ server names.
+ (erc-autojoin-channels, erc-autojoin-add, erc-autojoin-remove):
+ Likewise.
+ (erc-server-join-channel): Move to erc.el.
+ * lisp/erc/erc.el (erc-server-join-channel): Move from erc-join.el.
+ (erc-cmd-JOIN): Use erc-server-join-channel.
+
+2017-05-06 Tino Calancha <tino.calancha@gmail.com>
+
+ Ensure the created temp file in a test is new
+
+ * test/lisp/buff-menu-tests.el (buff-menu-24962): Use `make-temp-file'
+ to create the temp file.
+
+2017-05-06 Glenn Morris <rgm@gnu.org>
+
+ Decruftify dns-mode.el a little bit
+
+ * lisp/textmodes/dns-mode.el (dns-mode-control-entities):
+ New constant.
+ (dns-mode-control-entity, dns-mode-bad-control-entity)
+ (dns-mode-type, dns-mode-class): New faces.
+ (dns-mode-control-entity-face, dns-mode-bad-control-entity-face)
+ (dns-mode-type-face, dns-mode-class): Make these variables use the
+ new faces, and mark as obsolete.
+ (dns-mode-font-lock-keywords): Use dns-mode-control-entities.
+
+2017-05-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pretty-print Lisp_Object values in GDB
+
+ * src/.gdbinit: Add a pretty-printer for Lisp_Object values. Now,
+ GDB displays them as "XIL(0xXXX)" rather than displaying them
+ as "..." when CHECK_LISP_OBJECT_TYPE is in effect and as "DDDDD"
+ otherwise.
+
+2017-05-05 Peder O. Klingenberg <peder@klingenberg.no>
+
+ Tweak dns-mode font-lock
+
+ * lisp/textmodes/dns-mode.el (dns-mode-font-lock-keywords):
+ Highlight $TTL as a control entity. (Bug#26780)
+
+2017-05-05 Glenn Morris <rgm@gnu.org>
+
+ Fontify the doc-string in some CL forms as such
+
+ * lisp/emacs-lisp/lisp-mode.el (defconstant, defparameter):
+ Add the doc-string-elt property. (Bug#26778)
+
+2017-05-05 Glenn Morris <rgm@gnu.org>
+
+ * lisp/emacs-lisp/cl-lib.el (cl-mapcar): Remove recent autoload cookie.
+
+2017-05-05 Dmitry Gutov <dgutov@yandex.ru>
+
+ cl-defmethod: Make the edebug spec more technically correct
+
+ * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Denote the
+ edebug spec part for qualifiers as [&rest atom], per
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00053.html.
+
+2017-05-05 Mike Kupfer <mkupfer@alum.berkeley.edu>
+
+ Fix MH-E not to load cl at runtime (Bug#25552)
+
+ * lisp/mh-e/mh-acros.el (defun-mh): Check at runtime, not
+ compile time, whether the target is bound.
+ * lisp/mh-e/mh-compat.el: Enable compilation. Pull in
+ mh-acros at compile time.
+ Authored-by: Glenn Morris <rgm@gnu.org>, Noam Postavsky
+ <npostavs@users.sourceforge.net>
+
+2017-05-04 Jean-Christophe Helary <jean.christophe.helary@gmail.com>
+
+ Multiline support in NS "Open Selected File" service.
+
+ * lisp/term/ns-win.el (ns-open-file-service): new function. Wraps the
+ original call in a (split-string) to create as many calls as there
+ are lines.
+ (ns-spi-service-call): Call `ns-open-file-service' instead of
+ `dnd-open-file'.
+
+2017-05-04 Göktuğ Kayaalp <self@gkayaalp.com>
+
+ Require cl-lib at runtime in vc-hg
+
+ * lisp/vc/vc-hg.el: Require cl-lib at runtime as well (bug#26609).
+
+2017-05-04 Tino Calancha <tino.calancha@gmail.com>
+
+ Inherit incompatible/obsolete package faces from error
+
+ Don't use the same face for installed packages as for incompatible
+ or obsolete ones.
+ * lisp/emacs-lisp/package.el (package-status-incompat): Inherit from error.
+
+2017-05-04 Michael Albinus <michael.albinus@gmx.de>
+
+ Set process property `adjust-window-size-function' to `ignore' in Tramp
+
+ * lisp/net/tramp-adb.el (tramp-adb-parse-device-names)
+ (tramp-adb-maybe-open-connection):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
+ * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-maybe-open-connection):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory)
+ (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl)
+ (tramp-smb-maybe-open-connection): Set process property
+ `adjust-window-size-function' to `ignore'.
+
+2017-05-04 Nicolas Petton <nicolas@petton.fr>
+
+ * lisp/emacs-lisp/seq.el: Bump seq version.
+
+2017-05-04 Damien Cassou <damien@cassou.me>
+
+ Add seq-set-equal-p to test for set equality
+
+ * lisp/emacs-lisp/seq.el (seq-set-equal-p): Add function to compare
+ two lists as if they were sets.
+
+ * test/lisp/emacs-lisp/seq-tests.el (test-seq-set-equal-p): Add test
+ for seq-set-equal-p.
+
+2017-05-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Spelling fixes
+
+ * lisp/gnus/nndiary.el (nndiary-last-occurrence):
+ Rename from nndiary-last-occurence.
+ (nndiary-next-occurrence):
+ Rename from nndiary-next-occurence. All uses changed.
+
+2017-05-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from pkg-config
+
+ * m4/pkg.m4: Copy from pkg-config 0.29.1.
+
+2017-05-04 Tom Tromey <tom@tromey.com>
+
+ Add color highlighting to css-mode
+
+ Bug#25525
+ * lisp/textmodes/css-mode.el (css--color-map): New constant.
+ (css-value-class-alist): Use css--color-map.
+ (css--number-regexp, css--percent-regexp)
+ (css--number-or-percent-regexp, css--angle-regexp): New constants.
+ (css--color-skip-blanks, css--rgb-color, css--hsl-color): New
+ functions.
+ (css--colors-regexp): New constant.
+ (css--hex-color, css--named-color, css--compute-color)
+ (css--contrasty-color, css--fontify-colors)
+ (css--fontify-region): New functions.
+ (css-mode): Set font-lock-fontify-region-function.
+ (css-mode-syntax-table): Set syntax on more characters.
+ (css-fontify-colors): New defcustom.
+ (scss-mode-syntax-table): Define syntax for ?$ and ?%.
+ * test/lisp/textmodes/css-mode-tests.el (css-test-property-values):
+ Update.
+ (css-test-rgb-parser, css-test-hsl-parser)
+ (css-test-named-color): New tests.
+ * etc/NEWS: Add entry.
+
+2017-05-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#26763
+
+ * lisp/files.el (delete-directory): Call file name handler
+ with `trash' argument.
+
+ * lisp/net/ange-ftp.el (ange-ftp-delete-directory):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-delete-directory):
+ Add TRASH arg. Implement it. (Bug#26763)
+ (tramp-get-remote-trash): Check for `delete-by-moving-to-trash'.
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-delete-directory):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-delete-directory):
+ Add _TRASH arg.
+
+2017-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ptrdiff_t, not int, for stack sizes
+
+ * src/thread.c (invoke_thread_function):
+ * src/xterm.c (x_cr_export_frames):
+ Don’t assume SPECPDL_INDEX fits in ‘int’.
+
+2017-05-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Check list object type if --enable-gcc-warnings
+
+ * configure.ac (--enable-check-lisp-object-type):
+ Default to "yes" if --enable-gcc-warnings is not "no".
+ * etc/NEWS: Mention this.
+ * src/eval.c (internal_lisp_condition_case): Fix some glitches
+ with 'volatile' uncovered by the above: in particular, 'clauses'
+ should be a pointer to volatile storage on the stack, and need not
+ be volatile itself. Use an int, not ptrdiff_t, to count clauses.
+ Don’t bother gathering binding count if VAR is nil. Use
+ more-specific local names to try to clarify what’s going on.
+
+2017-05-02 Glenn Morris <rgm@gnu.org>
+
+ Tweak auth-source-pass.el to avoid run-time subr-x
+
+ * lisp/auth-source-pass.el (auth-source-pass--parse-data):
+ Avoid needing subr-x at run-time.
+
+2017-05-02 Charles A. Roelli <charles@aurox.ch>
+
+ Constrain non-child frames to screen area in OS X
+
+ * src/nsterm.m (constrainFrameRect:toScreen:): Constrain non-child
+ frames in OS X, if they would otherwise go offscreen.
+
+ (Bug#25818)
+
+2017-05-02 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix error in completion for separate Tramp syntax
+
+ * lisp/net/tramp.el (tramp-completion-file-name-regexp-separate):
+ Tweak regexp.
+
+ * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion):
+ Run method and host name completion for all syntaxes.
+
+2017-05-02 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compilation warnings
+
+ * src/w32fns.c (Fx_file_dialog, w32_parse_and_hook_hot_key):
+ * src/w32term.c (x_draw_glyph_string):
+ * src/w32fns.c (compute_tip_xy):
+ * src/w32font.c (w32font_text_extents):
+ * src/w32menu.c (set_frame_menubar):
+ * src/search.c (Freplace_match): Avoid compiler warnings in
+ optimized builds.
+
+2017-05-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-05-02 utimens: port to Emacs + MS-Windows
+ * lib/utimens.c: Copy from gnulib.
+
+2017-05-02 Gemini Lasswell <gazally@runbox.com>
+
+ Fix Edebug specs for 'cl-defmethod' and 'defmethod'
+
+ * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Change Edebug spec
+ to make Edebug generate a new symbol for each method (Bug#24753) and
+ to support a string following :extra (Bug#23995).
+ * lisp/emacs-lisp/eieio-compat.el (defmethod): Change Edebug spec to
+ make Edebug generate a new symbol for each method (Bug#24753).
+
+2017-05-02 Eli Zaretskii <eliz@gnu.org>
+
+ Temporary fix for the MS_Windows build
+
+ * nt/inc/ms-w32.h (WIN32_LEAN_AND_MEAN): Define to an empty value,
+ to be consistent with Gnulib's utimens.c. This is because utimens.c
+ unconditionally defines WIN32_LEAN_AND_MEAN to an empty value, so the
+ previous definition here conflicted with that.
+
+2017-05-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port format-time-string to MS-Windows better
+
+ * test/src/editfns-tests.el (format-time-string-with-zone):
+ Port test cases to MS-Windows.
+
+2017-05-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-05-01 New module 'localtime-buffer'
+ 2017-04-30 utimens: Add support for native Windows
+ * admin/merge-gnulib (AVOIDED_MODULES): Add tzset.
+ * configure.ac (tzset): No need for Emacs itself to check now.
+ * lib/gettimeofday.c, lib/time.in.h, lib/time_rz.c, lib/utimens.c:
+ * m4/gettimeofday.m4, m4/time_h.m4, m4/time_rz.m4: Copy from gnulib.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib/localtime-buffer.c, lib/localtime-buffer.h:
+ * m4/localtime-buffer.m4: New files, copied from gnulib.
+ * src/editfns.c (init_editfns): Assume tzset is callable.
+
+2017-05-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ Speed up project-find-regexp for simple regexps
+
+ * lisp/progmodes/xref.el (xref--regexp-syntax-dependent-p):
+ New function.
+ (xref--collect-matches): Use it. Don't try to enable the
+ appropriate major mode and file-local variables if the regexp
+ does not depend on the buffer's syntax (bug#26710).
+ (xref--collect-matches-1): Don't syntax-propertize in that
+ case either.
+
+2017-05-01 Philipp Stephani <phst@google.com>
+
+ Warn about missing backslashes during load
+
+ * src/lread.c (load_warn_unescaped_character_literals, Fload, read1)
+ (syms_of_lread): Warn if unescaped character literals are
+ found (Bug#20152).
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Check for
+ unescaped character literals during byte compilation.
+ * test/src/lread-tests.el (lread-tests--unescaped-char-literals): New
+ unit test.
+ (lread-tests--with-temp-file, lread-tests--last-message): Helper
+ functions for unit test.
+ * test/lisp/emacs-lisp/bytecomp-tests.el
+ (bytecomp-tests--unescaped-char-literals): New unit test.
+ * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file):
+ Helper macro for unit test.
+
+2017-05-01 Ken Brown <kbrown@cornell.edu>
+
+ * configure.ac: Suggest Mailutils on Cygwin.
+
+2017-05-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t stress-test time zones near the Epoch
+
+ * test/src/editfns-tests.el (format-time-string-with-zone)
+ (format-time-string-with-outlandish-zone): Don’t format
+ timestamps near the Epoch, as this runs into bugs on MS-Windows,
+ and we don’t want to worry about those bugs.
+
+2017-05-01 Glenn Morris <rgm@gnu.org>
+
+ Tweak vc-tests.el for bzr
+
+ * test/lisp/vc/vc-tests.el (vc-test--working-revision):
+ Handle test environments where HOME does not exist.
+
+2017-05-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ vc-git-state: Return `ignored' as appropriate with newer Git
+
+ * lisp/vc/vc-git.el
+ (vc-git--program-version): New variable.
+ (vc-git--program-version): New function.
+ (vc-git-state): Use it to choose whether to add '--ignored' (bug#19343).
+
+2017-05-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ vc-git-state: Bring back CentOS 6 compatibility
+
+ * lisp/vc/vc-git.el (vc-git-state):
+ Bring back CentOS 6 compatibility (bug#19343).
+
+2017-05-01 Martin Rudalics <rudalics@gmx.at>
+
+ Rewrite w32fns.c's `x_set_menu_bar_lines'
+
+ * src/w32fns.c (x_set_menu_bar_lines): Redraw frame immediately
+ regardless of whether menu bar is added or removed. Clear
+ under internal border iff a W32 window exists. Store either 0
+ or 1 as new parameter value.
+ (x_change_tool_bar_height): Use FRAME_W32_WINDOW instead of
+ FRAME_X_WINDOW.
+
+2017-05-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix filenotify-tests.el for cygwin
+
+ * test/lisp/filenotify-tests.el (file-notify--test-read-event):
+ Add an additional `sit-for'.
+ (file-notify-test02-rm-watch): Add an additional
+ `file-notify--test-read-event' call.
+
+2017-05-01 Jonathan Ganc <jonganc@gmail.com>
+
+ Speed up vc-git-status and make it more precise
+
+ * lisp/vc/vc-git.el (vc-git-state)
+ (vc-git--git-status-to-vc-state): Update 'vc-git-state' to use
+ 'git status', so that 'vc-git-state' can now return 'ignored',
+ 'conflict', or 'unregistered' when appropriate. Discussed in
+ bug#26066. Fixes bug#19343.
+
+2017-05-01 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix Git revision navigation in currently removed directories
+
+ * lisp/vc/vc-git.el (vc-git-next-revision): Use the repo root as
+ default-directory because FILE's parent directory might not exist
+ anymore (bug#26345).
+
+2017-04-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-04-30 strftime-fixes: New module
+ 2017-04-30 mktime: Work around TZ problem on native Windows
+ 2017-04-30 ctime, localtime: New modules
+ 2017-04-30 gettimeofday: Provide higher resolution on native Windows
+ 2017-04-29 utime-h: Modernize handling of 'struct utimbuf'
+ 2017-04-29 Make use of module 'utime-h'
+ 2017-04-30 Fix a few typos
+ * admin/merge-gnulib (AVOIDED_MODULES): Avoid utime-h, too.
+ * lib/gettimeofday.c, lib/mktime.c, lib/time.in.h, lib/utimens.c:
+ * m4/gettimeofday.m4, m4/include_next.m4, m4/mktime.m4:
+ * m4/strftime.m4, m4/time_h.m4, m4/timegm.m4, m4/utimens.m4:
+ Copy from gnulib.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+
+2017-04-30 Eli Zaretskii <eliz@gnu.org>
+
+ Don't lose key bindings on mis-spelled text in flyspell-mode
+
+ * lisp/textmodes/flyspell.el (flyspell-mouse-map): Bind mouse-2
+ explicitly.
+ (make-flyspell-overlay): If the mis-spelled text already has a
+ 'keymap' property, make that keymap the parent of
+ flyspell-mouse-map, so as not to lose the parent's bindings.
+ (Bug#26672)
+
+2017-04-30 Martin Rudalics <rudalics@gmx.at>
+
+ Fix `delete-frame' behavior including Bug#26682
+
+ * src/frame.c (other_frames): Accept two arguments now. Don't
+ care about minibuffer window. Don't care about visibility when
+ called from delete_frame with FORCE true (Bug#26682).
+ (delete_frame, Fmake_frame_invisible): Adjust other_frames
+ calls.
+ * src/w32term.c (w32_read_socket): Don't add a move frame event
+ for an invisible frame.
+ * lisp/frame.el (handle-delete-frame): Don't kill Emacs when
+ attempting to delete a surrogate minibuffer frame.
+
+2017-04-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This avoids incorporating the following, which I suspect are
+ more trouble for Emacs than they’re worth:
+ 2017-04-29 stat, fstat: fix time_t etc. on native Windows platforms
+ * admin/merge-gnulib (AVOIDED_MODULES): Avoid stat, too.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib/pathmax.h, lib/stat.c, m4/pathmax.m4, m4/stat.m4: Remove.
+
+2017-04-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix buffer overflow in make-docfile
+
+ * lib-src/make-docfile.c (scan_c_stream): Check for buffer
+ overflow when reading an identifier. Use a static buffer for NAME
+ rather than a small dynamically-allocated buffer.
+
+2017-04-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-04-29 getopt: port to Solaris 10 with circa-1997 glibc getopt.h
+ * lib/getopt-pfx-ext.h: Copy from gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-04-30 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix dependency error during bootstrap
+
+ * lisp/files.el: Require pcase and easy-mmode at compile time.
+
+2017-04-30 Mats Lidell <mats.lidell@cag.se>
+
+ * etc/tutorials/TUTORIAL.sv: synced with TUTORIAL
+
+2017-04-29 Philipp Stephani <phst@google.com>
+
+ Reimplement auto-saving to visited files
+
+ This reacts to confusing behavior of 'auto-save-visited-file-name',
+ cf. Bug#25478.
+
+ * lisp/files.el (auto-save-visited-interval): New customization option.
+ (auto-save-visited-mode): New global minor mode.
+ (auto-save-visited-file-name): Make obsolete.
+ (auto-save--timer): New internal helper variable.
+
+ * doc/emacs/files.texi (Auto Save Files): Document
+ 'auto-save-visited-mode' instead of obsolete
+ 'auto-save-visited-file-name'.
+ (Auto Save Control): Document customization option
+ 'auto-save-visited-interval'.
+
+2017-04-29 Paul Eggert <eggert@cs.ucla.edu>
+
+ Allow bypassing of some checks when merging
+
+ * build-aux/git-hooks/pre-commit: Don't check merged-in changes.
+
+2017-04-29 Philipp Stephani <phst@google.com>
+
+ Integrate module test with normal test suite
+
+ * test/Makefile.in (ELFILES): Exclude module test if modules aren't
+ configured.
+ (EMACS_TEST_DIRECTORY): Expand test directory so that it's set
+ correctly even if Emacs changes the current directory.
+ ($(srcdir)/src/emacs-module-tests.log)
+ ($(test_module)): Proper dependency tracking for test module.
+
+ * test/data/emacs-module/Makefile (ROOT): Adapt to new location.
+ Remove 'check' target and EMACS variable, which are no longer
+ necessary.
+ (SO): Change to include period.
+
+ * test/src/emacs-module-tests.el (mod-test): Use EMACS_TEST_DIRECTORY
+ environment variable to reliably find test data.
+
+ * configure.ac (HAVE_MODULES, MODULES_SUFFIX): Add necessary
+ substitutions.
+
+2017-04-28 Glenn Morris <rgm@gnu.org>
+
+ Broaden comint-password-prompt-regexp
+
+ * lisp/comint.el (comint-password-prompt-regexp):
+ Broaden the regexp, for non-English locales. (Bug#26698)
+
+2017-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/auth-source.el (auth-source-backend-parse): `return' -> cl-return.
+
+2017-04-28 Bartosz Duszel <bartosz.duszel@gmail.com>
+
+ Don't pass the value of point to 'push-mark', as that's the default.
+
+ * lisp/textmodes/bib-mode.el (mark-bib):
+ * lisp/simple.el (mark-whole-buffer, yank):
+ * lisp/ses.el (ses--advice-yank, ses-mark-row, ses-mark-column):
+ * lisp/progmodes/xscheme.el (xscheme-yank):
+ * lisp/progmodes/verilog-mode.el (verilog-mark-defun):
+ * lisp/progmodes/perl-mode.el (perl-mark-function):
+ * lisp/progmodes/pascal.el (pascal-mark-defun):
+ * lisp/progmodes/meta-mode.el (meta-mark-defun):
+ * lisp/progmodes/icon.el (mark-icon-function):
+ * lisp/progmodes/cc-cmds.el (c-mark-function):
+ * lisp/obsolete/vip.el (ex-goto):
+ * lisp/obsolete/vi.el (vi-put-before):
+ * lisp/mouse.el (mouse-yank-primary):
+ * lisp/menu-bar.el (menu-bar-select-yank):
+ * lisp/mail/sendmail.el (mail-yank-original):
+ * lisp/hexl.el (hexl-beginning-of-buffer, hexl-end-of-buffer):
+ * lisp/emulation/viper-cmd.el (viper-mark-beginning-of-buffer)
+ (viper-mark-end-of-buffer):
+ * lisp/cedet/semantic/senator.el (senator-mark-defun):
+ * lisp/allout.el (allout-mark-topic): Remove unnecessary argument
+ `(point)' from calls to `push-mark'. (Bug#25565)
+
+2017-04-28 Glenn Morris <rgm@gnu.org>
+
+ Merge from origin/emacs-25
+
+ 784602b1050 (origin/emacs-25) ; Add release notice
+ 3a34412caae (tag: emacs-25.2) Set Emacs version to 25.2 and update AU...
+ 56a4461a48d ; Move stray item from admin/notes/repo to CONTRIBUTE
+ 2b0d1118199 ; CONTRIBUTE: Remove stray header.
+ f2ab09ec60d Fix a typo in indexing the user manual
+ bc55a574235 * lisp/menu-bar.el (kill-this-buffer): Doc fix. (Bug#26466)
+ a6d50401b4b Document 'line-pixel-height'
+ 0c55cf43e61 * search.c (Fre_search_forward, Fre_search_backward): Imp...
+ c7ed57eaef4 Mention that processes start in default-directory (Bug#18...
+ 856ec9ffa1f * src/xdisp.c (vmessage, message): Clarify commentary.
+ 849a0aaa1c9 Belated fixes for admin.el's M-x make-manuals-dist
+ 84938d79698 default-directory: Remark that it must be a directory name
+ 3f0d047d2eb Delete confuse statement in manual
+ ee1bd94dd0c Improve packaging documentation
+ fb18bff91f0 Expand manual section on quitting windows
+ 9a737079645 Fix docstring of dabbrev-abbrev-char-regexp
+ afe8849bac1 * doc/misc/cl.texi (Iteration Clauses): Clarify example (...
+ ada79442c07 ;* doc/misc/info.texi (Choose menu subtopic): Improve ind...
+ d38fd9229c0 Narrow scope of modification hook renabling in org-src fo...
+ e0e9db4c84a ; Spelling fix
+
+ # Conflicts:
+ # README
+ # etc/AUTHORS
+ # etc/HISTORY
+ # lisp/ldefs-boot.el
+
+2017-04-28 Glenn Morris <rgm@gnu.org>
+
+ * doc/misc/auth.texi: Commas don't work in node names.
+
+ * test/lisp/auth-source-pass-tests.el: Fix loading of cl-lib.
+
+2017-04-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Test format-time-string with zone arg
+
+ * test/src/editfns-tests.el (format-time-string-with-zone)
+ (format-time-string-with-outlandish-zone): New tests.
+
+2017-04-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-04-24 time_rz: fix heap buffer overflow vulnerability
+ 2017-04-23 stat-time: Update comments.
+ 2017-04-22 ftoastr: cite a newer paper
+ 2017-04-21 gettext-h: Avoid -Wundef warning.
+ * lib/ftoastr.c, lib/gettext.h, lib/stat-time.h, lib/time_rz.c:
+ * m4/getopt.m4: Copy from gnulib.
+ * m4/gnulib-comp.m4: Regenerate.
+
+2017-04-27 Damien Cassou <damien@cassou.me>
+
+ auth-source-pass: Add documentation; fix tests and indentation.
+
+ * doc/misc/auth.texi: Document new integration with Pass. Use @itemize
+ instead of @enumerate.
+ * lisp/auth-source-pass.el: Fix indentation.
+ (auth-source-pass--remove-directory-name): Remove.
+ * test/lisp/auth-source-pass-tests.el: Adjust test macros.
+
+2017-04-27 foudfou <foudil.newbie+git@gmail.com>
+
+ auth-source-pass: Enable finding entries by "host/username"
+
+ * lisp/auth-source-pass.el: Enable finding entries by "host/username".
+ * test/lisp/auth-source-pass-tests.el: Adjust tests to check it.
+
+2017-04-27 Damien Cassou <damien@cassou.me>
+
+ Integrate auth-source with password-store
+
+ * lisp/auth-source-pass.el: auth-source backend for password-store.
+ * test/lisp/auth-source-pass-tests.el: Tests for auth-source-pass
+ behavior.
+
+2017-04-27 Damien Cassou <damien@cassou.me>
+
+ * lisp/auth-source.el: Document parser functions.
+
+2017-04-27 Ted Zlatanov <tzz@lifelogs.com>
+
+ auth-source: factor out parsers and add tests
+
+ * lisp/auth-source.el: Factor out the source parsers. Clean up comments.
+ * test/lisp/auth-source-tests.el: Add tests.
+
+2017-04-27 Martin Rudalics <rudalics@gmx.at>
+
+ Fix doc and customization type of `window-combination-limit' (Bug#26673)
+
+ * src/window.c (Vwindow_combination_limit): Fix doc-string.
+ * lisp/cus-start.el (window-combination-limit): Fix
+ customization type.
+ * doc/lispref/windows.texi (Recombining Windows): Fix
+ documentation of `window-combination-limit'.
+
+2017-04-27 Tino Calancha <tino.calancha@gmail.com>
+
+ Drop face from hi-lock--unused-faces only when used
+
+ * lisp/hi-lock.el (hi-lock-set-pattern): If REGEXP is already
+ highlighted, then push FACE into hi-lock--unused-faces (Bug#26666).
+ * test/lisp/hi-lock-tests.el (hi-lock-bug26666): Add test.
+
+2017-04-26 Alan Third <alan@idiocy.org>
+
+ Fix macOS version check (bug#26664)
+
+ * src/nsterm.m (initFrameFromEmacs): Prevent window tabbing mode on
+ macOS versions 10.12+.
+
+2017-04-26 Glenn Morris <rgm@gnu.org>
+
+ Make charprop.el provide a feature
+
+ * admin/unidata/unidata-gen.el (unidata-gen-charprop):
+ Provide a feature.
+ * lisp/loadup.el: Use the charprop feature.
+
+2017-04-26 Glenn Morris <rgm@gnu.org>
+
+ * lisp/loadup.el: Get charprop.el into etc/DOC again.
+
+2017-04-26 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/ido.el (ido-everywhere): Use add-function.
+
+2017-04-26 Martin Rudalics <rudalics@gmx.at>
+
+ Try to fix latest fix of w32_mouse_position
+
+ * src/w32term.c (w32_mouse_position): Fix a bug introduced by
+ latest fix and try to make the affected code more rigorous.
+
+2017-04-26 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid segfaults when 'find-font' is invoked for a TTY frame
+
+ * src/font.c (font_pixel_size): Don't call GUI functions if F is a
+ text-mode frame. (Bug#26646)
+
+2017-04-26 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp.el (tramp-set-connection-local-variables-for-buffer):
+
+ New defun.
+
+2017-04-26 Glenn Morris <rgm@gnu.org>
+
+ * src/Makefile.in (leimdir): Remove variable, no longer used.
+
+2017-04-26 Glenn Morris <rgm@gnu.org>
+
+ Generate leim-list via lisp/Makefile, not src/Makefile
+
+ * src/Makefile.in ($(leimdir)/leim-list.el): Remove rule.
+ (emacs$(EXEEXT)): Don't depend on leim-list.
+ * lisp/Makefile.in ($(lisp)/loaddefs.el): Depend on gen-lisp again.
+
+2017-04-25 Alan Third <alan@idiocy.org>
+
+ Fix define for GNUstep builds
+
+ * src/nsterm.m (initFrameFromEmacs): Fix the ifdef so that GNUstep
+ doesn't see the code.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Suppress intermittent test failure on hydra
+
+ * test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+ (eieio-test-method-order-list-6): Skip on hydra.
+
+2017-04-25 Alan Third <alan@idiocy.org>
+
+ Fix some NS frame handling issues
+
+ * src/nsterm.m (FRAME_DECORATED_FLAGS, FRAME_UNDECORATED_FLAGS): New
+ defines intended to make things tidier.
+ (x_set_undecorated): Use the new defines.
+ (windowWillResize): Don't use new macOS 12+ only feature.
+ (initFrameFromEmacs): Use the new defines, and disable automatic
+ window tabbing feature in macOS 12.
+ (x_set_undecorated, x_set_parent_frame, x_set_no_accept_focus,
+ x_set_z_group): Add NSTRACE notices.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Avoid parallel race condition
+
+ * lisp/Makefile.in ($(lisp)/loaddefs.el): Remove gen-lisp for now.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Generate each unicode lisp file independently
+
+ This is better for parallel builds, eg it eliminates race
+ conditions from having one process write multiple files.
+ * admin/unidata/Makefile.in (lparen, unifiles): New variables.
+ Parse unidata-gen.el, not charprop.el, to get the list of uni- files.
+ (all): Explicitly list the output lisp files.
+ (PHONY_EXTRAS): Remove.
+ (${unidir}/charprop.el): Change rule to just be for this file.
+ (${unifiles}): New rule to write each unicode lisp file.
+ (extraclean): Simplify.
+ * admin/unidata/unidata-gen.el (unidata-gen-charprop):
+ Quieten in batch mode.
+ (unidata-gen-files): Remove, no longer used.
+ * lisp/loadup.el: Update command-line parser.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Further refactoring in unidata-gen.el
+
+ * admin/unidata/unidata-gen.el (unidata-gen-charprop):
+ New function, split from unidata-gen-files.
+ (unidata-gen-files): Use unidata-gen-charprop.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Allow unidata-gen-file to work independently
+
+ * admin/unidata/unidata-gen.el (unidata-gen-file):
+ Make it work as a stand-alone function in batch mode.
+ (unidata-gen-files): Pass extra arguments to unidata-gen-file.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Preparatory refactoring in unidata-gen.el
+
+ * admin/unidata/unidata-gen.el (unidata-gen-file):
+ New function, split from unidata-gen-files.
+ (unidata-gen-files): Use unidata-gen-file.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Write each generated character property lisp file only once
+
+ * admin/unidata/unidata-gen.el (unidata-file-alist):
+ Rename from unidata-prop-alist. All users changed.
+ Use file name rather than property name as the key.
+ (unidata-prop-prop): New function.
+ (unidata-prop-index, unidata-prop-generator, unidata-prop-docstring)
+ (unidata-prop-describer, unidata-prop-default, unidata-prop-val-list):
+ Change to parse the argument rather than unidata-prop-alist.
+ (unidata-gen-table-character, unidata-gen-table)
+ (unidata-gen-table-symbol, unidata-gen-table-integer)
+ (unidata-gen-table-numeric, unidata-gen-table-word-list)
+ (unidata-gen-table-name, unidata-gen-table-decomposition)
+ (unidata-gen-table-special-casing): Pass index as an argument.
+ (unidata-check): Adapt to unidata-file-alist.
+ Pass index to generator functions.
+ (unidata-gen-files): Adapt to unidata-file-alist.
+ Write each output file once only. Overwrite rather than delete.
+
+2017-04-25 Andrew G Cohen <cohen@andy.bu.edu>
+
+ Fix requesting sparse articles in gnus
+
+ * lisp/gnus/gnus-art.el (gnus-request-article-this-buffer): Delete the
+ sparse article number from the list, not its id.
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Don't advertise s_client in tls.el docs
+
+ * lisp/net/tls.el (tls-end-of-info, tls-success, tls-untrusted):
+ Don't mention s_client in docs.
+
+2017-04-25 Rob Browning <rlb@defaultvalue.org>
+
+ Remove s_client usage from tls.el
+
+ * lisp/net/tls.el (tls-program, tls-checktrust): Remove s_client.
+ Ref http://bugs.debian.org/766397
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00803.html
+
+2017-04-25 Glenn Morris <rgm@gnu.org>
+
+ Further robustify cedet bootstrap to loaddefs not yet built
+
+ * lisp/cedet/semantic/util.el (semantic-something-to-tag-table):
+ Avoid void-function error when bootstrapping and semantic/loaddefs.el
+ does not yet exist.
+
+2017-04-24 Alan Third <alan@idiocy.org>
+
+ Fix XBM colour rendering in NS port (bug#22060)
+
+ src/nsimage.m (setXBMColor): Fix calculation of xbm_fg.
+
+2017-04-24 Vibhav Pant <vibhavp@gmail.com>
+
+ Add support for IRCv3 message tags.
+
+ * lisp/erc/erc-backend.el:
+ erc-response: Add `tags' element.
+ Add (erc-parse-tags).
+ (erc-parse-server-response): Use (erc-parse-tags) to parse message
+ tags (if any), and store them in `erc-resopnse' struct.
+
+ * lisp/erc/erc.el: (erc-display-message): Expose message tags with text
+ properties of the corresponding message line.
+
+2017-04-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Add image sizing tests for an image that's narrow
+
+ Needlessly refactor tests for clarity
+
+2017-04-23 Philipp Stephani <phst@google.com>
+
+ Add missing remappings for Ido mode
+
+ Among others, add a remapping for C-x 4 d, cf. Bug#26360.
+
+ * lisp/ido.el (ido-mode): Remap missing commands.
+ (ido-file-internal, ido-visit-buffer): Add support for new
+ methods.
+ (ido-display-buffer-other-frame)
+ (ido-find-alternate-file-other-window, ido-dired-other-window)
+ (ido-dired-other-frame): New commands.
+
+ * test/lisp/ido-tests.el (ido-tests--other-window-frame): Add unit
+ test for the bindings.
+
+2017-04-23 Martin Rudalics <rudalics@gmx.at>
+
+ Let w32_mouse_position pick a child window only if it has a child frame
+
+ * src/w32term.c (w32_mouse_position): When using a frame found
+ by ChildWindowFromPoint make sure it's a child frame (Bug#26615,
+ maybe).
+
+2017-04-23 Noam Postavsky <npostavs@gmail.com>
+
+ Don't require bytecomp for running ert tests
+
+ "Fix ert-tests when running compiled" 2016-12-06 accidentally
+ introduced a dependency on `bytecomp' into `ert'. As mentioned in
+ "Avoid ert test failures" 2017-04-18, the accidental dependency of ert
+ on bytecomp was masked by loading other libraries until recently.
+
+ * lisp/emacs-lisp/ert.el (ert--expand-should-1): Only use
+ `byte-compile-macro-environment' if it's bound.
+ * test/src/eval-tests.el: Add defvar for dynamic variable
+ `byte-compile-debug'.
+
+2017-04-23 Andrew G Cohen <cohen@andy.bu.edu>
+
+ Eliminate unneeded warp-to-article in gnus article referral
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-refer-thread):
+ (gnus-summary-refer-article): Remove gnus-warp-to article call.
+
+2017-04-23 Andrew G Cohen <cohen@andy.bu.edu>
+
+ Allow limiting gnus summary buffers to a thread
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-limit-include-thread): Include
+ an optional argument to allow limiting the summary buffer to just the
+ thread-related articles.
+ (gnus-refer-thread-limit-to-thread): Introduce customizable variable
+ to control whether thread-referral adds the thread to the summary
+ buffer or limits to just the thread.
+ (gnus-summary-refer-thread): Use the new variable.
+
+2017-04-23 Andrew G Cohen <cohen@andy.bu.edu>
+
+ Correct gnus-newsgroup-limits in gnus when including thread
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-limit-include-thread): Should
+ only add one list of thread-related articles to gnus-newsgroup-limits
+ rather than two.
+
+2017-04-23 Andrew G Cohen <cohen@andy.bu.edu>
+
+ Improve gnus thread matching of similar subjects
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-limit-include-thread):
+ Use the more liberal gnus-general-simplify-subject regexp to
+ find thread articles with similar subjects.
+
+2017-04-22 Noam Postavsky <npostavs@gmail.com>
+
+ Add new `lisp-indent-region' that doesn't reparse the code.
+
+ Both `lisp-indent-region' and `lisp-indent-line' now use `syntax-ppss'
+ to get initial state, so they will no longer indent string literal
+ contents.
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-ppss): New function, like
+ `syntax-ppss', but with a more dependable item 2.
+ (lisp-indent-region): New function, like `indent-region-line-by-line'
+ but additionally keep a running parse state to avoid reparsing the
+ code repeatedly. Use `lisp-ppss' to get initial state.
+ (lisp-indent-line): Take optional PARSE-STATE argument, pass it to
+ `calculate-lisp-indent', use `lisp-ppss' if not given.
+ (lisp-mode-variables): Set `indent-region-function' to
+ `lisp-indent-region'.
+
+2017-04-22 Noam Postavsky <npostavs@gmail.com>
+
+ Remove ignored argument from lisp-indent-line
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-indent-line): Remove WHOLE-EXP
+ argument, the behavior has long since been handled in
+ `indent-for-tab-command'. Also remove redundant `beg' and `shift-amt'
+ variables and use `indent-line-to'.
+
+2017-04-22 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Clean up marker.
+
+2017-04-22 Noam Postavsky <npostavs@gmail.com>
+
+ Don't reparse the sexp in indent-sexp (Bug#25122)
+
+ * lisp/emacs-lisp/lisp-mode.el (calculate-lisp-indent): Let
+ PARSE-START be a parse state that can be reused.
+ (indent-sexp): Pass the running parse state to calculate-lisp-indent
+ instead of the sexp beginning position. Saving the
+ CONTAINING-SEXP-START returned by `calculate-lisp-indent' is no longer
+ needed. Don't bother stopping if we don't descend below init-depth,
+ since we now alway scan the whole buffer (via syntax-ppss) anyway.
+ * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp): Add blank
+ line to test case.
+
+2017-04-22 Vibhav Pant <vibhavp@gmail.com>
+
+ Add cond test cases for singleton clauses.
+
+ * test/lisp/emacs-lisp/bytecomp-tests.el: Add test cond forms where
+ the default clause is a single non-nil expression.
+
+2017-04-22 Vibhav Pant <vibhavp@gmail.com>
+
+ b-c--cond-jump-table-info: Use correct body for singleton clauses
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table-info):
+ When a clause's body consists of a single constant expression, use
+ that expression as the body to be compiled. This fixes switch bytecode
+ evaluating to nil to such clauses.
+
+2017-04-22 Philipp Stephani <phst@google.com>
+
+ ffap: Don't switch window unless needed
+
+ When using ffap-other-window, don't change the window configuration
+ unless a new buffer has actually been created (Bug#25352).
+
+ * lisp/ffap.el (ffap-other-frame): Don't change the window
+ configuration if no new buffer has been created.
+ * test/lisp/ffap-tests.el (ffap-other-window--bug-25352): Add unit
+ test.
+
+2017-04-22 Alan Mackenzie <acm@muc.de>
+
+ Fix fontification of C++ declaration with type FOO::FOO.
+
+ * lisp/progmodes/cc-engine.el (c-find-decl-spots): Initialize
+ cfd-top-level properly.
+ (c-forward-decl-or-cast-1): On finding FOO::FOO, check it is followed by "("
+ before deciding it is a constructor.
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-complex-decl-prepare): Negate the
+ result of the c-bs-at-toplevel-p call passed to c-font-lock-declarators
+ (simple bug fix).
+
+2017-04-22 Philipp Stephani <phst@google.com>
+
+ Fix usage of FRAME_Z_GROUP
+
+ * src/nsterm.m (initFrameFromEmacs:): FRAME_Z_GROUP does not return a
+ Lisp object, cf. Bug#26597.
+
+2017-04-22 Alan Third <alan@idiocy.org>
+
+ Fix GNUstep build
+
+ * src/nsfns.m (Fns_frame_z_list_order): Rewrite for GNUstep
+ compatibility.
+ * src/nsmenu.m (update_frame_tool_bar): Remove unused variable.
+
+2017-04-21 Alan Third <alan@idiocy.org>
+
+ Add no-accept-focus and frame-list-z-order to NS port
+
+ * lisp/frame.el (frame-list-z-order): Add NS.
+ * src/nsfns.m: Add x_set_no_accept_focus to handler struct.
+ (Fx_create_frame): Handle no-accept-focus parameter.
+ (ns_window_is_ancestor):
+ (Fns_frame_list_z_order): New functions.
+ * src/nsterm.m (x_set_no_accept_focus): New function.
+ (initFrameFromEmacs): Use EmacsWindow instead of EmacsFSWindow for
+ non-fullscreen windows.
+ (EmacsWindow:canBecomeKeyWindow): New function.
+
+2017-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Improve prefix handling for dash.el
+
+ * lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload):
+ Don't drop dash's "-<letter>" prefixes.
+
+2017-04-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-macs.el: Fix symbol-macrolet
+
+ Revert 0d112c00ba0ec14bd3014efcd3430b9ddcfe1fc1 (to fix bug#26325)
+ and use a different fix for bug#26068.
+ (cl--symbol-macro-key): New function.
+ (cl--sm-macroexpand, cl-symbol-macrolet): Use it instead of `symbol-name`.
+ * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-symbol-macrolet):
+ Failure is not expected any more.
+
+2017-04-21 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid infinite loop in redisplay when header-line-format is invalid
+
+ * src/xdisp.c (handle_invisible_prop): Avoid inflooping when the
+ string has an invalid %-construct in it and is displayed as part
+ of mode-line or header-line. (Bug#26586)
+
+2017-04-21 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Add tests to check image scaling functionality
+
+ This is in preparation to doing further work in this area to avoid
+ regressions.
+
+ * test/data/image/blank-200x100.png: New file for testing
+ image scaling.
+
+ * test/manual/image-size-tests.el: New file.
+
+2017-04-21 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Allow svg-image to take all create-image PROPS
+
+ * lisp/svg.el (svg-image): Allow passing in PROPS when
+ creating an image for convenience.
+
+2017-04-21 George D. Plymale II <georgedp@orbitalimpact.com> (tiny change)
+
+ Treat non-erroring lisp call as successful eshell command (Bug#26161)
+
+ This lets a compound command like 'cd .. && echo ok' print 'ok',
+ similar to how most other shells behave.
+
+ * lisp/eshell/esh-cmd.el (eshell-exit-success-p): Only check if the
+ last exit code was zero, rather than first checking whether the last
+ command returned nil.
+ (eshell-exec-lisp): Set `eshell-last-command-status' to 1 on error.
+
+2017-04-21 Reuben Thomas <rrt@sc3d.org>
+
+ Fix reading of tab settings in whitespace-mode
+
+ lisp/whitespace.el (whitespace-indent-tabs-mode)
+ whitespace-tab-width): Remove these variables. The underlying
+ variables `indent-tabs-mode' and `tab-width' are already buffer-local
+ when needed, and whitespace-mode never changes them.
+ (whitespace-ensure-local-variables): Remove this function, which only
+ existed to set the above variables.
+ (whitespace-cleanup-region, whitespace-regexp)
+ (whitespace-indentation-regexp, whitespace-report-region)
+ (whitespace-turn-on, whitespace-color-on): Adjust these functions to
+ use `indent-tabs-mode' and `tab-width' directly, and not call
+ `whitespace-ensure-local-variables'.
+
+2017-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/vc/vc-hg.el (vc-hg-state-fast): Fix compiler warning
+
+ by simplifying ascii-test.
+
+2017-04-20 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecomp: Don't inline functions that use byte-switch (Bug#26518)
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Don't inline
+ FORM if the bytecode uses the byte-switch instruction. It is
+ impossible to guess the correct stack depth while inlining such
+ bytecode, resulting in faulty code.
+
+2017-04-20 Nicolas Petton <nicolas@petton.fr>
+
+ Set Emacs version to 25.2 and update AUTHORS file
+
+ * README: Set Emacs version to 25.2.
+ * etc/HISTORY: Add release log.
+ * lisp/ldefs-boot.el:
+ * etc/AUTHORS:
+ * ChangeLog.2: Update.
+
+2017-04-20 Noam Postavsky <npostavs@gmail.com>
+
+ Don't register "def" as an autoload prefix (Bug#26412)
+
+ * lisp/emacs-lisp/autoload.el (autoload--make-defs-autoload): Don't
+ accept "def" as a prefix.
+
+2017-04-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use substring completion for Info menus and index
+
+ * lisp/info.el (Info-complete-menu-item): Add `category' metadata.
+ (Info-menu): Simplify now that we use the `default' arg of completing-read.
+ * lisp/minibuffer.el (completion-category-defaults): Use substring
+ completion for `info-menu`.
+
+2017-04-19 Glenn Morris <rgm@gnu.org>
+
+ Remove some explicit runtime loads of pcase
+
+ Pcase is macros, so these should have used eval-when-compile.
+ Anyway, pcase entry points are autoloaded, so the compiler handles it.
+ * lisp/profiler.el, lisp/emacs-lisp/eieio-core.el:
+ * lisp/emacs-lisp/generator.el, lisp/emacs-lisp/subr-x.el:
+ * lisp/progmodes/xref.el: No need to require pcase.
+
+2017-04-19 Glenn Morris <rgm@gnu.org>
+
+ Stop cl-lib loading pcase at runtime
+
+ The cause was an unexpanded pcase-defmacro in cl-loaddefs.
+ * lisp/emacs-lisp/autoload.el (make-autoload):
+ Treat pcase-defmacro like defmacro.
+
+2017-04-19 Alan Third <alan@idiocy.org>
+
+ Note frame documentation exceptions for NS builds
+
+ * doc/lispref/frames.texi (Management Parameters, Child Frames): Note
+ NS differences.
+
+2017-04-19 Alan Third <alan@idiocy.org>
+
+ Fix bug introduced by my last commit
+
+ * src/nsterm.m (ns_draw_fringe_bitmap): Revert key-mashing accident.
+
+2017-04-19 Alan Third <alan@idiocy.org>
+
+ Add new frame functionality to NS port
+
+ * lisp/frame.el (frame-restack): Call ns-frame-restack.
+ * src/keyboard.c (kbd_buffer_get_event) [HAVE_NS]: Enable
+ MOVE_FRAME_EVENT handling.
+ * src/frame.h:
+ * src/frame.c: Enable 'z-group', 'undecorated' and 'parent' frame
+ definitions.
+ * src/nsfns.m: Add x_set_z_group, x_set_parent_frame and
+ x_set_undecorated (Cocoa only) to handler struct.
+ (Fx_create_frame): Handle 'z-group', 'parent-frame' and 'undecorated'
+ frame parameter.
+ (Fns_frame_restack): New function.
+ * src/nsmenu.m (free_frame_tool_bar, update_frame_tool_bar):
+ FRAME_TOOLBAR_HEIGHT is no longer a variable.
+ * src/nsterm.h (NS_PARENT_WINDOW_LEFT_POS, NS_PARENT_WINDOW_TOP_POS):
+ Add #defines to find the screen position of the parent frame.
+ (NS_TOP_POS): Remove defun.
+ (EmacsView): Remove redundant toolbar variables and add createToolbar
+ method.
+ (FRAME_NS_TITLEBAR_HEIGHT, FRAME_TOOLBAR_HEIGHT): Always calculate the
+ values instead of storing them in a variable.
+ * src/nsterm.m (x_set_offset, windowDidMove): Take parent frame
+ position into account when positioning frames.
+ (initFrameFromEmacs): Remove toolbar creation code and handle new
+ frame parameters.
+ (x_set_window_size): Remove toolbar height calculation.
+ (x_set_z_group):
+ (x_set_parent_frame):
+ (x_set_undecorated) [NS_IMPL_COCOA]: New function.
+ (x_destroy_window): Detach parent if child closes.
+ (updateFrameSize): Change NSTRACE message to reflect new reality and
+ no longer reset frame size.
+ (windowWillResize): Don’t change NS window name when the titlebar
+ is invisible.
+ (createToolbar): Move toolbar creation code into it’s own method.
+ (toggleFullScreen): FRAME_TOOLBAR_HEIGHT and FRAME_NS_TITLEBAR_HEIGHT
+ are no longer variables.
+ (windowDidMove): Fire MOVE_FRAME_EVENT Emacs event.
+
+2017-04-19 Glenn Morris <rgm@gnu.org>
+
+ Tweak bytecomp's loading of cl-extra
+
+ * lisp/emacs-lisp/bytecomp.el: Don't force load of cl-extra in a
+ post-bootstrap emacs where cl-loaddefs does exist.
+
+2017-04-19 Glenn Morris <rgm@gnu.org>
+
+ Avoid unnecessary loading of subr-x at run-time
+
+ * lisp/doc-view.el, lisp/filenotify.el, lisp/info-look.el:
+ * lisp/svg.el, lisp/emacs-lisp/byte-opt.el, lisp/net/shr.el:
+ * lisp/textmodes/sgml-mode.el, test/lisp/dom-tests.el:
+ No need to load subr-x at run-time.
+ * lisp/gnus/nnheader.el: No need to load subr-x.
+
+2017-04-18 michael schuldt <mbschuldt@gmail.com> (tiny change)
+
+ Use iteration in math-factorial-iter
+
+ * lisp/calc/calc-comb.el (math-factorial-iter):
+ Use iteration instead of recursion to avoid max-specpdl-size problem.
+
+2017-04-18 Glenn Morris <rgm@gnu.org>
+
+ * test/lisp/kmacro-tests.el: Require seq, for seq-concatenate.
+
+2017-04-18 Glenn Morris <rgm@gnu.org>
+
+ Avoid ert test failures
+
+ * lisp/emacs-lisp/ert.el (ert--expand-should-1):
+ Avoid errors related to undefined byte-compile-macro-environment.
+ Somehow masked until very recently because loading seq (eg)
+ loads bytecomp. http://hydra.nixos.org/build/51730765
+
+2017-04-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a typo in indexing the user manual
+
+ * doc/emacs/cmdargs.texi (General Variables): Fix a horrible typo.
+
+2017-04-18 Noam Postavsky <npostavs@gmail.com>
+
+ Fix find-library-name for load-history entries with nil FILE-NAME (Bug#26355)
+
+ * lisp/emacs-lisp/find-func.el (find-library--from-load-history):
+ Rename from find-library--from-load-path. Check for `load-history'
+ entries with nil FILE-NAMEs. Simplify by not double
+ checking for suffixes and making use of `locate-file'.
+
+2017-04-18 Alan Third <alan@idiocy.org>
+ YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ Use vfork if possible on Darwin (bug#26397)
+
+
+ * src/conf_post.h (HAVE_WORKING_VFORK): Don't undef.
+ (vfork): Don't define.
+ * src/process.c (create_process) [DARWIN_OS]: Use fork if pty_flag is
+ set, otherwise vfork.
+ * src/callproc.c (call_process) [DARWIN_OS]: Use TIOCNOTTY to detach
+ the controlling terminal instead of setsid.
+
+2017-04-18 Fran Litterio <flitterio@gmail.com>
+
+ Small erc-kill-channel fix (bug#23700)
+
+ * lisp/erc/erc.el (erc-kill-channel): Handle null erc-default-target.
+
+2017-04-18 Glenn Morris <rgm@gnu.org>
+
+ ediff: use user-error rather than debug-ignored-errors
+
+ * lisp/vc/ediff-diff.el (ediff-prepare-error-list):
+ * lisp/vc/ediff-help.el (ediff-help-for-quick-help):
+ * lisp/vc/ediff-init.el (ediff-barf-if-not-control-buffer)
+ (ediff-check-version):
+ * lisp/vc/ediff-merg.el (ediff-shrink-window-C):
+ * lisp/vc/ediff-mult.el (ediff-draw-dir-diffs, ediff-show-dir-diffs)
+ (ediff-append-custom-diff, ediff-meta-show-patch)
+ (ediff-filegroup-action, ediff-show-meta-buffer, ediff-show-registry)
+ (ediff-get-meta-info, ediff-patch-file-form-meta):
+ * lisp/vc/ediff-ptch.el (ediff-patch-file-internal):
+ * lisp/vc/ediff-util.el (ediff-toggle-autorefine)
+ (ediff--check-ancestor-exists, ediff-toggle-read-only)
+ (ediff-toggle-wide-display, ediff-toggle-multiframe)
+ (ediff-toggle-use-toolbar, ediff-toggle-show-clashes-only)
+ (ediff-next-difference, ediff-previous-difference)
+ (ediff-pop-diff, ediff-read-file-name, ediff-verify-file-buffer)
+ (ediff-save-buffer):
+ * lisp/vc/ediff-wind.el (ediff-make-wide-display):
+ * lisp/vc/ediff.el (ediff-find-file, ediff-buffers-internal)
+ (ediff-directories-internal, ediff-directory-revisions-internal)
+ (ediff-regions-wordwise, ediff-regions-linewise)
+ (ediff-load-version-control): Use user-error.
+ (debug-ignored-errors): No longer modify.
+
+2017-04-18 Glenn Morris <rgm@gnu.org>
+
+ mh-e: use user-error rather than debug-ignored-errors
+
+ * lisp/mh-e/mh-alias.el (mh-alias-grab-from-field):
+ * lisp/mh-e/mh-utils.el (mh-get-msg-num): Use user-error.
+ (debug-ignored-errors): No longer modify.
+
+2017-04-18 Glenn Morris <rgm@gnu.org>
+
+ ispell.el: use user-error rather than debug-ignored-errors
+
+ * lisp/textmodes/ispell.el (ispell-get-word): Use user-error.
+ (debug-ignored-errors): No longer modify.
+
+2017-04-17 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ * src/xterm.c (x_fill_rectangle): Now static.
+
+2017-04-17 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ Tighten recently-added UTF-8 check
+
+ * src/coding.c (encode_coding_utf_8): Now extern.
+ * src/terminal.c (terminal_glyph_code) [HAVE_STRUCT_UNIPAIR_UNICODE]:
+ Check for UTF-8, not just for multibyte.
+
+2017-04-17 David Engster <deng@randomsample.de>
+
+ xml: Properly handle symbol-qnames for attribute parsing
+
+ * lisp/xml.el (xml-parse-attlist): Do not strip 'symbol-qnames from
+ xml-ns argument (reverts aea67018) (Bug#26533).
+ (xml-maybe-do-ns): Properly handle default namespace by not
+ interning new symbol when 'special' flag is set.
+
+ * test/lisp/xml-tests.el (xml-parse-test--namespace-attribute-qnames)
+ (xml-parse-namespace-attribute-qnames): Add test for Bug#26533.
+
+2017-04-17 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ * src/lisp.h (STRING_SET_CHARS): Simplify assertion.
+
+2017-04-17 Eli Zaretskii <eliz@gnu.org>
+
+ Fix assertion violations when displaying thread-related error
+
+ * src/process.c (Faccept_process_output): Don't assume a thread's
+ name is always a string.
+
+2017-04-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ dired ‘M’ should not complain about ‘.’ and ‘..’
+
+ * lisp/dired-aux.el (dired-do-redisplay):
+ Allow redisplay of ‘.’ and ‘..’ (Bug#26528).
+
+2017-04-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unused coding enums
+
+ * src/coding.h (enum coding_system_type, enum end_of_line_type):
+ Remove; unused.
+
+2017-04-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Work around bug with unibyte Linux consoles
+
+ * src/terminal.c (terminal_glyph_code): Skip the UTF-8 stuff if
+ the terminal's coding system is unibyte (Bug#26396).
+
+2017-04-16 Teemu Likonen <tlikonen@iki.fi>
+
+ Fix org-agenda's command for calendar-lunar-phases
+
+ Function org-agenda-phases-of-moon tries to call a non-existing
+ function calendar-phases-of-moon. The correct function is
+ calendar-lunar-phases.
+
+2017-04-16 Michael Albinus <michael.albinus@gmx.de>
+
+ Tuning for `separate' Tramp syntax
+
+ * lisp/net/tramp.el (tramp-method-regexp): Fix it for `separate' syntax.
+ (tramp-completion-file-name-regexp-separate): Simplify.
+
+ * test/lisp/net/tramp-tests.el (tramp-test02-file-name-dissect-separate):
+ Extend test.
+
+2017-04-16 Alan Mackenzie <acm@muc.de>
+
+ Fix bug #26529: C-h k errors with a lambda function bound to a key.
+
+ * lisp/help-fns.el (help-fns--signature, describe-function-1): Check
+ `function' is a symbol before trying to get property `reader-construct' from
+ it.
+
+2017-04-16 Simen Heggestøyl <simenheg@gmail.com>
+
+ Fix highlighting of short selectors in CSS mode
+
+ * lisp/textmodes/css-mode.el (css--font-lock-keywords): Highlight
+ selectors where the part before a colon is only one character long,
+ such as `a:hover'.
+
+2017-04-16 Eli Zaretskii <eliz@gnu.org>
+
+ Fix redisplay performance problems with some fonts
+
+ * src/font.c (font_list_entities): Revert part of the changes
+ introduced on Apr 2, 2014 to fix bug#17125. It turns out having
+ zero_vector in the font-cache is an important indication that
+ cannot be removed. (Bug#21028)
+
+2017-04-16 Eli Zaretskii <eliz@gnu.org>
+
+ Add assertion to STRING_SET_CHARS
+
+ * src/lisp.h (STRING_SET_CHARS): Add an assertion and commentary
+ to prevent incorrect usage. For details, see this discussion:
+ https://lists.gnu.org/r/emacs-devel/2017-04/msg00412.html.
+
+2017-04-16 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid compilation warnings on MS-Windows
+
+ * src/w32term.c (w32_read_socket): Avoid compiler warnings about
+ parentheses around assignment.
+ * src/w32fns.c (w32_createwindow): Remove unused variable
+ dwStyle. Use "|=" where appropriate.
+
+2017-04-16 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-04-14 intprops: try to avoid tickling similar bugs
+ 2017-04-14 intprops: port to Oracle Studio 12.3 x86
+ * doc/misc/texinfo.tex, lib/intprops.h: Copy from gnulib.
+
+2017-04-15 Martin Rudalics <rudalics@gmx.at>
+
+ Fix bugs in `with-displayed-buffer-window' and `fit-window-to-buffer'
+
+ * lisp/window.el (with-displayed-buffer-window): When a
+ 'window-height' action alist entry specifies a function, call
+ `temp-buffer-window-show' with a '(window-height . t)' dummy
+ entry so `window--try-to-split-window' will bind
+ `window-combination-limit' to t and that function does not
+ resize any other window but the one we split this one off
+ (Bug#25055, Bug#25179).
+ (fit-window-to-buffer): Call `window-max-delta' with NOUP t so
+ we steal space only from windows in the same combination.
+ Stealing space from other windows would not allow us to return
+ that space later when this window is deleted (Bug#25055,
+ Bug#25179).
+
+2017-04-15 Glenn Morris <rgm@gnu.org>
+
+ Avoid userlock queries hanging forever in batch mode
+
+ * lisp/userlock.el (ask-user-about-lock)
+ (ask-user-about-supersession-threat): Abort in batch mode.
+
+2017-04-14 Martin Rudalics <rudalics@gmx.at>
+
+ Fix segfault when calling frame_ancestor_p (Bug#26493)
+
+ * src/xterm.c (handle_one_xevent): Check that hf was not reset
+ before calling frame_ancestor_p (Bug#26493).
+
+2017-04-14 Martin Rudalics <rudalics@gmx.at>
+
+ A few additional copy-edits in documentation of frames
+
+ * doc/lispref/frames.texi (Frame Layout)
+ (Implied Frame Resizing): Windows -> MS-Windows.
+ (Deleting Frames): Fix typo.
+
+2017-04-14 Glenn Morris <rgm@gnu.org>
+
+ Use user-error for some ert.el errors
+
+ * lisp/emacs-lisp/ert.el (ert-read-test-name, ert-delete-all-tests)
+ (ert-results-find-test-at-point-other-window, ert-describe-test):
+ Use user-error.
+
+2017-04-14 Glenn Morris <rgm@gnu.org>
+
+ Use user-error for customize's "invalid face" error
+
+ * lisp/cus-edit.el (customize-face): Use user-error.
+ (debug-ignored-errors): No more need to add "Invalid face".
+
+2017-04-14 Glenn Morris <rgm@gnu.org>
+
+ Remove duplicate lisp-eval-defun definition
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-eval-defun):
+ Autoload rather than defining a stub.
+
+2017-04-14 Glenn Morris <rgm@gnu.org>
+
+ * lisp/Makefile.in (check-defun-dups): Ignore obsolete files.
+
+2017-04-14 Glenn Morris <rgm@gnu.org>
+
+ Create generated lisp files before main loaddefs.el
+
+ This should improve reproducibility of lisp/loaddefs.el.
+ * lisp/Makefile.in (gen-lisp): New phony target.
+ ($(lisp)/loaddefs.el, compile-main): Depend on gen-lisp.
+ * src/Makefile.in ($(leimdir)/leim-list.el): Depend on all of ../leim.
+ * lisp/cedet/semantic.el (semantic-mode):
+ * lisp/cedet/semantic/fw.el (top-level):
+ * lisp/emacs-lisp/eieio-core.el (top-level):
+ Robustify to generated input files maybe not yet existing.
+
+2017-04-14 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ Fix minor quoting issues in Makefile.in
+
+ * Makefile.in (install-arch-dep, uninstall):
+ Quote EMACS and EMACS_NAME more consistently.
+
+2017-04-13 Glenn Morris <rgm@gnu.org>
+
+ * Makefile.in (install-etc): Use existing Makefile variables.
+
+2017-04-13 Eli Zaretskii <eliz@gnu.org>
+
+ Minor copyedits of recent changes in documentation
+
+ * doc/lispref/frames.texi (Frame Layout, Frame Position)
+ (Frame Size, Frame Interaction Parameters, Input Focus)
+ (Raising and Lowering, Child Frames): Improve wording and indexing.
+ * doc/emacs/cmdargs.texi (Borders X): Improve indexing.
+
+2017-04-13 Glenn Morris <rgm@gnu.org>
+
+ Small src/Makefile simplification
+
+ * src/Makefile.in ($(lispsource)/international/ucs-normalize.elc)
+ ($(lispsource)/term/ns-win.elc): Combine rules.
+
+2017-04-13 Simen Heggestøyl <simenheg@gmail.com>
+
+ Add grid layout module to CSS property list
+
+ * lisp/textmodes/css-mode.el (css-property-alist)
+ (css-value-class-alist): Add new properties and value classes from CSS
+ Grid Layout Module.
+
+2017-04-13 Martin Rudalics <rudalics@gmx.at>
+
+ Describe recent frame and window changes in manuals
+
+ * doc/emacs/emacs.texi (Top):
+ * doc/emacs/cmdargs.texi (Borders X): Clearly separate the terms
+ "outer border" (for the X border which can be set from within
+ Emacs) and "external border" (for the border which is added by
+ the window manager).
+ * doc/lispref/display.texi (Tooltips): Clarify slightly.
+ * doc/lispref/elisp.texi (Top): Update node and section names.
+ * doc/lispref/frames.texi (Frames): Describe difference between
+ top-level and child frames.
+ (Frame Layout): Describe outer border. Add more details about
+ how Emacs obtains the outer size and position of a frame and
+ about menu bar/tool bar wrapping. Add references to new frame
+ parameters.
+ (Size and Position): Remove subsection.
+ (Frame Position): New subsection excerpted from the earlier Size
+ and Position subsection. Clarify positioning concepts and
+ some of their shortcomings. Describe `move-frame-functions'.
+ (Frame Size): New subsection excerpted from the earlier Size
+ and Position subsection. Describe how to track frame size
+ changes and the new function `frame-size-changed-p'.
+ (Position Parameters): Describe child frame positioning. Warn
+ about negative offsets. Describe 'z-group' parameter.
+ (Size Parameters): Describe 'text-pixels' specification
+ facility and new 'min-width' and 'min-height' parameters.
+ (Layout Parameters): Clarify description of 'tool-bar-lines' and
+ 'menu-bar-lines' parameters.
+ (Frame Interaction Parameters): New subsubsection describing
+ 'parent-frame', 'delete-before', 'mouse-wheel-frame' and
+ 'no-other-frame' parameters.
+ (Management Parameters): Describe 'skip-taskbar',
+ 'no-focus-on-map', 'no-accept-focus', 'undecorated' and
+ 'override-redirect' parameters.
+ (Deleting Frames): Describe handling of 'delete-before'
+ parameter and child frames for `delete-frame' and
+ `delete-other-frames'.
+ (Finding All Frames): Describe `frame-list-z-order' and handling
+ of 'no-other-frame' parameter by `next-frame'.
+ (Minibuffers and Frames): Minor clarifications.
+ (Input Focus): Document `x-focus-frame'. Clarify descriptions
+ of `focus-in-hook', `focus-out-hook' and `focus-follows-mouse'.
+ (Visibility of Frames): Describe mapping and how the visibility
+ of a parent frame affects that of its child frames.
+ (Raising and Lowering): Describe restacking of frames and
+ z-groups.
+ (Child Frames): New section.
+ * doc/lispref/windows.texi (Selecting Windows): Describe
+ additional semantics of NORECORD argument of `select-window' and
+ how `buffer-list-update-hook' can emulate a "select window
+ hook".
+ (Mouse Window Auto-selection): New section.
+
+2017-04-13 Damien Cassou <damien@cassou.me>
+
+ Fix imenu--sort-by-position for non-pairs parameters (bug#26457)
+
+ * lisp/imenu.el (imenu--sort-by-position): Fix to accept lists beyond
+ pairs.
+ * test/lisp/imenu-tests.el: Add 2 tests for `imenu--sort-by-position`.
+
+2017-04-13 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid unnecessary regeneration of the entire loaddefs.el
+
+ * lisp/Makefile.in (autoloads .PHONY): Add commentary explaining
+ why $(lisp)/loaddefs.el is a dependency of '.PHONY'.
+ ($(lisp)/loaddefs.el): Copy an existing loaddefs.el to
+ loaddefs.tmp before running 'batch-update-autoloads' on it, to
+ avoid slow regeneration of the full contents. (Bug#26459)
+ Use 'move-if-change' instead of 'mv', to avoid producing a new
+ Emacs binary when not necessary.
+
+2017-04-13 Dmitry Gutov <dgutov@yandex.ru>
+
+ Handle indentation of nested ternary operators in JS
+
+ * lisp/progmodes/js.el (js--looking-at-operator-p):
+ Handle nested ternary operators.
+
+2017-04-12 Eli Zaretskii <eliz@gnu.org>
+
+ Don't call 'kill-this-buffer' outside of menus
+
+ * lisp/simple.el (kill-current-buffer): New function.
+ (completion-list-mode-map): Use it instead of kill-this-buffer.
+ * lisp/type-break.el (type-break-mode):
+ * lisp/term/ns-win.el (global-map):
+ * lisp/progmodes/gdb-mi.el (gdb-memory-mode-map)
+ (gdb-disassembly-mode-map, gdb-frames-mode-map)
+ (gdb-locals-mode-map, gdb-registers-mode-map):
+ * lisp/org/org-mhe.el (org-mhe-follow-link):
+ * lisp/net/secrets.el (secrets-mode-map):
+ * lisp/net/eudc.el (eudc-mode-map):
+ * lisp/net/eudc-hotlist.el (eudc-hotlist-mode-map): Use
+ kill-current-buffer instead of kill-this-buffer. (Bug#26466)
+
+2017-04-12 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/menu-bar.el (kill-this-buffer): Doc fix. (Bug#26466)
+
+2017-04-12 Martin Rudalics <rudalics@gmx.at>
+
+ New internal-border face and args for select-window and x-focus-frame
+
+ Add `internal-border' face and handle it whenever clearing the
+ internal border. If NORECORD equals the symbol
+ 'mark-for-redisplay', `select-window' will not record the window
+ but still mark it for redisplay. The new argument NOACTIVATE
+ for `x-focus-frame' tries to not activate FRAME when set.
+
+ * lisp/faces.el (internal-border): New face.
+ * lisp/mwheel.el (mwheel-scroll): Select window to scroll with
+ `mark-for-redisplay'.
+ * lisp/scroll-bar.el (scroll-bar-drag)
+ (scroll-bar-horizontal-drag, scroll-bar-scroll-down)
+ (scroll-bar-scroll-up, scroll-bar-toolkit-scroll)
+ (scroll-bar-toolkit-horizontal-scroll): Select window to scroll
+ with `mark-for-redisplay'.
+ * lisp/window.el (handle-select-window): When
+ `focus-follows-mouse' is not 'auto-raise' try to not activate
+ FRAME.
+ * src/dispextern.h (face_id): Add INTERNAL_BORDER_FACE_ID.
+ * src/frame.c (Fx_focus_frame): New argument NOACTIVATE.
+ * src/frame.h (x_focus_frame): Update extern declaration.
+ * src/gtkutil.c (xg_clear_under_internal_border): Remove
+ function.
+ (xg_frame_resized, xg_frame_set_char_size): Call
+ x_clear_under_internal_border.
+ (xg_tool_bar_callback): Adapt x_focus_frame call.
+ * src/gtkutil.h (xg_clear_under_internal_border): Remove
+ declaration.
+ * src/nsfns.m (x_focus_frame): Add argument NOACTIVATE.
+ * src/w32fns.c (x_clear_under_internal_border): Fill border
+ with internal-border background if specified.
+ * src/w32term.h (x_clear_under_internal_border): Add extern
+ declaration.
+ * src/w32term.c (x_after_update_window_line): Fill border
+ with internal-border background if specified.
+ (w32_set_vertical_scroll_bar, w32_set_horizontal_scroll_bar)
+ (x_scroll_bar_clear, w32_read_socket): Call
+ x_clear_under_internal_border.
+ (x_focus_frame): New argument NOACTIVATE.
+ * src/window.c (select_window): Mark WINDOW for redisplay when
+ NORECORD equals 'mark-for-redisplay'.
+ (Fselect_window): Update doc-string.
+ (syms_of_window): Define Qmark_for_redisplay.
+ * src/xdisp.c (clear_garbaged_frames, echo_area_display)
+ (redisplay_internal): Call x_clear_under_internal_border.
+ * src/xfaces.c (lookup_basic_face): Handle `window-divider'
+ and `internal-border' faces.
+ (realize_basic_faces): Realize `internal-border' face.
+ (syms_of_xfaces): Define Qinternal_border.
+ * src/xfns.c (x_set_internal_border_width): Remove call for
+ xg_clear_under_internal_border.
+ (x_focus_frame): New argument NOACTIVATE. When non-nil try to not
+ activate frame.
+ * src/xterm.c (x_fill_rectangle): No more static.
+ (x_clear_under_internal_border, x_after_update_window_line):
+ Fill border with internal-border background if specified.
+ (xt_horizontal_action_hook): Rewrite.
+ (handle_one_xevent): Call x_clear_under_internal_border.
+ * src/xterm.h (x_fill_rectangle): Add extern declaration.
+
+2017-04-12 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ Port recent frame changes to --enable-gcc-warnings
+
+ * src/frame.c (next_frame, prev_frame):
+ Remove now-redundant assertions.
+ * src/frame.h (FOR_EACH_FRAME): Assume Vframe_list is nonempty.
+
+2017-04-12 Tak Kunihiro <tkk@misasa.okayama-u.ac.jp>
+
+ Scroll right and left using wheel-right and wheel-left.
+
+ These changes also make use of touchpad and trackpad (Bug#26347).
+
+ * doc/emacs/frames.texi (Mouse Commands): Document horizontal
+ scrolling using the mouse wheel.
+
+ * lisp/mwheel.el (mwheel-scroll): Respond to wheel-right and wheel-left.
+ (mwheel-tilt-scroll-p, mwheel-flip-direction)
+ (mwheel-scroll-left-function, mwheel-scroll-right-function): New
+ defcustoms.
+ (mouse-wheel-left-event, mouse-wheel-right-event): New variables,
+ events that calls wheel-left/right.
+
+ * etc/NEWS: Mention horizontal scrolling using the mouse wheel.
+
+2017-04-12 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/Makefile.in (autoloads-force): Fix usage of ".PHONY".
+
+2017-04-12 Martin Rudalics <rudalics@gmx.at>
+
+ Add new frame parameters and associated functions
+
+ Add new frame parameters `undecorated', `override-redirect',
+ `parent-frame', `skip-taskbar', `no-focus-on-map',
+ `no-accept-focus', `z-group', `delete-before', `no-other-frame',
+ `mouse-wheel-frame', `min-width', `min-height'. Add new
+ functions `frame-restack' and `frame-list-z-order'.
+
+ * lisp/cus-start.el (focus-follows-mouse): Adapt customization
+ type.
+ * lisp/frame.el (handle-delete-frame): Handle child and
+ `delete-before' frames.
+ (other-frame): Stop looking for other frame after one round.
+ (frame-list-z-order, frame-restack): New functions.
+ (delete-other-frames): Handle child frames.
+ * lisp/frameset.el (frameset-persistent-filter-alist)
+ (frameset--record-relationships): Handle `delete-before',
+ `parent-frame' and `mouse-wheel-frame' parameters. Rename
+ latter from `frameset--record-minibuffer-relationships'.
+ (frameset--restore-frame): Handle ‘parent-frame’ parameter
+ specially.
+ (frameset-restore): Handle `delete-before', `parent-frame' and
+ `mouse-wheel-frame' parameters.
+ * lisp/mwheel.el (mwheel-scroll): Handle `mouse-wheel-frame'
+ parameter.
+ * lisp/window.el (window--min-size-ignore-p): Fix doc-string.
+ (mouse-autoselect-window-select, handle-select-window): Major
+ rewrite. Try to not ignore errors. Handle auto-selection of
+ child frames and different values of `focus-follows-mouse'.
+ * src/frame.c (frame_windows_min_size): Handle new `min-width'
+ and `min-height' frame parameters.
+ (make_frame): Initialize new frame structure members.
+ (do_switch_frame): Don't reset internal_last_event_frame for
+ descendant frames.
+ (Fframe_parent, frame_ancestor_p, Fframe_ancestor_p): New
+ functions.
+ (candidate_frame): Don't return `no-other-frame' frame.
+ (other_frames): New function replacing other_visible_frames.
+ (delete_frame): Rewrite. Handle child and `delete-before' frames.
+ (Fmake_frame_invisible): Call other_frames.
+ (store_frame_param): Check `delete-before' and `parent-frame'
+ parameters for circular dependencies.
+ (frame_parms, syms_of_frame): Add entries for and define new
+ frame parameters.
+ (focus_follows_mouse): New meaningful value `auto-raise'.
+ * src/frame.h (z_group): New enumeration type.
+ (frame): New slots parent_frame, undecorated, override_redirect,
+ skip_taskbar, no_focus_on_map, no_accept_focus, z_group.
+ (fset_parent_frame): New inlined function.
+ (FRAME_UNDECORATED, FRAME_OVERRIDE_REDIRECT)
+ (FRAME_PARENT_FRAME, FRAME_SKIP_TASKBAR, FRAME_NO_FOCUS_ON_MAP)
+ (FRAME_NO_ACCEPT_FOCUS, FRAME_Z_GROUP, FRAME_Z_GROUP_NONE)
+ (FRAME_Z_GROUP_ABOVE, FRAME_Z_GROUP_ABOVE_SUSPENDED)
+ (FRAME_Z_GROUP_BELOW): New macros.
+ (frame_ancestor_p): Add declaration.
+ * src/gtkutil.c (xg_create_frame_widgets): Handle
+ `undecorated' and `override-redirect' frame parameters.
+ (x_wm_set_size_hint): None for child frames.
+ (xg_set_undecorated, xg_frame_restack, xg_set_skip_taskbar)
+ (xg_set_no_focus_on_map, xg_set_no_accept_focus)
+ (xg_set_override_redirect): New functions.
+ (xg_update_scrollbar_pos, xg_update_horizontal_scrollbar_pos):
+ Don't let scrollbars obscure child frames.
+ * src/gtkutil.h: (xg_set_undecorated, xg_frame_restack)
+ (xg_set_skip_taskbar, xg_set_no_focus_on_map)
+ (xg_set_no_accept_focus, xg_set_override_redirect): Add extern
+ declarations.
+ * src/nsfns.m (ns_frame_parm_handlers): Add entries for new
+ frame parameters.
+ (Fx_create_frame): Install `min-width' and `min-height' frame
+ parameters.
+ * src/nsterm.m (mouseMoved:): Handle focus_follows_mouse change.
+ * src/w32fns.c (WS_EX_NOACTIVATE): Define if necessary.
+ (x_real_positions): Handle child frames.
+ (x_set_menu_bar_lines): Don't for child frames.
+ (x_set_undecorated, x_set_parent_frame, x_set_skip_taskbar)
+ (x_set_no_focus_on_map, x_set_no_accept_focus)
+ (x_set_z_group): New functions.
+ (w32_createvscrollbar, w32_createhscrollbar): Don't draw
+ scroll bars over child frames.
+ (w32_createwindow): Handle new frame parameters and child frames.
+ (w32_wnd_proc): Let mouse clicks into a child frame activate
+ the frame. Try to handle the `no-accept-focus' parameter. Do
+ SetFocus when our window is brought to top or becomes the
+ foreground window.
+ (w32_window): Don't initialize menu bar for child frames.
+ (Fx_create_frame): Handle new frame parameters.
+ (x_create_tip_frame): Set explicit_parent slot.
+ (w32_dialog_in_progress): New function.
+ (Fx_file_dialog): Handle `z-group-above' frames.
+ (w32_frame_list_z_order, Fw32_frame_list_z_order)
+ (w32_frame_restack, Fw32_frame_restack): New functions.
+ (w32_frame_parm_handlers): Add entries for new frame
+ parameters.
+ * src/w32font.c (Fx_select_font): Handle `z-group-above'
+ frames during font selection dialogue.
+ * src/w32term.c (construct_mouse_wheel): Construct mouse wheel
+ event from F's w32 window.
+ (w32_mouse_position): Handle child frames.
+ (w32_set_vertical_scroll_bar, w32_set_horizontal_scroll_bar):
+ Don't draw scroll bars over child frames.
+ (w32_read_socket): Always erase background of child frames.
+ When generating SELECT_WINDOW_EVENTs handle new value of
+ `focus-follows-mouse' and handle `no-accept-focus' parameter.
+ Handle `mouse-wheel-frame' parameter.
+ (x_calc_absolute_position, x_set_offset, x_set_window_size):
+ Handle child frames.
+ (x_make_frame_visible): Handle child frames specially. Handle
+ `no-focus-on-map' parameter.
+ * src/w32term.h (w32_dialog_in_progress): Add external
+ declaration.
+ * src/xdisp.c (x_consider_frame_title, prepare_menu_bars): Not
+ for child frames.
+ * src/xfns.c (Xm/MwmUtil.h): Include for WM hints.
+ (PropMotifWmHints, PROP_MOTIF_WM_HINTS_ELEMENTS): Define for
+ non-Motif, non-GTK case.
+ (x_real_pos_and_offsets): Handle child frames.
+ (x_set_undecorated, x_set_parent_frame)
+ (x_set_no_focus_on_map, x_set_no_accept_focus)
+ (x_set_override_redirect): New functions.
+ (x_set_menu_bar_lines): Not for child frames.
+ (x_window): Handle `undecorated' and `override_redirect' cases.
+ (Fx_create_frame): Handle new frame parameters.
+ (frame_geometry): Handle child frames and outer border.
+ (x_frame_list_z_order, Fx_frame_list_z_order)
+ (x_frame_restack, Fx_frame_restack): New functions.
+ (Fx_file_dialog, Fx_select_font): Set x_menu_set_in_use.
+ (x_frame_parm_handlers): Add entries for new frame parameters.
+ * src/xmenu.c (x_menu_set_in_use): Handle `z-group-above'
+ frames.
+ * src/xterm.c (x_set_frame_alpha): Don't set alpha of parent
+ for child frames.
+ (XTmouse_position): Handle child frames.
+ (x_scroll_bar_create, x_scroll_bar_expose): Don't let scroll
+ bars obscure child frames.
+ (handle_one_xevent): Handle child frame positions. If necessary
+ set `skip-taskbar' and reassign proper `z-group' when we are
+ mapped. When generating SELECT_WINDOW_EVENTs handle new value
+ of `focus-follows-mouse'. Handle `mouse-wheel-frame' parameter.
+ Let mouse clicks into a child frame activate the frame.
+ (x_calc_absolute_position, x_set_offset): Handle child frames
+ specially.
+ (x_set_skip_taskbar, x_set_z_group): New functions.
+ (x_make_frame_visible): Handle child frames.
+ (ATOM_REFS_INIT): Add entries for
+ Xatom_net_wm_state_skip_taskbar, Xatom_net_wm_state_above,
+ Xatom_net_wm_state_below.
+ * src/xterm.h (top-level): Declare Xatom_net_wm_state_above,
+ Xatom_net_wm_state_below and Xatom_net_wm_state_skip_taskbar.
+ (x_set_skip_taskbar, x_set_z_group): Add extern declarations.
+
+2017-04-11 Glenn Morris <rgm@gnu.org>
+
+ Update a package test for hydra
+
+ * test/lisp/emacs-lisp/package-tests.el (with-package-test):
+ Also bind package-gnupghome-dir, see eg
+ http://hydra.nixos.org/build/51462182 .
+
+2017-04-11 Martin Rudalics <rudalics@gmx.at>
+
+ Frame movement, focus and hook related changes
+
+ New hook `move-frame-functions'. Run `focus-in-hook'
+ after switching to frame that gets focus. Don't run
+ XMoveWindow for GTK.
+
+ * lisp/frame.el (handle-move-frame, frame-size-changed-p): New
+ functions.
+
+ * src/frame.c (do_switch_frame): Simplify code.
+ (Fhandle_switch_frame): Switch frame before running
+ `handle-focus-in'.
+ (Vfocus_in_hook, Vfocus_out_hook): Clarify doc-strings.
+ (Vmove_frame_functions): New hook variable.
+ * src/keyboard.c (kbd_buffer_get_event): Handle
+ MOVE_FRAME_EVENT. Handle SELECT_WINDOW_EVENT separately.
+ (head_table): Add Qmove_frame entry.
+ (syms_of_keyboard): Add Qmove_frame.
+ (keys_of_keyboard): Define key for `move-frame'.
+ * src/termhooks.h (event_kind): Add MOVE_FRAME_EVENT.
+ * src/w32term.c (w32_read_socket): Create MOVE_FRAME_EVENT.
+ * src/window.c (run_window_size_change_functions): Record size of
+ FRAME's minibuffer window too.
+ * src/xterm.c (handle_one_xevent): Create MOVE_FRAME_EVENT.
+ (x_set_offset): For GTK call gtk_widget_move instead of
+ XMoveWindow.
+
+2017-04-11 Werner LEMBERG <wl@gnu.org>
+
+ Avoid abort in ftfont.c due to faulty fonts
+
+ * src/ftfont.c (ftfont_get_metrics): Try loading the font without
+ hinting, before aborting. (Bug#25945)
+
+2017-04-11 Eli Zaretskii <eliz@gnu.org>
+
+ Document 'line-pixel-height'
+
+ * doc/lispref/display.texi (Size of Displayed Text): Document
+ line-pixel-height. Suggested by Tak Kunihiro
+ <tkk@misasa.okayama-u.ac.jp>. (Bug#26379)
+
+2017-04-11 Jens Lechtenboerger <jens.lechtenboerger@fsfe.org>
+
+ Introduce customizable variable 'package-gnupghome-dir'
+
+ * lisp/emacs-lisp/package.el (package-import-keyring)
+ (package--check-signature-content, package-check-signature):
+ Use new variable package-gnupghome-dir to control which GnuPG
+ homedir to use.
+ * doc/emacs/package.texi: Mention package-gnupghome-dir.
+ * etc/NEWS: Mention package-gnupghome-dir.
+
+2017-04-11 Martin Rudalics <rudalics@gmx.at>
+
+ Set x_gtk_use_window_move by default for fixing bug#25851 and bug#25943
+
+ This activates a change that was installed a few weeks ago but whose
+ ChangeLog was inadvertently dropped during its commit. The proper
+ ChangeLog is included below as part of the present commit.
+
+ * src/gtkutil.c (xg_set_geometry): When x_gtk_use_window_move
+ is set avoid calling x_gtk_parse_geometry (Bug#25851).
+ (x_wm_set_size_hint): When x_gtk_use_window_move is set, set
+ PPosition, USPosition and USSize flags if requested.
+ * src/xterm.c (x_set_offset): With GTK when
+ x_gtk_use_window_move is set, leave it entirely to
+ gtk_window_move to position the window and skip any
+ post-adjustments (Bug#25851 and Bug#25943).
+ (x_gtk_use_window_move): New variable.
+
+2017-04-10 Alan Mackenzie <acm@muc.de>
+
+ Fix a loop in C Mode caused by inadequate analysis of comments.
+
+ After M-;, and the insertion of the opening "/*", the CC Mode after-change
+ function got confused, since the new comment opener matched the end of a
+ subsequent comment, but moving back over that comment did not come back to the
+ starting point. Fix this.
+
+ * lisp/progmodes/cc-engine.el (c-end-of-macro): Add a limit parameter, wherer
+ point is left if no end-of-macro is found before it.
+ (c-forward-sws): Change the `safe-start' mechanism. Now `safe-start' is
+ non-nil except where we have an unclosed block comment at the end of a macro.
+ This enables us to populate the cache more fully, at the cost of some run
+ time.
+
+2017-04-10 Lars Brinkhoff <lars@nocrew.org>
+
+ Add PVSIZE function to return the size of a pseudovector.
+
+ * src/lisp.h (PVSIZE): New function.
+
+ * src/chartab.c (copy_char_table):
+ * src/data.c (Ftype_of, Finteractive_form, Faref, Faset):
+ * src/doc.c (Fdocumentation, store_function_docstring):
+ * src/eval.c (Fcommandp, funcall_lambda, lambda_arity, Ffetch_bytecode):
+ * src/fns.c (Flength, Fcopy_sequence):
+ * src/font.h (FONT_SPEC_P, FONT_ENTITY_P, FONT_OBJECT_P):
+ * src/lread.c (substitute_object_recurse):
+ * src/print.c (print_object):
+ Use it.
+
+2017-04-10 Michael Albinus <michael.albinus@gmx.de>
+
+ Add Tramp tests
+
+ * lisp/net/tramp.el (tramp-syntax): Adapt docstring.
+
+ * test/lisp/net/tramp-tests.el
+ (tramp-test01-file-name-syntax-simplified)
+ (tramp-test01-file-name-syntax-separate)
+ (tramp-test02-file-name-dissect-simplified)
+ (tramp-test02-file-name-dissect-separate): New tests.
+
+2017-04-10 Martin Rudalics <rudalics@gmx.at>
+
+ Make sure that `shell' makes BUFFER current
+
+ * lisp/shell.el (shell): Restrict scope of recently added
+ `with-current-buffer' to make sure that BUFFER is current when
+ `shell' returns.
+
+2017-04-10 Jim Blandy <jimb@red-bean.com>
+
+ Default to PCRE syntax when reading .hgignore
+
+ * lisp/vc/vc-hg.el (vc-hg--slurp-hgignore-1):
+ Default to the PCRE syntax (bug#26249).
+
+2017-04-09 Michael Albinus <michael.albinus@gmx.de>
+
+ Document Tramp changes
+
+ * doc/misc/tramp.texi (Change file name syntax): New node.
+
+ * etc/NEWS: Mention `tramp-change-syntax'.
+
+ * lisp/net/tramp.el (tramp-file-name-regexp): Reinsert it.
+ External packages uses it.
+ (tramp-syntax): Set also `tramp-file-name-regexp'.
+
+2017-04-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib (Bug#26398)
+
+ This incorporates:
+ 2017-04-08 getopt: prefer - to _ in new file names
+ 2017-04-08 getopt: port recent getopt changes to macOS
+ * .gitignore: Add lib/getopt-cdefs.h.
+ * lib/getopt-cdefs.in.h: Rename from lib/getopt_cdefs.in.h.
+ * lib/getopt-core.h: Rename from lib/getopt_core.h.
+ * lib/getopt-ext.h: Rename from lib/getopt_ext.h.
+ * lib/getopt-pfx-core.h: Rename from lib/getopt_pfx_core.h.
+ * lib/getopt-pfx-ext.h: Rename from lib/getopt_pfx_ext.h.
+ * lib/getopt.in.h, lib/unistd.in.h, m4/getopt.m4:
+ Copy from Gnulib.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+
+2017-04-09 Ken Raeburn <raeburn@raeburn.org>
+
+ Write updated loaddefs to a temporary file and rename into place.
+
+ In a parallel build, byte compilation can be running at the same times
+ as loaddefs.el is being regenerated. However, in a CANNOT_DUMP build,
+ loaddefs.el is read at startup and must always be in a usable state.
+
+ * lisp/Makefile.in ($(lisp)/loaddefs.el): Write generated output to
+ loaddefs.el.new and then rename it to loaddefs.el.
+
+2017-04-09 Glenn Morris <rgm@gnu.org>
+
+ In the manual, mention pops and imaps
+
+ * doc/emacs/rmail.texi (Movemail, Remote Mailboxes):
+ Mention pops and imaps protocols.
+
+2017-04-09 Glenn Morris <rgm@gnu.org>
+
+ * doc/emacs/rmail.texi: Prefer @command to @code for movemail.
+
+2017-04-09 Sergey Poznyakoff <gray@gnu.org>
+
+ Fix rmail handling of movemail protocols (bug#18278)
+
+ * lisp/mail/rmail.el (rmail-remote-proto-p): New function.
+ (rmail-parse-url): Return protocol in second list element.
+ Only use passwords with remote mailboxes.
+ (rmail-insert-inbox-text): Handle non-simple local
+ mailboxes (maildir, MH, etc.).
+
+2017-04-09 Glenn Morris <rgm@gnu.org>
+
+ Fix typos in manual re movemail local mailboxes
+
+ * doc/emacs/rmail.texi (Movemail, Other Mailbox Formats):
+ Fix examples of local mailbox urls.
+
+2017-04-08 Glenn Morris <rgm@gnu.org>
+
+ * lisp/gnus/nnmail.el (nnmail-crosspost-link-function): Simplify.
+
+2017-04-08 Glenn Morris <rgm@gnu.org>
+
+ Remove references to OS/2 in code, doc, and comments
+
+ * lisp/gnus/nnheader.el (nnheader-read-timeout)
+ (nnheader-file-name-translation-alist): Remove OS/2 case, and simplify.
+ * lisp/emulation/viper-util.el (viper-color-defined-p):
+ * lisp/net/pop3.el (pop3-read-timeout):
+ * lisp/net/imap.el (imap-read-timeout):
+ * lisp/url/url-privacy.el (url-setup-privacy-info): Remove OS/2 case.
+ * lisp/emulation/viper-ex.el (viper-glob-function):
+ * lisp/vc/ediff-util.el (ediff-submit-report): Doc fix.
+ * lisp/cus-edit.el (custom-display): Remove "pm" (OS/2).
+ * doc/emacs/msdos-xtra.texi (MS-DOS):
+ * doc/misc/gnus.texi (Various Various):
+ * doc/misc/viper.texi (Rudimentary Changes): Remove mentions of OS/2.
+
+2017-04-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Tune Tramp syntax
+
+ * lisp/net/tramp-cmds.el (tramp-change-syntax):
+ Use `tramp-syntax-values'.
+
+ * lisp/net/tramp-compat.el (tramp-compat-tramp-syntax): New defsubst.
+
+ * lisp/net/tramp.el (tramp-syntax): Rename possible values.
+ (tramp-syntax-values): New defun.
+ (tramp-prefix-format, tramp-method-regexp)
+ (tramp-postfix-method-format, tramp-prefix-ipv6-format)
+ (tramp-postfix-ipv6-format, tramp-postfix-host-format)
+ (tramp-completion-file-name-regexp): Use `tramp-compat-tramp-syntax'
+ and changed values.
+ (tramp-completion-file-name-regexp-default): Rename from
+ `tramp-completion-file-name-regexp-unified'. Adapt docstring.
+ (tramp-completion-file-name-regexp-simplified): Rename from
+ `tramp-completion-file-name-regexp-old-style'. Adapt docstring.
+ (tramp-initial-completion-file-name-regexp):
+ Use `tramp-completion-file-name-regexp-default'.
+ (tramp-run-real-handler): Do not autoload any longer.
+
+2017-04-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace more nested ifs with cond
+
+ This is a continuation of d526047 "Replace more nested ifs with cond".
+ * lisp/play/dunnet.el (dun-firstword, dun-firstwordl, dun-cat): Use
+ when and cond where appropriate.
+
+2017-04-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Adjust the edebug spec of if-let*
+
+ This was fixed in Bug#24748, but now looking more closely, using gate in
+ the spec seems correct. See (info "(elisp) Backtracking").
+ * lisp/emacs-lisp/subr-x.el (if-let*): Use gate in edebug spec.
+
+2017-04-08 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace some uses of cl-member-if with apply
+
+ From the mhtml-mode series. Some of the uses of cl-lib are not
+ necessary.
+ * lisp/align.el: Don't require cl-lib.
+ (align-region): Use apply instead of cl-member-if.
+ * lisp/emulation/viper.el: Don't require cl-lib.
+ (viper-mode, this-major-mode-requires-vi-state): Use apply instead of
+ cl-member-if.
+
+2017-04-08 Philipp Stephani <phst@google.com>
+
+ Validate SPEC of `dolist', cf. Bug#25477.
+
+ * lisp/subr.el (dolist): Test type and length of SPEC.
+ * test/lisp/subr-tests.el (subr-tests--dolist--wrong-number-of-args):
+ Add unit test.
+
+2017-04-08 Philipp Stephani <phst@google.com>
+
+ Add unit test for Bug#26378
+
+ * test/lisp/vc/ediff-diff-tests.el
+ (ediff-diff-tests--ediff-exec-process--nil): New unit test.
+
+2017-04-08 Lars Brinkhoff <lars@nocrew.org>
+
+ Fix circular read syntax for records.
+
+ * src/lread.c (substitute_object_recurse): Work with records.
+
+ * test/src/lread-tests.el (lread-record-1): New test.
+
+2017-04-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Deprecate copy-record in favor of copy-sequence
+
+ Since copy-sequence seems to be needed anyway for records, have it
+ work on records, and remove copy-record as being superfluous.
+ * doc/lispref/records.texi (Records, Record Functions):
+ * lisp/emacs-lisp/cl-macs.el (cl-defstruct):
+ * lisp/emacs-lisp/eieio.el (make-instance, clone):
+ * test/src/alloc-tests.el (record-3):
+ Use copy-sequence, not copy-record, to copy records.
+ * doc/lispref/sequences.texi (Sequence Functions)
+ (Array Functions): Document that aref and copy-sequence
+ work on records.
+ * etc/NEWS: Omit copy-record.
+ * src/alloc.c (Fcopy_record): Remove.
+ * src/data.c (Faref): Document that arg can be a record.
+ * src/fns.c (Fcopy_sequence): Copy records, too.
+
+2017-04-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix dependency checking in src/Makefile.in
+
+ * src/Makefile.in (AUTO_DEPEND, DEPDIR, DEPFLAGS): Move includes of
+ dependency files until after ALLOBJS is defined, since it uses ALLOBJS.
+ Otherwise, some dependencies will be missed.
+
+2017-04-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor tuneup of write-region change
+
+ * src/fileio.c (write_region): Use SCHARS, not Flength,
+ on a value known to be a string.
+
+2017-04-08 Noam Postavsky <npostavs@gmail.com>
+
+ Adjust write-region so file name is at the beginning again
+
+ * lisp/epa-file.el (epa-file-write-region):
+ * lisp/gnus/mm-util.el (mm-append-to-file):
+ * lisp/jka-compr.el (jka-compr-write-region):
+ * lisp/net/ange-ftp.el (ange-ftp-write-region):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
+ * src/fileio.c (write_region): Put file name at the beginning and move
+ number of characters to the end of the message.
+
+2017-04-08 Kaushal Modi <kaushal.modi@gmail.com>
+
+ Check that file argument is a string
+
+ * lisp/vc/ediff-diff.el (ediff-exec-process): Check that the argument
+ passed to `file-local-copy' is a string (Bug#26378). Also fix
+ the existing comment for this function, and convert it to its
+ doc-string.
+
+2017-04-08 Noam Postavsky <npostavs@gmail.com>
+
+ Fix handling of non-integer START param to write-region
+
+ The previous patch for Bug#354 incorrectly assumed that START would
+ always be an integer.
+
+ * lisp/epa-file.el (epa-file-write-region):
+ * lisp/jka-compr.el (jka-compr-write-region):
+ * lisp/net/ange-ftp.el (ange-ftp-write-region):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
+ * src/fileio.c (write_region): Handle nil and string values of START.
+
+2017-04-07 Glenn Morris <rgm@gnu.org>
+
+ * lisp/textmodes/rst.el (rst-package-emacs-version-alist): Fixes.
+
+2017-04-07 Michael Albinus <michael.albinus@gmx.de>
+
+ Add Tramp versions to `customize-package-emacs-version-alist'
+
+ * lisp/net/trampver.el (customize-package-emacs-version-alist):
+ Add Tramp versions to `customize-package-emacs-version-alist'.
+
+2017-04-07 Tom Tromey <tom@tromey.com>
+
+ * lisp/textmodes/rst.el (rst-toc-link-keymap): Move before first use.
+
+2017-04-07 Lars Brinkhoff <lars@nocrew.org>
+
+ * doc/lispref/records.texi (Record Functions): fix typo.
+
+2017-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ More casefiddle minor fixes
+
+ * src/casefiddle.c (case_character_impl): Omit unnecessary casts.
+ (case_character_impl): Avoid reevaluation of CHAR_TABLE_REF.
+ (GREEK_CAPITAL_LETTER_SIGMA): Fix typo in my previous change.
+
+2017-04-07 Jeff Clough <kb1vqh@gmail.com>
+
+ Output number of characters added to file (Bug#354)
+
+ * src/fileio.c (write_region):
+ * lisp/epa-file.el (epa-file-write-region):
+ * lisp/jka-compr.el (jka-compr-write-region):
+ * lisp/net/ange-ftp.el (ange-ftp-write-region):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
+ * lisp/gnus/mm-util.el (mm-append-to-file): Functions now output
+ characters written in addition to file name.
+ * doc/lispref/files.texi: Added documentation to write-region and
+ append-to-file describing their output.
+
+2017-04-07 Noam Postavsky <npostavs@users.sourceforge.net>
+
+ Fix ‘!NILP (Vpurify_flag)’ assertion failure during temacs bootstrap
+
+ The recent changes to src/casefiddle.c cause build failure as seen
+ below:
+
+ Starting program: /home/npostavs/src/emacs/emacs-bootstrapping/src/temacs
+ --batch --load loadup bootstrap
+ [Thread debugging using libthread_db enabled]
+ Using host libthread_db library "/usr/lib/libthread_db.so.1".
+ Loading loadup.el (source)...
+ Using load-path (/home/npostavs/src/emacs/emacs-bootstrapping/lisp
+ /home/npostavs/src/emacs/emacs-bootstrapping/lisp/emacs-lisp
+ /home/npostavs/src/emacs/emacs-bootstrapping/lisp/language
+ /home/npostavs/src/emacs/emacs-bootstrapping/lisp/international
+ /home/npostavs/src/emacs/emacs-bootstrapping/lisp/textmodes
+ /home/npostavs/src/emacs/emacs-bootstrapping/lisp/vc)
+ Loading emacs-lisp/byte-run (source)...
+ Loading emacs-lisp/backquote (source)...
+ Loading subr (source)...
+ Loading version (source)...
+ Loading widget (source)...
+ Loading custom (source)...
+ Loading emacs-lisp/map-ynp (source)...
+ Loading international/mule (source)...
+ Loading international/mule-conf (source)...
+
+ lread.c:3914: Emacs fatal error: assertion failed: !NILP (Vpurify_flag)
+
+ Breakpoint 1, terminate_due_to_signal at emacs.c:363
+ 363 signal (sig, SIG_DFL);
+ (gdb) bt
+ #0 0x0000000000579826 in terminate_due_to_signal at emacs.c:363
+ #1 0x000000000060ec33 in die at alloc.c:7352
+ #2 0x000000000066db40 in intern_c_string_1 at lread.c:3914
+ #3 0x0000000000576884 in intern_c_string at lisp.h:3790
+ #4 0x00000000005dc84f in prepare_casing_context at casefiddle.c:69
+ #5 0x00000000005dd37f in casify_object at casefiddle.c:311
+ #6 0x00000000005dd47f in Fcapitalize at casefiddle.c:356
+ #7 0x00000000006325ac in eval_sub at eval.c:2219
+ #8 0x0000000000632368 in eval_sub at eval.c:2184
+ #9 0x000000000063446c in apply_lambda at eval.c:2875
+ #10 0x00000000006329af in eval_sub at eval.c:2294
+ #11 0x000000000062d462 in Fprogn at eval.c:449
+ #12 0x000000000062d4cf in prog_ignore at eval.c:461
+ #13 0x000000000062f19c in Fwhile at eval.c:982
+ #14 0x00000000006321f4 in eval_sub at eval.c:2172
+ #15 0x000000000062d462 in Fprogn at eval.c:449
+ #16 0x000000000062f0c4 in Flet at eval.c:963
+ #17 0x00000000006321f4 in eval_sub at eval.c:2172
+ #18 0x0000000000632963 in eval_sub at eval.c:2290
+ #19 0x000000000062d462 in Fprogn at eval.c:449
+ #20 0x000000000062f0c4 in Flet at eval.c:963
+ #21 0x00000000006321f4 in eval_sub at eval.c:2172
+ #22 0x0000000000668caa in readevalloop at lread.c:1927
+ #23 0x0000000000667253 in Fload at lread.c:1332
+ #24 0x0000000000632683 in eval_sub at eval.c:2233
+ #25 0x0000000000668caa in readevalloop at lread.c:1927
+ #26 0x0000000000667253 in Fload at lread.c:1332
+ #27 0x0000000000632683 in eval_sub at eval.c:2233
+ #28 0x0000000000631be5 in Feval at eval.c:2041
+ #29 0x000000000057e1af in top_level_2 at keyboard.c:1121
+ #30 0x000000000062ffc7 in internal_condition_case at eval.c:1324
+ #31 0x000000000057e1f0 in top_level_1 at keyboard.c:1129
+ #32 0x000000000062f51e in internal_catch at eval.c:1091
+ #33 0x000000000057e0ea in command_loop at keyboard.c:1090
+ #34 0x000000000057d6d5 in recursive_edit_1 at keyboard.c:697
+ #35 0x000000000057d8b4 in Frecursive_edit at keyboard.c:768
+ #36 0x000000000057b55b in main at emacs.c:1687
+
+ Lisp Backtrace:
+ "capitalize" (0xffffcf70)
+ "format" (0xffffd130)
+ "define-charset" (0xffffd370)
+ "while" (0xffffd560)
+ "let" (0xffffd7c0)
+ "dolist" (0xffffd910)
+ "let" (0xffffdb70)
+ "load" (0xffffdfe0)
+ "load" (0xffffe4a0)
+
+ * src/casefiddle.c (syms_of_casefiddle): Declare four new symbols:
+ Qtitlecase, Qspecial_uppercase, Qspecial_lowercase and
+ Qspecial_titlecase.
+ (prepare_casing_context): Use aforementioned symbols.
+
+2017-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This merges some getopt fixes from Zack Weinberg, and affects only
+ non-GNUish platforms. It incorporates:
+ 2017-04-06 getopt-gnu: omit some duplicate code
+ 2017-04-06 getopt-posix: use angle-bracket include
+ 2017-04-06 getopt: annotate files with relationship to glibc
+ 2017-04-06 getopt: split up getopt.in.h and eliminate __need_getopt
+ 2017-04-06 getopt: better handling of ambiguous options
+ 2017-04-06 getopt: refactor long-option handling
+ 2017-04-06 getopt: tidy up _getopt_initialize a bit
+ 2017-04-06 getopt: merge from glibc: repetition reduction
+ 2017-04-06 getopt: clean up error reporting
+ 2017-04-06 getopt: fix fencepost error in ambiguous-W-option handling
+ 2017-04-06 getopt: clean up getopt.c and getopt1.c file headers
+ 2017-04-06 getopt: harmonize comments with glibc
+ 2017-04-06 getopt: remove USE_NONOPTION_FLAGS
+ 2017-04-06 getopt: tabify, in preparation for merge with glibc
+ 2017-04-06 md5, sha1, sha256, sha512: Add comments re correctness
+ * build-aux/config.sub, doc/misc/texinfo.tex, lib/getopt.c:
+ * lib/getopt.in.h, lib/getopt1.c, lib/getopt_int.h, lib/md5.c:
+ * lib/md5.h, lib/sha1.c, lib/sha1.h, lib/sha256.c, lib/sha256.h:
+ * lib/sha512.c, lib/sha512.h, lib/unistd.in.h, m4/getopt.m4:
+ Copy from gnulib.
+ * lib/getopt_cdefs.in.h, lib/getopt_core.h, lib/getopt_ext.h:
+ * lib/getopt_pfx_core.h, lib/getopt_pfx_ext.h:
+ New files, taken from gnulib.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4:
+ Regenerate.
+
+2017-04-07 Hong Xu <hong@topbug.net>
+
+ * src/search.c (Fre_search_forward, Fre_search_backward): Improve
+ doc (Bug#25193).
+
+2017-04-07 Noam Postavsky <npostavs@gmail.com>
+
+ Mention that processes start in default-directory (Bug#18515)
+
+ * doc/lispref/processes.texi (Synchronous Processes):
+ (Asynchronous Processes):
+ * lisp/subr.el (start-process):
+ * src/callproc.c (call-process): Mention that the subprocess starts in
+ `default-directory' when local, suggest `start-file-process' and
+ `process-file' otherwise.
+
+2017-04-07 Noam Postavsky <npostavs@gmail.com>
+
+ * src/xdisp.c (vmessage, message): Clarify commentary.
+
+2017-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor casefiddle.c cleanups
+
+ * src/casefiddle.c: Redo recent changes to match GNU style,
+ and prefer C99-style decls within blocks.
+ (GREEK_CAPITAL_LETTER_SIGMA): Rename from CAPITAL_SIGMA, so that
+ we are merely using the Unicode name, and make it a constant
+ rather than a macro. All uses changed.
+ (SMALL_SIGMA): Remove; unused.
+ (GREEK_SMALL_LETTER_FINAL_SIGMA): Rename from SMALL_FINAL_SIGMA,
+ and make it a constant rather than a macro. All uses changed.
+ (do_casify_multibyte_string): Use ‘verify’ rather than an
+ unportable static_assertion local.
+
+2017-04-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp/international/README: Update to match current list.
+
+2017-04-06 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix 'make clean' in lib subdirectory
+
+ * lib/Makefile.in (clean): Remove *-t files.
+ (mostlyclean): Remove MOSTLYCLEANFILES that are not *-t files.
+ This removes files like lib/getopt.h that should be removed
+ even if this configuration did not need to build them.
+ (maintainer-clean): Remove TAGS here, not in distclean,
+ to be consistent with ../src/Makefile.in.
+
+2017-04-06 Michael Albinus <michael.albinus@gmx.de>
+
+ Add new Tramp syntax
+
+ * lisp/net/tramp-cmds.el (tramp-change-syntax): New defun.
+
+ * lisp/net/tramp.el (tramp-syntax): Change default to `def'.
+ Add :set function.
+ (tramp-prefix-port-format): Simplify.
+ (tramp-file-name-regexp-separate): Remove.
+ (tramp-initial-file-name-regexp)
+ (tramp-completion-file-name-regexp-old-style)
+ (tramp-initial-completion-file-name-regexp): New defconst.
+ (tramp-prefix-format, tramp-prefix-regexp)
+ (tramp-method-regexp, tramp-postfix-method-format)
+ (tramp-postfix-method-regexp, tramp-prefix-ipv6-format)
+ (tramp-prefix-ipv6-regexp, tramp-postfix-ipv6-format)
+ (tramp-postfix-ipv6-regexp)
+ (tramp-postfix-host-format, tramp-postfix-host-regexp)
+ (tramp-remote-file-name-spec-regexp)
+ (tramp-file-name-structure, tramp-file-name-regexp)
+ (tramp-completion-file-name-regexp)
+ (tramp-rfn-eshadow-update-overlay-regexp): Change them to be defuns.
+ (tramp-tramp-file-p, tramp-find-method)
+ (tramp-dissect-file-name, tramp-make-tramp-file-name)
+ (tramp-completion-make-tramp-file-name)
+ (tramp-rfn-eshadow-update-overlay)
+ (tramp-register-autoload-file-name-handlers)
+ (tramp-register-file-name-handlers)
+ (tramp-unload-file-name-handlers)
+ (tramp-completion-handle-file-name-all-completions)
+ (tramp-completion-dissect-file-name, tramp-clear-passwd):
+ * lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler):
+ * lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered)
+ (tramp-compute-multi-hops): Use them.
+
+2017-04-06 Michal Nazarewicz <mina86@mina86.com>
+
+ Implement special sigma casing rule (bug#24603)
+
+ In Greek, a sigma character has two lower case forms which depend on
+ their position in the word. Implement logic determining it.
+
+ * src/casefiddle.c (struct casing_context, case_character_impl): Don’t
+ assume inword is true when flag is CASE_UP and false when flag is
+ CASE_DOWN. For final sigma detection we need this information tracked
+ reliably;.
+ (CAPITAL_SIGMA, SMALL_SIGMA, SMALL_FINAL_SIGMA): New macros defining
+ Unicode code point of different forms of sigma letter.
+ (case_character): Implement support for final sigma casing.
+ (do_casify_multibyte_string, do_casify_multibyte_region): Update after
+ changes to case_character.
+
+ * test/src/casefiddle-tests.el (casefiddle-tests-casing): Add test
+ cases for final sigma.
+
+2017-04-06 Michal Nazarewicz <mina86@mina86.com>
+
+ Support casing characters which map into multiple code points (bug#24603)
+
+ Implement unconditional special casing rules defined in Unicode standard.
+
+ Among other things, they deal with cases when a single code point is
+ replaced by multiple ones because single character does not exist (e.g.
+ ‘fi’ ligature turning into ‘FL’) or is not commonly used (e.g. ß turning
+ into SS).
+
+ * admin/unidata/SpecialCasing.txt: New data file pulled from Unicode
+ standard distribution.
+ * admin/unidata/README: Mention SpecialCasing.txt.
+
+ * admin/unidata/unidata-gen.el (unidata-gen-table-special-casing,
+ unidata-gen-table-special-casing--do-load): New functions generating
+ ‘special-uppercase’, ‘special-lowercase’ and ‘special-titlecase’
+ character Unicode properties built from the SpecialCasing.txt Unicode
+ data file.
+
+ * src/casefiddle.c (struct casing_str_buf): New structure for
+ representing short strings used to handle one-to-many character
+ mappings.
+
+ (case_character_imlp): New function which can handle one-to-many
+ character mappings.
+ (case_character, case_single_character): Wrappers for the above
+ functions. The former may map one character to multiple (or no)
+ code points while the latter does what the former used to do (i.e.
+ handles one-to-one mappings only).
+
+ (do_casify_natnum, do_casify_unibyte_string,
+ do_casify_unibyte_region): Use case_single_character.
+ (do_casify_multibyte_string, do_casify_multibyte_region): Support new
+ features of case_character.
+ * (do_casify_region): Updated to reflact do_casify_multibyte_string
+ changes.
+
+ (casify_word): Handle situation when one character-length of a word
+ can change affecting where end of the word is.
+
+ (upcase, capitalize, upcase-initials): Update documentation to mention
+ limitations when working on characters.
+
+ * test/src/casefiddle-tests.el (casefiddle-tests-char-properties):
+ Add test cases for the newly introduced character properties.
+ (casefiddle-tests-casing): Update test cases which are now passing.
+
+ * test/lisp/char-fold-tests.el (char-fold--ascii-upcase,
+ char-fold--ascii-downcase): New functions which behave like old ‘upcase’
+ and ‘downcase’.
+ (char-fold--test-match-exactly): Use the new functions. This is needed
+ because otherwise fi and similar characters are turned into their multi-
+ -character representation.
+
+ * doc/lispref/strings.texi: Describe issue with casing characters versus
+ strings.
+ * doc/lispref/nonascii.texi: Describe the new character properties.
+
+2017-04-06 Michal Nazarewicz <mina86@mina86.com>
+
+ Split up casify_region function (bug#24603)
+
+ No functional changes at this time but splitting casify_region into
+ a function dealing with multibyte and another dealing with unibyte
+ buffers will make future code changes slightly easier.
+
+ * src/casefiddle.c (casify_region): Move most of the code into two
+ new functions:
+ (do_casify_multibyte_region, do_casify_unibyte_region): new functions.
+
+2017-04-06 Michal Nazarewicz <mina86@mina86.com>
+
+ Add support for title-casing letters (bug#24603)
+
+ * src/casefiddle.c (struct casing_context, prepare_casing_context): Add
+ titlecase_char_table member. It’s set to the ‘titlecase’ Unicode
+ property table if capitalization has been requested.
+ (case_character): Make use of the titlecase_char_table to title-case
+ initial characters when capitalising.
+
+ * test/src/casefiddle-tests.el (casefiddle-tests--characters,
+ casefiddle-tests-casing): Update test cases which are now passing.
+
+2017-04-06 Michal Nazarewicz <mina86@mina86.com>
+
+ Introduce case_character function
+
+ Move single-character casing logic into a separate function so that
+ it is collected in a single place. This will make future changes to
+ the logic easier. This commit introduces no functionality changes.
+
+ * src/casefiddle.c (struct casing_context, prepare_casing_context): New
+ structure for saving casing context and function to initialize it.
+ (case_character): New function which cases character base on provided
+ context.
+ (do_casify_integer, do_casify_multibyte_string,
+ do_casify_unibyte_string, casify_object, casify_region): Convert to
+ use casing_context and case_character.
+
+2017-04-06 Michal Nazarewicz <mina86@mina86.com>
+
+ Split casify_object into multiple functions
+
+ casify_object had three major cases to cover and those were mostly
+ independent of each other. Move those branches to separate function
+ so it’s easier to comprehend each individual case.
+
+ While at it, use somewhat more descriptive ch and cased variable names
+ rather than c and c1.
+
+ This commit introduces no functional changes.
+
+ * src/casefiddle.c (casify_object): Split into…
+ (do_casify_integer, do_casify_multibyte_string,
+ do_casify_unibyte_string): …new functions.
+
+2017-04-06 Lars Brinkhoff <lars@nocrew.org>
+
+ Update documentation for type semantics of records.
+
+ * doc/lispref/objects.texi (Record Type): improve description of what
+ `type-of' returns for records.
+ (Type Descriptors): new section.
+ * doc/lispref/elisp.texi: reference it.
+ * doc/lispref/records.texi (Records): reference it. Document
+ behaviour when type slot is a record.
+
+ * admin/alloc-colors.c (Fmake_record, Frecord): mention type desciptors.
+
+2017-04-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/help-fns.el (describe-symbol): `nil' is not an interesting default.
+
+2017-04-06 Tom Tromey <tom@tromey.com>
+
+ require cl-lib to fix fallout from mhtml series
+
+ * lisp/align.el, lisp/calc/calc-embed.el, lisp/cedet/semantic.el,
+ lisp/emulation/viper.el: Require cl-lib.
+
+2017-04-06 Ken Raeburn <raeburn@raeburn.org>
+
+ In CANNOT_DUMP builds, allow editing of files named "dump".
+
+ * lisp/loadup.el: Perform the "dump" or "bootstrap" actions like
+ calling dump-emacs only if dump-emacs is defined; otherwise, don't
+ treat those command-line argument specially.
+
+2017-04-06 Ken Raeburn <raeburn@raeburn.org>
+
+ In CANNOT_DUMP builds, don't prepare for unexec.
+
+ Having a command-line argument of "dump" or "bootstrap" would trigger
+ behavior like not installing signal handlers. In CANNOT_DUMP modes,
+ we should get signal handlers installed regardless of whatever funny
+ file names we decide to edit.
+
+ src/emacs.c (main) [CANNOT_DUMP]: Don't enable the "dumping"
+ alterations to initialization that prepares the process for unexec.
+
+2017-04-06 Ken Raeburn <raeburn@raeburn.org>
+
+ Allow a CANNOT_DUMP build to use exec-path during bootstrap.
+
+ During a bootstrap, loading rmail.el invokes movemail to determine its
+ flavor, but call-process doesn't work if exec-path is nil.
+
+ * lisp/loadup.el: Only clear exec-path if dumping.
+
+2017-04-06 Ken Raeburn <raeburn@raeburn.org>
+
+ Fix CANNOT_DUMP build on Darwin/macOS.
+
+ * src/conf_post.h (malloc, realloc, free) [DARWIN_OS && emacs &&
+ CANNOT_DUMP]: Don't define as unexec_malloc, etc.
+ * src/emacs.c (main): Don't call unexec_init_emacs_zone.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ add two more mhtml tests
+
+ * test/manual/indent/html-multi-2.html: New file.
+ * test/manual/indent/html-multi-3.html: New file.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ enable mhtml-mode by default
+
+ * lisp/files.el (auto-mode-alist): Reference mhtml-mode, not
+ html-mode.
+ (magic-fallback-mode-alist): Likewise.
+ * lisp/net/eww.el (eww-view-source): Use mthml-mode.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ add mhtml-mode.el
+
+ * etc/NEWS: Update.
+ * lisp/textmodes/mhtml-mode.el: New file.
+ * test/manual/indent/html-multi.html: New file.
+ * test/lisp/textmodes/mhtml-mode-tests.el: New file.
+ * doc/emacs/text.texi (HTML Mode): Mention mhtml-mode.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change sgml-mode to help multi-html mode
+
+ * lisp/textmodes/sgml-mode.el (sgml-syntax-propertize-rules): New
+ defconst.
+ (sgml-syntax-propertize): Use it.
+ (sgml--find-<>-backward): New function.
+ (sgml-parse-tag-backward): Use it.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ make js.el respect prog-first-column
+
+ * lisp/progmodes/js.el (js--proper-indentation): Call prog-first-column.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ make smie.el respect prog-first-column
+
+ * lisp/emacs-lisp/smie.el (smie-indent-bob): Call prog-first-column.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change viper to use derived-mode-p
+
+ * lisp/subr.el (provided-mode-derived-p): New function.
+ (derived-mode-p): Use it.
+ * lisp/emulation/viper.el (viper-mode): Use derived-mode-p.
+ (this-major-mode-requires-vi-state): Use provided-mode-derived-p.
+ (set-viper-state-in-major-mode): Use derived-mode-p.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change align to use derived-mode-p
+
+ * lisp/align.el (align-region): Use derived-mode-p.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change org to use derived-mode-p
+
+ * lisp/org/org-list.el (org-list-insert-radio-list): Use
+ derived-mode-p.
+ * lisp/org/org-table.el (orgtbl-setup, orgtbl-toggle-comment): Use
+ derived-mode-p.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change semantic to use derived-mode-p
+
+ * lisp/cedet/semantic.el (semantic-new-buffer-fcn): Use derived-mode-p.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change calc to use derived-mode-p
+
+ * lisp/calc/calc-embed.el (calc-embedded-find-modes)
+ (calc-embedded-make-info): Use derived-mode-p.
+
+2017-04-05 Tom Tromey <tom@tromey.com>
+
+ change auto-insert to use derived-mode-p
+
+ * lisp/autoinsert.el (auto-insert): Use derived-mode-p.
+
+2017-04-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * lisp/info.el (Info-search): Fix typo in April 1 change.
+
+2017-04-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor cleanups related to type-of
+
+ * src/data.c (Frecordp): Rename from Frecordp_p, for consistency.
+ * src/data.c (syms_of_data):
+ * src/frame.c (syms_of_frame): Put all the primitive type names
+ together, under the "Types that type-of returns" comment.
+
+2017-04-05 Glenn Morris <rgm@gnu.org>
+
+ * doc/lispref/package.texi (Package Archives): Mention https.
+
+2017-04-05 Glenn Morris <rgm@gnu.org>
+
+ Advertise https for homepage of gnu.org packages
+
+ * lisp/emacs-lisp/package.el (describe-package-1):
+ Use https, if supported, for the homepage of packages on gnu.org.
+
+2017-04-05 Glenn Morris <rgm@gnu.org>
+
+ Default to https for elpa.gnu.org if gnutls available
+
+ * lisp/emacs-lisp/package.el (package-archives):
+ Default to https for elpa.gnu.org if gnutls is available. Ref:
+ https://lists.gnu.org/r/emacs-devel/2015-05/msg00130.html
+
+2017-04-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor simplifications and doc for records
+
+ * doc/lispref/records.texi (Records): Mention size limit.
+ * etc/NEWS: Mention records.
+ * src/alloc.c (allocate_pseudovector, allocate_record):
+ Prefer 'PSEUDOVECTOR_SIZE_MASK' to its definiens.
+ (allocate_record): Check arg range here, not in callers, as this
+ simplifies the code. Use allocate_vectorlike instead of
+ allocate_vector, to avoid duplicate runtime tests.
+ (Fmake_record, record): Don't mention PSEUDOVECTOR_SIZE_BITS in
+ the doc string, as it is not visible to the user.
+ (Fmake_record, record, Fcopy_record):
+ Prefer make_lisp_ptr to XSETVECTOR.
+ (record): Broaden memcpy to copy the type, too.
+
+2017-04-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix recent changes in record data type
+
+ * src/alloc.c (Fmake_record, Frecord, Fcopy_record): Avoid
+ compiler warnings when 'ptrdiff_t' is narrower than 'long int'.
+
+2017-04-04 Philipp Stephani <phst@google.com>
+
+ Make subprocess functions resolve the default directory
+
+ `call-process' doesn't respect file name handlers in
+ `default-directory', so `file-name-non-special' has to resolve them
+ for `process-file', `start-file-process', and
+ `shell-command' (Bug#25949).
+
+ * lisp/files.el (file-name-non-special): Also resolve default
+ directory for 'process-file', 'start-file-process', and
+ 'shell-command'.
+ * test/lisp/files-tests.el
+ (files-tests--file-name-non-special--subprocess): Add unit test.
+
+2017-04-04 Philipp Stephani <phst@google.com>
+
+ Make ediff handle remote and quoted file names
+
+ Quoted file names need to be unquoted before passed to
+ subprocesses (Bug#25950).
+
+ * lisp/vc/ediff-diff.el (ediff-exec-process): Handle remote and quoted
+ file names.
+ * test/lisp/vc/ediff-diff-tests.el
+ (ediff-diff-tests--ediff-exec-process--quoted-file): Add unit test.
+
+2017-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Backward compatibility with pre-existing struct instances.
+
+ * lisp/emacs-lisp/cl-lib.el (cl--old-struct-type-of): New function.
+ (cl-old-struct-compat-mode): New minor mode.
+
+ * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Pass `record' to
+ cl-struct-define to signal use of record objects.
+
+ * lisp/emacs-lisp/cl-preloaded.el (cl--struct-get-class,
+ cl-struct-define): Enable legacy defstruct compatibility.
+
+ * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-old-struct,
+ old-struct): New tests.
+
+ * doc/lispref/elisp.texi, doc/lispref/records.texi: Document
+ `old-struct-compat'.
+
+2017-04-04 Lars Brinkhoff <lars@nocrew.org>
+
+ Make the URL library use records.
+
+ * lisp/url/url.el, lisp/url/url-cache.el, lisp/url/url-dav.el,
+ lisp/url/url-expand.el, lisp/url/url-file.el, lisp/url/url-imap.el,
+ lisp/url/url-ldap.el: Use `url-p' instead of `vectorp'.
+
+ * lisp/url/url-http.el (url-http): Check for type `url' instead of
+ `vector'.
+
+2017-04-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Make EIEIO use records.
+
+ * lisp/emacs-lisp/eieio-compat.el
+ (eieio--generic-static-object-generalizer): Adjust to new tags.
+
+ * lisp/emacs-lisp/eieio-core.el: Use records, and place the class object
+ directly as tag.
+ (eieio--object-class): Adjust to new tag representation.
+ (eieio-object-p): Rewrite, and adapt to new `type-of' behavior.
+ (eieio-defclass-internal): Use `make-record'.
+ (eieio--generic-generalizer): Adjust generalizer code accordingly.
+
+ * lisp/emacs-lisp/eieio.el (make-instance, clone): Use copy-record.
+
+ * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates):
+ Add `recordp'.
+
+ * doc/lispref/records.texi, doc/misc/eieio.texi: Update for records.
+
+2017-04-04 Lars Brinkhoff <lars@nocrew.org>
+
+ Make cl-defstruct use records.
+
+ * lisp/emacs-lisp/cl-extra.el (cl--describe-class)
+ (cl--describe-class-slots): Use the new `type-of'.
+
+ * lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Use type-of.
+ (cl--generic-struct-specializers): Adjust to new tag.
+
+ * lisp/emacs-lisp/cl-macs.el (cl-defstruct): When type is nil, use records.
+ Use the type symbol as the tag. Use copy-record to copy structs.
+ (cl--defstruct-predicate): New function.
+ (cl--pcase-mutually-exclusive-p): Use it.
+ (cl-struct-sequence-type): Can now return `record'.
+
+ * lisp/emacs-lisp/cl-preloaded.el (cl--make-slot-desc): Adjust ad-hoc
+ code to new format.
+ (cl--struct-register-child): Work with records.
+ (cl-struct-define): Don't touch the tag's symbol-value and
+ symbol-function slots when we use the type as tag.
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-object): Adjust to new tag.
+
+ * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-defstruct-record):
+ New test.
+
+ * doc/lispref/records.texi, doc/misc/cl.texi: Update for records.
+
+2017-04-04 Lars Brinkhoff <lars@nocrew.org>
+
+ Add record objects with user-defined types.
+
+ * src/alloc.c (allocate_record): New function.
+ (Fmake_record, Frecord, Fcopy_record): New functions.
+ (syms_of_alloc): defsubr them.
+ (purecopy): Work with records.
+
+ * src/data.c (Ftype_of): Return slot 0 for record objects, or type
+ name if record's type holds class.
+ (Frecordp): New function.
+ (syms_of_data): defsubr it. Define `Qrecordp'.
+ (Faref, Faset): Work with records.
+
+ * src/fns.c (Flength): Work with records.
+
+ * src/lisp.h (prec_type): Add PVEC_RECORD.
+ (RECORDP, CHECK_RECORD, CHECK_RECORD_TYPE): New functions.
+
+ * src/lread.c (read1): Add syntax for records.
+
+ * src/print.c (PRINT_CIRCLE_CANDIDATE_P): Add RECORDP.
+ (print_object): Add syntax for records.
+
+ * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-2):
+ New test.
+
+ * test/src/alloc-tests.el (record-1, record-2, record-3):
+ New tests.
+
+ * doc/lispref/elisp.texi, doc/lispref/objects.texi,
+ doc/lispref/records.texi: Add documentation for records.
+
+2017-04-04 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix a test in python-test.el
+
+ Fix a test that breaks the test suite when it is run within a
+ virtual environment.
+ See following link for details:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00857.html
+ * test/lisp/progmodes/python-tests.el
+ (python-shell-calculate-process-environment-7): Bind
+ python-shell-virtualenv-root to VIRTUAL_ENV when this var is set; otherwise
+ bind it to '/env'.
+
+2017-04-04 Noam Postavsky <npostavs@gmail.com>
+
+ Throw a `search-failed' derived error in Info search
+
+ The original fix for Bug#6106 switched from signaling `search-failed'
+ to `user-error'. However, this breaks incremental searching over
+ multiple nodes because the isearch code doesn't expect a `user-error'.
+
+ * src/search.c (syms_of_search): New error, `user-search-failed',
+ with `user-error' and `search-failed' as parents.
+ * doc/lispref/errors.texi (Standard Errors): Document it.
+ * etc/NEWS: Announce it.
+ * lisp/info.el (Info-search): Use it instead of `user-error' so that
+ isearch will handle failed searches correctly.
+
+2017-04-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Add Tramp test
+
+ * doc/misc/tramp.texi (Remote processes): Fix typo.
+
+ * lisp/shell.el (shell): Fix typo.
+
+ * lisp/net/tramp.el (tramp-set-connection-local-variables): Simplify.
+
+ * test/lisp/net/tramp-tests.el (tramp-test30-explicit-shell-file-name):
+ New test.
+ (tramp--test-special-characters, tramp--test-utf8): Adapt docstring.
+ (tramp-test31-vc-registered)
+ (tramp-test32-make-auto-save-file-name)
+ (tramp-test33-make-nearby-temp-file)
+ (tramp-test34-special-characters)
+ (tramp-test34-special-characters-with-stat)
+ (tramp-test34-special-characters-with-perl)
+ (tramp-test34-special-characters-with-ls, tramp-test35-utf8)
+ (tramp-test35-utf8-with-stat, tramp-test35-utf8-with-perl)
+ (tramp-test35-utf8-with-ls)
+ (tramp-test36-asynchronous-requests)
+ (tramp-test37-recursive-load, tramp-test38-unload): Rename.
+
+2017-04-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/ses.el: Silence byte-compiler warnings.
+
+ (ses-jump, ses-recalculate-cell, ses-define-local-printer): Silence
+ byte-compiler warnings.
+
+2017-04-02 Glenn Morris <rgm@gnu.org>
+
+ Belated fixes for admin.el's M-x make-manuals-dist
+
+ * admin/admin.el (make-manuals-dist-output-variables): Additions.
+ (make-manuals-dist--1): Also copy docstyle.texi.
+
+2017-04-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix bugs in simplified test dependencies
+
+ Problem reported by Glenn Morris in:
+ https://lists.gnu.org/r/emacs-devel/2017-04/msg00017.html
+ * test/Makefile.in (LOGFILES, TESTS): Omit leading "./".
+ (TESTS): Omit unnecessary patsubst.
+ (test_template): Redo dependency heuristic, hopefully
+ correctly this time. It's the .log file that depends,
+ not the phony test target. Declare the phonies to be PHONY.
+ Resurrect the exception for the *-tests subdirectory.
+ Adjust to the fact that leading "./" is omitted now.
+
+2017-04-02 Wilfred Hughes <me@wilfred.me.uk>
+
+ Fix typo in docstring
+
+ * lisp/help.el: Fix typo.
+
+2017-04-02 Michael Albinus <michael.albinus@gmx.de>
+
+ Apply connecion-local variables for shells
+
+ * doc/misc/tramp.texi (Remote processes): Show use of connection-local
+ variables. Don't mention Emacs 23 anymore.
+ (Frequently Asked Questions): Precise Emacs and MS Windows version.
+
+ * lisp/files-x.el (connection-local-normalize-criteria):
+ Suppress nil properties.
+ (connection-local-set-profiles, with-connection-local-profiles):
+ Adapt docstring.
+
+ * lisp/shell.el (shell): Apply connecion-local variables.
+
+2017-04-01 Evgeni Kolev <evgenysw@gmail.com> (tiny change)
+
+ Propertize only perl prototype chars `][$%&*;+@\' as punctuation
+
+ This prevents variables in signatures such as `sub add ($a, $b)' from
+ being treated as punctuation.
+ * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function):
+ Strictly match only prototype characters as punctuation. (Bug#26037)
+
+2017-04-01 Tom Tromey <tom@tromey.com>
+
+ fix two js-mode syntax propertization bugs
+
+ Bug#26070:
+ * lisp/progmodes/js.el (js--syntax-propertize-regexp-regexp): Add
+ zero-or-one to regular expression.
+ (js-syntax-propertize-regexp): Update. Propertize body of regexp
+ literal up to END.
+ * test/lisp/progmodes/js-tests.el (js-mode-propertize-bug-1)
+ (js-mode-propertize-bug-2): New tests.
+
+2017-04-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify test dependency generation
+
+ Generate default dependencies by using GNU extensions to ‘make’
+ rather than via a hacky auxiliary program and script.
+ * .gitignore: Remove test/make-test-deps.mk.
+ * test/Makefile.in (ELFILES, LOGFILES, TESTS):
+ Use :=, not =, to avoid multiple redundant invocations of ‘find’.
+ (test_template): Infer dependency directly instead of via
+ make-test-deps.mk.
+ (check-doit): Prepend ‘@’ to avoid excessively long ‘make’ output.
+ (clean): No need to clean make-test-deps.mk.
+ (make-test-deps.mk): Remove rule.
+ * test/make-test-deps.emacs-lisp: Remove.
+
+2017-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * test/lisp/emacs-lisp/cl-lib-tests.el: Improve symbol-macrolet tests
+
+ (cl-lib-symbol-macrolet): Fix last test so it doesn't break the whole
+ test suite.
+ (cl-lib-symbol-macrolet-2): New test.
+
+2017-04-01 Tino Calancha <tino.calancha@gmail.com>
+
+ Use only posix options in a ediff-ptch test
+
+ * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
+ Use just "-b" patch option. Don't assume a particular suffix for
+ the backup files.
+
+2017-04-01 Jarno Malmari <jarno@malmari.fi>
+
+ Initial implementation of HTTP Digest qop for url
+
+ This also refactors digest authentication functions in url-auth.el.
+
+ * lisp/url/url-auth.el (url-digest-auth, url-digest-auth-create-key):
+ (url-digest-auth-build-response, url-digest-auth-directory-id-assoc):
+ (url-digest-auth-name-value-string, url-digest-auth-source-creds):
+ (url-digest-cached-key, url-digest-cache-key, url-digest-find-creds):
+ (url-digest-find-new-key, url-digest-prompt-creds): Add new functions
+ to simplify code and aid in unit testing.
+ (url-digest-auth-build-response): Hook up new functionality, or fall
+ back to previous.
+ (url-digest-auth-make-request-digest-qop):
+ (url-digest-auth-make-cnonce, url-digest-auth-nonce-count):
+ (url-digest-auth-name-value-string): Add new helper functions.
+ * test/lisp/url/url-auth-tests.el (url-auth-test-colonjoin):
+ (url-auth-test-digest-ha1, url-auth-test-digest-ha2):
+ (url-auth-test-digest-request-digest): Add a few tests as now more
+ features are testable via intermediate functions.
+ (url-auth-test-challenges, url-auth-test-digest-request-digest): Test
+ the new implementation. Parts of these were accidentally already
+ merged in the past.
+
+2017-04-01 Tino Calancha <tino.calancha@gmail.com>
+
+ Tweak ediff-ptch test in previous commit a bit more
+
+ * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
+ Apply patches without requiring a shell. Add some comments.
+
+2017-03-31 Glenn Morris <rgm@gnu.org>
+
+ Tweak an ediff-ptch test
+
+ * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084):
+ Add skip conditions. Avoid going through shell where not needed.
+
+2017-03-31 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp-smb.el (tramp-smb-errors):
+
+ Add "NT_STATUS_PASSWORD_MUST_CHANGE".
+
+2017-03-31 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-symbol-macrolet): New test.
+
+2017-03-31 Tino Calancha <tino.calancha@gmail.com>
+
+ dired-mark-suffix: New command
+
+ Now dired-mark-extension prepends '.' to extension when not present.
+ Add command dired-mark-suffix to preserve the previous
+ behaviour (Bug#25942).
+ * lisp/dired-x.el (dired-mark-suffix): New command;
+ mark files ending in a given suffix.
+ (dired--mark-suffix-interactive-spec): New defun.
+ (dired-mark-extension, dired-mark-suffix): Use it.
+ * doc/misc/dired-x.texi (Advanced Mark Commands): Update manual.
+ * test/lisp/dired-x-tests.el: New test suite; add test for these features.
+
+2017-03-31 Tino Calancha <tino.calancha@gmail.com>
+
+ default-directory: Remark that it must be a directory name
+
+ * src/buffer.c (default-directory): Update docstring (Bug#26272).
+
+2017-03-31 Tino Calancha <tino.calancha@gmail.com>
+
+ Delete confuse statement in manual
+
+ * doc/misc/cl.texi (For Clauses): Delete confuse statement
+ and its example (Bug#23550).
+
+2017-03-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use find -delete if available
+
+ This shortens the ‘make’ output and should avoid some
+ repetitive scanning of directories during a build.
+ * configure.ac (FIND_DELETE): New var.
+ * lisp/Makefile.in (compile-always, bootstrap-clean):
+ * test/Makefile.in (clean, bootstrap-clean): Use it.
+ * test/Makefile.in (ELCFILES, LOGSAVEFILES): Remove; no longer needed.
+
+2017-03-31 Mark Oteiza <mvoteiza@udel.edu>
+
+ Remove gnus-boundp
+
+ * lisp/gnus/gnus-start.el (gnus-display-time-event-handler): Use
+ bound-and-true-p.
+ * lisp/gnus/gnus-util.el (gnus-boundp): Remove.
+
+2017-03-31 Niels Möller <nisse@lysator.liu.se> (tiny change)
+
+ Stop `fixup-whitespace' adding trailing whitespace (Bug#18783)
+
+ * lisp/simple.el (fixup-whitespace): Insert no spaces if point is at
+ end of line after deleting horizontal whitespace.
+
+2017-03-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/inotify.c (add_watch): Add comment.
+
+2017-03-31 Andreas Politz <politza@hochschule-trier.de>
+
+ Minor filenotify.el fixes
+
+ * lisp/filenotify.el: Require subr-x.
+ (file-notify-callback): Use equal, not eq.
+
+2017-03-31 Noam Postavsky <npostavs@gmail.com>
+
+ Improve packaging documentation
+
+ * doc/lispref/package.texi (Packaging Basics):
+ * doc/lispref/tips.texi (Library Headers): Clarify some header
+ formats, relation between file headers and package
+ attributes (Bug#13281).
+
+2017-03-31 John Mastro <john.b.mastro@gmail.com>
+
+ Fix a small incompatibility in ibuffer
+
+ Translate nil values from column functions to the empty string, so that
+ subsequent calls to string-width don't signal an error (Bug#26317).
+ * lisp/ibuffer.el (ibuffer-compile-format): If a column function returns
+ nil, treat it like the empty string.
+
+2017-03-30 Alan Mackenzie <acm@muc.de>
+
+ Fix C++ fontification problems 500 bytes after typing a space, and other bugs
+
+ Also implement the "asymmetric space" rule for fontifying otherwise
+ ambiguous
+ declarations/expressions.
+
+ * lisp/progmodes/cc-engine.el (c-before-change-check-<>-operators): Don't set
+ c-new-BEG or c-new-END when there is no need.
+ (c-forward-decl-or-cast-1): Add "CASE 17.5" to implement the "asymmetric
+ space" rule.
+
+ * lisp/progmodes/cc-fonts.el (c-get-fontification-context): New function,
+ extracted from c-font-lock-declarations. Add to this function processing to
+ make `context' 'decl for lines contained within parens when these are also
+ declarations.
+ (c-font-lock-declarations): Call the newly extracted function above in place
+ of inline code.
+
+ * lisp/progmodes/cc-mode.el (c-fl-decl-start): Set point before calling
+ c-literal-start.
+
+ * lisp/progmodes/cc-vars.el (c-asymmetry-fontification-flag): New user option.
+
+ * doc/misc/cc-mode.texi (Misc Font Locking): New node documenting the new
+ "asymmetric fontification" rule, including the variable
+ c-asymmetric-fontification-flag.
+
+2017-03-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Some inotify cleanup
+
+ This catches some problems with integer overflow and races
+ that I noticed in inotify.c after reviewing the changes
+ installed to fix Bug#26126.
+ * src/fns.c, src/lisp.h (equal_no_quit): Now extern.
+ * src/inotify.c (aspect_to_inotifymask):
+ Check for cycles and for improper lists.
+ (make_lispy_mask, lispy_mask_match_p): Remove.
+ All callers changed to use INTEGER_TO_CONS and CONS_TO_INTEGER.
+ (inotifyevent_to_event, add_watch):
+ Don’t assume watch descriptors and cookies fit in fixnums.
+ (add_watch): Use assoc_no_quit, not Fassoc.
+ Avoid integer overflow in (very!) long-running processes where
+ the Emacs watch ID could overflow. Avoid some duplicate code.
+ (find_descriptor): New function.
+ (remove_descriptor): First arg is now the returned value from
+ find_descriptor, rather than the descriptor. This way, the
+ value can be removed without calling Fdelete, which might quit.
+ Wait until the end (when watch_list is consistent) before signaling
+ any errors.
+ (remove_watch, inotify_callback):
+ Use find_descriptor to avoid the need for Fdelete.
+ (inotify_callback): Use simpler tests for ioctl failure.
+ Free temporary buffer if signaled, and put it on the stack if small.
+ Use ssize_t to index through read results, to avoid a cast.
+ (valid_watch_descriptor): New function, with a tighter check.
+ (Finotify_rm_watch, Finotify_valid_p): Use it.
+ (Finotify_valid_p): Use assoc_no_quit and ass_no_quit instead
+ of Fassoc. Do not assume the first assoc succeeds.
+ * test/src/inotify-tests.el (inotify-valid-p-simple):
+ Add inotify-valid-p tests, some of which dump core without
+ the fixes noted above.
+
+2017-03-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp-sh.el (tramp-get-remote-locale): Add "C.UTF-8" as candidate.
+
+2017-03-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/cedet/semantic/wisent/wisent.el (wisent-automaton-p): Use obarrayp.
+
+2017-03-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix assoc_no_quit so that it does not quit
+
+ The problem was that it called Fequal, which can quit.
+ * src/fns.c (enum equal_kind):
+ New enum, to be used in place of a boolean.
+ (equal_no_quit): New function.
+ (Fmemql, Feql): Use it to compare floats, as a minor tuneup.
+ (assoc_no_quit): Use it to avoid quitting, the main point here.
+ (internal_equal): Generalize bool to enum equal_kind arg, so that
+ there are now 3 possibilities instead of 2. Do not signal an
+ error if EQUAL_NO_QUIT. Put the arg before the depth, since depth
+ should be irrelevant if the arg is EQUAL_NO_QUIT. All callers
+ changed.
+
+2017-03-29 Alan Mackenzie <acm@muc.de>
+
+ Amend gitmerge to recognize the injunction "don't merge".
+
+ * admin/gitmerge.el (gitmerge-skip-regexp): amend regexp to match "don't" as
+ well as "do not".
+
+2017-03-29 Simen Heggestøyl <simenheg@gmail.com>
+
+ Add one more CSS pseudo-class
+
+ * lisp/textmodes/css-mode.el (css-pseudo-class-ids): Add
+ `focus-within'.
+
+2017-03-29 Simen Heggestøyl <simenheg@gmail.com>
+
+ Update list of CSS pseudo-classes
+
+ * lisp/textmodes/css-mode.el (css-pseudo-class-ids): Update list of
+ pseudo-classes.
+
+2017-03-29 Noam Postavsky <npostavs@gmail.com>
+
+ Adjust some search failure errors in info.el
+
+ * lisp/info.el (Info-select-node): The search for beginning of node is
+ an internal detail, and is not normally expected to fail, so it should
+ not be a user error.
+ (Info-complete-menu-item): Failing to find a menu indicates the user
+ searched for a menu when there isn't one, so change to `use-error'.
+
+2017-03-28 Alan Mackenzie <acm@muc.de>
+
+ * lisp/progmodes/cc-defs.el (c-version): Restore c-version to 5.33
+
+2017-03-28 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t mishandle (format "%i" -1.0)
+
+ * src/editfns.c (styled_format): Treat %i like %d when converting arg.
+
+2017-03-28 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/emacs-lisp/ert.el (ert-run-tests): Make INTERACTIVE arg optional.
+
+2017-03-28 Michael Albinus <michael.albinus@gmx.de>
+
+ * src/inotify.c (Finotify_add_watch): aspect can also be a symbol.
+
+2017-03-28 Noam Postavsky <npostavs@gmail.com>
+
+ Don't add `search-failed' to ignored errors in info.el (Bug#6106)
+
+ * lisp/info.el: Stop adding `search-failed' to `debug-ignored-errors'.
+ (Info-select-node, Info-search): Replace (signal 'search-failed ...)
+ with (user-error "Search failed: "...).
+
+2017-03-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix obsolete ‘test/automated’ references
+
+ * Makefile.in (mostlyclean, clean, maybeclean_dirs, distclean)
+ (bootstrap-clean, maintainer-clean):
+ Clean ‘test’, not ‘test/automated’. Test for existence of
+ subdirectory only for ‘test’, not for directories that should
+ always exist.
+ * admin/MAINTAINERS, etc/TODO, lisp/emacs-lisp/bytecomp.el:
+ * lisp/emacs-lisp/seq.el, lisp/emacs-lisp/thunk.el:
+ * lisp/man.el (Man-parse-man-k):
+ * lisp/url/url-domsuf.el, make-dist:
+ * test/file-organization.org:
+ Fix obsolete references to test/automated.
+
+2017-03-27 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ shr-image-fetched: Work for narrowed Gnus article
+
+ See <8737e3msun.fsf@gmail.com> of bug#26231 in the bug-gnu-emacs list.
+
+ * lisp/net/shr.el (shr-image-fetched): Work for narrowed article.
+
+2017-03-27 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/net/tramp.el (tramp-file-name-handler): Autoload it.
+
+2017-03-27 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Expand manual section on quitting windows
+
+ * doc/lispref/windows.texi (Quitting Windows): Provide more
+ information about the elements of the quit-restore window parameter,
+ and how they affect the behavior of quit-restore-window.
+
+2017-03-26 Philipp Stephani <phst@google.com>
+
+ Add check for expected backtrace in module calls.
+
+ * test/manual/cedet/tests/test.el
+ (mod-test-non-local-exit-signal-test): Compare actual backtrace to
+ expected backtrace.
+
+2017-03-26 Eli Zaretskii <eliz@gnu.org>
+
+ Fix redisplay glitches due to recent change in redisplay_internal
+
+ * src/xdisp.c (redisplay_internal): A better fix for bug#26097.
+ See https://lists.gnu.org/r/emacs-devel/2017-03/msg00695.html
+ for the problems caused by the original fix.
+
+2017-03-26 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#26258
+
+ * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
+ * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist):
+ * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist):
+ Autoload. Call `tramp-register-foreign-file-name-handler'. (Bug#26258)
+
+ * lisp/net/tramp.el (tramp-autoload-file-name-handler): Remove.
+ (tramp-register-autoload-file-name-handlers)
+ (tramp-register-file-name-handlers): Do not handle
+ `tramp-autoload-file-name-handler' anymore. Mark `operations'
+ the handlers are responsible for.
+ (tramp-register-foreign-file-name-handler): New defun.
+
+2017-03-26 Noam Postavsky <npostavs@gmail.com>
+
+ Fix docstring of dabbrev-abbrev-char-regexp
+
+ * lisp/dabbrev.el (dabbrev-abbrev-char-regexp): Using a value of nil
+ is equivalent to "\\sw\\|\\s_", and has no special behavior. If the
+ previous character doesn't match, we search backwards for one that
+ does, not throw an error. Replace Lisp example with C based one to
+ make it clear that "symbol" means a sequence of word and symbol
+ constituent characters, not a Lisp symbol (Bug#358).
+
+2017-03-26 Johan Claesson <johanclaesson@bredband.net> (tiny change)
+
+ * doc/misc/cl.texi (Iteration Clauses): Clarify example (Bug#19515).
+
+2017-03-26 Andreas Politz <politza@hochschule-trier.de>
+
+ Minor fixes for inotify.c and filenotify.el
+
+ * lisp/filenotify.el (file-notify--watch-absolute-filename):
+ Add docstring.
+ (file-notify-callback): Simplify.
+
+ * src/inotify.c (Finotify_add_watch): Adapt docstring.
+
+2017-03-26 Andreas Politz <politza@hochschule-trier.de>
+
+ Fix issues regarding inotify file-notification
+
+ Remove special code handling the inotify back-end.
+ * lisp/filenotify.el (file-notify--watch): New struct
+ representing a file-watch.
+ (file-notify-descriptors): Use the new struct as hash-value.
+ (file-notify-handle-event): Check that event is a cons.
+ (file-notify--rm-descriptor, file-notify--event-watched-file)
+ (file-notify--event-file-name, file-notify--event-file1-name)
+ (file-notify-callback, file-notify-add-watch)
+ (file-notify-rm-watch, file-notify-valid-p): Use new struct.
+ Remove special code handling inotify descriptors. Remove code
+ handling multiple clients per descriptor.
+ (file-notify--descriptor): Remove unused function.
+
+ Let inotify-add-watch return a unique descriptor on every
+ call, like every other back-end does (Bug#26126). Prevent
+ multiple clients from interfering with each other, when
+ watching a shared descriptor.
+ * src/inotify.c (watch_list): Extend the format by including a
+ id and the provided mask.
+ (INOTIFY_DEFAULT_MASK): Default mask used for all clients.
+ (make_watch_descriptor): Removed.
+ (make_lispy_mask, lispy_mask_match_p): New functions.
+ (inotifyevent_to_event): Match event against the mask provided
+ by the client.
+ (add_watch, remove_descriptor, remove_watch): New functions
+ for managing the watch_list.
+ (inotify_callback): Use the new functions.
+ (Finotify_add_watch, Finotify_rm_watch): Remove deprecated
+ flags from documentation. Add check for validity of provided
+ descriptor. Use the new functions. Use the default mask.
+ (INOTIFY_DEBUG): Add new debug conditional.
+ (inotify-watch-list, inotify-allocated-p): New debug functions.
+ (symbol_to_inotifymask, syms_of_inotify): Remove deprecated symbols.
+
+ * test/lisp/filenotify-tests.el:
+ (file-notify-test02-rm-watch): Remove expected failure for inotify.
+
+2017-03-26 Paul Pogonyshev <pogonyshev@gmail.com>
+
+ * lisp/emacs-lisp/pcase.el (pcase): Comment debug message (Bug#26177).
+
+2017-03-25 Jens Uwe Schmidt <ju.schmidt@gmx.de> (tiny change)
+
+ Stop edebug getting stuck on backquote (Bug#23651)
+
+ * lisp/emacs-lisp/edebug.el (edebug-read-sexp): Move forward after
+ reading backquote or comma.
+
+2017-03-25 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Expand manual section on quitting windows
+
+ * doc/lispref/windows.texi (Quitting Windows): Provide more
+ information about the elements of the quit-restore window parameter,
+ and how they affect the behavior of quit-restore-window.
+
+2017-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ Support in ispell.el multiple dictionaries loaded by Hunspell
+
+ * lisp/textmodes/ispell.el (ispell-find-hunspell-dictionaries):
+ Support Hunspell configurations that load more than one dictionary
+ by default. Doc fix. (Bug#25830)
+
+2017-03-25 Michael Albinus <michael.albinus@gmx.de>
+
+ Simplify Tramp autoloading.
+
+ * lisp/net/tramp.el (tramp-completion-file-name-handler):
+ Simplify autoloading. Give it the `operations' property.
+ (tramp-completion-handle-expand-file-name): Remove.
+
+2017-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a segfault due to failure to realize some faces
+
+ * src/xdisp.c (redisplay_internal): If the frame becomes garbaged
+ while redisplaying its windows, redisplay all of its windows
+ again. (Bug#26097)
+ (init_iterator): When freeing all realized faces on all frames,
+ reset the 'face_change' flag of the frame whose window we are
+ about to iterate.
+
+2017-03-25 Philipp Stephani <phst@google.com>
+
+ Use a named function for 'safe-local-variable
+
+ This improves the help screen for `version-control' (Bug#25431).
+
+ * lisp/files.el (version-control-safe-local-p): New function.
+ (version-control): Use it.
+
+2017-03-25 Eli Zaretskii <eliz@gnu.org>
+
+ ;* doc/misc/info.texi (Choose menu subtopic): Improve indexing. (Bug#26236)
+
+2017-03-25 Helmut Eller <eller.helmut@gmail.com>
+
+ Make it easier to abort a series of tests with C-g
+
+ * lisp/emacs-lisp/ert.el (ert-run-tests): Add "interactively" arg. If
+ interactively is true and a test was aborted then ask if the remaining
+ tests should be aborted too.
+ (ert-run-tests-batch, ert-run-tests-interactively): Pass in
+ interactively arg.
+
+2017-03-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t require chown/chgrp for game installation
+
+ Problem reported by Joseph Mingrone in:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00622.html
+ * lib-src/Makefile.in (exp_archlibdir): Don’t fail if chown or
+ chgrp fails with update-game-score and the game directory.
+ Instead, expect the installer to fix this up afterwards.
+
+2017-03-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/lisp-mode.el: Don't highlight \( at BOL
+
+ (elisp--font-lock-backslash): Extract from lisp-el-font-lock-keywords-2.
+ Don't highlight \ at BOL. Don't assume syntax-ppss preserves match-data.
+
+2017-03-23 Philipp Stephani <phst@google.com>
+
+ Protect against an infloop in python-mode
+
+ There appears to be an edge case caused by using `syntax-ppss' in a
+ narrowed buffer during JIT lock inside of Python triple-quote strings.
+ Unfortunately it is impossible to reproduce without manually
+ destroying the syntactic information in the Python buffer, but it has
+ been observed in practice. In that case it can happen that the syntax
+ caches get sufficiently out of whack so that there appear to be
+ overlapping strings in the buffer. As Python has no nested strings,
+ this situation is impossible and leads to an infloop in
+ `python-nav-end-of-statement'. Protect against this by checking
+ whether the search for the end of the current string makes progress.
+
+ * lisp/progmodes/python.el (python-nav-end-of-statement): Protect
+ against infloop.
+ * test/lisp/progmodes/python-tests.el
+ (python-tests--python-nav-end-of-statement--infloop): Add unit test.
+
+2017-03-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/lispref/os.texi (File Notifications):
+
+ Strengthen the recommendation to use filenotify.el.
+
+2017-03-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-03-22 getopt: merge from glibc
+ * build-aux/config.sub, lib/getopt.c, lib/getopt.in.h:
+ * lib/getopt1.c, lib/getopt_int.h: Copy from gnulib.
+ * lib/gnulib.mk.in: Regenerate.
+
+2017-03-23 Michael Albinus <michael.albinus@gmx.de>
+
+ Use lexical-bind in Tramp
+
+ * lisp/net/tramp*.el: Add lexical-binding cookie. Move declarations up.
+
+ * lisp/net/tramp-adb.el (tramp-adb-parse-device-names): Use `push'
+ rather than `add-to-list'.
+ (tramp-adb-get-device): Remove unused variable.
+
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-parse-device-names): Remove unused
+ variable.
+
+ * lisp/net/tramp.el (auto-save-file-name-transforms): Declare.
+ (tramp-find-file-name-coding-system-alist): Use `push' rather
+ than `add-to-list'.
+
+ * test/lisp/net/tramp-tests.el: Add lexical-binding cookie.
+ Require 'dired. Move declarations up.
+ (tramp-test32-make-nearby-temp-file): Wrap `make-nearby-temp-file'
+ and `temporary-file-directory' calls with `with-no-warnings'.
+ (tramp-test35-asynchronous-requests): Mark unused variable.
+
+2017-03-23 Kaushal Modi <kaushal.modi@gmail.com>
+ Noam Postavsky <npostavs@gmail.com>
+
+ Do not include comment start chars in ffap string
+
+ * lisp/ffap.el (ffap-string-at-point): If the point is in a comment,
+ ensure that the returned string does not contain the comment start
+ characters (especially for major modes that have '//' as comment start
+ characters). Otherwise, in a major mode like c-mode, with `ido-mode'
+ enabled and `ido-use-filename-at-point' set to `guess', doing "C-x
+ C-f" on a "//foo" comment will initiate an attempt to access a path
+ "//foo" (Bug#24057).
+
+2017-03-23 Martin Rudalics <rudalics@gmx.at>
+
+ c:/Temp/gtk-window-move/ChangeLog.txt
+
+2017-03-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix filenotify.el issue for kqueue
+
+ * lisp/filenotify.el (file-notify-add-watch): Use directory
+ for remote file name handlers.
+
+ * test/lisp/filenotify-tests.el (file-notify-test01-add-watch):
+ Create/delete temporary file only for "kqueue".
+ (file-notify-test02-rm-watch): Create/delete temporary files.
+
+2017-03-22 Michael Albinus <michael.albinus@gmx.de>
+
+ Extend `file-notify-test02-rm-watch'
+
+ * test/lisp/filenotify-tests.el (file-notify-test02-rm-watch):
+ Expect it failed for inotify. Divide tests into different
+ `unwind-protect' clauses. Check, that removing watch
+ descriptors out of order do not harm. (Bug#26126)
+
+2017-03-22 Noam Postavsky <npostavs@gmail.com>
+
+ * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-subsexp): Test for Bug#26187
+
+2017-03-22 Graham Dobbins <gdobbins@protonmail.com> (tiny change)
+
+ * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Fix null endpos case
+
+2017-03-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve configure --with-pop etc. diagnostics
+
+ * configure.ac: Improve diagnostics re --with-pop and
+ --with-mailutils (Bug#26102).
+
+2017-03-21 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "Make --without-pop the default."
+
+ This reverts commit 9319de675e395517f9a7b50cae1a3aad9cd0abc2.
+
+2017-03-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don’t remove dependency files when configuring
+
+ Problem reported by Tom Tromey in:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00533.html
+ * configure.ac: Don’t remove */*.o and */deps/* when
+ --enable-autodepend is in effect.
+
+2017-03-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make --without-pop the default.
+
+ Suggested by Angelo Graziosi in:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00431.html
+ * configure.ac: Change the default from --with-pop to
+ --without-pop. Adjust diagnostics to match.
+
+2017-03-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Streamline dependency-file generation
+
+ * configure.ac (AUTODEPEND_PARENTS): New var.
+ mkdir the dependency directories here, to simplify ‘make’.
+ Remove dependency files just before outputting Makefiles, so that
+ they are preserved if ‘configure’ exits early due to some other problem.
+ * lib/Makefile.in, lwlib/Makefile.in, oldXMenu/Makefile.in:
+ * src/Makefile.in: Adjust deps strategies to be similar, as follows:
+ (MKDEPDIR): Remove. All uses removed. This cuts down on the
+ number of processes spun off by ‘make’.
+ (clean mostlyclean): Remove $(DEPDIR) contents, not $(DEPDIR) itself.
+ (distclean): Remove $(DEPDIR) itself.
+ * lwlib/Makefile.in (all): Move to front, so that depdir includes
+ do not alter default action.
+
+2017-03-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port and simplify example sh script
+
+ * doc/misc/org.texi (noweb-ref): Simplify shell script example and
+ don’t use ‘tail -1’, which is not portable.
+
+2017-03-21 Noam Postavsky <npostavs@gmail.com>
+
+ Narrow scope of modification hook renabling in org-src fontification
+
+ Modification hooks should be enabled while modifying text in the
+ org-src temp buffer, but in 2017-01-29 "Call modification hooks in
+ org-src fontify buffers" the hooks were enabled also for modifications
+ to the original org buffer. This causes fontification errors when
+ combined with certain packages, as reported in
+ https://lists.gnu.org/r/emacs-orgmode/2017-03/msg00420.html.
+
+ * lisp/org/org-src.el (org-src-font-lock-fontify-block): Reduce scope
+ of inhibit-modification-hooks let-binding.
+
+2017-03-21 Tino Calancha <tino.calancha@gmail.com>
+
+ epatch: Save right backups in Git multipatches
+
+ Multipatches on N Git files save wrong backups for
+ N-1 files; only the last one has a correct backup (Bug#26084).
+ * lisp/vc/diff-mode.el (diff-file-junk-re): Add 'Prereq: '
+ * lisp/vc/ediff-ptch.el (ediff-map-patch-buffer): Use 'diff-file-junk-re'.
+ * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug25010):
+ Rename from ibuffer-test-bug25010.
+ (ediff-ptch-test-bug26084): New test.
+
+2017-03-21 Michael R. Mauger <michael@mauger.com>
+
+ * lisp/progmodes/sql.el: Version 3.6
+
+ (sql-login-params): Added :must-match for completition of
+ `server' and `database' login parameters.
+ (sql-sqlite-login-params, sql-postgres-login-params): Set
+ :must-match to `confirm'.
+ (sql-get-login-ext): Use :must-match value to control
+ `read-file-name' or `completing-read'.
+ (sql-connect): Added optional BUF-NAME parameter; Reworked
+ connection variable processing; Pass buffer name to
+ `sql-product-interactive'.
+ (sql-product-interactive): Pass buffer name along.
+ (sql-comint): Add optional BUF-NAME and calculate reasonable default.
+ (sql-comint-oracle, sql-sybase-comint, sql-comint-informix)
+ (sql-comint-sqlite, sql-comint-mysql, sql-comint-solid)
+ (sql-comint-ingres, sql-comint-ms, sql-comint-postgres)
+ (sql-comint-interbase, sql-comint-db2, sql-comint-linter)
+ (sql-comint-vertica): Add optional BUF-NAME, pass to
+ `sql-comint'.
+ (sql-oracle--list-oracle-name): New function.
+ (sql-oracle-list-all): Use it.
+ (sql-oracle-completion-object): Enhanced.
+
+2017-03-20 Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+ Solve ses-recalculate-cell updating only current line bug.
+
+ * lisp/ses.el (ses-recalculate-cell): Add optional argument
+ ses--curcell to avoid overwriting ses--curcell when function is
+ called from ses-recalculate-all. Update docstring accordingly.
+ (ses-recalculate-all): Call ses-recalculate-cell with argument
+ ses--curcell to avoid its overwriting.
+
+2017-03-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix problem with out-of-date dependencies
+
+ Problem reported by Robert Marshall in:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00501.html
+ Although this problem has been with us for a while, the recent
+ change from Automake to GNU Make exposed it again.
+ * configure.ac (AUTO_DEPEND): When autodepending, clean out any
+ leftover dependency and object files, since the previous sources'
+ dependencies may disagree with the current ones. Reconfiguring
+ typically needs to force a rebuild anyway.
+
+2017-03-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Simpler filter implementation
+
+ * lisp/play/dunnet.el (dun-endgame-question): Get or set
+ dun-endgame-questions one time only. Use dolist and an index to
+ prune the list.
+
+2017-03-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/button.el (forward-button): Use user-error instead.
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This gets Emacs working again with HP-UX Itanium cc.
+ It incorporates:
+ 2017-03-19 stdalign: tweak version# and test for HP-UX IA64
+ 2017-03-18 stdalign: restore previous behavior for HP-UX IA64
+ 2017-03-17 stat-time, timespec: Support header files in C++ mode
+ 2017-03-17 stdalign: Make it work with HP-UX cc
+ 2017-03-17 flexmember: try to detect HP-UX 11.31 cc bug
+ 2017-03-16 stdint: Fix test compilation failure with HP-UX 11 cc.
+ 2017-03-14 gnulib-tool: don't produce tests with only snippets
+ 2017-03-14 limits-h: Make it work with HP-UX cc.
+ * etc/PROBLEMS: Remove now-obsolete entry for HP-UX 11.31.
+ * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate.
+ * lib/limits.in.h, lib/stat-time.h, lib/stdalign.in.h:
+ * lib/stdint.in.h, lib/timespec.h, m4/flexmember.m4, m4/stdalign.m4:
+ Copy from gnulib.
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ * ChangeLog.2: Merge from emacs-25.
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fixups after merge from emacs-25
+
+ * etc/NEWS: Remove stray entry.
+ * etc/NEWS.25: Copy from Emacs emacs-25 etc/NEWS.
+ * lisp/textmodes/rst.el (rst-package-emacs-version-alist):
+ Make it nondecreasing.
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ d71e071 Improve documentation of interactive "r".
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ a094732 * etc/PROBLEMS: Say that HP-UX cc doesn't work.
+ 1925dd9 Fix duplicate wording in Emacs manual
+ 6de8429 * lisp/paren.el (show-paren--default, show-paren-function): A...
+ 2d671fd Fix wording in Emacs manual
+ a8766a2 Document how to customize input methods
+ 6eb8995 * lisp/net/eww.el (eww-reload): Doc fix. (Bug#25981)
+ aceac95 Fix warning message about native completion (Bug#25984)
+ a314c1f Clarify documentation of 'raise' and 'height' display specs
+ f366f6e Mention problems with GPaste in PROBLEMS
+ 6e788ef ; etc/PROBLEMS: Explain about the python+libedit problem (Bug...
+ 6406618 Fix doc strings in info.el
+ c1ed152 ; * src/keyboard.c (Fposn_at_point): Fix last change.
+ eed9677 Fix doc string of 'posn-at-point'
+ 0d5957e Documentation fix in elisp reference manual
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ ec4226d * lisp/woman.el (woman): Fix docstring prefix arg description.
+ 2b774fa Mention "editor" in Emacs man page header
+ ae60d0c Document problems with nerd-fonts
+ 2fdb5a9 ; Details about pinning Emacs to w32 task bar
+ 5c3105e * doc/lispref/modes.texi (Derived Modes): Make example more i...
+ 4c51ef4 Clarify what is the "cursor"
+ 8303c32 ; * etc/NEWS: Copyedits.
+ 3f7493e ; Fix a typo in comment
+ c54cf8d Improve commentary in lisp.h
+ 8b92f86 ; * admin/make-tarball.txt: Cross-reference admin/release-pro...
+ 0ba9932 Disable native completion for ipython (Bug#25067)
+ 38fc456 Fix a typo in ada-mode manual
+ 00e75ba ; * src/coding.c (Fencode_coding_region): Fix a typo in the d...
+ a541c21 Clarify documentation of 'bufferpos-to-filepos' and 'filepos-...
+
+ # Conflicts:
+ # etc/NEWS
+ # etc/PROBLEMS
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 02d9ad8 * admin/make-tarball.txt: Add documentation regarding the rel...
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ e1171de * CONTRIBUTE (Documenting your changes): Index new vars/comma...
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ ab0a60a ; * CONTRIBUTE (Generating ChangeLog entries): Drop duplicate...
+ 7e02a47 Index byte-compile-debug
+ 7c1e598 Document `byte-compile-debug' in the ELisp manual
+ 4d81eb4 Document variable `byte-compile-debug'
+ 72ef710 Fix call to debugger on assertion failure
+ ae8264c Call modification hooks in org-src fontify buffers
+ b3139da ; Fix last change in doc/lispref/strings.texi
+ c331f39 Improve documentation of 'format' conversions
+ 9f52f67 Remove stale functions from ert manual
+ c416b14 Fix a typo in Eshell manual
+ 06695a0 ; Fix a typo in ediff-merg.el
+ 954e9e9 Improve documentation of hooks related to saving buffers
+ 9fcab85 Improve documentation of auto-save-visited-file-name
+ 2236c53 fix typo in mailcap-mime-extensions
+ 85a3e4e Fix typos in flymake.el
+ a1ef10e More NEWS checking for admin.el's set-version
+
+ # Conflicts:
+ # lisp/emacs-lisp/bytecomp.el
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 5569e64 ; Spelling fixes
+ 24a5f57 * lisp/net/eww.el (eww-tag-meta): Handle single quoted URLs (...
+ 9b89896 * lisp/progmodes/sql.el (sql-product-alist): Doc tweak
+ 69b50f5 * lisp/progmodes/sql.el (sql-product-alist): Doc fix. (Bug#2...
+ 42eae54 Improve documentation of dabbrevs
+ b0ade0d Clarify that easy-menu-add is a nop (Bug#25382)
+ 3c69f2c * lisp/textmodes/rst.el (rst-package-emacs-version-alist): Fi...
+
+ # Conflicts:
+ # lisp/textmodes/rst.el
+
+2017-03-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 0e35405 Improve documentation of coding-systems
+ c2fd04c Improve definition of 'variable-pitch' face on MS-Windows
+ 16fb50d Fix an error message in python.el
+ a2a2073 Clarify major mode switching
+ fc38671 Add helpful comment to compile-command's docstring
+ ee65d85 Fix ':version' of 'select-enable-primary'
+
+2017-03-19 Paul Pogonyshev <pogonyshev@gmail.com>
+
+ Fix bug in generator function with pcase (Bug#26068)
+
+ * lisp/emacs-lisp/cl-macs.el (cl--sm-macroexpand): Remove some calls
+ to symbol-name.
+
+2017-03-19 Alan Mackenzie <acm@muc.de>
+
+ Fix chaotic indentation of C++ lambda. Enhance documentation thereof
+
+ * lisp/progmodes/cc-engine.el (c-looking-at-inexpr-block): qualify an
+ invocation of c-on-identifier with a check we're not at the _end_ of an
+ identifier.
+
+ * doc/misc/cc-mode.texi: (Tex title page): Remove @subtitlefont because the
+ perl versions of texi2dvi haven't implemented it.
+ (Syntactic Symbols): Note that `inlambda' is also used in C++ Mode, not just
+ in Pike Mode.
+ (Statement Block Symbols): Add a section illustrating a C++ lambda function.
+ (FAQ): Add a question about "excessive" indentation of the contents of a C++
+ lambda function, and how to get rid of it.
+
+2017-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Remove unused vars in cl-extra.el and tramp.el.
+
+ * lisp/emacs-lisp/cl-extra.el (cl--print-table): Remove unused vars.
+
+ * lisp/net/tramp.el (tramp-dissect-file-name): Remove unused `match'.
+ (outline-regexp, ls-lisp-use-insert-directory-program): Declare.
+ (tramp-find-foreign-file-name-handler): Mark unused arg, remove unused `v`.
+
+2017-03-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Improve describe-symbol's layout of slots when describing types
+
+ * lisp/emacs-lisp/cl-extra.el (cl--print-table): New function.
+ (cl--describe-class-slots): Use it.
+
+2017-03-18 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#26156
+
+ * lisp/net/tramp.el (tramp-completion-file-name-handler-alist):
+ <expand-file-name>: Remove handler. (Bug#26156)
+
+2017-03-18 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/obarray.el (obarray-size): Avoid compiler warning.
+
+2017-03-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change in lib/Makefile.in
+
+ * lib/Makefile.in (srcdir): Define, as including
+ $(srcdir)/../nt/gnulib-cfg.mk needs that.
+
+2017-03-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ * configure.ac: Fix typo in diagnostic.
+
+2017-03-18 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port out-of-source builds to windows-nt
+
+ Problem reported by Angelo Graziosi in:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00431.html
+ * lib/Makefile.in: Prepend $(srcdir) to ../nt/gnulib-cfg.mk,
+ to handle out-of-source builds if windows-nt.
+
+2017-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ MS-Windows followup for switch from Automake
+
+ * nt/INSTALL:
+ * nt/INSTALL.W64: Remove references to Automake. (Bug#26100)
+
+2017-03-17 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of interactive "r".
+
+ * doc/lispref/commands.texi (Interactive Codes): Mention that mark
+ must be set for "r" to work.
+
+2017-03-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fixups for GNU Make switchover
+
+ This fixes some minor problems introduced in the recent switch to GNU
+ Make, discovered by further testing. Without some of these changes
+ 'make -j' would sometimes have race conditions caused by missing
+ dependencies. (Bug#26100)
+ * .gitignore: Remove src/stamp-h.in, src/stamp-h1.
+ * Makefile.in ($(MAKEFILE_NAME)): Depend on configure, not
+ src/config.in, since the former's timestamp now represents
+ the latter's.
+ ($(srcdir)/configure): Use plain ./autogen.sh, for consistency
+ with other autogen.sh invocations.
+ ($(srcdir)/src/stamp-h.in):
+ Remove rule, as this file is no longer created.
+ * Makefile.in (top_distclean):
+ * src/Makefile.in (bootstrap-clean):
+ No need to remove stamp-h1, as that was an Automake byproduct
+ and Automake is no longer in use.
+ * lib/Makefile.in, src/Makefile.in:
+ (AUTOCONF_INPUTS, $(top_srcdir)/configure): Remove.
+ (../config.status, Makefile): Simplify by limiting dependencies
+ to files we care about and files in the repository, and by
+ using just one file to represent the timestamps on multiple
+ targets updated by the same rule.
+ * autogen.sh: Do not create or use src/stamp-h.in.
+ Instead, have 'find' test the two output files directly.
+
+2017-03-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Switch from Automake to GNU Make
+
+ Emacs assumes GNU Make, and GNU Make has much of the functionality of
+ Automake built-in. The Emacs build process uses Automake primarily
+ because Emacs uses some Gnulib code and Gnulib formerly required
+ Automake. Now that Gnulib no longer requires Automake, Emacs can
+ stop using Automake and this should simplify Emacs maintenance
+ in the future (Bug#26100). Although this patch may look long, most of
+ it is generated automatically: the changes to build-aux/config.guess,
+ build-aux/config.sub, build-aux/install-sh, and lib/gnulib.mk.in are
+ all done by admin/merge-gnulib.
+ * .gitignore: Remove build-aux/ar-lib, build-aux/compile,
+ build-aux/config.guess, build-aux/config.sub, build-aux/depcomp,
+ build-aux/install-sh, build-aux/missing, and lib/Makefile.in,
+ as they are no longer built by autogen.sh.
+ Add lib/gnulib.mk, as it is now built by 'configure'.
+ Remove nt/gnulib.mk, as it is no longer built by 'make'.
+ * INSTALL.REPO, README, admin/make-tarball.txt:
+ Remove mention of Automake.
+ * Makefile.in (AUTOCONF, AUTOMAKE, AUTOHEADER, ACLOCAL, lib)
+ (AUTOCONF_INPUTS, ACLOCAL_PATH, ACLOCAL_INPUTS)
+ ($(srcdir)/aclocal.m4, AUTOMAKE_INPUTS)
+ ($(srcdir)/lib/Makefile.in, $(srcdir)/nt/gnulib.mk, am--refresh):
+ Remove.
+ ($(MAKEFILE_NAME)): Depend on lib/gnulib.mk.in.
+ ($(srcdir)/configure, $(srcdir)/src/stamp-h.in)
+ ($(srcdir)/src/config.in):
+ Use autogen.sh instead of doing it by hand.
+ * admin/merge-gnulib (AVOIDED_MODULES, avoided_flags)):
+ New vars, to simplify processing of avoided modules.
+ (GNULIB_TOOL_FLAGS): Move --avoid flags into AVOIDED_MODULES.
+ Add --gnu-make, and change makefile name to gnulib.mk.in.
+ Copy config.guess, config.sub, and install-sh too, since
+ Automake no longer does that for us.
+ * admin/notes/copyright:
+ * admin/update_autogen (genfiles):
+ Update list of files.
+ Remove hack for nt/gnulib.mk, a file that is no longer needed.
+ * autogen.sh (progs): Remove Automake.
+ (automake_min): Remove.
+ Build aclocal.m4 so that autoreconf need not use aclocal.
+ * build-aux/config.guess, build-aux/config.sub:
+ * build-aux/install-sh:
+ New files, copied from Gnulib. These are now updated by
+ admin/merge-gnulib instead by autogen.sh.
+ * configure.ac (AC_PROG_MAKE_SET, ACLOCAL_PATH, AM_CONDITIONAL):
+ Remove.
+ (AM_INIT_AUTOMAKE, AM_SILENT_RULES): Remove call.
+ (AC_PROG_CC_C_O): Call this instead of AM_PROG_CC_C_O.
+ (BUILDING_FOR_WINDOWSNT, HYBRID_MALLOC_LIB): Remove; no longer needed.
+ (--disable-silent-rules): New option, since Automake no longer
+ does this for us.
+ (AM_V, AM_DEFAULT_V): Set unconditionally, and do not bother
+ with AM_SUBST_NOTMAKE.
+ (AC_PROG_INSTALL): Add call.
+ (MAKEINFO): Do not bother with the 'missing' program.
+ (MAKEINFO, SYSTEM_TYPE): AC_SUBST.
+ (AC_CONFIG_FILES): Add Makefile, lib/gnulib.mk.
+ (SUBDIR_MAKEFILES): Remove duplication.
+ * lib/Makefile.am: Remove, replacing with:
+ * lib/Makefile.in: New file, with the old Makefile.am contents
+ and with the following changes:
+ (AUTOMAKE_OPTIONS, BUILT_SOURCES, CLEANFILES, EXTRA_DIST)
+ (MOSTLYCLEANDIRS, MOSTLYCLEANFILES, noinst_LIBRARIES, SUFFIXES)
+ (AM_CFLAGS, DEFAULT_INCLUDES, libegnu_a_SOURCES, libegnu_a_LIBADD)
+ (EXTRA_libegnu_a_SOURCES, libegnu_a_SHORTNAME, libegnu_a_CPPFLAGS):
+ Remove.
+ (VPATH, abs_top_builddir, top_builddir, top_srcdir, all, AM_V_AR)
+ (AM_V_CC, AM_V_GEN, AM_V_at, DEPDIR, DEPFLAGS, MKDEPDIR, SYSTEM_TYPE)
+ (libgnu.a, libegnu.a, ETAGS, $(ETAGS), tags, TAGS, clean)
+ (mostlyclean, distclean, bootstrap-clean, maintainer-clean):
+ New macros and rules, since Automake no longer does them.
+ Include ../nt/gnulib-cfg.mk if SYSTEM_TYPE is windows-nt,
+ instead of including ../nt/gnulib.mk if BUILDING_FOR_WINDOWS_NT.
+ Include dependency files if AUTO_DEPEND.
+ (ALL_CFLAGS, AUTOCONF_INPUTS, libgnu_a_OBJECTS, libegnu_a_OBJECTS):
+ New macros.
+ (bootstrap-clean): Depend on distclean, not maintainer-clean,
+ and remove gnulib.mk.
+ (AUTOCONF_INPUTS, $(top_srcdir)/configure, ../config.status, Makefile):
+ New macros and rules, copied from ../Makefile.in.
+ ($(libegnu_a_OBJECTS), $(libgnu_a_OBJECTS)): Depend on BUILT_SOURCES.
+ (.c.o, e-%.o): New generic rules.
+ * lib/gnulib.mk: Remove.
+ * lib/gnulib.mk.in: New file, which is built by autogen.sh
+ and contains much of what used to be in lib/gnulib.mk.
+ * m4/gnulib-common.m4: Copy from gnulib.
+ * make-dist: Do not distribute build-aux/compile, build-aux/depcomp,
+ build-aux/missing, build-aux/ar-lib, lib/Makefile.am, nt/gnulib.mk,
+ nt/gnulib-modules-to-delete.cfg. Distribute lib/Makefile.in,
+ lib/gnulib.mk.in, and nt/gnulib-cfg.mk instead.
+ * nt/Makefile.in (AM_V_GEN, am__v_GEN_, am__v_GEN_0)
+ (am__v_GEN_1, ${srcdir}/gnulib.mk): Remove.
+ * nt/gnulib-cfg.mk: New file, which supersedes ...
+ * nt/gnulib-modules-to-delete.cfg: ... this file, which is removed.
+ * src/Makefile.in (ACLOCAL_INPUTS): Remove.
+ (AUTOCONF_INPUTS): Merge ACLOCAL_INPUTS into it.
+ ($(top_srcdir)/configure, ../config.status, config.in Makefile):
+ Defer to parent Makefile.
+
+2017-03-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Don't suggest Mailutils on MS-Windows
+
+ * configure.ac: Don't suggest GNU Mailutils on MS-Windows, as it
+ hasn't been ported.
+
+2017-03-17 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Fix bug: Range-check integer ‘alpha’ frame parm value
+
+ Typo introduced 2013-04-01, "Prefer < to >
+ in range checks such as 0 <= i && i < N".
+
+ * src/frame.c (x_set_alpha): Use ‘ialpha’, not ‘alpha’.
+
+2017-03-17 Thien-Thi Nguyen <ttn@gnu.org>
+
+ Fix bug: Range-check integer ‘alpha’ frame parm value
+
+ Typo introduced 2013-04-01, "Prefer < to >
+ in range checks such as 0 <= i && i < N".
+
+ * src/frame.c (x_set_alpha): Use ‘ialpha’, not ‘alpha’.
+
+2017-03-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#26127
+
+ * lisp/filenotify.el (file-notify--rm-descriptor): Check, that
+ there is a function which could be called. (Bug#26127)
+
+ * test/lisp/filenotify-tests.el (file-notify--test-cleanup):
+ Clear also `file-notify-descriptors'.
+ (file-notify--test-make-temp-name): Move up.
+ (file-notify-test02-rm-watch): New test.
+ (file-notify-test03-events, file-notify-test04-autorevert)
+ (file-notify-test05-file-validity)
+ (file-notify-test06-dir-validity)
+ (file-notify-test07-many-events, file-notify-test08-backup)
+ (file-notify-test09-watched-file-in-watched-dir)
+ (file-notify-test10-sufficient-resources): Rename.
+
+2017-03-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/PROBLEMS: Say that HP-UX cc doesn't work.
+
+2017-03-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Emacs 'movemail' is now a configure-time option
+
+ The new configure option --with-mailutils lets the builder say
+ that Emacs should assume that GNU Mailutils is installed, instead
+ of continuing to build and install its own limited and insecure
+ substitute for 'movemail'.
+ * INSTALL, etc/NEWS, etc/PROBLEMS: Mention --with-mailutils.
+ * configure.ac: Add --with-mailutils option.
+ (with_mailutils): New variable.
+ Do not bother configuring 'movemail' when not building it.
+ Warn about issues relating to --with-mailutils.
+ * doc/emacs/rmail.texi (Movemail): Mention --with-mailutils.
+ (Movemail, Remote Mailboxes): Document port numbers in
+ POP and IMAP URLs.
+ * lib-src/Makefile.in (with_mailutils): New macro.
+ (UTILITIES): Use it.
+
+2017-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Add obarray-size and fix tests accordingly. Use obarrayp in cedet.
+
+ * lisp/obarray.el (obarray-size): New function.
+
+ * lisp/cedet/semantic/lex-spp.el (semantic-lex-spp-symbol)
+ (semantic-lex-spp-save-table, semantic-lex-spp-macros):
+ * lisp/cedet/semantic/bovine/c.el (semantic-c-describe-environment):
+ Use obarrayp.
+
+ * test/lisp/obarray-tests.el (obarray-make-default-test)
+ (obarray-make-with-size-test): Use it.
+
+2017-03-16 Michael Albinus <michael.albinus@gmx.de>
+
+ Document remote file name syntax change
+
+ * doc/emacs/files.texi (Remote Files, Quoted File Names):
+ * doc/misc/org.texi (dir): Change examples to use a method.
+
+ * doc/misc/tramp.texi (Top) [trampf]: Remove macro. Add
+ `Testing' menu entry.
+ (History): Fix typos. Mention syntax change.
+ (Configuration, Default Host, File name Syntax)
+ (File name completion, Frequently Asked Questions):
+ Change examples to use a method.
+ (External methods, Default Host, Multi-hops, Remote processes):
+ Fix typos.
+ (Default Method): Mention pseudo method "-".
+ (External packages): Rewrite intention of `non-essential'.
+
+ * etc/NEWS: Mark recent Tramp entries as documented.
+
+2017-03-16 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ (semantic-lex-type-invalid): Fix nested backquote.
+
+ * lisp/cedet/semantic/lex.el: Use lexical-binding.
+ (semantic-lex-type-invalid): Fix nested backquote.
+ (semantic-lex-map-symbols, semantic-lex-type-symbol)
+ (semantic-lex-keyword-symbol): Use obarrayp.
+
+2017-03-15 Michael Albinus <michael.albinus@gmx.de>
+
+ * lisp/ido.el (ido-read-internal, ido-complete): Do not bind `non-essential'.
+
+2017-03-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Write a named function
+
+ * lisp/comint.el (comint-nonblank-p): New function.
+ (comint-input-filter): Use it.
+
+2017-03-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace more nested ifs with cond
+
+ This is a continuation of 0db5ba4 "Replace nested ifs with cond".
+ * lisp/play/dunnet.el (dun-special-object, dun-inven, dun-drop):
+ (dun-drop-check, dun-swim, dun-break): Use when and cond where
+ appropriate.
+ (dun-examine): Fix indentation.
+ (dun-doverb): Use when.
+ (dun-read-line): Refactor.
+
+2017-03-15 Noam Postavsky <npostavs@gmail.com>
+
+ Recomplexify ‘delete-trailing-whitespace’ by treating \n as whitespace again
+
+ Mostly reverts "Simplify ‘delete-trailing-whitespace’ by not treating
+ \n as whitespace" from 2016-07-04. Setting \n to non-whitespace
+ causes the regex engine to backtrack a lot when searching for
+ "\\s-+$" (Bug#26079).
+
+ * lisp/simple.el (delete-trailing-whitespace): Don't change newline
+ syntax, search for "\\s-$" and then skip backward over trailing
+ whitespace.
+
+2017-03-14 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-03-14 snippets: move unadjusted snippet sources to lib
+ 2017-03-14 gnulib-tool: fix typo in comment output
+ 2017-03-14 snippets: work around GNU Make 3.82 VPATH
+ 2017-03-13 gnulib-tool: minor --gnu-make fixups
+ 2017-03-12 gnulib-tool: new option --gnu-make
+ * .gitignore: Remove lib/arg-nonnull.h, lib/c++defs.h,
+ lib/warn-on-use.h. Change exception from
+ build-aux/snippet/_Noreturn.h to lib/_Noreturn.h.
+ * admin/authors.el (authors-renamed-files-regexps):
+ * admin/notes/copyright, make-dist:
+ The snippet files moved from build-aux/snippet to lib.
+ * lib/_Noreturn.h: Rename from build-aux/snippet/_Noreturn.h.
+ * lib/arg-nonnull.h: Rename from build-aux/snippet/arg-nonnull.h.
+ * lib/c++defs.h: Rename from build-aux/snippet/c++defs.h.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+ * lib/warn-on-use.h: Rename from build-aux/snippet/warn-on-use.h.
+
+2017-03-14 Eli Zaretskii <eliz@gnu.org>
+
+ Fix duplicate wording in Emacs manual
+
+ * doc/emacs/programs.texi (Which Function): Delete duplicate
+ wording. (Bug#26098)
+
+2017-03-14 Michael Albinus <michael.albinus@gmx.de>
+
+ Reenable lost Tramp test case
+
+ * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion):
+ Reenable lost test case.
+
+2017-03-14 Alan Third <alan@idiocy.org>
+
+ Revert "Remove NSEvent loop from ns_select (bug#25265)"
+
+ This reverts commit 3bd2e9e975ed29daaf03ca7559e4664aade0674f.
+
+2017-03-14 Alan Third <alan@idiocy.org>
+
+ Revert "Add missing timeout value in ns_select"
+
+ This reverts commit a65236214d9202fb69a6ba5169d4ac1a4bcb0b0d.
+
+2017-03-14 Alan Third <alan@idiocy.org>
+
+ Remove old macOS compatibility code
+
+ * src/nsimage.m, src/nsmenu.m, src/nsterm.m: Remove code only for
+ macOS versions below 10.6 as they are not supported in Emacs 25+.
+
+2017-03-14 Michael Albinus <michael.albinus@gmx.de>
+
+ Tune `tramp-completion-file-name-regexp-unified'
+
+ * lisp/net/tramp.el (tramp-completion-file-name-regexp-unified):
+ Extend this regexp to match also "/".
+
+2017-03-14 Tino Calancha <tino.calancha@gmail.com>
+
+ Show ancestor buffer in 3way merges
+
+ Add an option ediff-show-ancestor', to control if the ancestor buffer
+ must be shown in 3way merges (Bug#25493); set it non-nil by default.
+ Add a toggle to change this option interactively; the original
+ value of the option is restored on exit.
+
+ Update the window setup so that the ancestor buffer is
+ shown in 3way merges when ediff-show-ancestor is non-nil.
+
+ Any operation on ediff windows must take in account the
+ ancestor window as well, when this is shown.
+
+ * lisp/vc/ediff-init.el (ediff-show-ancestor): New option.
+ (ediff--show-ancestor-orig): New defvar.
+ * lisp/vc/ediff-wind.el (ediff-window-Ancestor): New defvar.
+ (ediff-setup-windows-plain-merge, ediff-setup-windows-multiframe-merge):
+ Display ancestor buffer if ediff-show-ancestor is non-nil.
+ (ediff-keep-window-config): Expect ancestor window in
+ ediff-window-config-saved.
+ (ediff-window-alist): Add entry for the ancestor window.
+ * lisp/vc/ediff-util.el (ediff-setup-control-buffer):
+ ediff-window-config-saved contains ancestor window.
+ (ediff-show-ancestor): Delete this command.
+ (ediff-setup-keymap): Bind ediff-toggle-show-ancestor to '/' for merge jobs.
+ (ediff-update-diffs): Compute new diffs using ancestor buffer in 3way merges;
+ don't cheat it to think that is performing a comparison, that trick is not
+ necessary anymore: simply call 'ediff-setup-diff-regions-function'
+ with file-A, file-B and the file ancestor.
+ (ediff-recenter): Update doc string. Consider the ancestor buffer.
+ (ediff--check-ancestor-exists): New defun.
+ (ediff-toggle-show-ancestor): New command; toggle ediff-show-ancestor.
+ (ediff--restore-options-on-exit): Restore ediff-show-ancestor on exit.
+ (ediff-scroll-vertically, ediff-scroll-horizontally)
+ (ediff-operate-on-windows): Consider the ancestor as well.
+ * lisp/vc/ediff-help.el (ediff-long-help-message-merge):
+ List ediff-toggle-show-ancestor.
+ * doc/misc/ediff.texi (Introduction, Quick Help Commands): Update manual.
+
+2017-03-14 Tino Calancha <tino.calancha@gmail.com>
+
+ diff-mode: Improve default faces for buffer ancestor
+
+ * lisp/vc/ediff-init.el (ediff-current-diff-Ancestor)
+ (ediff-fine-diff-Ancestor): Use defaults consistent with
+ faces for 'ediff-buffer-A' and 'ediff-buffer-B'.
+
+2017-03-14 Hong Xu <hong@topbug.net>
+
+ * lisp/paren.el (show-paren--default, show-paren-function): Add docstring.
+
+2017-03-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix make-dist typo
+
+ * make-dist: Fix typo introduced in the Bug#25895 fix.
+
+2017-03-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix wording in Emacs manual
+
+ * doc/emacs/text.texi (Paragraphs): Fix a garbled sentence.
+ (Bug#26086)
+
+2017-03-13 Michael Albinus <michael.albinus@gmx.de>
+
+ etc/NEWS: Remote file names require a method.
+
+2017-03-13 Michael Albinus <michael.albinus@gmx.de>
+
+ Require method in remote file name syntax
+
+ * lisp/minibuffer.el (completion--nth-completion):
+ Do not bind `non-essential'.
+
+ * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection):
+ * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Do not call
+ `tramp-check-proper-method-and-host'.
+
+ * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): Better traces.
+ (tramp-maybe-open-connection): Do not use argument for
+ ´tramp-completion-mode-p'.
+
+ * lisp/net/tramp.el (tramp-default-method-marker): New defconst.
+ (tramp-prefix-format, tramp-postfix-method-format)
+ (tramp-prefix-ipv6-format, tramp-postfix-ipv6-format)
+ (tramp-prefix-port-format, tramp-postfix-host-format)
+ (tramp-file-name-regexp, tramp-completion-file-name-regexp):
+ Use `eq' instead of `eqal'.
+ (tramp-method-regexp, tramp-domain-regexp)
+ (tramp-remote-file-name-spec-regexp)
+ (tramp-file-name-regexp-unified)
+ (tramp-completion-file-name-regexp-unified)
+ (tramp-completion-file-name-regexp-separate): Adapt regexp.
+ (tramp-completion-file-name-handler-alist)
+ (tramp-run-real-handler): Autoload them.
+ (tramp-find-method): Handle `tramp-default-method-marker'.
+ (tramp-check-proper-method-and-host)
+ (tramp-completion-run-real-handler): Remove them.
+ (tramp-error-with-buffer, tramp-connectable-p): Do not use
+ argument for ´tramp-completion-mode-p'.
+ (tramp-find-foreign-file-name-handler): Remove COMPLETION
+ argument. Do not apply heuristic for completion.
+ (tramp-file-name-handler): Do not modify `non-essential'.
+ (tramp-completion-file-name-handler): Change implementation.
+ (tramp-autoload-file-name-handler)
+ (tramp-completion-handle-file-name-all-completions):
+ Call `tramp-run-real-handler'.
+ (tramp-completion-mode-p): Do not autoload. Remove argument.
+ Do not apply heuristic for completion.
+ (tramp-completion-dissect-file-name): Simplify implementation.
+ (tramp-handle-file-name-as-directory): Call `tramp-connectable-p'.
+
+ * test/lisp/net/tramp-tests.el (tramp-test01-file-name-syntax)
+ (tramp-test02-file-name-dissect)
+ (tramp-test03-file-name-defaults)
+ (tramp-test06-directory-file-name): Adapt to the new syntax.
+ (tramp-test11-copy-file, tramp-test12-rename-file)
+ (tramp--test-check-files): Deactivate temporarily tests with
+ quoted file names.
+ (tramp-test16-directory-files, tramp-test17-insert-directory):
+ Adapt tests.
+ (tramp-test24-file-name-completion): Do not check for
+ completion mode.
+ (tramp-test31-make-auto-save-file-name): Deactivate temporarily
+ two tests.
+
+2017-03-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix bidi paragraph direction when inserting text at newline
+
+ * src/insdel.c (invalidate_buffer_caches): Invalidate the bidi
+ paragraph cache when inserting immediately after a newline.
+ (Bug#26083)
+
+2017-03-13 Tino Calancha <tino.calancha@gmail.com>
+
+ * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-1): Fix regexp.
+
+2017-03-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-compiled): New variable
+
+ (cl-print-object) <compiled-function>: Print the docstring and
+ interactive form. Obey cl-print-compiled.
+
+2017-03-13 Noam Postavsky <npostavs@gmail.com>
+
+ Fix indent-sexp when called from inside a string (Bug#21343)
+
+ * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Get initial syntax parse
+ state from `syntax-ppss'.
+
+2017-03-13 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/emacs-lisp/lisp-mode.el (indent-sexp): Simplify.
+
+ * test/lisp/emacs-lisp/lisp-mode-tests.el (indent-sexp):
+ (indent-subsexp, indent-sexp-in-string): New tests.
+
+2017-03-12 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use switch on pseudovector types; plus cleanups along the way
+
+ * src/lisp.h (PSEUDOVECTOR_TYPE): New function, extracted from mark_object.
+ (PSEUDOVECTOR_TYPEP): Change type of `code'.
+
+ * src/alloc.c (sweep_vectors): Remove out-of-date assertion.
+ (mark_object): Use PSEUDOVECTOR_TYPE.
+
+ * src/data.c (Ftype_of): Use switch on pvec type.
+
+ * src/print.c (print_object): Use switch on pvec type.
+
+ * lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-types):
+ Add recently added types.
+
+2017-03-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Install update-game-score only on request
+
+ Most distributions do not install update-game-score properly
+ due to setuid/setgid complications, so install it only when
+ the installer specifies a user or group (Bug#25895).
+ * .gitattributes: Remove lib-src/update-game-score.exe.manifest.
+ * Makefile.in (gameuser, gamegroup, use_gamedir, PATH_GAME):
+ New vars.
+ (epaths-force): Use PATH_GAME.
+ (uninstall): Remove snake-scores and tetris-scores only if shared.
+ * configure.ac: Default --with-gameuser to 'no'.
+ (UPDATE_MANIFEST): Remove.
+ * etc/NEWS: Mention this.
+ * lib-src/Makefile.in (UPDATE_MANIFEST): Remove.
+ (use_gamedir): New macro.
+ (UTILITIES): Remove update-game-score unless use_gamedir.
+ (SCRIPTS): Remove $(UPDATE_MANIFEST).
+ ($(DESTDIR)${archlibdir}): Install game directory program and data
+ only if use_gamedir.
+ * lib-src/update-game-score.exe.manifest: Remove, as
+ update-game-score is no longer installed on MS-Windows.
+ * lisp/play/gamegrid.el (gamegrid-add-score-with-update-game-score):
+ Use auxiliary program only if setuid or setgid.
+ * make-dist: Do not distribute update-game-score.exe.manifest.
+ * src/callproc.c (init_callproc):
+ Set Vshared_game_score_directory based on PATH_GAME, not DOS_NT.
+ (syms_of_callproc): Remove unnecessary initialization of
+ Vshared_game_score_directory.
+
+2017-03-12 Simen Heggestøyl <simenheg@gmail.com>
+
+ Add `touch-action' to list of CSS properties
+
+ * lisp/textmodes/css-mode.el (css-property-alist): Add `touch-action'
+ property.
+
+2017-03-12 Eli Zaretskii <eliz@gnu.org>
+
+ Teach etags to process ENUM_BF correctly
+
+ * lib-src/etags.c (sym_type): New enumeration value st_C_enum_bf.
+ (hash): Regenerated values for asso_values[] array.
+ (in_word_set): Update values of TOTAL_KEYWORDS and
+ MAX_HASH_VALUE. Add "ENUM_BF" to the wordlist[] array.
+ (in_enum_bf): New file-global variable.
+ (consider_token): Skip ENUM_BF if not in a macro definition.
+ (C_entries): Reset the in_enum_bf flag when past its closing
+ parenthesis.
+
+ * test/manual/etags/ETAGS.good_1:
+ * test/manual/etags/ETAGS.good_2:
+ * test/manual/etags/ETAGS.good_3:
+ * test/manual/etags/ETAGS.good_4:
+ * test/manual/etags/ETAGS.good_5:
+ * test/manual/etags/ETAGS.good_6:
+ * test/manual/etags/CTAGS.good: Adapt to changes in etags.
+
+2017-03-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Use path/to/file instead of path/to.file in tramp.texi
+
+ * doc/misc/tramp.texi (Configuration, File name Syntax):
+ Use path/to/file instead of path/to.file.
+
+2017-03-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove some stray gnulib files
+
+ * admin/merge-gnulib: rm m4/gnulib-tool.m4 too.
+ (GNULIB_MODULES): Remove unsetenv, as it is not needed and
+ the --avoid=unsetenv option avoided most of it anyway.
+ * lib/unsetenv.c, m4/gnulib-tool.m4, m4/setenv.m4: Remove.
+ * lib/gnulib.mk: Regenerate.
+
+2017-03-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-03-11 gnulib-common.m4: avoid aclocal.m4 bloat
+ * doc/misc/texinfo.tex, m4/gnulib-common.m4: Copy from gnulib.
+
+2017-03-12 Glenn Morris <rgm@gnu.org>
+
+ Remove trivial duplication in epg-config
+
+ * lisp/epg-config.el (epg-config--program-alist):
+ Use epg-gpg-minimum-version.
+
+2017-03-12 Glenn Morris <rgm@gnu.org>
+
+ Small epg-find-configuration improvement
+
+ * lisp/epg-config.el (epg-find-configuration):
+ Handle epg-gpg-program customized but not saved. (Bug#25947)
+
+2017-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Improve last change
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2):
+ Use ppss to check escaping and add help-echo.
+
+2017-03-11 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Highlight useless backslashes in Elisp strings
+
+ * lisp/emacs-lisp/lisp-mode.el (lisp-el-font-lock-keywords-2):
+ Put warning face on backslashes that have no effect.
+
+2017-03-11 Eli Zaretskii <eliz@gnu.org>
+
+ Document how to customize input methods
+
+ * doc/emacs/mule.texi (Input Methods): Document how to customize
+ input methods.
+
+2017-03-11 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/net/eww.el (eww-reload): Doc fix. (Bug#25981)
+
+2017-03-11 Eli Zaretskii <eliz@gnu.org>
+
+ Fix generation of nt/gnulib.mk on macOS
+
+ * nt/Makefile.in (${srcdir}/gnulib.mk): Don't use the -f- option
+ to Sed, as that is not portable with non-GNU Sed variants.
+ (Bug#26043)
+
+2017-03-11 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid aborts/assertion violations due to 'vim-empty-lines-mode'
+
+ * src/xdisp.c (handle_single_display_spec): If position to be
+ restored after processing the display property comes from an
+ overlay, protect against that overlay's end point being outside of
+ the narrowed region.
+ Reported by Filipe Silva <filipe.silva@gmail.com> in
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00176.html.
+
+2017-03-10 Glenn Morris <rgm@gnu.org>
+
+ Small improvement for epa-display-error (bug#24553)
+
+ * lisp/epa.el (epa-display-error): Report the actual program in use.
+
+2017-03-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Tweak X toolkit code to pacify modern GCC
+
+ * lwlib/lwlib-Xaw.c, lwlib/lwlib-Xm.c, lwlib/lwlib.c:
+ Don’t include <stdlib.h>, since this code now calls emacs_abort
+ rather than abort.
+ * lwlib/lwlib-Xaw.c (make_dialog, xaw_generic_callback)
+ (wm_delete_window):
+ * lwlib/lwlib-Xm.c (make_menu_in_widget, do_call):
+ * lwlib/lwlib.c (instantiate_widget_instance, lw_make_widget):
+ * lwlib/xlwmenu.c (abort_gracefully, draw_separator)
+ (separator_height, XlwMenuInitialize):
+ Use emacs_abort, not abort. Without this change, some calls
+ to ‘abort’ were invalid, as stdlib.h was not always included.
+ * src/widget.c (resources, emacsFrameClassRec):
+ * src/xfns.c (x_window) [USE_X_TOOLKIT]:
+ * src/xmenu.c (create_and_show_popup_menu) [USE_X_TOOLKIT]:
+ * src/xterm.c (emacs_options) [USE_X_TOOLKIT}:
+ (x_term_init) [USE_X_TOOLKIT]:
+ Cast string constants to char * to pacify --enable-gcc-warnings.
+
+2017-03-10 Michael Albinus <michael.albinus@gmx.de>
+
+ * doc/misc/tramp.texi (Android shell setup): Require adb program
+
+2017-03-10 Michael Albinus <michael.albinus@gmx.de>
+
+ Adapt tramp-tests.el
+
+ * test/lisp/net/tramp-tests.el (tramp-test06-directory-file-name)
+ (tramp-test24-file-name-completion): Call
+ `tramp-completion-mode-p' with argument.
+
+2017-03-10 Thien-Thi Nguyen <ttn@gnu.org>
+
+ [doc] Replace bindat example: s/fortune cookie/rfc868 payload/
+
+ * doc/lispref/processes.texi (Bindat Examples):
+ Mention two examples in intro blurb; rewrite first example.
+
+2017-03-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify checks for xdg-open and xdg-email
+
+ browse-url's xdg-open detection was too picky on some GNU/Linux
+ desktops; see Bug#25778. Simplify the code by assuming xdg-open works
+ if it is executable, as nowadays this is more likely to be correct than
+ trying to use heuristics from a few years ago. Don't test for nohup: it
+ is ineffective nowadays, as xdg-open's child uses the default action for
+ SIGHUP even if xdg-open's invoker ignores SIGHUP. While we're at it,
+ allow for Wayland here, as "emacs -nw" might be running in a non-X
+ Wayland terminal.
+ * lisp/mail/emacsbug.el (report-emacs-bug-can-use-xdg-email):
+ * lisp/net/browse-url.el (browse-url-can-use-xdg-open):
+ Simplify to a test for DISPLAY and whether the helper program is
+ executable. Allow WAYLAND_DISPLAY as an option.
+
+2017-03-09 Vibhav Pant <vibhavp@gmail.com>
+
+ Byte compile cond clauses without any bodies correctly.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table): When a
+ cond clause has no body, push t on to the stack.
+
+2017-03-09 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix bug#23006
+
+ * lisp/minibuffer.el (completion--nth-completion):
+ Let-bind `non-essential'.
+
+ * lisp/net/tramp.el (tramp-completion-mode): Fix docstring.
+ (tramp-completion-mode-p): Optional parameter VEC. Replace
+ check for `last-input-event' by analysing VEC argument.
+ (tramp-error-with-buffer, tramp-file-name-handler)
+ (tramp-connectable-p, tramp-handle-file-name-as-directory):
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection): Use it.
+
+2017-03-09 Vibhav Pant <vibhavp@gmail.com>
+
+ etc/NEWS: Add entry for new `switch' bytecode.
+
+2017-03-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/data.c (arithcompare): Add comments.
+
+2017-03-08 Glenn Morris <rgm@gnu.org>
+
+ Update a cl-print test
+
+ * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-tests-1):
+ Update for recent change in cl-print-object function output.
+
+2017-03-08 Sam Steingold <sds@gnu.org>
+
+ Replace change-log-date-face -> change-log-date
+
+ This fixes c430f7e23fc2c22f251ace4254e37dea1452dfc3.
+
+2017-03-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix bug#26011
+
+ * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-via-buffer):
+ Check, whether file is too large. (Bug#26011)
+
+2017-03-08 Andreas Schwab <schwab@linux-m68k.org>
+
+ * src/data.c (minmax_driver): Use CHECK_NUMBER_OR_FLOAT_COERCE_MARKER.
+ (Fmax, Fmin): Restore documentation.
+
+ * src/data.c (cons_to_unsigned, cons_to_signed, Fstring_to_number): Reorder
+ comparisons that are written backward.
+
+2017-03-08 Thien-Thi Nguyen <ttn@gnu.org>
+
+ [doc elisp] Add some index entries for "old" advice mechanism
+
+ * doc/lispref/functions.texi (Porting old advice):
+ Add one @cindex and two @findex entries.
+
+2017-03-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/NEWS: Adjust to match previous patch.
+
+2017-03-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ min and max should not return markers
+
+ Problem reported by Glenn Morris in:
+ https://lists.gnu.org/r/emacs-devel/2017-03/msg00147.html
+ * src/data.c (minmax_driver): Convert any marker result to an
+ integer, since some callers assume this.
+ * test/src/data-tests.el (data-tests-max, data-tests-min):
+ Test for this.
+
+2017-03-08 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-print.el (cl-print-object): Use #f(..) for functions.
+
+2017-03-08 Alan Third <alan@idiocy.org>
+
+ Add missing timeout value in ns_select
+
+ * src/nsterm.m (ns_select): Set timeout to distant future when relying
+ on fd_handler's timeout.
+
+2017-03-07 Glenn Morris <rgm@gnu.org>
+
+ * admin/update_autogen: Ensure nt/gnulib.mk exists, for autoreconf.
+
+2017-03-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove isnan hack for Solaris 10 gcc 3.4.3
+
+ This seems to have been a false alarm (Bug#26018).
+ * src/data.c (isnan):
+ * src/floatfns.c (isfinite, isnan):
+ Use standard implementation if available.
+
+2017-03-07 Eli Zaretskii <eliz@gnu.org>
+
+ Support browsing URLs with embedded spaces on MS-Windows
+
+ * lisp/net/browse-url.el (browse-url-default-windows-browser):
+ Unhex %XX hex-encoded characters, as w32-shell-execute doesn't
+ support that in file:// URLs. (Bug#26014)
+
+2017-03-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Define copysign on all platforms
+
+ * configure.ac (copysign): Remove test.
+ * src/floatfns.c (signbit): New macro, if not already defined.
+ (Fcopysign): Use it instead of copysign.
+ (Fcopysign, syms_of_floatfns): Define the function on all platforms.
+
+2017-03-07 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Revert "Replace ldefs-boot with a much smaller file"
+
+ This reverts commit c27b645956a11fab1dd8fa189254d525390958f5.
+
+ This commit has been reverted because the new mechanism was too
+ sensitive to changes in the lisp source, generation of new ldefs-boot
+ files was platform specific and resulted in warnings about undefined
+ variables.
+
+ See also 11436e2890d.
+
+2017-03-07 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Revert "Record autoloads till emacs dump"
+
+ This reverts commit 72c668a9042ac6475eadedfee5c87fb1e6b2d753.
+
+ This commit has been reverted because the new mechanism was too
+ sensitive to changes in the lisp source, generation of new ldefs-boot
+ files was platform specific and resulted in warnings about undefined
+ variables.
+
+ See also 11436e2890d.
+
+2017-03-07 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Revert "Remove unused ldefs-boot.el"
+
+ This reverts commit ef8c9f8fc922b615aca91b47820d1f1900fddc96.
+
+ This commit has been reverted because the new mechanism was too
+ sensitive to changes in the lisp source, generation of new ldefs-boot
+ files was platform specific and resulted in warnings about undefined
+ variables.
+
+ See also 11436e2890d.
+
+2017-03-07 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Revert "Remove conditional includes from bootstrap"
+
+ This reverts commit 1b946305182312faa7fcd838caf55dcb07b2ab04.
+
+ This commit has been reverted because the new mechanism was too
+ sensitive to changes in the lisp source, generation of new ldefs-boot
+ files was platform specific and resulted in warnings about undefined
+ variables.
+
+ See also 11436e2890d.
+
+2017-03-07 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Revert "Speed generation of ldefs-boot-auto"
+
+ This reverts commit 7b5e1c8238ef961fd3305b1dce053b9bced684ba.
+
+ This commit has been reverted because the new mechanism was too
+ sensitive to changes in the lisp source, generation of new ldefs-boot
+ files was platform specific and resulted in warnings about undefined
+ variables.
+
+ See also 11436e2890d.
+
+2017-03-07 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Revert "Fix minor problems with loaddefs autogeneration"
+
+ This reverts commit f2bd2c1e6476acc71e71f6cb2a1c56c5edd900ba.
+
+ This commit has been reverted because the new mechanism was too
+ sensitive to changes in the lisp source, generation of new ldefs-boot
+ files was platform specific and resulted in warnings about undefined
+ variables.
+
+2017-03-07 Noam Postavsky <npostavs@gmail.com>
+
+ Set default when asking for send-mail-function (Bug#25874).
+
+ * lisp/mail/sendmail.el (sendmail-query-user-about-smtp): Pass first
+ option as default for `completing-read'.
+
+2017-03-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ min and max now return one of their arguments
+
+ * doc/lispref/numbers.texi (Comparison of Numbers):
+ * etc/NEWS: Document this.
+ * src/data.c (Amax, Amin): Remove constants. All uses removed.
+ (minmax_driver): New function.
+ (Fmax, Fmin): Use it instead of arith_driver.
+ * test/src/data-tests.el (data-tests-max, data-tests-min): New tests.
+
+2017-03-06 Alan Third <alan@idiocy.org>
+
+ Remove NSEvent loop from ns_select (bug#25265)
+
+ * src/nsterm.m (ns_select): Remove event processing loop and replace
+ with simple test for a new event.
+
+2017-03-06 Eli Zaretskii <eliz@gnu.org>
+
+ A better fix for bug#25845
+
+ * src/xdisp.c (font_for_underline_metrics): New function.
+ * src/dispextern.h: Add its prototype.
+ * src/xterm.c (x_draw_glyph_string):
+ * src/w32term.c (x_draw_glyph_string):
+ * src/nsterm.m (ns_draw_text_decoration): Call it. This avoids
+ having identical code 3 times in 3 different files.
+
+2017-03-06 Noam Postavsky <npostavs@gmail.com>
+
+ Fix warning message about native completion (Bug#25984)
+
+ * lisp/progmodes/python.el (python-shell-completion-native-turn-on-maybe):
+ The relevant variable is `python-shell-completion-native-enable'.
+
+2017-03-06 Tom Tromey <tom@tromey.com>
+
+ Fix typos in EIEIO manual
+
+ * doc/misc/eieio.texi (Slot Options, Class Options): Fix typos.
+
+2017-03-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-03-04 dtotimespec: simplify
+ * lib/dtotimespec.c: Copy from gnulib.
+
+2017-03-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ ffloor etc. now accept only floats
+
+ * etc/NEWS: Say why.
+ * src/floatfns.c (Ffceiling, Fffloor, Ffround, Fftruncate):
+ Require arg to be float.
+ * test/src/floatfns-tests.el (fround-fixnum): Check this.
+
+2017-03-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of cursor on underlined text
+
+ * src/nsterm.m (ns_draw_text_decoration):
+ * src/xterm.c (x_draw_glyph_string):
+ * src/w32term.c (x_draw_glyph_string): Compute the position and
+ thickness of the underline by looking for the first glyph of the
+ run of underlined glyphs that includes the glyph string we are
+ drawing. (Bug#25845)
+
+2017-03-05 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add more CL concept index items, print Concept Index
+
+ * doc/misc/cl.texi: Print concept index.
+ (Generalized Variables, Variable Bindings):
+ (Dynamic Bindings, Function Bindings, Macro Bindings, Conditionals):
+ (Blocks and Exits, Iteration, Multiple Values): Add concept index
+ items.
+
+2017-03-05 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add 'loop facility' to the CL concept index
+
+ * doc/misc/cl.texi (Loop Facility): Add "loop facility" as a concept
+ index item.
+
+2017-03-05 martin rudalics <rudalics@gmx.at>
+
+ In `window--display-buffer' fix behavior reported in Bug#25946
+
+ * lisp/window.el (window--display-buffer): Set the dedicated
+ status of the window used and clear its history of previous
+ buffers also for the case that the window already shows the
+ buffer to be displayed. (Bug#25946)
+
+2017-03-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Compare and round more carefully
+
+ * etc/NEWS: Document this.
+ * src/data.c (store_symval_forwarding):
+ * src/sound.c (parse_sound):
+ Do not botch NaN comparison.
+ * src/data.c (cons_to_unsigned, cons_to_signed):
+ Signal an error if a floating-point arg is not integral.
+ * src/data.c (cons_to_unsigned, cons_to_signed):
+ * src/fileio.c (file_offset):
+ Use simpler overflow check.
+ * src/dbusbind.c (xd_extract_signed, xd_extract_unsigned):
+ Avoid rounding error in overflow check.
+ (Fcar_less_than_car): Use arithcompare directly.
+ * test/src/charset-tests.el: New file.
+
+2017-03-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fewer rounding errors with (format "%f" fixnum)
+
+ * etc/NEWS: Document this.
+ * src/editfns.c (styled_format): When formatting integers via a
+ floating-point format, use long double instead of double
+ conversion, if long double’s extra precision might help.
+
+2017-03-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/floatfns.c (Fftruncate): Simplify via emacs_trunc.
+
+ * src/editfns.c (styled_format): Omit unnecessary code for "%0d" etc.
+
+2017-03-04 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify documentation of 'raise' and 'height' display specs
+
+ * doc/lispref/display.texi (Other Display Specs): Clarify the
+ effect of 'height' display spec on the following 'raise'.
+ (Bug#25824)
+
+2017-03-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix header shown by Info 'L' command
+
+ * lisp/info.el (Info-history-find-node): A better heading for the
+ list of visited nodes. (Bug#25876)
+
+2017-03-04 K. Handa <handa@gnu.org>
+
+ Add a section about incorrect Bengali rendering.
+
+2017-03-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix minor problems with loaddefs autogeneration
+
+ * admin/ldefs-clean.el (ldefs-clean): Bind coding-system-for-read
+ and coding-system-for-write, to produce a UTF-8 file with Unix
+ EOLs on MS-Windows.
+
+ * lisp/ldefs-boot-manual.el (image-type): Add autoload cookie.
+
+2017-03-04 David Bremner <david@tethera.net> (tiny change)
+
+ Fix issues with dedicated windows in shr.el
+
+ * lisp/net/shr.el (shr-pixel-buffer-width, shr-render-td-1): Make
+ the window not dedicated, to avoid errors if it was, before
+ setting its buffer temporarily. (Bug#25828)
+
+2017-03-04 Eli Zaretskii <eliz@gnu.org>
+
+ Mention problems with GPaste in PROBLEMS
+
+ * etc/PROBLEMS (GPaste): Mention the problem in yanking caused by
+ GPaste, and its solution. (Bug#25902)
+
+2017-03-04 Glenn Morris <rgm@gnu.org>
+
+ Avoid duplicate gud menu items with gdb-mi
+
+ * lisp/progmodes/gud.el (gud-menu-map): Avoid duplicate "Run"
+ entries in gdbmi mode. (Bug#23923)
+
+2017-03-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/editfns.c (styled_format): Omit unnecessary code.
+
+2017-03-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ logb now works correctly on large integers
+
+ * admin/merge-gnulib (GNULIB_MODULES): Add count-leading-zeros.
+ * etc/NEWS: Document the change.
+ * lib/count-leading-zeros.c, lib/count-leading-zeros.h:
+ * m4/count-leading-zeros.m4: New files, copied from Gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+ * src/floatfns.c: Include count-leading-zeros.h.
+ (Flogb): Do not convert fixnum to float before taking the log,
+ as the rounding error can cause the answer to be off by 1.
+ * src/lisp.h (EMACS_UINT_WIDTH): New constant.
+ * test/src/floatfns-tests.el (logb-extreme-fixnum): New test.
+
+2017-03-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-02-25 maintainer-makefile: Fix AC_PROG_SED with autoconf cache.
+ 2017-02-24 ftoastr: port to -Wdouble-promotion
+ * lib/ftoastr.c, m4/gnulib-common.m4: Copy from gnulib.
+
+2017-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid duplicating characters recorded in macros
+
+ * src/keyboard.c (record_char): Don't store in macro definitions
+ characters that came from executing a macro. (Bug#25860)
+
+2017-03-03 Eli Zaretskii <eliz@gnu.org>
+
+ Fix color component calculations in color.el
+
+ * lisp/color.el (color-name-to-rgb): Use 16 bits per color component.
+ (color-rgb-to-hex): Accept an optional argument
+ DIGITS-PER-COMPONENT, defaulting to 4, and format the hexadecimal
+ notation either for 8 or 16 bits per component. (Bug#25890)
+ * lisp/net/shr-color.el (shr-color->hexadecimal): Call
+ color-rgb-to-hex with the optional argument of 2, to match color
+ processing on the Web.
+
+2017-03-03 Tino Calancha <tino.calancha@gmail.com>
+
+ Use lexical binding in benchmark.el
+
+ * lisp/emacs-lisp/benchmark.el: Enable lexical binding.
+ (benchmark-elapse): Use 'declare'.
+ * test/lisp/emacs-lisp/benchmark-tests.el: Add test suite.
+
+2017-03-03 Noam Postavsky <npostavs@gmail.com>
+
+ Switch pp.el to lexical binding
+
+ Additionally, do some minor code cleanup.
+
+ * lisp/emacs-lisp/pp.el: Set lexical-binding.
+ (pp-buffer): Use skip-syntax-forward.
+ (pp-eval-expression): Use push.
+ (pp-last-sexp): Use with-syntax-table.
+ * test/lisp/emacs-lisp/pp-tests.el: New tests.
+
+2017-03-03 Chunyang Xu <mail@xuchunyang.me> (tiny change)
+
+ Fix completing-read call in reb-change-syntax
+
+ * lisp/emacs-lisp/re-builder.el (reb-change-syntax): Use 'default' arg
+ of completing-read.
+
+2017-03-03 Rolf Ade <rolf@pointsman.de> (tiny change)
+
+ sql-mode w/ sqlite: In-memory database
+
+ Enable the usage of an in-memory database. Prior to this, sql-mode w/
+ sqlite could only be used with file databases.
+ * lisp/progmodes/sql.el (sql-get-login-ext): Don't expand an empty
+ file name provided by the user, but call sub-process sqlite with that,
+ in which case it uses an in-memory database.
+
+2017-03-03 Allen Li <vianchielfaura@gmail.com>
+
+ Stop abbrev-prefix-mark from adding extra newline (Bug#25767)
+
+ `abbrev--before-point' does not adjust `pos' to account for when it
+ deletes the "-" left by abbrev-prefix-mark. Therefore, when
+ `abbrev-before-point' goes to restore point, it moves point one
+ character too far forward.
+
+ * lisp/abbrev.el (abbrev--before-point): Adjust pos when deleting "-".
+
+2017-03-03 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/subr.el (apply-partially): Move to 'Basic Lisp functions' section.
+
+2017-03-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore XFLOATINT but with restricted args
+
+ Turn instances of extract_float into XFLOAT_DATA when possible,
+ and to a resurrected XFLOATINT when the arg is a number.
+ The resurrected XFLOATINT is more like XFLOAT and XINT in
+ that is valid only if its arg is a number. This clarifies
+ the ways in which floats can be extracted at the C level.
+ * src/editfns.c (styled_format):
+ * src/floatfns.c (extract_float, Fexpt):
+ Use XFLOATINT rather than open-coding it.
+ * src/fns.c (internal_equal):
+ * src/image.c (imagemagick_load_image):
+ * src/xdisp.c (resize_mini_window):
+ Prefer XFLOAT_DATA to extract_float on values known to be floats.
+ * src/frame.c (x_set_screen_gamma):
+ * src/frame.h (NUMVAL):
+ * src/image.c (x_edge_detection, compute_image_size):
+ * src/lread.c (read_filtered_event):
+ * src/window.c (Fset_window_vscroll):
+ * src/xdisp.c (handle_single_display_spec, try_scrolling)
+ (redisplay_window, calc_pixel_width_or_height, x_produce_glyphs)
+ (on_hot_spot_p):
+ Prefer XFLOATINT to extract_float on values known to be numbers.
+ * src/lisp.h (XFLOATINT): Bring back this function, except
+ it now assumes its argument is a number.
+
+2017-03-02 Glenn Morris <rgm@gnu.org>
+
+ Ert commands to error if no test at point (bug#25931)
+
+ * lisp/emacs-lisp/ert.el (ert-results-mode-menu):
+ Deactivate some items if no test at point.
+ (ert--results-test-at-point-no-redefinition):
+ Add option to signal an error rather than return nil.
+ (ert-results-pop-to-backtrace-for-test-at-point)
+ (ert-results-pop-to-messages-for-test-at-point)
+ (ert-results-pop-to-should-forms-for-test-at-point)
+ (ert-results-describe-test-at-point): Error if no test at point.
+
+2017-03-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove XFLOATINT
+
+ * src/lisp.h (XFLOATINT): Remove this alias for extract_float.
+ All callers changed to use extract_float.
+ * src/frame.h (NUMVAL): Now an inline function, not a macro.
+
+2017-03-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix rounding errors in <, =, etc.
+
+ * etc/NEWS: Document this.
+ * src/bytecode.c (exec_byte_code):
+ * src/data.c (arithcompare):
+ Do not lose information when comparing floats to integers.
+ * test/src/data-tests.el (data-tests-=, data-tests-<)
+ (data-tests->, data-tests-<=, data-tests->=):
+ Test this.
+
+2017-03-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of mouse-highlight produced by overlapping overlays
+
+ * src/xfaces.c (face_at_buffer_position): If called to find the
+ mouse-face, only consider the highest-priority source for that
+ face, and ignore the rest. Previously, all the mouse-face
+ definitions at POS were merged in that case.
+ * src/xdisp.c (note_mouse_highlight): Record the overlay that
+ specifies mouse-face _after_ clearing the info about the previous
+ overlay, so as not to clear the information about the just-recorded
+ overlay. (Bug#25906)
+
+2017-03-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of strike-through text in variable-height lines
+
+ * src/nsterm.m (ns_draw_text_decoration):
+ * src/xterm.c (x_draw_glyph_string):
+ * src/w32term.c (x_draw_glyph_string): Fix calculation of the
+ strike-through y-coordinate for a glyph row which is taller than
+ the strike-through text. (Bug#25907)
+
+2017-03-02 Martin Rudalics <rudalics@gmx.at>
+
+ Don't call x_net_wm_state for scroll bar windows (Bug#24963, Bug#25887)
+
+ * src/xterm.c (handle_one_xevent): For ConfigureNotify events
+ don't call x_net_wm_state when the window is a scroll bar window.
+ (Bug#24963, Bug#25887)
+
+2017-03-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ gnus-summary-select-article-buffer: Don't re-render existing article
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-select-article-buffer):
+ Don't re-render existing article.
+
+2017-03-02 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Don't add debbugs address to message body (bug#25896)
+
+ * lisp/gnus/gnus-group.el (gnus-read-ephemeral-bug-group):
+ Don't add debbugs address to message body (bug#25896), and
+ don't add it to message header either if it already exists.
+
+2017-03-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/cedet/semantic/db-global.el: Make dynbind use explicit
+
+ (semanticdb--ih): Declare.
+ (semanticdb-enable-gnu-global-databases): Use it instead of `ih'.
+ (semanticdb-enable-gnu-global-in-buffer, semanticdb-get-database-tables)
+ (semanticdb-find-tags-for-completion-method): Silence compiler warning.
+
+2017-03-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/help-fns.el (describe-variable): Use cl-print for the value
+
+ Use `pp-buffer' rather than `pp' so as to avoid calling prin1 twice.
+
+2017-03-02 Glenn Morris <rgm@gnu.org>
+
+ * test/lisp/net/puny-tests.el: New file.
+
+2017-03-02 Glenn Morris <rgm@gnu.org>
+
+ Small puny.el fix
+
+ * lisp/net/puny.el (puny-decode-string-internal):
+ Handle strings with no ascii parts. (Bug#23688)
+
+2017-03-02 Glenn Morris <rgm@gnu.org>
+
+ Small recover-this-file improvement
+
+ * lisp/files.el (recover-this-file): Explicit error if not
+ visiting a file. (Bug#23671)
+
+2017-03-01 Glenn Morris <rgm@gnu.org>
+
+ Fix for coding-system completion (bug#23670)
+
+ * lisp/international/mule.el (read-buffer-file-coding-system):
+ Ensure that completion-pcm--delim-wild-regex is enclosed in parens,
+ so that completion-pcm--pattern->regex can append "*?".
+
+2017-03-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix rounding error in ‘ceiling’ etc.
+
+ Without this fix, (ceiling most-negative-fixnum -1.0) returns
+ most-negative-fixnum instead of correctly signaling range-error,
+ and similarly for floor, round, and truncate.
+ * configure.ac (trunc): Add a check, since Gnulib’s doc says
+ ‘trunc’ is missing from MSVC 9. The Gnulib doc says ‘trunc’ is
+ also missing from some other older operating systems like Solaris
+ 9 which I know we don’t care about any more, so MSVC is the only
+ reason to worry about ‘trunc’ here.
+ * src/editfns.c (styled_format): Formatting a float with %c is now an
+ error. The old code did not work in general, because FIXNUM_OVERFLOW_P
+ had rounding errors. Besides, the "if (FLOATP (...))" was in there
+ only as a result of my misunderstanding old code that I introduced
+ 2011. Although %d etc. is sometimes used on floats that represent
+ huge UIDs or PIDs etc. that do not fit in fixnums, this cannot
+ happen with characters.
+ * src/floatfns.c (rounding_driver): Rework to do the right thing
+ when the intermediate result equals 2.305843009213694e+18, i.e.,
+ is exactly 1 greater than MOST_POSITIVE_FIXNUM on a 64-bit host.
+ Simplify so that only one section of code checks for overflow,
+ rather than two.
+ (double_identity): Remove. All uses changed to ...
+ (emacs_trunc): ... this new function. Add replacement for
+ platforms that lack ‘trunc’.
+ * src/lisp.h (FIXNUM_OVERFLOW_P, make_fixnum_or_float):
+ Make it clear that the arg cannot be floating point.
+ * test/src/editfns-tests.el (format-c-float): New test.
+ * test/src/floatfns-tests.el: New file, to test for this bug.
+
+2017-03-01 Glenn Morris <rgm@gnu.org>
+
+ Small help--loaded-p fix
+
+ * lisp/help-fns.el (help--loaded-p): Handle entry in load-history
+ with nil file name. (Bug#25847)
+
+2017-03-01 Leo Liu <sdl.web@gmail.com>
+
+ * src/fns.c (Fbuffer_hash): Doc fix.
+
+2017-03-01 Eric Abrahamsen <eric@ericabrahamsen.net>
+
+ Don't use mapconcat with chars in gnus registry marks (Bug#25839)
+
+ * lisp/gnus/gnus-registry.el (gnus-registry-article-marks-to-chars):
+ Instead, use a plain concat, which will create a string out of a list
+ of characters.
+
+2017-03-01 Noam Postavsky <npostavs@gmail.com>
+
+ Fix epg-tests with dummy-pinentry program (Bug#23619)
+
+ * test/data/epg/dummy-pinentry: New file.
+ * test/lisp/epg-tests.el (with-epg-tests): Add it to gpg-agent.conf
+ when a passphrase is required. Add debug declaration. Set
+ GPG_AGENT_INFO non-destructively.
+
+2017-02-28 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Speed generation of ldefs-boot-auto
+
+ Previously, generation of ldefs-boot-auto required at least one full
+ bootstrap and, in extreme cases, two. Now, from build system, it
+ requires the same time as taken to dump Emacs.
+
+ * Makefile.in: Remove all calls, pass to src.
+ * admin/ldefs-clean.el: Update for changed messages.
+ * lisp/Makefile.in (compile-first-delete): Add.
+ * lisp/ldefs-boot-auto.el: Update.
+ * src/Makefile.in (generate-ldefs-boot): Add.
+
+2017-02-28 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Add error handling to magic-mode-alist
+
+ * lisp/files.el (set-auto-mode): Add explicit error handling in two
+ places.
+
+2017-02-28 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Remove conditional includes from bootstrap
+
+ Previously, bootstrap-emacs includes optional functionality, depending
+ on the platform which is not needed for bootstrap function. As a
+ result, bootstrap-emacs contains different functions in different
+ circumstances. If ldefs-boot-auto.el is generated, then loaded
+ functions will not be added to ldefs-boot-auto.el, although they may be
+ required during some builds. With this change, bootstrap-emacs should
+ always behave the same way and, therefore, require the same autoloads.
+
+ * lisp/loadup.el: No longer load optional includes during bootstrap
+ dumping.
+ * lisp/ldefs-boot-auto.el: Regenerate.
+ * lisp/ldefs-boot-manual.el: Add two autoloads.
+
+2017-02-28 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Do not use find-file non-interactively
+
+ * lisp/international/titdic-cnv.el (miscdic-convert): Use
+ insert-file-contents in place of find-file.
+
+2017-02-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * src/xdisp.c (overlay_arrows_changed_p): Fix return value and doc
+
+ (update_overlay_arrows): Skip non-markers.
+
+2017-02-28 Ken Brown <kbrown@cornell.edu>
+
+ Try to avoid hang when logging out of MS-Windows
+
+ * src/w32term.c (x_update_window_begin, x_update_window_end)
+ (my_show_window, my_set_window_pos, my_set_focus)
+ (my_set_foreground_window, my_destroy_window)
+ (my_bring_window_to_top, x_iconify_frame): Replace calls to
+ SendMessage by calls to SendMessageTimeout with a 6-second
+ timeout. (Bug#25875)
+
+2017-02-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/textmodes/reftex-toc.el (reftex-re-enlarge): Demote errors.
+
+2017-02-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc/misc/eieio.texi: Update to account for the cl-generic facilities
+
+ (Quick Start, Class Options, Generics): Adjust names for cl-generic.
+ (Methods): Document cl-defmethod.
+ Explain in more detail the order in which the various
+ methods are executed. Document the conditions under which a method
+ is redefined. Remove reference to `eieio-generic-call-arglst`.
+ Don't document the precise return value of cl-next-method-p.
+ (Static Methods): Adjust to use `subclass` specializer.
+ (Method Invocation): Use cl-call-next-method and drop mention of :primary.
+ (Signal Handling, Signals): Adjust names and args for cl-generic; add
+ cl-no-primary-method.
+ (CLOS compatibility, Wish List): Adjust to new featureset.
+
+2017-02-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/cedet/mode-local.el (define-mode-local-override): Declare doctring.
+
+ * lisp/nxml/nxml-mode.el (nxml-mode): Use new sgml-syntax-propertize.
+
+2017-02-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/textmodes/sgml-mode.el: syntax-propertize <![CDATA and <?..?>
+
+ (sgml-syntax-propertize-function): Mark <![CDATA and <?..?>.
+ (sgml-syntax-propertize-inside): New fun.
+
+2017-02-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/textmodes/css-mode.el (css-completion-at-point): Auto-insert
+
+ ": ;" after completing a property.
+
+2017-02-28 Tino Calancha <tino.calancha@gmail.com>
+
+ Show Ibuffer and jump to line listing current buffer
+
+ * lisp/ibuffer.el (ibuffer-jump): New command (Bug#25577).
+
+2017-02-27 Juri Linkov <juri@linkov.net>
+
+ * lisp/vc/add-log.el (change-log-next-buffer): Check if file exists
+
+ before adding it to the list of files.
+
+2017-02-27 Juri Linkov <juri@linkov.net>
+
+ Put text properties on query-replace separator string instead of "\0"
+
+ * lisp/replace.el (query-replace--split-string):
+ Split at a substring instead of just character.
+ (query-replace-read-from): Put text properties on the
+ separator string instead of "\0". (Bug#25482)
+
+2017-02-27 Juri Linkov <juri@linkov.net>
+
+ Add file name and its extension to suggestions in dired-mark-files-regexp
+
+ * lisp/dired.el (dired-mark-files-regexp): Add file name
+ and its extension to the list of suggested defaults. (Bug#25578)
+
+2017-02-27 Chunyang Xu <mail@xuchunyang.me> (tiny change)
+
+ Prompt default extension in dired-mark-extension
+
+ * lisp/dired-x.el (dired-mark-extension): Prompt default extension
+ based on extension of file at point. (Bug#25578)
+
+2017-02-27 Tino Calancha <tino.calancha@gmail.com>
+
+ Prevent for consing in cl-mapc and cl-mapl
+
+ * lisp/emacs-lisp/cl-extra.el (cl--mapcar-many): Add optional arg ACC;
+ If non-nil, accumulate values in the result (Bug#25826).
+ (cl-mapc): Do computations inside function instead of call cl-map.
+ (cl-mapl): Do computations inside function instead of call cl-maplist.
+ * lisp/emacs-lisp/cl-lib.el (mapcar): Add autoload cookie.
+ Call cl--mapcar-many with non-nil 3rd argument.
+ * test/lisp/emacs-lisp/cl-extra-tests.el (cl-extra-test-map)
+ (cl-extra-test-mapc, cl-extra-test-mapcar, cl-extra-test-mapl)
+ (cl-extra-test-maplist): New tests.
+
+2017-02-27 Tino Calancha <tino.calancha@gmail.com>
+
+ Choose the right target dir on dired operations
+
+ Prevent from changing the input target dir
+ when dired-dwim-target is non-nil (Bug#25609).
+ * lisp/dired-aux.el (dired-do-create-files):
+ If dired-dwim-target is non-nil, then bind 'default' to nil.
+ * test/lisp/dired-tests.el (dired-test-bug25609): Add test.
+
+2017-02-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * src/xdisp.c (overlay_arrows_changed_p): Fix last change.
+
+2017-02-27 Noam Postavsky <npostavs@gmail.com>
+
+ Don't record eshell/clear "command" in history (Bug#25838)
+
+ `eshell/clear' is implemented by sending a series of blank lines,
+ which is not a useful thing to have in the history.
+
+ * lisp/eshell/em-hist.el (eshell-input-filter-default): Use
+ `string-blank-p' which does check for newlines (even though newlines
+ have comment-end syntax, not whitespace syntax class).
+ * lisp/eshell/esh-mode.el (eshell/clear): Remove
+ `eshell-add-to-history' from `eshell-input-filter-functions' while
+ sending the blank lines. This change is needed to solve the bug if
+ the user customizes `eshell-input-filter' to something that doesn't
+ filter newlines.
+
+2017-02-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove a few unused C functions
+
+ * src/eval.c (let_shadows_global_binding_p):
+ * src/print.c (write_string):
+ * src/systhread.c (sys_mutex_destroy, sys_thread_equal):
+ Remove.
+ * src/print.c (write_string): Rename from write_string_1.
+ All uses changed.
+
+2017-02-26 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid segfault in overlay_arrows_changed_p
+
+ * src/xdisp.c (overlay_arrows_changed_p): Fix recent change
+ to avoid a segfault.
+
+2017-02-26 Noam Postavsky <npostavs@gmail.com>
+
+ Don't call package--ensure-init-file if initialized during startup
+
+ * lisp/emacs-lisp/package.el (package-initialize): Check
+ `after-init-time' rather than `load-file-name' to decide if
+ `package--ensure-init-file' should be called. Depending on
+ `load-file-name' will fail if the user calls `pacakge-initialize' in
+ file which is loaded from the init file (Bug#24643, Bug#25819).
+
+2017-02-26 Eli Zaretskii <eliz@gnu.org>
+
+ Fix display of before- and after-strings at invisible text
+
+ * src/xdisp.c (next_overlay_string): Don't raise the
+ ignore_overlay_strings_at_pos_p flag if the iterator is already
+ set to continue at a buffer position different from the one
+ where the overlay strings we just processed were loaded. (Bug#25856)
+
+2017-02-26 Michael Albinus <michael.albinus@gmx.de>
+
+ Work on `tramp-completion-mode-p'
+
+ * etc/NEWS: Say that `tramp-completion-mode' is obsolete.
+
+ * lisp/net/tramp.el (tramp-completion-mode): Make it obsolete.
+ (tramp-completion-mode-p): Reintroduce the check for 'tab.
+
+2017-02-25 Tom Tromey <tom@tromey.com>
+
+ Use font-lock-doc-face in js-mode
+
+ Bug#25858:
+ * lisp/progmodes/js.el (js-font-lock-syntactic-face-function): New
+ defun.
+ (js-mode): Use it.
+ * test/lisp/progmodes/js-tests.el (js-mode-doc-comment-face): New
+ test.
+
+2017-02-25 Noam Postavsky <npostavs@gmail.com>
+
+ Don't use IP 0.0.0.0 for package test server (Bug#22582)
+
+ * test/lisp/emacs-lisp/package-resources/package-test-server.py: Set
+ 'server_address' when port number is given on the command line. Print
+ IP and port number as a URL, and flush it after printing.
+ * test/lisp/emacs-lisp/package-tests.el:
+ (package-test-update-archives-async): Grab the whole URL from server
+ output.
+
+2017-02-25 Tom Tromey <tom@tromey.com>
+
+ Add more branch support to vc-dir
+
+ Bug#25859:
+ * lisp/vc/vc-dir.el (vc-dir-mode-map) Add "B" bindings.
+ * lisp/vc/vc.el (vc-revision-history): New defvar.
+ (vc-read-revision): Use vc-revision-history.
+ (vc-print-branch-log): New function.
+ * doc/emacs/maintaining.texi (VC Directory Commands): Document new
+ bindings.
+ * etc/NEWS: Mention new vc-dir bindings.
+
+2017-02-25 Alan Mackenzie <acm@muc.de>
+
+ Allow for the :: operator in C++ "enum class" declarations.
+
+ * lisp/progmodes/cc-engine.el (c-backward-typed-enum-colon): Check for
+ "::".
+
+2017-02-25 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix bug#25854
+
+ * lisp/net/tramp-sh.el (tramp-do-file-attributes-with-ls):
+ Simplify error handling for huge inodes.
+ (tramp-convert-file-attributes): Handle very huge inodes. (Bug#25854)
+
+2017-02-25 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid leaving garbage on screen when using 'raise' display property
+
+ * src/xdisp.c (display_line): Reset voffset value of the iterator
+ when it hits ZV, to avoid "inheriting" it to glyph rows past ZV,
+ which then leaves stuff on screen that needs to be cleared by
+ redisplay. (Bug#25855)
+
+2017-02-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix doc strings in info.el
+
+ * lisp/info.el (Info-selection-hook, Info-mode-hook)
+ (Info-edit-mode-hook): Doc fixes. (Bug#25794)
+
+2017-02-25 Eli Zaretskii <eliz@gnu.org>
+
+ Fix doc string of 'posn-at-point'
+
+ * src/keyboard.c (Fposn_at_point): Clarify the doc string.
+ (Bug#25796)
+
+2017-02-25 Peder O. Klingenberg <peder@klingenberg.no>
+
+ New option -u / --suppress-output to emacsclient
+
+ * lib-src/emacsclient.c (print_help_and_exit, longopts)
+ (decode_options, main): Implement new option --suppress-output / -u to
+ suppress printing of eval-results.
+ * doc/emacs/misc.texi (emacsclient Options): Document the new
+ "--suppress-output/-u" options.
+ * etc/NEWS: Mention the new options.
+
+2017-02-25 Noam Postavsky <npostavs@gmail.com>
+
+ Fix scrolling with partial line corner case (Bug#25792)
+
+ Also fix up the scrolling tests so that they don't make so many
+ assumptions about the current window configuration.
+
+ * src/xdisp.c (try_window): Take partial line height into account when
+ comparing cursor position against scroll margin.
+
+ * test/manual/scroll-tests.el (scroll-tests-with-buffer-window): Add
+ HEIGHT argument, to allow setting up window with exact height and
+ partial line.
+ (scroll-tests-display-buffer-with-height): New display-buffer action
+ function.
+ (scroll-tests-scroll-margin-over-max):
+ (scroll-tests--scroll-margin-whole-window): Pass HEIGHT to
+ `scroll-tests--scroll-margin-whole-window'.
+ (scroll-tests-conservative-show-trailing-whitespace): New test.
+ (scroll-tests-scroll-margin-negative): Fix line counting.
+ (scroll-tests--point-in-middle-of-window-p): Set window height
+ properly.
+
+2017-02-25 Tom Tromey <tom@tromey.com>
+
+ Fix indentation error in js.el
+
+ * lisp/progmodes/js.el (js--indent-in-array-comp): Wrap forward-sexp
+ call in condition-case.
+ * test/lisp/progmodes/js-tests.el (js-mode-indentation-error): New
+ test.
+
+2017-02-24 Tom Tromey <tom@tromey.com>
+
+ add "async" and "await" keywords
+
+ * lisp/progmodes/js.el (js--keyword-re): Add async, await.
+
+2017-02-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Use cl-print for Edebug and EIEIO
+
+ * lisp/emacs-lisp/edebug.el (edebug-prin1-to-string): Use cl-print.
+ (edebug-prin1, edebug-print): Remove.
+
+ * lisp/emacs-lisp/eieio.el (object-print): Declare obsolete.
+ (cl-print-object): Add a method for EIEIO objects.
+ (eieio-edebug-prin1-to-string): Delete.
+ (edebug-prin1-to-string): Don't advise any more.
+
+ * lisp/emacs-lisp/eieio-datadebug.el (data-debug-insert-object-button):
+ Replace `object-print' -> `cl-prin1-to-string'.
+
+2017-02-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Fix left over uses of `call-next-method'
+
+ * lisp/cedet/semantic/db-global.el (object-print):
+ * lisp/cedet/semantic/db.el (object-print): Use `cl-call-next-method'.
+
+2017-02-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Minor redisplay optimizations
+
+ * src/frame.c (Ficonify_frame): No need to redisplay everything.
+
+ * src/xdisp.c (overlay_arrows_changed_p): Add `set_redisplay' argument.
+ (redisplay_internal): Use it to avoid redisplaying everything.
+ (try_window_id): Use it keep the same behavior as before.
+
+2017-02-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-print.el: New file
+
+ * lisp/emacs-lisp/nadvice.el (advice--where): New function.
+ (advice--make-docstring): Use it.
+
+ * src/print.c (print_number_index): Don't declare here any more.
+ (Fprint_preprocess): New function.
+
+ * test/lisp/emacs-lisp/cl-print-tests.el: New file.
+
+2017-02-24 Peder O. Klingenberg <peder@klingenberg.no>
+
+ Make calc's least common multiple positive (bug#25255)
+
+ * lisp/calc/calc-comb.el (calcFunc-lcm): Return absolute value.
+ * doc/misc/calc.texi (Combinatorial Functions): Update for the above.
+
+2017-02-24 Tino Calancha <tino.calancha@gmail.com>
+
+ Documentation fix in elisp reference manual
+
+ * doc/lispref/macros.texi (Defining Macros): Drop redundant mention
+ on 'declare' forms (Bug#25846).
+
+2017-02-24 Gemini Lasswell <gazally@runbox.com>
+
+ Support read syntax for circular objects in Edebug (Bug#23660)
+
+ * lisp/emacs-lisp/edebug.el (edebug-read-special): New name
+ for edebug-read-function. Handle the read syntax for circular
+ objects.
+ (edebug-read-objects): New variable.
+ (edebug-read-and-maybe-wrap-form1): Reset edebug-read-objects.
+
+ * src/lread.c (Fsubstitute_object_in_subtree): Make
+ substitute_object_in_subtree into a Lisp primitive.
+
+2017-02-24 Lixin Chin <lixinchin@gmail.com> (tiny change)
+
+ Add Conference to the list of valid bibtex entry types
+
+ * lisp/textmodes/bibtex.el (bibtex-BibTeX-entry-alist):
+ Add Conference as a duplicate of InProceedings. (Bug#25143)
+
+2017-02-23 Glenn Morris <rgm@gnu.org>
+
+ * lisp/comint.el (comint-password-prompt-regexp): Add SUDO. (Bug#24817)
+
+2017-02-23 Glenn Morris <rgm@gnu.org>
+
+ Small dunnet score file improvements
+
+ * lisp/play/dunnet.el (dun-log-file): Switch to per-user default.
+ (dun-do-logfile): Handle non-existing score file.
+
+2017-02-23 Glenn Morris <rgm@gnu.org>
+
+ * lisp/play/dunnet.el (dun-help): Doc fix.
+
+2017-02-23 Mark Oteiza <mvoteiza@udel.edu>
+
+ Declare dun-line and dun-line-list
+
+ Previously, there were free variables 'line' and 'line-list'.
+ * lisp/play/dunnet.el (dun-line, dun-line-list): New variables.
+ (dun-press, dun-vparse, dun-parse2, dun-unix-parse, dun-batch-parse):
+ (dun-batch-parse2, dun-batch-loop, dun-batch-dos-interface):
+ (dun-batch-unix-interface): Use them.
+
+2017-02-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-02-16 xbinary-io: rename from xsetmode
+ 2017-02-15 xsetmode: new module
+ * lib-src/etags.c (main):
+ * lib-src/hexl.c (main):
+ * src/emacs.c (main) [MSDOS]:
+ Prefer set_binary_mode to the obsolescent SET_BINARY.
+ * lib/binary-io.c, lib/binary-io.h: Copy from gnulib.
+
+2017-02-23 Paul Eggert <eggert@cs.ucla.edu>
+
+ hexl: handle large files and I/O errors
+
+ * lib-src/hexl.c: Include inttypes.h, for PRIxMAX etc.
+ Do not include ctype.h, as the code no longer uses isdigit.
+ (DEFAULT_GROUPING, un_flag, iso_flag, group_by): Now local to ‘main’.
+ (DEFAULT_BASE, endian): Remove; was not really used.
+ (usage): Remove; now done by ‘main’, as that’s simpler.
+ (progname): Now static.
+ (output_error, hexchar): New functions.
+ (main): Use them. Simplify. Remove "-oct", "-big-endian", and
+ "-little-endian" options, as they did not work and were not used.
+ Use SET_BINARY only on stdin, and fopen with "rb" otherwise.
+ Use SET_BINARY only once on stdout.
+ Do not assume file offsets fit in ‘long’.
+ If an I/O error occurs, report it and exit with nonzero status.
+
+2017-02-23 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid quitting inside a critical section on MS-Windows
+
+ * src/w32uniscribe.c (uniscribe_list_family):
+ * src/w32font.c (w32font_list_family, w32font_text_extents)
+ (w32font_list_internal, w32font_match_internal)
+ (list_all_matching_fonts): Prevent quitting while these functions
+ cons lists of fonts, to avoid leaving the critical section taken
+ by the main thread, which will then cause any other thread
+ attempting to enter the critical section to hang. (Bug#25279)
+
+2017-02-22 Dmitry Gutov <dgutov@yandex.ru>
+
+ Use revision-completion-table in vc-retrieve-tag
+
+ * lisp/vc/vc.el (vc-retrieve-tag): Use the
+ revision-completion-table command for completion (bug#25710).
+
+2017-02-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-generic.el (cl--generic-typeof-types): Add `atom'
+
+ remove entries whose car can't be returned by type-of.
+ (cl--generic-all-builtin-types): New var.
+ (cl-generic-generalizers): Use it to avoid requiring
+ extra entries in cl--generic-typeof-types.
+
+2017-02-22 Noam Postavsky <npostavs@gmail.com>
+
+ Find macro binding for symbol-bound macros too (Bug#6848)
+
+ There are 2 ways to bind a macro: with global-set-key or
+ kmacro-bind-to-key. The former binds a key to a symbol, while the
+ latter binds to a lambda. In 2010-03-03 "Fix keyboard macro key
+ lookup (Bug#5481)", `insert-kbd-macro' was fixed to detect the lambda
+ case, but broke the symbol case.
+
+ * lisp/macros.el (insert-kbd-macro): Also check for bindings of
+ MACRONAME.
+
+2017-02-22 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Fix last change
+
+2017-02-22 Juri Linkov <juri@linkov.net>
+
+ * lisp/isearch.el (lazy-highlight-max-at-a-time): Doc fix (bug#21092).
+
+2017-02-22 Juri Linkov <juri@linkov.net>
+
+ * lisp/isearch.el (isearch-lazy-highlight): New choice ‘all-windows’.
+
+ (isearch-lazy-highlight-update): Check it to decide whether to apply
+ overlays only on the selected window.
+
+ * lisp/follow.el (follow-mode): Set isearch-lazy-highlight to ‘all-windows’.
+ (Bug#17453, bug#21092)
+
+2017-02-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Minor weak hash table performance tweaks
+
+ * src/fns.c (make_hash_table): Omit unnecessary assignment to
+ h->next_weak when the hash table is not weak.
+ (copy_hash_table): Put the copy next to the original in the
+ weak_hash_tables list, as this should have better locality
+ when scanning the weak hash tables.
+
+2017-02-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use float instead of Lisp_Object for rehash_size
+
+ * src/alloc.c (purecopy_hash_table):
+ * src/fns.c (maybe_resize_hash_table, Fmake_hash_table):
+ (Fhash_table_rehash_size):
+ * src/lisp.h (struct Lisp_Hash_Table.rehash_size):
+ The rehash_size member of struct Lisp_Hash_Table is now a
+ float, not a Lisp_Object.
+ * src/alloc.c (purecopy_hash_table): Assign members in order.
+ * src/fns.c (make_hash_table): Use EMACS_INT for size and
+ float for rehash_size, instead of Lisp_Object for both.
+ All callers changed.
+ * src/lisp.h (DEFAULT_REHASH_SIZE): Now float, not double,
+ and 1 smaller.
+ * src/print.c (print_object): Simplify by calling
+ Fhash_table_rehash_size and Fhash_table_rehash_threshold.
+ Avoid unnecessary NILP.
+
+2017-02-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use ptrdiff_t instead of Lisp_Object for collision
+
+ * src/alloc.c (purecopy_hash_table): Assign, don’t purecopy.
+ * src/fns.c (set_hash_next_slot, set_hash_index_slot): Hash index
+ arg is now ptrdiff_t index (or -1 if empty), not Lisp_Object
+ integer (or Qnil if empty). All callers changed.
+ (larger_vecalloc): New static function.
+ (larger_vector): Use it.
+ (HASH_NEXT, HASH_INDEX): Move here from lisp.h. Return ptrdiff_t
+ index (or -1) not Lisp_Object integer (or Qnil). All callers changed.
+ * src/fns.c (make_hash_table, maybe_resize_hash_table, hash_lookup)
+ (hash_put, hash_remove_from_table, hash_clear, sweep_weak_table):
+ * src/profiler.c (evict_lower_half, record_backtrace):
+ -1, not nil, is now the convention for end of collision list.
+ * src/fns.c (maybe_resize_hash_table): Avoid double-initialization
+ of the free list. Reallocate H->next last, in case other
+ reallocations exhaust memory.
+ * src/lisp.h (struct Lisp_Hash_Table): ‘next_free’ is now
+ ptrdiff_t, not Lisp_Object. Adjust commentary for ‘next’ and
+ ‘index’, which no longer contain nil.
+ (HASH_NEXT, HASH_INDEX): Move to src/fns.c.
+
+2017-02-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Hash table threshold is now float, not double
+
+ Change default from 0.8 to 0.8125 so it fits in float without
+ rounding glitches.
+ * doc/lispref/hash.texi (Creating Hash):
+ * doc/lispref/objects.texi (Hash Table Type):
+ * etc/NEWS:
+ Document change.
+ * src/fns.c (make_hash_table, maybe_resize_hash_table)
+ (Fmake_hash_table): Threshold is now float, not double.
+ Be consistent about how this is rounded.
+ * src/lisp.h (struct Lisp_Hash_Table.rehash_threshold):
+ Change back to float, now that the other code rounds consistently.
+ (DEFAULT_REHASH_THRESHOLD): Now float 0.8125 instead of double 0.8.
+
+2017-02-22 Juri Linkov <juri@linkov.net>
+
+ Avoid flicker in lazy-highlight by doing all updates without redisplay.
+
+ * lisp/isearch.el (lazy-highlight-max-at-a-time):
+ Change default value from 20 to nil to not trigger redisplay
+ between updating iterations.
+ (lazy-highlight-cleanup): New arg ‘procrastinate’ to not remove
+ overlays when non-nil.
+ (isearch-lazy-highlight-new-loop): Call lazy-highlight-cleanup
+ with non-nil second arg when the search string is not empty.
+ Run timer with isearch-lazy-highlight-start instead of
+ isearch-lazy-highlight-update.
+ (isearch-lazy-highlight-start): New function. (Bug#25751)
+
+2017-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/autoload.el (make-autoload): Support cl-defgeneric
+
+ * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Tweak for autoloading.
+
+2017-02-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/cl-preloaded.el (cl-struct-define): Fix duplication
+
+ which resulted in incomplete list of parents in one copy of the
+ cl-structure-class class.
+
+2017-02-21 Glenn Morris <rgm@gnu.org>
+
+ Tweak recent custom-reevaluate-setting change
+
+ * lisp/custom.el (custom-reevaluate-setting):
+ Tweak previous change to avoid font-lock init issues.
+
+2017-02-21 Glenn Morris <rgm@gnu.org>
+
+ Ensure delayed-init custom variables get marked special
+
+ * lisp/custom.el (custom-reevaluate-setting):
+ If the variable has never been set, defvar it. (Bug#25770)
+
+2017-02-21 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn on lexical-binding in dunnet.el
+
+ * lisp/play/dunnet.el: Turn on lexical-binding. Re-instate lexical
+ byte compile warnings.
+
+2017-02-21 Mark Oteiza <mvoteiza@udel.edu>
+
+ Make dunnet insertion functions n-ary
+
+ * lisp/play/dunnet.el (dun-mprinc, dun-mprincl, dun-minsert):
+ (dun-minsertl, dun-batch-mprinc, dun-batch-mprincl): Change to accept
+ any number of arguments.
+ (dun-parse, dun-describe-room, dun-quit, dun-inven, dun-shake):
+ (dun-take, dun-go, dun-move, dun-press, dun-score):
+ (dun-compile-save-out, dun-do-logfile): Collect arguments from
+ multiple insertion calls into less calls with more args.
+
+2017-02-21 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ message-goto-body-1: Fix regexp so as not to match multi-line
+
+ * lisp/gnus/message.el (message-goto-body-1):
+ Fix regexp so as not to match multi-line.
+
+2017-02-20 Noam Postavsky <npostavs@gmail.com>
+
+ Simplify cl-get using `plist-member'
+
+ * lisp/emacs-lisp/cl-extra.el (cl-get, cl-getf, cl--set-getf): Use
+ `plist-member' instead of explicit loop.
+ * test/lisp/emacs-lisp/cl-extra-tests.el: New tests.
+
+2017-02-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Verify xwidget USE_LSB_TAG assumption
+
+ * src/xwidget.c (Fxwidget_webkit_execute_script):
+ Add verification. Problem reported by Andreas Schwab (Bug#25816#8).
+
+2017-02-20 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * src/insdel.c (make_gap): Improve comment.
+
+2017-02-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Do not use switch-to-buffer for working in a temp buffer
+
+ * lisp/play/dunnet.el (dunnet): Use pop-to-buffer-same-window instead,
+ cf. Bug#22244.
+ (dun-load-d, dun-eval, dun-save-game, dun-do-logfile): Use
+ with-temp-buffer instead.
+
+2017-02-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Make dun-room-shorts a defconst
+
+ * lisp/play/dunnet.el (dun-room-shorts): Make defconst and collect
+ initial value into the declaration.
+ (dun-space-to-hyphen): Remove.
+
+2017-02-20 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port xwidget to -DCHECK_LISP_OBJECT_TYPE
+
+ * src/xwidget.c (webkit_javascript_finished_cb)
+ (Fxwidget_webkit_execute_script): Don't assume Lisp_Object is an
+ integer. This fix is just a hack; I’ll file a bug report about
+ the underlying problem.
+
+2017-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ mm-decode.el: Simplify regexp used to search html meta tag
+
+ * lisp/gnus/mm-decode.el (mm-add-meta-html-tag, mm-shr):
+ Simplify regexp used to search html meta tag.
+
+2017-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ mm-shr: Ignore coding-system `ascii'
+
+ * lisp/gnus/mm-decode.el (mm-shr): Ignore coding-system `ascii'.
+
+2017-02-20 Tom Tromey <tom@tromey.com>
+
+ vc-log-outgoing fixes for git; add binding to vc-dir
+
+ * lisp/vc/vc-dir.el (vc-dir-mode-map): Bind "O" to vc-log-outgoing.
+ * lisp/vc/vc-git.el (vc-git-log-outgoing, vc-git-log-incoming): Use
+ async execution.
+ (vc-git-log-view-mode): Also truncate lines for log-outgoing and
+ log-incoming.
+ * lisp/vc/vc.el (vc-log-incoming, vc-log-outgoing): Don't pass nil
+ as remote-location argument.
+
+2017-02-20 Tom Tromey <tom@tromey.com>
+
+ Remove stale comments from vc-git and vc-hg
+
+ * lisp/vc/vc-git.el (vc-git-retrieve-tag): Remove comment.
+ * lisp/vc/vc-hg.el (vc-hg-retrieve-tag): Remove comment.
+
+2017-02-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Remove member clone
+
+ * lisp/play/dunnet.el (dun-answer): Use member instead.
+ (dun-members): Remove.
+
+2017-02-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Prefix global var
+
+ * lisp/play/dunnet.el (room): Rename to dun-room.
+ (dun-messages, dunnet, dun-describe-room, dun-drop, dun-move):
+ (dun-restore, dun-do-logfile, dun-batch-loop): Use new name.
+
+2017-02-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace nested ifs with cond
+
+ * lisp/play/dunnet.el (dun-messages, dun-describe-room, dun-examine):
+ (dun-eat, dun-put-objs, dun-turn, dun-press, dun-ls, dun-cd): Use when
+ and cond where appropriate.
+ (dun-sauna-heat): Accept sauna level as an argument. Use cond.
+ (dun-take): Use null and dun-mprincl.
+ (dun-inven-weight, dun-load-d): Reformat.
+ (dun-remove-obj-from-inven, dun-remove-obj-from-room): Nix setq to nil.
+
+2017-02-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix glitches in recent hash table changes
+
+ * src/fns.c (Fmake_hash_table): Simplify the machine code slightly
+ by using 0 rather than -1.
+ * src/lisp.h (struct Lisp_Hash_Table.pure): Now bool rather
+ than a bitfield, for speed (the bitfield did not save space).
+ (struct Lisp_Hash_Table.rehash_threshold): Now double rather than
+ float, since the float caused unwanted rounding errors, e.g.,
+ (hash-table-rehash-threshold (make-hash-table)) yielded
+ 0.800000011920929 instead of the correct 0.8.
+
+2017-02-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * src/insdel.c (make_gap): Increase enough to avoid O(N^2) behavior.
+
+2017-02-19 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid aborts during loadup
+
+ * src/emacs-module.c (syms_of_module):
+ * src/image.c (xpm_make_color_table_h): Update calls to
+ make_hash_table to adjust to a recent change in fns.c.
+ * src/fns.c (make_hash_table):
+ * src/lisp.h (make_hash_table): 4th arg is now of type double.
+
+2017-02-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Rework connection local variables
+
+ For connection local variables interface, `class' is renamed
+ to `profile'. All arguments `criteria' are a plist now.
+
+ * doc/lispref/variables.texi (Connection Local Variables):
+ Rewrite.
+
+ * lisp/files-x.el (connection-local-profile-alist): Rename
+ from `connection-local-class-alist'. Adapt docstring.
+ (connection-local-criteria-alist): Adapt docstring.
+ (connection-local-normalize-criteria): New defun.
+ (connection-local-get-profiles): Rename from
+ `connection-local-get-classes'. Rewrite.
+ (connection-local-set-profiles): Rename from
+ `connection-local-set-classes'. Rewrite.
+ (connection-local-get-profile-variables): Rename from
+ `connection-local-get-class-variables'. Rewrite.
+ (connection-local-set-profile-variables): Rename from
+ `connection-local-set-class-variables'. Rewrite.
+ (hack-connection-local-variables)
+ (hack-connection-local-variables-apply)): Rewrite.
+ (with-connection-local-profiles): Rename from
+ `ith-connection-local-classes'. Rewrite.
+
+ * lisp/net/tramp.el (tramp-set-connection-local-variables):
+ Compute criteria.
+
+ * lisp/net/tramp-cmds.el (tramp-bug):
+ Use `connection-local-profile-alist'.
+
+ * test/lisp/files-x-tests.el (files-x-test--variables1)
+ (files-x-test--variables2, files-x-test--variables3)
+ (files-x-test--variables4, files-x-test--criteria1)
+ (files-x-test--criteria2): Make them a defconst.
+ (files-x-test--application)
+ (files-x-test--another-application, files-x-test--protocol)
+ (files-x-test--user, files-x-test--machine): New defconst.
+ (files-x-test--criteria): New defvar.
+ (files-x-test--criteria3): Remove.
+ (files-x-test-connection-local-set-profile-variables):
+ Rename from `files-x-test-connection-local-set-class-variables'.
+ Rewrite.
+ (files-x-test-connection-local-set-profiles): Rename from
+ `files-x-test-connection-local-set-classes'. Rewrite.
+ (files-x-test-hack-connection-local-variables-apply) Rewrite.
+ (files-x-test-with-connection-local-profiles): Rename from
+ `files-x-test-with-connection-local-classes'. Rewrite.
+
+2017-02-19 Mark Oteiza <mvoteiza@udel.edu>
+
+ Set up combination and random item location
+
+ * lisp/play/dunnet.el (dun-combination): Make defconst.
+ (tloc, tcomb): Remove. Replace with a top-level form.
+
+2017-02-19 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace movement variables with an alist and accessor
+
+ * lisp/play/dunnet.el (north, south, east, west, northeast, southeast):
+ (northwest, southwest, up, down, in, out): Remove.
+ (dun-movement-alist): New constant.
+ (dun-movement): New function.
+ (dun-n, dun-s, dun-e, dun-w, dun-ne, dun-se, dun-nw, dun-sw, dun-up):
+ (dun-down, dun-in, dun-out): Use a symbol for indicating movement.
+ (dun-move, dun-special-move): Translate movement symbol to an
+ enumeration.
+
+2017-02-19 Mark Oteiza <mvoteiza@udel.edu>
+
+ Change top-level setq forms to defvar or defconst
+
+ Also collect some code onto fewer lines and reindent.
+ * lisp/play/dunnet.el (dun-visited, dun-current-room, dun-exitf):
+ (dun-badcd, dun-computer, dun-floppy, dun-key-level, dun-hole):
+ (dun-correct-answer, dun-lastdir, dun-numsaves, dun-jar, dun-dead):
+ (room, dun-numcmds, dun-wizard, dun-endgame-question, dun-logged-in):
+ (dungeon-mode, dun-unix-verbs, dun-dos-verbs, dun-batch-mode):
+ (dun-cdpath, dun-cdroom, dun-uncompressed, dun-ethernet):
+ (dun-restricted, dun-ftptype, dun-endgame, dun-rooms):
+ (dun-light-rooms, dun-verblist, dun-inbus, dun-nomail, dun-ignore):
+ (dun-mode, dun-sauna-level, north, south, east, west, northeast):
+ (southeast, northwest, southwest, up, down, in, out, dungeon-map):
+ (dun-objnames, obj-special, dun-room-objects, dun-room-silents):
+ (dun-inventory, dun-objects, dun-object-lbs, dun-object-pts):
+ (dun-objfiles, dun-perm-objects, dun-physobj-desc, dun-permobj-desc):
+ (dun-diggables, dun-room-shorts, dun-endgame-questions): Change
+ declaration to use defvar or defconst.
+ (dun-doverb, dun-vparse, dun-vparse2, dun-batch-parse):
+ (dun-batch-parse2): Omit the dun- prefix from arguments dun-ignore
+ dun-verblist. Those are now constants and the byte compiler doesn't
+ allow defconsts in lambda lists.
+
+2017-02-19 Mark Oteiza <mvoteiza@udel.edu>
+
+ Move all dunnet globals up to the top
+
+ * lisp/play/dunnet.el: Adjust comments to reflect moved forms.
+ (dun-visited, dun-current-room, dun-exitf):
+ (dun-badcd, dun-computer, dun-floppy, dun-key-level, dun-hole):
+ (dun-correct-answer, dun-lastdir, dun-numsaves, dun-jar, dun-dead):
+ (room, dun-numcmds, dun-wizard, dun-endgame-question, dun-logged-in):
+ (dungeon-mode, dun-unix-verbs, dun-dos-verbs, dun-batch-mode):
+ (dun-cdpath, dun-cdroom, dun-uncompressed, dun-ethernet):
+ (dun-restricted, dun-ftptype, dun-endgame, dun-rooms):
+ (dun-light-rooms, dun-verblist, dun-inbus, dun-nomail, dun-ignore):
+ (dun-mode, dun-sauna-level, north, south, east, west, northeast):
+ (southeast, northwest, southwest, up, down, in, out, dungeon-map):
+ (dun-objnames, obj-special, dun-room-objects, dun-room-silents):
+ (dun-inventory, dun-objects, dun-object-lbs, dun-object-pts):
+ (dun-objfiles, dun-perm-objects, dun-physobj-desc, dun-permobj-desc):
+ (dun-diggables, dun-room-shorts, dun-endgame-questions): Move to the
+ top of the file, before any uses.
+
+2017-02-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix bug#25788
+
+ * lisp/net/tramp.el (tramp-autoload-file-name-handler):
+ Do not load tramp.el just for "/". (Bug#25788)
+
+2017-02-19 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
+
+ Fix fringe bitmap initialization on MS-Windows
+
+ * src/fringe.c (init_fringe_bitmap) [HAVE_NTGUI]: Fix initialization
+ of fb->bits. (Bug#25673)
+
+2017-02-19 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Change type of `rehash_threshold' and `pure' fields in hash-tables
+
+ * src/lisp.h (struct Lisp_Hash_Table): Change type of
+ `rehash_threshold' and `pure' fields and move them after `count'.
+ * src/fns.c (make_hash_table): Change type of `rehash_threshold' and `pure'.
+ (Fmake_hash_table, Fhash_table_rehash_threshold):
+ * src/category.c (hash_get_category_set):
+ * src/xterm.c (syms_of_xterm):
+ * src/profiler.c (make_log):
+ * src/print.c (print_object):
+ * src/alloc.c (purecopy_hash_table, purecopy): Adjust accordingly.
+
+2017-02-19 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use 'char *FOO' instead of 'char* FOO'
+
+2017-02-19 Mark Oteiza <mvoteiza@udel.edu>
+
+ More json.el changes
+
+ * lisp/json.el (json-read-keyword, json-read-number, json-read-object):
+ (json-read-array): Just use = for char comparison.
+
+2017-02-18 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/woman.el (woman): Fix docstring prefix arg description.
+
+2017-02-18 Alan Mackenzie <acm@muc.de>
+
+ Fix edebug-spec on c-lang-defvar.
+
+ This allows c-lang-defvars with the symbol 'dont-doc in the place of the
+ optional documentation to be instrumented for edebug.
+
+ lisp/progmodes/cc-langs.el (top-level): Amend the edebug-spec for
+ c-lang-defvar.
+ (c-opt-identifier-concat-key, c-decl-prefix-or-start-re): remove redundant
+ 'dont-doc.
+
+2017-02-18 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Lists used as plists now have to be an even length
+
+ * lisp/net/eww.el (eww-size-text-inputs): `eww-form' isn't a plist.
+ (eww-process-text-input): Not here, either.
+
+2017-02-18 Michael Albinus <michael.albinus@gmx.de>
+
+ Unset `non-essential' in Tramp when not needed anymore
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.3.2-pre".
+
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection):
+ Use `tramp-completion-mode-p'.
+
+ * lisp/net/tramp.el (tramp-file-name-handler): Unset `non-essential'
+ when file name doesn't match `tramp-completion-file-name-regexp'.
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Automatically regenerate emacs.1 and *.rc files
+
+ * Makefile.in (CONFIG_STATUS_FILES_IN): New variable, lists
+ non-Makefile files produced by config.status.
+ ($(MAKEFILE_NAME)): Depend on $(CONFIG_STATUS_FILES_IN), so that
+ their targets are regenerated when the source changes.
+
+2017-02-18 Alan Mackenzie <acm@muc.de>
+
+ Set the syntax table in AWK Mode.
+
+ This is a partial reversion of CC Mode commit on 2016-05-09 17:49:45 +0000.
+ It fixes bug #25722.
+
+ lisp/progmodes/cc-mode.el (awk-mode): Explicitly set the syntax table.
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Mention "editor" in Emacs man page header
+
+ * doc/man/emacs.1.in: Mention "editor" in the header line.
+ (Bug#25771, Bug#25779)
+
+2017-02-18 Göktuğ Kayaalp <self@gkayaalp.com>
+
+ Fix Turkish language environment setup
+
+ * lisp/language/european.el ("Turkish"): Fix a typo in Turkish
+ language setup. (Bug#25763)
+
+2017-02-18 Rami Ylimäki <rami.ylimaki@vincit.fi>
+
+ Support 24-bit direct colors on text terminals
+
+ * src/term.c (init_tty): Use 24-bit terminal colors if corresponding
+ foreground and background functions are present in terminal type
+ definition.
+ * src/tparam.h: Define prototype for tigetstr.
+
+ * lisp/term/tty-colors.el (tty-color-define): Convert color palette
+ index to pixel value on 16.7M color terminals.
+ (tty-color-24bit): New function to convert color palette index to
+ pixel value on 16.7M color terminals.
+ (tty-color-desc): Don't approximate colors on 16.7M color terminals.
+ * lisp/term/xterm.el (xterm-register-default-colors): Define all named
+ TTY colors on 16.7M color terminals.
+
+ * doc/misc/efaq.texi (Colors on a TTY): Add instructions on how to
+ enable direct color TTY mode.
+ * etc/NEWS: Mention direct color TTY mode and point to FAQ.
+
+2017-02-18 Rami Ylimäki <rami.ylimaki@vincit.fi>
+
+ Remove unused TN_max_pairs field
+
+ * src/termchar.h (tty_display_info): Remove TN_max_pairs field,
+ describing maximum number of terminal background/foreground color pairs.
+ * src/term.c (tty_default_color_capabilities, tty_setup_colors)
+ (init_tty): Remove references to TN_max_pairs.
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of query-replace-from-to-separator
+
+ * doc/emacs/search.texi (Query Replace): Document the meaning of
+ the nil value of query-replace-from-to-separator. (Bug#25482)
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Document problems with nerd-fonts
+
+ * etc/PROBLEMS (fonts): Describe the potential problems with
+ nerd-fonts that cause slow display. (Bug#25697)
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Improve commentary for a recent change in keyboard.c
+
+ * src/keyboard.c (Fset__this_command_keys): Add a comment about
+ the magic 248 value. (Bug#25612)
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid infloop in rect.el
+
+ * lisp/rect.el (rectangle--*-char): Avoid inflooping when called
+ with argument N whose absolute value is greater than 1. (Bug#25773)
+
+2017-02-18 Eli Zaretskii <eliz@gnu.org>
+
+ Remove annoying warnings about let-binding
+
+ * src/data.c (Fmake_variable_buffer_local, Fmake_local_variable):
+ Remove warnings about making symbols local while let-bound.
+ (Bug#25561)
+
+2017-02-18 Hong Xu <hong@topbug.net>
+
+ Avoid errors when flyspell-generic-check-word-predicate is a lambda.
+
+ * lisp/textmodes/flyspell.el (flyspell-auto-correct-word, flyspell-word): Apply
+ functionp instead of fboundp on
+ flyspell-generic-check-word-predicate (Bug#25765).
+
+2017-02-18 Glenn Morris <rgm@gnu.org>
+
+ Remove the build number from emacs-version variable
+
+ It's a largely internal detail that can confuse users. (Bug#25590)
+ * lisp/version.el (emacs-build-number): New constant.
+ (emacs-version): Use emacs-build-number.
+ * lisp/loadup.el (top-level): When dumping, increment
+ emacs-build-number rather than emacs-version.
+ * src/emacs.c (emacs-version): Doc fix.
+ * doc/lispref/intro.texi (Version Info): Update emacs-version details.
+ Mention emacs-build-number.
+ * lisp/gnus/gnus-util.el (gnus-emacs-version):
+ * lisp/mail/emacsbug.el (report-emacs-bug):
+ * admin/admin.el (set-version): Update for emacs-version change.
+
+2017-02-18 Glenn Morris <rgm@gnu.org>
+
+ Ensure that user-mail-address always has a value
+
+ * lisp/startup.el (user-mail-address): Initialize in the normal way.
+ (command-line): Reset user-mail-address if needed using
+ standard custom machinery.
+ * lisp/mail/feedmail.el (feedmail-fiddle-from):
+ * lisp/mail/rmail.el (rmail-unknown-mail-followup-to):
+ * lisp/mail/rmailsum.el (rmail-header-summary):
+ Simplify now that user-mail-address is always set.
+
+2017-02-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn on lexical-binding in ruby-mode
+
+ * lisp/progmodes/ruby-mode.el: Turn on lexical-binding.
+ (ruby-font-lock-syntax-table): Use make-syntax-table.
+ (ruby-mode): 'define-derived-mode' writes the keys for us.
+
+2017-02-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn on lexical-binding in elint.el
+
+ * lisp/emacs-lisp/elint.el: Quote entry point commands in commentary.
+ (elint-running, elint-current-pos): Move these dynamic vars to toward
+ the top of the file.
+ (elint-check-quote-form): Ignore unused argument.
+ (elint-check-conditional-form): Remove unused binding.
+
+2017-02-18 Gemini Lasswell <gazally@runbox.com>
+
+ * lisp/emacs-lisp/subr-x.el (if-let*): Fix Edebug spec (Bug#24748)
+
+2017-02-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Enable erc-accidental-paste-threshold-seconds by default
+
+ * lisp/erc/erc.el (erc-accidental-paste-threshold-seconds): Set
+ default to 0.2 (Bug#25709).
+
+2017-02-17 Michal Nazarewicz <mina86@mina86.com>
+
+ Fix build failure caused by ‘Generate upcase and downcase tables from Unicode’
+
+ The [5ec3a584: Generate upcase and downcase tables from Unicode data]
+ commit broke bootstrap from a truly clean tree (e.g. a fresh clone or
+ one created with ‘make extraclean’), see
+ <http://hydra.nixos.org/build/48774928>.
+
+ The failure was caused by characters.el trying to read Unicode
+ property tables which aren’t available so early in the build process.
+
+ Wrap the part that requires Unicode property tables in a condition
+ checking if those are available. If they aren’t they case and syntax
+ tables won’t be fully set but later on, the characters.el file will be
+ evaluated again and this time with Unicode properties available so
+ final Emacs ends up with the exact same case and syntax tables.
+
+2017-02-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ mm-add-meta-html-tag: Improve regexp
+
+ * lisp/gnus/mm-decode.el (mm-add-meta-html-tag):
+ Improve regexp to search html meta tag.
+
+2017-02-17 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ mm-shr: Prefer charset specified in html meta tag
+
+ * lisp/gnus/mm-decode.el (mm-shr): Prefer charset specified in html
+ meta tag than mail-parse-charset in the case there is no charset spec
+ in MIME header.
+
+2017-02-17 Glenn Morris <rgm@gnu.org>
+
+ Stop duplicating some custom-types in message.el
+
+ * lisp/gnus/message.el (user-mail-address, user-full-name):
+ No need to re-specify custom-type.
+
+2017-02-17 Glenn Morris <rgm@gnu.org>
+
+ Whitespace trivia in dunnet.el
+
+ * lisp/play/dunnet.el (dun-special-object, dun-put-objs)
+ (dun-rlogin-endgame): Whitespace trivia.
+
+2017-02-17 Glenn Morris <rgm@gnu.org>
+
+ Explicit error on changing case of negative integers
+
+ * src/casefiddle.c (casify_object): Reject negative integers:
+ Emacs characters are positive integers. (Bug#25684)
+
+2017-02-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ Fix buffers update in vc-retrieve-tag
+
+ * lisp/vc/vc.el (vc-retrieve-tag): When the granularity is
+ `repository', use the repository root and pass it to
+ vc-resynch-buffer (bug#25714).
+
+2017-02-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/buffer.h: Fix indenting.
+
+2017-02-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add sanity checks for Bswitch hash tables
+
+ * src/bytecode.c (exec_byte_code) [BYTE_CODE_SAFE]:
+ Check that operand is a hash table and hashes to ints.
+
+2017-02-16 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/keyboard.c (read_key_sequence): Fix integer-overflow glitch.
+
+2017-02-16 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecomp.el: Avoid unnecessary calculation for jump table addresses.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Don't do
+ redundant operations while calculating the correct jump addresses
+ from TAGs in jump tables.
+
+2017-02-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Minor changes in json.el
+
+ * lisp/json.el (json-advance): Simpler docstring.
+ (json-read-escaped-char): Use xdigit subform in rx expression.
+ (json-read-string): Just use = for char comparison.
+
+2017-02-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Don't expand body inside a let-binding when there are no bindings
+
+ * lisp/emacs-lisp/pcase.el (pcase-codegen): Only let-bind if VARS
+ is non-nil.
+
+2017-02-16 Glenn Morris <rgm@gnu.org>
+
+ Handle user-mail-address being the empty string
+
+ * lisp/mail/feedmail.el (feedmail-fiddle-from):
+ * lisp/mail/rmail.el (rmail-unknown-mail-followup-to):
+ * lisp/mail/rmailsum.el (rmail-header-summary):
+ Belated update for 2002-09-29 startup.el change, 680ebfa, where
+ the value of user-mail-address during initialization was changed
+ from nil to the empty string.
+
+2017-02-15 Michael Albinus <michael.albinus@gmx.de>
+
+ Continue to fix bug#25607
+
+ * lisp/ido.el (ido-complete): Let-bind `non-essential' to nil.
+ (ido-file-name-all-completions-1): Do not bind `non-essential'.
+
+ * lisp/net/tramp.el: (tramp-completion-file-name-handler):
+ Improve autoloaded version.
+ (tramp-completion-file-name-handler): Remove old compat code.
+ Check only for `tramp-completion-mode-p'.
+ (tramp-completion-mode-p): Autoload. Do not check any longer
+ for `last-input-event'.
+ (tramp-completion-handle-expand-file-name): Simplify. (Bug#25607)
+
+2017-02-15 Michal Nazarewicz <mina86@mina86.com>
+
+ casing: don’t assume letters are *either* upper- or lower-case (bug#24603)
+
+ A compatibility digraph characters, such as Dž, are neither upper- nor
+ lower-case. At the moment however, those are reported as upper-case¹
+ despite the fact that they change when upper-cased.
+
+ Stop checking if a character is upper-case before trying to up-case it
+ so that title-case characters are handled correctly. This fixes one of
+ the issues mentioned in bug#24603.
+
+ ¹ Because they change when converted to lower-case. Notice an asymmetry
+ in that for a character to be considered lower-case it must not be
+ upper-case (plus the usual condition of changing when upper-cased).
+
+ * src/buffer.h (upcase1): Delete.
+ (upcase): Change to upcase character unconditionally just like downcase
+ does it. This is what upcase1 was.
+
+ * src/casefiddle.c (casify_object, casify_region): Use upcase instead
+ of upcase1 and don’t check !uppercasep(x) before calling upcase.
+
+ * src/keyboard.c (read_key_sequence): Don’t check if uppercase(x), just
+ downcase(x) and see if it changed.
+
+ * test/src/casefiddle-tests.el (casefiddle-tests--characters,
+ casefiddle-tests-casing): Update test cases which are now passing.
+
+2017-02-15 Michal Nazarewicz <mina86@mina86.com>
+
+ Generate upcase and downcase tables from Unicode data (bug#24603)
+
+ Use Unicode data to generate case tables instead of mostly repeating
+ them in lisp code. Do that in a way which maps ‘Dz’ (and similar)
+ digraph to ‘dz’ when down- and ‘DZ’ when upcasing.
+
+ https://debbugs.gnu.org/cgi/bugreport.cgi?msg=89;bug=24603 lists all
+ changes to syntax table and case tables introduced by this commit.
+
+ * lisp/international/characters.el: Remove case-pairs defined with
+ explicit Lisp code and instead use Unicode character properties.
+
+ * test/src/casefiddle-tests.el (casefiddle-tests--characters,
+ casefiddle-tests-casing): Update test cases which are now working
+ as they should.
+
+2017-02-15 Michal Nazarewicz <mina86@mina86.com>
+
+ Add tests for casefiddle.c (bug#24603)
+
+ Fixes cases marked FIXME upcoming in followup commits.
+
+ * test/src/casefiddle-tests.el (casefiddle-tests-char-properties,
+ casefiddle-tests-case-table, casefiddle-tests-casing-character,
+ casefiddle-tests-casing, casefiddle-tests-casing-byte8,
+ casefiddle-tests-casing-byte8-with-changes): New tests.
+ (casefiddle-tests--test-casing): New helper function for runnig
+ some of the tests.
+
+2017-02-15 Michal Nazarewicz <mina86@mina86.com>
+
+ oldXMenu: add missing #include <string.h>
+
+ Some of the files in oldXMenu use functions from string.h without
+ including that header which results in compile warnings:
+
+ ChgPane.c:46:5: warning: implicit declaration of function ‘strlen’
+ ChgPane.c:46:20: warning: incompatible implicit declaration of
+ built-in function ‘strlen’
+ ChgSel.c:62:2: warning: implicit declaration of function ‘strlen’
+ ChgSel.c:62:17: warning: incompatible implicit declaration of built-in
+ function ‘strlen’
+ Create.c:220:5: warning: implicit declaration of function ‘strcmp’
+ InsPane.c:65:5: warning: implicit declaration of function ‘strlen’
+ InsPane.c:65:20: warning: incompatible implicit declaration of
+ built-in function ‘strlen’
+ InsSel.c:68:5: warning: implicit declaration of function ‘strlen’
+ InsSel.c:68:20: warning: incompatible implicit declaration of built-in
+ function ‘strlen’
+ InsSel.c:75:5: warning: implicit declaration of function ‘strcmp’
+
+ Add the necessary ‘#include <string.h>’.
+
+ oldXMenu/ChgPane.c, oldXMenu/ChgSel.c, oldXMenu/Create.c, oldXMenu/InsPane.c,
+ oldXMenu/InsSel.c: add missing #include <string.h>
+
+2017-02-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fixup recent rmail patch
+
+ * lisp/mail/rmail.el (rmail-epa-decrypt): Remove unused local.
+
+2017-02-15 Richard Stallman <rms@gnu.org>
+
+ Rmail fix
+
+ * lisp/mail/rmail.el (rmail-epa-decrypt-1): Include the just-decrypted text
+ as element 4 of the value.
+ (rmail-epa-decrypt): Take the text to insert from that element.
+
+2017-02-15 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecomp-tests.el: Store all test forms in one constant.
+
+ * test/lisp/emacs-lisp/bytecomp-tests.el: Store all test expressions
+ in a single constant (byte-opt-testsuite-arith-data), add new forms
+ which generate lapcode with adjacent/redundant tags.
+
+2017-02-15 Glenn Morris <rgm@gnu.org>
+
+ Small lispref edit
+
+ * doc/lispref/os.texi (User Identification):
+ Remove extraneous detail about user-mail-address.
+
+2017-02-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Document fill-separate-heterogeneous-words-with-space (bug#25685)
+
+ * doc/lispref/text.texi (Filling):
+ Document fill-separate-heterogeneous-words-with-space (bug#25685).
+
+2017-02-15 Noam Postavsky <npostavs@gmail.com>
+
+ Test comment-multi-line = nil auto fill case too
+
+ * test/lisp/progmodes/js-tests.el (js-mode-auto-fill): Test with
+ `comment-multi-line' both nil and non-nil.
+ * lisp/newcomment.el (comment-multi-line): Mark safe if it's a
+ boolean.
+ * etc/NEWS: Mention that `js-mode' now sets `comment-multi-line'.
+
+2017-02-15 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Don't delete leading and trailing space from CJK word (bug#25685)
+
+ * lisp/textmodes/fill.el (fill-delete-newlines):
+ Don't delete leading and trailing space from CJK word.
+ (fill-separate-heterogeneous-words-with-space):
+ New user option that controls it (bug#25685).
+
+2017-02-15 Juri Linkov <juri@linkov.net>
+
+ ‘M-s w RET word C-s’ repeats incremental search.
+
+ * lisp/isearch.el (isearch-new-nonincremental): New variable.
+ (with-isearch-suspended): Bind isearch-new-nonincremental to
+ isearch-nonincremental, and restore it afterwards.
+ (isearch-forward-exit-minibuffer, isearch-reverse-exit-minibuffer):
+ Set isearch-new-nonincremental to nil. (Bug#25562)
+
+2017-02-14 Tom Tromey <tom@tromey.com>
+
+ Make vc-git detect conflict state for vc-dir
+
+ * lisp/vc/vc-git.el (vc-git-dir-status-state): New struct.
+ (vc-git-dir-status-update-file): New function.
+ (vc-git-after-dir-status-stage, vc-git-dir-status-goto-stage): Use
+ vc-git-dir-status-state; add 'ls-files-conflict state.
+ (vc-git-dir-status-files): Create a vc-git-dir-status-state.
+
+2017-02-14 Vibhav Pant <vibhavp@gmail.com>
+
+ byte-opt: Replace merged tags in jump tables too. (bug#25716)
+
+ * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): While merging
+ adjacent tags, make sure that the old tag is replaced in all jump
+ tables, if any. This fixes the bytecode VM jumping to the wrong
+ address in compiled cond forms where the body of a clause was a loop
+ of any sort.
+
+2017-02-14 Glenn Morris <rgm@gnu.org>
+
+ Remove overly broad element from default mail-dont-reply-to-names
+
+ * lisp/mail/mail-utils.el (mail-dont-reply-to):
+ Do not include just "user@" in mail-dont-reply-to-names, and simplify.
+ Ref: lists.gnu.org/archive/html/help-gnu-emacs/2017-02/msg00049.html
+ * lisp/gnus/message.el (message-dont-reply-to-names): Doc fix.
+ * doc/misc/message.texi (Wide Reply): Tiny fix re dont-reply-to-names.
+
+2017-02-14 Juri Linkov <juri@linkov.net>
+
+ * etc/NEWS: Mention query-replace-from-to-separator. (Bug#25482)
+
+2017-02-13 Arash Esbati <arash@gnu.org>
+
+ Match all characters in optional argument of \documentclass
+
+ * lisp/textmodes/reftex.el (reftex-TeX-master-file): Match all
+ characters in optional argument containing name of the main file.
+
+2017-02-13 Vibhav Pant <vibhavp@gmail.com>
+
+ Merge branch 'master' into feature/byte-switch
+
+2017-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Fix non-ASCII text encoding (bug#25658)
+
+ * lisp/gnus/mm-bodies.el (mm-encode-body):
+ Fix non-ASCII text encoding (bug#25658).
+
+2017-02-13 Vibhav Pant <vibhavp@gmail.com>
+
+ test/lisp/emacs-lisp/bytecomp-tests.el: Add more tests for switch.
+
+2017-02-13 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * doc/lispref/modes.texi (Derived Modes): Make example more idiomatic
+
+2017-02-13 Glenn Morris <rgm@gnu.org>
+
+ Fix recent bootstrap issue by moving string-to-list
+
+ * lisp/international/mule-util.el (string-to-list, string-to-vector):
+ Move from here...
+ * lisp/subr.el (string-to-list, string-to-vector): ...to here.
+ The implementation is trivial and at least string-to-list
+ has ended up being needed early during bootstrap.
+
+2017-02-13 Glenn Morris <rgm@gnu.org>
+
+ Doc fixes related to mail-host-address
+
+ * lisp/startup.el (mail-host-address): Doc fix.
+ * doc/lispref/os.texi (System Environment):
+ Remove extraneous details of mail-host-address.
+
+2017-02-13 Glenn Morris <rgm@gnu.org>
+
+ Simplify time-stamp mail host usage
+
+ * lisp/time-stamp.el (time-stamp-mail-host-name): Remove function.
+ (time-stamp-string-preprocess): Handle "h" (mail host) directly.
+
+2017-02-13 Glenn Morris <rgm@gnu.org>
+
+ Doc fix for vhdl-mode re mail-host-address
+
+ * lisp/progmodes/vhdl-mode.el (vhdl-file-header): Doc fix.
+ (mail-host-address): Do not add to vhdl-related custom group,
+ since vhdl-template-replace-header-keywords doesn't use it.
+
+2017-02-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Substitute leading $HOME/ in xdg-user-dirs
+
+ * lisp/xdg.el (xdg--substitute-home-env): New function.
+ (xdg--user-dirs-parse-line): Use it.
+ (xdg-user-dir): Expand ~/ in xdg-user-dirs values.
+
+2017-02-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/buff-menu.el: Turn on lexical-binding.
+
+2017-02-13 Juri Linkov <juri@linkov.net>
+
+ * lisp/replace.el (query-replace-from-to-separator): Move propertize
+
+ and char-displayable-p test to query-replace-read-from.
+ Add choice nil to disable this feature.
+ (query-replace-read-from): Don't reevaluate custom setting.
+ Use char-displayable-p to test the first non-whitespace character
+ in query-replace-from-to-separator, use " -> " when fails.
+ Add prompt for the case when separator is nil but
+ query-replace-defaults is non-nil.
+ Remove unused test for regexp-flag.
+ Thanks to Thierry Volpiatto <thierry.volpiatto@gmail.com>
+
+2017-02-13 Karl Fogel <kfogel@red-bean.com>
+
+ Convert more uses of `looking-at' to `following-char'
+
+ This follows up to Mark Oteiza's commit of 12 Feb 2017, 14:46:03 UTC
+ (commit 91478f46238a) with more of the same.
+
+ * lisp/bookmark.el (bookmark-send-edited-annotation):
+ (bookmark-bmenu-execute-deletions): Replace instances of looking-at
+ with char comparisons using following-char.
+
+2017-02-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix typos in tests for lax-plist-get etc.
+
+ Problem reported by Eli Zaretskii (Bug#25606#62).
+ * test/src/fns-tests.el (test-cycle-lax-plist-get)
+ (test-cycle-plist-put, test-cycle-lax-plist-put):
+ Fix tests to match behavior.
+
+2017-02-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix bug#25607
+
+ * lisp/net/tramp.el (tramp-completion-file-name-handler):
+ Improve autoloaded version.
+ (tramp-autoload-file-name-handler): Avoid recursive load.
+ (tramp-completion-handle-expand-file-name): Handle empty NAME.
+ (Bug#25607)
+
+2017-02-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Remove server-buffer-clients string from minor-mode-alist
+
+ * lisp/server.el: Don't put an element for server-buffer-clients into
+ minor-mode-alist. (Bug#20201)
+
+2017-02-12 Mark Oteiza <mvoteiza@udel.edu>
+
+ Nix some useless uses of looking-at, looking-back
+
+ * lisp/allout.el (allout-kill-topic):
+ (allout-next-topic-pending-encryption):
+ * lisp/bookmark.el (bookmark-kill-line):
+ * lisp/cus-edit.el (custom-save-variables, custom-save-faces):
+ * lisp/cus-theme.el (custom-theme-write-variables):
+ (custom-theme-write-faces):
+ * lisp/emacs-lisp/autoload.el (autoload-generate-file-autoloads):
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer):
+ * lisp/emacs-lisp/checkdoc.el (checkdoc-interactive-loop):
+ (checkdoc-interactive-ispell-loop):
+ (checkdoc-message-interactive-ispell-loop, checkdoc-this-string-valid):
+ (checkdoc-this-string-valid-engine):
+ * lisp/emacs-lisp/elint.el (elint-get-top-forms):
+ * lisp/emulation/viper-cmd.el (viper-backward-indent):
+ * lisp/image-dired.el (image-dired-delete-char):
+ * lisp/simple.el (kill-visual-line): Replace instances of looking-at,
+ looking-back with char comparisons using following-char, preceding-char.
+
+2017-02-12 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify what is the "cursor"
+
+ * doc/lispref/windows.texi (Window Point): Clarify the notion of
+ "cursor".
+
+2017-02-11 Tom Tromey <tom@tromey.com>
+
+ Recognize JS regexp literals more correctly
+
+ Bug#25529
+ * lisp/progmodes/js.el (js--syntax-propertize-regexp-regexp): New
+ constant.
+ (js-syntax-propertize-regexp): Use it. Remove "end" argument.
+ (js--syntax-propertize-regexp-syntax-table): Remove.
+ (js-syntax-propertize): Update.
+ * test/lisp/progmodes/js-tests.el (js-mode-regexp-syntax-bug-25529):
+ New test.
+
+2017-02-11 Vibhav Pant <vibhavp@gmail.com>
+
+ src/bytecode.c (exec_byte_code): Make hash_code a Lisp_Object.
+
+ This avoids using XUINT every time while comparing it with
+ HASH_HASH (h, i), replacing it with EQ.
+
+2017-02-11 Vibhav Pant <vibhavp@gmail.com>
+
+ src/bytecode.c (exec_byte_code): Remove unnecessary (e)assert.
+
+2017-02-11 Tom Tromey <tom@tromey.com>
+
+ Fix bug in css--mdn-find-symbol
+
+ * lisp/textmodes/css-mode.el (css--mdn-find-symbol): Skip whitespace
+ before skipping word characters.
+ test/lisp/textmodes/css-mode-tests.el (css-mdn-symbol-guessing): Add
+ regression test.
+
+2017-02-11 Vibhav Pant <vibhavp@gmail.com>
+
+ src/bytecode.c: Add optional sanity check for jump tables.
+
+ * src/bytecode.c (exec_byte_code): When sanity checks are enabled,
+ check that the jump table's size is equal to it's count.
+
+2017-02-11 Vibhav Pant <vibhavp@gmail.com>
+
+ Merge branch 'master' into feature/byte-switch
+
+ * src/bytecode.c: Refactor to follow GNU coding standards
+
+2017-02-11 Eli Zaretskii <eliz@gnu.org>
+
+ Fix handling of XBM images on MS-Windows
+
+ * src/image.c (xbm_load) [HAVE_NTGUI]: Fix calculation of
+ 'nbytes' when inverting XBM data bits. (Bug#25661)
+
+2017-02-11 Eli Zaretskii <eliz@gnu.org>
+
+ Fix handling of PBM data
+
+ * src/image.c (pbm_load): Handle PBM data with no blanks between
+ individual pixel values correctly. (Bug#25660)
+
+2017-02-10 Noam Postavsky <npostavs@gmail.com>
+
+ Fix warnings in debug tracing code
+
+ * src/xdisp.c (dump_glyph, dump_glyph_string):
+ * src/xfaces.c (dump_realized_face): Cast arguments or adjust format
+ specifiers to match signedness.
+
+2017-02-10 Sam Steingold <sds@gnu.org>
+
+ Extract grep-find-ignored-directories processing from rgrep-default-command
+
+ (rgrep-find-ignored-directories): Extract from `rgrep-default-command'.
+ Some Emacs packages use `grep-find-ignored-directories' to ignore some
+ directories, so will use this function instead of custom code.
+ (rgrep-default-command): Use `rgrep-find-ignored-directories'.
+
+2017-02-10 Vibhav Pant <vibhavp@gmail.com>
+
+ src/bytecode.c: Avoid comparing values unnecessarily in Bswitch
+
+ * src/bytecode.c: (exec_byte_code) While linear searching the jump
+ table, compare the value's hash table first to avoid calling
+ h->test.cmpfn every time.
+
+2017-02-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix a few integer-overflow glitches
+
+ * src/composite.c (composition_compute_stop_pos, composition_reseat_it):
+ * src/dispextern.h (struct composition_it.rule_idx):
+ * src/keyboard.c (Fset__this_command_keys):
+ * src/xwidget.c (webkit_js_to_lisp):
+ Don’t assume object sizes fit in ‘int’.
+ * src/xwidget.c (Fxwidget_resize):
+ Don’t assume Emacs integers fit in ‘int’.
+
+2017-02-10 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a bug with displaying an image after a TAB
+
+ * src/xdisp.c (display_line): Handle TAB at end of screen line
+ specially only when we are displaying characters. (Bug#25662)
+
+2017-02-10 Eli Zaretskii <eliz@gnu.org>
+
+ Improve commentary in lisp.h
+
+ * src/lisp.h: Explain in the comment why enlarging a Lisp_Misc
+ object is discouraged.
+
+2017-02-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Move cyclic tests to fns-tests.el
+
+ * test/src/fns-tests.el (cyc1, cyc2, dot1, dot2): New functions.
+ (test-cycle-length, test-cycle-safe-length, test-cycle-member)
+ (test-cycle-memq, test-cycle-memql, test-cycle-assq)
+ (test-cycle-assoc, test-cycle-rassq, test-cycle-rassoc)
+ (test-cycle-delq, test-cycle-delete, test-cycle-reverse)
+ (test-cycle-plist-get, test-cycle-lax-plist-get)
+ (test-cycle-plist-member, test-cycle-plist-put)
+ (test-cycle-lax-plist-put, test-cycle-equal, test-cycle-nconc):
+ New tests.
+ * test/manual/cyclic-tests.el: File deleted.
+
+2017-02-10 Gemini Lasswell <gazally@runbox.com>
+
+ Fix instrumenting code with propertized strings in Edebug
+
+ * lisp/emacs-lisp/edebug.el (edebug-read-function): Allow
+ 'read' to decide what is and isn't a syntax error. (Bug#25068)
+
+2017-02-10 Vladimir Panteleev <vladimir@thecybershadow.net>
+
+ Improve fontification in bat-mode
+
+ * lisp/progmodes/bat-mode.el (bat-font-lock-keywords): Match
+ word and symbol constituents when looking for variable names
+ to fontify; also, correct the syntax table and mark the equal
+ sign (=) character as punctuation. Improve fontification
+ accuracy of iteration/positional variables.
+ (bat-mode): Set comment-start-skip. (Bug#25541)
+
+ * test/lisp/progmodes/bat-mode-tests.el: New file, tests for
+ bat-mode.el.
+
+2017-02-10 Eli Zaretskii <eliz@gnu.org>
+
+ Restore special setting of this-command-keys by M-x
+
+ It was lost when execute-extended-command was reimplemented in Lisp.
+
+ * src/keyboard.c (Fset__this_command_keys): New function.
+ (syms_of_keyboard): Defsubr it.
+
+ * lisp/simple.el (execute-extended-command): Set this-command-keys
+ as novice.el expects. (Bug#25612)
+
+2017-02-09 Juri Linkov <juri@linkov.net>
+
+ * lisp/isearch.el (isearch-search-fun-default): Set isearch-adjusted
+
+ to t to display "Pending" in the search prompt for lax
+ word/symbol search (bug#25562). Don't use lax for lazy-highlighting
+ when 'bound' is non-nil.
+ (word-search-regexp, isearch-symbol-regexp): Don't depend on lax
+ at the beginning of regexp (bug#22589).
+
+ * lisp/info.el (Info-isearch-search):
+ Use isearch--lax-regexp-function-p.
+
+ * doc/emacs/search.texi (Word Search, Symbol Search):
+ Mention "Pending" prompt for lax word/symbol search.
+
+2017-02-09 Vibhav Pant <vibhavp@gmail.com>
+
+ src/bytecode.c (exec_byte_code): Remove unneeded assert.
+
+ bytecode.c (exec_byte_code): Use h->count instead of HASH_TABLE_SIZE
+
+2017-02-09 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecode.c (exec_byte_code): don't check hash code in linear search.
+
+ * src/bytecode.c (exec_byte_code): Don't check that the hash code is
+ not nil when linear scanning the jump table. Hash tables for are
+ declared with :size as the exact number of cases, so each entry i
+ should have a hash code. When BYTE_CODE_SAFE, do it as a sanity
+ check.
+
+2017-02-09 Tino Calancha <tino.calancha@gmail.com>
+
+ Ibuffer: Update mode documentation
+
+ * lisp/ibuffer.el (ibuffer-mode): List newest commands in mode documentation.
+
+2017-02-09 Steven Allen <steven@stebalien.com> (tiny change)
+
+ Fix environment variable for xdg-data-dirs
+
+ * lisp/xdg.el (xdg-data-dirs): Use XDG_DATA_DIRS, not XDG_CONFIG_DIRS
+
+2017-02-09 Tino Calancha <tino.calancha@gmail.com>
+
+ Ibuffer: Erase output buffer before shell commands
+
+ * lisp/ibuf-macs.el (define-ibuffer-op): Add keyword arguments
+ BEFORE and AFTER; they are forms to run before/after the operation.
+ * lisp/ibuf-ext.el (ibuffer--maybe-erase-shell-cmd-output):
+ New defun; if shell-command-dont-erase-buffer is nil, then
+ erase shell command output buffer.
+ (ibuffer-do-shell-command-pipe, ibuffer-do-shell-command-file): Use it.
+
+2017-02-09 Tino Calancha <tino.calancha@gmail.com>
+
+ Ibuffer: Don't truncate shell command output
+
+ * lisp/ibuf-ext.el (ibuffer-do-shell-command-pipe)
+ (ibuffer-do-shell-command-pipe-replace)
+ Use 'call-shell-region' (Bug#22679).
+ (ibuffer-do-shell-command-file): Use call-process-shell-command.
+ If FILE, the file that the buffer object is visiting,
+ exists and the buffer is up-to-date, then use
+ FILE instead of creating a temporary file (Bug#22679).
+
+2017-02-09 Vibhav Pant <vibhavp@gmail.com>
+
+ Improve byte-switch execution.
+
+ * lisp/emacs-lisp/byte-opt.el,
+ lisp/emacs-lisp/bytecomp.el (byte-decompile-bytecode-1),
+ (byte-compile-lapcode): Calculate the actual jump address while
+ compiling, store it in the jump table.
+
+ * src/bytecode.c: Jump to the looked up value directly, do a linear
+ search when the number of elements is <= 5.
+
+2017-02-09 Noam Postavsky <npostavs@gmail.com>
+
+ Make sure eshell pipelines don't drop data
+
+ * lisp/eshell/esh-proc.el (eshell-sentinel): If called while still
+ handling output of the process, make sure to close the pipes only later,
+ so that the next process in the pipeline recieves EOF only after getting
+ all its input (Bug#25549).
+
+2017-02-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Make mm-shr use mail-parse-charset by default
+
+ * lisp/gnus/mm-decode.el (mm-shr): Use mail-parse-charset by default.
+ This helps an html message with no charset spec to be decoded.
+
+2017-02-08 Stephen Berman <stephen.berman@gmx.net>
+
+ describe-char: unambiguous name for inserting ASCII 7
+
+ * lisp/descr-text.el (describe-char): Make the input
+ suggestion for inserting ASCII character 7 by name use the
+ unambiguous name "BELL (BEL)" (bug#25641).
+
+2017-02-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Modify suppressing `vc-refresh-state' in filenotify-tests.el
+
+ * test/lisp/filenotify-tests.el (file-notify-test03-autorevert):
+ Use an advice rather than an alias for suppressing `vc-refresh-state'.
+
+2017-02-08 Noam Postavsky <npostavs@gmail.com>
+
+ Disable native completion for ipython (Bug#25067)
+
+ * lisp/progmodes/python.el:
+ (python-shell-completion-native-disabled-interpreters): Add "ipython".
+
+2017-02-07 Michael Albinus <michael.albinus@gmx.de>
+
+ Suppress undesired error messages in filenotify-tests.el
+
+ * test/lisp/filenotify-tests.el (file-notify-test03-autorevert):
+ Suppress `vc-refresh-state', it produces undesired error messages.
+
+2017-02-07 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a typo in ada-mode manual
+
+ * doc/misc/ada-mode.texi (Project file variables): Add a missing
+ right bracket. Reported by Jean-Christophe Helary
+ <jean.christophe.helary@gmail.com>.
+
+2017-02-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Ensure that Gnus bugs show up in the Emacs tracker
+
+ * lisp/gnus/gnus.el (gnus-bug-package): Include Emacs in the
+ package spec.
+
+2017-02-07 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Revert "Don't tag Gnus bugs with "gnus""
+
+ This reverts commit b6fa58072304c2a24f1fe8a0e06a4739a7f8211b.
+
+ The debbugs syntax requires a package name
+
+2017-02-07 Vibhav Pant <vibhavp@gmail.com>
+
+ Add tests for checking byte-switch code.
+
+ * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-cond): New test,
+ test byte-switch bytecode.
+
+2017-02-07 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add xdg library
+
+ * etc/NEWS: Mention new library.
+ * lisp/xdg.el: New file.
+
+2017-02-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not trick info/dir’s timestamp
+
+ * Makefile.in (${srcdir}/info/dir): When making this file, do not
+ do anything special about its timestamp. Previously this rule
+ used move-if-change, which meant that this file’s timestamp could
+ end up being older than the files it depends on, and this caused
+ ‘make --question info’ to fail, which caused ‘make-dist’ to fail
+ now that ‘make-dist’ invokes ‘make --question info’.
+
+2017-02-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make FOR_EACH_TAIL more like other FOR_EACH macros
+
+ See comments by Stefan Monnier in:
+ https://lists.gnu.org/r/emacs-devel/2017-02/msg00181.html
+ and by Eli Zaretskii in:
+ https://lists.gnu.org/r/emacs-devel/2017-02/msg00207.html
+ * src/fns.c (internal_equal): Do not bypass check for depth
+ overflow when tail-recursing via a dotted list tail or an overlay
+ plist, to avoid a rare infloop.
+ * src/lisp.h (FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE): Take TAIL as an
+ arg, and update it at each iteration, rather than have callers
+ access it.tail. All callers changed.
+ (FOR_EACH_TAIL): Do not check for dotted lists, as this is now
+ the caller’s responsibility. All callers changed.
+ (FOR_EACH_TAIL_CONS): Remove. All callers changed.
+ (struct for_each_tail_internal.tail): Remove; no longer needed.
+ (FOR_EACH_TAIL_INTERNAL): Remove dotted arg, and set the tail
+ arg each time through the loop. All callers changed.
+
+2017-02-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port to clang 3.8.0
+
+ It does not allow a for-loop's control var to be an anonymous struct.
+ * src/lisp.h (struct for_each_tail_internal): New type.
+ (FOR_EACH_TAIL_INTERNAL): Use it.
+
+2017-02-05 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ Add cyclic-list tests
+
+ * test/manual/cycle-tests.el: New file (Bug#25606).
+
+2017-02-05 Paul Eggert <eggert@Penguin.CS.UCLA.EDU>
+
+ FOR_EACH_TAIL now checks for quit
+
+ As per Eli Zaretskii (Bug#25606#20). Although these calls to
+ maybe_quit are unnecessary in practice, Eli was not convinced
+ that the calls are unnecessary.
+ * src/lisp.h (FOR_EACH_TAIL, FOR_EACH_TAIL_CONS):
+ Call maybe_quit every so often.
+ (FOR_EACH_TAIL_INTERNAL): New arg CHECK_QUIT. All callers changed.
+
+2017-02-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Signal list cycles in ‘length’ etc.
+
+ Use macros like FOR_EACH_TAIL instead of maybe_quit to
+ catch list cycles automatically instead of relying on the
+ user becoming impatient and typing C-g (Bug#25606).
+ * src/fns.c (Flength, Fmember, Fmemq, Fmemql, Fassq, Fassoc, Frassq)
+ (Frassoc, Fdelete, Freverse):
+ Use FOR_EACH_TAIL instead of maybe_quit.
+ (Fnreverse): Use simple EQ to check for circular list instead
+ of rarely_quit, as this suffices in this unusual case.
+ (Fplist_put, Flax_plist_put, Flax_plist_put):
+ Use FOR_EACH_TAIL_CONS instead of maybe_quit.
+ (internal_equal): Use FOR_EACH_TAIL_CONS to check lists, instead
+ of by-hand tail recursion that did not catch cycles.
+ * src/fns.c (Fsafe_length, Fplist_get):
+ * src/xdisp.c (display_mode_element):
+ Use FOR_EACH_TAIL_SAFE instead of by-hand Floyd’s algorithm.
+ * src/lisp.h (QUIT_COUNT_HEURISTIC): Remove; no longer needed.
+ (rarely_quit): Simply count toward USHRT_MAX + 1, since the
+ fancier versions are no longer needed.
+ (FOR_EACH_TAIL_CONS, FOR_EACH_TAIL_SAFE)
+ (FOR_EACH_TAIL_INTERNAL): New macros, the last with definiens
+ mostly taken from FOR_EACH_TAIL.
+ (FOR_EACH_TAIL): Rewrite in terms of FOR_EACH_TAIL_INTERNAL.
+
+2017-02-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify use of FOR_EACH_TAIL
+
+ * src/data.c (circular_list): New function.
+ * src/lisp.h (FOR_EACH_TAIL): Use Brent’s algorithm and C99 for-loop
+ decl, to eliminate the need for the args TAIL, TORTOISE and N, and
+ to speed things up a bit on typical hosts with optimization.
+ All uses changed (Bug#25605).
+
+2017-02-05 Simen Heggestøyl <simenheg@gmail.com>
+
+ * lisp/textmodes/css-mode.el: Require subr-x at compile time
+
+2017-02-05 Eli Zaretskii <eliz@gnu.org>
+
+ Clarify documentation of 'bufferpos-to-filepos' and 'filepos-to-bufferpos'
+
+ * doc/lispref/nonascii.texi (Text Representations): Clarify that
+ 'exact' value of QUALITY argument to 'bufferpos-to-filepos' and
+ 'filepos-to-bufferpos' can lead to expensive and slow processing.
+
+ * lisp/international/mule-util.el (filepos-to-bufferpos)
+ (bufferpos-to-filepos): Doc fix. (Bug#25626)
+
+2017-02-05 Vibhav Pant <vibhavp@gmail.com>
+
+ Merge remote-tracking branch 'origin/master' into feature/byte-switch
+
+2017-02-05 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecomp.el: Use macroexp-const-p instead of bc-cond-valid-obj2-p.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-vars): Use
+ (macroexp-cons-p) instead of (byte-compile-cond-valid-obj2-p) to
+ make sure that obj1/obj2 can be compared with `eq'.
+
+2017-02-05 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Use eq instead of =.
+
+2017-02-05 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecomp.el: Inline lapcode containing `byte-switch' correctly.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-inline-lapcode):
+ Restore value of byte-compile-depth after emitting a jump to a tag
+ in a jump table, or default/done tags.
+ Set the depth of final tags for byte-switch to nil after emitting
+ any jumps to them.
+
+2017-02-05 Vibhav Pant <vibhavp@gmail.com>
+
+ byte-opt.el: Replace jump tables while decompiling correctly.
+
+ * lisp/emacs-lisp/byte-opt.el (byte-decompile-bytecode-1):
+ Don't make a copy of the constant vector, as it isn't used with
+ the decompiled lapcode.
+ Make sure that the correct lapcode pair/list is being modified while
+ replacing the jump table.
+
+2017-02-05 Vibhav Pant <vibhavp@gmail.com>
+
+ bytecomp.el: Don't store non-keyword symbols in jump-tables.
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-valid-obj2-p) return
+ nil when OBJ is a non-keyword symbol (i.e a variable), as the jump
+ table can only be used when comparing variables with constant values.
+
+2017-02-04 Tom Tromey <tom@tromey.com>
+
+ typo fix
+
+ (css--colon-inside-selector-p): Fix typo in docstring.
+
+2017-02-04 Tom Tromey <tom@tromey.com>
+
+ Set comment-multi-line in js-mode
+
+ Bug#6806:
+ * lisp/progmodes/js.el (js-mode): Set comment-multi-line to t.
+ * test/lisp/progmodes/js-tests.el (js-mode-auto-fill): New test.
+
+2017-02-04 Simen Heggestøyl <simenheg@gmail.com>
+
+ * test/manual/indent/scss-mode.scss: Fix indentation
+
+2017-02-04 Simen Heggestøyl <simenheg@gmail.com>
+
+ Fix indentation of multiline CSS property values
+
+ * lisp/textmodes/css-mode.el (css-smie-grammar): Give colons belonging
+ to properties higher precedence.
+ (css--colon-inside-selector-p, css--colon-inside-funcall): New
+ functions for helping SMIE during tokenization.
+ (css-smie--forward-token, css-smie--backward-token): Distinguish
+ colons belonging to properties from other colons.
+
+ * test/manual/indent/css-mode.css: Add tests for the changes above.
+
+ * test/manual/indent/scss-mode.scss: Ditto.
+
+2017-02-04 Gemini Lasswell <gazally@runbox.com>
+
+ Add tests for lisp/kmacro.el
+
+ * test/lisp/kmacro-tests.el: New file. (Bug#24939)
+
+2017-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix autorevert-tests on MS-Windows
+
+ * test/lisp/autorevert-tests.el
+ (auto-revert-test02-auto-revert-deleted-file): Don't check that
+ auto-revert-use-notify was reset to nil on w32.
+
+2017-02-04 Gemini Lasswell <gazally@runbox.com>
+
+ New macro 'ert-with-message-capture'
+
+ * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): New macro.
+ (Bug#25158)
+
+ * test/lisp/autorevert-tests.el (auto-revert--wait-for-revert)
+ (auto-revert-test00-auto-revert-mode)
+ (auto-revert-test01-auto-revert-several-files)
+ (auto-revert-test02-auto-revert-deleted-file)
+ (auto-revert-test03-auto-revert-tail-mode)
+ (auto-revert-test04-auto-revert-mode-dired):
+ * test/lisp/filenotify-tests.el (file-notify-test03-autorevert): Use
+ ert-with-message-capture.
+
+2017-02-04 Gemini Lasswell <gazally@runbox.com>
+
+ Avoid invalid read syntax errors due to 'ert-with-test-buffer'
+
+ * lisp/emacs-lisp/ert-x.el (ert-with-test-buffer): Fix the
+ 'declare' form. (Bug#24722)
+
+2017-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a syntax error when evaluating pcase.el under Edebug
+
+ * lisp/emacs-lisp/pcase.el (pcase-MACRO): Replace def-edebug-spec
+ with an explicit 'put' form. Suggested by Gemini Lasswell
+ <gazally@runbox.com>. (Bug#24717)
+
+2017-02-04 Gemini Lasswell <gazally@runbox.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ Change edebug-max-depth from defconst to defcustom
+
+ * lisp/emacs-lisp/edebug.el (edebug-max-depth): Add defcustom.
+ (Bug#24713)
+
+ * etc/NEWS: Mention edebug-max-depth.
+
+ * doc/lispref/edebug.texi (Checking Whether to Stop): Mention
+ edebug-max-depth and index it. Add cross-references for
+ max-lisp-eval-depth and max-specpdl-size.
+
+2017-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ Support options with embedded whitespace in 'dired-listing-switches'
+
+ * lisp/dired.el (dired-listing-switches): Document how to quote
+ options with embedded whitespace.
+
+ * lisp/files.el (insert-directory): Use split-string-and-unquote
+ to support dired-listing-switches that specify command-line
+ options with embedded spaces. (Bug#25485)
+
+2017-02-04 Gemini Lasswell <gazally@runbox.com>
+ Noam Postavsky <npostavs@users.sourceforge.net>
+
+ Add tests for lisp/emacs-lisp/testcover.el
+
+ * test/lisp/emacs-lisp/testcover-tests.el: New file.
+ * test/lisp/emacs-lisp/testcover-resources/testcases.el: New file.
+
+2017-02-04 Eli Zaretskii <eliz@gnu.org>
+
+ Document 'save-some-buffers-default-predicate'
+
+ * doc/lispref/files.texi (Saving Buffers):
+ * doc/emacs/files.texi (Save Commands): Document
+ save-some-buffers-default-predicate.
+
+2017-02-04 Richard Stallman <rms@gnu.org>
+
+ New defcustom 'save-some-buffers-default-predicate'
+
+ * lisp/files.el (save-some-buffers-default-predicate): New defcustom.
+ (save-some-buffers): Use it when PRED is nil or omitted.
+
+2017-02-04 Mark Oteiza <mvoteiza@udel.edu>
+
+ Rename to if-let* and when-let*
+
+ Make the existing if-let and when-let aliases.
+ * lisp/emacs-lisp/subr-x.el (if-let*, when-let*): New macros. Rewrite
+ docstrings, incorporating that from let* and the existing if-let.
+ (if-let, when-let, and-let*): Alias them.
+
+2017-02-03 Vibhav Pant <vibhavp@gmail.com>
+
+ Revert "Use maphash instead of cl-loop."
+
+ This reverts commit bfa88520136dd6b187ba101e6db5a5f8f0d5e874.
+
+2017-02-03 Nicolas Petton <nicolas@petton.fr>
+
+ Bump Emacs version to 25.2 RC1
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version.
+ * lisp/ldefs-boot.el: Update.
+
+2017-02-03 Nicolas Petton <nicolas@petton.fr>
+
+ * admin/make-tarball.txt: Add documentation regarding the release banner.
+
+2017-02-03 Tino Calancha <tino.calancha@gmail.com>
+
+ * CONTRIBUTE (Documenting your changes): Index new vars/commands in manual.
+
+2017-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Re-port alloc.c to Solaris sparc and simplify
+
+ alloc.c had bitrotted a bit, and used an undefined symbol
+ stack_base when Emacs was built on Solaris sparc, leading to
+ compilation failures. Also, code related to __builtin_unwind_init
+ was unnecessarily duplicated. Fix the bitrot and remove some
+ duplication.
+ * src/alloc.c: Remove uses of GC_SAVE_REGISTERS_ON_STACK, since it
+ is never defined.
+ (test_setjmp) [!HAVE___BUILTIN_UNWIND_INIT && GC_SETJMP_WORKS]:
+ Define a no-op dummy, to simplify use.
+ (test_setjmp) [!GC_SETJMP_WORKS]: Test setjmp_tested_p here rather
+ than in the caller, to simplify use.
+ (stacktop_sentry): New type.
+ (__builtin_unwind_init) [!HAVE___BUILTIN_UNWIND_INIT]: New macro.
+ (SET_STACK_TOP_ADDRESS): New macro, containing code that was duplicated.
+ (flush_stack_call_func, Fgarbage_collect): Use it.
+ (init_alloc): Omit unnecessary initialization.
+ After dumping, Emacs need not re-test setjmp.
+
+2017-02-03 Noam Postavsky <npostavs@gmail.com>
+
+ Add tests for scrolling
+
+ * test/manual/scroll-tests.el: New tests for scroll-margin behavior.
+
+2017-02-03 Noam Postavsky <npostavs@gmail.com>
+
+ Fix scrolling with partial lines
+
+ * src/xdisp.c (partial_line_height): New function.
+ (try_scrolling):
+ * src/window.c (window_scroll_pixel_based): Use it for calculating the
+ pixel scroll margin correctly in a window with partial lines.
+
+2017-02-03 Noam Postavsky <npostavs@gmail.com>
+
+ Make limit on scroll-margin variable
+
+ * src/xdisp.c (maximum-scroll-margin): New variable.
+ * lisp/cus-start.el: Make it customizable.
+ * etc/NEWS: Mention it.
+ * doc/emacs/display.texi (Auto Scrolling):
+ * doc/lispref/windows.texi (Textual Scrolling): Document it.
+ * src/window.c (window_scroll_pixel_based): Use it instead of hardcoding
+ division by 4 (Bug #5718).
+
+2017-02-03 Noam Postavsky <npostavs@gmail.com>
+
+ Don't count mode line for scroll-margin limit
+
+ * src/window.c (window_scroll_margin): Use window_box_height to avoid
+ counting header line, scrollbars for scroll-margin limit (Bug #5718).
+
+2017-02-03 Noam Postavsky <npostavs@gmail.com>
+
+ Refactor uses of scroll_margin to a function
+
+ Its effective range needs to be clamped between 0 and (window height /
+ 4), so it's better to have this constraint in a single place.
+
+ * src/window.c (window_scroll_margin): New function.
+ (window_scroll_pixel_based, window_scroll_line_based):
+ (Frecenter, Fmove_to_window_line):
+ * src/xdisp.c (try_scrolling, try_cursor_movement):
+ (redisplay_window, try_window, try_window_id): Use it.
+
+2017-02-03 Dmitry Gutov <dgutov@yandex.ru>
+
+ (xref-collect-matches): Use '-E' together with '-e'
+
+ * lisp/progmodes/xref.el (xref-collect-matches): Use '-E'
+ together with '-e', as suggested by Noam Postavsky
+ (https://lists.gnu.org/r/emacs-devel/2017-01/msg00780.html).
+
+2017-02-03 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify Oracle Studio 12.5
+
+ * src/emacs.c (main): Do not silently convert char * to bool.
+
+2017-02-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix lisp.h underparenthesization
+
+ * src/lisp.h (STACK_CONS, AUTO_STRING_WITH_LEN):
+ Parenthesize compound literals that are function call args.
+ Although this does not fix any bugs, it is the proper style for
+ macro parenthesization as it means this code will continue to
+ work even if make_lisp_ptr is changed to a macro.
+
+2017-02-02 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/doc-view.el (doc-view-mode): Don't require a final newline
+
+ (doc-view-revert-buffer): Silence overflow warnings.
+
+2017-02-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ 2017-01-30 Port to PGI 16.10 x86-64
+ 2017-01-20 time_rz: fix comment typo
+ 2017-01-14 strftime: %z is -00 if unknown
+ This incorporates:
+ * doc/misc/texinfo.tex, lib/c-ctype.h, lib/strftime.c:
+ * lib/time-internal.h, lib/verify.h:
+ Copy from gnulib.
+
+2017-02-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Check if there are hunks before kill or refine a hunk
+
+ * lisp/vc/diff-mode.el (diff--some-hunks-p): New predicate.
+ (diff-hunk-kill, diff-file-kill, diff-refine-hunk): Use it (Bug#25571).
+
+2017-02-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Ignore error after kill last file or hunk
+
+ * lisp/vc/diff-mode.el (diff-hunk-kill): Go to beginning of hunk before kill.
+ Ignore error after kill last hunk (Bug#25570).
+ (diff-file-kill): Idem.
+
+2017-02-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Show current line highlighted in *Occur* buffer
+
+ * lisp/replace.el (list-matching-lines-current-line-face)
+ (list-matching-lines-jump-to-current-line): New user options.
+ (occur--orig-line, occur--orig-line-str): New variables.
+ (occur, occur-engine): Use them.
+ (occur--final-pos): New variable.
+ (occur-1): Use it.
+ (occur-engine): Idem.
+ Show the current line with 'list-matching-lines-current-line-face'.
+ Set point on the first matching line after the current one.
+ * etc/NEWS: Add entry for the new option.
+
+2017-02-02 Tino Calancha <tino.calancha@gmail.com>
+
+ Allow occur command to operate on the region
+
+ See discussion in:
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg01084.html
+ * lisp/replace.el (occur--region-start, occur--region-end)
+ (occur--matches-threshold): New variables.
+ (occur-engine): Use them.
+ (occur): Idem.
+ Add optional arg REGION; if non-nil occur applies in that region.
+ * doc/lispintro/emacs-lisp-intro.texi (Keybindings): Update manual
+ * doc/emacs/search.texi (Other Repeating Search): Idem.
+
+2017-02-02 Mark Oteiza <mvoteiza@udel.edu>
+
+ Treat list-buffers-directory as a string
+
+ Another step in the long history of list-buffers-directory. A thread
+ branch discussing the meaning/use of the variable starts here
+ https://lists.gnu.org/r/emacs-devel/2009-09/msg00684.html
+ Also see (info "(elisp) Buffer File Name").
+ * lisp/buff-menu.el: Relocate special case code into info.el. Nix
+ Info-* defvars.
+ (Buffer-menu--pretty-file-name): Remove special case. Use
+ bound-and-true-p.
+ (Buffer-menu-info-node-description): Remove.
+ * lisp/ibuffer.el (ibuffer-buffer-file-name): Treat
+ list-buffers-directory as a string.
+ * lisp/info.el (Info-node-description): New function.
+ (Info-select-node): Use it.
+
+2017-02-02 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn on lexical-binding in parse-time.el
+
+ * lisp/calendar/parse-time.el: Turn on lexical-binding.
+ (parse-time-iso8601-regexp, parse-iso8601-time-string): Remove unused
+ bindings.
+
+2017-02-02 Mark Oteiza <mvoteiza@udel.edu>
+
+ Prevent creating thumbnails of all gif frames
+
+ With the previous defaults, doing image-dired on a directory with an
+ animated foo.gif would cause creation of foo.thumb-N.gif for each of
+ N frames in foo.gif. By default image-dired looks for foo.thumb.gif, so
+ there additionally is no usable thumbnail after all the needless effort.
+ image-dired never handled animation, regardless.
+ * lisp/image-dired.el: Mention limitation.
+ (image-dired-cmd-create-thumbnail-options):
+ (image-dired-cmd-create-temp-image-options):
+ (image-dired-cmd-create-standard-thumbnail-options): Append [0] to
+ filename to indicate only converting the 0th frame.
+ (image-dired-display-image-mode): Don't show a cursor.
+
+2017-02-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix quitting bug when buffers are frozen
+
+ Problem noted by Eli Zaretskii in:
+ https://lists.gnu.org/r/emacs-devel/2017-01/msg00721.html
+ This patch also fixes some other issues in that report.
+ * src/lisp.h (incr_rarely_quit): Remove.
+ All callers changed to use rarely_quit directly.
+ * src/search.c (freeze_buffer_relocation)
+ (thaw_buffer_relocation): New functions.
+ (looking_at_1, fast_looking_at, search_buffer):
+ Use them to fix bug when quitting when buffers are frozen.
+ * src/sysdep.c (emacs_intr_read): Rename from emacs_nointr_read.
+ All uses changed.
+
+2017-02-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Revamp quitting and fix infloops
+
+ This fixes some infinite loops that cannot be quitted out of,
+ e.g., (defun foo () (nth most-positive-fixnum '#1=(1 . #1#)))
+ when byte-compiled and when run under X. See:
+ https://lists.gnu.org/r/emacs-devel/2017-01/msg00577.html
+ This also attempts to keep the performance improvements I recently
+ added, as much as possible under the constraint that the infloops
+ must be caught. In some cases this fixes infloop bugs recently
+ introduced when I removed immediate_quit.
+ * src/alloc.c (Fmake_list):
+ Use rarely_quit, not maybe_quit, for speed in the usual case.
+ * src/bytecode.c (exec_byte_code):
+ * src/editfns.c (Fcompare_buffer_substrings):
+ * src/fns.c (Fnthcdr):
+ * src/syntax.c (scan_words, skip_chars, skip_syntaxes)
+ (Fbackward_prefix_chars):
+ Use rarely_quit so that users can C-g out of long loops.
+ * src/callproc.c (call_process_cleanup, call_process):
+ * src/fileio.c (read_non_regular, Finsert_file_contents):
+ * src/indent.c (compute_motion):
+ * src/syntax.c (scan_words, Fforward_comment):
+ Remove now-unnecessary maybe_quit calls.
+ * src/callproc.c (call_process):
+ * src/doc.c (get_doc_string, Fsnarf_documentation):
+ * src/fileio.c (Fcopy_file, read_non_regular, Finsert_file_contents):
+ * src/lread.c (safe_to_load_version):
+ * src/sysdep.c (system_process_attributes) [GNU_LINUX]:
+ Use emacs_read_quit instead of emacs_read in places where
+ C-g handling is safe.
+ * src/eval.c (maybe_quit): Move comment here from lisp.h.
+ * src/fileio.c (Fcopy_file, e_write):
+ Use emacs_write_quit instead of emacs_write_sig in places where
+ C-g handling is safe.
+ * src/filelock.c (create_lock_file): Use emacs_write, not
+ plain write, as emacs_write no longer has a problem.
+ (read_lock_data): Use emacs_read, not read, as emacs_read
+ no longer has a problem.
+ * src/fns.c (rarely_quit): Move to lisp.h and rename to
+ incr_rarely_quit. All uses changed..
+ * src/fns.c (Fmemq, Fmemql, Fassq, Frassq, Fplist_put, Fplist_member):
+ * src/indent.c (compute_motion):
+ * src/syntax.c (find_defun_start, back_comment, forw_comment)
+ (Fforward_comment, scan_lists, scan_sexps_forward):
+ Use incr_rarely_quit so that users can C-g out of long loops.
+ * src/fns.c (Fnconc): Move incr_rarely_quit call to within
+ inner loop, so that it catches C-g there too.
+ * src/keyboard.c (tty_read_avail_input): Remove commented-out
+ and now-obsolete code dealing with interrupts.
+ * src/lisp.h (rarely_quit, incr_rarely_quit): New functions,
+ the latter moved here from fns.c and renamed from rarely_quit.
+ (emacs_read_quit, emacs_write_quit): New decls.
+ * src/search.c (find_newline, search_buffer, find_newline1):
+ Add maybe_quit to catch C-g.
+ * src/sysdep.c (get_child_status): Always invoke maybe_quit
+ if interruptible, so that the caller need not bother.
+ (emacs_nointr_read, emacs_read_quit, emacs_write_quit):
+ New functions.
+ (emacs_read): Rewrite in terms of emacs_nointr_read.
+ Do not handle C-g or signals; that is now for emacs_read_quit.
+ (emacs_full_write): Replace PROCESS_SIGNALS two-way arg
+ with INTERRUPTIBLE three-way arg. All uses changed.
+
+2017-02-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove immediate_quit.
+
+ The old code that sets and clears immediate_quit was
+ ineffective except when Emacs is running in terminal mode, and
+ has problematic race conditions anyway, so remove it. This
+ will introduce some hangs when Emacs runs in terminal mode,
+ and these hangs should be fixed in followup patches.
+ * src/keyboard.c (immediate_quit): Remove. All uses removed.
+
+2017-02-01 Alan Mackenzie <acm@muc.de>
+
+ Allow C++ nested brace-list-entries to be better indented.
+
+ This fixes bug #24431. The key change of this bug fix is correctly analyzing
+ nested brace lists when the opening element stands on the same line as both
+ its introductory brace and an enclosing parameter list parenthesis.
+
+ * lisp/progmodes/cc-align.el (c-lineup-under-anchor): New line-up function.
+
+ * lisp/progmodes/cc-engine.el (c-looking-at-or-maybe-in-bracelist): Accept the
+ presence of exactly an identifier between an open parenthesis and an open
+ brace as evidence of the brace starting a brace list.
+ (c-looking-at-statement-block): New function, extracted from
+ c-looking-at-inexpr-block. Enhance it to analyze inner blocks recursively
+ when needed.
+ (c-looking-at-inexpr-block): Extract new function (see above) and call it.
+ (c-add-stmt-syntax): Enhance, with new &optional parameter, to supply the
+ prime syntactic symbol with a fixed anchor point. When this is used, restrict
+ all added syntactic symbols to those having an anchor point on the same line.
+ Add, in addition to the current additional symbols, c-brace-list-entry when
+ needed; use c-looking-at-statement-block to determine the latter.
+ (c-guess-basic-syntax, CASE 9D): Use c-add-stmt-syntax rather than just
+ c-add-syntax, to assemble the syntactic context of a 'brace-list-entry, thus
+ getting, possibly, several accompanying syntactic entries.
+
+ * lisp/progmodes/cc-styles.el (c-style-alist, "gnu" style): New entry for
+ 'brace-list-intro, namely c-lineup-arglist-intro-after-paren.
+
+ * lisp/progmodes/cc-vars.el (c-offsets-alist): Change the factory default
+ offset for 'brace-list-entry from 0 to c-lineup-under-anchor.
+
+ * doc/misc/cc-mode.texi (Syntactic Symbols): Amend the definition of
+ brace-list-intro.
+ (Brace List Symbols): Amend the example to show the new analysis of brace
+ lists when the first element comes on the same line as the opening brace.
+ (Misc Line-Up): Document the new line-up function c-lineup-under-anchor.
+
+2017-02-01 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Revert "DOn't use string-as-unibyte in Gnus"
+
+ This reverts commit d1c931009004aef847105b7bac6b6ffafd985b82.
+
+ Not all the cases where we had string-as-unibyte were characters,
+ so this needs to be considered more thoroughly before being redone.
+
+2017-02-01 Vibhav Pant <vibhavp@gmail.com>
+
+ Use maphash instead of cl-loop.
+
+ * lisp/emacs-lisp/bytecomp.el: (byte-compile-lapcode) Use maphash
+ instead of cl-loop
+
+2017-02-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix a subtle problem in Tramp with timers
+
+ * lisp/net/tramp.el (tramp-accept-process-output): Change argument
+ list. Make it work when called inside a timer. See
+ <https://lists.gnu.org/r/tramp-devel/2017-01/msg00010.html>.
+
+2017-01-31 Eli Zaretskii <eliz@gnu.org>
+
+ Index byte-compile-debug
+
+ * doc/lispref/compile.texi (Compilation Functions): Index
+ byte-compile-debug.
+
+2017-01-31 Philipp Stephani <phst@google.com>
+
+ Document `byte-compile-debug' in the ELisp manual
+
+ * doc/lispref/compile.texi: Document variable `byte-compile-debug'.
+
+2017-01-31 Ted Zlatanov <tzz@lifelogs.com>
+
+ read-multiple-choice: explain dialog popups more
+
+ * lisp/emacs-lisp/subr-x.el (read-multiple-choice): Explain
+ when a graphical popup is used and how it can be avoided.
+
+2017-01-31 Ted Zlatanov <tzz@lifelogs.com>
+
+ auth-source-user-and-password: add forgotten user parameter
+
+ * lisp/auth-source.el (auth-source-user-and-password): Use
+ accidentally unused "user" parameter.
+ Reported by Oscar Najera <najera.oscar@gmail.com>.
+
+2017-01-31 Simen Heggestøyl <simenheg@gmail.com>
+
+ Fix typo in a NEWS entry for CSS mode
+
+2017-01-31 Philipp Stephani <phst@google.com>
+
+ Document variable `byte-compile-debug'
+
+ * lisp/emacs-lisp/bytecomp.el (byte-compile-debug): Document variable.
+
+2017-01-31 Lars Ingebrigtsen <larsi@gnus.org>
+
+ DOn't use string-as-unibyte in Gnus
+
+ * lisp/gnus/nnmail.el (nnmail-parse-active): Don't use
+ string-as-unibyte.
+ (nnmail-insert-xref): Ditto.
+
+ * lisp/gnus/canlock.el (canlock-make-cancel-key): Ditto.
+
+ * lisp/gnus/gnus-art.el (gnus-article-browse-html-parts): Ditto.
+
+ * lisp/gnus/gnus-srvr.el (gnus-browse-foreign-server): Ditto.
+ (gnus-browse-foreign-server): Ditto.
+ (gnus-browse-foreign-server): Ditto.
+
+ * lisp/gnus/gnus-start.el
+ (gnus-update-active-hashtb-from-killed): Ditto.
+ (gnus-read-newsrc-el-file): Ditto.
+
+ * lisp/gnus/mml.el (mml-generate-mime-1): Ditto.
+
+ * lisp/gnus/nnir.el (nnir-get-active): Ditto.
+ (nnir-get-active): Ditto.
+
+2017-01-31 Juri Linkov <juri@linkov.net>
+
+ Allow C-s C-w to yank ' to the search ring in the Gnus article buffer
+
+ * lisp/gnus/gnus-art.el (gnus-article-mode-syntax-table): Make
+ M-. in article buffers work for `foo' strings, and still allow
+ C-s C-w to yank ' to the search ring (bug#22248).
+
+2017-01-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/alloc.c, src/lisp.h: Fix minor glitches in recent changes.
+
+2017-01-31 Tino Calancha <tino.calancha@gmail.com>
+
+ * test/lisp/vc/diff-mode-tests.el: Require diff-mode.
+
+2017-01-31 Dima Kogan <dima@secretsauce.net>
+
+ New test for diff-mode handling trailing --
+
+ test/lisp/vc/diff-mode-tests.el: New test file
+
+2017-01-31 Dima Kogan <dima@secretsauce.net>
+
+ Handle patch terminators produced by git and bzr patch export
+
+ Patch by Juri Linkov posted in the #9597 bug report
+
+ * lisp/vc/diff-mode.el (diff-sanity-check-hunk): Find and ignore
+ terminator (Bug #9597, #5302)
+
+2017-01-31 Dima Kogan <dima@secretsauce.net>
+
+ Revert two accidental commits
+
+ This reverts commit f3c77d11af65f3b319b1784b4c3cf08c51aa7997.
+ This reverts commit 3c941b900007c9e79c00af0f21d88154f6d8af1a.
+
+2017-01-31 Dima Kogan <dima@secretsauce.net>
+
+ stash
+
+2017-01-31 Dima Kogan <dima@secretsauce.net>
+
+ comint-get-old-input-default: behavior follows docstring
+
+ lisp/comint.el (comint-get-old-input-default): Modify behavior to follow
+ docstring: if `comint-use-prompt-regexp' is nil, then return the CURRENT LINE,
+ if point is on an output field.
+
+2017-01-31 Noam Postavsky <npostavs@gmail.com>
+
+ Fix call to debugger on assertion failure
+
+ * lisp/emacs-lisp/cl-preloaded.el (cl--assertion-failed): The first
+ argument must be `error', and the second is a list of arguments for
+ `signal'.
+
+2017-01-30 Tom Tromey <tom@tromey.com>
+
+ css-mode documentation lookup feature
+
+ * etc/NEWS: Mention new feature.
+ * lisp/textmodes/css-mode.el (css-mode-map): New defvar.
+ (css--mdn-lookup-history): New defvar.
+ (css-lookup-url-format): New defcustom.
+ (css--mdn-property-regexp, css--mdn-completion-list): New defconsts.
+ (css--mdn-after-render, css--mdn-find-symbol, css-lookup-symbol): New
+ defuns.
+ * test/lisp/textmodes/css-mode-tests.el (css-mdn-symbol-guessing): New
+ test.
+
+2017-01-30 Glenn Morris <rgm@gnu.org>
+
+ edt-mapper: just loading a library should not run code
+
+ * lisp/emulation/edt-mapper.el (edt-mapper): New function,
+ containing code previously at top-level.
+ * lisp/emulation/edt.el (edt-load-keys): After loading edt-mapper,
+ run edt-mapper function.
+
+2017-01-30 Glenn Morris <rgm@gnu.org>
+
+ mh-compat.el: remove duplicate definition
+
+ * lisp/mh-e/mh-compat.el (mh-make-obsolete-variable):
+ Remove duplicate definition.
+
+2017-01-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Add delq list arg check
+
+ * src/fns.c (Fdelq): Check that list is a proper list.
+ This is more compatible with what ‘delete’ does.
+
+2017-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/indent.el (indent-region-line-by-line): New function.
+
+ Extracted from indent-region.
+ (indent-region, indent-region-function): Use it.
+
+2017-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/subr.el (string-make-unibyte, string-make-multibyte): Obsolete.
+
+2017-01-30 Eli Zaretskii <eliz@gnu.org>
+
+ More fixes to prevent crashes on C-g
+
+ * src/fns.c (Fassq, Frassq, Fplist_put): Reset immediate_quit
+ before returning, to avoid crashes in quit. (Bug#25566)
+
+2017-01-30 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashes on C-g in TTY sessions
+
+ * src/keyboard.c (handle_interrupt): Don't quit if
+ waiting_for_input is set, as doing that is "unsafe": it will
+ abort. (Bug#25566)
+
+2017-01-30 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el: Create jump tables with :purecopy t
+
+ Merge remote-tracking branch 'origin/master' into feature/byte-switch
+
+2017-01-30 Vibhav Pant <vibhavp@gmail.com>
+
+ Fix hash tables not being purified correctly.
+
+ * src/alloc.c
+ (purecopy_hash_table) New function, makes a copy of the given hash
+ table in pure storage.
+ Add new struct `pinned_object' and `pinned_objects' linked list for
+ pinning objects.
+ (Fpurecopy) Allow purifying hash tables
+ (purecopy) Pin hash tables that are either weak or not declared with
+ `:purecopy t`, use purecopy_hash_table otherwise.
+ (marked_pinned_objects) New function, marks all objects in pinned_objects.
+ (garbage_collect_1) Use it. Mark all pinned objects before sweeping.
+ * src/lisp.h: Add new field `pure' to struct `Lisp_Hash_Table'.
+ * src/fns.c: Add `purecopy' parameter to hash tables.
+ (Fmake_hash_table): Check for a `:purecopy PURECOPY' argument, pass it
+ to make_hash_table.
+ (make_hash_table): Add `pure' parameter, set h->pure to it.
+ (Fclrhash, Fremhash, Fputhash): Enforce that the table is impure with
+ CHECK_IMPURE.
+ * src/lread.c: (read1) Parse for `purecopy' parameter while reading
+ hash tables.
+ * src/print.c: (print_object) add the `purecopy' parameter while
+ printing hash tables.
+ * src/category.c, src/emacs-module.c, src/image.c, src/profiler.c,
+ src/xterm.c: Use new (make_hash_table).
+
+2017-01-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ Escape dash in xref rgrep regexp
+
+ * lisp/progmodes/xref.el (xref-collect-matches): Escape dash
+ in REGEXP if it's the first character.
+
+2017-01-29 Dmitry Gutov <dgutov@yandex.ru>
+
+ Say JavaScript, not Javascript
+
+ * lisp/progmodes/js.el (js-mode-map, js-syntax-propertize)
+ (js-js-error, js-eval, js-set-js-context)
+ (js--get-js-context):
+ Refer to the language consistently as JavaScript.
+
+2017-01-29 Juanma Barranquero <lekktu@gmail.com>
+
+ lisp/*.el: Fix some warnings
+
+ * lisp/battery.el (dbus-get-property):
+ * lisp/dired-aux.el (format-spec): Declare function.
+
+ * lisp/net/zeroconf.el (zeroconf-list-service-names)
+ (zeroconf-list-service-types, zeroconf-list-services):
+ Mark unused lexical arg.
+
+ * lisp/progmodes/hideshow.el (hs-hide-block-at-point):
+ * lisp/progmodes/sql.el (sql-end-of-statement):
+ Pass LIMIT to 'looking-back'.
+
+2017-01-29 Noam Postavsky <npostavs@gmail.com>
+
+ Don't warn about obsolete defgenerics when defining them
+
+ * lisp/emacs-lisp/cl-generic.el (cl-defgeneric): The declaration code
+ should run after the definition code (Bug#25556).
+
+2017-01-29 Noam Postavsky <npostavs@gmail.com>
+
+ Call modification hooks in org-src fontify buffers
+
+ * lisp/org/org-src.el (org-src-font-lock-fontify-block): Let-bind
+ `inhibit-modification-hooks' to nil, since this function can be called
+ from jit-lock-function which binds that variable to t (Bug#25132).
+
+2017-01-29 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix Bug#25524
+
+ * lisp/vc/diff-mode.el (diff-beginning-of-hunk):
+ Return position at the beginning off the hunk.
+ (diff-file-junk-re): Add SVN keywords.
+
+2017-01-28 Stephen Berman <stephen.berman@gmx.net>
+
+ hl-line.el: Don't try to operate on a killed buffer
+
+ * lisp/hl-line.el (hl-line-maybe-unhighlight): Examine only
+ live buffers (bug#25522).
+
+2017-01-28 Mark Oteiza <mvoteiza@udel.edu>
+
+ Use access-file in EWW to check before downloading a file
+
+ * lisp/net/eww.el (eww-download): Check accessibility of
+ eww-download-directory to prevent starting a download that will fail
+ to write.
+ * src/fileio.c (Faccess_file): Clarify the use of string argument in
+ the docstring.
+
+2017-01-28 Yuri D'Elia <wavexx@thregr.org>
+
+ Subject: Check Bcc after the Messag hook has run
+
+ * lisp/gnus/message.el (message-send): If the hook modifies
+ the message (mml tags or headers), we should check bcc on the
+ final message, not on the original.
+
+2017-01-28 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'format' conversions
+
+ * src/editfns.c (Fformat): More accurate description of %g and
+ effects of the various flags on it. More accurate description of
+ integer conversions.
+
+ * doc/lispref/strings.texi (Formatting Strings): More accurate
+ description of %g and effects of the various flags on it. More
+ accurate description of integer conversions. (Bug#25557)
+
+2017-01-28 Juanma Barranquero <lekktu@gmail.com>
+
+ test/*.el: Avoid byte-compiler warnings
+
+ * test/lisp/abbrev-tests.el (abbrev-table-p-test): Remove unused 'let*'.
+
+ * test/lisp/faces-tests.el (faces--test): New customization group.
+ (faces--test1, faces--test2): Use it.
+
+ * test/lisp/ffap-tests.el (ffap-tests-25243):
+ Call 'mark-whole-buffer' interactively.
+
+ * test/lisp/ibuffer-tests.el (ibuffer-filter-groups, ibuffer-filtering-alist)
+ (ibuffer-filtering-qualifiers, ibuffer-save-with-custom)
+ (ibuffer-saved-filter-groups, ibuffer-saved-filters): Defvar.
+ (ibuffer-format-qualifier, ibuffer-unary-operand): Declare.
+
+ * test/lisp/minibuffer-tests.el (completion-test1):
+ Mark unused lexical arguments.
+
+ * test/lisp/simple-tests.el (simple-test--dummy-buffer): Wrap result in
+ 'with-no-warnings' to avoid them when the macro is invoked for effect.
+
+ * test/lisp/emacs-lisp/cl-seq-tests.el (cl-seq-count-test):
+ Mark unused lexical arguments.
+
+ * test/lisp/emacs-lisp/let-alist-tests.el (let-alist-surface-test):
+ Mark unused lexical arguments.
+ (let-alist-cons): Remove unused let binding.
+
+ * test/lisp/net/dbus-tests.el (dbus-debug): Defvar.
+ (dbus-get-unique-name): Declare.
+
+ * test/lisp/progmodes/python-tests.el (python-bob-infloop-avoid):
+ Call 'font-lock-fontify-buffer' interactively.
+
+ * test/lisp/textmodes/tildify-tests.el (tildify-space-undo-test--test):
+ Mark unused lexical argument.
+
+2017-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Restore a test that was removed by a recent commit
+
+ * src/fileio.c (Ffile_accessible_directory_p): Don't overwrite the
+ errno value unless it's necessary. (Bug#25419)
+
+2017-01-27 Mark Oteiza <mvoteiza@udel.edu>
+
+ Fix a couple eww customization types
+
+ * lisp/new/eww.el (eww-download-directory, eww-bookmarks-directory):
+ Change customization type to "directory".
+
+2017-01-27 Philipp Stephani <phst@google.com>
+
+ Don't require a shell when loading htmlfontify
+
+ * lisp/htmlfontify.el (hfy-which-etags): Don't call a shell for
+ detecting the etags version (Bug#25468).
+ * test/lisp/htmlfontify-tests.el (htmlfontify-bug25468): Add unit
+ test.
+
+2017-01-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Slightly tune file-accessible-directory-p fix
+
+ * src/fileio.c (Ffile_accessible_directory_p):
+ Remove unnecessary test (Bug#25419).
+
+2017-01-27 Arash Esbati <arash@gnu.org>
+
+ Add \citetitle to biblatex cite format
+
+ * lisp/textmodes/reftex-vars.el (reftex-cite-format-builtin): Add
+ \citetitle[*] to `reftex-cite-format' and bind them to keys i/I
+ per user request
+ https://lists.gnu.org/r/auctex/2017-01/msg00049.html.
+
+2017-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix charsets and encodings from non-file MIME parts
+
+ * lisp/gnus/mml.el (mml-generate-mime-1): Get the charsets and
+ encoding right for parts that do not originate from files.
+
+2017-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix 'describe-variable' for longish variable values
+
+ * lisp/help-fns.el (describe-variable): Don't accidentally remove
+ the last character of a variable's value. (Bug#25545)
+
+2017-01-27 Vladimir Panteleev <git@thecybershadow.net> (tiny change)
+
+ Remove stale functions from ert manual
+
+ * doc/misc/ert.texi (Useful Techniques when Writing Tests):
+ Replace ert--mismatch references with its cl-lib replacement,
+ cl-mismatch.
+
+2017-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a typo in Eshell manual
+
+ * doc/misc/eshell.texi (History): Fix a typo. Reported by Mak
+ Kolybabi <mak@kolybabi.com>.
+
+2017-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Ensure last line is at window bottom in shell buffers
+
+ * lisp/shell.el (shell-mode): Use setq-local. Set
+ scroll-conservatively to 101 locally. See the discussion at
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg00736.html
+ for the reasons.
+
+2017-01-27 Michael Hoffman <emacs-hoffman@sneakemail.com> (tiny change)
+
+ Support Bash Ctrl-Z indication of directory name in term.el
+
+ * lisp/term/xterm.el (term-emulate-terminal): Do not display ?\032 escape
+ codes even when 'handled-ansi-message' is non-nil. (Bug#11919)
+
+2017-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Don't report zero errno for inaccessible directory
+
+ * src/fileio.c (Ffile_accessible_directory_p): Report EACCES when
+ a file handler reports a failure. (Bug#25419)
+
+2017-01-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix filenotify-tests on MS-Windows
+
+ * test/lisp/filenotify-tests.el (file-notify-test04-file-validity)
+ (file-notify-test05-dir-validity)
+ (file-notify-test06-many-events)
+ (file-notify-test08-watched-file-in-watched-dir): Manually remove
+ the watch descriptor before calling file-notify--test-cleanup-p.
+ (Bug#25539)
+
+2017-01-27 Hong Xu <hong@topbug.net>
+
+ python-mode: Fix detection for opening blocks.
+
+ * lisp/progmodes/python.el
+ (python-info-dedenter-opening-block-positions): There can't be any
+ back-indented lines between an opening block and the current line.
+
+ * test/lisp/progmodes/python-tests.el
+ (python-indent-electric-colon-4): Add an indent test case where
+ there is one-more indented previous opening block.
+
+2017-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix Message check for bogus domain names
+
+ * lisp/gnus/message.el (message-make-fqdn): Fix check for
+ bogus system names (bug#24570).
+
+2017-01-27 Øyvind Stegard <oyvind@stegard.net> (tiny change)
+
+ Subject: Restore correct Gnus newsgroup name after sending message
+
+ * lisp/gnus/gnus-msg.el (gnus-msg-mail): Set the value of
+ gnus-newsgroup-name in the correct buffer (bug#24329).
+
+2017-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Mention the new Gnus sorting command
+
+2017-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Don't try to find charsets of non-text MIME parts
+
+ * lisp/gnus/mml.el (mml-generate-mime-1): It seems nonsensical
+ to try to determine the charset of non-text message parts, so
+ skip that (bug#24190). This will also remove messages like
+ "bunzip2ing /tmp/acsb.cpio.bz2...done" while sending messages
+ if you include such files.
+
+2017-01-27 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Add new command gnus-article-sort-by-marks
+
+ * doc/misc/gnus.texi (Summary Sorting): Mention
+ gnus-summary-sort-by-marks.
+
+ * lisp/gnus/gnus-sum.el (gnus-article-sort-by-marks): New
+ function (bug#23393).
+ (gnus-thread-sort-by-marks): Ditto.
+ (gnus-summary-sort-by-mark): New command suggested by Dan Jacobson.
+ (gnus-summary-mode-map): Add keystroke.
+ (gnus-summary-make-menu-bar): Add to menu.
+
+2017-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Make `C-h b' work correctly in Gnus article buffer (bug#18257)
+
+ * lisp/gnus/gnus-art.el (gnus-article-describe-bindings):
+ Ignore summary commands that aren't bound to
+ gnus-article-read-summary-keys keys (bug#18257).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix crossposting in non-primary groups
+
+ * lisp/gnus/message.el
+ (message-cross-post-followup-to-header): Gnus server prefixes
+ shouldn't be included in the group names (bug#21661).
+ (message-cross-post-followup-to): Ditto.
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Gnus doc clarification
+
+ * doc/misc/gnus.texi (Unavailable Servers): Explicitly say
+ that "unreachable" is the same as disabling it (bug#21630).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Remove dead code from rfc2047
+
+ * lisp/mail/rfc2047.el (rfc2047-fold-field): Remove dead code.
+
+ It's been disabled since 2005, when I made the change with the
+ following comment.
+
+ (rfc2047-encode-message-header): Disabled header folding -- not
+ all headers can be folded, and this should be done by the message
+ composition mode. Probably. I think.
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fill too long mail headers
+
+ * lisp/gnus/message.el (message--fold-long-headers): New
+ function to fold too-long headers (bug#21608).
+ (message-send-mail): Use it to fill headers longer than 998
+ characters (which is the protocol limit).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make nndoc more resilient against corrupted files
+
+ * lisp/gnus/nndoc.el (nndoc-possibly-change-buffer): Don't bug
+ out on invalid files, like invalid .gz files (bug#21538).
+ This may hinder Gnus from starting up.
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Respect buffer-local message-fcc-handler-function
+
+ * lisp/gnus/message.el (message-do-fcc): Copy the local
+ variables from the Message buffer so that local settings of
+ `message-fcc-handler-function' etc are respected (bug#21174).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ (message-do-fcc): Modernize the code slightly.
+
+ * lisp/gnus/message.el (message-do-fcc): Modernize the code slightly.
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Avoid a regexp overflow in message-goto-body
+
+ * lisp/gnus/message.el (message-goto-body-1): Avoid using a
+ complicated backtracking regexp, because they may overflow on
+ large headers (bug#21160).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Refactor message-goto-body
+
+ * lisp/gnus/message.el (message-goto-body-1): Refactor out for reuse.
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix typo in last checkin
+
+ * lisp/gnus/nnimap.el (nnimap-shell-program): Document
+ nnimap-shell-program (bug#20651).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Document nnimap-shell-program
+
+ * lisp/gnus/nnimap.el (nnimap-shell-program): Document
+ nnimap-shell-program (bug#20651).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Document :shell-command in `make-network-process'
+
+ * doc/lispref/processes.texi (Network): Document :shell-command.
+
+ * lisp/net/network-stream.el (open-network-stream): Document
+ the :shell-command parameter (bug#20651).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Gnus doc clarification
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-save-article): Mention
+ the gnus-prompt-before-saving variable (bug#20500).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix the previous mml patch better
+
+ * lisp/gnus/mml.el (mml-minibuffer-read-file): Fix the
+ previous patch in a better way (bug#20480).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Give a slight better error message in mml-minibuffer-read-file
+
+ * lisp/gnus/mml.el (mml-minibuffer-read-file): Give a slightly
+ better error message when the user enters nothing (bug#20480).
+
+2017-01-26 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el:(bc-cond-jump-table-info)add docstring
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make eww buffers prettier in the buffer listing
+
+ * lisp/net/eww.el (eww-render): Put the currently visited URL
+ into the buffer listing (bug#23738).
+ (eww-render): Ditto.
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Allow mml-attach-file to prompt less
+
+ * lisp/gnus/mml.el (mml-attach-file): If given a prefix, don't
+ prompt for type/description/disposition, but use defaults
+ (bug#19202).
+
+2017-01-26 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Don't allow message-newline-and-reformat to be run outside the body
+
+ * lisp/gnus/message.el (message-newline-and-reformat): Error
+ out if run outside the body of a message (bug#18820).
+
+2017-01-26 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el: Use correct function to push nil
+
+ * lisp/emacs-lisp/bytecomp.el: (byte-compile-cond-jump-table) Use
+ byte-compile-constant instead of byte-compile-form to push nil.
+
+2017-01-26 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/disass.el: Fix spacing while showing jump tables
+
+2017-01-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Replace QUIT with maybe_quit
+
+ There’s no longer need to have QUIT stand for a slug of C statements.
+ Use the more-obvious function-call syntax instead.
+ Also, use true and false when setting immediate_quit.
+ These changes should not affect the generated machine code.
+ * src/lisp.h (QUIT): Remove. All uses replaced by maybe_quit.
+
+2017-01-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ A quicker check for quit
+
+ On some microbenchmarks this lets Emacs run 60% faster on my
+ platform (AMD Phenom II X4 910e, Fedora 25 x86-64).
+ * src/atimer.c: Include keyboard.h, for pending_signals.
+ * src/editfns.c (Fcompare_buffer_substrings):
+ * src/fns.c (Fnthcdr, Fmemq, Fmemql, Fassq, Frassq, Fplist_put)
+ (Fnconc, Fplist_member):
+ Set and clear immediate_quit before and after loop instead of
+ executing QUIT each time through the loop. This is OK for loops
+ that affect only locals.
+ * src/eval.c (process_quit_flag): Now static.
+ (maybe_quit): New function, containing QUIT’s old body.
+ * src/fns.c (rarely_quit): New function.
+ (Fmember, Fassoc, Frassoc, Fdelete, Fnreverse, Freverse)
+ (Flax_plist_get, Flax_plist_put, internal_equal, Fnconc):
+ Use it instead of QUIT, for
+ speed in tight loops that might modify non-locals.
+ * src/keyboard.h (pending_signals, process_pending_signals):
+ These belong to keyboard.c, so move them here ...
+ * src/lisp.h: ... from here.
+ (QUIT): Redefine in terms of the new maybe_quit function, which
+ contains this macro’s old definiens. This works well with branch
+ prediction on processors with return stack buffers, e.g., x86
+ other than the original Pentium.
+
+2017-01-26 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify make-list implementation
+
+ * src/alloc.c (Fmake_list): Don’t unroll loop, as the complexity
+ is not worth it these days.
+
+2017-01-26 Mark Oteiza <mvoteiza@udel.edu>
+
+ Make use of cl-loop destructuring
+
+ * lisp/progmodes/js.el (js--get-tabs): Replace extraneous bits with
+ destructuring.
+ (with-js): Add declare forms.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Revert "Bind C-c keys in the article buffer"
+
+ This reverts commit 6b4195f2ace1f6328c5a833fde40f39babef4fa6.
+
+ The commit somehow lead to problems in other parts of Emacs.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Document how to quote MML tags
+
+ * doc/misc/emacs-mime.texi (MML Definition): Mention how to
+ quote MML tags (bug#18881).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make address parsing more robust
+
+ * lisp/mail/ietf-drums.el (ietf-drums-parse-address): Don't
+ bug out on addresses like
+ (ietf-drums-parse-address "\"Foo \"bar\" <larsi@gnus.org>")
+ (bug#18572).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix the %P (line number) thing in Gnus summary buffers
+
+ * lisp/gnus/gnus-salt.el (gnus-pick-line-number): Remove hack.
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-read-group-1): Reset the
+ "pick" mode line number on entry instead of relying in a hack (bug#18311).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix wrong documentation on nnmairix keystrokes
+
+ * doc/misc/gnus.texi (nnmairix keyboard shortcuts): The
+ nnmairix commands are on G G, not $ (bug#18260).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Bind C-c keys in the article buffer
+
+ * lisp/gnus/gnus-art.el (gnus-article-mode-map): Also bind the
+ C-c keys so that they execute in the summary buffer
+ (bug#18257). This makes commands like `C-c C-f' work from the
+ article buffer.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Don't mark articles in Gnus as displayed when they aren't
+
+ * lisp/gnus/gnus-sum.el (gnus-summary-read-group-1): Don't
+ mark any articles as selected if we're not selecting any
+ articles (bug#18255).
+
+2017-01-25 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/disass.el: Display jump tables for switch.
+
+ * lisp/emacs-lisp/bytecomp.el:Use correct size for switch jump-table
+
+ * lisp/emacs-lisp/bytecomp.el: Simplify b-c-cond-valid-obj2-p
+
+ * lisp/emacs-lisp/bytecomp.el: Fix byte-switch codegen with symbols.
+
+2017-01-25 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/byte-opt.el: Add support for decompiling switch
+
+ * lisp/emacs-lisp/byte-opt.el: (byte-decompile-bytecode-1) When the
+ constant encountered precedes a byte-switch op, replace all the
+ addresses in the jump table with tags.
+
+2017-01-25 Mark Oteiza <mvoteiza@udel.edu>
+
+ Move cXXXr and cXXXXr to subr.el
+
+ * etc/NEWS: Mention new core Elisp.
+ * doc/lispref/lists.texi (List Elements): Document and index the new
+ functions.
+ * doc/misc/cl.texi (List Functions): Change "defines" to "aliases".
+ * lisp/subr.el (caaar, caadr, cadar, caddr, cdaar, cdadr, cddar)
+ (cdddr, caaaar caaadr, caadar, caaddr, cadaar, cadadr, caddar):
+ (cadddr, cdaaar, cdaadr, cdadar, cdaddr, cddaar, cddadr, cdddar):
+ (cddddr): New functions.
+ * lisp/emacs-lisp/cl-lib.el (cl-caaar, cl-caadr, cl-cadar, cl-caddr):
+ (cl-cdaar, cl-cdadr, cl-cddar cl-cdddr, cl-caaaar cl-caaadr):
+ (cl-caadar, cl-caaddr, cl-cadaar, cl-cadadr, cl-caddar, cl-cadddr):
+ (cl-cdaaar, cl-cdaadr, cl-cdadar, cl-cdaddr, cl-cddaar, cl-cddadr):
+ (cl-cdddar, cl-cddddr): Alias to new subr functions.
+ * lisp/emacs-lisp/cl.el (cl-unload-function): Remove cXXXr and cXXXXr
+ elements.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Only save .newsrc file if the native method is NNTP
+
+ * lisp/gnus/gnus-start.el (gnus-save-newsrc-file): Only save
+ the .newsrc file if the native select method is NNTP
+ (bug#18198). This avoids problems with invalid IMAP group
+ names and the like in the .newsrc file.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Only save .newsrc file if the native method is NNTP
+
+ * lisp/gnus/gnus-start.el (gnus-save-newsrc-file): Only save
+ the .newsrc file if the native select method is NNTP
+ (bug#18198). This avoids problems with invalid IMAP group
+ names and the like in the .newsrc file.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Gnus custom spec fix
+
+ * lisp/gnus/gnus-art.el (gnus-signature-limit): Fix customize
+ spec to match the doc string (bug#17679).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify confusing Gnus error message
+
+ * lisp/gnus/gnus-topic.el (gnus-topic-unindent): Clarify
+ confusing error message (bug#17677).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Make C-u C-x m work with Message as documented
+
+ * lisp/gnus/message.el (message-mail): Respect the CONTINUE
+ parameter (bug#17175).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix problem with auto-mode and dir-locals-collect-variables
+
+ * lisp/files.el (dir-locals-collect-variables): When run from
+ auto-mode, the file in question may not be an absolute path
+ name (bug#24016).
+
+ Example backtrace:
+
+ Debugger entered--Lisp error: (args-out-of-range "compile-1st-in-loa
+ dir-locals-collect-variables(((emacs-lisp-mode (indent-tabs-mode))
+ hack-dir-local-variables()
+ hack-local-variables(no-mode)
+ run-mode-hooks(diff-mode-hook)
+ diff-mode()
+ mm-display-inline-fontify((#<buffer *mm*-923037> ("text/x-diff" (
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Attach text files correctly in Message
+
+ * lisp/gnus/mml.el (mml-generate-mime-1): Detect which coding
+ system has been used in attached text files, and don't try to
+ do any encoding of these files (bug#13808).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Build fix for older gnutls versions
+
+ * src/gnutls.c (emacs_gnutls_handle_error):
+ GNUTLS_E_PREMATURE_TERMINATION is apparently only present in
+ gnutls-3.
+
+2017-01-25 Tino Calancha <tino.calancha@gmail.com>
+
+ ediff-difference-vector-alist: Drop duplicated definition
+
+ * lisp/vc/ediff-init.el (ediff-difference-vector-alist):
+ Drop duplicated definition.
+ (ediff-difference-vector-A, ediff-difference-vector-B)
+ (ediff-difference-vector-C, ediff-difference-vector-Ancestor):
+ Move definition before 'ediff-difference-vector-alist'.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Revert "nnimap.el: support additional expunge options"
+
+ This reverts commit 4e9baea6aba1633074889339dcc7cdc9d73880d3.
+
+ The patch broke fetching new mail:
+
+ Debugger entered--Lisp error: (error "Format specifier doesn’t match argument type")
+ format("%d .*\n" (t ("OK" ("HIGHESTMODSEQ" "914696") "Expunge" "completed.") ("VANISHED" "1825937") ("0" "RECENT")))
+ (looking-at (format "%d .*\n" sequence))
+ (not (looking-at (format "%d .*\n" sequence)))
+ (progn (while (and (not (bobp)) (progn (forward-line -1) (looking-at "\\*\\|[0-9]+ OK NOOP")))) (not (looking-at (format "%d .*\n" sequence))))
+
+2017-01-25 Nikolaus Rath <Nikolaus@rath.org>
+
+ nnimap.el: support additional expunge options
+
+ * lisp/gnus/nnimap.el (nnimap-close-group)
+ (nnimap-request-expire-articles, nnimap-delete-article)
+ (nnimap-request-scan): add new 'never, 'immediate, and 'on-exit
+ settings for nnimap-expunge (bug#20670).
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Don't tag Gnus bugs with "gnus"
+
+ * lisp/gnus/gnus-msg.el (gnus-bug): Remove the bug package tags.
+
+ * lisp/gnus/gnus.el (gnus-bug-package): Removed; Gnus doesn't
+ have its own package any more in the bug tracker.
+
+2017-01-25 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Tweak TLS error messaging on closed connections
+
+ * src/gnutls.c (emacs_gnutls_handle_error): Demote the normal
+ peer-closed-connection "The TLS connection was non-properly
+ terminated" message to a lower level so that it isn't shown to
+ the user by default.
+
+2017-01-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Avoid having eww unexpectedly open external browsers
+
+ * lisp/net/eww.el (eww-render): Instead of opening unsupported
+ content types like audio/mpeg directly in an external browser
+ (which can be very confusing especially when something
+ redirects to a file like that), just display a simple
+ interstitial that people can choose to click on or not
+ (bug#22671).
+
+2017-01-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ When opening new eww buffers, use buffer names based on the host name
+
+ * lisp/net/eww.el (eww-browse-url): When opening in a new
+ window, use a buffer name based on the host name (bug#23738).
+ (eww--dwim-expand-url): Refactored out into its own function
+ for easier reuse.
+
+2017-01-24 David Engster <deng@randomsample.de>
+
+ xml: Fix parsing of default namespace with quoted names
+
+ * lisp/xml.el (xml-parse-attlist): Properly extract namespace when
+ parsing is done with quoted symbol names (bug#23440).
+ * test/lisp/xml-tests.el (xml-parse-test--default-namespace-qnames)
+ (xml-parse-test-default-namespace-qnames): Test for the above.
+
+2017-01-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Fix rendering of some complex SVG images
+
+ * lisp/net/shr.el (shr-parse-image-data): Don't transform
+ SVG->DOM->XML unless we're blocking images, as this is apt to
+ destroy the SVG (bug#24111).
+
+2017-01-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Clarify the last clarification
+
+ * lisp/net/shr.el (shr-width): Clarify the interaction with
+ `shr-use-fonts' (bug#24928).
+
+2017-01-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ shr-width doc clarification
+
+ * lisp/net/shr.el (shr-width): Clarify the interaction with
+ `shr-use-fonts' (bug#24928).
+
+2017-01-24 Lars Ingebrigtsen <larsi@gnus.org>
+
+ Allow passing in max-width/height
+
+ * lisp/net/shr.el (shr-rescale-image): Allow passing in
+ max-width/height (bug#25287).
+
+2017-01-24 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/vhdl-mode.el: Avoid add-to-list on local vars
+
+ Require `cl' for `pushnew'.
+ (vhdl-scan-project-contents, vhdl-compose-wire-components)
+ (vhdl-uniquify): Use `pushnew' instead of `add-to-list'.
+
+2017-01-24 Noam Postavsky <npostavs@gmail.com>
+
+ Fix comment detection on open parens
+
+ Characters having both open paren syntax and comment start syntax were
+ being detected as open parens even when they should have been part a
+ comment starter (Bug#24870).
+
+ * src/syntax.c (in_2char_comment_start): New function, extracted from
+ `scan_sexps_forward'.
+ (scan_sexps_forward): Add check for a 2-char comment starter before the
+ loop. Inside the loop, do that check after incrementing the 'from'
+ character index. Move the single char comment syntax cases into the
+ switch instead of special casing them before.
+ * test/src/syntax-tests.el (parse-partial-sexp-paren-comments):
+ (parse-partial-sexp-continue-over-comment-marker): New tests.
+
+2017-01-23 Alan Mackenzie <acm@muc.de>
+
+ Give , and .@ doc strings. Fixes bug #24561.
+
+ Also make *Help* links to ``' possible. Also make usable as such doc strings
+ on the function-documentation property of a symbol.
+
+ * lisp/emacs-lisp/backquote.el (top-level): Give , and '@ doc strings on the
+ function-documentation property. Also give these symbols a reader-construct
+ property.
+
+ * lisp/help-fns.el (describe-function): Allow the function-documentation
+ property to work. Use princ rather than prin1 to print the function's name
+ when it has a reader-construct property.
+ (help-fns-signature): Don't insert `high-usage' for a reader-construct.
+ (describe-function-1): Adapt to process documentation on the
+ function-documentation property. Print "a reader construct" when appropriate.
+
+ * lisp/help-mode.el (help-xref-symbol-regexp): Amend this regexp also to match
+ ``'.
+
+2017-01-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Improve uses of CHECK_LIST etc.
+
+ * src/eval.c (FletX): Report an error for invalid constructs like
+ ‘(let* (a . 0))’, so that ‘let*’ is more consistent with ‘let’.
+ (lambda_arity): Use plain CHECK_CONS.
+ * src/fns.c (CHECK_LIST_END): Move from here to lisp.h.
+ (Fcopy_alist): Remove unnecessary CHECK_LIST call, since
+ concat does that for us.
+ (Fnthcdr, Fmember, Fmemql, Fdelete, Fnreverse):
+ Use CHECK_LIST_END, not CHECK_LIST_CONS. This hoists a
+ runtime check out of the loop.
+ (Fmemq): Simplify and use CHECK_LIST_END instead of CHECK_LIST.
+ (Fassq, Fassoc, Frassq, Frassoc):
+ Simplify and use CHECK_LIST_END instead of CAR.
+ (assq_no_quit, assoc_no_quit): Simplify and assume proper list.
+ (Fnconc): Use plain CHECK_CONS, and do-while instead of while loop.
+ * src/fontset.c (Fnew_fontset):
+ * src/frame.c (Fmodify_frame_parameters):
+ Use CHECK_LIST_END at end, rather than CHECK_LIST at start, for a
+ more-complete check.
+ * src/gfilenotify.c (Fgfile_add_watch):
+ Omit unnecessary CHECK_LIST, since Fmember does that for us.
+ * src/lisp.h (lisp_h_CHECK_LIST_CONS, CHECK_LIST_CONS):
+ Remove; no longer used.
+ (CHECK_LIST_END): New inline function.
+
+2017-01-22 Tino Calancha <tino.calancha@gmail.com>
+
+ Prevent to use tabulated-list--near-rows unbound
+
+ * lisp/emacs-lisp/tabulated-list.el (tabulated-list-print-entry):
+ Make sure 'tabulated-list--near-rows' is bound before use it (Bug#25506).
+
+2017-01-22 Juri Linkov <juri@linkov.net>
+
+ * lisp/simple.el (region-bounds): New function.
+
+ (region-noncontiguous-p): Use it.
+ https://lists.gnu.org/r/emacs-devel/2017-01/msg00044.html
+
+2017-01-21 Alan Mackenzie <acm@muc.de>
+
+ Fix low-level handling of (big) C macros.
+
+ In particular, ensure that a comment detected by its syntax is not a CPP
+ construct marked with generic comment delimiter syntax-table text
+ properties.
+
+ * lisp/progmodes/cc-engine.el (c-beginning-of-macro, c-end-of-macro): Set
+ c-macro-cache-syntactic to nil when the cached macro changes.
+ (c-syntactic-end-of-macro, c-no-comment-end-of-macro)
+ (c-state-semi-pp-to-literal, c-state-full-pp-to-literal)
+ (c-state-pp-to-literal, c-parse-ps-state-to-cache)
+ (c-state-cache-non-literal-place, c-literal-limits, c-literal-start)
+ (c-determine-limit): When checking a parse syntax for a comment, check that
+ we're not in a CPP construct marked by syntax-table generic comment delimiter
+ text property.
+ (c-state-pp-to-literal): Change from a defsubst to a defun.
+
+ * lisp/progmodes/cc-mode.el (c-neutralize-syntax-in-and-mark-CPP): Check a
+ parse syntax as described above under cc-engine.el.
+
+2017-01-21 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el: Remove unused debugging statements.
+
+2017-01-21 Noam Postavsky <npostavs@gmail.com>
+
+ Don't wait for frame to become visible
+
+ * src/xterm.c (x_make_frame_visible): Remove code that waits for the
+ frame to become visible. We have to deal with invisible frames anyway,
+ the loop could sometimes before the frame turned visible, and for some
+ window managers (e.g., XMonad, i3wm) it caused Emacs to get stuck in a
+ busy loop (Bug#24091).
+
+2017-01-21 Tino Calancha <tino.calancha@gmail.com>
+
+ diff-hunk-kill independent of point inside headers
+
+ Make diff-apply-hunk and diff-hunk-kill independent of the point
+ position in a diff header (Bug#17544).
+ This change allows to apply hunks in order. It also makes possible to
+ press M-k repeatedly to kill hunks in the order they appear in the buffer.
+ See discussion on #Bug25105.
+ * lisp/vc/diff-mode.el (diff-file-junk-re):
+ Move definition before it's used.
+ (diff--at-diff-header-p): New predicate; return non-nil when point
+ is inside a hunk header, a file header, or within a line
+ matching diff-file-junk-re.
+ (diff-beginning-of-hunk): Use it.
+ Check if the point is inside a diff header, in the middle of a hunk,
+ or before the first hunk.
+ (diff-apply-hunk): Call diff-beginning-of-hunk with non-nil arg
+ before apply the hunk.
+ (diff-hunk-kill, diff-file-kill):
+ Call diff-beginning-of-hunk with non-nil arg after kill the hunks.
+ (diff-post-command-hook): Call diff-beginning-of-hunk with non-nil argument.
+
+2017-01-20 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of hooks related to saving buffers
+
+ * lisp/files.el (write-file-functions, write-contents-functions)
+ (before-save-hook, after-save-hook): Note that these are only used
+ by save-buffer.
+
+ * doc/lispref/backups.texi (Auto-Saving):
+ * doc/lispref/files.texi (Saving Buffers): Mention that
+ save-related hooks are not run by auto-saving. (Bug#25460)
+
+2017-01-20 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of auto-save-visited-file-name
+
+ * doc/emacs/files.texi (Auto Save Files): Mention subtle
+ differences between saving the buffer and auto-saving with
+ auto-save-visited-file-name set non-nil. (Bug#25478)
+
+2017-01-20 Noam Postavsky <npostavs@gmail.com>
+
+ Fix free var FOO-mode-{syntax,abbrev}-table warnings
+
+ * lisp/emacs-lisp/derived.el (define-derived-mode): Unconditionally
+ defvar the syntax and abbrev tables so that the compiler will know that
+ they are dynamically bound variables (Bug#25446).
+
+2017-01-19 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el: Fix errors with matching quoted forms
+
+ * lisp/emacs-lisp/bytecomp.el: (byte-compile-cond-jump-table-info)
+ eval obj2 to avoid quoted forms being stored as is.
+
+2017-01-19 Vibhav Pant <vibhavp@gmail.com>
+
+ lisp/emacs-lisp/bytecomp.el: Use byte-switch only for quoted symbols
+
+2017-01-19 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el: Add default-case for last cond clause.
+
+ * lisp/emacs-lisp/bytecomp.el: (byte-compile-cond-jump-table) Add
+ default-case for last cond clause.
+
+2017-01-19 Philipp Stephani <phst@google.com>
+
+ Check that variable lists are actually lists
+
+ 'let' and 'let*' document that their first argument has to be a list,
+ but don't check for that; instead, they allow (and silently ignore)
+ other types. Introduce an explicit type check.
+
+ * src/eval.c (Flet, FletX): Check that the variable list is indeed a
+ list.
+ * test/src/eval-tests.el: Add unit tests.
+
+2017-01-19 Vibhav Pant <vibhavp@gmail.com>
+
+ Add type checking for Bswitch, when enabled at compile time.
+
+ * src/bytecode.c: (exec_byte_code) If BYTE_CODE_SAFE is enabled at
+ compile time, use CHECK_TYPE to verify that the jump table is a hash table.
+
+2017-01-19 Vibhav Pant <vibhavp@gmail.com>
+
+ Use byte-switch for all symbols.
+
+ * lisp/emacs-lisp/bytecomp.el: (byte-compile-cond-valid-obj2-p) Return
+ t for all symbols (instead for just keywords)
+
+2017-01-19 Noam Postavsky <npostavs@gmail.com>
+
+ Avoid inefficient regex in diff-refine-hunk (Bug#25410)
+
+ * lisp/vc/diff-mode.el (diff--forward-while-leading-char): New function.
+ (diff-refine-hunk): Use it instead of trying to match multiple lines
+ with a single lines.
+
+2017-01-18 Eli Zaretskii <eliz@gnu.org>
+
+ Remove lock file when auto-saving into the visited file
+
+ * src/fileio.c (write_region): When auto-saving into the visited
+ file, unlock the file whenever we mark the buffer unmodified.
+ (Bug#25470)
+
+2017-01-18 Vibhav Pant <vibhavp@gmail.com>
+
+ * src/bytecode.c: (exec_byte_code) Use hash_lookup for Bswitch
+
+ Fgethash type checks the provided table object, which is unnecessary
+ for compiled bytecode.
+
+2017-01-18 Tom Tromey <tom@tromey.com>
+
+ fix typo in mailcap-mime-extensions
+
+ * lisp/net/mailcap.el (mailcap-mime-extensions): Use "text/x-patch",
+ not "test/x-patch". (Bug#25472)
+
+2017-01-18 Lele Gaifax <lele@metapensiero.it> (tiny change)
+
+ Fix typos in flymake.el
+
+ * lisp/progmodes/flymake.el (flymake-check-patch-master-file-buffer):
+ Spelling fixes in the doc string.
+
+2017-01-18 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a bug with signaling a thread that waits for condvar
+
+ * src/thread.c (lisp_mutex_lock_for_thread): New function,
+ with all the guts of lisp_mutex_lock.
+ (lisp_mutex_lock): Call lisp_mutex_lock_for_thread.
+ (condition_wait_callback): Don't call post_acquire_global_lock
+ before locking the mutex, as that could cause a signaled thread to
+ exit prematurely, because the condvar's mutex is recorded to be
+ not owned by any thread, and with-mutex wants to unlock it as part
+ of unwinding the stack in response to the signal.
+
+2017-01-18 Eli Zaretskii <eliz@gnu.org>
+
+ Rudimentary error handling for non-main threads
+
+ * src/thread.c (last_thread_error): New static variable.
+ (syms_of_threads): Staticpro it.
+ (record_thread_error, Fthread_last_error): New functions.
+ (syms_of_threads): Defsubr Fthread_last_error.
+
+ * doc/lispref/threads.texi (Basic Thread Functions): Document
+ thread-last-error.
+
+ * test/src/thread-tests.el (thread-errors, thread-signal-early)
+ (threads-condvar-wait): Test the values returned by
+ thread-last-error.
+
+2017-01-17 Tom Tromey <tom@tromey.com>
+
+ Add info-lookup help for gdb-script-mode
+
+ Bug#25464:
+ * lisp/info-look.el (info-lookup-guess-gdb-script-symbol): New
+ function.
+ Add help for gdb-script-mode.
+
+2017-01-17 Tom Tromey <tom@tromey.com>
+
+ Treat ":root" as a css-selector
+
+ * lisp/textmodes/css-mode.el (css--font-lock-keywords): Recognize bare
+ ":root" as selector.
+
+2017-01-17 Tom Tromey <tom@tromey.com>
+
+ Fix JS regexp literal syntax propertization in expressions
+
+ Bug#25465:
+ * lisp/progmodes/js.el (js-syntax-propertize): Recognize a regexp
+ literal after "!", "&", and "|".
+ test/lisp/progmodes/js-tests.el (js-mode-regexp-syntax): New test.
+
+2017-01-17 Glenn Morris <rgm@gnu.org>
+
+ More NEWS checking for admin.el's set-version
+
+ * admin/admin.el (set-version): Warn if temporary NEWS markup
+ still present in release candidates.
+
+2017-01-17 Mark Oteiza <mvoteiza@udel.edu>
+
+ Mark unused arguments and remove unused variables
+
+ * lisp/play/dunnet.el (dun-mode, dun-die, dun-inven, dun-try-take):
+ (dun-dig, dun-type, dun-n, dun-s, dun-e, dun-w, dun-ne, dun-se):
+ (dun-nw, dun-sw, dun-up, dun-down, dun-in, dun-out, dun-long):
+ (dun-swim, dun-score, dun-flush, dun-piss, dun-sleep, dun-drive):
+ (dun-superb, dun-power, dun-unix-parse, dun-bin, dun-fascii):
+ (dun-ftpquit, dun-ftphelp, dun-uexit, dun-pwd, dun-dos-parse):
+ (dun-dos-invd, dun-dos-spawn, dun-dos-exit, dun-dos-nil):
+ (dungeon-nil): Mark arguments as unused.
+ (dun-drop, dun-objnum-from-args, dun-get-path, dun-ftp):
+ (dun-restore): Remove unused variable.
+
+2017-01-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix auto-save-file-name problem in Tramp on MS Windows
+
+ * lisp/files.el (make-auto-save-file-name): Use `file-remote-p'
+ rather than an ange-ftp regexp.
+
+ * lisp/net/tramp.el (tramp-handle-make-auto-save-file-name):
+ Fix a problem when running on MS Windows.
+
+ * test/lisp/net/tramp-tests.el (tramp-test31-make-auto-save-file-name):
+ Adapt test.
+
+2017-01-17 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix auto-save-file-name problem in Tramp on MS Windows. Do not merge
+
+ * lisp/net/tramp.el (tramp-handle-make-auto-save-file-name):
+ Fix a problem when running on MS Windows.
+
+2017-01-17 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 42614fa Update remaining copyright years with admin.el M-x set-copyright
+ f17a006 * lisp/ffap.el (ffap-lax-url): Bump :version after recent cha...
+
+2017-01-17 Mark Oteiza <mvoteiza@udel.edu>
+
+ Nix some uses of eval
+
+ * lisp/play/dunnet.el: Fix triple negative.
+ (dun-doverb): Use funcall instead of eval.
+ (dun-echo): Just call dun-mprinc.
+ (dun-save-val): Just bind value without eval.
+
+2017-01-17 Tom Tromey <tom@tromey.com>
+
+ Fix comment in css-mode.el
+
+ * lisp/textmodes/css-mode.el: Remove obsolete comment.
+
+2017-01-16 Vibhav Pant <vibhavp@gmail.com>
+
+ update branch
+
+2017-01-16 Ian Dunn <dunni@gnu.org> (tiny change)
+
+ * lisp/net/eww.el (eww-tag-meta): Handle single quoted URLs (Bug#25445).
+
+2017-01-15 Noam Postavsky <npostavs@gmail.com>
+
+ Improve ffap-gopher-at-point handling of long lines
+
+ * lisp/ffap.el (ffap-gopher-regexp): Only match the KEY part. Note
+ setting to nil is now supported.
+ (ffap--gopher-var-on-line): New function.
+ (ffap-gopher-at-point): Use it instead of the old ffap-gopher-regexp
+ which could overflow the regexp stack on long lines (Bug#25391). Use
+ `let-alist' instead of calling `set' on local variables.
+ * test/lisp/ffap-tests.el (ffap-gopher-at-point): New test.
+
+2017-01-15 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/byte-opt.el: Optimize how tags are checked for use.
+
+ * lisp/emacs-lisp/byte-opt.el: (byte-optimize-lapcode): Return nil instantly on
+ finding the tag in a jump table.
+
+2017-01-15 Vibhav Pant <vibhavp@gmail.com>
+
+ * lisp/emacs-lisp/bytecomp.el: Add documentation, remove code duplication
+
+2017-01-14 Vibhav Pant <vibhavp@gmail.com>
+
+ Add new 'switch' byte-code.
+
+ 'switch' takes two arguments from the stack: the variable to test, and
+ a jump table (implemented as a hash-table with the appropriate :test
+ function). By looking up the value of the variable in the hash table,
+ the interpreter can jump to the label pointed to by the value, if any.
+ This implementation can only be used for `cond' forms of the type
+ `(cond ((test x 'foo) 'bar) ...)`, such that the function `test` and
+ variable `x` is same for all clauses.
+
+ * lisp/emacs-lisp/bytecomp.el:
+
+ * Add (byte-compile-cond-valid-obj2-p), (byte-compile-cond-vars),
+ (byte-compile-cond-jump-table-info), (byte-compile-jump-table-add-tag),
+ (byte-compile-cond-jump-table), byte-compile-jump-tables.
+
+ * Add defcustom `byte-compile-cond-use-jump-table'.
+
+ * (byte-compile-cond): Use them.
+
+ * (byte-compile-lapcode): Patch tags present in jump tables, if any.
+
+ * lisp/emacs-lisp//byte-opt.el: (byte-optimize-lapcode): Add checks to
+ some peephole optimizations to prevent them from messing up any code
+ involving `byte-switch`.
+
+ * src/bytecode.c: (exec_byte_code): Add bytecode Bswitch.
+
+2017-01-14 Alan Third <alan@idiocy.org>
+
+ Fix NS main thread check (bug#25265)
+
+ * src/nsterm.m (ns_read_socket, ns_select): Replace mainThread with
+ isMainThread.
+
+2017-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/progmodes/sql.el (sql-product-alist): Doc tweak
+
+ `:sqli-comint-func' does not have to be a symbol.
+
+2017-01-14 Alan Mackenzie <acm@muc.de>
+
+ Correct c-parse-state-get-strategy for moving HERE backward into a macro.
+
+ * lisp/progmodes/cc-engine.el (c-parse-state-get-strategy): When HERE is below
+ its previous value, we chose strategy 'forward, and the new HERE is in a
+ (different) macro, ensure the returned START-POINT is not above the start of
+ the macro.
+
+2017-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ Include "Date:" in mail messages filed by 'sendmail-send-it'
+
+ * lisp/mail/sendmail.el (mail-do-fcc): Insert a 'Date:' header
+ into the filed message. In the outgoing message, sendmail will
+ add the date, but the composed message body doesn't have it.
+ (Bug#25436)
+
+2017-01-14 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/progmodes/sql.el (sql-product-alist): Doc fix. (Bug#25440)
+
+2017-01-14 Dmitry Gutov <dgutov@yandex.ru>
+
+ Remove leftover references to log-view-message-face
+
+ * lisp/vc/vc-bzr.el (vc-bzr-log-view-mode): Use log-view-message.
+
+ * lisp/vc/vc-git.el (vc-git-root-log-format): Same.
+
+ * lisp/vc/vc-hg.el (vc-hg-root-log-format): Same.
+
+2017-01-13 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Record autoloads till emacs dump
+
+ * admin/ldefs-clean.el (ldefs-clean-up): Record autoloads till emacs dump
+ * lisp/ldefs-boot-auto.el (batch-byte-compile): Update
+
+ Previously, autoloads were collected till loaddefs.el was generated as
+ part of the build. However, bootstrap-emacs does not load
+ loaddefs (rather it is dumped), hence we must record autoloads until the
+ full emacs binary is dumped.
+
+2017-01-13 Tom Tromey <tom@tromey.com>
+
+ Add chained indentation to js-mode
+
+ Bug#20896
+ * lisp/progmodes/js.el (js-chain-indent): New variable.
+ (js--skip-term-backward, js--skip-terms-backward)
+ (js--chained-expression-p): New functions.
+ (js--proper-indentation): Call js--chained-expression-p.
+ * test/manual/indent/js-chain.js: New file.
+ * test/manual/indent/js.js: Add (non-)chained indentation test.
+
+2017-01-13 Tom Tromey <tom@tromey.com>
+
+ Fix js-mode indentation bug
+
+ Bug#15582:
+ * lisp/progmodes/js.el (js--find-newline-backward): New function.
+ (js--continued-expression-p): Use it.
+ * test/manual/indent/js.js: Add new test.
+
+2017-01-13 Tom Tromey <tom@tromey.com>
+
+ Fix definition of EMACS in test/manual/indent/Makefile
+
+ * test/manual/indent/Makefile (EMACS): Add one more "..".
+
+2017-01-13 Tom Tromey <tom@tromey.com>
+
+ Add .jsx to auto-mode-alist
+
+ Bug#25389:
+ * lisp/files.el (auto-mode-alist): Add entry for .jsx.
+
+2017-01-13 Tom Tromey <tom@tromey.com>
+
+ Fix two js-mode filling bugs
+
+ Bug#19399 and Bug#22431:
+ * lisp/progmodes/js.el (js-mode): Set comment-line-break-function and
+ c-block-comment-start-regexp.
+ * test/lisp/progmodes/js-tests.el: New file.
+
+2017-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change
+
+ * test/src/thread-tests.el (threads-condvar-wait): Revert
+ previous change. Make sure no other threads from previous
+ tests are running, to avoid interfering with our thread counts.
+
+2017-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the new condvar test
+
+ * test/src/thread-tests.el (threads-condvar-wait): Enlarge the
+ time we sleep in the main thread to let the other thread
+ process notifications.
+
+2017-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Minor improvements in the new condvar test
+
+ * test/src/thread-tests.el (threads-test-condvar-wait): Use
+ with-mutex instead of emulating it inline.
+ (threads-condvar-wait): Improve comments. Check that the new
+ thread is alive before waiting for it to become blocked on the
+ conditional variable.
+
+2017-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a bug in waiting for condition variable
+
+ * src/thread.c (lisp_mutex_lock, lisp_mutex_unlock)
+ (lisp_mutex_unlock_for_wait, condition_wait_callback)
+ (condition_notify_callback): Improve commentary.
+ (condition_wait_callback): Call post_acquire_global_lock before
+ attempting to lock the mutex, to make sure the lock's owner is
+ recorded correctly.
+
+ * test/src/thread-tests.el (threads-condvar-wait): New test.
+
+2017-01-13 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of dabbrevs
+
+ * doc/emacs/abbrevs.texi (Dynamic Abbrevs): Add a cross reference
+ to "Dabbrev Customization".
+ (Dabbrev Customization): More details about the default value of
+ dabbrev-abbrev-char-regexp and use cases when it might not be good
+ enough. (Bug#25432)
+
+2017-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Fix last change of dd80ee6 (was: mm-uu.el: Don't dissect patch part)
+
+2017-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ mm-uu.el: Don't dissect patch part
+
+ This fixes a bug that the patch part is broken in the article
+ <87inpjzhpb.fsf@users.sourceforge.net> in the bug-gnu-emacs list.
+
+ * lisp/gnus/mm-uu.el (mm-uu-dissect-text-parts):
+ Don't dissect patch part.
+
+2017-01-13 Dmitry Lazurkin <dilaz03@gmail.com>
+
+ Fix extracting async def type and name in python mode imenu
+
+ * lisp/progmodes/python.el (python-imenu--get-defun-type-name):
+ New function.
+ (python-imenu--build-tree): Use python-imenu--get-defun-type-name for
+ extract async or simple def type and name at current
+ position (Bug#24820).
+ * test/lisp/progmodes/python-tests.el (python-imenu-create-index-1):
+ (python-imenu-create-flat-index-1): Add async def's.
+
+2017-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ Remove garbage from Content-Transfer-Encoding value (bug#25420)
+
+ * lisp/mail/ietf-drums.el (ietf-drums-strip-cte): New function.
+ (ietf-drums-remove-garbage): New function.
+ (ietf-drums-remove-whitespace): Remove CR as well.
+
+ * lisp/mail/mail-parse.el (mail-header-strip-cte):
+ Alias to ietf-drums-strip-cte.
+
+ * lisp/gnus/gnus-art.el (article-decode-charset):
+ * lisp/gnus/gnus-sum.el (gnus-summary-enter-digest-group):
+ * lisp/gnus/mm-decode.el (mm-dissect-buffer):
+ * lisp/gnus/nndoc.el (nndoc-decode-content-transfer-encoding)
+ (nndoc-rfc822-forward-generate-article):
+ * lisp/mh-e/mh-mime.el (mh-decode-message-body):
+ Replace mail-header-strip with mail-header-strip-cte.
+
+2017-01-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ Restore behavior of ‘./autogen.sh autoconf git’
+
+ * autogen.sh: Do both autoconf and git setup when invoked
+ as ‘./autogen.sh autoconf git’. Avoid unnecessary newline in chatter.
+ Mention new --no-check option in usage message. (Bug#25359)
+
+2017-01-12 Glenn Morris <rgm@gnu.org>
+
+ * autogen.sh: Simplify argument parsing.
+
+2017-01-12 Noam Postavsky <npostavs@gmail.com>
+
+ Clarify that easy-menu-add is a nop (Bug#25382)
+
+ * lisp/emacs-lisp/easymenu.el (easy-menu-add): Make it into an alias of
+ `ignore', like `easy-menu-remove'.
+
+2017-01-12 Glenn Morris <rgm@gnu.org>
+
+ * lisp/textmodes/rst.el (rst-package-emacs-version-alist): Fix entry.
+
+2017-01-11 Glenn Morris <rgm@gnu.org>
+
+ * autogen.sh: Add --no-check option. (Bug#25359)
+
+2017-01-11 Glenn Morris <rgm@gnu.org>
+
+ Convert some network test failures to skipping
+
+ These tests intermittently fail on hydra.nixos.org for unclear
+ reasons related to starting the external process.
+ This isn't an Emacs issue, and the failures cause noise on
+ the emacs-buildstatus list. (Bug#24503)
+ * test/lisp/net/network-stream-tests.el (echo-server-nowait)
+ (connect-to-tls-ipv4-nowait): Skip rather than fail if the
+ external process fails to start properly.
+
+2017-01-11 Eli Zaretskii <eliz@gnu.org>
+
+ Revert "Add DNS keywords and remove duplications"
+
+ This reverts commit 1cb9aa5b14867983d0013a61709b4d0af18364ff.
+
+2017-01-11 Alexander Kuleshov <kuleshovmail@gmail.com>
+
+ Add DNS keywords and remove duplications
+
+ * lisp/textmodes/dns-mode.el (dns-mode-types): Add two TLSA and
+ NSEC" DNS related keywords and remove duplication of "NSAP".
+
+2017-01-11 Alexander Kuleshov <kuleshovmail@gmail.com>
+
+ Add DNS keywords and remove duplications
+
+ * lisp/textmodes/dns-mode.el (dns-mode-types): Add two TLSA and
+ NSEC" DNS related keywords and remove duplication of "NSAP".
+
+2017-01-11 Alan Mackenzie <acm@muc.de>
+
+ Handle syntactic WS cache properties more accurately at buffer changes.
+
+ This fixes bug #25362.
+
+ * lisp/progmodes/cc-engine.el (c-sws-lit-type, c-sws-lit-limits)
+ (c-invalidate-sws-region-before, c-invalidate-sws-region-after-del)
+ (c-invalidate-sws-region-after-ins): New variables and functions.
+ (c-invalidate-sws-region-after): Change from a defsubst to a defun.
+ Also pass
+ it the standard OLD-LEN argument. Call both
+ c-invalidate-sws-region-after-{ins,del} to check for "dangerous" WS
+ cache
+ properties.
+
+ * lisp/progmodes/cc-langs.el (c-block-comment-ender-regexp): New language
+ variable.
+
+ * lisp/progmodes/cc-mode.el (c-before-change): Call
+ c-invalidate-sws-region-before.
+ (c-after-change): Pass old-len to c-invalidate-sws-region-after.
+
+2017-01-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Support stat 8.26 in Tramp
+
+ * lisp/net/tramp-sh.el (tramp-get-remote-stat): Use QUOTING_STYLE
+ environment variable of newer coreutils. (Bug#23422)
+
+2017-01-10 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of coding-systems
+
+ * doc/lispref/nonascii.texi (Coding System Basics): Mention
+ 'prefer-utf-8'. Index it and 'undecided'.
+ (Encoding and I/O): Fix a typo.
+ (User-Chosen Coding Systems): Improve the documentation of
+ ACCEPT-DEFAULT-P argument to select-safe-coding-system. Document
+ select-safe-coding-system-function.
+ (Specifying Coding Systems): Document coding-system-require-warning.
+
+2017-01-10 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2017-01-09 maint: time stamp -> timestamp
+ 2017-01-07 stdioext: Port to Minix 3.2 and newer
+ 2017-01-06 glob, intprops, xalloc: work around Clang bug
+ 2017-01-02 revert copyright-year change to synced files
+ * doc/misc/texinfo.tex, lib/fpending.c, lib/intprops.h, lib/mktime.c:
+ * lib/stat-time.h, lib/stdio-impl.h, lib/time.in.h, lib/timespec.h:
+ * lib/utimens.c, lib/xalloc-oversized.h:
+ Copy from gnulib.
+
+2017-01-10 Eli Zaretskii <eliz@gnu.org>
+
+ Don't use unsafe encoding for the bookmark file
+
+ * lisp/bookmark.el (bookmark-write-file): Handle the case when the
+ explicitly specified encoding of the bookmark file cannot encode the
+ additional bookmarks just added. (Bug#25365)
+
+2017-01-09 Eli Zaretskii <eliz@gnu.org>
+
+ Improve definition of 'variable-pitch' face on MS-Windows
+
+ * lisp/faces.el (variable-pitch): Don't specify too many
+ attributes of the font, otherwise faces that request different
+ weight or slant or size will not get them.
+
+2017-01-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix an error message in python.el
+
+ * lisp/progmodes/python.el (python-shell-get-process-or-error):
+ Don't repeat the same key binding twice. (Bug#25405)
+
+2017-01-09 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Remove unused ldefs-boot.el
+
+ * lisp/ldefs-boot.el: Remove
+
+ This file was not removed as reported in c27b645956a11, but accidentally
+ left.
+
+2017-01-09 Noam Postavsky <npostavs@gmail.com>
+ Eli Zaretskii <eliz@gnu.org>
+
+ Use expanded stack during regex matches
+
+ While the stack is increased in main(), to allow the regex stack
+ allocation to use alloca we also need to modify regex.c to actually take
+ advantage of the increased stack, and not limit stack allocations to
+ SAFE_ALLOCA bytes.
+
+ * src/regex.c (MATCH_MAY_ALLOCATE): Remove obsolete comment about
+ allocations in signal handlers which no longer happens and correct
+ description about when and why MATCH_MAY_ALLOCATE should be defined.
+ (emacs_re_safe_alloca): New variable.
+ (REGEX_USE_SAFE_ALLOCA): Use it as the limit of stack allocation instead
+ of MAX_ALLOCA.
+ (emacs_re_max_failures): Rename from `re_max_failures' to avoid
+ confusion with glibc's `re_max_failures'.
+ * src/emacs.c (main): Increase the amount of fixed 'extra' bytes we add
+ to the stack. Instead of changing emacs_re_max_failures based on the
+ new stack size, just change emacs_re_safe_alloca; emacs_re_max_failures
+ remains constant regardless, since if we run out stack space SAFE_ALLOCA
+ will fall back to heap allocation.
+
+2017-01-09 Noam Postavsky <npostavs@gmail.com>
+
+ Fix computation of regex stack limit
+
+ The regex stack limit was being computed as the number of stack entries,
+ whereas it was being compared with the current size as measured in
+ bytes. This could cause indefinite looping when nearing the stack limit
+ if re_max_failures happened not to be a multiple of sizeof
+ fail_stack_elt_t (Bug #24751).
+
+ * src/regex.c (GROW_FAIL_STACK): Compute both current stack size and
+ limit as numbers of stack entries.
+
+2017-01-08 Alan Third <alan@idiocy.org>
+
+ Remove apploopnr
+
+ * src/nsterm.m (ns_select, ns_read_socket): Remove apploopnr and only
+ allow app loop to run in main thread.
+
+2017-01-08 Glenn Morris <rgm@gnu.org>
+
+ Remove unused configure output variable
+
+ * configure.ac (GNULIB_MK):
+ * Makefile.in (gnulib_mk): Remove, no longer used.
+
+2017-01-08 Glenn Morris <rgm@gnu.org>
+
+ Fix automake dependencies
+
+ * Makefile.in (AUTOMAKE_INPUTS): Add nt/gnulib.mk. (Bug#25372)
+ All platforms need this file to exist.
+
+2017-01-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove unnecessary blankp code
+
+ * src/character.c (blankp): Remove redundant code that slows Emacs
+ down a bit. The caller already does the test.
+
+2017-01-08 Stefan Merten <stefan@merten-home.de>
+
+ * lisp/textmodes/rst.el: Fix rst-forward-indented-block.
+
+ * lisp/textmodes/rst.el (rst-cvs-header, rst-svn-rev)
+ (rst-svn-timestamp)
+ (rst-official-version, rst-official-cvs-rev)
+ (rst-package-emacs-version-alist): Maintain version numbers.
+ (rst-forward-indented-block): Fix. Start searching at next
+ line again. Fixes fontification of comments continuing on the
+ same line they started.
+
+2017-01-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove @SET_MAKE@ from manually-maintained files
+
+ Emacs now assumes GNU Make, so @SET_MAKE@ is no longer needed.
+ * Makefile.in, lwlib/Makefile.in, nextstep/Makefile.in:
+ * src/Makefile.in: Remove @SET_MAKE@.
+
+2017-01-07 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix a problem with `start-file-process' in Tramp
+
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection):
+ `start-file-process' shall work when `non-essential' is
+ non-nil, but there is already an established connection.
+ <https://github.com/company-mode/company-mode/issues/462>
+
+2017-01-07 Rolf Ade <rolf@pointsman.de> (tiny change)
+
+ Fix selecting SQLite database files with sql-mode (Bug#23566)
+
+ * lisp/progmodes/sql.el (sql-sqlite-login-params): Allow any name as
+ SQLite database file name, by default.
+ (sql-get-login-ext): Fixed read-file-name arguments to provide
+ path completion even if a database name pattern is customized and to
+ allow creation of new SQLite database files.
+
+2017-01-07 Noam Postavsky <npostavs@gmail.com>
+
+ Clarify major mode switching
+
+ * doc/emacs/modes.texi (Major Modes):
+ * doc/lispref/modes.texi (Modes, Major Modes): Explictly say that each
+ buffer has exactly one major mode and can't be "turned off", only
+ switched away from (Bug#25357).
+
+2017-01-07 Noam Postavsky <npostavs@gmail.com>
+
+ Add helpful comment to compile-command's docstring
+
+ * lisp/progmodes/compile.el (compile-command): Mention trailing space in
+ docstring (Bug#25337).
+
+2017-01-07 Eli Zaretskii <eliz@gnu.org>
+
+ Specify encoding of the bookmark file
+
+ * lisp/bookmark.el (bookmark-insert-file-format-version-stamp):
+ Accept an argument CODING and include a 'coding:' cookie in the
+ bookmark file preamble.
+ (bookmark-upgrade-file-format-from-0): Call
+ 'bookmark-insert-file-format-version-stamp' with the file buffer's
+ encoding, as detected when it was read.
+ (bookmark-file-coding-system): New variable.
+ (bookmark-load): Set bookmark-file-coding-system to the encoding
+ of the loaded file.
+ (bookmark-write-file): Bind coding-system-for-write to either the
+ user setting via "C-x RET c" or to the existing file encoding,
+ defaulting to 'utf-8-emacs'. Update the value of
+ bookmark-file-coding-system. (Bug#25365)
+
+2017-01-07 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid infloop in 'ispell-region'
+
+ * lisp/textmodes/ispell.el (ispell-begin-skip-region-regexp):
+ Protect against 'ispell-skip-region-alist' being nil. Reported by
+ Ernest Adrogué <nfdisco@gmail.com>, see
+ https://lists.gnu.org/r/help-gnu-emacs/2017-01/msg00007.html.
+
+2017-01-06 Philipp Stephani <phst@google.com>
+
+ Add support for Unicode whitespace in [:blank:]
+
+ See Bug#25366.
+
+ * src/character.c (blankp): New function for checking Unicode
+ horizontal whitespace.
+ * src/regex.c (ISBLANK): Use 'blankp' for non-ASCII horizontal
+ whitespace.
+ (BIT_BLANK): New bit for range table.
+ (re_wctype_to_bit, execute_charset): Use it.
+ * test/lisp/subr-tests.el (subr-tests--string-match-p--blank): Add
+ unit test for [:blank:] character class.
+ * test/src/regex-tests.el (test): Adapt unit test.
+ * doc/lispref/searching.texi (Char Classes): Document new Unicode
+ behavior for [:blank:].
+
+2017-01-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix ':version' of 'select-enable-primary'
+
+ * lisp/select.el (select-enable-primary): Fix a typo in
+ ':version'. (Bug#25375)
+
+2017-01-06 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ (feedmail-deduce-address-list): Avoid add-to-list on local variables.
+
+ Author:
+
+ * lisp/mail/feedmail.el (feedmail-deduce-address-list):
+ Avoid add-to-list on local variables.
+
+2017-01-06 Noam Postavsky <npostavs@gmail.com>
+
+ Fix isearch handling of C-u C-u...
+
+ * lisp/isearch.el: Add `isearch-scroll' property to
+ universal-argument-more so that `isearch-allow-scroll' will apply to it
+ as well.
+ (isearch-pre-command-hook): Let `isearch-allow-prefix' apply to
+ `universal-argument-more' as well (Bug#25302).
+
+2017-01-05 Paul Eggert <eggert@cs.ucla.edu>
+
+ Shorten autogen.sh script
+
+ * autogen.sh: Use a shorter script, as some 'sed' implementations
+ mishandle long scripts.
+
+2017-01-05 Eli Zaretskii <eliz@gnu.org>
+
+ Yet another fix for autogen.sh
+
+ * autogen.sh (gnulib.mk): Make the Sed script more portable.
+
+ * nt/Makefile.in (${srcdir}/gnulib.mk): Adapt the Sed command to
+ the changes in autogen.sh.
+
+2017-01-05 Eli Zaretskii <eliz@gnu.org>
+
+ * autogen.sh (gnulib.mk): Another attempt to fix macOS build.
+
+2017-01-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix dependencies of nt/gnulib.mk
+
+ * Makefile.in ($(srcdir)/nt/gnulib.mk): Avoid circular dependency
+ of nt/gnulib.mk on lib/Makefile.in.
+
+2017-01-05 Eli Zaretskii <eliz@gnu.org>
+
+ Unbreak macOS build
+
+ * autogen.sh (gnulib.mk): Don't use non-portable extensions of GNU
+ Sed.
+
+2017-01-05 Johan Claesson <johanclaesson@bredband.net> (tiny change)
+
+ Fix term.el handling of ^Z-sequences spanning chunks
+
+ Bash will after each command send ?\032 and the current directory "/tmp"
+ to inform term.el. Bash output is buffered in 4096 bytes chunks. If a
+ command outputs roughly 4096 bytes then the end of the first chunk will
+ be "/tm" (Bug#13350).
+
+ * lisp/term.el (term-emulate-terminal): Change the regexp to find the
+ end of the ?\032 sequence to use \n instead of $, the latter can match
+ end of string as well.
+
+2017-01-05 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn on lexical-binding in mb-depth.el
+
+ * lisp/mb-depth.el: Turn on lexical-binding.
+ (minibuffer-depth-setup): Bind things used multiple times.
+
+2017-01-04 Alan Third <alan@idiocy.org>
+
+ Revert "Rework NS event handling (bug#25265)"
+
+ This reverts commit e0e5b0f4a4ce1d19ee0240c514dedd873d4165dc.
+
+2017-01-04 Glenn Morris <rgm@gnu.org>
+
+ Update remaining copyright years with admin.el M-x set-copyright
+
+ * etc/refcards/ru-refcard.tex (cyear): Set to 2017.
+
+2017-01-04 Glenn Morris <rgm@gnu.org>
+
+ * lisp/ffap.el (ffap-lax-url): Bump :version after recent change.
+
+2017-01-04 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port recent autogen.sh changes to Darwin
+
+ Problem reported by Sam Steingold (Bug#25347).
+ * autogen.sh: Don't assume 'sed -f-' reads a script from stdin, as
+ POSIX does not require it and it does not work on Darwin.
+
+2017-01-04 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ Avoid add-to-list on local variables
+
+ * lisp/gnus/nnir.el: Use lexical-binding and cl-lib.
+ (nnir-retrieve-headers): Use pcase.
+ (nnir-search-thread): Avoid add-to-list on local variables.
+
+ * lisp/gnus/smime.el: Use lexical-binding and cl-lib.
+ (smime-verify-region): Avoid add-to-list on local variables.
+
+ * lisp/mail/undigest.el: Use lexical-binding and cl-lib.
+ (rmail-digest-parse-mime, rmail-digest-rfc1153)
+ (rmail-digest-parse-rfc934): Avoid add-to-list on local variable.
+
+ * lisp/net/ldap.el (ldap-search): Move init into declaration.
+
+ * lisp/net/newst-backend.el (newsticker--cache-add):
+ Avoid add-to-list on local variables; Simplify code with `assq'.
+
+ * lisp/net/zeroconf.el: Use lexical-binding and cl-lib.
+ (dbus-debug): Remove declaration, unused.
+ (zeroconf-service-add-hook, zeroconf-service-remove-hook)
+ (zeroconf-service-browser-handler, zeroconf-publish-service):
+ Avoid add-to-list and *-hook on local variables.
+
+ * lisp/org/org-archive.el (org-all-archive-files):
+ * lisp/org/org-agenda.el (org-agenda-get-restriction-and-command):
+ Avoid add-to-list on local variables.
+
+ * lisp/org/ox-publish.el (org-publish--run-functions): New function.
+ (org-publish-projects): Use it to avoid run-hooks on a local variable.
+ (org-publish-cache-file-needs-publishing): Avoid add-to-list on
+ local variables.
+
+ * lisp/progmodes/ada-prj.el: Use setq instead of (set '...).
+ (ada-prj-load-from-file): Avoid add-to-list on local variables.
+
+ * lisp/progmodes/ada-xref.el (ada-initialize-runtime-library): Simplify.
+ (ada-gnat-parse-gpr, ada-parse-prj-file-1)
+ (ada-xref-find-in-modified-ali): Avoid add-to-list on local variables.
+
+ * lisp/progmodes/idlw-shell.el (idlwave-shell-update-bp-overlays):
+ Avoid add-to-list on local variables.
+
+2017-01-04 Mark Oteiza <mvoteiza@udel.edu>
+
+ Turn on lexical-binding in md4.el
+
+ * lisp/md4.el: Turn on lexical-binding.
+ * test/lisp/md4-tests.el: New file.
+
+2017-01-03 Stefan Merten <stefan@merten-home.de>
+
+ Lots of refactorings and a few minor improvements.
+
+ User visible improvements and changes:
+ * Improve and debug `rst-forward-section` and `rst-backward-section`.
+ * Auto-enumeration may be used with all styles for list insertion.
+ * Improve and debug `rst-toc-insert`.
+ * Adapt change in Emacs to use customization group `text` instead of `wp`.
+ * Bind `n` and `p` in `rst-toc-mode`.
+ * `z` in `toc-mode` returns to the previous window configuration.
+ * Require Emacs version >= 24.1.
+
+ Lots of refactorings including:
+ * Silence byte compiler.
+ * Use lexical binding.
+ * Use `cl-lib`.
+ * Add tests and raise test coverage.
+
+2017-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ (cl-defstruct): Improve error message for slots w/o value (bug#25312)
+
+ * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Don't signal an error but
+ emit a warning for those coders who forgot to put a default value in
+ their slot.
+
+2017-01-03 Philipp Stephani <p.stephani2@gmail.com>
+
+ Small patch for ffap.el
+
+ * lisp/ffap.el (ffap-alist): Document that ffap sets the match data
+ while walking 'ffap-alist'.
+
+2017-01-03 Eli Zaretskii <eliz@gnu.org>
+
+ Generate nt/gnulib.mk from lib/gnulib.mk
+
+ This was proposed by Paul Eggert <eggert@cs.ucla.edu>,
+ with the purpose of avoiding manual maintenance of
+ nt/gnulib.mk.
+
+ * nt/gnulib-modules-to-delete.cfg: New file.
+ * nt/Makefile.in (AM_V_GEN, am__v_GEN_, am__v_GEN_0)
+ (am__v_GEN_1): New variables.
+ (${srcdir}/gnulib.mk): Rules to generate gnulib.mk from
+ lib/gnulib.mk and list of modules in gnulib-modules-to-delete.cfg.
+
+ * make-dist (nt): Add gnulib-modules-to-delete.cfg to the list of
+ files to link.
+ * configure.ac (GNULIB_MK): Compute the value according to $opsys.
+ * autogen.sh: Create nt/gnulib.mk if it doesn't exist, before
+ running autoreconf.
+ * Makefile.in (gnulib_mk): New variable.
+ ($(srcdir)/nt/gnulib.mk): Rule to produce it.
+ (AUTOMAKE_INPUTS): Use $(gnulib_mk) instead of a literal file
+ name.
+ * .gitignore: Add nt/gnulib.mk.
+
+ * src/w32.c (acl_errno_valid): Implement it here, as we no longer
+ build the acl-permissions module from Gnulib.
+
+2017-01-03 Noam Postavsky <npostavs@gmail.com>
+
+ Handle multibyte chars spanning chunks in term.el
+
+ * lisp/term.el (term-terminal-undecoded-bytes): New variable.
+ (term-mode): Make it buffer local. Don't make `term-terminal-parameter'
+ buffer-local twice.
+ (term-emulate-terminal): Check for bytes of incompletely decoded
+ characters, and save them until the next call when they can be fully
+ decoded (Bug#25288).
+
+2017-01-03 Michael Albinus <michael.albinus@gmx.de>
+
+ Finish work on filenotify-tests.el
+
+ * test/lisp/filenotify-tests.el (file-notify--test-monitors):
+ New variable.
+ (file-notify--test-cleanup, file-notify--test-monitor): Use it.
+ (file-notify--test-read-event, file-notify-test02-events)
+ (file-notify-test04-file-validity): Handle "gvfs-monitor-dir.exe".
+ (file-notify-test03-autorevert)
+ (file-notify-test08-watched-file-in-watched-dir):
+ Set `file-notify--test-desc' for proper work of
+ `file-notify--test-monitor'. (Bug#21804)
+
+2017-01-02 Michael Albinus <michael.albinus@gmx.de>
+
+ Check also for "gvfs-monitor-dir.exe" in Tramp
+
+ * lisp/net/tramp-sh.el (tramp-get-remote-gvfs-monitor-dir): Check also
+ for "gvfs-monitor-dir.exe".
+
+2017-01-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation --without-x
+
+ * src/composite.c (autocmp_chars) [HAVE_WINDOW_SYSTEM]: Call
+ font_range only if it is compiled in. (Bug#25334)
+
+2017-01-02 Sašo Živanović <saso.zivanovic@guest.arnes.si>
+
+ Fix RefTeX to show table of contents for dtx files (tiny change)
+
+ * lisp/textmodes/reftex.el (reftex-compile-variables): Change the
+ section regexp so that it accepts lines starting with the comment
+ character. (tiny change)
+ * lisp/textmodes/reftex-parse.el (reftex-parse-from-file): Filter
+ gathered toc entries, accepting a commented entry if and only if the
+ source file is a ".dtx" file. (tiny change)
+
+2017-01-02 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove mistakenly-added files
+
+ Problem reported by Glenn Morris in:
+ https://lists.gnu.org/r/emacs-devel/2017-01/msg00008.html
+ * lisp/gnus/gnus-ems.el, lisp/gnus/gnus-sync.el:
+ * lisp/gnus/messcompat.el, lisp/nxml/nxml-glyph.el:
+ * lisp/nxml/nxml-uchnm.el, lisp/obsolete/awk-mode.el:
+ * lisp/obsolete/iso-acc.el, lisp/obsolete/iso-insert.el:
+ * lisp/obsolete/iso-swed.el, lisp/obsolete/resume.el:
+ * lisp/obsolete/scribe.el, lisp/obsolete/spell.el:
+ * lisp/obsolete/swedish.el, lisp/obsolete/sym-comp.el:
+ Remove files that were added by mistake during a merge.
+
+2017-01-01 Noam Postavsky <npostavs@gmail.com>
+
+ Warn about incomplete untarring of link files
+
+ The current tar-mode doesn't really support unpacking symlinks, it
+ simply creates an empty file of the same name.
+
+ * lisp/tar-mode.el (tar--describe-as-link): New function extracted from
+ `tar--check-descriptor'.
+ (tar-untar-buffer): Use it to warn about imperfectly untarred link
+ files.
+
+2017-01-01 Noam Postavsky <npostavs@gmail.com>
+
+ Remove sh-mode's skeleton-end-hook
+
+ * lisp/progmodes/sh-script.el (sh-mode): Remove local setting of
+ `skeleton-end-hook', `skeleton-insert' already does `newline-and-indent'
+ and also respects `skeleton-end-newline' (Bug#16634).
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ * nt/gnulib.mk (stdint.h): Update to match lib/gnulib.mk here.
+
+2017-01-01 Mark Oteiza <mvoteiza@udel.edu>
+
+ Add term/tmux.el
+
+ Since tmux version 2.1, new tmux terminfos are shipped due to oddities
+ with xterm and screen terminfos. This is simply a duplication of
+ term/screen.el with screen -> tmux.
+ * lisp/term/tmux.el: New file.
+
+2017-01-01 Philipp Stephani <phst@google.com>
+
+ Fix encoding of JSON surrogate pairs
+
+ JSON requires that such pairs be treated as UTF-16 surrogate pairs, not
+ individual code points; cf. Bug #24784.
+
+ * lisp/json.el (json-read-escaped-char): Fix decoding of surrogate
+ pairs.
+ (json--decode-utf-16-surrogates): New defun.
+
+ * test/lisp/json-tests.el (test-json-read-string): Add test for
+ surrogate pairs.
+
+2017-01-01 Michael Albinus <michael.albinus@gmx.de>
+
+ Remove tramp-gw.el, which was synced from emacs-25 by accident
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Do not use Gnulib’s m4/wint_t.m4.
+
+ * admin/merge-gnulib: Remove m4/wint_t.m4 when merging.
+ Fix typo so that warn-on-use.m4 is removed too.
+ * configure.ac (gt_TYPE_WINT_T): New macro, replacing Gnulib’s.
+ * m4/wint_t.m4: Remove.
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib, continued
+
+ * m4/wint_t.m4: New file, copied from gnulib.
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update copyright year to 2017 in master
+
+ Run admin/update-copyright in the master branch. This fixes files
+ that were not already fixed in the emacs-25 branch before it was
+ merged here.
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove test/automated detritus from merge
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2016-12-19 stdint: Fix WINT_MAX to match wint_t on mingw
+ 2016-12-18 getopt: Fix link error for users of getopt() in <unistd.h>
+ 2016-12-17 getlogin: Port to newer mingw
+ 2016-12-17 stdint: Fix WINT_MAX to match wint_t on MSVC
+ 2016-12-17 Avoid redefinition errors on MSVC
+ * lib/getopt.in.h, lib/stdint.in.h, lib/stdio.in.h, lib/unistd.in.h:
+ * m4/stdint.m4, m4/unistd_h.m4:
+ Copy from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+ Plus, this commit updates the indenting on copyright notices to
+ match that of gnulib.
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 2e2a806 Fix copyright years by hand
+ 5badc81 Update copyright year to 2017
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 665be69 ; Update ChangeLog.2 and AUTHORS files
+
+ # Conflicts:
+ # etc/AUTHORS
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 697167b ; Improve wording of previous change in variables.texi
+ d7973e8 Document 'default-toplevel-value' and 'set-default-toplevel-v...
+ 8b71826 Don't modify minibuffer variables globally
+ 5b5e036 Revert to pre-25.1 behavior in ffap
+ 19994a1 * lisp/ffap.el: Fix obsolete comment referencing ffap-bug.
+ 3ace730 Attempt to fix 64-bit AIX build
+ f69bd79 Clarify usage of 'ediff-cleanup-hook' (Bug#24675)
+ c04ac8a Document that variable binding order is unspecified
+ 272554a * lisp/desktop.el (desktop-buffers-not-to-save): Doc fix.
+ 08de101 Fix M-x hints on Mac port
+ 86a297a Work around reporting a dpi change in apply_xft_settings
+ cf1f985 ; lisp/skeleton.el (skeleton-insert): Fix typo in last change
+ 9e1209d Amend the version number of CC Mode 5.33 -> 5.32.99. Don't m...
+ 88cdf14 Improve skeleton docstrings
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 4179238 Improve documentation of 'w32-scroll-lock-modifier'
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from origin/emacs-25
+
+ 9adb101 Document 'describe-fontset'
+ 229315c ; Add missing symbol quoting.
+ 3d94931 Repair desktop restoration on text terminals
+ 43022f9 Ignore forward-sexp-function in js-mode indentation code
+ b19fb49 Improve documentation of 'define-coding-system'
+ 467768f Fix Bug#25162
+ 6db78ae Fix a typo in define-abbrev-table
+ 5f7d906 Bump makeinfo requirement from 4.7 to 4.13
+ 442e2f6 Fixes related to select-enable-clipboard
+ e4ac450 Define struct predicate before acccesors
+ 08decbd Doc fix for vc-git
+ 5531e75 Further improve make-dist checking
+ 953bf67 Improve previous make-dist change
+ 129645a Make make-dist --snapshot do some sanity checks
+
+ # Conflicts:
+ # lisp/menu-bar.el
+
+2017-01-01 Alan Mackenzie <acm@muc.de>
+
+ Give eval-and-compile a correct edebug spec. Fixes bug #16184 properly.
+
+ * lisp/emacs-lisp/edebug.el (edebug_offset_indices): Revert abortive commit
+ from Thu Dec 29 09:22:36 2016 +0000 which didn't really fix the bug.
+
+ * lisp/emacs-lisp/byte-run.el (eval-and-compile): Change the edebug spec from
+ t to (&rest def-form).
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix copyright years by hand
+
+ These are dates that admin/update-copyright did not update, or
+ updated incorrectly.
+
+2017-01-01 Paul Eggert <eggert@cs.ucla.edu>
+
+ Update copyright year to 2017
+
+ Run admin/update-copyright.
+
+2016-12-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ Clarify internal_catch etc.
+
+ The recent change to internal_catch and friends relied on some
+ confusion I introduced to the code in 2013. Attempt to fix
+ the confusion by clarifying the code instead. This saves an
+ instruction and a load dependency in the typical case.
+ * src/eval.c (internal_catch, internal_condition_case)
+ (internal_condition_case_1, internal_condition_case_2)
+ (internal_condition_case_n): Undo the previous change. Instead,
+ use use ‘c’ rather than ‘handlerlist’ in the typical case.
+ Also, use ‘eassert’ rather than ‘clobbered_eassert’ when possible.
+
+2016-12-31 Ken Brown <kbrown@cornell.edu>
+
+ Further improve filenotify-tests.el
+
+ * test/lisp/filenotify-tests.el
+ (file-notify--test-read-event): Adapt to file monitors of type
+ GFamFileMonitor, which occur on Cygwin.
+ (file-notify--test-monitor): Update doc string.
+
+2016-12-31 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/xdisp.c (string_from_display_spec): Simplify.
+
+2016-12-31 Alan Third <alan@idiocy.org>
+
+ Rework NS event handling (bug#25265)
+
+ * src/nsterm.m (unwind_apploopnr): Remove.
+ (ns_read_socket): Remove references to apploopnr. Make processing the
+ NS event loop conditional on being in the main thread.
+ (ns_select): Remove references to apploopnr. Remove all fd_handler
+ related stuff. Check if there are events waiting on the NS event
+ queue rather than running the event loop. Remove unused variables and
+ code.
+ (fd_handler): Remove.
+ (ns_term_init): Remove creation of fd_handler thread.
+ (hold_event, EmacsApp:sendEvent, EmacsView:mouseMoved,
+ EmacsView:windowDidExpose): Remove send_appdefined.
+ (ns_send_appdefined): Always check the event queue for
+ applicationDefined events rather than relying on send_appdefined var.
+ * src/nsterm.h: Remove reference to fd_handler method.
+
+2016-12-31 Philipp Stephani <phst@google.com>
+
+ Checkdoc: use syntax functions instead of regex
+
+ In checkdoc.el, get rid of the error-prone regex to find definition
+ forms, and use existing syntax-based navigation functions instead.
+ This fixes a corner case with one-argument `defvar' forms.
+
+ * lisp/emacs-lisp/checkdoc.el (checkdoc--next-docstring): New function.
+ (checkdoc-next-docstring, checkdoc-defun): Use it.
+ * test/lisp/emacs-lisp/checkdoc-tests.el (checkdoc-tests--next-docstring):
+ Add unit test.
+
+2016-12-31 Eli Zaretskii <eliz@gnu.org>
+
+ Don't define NOMINMAX on MS-Windows
+
+ * src/callproc.c (NOMINMAX) [WINDOWSNT]: Don't define. This is no
+ longer needed with the current sources and MinGW headers, while
+ defining NOMINMAX causes an annoying compiler warning.
+
+2016-12-31 Chris Gregory <czipperz@gmail.com> (tiny change)
+
+ Simplify code in eval.c that calls 'setjmp'
+
+ * src/eval.c (internal_catch, internal_condition_case)
+ (internal_condition_case_1, internal_condition_case_2)
+ (internal_condition_case_n): Factor out the common tail of the
+ functions.
+
+2016-12-31 Chris Gregory <czipperz@gmail.com> (tiny change)
+
+ Simplify code in 'string_from_display_spec'
+
+ * src/xdisp.c (string_from_display_spec): Eliminate a redundant
+ test before the loop.
+
+2016-12-31 Eli Zaretskii <eliz@gnu.org>
+
+ Serialize random number generation on MS-Windows
+
+ * src/w32.c (rand_as183): New function.
+ (random): Use it instead of MS runtime's 'rand'. This avoids
+ producing separate and identical random series in each Lisp
+ thread.
+ (srandom): Modify to supply 3 seed values to 'rand_as183'.
+
+2016-12-31 Michael Albinus <michael.albinus@gmx.de>
+
+ * src/gfilenotify.c (Fgfile_monitor_name): Return interned symbol.
+
+2016-12-30 Ken Raeburn <raeburn@raeburn.org>
+
+ Don't call xg_select for a NextStep build.
+
+ NextStep builds use glib but don't use xg_select.
+
+ * src/process.c (wait_reading_process_output): Don't call xg_select
+ for a NextStep build.
+
+2016-12-30 Ken Raeburn <raeburn@raeburn.org>
+
+ Increase the obarray size.
+
+ In a typical GNU/Linux/X11 build, we wind up with over 15k symbols by
+ the time we've started. The old obarray size ensured an average chain
+ length of 10 or more.
+
+ * src/lread.c (OBARRAY_SIZE): Increase to 15121.
+
+2016-12-30 Ken Raeburn <raeburn@raeburn.org>
+
+ Initialize thread support for Xlib.
+
+ * src/xterm.c (x_initialize) [THREADS_ENABLED]: Call XInitThreads
+ before doing anything else with X.
+
+2016-12-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename primary_thread to main_thread
+
+ This avoids the confusion of using two different phrases "main thread"
+ and "primary thread" internally to mean the same thing. See:
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg01142.html
+ * src/thread.c (main_thread): Rename from primary_thread,
+ since the new name no longer clashes with main_thread_id
+ and Emacs internals normally call this the "main thread".
+ (init_main_thread): Rename from init_primary_thread.
+ (main_thread_p): Rename from primary_thread_p.
+ All uses changed.
+
+2016-12-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ Rename main_thread to main_thread_id and simplify
+
+ * src/emacs-module.c: Include syssignal.h, for main_thread_id.
+ [HAVE_PTHREAD]: Do not include pthread.h.
+ (main_thread): Remove. All uses replaced by main_thread_id,
+ or by dwMainThreadId on NT. Since the HAVE_PTHREAD code is now using
+ the main_thread_id established by sysdep.c, there is no need for a
+ separate copy of the main thread ID here.
+ (module_init): Remove. All uses removed.
+ * src/sysdep.c (main_thread_id) [HAVE_PTHREAD]:
+ Rename from main_thread. All uses changed. Now extern.
+
+2016-12-30 Michael Albinus <michael.albinus@gmx.de>
+
+ * src/gfilenotify.c (Fgfile_monitor_name): Return a symbol.
+
+2016-12-30 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/sysdep.c (deliver_process_signal): Improve comment.
+
+2016-12-30 Alan Mackenzie <acm@muc.de>
+
+ CC Mode: Fix the fontification of a spuriously recognized enum member.
+
+ The "enum" was in an argument list, but triggered the fontification of a
+ following identifier in the function block as though it were in an enum
+ declaration.
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-enum-body): New function.
+ (c-basic-matchers-after): Replace the inline stanza for enum elements with a
+ call to c-font-lock-enum-body.
+
+ * lisp/progmodes/cc-langs.el (c-enum-clause-introduction-re): New language
+ variable.
+
+2016-12-30 Nicolas Petton <nicolas@petton.fr>
+
+ Bump Emacs version to 25.1.91
+
+ * README:
+ * configure.ac:
+ * msdos/sed2v2.inp:
+ * nt/README.W32: Bump Emacs version.
+ * lisp/ldefs-boot.el: Update.
+
+2016-12-30 Eli Zaretskii <eliz@gnu.org>
+
+ Attempt to fix crashes with threads in GTK builds
+
+ * src/xgselect.c (xg_select): Call pselect via thread_select, not
+ directly, to avoid running Lisp (via unblock_input) when more than
+ one thread could be running. (Bug#25247)
+ * src/process.c (wait_reading_process_output) [HAVE_GLIB]: Call
+ xg_select directly instead of through thread_select.
+ * src/xgselect.h (xg_select): Last 2 arguments are no longer
+ 'const', for consistency with thread_select.
+
+2016-12-30 Arash Esbati <arash.esbati@gmail.com>
+
+ Add entry for biblatex
+
+ * lisp/textmodes/reftex-vars.el (reftex-cite-format-builtin): Add
+ entry for biblatex macros.
+
+2016-12-30 Alan Mackenzie <acm@muc.de>
+
+ Backport: Remove an ambiguity from defvar's doc string. Fixes bug #25292.
+
+ The ambiguity was whether INITVALUE is evaluated when it's not going to be
+ used to set SYMBOL's value.
+
+ * src/eval.c (defvar): Rewrite a paragraph of the doc string.
+
+ (cherry picked from commit 8295e97f18490a535d1188a3daf0b0fd1bf4fa0d)
+
+2016-12-30 Tino Calancha <tino.calancha@gmail.com>
+
+ ffap-string-at-point: Limit max length of active region
+
+ Prevents that 'ffap-guesser' waste time checking large strings
+ which are likely not valid candidates (Bug#25243).
+ * lisp/ffap.el (ffap-max-region-length): New variable.
+ (ffap-string-at-point): Use it.
+ * test/lisp/ffap-tests.el: New test suite.
+ (ffap-tests-25243): Add test for this bug.
+
+2016-12-30 Thien-Thi Nguyen <ttn@gnu.org>
+
+ last-chance: Also ignore NEWS files + typo fixes
+
+ * admin/last-chance.el: Fix typo in copyright notice.
+ (last-chance-uninteresting-regexps): Add entry to match NEWS files.
+ (last-chance-cleanup): Fix typo in docstring.
+
+2016-12-29 Mike Kupfer <mkupfer@alum.berkeley.edu>
+
+ * lisp/mh-e/mh-e.el (mh-fetch-x-image-url): Fix a docstring typo.
+
+2016-12-29 Alan Mackenzie <acm@muc.de>
+
+ Remove an ambiguity from defvar's doc string. Fixes bug #25292.
+
+ The ambiguity was whether INITVALUE is evaluated when it's not going to be
+ used to set SYMBOL's value.
+
+ * src/eval.c (defvar): Rewrite a paragraph of the doc string.
+
+2016-12-29 Michael Albinus <michael.albinus@gmx.de>
+
+ Improve filenotify-tests.el
+
+ * src/inotify.c (Finotify_valid_p):
+ * src/kqueue.c (Fkqueue_valid_p):
+ * src/w32notify.c (Fw32notify_valid_p):
+ * src/gfilenotify.c (Fgfile_valid_p): Fix typo in docstring.
+ (Fgfile_monitor_name): New defun.
+ (syms_of_gfilenotify): Declare Sgfile_monitor_name.
+
+ * test/lisp/filenotify-tests.el (file-notify--test-read-event):
+ New defun, derived from `file-notify--test-read-event-timeout'.
+ Replace all calls of `read-event' by this.
+ (file-notify--test-timeout): Fix docstring.
+ (file-notify--test-monitor): New defun.
+ (file-notify--deftest-remote): Do not bind
+ `file-notify--test-read-event-timeout' anymore.
+ (file-notify-test00-availability): Print also monitor, if existent.
+ (file-notify--test-with-events): Add an additional
+ `file-notify--test-read-event' call, in order to get it work
+ after `file-notify-add-watch'. Remove special timeout for cygwin.
+ (file-notify-test02-events): Make a better check for cygwin.
+ (file-notify-test06-many-events): Improve event list for cygwin.
+ (file-notify-test08-watched-file-in-watched-dir): Add cygwin case.
+
+2016-12-29 Alan Mackenzie <acm@muc.de>
+
+ Partially correct fontification of "(b*3)", and the like, in C++ Mode
+
+ This problem is caused by the fundamental ambiguity in C++ between
+ argument declarations and initialization clauses.
+
+ * lisp/progmodes/cc-fonts.el (c-font-lock-declarations): If we have an open
+ paren preceded by an arithmetic operator, we give this the context nil, not
+ 'arglist.
+
+ * lisp/progmodes/cc-langs.el (c-arithmetic-operators, c-arithmetic-op-regexp):
+ New lang consts and vars.
+
+2016-12-29 Alan Mackenzie <acm@muc.de>
+
+ Initialize edebug-offset-indices to a cons, not nil. Fixes bug #16184.
+
+ This is because there are times when this variable is changed by setcar before
+ an atom is pushed onto it by debug-enter. This happens, for example, whilst
+ instrumenting c-font-lock-declarations in .../lisp/progmodes/cc-fonts.el.
+
+ * lisp/emacs-lisp/edebug.el (edebug-offset-indices): initialize to '(0).
+
+2016-12-28 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/inline.el: Fix apply-conversion (bug#25280)
+
+ (inline--dont-quote): Quote the function with #' when passing it to `apply'.
+ Cherry picked from commit e6161f648903d821865b9610b3b6aa0f82a5dcb7.
+
+2016-12-27 Michael Albinus <michael.albinus@gmx.de>
+
+ Release Tramp 2.3.1
+
+ * doc/misc/trampver.texi:
+ * lisp/net/trampver.el: Change version to "2.3.1".
+
+ * lisp/net/tramp.el (tramp-eshell-directory-change): Add it to
+ `eshell-mode-hook' but `eshell-first-time-mode-hook'.
+
+ * lisp/net/tramp-compat.el (tramp-compat-file-name-quoted-p)
+ (tramp-compat-file-name-quote)
+ (tramp-compat-file-name-unquote): Embed them in `eval-and-compile'.
+
+2016-12-27 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify prog1 implementation
+
+ Inspired by a suggestion from Chris Gregory in:
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg00965.html
+ On my platform, this generates exactly the same machine insns.
+ * src/eval.c (prog_ignore): Rename from unwind_body, since
+ it’s more general than that. All callers changed.
+ (Fprog1): Simplify by using prog_ignore.
+ (Fwhile): Clarify by using prog_ignore.
+
+2016-12-27 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/emacs-lisp/inline.el: Fix apply-conversion (bug#25280)
+
+ (inline--dont-quote): Quote the function with #' when passing it to `apply'.
+
+2016-12-27 Mark Oteiza <mvoteiza@udel.edu>
+
+ Remove a use of lexical-let
+
+ * lisp/gnus/message.el (message-completion-function): Just use let,
+ since the file now uses lexical-binding.
+
+2016-12-27 Ken Brown <kbrown@cornell.edu>
+
+ Improve filenotify-tests.el on Cygwin (Bug #21804)
+
+ * test/lisp/filenotify-tests.el [CYGWIN]
+ (file-notify--test-read-event-timeout): Increase.
+ (file-notify--test-with-events): Add delay before executing body.
+ (file-notify-test02-events, file-notify-test04-file-validity):
+ Adjust expected results.
+
+2016-12-27 Eli Zaretskii <eliz@gnu.org>
+
+ Fix expand-file-name on DOS_NT systems when /: escaping is used
+
+ * src/fileio.c (Fexpand_file_name) [DOS_NT]: Don't expand "~" in
+ file names escaped by "/:". Don't recursively expand
+ default-directory escaped with "/:" which is not followed by a
+ drive spec. (Bug#25183)
+
+2016-12-27 Bake Timmons <65pandas@gmail.com>
+
+ Fix `mail-sources' value of `(group)' in Gnus manual (bug#25275)
+
+ * doc/misc/gnus.texi (Mail Source Specifiers):
+ Replace wrong `mail-sources' value of `(group)' in Gnus manual with
+ the correct `((group))' value. (bug#25275) (tiny change)
+
+2016-12-27 Bake Timmons <65pandas@gmail.com>
+
+ Fix bug in customizing `mail-sources' variable (bug#25274)
+
+ * lisp/gnus/mail-source.el (mail-sources): Use list instead of cons
+ for lone argument. (bug#25274) (tiny change)
+
+2016-12-26 Philipp Stephani <phst@google.com>
+
+ Checkdoc: Don't require a space before an arg list
+
+ See Bug#24998.
+
+ * lisp/emacs-lisp/checkdoc.el (checkdoc-defun-regexp): Don't require a
+ space before a argument list.
+ * test/lisp/emacs-lisp/checkdoc-tests.el (checkdoc-tests--bug-24998):
+ Add unit test.
+
+2016-12-26 Eli Zaretskii <eliz@gnu.org>
+
+ Document 'default-toplevel-value' and 'set-default-toplevel-value'
+
+ * doc/lispref/variables.texi (Default Value): Document
+ 'default-toplevel-value' and 'set-default-toplevel-value'.
+
+2016-12-25 Michihito Shigemura <m_shigemura@shigemk2.com> (tiny change)
+
+ Add zshrc and zshenv detection to sh-mode (bug#25217)
+
+ * lisp/progmodes/sh-script.el (sh-mode): Add zsh string-match
+
+2016-12-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix typo in lisp.h reordering patch
+
+ * src/lisp.h (XUNTAG) [!USE_LSB_TAG]: Remove duplicate defn.
+ Reported by Eli Zaretskii (Bug#25128#19).
+
+2016-12-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ regex.h now includes sys/types.h
+
+ * src/dired.c, src/emacs.c, src/search.c, src/syntax.c, src/thread.h:
+ Do not include sys/types.h; no longer needed.
+ * src/regex.h: Include <sys/types.h>, as that's what Gnulib and
+ glibc regex.h does, and POSIX has blessed this since 2008.
+
+2016-12-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Reorder lisp.h to declare types before using them
+
+ This puts basic functions for types to be after the corresponding
+ type definitions. This is a more-common programming style in C,
+ and will make it easier to port Emacs to gcc
+ -fcheck-pointer-bounds, since the functions now have access to the
+ corresponding types' sizes. This patch does not change the code;
+ it just moves declarations and definitions and removes
+ no-longer-needed forward declarations (Bug#25128).
+ * src/buffer.c, src/data.c, src/image.c:
+ Include process.h, for PROCESSP.
+ * src/buffer.h (BUFFERP, CHECK_BUFFER, XBUFFER):
+ * src/process.h (PROCESSP, CHECK_PROCESS, XPROCESS):
+ * src/termhooks.h (TERMINALP, XTERMINAL):
+ * src/window.h (WINDOWP, CHECK_WINDOW, XWINDOW):
+ * src/thread.h (THREADP, CHECK_THREAD, XTHREAD, MUTEXP, CHECK_MUTEX)
+ (XMUTEX, CONDVARP, CHECK_CONDVAR, XCONDVAR):
+ Move here from lisp.h.
+ * src/intervals.h: Include buffer.h, for BUFFERP.
+ Include lisp.h, for Lisp_Object.
+ * src/lisp.h: Reorder declarations and definitions as described
+ above. Move thread includes to be later, so that they can use the
+ reordered definitions. Move some symbols to other headers (noted
+ elsewhere). Remove forward decls that are no longer needed.
+ * src/thread.h: Include systhread.h here, not in lisp.h,
+ since lisp.h itself does not need systhread.h.
+
+2016-12-25 Leo Liu <sdl.web@gmail.com>
+
+ Don't modify minibuffer variables globally
+
+ * lisp/files.el (cd): Use setq-local instead. (Bug#25260)
+
+2016-12-25 Dima Kogan <dima@secretsauce.net>
+
+ diff-mode auto-refines only after a successful motion
+
+ Prior to this patch (if enabled) auto-refinement would kick in after all
+ hunk navigation commands, even if the motion failed. This would result
+ in a situation where the hunk navigation would signal an error and beep,
+ but yet still accomplish potentially useful work, by auto-refining.
+ This patch moves the auto-refinement code to only run when a motion was
+ successful
+
+ * lisp/vc/diff-mode.el (diff--internal-hunk-next,
+ diff--internal-hunk-prev): Removed auto-refinement-triggering code
+ * lisp/vc/diff-mode.el (diff--wrap-navigation): Added
+ auto-refinement-triggering code
+
+2016-12-25 Dima Kogan <dima@secretsauce.net>
+
+ diff-mode is able to better handle file headers
+
+ This fixes a regression introduced in
+
+ https://git.savannah.gnu.org/gitweb/?p=emacs.git;a=commit;h=2c8a7e50d24daf19ea7d86f1cfeaa98a41c56085
+
+ This bug was filed in
+
+ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25105
+
+ Patches generated from a VCS such as git contain a patch message at the
+ start, and diff-mode is now once-again able to properly able to ignore
+ this message when issuing navigation commands around the message.
+
+ * lisp/vc/diff-mode.el (diff-beginning-of-file-and-junk): More
+ thoroughly ignore the header when looking for a beginning of file
+ diffs.
+
+2016-12-25 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use libpng-config --ldflags, not --libs
+
+ Problem reported by James K. Lowden (Bug#25268).
+ * configure.ac (LIBPNG): Pass --ldflags, not --libs, to libpng-config.
+
+2016-12-24 Eli Zaretskii <eliz@gnu.org>
+
+ Revert to pre-25.1 behavior in ffap
+
+ * lisp/ffap.el (ffap-lax-url): Change the default to t, to produce
+ the same behavior as in Emacs 24.x. (Bug#25264)
+ Explain the trade-offs of customizing this in the doc string.
+
+2016-12-24 Noam Postavsky <npostavs@gmail.com>
+
+ * lisp/ffap.el: Fix obsolete comment referencing ffap-bug.
+
+2016-12-24 Noam Postavsky <npostavs@gmail.com>
+
+ Remove redundant `save-match-data' in whitespace.el
+
+ * lisp/whitespace.el (whitespace-cleanup, whitespace-cleanup-region):
+ (whitespace-report-region): Remove redundant `save-match-data' calls.
+
+2016-12-24 Noam Postavsky <npostavs@gmail.com>
+
+ Fix whitespace eob cleanup
+
+ * lisp/whitespace.el (whitespace-empty-at-eob-regexp): Match any number
+ of empty lines at end of buffer.
+ * test/lisp/whitespace-tests.el (whitespace-cleanup-eob): New test.
+ (whitespace-tests--cleanup-string): New helper function for tests.
+
+2016-12-24 Hong Xu <hong@topbug.net>
+
+ Fix timezone detection of parse-iso8601-time-string
+
+ * lisp/calendar/parse-time.el (parse-iso8601-time-string): Fix timezone
+ parsing. Add a doc string. (Bug#25086)
+ * src/editfns.c (Fdecode-time): Doc fix.
+ * doc/misc/emacs-mime.texi (time-date): Add an example for
+ parse-iso8601-time-string.
+ * test/lisp/calendar/parse-time-tests.el (parse-time-tests): Add
+ tests for parse-iso8601-time-string.
+
+2016-12-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Simplify exec_byte_code via moving decls etc.
+
+ * src/bytecode.c (exec_byte_code): Simplify, mostly by moving
+ initializers into decls, and by omitting some unnecessary changes
+ to ‘top’.
+
+2016-12-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Remove interpreter’s byte stack
+
+ This improves performance overall on my benchmark on x86-64,
+ since the interpreted program-counter resides in a machine
+ register rather than in RAM.
+ * etc/DEBUG, src/.gdbinit: Remove xbytecode GDB command, as there
+ is no longer a byte stack to decode.
+ * src/bytecode.c (struct byte_stack, byte_stack_list)
+ (relocate_byte_stack): Remove. All uses removed.
+ (FETCH): Simplify now that pc is now local (typically, in a
+ register) and no longer needs to be relocated.
+ (CHECK_RANGE): Remove. All uses now done inline, in a different way.
+ (BYTE_CODE_QUIT): Remove; now done by op_relative_branch.
+ (exec_byte_code): Allocate a copy of the function’s bytecode,
+ so that there is no problem if GC moves it.
+ * src/lisp.h (struct handler): Remove byte_stack member.
+ All uses removed.
+ * src/thread.c (unmark_threads): Remove. All uses removed.
+ * src/thread.h (struct thread_state): Remove m_byte_stack_list member.
+ All uses removed. m_stack_bottom is now the first non-Lisp field.
+
+2016-12-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ BYTE_CODE_SAFE typo fix
+
+ * src/bytecode.c (FETCH): Depend on the value of BYTE_CODE_SAFE,
+ not on whether it is defined.
+
+2016-12-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ BYTE_CODE_SAFE cleanups
+
+ * src/bytecode.c (BYTE_MAINTAIN_TOP): Remove; no longer needed.
+ (struct byte_stack) [BYTE_MAINTAIN_TOP]:
+ Remove unused members ‘top’ and ‘bottom’.
+ (exec_byte_code): Nest inside { } to avoid GCC warning about
+ jumping over declaration when compiled with -DBYTE_CODE_SAFE.
+
+2016-12-24 Thien-Thi Nguyen <ttn@gnu.org>
+
+ last-chance: new utility lib for dangling deterrence
+
+ * admin/last-chance.el: New file.
+
+2016-12-24 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use max_align_t instead of void *
+
+ * src/thread.c (run_thread): Don’t assume void * is aligned enough.
+
+2016-12-23 Eli Zaretskii <eliz@gnu.org>
+
+ Attempt to fix 64-bit AIX build
+
+ * src/unexaix.c (make_hdr, copy_text_and_data, write_segment): Fix
+ type-casts that assumed 32-bit pointers. (Bug#25141)
+
+2016-12-23 Philipp Stephani <phst@google.com>
+
+ Clarify usage of 'ediff-cleanup-hook' (Bug#24675)
+
+ * doc/misc/ediff.texi (Hooks): Clarify usage of 'ediff-cleanup-hook'
+
+2016-12-23 Philipp Stephani <phst@google.com>
+
+ Document that variable binding order is unspecified
+
+ * doc/lispref/variables.texi (Local Variables):
+ * doc/misc/cl.texi (Modify Macros): Document that binding order in 'let' and
+ 'cl-letf' is unspecified.
+
+2016-12-23 Eli Zaretskii <eliz@gnu.org>
+
+ Prevent infloops in redisplay due to truncate-lines and overlays
+
+ * src/xdisp.c (hscroll_window_tree): Avoid inflooping in
+ redisplay_window when a screen line ends in an overlay string with
+ a newline. (Bug#25246)
+
+2016-12-23 Philipp Stephani <phst@google.com>
+
+ Treat incomplete integer literals as errors
+
+ See Bug#25120.
+
+ * src/lread.c (read_integer): Treat incomplete integer literals as errors.
+ * test/src/lread-tests.el (lread-empty-int-literal): New unit test for
+ incomplete integer literals.
+
+2016-12-23 Eli Zaretskii <eliz@gnu.org>
+
+ * lisp/desktop.el (desktop-buffers-not-to-save): Doc fix.
+
+2016-12-23 Stefan Monnier <monnier@IRO.UMontreal.CA>
+
+ Fix M-x hints on Mac port
+
+ * lisp/simple.el (execute-extended-command--shorter): Call
+ input-pending-p to trigger input processing on some systems, such
+ as Mac port. (Bug#23002)
+
+2016-12-23 Michael Albinus <michael.albinus@gmx.de>
+
+ * test/lisp/net/tramp-tests.el (tramp--test-check-files): Make it robust.
+
+2016-12-23 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid aborts due to unaligned byte stack of threads
+
+ * src/thread.c (run_thread): Make sure the pointers to thread byte
+ stack are properly aligned. (Bug#25247)
+
+2016-12-22 Paul Eggert <eggert@cs.ucla.edu>
+
+ Pacify --enable-gcc-warnings
+
+ * src/charset.c (load_charset_map):
+ * src/coding.c (decode_coding_object):
+ * src/frame.c (make_frame):
+ * src/window.c (Frecenter):
+ Mark locals with UNINIT to silence false alarms from
+ -Wmaybe-uninitialized.
+ * src/lisp.h (SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD)
+ (SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD):
+ Check and assume that values are nonnull. This pacifies
+ -Wmaybe-uninitialized in Fmake_variable_buffer_local and
+ Fmake_local_variable.
+
+2016-12-22 Eli Zaretskii <eliz@gnu.org>
+
+ Fix last change with thread marking under GC_CHECK_MARKED_OBJECTS
+
+ * src/thread.c (primary_thread_p): New function.
+ * src/alloc.c (mark_object): Use 'primary_thread_p' to bypass tests
+ meant for thread objects allocated dynamically.
+ * src/thread.h (primary_thread_p): Add prototype.
+
+2016-12-22 Martin Rudalics <rudalics@gmx.at>
+
+ Work around reporting a dpi change in apply_xft_settings
+
+ * src/xsettings.c (apply_xft_settings): Don't report a change
+ when dpi settings do not differ substantially.
+
+2016-12-22 Noam Postavsky <npostavs@gmail.com>
+
+ Use completion-at-point in verilog-mode
+
+ There were some functions in verilog-mode that implemented in-buffer
+ completion, but this needlessly duplicates completion-at-point
+ functionality, and the popup window management had problems
+ (see Bug #23842). We need to keep them for backwards compatibility with
+ older emacs versions, but use completion-at-point if available.
+
+ * lisp/progmodes/verilog-mode.el (verilog-toggle-completions): Mark as
+ obsolete if completion-cycle-threshold is available.
+ (verilog-mode-map, verilog-menu): Bind completion-at-point and
+ completion-help-at-point in preference to verilog-complete-word and
+ verilog-show-completions, respectively.
+ (verilog-mode): Add verilog-completion-at-point to
+ completion-at-point-functions.
+ (verilog-completion-at-point): New function.
+ (verilog-show-completions, verilog-complete-word): Use it to avoid code
+ duplication.
+
+2016-12-21 Reuben Thomas <rrt@sc3d.org>
+
+ Keep default CASECHARS/NOT-CASECHARS for ispell built-in dictionaries
+
+ * lisp/textmodes/ispell.el (ispell-set-spellchecker-params): Do not
+ override CASECHARS and NOT-CASECHARS. The ispell dictionaries
+ retain their hardwired values, and all other dictionaries are given
+ sensible defaults.
+
+2016-12-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * lisp/textmodes/tex-mode.el (tex-compile-commands): Add luatex
+ and xetex commands.
+
+2016-12-21 Eli Zaretskii <eliz@gnu.org>
+
+ Fix aborts in GC under GC_CHECK_MARKED_OBJECTS
+
+ * src/alloc.c (mark_object) [GC_CHECK_MARKED_OBJECTS]: Don't abort
+ for thread objects. They are marked via the all_threads list, and
+ therefore don't need to be inserted into the red-black tree, so
+ mem_find will never find them. Reported by Daniel Colascione
+ <dancol@dancol.org> in
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg00817.html.
+
+2016-12-21 Stefan Monnier <monnier@iro.umontreal.ca>
+
+ * src/data.c (Fmake_variable_frame_local): Remove
+
+ * src/lisp.h (struct Lisp_Buffer_Local_Value): Remove `frame_local'.
+
+ * src/data.c (swap_in_symval_forwarding, set_internal)
+ (set_symbol_trapped_write, make_blv, Fmake_variable_buffer_local)
+ (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p):
+ Don't pay attention to ->frame_local any more.
+ (syms_of_data): Remove Qtrapping_frame_local and don't defsubr
+ Smake_variable_frame_local.
+
+ * etc/NEWS (Incompatible Lisp Changes in Emacs 26.1): Announce removal
+ of make-variable-frame-local.
+
+ * lisp/help-fns.el (describe-variable): Don't handle the now impossible
+ frame-local case.
+
+ * lisp/subr.el (make-variable-frame-local): Remove obsolescence data.
+
+ * src/frame.c (store_frame_param):
+ * src/eval.c (specbind): Don't pay attention to ->frame_local any more.
+
+ * src/widget.c (first_frame_p): Remove, unused.
+
+2016-12-21 Paul Eggert <eggert@cs.ucla.edu>
+
+ Port dumping better to WSL
+
+ Problem reported by Angelo Graziosi in:
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg00822.html
+ * src/sysdep.c (disable_address_randomization):
+ Detect buggy platforms where 'personality' always returns 0.
+
+2016-12-21 Michael Albinus <michael.albinus@gmx.de>
+
+ Remove gateway methods in Tramp
+
+ * doc/misc/tramp.texi (Top, Configuration): Remove section
+ `Gateway methods', insert section `Firewalls' in menu.
+ (History): Gateways are removed now.
+ (Gateway methods): Remove section.
+ (Multi-hops, Traces and Profiles): Don't reference to gateways anymore.
+ (Firewalls): New section.
+
+ * etc/NEWS: Gateway methods in Tramp have been removed.
+
+ * lisp/net/tramp.el (tramp-methods): Adapt docstring.
+ (tramp-file-name-port, tramp-accept-process-output): Simplify.
+
+ * lisp/net/tramp-gw.el: Remove.
+
+ * lisp/net/tramp-sh.el (tramp-gw-tunnel-method)
+ (tramp-gw-socks-method): Remove declarations.
+ (tramp-methods) <scp, scpx, ssh, sshx, telnet, nc, plink, pscp>:
+ Remove `tramp-gw-args' and `tramp-default-port'. (Bug#18967)
+ (tramp-do-copy-or-rename-file-out-of-band)
+ (tramp-compute-multi-hops, tramp-maybe-open-connection):
+ Remove gateway support.
+
+ * test/lisp/net/tramp-tests.el (tramp-test03-file-name-defaults):
+ Remove gateway tests.
+
+2016-12-20 Alan Mackenzie <acm@muc.de>
+
+ Amend the version number of CC Mode 5.33 -> 5.32.99. Don't merge to trunk.
+
+ lisp/progmodes/cc-defs.el: Amend the version number.
+ etc/NEWS: Add an item explaining the change.
+
+2016-12-20 Tino Calancha <tino.calancha@gmail.com>
+
+ files-test-read-file-in-: Delete temporary dir on exit
+
+ * test/lisp/files-tests.el (files-test-read-file-in-~):
+ Create subdir inside dir.
+
+2016-12-20 Christopher Genovese <genovese@cmu.edu>
+
+ ibuffer: New filters and commands
+
+ Add several new filters and improve documentation.
+ See discussion on:
+ https://lists.gnu.org/r/emacs-devel/2016-11/msg00399.html
+ * lisp/ibuf-ext.el: Add paragraph to file commentary.
+ (ibuffer-saved-filters, ibuffer-filtering-qualifiers)
+ (ibuffer-filter-groups): Update doc string.
+ (ibuffer-unary-operand): Add new function that transparently
+ handles 'not' formats for compound filters.
+ (ibuffer-included-in-filter-p): Handle 'not' fully; update doc string.
+ (ibuffer-included-in-filter-p-1): Handle 'and' compound filters.
+ (ibuffer-decompose-filter): Handle 'and' as well,
+ and handle 'not' consistently with other uses.
+ (ibuffer-and-filter): New defun analogous to 'ibuffer-or-filter'.
+ (ibuffer--or-and-filter): New defun.
+ (ibuffer-or-filter, ibuffer-and-filter): Use it.
+ (ibuffer-format-qualifier): Handle 'and' filters as well.
+ (ibuffer-filter-by-basename, ibuffer-filter-by-file-extension)
+ (ibuffer-filter-by-directory, ibuffer-filter-by-starred-name)
+ (ibuffer-filter-by-modified, ibuffer-filter-by-visiting-file):
+ Add new pre-defined filters.
+ (ibuffer-filter-chosen-by-completion): Add new interactive command
+ for easily choosing a filter from the descriptions.
+ * lisp/ibuffer.el (ibuffer-mode-map):
+ Bind ibuffer-filter-by-basename, ibuffer-filter-by-file-extension,
+ ibuffer-filter-by-starred-name, ibuffer-filter-by-modified,
+ ibuffer-filter-by-visiting-file to '/b', '/.', '/*', '/i', '/v'
+ respectively; bind 'ibuffer-or-filter', 'ibuffer-and-filter',
+ 'ibuffer-pop-filter' ,'ibuffer-pop-filter-group' and
+ 'ibuffer-filter-disable' to '/|', '/&', '/<up>', '/S-<up>'
+ and '/ DEL' respectively.
+ * test/lisp/ibuffer-tests.el (ibuffer-autoload): Add appropriate
+ skip specification.
+ Add menu entries for the new filters.
+ (ibuffer-filter-inclusion-1, ibuffer-filter-inclusion-2
+ ibuffer-filter-inclusion-3, ibuffer-filter-inclusion-4
+ ibuffer-filter-inclusion-5, ibuffer-filter-inclusion-6
+ ibuffer-filter-inclusion-7, ibuffer-filter-inclusion-8
+ ibuffer-decompose-filter, ibuffer-and-filter
+ ibuffer-or-filter): Add new tests; they are skipped unless
+ ibuf-ext is loaded.
+
+2016-12-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Update NEWS
+
+ * etc/NEWS (Image-Dired): New section.
+
+2016-12-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Recognize graphicsmagick in image-dired
+
+ * lisp/image-dired.el (image-dired-cmd-create-thumbnail-program):
+ (image-dired-cmd-create-thumbnail-options):
+ (image-dired-cmd-create-temp-image-program):
+ (image-dired-cmd-create-temp-image-options):
+ (image-dired-cmd-create-standard-thumbnail-options):
+ (image-dired-cmd-rotate-thumbnail-program):
+ (image-dired-cmd-rotate-thumbnail-options): Account for existence of
+ gm(1) executable.
+
+2016-12-20 Noam Postavsky <npostavs@gmail.com>
+
+ Improve skeleton docstrings
+
+ * lisp/skeleton.el (skeleton-end-newline): Remove mention of
+ `skeleton-end-hook', its default code was moved into `skeleton-insert'.
+ (skeleton-insert): Mention `skeleton-end-newline' and move reference to
+ `skeleton-end-hook' above the explanation of skeleton syntax.
+
+2016-12-20 Mark Oteiza <mvoteiza@udel.edu>
+
+ Implement asynchronous thumbnail generation in image-dired
+
+ Additionally, all FOO-options defcustoms that were in fact shell command
+ strings have been converted to argument lists. Another method for
+ shrinking PNG thumbs with optipng(1) has been added.
+ * lisp/image-dired.el: Remove TODO item in commentary.
+ (image-dired-cmd-create-thumbnail-options):
+ (image-dired-cmd-create-temp-image-options):
+ (image-dired-cmd-rotate-thumbnail-options):
+ (image-dired-cmd-rotate-original-options):
+ (image-dired-cmd-write-exif-data-options):
+ (image-dired-cmd-read-exif-data-options): Convert to argument lists.
+ (image-dired-cmd-pngnq-program, image-dired-cmd-pngcrush-program):
+ Change string type to file.
+ (image-dired-cmd-create-standard-thumbnail-command): Remove.
+ (image-dired-cmd-pngnq-options):
+ (image-dired-cmd-create-standard-thumbnail-options):
+ (image-dired-cmd-optipng-program, image-dired-cmd-optipng-options):
+ New defcustoms.
+ (image-dired-queue, image-dired-queue-active-jobs):
+ (image-dired-queue-active-limit): New variables.
+ (image-dired-pngnq-thumb, image-dired-pngcrush-thumb):
+ (image-dired-optipng-thumb): New functions.
+ (image-dired-create-thumb-1): Renamed from image-dired-create-thumb.
+ Use start-process instead of call-process. Set file modes. Trigger
+ PNG file optimization in process sentinel.
+ (image-dired-thumb-queue-run, image-dired-create-thumb): New functions.
+ (image-dired-display-thumbs):
+ (image-dired-create-thumbs): Don't expect call-process return value.
+ (image-dired-display-image, image-dired-rotate-thumbnail): Use
+ start-process instead of call-process.
+ (image-dired-rotate-original, image-dired-set-exif-data):
+ (image-dired-get-exif-data): Adapt to arguments being an arg list.
+
+2016-12-19 Andreas Schwab <schwab@linux-m68k.org>
+
+ Protect change of window's buffer in vertical-motion against unwinds (bug#25209)
+
+ * src/indent.c (restore_window_buffer): New function.
+ (Fvertical_motion): Use it to restore window's buffer.
+
+2016-12-19 Glenn Morris <rgm@gnu.org>
+
+ Improve default load-path for uninstalled CANNOT_DUMP builds
+
+ * src/lread.c (load_path_default) [CANNOT_DUMP]:
+ Use build load-path if we seem to be running uninstalled. (Bug#24974)
+ I think this became an issue several years ago when we stopped
+ using EMACSLOADPATH in the Makefiles; however this change should
+ improve the CANNOT_DUMP uninstalled case in general.
+
+2016-12-19 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'w32-scroll-lock-modifier'
+
+ * doc/emacs/msdos.texi (Windows Keyboard): Document how to set up
+ w32-scroll-lock-modifier so that Scroll Lock toggles the LED.
+
+ * src/w32fns.c (syms_of_w32fns) <w32-scroll-lock-modifier>: Doc
+ fix. (Bug#25204)
+
+2016-12-19 Eli Zaretskii <eliz@gnu.org>
+
+ Document 'describe-fontset'
+
+ * doc/emacs/mule.texi (Fontsets): Document 'describe-fontset'.
+ (Bug#25216)
+
+2016-12-19 Eli Zaretskii <eliz@gnu.org>
+
+ Document 'describe-fontset'
+
+ * doc/emacs/mule.texi (Fontsets): Document 'describe-fontset'.
+ (Bug#25216)
+
+2016-12-19 Eli Zaretskii <eliz@gnu.org>
+
+ Fix crashes upon C-g on Posix TTY frames
+
+ * src/thread.h (struct thread_state): New member not_holding_lock.
+ (maybe_reacquire_global_lock): Add prototype.
+ * src/thread.c: Include syssignal.h.
+ (maybe_reacquire_global_lock): New function.
+ (really_call_select): Set the not_holding_lock member of the
+ thread state before releasing the lock, and rest it after
+ re-acquiring the lock when the select function returns. Block
+ SIGINT while doing this to make sure we are not interrupted on TTY
+ frames.
+ * src/sysdep.c (block_interrupt_signal, restore_signal_mask): New
+ functions.
+ * src/syssignal.h (block_interrupt_signal, restore_signal_mask):
+ Add prototypes.
+ * src/keyboard.c (read_char) [THREADS_ENABLED]: Call
+ maybe_reacquire_global_lock. (Bug#25178)
+
+2016-12-19 Sam Steingold <sds@gnu.org>
+
+ avoid Eager macro-expansion failure: (void-function string-to-list)
+
+ * lisp/loadup.el [ns]: "ucs-normalize" uses `string-to-list' which is defined
+ in "mule-util", so we have to load "mule-util" before "ucs-normalize",
+ otherwise I get "Eager macro-expansion failure" on "make bootstrap"
+
+2016-12-19 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#24980
+
+ * lisp/ido.el (ido-add-virtual-buffers-to-list):
+ Suppress Tramp invocation. (Bug#24980)
+
+2016-12-18 Philipp Stephani <phst@google.com>
+
+ Add a new compile error regexp for Clang includes
+
+ Clang uses a slight variation of GCC's include format, causing includes
+ to be treated as warnings instead of informational messages. Use a new
+ regular expression instead.
+
+ * lisp/progmodes/compile.el
+ (compilation-error-regexp-alist-alist): New element
+ `clang-include' for Clang-style "included from" lines.
+ * test/lisp/progmodes/compile-tests.el
+ (compile-tests--test-regexps-data): Add unit test.
+
+2016-12-18 Alan Third <alan@idiocy.org>
+
+ Reinstate ispell character offset (bug#25219)
+
+ * lisp/textmodes/ispell.el (ispell-process-line): insert -1 where
+ ispell-offset used to be.
+
+2016-12-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Bind new image-mode scroll commands in image-dired
+
+ * lisp/image-dired.el (image-dired-display-image-mode-map): Add bindings
+ to new image-mode commands.
+
+2016-12-18 Noam Postavsky <npostavs@gmail.com>
+
+ Fix rx-any with range with ?\] and ?-
+
+ * lisp/emacs-lisp/rx.el: Make sure not to produce a circular
+ list (Bug#25123).
+ * test/lisp/emacs-lisp/rx-tests.el (rx-char-any): New test.
+
+2016-12-18 Mark Oteiza <mvoteiza@udel.edu>
+
+ Use floor of mtime instead of rounding for thumb property
+
+ This seems to be the correct thing to do, at least more in line with
+ what at least one other implementation does. Anything using
+ gnome-desktop [0] effectively does the same, as
+ gnome_desktop_thumbnail_is_valid applies atol(3) to mtime for
+ comparison and time_t on GNU/Linux is a signed int.
+ [0] https://git.gnome.org/browse/gnome-desktop/
+ * lisp/image-dired.el (image-dired-create-thumb): Use floor here.
+
+2016-12-17 Reuben Thomas <rrt@sc3d.org>
+
+ Fix spelling mistake in private defun name (Bug#25218)
+
+ lisp/textmodes/flyspell.el (flyspell-ajust-cursor-point): Rename to
+ `flyspell-adjust-cursor-point'.
+
+2016-12-17 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs support from flyspell.el (Bug#25218)
+
+ lisp/textmodes/flyspell.el (flyspell-prog-mode, flyspell-mode-on):
+ (flyspell-word, flyspell-delete-region-overlays):
+ (flyspell-correct-word-before-point): Remove XEmacs support.
+ (flyspell-xemacs-popup): Remove XEmacs-specific defun.
+
+2016-12-17 Michael Albinus <michael.albinus@gmx.de>
+
+ More tests for Tramp
+
+ * lisp/net/tramp.el (tramp-drop-volume-letter): Handle quoted
+ file names.
+
+ * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name): Quote file
+ name properly.
+
+ * test/lisp/net/tramp-tests.el (tramp-test05-expand-file-name):
+ Mark quoted file name as absolute. (Bug#25183)
+ (tramp--test-windows-nt-and-batch)
+ (tramp--test-windows-nt-and-pscp-psftp-p): New defuns.
+ (tramp--test-windows-nt-or-smb-p): Rename from
+ `tramp--test-smb-windows-nt-p'. Adapt callees.
+ (tramp--test-check-files): Improve checks for environment variables.
+ (tramp-test33-special-characters)
+ (tramp-test33-special-characters-with-stat)
+ (tramp-test33-special-characters-with-perl)
+ (tramp-test33-special-characters-with-ls, tramp-test34-utf8)
+ (tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
+ (tramp-test34-utf8-with-ls): Add more checks for skip.
+
+2016-12-17 Eli Zaretskii <eliz@gnu.org>
+
+ Fix comments
+
+ * src/thread.h (struct thread_state): Fix comments.
+ * src/process.c (wait_reading_process_output): Fix a typo in
+ commentary.
+
+2016-12-17 Eli Zaretskii <eliz@gnu.org>
+
+ Repair desktop restoration on text terminals
+
+ * lisp/desktop.el (desktop-restoring-frameset-p): Test for the GUI
+ frame here, instead of in desktop-restoring-frameset. That's
+ because desktop-read wants to know whether frameset will actually
+ be restored, and has fallback procedures up its sleeve when it
+ won't be; these fallbacks need to be invoked when the frameset is
+ not going to be restored. (Bug#24298)
+
+2016-12-17 Eli Zaretskii <eliz@gnu.org>
+
+ Fix crashes on MS-Windows during dumping
+
+ * src/unexw32.c (get_section_info): Make extra_bss_size be the
+ maximum of extra_bss_size and extra_bss_size_static. This avoids
+ computing the size of the output file smaller than it actually
+ needs to be, which then causes copy_executable_and_dump_data to
+ write beyond the requested size of the file mapping, thus relying
+ on the OS roundup to page boundary to save us from ourselves. See
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg00642.html
+ for the details.
+
+ * lib/stdio-impl.h: Revert the workaround fix of not including
+ errno.h for MinGW.
+
+2016-12-17 Dmitry Gutov <dgutov@yandex.ru>
+
+ Ignore forward-sexp-function in js-mode indentation code
+
+ * lisp/progmodes/js.el (js--multi-line-declaration-indentation)
+ (js--maybe-goto-declaration-keyword-end):
+ Bind forward-sexp-function to nil (bug#25215).
+
+2016-12-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Be more selective clearing the image cache
+
+ * lisp/image-dired.el (image-dired-create-thumbs):
+ (image-dired-rotate-thumbnail, image-dired-refresh-thumb): Only clear
+ the current thumbnail file from the image cache.
+
+2016-12-16 Eli Zaretskii <eliz@gnu.org>
+
+ Unbreak the MinGW build
+
+ * lib/stdio-impl.h [__MINGW32__]: Don't include errno.h. Without
+ this, temacs crashes while dumping.
+
+2016-12-16 Nicolas Petton <nicolas@petton.fr>
+
+ Make seq-into return the sequence when no conversion needed
+
+ * lisp/emacs-lisp/seq.el (seq-into): Do not convert the sequence when
+ no conversion is needed.
+ * test/lisp/emacs-lisp/seq-tests.el (test-seq-into-and-identity): Add
+ a regression test checking for identity.
+
+2016-12-16 Eli Zaretskii <eliz@gnu.org>
+
+ Improve documentation of 'define-coding-system'
+
+ * lisp/international/mule.el (define-coding-system): Warn against
+ possible infinite recursion in pre-write-conversion and
+ post-read-conversion functions. (Bug#25203)
+
+2016-12-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ New commands image-scroll-left and image-scroll-right
+
+ * etc/NEWS: Mention them.
+ * lisp/image-mode.el (image-scroll-left, image-scroll-right): New
+ functions.
+
+2016-12-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ More image-dired refactoring
+
+ * lisp/image-dired.el (image-dired-thumbnail-mode):
+ (image-dired-display-image-mode): Add :group 'image-dired so
+ customize-mode works.
+ (image-dired-display-image): Rearrange.
+ (image-dired-copy-with-exif-file-name): This map is for side effect.
+ (image-dired-dired-edit-comment-and-tags): Just use #'identity.
+
+2016-12-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/image-dired.el: Turn on lexical-binding.
+
+2016-12-16 Mark Oteiza <mvoteiza@udel.edu>
+
+ Teach image-dired to also generate large thumbs
+
+ * lisp/image-dired.el (image-dired-thumbnail-storage): Add
+ standard-large option.
+ (image-dired-thumb-size): Add condition for standard-large storage.
+ (image-dired-insert-thumbnail): Check for new option. Change
+ thumbnail path conditionally.
+ (image-dired-thumb-size): New function.
+ (image-dired-create-thumb, image-dired-line-up-dynamic): Use it.
+
+2016-12-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ Merge from gnulib
+
+ This incorporates:
+ 2016-12-14 xalloc-oversized: check for PTRDIFF_MAX too
+ 2016-12-12 fpending: port to native Windows with MSVC
+ * .gitignore: Do not ignore lib/stdio-impl.h.
+ * lib/fpending.c, lib/xalloc-oversized.h, m4/fpending.m4:
+ Copy from gnulib.
+ * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
+ * lib/stdio-impl.h:
+ New file, copied from gnulib.
+ * nt/gnulib.mk (EXTRA_DIST): Add stdio-impl.h.
+
+2016-12-15 Paul Eggert <eggert@cs.ucla.edu>
+
+ * etc/images/icons/hicolor/scalable/mimetypes/emacs-document.svg:
+ Append newline.
+
+2016-12-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Don't abuse princ and spam messages
+
+ * lisp/image-dired.el (image-dired-format-properties-string): Nix princ.
+ (image-dired-display-thumb-properties):
+ (image-dired-dired-display-properties): Nix princ. Bind
+ message-log-max to nil.
+
+2016-12-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Inherit things from special-mode and image-mode
+
+ * lisp/image-dired.el: Require image-mode library.
+ (image-dired-thumbnail-mode-map): Remove superfluous binding.
+ (image-dired-display-image-mode-map): Remove superfluous binding.
+ Add movement remaps from image-mode-map.
+ (image-dired-thumbnail-mode): Derive from special-mode.
+ (image-dired-display-image-mode): Derive from special-mode. Call
+ image-mode-setup-winprops.
+
+2016-12-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ Fix some image-dired customization types
+
+ * lisp/image-dired.el (image-dired): Add info link to defgroup.
+ (image-dired-dir, image-dired-gallery-dir): Set type to directory.
+ (image-dired-db-file, image-dired-temp-image-file):
+ (image-dired-cmd-create-thumbnail-program):
+ (image-dired-cmd-create-temp-image-program):
+ (image-dired-cmd-rotate-thumbnail-program):
+ (image-dired-cmd-rotate-original-program):
+ (image-dired-temp-rotate-image-file):
+ (image-dired-cmd-write-exif-data-program):
+ (image-dired-cmd-read-exif-data-program): Set type to file.
+ (image-dired-create-thumb, image-dired-line-up-dynamic): Check storage
+ type at runtime, since setting image-dired-thumb-size does not
+ automatically set image-dired-thumb-width and image-dired-thumb-height.
+
+2016-12-15 Eli Zaretskii <eliz@gnu.org>
+
+ Prevent crashes in xg_select due to concurrency
+
+ * src/xgselect.c (xg_select): Don't call Glib functions that use
+ 'context' if we failed to acquire it. This means some other
+ thread owns the context, in which case both using the context and
+ calling block_input/unblock_input will step on that thread's toes
+ and eventually lead to crashes. (Bug#25172)
+
+2016-12-15 Nicolas Petton <nicolas@petton.fr>
+
+ Fix circular list handling in seq-mapn
+
+ * lisp/emacs-lisp/seq.el (seq-mapn): Do not copy list arguments.
+ * test/lisp/emacs-lisp/seq-tests.el (test-seq-mapn-circular-lists):
+ Add a regression test.
+
+2016-12-15 Michael Albinus <michael.albinus@gmx.de>
+
+ Check in tramp-tests.el, that environment variables are set correctly
+
+ * test/lisp/net/tramp-tests.el (tramp--test-check-files):
+ Check also, that environment variables are set correctly.
+
+2016-12-15 Dominique Quatravaux <dominique.quatravaux@epfl.ch> (tiny change)
+
+ Protect environment variables with double quotes in Tramp
+
+ * lisp/net/tramp-sh.el (tramp-open-connection-setup-interactive-shell):
+ Protect environment variables with double quotes.
+
+2016-12-15 Tino Calancha <tino.calancha@gmail.com>
+
+ * lisp/ibuf-macs.el (define-ibuffer-filter): Wrap ,@body in a progn.
+
+2016-12-15 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/image-dired.el (image-dired-create-thumb): Create parent directories.
+
+2016-12-14 Mark Oteiza <mvoteiza@udel.edu>
+
+ * lisp/image-mode.el (image-mode-winprops-alist): Add docstring.
+
+2016-12-14 Mark Oteiza <mvoteiza@udel.edu>
+
+ Recognize pngnq or pngnq-s9
+
+ * lisp/image-dired.el (image-dired-cmd-pngnq-program): Also consider
+ pngnq-s9 as a possible executable.
+
+2016-12-14 Mark Oteiza <mvoteiza@udel.edu>
+
+ Update standard image-dired thumbnail location
+
+ * lisp/image-dired.el (image-dired-thumb-name): Conform to the latest
+ standard: consider XDG_CACHE_HOME, falling back on ~/.cache.
+
+2016-12-14 Mark Oteiza <mvoteiza@udel.edu>
+
+ Reset window scroll when displaying an image
+
+ When viewing a large image full size and scrolling, for instance, to
+ the lower right corner, then selecting a much smaller image in the
+ thumbnail buffer, the window stays scrolled so the new image is out of
+ the window. One must scroll back to the "origin" to view the new
+ displayed image, or just kill the image-dired-display-image buffer and
+ try again. This fixes the issue.
+ * lisp/image-dired.el (image-dired-display-window-width):
+ (image-dired-display-window-height): Operate on a window as argument.
+ (image-dired-display-image): Bind (image-dired-display-window) and use
+ it. Set window vscroll and hscroll to zero when refreshing the
+ buffer's contents.
+
+2016-12-14 Mark Oteiza <mvoteiza@udel.edu>
+
+ More image-dired polish
+
+ * lisp/image-dired.el (image-dired-file-name-at-point): New function.
+ (image-dired-thumbnail-mode, image-dired-display-image-mode): Disable
+ undo list. Add image-dired-file-name-at-point to
+ file-name-at-point-functions to facilitate find-file and friends.
+ (image-dired-thumbnail-display-external):
+ (image-dired-dired-display-external): Use start-process instead, to
+ avoid needlessly blocking and using a shell.
+
+2016-12-13 Phillip Lord <phillip.lord@russet.org.uk>
+
+ Replace ldefs-boot with a much smaller file
+
+ * Makefile.in (bootstrap-build,generate-ldefs-boot): New targets.
+ (bootstrap): Depend on bootstrap-build.
+ * admin/ldefs-clean.el: New file.
+ * lisp/Makefile.in (compile-first): Depend on loaddefs.el
+ * lisp/ldefs-boot.el: Remove.
+ * lisp/ldefs-boot-auto.el: New file.
+ * lisp/ldefs-boot-manual.el: New file.
+ * lisp/loadup.el: Load ldefs-boot-manual.el.
+ * src/emacs.c (generating_ldefs_boot): New variable.
+ (main): Check whether we are generating ldefs.
+ * src/eval.c (autoload-do-load): Dump autoload forms to stderr when
+ requested.
+ * src/lisp.h (generating_ldefs_boot): New variable.
+ * admin/gitmerge.el, admin/make-tarball.txt, admin/notes/copyright,
+ lisp/Makefile.in, lisp/cus-dep.el, lisp/emacs-lisp/elint.el,
+ lisp/finder.el, lisp/loadup.el, msdos/mainmake.v2: Update reference to
+ ldefs-boot.
+ * admin/update_autogen: Alter mechanism for ldefs-boot generation.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove support for aspell < 0.60 (from 2004)
+
+ lisp/textmodes/ispell.el (ispell-check-version): Require Aspell 0.60.
+ (ispell-aspell-dictionary-alist): Remove check that we have Aspell 0.60.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Minor docstring and comment fixes to ispell.el
+
+ lisp/textmodes/ispell.el (ispell-aspell-dictionary-alist): Mention
+ ispell-aspell-dictionary-alist, not ispell-dictionary-alist.
+ (ispell-set-spellchecker-params): Change double-single quotes to
+ single single quotes in comment.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove unused variable
+
+ * lisp/textmodes/ispell.el (current-ispell-directory): Remove.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs-specific ispell-with-no-warnings
+
+ * lisp/textmodes/ispell.el (ispell-with-no-warnings): Remove this
+ defmacro, needed only for XEmacs.
+ (ispell-command-loop, ispell-message): Use with-no-warnings directly.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove meaningless defconst ispell-version
+
+ * lisp/textmodes/ispell.el (ispell-version): Since ispell.el is now
+ firmly part of Emacs, and the version hasn’t changed since 2003, and
+ isn’t used anywhere, remove it. 3rd-party code can better use the
+ Emacs version, or feature or function checks.
+ (ispell-check-version): No longer report ispell.el version.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove boundp test for always-bound symbol
+
+ * lisp/textmodes/ispell.el (ispell-message): mail-yank-prefix is
+ defvar’d at the top of the file, so remove a test to see if it is
+ bound.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove support for ispell < 3.1.12
+
+ * lisp/textmodes/ispell.el (ispell-offset): Remove.
+ (ispell-check-version): Require ispell >= 3.1.12, released in 1994.
+ (ispell-process-line): No longer use ispell-offset.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove unused constant
+
+ * lisp/textmodes/ispell.el (ispell-required-version): Remove.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove support for old versions of supercite and GNUS from ispell.el
+
+ * lisp/textmodes/ispell.el (ispell-message): Require supercite >= 3.0
+ and GNUS >= 5. Not exactly the bleeding edge!
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove remaining mentions of XEmacs from ispell.el
+
+ * lisp/textmodes/ispell.el (ispell-valid-dictionary-list):
+ (ispell-add-per-file-word-list): Remove mentions of XEmacs from
+ comments.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs-specific minibuffer handling code from ispell.el
+
+ * lisp/textmodes/ispell.el (ispell-init-process): Assume we are not in
+ XEmacs.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs-specific horizontal scrollbar handling in ispell.el
+
+ * lisp/textmodes/ispell.el (ispell-command-loop): Remove
+ XEmacs-specific code.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs-specific code dealing with enable-multibyte-characters
+
+ * lisp/textmodes/ispell.el (ispell-decode-string):
+ (ispell-init-process): Remove XEmacs-specific guard.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs-specific code from ispell.el
+
+ * lisp/textmodes/ispell.el (ispell-menu-xemacs): Remove
+ (ispell-menu-map-needed): Remove XEmacs-specific check.
+ (ispell-word): Remove XEmacs-specific extent code.
+ (ispell-init-process): Remove XEmacs workaround for local add-hook.
+ Assume we have set-process-query-on-exit-flag.
+ (ispell-kill-ispell, ispell-change-dictionary): Remove XEmacs
+ workaround for called-interactively-p.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove some commented-out code
+
+ lisp/textmodes/ispell.el (ispell-process)
+ ispell-valid-dictionary-list): Remove commented-out code.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove XEmacs and old Emacs highlighting code
+
+ * lisp/textmodes/ispell.el
+ (ispell-highlight-spelling-error-xemacs): Remove.
+ (ispell-highlight-spelling-error): Assume display-color-p exists.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Assume Emacs supports [:alpha:] in regexps
+
+ * lisp/textmodes/ispell.el (ispell-emacs-alpha-regexp): Remove.
+ (ispell-set-spellchecker-params): Remove tests of
+ ispell-emacs-alpha-regexp.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove some XEmacs-specific code from ispell.el
+
+ * lisp/textmodes/ispell.el: Remove XEmacs menubar setup.
+ (ispell-int-char): Remove.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Generalize over-specific documentation
+
+ * lisp/textmodes/ispell.el (ispell-personal-dictionary): Rather than
+ document precise personal wordlist filenames for only two supported
+ spelling checkers, simply say that the default personal dictionary
+ depends on the chosen spelling checker. The user can check the
+ spelling checker’s documentation if necessary. This is simpler, and
+ works for other supported (and future, or unknown) spelling checkers.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove tests for built-in functions
+
+ * lisp/textmodes/ispell.el (buffer-substring-no-properties): Remove
+ back-up definition.
+ (ispell-add-per-file-word-list): Remove tests for comment-padright and
+ comment-normalize-vars.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove unused ispell-looking-back
+
+ * lisp/textmodes/ispell.el (ispell-looking-back): Remove unused alias.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Assume we have version<= for checking ispell version
+
+ * lisp/textmodes/ispell.el (ispell-check-minver): Remove.
+ (ispell-check-version): Use version<= directly.
+
+2016-12-13 Reuben Thomas <rrt@sc3d.org>
+
+ Remove ispell.el pre-GNU Emacs comments
+
+ * lisp/textmodes/ispell.el (Commentary): Remove original maintainer
+ details, as Emacs version, bug report address and so forth should be
+ used instead for this version. Remove in-line change history; use
+ git instead.
+
+2016-12-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ More small fixes for image-dired
+
+ * lisp/image-dired.el: Fix commentary to refer to correct Emacs manual
+ node.
+ (image-dired--with-db-file): Add declare forms.
+ (image-dired-hidden-p): Rewrite with cl-loop. It's not necessary to
+ run through the whole list.
+
+2016-12-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Remove image-dired-kill-buffer-and-window
+
+ This breaks window layout, especially when quitting a
+ image-dired-display-image-mode buffer.
+ * lisp/image-dired.el (image-dired-thumbnail-mode-map):
+ (image-dired-display-image-mode-map): Replace in keymap and menu items
+ bindings to image-dired-kill-buffer-and-window with quit-window.
+ (image-dired-kill-buffer-and-window): Remove.
+
+2016-12-13 Mark Oteiza <mvoteiza@udel.edu>
+
+ Replace image-dired-setup-dired-keybindings with a minor mode
+
+ * lisp/image-dired.el (image-dired-thumbnail-mode): Fix docstring to
+ remove mention of nonexistent image-dired-dired and to refer to the
+ new minor mode.
+ (image-dired-minor-mode-map): New keymap assimilated from
+ image-dired-setup-dired-keybindings. In the future, the keymap parent
+ should be removed, and perhaps also the duplicate bindings that
+ already exist in dired-mode-map.
+ (image-dired-setup-dired-keybindings): Remove. Replace with an
+ obsolete function alias.
+ (image-dired-minor-mode): New minor mode, assuming the role of
+ image-dired-setup-dired-keybindings.
+
+2016-12-13 Paul Eggert <eggert@cs.ucla.edu>
+
+ * test/src/regex-resources/PTESTS: Convert to UTF-8.
+
+2016-12-13 Noam Postavsky <npostavs@gmail.com>
+
+ Clarify thread-signal semantics
+
+ * doc/lispref/threads.texi (Basic Thread Functions): Explain that the
+ thread will be signaled as soon as possible.
+
+2016-12-13 Noam Postavsky <npostavs@gmail.com>
+
+ Clean up var watcher disabling on thread switching
+
+ * src/data.c (Fset_default): Move code into new C level function,
+ `set_default_internal'.
+ (set_default_internal): New function, like `Fset_default' but also takes
+ additional bindflag parameter.
+ (set_internal): Only call `notify_variable_watchers' if bindflag is not
+ SET_INTERNAL_THREAD_SWITCH.
+ * src/eval.c (do_specbind, do_one_unbind): Add bindflag parameter,
+ passed on to set_internal and set_default_internal. Adjust callers.
+ (rebind_for_thread_switch, unbind_for_thread_switch): Pass
+ SET_INTERNAL_THREAD_SWITCH to do_specbind, do_one_unbind instead of
+ temporarily adjusting symbol's trapped_write field.
+
+2016-12-13 Glenn Morris <rgm@gnu.org>
+
+ Minor fix for define-derived-mode
+
+ * lisp/emacs-lisp/derived.el (define-derived-mode):
+ Do not let eg eval-defun reset the values of syntax or abbrev tables,
+ since they might have been defined externally. (Bug#16160)
+
+2016-12-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ * build-aux/git-hooks/pre-commit: Add whitespace comment.
+
+2016-12-12 Clément Pit--Claudel <clement.pitclaudel@live.com>
+
+ Move backtrace to ELisp using a new mapbacktrace primitive
+
+ * src/eval.c (get_backtrace_starting_at, backtrace_frame_apply)
+ (Fmapbacktrace, Fbacktrace_frame_internal): New functions.
+ (get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'.
+
+ * lisp/subr.el (backtrace--print-frame): New function.
+ (backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'.
+ (backtrace-frame): Reimplement using `backtrace-frame--internal'.
+
+ * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a base to
+ `mapbacktrace' instead of searching for "(debug" in the output of
+ `backtrace'.
+
+ * test/lisp/subr-tests.el (subr-test-backtrace-simple-tests)
+ (subr-test-backtrace-integration-test): New tests.
+
+ * doc/lispref/debugging.texi (Internals of Debugger): Document
+ `mapbacktrace' and missing argument BASE of `backtrace-frame'.
+
+2016-12-12 Paul Eggert <eggert@cs.ucla.edu>
+
+ Use C99 syntax for font drivers
+
+ Problem reported by Daniel Colascione in:
+ https://lists.gnu.org/r/emacs-devel/2016-12/msg00515.html
+ * src/ftcrfont.c (ftcrfont_driver):
+ * src/ftfont.c (ftfont_driver):
+ * src/ftxfont.c (ftxfont_driver):
+ * src/macfont.m (macfont_driver):
+ * src/nsfont.m (nsfont_driver):
+ * src/xfont.c (xfont_driver):
+ * src/xftfont.c (xftfont_driver):
+ Use C99 syntax, not the old GNU C syntax.
+
+2016-12-12 Glenn Morris <rgm@gnu.org>
+
+ Obsolete gs.el
+
+ * lisp/gs.el: Move to lisp/obsolete. (Bug#1524)
+ * doc/lispref/display.texi (Image Formats): Remove postscript.
+ (PostScript Images): Remove section.
+ * doc/lispref/elisp.texi: Update menu.
+
+2016-12-12 Glenn Morris <rgm@gnu.org>
+
+ Un-revert recent Ffset change
+
+ * src/data.c (Ffset): Reinstate the check for "nil".
+
+2016-12-12 Glenn Morris <rgm@gnu.org>
+
+ Minor advice.el fix
+
+ * lisp/emacs-lisp/advice.el (ad-preactivate-advice):
+ Avoid setting the function definition of nil.
+ This was happening during bootstrap of org-compat.el,
+ apparently due to eager macro expansion of code behind
+ a (featurep 'xemacs) test.
+
+2016-12-12 Eli Zaretskii <eliz@gnu.org>
+
+ Make etags-tests work in out-of-tree builds
+
+ * test/lisp/progmodes/etags-tests.el (etags-bug-158)
+ (etags-bug-23164): Make them work in an out-of-tree build.
+ Reported by Ken Brown <kbrown@cornell.edu>.
+
+2016-12-12 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid crashing if a new thread is signaled right away
+
+ * src/thread.c (post_acquire_global_lock): Don't raise the pending
+ signal if the thread's handlers were not yet set up, as that will
+ cause Emacs to exit with a fatal error. This can happen if a
+ thread is signaled as soon as make-thread returns, before the new
+ thread had an opportunity to acquire the global lock, set up the
+ handlers, and call the thread function.
+
+ * test/src/thread-tests.el (thread-signal-early): New test.
+
+2016-12-12 Eli Zaretskii <eliz@gnu.org>
+
+ Fix point motion in cloned buffers
+
+ * src/thread.c (post_acquire_global_lock): Call
+ set_buffer_internal_2 instead of tricking set_buffer_internal_1
+ into resetting the current buffer even if it didn't change. This
+ avoids bug#25165, caused by failing to record the modified values
+ of point and mark, because current_buffer was set to NULL. Also,
+ don't bother re-setting the buffer if there was no thread switch,
+ as that just wastes cycles.
+ * src/buffer.c (set_buffer_internal_2): New function, with most of
+ the body of set_buffer_internal_1, but without the test for B
+ being identical to the current buffer.
+ (set_buffer_internal_1): Call set_buffer_internal_2 if B is not
+ identical to the current buffer.
+ * src/buffer.h (set_buffer_internal_2): Add prototype.
+
+ * test/src/thread-tests.el (thread-sticky-point): New test.
+
+2016-12-12 Michael Albinus <michael.albinus@gmx.de>
+
+ Further improvements in Tramp's file name unquoting
+
+ * lisp/net/tramp-adb.el (tramp-adb-handle-file-local-copy)
+ (tramp-adb-handle-write-region): Unquote localname.
+ (tramp-adb-handle-copy-file): Implement direct copy on remote device.
+ (tramp-adb-handle-rename-file): Quote arguments, add "-f" to force.
+
+ * lisp/net/tramp.el (tramp-file-name-unquote-localname): New defun.
+ (tramp-handle-file-name-case-insensitive-p):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-get-file-attributes)
+ (tramp-gvfs-connection-mounted-p, tramp-gvfs-mount-spec)
+ (tramp-gvfs-maybe-open-connection):
+ * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name):
+ * lisp/net/tramp-smb.el (tramp-smb-get-share)
+ (tramp-smb-get-localname): Use it.
+
+ * test/lisp/net/tramp-tests.el (tramp--test-docker-p): New defun.
+ (tramp--test-special-characters, tramp-test34-utf8)
+ (tramp-test34-utf8-with-stat, tramp-test34-utf8-with-perl)
+ (tramp-test34-utf8-with-ls): Use it.
+
+2016-12-12 Martin Rudalics <rudalics@gmx.at>
+
+ Strengthen conditions for resizing sibling windows (Bug#25169)
+
+ * lisp/window.el (window-resize, delete-window): Resize other siblings
+ only if `window-combination-resize' equals t (Bug#25169).
+
+2016-12-12 Noam Postavsky <npostavs@gmail.com>
+
+ Quote filenames containing '~' in prompts
+
+ When in a directory named '~', the default value given by
+ `read-file-name' should be quoted by prepending '/:', in order to
+ prevent it from being interpreted as referring to the $HOME
+ directory (Bug#16984).
+
+ * lisp/minibuffer.el (minibuffer-maybe-quote-filename): New function.
+ (completion--sifn-requote, read-file-name-default): Use it instead of
+ `minibuffer--double-dollars'.
+ * test/lisp/files-tests.el (files-test-read-file-in-~): Test it.
+
+2016-12-11 Eli Zaretskii <eliz@gnu.org>
+
+ Undo part of last change
+
+ * src/thread.h:
+ * src/keyboard.c:
+ * src/keyboard.h: Undo part of last change:
+ input_available_clear_time is again a global variable.
+
+2016-12-11 Eli Zaretskii <eliz@gnu.org>
+
+ Avoid aborts when a thread signals an error
+
+ * src/thread.h (struct thread_state): Add members
+ m_waiting_for_input and m_input_available_clear_time.
+ (waiting_for_input, input_available_clear_time): New macros.
+ * src/keyboard.c (waiting_for_input, input_available_clear_time):
+ Remove; they are now macros that reference the current thread.
+ (Bug#25171)
+ * src/w32select.c: Don't include keyboard.h.
+
+ * test/src/thread-tests.el (thread-errors): New test.
+
+2016-12-11 Philipp Stephani <phst@google.com>
+
+ Clean up compile-tests.el
+
+ Switch to lexical binding. Make checkdoc happy.
+
+ * test/lisp/progmodes/compile-tests.el (compile--test-error-line)
+ (compile-test-error-regexps): Instead of checking a single Boolean
+ value, use `should' for each attribute of the message to be compared.
+ (compile-tests--test-regexps-data): Document sixth list element
+ TYPE.
+
+2016-12-11 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix Bug#25162
+
+ * doc/emacs/files.texi (Reverting): Document
+ auto-revert-remote-files and auto-revert-verbose.
+
+ * lisp/autorevert.el (auto-revert-verbose, auto-revert-mode)
+ (auto-revert-tail-mode, global-auto-revert-mode): Fix docstring.
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Fix a typo in define-abbrev-table
+
+ * lisp/abbrev.el (define-abbrev-table): Fix typo in docstring handling.
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Improve previous cperl-mode change
+
+ * lisp/progmodes/cperl-mode.el (cperl-mode-abbrev-table):
+ Improve previous change.
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Mark default cperl abbrevs as system ones
+
+ * lisp/progmodes/cperl-mode.el (cperl-mode):
+ Mark our abbrevs as system ones. (Bug#10934)
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Revert earlier Ffset change
+
+ * src/data.c (Ffset): Allow nil again, since it caused
+ eager macro-expansion failures.
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Tweaks for message bogus address detection
+
+ * lisp/gnus/message.el (message-bogus-recipient-p):
+ Do not require "@", since some mailers deliver to local addresses
+ without one. (Bug#23054)
+ Move "@.*@" from here...
+ (message-bogus-addresses): ...to here, so it can be customized.
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Do not allow nil to be defined as a function
+
+ * lisp/emacs-lisp/byte-run.el (defun):
+ * src/data.c (Ffset): Do not allow "nil". (Bug#25110)
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Bump makeinfo requirement from 4.7 to 4.13
+
+ * configure.ac: Bump makeinfo version requirement from 4.7 to 4.13.
+ We need at least 4.8, and that may be buggy, so go for the last
+ of the 4 series, which is 8 years old. (Bug#25108)
+
+2016-12-11 Glenn Morris <rgm@gnu.org>
+
+ Fixes related to select-enable-clipboard
+
+ * lisp/menu-bar.el (clipboard-yank, clipboard-kill-ring-save)
+ (clipboard-kill-region):
+ * lisp/eshell/esh-io.el (eshell-virtual-targets)
+ (eshell-clipboard-append):
+ Replace option gui-select-enable-clipboard with
+ select-enable-clipboard; renamed October 2014. (Bug#25145)
+
+2016-12-11 Nicolas Richard <theonewiththeevillook@yahoo.fr>
+
+ Add some sanity checking of defun arglist
+
+ * lisp/emacs-lisp/byte-run.el (defun):
+ Check for malformed argument lists. (Bug#15715)
+
+2016-12-11 Matt Armstrong <marmstrong@google.com> (tiny change)
+
+ Minor shell-mode fix for zsh
+
+ * lisp/shell.el (shell-mode): Prevent shell-dirstack-query
+ becoming confused by zsh abbreviations. (Bug#24632)
+
+2016-12-10 Noam Postavsky <npostavs@gmail.com>
+
+ Define struct predicate before acccesors
+
+ The accessor functions use the predicate function, which causes problems
+ when reloading after unload-feature: the compiler-macro property is
+ still present on the predicate symbol, and the compiler fails to find
+ the definition when trying to inline it into the accessor
+ function (Bug#25088).
+
+ * lisp/emacs-lisp/cl-macs.el (cl-defstruct): Move predicate definition
+ before field accessor definitions.
+
+2016-12-10 Andreas Schwab <schwab@linux-m68k.org>
+
+ * Makefile.in (install-etc): Don't prepend $(DESTDIR) to commands in
+ system unit file.
+
+2016-12-10 Eli Zaretskii <eliz@gnu.org>
+
+ Support concurrency in Emacs Lisp
+
+ Merge branch 'test-concurrency'
+
+ * src/thread.c:
+ * src/thread.h:
+ * src/systhread.c:
+ * src/systhread.h: New files.
+ * src/xgselect.c (xg_select): Avoid using SAFE_NALLOCA and use
+ xnmalloc unconditionally.
+ * src/window.c (struct save_window_data): Rename current_buffer to
+ f_current_buffer.
+ * src/w32proc.c (sys_select): Change the function signature to
+ closer fit 'pselect' on Posix hosts.
+ * src/search.c:
+ * src/regex.h: Convert some globals to macros that reference
+ thread-specific values.
+ * src/process.c (pset_thread, add_non_keyboard_read_fd)
+ (add_process_read_fd, add_non_blocking_write_fd)
+ (recompute_input_desc, compute_input_wait_mask)
+ (compute_non_process_wait_mask, compute_non_keyboard_wait_mask)
+ (compute_write_mask, clear_waiting_thread_info)
+ (update_processes_for_thread_death, Fset_process_thread)
+ (Fprocess_thread): New functions.
+ (enum fd_bits): New enumeration.
+ (fd_callback_data): Add 'thread' and 'waiting_thread', rename
+ 'condition' to 'flags'.
+ (set_process_filter_masks, create_process, create_pty)
+ (Fmake_serial_process, finish_after_tls_connection)
+ (connect_network_socket, deactivate_process)
+ (server_accept_connection, wait_reading_process_output)
+ (Fcontinue_process, Fstop_process, keyboard_bit_set)
+ (add_timer_wait_descriptor, add_keyboard_wait_descriptor)
+ (delete_keyboard_wait_descriptor): Use the new functions instead
+ of manipulating fd flags and masks directly.
+ (syms_of_process): Defsubr the new primitives.
+ * src/print.c (print_object): Print threads, mutexes, and
+ conditional variables.
+ * src/lisp.h (enum pvec_type): New values PVEC_THREAD, PVEC_MUTEX,
+ and PVEC_CONDVAR.
+ (XTHREAD, XMUTEX, XCONDVAR, THREADP, MUTEXP, CONDVARP)
+ (CHECK_THREAD, CHECK_MUTEX, CHECK_CONDVAR): New inline functions.
+ (XSETTHREAD, XSETMUTEX, XSETCONDVAR): New macros.
+ (struct handler): Add back byte_stack. Rename lisp_eval_depth to
+ f_lisp_eval_depth.
+ * src/eval.c (specpdl_kind, specpdl_arg, do_specbind)
+ (rebind_for_thread_switch, do_one_unbind)
+ (unbind_for_thread_switch): New functions.
+ (init_eval): 'handlerlist' is not malloc'ed.
+ (specbind): Call do_specbind.
+ (unbind_to): Call do_one_unbind.
+ (mark_specpdl): Accept 2 arguments.
+ (mark_specpdl): Mark the saved value in a let-binding.
+ * src/emacs.c (main): Call init_threads_once, init_threads, and
+ syms_of_threads.
+ * src/data.c (Ftype_of): Support thread, mutex, and condvar
+ objects.
+ (Fthreadp, Fmutexp, Fcondition_variable_p): New functions.
+ (syms_of_data): DEFSYM and defsubr new symbols and primitives.
+ * src/bytecode.c (struct byte_stack, FETCH, CHECK_RANGE)
+ (BYTE_CODE_QUIT): Add back.
+ (exec_byte_code): Add back byte stack manipulation.
+ * src/alloc.c (cleanup_vector): Handle threads, mutexes, and
+ conditional variables.
+ (mark_stack): Now extern; accept additional argument 'bottom'.
+ (flush_stack_call_func): New function.
+ (garbage_collect_1): Call mark_threads and unmark_threads. Don't
+ mark handlers.
+ * src/.gdbinit (xbytecode): Add back.
+
+ * test/src/thread-tests.el: New tests.
+ * test/src/data-tests.el (binding-test-manual)
+ (binding-test-setq-default, binding-test-makunbound)
+ (binding-test-defvar-bool, binding-test-defvar-int)
+ (binding-test-set-constant-t, binding-test-set-constant-nil)
+ (binding-test-set-constant-keyword)
+ (binding-test-set-constant-nil): New tests.
+
+ * doc/lispref/processes.texi (Processes and Threads): New
+ subsection.
+ * doc/lispref/threads.texi: New file
+ * doc/lispref/elisp.texi (Top): Include it.
+ * doc/lispref/objects.texi (Thread Type, Mutex Type)
+ (Condition Variable Type): New subsections.
+ (Type Predicates): Add thread-related predicates.
+ * doc/lispref/objects.texi (Editing Types):
+ * doc/lispref/elisp.texi (Top): Update higher-level menus.
+
+ * etc/NEWS: Mention concurrency features.
+
+2016-12-10 Eli Zaretskii <eliz@gnu.org>
+
+ Fix error messages in thread.c
+
+ * src/thread.c (lisp_mutex_unlock, Fcondition_wait)
+ (Fcondition_notify, Fthread_join): Fix error messages.
+
+2016-12-10 Eli Zaretskii <eliz@gnu.org>
+
+ Improve doc strings in thread.c
+
+ * src/thread.c (Fmake_condition_variable, Fcondition_wait)
+ (Fcondition_notify, Fcondition_mutex, Fcondition_name, Fmake_thread)
+ (Fthread_join, Fall_threads): Doc fixes.
+
+2016-12-10 Eli Zaretskii <eliz@gnu.org>
+
+ Fix building with check-lisp-object-type
+
+ * src/thread.c (mark_one_thread): Use NILP to compare with
+ m_saved_last_thing_searched, which is a Lisp object. Reported by
+ Andreas Politz <politza@hochschule-trier.de>.
+
+2016-12-10 Eli Zaretskii <eliz@gnu.org>
+
+ Documentation and commentary improvements
+
+ * src/lisp.h:
+ * src/regex.c:
+ * src/xgselect.c (xg_select): Improve commentary and formatting.
+
+ * doc/lispref/objects.texi (Thread Type, Mutex Type)
+ (Condition Variable Type): New subsections.
+ (Type Predicates): Add thread-related predicates.
+ * doc/lispref/objects.texi (Editing Types):
+ * doc/lispref/elisp.texi (Top): Update higher-level menus.
+
+2016-12-09 Michael Albinus <michael.albinus@gmx.de>
+
+ Fix further problems with quoted file names in Tramp
+
+ * lisp/net/tramp.el (tramp-quoted-name-p, tramp-quote-name)
+ (tramp-unquote-name): Move defsubst ...
+ * lisp/net/tramp-compat.el (tramp-compat-file-name-quoted-p)
+ (tramp-compat-file-name-quote)
+ (tramp-compat-file-name-unquote): ... here. Adapt callees.
+
+ * lisp/net/tramp-cache.el (tramp-flush-file-property)
+ (tramp-flush-directory-property):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-url-file-name):
+ * lisp/net/tramp-sh.el (tramp-make-copy-program-file-name):
+ * lisp/net/tramp-smb.el (tramp-smb-handle-copy-file)
+ (tramp-smb-handle-substitute-in-file-name)
+ (tramp-smb-get-share, tramp-smb-get-localname): Handle quoted files.
+
+2016-12-09 Eli Zaretskii <eliz@gnu.org>
+
+ *src/sysdep.c: Fix a comment.
+
+2016-12-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation error on Fedora 24
+
+ * src/sysdep.c [HAVE_H_ERRNO]: Remove declaration of h_errno.
+ Reported by Paul Eggert <eggert@cs.ucla.edu>.
+
+2016-12-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation warnings due to prototype of thread_select
+
+ * src/thread.h <int select_func>: Make the 5th and 6th arguments
+ be 'const'.
+ * src/process.c [WINDOWSNT]:
+ * src/w32proc.c: Make the 5th and 6th argument to sys_select be
+ 'const'.
+
+2016-12-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation on Debian GNU/Linux
+
+ * src/thread.h: Include sys/types.h, for ssize_t that regex.h
+ uses. Reported by Robert Marshall <robert.marshall@codethink.co.uk>.
+
+2016-12-09 Eli Zaretskii <eliz@gnu.org>
+
+ Fix subtle errors with let-binding of localized variables
+
+ * src/eval.c (do_specbind): Don't require a "symbol" that is
+ actually a cons cell, in order to call set-default, as there are
+ no longer such bindings. This makes do_specbind work like the
+ pre-concurrency implementation in specbind for bindings of
+ forwarded symbols. Use specpdl_kind to access the type of the
+ binding.
+ (specpdl_kind): New function.
+
+2016-12-09 Michael Albinus <michael.albinus@gmx.de>
+
+ Document file-name-quote, file-name-unquote and file-name-quoted-p
+
+ * doc/lispref/files.texi (File Name Expansion):
+ * etc/NEWS: Mention file-name-quote, file-name-unquote and
+ file-name-quoted-p.
+
+ * lisp/files.el (file-name-non-special): Revert using
+ file-name-quote, file-name-unquote and file-name-quoted-p.
+
+2016-12-09 Noam Postavsky <npostavs@gmail.com>
+
+ Fix bad quoting of python-shell-interpreter
+
+ `python-shell-calculate-command' was using `shell-quote-argument' as if
+ it was generating a shell command, but its callers don't pass the result
+ to a shell, and they expect to parse it with `split-string-and-unquote'.
+ This caused problems depending on the flavor of shell quoting in
+ effect (Bug#25025).
+
+ * lisp/progmodes/python.el (python-shell-calculate-command): Use
+ `combine-and-quote-strings' to quote the interpreter, so that it can be
+ parsed by `python-shell-make-comint' successfully using
+ `split-string-and-unquote'.
+
+2016-12-09 Paul Eggert <eggert@cs.ucla.edu>
+
+ * src/lisp.h (struct terminal): Remove unnecessary forward decl.
+
+2016-12-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Make read1 more reentrant
+
+ This is needed if ‘read’ is called soon after startup, before the
+ Unicode tables have been set up, and it reads a \N escape and
+ needs to look up a value the Unicode tables, a lookup that in turn
+ calls read1 recursively. Although this change doesn’t make ‘read’
+ fully reentrant, it’s good enough to handle this case.
+ * src/lread.c (read_buffer_size, read_buffer): Remove static vars.
+ (grow_read_buffer): Revamp to use locals, not statics, and to
+ record memory allocation un the specpdl. All callers changed.
+ (read1): Start with a stack-based buffer, and use the heap
+ only if the stack buffer is too small. Use unbind_to to
+ free any heap buffer allocated. Use bool for boolean.
+ Redo symbol loop so that only one call to grow_read_buffer
+ is needed.
+ (init_obarray): Remove no-longer-needed initialization.
+
+2016-12-08 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation warnings
+
+ * src/thread.c (Fmake_thread): Call emacs_abort, to avoid
+ compilation warning.
+
+2016-12-08 Paul Eggert <eggert@cs.ucla.edu>
+
+ Fix unlikely substitute-command-keys memory leak
+
+ * src/doc.c (Fsubstitute_command_keys):
+ Free buffer when unwinding.
+
+2016-12-08 Michael Albinus <michael.albinus@gmx.de>
+
+ Add file-name-quoted-p, file-name-quote, file-name-unquote
+
+ * lisp/files.el (file-name-quoted-p, file-name-quote)
+ (file-name-unquote): New defsubst.
+ (find-file--read-only, find-file-noselect)
+ (file-name-non-special): Use them.
+
+2016-12-08 Eli Zaretskii <eliz@gnu.org>
+
+ Add a NEWS entry.
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Minor fix for symbol-file
+
+ * lisp/subr.el (symbol-file): Avoid false matches with "require"
+ elements in load-history. (Bug#25109)
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Doc fix for vc-git
+
+ * lisp/vc/vc-git.el (vc-git-region-history): Add a doc string.
+
+2016-12-08 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix Bug#24962
+
+ * lisp/buff-menu.el (list-buffers--refresh):
+ List buffers with name starting with " " if they visit a file.
+ * test/lisp/buff-menu-tests.el (buff-menu-24962):
+ Update test result as pass.
+
+2016-12-08 Tino Calancha <tino.calancha@gmail.com>
+
+ ediff-fixup-patch-map: Improve prompt
+
+ * lisp/vc/ediff-ptch.el (ediff-fixup-patch-map):
+ Make clear in the prompt when we are applying a multi patch.
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Retain message logging in map-y-or-n-p
+
+ * lisp/emacs-lisp/map-ynp.el (map-y-or-n-p):
+ Stop disabling logging to Messages buffer. (Bug#13326)
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Doc fix for recent change
+
+ * lisp/simple.el (region-modifiable-p): Doc fix.
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Quieten make-dist default operation
+
+ * make-dist: Add --verbose option. Default to quieter operation.
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Further improve make-dist checking
+
+ * make-dist: Print status messages when checking.
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Improve previous make-dist change
+
+ * make-dist: Let make check the info files more thoroughly.
+
+2016-12-08 Glenn Morris <rgm@gnu.org>
+
+ Make make-dist --snapshot do some sanity checks
+
+ * make-dist: Snapshot mode no longer disables checks.
+ Checks now includes checks for freshness. (Bug#25084)
+ Checks now exits with an error if problems were found.
+
+2016-12-07 Tino Calancha <tino.calancha@gmail.com>
+
+ Fix regression introduced by commit 7b1e97f
+
+ * lisp/ibuf-ext.el (ibuffer-decompose-filter): Use cdr instead
+ of cadr; required after commit 20f5a5b.
+
+2016-12-07 Paul Eggert <eggert@cs.ucla.edu>
+
+ Put post-25 ChangeLog entries into ChangeLog.3
+
+ * ChangeLog.2: Copy from emacs-25 branch.
+ * ChangeLog.3: New file, with changes only in master.
+ * Makefile.in (CHANGELOG_HISTORY_INDEX_MAX): Bump from 2 to 3.
+
+2016-12-07 Eli Zaretskii <eliz@gnu.org>
+
+ Fix network streams.
+
+ The original code messed up flags in fd_callback_data[], and also
+ didn't call add_process_read_fd for process-related file descriptors.
+
+2016-12-07 Eli Zaretskii <eliz@gnu.org>
+
+ Minimize spurious diffs from master.
+
+2016-12-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the test suite
+
+ * test/automated/bindings.el: Contents moved to
+ test/src/data-tests.el.
+ * test/automated/threads.el: Moved to test/src/thread-tests.el.
+
+2016-12-06 Eli Zaretskii <eliz@gnu.org>
+
+ Fix a typo in bytecode.c.
+
+2016-12-05 Eli Zaretskii <eliz@gnu.org>
+
+ Fix compilation problems.
+
+ Fix merged code in process.c and eval.c.
+
+2016-12-04 Eli Zaretskii <eliz@gnu.org>
+
+ Merge branch 'concurrency'
+
+ Conflicts (resolved):
+ configure.ac
+ src/Makefile.in
+ src/alloc.c
+ src/bytecode.c
+ src/emacs.c
+ src/eval.c
+ src/lisp.h
+ src/process.c
+ src/regex.c
+ src/regex.h
+
+2015-11-02 Eli Zaretskii <eliz@gnu.org>
+
+ Fix the MS-Windows build
+
+ * src/thread.h [WINDOWSNT]: Include sys/socket.h.
+
+ * src/sysselect.h: Don't define fd_set and FD_* macros for
+ MS-Windows here.
+ * src/w32.h: Define them here.
+
+ * src/process.h (sys_select): Declare prototype.
+
+ * src/sysdep.c:
+ * src/process.c:
+ * src/filelock.c:
+ * src/emacs.c:
+ * src/callproc.c: Move inclusion of sys/select.h after lisp.h.
+ * nt/inc/socket.h: Include w32.h instead of sysselect.h
+
+2015-11-01 Ken Raeburn <raeburn@raeburn.org>
+
+ merge from trunk
+
+2013-10-19 Barry O'Reilly <gundaetiapo@gmail.com>
+
+ * src/eval.c (unbind_for_thread_switch): Fix iteration over the
+ specpdl stack.
+
+2013-10-18 Tom Tromey <tromey@redhat.com>
+
+ change condition-variablep to condition-variable-p
+
+2013-09-01 Eli Zaretskii <eliz@gnu.org>
+
+ Fix crashes when unbind_for_thread_switch signals an error.
+
+ src/eval.c (unbind_for_thread_switch): Accept a 'struct
+ thread_state *' argument and use specpdl_ptr and specpdl of that
+ thread. Fixes crashes if find_symbol_value signals an error.
+ src/thread.c (post_acquire_global_lock): Update current_thread
+ before calling unbind_for_thread_switch. Pass the previous thread
+ to unbind_for_thread_switch.
+
+2013-08-31 Eli Zaretskii <eliz@gnu.org>
+
+ Improve MS-Windows implementation of threads.
+
+ src/systhread.c (sys_cond_init): Set the 'initialized' member to
+ true only if initialization is successful. Initialize wait_count
+ and wait_count_lock.
+ (sys_cond_wait, sys_cond_signal, sys_cond_broadcast): If
+ 'initialized' is false, do nothing.
+ (sys_cond_wait): Fix the implementation to avoid the "missed
+ wakeup" bug: count the waiting threads, and reset the broadcast
+ event once the last thread was released.
+ (sys_cond_signal, sys_cond_broadcast): Use SetEvent instead of
+ PulseEvent. Don't signal the event if no threads are waiting.
+ (sys_cond_destroy): Only close non-NULL handles.
+ (sys_thread_create): Return zero if unsuccessful, 1 if successful.
+ src/systhread.h (w32thread_cond_t): New member 'initialized'.
+ Rename waiters_count and waiters_count_lock to wait_count and
+ wait_count_lock, respectively.
+
+2013-08-30 Eli Zaretskii <eliz@gnu.org>
+
+ Enable thread support in the MS-Windows build.
+
+ src/systhread.h (w32thread_critsect, w32thread_cond_t, sys_mutex_t)
+ (sys_cond_t, sys_thread_t) [WINDOWSNT]: New data types.
+ src/systhread.c (sys_mutex_init, sys_mutex_lock, sys_mutex_unlock)
+ (sys_mutex_destroy, sys_cond_init, sys_cond_wait)
+ (sys_cond_signal, sys_cond_broadcast, sys_cond_destroy)
+ (sys_thread_self, sys_thread_equal, w32_beginthread_wrapper)
+ (sys_thread_create, sys_thread_yield) [WINDOWSNT]: New functions.
+
+ configure.ac (THREADS_ENABLED): Enable threads for MinGW, even
+ if pthreads is not available.
+
+2013-08-27 Tom Tromey <tromey@redhat.com>
+
+ use condition-notify in the docs, not condition-signal
+
+ zap until-condition docs
+
+ zap until-condition
+
+ rename thread-blocker to thread--blocker
+
+ remove binding_symbol
+
+ fix style of threadp, mutexp, and condition-variable-p
+
+ make thread_check_current_buffer return bool
+
+ add a comment before flush_stack_call_func
+
+ fix whitespace_regexp warning
+
+2013-08-26 Eli Zaretskii <eliz@gnu.org>
+
+ Fix MS-Windows build.
+
+ src/callproc.c:
+ src/emacs.c:
+ src/filelock.c:
+ src/process.c:
+ src/sysdep.c:
+ src/w32.c: Reshuffle Windows-specific headers to avoid errors with
+ redefinition of fd_set etc.
+ src/process.c: Don't use num_pending_connects when
+ NON_BLOCKING_CONNECT is not defined.
+ src/sysselect.h: Move definitions of FD_* macros and of SELECT_TYPE
+ here from w32.h.
+ src/w32proc.c (sys_select): Adjust the argument types to what
+ thread.h expects.
+
+ nt/inc/sys/socket.h: Include stdint.h. Include sysselect.h instead
+ of w32.h.
+
+2013-08-26 Tom Tromey <tromey@redhat.com>
+
+ use record_unwind_protect_void, avoid warning
+
+ implement --enable-threads and a thread-less mode
+
+2013-08-25 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-08-20 Tom Tromey <tromey@redhat.com>
+
+ fix up some merge errors in process.c
+
+ remove a dead function
+ clean up a fixme I added in create_pty during the merge
+
+2013-08-20 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-07-26 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-07-13 Tom Tromey <tromey@redhat.com>
+
+ Merge from trunk
+
+2013-07-12 Tom Tromey <tromey@redhat.com>
+
+ Use thread_alive_p in a couple more spots
+
+2013-07-07 Tom Tromey <tromey@redhat.com>
+
+ fix xfree bug in run_thread
+
+ this fixes run_thread to account for the dummy slot
+ in specpdl
+
+2013-07-07 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+ this merges frmo trunk and fixes various build issues.
+ this needed a few ugly tweaks.
+ this hangs in "make check" now
+
+2013-07-06 Tom Tromey <tromey@redhat.com>
+
+ add assertion to flush_stack_call_func
+
+ functions called via flush_stack_call_func are assumed
+ to return with the global lock held again, and with
+ current_thread reset. this assertion verifies part of this
+
+2013-07-06 Tom Tromey <tromey@redhat.com>
+
+ call init_primary_thread from init_threads
+
+2013-07-05 Tom Tromey <tromey@redhat.com>
+
+ avoid SAFE_ALLOCA
+
+ avoid SAFE_ALLOCA in xgselect.c.
+ in this code it is just as easy to always use malloc;
+ and it avoids thread-switching problems, as the safe-alloca
+ stuff implicitly refers to the current thread
+
+2013-07-05 Tom Tromey <tromey@redhat.com>
+
+ avoid current_thread sometimes
+
+ this tweaks thread.c to use 'self' instead of current_thread
+ in a couple spots. this is clearer and more robust
+
+2013-07-05 Tom Tromey <tromey@redhat.com>
+
+ initialize saved_value
+
+ initialize the saved_value field in all needed cases
+ also, add an assertion to do_one_unbind
+
+2013-07-04 Tom Tromey <tromey@redhat.com>
+
+ fix buglet in test case
+
+2013-07-04 Tom Tromey <tromey@redhat.com>
+
+ unlink thread later
+
+ unlink thread from global list later
+ also remove some unnecessary destruction code
+
+2013-07-04 Tom Tromey <tromey@redhat.com>
+
+ introduce thread_alive_p macro
+
+ This introduces the thread_alive_p macro and changes
+ thread-alive-p to use it. This is a minor cleanup.
+ It also changes all-threads to ignore dead threads.
+
+2013-07-03 Tom Tromey <tromey@redhat.com>
+
+ Don't call unbind_for_thread_switch in run_thread
+
+ This removes the call to unbind_for_thread_switch from run_thread.
+ This isn't necessary because acquire_global_lock does it properly.
+
+2013-07-03 Tom Tromey <tromey@redhat.com>
+
+ remove unused field from struct thread_state
+
+ Fix a comment.
+
+2013-06-13 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-06-06 Tom Tromey <tromey@redhat.com>
+
+ fix a few latent issues in the thread patch
+
+ * we called unbind_for_thread_switch unconditionally, but this
+ is wrong if the previous thread exited
+ * likewise, exiting a thread should clear current_thread
+ * redundant assignment in run_thread
+ * clean up init_threads - no need to re-init the primary thread
+
+ This patch still sometimes causes weird hangs in "make check".
+ However, I think that is a kernel bug, since Emacs enters the zombie
+ state but its parent process hangs in wait. This shouldn't happen.
+
+2013-06-04 Tom Tromey <tromey@redhat.com>
+
+ update eval.c to make it build again after the merge
+
+2013-06-03 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk; clean up some issues
+
+2013-03-18 Tom Tromey <tromey@redhat.com>
+
+ don't let kill-buffer kill a buffer if it is current in any thread
+
+2013-03-18 Tom Tromey <tromey@redhat.com>
+
+ fix process bugs
+
+ Fix some process-related bugs, mostly thinkos from the conversion to
+ recording fd state as flags.
+ This now passes the test suite without hanging.
+
+2013-03-17 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-03-08 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-01-16 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2013-01-06 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+2012-12-23 Tom Tromey <tromey@redhat.com>
+
+ mention let bindings and lack of other ways to rewind
+
+2012-12-17 Tom Tromey <tromey@redhat.com>
+
+ Remove bit accidentally left over from the merge
+
+ merge from trunk
+
+2012-09-04 Tom Tromey <tromey@redhat.com>
+
+ merge from trunk
+
+ link from thread docs to match data
+
+2012-08-27 Tom Tromey <tromey@redhat.com>
+
+ cannot thread-join the current thread
+
+ fix test suite for condition-variable-p name change
+
+ add tests for variable bindings
+
+2012-08-25 Tom Tromey <tromey@redhat.com>
+
+ minor update to thread-join docs
+
+2012-08-24 Tom Tromey <tromey@redhat.com>
+
+ minor documentation updates
+
+2012-08-23 Tom Tromey <tromey@redhat.com>
+
+ document until-condition
+
+ first draft of threads documentation
+
+ rename condition-variablep to condition-variable-p
+
+ document process-thread and set-process-thread
+
+2012-08-20 Tom Tromey <tromey@redhat.com>
+
+ pass the thread name to the OS if possible
+
+ use prctl to pass the thread name to the OS, if possible
+
+2012-08-20 Tom Tromey <tromey@redhat.com>
+
+ add convenience macros with-mutex and until-condition
+
+ with-mutex is a safe way to run some code with a mutex held.
+ until-condition is a safe way to wait on a condition variable.
+
+2012-08-20 Tom Tromey <tromey@redhat.com>
+
+ Merge from trunk
+
+2012-08-19 Tom Tromey <tromey@redhat.com>
+
+ another docstring fixlet
+
+ minor docstring fixup
+
+ add condition-mutex and condition-name
+
+ ensure name of a thread is a string
+
+ ensure name of a mutex is a string
+
+ use NILP
+
+2012-08-19 Tom Tromey <tromey@redhat.com>
+
+ condition variables
+
+ This implements condition variables for elisp.
+ This needs more tests.
+
+2012-08-19 Tom Tromey <tromey@redhat.com>
+
+ comment fixes
+
+2012-08-19 Tom Tromey <tromey@redhat.com>
+
+ refactor systhread.h
+
+ This refactors systhread.h to move the notion of a "lisp mutex"
+ into thread.c. This lets us make make the global lock and
+ post_acquire_global_lock static.
+
+2012-08-17 Tom Tromey <tromey@redhat.com>
+
+ write docstrings for the thread functions
+
+ declare unbind_for_thread_switch and rebind_for_thread_switch in lisp.h
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ add test case for I/O switching
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ process changes
+
+ This changes wait_reading_process_output to handle threads better. It
+ introduces a wrapper for select that releases the global lock, and it
+ ensures that only a single thread can select a given file descriptor
+ at a time.
+
+ This also adds the thread-locking feature to processes. By default a
+ process can only have its output accepted by the thread that created
+ it. This can be changed using set-process-thread. (If the thread
+ exits, the process is again available for waiting by any thread.)
+
+ Note that thread-signal will not currently interrupt a thread blocked
+ on select. I'll fix this later.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ Prepare process.c for threads by not having global select masks.
+ The next step is to make it so selects can choose fds by thread.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ fix a latent bug in process.c
+
+ * src/process.c (wait_reading_process_output): Check Writeok bits,
+ not write_mask.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This adds thread-blocker, a function to examine what a thread is
+ blocked on. I thought this would be another nice debugging addition.
+
+ This adds names to mutexes. This seemed like a nice debugging
+ extension.
+
+ This adds some tests of the threading code.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This supplies the mutex implementation for Emacs Lisp.
+
+ A lisp mutex is implemented using a condition variable, so that we can
+ interrupt a mutex-lock operation by calling thread-signal on the
+ blocking thread. I did things this way because pthread_mutex_lock
+ can't readily be interrupted.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This adds most of the thread features visible to emacs lisp.
+
+ I roughly followed the Bordeaux threads API:
+
+ http://trac.common-lisp.net/bordeaux-threads/wiki/ApiDocumentation
+
+ ... but not identically. In particular I chose not to implement
+ interrupt-thread or destroy-thread, but instead a thread-signaling
+ approach.
+
+ I'm still undecided about *default-special-bindings* (which I did not
+ implement). I think it would be more emacs-like to capture the let
+ bindings at make-thread time, but IIRC Stefan didn't like this idea
+ the first time around.
+
+ There are one or two semantics issues pointed out in the patch where I
+ could use some advice.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This turns thread_state into a pseudovector and updates various bits
+ of Emacs to cope.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This introduces some new functions to handle the specpdl. The basic
+ idea is that when a thread loses the interpreter lock, it will unbind
+ the bindings it has put in place. Then when a thread acquires the
+ lock, it will restore its bindings.
+
+ This code reuses an existing empty slot in struct specbinding to store
+ the current value when the thread is "swapped out".
+
+ This approach performs worse than my previously planned approach.
+ However, it was one I could implement with minimal time and
+ brainpower. I hope that perhaps someone else could improve the code
+ once it is in.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This introduces the low-level system threading support. It also adds
+ the global lock. The low-level support is a bit over-eager, in that
+ even at the end of the present series, it will not all be used. I
+ think thiat is ok since I plan to use it all eventually -- in
+ particular for the emacs lisp mutex implementation.
+
+ I've only implemented the pthreads-based version. I think it should
+ be relatively clear how to port this to other systems, though.
+
+ I'd also like to do a "no threads" port that will turn most things
+ into no-ops, and have thread-creation fail. I was thinking perhaps
+ I'd make a future (provide 'threads) conditional on threads actually
+ working.
+
+ One other minor enhancement available here is to make it possible to
+ set the name of the new thread at the OS layer. That way gdb, e.g.,
+ could display thread names.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This parameterizes the GC a bit to make it thread-ready.
+
+ The basic idea is that whenever a thread "exits lisp" -- that is,
+ releases the global lock in favor of another thread -- it must save
+ its stack boundaries in the thread object. This way the boundaries
+ are always available for marking. This is the purpose of
+ flush_stack_call_func.
+
+ I haven't tested this under all the possible GC configurations.
+ There is a new FIXME in a spot that i didn't convert.
+
+ Arguably all_threads should go in the previous patch.
+
+2012-08-15 Tom Tromey <tromey@redhat.com>
+
+ This introduces a thread-state object and moves various C globals
+ there. It also introduces #defines for these globals to avoid a
+ monster patch.
+
+ The #defines mean that this patch also has to rename a few fields
+ whose names clash with the defines.
+
+ There is currently just a single "thread"; so this patch does not
+ impact Emacs behavior in any significant way.
+
2016-12-07 Paul Eggert <eggert@cs.ucla.edu>
Merge from origin/emacs-25
@@ -131,7 +28810,7 @@
* lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Fix docstring
so that it matches the actual implementation.
- See https://lists.gnu.org/archive/html/help-gnu-emacs/2016-04/msg00071.html
+ See https://lists.gnu.org/r/help-gnu-emacs/2016-04/msg00071.html
2016-12-07 Tino Calancha <tino.calancha@gmail.com>
@@ -193,10 +28872,13 @@
ibuffer: compare marks with EQ
- * lisp/ibuffer (ibuffer-update-title-and-summary, ibuffer-redisplay-current)
+ * lisp/ibuffer.el:
+ (ibuffer-update-title-and-summary)
+ (ibuffer-redisplay-current)
(ibuffer-buffer-name-face, ibuffer-unmark-all)
(ibuffer-count-deletion-lines, ibuffer-buffer-names-with-mark):
- Use 'eq' instead of 'char-equal' when comparing mark characters (Bug#25000).
+ Use 'eq' instead of 'char-equal' when comparing mark characters
+ (Bug#25000).
* test/lisp/ibuffer-tests.el (ibuffer-test-Bug25000):
Update test result as pass.
@@ -341,7 +29023,7 @@
Make TAB and M-TAB run widget-forward and widget-backward (bug#25091)
- * lisp/gnus/mm-decode (mm-convert-shr-links): Avoid `shr-next-link'
+ * lisp/gnus/mm-decode.el (mm-convert-shr-links): Avoid `shr-next-link'
and `shr-previous-link' so TAB and M-TAB run `widget-forward' and
`widget-backward' instead (bug#25091).
@@ -1081,7 +29763,7 @@
ash, lsh avoid code duplication
See discussion in:
- https://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00469.html
+ https://lists.gnu.org/r/emacs-devel/2016-11/msg00469.html
* src/data.c (ash_lsh_impl): New function.
(ash, lsh): Use it.
@@ -1138,7 +29820,7 @@
Allow user control of progress messages in cpp.el
- * progmodes/cpp.el (cpp-message-min-time-interval): New defcustom.
+ * lisp/progmodes/cpp.el (cpp-message-min-time-interval): New defcustom.
(cpp-progress-time): Use 'cpp-message-min-time-interval'. Improve
the doc string.
(cpp-highlight-buffer): Use 'cpp-progress-message' instead of
@@ -1216,7 +29898,7 @@
This option allows the user to specify where to place point after these
commands.
- * comint.el (comint-move-point-for-matching-input): New user option.
+ * lisp/comint.el (comint-move-point-for-matching-input): New user option.
(comint-previous-matching-input-from-input): Use user option.
2016-11-22 Michael Albinus <michael.albinus@gmx.de>
@@ -1302,7 +29984,7 @@
Fix another CANNOT_DUMP problem
Reported by Robert Pluim in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00468.html
+ https://lists.gnu.org/r/emacs-devel/2016-11/msg00468.html
* src/emacs.c (might_dump) [CANNOT_DUMP]: Move enum decl from here ...
* src/lisp.h: ... to here.
@@ -1342,7 +30024,7 @@
Fix undefined refs on some GNU/Linux hosts
Problem reported by Ken Raeburn in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00463.html
+ https://lists.gnu.org/r/emacs-devel/2016-11/msg00463.html
* src/emacs.c (heap_bss_diff) [CANNOT_DUMP]: Remove, as this is
not needed in the CANNOT_UNDUMP case. All uses removed. This
removes unwanted references to my_endbss and my_endbss_static,
@@ -1804,7 +30486,7 @@
Check for header-line-format instead.
* lisp/emulation/viper.el (viper-load-custom-file): Reference
major-mode instead.
- * lisp-mail-feedmail.el (feedmail-fill-to-cc-fill-column): Use
+ * lisp/mail/feedmail.el (feedmail-fill-to-cc-fill-column): Use
fill-column instead.
2016-11-15 Simen Heggestøyl <simenheg@gmail.com>
@@ -1844,9 +30526,9 @@
Update verilog-mode.el
- * verilog-mode.el (verilog-read-decls, verilog-calc-1): Fix
- "default clocking" indentation and preventing AUTOs from working,
- bug1084. Reported by Alan Morgan.
+ * lisp/progmodes/verilog-mode.el (verilog-read-decls)
+ (verilog-calc-1): Fix "default clocking" indentation and
+ preventing AUTOs from working, bug1084. Reported by Alan Morgan.
(verilog-diff-report): Fix `verilog-diff-report'
not returning bad status on differences, bug1087. Reported by
Eric Jackowski.
@@ -1920,7 +30602,7 @@
* lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection):
* lisp/net/tramp-gvfs.el (tramp-gvfs-maybe-open-connection):
- * lisp/net/lisp/net/tramp-sh.el (tramp-maybe-open-connection):
+ * lisp/net/tramp-sh.el (tramp-maybe-open-connection):
* lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Use it.
* test/lisp/files-x-tests.el: New file.
@@ -1930,7 +30612,7 @@
tabulated-list: extend truncation into next align-right column
See discussion on:
- https://lists.gnu.org/archive/html/emacs-devel/2016-10/msg01101.html
+ https://lists.gnu.org/r/emacs-devel/2016-10/msg01101.html
* lisp/emacs-lisp/tabulated-list.el
(tabulated-list--near-rows): New variable.
(tabulated-list-print, tabulated-list-set-col): Use it.
@@ -1953,7 +30635,7 @@
* lisp/international/mule.el (auto-coding-alist-lookup):
* lisp/files.el (file-truename):
(abbreviate-file-name, set-auto-mode, file-relative-name):
- * package.el (package-untar-buffer): Use
+ * lisp/emacs-lisp/package.el (package-untar-buffer): Use
'file-name-case-insensitive-p' instead of 'system-type' to test
case-insensitivity.
@@ -2254,7 +30936,7 @@
Fix references to long obsoleted functions/aliases
- * doc/lispintro/emacs-list-intro.texi (Miscellaneous):
+ * doc/lispintro/emacs-lisp-intro.texi (Miscellaneous):
* doc/misc/cl.texi (Conditionals):
* doc/misc/speedbar.texi (Major Display Modes): Use string-to-number,
not string-to-int.
@@ -3079,13 +31761,13 @@
Only two of the commands there were autoloaded, one of which is an
easter egg.
- * lisp/miscl.el (copy-from-above-command):
- * lisp/miscl.el (zap-up-to-char):
- * lisp/miscl.el (mark-beginning-of-buffer):
- * lisp/miscl.el (mark-end-of-buffer):
- * lisp/miscl.el (upcase-char):
- * lisp/miscl.el (forward-to-word):
- * lisp/miscl.el (backward-to-word):
+ * lisp/misc.el (copy-from-above-command):
+ * lisp/misc.el (zap-up-to-char):
+ * lisp/misc.el (mark-beginning-of-buffer):
+ * lisp/misc.el (mark-end-of-buffer):
+ * lisp/misc.el (upcase-char):
+ * lisp/misc.el (forward-to-word):
+ * lisp/misc.el (backward-to-word):
Add autoload cookie.
2016-10-22 Martin Rudalics <rudalics@gmx.at>
@@ -3148,7 +31830,7 @@
* lisp/info.el (Info-fontify-node): Don't fontify random numbers
in parentheses as if they were footnote references. See
- https://lists.gnu.org/archive/html/bug-texinfo/2016-10/msg00007.html
+ https://lists.gnu.org/r/bug-texinfo/2016-10/msg00007.html
for the details.
2016-10-20 Philipp Stephani <phst@google.com>
@@ -3157,7 +31839,7 @@
See Bug#24747.
- * progmodes/cc-mode-tests.el: Rename from cc-mode.el; fix typo in
+ * test/lisp/progmodes/cc-mode-tests.el: Rename from cc-mode.el; fix typo in
file-local variable; add comments to make checkdoc happy.
2016-10-20 Michael Albinus <michael.albinus@gmx.de>
@@ -3330,14 +32012,14 @@
use full time objects (lists) instead of floats when possible
- * midnight.el (midnight-buffer-display-time): Remove
+ * lisp/midnight.el (midnight-buffer-display-time): Remove
(clean-buffer-list): Use float time only for time comparison
2016-10-15 Sam Steingold <sds@gnu.org>
Save and restore buffer-display-time
- * desktop.el (desktop-locals-to-save): Add `buffer-display-time'
+ * lisp/desktop.el (desktop-locals-to-save): Add `buffer-display-time'
(desktop-read): Set `desktop-file-modtime' before loading the desktop file
(desktop-create-buffer): Adjust `buffer-display-time' for the downtime
@@ -3351,7 +32033,7 @@
bracketed paste for that buffer. If bracketed paste is inhiited for at
least one buffer in a terminal, it is disabled for the whole terminal.
- * term/xterm.el (xterm-inhibit-bracketed-paste-mode): New mode to
+ * lisp/term/xterm.el (xterm-inhibit-bracketed-paste-mode): New mode to
inhibit XTerm bracketed paste per buffer.
(xterm--buffer-terminals, xterm--update-bracketed-paste)
(xterm--bracketed-paste-possible, xterm--is-xterm): New helper
@@ -3361,7 +32043,7 @@
(terminal-init-xterm): Update bracketed paste status when
initializing an XTerm and on window configuration change.
- * term.el (term-char-mode, term-line-mode): Inhibit XTerm
+ * lisp/term.el (term-char-mode, term-line-mode): Inhibit XTerm
bracketed paste in char mode.
2016-10-15 Dima Kogan <dima@secretsauce.net>
@@ -3437,7 +32119,7 @@
Add test for Bug#24627
- * /test/lisp/thingatpt-tests.el (thing-at-point-bug24627): New test.
+ * test/lisp/thingatpt-tests.el (thing-at-point-bug24627): New test.
2016-10-12 Eli Zaretskii <eliz@gnu.org>
@@ -3633,7 +32315,7 @@
2016-10-05 Mark Oteiza <mvoteiza@udel.edu>
- * lisp/url-url-parse.el (url-generic-parse-url): Unquote macro URL argument.
+ * lisp/url/url-parse.el (url-generic-parse-url): Unquote macro URL argument.
2016-10-05 Mark Oteiza <mvoteiza@udel.edu>
@@ -3795,7 +32477,7 @@
Ibuffer: 'w' and 'B' default to buffer at current line
See discussion in:
- https://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00384.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00384.html
* lisp/ibuffer.el (ibuffer--near-buffers): New defun;
return buffers near current line.
* lisp/ibuf-ext.el (ibuffer-copy-buffername-as-kill): Use it.
@@ -3815,7 +32497,7 @@
dired-mark-extension: Unmark if called with C-u prefix
See discussion in #Bug2518 and:
- https://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00711.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00711.html
* lisp/dired-x.el (dired-mark-extension):
Update interactive calls: a prefix arg C-u unmark files;
a prefix C-u C-u prompt for MARKER-CHAR and mark files with it.
@@ -3838,7 +32520,7 @@
See this thread for discussion:
- https://lists.gnu.org/archive/html/emacs-devel/2016-09/threads.html#00329
+ https://lists.gnu.org/r/emacs-devel/2016-09/threads.html#00329
From: Karl Fogel
To: Emacs Devel
Subject: Question about intended behavior of 'insert-for-yank-1'.
@@ -3926,7 +32608,7 @@
Fix compatibility with macOS 10.12 pmset (bug#24537)
- * lisp/battery.el (battery-pmset): Recognise and ignore battery id if
+ * lisp/battery.el (battery-pmset): Recognize and ignore battery id if
present in output.
2016-09-30 Paul Eggert <eggert@cs.ucla.edu>
@@ -4361,7 +33043,7 @@
Define _GNU_SOURCE in files delaying config.h
Problem reported by Richard Copley in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00440.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00440.html
* src/w32.c, src/w32notify.c, src/w32proc.c (_GNU_SOURCE):
Define early.
@@ -4403,7 +33085,7 @@
Define _GNU_SOURCE in unexmacosx.c
Problem reported by Bob Halley in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00427.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00427.html
* src/unexmacosx.c (_GNU_SOURCE): Define if not already defined.
2016-09-16 Alan Mackenzie <acm@muc.de>
@@ -4602,7 +33284,7 @@
2016-09-12 Michal Nazarewicz <mina86@mina86.com>
- Fix compiler thinking width and height may be unitialised in frame.c
+ Fix compiler thinking width and height may be unitialized in frame.c
This fixes the following warning:
@@ -4618,7 +33300,7 @@
2016-09-12 Michal Nazarewicz <mina86@mina86.com>
- Fix compiler thinking tmpdir may be unitialised in emacsclient
+ Fix compiler thinking tmpdir may be unitialized in emacsclient
This fixes the following warning:
@@ -4644,7 +33326,7 @@
on each function using an external program: when the executable
is not available signal an error.
See discussion on:
- https://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00135.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00135.html
* lisp/image-dired.el (image-dired--check-executable-exists): New defun.
Throw and error when the executable arg is missing.
(image-dired-display-image, image-dired-rotate-thumbnail)
@@ -5081,7 +33763,7 @@
image-dired: Report when a necessary executable is not found
See discussion on:
- https://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00552.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00552.html
* lisp/image-dired.el (image-dired-cmd-rotate-original-program)
(image-dired-cmd-create-thumbnail-program)
(image-dired-cmd-create-temp-image-program)
@@ -5121,7 +33803,7 @@
* lisp/image.el (image-increase-size, image-decrease-size):
Compute a floating point division.
Problem reported in:
- https://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00067.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00067.html
2016-09-03 Robert Cochran <robert-git@cochranmail.com>
@@ -5206,14 +33888,14 @@
* nt/inc/ms-w32.h (execve) [MINGW_W64]: Make the prototype match
the GCC 6 builtin, to avoid warnings. For more details, see
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00721.html.
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00721.html.
2016-08-31 Paul Eggert <eggert@cs.ucla.edu>
Fix over-substitution of quotes on error
Problem reported by Tino Calancha in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-09/msg00000.html
+ https://lists.gnu.org/r/emacs-devel/2016-09/msg00000.html
* src/print.c (print_error_message):
Substitute quotes in errmsg only when gotten from a property.
@@ -5332,7 +34014,7 @@
See this thread for discussion:
- https://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00611.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00611.html
From: Karl Fogel <kfogel {_AT_} red-bean.com>
To: Emacs Development <emacs-devel {_AT_} gnu.org>
Subject: [PATCH] Have LaTeX mode use normal double quotes in comments.
@@ -5432,13 +34114,13 @@
* lisp/net/tramp-adb.el (tramp-adb-parse-device-names)
(tramp-adb-maybe-open-connection):
* lisp/net/tramp-cache.el (tramp-get-connection-property):
- * tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
+ * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch):
* lisp/net/tramp-gw.el (tramp-gw-gw-proc-sentinel)
(tramp-gw-aux-proc-sentinel, tramp-gw-open-connection):
- * tramp-sh.el (tramp-process-sentinel)
+ * lisp/net/tramp-sh.el (tramp-process-sentinel)
(tramp-sh-handle-file-notify-add-watch)
(tramp-maybe-open-connection):
- * lisp/net/lisp/net/lisp/net/tramp-smb.el (tramp-smb-action-with-tar)
+ * lisp/net/tramp-smb.el (tramp-smb-action-with-tar)
(tramp-smb-handle-copy-directory, tramp-smb-action-get-acl)
(tramp-smb-handle-process-file, tramp-smb-action-set-acl)
(tramp-smb-get-cifs-capabilities)
@@ -5452,7 +34134,7 @@
* src/keyboard.c (parse_solitary_modifier): If the argument SYMBOL
is not a symbol, don't try to recognize it. See
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00502.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00502.html
for the details.
* test/src/keymap-tests.el (keymap-where-is-internal-test): New
@@ -5565,7 +34247,7 @@
Rename option to shell-command-dont-erase-buffer
Suggested by Clément Pit--Claudel in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00487.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00487.html
* lisp/simple.el (shell-command-dont-erase-buffer):
(shell-command--save-pos-or-erase):
(shell-command--set-point-after-cmd):
@@ -5611,7 +34293,7 @@
* lisp/frame.el (delete-other-frames): Delete other frames on
FRAME's terminal instead of the current terminal. Delete
non-minibuffer-only surrogate frames too. See
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00467.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00467.html
* doc/lispref/frames.texi (Deleting Frames): Minor fixes for
docs of `delete-frame' and `frame-live-p'. Add entry for
`delete-other-frames'.
@@ -5791,7 +34473,7 @@
template declaration.
(c-inside-bracelist-p): Call c-looking-at-or-maybe-in-bracelist in place of
much inline code.
- (c-looking-at-inexpr-block): Amend so that it won't wrongly recognise an
+ (c-looking-at-inexpr-block): Amend so that it won't wrongly recognize an
initialization starting "({" as an in-expression block, by checking for
semicolons, as opposed to commas, separating elements inside it.
(c-guess-continued-construct): (CASE B-2): Recognize a brace-list-open by
@@ -5842,7 +34524,7 @@
(a frame with a root window plus a minibuffer window) and the
frame's minibuffer window for a minibuffer-less frame (a frame
whose minibuffer window is on another frame). See also:
- https://lists.gnu.org/archive/html/emacs-devel/2016-07/msg01259.html
+ https://lists.gnu.org/r/emacs-devel/2016-07/msg01259.html
* src/frame.c (make_frame, make_frame_without_minibuffer)
(make_minibuffer_frame): When assigning the frame's minibuffer
@@ -5931,7 +34613,7 @@
* lisp/server.el (server-reply-print): Fix check for truncated quote
sequence at end of message. Problem reported in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00101.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00101.html
2016-08-18 Eli Zaretskii <eliz@gnu.org>
@@ -6008,7 +34690,7 @@
Return a sublist of the attributes returned by 'file-attributes'.
Suggested by Ted Zlatanov in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg01195.html
+ https://lists.gnu.org/r/emacs-devel/2016-07/msg01195.html
2016-08-17 Michael Albinus <michael.albinus@gmx.de>
@@ -6048,7 +34730,7 @@
* doc/emacs/misc.texi (shell-command-not-erase-buffer):
Document this feature in the manual.
See discussion on:
- http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg00610.html
+ https://lists.gnu.org/r/emacs-devel/2016-07/msg00610.html
2016-08-16 Michael Albinus <michael.albinus@gmx.de>
@@ -6386,7 +35068,7 @@
This can happen with `revert-buffer' or sometimes `find-file', when the file
is already in a buffer, but the file has been changed outside of Emacs.
- * lisp/progmodes/cc-mode (c-after-change): When we detect a missing
+ * lisp/progmodes/cc-mode.el (c-after-change): When we detect a missing
invocation of c-before-change-functions, we assume the changed region is the
entire buffer, and call c-before-change explicitly before proceding.
@@ -6828,7 +35510,7 @@
Widen in certain low level CC Mode functions. This fixes bug #24148.
- * lisp/progmodes/cc-engine (c-state-semi-pp-to-literal)
+ * lisp/progmodes/cc-engine.el (c-state-semi-pp-to-literal)
(c-state-full-pp-to-literal): Widen around the functionality.
(c-parse-ps-state-below): Correct the order of save-excursion and
save-restriction.
@@ -6857,7 +35539,7 @@
a second time; although it doesn’t hurt, it’s not needed.
* src/sysdep.c [!HAVE_GNUTLS]: Don’t include gnutls/crypto.h,
as it may not be available. Problem reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00100.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00100.html
2016-08-03 Michal Nazarewicz <mina86@mina86.com>
@@ -6889,7 +35571,7 @@
Port to systems lacking GNUTLS_NONBLOCK
Problem reported by Colin Baxter in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00096.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00096.html
* src/gnutls.c (Fgnutls_boot): Don’t assume GNUTLS_NONBLOCK is defined.
2016-08-03 Paul Eggert <eggert@cs.ucla.edu>
@@ -7001,7 +35683,8 @@
2016-08-02 Stefan Monnier <monnier@iro.umontreal.ca>
- * cl-generic.el: Fix problems introduced by new load-history format
+ * lisp/emacs-lisp/cl-generic.el: Fix problems introduced by new
+ load-history format
* lisp/emacs-lisp/cl-generic.el (cl--generic-load-hist-format): New function.
(cl-generic-define-method, cl--generic-describe): Use it.
@@ -7128,7 +35811,7 @@
Don’t (require 'cl)
- * test/src/regex-test.el: Don’t (require 'cl).
+ * test/src/regex-tests.el: Don’t (require 'cl).
(regex-tests-PCRE): s/loop/cl-loop/
2016-08-02 Michal Nazarewicz <mina86@mina86.com>
@@ -7171,7 +35854,7 @@
* src/process.c (connect_network_socket):
Reverse sense of previous fix. Problem reported by Ken Brown in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-08/msg00004.html
+ https://lists.gnu.org/r/emacs-devel/2016-08/msg00004.html
2016-08-01 Glenn Morris <rgm@gnu.org>
@@ -7256,7 +35939,7 @@
* doc/misc/ses.texi (Printer functions): Split the node into 5
sub-nodes + add some extra documentation.
- (Various kinds of printer functions): Make an itemisation to
+ (Various kinds of printer functions): Make an itemization to
disintguish better the 3 types of printers, give an example of
lambda printer definition.
(Standard printer functions): Add documentation for ses-prin1
@@ -7292,8 +35975,8 @@
prompt the user to save it, so the customization is not lost on
restart.
- * gnus-srvr.el (gnus-server-toggle-cloud-method-server): Prompt to
- save the customization of `gnus-cloud-method'.
+ * lisp/gnus/gnus-srvr.el (gnus-server-toggle-cloud-method-server):
+ Prompt to save the customization of `gnus-cloud-method'.
2016-07-27 Ken Brown <kbrown@cornell.edu>
@@ -7344,7 +36027,8 @@
2016-07-25 Ted Zlatanov <tzz@lifelogs.com>
- * gnus-cloud.el (gnus-cloud-encode-data): Fix 'base64-gzip encoding.
+ * lisp/gnus/gnus-cloud.el (gnus-cloud-encode-data): Fix
+ 'base64-gzip encoding.
2016-07-25 Andrew Hyatt <ahyatt@gmail.com>
@@ -7365,7 +36049,7 @@
Fix ‘[[:cc:]]*literal’ regex failing to match ‘literal’ (bug#24020)
- The regex engine tries to optimise Kleene star by avoiding backtracking
+ The regex engine tries to optimize Kleene star by avoiding backtracking
when it can detect that star’s operand cannot match what follows it in
the pattern.
@@ -7379,7 +36063,7 @@
engine knows whatever would be put back into the string cannot possibly
match literal digit one so no backtracking will be attempted.
- In the regexes of the form ‘[[:CC:]]*X’, the optimisation can be applied
+ In the regexes of the form ‘[[:CC:]]*X’, the optimization can be applied
if the character class CC does not match character X. In the above
example, this holds because digit one is not in alpha character class.
@@ -7388,7 +36072,7 @@
that character classes do not match multibyte characters. For example,
it would incorrectly conclude that [[:alpha:]] doesn’t match ‘ż’.
- This, in turn, led to the aforementioned Kleene star optimisation being
+ This, in turn, led to the aforementioned Kleene star optimization being
incorrectly applied in patterns such as ‘[[:graph:]]*☠’ (which should
match ‘☠’ but doesn’t as can be tested by executing
(string-match-p "[[:graph:]]*☠" "☠")
@@ -7940,7 +36624,7 @@
2016-07-12 Stefan Monnier <monnier@iro.umontreal.ca>
- * cl-generic.el (cl-defmethod): Make docstring dynamic
+ * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Make docstring dynamic
* lisp/emacs-lisp/cl-generic.el (cl-defmethod): Make docstring dynamic.
(cl--generic-make-defmethod-docstring): New function for that.
@@ -7999,7 +36683,7 @@
* src/gtkutil.c (xg_hide_tip): New function.
(xg_hide_tooltip): Adjust to cancel GTK event loop timeout if needed.
* src/menu.c (Fx_popup_menu): Adjust call to Fx_hide_tip.
- * src/nsfns.c (toplevel): Remove 'tip_frame' leftover.
+ * src/nsfns.m (toplevel): Remove 'tip_frame' leftover.
* src/w32fns.c (unwind_create_tip_frame): Remove.
(w32_display_monitor_attributes_list)
(w32_display_monitor_attributes_list_fallback): Use FRAME_TOOLTIP_P.
@@ -8086,7 +36770,7 @@
Dired always read file system
- * dired.el (dired-always-read-filesystem): Add new option.
+ * lisp/dired.el (dired-always-read-filesystem): Add new option.
(dired-mark-files-containing-regexp): Use it (Bug#22694).
* doc/emacs/dired.texi: Mention it in the manual.
* test/lisp/dired-tests.el (dired-test-bug22694): Add test.
@@ -8289,8 +36973,8 @@
Copy buffer names to kill ring
- * ibuf-ext.el (ibuffer-copy-buffername-as-kill): New command.
- * lisp/ibuffer (ibuffer-mode-map): Bound it to 'B'.
+ * lisp/ibuf-ext.el (ibuffer-copy-buffername-as-kill): New command.
+ * lisp/ibuffer.el (ibuffer-mode-map): Bound it to 'B'.
;* etc/NEWS: Add entry for this new feature.
2016-07-07 Tino Calancha <tino.calancha@gmail.com>
@@ -8313,8 +36997,8 @@
Prevent NS event loop being re-entered (bug#11049)
- * nsterm.m (ns_read_socket, ns_select): Return -1 if already in event
- loop instead of aborting.
+ * src/nsterm.m (ns_read_socket, ns_select): Return -1 if already
+ in event loop instead of aborting.
2016-07-07 Alan Third <alan@idiocy.org>
@@ -8364,7 +37048,7 @@
* lisp/ibuffer.el (ibuffer-mode-map): 'ibuffer-mark-by-content-regexp'
just bound to '% g'.
As suggested in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg00165.html
+ https://lists.gnu.org/r/emacs-devel/2016-07/msg00165.html
2016-07-07 Tino Calancha <tino.calancha@gmail.com>
@@ -8519,11 +37203,11 @@
* configure.ac [USE_X_TOOLKIT]: Define X_TOOLKIT_EDITRES if
_XEditResCheckMessages is declared in X11/Xmu/Editres.h and may be
linked with -lXmu. This should work with any non-ancient Xmu library.
- * xfns.c (toplevel): Remove old cruft.
+ * src/xfns.c (toplevel): Remove old cruft.
(x_window) [USE_X_TOOLKIT]: Use X_TOOLKIT_EDITRES.
- * xterm.c (toplevel): Remove old cruft.
+ * src/xterm.c (toplevel): Remove old cruft.
(handle_one_xevent): Use X_TOOLKIT_EDITRES.
- * xterm.h (toplevel): Include X11/Xmu/Editres.h if X_TOOLKIT_EDITRES.
+ * src/xterm.h (toplevel): Include X11/Xmu/Editres.h if X_TOOLKIT_EDITRES.
2016-07-04 Michael Albinus <michael.albinus@gmx.de>
@@ -8573,7 +37257,7 @@
* src/process.c (wait_reading_process_output): Further fix for
typo introduced in 2015-07-06T02:19:13Z!eggert@cs.ucla.edu when
wait == INFINITY and got_output_end_time is invalid. See:
- http://bugs.gnu.org/23864#20
+ https://bugs.gnu.org/23864#20
2016-07-03 Alan Mackenzie <acm@muc.de>
@@ -8705,7 +37389,7 @@
strings which affect the stringiness of a piece of text. This fixes the
bug
reported in
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00695.html.
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00695.html.
* lisp/progmodes/cc-engine.el (c-truncate-semi-nonlit-pos-cache): new
defsubst.
@@ -8927,7 +37611,7 @@
Problem reported by Juliusz Chroboczek (Bug#17976)
and by Artur Malabarba (Bug#23620).
Patch from a suggestion by Andreas Schwab in:
- http://bugs.gnu.org/17976#39
+ https://bugs.gnu.org/17976#39
This patch is for non-MS-Windows platforms.
I don't know the situation on MS-Windows.
* src/process.c (connecting_status):
@@ -8951,7 +37635,7 @@
Fix GNUC_PREREQ for GCC 2.8.1 etc.
Problem reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00608.html
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00608.html
* src/conf_post.h (GNUC_PREREQ): Port to GCC versions like GCC
2.8.1 (1998), which come before GCC 3.0 and which have nonzero
patchlevel numbers.
@@ -8977,7 +37661,7 @@
Fix GNUC_PREREQ off-by-1 typo
Problem reported by Martin Rudalics in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00587.html
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00587.html
* src/conf_post.h (GNUC_PREREQ) [__GNUC_PATCHLEVEL__]:
Fix < vs <= typo.
@@ -9245,7 +37929,7 @@
* src/lread.c (Fload): Don't overwrite the last character of the
file name in FOUND with 'c', unless the file name ended in ".elc"
to begin with. Don't treat empty files as byte-compiled. See
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00463.html
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00463.html
for more details of the problem this caused.
2016-06-22 Eli Zaretskii <eliz@gnu.org>
@@ -9638,7 +38322,7 @@
Automatically detect whether .h file is C or C++
* lisp/progmodes/cc-mode.el (c-or-c++-mode): A new function which
- analyses contents of the buffer to determine whether it looks like C++
+ analyzes contents of the buffer to determine whether it looks like C++
source code and based on that enables c-mode or c++-mode.
(c-or-c++-mode--regexp): Regular expression which, when matches
a buffer, signals file is C++.
@@ -9661,7 +38345,8 @@
2016-06-15 Ted Zlatanov <tzz@lifelogs.com>
- * generic-x.el (ansible-inventory-generic-mode): Warn if value is missing
+ * lisp/generic-x.el (ansible-inventory-generic-mode): Warn if
+ value is missing
2016-06-15 Tim Chambers <tbc@alum.mit.edu> (tiny change)
@@ -9675,7 +38360,7 @@
* src/xfns.c (x_get_monitor_attributes_xrandr): Use #if, not #ifdef.
This ports to systems that predate xrandr 1.3. See Christian Lynbech in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-06/msg00198.html
+ https://lists.gnu.org/r/emacs-devel/2016-06/msg00198.html
2016-06-14 Paul Eggert <eggert@cs.ucla.edu>
@@ -10030,7 +38715,7 @@
Replace IF_LINT by NONVOLATILE and UNINIT
- Inspired by a suggestion from RMS in: http://bugs.gnu.org/23640#58
+ Inspired by a suggestion from RMS in: https://bugs.gnu.org/23640#58
* .dir-locals.el (c-mode): Adjust to macro changes.
* src/conf_post.h (NONVOLATILE, UNINIT): New macros (Bug#23640).
(IF_LINT): Remove. All uses replaced by the new macros.
@@ -10297,7 +38982,7 @@
* lisp/version.el (emacs-repository-get-version):
Parse .git/packed-refs if it exists.
Problem reported by Martin Rudalics in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00554.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00554.html
2016-06-01 Michael Albinus <michael.albinus@gmx.de>
@@ -10333,7 +39018,7 @@
Fix incomplete handling of translation table in a coding system.
- * coding.c (get_translation): New arg NCHARS. Even if TRANS
+ * src/coding.c (get_translation): New arg NCHARS. Even if TRANS
is an alist, return a character or a vector of character.
(produce_chars): Adjust for the above change.
(consume_chars): Likewise.
@@ -10630,7 +39315,7 @@
Don’t document declare-function internals
Suggested by Stefan Monnier in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00618.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00618.html
* doc/lispref/functions.texi (Declaring Functions):
* lisp/subr.el (declare-function):
* lisp/emacs-lisp/bytecomp.el:
@@ -10716,7 +39401,7 @@
Fix byte-compiler pacification for declare-function
Problem reported by Michael Heerdegen in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00590.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00590.html
* lisp/emacs-lisp/bytecomp.el:
(byte-compile-macroexpand-declare-function):
Revert signature to previous value.
@@ -10963,7 +39648,7 @@
Don’t use only last protocol from getaddrinfo
Problem reported by Ken Brown in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00483.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00483.html
* src/process.c (conv_addrinfo_to_lisp): New function.
(connect_network_socket): Arg is now a list of addrinfos, not
merely IP addresses. All uses changed. Use protocol from
@@ -10981,7 +39666,7 @@
* lisp/image.el (image--get-image): Require seq here, not at the
top level, to avoid ‘(require seq) while preparing to dump’ while
bootstrapping. Suggested by Tino Calancha in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00477.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00477.html
2016-05-22 Nicolas Petton <nicolas@petton.fr>
@@ -11498,7 +40183,7 @@
Port autogen.sh to Git 2.4
Problem reported by Michael Brand in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00367.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00367.html
* autogen.sh (git_config): Don't assume that git rev-parse
groks --git-common-dir.
@@ -11721,8 +40406,8 @@
Fixes bug #16759 and bug #23476.
- * .dir-locals: Put the c-noise-macros-with-paren-names setting back into the C
- Mode value.
+ * .dir-locals.el: Put the c-noise-macros-with-paren-names setting
+ back into the C Mode value.
* lisp/progmodes/cc-mode.el: (c-basic-common-init): Remove the call to
c-make-macro-with-semi-re.
@@ -12100,8 +40785,7 @@
2016-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
- * lisp/emulation/viper(-cmd)?.el: Use lexical-binding.
-
+ * lisp/emulation/viper.el:
* lisp/emulation/viper-cmd.el: Use lexical-binding.
(viper-change-state-to-vi, viper-change-state-to-emacs): Allow dummy
args, for use in advice-add.
@@ -12346,8 +41030,9 @@
gitmerge: Add cherry pick to gitmerge-skip-regexp
- * gitmerge.el (gitmerge-skip-regexp): Add "cherry picked from commit",
- which is the string appended by 'git cherry-pick -x'.
+ * admin/gitmerge.el (gitmerge-skip-regexp): Add "cherry picked
+ from commit", which is the string appended by 'git cherry-pick
+ -x'.
2016-05-01 Lars Ingebrigtsen <larsi@gnus.org>
@@ -12436,7 +41121,7 @@
* src/buffer.c (Fgenerate_new_buffer_name): Increment count just
once each time through the loop. Reported by Lars Ingebrigtsen in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00918.html
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00918.html
2016-04-30 Lars Ingebrigtsen <larsi@gnus.org>
@@ -12642,7 +41327,8 @@
2016-04-30 Alan Mackenzie <acm@muc.de>
- * .dir-locals: Amend for correct fontification of *.[ch] containing "IF_LINT"
+ * .dir-locals.el: Amend for correct fontification of *.[ch]
+ containing "IF_LINT"
2016-04-30 Lars Ingebrigtsen <larsi@gnus.org>
@@ -12669,7 +41355,7 @@
CC Mode: Recognize a noise macro with parens after a declarator's identifier
- * lisp/progmodes/cc-engine (c-forward-decl-or-cast-1): In the while loop
+ * lisp/progmodes/cc-engine.el (c-forward-decl-or-cast-1): In the while loop
following comment "Skip over type decl suffix operators." insert code also
to check for noise macros with parentheses.
@@ -12949,7 +41635,7 @@
Link from (emacs)Exiting to (lisp)Killing Emacs
* doc/emacs/entering.texi (Exiting): Link to the lispref
- manual for further customisations (bug#15445).
+ manual for further customizations (bug#15445).
2016-04-29 Lars Ingebrigtsen <larsi@gnus.org>
@@ -13159,7 +41845,7 @@
Move the diff command to "Operate" in ibuffer
* lisp/ibuffer.el (ibuffer-mode-operate-map): Move the diff
- command to the "Operate" menu, and remove the customisation
+ command to the "Operate" menu, and remove the customization
entry to make the "View" menu more logical (bug#1150).
2016-04-27 Lars Ingebrigtsen <larsi@gnus.org>
@@ -13173,9 +41859,10 @@
Add a number of Python 3 exceptions
- * lisp/progmoes/python.el (python-font-lock-keywords): Clean up the exception
- list, adding a number of new Python 3 exceptions and moving some exceptions
- to the Python 2 and 3 list as Python 2.7 includes them.
+ * lisp/progmodes/python.el (python-font-lock-keywords): Clean up
+ the exception list, adding a number of new Python 3 exceptions and
+ moving some exceptions to the Python 2 and 3 list as Python 2.7
+ includes them.
2016-04-26 Anders Lindgren <andlind@gmail.com>
@@ -13209,7 +41896,7 @@
Fix socketd fd startup bug that I introduced
Problem reported by Matthew Leach in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00778.html
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00778.html
* src/emacs.c (main): Indicate more clearly the coupling between
the --daemon option and init_process_emacs.
* src/lisp.h: Adjust to API changes.
@@ -13269,7 +41956,7 @@
This also fixes the mishandling of "\N{CJK COMPATIBILITY
IDEOGRAPH-F900}", "\N{VARIATION SELECTOR-1}", etc.
Problem reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00614.html
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00614.html
* doc/lispref/nonascii.texi (Character Codes), etc/NEWS: Document this.
* lisp/international/mule-cmds.el (char-from-name): New function.
(read-char-by-name): Use it. Document that "BED" is treated as
@@ -13340,7 +42027,7 @@
Remove the previous change.
(vc-state): Same. And update the old, incorrect comment about
unregistered files
- (http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00526.html).
+ (https://lists.gnu.org/r/emacs-devel/2016-04/msg00526.html).
* test/lisp/vc/vc-tests.el (vc-test--state): Remove the check
calling `vc-state' on default-directory (VC state is undefined
@@ -13475,12 +42162,12 @@
Compute User-Agent dynamically in url-http
- * url-http.el (url-http-user-agent-string): Compute User-Agent
- string dynamically.
+ * lisp/url/url-http.el (url-http-user-agent-string): Compute
+ User-Agent string dynamically.
(url-http--user-agent-default-string): New function.
- * url-vars.el (url-privacy-level): Allow `emacs' in list of
- information not to send.
+ * lisp/url/url-vars.el (url-privacy-level): Allow `emacs' in list
+ of information not to send.
(url-user-agent): Add nil and `default' options; do not
pre-compute value.
@@ -13581,7 +42268,7 @@
Use 'ucs-names' for character name escapes
- * lread.c (invalid_character_name, check_scalar_value)
+ * src/lread.c (invalid_character_name, check_scalar_value)
(parse_code_after_prefix, character_name_to_code): New helper
functions that use 'ucs-names' and parsing for CJK ideographs.
(read_escape): Use helper functions.
@@ -13605,7 +42292,7 @@
Implement named character escapes, similar to Perl
- * lread.c (init_character_names): New function.
+ * src/lread.c (init_character_names): New function.
(read_escape): Read Perl-style named character escape sequences.
(syms_of_lread): Initialize new variable 'character_names'.
* test/src/lread-tests.el (lread-char-empty-name): Add test file
@@ -13652,13 +42339,13 @@
Prevent bootstrap autoload backup files
- * lisp/emacs-lisp/autoload (autoload-find-generated-file): Suppress
- backups in newly created file.
+ * lisp/emacs-lisp/autoload.el (autoload-find-generated-file): Suppress
+ backups in newly created file.
- (autoload-ensure-default-file): Function split into two.
- (autoload-ensure-file-writeable): New function from split.
+ (autoload-ensure-default-file): Function split into two.
+ (autoload-ensure-file-writeable): New function from split.
- (Bug#23203)
+ (Bug#23203)
2016-04-20 Paul Eggert <eggert@penguin.cs.ucla.edu>
@@ -13674,7 +42361,7 @@
Avoid AC_PREPROC_IFELSE glitch in configure.ac
Problem reported by Angelo Graziosi in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00545.html
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00545.html
* configure.ac (gl_gcc_warnings): Work around an Autoconf glitch:
AC_PREPROC_IFELSE doesn’t generate a simple shell command.
@@ -13732,7 +42419,7 @@
* lisp/emacs-lisp/easy-mmode.el (define-minor-mode): Fix docstring
so that it matches the actual implementation.
- See https://lists.gnu.org/archive/html/help-gnu-emacs/2016-04/msg00071.html
+ See https://lists.gnu.org/r/help-gnu-emacs/2016-04/msg00071.html
2016-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -13871,7 +42558,7 @@
Port ‘./autogen.sh git’ to non-clones
Problem reported by Angelo Graziosi in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00341.html
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00341.html
* autogen.sh (do_git): Default to false when the arg is ‘all’ but
there is no ‘.git’.
(git_common_dir, hooks): New vars.
@@ -14177,7 +42864,7 @@
Port redirect-debugging-output to MS-Windows
Suggested by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00037.html
+ https://lists.gnu.org/r/emacs-devel/2016-04/msg00037.html
* src/print.c [WINDOWSNT]: Include sys/socket.h.
* src/w32.c (sys_dup2): Work around problem with MS-Windows _dup2.
@@ -14186,7 +42873,7 @@
Port redirect-debugging-output to non-GNU/Linux
Problem reported by Kylie McClain for musl in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg01592.html
+ https://lists.gnu.org/r/emacs-devel/2016-03/msg01592.html
* etc/DEBUG, etc/NEWS: Mention this.
* src/callproc.c (child_setup) [!MSDOS]:
* src/dispnew.c (init_display):
@@ -14772,7 +43459,7 @@
Compute a better commit message for merges
Problem reported by David Engster in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg01270.html
+ https://lists.gnu.org/r/emacs-devel/2016-03/msg01270.html
* admin/gitmerge.el (gitmerge-commit-message):
Truncate the computed commit message to at most 72 characters per line.
(gitmerge-maybe-resume): Don’t use "-" as the commit message for
@@ -14812,7 +43499,7 @@
* admin/gitmerge.el (gitmerge-skip-regexp): Omit "merge", as it
causes false positives. See:
- http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg01234.html
+ https://lists.gnu.org/r/emacs-devel/2016-03/msg01234.html
2016-03-22 Paul Eggert <eggert@cs.ucla.edu>
@@ -14955,8 +43642,8 @@
* lisp/progmodes/cc-engine.el (c-back-over-member-initializers): Check
more robustly for ":" token when searching backwards for it.
- * lisp/progmodes/cc-langs (c-:$-multichar-token-regexp): New language
- variable.
+ * lisp/progmodes/cc-langs.el (c-:$-multichar-token-regexp): New
+ language variable.
[This reapplies commit 9e5452f7166e3634f2d8e943815ed722e1672714,
which was inadvertently lost by merge commit
@@ -15159,15 +43846,15 @@
Add a Catalan language environment
- * international/mule-cmds.el (locale-language-names): Map locale
+ * lisp/international/mule-cmds.el (locale-language-names): Map locale
language name `ca' to language environment `Catalan'.
- * language/european.el: Add definition of language environment for
- the Catalan language.
+ * lisp/language/european.el: Add definition of language
+ environment for the Catalan language.
- * leim/quail/latin-pre.el: Add quail rule to the `catalan-prefix'
- input method to support input of middle dot characters through
- composition (bug#18279).
+ * lisp/leim/quail/latin-pre.el: Add quail rule to the
+ `catalan-prefix' input method to support input of middle dot
+ characters through composition (bug#18279).
2016-03-19 Paul Eggert <eggert@cs.ucla.edu>
@@ -15529,7 +44216,7 @@
Unbreak the MinGW64 build
* nt/inc/ms-w32.h [MINGW_W64]: Undefine HAVE_GAI_STRERROR. See
- http://lists.gnu.org/archive/html/emacs-devel/2016-03/msg00130.html
+ https://lists.gnu.org/r/emacs-devel/2016-03/msg00130.html
for the details. Reported by Angelo Graziosi
<angelo.graziosi@alice.it>.
@@ -15564,7 +44251,7 @@
Implement getaddrinfo fallback for MS-Windows
- See http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg01602.html
+ See https://lists.gnu.org/r/emacs-devel/2016-02/msg01602.html
for more details.
* nt/mingw-cfg.site (ac_cv_func_getaddrinfo)
@@ -15749,7 +44436,7 @@
bd58c13 Improve documentation of focus-related hooks
00a4720 Further improve doc string of 'disable-point-adjustment'
c582def Further adaptions in file-notify-tests.el for w32notify
- a1585e1 Don't bug out on localised dates in gnus-icalendar
+ a1585e1 Don't bug out on localized dates in gnus-icalendar
2016-03-03 John Wiegley <johnw@newartisans.com>
@@ -15820,7 +44507,7 @@
This is possible in all functions where we catch signals anyway.
- * emacs-module.c (module_make_global_ref, module_funcall)
+ * src/emacs-module.c (module_make_global_ref, module_funcall)
(module_copy_string_contents, module_make_string): Use xsignal0
and CHECK macros for argument checks.
@@ -15832,7 +44519,7 @@
and negate its sense. Use it via AC_SUBST, not AC_DEFINE,
and have its value be either empty or --no-build-details.
All uses changed. Change option to --disable-build-details.
- * doc/lispref/cmdargs.texi (Initial Options):
+ * doc/emacs/cmdargs.texi (Initial Options):
Document --no-build-details.
* doc/lispref/internals.texi (Building Emacs):
* etc/NEWS:
@@ -16270,10 +44957,10 @@
2016-02-25 Jan Tatarik <jan.tatarik@gmail.com>
- Don't use (localised) week days in dates
+ Don't use (localized) week days in dates
* lisp/gnus/gnus-icalendar.el
- (gnus-icalendar-event:org-timestamp): Don't use (localised)
+ (gnus-icalendar-event:org-timestamp): Don't use (localized)
week days in the dates, because that messes up things later.
2016-02-25 Thierry Volpiatto <thierry.volpiatto@gmail.com>
@@ -16335,9 +45022,9 @@
Make checkdoc warn about variables described as "True"
- * checkdoc.el (checkdoc-this-string-valid-engine): Docstrings for
- variables "True...", and functions "Return true...", should usually be
- "non-nil" (bug#15506).
+ * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine):
+ Docstrings for variables "True...", and functions "Return
+ true...", should usually be "non-nil" (bug#15506).
2016-02-24 Lars Ingebrigtsen <larsi@gnus.org>
@@ -16589,7 +45276,7 @@
really changed.
(save_window_save): Set the pixel_height_before_size_change and
pixel_width_before_size_change fields.
- (Vwindow_size_change_functions): Move here definiton from xdisp.c.
+ (Vwindow_size_change_functions): Move here definition from xdisp.c.
* src/xdisp.c (prepare_menu_bars, redisplay_internal): Call
run_window_size_change_functions.
(Vwindow_size_change_functions): Move definition to window.c.
@@ -16738,7 +45425,7 @@
Test message-strip-subject-trailing-was
- * test/lisp/gnus/message-test.el (message-strip-subject-trailing-was):
+ * test/lisp/gnus/message-tests.el (message-strip-subject-trailing-was):
New test (bug#22632).
2016-02-22 Michal Nazarewicz <mina86@mina86.com>
@@ -16775,7 +45462,7 @@
* lisp/gnus/gnus-rfc1843.el: New file for Gnus/rfc1843
interface functions.
- * lisp/gnus/rfc1843.el: Move all Gnus-specifig functions to
+ * lisp/gnus/gnus-rfc1843.el: Move all Gnus-specifig functions to
gnus-rfc1843.
2016-02-22 Lars Ingebrigtsen <larsi@gnus.org>
@@ -16791,7 +45478,7 @@
Don't require mm-util
- * lisp/gnus/ietf-drums.el (mm-util): Don't require.
+ * lisp/mail/ietf-drums.el (mm-util): Don't require.
2016-02-22 Lars Ingebrigtsen <larsi@gnus.org>
@@ -16842,7 +45529,7 @@
5d17ae7 Improve file-notify-test08-watched-file-in-watched-dir
1cb1268 Fix todo-mode item date editing bugs
1e996cf Fix "[:upper:]" for non-ASCII characters
- 896f993 Allow customising the article mode cursor behavior
+ 896f993 Allow customizing the article mode cursor behavior
24c1c1d Use pop-to-buffer-same-window in woman.el
2a75f64 New filenotify test for bug#22736
c9bccf7 Report critical battery errors
@@ -16907,7 +45594,7 @@
Port recent filevercmp addition to MS-Windows
Reported by Andy Moreton in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg01302.html
+ https://lists.gnu.org/r/emacs-devel/2016-02/msg01302.html
* nt/gnulib.mk (libgnu_a_SOURCES): Add filevercmp.c.
(EXTRA_DIST): Add filevercmp.h.
@@ -17435,7 +46122,7 @@
* lisp/gnus/pop3.el: Ditto.
- * lisp/gnus/sieve-manage.el: Ditto.
+ * lisp/net/sieve-manage.el: Ditto.
* lisp/net/network-stream.el (open-protocol-stream): Make obsolete.
@@ -17460,7 +46147,7 @@
Remove compat functions from starttls.el
- * lisp/gnus/starttls.el
+ * lisp/net/starttls.el
(starttls-set-process-query-on-exit-flag): Remove.
2016-02-13 Lars Ingebrigtsen <larsi@gnus.org>
@@ -17480,7 +46167,7 @@
Remove compat code from rfc2047
- * lisp/gnus/rfc2047.el (rfc2047-encode-message-header): Remove
+ * lisp/mail/rfc2047.el (rfc2047-encode-message-header): Remove
compat code.
(rfc2047-decode-string): Ditto.
@@ -17817,9 +46504,9 @@
Fix encoding problem introduced by previous patch series
- * lisp/gnus/rfc2047.el: Ditto (bug#22648).
+ * lisp/mail/rfc2047.el: Ditto (bug#22648).
- * lisp/gnus/rfc2231.el: Fix problem created by the
+ * lisp/mail/rfc2231.el: Fix problem created by the
mm-replace-in-string conversion.
2016-02-12 Lars Ingebrigtsen <larsi@gnus.org>
@@ -17915,7 +46602,7 @@
Make sieve-manage require sasl
- * lisp/gnus/sieve-manage.el: Fix compilation warning by
+ * lisp/net/sieve-manage.el: Fix compilation warning by
requiring sasl.
2016-02-11 Lars Ingebrigtsen <larsi@gnus.org>
@@ -18021,7 +46708,7 @@
Don't use mm-with-unibyte-buffer in utf7
- * lisp/gnus/utf7.el (utf7-fragment-encode): Don't use
+ * lisp/international/utf7.el (utf7-fragment-encode): Don't use
mm-with-unibyte-buffer.
2016-02-11 Lars Ingebrigtsen <larsi@gnus.org>
@@ -18102,7 +46789,7 @@
Remove XEmacs compat code from ietf-drums.el
- * lisp/gnus/ietf-drums.el (ietf-drums-syntax-table): Drop
+ * lisp/mail/ietf-drums.el (ietf-drums-syntax-table): Drop
XEmacs compat.
2016-02-10 Lars Ingebrigtsen <larsi@gnus.org>
@@ -18295,7 +46982,7 @@
Remove compat code from compface.el
- * lisp/gnus/compface.el: Remove XEmacs compat code throughout.
+ * lisp/image/compface.el: Remove XEmacs compat code throughout.
2016-02-09 Lars Ingebrigtsen <larsi@gnus.org>
@@ -18510,7 +47197,7 @@
* src/alloc.c (aligned_alloc): Define to private name when a
static function, to avoid collision with lisp.h extern decl.
Reported by John Yates in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg00439.html
+ https://lists.gnu.org/r/emacs-devel/2016-02/msg00439.html
2016-02-08 David Edmondson <dme@dme.org>
@@ -18526,7 +47213,7 @@
Make `message-beginning-of-line' aware of folded headers
- * lisp/gnus/message.pl (message-beginning-of-header): New function which
+ * lisp/gnus/message.el (message-beginning-of-header): New function which
moves point to the beginning of a mail header. The function is aware of
folded headers and with non-nil argument looks for the true beginning of
a header while with nil argument moves to the indented text of header's
@@ -18537,7 +47224,7 @@
2016-02-08 Michal Nazarewicz <mina86@mina86.com>
- Optimise ‘point in message header’ check
+ Optimize ‘point in message header’ check
* lisp/gnus/message.el (message-point-in-header-p): Replace two unbound
regular expression matches with a single bound string match thus
@@ -18761,7 +47448,7 @@
Port to FreeBSD x86
Reported by Herbert J. Skuhra in:
- http://lists.gnu.org/archive/html/emacs-devel/2016-02/msg00336.html
+ https://lists.gnu.org/r/emacs-devel/2016-02/msg00336.html
* src/lisp.h (NONPOINTER_BITS) [__FreeBSD__]: Zero in this case too,
since malloc always returns a multiple of 8 in FreeBSD.
@@ -19209,7 +47896,7 @@
Build fix for --enable-check-lisp-object-type
- * process.c (check_for_dns): Type fix reported by YAMAMOTO
+ * src/process.c (check_for_dns): Type fix reported by YAMAMOTO
Mitsuharu.
2016-02-01 Glenn Morris <rgm@gnu.org>
@@ -19225,7 +47912,7 @@
Boot parameter check fix
- * process.c (send_process): Fix test for boot parameters noted
+ * src/process.c (send_process): Fix test for boot parameters noted
by Andy Moreton.
2016-02-01 Paul Eggert <eggert@cs.ucla.edu>
@@ -19251,7 +47938,7 @@
Return the correct server port number
- * process.c (connect_network_socket): Return the correct
+ * src/process.c (connect_network_socket): Return the correct
server port number.
2016-01-31 Lars Ingebrigtsen <larsi@gnus.org>
@@ -19264,7 +47951,7 @@
Better async error reporting
- * process.c (connect_network_socket): Mark failed processes
+ * src/process.c (connect_network_socket): Mark failed processes
with a better error message.
(check_for_dns): Ditto.
@@ -19314,7 +48001,7 @@
Windows build fix
- * process.c (Fmake_network_process): Build fix for systems
+ * src/process.c (Fmake_network_process): Build fix for systems
without local sockets.
2016-01-31 Lars Ingebrigtsen <larsi@gnus.org>
@@ -19325,21 +48012,21 @@
Fix GC problem in async TLS connection
- * process.h: All Lisp_Object slots have to come first,
+ * src/process.h: All Lisp_Object slots have to come first,
otherwise they won't be protected from gc.
2016-01-31 Lars Ingebrigtsen <larsi@gnus.org>
Further TLS async work
- * gnutls.c (boot_error): New function to either signal an
+ * src/gnutls.c (boot_error): New function to either signal an
error or return an error code.
(Fgnutls_boot): Don't signal errors when running asynchronously.
- * process.h (pset_status): Move here from process.c to be
+ * src/process.h (pset_status): Move here from process.c to be
able to use from gnutls.c.
- * process.c (connect_network_socket): Do the TLS boot here
+ * src/process.c (connect_network_socket): Do the TLS boot here
when running asynchronously.
(wait_reading_process_output): Rework the dns_processes
handling for more safety.
@@ -19362,7 +48049,7 @@
Port new hybrid malloc to FreeBSD
- Problem reported by Wolfgang Jenkner in: http://bugs.gnu.org/22086#118
+ Problem reported by Wolfgang Jenkner in: https://bugs.gnu.org/22086#118
* src/gmalloc.c (__malloc_initialize_hook, __after_morecore_hook)
(__morecore) [HYBRID_MALLOC]: Define in this case too.
@@ -19456,7 +48143,7 @@
Fix segfault from double free
- * process.c (check_for_dns): Protect against double free
+ * src/process.c (check_for_dns): Protect against double free
issues.
2016-01-30 Lars Ingebrigtsen <larsi@gnus.org>
@@ -19482,7 +48169,7 @@
* src/gnutls.c (Fgnutls_mark_process): New function.
* src/process.c (send_process): Don't write to GnuTLS sockets that
- haven't been initialised yed.
+ haven't been initialized yed.
* src/process.h: New slot gnutls_wait_p.
@@ -19744,7 +48431,7 @@
Re-enable checks in member, memql, delete to complain about non-lists
- * fns.c (Fmember, Fmemql, Fdelete): Revert 2007-10-16 change.
+ * src/fns.c (Fmember, Fmemql, Fdelete): Revert 2007-10-16 change.
2016-01-30 Lars Ingebrigtsen <larsi@gnus.org>
@@ -19754,7 +48441,7 @@
Make async resolution more efficient
- * process.c (wait_reading_process_output): Use a list of
+ * src/process.c (wait_reading_process_output): Use a list of
process objects instead of looping through an array to check
for name resolution. This should be much faster.
@@ -19768,66 +48455,66 @@
Compilation for for systems with getaddrinfo_a
- * process.c (Fmake_network_process): Make stuff work again on
+ * src/process.c (Fmake_network_process): Make stuff work again on
systems with getaddrinfo_a.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Save correct server data
- * process.c (connect_network_socket): Save the correct contact
+ * src/process.c (connect_network_socket): Save the correct contact
info for servers.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Compilation for for non-GNU systems
- * process.c (Fmake_network_process): Make compilation work
+ * src/process.c (Fmake_network_process): Make compilation work
again on hosts that don't have getaddrinfo_a.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Avoid memory leaks in async DNS
- * process.c (check_for_dns): Free async DNS resources after
+ * src/process.c (check_for_dns): Free async DNS resources after
they've been used.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
- * process.c (check_for_dns): Free the result data.
+ * src/process.c (check_for_dns): Free the result data.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Fix server connections
- * process.c (Fmake_network_process): Make creating server
+ * src/process.c (Fmake_network_process): Make creating server
listening ports work again.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Further make_network_process clean up
- * process.c (Fmake_network_process): Remove setting of unused
+ * src/process.c (Fmake_network_process): Remove setting of unused
family variable.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Clean up GETADDRINFO usage in make-network-process
- * process.c (Fmake_network_process): Clean up the GETADDRINFO
+ * src/process.c (Fmake_network_process): Clean up the GETADDRINFO
handling.
2016-01-29 Lars Ingebrigtsen <larsi@gnus.org>
Implement asynchronous name resolution
- * process.c (Fmake_network_process): Do asynchronous DNS
+ * src/process.c (Fmake_network_process): Do asynchronous DNS
lookups if we have getaddrinfo_a and the user requests :nowait.
(check_for_dns): New function.
(wait_reading_process_output): Check for pending name
resolution in the idle loop.
- * process.h: Add structure for async DNS.
+ * src/process.h: Add structure for async DNS.
2016-01-28 Glenn Morris <rgm@gnu.org>
@@ -19841,7 +48528,7 @@
Fix memory leak
- * process.c (connect_network_socket): Free previous sockaddr
+ * src/process.c (connect_network_socket): Free previous sockaddr
before allocating a new one.
2016-01-28 Lars Ingebrigtsen <larsi@gnus.org>
@@ -19877,7 +48564,7 @@
2016-01-27 Glenn Morris <rgm@gnu.org>
- * test/lisp/vc/vc-hg.el: Move from test/automated/.
+ * test/lisp/vc/vc-hg-tests.el: Move from test/automated/.
2016-01-25 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -19981,7 +48668,7 @@
that as the same name can be used for different locations in different
SES sheets ; 2) use `local-variable-if-set-p' rather than `boundp' and
`local-variable-p' to check if cell name is already in use in this
- sheet or needs initialisation.
+ sheet or needs initialization.
(ses-relocate-all): Cell value relocation : 1) like for name
relocation use the `ses-cell' property rather than comparing actual
name to corresponding standard name. 2) Correct bug introduced in
@@ -20144,7 +48831,7 @@
2016-01-17 Bill Wohler <wohler@newt.com>
- * mh-e.el (mh-version): Add +git to version.
+ * lisp/mh-e/mh-e.el (mh-version): Add +git to version.
2016-01-16 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -20186,7 +48873,8 @@
2016-01-16 Stefan Monnier <monnier@iro.umontreal.ca>
- * elisp-mode.el (elisp--font-lock-flush-elisp-buffers): Fix comment
+ * lisp/progmodes/elisp-mode.el
+ (elisp--font-lock-flush-elisp-buffers): Fix comment
2016-01-16 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -20231,7 +48919,8 @@
2016-01-15 Stefan Monnier <monnier@iro.umontreal.ca>
- * xmltok.el: Mark the "sole --" rather than the comment opener
+ * lisp/nxml/xmltok.el: Mark the "sole --" rather than the comment
+ opener.
* lisp/nxml/xmltok.el (xmltok-scan-after-comment-open): Put the error
marker on the "sole --" rather than on the comment opener.
@@ -20529,7 +49218,7 @@
2f32cb5 * doc/misc/efaq.texi (Packages that do not come with Emacs):
Update the URI of MELPA and marmalade-repo.
Reported by CHENG Goa <chenggao@royau.me> in
- https://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00390.html.
+ https://lists.gnu.org/r/emacs-devel/2016-01/msg00390.html.
d2937aa * lisp/progmodes/opascal.el (opascal-mode-syntax-table):
5330c25 * lisp/progmodes/xscheme.el (xscheme-prompt-for-expression-exit):
7380990 Remove function wrongly on AWK Mode value of context
@@ -20805,12 +49494,12 @@
free to format differently a really empty cell, ie. containing nil,
from a cell containing an empty string "".
- * ses.el (ses-call-printer): Replace `(or value "")' by just `value'
- in the case of a lambda expression printer function.
+ * lisp/ses.el (ses-call-printer): Replace `(or value "")' by just
+ `value' in the case of a lambda expression printer function.
- * ses.texi (Printer functions): Add example and description about
- lambda expression printer function handling all the possible values,
- including unexpected ones.
+ * doc/misc/ses.texi (Printer functions): Add example and
+ description about lambda expression printer function handling all
+ the possible values, including unexpected ones.
2015-12-30 Vincent Belaïche <vincentb1@users.sourceforge.net>
@@ -20821,7 +49510,7 @@
removed the (setq ses--curcell t) setting in the ses-command-hook
function.
- * ses.el (ses-check-curcell): replace `(eq ses--curcell t)' by just `t' as
+ * lisp/ses.el (ses-check-curcell): replace `(eq ses--curcell t)' by just `t' as
a condition to call function `ses-set-curcell'. Comment this as a quick
temporary hack to make it work, as I don't know yet whether a definite
correction would be to make the ses-set-curcell at every ses-check-curcell,
@@ -20863,14 +49552,14 @@
Further Unicode restrictive fixups
- * puny.el (puny-highly-restrictive-p): Include the extra
+ * lisp/net/puny.el (puny-highly-restrictive-p): Include the extra
identifier characters from table 3.
2015-12-29 Lars Ingebrigtsen <larsi@gnus.org>
Add a new function to say whether a string is restrictive
- * puny.el (puny-highly-restrictive-p): New function.
+ * lisp/net/puny.el (puny-highly-restrictive-p): New function.
2015-12-28 Lars Ingebrigtsen <larsi@gnus.org>
@@ -20891,7 +49580,7 @@
IDNA-encode all domain names in `open-network-stream'
- * network-stream.el (open-network-stream)
+ * lisp/net/network-stream.el (open-network-stream)
(network-stream-open-plain, network-stream-open-starttls):
IDNA-encode all domain names, if needed.
@@ -20899,13 +49588,14 @@
Fix puny-encoding all-non-ASCII domains
- * puny.el (puny-encode-string): Fix the all-non-ASCII encoding case.
+ * lisp/net/puny.el (puny-encode-string): Fix the all-non-ASCII
+ encoding case.
2015-12-28 Lars Ingebrigtsen <larsi@gnus.org>
shr link traversal fixup
- * shr.el (shr-next-link): Don't bug out on adjacent links.
+ * lisp/net/shr.el (shr-next-link): Don't bug out on adjacent links.
2015-12-28 Lars Ingebrigtsen <larsi@gnus.org>
@@ -20918,19 +49608,19 @@
Fix punycode short circuit logic
- * puny.el (puny-encode-domain): Fix short-circuit logic.
+ * lisp/net//puny.el (puny-encode-domain): Fix short-circuit logic.
2015-12-28 Lars Ingebrigtsen <larsi@gnus.org>
IDNA speed up
- * puny.el (puny-encode-domain): Make the common non-IDNA case faster
+ * lisp/net/puny.el (puny-encode-domain): Make the common non-IDNA case faster
2015-12-28 Lars Ingebrigtsen <larsi@gnus.org>
Add IDNA domain encode/decode functions
- * puny.el (puny-decode-domain): New function.
+ * lisp/net/puny.el (puny-decode-domain): New function.
(puny-encode-domain): Ditto.
(puny-decode-digit): Fix digit decoding error.
@@ -20938,7 +49628,7 @@
Rename idna.el to puny.el
- * puny.el: Renamed from idna.el to avoid name collisions with
+ * lisp/net/puny.el: Renamed from idna.el to avoid name collisions with
the external idna.el library.
2015-12-27 Katsumi Yamaoka <yamaoka@jpl.org>
@@ -20950,7 +49640,8 @@
2015-12-27 Lars Ingebrigtsen <larsi@gnus.org>
- * idna.el (idna-decode-string-internal): Implement decoding.
+ * lisp/net/idna.el (idna-decode-string-internal): Implement
+ decoding.
2015-12-27 Lars Ingebrigtsen <larsi@gnus.org>
@@ -21276,7 +49967,7 @@
* lisp/dired.el: Remove autoloads.
* lisp/Makefile.in: Add dired to autogenel.
- * lisp/dired-aux.el,lisp/dired-x.el: Update file local.
+ * lisp/dired-aux.el, lisp/dired-x.el: Update file local.
* test/lisp/dired-tests.el: Add new test.
2015-12-17 Phillip Lord <phillip.lord@russet.org.uk>
@@ -21284,9 +49975,9 @@
eieio generate autoloads to non-versioned file.
* lisp/Makefile.in: eieio-loaddefs add to autogenel.
- * lisp/emacs-lisp/eieio.el,lisp/emacs-lisp/eieio-core.el:
+ * lisp/emacs-lisp/eieio.el, lisp/emacs-lisp/eieio-core.el:
Remove autoloads.
- * lisp/emacs-lisp/eieio-compat.el,lisp/emacs-lisp/eieio-custom.el,
+ * lisp/emacs-lisp/eieio-compat.el, lisp/emacs-lisp/eieio-custom.el,
lisp/emacs-lisp/eieio-opt.el: Update file local.
* test/lisp/emacs-lisp/eieio-tests/eieio-tests.el: New test.
@@ -21314,10 +50005,10 @@
* lisp/Makefile.in: Add rmail-loaddefs.el to autogenel.
* lisp/mail/rmail.el: Remove autoloads, add require.
- * lisp/mail/rmailedit.el,lisp/mail/rmailkwd.el,
- lisp/mail/rmailmm.el,lisp/mail/rmailmsc.el,
- lisp/mail/rmailsort.el,lisp/mail/rmailsum.el,
- lisp/mail/undigest.el: Update file-local.
+ * lisp/mail/rmailedit.el, lisp/mail/rmailkwd.el:
+ * lisp/mail/rmailmm.el, lisp/mail/rmailmsc.el:
+ * lisp/mail/rmailsort.el, lisp/mail/rmailsum.el:
+ * lisp/mail/undigest.el: Update file-local.
* test/lisp/mail/rmail-tests.el:
2015-12-17 Phillip Lord <phillip.lord@russet.org.uk>
@@ -21341,11 +50032,11 @@
* lisp/Makefile.in: Add reftex-loaddefs to autogen files
* lisp/textmodes/reftex.el: Remove autoloads.
- * lisp/textmodes/reftex-auc.el,lisp/textmodes/reftex-cite.el,
- lisp/textmodes/reftex-dcr.el,lisp/textmodes/reftex-global.el,
- lisp/textmodes/reftex-index.el,lisp/textmodes/reftex-parse.el,
- lisp/textmodes/reftex-ref.el,lisp/textmodes/reftex-sel.el,
- lisp/textmodes/reftex-toc.el: Update autoload file-local.
+ * lisp/textmodes/reftex-auc.el, lisp/textmodes/reftex-cite.el:
+ * lisp/textmodes/reftex-dcr.el, lisp/textmodes/reftex-global.el:
+ * lisp/textmodes/reftex-index.el, lisp/textmodes/reftex-parse.el:
+ * lisp/textmodes/reftex-ref.el, lisp/textmodes/reftex-sel.el:
+ * lisp/textmodes/reftex-toc.el: Update autoload file-local.
* test/lisp/textmodes/reftex-tests.el: Add test of an autoloaded
function.
@@ -21933,262 +50624,263 @@
Rename all test files to reflect source layout.
- * CONTRIBUTE,Makefile.in,configure.ac: Update to reflect
- test directory moves.
- * test/file-organisation.org: New file.
- * test/automated/Makefile.in
- test/automated/data/decompress/foo.gz
- test/automated/data/epg/pubkey.asc
- test/automated/data/epg/seckey.asc
- test/automated/data/files-bug18141.el.gz
- test/automated/data/flymake/test.c
- test/automated/data/flymake/test.pl
- test/automated/data/package/archive-contents
- test/automated/data/package/key.pub
- test/automated/data/package/key.sec
- test/automated/data/package/multi-file-0.2.3.tar
- test/automated/data/package/multi-file-readme.txt
- test/automated/data/package/newer-versions/archive-contents
- test/automated/data/package/newer-versions/new-pkg-1.0.el
- test/automated/data/package/newer-versions/simple-single-1.4.el
- test/automated/data/package/package-test-server.py
- test/automated/data/package/signed/archive-contents
- test/automated/data/package/signed/archive-contents.sig
- test/automated/data/package/signed/signed-bad-1.0.el
- test/automated/data/package/signed/signed-bad-1.0.el.sig
- test/automated/data/package/signed/signed-good-1.0.el
- test/automated/data/package/signed/signed-good-1.0.el.sig
- test/automated/data/package/simple-depend-1.0.el
- test/automated/data/package/simple-single-1.3.el
- test/automated/data/package/simple-single-readme.txt
- test/automated/data/package/simple-two-depend-1.1.el
- test/automated/abbrev-tests.el
- test/automated/auto-revert-tests.el
- test/automated/calc-tests.el
- test/automated/icalendar-tests.el
- test/automated/character-fold-tests.el
- test/automated/comint-testsuite.el
- test/automated/descr-text-test.el
- test/automated/electric-tests.el
- test/automated/cl-generic-tests.el
- test/automated/cl-lib-tests.el
- test/automated/eieio-test-methodinvoke.el
- test/automated/eieio-test-persist.el
- test/automated/eieio-tests.el
- test/automated/ert-tests.el
- test/automated/ert-x-tests.el
- test/automated/generator-tests.el
- test/automated/let-alist.el
- test/automated/map-tests.el
- test/automated/advice-tests.el
- test/automated/package-test.el
- test/automated/pcase-tests.el
- test/automated/regexp-tests.el
- test/automated/seq-tests.el
- test/automated/subr-x-tests.el
- test/automated/tabulated-list-test.el
- test/automated/thunk-tests.el
- test/automated/timer-tests.el
- test/automated/epg-tests.el
- test/automated/eshell.el
- test/automated/faces-tests.el
- test/automated/file-notify-tests.el
- test/automated/auth-source-tests.el
- test/automated/gnus-tests.el
- test/automated/message-mode-tests.el
- test/automated/help-fns.el
- test/automated/imenu-test.el
- test/automated/info-xref.el
- test/automated/mule-util.el
- test/automated/isearch-tests.el
- test/automated/json-tests.el
- test/automated/bytecomp-tests.el
- test/automated/coding-tests.el
- test/automated/core-elisp-tests.el
- test/automated/decoder-tests.el
- test/automated/files.el
- test/automated/font-parse-tests.el
- test/automated/lexbind-tests.el
- test/automated/occur-tests.el
- test/automated/process-tests.el
- test/automated/syntax-tests.el
- test/automated/textprop-tests.el
- test/automated/undo-tests.el
- test/automated/man-tests.el
- test/automated/completion-tests.el
- test/automated/dbus-tests.el
- test/automated/newsticker-tests.el
- test/automated/sasl-scram-rfc-tests.el
- test/automated/tramp-tests.el
- test/automated/obarray-tests.el
- test/automated/compile-tests.el
- test/automated/elisp-mode-tests.el
- test/automated/f90.el
- test/automated/flymake-tests.el
- test/automated/python-tests.el
- test/automated/ruby-mode-tests.el
- test/automated/subword-tests.el
- test/automated/replace-tests.el
- test/automated/simple-test.el
- test/automated/sort-tests.el
- test/automated/subr-tests.el
- test/automated/reftex-tests.el
- test/automated/sgml-mode-tests.el
- test/automated/tildify-tests.el
- test/automated/thingatpt.el
- test/automated/url-future-tests.el
- test/automated/url-util-tests.el
- test/automated/add-log-tests.el
- test/automated/vc-bzr.el
- test/automated/vc-tests.el
- test/automated/xml-parse-tests.el
- test/BidiCharacterTest.txt
- test/biditest.el
- test/cedet/cedet-utests.el
- test/cedet/ede-tests.el
- test/cedet/semantic-ia-utest.el
- test/cedet/semantic-tests.el
- test/cedet/semantic-utest-c.el
- test/cedet/semantic-utest.el
- test/cedet/srecode-tests.el
- test/cedet/tests/test.c
- test/cedet/tests/test.el
- test/cedet/tests/test.make
- test/cedet/tests/testdoublens.cpp
- test/cedet/tests/testdoublens.hpp
- test/cedet/tests/testfriends.cpp
- test/cedet/tests/testjavacomp.java
- test/cedet/tests/testnsp.cpp
- test/cedet/tests/testpolymorph.cpp
- test/cedet/tests/testspp.c
- test/cedet/tests/testsppcomplete.c
- test/cedet/tests/testsppreplace.c
- test/cedet/tests/testsppreplaced.c
- test/cedet/tests/testsubclass.cpp
- test/cedet/tests/testsubclass.hh
- test/cedet/tests/testtypedefs.cpp
- test/cedet/tests/testvarnames.c
- test/etags/CTAGS.good
- test/etags/ETAGS.good_1
- test/etags/ETAGS.good_2
- test/etags/ETAGS.good_3
- test/etags/ETAGS.good_4
- test/etags/ETAGS.good_5
- test/etags/ETAGS.good_6
- test/etags/a-src/empty.zz
- test/etags/a-src/empty.zz.gz
- test/etags/ada-src/2ataspri.adb
- test/etags/ada-src/2ataspri.ads
- test/etags/ada-src/etags-test-for.ada
- test/etags/ada-src/waroquiers.ada
- test/etags/c-src/a/b/b.c
- test/etags/c-src/abbrev.c
- test/etags/c-src/c.c
- test/etags/c-src/dostorture.c
- test/etags/c-src/emacs/src/gmalloc.c
- test/etags/c-src/emacs/src/keyboard.c
- test/etags/c-src/emacs/src/lisp.h
- test/etags/c-src/emacs/src/regex.h
- test/etags/c-src/etags.c
- test/etags/c-src/exit.c
- test/etags/c-src/exit.strange_suffix
- test/etags/c-src/fail.c
- test/etags/c-src/getopt.h
- test/etags/c-src/h.h
- test/etags/c-src/machsyscalls.c
- test/etags/c-src/machsyscalls.h
- test/etags/c-src/sysdep.h
- test/etags/c-src/tab.c
- test/etags/c-src/torture.c
- test/etags/cp-src/MDiagArray2.h
- test/etags/cp-src/Range.h
- test/etags/cp-src/burton.cpp
- test/etags/cp-src/c.C
- test/etags/cp-src/clheir.cpp.gz
- test/etags/cp-src/clheir.hpp
- test/etags/cp-src/conway.cpp
- test/etags/cp-src/conway.hpp
- test/etags/cp-src/fail.C
- test/etags/cp-src/functions.cpp
- test/etags/cp-src/screen.cpp
- test/etags/cp-src/screen.hpp
- test/etags/cp-src/x.cc
- test/etags/el-src/TAGTEST.EL
- test/etags/el-src/emacs/lisp/progmodes/etags.el
- test/etags/erl-src/gs_dialog.erl
- test/etags/f-src/entry.for
- test/etags/f-src/entry.strange.gz
- test/etags/f-src/entry.strange_suffix
- test/etags/forth-src/test-forth.fth
- test/etags/html-src/algrthms.html
- test/etags/html-src/index.shtml
- test/etags/html-src/software.html
- test/etags/html-src/softwarelibero.html
- test/etags/lua-src/allegro.lua
- test/etags/objc-src/PackInsp.h
- test/etags/objc-src/PackInsp.m
- test/etags/objc-src/Subprocess.h
- test/etags/objc-src/Subprocess.m
- test/etags/objcpp-src/SimpleCalc.H
- test/etags/objcpp-src/SimpleCalc.M
- test/etags/pas-src/common.pas
- test/etags/perl-src/htlmify-cystic
- test/etags/perl-src/kai-test.pl
- test/etags/perl-src/yagrip.pl
- test/etags/php-src/lce_functions.php
- test/etags/php-src/ptest.php
- test/etags/php-src/sendmail.php
- test/etags/prol-src/natded.prolog
- test/etags/prol-src/ordsets.prolog
- test/etags/ps-src/rfc1245.ps
- test/etags/pyt-src/server.py
- test/etags/tex-src/gzip.texi
- test/etags/tex-src/nonewline.tex
- test/etags/tex-src/testenv.tex
- test/etags/tex-src/texinfo.tex
- test/etags/y-src/atest.y
- test/etags/y-src/cccp.c
- test/etags/y-src/cccp.y
- test/etags/y-src/parse.c
- test/etags/y-src/parse.y
- test/indent/css-mode.css
- test/indent/js-indent-init-dynamic.js
- test/indent/js-indent-init-t.js
- test/indent/js-jsx.js
- test/indent/js.js
- test/indent/latex-mode.tex
- test/indent/modula2.mod
- test/indent/nxml.xml
- test/indent/octave.m
- test/indent/pascal.pas
- test/indent/perl.perl
- test/indent/prolog.prolog
- test/indent/ps-mode.ps
- test/indent/ruby.rb
- test/indent/scheme.scm
- test/indent/scss-mode.scss
- test/indent/sgml-mode-attribute.html
- test/indent/shell.rc
- test/indent/shell.sh
- test/redisplay-testsuite.el
- test/rmailmm.el
- test/automated/buffer-tests.el
- test/automated/cmds-tests.el
- test/automated/data-tests.el
- test/automated/finalizer-tests.el
- test/automated/fns-tests.el
- test/automated/inotify-test.el
- test/automated/keymap-tests.el
- test/automated/print-tests.el
- test/automated/libxml-tests.el
- test/automated/zlib-tests.el: Files Moved.
+ * CONTRIBUTE, Makefile.in, configure.ac: Update to reflect
+ test directory moves.
+ * test/file-organisation.org: New file.
+ * test/automated/Makefile.in:
+ * test/automated/data/decompress/foo.gz:
+ * test/automated/data/epg/pubkey.asc:
+ * test/automated/data/epg/seckey.asc:
+ * test/automated/data/files-bug18141.el.gz:
+ * test/automated/data/flymake/test.c:
+ * test/automated/data/flymake/test.pl:
+ * test/automated/data/package/archive-contents:
+ * test/automated/data/package/key.pub:
+ * test/automated/data/package/key.sec:
+ * test/automated/data/package/multi-file-0.2.3.tar:
+ * test/automated/data/package/multi-file-readme.txt:
+ * test/automated/data/package/newer-versions/archive-contents:
+ * test/automated/data/package/newer-versions/new-pkg-1.0.el:
+ * test/automated/data/package/newer-versions/simple-single-1.4.el:
+ * test/automated/data/package/package-test-server.py:
+ * test/automated/data/package/signed/archive-contents:
+ * test/automated/data/package/signed/archive-contents.sig:
+ * test/automated/data/package/signed/signed-bad-1.0.el:
+ * test/automated/data/package/signed/signed-bad-1.0.el.sig:
+ * test/automated/data/package/signed/signed-good-1.0.el:
+ * test/automated/data/package/signed/signed-good-1.0.el.sig:
+ * test/automated/data/package/simple-depend-1.0.el:
+ * test/automated/data/package/simple-single-1.3.el:
+ * test/automated/data/package/simple-single-readme.txt:
+ * test/automated/data/package/simple-two-depend-1.1.el:
+ * test/automated/abbrev-tests.el:
+ * test/automated/auto-revert-tests.el:
+ * test/automated/calc-tests.el:
+ * test/automated/icalendar-tests.el:
+ * test/automated/character-fold-tests.el:
+ * test/automated/comint-testsuite.el:
+ * test/automated/descr-text-test.el:
+ * test/automated/electric-tests.el:
+ * test/automated/cl-generic-tests.el:
+ * test/automated/cl-lib-tests.el:
+ * test/automated/eieio-test-methodinvoke.el:
+ * test/automated/eieio-test-persist.el:
+ * test/automated/eieio-tests.el:
+ * test/automated/ert-tests.el:
+ * test/automated/ert-x-tests.el:
+ * test/automated/generator-tests.el:
+ * test/automated/let-alist.el:
+ * test/automated/map-tests.el:
+ * test/automated/advice-tests.el:
+ * test/automated/package-test.el:
+ * test/automated/pcase-tests.el:
+ * test/automated/regexp-tests.el:
+ * test/automated/seq-tests.el:
+ * test/automated/subr-x-tests.el:
+ * test/automated/tabulated-list-test.el:
+ * test/automated/thunk-tests.el:
+ * test/automated/timer-tests.el:
+ * test/automated/epg-tests.el:
+ * test/automated/eshell.el:
+ * test/automated/faces-tests.el:
+ * test/automated/file-notify-tests.el:
+ * test/automated/auth-source-tests.el:
+ * test/automated/gnus-tests.el:
+ * test/automated/message-mode-tests.el:
+ * test/automated/help-fns.el:
+ * test/automated/imenu-test.el:
+ * test/automated/info-xref.el:
+ * test/automated/mule-util.el:
+ * test/automated/isearch-tests.el:
+ * test/automated/json-tests.el:
+ * test/automated/bytecomp-tests.el:
+ * test/automated/coding-tests.el:
+ * test/automated/core-elisp-tests.el:
+ * test/automated/decoder-tests.el:
+ * test/automated/files.el:
+ * test/automated/font-parse-tests.el:
+ * test/automated/lexbind-tests.el:
+ * test/automated/occur-tests.el:
+ * test/automated/process-tests.el:
+ * test/automated/syntax-tests.el:
+ * test/automated/textprop-tests.el:
+ * test/automated/undo-tests.el:
+ * test/automated/man-tests.el:
+ * test/automated/completion-tests.el:
+ * test/automated/dbus-tests.el:
+ * test/automated/newsticker-tests.el:
+ * test/automated/sasl-scram-rfc-tests.el:
+ * test/automated/tramp-tests.el:
+ * test/automated/obarray-tests.el:
+ * test/automated/compile-tests.el:
+ * test/automated/elisp-mode-tests.el:
+ * test/automated/f90.el:
+ * test/automated/flymake-tests.el:
+ * test/automated/python-tests.el:
+ * test/automated/ruby-mode-tests.el:
+ * test/automated/subword-tests.el:
+ * test/automated/replace-tests.el:
+ * test/automated/simple-test.el:
+ * test/automated/sort-tests.el:
+ * test/automated/subr-tests.el:
+ * test/automated/reftex-tests.el:
+ * test/automated/sgml-mode-tests.el:
+ * test/automated/tildify-tests.el:
+ * test/automated/thingatpt.el:
+ * test/automated/url-future-tests.el:
+ * test/automated/url-util-tests.el:
+ * test/automated/add-log-tests.el:
+ * test/automated/vc-bzr.el:
+ * test/automated/vc-tests.el:
+ * test/automated/xml-parse-tests.el:
+ * test/BidiCharacterTest.txt:
+ * test/biditest.el:
+ * test/cedet/cedet-utests.el:
+ * test/cedet/ede-tests.el:
+ * test/cedet/semantic-ia-utest.el:
+ * test/cedet/semantic-tests.el:
+ * test/cedet/semantic-utest-c.el:
+ * test/cedet/semantic-utest.el:
+ * test/cedet/srecode-tests.el:
+ * test/cedet/tests/test.c:
+ * test/cedet/tests/test.el:
+ * test/cedet/tests/test.make:
+ * test/cedet/tests/testdoublens.cpp:
+ * test/cedet/tests/testdoublens.hpp:
+ * test/cedet/tests/testfriends.cpp:
+ * test/cedet/tests/testjavacomp.java:
+ * test/cedet/tests/testnsp.cpp:
+ * test/cedet/tests/testpolymorph.cpp:
+ * test/cedet/tests/testspp.c:
+ * test/cedet/tests/testsppcomplete.c:
+ * test/cedet/tests/testsppreplace.c:
+ * test/cedet/tests/testsppreplaced.c:
+ * test/cedet/tests/testsubclass.cpp:
+ * test/cedet/tests/testsubclass.hh:
+ * test/cedet/tests/testtypedefs.cpp:
+ * test/cedet/tests/testvarnames.c:
+ * test/etags/CTAGS.good:
+ * test/etags/ETAGS.good_1:
+ * test/etags/ETAGS.good_2:
+ * test/etags/ETAGS.good_3:
+ * test/etags/ETAGS.good_4:
+ * test/etags/ETAGS.good_5:
+ * test/etags/ETAGS.good_6:
+ * test/etags/a-src/empty.zz:
+ * test/etags/a-src/empty.zz.gz:
+ * test/etags/ada-src/2ataspri.adb:
+ * test/etags/ada-src/2ataspri.ads:
+ * test/etags/ada-src/etags-test-for.ada:
+ * test/etags/ada-src/waroquiers.ada:
+ * test/etags/c-src/a/b/b.c:
+ * test/etags/c-src/abbrev.c:
+ * test/etags/c-src/c.c:
+ * test/etags/c-src/dostorture.c:
+ * test/etags/c-src/emacs/src/gmalloc.c:
+ * test/etags/c-src/emacs/src/keyboard.c:
+ * test/etags/c-src/emacs/src/lisp.h:
+ * test/etags/c-src/emacs/src/regex.h:
+ * test/etags/c-src/etags.c:
+ * test/etags/c-src/exit.c:
+ * test/etags/c-src/exit.strange_suffix:
+ * test/etags/c-src/fail.c:
+ * test/etags/c-src/getopt.h:
+ * test/etags/c-src/h.h:
+ * test/etags/c-src/machsyscalls.c:
+ * test/etags/c-src/machsyscalls.h:
+ * test/etags/c-src/sysdep.h:
+ * test/etags/c-src/tab.c:
+ * test/etags/c-src/torture.c:
+ * test/etags/cp-src/MDiagArray2.h:
+ * test/etags/cp-src/Range.h:
+ * test/etags/cp-src/burton.cpp:
+ * test/etags/cp-src/c.C:
+ * test/etags/cp-src/clheir.cpp.gz:
+ * test/etags/cp-src/clheir.hpp:
+ * test/etags/cp-src/conway.cpp:
+ * test/etags/cp-src/conway.hpp:
+ * test/etags/cp-src/fail.C:
+ * test/etags/cp-src/functions.cpp:
+ * test/etags/cp-src/screen.cpp:
+ * test/etags/cp-src/screen.hpp:
+ * test/etags/cp-src/x.cc:
+ * test/etags/el-src/TAGTEST.EL:
+ * test/etags/el-src/emacs/lisp/progmodes/etags.el:
+ * test/etags/erl-src/gs_dialog.erl:
+ * test/etags/f-src/entry.for:
+ * test/etags/f-src/entry.strange.gz:
+ * test/etags/f-src/entry.strange_suffix:
+ * test/etags/forth-src/test-forth.fth:
+ * test/etags/html-src/algrthms.html:
+ * test/etags/html-src/index.shtml:
+ * test/etags/html-src/software.html:
+ * test/etags/html-src/softwarelibero.html:
+ * test/etags/lua-src/allegro.lua:
+ * test/etags/objc-src/PackInsp.h:
+ * test/etags/objc-src/PackInsp.m:
+ * test/etags/objc-src/Subprocess.h:
+ * test/etags/objc-src/Subprocess.m:
+ * test/etags/objcpp-src/SimpleCalc.H:
+ * test/etags/objcpp-src/SimpleCalc.M:
+ * test/etags/pas-src/common.pas:
+ * test/etags/perl-src/htlmify-cystic:
+ * test/etags/perl-src/kai-test.pl:
+ * test/etags/perl-src/yagrip.pl:
+ * test/etags/php-src/lce_functions.php:
+ * test/etags/php-src/ptest.php:
+ * test/etags/php-src/sendmail.php:
+ * test/etags/prol-src/natded.prolog:
+ * test/etags/prol-src/ordsets.prolog:
+ * test/etags/ps-src/rfc1245.ps:
+ * test/etags/pyt-src/server.py:
+ * test/etags/tex-src/gzip.texi:
+ * test/etags/tex-src/nonewline.tex:
+ * test/etags/tex-src/testenv.tex:
+ * test/etags/tex-src/texinfo.tex:
+ * test/etags/y-src/atest.y:
+ * test/etags/y-src/cccp.c:
+ * test/etags/y-src/cccp.y:
+ * test/etags/y-src/parse.c:
+ * test/etags/y-src/parse.y:
+ * test/indent/css-mode.css:
+ * test/indent/js-indent-init-dynamic.js:
+ * test/indent/js-indent-init-t.js:
+ * test/indent/js-jsx.js:
+ * test/indent/js.js:
+ * test/indent/latex-mode.tex:
+ * test/indent/modula2.mod:
+ * test/indent/nxml.xml:
+ * test/indent/octave.m:
+ * test/indent/pascal.pas:
+ * test/indent/perl.perl:
+ * test/indent/prolog.prolog:
+ * test/indent/ps-mode.ps:
+ * test/indent/ruby.rb:
+ * test/indent/scheme.scm:
+ * test/indent/scss-mode.scss:
+ * test/indent/sgml-mode-attribute.html:
+ * test/indent/shell.rc:
+ * test/indent/shell.sh:
+ * test/redisplay-testsuite.el:
+ * test/rmailmm.el:
+ * test/automated/buffer-tests.el:
+ * test/automated/cmds-tests.el:
+ * test/automated/data-tests.el:
+ * test/automated/finalizer-tests.el:
+ * test/automated/fns-tests.el:
+ * test/automated/inotify-test.el:
+ * test/automated/keymap-tests.el:
+ * test/automated/print-tests.el:
+ * test/automated/libxml-tests.el:
+ * test/automated/zlib-tests.el: Files Moved.
2015-11-21 Wilson Snyder <wsnyder@wsnyder.org>
verilog-mode.el: Commentary and fix pre-Emacs 21 behavior.
- * verilog-mode.el (verilog-save-font-no-change-functions):
- Commentary and fix pre-Emacs 21 behavior.
+ * lisp/progmodes/verilog-mode.el
+ (verilog-save-font-no-change-functions): Commentary and fix
+ pre-Emacs 21 behavior.
2015-11-20 Michael Albinus <michael.albinus@gmx.de>
@@ -22324,8 +51016,8 @@
Minor fix to comment indentation and typo in last commit
- * linum.el (linum-update-window): Fix comment indentation and a
- typo.
+ * lisp/linum.el (linum-update-window): Fix comment indentation and
+ a typo.
2015-11-17 João Távora <joaotavora@gmail.com>
@@ -22342,7 +51034,7 @@
A similar fix was commited to nlinum.el in ELPA.git's
e7f5f549fbfb740b911fb7f33b42381ecece56d8
- * linum.el (linum-delete-overlays): Restore margins more
+ * lisp/linum.el (linum-delete-overlays): Restore margins more
criteriously.
(linum-update-window): Set margins more criteriously.
@@ -22518,7 +51210,7 @@
Update verilog-mode.el to 2015-11-09-b121d60-vpo.
- * verilog-mode.el (verilog-auto, verilog-delete-auto)
+ * lisp/progmodes/verilog-mode.el (verilog-auto, verilog-delete-auto)
(verilog-modi-cache-results, verilog-save-buffer-state)
(verilog-save-font-no-change-functions): When internally suppressing change
functions, use `inhibit-modification-hooks' and call
@@ -22597,7 +51289,7 @@
This file records repository revisions from
commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to
-commit f15f6b53078ac2176f8d2c05d99d3d9b4d32986b (inclusive).
+commit e8a7c41b4e2dc9df18038d2931ed883946a2bb50 (inclusive).
See ChangeLog.1 for earlier changes.
;; Local Variables:
@@ -22619,4 +51311,4 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/GNUmakefile b/GNUmakefile
index 98d31f4afcb..3627d220d02 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
#
# written by Paul Eggert
@@ -62,13 +62,10 @@ default $(ORDINARY_GOALS): Makefile
# Execute in sequence, so that multiple user goals don't conflict.
.NOTPARALLEL:
-# 'all' if a .git subdirectory is present, empty otherwise.
-ALL_IF_GIT = $(subst .git,all,$(wildcard .git))
-
configure:
@echo >&2 'There seems to be no "configure" file in this directory.'
- @echo >&2 Running ./autogen.sh $(ALL_IF_GIT) ...
- ./autogen.sh $(ALL_IF_GIT)
+ @echo >&2 Running ./autogen.sh ...
+ ./autogen.sh
@echo >&2 '"configure" file built.'
Makefile: configure
diff --git a/INSTALL b/INSTALL
index ea968904325..e93b3064fcb 100644
--- a/INSTALL
+++ b/INSTALL
@@ -24,7 +24,7 @@ find some things, or what options to use.
'src/config.h' file containing system-dependent definitions.
Running the 'make' utility then builds the package for your system.
-Building Emacs requires GNU make, <http://www.gnu.org/software/make/>.
+Building Emacs requires GNU make, <https://www.gnu.org/software/make/>.
On most systems that Emacs supports, this is the default 'make' program.
Here's the procedure to build Emacs using 'configure' on systems which
@@ -162,7 +162,7 @@ can be found (in the unlikely event that your distribution does not
provide them). By default, libraries marked with an X are required if
X11 is being used.
- libXaw3d http://directory.fsf.org/project/xaw3d/
+ libXaw3d https://directory.fsf.org/project/xaw3d/
X libxpm for XPM: http://www.x.org/releases/current/src/lib/
X libpng for PNG: http://www.libpng.org/
libz (for PNG): http://www.zlib.net/
@@ -187,7 +187,7 @@ them.
On the GNU system, Emacs supports both X fonts and local fonts
(i.e. fonts managed by the fontconfig library). If you need more
fonts than your distribution normally provides, you must install them
-yourself. See <URL:http://www.gnu.org/software/freefont/> for a large
+yourself. See <https://www.gnu.org/software/freefont/> for a large
number of free Unicode fonts.
* GNU/Linux development packages
@@ -261,10 +261,10 @@ Emacs with the options '--without-dbus --without-gconf --without-gsettings'.
To read email via a network protocol like IMAP or POP, you can
configure Emacs with the option '--with-mailutils', so that it always
-uses the GNU Mailutils 'movemail' program to retrieve mail. Otherwise
-the Emacs build procedure builds and installs an auxiliary 'movemail'
-program, a limited and insecure substitute that Emacs can use when
-Mailutils is not installed; when this happens, there are several
+uses the GNU Mailutils 'movemail' program to retrieve mail; this is
+the default if GNU Mailutils is installed. Otherwise the Emacs build
+procedure builds and installs an auxiliary 'movemail' program, a
+limited and insecure substitute; when this happens, there are several
configure options such as --without-pop that provide fine-grained
control over Emacs 'movemail' construction.
@@ -272,10 +272,11 @@ The Emacs mail reader RMAIL is configured to be able to read mail from
a POP3 server by default. Versions of the POP protocol older than
POP3 are not supported. While POP3 support is typically enabled,
whether Emacs actually uses POP3 is controlled by individual users;
-see the Rmail chapter of the Emacs manual. Unless you configure
---with-mailutils, it is a good idea to configure --without-pop so that
+see the Rmail chapter of the Emacs manual. Unless --with-mailutils is
+in effect, it is a good idea to configure without POP3 support so that
users are less likely to inadvertently read email via insecure
-channels.
+channels. On native MS-Windows, --with-pop is the default; on other
+platforms, --without-pop is the default.
For image support you may have to download, build, and install the
appropriate image support libraries for image types other than XBM and
@@ -340,17 +341,13 @@ Use --disable-silent-rules to cause 'make' to give more details about
the commands it executes. This can be helpful when debugging a build
that goes awry. 'make V=1' also enables the extra chatter.
-Use --enable-link-time-optimization to enable link-time optimizer. If
-you're using GNU compiler, this feature is supported since version 4.5.0.
-If 'configure' can determine number of online CPUS on your system, final
-link-time optimization and code generation is executed in parallel using
-one job per each available online CPU.
-
-This option is also supported for clang. You should have GNU binutils
-with 'gold' linker and plugin support, and clang with LLVMgold.so plugin.
-Read http://llvm.org/docs/GoldPlugin.html for details. Also note that
-this feature is still experimental, so prepare to build binutils and
-clang from the corresponding source code repositories.
+Use --enable-link-time-optimization to enable link-time optimization.
+With GCC, you need GCC 4.5.0 and later, and 'configure' arranges for
+linking to be parallelized if possible. With Clang, you need GNU
+binutils with the gold linker and plugin support, along with the LLVM
+gold plugin <http://llvm.org/docs/GoldPlugin.html>. Link time
+optimization is not the default as it tends to cause crashes and to
+make Emacs slower.
The '--prefix=PREFIXDIR' option specifies where the installation process
should put emacs and its data files. This defaults to '/usr/local'.
@@ -550,7 +547,7 @@ information on this.
Emacs info files.
8) If your system uses lock files to interlock access to mailer inbox files,
-and if you did not configure --with-mailutils, then you might need to
+and if --with-mailutils is not in effect, then you might need to
make the Emacs-specific 'movemail' program setuid or setgid in order
to enable it to write the lock files. We believe this is safe.
@@ -683,4 +680,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/INSTALL.REPO b/INSTALL.REPO
index ce346bb246c..a5b60cf6cb1 100644
--- a/INSTALL.REPO
+++ b/INSTALL.REPO
@@ -19,7 +19,7 @@ To use the autotools, run the following shell command to generate the
'configure' script and some related files, and to set up your git
configuration:
- $ ./autogen.sh all
+ $ ./autogen.sh
You can then configure your build as follows:
@@ -54,7 +54,7 @@ If CPU time is not an issue, 'make bootstrap' is a more thorough way
to rebuild, avoiding spurious problems.
Occasionally, there are changes that 'make bootstrap' won't be able to
-handle. The most thorough cleaning can be achieved by 'git clean -fx'
+handle. The most thorough cleaning can be achieved by 'git clean -fdx'
which will leave you with only files from the git repository. Here
are some faster methods for a couple of particular error cases:
@@ -91,4 +91,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/Makefile.in b/Makefile.in
index a31d416bd74..3f46d0acafa 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
@@ -448,7 +448,7 @@ config.status: ${srcdir}/configure
fi
$(srcdir)/configure: $(srcdir)/configure.ac $(srcdir)/m4/*.m4
- cd $(srcdir) && ./autogen.sh
+ cd $(srcdir) && ./autogen.sh autoconf
# ==================== Installation ====================
@@ -511,7 +511,7 @@ install-nt:
## For them, it is empty.
INSTALL_ARCH_INDEP_EXTRA = @INSTALL_ARCH_INDEP_EXTRA@
-## http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg01672.html
+## https://lists.gnu.org/r/emacs-devel/2007-10/msg01672.html
## Needs to be the user running install, so configure can't set it.
set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \
`id -un 2> /dev/null`; do \
@@ -550,11 +550,11 @@ set_installuser=for installuser in $${LOGNAME} $${USERNAME} $${USER} \
## Note that we use tar instead of plain old cp -R/-r because the latter
## is apparently not portable (even in 2012!).
-## http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00278.html
+## https://lists.gnu.org/r/emacs-devel/2012-05/msg00278.html
## I have no idea which platforms Emacs supports where cp -R does not
## work correctly, and therefore no idea when tar can be replaced.
## See also these comments from 2004 about cp -r working fine:
-## http://lists.gnu.org/archive/html/autoconf-patches/2004-11/msg00005.html
+## https://lists.gnu.org/r/autoconf-patches/2004-11/msg00005.html
install-arch-indep: lisp install-info install-man ${INSTALL_ARCH_INDEP_EXTRA}
-set ${COPYDESTS} ; \
unset CDPATH; \
@@ -991,8 +991,7 @@ ${srcdir}/info/dir: ${info_dir_deps}
$(AM_V_at)${MKDIR_P} ${srcdir}/info
$(AM_V_GEN)(cd ${srcdir}/doc && \
AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \
- ) >$@.tmp
- mv $@.tmp $@
+ ) >$@.tmp && mv $@.tmp $@
INSTALL_DVI = install-emacs-dvi install-lispref-dvi \
install-lispintro-dvi install-misc-dvi
@@ -1094,7 +1093,7 @@ check-info: info
# * Rebuild Makefile, to update the build procedure itself.
# * Do the actual build.
bootstrap: bootstrap-clean
- cd $(srcdir) && ./autogen.sh
+ cd $(srcdir) && ./autogen.sh autoconf
$(MAKE) MAKEFILE_NAME=force-Makefile force-Makefile
$(MAKE) all
@@ -1116,7 +1115,7 @@ ChangeLog:
./$(emacslog) -o $(CHANGELOG) -n $(CHANGELOG_HISTORY_INDEX_MAX)
# Check that we are in a good state for changing history.
-PREFERRED_BRANCH = master
+PREFERRED_BRANCH = emacs-26
preferred-branch-is-current:
git branch | grep -q '^\* $(PREFERRED_BRANCH)$$'
unchanged-history-files:
diff --git a/README b/README
index 494ee08c2b7..0b0d3a3eac6 100644
--- a/README
+++ b/README
@@ -2,7 +2,7 @@ Copyright (C) 2001-2017 Free Software Foundation, Inc.
See the end of the file for license conditions.
-This directory tree holds version 26.0.50 of GNU Emacs, the extensible,
+This directory tree holds version 27.0.50 of GNU Emacs, the extensible,
customizable, self-documenting real-time display editor.
The file INSTALL in this directory says how to build and install GNU
@@ -28,8 +28,8 @@ See the "Bugs" section of the Emacs manual for more information on how
to report bugs. (The file 'BUGS' in this directory explains how you
can find and read that section using the Info files that come with
Emacs.) For a list of mailing lists related to Emacs, see
-<http://savannah.gnu.org/mail/?group=emacs>. For the complete
-list of GNU mailing lists, see <http://lists.gnu.org/>.
+<https://savannah.gnu.org/mail/?group=emacs>. For the complete
+list of GNU mailing lists, see <https://lists.gnu.org/>.
The 'etc' subdirectory contains several other files, named in capital
letters, which you might consider looking at when installing GNU
@@ -45,7 +45,8 @@ The file 'configure.ac' is the input used by the autoconf program to
construct the 'configure' script.
The shell script 'autogen.sh' generates 'configure' and other files by
-running Autoconf, which in turn uses GNU m4. If you want to use it,
+running Autoconf (which in turn uses GNU m4), and configures files in
+the .git subdirectory if you are using Git. If you want to use it,
you will need to install recent versions of these build tools. This
should be needed only if you edit files like 'configure.ac' that
specify Emacs's autobuild procedure.
@@ -115,4 +116,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES
index cead305aee1..04d1ff76f36 100644
--- a/admin/CPP-DEFINES
+++ b/admin/CPP-DEFINES
@@ -19,7 +19,6 @@ __DJGPP_MINOR__ Minor version number of the DJGPP library; used only in msdos.c
DOS_NT Compiling for either the MS-DOS or native MS-Windows port.
WINDOWSNT Compiling the native MS-Windows (W32) port.
__MINGW32__ Compiling the W32 port with the MinGW or MinGW-w64 ports of GCC.
-_MSC_VER Compiling the W32 port with the Microsoft C compiler.
MINGW_W64 Compiling the W32 port with the MinGW-w64 port of GCC.
DARWIN_OS Compiling on macOS or pure Darwin (and using s/darwin.h).
SOLARIS2
@@ -103,7 +102,6 @@ HAVE_ALARM
HAVE_ALLOCA
HAVE_ALLOCA_H
HAVE_ALSA
-HAVE_ATTRIBUTE_ALIGNED
HAVE_BDFFONT
HAVE_BOXES
HAVE_C99_STRTOLD
@@ -205,7 +203,6 @@ HAVE_LIBXML2
HAVE_LIBXMU
HAVE_LOCALTIME_R
HAVE_LOCAL_SOCKETS
-HAVE_LONG_FILE_NAMES
HAVE_LONG_LONG_INT
HAVE_LRAND48
HAVE_LSTAT
diff --git a/admin/ChangeLog.1 b/admin/ChangeLog.1
index b1aaee7cb60..90401799a66 100644
--- a/admin/ChangeLog.1
+++ b/admin/ChangeLog.1
@@ -1547,7 +1547,7 @@
* make-tarball.txt: Suggest 'autoreconf -I m4 --force'
rather than doing rm and autoconf by hand. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00673.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00673.html>.
2011-01-17 Paul Eggert <eggert@cs.ucla.edu>
@@ -2592,4 +2592,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/MAINTAINERS b/admin/MAINTAINERS
index c13cb552a78..753a676e81a 100644
--- a/admin/MAINTAINERS
+++ b/admin/MAINTAINERS
@@ -62,6 +62,7 @@ Michael Albinus
lisp/url/url-tramp.el
doc/misc/tramp*.texi
test/lisp/net/tramp-tests.el
+ test/lisp/url/url-tramp-tests.el
D-Bus
src/dbusbind.c
diff --git a/admin/README b/admin/README
index cb6ba859926..7906844309a 100644
--- a/admin/README
+++ b/admin/README
@@ -78,7 +78,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
mode: outline
diff --git a/admin/admin.el b/admin/admin.el
index e81e7f1e7e1..bedb6b2c032 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -114,7 +114,7 @@ Root must be the root of an Emacs source tree."
;; configure.ac with sed, rather than duplicating the information.
(set-version-in-file root "msdos/sed2v2.inp" version
(rx (and bol "/^#undef " (1+ not-newline)
- "define VERSION" (1+ space) "\""
+ "define PACKAGE_VERSION" (1+ space) "\""
(submatch (1+ (in "0-9."))))))
;; Major version only.
(when (string-match "\\([0-9]\\{2,\\}\\)" version)
@@ -158,11 +158,17 @@ Documentation changes might not have been completed!"))))
(re-search-forward "is about changes in Emacs version \\([0-9]+\\)")
(replace-match (number-to-string newmajor) nil nil nil 1)
(re-search-forward "^See files \\(NEWS\\)")
- (replace-match (format "NEWS.%s, NEWS" oldmajor) nil nil nil 1)
- (let ((start (line-beginning-position)))
- (search-forward "in older Emacs versions")
- (or (equal start (line-beginning-position))
- (fill-region start (line-beginning-position 2))))
+ (unless (save-match-data
+ (when (looking-at "\\(\\..*\\), \\(\\.\\.\\.\\|…\\)")
+ (replace-match
+ (format ".%s, NEWS.%s" oldmajor (1- oldmajor))
+ nil nil nil 1)
+ t))
+ (replace-match (format "NEWS.%s, NEWS" oldmajor) nil nil nil 1)
+ (let ((start (line-beginning-position)))
+ (search-forward "in older Emacs versions")
+ (or (equal start (line-beginning-position))
+ (fill-region start (line-beginning-position 2)))))
(re-search-forward "^ $")
(forward-line -1)
(let ((start (point)))
@@ -893,3 +899,7 @@ changes (in a non-trivial way). This function does not check for that."
(provide 'admin)
;;; admin.el ends here
+
+;; Local Variables:
+;; coding: utf-8
+;; End:
diff --git a/admin/alloc-colors.c b/admin/alloc-colors.c
index fa6a639d88b..a4701dd77bd 100644
--- a/admin/alloc-colors.c
+++ b/admin/alloc-colors.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <X11/Xlib.h>
diff --git a/admin/authors.el b/admin/authors.el
index 86d42be8dc6..603ceb3fa08 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -1,3 +1,4 @@
+
;;; authors.el --- utility for maintaining Emacs's AUTHORS file
;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
@@ -20,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -391,7 +392,7 @@ Changes to files matching one of the regexps in this list are not listed.")
"vms" "mac" "url" "tree-widget"
"info/dir"
;; Not in gnulib anymore
- "lib/qset-acl.c" "lib/qcopy-acl.c" "lib/file-has-acl.c"
+ "lib/qset-acl.c" "lib/qcopy-acl.c" "lib/file-has-acl.c" "lib/secure_getenv.c"
;; files from old MS Windows build procedures
"nt/gnulib-modules-to-delete.cfg"
"makefile.w32-in"
@@ -736,6 +737,8 @@ Changes to files in this list are not listed.")
"org-exp-blocks.el" ; maybe this is ob-exp now? dunno
"org-lparse.el"
"org-special-blocks.el" "org-taskjuggler.el"
+ "ob-sh.el"
+ "ob-scala.el"
"progmodes/cap-words.el"
"w32-common-fns.el"
;; gnus
@@ -751,7 +754,7 @@ Changes to files in this list are not listed.")
"format-spec.el" "gnus-move.el" "gnus-sync.el"
"auth-source.el" "ecomplete.el" "gravatar.el" "mailcap.el" "plstore.el"
"pop3.el" "qp.el" "registry.el" "rfc2231.el" "rtree.el"
- "sieve.el" "sieve-mode.el"
+ "sieve.el" "sieve-mode.el" "gnus-ems.el"
;; doc
"getopt.c" "texindex.c" "news.texi" "vc.texi" "vc2-xtra.texi"
"back.texi" "vol1.texi" "vol2.texi" "elisp-covers.texi" "two.el"
@@ -801,7 +804,12 @@ Changes to files in this list are not listed.")
"cedet-utests.el" "ede-tests.el" "semantic-ia-utest.el"
"semantic-tests.el" "semantic-utest-c.el" "semantic-utest.el"
"srecode-tests.el" "make-test-deps.emacs-lisp"
- )
+ "nxml-uchnm.el"
+ "decoder-tests.el"
+ "obsolete/scribe.el"
+ "cp51932.el"
+ "eucjp-ms.el"
+ "lisp.mk")
"File names which are valid, but no longer exist (or cannot be found)
in the repository.")
@@ -906,6 +914,9 @@ in the repository.")
("patcomp.el" . "patcomp.el")
("emulation/ws-mode.el" . "ws-mode.el")
("vc/vc-arch.el" . "vc-arch.el")
+ ("lisp/gnus/messcompat.el" . "messcompat.el")
+ ("html2text.el" . "html2text.el")
+ ("lisp/net/html2text.el" . "html2text.el")
;; From lisp to etc/forms.
("forms-d2.el" . "forms-d2.el")
("forms-pass.el" . "forms-pass.el")
@@ -950,9 +961,17 @@ in the repository.")
;; Moved from lisp/gnus/ to lisp/mail/
("binhex.el" . "mail/binhex.el")
("uudecode.el" . "mail/uudecode.el")
+ ("mail-parse.el" . "mail/mail-parse.el")
+ ("yenc.el" . "mail/yenc.el")
+ ("flow-fill.el" . "mail/flow-fill.el")
+ ("ietf-drums.el" . "mail/ietf-drums.el")
+ ("sieve-manage.el" . "mail/sieve-manage.el")
+ ;; Moved from lisp/gnus/ to lisp/image/
+ ("compface.el" . "image/compface.el")
;; Moved from lisp/gnus/ to lisp/net/
("imap.el" . "net/imap.el")
("rfc2104.el" . "net/rfc2104.el")
+ ("starttls.el" . "net/starttls.el")
;; And from emacs/ to misc/ and back again.
("ns-emacs.texi" . "macos.texi")
("overrides.texi" . "gnus-overrides.texi")
@@ -993,6 +1012,7 @@ in the repository.")
("edt-user.doc" . "edt.texi")
("DEV-NOTES" . "nextstep")
("org/COPYRIGHT-AND-LICENSE" . "org/README")
+ ("lisp/net/idna.el" . "puny.el")
;; Moved to different directories.
("ctags.1" . "ctags.1")
("etags.1" . "etags.1")
@@ -1021,6 +1041,8 @@ in the repository.")
;; module.* moved to emacs-module.*
("src/module.h" . "src/emacs-module.h")
("src/module.c" . "src/emacs-module.c")
+ ;; gnulib
+ ("lib/strftime.c" . "lib/nstrftime.c")
)
"Alist of files which have been renamed during their lifetime.
Elements are (OLDNAME . NEWNAME).")
@@ -1299,9 +1321,10 @@ it is found in `authors-fixed-case'."
(setq author (replace-regexp-in-string "[ \t]+" " " author))
;; NB this ignores the first name only case.
(unless (string-match "[-, \t]" author)
- (push (format-message "%s:%d: ignored `%s'"
- file (1+ (count-lines (point-min) pos)) author)
- authors-ignored-names)
+ (or (authors-lax-changelog-p file)
+ (push (format-message "%s:%d: ignored `%s'"
+ file (1+ (count-lines (point-min) pos)) author)
+ authors-ignored-names))
(setq author ""))
(or (car (member author authors-fixed-case))
(capitalize author))))
diff --git a/admin/build-configs b/admin/build-configs
index aa62dadc912..ac3147fe63b 100755
--- a/admin/build-configs
+++ b/admin/build-configs
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
require 5;
@@ -97,4 +97,3 @@ foreach $config (@configs)
# Local Variables:
# mode: cperl
# End:
-
diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el
index 46a5e42aa7b..d867c053e5c 100644
--- a/admin/bzrmerge.el
+++ b/admin/bzrmerge.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/admin/charsets/Makefile.in b/admin/charsets/Makefile.in
index b154bc13d45..0c252ae919f 100644
--- a/admin/charsets/Makefile.in
+++ b/admin/charsets/Makefile.in
@@ -19,7 +19,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/admin/charsets/big5.awk b/admin/charsets/big5.awk
index 7482d11a2d1..2393f9144bc 100644
--- a/admin/charsets/big5.awk
+++ b/admin/charsets/big5.awk
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
BEGIN {
tohex["A"] = 10;
@@ -68,5 +68,3 @@ function decode_big5(big5) {
code = decode_big5(big5);
printf "0x%04X %s\n", code, $2;
}
-
-
diff --git a/admin/charsets/compact.awk b/admin/charsets/compact.awk
index 21e03ee4157..b912a0fd203 100644
--- a/admin/charsets/compact.awk
+++ b/admin/charsets/compact.awk
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
# Make a charset map compact by changing this kind of line sequence:
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk
index df1f8cd7b23..6aac98815b5 100644
--- a/admin/charsets/cp51932.awk
+++ b/admin/charsets/cp51932.awk
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
diff --git a/admin/charsets/cp932.awk b/admin/charsets/cp932.awk
index acba0333371..7fd3e9111f5 100644
--- a/admin/charsets/cp932.awk
+++ b/admin/charsets/cp932.awk
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
@@ -113,4 +113,3 @@ END {
printf "0x%02X%02X 0x%04X # 4\n", i, j, code++;
}
}
-
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index 24152b44eff..94e27d00651 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
diff --git a/admin/charsets/gb180302.awk b/admin/charsets/gb180302.awk
index 4947f966371..1a6995a1cb4 100644
--- a/admin/charsets/gb180302.awk
+++ b/admin/charsets/gb180302.awk
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
BEGIN {
tohex["A"] = 10;
diff --git a/admin/charsets/gb180304.awk b/admin/charsets/gb180304.awk
index 81d7e7301bf..9c6522b5729 100644
--- a/admin/charsets/gb180304.awk
+++ b/admin/charsets/gb180304.awk
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
BEGIN {
tohex["A"] = 10;
diff --git a/admin/charsets/mapconv b/admin/charsets/mapconv
index 5f62ff90d3a..8ee3d142e72 100755
--- a/admin/charsets/mapconv
+++ b/admin/charsets/mapconv
@@ -19,7 +19,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README
index f9dc2ba99f8..f4fea85e8b6 100644
--- a/admin/charsets/mapfiles/README
+++ b/admin/charsets/mapfiles/README
@@ -80,4 +80,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el
index 4ccf4bfb5be..8355af4488d 100644
--- a/admin/charsets/mule-charsets.el
+++ b/admin/charsets/mule-charsets.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; For the record: the old, pre-v23 code was this:
@@ -67,4 +67,3 @@
(sort-lines nil (point-min) (point-max))
(let ((coding-system-for-write 'unix))
(write-file (car elt)))))
-
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 3808a44eff6..a8582ac59cf 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/admin/diff-tar-files b/admin/diff-tar-files
index 23df9ff1922..f45d72f1a66 100755
--- a/admin/diff-tar-files
+++ b/admin/diff-tar-files
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
if [ $# != 2 ]; then
diff --git a/admin/find-gc.el b/admin/find-gc.el
index 53ac9220408..91acbb5149d 100644
--- a/admin/find-gc.el
+++ b/admin/find-gc.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/admin/gitmerge.el b/admin/gitmerge.el
index a0efce5ea69..69f48b877af 100644
--- a/admin/gitmerge.el
+++ b/admin/gitmerge.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -67,8 +67,9 @@ re-?generate\\|bump version\\|from trunk\\|Auto-commit"
'((t (:strike-through t)))
"Face for skipped commits.")
-(defconst gitmerge-default-branch "origin/emacs-25"
- "Default for branch that should be merged.")
+(defvar gitmerge-default-branch nil
+ "Default for branch that should be merged.
+If nil, the function `gitmerge-default-branch' guesses.")
(defconst gitmerge-buffer "*gitmerge*"
"Working buffer for gitmerge.")
@@ -103,6 +104,21 @@ re-?generate\\|bump version\\|from trunk\\|Auto-commit"
(defvar gitmerge--commits nil)
(defvar gitmerge--from nil)
+(defun gitmerge-emacs-version (&optional branch)
+ "Return the major version of Emacs, optionally in BRANCH."
+ (with-temp-buffer
+ (if (not branch)
+ (insert-file-contents "configure.ac")
+ (call-process "git" nil t nil "show" (format "%s:configure.ac" branch))
+ (goto-char (point-min)))
+ (re-search-forward "^AC_INIT([^,]+, \\([0-9]+\\)\\.")
+ (string-to-number (match-string 1))))
+
+(defun gitmerge-default-branch ()
+ "Default for branch that should be merged; eg \"origin/emacs-26\"."
+ (or gitmerge-default-branch
+ (format "origin/emacs-%s" (1- (gitmerge-emacs-version)))))
+
(defun gitmerge-get-sha1 ()
"Get SHA1 from commit at point."
(save-excursion
@@ -291,23 +307,47 @@ Returns non-nil if conflicts remain."
;; (pop-to-buffer (current-buffer)) (debug 'before-resolve)
))
;; Try to resolve the conflicts.
- (cond
- ((member file '("configure" "lisp/ldefs-boot.el"
- "lisp/emacs-lisp/cl-loaddefs.el"))
- ;; We are in the file's buffer, so names are relative.
- (call-process "git" nil t nil "checkout" "--"
- (file-name-nondirectory file))
- (revert-buffer nil 'noconfirm))
- (t
- (goto-char (point-max))
- (while (re-search-backward smerge-begin-re nil t)
- (save-excursion
- (ignore-errors
- (smerge-match-conflict)
- (smerge-resolve))))
- ;; (when (derived-mode-p 'change-log-mode)
- ;; (pop-to-buffer (current-buffer)) (debug 'after-resolve))
- (save-buffer)))
+ (let (temp)
+ (cond
+ ((and (equal file "etc/NEWS")
+ (ignore-errors
+ (setq temp
+ (format "NEWS.%s"
+ (gitmerge-emacs-version gitmerge--from))))
+ (file-exists-p temp)
+ (or noninteractive
+ (y-or-n-p "Try to fix NEWS conflict? ")))
+ (let ((relfile (file-name-nondirectory file))
+ (tempfile (make-temp-file "gitmerge")))
+ (unwind-protect
+ (progn
+ (call-process "git" nil `(:file ,tempfile) nil "diff"
+ (format ":1:%s" file)
+ (format ":3:%s" file))
+ (call-process "git" nil t nil "reset" "--" relfile)
+ (call-process "git" nil t nil "checkout" "--" relfile)
+ (revert-buffer nil 'noconfirm)
+ (call-process "patch" tempfile nil nil temp)
+ (call-process "git" nil t nil "add" "--" temp))
+ (delete-file tempfile))))
+ ;; Generated files.
+ ((member file '("lisp/ldefs-boot.el"))
+ ;; We are in the file's buffer, so names are relative.
+ (call-process "git" nil t nil "reset" "--"
+ (file-name-nondirectory file))
+ (call-process "git" nil t nil "checkout" "--"
+ (file-name-nondirectory file))
+ (revert-buffer nil 'noconfirm))
+ (t
+ (goto-char (point-max))
+ (while (re-search-backward smerge-begin-re nil t)
+ (save-excursion
+ (ignore-errors
+ (smerge-match-conflict)
+ (smerge-resolve))))
+ ;; (when (derived-mode-p 'change-log-mode)
+ ;; (pop-to-buffer (current-buffer)) (debug 'after-resolve))
+ (save-buffer))))
(goto-char (point-min))
(prog1 (re-search-forward smerge-begin-re nil t)
(unless exists (kill-buffer))))))))
@@ -400,7 +440,7 @@ Throw an user-error if we cannot resolve automatically."
"\n - You can safely close this Emacs session and do this "
"in a new one."
"\n - When running gitmerge again, remember that you must "
- "that from within the Emacs repo.\n")
+ "do that from within the Emacs repo.\n")
(pop-to-buffer (current-buffer)))
(user-error "Resolve the conflicts manually"))))))
@@ -495,7 +535,7 @@ Branch FROM will be prepended to the list."
(if (gitmerge-maybe-resume)
'resume
(completing-read "Merge branch: " (gitmerge-get-all-branches)
- nil t gitmerge-default-branch))))))
+ nil t (gitmerge-default-branch)))))))
(let ((default-directory (vc-git-root default-directory)))
(if (eq from 'resume)
(progn
diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in
index fd1d8954e58..740168fc735 100644
--- a/admin/grammars/Makefile.in
+++ b/admin/grammars/Makefile.in
@@ -15,7 +15,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/admin/grammars/c.by b/admin/grammars/c.by
index c312fd636df..da9f967a160 100644
--- a/admin/grammars/c.by
+++ b/admin/grammars/c.by
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; TODO: From Nate Schley
;; > * Can't parse signature element: "const char* const rmc_ClrTxt"
diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy
index ffbe7cc4a99..d64dcdcbfd9 100644
--- a/admin/grammars/grammar.wy
+++ b/admin/grammars/grammar.wy
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
%package semantic-grammar-wy
%provide semantic/grammar-wy
diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy
index bbad38d23f6..f1a4c147cd1 100644
--- a/admin/grammars/java-tags.wy
+++ b/admin/grammars/java-tags.wy
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
%package wisent-java-tags-wy
%provide semantic/wisent/javat-wy
diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy
index 72b662e1795..ded8023b7f4 100644
--- a/admin/grammars/js.wy
+++ b/admin/grammars/js.wy
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/admin/grammars/make.by b/admin/grammars/make.by
index 0bfde31979f..d3a03ead472 100644
--- a/admin/grammars/make.by
+++ b/admin/grammars/make.by
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
%package semantic-make-by
%provide semantic/bovine/make-by
@@ -134,7 +134,7 @@ elements: element some-whitespace elements
( ,@$1 )
| ;;EMPTY
;
-
+
element: sub-element element
( (concat (car ,$1) (car ,$2)) )
| ;;EMPTY
diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy
index 23aa65cd7f1..c8426e2581d 100644
--- a/admin/grammars/python.wy
+++ b/admin/grammars/python.wy
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by
index c4d6a392f7c..86fe81d1852 100644
--- a/admin/grammars/scheme.by
+++ b/admin/grammars/scheme.by
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
%package semantic-scm-by
%provide semantic/bovine/scm-by
@@ -98,4 +98,3 @@ expression : symbol
;
;;; scheme.by ends here
-
diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy
index 811a3240604..aefa4c81242 100644
--- a/admin/grammars/srecode-template.wy
+++ b/admin/grammars/srecode-template.wy
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/admin/last-chance.el b/admin/last-chance.el
index cab2d4718d6..76b8bcf6db1 100644
--- a/admin/last-chance.el
+++ b/admin/last-chance.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/admin/make-emacs b/admin/make-emacs
index 4c735065e54..0938336407e 100755
--- a/admin/make-emacs
+++ b/admin/make-emacs
@@ -17,7 +17,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
require 5;
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index e5c77172c9f..ac6d15d6cee 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -5,7 +5,7 @@ Instructions to create pretest or release tarballs. -*- coding: utf-8 -*-
Steps to take before starting on the first pretest in any release sequence:
-0. The release branch (e.g. emacs-25) should already have been made
+0. The release branch (e.g. emacs-26) should already have been made
and you should use it for all that follows. Diffs from this
branch should be going to the emacs-diffs mailing list.
@@ -18,7 +18,7 @@ Steps to take before starting on the first pretest in any release sequence:
when preparing the first pretest for a major Emacs release.)
Commit cus-edit.el if changed.
-3. Remove any old pretests from ftp://alpha.gnu.org/gnu/emacs/pretest.
+3. Remove any old pretests from https://alpha.gnu.org/gnu/emacs/pretest.
You can use 'gnupload --delete' (see below for more gnupload details).
General steps (for each step, check for possible errors):
@@ -101,8 +101,8 @@ General steps (for each step, check for possible errors):
Check the contents of the new tar with admin/diff-tar-files
against the previous release (if this is the first pretest) or the
previous pretest. If you did not make the previous pretest
- yourself, find it at <ftp://alpha.gnu.org/gnu/emacs/pretest>.
- Releases are of course at <ftp://ftp.gnu.org/pub/gnu/emacs/>.
+ yourself, find it at <https://alpha.gnu.org/gnu/emacs/pretest>.
+ Releases are of course at <https://ftp.gnu.org/pub/gnu/emacs/>.
If this is the first pretest of a major release, just comparing
with the previous release may overlook many new files. You can try
@@ -130,9 +130,9 @@ General steps (for each step, check for possible errors):
Now you should upload the files to the GNU ftp server. In order to
do that, you must be registered as an Emacs maintainer and have your
GPG key acknowledged by the ftp people. For instructions, see
- http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html
+ https://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html
The simplest method to upload is to use the gnulib
- <http://www.gnu.org/s/gnulib/> script "build-aux/gnupload":
+ <https://www.gnu.org/s/gnulib/> script "build-aux/gnupload":
For a pretest:
gnupload [--user your@gpg.key.email] --to alpha.gnu.org:emacs/pretest \
@@ -161,11 +161,11 @@ General steps (for each step, check for possible errors):
FILE.sig, FILE.directive.asc.
For a release, place the files in the /incoming/ftp directory.
For a pretest, place the files in /incoming/alpha instead, so that
- they appear on ftp://alpha.gnu.org/.
+ they appear on https://alpha.gnu.org/.
10. After five minutes, verify that the files are visible at
- ftp://alpha.gnu.org/gnu/emacs/pretest/ for a pretest, or
- ftp://ftp.gnu.org/gnu/emacs/ for a release.
+ https://alpha.gnu.org/gnu/emacs/pretest/ for a pretest, or
+ https://ftp.gnu.org/gnu/emacs/ for a release.
Download them and check the signatures. Check they build.
@@ -177,6 +177,11 @@ General steps (for each step, check for possible errors):
See the info-gnu-emacs mailing list archives for the form
of past announcements. The first pretest announcement, and the
release announcement, should have more detail.
+ Use the emacs-devel topic 'emacs-announce'. The best way to do
+ this is to add a header "Keywords: emacs-announce" to your mail.
+ (You can also put it in the Subject, but this is not as good
+ because replies that invariably are not announcements also get
+ sent out as if they were.)
12. After a release, update the Emacs pages as below.
@@ -185,7 +190,7 @@ UPDATING THE EMACS WEB PAGES AFTER A RELEASE
As soon as possible after a release, the Emacs web pages should be updated.
Anyone with write access to the Emacs code repository can do this.
-For instructions, see <http://savannah.gnu.org/cvs/?group=emacs>.
+For instructions, see <https://savannah.gnu.org/cvs/?group=emacs>.
Changes go live more or less as soon as they are committed.
The pages to update are:
@@ -207,7 +212,7 @@ longer present.
Tar up the generated html_node/emacs/ and elisp/ directories and update
the files manual/elisp.html_node.tar.gz and emacs.html_node.tar.gz.
-Use M-x make-manuals-dist from from admin/admin.el to update the
+Use M-x make-manuals-dist from admin/admin.el to update the
manual/texi/ tarfiles.
Add compressed copies of the main info pages from the tarfile to manual/info/.
@@ -215,5 +220,5 @@ Add compressed copies of the main info pages from the tarfile to manual/info/.
Update the refcards/pdf/ and ps/ directories, and also
refcards/emacs-refcards.tar.gz (use make -C etc/refcards pdf ps dist).
-Browsing <http://web.cvs.savannah.gnu.org/viewvc/?root=emacs> is one
+Browsing <https://web.cvs.savannah.gnu.org/viewvc/?root=emacs> is one
way to check for any files that still need updating.
diff --git a/admin/merge-gnulib b/admin/merge-gnulib
index d4bbf17cb3d..4b1dc592b94 100755
--- a/admin/merge-gnulib
+++ b/admin/merge-gnulib
@@ -19,7 +19,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# written by Paul Eggert
@@ -30,24 +30,25 @@ GNULIB_MODULES='
careadlinkat close-stream
count-leading-zeros count-one-bits count-trailing-zeros
crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512
- diffseq dtoastr dtotimespec dup2 environ execinfo faccessat
+ d-type diffseq dtoastr dtotimespec dup2
+ environ execinfo explicit_bzero faccessat
fcntl fcntl-h fdatasync fdopendir
- filemode filevercmp flexmember fstatat fsync
+ filemode filevercmp flexmember fstatat fsusage fsync
getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog
ignore-value intprops largefile lstat
- manywarnings memrchr minmax mkostemp mktime
+ manywarnings memrchr minmax mkostemp mktime nstrftime
pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat
sig2str socklen stat-time std-gnu11 stdalign stddef stdio
- stpcpy strftime strtoimax symlink sys_stat
- sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub
- update-copyright utimens
+ stpcpy strtoimax symlink sys_stat sys_time
+ tempname time time_r time_rz timegm timer-time timespec-add timespec-sub
+ update-copyright unlocked-io utimens
vla warnings
'
AVOIDED_MODULES='
close dup fchdir fstat
malloc-posix msvc-inval msvc-nothrow
- open openat-die opendir raise
+ openat-die opendir raise
save-cwd select setenv sigprocmask stat stdarg stdbool
threadlib tzset unsetenv utime utime-h
'
@@ -105,6 +106,7 @@ done
rm -- "$src"lib/gl_openssl.h "$src"m4/fcntl-o.m4 \
"$src"m4/gl-openssl.m4 \
"$src"m4/gnulib-cache.m4 "$src"m4/gnulib-tool.m4 \
+ "$src"m4/manywarnings-c++.m4 \
"$src"m4/warn-on-use.m4 "$src"m4/wint_t.m4 &&
cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc &&
cp -- "$gnulib_srcdir"/build-aux/config.guess \
diff --git a/admin/merge-pkg-config b/admin/merge-pkg-config
index 363d22dfa5b..dbacb4bc30d 100755
--- a/admin/merge-pkg-config
+++ b/admin/merge-pkg-config
@@ -19,7 +19,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# written by Paul Eggert
diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker
index 3d6df03d5e7..c39458184f6 100644
--- a/admin/notes/bugtracker
+++ b/admin/notes/bugtracker
@@ -1,6 +1,6 @@
NOTES ON THE EMACS BUG TRACKER -*- outline -*-
-The Emacs Bug Tracker can be found at http://debbugs.gnu.org/
+The Emacs Bug Tracker can be found at https://debbugs.gnu.org/
* Quick-start guide
@@ -33,14 +33,14 @@ tags 123 moreinfo|unreproducible|wontfix|patch
* More detailed information
-For a list of all bugs, see http://debbugs.gnu.org/db/pa/lemacs.html
+For a list of all bugs, see https://debbugs.gnu.org/db/pa/lemacs.html
This is a static page, updated once a day. There is also a dynamic
list, generated on request. This accepts various options, eg to see
the most recent bugs:
-http://debbugs.gnu.org/cgi/pkgreport.cgi?newest=100
+https://debbugs.gnu.org/cgi/pkgreport.cgi?newest=100
-Or follow the links on the front page http://debbugs.gnu.org .
+Or follow the links on the front page https://debbugs.gnu.org .
** How do I report a bug in Emacs now?
The same way as you always did. Send mail to bug-gnu-emacs@gnu.org,
@@ -73,7 +73,7 @@ cc everyone on replies.)
(Many people think the submitter SHOULD be automatically subscribed
to subsequent discussion, but this does not seem to be implemented.
See http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=37078
-See also http://debbugs.gnu.org/5439 )
+See also https://debbugs.gnu.org/5439 )
Do NOT send a separate copy to the bug list address, since this may
generate a new report. The only time to send mail to the bug list
@@ -95,13 +95,16 @@ normal bug reporting.)
** When reporting a new bug, to send a Cc to another address
(e.g. bug-cc-mode@gnu.org), do NOT just use a Cc: header.
-Instead, use "X-Debbugs-CC:". This ensures the Cc address will get a
+Instead, use "X-Debbugs-CC:". This ensures the Cc address(es) will get a
mail with the bug report number in. If you do not do this, each reply
in the subsequent discussion might end up creating a new bug.
This is annoying. (So annoying that a form of message-id tracking has
been implemented to hopefully stop this happening, but it is still
better to use X-Debbugs-CC.)
+If you want to send copies to more than one address, add them
+comma-separated in only one X-Debbugs-CC line.
+
Like any X-Debbugs- header, this one can also be specified in the
pseudo-header (see below), if your mail client does not let you add
"X-" headers.
@@ -246,7 +249,7 @@ reopen 123
*** Bugs can be tagged in various ways (eg wontfix, patch, etc).
The available tags are:
patch wontfix moreinfo unreproducible fixed notabug
-See http://debbugs.gnu.org/Developer#tags
+See https://debbugs.gnu.org/Developer#tags
The list of tags can be prefixed with +, - or =, meaning to add (the
default), remove, or reset the tags. E.g.:
@@ -254,7 +257,7 @@ tags 123 + wontfix
** URL shortcuts
-http://debbugs.gnu.org/...
+https://debbugs.gnu.org/...
123 # given bug number
123;mbox=yes # mbox version of given bug
@@ -314,11 +317,11 @@ search box. The only piece you really need to add is the "users"
portion, the rest has the same syntax as normal.
**** To browse bugs by usertag:
-http://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users
+https://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users
**** To find all bugs usertagged by a given email address:
-http://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs
+https://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs
(Supposedly, the "users" field can be a comma-separated list of more
than one email address, but it does not seem to work for me.)
@@ -328,7 +331,7 @@ than one email address, but it does not seem to work for me.)
This works just like a normal tags search, but with the addition of a
"users" field. Eg:
-http://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs;tag=calendar
+https://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs;tag=calendar
*** To merge bugs:
Eg when bad replies create a bunch of new bugs for the same report.
@@ -377,7 +380,7 @@ You must unmerge, clone, then re-merge.
*** To set severity:
severity 123 critical|grave|serious|important|normal|minor|wishlist
-See http://debbugs.gnu.org/Developer#severities for the meanings.
+See https://debbugs.gnu.org/Developer#severities for the meanings.
*** To set the owner of a bug:
owner 123 A Hacker <none@example.com>
@@ -435,10 +438,10 @@ The bug will be re-archived after the next 28 day period of no activity.
It's a function of the number of displayed bugs. You can speed things
up by only looking at the newest 100 bugs:
-http://debbugs.gnu.org/cgi-bin/pkgreport.cgi?newest=100;package=emacs
+https://debbugs.gnu.org/cgi-bin/pkgreport.cgi?newest=100;package=emacs
Or use the static index:
-http://debbugs.gnu.org/db/ix/full.html
+https://debbugs.gnu.org/db/ix/full.html
** What are those "mbox folder" links on the bug report pages?
@@ -484,7 +487,7 @@ the bug web-pages.
*** Debian stuff
-http://lists.gnu.org/archive/html/emacs-devel/2009-11/msg00440.html
+https://lists.gnu.org/r/emacs-devel/2009-11/msg00440.html
** Gnus-specific voodoo
@@ -493,7 +496,7 @@ http://lists.gnu.org/archive/html/emacs-devel/2009-11/msg00440.html
*** If the above is not available:
(add-hook 'gnus-article-mode-hook
(lambda ()
- (setq bug-reference-url-format "http://debbugs.gnu.org/%s")
+ (setq bug-reference-url-format "https://debbugs.gnu.org/%s")
(bug-reference-mode 1)))
and you can click on the bug number in the subject header.
@@ -507,8 +510,8 @@ reference, you don't need to read these as a user of the system.
Getting mail from the Emacs bug list into the tracker requires the
assistance of sysadmin at gnu.org. The test tracker set-up was, I
think, [gnu.org #359140]:
-http://lists.gnu.org/archive/html/savannah-hackers/2008-03/msg00074.html
-http://lists.gnu.org/archive/html/savannah-hackers/2008-04/msg00034.html
+https://lists.gnu.org/r/savannah-hackers/2008-03/msg00074.html
+https://lists.gnu.org/r/savannah-hackers/2008-04/msg00034.html
** The debbugs.gnu.org setup was handled in [gnu.org #510605].
There are two pieces (replace AT with @ in the following):
@@ -548,11 +551,11 @@ It does basic spam processing on the moderator requests and
automatically rejects the obviously bogus ones. Someone still has to
accept the good ones though. The advantage of this would not be having
to run and tune our own spam filter. See
-http://savannah.nongnu.org/projects/listhelper
+https://savannah.nongnu.org/projects/listhelper
An "X-Debbugs-Envelope-To" header is used to keep track of where the
mail was actually bound for:
-http://lists.gnu.org/archive/html/emacs-devel/2009-11/msg01211.html
+https://lists.gnu.org/r/emacs-devel/2009-11/msg01211.html
** Mailing list recipient/sender filters.
The following mailman filters are useful to stop messages being
diff --git a/admin/notes/copyright b/admin/notes/copyright
index 9b614221caf..5d449763d3e 100644
--- a/admin/notes/copyright
+++ b/admin/notes/copyright
@@ -86,7 +86,7 @@ in a README file in each directory with images. (Legal advice says
that we need not add notices to each image file individually, if they
allow for that.). It is recommended to use the word "convert" to
describe the automatic process of changing an image from one format to
-another (http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00618.html).
+another (https://lists.gnu.org/r/emacs-devel/2007-02/msg00618.html).
When installing a file with an "unusual" license (after checking first
@@ -159,7 +159,7 @@ etc/future-bug
etc/letter.pbm,letter.xpm
- trivial, no notice needed.
-<http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00324.html>
+<https://lists.gnu.org/r/emacs-devel/2007-02/msg00324.html>
etc/FTP, ORDERS
- trivial (at time of writing), no license needed
@@ -214,7 +214,7 @@ lib-src/etags.c
from a legal point of view.
lisp/cedet/semantic/imenu.el
- - See http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00410.html
+ - See https://lists.gnu.org/r/emacs-devel/2010-03/msg00410.html
in which Eric Ludlam established that the remaining contributions
from authors other than himself were negligible.
@@ -223,7 +223,7 @@ lisp/play/tetris.el
(2007/1) there is no problem with our use of the name "tetris" or
the concept.
rms: "My understanding is that game rules as such are not copyrightable."
- <http://lists.gnu.org/archive/html/emacs-devel/2007-01/msg00960.html>
+ <https://lists.gnu.org/r/emacs-devel/2007-01/msg00960.html>
rms: Legal advice is that we are ok and need not worry about this.
@@ -307,8 +307,8 @@ doc/*/*.texi - All manuals should be under GFDL (but see below), and
should include a copy of it, so that they can be distributed
separately. faq.texi has a different license, for some reason no-one
can remember.
-http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg00583.html
-http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg00618.html
+https://lists.gnu.org/r/emacs-devel/2007-04/msg00583.html
+https://lists.gnu.org/r/emacs-devel/2007-04/msg00618.html
doc/misc/mh-e.texi is dual-licensed (GPL and GFDL) per agreement with
FSF (reconfirmed by rms Aug 25 2008). Discussion with
@@ -397,7 +397,7 @@ lisp/term/README
Accordingly, FSF copyright was added.
src/unexhp9k800.c
- http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00138.html
+ https://lists.gnu.org/r/emacs-devel/2007-02/msg00138.html
- briefly removed due to legal uncertainly Jan-Mar 2007. The
relevant assignment is under "hp9k800" in copyright.list. File was
written by John V. Morris at HP, and disclaimed by the author and
@@ -406,10 +406,10 @@ src/unexhp9k800.c
lisp/progmodes/python.el
Dave Love alerted us to a potential legal problem:
-http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00459.html
+https://lists.gnu.org/r/emacs-pretest-bug/2007-04/msg00459.html
On consultation with a lawyer, we found there was no problem:
-http://lists.gnu.org/archive/html/emacs-devel/2007-05/msg00466.html
+https://lists.gnu.org/r/emacs-devel/2007-05/msg00466.html
** Issues that are "fixed" for the release of Emacs 22, but we may
@@ -511,7 +511,7 @@ etc/TUTORIAL* (translations)
rms: "We can leave the TUTORIAL translations alone until their
maintainers update them."
Can adapt short license text from end of GPL translations at:
- http://www.gnu.org/licenses/translations.html
+ https://www.gnu.org/licenses/translations.html
Only a few sentences around the license notice need changing from
previous version.
Done: TUTORIAL.eo
@@ -527,7 +527,7 @@ None known.
The EMACS_22_BASE branch was changed to GPLv3 (or later) 2007/07/25.
Some notes:
-(see http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg01431.html)
+(see https://lists.gnu.org/r/emacs-devel/2007-07/msg01431.html)
1. There are some files in the Emacs tree which are not part of Emacs (eg
those included from Gnulib). These are all copyright FSF and (at time
@@ -594,4 +594,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/notes/documentation b/admin/notes/documentation
index 09476ad6962..d894175e212 100644
--- a/admin/notes/documentation
+++ b/admin/notes/documentation
@@ -5,7 +5,7 @@ Some documentation tips culled from emacs-devel postings.
** Manual indices
-http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00400.html
+https://lists.gnu.org/r/emacs-devel/2008-10/msg00400.html
For example, this text:
@@ -51,7 +51,7 @@ combine them into a single entry, e.g.:
** Point is a proper name
-http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00414.html
+https://lists.gnu.org/r/emacs-devel/2008-10/msg00414.html
In Emacs tradition, we treat "point" as a proper name when it refers
to the current editing location. It should not have an article.
@@ -65,7 +65,7 @@ referring to point, please fix it.
** Don't use passive verbs
-http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00414.html
+https://lists.gnu.org/r/emacs-devel/2008-10/msg00414.html
Documentation is clearer if it avoids the passive voice whenever
possible. For example, rather than saying "Point does not move", say
@@ -80,7 +80,7 @@ often provides important information which makes the text clearer, too.
*** Why Antinews is useful
-http://lists.gnu.org/archive/html/emacs-devel/2008-11/msg00893.html
+https://lists.gnu.org/r/emacs-devel/2008-11/msg00893.html
The usefulness of Antinews is to help people who buy the printed
manual and are still using the previous Emacs version. That's why we
@@ -91,7 +91,7 @@ Of course, we try to make it amusing as well.
*** Don't mention in Antinews too many features absent in old versions
-http://lists.gnu.org/archive/html/emacs-devel/2008-11/msg01054.html
+https://lists.gnu.org/r/emacs-devel/2008-11/msg01054.html
Since the purpose of Antinews is to help people use the previous Emacs
version, there is usually no need to mention features that are simply
@@ -114,4 +114,4 @@ In those cases, the user might have trouble figuring out how to use
the old version without some sort of help.
** To indicate possession, write Emacs's rather than Emacs'.
-http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00649.html
+https://lists.gnu.org/r/emacs-devel/2012-02/msg00649.html
diff --git a/admin/notes/elpa b/admin/notes/elpa
index 4c0f1980def..ea6c132fe19 100644
--- a/admin/notes/elpa
+++ b/admin/notes/elpa
@@ -10,7 +10,7 @@ repository named "elpa", hosted on Savannah. To check it out:
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 http://elpa.gnu.org/packages.
+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
diff --git a/admin/notes/font-backend b/admin/notes/font-backend
index 2418966c93d..65c37a483bc 100644
--- a/admin/notes/font-backend
+++ b/admin/notes/font-backend
@@ -66,4 +66,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow
index 2e4bbac70fe..54657866ef5 100644
--- a/admin/notes/git-workflow
+++ b/admin/notes/git-workflow
@@ -12,22 +12,22 @@ git config --global user.email "fchu@example.com"
git config --global transfer.fsckObjects true
(See the thread "Recommend these .gitconfig settings for git integrity."
-[https://lists.gnu.org/archive/html/emacs-devel/2016-01/threads.html#01802]
+[https://lists.gnu.org/r/emacs-devel/2016-01/threads.html#01802]
for more details about why that last line is there.)
Initial setup
=============
Then we want to clone the repository. We normally want to have both
-the current master and the emacs-25 branch.
+the current master and the emacs-26 branch.
mkdir ~/emacs
cd ~/emacs
git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master
(cd master; git config push.default current)
-./master/admin/git-new-workdir master emacs-25
-cd emacs-25
-git checkout emacs-25
+./master/admin/git-new-workdir master emacs-26
+cd emacs-26
+git checkout emacs-26
You now have both branches conveniently accessible, and you can do
"git pull" in them once in a while to keep updated.
@@ -57,11 +57,11 @@ you commit your change locally and then send a patch file as a bug report
as described in ../../CONTRIBUTE.
-Backporting to emacs-25
+Backporting to emacs-26
=======================
If you have applied a fix to the master, but then decide that it should
-be applied to the emacs-25 branch, too, then
+be applied to the emacs-26 branch, too, then
cd ~/emacs/master
git log
@@ -71,7 +71,7 @@ which will look like
commit 958b768a6534ae6e77a8547a56fc31b46b63710b
-cd ~/emacs/emacs-25
+cd ~/emacs/emacs-26
git cherry-pick -xe 958b768a6534ae6e77a8547a56fc31b46b63710b
and add "Backport:" to the commit string. Then
@@ -79,17 +79,17 @@ and add "Backport:" to the commit string. Then
git push
-Merging emacs-25 to the master
+Merging emacs-26 to the master
==============================
It is recommended to use the file gitmerge.el in the admin directory
-for merging 'emacs-25' into 'master'. It will take care of many
+for merging 'emacs-26' into 'master'. It will take care of many
things which would otherwise have to be done manually, like ignoring
commits that should not land in master, fixing up ChangeLogs and
automatically dealing with certain types of conflicts. If you really
want to, you can do the merge manually, but then you're on your own.
If you still choose to do that, make absolutely sure that you *always*
-use the 'merge' command to transport commits from 'emacs-25' to
+use the 'merge' command to transport commits from 'emacs-26' to
'master'. *Never* use 'cherry-pick'! If you don't know why, then you
shouldn't manually do the merge in the first place; just use
gitmerge.el instead.
@@ -102,11 +102,11 @@ up-to-date by doing a pull. Then start Emacs with
emacs -l admin/gitmerge.el -f gitmerge
You'll be asked for the branch to merge, which will default to
-'origin/emacs-25', which you should accept. Merging a local tracking
+'origin/emacs-26', which you should accept. Merging a local tracking
branch is discouraged, since it might not be up-to-date, or worse,
contain commits from you which are not yet pushed upstream.
-You will now see the list of commits from 'emacs-25' which are not yet
+You will now see the list of commits from 'emacs-26' which are not yet
merged to 'master'. You might also see commits that are already
marked for "skipping", which means that they will be merged with a
different merge strategy ('ours'), which will effectively ignore the
diff --git a/admin/notes/hydra b/admin/notes/hydra
index d5959354b08..6c40f6b3022 100644
--- a/admin/notes/hydra
+++ b/admin/notes/hydra
@@ -6,13 +6,12 @@ See the end of the file for license conditions.
NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA
A continuous build for Emacs can be found at
-http://hydra.nixos.org/jobset/gnu/emacs-trunk
-http://hydra.nixos.org/jobset/gnu/emacs-24
+https://hydra.nixos.org/jobset/gnu/emacs-trunk
* It builds Emacs on various platforms.
Sometimes jobs fail due to hydra problems rather than Emacs problems.
-Eg it seems like the cygwin build will never work again.
-http://lists.gnu.org/archive/html/hydra-users/2013-08/msg00000.html
+Eg it seems like the darwin build will never work again.
+https://lists.gnu.org/r/hydra-users/2016-01/msg00000.html
* Mail notifications
In addition to the web interface, Hydra can send notifications by
@@ -21,7 +20,7 @@ SUCCEEDED to FAILED. It sends notifications about build status in
Emacs trunk to emacs-buildstatus@gnu.org.
If you want to receive these notifications, please subscribe at
-http://lists.gnu.org/mailman/listinfo/emacs-buildstatus
+https://lists.gnu.org/mailman/listinfo/emacs-buildstatus
* The Emacs jobset consists of the following jobs:
@@ -31,23 +30,29 @@ by running make-dist to create a tarball. If this job fails, all the
others will too (because they use the tarball as input).
** The 'build' job
-which starts from the tarball and does a normal build
+which starts from the tarball and does a normal build.
** The 'coverage' job
-does a gcov build and then runs 'make check'. Fails if any test fails.
+does a gcov build and then runs 'make check-expensive'. Fails if any
+test fails.
* Nix expressions
The recipe for GNU Emacs are available via Git:
-http://git.savannah.gnu.org/cgit/hydra-recipes.git/tree/emacs
+https://git.savannah.gnu.org/cgit/hydra-recipes.git/tree/emacs
To modify the build job, email the patch to hydra-users@gnu.org. The
build recipes are written in the Nix language.
+* Identifying hydra
+Lisp packages, Makefiles, scripts, and other software could determine
+whether they run on hydra by checking for the environment variable
+EMACS_HYDRA_CI.
+
* Other Information
For a list of other GNU packages that have a continuous build on
-Hydra, see http://hydra.nixos.org/project/gnu
+Hydra, see https://hydra.nixos.org/project/gnu
-See http://www.gnu.org/software/devel.html#Hydra for more information.
+See https://www.gnu.org/software/devel.html#Hydra for more information.
This file is part of GNU Emacs.
@@ -63,4 +68,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty
index d0096adc6d2..0969daf9d07 100644
--- a/admin/notes/multi-tty
+++ b/admin/notes/multi-tty
@@ -1296,4 +1296,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/notes/repo b/admin/notes/repo
index 0da1e1e227a..f6004a97db1 100644
--- a/admin/notes/repo
+++ b/admin/notes/repo
@@ -11,7 +11,7 @@ install it only on the emacs-24 branch, not on the master as well.
Installing things manually into more than one branch makes merges more
difficult.
-http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01124.html
+https://lists.gnu.org/r/emacs-devel/2010-03/msg01124.html
The exception is, if you know that the change will be difficult to
merge to the master (eg because the master code has changed a lot).
@@ -40,7 +40,7 @@ so interim merges are unnecessary.
Or use shelves; or rebase; or do something else. See the thread for
yet another fun excursion into the exciting world of version control.
-http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00086.html
+https://lists.gnu.org/r/emacs-devel/2010-04/msg00086.html
* Installing changes from gnulib
diff --git a/admin/notes/spelling b/admin/notes/spelling
new file mode 100644
index 00000000000..a63d4bba849
--- /dev/null
+++ b/admin/notes/spelling
@@ -0,0 +1,11 @@
+Re "behavior" vs "behaviour", etc.
+
+- GNU Emacs originated in the US.
+
+- If there is a choice between US vs UK spelling for a word
+ for new text (code, docs), choose the US variant.
+
+- It's probably (IMHO --ttn, 2017-10-13) not a high priority to
+ change existing text; use your best judgement (ask if unsure).
+
+- http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg00489.html
diff --git a/admin/notes/tags b/admin/notes/tags
index a1e1b86429c..1e2a38347da 100644
--- a/admin/notes/tags
+++ b/admin/notes/tags
@@ -3,7 +3,7 @@ Apparently these date from ye olden days, when tags were common
to several GNU projects. So many of them had no relevance to Emacs,
and hence were removed. See:
-http://lists.gnu.org/archive/html/emacs-devel/2012-04/msg00042.html
+https://lists.gnu.org/r/emacs-devel/2012-04/msg00042.html
In the unlikely event that you need them, the removed tags were:
diff --git a/admin/notes/unicode b/admin/notes/unicode
index 0d6c6af015f..bc7279150a9 100644
--- a/admin/notes/unicode
+++ b/admin/notes/unicode
@@ -15,9 +15,10 @@ Emacs uses the following files from the Unicode Character Database
. BidiBrackets.txt
. IVD_Sequences.txt
. NormalizationTest.txt
+ . SpecialCasing.txt
. BidiCharacterTest.txt
-First, the first 6 files need to be copied into admin/unidata/, and
+First, the first 7 files need to be copied into admin/unidata/, and
then Emacs should be rebuilt for them to take effect. Rebuilding
Emacs updates several derived files elsewhere in the Emacs source
tree, mainly in lisp/international/.
@@ -305,4 +306,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/notes/versioning b/admin/notes/versioning
index ef11335de54..9428dc76710 100644
--- a/admin/notes/versioning
+++ b/admin/notes/versioning
@@ -1,6 +1,6 @@
GNU EMACS VERSIONING -*- org -*-
-Ref: http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00872.html
+Ref: https://lists.gnu.org/r/emacs-devel/2014-09/msg00872.html
Emacs version numbers have the form
@@ -27,4 +27,3 @@ unexpected last-minute problem occurs.
The development version for a new major release has "minor" = 0.
The development version for a new minor release has "minor" = that of
the previous release.
-
diff --git a/admin/notes/www b/admin/notes/www
index 8e911a44d50..8e5bfb68d7a 100644
--- a/admin/notes/www
+++ b/admin/notes/www
@@ -79,4 +79,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/notes/years b/admin/notes/years
index c0db1854e30..b56d94a1eda 100644
--- a/admin/notes/years
+++ b/admin/notes/years
@@ -37,4 +37,4 @@ but should keep the full list in a comment in the source.
--RMS, 2005-07-13
[1] Note that this includes 2001 - see
-<http://lists.gnu.org/archive/html/emacs-pretest-bug/2006-12/msg00119.html>
+<https://lists.gnu.org/r/emacs-pretest-bug/2006-12/msg00119.html>
diff --git a/admin/nt/README-UNDUMP.W32 b/admin/nt/README-UNDUMP.W32
index f4214161230..b6ed8eee7ec 100644
--- a/admin/nt/README-UNDUMP.W32
+++ b/admin/nt/README-UNDUMP.W32
@@ -7,7 +7,7 @@ This README file describes how to dump a bare precompiled version of
GNU Emacs for Windows. This barebin distribution supplements the
standard distribution of Emacs, which you can download from:
- ftp://ftp.gnu.org/gnu/emacs/
+ https://ftp.gnu.org/gnu/emacs/
If you do not have the "bin" or "src" distribution, then you will need
to download one of those before you can use this barebin version.
@@ -55,4 +55,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/admin/nt/README-ftp-server b/admin/nt/README-ftp-server
index 5fd363c2eb5..e480465b36c 100644
--- a/admin/nt/README-ftp-server
+++ b/admin/nt/README-ftp-server
@@ -227,18 +227,18 @@ See the end of the file for license conditions.
The Emacs on MS Windows FAQ is distributed with Emacs (info
manual "efaq-w32"), and at
- http://www.gnu.org/software/emacs/manual/efaq-w32.html
+ https://www.gnu.org/software/emacs/manual/efaq-w32.html
In addition to the FAQ, there is a mailing list for discussing issues
related to the Windows port of Emacs. For information about the
list, see this Web page:
- http://lists.gnu.org/mailman/listinfo/help-emacs-windows
+ https://lists.gnu.org/mailman/listinfo/help-emacs-windows
To ask questions on the mailing list, send email to
help-emacs-windows@gnu.org. (You don't need to subscribe for that.)
To subscribe to the list or unsubscribe from it, fill the form you
- find at http://mail.gnu.org/mailman/listinfo/help-emacs-windows as
+ find at https://mail.gnu.org/mailman/listinfo/help-emacs-windows as
explained there.
Another valuable source of information and help which should not be
@@ -274,4 +274,4 @@ 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 http://www.gnu.org/licenses/.
+along with GNU Emacs. If not, see https://www.gnu.org/licenses/.
diff --git a/admin/nt/dist-build/README-scripts b/admin/nt/dist-build/README-scripts
new file mode 100644
index 00000000000..1c62a866724
--- /dev/null
+++ b/admin/nt/dist-build/README-scripts
@@ -0,0 +1,92 @@
+Distribution Build Scripts for Windows
+======================================
+
+The scripts are used to build the binary distribution zip files for windows.
+
+File System Organization
+------------------------
+
+
+They are relatively strict about the file system organization. In
+general, they should work across several more than just the version of
+Emacs they come with, as the dependencies of Emacs change relatively slowly.
+
+The file system needs to be organized like so:
+
+~/emacs-build/git
+
+Contains a checkout of the Emacs git repository, organized according
+to branches, with git worktree
+
+~/emacs-build/git/emacs-$branch
+
+A branch of the git repository containing the current release
+branch. This has to be created by hand.
+
+~/emacs-build/git/emacs-$version
+
+A branch of the git repository containing the last release. The
+build-zips.sh file will create this for you.
+
+~/emacs-build/deps
+
+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
+
+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).
+
+
+~/emacs-build/build/$version/i686
+~/emacs-build/build/$version/x86_64
+
+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
+
+We install Emacs here. This directory is created by build-zips.sh.
+This directory can and *should* be deleted after zips have been
+created.
+
+~/emacs-upload
+
+Zips are created and moved here from where they can be, well,
+uploaded.
+
+
+
+Build Process
+-------------
+
+For each major version:
+
+The dependencies files need to be created. This can be around the time
+of the pre-tests, then used for all releases of that version, to
+ensure the maximum stability.
+
+To do this:
+
+Update msys to the latest version with `pacman -Syu`.
+
+Then run build-dep-zips.py, in this directory. Three zips will be
+created, containing the 64bit and 32bit dependencies, as well as the
+source for these.
+
+For emacs release or pre-test version:
+
+Run `build-zips.sh -g` in the release branch. This will create a worktree
+with the tag of the last version.
+
+Then run `build-zips.sh` in this worktree. Eventually, four new zip
+files will be created in ~/emacs-upload from where they can be signed
+and uploaded with `gnupload`.
diff --git a/admin/nt/dist-build/README-windows-binaries b/admin/nt/dist-build/README-windows-binaries
new file mode 100644
index 00000000000..39a5871b6a0
--- /dev/null
+++ b/admin/nt/dist-build/README-windows-binaries
@@ -0,0 +1,45 @@
+Windows Binaries
+================
+
+Currently, we provide four different binary packages for Emacs, which
+are:
+
+emacs-$VERSION-x86_64.zip
+
+Contains a 64-bit build of Emacs with dependencies. Mostly, this is
+the best one to install.
+
+emacs-$VERSION-x86_64-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.zip
+
+Contains a 32-bit build of Emacs with dependencies. This is useful for
+running on a 32-bit machine.
+
+emacs-$VERSION-i686-no-deps.zip
+
+Contains a 32-bit build of Emacs without dependencies
+
+In addition, we provide the following files which will not be useful
+for most end-users.
+
+emacs-27-x86_64-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-27-i686-deps.zip
+
+The 32-bit version of the dependencies.
+
+emacs-27-deps-mingw-w64-src.zip
+
+The source for the dependencies. Source for Emacs itself is available
+in the main distribution tarball. These dependencies were produced
+from an updated msys2 at the point of the first pre-test. It is not
+intended that these will be updated after that point. \ No newline at end of file
diff --git a/admin/nt/dist-build/build-dep-zips.py b/admin/nt/dist-build/build-dep-zips.py
new file mode 100755
index 00000000000..6ec8fafaf8b
--- /dev/null
+++ b/admin/nt/dist-build/build-dep-zips.py
@@ -0,0 +1,232 @@
+#!/usr/bin/python3
+
+## Copyright (C) 2017 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/>.
+import argparse
+import multiprocessing as mp
+import glob
+import os
+import shutil
+import re
+
+from subprocess import check_output
+
+## Constants
+EMACS_MAJOR_VERSION="27"
+
+
+## Options
+DRY_RUN=False
+
+## Packages to fiddle with
+SKIP_PKGS=["mingw-w64-gcc-libs"]
+MUNGE_PKGS ={"mingw-w64-libwinpthread-git":"mingw-w64-winpthreads-git"}
+ARCH_PKGS=["mingw-w64-mpc",
+ "mingw-w64-termcap",
+ "mingw-w64-xpm-nox"]
+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 extract_deps():
+
+ # This list derives from the features we want Emacs to compile with.
+ PKG_REQ='''mingw-w64-x86_64-giflib
+mingw-w64-x86_64-gnutls
+mingw-w64-x86_64-libjpeg-turbo
+mingw-w64-x86_64-libpng
+mingw-w64-x86_64-librsvg
+mingw-w64-x86_64-libtiff
+mingw-w64-x86_64-libxml2
+mingw-w64-x86_64-xpm-nox
+mingw-w64-x86_64-lcms2'''.split()
+
+ # Get a list of all dependencies needed for packages mentioned above.
+ # Run `pactree -lu' for each element of $PKG_REQ.
+ pkgs = set()
+ for x in PKG_REQ:
+ pkgs.update(
+ check_output(["pactree", "-lu", x]).decode("utf-8").split()
+ )
+
+ 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("Downloading {}...".format(tarball))
+ check_output_maybe(
+ "wget -a ../download.log -O {} {}/{}/download"
+ .format(tarball, SRC_REPO, tarball),
+ shell=True
+ )
+ print("Downloading {}... done".format(tarball))
+
+def gather_source(deps):
+
+
+ ## Source for gcc-libs is part of gcc
+ ## Source for libwinpthread is in libwinpthreads
+ ## mpc, termcap, xpm -- has x86_64, and i686 versions
+
+ ## 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()
+
+ ## Produces output like:
+ ## mingw-w64-x86_64-zlib 2.43.2
+ pkg_name_components = pkg_name_and_version.split()
+ 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)
+
+ if(simple_pkg_name in SKIP_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_PKGS.get(d,d)
+
+ tarball = "{}-{}.src.tar.gz".format(d,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)
+
+ print("Zipping")
+ check_output_maybe("zip -9 ../emacs-{}-{}deps-mingw-w64-src.zip *"
+ .format(EMACS_MAJOR_VERSION,DATE),
+ shell=True)
+
+ os.chdir("..")
+
+
+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")
+
+
+if(os.environ["MSYSTEM"] != "MSYS"):
+ print("Run this script in an MSYS-shell!")
+ exit(1)
+
+
+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")
+
+parser.add_argument("-c", help="clean only",
+ action="store_true")
+
+parser.add_argument("-d", help="dry run",
+ action="store_true")
+
+args = parser.parse_args()
+do_all=not (args.c or args.r or args.f or args.t)
+
+deps=extract_deps()
+
+DRY_RUN=args.d
+
+if args.s:
+ DATE="{}-".format(check_output(["date", "+%Y-%m-%d"]).decode("utf-8").strip())
+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 or args.r ):
+ gather_source(deps)
+
+if( args.c ):
+ clean()
diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh
new file mode 100755
index 00000000000..5822d821a1c
--- /dev/null
+++ b/admin/nt/dist-build/build-zips.sh
@@ -0,0 +1,210 @@
+#!/bin/bash
+
+## Copyright (C) 2017 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/>.
+
+
+function git_up {
+ echo [build] Making git worktree for Emacs $VERSION
+ cd $HOME/emacs-build/git/emacs-$MAJOR_VERSION
+ git pull
+ git worktree add ../$BRANCH $BRANCH
+
+ cd ../$BRANCH
+ ./autogen.sh
+}
+
+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
+
+ ## 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
+
+ export PKG_CONFIG_PATH=$PKG
+
+ ## Running configure forces a rebuild of the C core which takes
+ ## time that is not always needed
+ if (($CONFIG))
+ then
+ echo [build] Configuring Emacs $ARCH
+ ../../../git/$BRANCH/configure \
+ --without-dbus \
+ --host=$HOST --without-compress-install \
+ $CACHE \
+ CFLAGS="-O2 -static -g3"
+ fi
+
+ make -j 16 install \
+ 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
+
+ if [ -z $SNAPSHOT ];
+ then
+ DEPS_FILE=$HOME/emacs-build/deps/emacs-$MAJOR_VERSION-$ARCH-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`
+ fi
+
+ echo [build] Using $DEPS_FILE
+ unzip $DEPS_FILE
+
+ zip -r -9 emacs-$OF_VERSION-$ARCH.zip *
+ mv emacs-$OF_VERSION-$ARCH.zip ~/emacs-upload
+}
+
+function build_installer {
+ ARCH=$1
+ cd $HOME/emacs-build/install/emacs-$VERSION
+ echo [build] Calling makensis in `pwd`
+ cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi .
+
+ makensis -v4 \
+ -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \
+ -DOUT_VERSION=$OF_VERSION emacs.nsi
+ rm emacs.nsi
+ mv emacs-$OF_VERSION-$ARCH-installer.exe ~/emacs-upload
+}
+
+set -o errexit
+
+SNAPSHOT=
+CACHE=
+
+BUILD=1
+BUILD_32=1
+BUILD_64=1
+GIT_UP=0
+CONFIG=1
+
+while getopts "36ghnsiV:" 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
+ ;;
+
+ g)
+ BUILD_32=0
+ BUILD_64=0
+ GIT_UP=1
+ ;;
+ n)
+ CONFIG=0
+ ;;
+ i)
+ BUILD=0
+ ;;
+ V)
+ VERSION=$OPTARG
+ ;;
+ s)
+ SNAPSHOT="-snapshot"
+ ;;
+ h)
+ echo "build-zips.sh"
+ echo " -3 32 bit build only"
+ echo " -6 64 bit build only"
+ echo " -g git update and worktree only"
+ echo " -i build installer only"
+ exit 0
+ ;;
+ \?)
+ echo "Invalid option: -$OPTARG" >&2
+ ;;
+ esac
+done
+
+if [ -z $VERSION ];
+then
+ VERSION=`
+ sed -n 's/^AC_INIT(GNU Emacs,[ ]*\([^ ,)]*\).*/\1/p' < ../../../configure.ac
+`
+fi
+
+if [ -z $VERSION ];
+then
+ echo [build] Cannot determine Emacs version
+ exit 1
+fi
+
+MAJOR_VERSION="$(echo $VERSION | cut -d'.' -f1)"
+
+## ACTUAL VERSION is the version declared by emacs
+ACTUAL_VERSION=$VERSION
+
+## VERSION includes the word snapshot if necessary
+VERSION=$VERSION$SNAPSHOT
+
+## OF version includes the date if we have a snapshot
+OF_VERSION=$VERSION
+
+if [ -z $SNAPSHOT ];
+then
+ BRANCH=emacs-$VERSION
+else
+ BRANCH=master
+ CACHE=-C
+ OF_VERSION="$VERSION-`date +%Y-%m-%d`"
+fi
+
+if (($GIT_UP))
+then
+ git_up
+fi
+
+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
+ fi
+ build_installer i686
+fi
diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi
new file mode 100644
index 00000000000..dce8f3db4a3
--- /dev/null
+++ b/admin/nt/dist-build/emacs.nsi
@@ -0,0 +1,88 @@
+!include MUI2.nsh
+!include LogicLib.nsh
+!include x64.nsh
+
+Outfile "emacs-${OUT_VERSION}-${ARCH}-installer.exe"
+
+
+SetCompressor /solid lzma
+
+Var StartMenuFolder
+
+
+!define MUI_WELCOMEPAGE_TITLE "Emacs"
+!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"
+
+!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_DIRECTORY
+!insertmacro MUI_PAGE_INSTFILES
+
+!insertmacro MUI_PAGE_STARTMENU Application $StartMenuFolder
+
+!insertmacro MUI_UNPAGE_CONFIRM
+!insertmacro MUI_UNPAGE_INSTFILES
+
+!insertmacro MUI_LANGUAGE "English"
+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}
+functionend
+
+
+Section
+
+ SetOutPath $INSTDIR
+
+ File /r ${ARCH}
+ # define uninstaller name
+ WriteUninstaller $INSTDIR\Uninstall.exe
+
+ !insertmacro MUI_STARTMENU_WRITE_BEGIN Application
+ ;Create shortcuts
+ CreateDirectory "$SMPROGRAMS\$StartMenuFolder"
+ CreateShortcut "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk" "$INSTDIR\Uninstall.exe"
+
+ !insertmacro MUI_STARTMENU_WRITE_END
+ CreateShortCut "$SMPROGRAMS\$StartMenuFolder\Emacs.lnk" "$INSTDIR\${ARCH}\bin\runemacs.exe"
+SectionEnd
+
+
+# create a section to define what the uninstaller does.
+# the section will always be named "Uninstall"
+Section "Uninstall"
+
+ # Always delete uninstaller first
+ Delete "$INSTDIR\Uninstall.exe"
+
+ # now delete installed directory
+ RMDir /r "$INSTDIR\${ARCH}"
+ RMDir "$INSTDIR"
+
+ !insertmacro MUI_STARTMENU_GETFOLDER Application $StartMenuFolder
+
+ Delete "$SMPROGRAMS\$StartMenuFolder\Uninstall.lnk"
+ RMDir "$SMPROGRAMS\$StartMenuFolder"
+SectionEnd
diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs
index a5ec6965b19..8f84edee47d 100755
--- a/admin/quick-install-emacs
+++ b/admin/quick-install-emacs
@@ -18,7 +18,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
@@ -172,7 +172,10 @@ test x"$prefix" = x && { prefix="`get_config_var prefix`" || exit 4 ; }
test x"$ARCH" = x && { ARCH="`get_config_var host`" || exit 4 ; }
VERSION=`
- sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.ac
+ sed -n 's/^AC_INIT([ ]*emacs[ ]*,[ ]*\([^ ),]*\).*/\1/p' <$SRC/configure.ac
+` || exit 4
+test -n "$VERSION" || VERSION=`
+ sed -n 's/^AC_INIT([ ]*GNU Emacs[ ]*,[ ]*\([^ ),]*\).*/\1/p' <$SRC/configure.ac
` || exit 4
test -n "$VERSION" || { printf '%s\n' >&2 "$me: no version in configure.ac"; exit 4; }
diff --git a/admin/release-process b/admin/release-process
index 6aa004014b8..3bb72b9735c 100644
--- a/admin/release-process
+++ b/admin/release-process
@@ -115,12 +115,12 @@ Redirect /software/emacs/manual/html_mono/automake.html /software/automake/manua
Redirect /software/emacs/manual/html_node/automake/ /software/automake/manual/html_node/
Another tool you can use to check links is gnu.org's linc.py:
-http://www.gnu.org/server/source/
+https://www.gnu.org/server/source/
You run this with something like:
cd /path/to/cvs/emacs-www
-linc.py -o /path/to/output-dir --url http://www.gnu.org/software/emacs/ .
+linc.py -o /path/to/output-dir --url https://www.gnu.org/software/emacs/ .
Be warned that it is really, really slow (as in, can take ~ a full day
to check the manual/ directory). It is probably best to run it on a
diff --git a/admin/unidata/BidiBrackets.txt b/admin/unidata/BidiBrackets.txt
index eb02a24bfc0..2114e632b9f 100644
--- a/admin/unidata/BidiBrackets.txt
+++ b/admin/unidata/BidiBrackets.txt
@@ -1,6 +1,6 @@
-# BidiBrackets-9.0.0.txt
-# Date: 2016-06-07, 22:30:00 GMT [AG, LI, KW]
-# © 2016 Unicode®, Inc.
+# BidiBrackets-10.0.0.txt
+# Date: 2017-04-12, 17:30:00 GMT [AG, LI, KW]
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -8,7 +8,7 @@
# For documentation, see http://www.unicode.org/reports/tr44/
#
# Bidi_Paired_Bracket and Bidi_Paired_Bracket_Type Properties
-#
+#
# This file is a normative contributory data file in the Unicode
# Character Database.
#
diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt
index 68142c5e326..cbb61c4b570 100644
--- a/admin/unidata/BidiMirroring.txt
+++ b/admin/unidata/BidiMirroring.txt
@@ -1,13 +1,13 @@
-# BidiMirroring-9.0.0.txt
-# Date: 2016-01-21, 22:00:00 GMT [KW, LI]
-# © 2016 Unicode®, Inc.
+# BidiMirroring-10.0.0.txt
+# Date: 2017-04-12, 17:30:00 GMT [KW, LI]
+# © 2017 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
# For documentation, see http://www.unicode.org/reports/tr44/
#
# Bidi_Mirroring_Glyph Property
-#
+#
# This file is an informative contributory data file in the
# Unicode Character Database.
#
@@ -15,20 +15,20 @@
# value, for which there is another Unicode character that typically has a glyph
# that is the mirror image of the original character's glyph.
#
-# The repertoire covered by the file is Unicode 9.0.0.
-#
+# The repertoire covered by the file is Unicode 10.0.0.
+#
# The file contains a list of lines with mappings from one code point
# to another one for character-based mirroring.
# Note that for "real" mirroring, a rendering engine needs to select
# appropriate alternative glyphs, and that many Unicode characters do not
# have a mirror-image Unicode character.
-#
+#
# Each mapping line contains two fields, separated by a semicolon (';').
# Each of the two fields contains a code point represented as a
# variable-length hexadecimal value with 4 to 6 digits.
# A comment indicates where the characters are "BEST FIT" mirroring.
-#
-# Code points for which Bidi_Mirrored=Yes, but for which no appropriate
+#
+# Code points for which Bidi_Mirrored=Yes, but for which no appropriate
# characters exist with mirrored glyphs, are
# listed as comments at the end of the file.
#
@@ -38,14 +38,14 @@
# point has the default value for the Bidi_Mirroring_Glyph property,
# that means that no other character exists whose glyph is suitable
# for character-based mirroring.
-#
+#
# For information on bidi mirroring, see UAX #9: Unicode Bidirectional Algorithm,
# at http://www.unicode.org/unicode/reports/tr9/
-#
+#
# This file was originally created by Markus Scherer.
# Extended for Unicode 3.2, 4.0, 4.1, 5.0, 5.1, 5.2, and 6.0 by Ken Whistler,
# and for subsequent versions by Ken Whistler and Laurentiu Iancu.
-#
+#
# ############################################################
#
# Property: Bidi_Mirroring_Glyph
diff --git a/admin/unidata/Blocks.txt b/admin/unidata/Blocks.txt
index 74c41e58a81..a4f851b14a5 100644
--- a/admin/unidata/Blocks.txt
+++ b/admin/unidata/Blocks.txt
@@ -1,6 +1,6 @@
-# Blocks-9.0.0.txt
-# Date: 2016-02-05, 23:48:00 GMT [KW]
-# © 2016 Unicode®, Inc.
+# Blocks-10.0.0.txt
+# Date: 2017-04-12, 17:30:00 GMT [KW]
+# © 2017 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
@@ -14,12 +14,12 @@
# Note: When comparing block names, casing, whitespace, hyphens,
# and underbars are ignored.
# For example, "Latin Extended-A" and "latin extended a" are equivalent.
-# For more information on the comparison of property values,
+# For more information on the comparison of property values,
# see UAX #44: http://www.unicode.org/reports/tr44/
#
# All block ranges start with a value where (cp MOD 16) = 0,
# and end with a value where (cp MOD 16) = 15. In other words,
-# the last hexadecimal digit of the start of range is ...0
+# the last hexadecimal digit of the start of range is ...0
# and the last hexadecimal digit of the end of range is ...F.
# This constraint on block ranges guarantees that allocations
# are done in terms of whole columns, and that code chart display
@@ -51,6 +51,7 @@
07C0..07FF; NKo
0800..083F; Samaritan
0840..085F; Mandaic
+0860..086F; Syriac Supplement
08A0..08FF; Arabic Extended-A
0900..097F; Devanagari
0980..09FF; Bengali
@@ -253,9 +254,12 @@ FFF0..FFFF; Specials
11680..116CF; Takri
11700..1173F; Ahom
118A0..118FF; Warang Citi
+11A00..11A4F; Zanabazar Square
+11A50..11AAF; Soyombo
11AC0..11AFF; Pau Cin Hau
11C00..11C6F; Bhaiksuki
11C70..11CBF; Marchen
+11D00..11D5F; Masaram Gondi
12000..123FF; Cuneiform
12400..1247F; Cuneiform Numbers and Punctuation
12480..1254F; Early Dynastic Cuneiform
@@ -270,6 +274,8 @@ FFF0..FFFF; Specials
17000..187FF; Tangut
18800..18AFF; Tangut Components
1B000..1B0FF; Kana Supplement
+1B100..1B12F; Kana Extended-A
+1B170..1B2FF; Nushu
1BC00..1BC9F; Duployan
1BCA0..1BCAF; Shorthand Format Controls
1D000..1D0FF; Byzantine Musical Symbols
@@ -300,6 +306,7 @@ FFF0..FFFF; Specials
2A700..2B73F; CJK Unified Ideographs Extension C
2B740..2B81F; CJK Unified Ideographs Extension D
2B820..2CEAF; CJK Unified Ideographs Extension E
+2CEB0..2EBEF; CJK Unified Ideographs Extension F
2F800..2FA1F; CJK Compatibility Ideographs Supplement
E0000..E007F; Tags
E0100..E01EF; Variation Selectors Supplement
diff --git a/admin/unidata/IVD_Sequences.txt b/admin/unidata/IVD_Sequences.txt
index fdf21e8a308..304bf91d9b0 100644
--- a/admin/unidata/IVD_Sequences.txt
+++ b/admin/unidata/IVD_Sequences.txt
@@ -2,6 +2,9 @@
#
# History:
#
+# 2016-08-15 Combined registration of the MSARG collection and of
+# sequences in that collection.
+#
# 2014-05-16 Combined registration of the Moji_Joho collection and of
# sequences in that collection.
#
@@ -11,17 +14,17 @@
# collection. Registration of additional sequences in the
# Hanyo-Denshi collection.
#
-# 2010-11-14 Combined registration of the Hanyo-Denshi collection and of
-# sequences in that collection.
+# 2010-11-14 Combined registration of the Hanyo-Denshi collection and
+# of sequences in that collection.
#
-# 2007-12-14 Combined registration of the Adobe-Japan1 collection and of
-# sequences in that collection.
+# 2007-12-14 Combined registration of the Adobe-Japan1 collection and
+# of sequences in that collection.
#
# This file is part of the Unicode Ideographic Variation Database (IVD).
# For more details on the IVD, see UTS #37:
# http://www.unicode.org/reports/tr37/
#
-# Copyright 2006-2014 Unicode, Inc.
+# Copyright 2006-2016 Unicode, Inc.
# For terms of use, see: http://www.unicode.org/terms_of_use.html
#
3402 E0100; Adobe-Japan1; CID+13698
@@ -268,6 +271,9 @@
36C3 E0100; Hanyo-Denshi; IA1426
36C3 E0101; Hanyo-Denshi; TK01020180
36C3 E0102; Hanyo-Denshi; TK01020240
+36C7 E0100; MSARG; MA_9856
+36C7 E0101; MSARG; ME_36C7_001
+36C7 E0102; MSARG; ME_36C7_002
36CF E0100; Adobe-Japan1; CID+17494
36EE E0100; Moji_Joho; MJ000648
36EE E0101; Moji_Joho; MJ000649
@@ -4847,6 +4853,8 @@
5554 E0101; Hanyo-Denshi; TK01014490
5556 E0100; Adobe-Japan1; CID+4394
5557 E0100; Adobe-Japan1; CID+4395
+5557 E0101; MSARG; MB_B0E8
+5557 E0102; MSARG; ME_5557_001
5558 E0100; Adobe-Japan1; CID+21280
555A E0100; Adobe-Japan1; CID+21281
555A E0101; Hanyo-Denshi; JB2162
@@ -8319,6 +8327,8 @@
5EF8 E0100; Adobe-Japan1; CID+4762
5EF8 E0101; Moji_Joho; MJ011106
5EF8 E0102; Moji_Joho; MJ011107
+5EF8 E0103; MSARG; MA_9059
+5EF8 E0104; MSARG; ME_5EF8_001
5EF9 E0100; Adobe-Japan1; CID+16853
5EF9 E0101; Moji_Joho; MJ011108
5EF9 E0102; Moji_Joho; MJ011109
@@ -8529,6 +8539,8 @@
5F55 E0100; Moji_Joho; MJ011232
5F55 E0101; Hanyo-Denshi; KS112100
5F55 E0101; Moji_Joho; MJ057475
+5F55 E0102; MSARG; MD_5F55
+5F55 E0103; MSARG; ME_5F55_001
5F56 E0100; Adobe-Japan1; CID+4780
5F56 E0101; Hanyo-Denshi; JA5533
5F56 E0101; Moji_Joho; MJ011233
@@ -26361,6 +26373,8 @@
8846 E0105; Hanyo-Denshi; KS386520
8846 E0105; Moji_Joho; MJ058677
8846 E0106; Hanyo-Denshi; TK01083450
+8846 E0107; MSARG; MA_8FBC
+8846 E0108; MSARG; ME_8846_001
8848 E0100; Adobe-Japan1; CID+22465
8849 E0100; Adobe-Japan1; CID+22466
884A E0100; Adobe-Japan1; CID+18635
@@ -31073,6 +31087,8 @@
93C5 E0101; Hanyo-Denshi; JB6930
93C5 E0102; Hanyo-Denshi; TK01093900
93C6 E0100; Adobe-Japan1; CID+8679
+93C6 E0101; MSARG; MA_9264
+93C6 E0102; MSARG; ME_93C6_001
93C7 E0100; Adobe-Japan1; CID+18865
93C8 E0100; Adobe-Japan1; CID+7029
93C8 E0101; Hanyo-Denshi; JA7926
@@ -32678,6 +32694,8 @@
98EB E0102; Moji_Joho; MJ028359
98EB E0103; Hanyo-Denshi; FT2689
98EB E0103; Moji_Joho; MJ028358
+98EC E0100; MSARG; MA_914B
+98EC E0101; MSARG; ME_98EC_001
98ED E0100; Adobe-Japan1; CID+4289
98ED E0101; Hanyo-Denshi; JA5012
98ED E0101; Moji_Joho; MJ028362
@@ -33545,6 +33563,8 @@
9AE3 E0100; Adobe-Japan1; CID+7278
9AE4 E0100; Adobe-Japan1; CID+22934
9AE5 E0100; Adobe-Japan1; CID+19007
+9AE5 E0101; MSARG; MD_9AE5
+9AE5 E0102; MSARG; ME_9AE5_001
9AE6 E0100; Adobe-Japan1; CID+7279
9AE7 E0100; Adobe-Japan1; CID+22935
9AE9 E0100; Adobe-Japan1; CID+19008
@@ -35487,6 +35507,8 @@ FA29 E0100; Adobe-Japan1; CID+8687
20C50 E0101; Moji_Joho; MJ057161
20C74 E0100; Hanyo-Denshi; KS041540
20C74 E0101; Hanyo-Denshi; TK01014200
+20C98 E0100; MSARG; MD_20C98
+20C98 E0101; MSARG; ME_20C98_001
20C9C E0100; Hanyo-Denshi; TK01014280
20C9C E0101; Hanyo-Denshi; TK01014620
20D45 E0100; Adobe-Japan1; CID+17359
@@ -35689,6 +35711,8 @@ FA29 E0100; Adobe-Japan1; CID+8687
21A41 E0101; Hanyo-Denshi; TK01022390
21A62 E0100; Hanyo-Denshi; KS082510
21A62 E0101; Hanyo-Denshi; TK01022590
+21A74 E0100; MSARG; MD_21A74
+21A74 E0101; MSARG; ME_21A74_001
21AA2 E0100; Moji_Joho; MJ034079
21AA2 E0101; Moji_Joho; MJ034080
21B33 E0100; Hanyo-Denshi; KS084630
diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in
index 5cc43bc3718..c389cb3f535 100644
--- a/admin/unidata/Makefile.in
+++ b/admin/unidata/Makefile.in
@@ -19,7 +19,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
@@ -119,4 +119,3 @@ maintainer-clean: distclean
extraclean:
rm -f ${top_srcdir}/src/macuvs.h ${unidir}/charscript.el*
rm -f ${unifiles} ${unidir}/charprop.el
-
diff --git a/admin/unidata/NormalizationTest.txt b/admin/unidata/NormalizationTest.txt
index e133fa8a788..71f2371c5eb 100644
--- a/admin/unidata/NormalizationTest.txt
+++ b/admin/unidata/NormalizationTest.txt
@@ -1,6 +1,6 @@
-# NormalizationTest-9.0.0.txt
-# Date: 2016-04-04, 11:41:55 GMT
-# © 2016 Unicode®, Inc.
+# NormalizationTest-10.0.0.txt
+# Date: 2017-03-08, 08:41:55 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -17653,6 +17653,10 @@ FFEE;FFEE;FFEE;25CB;25CB; # (○; ○; ○; ○; ○; ) HALFWIDTH WHITE CIRCLE
0061 0CBC 3099 093C 0334 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062;0061 0334 0CBC 093C 3099 0062; # (a◌಼◌゙◌़◌̴b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; a◌̴◌಼◌़◌゙b; ) LATIN SMALL LETTER A, KANNADA SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
0061 05B0 094D 3099 0CCD 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062;0061 3099 094D 0CCD 05B0 0062; # (a◌ְ◌्◌゙◌್b; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; a◌゙◌्◌್◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, KANNADA SIGN VIRAMA, LATIN SMALL LETTER B
0061 0CCD 05B0 094D 3099 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062;0061 3099 0CCD 094D 05B0 0062; # (a◌್◌ְ◌्◌゙b; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; a◌゙◌್◌्◌ְb; ) LATIN SMALL LETTER A, KANNADA SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 0D3B 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062;0061 3099 094D 0D3B 05B0 0062; # (a◌ְ◌्◌゙◌഻b; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; a◌゙◌्◌഻◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN VERTICAL BAR VIRAMA, LATIN SMALL LETTER B
+0061 0D3B 05B0 094D 3099 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062;0061 3099 0D3B 094D 05B0 0062; # (a◌഻◌ְ◌्◌゙b; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; a◌゙◌഻◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN VERTICAL BAR VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 0D3C 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062;0061 3099 094D 0D3C 05B0 0062; # (a◌ְ◌्◌゙◌഼b; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; a◌゙◌्◌഼◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN CIRCULAR VIRAMA, LATIN SMALL LETTER B
+0061 0D3C 05B0 094D 3099 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062;0061 3099 0D3C 094D 05B0 0062; # (a◌഼◌ְ◌्◌゙b; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; a◌゙◌഼◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN CIRCULAR VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 0D4D 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062;0061 3099 094D 0D4D 05B0 0062; # (a◌ְ◌्◌゙◌്b; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; a◌゙◌्◌്◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MALAYALAM SIGN VIRAMA, LATIN SMALL LETTER B
0061 0D4D 05B0 094D 3099 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062;0061 3099 0D4D 094D 05B0 0062; # (a◌്◌ְ◌्◌゙b; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; a◌゙◌്◌्◌ְb; ) LATIN SMALL LETTER A, MALAYALAM SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 0DCA 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062;0061 3099 094D 0DCA 05B0 0062; # (a◌ְ◌्◌゙◌්b; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; a◌゙◌्◌්◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, SINHALA SIGN AL-LAKUNA, LATIN SMALL LETTER B
@@ -17999,6 +18003,14 @@ FFEE;FFEE;FFEE;25CB;25CB; # (○; ○; ○; ○; ○; ) HALFWIDTH WHITE CIRCLE
0061 1DF4 0315 0300 05AE 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062;0061 05AE 1DF4 0300 0315 0062; # (a◌ᷴ◌̕◌̀◌֮b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; a◌֮◌ᷴ◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING LATIN SMALL LETTER U WITH DIAERESIS, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 0315 0300 05AE 1DF5 0062;00E0 05AE 1DF5 0315 0062;0061 05AE 0300 1DF5 0315 0062;00E0 05AE 1DF5 0315 0062;0061 05AE 0300 1DF5 0315 0062; # (a◌̕◌̀◌֮◌᷵b; à◌֮◌᷵◌̕b; a◌֮◌̀◌᷵◌̕b; à◌֮◌᷵◌̕b; a◌֮◌̀◌᷵◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING UP TACK ABOVE, LATIN SMALL LETTER B
0061 1DF5 0315 0300 05AE 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062;0061 05AE 1DF5 0300 0315 0062; # (a◌᷵◌̕◌̀◌֮b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; a◌֮◌᷵◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING UP TACK ABOVE, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
+0061 035C 0315 0300 1DF6 0062;00E0 0315 1DF6 035C 0062;0061 0300 0315 1DF6 035C 0062;00E0 0315 1DF6 035C 0062;0061 0300 0315 1DF6 035C 0062; # (a◌͜◌̕◌̀◌᷶b; à◌̕◌᷶◌͜b; a◌̀◌̕◌᷶◌͜b; à◌̕◌᷶◌͜b; a◌̀◌̕◌᷶◌͜b; ) LATIN SMALL LETTER A, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, COMBINING KAVYKA ABOVE RIGHT, LATIN SMALL LETTER B
+0061 1DF6 035C 0315 0300 0062;00E0 1DF6 0315 035C 0062;0061 0300 1DF6 0315 035C 0062;00E0 1DF6 0315 035C 0062;0061 0300 1DF6 0315 035C 0062; # (a◌᷶◌͜◌̕◌̀b; à◌᷶◌̕◌͜b; a◌̀◌᷶◌̕◌͜b; à◌᷶◌̕◌͜b; a◌̀◌᷶◌̕◌͜b; ) LATIN SMALL LETTER A, COMBINING KAVYKA ABOVE RIGHT, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, LATIN SMALL LETTER B
+0061 0300 05AE 1D16D 1DF7 0062;00E0 1D16D 05AE 1DF7 0062;0061 1D16D 05AE 1DF7 0300 0062;00E0 1D16D 05AE 1DF7 0062;0061 1D16D 05AE 1DF7 0300 0062; # (a◌̀◌𝅭֮◌᷷b; à𝅭◌֮◌᷷b; a𝅭◌֮◌᷷◌̀b; à𝅭◌֮◌᷷b; a𝅭◌֮◌᷷◌̀b; ) LATIN SMALL LETTER A, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, COMBINING KAVYKA ABOVE LEFT, LATIN SMALL LETTER B
+0061 1DF7 0300 05AE 1D16D 0062;00E0 1D16D 1DF7 05AE 0062;0061 1D16D 1DF7 05AE 0300 0062;00E0 1D16D 1DF7 05AE 0062;0061 1D16D 1DF7 05AE 0300 0062; # (a◌᷷◌̀◌𝅭֮b; à𝅭◌᷷◌֮b; a𝅭◌᷷◌֮◌̀b; à𝅭◌᷷◌֮b; a𝅭◌᷷◌֮◌̀b; ) LATIN SMALL LETTER A, COMBINING KAVYKA ABOVE LEFT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, LATIN SMALL LETTER B
+0061 0300 05AE 1D16D 1DF8 0062;00E0 1D16D 05AE 1DF8 0062;0061 1D16D 05AE 1DF8 0300 0062;00E0 1D16D 05AE 1DF8 0062;0061 1D16D 05AE 1DF8 0300 0062; # (a◌̀◌𝅭֮◌᷸b; à𝅭◌֮◌᷸b; a𝅭◌֮◌᷸◌̀b; à𝅭◌֮◌᷸b; a𝅭◌֮◌᷸◌̀b; ) LATIN SMALL LETTER A, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, COMBINING DOT ABOVE LEFT, LATIN SMALL LETTER B
+0061 1DF8 0300 05AE 1D16D 0062;00E0 1D16D 1DF8 05AE 0062;0061 1D16D 1DF8 05AE 0300 0062;00E0 1D16D 1DF8 05AE 0062;0061 1D16D 1DF8 05AE 0300 0062; # (a◌᷸◌̀◌𝅭֮b; à𝅭◌᷸◌֮b; a𝅭◌᷸◌֮◌̀b; à𝅭◌᷸◌֮b; a𝅭◌᷸◌֮◌̀b; ) LATIN SMALL LETTER A, COMBINING DOT ABOVE LEFT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, MUSICAL SYMBOL COMBINING AUGMENTATION DOT, LATIN SMALL LETTER B
+0061 059A 0316 302A 1DF9 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062;0061 302A 0316 1DF9 059A 0062; # (a◌֚◌̖◌〪◌᷹b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; a◌〪◌̖◌᷹◌֚b; ) LATIN SMALL LETTER A, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, COMBINING WIDE INVERTED BRIDGE BELOW, LATIN SMALL LETTER B
+0061 1DF9 059A 0316 302A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062;0061 302A 1DF9 0316 059A 0062; # (a◌᷹◌֚◌̖◌〪b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; a◌〪◌᷹◌̖◌֚b; ) LATIN SMALL LETTER A, COMBINING WIDE INVERTED BRIDGE BELOW, HEBREW ACCENT YETIV, COMBINING GRAVE ACCENT BELOW, IDEOGRAPHIC LEVEL TONE MARK, LATIN SMALL LETTER B
0061 0315 0300 05AE 1DFB 0062;00E0 05AE 1DFB 0315 0062;0061 05AE 0300 1DFB 0315 0062;00E0 05AE 1DFB 0315 0062;0061 05AE 0300 1DFB 0315 0062; # (a◌̕◌̀◌֮◌᷻b; à◌֮◌᷻◌̕b; a◌֮◌̀◌᷻◌̕b; à◌֮◌᷻◌̕b; a◌֮◌̀◌᷻◌̕b; ) LATIN SMALL LETTER A, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, COMBINING DELETION MARK, LATIN SMALL LETTER B
0061 1DFB 0315 0300 05AE 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062;0061 05AE 1DFB 0300 0315 0062; # (a◌᷻◌̕◌̀◌֮b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; a◌֮◌᷻◌̀◌̕b; ) LATIN SMALL LETTER A, COMBINING DELETION MARK, COMBINING COMMA ABOVE RIGHT, COMBINING GRAVE ACCENT, HEBREW ACCENT ZINOR, LATIN SMALL LETTER B
0061 035D 035C 0315 1DFC 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062;0061 0315 035C 1DFC 035D 0062; # (a◌͝◌͜◌̕◌᷼b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; a◌̕◌͜◌᷼◌͝b; ) LATIN SMALL LETTER A, COMBINING DOUBLE BREVE, COMBINING DOUBLE BREVE BELOW, COMBINING COMMA ABOVE RIGHT, COMBINING DOUBLE INVERTED BREVE BELOW, LATIN SMALL LETTER B
@@ -18397,8 +18409,20 @@ FFEE;FFEE;FFEE;25CB;25CB; # (○; ○; ○; ○; ○; ) HALFWIDTH WHITE CIRCLE
0061 116B7 3099 093C 0334 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062;0061 0334 116B7 093C 3099 0062; # (a◌𑚷◌゙◌़◌̴b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; a◌̴◌𑚷◌़◌゙b; ) LATIN SMALL LETTER A, TAKRI SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
0061 05B0 094D 3099 1172B 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062;0061 3099 094D 1172B 05B0 0062; # (a◌ְ◌्◌゙◌𑜫b; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; a◌゙◌्◌𑜫◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, AHOM SIGN KILLER, LATIN SMALL LETTER B
0061 1172B 05B0 094D 3099 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062;0061 3099 1172B 094D 05B0 0062; # (a◌𑜫◌ְ◌्◌゙b; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; a◌゙◌𑜫◌्◌ְb; ) LATIN SMALL LETTER A, AHOM SIGN KILLER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11A34 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062;0061 3099 094D 11A34 05B0 0062; # (a◌ְ◌्◌゙◌𑨴b; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; a◌゙◌्◌𑨴◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SIGN VIRAMA, LATIN SMALL LETTER B
+0061 11A34 05B0 094D 3099 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062;0061 3099 11A34 094D 05B0 0062; # (a◌𑨴◌ְ◌्◌゙b; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; a◌゙◌𑨴◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11A47 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062;0061 3099 094D 11A47 05B0 0062; # (a◌ְ◌्◌゙◌𑩇b; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; a◌゙◌्◌𑩇◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, ZANABAZAR SQUARE SUBJOINER, LATIN SMALL LETTER B
+0061 11A47 05B0 094D 3099 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062;0061 3099 11A47 094D 05B0 0062; # (a◌𑩇◌ְ◌्◌゙b; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; a◌゙◌𑩇◌्◌ְb; ) LATIN SMALL LETTER A, ZANABAZAR SQUARE SUBJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11A99 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062;0061 3099 094D 11A99 05B0 0062; # (a◌ְ◌्◌゙◌𑪙b; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; a◌゙◌्◌𑪙◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, SOYOMBO SUBJOINER, LATIN SMALL LETTER B
+0061 11A99 05B0 094D 3099 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062;0061 3099 11A99 094D 05B0 0062; # (a◌𑪙◌ְ◌्◌゙b; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; a◌゙◌𑪙◌्◌ְb; ) LATIN SMALL LETTER A, SOYOMBO SUBJOINER, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 05B0 094D 3099 11C3F 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062;0061 3099 094D 11C3F 05B0 0062; # (a◌ְ◌्◌゙◌𑰿b; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; a◌゙◌्◌𑰿◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, BHAIKSUKI SIGN VIRAMA, LATIN SMALL LETTER B
0061 11C3F 05B0 094D 3099 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062;0061 3099 11C3F 094D 05B0 0062; # (a◌𑰿◌ְ◌्◌゙b; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; a◌゙◌𑰿◌्◌ְb; ) LATIN SMALL LETTER A, BHAIKSUKI SIGN VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 3099 093C 0334 11D42 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062;0061 0334 093C 11D42 3099 0062; # (a◌゙◌़◌̴◌𑵂b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; a◌̴◌़◌𑵂◌゙b; ) LATIN SMALL LETTER A, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, MASARAM GONDI SIGN NUKTA, LATIN SMALL LETTER B
+0061 11D42 3099 093C 0334 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062;0061 0334 11D42 093C 3099 0062; # (a◌𑵂◌゙◌़◌̴b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; a◌̴◌𑵂◌़◌゙b; ) LATIN SMALL LETTER A, MASARAM GONDI SIGN NUKTA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11D44 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062;0061 3099 094D 11D44 05B0 0062; # (a◌ְ◌्◌゙◌𑵄b; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; a◌゙◌्◌𑵄◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MASARAM GONDI SIGN HALANTA, LATIN SMALL LETTER B
+0061 11D44 05B0 094D 3099 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062;0061 3099 11D44 094D 05B0 0062; # (a◌𑵄◌ְ◌्◌゙b; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; a◌゙◌𑵄◌्◌ְb; ) LATIN SMALL LETTER A, MASARAM GONDI SIGN HALANTA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
+0061 05B0 094D 3099 11D45 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062;0061 3099 094D 11D45 05B0 0062; # (a◌ְ◌्◌゙◌𑵅b; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; a◌゙◌्◌𑵅◌ְb; ) LATIN SMALL LETTER A, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, MASARAM GONDI VIRAMA, LATIN SMALL LETTER B
+0061 11D45 05B0 094D 3099 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062;0061 3099 11D45 094D 05B0 0062; # (a◌𑵅◌ְ◌्◌゙b; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; a◌゙◌𑵅◌्◌ְb; ) LATIN SMALL LETTER A, MASARAM GONDI VIRAMA, HEBREW POINT SHEVA, DEVANAGARI SIGN VIRAMA, COMBINING KATAKANA-HIRAGANA VOICED SOUND MARK, LATIN SMALL LETTER B
0061 093C 0334 16AF0 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062;0061 0334 16AF0 093C 0062; # (a◌़◌̴◌𖫰b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; a◌̴◌𖫰◌़b; ) LATIN SMALL LETTER A, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING HIGH TONE, LATIN SMALL LETTER B
0061 16AF0 093C 0334 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062;0061 16AF0 0334 093C 0062; # (a◌𖫰◌़◌̴b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; a◌𖫰◌̴◌़b; ) LATIN SMALL LETTER A, BASSA VAH COMBINING HIGH TONE, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, LATIN SMALL LETTER B
0061 093C 0334 16AF1 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062;0061 0334 16AF1 093C 0062; # (a◌़◌̴◌𖫱b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; a◌̴◌𖫱◌़b; ) LATIN SMALL LETTER A, DEVANAGARI SIGN NUKTA, COMBINING TILDE OVERLAY, BASSA VAH COMBINING LOW TONE, LATIN SMALL LETTER B
diff --git a/admin/unidata/README b/admin/unidata/README
index 06a66663a72..f5881a1a149 100644
--- a/admin/unidata/README
+++ b/admin/unidata/README
@@ -5,26 +5,30 @@ copyright.html.
The names, URLs, and dates for these files are as follows.
+BidiBrackets.txt
+http://www.unicode.org/Public/UNIDATA/BidiBrackets.txt
+2017-04-20
+
BidiMirroring.txt
http://www.unicode.org/Public/UNIDATA/BidiMirroring.txt
-2013-12-17
+2017-04-20
IVD_Sequences.txt
-http://www.unicode.org/ivd/data/2014-05-16/IVD_Sequences.txt
-2014-05-16
+http://www.unicode.org/ivd/
+2016-08-15
UnicodeData.txt
http://www.unicode.org/Public/UNIDATA/UnicodeData.txt
-2014-03-10
+2017-03-07
Blocks.txt
http://www.unicode.org/Public/8.0.0/ucd/Blocks.txt
-2014-11-10
+2017-04-20
NormalizationTest.txt
http://www.unicode.org/Public/UNIDATA/NormalizationTest.txt
-2016-07-16
+2017-03-08
SpecialCasing.txt
http://unicode.org/Public/UNIDATA/SpecialCasing.txt
-2016-03-03
+2017-04-20
diff --git a/admin/unidata/SpecialCasing.txt b/admin/unidata/SpecialCasing.txt
index b23fa7f7680..b9ba0d81c16 100644
--- a/admin/unidata/SpecialCasing.txt
+++ b/admin/unidata/SpecialCasing.txt
@@ -1,6 +1,6 @@
-# SpecialCasing-9.0.0.txt
-# Date: 2016-03-02, 18:55:13 GMT
-# © 2016 Unicode®, Inc.
+# SpecialCasing-10.0.0.txt
+# Date: 2017-04-14, 05:40:43 GMT
+# © 2017 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in the U.S. and other countries.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
@@ -197,7 +197,7 @@ FB17; FB17; 0544 056D; 0544 053D; # ARMENIAN SMALL LIGATURE MEN XEH
# ================================================================================
# Conditional Mappings
-# The remainder of this file provides conditional casing data used to produce
+# The remainder of this file provides conditional casing data used to produce
# full case mappings.
# ================================================================================
# Language-Insensitive Mappings
diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt
index a756976461b..d89c64f526a 100644
--- a/admin/unidata/UnicodeData.txt
+++ b/admin/unidata/UnicodeData.txt
@@ -2072,6 +2072,17 @@
085A;MANDAIC VOCALIZATION MARK;Mn;220;NSM;;;;;N;;;;;
085B;MANDAIC GEMINATION MARK;Mn;220;NSM;;;;;N;;;;;
085E;MANDAIC PUNCTUATION;Po;0;R;;;;;N;;;;;
+0860;SYRIAC LETTER MALAYALAM NGA;Lo;0;AL;;;;;N;;;;;
+0861;SYRIAC LETTER MALAYALAM JA;Lo;0;AL;;;;;N;;;;;
+0862;SYRIAC LETTER MALAYALAM NYA;Lo;0;AL;;;;;N;;;;;
+0863;SYRIAC LETTER MALAYALAM TTA;Lo;0;AL;;;;;N;;;;;
+0864;SYRIAC LETTER MALAYALAM NNA;Lo;0;AL;;;;;N;;;;;
+0865;SYRIAC LETTER MALAYALAM NNNA;Lo;0;AL;;;;;N;;;;;
+0866;SYRIAC LETTER MALAYALAM BHA;Lo;0;AL;;;;;N;;;;;
+0867;SYRIAC LETTER MALAYALAM RA;Lo;0;AL;;;;;N;;;;;
+0868;SYRIAC LETTER MALAYALAM LLA;Lo;0;AL;;;;;N;;;;;
+0869;SYRIAC LETTER MALAYALAM LLLA;Lo;0;AL;;;;;N;;;;;
+086A;SYRIAC LETTER MALAYALAM SSA;Lo;0;AL;;;;;N;;;;;
08A0;ARABIC LETTER BEH WITH SMALL V BELOW;Lo;0;AL;;;;;N;;;;;
08A1;ARABIC LETTER BEH WITH HAMZA ABOVE;Lo;0;AL;;;;;N;;;;;
08A2;ARABIC LETTER JEEM WITH TWO DOTS ABOVE;Lo;0;AL;;;;;N;;;;;
@@ -2366,6 +2377,8 @@
09F9;BENGALI CURRENCY DENOMINATOR SIXTEEN;No;0;L;;;;16;N;;;;;
09FA;BENGALI ISSHAR;So;0;L;;;;;N;;;;;
09FB;BENGALI GANDA MARK;Sc;0;ET;;;;;N;;;;;
+09FC;BENGALI LETTER VEDIC ANUSVARA;Lo;0;L;;;;;N;;;;;
+09FD;BENGALI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
0A01;GURMUKHI SIGN ADAK BINDI;Mn;0;NSM;;;;;N;;;;;
0A02;GURMUKHI SIGN BINDI;Mn;0;NSM;;;;;N;;;;;
0A03;GURMUKHI SIGN VISARGA;Mc;0;L;;;;;N;;;;;
@@ -2530,6 +2543,12 @@
0AF0;GUJARATI ABBREVIATION SIGN;Po;0;L;;;;;N;;;;;
0AF1;GUJARATI RUPEE SIGN;Sc;0;ET;;;;;N;;;;;
0AF9;GUJARATI LETTER ZHA;Lo;0;L;;;;;N;;;;;
+0AFA;GUJARATI SIGN SUKUN;Mn;0;NSM;;;;;N;;;;;
+0AFB;GUJARATI SIGN SHADDA;Mn;0;NSM;;;;;N;;;;;
+0AFC;GUJARATI SIGN MADDAH;Mn;0;NSM;;;;;N;;;;;
+0AFD;GUJARATI SIGN THREE-DOT NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;;
+0AFE;GUJARATI SIGN CIRCLE NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;;
+0AFF;GUJARATI SIGN TWO-CIRCLE NUKTA ABOVE;Mn;0;NSM;;;;;N;;;;;
0B01;ORIYA SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0B02;ORIYA SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
0B03;ORIYA SIGN VISARGA;Mc;0;L;;;;;N;;;;;
@@ -2876,6 +2895,7 @@
0CEF;KANNADA DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
0CF1;KANNADA SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
0CF2;KANNADA SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+0D00;MALAYALAM SIGN COMBINING ANUSVARA ABOVE;Mn;0;NSM;;;;;N;;;;;
0D01;MALAYALAM SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
0D02;MALAYALAM SIGN ANUSVARA;Mc;0;L;;;;;N;;;;;
0D03;MALAYALAM SIGN VISARGA;Mc;0;L;;;;;N;;;;;
@@ -2931,6 +2951,8 @@
0D38;MALAYALAM LETTER SA;Lo;0;L;;;;;N;;;;;
0D39;MALAYALAM LETTER HA;Lo;0;L;;;;;N;;;;;
0D3A;MALAYALAM LETTER TTTA;Lo;0;L;;;;;N;;;;;
+0D3B;MALAYALAM SIGN VERTICAL BAR VIRAMA;Mn;9;NSM;;;;;N;;;;;
+0D3C;MALAYALAM SIGN CIRCULAR VIRAMA;Mn;9;NSM;;;;;N;;;;;
0D3D;MALAYALAM SIGN AVAGRAHA;Lo;0;L;;;;;N;;;;;
0D3E;MALAYALAM VOWEL SIGN AA;Mc;0;L;;;;;N;;;;;
0D3F;MALAYALAM VOWEL SIGN I;Mc;0;L;;;;;N;;;;;
@@ -6413,6 +6435,7 @@
1CF4;VEDIC TONE CANDRA ABOVE;Mn;230;NSM;;;;;N;;;;;
1CF5;VEDIC SIGN JIHVAMULIYA;Lo;0;L;;;;;N;;;;;
1CF6;VEDIC SIGN UPADHMANIYA;Lo;0;L;;;;;N;;;;;
+1CF7;VEDIC SIGN ATIKRAMA;Mc;0;L;;;;;N;;;;;
1CF8;VEDIC TONE RING ABOVE;Mn;230;NSM;;;;;N;;;;;
1CF9;VEDIC TONE DOUBLE RING ABOVE;Mn;230;NSM;;;;;N;;;;;
1D00;LATIN LETTER SMALL CAPITAL A;Ll;0;L;;;;;N;;;;;
@@ -6661,6 +6684,10 @@
1DF3;COMBINING LATIN SMALL LETTER O WITH DIAERESIS;Mn;230;NSM;;;;;N;;;;;
1DF4;COMBINING LATIN SMALL LETTER U WITH DIAERESIS;Mn;230;NSM;;;;;N;;;;;
1DF5;COMBINING UP TACK ABOVE;Mn;230;NSM;;;;;N;;;;;
+1DF6;COMBINING KAVYKA ABOVE RIGHT;Mn;232;NSM;;;;;N;;;;;
+1DF7;COMBINING KAVYKA ABOVE LEFT;Mn;228;NSM;;;;;N;;;;;
+1DF8;COMBINING DOT ABOVE LEFT;Mn;228;NSM;;;;;N;;;;;
+1DF9;COMBINING WIDE INVERTED BRIDGE BELOW;Mn;220;NSM;;;;;N;;;;;
1DFB;COMBINING DELETION MARK;Mn;230;NSM;;;;;N;;;;;
1DFC;COMBINING DOUBLE INVERTED BREVE BELOW;Mn;233;NSM;;;;;N;;;;;
1DFD;COMBINING ALMOST EQUAL TO BELOW;Mn;220;NSM;;;;;N;;;;;
@@ -7339,6 +7366,7 @@
20BC;MANAT SIGN;Sc;0;ET;;;;;N;;;;;
20BD;RUBLE SIGN;Sc;0;ET;;;;;N;;;;;
20BE;LARI SIGN;Sc;0;ET;;;;;N;;;;;
+20BF;BITCOIN SIGN;Sc;0;ET;;;;;N;;;;;
20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;;
20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;;
20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;;
@@ -8135,6 +8163,7 @@
23FC;POWER ON-OFF SYMBOL;So;0;ON;;;;;N;;;;;
23FD;POWER ON SYMBOL;So;0;ON;;;;;N;;;;;
23FE;POWER SLEEP SYMBOL;So;0;ON;;;;;N;;;;;
+23FF;OBSERVER EYE SYMBOL;So;0;ON;;;;;N;;;;;
2400;SYMBOL FOR NULL;So;0;ON;;;;;N;GRAPHIC FOR NULL;;;;
2401;SYMBOL FOR START OF HEADING;So;0;ON;;;;;N;GRAPHIC FOR START OF HEADING;;;;
2402;SYMBOL FOR START OF TEXT;So;0;ON;;;;;N;GRAPHIC FOR START OF TEXT;;;;
@@ -10083,6 +10112,7 @@
2BCF;ROTATED WHITE FOUR POINTED CUSP;So;0;ON;;;;;N;;;;;
2BD0;SQUARE POSITION INDICATOR;So;0;ON;;;;;N;;;;;
2BD1;UNCERTAINTY SIGN;So;0;ON;;;;;N;;;;;
+2BD2;GROUP MARK;So;0;ON;;;;;N;;;;;
2BEC;LEFTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;;
2BED;UPWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;;
2BEE;RIGHTWARDS TWO-HEADED ARROW WITH TRIANGLE ARROWHEADS;So;0;ON;;;;;N;;;;;
@@ -10615,6 +10645,11 @@
2E42;DOUBLE LOW-REVERSED-9 QUOTATION MARK;Ps;0;ON;;;;;N;;;;;
2E43;DASH WITH LEFT UPTURN;Po;0;ON;;;;;N;;;;;
2E44;DOUBLE SUSPENSION MARK;Po;0;ON;;;;;N;;;;;
+2E45;INVERTED LOW KAVYKA;Po;0;ON;;;;;N;;;;;
+2E46;INVERTED LOW KAVYKA WITH KAVYKA ABOVE;Po;0;ON;;;;;N;;;;;
+2E47;LOW KAVYKA;Po;0;ON;;;;;N;;;;;
+2E48;LOW KAVYKA WITH DOT;Po;0;ON;;;;;N;;;;;
+2E49;DOUBLE STACKED COMMA;Po;0;ON;;;;;N;;;;;
2E80;CJK RADICAL REPEAT;So;0;ON;;;;;N;;;;;
2E81;CJK RADICAL CLIFF;So;0;ON;;;;;N;;;;;
2E82;CJK RADICAL SECOND ONE;So;0;ON;;;;;N;;;;;
@@ -11250,6 +11285,7 @@
312B;BOPOMOFO LETTER NG;Lo;0;L;;;;;N;;;;;
312C;BOPOMOFO LETTER GN;Lo;0;L;;;;;N;;;;;
312D;BOPOMOFO LETTER IH;Lo;0;L;;;;;N;;;;;
+312E;BOPOMOFO LETTER O WITH DOT ABOVE;Lo;0;L;;;;;N;;;;;
3131;HANGUL LETTER KIYEOK;Lo;0;L;<compat> 1100;;;;N;HANGUL LETTER GIYEOG;;;;
3132;HANGUL LETTER SSANGKIYEOK;Lo;0;L;<compat> 1101;;;;N;HANGUL LETTER SSANG GIYEOG;;;;
3133;HANGUL LETTER KIYEOK-SIOS;Lo;0;L;<compat> 11AA;;;;N;HANGUL LETTER GIYEOG SIOS;;;;
@@ -12016,7 +12052,7 @@
4DFE;HEXAGRAM FOR AFTER COMPLETION;So;0;ON;;;;;N;;;;;
4DFF;HEXAGRAM FOR BEFORE COMPLETION;So;0;ON;;;;;N;;;;;
4E00;<CJK Ideograph, First>;Lo;0;L;;;;;N;;;;;
-9FD5;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
+9FEA;<CJK Ideograph, Last>;Lo;0;L;;;;;N;;;;;
A000;YI SYLLABLE IT;Lo;0;L;;;;;N;;;;;
A001;YI SYLLABLE IX;Lo;0;L;;;;;N;;;;;
A002;YI SYLLABLE I;Lo;0;L;;;;;N;;;;;
@@ -17093,6 +17129,9 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
10321;OLD ITALIC NUMERAL FIVE;No;0;L;;;;5;N;;;;;
10322;OLD ITALIC NUMERAL TEN;No;0;L;;;;10;N;;;;;
10323;OLD ITALIC NUMERAL FIFTY;No;0;L;;;;50;N;;;;;
+1032D;OLD ITALIC LETTER YE;Lo;0;L;;;;;N;;;;;
+1032E;OLD ITALIC LETTER NORTHERN TSE;Lo;0;L;;;;;N;;;;;
+1032F;OLD ITALIC LETTER SOUTHERN TSE;Lo;0;L;;;;;N;;;;;
10330;GOTHIC LETTER AHSA;Lo;0;L;;;;;N;;;;;
10331;GOTHIC LETTER BAIRKAN;Lo;0;L;;;;;N;;;;;
10332;GOTHIC LETTER GIBA;Lo;0;L;;;;;N;;;;;
@@ -20068,6 +20107,158 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
118F1;WARANG CITI NUMBER EIGHTY;No;0;L;;;;80;N;;;;;
118F2;WARANG CITI NUMBER NINETY;No;0;L;;;;90;N;;;;;
118FF;WARANG CITI OM;Lo;0;L;;;;;N;;;;;
+11A00;ZANABAZAR SQUARE LETTER A;Lo;0;L;;;;;N;;;;;
+11A01;ZANABAZAR SQUARE VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11A02;ZANABAZAR SQUARE VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;;
+11A03;ZANABAZAR SQUARE VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11A04;ZANABAZAR SQUARE VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+11A05;ZANABAZAR SQUARE VOWEL SIGN OE;Mn;0;NSM;;;;;N;;;;;
+11A06;ZANABAZAR SQUARE VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+11A07;ZANABAZAR SQUARE VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+11A08;ZANABAZAR SQUARE VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+11A09;ZANABAZAR SQUARE VOWEL SIGN REVERSED I;Mn;0;NSM;;;;;N;;;;;
+11A0A;ZANABAZAR SQUARE VOWEL LENGTH MARK;Mn;0;NSM;;;;;N;;;;;
+11A0B;ZANABAZAR SQUARE LETTER KA;Lo;0;L;;;;;N;;;;;
+11A0C;ZANABAZAR SQUARE LETTER KHA;Lo;0;L;;;;;N;;;;;
+11A0D;ZANABAZAR SQUARE LETTER GA;Lo;0;L;;;;;N;;;;;
+11A0E;ZANABAZAR SQUARE LETTER GHA;Lo;0;L;;;;;N;;;;;
+11A0F;ZANABAZAR SQUARE LETTER NGA;Lo;0;L;;;;;N;;;;;
+11A10;ZANABAZAR SQUARE LETTER CA;Lo;0;L;;;;;N;;;;;
+11A11;ZANABAZAR SQUARE LETTER CHA;Lo;0;L;;;;;N;;;;;
+11A12;ZANABAZAR SQUARE LETTER JA;Lo;0;L;;;;;N;;;;;
+11A13;ZANABAZAR SQUARE LETTER NYA;Lo;0;L;;;;;N;;;;;
+11A14;ZANABAZAR SQUARE LETTER TTA;Lo;0;L;;;;;N;;;;;
+11A15;ZANABAZAR SQUARE LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11A16;ZANABAZAR SQUARE LETTER DDA;Lo;0;L;;;;;N;;;;;
+11A17;ZANABAZAR SQUARE LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11A18;ZANABAZAR SQUARE LETTER NNA;Lo;0;L;;;;;N;;;;;
+11A19;ZANABAZAR SQUARE LETTER TA;Lo;0;L;;;;;N;;;;;
+11A1A;ZANABAZAR SQUARE LETTER THA;Lo;0;L;;;;;N;;;;;
+11A1B;ZANABAZAR SQUARE LETTER DA;Lo;0;L;;;;;N;;;;;
+11A1C;ZANABAZAR SQUARE LETTER DHA;Lo;0;L;;;;;N;;;;;
+11A1D;ZANABAZAR SQUARE LETTER NA;Lo;0;L;;;;;N;;;;;
+11A1E;ZANABAZAR SQUARE LETTER PA;Lo;0;L;;;;;N;;;;;
+11A1F;ZANABAZAR SQUARE LETTER PHA;Lo;0;L;;;;;N;;;;;
+11A20;ZANABAZAR SQUARE LETTER BA;Lo;0;L;;;;;N;;;;;
+11A21;ZANABAZAR SQUARE LETTER BHA;Lo;0;L;;;;;N;;;;;
+11A22;ZANABAZAR SQUARE LETTER MA;Lo;0;L;;;;;N;;;;;
+11A23;ZANABAZAR SQUARE LETTER TSA;Lo;0;L;;;;;N;;;;;
+11A24;ZANABAZAR SQUARE LETTER TSHA;Lo;0;L;;;;;N;;;;;
+11A25;ZANABAZAR SQUARE LETTER DZA;Lo;0;L;;;;;N;;;;;
+11A26;ZANABAZAR SQUARE LETTER DZHA;Lo;0;L;;;;;N;;;;;
+11A27;ZANABAZAR SQUARE LETTER ZHA;Lo;0;L;;;;;N;;;;;
+11A28;ZANABAZAR SQUARE LETTER ZA;Lo;0;L;;;;;N;;;;;
+11A29;ZANABAZAR SQUARE LETTER -A;Lo;0;L;;;;;N;;;;;
+11A2A;ZANABAZAR SQUARE LETTER YA;Lo;0;L;;;;;N;;;;;
+11A2B;ZANABAZAR SQUARE LETTER RA;Lo;0;L;;;;;N;;;;;
+11A2C;ZANABAZAR SQUARE LETTER LA;Lo;0;L;;;;;N;;;;;
+11A2D;ZANABAZAR SQUARE LETTER VA;Lo;0;L;;;;;N;;;;;
+11A2E;ZANABAZAR SQUARE LETTER SHA;Lo;0;L;;;;;N;;;;;
+11A2F;ZANABAZAR SQUARE LETTER SSA;Lo;0;L;;;;;N;;;;;
+11A30;ZANABAZAR SQUARE LETTER SA;Lo;0;L;;;;;N;;;;;
+11A31;ZANABAZAR SQUARE LETTER HA;Lo;0;L;;;;;N;;;;;
+11A32;ZANABAZAR SQUARE LETTER KSSA;Lo;0;L;;;;;N;;;;;
+11A33;ZANABAZAR SQUARE FINAL CONSONANT MARK;Mn;0;NSM;;;;;N;;;;;
+11A34;ZANABAZAR SQUARE SIGN VIRAMA;Mn;9;NSM;;;;;N;;;;;
+11A35;ZANABAZAR SQUARE SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11A36;ZANABAZAR SQUARE SIGN CANDRABINDU WITH ORNAMENT;Mn;0;NSM;;;;;N;;;;;
+11A37;ZANABAZAR SQUARE SIGN CANDRA WITH ORNAMENT;Mn;0;NSM;;;;;N;;;;;
+11A38;ZANABAZAR SQUARE SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11A39;ZANABAZAR SQUARE SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11A3A;ZANABAZAR SQUARE CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;;
+11A3B;ZANABAZAR SQUARE CLUSTER-FINAL LETTER YA;Mn;0;NSM;;;;;N;;;;;
+11A3C;ZANABAZAR SQUARE CLUSTER-FINAL LETTER RA;Mn;0;NSM;;;;;N;;;;;
+11A3D;ZANABAZAR SQUARE CLUSTER-FINAL LETTER LA;Mn;0;NSM;;;;;N;;;;;
+11A3E;ZANABAZAR SQUARE CLUSTER-FINAL LETTER VA;Mn;0;NSM;;;;;N;;;;;
+11A3F;ZANABAZAR SQUARE INITIAL HEAD MARK;Po;0;L;;;;;N;;;;;
+11A40;ZANABAZAR SQUARE CLOSING HEAD MARK;Po;0;L;;;;;N;;;;;
+11A41;ZANABAZAR SQUARE MARK TSHEG;Po;0;L;;;;;N;;;;;
+11A42;ZANABAZAR SQUARE MARK SHAD;Po;0;L;;;;;N;;;;;
+11A43;ZANABAZAR SQUARE MARK DOUBLE SHAD;Po;0;L;;;;;N;;;;;
+11A44;ZANABAZAR SQUARE MARK LONG TSHEG;Po;0;L;;;;;N;;;;;
+11A45;ZANABAZAR SQUARE INITIAL DOUBLE-LINED HEAD MARK;Po;0;L;;;;;N;;;;;
+11A46;ZANABAZAR SQUARE CLOSING DOUBLE-LINED HEAD MARK;Po;0;L;;;;;N;;;;;
+11A47;ZANABAZAR SQUARE SUBJOINER;Mn;9;NSM;;;;;N;;;;;
+11A50;SOYOMBO LETTER A;Lo;0;L;;;;;N;;;;;
+11A51;SOYOMBO VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11A52;SOYOMBO VOWEL SIGN UE;Mn;0;NSM;;;;;N;;;;;
+11A53;SOYOMBO VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11A54;SOYOMBO VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+11A55;SOYOMBO VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+11A56;SOYOMBO VOWEL SIGN OE;Mn;0;NSM;;;;;N;;;;;
+11A57;SOYOMBO VOWEL SIGN AI;Mc;0;L;;;;;N;;;;;
+11A58;SOYOMBO VOWEL SIGN AU;Mc;0;L;;;;;N;;;;;
+11A59;SOYOMBO VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+11A5A;SOYOMBO VOWEL SIGN VOCALIC L;Mn;0;NSM;;;;;N;;;;;
+11A5B;SOYOMBO VOWEL LENGTH MARK;Mn;0;NSM;;;;;N;;;;;
+11A5C;SOYOMBO LETTER KA;Lo;0;L;;;;;N;;;;;
+11A5D;SOYOMBO LETTER KHA;Lo;0;L;;;;;N;;;;;
+11A5E;SOYOMBO LETTER GA;Lo;0;L;;;;;N;;;;;
+11A5F;SOYOMBO LETTER GHA;Lo;0;L;;;;;N;;;;;
+11A60;SOYOMBO LETTER NGA;Lo;0;L;;;;;N;;;;;
+11A61;SOYOMBO LETTER CA;Lo;0;L;;;;;N;;;;;
+11A62;SOYOMBO LETTER CHA;Lo;0;L;;;;;N;;;;;
+11A63;SOYOMBO LETTER JA;Lo;0;L;;;;;N;;;;;
+11A64;SOYOMBO LETTER JHA;Lo;0;L;;;;;N;;;;;
+11A65;SOYOMBO LETTER NYA;Lo;0;L;;;;;N;;;;;
+11A66;SOYOMBO LETTER TTA;Lo;0;L;;;;;N;;;;;
+11A67;SOYOMBO LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11A68;SOYOMBO LETTER DDA;Lo;0;L;;;;;N;;;;;
+11A69;SOYOMBO LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11A6A;SOYOMBO LETTER NNA;Lo;0;L;;;;;N;;;;;
+11A6B;SOYOMBO LETTER TA;Lo;0;L;;;;;N;;;;;
+11A6C;SOYOMBO LETTER THA;Lo;0;L;;;;;N;;;;;
+11A6D;SOYOMBO LETTER DA;Lo;0;L;;;;;N;;;;;
+11A6E;SOYOMBO LETTER DHA;Lo;0;L;;;;;N;;;;;
+11A6F;SOYOMBO LETTER NA;Lo;0;L;;;;;N;;;;;
+11A70;SOYOMBO LETTER PA;Lo;0;L;;;;;N;;;;;
+11A71;SOYOMBO LETTER PHA;Lo;0;L;;;;;N;;;;;
+11A72;SOYOMBO LETTER BA;Lo;0;L;;;;;N;;;;;
+11A73;SOYOMBO LETTER BHA;Lo;0;L;;;;;N;;;;;
+11A74;SOYOMBO LETTER MA;Lo;0;L;;;;;N;;;;;
+11A75;SOYOMBO LETTER TSA;Lo;0;L;;;;;N;;;;;
+11A76;SOYOMBO LETTER TSHA;Lo;0;L;;;;;N;;;;;
+11A77;SOYOMBO LETTER DZA;Lo;0;L;;;;;N;;;;;
+11A78;SOYOMBO LETTER ZHA;Lo;0;L;;;;;N;;;;;
+11A79;SOYOMBO LETTER ZA;Lo;0;L;;;;;N;;;;;
+11A7A;SOYOMBO LETTER -A;Lo;0;L;;;;;N;;;;;
+11A7B;SOYOMBO LETTER YA;Lo;0;L;;;;;N;;;;;
+11A7C;SOYOMBO LETTER RA;Lo;0;L;;;;;N;;;;;
+11A7D;SOYOMBO LETTER LA;Lo;0;L;;;;;N;;;;;
+11A7E;SOYOMBO LETTER VA;Lo;0;L;;;;;N;;;;;
+11A7F;SOYOMBO LETTER SHA;Lo;0;L;;;;;N;;;;;
+11A80;SOYOMBO LETTER SSA;Lo;0;L;;;;;N;;;;;
+11A81;SOYOMBO LETTER SA;Lo;0;L;;;;;N;;;;;
+11A82;SOYOMBO LETTER HA;Lo;0;L;;;;;N;;;;;
+11A83;SOYOMBO LETTER KSSA;Lo;0;L;;;;;N;;;;;
+11A86;SOYOMBO CLUSTER-INITIAL LETTER RA;Lo;0;L;;;;;N;;;;;
+11A87;SOYOMBO CLUSTER-INITIAL LETTER LA;Lo;0;L;;;;;N;;;;;
+11A88;SOYOMBO CLUSTER-INITIAL LETTER SHA;Lo;0;L;;;;;N;;;;;
+11A89;SOYOMBO CLUSTER-INITIAL LETTER SA;Lo;0;L;;;;;N;;;;;
+11A8A;SOYOMBO FINAL CONSONANT SIGN G;Mn;0;NSM;;;;;N;;;;;
+11A8B;SOYOMBO FINAL CONSONANT SIGN K;Mn;0;NSM;;;;;N;;;;;
+11A8C;SOYOMBO FINAL CONSONANT SIGN NG;Mn;0;NSM;;;;;N;;;;;
+11A8D;SOYOMBO FINAL CONSONANT SIGN D;Mn;0;NSM;;;;;N;;;;;
+11A8E;SOYOMBO FINAL CONSONANT SIGN N;Mn;0;NSM;;;;;N;;;;;
+11A8F;SOYOMBO FINAL CONSONANT SIGN B;Mn;0;NSM;;;;;N;;;;;
+11A90;SOYOMBO FINAL CONSONANT SIGN M;Mn;0;NSM;;;;;N;;;;;
+11A91;SOYOMBO FINAL CONSONANT SIGN R;Mn;0;NSM;;;;;N;;;;;
+11A92;SOYOMBO FINAL CONSONANT SIGN L;Mn;0;NSM;;;;;N;;;;;
+11A93;SOYOMBO FINAL CONSONANT SIGN SH;Mn;0;NSM;;;;;N;;;;;
+11A94;SOYOMBO FINAL CONSONANT SIGN S;Mn;0;NSM;;;;;N;;;;;
+11A95;SOYOMBO FINAL CONSONANT SIGN -A;Mn;0;NSM;;;;;N;;;;;
+11A96;SOYOMBO SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11A97;SOYOMBO SIGN VISARGA;Mc;0;L;;;;;N;;;;;
+11A98;SOYOMBO GEMINATION MARK;Mn;0;NSM;;;;;N;;;;;
+11A99;SOYOMBO SUBJOINER;Mn;9;NSM;;;;;N;;;;;
+11A9A;SOYOMBO MARK TSHEG;Po;0;L;;;;;N;;;;;
+11A9B;SOYOMBO MARK SHAD;Po;0;L;;;;;N;;;;;
+11A9C;SOYOMBO MARK DOUBLE SHAD;Po;0;L;;;;;N;;;;;
+11A9E;SOYOMBO HEAD MARK WITH MOON AND SUN AND TRIPLE FLAME;Po;0;L;;;;;N;;;;;
+11A9F;SOYOMBO HEAD MARK WITH MOON AND SUN AND FLAME;Po;0;L;;;;;N;;;;;
+11AA0;SOYOMBO HEAD MARK WITH MOON AND SUN;Po;0;L;;;;;N;;;;;
+11AA1;SOYOMBO TERMINAL MARK-1;Po;0;L;;;;;N;;;;;
+11AA2;SOYOMBO TERMINAL MARK-2;Po;0;L;;;;;N;;;;;
11AC0;PAU CIN HAU LETTER PA;Lo;0;L;;;;;N;;;;;
11AC1;PAU CIN HAU LETTER KA;Lo;0;L;;;;;N;;;;;
11AC2;PAU CIN HAU LETTER LA;Lo;0;L;;;;;N;;;;;
@@ -20290,6 +20481,81 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
11CB4;MARCHEN VOWEL SIGN O;Mc;0;L;;;;;N;;;;;
11CB5;MARCHEN SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
11CB6;MARCHEN SIGN CANDRABINDU;Mn;0;NSM;;;;;N;;;;;
+11D00;MASARAM GONDI LETTER A;Lo;0;L;;;;;N;;;;;
+11D01;MASARAM GONDI LETTER AA;Lo;0;L;;;;;N;;;;;
+11D02;MASARAM GONDI LETTER I;Lo;0;L;;;;;N;;;;;
+11D03;MASARAM GONDI LETTER II;Lo;0;L;;;;;N;;;;;
+11D04;MASARAM GONDI LETTER U;Lo;0;L;;;;;N;;;;;
+11D05;MASARAM GONDI LETTER UU;Lo;0;L;;;;;N;;;;;
+11D06;MASARAM GONDI LETTER E;Lo;0;L;;;;;N;;;;;
+11D08;MASARAM GONDI LETTER AI;Lo;0;L;;;;;N;;;;;
+11D09;MASARAM GONDI LETTER O;Lo;0;L;;;;;N;;;;;
+11D0B;MASARAM GONDI LETTER AU;Lo;0;L;;;;;N;;;;;
+11D0C;MASARAM GONDI LETTER KA;Lo;0;L;;;;;N;;;;;
+11D0D;MASARAM GONDI LETTER KHA;Lo;0;L;;;;;N;;;;;
+11D0E;MASARAM GONDI LETTER GA;Lo;0;L;;;;;N;;;;;
+11D0F;MASARAM GONDI LETTER GHA;Lo;0;L;;;;;N;;;;;
+11D10;MASARAM GONDI LETTER NGA;Lo;0;L;;;;;N;;;;;
+11D11;MASARAM GONDI LETTER CA;Lo;0;L;;;;;N;;;;;
+11D12;MASARAM GONDI LETTER CHA;Lo;0;L;;;;;N;;;;;
+11D13;MASARAM GONDI LETTER JA;Lo;0;L;;;;;N;;;;;
+11D14;MASARAM GONDI LETTER JHA;Lo;0;L;;;;;N;;;;;
+11D15;MASARAM GONDI LETTER NYA;Lo;0;L;;;;;N;;;;;
+11D16;MASARAM GONDI LETTER TTA;Lo;0;L;;;;;N;;;;;
+11D17;MASARAM GONDI LETTER TTHA;Lo;0;L;;;;;N;;;;;
+11D18;MASARAM GONDI LETTER DDA;Lo;0;L;;;;;N;;;;;
+11D19;MASARAM GONDI LETTER DDHA;Lo;0;L;;;;;N;;;;;
+11D1A;MASARAM GONDI LETTER NNA;Lo;0;L;;;;;N;;;;;
+11D1B;MASARAM GONDI LETTER TA;Lo;0;L;;;;;N;;;;;
+11D1C;MASARAM GONDI LETTER THA;Lo;0;L;;;;;N;;;;;
+11D1D;MASARAM GONDI LETTER DA;Lo;0;L;;;;;N;;;;;
+11D1E;MASARAM GONDI LETTER DHA;Lo;0;L;;;;;N;;;;;
+11D1F;MASARAM GONDI LETTER NA;Lo;0;L;;;;;N;;;;;
+11D20;MASARAM GONDI LETTER PA;Lo;0;L;;;;;N;;;;;
+11D21;MASARAM GONDI LETTER PHA;Lo;0;L;;;;;N;;;;;
+11D22;MASARAM GONDI LETTER BA;Lo;0;L;;;;;N;;;;;
+11D23;MASARAM GONDI LETTER BHA;Lo;0;L;;;;;N;;;;;
+11D24;MASARAM GONDI LETTER MA;Lo;0;L;;;;;N;;;;;
+11D25;MASARAM GONDI LETTER YA;Lo;0;L;;;;;N;;;;;
+11D26;MASARAM GONDI LETTER RA;Lo;0;L;;;;;N;;;;;
+11D27;MASARAM GONDI LETTER LA;Lo;0;L;;;;;N;;;;;
+11D28;MASARAM GONDI LETTER VA;Lo;0;L;;;;;N;;;;;
+11D29;MASARAM GONDI LETTER SHA;Lo;0;L;;;;;N;;;;;
+11D2A;MASARAM GONDI LETTER SSA;Lo;0;L;;;;;N;;;;;
+11D2B;MASARAM GONDI LETTER SA;Lo;0;L;;;;;N;;;;;
+11D2C;MASARAM GONDI LETTER HA;Lo;0;L;;;;;N;;;;;
+11D2D;MASARAM GONDI LETTER LLA;Lo;0;L;;;;;N;;;;;
+11D2E;MASARAM GONDI LETTER KSSA;Lo;0;L;;;;;N;;;;;
+11D2F;MASARAM GONDI LETTER JNYA;Lo;0;L;;;;;N;;;;;
+11D30;MASARAM GONDI LETTER TRA;Lo;0;L;;;;;N;;;;;
+11D31;MASARAM GONDI VOWEL SIGN AA;Mn;0;NSM;;;;;N;;;;;
+11D32;MASARAM GONDI VOWEL SIGN I;Mn;0;NSM;;;;;N;;;;;
+11D33;MASARAM GONDI VOWEL SIGN II;Mn;0;NSM;;;;;N;;;;;
+11D34;MASARAM GONDI VOWEL SIGN U;Mn;0;NSM;;;;;N;;;;;
+11D35;MASARAM GONDI VOWEL SIGN UU;Mn;0;NSM;;;;;N;;;;;
+11D36;MASARAM GONDI VOWEL SIGN VOCALIC R;Mn;0;NSM;;;;;N;;;;;
+11D3A;MASARAM GONDI VOWEL SIGN E;Mn;0;NSM;;;;;N;;;;;
+11D3C;MASARAM GONDI VOWEL SIGN AI;Mn;0;NSM;;;;;N;;;;;
+11D3D;MASARAM GONDI VOWEL SIGN O;Mn;0;NSM;;;;;N;;;;;
+11D3F;MASARAM GONDI VOWEL SIGN AU;Mn;0;NSM;;;;;N;;;;;
+11D40;MASARAM GONDI SIGN ANUSVARA;Mn;0;NSM;;;;;N;;;;;
+11D41;MASARAM GONDI SIGN VISARGA;Mn;0;NSM;;;;;N;;;;;
+11D42;MASARAM GONDI SIGN NUKTA;Mn;7;NSM;;;;;N;;;;;
+11D43;MASARAM GONDI SIGN CANDRA;Mn;0;NSM;;;;;N;;;;;
+11D44;MASARAM GONDI SIGN HALANTA;Mn;9;NSM;;;;;N;;;;;
+11D45;MASARAM GONDI VIRAMA;Mn;9;NSM;;;;;N;;;;;
+11D46;MASARAM GONDI REPHA;Lo;0;L;;;;;N;;;;;
+11D47;MASARAM GONDI RA-KARA;Mn;0;NSM;;;;;N;;;;;
+11D50;MASARAM GONDI DIGIT ZERO;Nd;0;L;;0;0;0;N;;;;;
+11D51;MASARAM GONDI DIGIT ONE;Nd;0;L;;1;1;1;N;;;;;
+11D52;MASARAM GONDI DIGIT TWO;Nd;0;L;;2;2;2;N;;;;;
+11D53;MASARAM GONDI DIGIT THREE;Nd;0;L;;3;3;3;N;;;;;
+11D54;MASARAM GONDI DIGIT FOUR;Nd;0;L;;4;4;4;N;;;;;
+11D55;MASARAM GONDI DIGIT FIVE;Nd;0;L;;5;5;5;N;;;;;
+11D56;MASARAM GONDI DIGIT SIX;Nd;0;L;;6;6;6;N;;;;;
+11D57;MASARAM GONDI DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;;
+11D58;MASARAM GONDI DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;;
+11D59;MASARAM GONDI DIGIT NINE;Nd;0;L;;9;9;9;N;;;;;
12000;CUNEIFORM SIGN A;Lo;0;L;;;;;N;;;;;
12001;CUNEIFORM SIGN A TIMES A;Lo;0;L;;;;;N;;;;;
12002;CUNEIFORM SIGN A TIMES BAD;Lo;0;L;;;;;N;;;;;
@@ -24087,6 +24353,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
16F9E;MIAO LETTER REFORMED TONE-6;Lm;0;L;;;;;N;;;;;
16F9F;MIAO LETTER REFORMED TONE-8;Lm;0;L;;;;;N;;;;;
16FE0;TANGUT ITERATION MARK;Lm;0;L;;;;;N;;;;;
+16FE1;NUSHU ITERATION MARK;Lm;0;L;;;;;N;;;;;
17000;<Tangut Ideograph, First>;Lo;0;L;;;;;N;;;;;
187EC;<Tangut Ideograph, Last>;Lo;0;L;;;;;N;;;;;
18800;TANGUT COMPONENT-001;Lo;0;L;;;;;N;;;;;
@@ -24846,6 +25113,687 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
18AF2;TANGUT COMPONENT-755;Lo;0;L;;;;;N;;;;;
1B000;KATAKANA LETTER ARCHAIC E;Lo;0;L;;;;;N;;;;;
1B001;HIRAGANA LETTER ARCHAIC YE;Lo;0;L;;;;;N;;;;;
+1B002;HENTAIGANA LETTER A-1;Lo;0;L;;;;;N;;;;;
+1B003;HENTAIGANA LETTER A-2;Lo;0;L;;;;;N;;;;;
+1B004;HENTAIGANA LETTER A-3;Lo;0;L;;;;;N;;;;;
+1B005;HENTAIGANA LETTER A-WO;Lo;0;L;;;;;N;;;;;
+1B006;HENTAIGANA LETTER I-1;Lo;0;L;;;;;N;;;;;
+1B007;HENTAIGANA LETTER I-2;Lo;0;L;;;;;N;;;;;
+1B008;HENTAIGANA LETTER I-3;Lo;0;L;;;;;N;;;;;
+1B009;HENTAIGANA LETTER I-4;Lo;0;L;;;;;N;;;;;
+1B00A;HENTAIGANA LETTER U-1;Lo;0;L;;;;;N;;;;;
+1B00B;HENTAIGANA LETTER U-2;Lo;0;L;;;;;N;;;;;
+1B00C;HENTAIGANA LETTER U-3;Lo;0;L;;;;;N;;;;;
+1B00D;HENTAIGANA LETTER U-4;Lo;0;L;;;;;N;;;;;
+1B00E;HENTAIGANA LETTER U-5;Lo;0;L;;;;;N;;;;;
+1B00F;HENTAIGANA LETTER E-2;Lo;0;L;;;;;N;;;;;
+1B010;HENTAIGANA LETTER E-3;Lo;0;L;;;;;N;;;;;
+1B011;HENTAIGANA LETTER E-4;Lo;0;L;;;;;N;;;;;
+1B012;HENTAIGANA LETTER E-5;Lo;0;L;;;;;N;;;;;
+1B013;HENTAIGANA LETTER E-6;Lo;0;L;;;;;N;;;;;
+1B014;HENTAIGANA LETTER O-1;Lo;0;L;;;;;N;;;;;
+1B015;HENTAIGANA LETTER O-2;Lo;0;L;;;;;N;;;;;
+1B016;HENTAIGANA LETTER O-3;Lo;0;L;;;;;N;;;;;
+1B017;HENTAIGANA LETTER KA-1;Lo;0;L;;;;;N;;;;;
+1B018;HENTAIGANA LETTER KA-2;Lo;0;L;;;;;N;;;;;
+1B019;HENTAIGANA LETTER KA-3;Lo;0;L;;;;;N;;;;;
+1B01A;HENTAIGANA LETTER KA-4;Lo;0;L;;;;;N;;;;;
+1B01B;HENTAIGANA LETTER KA-5;Lo;0;L;;;;;N;;;;;
+1B01C;HENTAIGANA LETTER KA-6;Lo;0;L;;;;;N;;;;;
+1B01D;HENTAIGANA LETTER KA-7;Lo;0;L;;;;;N;;;;;
+1B01E;HENTAIGANA LETTER KA-8;Lo;0;L;;;;;N;;;;;
+1B01F;HENTAIGANA LETTER KA-9;Lo;0;L;;;;;N;;;;;
+1B020;HENTAIGANA LETTER KA-10;Lo;0;L;;;;;N;;;;;
+1B021;HENTAIGANA LETTER KA-11;Lo;0;L;;;;;N;;;;;
+1B022;HENTAIGANA LETTER KA-KE;Lo;0;L;;;;;N;;;;;
+1B023;HENTAIGANA LETTER KI-1;Lo;0;L;;;;;N;;;;;
+1B024;HENTAIGANA LETTER KI-2;Lo;0;L;;;;;N;;;;;
+1B025;HENTAIGANA LETTER KI-3;Lo;0;L;;;;;N;;;;;
+1B026;HENTAIGANA LETTER KI-4;Lo;0;L;;;;;N;;;;;
+1B027;HENTAIGANA LETTER KI-5;Lo;0;L;;;;;N;;;;;
+1B028;HENTAIGANA LETTER KI-6;Lo;0;L;;;;;N;;;;;
+1B029;HENTAIGANA LETTER KI-7;Lo;0;L;;;;;N;;;;;
+1B02A;HENTAIGANA LETTER KI-8;Lo;0;L;;;;;N;;;;;
+1B02B;HENTAIGANA LETTER KU-1;Lo;0;L;;;;;N;;;;;
+1B02C;HENTAIGANA LETTER KU-2;Lo;0;L;;;;;N;;;;;
+1B02D;HENTAIGANA LETTER KU-3;Lo;0;L;;;;;N;;;;;
+1B02E;HENTAIGANA LETTER KU-4;Lo;0;L;;;;;N;;;;;
+1B02F;HENTAIGANA LETTER KU-5;Lo;0;L;;;;;N;;;;;
+1B030;HENTAIGANA LETTER KU-6;Lo;0;L;;;;;N;;;;;
+1B031;HENTAIGANA LETTER KU-7;Lo;0;L;;;;;N;;;;;
+1B032;HENTAIGANA LETTER KE-1;Lo;0;L;;;;;N;;;;;
+1B033;HENTAIGANA LETTER KE-2;Lo;0;L;;;;;N;;;;;
+1B034;HENTAIGANA LETTER KE-3;Lo;0;L;;;;;N;;;;;
+1B035;HENTAIGANA LETTER KE-4;Lo;0;L;;;;;N;;;;;
+1B036;HENTAIGANA LETTER KE-5;Lo;0;L;;;;;N;;;;;
+1B037;HENTAIGANA LETTER KE-6;Lo;0;L;;;;;N;;;;;
+1B038;HENTAIGANA LETTER KO-1;Lo;0;L;;;;;N;;;;;
+1B039;HENTAIGANA LETTER KO-2;Lo;0;L;;;;;N;;;;;
+1B03A;HENTAIGANA LETTER KO-3;Lo;0;L;;;;;N;;;;;
+1B03B;HENTAIGANA LETTER KO-KI;Lo;0;L;;;;;N;;;;;
+1B03C;HENTAIGANA LETTER SA-1;Lo;0;L;;;;;N;;;;;
+1B03D;HENTAIGANA LETTER SA-2;Lo;0;L;;;;;N;;;;;
+1B03E;HENTAIGANA LETTER SA-3;Lo;0;L;;;;;N;;;;;
+1B03F;HENTAIGANA LETTER SA-4;Lo;0;L;;;;;N;;;;;
+1B040;HENTAIGANA LETTER SA-5;Lo;0;L;;;;;N;;;;;
+1B041;HENTAIGANA LETTER SA-6;Lo;0;L;;;;;N;;;;;
+1B042;HENTAIGANA LETTER SA-7;Lo;0;L;;;;;N;;;;;
+1B043;HENTAIGANA LETTER SA-8;Lo;0;L;;;;;N;;;;;
+1B044;HENTAIGANA LETTER SI-1;Lo;0;L;;;;;N;;;;;
+1B045;HENTAIGANA LETTER SI-2;Lo;0;L;;;;;N;;;;;
+1B046;HENTAIGANA LETTER SI-3;Lo;0;L;;;;;N;;;;;
+1B047;HENTAIGANA LETTER SI-4;Lo;0;L;;;;;N;;;;;
+1B048;HENTAIGANA LETTER SI-5;Lo;0;L;;;;;N;;;;;
+1B049;HENTAIGANA LETTER SI-6;Lo;0;L;;;;;N;;;;;
+1B04A;HENTAIGANA LETTER SU-1;Lo;0;L;;;;;N;;;;;
+1B04B;HENTAIGANA LETTER SU-2;Lo;0;L;;;;;N;;;;;
+1B04C;HENTAIGANA LETTER SU-3;Lo;0;L;;;;;N;;;;;
+1B04D;HENTAIGANA LETTER SU-4;Lo;0;L;;;;;N;;;;;
+1B04E;HENTAIGANA LETTER SU-5;Lo;0;L;;;;;N;;;;;
+1B04F;HENTAIGANA LETTER SU-6;Lo;0;L;;;;;N;;;;;
+1B050;HENTAIGANA LETTER SU-7;Lo;0;L;;;;;N;;;;;
+1B051;HENTAIGANA LETTER SU-8;Lo;0;L;;;;;N;;;;;
+1B052;HENTAIGANA LETTER SE-1;Lo;0;L;;;;;N;;;;;
+1B053;HENTAIGANA LETTER SE-2;Lo;0;L;;;;;N;;;;;
+1B054;HENTAIGANA LETTER SE-3;Lo;0;L;;;;;N;;;;;
+1B055;HENTAIGANA LETTER SE-4;Lo;0;L;;;;;N;;;;;
+1B056;HENTAIGANA LETTER SE-5;Lo;0;L;;;;;N;;;;;
+1B057;HENTAIGANA LETTER SO-1;Lo;0;L;;;;;N;;;;;
+1B058;HENTAIGANA LETTER SO-2;Lo;0;L;;;;;N;;;;;
+1B059;HENTAIGANA LETTER SO-3;Lo;0;L;;;;;N;;;;;
+1B05A;HENTAIGANA LETTER SO-4;Lo;0;L;;;;;N;;;;;
+1B05B;HENTAIGANA LETTER SO-5;Lo;0;L;;;;;N;;;;;
+1B05C;HENTAIGANA LETTER SO-6;Lo;0;L;;;;;N;;;;;
+1B05D;HENTAIGANA LETTER SO-7;Lo;0;L;;;;;N;;;;;
+1B05E;HENTAIGANA LETTER TA-1;Lo;0;L;;;;;N;;;;;
+1B05F;HENTAIGANA LETTER TA-2;Lo;0;L;;;;;N;;;;;
+1B060;HENTAIGANA LETTER TA-3;Lo;0;L;;;;;N;;;;;
+1B061;HENTAIGANA LETTER TA-4;Lo;0;L;;;;;N;;;;;
+1B062;HENTAIGANA LETTER TI-1;Lo;0;L;;;;;N;;;;;
+1B063;HENTAIGANA LETTER TI-2;Lo;0;L;;;;;N;;;;;
+1B064;HENTAIGANA LETTER TI-3;Lo;0;L;;;;;N;;;;;
+1B065;HENTAIGANA LETTER TI-4;Lo;0;L;;;;;N;;;;;
+1B066;HENTAIGANA LETTER TI-5;Lo;0;L;;;;;N;;;;;
+1B067;HENTAIGANA LETTER TI-6;Lo;0;L;;;;;N;;;;;
+1B068;HENTAIGANA LETTER TI-7;Lo;0;L;;;;;N;;;;;
+1B069;HENTAIGANA LETTER TU-1;Lo;0;L;;;;;N;;;;;
+1B06A;HENTAIGANA LETTER TU-2;Lo;0;L;;;;;N;;;;;
+1B06B;HENTAIGANA LETTER TU-3;Lo;0;L;;;;;N;;;;;
+1B06C;HENTAIGANA LETTER TU-4;Lo;0;L;;;;;N;;;;;
+1B06D;HENTAIGANA LETTER TU-TO;Lo;0;L;;;;;N;;;;;
+1B06E;HENTAIGANA LETTER TE-1;Lo;0;L;;;;;N;;;;;
+1B06F;HENTAIGANA LETTER TE-2;Lo;0;L;;;;;N;;;;;
+1B070;HENTAIGANA LETTER TE-3;Lo;0;L;;;;;N;;;;;
+1B071;HENTAIGANA LETTER TE-4;Lo;0;L;;;;;N;;;;;
+1B072;HENTAIGANA LETTER TE-5;Lo;0;L;;;;;N;;;;;
+1B073;HENTAIGANA LETTER TE-6;Lo;0;L;;;;;N;;;;;
+1B074;HENTAIGANA LETTER TE-7;Lo;0;L;;;;;N;;;;;
+1B075;HENTAIGANA LETTER TE-8;Lo;0;L;;;;;N;;;;;
+1B076;HENTAIGANA LETTER TE-9;Lo;0;L;;;;;N;;;;;
+1B077;HENTAIGANA LETTER TO-1;Lo;0;L;;;;;N;;;;;
+1B078;HENTAIGANA LETTER TO-2;Lo;0;L;;;;;N;;;;;
+1B079;HENTAIGANA LETTER TO-3;Lo;0;L;;;;;N;;;;;
+1B07A;HENTAIGANA LETTER TO-4;Lo;0;L;;;;;N;;;;;
+1B07B;HENTAIGANA LETTER TO-5;Lo;0;L;;;;;N;;;;;
+1B07C;HENTAIGANA LETTER TO-6;Lo;0;L;;;;;N;;;;;
+1B07D;HENTAIGANA LETTER TO-RA;Lo;0;L;;;;;N;;;;;
+1B07E;HENTAIGANA LETTER NA-1;Lo;0;L;;;;;N;;;;;
+1B07F;HENTAIGANA LETTER NA-2;Lo;0;L;;;;;N;;;;;
+1B080;HENTAIGANA LETTER NA-3;Lo;0;L;;;;;N;;;;;
+1B081;HENTAIGANA LETTER NA-4;Lo;0;L;;;;;N;;;;;
+1B082;HENTAIGANA LETTER NA-5;Lo;0;L;;;;;N;;;;;
+1B083;HENTAIGANA LETTER NA-6;Lo;0;L;;;;;N;;;;;
+1B084;HENTAIGANA LETTER NA-7;Lo;0;L;;;;;N;;;;;
+1B085;HENTAIGANA LETTER NA-8;Lo;0;L;;;;;N;;;;;
+1B086;HENTAIGANA LETTER NA-9;Lo;0;L;;;;;N;;;;;
+1B087;HENTAIGANA LETTER NI-1;Lo;0;L;;;;;N;;;;;
+1B088;HENTAIGANA LETTER NI-2;Lo;0;L;;;;;N;;;;;
+1B089;HENTAIGANA LETTER NI-3;Lo;0;L;;;;;N;;;;;
+1B08A;HENTAIGANA LETTER NI-4;Lo;0;L;;;;;N;;;;;
+1B08B;HENTAIGANA LETTER NI-5;Lo;0;L;;;;;N;;;;;
+1B08C;HENTAIGANA LETTER NI-6;Lo;0;L;;;;;N;;;;;
+1B08D;HENTAIGANA LETTER NI-7;Lo;0;L;;;;;N;;;;;
+1B08E;HENTAIGANA LETTER NI-TE;Lo;0;L;;;;;N;;;;;
+1B08F;HENTAIGANA LETTER NU-1;Lo;0;L;;;;;N;;;;;
+1B090;HENTAIGANA LETTER NU-2;Lo;0;L;;;;;N;;;;;
+1B091;HENTAIGANA LETTER NU-3;Lo;0;L;;;;;N;;;;;
+1B092;HENTAIGANA LETTER NE-1;Lo;0;L;;;;;N;;;;;
+1B093;HENTAIGANA LETTER NE-2;Lo;0;L;;;;;N;;;;;
+1B094;HENTAIGANA LETTER NE-3;Lo;0;L;;;;;N;;;;;
+1B095;HENTAIGANA LETTER NE-4;Lo;0;L;;;;;N;;;;;
+1B096;HENTAIGANA LETTER NE-5;Lo;0;L;;;;;N;;;;;
+1B097;HENTAIGANA LETTER NE-6;Lo;0;L;;;;;N;;;;;
+1B098;HENTAIGANA LETTER NE-KO;Lo;0;L;;;;;N;;;;;
+1B099;HENTAIGANA LETTER NO-1;Lo;0;L;;;;;N;;;;;
+1B09A;HENTAIGANA LETTER NO-2;Lo;0;L;;;;;N;;;;;
+1B09B;HENTAIGANA LETTER NO-3;Lo;0;L;;;;;N;;;;;
+1B09C;HENTAIGANA LETTER NO-4;Lo;0;L;;;;;N;;;;;
+1B09D;HENTAIGANA LETTER NO-5;Lo;0;L;;;;;N;;;;;
+1B09E;HENTAIGANA LETTER HA-1;Lo;0;L;;;;;N;;;;;
+1B09F;HENTAIGANA LETTER HA-2;Lo;0;L;;;;;N;;;;;
+1B0A0;HENTAIGANA LETTER HA-3;Lo;0;L;;;;;N;;;;;
+1B0A1;HENTAIGANA LETTER HA-4;Lo;0;L;;;;;N;;;;;
+1B0A2;HENTAIGANA LETTER HA-5;Lo;0;L;;;;;N;;;;;
+1B0A3;HENTAIGANA LETTER HA-6;Lo;0;L;;;;;N;;;;;
+1B0A4;HENTAIGANA LETTER HA-7;Lo;0;L;;;;;N;;;;;
+1B0A5;HENTAIGANA LETTER HA-8;Lo;0;L;;;;;N;;;;;
+1B0A6;HENTAIGANA LETTER HA-9;Lo;0;L;;;;;N;;;;;
+1B0A7;HENTAIGANA LETTER HA-10;Lo;0;L;;;;;N;;;;;
+1B0A8;HENTAIGANA LETTER HA-11;Lo;0;L;;;;;N;;;;;
+1B0A9;HENTAIGANA LETTER HI-1;Lo;0;L;;;;;N;;;;;
+1B0AA;HENTAIGANA LETTER HI-2;Lo;0;L;;;;;N;;;;;
+1B0AB;HENTAIGANA LETTER HI-3;Lo;0;L;;;;;N;;;;;
+1B0AC;HENTAIGANA LETTER HI-4;Lo;0;L;;;;;N;;;;;
+1B0AD;HENTAIGANA LETTER HI-5;Lo;0;L;;;;;N;;;;;
+1B0AE;HENTAIGANA LETTER HI-6;Lo;0;L;;;;;N;;;;;
+1B0AF;HENTAIGANA LETTER HI-7;Lo;0;L;;;;;N;;;;;
+1B0B0;HENTAIGANA LETTER HU-1;Lo;0;L;;;;;N;;;;;
+1B0B1;HENTAIGANA LETTER HU-2;Lo;0;L;;;;;N;;;;;
+1B0B2;HENTAIGANA LETTER HU-3;Lo;0;L;;;;;N;;;;;
+1B0B3;HENTAIGANA LETTER HE-1;Lo;0;L;;;;;N;;;;;
+1B0B4;HENTAIGANA LETTER HE-2;Lo;0;L;;;;;N;;;;;
+1B0B5;HENTAIGANA LETTER HE-3;Lo;0;L;;;;;N;;;;;
+1B0B6;HENTAIGANA LETTER HE-4;Lo;0;L;;;;;N;;;;;
+1B0B7;HENTAIGANA LETTER HE-5;Lo;0;L;;;;;N;;;;;
+1B0B8;HENTAIGANA LETTER HE-6;Lo;0;L;;;;;N;;;;;
+1B0B9;HENTAIGANA LETTER HE-7;Lo;0;L;;;;;N;;;;;
+1B0BA;HENTAIGANA LETTER HO-1;Lo;0;L;;;;;N;;;;;
+1B0BB;HENTAIGANA LETTER HO-2;Lo;0;L;;;;;N;;;;;
+1B0BC;HENTAIGANA LETTER HO-3;Lo;0;L;;;;;N;;;;;
+1B0BD;HENTAIGANA LETTER HO-4;Lo;0;L;;;;;N;;;;;
+1B0BE;HENTAIGANA LETTER HO-5;Lo;0;L;;;;;N;;;;;
+1B0BF;HENTAIGANA LETTER HO-6;Lo;0;L;;;;;N;;;;;
+1B0C0;HENTAIGANA LETTER HO-7;Lo;0;L;;;;;N;;;;;
+1B0C1;HENTAIGANA LETTER HO-8;Lo;0;L;;;;;N;;;;;
+1B0C2;HENTAIGANA LETTER MA-1;Lo;0;L;;;;;N;;;;;
+1B0C3;HENTAIGANA LETTER MA-2;Lo;0;L;;;;;N;;;;;
+1B0C4;HENTAIGANA LETTER MA-3;Lo;0;L;;;;;N;;;;;
+1B0C5;HENTAIGANA LETTER MA-4;Lo;0;L;;;;;N;;;;;
+1B0C6;HENTAIGANA LETTER MA-5;Lo;0;L;;;;;N;;;;;
+1B0C7;HENTAIGANA LETTER MA-6;Lo;0;L;;;;;N;;;;;
+1B0C8;HENTAIGANA LETTER MA-7;Lo;0;L;;;;;N;;;;;
+1B0C9;HENTAIGANA LETTER MI-1;Lo;0;L;;;;;N;;;;;
+1B0CA;HENTAIGANA LETTER MI-2;Lo;0;L;;;;;N;;;;;
+1B0CB;HENTAIGANA LETTER MI-3;Lo;0;L;;;;;N;;;;;
+1B0CC;HENTAIGANA LETTER MI-4;Lo;0;L;;;;;N;;;;;
+1B0CD;HENTAIGANA LETTER MI-5;Lo;0;L;;;;;N;;;;;
+1B0CE;HENTAIGANA LETTER MI-6;Lo;0;L;;;;;N;;;;;
+1B0CF;HENTAIGANA LETTER MI-7;Lo;0;L;;;;;N;;;;;
+1B0D0;HENTAIGANA LETTER MU-1;Lo;0;L;;;;;N;;;;;
+1B0D1;HENTAIGANA LETTER MU-2;Lo;0;L;;;;;N;;;;;
+1B0D2;HENTAIGANA LETTER MU-3;Lo;0;L;;;;;N;;;;;
+1B0D3;HENTAIGANA LETTER MU-4;Lo;0;L;;;;;N;;;;;
+1B0D4;HENTAIGANA LETTER ME-1;Lo;0;L;;;;;N;;;;;
+1B0D5;HENTAIGANA LETTER ME-2;Lo;0;L;;;;;N;;;;;
+1B0D6;HENTAIGANA LETTER ME-MA;Lo;0;L;;;;;N;;;;;
+1B0D7;HENTAIGANA LETTER MO-1;Lo;0;L;;;;;N;;;;;
+1B0D8;HENTAIGANA LETTER MO-2;Lo;0;L;;;;;N;;;;;
+1B0D9;HENTAIGANA LETTER MO-3;Lo;0;L;;;;;N;;;;;
+1B0DA;HENTAIGANA LETTER MO-4;Lo;0;L;;;;;N;;;;;
+1B0DB;HENTAIGANA LETTER MO-5;Lo;0;L;;;;;N;;;;;
+1B0DC;HENTAIGANA LETTER MO-6;Lo;0;L;;;;;N;;;;;
+1B0DD;HENTAIGANA LETTER YA-1;Lo;0;L;;;;;N;;;;;
+1B0DE;HENTAIGANA LETTER YA-2;Lo;0;L;;;;;N;;;;;
+1B0DF;HENTAIGANA LETTER YA-3;Lo;0;L;;;;;N;;;;;
+1B0E0;HENTAIGANA LETTER YA-4;Lo;0;L;;;;;N;;;;;
+1B0E1;HENTAIGANA LETTER YA-5;Lo;0;L;;;;;N;;;;;
+1B0E2;HENTAIGANA LETTER YA-YO;Lo;0;L;;;;;N;;;;;
+1B0E3;HENTAIGANA LETTER YU-1;Lo;0;L;;;;;N;;;;;
+1B0E4;HENTAIGANA LETTER YU-2;Lo;0;L;;;;;N;;;;;
+1B0E5;HENTAIGANA LETTER YU-3;Lo;0;L;;;;;N;;;;;
+1B0E6;HENTAIGANA LETTER YU-4;Lo;0;L;;;;;N;;;;;
+1B0E7;HENTAIGANA LETTER YO-1;Lo;0;L;;;;;N;;;;;
+1B0E8;HENTAIGANA LETTER YO-2;Lo;0;L;;;;;N;;;;;
+1B0E9;HENTAIGANA LETTER YO-3;Lo;0;L;;;;;N;;;;;
+1B0EA;HENTAIGANA LETTER YO-4;Lo;0;L;;;;;N;;;;;
+1B0EB;HENTAIGANA LETTER YO-5;Lo;0;L;;;;;N;;;;;
+1B0EC;HENTAIGANA LETTER YO-6;Lo;0;L;;;;;N;;;;;
+1B0ED;HENTAIGANA LETTER RA-1;Lo;0;L;;;;;N;;;;;
+1B0EE;HENTAIGANA LETTER RA-2;Lo;0;L;;;;;N;;;;;
+1B0EF;HENTAIGANA LETTER RA-3;Lo;0;L;;;;;N;;;;;
+1B0F0;HENTAIGANA LETTER RA-4;Lo;0;L;;;;;N;;;;;
+1B0F1;HENTAIGANA LETTER RI-1;Lo;0;L;;;;;N;;;;;
+1B0F2;HENTAIGANA LETTER RI-2;Lo;0;L;;;;;N;;;;;
+1B0F3;HENTAIGANA LETTER RI-3;Lo;0;L;;;;;N;;;;;
+1B0F4;HENTAIGANA LETTER RI-4;Lo;0;L;;;;;N;;;;;
+1B0F5;HENTAIGANA LETTER RI-5;Lo;0;L;;;;;N;;;;;
+1B0F6;HENTAIGANA LETTER RI-6;Lo;0;L;;;;;N;;;;;
+1B0F7;HENTAIGANA LETTER RI-7;Lo;0;L;;;;;N;;;;;
+1B0F8;HENTAIGANA LETTER RU-1;Lo;0;L;;;;;N;;;;;
+1B0F9;HENTAIGANA LETTER RU-2;Lo;0;L;;;;;N;;;;;
+1B0FA;HENTAIGANA LETTER RU-3;Lo;0;L;;;;;N;;;;;
+1B0FB;HENTAIGANA LETTER RU-4;Lo;0;L;;;;;N;;;;;
+1B0FC;HENTAIGANA LETTER RU-5;Lo;0;L;;;;;N;;;;;
+1B0FD;HENTAIGANA LETTER RU-6;Lo;0;L;;;;;N;;;;;
+1B0FE;HENTAIGANA LETTER RE-1;Lo;0;L;;;;;N;;;;;
+1B0FF;HENTAIGANA LETTER RE-2;Lo;0;L;;;;;N;;;;;
+1B100;HENTAIGANA LETTER RE-3;Lo;0;L;;;;;N;;;;;
+1B101;HENTAIGANA LETTER RE-4;Lo;0;L;;;;;N;;;;;
+1B102;HENTAIGANA LETTER RO-1;Lo;0;L;;;;;N;;;;;
+1B103;HENTAIGANA LETTER RO-2;Lo;0;L;;;;;N;;;;;
+1B104;HENTAIGANA LETTER RO-3;Lo;0;L;;;;;N;;;;;
+1B105;HENTAIGANA LETTER RO-4;Lo;0;L;;;;;N;;;;;
+1B106;HENTAIGANA LETTER RO-5;Lo;0;L;;;;;N;;;;;
+1B107;HENTAIGANA LETTER RO-6;Lo;0;L;;;;;N;;;;;
+1B108;HENTAIGANA LETTER WA-1;Lo;0;L;;;;;N;;;;;
+1B109;HENTAIGANA LETTER WA-2;Lo;0;L;;;;;N;;;;;
+1B10A;HENTAIGANA LETTER WA-3;Lo;0;L;;;;;N;;;;;
+1B10B;HENTAIGANA LETTER WA-4;Lo;0;L;;;;;N;;;;;
+1B10C;HENTAIGANA LETTER WA-5;Lo;0;L;;;;;N;;;;;
+1B10D;HENTAIGANA LETTER WI-1;Lo;0;L;;;;;N;;;;;
+1B10E;HENTAIGANA LETTER WI-2;Lo;0;L;;;;;N;;;;;
+1B10F;HENTAIGANA LETTER WI-3;Lo;0;L;;;;;N;;;;;
+1B110;HENTAIGANA LETTER WI-4;Lo;0;L;;;;;N;;;;;
+1B111;HENTAIGANA LETTER WI-5;Lo;0;L;;;;;N;;;;;
+1B112;HENTAIGANA LETTER WE-1;Lo;0;L;;;;;N;;;;;
+1B113;HENTAIGANA LETTER WE-2;Lo;0;L;;;;;N;;;;;
+1B114;HENTAIGANA LETTER WE-3;Lo;0;L;;;;;N;;;;;
+1B115;HENTAIGANA LETTER WE-4;Lo;0;L;;;;;N;;;;;
+1B116;HENTAIGANA LETTER WO-1;Lo;0;L;;;;;N;;;;;
+1B117;HENTAIGANA LETTER WO-2;Lo;0;L;;;;;N;;;;;
+1B118;HENTAIGANA LETTER WO-3;Lo;0;L;;;;;N;;;;;
+1B119;HENTAIGANA LETTER WO-4;Lo;0;L;;;;;N;;;;;
+1B11A;HENTAIGANA LETTER WO-5;Lo;0;L;;;;;N;;;;;
+1B11B;HENTAIGANA LETTER WO-6;Lo;0;L;;;;;N;;;;;
+1B11C;HENTAIGANA LETTER WO-7;Lo;0;L;;;;;N;;;;;
+1B11D;HENTAIGANA LETTER N-MU-MO-1;Lo;0;L;;;;;N;;;;;
+1B11E;HENTAIGANA LETTER N-MU-MO-2;Lo;0;L;;;;;N;;;;;
+1B170;NUSHU CHARACTER-1B170;Lo;0;L;;;;;N;;;;;
+1B171;NUSHU CHARACTER-1B171;Lo;0;L;;;;;N;;;;;
+1B172;NUSHU CHARACTER-1B172;Lo;0;L;;;;;N;;;;;
+1B173;NUSHU CHARACTER-1B173;Lo;0;L;;;;;N;;;;;
+1B174;NUSHU CHARACTER-1B174;Lo;0;L;;;;;N;;;;;
+1B175;NUSHU CHARACTER-1B175;Lo;0;L;;;;;N;;;;;
+1B176;NUSHU CHARACTER-1B176;Lo;0;L;;;;;N;;;;;
+1B177;NUSHU CHARACTER-1B177;Lo;0;L;;;;;N;;;;;
+1B178;NUSHU CHARACTER-1B178;Lo;0;L;;;;;N;;;;;
+1B179;NUSHU CHARACTER-1B179;Lo;0;L;;;;;N;;;;;
+1B17A;NUSHU CHARACTER-1B17A;Lo;0;L;;;;;N;;;;;
+1B17B;NUSHU CHARACTER-1B17B;Lo;0;L;;;;;N;;;;;
+1B17C;NUSHU CHARACTER-1B17C;Lo;0;L;;;;;N;;;;;
+1B17D;NUSHU CHARACTER-1B17D;Lo;0;L;;;;;N;;;;;
+1B17E;NUSHU CHARACTER-1B17E;Lo;0;L;;;;;N;;;;;
+1B17F;NUSHU CHARACTER-1B17F;Lo;0;L;;;;;N;;;;;
+1B180;NUSHU CHARACTER-1B180;Lo;0;L;;;;;N;;;;;
+1B181;NUSHU CHARACTER-1B181;Lo;0;L;;;;;N;;;;;
+1B182;NUSHU CHARACTER-1B182;Lo;0;L;;;;;N;;;;;
+1B183;NUSHU CHARACTER-1B183;Lo;0;L;;;;;N;;;;;
+1B184;NUSHU CHARACTER-1B184;Lo;0;L;;;;;N;;;;;
+1B185;NUSHU CHARACTER-1B185;Lo;0;L;;;;;N;;;;;
+1B186;NUSHU CHARACTER-1B186;Lo;0;L;;;;;N;;;;;
+1B187;NUSHU CHARACTER-1B187;Lo;0;L;;;;;N;;;;;
+1B188;NUSHU CHARACTER-1B188;Lo;0;L;;;;;N;;;;;
+1B189;NUSHU CHARACTER-1B189;Lo;0;L;;;;;N;;;;;
+1B18A;NUSHU CHARACTER-1B18A;Lo;0;L;;;;;N;;;;;
+1B18B;NUSHU CHARACTER-1B18B;Lo;0;L;;;;;N;;;;;
+1B18C;NUSHU CHARACTER-1B18C;Lo;0;L;;;;;N;;;;;
+1B18D;NUSHU CHARACTER-1B18D;Lo;0;L;;;;;N;;;;;
+1B18E;NUSHU CHARACTER-1B18E;Lo;0;L;;;;;N;;;;;
+1B18F;NUSHU CHARACTER-1B18F;Lo;0;L;;;;;N;;;;;
+1B190;NUSHU CHARACTER-1B190;Lo;0;L;;;;;N;;;;;
+1B191;NUSHU CHARACTER-1B191;Lo;0;L;;;;;N;;;;;
+1B192;NUSHU CHARACTER-1B192;Lo;0;L;;;;;N;;;;;
+1B193;NUSHU CHARACTER-1B193;Lo;0;L;;;;;N;;;;;
+1B194;NUSHU CHARACTER-1B194;Lo;0;L;;;;;N;;;;;
+1B195;NUSHU CHARACTER-1B195;Lo;0;L;;;;;N;;;;;
+1B196;NUSHU CHARACTER-1B196;Lo;0;L;;;;;N;;;;;
+1B197;NUSHU CHARACTER-1B197;Lo;0;L;;;;;N;;;;;
+1B198;NUSHU CHARACTER-1B198;Lo;0;L;;;;;N;;;;;
+1B199;NUSHU CHARACTER-1B199;Lo;0;L;;;;;N;;;;;
+1B19A;NUSHU CHARACTER-1B19A;Lo;0;L;;;;;N;;;;;
+1B19B;NUSHU CHARACTER-1B19B;Lo;0;L;;;;;N;;;;;
+1B19C;NUSHU CHARACTER-1B19C;Lo;0;L;;;;;N;;;;;
+1B19D;NUSHU CHARACTER-1B19D;Lo;0;L;;;;;N;;;;;
+1B19E;NUSHU CHARACTER-1B19E;Lo;0;L;;;;;N;;;;;
+1B19F;NUSHU CHARACTER-1B19F;Lo;0;L;;;;;N;;;;;
+1B1A0;NUSHU CHARACTER-1B1A0;Lo;0;L;;;;;N;;;;;
+1B1A1;NUSHU CHARACTER-1B1A1;Lo;0;L;;;;;N;;;;;
+1B1A2;NUSHU CHARACTER-1B1A2;Lo;0;L;;;;;N;;;;;
+1B1A3;NUSHU CHARACTER-1B1A3;Lo;0;L;;;;;N;;;;;
+1B1A4;NUSHU CHARACTER-1B1A4;Lo;0;L;;;;;N;;;;;
+1B1A5;NUSHU CHARACTER-1B1A5;Lo;0;L;;;;;N;;;;;
+1B1A6;NUSHU CHARACTER-1B1A6;Lo;0;L;;;;;N;;;;;
+1B1A7;NUSHU CHARACTER-1B1A7;Lo;0;L;;;;;N;;;;;
+1B1A8;NUSHU CHARACTER-1B1A8;Lo;0;L;;;;;N;;;;;
+1B1A9;NUSHU CHARACTER-1B1A9;Lo;0;L;;;;;N;;;;;
+1B1AA;NUSHU CHARACTER-1B1AA;Lo;0;L;;;;;N;;;;;
+1B1AB;NUSHU CHARACTER-1B1AB;Lo;0;L;;;;;N;;;;;
+1B1AC;NUSHU CHARACTER-1B1AC;Lo;0;L;;;;;N;;;;;
+1B1AD;NUSHU CHARACTER-1B1AD;Lo;0;L;;;;;N;;;;;
+1B1AE;NUSHU CHARACTER-1B1AE;Lo;0;L;;;;;N;;;;;
+1B1AF;NUSHU CHARACTER-1B1AF;Lo;0;L;;;;;N;;;;;
+1B1B0;NUSHU CHARACTER-1B1B0;Lo;0;L;;;;;N;;;;;
+1B1B1;NUSHU CHARACTER-1B1B1;Lo;0;L;;;;;N;;;;;
+1B1B2;NUSHU CHARACTER-1B1B2;Lo;0;L;;;;;N;;;;;
+1B1B3;NUSHU CHARACTER-1B1B3;Lo;0;L;;;;;N;;;;;
+1B1B4;NUSHU CHARACTER-1B1B4;Lo;0;L;;;;;N;;;;;
+1B1B5;NUSHU CHARACTER-1B1B5;Lo;0;L;;;;;N;;;;;
+1B1B6;NUSHU CHARACTER-1B1B6;Lo;0;L;;;;;N;;;;;
+1B1B7;NUSHU CHARACTER-1B1B7;Lo;0;L;;;;;N;;;;;
+1B1B8;NUSHU CHARACTER-1B1B8;Lo;0;L;;;;;N;;;;;
+1B1B9;NUSHU CHARACTER-1B1B9;Lo;0;L;;;;;N;;;;;
+1B1BA;NUSHU CHARACTER-1B1BA;Lo;0;L;;;;;N;;;;;
+1B1BB;NUSHU CHARACTER-1B1BB;Lo;0;L;;;;;N;;;;;
+1B1BC;NUSHU CHARACTER-1B1BC;Lo;0;L;;;;;N;;;;;
+1B1BD;NUSHU CHARACTER-1B1BD;Lo;0;L;;;;;N;;;;;
+1B1BE;NUSHU CHARACTER-1B1BE;Lo;0;L;;;;;N;;;;;
+1B1BF;NUSHU CHARACTER-1B1BF;Lo;0;L;;;;;N;;;;;
+1B1C0;NUSHU CHARACTER-1B1C0;Lo;0;L;;;;;N;;;;;
+1B1C1;NUSHU CHARACTER-1B1C1;Lo;0;L;;;;;N;;;;;
+1B1C2;NUSHU CHARACTER-1B1C2;Lo;0;L;;;;;N;;;;;
+1B1C3;NUSHU CHARACTER-1B1C3;Lo;0;L;;;;;N;;;;;
+1B1C4;NUSHU CHARACTER-1B1C4;Lo;0;L;;;;;N;;;;;
+1B1C5;NUSHU CHARACTER-1B1C5;Lo;0;L;;;;;N;;;;;
+1B1C6;NUSHU CHARACTER-1B1C6;Lo;0;L;;;;;N;;;;;
+1B1C7;NUSHU CHARACTER-1B1C7;Lo;0;L;;;;;N;;;;;
+1B1C8;NUSHU CHARACTER-1B1C8;Lo;0;L;;;;;N;;;;;
+1B1C9;NUSHU CHARACTER-1B1C9;Lo;0;L;;;;;N;;;;;
+1B1CA;NUSHU CHARACTER-1B1CA;Lo;0;L;;;;;N;;;;;
+1B1CB;NUSHU CHARACTER-1B1CB;Lo;0;L;;;;;N;;;;;
+1B1CC;NUSHU CHARACTER-1B1CC;Lo;0;L;;;;;N;;;;;
+1B1CD;NUSHU CHARACTER-1B1CD;Lo;0;L;;;;;N;;;;;
+1B1CE;NUSHU CHARACTER-1B1CE;Lo;0;L;;;;;N;;;;;
+1B1CF;NUSHU CHARACTER-1B1CF;Lo;0;L;;;;;N;;;;;
+1B1D0;NUSHU CHARACTER-1B1D0;Lo;0;L;;;;;N;;;;;
+1B1D1;NUSHU CHARACTER-1B1D1;Lo;0;L;;;;;N;;;;;
+1B1D2;NUSHU CHARACTER-1B1D2;Lo;0;L;;;;;N;;;;;
+1B1D3;NUSHU CHARACTER-1B1D3;Lo;0;L;;;;;N;;;;;
+1B1D4;NUSHU CHARACTER-1B1D4;Lo;0;L;;;;;N;;;;;
+1B1D5;NUSHU CHARACTER-1B1D5;Lo;0;L;;;;;N;;;;;
+1B1D6;NUSHU CHARACTER-1B1D6;Lo;0;L;;;;;N;;;;;
+1B1D7;NUSHU CHARACTER-1B1D7;Lo;0;L;;;;;N;;;;;
+1B1D8;NUSHU CHARACTER-1B1D8;Lo;0;L;;;;;N;;;;;
+1B1D9;NUSHU CHARACTER-1B1D9;Lo;0;L;;;;;N;;;;;
+1B1DA;NUSHU CHARACTER-1B1DA;Lo;0;L;;;;;N;;;;;
+1B1DB;NUSHU CHARACTER-1B1DB;Lo;0;L;;;;;N;;;;;
+1B1DC;NUSHU CHARACTER-1B1DC;Lo;0;L;;;;;N;;;;;
+1B1DD;NUSHU CHARACTER-1B1DD;Lo;0;L;;;;;N;;;;;
+1B1DE;NUSHU CHARACTER-1B1DE;Lo;0;L;;;;;N;;;;;
+1B1DF;NUSHU CHARACTER-1B1DF;Lo;0;L;;;;;N;;;;;
+1B1E0;NUSHU CHARACTER-1B1E0;Lo;0;L;;;;;N;;;;;
+1B1E1;NUSHU CHARACTER-1B1E1;Lo;0;L;;;;;N;;;;;
+1B1E2;NUSHU CHARACTER-1B1E2;Lo;0;L;;;;;N;;;;;
+1B1E3;NUSHU CHARACTER-1B1E3;Lo;0;L;;;;;N;;;;;
+1B1E4;NUSHU CHARACTER-1B1E4;Lo;0;L;;;;;N;;;;;
+1B1E5;NUSHU CHARACTER-1B1E5;Lo;0;L;;;;;N;;;;;
+1B1E6;NUSHU CHARACTER-1B1E6;Lo;0;L;;;;;N;;;;;
+1B1E7;NUSHU CHARACTER-1B1E7;Lo;0;L;;;;;N;;;;;
+1B1E8;NUSHU CHARACTER-1B1E8;Lo;0;L;;;;;N;;;;;
+1B1E9;NUSHU CHARACTER-1B1E9;Lo;0;L;;;;;N;;;;;
+1B1EA;NUSHU CHARACTER-1B1EA;Lo;0;L;;;;;N;;;;;
+1B1EB;NUSHU CHARACTER-1B1EB;Lo;0;L;;;;;N;;;;;
+1B1EC;NUSHU CHARACTER-1B1EC;Lo;0;L;;;;;N;;;;;
+1B1ED;NUSHU CHARACTER-1B1ED;Lo;0;L;;;;;N;;;;;
+1B1EE;NUSHU CHARACTER-1B1EE;Lo;0;L;;;;;N;;;;;
+1B1EF;NUSHU CHARACTER-1B1EF;Lo;0;L;;;;;N;;;;;
+1B1F0;NUSHU CHARACTER-1B1F0;Lo;0;L;;;;;N;;;;;
+1B1F1;NUSHU CHARACTER-1B1F1;Lo;0;L;;;;;N;;;;;
+1B1F2;NUSHU CHARACTER-1B1F2;Lo;0;L;;;;;N;;;;;
+1B1F3;NUSHU CHARACTER-1B1F3;Lo;0;L;;;;;N;;;;;
+1B1F4;NUSHU CHARACTER-1B1F4;Lo;0;L;;;;;N;;;;;
+1B1F5;NUSHU CHARACTER-1B1F5;Lo;0;L;;;;;N;;;;;
+1B1F6;NUSHU CHARACTER-1B1F6;Lo;0;L;;;;;N;;;;;
+1B1F7;NUSHU CHARACTER-1B1F7;Lo;0;L;;;;;N;;;;;
+1B1F8;NUSHU CHARACTER-1B1F8;Lo;0;L;;;;;N;;;;;
+1B1F9;NUSHU CHARACTER-1B1F9;Lo;0;L;;;;;N;;;;;
+1B1FA;NUSHU CHARACTER-1B1FA;Lo;0;L;;;;;N;;;;;
+1B1FB;NUSHU CHARACTER-1B1FB;Lo;0;L;;;;;N;;;;;
+1B1FC;NUSHU CHARACTER-1B1FC;Lo;0;L;;;;;N;;;;;
+1B1FD;NUSHU CHARACTER-1B1FD;Lo;0;L;;;;;N;;;;;
+1B1FE;NUSHU CHARACTER-1B1FE;Lo;0;L;;;;;N;;;;;
+1B1FF;NUSHU CHARACTER-1B1FF;Lo;0;L;;;;;N;;;;;
+1B200;NUSHU CHARACTER-1B200;Lo;0;L;;;;;N;;;;;
+1B201;NUSHU CHARACTER-1B201;Lo;0;L;;;;;N;;;;;
+1B202;NUSHU CHARACTER-1B202;Lo;0;L;;;;;N;;;;;
+1B203;NUSHU CHARACTER-1B203;Lo;0;L;;;;;N;;;;;
+1B204;NUSHU CHARACTER-1B204;Lo;0;L;;;;;N;;;;;
+1B205;NUSHU CHARACTER-1B205;Lo;0;L;;;;;N;;;;;
+1B206;NUSHU CHARACTER-1B206;Lo;0;L;;;;;N;;;;;
+1B207;NUSHU CHARACTER-1B207;Lo;0;L;;;;;N;;;;;
+1B208;NUSHU CHARACTER-1B208;Lo;0;L;;;;;N;;;;;
+1B209;NUSHU CHARACTER-1B209;Lo;0;L;;;;;N;;;;;
+1B20A;NUSHU CHARACTER-1B20A;Lo;0;L;;;;;N;;;;;
+1B20B;NUSHU CHARACTER-1B20B;Lo;0;L;;;;;N;;;;;
+1B20C;NUSHU CHARACTER-1B20C;Lo;0;L;;;;;N;;;;;
+1B20D;NUSHU CHARACTER-1B20D;Lo;0;L;;;;;N;;;;;
+1B20E;NUSHU CHARACTER-1B20E;Lo;0;L;;;;;N;;;;;
+1B20F;NUSHU CHARACTER-1B20F;Lo;0;L;;;;;N;;;;;
+1B210;NUSHU CHARACTER-1B210;Lo;0;L;;;;;N;;;;;
+1B211;NUSHU CHARACTER-1B211;Lo;0;L;;;;;N;;;;;
+1B212;NUSHU CHARACTER-1B212;Lo;0;L;;;;;N;;;;;
+1B213;NUSHU CHARACTER-1B213;Lo;0;L;;;;;N;;;;;
+1B214;NUSHU CHARACTER-1B214;Lo;0;L;;;;;N;;;;;
+1B215;NUSHU CHARACTER-1B215;Lo;0;L;;;;;N;;;;;
+1B216;NUSHU CHARACTER-1B216;Lo;0;L;;;;;N;;;;;
+1B217;NUSHU CHARACTER-1B217;Lo;0;L;;;;;N;;;;;
+1B218;NUSHU CHARACTER-1B218;Lo;0;L;;;;;N;;;;;
+1B219;NUSHU CHARACTER-1B219;Lo;0;L;;;;;N;;;;;
+1B21A;NUSHU CHARACTER-1B21A;Lo;0;L;;;;;N;;;;;
+1B21B;NUSHU CHARACTER-1B21B;Lo;0;L;;;;;N;;;;;
+1B21C;NUSHU CHARACTER-1B21C;Lo;0;L;;;;;N;;;;;
+1B21D;NUSHU CHARACTER-1B21D;Lo;0;L;;;;;N;;;;;
+1B21E;NUSHU CHARACTER-1B21E;Lo;0;L;;;;;N;;;;;
+1B21F;NUSHU CHARACTER-1B21F;Lo;0;L;;;;;N;;;;;
+1B220;NUSHU CHARACTER-1B220;Lo;0;L;;;;;N;;;;;
+1B221;NUSHU CHARACTER-1B221;Lo;0;L;;;;;N;;;;;
+1B222;NUSHU CHARACTER-1B222;Lo;0;L;;;;;N;;;;;
+1B223;NUSHU CHARACTER-1B223;Lo;0;L;;;;;N;;;;;
+1B224;NUSHU CHARACTER-1B224;Lo;0;L;;;;;N;;;;;
+1B225;NUSHU CHARACTER-1B225;Lo;0;L;;;;;N;;;;;
+1B226;NUSHU CHARACTER-1B226;Lo;0;L;;;;;N;;;;;
+1B227;NUSHU CHARACTER-1B227;Lo;0;L;;;;;N;;;;;
+1B228;NUSHU CHARACTER-1B228;Lo;0;L;;;;;N;;;;;
+1B229;NUSHU CHARACTER-1B229;Lo;0;L;;;;;N;;;;;
+1B22A;NUSHU CHARACTER-1B22A;Lo;0;L;;;;;N;;;;;
+1B22B;NUSHU CHARACTER-1B22B;Lo;0;L;;;;;N;;;;;
+1B22C;NUSHU CHARACTER-1B22C;Lo;0;L;;;;;N;;;;;
+1B22D;NUSHU CHARACTER-1B22D;Lo;0;L;;;;;N;;;;;
+1B22E;NUSHU CHARACTER-1B22E;Lo;0;L;;;;;N;;;;;
+1B22F;NUSHU CHARACTER-1B22F;Lo;0;L;;;;;N;;;;;
+1B230;NUSHU CHARACTER-1B230;Lo;0;L;;;;;N;;;;;
+1B231;NUSHU CHARACTER-1B231;Lo;0;L;;;;;N;;;;;
+1B232;NUSHU CHARACTER-1B232;Lo;0;L;;;;;N;;;;;
+1B233;NUSHU CHARACTER-1B233;Lo;0;L;;;;;N;;;;;
+1B234;NUSHU CHARACTER-1B234;Lo;0;L;;;;;N;;;;;
+1B235;NUSHU CHARACTER-1B235;Lo;0;L;;;;;N;;;;;
+1B236;NUSHU CHARACTER-1B236;Lo;0;L;;;;;N;;;;;
+1B237;NUSHU CHARACTER-1B237;Lo;0;L;;;;;N;;;;;
+1B238;NUSHU CHARACTER-1B238;Lo;0;L;;;;;N;;;;;
+1B239;NUSHU CHARACTER-1B239;Lo;0;L;;;;;N;;;;;
+1B23A;NUSHU CHARACTER-1B23A;Lo;0;L;;;;;N;;;;;
+1B23B;NUSHU CHARACTER-1B23B;Lo;0;L;;;;;N;;;;;
+1B23C;NUSHU CHARACTER-1B23C;Lo;0;L;;;;;N;;;;;
+1B23D;NUSHU CHARACTER-1B23D;Lo;0;L;;;;;N;;;;;
+1B23E;NUSHU CHARACTER-1B23E;Lo;0;L;;;;;N;;;;;
+1B23F;NUSHU CHARACTER-1B23F;Lo;0;L;;;;;N;;;;;
+1B240;NUSHU CHARACTER-1B240;Lo;0;L;;;;;N;;;;;
+1B241;NUSHU CHARACTER-1B241;Lo;0;L;;;;;N;;;;;
+1B242;NUSHU CHARACTER-1B242;Lo;0;L;;;;;N;;;;;
+1B243;NUSHU CHARACTER-1B243;Lo;0;L;;;;;N;;;;;
+1B244;NUSHU CHARACTER-1B244;Lo;0;L;;;;;N;;;;;
+1B245;NUSHU CHARACTER-1B245;Lo;0;L;;;;;N;;;;;
+1B246;NUSHU CHARACTER-1B246;Lo;0;L;;;;;N;;;;;
+1B247;NUSHU CHARACTER-1B247;Lo;0;L;;;;;N;;;;;
+1B248;NUSHU CHARACTER-1B248;Lo;0;L;;;;;N;;;;;
+1B249;NUSHU CHARACTER-1B249;Lo;0;L;;;;;N;;;;;
+1B24A;NUSHU CHARACTER-1B24A;Lo;0;L;;;;;N;;;;;
+1B24B;NUSHU CHARACTER-1B24B;Lo;0;L;;;;;N;;;;;
+1B24C;NUSHU CHARACTER-1B24C;Lo;0;L;;;;;N;;;;;
+1B24D;NUSHU CHARACTER-1B24D;Lo;0;L;;;;;N;;;;;
+1B24E;NUSHU CHARACTER-1B24E;Lo;0;L;;;;;N;;;;;
+1B24F;NUSHU CHARACTER-1B24F;Lo;0;L;;;;;N;;;;;
+1B250;NUSHU CHARACTER-1B250;Lo;0;L;;;;;N;;;;;
+1B251;NUSHU CHARACTER-1B251;Lo;0;L;;;;;N;;;;;
+1B252;NUSHU CHARACTER-1B252;Lo;0;L;;;;;N;;;;;
+1B253;NUSHU CHARACTER-1B253;Lo;0;L;;;;;N;;;;;
+1B254;NUSHU CHARACTER-1B254;Lo;0;L;;;;;N;;;;;
+1B255;NUSHU CHARACTER-1B255;Lo;0;L;;;;;N;;;;;
+1B256;NUSHU CHARACTER-1B256;Lo;0;L;;;;;N;;;;;
+1B257;NUSHU CHARACTER-1B257;Lo;0;L;;;;;N;;;;;
+1B258;NUSHU CHARACTER-1B258;Lo;0;L;;;;;N;;;;;
+1B259;NUSHU CHARACTER-1B259;Lo;0;L;;;;;N;;;;;
+1B25A;NUSHU CHARACTER-1B25A;Lo;0;L;;;;;N;;;;;
+1B25B;NUSHU CHARACTER-1B25B;Lo;0;L;;;;;N;;;;;
+1B25C;NUSHU CHARACTER-1B25C;Lo;0;L;;;;;N;;;;;
+1B25D;NUSHU CHARACTER-1B25D;Lo;0;L;;;;;N;;;;;
+1B25E;NUSHU CHARACTER-1B25E;Lo;0;L;;;;;N;;;;;
+1B25F;NUSHU CHARACTER-1B25F;Lo;0;L;;;;;N;;;;;
+1B260;NUSHU CHARACTER-1B260;Lo;0;L;;;;;N;;;;;
+1B261;NUSHU CHARACTER-1B261;Lo;0;L;;;;;N;;;;;
+1B262;NUSHU CHARACTER-1B262;Lo;0;L;;;;;N;;;;;
+1B263;NUSHU CHARACTER-1B263;Lo;0;L;;;;;N;;;;;
+1B264;NUSHU CHARACTER-1B264;Lo;0;L;;;;;N;;;;;
+1B265;NUSHU CHARACTER-1B265;Lo;0;L;;;;;N;;;;;
+1B266;NUSHU CHARACTER-1B266;Lo;0;L;;;;;N;;;;;
+1B267;NUSHU CHARACTER-1B267;Lo;0;L;;;;;N;;;;;
+1B268;NUSHU CHARACTER-1B268;Lo;0;L;;;;;N;;;;;
+1B269;NUSHU CHARACTER-1B269;Lo;0;L;;;;;N;;;;;
+1B26A;NUSHU CHARACTER-1B26A;Lo;0;L;;;;;N;;;;;
+1B26B;NUSHU CHARACTER-1B26B;Lo;0;L;;;;;N;;;;;
+1B26C;NUSHU CHARACTER-1B26C;Lo;0;L;;;;;N;;;;;
+1B26D;NUSHU CHARACTER-1B26D;Lo;0;L;;;;;N;;;;;
+1B26E;NUSHU CHARACTER-1B26E;Lo;0;L;;;;;N;;;;;
+1B26F;NUSHU CHARACTER-1B26F;Lo;0;L;;;;;N;;;;;
+1B270;NUSHU CHARACTER-1B270;Lo;0;L;;;;;N;;;;;
+1B271;NUSHU CHARACTER-1B271;Lo;0;L;;;;;N;;;;;
+1B272;NUSHU CHARACTER-1B272;Lo;0;L;;;;;N;;;;;
+1B273;NUSHU CHARACTER-1B273;Lo;0;L;;;;;N;;;;;
+1B274;NUSHU CHARACTER-1B274;Lo;0;L;;;;;N;;;;;
+1B275;NUSHU CHARACTER-1B275;Lo;0;L;;;;;N;;;;;
+1B276;NUSHU CHARACTER-1B276;Lo;0;L;;;;;N;;;;;
+1B277;NUSHU CHARACTER-1B277;Lo;0;L;;;;;N;;;;;
+1B278;NUSHU CHARACTER-1B278;Lo;0;L;;;;;N;;;;;
+1B279;NUSHU CHARACTER-1B279;Lo;0;L;;;;;N;;;;;
+1B27A;NUSHU CHARACTER-1B27A;Lo;0;L;;;;;N;;;;;
+1B27B;NUSHU CHARACTER-1B27B;Lo;0;L;;;;;N;;;;;
+1B27C;NUSHU CHARACTER-1B27C;Lo;0;L;;;;;N;;;;;
+1B27D;NUSHU CHARACTER-1B27D;Lo;0;L;;;;;N;;;;;
+1B27E;NUSHU CHARACTER-1B27E;Lo;0;L;;;;;N;;;;;
+1B27F;NUSHU CHARACTER-1B27F;Lo;0;L;;;;;N;;;;;
+1B280;NUSHU CHARACTER-1B280;Lo;0;L;;;;;N;;;;;
+1B281;NUSHU CHARACTER-1B281;Lo;0;L;;;;;N;;;;;
+1B282;NUSHU CHARACTER-1B282;Lo;0;L;;;;;N;;;;;
+1B283;NUSHU CHARACTER-1B283;Lo;0;L;;;;;N;;;;;
+1B284;NUSHU CHARACTER-1B284;Lo;0;L;;;;;N;;;;;
+1B285;NUSHU CHARACTER-1B285;Lo;0;L;;;;;N;;;;;
+1B286;NUSHU CHARACTER-1B286;Lo;0;L;;;;;N;;;;;
+1B287;NUSHU CHARACTER-1B287;Lo;0;L;;;;;N;;;;;
+1B288;NUSHU CHARACTER-1B288;Lo;0;L;;;;;N;;;;;
+1B289;NUSHU CHARACTER-1B289;Lo;0;L;;;;;N;;;;;
+1B28A;NUSHU CHARACTER-1B28A;Lo;0;L;;;;;N;;;;;
+1B28B;NUSHU CHARACTER-1B28B;Lo;0;L;;;;;N;;;;;
+1B28C;NUSHU CHARACTER-1B28C;Lo;0;L;;;;;N;;;;;
+1B28D;NUSHU CHARACTER-1B28D;Lo;0;L;;;;;N;;;;;
+1B28E;NUSHU CHARACTER-1B28E;Lo;0;L;;;;;N;;;;;
+1B28F;NUSHU CHARACTER-1B28F;Lo;0;L;;;;;N;;;;;
+1B290;NUSHU CHARACTER-1B290;Lo;0;L;;;;;N;;;;;
+1B291;NUSHU CHARACTER-1B291;Lo;0;L;;;;;N;;;;;
+1B292;NUSHU CHARACTER-1B292;Lo;0;L;;;;;N;;;;;
+1B293;NUSHU CHARACTER-1B293;Lo;0;L;;;;;N;;;;;
+1B294;NUSHU CHARACTER-1B294;Lo;0;L;;;;;N;;;;;
+1B295;NUSHU CHARACTER-1B295;Lo;0;L;;;;;N;;;;;
+1B296;NUSHU CHARACTER-1B296;Lo;0;L;;;;;N;;;;;
+1B297;NUSHU CHARACTER-1B297;Lo;0;L;;;;;N;;;;;
+1B298;NUSHU CHARACTER-1B298;Lo;0;L;;;;;N;;;;;
+1B299;NUSHU CHARACTER-1B299;Lo;0;L;;;;;N;;;;;
+1B29A;NUSHU CHARACTER-1B29A;Lo;0;L;;;;;N;;;;;
+1B29B;NUSHU CHARACTER-1B29B;Lo;0;L;;;;;N;;;;;
+1B29C;NUSHU CHARACTER-1B29C;Lo;0;L;;;;;N;;;;;
+1B29D;NUSHU CHARACTER-1B29D;Lo;0;L;;;;;N;;;;;
+1B29E;NUSHU CHARACTER-1B29E;Lo;0;L;;;;;N;;;;;
+1B29F;NUSHU CHARACTER-1B29F;Lo;0;L;;;;;N;;;;;
+1B2A0;NUSHU CHARACTER-1B2A0;Lo;0;L;;;;;N;;;;;
+1B2A1;NUSHU CHARACTER-1B2A1;Lo;0;L;;;;;N;;;;;
+1B2A2;NUSHU CHARACTER-1B2A2;Lo;0;L;;;;;N;;;;;
+1B2A3;NUSHU CHARACTER-1B2A3;Lo;0;L;;;;;N;;;;;
+1B2A4;NUSHU CHARACTER-1B2A4;Lo;0;L;;;;;N;;;;;
+1B2A5;NUSHU CHARACTER-1B2A5;Lo;0;L;;;;;N;;;;;
+1B2A6;NUSHU CHARACTER-1B2A6;Lo;0;L;;;;;N;;;;;
+1B2A7;NUSHU CHARACTER-1B2A7;Lo;0;L;;;;;N;;;;;
+1B2A8;NUSHU CHARACTER-1B2A8;Lo;0;L;;;;;N;;;;;
+1B2A9;NUSHU CHARACTER-1B2A9;Lo;0;L;;;;;N;;;;;
+1B2AA;NUSHU CHARACTER-1B2AA;Lo;0;L;;;;;N;;;;;
+1B2AB;NUSHU CHARACTER-1B2AB;Lo;0;L;;;;;N;;;;;
+1B2AC;NUSHU CHARACTER-1B2AC;Lo;0;L;;;;;N;;;;;
+1B2AD;NUSHU CHARACTER-1B2AD;Lo;0;L;;;;;N;;;;;
+1B2AE;NUSHU CHARACTER-1B2AE;Lo;0;L;;;;;N;;;;;
+1B2AF;NUSHU CHARACTER-1B2AF;Lo;0;L;;;;;N;;;;;
+1B2B0;NUSHU CHARACTER-1B2B0;Lo;0;L;;;;;N;;;;;
+1B2B1;NUSHU CHARACTER-1B2B1;Lo;0;L;;;;;N;;;;;
+1B2B2;NUSHU CHARACTER-1B2B2;Lo;0;L;;;;;N;;;;;
+1B2B3;NUSHU CHARACTER-1B2B3;Lo;0;L;;;;;N;;;;;
+1B2B4;NUSHU CHARACTER-1B2B4;Lo;0;L;;;;;N;;;;;
+1B2B5;NUSHU CHARACTER-1B2B5;Lo;0;L;;;;;N;;;;;
+1B2B6;NUSHU CHARACTER-1B2B6;Lo;0;L;;;;;N;;;;;
+1B2B7;NUSHU CHARACTER-1B2B7;Lo;0;L;;;;;N;;;;;
+1B2B8;NUSHU CHARACTER-1B2B8;Lo;0;L;;;;;N;;;;;
+1B2B9;NUSHU CHARACTER-1B2B9;Lo;0;L;;;;;N;;;;;
+1B2BA;NUSHU CHARACTER-1B2BA;Lo;0;L;;;;;N;;;;;
+1B2BB;NUSHU CHARACTER-1B2BB;Lo;0;L;;;;;N;;;;;
+1B2BC;NUSHU CHARACTER-1B2BC;Lo;0;L;;;;;N;;;;;
+1B2BD;NUSHU CHARACTER-1B2BD;Lo;0;L;;;;;N;;;;;
+1B2BE;NUSHU CHARACTER-1B2BE;Lo;0;L;;;;;N;;;;;
+1B2BF;NUSHU CHARACTER-1B2BF;Lo;0;L;;;;;N;;;;;
+1B2C0;NUSHU CHARACTER-1B2C0;Lo;0;L;;;;;N;;;;;
+1B2C1;NUSHU CHARACTER-1B2C1;Lo;0;L;;;;;N;;;;;
+1B2C2;NUSHU CHARACTER-1B2C2;Lo;0;L;;;;;N;;;;;
+1B2C3;NUSHU CHARACTER-1B2C3;Lo;0;L;;;;;N;;;;;
+1B2C4;NUSHU CHARACTER-1B2C4;Lo;0;L;;;;;N;;;;;
+1B2C5;NUSHU CHARACTER-1B2C5;Lo;0;L;;;;;N;;;;;
+1B2C6;NUSHU CHARACTER-1B2C6;Lo;0;L;;;;;N;;;;;
+1B2C7;NUSHU CHARACTER-1B2C7;Lo;0;L;;;;;N;;;;;
+1B2C8;NUSHU CHARACTER-1B2C8;Lo;0;L;;;;;N;;;;;
+1B2C9;NUSHU CHARACTER-1B2C9;Lo;0;L;;;;;N;;;;;
+1B2CA;NUSHU CHARACTER-1B2CA;Lo;0;L;;;;;N;;;;;
+1B2CB;NUSHU CHARACTER-1B2CB;Lo;0;L;;;;;N;;;;;
+1B2CC;NUSHU CHARACTER-1B2CC;Lo;0;L;;;;;N;;;;;
+1B2CD;NUSHU CHARACTER-1B2CD;Lo;0;L;;;;;N;;;;;
+1B2CE;NUSHU CHARACTER-1B2CE;Lo;0;L;;;;;N;;;;;
+1B2CF;NUSHU CHARACTER-1B2CF;Lo;0;L;;;;;N;;;;;
+1B2D0;NUSHU CHARACTER-1B2D0;Lo;0;L;;;;;N;;;;;
+1B2D1;NUSHU CHARACTER-1B2D1;Lo;0;L;;;;;N;;;;;
+1B2D2;NUSHU CHARACTER-1B2D2;Lo;0;L;;;;;N;;;;;
+1B2D3;NUSHU CHARACTER-1B2D3;Lo;0;L;;;;;N;;;;;
+1B2D4;NUSHU CHARACTER-1B2D4;Lo;0;L;;;;;N;;;;;
+1B2D5;NUSHU CHARACTER-1B2D5;Lo;0;L;;;;;N;;;;;
+1B2D6;NUSHU CHARACTER-1B2D6;Lo;0;L;;;;;N;;;;;
+1B2D7;NUSHU CHARACTER-1B2D7;Lo;0;L;;;;;N;;;;;
+1B2D8;NUSHU CHARACTER-1B2D8;Lo;0;L;;;;;N;;;;;
+1B2D9;NUSHU CHARACTER-1B2D9;Lo;0;L;;;;;N;;;;;
+1B2DA;NUSHU CHARACTER-1B2DA;Lo;0;L;;;;;N;;;;;
+1B2DB;NUSHU CHARACTER-1B2DB;Lo;0;L;;;;;N;;;;;
+1B2DC;NUSHU CHARACTER-1B2DC;Lo;0;L;;;;;N;;;;;
+1B2DD;NUSHU CHARACTER-1B2DD;Lo;0;L;;;;;N;;;;;
+1B2DE;NUSHU CHARACTER-1B2DE;Lo;0;L;;;;;N;;;;;
+1B2DF;NUSHU CHARACTER-1B2DF;Lo;0;L;;;;;N;;;;;
+1B2E0;NUSHU CHARACTER-1B2E0;Lo;0;L;;;;;N;;;;;
+1B2E1;NUSHU CHARACTER-1B2E1;Lo;0;L;;;;;N;;;;;
+1B2E2;NUSHU CHARACTER-1B2E2;Lo;0;L;;;;;N;;;;;
+1B2E3;NUSHU CHARACTER-1B2E3;Lo;0;L;;;;;N;;;;;
+1B2E4;NUSHU CHARACTER-1B2E4;Lo;0;L;;;;;N;;;;;
+1B2E5;NUSHU CHARACTER-1B2E5;Lo;0;L;;;;;N;;;;;
+1B2E6;NUSHU CHARACTER-1B2E6;Lo;0;L;;;;;N;;;;;
+1B2E7;NUSHU CHARACTER-1B2E7;Lo;0;L;;;;;N;;;;;
+1B2E8;NUSHU CHARACTER-1B2E8;Lo;0;L;;;;;N;;;;;
+1B2E9;NUSHU CHARACTER-1B2E9;Lo;0;L;;;;;N;;;;;
+1B2EA;NUSHU CHARACTER-1B2EA;Lo;0;L;;;;;N;;;;;
+1B2EB;NUSHU CHARACTER-1B2EB;Lo;0;L;;;;;N;;;;;
+1B2EC;NUSHU CHARACTER-1B2EC;Lo;0;L;;;;;N;;;;;
+1B2ED;NUSHU CHARACTER-1B2ED;Lo;0;L;;;;;N;;;;;
+1B2EE;NUSHU CHARACTER-1B2EE;Lo;0;L;;;;;N;;;;;
+1B2EF;NUSHU CHARACTER-1B2EF;Lo;0;L;;;;;N;;;;;
+1B2F0;NUSHU CHARACTER-1B2F0;Lo;0;L;;;;;N;;;;;
+1B2F1;NUSHU CHARACTER-1B2F1;Lo;0;L;;;;;N;;;;;
+1B2F2;NUSHU CHARACTER-1B2F2;Lo;0;L;;;;;N;;;;;
+1B2F3;NUSHU CHARACTER-1B2F3;Lo;0;L;;;;;N;;;;;
+1B2F4;NUSHU CHARACTER-1B2F4;Lo;0;L;;;;;N;;;;;
+1B2F5;NUSHU CHARACTER-1B2F5;Lo;0;L;;;;;N;;;;;
+1B2F6;NUSHU CHARACTER-1B2F6;Lo;0;L;;;;;N;;;;;
+1B2F7;NUSHU CHARACTER-1B2F7;Lo;0;L;;;;;N;;;;;
+1B2F8;NUSHU CHARACTER-1B2F8;Lo;0;L;;;;;N;;;;;
+1B2F9;NUSHU CHARACTER-1B2F9;Lo;0;L;;;;;N;;;;;
+1B2FA;NUSHU CHARACTER-1B2FA;Lo;0;L;;;;;N;;;;;
+1B2FB;NUSHU CHARACTER-1B2FB;Lo;0;L;;;;;N;;;;;
1BC00;DUPLOYAN LETTER H;Lo;0;L;;;;;N;;;;;
1BC01;DUPLOYAN LETTER X;Lo;0;L;;;;;N;;;;;
1BC02;DUPLOYAN LETTER P;Lo;0;L;;;;;N;;;;;
@@ -28269,6 +29217,12 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F248;TORTOISE SHELL BRACKETED CJK UNIFIED IDEOGRAPH-6557;So;0;L;<compat> 3014 6557 3015;;;;N;;;;;
1F250;CIRCLED IDEOGRAPH ADVANTAGE;So;0;L;<circle> 5F97;;;;N;;;;;
1F251;CIRCLED IDEOGRAPH ACCEPT;So;0;L;<circle> 53EF;;;;N;;;;;
+1F260;ROUNDED SYMBOL FOR FU;So;0;ON;;;;;N;;;;;
+1F261;ROUNDED SYMBOL FOR LU;So;0;ON;;;;;N;;;;;
+1F262;ROUNDED SYMBOL FOR SHOU;So;0;ON;;;;;N;;;;;
+1F263;ROUNDED SYMBOL FOR XI;So;0;ON;;;;;N;;;;;
+1F264;ROUNDED SYMBOL FOR SHUANGXI;So;0;ON;;;;;N;;;;;
+1F265;ROUNDED SYMBOL FOR CAI;So;0;ON;;;;;N;;;;;
1F300;CYCLONE;So;0;ON;;;;;N;;;;;
1F301;FOGGY;So;0;ON;;;;;N;;;;;
1F302;CLOSED UMBRELLA;So;0;ON;;;;;N;;;;;
@@ -29248,6 +30202,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F6D0;PLACE OF WORSHIP;So;0;ON;;;;;N;;;;;
1F6D1;OCTAGONAL SIGN;So;0;ON;;;;;N;;;;;
1F6D2;SHOPPING TROLLEY;So;0;ON;;;;;N;;;;;
+1F6D3;STUPA;So;0;ON;;;;;N;;;;;
+1F6D4;PAGODA;So;0;ON;;;;;N;;;;;
1F6E0;HAMMER AND WRENCH;So;0;ON;;;;;N;;;;;
1F6E1;SHIELD;So;0;ON;;;;;N;;;;;
1F6E2;OIL DRUM;So;0;ON;;;;;N;;;;;
@@ -29268,6 +30224,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F6F4;SCOOTER;So;0;ON;;;;;N;;;;;
1F6F5;MOTOR SCOOTER;So;0;ON;;;;;N;;;;;
1F6F6;CANOE;So;0;ON;;;;;N;;;;;
+1F6F7;SLED;So;0;ON;;;;;N;;;;;
+1F6F8;FLYING SAUCER;So;0;ON;;;;;N;;;;;
1F700;ALCHEMICAL SYMBOL FOR QUINTESSENCE;So;0;ON;;;;;N;;;;;
1F701;ALCHEMICAL SYMBOL FOR AIR;So;0;ON;;;;;N;;;;;
1F702;ALCHEMICAL SYMBOL FOR FIRE;So;0;ON;;;;;N;;;;;
@@ -29617,6 +30575,18 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F8AB;RIGHTWARDS FRONT-TILTED SHADOWED WHITE ARROW;So;0;ON;;;;;N;;;;;
1F8AC;WHITE ARROW SHAFT WIDTH ONE;So;0;ON;;;;;N;;;;;
1F8AD;WHITE ARROW SHAFT WIDTH TWO THIRDS;So;0;ON;;;;;N;;;;;
+1F900;CIRCLED CROSS FORMEE WITH FOUR DOTS;So;0;ON;;;;;N;;;;;
+1F901;CIRCLED CROSS FORMEE WITH TWO DOTS;So;0;ON;;;;;N;;;;;
+1F902;CIRCLED CROSS FORMEE;So;0;ON;;;;;N;;;;;
+1F903;LEFT HALF CIRCLE WITH FOUR DOTS;So;0;ON;;;;;N;;;;;
+1F904;LEFT HALF CIRCLE WITH THREE DOTS;So;0;ON;;;;;N;;;;;
+1F905;LEFT HALF CIRCLE WITH TWO DOTS;So;0;ON;;;;;N;;;;;
+1F906;LEFT HALF CIRCLE WITH DOT;So;0;ON;;;;;N;;;;;
+1F907;LEFT HALF CIRCLE;So;0;ON;;;;;N;;;;;
+1F908;DOWNWARD FACING HOOK;So;0;ON;;;;;N;;;;;
+1F909;DOWNWARD FACING NOTCHED HOOK;So;0;ON;;;;;N;;;;;
+1F90A;DOWNWARD FACING HOOK WITH DOT;So;0;ON;;;;;N;;;;;
+1F90B;DOWNWARD FACING NOTCHED HOOK WITH DOT;So;0;ON;;;;;N;;;;;
1F910;ZIPPER-MOUTH FACE;So;0;ON;;;;;N;;;;;
1F911;MONEY-MOUTH FACE;So;0;ON;;;;;N;;;;;
1F912;FACE WITH THERMOMETER;So;0;ON;;;;;N;;;;;
@@ -29632,6 +30602,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F91C;RIGHT-FACING FIST;So;0;ON;;;;;N;;;;;
1F91D;HANDSHAKE;So;0;ON;;;;;N;;;;;
1F91E;HAND WITH INDEX AND MIDDLE FINGERS CROSSED;So;0;ON;;;;;N;;;;;
+1F91F;I LOVE YOU HAND SIGN;So;0;ON;;;;;N;;;;;
1F920;FACE WITH COWBOY HAT;So;0;ON;;;;;N;;;;;
1F921;CLOWN FACE;So;0;ON;;;;;N;;;;;
1F922;NAUSEATED FACE;So;0;ON;;;;;N;;;;;
@@ -29640,7 +30611,17 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F925;LYING FACE;So;0;ON;;;;;N;;;;;
1F926;FACE PALM;So;0;ON;;;;;N;;;;;
1F927;SNEEZING FACE;So;0;ON;;;;;N;;;;;
+1F928;FACE WITH ONE EYEBROW RAISED;So;0;ON;;;;;N;;;;;
+1F929;GRINNING FACE WITH STAR EYES;So;0;ON;;;;;N;;;;;
+1F92A;GRINNING FACE WITH ONE LARGE AND ONE SMALL EYE;So;0;ON;;;;;N;;;;;
+1F92B;FACE WITH FINGER COVERING CLOSED LIPS;So;0;ON;;;;;N;;;;;
+1F92C;SERIOUS FACE WITH SYMBOLS COVERING MOUTH;So;0;ON;;;;;N;;;;;
+1F92D;SMILING FACE WITH SMILING EYES AND HAND COVERING MOUTH;So;0;ON;;;;;N;;;;;
+1F92E;FACE WITH OPEN MOUTH VOMITING;So;0;ON;;;;;N;;;;;
+1F92F;SHOCKED FACE WITH EXPLODING HEAD;So;0;ON;;;;;N;;;;;
1F930;PREGNANT WOMAN;So;0;ON;;;;;N;;;;;
+1F931;BREAST-FEEDING;So;0;ON;;;;;N;;;;;
+1F932;PALMS UP TOGETHER;So;0;ON;;;;;N;;;;;
1F933;SELFIE;So;0;ON;;;;;N;;;;;
1F934;PRINCE;So;0;ON;;;;;N;;;;;
1F935;MAN IN TUXEDO;So;0;ON;;;;;N;;;;;
@@ -29665,6 +30646,7 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F949;THIRD PLACE MEDAL;So;0;ON;;;;;N;;;;;
1F94A;BOXING GLOVE;So;0;ON;;;;;N;;;;;
1F94B;MARTIAL ARTS UNIFORM;So;0;ON;;;;;N;;;;;
+1F94C;CURLING STONE;So;0;ON;;;;;N;;;;;
1F950;CROISSANT;So;0;ON;;;;;N;;;;;
1F951;AVOCADO;So;0;ON;;;;;N;;;;;
1F952;CUCUMBER;So;0;ON;;;;;N;;;;;
@@ -29680,6 +30662,19 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F95C;PEANUTS;So;0;ON;;;;;N;;;;;
1F95D;KIWIFRUIT;So;0;ON;;;;;N;;;;;
1F95E;PANCAKES;So;0;ON;;;;;N;;;;;
+1F95F;DUMPLING;So;0;ON;;;;;N;;;;;
+1F960;FORTUNE COOKIE;So;0;ON;;;;;N;;;;;
+1F961;TAKEOUT BOX;So;0;ON;;;;;N;;;;;
+1F962;CHOPSTICKS;So;0;ON;;;;;N;;;;;
+1F963;BOWL WITH SPOON;So;0;ON;;;;;N;;;;;
+1F964;CUP WITH STRAW;So;0;ON;;;;;N;;;;;
+1F965;COCONUT;So;0;ON;;;;;N;;;;;
+1F966;BROCCOLI;So;0;ON;;;;;N;;;;;
+1F967;PIE;So;0;ON;;;;;N;;;;;
+1F968;PRETZEL;So;0;ON;;;;;N;;;;;
+1F969;CUT OF MEAT;So;0;ON;;;;;N;;;;;
+1F96A;SANDWICH;So;0;ON;;;;;N;;;;;
+1F96B;CANNED FOOD;So;0;ON;;;;;N;;;;;
1F980;CRAB;So;0;ON;;;;;N;;;;;
1F981;LION FACE;So;0;ON;;;;;N;;;;;
1F982;SCORPION;So;0;ON;;;;;N;;;;;
@@ -29698,7 +30693,36 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
1F98F;RHINOCEROS;So;0;ON;;;;;N;;;;;
1F990;SHRIMP;So;0;ON;;;;;N;;;;;
1F991;SQUID;So;0;ON;;;;;N;;;;;
+1F992;GIRAFFE FACE;So;0;ON;;;;;N;;;;;
+1F993;ZEBRA FACE;So;0;ON;;;;;N;;;;;
+1F994;HEDGEHOG;So;0;ON;;;;;N;;;;;
+1F995;SAUROPOD;So;0;ON;;;;;N;;;;;
+1F996;T-REX;So;0;ON;;;;;N;;;;;
+1F997;CRICKET;So;0;ON;;;;;N;;;;;
1F9C0;CHEESE WEDGE;So;0;ON;;;;;N;;;;;
+1F9D0;FACE WITH MONOCLE;So;0;ON;;;;;N;;;;;
+1F9D1;ADULT;So;0;ON;;;;;N;;;;;
+1F9D2;CHILD;So;0;ON;;;;;N;;;;;
+1F9D3;OLDER ADULT;So;0;ON;;;;;N;;;;;
+1F9D4;BEARDED PERSON;So;0;ON;;;;;N;;;;;
+1F9D5;PERSON WITH HEADSCARF;So;0;ON;;;;;N;;;;;
+1F9D6;PERSON IN STEAMY ROOM;So;0;ON;;;;;N;;;;;
+1F9D7;PERSON CLIMBING;So;0;ON;;;;;N;;;;;
+1F9D8;PERSON IN LOTUS POSITION;So;0;ON;;;;;N;;;;;
+1F9D9;MAGE;So;0;ON;;;;;N;;;;;
+1F9DA;FAIRY;So;0;ON;;;;;N;;;;;
+1F9DB;VAMPIRE;So;0;ON;;;;;N;;;;;
+1F9DC;MERPERSON;So;0;ON;;;;;N;;;;;
+1F9DD;ELF;So;0;ON;;;;;N;;;;;
+1F9DE;GENIE;So;0;ON;;;;;N;;;;;
+1F9DF;ZOMBIE;So;0;ON;;;;;N;;;;;
+1F9E0;BRAIN;So;0;ON;;;;;N;;;;;
+1F9E1;ORANGE HEART;So;0;ON;;;;;N;;;;;
+1F9E2;BILLED CAP;So;0;ON;;;;;N;;;;;
+1F9E3;SCARF;So;0;ON;;;;;N;;;;;
+1F9E4;GLOVES;So;0;ON;;;;;N;;;;;
+1F9E5;COAT;So;0;ON;;;;;N;;;;;
+1F9E6;SOCKS;So;0;ON;;;;;N;;;;;
20000;<CJK Ideograph Extension B, First>;Lo;0;L;;;;;N;;;;;
2A6D6;<CJK Ideograph Extension B, Last>;Lo;0;L;;;;;N;;;;;
2A700;<CJK Ideograph Extension C, First>;Lo;0;L;;;;;N;;;;;
@@ -29707,6 +30731,8 @@ FFFD;REPLACEMENT CHARACTER;So;0;ON;;;;;N;;;;;
2B81D;<CJK Ideograph Extension D, Last>;Lo;0;L;;;;;N;;;;;
2B820;<CJK Ideograph Extension E, First>;Lo;0;L;;;;;N;;;;;
2CEA1;<CJK Ideograph Extension E, Last>;Lo;0;L;;;;;N;;;;;
+2CEB0;<CJK Ideograph Extension F, First>;Lo;0;L;;;;;N;;;;;
+2EBE0;<CJK Ideograph Extension F, Last>;Lo;0;L;;;;;N;;;;;
2F800;CJK COMPATIBILITY IDEOGRAPH-2F800;Lo;0;L;4E3D;;;;N;;;;;
2F801;CJK COMPATIBILITY IDEOGRAPH-2F801;Lo;0;L;4E38;;;;N;;;;;
2F802;CJK COMPATIBILITY IDEOGRAPH-2F802;Lo;0;L;4E41;;;;N;;;;;
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 7845d02cdc8..8eafedb82c2 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -17,7 +17,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
@@ -32,7 +32,7 @@
## The Unicode blocks actually extend past some of these ranges with
## undefined codepoints.
-## For additional details, see <http://debbugs.gnu.org/20789#11>.
+## For additional details, see <https://debbugs.gnu.org/20789#11>.
## Things to do after installing a new version of Blocks.txt:
## Check the output against the old output.
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index e1e896ce29c..e6e8aaa0954 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1346,50 +1346,56 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
(generator (unidata-prop-generator proplist))
(default-value (unidata-prop-default proplist))
(val-list (unidata-prop-val-list proplist))
- (table (progn
- (message "Generating %S table..." prop)
- (funcall generator prop index default-value val-list)))
- (decoder (char-table-extra-slot table 1))
- (alist (and (functionp index)
- (funcall index)))
- (check #x400))
- (dolist (e unidata-list)
- (let* ((char (car e))
- (val1
- (if alist (nth 1 (assoc char alist))
- (nth index e)))
- val2)
- (if (and (stringp val1) (= (length val1) 0))
- (setq val1 nil))
- (unless (or (consp char)
- (integerp decoder))
- (setq val2
- (cond ((functionp decoder)
- (funcall decoder char (aref table char) table))
- (t ; must be nil
- (aref table char))))
- (if val1
- (cond ((eq generator 'unidata-gen-table-symbol)
- (setq val1 (intern val1)))
- ((eq generator 'unidata-gen-table-integer)
- (setq val1 (string-to-number val1)))
- ((eq generator 'unidata-gen-table-character)
- (setq val1 (string-to-number val1 16)))
- ((eq generator 'unidata-gen-table-decomposition)
- (setq val1 (unidata-split-decomposition val1))))
- (cond ((eq prop 'decomposition)
- (setq val1 (list char)))
- ((eq prop 'bracket-type)
- (setq val1 'n))))
- (when (>= char check)
- (message "%S %04X" prop check)
- (setq check (+ check #x400)))
- (or (equal val1 val2)
- ;; <control> characters get a 'name' property of nil
- (and (eq prop 'name) (string= val1 "<control>") (null val2))
- (insert (format "> %04X %S\n< %04X %S\n"
- char val1 char val2)))
- (sit-for 0))))))))
+ (check #x400)
+ table decoder alist)
+ ;; We compare values in unidata.txt with the ones returned by various
+ ;; generator functions. However, SpecialCasing.txt is read directly by
+ ;; unidata-gen-table-special-casing--do-load and there is no other file
+ ;; to compare those values with. This is why we’re skipping the check
+ ;; for special casing properties.
+ (unless (eq generator 'unidata-gen-table-special-casing)
+ (setq table (progn
+ (message "Generating %S table..." prop)
+ (funcall generator prop index default-value val-list))
+ decoder (char-table-extra-slot table 1))
+ (unless (integerp decoder)
+ (setq alist (and (functionp index) (funcall index)))
+ (dolist (e unidata-list)
+ (let ((char (car e)) val1 val2)
+ (unless (consp char)
+ (setq val1 (if alist
+ (nth 1 (assoc char alist))
+ (nth index e)))
+ (and (stringp val1)
+ (= (length val1) 0)
+ (setq val1 nil))
+ (if val1
+ (cond ((eq generator 'unidata-gen-table-symbol)
+ (setq val1 (intern val1)))
+ ((eq generator 'unidata-gen-table-integer)
+ (setq val1 (string-to-number val1)))
+ ((eq generator 'unidata-gen-table-character)
+ (setq val1 (string-to-number val1 16)))
+ ((eq generator 'unidata-gen-table-decomposition)
+ (setq val1 (unidata-split-decomposition val1))))
+ (cond ((eq prop 'decomposition)
+ (setq val1 (list char)))
+ ((eq prop 'bracket-type)
+ (setq val1 'n))))
+ (setq val2 (aref table char))
+ (when decoder
+ (setq val2 (funcall decoder char val2 table)))
+ (when (>= char check)
+ (message "%S %04X" prop check)
+ (setq check (+ check #x400)))
+ (or (equal val1 val2)
+ ;; <control> characters get a 'name' property of nil
+ (and (eq prop 'name)
+ (string= val1 "<control>")
+ (null val2))
+ (insert (format "> %04X %S\n< %04X %S\n"
+ char val1 char val2)))
+ (sit-for 0))))))))))
;; The entry functions. They generate files described in the header
;; comment of this file.
diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el
index 0b7edc73c8c..f254f4a3666 100644
--- a/admin/unidata/uvs.el
+++ b/admin/unidata/uvs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/admin/update-copyright b/admin/update-copyright
index 4da327bd9c3..a068816e304 100755
--- a/admin/update-copyright
+++ b/admin/update-copyright
@@ -22,7 +22,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# written by Paul Eggert
diff --git a/admin/update_autogen b/admin/update_autogen
index ba4ed00fa39..cfbb7c77a79 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -18,7 +18,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/autogen.sh b/autogen.sh
index 0153f896a17..00bdfb91d44 100755
--- a/autogen.sh
+++ b/autogen.sh
@@ -19,7 +19,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
@@ -45,8 +45,8 @@ autoconf_min=`sed -n 's/^ *AC_PREREQ(\([0-9\.]*\)).*/\1/p' configure.ac`
## Also note that we do not handle micro versions.
get_version ()
{
- ## Remove eg "./autogen.sh: line 50: autoconf: command not found".
- $1 --version 2>&1 | sed -e '/not found/d' -e 's/.* //' -n -e '1 s/\([0-9][0-9\.]*\).*/\1/p'
+ vers=`($1 --version) 2> /dev/null` && expr "$vers" : '[^
+]* \([0-9][0-9.]*\).*'
}
## $1 = version string, eg "2.59"
@@ -82,9 +82,8 @@ check_version ()
printf '%s' "(using $uprog0=$uprog) "
fi
- have_version=`get_version $uprog`
-
- [ x"$have_version" = x ] && return 1
+ command -v $uprog > /dev/null || return 1
+ have_version=`get_version $uprog` || return 4
have_maj=`major_version $have_version`
need_maj=`major_version $2`
@@ -116,7 +115,7 @@ for arg; do
do_check=false;;
all)
do_autoconf=true
- test -e .git && do_git=true;;
+ test -r .git && do_git=true;;
autoconf)
do_autoconf=true;;
git)
@@ -128,7 +127,8 @@ done
case $do_autoconf,$do_git in
false,false)
- do_autoconf=true;;
+ do_autoconf=true
+ test -r .git && do_git=true;;
esac
# Generate Autoconf-related files, if requested.
@@ -158,6 +158,7 @@ if $do_autoconf; then
0) stat="ok" ;;
1) stat="missing" ;;
2) stat="too old" ;;
+ 4) stat="broken?" ;;
*) stat="unable to check" ;;
esac
@@ -209,7 +210,7 @@ If you do not have permission to do this, or if the version provided
by your system is too old, it is normally straightforward to build
these packages from source. You can find the sources at:
-ftp://ftp.gnu.org/gnu/PACKAGE/
+https://ftp.gnu.org/gnu/PACKAGE/
Download the package (make sure you get at least the minimum version
listed above), extract it using tar, then run configure, make,
@@ -268,23 +269,23 @@ fi
git_config ()
{
+ $do_git || return
+
name=$1
value=$2
ovalue=`git config --get "$name"` && test "$ovalue" = "$value" || {
- if $do_git; then
- if $git_was_ok; then
- echo 'Configuring local git repository...'
- case $cp_options in
- --backup=*)
- config=$git_common_dir/config
- cp $cp_options --force -- "$config" "$config" || exit;;
- esac
- fi
- echo "git config $name '$value'"
- git config "$name" "$value" || exit
- fi
- git_was_ok=false
+ if $git_was_ok; then
+ echo 'Configuring local git repository...'
+ case $cp_options in
+ --backup=*)
+ config=$git_common_dir/config
+ cp $cp_options --force -- "$config" "$config" || exit;;
+ esac
+ fi
+ echo "git config $name '$value'"
+ git config "$name" "$value" || exit
+ git_was_ok=false
}
}
@@ -293,7 +294,7 @@ git_config ()
# Get location of Git's common configuration directory. For older Git
# versions this is just '.git'. Newer Git versions support worktrees.
-{ test -e .git &&
+{ test -r .git &&
git_common_dir=`git rev-parse --no-flags --git-common-dir 2>/dev/null` &&
test -n "$git_common_dir"
} || git_common_dir=.git
@@ -326,8 +327,21 @@ for hook in commit-msg pre-commit; do
cmp -- build-aux/git-hooks/$hook "$hooks/$hook" >/dev/null 2>&1 ||
tailored_hooks="$tailored_hooks $hook"
done
+
+git_sample_hook_src ()
+{
+ hook=$1
+ src=$hooks/$hook.sample
+ if test ! -r "$src"; then
+ case $hook in
+ applypatch-msg) src=build-aux/git-hooks/commit-msg;;
+ pre-applypatch) src=build-aux/git-hooks/pre-commit;;
+ esac
+ fi
+}
for hook in applypatch-msg pre-applypatch; do
- cmp -- "$hooks/$hook.sample" "$hooks/$hook" >/dev/null 2>&1 ||
+ git_sample_hook_src $hook
+ cmp -- "$src" "$hooks/$hook" >/dev/null 2>&1 ||
sample_hooks="$sample_hooks $hook"
done
@@ -335,6 +349,11 @@ if test -n "$tailored_hooks$sample_hooks"; then
if $do_git; then
echo "Installing git hooks..."
+ if test ! -d "$hooks"; then
+ printf "mkdir -p -- '%s'\\n" "$hooks"
+ mkdir -p -- "$hooks" || exit
+ fi
+
if test -n "$tailored_hooks"; then
for hook in $tailored_hooks; do
dst=$hooks/$hook
@@ -345,8 +364,9 @@ if test -n "$tailored_hooks$sample_hooks"; then
if test -n "$sample_hooks"; then
for hook in $sample_hooks; do
+ git_sample_hook_src $hook
dst=$hooks/$hook
- cp $cp_options -- "$dst.sample" "$dst" || exit
+ cp $cp_options -- "$src" "$dst" || exit
chmod -- a-w "$dst" || exit
done
fi
@@ -357,7 +377,7 @@ fi
if test ! -f configure; then
echo "You can now run '$0 autoconf'."
-elif test -e .git && test $git_was_ok = false && test $do_git = false; then
+elif test -r .git && test $git_was_ok = false && test $do_git = false; then
echo "You can now run '$0 git'."
elif test ! -f config.status ||
test -n "`find configure src/config.in -newer config.status`"; then
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 2193702b12a..31e01efec3e 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -2,7 +2,7 @@
# Attempt to guess a canonical system name.
# Copyright 1992-2017 Free Software Foundation, Inc.
-timestamp='2017-05-27'
+timestamp='2017-11-07'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -15,7 +15,7 @@ timestamp='2017-05-27'
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this program; if not, see <http://www.gnu.org/licenses/>.
+# along with this program; if not, see <https://www.gnu.org/licenses/>.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
@@ -27,7 +27,7 @@ timestamp='2017-05-27'
# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
#
# You can get the latest version of this script from:
-# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
#
# Please send patches to <config-patches@gnu.org>.
@@ -39,7 +39,7 @@ Usage: $0 [OPTION]
Output the configuration name of the system \`$me' is run on.
-Operation modes:
+Options:
-h, --help print this help, then exit
-t, --time-stamp print date of last modification, then exit
-v, --version print version number, then exit
@@ -244,6 +244,9 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'`
echo ${UNAME_MACHINE_ARCH}-unknown-libertybsd${UNAME_RELEASE}
exit ;;
+ *:MidnightBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-midnightbsd${UNAME_RELEASE}
+ exit ;;
*:ekkoBSD:*:*)
echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE}
exit ;;
@@ -259,6 +262,9 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
*:Sortix:*:*)
echo ${UNAME_MACHINE}-unknown-sortix
exit ;;
+ *:Redox:*:*)
+ echo ${UNAME_MACHINE}-unknown-redox
+ exit ;;
alpha:OSF1:*:*)
case $UNAME_RELEASE in
*4.0)
@@ -315,15 +321,6 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
exitcode=$?
trap '' 0
exit $exitcode ;;
- Alpha\ *:Windows_NT*:*)
- # How do we know it's Interix rather than the generic POSIX subsystem?
- # Should we change UNAME_MACHINE based on the output of uname instead
- # of the specific Alpha model?
- echo alpha-pc-interix
- exit ;;
- 21064:Windows_NT:50:3)
- echo alpha-dec-winnt3.5
- exit ;;
Amiga*:UNIX_System_V:4.0:*)
echo m68k-unknown-sysv4
exit ;;
@@ -485,13 +482,13 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
#endif
#if defined (host_mips) && defined (MIPSEB)
#if defined (SYSTYPE_SYSV)
- printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
+ printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0);
#endif
#if defined (SYSTYPE_SVR4)
- printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
+ printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0);
#endif
#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
- printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
+ printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0);
#endif
#endif
exit (-1);
@@ -614,7 +611,7 @@ EOF
*:AIX:*:*)
echo rs6000-ibm-aix
exit ;;
- ibmrt:4.4BSD:*|romp-ibm:BSD:*)
+ ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*)
echo romp-ibm-bsd4.4
exit ;;
ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and
@@ -635,8 +632,8 @@ EOF
9000/[34678]??:HP-UX:*:*)
HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
case "${UNAME_MACHINE}" in
- 9000/31? ) HP_ARCH=m68000 ;;
- 9000/[34]?? ) HP_ARCH=m68k ;;
+ 9000/31?) HP_ARCH=m68000 ;;
+ 9000/[34]??) HP_ARCH=m68k ;;
9000/[678][0-9][0-9])
if [ -x /usr/bin/getconf ]; then
sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null`
@@ -749,7 +746,7 @@ EOF
{ echo "$SYSTEM_NAME"; exit; }
echo unknown-hitachi-hiuxwe2
exit ;;
- 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*)
echo hppa1.1-hp-bsd
exit ;;
9000/8??:4.3bsd:*:*)
@@ -758,7 +755,7 @@ EOF
*9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*)
echo hppa1.0-hp-mpeix
exit ;;
- hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*)
echo hppa1.1-hp-osf
exit ;;
hp8??:OSF1:*:*)
@@ -855,10 +852,6 @@ EOF
*:MSYS*:*)
echo ${UNAME_MACHINE}-pc-msys
exit ;;
- i*:windows32*:*)
- # uname -m includes "-pc" on this system.
- echo ${UNAME_MACHINE}-mingw32
- exit ;;
i*:PW*:*)
echo ${UNAME_MACHINE}-pc-pw32
exit ;;
@@ -874,27 +867,12 @@ EOF
echo ia64-unknown-interix${UNAME_RELEASE}
exit ;;
esac ;;
- [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
- echo i${UNAME_MACHINE}-pc-mks
- exit ;;
- 8664:Windows_NT:*)
- echo x86_64-pc-mks
- exit ;;
- i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
- # How do we know it's Interix rather than the generic POSIX subsystem?
- # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
- # UNAME_MACHINE based on the output of uname instead of i386?
- echo i586-pc-interix
- exit ;;
i*:UWIN*:*)
echo ${UNAME_MACHINE}-pc-uwin
exit ;;
amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
echo x86_64-unknown-cygwin
exit ;;
- p*:CYGWIN*:*)
- echo powerpcle-unknown-cygwin
- exit ;;
prep*:SunOS:5.*:*)
echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
@@ -1097,7 +1075,7 @@ EOF
i*86:*DOS:*:*)
echo ${UNAME_MACHINE}-pc-msdosdjgpp
exit ;;
- i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*)
+ i*86:*:4.*:*)
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}
@@ -1425,16 +1403,28 @@ EOF
exit ;;
esac
+echo "$0: unable to guess system type" >&2
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}" in
+ mips:Linux | mips64:Linux)
+ # If we got here on MIPS GNU/Linux, output extra information.
+ cat >&2 <<EOF
+
+NOTE: MIPS GNU/Linux systems require a C compiler to fully recognize
+the system type. Please install a C compiler and try again.
+EOF
+ ;;
+esac
+
cat >&2 <<EOF
-$0: unable to guess system type
This script (version $timestamp), has failed to recognize the
-operating system you are using. If your script is old, overwrite
-config.guess and config.sub with the latest versions from:
+operating system you are using. If your script is old, overwrite *all*
+copies of config.guess and config.sub with the latest versions from:
- http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
+ https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
and
- http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+ https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
If $0 has already been updated, send the following data and any
information you think might be pertinent to config-patches@gnu.org to
@@ -1466,7 +1456,7 @@ EOF
exit 1
# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
+# eval: (add-hook 'write-file-functions 'time-stamp)
# time-stamp-start: "timestamp='"
# time-stamp-format: "%:y-%02m-%02d"
# time-stamp-end: "'"
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 40ea5dfe115..00f68b8e5f3 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -2,7 +2,7 @@
# Configuration validation subroutine script.
# Copyright 1992-2017 Free Software Foundation, Inc.
-timestamp='2017-04-02'
+timestamp='2017-11-23'
# 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
@@ -15,7 +15,7 @@ timestamp='2017-04-02'
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this program; if not, see <http://www.gnu.org/licenses/>.
+# along with this program; if not, see <https://www.gnu.org/licenses/>.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
@@ -33,7 +33,7 @@ timestamp='2017-04-02'
# Otherwise, we print the canonical config type on stdout and succeed.
# You can get the latest version of this script from:
-# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
# This file is supposed to be the same for all GNU packages
# and recognize all the CPU types, system types and aliases
@@ -57,7 +57,7 @@ Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS
Canonicalize a configuration name.
-Operation modes:
+Options:
-h, --help print this help, then exit
-t, --time-stamp print date of last modification, then exit
-v, --version print version number, then exit
@@ -229,9 +229,6 @@ case $os in
-ptx*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
;;
- -windowsnt*)
- os=`echo $os | sed -e 's/windowsnt/winnt/'`
- ;;
-psos*)
os=-psos
;;
@@ -316,7 +313,6 @@ case $basic_machine in
| v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \
| visium \
| wasm32 \
- | we32k \
| x86 | xc16x | xstormy16 | xtensa \
| z8k | z80)
basic_machine=$basic_machine-unknown
@@ -643,7 +639,7 @@ case $basic_machine in
basic_machine=rs6000-bull
os=-bosx
;;
- dpx2* | dpx2*-bull)
+ dpx2*)
basic_machine=m68k-bull
os=-sysv3
;;
@@ -905,7 +901,7 @@ case $basic_machine in
basic_machine=v70-nec
os=-sysv
;;
- next | m*-next )
+ next | m*-next)
basic_machine=m68k-next
case $os in
-nextstep* )
@@ -1259,6 +1255,9 @@ case $basic_machine in
basic_machine=hppa1.1-winbond
os=-proelf
;;
+ x64)
+ basic_machine=x86_64-pc
+ ;;
xbox)
basic_machine=i686-pc
os=-mingw32
@@ -1366,8 +1365,8 @@ esac
if [ x"$os" != x"" ]
then
case $os in
- # First match some system type aliases
- # that might get confused with valid system types.
+ # First match some system type aliases that might get confused
+ # with valid system types.
# -solaris* is a basic system type, with this one exception.
-auroraux)
os=-auroraux
@@ -1387,9 +1386,9 @@ case $os in
-gnu/linux*)
os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
;;
- # First accept the basic system types.
+ # Now accept the basic system types.
# The portable systems comes first.
- # Each alternative MUST END IN A *, to match a version number.
+ # Each alternative MUST end in a * to match a version number.
# -sysv* is not here because it comes later, after sysvr4.
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
@@ -1492,7 +1491,7 @@ case $os in
-nova*)
os=-rtmk-nova
;;
- -ns2 )
+ -ns2)
os=-nextstep2
;;
-nsk*)
@@ -1547,6 +1546,19 @@ case $os in
-dicos*)
os=-dicos
;;
+ -pikeos*)
+ # Until real need of OS specific support for
+ # particular features comes up, bare metal
+ # configurations are quite functional.
+ case $basic_machine in
+ arm*)
+ os=-eabi
+ ;;
+ *)
+ os=-elf
+ ;;
+ esac
+ ;;
-nacl*)
;;
-ios)
@@ -1694,7 +1706,7 @@ case $basic_machine in
m88k-omron*)
os=-luna
;;
- *-next )
+ *-next)
os=-nextstep
;;
*-sequent)
@@ -1829,7 +1841,7 @@ echo $basic_machine$os
exit
# Local variables:
-# eval: (add-hook 'write-file-hooks 'time-stamp)
+# eval: (add-hook 'write-file-functions 'time-stamp)
# time-stamp-start: "timestamp='"
# time-stamp-format: "%:y-%02m-%02d"
# time-stamp-end: "'"
diff --git a/build-aux/git-hooks/commit-msg b/build-aux/git-hooks/commit-msg
index 475956e551b..e1ff281de71 100755
--- a/build-aux/git-hooks/commit-msg
+++ b/build-aux/git-hooks/commit-msg
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Written by Paul Eggert.
@@ -44,7 +44,7 @@ if test "$at_sign" != @; then
fi
# Check the log entry.
-exec $awk -v at_sign="$at_sign" -v cent_sign="$cent_sign" '
+exec $awk -v at_sign="$at_sign" -v cent_sign="$cent_sign" -v file="$1" '
BEGIN {
# These regular expressions assume traditional Unix unibyte behavior.
# They are needed for old or broken versions of awk, e.g.,
@@ -66,8 +66,12 @@ exec $awk -v at_sign="$at_sign" -v cent_sign="$cent_sign" '
non_print = "[^[:print:]]"
}
}
+ c_lower = "abcdefghijklmnopqrstuvwxyz"
+ unsafe_gnu_url = "(http|ftp)://([" c_lower ".]*\\.)?(gnu|fsf)\\.org"
}
+ { input[NR] = $0 }
+
/^#/ {
# Ignore every line after a scissors line.
if (/^# *---* *(>[8%]|[8%]<) *---* *$/) { exit }
@@ -125,6 +129,10 @@ exec $awk -v at_sign="$at_sign" -v cent_sign="$cent_sign" '
status = 1
}
+ $0 ~ unsafe_gnu_url {
+ needs_rewriting = 1
+ }
+
$0 ~ non_print {
print "Unprintable character in commit message"
status = 1
@@ -135,6 +143,21 @@ exec $awk -v at_sign="$at_sign" -v cent_sign="$cent_sign" '
print "Empty commit message"
status = 1
}
+ if (status == 0 && needs_rewriting) {
+ for (i = 1; i <= NR; i++) {
+ line = input[i]
+ while (match(line, unsafe_gnu_url)) {
+ prefix = substr(line, 1, RSTART - 1)
+ suffix = substr(line, RSTART)
+ line = prefix "https:" substr(suffix, 5 + (suffix ~ /^http:/))
+ }
+ print line >file
+ }
+ if (close(file) != 0) {
+ print "Cannot rewrite: " file
+ status = 1
+ }
+ }
if (status != 0) {
print "Commit aborted; please see the file 'CONTRIBUTE'"
}
diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit
index 548bf933f0c..68a0c33d4a1 100755
--- a/build-aux/git-hooks/pre-commit
+++ b/build-aux/git-hooks/pre-commit
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
LC_ALL=C
export LC_ALL
@@ -28,7 +28,7 @@ exec >&2
# When doing a two-way merge, ignore problems that came from the other
# side of the merge.
head=HEAD
-if test -e "$GIT_DIR"/MERGE_HEAD; then
+if test -r "$GIT_DIR"/MERGE_HEAD; then
merge_heads=`cat "$GIT_DIR"/MERGE_HEAD` || exit
for merge_head in $merge_heads; do
case $head in
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index cf164254634..3c94bd56a0b 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -3,7 +3,7 @@ eval '(exit $?0)' && eval 'exec perl -wS "$0" "$@"'
if 0;
# Convert git log output to ChangeLog format.
-my $VERSION = '2016-03-22 21:49'; # UTC
+my $VERSION = '2017-09-13 06:45'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
@@ -22,7 +22,7 @@ my $VERSION = '2016-03-22 21:49'; # UTC
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
# Written by Jim Meyering
@@ -33,7 +33,7 @@ use POSIX qw(strftime);
(my $ME = $0) =~ s|.*/||;
-# use File::Coda; # http://meyering.net/code/Coda/
+# use File::Coda; # https://meyering.net/code/Coda/
END {
defined fileno STDOUT or return;
close STDOUT and return;
diff --git a/build-aux/gitlog-to-emacslog b/build-aux/gitlog-to-emacslog
index 482b8dbe5dc..6a58f2d4b2c 100755
--- a/build-aux/gitlog-to-emacslog
+++ b/build-aux/gitlog-to-emacslog
@@ -17,7 +17,7 @@
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
LC_ALL=C
export LC_ALL
@@ -68,7 +68,7 @@ if [ -f "$output" ]; then
fi
# If this is not a Git repository, just generate an empty ChangeLog.
-test -e .git || {
+test -r .git || {
>"$output"
exit
}
@@ -81,7 +81,7 @@ test -e .git || {
--ignore-line='^; ' --format='%B' \
"$gen_origin..$new_origin" >"ChangeLog.tmp" || exit
-if test -e "ChangeLog.tmp"; then
+if test -r "ChangeLog.tmp"; then
# Fix up bug references.
# This would be better as eg a --transform option to gitlog-to-changelog,
diff --git a/build-aux/install-sh b/build-aux/install-sh
index 0360b79e7d0..ac159ceda40 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=2016-01-11.22; # UTC
+scriptversion=2017-09-23.17; # UTC
# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
@@ -271,15 +271,18 @@ do
fi
dst=$dst_arg
- # If destination is a directory, append the input filename; won't work
- # if double slashes aren't ignored.
+ # If destination is a directory, append the input filename.
if test -d "$dst"; then
if test "$is_target_a_directory" = never; then
echo "$0: $dst_arg: Is a directory" >&2
exit 1
fi
dstdir=$dst
- dst=$dstdir/`basename "$src"`
+ dstbase=`basename "$src"`
+ case $dst in
+ */) dst=$dst$dstbase;;
+ *) dst=$dst/$dstbase;;
+ esac
dstdir_status=0
else
dstdir=`dirname "$dst"`
@@ -288,6 +291,11 @@ do
fi
fi
+ case $dstdir in
+ */) dstdirslash=$dstdir;;
+ *) dstdirslash=$dstdir/;;
+ esac
+
obsolete_mkdir_used=false
if test $dstdir_status != 0; then
@@ -427,8 +435,8 @@ do
else
# Make a couple of temp file names in the proper directory.
- dsttmp=$dstdir/_inst.$$_
- rmtmp=$dstdir/_rm.$$_
+ dsttmp=${dstdirslash}_inst.$$_
+ rmtmp=${dstdirslash}_rm.$$_
# Trap to clean up those temp files at exit.
trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0
diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir
index e8c66943e0a..8a1d580363a 100755
--- a/build-aux/make-info-dir
+++ b/build-aux/make-info-dir
@@ -20,7 +20,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/build-aux/move-if-change b/build-aux/move-if-change
index 4dd86995921..4a65145594c 100755
--- a/build-aux/move-if-change
+++ b/build-aux/move-if-change
@@ -2,7 +2,7 @@
# Like mv $1 $2, but if the files are the same, just delete $1.
# Status is zero if successful, nonzero otherwise.
-VERSION='2016-01-11 22:04'; # UTC
+VERSION='2017-09-13 06:45'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
@@ -21,7 +21,7 @@ VERSION='2016-01-11 22:04'; # UTC
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
usage="usage: $0 SOURCE DEST"
@@ -39,7 +39,7 @@ Report bugs to <bug-gnulib@gnu.org>."
version=`expr "$VERSION" : '\([^ ]*\)'`
version="move-if-change (gnulib) $version
Copyright (C) 2011 Free Software Foundation, Inc.
-License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
+License GPLv3+: GNU GPL version 3 or later <https://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law."
diff --git a/build-aux/msys-to-w32 b/build-aux/msys-to-w32
index 3f57478a9df..38daf56b0a2 100755
--- a/build-aux/msys-to-w32
+++ b/build-aux/msys-to-w32
@@ -15,7 +15,7 @@
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
# Take only the basename from the full pathname
me=${0//*\//}
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index 2d20d211c9e..63455c37948 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -3,7 +3,7 @@ eval '(exit $?0)' && eval 'exec perl -wS -0777 -pi "$0" "$@"'
if 0;
# Update an FSF copyright year list to include the current year.
-my $VERSION = '2016-01-12.23:13'; # UTC
+my $VERSION = '2017-09-13.06:45'; # UTC
# Copyright (C) 2009-2017 Free Software Foundation, Inc.
#
@@ -18,7 +18,7 @@ my $VERSION = '2016-01-12.23:13'; # UTC
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
# Written by Jim Meyering and Joel E. Denny
diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs
index 90f1b3c0c63..64197589252 100755
--- a/build-aux/update-subdirs
+++ b/build-aux/update-subdirs
@@ -17,7 +17,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
cd "$1" || exit 1
diff --git a/config.bat b/config.bat
index d1f2702d356..90882218bc6 100644
--- a/config.bat
+++ b/config.bat
@@ -16,7 +16,7 @@ rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
rem GNU General Public License for more details.
rem You should have received a copy of the GNU General Public License
-rem along with GNU Emacs. If not, see http://www.gnu.org/licenses/.
+rem along with GNU Emacs. If not, see https://www.gnu.org/licenses/.
rem ----------------------------------------------------------------------
rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS:
@@ -189,9 +189,6 @@ rm -f junk.c junk junk.exe
update config.h2 config.h >nul
rm -f config.tmp config.h2
-rem On my system dir.h gets in the way. It's a VMS file so who cares.
-if exist dir.h ren dir.h vmsdir.h
-
rem Create "makefile" from "makefile.in".
rm -f Makefile makefile.tmp
copy Makefile.in+deps.mk makefile.tmp
@@ -222,6 +219,10 @@ sed -e "/^LIBXML2_LIBS *=/s/=/= -lxml2 -lz -liconv/" <Makefile >makefile.tmp
sed -e "/^LIBXML2_CFLAGS *=/s|=|= -I/dev/env/DJDIR/include/libxml2|" <makefile.tmp >Makefile
rm -f makefile.tmp
:src7
+Rem Create .d files for new files in src/
+If Not Exist deps\stamp mkdir deps
+for %%f in (*.c) do @call ..\msdos\depfiles.bat %%f
+echo deps-stamp > deps\stamp
cd ..
rem ----------------------------------------------------------------------
Echo Configuring the library source directory...
@@ -273,6 +274,7 @@ Echo Configuring the lib directory...
If Exist build-aux\snippet\c++defs.h update build-aux/snippet/c++defs.h build-aux/snippet/cxxdefs.h
cd lib
Rem Rename files like djtar on plain DOS filesystem would.
+If Exist c++defs.h update c++defs.h cxxdefs.h
If Exist alloca.in.h update alloca.in.h alloca.in-h
If Exist byteswap.in.h update byteswap.in.h byteswap.in-h
If Exist dirent.in.h update dirent.in.h dirent.in-h
@@ -280,12 +282,12 @@ If Exist errno.in.h update errno.in.h errno.in-h
If Exist execinfo.in.h update execinfo.in.h execinfo.in-h
If Exist fcntl.in.h update fcntl.in.h fcntl.in-h
If Exist getopt.in.h update getopt.in.h getopt.in-h
+If Exist getopt-cdefs.in.h update getopt-cdefs.in.h getopt-cdefs.in-h
If Exist inttypes.in.h update inttypes.in.h inttypes.in-h
-If Exist stdarg.in.h update stdarg.in.h stdarg.in-h
-If Exist stdalign.in.h update stdalign.in.h stdalign.in-h
-If Exist stdbool.in.h update stdbool.in.h stdbool.in-h
+If Exist limits.in.h update limits.in.h limits.in-h
If Exist signal.in.h update signal.in.h signal.in-h
-If Exist stdalign.in.h update stdalign.in.h stdalign.in-h
+If Exist signal.in.h update signal.in.h signal.in-h
+If Exist stdalign.in.h update stdalign.in.h stdalign.in-h
If Exist stddef.in.h update stddef.in.h stddef.in-h
If Exist stdint.in.h update stdint.in.h stdint.in-h
If Exist stdio.in.h update stdio.in.h stdio.in-h
@@ -293,16 +295,20 @@ If Exist stdlib.in.h update stdlib.in.h stdlib.in-h
If Exist string.in.h update string.in.h string.in-h
If Exist sys_select.in.h update sys_select.in.h sys_select.in-h
If Exist sys_stat.in.h update sys_stat.in.h sys_stat.in-h
-If Exist sys_types.in.h update sys_types.in.h sys_types.in-h
If Exist sys_time.in.h update sys_time.in.h sys_time.in-h
+If Exist sys_types.in.h update sys_types.in.h sys_types.in-h
If Exist time.in.h update time.in.h time.in-h
If Exist unistd.in.h update unistd.in.h unistd.in-h
+If Exist gnulib.mk.in update gnulib.mk.in gnulib.mk-in
Rem Only repository has the msdos/autogen directory
If Exist Makefile.in sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp
If Exist ..\msdos\autogen\Makefile.in sed -f ../msdos/sedlibcf.inp < ..\msdos\autogen\Makefile.in > makefile.tmp
sed -f ../msdos/sedlibmk.inp < makefile.tmp > Makefile
rm -f makefile.tmp
-Rem Create .Po files for new files in lib/
+sed -f ../msdos/sedlibcf.inp < gnulib.mk-in > gnulib.tmp
+sed -f ../msdos/sedlibmk.inp < gnulib.tmp > gnulib.mk
+rm -f gnulib.tmp
+Rem Create .d files for new files in lib/
If Not Exist deps\stamp mkdir deps
for %%f in (*.c) do @call ..\msdos\depfiles.bat %%f
echo deps-stamp > deps\stamp
diff --git a/configure.ac b/configure.ac
index ef61107b025..61455a4b0fa 100644
--- a/configure.ac
+++ b/configure.ac
@@ -19,11 +19,11 @@ dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
dnl GNU General Public License for more details.
dnl
dnl You should have received a copy of the GNU General Public License
-dnl along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+dnl along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
AC_PREREQ(2.65)
dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el.
-AC_INIT(GNU Emacs, 26.0.50, bug-gnu-emacs@gnu.org)
+AC_INIT(GNU Emacs, 27.0.50, bug-gnu-emacs@gnu.org, , https://www.gnu.org/software/emacs/)
dnl Set emacs_config_options to the options of 'configure', quoted for the shell,
dnl and then quoted again for a C string. Separate options with spaces.
@@ -168,13 +168,16 @@ Defaulting to $host.])
# format ("c:/foo/bar").
srcdir=`cd "${srcdir}" && pwd -W`
# 'eval' pacifies strict POSIX non-MinGW shells (Bug#18612).
- eval 'srcdir="/${srcdir:0:1}${srcdir:2}"'
+ # We downcase the drive letter to avoid warnings when
+ # generating autoloads.
+ eval 'srcdir=/`echo ${srcdir:0:1} | sed "y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/"`"${srcdir:2}"'
;;
esac;;
esac
canonical=$host
configuration=${host_alias-${build_alias-$host}}
+emacs_uname_r=`uname -r`
dnl Support for --program-prefix, --program-suffix and
dnl --program-transform-name options
@@ -229,21 +232,35 @@ AC_DEFUN([OPTION_DEFAULT_ON], [dnl
m4_bpatsubst([with_$1], [[^0-9a-z]], [_])=$with_features])dnl
])dnl
-# FIXME: The default options '--without-mailutils --with-pop' result
-# in a movemail implementation that supports only unencrypted POP3
-# connections. Encrypted connections should be the default.
-
-OPTION_DEFAULT_OFF([mailutils],
- [rely on GNU Mailutils, so that the --without-pop through --with-mailhost
- options are irrelevant])
+# For retrieving mail, unencrypted network connections are the default
+# only on native MS-Windows platforms. (FIXME: These platforms should
+# also be secure by default.)
+
+AC_ARG_WITH([mailutils],
+ [AS_HELP_STRING([--with-mailutils],
+ [rely on GNU Mailutils, so that the --without-pop through --with-mailhost
+ options are irrelevant; this is the default if GNU Mailutils is
+ installed])],
+ [],
+ [with_mailutils=$with_features
+ if test "$with_mailutils" = yes; then
+ (movemail --version) >/dev/null 2>&1 || with_mailutils=no
+ fi])
if test "$with_mailutils" = no; then
with_mailutils=
fi
AC_SUBST([with_mailutils])
-OPTION_DEFAULT_ON([pop],
- [don't support POP mail retrieval with movemail (--without-pop or
- --with-mailutils is recommended, as movemail POP is insecure)])
+AC_ARG_WITH([pop],
+ [AS_HELP_STRING([--with-pop],
+ [Support POP mail retrieval if Emacs movemail is used (not recommended,
+ as Emacs movemail POP is insecure). This is the default only on
+ native MS-Windows.])],
+ [],
+ [case $host in
+ *-mingw*) with_pop=yes;;
+ *) with_pop=no-by-default;;
+ esac])
if test "$with_pop" = yes; then
AC_DEFINE(MAIL_USE_POP)
fi
@@ -333,6 +350,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support])
OPTION_DEFAULT_ON([gif],[don't compile with GIF image support])
OPTION_DEFAULT_ON([png],[don't compile with PNG image support])
OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support])
+OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support])
OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support])
OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)])
OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support])
@@ -352,7 +370,8 @@ OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI in a Cygwin build])
OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console])
OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support])
-OPTION_DEFAULT_ON([gconf],[don't compile with GConf support])
+AC_ARG_WITH([gconf],[AS_HELP_STRING([--with-gconf],
+[compile with Gconf support (Gsettings replaces this)])],[],[with_gconf=maybe])
OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support])
OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support])
OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support])
@@ -384,7 +403,7 @@ OPTION_DEFAULT_OFF([xwidgets],
## For the times when you want to build Emacs but don't have
## a suitable makeinfo, and can live without the manuals.
-dnl http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg01844.html
+dnl https://lists.gnu.org/r/emacs-devel/2008-04/msg01844.html
OPTION_DEFAULT_ON([makeinfo],[don't require makeinfo for building manuals])
## Makefile.in needs the cache file name.
@@ -510,7 +529,7 @@ fi
dnl The name of this option is unfortunate. It predates, and has no
dnl relation to, the "sampling-based elisp profiler" added in 24.3.
dnl Actually, it stops it working.
-dnl http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00393.html
+dnl https://lists.gnu.org/r/emacs-devel/2012-11/msg00393.html
AC_ARG_ENABLE(profiling,
[AS_HELP_STRING([--enable-profiling],
[build emacs with low-level, gprof profiling support.
@@ -680,6 +699,14 @@ case "${canonical}" in
esac
;;
+ ## QNX Neutrino
+ *-nto-qnx* )
+ opsys=qnxnto
+ test -z "$CC" && CC=qcc
+ CFLAGS="$CFLAGS -D__NO_EXT_QNX"
+ LDFLAGS="-N2MB $LDFLAGS"
+ ;;
+
## Intel 386 machines where we don't care about the manufacturer.
i[3456]86-*-* )
case "${canonical}" in
@@ -936,7 +963,7 @@ AS_IF([test $gl_gcc_warnings = no],
nw="$nw -Wbad-function-cast" # These casts are no worse than others.
# Emacs doesn't care about shadowing; see
- # <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ # <https://lists.gnu.org/r/emacs-diffs/2011-11/msg00265.html>.
nw="$nw -Wshadow"
# Emacs's use of alloca inhibits protecting the stack.
@@ -957,6 +984,7 @@ AS_IF([test $gl_gcc_warnings = no],
# This part is merely for shortening the command line,
# since -Wno-FOO needs to be added below regardless.
nw="$nw -Wmissing-field-initializers"
+ nw="$nw -Woverride-init"
nw="$nw -Wtype-limits"
nw="$nw -Wunused-parameter"
@@ -966,9 +994,10 @@ AS_IF([test $gl_gcc_warnings = no],
nw="$nw -Wmissing-braces"
fi
- # This causes too much noise in the MinGW build
+ # These cause too much noise in the MinGW build
if test $opsys = mingw32; then
nw="$nw -Wpointer-sign"
+ nw="$nw -Wsuggest-attribute=format"
fi
gl_MANYWARN_ALL_GCC([ws])
@@ -978,6 +1007,7 @@ AS_IF([test $gl_gcc_warnings = no],
done
gl_WARN_ADD([-Wredundant-decls]) # Prefer this, as we don't use Bison.
gl_WARN_ADD([-Wno-missing-field-initializers]) # We need this one
+ gl_WARN_ADD([-Wno-override-init]) # More trouble than it is worth
gl_WARN_ADD([-Wno-sign-compare]) # Too many warnings for now
gl_WARN_ADD([-Wno-type-limits]) # Too many warnings for now
gl_WARN_ADD([-Wno-unused-parameter]) # Too many warnings for now
@@ -1005,9 +1035,10 @@ AS_IF([test $gl_gcc_warnings = no],
])
])
-# clang is unduly picky about these regardless of whether
+# clang is picky about these regardless of whether
# --enable-gcc-warnings is specified.
if test "$emacs_cv_clang" = yes; then
+ gl_WARN_ADD([-Wno-initializer-overrides])
gl_WARN_ADD([-Wno-tautological-compare])
gl_WARN_ADD([-Wno-tautological-constant-out-of-range-compare])
fi
@@ -1029,12 +1060,8 @@ edit_cflags="
AC_ARG_ENABLE(link-time-optimization,
[AS_HELP_STRING([--enable-link-time-optimization],
- [build emacs with link-time optimization.
- This requires GCC 4.5.0 or later, or clang.
- (Note that clang support is experimental - see INSTALL.)
- It also makes Emacs harder to debug, and when we tried it
- with GCC 4.9.0 x86-64 it made Emacs slower, so it's not
- recommended for typical use.])],
+ [build with link-time optimization
+ (experimental; see INSTALL)])],
if test "${enableval}" != "no"; then
ac_lto_supported=no
if test "$emacs_cv_clang" = yes; then
@@ -1125,36 +1152,31 @@ dnl hosted on AFS, both examples where simple links work, but links to
dnl directories fail. We use a cut-down version instead.
dnl AC_PROG_LN_S
-AC_MSG_CHECKING([whether ln -s works for files in the same directory])
-rm -f conf$$ conf$$.file
+AC_CACHE_CHECK([command to symlink files in the same directory], [emacs_cv_ln_s_fileonly],
+[rm -f conf$$ conf$$.file
-LN_S_FILEONLY='cp -p'
+emacs_cv_ln_s_fileonly='cp -p'
dnl On MinGW, ensure we will call the MSYS /bin/ln.exe, not some
dnl random program in the current directory.
if (echo >conf$$.file) 2>/dev/null; then
if ln -s conf$$.file conf$$ 2>/dev/null; then
if test "$opsys" = "mingw32"; then
- LN_S_FILEONLY='/bin/ln -s'
+ emacs_cv_ln_s_fileonly='/bin/ln -s'
else
- LN_S_FILEONLY='ln -s'
+ emacs_cv_ln_s_fileonly='ln -s'
fi
elif ln conf$$.file conf$$ 2>/dev/null; then
if test "$opsys" = "mingw32"; then
- LN_S_FILEONLY=/bin/ln
+ emacs_cv_ln_s_fileonly=/bin/ln
else
- LN_S_FILEONLY=ln
+ emacs_cv_ln_s_fileonly=ln
fi
fi
fi
-rm -f conf$$ conf$$.file
-
-if test "$LN_S_FILEONLY" = "ln -s"; then
- AC_MSG_RESULT([yes])
-else
- AC_MSG_RESULT([no, using $LN_S_FILEONLY])
-fi
+rm -f conf$$ conf$$.file])
+LN_S_FILEONLY=$emacs_cv_ln_s_fileonly
AC_SUBST(LN_S_FILEONLY)
@@ -1163,7 +1185,7 @@ dnl AC_PROG_LN_S sets LN_S to 'cp -pR' for MinGW, on the premise that 'ln'
dnl doesn't support links to directories, as in "ln file dir". But that
dnl use is non-portable, and OTOH MinGW wants to use hard links for Emacs
dnl executables at "make install" time.
-dnl See http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00475.html
+dnl See https://lists.gnu.org/r/emacs-devel/2013-04/msg00475.html
dnl for more details.
if test "$opsys" = "mingw32"; then
LN_S="/bin/ln"
@@ -1218,8 +1240,8 @@ if test $opsys = gnu-linux; then
AC_SUBST([SETFATTR])
fi
fi
-case $opsys,$PAXCTL_notdumped in
- gnu-linux, | netbsd,)
+case $opsys,$PAXCTL_notdumped,$emacs_uname_r in
+ gnu-linux,,* | netbsd,,[0-7].*)
AC_PATH_PROG([PAXCTL], [paxctl], [],
[$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin])
if test -n "$PAXCTL"; then
@@ -1306,26 +1328,29 @@ dnl For a long time, -znocombreloc was added to LDFLAGS rather than
dnl LD_SWITCH_SYSTEM_TEMACS. That is:
dnl * inappropriate, as LDFLAGS is a user option but this is essential.
dnl Eg "make LDFLAGS=... all" could run into problems,
-dnl http://bugs.debian.org/684788
+dnl https://bugs.debian.org/684788
dnl * unnecessary, since temacs is the only thing that actually needs it.
dnl Indeed this is where it was originally, prior to:
-dnl http://lists.gnu.org/archive/html/emacs-pretest-bug/2004-03/msg00170.html
-late_LDFLAGS="$LDFLAGS"
+dnl https://lists.gnu.org/r/emacs-pretest-bug/2004-03/msg00170.html
if test x$GCC = xyes; then
LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc"
else
LDFLAGS_NOCOMBRELOC="-znocombreloc"
fi
+AC_CACHE_CHECK([for -znocombreloc], [emacs_cv_znocombreloc],
+[late_LDFLAGS="$LDFLAGS"
LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC"
-AC_MSG_CHECKING([for -znocombreloc])
AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])],
- [AC_MSG_RESULT(yes)],
+ [emacs_cv_znocombreloc=yes], [emacs_cv_znocombreloc=no])
+
+LDFLAGS="$late_LDFLAGS"])
+
+if test x$emacs_cv_znocombreloc = xno; then
LDFLAGS_NOCOMBRELOC=
- [AC_MSG_RESULT(no)])
+fi
-LDFLAGS="$late_LDFLAGS"
AC_CACHE_CHECK([whether addresses are sanitized],
[emacs_cv_sanitize_address],
@@ -1382,10 +1407,6 @@ case "$opsys" in
# The resulting binary has a complete symbol table, and is better
# for debugging and other observability tools (debuggers, pstack, etc).
#
- # If you encounter a problem using dldump(), please consider sending
- # a message to the OpenSolaris tools-linking mailing list:
- # http://mail.opensolaris.org/mailman/listinfo/tools-linking
- #
# It is likely that dldump() works with older Solaris too, but this has
# not been tested, so for now this change is for Solaris 10 or newer.
UNEXEC_OBJ=unexsol.o
@@ -1494,6 +1515,8 @@ case "$opsys" in
hpux*) LIBS_SYSTEM="-l:libdld.sl" ;;
+ qnxnto) LIBS_SYSTEM="-lsocket" ;;
+
sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;;
## Motif needs -lgen.
@@ -1688,13 +1711,13 @@ fi
# sysinfo as well. To make sure that we're using GNU/Linux
# sysinfo, we explicitly set one of its fields.
if test "$ac_cv_header_sys_sysinfo_h" = yes; then
- AC_MSG_CHECKING([if Linux sysinfo may be used])
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/sysinfo.h>]],
+ AC_CACHE_CHECK([if Linux sysinfo may be used], [emacs_cv_linux_sysinfo],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/sysinfo.h>]],
[[struct sysinfo si;
si.totalram = 0;
sysinfo (&si)]])],
- emacs_cv_linux_sysinfo=yes, emacs_cv_linux_sysinfo=no)
- AC_MSG_RESULT($emacs_cv_linux_sysinfo)
+ emacs_cv_linux_sysinfo=yes, emacs_cv_linux_sysinfo=no)])
+
if test $emacs_cv_linux_sysinfo = yes; then
AC_DEFINE([HAVE_LINUX_SYSINFO], 1, [Define to 1 if you have Linux sysinfo function.])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/sysinfo.h>]],
@@ -1753,23 +1776,20 @@ AUTO_DEPEND=no
AUTODEPEND_PARENTS='lib src'
dnl check if we have GCC and autodepend is on.
if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then
- AC_MSG_CHECKING([whether gcc understands -MMD -MF])
- SAVE_CFLAGS="$CFLAGS"
+ AC_CACHE_CHECK([whether gcc understands -MMD -MF], [emacs_cv_autodepend],
+ [SAVE_CFLAGS="$CFLAGS"
CFLAGS="$CFLAGS -MMD -MF deps.d -MP"
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], , ac_enable_autodepend=no)
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
+ [emacs_cv_autodepend=yes], [emacs_cv_autodepend=no])
CFLAGS="$SAVE_CFLAGS"
- test -f deps.d || ac_enable_autodepend=no
- rm -rf deps.d
- AC_MSG_RESULT([$ac_enable_autodepend])
- if test $ac_enable_autodepend = yes; then
+ test -f deps.d || emacs_cv_autodepend=no
+ rm -rf deps.d])
+ if test $emacs_cv_autodepend = yes; then
AUTO_DEPEND=yes
fi
fi
AC_SUBST(AUTO_DEPEND)
-dnl checks for operating system services
-AC_SYS_LONG_FILE_NAMES
-
#### Choose a window system.
## We leave window_system equal to none if
@@ -2028,19 +2048,17 @@ if test "${with_w32}" != no; then
fi
if test "${opsys}" = "mingw32"; then
- AC_MSG_CHECKING([whether Windows API headers are recent enough])
- AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
+ AC_CACHE_CHECK([whether Windows API headers are recent enough], [emacs_cv_w32api],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#include <windows.h>
#include <usp10.h>]],
[[PIMAGE_NT_HEADERS pHeader;
PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader)]])],
- [emacs_cv_w32api=yes
- HAVE_W32=yes],
- emacs_cv_w32api=no)
- AC_MSG_RESULT($emacs_cv_w32api)
+ [emacs_cv_w32api=yes], [emacs_cv_w32api=no])])
if test "${emacs_cv_w32api}" = "no"; then
AC_MSG_ERROR([the Windows API headers are too old to support this build.])
fi
+ HAVE_W32=${emacs_cv_w32api}
fi
FIRSTFILE_OBJ=
@@ -2072,15 +2090,15 @@ if test "${HAVE_W32}" = "yes"; then
AC_SUBST(comma_space_version)
AC_CONFIG_FILES([nt/emacs.rc nt/emacsclient.rc])
if test "${opsys}" = "cygwin"; then
- W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32"
- W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool"
+ W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lusp10 -lgdi32"
+ W32_LIBS="$W32_LIBS -lole32 -lcomdlg32 -lcomctl32 -lwinspool"
# Tell the linker that emacs.res is an object (which we compile from
# the rc file), not a linker script.
W32_RES_LINK="-Wl,emacs.res"
else
W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o"
- W32_LIBS="$W32_LIBS -lwinmm -lgdi32 -lcomdlg32"
- W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32 -lusp10"
+ W32_LIBS="$W32_LIBS -lwinmm -lusp10 -lgdi32 -lcomdlg32"
+ W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32"
W32_RES_LINK="\$(EMACSRES)"
CLIENTRES="emacsclient.res"
CLIENTW="emacsclientw\$(EXEEXT)"
@@ -2202,7 +2220,8 @@ test "$CANNOT_DUMP" = yes ||
case "$opsys" in
## darwin ld insists on the use of malloc routines in the System framework.
darwin | mingw32 | nacl | sol2-10) ;;
- cygwin) hybrid_malloc=yes
+ cygwin | qnxnto | freebsd)
+ hybrid_malloc=yes
system_malloc= ;;
*) test "$ac_cv_func_sbrk" = yes && system_malloc=$emacs_cv_sanitize_address;;
esac
@@ -2403,8 +2422,8 @@ if test "${HAVE_X11}" = "yes"; then
fi
if test "${opsys}" = "gnu-linux"; then
- AC_MSG_CHECKING(whether X on GNU/Linux needs -b to link)
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],
+ AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link], [emacs_cv_b_link],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]],
[[XOpenDisplay ("foo");]])],
[xgnu_linux_first_failure=no],
[xgnu_linux_first_failure=yes])
@@ -2420,28 +2439,29 @@ if test "${HAVE_X11}" = "yes"; then
if test "${xgnu_linux_second_failure}" = "yes"; then
# If we get the same failure with -b, there is no use adding -b.
# So leave it out. This plays safe.
- AC_MSG_RESULT(no)
+ emacs_cv_b_link=no
else
- LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout"
- C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout"
- AC_MSG_RESULT(yes)
+ emacs_cv_b_link=yes
fi
CPPFLAGS=$OLD_CPPFLAGS
LIBS=$OLD_LIBS
else
- AC_MSG_RESULT(no)
+ emacs_cv_b_link=no
+ fi])
+ if test "x$emacs_cv_b_link" = xyes ; then
+ LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout"
+ C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout"
fi
fi
# Reportedly, some broken Solaris systems have XKBlib.h but are missing
# header files included from there.
- AC_MSG_CHECKING(for Xkb)
- AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <X11/Xlib.h>
+ AC_CACHE_CHECK([for Xkb], [emacs_cv_xkb],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <X11/Xlib.h>
#include <X11/XKBlib.h>]],
[[XkbDescPtr kb = XkbGetKeyboard (0, XkbAllComponentsMask, XkbUseCoreKbd);]])],
- emacs_xkb=yes, emacs_xkb=no)
- AC_MSG_RESULT($emacs_xkb)
- if test $emacs_xkb = yes; then
+ emacs_cv_xkb=yes, emacs_cv_xkb=no)])
+ if test $emacs_cv_xkb = yes; then
AC_DEFINE(HAVE_XKB, 1, [Define to 1 if you have the Xkb extension.])
fi
@@ -2503,7 +2523,8 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}"
if test "${with_imagemagick}" != "no"; then
## 6.3.5 is the earliest version known to work; see Bug#17339.
## 6.8.2 makes Emacs crash; see Bug#13867.
- IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2"
+ ## 7 and later have not been ported to; See Bug#25967.
+ IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2 Wand < 7"
EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK_MODULE])
if test $HAVE_IMAGEMAGICK = yes; then
@@ -2601,9 +2622,8 @@ if test x"$pkg_check_gtk" = xyes; then
CFLAGS="$CFLAGS $GTK_CFLAGS"
LIBS="$GTK_LIBS $LIBS"
dnl Try to compile a simple GTK program.
- AC_MSG_CHECKING([whether GTK compiles])
- GTK_COMPILES=no
- AC_LINK_IFELSE(
+ AC_CACHE_CHECK([whether GTK compiles], [emacs_cv_gtk_compiles],
+ [AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
[[/* Check the Gtk and Glib APIs. */
#include <gtk/gtk.h>
@@ -2621,9 +2641,8 @@ if test x"$pkg_check_gtk" = xyes; then
0, 0, 0, G_CALLBACK (callback), 0))
gtk_main_iteration ();
]])],
- [GTK_COMPILES=yes])
- AC_MSG_RESULT([$GTK_COMPILES])
- if test "${GTK_COMPILES}" != "yes"; then
+ [emacs_cv_gtk_compiles=yes], [emacs_cv_gtk_compiles=no])])
+ if test "${emacs_cv_gtk_compiles}" != "yes"; then
GTK_OBJ=
if test "$USE_X_TOOLKIT" != "maybe"; then
AC_MSG_ERROR([Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?]);
@@ -2639,8 +2658,7 @@ if test x"$pkg_check_gtk" = xyes; then
closing open displays. This is no problem if you just use
one display, but if you use more than one and close one of them
Emacs may crash.
- See http://bugzilla.gnome.org/show_bug.cgi?id=85715]])
- sleep 3
+ See https://bugzilla.gnome.org/show_bug.cgi?id=85715]])
fi
fi
@@ -2754,8 +2772,8 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then
CFLAGS="$CFLAGS $GSETTINGS_CFLAGS"
old_LIBS=$LIBS
LIBS="$LIBS $GSETTINGS_LIBS"
- AC_MSG_CHECKING([whether GSettings is in gio])
- AC_LINK_IFELSE(
+ AC_CACHE_CHECK([whether GSettings is in gio], [emacs_cv_gsettings_in_gio],
+ [AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
[[/* Check that gsettings really is present. */
#include <glib-object.h>
@@ -2765,13 +2783,13 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then
GSettings *settings;
GVariant *val = g_settings_get_value (settings, "");
]])],
- [], HAVE_GSETTINGS=no)
- AC_MSG_RESULT([$HAVE_GSETTINGS])
+ [emacs_cv_gsettings_in_gio=yes], [emacs_cv_gsettings_in_gio=no])])
- if test "$HAVE_GSETTINGS" = "yes"; then
+ if test "$emacs_cv_gsettings_in_gio" = "yes"; then
AC_DEFINE(HAVE_GSETTINGS, 1, [Define to 1 if using GSettings.])
SETTINGS_CFLAGS="$GSETTINGS_CFLAGS"
SETTINGS_LIBS="$GSETTINGS_LIBS"
+ test "$with_gconf" = "yes" || with_gconf=no
fi
CFLAGS=$old_CFLAGS
LIBS=$old_LIBS
@@ -2781,7 +2799,7 @@ fi
dnl GConf has been tested under GNU/Linux only.
dnl The version is really arbitrary, it is about the same age as Gtk+ 2.6.
HAVE_GCONF=no
-if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then
+if test "${HAVE_X11}" = "yes" && test "${with_gconf}" != "no"; then
EMACS_CHECK_MODULES([GCONF], [gconf-2.0 >= 2.13])
if test "$HAVE_GCONF" = yes; then
AC_DEFINE(HAVE_GCONF, 1, [Define to 1 if using GConf.])
@@ -2826,8 +2844,6 @@ if test "${with_gnutls}" = "yes" ; then
[HAVE_GNUTLS=yes], [HAVE_GNUTLS=no])
if test "${HAVE_GNUTLS}" = "yes"; then
AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
- EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0],
- [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], [])
fi
# Windows loads GnuTLS dynamically
@@ -3332,18 +3348,18 @@ if test "${HAVE_W32}" = "yes" && test "${opsys}" = "cygwin"; then
AC_CHECK_HEADER(noX/xpm.h,
[AC_CHECK_LIB(Xpm, XpmReadFileToImage, HAVE_XPM=yes)])
if test "${HAVE_XPM}" = "yes"; then
- AC_MSG_CHECKING(for XpmReturnAllocPixels preprocessor define)
- AC_EGREP_CPP(no_return_alloc_pixels,
+ AC_CACHE_CHECK([for XpmReturnAllocPixels preprocessor define],
+ [emacs_cv_cpp_xpm_return_alloc_pixels],
+ [AC_EGREP_CPP(no_return_alloc_pixels,
[#include "noX/xpm.h"
#ifndef XpmReturnAllocPixels
no_return_alloc_pixels
#endif
- ], HAVE_XPM=no, HAVE_XPM=yes)
+ ], emacs_cv_cpp_xpm_return_alloc_pixels=no,
+ emacs_cv_cpp_xpm_return_alloc_pixels=yes)])
- if test "${HAVE_XPM}" = "yes"; then
- AC_MSG_RESULT(yes)
- else
- AC_MSG_RESULT(no)
+ if test "$emacs_cv_cpp_xpm_return_alloc_pixels" = "no"; then
+ HAVE_XPM=no
LDFLAGS="$SAVE_LDFLAGS"
fi
fi
@@ -3363,18 +3379,18 @@ if test "${HAVE_X11}" = "yes"; then
AC_CHECK_HEADER(X11/xpm.h,
[AC_CHECK_LIB(Xpm, XpmReadFileToPixmap, HAVE_XPM=yes, , -lX11)])
if test "${HAVE_XPM}" = "yes"; then
- AC_MSG_CHECKING(for XpmReturnAllocPixels preprocessor define)
- AC_EGREP_CPP(no_return_alloc_pixels,
+ AC_CACHE_CHECK([for XpmReturnAllocPixels preprocessor define],
+ [emacs_cv_cpp_xpm_return_alloc_pixels],
+ [AC_EGREP_CPP(no_return_alloc_pixels,
[#include "X11/xpm.h"
#ifndef XpmReturnAllocPixels
no_return_alloc_pixels
#endif
- ], HAVE_XPM=no, HAVE_XPM=yes)
+ ], emacs_cv_cpp_xpm_return_alloc_pixels=no,
+ emacs_cv_cpp_xpm_return_alloc_pixels=yes)])
- if test "${HAVE_XPM}" = "yes"; then
- AC_MSG_RESULT(yes)
- else
- AC_MSG_RESULT(no)
+ if test "$emacs_cv_cpp_xpm_return_alloc_pixels" = "no"; then
+ HAVE_XPM=no
fi
fi
fi
@@ -3408,7 +3424,9 @@ AC_SUBST(LIBXPM)
### Use -ljpeg if available, unless '--with-jpeg=no'.
HAVE_JPEG=no
LIBJPEG=
-if test "${with_jpeg}" != "no"; then
+if test "${NS_IMPL_COCOA}" = yes; then
+ : # Cocoa provides its own jpeg support, so do nothing.
+elif test "${with_jpeg}" != "no"; then
AC_CACHE_CHECK([for jpeglib 6b or later],
[emacs_cv_jpeglib],
[OLD_LIBS=$LIBS
@@ -3450,6 +3468,25 @@ if test "${with_jpeg}" != "no"; then
fi
AC_SUBST(LIBJPEG)
+HAVE_LCMS2=no
+LIBLCMS2=
+if test "${with_lcms2}" != "no"; then
+ OLIBS=$LIBS
+ AC_SEARCH_LIBS([cmsCreateTransform], [lcms2], [HAVE_LCMS2=yes])
+ LIBS=$OLIBS
+ case $ac_cv_search_cmsCreateTransform in
+ -*) LIBLCMS2=$ac_cv_search_cmsCreateTransform ;;
+ esac
+fi
+if test "${HAVE_LCMS2}" = "yes"; then
+ AC_DEFINE([HAVE_LCMS2], 1, [Define to 1 if you have the lcms2 library (-llcms2).])
+ ### mingw32 doesn't use -llcms2, since it loads the library dynamically.
+ if test "${opsys}" = "mingw32"; then
+ LIBLCMS2=
+ fi
+fi
+AC_SUBST(LIBLCMS2)
+
HAVE_ZLIB=no
LIBZ=
if test "${with_zlib}" != "no"; then
@@ -3473,27 +3510,22 @@ AC_SUBST(LIBZ)
LIBMODULES=
HAVE_MODULES=no
MODULES_OBJ=
-MODULES_SUFFIX=
+case $opsys in
+ cygwin|mingw32) MODULES_SUFFIX=".dll" ;;
+ *) MODULES_SUFFIX=".so" ;;
+esac
if test "${with_modules}" != "no"; then
case $opsys in
gnu|gnu-linux)
LIBMODULES="-ldl"
- MODULES_SUFFIX=".so"
- HAVE_MODULES=yes
- ;;
- cygwin|mingw32)
- MODULES_SUFFIX=".dll"
HAVE_MODULES=yes
;;
- darwin)
- MODULES_SUFFIX=".so"
+ cygwin|mingw32|darwin)
HAVE_MODULES=yes
;;
*)
# BSD systems have dlopen in libc.
- AC_CHECK_FUNC([dlopen],
- [MODULES_SUFFIX=".so"
- HAVE_MODULES=yes])
+ AC_CHECK_FUNC([dlopen], [HAVE_MODULES=yes])
;;
esac
@@ -3529,7 +3561,7 @@ HAVE_PNG=no
LIBPNG=
PNG_CFLAGS=
if test "${NS_IMPL_COCOA}" = yes; then
- : # Nothing to do
+ : # Cocoa provides its own png support, so do nothing.
elif test "${with_png}" != no; then
# mingw32 loads the library dynamically.
if test "$opsys" = mingw32; then
@@ -3961,6 +3993,15 @@ AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break])
AC_CHECK_DECLS([aligned_alloc], [], [], [[#include <stdlib.h>]])
dnl Cannot use AC_CHECK_FUNCS
+AC_CACHE_CHECK([for __builtin_frame_address],
+ [emacs_cv_func___builtin_frame_address],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM([], [__builtin_frame_address (0);])],
+ [emacs_cv_func___builtin_frame_address=yes],
+ [emacs_cv_func___builtin_frame_address=no])])
+if test $emacs_cv_func___builtin_frame_address = yes; then
+ AC_DEFINE([HAVE___BUILTIN_FRAME_ADDRESS], 1,
+ [Define to 1 if you have the '__builtin_frame_address' function.])
+fi
AC_CACHE_CHECK([for __builtin_unwind_init],
emacs_cv_func___builtin_unwind_init,
[AC_LINK_IFELSE([AC_LANG_PROGRAM([], [__builtin_unwind_init ();])],
@@ -3981,17 +4022,11 @@ AC_CHECK_FUNCS(grantpt)
# PTY-related GNU extensions.
AC_CHECK_FUNCS(getpt posix_openpt)
-# Check this now, so that we will NOT find the above functions in ncurses.
-# That is because we have not set up to link ncurses in lib-src.
-# It's better to believe a function is not available
-# than to expect to find it in ncurses.
-# Also we need tputs and friends to be able to build at all.
-AC_MSG_CHECKING([for library containing tputs])
-# Run a test program that contains a call to tputs, a call that is
-# never executed. This tests whether a pre-'main' dynamic linker
-# works with the library. It's too much trouble to actually call
-# tputs in the test program, due to portability hassles. When
-# cross-compiling, assume the test program will run if it links.
+dnl Run a test program that contains a call to tputs, a call that is
+dnl never executed. This tests whether a pre-'main' dynamic linker
+dnl works with the library. It's too much trouble to actually call
+dnl tputs in the test program, due to portability hassles. When
+dnl cross-compiling, assume the test program will run if it links.
AC_DEFUN([tputs_link_source], [
AC_LANG_SOURCE(
[[extern void tputs (const char *, int, int (*)(int));
@@ -4002,38 +4037,41 @@ AC_DEFUN([tputs_link_source], [
return 0;
}]])
])
-if test "${opsys}" = "mingw32"; then
- msg='none required'
+# Check this now, so that we will NOT find the above functions in ncurses.
+# That is because we have not set up to link ncurses in lib-src.
+# It's better to believe a function is not available
+# than to expect to find it in ncurses.
+# Also we need tputs and friends to be able to build at all.
+AC_CACHE_CHECK([for library containing tputs], [emacs_cv_tputs_lib],
+[if test "${opsys}" = "mingw32"; then
+ emacs_cv_tputs_lib='none required'
else
- # Maybe curses should be tried earlier?
- # See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35
- for tputs_library in '' tinfo ncurses terminfo termcap curses; do
+ # curses precedes termcap because of AIX (Bug#9736#35) and OpenIndiana.
+ for tputs_library in '' tinfo ncurses terminfo curses termcap; do
OLIBS=$LIBS
if test -z "$tputs_library"; then
- LIBS_TERMCAP=
- msg='none required'
+ emacs_cv_tputs_lib='none required'
else
- LIBS_TERMCAP=-l$tputs_library
- msg=$LIBS_TERMCAP
- LIBS="$LIBS_TERMCAP $LIBS"
+ emacs_cv_tputs_lib=-l$tputs_library
+ LIBS="$emacs_cv_tputs_lib $LIBS"
fi
- AC_RUN_IFELSE([tputs_link_source], [], [msg=no],
- [AC_LINK_IFELSE([tputs_link_source], [], [msg=no])])
+ AC_RUN_IFELSE([tputs_link_source], [], [emacs_cv_tputs_lib=no],
+ [AC_LINK_IFELSE([tputs_link_source], [], [emacs_cv_tputs_lib=no])])
LIBS=$OLIBS
- if test "X$msg" != Xno; then
+ if test "X$emacs_cv_tputs_lib" != Xno; then
break
fi
done
-fi
-AC_MSG_RESULT([$msg])
-if test "X$msg" = Xno; then
- AC_MSG_ERROR([The required function 'tputs' was not found in any library.
+fi])
+AS_CASE(["$emacs_cv_tputs_lib"],
+ [no], [AC_MSG_ERROR([The required function 'tputs' was not found in any library.
The following libraries were tried (in order):
- libtinfo, libncurses, libterminfo, libtermcap, libcurses
+ libtinfo, libncurses, libterminfo, libcurses, libtermcap
Please try installing whichever of these libraries is most appropriate
for your system, together with its header files.
-For example, a libncurses-dev(el) or similar package.])
-fi
+For example, a libncurses-dev(el) or similar package.])],
+ [-l*], [LIBS_TERMCAP=$emacs_cv_tputs_lib],
+ [*], [LIBS_TERMCAP=])
## Use termcap instead of terminfo?
## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500.
@@ -4269,28 +4307,27 @@ dnl glib at a low level.
dnl
dnl Check this late, since it depends on $GTK_CFLAGS etc.
XGSELOBJ=
-OLDCFLAGS="$CFLAGS"
+AC_CACHE_CHECK([whether GLib is linked in], [emacs_cv_links_glib],
+[OLDCFLAGS="$CFLAGS"
OLDLIBS="$LIBS"
CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS"
LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS"
CFLAGS="$CFLAGS $NOTIFY_CFLAGS $CAIRO_CFLAGS"
LIBS="$LIBS $NOTIFY_LIBS $CAIRO_LIBS"
-AC_MSG_CHECKING([whether GLib is linked in])
AC_LINK_IFELSE([AC_LANG_PROGRAM(
[[#include <glib.h>
]],
[[g_print ("Hello world");]])],
- [links_glib=yes],
- [links_glib=no])
-AC_MSG_RESULT([$links_glib])
-if test "${links_glib}" = "yes"; then
+ [emacs_cv_links_glib=yes],
+ [emacs_cv_links_glib=no])
+CFLAGS="$OLDCFLAGS"
+LIBS="$OLDLIBS"])
+if test "${emacs_cv_links_glib}" = "yes"; then
AC_DEFINE(HAVE_GLIB, 1, [Define to 1 if GLib is linked in.])
if test "$HAVE_NS" = no;then
XGSELOBJ=xgselect.o
fi
fi
-CFLAGS="$OLDCFLAGS"
-LIBS="$OLDLIBS"
AC_SUBST(XGSELOBJ)
dnl Adapted from Haible's version.
@@ -4435,7 +4472,6 @@ emacs_broken_SIGIO=no
case $opsys in
dnl SIGIO exists, but the feature doesn't work in the way Emacs needs.
- dnl See eg <http://article.gmane.org/gmane.os.openbsd.ports/46831>.
hpux* | nacl | openbsd | sol2* | unixware )
emacs_broken_SIGIO=yes
;;
@@ -4580,7 +4616,7 @@ case $opsys in
AC_DEFINE(PTY_TTY_NAME_SPRINTF, [])
;;
- gnu | openbsd )
+ gnu | openbsd | qnxnto )
AC_DEFINE(FIRST_PTY_LETTER, ['p'])
;;
@@ -4656,16 +4692,15 @@ case $opsys in
dnl FIXME Does gnu-kfreebsd have linux/version.h? It seems unlikely...
gnu-linux | gnu-kfreebsd )
- AC_MSG_CHECKING([for signals via characters])
- AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
+ AC_CACHE_CHECK([for signals via characters], [emacs_cv_signals_via_chars],
+ [AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[
#include <linux/version.h>
#if LINUX_VERSION_CODE < 0x20400
# error "Linux version too old"
#endif
- ]], [[]])], emacs_signals_via_chars=yes, emacs_signals_via_chars=no)
+ ]], [[]])], emacs_cv_signals_via_chars=yes, emacs_cv_signals_via_chars=no)])
- AC_MSG_RESULT([$emacs_signals_via_chars])
- test $emacs_signals_via_chars = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
+ test "$emacs_cv_signals_via_chars" = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1)
;;
esac
@@ -5082,22 +5117,6 @@ else
fi
AC_SUBST(LIBXMENU)
-AC_CACHE_CHECK([for struct alignment],
- [emacs_cv_struct_alignment],
- [AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[#include <stddef.h>
- struct __attribute__ ((aligned (8))) s { char c; };
- struct t { char c; struct s s; };
- char verify[offsetof (struct t, s) == 8 ? 1 : -1];
- ]])],
- [emacs_cv_struct_alignment=yes],
- [emacs_cv_struct_alignment=no])])
-if test "$emacs_cv_struct_alignment" = yes; then
- AC_DEFINE([HAVE_STRUCT_ATTRIBUTE_ALIGNED], 1,
- [Define to 1 if 'struct __attribute__ ((aligned (N)))' aligns the
- structure to an N-byte boundary.])
-fi
-
if test "${GNU_MALLOC}" = "yes" ; then
AC_DEFINE(GNU_MALLOC, 1,
[Define to 1 if you want to use the GNU memory allocator.])
@@ -5293,7 +5312,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* No code in Emacs #includes config.h twice, but some bits of code
@@ -5347,7 +5366,7 @@ emacs_config_features=
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \
- XWIDGETS LIBSYSTEMD CANNOT_DUMP; do
+ XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do
case $opt in
CANNOT_DUMP) eval val=\${$opt} ;;
@@ -5380,7 +5399,8 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D
Does Emacs use a png library? ${HAVE_PNG} $LIBPNG
Does Emacs use -lrsvg-2? ${HAVE_RSVG}
Does Emacs use cairo? ${HAVE_CAIRO}
- Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}
+ Does Emacs use -llcms2? ${HAVE_LCMS2}
+ Does Emacs use imagemagick (version 6)? ${HAVE_IMAGEMAGICK}
Does Emacs support sound? ${HAVE_SOUND}
Does Emacs use -lgpm? ${HAVE_GPM}
Does Emacs use -ldbus? ${HAVE_DBUS}
@@ -5427,13 +5447,12 @@ to run if these resources are not installed."])
echo
fi
-if test "${opsys}" = "cygwin"; then
- case `uname -r` in
- 1.5.*) AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]])
+case $opsys,$emacs_uname_r in
+ cygwin,1.5.*)
+ AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]])
echo
;;
- esac
-fi
+esac
# Remove any trailing slashes in these variables.
case $prefix in
@@ -5547,6 +5566,12 @@ if test ! "$with_mailutils"; then
AC_MSG_WARN([This configuration installs a 'movemail' program
that retrieves POP3 email via only insecure channels.
To omit insecure POP3, you can use '$0 --without-pop'.])
+ elif test "$with_pop" = no-by-default; then
+ AC_MSG_WARN([This configuration installs a 'movemail' program
+that does not retrieve POP3 email. By default, Emacs 25 and earlier
+installed a 'movemail' program that retrieved POP3 email via only
+insecure channels, a practice that is no longer recommended but that
+you can continue to support by using '$0 --with-pop'.])
fi
case $opsys in
@@ -5558,7 +5583,7 @@ To omit insecure POP3, you can use '$0 --without-pop'.])
case `(movemail --version) 2>/dev/null` in
*Mailutils*) ;;
*) emacs_fix_movemail="install GNU Mailutils
-<http://mailutils.org> and $emacs_fix_movemail";;
+<https://mailutils.org> and $emacs_fix_movemail";;
esac
AC_MSG_NOTICE([You might want to $emacs_fix_movemail.]);;
esac
diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1
index 3c7aeb0c1d0..169a4b47932 100644
--- a/doc/emacs/ChangeLog.1
+++ b/doc/emacs/ChangeLog.1
@@ -1121,7 +1121,7 @@
Convert some TeX accents (e.g., '@l{}') to UTF-8 (e.g., 'ł').
Apparently the TeX accents cause problems when generating gnu.org
web pages, e.g., @l{} is rendered as '/l' on
- <http://www.gnu.org/software/emacs/manual/html_node/
+ <https://www.gnu.org/software/emacs/manual/html_node/
emacs/Acknowledgments.html>.
2013-03-16 Glenn Morris <rgm@gnu.org>
@@ -10934,4 +10934,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in
index ffcc4baafdd..61e870b80fb 100644
--- a/doc/emacs/Makefile.in
+++ b/doc/emacs/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
@@ -58,7 +58,7 @@ HTML_OPTS = --no-split --html
# Options used only when making info output.
# --no-split is only needed because of MS-DOS.
# For a possible alternative, see
-# http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg01182.html
+# https://lists.gnu.org/r/emacs-devel/2011-01/msg01182.html
INFO_OPTS= --no-split
INSTALL = @INSTALL@
diff --git a/doc/emacs/abbrevs.texi b/doc/emacs/abbrevs.texi
index 117d07e2814..5f400a2399a 100644
--- a/doc/emacs/abbrevs.texi
+++ b/doc/emacs/abbrevs.texi
@@ -62,8 +62,8 @@ definition for the current major mode overrides a global definition.
You can define abbrevs interactively during the editing session,
irrespective of whether Abbrev mode is enabled. You can also save
-lists of abbrev definitions in files, which you can the reload for use
-in later sessions.
+lists of abbrev definitions in files, which you can then reload for
+use in later sessions.
@node Defining Abbrevs
@section Defining Abbrevs
diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi
index 8f592ec87a5..7d8549c918f 100644
--- a/doc/emacs/ack.texi
+++ b/doc/emacs/ack.texi
@@ -285,7 +285,7 @@ Borgman, Baoqiu Cui, Dan Davison, Christian Egli, Eric S. Fraga, Daniel German,
Jackson, Martyn Jago, Thorsten Jolitz, Jambunathan K, Tokuya Kameshima, Sergey Litvinov, David Maus, Ross Patterson, Juan Pechiar, Sebastian Rose, Eric Schulte,
Paul Sexton, Ulf Stegemann, Andy Stewart, Christopher Suckling, David O'Toole, John Wiegley, Zhang Weize,
Piotr Zieliński, and others also wrote various Org mode components.
-For more information, @pxref{History and Acknowledgments,,, org, The Org Manual}.
+For more information, @pxref{History and acknowledgments,,, org, The Org Manual}.
@item
Scott Draves wrote @file{tq.el}, help functions for maintaining
@@ -1418,8 +1418,8 @@ zone out in front of Emacs.
Eli Zaretskii made many standard Emacs features work on MS-DOS and
Microsoft Windows. He also wrote @file{tty-colors.el}, which
implements transparent mapping of X colors to tty colors; and
-@file{rxvt.el}. He implemented support for bidirectional text,
-and also menus on text-mode terminals.
+@file{rxvt.el}. He implemented support for bidirectional text, menus
+on text-mode terminals, and built-in display of line numbers.
@item
Jamie Zawinski wrote much of the support for faces and X selections.
diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi
index 87cbe439e05..426c18b14e5 100644
--- a/doc/emacs/anti.texi
+++ b/doc/emacs/anti.texi
@@ -4,215 +4,167 @@
@c See file emacs.texi for copying conditions.
@node Antinews
-@appendix Emacs 24 Antinews
+@appendix Emacs 25 Antinews
@c Update the emacs.texi Antinews menu entry with the above version number.
For those users who live backwards in time, here is information
-about downgrading to Emacs version 24.5. We hope you will enjoy the
-greater simplicity that results from the absence of many Emacs
-@value{EMACSVER} features.
+about downgrading to Emacs version 25.2. We hope you will enjoy the
+greater simplicity that results from the absence of many @w{Emacs
+@value{EMACSVER}} features.
@itemize @bullet
@item
-Support for Cairo drawing has been removed. On GNU and Unix systems,
-you now have only one drawing engine---the venerable X Window system.
-No need to procrastinate on the dilemma whether you do or don't want
-the new shiny Cairo thing. Hail, simplicity!
-
-@item
-Emacs still works on SGI IRIX systems. If you live backwards in time,
-this is actually a bonus, as IRIX systems will become more and more
-popular as you move farther back in time.
-
-@item
-Support for dynamically loaded modules has been removed. You get to
-use only the trusted Emacs codebase, with no additions. Those
-external modules written by some J.R. Hacker cannot be trusted anyway.
-Good riddance!
-
-@item
-We have greatly simplified the Emacs features which access the network
-by removing the Network Security Manager. No more annoying prompts
-about trusting this or that site or page---you asked for it, you get
-it, no questions asked! You, the user, are now in charge of any
-security issues related to sites whose certificates expired or didn't
-exist in the first place. Giving the user the utmost freedom was and
-always will be the most important goal of Emacs development. We keep
-that goal even as we develop Emacs back in time.
-
-@item
-We made the output of @kbd{C-h l} much simpler and easier to grasp by
-removing the names of commands run by the recorded keystrokes. True
-Emacs lovers know their bindings by heart anyway, so why waste
-precious screen estate on that which is well known?
-
-@item
-Selection- and clipboard-related commands and variables got their
-historical names back. It's now the definitive
-@code{x-select-enable-clipboard} again instead of the vague
-@code{select-enable-clipboard}, and all those @code{gui-select-text},
-@code{gui-get-primary-selection}, etc.@: got their @code{x-*} names
-back. (What's a ``GUI'', anyway?) The only true window system with
-selections is the X Window system, so we stopped pretending that other
-platforms have anything similar to that. You now know when you invoke
-a command that accesses X.
-
-@item
-Passwords are no longer hidden when typed in @code{-batch} mode. It
-was a misfeature to have it not shown in the first place: who can type
-without seeing what they type? We couldn't convince the users of GUI
-sessions to give up hiding the password, so we at least made it
-visible in batch mode, which is something every veteran Emacs user
-uses all the time. Stay tuned for un-hiding the password in GUI
-sessions as well as we downgrade progressively to previous Emacs
-versions.
-
-@item
-The nuisance with Unicode characters popping up all over the place has
-been amply dealt with. We've removed @kbd{C-x 8} shorthands for
-characters such as ‘, ’, “, ”, €, ≤, and many others; as a nice
-benefit, this removes many useless entries at the beginning of the
-@kbd{C-h b} output. The @code{electric-quote-mode} has been deleted,
-so there's only the one true quoting method now---using the
-plain-@acronym{ASCII} quote characters. And if that's not enough, the
-doc strings and other messages show text quoted @t{`like this'}
-as they were written, instead of arbitrarily replacing them
-with Unicode ``curved quote'' characters @t{‘like this’}. The
-@code{text-quoting-style} variable becomes therefore unneeded and was
-removed. As result, text produced by Emacs can be sent to those
-venerable teletypes again, yeah!
-
-For the same reasons, the character classes @code{[:alpha:]} and
-@code{[:alnum:]} again match any word-constituent character, and
-@code{[:graph:]} and @code{[:print:]} match every multibyte character.
-Confusing use of Unicode character properties is gone.
-
-@item
-I-search and query-replace no longer try to confuse you by using the
-``character-folding'' magic. They will no longer find any characters
-you didn't actually type, like find @kbd{ⓐ} when you actually typed
-@kbd{a}. Users who want to find some fancy character will have to
-type it explicitly.
-
-@item
-The @file{desktop.el} package no longer records window and frame
-configuration, and doesn't attempt to restore them. You now have back
-your freedom of re-arranging your windows and frames anew each time
-you restore a session. This made the new backward-incompatible format
-of the @file{.emacs.desktop} file unnecessary, so the format was
-reverted back to what it was before Emacs 25. You can now again use
-the desktop file with all the previous versions of Emacs.
-
-@item
-We have reworked the Prettify Symbols mode to support only the default
-@code{prettify-symbols-compose-predicate}. No need to consider
-whether your major or minor mode needs its own prettifications; just
-use what came with Emacs. We also removed the
-@code{prettify-symbols-unprettify-at-point} option: once prettified,
-always prettified! These changes make the Prettify Symbols mode quite
-a lot simpler and easier to use.
+Emacs no longer defaults to requiring the GnuTLS library when you
+build it. Those who want the TLS functionality built-in will have to
+explicitly request it at build time---or forever hold their peace. We
+decided that having the TLS functionality doesn't justify annoying
+users or package builders with error messages about libgnutls absence.
+We also decided that if you do build with GnuTLS, we will allow
+versions of the library older than 2.12.2, as that version will become
+less and less available/popular as you move farther back in time.
@item
-Support for nifty new features of xterm, such as access to the X
-selection and the clipboard, the ``bracketed paste mode'', and other
-advanced capabilities has been removed. When you kill text in an
-xterm Emacs session, that text is only saved in the Emacs kill ring,
-without letting other applications have any way of accessing it. An
-xterm is just a text terminal, nothing more, nothing less. There
-should be no feature we support on xterm that isn't supported on bare
-console terminals. For the same reasons, support for mouse-tracking
-on xterm was removed. We will continue this line of simplifications
-as we downgrade to previous versions of Emacs; stay tuned.
+For similar reasons, we've reverted back to building our own version
+of @command{movemail} that retrieves POP3 mail as clear text via
+insecure channels. As you move back in time, the availability of
+secure alternatives to POP3 will diminish, and we are only keen to
+support that. We've also removed the @option{--with-mailutils}
+configure-time option, as it no longer makes sense for the observable
+past.
-@item
-Various features in @file{package.el} have been simplified. The
-``external'' package status is no longer available. A package present
-on multiple archives will now be listed as many times as it is found:
-we don't believe in concealing any information from the users. This
-and other similar simplifications made
-@code{package-menu-toggle-hiding} unnecessary, since there's nothing
-to unhide now.
-
-@item
-The @kbd{@key{UP}} and @kbd{@key{DOWN}} keys in the minibuffer have
-been simplified to move by history items. No need to wonder whether
-you have moved to the next/previous item or to another line within the
-same item. Well-written commands shouldn't allow too long history
-entries anyway; be sure to report any that do as bugs, so that we
-could fix them in past versions of Emacs.
-
-@item
-The VC mode was simplified by removing the support for ``push''
-commands. Moving back in time means you will have less and less need
-to use modern version control systems such as Git, Bazaar, and
-Mercurial, so the necessity of using ``push'' commands will gradually
-disappear. We removed it from Emacs in advance, so that you won't
-need to un-learn it when this command disappears, as it should.
-
-@item
-The support for full C/C++ expressions in macros has been removed from
-Hide-Ifdef mode. It now supports only the basic literal macros. As
-result, the user interface was simplified, and a number of useless
-commands have been removed from Hide-Ifdef mode. Further
-simplifications were made possible by removing support for some fancy
-new preprocessor directives, such as @code{#if defined}, @code{#elif},
-etc.
-
-@item
-We have reverted to Etags for looking up definitions of functions,
-variables, etc. Commands such as @kbd{M-.} use tags tables, as they
-always have. This allowed the removal of the entire @file{xref.el}
-package and its many metastases in the other Emacs packages and
-commands, significantly simplifying those. No more complexities with
-the various ``backends'' that provide incoherent behavior that is hard
-to explain and remember; either the symbol is in TAGS or it isn't. No
-more new user interfaces we never before saw in Emacs, either; if you
-want the next definition for the symbol you typed, just invoke
-@kbd{C-u M-.}---what could be simpler? As a nice side effect, you get
-to use your beloved @code{tags-loop-continue} and @code{pop-tag-mark}
-commands and their memorable bindings. The @file{package.el} package
-has been removed for similar reasons.
+@item
+We have removed support for @command{systemd} and similar services: we
+no longer provide a user init file for enabling Emacs support via
+those services, and we removed from the Emacs server the
+socket-launching support important for Emacs client operation under
+these services. Again, these services will lose popularity as you
+move back in time, so the code supporting them will be just dead code,
+bloating Emacs unnecessarily.
+
+@item
+Reproducible builds of Emacs are no longer supported, as past
+development will make that unnecessary.
+
+@item
+The @option{--fg-daemon} is gone, leaving only @option{--daemon}. No
+need to procrastinate on the dilemma whether you do or don't want the
+new shiny ``headless Emacs'' thingy. Hail, simplicity!
+
+@item
+As text terminals supporting true color will lose ground as you move
+back in time, we've removed support for 24-bit colors on text
+terminals. If you want colors on a text terminal, you should be fine
+with just 8 of them. (Truth being told, we think text terminals
+should be monochrome, but you will have to keep downgrading to older
+Emacs versions to have that feature back.)
+
+@item
+Emacs 25.2 no longer supports magic signatures of the form
+@samp{#!/usr/bin/env @var{interpreter}} in scripts. Moving back in
+time means you are getting closer to the ideal of the original Unix
+design where all the interpreters lived in a single directory
+@file{/bin}, so this fancy feature is simply becoming unnecessary
+ballast.
+
+@item
+The double-buffering feature of Emacs display on X has been removed.
+We decided that its complexity and a few random surprising
+side-effects aren't justified by the gains, even though those gains
+were hailed in some quarters. Yes, Emacs 25.2 will flicker in some
+use cases, but we are sure Emacs users will be able to suck it, a they
+have been doing for years. Since this feature is gone, we've also
+removed the @code{inhibit-double-buffering} frame parameter, which is
+now unnecessary.
+
+@item
+Non-breaking hyphens and ASCII characters displayed instead of
+unsupported quote characters are now again displayed using the
+@code{escape-glyph} face. We think having a single face instead of 3
+different ones will make Emacs customization a much simpler job for
+users. For the same reason, we've removed the
+@code{header-line-highlight} face, leaving just @code{highlight} for
+any element of the Emacs display besides the mode line.
+
+@item
+You can no longer disable attempts of recovery from fatal exceptions
+such as C stack overflows and fatal signals. Since the recovery
+included in Emacs is reliable enough, we decided there was no reason
+to put your edits in danger of becoming lost when these situations
+happen. The variables @code{'attempt-stack-overflow-recovery} and
+@code{attempt-orderly-shutdown-on-fatal-signal} are therefore removed.
+
+@item
+The @code{list-timers} command was removed, as we decided timers are
+not user-level feature, and therefore users should not be allowed to
+mess with them. Ask an Emacs Lisp guru near you for help if you have
+a runaway timer in your session. (Of course, as you move back in
+time, such runaway timers will become less and less frequent, and
+actually timers might start shutting down automatically, as they
+cannot cope with time reversal.)
+
+@item
+Horizontal scrolling using the mouse or touchpad has been removed. In
+the past, wide monitors will become less popular, so horizontal
+scrolling will no longer be needed. Removal of the mouse support for
+horizontal scrolling is the first step towards its complete removal in
+prior Emacs versions.
+
+@item
+We have found the @option{--tramp} option of @command{emacsclient} too
+risky and too complicated, so we removed it to simplify the client
+code and its usage.
+
+@item
+The @code{display-raw-bytes-as-hex} variable is gone, so raw bytes can
+only be displayed as octal escapes. Emacs users should be able to
+convert from octal to any other base in their sleep!
@item
-@code{(/ @var{n})} once again yields just @var{n}. Emacs Lisp is not
-Common Lisp, so compatibility with CL just complicates Emacs here.
+Displaying line numbers for a buffer is only possibly using add-on
+features, such as @code{linum-mode}, which can only display the
+numbers in the display margins. Line-number display using these
+features is also slow, as we firmly believe such a feature is
+un-Emacsy and should not have been included in Emacs to begin with.
+Consequently, @code{display-line-numbers-mode} was removed.
@item
-The functions @code{filepos-to-bufferpos} and
-@code{bufferpos-to-filepos} have been removed. Code that needs to
-find a file position by a buffer position or vice versa should adapt
-by reading the file with no conversions and counting bytes while
-comparing text. How hard can that be?
+On our permanent quest for simplifying Emacs, we've removed the
+support for passing command-line arguments and options to Emacs via
+the @option{--alternate-editor} option of @command{emacsclient} and
+@env{ALTERNATE_EDITOR} environment variable. There's only one True
+Emacs---the one that comes up when invoked as @kbd{emacs}, no need for
+all those fancy options!
@item
-We saw no need for the @code{make-process} primitive, so we removed
-it. The @code{start-process} primitive provides all the functionality
-one needs, so adding more APIs just confuses users.
+The complication known as ``single-line horizontal scrolling'' is no
+longer with you in Emacs 25.2. This feature was a bow to ``other
+editors''; instead, let those other editors bow to Emacs by hscrolling
+the entire window at all times. Repeat after me: ``The Emacs way is
+the Only Way!''
@item
-The functions @code{bidi-find-overridden-directionality} and
-@code{buffer-substring-with-bidi-context} were removed, in preparation
-for removing the whole bidi support when downgrading to Emacs 23.
+The fancy case conversions of non-ASCII characters used in several
+locales, like Turkish and Greek, are removed, leaving the relations
+between upper and lower letter-case simple again, as they were in
+7-bit ASCII. Likewise with ligatures that turn into multiple
+characters when their letter-case changes---gone.
@item
-Horizontal scroll bars are no longer supported. Enlarge your windows
-and frames instead, or use @code{truncate-lines} and the automatic
-horizontal scrolling of text that Emacs had since time immemorial.
+Enchant is no longer supported by @code{ispell-buffer} and similar
+spell-checking commands. As Enchant will gradually disappear while
+you move back in time, its support will become unnecessary anyway.
@item
-Emacs is again counting the height of a frame's menu and its tool bar
-in the frame's text height calculations. This makes Emacs invocation
-on different platforms and with different toolkits less predictable
-when frame geometry parameters are given on the Emacs command line,
-thus making Emacs more adventurous and less boring to use.
+Tramp lost its support for Google Drive repositories. Cloud storage
+is on its way to extinction as you move back in time, thus making this
+feature redundant.
@item
-The @command{etags} program no longer supports Ruby and Go languages.
-You won't need that as you progressively travel back in time towards
-the time before these languages were invented. We removed support for
-them in anticipation for that time.
+Several commands, deemed to be unnecessary complications, have been
+removed. Examples include @code{replace-buffer-contents} and
+@code{apropos-local-variable}.
@item
To keep up with decreasing computer memory capacity and disk space, many
-other functions and files have been eliminated in Emacs 24.5.
+other functions and files have been eliminated in Emacs 25.2.
@end itemize
diff --git a/doc/emacs/basic.texi b/doc/emacs/basic.texi
index 6b66c18016b..5878e7da256 100644
--- a/doc/emacs/basic.texi
+++ b/doc/emacs/basic.texi
@@ -630,7 +630,8 @@ Display the line number of point.
@item M-x line-number-mode
@itemx M-x column-number-mode
Toggle automatic display of the current line number or column number.
-@xref{Optional Mode Line}.
+@xref{Optional Mode Line}. If you want to have a line number
+displayed before each line, see @ref{Display Custom}.
@item M-=
Display the number of lines, words, and characters that are present in
diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi
index f3a3c8ef251..1a27fe877e0 100644
--- a/doc/emacs/buffers.texi
+++ b/doc/emacs/buffers.texi
@@ -98,7 +98,8 @@ related commands, use @dfn{permissive completion with confirmation} for
minibuffer completion: if you type @key{RET} immediately after
completing up to a nonexistent buffer name, Emacs prints
@samp{[Confirm]} and you must type a second @key{RET} to submit that
-buffer name. @xref{Completion Exit}, for details.
+buffer name. @xref{Completion Exit}, for details. For other
+completion options and features, see @ref{Completion Options}.
If you specify a buffer that does not exist, @kbd{C-x b} creates a
new, empty buffer that is not visiting any file, and selects it for
@@ -110,8 +111,8 @@ it, Emacs asks for the file name to use, and the buffer's major mode
is re-established taking that file name into account (@pxref{Choosing
Modes}).
-@kindex C-x @key{LEFT}
-@kindex C-x @key{RIGHT}
+@kindex C-x LEFT
+@kindex C-x RIGHT
@findex next-buffer
@findex previous-buffer
For conveniently switching between a few buffers, use the commands
@@ -173,10 +174,15 @@ List the existing buffers (@code{list-buffers}).
@cindex listing current buffers
@kindex C-x C-b
@findex list-buffers
- To display a list of existing buffers, type @kbd{C-x C-b}. Each
+ To display a list of existing buffers, type @kbd{C-x C-b}. This
+pops up a buffer menu in a buffer named @file{*Buffer List*}. Each
line in the list shows one buffer's name, size, major mode and visited file.
The buffers are listed in the order that they were current; the
-buffers that were current most recently come first.
+buffers that were current most recently come first. This section
+describes how the list of buffers is displayed and how to interpret
+the various indications in the list; see @ref{Several Buffers}, for
+description of the special mode in the @file{*Buffer List*} buffer and
+the commands available there.
@samp{.} in the first field of a line indicates that the buffer is
current. @samp{%} indicates a read-only buffer. @samp{*} indicates
@@ -699,13 +705,20 @@ Customization}).
@item M-x bs-show
Make a list of buffers similarly to @kbd{M-x list-buffers} but
customizable.
+@item M-x ibuffer
+Make a list of buffers and operate on them in Dired-like fashion.
@end table
+@findex bs-customize
@kbd{M-x bs-show} pops up a buffer list similar to the one normally
-displayed by @kbd{C-x C-b} but which you can customize. If you prefer
+displayed by @kbd{C-x C-b}, but whose display you can customize in a
+more flexible fashion. For example, you can specify the list of
+buffer attributes to show, the minimum and maximum width of buffer
+name column, a regexp for names of buffers that will never be shown
+and those which will always be shown, etc. If you prefer
this to the usual buffer list, you can bind this command to @kbd{C-x
C-b}. To customize this buffer list, use the @code{bs} Custom group
-(@pxref{Easy Customization}).
+(@pxref{Easy Customization}), or invoke @kbd{bs-customize}.
@findex msb-mode
@cindex mode, MSB
@@ -718,3 +731,8 @@ prefer. It replaces the bindings of @code{mouse-buffer-menu},
normally on @kbd{C-Down-mouse-1} and @kbd{C-@key{F10}}, and the menu
bar buffer menu. You can customize the menu in the @code{msb} Custom
group.
+
+@findex ibuffer
+ IBuffer is a major mode for viewing a list of buffers and operating
+on them in a way analogous to that of Dired (@pxref{Dired}), including
+filtering, marking, sorting in various ways, and acting on buffers.
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index f7eb8fe9eaf..87ac61bac3b 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -90,6 +90,10 @@ inserted above point, which remains at the end. Otherwise, point
remains fixed while compilation output is added at the end of the
buffer.
+ While compilation proceeds, the mode line is updated to show the
+number of errors, warnings, and informational messages that have been
+seen so far.
+
@cindex compilation buffer, keeping point at end
@vindex compilation-scroll-output
If you change the variable @code{compilation-scroll-output} to a
@@ -1385,7 +1389,7 @@ Loading,,, elisp, the Emacs Lisp Reference Manual}.
@vindex load-path
The Emacs Lisp load path is specified by the variable
-@code{load-path}. Its value should be a list of directory names
+@code{load-path}. Its value should be a list of directories
(strings). These directories are searched, in the specified order, by
the @kbd{M-x load-library} command, the lower-level @code{load}
function, and other Emacs functions that find Emacs Lisp libraries. A
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 0b1a400b364..618a05d451b 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -92,7 +92,7 @@ arguments.)
@itemx --visit=@var{file}
@cindex visiting files, command-line argument
@vindex inhibit-startup-buffer-menu
-Visit @var{file} using @code{find-file}. @xref{Visiting}.
+Visit the specified @var{file}. @xref{Visiting}.
When Emacs starts up, it displays the startup buffer in one window,
and the buffer visiting @var{file} in another window
@@ -111,12 +111,12 @@ Buffer Menu for this, change the variable
@item +@var{linenum} @var{file}
@opindex +@var{linenum}
-Visit @var{file} using @code{find-file}, then go to line number
-@var{linenum} in it.
+Visit the specified @var{file}, then go to line number @var{linenum}
+in it.
@item +@var{linenum}:@var{columnnum} @var{file}
-Visit @var{file} using @code{find-file}, then go to line number
-@var{linenum} and put point at column number @var{columnnum}.
+Visit the specified @var{file}, then go to line number @var{linenum}
+and put point at column number @var{columnnum}.
@item -l @var{file}
@opindex -l
@@ -365,6 +365,14 @@ own@footnote{This option has no effect on MS-Windows.}.
Enable the Emacs Lisp debugger for errors in the init file.
@xref{Error Debugging,, Entering the Debugger on an Error, elisp, The
GNU Emacs Lisp Reference Manual}.
+
+@item --module-assertions
+@opindex --module-assertions
+@cindex module verification
+Enable expensive correctness checks when dealing with dynamically
+loadable modules. This is intended for module authors that wish to
+verify that their module conforms to the module API requirements. The
+option makes Emacs abort if a module-related assertion triggers.
@end table
@node Command Example
@@ -458,7 +466,7 @@ variables to be set, but it uses their values if they are set.
@item CDPATH
@vindex CDPATH, environment variable
Used by the @code{cd} command to search for the directory you specify,
-when you specify a relative directory name.
+when you specify a relative directory,
@item DBUS_SESSION_BUS_ADDRESS
@vindex DBUS_SESSION_BUS_ADDRESS, environment variable
Used by D-Bus when Emacs is compiled with it. Usually, there is no
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index c84f4a975d8..3e17696342f 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -587,7 +587,7 @@ too.)
@vindex custom-theme-load-path
If you want Emacs to look for Custom themes in some other directory,
-add the directory name to the list variable
+add the directory to the list variable
@code{custom-theme-load-path}. Its default value is
@code{(custom-theme-directory t)}; here, the symbol
@code{custom-theme-directory} has the special meaning of the value of
@@ -1321,7 +1321,7 @@ Each alist entry consists of a variable name and the directory-local
value to assign to that variable, when the specified major mode is
enabled. Instead of a mode name, you can specify @samp{nil}, which
means that the alist applies to any mode; or you can specify a
-subdirectory name (a string), in which case the alist applies to all
+subdirectory (a string), in which case the alist applies to all
files in that subdirectory.
Here's an example of a @file{.dir-locals.el} file:
@@ -1356,7 +1356,7 @@ Variables}.
@findex copy-file-locals-to-dir-locals
Instead of editing the @file{.dir-locals.el} file by hand, you can
use the command @kbd{M-x add-dir-local-variable}. This prompts for a
-mode or subdirectory name, and for variable and value, and adds the
+mode or subdirectory, and for variable and value, and adds the
entry defining the directory-local variable. @kbd{M-x
delete-dir-local-variable} deletes an entry. @kbd{M-x
copy-file-locals-to-dir-locals} copies the file-local variables in the
@@ -1701,7 +1701,7 @@ and mouse events:
(global-set-key (kbd "C-c y") 'clipboard-yank)
(global-set-key (kbd "C-M-q") 'query-replace)
(global-set-key (kbd "<f5>") 'flyspell-mode)
-(global-set-key (kbd "C-<f5>") 'linum-mode)
+(global-set-key (kbd "C-<f5>") 'display-line-numbers-mode)
(global-set-key (kbd "C-<right>") 'forward-sentence)
(global-set-key (kbd "<mouse-2>") 'mouse-save-then-kill)
@end example
@@ -1710,7 +1710,7 @@ and mouse events:
specify the key sequence. Using a string is simpler, but only works
for @acronym{ASCII} characters and Meta-modified @acronym{ASCII}
characters. For example, here's how to bind @kbd{C-x M-l} to
-@code{make-symbolic-link} (@pxref{Misc File Ops}):
+@code{make-symbolic-link} (@pxref{Copying and Naming}):
@example
(global-set-key "\C-x\M-l" 'make-symbolic-link)
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index 22b0fcd4676..9348ef5042d 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -61,16 +61,28 @@ you to operate on the listed files. @xref{Directories}.
@kindex C-x d
@vindex dired-listing-switches
To invoke Dired, type @kbd{C-x d} (@code{dired}). This reads a
-directory name using the minibuffer, and opens a @dfn{Dired buffer}
+directory's name using the minibuffer, and opens a @dfn{Dired buffer}
listing the files in that directory. You can also supply a wildcard
file name pattern as the minibuffer argument, in which case the Dired
-buffer lists all files matching that pattern. The usual history and
-completion commands can be used in the minibuffer; in particular,
-@kbd{M-n} puts the name of the visited file (if any) in the minibuffer
-(@pxref{Minibuffer History}).
+buffer lists all files matching that pattern. A wildcard may appear
+in the directory part as well.
+For instance,
+
+@example
+C-x d ~/foo/*.el @key{RET}
+C-x d ~/foo/*/*.el @key{RET}
+@end example
+
+The former lists all the files with extension @samp{.el} in directory
+@samp{foo}. The latter lists the files with extension @samp{.el}
+in subdirectories 2 levels of depth below @samp{foo}.
+
+The usual history and completion commands can be used in the minibuffer;
+in particular, @kbd{M-n} puts the name of the visited file (if any) in
+the minibuffer (@pxref{Minibuffer History}).
You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file})
-a directory name.
+a directory's name.
The variable @code{dired-listing-switches} specifies the options to
give to @command{ls} for listing the directory; this string
@@ -224,6 +236,14 @@ Dired cannot delete directories that are nonempty. If the variable
@code{dired-recursive-deletes} is non-@code{nil}, then Dired can
delete nonempty directories including all their contents. That can
be somewhat risky.
+Even if you have set @code{dired-recursive-deletes} to @code{nil},
+you might want sometimes to delete recursively directories
+without being asked for confirmation for all of them. This is handy
+when you have marked many directories for deletion and you are very
+sure that all of them can safely being deleted. For every nonempty
+directory you are asked for confirmation; if you answer @code{all},
+then all the remaining directories will be deleted without more
+questions.
@vindex delete-by-moving-to-trash
If you change the variable @code{delete-by-moving-to-trash} to
@@ -627,6 +647,14 @@ Copy the specified files (@code{dired-do-copy}). The argument @var{new}
is the directory to copy into, or (if copying a single file) the new
name. This is like the shell command @code{cp}.
+@vindex dired-create-destination-dirs
+The option @code{dired-create-destination-dirs} controls whether Dired
+should create non-existent directories in the destination while
+copying/renaming files. The default value @code{nil} means Dired
+never creates such missing directories; the value @code{always},
+means Dired automatically creates them; the value @code{ask}
+means Dired asks you for confirmation before creating them.
+
@vindex dired-copy-preserve-time
If @code{dired-copy-preserve-time} is non-@code{nil}, then copying
with this command preserves the modification time of the old file in
@@ -658,6 +686,9 @@ single file, the argument @var{new} is the new name of the file. If
you rename several files, the argument @var{new} is the directory into
which to move the files (this is like the shell command @command{mv}).
+The option @code{dired-create-destination-dirs} controls whether Dired
+should create non-existent directories in @var{new}.
+
Dired automatically changes the visited file name of buffers associated
with renamed files so that they refer to the new names.
@@ -875,27 +906,33 @@ treat it specially.
@item
Otherwise, if the command string contains @samp{?} surrounded by
-whitespace, Emacs runs the shell command once @emph{for each file},
-substituting the current file name for @samp{?} each time. You can
-use @samp{?} more than once in the command; the same file name
-replaces each occurrence.
+whitespace or @samp{`?`}, Emacs runs the shell command once
+@emph{for each file}, substituting the current file name for @samp{?}
+and @samp{`?`} each time. You can use both @samp{?} or @samp{`?`} more
+than once in the command; the same file name replaces each occurrence.
+If you mix them with @samp{*} the command signals an error.
@item
-If the command string contains neither @samp{*} nor @samp{?}, Emacs
-runs the shell command once for each file, adding the file name at the
+If the command string contains neither @samp{*} nor @samp{?} nor @samp{`?`},
+Emacs runs the shell command once for each file, adding the file name at the
end. For example, @kbd{! uudecode @key{RET}} runs @code{uudecode} on
each file.
@end itemize
- To iterate over the file names in a more complicated fashion, use an
-explicit shell loop. For example, here is how to uuencode each file,
-making the output file name by appending @samp{.uu} to the input file
-name:
+ To iterate over the file names in a more complicated fashion, you might
+prefer to use an explicit shell loop. For example, here is how to uuencode
+each file, making the output file name by appending @samp{.uu} to the input
+file name:
@example
for file in * ; do uuencode "$file" "$file" >"$file".uu; done
@end example
+The same example with @samp{`?`} notation:
+@example
+uuencode ? ? > `?`.uu
+@end example
+
The @kbd{!} and @kbd{&} commands do not attempt to update the Dired
buffer to show new or modified files, because they don't know what
files will be changed. Use the @kbd{g} command to update the Dired
@@ -1109,7 +1146,7 @@ parent directory.
@findex dired-next-dirline
@kindex > @r{(Dired)}
@item >
-Move down to the next directory-file line (@code{dired-prev-dirline}).
+Move down to the next directory-file line (@code{dired-next-dirline}).
@end table
@node Hiding Subdirectories
@@ -1407,7 +1444,7 @@ rotation is lossless, and uses an external utility called JpegTRAN.
@kindex + @r{(Dired)}
@findex dired-create-directory
The command @kbd{+} (@code{dired-create-directory}) reads a
-directory name, and creates that directory. It signals an error if
+directory's name, and creates that directory. It signals an error if
the directory already exists.
@cindex searching multiple files via Dired
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index c4554eb3187..5860bacb9d8 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -711,6 +711,12 @@ Similar to @code{mode-line} for a window's header line, which appears
at the top of a window just as the mode line appears at the bottom.
Most windows do not have a header line---only some special modes, such
Info mode, create one.
+@item header-line-highlight
+@cindex header-line-highlight face
+Similar to @code{highlight} and @code{mode-line-highlight}, but used
+for mouse-sensitive portions of text on header lines. This is a
+separate face because the @code{header-line} face might be customized
+in a way that does not interact well with @code{highlight}.
@item vertical-border
@cindex vertical-border face
This face is used for the vertical divider between windows on text
@@ -1333,7 +1339,7 @@ characters in the buffer, which means that @samp{k} for 10^3, @samp{M}
for 10^6, @samp{G} for 10^9, etc., are used to abbreviate.
@cindex line number display
-@cindex display of line number
+@cindex display of current line number
@findex line-number-mode
The current line number of point appears in the mode line when Line
Number mode is enabled. Use the command @kbd{M-x line-number-mode} to
@@ -1542,11 +1548,20 @@ for details.
@cindex curly quotes
@cindex curved quotes
@cindex homoglyph face
+
+Emacs tries to determine if the curved quotes @samp{‘} and @samp{’}
+can be displayed on the current display. By default, if this seems to
+be so, then Emacs will translate the @acronym{ASCII} quotes (@samp{`}
+and @samp{'}), when they appear in messages and help texts, to these
+curved quotes. You can influence or inhibit this translation by
+customizing the user option @code{text-quoting-style} (@pxref{Keys in
+Documentation,,, elisp, The Emacs Lisp Reference Manual}).
+
If the curved quotes @samp{‘}, @samp{’}, @samp{“}, and @samp{”} are
known to look just like @acronym{ASCII} characters, they are shown
-with the @code{homoglyph} face. Curved quotes that cannot be
-displayed are shown as their @acronym{ASCII} approximations @samp{`},
-@samp{'}, and @samp{"} with the @code{homoglyph} face.
+with the @code{homoglyph} face. Curved quotes that are known not to
+be displayable are shown as their @acronym{ASCII} approximations
+@samp{`}, @samp{'}, and @samp{"} with the @code{homoglyph} face.
@node Cursor Display
@section Displaying the Cursor
@@ -1710,6 +1725,86 @@ variable @code{visual-line-fringe-indicators}.
This section describes variables that control miscellaneous aspects
of the appearance of the Emacs screen. Beginning users can skip it.
+@vindex display-line-numbers
+@cindex number lines in a buffer
+@cindex display line numbers
+ If you want to have Emacs display line numbers for every line in the
+buffer, customize the buffer-local variable
+@code{display-line-numbers}; it is @code{nil} by default. This
+variable can have several different values to support various modes of
+line-number display:
+
+@table @asis
+@item @code{t}
+Display (an absolute) line number before each non-continuation screen
+line that displays buffer text. If the line is a continuation line,
+or if the entire screen line displays a display or an overlay string,
+that line will not be numbered.
+
+@item @code{relative}
+Display relative line numbers before non-continuation lines which show
+buffer text. The line numbers are relative to the line showing point,
+so the numbers grow both up and down as lines become farther from the
+current line.
+
+@item @code{visual}
+This value causes Emacs to count lines visually: only lines actually
+shown on the display will be counted (disregarding any lines in
+invisible parts of text), and lines which wrap to consume more than
+one screen line will be numbered that many times. The displayed
+numbers are relative, as with @code{relative} value above. This is
+handy in modes that fold text, such as Outline mode (@pxref{Outline
+Mode}), and when you need to move by exact number of screen lines.
+
+@item anything else
+Any other non-@code{nil} value is treated as @code{t}.
+@end table
+
+@findex display-line-numbers-mode
+@findex global-display-line-numbers-mode
+@vindex display-line-numbers-type
+A convenient way of turning on display of line numbers is @w{@kbd{M-x
+display-line-numbers-mode @key{RET}}}. This mode has a globalized
+variant, @code{global-display-line-numbers-mode}. The user option
+@code{display-line-numbers-type} controls which sub-mode of
+line-number display, described above, will these modes activate.
+
+@vindex display-line-numbers-current-absolute
+When Emacs displays relative line numbers, you can control the number
+displayed before the current line, the line showing point. By
+default, Emacs displays the absolute number of the current line there,
+even though all the other line numbers are relative. If you customize
+the variable @code{display-line-numbers-current-absolute} to a
+@code{nil} value, the number displayed for the current line will be
+zero. This is handy if you don't care about the number of the current
+line, and want to leave more horizontal space for text in large
+buffers.
+
+@vindex display-line-numbers-widen
+In a narrowed buffer (@pxref{Narrowing}) lines are normally numbered
+starting at the beginning of the narrowing. However, if you customize
+the variable @code{display-line-numbers-widen} to a non-@code{nil}
+value, line numbers will disregard any narrowing and will start at the
+first character of the buffer.
+
+@vindex display-line-numbers-width-start
+@vindex display-line-numbers-grow-only
+@vindex display-line-numbers-width
+In selective display mode (@pxref{Selective Display}), and other modes
+that hide many lines from display (such as Outline and Org modes), you
+may wish to customize the variables
+@code{display-line-numbers-width-start} and
+@code{display-line-numbers-grow-only}, or set
+@code{display-line-numbers-width} to a large enough value, to avoid
+occasional miscalculations of space reserved for the line numbers.
+
+@cindex line-number face
+The line numbers are displayed in a special face @code{line-number}.
+The current line number is displayed in a different face,
+@code{line-number-current-line}, so you can make the current line's
+number have a distinct appearance, which will help locating the line
+showing point.
+
@vindex visible-bell
If the variable @code{visible-bell} is non-@code{nil}, Emacs attempts
to make the whole screen blink when it would normally make an audible bell
diff --git a/doc/emacs/doclicense.texi b/doc/emacs/doclicense.texi
index 9c3bbe56e91..eaf3da0e92d 100644
--- a/doc/emacs/doclicense.texi
+++ b/doc/emacs/doclicense.texi
@@ -6,7 +6,7 @@
@display
Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
-@uref{http://fsf.org/}
+@uref{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -414,7 +414,7 @@ The Free Software Foundation may publish new, revised versions
of the GNU Free Documentation License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
+@uref{https://www.gnu.org/licenses/}.
Each version of the License is given a distinguishing version number.
If the Document specifies that a particular numbered version of this
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index a3eb4225a75..2c3312d7a83 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -118,11 +118,11 @@ some of the ways to customize it; it corresponds to GNU Emacs version
@ifset WWW_GNU_ORG
@html
The homepage for GNU Emacs is at
-<a href="/software/emacs/">http://www.gnu.org/software/emacs/</a>.<br>
+<a href="/software/emacs/">https://www.gnu.org/software/emacs/</a>.<br>
To view this manual in other formats, click
<a href="/software/emacs/manual/emacs.html">here</a>.<br>
You can also purchase a printed copy from the
-<a href="http://shop.fsf.org/product/emacs-manual/">FSF store</a>.
+<a href="https://shop.fsf.org/product/emacs-manual/">FSF store</a>.
@end html
@end ifset
@@ -222,7 +222,7 @@ Appendices
* GNU Free Documentation License:: The license for this documentation.
* Emacs Invocation:: Hairy startup options.
* X Resources:: X resources for customizing Emacs.
-* Antinews:: Information about Emacs version 24.
+* Antinews:: Information about Emacs version 25.
* Mac OS / GNUstep:: Using Emacs under Mac OS and GNUstep.
* Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS.
* Manifesto:: What's GNU? Gnu's Not Unix!
@@ -453,6 +453,7 @@ File Handling
* Directories:: Creating, deleting, and listing file directories.
* Comparing Files:: Finding where two files differ.
* Diff Mode:: Mode for editing file differences.
+* Copying and Naming:: Copying, naming and renaming files.
* Misc File Ops:: Other things you can do on files.
* Compressed Files:: Accessing compressed files.
* File Archives:: Operating on tar, zip, jar etc. archive files.
@@ -1313,7 +1314,7 @@ Emacs editors, all sharing common principles of organization. For
information on the underlying philosophy of Emacs and the lessons
learned from its development, see @cite{Emacs, the Extensible,
Customizable Self-Documenting Display Editor}, available from
-@url{ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-519A.pdf}.
+@url{http://hdl.handle.net/1721.1/5736}.
This version of the manual is mainly intended for use with GNU Emacs
installed on GNU and Unix systems. GNU Emacs can also be used on
@@ -1347,7 +1348,7 @@ One way to get a copy of GNU Emacs is from someone else who has it.
You need not ask for our permission to do so, or tell any one else;
just copy it. If you have access to the Internet, you can get the
latest distribution version of GNU Emacs by anonymous FTP; see
-@url{http://www.gnu.org/software/emacs} on our website for more
+@url{https://www.gnu.org/software/emacs} on our website for more
information.
You may also receive GNU Emacs when you buy a computer. Computer
@@ -1364,19 +1365,19 @@ Software Foundation are tax deductible in the US@. If you use GNU Emacs
at your workplace, please suggest that the company make a donation.
To donate, see @url{https://my.fsf.org/donate/}.
For other ways in which you can help, see
-@url{http://www.gnu.org/help/help.html}.
+@url{https://www.gnu.org/help/help.html}.
@c The command view-order-manuals uses this anchor.
@anchor{Printed Books}
We also sell hardcopy versions of this manual and @cite{An
Introduction to Programming in Emacs Lisp}, by Robert J. Chassell.
-You can visit our online store at @url{http://shop.fsf.org/}.
+You can visit our online store at @url{https://shop.fsf.org/}.
The income from sales goes to support the foundation's purpose: the
development of new free software, and improvements to our existing
programs including GNU Emacs.
If you need to contact the Free Software Foundation, see
-@url{http://www.fsf.org/about/contact/}, or write to
+@url{https://www.fsf.org/about/contact/}, or write to
@display
Free Software Foundation
@@ -1400,8 +1401,8 @@ Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Stephen Berman, Karl
Berry, Anna M. Bigatti, Ray Blaak, Martin Blais, Jim Blandy, Johan
Bockgård, Jan Böcker, Joel Boehland, Lennart Borgman, Per Bothner,
Terrence Brannon, Frank Bresz, Peter Breton, Emmanuel Briot, Kevin
-Broadey, Vincent Broman, Michael Brouwer, David M. Brown, Stefan Bruda,
-Georges Brun-Cottan, Joe Buehler, Scott Byer, Włodek Bzyl,
+Broadey, Vincent Broman, Michael Brouwer, David M. Brown, Ken Brown, Stefan Bruda,
+Georges Brun-Cottan, Joe Buehler, Scott Byer, Włodek Bzyl, Tino Calancha,
Bill Carpenter, Per Cederqvist, Hans Chalupsky, Chris Chase, Bob
Chassell, Andrew Choi, Chong Yidong, Sacha Chua, Stewart Clamen, James
Clark, Mike Clarkson, Glynn Clements, Andrew Cohen, Daniel Colascione,
@@ -1443,7 +1444,7 @@ Limpach, Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link,
Juri Linkov, Francis Litterio, Sergey Litvinov, Leo Liu, Emilio C. Lopes,
Martin Lorentzon, Dave Love, Eric Ludlam, Károly Lőrentey, Sascha
Lüdecke, Greg McGary, Roland McGrath, Michael McNamara, Alan Mackenzie,
-Christopher J. Madsen, Neil M. Mager, Ken Manheimer, Bill Mann,
+Christopher J. Madsen, Neil M. Mager, Artur Malabarba, Ken Manheimer, Bill Mann,
Brian Marick, Simon Marshall, Bengt Martensson, Charlie Martin,
Yukihiro Matsumoto, Tomohiro Matsuyama, David Maus, Thomas May, Will Mengarini, David
Megginson, Stefan Merten, Ben A. Mesander, Wayne Mesard, Brad
@@ -1454,11 +1455,11 @@ Gergely Nagy, Nobuyoshi Nakada, Thomas Neumann, Mike Newton, Thien-Thi Nguyen,
Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Nikšić, Jeff Norden,
Andrew Norman, Theresa O'Connor, Kentaro Ohkouchi, Christian Ohler,
Kenichi Okada, Alexandre Oliva, Bob Olson, Michael Olson, Takaaki Ota,
-Pieter E. J. Pareit, Ross Patterson, David Pearson, Juan Pechiar,
+Mark Oteiza, Pieter E. J. Pareit, Ross Patterson, David Pearson, Juan Pechiar,
Jeff Peck, Damon Anton Permezel, Tom Perrine, William M. Perry, Per
-Persson, Jens Petersen, Daniel Pfeiffer, Justus Piater, Richard L.
+Persson, Jens Petersen, Nicolas Petton, Daniel Pfeiffer, Justus Piater, Richard L.
Pieri, Fred Pierresteguy, François Pinard, Daniel Pittman, Christian
-Plaunt, Alexander Pohoyda, David Ponce, Francesco A. Potortì,
+Plaunt, Alexander Pohoyda, David Ponce, Noam Postavsky, Francesco A. Potortì,
Michael D. Prange, Mukesh Prasad, Ken Raeburn, Marko Rahamaa, Ashwin
Ram, Eric S. Raymond, Paul Reilly, Edward M. Reingold, David
Reitter, Alex Rezinsky, Rob Riepel, Lara Rios, Adrian Robert, Nick
@@ -1475,7 +1476,7 @@ Stanislav Shalunov, Marc Shapiro, Richard Sharman, Olin Shivers, Tibor
Šimko, Espen Skoglund, Rick Sladkey, Lynn Slater, Chris Smith,
David Smith, Paul D. Smith, Wilson Snyder, William Sommerfeld, Simon
South, Andre Spiegel, Michael Staats, Thomas Steffen, Ulf Stegemann,
-Reiner Steib, Sam Steingold, Ake Stenhoff, Peter Stephenson, Ken
+Reiner Steib, Sam Steingold, Ake Stenhoff, Philipp Stephani, Peter Stephenson, Ken
Stevens, Andy Stewart, Jonathan Stigelman, Martin Stjernholm, Kim F.
Storm, Steve Strassmann, Christopher Suckling, Olaf Sylvester, Naoto
Takahashi, Steven Tamm, Jan Tatarik, Luc Teirlinck, Jean-Philippe Theberge, Jens
@@ -1502,7 +1503,7 @@ Neal Ziring, Teodor Zlatanov, and Detlev Zundel.
advanced, self-documenting, customizable, extensible editor Emacs.
(The @samp{G} in
@c Workaround makeinfo 4 bug.
-@c http://lists.gnu.org/archive/html/bug-texinfo/2004-08/msg00009.html
+@c https://lists.gnu.org/r/bug-texinfo/2004-08/msg00009.html
@iftex
@acronym{GNU, @acronym{GNU}'s Not Unix}
@end iftex
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi
index 0b4e8eda2a7..dc59e13e081 100644
--- a/doc/emacs/files.texi
+++ b/doc/emacs/files.texi
@@ -33,6 +33,7 @@ on file directories.
* Directories:: Creating, deleting, and listing file directories.
* Comparing Files:: Finding where two files differ.
* Diff Mode:: Mode for editing file differences.
+* Copying and Naming:: Copying, naming and renaming files.
* Misc File Ops:: Other things you can do on files.
* Compressed Files:: Accessing compressed files.
* File Archives:: Operating on tar, zip, jar etc. archive files.
@@ -62,6 +63,9 @@ completing up to a nonexistent file name, Emacs prints
@samp{[Confirm]} and you must type a second @key{RET} to confirm.
@xref{Completion Exit}, for details.
+Minibuffer history commands offer some special features for reading
+file names, see @ref{Minibuffer History}.
+
@cindex default directory
@vindex default-directory
@vindex insert-default-directory
@@ -83,7 +87,7 @@ buffer that is not visiting a file, via a command like @kbd{C-x b},
its default directory is usually copied from the buffer that was
current at the time (@pxref{Select Buffer}). You can use the command
@kbd{M-x pwd} to see the value of @code{default-directory} in the
-current buffer. The command @kbd{M-x cd} prompts for a directory
+current buffer. The command @kbd{M-x cd} prompts for a directory's
name, and sets the buffer's @code{default-directory} to that directory
(doing this does not change the buffer's file name, if any).
@@ -1278,15 +1282,10 @@ default), and @code{list-directory-verbose-switches} is a string
giving the switches to use in a verbose listing (@code{"-l"} by
default).
-@vindex directory-free-space-program
-@vindex directory-free-space-args
In verbose directory listings, Emacs adds information about the
-amount of free space on the disk that contains the directory. To do
-this, it runs the program specified by
-@code{directory-free-space-program} with arguments
-@code{directory-free-space-args}.
+amount of free space on the disk that contains the directory.
- The command @kbd{M-x delete-directory} prompts for a directory name
+ The command @kbd{M-x delete-directory} prompts for a directory's name
using the minibuffer, and deletes the directory if it is empty. If
the directory is not empty, you will be asked whether you want to
delete it recursively. On systems that have a ``Trash'' (or ``Recycle
@@ -1545,6 +1544,76 @@ decide whether to save the changes (the list of modified files is
displayed in the echo area). With a prefix argument, it tries to
modify the original source files rather than the patched source files.
+@node Copying and Naming
+@section Copying, Naming and Renaming Files
+
+ Emacs has several commands for copying, naming, and renaming files.
+All of them read two file names @var{old} and @var{new} using the
+minibuffer, and then copy or adjust a file's name accordingly; they do
+not accept wildcard file names.
+
+In all these commands, if the argument @var{new} is just a directory
+name, the real new name is in that directory, with the same
+non-directory component as @var{old}. For example, the command
+@w{@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp/ @key{RET}}}
+renames @file{~/foo} to @file{/tmp/foo}. On GNU and other POSIX-like
+systems, directory names end in @samp{/}. @xref{Directory Names,,,
+elisp, the Emacs Lisp Reference Manual}.
+
+All these commands ask for confirmation when the new file name already
+exists.
+
+@findex copy-file
+@cindex copying files
+ @kbd{M-x copy-file} copies the contents of the file @var{old} to the
+file @var{new}.
+
+@findex copy-directory
+ @kbd{M-x copy-directory} copies directories, similar to the
+@command{cp -r} shell command. If @var{new} is a directory name, it
+creates a copy of the @var{old} directory and puts it in @var{new}.
+Otherwise it copies all the contents of @var{old} into a new directory
+named @var{new}.
+
+@cindex renaming files
+@findex rename-file
+ @kbd{M-x rename-file} renames file @var{old} as @var{new}. If the
+file name @var{new} already exists, you must confirm with @kbd{yes} or
+renaming is not done; this is because renaming causes the old meaning
+of the name @var{new} to be lost. If @var{old} and @var{new} are on
+different file systems, the file @var{old} is copied and deleted.
+
+@ifnottex
+ If a file is under version control (@pxref{Version Control}), you
+should rename it using @w{@kbd{M-x vc-rename-file}} instead of
+@w{@kbd{M-x rename-file}}. @xref{VC Delete/Rename}.
+@end ifnottex
+
+@findex add-name-to-file
+@cindex hard links (creation)
+ @kbd{M-x add-name-to-file} adds an additional name to an existing
+file without removing the old name. The new name is created as a hard
+link to the existing file. The new name must belong on the same file
+system that the file is on. On MS-Windows, this command works only if
+the file resides in an NTFS file system. On MS-DOS, and some remote
+system types, it works by copying the file.
+
+@findex make-symbolic-link
+@cindex symbolic links (creation)
+ @kbd{M-x make-symbolic-link} creates a symbolic link named
+@var{new}, which points at @var{target}. The effect is that future
+attempts to open file @var{new} will refer to whatever file is named
+@var{target} at the time the opening is done, or will get an error if
+the name @var{target} is nonexistent at that time. This command does
+not expand the argument @var{target}, so that it allows you to specify
+a relative name as the target of the link. However, this command
+does expand leading @samp{~} in @var{target} so that you can easily
+specify home directories, and strips leading @samp{/:} so that you can
+specify relative names beginning with literal @samp{~} or @samp{/:}.
+@xref{Quoted File Names}. On MS-Windows, this command works only on
+MS Windows Vista and later. When @var{new} is remote,
+it works depending on the system type.
+
@node Misc File Ops
@section Miscellaneous File Operations
@@ -1581,62 +1650,6 @@ should delete it using @kbd{M-x vc-delete-file} instead of @kbd{M-x
delete-file}. @xref{VC Delete/Rename}.
@end ifnottex
-@findex copy-file
-@cindex copying files
- @kbd{M-x copy-file} copies the contents of the file @var{old} to the
-file @var{new}.
-
-@findex copy-directory
- @kbd{M-x copy-directory} copies directories, similar to the
-@command{cp -r} shell command. It prompts for a directory @var{old}
-and a destination @var{new}. If @var{new} is an existing directory,
-it creates a copy of the @var{old} directory and puts it in @var{new}.
-If @var{new} is not an existing directory, it copies all the contents
-of @var{old} into a new directory named @var{new}.
-
-@cindex renaming files
-@findex rename-file
- @kbd{M-x rename-file} reads two file names @var{old} and @var{new}
-using the minibuffer, then renames file @var{old} as @var{new}. If
-the file name @var{new} already exists, you must confirm with
-@kbd{yes} or renaming is not done; this is because renaming causes the
-old meaning of the name @var{new} to be lost. If @var{old} and
-@var{new} are on different file systems, the file @var{old} is copied
-and deleted. If the argument @var{new} is just a directory name, the
-real new name is in that directory, with the same non-directory
-component as @var{old}. For example, @kbd{M-x rename-file @key{RET}
-~/foo @key{RET} /tmp @key{RET}} renames @file{~/foo} to
-@file{/tmp/foo}. The same rule applies to all the remaining commands
-in this section. All of them ask for confirmation when the new file
-name already exists, too.
-
-@ifnottex
- If a file is under version control (@pxref{Version Control}), you
-should rename it using @kbd{M-x vc-rename-file} instead of @kbd{M-x
-rename-file}. @xref{VC Delete/Rename}.
-@end ifnottex
-
-@findex add-name-to-file
-@cindex hard links (creation)
- @kbd{M-x add-name-to-file} adds an additional name to an existing
-file without removing its old name. The new name is created as a
-hard link to the existing file. The new name must belong on the
-same file system that the file is on. On MS-Windows, this command
-works only if the file resides in an NTFS file system. On MS-DOS, it
-works by copying the file.
-
-@findex make-symbolic-link
-@cindex symbolic links (creation)
- @kbd{M-x make-symbolic-link} reads two file names @var{target} and
-@var{linkname}, then creates a symbolic link named @var{linkname},
-which points at @var{target}. The effect is that future attempts to
-open file @var{linkname} will refer to whatever file is named
-@var{target} at the time the opening is done, or will get an error if
-the name @var{target} is nonexistent at that time. This command does
-not expand the argument @var{target}, so that it allows you to specify
-a relative name as the target of the link. On MS-Windows, this
-command works only on MS Windows Vista and later.
-
@kindex C-x i
@findex insert-file
@kbd{M-x insert-file} (also @kbd{C-x i}) inserts a copy of the
@@ -1802,10 +1815,9 @@ syntax:
@noindent
To carry out this request, Emacs uses a remote-login program such as
-@command{ftp}, @command{ssh}, @command{rlogin}, or @command{telnet}.
+@command{ssh}.
You must always specify in the file name which method to use---for
-example, @file{/ftp:@var{user}@@@var{host}:@var{filename}} uses FTP,
-whereas @file{/ssh:@var{user}@@@var{host}:@var{filename}} uses
+example, @file{/ssh:@var{user}@@@var{host}:@var{filename}} uses
@command{ssh}. When you specify the pseudo method @var{-} in the file
name, Emacs chooses the method as follows:
@@ -1958,7 +1970,7 @@ them all.
@item M-x file-cache-add-directory-list @key{RET} @var{variable} @key{RET}
Add each file name in each directory listed in @var{variable} to the
file name cache. @var{variable} should be a Lisp variable whose value
-is a list of directory names, like @code{load-path}.
+is a list of directories, like @code{load-path}.
@item M-x file-cache-clear-cache @key{RET}
Clear the cache; that is, remove all file names from it.
@end table
diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi
index 2ba3e26c484..f2dba832522 100644
--- a/doc/emacs/fixit.texi
+++ b/doc/emacs/fixit.texi
@@ -227,7 +227,7 @@ case-convert it and go on typing. @xref{Case}.
This section describes the commands to check the spelling of a
single word or of a portion of a buffer. These commands only work if
-the spelling checker program Aspell, Ispell or Hunspell is installed.
+the spelling checker program Hunspell, Aspell, Ispell or Enchant is installed.
These programs are not part of Emacs, but one of them is usually
installed in GNU/Linux and other free operating systems.
@ifnottex
@@ -249,11 +249,12 @@ Check and correct spelling in the region.
Check and correct spelling in a draft mail message, excluding cited
material.
@item M-x ispell-change-dictionary @key{RET} @var{dict} @key{RET}
-Restart the Aspell/Ispell/Hunspell process, using @var{dict} as the dictionary.
+Restart the spell-checker process, using @var{dict} as the dictionary.
@item M-x ispell-kill-ispell
-Kill the Aspell/Ispell/Hunspell subprocess.
+Kill the spell-checker subprocess.
@item M-@key{TAB}
@itemx @key{ESC} @key{TAB}
+@itemx C-M-i
Complete the word before point based on the spelling dictionary
(@code{ispell-complete-word}).
@item M-x flyspell-mode
@@ -318,8 +319,8 @@ Accept the incorrect word---treat it as correct, but only in this
editing session and for this buffer.
@item i
-Insert this word in your private dictionary file so that Aspell or Ispell
-or Hunspell will consider it correct from now on, even in future sessions.
+Insert this word in your private dictionary file so that it will be
+considered correct from now on, even in future sessions.
@item m
Like @kbd{i}, but you can also specify dictionary completion
@@ -363,7 +364,7 @@ character; type that digit or character to choose it.
@cindex @code{ispell} program
@findex ispell-kill-ispell
- Once started, the Aspell or Ispell or Hunspell subprocess continues
+ Once started, the spell-checker subprocess continues
to run, waiting for something to do, so that subsequent spell checking
commands complete more quickly. If you want to get rid of the
process, use @kbd{M-x ispell-kill-ispell}. This is not usually
@@ -374,7 +375,7 @@ spelling correction.
@vindex ispell-local-dictionary
@vindex ispell-personal-dictionary
@findex ispell-change-dictionary
- Ispell, Aspell and Hunspell look up spelling in two dictionaries:
+ Spell-checkers look up spelling in two dictionaries:
the standard dictionary and your personal dictionary. The standard
dictionary is specified by the variable @code{ispell-local-dictionary}
or, if that is @code{nil}, by the variable @code{ispell-dictionary}.
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index e3e59ad43ac..c94d690cf7f 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -575,7 +575,8 @@ font names in X resource files.
If you are running Emacs on the GNOME desktop, you can tell Emacs to
use the default system font by setting the variable
@code{font-use-system-font} to @code{t} (the default is @code{nil}).
-For this to work, Emacs must have been compiled with Gconf support.
+For this to work, Emacs must have been compiled with support for
+Gsettings (or the older Gconf).
@item
Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font
@@ -835,8 +836,8 @@ associate the speedbar with a different frame, dismiss it and call
The speedbar can operate in various modes. Its default mode is
@dfn{File Display} mode, which shows the files in the current
directory of the selected window of the attached frame, one file per
-line. Clicking on a file name visits that file in the selected window
-of the attached frame, and clicking on a directory name shows that
+line. Clicking on a non-directory visits that file in the selected window
+of the attached frame, and clicking on a directory shows that
directory in the speedbar (@pxref{Mouse References}). Each line also
has a box, @samp{[+]} or @samp{<+>}, that you can click on to
@dfn{expand} the contents of that item. Expanding a directory adds
@@ -1001,11 +1002,25 @@ when the entire buffer is visible.
The visual appearance of the scroll bars is controlled by the
@code{scroll-bar} face.
+@cindex vertical border
+ On graphical frames, vertical scroll bars implicitly serve to separate
+side-by-side windows visually. When vertical scroll bars are disabled,
+Emacs by default separates such windows with the help of a one-pixel
+wide @dfn{vertical border}. That border occupies the first pixel column
+of the window on the right and may thus overdraw the leftmost pixels of
+any glyph displayed there. If these pixels convey important
+information, you can make them visible by enabling window dividers, see
+@ref{Window Dividers}. To replicate the look of vertical borders, set
+the @code{right-divider-width} parameter of frames to one and have the
+@code{window-divider} face inherit from that of @code{vertical-border},
+@ref{Window Dividers,, Window Dividers, elisp, The Emacs Lisp Reference
+Manual}.
+
@cindex Horizontal Scroll Bar
@cindex Horizontal Scroll Bar mode
On graphical displays with toolkit support, Emacs may also supply a
@dfn{horizontal scroll bar} on the bottom of each window. Clicking
-@kbd{mouse-1} on the that scroll bar's left and right buttons scrolls
+@kbd{mouse-1} on that scroll bar's left and right buttons scrolls
the window horizontally by one column at a time. Clicking @kbd{mouse-1}
on the left or right of the scroll bar's inner box scrolls the window by
four columns. Dragging the inner box scrolls the window continuously.
@@ -1059,7 +1074,12 @@ window-divider-mode}.
customize the options @code{window-divider-default-bottom-width} and
@code{window-divider-default-right-width}.
- For more details about window dividers see @ref{Window Dividers,,
+ When vertical scroll bars are disabled, dividers can be also useful to
+make the first pixel column of a window visible which would be otherwise
+covered by the vertical border used to separate side-by-side windows
+(@pxref{Scroll Bars}).
+
+For more details about window dividers see @ref{Window Dividers,,
Window Dividers, elisp, The Emacs Lisp Reference Manual}.
@node Drag and Drop
diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi
index 41899e6152f..124c1fd8802 100644
--- a/doc/emacs/glossary.texi
+++ b/doc/emacs/glossary.texi
@@ -405,6 +405,14 @@ A directory local variable is a local variable (q.v.@:) that applies
to all the files within a certain directory. @xref{Directory
Variables}.
+@item Directory Name
+On GNU and other Unix-like systems, directory names are strings that
+end in @samp{/}. For example, @file{/no-such-dir/} is a directory
+name whereas @file{/tmp} is not, even though @file{/tmp} names a file
+that happens to be a directory. On MS-DOS the relationship is more
+complicated. @xref{Directory Names,,, elisp, the Emacs Lisp Reference
+Manual}.
+
@item Dired
Dired is the Emacs facility that displays the contents of a file
directory and allows you to ``edit the directory'', performing
@@ -586,7 +594,7 @@ GNU General Public License. @xref{Copying}.
@item Free Software Foundation
The Free Software Foundation (FSF) is a charitable foundation
dedicated to promoting the development of free software (q.v.).
-For more information, see @uref{http://fsf.org/, the FSF website}.
+For more information, see @uref{https://fsf.org/, the FSF website}.
@item Fringe
On a graphical display (q.v.), there's a narrow portion of the frame
@@ -642,7 +650,7 @@ GNU is a recursive acronym for GNU's Not Unix, and it refers to a
Unix-compatible operating system which is free software (q.v.).
@xref{Manifesto}. GNU is normally used with Linux as the kernel since
Linux works better than the GNU kernel. For more information, see
-@uref{http://www.gnu.org/, the GNU website}.
+@uref{https://www.gnu.org/, the GNU website}.
@item Graphic Character
Graphic characters are those assigned pictorial images rather than
@@ -1197,7 +1205,7 @@ string or the next match for a specified regular expression.
@xref{Search}.
@item Search Path
-A search path is a list of directory names, to be used for searching for
+A search path is a list of directories, to be used for searching for
files for certain purposes. For example, the variable @code{load-path}
holds a search path for finding Lisp library files. @xref{Lisp Libraries}.
diff --git a/doc/emacs/gnu.texi b/doc/emacs/gnu.texi
index 78f53544377..b88fd74ca3e 100644
--- a/doc/emacs/gnu.texi
+++ b/doc/emacs/gnu.texi
@@ -30,8 +30,8 @@ that different wording could help avoid. Footnotes added in 1993 help
clarify these points.
For up-to-date information about available GNU software, please see
-our web site, @uref{http://www.gnu.org}. For software tasks and other
-ways to contribute, see @uref{http://www.gnu.org/help}.
+our web site, @uref{https://www.gnu.org}. For software tasks and other
+ways to contribute, see @uref{https://www.gnu.org/help}.
@end quotation
@unnumberedsec What's GNU@? Gnu's Not Unix!
@@ -379,7 +379,7 @@ urge people to reject the term ``intellectual property'' entirely,
lest it lead others to suppose that those laws form one coherent
issue. The way to be clear is to discuss patents, copyrights, and
trademarks separately. See
-@uref{http://www.gnu.org/philosophy/not-ipr.xhtml} for more
+@uref{https://www.gnu.org/philosophy/not-ipr.xhtml} for more
explanation of how this term spreads confusion and bias.} carefully
(such as lawyers) say that there is no intrinsic right to intellectual
property. The kinds of supposed intellectual property rights that the
@@ -495,7 +495,7 @@ distinguish between ``free software'' and ``freeware''. The term
``freeware'' means software you are free to redistribute, but usually
you are not free to study and change the source code, so most of it is
not free software. See
-@uref{http://www.gnu.org/philosophy/words-to-avoid.html} for more
+@uref{https://www.gnu.org/philosophy/words-to-avoid.html} for more
explanation.}, asking for donations from satisfied users, or selling
hand-holding services. I have met people who are already working this
way successfully.
diff --git a/doc/emacs/gpl.texi b/doc/emacs/gpl.texi
index 0e2e212acb1..c007dc06966 100644
--- a/doc/emacs/gpl.texi
+++ b/doc/emacs/gpl.texi
@@ -5,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/}
+Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies of this
license document, but changing it is not allowed.
@@ -684,7 +684,7 @@ 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 @url{http://www.gnu.org/licenses/}.
+along with this program. If not, see @url{https://www.gnu.org/licenses/}.
@end smallexample
Also add information on how to contact you by electronic and paper mail.
@@ -707,11 +707,11 @@ use an ``about box''.
You should also get your employer (if you work as a programmer) or school,
if any, to sign a ``copyright disclaimer'' for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-@url{http://www.gnu.org/licenses/}.
+@url{https://www.gnu.org/licenses/}.
The GNU General Public License does not permit incorporating your
program into proprietary programs. If your program is a subroutine
library, you may consider it more useful to permit linking proprietary
applications with the library. If this is what you want to do, use
the GNU Lesser General Public License instead of this License. But
-first, please read @url{http://www.gnu.org/philosophy/why-not-lgpl.html}.
+first, please read @url{https://www.gnu.org/licenses/why-not-lgpl.html}.
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 548ca6a1b48..9ef33dd4cf5 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -203,9 +203,10 @@ string}, which describes exactly what the command does.
describes the command corresponding to @var{key}.
@kbd{C-h c}, @kbd{C-h k} and @kbd{C-h K} work for any sort of key
-sequences, including function keys, menus, and mouse events. For
-instance, after @kbd{C-h k} you can select a menu item from the menu
-bar, to view the documentation string of the command it runs.
+sequences, including function keys, menus, and mouse events (except
+that @kbd{C-h c} ignores mouse movement events). For instance, after
+@kbd{C-h k} you can select a menu item from the menu bar, to view the
+documentation string of the command it runs.
@kindex C-h w
@findex where-is
@@ -319,12 +320,21 @@ search for non-customizable variables too.
Search for variables. With a prefix argument, search for
customizable variables only.
+@item M-x apropos-local-variable
+@findex apropos-local-variable
+Search for buffer-local variables.
+
@item M-x apropos-value
@findex apropos-value
Search for variables whose values match the specified pattern. With a
prefix argument, search also for functions with definitions matching
the pattern, and Lisp symbols with properties matching the pattern.
+@item M-x apropos-local-value
+@findex apropos-local-value
+Search for buffer-local variables whose values match the specified
+pattern.
+
@item C-h d
@kindex C-h d
@findex apropos-documentation
@@ -632,7 +642,7 @@ Display information about where to get external packages
@item C-h C-f
Display the Emacs frequently-answered-questions list (@code{view-emacs-FAQ}).
@item C-h g
-Visit a @uref{http://www.gnu.org} page with information about the GNU
+Visit a @uref{https://www.gnu.org} page with information about the GNU
Project (@code{describe-gnu-project}).
@item C-h C-m
Display information about ordering printed copies of Emacs manuals
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 47de0531292..5165881739f 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -519,6 +519,10 @@ when exiting Emacs; if you wish to prevent Emacs from transferring
data to the clipboard manager, change the variable
@code{x-select-enable-clipboard-manager} to @code{nil}.
+ Since strings containing NUL bytes are usually truncated when passed
+through the clipboard, Emacs replaces such characters with ``\0''
+before transferring them to the system's clipboard.
+
@vindex select-enable-primary
@findex clipboard-kill-region
@findex clipboard-kill-ring-save
diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi
index 134646ccaa7..1577f3d1235 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -213,6 +213,6 @@ issues to be addressed. Interested developers should contact
@email{emacs-devel@@gnu.org}.
@end ifnothtml
@ifhtml
-@url{http://lists.gnu.org/mailman/listinfo/emacs-devel, the
+@url{https://lists.gnu.org/mailman/listinfo/emacs-devel, the
emacs-devel mailing list}.
@end ifhtml
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 80a4467f639..112f1f4d9ed 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -56,6 +56,7 @@ versions of a source file, storing information such as the creation
time of each version, who made it, and a description of what was
changed.
+@cindex VC
The Emacs version control interface is called @dfn{VC}@. VC
commands work with several different version control systems;
currently, it supports Bazaar, CVS, Git, Mercurial, Monotone, RCS,
@@ -1049,13 +1050,14 @@ increase the number of revisions shown in an existing
entries} or @samp{Show unlimited entries} buttons at the end of the
buffer. However, RCS, SCCS, and CVS do not support this feature.
+@kindex C-x v h
@findex vc-region-history
A useful variant of examining changes is provided by the command
-@kbd{vc-region-history}, which shows a @file{*VC-history*} buffer with
-the history of changes to the region of the current file between point
-and the mark (@pxref{Mark}). The history of changes includes the
-commit log messages and also the changes themselves in the Diff
-format.
+@kbd{vc-region-history} (by default bound to @kbd{C-x v h}), which shows
+a @file{*VC-history*} buffer with the history of changes to the region
+of the current file between point and the mark (@pxref{Mark}). The
+history of changes includes the commit log messages and also the
+changes themselves in the Diff format.
Invoke this command after marking the region of the current file in
whose changes you are interested. In the @file{*VC-history*} buffer
@@ -1124,7 +1126,7 @@ it is used to specify multi-file VC filesets for commands like
@kindex C-x v d
@findex vc-dir
To use the VC Directory buffer, type @kbd{C-x v d} (@code{vc-dir}).
-This reads a directory name using the minibuffer, and switches to a VC
+This reads a directory's name using the minibuffer, and switches to a VC
Directory buffer for that directory. By default, the buffer is named
@file{*vc-dir*}. Its contents are described
@iftex
@@ -1819,17 +1821,21 @@ Go back to where you previously invoked @kbd{M-.} and friends
@kindex M-.
@findex xref-find-definitions
+@vindex xref-prompt-for-identifier
@kbd{M-.}@: (@code{xref-find-definitions}) shows the definitions of
the identifier at point. With a prefix argument, or if there's no
-identifier at point, it prompts for the identifier. If the
-identifier has only one definition, the command jumps to it. If the
-identifier has more than one possible definition (e.g., in an
-object-oriented language, or if there's a function and a variable by
-the same name), the command shows the candidate definitions in a
-@file{*xref*} buffer, together with the files in which these
-definitions are found. Selecting one of these candidates by typing
-@kbd{@key{RET}} or clicking @kbd{mouse-2} will pop a buffer showing
-the corresponding definition.
+identifier at point, it prompts for the identifier. (If you want it
+to always prompt, customize @code{xref-prompt-for-identifier} to
+@code{t}.)
+
+If the specified identifier has only one definition, the command jumps
+to it. If the identifier has more than one possible definition (e.g.,
+in an object-oriented language, or if there's a function and a
+variable by the same name), the command shows the candidate
+definitions in a @file{*xref*} buffer, together with the files in
+which these definitions are found. Selecting one of these candidates
+by typing @kbd{@key{RET}} or clicking @kbd{mouse-2} will pop a buffer
+showing the corresponding definition.
When entering the identifier argument to @kbd{M-.}, the usual
minibuffer completion commands can be used (@pxref{Completion}), with
@@ -1881,8 +1887,7 @@ the special XREF mode:
@table @kbd
@item @key{RET}
@itemx mouse-2
-Display the reference on the current line and bury the @file{*xref*}
-buffer.
+Display the reference on the current line.
@item n
@itemx .
@findex xref-next-line
@@ -1897,6 +1902,10 @@ Move to the previous reference and display it in the other window
@findex xref-show-location-at-point
Display the reference on the current line in the other window
(@code{xref-show-location-at-point}).
+@item TAB
+@findex xref-quit-and-goto-xref
+Display the reference on the current line and bury the @file{*xref*}
+buffer (@code{xref-quit-and-goto-xref}).
@findex xref-query-replace-in-results
@item r @var{pattern} @key{RET} @var{replacement} @key{RET}
Perform interactive query-replace on references that match
@@ -1913,8 +1922,8 @@ without displaying the references.
@node Identifier Search
@subsubsection Searching and Replacing with Identifiers
-@cindex search and replace in multiple files
-@cindex multiple-file search and replace
+@cindex search and replace in multiple source files
+@cindex multiple source file search and replace
The commands in this section perform various search and replace
operations either on identifiers themselves or on files that reference
@@ -2429,8 +2438,11 @@ needed to recognize what you want to tag. If the syntax requires you
to write @var{tagregexp} so it matches more characters beyond the tag
itself, you should add a @var{nameregexp}, to pick out just the tag.
This will enable Emacs to find tags more accurately and to do
-completion on tag names more reliably. You can find some examples
-below.
+completion on tag names more reliably. In @var{nameregexp}, it is
+frequently convenient to use ``back references'' (@pxref{Regexp
+Backslash}) to parenthesized groupings @w{@samp{\( @dots{} \)}} in
+@var{tagregexp}. For example, @samp{\1} refers to the first such
+parenthesized grouping. You can find some examples of this below.
The @var{modifiers} are a sequence of zero or more characters that
modify the way @command{etags} does the matching. A regexp with no
@@ -2478,7 +2490,7 @@ following example tags the @code{DEFVAR} macros in the Emacs source
files, for the C language only:
@smallexample
---regex='@{c@}/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/'
+--regex='@{c@}/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/\1/'
@end smallexample
@noindent
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index 1e160508e53..eb935706001 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -367,7 +367,7 @@ of buffers that you have been in, and, for each buffer, a place where
you set the mark. The length of the global mark ring is controlled by
@code{global-mark-ring-max}, and is 16 by default.
-@kindex C-x C-@key{SPC}
+@kindex C-x C-SPC
@findex pop-global-mark
The command @kbd{C-x C-@key{SPC}} (@code{pop-global-mark}) jumps to
the buffer and position of the latest entry in the global ring. It also
@@ -449,7 +449,7 @@ using @kbd{C-@key{SPC} C-@key{SPC}} or @kbd{C-u C-x C-x}.
@table @kbd
@item C-@key{SPC} C-@key{SPC}
-@kindex C-@key{SPC} C-@key{SPC}
+@kindex C-SPC C-SPC
Set the mark at point (like plain @kbd{C-@key{SPC}}) and enable
Transient Mark mode just once, until the mark is deactivated. (This
is not really a separate command; you are using the @kbd{C-@key{SPC}}
diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi
index 83e7f3b7eb5..93f91420771 100644
--- a/doc/emacs/mini.texi
+++ b/doc/emacs/mini.texi
@@ -89,7 +89,10 @@ the default directory. If you now type @kbd{buffer.c} as input, that
specifies the file @file{/u2/emacs/src/buffer.c}. @xref{File Names},
for information about the default directory.
- You can specify the parent directory with @file{..}:
+ Alternative defaults for the file name you may want are available by
+typing @kbd{M-n}, see @ref{Minibuffer History}.
+
+ You can specify a file in the parent directory with @file{..}:
@file{/a/b/../foo.el} is equivalent to @file{/a/foo.el}.
Alternatively, you can use @kbd{M-@key{DEL}} to kill directory names
backwards (@pxref{Words}).
@@ -609,8 +612,6 @@ Move to a later item in the minibuffer history that matches
@kindex M-p @r{(minibuffer history)}
@kindex M-n @r{(minibuffer history)}
-@kindex UP @r{(minibuffer history)}
-@kindex DOWN @r{(minibuffer history)}
@findex next-history-element
@findex previous-history-element
While in the minibuffer, @kbd{M-p} (@code{previous-history-element})
@@ -627,8 +628,25 @@ typed @kbd{M-p}), Emacs tries fetching from a list of default
arguments: values that you are likely to enter. You can think of this
as moving through the ``future history''.
+@cindex future history for file names
+@cindex minibuffer defaults for file names
+@vindex file-name-at-point-functions
+ The ``future history'' for file names includes several possible
+alternatives you may find useful, such as the file name or the URL at
+point in the current buffer. The defaults put into the ``future
+history'' in this case are controlled by the functions mentioned in
+the value of the option @code{file-name-at-point-functions}. By
+default, its value invokes the @code{ffap} package (@pxref{FFAP}),
+which tries to guess the default file or URL from the text around
+point. To disable this guessing, customize the option to a @code{nil}
+value, then the ``future history'' of file names will include only the
+file, if any, visited by the current buffer, and the default
+directory.
+
@findex previous-line-or-history-element
@findex next-line-or-history-element
+@kindex UP @r{(minibuffer history)}
+@kindex DOWN @r{(minibuffer history)}
The arrow keys @kbd{@key{UP}} and @kbd{@key{DOWN}} work like
@kbd{M-p} and @kbd{M-n}, but if the current history item is longer
than a single line, they allow you to move to the previous or next
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 84681f2269a..6ad5fbafdd6 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -661,7 +661,7 @@ available.
(either in the @var{cmd} argument to one of the above commands, or in
other contexts), Emacs searches for the program in the directories
specified by the variable @code{exec-path}. The value of this
-variable must be a list of directory names; the default value is
+variable must be a list of directories; the default value is
initialized from the environment variable @env{PATH} when Emacs is
started (@pxref{General Variables}).
@@ -742,6 +742,11 @@ this; e.g., whether to rename the pre-existing output buffer, or to
use a different buffer for the new command. Consult the variable's
documentation for more possibilities.
+@vindex async-shell-command-display-buffer
+ If you want the output buffer for asynchronous shell commands to be
+displayed only when the command generates output, set
+@code{async-shell-command-display-buffer} to @code{nil}.
+
@kindex M-|
@findex shell-command-on-region
@kbd{M-|} (@code{shell-command-on-region}) is like @kbd{M-!}, but
@@ -1816,8 +1821,10 @@ listed below:
@table @samp
@item -a @var{command}
@itemx --alternate-editor=@var{command}
-Specify a command to run if @code{emacsclient} fails to contact Emacs.
+Specify a shell command to run if @code{emacsclient} fails to contact Emacs.
This is useful when running @code{emacsclient} in a script.
+The command may include arguments, which may be quoted "like this".
+Currently, escaping of quotes is not supported.
As a special exception, if @var{command} is the empty string, then
@code{emacsclient} starts Emacs in daemon mode (as @command{emacs
@@ -2808,7 +2815,7 @@ Find @var{filename}, guessing a default from text around point
@code{ffap-alternate-file}, analogous to @code{find-alternate-file}.
@item C-x d @var{directory} @key{RET}
@kindex C-x d @r{(FFAP)}
-Start Dired on @var{directory}, defaulting to the directory name at
+Start Dired on @var{directory}, defaulting to the directory at
point (@code{dired-at-point}).
@item C-x C-d
@code{ffap-list-directory}, analogous to @code{list-directory}.
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index be893403012..876431aa9e9 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -225,10 +225,12 @@ Font-Lock mode automatically highlights certain textual units found in
programs. It is enabled globally by default, but you can disable it
in individual buffers. @xref{Faces}.
-@findex linum-mode
-@cindex Linum mode
+@findex display-line-numbers-mode
+@cindex display-line-numbers-mode
@item
-Linum mode displays each line's line number in the window's left margin.
+Display Line Numbers mode is a convenience wrapper around
+@code{display-line-numbers}, setting it using the value of
+@code{display-line-numbers-type}. @xref{Display Custom}.
@item
Outline minor mode provides similar facilities to the major mode
diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi
index 0d98dc81c1e..03250447bbf 100644
--- a/doc/emacs/msdos-xtra.texi
+++ b/doc/emacs/msdos-xtra.texi
@@ -363,7 +363,7 @@ the home directory, as you would on GNU or Unix. You can also set
@env{HOME} variable in the environment before starting Emacs; its
value will then override the above default behavior.
- Emacs on MS-DOS handles the directory name @file{/dev} specially,
+ Emacs on MS-DOS handles the name @file{/dev} specially,
because of a feature in the emulator libraries of DJGPP that pretends
I/O devices have names in that directory. We recommend that you avoid
using an actual directory named @file{/dev} on any disk.
diff --git a/doc/emacs/msdos.texi b/doc/emacs/msdos.texi
index 356936504ec..dd2004fbb00 100644
--- a/doc/emacs/msdos.texi
+++ b/doc/emacs/msdos.texi
@@ -580,7 +580,7 @@ pressed the @key{Shift} key while typing the non-character key.
@vindex w32-enable-caps-lock
If the variable @code{w32-enable-caps-lock} is set to a @code{nil}
value, the @key{CapsLock} key produces the symbol @code{capslock}
-instead of the shifted version of they keys. The default value is
+instead of the shifted version of typed keys. The default value is
@code{t}.
@vindex w32-enable-num-lock
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index 13407f6f07b..78f77cb3003 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1002,16 +1002,15 @@ its name at the prompt.)
@vindex sendmail-coding-system
When you send a mail message (@pxref{Sending Mail}),
Emacs has four different ways to determine the coding system to use
-for encoding the message text. It tries the buffer's own value of
+for encoding the message text. It first tries the buffer's own value of
@code{buffer-file-coding-system}, if that is non-@code{nil}.
Otherwise, it uses the value of @code{sendmail-coding-system}, if that
-is non-@code{nil}. The third way is to use the default coding system
-for new files, which is controlled by your choice of language
-@c i.e., default-sendmail-coding-system
-environment, if that is non-@code{nil}. If all of these three values
-are @code{nil}, Emacs encodes outgoing mail using the Latin-1 coding
-system.
-@c FIXME? Where does the Latin-1 default come in?
+is non-@code{nil}. Thirdly, it uses the value of
+@code{default-sendmail-coding-system}.
+If all of these three values are @code{nil}, Emacs encodes outgoing
+mail using the default coding system for new files (i.e., the
+default value of @code{buffer-file-coding-system}), which is
+controlled by your choice of language environment.
@node Text Coding
@section Specifying a Coding System for File Text
@@ -1198,7 +1197,7 @@ names (@code{set-file-name-coding-system}).
@end table
@findex set-file-name-coding-system
-@kindex C-x @key{RET} F
+@kindex C-x RET F
@cindex file names with non-@acronym{ASCII} characters
The command @kbd{C-x @key{RET} F} (@code{set-file-name-coding-system})
specifies a coding system to use for encoding file @emph{names}. It
@@ -1356,7 +1355,7 @@ fontset}, the @dfn{startup fontset} and the @dfn{default fontset}.
@c FIXME? The doc of *standard*-fontset-spec says:
@c "You have the biggest chance to display international characters
@c with correct glyphs by using the *standard* fontset." (my emphasis)
-@c See http://lists.gnu.org/archive/html/emacs-devel/2012-04/msg00430.html
+@c See https://lists.gnu.org/r/emacs-devel/2012-04/msg00430.html
The default fontset is most likely to have fonts for a wide variety of
non-@acronym{ASCII} characters, and is the default fallback for the
other two fontsets, and if you set a default font rather than fontset.
@@ -1774,15 +1773,15 @@ Chars}).
@cindex bidirectional editing
@cindex right-to-left text
- Emacs supports editing text written in scripts, such as Arabic and
-Hebrew, whose natural ordering of horizontal text for display is from
-right to left. However, digits and Latin text embedded in these
-scripts are still displayed left to right. It is also not uncommon to
-have small portions of text in Arabic or Hebrew embedded in an otherwise
-Latin document; e.g., as comments and strings in a program source
-file. For these reasons, text that uses these scripts is actually
-@dfn{bidirectional}: a mixture of runs of left-to-right and
-right-to-left characters.
+ Emacs supports editing text written in scripts, such as Arabic,
+Farsi, and Hebrew, whose natural ordering of horizontal text for
+display is from right to left. However, digits and Latin text
+embedded in these scripts are still displayed left to right. It is
+also not uncommon to have small portions of text in Arabic or Hebrew
+embedded in an otherwise Latin document; e.g., as comments and strings
+in a program source file. For these reasons, text that uses these
+scripts is actually @dfn{bidirectional}: a mixture of runs of
+left-to-right and right-to-left characters.
This section describes the facilities and options provided by Emacs
for editing bidirectional text.
@@ -1795,8 +1794,12 @@ of the first character you read precedes that of the next character.
Reordering of bidirectional text into the @dfn{visual} order happens
at display time. As result, character positions no longer increase
monotonically with their positions on display. Emacs implements the
-Unicode Bidirectional Algorithm described in the Unicode Standard
-Annex #9, for reordering of bidirectional text for display.
+Unicode Bidirectional Algorithm (UBA) described in the Unicode
+Standard Annex #9, for reordering of bidirectional text for display.
+It deviates from the UBA only in how continuation lines are displayed
+when text direction is opposite to the base paragraph direction,
+e.g. when a long line of English text appears in a right-to-left
+paragraph.
@vindex bidi-display-reordering
The buffer-local variable @code{bidi-display-reordering} controls
@@ -1807,15 +1810,21 @@ directionality when they are displayed. The default value is
@cindex base direction of paragraphs
@cindex paragraph, base direction
+@vindex bidi-paragraph-start-re
+@vindex bidi-paragraph-separate-re
Each paragraph of bidirectional text can have its own @dfn{base
-direction}, either right-to-left or left-to-right. (Paragraph
-@c paragraph-separate etc have no influence on this?
-boundaries are empty lines, i.e., lines consisting entirely of
-whitespace characters.) Text in left-to-right paragraphs begins on
-the screen at the left margin of the window and is truncated or
-continued when it reaches the right margin. By contrast, text in
-right-to-left paragraphs is displayed starting at the right margin and
-is continued or truncated at the left margin.
+direction}, either right-to-left or left-to-right. Text in
+left-to-right paragraphs begins on the screen at the left margin of
+the window and is truncated or continued when it reaches the right
+margin. By contrast, text in right-to-left paragraphs is displayed
+starting at the right margin and is continued or truncated at the left
+margin. By default, paragraph boundaries are empty lines, i.e., lines
+consisting entirely of whitespace characters. To change that, you can
+customize the two variables @code{bidi-paragraph-start-re} and
+@code{bidi-paragraph-separate-re}, whose values should be regular
+expressions (strings); e.g., to have a single newline start a new
+paragraph, set both of these variables to @code{"^"}. These two
+variables are buffer-local (@pxref{Locals}).
@vindex bidi-paragraph-direction
Emacs determines the base direction of each paragraph dynamically,
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index ecc955d3efe..215f50cb406 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -182,7 +182,7 @@ variable @code{package-archives}, whose value is a list of package
archives known to Emacs. Each list element must have the form
@code{(@var{id} . @var{location})}, where @var{id} is the name of a
package archive and @var{location} is the @acronym{HTTP} address or
-directory name of the package archive. You can alter this list if you
+name of the package archive directory. You can alter this list if you
wish to use third party package archives---but do so at your own risk,
and use only third parties that you think you can trust!
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 222d1c2a4de..811dab5cfa0 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -712,7 +712,7 @@ before it. An argument of zero, rather than doing nothing, transposes
the balanced expressions ending at or after point and the mark.
@kindex C-M-@@
-@kindex C-M-@key{SPC}
+@kindex C-M-SPC
@findex mark-sexp
To operate on balanced expressions with a command which acts on the
region, type @kbd{C-M-@key{SPC}} (@code{mark-sexp}). This sets the
@@ -1146,9 +1146,12 @@ comment or for aligning an existing comment. It is set differently by
various major modes. The function is called with no arguments, but with
point at the beginning of the comment, or at the end of a line if a new
comment is to be inserted. It should return the column in which the
-comment ought to start. For example, in Lisp mode, the indent hook
-function bases its decision on how many semicolons begin an existing
-comment, and on the code in the preceding lines.
+comment ought to start. For example, the default hook function bases
+its decision on how many comment characters begin an existing comment.
+
+Emacs also tries to align comments on adjacent lines. To override
+this, the function may return a cons of two (possibly equal) integers
+to indicate an acceptable range of indentation.
@node Documentation
@section Documentation Lookup
@@ -1316,16 +1319,20 @@ count as blocks.
@kindex S-mouse-2
@table @kbd
@item C-c @@ C-h
+@itemx C-c @@ C-d
Hide the current block (@code{hs-hide-block}).
@item C-c @@ C-s
Show the current block (@code{hs-show-block}).
@item C-c @@ C-c
+@itemx C-x @@ C-e
Either hide or show the current block (@code{hs-toggle-hiding}).
@item S-mouse-2
Toggle hiding for the block you click on (@code{hs-mouse-toggle-hiding}).
@item C-c @@ C-M-h
+@itemx C-c @@ C-t
Hide all top-level blocks (@code{hs-hide-all}).
@item C-c @@ C-M-s
+@itemx C-c @@ C-a
Show all blocks in the buffer (@code{hs-show-all}).
@item C-c @@ C-l
Hide all blocks @var{n} levels below this block
@@ -1464,7 +1471,7 @@ Prompt for the name of a function defined in any file Emacs has
parsed, and move point there (@code{semantic-complete-jump}).
@item C-c , @key{SPC}
-@kindex C-c , @key{SPC}
+@kindex C-c , SPC
Display a list of possible completions for the symbol at point
(@code{semantic-complete-analyze-inline}). This also activates a set
of special key bindings for choosing a completion: @key{RET} accepts
@@ -1713,8 +1720,8 @@ preprocessor commands.
@item C-c C-@key{DEL}
@itemx C-c @key{DEL}
@findex c-hungry-delete-backwards
-@kindex C-c C-@key{DEL} (C Mode)
-@kindex C-c @key{DEL} (C Mode)
+@kindex C-c C-DEL (C Mode)
+@kindex C-c DEL (C Mode)
Delete the entire block of whitespace preceding point (@code{c-hungry-delete-backwards}).
@item C-c C-d
@@ -1722,8 +1729,8 @@ Delete the entire block of whitespace preceding point (@code{c-hungry-delete-bac
@itemx C-c @key{Delete}
@findex c-hungry-delete-forward
@kindex C-c C-d (C Mode)
-@kindex C-c C-@key{Delete} (C Mode)
-@kindex C-c @key{Delete} (C Mode)
+@kindex C-c C-Delete (C Mode)
+@kindex C-c Delete (C Mode)
Delete the entire block of whitespace after point (@code{c-hungry-delete-forward}).
@end table
diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi
index 7369f6b05b6..40e3e2c1c31 100644
--- a/doc/emacs/regs.texi
+++ b/doc/emacs/regs.texi
@@ -15,7 +15,10 @@ jump back to that position once, or many times.
Each register has a name that consists of a single character, which
we will denote by @var{r}; @var{r} can be a letter (such as @samp{a})
or a number (such as @samp{1}); case matters, so register @samp{a} is
-not the same as register @samp{A}.
+not the same as register @samp{A}. You can also set a register in
+non-alphanumeric characters, for instance @samp{*} or @samp{C-d}.
+Note, it's not possible to set a register in @samp{C-g} or @samp{ESC},
+because these keys are reserved to terminate interactive commands.
@findex view-register
A register can store a position, a piece of text, a rectangle, a
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index 046087ef452..b073687da9c 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1363,7 +1363,7 @@ message itself is flagged as deleted.
Mailing list messages that might offend or annoy some readers are sometimes
encoded in a simple code called @dfn{rot13}---so named because it
rotates the alphabet by 13 letters. This code is not for secrecy, as it
-provides none; rather, it enables those who wish to to avoid
+provides none; rather, it enables those who wish to avoid
seeing the real text of the message. For example, a review of a film
might use rot13 to hide important plot points.
@@ -1382,7 +1382,7 @@ Rmail attempts to locate the @command{movemail} program and determine its
version. There are two versions of the @command{movemail} program: the
GNU Mailutils version (@pxref{movemail,,,mailutils,GNU mailutils}),
and an Emacs-specific version that is built and installed unless Emacs
-was configured using the @option{--with-mailutils} option.
+was configured @option{--with-mailutils} in effect.
The two @command{mailtool} versions support the same
command line syntax and the same basic subset of options. However, the
Mailutils version offers additional features.
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 905df025d29..7b334733d67 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -582,6 +582,8 @@ word search (@code{isearch-forward-word}).
Search for @var{words}, using a forward nonincremental word search.
@item M-s w C-r @key{RET} @var{words} @key{RET}
Search backward for @var{words}, using a nonincremental word search.
+@item M-s M-w
+Search the Web for the text in region.
@end table
@kindex M-s w
@@ -617,12 +619,15 @@ toggling lax whitespace matching (@pxref{Lax Search, lax space
matching}) has no effect on them.
@kindex M-s M-w
-@findex eww-search-word
+@findex eww-search-words
@vindex eww-search-prefix
- Search the Web for the text in region. This command performs an
-Internet search for the words in region using the search engine whose
-@acronym{URL} is specified by the variable @code{eww-search-prefix}.
-@xref{Basics, EWW, , eww, The Emacs Web Wowser Manual}.
+ To search the Web for the text in region, type @kbd{M-s M-w}. This
+command performs an Internet search for the words in region using the
+search engine whose @acronym{URL} is specified by the variable
+@code{eww-search-prefix} (@pxref{Basics, EWW, , eww, The Emacs Web
+Wowser Manual}). If the region is not active, or doesn't contain any
+words, this command prompts the user for a URL or keywords to search.
+
@node Symbol Search
@section Symbol Search
@@ -1609,6 +1614,14 @@ to go back to the position of the previous occurrence (or what used to
be an occurrence), in case you changed it by mistake or want to
reexamine it.
+@item u
+to undo the last replacement and go back to where that replacement was
+made.
+
+@item U
+to undo all the replacements and go back to where the first
+replacement was made.
+
@item C-r
to enter a recursive editing level, in case the occurrence needs to be
edited rather than just replaced with @var{newstring}. When you are
@@ -1680,15 +1693,10 @@ Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers},
which always search the whole buffer, all operate on the text from point
to the end of the buffer, or on the region if it is active.
-@findex list-matching-lines
-@findex occur
-@findex multi-occur
-@findex multi-occur-in-matching-buffers
-@findex how-many
-@findex flush-lines
-@findex keep-lines
-
@table @kbd
+@findex multi-isearch-buffers
+@cindex isearch multiple buffers
+@cindex multiple-buffer isearch
@item M-x multi-isearch-buffers
Prompt for one or more buffer names, ending with @key{RET}; then,
begin a multi-buffer incremental search in those buffers. (If the
@@ -1697,10 +1705,14 @@ next specified buffer, and so forth.) With a prefix argument, prompt
for a regexp and begin a multi-buffer incremental search in buffers
matching that regexp.
+@findex multi-isearch-buffers-regexp
@item M-x multi-isearch-buffers-regexp
This command is just like @code{multi-isearch-buffers}, except it
performs an incremental regexp search.
+@findex multi-isearch-files
+@cindex isearch multiple files
+@cindex multiple-file isearch
@item M-x multi-isearch-files
Prompt for one or more file names, ending with @key{RET}; then,
begin a multi-file incremental search in those files. (If the
@@ -1709,6 +1721,7 @@ next specified file, and so forth.) With a prefix argument, prompt
for a regexp and begin a multi-file incremental search in files
matching that regexp.
+@findex multi-isearch-files-regexp
@item M-x multi-isearch-files-regexp
This command is just like @code{multi-isearch-files}, except it
performs an incremental regexp search.
@@ -1724,6 +1737,7 @@ a multi-file incremental search is activated automatically.
@vindex list-matching-lines-jump-to-current-line
@cindex list-matching-lines-current-line-face (face name)
@kindex M-s o
+@findex occur
@item M-x occur
@itemx M-s o
Prompt for a regexp, and display a list showing each line in the
@@ -1742,6 +1756,10 @@ at the first match after such line.
You can also run @kbd{M-s o} when an incremental search is active;
this uses the current search string.
+Note that matches for the regexp you type are extended to include
+complete lines, and a match that starts before the previous match ends
+is not considered a match.
+
@kindex RET @r{(Occur mode)}
@kindex o @r{(Occur mode)}
@kindex C-o @r{(Occur mode)}
@@ -1759,25 +1777,30 @@ mode, in which edits made to the entries are also applied to the text
in the originating buffer. Type @kbd{C-c C-c} to return to Occur
mode.
+@findex list-matching-lines
The command @kbd{M-x list-matching-lines} is a synonym for @kbd{M-x
occur}.
+@findex multi-occur
@item M-x multi-occur
This command is just like @code{occur}, except it is able to search
through multiple buffers. It asks you to specify the buffer names one
by one.
+@findex multi-occur-in-matching-buffers
@item M-x multi-occur-in-matching-buffers
This command is similar to @code{multi-occur}, except the buffers to
search are specified by a regular expression that matches visited file
names. With a prefix argument, it uses the regular expression to
match buffer names instead.
+@findex how-many
@item M-x how-many
Prompt for a regexp, and print the number of matches for it in the
buffer after point. If the region is active, this operates on the
region instead.
+@findex flush-lines
@item M-x flush-lines
Prompt for a regexp, and delete each line that contains a match for
it, operating on the text after point. This command deletes the
@@ -1791,6 +1814,7 @@ lines. It deletes the lines before starting to look for the next
match; hence, it ignores a match starting on the same line at which
another match ended.
+@findex keep-lines
@item M-x keep-lines
Prompt for a regexp, and delete each line that @emph{does not} contain
a match for it, operating on the text after point. If point is not at
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index 4dcbaec03ec..67ad8f94ade 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -443,6 +443,13 @@ non-@code{nil}, and in programming-language strings if
@code{nil} for @code{electric-quote-string} and @code{t} for the other
variables.
+@vindex electric-quote-replace-double
+ You can also set the option @code{electric-quote-replace-double} to
+a non-@code{nil} value. Then, typing @t{"} insert an appropriate
+curved double quote depending on context: @t{“} at the beginning of
+the buffer or after a line break, whitespace, opening parenthesis, or
+quote character, and @t{”} otherwise.
+
Electric Quote mode is disabled by default. To toggle it, type
@kbd{M-x electric-quote-mode}. To toggle it in a single buffer, use
@kbd{M-x electric-quote-local-mode}. To suppress it for a single use,
@@ -1432,7 +1439,7 @@ org-agenda}. This command prompts for what you want to see: a list of
things to do this week, a list of TODO items with specific keywords,
etc.
@ifnottex
-@xref{Agenda Views,,,org, The Org Manual}, for details.
+@xref{Agenda views,,,org, The Org Manual}, for details.
@end ifnottex
@node Org Authoring
@@ -1728,9 +1735,9 @@ C-p} (@code{tex-print}) to print a hardcopy of the output file.
@vindex tex-directory
By default, @kbd{C-c C-b} runs @TeX{} in the current directory. The
output of @TeX{} also goes in this directory. To run @TeX{} in a
-different directory, change the variable @code{tex-directory} to the
-desired directory name. If your environment variable @env{TEXINPUTS}
-contains relative directory names, or if your files contains
+different directory, change the variable @code{tex-directory} to
+the desired directory. If your environment variable @env{TEXINPUTS}
+contains relative names, or if your files contains
@samp{\input} commands with relative file names, then
@code{tex-directory} @emph{must} be @code{"."} or you will get the
wrong results. Otherwise, it is safe to specify some other directory,
@@ -2401,6 +2408,23 @@ these special properties from the text in the region.
The @code{invisible} and @code{intangible} properties are not saved.
+@vindex enriched-allow-eval-in-display-props
+@cindex security, when displaying enriched text
+ Enriched mode also supports saving and restoring @code{display}
+properties (@pxref{Display Property,,,elisp, the Emacs Lisp Reference
+Manual}), which affect how text is displayed on the screen, and also
+allow displaying images and strings that come from sources other than
+buffer text. The @code{display} properties also support execution of
+arbitrary Lisp forms as part of processing the property for display,
+thus providing a means to dynamically tailor the display to some
+conditions that can only be known at display time. Since execution of
+arbitrary Lisp opens Emacs to potential attacks, especially when the
+source of enriched text is outside of Emacs or even outside of your
+system (e.g., if it was received in an email message), such execution
+is by default disabled in Enriched mode. You can enable it by
+customizing the variable @code{enriched-allow-eval-in-display-props}
+to a non-@code{nil} value.
+
@node Text Based Tables
@section Editing Text-based Tables
@cindex table mode
@@ -2793,9 +2817,14 @@ high, the table is 67 characters wide and 16 lines high with 2 columns
and 3 rows, and a total of 5 cells.
@findex table-insert-sequence
- @kbd{M-x table-insert-sequence} inserts a string into each cell.
-Each string is a part of a sequence i.e., a series of increasing
-integer numbers.
+ @kbd{M-x table-insert-sequence} traverses the cells of a table
+inserting a sequence of text strings into each cell as it goes. It
+asks for the base string of the sequence, and then produces the
+sequence by ``incrementing'' the base string, either numerically (if
+the base string ends in numerical characters) or in the
+@acronym{ASCII} order. In addition to the base string, the command
+prompts for the number of elements in the sequence, the increment, the
+cell interval, and the justification of the text in each cell.
@cindex table for HTML and LaTeX
@findex table-generate-source
diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi
index ee3fc491306..4a836c3224b 100644
--- a/doc/emacs/trouble.texi
+++ b/doc/emacs/trouble.texi
@@ -491,7 +491,7 @@ are suggestions for workarounds and solutions.
@cindex bug tracker
@item
-The GNU Bug Tracker at @url{http://debbugs.gnu.org}. Emacs bugs are
+The GNU Bug Tracker at @url{https://debbugs.gnu.org}. Emacs bugs are
filed in the tracker under the @samp{emacs} package. The tracker
records information about the status of each bug, the initial bug
report, and the follow-up messages by the bug reporter and Emacs
@@ -509,7 +509,7 @@ by the Emacs maintainers, are shown by @kbd{M-x debbugs-gnu-usertags}.
@item
The @samp{bug-gnu-emacs} mailing list (also available as the newsgroup
@samp{gnu.emacs.bug}). You can read the list archives at
-@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. This list
+@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs}. This list
works as a mirror of the Emacs bug reports and follow-up messages
which are sent to the bug tracker. It also contains old bug reports
from before the bug tracker was introduced (in early 2008).
@@ -524,7 +524,7 @@ The @samp{emacs-pretest-bug} mailing list. This list is no longer
used, and is mainly of historical interest. At one time, it was used
for bug reports in development (i.e., not yet released) versions of
Emacs. You can read the archives for 2003 to mid 2007 at
-@url{http://lists.gnu.org/archive/html/emacs-pretest-bug/}. Nowadays,
+@url{https://lists.gnu.org/r/emacs-pretest-bug/}. Nowadays,
it is an alias for @samp{bug-gnu-emacs}.
@item
@@ -680,7 +680,7 @@ will be sent to the Emacs maintainers at
@email{bug-gnu-emacs@@gnu.org}.
@end ifnothtml
@ifhtml
-@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, bug-gnu-emacs}.
+@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, bug-gnu-emacs}.
@end ifhtml
(If you want to suggest an improvement or new feature, use the same
address.) If you cannot send mail from inside Emacs, you can copy the
@@ -690,7 +690,7 @@ and send it to that address. Or you can simply send an email to that
address describing the problem.
Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and
-stored in the GNU Bug Tracker at @url{http://debbugs.gnu.org}. Please
+stored in the GNU Bug Tracker at @url{https://debbugs.gnu.org}. Please
include a valid reply email address, in case we need to ask you for
more information about your report. Submissions are moderated, so
there may be a delay before your report appears.
@@ -1084,7 +1084,7 @@ improvement they bring about.
For a fix for an existing bug, it is
best to reply to the relevant discussion on the @samp{bug-gnu-emacs}
list, or the bug entry in the GNU Bug Tracker at
-@url{http://debbugs.gnu.org}. Explain why your change fixes the bug.
+@url{https://debbugs.gnu.org}. Explain why your change fixes the bug.
@item
For a new feature, include a description of the feature and your
@@ -1176,7 +1176,7 @@ documentation, i.e., Texinfo files.
@xref{Change Log},
@ifset WWW_GNU_ORG
see
-@url{http://www.gnu.org/prep/standards/html_node/Change-Log-Concepts.html},
+@url{https://www.gnu.org/prep/standards/html_node/Change-Log-Concepts.html},
@end ifset
@xref{Change Log Concepts, Change Log Concepts,
Change Log Concepts, standards, GNU Coding Standards}.
@@ -1223,11 +1223,11 @@ repository (@pxref{Sending Patches}).
@item
check if existing bug reports are fixed in newer versions of Emacs
-@url{http://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}.
+@url{https://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}.
@item
fix existing bug reports
-@url{http://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}.
+@url{https://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}.
@item
@c etc/TODO not in WWW_GNU_ORG
@@ -1251,7 +1251,7 @@ If you would like to work on improving Emacs, please contact the maintainers at
@email{emacs-devel@@gnu.org}.
@end ifnothtml
@ifhtml
-@url{http://lists.gnu.org/mailman/listinfo/emacs-devel, the
+@url{https://lists.gnu.org/mailman/listinfo/emacs-devel, the
emacs-devel mailing list}.
@end ifhtml
You can ask for suggested projects or suggest your own ideas.
@@ -1262,7 +1262,7 @@ you have not yet started work, it is useful to contact
@email{emacs-devel@@gnu.org}
@end ifnothtml
@ifhtml
-@url{http://lists.gnu.org/mailman/listinfo/emacs-devel, emacs-devel}
+@url{https://lists.gnu.org/mailman/listinfo/emacs-devel, emacs-devel}
@end ifhtml
before you start; it might be possible to suggest ways to make your
extension fit in better with the rest of Emacs.
@@ -1274,7 +1274,7 @@ require a copyright assignment to the FSF; @xref{Copyright Assignment}.
The development version of Emacs can be downloaded from the
repository where it is actively maintained by a group of developers.
See the Emacs project page
-@url{http://savannah.gnu.org/projects/emacs/} for access details.
+@url{https://savannah.gnu.org/projects/emacs/} for access details.
It is important to write your patch based on the current working
version. If you start from an older version, your patch may be
@@ -1296,7 +1296,7 @@ desired change), refer to:
@ifset WWW_GNU_ORG
@ifhtml
the Emacs Manual
-@url{http://www.gnu.org/software/emacs/manual/emacs.html}.
+@url{https://www.gnu.org/software/emacs/manual/emacs.html}.
@end ifhtml
@ifnothtml
@xref{Top, Emacs Manual,,emacs}.
@@ -1310,7 +1310,7 @@ the Emacs Manual
@ifset WWW_GNU_ORG
@ifhtml
the Emacs Lisp Reference Manual
-@url{http://www.gnu.org/software/emacs/manual/elisp.html}.
+@url{https://www.gnu.org/software/emacs/manual/elisp.html}.
@end ifhtml
@ifnothtml
@xref{Top, Emacs Lisp Reference Manual,,elisp}.
@@ -1321,7 +1321,7 @@ the Emacs Lisp Reference Manual
@end ifclear
@item
-@url{http://www.gnu.org/software/emacs}
+@url{https://www.gnu.org/software/emacs}
@item
@url{http://www.emacswiki.org/}
@@ -1337,7 +1337,7 @@ the Emacs Lisp Reference Manual
@cindex coding standards
Contributed code should follow the GNU Coding Standards
-@url{http://www.gnu.org/prep/standards/}. This may also be available
+@url{https://www.gnu.org/prep/standards/}. This may also be available
in info on your system.
If it doesn't, we'll need to find someone to fix the code before we
@@ -1350,7 +1350,7 @@ Emacs has additional style and coding conventions:
@ifset WWW_GNU_ORG
@ifhtml
the ``Tips and Conventions'' Appendix in the Emacs Lisp Reference
-@url{http://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html}.
+@url{https://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html}.
@end ifhtml
@ifnothtml
@xref{Tips, ``Tips and Conventions'' Appendix in the Emacs Lisp Reference, Tips
@@ -1385,11 +1385,11 @@ Use @code{?\s} instead of @code{? } in Lisp code for a space character.
The FSF (Free Software Foundation) is the copyright holder for GNU Emacs.
The FSF is a nonprofit with a worldwide mission to promote computer
user freedom and to defend the rights of all free software users.
-For general information, see the website @url{http://www.fsf.org/}.
+For general information, see the website @url{https://www.fsf.org/}.
Generally speaking, for non-trivial contributions to GNU Emacs we
require that the copyright be assigned to the FSF@. For the reasons
-behind this, see @url{http://www.gnu.org/licenses/why-assign.html}.
+behind this, see @url{https://www.gnu.org/licenses/why-assign.html}.
Copyright assignment is a simple process. Residents of some countries
can do it entirely electronically. We can help you get started, and
@@ -1426,7 +1426,7 @@ Send a message to
the mailing list @email{help-gnu-emacs@@gnu.org},
@end ifnothtml
@ifhtml
-@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs, the
+@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs, the
help-gnu-emacs mailing list},
@end ifhtml
or post your request on newsgroup @code{gnu.emacs.help}. (This
@@ -1434,7 +1434,7 @@ mailing list and newsgroup interconnect, so it does not matter which
one you use.)
@item
-Look in the @uref{http://www.fsf.org/resources/service/, service
+Look in the @uref{https://www.fsf.org/resources/service/, service
directory} for someone who might help you for a fee.
@end itemize
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 8e5c5d5b612..00498399c79 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -238,20 +238,19 @@ is one, to determine the file version, since it is often more reliable
than the RCS master file. To inhibit using the version header this
way, change the variable @code{vc-consult-headers} to @code{nil}.
-@kindex C-x v h
@findex vc-insert-headers
@vindex vc-@var{backend}-header
- To insert a suitable header string into the current buffer, type
-@kbd{C-x v h} (@code{vc-insert-headers}). This command works only on
+ To insert a suitable header string into the current buffer, use the
+command @kbd{M-x vc-insert-headers}. This command works only on
Subversion, CVS, RCS, and SCCS@. The variable
@code{vc-@var{backend}-header} contains the list of keywords to insert
into the version header; for instance, CVS uses @code{vc-cvs-header},
whose default value is @code{'("\$Id\$")}. (The extra backslashes
prevent the string constant from being interpreted as a header, if the
Emacs Lisp file defining it is maintained with version control.) The
-@kbd{C-x v h} command inserts each keyword in the list on a new line
-at point, surrounded by tabs, and inside comment delimiters if
-necessary.
+@code{vc-insert-headers} command inserts each keyword in the list on a
+new line at point, surrounded by tabs, and inside comment delimiters
+if necessary.
@vindex vc-static-header-alist
The variable @code{vc-static-header-alist} specifies further strings
@@ -347,22 +346,9 @@ status by setting @code{vc-consult-headers} to @code{nil}. VC then
always uses the file permissions (if it is supposed to trust them), or
else checks the master file.
-@vindex vc-mistrust-permissions
- You can specify the criterion for whether to trust the file
-permissions by setting the variable @code{vc-mistrust-permissions}.
-Its value can be @code{t} (always mistrust the file permissions and
-check the master file), @code{nil} (always trust the file
-permissions), or a function of one argument which makes the decision.
-The argument is the directory name of the @file{RCS} subdirectory. A
-non-@code{nil} value from the function says to mistrust the file
-permissions. If you find that the file permissions of work files are
-changed erroneously, set @code{vc-mistrust-permissions} to @code{t}.
-Then VC always checks the master file to determine the file's status.
-
VC determines the version control state of files under SCCS much as
with RCS@. It does not consider SCCS version headers, though. Thus,
-the variable @code{vc-mistrust-permissions} affects SCCS use, but
-@code{vc-consult-headers} does not.
+the variable @code{vc-consult-headers} does not affect SCCS use.
@node CVS Options
@subsubsection Options specific for CVS
diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi
index 7e27ddd1d9a..eaefcee21c3 100644
--- a/doc/emacs/xresources.texi
+++ b/doc/emacs/xresources.texi
@@ -250,6 +250,11 @@ specified if @samp{off}.
Gamma correction for colors, equivalent to the frame parameter
@code{screen-gamma}.
+@item @code{scrollBar} (class @code{ScrollBar})
+@cindex tool bar
+If the value of this resource is @samp{off} or @samp{false} or
+@samp{0}, Emacs disables Scroll Bar mode at startup (@pxref{Scroll Bars}).
+
@item @code{scrollBarWidth} (class @code{ScrollBarWidth})
@cindex scrollbar width
The scroll bar width in pixels, equivalent to the frame parameter
diff --git a/doc/lispintro/ChangeLog.1 b/doc/lispintro/ChangeLog.1
index 7e5b629164b..de24c8e2bb2 100644
--- a/doc/lispintro/ChangeLog.1
+++ b/doc/lispintro/ChangeLog.1
@@ -797,4 +797,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in
index d8e203fd066..065a718f707 100644
--- a/doc/lispintro/Makefile.in
+++ b/doc/lispintro/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
diff --git a/doc/lispintro/README b/doc/lispintro/README
index f8134fce80b..18a39703dcb 100644
--- a/doc/lispintro/README
+++ b/doc/lispintro/README
@@ -42,4 +42,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/lispintro/cons-1.eps b/doc/lispintro/cons-1.eps
index 1d4e78cb737..fe3e6d2ad5c 100644
--- a/doc/lispintro/cons-1.eps
+++ b/doc/lispintro/cons-1.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/cons-2.eps b/doc/lispintro/cons-2.eps
index af59a0fd7db..a9838b4b493 100644
--- a/doc/lispintro/cons-2.eps
+++ b/doc/lispintro/cons-2.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/cons-2a.eps b/doc/lispintro/cons-2a.eps
index 2edcc21bebf..f5a048f3076 100644
--- a/doc/lispintro/cons-2a.eps
+++ b/doc/lispintro/cons-2a.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/cons-3.eps b/doc/lispintro/cons-3.eps
index f7e37f16f9f..55573676251 100644
--- a/doc/lispintro/cons-3.eps
+++ b/doc/lispintro/cons-3.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/cons-4.eps b/doc/lispintro/cons-4.eps
index f9549b9511a..86c3cfc2d16 100644
--- a/doc/lispintro/cons-4.eps
+++ b/doc/lispintro/cons-4.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/cons-5.eps b/doc/lispintro/cons-5.eps
index 83f14df6d2a..e66cff4df11 100644
--- a/doc/lispintro/cons-5.eps
+++ b/doc/lispintro/cons-5.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/doclicense.texi b/doc/lispintro/doclicense.texi
index 9c3bbe56e91..eaf3da0e92d 100644
--- a/doc/lispintro/doclicense.texi
+++ b/doc/lispintro/doclicense.texi
@@ -6,7 +6,7 @@
@display
Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
-@uref{http://fsf.org/}
+@uref{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -414,7 +414,7 @@ The Free Software Foundation may publish new, revised versions
of the GNU Free Documentation License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
+@uref{https://www.gnu.org/licenses/}.
Each version of the License is given a distinguishing version number.
If the Document specifies that a particular numbered version of this
diff --git a/doc/lispintro/drawers.eps b/doc/lispintro/drawers.eps
index b9efdceb554..97a581bb39c 100644
--- a/doc/lispintro/drawers.eps
+++ b/doc/lispintro/drawers.eps
@@ -24,7 +24,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 53 dict def
tgifdict begin
@@ -223,7 +223,7 @@ NP
GS
0
/Courier FF [17 0 0 -17 0 0] MS
- (symbol name) TGSW
+ (symbol name) TGSW
AD
GR
2 DI NE 0 RM
@@ -243,7 +243,7 @@ NP
GS
0
/Courier FF [17 0 0 -17 0 0] MS
- (Chest of Drawers) TGSW
+ (Chest of Drawers) TGSW
AD
GR
2 DI NE 0 RM
@@ -342,7 +342,7 @@ NP
GS
0
/NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS
- (directions to) TGSW
+ (directions to) TGSW
AD
GR
2 DI NE 0 RM
@@ -388,7 +388,7 @@ NP
GS
0
/Courier FF [17 0 0 -17 0 0] MS
- (symbol definition) TGSW
+ (symbol definition) TGSW
AD
GR
2 DI NE 0 RM
@@ -408,7 +408,7 @@ NP
GS
0
/NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS
- (directions to) TGSW
+ (directions to) TGSW
AD
GR
2 DI NE 0 RM
@@ -428,7 +428,7 @@ NP
GS
0
/Courier FF [17 0 0 -17 0 0] MS
- (variable name) TGSW
+ (variable name) TGSW
AD
GR
2 DI NE 0 RM
@@ -448,7 +448,7 @@ NP
GS
0
/NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS
- (directions to) TGSW
+ (directions to) TGSW
AD
GR
2 DI NE 0 RM
@@ -468,7 +468,7 @@ NP
GS
0
/Courier FF [17 0 0 -17 0 0] MS
- (property list) TGSW
+ (property list) TGSW
AD
GR
2 DI NE 0 RM
@@ -488,7 +488,7 @@ NP
GS
0
/NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS
- (directions to) TGSW
+ (directions to) TGSW
AD
GR
2 DI NE 0 RM
diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi
index 36d767737df..65ded50c396 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -120,7 +120,7 @@ Foundation, Inc.
@iftex
Published by the:@*
-GNU Press, @hfill @uref{http://www.fsf.org/licensing/gnu-press/}@*
+GNU Press, @hfill @uref{https://www.fsf.org/licensing/gnu-press/}@*
a division of the @hfill email: @email{sales@@fsf.org}@*
Free Software Foundation, Inc. @hfill Tel: +1 (617) 542-5942@*
51 Franklin Street, Fifth Floor @hfill Fax: +1 (617) 542-2652@*
@@ -128,10 +128,10 @@ Boston, MA 02110-1301 USA
@end iftex
@ifnottex
-Printed copies available from @uref{http://shop.fsf.org/}. Published by:
+Printed copies available from @uref{https://shop.fsf.org/}. Published by:
@example
-GNU Press, http://www.fsf.org/licensing/gnu-press/
+GNU Press, https://www.fsf.org/licensing/gnu-press/
a division of the email: sales@@fsf.org
Free Software Foundation, Inc. Tel: +1 (617) 542-5942
51 Franklin Street, Fifth Floor Fax: +1 (617) 542-2652
@@ -208,7 +208,7 @@ supports it in developing GNU and promoting software freedom.''
@ifset WWW_GNU_ORG
@html
<p>The homepage for GNU Emacs is at
-<a href="/software/emacs/">http://www.gnu.org/software/emacs/</a>.<br>
+<a href="/software/emacs/">https://www.gnu.org/software/emacs/</a>.<br>
To view this manual in other formats, click
<a href="/software/emacs/manual/eintr.html">here</a>.
@end html
@@ -831,7 +831,7 @@ An expert programmer who reviewed this text said to me:
@i{I prefer to learn from reference manuals. I ``dive into'' each
paragraph, and ``come up for air'' between paragraphs.}
-@i{When I get to the end of a paragraph, I assume that that subject is
+@i{When I get to the end of a paragraph, I assume that subject is
done, finished, that I know everything I need (with the
possible exception of the case when the next paragraph starts talking
about it in more detail). I expect that a well written reference manual
@@ -12059,7 +12059,7 @@ For more information, see
@ref{Indicating, , Indicating, texinfo, Texinfo Manual}, which goes to
a Texinfo manual in the current directory. Or, if you are on the
Internet, see
-@uref{http://www.gnu.org/software/texinfo/manual/texinfo/}
+@uref{https://www.gnu.org/software/texinfo/manual/texinfo/}
@end ifhtml
@iftex
``Indicating Definitions, Commands, etc.''@: in @cite{Texinfo, The GNU
@@ -21658,8 +21658,8 @@ can ill afford to lose manuals this way.
Free documentation, like free software, is a matter of freedom, not
price. The problem with these manuals was not that O'Reilly Associates
charged a price for printed copies---that in itself is fine. The Free
-Software Foundation @uref{http://shop.fsf.org, sells printed copies} of
-free @uref{http://www.gnu.org/doc/doc.html, GNU manuals}, too.
+Software Foundation @uref{https://shop.fsf.org, sells printed copies} of
+free @uref{https://www.gnu.org/doc/doc.html, GNU manuals}, too.
But GNU manuals are available in source code form, while these manuals
are available only on paper. GNU manuals come with permission to copy
and modify; the Perl manuals do not. These restrictions are the
@@ -21738,7 +21738,7 @@ copylefted manuals to non-copylefted ones.
@noindent
Note: The Free Software Foundation maintains a page on its Web site
that lists free books available from other publishers:@*
-@uref{http://www.gnu.org/doc/other-free-books.html}
+@uref{https://www.gnu.org/doc/other-free-books.html}
@node GNU Free Documentation License
@appendix GNU Free Documentation License
diff --git a/doc/lispintro/lambda-1.eps b/doc/lispintro/lambda-1.eps
index 47370b24b90..e349b20d36f 100644
--- a/doc/lispintro/lambda-1.eps
+++ b/doc/lispintro/lambda-1.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/lambda-2.eps b/doc/lispintro/lambda-2.eps
index 804dbfbd6fe..7be38da95e1 100644
--- a/doc/lispintro/lambda-2.eps
+++ b/doc/lispintro/lambda-2.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispintro/lambda-3.eps b/doc/lispintro/lambda-3.eps
index 95610f692ff..a3b419a9e80 100644
--- a/doc/lispintro/lambda-3.eps
+++ b/doc/lispintro/lambda-3.eps
@@ -19,7 +19,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
/tgifdict 132 dict def
tgifdict begin
diff --git a/doc/lispref/ChangeLog.1 b/doc/lispref/ChangeLog.1
index 1044ad7370b..c461f9a42b1 100644
--- a/doc/lispref/ChangeLog.1
+++ b/doc/lispref/ChangeLog.1
@@ -497,7 +497,7 @@
Improve doc for use of 'int', and discuss 'ssize_t'.
* internals.texi (C Integer Types): Mention 'int' for other
randomish values that lie in 'int' range. Mention 'ssize_t'. See:
- http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00019.html
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00019.html
Use AUTO_CONS instead of SCOPED_CONS, etc.
* internals.texi (Stack-allocated Objects):
@@ -971,7 +971,7 @@
* markers.texi (Moving Marker Positions): Clarify guidance about
when to move markers and when to create a new one, as discussed at
- http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16818#17
+ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16818#17
2014-03-02 Glenn Morris <rgm@gnu.org>
@@ -2154,7 +2154,7 @@
* internals.texi (C Integer Types): New section.
This follows up and records an email in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00496.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00496.html>.
2012-12-10 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -2475,7 +2475,7 @@
* os.texi (Time of Day):
Update for new time stamp format (HIGH LOW MICROSEC PICOSEC).
These instances were missed the first time around.
- Problem reported by Glenn Morris in <http://bugs.gnu.org/12706#25>.
+ Problem reported by Glenn Morris in <https://bugs.gnu.org/12706#25>.
2012-10-24 Chong Yidong <cyd@gnu.org>
@@ -6288,7 +6288,7 @@
2009-04-11 Eli Zaretskii <eliz@gnu.org>
* display.texi (Overlays): Overlays don't scale well. See
- http://lists.gnu.org/archive/html/emacs-devel/2009-04/msg00243.html.
+ https://lists.gnu.org/r/emacs-devel/2009-04/msg00243.html.
2009-04-10 Chong Yidong <cyd@stupidchicken.com>
@@ -14004,4 +14004,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in
index 89eb81093d1..9fa5901a1ac 100644
--- a/doc/lispref/Makefile.in
+++ b/doc/lispref/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
diff --git a/doc/lispref/README b/doc/lispref/README
index fbc3169ceef..b3f450a1295 100644
--- a/doc/lispref/README
+++ b/doc/lispref/README
@@ -18,7 +18,7 @@ or for HTML.
* You can buy nicely printed copies from the Free Software Foundation.
Buying a manual from the Free Software Foundation helps support our GNU
-development work. See <http://shop.fsf.org/>.
+development work. See <https://shop.fsf.org/>.
(At time of writing, this manual is out of print.)
* The master file for formatting this manual for Tex is called 'elisp.texi'.
@@ -45,4 +45,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi
index 02d08ebc019..fc14c8cfca5 100644
--- a/doc/lispref/anti.texi
+++ b/doc/lispref/anti.texi
@@ -6,110 +6,158 @@
@c This node must have no pointers.
@node Antinews
-@appendix Emacs 24 Antinews
+@appendix Emacs 25 Antinews
@c Update the elisp.texi Antinews menu entry with the above version number.
For those users who live backwards in time, here is information about
-downgrading to Emacs version 24.5. We hope you will enjoy the greater
-simplicity that results from the absence of many Emacs @value{EMACSVER}
-features.
+downgrading to Emacs version 25.2. We hope you will enjoy the greater
+simplicity that results from the absence of many @w{Emacs
+@value{EMACSVER}} features.
-@section Old Lisp Features in Emacs 24
+@section Old Lisp Features in Emacs 25
@itemize @bullet
@item
-The requirement that @code{setq} and @code{setf} must be called with
-an even number of arguments has been removed. You can now call them
-with an odd number of arguments, and Emacs will helpfully supply a
-@code{nil} for the missing one. Simplicity rules!
+The concurrency features have been removed. Even in its limited
+``mostly cooperative'' form, with only one Lisp thread running at any
+given time, it made Emacs significantly more complex for Lisp programs
+that need to work correctly in the presence of additional threads.
@item
-@kbd{M-x shell} and @kbd{M-x compile} set the @env{EMACS} environment
-variable, as they should, to indicate that the subprocess is run by
-Emacs. This is so packages that took years to learn how to work
-around that setting could continue using their code to that effect.
+Handling of file attributes has been simplified by discarding the
+accessor functions, such as @code{file-attribute-type} and
+@code{file-attribute-modification-time}. Real Lisp programmers always
+access the individual attributes by their ordinal numbers, and can
+recite those numbers in their sleep.
@item
-The @code{save-excursion} form saves and restores the mark, as
-expected. No more need for the new @code{save-mark-and-excursion},
-which has been deleted.
+The networking code is back at its pristine simplicity, as we deleted
+the use of asynchronous DNS resolution, connection, and TLS
+negotiation for TLS streams. You no longer need to consider the
+resulting complexity and interesting race conditions when you write
+Lisp programs that use network communications. As a direct
+consequence, the @code{:complete-negotiation} parameter of
+@code{gnutls-boot} has become unnecessary, and was removed---just one
+example of how removal of asynchronicity simplifies Emacs.
@item
-We have removed the @code{text-quoting-style} variable and the
-associated functionality that translates quote characters in messages
-displayed to the user and in help buffers. Emacs now shows exactly
-the same quote characters as you wrote in your code! Likewise,
-@code{substitute-command-keys} leaves the quote characters alone. As
-you move back in time, Unicode support becomes less and less
-important, so no need to display those fancy new quotes the Unicode
-Standard invented.
+We've removed the @file{puny.el} library, so Web sites with
+non-@acronym{ASCII} URLs are no longer easily accessible. But such
+sites become more and more rare as you move back in time, so having a
+specialized library for their support was deemed an unnecessary
+maintenance burden.
+
+@item
+Field numbers like @samp{%2$} in format specifiers are no longer
+available. We decided that their use makes code reading and
+comprehension much harder, and that having them is unjustified in the
+past where similar features in popular C libraries will also be gone.
+
+@item
+Since the built-in capability to display line numbers has been removed
+(@pxref{Antinews,,, emacs, The GNU Emacs Manual}), we've also deleted
+the @code{line-number-display-width} function and the support for the
+@code{display-line-numbers-disable} property, as Lisp programs that do
+their own display layout decisions no longer need to cater to this
+tricky feature.
@item
Regular expressions have been simplified by removing support for
-Unicode character properties in regexp classes. As result,
-@code{[:alpha:]} and @code{[:alnum:]} will match any character with a
-word syntax, and @code{[:graph:]} and @code{[:print:]} will match any
-multibyte character, including surrogates and unassigned codepoints.
-Once again, this is in line with diminishing importance of Unicode as
-you move back in time.
+Unicode character properties in the @code{[:blank:]} regexp class. As
+result, this class will match only spaces and tabs. Once again, this
+is in line with diminishing importance of Unicode as you move back in
+time.
+
+@item
+For similar reasons, we removed the function @code{char-from-name}.
+It should be easy enough to access the full list of Unicode characters
+returned by @code{ucs-names} instead, for as long as Unicode support
+in Emacs exists (which shouldn't be too long).
+
+@item
+Various functions that accept file names as arguments, such as
+@code{file-attributes}, @code{file-symlink-p}, and
+@code{make-symbolic-link} gained back the special support for file
+names quoted with @samp{/:}, and they now interpret @samp{~} in
+symlink targets as you'd expect: to mean your home directory. The
+confusing differences between the operation of these functions in
+interactive and non-interactive invocations has been removed.
+
+@item
+The function @file{assoc} has been simplified by removing its third
+optional argument. It now always uses @code{equal} for comparison.
+Likewise, @code{alist-get} always uses @code{assq}, and @code{map-get}
+and @code{map-put} always use @code{eql} for their comparisons.
+
+@item
+GnuTLS cryptographic functions are no longer available in Emacs. We
+have decided that the needs for such functionality are deteriorating,
+and their cumbersome interfaces make them hard to use.
+
+@item
+We have removed support for records of user-defined types, and
+@code{cl-defstruct} no longer uses records. This removes the
+potential for quite a few places where existing and past code could be
+broken by records.
+
+@item
+You can again use @code{string-as-unibyte},
+@code{string-make-multibyte}, and other similar functions, without
+being annoyed by messages about their deprecation. This is in
+preparation for removal of multibyte text from Emacs in the distance
+past.
@item
-Evaluating @samp{(/ @var{n})} will now yield @var{n}. We have
-realized that interpreting that as in Common Lisp was a bad mistake
-that needed to be corrected.
+The function @code{read-color} no longer displays color names using
+each color as the background. We have determined that this surprises
+users and produces funny inconsistent results on color-challenged
+terminals.
@item
-The @code{pcase} form was significantly simplified by removing the
-UPatterns @code{quote} and @code{app}. To further simplify this
-facility, we've removed @code{pcase-defmacro}, since we found no need
-for letting Lisp programs define new UPatterns.
+We removed the function @code{file-name-case-insensitive-p}, as
+testing for the OS symbol should be enough for the observable past to
+come, and learning to use yet another API is a burden.
@item
-We've removed the text properties @code{cursor-intangible} and
-@code{cursor-sensor-functions}, replacing them by the much simpler
-@code{intangible}, @code{point-entered}, and @code{point-left}
-properties. The latter are implemented on a much lower level, and
-therefore are better integrated with user expectations. For similar
-reasons, @code{cursor-intangible-mode} and @code{cursor-sensor-mode}
-were removed; use the hook variable @code{inhibit-point-motion-hooks}
-which is no longer obsolete.
+The function @code{read-multiple-choice} is also gone, in recognition
+of the fact that nothing makes Emacs Lisp hacker rejoice more than the
+need to sit down and write yet another interactive question-and-answer
+function, and make it optimal for each specific case.
@item
-Process creation and management functions were significantly improved
-and simplified by removing @code{make-process} and the @code{pipe}
-connection type. Redirecting @code{stderr} of a subprocess should be
-done with shell facilities, not by Emacs.
+The function @code{add-variable-watcher} and the corresponding
+debugger command @code{debug-on-variable-change} have been removed.
+They make debugging more complicated, while examining the value of a
+variable at each stop point is easy enough to cover the same use
+cases. Let simplicity rule!
@item
-We decided that shutting up informative messages is bad for user
-interaction, so we've removed the @code{inhibit-message} variable
-which could be used to that effect.
+The function @code{mapcan} is gone; use @code{mapcar} instead, and
+process the resulting list as you see fit.
@item
-Support for generators and for finalizers has been removed, as we
-found no real need for these facilities.
+You can once again write a Lisp program that returns funny random
+values from @code{file-attributes} by having another process alter the
+filesystem while Emacs is accessing the file. This can give rise to
+some interesting applications in the near past.
@item
-Due to excessive complexity and the diminishing need for Unicode
-support, the functions @code{string-collate-lessp} and
-@code{string-collate-equalp} were removed. Their locale-independent
-counterparts @code{string-lessp} and @code{string-equal} are so much
-more simple and yield predictable results that we don't see any
-situation where the locale-dependent collation could be useful in
-Emacs. As result, the @file{ls-lisp.el} package sorts files in a
-locale-independent manner.
+We have removed the functions @code{file-name-quote},
+@code{file-name-unquote}, and @code{file-name-quoted-p}. Writing code
+that checks whether a file name is already quoted is easy, and doubly
+quoting a file name should not produce any problems for well-written
+Lisp code.
@item
-In preparation for removal in some past version of Emacs of the
-bidirectional editing support, we started by deleting two functions
-@code{bidi-find-overridden-directionality} and
-@code{buffer-substring-with-bidi-context}.
+Frame parameters like @code{z-group}, @code{min-width},
+@code{parent-frame}, @code{delete-before}, etc. have been removed.
+Emacs should not replace your window-manager, certainly not as
+window-managers become less and less capable.
@item
-Time conversion functions, such as @code{current-time-string}, no
-longer accept an optional @var{zone} argument. If you need to change
-the current time zone (why?), do that explicitly with
-@code{set-time-zone-rule}.
+We decided that the format of mode line and header line should be
+customizable only based on buffers; the @code{mode-line-format} and
+@code{header-line-format} window parameters have been removed.
@item
As part of the ongoing quest for simplicity, many other functions and
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index 3e2d1f62483..48251c7c518 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -129,7 +129,7 @@ its value. Major modes should not set this variable---they should set
@defopt backup-directory-alist
This variable's value is an alist of filename patterns and backup
-directory names. Each element looks like
+directories. Each element looks like
@smallexample
(@var{regexp} . @var{directory})
@end smallexample
@@ -145,7 +145,7 @@ truncates the resulting name.
For the common case of all backups going into one directory, the alist
should contain a single element pairing @samp{"."} with the appropriate
-directory name.
+directory.
If this variable is @code{nil} (the default), or it fails to match a
filename, the backup is made in the original file's directory.
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index cf24a730ba6..0d02cb3d3e9 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -1089,12 +1089,15 @@ is not cleared by changing major modes.
@defopt buffer-offer-save
This variable, if non-@code{nil} in a particular buffer, tells
-@code{save-buffers-kill-emacs} and @code{save-some-buffers} (if the
-second optional argument to that function is @code{t}) to offer to
-save that buffer, just as they offer to save file-visiting buffers.
-@xref{Definition of save-some-buffers}. The variable
-@code{buffer-offer-save} automatically becomes buffer-local when set
-for any reason. @xref{Buffer-Local Variables}.
+@code{save-buffers-kill-emacs} to offer to save that buffer, just as
+it offers to save file-visiting buffers. If @code{save-some-buffers}
+is called with the second optional argument set to @code{t}, it will
+also offer to save the buffer. Lastly, if this variable is set to the
+symbol @code{always}, both @code{save-buffers-kill-emacs} and
+@code{save-some-buffers} will always offer to save. @xref{Definition
+of save-some-buffers}. The variable @code{buffer-offer-save}
+automatically becomes buffer-local when set for any reason.
+@xref{Buffer-Local Variables}.
@end defopt
@defvar buffer-save-without-query
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index 274f8b47063..16b58d3d3c8 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -395,7 +395,7 @@ Completion, Prompt.
The position of point, as an integer (@pxref{Point}). No I/O.
@item D
-A directory name. The default is the current default directory of the
+A directory. The default is the current default directory of the
current buffer, @code{default-directory} (@pxref{File Name Expansion}).
Existing, Completion, Default, Prompt.
@@ -1005,11 +1005,11 @@ If the last event came from a keyboard macro, the value is @code{macro}.
@cindex @code{display} property, and point display
@cindex @code{composition} property, and point display
- It is not easy to display a value of point in the middle of a
-sequence of text that has the @code{display}, @code{composition} or
-is invisible. Therefore, after a command finishes and returns to the
-command loop, if point is within such a sequence, the command loop
-normally moves point to the edge of the sequence.
+ Emacs cannot display the cursor when point is in the middle of a
+sequence of text that has the @code{display} or @code{composition}
+property, or is invisible. Therefore, after a command finishes and
+returns to the command loop, if point is within such a sequence, the
+command loop normally moves point to the edge of the sequence.
A command can inhibit this feature by setting the variable
@code{disable-point-adjustment}:
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 201d9fc2fa5..57ff06085d9 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -434,6 +434,7 @@ to what @code{eval-when-compile} does.
@node Compiler Errors
@section Compiler Errors
@cindex compiler errors
+@cindex byte-compiler errors
Error and warning messages from byte compilation are printed in a
buffer named @file{*Compile-Log*}. These messages include file names
@@ -450,6 +451,10 @@ compiled, and point shows how far the byte compiler was able to read;
the cause of the error might be nearby. @xref{Syntax Errors}, for
some tips for locating syntax errors.
+@cindex byte-compiler warnings
+@cindex free variable, byte-compiler warning
+@cindex reference to free variable, compilation warning
+@cindex function not known to be defined, compilation warning
A common type of warning issued by the byte compiler is for
functions and variables that were used but not defined. Such warnings
report the line number for the end of the file, not the locations
@@ -490,12 +495,13 @@ The reference to @var{variable} must be in the @var{then-form} of the
@item
You can tell the compiler that a function is defined using
-@code{declare-function}. @xref{Declaring Functions}.
+@code{declare-function}. @xref{Declaring Functions}.
@item
Likewise, you can tell the compiler that a variable is defined using
@code{defvar} with no initial value. (Note that this marks the
-variable as special.) @xref{Defining Variables}.
+variable as special, i.e.@: dynamically bound.) @xref{Defining
+Variables}.
@end itemize
You can also suppress any and all compiler warnings within a certain
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 401a999cf23..4eddbe9c122 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1101,13 +1101,10 @@ These examples show typical uses of @code{error}:
error symbol @code{error}, and a list containing the string returned by
@code{format-message}.
-The @code{text-quoting-style} variable controls what quotes are
-generated; @xref{Keys in Documentation}. A call using a format like
-@t{"Missing `%s'"} with grave accents and apostrophes typically
-generates a message like @t{"Missing ‘foo’"} with matching curved
-quotes. In contrast, a call using a format like @t{"Missing '%s'"}
-with only apostrophes typically generates a message like @t{"Missing
-’foo’"} with only closing curved quotes, an unusual style in English.
+Typically grave accent and apostrophe in the format translate to
+matching curved quotes, e.g., @t{"Missing `%s'"} might result in
+@t{"Missing ‘foo’"}. @xref{Text Quoting Style}, for how to influence
+or inhibit this translation.
@strong{Warning:} If you want to use your own string as an error message
verbatim, don't just write @code{(error @var{string})}. If @var{string}
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 5372728466f..ed455828f6e 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -599,7 +599,7 @@ The value must be a file name for an existing file. The widget
provides completion.
@item directory
-The value must be a directory name. The widget provides completion.
+The value must be a directory. The widget provides completion.
@item hook
The value must be a list of functions. This customization type is
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 2ca4a0a849e..fe3446ada2d 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -135,7 +135,7 @@ set @code{debug-ignored-errors} to @code{nil}.
@defopt eval-expression-debug-on-error
If this variable has a non-@code{nil} value (the default), running the
command @code{eval-expression} causes @code{debug-on-error} to be
-temporarily bound to to @code{t}. @xref{Lisp Eval,, Evaluating
+temporarily bound to @code{t}. @xref{Lisp Eval,, Evaluating
Emacs-Lisp Expressions, emacs, The GNU Emacs Manual}.
If @code{eval-expression-debug-on-error} is @code{nil}, then the value
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 4de55fd3fb2..a505639f514 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -265,13 +265,10 @@ properties, it is displayed with the specified faces (@pxref{Faces}).
The string is also added to the @file{*Messages*} buffer, but without
text properties (@pxref{Logging Messages}).
-The @code{text-quoting-style} variable controls what quotes are
-generated; @xref{Keys in Documentation}. A call using a format like
-@t{"Missing `%s'"} with grave accents and apostrophes typically
-generates a message like @t{"Missing ‘foo’"} with matching curved
-quotes. In contrast, a call using a format like @t{"Missing '%s'"}
-with only apostrophes typically generates a message like @t{"Missing
-’foo’"} with only closing curved quotes, an unusual style in English.
+Typically grave accent and apostrophe in the format translate to
+matching curved quotes, e.g., @t{"Missing `%s'"} might result in
+@t{"Missing ‘foo’"}. @xref{Text Quoting Style}, for how to influence
+or inhibit this translation.
In batch mode, the message is printed to the standard error stream,
followed by a newline.
@@ -810,7 +807,7 @@ mechanism can change the variable @code{delayed-warnings-hook}:
@defvar delayed-warnings-hook
This is a normal hook which is run by the Emacs command loop, after
-@code{post-command-hook}, in order to to process and display delayed
+@code{post-command-hook}, in order to process and display delayed
warnings.
Its default value is a list of two functions:
@@ -1974,12 +1971,98 @@ line, if present, in the return value. If it is @code{t}, include the
height of both, if present, in the return value.
@end defun
+@code{window-text-pixel-size} treats the text displayed in a window as a
+whole and does not care about the size of individual lines. The
+following function does.
+
+@defun window-lines-pixel-dimensions &optional window first last body inverse
+This function calculates the pixel dimensions of each line displayed in
+the specified @var{window}. It does so by walking @var{window}'s
+current glyph matrix---a matrix storing the glyph (@pxref{Glyphs}) of
+each buffer character currently displayed in @var{window}. If
+successful, it returns a list of cons pairs representing the x- and
+y-coordinates of the lower right corner of the last character of each
+line. Coordinates are measured in pixels from an origin (0, 0) at the
+top-left corner of @var{window}. @var{window} must be a live window and
+defaults to the selected one.
+
+If the optional argument @var{first} is an integer, it denotes the index
+(starting with 0) of the first line of @var{window}'s glyph matrix to be
+returned. Note that if @var{window} has a header line, the line with
+index 0 is that header line. If @var{first} is nil, the first line to
+be considered is determined by the value of the optional argument
+@var{body}: If @var{body} is non-@code{nil}, this means to start with
+the first line of @var{window}'s body, skipping any header line, if
+present. Otherwise, this function will start with the first line of
+@var{window}'s glyph matrix, possibly the header line.
+
+If the optional argument @var{last} is an integer, it denotes the index
+of the last line of @var{window}'s glyph matrix that shall be returned.
+If @var{last} is nil, the last line to be considered is determined by
+the value of @var{body}: If @var{body} is non-@code{nil}, this means to
+use the last line of @var{window}'s body, omitting @var{window}'s mode
+line, if present. Otherwise, this means to use the last line of
+@var{window} which may be the mode line.
+
+The optional argument @var{inverse}, if @code{nil}, means that the
+y-pixel value returned for any line specifies the distance in pixels
+from the left edge (body edge if @var{body} is non-@code{nil}) of
+@var{window} to the right edge of the last glyph of that line.
+@var{inverse} non-@code{nil} means that the y-pixel value returned for
+any line specifies the distance in pixels from the right edge of the
+last glyph of that line to the right edge (body edge if @var{body} is
+non-@code{nil}) of @var{window}. This is useful for determining the
+amount of slack space at the end of each line.
+
+The optional argument @var{left}, if non-@code{nil} means to return the
+x- and y-coordinates of the lower left corner of the leftmost character
+on each line. This is the value that should be used for windows that
+mostly display text from right to left.
+
+If @var{left} is non-@code{nil} and @var{inverse} is @code{nil}, this
+means that the y-pixel value returned for any line specifies the
+distance in pixels from the left edge of the last (leftmost) glyph of
+that line to the right edge (body edge if @var{body} is non-@code{nil})
+of @var{window}. If @var{left} and @var{inverse} are both
+non-@code{nil}, the y-pixel value returned for any line specifies the
+distance in pixels from the left edge (body edge if @var{body} is
+non-@code{nil}) of @var{window} to the left edge of the last (leftmost)
+glyph of that line.
+
+This function returns @code{nil} if the current glyph matrix of
+@var{window} is not up-to-date which usually happens when Emacs is busy,
+for example, when processing a command. The value should be retrievable
+though when this function is run from an idle timer with a delay of zero
+seconds.
+@end defun
+
@defun line-pixel-height
This function returns the height in pixels of the line at point in the
selected window. The value includes the line spacing of the line
(@pxref{Line Height}).
@end defun
+When a buffer is displayed with line numbers (@pxref{Display Custom,,,
+emacs, The GNU Emacs Manual}), it is sometimes useful to know the
+width taken for displaying the line numbers. The following function
+is for Lisp programs which need this information for layout
+calculations.
+
+@defun line-number-display-width &optional pixelwise
+This function returns the width used for displaying the line numbers
+in the selected window. If the optional argument @var{pixelwise} is
+the symbol @code{columns}, the return value is a float number of the
+frame's canonical columns; if @var{pixelwise} is @code{t} or any other
+non-@code{nil} value, the value is an integer and is measured in
+pixels. If @var{pixelwise} is omitted or @code{nil}, the value is the
+integer number of columns of the font defined for the
+@code{line-number} face, and doesn't include the 2 columns used to pad
+the numbers on display. If line numbers are not displayed in the
+selected window, the value is zero regardless of the value of
+@var{pixelwise}. Use @code{with-selected-window} (@pxref{Selecting
+Windows}) if you need this information about another window.
+@end defun
+
@node Line Height
@section Line Height
@@ -2341,7 +2424,9 @@ the values of the @code{:family}, @code{:foundry}, @code{:width},
The name of a face from which to inherit attributes, or a list of face
names. Attributes from inherited faces are merged into the face like
an underlying face would be, with higher priority than underlying
-faces (@pxref{Displaying Faces}). If a list of faces is used,
+faces (@pxref{Displaying Faces}). If the face to inherit from is
+@code{unspecified}, it is treated the same as @code{nil}, since Emacs
+never merges @code{:inherit} attributes. If a list of faces is used,
attributes from faces earlier in the list override those from later
faces.
@end table
@@ -2802,6 +2887,16 @@ non-selected window, Emacs applies the @code{mode-line-inactive} face.
For a header line, Emacs applies the @code{header-line} face.
@item
+If the text comes from an overlay string via @code{before-string} or
+@code{after-string} properties (@pxref{Overlay Properties}), or from a
+display string (@pxref{Other Display Specs}), and the string doesn't
+contain a @code{face} or @code{mouse-face} property, but the buffer
+text affected by the overlay/display property does define a face,
+Emacs applies the face attributes of the ``underlying'' buffer text.
+Note that this is so even if the overlay or display string is
+displayed in the display margins (@pxref{Display Margins}).
+
+@item
If any given attribute has not been specified during the preceding
steps, Emacs applies the attribute of the @code{default} face.
@end itemize
@@ -4402,6 +4497,17 @@ for the @code{display} property, only one of the values takes effect,
following the rules of @code{get-char-property}. @xref{Examining
Properties}.
+@cindex display property, unsafe evaluation
+@cindex security, and display specifications
+ Some of the display specifications allow inclusion of Lisp forms,
+which are evaluated at display time. This could be unsafe in certain
+situations, e.g., when the display specification was generated by some
+external program/agent. Wrapping a display specification in a list
+that begins with the special symbol @code{disable-eval}, as in
+@w{@code{('disable-eval @var{spec})}}, will disable evaluation of any
+Lisp in @var{spec}, while still supporting all the other display
+property features.
+
The rest of this section describes several kinds of
display specifications and what they mean.
@@ -4543,7 +4649,7 @@ as an absolute number of pixels.
@smallexample
@group
- @var{expr} ::= @var{num} | (@var{num}) | @var{unit} | @var{elem} | @var{pos} | @var{image} | @var{form}
+ @var{expr} ::= @var{num} | (@var{num}) | @var{unit} | @var{elem} | @var{pos} | @var{image} | @var{xwidget} | @var{form}
@var{num} ::= @var{integer} | @var{float} | @var{symbol}
@var{unit} ::= in | mm | cm | width | height
@end group
@@ -4559,22 +4665,34 @@ as an absolute number of pixels.
The form @var{num} specifies a fraction of the default frame font
height or width. The form @code{(@var{num})} specifies an absolute
number of pixels. If @var{num} is a symbol, @var{symbol}, its
-buffer-local variable binding is used.
+buffer-local variable binding is used; that binding can be either a
+number or a cons cell of the forms shown above (including yet another
+cons cell whose @code{car} is a symbol that has a buffer-local
+binding).
The @code{in}, @code{mm}, and @code{cm} units specify the number of
pixels per inch, millimeter, and centimeter, respectively. The
@code{width} and @code{height} units correspond to the default width
-and height of the current face. An image specification @code{image}
-corresponds to the width or height of the image.
+and height of the current face. An image specification of the form
+@w{@code{(image . @var{props})}} (@pxref{Image Descriptors})
+corresponds to the width or height of the specified image. Similarly,
+an xwidget specification of the form @w{@code{(xwidget . @var{props})}}
+stands for the width or height of the specified xwidget.
+@xref{Xwidgets}.
The elements @code{left-fringe}, @code{right-fringe},
@code{left-margin}, @code{right-margin}, @code{scroll-bar}, and
-@code{text} specify to the width of the corresponding area of the
-window.
+@code{text} specify the width of the corresponding area of the window.
+When the window displays line numbers (@pxref{Size of Displayed
+Text}), the width of the @code{text} area is decreased by the screen
+space taken by the line-number display.
The @code{left}, @code{center}, and @code{right} positions can be
used with @code{:align-to} to specify a position relative to the left
-edge, center, or right edge of the text area.
+edge, center, or right edge of the text area. When the window
+displays line numbers, the @code{left} and the @code{center} positions
+are offset to account for the screen space taken by the line-number
+display.
Any of the above window elements (except @code{text}) can also be
used with @code{:align-to} to specify that the position is relative to
@@ -4590,13 +4708,15 @@ the left-margin, use
If no specific base offset is set for alignment, it is always relative
to the left edge of the text area. For example, @samp{:align-to 0} in a
-header-line aligns with the first text column in the text area.
+header-line aligns with the first text column in the text area. When
+the window displays line numbers, the text is considered to start where
+the space used for line-number display ends.
A value of the form @code{(@var{num} . @var{expr})} stands for the
product of the values of @var{num} and @var{expr}. For example,
@code{(2 . in)} specifies a width of 2 inches, while @code{(0.5 .
@var{image})} specifies half the width (or height) of the specified
-image.
+@var{image} (which should be given by its image spec).
The form @code{(+ @var{expr} ...)} adds up the value of the
expressions. The form @code{(- @var{expr} ...)} negates or subtracts
@@ -4743,6 +4863,13 @@ certain buffer text, without altering or preventing the display of
that text, put a @code{before-string} property on the text and put the
margin display specification on the contents of the before-string.
+ Note that if the string to be displayed in the margin doesn't
+specify a face, its face is determined using the same rules and
+priorities as it is for strings displayed in the text area
+(@pxref{Displaying Faces}). If this results in undesirable
+``leaking'' of faces into the margin, make sure the string has an
+explicit face specified for it.
+
Before the display margins can display anything, you must give
them a nonzero width. The usual way to do that is to set these
variables:
@@ -5223,6 +5350,17 @@ and if @code{:height} is set it will have precedence over
wish. @code{:max-width} and @code{:max-height} will always preserve
the aspect ratio.
+If both @code{:width} and @code{:max-height} has been set (but
+@code{:height} has not been set), then @code{:max-height} will have
+precedence. The same is the case for the opposite combination: The
+``max'' keyword has precedence. That is, if you have a 200x100 image
+and specify that @code{:width} should be 400 and @code{:max-height}
+should be 150, you'll end up with an image that is 300x150: Preserving
+the aspect ratio and not exceeding the ``max'' setting. This
+combination of parameters is a useful way of saying ``display this
+image as large as possible, but no larger than the available display
+area''.
+
@item :scale @var{scale}
This should be a number, where values higher than 1 means to increase
the size, and lower means to decrease the size. For instance, a value
@@ -5243,7 +5381,7 @@ hint to ImageMagick to help it detect the image type.
Specifies a rotation angle in degrees.
@item :index @var{frame}
-@c Doesn't work: http://debbugs.gnu.org/7978
+@c Doesn't work: https://debbugs.gnu.org/7978
@xref{Multi-Frame Images}.
@end table
@@ -5531,14 +5669,14 @@ This variable's value is a list of locations in which to search for
image files. If an element is a string or a variable symbol whose
value is a string, the string is taken to be the name of a directory
to search. If an element is a variable symbol whose value is a list,
-that is taken to be a list of directory names to search.
+that is taken to be a list of directories to search.
The default is to search in the @file{images} subdirectory of the
directory specified by @code{data-directory}, then the directory
specified by @code{data-directory}, and finally in the directories in
@code{load-path}. Subdirectories are not automatically included in
the search, so if you put an image file in a subdirectory, you have to
-supply the subdirectory name explicitly. For example, to find the
+supply the subdirectory explicitly. For example, to find the
image @file{images/foo/bar.xpm} within @code{data-directory}, you
should specify the image as follows:
@@ -6929,7 +7067,7 @@ window display table nor a buffer display table defined, or when Emacs
is outputting text to the standard output or error streams. Although its
default is typically @code{nil}, in an interactive session if the
terminal cannot display curved quotes, its default maps curved quotes
-to ASCII approximations. @xref{Keys in Documentation}.
+to ASCII approximations. @xref{Text Quoting Style}.
@end defvar
The @file{disp-table} library defines several functions for changing
@@ -7297,7 +7435,11 @@ follows the Unicode Bidirectional Algorithm (a.k.a.@: @acronym{UBA}),
which is described in Annex #9 of the Unicode standard
(@url{http://www.unicode.org/reports/tr9/}). Emacs provides a ``Full
Bidirectionality'' class implementation of the @acronym{UBA},
-consistent with the requirements of the Unicode Standard v8.0.
+consistent with the requirements of the Unicode Standard v9.0. Note,
+however, that the way Emacs displays continuation lines when text
+direction is opposite to the base paragraph direction deviates from
+the UBA, which requires to perform line wrapping before reordering
+text for display.
@defvar bidi-display-reordering
If the value of this buffer-local variable is non-@code{nil} (the
@@ -7359,6 +7501,35 @@ truncated or continued when the text reaches the right margin.
Right-to-left paragraphs are displayed beginning at the right margin,
and are continued or truncated at the left margin.
+@cindex paragraph-start, and bidirectional display
+@cindex paragraph-separate, and bidirectional display
+ Where exactly paragraphs start and end, for the purpose of the Emacs
+@acronym{UBA} implementation, is determined by the following two
+buffer-local variables (note that @code{paragraph-start} and
+@code{paragraph-separate} have no influence on this). By default both
+of these variables are @code{nil}, and paragraphs are bounded by empty
+lines, i.e., lines that consist entirely of zero or more whitespace
+characters followed by a newline.
+
+@defvar bidi-paragraph-start-re
+If non-@code{nil}, this variable's value should be a regular
+expression matching a line that starts or separates two paragraphs.
+The regular expression is always matched after a newline, so it is
+best to anchor it, i.e., begin it with a @code{"^"}.
+@end defvar
+
+@defvar bidi-paragraph-separate-re
+If non-@code{nil}, this variable's value should be a regular
+expression matching a line separates two paragraphs. The regular
+expression is always matched after a newline, so it is best to anchor
+it, i.e., begin it with a @code{"^"}.
+@end defvar
+
+ If you modify any of these two variables, you should normally modify
+both, to make sure they describe paragraphs consistently. For
+example, to have each new line start a new paragraph for
+bidi-reordering purposes, set both variables to @code{"^"}.
+
By default, Emacs determines the base direction of each paragraph by
looking at the text at its beginning. The precise method of
determining the base direction is specified by the @acronym{UBA}; in a
diff --git a/doc/lispref/doclicense.texi b/doc/lispref/doclicense.texi
index 9c3bbe56e91..eaf3da0e92d 100644
--- a/doc/lispref/doclicense.texi
+++ b/doc/lispref/doclicense.texi
@@ -6,7 +6,7 @@
@display
Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
-@uref{http://fsf.org/}
+@uref{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -414,7 +414,7 @@ The Free Software Foundation may publish new, revised versions
of the GNU Free Documentation License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
+@uref{https://www.gnu.org/licenses/}.
Each version of the License is given a distinguishing version number.
If the Document specifies that a particular numbered version of this
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index da72c9b700c..979add9f319 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -244,7 +244,7 @@ least for a certain distance.
@item S
Stop: don't execute any more of the program, but wait for more
Edebug commands (@code{edebug-stop}).
-@c FIXME Does not work. http://debbugs.gnu.org/9764
+@c FIXME Does not work. https://debbugs.gnu.org/9764
@item @key{SPC}
Step: stop at the next stop point encountered (@code{edebug-step-mode}).
@@ -1139,14 +1139,17 @@ definition, but specifications are much more general than macro
arguments. @xref{Defining Macros}, for more explanation of
the @code{declare} form.
-@c See, e.g., http://debbugs.gnu.org/10577
+@c See, e.g., https://debbugs.gnu.org/10577
@c FIXME Maybe there should be an Edebug option to get it to
@c automatically load the entire source file containing the function
@c being instrumented. That would avoid this.
Take care to ensure that the specifications are known to Edebug when
-you instrument code. If you are instrumenting a function from a file
-that uses @code{eval-when-compile} to require another file containing
-macro definitions, you may need to explicitly load that file.
+you instrument code. If you are instrumenting a function which uses a
+macro defined in another file, you may first need to either evaluate
+the @code{require} forms in the file containing your function, or
+explicitly load the file containing the macro. If the definition of a
+macro is wrapped by @code{eval-when-compile}, you may need to evaluate
+it.
You can also define an edebug specification for a macro separately
from the macro definition with @code{def-edebug-spec}. Adding
@@ -1231,13 +1234,17 @@ A single unevaluated Lisp object, which is not instrumented.
@c an "expression" is not necessarily intended for evaluation.
@item form
-A single evaluated expression, which is instrumented.
+A single evaluated expression, which is instrumented. If your macro
+wraps the expression with @code{lambda} before it is evaluated, use
+@code{def-form} instead. See @code{def-form} below.
@item place
A generalized variable. @xref{Generalized Variables}.
@item body
-Short for @code{&rest form}. See @code{&rest} below.
+Short for @code{&rest form}. See @code{&rest} below. If your macro
+wraps its body of code with @code{lambda} before it is evaluated, use
+@code{def-body} instead. See @code{def-body} below.
@item function-form
A function form: either a quoted function symbol, a quoted lambda
@@ -1292,11 +1299,16 @@ succeeds.
@item &define
@c @kindex &define @r{(Edebug)}
-Indicates that the specification is for a defining form. The defining
-form itself is not instrumented (that is, Edebug does not stop before and
-after the defining form), but forms inside it typically will be
-instrumented. The @code{&define} keyword should be the first element in
-a list specification.
+
+Indicates that the specification is for a defining form. Edebug's
+definition of a defining form is a form containing one or more code
+forms which are saved and executed later, after the execution of the
+defining form.
+
+The defining form itself is not instrumented (that is, Edebug does not
+stop before and after the defining form), but forms inside it
+typically will be instrumented. The @code{&define} keyword should be
+the first element in a list specification.
@item nil
This is successful when there are no more arguments to match at the
@@ -1690,3 +1702,33 @@ Whether or not to pause for @code{edebug-sit-for-seconds} on reaching
a breakpoint. Set to @code{nil} to prevent the pause, non-@code{nil}
to allow it.
@end defopt
+
+@defopt edebug-behavior-alist
+By default, this alist contains one entry with the key @code{edebug}
+and a list of three functions, which are the default implementations
+of the functions inserted in instrumented code: @code{edebug-enter},
+@code{edebug-before} and @code{edebug-after}. To change Edebug's
+behavior globally, modify the default entry.
+
+Edebug's behavior may also be changed on a per-definition basis by
+adding an entry to this alist, with a key of your choice and three
+functions. Then set the @code{edebug-behavior} symbol property of an
+instrumented definition to the key of the new entry, and Edebug will
+call the new functions in place of its own for that definition.
+@end defopt
+
+@defopt edebug-new-definition-function
+A function run by Edebug after it wraps the body of a definition
+or closure. After Edebug has initialized its own data, this function
+is called with one argument, the symbol associated with the
+definition, which may be the actual symbol defined or one generated by
+Edebug. This function may be used to set the @code{edebug-behavior}
+symbol property of each definition instrumented by Edebug.
+@end defopt
+
+@defopt edebug-after-instrumentation-function
+To inspect or modify Edebug's instrumentation before it is used, set
+this variable to a function which takes one argument, an instrumented
+top-level form, and returns either the same or a replacement form,
+which Edebug will then use as the final result of instrumentation.
+@end defopt
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 7cc91a8f7e3..a271749e044 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -159,7 +159,7 @@ Cover art by Etienne Suvasa.
@ifset WWW_GNU_ORG
@html
<p>The homepage for GNU Emacs is at
-<a href="/software/emacs/">http://www.gnu.org/software/emacs/</a>.<br>
+<a href="/software/emacs/">https://www.gnu.org/software/emacs/</a>.<br>
For information on using Emacs, refer to the
<a href="/software/emacs/manual/emacs.html">Emacs Manual</a>.<br>
To view this manual in other formats, click
@@ -230,7 +230,7 @@ To view this manual in other formats, click
Appendices
-* Antinews:: Info for users downgrading to Emacs 24.
+* Antinews:: Info for users downgrading to Emacs 25.
* GNU Free Documentation License:: The license for this documentation.
* GPL:: Conditions for copying and changing GNU Emacs.
* Tips:: Advice and coding conventions for Emacs Lisp.
@@ -455,6 +455,7 @@ Evaluation
the program).
* Backquote:: Easier construction of list structure.
* Eval:: How to invoke the Lisp interpreter explicitly.
+* Deferred Eval:: Deferred and lazy evaluation of forms.
Kinds of Forms
@@ -940,6 +941,7 @@ Documentation
* Documentation Basics:: Where doc strings are defined and stored.
* Accessing Documentation:: How Lisp programs can access doc strings.
* Keys in Documentation:: Substituting current key bindings.
+* Text Quoting Style:: Quotation marks in doc strings and messages.
* Describing Characters:: Making printable descriptions of
non-printing characters and key sequences.
* Help Functions:: Subroutines used by Emacs help facilities.
@@ -1130,6 +1132,8 @@ Window Frame Parameters
* Buffer Parameters:: Which buffers have been or should be shown.
* Frame Interaction Parameters:: Parameters for interacting with other
frames.
+* Mouse Dragging Parameters:: Parameters for resizing and moving
+ frames with the mouse.
* Management Parameters:: Communicating with the window manager.
* Cursor Parameters:: Controlling the cursor appearance.
* Font and Color Parameters:: Fonts and colors for the frame text.
@@ -1194,6 +1198,7 @@ Text
* Decompression:: Dealing with compressed data.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
+* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes atomically.
* Change Hooks:: Supplying functions to be run when text is changed.
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index 1f67819c34e..cd22b70800d 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -172,8 +172,11 @@ The message is @samp{Search failed}. @xref{Searching and Matching}.
@item setting-constant
The message is @samp{Attempt to set a constant symbol}. This happens
-when attempting to assign values to @code{nil}, @code{t}, and keyword
-symbols. @xref{Constant Variables}.
+when attempting to assign values to @code{nil}, @code{t},
+@code{most-positive-fixnum}, @code{most-negative-fixnum}, and keyword
+symbols. It also happens when attempting to assign values to
+@code{enable-multibyte-characters} and some other symbols whose direct
+assignment is not allowed for some reason. @xref{Constant Variables}.
@c simple.el
@item text-read-only
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index 363d0a14313..0f9f301547a 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -20,11 +20,12 @@ function @code{eval}.
@ifnottex
@menu
-* Intro Eval:: Evaluation in the scheme of things.
-* Forms:: How various sorts of objects are evaluated.
-* Quoting:: Avoiding evaluation (to put constants in the program).
-* Backquote:: Easier construction of list structure.
-* Eval:: How to invoke the Lisp interpreter explicitly.
+* Intro Eval:: Evaluation in the scheme of things.
+* Forms:: How various sorts of objects are evaluated.
+* Quoting:: Avoiding evaluation (to put constants in the program).
+* Backquote:: Easier construction of list structure.
+* Eval:: How to invoke the Lisp interpreter explicitly.
+* Deferred Eval:: Deferred and lazy evaluation of forms.
@end menu
@node Intro Eval
@@ -818,7 +819,7 @@ The depth limit counts internal uses of @code{eval}, @code{apply}, and
expressions, and recursive evaluation of function call arguments and
function body forms, as well as explicit calls in Lisp code.
-The default value of this variable is 400. If you set it to a value
+The default value of this variable is 800. If you set it to a value
less than 100, Lisp will reset it to 100 if the given value is
reached. Entry to the Lisp debugger increases the value, if there is
little room left, to make sure the debugger itself has room to
@@ -877,3 +878,115 @@ particular elements, like this:
@end group
@end example
@end defvar
+
+@node Deferred Eval
+@section Deferred and Lazy Evaluation
+
+@cindex deferred evaluation
+@cindex lazy evaluation
+
+
+ Sometimes it is useful to delay the evaluation of an expression, for
+example if you want to avoid performing a time-consuming calculation
+if it turns out that the result is not needed in the future of the
+program. The @file{thunk} library provides the following functions
+and macros to support such @dfn{deferred evaluation}:
+
+@cindex thunk
+@defmac thunk-delay forms@dots{}
+Return a @dfn{thunk} for evaluating the @var{forms}. A thunk is a
+closure (@pxref{Closures}) that inherits the lexical enviroment of the
+@code{thunk-delay} call. Using this macro requires
+@code{lexical-binding}.
+@end defmac
+
+@defun thunk-force thunk
+Force @var{thunk} to perform the evaluation of the forms specified in
+the @code{thunk-delay} that created the thunk. The result of the
+evaluation of the last form is returned. The @var{thunk} also
+``remembers'' that it has been forced: Any further calls of
+@code{thunk-force} with the same @var{thunk} will just return the same
+result without evaluating the forms again.
+@end defun
+
+@defmac thunk-let (bindings@dots{}) forms@dots{}
+This macro is analogous to @code{let} but creates ``lazy'' variable
+bindings. Any binding has the form @w{@code{(@var{symbol}
+@var{value-form})}}. Unlike @code{let}, the evaluation of any
+@var{value-form} is deferred until the binding of the according
+@var{symbol} is used for the first time when evaluating the
+@var{forms}. Any @var{value-form} is evaluated at most once. Using
+this macro requires @code{lexical-binding}.
+@end defmac
+
+Example:
+
+@example
+@group
+(defun f (number)
+ (thunk-let ((derived-number
+ (progn (message "Calculating 1 plus 2 times %d" number)
+ (1+ (* 2 number)))))
+ (if (> number 10)
+ derived-number
+ number)))
+@end group
+
+@group
+(f 5)
+@result{} 5
+@end group
+
+@group
+(f 12)
+@print{} Calculating 1 plus 2 times 12
+@result{} 25
+@end group
+
+@end example
+
+Because of the special nature of lazily bound variables, it is an error
+to set them (e.g.@: with @code{setq}).
+
+
+@defmac thunk-let* (bindings@dots{}) forms@dots{}
+This is like @code{thunk-let} but any expression in @var{bindings} is allowed
+to refer to preceding bindings in this @code{thunk-let*} form. Using
+this macro requires @code{lexical-binding}.
+@end defmac
+
+@example
+@group
+(thunk-let* ((x (prog2 (message "Calculating x...")
+ (+ 1 1)
+ (message "Finished calculating x")))
+ (y (prog2 (message "Calculating y...")
+ (+ x 1)
+ (message "Finished calculating y")))
+ (z (prog2 (message "Calculating z...")
+ (+ y 1)
+ (message "Finished calculating z")))
+ (a (prog2 (message "Calculating a...")
+ (+ z 1)
+ (message "Finished calculating a"))))
+ (* z x))
+
+@print{} Calculating z...
+@print{} Calculating y...
+@print{} Calculating x...
+@print{} Finished calculating x
+@print{} Finished calculating y
+@print{} Finished calculating z
+@result{} 8
+
+@end group
+@end example
+
+@code{thunk-let} and @code{thunk-let*} use thunks implicitly: their
+expansion creates helper symbols and binds them to thunks wrapping the
+binding expressions. All references to the original variables in the
+body @var{forms} are then replaced by an expression that calls
+@code{thunk-force} with the according helper variable as the argument.
+So, any code using @code{thunk-let} or @code{thunk-let*} could be
+rewritten to use thunks, but in many cases using these macros results
+in nicer code than using thunks explicitly.
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 2b692dbf680..b257c328f4d 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -332,7 +332,9 @@ in the list @code{find-file-hook}.
that is visiting that file---that is, the contents of the file are
copied into the buffer and the copy is what you edit. Changes to the
buffer do not change the file until you @dfn{save} the buffer, which
-means copying the contents of the buffer into the file.
+means copying the contents of the buffer into the file. Buffers which
+are not visiting a file can still be ``saved'', in a sense, using
+functions in the buffer-local @code{write-contents-functions} hook.
@deffn Command save-buffer &optional backup-option
This function saves the contents of the current buffer in its visited
@@ -365,8 +367,8 @@ With an argument of 0, unconditionally do @emph{not} make any backup file.
@anchor{Definition of save-some-buffers}
This command saves some modified file-visiting buffers. Normally it
asks the user about each buffer. But if @var{save-silently-p} is
-non-@code{nil}, it saves all the file-visiting buffers without querying
-the user.
+non-@code{nil}, it saves all the file-visiting buffers without
+querying the user.
@vindex save-some-buffers-default-predicate
The optional @var{pred} argument provides a predicate that controls
@@ -401,7 +403,7 @@ If @var{confirm} is non-@code{nil}, that means to ask for confirmation
before overwriting an existing file. Interactively, confirmation is
required, unless the user supplies a prefix argument.
-If @var{filename} is an existing directory, or a symbolic link to one,
+If @var{filename} is a directory name (@pxref{Directory Names}),
@code{write-file} uses the name of the visited file, in directory
@var{filename}. If the buffer is not visiting a file, it uses the
buffer name instead.
@@ -457,15 +459,23 @@ Even though this is not a normal hook, you can use @code{add-hook} and
@defvar write-contents-functions
This works just like @code{write-file-functions}, but it is intended
for hooks that pertain to the buffer's contents, not to the particular
-visited file or its location. Such hooks are usually set up by major
-modes, as buffer-local bindings for this variable. This variable
-automatically becomes buffer-local whenever it is set; switching to a
-new major mode always resets this variable, but calling
-@code{set-visited-file-name} does not.
+visited file or its location, and can be used to create arbitrary save
+processes for buffers that aren't visiting files at all. Such hooks
+are usually set up by major modes, as buffer-local bindings for this
+variable. This variable automatically becomes buffer-local whenever
+it is set; switching to a new major mode always resets this variable,
+but calling @code{set-visited-file-name} does not.
If any of the functions in this hook returns non-@code{nil}, the file
is considered already written and the rest are not called and neither
are the functions in @code{write-file-functions}.
+
+When using this hook to save buffers that are not visiting files (for
+instance, special-mode buffers), keep in mind that, if the function
+fails to save correctly and returns a @code{nil} value,
+@code{save-buffer} will go on to prompt the user for a file to save
+the buffer in. If this is undesirable, consider having the function
+fail by raising an error.
@end defvar
@defopt before-save-hook
@@ -628,7 +638,10 @@ If @var{mustbenew} is non-@code{nil}, then @code{write-region} asks
for confirmation if @var{filename} names an existing file. If
@var{mustbenew} is the symbol @code{excl}, then @code{write-region}
does not ask for confirmation, but instead it signals an error
-@code{file-already-exists} if the file already exists.
+@code{file-already-exists} if the file already exists. Although
+@code{write-region} normally follows a symbolic link and creates the
+pointed-to file if the symbolic link is dangling, it does not follow
+symbolic links if @var{mustbenew} is @code{excl}.
The test for an existing file, when @var{mustbenew} is @code{excl}, uses
a special system feature. At least for files on a local disk, there is
@@ -817,9 +830,7 @@ are silently and automatically ignored.
These functions test for permission to access a file for reading,
writing, or execution. Unless explicitly stated otherwise, they
-recursively follow symbolic links for their file name arguments, at
-all levels (at the level of the file itself and at all levels of
-parent directories).
+follow symbolic links. @xref{Kinds of Files}.
On some operating systems, more complex sets of access permissions
can be specified, via mechanisms such as Access Control Lists (ACLs).
@@ -829,17 +840,17 @@ permissions.
@defun file-exists-p filename
This function returns @code{t} if a file named @var{filename} appears
to exist. This does not mean you can necessarily read the file, only
-that you can find out its attributes. (On Unix and GNU/Linux, this is
-true if the file exists and you have execute permission on the
-containing directories, regardless of the permissions of the file
-itself.)
+that you can find out its attributes. (On GNU and other POSIX-like
+systems, this is true if the file exists and you have execute
+permission on the containing directories, regardless of the
+permissions of the file itself.)
If the file does not exist, or if access control policies prevent you
from finding its attributes, this function returns @code{nil}.
-Directories are files, so @code{file-exists-p} returns @code{t} when
-given a directory name. However, symbolic links are treated
-specially; @code{file-exists-p} returns @code{t} for a symbolic link
+Directories are files, so @code{file-exists-p} can return @code{t} when
+given a directory. However, because @code{file-exists-p} follows
+symbolic links, it returns @code{t} for a symbolic link
name only if the target file exists.
@end defun
@@ -849,11 +860,11 @@ and you can read it. It returns @code{nil} otherwise.
@end defun
@defun file-executable-p filename
-This function returns @code{t} if a file named @var{filename} exists and
-you can execute it. It returns @code{nil} otherwise. On Unix and
-GNU/Linux, if the file is a directory, execute permission means you can
-check the existence and attributes of files inside the directory, and
-open those files if their modes permit.
+This function returns @code{t} if a file named @var{filename} exists
+and you can execute it. It returns @code{nil} otherwise. On GNU and
+other POSIX-like systems, if the file is a directory, execute
+permission means you can check the existence and attributes of files
+inside the directory, and open those files if their modes permit.
@end defun
@defun file-writable-p filename
@@ -906,10 +917,7 @@ returns @code{t} for nonexistent files.
If the optional argument @var{group} is non-@code{nil}, this function
also checks that the file's group would be unchanged.
-If @var{filename} is a symbolic link, then, unlike the other functions
-discussed here, @code{file-ownership-preserved-p} does @emph{not}
-replace @var{filename} with its target. However, it does recursively
-follow symbolic links at all levels of parent directories.
+This function does not follow symbolic links.
@end defun
@defun file-modes filename
@@ -919,8 +927,8 @@ follow symbolic links at all levels of parent directories.
@cindex file modes
This function returns the @dfn{mode bits} of @var{filename}---an
integer summarizing its read, write, and execution permissions.
-Symbolic links in @var{filename} are recursively followed at all
-levels. If the file does not exist, the return value is @code{nil}.
+This function follows symbolic links. If the file does not exist, the
+return value is @code{nil}.
@xref{File permissions,,, coreutils, The @sc{gnu} @code{Coreutils}
Manual}, for a description of mode bits. For example, if the
@@ -960,10 +968,10 @@ $ ls -l diffs
executable file mode bit. So @code{file-modes} considers a file
executable if its name ends in one of the standard executable
extensions, such as @file{.com}, @file{.bat}, @file{.exe}, and some
-others. Files that begin with the Unix-standard @samp{#!} signature,
+others. Files that begin with the POSIX-standard @samp{#!} signature,
such as shell and Perl scripts, are also considered executable.
Directories are also reported as executable, for compatibility with
-Unix. These conventions are also followed by @code{file-attributes}
+POSIX@. These conventions are also followed by @code{file-attributes}
(@pxref{File Attributes}).
@end defun
@@ -971,19 +979,26 @@ Unix. These conventions are also followed by @code{file-attributes}
@subsection Distinguishing Kinds of Files
@cindex file classification
@cindex classification of file types
+@cindex symbolic links
This section describes how to distinguish various kinds of files, such
as directories, symbolic links, and ordinary files.
+ Symbolic links are ordinarily followed wherever they appear. For
+example, to interpret the file name @file{a/b/c}, any of @file{a},
+@file{a/b}, and @file{a/b/c} can be symbolic links that are followed,
+possibly recursively if the link targets are themselves symbolic
+links. However, a few functions do not follow symbolic links at the
+end of a file name (@file{a/b/c} in this example). Such a function
+is said to @dfn{not follow symbolic links}.
+
@defun file-symlink-p filename
-@cindex file symbolic links
-If the file @var{filename} is a symbolic link, the
-@code{file-symlink-p} function returns its (non-recursive) link target
+@cindex symbolic links
+If the file @var{filename} is a symbolic link, this function does not
+follow it and instead returns its link target
as a string. (The link target string is not necessarily the full
absolute file name of the target; determining the full file name that
-the link points to is nontrivial, see below.) If the leading
-directories of @var{filename} include symbolic links, this function
-recursively follows them.
+the link points to is nontrivial, see below.)
If the file @var{filename} is not a symbolic link, or does not exist,
@code{file-symlink-p} returns @code{nil}.
@@ -1011,9 +1026,9 @@ Here are a few examples of using this function:
Note that in the third example, the function returned @file{sym-link},
but did not proceed to resolve it, although that file is itself a
-symbolic link. This is what we meant by ``non-recursive'' above---the
-process of following the symbolic links does not recurse if the link
-target is itself a link.
+symbolic link. That is because this function does not follow symbolic
+links---the process of following the symbolic links does not apply to
+the last component of the file name.
The string that this function returns is what is recorded in the
symbolic link; it may or may not include any leading directories.
@@ -1044,12 +1059,10 @@ link. If you actually need the file name of the link target, use
@ref{Truenames}.
@end defun
-The next two functions recursively follow symbolic links at
-all levels for @var{filename}.
-
@defun file-directory-p filename
This function returns @code{t} if @var{filename} is the name of an
existing directory, @code{nil} otherwise.
+This function follows symbolic links.
@example
@group
@@ -1080,6 +1093,7 @@ existing directory, @code{nil} otherwise.
This function returns @code{t} if the file @var{filename} exists and is
a regular file (not a directory, named pipe, terminal, or
other I/O device).
+This function follows symbolic links.
@end defun
@node Truenames
@@ -1110,8 +1124,11 @@ file name component immediately preceding @samp{..} will be
simplified away before @code{file-truename} is called. To
eliminate the need for a call to @code{expand-file-name},
@code{file-truename} handles @samp{~} in the same way that
-@code{expand-file-name} does. @xref{File Name Expansion,, Functions
-that Expand Filenames}.
+@code{expand-file-name} does.
+
+If the target of a symbolic links has remote file name syntax,
+@code{file-truename} returns it quoted. @xref{File Name Expansion,,
+Functions that Expand Filenames}.
@end defun
@defun file-chase-links filename &optional limit
@@ -1231,15 +1248,11 @@ on the 19th, @file{aug-20} was written on the 20th, and the file
@end example
@end defun
- If the @var{filename} argument to the next two functions is a
-symbolic link, then these function do @emph{not} replace it with its
-target. However, they both recursively follow symbolic links at all
-levels of parent directories.
-
@defun file-attributes filename &optional id-format
@anchor{Definition of file-attributes}
This function returns a list of attributes of file @var{filename}. If
-the specified file cannot be opened, it returns @code{nil}.
+the specified file's attributes cannot be accessed, it returns @code{nil}.
+This function does not follow symbolic links.
The optional parameter @var{id-format} specifies the preferred format
of attributes @acronym{UID} and @acronym{GID} (see below)---the
valid values are @code{'string} and @code{'integer}. The latter is
@@ -1247,6 +1260,13 @@ the default, but we plan to change that, so you should specify a
non-@code{nil} value for @var{id-format} if you use the returned
@acronym{UID} or @acronym{GID}.
+On GNU platforms when operating on a local file, this function is
+atomic: if the filesystem is simultaneously being changed by some
+other process, this function returns the file's attributes either
+before or after the change. Otherwise this function is not atomic,
+and might return @code{nil} if it detects the race condition, or might
+return a hodgepodge of the previous and current file attributes.
+
Accessor functions are provided to access the elements in this list.
The accessors are mentioned along with the descriptions of the
elements below.
@@ -1391,7 +1411,7 @@ This function returns the number of names (i.e., hard links) that
file @var{filename} has. If the file does not exist, this function
returns @code{nil}. Note that symbolic links have no effect on this
function, because they are not considered to be names of the files
-they link to.
+they link to. This function does not follow symbolic links.
@example
@group
@@ -1553,6 +1573,16 @@ a @code{file-missing} error instead.
made by these functions instead of writing them immediately to
secondary storage. @xref{Files and Storage}.
+ In the functions that have an argument @var{newname}, if this
+argument is a directory name it is treated as if the nondirectory part
+of the source name were appended. Typically, a directory name is one
+that ends in @samp{/} (@pxref{Directory Names}). For example, if the
+old name is @file{a/b/c}, the @var{newname} @file{d/e/f/} is treated
+as if it were @file{d/e/f/c}. This special treatment does not apply
+if @var{newname} is not a directory name but names a file that is a
+directory; for example, the @var{newname} @file{d/e/f} is left as-is
+even if @file{d/e/f} happens to be a directory.
+
In the functions that have an argument @var{newname}, if a file by the
name of @var{newname} already exists, the actions taken depend on the
value of the argument @var{ok-if-already-exists}:
@@ -1570,11 +1600,6 @@ Replace the old file without confirmation if @var{ok-if-already-exists}
is any other value.
@end itemize
-The next four commands all recursively follow symbolic links at all
-levels of parent directories for their first argument, but, if that
-argument is itself a symbolic link, then only @code{copy-file}
-replaces it with its (recursive) target.
-
@deffn Command add-name-to-file oldname newname &optional ok-if-already-exists
@cindex file with multiple names
@cindex file hard link
@@ -1582,6 +1607,14 @@ This function gives the file named @var{oldname} the additional name
@var{newname}. This means that @var{newname} becomes a new hard
link to @var{oldname}.
+If @var{newname} is a symbolic link, its directory entry is replaced,
+not the directory entry it points to. If @var{oldname} is a symbolic
+link, this function might or might not follow the link; it does not
+follow the link on GNU platforms. If @var{oldname} is a directory,
+this function typically fails, although for the superuser on a few
+old-fashioned non-GNU platforms it can succeed and create a filesystem
+that is not tree-structured.
+
In the first part of the following example, we list two files,
@file{foo} and @file{foo3}.
@@ -1649,14 +1682,34 @@ This command renames the file @var{filename} as @var{newname}.
If @var{filename} has additional names aside from @var{filename}, it
continues to have those names. In fact, adding the name @var{newname}
with @code{add-name-to-file} and then deleting @var{filename} has the
-same effect as renaming, aside from momentary intermediate states.
+same effect as renaming, aside from momentary intermediate states and
+treatment of errors, directories and symbolic links.
+
+This command does not follow symbolic links. If @var{filename} is a
+symbolic link, this command renames the symbolic link, not the file it
+points to. If @var{newname} is a symbolic link, its directory entry
+is replaced, not the directory entry it points to.
+
+This command does nothing if @var{filename} and @var{newname} are the
+same directory entry, i.e., if they refer to the same parent directory
+and give the same name within that directory. Otherwise, if
+@var{filename} and @var{newname} name the same file, this command does
+nothing on POSIX-conforming systems, and removes @var{filename} on
+some non-POSIX systems.
+
+If @var{newname} exists, then it must be an empty directory if
+@var{oldname} is a directory and a non-directory otherwise.
@end deffn
-@deffn Command copy-file oldname newname &optional ok-if-exists time preserve-uid-gid preserve-extended-attributes
+@deffn Command copy-file oldname newname &optional ok-if-already-exists time preserve-uid-gid preserve-extended-attributes
This command copies the file @var{oldname} to @var{newname}. An
-error is signaled if @var{oldname} does not exist. If @var{newname}
+error is signaled if @var{oldname} is not a regular file. If @var{newname}
names a directory, it copies @var{oldname} into that directory,
preserving its final name component.
+@c FIXME: See Bug#27986 for how the previous sentence might change.
+
+This function follows symbolic links, except that it does not follow a
+dangling symbolic link to create @var{newname}.
If @var{time} is non-@code{nil}, then this function gives the new file
the same last-modified time that the old one has. (This works on only
@@ -1684,12 +1737,24 @@ default file permissions (see @code{set-default-file-modes} below), if
SELinux context are not copied over in either case.
@end deffn
-@deffn Command make-symbolic-link filename newname &optional ok-if-exists
+@deffn Command make-symbolic-link target newname &optional ok-if-already-exists
@pindex ln
@kindex file-already-exists
-This command makes a symbolic link to @var{filename}, named
+This command makes a symbolic link to @var{target}, named
@var{newname}. This is like the shell command @samp{ln -s
-@var{filename} @var{newname}}.
+@var{target} @var{newname}}. The @var{target} argument
+is treated only as a string; it need not name an existing file.
+If @var{ok-if-already-exists} is an integer, indicating interactive
+use, then leading @samp{~} is expanded and leading @samp{/:} is
+stripped in the @var{target} string.
+
+If @var{target} is a relative file name, the resulting symbolic link
+is interpreted relative to the directory containing the symbolic link.
+@xref{Relative File Names}.
+
+If both @var{target} and @var{newname} have remote file name syntax,
+and if both remote identifications are equal, the symbolic link points
+to the local file name part of @var{target}.
This function is not available on systems that don't support symbolic
links.
@@ -1702,12 +1767,11 @@ links.
This command deletes the file @var{filename}. If the file has
multiple names, it continues to exist under the other names. If
@var{filename} is a symbolic link, @code{delete-file} deletes only the
-symbolic link and not its target (though it does follow symbolic links
-at all levels of parent directories).
+symbolic link and not its target.
A suitable kind of @code{file-error} error is signaled if the file
-does not exist, or is not deletable. (On Unix and GNU/Linux, a file
-is deletable if its directory is writable.)
+does not exist, or is not deletable. (On GNU and other POSIX-like
+systems, a file is deletable if its directory is writable.)
If the optional argument @var{trash} is non-@code{nil} and the
variable @code{delete-by-moving-to-trash} is non-@code{nil}, this
@@ -1724,8 +1788,7 @@ See also @code{delete-directory} in @ref{Create/Delete Dirs}.
@cindex file modes, setting
@deffn Command set-file-modes filename mode
This function sets the @dfn{file mode} (or @dfn{permissions}) of
-@var{filename} to @var{mode}. It recursively follows symbolic links
-at all levels for @var{filename}.
+@var{filename} to @var{mode}. This function follows symbolic links.
If called non-interactively, @var{mode} must be an integer. Only the
lowest 12 bits of the integer are used; on most systems, only the
@@ -1756,8 +1819,11 @@ This function sets the default permissions for new files created by
Emacs and its subprocesses. Every file created with Emacs initially
has these permissions, or a subset of them (@code{write-region} will
not grant execute permissions even if the default file permissions
-allow execution). On Unix and GNU/Linux, the default permissions are
-given by the bitwise complement of the @samp{umask} value.
+allow execution). On GNU and other POSIX-like systems, the default
+permissions are given by the bitwise complement of the @samp{umask}
+value, i.e.@: each bit that is set in the argument @var{mode} will be
+@emph{reset} in the default permissions with which Emacs creates
+files.
The argument @var{mode} should be an integer which specifies the
permissions, similar to @code{set-file-modes} above. Only the lowest
@@ -1896,9 +1962,9 @@ directory.
@cindex converting file names from/to MS-Windows syntax
On MS-DOS and MS-Windows, these functions (like the function that
actually operate on files) accept MS-DOS or MS-Windows file-name syntax,
-where backslashes separate the components, as well as Unix syntax; but
-they always return Unix syntax. This enables Lisp programs to specify
-file names in Unix syntax and work properly on all systems without
+where backslashes separate the components, as well as POSIX syntax; but
+they always return POSIX syntax. This enables Lisp programs to specify
+file names in POSIX syntax and work properly on all systems without
change.@footnote{In MS-Windows versions of Emacs compiled for the Cygwin
environment, you can use the functions
@code{cygwin-convert-file-name-to-windows} and
@@ -1943,16 +2009,16 @@ This function returns the directory part of @var{filename}, as a
directory name (@pxref{Directory Names}), or @code{nil} if
@var{filename} does not include a directory part.
-On GNU and Unix systems, a string returned by this function always
+On GNU and other POSIX-like systems, a string returned by this function always
ends in a slash. On MS-DOS it can also end in a colon.
@example
@group
-(file-name-directory "lewis/foo") ; @r{Unix example}
+(file-name-directory "lewis/foo") ; @r{GNU example}
@result{} "lewis/"
@end group
@group
-(file-name-directory "foo") ; @r{Unix example}
+(file-name-directory "foo") ; @r{GNU example}
@result{} nil
@end group
@end example
@@ -2044,7 +2110,7 @@ Note that the @samp{.~3~} in the two last examples is the backup part,
not an extension.
@end defun
-@defun file-name-base &optional filename
+@defun file-name-base filename
This function is the composition of @code{file-name-sans-extension}
and @code{file-name-nondirectory}. For example,
@@ -2052,8 +2118,6 @@ and @code{file-name-nondirectory}. For example,
(file-name-base "/my/home/foo.c")
@result{} "foo"
@end example
-
-The @var{filename} argument defaults to @code{buffer-file-name}.
@end defun
@node Relative File Names
@@ -2066,8 +2130,9 @@ root directory. A file name can specify all the directory names
starting from the root of the tree; then it is called an
@dfn{absolute} file name. Or it can specify the position of the file
in the tree relative to a default directory; then it is called a
-@dfn{relative} file name. On Unix and GNU/Linux, an absolute file
-name starts with a @samp{/} or a @samp{~}
+@dfn{relative} file name. On GNU and other POSIX-like systems,
+after any leading @samp{~} has been expanded, an absolute file name
+starts with a @samp{/}
(@pxref{abbreviate-file-name}), and a relative one does not. On
MS-DOS and MS-Windows, an absolute file name starts with a slash or a
backslash, or with a drive specification @samp{@var{x}:/}, where
@@ -2075,7 +2140,7 @@ backslash, or with a drive specification @samp{@var{x}:/}, where
@defun file-name-absolute-p filename
This function returns @code{t} if file @var{filename} is an absolute
-file name, @code{nil} otherwise.
+file name or begins with @samp{~}, @code{nil} otherwise.
@example
@group
@@ -2093,7 +2158,8 @@ file name, @code{nil} otherwise.
@end example
@end defun
- Given a possibly relative file name, you can convert it to an
+ Given a possibly relative file name, you can expand any
+leading @samp{~} and convert the result to an
absolute name using @code{expand-file-name} (@pxref{File Name
Expansion}). This function converts absolute file names to relative
names:
@@ -2125,17 +2191,18 @@ form.
@cindex directory file name
@cindex file name of directory
- A @dfn{directory name} is the name of a directory. A directory is
-actually a kind of file, so it has a file name (called the
-@dfn{directory file name}, which is related to the directory name but
-not identical to it. (This is not quite the same as the usual Unix
-terminology.) These two different names for the same entity are
-related by a syntactic transformation. On GNU and Unix systems, this
-is simple: a directory name ends in a slash, whereas the directory
-file name lacks that slash. On MS-DOS the relationship is more
+ A @dfn{directory name} is a string that must name a directory if it
+names any file at all. A directory is actually a kind of file, and it
+has a file name (called the @dfn{directory file name}, which is
+related to the directory name but is typically not identical. (This
+is not quite the same as the usual POSIX terminology.) These two
+names for the same entity are related by a syntactic transformation.
+On GNU and other POSIX-like systems, this is simple: to obtain a
+directory name, append a @samp{/} to a directory file name that does
+not already end in @samp{/}. On MS-DOS the relationship is more
complicated.
- The difference between directory name and directory file name is
+ The difference between a directory name and a directory file name is
subtle but crucial. When an Emacs variable or function argument is
described as being a directory name, a directory file name is not
acceptable. When @code{file-name-directory} returns a string, that is
@@ -2163,15 +2230,16 @@ string (if it does not already end in one).
@defun directory-name-p filename
This function returns non-@code{nil} if @var{filename} ends with a
directory separator character. This is the forward slash @samp{/} on
-Unix and GNU systems; MS-Windows and MS-DOS recognize both the forward
-slash and the backslash @samp{\} as directory separators.
+GNU and other POSIX-like systems; MS-Windows and MS-DOS recognize both
+the forward slash and the backslash @samp{\} as directory separators.
@end defun
@defun directory-file-name dirname
This function returns a string representing @var{dirname} in a form
that the operating system will interpret as the name of a file (a
directory file name). On most systems, this means removing the final
-slash (or backslash) from the string.
+directory separators from the string, unless the string consists
+entirely of directory separators.
@example
@group
@@ -2220,6 +2288,10 @@ might be nil (for example, from an element of @code{load-path}), use:
(expand-file-name @var{relfile} @var{dirname})
@end example
+However, @code{expand-file-name} expands leading @samp{~} in
+@var{relfile}, which may not be what you want. @xref{File Name
+Expansion}.
+
To convert a directory name to its abbreviation, use this
function:
@@ -2247,7 +2319,7 @@ because it recognizes abbreviations even as part of the name.
@dfn{Expanding} a file name means converting a relative file name to
an absolute one. Since this is done relative to a default directory,
-you must specify the default directory name as well as the file name
+you must specify the default directory as well as the file name
to be expanded. It also involves expanding abbreviations like
@file{~/}
@ifnottex
@@ -2258,7 +2330,8 @@ and eliminating redundancies like @file{./} and @file{@var{name}/../}.
@defun expand-file-name filename &optional directory
This function converts @var{filename} to an absolute file name. If
@var{directory} is supplied, it is the default directory to start with
-if @var{filename} is relative. (The value of @var{directory} should
+if @var{filename} is relative and does not start with @samp{~}.
+(The value of @var{directory} should
itself be an absolute directory name or directory file name; it may
start with @samp{~}.) Otherwise, the current buffer's value of
@code{default-directory} is used. For example:
@@ -2278,11 +2351,15 @@ start with @samp{~}.) Otherwise, the current buffer's value of
@end group
@end example
-If the part of the combined file name before the first slash is
+If the part of @var{filename} before the first slash is
@samp{~}, it expands to the value of the @env{HOME} environment
variable (usually your home directory). If the part before the first
slash is @samp{~@var{user}} and if @var{user} is a valid login name,
it expands to @var{user}'s home directory.
+If you do not want this expansion for a relative @var{filename} that
+might begin with a literal @samp{~}, you can use @code{(concat
+(file-name-as-directory directory) filename)} instead of
+@code{(expand-file-name filename directory)}.
Filenames containing @samp{.} or @samp{..} are simplified to their
canonical form:
@@ -2383,7 +2460,7 @@ results.
@c Wordy to avoid overfull hbox. --rjc 15mar92
Here we assume that the environment variable @env{HOME}, which holds
-the user's home directory name, has value @samp{/xcssun/users/rms}.
+the user's home directory, has value @samp{/xcssun/users/rms}.
@example
@group
@@ -2467,11 +2544,12 @@ construct a name for such a file:
The job of @code{make-temp-file} is to prevent two different users or
two different jobs from trying to use the exact same file name.
-@defun make-temp-file prefix &optional dir-flag suffix
+@defun make-temp-file prefix &optional dir-flag suffix text
This function creates a temporary file and returns its name. Emacs
creates the temporary file's name by adding to @var{prefix} some
random characters that are different in each Emacs job. The result is
-guaranteed to be a newly created empty file. On MS-DOS, this function
+guaranteed to be a newly created file, containing @var{text} if that's
+given as a string and empty otherwise. On MS-DOS, this function
can truncate the @var{string} prefix to fit into the 8+3 file-name
limits. If @var{prefix} is a relative file name, it is expanded
against @code{temporary-file-directory}.
@@ -2494,6 +2572,8 @@ not the directory name, of that directory. @xref{Directory Names}.
If @var{suffix} is non-@code{nil}, @code{make-temp-file} adds it at
the end of the file name.
+If @var{text} is a string, @code{make-temp-file} inserts it in the file.
+
To prevent conflicts among different libraries running in the same
Emacs, each Lisp program that uses @code{make-temp-file} should have its
own @var{prefix}. The number added to the end of @var{prefix}
@@ -2547,13 +2627,14 @@ should compute the directory like this:
@end defopt
@defun make-temp-name base-name
-This function generates a string that can be used as a unique file
+This function generates a string that might be a unique file
name. The name starts with @var{base-name}, and has several random
characters appended to it, which are different in each Emacs job. It
is like @code{make-temp-file} except that (i) it just constructs a
-name, and does not create a file, and (ii) @var{base-name} should be
-an absolute file name (on MS-DOS, this function can truncate
-@var{base-name} to fit into the 8+3 file-name limits).
+name and does not create a file, (ii) @var{base-name} should be an
+absolute file name that is not magic, and (iii) if the returned file
+name is magic, it might name an existing file. @xref{Magic File
+Names}.
@strong{Warning:} In most cases, you should not use this function; use
@code{make-temp-file} instead! This function is susceptible to a race
@@ -2744,8 +2825,8 @@ located in @file{~/.abbrev_defs}. Here is the definition of
This function returns a file name based on @var{filename}, which fits
the conventions of the current operating system.
-On GNU and Unix systems, this simply returns @var{filename}. On other
-operating systems, it may enforce system-specific file name
+On GNU and other POSIX-like systems, this simply returns @var{filename}.
+On other operating systems, it may enforce system-specific file name
conventions; for example, on MS-DOS this function performs a variety
of changes to enforce MS-DOS file name limitations, including
converting any leading @samp{.} to @samp{_} and truncating to three
@@ -2849,7 +2930,7 @@ directory @var{file}, formatted with @code{ls} according to
@var{switches} may be a string of options, or a list of strings
representing individual options.
-The argument @var{file} may be either a directory name or a file
+The argument @var{file} may be either a directory or a file
specification including wildcard characters. If @var{wildcard} is
non-@code{nil}, that means treat @var{file} as a file specification with
wildcards.
@@ -2905,8 +2986,9 @@ if they don't already exist.
@deffn Command copy-directory dirname newname &optional keep-time parents copy-contents
This command copies the directory named @var{dirname} to
-@var{newname}. If @var{newname} names an existing directory,
+@var{newname}. If @var{newname} is a directory name,
@var{dirname} will be copied to a subdirectory there.
+@xref{Directory Names}.
It always sets the file modes of the copied files to match the
corresponding original file.
@@ -2921,7 +3003,7 @@ this happens by default.
The fifth argument @var{copy-contents}, if non-@code{nil}, means to
copy the contents of @var{dirname} directly into @var{newname} if the
-latter is an existing directory, instead of copying @var{dirname} into
+latter is a directory name, instead of copying @var{dirname} into
it as a subdirectory.
@end deffn
@@ -3055,7 +3137,8 @@ first, before handlers for jobs such as remote file access.
@code{file-ownership-preserved-p},
@code{file-readable-p}, @code{file-regular-p},
@code{file-remote-p}, @code{file-selinux-context},
-@code{file-symlink-p}, @code{file-truename}, @code{file-writable-p},
+@code{file-symlink-p}, @code{file-system-info},
+@code{file-truename}, @code{file-writable-p},
@code{find-backup-file-name},@*
@code{get-file-buffer},
@code{insert-directory},
@@ -3111,7 +3194,8 @@ first, before handlers for jobs such as remote file access.
@code{file-ownership-pre@discretionary{}{}{}served-p},
@code{file-readable-p}, @code{file-regular-p},
@code{file-remote-p}, @code{file-selinux-context},
-@code{file-symlink-p}, @code{file-truename}, @code{file-writable-p},
+@code{file-symlink-p}, @code{file-system-info},
+@code{file-truename}, @code{file-writable-p},
@code{find-backup-file-name},
@code{get-file-buffer},
@code{insert-directory},
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 50467d1dfd5..a146061c771 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -112,37 +112,39 @@ window of another Emacs frame. @xref{Child Frames}.
* Display Feature Testing:: Determining the features of a terminal.
@end menu
+
@node Creating Frames
@section Creating Frames
@cindex frame creation
To create a new frame, call the function @code{make-frame}.
-@deffn Command make-frame &optional alist
+@deffn Command make-frame &optional parameters
This function creates and returns a new frame, displaying the current
buffer.
-The @var{alist} argument is an alist that specifies frame parameters
-for the new frame. @xref{Frame Parameters}. If you specify the
-@code{terminal} parameter in @var{alist}, the new frame is created on
-that terminal. Otherwise, if you specify the @code{window-system}
-frame parameter in @var{alist}, that determines whether the frame
-should be displayed on a text terminal or a graphical terminal.
-@xref{Window Systems}. If neither is specified, the new frame is
-created in the same terminal as the selected frame.
-
-Any parameters not mentioned in @var{alist} default to the values in
-the alist @code{default-frame-alist} (@pxref{Initial Parameters});
+The @var{parameters} argument is an alist that specifies frame
+parameters for the new frame. @xref{Frame Parameters}. If you specify
+the @code{terminal} parameter in @var{parameters}, the new frame is
+created on that terminal. Otherwise, if you specify the
+@code{window-system} frame parameter in @var{parameters}, that
+determines whether the frame should be displayed on a text terminal or a
+graphical terminal. @xref{Window Systems}. If neither is specified,
+the new frame is created in the same terminal as the selected frame.
+
+Any parameters not mentioned in @var{parameters} default to the values
+in the alist @code{default-frame-alist} (@pxref{Initial Parameters});
parameters not specified there default from the X resources or its
equivalent on your operating system (@pxref{X Resources,, X Resources,
-emacs, The GNU Emacs Manual}). After the frame is created, Emacs
-applies any parameters listed in @code{frame-inherited-parameters}
-(see below) and not present in the argument, taking the values from
-the frame that was selected when @code{make-frame} was called.
+emacs, The GNU Emacs Manual}). After the frame is created, this
+function applies any parameters specified in
+@code{frame-inherited-parameters} (see below) it has no assigned yet,
+taking the values from the frame that was selected when
+@code{make-frame} was called.
Note that on multi-monitor displays (@pxref{Multiple Terminals}), the
window manager might position the frame differently than specified by
-the positional parameters in @var{alist} (@pxref{Position
+the positional parameters in @var{parameters} (@pxref{Position
Parameters}). For example, some window managers have a policy of
displaying the frame on the monitor that contains the largest part of
the window (a.k.a.@: the @dfn{dominating} monitor).
@@ -158,20 +160,28 @@ A normal hook run by @code{make-frame} before it creates the frame.
@end defvar
@defvar after-make-frame-functions
-An abnormal hook run by @code{make-frame} after it creates the frame.
-Each function in @code{after-make-frame-functions} receives one argument, the
-frame just created.
+An abnormal hook run by @code{make-frame} after it created the frame.
+Each function in @code{after-make-frame-functions} receives one
+argument, the frame just created.
@end defvar
+Note that any functions added to these hooks by your initial file are
+usually not run for the initial frame, since Emacs reads the initial
+file only after creating that frame. However, if the initial frame is
+specified to use a separate minibuffer frame (@pxref{Minibuffers and
+Frames}), the functions will be run for both, the minibuffer-less and
+the minibuffer frame.
+
@defvar frame-inherited-parameters
This variable specifies the list of frame parameters that a newly
created frame inherits from the currently selected frame. For each
-parameter (a symbol) that is an element in the list and is not present
-in the argument to @code{make-frame}, the function sets the value of
-that parameter in the created frame to its value in the selected
-frame.
+parameter (a symbol) that is an element in this list and has not been
+assigned earlier when processing @code{make-frame}, the function sets
+the value of that parameter in the created frame to its value in the
+selected frame.
@end defvar
+
@node Multiple Terminals
@section Multiple Terminals
@cindex multiple terminals
@@ -974,14 +984,7 @@ Parameters}). The text size of the initial frame can be also set with
the help of an X-style geometry specification. @xref{Emacs Invocation,,
Command Line Arguments for Emacs Invocation, emacs, The GNU Emacs
Manual}. Below we list some functions to access and set the size of an
-existing, visible frame.
-
-@defun frame-text-height &optional frame
-@defunx frame-text-width &optional frame
-These functions return the height and width of the text area of
-@var{frame} (@pxref{Frame Layout}), measured in pixels. For a text
-terminal, the results are in characters rather than pixels.
-@end defun
+existing, visible frame, by default the selected one.
@defun frame-height &optional frame
@defunx frame-width &optional frame
@@ -997,11 +1000,33 @@ rounded down to the number of characters of the default font that fully
fit into the text area.
@end defun
-@defun frame-pixel-height &optional frame
-@defunx frame-pixel-width &optional frame
-These functions return the native width and height, see @ref{Frame
-Layout}) of @var{frame} in pixels. For a text terminal, the results are
-in characters rather than pixels.
+The functions following next return the pixel widths and heights of the
+native, outer and inner frame and the text area (@pxref{Frame Layout})
+of a given frame. For a text terminal, the results are in characters
+rather than pixels.
+
+@defun frame-outer-width &optional frame
+@defunx frame-outer-height &optional frame
+These functions return the outer width and height of @var{frame} in
+pixels.
+@end defun
+
+@defun frame-native-height &optional frame
+@defunx frame-native-width &optional frame
+These functions return the native width and height of @var{frame} in
+pixels.
+@end defun
+
+@defun frame-inner-width &optional frame
+@defunx frame-inner-height &optional frame
+These functions return the inner width and height of @var{frame} in
+pixels.
+@end defun
+
+@defun frame-text-width &optional frame
+@defunx frame-text-height &optional frame
+These functions return the width and height of the text area of
+@var{frame} in pixels.
@end defun
On window systems that support it, Emacs tries by default to make the
@@ -1185,6 +1210,13 @@ terminal supports colors, the parameters @code{foreground-color},
@code{display-type} are also meaningful. If the terminal supports
frame transparency, the parameter @code{alpha} is also meaningful.
+ By default, frame parameters are saved and restored by the desktop
+library functions (@pxref{Desktop Save Mode}) when the variable
+@code{desktop-restore-frames} is non-@code{nil}. It's the
+responsibility of applications that their parameters are included in
+@code{frameset-persistent-filter-alist} to avoid that they get
+meaningless or even harmful values in restored sessions.
+
@menu
* Parameter Access:: How to change a frame's parameters.
* Initial Parameters:: Specifying frame parameters when you make a frame.
@@ -1345,6 +1377,8 @@ text terminals.
* Buffer Parameters:: Which buffers have been or should be shown.
* Frame Interaction Parameters:: Parameters for interacting with other
frames.
+* Mouse Dragging Parameters:: Parameters for resizing and moving
+ frames with the mouse.
* Management Parameters:: Communicating with the window manager.
* Cursor Parameters:: Controlling the cursor appearance.
* Font and Color Parameters:: Fonts and colors for the frame text.
@@ -1404,18 +1438,19 @@ named, this parameter will be @code{nil}.
@cindex frame position
Parameters describing the X- and Y-offsets of a frame are always
-measured in pixels. For normal, non-child frames they specify the
-frame's absolute outer position (@pxref{Frame Geometry}) with respect to
-its display's origin. For a child frame (@pxref{Child Frames}) they
-specify the frame's outer position relative to the native position of
-the frame's parent frame. (Note that none of these parameters is
-meaningful on TTY frames.)
+measured in pixels. For a normal, non-child frame they specify the
+frame's outer position (@pxref{Frame Geometry}) relative to its
+display's origin. For a child frame (@pxref{Child Frames}) they specify
+the frame's outer position relative to the native position of the
+frame's parent frame. (Note that none of these parameters is meaningful
+on TTY frames.)
@table @code
@vindex left, a frame parameter
@item left
The position, in pixels, of the left outer edge of the frame with
-respect to the left edge of the frame's display or parent frame.
+respect to the left edge of the frame's display or parent frame. It can
+be specified in one of the following ways.
@table @asis
@item an integer
@@ -1436,6 +1471,30 @@ right edge of the display or parent frame. The integer @var{pos} may be
positive or negative; a negative value specifies a position outside the
screen or parent frame or on a monitor other than the primary one (for
multi-monitor displays).
+
+@cindex left position ratio
+@cindex top position ratio
+@item a floating-point value
+A floating-point value in the range 0.0 to 1.0 specifies the left edge's
+offset via the @dfn{left position ratio} of the frame---the ratio of the
+left edge of its outer frame to the width of the frame's workarea
+(@pxref{Multiple Terminals}) or its parent's native frame (@pxref{Child
+Frames}) minus the width of the outer frame. Thus, a left position
+ratio of 0.0 flushes a frame to the left, a ratio of 0.5 centers it and
+a ratio of 1.0 flushes it to the right of its display or parent frame.
+Similarly, the @dfn{top position ratio} of a frame is the ratio of the
+frame's top position to the height of its workarea or parent frame minus
+the height of the frame.
+
+Emacs will try to keep the position ratios of a child frame unaltered if
+that frame has a non-@code{nil} @code{keep-ratio} parameter
+(@pxref{Frame Interaction Parameters}) and its parent frame is resized.
+
+Since the outer size of a frame (@pxref{Frame Geometry}) is usually
+unavailable before a frame has been made visible, it is generally not
+advisable to use floating-point values when creating decorated frames.
+Floating-point values are more suited for ensuring that an (undecorated)
+child frame is positioned nicely within the area of its parent frame.
@end table
Some window managers ignore program-specified positions. If you want to
@@ -1448,17 +1507,19 @@ following example:
nil '((user-position . t) (left . (+ -4))))
@end example
-In general, it is not a good idea to specify negative offsets to
-position a frame relative to the right or bottom edge of its display.
-Positioning the initial or a new frame is either not accurate (because
-the size of the outer frame is not yet fully known before the frame has
-been made visible) or will cause additional flicker (if the frame is
-repositioned after becoming visible).
+In general, it is not a good idea to position a frame relative to the
+right or bottom edge of its display. Positioning the initial or a new
+frame is either not accurate (because the size of the outer frame is not
+yet fully known before the frame has been made visible) or will cause
+additional flicker (if the frame has to be repositioned after becoming
+visible).
- Note also, that negative offsets are not stored internally and are not
-returned by the function @code{frame-parameters}. This means that the
-desktop saving routines will restore the frame from the positive offsets
-obtained by that function.
+ Note also, that positions specified relative to the right/bottom edge
+of a display, workarea or parent frame as well as floating-point offsets
+are stored internally as integer offsets relative to the left/top edge
+of the display, workarea or parent frame edge. They are also returned
+as such by functions like @code{frame-parameters} and restored as such
+by the desktop saving routines.
@vindex top, a frame parameter
@item top
@@ -1523,24 +1584,61 @@ function @code{frame-restack} (@pxref{Raising and Lowering}).
@subsubsection Size Parameters
@cindex window size on display
- Frame parameters specify frame sizes in character units. On
-graphical displays, the @code{default} face determines the actual
-pixel sizes of these character units (@pxref{Face Attributes}).
+Frame parameters usually specify frame sizes in character units. On
+graphical displays, the @code{default} face determines the actual pixel
+sizes of these character units (@pxref{Face Attributes}).
@table @code
@vindex width, a frame parameter
@item width
-The width of the frame's text area (@pxref{Frame Geometry}), in
-characters. The value can be also a cons cell of the symbol
-@code{text-pixels} and an integer denoting the width of the text area in
-pixels.
+This parameter specifies the width of the frame. It can be specified as
+in the following ways:
+
+@table @asis
+@item an integer
+A positive integer specifies the width of the frame's text area
+(@pxref{Frame Geometry}) in characters.
+
+@item a cons cell
+If this is a cons cell with the symbol @code{text-pixels} in its
+@sc{car}, the @sc{cdr} of that cell specifies the width of the frame's
+text area in pixels.
+
+@cindex frame width ratio
+@cindex frame height ratio
+@item a floating-point value
+A floating-point number between 0.0 and 1.0 can be used to specify the
+width of a frame via its @dfn{width ratio}---the ratio of its outer
+width (@pxref{Frame Geometry}) to the width of the frame's workarea
+(@pxref{Multiple Terminals}) or its parent frame's (@pxref{Child
+Frames}) native frame. Thus, a value of 0.5 makes the frame occupy half
+of the width of its workarea or parent frame, a value of 1.0 the full
+width. Similarly, the @dfn{height ratio} of a frame is the ratio of its
+outer height to the height of its workarea or its parent's native frame.
+
+Emacs will try to keep the width and height ratio of a child frame
+unaltered if that frame has a non-@code{nil} @code{keep-ratio} parameter
+(@pxref{Frame Interaction Parameters}) and its parent frame is resized.
+
+Since the outer size of a frame is usually unavailable before a frame
+has been made visible, it is generally not advisable to use
+floating-point values when creating decorated frames. Floating-point
+values are more suited to ensure that a child frame always fits within
+the area of its parent frame as, for example, when customizing
+@code{display-buffer-alist} (@pxref{Choosing Window}) via
+@code{display-buffer-in-child-frame}.
+@end table
+
+Regardless of how this parameter was specified, functions reporting the
+value of this parameter like @code{frame-parameters} always report the
+width of the frame's text area in characters as an integer rounded, if
+necessary, to a multiple of the frame's default character width. That
+value is also used by the desktop saving routines.
@vindex height, a frame parameter
@item height
-The height of the frame's text area (@pxref{Frame Geometry}), in
-characters. The value can be also a cons cell of the symbol
-@code{text-pixels} and an integer denoting the height of the text area
-in pixels.
+This parameter specifies the height of the frame. It works just like
+@code{width}, except vertically instead of horizontally.
@vindex user-size, a frame parameter
@item user-size
@@ -1551,25 +1649,25 @@ user-position}) does for the position parameters @code{top} and
@vindex min-width, a frame parameter
@item min-width
-This parameter specifies the minimum native width of the frame
-(@pxref{Frame Geometry}), in characters. Normally, the functions that
+This parameter specifies the minimum native width (@pxref{Frame
+Geometry}) of the frame, in characters. Normally, the functions that
establish a frame's initial width or resize a frame horizontally make
sure that all the frame's windows, vertical scroll bars, fringes,
margins and vertical dividers can be displayed. This parameter, if
non-@code{nil} allows to make a frame narrower than that with the
-consequence that any components that do not fit on the frame will be
-clipped by the window manager.
+consequence that any components that do not fit will be clipped by the
+window manager.
@vindex min-height, a frame parameter
@item min-height
-This parameter specifies the minimum height of the native (@pxref{Frame
-Geometry}), in characters. Normally, the functions that establish a
-frame's initial size or resize a frame make sure that all the frame's
-windows, horizontal scroll bars and dividers, mode and header lines, the
-echo area and the internal menu and tool bar can be displayed. This
-parameter, if non-@code{nil} allows to make a frame smaller than that
-with the consequence that any components that do not fit on the frame
-will be clipped by the window-system or window manager.
+This parameter specifies the minimum native height (@pxref{Frame
+Geometry}) of the frame, in characters. Normally, the functions that
+establish a frame's initial size or resize a frame make sure that all
+the frame's windows, horizontal scroll bars and dividers, mode and
+header lines, the echo area and the internal menu and tool bar can be
+displayed. This parameter, if non-@code{nil} allows to make a frame
+smaller than that with the consequence that any components that do not
+fit will be clipped by the window manager.
@cindex fullboth frames
@cindex fullheight frames
@@ -1623,6 +1721,20 @@ file as, for example
This will give a new frame full height after typing in it @key{F11} for
the first time.
+
+@vindex fit-frame-to-buffer-margins, a frame parameter
+@item fit-frame-to-buffer-margins
+This parameter allows to override the value of the option
+@code{fit-frame-to-buffer-margins} when fitting this frame to the buffer
+of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing
+Windows}).
+
+@vindex fit-frame-to-buffer-sizes, a frame parameter
+@item fit-frame-to-buffer-sizes
+This parameter allows to override the value of the option
+@code{fit-frame-to-buffer-sizes} when fitting this frame to the buffer
+of its root window with @code{fit-frame-to-buffer} (@pxref{Resizing
+Windows}).
@end table
@@ -1646,9 +1758,9 @@ Geometry}).
@vindex vertical-scroll-bars, a frame parameter
@item vertical-scroll-bars
-Whether the frame has scroll bars for vertical scrolling, and which side
-of the frame they should be on. The possible values are @code{left},
-@code{right}, and @code{nil} for no scroll bars.
+Whether the frame has scroll bars (@pxref{Scroll Bars}) for vertical
+scrolling, and which side of the frame they should be on. The possible
+values are @code{left}, @code{right}, and @code{nil} for no scroll bars.
@vindex horizontal-scroll-bars, a frame parameter
@item horizontal-scroll-bars
@@ -1692,30 +1804,40 @@ to not draw bottom dividers.
@vindex menu-bar-lines frame parameter
@item menu-bar-lines
-The number of lines to allocate at the top of the frame for a menu bar.
-The default is one if Menu Bar mode is enabled and zero otherwise.
-@xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an external menu
-bar, this value remains unchanged even when the menu bar wraps to two or
-more lines. In that case, the @code{menu-bar-size} value returned by
-@code{frame-geometry} (@pxref{Frame Geometry}) allows to derive whether
-the menu bar actually occupies one or more lines.
+The number of lines to allocate at the top of the frame for a menu bar
+(@pxref{Menu Bar}). The default is one if Menu Bar mode is enabled and
+zero otherwise. @xref{Menu Bars,,,emacs, The GNU Emacs Manual}. For an
+external menu bar (@pxref{Frame Layout}), this value remains unchanged
+even when the menu bar wraps to two or more lines. In that case, the
+@code{menu-bar-size} value returned by @code{frame-geometry}
+(@pxref{Frame Geometry}) allows to derive whether the menu bar actually
+occupies one or more lines.
@vindex tool-bar-lines frame parameter
@item tool-bar-lines
-The number of lines to use for the tool bar. The default is one if Tool
-Bar mode is enabled and zero otherwise. @xref{Tool Bars,,,emacs, The
-GNU Emacs Manual}. This value may change whenever the tool bar wraps.
+The number of lines to use for the tool bar (@pxref{Tool Bar}). The
+default is one if Tool Bar mode is enabled and zero otherwise.
+@xref{Tool Bars,,,emacs, The GNU Emacs Manual}. This value may change
+whenever the tool bar wraps (@pxref{Frame Layout}).
@vindex tool-bar-position frame parameter
@item tool-bar-position
-The position of the tool bar. Currently only for the GTK tool bar.
-Value can be one of @code{top}, @code{bottom} @code{left}, @code{right}.
-The default is @code{top}.
+The position of the tool bar when Emacs was built with GTK+. Its value
+can be one of @code{top}, @code{bottom} @code{left}, @code{right}. The
+default is @code{top}.
@vindex line-spacing, a frame parameter
@item line-spacing
Additional space to leave below each text line, in pixels (a positive
integer). @xref{Line Height}, for more information.
+
+@vindex no-special-glyphs, a frame parameter
+@item no-special-glyphs
+If this is non-@code{nil}, it suppresses the display of any truncation
+and continuation glyphs (@pxref{Truncation}) for all buffers displayed
+by this frame. This is useful to eliminate such glyphs when fitting a
+frame to its buffer via @code{fit-frame-to-buffer} (@pxref{Resizing
+Windows}).
@end table
@@ -1735,8 +1857,14 @@ yes, @code{nil} means no, @code{only} means this frame is just a
minibuffer. If the value is a minibuffer window (in some other
frame), the frame uses that minibuffer.
-This frame parameter takes effect when the frame is created, and can
-not be changed afterwards.
+This parameter takes effect when the frame is created. If specified as
+@code{nil}, Emacs will try to set it to the minibuffer window of
+@code{default-minibuffer-frame} (@pxref{Minibuffers and Frames}). For
+an existing frame, this parameter can be used exclusively to specify
+another minibuffer window. It is not allowed to change it from a
+minibuffer window to @code{t} and vice-versa, or from @code{t} to
+@code{nil}. If the parameter specifies a minibuffer window already,
+setting it to @code{nil} has no effect.
@vindex buffer-predicate, a frame parameter
@item buffer-predicate
@@ -1757,6 +1885,7 @@ most-recently-selected first.
If non-@code{nil}, this frame's window is never split automatically.
@end table
+
@node Frame Interaction Parameters
@subsubsection Frame Interaction Parameters
@cindex frame interaction parameters
@@ -1781,15 +1910,115 @@ Frames}.
@item mouse-wheel-frame
If non-@code{nil}, this parameter specifies the frame whose windows will
be scrolled whenever the mouse wheel is scrolled with the mouse pointer
-hovering over this frame (@pxref{Mouse Commands,,, emacs, The GNU Emacs
-Manual}).
+hovering over this frame, see @ref{Mouse Commands,,, emacs, The GNU
+Emacs Manual}.
@vindex no-other-frame, a frame parameter
@item no-other-frame
If this is non-@code{nil}, then this frame is not eligible as candidate
for the functions @code{next-frame}, @code{previous-frame}
-(@pxref{Finding All Frames}) and @code{other-frame} (@pxref{Frame
-Commands,,, emacs, The GNU Emacs Manual}).
+(@pxref{Finding All Frames}) and @code{other-frame}, see @ref{Frame
+Commands,,, emacs, The GNU Emacs Manual}.
+
+@vindex auto-hide-function, a frame parameter
+@item auto-hide-function
+When this parameter specifies a function, that function will be called
+instead of the function specified by the variable
+@code{frame-auto-hide-function} when quitting the frame's only window
+(@pxref{Quitting Windows}) and there are other frames left.
+
+@vindex minibuffer-exit, a frame parameter
+@item minibuffer-exit
+When this parameter is non-@code{nil}, Emacs will by default make this
+frame invisible whenever the minibuffer (@pxref{Minibuffers}) is exited.
+Alternatively, it can specify the functions @code{iconify-frame} and
+@code{delete-frame}. This parameter is useful to make a child frame
+disappear automatically (similar to how Emacs deals with a window) when
+exiting the minibuffer.
+
+@vindex keep-ratio, a frame parameter
+@item keep-ratio
+This parameter is currently meaningful for child frames (@pxref{Child
+Frames}) only. If it is non-@code{nil}, then Emacs will try to keep the
+frame's size (width and height) ratios (@pxref{Size Parameters}) as well
+as its left and right position ratios (@pxref{Position Parameters})
+unaltered whenever its parent frame is resized.
+
+If the value of this parameter is @code{nil}, the frame's position and
+size remain unaltered when the parent frame is resized, so the position
+and size ratios may change. If the value of this parameter is @code{t},
+Emacs will try to preserve the frame's size and position ratios, hence
+the frame's size and position relative to its parent frame may change.
+
+More individual control is possible by using a cons cell: In that case
+the frame's width ratio is preserved if the @sc{car} of the cell is
+either @code{t} or @code{width-only}. The height ratio is preserved if
+the @sc{car} of the cell is either @code{t} or @code{height-only}. The
+left position ratio is preserved if the @sc{cdr} of the cell is either
+@code{t} or @code{left-only}. The top position ratio is preserved if
+the @sc{cdr} of the cell is either @code{t} or @code{top-only}.
+@end table
+
+
+@node Mouse Dragging Parameters
+@subsubsection Mouse Dragging Parameters
+@cindex mouse dragging parameters
+@cindex parameters for resizing frames with the mouse
+@cindex parameters for moving frames with the mouse
+
+The parameters described below provide support for resizing a frame by
+dragging its internal borders with the mouse. They also allow moving a
+frame with the mouse by dragging the header line of its topmost or the
+mode line of its bottommost window.
+
+These parameters are mostly useful for child frames (@pxref{Child
+Frames}) that come without window manager decorations. If necessary,
+they can be used for undecorated top-level frames as well.
+
+@table @code
+@vindex drag-internal-border, a frame parameter
+@item drag-internal-border
+If non-@code{nil}, the frame can be resized by dragging its internal
+borders, if present, with the mouse.
+
+@vindex drag-with-header-line, a frame parameter
+@item drag-with-header-line
+If non-@code{nil}, the frame can be moved with the mouse by dragging the
+header line of its topmost window.
+
+@vindex drag-with-mode-line, a frame parameter
+@item drag-with-mode-line
+If non-@code{nil}, the frame can be moved with the mouse by dragging the
+mode line of its bottommost window. Note that such a frame is not
+allowed to have its own minibuffer window.
+
+@vindex snap-width, a frame parameter
+@item snap-width
+A frame that is moved with the mouse will ``snap'' at the border(s) of
+the display or its parent frame whenever it is dragged as near to such
+an edge as the number of pixels specified by this parameter.
+
+@vindex top-visible, a frame parameter
+@item top-visible
+If this parameter is a number, the top edge of the frame never appears
+above the top edge of its display or parent frame. Moreover, as many
+pixels of the frame as specified by that number will remain visible when
+the frame is moved against any of the remaining edges of its display or
+parent frame. Setting this parameter is useful to guard against
+dragging a child frame with a non-@code{nil}
+@code{drag-with-header-line} parameter completely out of the area
+of its parent frame.
+
+@vindex bottom-visible, a frame parameter
+@item bottom-visible
+If this parameter is a number, the bottom edge of the frame never
+appears below the bottom edge of its display or parent frame. Moreover,
+as many pixels of the frame as specified by that number will remain
+visible when the frame is moved against any of the remaining edges of
+its display or parent frame. Setting this parameter is useful to guard
+against dragging a child frame with a non-@code{nil}
+@code{drag-with-mode-line} parameter completely out of the area of
+its parent frame.
@end table
@@ -1797,9 +2026,9 @@ Commands,,, emacs, The GNU Emacs Manual}).
@subsubsection Window Management Parameters
@cindex window manager interaction, and frame parameters
- The following frame parameters control various aspects of the
-frame's interaction with the window manager. They have no effect on
-text terminals.
+ The following frame parameters control various aspects of the frame's
+interaction with the window manager or window system. They have no
+effect on text terminals.
@table @code
@vindex visibility, a frame parameter
@@ -1908,7 +2137,8 @@ If non-@code{nil}, this means that this is an @dfn{override redirect}
frame---a frame not handled by window managers under X. Override
redirect frames have no window manager decorations, can be positioned
and resized only via Emacs' positioning and resizing functions and are
-usually drawn on top of all other frames.
+usually drawn on top of all other frames. Setting this parameter has
+no effect on MS-Windows.
@ignore
@vindex parent-id, a frame parameter
@@ -1919,6 +2149,20 @@ Specifying this lets you create an Emacs window inside some other
application's window. (It is not certain this will be implemented; try
it and see if it works.)
@end ignore
+
+@vindex ns-appearance, a frame parameter
+@item ns-appearance
+Only available on macOS, if set to @code{dark} draw this frame's
+window-system window using the ``vibrant dark'' theme, otherwise use
+the system default. The ``vibrant dark'' theme can be used to set the
+toolbar and scrollbars to a dark appearance when using an Emacs theme
+with a dark background.
+
+@vindex ns-transparent-titlebar, a frame parameter
+@item ns-transparent-titlebar
+Only available on macOS, if non-@code{nil}, set the titlebar and
+toolbar to be transparent. This effectively sets the background color
+of both to match the Emacs background color.
@end table
@@ -2080,6 +2324,9 @@ The @code{alpha} frame parameter can also be a cons cell
@code{(@var{active} . @var{inactive})}, where @var{active} is the
opacity of the frame when it is selected, and @var{inactive} is the
opacity when it is not selected.
+
+Some window systems do not support the @code{alpha} parameter for child
+frames (@pxref{Child Frames}).
@end table
The following frame parameters are semi-obsolete in that they are
@@ -2824,57 +3071,77 @@ unwanted frames are iconified instead.
@cindex child frames
@cindex parent frames
-On some window-systems the @code{parent-frame} parameter (@pxref{Frame
-Interaction Parameters}) can be used to make a frame a child of the
-frame specified by that parameter. The frame specified by that
-parameter will then be the frame's parent frame as long as the parameter
-is not changed or reset. Technically, this makes the child frame's
-window-system window a child window of the parent frame's window-system
-window.
-
+Child frames are objects halfway between windows (@pxref{Windows}) and
+``normal'' frames. Like windows, they are attached to an owning frame.
+Unlike windows, they may overlap each other---changing the size or
+position of one child frame does not change the size or position of any
+of its sibling child frames.
+
+ By design, operations to make or modify child frames are implemented
+with the help of frame parameters (@pxref{Frame Parameters}) without any
+specialized functions or customizable variables. Note that child frames
+are meaningful on graphical terminals only.
+
+ To create a new child frame or to convert a normal frame into a child
+frame, set that frame's @code{parent-frame} parameter (@pxref{Frame
+Interaction Parameters}) to that of an already existing frame. The
+frame specified by that parameter will then be the frame's parent frame
+as long as the parameter is not changed or reset. Technically, this
+makes the child frame's window-system window a child window of the
+parent frame's window-system window.
+
+@cindex reparent frame
+@cindex nest frame
The @code{parent-frame} parameter can be changed at any time. Setting
-it to another frame ``reparents'' the child frame. Setting it to
-another child frame makes the frame a ``nested'' child frame. Setting
-it to @code{nil} restores the frame's status as a top-level frame---one
-whose window-system window is a child of its display's root window.
+it to another frame @dfn{reparents} the child frame. Setting it to
+another child frame makes the frame a @dfn{nested} child frame. Setting
+it to @code{nil} restores the frame's status as a top-level frame---a
+frame whose window-system window is a child of its display's root
+window.
Since child frames can be arbitrarily nested, a frame can be both a
child and a parent frame. Also, the relative roles of child and parent
frame may be reversed at any time (though it's usually a good idea to
-keep the size of child frames sufficiently smaller than that of their
+keep the size of a child frame sufficiently smaller than that of its
parent). An error will be signaled for the attempt to make a frame an
ancestor of itself.
- A child frame is clipped at the native edges (@pxref{Frame Geometry})
-of its parent frame---everything outside these edges is invisible. Its
-@code{left} and @code{top} parameters specify positions relative to the
-top-left corner of its parent's native frame. When either of the frames
-is resized, the relative position of the child frame remains unaltered.
-Hence, resizing either of these frames can hide or reveal parts of the
-child frame.
+ Most window-systems clip a child frame at the native edges
+(@pxref{Frame Geometry}) of its parent frame---everything outside these
+edges is usually invisible. A child frame's @code{left} and @code{top}
+parameters specify a position relative to the top-left corner of its
+parent's native frame. When the parent frame is resized, this position
+remains conceptually unaltered.
NS builds do not clip child frames at the parent frame's edges,
-allowing them to be positioned so they do not obscure the parent
-frame while still being visible themselves.
+allowing them to be positioned so they do not obscure the parent frame
+while still being visible themselves.
Usually, moving a parent frame moves along all its child frames and
their descendants as well, keeping their relative positions unaltered.
-The hook @code{move-frame-functions} (@pxref{Frame Position}) is run for
-a child frame only when the position of the child frame relative to its
-parent frame changes. When a parent frame is resized, the child frame
-retains its position respective to the left and upper native edges of
-its parent. In this case, the position respective to the lower or right
-native edge of the parent frame is usually lost.
+Note that the hook @code{move-frame-functions} (@pxref{Frame Position})
+is run for a child frame only when the position of the child frame
+relative to its parent frame changes. It is not run for a child frame
+when the position of the parent frame changes.
+
+ When a parent frame is resized, its child frames conceptually retain
+their previous sizes and their positions relative to the left upper
+corner of the parent. This means that a child frame may become
+(partially) invisible when its parent frame shrinks. The parameter
+@code{keep-ratio} (@pxref{Frame Interaction Parameters}) can be used to
+resize and reposition a child frame proportionally whenever its parent
+frame is resized. This may avoid obscuring parts of a frame when its
+parent frame is shrunk.
A visible child frame always appears on top of its parent frame thus
obscuring parts of it, except on NS builds where it may be positioned
-beneath the parent. This is comparable to the window-system window of
-a top-level frame which also always appears on top of its parent
-window---the desktop's root window. When a parent frame is iconified
-or made invisible (@pxref{Visibility of Frames}), its child frames are
-made invisible. When a parent frame is deiconified or made visible,
-its child frames are made visible. When a parent frame is about to be
-deleted, (@pxref{Deleting Frames}) its child frames are recursively
+beneath the parent. This is comparable to the window-system window of a
+top-level frame which also always appears on top of its parent
+window---the desktop's root window. When a parent frame is iconified or
+made invisible (@pxref{Visibility of Frames}), its child frames are made
+invisible. When a parent frame is deiconified or made visible, its
+child frames are made visible. When a parent frame is about to be
+deleted (@pxref{Deleting Frames}), its child frames are recursively
deleted before it.
Whether a child frame can have a menu or tool bar is window-system or
@@ -2892,7 +3159,55 @@ outer border can be used. On MS-Windows, specifying a non-zero outer
border width will show a one-pixel wide external border. Under all
window-systems, the internal border can be used. In either case, it's
advisable to disable a child frame's window manager decorations with the
-@code{undecorated} frame parameter @pxref{Management Parameters}).
+@code{undecorated} frame parameter (@pxref{Management Parameters}).
+
+ To resize or move an undecorated child frame with the mouse, special
+frame parameters (@pxref{Mouse Dragging Parameters}) have to be used.
+The internal border of a child frame, if present, can be used to resize
+the frame with the mouse, provided that frame has a non-@code{nil}
+@code{drag-internal-border} parameter. If set, the @code{snap-width}
+parameter indicates the number of pixels where the frame @dfn{snaps} at
+the respective edge or corner of its parent frame.
+
+ There are two ways to drag an entire child frame with the mouse: The
+@code{drag-with-mode-line} parameter, if non-@code{nil}, allows to drag
+a frame without minibuffer window (@pxref{Minibuffer Windows}) via the
+mode line area of its bottommost window. The
+@code{drag-with-header-line} parameter, if non-@code{nil}, allows to
+drag the frame via the header line area of its topmost window.
+
+ In order to give a child frame a draggable header or mode line, the
+window parameters @code{mode-line-format} and @code{header-line-format}
+are handy (@pxref{Window Parameters}). These allow to remove an
+unwanted mode line (when @code{drag-with-header-line} is chosen) and to
+remove mouse-sensitive areas which might interfere with frame dragging.
+
+ To avoid that dragging moves a frame completely out of its parent's
+native frame, something which might happen when the mouse cursor
+overshoots and makes the frame difficult to retrieve once the mouse
+button has been released, it is advisable to set the frame's
+@code{top-visible} or @code{bottom-visible} parameter correspondingly.
+
+ The @code{top-visible} parameter specifies the number of pixels at the
+top of the frame that always remain visible within the parent's native
+frame during dragging and should be set when specifying a non-@code{nil}
+@code{drag-with-header-line} parameter. The @code{bottom-visible}
+parameter specifies the number of pixels at the bottom of the frame that
+always remain visible within the parent's native frame during dragging
+and should be preferred when specifying a non-@code{nil}
+@code{drag-with-mode-line} parameter.
+
+ When a child frame is used for displaying a buffer via
+@code{display-buffer-in-child-frame} (@pxref{Display Action Functions}),
+the frame's @code{auto-hide-function} parameter (@pxref{Frame
+Interaction Parameters}) can be set to a function, in order to
+appropriately deal with the frame when the window displaying the buffer
+shall be quit.
+
+ When a child frame is used during minibuffer interaction, for example,
+to display completions in a separate window, the @code{minibuffer-exit}
+parameter (@pxref{Frame Interaction Parameters}) is useful in order to
+deal with the frame when the minibuffer is exited.
The behavior of child frames deviates from that of top-level frames in
a number of other ways as well. Here we sketch a few of them:
@@ -2901,7 +3216,11 @@ a number of other ways as well. Here we sketch a few of them:
@item
The semantics of maximizing and iconifying child frames is highly
window-system dependent. As a rule, applications should never invoke
-these operations for child frames.
+these operations on child frames. By default, invoking
+@code{iconify-frame} on a child frame will try to iconify the top-level
+frame corresponding to that child frame instead. To obtain a different
+behavior, users may customize the option @code{iconify-child-frame}
+described below.
@item
Raising, lowering and restacking child frames (@pxref{Raising and
@@ -2930,7 +3249,7 @@ work on all window-systems. Some will drop the object on the parent
frame or on some ancestor instead.
@end itemize
- The following two functions may be useful when working with child and
+ The following two functions can be useful when working with child and
parent frames:
@defun frame-parent &optional frame
@@ -2951,6 +3270,29 @@ of @var{descendant}'s parent frame. Both, @var{ancestor} and
frame.
@end defun
+Note also the function @code{window-largest-empty-rectangle}
+(@pxref{Coordinates and Windows}) which can be used to inscribe a child
+frame in the largest empty area of an existing window. This can be
+useful to avoid that a child frame obscures any text shown in that
+window.
+
+Customizing the following option can be useful to tweak the behavior of
+@code{iconify-frame} for child frames.
+
+@defvar iconify-child-frame
+This option tells Emacs how to proceed when it is asked to iconify a
+child frame. If it is @code{nil}, @code{iconify-frame} will do nothing
+when invoked on a child frame. If it is @code{iconify-top-level}, Emacs
+will try to iconify the top-level frame that is the ancestor of this
+child frame instead. If it is @code{make-invisible}, Emacs will try to
+make this child frame invisible instead of iconifying it.
+
+Any other value means to try iconifying the child frame. Since such an
+attempt may not be honored by all window managers and can even lead to
+making the child frame unresponsive to user actions, the default is to
+iconify the top level frame instead.
+@end defvar
+
@node Mouse Tracking
@section Mouse Tracking
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 283f74ff5d2..466a12f7a48 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -544,6 +544,15 @@ variable; these two uses of a symbol are independent and do not
conflict. (This is not the case in some dialects of Lisp, like
Scheme.)
+ By convention, if a function's symbol consists of two names
+separated by @samp{--}, the function is intended for internal use and
+the first part names the file defining the function. For example, a
+function named @code{vc-git--rev-parse} is an internal function
+defined in @file{vc-git.el}. Internal-use functions written in C have
+names ending in @samp{-internal}, e.g., @code{bury-buffer-internal}.
+Emacs code contributed before 2018 may follow other internal-use
+naming conventions, which are being phased out.
+
@node Defining Functions
@section Defining Functions
@cindex defining a function
@@ -703,7 +712,7 @@ the backquote (@pxref{Backquote}), but quotes code and accepts only
@end defmac
@defmac inline-letevals (bindings@dots{}) body@dots{}
-This is is similar to @code{let} (@pxref{Local Variables}): it sets up
+This is similar to @code{let} (@pxref{Local Variables}): it sets up
local variables as specified by @var{bindings}, and then evaluates
@var{body} with those bindings in effect. Each element of
@var{bindings} should be either a symbol or a list of the form
@@ -921,11 +930,11 @@ the @code{call-interactively} function. @xref{Interactive Call}.
A @dfn{mapping function} applies a given function (@emph{not} a
special form or macro) to each element of a list or other collection.
Emacs Lisp has several such functions; this section describes
-@code{mapcar}, @code{mapc}, and @code{mapconcat}, which map over a
-list. @xref{Definition of mapatoms}, for the function @code{mapatoms}
-which maps over the symbols in an obarray. @xref{Definition of
-maphash}, for the function @code{maphash} which maps over key/value
-associations in a hash table.
+@code{mapcar}, @code{mapc}, @code{mapconcat}, and @code{mapcan}, which
+map over a list. @xref{Definition of mapatoms}, for the function
+@code{mapatoms} which maps over the symbols in an obarray.
+@xref{Definition of maphash}, for the function @code{maphash} which
+maps over key/value associations in a hash table.
These mapping functions do not allow char-tables because a char-table
is a sparse array whose nominal range of indices is very large. To map
@@ -977,6 +986,26 @@ Return the list of results."
@end example
@end defun
+@defun mapcan function sequence
+This function applies @var{function} to each element of
+@var{sequence}, like @code{mapcar}, but instead of collecting the
+results into a list, it returns a single list with all the elements of
+the results (which must be lists), by altering the results (using
+@code{nconc}; @pxref{Rearrangement}). Like with @code{mapcar},
+@var{sequence} can be of any type except a char-table.
+
+@example
+@group
+;; @r{Contrast this:}
+(mapcar 'list '(a b c d))
+ @result{} ((a) (b) (c) (d))
+;; @r{with this:}
+(mapcan 'list '(a b c d))
+ @result{} (a b c d)
+@end group
+@end example
+@end defun
+
@defun mapc function sequence
@code{mapc} is like @code{mapcar} except that @var{function} is used for
side-effects only---the values it returns are ignored, not collected
@@ -2000,8 +2029,8 @@ It is equivalent to the following:
@end example
@end defmac
-In addition, you can mark a certain a particular calling convention
-for a function as obsolete:
+In addition, you can mark a particular calling convention for a
+function as obsolete:
@defun set-advertised-calling-convention function signature when
This function specifies the argument list @var{signature} as the
diff --git a/doc/lispref/gpl.texi b/doc/lispref/gpl.texi
index 0e2e212acb1..c007dc06966 100644
--- a/doc/lispref/gpl.texi
+++ b/doc/lispref/gpl.texi
@@ -5,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/}
+Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies of this
license document, but changing it is not allowed.
@@ -684,7 +684,7 @@ 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 @url{http://www.gnu.org/licenses/}.
+along with this program. If not, see @url{https://www.gnu.org/licenses/}.
@end smallexample
Also add information on how to contact you by electronic and paper mail.
@@ -707,11 +707,11 @@ use an ``about box''.
You should also get your employer (if you work as a programmer) or school,
if any, to sign a ``copyright disclaimer'' for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-@url{http://www.gnu.org/licenses/}.
+@url{https://www.gnu.org/licenses/}.
The GNU General Public License does not permit incorporating your
program into proprietary programs. If your program is a subroutine
library, you may consider it more useful to permit linking proprietary
applications with the library. If this is what you want to do, use
the GNU Lesser General Public License instead of this License. But
-first, please read @url{http://www.gnu.org/philosophy/why-not-lgpl.html}.
+first, please read @url{https://www.gnu.org/licenses/why-not-lgpl.html}.
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index cb214113523..4aa9b95180e 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -33,6 +33,7 @@ Help, emacs, The GNU Emacs Manual}.
* Documentation Basics:: Where doc strings are defined and stored.
* Accessing Documentation:: How Lisp programs can access doc strings.
* Keys in Documentation:: Substituting current key bindings.
+* Text Quoting Style:: Quotation marks in doc strings and messages.
* Describing Characters:: Making printable descriptions of
non-printing characters and key sequences.
* Help Functions:: Subroutines used by Emacs help facilities.
@@ -336,6 +337,7 @@ specifies @var{mapvar}'s value as the keymap for any following
(grave accent) stands for a left quote.
This generates a left single quotation mark, an apostrophe, or a grave
accent depending on the value of @code{text-quoting-style}.
+@xref{Text Quoting Style}.
@item '
(apostrophe) stands for a right quote.
@@ -351,25 +353,24 @@ and @samp{\=\=} puts @samp{\=} into the output.
@strong{Please note:} Each @samp{\} must be doubled when written in a
string in Emacs Lisp.
-@defvar text-quoting-style
+@defopt text-quoting-style
@cindex curved quotes
@cindex curly quotes
The value of this variable is a symbol that specifies the style Emacs
-should use for single quotes in the wording of help and messages.
-If the variable's value is @code{curve}, the style is
-@t{‘like this’} with curved single quotes. If the value is
-@code{straight}, the style is @t{'like this'} with straight
-apostrophes. If the value is @code{grave},
-quotes are not translated and the style is @t{`like
-this'} with grave accent and apostrophe, the standard style
-before Emacs version 25. The default value @code{nil}
-acts like @code{curve} if curved single quotes are displayable, and
-like @code{grave} otherwise.
-
-This variable can be used by experts on platforms that have problems
-with curved quotes. As it is not intended for casual use, it is not a
-user option.
-@end defvar
+should use for single quotes in the wording of help and messages. If
+the variable's value is @code{curve}, the style is @t{‘like this’}
+with curved single quotes. If the value is @code{straight}, the style
+is @t{'like this'} with straight apostrophes. If the value is
+@code{grave}, quotes are not translated and the style is @t{`like
+this'} with grave accent and apostrophe, the standard style before
+Emacs version 25. The default value @code{nil} acts like @code{curve}
+if curved single quotes seem to be displayable, and like @code{grave}
+otherwise.
+
+This option is useful on platforms that have problems with curved
+quotes. You can customize it freely according to your personal
+preference.
+@end defopt
@defun substitute-command-keys string
This function scans @var{string} for the above special sequences and
@@ -429,6 +430,53 @@ C-g abort-recursive-edit
strings---for instance, you can refer to functions, variables, and
sections of this manual. @xref{Documentation Tips}, for details.
+@node Text Quoting Style
+@section Text Quoting Style
+
+ Typically, grave accents and apostrophes are treated specially in
+documentation strings and diagnostic messages, and translate to matching
+single quotation marks (also called ``curved quotes''). For example,
+the documentation string @t{"Alias for `foo'."} and the function call
+@code{(message "Alias for `foo'.")} both translate to @t{"Alias for
+‘foo’."}. Less commonly, Emacs displays grave accents and apostrophes
+as themselves, or as apostrophes only (e.g., @t{"Alias for 'foo'."}).
+Documentation strings and message formats should be written so that
+they display well with any of these styles. For example, the
+documentation string @t{"Alias for 'foo'."} is probably not what you
+want, as it can display as @t{"Alias for ’foo’."}, an unusual style in
+English.
+
+ Sometimes you may need to display a grave accent or apostrophe
+without translation, regardless of text quoting style. In a
+documentation string, you can do this with escapes. For example, in
+the documentation string @t{"\\=`(a ,(sin 0)) ==> (a 0.0)"} the grave
+accent is intended to denote Lisp code, so it is escaped and displays
+as itself regardless of quoting style. In a call to @code{message} or
+@code{error}, you can avoid translation by using a format @t{"%s"}
+with an argument that is a call to @code{format}. For example,
+@code{(message "%s" (format "`(a ,(sin %S)) ==> (a %S)" x (sin x)))}
+displays a message that starts with grave accent regardless of text
+quoting style.
+
+@defopt text-quoting-style
+@cindex curved quotes
+@cindex curly quotes
+The value of this user option is a symbol that specifies the style
+Emacs should use for single quotes in the wording of help and
+messages. If the option's value is @code{curve}, the style is
+@t{‘like this’} with curved single quotes. If the value is
+@code{straight}, the style is @t{'like this'} with straight
+apostrophes. If the value is @code{grave}, quotes are not translated
+and the style is @t{`like this'} with grave accent and apostrophe, the
+standard style before Emacs version 25. The default value @code{nil}
+acts like @code{curve} if curved single quotes seem to be displayable,
+and like @code{grave} otherwise.
+
+This option is useful on platforms that have problems with curved
+quotes. You can customize it freely according to your personal
+preference.
+@end defopt
+
@node Describing Characters
@section Describing Characters for Help Messages
@cindex describe characters and events
diff --git a/doc/lispref/hooks.texi b/doc/lispref/hooks.texi
index 0ac5b08c87b..6443464f0ed 100644
--- a/doc/lispref/hooks.texi
+++ b/doc/lispref/hooks.texi
@@ -241,11 +241,6 @@ Redisplay}.
@itemx window-scroll-functions
@itemx window-size-change-functions
@xref{Window Hooks}.
-
-@item window-text-change-functions
-@vindex window-text-change-functions
-Functions to call in redisplay when text in the window might change.
-
@end table
@ignore
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 663d0fd92b9..b0348e74d47 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -248,7 +248,7 @@ of 8k bytes, and small vectors are packed into blocks of 4k bytes).
@cindex storage of vector-like Lisp objects
Beyond the basic vector, a lot of objects like window, buffer, and
frame are managed as if they were vectors. The corresponding C data
-structures include the @code{struct vectorlike_header} field whose
+structures include the @code{union vectorlike_header} field whose
@code{size} member contains the subtype enumerated by @code{enum pvec_type}
and an information about how many @code{Lisp_Object} fields this structure
contains and what the size of the rest data is. This information is
@@ -1085,7 +1085,7 @@ Some of the fields of @code{struct buffer} are:
@table @code
@item header
-A header of type @code{struct vectorlike_header} is common to all
+A header of type @code{union vectorlike_header} is common to all
vectorlike objects.
@item own_text
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 8eab2818f97..0c993806824 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1511,12 +1511,12 @@ respects. A property list behaves like an association list in which
each key can occur only once. @xref{Property Lists}, for a comparison
of property lists and association lists.
-@defun assoc key alist
+@defun assoc key alist &optional testfn
This function returns the first association for @var{key} in
@var{alist}, comparing @var{key} against the alist elements using
-@code{equal} (@pxref{Equality Predicates}). It returns @code{nil} if no
-association in @var{alist} has a @sc{car} @code{equal} to @var{key}.
-For example:
+@var{testfn} if non-nil, or @code{equal} if nil (@pxref{Equality
+Predicates}). It returns @code{nil} if no association in @var{alist}
+has a @sc{car} equal to @var{key}. For example:
@smallexample
(setq trees '((pine . cones) (oak . acorns) (maple . seeds)))
@@ -1561,11 +1561,11 @@ this as reverse @code{assoc}, finding the key for a given value.
@defun assq key alist
This function is like @code{assoc} in that it returns the first
association for @var{key} in @var{alist}, but it makes the comparison
-using @code{eq} instead of @code{equal}. @code{assq} returns @code{nil}
-if no association in @var{alist} has a @sc{car} @code{eq} to @var{key}.
-This function is used more often than @code{assoc}, since @code{eq} is
-faster than @code{equal} and most alists use symbols as keys.
-@xref{Equality Predicates}.
+using @code{eq}. @code{assq} returns @code{nil} if no association in
+@var{alist} has a @sc{car} @code{eq} to @var{key}. This function is
+used more often than @code{assoc}, since @code{eq} is faster than
+@code{equal} and most alists use symbols as keys. @xref{Equality
+Predicates}.
@smallexample
(setq trees '((pine . cones) (oak . acorns) (maple . seeds)))
@@ -1589,16 +1589,20 @@ keys may not be symbols:
@end smallexample
@end defun
-@defun alist-get key alist &optional default remove
-This function is like @code{assq}, but instead of returning the entire
-association for @var{key} in @var{alist},
-@w{@code{(@var{key} . @var{value})}}, it returns just the @var{value}.
-If @var{key} is not found in @var{alist}, it returns @var{default}.
-
-This is a generalized variable (@pxref{Generalized Variables}) that
-can be used to change a value with @code{setf}. When using it to set
-a value, optional argument @var{remove} non-@code{nil} means to remove
-@var{key} from @var{alist} if the new value is @code{eql} to @var{default}.
+@defun alist-get key alist &optional default remove testfn
+This function is similar to @code{assq}. It finds the first
+association @w{@code{(@var{key} . @var{value})}} by comparing
+@var{key} with @var{alist} elements, and, if found, returns the
+@var{value} of that association. If no association is found, the
+function returns @var{default}. Comparison of @var{key} against
+@var{alist} elements uses the function specified by @var{testfn},
+defaulting to @code{eq}.
+
+This is a generalized variable (@pxref{Generalized Variables})
+that can be used to change a value with @code{setf}. When
+using it to set a value, optional argument @var{remove} non-@code{nil}
+means to remove @var{key}'s association from @var{alist} if the new
+value is @code{eql} to @var{default}.
@end defun
@defun rassq value alist
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index d925c8c8f65..e4997d98ae3 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -280,7 +280,7 @@ in a list of directories specified by the variable @code{load-path}.
@defvar load-path
The value of this variable is a list of directories to search when
loading files with @code{load}. Each element is a string (which must be
-a directory name) or @code{nil} (which stands for the current working
+a directory) or @code{nil} (which stands for the current working
directory).
@end defvar
@@ -339,7 +339,7 @@ the above initialization procedure. Emacs initializes
@code{load-path} based on the value of the environment variable.
The syntax of @env{EMACSLOADPATH} is the same as used for @code{PATH};
-directory names are separated by @samp{:} (or @samp{;}, on some
+directories are separated by @samp{:} (or @samp{;}, on some
operating systems).
@ignore
@c AFAICS, does not (yet) work right to specify non-absolute elements.
@@ -468,6 +468,10 @@ runs the real definition as if it had been loaded all along.
Autoloading can also be triggered by looking up the documentation of
the function or macro (@pxref{Documentation Basics}).
+@menu
+* When to Autoload:: When to Use Autoload.
+@end menu
+
There are two ways to set up an autoloaded function: by calling
@code{autoload}, and by writing a ``magic'' comment in the
source before the real definition. @code{autoload} is the low-level
@@ -699,6 +703,42 @@ symbol's new function value. If the value of the optional argument
function, only a macro.
@end defun
+@node When to Autoload
+@subsection When to Use Autoload
+@cindex autoload, when to use
+
+Do not add an autoload comment unless it is really necessary.
+Autoloading code means it is always globally visible. Once an item is
+autoloaded, there is no compatible way to transition back to it not
+being autoloaded (after people become accustomed to being able to use it
+without an explicit load).
+
+@itemize
+@item
+The most common items to autoload are the interactive entry points to a
+library. For example, if @file{python.el} is a library defining a
+major-mode for editing Python code, autoload the definition of the
+@code{python-mode} function, so that people can simply use @kbd{M-x
+python-mode} to load the library.
+
+@item
+Variables usually don't need to be autoloaded. An exception is if the
+variable on its own is generally useful without the whole defining
+library being loaded. (An example of this might be something like
+@code{find-exec-terminator}.)
+
+@item
+Don't autoload a user option just so that a user can set it.
+
+@item
+Never add an autoload @emph{comment} to silence a compiler warning in
+another file. In the file that produces the warning, use
+@code{(defvar foo)} to silence an undefined variable warning, and
+@code{declare-function} (@pxref{Declaring Functions}) to silence an
+undefined function warning; or require the relevant library; or use an
+explicit autoload @emph{statement}.
+@end itemize
+
@node Repeated Loading
@section Repeated Loading
@cindex repeated loading
@@ -1144,3 +1184,8 @@ object.
Loadable modules in Emacs are enabled by using the
@kbd{--with-modules} option at configure time.
+
+If you write your own dynamic modules, you may wish to verify their
+conformance to the Emacs dynamic module API. Invoking Emacs with the
+@kbd{--module-assertions} option will help you in this matter.
+@xref{Initial Options,,,emacs, The GNU Emacs Manual}.
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 81402552678..75dec13ab7c 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -57,17 +57,18 @@ including @code{beginning-of-line}, @code{forward-word},
@code{forward-sentence}, and @code{forward-paragraph}, stop at the
boundary between the prompt and the actual text.
-@c See http://debbugs.gnu.org/11276
+@c See https://debbugs.gnu.org/11276
The minibuffer's window is normally a single line; it grows
-automatically if the contents require more space. Whilst it is
-active, you can explicitly resize it temporarily with the window
-sizing commands; it reverts to its normal size when the minibuffer is
-exited. When the minibuffer is not active, you can resize it
-permanently by using the window sizing commands in the frame's other
-window, or dragging the mode line with the mouse. (Due to details of
-the current implementation, for this to work @code{resize-mini-windows}
-must be @code{nil}.) If the frame contains just a minibuffer, you can
-change the minibuffer's size by changing the frame's size.
+automatically if the contents require more space. Whilst the minibuffer
+is active, you can explicitly resize its window temporarily with the
+window sizing commands; the window reverts to its normal size when the
+minibuffer is exited. When the minibuffer is not active, you can resize
+its window permanently by using the window sizing commands in the
+frame's other window, or dragging the mode line with the mouse. (Due to
+details of the current implementation, for this to work
+@code{resize-mini-windows} must be @code{nil}.) If the frame contains
+just a minibuffer window, you can change its size by changing the
+frame's size.
Use of the minibuffer reads input events, and that alters the values
of variables such as @code{this-command} and @code{last-command}
@@ -1439,7 +1440,7 @@ platform-dependent. Here, we simply document the behavior when using
the minibuffer.
@code{read-file-name} does not automatically expand the returned file
-name. You must call @code{expand-file-name} yourself if an absolute
+name. You can call @code{expand-file-name} yourself if an absolute
file name is required.
The optional argument @var{require-match} has the same meaning as in
@@ -2256,43 +2257,48 @@ contents of the minibuffer before the point.
These functions access and select minibuffer windows, test whether they
are active and control how they get resized.
-@defun active-minibuffer-window
-This function returns the currently active minibuffer window, or
-@code{nil} if there is none.
-@end defun
-
@defun minibuffer-window &optional frame
@anchor{Definition of minibuffer-window}
This function returns the minibuffer window used for frame @var{frame}.
-If @var{frame} is @code{nil}, that stands for the current frame. Note
-that the minibuffer window used by a frame need not be part of that
+If @var{frame} is @code{nil}, that stands for the selected frame.
+
+Note that the minibuffer window used by a frame need not be part of that
frame---a frame that has no minibuffer of its own necessarily uses some
-other frame's minibuffer window.
+other frame's minibuffer window. The minibuffer window of a
+minibuffer-less frame can be changed by setting that frame's
+@code{minibuffer} frame parameter (@pxref{Buffer Parameters}).
@end defun
@defun set-minibuffer-window window
This function specifies @var{window} as the minibuffer window to use.
This affects where the minibuffer is displayed if you put text in it
-without invoking the usual minibuffer commands. It has no effect on
-the usual minibuffer input functions because they all start by
-choosing the minibuffer window according to the current frame.
+without invoking the usual minibuffer commands. It has no effect on the
+usual minibuffer input functions because they all start by choosing the
+minibuffer window according to the selected frame.
@end defun
@c Emacs 19 feature
@defun window-minibuffer-p &optional window
This function returns non-@code{nil} if @var{window} is a minibuffer
-window.
-@var{window} defaults to the selected window.
+window. @var{window} defaults to the selected window.
@end defun
-It is not correct to determine whether a given window is a minibuffer by
-comparing it with the result of @code{(minibuffer-window)}, because
-there can be more than one minibuffer window if there is more than one
-frame.
+The following function returns the window showing the currently active
+minibuffer.
+
+@defun active-minibuffer-window
+This function returns the window of the currently active minibuffer, or
+@code{nil} if there is no active minibuffer.
+@end defun
+
+It is not sufficient to determine whether a given window shows the
+currently active minibuffer by comparing it with the result of
+@code{(minibuffer-window)}, because there can be more than one
+minibuffer window if there is more than one frame.
@defun minibuffer-window-active-p window
-This function returns non-@code{nil} if @var{window} is the currently
-active minibuffer window.
+This function returns non-@code{nil} if @var{window} shows the currently
+active minibuffer.
@end defun
The following two options control whether minibuffer windows are resized
@@ -2374,14 +2380,14 @@ returns zero.
@defopt enable-recursive-minibuffers
If this variable is non-@code{nil}, you can invoke commands (such as
-@code{find-file}) that use minibuffers even while the minibuffer window
-is active. Such invocation produces a recursive editing level for a new
+@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.
-If this variable is @code{nil}, you cannot invoke minibuffer
-commands when the minibuffer window is active, not even if you switch to
-another window to do it.
+If this variable is @code{nil}, you cannot invoke minibuffer commands
+when the minibuffer is active, not even if you switch to another window
+to do it.
@end defopt
@c Emacs 19 feature
@@ -2407,6 +2413,19 @@ This is a normal hook that is run whenever the minibuffer is entered.
@xref{Hooks}.
@end defvar
+@defmac minibuffer-with-setup-hook function &rest body
+This macro executes @var{body} after arranging for the specified
+@var{function} to be called via @code{minibuffer-setup-hook}. By
+default, @var{function} is called before the other functions in the
+@code{minibuffer-setup-hook} list, but if @var{function} is of the
+form @w{@code{(:append @var{func})}}, @var{func} will be called
+@emph{after} the other hook functions.
+
+The @var{body} forms should not use the minibuffer more than once. If
+the minibuffer is re-entered recursively, @var{function} will only be
+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.
@xref{Hooks}.
@@ -2426,9 +2445,9 @@ minibuffer, it scrolls this window.
@end defvar
@defun minibuffer-selected-window
-This function returns the window that was selected when the
-minibuffer was entered. If selected window is not a minibuffer
-window, it returns @code{nil}.
+This function returns the window that was selected just before the
+minibuffer window was selected. If the selected window is not a
+minibuffer window, it returns @code{nil}.
@end defun
@defopt max-mini-window-height
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 0e476b47a31..bd94aeadf15 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1490,10 +1490,11 @@ alist @code{minor-mode-map-alist}. @xref{Definition of minor-mode-map-alist}.
One use of minor mode keymaps is to modify the behavior of certain
self-inserting characters so that they do something else as well as
self-insert. (Another way to customize @code{self-insert-command} is
-through @code{post-self-insert-hook}. Apart from this, the facilities
-for customizing @code{self-insert-command} are limited to special cases,
-designed for abbrevs and Auto Fill mode. Do not try substituting your
-own definition of @code{self-insert-command} for the standard one. The
+through @code{post-self-insert-hook}, see @ref{Commands for
+Insertion}. Apart from this, the facilities for customizing
+@code{self-insert-command} are limited to special cases, designed for
+abbrevs and Auto Fill mode. Do not try substituting your own
+definition of @code{self-insert-command} for the standard one. The
editor command loop handles this function specially.)
Minor modes may bind commands to key sequences consisting of @kbd{C-c}
@@ -1737,7 +1738,9 @@ holds a @dfn{mode line construct}: a template that controls what is
displayed on the buffer's mode line. The value of
@code{header-line-format} specifies the buffer's header line in the same
way. All windows for the same buffer use the same
-@code{mode-line-format} and @code{header-line-format}.
+@code{mode-line-format} and @code{header-line-format} unless a
+@code{mode-line-format} or @code{header-line-format} parameter has been
+specified for that window (@pxref{Window Parameters}).
For efficiency, Emacs does not continuously recompute each window's
mode line and header line. It does so when circumstances appear to call
diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi
index 039201feca1..41d2d84ecd7 100644
--- a/doc/lispref/nonascii.texi
+++ b/doc/lispref/nonascii.texi
@@ -212,7 +212,7 @@ emacs, GNU Emacs Manual}. Unlike @code{find-file-literally}, finding
a file as @samp{raw-text} doesn't disable format conversion,
uncompression, or auto mode selection.
-@c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip.
+@c See https://debbugs.gnu.org/11226 for lack of unibyte tooltip.
@vindex enable-multibyte-characters
The buffer-local variable @code{enable-multibyte-characters} is
non-@code{nil} in multibyte buffers, and @code{nil} in unibyte ones.
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index 3fdc94169bd..be74b0c6111 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1107,6 +1107,24 @@ bit is one in the result if, and only if, the @var{n}th bit is zero in
@end example
@end defun
+@cindex popcount
+@cindex Hamming weight
+@cindex counting set bits
+@defun logcount integer
+This function returns the @dfn{Hamming weight} of @var{integer}: the
+number of ones in the binary representation of @var{integer}.
+If @var{integer} is negative, it returns the number of zero bits in
+its two's complement binary representation. The result is always
+nonnegative.
+
+@example
+(logcount 43) ; 43 = #b101011
+ @result{} 4
+(logcount -43) ; -43 = #b111...1010101
+ @result{} 3
+@end example
+@end defun
+
@node Math Functions
@section Standard Mathematical Functions
@cindex transcendental functions
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 1f4c378df18..97f411a08dc 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -283,11 +283,11 @@ character @kbd{a}.
?Q @result{} 81 ?q @result{} 113
@end example
- You can use the same syntax for punctuation characters, but it is
-often a good idea to add a @samp{\} so that the Emacs commands for
-editing Lisp code don't get confused. For example, @samp{?\(} is the
-way to write the open-paren character. If the character is @samp{\},
-you @emph{must} use a second @samp{\} to quote it: @samp{?\\}.
+ You can use the same syntax for punctuation characters. However, if
+the punctuation character has a special syntactic meaning in Lisp, you
+must quote it with a @samp{\}. For example, @samp{?\(} is the way to
+write the open-paren character. Likewise, if the character is
+@samp{\}, you must use a second @samp{\} to quote it: @samp{?\\}.
@cindex whitespace
@cindex bell character
@@ -336,18 +336,19 @@ escape character; this has nothing to do with the
character @key{ESC}. @samp{\s} is meant for use in character
constants; in string constants, just write the space.
- A backslash is allowed, and harmless, preceding any character without
-a special escape meaning; thus, @samp{?\+} is equivalent to @samp{?+}.
-There is no reason to add a backslash before most characters. However,
-you should add a backslash before any of the characters
-@samp{()\|;'`"#.,} to avoid confusing the Emacs commands for editing
-Lisp code. You can also add a backslash before whitespace characters such as
-space, tab, newline and formfeed. However, it is cleaner to use one of
-the easily readable escape sequences, such as @samp{\t} or @samp{\s},
-instead of an actual whitespace character such as a tab or a space.
-(If you do write backslash followed by a space, you should write
-an extra space after the character constant to separate it from the
-following text.)
+ A backslash is allowed, and harmless, preceding any character
+without a special escape meaning; thus, @samp{?\+} is equivalent to
+@samp{?+}. There is no reason to add a backslash before most
+characters. However, you must add a backslash before any of the
+characters @samp{()[]\;"}, and you should add a backslash before any
+of the characters @samp{|'`#.,} to avoid confusing the Emacs commands
+for editing Lisp code. You can also add a backslash before whitespace
+characters such as space, tab, newline and formfeed. However, it is
+cleaner to use one of the easily readable escape sequences, such as
+@samp{\t} or @samp{\s}, instead of an actual whitespace character such
+as a tab or a space. (If you do write backslash followed by a space,
+you should write an extra space after the character constant to
+separate it from the following text.)
@node General Escape Syntax
@subsubsection General Escape Syntax
@@ -1897,6 +1898,9 @@ with references to further information.
@item bool-vector-p
@xref{Bool-Vectors, bool-vector-p}.
+@item booleanp
+@xref{nil and t, booleanp}.
+
@item bufferp
@xref{Buffer Basics, bufferp}.
@@ -1966,18 +1970,15 @@ with references to further information.
@item mutexp
@xref{Mutexes, mutexp}.
-@item wholenump
-@xref{Predicates on Numbers, wholenump}.
-
@item nlistp
@xref{List-related Predicates, nlistp}.
-@item numberp
-@xref{Predicates on Numbers, numberp}.
-
@item number-or-marker-p
@xref{Predicates on Markers, number-or-marker-p}.
+@item numberp
+@xref{Predicates on Numbers, numberp}.
+
@item overlayp
@xref{Overlays, overlayp}.
@@ -1990,6 +1991,9 @@ with references to further information.
@item sequencep
@xref{Sequence Functions, sequencep}.
+@item string-or-null-p
+@xref{Predicates for Strings, string-or-null-p}.
+
@item stringp
@xref{Predicates for Strings, stringp}.
@@ -2008,6 +2012,9 @@ with references to further information.
@item vectorp
@xref{Vectors, vectorp}.
+@item wholenump
+@xref{Predicates on Numbers, wholenump}.
+
@item window-configuration-p
@xref{Window Configurations, window-configuration-p}.
@@ -2016,21 +2023,6 @@ with references to further information.
@item windowp
@xref{Basic Windows, windowp}.
-
-@item booleanp
-@xref{nil and t, booleanp}.
-
-@item string-or-null-p
-@xref{Predicates for Strings, string-or-null-p}.
-
-@item threadp
-@xref{Basic Thread Functions, threadp}.
-
-@item mutexp
-@xref{Mutexes, mutexp}.
-
-@item condition-variable-p
-@xref{Condition Variables, condition-variable-p}.
@end table
The most general way to check the type of an object is to call the
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index e6ec60f9236..501960bdc3f 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -222,7 +222,7 @@ If it is @code{t}, it selects the @file{*scratch*} buffer.
@c called from two places. If displaying a startup screen, they are
@c called in command-line-1 before the startup screen is shown.
@c inhibit-startup-hooks is then set and window-setup-hook set to nil.
-@c If not displaying a startup screen, they are are called in
+@c If not displaying a startup screen, they are called in
@c normal-top-level.
@c FIXME? So it seems they can be called before or after the
@c daemon/session restore step?
@@ -514,7 +514,7 @@ On MS-DOS, Emacs sets the @env{TERM} environment variable to @samp{internal}.
@end defopt
@defopt term-file-aliases
-This variable is an an association list mapping terminal types to
+This variable is an association list mapping terminal types to
their aliases. For example, an element of the form @code{("vt102"
. "vt100")} means to treat a terminal of type @samp{vt102} like one of
type @samp{vt100}.
@@ -1037,7 +1037,7 @@ value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems.
@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 directory names. @code{nil} in this list means
+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}.
@@ -1486,8 +1486,8 @@ This stands for the full name of the month.
@item %c
This is a synonym for @samp{%x %X}.
@item %C
-This has a locale-specific meaning. In the default locale (named C), it
-is equivalent to @samp{%A, %B %e, %Y}.
+This stands for the century, that is, the year divided by 100,
+truncated toward zero.
@item %d
This stands for the day of month, zero-padded.
@item %D
@@ -1530,8 +1530,11 @@ This stands for the calendar quarter (1--4).
This is a synonym for @samp{%I:%M:%S %p}.
@item %R
This is a synonym for @samp{%H:%M}.
+@item %s
+This stands for the integer number of seconds since the epoch.
@item %S
-This stands for the seconds (00--59).
+This stands for the second (00--59, or 00--60 on platforms
+that support leap seconds).
@item %t
This stands for a tab character.
@item %T
@@ -1561,22 +1564,31 @@ This stands for the year with century.
@item %Z
This stands for the time zone abbreviation (e.g., @samp{EST}).
@item %z
-This stands for the time zone numerical offset (e.g., @samp{-0500}).
+This stands for the time zone numerical offset. The @samp{z} can be
+preceded by one, two, or three colons; if plain @samp{%z} stands for
+@samp{-0500}, then @samp{%:z} stands for @samp{-05:00}, @samp{%::z}
+stands for @samp{-05:00:00}, and @samp{%:::z} is like @samp{%::z}
+except it suppresses trailing instances of @samp{:00} so it stands for
+@samp{-05} in the same example.
+@item %%
+This stands for a single @samp{%}.
@end table
+One or more flag characters can appear immediately after the @samp{%}.
+@samp{0} pads with zeros, @samp{_} pads with blanks, @samp{-}
+suppresses padding, @samp{^} upper-cases letters, and @samp{#}
+reverses the case of letters.
+
You can also specify the field width and type of padding for any of
these @samp{%}-sequences. This works as in @code{printf}: you write
-the field width as digits in the middle of a @samp{%}-sequences. If you
-start the field width with @samp{0}, it means to pad with zeros. If you
-start the field width with @samp{_}, it means to pad with spaces.
-
+the field width as digits in a @samp{%}-sequence, after any flags.
For example, @samp{%S} specifies the number of seconds since the minute;
@samp{%03S} means to pad this with zeros to 3 positions, @samp{%_3S} to
pad with spaces to 3 positions. Plain @samp{%3S} pads with zeros,
because that is how @samp{%S} normally pads to two positions.
-The characters @samp{E} and @samp{O} act as modifiers when used between
-@samp{%} and one of the letters in the table above. @samp{E} specifies
+The characters @samp{E} and @samp{O} act as modifiers when used after
+any flags and field widths in a @samp{%}-sequence. @samp{E} specifies
using the current locale's alternative version of the date and time.
In a Japanese locale, for example, @code{%Ex} might yield a date format
based on the Japanese Emperors' reigns. @samp{E} is allowed in
@@ -1587,6 +1599,11 @@ based on the Japanese Emperors' reigns. @samp{E} is allowed in
representation of numbers, instead of the ordinary decimal digits. This
is allowed with most letters, all the ones that output numbers.
+To help debug programs, unrecognized @samp{%}-sequences stand for
+themselves and are output as-is. Programs should not rely on this
+behavior, as future versions of Emacs may recognize new
+@samp{%}-sequences as extensions.
+
This function uses the C library function @code{strftime}
(@pxref{Formatting Calendar Time,,, libc, The GNU C Library Reference
Manual}) to do most of the work. In order to communicate with that
@@ -1885,8 +1902,8 @@ one of these functions; the arrival of the specified time will not
cause anything special to happen.
@end defun
-@findex timer-list
-The @code{timer-list} command lists all the currently active timers.
+@findex list-timers
+The @code{list-timers} command lists all the currently active timers.
There's only one command available in the buffer displayed: @kbd{c}
(@code{timer-list-cancel}) that will cancel the timer on the line
under point.
diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi
index af05d1ef58c..153ee48741c 100644
--- a/doc/lispref/package.texi
+++ b/doc/lispref/package.texi
@@ -275,7 +275,7 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example:
Via the Package Menu, users may download packages from @dfn{package
archives}. Such archives are specified by the variable
@code{package-archives}, whose default value contains a single entry:
-the archive hosted by the GNU project at @url{http://elpa.gnu.org}. This
+the archive hosted by the GNU project at @url{https://elpa.gnu.org}. This
section describes how to set up and maintain a package archive.
@cindex base location, package archive
diff --git a/doc/lispref/positions.texi b/doc/lispref/positions.texi
index 7c30fe977ca..9fd4bd8fe8e 100644
--- a/doc/lispref/positions.texi
+++ b/doc/lispref/positions.texi
@@ -432,11 +432,16 @@ prints a message reporting the number of lines, words, and characters
in the buffer, or in the region if the region is active.
@end deffn
-@defun line-number-at-pos &optional pos
+@defun line-number-at-pos &optional pos absolute
@cindex line number
This function returns the line number in the current buffer
-corresponding to the buffer position @var{pos}. If @var{pos} is @code{nil}
-or omitted, the current buffer position is used.
+corresponding to the buffer position @var{pos}. If @var{pos} is
+@code{nil} or omitted, the current buffer position is used. If
+@var{absolute} is @code{nil}, the default, counting starts at
+@code{(point-min)}, so the value refers to the contents of the
+accessible portion of the (potentially narrowed) buffer. If
+@var{absolute} is non-@code{nil}, ignore any narrowing and return
+the absolute line number.
@end defun
@ignore
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 292d55d50c5..a1e8730f716 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -1351,6 +1351,22 @@ integer); that allows you to send signals to processes that are not
children of Emacs. @xref{System Processes}.
@end deffn
+Sometimes, it is necessary to send a signal to a non-local
+asynchronous process. This is possible by writing an own
+@code{interrupt-process} implementation. This function must be added
+then to @code{interrupt-process-functions}.
+
+@defvar interrupt-process-functions
+This variable is a list of functions to be called for
+@code{interrupt-process}. The arguments of the functions are the same
+as for @code{interrupt-process}. These functions are called in the
+order of the list, until one of them returns non-@code{nil}. The
+default function, which shall always be the last in this list, is
+@code{internal-default-interrupt-process}.
+
+This is the mechanism, how Tramp implements @code{interrupt-process}.
+@end defvar
+
@node Output from Processes
@section Receiving Output from Processes
@cindex process output
@@ -2315,7 +2331,7 @@ server is stopped; a non-@code{nil} value means yes.
Emacs can create encrypted network connections, using either built-in
or external support. The built-in support uses the GnuTLS
Transport Layer Security Library; see
-@uref{http://www.gnu.org/software/gnutls/, the GnuTLS project page}.
+@uref{https://www.gnu.org/software/gnutls/, the GnuTLS project page}.
If your Emacs was compiled with GnuTLS support, the function
@code{gnutls-available-p} is defined and returns non-@code{nil}. For
more details, @pxref{Top,, Overview, emacs-gnutls, The Emacs-GnuTLS manual}.
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 67d4c224647..755fa554bb6 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -327,7 +327,7 @@ expression. Thus, @samp{fo*} has a repeating @samp{o}, not a repeating
The matcher processes a @samp{*} construct by matching, immediately, as
many repetitions as can be found. Then it continues with the rest of
the pattern. If that fails, backtracking occurs, discarding some of the
-matches of the @samp{*}-modified construct in the hope that that will
+matches of the @samp{*}-modified construct in the hope that this will
make it possible to match the rest of the pattern. For example, in
matching @samp{ca*ar} against the string @samp{caaar}, the @samp{a*}
first tries to match all three @samp{a}s; but the rest of the pattern is
@@ -950,7 +950,7 @@ for Font Lock mode@footnote{Note that @code{regexp-opt} does not
guarantee that its result is absolutely the most efficient form
possible. A hand-tuned regular expression can sometimes be slightly
more efficient, but is almost never worth the effort.}.
-@c E.g., see http://debbugs.gnu.org/2816
+@c E.g., see https://debbugs.gnu.org/2816
The optional argument @var{paren} can be any of the following:
@@ -1220,7 +1220,7 @@ previous character cannot be part of a match for @var{regexp}. When
the match is extended, its starting position is allowed to occur
before @var{limit}.
-@c http://debbugs.gnu.org/5689
+@c https://debbugs.gnu.org/5689
As a general recommendation, try to avoid using @code{looking-back}
wherever possible, since it is slow. For this reason, there are no
plans to add a @code{looking-back-p} function.
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index c7cf9f5e1af..4fba880803e 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -155,7 +155,10 @@ This function generalizes @code{aref} (@pxref{Array Functions}) and
@cindex copying sequences
This function returns a copy of @var{seqr}, which should be either a
sequence or a record. The copy is the same type of object as the
-original, and it has the same elements in the same order.
+original, and it has the same elements in the same order. However, if
+@var{seqr} is empty, like a string or a vector of zero length, the
+value returned by this function might not be a copy, but an empty
+object of the same type and identical to @var{seqr}.
Storing a new element into the copy does not affect the original
@var{seqr}, and vice versa. However, the elements of the copy
@@ -850,7 +853,7 @@ it is a function of two arguments to use instead of the default @code{equal}.
@end group
@group
(seq-uniq '(1 2 2.0 1.0) #'=)
-@result{} [3 4]
+@result{} [1 2]
@end group
@end example
@end defun
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 23961f99efd..31734c5ecf6 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -121,7 +121,7 @@ character (i.e., an integer), @code{nil} otherwise.
The following functions create strings, either from scratch, or by
putting strings together, or by taking them apart.
-@defun make-string count character
+@defun make-string count character &optional multibyte
This function returns a string made up of @var{count} repetitions of
@var{character}. If @var{count} is negative, an error is signaled.
@@ -132,6 +132,13 @@ This function returns a string made up of @var{count} repetitions of
@result{} ""
@end example
+ Normally, if @var{character} is an @acronym{ASCII} character, the
+result is a unibyte string. But if the optional argument
+@var{multibyte} is non-@code{nil}, the function will produce a
+multibyte string instead. This is useful when you later need to
+concatenate the result with non-@acronym{ASCII} strings or replace
+some of its characters with non-@acronym{ASCII} characters.
+
Other functions to compare with this one include @code{make-vector}
(@pxref{Vectors}) and @code{make-list} (@pxref{Building Lists}).
@end defun
@@ -812,30 +819,32 @@ formatting feature described here; they differ from @code{format-message} only
in how they use the result of formatting.
@defun format string &rest objects
-This function returns a new string that is made by copying
-@var{string} and then replacing any format specification
-in the copy with encodings of the corresponding @var{objects}. The
+This function returns a string equal to @var{string}, replacing any format
+specifications with encodings of the corresponding @var{objects}. The
arguments @var{objects} are the computed values to be formatted.
The characters in @var{string}, other than the format specifications,
are copied directly into the output, including their text properties,
if any. Any text properties of the format specifications are copied
to the produced string representations of the argument @var{objects}.
+
+The output string need not be newly-allocated. For example, if
+@code{x} is the string @code{"foo"}, the expressions @code{(eq x
+(format x))} and @code{(eq x (format "%s" x))} might both yield
+@code{t}.
@end defun
@defun format-message string &rest objects
-@cindex curved quotes
-@cindex curly quotes
+@cindex curved quotes, in formatted messages
+@cindex curly quotes, in formatted messages
This function acts like @code{format}, except it also converts any
grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per the
value of @code{text-quoting-style}.
-A format that quotes with grave accents and apostrophes @t{`like
-this'} typically generates curved quotes @t{‘like this’}. In
-contrast, a format that quotes with only apostrophes @t{'like this'}
-typically generates two closing curved quotes @t{’like this’}, an
-unusual style in English. @xref{Keys in Documentation}, for how the
-@code{text-quoting-style} variable affects generated quotes.
+Typically grave accent and apostrophe in the format translate to
+matching curved quotes, e.g., @t{"Missing `%s'"} might result in
+@t{"Missing ‘foo’"}. @xref{Text Quoting Style}, for how to influence
+or inhibit this translation.
@end defun
@cindex @samp{%} in format
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index e6ea8a1cc09..cda5f1c40f6 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -273,6 +273,12 @@ distinct uninterned symbol whose name is also @samp{foo}.
@end example
@end defun
+@defun gensym &optional prefix
+This function returns a symbol using @code{make-symbol}, whose name is
+made by appending @code{gensym-counter} to @var{prefix}. The prefix
+defaults to @code{"g"}.
+@end defun
+
@defun intern name &optional obarray
This function returns the interned symbol whose name is @var{name}. If
there is no such symbol in the obarray @var{obarray}, @code{intern}
diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi
index e3ae53536f9..b37f2b22b82 100644
--- a/doc/lispref/syntax.texi
+++ b/doc/lispref/syntax.texi
@@ -751,7 +751,8 @@ position. This function does that conveniently.
@defun syntax-ppss &optional pos
This function returns the parser state that the parser would reach at
-position @var{pos} starting from the beginning of the buffer.
+position @var{pos} starting from the beginning of the visible portion
+of the buffer.
@iftex
See the next section for
@end iftex
@@ -762,11 +763,11 @@ for a description of the parser state.
The return value is the same as if you call the low-level parsing
function @code{parse-partial-sexp} to parse from the beginning of the
-buffer to @var{pos} (@pxref{Low-Level Parsing}). However,
-@code{syntax-ppss} uses a cache to speed up the computation. Due to
-this optimization, the second value (previous complete subexpression)
-and sixth value (minimum parenthesis depth) in the returned parser
-state are not meaningful.
+visible portion of the buffer to @var{pos} (@pxref{Low-Level
+Parsing}). However, @code{syntax-ppss} uses caches to speed up the
+computation. Due to this optimization, the second value (previous
+complete subexpression) and sixth value (minimum parenthesis depth) in
+the returned parser state are not meaningful.
This function has a side effect: it adds a buffer-local entry to
@code{before-change-functions} (@pxref{Change Hooks}) for
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 9696c73c484..35ba5d0dddc 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -54,9 +54,12 @@ the character after point.
* Registers:: How registers are implemented. Accessing the text or
position stored in a register.
* Transposition:: Swapping two portions of a buffer.
+* Replacing:: Replacing the text of one buffer with the text
+ of another buffer.
* Decompression:: Dealing with compressed data.
* Base 64:: Conversion to or from base 64 encoding.
* Checksum/Hash:: Computing cryptographic hashes.
+* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS.
* Parsing HTML/XML:: Parsing HTML and XML.
* Atomic Changes:: Installing several buffer changes atomically.
* Change Hooks:: Supplying functions to be run when text is changed.
@@ -522,9 +525,17 @@ responsible for calling @code{blink-paren-function} when the inserted
character has close parenthesis syntax (@pxref{Blinking}).
@vindex post-self-insert-hook
+@vindex self-insert-uses-region-functions
The final thing this command does is to run the hook
@code{post-self-insert-hook}. You could use this to automatically
-reindent text as it is typed, for example.
+reindent text as it is typed, for example. If any function on this
+hook needs to act on the region (@pxref{The Region}), it should make
+sure Delete Selection mode (@pxref{Using Region, Delete Selection, ,
+emacs, The GNU Emacs Manual}) doesn't delete the region before
+@code{post-self-insert-hook} functions are invoked. The way to do so
+is to add a function that returns @code{nil} to
+@code{self-insert-uses-region-functions}, a special hook that tells
+Delete Selection mode it should not delete the region.
Do not try substituting your own definition of
@code{self-insert-command} for the standard one. The editor command
@@ -1883,10 +1894,10 @@ prefix or @code{nil}, meaning it has failed to determine a prefix.
@cindex filling, automatic
@cindex Auto Fill mode
-@c FIXME: I don't think any of the variables below is a/an normal/abnormal hook.
- Auto Fill mode is a minor mode that fills lines automatically as text
-is inserted. This section describes the hook used by Auto Fill mode.
-For a description of functions that you can call explicitly to fill and
+Auto Fill mode is a minor mode that fills lines automatically as text is
+inserted. @xref{Auto Fill,,, emacs, The GNU Emacs Manual}. This
+section describes some variables used by Auto Fill mode. For a
+description of functions that you can call explicitly to fill and
justify existing text, see @ref{Filling}.
Auto Fill mode also enables the functions that change the margins and
@@ -1895,11 +1906,11 @@ justification style to refill portions of the text. @xref{Margins}.
@defvar auto-fill-function
The value of this buffer-local variable should be a function (of no
arguments) to be called after self-inserting a character from the table
-@code{auto-fill-chars}. It may be @code{nil}, in which case nothing
-special is done in that case.
+@code{auto-fill-chars}, see below. It may be @code{nil}, in which case
+nothing special is done in that case.
-The value of @code{auto-fill-function} is @code{do-auto-fill} when
-Auto-Fill mode is enabled. That is a function whose sole purpose is to
+The value of @code{auto-fill-function} is @code{do-auto-fill} when Auto
+Fill mode is enabled. That is a function whose sole purpose is to
implement the usual strategy for breaking a line.
@end defvar
@@ -1916,6 +1927,14 @@ self-inserted---space and newline in most language environments. They
have an entry @code{t} in the table.
@end defvar
+@defopt comment-auto-fill-only-comments
+This variable, if non-@code{nil}, means to fill lines automatically
+within comments only. More precisely, this means that if a comment
+syntax was defined for the current buffer, then self-inserting a
+character outside of a comment will not call @code{auto-fill-function}.
+@end defopt
+
+
@node Sorting
@section Sorting Text
@cindex sorting text
@@ -4235,6 +4254,7 @@ A marker represents a buffer position to jump to.
A string is text saved in the register.
@item a rectangle
+@cindex rectangle, as contents of a register
A rectangle is represented by a list of strings.
@item @code{(@var{window-configuration} @var{position})}
@@ -4326,6 +4346,28 @@ is non-@code{nil}, @code{transpose-regions} does not do this---it leaves
all markers unrelocated.
@end defun
+@node Replacing
+@section Replacing Buffer Text
+
+ You can use the following function to replace the text of one buffer
+with the text of another buffer:
+
+@deffn Command replace-buffer-contents source
+This function replaces the accessible portion of the current buffer
+with the accessible portion of the buffer @var{source}. @var{source}
+may either be a buffer object or the name of a buffer. When
+@code{replace-buffer-contents} succeeds, the text of the accessible
+portion of the current buffer will be equal to the text of the
+accessible portion of the @var{source} buffer. This function attempts
+to keep point, markers, text properties, and overlays in the current
+buffer intact. One potential case where this behavior is useful is
+external code formatting programs: they typically write the
+reformatted text into a temporary buffer or file, and using
+@code{delete-region} and @code{insert-buffer-substring} would destroy
+these properties. However, the latter combination is typically
+faster. @xref{Deletion}, and @ref{Insertion}.
+@end deffn
+
@node Decompression
@section Dealing With Compressed Data
@@ -4436,6 +4478,11 @@ similar theoretical weakness also exists in SHA-1. Therefore, for
security-related applications you should use the other hash types,
such as SHA-2.
+@defun secure-hash-algorithms
+This function returns a list of symbols representing algorithms that
+@code{secure-hash} can use.
+@end defun
+
@defun secure-hash algorithm object &optional start end binary
This function returns a hash for @var{object}. The argument
@var{algorithm} is a symbol stating which hash to compute: one of
@@ -4494,12 +4541,213 @@ It should be somewhat more efficient on larger buffers than
@c according to what we find useful.
@end defun
+@node GnuTLS Cryptography
+@section GnuTLS Cryptography
+@cindex MD5 checksum
+@cindex SHA hash
+@cindex hash, cryptographic
+@cindex cryptographic hash
+@cindex AEAD cipher
+@cindex cipher, AEAD
+@cindex symmetric cipher
+@cindex cipher, symmetric
+
+ If compiled with GnuTLS, Emacs offers built-in cryptographic
+support. Following the GnuTLS API terminology, the available tools
+are digests, MACs, symmetric ciphers, and AEAD ciphers.
+
+The terms used herein, such as IV (Initialization Vector), require
+some familiarity with cryptography and will not be defined in detail.
+Please consult @uref{https://www.gnutls.org/} for specific
+documentation which may help you understand the terminology and
+structure of the GnuTLS library.
+
+@menu
+* Format of GnuTLS Cryptography Inputs::
+* GnuTLS Cryptographic Functions::
+@end menu
+
+@node Format of GnuTLS Cryptography Inputs
+@subsection Format of GnuTLS Cryptography Inputs
+@cindex format of gnutls cryptography inputs
+@cindex gnutls cryptography inputs format
+
+ The inputs to GnuTLS cryptographic functions can be specified in
+several ways, both as primitive Emacs Lisp types or as lists.
+
+The list form is currently similar to how @code{md5} and
+@code{secure-hash} operate.
+
+@table @code
+@item @var{buffer}
+Simply passing a buffer as input means the whole buffer should be used.
+
+@item @var{string}
+A string as input will be used directly. It may be modified by the
+function (unlike most other Emacs Lisp functions) to reduce the chance
+of exposing sensitive data after the function does its work.
+
+@item (@var{buffer-or-string} @var{start} @var{end} @var{coding-system} @var{noerror})
+This specifies a buffer or a string as described above, but an
+optional range can be specified with @var{start} and @var{end}.
+
+In addition an optional @var{coding-system} can be specified if needed.
+
+The last optional item, @var{noerror}, overrides the normal error when
+the text can't be encoded using the specified or chosen coding system.
+When @var{noerror} is non-@code{nil}, this function silently uses
+@code{raw-text} coding instead.
+
+@item (@code{iv-auto} @var{length})
+This will generate an IV (Initialization Vector) of the specified
+length using the GnuTLS @code{GNUTLS_RND_NONCE} generator and pass it
+to the function. This ensures that the IV is unpredictable and
+unlikely to be reused in the same session. The actual value of the IV
+is returned by the function as described below.
+
+@end table
+
+@node GnuTLS Cryptographic Functions
+@subsection GnuTLS Cryptographic Functions
+@cindex gnutls cryptographic functions
+
+@defun gnutls-digests
+This function returns the alist of the GnuTLS digest algorithms.
+
+Each entry has a key which represents the algorithm, followed by a
+plist with internal details about the algorithm. The plist will have
+@code{:type gnutls-digest-algorithm} and also will have the key
+@code{:digest-algorithm-length 64} to indicate the size, in bytes, of
+the resulting digest.
+
+There is a name parallel between GnuTLS MAC and digest algorithms but
+they are separate things internally and should not be mixed.
+@end defun
+
+@defun gnutls-hash-digest digest-method input
+The @var{digest-method} can be the whole plist from
+@code{gnutls-digests}, or just the symbol key, or a string with the
+name of that symbol.
+
+The @var{input} can be specified as a buffer or string or in other
+ways (@pxref{Format of GnuTLS Cryptography Inputs}).
+
+This function returns @code{nil} on error, and signals a Lisp error if
+the @var{digest-method} or @var{input} are invalid. On success, it
+returns a list of a binary string (the output) and the IV used.
+@end defun
+
+@defun gnutls-macs
+This function returns the alist of the GnuTLS MAC algorithms.
+
+Each entry has a key which represents the algorithm, followed by a
+plist with internal details about the algorithm. The plist will have
+@code{:type gnutls-mac-algorithm} and also will have the keys
+@code{:mac-algorithm-length} @code{:mac-algorithm-keysize}
+@code{:mac-algorithm-noncesize} to indicate the size, in bytes, of the
+resulting hash, the key, and the nonce respectively.
+
+The nonce is currently unused and only some MACs support it.
+
+There is a name parallel between GnuTLS MAC and digest algorithms but
+they are separate things internally and should not be mixed.
+@end defun
+
+@defun gnutls-hash-mac hash-method key input
+The @var{hash-method} can be the whole plist from
+@code{gnutls-macs}, or just the symbol key, or a string with the
+name of that symbol.
+
+The @var{key} can be specified as a buffer or string or in other ways
+(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be
+wiped after use if it's a string.
+
+The @var{input} can be specified as a buffer or string or in other
+ways (@pxref{Format of GnuTLS Cryptography Inputs}).
+
+This function returns @code{nil} on error, and signals a Lisp error if
+the @var{hash-method} or @var{key} or @var{input} are invalid.
+
+On success, it returns a list of a binary string (the output) and the
+IV used.
+@end defun
+
+@defun gnutls-ciphers
+This function returns the alist of the GnuTLS ciphers.
+
+Each entry has a key which represents the cipher, followed by a plist
+with internal details about the algorithm. The plist will have
+@code{:type gnutls-symmetric-cipher} and also will have the keys
+@code{:cipher-aead-capable} set to @code{nil} or @code{t} to indicate
+AEAD capability; and @code{:cipher-tagsize} @code{:cipher-blocksize}
+@code{:cipher-keysize} @code{:cipher-ivsize} to indicate the size, in
+bytes, of the tag, block size of the resulting data, the key, and the
+IV respectively.
+@end defun
+
+@defun gnutls-symmetric-encrypt cipher key iv input &optional aead_auth
+The @var{cipher} can be the whole plist from
+@code{gnutls-ciphers}, or just the symbol key, or a string with the
+name of that symbol.
+
+The @var{key} can be specified as a buffer or string or in other ways
+(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be
+wiped after use if it's a string.
+
+The @var{iv} and @var{input} and the optional @var{aead_auth} can be
+specified as a buffer or string or in other ways (@pxref{Format of
+GnuTLS Cryptography Inputs}).
+
+@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose
+plist has @code{:cipher-aead-capable t}. Otherwise it's ignored.
+
+This function returns @code{nil} on error, and signals a Lisp error if
+the @var{cipher} or @var{key}, @var{iv}, or @var{input} are invalid,
+or if @var{aead_auth} was specified with an AEAD cipher and was
+invalid.
+
+On success, it returns a list of a binary string (the output) and the
+IV used.
+@end defun
+
+@defun gnutls-symmetric-decrypt cipher key iv input &optional aead_auth
+The @var{cipher} can be the whole plist from
+@code{gnutls-ciphers}, or just the symbol key, or a string with the
+name of that symbol.
+
+The @var{key} can be specified as a buffer or string or in other ways
+(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be
+wiped after use if it's a string.
+
+The @var{iv} and @var{input} and the optional @var{aead_auth} can be
+specified as a buffer or string or in other ways (@pxref{Format of
+GnuTLS Cryptography Inputs}).
+
+@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose
+plist has @code{:cipher-aead-capable t}. Otherwise it's ignored.
+
+This function returns @code{nil} on decryption error, and signals a
+Lisp error if the @var{cipher} or @var{key}, @var{iv}, or @var{input}
+are invalid, or if @var{aead_auth} was specified with an AEAD cipher
+and was invalid.
+
+On success, it returns a list of a binary string (the output) and the
+IV used.
+@end defun
+
@node Parsing HTML/XML
@section Parsing HTML and XML
@cindex parsing html
-When Emacs is compiled with libxml2 support, the following functions
-are available to parse HTML or XML text into Lisp object trees.
+ Emacs can be compiled with built-in libxml2 support.
+
+@defun libxml-available-p
+This function returns non-@code{nil} if built-in libxml2 support is
+available in this Emacs session.
+@end defun
+
+When libxml2 support is available, the following functions can be used
+to parse HTML or XML text into Lisp object trees.
@defun libxml-parse-html-region start end &optional base-url discard-comments
This function parses the text between @var{start} and @var{end} as
@@ -4566,9 +4814,9 @@ about syntax).
@cindex DOM
@cindex Document Object Model
-The @acronym{DOM} returned by @code{libxml-parse-html-region} (and the
-other @acronym{XML} parsing functions) is a tree structure where each
-node has a node name (called a @dfn{tag}), and optional key/value
+ The @acronym{DOM} returned by @code{libxml-parse-html-region} (and
+the other @acronym{XML} parsing functions) is a tree structure where
+each node has a node name (called a @dfn{tag}), and optional key/value
@dfn{attribute} list, and then a list of @dfn{child nodes}. The child
nodes are either strings or @acronym{DOM} objects.
@@ -4602,7 +4850,7 @@ would be:
@lisp
(dom-attr img 'href)
-=> "http://fsf.org/logo.png"
+=> "https://fsf.org/logo.png"
@end lisp
@item dom-children @var{node}
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 35abd8e79db..42a68677f58 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -68,10 +68,13 @@ costs.}. Use two hyphens to separate prefix and name if the symbol is
not meant to be used by other packages.
Occasionally, for a command name intended for users to use, it is more
-convenient if some words come before the package's name prefix. And
-constructs that define functions, variables, etc., work better if they
-start with @samp{defun} or @samp{defvar}, so put the name prefix later
-on in the name.
+convenient if some words come before the package's name prefix. For
+example, it is our convention to have commands that list objects named
+as @samp{list-@var{something}}, e.g., a package called @samp{frob}
+could have a command @samp{list-frobs}, when its other global symbols
+begin with @samp{frob-}. Also, constructs that define functions,
+variables, etc., work better if they start with @samp{defun} or
+@samp{defvar}, so put the name prefix later on in the name.
This recommendation applies even to names for traditional Lisp
primitives that are not primitives in Emacs Lisp---such as
@@ -531,9 +534,17 @@ that you know @emph{will} be defined, use a @code{declare-function}
statement (@pxref{Declaring Functions}).
@item
-If you use many functions and variables from a certain file, you can
-add a @code{require} for that package to avoid compilation warnings
-for them. For instance,
+If you use many functions, macros, and variables from a certain file,
+you can add a @code{require} (@pxref{Named Features, require}) for
+that package to avoid compilation warnings for them, like this:
+
+@example
+(require 'foo)
+@end example
+
+@noindent
+If you need only macros from some file, you can require it only at
+compile time (@pxref{Eval During Compile}). For instance,
@example
(eval-when-compile
@@ -741,7 +752,7 @@ preceded by @samp{URL}. For example,
@smallexample
The home page for the GNU project has more information (see URL
-`http://www.gnu.org/').
+`https://www.gnu.org/').
@end smallexample
@item
@@ -944,7 +955,7 @@ explains these conventions, starting with an example:
;; This file is free software@dots{}
@dots{}
-;; along with this file. If not, see <http://www.gnu.org/licenses/>.
+;; along with this file. If not, see <https://www.gnu.org/licenses/>.
@end group
@end smallexample
@@ -966,7 +977,7 @@ might need to list them instead. Do not say that the copyright holder
is the Free Software Foundation (or that the file is part of GNU
Emacs) unless your file has been accepted into the Emacs distribution.
For more information on the form of copyright and license notices, see
-@uref{http://www.gnu.org/licenses/gpl-howto.html, the guide on the GNU
+@uref{https://www.gnu.org/licenses/gpl-howto.html, the guide on the GNU
website}.
After the copyright notice come several @dfn{header comment} lines,
diff --git a/doc/lispref/two-volume-cross-refs.txt b/doc/lispref/two-volume-cross-refs.txt
index 78133e945f9..6b129668ea3 100644
--- a/doc/lispref/two-volume-cross-refs.txt
+++ b/doc/lispref/two-volume-cross-refs.txt
@@ -316,4 +316,4 @@ 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 file. If not, see <http://www.gnu.org/licenses/>.
+along with this file. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make
index a797750c0f0..15f96497259 100644
--- a/doc/lispref/two-volume.make
+++ b/doc/lispref/two-volume.make
@@ -232,4 +232,4 @@ elisp2-init: elisp.texi
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this file. If not, see <http://www.gnu.org/licenses/>.
+# along with this file. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 2818ea067d2..5bee0f9d82a 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -139,6 +139,13 @@ Variables}). A @code{defconst} form serves to inform human readers
that you do not intend to change the value of a variable, but Emacs
does not raise an error if you actually change it.
+@cindex read-only variables
+A small number of additional symbols are made read-only for various
+practical reasons. These include @code{enable-multibyte-characters},
+@code{most-positive-fixnum}, @code{most-negative-fixnum}, and a few
+others. Any attempt to set or bind these also signals a
+@code{setting-constant} error.
+
@node Local Variables
@section Local Variables
@cindex binding local variables
@@ -435,7 +442,9 @@ dynamically bound value; @pxref{Void Variables}), then @var{value} is
evaluated and @var{symbol} is set to the result. But if @var{symbol}
is not void, @var{value} is not evaluated, and @var{symbol}'s value is
left unchanged. If @var{value} is omitted, the value of @var{symbol}
-is not changed in any case.
+is not changed in any case. Using @code{defvar} with no value is one
+method of suppressing byte compilation warnings, see @ref{Compiler
+Errors}.
If @var{symbol} has a buffer-local binding in the current buffer,
@code{defvar} acts on the default value, which is buffer-independent,
@@ -574,6 +583,16 @@ The value is a whole shell command.
@item @dots{}-switches
The value specifies options for a command.
+
+@item @var{prefix}--@dots{}
+The variable is intended for internal use and is defined in the file
+@file{@var{prefix}.el}. (Emacs code contributed before 2018 may
+follow other conventions, which are being phased out.)
+
+@item @dots{}-internal
+The variable is intended for internal use and is defined in C code.
+(Emacs code contributed before 2018 may follow other conventions,
+which are being phased out.)
@end table
When you define a variable, always consider whether you should mark
@@ -1007,11 +1026,11 @@ variables like @code{case-fold-search}:
@subsection Lexical Binding
Lexical binding was introduced to Emacs, as an optional feature, in
-version 24.1. We expect its importance to increase in the future.
+version 24.1. We expect its importance to increase with time.
Lexical binding opens up many more opportunities for optimization, so
programs using it are likely to run faster in future Emacs versions.
-Lexical binding is also more compatible with concurrency, which we
-want to add to Emacs in the future.
+Lexical binding is also more compatible with concurrency, which was
+added to Emacs in version 26.1.
A lexically-bound variable has @dfn{lexical scope}, meaning that any
reference to the variable must be located textually within the binding
@@ -1176,7 +1195,7 @@ variable. The byte-compiler will also issue a warning if you use a
special variable as a function argument.
(To silence byte-compiler warnings about unused variables, just use
-a variable name that start with an underscore. The byte-compiler
+a variable name that starts with an underscore. The byte-compiler
interprets this as an indication that this is a variable known not to
be used.)
@@ -1343,6 +1362,9 @@ is not current either on entry to or exit from the @code{let}. This is
because @code{let} does not distinguish between different kinds of
bindings; it knows only which variable the binding was made for.
+It is an error to make a constant or a read-only variable
+buffer-local. @xref{Constant Variables}.
+
If the variable is terminal-local (@pxref{Multiple Terminals}), this
function signals an error. Such variables cannot have buffer-local
bindings as well.
@@ -1382,6 +1404,9 @@ in a void buffer-local value and leave the default value unaffected.
The value returned is @var{variable}.
+It is an error to make a constant or a read-only variable
+buffer-local. @xref{Constant Variables}.
+
@strong{Warning:} Don't assume that you should use
@code{make-variable-buffer-local} for user-option variables, simply
because users @emph{might} want to customize them differently in
@@ -1894,7 +1919,12 @@ settings to any file in that directory or any of its subdirectories
(optionally, you can exclude subdirectories; see below).
If some of the subdirectories have their own @file{.dir-locals.el}
files, Emacs uses the settings from the deepest file it finds starting
-from the file's directory and moving up the directory tree. The file
+from the file's directory and moving up the directory tree. This
+constant is also used to derive the name of a second dir-locals file
+@file{.dir-locals-2.el}. If this second dir-locals file is present,
+then that is loaded instead of @file{.dir-locals.el}. This is useful
+when @file{.dir-locals.el} is under version control in a shared
+repository and cannot be used for personal customizations. The file
specifies local variables as a specially formatted list; see
@ref{Directory Variables, , Per-directory Local Variables, emacs, The
GNU Emacs Manual}, for more details.
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index d9b4b743a3b..e1eac457179 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -752,6 +752,7 @@ The optional argument @var{pixelwise} non-@code{nil} means to return the
minimum size of @var{window} counted in pixels.
@end defun
+
@node Resizing Windows
@section Resizing Windows
@cindex window resizing
@@ -943,7 +944,8 @@ help of the two options listed next.
@defopt fit-frame-to-buffer-margins
This option can be used to specify margins around frames to be fit by
@code{fit-frame-to-buffer}. Such margins can be useful to avoid, for
-example, that such frames overlap the taskbar.
+example, that the resized frame overlaps the taskbar or parts of its
+parent frame.
It specifies the numbers of pixels to be left free on the left, above,
the right, and below a frame that shall be fit. The default specifies
@@ -1083,7 +1085,7 @@ by that function is preserved.
@end table
@code{window-preserve-size} installs a window parameter (@pxref{Window
-Parameters}) called @code{preserved-size} which is consulted by the
+Parameters}) called @code{window-preserved-size} which is consulted by the
window resizing functions. This parameter will not prevent resizing the
window when the window shows another buffer than the one when
@code{window-preserve-size} was invoked or if its size has changed since
@@ -1317,8 +1319,8 @@ argument @var{window}, in lieu of the usual action of
@code{delete-other-windows}. @xref{Window Parameters}.
Also, if @code{ignore-window-parameters} is @code{nil}, this function
-does not delete any window whose @code{no-delete-other-window} parameter
-is non-@code{nil}.
+does not delete any window whose @code{no-delete-other-windows}
+parameter is non-@code{nil}.
@end deffn
@deffn Command delete-windows-on &optional buffer-or-name frame
@@ -2484,6 +2486,25 @@ the function specified in @code{pop-up-frame-function}
is added to the newly created frame's parameters.
@end defun
+@defun display-buffer-in-child-frame buffer alist
+This function tries to display @var{buffer} in a child frame
+(@pxref{Child Frames}) of the selected frame, either reusing an existing
+child frame or by making a new one. If @var{alist} has a non-@code{nil}
+@code{child-frame-parameters} entry, the corresponding value is an alist
+of frame parameters to give the new frame. A @code{parent-frame}
+parameter specifying the selected frame is provided by default. If the
+child frame should be or become the child of another frame, a
+corresponding entry must be added to @var{alist}.
+
+The appearance of child frames is largely dependent on the parameters
+provided via @var{alist}. It is advisable to use at least ratios to
+specify the size (@pxref{Size Parameters}) and the position
+(@pxref{Position Parameters}) of the child frame and to add the
+@code{keep-ratio} in order to make sure that the child frame remains
+visible. For other parameters that should be considered see @ref{Child
+Frames}.
+@end defun
+
@defun display-buffer-use-some-frame buffer alist
This function tries to display @var{buffer} by trying to find a
frame that meets a predicate (by default any frame other than the
@@ -3124,12 +3145,17 @@ killed.
The default is to call @code{iconify-frame} (@pxref{Visibility of
Frames}). Alternatively, you may specify either @code{delete-frame}
(@pxref{Deleting Frames}) to remove the frame from its display,
-@code{ignore} to leave the frame unchanged, or any other function that
-can take a frame as its sole argument.
+@code{make-frame-invisible} to make the frame invisible, @code{ignore}
+to leave the frame unchanged, or any other function that can take a
+frame as its sole argument.
Note that the function specified by this option is called only if the
specified frame contains just one live window and there is at least one
other frame on the same terminal.
+
+For a particular frame, the value specified here may be overridden by
+that frame's @code{auto-hide-function} frame parameter (@pxref{Frame
+Interaction Parameters}).
@end defopt
@@ -3355,7 +3381,7 @@ producing the frame layout sketched above.
@example
@group
(defvar parameters
- '(window-parameters . ((no-other-window . t) (no-delete-other-window . t))))
+ '(window-parameters . ((no-other-window . t) (no-delete-other-windows . t))))
(setq fit-window-to-buffer-horizontally t)
(setq window-resize-pixelwise t)
@@ -3397,7 +3423,7 @@ retain their respective sizes when maximizing the frame, the variable
are accessible via @kbd{C-x o} by installing the @code{no-other-window}
parameter for each of these windows. In addition, it makes sure that
side windows are not deleted via @kbd{C-x 1} by installing the
-@code{no-delete-other-window} parameter for each of these windows.
+@code{no-delete-other-windows} parameter for each of these windows.
Since @code{dired} buffers have no fixed names, we use a special
function @code{dired-default-directory-on-left} in order to display a
@@ -4364,13 +4390,12 @@ is off the screen due to horizontal scrolling:
@cindex coordinate, relative to frame
@cindex window position
-This section describes functions that report the position of a window.
-Most of these functions report positions relative to an origin at the
-native position of the window's frame (@pxref{Frame Geometry}). Some
-functions report positions relative to the origin of the display of the
-window's frame. In any case, the origin has the coordinates (0, 0) and
-X and Y coordinates increase rightward and downward
-respectively.
+This section describes functions that report positions of and within a
+window. Most of these functions report positions relative to an origin
+at the native position of the window's frame (@pxref{Frame Geometry}).
+Some functions report positions relative to the origin of the display of
+the window's frame. In any case, the origin has the coordinates (0, 0)
+and X and Y coordinates increase rightward and downward respectively.
For the following functions, X and Y coordinates are reported in
integer character units, i.e., numbers of lines and columns
@@ -4608,6 +4633,49 @@ point in the selected window, it's sufficient to write:
@end example
@end defun
+The following function returns the largest rectangle that can be
+inscribed in a window without covering text displayed in that window.
+
+@defun window-largest-empty-rectangle &optional window count min-width min-height positions left
+This function calculates the dimensions of the largest empty rectangle
+that can be inscribed in the specified @var{window}'s text area.
+@var{window} must be a live window and defaults to the selected one.
+
+The return value is a triple of the width and the start and end
+y-coordinates of the largest rectangle that can be inscribed into the
+empty space (space not displaying any text) of the text area of
+@var{window}. No x-coordinates are returned by this function---any such
+rectangle is assumed to end at the right edge of @var{window}'s text
+area. If no empty space can be found, the return value is @code{nil}.
+
+The optional argument @var{count}, if non-@code{nil}, specifies a
+maximum number of rectangles to return. This means that the return
+value is a list of triples specifying rectangles with the largest
+rectangle first. @var{count} can be also a cons cell whose car
+specifies the number of rectangles to return and whose @sc{cdr}, if
+non-@code{nil}, states that all rectangles returned must be disjoint.
+
+The optional arguments @var{min-width} and @var{min-height}, if
+non-@code{nil}, specify the minimum width and height of any rectangle
+returned.
+
+The optional argument @var{positions}, if non-@code{nil}, is a cons cell
+whose @sc{car} specifies the uppermost and whose @sc{cdr} specifies the
+lowermost pixel position that must be covered by any rectangle returned.
+These positions measure from the start of the text area of @var{window}.
+
+The optional argument @var{left}, if non-@code{nil}, means to return
+values suitable for buffers displaying right to left text. In that
+case, any rectangle returned is assumed to start at the left edge of
+@var{window}'s text area.
+
+Note that this function has to retrieve the dimensions of each line of
+@var{window}'s glyph matrix via @code{window-lines-pixel-dimensions}
+(@pxref{Size of Displayed Text}). Hence, this function may also return
+@code{nil} when the current glyph matrix of @var{window} is not
+up-to-date.
+@end defun
+
@node Mouse Window Auto-selection
@section Mouse Window Auto-selection
@@ -4911,37 +4979,45 @@ windows when exiting that function.
The following parameters are currently used by the window management
code:
-@table @asis
-@item @code{delete-window}
+@table @code
+@item delete-window
+@vindex delete-window, a window parameter
This parameter affects the execution of @code{delete-window}
(@pxref{Deleting Windows}).
-@item @code{delete-other-windows}
+@item delete-other-windows
+@vindex delete-other-windows, a window parameter
This parameter affects the execution of @code{delete-other-windows}
(@pxref{Deleting Windows}).
-@item @code{no-delete-other-window}
+@item no-delete-other-windows
+@vindex no-delete-other-windows, a window parameter
This parameter marks the window as not deletable by
@code{delete-other-windows} (@pxref{Deleting Windows}).
-@item @code{split-window}
+@item split-window
+@vindex split-window, a window parameter
This parameter affects the execution of @code{split-window}
(@pxref{Splitting Windows}).
-@item @code{other-window}
+@item other-window
+@vindex other-window, a window parameter
This parameter affects the execution of @code{other-window}
(@pxref{Cyclic Window Ordering}).
-@item @code{no-other-window}
+@item no-other-window
+@vindex no-other-window, a window parameter
This parameter marks the window as not selectable by @code{other-window}
(@pxref{Cyclic Window Ordering}).
-@item @code{clone-of}
+@item clone-of
+@vindex clone-of, a window parameter
This parameter specifies the window that this one has been cloned
from. It is installed by @code{window-state-get} (@pxref{Window
Configurations}).
-@item @code{preserved-size}
+@item window-preserved-size
+@vindex window-preserved-size, a window parameter
This parameter specifies a buffer, a direction where @code{nil} means
vertical and @code{t} horizontal, and a size in pixels. If this window
displays the specified buffer and its size in the indicated direction
@@ -4950,7 +5026,8 @@ preserve the size of this window in the indicated direction. This
parameter is installed and updated by the function
@code{window-preserve-size} (@pxref{Preserving Window Sizes}).
-@item @code{quit-restore}
+@item quit-restore
+@vindex quit-restore, a window parameter
This parameter is installed by the buffer display functions
(@pxref{Choosing Window}) and consulted by @code{quit-restore-window}
(@pxref{Quitting Windows}). It contains four elements:
@@ -4981,15 +5058,37 @@ only if it still shows that buffer.
See the description of @code{quit-restore-window} in @ref{Quitting
Windows} for details.
-@item @code{window-side} @code{window-slot}
+@item window-side window-slot
+@vindex window-side, a window parameter
+@vindex window-slot, a window parameter
These parameters are used for implementing side windows (@pxref{Side
Windows}).
-@item @code{window-atom}
+@item window-atom
+@vindex window-atom, a window parameter
This parameter is used for implementing atomic windows, see @ref{Atomic
Windows}.
-@item @code{min-margins}
+@item mode-line-format
+@vindex mode-line-format, a window parameter
+This parameter replaces the value of the buffer-local variable
+@code{mode-line-format} (@pxref{Mode Line Basics}) of this window's
+buffer whenever this window is displayed. The symbol @code{none} means
+to suppress display of a mode line for this window. Display and
+contents of the mode line on other windows showing this buffer are not
+affected.
+
+@item header-line-format
+@vindex header-line-format, a window parameter
+This parameter replaces the value of the buffer-local variable
+@code{header-line-format} (@pxref{Mode Line Basics}) of this window's
+buffer whenever this window is displayed. The symbol @code{none} means
+to suppress display of a header line for this window. Display and
+contents of the header line on other windows showing this buffer are not
+affected.
+
+@item min-margins
+@vindex min-margins, a window parameter
The value of this parameter is a cons cell whose @sc{car} and @sc{cdr},
if non-@code{nil}, specify the minimum values (in columns) for the left
and right margin of this window. When present, Emacs will use these
@@ -5028,7 +5127,10 @@ redisplaying a window with scrolling. Displaying a different buffer in
the window also runs these functions.
This variable is not a normal hook, because each function is called with
-two arguments: the window, and its new display-start position.
+two arguments: the window, and its new display-start position. At the
+time of the call, the display-start position of the window argument is
+already set to its new value, and the buffer to be displayed in the
+window is already set as the current buffer.
These functions must take care when using @code{window-end}
(@pxref{Window Start and End}); if you need an up-to-date value, you
@@ -5039,6 +5141,11 @@ is scrolled. It's not designed for that, and such use probably won't
work.
@end defvar
+@defun run-window-scroll-functions &optional window
+This function calls @code{window-scroll-functions} for the specified
+@var{window}, which defaults to the selected window.
+@end defun
+
@defvar window-size-change-functions
This variable holds a list of functions to be called if the size of any
window changes for any reason. The functions are called once per
@@ -5068,17 +5175,22 @@ be called again.
@defvar window-configuration-change-hook
A normal hook that is run every time the window configuration of a frame
changes. Window configuration changes include splitting and deleting
-windows and the display of a different buffer in a window. Resizing the
+windows, and the display of a different buffer in a window. Resizing the
frame or individual windows do not count as configuration changes. Use
@code{window-size-change-functions}, see above, when you want to track
size changes that are not caused by the deletion or creation of windows.
-The buffer-local part of this hook is run once for each window on the
+The buffer-local value of this hook is run once for each window on the
affected frame, with the relevant window selected and its buffer
-current. The global part is run once for the modified frame, with that
-frame selected.
+current. The global value of this hook is run once for the modified
+frame, with that frame selected.
@end defvar
+@defun run-window-configuration-change-hook &optional frame
+This function runs @code{window-configuration-change-hook} for the
+specified @var{frame}, which defaults to the selected frame.
+@end defun
+
In addition, you can use @code{jit-lock-register} to register a Font
Lock fontification function, which will be called whenever parts of a
buffer are (re)fontified because a window was scrolled or its size
diff --git a/doc/man/ChangeLog.1 b/doc/man/ChangeLog.1
index aa863ff72ba..68498c64c0d 100644
--- a/doc/man/ChangeLog.1
+++ b/doc/man/ChangeLog.1
@@ -191,4 +191,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in
index 5d0948f51b3..0e905b7d833 100644
--- a/doc/man/emacs.1.in
+++ b/doc/man/emacs.1.in
@@ -546,7 +546,7 @@ is the number of color planes.
.SH MANUALS
You can order printed copies of the GNU Emacs Manual from the Free
Software Foundation, which develops GNU software.
-See the online store at <http://shop.fsf.org/>.
+See the online store at <https://shop.fsf.org/>.
.br
Your local administrator might also have copies available.
As with all software and publications from FSF, everyone is permitted
@@ -597,10 +597,10 @@ Do not expect a personal answer to a bug report.
The purpose of reporting bugs is to get them fixed for everyone
in the next release, if possible.
For personal assistance, consult the service directory at
-<http://www.fsf.org/resources/service/> for a list of people who offer it.
+<https://www.fsf.org/resources/service/> for a list of people who offer it.
Please do not send anything but bug reports to this mailing list.
-For other Emacs lists, see <http://savannah.gnu.org/mail/?group=emacs>.
+For other Emacs lists, see <https://savannah.gnu.org/mail/?group=emacs>.
.
.
.SH UNRESTRICTIONS
diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1
index 010eeba19c1..daaacab7f3e 100644
--- a/doc/man/emacsclient.1
+++ b/doc/man/emacsclient.1
@@ -62,10 +62,10 @@ A missing
is treated as column 1.
This option applies only to the next file specified.
.TP
-.B \-a, \-\-alternate-editor=EDITOR
-if the Emacs server is not running, run the specified editor instead.
+.B \-a, \-\-alternate-editor=COMMAND
+if the Emacs server is not running, run the specified shell command instead.
This can also be specified via the ALTERNATE_EDITOR environment variable.
-If the value of EDITOR is the empty string, run "emacs \-\-daemon" to
+If the value of ALTERNATE_EDITOR is the empty string, run "emacs \-\-daemon" to
start Emacs in daemon mode, and try to connect to it.
.TP
.B -c, \-\-create-frame
diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1
index 2b1571c0abb..bc2c184d412 100644
--- a/doc/misc/ChangeLog.1
+++ b/doc/misc/ChangeLog.1
@@ -12131,4 +12131,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 8ff823200ad..a60fb0b0a70 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi
index 507a048da50..1f1f13afee2 100644
--- a/doc/misc/autotype.texi
+++ b/doc/misc/autotype.texi
@@ -581,7 +581,7 @@ specify that @kbd{M-x quickurl} should insert @var{URL} if the word
@var{key} is at point, for example:
@example
-(("FSF" "http://www.fsf.org/" "The Free Software Foundation")
+(("FSF" "https://www.fsf.org/" "The Free Software Foundation")
("emacs" . "http://www.emacs.org/")
("hagbard" "http://www.hagbard.demon.co.uk" "Hagbard's World"))
@end example
diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi
index 7bd060189c5..e4e7330ba07 100644
--- a/doc/misc/calc.texi
+++ b/doc/misc/calc.texi
@@ -35751,7 +35751,7 @@ to work on these, please send a message (using @kbd{M-x report-calc-bug})
so any efforts can be coordinated.
The latest version of Calc is available from Savannah, in the Emacs
-repository. See @uref{http://savannah.gnu.org/projects/emacs}.
+repository. See @uref{https://savannah.gnu.org/projects/emacs}.
@c [summary]
@node Summary, Key Index, Reporting Bugs, Top
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index f9ba5cc3921..13f5c81d949 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -198,7 +198,7 @@ modify this GNU manual.''
@insertcopying
This manual was generated from cc-mode.texi, which is distributed with Emacs,
-or can be downloaded from @url{http://savannah.gnu.org/projects/emacs/}.
+or can be downloaded from @url{https://savannah.gnu.org/projects/emacs/}.
@end titlepage
@comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1760,6 +1760,7 @@ file. For commands that you can use to view the effect of your changes,
see @ref{Indentation Commands} and @ref{Filling and Breaking}.
For details of the @ccmode{} style system, see @ref{Styles}.
+
@item @kbd{C-c :} (@code{c-scope-operator})
@kindex C-c :
@findex c-scope-operator
@@ -1768,6 +1769,18 @@ In C++, it is also sometimes desirable to insert the double-colon scope
operator without performing the electric behavior of colon insertion.
@kbd{C-c :} does just this.
+@item @kbd{C-c C-z} (@code{c-display-defun-name})
+@kindex C-c C-z
+@findex c-display-defun-name
+@findex display-defun-name (c-)
+Display the current function name, if any, in the minibuffer.
+Additionally, if a prefix argument is given, push the function name to
+the kill ring. If there is no current function,
+@code{c-display-defun-name} does nothing. In Emacs, you can use this
+command in the middle of an interactive search if you set the
+customizable option @code{isearch-allow-scroll} to non-@code{nil}.
+@xref{Not Exiting Isearch,,,emacs, GNU Emacs Manual}.
+
@item @kbd{C-c C-\} (@code{c-backslash-region})
@kindex C-c C-\
@findex c-backslash-region
@@ -7396,7 +7409,7 @@ Emacs Lisp code that triggers the bug and include it in your report.
@cindex bug report mailing list
Reporting a bug using @code{c-submit-bug-report} files it in
-the GNU Bug Tracker at @url{http://debbugs.gnu.org}, then sends it on
+the GNU Bug Tracker at @url{https://debbugs.gnu.org}, then sends it on
to @email{bug-cc-mode@@gnu.org}. You can also send reports, other
questions, and suggestions (kudos?@: @t{;-)} to that address. It's a
mailing list which you can join or browse an archive of; see the web site at
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 33b4858a45b..c7ef1d8f5cb 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -317,7 +317,7 @@ This is analogous to the @code{defsubst} form;
@code{cl-defsubst} uses a different method (compiler macros) which
works in all versions of Emacs, and also generates somewhat more
@c For some examples,
-@c see http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00009.html
+@c see https://lists.gnu.org/r/emacs-devel/2012-11/msg00009.html
efficient inline expansions. In particular, @code{cl-defsubst}
arranges for the processing of keyword arguments, default values,
etc., to be done at compile-time whenever possible.
@@ -1207,7 +1207,7 @@ must have a well-defined value outside the @code{cl-letf} body.
There is essentially only one exception to this, which is @var{place}
a plain variable with a specified @var{value} (such as @code{(a 17)}
in the above example).
-@c See http://debbugs.gnu.org/12758
+@c See https://debbugs.gnu.org/12758
@c Some or all of this was true for cl.el, but not for cl-lib.el.
@ignore
The only exceptions are plain variables and calls to
@@ -1389,7 +1389,7 @@ treated like a @code{cl-letf} or @code{cl-letf*}. This differs from true
Common Lisp, where the rules of lexical scoping cause a @code{let}
binding to shadow a @code{symbol-macrolet} binding. In this package,
such shadowing does not occur, even when @code{lexical-binding} is
-@c See http://debbugs.gnu.org/12119
+@c See https://debbugs.gnu.org/12119
@code{t}. (This behavior predates the addition of lexical binding to
Emacs Lisp, and may change in future to respect @code{lexical-binding}.)
At present in this package, only @code{lexical-let} and
@@ -3326,7 +3326,7 @@ the first sequence. This function is more general than the Emacs
primitive @code{mapc}. (Note that this function is called
@code{cl-mapc} even in @file{cl.el}, rather than @code{mapc*} as you
might expect.)
-@c http://debbugs.gnu.org/6575
+@c https://debbugs.gnu.org/6575
@end defun
@defun cl-mapl function list &rest more-lists
diff --git a/doc/misc/doclicense.texi b/doc/misc/doclicense.texi
index 9c3bbe56e91..eaf3da0e92d 100644
--- a/doc/misc/doclicense.texi
+++ b/doc/misc/doclicense.texi
@@ -6,7 +6,7 @@
@display
Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
-@uref{http://fsf.org/}
+@uref{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -414,7 +414,7 @@ The Free Software Foundation may publish new, revised versions
of the GNU Free Documentation License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
+@uref{https://www.gnu.org/licenses/}.
Each version of the License is given a distinguishing version number.
If the Document specifies that a particular numbered version of this
diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi
index 61ee04e2b5b..84669dc4c4d 100644
--- a/doc/misc/ebrowse.texi
+++ b/doc/misc/ebrowse.texi
@@ -253,7 +253,7 @@ of a command pipe.
@findex --search-path
@item --search-path=@var{paths}
This option lets you specify search paths for your input files.
-@var{paths} is a list of directory names, separated from each other by a
+@var{paths} is a list of directories, separated by
either a colon or a semicolon, depending on the operating system.
@end table
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index e87ae95f626..4bf0e8dbb2c 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -806,8 +806,8 @@ name is expanded.
The include path only affects C/C++ header files. Use the slot
@code{:header-match-regexp} to change it.
-The @code{:system-include-path} allows you to specify full directory
-names to include directories where system header files can be found.
+The @code{:system-include-path} allows you to specify absolute names
+of include directories where system header files can be found.
These will be applied to files in this project only.
With @code{:compile-command} you can provide a command which should be
@@ -2555,7 +2555,7 @@ Return non-@code{nil} if @var{THIS} target wants @var{FILE}.
@end deffn
@deffn Method project-add-file :AFTER ot file
-Add the current buffer into project project target @var{OT}.
+Add the current buffer into project target @var{OT}.
Argument @var{FILE} is the file to add.
@end deffn
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index bb548c991cc..b66aaeb3198 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -61,7 +61,7 @@ Emacs @value{EMACSVER}.
This FAQ is maintained by the developers and users of Emacs on MS Windows.
If you find any errors, or have any suggestions, please send them to
-the @url{http://lists.gnu.org/mailman/listinfo/help-emacs-windows,
+the @url{https://lists.gnu.org/mailman/listinfo/help-emacs-windows,
help-emacs-windows} mailing list.
At time of writing, the latest version of GNU Emacs is version @value{EMACSVER}.
@@ -164,7 +164,7 @@ instructions (requires DJGPP).
@cindex Emacs source code
@cindex source for Emacs
You can download Emacs releases from
-@uref{http://ftpmirror.gnu.org/emacs/, ftp.gnu.org mirrors}. They
+@uref{https://ftpmirror.gnu.org/emacs/, ftp.gnu.org mirrors}. They
are distributed as compressed tar files, digitally signed by the
maintainer who made the release.
@@ -181,7 +181,7 @@ to give it a try. @xref{Compiling}.
@cindex latest development version of Emacs
@cindex Emacs Development
The development version of Emacs is available from
-@uref{http://savannah.gnu.org/projects/emacs, Savannah}, the GNU
+@uref{https://savannah.gnu.org/projects/emacs, Savannah}, the GNU
development site.
@node Compiling
@@ -581,7 +581,7 @@ update your registry (you may need to reboot).
Shane Holder gives some background on how "Scancode Map" is used
by the system:
@ignore
-http://ftp.gnu.org/old-gnu/emacs/windows/docs/ntemacs/contrib/caps-ctrl-registry.txt
+https://ftp.gnu.org/old-gnu/emacs/windows/docs/ntemacs/contrib/caps-ctrl-registry.txt
From: Shane Holder <holder@@mordor.rsn.hp.com>
To: ntemacs-users@@cs.washington.edu
Date: 04 Dec 1996 14:36:21 -0600
@@ -913,7 +913,7 @@ Fonts in Emacs 22 and earlier are named using the X Logical Font
Description (XLFD) format. Emacs on Windows ignores many of the
fields, and populates them with * when listing fonts. Former
maintainer Andrew Innes wrote
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/x-font-details,
+@uref{https://www.gnu.org/software/emacs/windows/ntemacs/discuss/x-font-details,
this explanation} of what each field in the font string means and how
Emacs treated them back in 19.34. Since then, multilingual support and
a redisplay overhaul to support variable width fonts have changed things
@@ -1060,7 +1060,7 @@ support packages of various components of Windows itself, GNU/Linux
distributions these days come with a number of Free truetype fonts
that cover a wide range of languages. The GNU Unifont project
contains glyphs for most of the Unicode codespace, and can be
-downloaded from @uref{http://ftpmirror.gnu.org/unifont, ftp.gnu.org
+downloaded from @uref{https://ftpmirror.gnu.org/unifont, ftp.gnu.org
mirrors}.
@node Third-party multibyte
@@ -1136,7 +1136,7 @@ There are a number of methods by which you can control automatic CR/LF
translation in Emacs, a situation that reflects the fact that the
default support was not very robust in the past. For a discussion of
this issue, take a look at
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/todo/translate,
+@uref{https://www.gnu.org/software/emacs/windows/ntemacs/todo/translate,
this collection of email messages} on the topic.
@menu
@@ -1339,7 +1339,7 @@ When an EOF is sent to a subprocess running in an interactive shell
with @code{process-send-eof}, the shell terminates unexpectedly as
if its input was closed. This affects the use of @kbd{C-c C-d} in
shell buffers. See
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/todo/shell-ctrl-d,
+@uref{https://www.gnu.org/software/emacs/windows/ntemacs/todo/shell-ctrl-d,
this discussion} for more details.
@node Using shell
@@ -1752,7 +1752,7 @@ AUCTeX is an Emacs package for writing LaTeX files, which also
includes preview-latex, an Emacs mode for previewing the formatted
contents of LaTeX documents. Pre-compiled versions for Windows are
available from
-@uref{http://www.gnu.org/software/auctex/download-for-windows.html, the
+@uref{https://www.gnu.org/software/auctex/download-for-windows.html, the
AUCTeX site}.
@node Spell check
@@ -2096,7 +2096,7 @@ code in lib/perl5db.pl
@end example
Doug Campbell also has some
-@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/perldb,
+@uref{https://www.gnu.org/software/emacs/windows/ntemacs/discuss/perldb,
suggestions} for improving the interaction of perldb and Emacs.
@c ------------------------------------------------------------
@@ -2272,8 +2272,8 @@ In Emacs, you can browse the manual using Info by typing @kbd{C-h r},
and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include:
@itemize
-@item @uref{http://www.gnu.org/software/emacs/, The Emacs homepage}
-@item @uref{http://www.gnu.org/software/emacs/manual/, Other Emacs manuals}
+@item @uref{https://www.gnu.org/software/emacs/, The Emacs homepage}
+@item @uref{https://www.gnu.org/software/emacs/manual/, Other Emacs manuals}
@item @uref{http://www.emacswiki.org/, Emacs Wiki}
@end itemize
@@ -2283,10 +2283,10 @@ and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include:
@cindex help, mailing lists
The official mailing list for Windows specific help and discussion is
-@url{http://lists.gnu.org/mailman/listinfo/help-emacs-windows,
+@url{https://lists.gnu.org/mailman/listinfo/help-emacs-windows,
help-emacs-windows}. See that link for information on how to subscribe
or unsubscribe. The
-@uref{http://lists.gnu.org/archive/html/help-emacs-windows/, list archives}
+@uref{https://lists.gnu.org/r/help-emacs-windows/, list archives}
are available online.
@c ------------------------------------------------------------
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index e9cfe7afce9..df3d09a6337 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -393,7 +393,7 @@ recipients the same freedom that you enjoyed.
@cindex GNU mailing lists
The Emacs mailing lists are described at
-@uref{http://savannah.gnu.org/mail/?group=emacs, the Emacs Savannah
+@uref{https://savannah.gnu.org/mail/?group=emacs, the Emacs Savannah
page}. Some of them are gatewayed to newsgroups.
The newsgroup @uref{news:comp.emacs} is for discussion of Emacs programs
@@ -421,8 +421,7 @@ posting bug reports to this newsgroup directly (@pxref{Reporting bugs}).
The FSF has maintained archives of all of the GNU mailing lists for many
years, although there may be some unintentional gaps in coverage. The
archive can be browsed over the web at
-@uref{http://lists.gnu.org/archive/html/, the GNU mail archive}. Raw
-files can be downloaded from @uref{ftp://lists.gnu.org/}.
+@uref{https://lists.gnu.org/r/, the GNU mail archive}.
Web-based Usenet search services, such as
@uref{http://groups.google.com/groups/dir?q=gnu&, Google}, also
@@ -458,13 +457,13 @@ RMS says:
@quotation
Sending bug reports to
-@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
+@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
the help-gnu-emacs mailing list}
(which has the effect of posting on @uref{news:gnu.emacs.help}) is
undesirable because it takes the time of an unnecessarily large group
of people, most of whom are just users and have no idea how to fix
these problem.
-@url{http://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
+@url{https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs, The
bug-gnu-emacs list} reaches a much smaller group of people who are
more likely to know what to do and have expressed a wish to receive
more messages about Emacs than the others.
@@ -506,12 +505,12 @@ unsubscribe.
@cindex Free Software Foundation, contacting
For up-to-date information, see
-@uref{http://www.fsf.org/about/contact.html, the FSF contact web-page}.
+@uref{https://www.fsf.org/about/contact.html, the FSF contact web-page}.
You can send general correspondence to @email{info@@fsf.org}.
@cindex Ordering GNU software
For details on how to order items directly from the FSF, see the
-@uref{http://shop.fsf.org/, FSF on-line store}.
+@uref{https://shop.fsf.org/, FSF on-line store}.
@c ------------------------------------------------------------
@node Getting help
@@ -645,7 +644,7 @@ information. To get a list of these commands, type @samp{?} after
@cindex Emacs manual, obtaining a printed or HTML copy of
You can order a printed copy of the Emacs manual from the FSF@. For
-details see the @uref{http://shop.fsf.org/, FSF on-line store}.
+details see the @uref{https://shop.fsf.org/, FSF on-line store}.
The full Texinfo source for the manual also comes in the @file{doc/emacs}
directory of the Emacs distribution, if you're daring enough to try to
@@ -655,7 +654,7 @@ file}).
If you absolutely have to print your own copy, and you don't have @TeX{},
you can get a PostScript or PDF (or HTML) version from
-@uref{http://www.gnu.org/software/emacs/manual/}
+@uref{https://www.gnu.org/software/emacs/manual/}
@xref{Learning how to do something}, for how to view the manual from Emacs.
@@ -675,12 +674,12 @@ in Info format (@pxref{Top, Emacs Lisp,, elisp, The
Emacs Lisp Reference Manual}).
You can also order a hardcopy of the manual from the FSF, for details
-see the @uref{http://shop.fsf.org/, FSF on-line store}. (This manual is
+see the @uref{https://shop.fsf.org/, FSF on-line store}. (This manual is
not always in print.)
An HTML version of the Emacs Lisp Reference Manual is available at
-@uref{http://www.gnu.org/software/emacs/elisp-manual/elisp.html}
+@uref{https://www.gnu.org/software/emacs/elisp-manual/elisp.html}
@node Installing Texinfo documentation
@section How do I install a piece of Texinfo documentation?
@@ -699,7 +698,7 @@ First, you must turn the Texinfo source files into Info files. You may
do this using the stand-alone @file{makeinfo} program, available as part
of the Texinfo package at
-@uref{http://www.gnu.org/software/texinfo/}
+@uref{https://www.gnu.org/software/texinfo/}
For information about the Texinfo format, read the Texinfo manual which
comes with the Texinfo package. This manual also comes installed in
@@ -893,7 +892,7 @@ Emacs news, a history of recent user-visible changes
More GNU information, including back issues of the @cite{GNU's
Bulletin}, are at
-@uref{http://www.gnu.org/bulletins/bulletins.html} and
+@uref{https://www.gnu.org/bulletins/bulletins.html} and
@uref{http://www.cs.pdx.edu/~trent/gnu/gnu.html}
@@ -905,7 +904,7 @@ Bulletin}, are at
@xref{Installing Emacs}, for some basic installation hints, and see
@ref{Problems building Emacs}, if you have problems with the installation.
-@uref{http://www.fsf.org/resources/service/, The GNU Service directory}
+@uref{https://www.fsf.org/resources/service/, The GNU Service directory}
lists companies and individuals willing to sell you help in installing
or using Emacs and other GNU software.
@@ -983,7 +982,7 @@ version; three components indicate a development
version (e.g., @samp{26.0.50} is what will eventually become @samp{26.1}).
Emacs is under active development, hosted at
-@uref{http://savannah.gnu.org/projects/emacs/, Savannah}.
+@uref{https://savannah.gnu.org/projects/emacs/, Savannah}.
Follow the instructions given there to clone the project repository.
Because Emacs undergoes many changes before a release, the version
@@ -1433,7 +1432,7 @@ of files from Macintosh, Microsoft, and Unix platforms.
In general, new Emacs users should not be provided with @file{.emacs}
files, because this can cause confusing non-standard behavior. Then
they send questions to
-@url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
+@url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
the help-gnu-emacs mailing list} asking why Emacs
isn't behaving as documented.
@@ -2490,7 +2489,7 @@ following in your @file{.emacs}:
If you're tired of seeing backup files whenever you do an @samp{ls} at
the Unix shell, try GNU @code{ls} with the @samp{-B} option. GNU
@code{ls} is part of the GNU Fileutils package, available from
-@samp{ftp.gnu.org} and its mirrors (@pxref{Current GNU distributions}).
+@url{https://ftp.gnu.org} and its mirrors (@pxref{Current GNU distributions}).
To disable or change the way backups are made,
@pxref{Backup Names,,, emacs, The GNU Emacs Manual}.
@@ -3035,7 +3034,7 @@ Xt toolkit.
@code{XFILESEARCHPATH} and @code{XUSERFILESEARCHPATH} should be a list
of file names separated by colons. @code{XAPPLRESDIR} should be a list
-of directory names separated by colons.
+of directories separated by colons.
Emacs searches for X resources:
@@ -3127,7 +3126,7 @@ this behavior, type @kbd{$$} instead.
Emacs has no way of knowing when the shell actually changes its
directory. This is an intrinsic limitation of Unix. So it tries to
guess by recognizing @samp{cd} commands. If you type @kbd{cd} followed
-by a directory name with a variable reference (@kbd{cd $HOME/bin}) or
+by directory with a variable reference (@kbd{cd $HOME/bin}) or
with a shell metacharacter (@kbd{cd ../lib*}), Emacs will fail to
correctly guess the shell's new current directory. A huge variety of
fixes and enhancements to shell mode for this problem have been written
@@ -3293,11 +3292,11 @@ the source distribution. In brief:
@item
First download the Emacs sources. @xref{Current GNU distributions}, for
-a list of ftp sites that make them available. On @file{ftp.gnu.org},
+a list of sites that make them available. On @url{https://ftp.gnu.org},
the main GNU distribution site, sources are available as
@c Don't include VER in the file name, because pretests are not there.
-@uref{ftp://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.gz}
+@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}.)
@@ -3305,7 +3304,7 @@ the main GNU distribution site, sources are available as
Next uncompress and extract the source files. This requires
the @code{gzip} and @code{tar} programs, which are standard utilities.
If your system does not have them, these can also be downloaded from
-@file{ftp.gnu.org}.
+@url{https://ftp.gnu.org}.
GNU @code{tar} can uncompress and extract in a single-step:
@@ -3383,7 +3382,7 @@ problem (@pxref{Reporting bugs}).
@cindex Downloading Emacs
Information on downloading Emacs is available at
-@uref{http://www.gnu.org/software/emacs/, the Emacs home-page}.
+@uref{https://www.gnu.org/software/emacs/, the Emacs home-page}.
@xref{Installing Emacs}, for information on how to obtain and build the latest
version of Emacs, and see @ref{Current GNU distributions}, for a list of
@@ -3426,7 +3425,7 @@ see @ref{Packages that do not come with Emacs}.
The easiest way to add more features to your Emacs is to use the
command @kbd{M-x list-packages}. This contacts the
-@uref{http:///elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'')
+@uref{https:///elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'')
server and fetches the list of additional packages that it offers.
These are GNU packages that are available for use with Emacs, but are
distributed separately from Emacs itself, for reasons of space, etc.
@@ -3464,22 +3463,26 @@ best way to find results.
@section Spell-checkers
@cindex Spell-checker
@cindex Checking spelling
-@cindex Ispell
-@cindex Aspell
@cindex Hunspell
+@cindex Aspell
+@cindex Ispell
+@cindex Enchant
Various spell-checkers are compatible with Emacs, including:
@table @b
+@item Hunspell
+@uref{http://hunspell.sourceforge.net/}
+
@item GNU Aspell
@uref{http://aspell.net/}
@item Ispell
@uref{http://fmg-www.cs.ucla.edu/geoff/ispell.html}
-@item Hunspell
-@uref{http://hunspell.sourceforge.net/}
+@item Enchant
+@uref{https://abiword.github.io/enchant/}
@end table
@@ -3494,11 +3497,11 @@ Various spell-checkers are compatible with Emacs, including:
The most up-to-date official GNU software is normally kept at
-@uref{ftp://ftp.gnu.org/pub/gnu}
+@uref{https://ftp.gnu.org/pub/gnu}
A list of sites mirroring @samp{ftp.gnu.org} can be found at
-@uref{http://www.gnu.org/order/ftp.html}
+@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)?
@@ -3544,7 +3547,7 @@ binary typically has a size of about 130 kbytes, so this can be useful
if you are in an extremely space-restricted environment. More
information is available from
-@uref{http://www.gnu.org/software/zile/}
+@uref{https://www.gnu.org/software/zile/}
@node Emacs for MS-DOS
@@ -3562,10 +3565,10 @@ onwards, including Windows XP and Vista.
The file @file{etc/PROBLEMS} contains some additional information
regarding Emacs under MS-DOS.
-A pre-built binary distribution of the old Emacs 20 is available, as
+A pre-built binary distribution of the old Emacs 24 is available, as
described at
-@uref{ftp://ftp.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
+@uref{http://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
For a list of other MS-DOS implementations of Emacs (and Emacs
look-alikes), consult the list of ``Emacs implementations and literature,''
@@ -4199,7 +4202,7 @@ Arabic, Farsi, and Hebrew, since version 24.1.
First, download and install the BDF font files and any auxiliary
packages they need. The GNU Intlfonts distribution can be found on
-@uref{http://directory.fsf.org/localization/intlfonts.html, the GNU
+@uref{https://directory.fsf.org/localization/intlfonts.html, the GNU
Software Directory Web site}.
Next, if you are on X Window system, issue the following two commands
diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi
index 87165631bf4..92846a924c5 100644
--- a/doc/misc/emacs-gnutls.texi
+++ b/doc/misc/emacs-gnutls.texi
@@ -94,7 +94,11 @@ There's one way to find out if GnuTLS is available, by calling
Zaretskii) in the same directory as Emacs, you should be OK.
@defun gnutls-available-p
-This function returns @code{t} if GnuTLS is available in this instance of Emacs.
+This function returns non-@code{nil} if GnuTLS is available in this
+instance of Emacs, @code{nil} otherwise. If GnuTLS is available, the
+value is a list of GnuTLS capabilities supported by the installed
+GnuTLS library, which depends on the library version. The meaning of
+the capabilities is documented in the doc string of this function.
@end defun
Oh, but sometimes things go wrong. Budgets aren't balanced,
@@ -113,7 +117,7 @@ The @code{gnutls-algorithm-priority} variable sets the GnuTLS priority
string. This is global, not per host name (although
@code{gnutls-negotiate} supports a priority string per connection so
it could be done if needed). The priority string syntax is in the
-@uref{http://www.gnu.org/software/gnutls/documentation.html, GnuTLS
+@uref{https://www.gnu.org/software/gnutls/documentation.html, GnuTLS
documentation}.
@end defvar
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index b0cfbc9d3c0..069d6b3389b 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -405,7 +405,7 @@ variable will cause @samp{text/html} parts to be treated as attachments.
@item mm-text-html-renderer
@vindex mm-text-html-renderer
This selects the function used to render @acronym{HTML}. The predefined
-renderers are selected by the symbols @code{gnus-article-html},
+renderers are selected by the symbols @code{shr}, @code{gnus-w3m},
@code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more
information about emacs-w3m}, @code{links}, @code{lynx},
@code{w3m-standalone} or @code{html2text}. If @code{nil} use an
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index e38ead079a7..49005537f85 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -804,7 +804,7 @@ emacswiki.org page for ERC@. Anyone may add tips, hints, etc.@: to it.
@item
You can ask questions about using ERC on the Emacs mailing list,
-@uref{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs}.
+@uref{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs}.
@item
You can visit the IRC Freenode channel @samp{#emacs}. Many of the
@@ -875,7 +875,7 @@ decided to include ERC in Emacs.
ERC 5.1 was released. It was subsequently included in Emacs 22.
ERC became an official GNU project, and development moved to
-@uref{http://sv.gnu.org/projects/erc}. We switched to using GNU Arch as
+@uref{https://sv.gnu.org/projects/erc}. We switched to using GNU Arch as
our revision control system. Our mailing list address changed as well.
@item 2007
diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index 4a2c29dcb9f..de71aca8aea 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -3,6 +3,10 @@
@setfilename ../../info/ert.info
@settitle Emacs Lisp Regression Testing
@include docstyle.texi
+@syncodeindex fn cp
+@syncodeindex vr cp
+@syncodeindex pg cp
+@syncodeindex ky cp
@c %**end of header
@dircategory Emacs misc features
@@ -59,6 +63,7 @@ traditional software development methods.
* How to Debug Tests:: What to do if a test fails.
* Extending ERT:: ERT is extensible in several ways.
* Other Testing Concepts:: Features not in ERT.
+* Index:: Concept, Function and Variable Index
* GNU Free Documentation License:: The license for this documentation.
@detailmenu
@@ -92,6 +97,10 @@ Other Testing Concepts
* Mocks and Stubs:: Stubbing out code that is irrelevant to the test.
* Fixtures and Test Suites:: How ERT differs from tools for other languages.
+Index
+
+* Index:: Concept, Function and Variable Index
+
Appendix
* GNU Free Documentation License:: The license for this documentation.
@@ -102,6 +111,7 @@ Appendix
@node Introduction
@chapter Introduction
+@cindex introduction to ERT
ERT allows you to define @emph{tests} in addition to functions,
macros, variables, and the other usual Lisp constructs. Tests are
@@ -169,6 +179,7 @@ Environment}.
@node How to Run Tests
@chapter How to Run Tests
+@cindex how to run ert tests
You can run tests either in the Emacs you are working in, or on the
command line in a separate Emacs process in batch mode (i.e., with no
@@ -187,7 +198,10 @@ different Emacs versions.
@node Running Tests Interactively
@section Running Tests Interactively
+@cindex running tests interactively
+@cindex interactive testing
+@findex ert
You can run the tests that are currently defined in your Emacs with
the command @kbd{@kbd{M-x} ert @kbd{RET} t @kbd{RET}}. (For an
explanation of the @code{t} argument, @pxref{Test Selectors}.) ERT will pop
@@ -232,6 +246,7 @@ F list-test
(different-atoms c d))))
@end example
+@cindex test results buffer
At the top, there is a summary of the results: we ran all tests defined
in the current Emacs (@code{Selector: t}), 31 of them passed, and 2
failed unexpectedly. @xref{Expected Failures}, for an explanation of
@@ -245,20 +260,29 @@ unexpected result. In the example above, there are two failures, both
due to failed @code{should} forms. @xref{Understanding Explanations},
for more details.
+@kindex TAB@r{, in ert results buffer}
+@kindex S-TAB@r{, in ert results buffer}
In the ERT results buffer, @kbd{TAB} and @kbd{S-TAB} cycle between
buttons. Each name of a function or macro in this buffer is a button;
moving point to it and typing @kbd{RET} jumps to its definition.
+@kindex r@r{, in ert results buffer}
+@kindex d@r{, in ert results buffer}
+@kindex .@r{, in ert results buffer}
+@kindex b@r{, in ert results buffer}
+@cindex backtrace of a failed test
Pressing @kbd{r} re-runs the test near point on its own. Pressing
@kbd{d} re-runs it with the debugger enabled. @kbd{.} jumps to the
definition of the test near point (@kbd{RET} has the same effect if
point is on the name of the test). On a failed test, @kbd{b} shows
the backtrace of the failure.
+@kindex l@r{, in ert results buffer}
@kbd{l} shows the list of @code{should} forms executed in the test.
If any messages were generated (with the Lisp function @code{message})
in a test or any of the code that it invoked, @kbd{m} will show them.
+@kindex L@r{, in ert results buffer}
By default, long expressions in the failure details are abbreviated
using @code{print-length} and @code{print-level}. Pressing @kbd{L}
while point is on a test failure will increase the limits to show more
@@ -267,7 +291,11 @@ of the expression.
@node Running Tests in Batch Mode
@section Running Tests in Batch Mode
+@cindex running tests in batch mode
+@cindex batch-mode testing
+@findex ert-run-tests-batch
+@findex ert-run-tests-batch-and-exit
ERT supports automated invocations from the command line or from
scripts or makefiles. There are two functions for this purpose,
@code{ert-run-tests-batch} and @code{ert-run-tests-batch-and-exit}.
@@ -283,6 +311,7 @@ with a zero exit status if all tests passed, or nonzero if any tests
failed or if anything else went wrong. It will also print progress
messages and error diagnostics to standard output.
+@findex ert-summarize-tests-batch-and-exit
You can also redirect the above output to a log file, say
@file{output.log}, and use the
@code{ert-summarize-tests-batch-and-exit} function to produce a neat
@@ -292,6 +321,20 @@ summary as shown below:
emacs -batch -l ert -f ert-summarize-tests-batch-and-exit output.log
@end example
+@vindex ert-quiet
+By default, ERT in batch mode is quite verbose, printing a line with
+result after each test. This gives you progress information: how many
+tests have been executed and how many there are. However, in some
+cases this much output may be undesirable. In this case, set
+@code{ert-quiet} variable to a non-nil value:
+
+@example
+emacs -batch -l ert -l my-tests.el \
+ --eval "(let ((ert-quiet t)) (ert-run-tests-batch-and-exit))"
+@end example
+
+In quiet mode ERT prints only unexpected results and summary.
+
If ERT is not part of your Emacs distribution, you may need to use
@code{-L /path/to/ert/} so that Emacs can find it. You may need
additional @code{-L} flags to ensure that @code{my-tests.el} and all the
@@ -300,6 +343,8 @@ files that it requires are on your @code{load-path}.
@node Test Selectors
@section Test Selectors
+@cindex test selector
+@cindex selecting tests
Functions like @code{ert} accept a @emph{test selector}, a Lisp
expression specifying a set of tests. Test selector syntax is similar
@@ -314,17 +359,22 @@ to Common Lisp's type specifier syntax:
@item A string is a regular expression that selects all tests with matching names.
@item A test (i.e., an object of @code{ert-test} data type) selects that test.
@item A symbol selects the test that the symbol names.
-@item @code{(member TESTS...)} selects the elements of TESTS, a list of
-tests or symbols naming tests.
-@item @code{(eql TEST)} selects TEST, a test or a symbol naming a test.
-@item @code{(and SELECTORS...)} selects the tests that match all SELECTORS.
-@item @code{(or SELECTORS...)} selects the tests that match any SELECTOR.
-@item @code{(not SELECTOR)} selects all tests that do not match SELECTOR.
-@item @code{(tag TAG)} selects all tests that have TAG on their tags list.
+@item @code{(member @var{tests}...)} selects the elements of
+@var{tests}, a list of tests or symbols naming tests.
+@item @code{(eql @var{test})} selects @var{test}, a test or a symbol
+naming a test.
+@item @code{(and @var{selectors}@dots{})} selects the tests that match
+all @var{selectors}.
+@item @code{(or @var{selectors}@dots{})} selects the tests that match
+any of the @var{selectors}.
+@item @code{(not @var{selector})} selects all tests that do not match
+@var{selector}.
+@item @code{(tag @var{tag})} selects all tests that have @var{tag} on
+their tags list.
(Tags are optional labels you can apply to tests when you define them.)
-@item @code{(satisfies PREDICATE)} selects all tests that satisfy PREDICATE,
-a function that takes a test as argument and returns non-@code{nil} if
-it is selected.
+@item @code{(satisfies @var{predicate})} selects all tests that
+satisfy @var{predicate}, a function that takes a test as argument and
+returns non-@code{nil} if it is selected.
@end itemize
Selectors that are frequently useful when selecting tests to run
@@ -340,7 +390,9 @@ result in the last run, and tag-based selectors such as @code{(not
@node How to Write Tests
@chapter How to Write Tests
+@cindex how to write tests
+@findex ert-deftest
ERT lets you define tests in the same way you define functions. You
can type @code{ert-deftest} forms in a buffer and evaluate them there
with @code{eval-defun} or @code{compile-defun}, or you can save the
@@ -361,6 +413,7 @@ to find where a test was defined if the test was loaded from a file.
@node The @code{should} Macro
@section The @code{should} Macro
+@findex should@r{, ert macro}
Test bodies can include arbitrary code; but to be useful, they need to
check whether the code being tested (or @emph{code under test})
does what it is supposed to do. The macro @code{should} is similar to
@@ -396,6 +449,8 @@ test failed, it helps to know that the function @code{+} returned 3
here. ERT records the return value for any predicate called directly
within @code{should}.
+@findex should-not@r{, ert macro}
+@findex should-error@r{, ert macro}
In addition to @code{should}, ERT provides @code{should-not}, which
checks that the predicate returns @code{nil}, and @code{should-error}, which
checks that the form called within it signals an error. An example
@@ -424,7 +479,10 @@ default.
@node Expected Failures
@section Expected Failures
+@cindex expected failures
+@cindex known bugs
+@vindex :expected-result
Some bugs are complicated to fix, or not very important, and are left as
@emph{known bugs}. If there is a test case that triggers the bug and
fails, ERT will alert you of this failure every time you run all
@@ -478,6 +536,9 @@ versions, specific architectures, etc.:
@node Tests and Their Environment
@section Tests and Their Environment
+@cindex skipping tests
+@cindex test preconditions
+@cindex preconditions of a test
Sometimes, it doesn't make sense to run a test due to missing
preconditions. A required Emacs feature might not be compiled in, the
function to be tested could call an external binary which might not be
@@ -491,6 +552,7 @@ available on the test machine, you name it. In this case, the macro
...)
@end lisp
+@cindex tests and their environment
The outcome of running a test should not depend on the current state
of the environment, and each test should leave its environment in the
same state it found it in. In particular, a test should not depend on
@@ -545,6 +607,8 @@ hook variables to @code{nil}. This avoids the above problems.
@node Useful Techniques
@section Useful Techniques when Writing Tests
+@cindex useful techniques
+@cindex tips and tricks
Testing simple functions that have no side effects and no dependencies
on their environment is easy. Such tests often look like this:
@@ -582,6 +646,8 @@ Here's a more complicated test:
" signal(ert-test-failed (\"foo\"))")))))))
@end lisp
+@findex make-ert-test
+@findex ert-equal-including-properties
This test creates a test object using @code{make-ert-test} whose body
will immediately signal failure. It then runs that test and asserts
that it fails. Then, it creates a temporary buffer and invokes
@@ -639,6 +705,8 @@ a test failed.
@node Understanding Explanations
@section Understanding Explanations
+@cindex understanding explanations
+@cindex explanations, understanding
Failed @code{should} forms are reported like this:
@@ -706,41 +774,55 @@ function registered. @xref{Defining Explanation Functions}.
@node Interactive Debugging
@section Interactive Debugging
+@cindex interactive debugging
+@cindex debugging failed tests
Debugging failed tests essentially works the same way as debugging any
other problems with Lisp code. Here are a few tricks specific to
tests:
@itemize
-@item Re-run the failed test a few times to see if it fails in the same way
+@cindex re-running a failed test
+@item
+Re-run the failed test a few times to see if it fails in the same way
each time. It's good to find out whether the behavior is
deterministic before spending any time looking for a cause. In the
ERT results buffer, @kbd{r} re-runs the selected test.
-@item Use @kbd{.} to jump to the source code of the test to find out exactly
+@cindex jump to the test source code
+@item
+Use @kbd{.} to jump to the source code of the test to find out exactly
what it does. Perhaps the test is broken rather than the code
under test.
-@item If the test contains a series of @code{should} forms and you can't
+@item
+If the test contains a series of @code{should} forms and you can't
tell which one failed, use @kbd{l}, which shows you the list of all
@code{should} forms executed during the test before it failed.
-@item Use @kbd{b} to view the backtrace. You can also use @kbd{d} to re-run
+@cindex show backtrace of failed test
+@item
+Use @kbd{b} to view the backtrace. You can also use @kbd{d} to re-run
the test with debugging enabled, this will enter the debugger and show
the backtrace as well; but the top few frames shown there will not be
relevant to you since they are ERT's own debugger hook. @kbd{b}
strips them out, so it is more convenient.
-@item If the test or the code under testing prints messages using
+@item
+If the test or the code under testing prints messages using
@code{message}, use @kbd{m} to see what messages it printed before it
failed. This can be useful to figure out how far it got.
-@item You can instrument tests for debugging the same way you instrument
+@cindex instrumenting test for Edebug
+@item
+You can instrument tests for debugging the same way you instrument
@code{defun}s for debugging: go to the source code of the test and
type @kbd{@kbd{C-u} @kbd{C-M-x}}. Then, go back to the ERT buffer and
re-run the test with @kbd{r} or @kbd{d}.
-@item If you have been editing and rearranging tests, it is possible that
+@cindex discard obsolete test results
+@item
+If you have been editing and rearranging tests, it is possible that
ERT remembers an old test that you have since renamed or removed:
renamings or removals of definitions in the source code leave around a
stray definition under the old name in the running process (this is a
@@ -751,6 +833,7 @@ forget about the obsolete test.
@node Extending ERT
@chapter Extending ERT
+@cindex extending ert
There are several ways to add functionality to ERT.
@@ -762,6 +845,7 @@ There are several ways to add functionality to ERT.
@node Defining Explanation Functions
@section Defining Explanation Functions
+@cindex defining explanation functions
The explanation function for a predicate is a function that takes the
same arguments as the predicate and returns an @emph{explanation}.
@@ -772,6 +856,7 @@ comprehensible printed representation. If the return value of the
predicate needs no explanation for a given list of arguments, the
explanation function should return @code{nil}.
+@vindex ert-explainer@r{, property}
To associate an explanation function with a predicate, add the
property @code{ert-explainer} to the symbol that names the predicate.
The value of the property should be the symbol that names the
@@ -780,6 +865,7 @@ explanation function.
@node Low-Level Functions for Working with Tests
@section Low-Level Functions for Working with Tests
+@cindex low-level functions
Both @code{ert-run-tests-interactively} and @code{ert-run-tests-batch}
are implemented on top of the lower-level test handling code in the
@@ -807,6 +893,7 @@ For information on mocks, stubs, fixtures, or test suites, see below.
@node Mocks and Stubs
@section Other Tools for Emacs Lisp
+@cindex mocks and stubs
Stubbing out functions or using so-called @emph{mocks} can make it
easier to write tests. See
@@ -820,6 +907,7 @@ offers mocks for Emacs Lisp and can be used in conjunction with ERT.
@node Fixtures and Test Suites
@section Fixtures and Test Suites
+@cindex fixtures
In many ways, ERT is similar to frameworks for other languages like
SUnit or JUnit. However, two features commonly found in such
@@ -877,6 +965,11 @@ e.g., to run quick tests during interactive development and slow tests less
often. This can be achieved with the @code{:tag} argument to
@code{ert-deftest} and @code{tag} test selectors.
+@node Index
+@unnumbered Index
+
+@printindex cp
+
@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index a7651b21d61..73f9a9562b1 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -142,24 +142,6 @@ Any tool you use often deserves the time spent learning to master it.
looks like: But don't let it fool you; once you know what's going on,
it's easier than it looks: @code{ls -lt **/*.doc(Lk+50aM+5)}.}
-@section What Eshell is not
-@cindex Eshell, what it is not
-@cindex what Eshell is not
-@cindex what isn't Eshell?
-
-Eshell is @emph{not} a replacement for system shells such as
-@command{bash} or @command{zsh}. Use Eshell when you want to move
-text between Emacs and external processes; if you only want to pipe
-output from one external process to another (and then another, and so
-on), use a system shell, because Emacs's IO system is buffer oriented,
-not stream oriented, and is very inefficient at such tasks. If you
-want to write shell scripts in Eshell, don't; either write an elisp
-library or use a system shell.
-
-Some things Eshell just doesn't do well. It fills the niche between
-IELM and your system shell, where the peculiar use-cases lie, and it
-is less than ideal outside that niche.
-
@menu
* Contributors to Eshell:: People who have helped out!
@end menu
@@ -257,7 +239,6 @@ especially for file names with special characters like pipe
(@code{|}), which could be part of remote file names.
@node Built-ins
-
@section Built-in commands
Several commands are built-in in Eshell. In order to call the
external variant of a built-in command @code{foo}, you could call
@@ -276,7 +257,7 @@ alias, @ref{Aliases}. Example:
@example
~ $ which sudo
-eshell/sudo is a compiled Lisp function in `em-unix.el'
+eshell/sudo is a compiled Lisp function in `em-tramp.el'.
~ $ alias sudo '*sudo $*'
~ $ which sudo
sudo is an alias, defined as "*sudo $*"
@@ -437,6 +418,9 @@ Lisp functions, based on successful completion).
@end table
+@ref{Aliases} for the built-in variables @samp{$*}, @samp{$1},
+@samp{$2}, @dots{}, in alias definitions.
+
@node Variables
@section Variables
Since Eshell is just an Emacs REPL@footnote{Read-Eval-Print Loop}, it
@@ -447,15 +431,24 @@ would in an Elisp program. Eshell provides a command version of
@node Aliases
@section Aliases
+@vindex $*
Aliases are commands that expand to a longer input line. For example,
@command{ll} is a common alias for @code{ls -l}, and would be defined
-with the command invocation @samp{alias ll ls -l}; with this defined,
+with the command invocation @kbd{alias ll 'ls -l $*'}; with this defined,
running @samp{ll foo} in Eshell will actually run @samp{ls -l foo}.
Aliases defined (or deleted) by the @command{alias} command are
automatically written to the file named by @code{eshell-aliases-file},
which you can also edit directly (although you will have to manually
reload it).
+@vindex $1, $2, @dots{}
+Note that unlike aliases in Bash, arguments must be handled
+explicitly. Typically the alias definition would end in @samp{$*} to
+pass all arguments along. More selective use of arguments via
+@samp{$1}, @samp{$2}, etc., is also possible. For example,
+@kbd{alias mcd 'mkdir $1 && cd $1'} would cause @kbd{mcd foo} to
+create and switch to a directory called @samp{foo}.
+
@node History
@section History
@cmindex history
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 1bc416fd02e..e2a80bb5f11 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -1,4 +1,4 @@
-\input texinfo @c -*-texinfo-*-
+\input texinfo @c -*-texinfo; coding: utf-8 -*-
@comment %**start of header
@setfilename ../../info/flymake.info
@set VERSION 0.3
@@ -6,6 +6,8 @@
@settitle GNU Flymake @value{VERSION}
@include docstyle.texi
@syncodeindex pg cp
+@syncodeindex vr cp
+@syncodeindex fn cp
@comment %**end of header
@copying
@@ -35,7 +37,7 @@ modify this GNU manual.''
@titlepage
@title GNU Flymake
@subtitle for version @value{VERSION}, @value{UPDATED}
-@author Pavel Kobiakov(@email{pk_at_work@@yahoo.com})
+@author Pavel Kobiakov(@email{pk_at_work@@yahoo.com}) and João Távora.
@page
@vskip 0pt plus 1filll
@insertcopying
@@ -50,307 +52,686 @@ modify this GNU manual.''
@end ifnottex
@menu
-* Overview of Flymake::
-* Installing Flymake::
* Using Flymake::
-* Configuring Flymake::
-* Flymake Implementation::
+* Extending Flymake::
+* The legacy Proc backend::
* GNU Free Documentation License::
* Index::
@end menu
-@node Overview of Flymake
-@chapter Overview
-@cindex Overview of Flymake
-
-Flymake is a universal on-the-fly syntax checker implemented as an
-Emacs minor mode. Flymake runs the pre-configured syntax check tool
-(compiler for C++ files, @code{perl} for perl files, etc.)@: in the
-background, passing it a temporary copy of the current buffer, and
-parses the output for known error/warning message patterns. Flymake
-then highlights erroneous lines (i.e., lines for which at least one
-error or warning has been reported by the syntax check tool), and
-displays an overall buffer status in the mode line. Status information
-displayed by Flymake contains total number of errors and warnings
-reported for the buffer during the last syntax check.
-
-@code{flymake-goto-next-error} and @code{flymake-goto-prev-error}
-functions allow for easy navigation to the next/previous erroneous
-line, respectively.
-
-Calling @code{flymake-display-err-menu-for-current-line} will popup a
-menu containing error messages reported by the syntax check tool for
-the current line. Errors/warnings belonging to another file, such as a
-@code{.h} header file included by a @code{.c} file, are shown in the
-current buffer as belonging to the first line. Menu items for such
-messages also contain a filename and a line number. Selecting such a
-menu item will automatically open the file and jump to the line with
-error.
+@node Using Flymake
+@chapter Using Flymake
+@cindex overview of flymake
+@cindex using flymake
-Syntax check is done ``on-the-fly''. It is started whenever
+Flymake is a universal on-the-fly buffer checker implemented as an
+Emacs minor mode. To use Flymake, you must first activate
+@code{flymake-mode} by using the command @kbd{flymake-mode}.
-@itemize @bullet
-@item buffer is loaded
-@item a newline character is added to the buffer
-@item some changes were made to the buffer more than @code{0.5} seconds ago (the
-delay is configurable).
-@end itemize
+When enabled, Flymake collects information about problems in the
+buffer, called @dfn{diagnostics}, from one or more different sources,
+or @dfn{backends}, and then visually annotates the buffer by
+highlighting problematic buffer regions with a special face.
-Flymake is a universal syntax checker in the sense that it's easily
-extended to support new syntax check tools and error message
-patterns. @xref{Configuring Flymake}.
+It also displays an overall buffer status in the mode line containing
+totals for different types of diagnostics.
+
+Syntax check is done ``on-the-fly''. It is started whenever
-@node Installing Flymake
-@chapter Installing
-@cindex Installing Flymake
+@itemize @bullet
+@item
+@code{flymake-mode} is started, unless
+@code{flymake-start-on-flymake-mode} is nil;
+@item
+a newline character is added to the buffer, unless
+@code{flymake-start-syntax-check-on-newline} is nil;
-Flymake is packaged in a single file, @code{flymake.el}.
+@item
+some changes were made to the buffer more than @code{0.5} seconds ago
+(the delay is configurable in @code{flymake-no-changes-timeout}).
+@end itemize
-To install/update Flymake, place @code{flymake.el} to a directory
-somewhere on Emacs load path. You might also want to byte-compile
-@code{flymake.el} to improve performance.
+Syntax check can also be started manually by typing the @kbd{M-x
+flymake-start @key{RET}} command.
-Also, place the following line in the @code{.emacs} file.
+@code{flymake-goto-next-error} and @code{flymake-goto-prev-error} are
+commands that allow easy navigation to the next/previous erroneous
+line, respectively. If might be a good idea to map them to @kbd{M-n}
+and @kbd{M-p} in @code{flymake-mode}, by adding to your init file:
@lisp
-(require 'flymake)
+(define-key flymake-mode-map (kbd "M-n") 'flymake-goto-next-error)
+(define-key flymake-mode-map (kbd "M-p") 'flymake-goto-prev-error)
@end lisp
-You might also map the most frequently used Flymake functions, such as
-@code{flymake-goto-next-error}, to some keyboard shortcuts:
+Flymake is a universal syntax checker in the sense that it's easily
+extended to support new backends (@pxref{Extending Flymake}).
-@lisp
-(global-set-key [f3] 'flymake-display-err-menu-for-current-line)
-(global-set-key [f4] 'flymake-goto-next-error)
-@end lisp
+Historically, Flymake used to accept diagnostics from a single
+backend, albeit a reasonably flexible one.
-@node Using Flymake
-@chapter Using Flymake
-@cindex Using Flymake
+This backend isn't (yet) obsolete, and so is still available as a
+fallback and active by default (@pxref{The legacy Proc backend}). It works by
+selecting a syntax check tool from a preconfigured list (compiler for
+C@t{++} files, @command{perl} for Perl files, etc.), and executing it in the
+background, passing it a temporary file which is a copy of the current
+buffer, and parsing the output for known error/warning message
+patterns.
@menu
-* Flymake mode::
-* Running the syntax check::
-* Navigating to error lines::
-* Viewing error messages::
* Syntax check statuses::
-* Troubleshooting::
+* Backend exceptions::
+* Customizable variables::
@end menu
-@node Flymake mode
-@section Flymake mode
-@cindex flymake-mode
+@node Syntax check statuses
+@section Syntax check statuses
+@cindex Syntax check statuses
-Flymake is an Emacs minor mode. To use Flymake, you
-must first activate @code{flymake-mode} by using the
-@code{flymake-mode} function.
+When enabled, Flymake displays its status in the mode line, which
+provides a visual summary of diagnostic collection. It may also hint
+at certain exceptional situations encountered when communicating with
+backends.
-Instead of manually activating @code{flymake-mode}, you can configure
-Flymake to automatically enable @code{flymake-mode} upon opening any
-file for which syntax check is possible. To do so, place the following
-line in @code{.emacs}:
+The following statuses are defined:
-@lisp
-(add-hook 'find-file-hook 'flymake-find-file-hook)
-@end lisp
+@multitable @columnfractions 0.25 0.75
+@item [@var{nerrors} @var{nwarnings} ...]
+@tab Normal operation. @var{nerrors} and @var{nwarnings} are, respectively,
+the total number of errors and warnings found during the last buffer
+check, for all backends. They may be followed by other totals for
+other types of diagnostics (@pxref{Flymake error types}).
+
+@item @code{Wait}
+@tab Some Flymake backends haven't reported since the last time they
+where questioned. It is reasonable to assume that this is a temporary
+delay and Flymake will resume normal operation soon.
+
+@item @code{!}
+@tab All the configured Flymake backends have disabled themselves: Flymake
+cannot annotate the buffer and action from the user is needed to
+investigate and remedy the situation (@pxref{Backend exceptions}).
+
+@item @code{?}
+@tab There are no applicable Flymake backends for this buffer, thus Flymake
+cannot annotate it. To fix this, a user may look to extending Flymake
+and add a new backend (@pxref{Extending Flymake}).
+
+@end multitable
-@node Running the syntax check
-@section Running the syntax check
-@cindex Manually starting the syntax check
+@node Backend exceptions
+@section Backend exceptions
+@cindex backend exceptions
+
+@cindex disabled backends
+@cindex backends, disabled
+Some backends may take longer than others to respond or complete, and
+some may decide to @emph{disable} themselves if they are not suitable
+for the current buffer or encounter some unavoidable problem. A
+disabled backend is not tried again for future checks of the current
+buffer.
+
+@findex flymake-reporting-backends
+@findex flymake-running-backends
+@findex flymake-disabled-backends
+The commands @code{flymake-reporting-backends},
+@code{flymake-running-backends} and @code{flymake-disabled-backends}
+show the backends currently used and those which are disabled.
+
+@cindex reset disabled backends
+Toggling @code{flymake-mode} off and on again, or invoking
+@code{flymake-start} with a prefix argument is one way to reset the
+disabled backend list, so that they will be tried again in the next check.
+
+@cindex logging
+@cindex flymake logging
+Flymake also uses a simple logging facility for indicating important
+points in the control flow. The logging facility sends logging
+messages to the @file{*Flymake log*} buffer. The information logged
+can be used for resolving various problems related to Flymake. For
+convenience, a shortcut to this buffer can be found in Flymake's menu,
+accessible from the top menu bar or just left of the status indicator.
+
+@vindex warning-minimum-log-level
+@vindex warning-minimum-level
+Logging output is controlled by the Emacs @code{warning-minimum-log-level}
+and @code{warning-minimum-level} variables.
-When @code{flymake-mode} is active, syntax check is started
-automatically on any of the three conditions mentioned above. Syntax
-check can also be started manually by using the
-@code{flymake-start-syntax-check-for-current-buffer} function. This
-can be used, for example, when changes were made to some other buffer
-affecting the current buffer.
+@node Customizable variables
+@section Customizable variables
+@cindex customizable variables
+@cindex variables for customizing flymake
-@node Navigating to error lines
-@section Navigating to error lines
-@cindex Navigating to error lines
+This section summarizes customization variables used for the
+configuration of the Flymake user interface.
-After syntax check is completed, lines for which at least one error or
-warning has been reported are highlighted, and total number of errors
-and warning is shown in the mode line. Use the following functions to
-navigate the highlighted lines.
+@vtable @code
+@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,
+which resets the timer.
-@multitable @columnfractions 0.25 0.75
+@item flymake-start-syntax-check-on-newline
+A boolean flag indicating whether to start syntax check immediately
+after a newline character is inserted into the buffer.
-@item @code{flymake-goto-next-error}
-@tab Moves point to the next erroneous line, if any.
+@item flymake-start-on-flymake-mode
+A boolean flag indicating whether to start syntax check immediately
+after enabling @code{flymake-mode}.
-@item @code{flymake-goto-prev-error}
-@tab Moves point to the previous erroneous line.
+@item flymake-error
+A custom face for highlighting regions for which an error has been
+reported.
-@end multitable
+@item flymake-warning
+A custom face for highlighting regions for which a warning has been
+reported.
+
+@item flymake-note
+A custom face for highlighting regions for which a note has been
+reported.
+
+@item flymake-error-bitmap
+A bitmap used in the fringe to mark lines for which an error has
+been reported.
-These functions treat erroneous lines as a linked list. Therefore,
-@code{flymake-goto-next-error} will go to the first erroneous line
-when invoked in the end of the buffer.
+@item flymake-warning-bitmap
+A bitmap used in the fringe to mark lines for which a warning has
+been reported.
-@node Viewing error messages
-@section Viewing error messages
-@cindex Viewing error messages
+@item flymake-fringe-indicator-position
+Which fringe (if any) should show the warning/error bitmaps.
-To view error messages belonging to the current line, use the
-@code{flymake-display-err-menu-for-current-line} function. If there's
-at least one error or warning reported for the current line, this
-function will display a popup menu with error/warning texts.
-Selecting the menu item whose error belongs to another file brings
-forward that file with the help of the
-@code{flymake-goto-file-and-line} function.
+@item flymake-wrap-around
+If non-nil, moving to errors with @code{flymake-goto-next-error} and
+@code{flymake-goto-prev-error} wraps around buffer boundaries.
+@end vtable
-@node Syntax check statuses
-@section Syntax check statuses
-@cindex Syntax check statuses
+@node Extending Flymake
+@chapter Extending Flymake
+@cindex extending flymake
-After syntax check is finished, its status is displayed in the mode line.
-The following statuses are defined.
+Flymake can primarily be extended in one of two ways:
-@multitable @columnfractions 0.25 0.75
-@item Flymake* or Flymake:E/W*
-@tab Flymake is currently running. For the second case, E/W contains the
-error and warning count for the previous run.
-
-@item Flymake
-@tab Syntax check is not running. Usually this means syntax check was
-successfully passed (no errors, no warnings). Other possibilities are:
-syntax check was killed as a result of executing
-@code{flymake-compile}, or syntax check cannot start as compilation
-is currently in progress.
-
-@item Flymake:E/W
-@tab Number of errors/warnings found by the syntax check process.
-
-@item Flymake:!
-@tab Flymake was unable to find master file for the current buffer.
-@end multitable
+@enumerate
+@item
+By changing the look and feel of the annotations produced by the
+different backends.
-The following errors cause a warning message and switch flymake mode
-OFF for the buffer.
+@item
+By adding a new buffer-checking backend.
+@end enumerate
-@multitable @columnfractions 0.25 0.75
-@item CFGERR
-@tab Syntax check process returned nonzero exit code, but no
-errors/warnings were reported. This indicates a possible configuration
-error (for example, no suitable error message patterns for the
-syntax check tool).
+The following sections discuss each approach in detail.
-@item NOMASTER
-@tab Flymake was unable to find master file for the current buffer.
+@menu
+* Flymake error types::
+* Backend functions::
+@end menu
-@item NOMK
-@tab Flymake was unable to find a suitable buildfile for the current buffer.
+@node Flymake error types
+@section Customizing Flymake error types
+@cindex customizing error types
+@cindex error types, customization
-@item PROCERR
-@tab Flymake was unable to launch a syntax check process.
-@end multitable
+@vindex flymake-diagnostic-types-alist
+The variable @code{flymake-diagnostic-types-alist} is looked up by
+Flymake every time an annotation for a diagnostic is created in the
+buffer. Specifically, this variable holds a table of correspondence
+between symbols designating diagnostic types and an additional
+sub-table of properties pertaining to each diagnostic type.
+
+Both tables are laid out in association list (@pxref{Association
+Lists,,, elisp, The Emacs Lisp Reference Manual}) format, and thus can
+be conveniently accessed with the functions of the @code{assoc}
+family.
+
+You can use any symbol-value association in the properties sub-table,
+but some symbols have special meaning as to where and how Flymake
+presents the diagnostic:
+
+@itemize
+
+@item
+@cindex bitmap of diagnostic
+@code{bitmap}, an image displayed in the fringe according to
+@code{flymake-fringe-indicator-position}. The value actually follows
+the syntax of @code{flymake-error-bitmap} (@pxref{Customizable
+variables}). It is overridden by any @code{before-string} overlay
+property.
+
+@item
+@cindex severity of diagnostic
+@code{severity} is a non-negative integer specifying the diagnostic's
+severity. The higher the value, the more serious is the error. If
+the overlay property @code{priority} is not specified, @code{severity}
+is used to set it and help sort overlapping overlays.
+@item
+Every property pertaining to overlays (@pxref{Overlay Properties,,,
+elisp, The Emacs Lisp Reference Manual}), except @code{category} and
+@code{evaporate}. These properties are used to affect the appearance
+of Flymake annotations.
-@node Troubleshooting
-@section Troubleshooting
-@cindex Logging
-@cindex Troubleshooting
+As an example, here's how to make errors (diagnostics of the type
+@code{:error}) stand out even more prominently in the buffer, by
+raising the characters using a @code{display} overlay property.
-Flymake uses a simple logging facility for indicating important points
-in the control flow. The logging facility sends logging messages to
-the @file{*Messages*} buffer. The information logged can be used for
-resolving various problems related to Flymake.
+@example
+(push '(display . (raise 1.2))
+ (cdr (assoc :error flymake-diagnostic-types-alist)))
+@end example
-Logging output is controlled by the @code{flymake-log-level}
-variable. @code{3} is the most verbose level, and @code{-1} switches
-logging off.
+@item
+@vindex flymake-category
+@code{flymake-category} is a symbol whose property list is considered
+the default for missing values of any other properties.
+@end itemize
-@node Configuring Flymake
-@chapter Configuring and Extending Flymake
-@cindex Configuring and Extending Flymake
+@cindex predefined diagnostic types
+@vindex flymake-error
+@vindex flymake-warning
+@vindex flymake-note
+Three default diagnostic types, @code{:error}, @code{:warning} and
+@code{:note} are predefined in
+@code{flymake-diagnostic-types-alist}. By default each lists a single
+@code{flymake-category} property whose value is, respectively, the
+symbols @code{flymake-error}, @code{flymake-warning} and
+@code{flymake-note}.
+
+These category symbols' plists is where the values of customizable
+variables and faces such as @code{flymake-error-bitmap} are found.
+Thus, if you change their plists, Flymake may stop honoring these
+user customizations.
+
+The @code{flymake-category} special property is also especially useful
+for backends which create diagnostics objects with non-default
+types that differ from an existing type by only a few properties
+(@pxref{Flymake utility functions}).
+
+As an example, consider configuring a new diagnostic type
+@code{:low-priority-note} that behaves much like the @code{:note}
+priority but without an overlay face.
+
+@example
+(add-to-list
+ 'flymake-diagnostic-types-alist
+ `(:low-priority-note . ((face . nil)
+ (flymake-category . flymake-note))))
+@end example
+
+@vindex flymake-diagnostics
+@vindex flymake-diagnostic-backend
+@vindex flymake-diagnostic-buffer
+@vindex flymake-diagnostic-text
+@vindex flymake-diagnostic-beg
+@vindex flymake-diagnostic-end
+As you might have guessed, Flymake's annotations are implemented as
+overlays (@pxref{Overlays,,, elisp, The Emacs Lisp Reference Manual}).
+Along with the properties that you specify for the specific type of
+diagnostic, Flymake adds the property @code{flymake-diagnostic} to
+these overlays, and sets it to the object that the backend created
+with @code{flymake-make-diagnostic}.
+
+Since overlays also support arbitrary keymaps, you can use this along
+with the functions @code{flymake-diagnostics} and
+@code{flymake-diagnostic-text} (@pxref{Flymake utility functions}) to
+create interactive annotations, such as in the following example of
+binding a @code{mouse-3} event (middle mouse button click) to an
+Internet search for the text of a @code{:warning} or @code{:error}.
+
+@example
+(defun my-search-for-message (event)
+ (interactive "e")
+ (let* ((diags (flymake-diagnostics (posn-point (event-start event))))
+ (topmost-diag (car diags)))
+ (eww-browse-url
+ (concat
+ "https://duckduckgo.com/?q="
+ (replace-regexp-in-string " "
+ "+"
+ (flymake-diagnostic-text topmost-diag)))
+ t)))
+
+(dolist (type '(:warning :error))
+ (let ((a (assoc type flymake-diagnostic-types-alist)))
+ (setf (cdr a)
+ (append `((mouse-face . highlight)
+ (keymap . ,(let ((map (make-sparse-keymap)))
+ (define-key map [mouse-2]
+ 'my-search-for-message)
+ map)))
+ (cdr a)))))
+@end example
+
+@node Backend functions
+@section Backend functions
+@cindex backend functions
+
+@vindex flymake-diagnostic-functions
+Flymake backends are Lisp functions placed in the special hook
+@code{flymake-diagnostic-functions}.
+
+A backend's responsibility is to diagnose the contents of a buffer for
+problems, registering the problem's positions, type, and summary
+description. This information is collected in the form of diagnostic
+objects created by the function @code{flymake-make-diagnostic}
+(@pxref{Flymake utility functions}), and
+then handed over to Flymake, which proceeds to annotate the
+buffer.
+
+A request for a buffer check, and the subsequent delivery of
+diagnostics, are two key events of the interaction between Flymake
+and backend. Each such event corresponds to a well-defined function
+calling convention: one for calls made by Flymake into the backend via
+the backend function, the other in the reverse direction via a
+callback. To be usable, backends must adhere to both.
+
+Backend functions must accept an arbitrary number of arguments:
+
+@itemize
+@item
+the first argument is always @var{report-fn}, a callback function
+detailed below;
+
+@item
+the remaining arguments are keyword-value pairs of the
+form @w{@code{(@var{:key} @var{value} @var{:key2} @var{value2}...)}}. Currently,
+Flymake provides no such arguments, but backend functions must be
+prepared to accept (and possibly ignore) any number of them.
+@end itemize
+
+Whenever Flymake or the user decide to re-check the buffer, backend
+functions are called as detailed above, and are expected to initiate
+this check, but aren't in any way required to complete it before
+exiting: if the computation involved is expensive, as
+is often the case with large buffers, that slower task should be
+scheduled for the future using asynchronous sub-processes
+(@pxref{Asynchronous Processes,,, elisp, The Emacs Lisp reference
+manual}) or other asynchronous mechanisms.
+
+In any case, backend functions are expected to return quickly or
+signal an error, in which case the backend is disabled
+(@pxref{Backend exceptions}).
+
+If the function returns, Flymake considers the backend to be
+@dfn{running}. If it has not done so already, the backend is expected
+to call the function @var{report-fn} passed to it, at which point
+Flymake considers the backend to be @dfn{reporting}. Backends call
+@var{report-fn} by passing it a single argument @var{report-action}
+followed by an optional list of keyword-value pairs of the form
+@w{@code{(@var{:report-key} @var{value} @var{:report-key2} @var{value2}...)}}.
+
+Currently accepted values for @var{report-action} are:
+
+@itemize
+@item
+A (possibly empty) list of diagnostic objects created by
+@code{flymake-make-diagnostic}, causing Flymake to annotate the
+buffer with this information.
+
+A backend may call @var{report-fn} repeatedly in this manner, but only
+until Flymake considers that the most recently requested buffer check
+is now obsolete, because, say, buffer contents have changed in the
+meantime. The backend is only given notice of this via a renewed call
+to the backend function. Thus, to prevent making obsolete reports and
+wasting resources, backend functions should first cancel any ongoing
+processing from previous calls.
+
+@item
+The symbol @code{:panic}, signaling that the backend has encountered
+an exceptional situation and should be disabled.
+@end itemize
+
+Currently accepted @var{report-key} arguments are:
+
+@itemize
+@item
+@code{:explanation}, whose value should give user-readable
+details of the situation encountered, if any.
+
+@item
+@code{:force}, whose value should be a boolean suggesting
+that Flymake consider the report even if it was somehow
+unexpected.
+@end itemize
@menu
-* Customizable variables::
-* Adding support for a new syntax check tool::
+* Flymake utility functions::
+* An annotated example backend::
@end menu
-Flymake was designed to be easily extended for supporting new syntax
-check tools and error message patterns.
+@node Flymake utility functions
+@subsection Flymake utility functions
+@cindex utility functions
+
+@cindex create diagnostic object
+Before delivering them to Flymake, backends create diagnostic objects
+by calling the function @code{flymake-make-diagnostic}.
+
+@deffn Function flymake-make-diagnostic buffer beg end type text
+Make a Flymake diagnostic for @var{buffer}'s region from @var{beg} to
+@var{end}. @var{type} is a key to
+@code{flymake-diagnostic-types-alist} and @var{text} is a description
+of the problem detected in this region.
+@end deffn
+
+@cindex access diagnostic object
+These objects' properties can be accessed with the functions
+@code{flymake-diagnostic-backend}, @code{flymake-diagnostic-buffer},
+@code{flymake-diagnostic-text}, @code{flymake-diagnostic-beg},
+@code{flymake-diagnostic-end} and @code{flymake-diagnostic-type}.
+
+Additionally, the function @code{flymake-diagnostics} will collect
+such objects in the region you specify.
+
+@cindex collect diagnostic objects
+@deffn Function flymake-diagnostics beg end
+Get a list of Flymake diagnostics in the region determined by
+@var{beg} and @var{end}. If neither @var{beg} or @var{end} is
+supplied, use the whole buffer, otherwise if @var{beg} is
+non-@code{nil} and @var{end} is @code{nil}, consider only diagnostics
+at @var{beg}.
+@end deffn
+
+@cindex buffer position from line and column number
+It is often the case with external syntax tools that a diagnostic's
+position is reported in terms of a line number, and sometimes a column
+number. To convert this information into a buffer position, backends
+can use the following function:
+
+@deffn Function flymake-diag-region buffer line &optional col
+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.
+@end deffn
+
+@cindex add a log message
+For troubleshooting purposes, backends may record arbitrary
+exceptional or erroneous situations into the Flymake log
+buffer (@pxref{Backend exceptions}):
+
+@deffn Macro flymake-log level msg &optional args
+Log, at level @var{level}, the message @var{msg} formatted with
+@var{args}. @var{level} is passed to @code{display-warning}
+(@pxref{Warning Basics,,, elisp, The Emacs Lisp reference Manual}), which is
+used to display the warning in Flymake's log buffer.
+@end deffn
+
+@node An annotated example backend
+@subsection An annotated example backend
+@cindex example of backend
+@cindex backend, annotated example
+
+This section presents an annotated example of a complete working
+Flymake backend. The example illustrates the process of writing a
+backend as outlined above.
+
+The backend in question is used for checking Ruby source files. It
+uses asynchronous sub-processes (@pxref{Asynchronous Processes,,, elisp,
+The Emacs Lisp Reference Manual}), a common technique for performing
+parallel processing in Emacs.
+
+The following code needs lexical binding (@pxref{Using Lexical
+Binding,,, elisp, The Emacs Lisp Reference Manual}) to be active.
+
+@example
+;;; ruby-flymake.el --- A ruby Flymake backend -*- lexical-binding: t; -*-
+(defvar-local ruby--flymake-proc nil)
+
+(defun ruby-flymake (report-fn &rest _args)
+ ;; Not having a ruby interpreter is a serious problem which should cause
+ ;; the backend to disable itself, so an @code{error} is signaled.
+ ;;
+ (unless (executable-find
+ "ruby") (error "Cannot find a suitable ruby"))
+ ;; If a live process launched in an earlier check was found, that
+ ;; process is killed. When that process's sentinel eventually runs,
+ ;; it will notice its obsoletion, since it have since reset
+ ;; `ruby-flymake-proc' to a different value
+ ;;
+ (when (process-live-p ruby--flymake-proc)
+ (kill-process ruby--flymake-proc))
+
+ ;; Save the current buffer, the narrowing restriction, remove any
+ ;; narrowing restriction.
+ ;;
+ (let ((source (current-buffer)))
+ (save-restriction
+ (widen)
+ ;; Reset the `ruby--flymake-proc' process to a new process
+ ;; calling the ruby tool.
+ ;;
+ (setq
+ ruby--flymake-proc
+ (make-process
+ :name "ruby-flymake" :noquery t :connection-type 'pipe
+ ;; Make output go to a temporary buffer.
+ ;;
+ :buffer (generate-new-buffer " *ruby-flymake*")
+ :command '("ruby" "-w" "-c")
+ :sentinel
+ (lambda (proc _event)
+ ;; Check that the process has indeed exited, as it might
+ ;; be simply suspended.
+ ;;
+ (when (eq 'exit (process-status proc))
+ (unwind-protect
+ ;; Only proceed if `proc' is the same as
+ ;; `ruby--flymake-proc', which indicates that
+ ;; `proc' is not an obsolete process.
+ ;;
+ (if (with-current-buffer source (eq proc ruby--flymake-proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ ;; Parse the output buffer for diagnostic's
+ ;; messages and locations, collect them in a list
+ ;; of objects, and call `report-fn'.
+ ;;
+ (cl-loop
+ while (search-forward-regexp
+ "^\\(?:.*.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$"
+ nil t)
+ for msg = (match-string 2)
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number (match-string 1)))
+ for type = (if (string-match "^warning" msg)
+ :warning
+ :error)
+ collect (flymake-make-diagnostic source
+ beg
+ end
+ type
+ msg)
+ into diags
+ finally (funcall report-fn diags)))
+ (flymake-log :warning "Canceling obsolete check %s"
+ proc))
+ ;; Cleanup the temporary buffer used to hold the
+ ;; check's output.
+ ;;
+ (kill-buffer (process-buffer proc)))))))
+ ;; Send the buffer contents to the process's stdin, followed by
+ ;; an EOF.
+ ;;
+ (process-send-region ruby--flymake-proc (point-min) (point-max))
+ (process-send-eof ruby--flymake-proc))))
+
+(defun ruby-setup-flymake-backend ()
+ (add-hook 'flymake-diagnostic-functions 'ruby-flymake nil t))
+
+(add-hook 'ruby-mode-hook 'ruby-setup-flymake-backend)
+@end example
+
+@node The legacy Proc backend
+@chapter The legacy ``Proc'' backend
+@cindex legacy proc backend
-@node Customizable variables
-@section Customizable variables
-@cindex Customizable variables
+@menu
+* Proc customization variables::
+* Adding support for a new syntax check tool::
+* Implementation overview::
+* Making a temporary copy::
+* Locating a master file::
+* Getting the include directories::
+* Locating the buildfile::
+* Starting the syntax check process::
+* Parsing the output::
+* Interaction with other modes::
+@end menu
-This section summarizes variables used for Flymake
-configuration.
+@findex flymake-proc-legacy-backend
+The backend @code{flymake-proc-legacy-backend} was originally designed
+to be extended for supporting new syntax check tools and error message
+patterns. It is also controlled by its own set of customization variables
-@table @code
-@item flymake-log-level
-Controls logging output, see @ref{Troubleshooting}.
+@node Proc customization variables
+@section Customization variables for the Proc backend
+@cindex proc backend customization variables
-@item flymake-allowed-file-name-masks
+@vtable @code
+@item flymake-proc-allowed-file-name-masks
A list of @code{(filename-regexp, init-function, cleanup-function
getfname-function)} for configuring syntax check tools. @xref{Adding
support for a new syntax check tool}.
-@ignore
-@item flymake-buildfile-dirs
-A list of directories (relative paths) for searching a
-buildfile. @xref{Locating the buildfile}.
-@end ignore
-
-@item flymake-master-file-dirs
+@item flymake-proc-master-file-dirs
A list of directories for searching a master file. @xref{Locating a
master file}.
-@item flymake-get-project-include-dirs-function
+@item flymake-proc-get-project-include-dirs-function
A function used for obtaining a list of project include dirs (C/C++
specific). @xref{Getting the include directories}.
-@item flymake-master-file-count-limit
-@itemx flymake-check-file-limit
+@item flymake-proc-master-file-count-limit
+@itemx flymake-proc-check-file-limit
Used when looking for a master file. @xref{Locating a master file}.
-@item flymake-err-line-patterns
+@item flymake-proc-err-line-patterns
Patterns for error/warning messages in the form @code{(regexp file-idx
line-idx col-idx err-text-idx)}. @xref{Parsing the output}.
-@item flymake-warning-predicate
-Predicate to classify error text as warning. @xref{Parsing the output}.
-
-@item flymake-compilation-prevents-syntax-check
+@item flymake-proc-diagnostic-type-pred
+A function to classify a diagnostic text as particular type of
+error. Should be a function taking an error text and returning one of
+the symbols indexing @code{flymake-diagnostic-types-alist}. If non-nil
+is returned but there is no such symbol in that table, a warning is
+assumed. If nil is returned, an error is assumed. Can also be a
+regular expression that should match only warnings. This variable
+replaces the old @code{flymake-warning-re} and
+@code{flymake-warning-predicate}.
+
+@item flymake-proc-compilation-prevents-syntax-check
A flag indicating whether compilation and syntax check of the same
-file cannot be run simultaneously.
-
-@item flymake-no-changes-timeout
-If any changes are made to the buffer, syntax check is automatically
-started after @code{flymake-no-changes-timeout} seconds.
-
-@item flymake-start-syntax-check-on-newline
-A boolean flag indicating whether to start syntax check after a
-newline character is added to the buffer.
-
-@item flymake-errline
-A custom face for highlighting lines for which at least one error has
-been reported.
-
-@item flymake-warnline
-A custom face for highlighting lines for which at least one warning
-and no errors have been reported.
-
-@item flymake-error-bitmap
-A bitmap used in the fringe to mark lines for which an error has
-been reported.
-
-@item flymake-warning-bitmap
-A bitmap used in the fringe to mark lines for which a warning has
-been reported.
-
-@item flymake-fringe-indicator-position
-Which fringe (if any) should show the warning/error bitmaps.
-
-@end table
+file cannot be run simultaneously. @xref{Interaction with other modes}.
+@end vtable
@node Adding support for a new syntax check tool
@section Adding support for a new syntax check tool
-@cindex Adding support for a new syntax check tool
+@cindex adding support for a new syntax check tool
@menu
* Example---Configuring a tool called directly::
@@ -358,7 +739,7 @@ Which fringe (if any) should show the warning/error bitmaps.
@end menu
Syntax check tools are configured using the
-@code{flymake-allowed-file-name-masks} list. Each item of this list
+@code{flymake-proc-allowed-file-name-masks} list. Each item of this list
has the following format:
@lisp
@@ -369,15 +750,15 @@ has the following format:
@item filename-regexp
This field is used as a key for locating init/cleanup/getfname
functions for the buffer. Items in
-@code{flymake-allowed-file-name-masks} are searched sequentially. The
-first item with @code{filename-regexp} matching buffer filename is
+@code{flymake-proc-allowed-file-name-masks} are searched sequentially.
+The first item with @code{filename-regexp} matching buffer filename is
selected. If no match is found, @code{flymake-mode} is switched off.
@item init-function
@code{init-function} is required to initialize the syntax check,
usually by creating a temporary copy of the buffer contents. The
function must return @code{(list cmd-name arg-list)}. If
-@code{init-function} returns null, syntax check is aborted, by
+@code{init-function} returns null, syntax check is aborted, but
@code{flymake-mode} is not switched off.
@item cleanup-function
@@ -390,90 +771,89 @@ This function is used for translating filenames reported by the syntax
check tool into ``real'' filenames. Filenames reported by the tool
will be different from the real ones, as actually the tool works with
the temporary copy. In most cases, the default implementation
-provided by Flymake, @code{flymake-get-real-file-name}, can be used as
-@code{getfname-function}.
-
+provided by Flymake, @code{flymake-proc-get-real-file-name}, can be
+used as @code{getfname-function}.
@end table
-To add support for a new syntax check tool, write corresponding
-@code{init-function}, and, optionally @code{cleanup-function} and
+To add support for a new syntax check tool, write the corresponding
+@code{init-function} and, optionally, @code{cleanup-function} and
@code{getfname-function}. If the format of error messages reported by
the new tool is not yet supported by Flymake, add a new entry to
-the @code{flymake-err-line-patterns} list.
+the @code{flymake-proc-err-line-patterns} list.
The following sections contain some examples of configuring Flymake
support for various syntax check tools.
@node Example---Configuring a tool called directly
@subsection Example---Configuring a tool called directly
-@cindex Adding support for perl
+@cindex adding support for perl
-In this example, we will add support for @code{perl} as a syntax check
-tool. @code{perl} supports the @code{-c} option which does syntax
+In this example, we will add support for @command{perl} as a syntax check
+tool. @command{perl} supports the @option{-c} option which does syntax
checking.
First, we write the @code{init-function}:
@lisp
-(defun flymake-perl-init ()
- (let* ((temp-file (flymake-init-create-temp-buffer-copy
- 'flymake-create-temp-inplace))
+(defun flymake-proc-perl-init ()
+ (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy
+ 'flymake-proc-create-temp-inplace))
(local-file (file-relative-name
temp-file
(file-name-directory buffer-file-name))))
(list "perl" (list "-wc " local-file))))
@end lisp
-@code{flymake-perl-init} creates a temporary copy of the buffer
+@code{flymake-proc-perl-init} creates a temporary copy of the buffer
contents with the help of
-@code{flymake-init-create-temp-buffer-copy}, and builds an appropriate
+@code{flymake-proc-init-create-temp-buffer-copy}, and builds an appropriate
command line.
Next, we add a new entry to the
-@code{flymake-allowed-file-name-masks}:
+@code{flymake-proc-allowed-file-name-masks}:
@lisp
-(setq flymake-allowed-file-name-masks
+(setq flymake-proc-allowed-file-name-masks
(cons '(".+\\.pl$"
- flymake-perl-init
- flymake-simple-cleanup
- flymake-get-real-file-name)
- flymake-allowed-file-name-masks))
+ flymake-proc-perl-init
+ flymake-proc-simple-cleanup
+ flymake-proc-get-real-file-name)
+ flymake-proc-allowed-file-name-masks))
@end lisp
Note that we use standard @code{cleanup-function} and
@code{getfname-function}.
-Finally, we add an entry to @code{flymake-err-line-patterns}:
+Finally, we add an entry to @code{flymake-proc-err-line-patterns}:
@lisp
-(setq flymake-err-line-patterns
+(setq flymake-proc-err-line-patterns
(cons '("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]"
2 3 nil 1)
- flymake-err-line-patterns))
+ flymake-proc-err-line-patterns))
@end lisp
@node Example---Configuring a tool called via make
@subsection Example---Configuring a tool called via make
-@cindex Adding support for C (gcc+make)
+@cindex adding support for C (gcc+make)
In this example we will add support for C files syntax checked by
@command{gcc} called via @command{make}.
We're not required to write any new functions, as Flymake already has
functions for @command{make}. We just add a new entry to the
-@code{flymake-allowed-file-name-masks}:
+@code{flymake-proc-allowed-file-name-masks}:
@lisp
-(setq flymake-allowed-file-name-masks
+(setq flymake-proc-allowed-file-name-masks
(cons '(".+\\.c$"
- flymake-simple-make-init
- flymake-simple-cleanup
- flymake-get-real-file-name)
- flymake-allowed-file-name-masks))
+ flymake-proc-simple-make-init
+ flymake-proc-simple-cleanup
+ flymake-proc-get-real-file-name)
+ flymake-proc-allowed-file-name-masks))
@end lisp
-@code{flymake-simple-make-init} builds the following @command{make}
+@code{flymake-proc-simple-make-init} builds the following @command{make}
command line:
@lisp
@@ -485,14 +865,15 @@ command line:
"check-syntax"))
@end lisp
-@code{base-dir} is a directory containing @code{Makefile}, see @ref{Locating the buildfile}.
+@code{base-dir} is a directory containing the @file{Makefile}, see
+@ref{Locating the buildfile}.
-Thus, @code{Makefile} must contain the @code{check-syntax} target. In
+Thus, @file{Makefile} must contain the @code{check-syntax} target. In
our case this target might look like this:
@verbatim
check-syntax:
- gcc -o /dev/null -S ${CHK_SOURCES}
+ gcc -o /dev/null -S ${CHK_SOURCES} || true
@end verbatim
@noindent
@@ -504,42 +885,25 @@ Automake variable @code{COMPILE}:
@verbatim
check-syntax:
- $(COMPILE) -o /dev/null -S ${CHK_SOURCES}
+ $(COMPILE) -o /dev/null -S ${CHK_SOURCES} || true
@end verbatim
-@node Flymake Implementation
-@chapter Flymake Implementation
-@cindex Implementation details
+@node Implementation overview
+@section Implementation overview
+@cindex syntax check models
+@cindex master file
-@menu
-* Determining whether syntax check is possible::
-* Making a temporary copy::
-* Locating a master file::
-* Getting the include directories::
-* Locating the buildfile::
-* Starting the syntax check process::
-* Parsing the output::
-* Highlighting erroneous lines::
-* Interaction with other modes::
-@end menu
-
-Syntax check is started by calling @code{flymake-start-syntax-check-for-current-buffer}.
-Flymake first determines whether it is able to do syntax
-check. It then saves a copy of the buffer in a temporary file in the
-buffer's directory (or in the system temp directory, for java
-files), creates a syntax check command and launches a process with
-this command. The output is parsed using a list of error message patterns,
-and error information (file name, line number, type and text) is
-saved. After the process has finished, Flymake highlights erroneous
-lines in the buffer using the accumulated error information.
-
-@node Determining whether syntax check is possible
-@section Determining whether syntax check is possible
-@cindex Syntax check models
-@cindex Master file
+@code{flymake-proc-legacy-backend} saves a copy of the buffer in a
+temporary file in the buffer's directory (or in the system temporary
+directory, for Java files), creates a syntax check command and
+launches a process with this command. The output is parsed using a
+list of error message patterns, and error information (file name, line
+number, type and text) is saved. After the process has finished,
+Flymake highlights erroneous lines in the buffer using the accumulated
+error information.
Syntax check is considered possible if there's an entry in
-@code{flymake-allowed-file-name-masks} matching buffer's filename and
+@code{flymake-proc-allowed-file-name-masks} matching buffer's filename and
its @code{init-function} returns non-@code{nil} value.
Two syntax check modes are distinguished:
@@ -549,31 +913,30 @@ Two syntax check modes are distinguished:
@item
Buffer can be syntax checked in a standalone fashion, that is, the
file (its temporary copy, in fact) can be passed over to the compiler to
-do the syntax check. Examples are C/C++ (.c, .cpp) and Java (.java)
-sources.
+do the syntax check. Examples are C/C@t{++} sources (@file{.c},
+@file{.cpp}) and Java (@file{.java}).
@item
Buffer can be syntax checked, but additional file, called master file,
is required to perform this operation. A master file is a file that
includes the current file, so that running a syntax check tool on it
-will also check syntax in the current file. Examples are C/C++ (.h,
-.hpp) headers.
+will also check syntax in the current file. Examples are C/C@t{++}
+headers (@file{.h}, @file{.hpp}).
@end enumerate
These modes are handled inside init/cleanup/getfname functions, see
@ref{Adding support for a new syntax check tool}.
-Flymake contains implementations of all functionality required to
-support different syntax check modes described above (making temporary
-copies, finding master files, etc.), as well as some tool-specific
-(routines for Make, Ant, etc.)@: code.
+The Proc backend contains implementations of all functionality
+required to support different syntax check modes described above
+(making temporary copies, finding master files, etc.), as well as some
+tool-specific (routines for Make, Ant, etc.)@: code.
@node Making a temporary copy
@section Making a temporary copy
-@cindex Temporary copy of the buffer
-@cindex Master file
+@cindex temporary copy of the buffer
After the possibility of the syntax check has been determined, a
temporary copy of the current buffer is made so that the most recent
@@ -585,9 +948,10 @@ Things get trickier, however, when master file is involved, as it
requires to
@itemize @bullet
-@item locate a master file
-@item patch it to include the current file using its new (temporary)
-name.
+@item
+locate a master file
+@item
+patch it to include the current file using its new (temporary) name.
@end itemize
Locating a master file is discussed in the following section.
@@ -603,46 +967,49 @@ the syntax check tool.
@node Locating a master file
@section Locating a master file
-@cindex Master file
+@cindex locating a master file
+@cindex master file, locating
Master file is located in two steps.
First, a list of possible master files is built. A simple name
-matching is used to find the files. For a C++ header @code{file.h},
-Flymake searches for all @code{.cpp} files in the directories whose relative paths are
-stored in a customizable variable @code{flymake-master-file-dirs}, which
-usually contains something like @code{("." "./src")}. No more than
-@code{flymake-master-file-count-limit} entries is added to the master file
-list. The list is then sorted to move files with names @code{file.cpp} to
-the top.
+matching is used to find the files. For a C++ header @file{file.h},
+the Proc backend searches for all @file{.cpp} files in the directories
+whose relative paths are stored in a customizable variable
+@code{flymake-proc-master-file-dirs}, which usually contains something
+like @code{("." "./src")}. No more than
+@code{flymake-proc-master-file-count-limit} entries is added to the
+master file list. The list is then sorted to move files with names
+@file{file.cpp} to the top.
Next, each master file in a list is checked to contain the appropriate
-include directives. No more than @code{flymake-check-file-limit} of each
+include directives. No more than @code{flymake-proc-check-file-limit} of each
file are parsed.
-For @code{file.h}, the include directives to look for are
+For @file{file.h}, the include directives to look for are
@code{#include "file.h"}, @code{#include "../file.h"}, etc. Each
include is checked against a list of include directories
(see @ref{Getting the include directories}) to be sure it points to the
-correct @code{file.h}.
+correct @file{file.h}.
First matching master file found stops the search. The master file is then
patched and saved to disk. In case no master file is found, syntax check is
-aborted, and corresponding status (!) is reported in the mode line.
+aborted, and corresponding status (@samp{!}) is reported in the mode line.
+@xref{Syntax check statuses}.
@node Getting the include directories
@section Getting the include directories
-@cindex Include directories (C/C++ specific)
+@cindex include directories (C/C++ specific)
Two sets of include directories are distinguished: system include directories
and project include directories. The former is just the contents of the
@code{INCLUDE} environment variable. The latter is not so easy to obtain,
and the way it can be obtained can vary greatly for different projects.
Therefore, a customizable variable
-@code{flymake-get-project-include-dirs-function} is used to provide the
+@code{flymake-proc-get-project-include-dirs-function} is used to provide the
way to implement the desired behavior.
-The default implementation, @code{flymake-get-project-include-dirs-imp},
+The default implementation, @code{flymake-proc-get-project-include-dirs-imp},
uses a @command{make} call. This requires a correct base directory, that is, a
directory containing a correct @file{Makefile}, to be determined.
@@ -652,123 +1019,98 @@ of every syntax check attempt.
@node Locating the buildfile
@section Locating the buildfile
-@cindex Locating the buildfile
+@cindex locating the buildfile
@cindex buildfile, locating
@cindex Makefile, locating
-Flymake can be configured to use different tools for performing syntax
-checks. For example, it can use direct compiler call to syntax check a perl
-script or a call to @command{make} for a more complicated case of a
-@code{C/C++} source. The general idea is that simple files, like perl
-scripts and html pages, can be checked by directly invoking a
-corresponding tool. Files that are usually more complex and generally
-used as part of larger projects, might require non-trivial options to
-be passed to the syntax check tool, like include directories for
-C++. The latter files are syntax checked using some build tool, like
-Make or Ant.
+The Proc backend can be configured to use different tools for
+performing syntax checks. For example, it can use direct compiler
+call to syntax check a perl script or a call to @command{make} for a
+more complicated case of a C/C@t{++} source. The general idea is
+that simple files, like Perl scripts and @acronym{HTML} pages, can be checked by
+directly invoking a corresponding tool. Files that are usually more
+complex and generally used as part of larger projects, might require
+non-trivial options to be passed to the syntax check tool, like
+include directories for C@t{++}. The latter files are syntax checked
+using some build tool, like Make or Ant.
All Make configuration data is usually stored in a file called
-@code{Makefile}. To allow for future extensions, flymake uses a notion of
-buildfile to reference the 'project configuration' file.
+@file{Makefile}. To allow for future extensions, Flymake uses a notion of
+buildfile to reference the @dfn{project configuration} file.
-Special function, @code{flymake-find-buildfile} is provided for locating buildfiles.
+@findex flymake-proc-find-buildfile
+Special function, @code{flymake-proc-find-buildfile} is provided for locating buildfiles.
Searching for a buildfile is done in a manner similar to that of searching
for possible master files.
@ignore
A customizable variable
-@code{flymake-buildfile-dirs} holds a list of relative paths to the
+@code{flymake-proc-buildfile-dirs} holds a list of relative paths to the
buildfile. They are checked sequentially until a buildfile is found.
@end ignore
-In case there's no build file, syntax check is aborted.
+In case there's no build file, the syntax check is aborted.
Buildfile values are also cached.
@node Starting the syntax check process
@section Starting the syntax check process
-@cindex Syntax check process
+@cindex syntax check process, legacy proc backend
-The command line (command name and the list of arguments) for launching a process is returned by the
-initialization function. Flymake then just calls @code{start-process}
-to start an asynchronous process and configures a process filter and
-sentinel, which are used for processing the output of the syntax check
-tool. When exiting Emacs, running Flymake processes will be killed
-without prompting the user.
+The command line (command name and the list of arguments) for
+launching a process is returned by the initialization function. The
+Proc backend then just starts an asynchronous process and configures a
+process filter and sentinel, which are used for processing the output
+of the syntax check tool. When exiting Emacs, running processes will
+be killed without prompting the user.
@node Parsing the output
@section Parsing the output
-@cindex Parsing the output
+@cindex parsing the output, legacy proc backend
The output generated by the syntax check tool is parsed in the process
filter/sentinel using the error message patterns stored in the
-@code{flymake-err-line-patterns} variable. This variable contains a
-list of items of the form @code{(regexp file-idx line-idx
-err-text-idx)}, used to determine whether a particular line is an
+@code{flymake-proc-err-line-patterns} variable. This variable contains a
+list of items of the form @w{@code{(regexp file-idx line-idx
+err-text-idx)}}, used to determine whether a particular line is an
error message and extract file name, line number and error text,
respectively. Error type (error/warning) is also guessed by matching
-error text with the '@code{^[wW]arning}' pattern. Anything that was not
+error text with the @samp{^[wW]arning} pattern. Anything that was not
classified as a warning is considered an error. Type is then used to
sort error menu items, which shows error messages first.
-Flymake is also able to interpret error message patterns missing err-text-idx
-information. This is done by merely taking the rest of the matched line
-(@code{(substring line (match-end 0))}) as error text. This trick allows
-making use of a huge collection of error message line patterns from
-@code{compile.el}. All these error patterns are appended to
-the end of @code{flymake-err-line-patterns}.
+The Proc backend is also able to interpret error message patterns
+missing err-text-idx information. This is done by merely taking the
+rest of the matched line (@code{(substring line (match-end 0))}) as
+error text. This trick allows making use of a huge collection of
+error message line patterns from @file{compile.el}. All these error
+patterns are appended to the end of
+@code{flymake-proc-err-line-patterns}.
The error information obtained is saved in a buffer local
variable. The buffer for which the process output belongs is
determined from the process-id@w{}->@w{}buffer mapping updated
after every process launch/exit.
-@node Highlighting erroneous lines
-@section Highlighting erroneous lines
-@cindex Erroneous lines, faces
-
-Highlighting is implemented with overlays and happens in the process
-sentinel, after calling the cleanup function. Two customizable faces
-are used: @code{flymake-errline} and
-@code{flymake-warnline}. Errors belonging outside the current
-buffer are considered to belong to line 1 of the current buffer.
-
-@c This manual does not use vindex.
-@c @vindex flymake-fringe-indicator-position
-@c @vindex flymake-error-bitmap
-@c @vindex flymake-warning-bitmap
-If the option @code{flymake-fringe-indicator-position} is non-@code{nil},
-errors and warnings are also highlighted in the left or right fringe,
-using the bitmaps specified by @code{flymake-error-bitmap}
-and @code{flymake-warning-bitmap}.
-
@node Interaction with other modes
@section Interaction with other modes
-@cindex Interaction with other modes
-@cindex Interaction with compile mode
+@cindex interaction with other modes, legacy proc backend
+@cindex interaction with compile mode, legacy proc backend
-The only mode flymake currently knows about is @code{compile}.
+The only mode the Proc backend currently knows about is
+@code{compile}.
-Flymake can be configured to not start syntax check if it thinks the
-compilation is in progress. The check is made by the
-@code{flymake-compilation-is-running}, which tests the
+The Proc backend can be configured to not start syntax check if it
+thinks the compilation is in progress, by testing the
@code{compilation-in-progress} variable. The reason why this might be
useful is saving CPU time in case both syntax check and compilation
are very CPU intensive. The original reason for adding this feature,
though, was working around a locking problem with MS Visual C++
-compiler.
-
-Flymake also provides an alternative command for starting compilation,
-@code{flymake-compile}:
+compiler. The variable in question is
+@code{flymake-proc-compilation-prevents-syntax-check}.
-@lisp
-(defun flymake-compile ()
- "Kill all flymake syntax checks then start compilation."
- (interactive)
- (flymake-stop-all-syntax-checks)
- (call-interactively 'compile))
-@end lisp
-
-It just kills all the active syntax check processes before calling
-@code{compile}.
+@findex flymake-proc-compile
+The Proc backend also provides an alternative command for starting
+compilation, @code{flymake-proc-compile}. It just kills all the active
+syntax check processes before calling @code{compile}.
@node GNU Free Documentation License
@appendix GNU Free Documentation License
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 6f5af94b345..b75ca0a7b07 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -167,8 +167,8 @@ package system might not be up to date (e.g., Gnus 5.9 bundled with Emacs
21 is outdated).
You can get the latest released version of Gnus from
@uref{http://www.gnus.org/dist/gnus.tar.gz}
-or via anonymous FTP from
-@uref{ftp://ftp.gnus.org/pub/gnus/gnus.tar.gz}.
+or from
+@uref{https://ftp.gnus.org/pub/gnus/gnus.tar.gz}.
@node FAQ 1-4
@subsubheading Question 1.4
@@ -405,7 +405,7 @@ However, I'd discourage you from doing so, since the
directory Emacs chooses will most certainly not be what
you want, so let's do it the correct way.
The first thing you've got to do is to
-create a suitable directory (no blanks in directory name
+create a suitable directory (no blanks in names
please), e.g., c:\myhome. Then you must set the environment
variable HOME to this directory. To do this under Windows 9x
or Me include the line
@@ -1522,7 +1522,7 @@ Gimp), open the image you want to include, cut out the
relevant part, reduce color depth to 1 bit, resize to
48*48 and save as bitmap. Now you should get the compface
package from
-@uref{ftp://ftp.cs.indiana.edu:/pub/faces/, this site}.
+@uref{ftp://ftp.cs.indiana.edu/pub/faces/, this site}.
and create the actual X-face by saying
@example
diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el
index c7d41c8555b..b6e8862f960 100644
--- a/doc/misc/gnus-news.el
+++ b/doc/misc/gnus-news.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -51,7 +51,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
\nLocal variables:\nmode: outline
paragraph-separate: \"[ ]*$\"\nend:\n")
diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi
index fc104104ede..94c2a79a2de 100644
--- a/doc/misc/gnus-news.texi
+++ b/doc/misc/gnus-news.texi
@@ -43,7 +43,7 @@ file, where this release will store flags for nntp. See a later entry
for more information about nntp marks. Note that downgrading isn't
safe in general.
-@item Incompatibility when switching from Emacs 23 to Emacs 22
+@item Incompatibility when switching from Emacs 23 to Emacs 22
In Emacs 23, Gnus uses Emacs's new internal coding system @code{utf-8-emacs}
for saving articles drafts and @file{~/.newsrc.eld}. These files may not
be read correctly in Emacs 22 and below. If you want to use Gnus across
@@ -59,7 +59,7 @@ will shadow the latest one are detected. You can then remove those
shadows manually or remove them using @code{make
remove-installed-shadows}.
-@item The installation directory name is allowed to have spaces and/or tabs.
+@item The installation directory's name is allowed to have spaces and/or tabs.
@end itemize
@item New packages and libraries within Gnus
@@ -143,7 +143,7 @@ with a WWW browser with @kbd{K H}. @xref{MIME Commands}.
@item International host names (@acronym{IDNA}) can now be decoded
inside article bodies using @kbd{W i}
(@code{gnus-summary-idna-message}). This requires that GNU Libidn
-(@url{http://www.gnu.org/software/libidn/}) has been installed.
+(@url{https://www.gnu.org/software/libidn/}) has been installed.
@c FIXME: Also mention @code{message-use-idna}?
@item The non-@acronym{ASCII} group names handling has been much
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index e00e173bc18..a2a879d5b58 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -2601,7 +2601,7 @@ Enter a buffer where you can edit the group info
@findex gnus-group-make-directory-group
@cindex nndir
Make a directory group (@pxref{Directory Groups}). You will be prompted
-for a directory name (@code{gnus-group-make-directory-group}).
+for the directory's name (@code{gnus-group-make-directory-group}).
@item G h
@kindex G h (Group)
@@ -4340,10 +4340,10 @@ does not necessarily need to be the same value that is determined by
@code{gnus-group-name-charset-group-alist}.
If @code{default-file-name-coding-system} or this variable is
-initialized by default to @code{iso-latin-1} for example, although you
+initialized by default to @code{iso-latin-1-unix} for example, although you
want to subscribe to the groups spelled in Chinese, that is the most
typical case where you have to customize
-@code{nnmail-pathname-coding-system}. The @code{utf-8} coding system is
+@code{nnmail-pathname-coding-system}. The @code{utf-8-unix} coding system is
a good candidate for it. Otherwise, you may change the locale in your
system so that @code{default-file-name-coding-system} or this variable
may be initialized to an appropriate value.
@@ -7759,7 +7759,9 @@ processing of the article is done before it is saved). For a different
approach (uudecoding, unsharing) you should use @code{gnus-uu}
(@pxref{Decoding Articles}).
-For the commands listed here, the target is a file. If you want to
+For the commands listed here, the target is a file.
+A directory name (ending in @samp{/}) causes the target
+to be a file under that directory. If you want to
save to a group, see the @kbd{B c} (@code{gnus-summary-copy-article})
command (@pxref{Mail Group Commands}).
@@ -8968,7 +8970,7 @@ Decode IDNA encoded domain names in the current articles. IDNA
encoded domain names looks like @samp{xn--bar}. If a string remain
unencoded after running invoking this, it is likely an invalid IDNA
string (@samp{xn--bar} is invalid). You must have GNU Libidn
-(@url{http://www.gnu.org/software/libidn/}) installed for this command
+(@url{https://www.gnu.org/software/libidn/}) installed for this command
to work.
@item W t
@@ -9184,7 +9186,7 @@ Verify a signed control message
hierarchy maintainer. You need to add the @acronym{PGP} public key of
the maintainer to your keyring to verify the
message.@footnote{@acronym{PGP} keys for many hierarchies are
-available at @uref{ftp://ftp.isc.org/pub/pgpcontrol/README.html}}
+available at @uref{https://ftp.isc.org/pub/pgpcontrol/README.html}}
@item W s
@kindex W s (Summary)
@@ -10974,7 +10976,7 @@ Pull all ticked articles (for the current group) into the summary buffer
@kindex A D (Summary)
@findex gnus-summary-enter-digest-group
If the current article is a collection of other articles (for instance,
-a digest), you might use this command to enter a group based on the that
+a digest), you might use this command to enter a group based on that
article (@code{gnus-summary-enter-digest-group}). Gnus will try to
guess what article type is currently displayed unless you give a prefix
to this command, which forces a ``digest'' interpretation. Basically,
@@ -12318,7 +12320,7 @@ This variable controls whether Gnus performs IDNA decoding of
internationalized domain names inside @samp{From}, @samp{To} and
@samp{Cc} headers. @xref{IDNA, ,IDNA,message, The Message Manual},
for how to compose such messages. This requires
-@uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this
+@uref{https://www.gnu.org/software/libidn/, GNU Libidn}, and this
variable is only enabled if you have installed it.
@vindex gnus-inhibit-images
@@ -13214,6 +13216,11 @@ Also @pxref{Formatting Variables}.
@subsection Server Commands
@cindex server commands
+The following keybinding are available in the server buffer. Be aware
+that some of the commands will only work on servers that you've added
+through this interface (with @kbd{a}), not with servers you've defined
+in your init files.
+
@table @kbd
@item v
@@ -13858,7 +13865,7 @@ The same as the above, but don't do automatic @acronym{STARTTLS} upgrades.
@findex nntp-open-tls-stream
@item nntp-open-tls-stream
Opens a connection to a server over a @dfn{secure} channel. To use
-this you must have @uref{http://www.gnu.org/software/gnutls/, GnuTLS}
+this you must have @uref{https://www.gnu.org/software/gnutls/, GnuTLS}
installed. You then define a server as follows:
@lisp
@@ -18485,7 +18492,7 @@ something along the lines of the following:
(defun my-article-old-p ()
"Say whether an article is old."
(< (time-to-days (date-to-time (mail-header-date gnus-headers)))
- (- (time-to-days (current-time)) gnus-agent-expire-days)))
+ (- (time-to-days nil) gnus-agent-expire-days)))
@end lisp
with the predicate then defined as:
@@ -21384,7 +21391,7 @@ 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 any switches to namazu that will change the
+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
diff --git a/doc/misc/gpl.texi b/doc/misc/gpl.texi
index 0e2e212acb1..c007dc06966 100644
--- a/doc/misc/gpl.texi
+++ b/doc/misc/gpl.texi
@@ -5,7 +5,7 @@
@c hence no sectioning command or @node.
@display
-Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{http://fsf.org/}
+Copyright @copyright{} 2007 Free Software Foundation, Inc. @url{https://fsf.org/}
Everyone is permitted to copy and distribute verbatim copies of this
license document, but changing it is not allowed.
@@ -684,7 +684,7 @@ 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 @url{http://www.gnu.org/licenses/}.
+along with this program. If not, see @url{https://www.gnu.org/licenses/}.
@end smallexample
Also add information on how to contact you by electronic and paper mail.
@@ -707,11 +707,11 @@ use an ``about box''.
You should also get your employer (if you work as a programmer) or school,
if any, to sign a ``copyright disclaimer'' for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-@url{http://www.gnu.org/licenses/}.
+@url{https://www.gnu.org/licenses/}.
The GNU General Public License does not permit incorporating your
program into proprietary programs. If your program is a subroutine
library, you may consider it more useful to permit linking proprietary
applications with the library. If this is what you want to do, use
the GNU Lesser General Public License instead of this License. But
-first, please read @url{http://www.gnu.org/philosophy/why-not-lgpl.html}.
+first, please read @url{https://www.gnu.org/licenses/why-not-lgpl.html}.
diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi
index addc3e177b5..f7fe5392ce5 100644
--- a/doc/misc/htmlfontify.texi
+++ b/doc/misc/htmlfontify.texi
@@ -825,7 +825,7 @@ with a class of @code{t} is considered to match any class you specify.
This matches Emacs's behavior when deciding on which face attributes to
use, to the best of my understanding ).
-If @var{class} is @code{nil}, then you just get get whatever
+If @var{class} is @code{nil}, then you just get whatever
@code{face-attr-construct} returns; i.e., the current specification in
effect for @var{face}.
@@ -963,8 +963,9 @@ Is @ref{hfy-optimizations} member @var{symbol} set or not?
@end lisp
Return everything preceding the last @samp{/} from a relative filename,
-on the assumption that this will produce a relative directory name. Hardly
-bombproof, but good enough in the context in which it is being used.
+on the assumption that this will produce the name of a relative
+directory. Hardly bombproof, but good enough in the context in which
+it is being used.
@item hfy-html-dekludge-buffer
@findex hfy-html-dekludge-buffer
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index bbdef4a8629..829986e220c 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -925,7 +925,7 @@ invoke @kbd{M-x message-idna-to-ascii-rhs RET} in the message buffer
to have the non-@acronym{ASCII} domain names encoded while you edit
the message.
-Note that you must have @uref{http://www.gnu.org/software/libidn/, GNU
+Note that you must have @uref{https://www.gnu.org/software/libidn/, GNU
Libidn} installed in order to use this functionality.
@node Security
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 3aa04caf865..0fb6e6ce5da 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -237,7 +237,7 @@ read a built-in tutorial by starting GNU Emacs and typing @kbd{C-h t}
@ref{Top, , GNU Emacs Manual, emacs, GNU Emacs Manual},
@end ifinfo
@ifhtml
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/,
@cite{GNU Emacs Manual}},
@end ifhtml
from the Free Software Foundation.
@@ -386,7 +386,7 @@ GNU Emacs Manual}.
@end ifnothtml
@ifhtml
See section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Easy-Customization.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Easy-Customization.html,
Easy Customization} in @cite{The GNU Emacs Manual}.
@end ifhtml
@xref{Options}.
@@ -406,7 +406,7 @@ GNU Emacs Manual}.
@end ifnothtml
@ifhtml
See section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Face-Customization.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Face-Customization.html,
Face Customization} in @cite{The GNU Emacs Manual}.
@end ifhtml
@@ -424,7 +424,7 @@ Emacs Manual}
@end ifnothtml
@ifhtml
See section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Hooks.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Hooks.html,
Hooks} in @cite{The GNU Emacs Manual}
@end ifhtml
for a description about @dfn{normal hooks} and @dfn{abnormal hooks}.
@@ -475,7 +475,7 @@ point.
@end ifnothtml
@ifhtml
See the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html,
Completion} in @cite{The GNU Emacs Manual}.
@end ifhtml
Note that @key{SPC} cannot be used for completing filenames and
@@ -1123,17 +1123,17 @@ exist,
@footnote{The @cite{GNU Emacs Lisp Reference Manual} should be available
via the Info system by typing @kbd{C-h i m Emacs Lisp
@key{RET}}. It is also available online at @*
-@uref{http://www.gnu.org/software/emacs/manual/elisp.html}.}
+@uref{https://www.gnu.org/software/emacs/manual/elisp.html}.}
@end iftex
@ifinfo
@footnote{@xref{Top, The GNU Emacs Lisp Reference Manual, , elisp, GNU
Emacs Lisp Reference Manual}, which should be available via the
Info system. It is also available online at
-@uref{http://www.gnu.org/software/emacs/manual/elisp.html}.}
+@uref{https://www.gnu.org/software/emacs/manual/elisp.html}.}
@end ifinfo
@ifhtml
@footnote{The
-@uref{http://www.gnu.org/software/emacs/manual/elisp.html,
+@uref{https://www.gnu.org/software/emacs/manual/elisp.html,
The GNU Emacs Lisp Reference Manual} should be available via
the Info system by typing @kbd{C-h i m Emacs Lisp @key{RET}}.}
@end ifhtml
@@ -1298,7 +1298,7 @@ When you choose a folder in MH-E via a command such as @kbd{o}
@end ifnothtml
@ifhtml
(see the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html,
Completion} in @cite{The GNU Emacs Manual}).
@end ifhtml
In addition, MH-E has several ways of choosing a suitable default so
@@ -2112,7 +2112,7 @@ display of this field requires the
@command{uncompface} program}. Recent versions of XEmacs have internal
support for @samp{X-Face:} images. If your version of XEmacs does not,
then you'll need both @command{uncompface} and the
-@uref{ftp://ftp.jpl.org/pub/elisp/, @samp{x-face} package}.}. MH-E
+@uref{http://www.jpl.org/ftp/pub/elisp/, @samp{x-face} package}.}. MH-E
renders the foreground and background of the image using the
associated attributes of the face @code{mh-show-xface}.
@@ -2126,7 +2126,7 @@ associated attributes of the face @code{mh-show-xface}.
Finally, MH-E will display images referenced by the
@samp{X-Image-URL:} header field if neither the @samp{Face:} nor the
@samp{X-Face:} fields are present@footnote{The display of the images
-requires the @uref{http://www.gnu.org/software/wget/wget.html,
+requires the @uref{https://www.gnu.org/software/wget/wget.html,
@command{wget} program} to fetch the image and the @command{convert}
program from the @uref{http://www.imagemagick.org/script/index.php,
ImageMagick suite}.}. Of the three header fields this is the most
@@ -2856,7 +2856,7 @@ See @cite{The PGG Manual}.
@end ifinfo
@ifhtml
See
-@uref{http://www.gnu.org/software/emacs/manual/pgg.html,
+@uref{https://www.gnu.org/software/emacs/manual/pgg.html,
@cite{The PGG Manual}}.
@end ifhtml
@@ -5623,7 +5623,7 @@ See @cite{The PGG Manual}.
@end ifinfo
@ifhtml
See
-@uref{http://www.gnu.org/software/emacs/manual/pgg.html,
+@uref{https://www.gnu.org/software/emacs/manual/pgg.html,
@cite{The PGG Manual}}.
@end ifhtml
@@ -6032,7 +6032,7 @@ GNU Emacs Manual}).
@end ifnothtml
@ifhtml
(see the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html,
Syntax of Regular Expressions} in
@cite{The GNU Emacs Manual}).
@end ifhtml
@@ -6182,7 +6182,7 @@ GNU Emacs Manual}).
@end ifnothtml
@ifhtml
(see the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html,
Syntax of Regular Expressions} in
@cite{The GNU Emacs Manual}).
@end ifhtml
@@ -6290,7 +6290,7 @@ You can also use the speedbar
@end ifnothtml
@ifhtml
(see the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Speedbar.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Speedbar.html,
Speedbar Frames} in @cite{The GNU Emacs Manual})
@end ifhtml
to view your folders. To bring up the speedbar, run @kbd{M-x speedbar
@@ -6422,7 +6422,7 @@ For a description of the menu bar, please
@end ifnothtml
@ifhtml
see the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Menu-Bar.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Menu-Bar.html,
The Menu Bar} in @cite{The GNU Emacs Manual}.
@end ifhtml
@@ -6444,7 +6444,7 @@ tool bar, please
@end ifnothtml
@ifhtml
see the section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Tool-Bars.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Tool-Bars.html,
Tool Bars} in @cite{The GNU Emacs Manual}.
@end ifhtml
@@ -8226,7 +8226,7 @@ GNU Emacs Manual}.
@end ifnothtml
@ifhtml
section
-@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html,
+@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html,
Syntax of Regular Expressions} in @cite{The GNU Emacs Manual}.
@end ifhtml
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index 6928baab1fa..f60ffba358d 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -440,20 +440,18 @@ headlines. Instead of reading headlines yourself you can tell
Newsticker to do that for you.
@vindex newsticker-new-item-functions
-In order to do so write a function which takes three arguments
+In order to do so write a function which takes two arguments
@table @var
-@item FEED
+@item FEEDNAME
the name of the corresponding news feed,
-@item TITLE
-the title of the headline,
-@item DESC
-the decoded description of the headline.
+@item ITEM
+the decoded headline.
@end table
and add it to @code{newsticker-new-item-functions}. Each function
contained in this list is called once for each new headline.
-Depending on the feed, the title and the description of a headline you
+Depending on the feed name and the contents of the new headline you
can
@itemize
@@ -463,7 +461,7 @@ descriptions (for which a function already exists, see
@code{newsticker-download-images}),
@item
automatically save enclosed audio and video files (for which another
-function exists as well, see @code{newsticker-download-images}),
+function exists as well, see @code{newsticker-download-enclosures}),
@item
flash the screen while playing some sound,
@item
diff --git a/doc/misc/org.texi b/doc/misc/org.texi
index fca5185337e..1f6e10287d1 100644
--- a/doc/misc/org.texi
+++ b/doc/misc/org.texi
@@ -4,7 +4,8 @@
@settitle The Org Manual
@include docstyle.texi
-@set VERSION 8.2.9
+@set VERSION 9.1.4
+@set DATE 2017-09-17
@c Version and Contact Info
@set MAINTAINERSITE @uref{http://orgmode.org,maintainers web page}
@@ -284,8 +285,8 @@ modify this GNU manual.''
@subtitle Release @value{VERSION}
@author by Carsten Dominik
-with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan
-Davison, Eric Schulte, Thomas Dye, Jambunathan K and Nicolas Goaziou.
+with contributions by Bastien Guerry, Nicolas Goaziou, Eric Schulte,
+Jambunathan K, Dan Davison, Thomas Dye, David O'Toole, and Philip Rooke.
@c The following two commands start the copyright page.
@page
@@ -293,13 +294,14 @@ Davison, Eric Schulte, Thomas Dye, Jambunathan K and Nicolas Goaziou.
@insertcopying
@end titlepage
+@c Output the short table of contents at the beginning.
+@shortcontents
+
@c Output the table of contents at the beginning.
@contents
@ifnottex
-@c FIXME These hand-written next,prev,up node pointers make editing a lot
-@c harder. There should be no need for them, makeinfo can do it
-@c automatically for any document with a normal structure.
+
@node Top, Introduction, (dir), (dir)
@top Org Mode Manual
@@ -308,23 +310,23 @@ Davison, Eric Schulte, Thomas Dye, Jambunathan K and Nicolas Goaziou.
@menu
* Introduction:: Getting started
-* Document Structure:: A tree works like your brain
+* Document structure:: A tree works like your brain
* Tables:: Pure magic for quick formatting
* Hyperlinks:: Notes in context
-* TODO Items:: Every tree branch can be a TODO item
+* TODO items:: Every tree branch can be a TODO item
* Tags:: Tagging headlines and matching sets of tags
-* Properties and Columns:: Storing information about an entry
-* Dates and Times:: Making items useful for planning
+* Properties and columns:: Storing information about an entry
+* Dates and times:: Making items useful for planning
* Capture - Refile - Archive:: The ins and outs for projects
-* Agenda Views:: Collecting information into views
+* Agenda views:: Collecting information into views
* Markup:: Prepare text for rich export
* Exporting:: Sharing and publishing notes
* Publishing:: Create a web site of linked Org files
-* Working With Source Code:: Export, evaluate, and tangle code blocks
+* Working with source code:: Export, evaluate, and tangle code blocks
* Miscellaneous:: All the rest which did not fit elsewhere
* Hacking:: How to hack your way around
* MobileOrg:: Viewing and capture on a mobile device
-* History and Acknowledgments:: How Org came into being
+* History and acknowledgments:: How Org came into being
* GNU Free Documentation License:: The license for this documentation.
* Main Index:: An index of Org's concepts and features
* Key Index:: Key bindings and where they are described
@@ -363,11 +365,6 @@ Visibility cycling
* Initial visibility:: Setting the initial visibility state
* Catching invisible edits:: Preventing mistakes when editing invisible parts
-Global and local cycling
-
-* Initial visibility:: Setting the initial visibility state
-* Catching invisible edits:: Preventing mistakes when editing invisible parts
-
Tables
* Built-in table editor:: Simple tables
@@ -434,7 +431,7 @@ Tags
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
Properties and columns
@@ -464,8 +461,7 @@ Dates and times
* Deadlines and scheduling:: Planning your work
* Clocking work time:: Tracking how long you spend on a task
* Effort estimates:: Planning work effort in advance
-* Relative timer:: Notes with a running timer
-* Countdown timer:: Starting a countdown timer for a task
+* Timers:: Notes with a running timer
Creating timestamps
@@ -487,7 +483,7 @@ Capture - Refile - Archive
* Capture:: Capturing new stuff
* Attachments:: Add files to tasks
-* RSS Feeds:: Getting input from RSS feeds
+* RSS feeds:: Getting input from RSS feeds
* Protocols:: External (e.g., Browser) access to Emacs and Org
* Refile and copy:: Moving/copying a tree from one place to another
* Archiving:: What to do with finished projects
@@ -504,6 +500,12 @@ Capture templates
* Template expansion:: Filling in information about time and context
* Templates in contexts:: Only show a template in a specific context
+Protocols for external access
+
+* @code{store-link} protocol:: Store a link, push URL to kill-ring.
+* @code{capture} protocol:: Fill a buffer with external information.
+* @code{open-source} protocol:: Edit published contents.
+
Archiving
* Moving subtrees:: Moving a tree to an archive file
@@ -517,7 +519,7 @@ Agenda views
* Presentation and sorting:: How agenda items are prepared for display
* Agenda commands:: Remote editing of Org trees
* Custom agenda views:: Defining special searches and views
-* Exporting Agenda Views:: Writing a view to a file
+* Exporting agenda views:: Writing a view to a file
* Agenda column view:: Using column view for collected entries
The built-in agenda views
@@ -525,7 +527,6 @@ The built-in agenda views
* Weekly/daily agenda:: The calendar page with current tasks
* Global TODO list:: All unfinished action items
* Matching tags and properties:: Structured information with fine-tuned search
-* Timeline:: Time-sorted view for single file
* Search view:: Find entries by searching for text
* Stuck projects:: Find projects you need to review
@@ -540,114 +541,127 @@ Custom agenda views
* Storing searches:: Type once, use often
* Block agenda:: All the stuff you need in a single buffer
-* Setting Options:: Changing the rules
+* Setting options:: Changing the rules
Markup for rich export
-* Structural markup elements:: The basic structure as seen by the exporter
+* Paragraphs:: The basic unit of text
+* Emphasis and monospace:: Bold, italic, etc.
+* Horizontal rules:: Make a line
* Images and tables:: Images, tables and caption mechanism
* Literal examples:: Source code examples with special formatting
-* Include files:: Include additional files into a document
-* Index entries:: Making an index
-* Macro replacement:: Use macros to create templates
+* Special symbols:: Greek letters and other symbols
+* Subscripts and superscripts:: Simple syntax for raising/lowering text
* Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents
-* Special blocks:: Containers targeted at export back-ends
-
-Structural markup elements
-
-* Document title:: Where the title is taken from
-* Headings and sections:: The document structure as seen by the exporter
-* Table of contents:: The if and where of the table of contents
-* Lists:: Lists
-* Paragraphs:: Paragraphs
-* Footnote markup:: Footnotes
-* Emphasis and monospace:: Bold, italic, etc.
-* Horizontal rules:: Make a line
-* Comment lines:: What will *not* be exported
Embedded @LaTeX{}
-* Special symbols:: Greek letters and other symbols
-* Subscripts and superscripts:: Simple syntax for raising/lowering text
* @LaTeX{} fragments:: Complex formulas made easy
* Previewing @LaTeX{} fragments:: What will this snippet look like?
* CDLaTeX mode:: Speed up entering of formulas
Exporting
-* The Export Dispatcher:: The main exporter interface
-* Export back-ends:: Built-in export formats
-* Export settings:: Generic export settings
+* The export dispatcher:: The main interface
+* Export settings:: Common export settings
+* Table of contents:: The if and where of the table of contents
+* Include files:: Include additional files into a document
+* Macro replacement:: Use macros to create templates
+* Comment lines:: What will not be exported
* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding
* Beamer export:: Exporting as a Beamer presentation
* HTML export:: Exporting to HTML
-* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
+* @LaTeX{} export:: Exporting to @LaTeX{}, and processing to PDF
* Markdown export:: Exporting to Markdown
* OpenDocument Text export:: Exporting to OpenDocument Text
* Org export:: Exporting to Org
* Texinfo export:: Exporting to Texinfo
* iCalendar export:: Exporting to iCalendar
* Other built-in back-ends:: Exporting to a man page
-* Export in foreign buffers:: Author tables and lists in Org syntax
* Advanced configuration:: Fine-tuning the export output
+* Export in foreign buffers:: Author tables and lists in Org syntax
+
+Beamer export
+
+* Beamer export commands:: For creating Beamer documents.
+* Beamer specific export settings:: For customizing Beamer export.
+* Sectioning Frames and Blocks in Beamer:: For composing Beamer slides.
+* Beamer specific syntax:: For using in Org documents.
+* Editing support:: For using helper functions.
+* A Beamer example:: A complete presentation.
HTML export
-* HTML Export commands:: How to invoke HTML export
-* HTML doctypes:: Org can export to various (X)HTML flavors
-* HTML preamble and postamble:: How to insert a preamble and a postamble
-* Quoting HTML tags:: Using direct HTML in Org mode
-* Links in HTML export:: How links will be interpreted and formatted
-* Tables in HTML export:: How to modify the formatting of tables
-* Images in HTML export:: How to insert figures into HTML output
-* Math formatting in HTML export:: Beautiful math also on the web
-* Text areas in HTML export:: An alternative way to show an example
-* CSS support:: Changing the appearance of the output
-* JavaScript support:: Info and Folding in a web browser
-
-@LaTeX{} and PDF export
-
-* @LaTeX{} export commands:: How to export to LaTeX and PDF
-* Header and sectioning:: Setting up the export file structure
-* Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code
-* @LaTeX{} specific attributes:: Controlling @LaTeX{} output
+* HTML Export commands:: Invoking HTML export
+* HTML Specific export settings:: Settings for HTML export
+* HTML doctypes:: Exporting various (X)HTML flavors
+* HTML preamble and postamble:: Inserting preamble and postamble
+* Quoting HTML tags:: Using direct HTML in Org files
+* Links in HTML export:: Interpreting and formatting links
+* Tables in HTML export:: Formatting and modifying tables
+* Images in HTML export:: Inserting figures with HTML output
+* Math formatting in HTML export:: Handling math equations
+* Text areas in HTML export:: Showing an alternate approach, an example
+* CSS support:: Styling HTML output
+* JavaScript support:: Folding scripting in the web browser
+
+@LaTeX{} export
+
+* @LaTeX{} export commands:: For producing @LaTeX{} and PDF documents.
+* @LaTeX{} specific export settings:: Unique to this @LaTeX{} back-end.
+* @LaTeX{} header and sectioning:: For file structure.
+* Quoting @LaTeX{} code:: Directly in the Org document.
+* Tables in @LaTeX{} export:: Attributes specific to tables.
+* Images in @LaTeX{} export:: Attributes specific to images.
+* Plain lists in @LaTeX{} export:: Attributes specific to lists.
+* Source blocks in @LaTeX{} export:: Attributes specific to source code blocks.
+* Example blocks in @LaTeX{} export:: Attributes specific to example blocks.
+* Special blocks in @LaTeX{} export:: Attributes specific to special blocks.
+* Horizontal rules in @LaTeX{} export:: Attributes specific to horizontal rules.
OpenDocument Text export
-* Pre-requisites for ODT export:: What packages ODT exporter relies on
-* ODT export commands:: How to invoke ODT export
-* Extending ODT export:: How to produce @samp{doc}, @samp{pdf} files
-* Applying custom styles:: How to apply custom styles to the output
-* Links in ODT export:: How links will be interpreted and formatted
-* Tables in ODT export:: How Tables are exported
-* Images in ODT export:: How to insert images
-* Math formatting in ODT export:: How @LaTeX{} fragments are formatted
-* Labels and captions in ODT export:: How captions are rendered
-* Literal examples in ODT export:: How source and example blocks are formatted
-* Advanced topics in ODT export:: Read this if you are a power user
+* Pre-requisites for ODT export:: Required packages.
+* ODT export commands:: Invoking export.
+* ODT specific export settings:: Configuration options.
+* Extending ODT export:: Producing @file{.doc}, @file{.pdf} files.
+* Applying custom styles:: Styling the output.
+* Links in ODT export:: Handling and formatting links.
+* Tables in ODT export:: Org table conversions.
+* Images in ODT export:: Inserting images.
+* Math formatting in ODT export:: Formatting @LaTeX{} fragments.
+* Labels and captions in ODT export:: Rendering objects.
+* Literal examples in ODT export:: For source code and example blocks.
+* Advanced topics in ODT export:: For power users.
Math formatting in ODT export
-* Working with @LaTeX{} math snippets:: How to embed @LaTeX{} math fragments
-* Working with MathML or OpenDocument formula files:: How to embed equations in native format
+* Working with @LaTeX{} math snippets:: Embedding in @LaTeX{} format.
+* Working with MathML or OpenDocument formula files:: Embedding in native format.
Advanced topics in ODT export
-* Configuring a document converter:: How to register a document converter
-* Working with OpenDocument style files:: Explore the internals
-* Creating one-off styles:: How to produce custom highlighting etc
-* Customizing tables in ODT export:: How to define and use Table templates
-* Validating OpenDocument XML:: How to debug corrupt OpenDocument files
+* Configuring a document converter:: Registering a document converter.
+* Working with OpenDocument style files:: Exploring internals.
+* Creating one-off styles:: Customizing styles, highlighting.
+* Customizing tables in ODT export:: Defining table templates.
+* Validating OpenDocument XML:: Debugging corrupted OpenDocument files.
Texinfo export
-* Texinfo export commands:: How to invoke Texinfo export
-* Document preamble:: File header, title and copyright page
-* Headings and sectioning structure:: Building document structure
-* Indices:: Creating indices
-* Quoting Texinfo code:: Incorporating literal Texinfo code
-* Texinfo specific attributes:: Controlling Texinfo output
-* An example::
+* Texinfo export commands:: Invoking commands.
+* Texinfo specific export settings:: Setting the environment.
+* Texinfo file header:: Generating the header.
+* Texinfo title and copyright page:: Creating preamble pages.
+* Info directory file:: Installing a manual in Info file hierarchy.
+* Headings and sectioning structure:: Building document structure.
+* Indices:: Creating indices.
+* Quoting Texinfo code:: Incorporating literal Texinfo code.
+* Plain lists in Texinfo export:: List attributes.
+* Tables in Texinfo export:: Table attributes.
+* Images in Texinfo export:: Image attributes.
+* Special blocks in Texinfo export:: Special block attributes.
+* A Texinfo example:: Processing Org to Texinfo.
Publishing
@@ -694,36 +708,32 @@ Header arguments
Using header arguments
-* System-wide header arguments:: Set global default values
-* Language-specific header arguments:: Set default values by language
-* Header arguments in Org mode properties:: Set default values for a buffer or heading
-* Language-specific header arguments in Org mode properties:: Set language-specific default values for a buffer or heading
-* Code block specific header arguments:: The most common way to set values
-* Header arguments in function calls:: The most specific level
+* System-wide header arguments:: Set globally, language-specific
+* Language-specific header arguments:: Set in the Org file's headers
+* Header arguments in Org mode properties:: Set in the Org file
+* Language-specific mode properties::
+* Code block specific header arguments:: The most commonly used method
+* Arguments in function calls:: The most specific level, takes highest priority
Specific header arguments
-* var:: Pass arguments to code blocks
-* results:: Specify the type of results and how they will
- be collected and handled
-* file:: Specify a path for file output
+* var:: Pass arguments to @samp{src} code blocks
+* results:: Specify results type; how to collect
+* file:: Specify a path for output file
* file-desc:: Specify a description for file results
-* dir:: Specify the default (possibly remote)
- directory for code block execution
-* exports:: Export code and/or results
-* tangle:: Toggle tangling and specify file name
-* mkdirp:: Toggle creation of parent directories of target
- files during tangling
-* comments:: Toggle insertion of comments in tangled
- code files
-* padline:: Control insertion of padding lines in tangled
- code files
-* no-expand:: Turn off variable assignment and noweb
- expansion during tangling
+* file-ext:: Specify an extension for file output
+* output-dir:: Specify a directory for output file
+* dir:: Specify the default directory for code block execution
+* exports:: Specify exporting code, results, both, none
+* tangle:: Toggle tangling; or specify file name
+* mkdirp:: Toggle for parent directory creation for target files during tangling
+* comments:: Toggle insertion of comments in tangled code files
+* padline:: Control insertion of padding lines in tangled code files
+* no-expand:: Turn off variable assignment and noweb expansion during tangling
* session:: Preserve the state of code evaluation
* noweb:: Toggle expansion of noweb references
* noweb-ref:: Specify block's noweb reference resolution target
-* noweb-sep:: String used to separate noweb references
+* noweb-sep:: String to separate noweb references
* cache:: Avoid re-evaluating unchanged code blocks
* sep:: Delimiter for writing tabular results outside Org
* hlines:: Handle horizontal lines in tables
@@ -733,22 +743,22 @@ Specific header arguments
* tangle-mode:: Set permission of tangled files
* eval:: Limit evaluation of specific code blocks
* wrap:: Mark source block evaluation results
-* post:: Post processing of code block results
-* prologue:: Text to prepend to code block body
-* epilogue:: Text to append to code block body
+* post:: Post processing of results of code block evaluation
+* prologue:: Text to prepend to body of code block
+* epilogue:: Text to append to body of code block
Miscellaneous
-* Completion:: M-TAB knows what you need
-* Easy Templates:: Quick insertion of structural elements
+* Completion:: M-TAB guesses completions
+* Easy templates:: Quick insertion of structural elements
* Speed keys:: Electric commands at the beginning of a headline
* Code evaluation security:: Org mode files evaluate inline code
-* Customization:: Adapting Org to your taste
+* Customization:: Adapting Org to changing tastes
* In-buffer settings:: Overview of the #+KEYWORDS
* The very busy C-c C-c key:: When in doubt, press C-c C-c
* Clean view:: Getting rid of leading stars in the outline
* TTY keys:: Using Org on a tty
-* Interaction:: Other Emacs packages
+* Interaction:: With other Emacs packages
* org-crypt:: Encrypting Org files
Interaction with other packages
@@ -780,14 +790,14 @@ Tables and lists in arbitrary syntax
MobileOrg
-* Setting up the staging area:: Where to interact with the mobile device
+* Setting up the staging area:: For the mobile device
* Pushing to MobileOrg:: Uploading Org files and agendas
* Pulling from MobileOrg:: Integrating captured and flagged items
@end detailmenu
@end menu
-@node Introduction, Document Structure, Top, Top
+@node Introduction
@chapter Introduction
@cindex introduction
@@ -799,79 +809,65 @@ MobileOrg
* Conventions:: Typesetting conventions in the manual
@end menu
-@node Summary, Installation, Introduction, Introduction
+@node Summary
@section Summary
@cindex summary
-Org is a mode for keeping notes, maintaining TODO lists, and doing
-project planning with a fast and effective plain-text system.
-
-Org develops organizational tasks around NOTES files that contain
-lists or information about projects as plain text. Org is
-implemented on top of Outline mode, which makes it possible to keep the
-content of large files well structured. Visibility cycling and
-structure editing help to work with the tree. Tables are easily created
-with a built-in table editor. Org supports TODO items, deadlines,
-timestamps, and scheduling. It dynamically compiles entries into an
-agenda that utilizes and smoothly integrates much of the Emacs calendar
-and diary. Plain text URL-like links connect to websites, emails,
-Usenet messages, BBDB entries, and any files related to the projects.
-For printing and sharing notes, an Org file can be exported as a
-structured ASCII file, as HTML, or (TODO and agenda items only) as an
-iCalendar file. It can also serve as a publishing tool for a set of
-linked web pages.
-
-As a project planning environment, Org works by adding metadata to outline
-nodes. Based on this data, specific entries can be extracted in queries and
-create dynamic @i{agenda views}.
-
-Org mode contains the Org Babel environment which allows you to work with
-embedded source code blocks in a file, to facilitate code evaluation,
-documentation, and literate programming techniques.
-
-Org's automatic, context-sensitive table editor with spreadsheet
-capabilities can be integrated into any major mode by activating the
-minor Orgtbl mode. Using a translation step, it can be used to maintain
-tables in arbitrary file types, for example in @LaTeX{}. The structure
-editing and list creation capabilities can be used outside Org with
-the minor Orgstruct mode.
-
-Org keeps simple things simple. When first fired up, it should
-feel like a straightforward, easy to use outliner. Complexity is not
-imposed, but a large amount of functionality is available when you need
-it. Org is a toolbox and can be used in different ways and for different
-ends, for example:
-
-@example
-@r{@bullet{} an outline extension with visibility cycling and structure editing}
-@r{@bullet{} an ASCII system and table editor for taking structured notes}
-@r{@bullet{} a TODO list editor}
-@r{@bullet{} a full agenda and planner with deadlines and work scheduling}
-@pindex GTD, Getting Things Done
-@r{@bullet{} an environment in which to implement David Allen's GTD system}
-@r{@bullet{} a simple hypertext system, with HTML and @LaTeX{} export}
-@r{@bullet{} a publishing tool to create a set of interlinked web pages}
-@r{@bullet{} an environment for literate programming}
-@end example
+Org is a mode for keeping notes, maintaining TODO lists, and project planning
+with a fast and effective plain-text system. It also is an authoring system
+with unique support for literate programming and reproducible research.
+
+Org is implemented on top of Outline mode, which makes it possible to keep
+the content of large files well structured. Visibility cycling and structure
+editing help to work with the tree. Tables are easily created with a
+built-in table editor. Plain text URL-like links connect to websites,
+emails, Usenet messages, BBDB entries, and any files related to the projects.
+
+Org develops organizational tasks around notes files that contain lists or
+information about projects as plain text. Project planning and task
+management makes use of metadata which is part of an outline node. Based on
+this data, specific entries can be extracted in queries and create dynamic
+@i{agenda views} that also integrate the Emacs calendar and diary. Org can
+be used to implement many different project planning schemes, such as David
+Allen's GTD system.
+
+Org files can serve as a single source authoring system with export to many
+different formats such as HTML, @LaTeX{}, Open Document, and 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 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.
+
+Org keeps simple things simple. When first fired up, it should feel like a
+straightforward, easy to use outliner. Complexity is not imposed, but a
+large amount of functionality is available when needed. Org is a toolbox.
+Many users actually run only a (very personal) fraction of Org's capabilities, and
+know that there is more whenever they need it.
+
+All of this is achieved with strictly plain text files, the most portable and
+future-proof file format. Org runs in Emacs. Emacs is one of the most
+widely ported programs, so that Org mode is available on every major
+platform.
@cindex FAQ
There is a website for Org which provides links to the newest
version of Org, as well as additional information, frequently asked
questions (FAQ), links to tutorials, etc. This page is located at
@uref{http://orgmode.org}.
-
@cindex print edition
-The version 7.3 of this manual is available as a
-@uref{http://www.network-theory.co.uk/org/manual/, paperback book from Network
-Theory Ltd.}
-@page
+An earlier version (7.3) of this manual is available as a
+@uref{http://www.network-theory.co.uk/org/manual/, paperback book from
+Network Theory Ltd.}
+@page
-@node Installation, Activation, Summary, Introduction
+@node Installation
@section Installation
@cindex installation
-@cindex XEmacs
Org is part of recent distributions of GNU Emacs, so you normally don't need
to install it. If, for one reason or another, you want to install Org on top
@@ -895,7 +891,7 @@ been visited, i.e., where no Org built-in function have been loaded.
Otherwise autoload Org functions will mess up the installation.
Then, to make sure your Org configuration is taken into account, initialize
-the package system with @code{(package-initialize)} in your @file{.emacs}
+the package system with @code{(package-initialize)} in your Emacs init file
before setting any Org option. If you want to use Org's package repository,
check out the @uref{http://orgmode.org/elpa.html, Org ELPA page}.
@@ -903,7 +899,7 @@ check out the @uref{http://orgmode.org/elpa.html, Org ELPA page}.
You can download Org latest release from @uref{http://orgmode.org/, Org's
website}. In this case, make sure you set the load-path correctly in your
-@file{.emacs}:
+Emacs init file:
@lisp
(add-to-list 'load-path "~/path/to/orgdir/lisp")
@@ -945,7 +941,7 @@ For more detailed explanations on Org's build system, please check the Org
Build System page on @uref{http://orgmode.org/worg/dev/org-build-system.html,
Worg}.
-@node Activation, Feedback, Installation, Introduction
+@node Activation
@section Activation
@cindex activation
@cindex autoload
@@ -957,14 +953,6 @@ Worg}.
@findex org-store-link
@findex org-iswitchb
-Since Emacs 22.2, files with the @file{.org} extension use Org mode by
-default. If you are using an earlier version of Emacs, add this line to your
-@file{.emacs} file:
-
-@lisp
-(add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode))
-@end lisp
-
Org mode buffers need font-lock to be turned on: this is the default in
Emacs@footnote{If you don't use font-lock globally, turn it on in Org buffer
with @code{(add-hook 'org-mode-hook 'turn-on-font-lock)}}.
@@ -979,15 +967,15 @@ suggested bindings for these keys, please modify the keys to your own
liking.
@lisp
(global-set-key "\C-cl" 'org-store-link)
-(global-set-key "\C-cc" 'org-capture)
(global-set-key "\C-ca" 'org-agenda)
+(global-set-key "\C-cc" 'org-capture)
(global-set-key "\C-cb" 'org-iswitchb)
@end lisp
@cindex Org mode, turning on
-With this setup, all files with extension @samp{.org} will be put
-into Org mode. As an alternative, make the first line of a file look
-like this:
+Files with the @file{.org} extension use Org mode by default. To turn on Org
+mode in a file that does not have the extension @file{.org}, make the first
+line of a file look like this:
@example
MY PROJECTS -*- mode: org; -*-
@@ -999,17 +987,12 @@ the file's name is. See also the variable
@code{org-insert-mode-line-in-empty-file}.
Many commands in Org work on the region if the region is @i{active}. To make
-use of this, you need to have @code{transient-mark-mode}
-(@code{zmacs-regions} in XEmacs) turned on. In Emacs 23 this is the default,
-in Emacs 22 you need to do this yourself with
-@lisp
-(transient-mark-mode 1)
-@end lisp
-@noindent If you do not like @code{transient-mark-mode}, you can create an
-active region by using the mouse to select a region, or pressing
+use of this, you need to have @code{transient-mark-mode} turned on, which is
+the default. If you do not like @code{transient-mark-mode}, you can create
+an active region by using the mouse to select a region, or pressing
@kbd{C-@key{SPC}} twice before moving the cursor.
-@node Feedback, Conventions, Activation, Introduction
+@node Feedback
@section Feedback
@cindex feedback
@cindex bug reports
@@ -1018,6 +1001,8 @@ active region by using the mouse to select a region, or pressing
If you find problems with Org, or if you have questions, remarks, or ideas
about it, please mail 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, on 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
@@ -1028,13 +1013,13 @@ version of Org available---if you are running an outdated version, it is
quite possible that the bug has been fixed already. If the bug persists,
prepare a report and provide as much information as possible, including the
version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org
-(@kbd{M-x org-version RET}), as well as the Org related setup in
-@file{.emacs}. The easiest way to do this is to use the command
+(@kbd{M-x org-version RET}), as well as the Org related setup in the Emacs
+init file. The easiest way to do this is to use the command
@example
@kbd{M-x org-submit-bug-report RET}
@end example
@noindent which will put all this information into an Emacs mail buffer so
-that you only need to add your description. If you re not sending the Email
+that you only need to add your description. If you are not sending the Email
from within Emacs, please copy and paste the content into your Email program.
Sometimes you might face a problem due to an error in your Emacs or Org mode
@@ -1061,8 +1046,8 @@ shown below.
debug-on-quit nil)
;; add latest org-mode to load path
-(add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp"))
-(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t))
+(add-to-list 'load-path "/path/to/org-mode/lisp")
+(add-to-list 'load-path "/path/to/org-mode/contrib/lisp" t)
@end lisp
If an error occurs, a backtrace can be very useful (see below on how to
@@ -1097,8 +1082,7 @@ To do this, use
or select @code{Org -> Refresh/Reload -> Reload Org uncompiled} from the
menu.
@item
-Go to the @code{Options} menu and select @code{Enter Debugger on Error}
-(XEmacs has this option in the @code{Troubleshooting} sub-menu).
+Go to the @code{Options} menu and select @code{Enter Debugger on Error}.
@item
Do whatever you have to do to hit the error. Don't forget to
document the steps you take.
@@ -1108,7 +1092,7 @@ screen. Save this buffer to a file (for example using @kbd{C-x C-w}) and
attach it to your bug report.
@end enumerate
-@node Conventions, , Feedback, Introduction
+@node Conventions
@section Typesetting conventions used in this manual
@subsubheading TODO keywords, tags, properties, etc.
@@ -1132,21 +1116,20 @@ special meaning are written with all capitals.
@end table
Moreover, Org uses @i{option keywords} (like @code{#+TITLE} to set the title)
-and @i{environment keywords} (like @code{#+BEGIN_HTML} to start a @code{HTML}
-environment). They are written in uppercase in the manual to enhance its
-readability, but you can use lowercase in your Org files@footnote{Easy
-templates insert lowercase keywords and Babel dynamically inserts
-@code{#+results}.}.
+and @i{environment keywords} (like @code{#+BEGIN_EXPORT html} to start
+a @code{HTML} environment). They are written in uppercase in the manual to
+enhance its readability, but you can use lowercase in your Org file.
-@subsubheading Keybindings and commands
+@subsubheading Key bindings and commands
@kindex C-c a
@findex org-agenda
@kindex C-c c
@findex org-capture
-The manual suggests two global keybindings: @kbd{C-c a} for @code{org-agenda}
-and @kbd{C-c c} for @code{org-capture}. These are only suggestions, but the
-rest of the manual assumes that you are using these keybindings.
+The manual suggests a few global key bindings, in particular @kbd{C-c a} for
+@code{org-agenda} and @kbd{C-c c} for @code{org-capture}. These are only
+suggestions, but the rest of the manual assumes that these key bindings are in
+place in order to list commands by key access.
Also, the manual lists both the keys and the corresponding commands for
accessing a functionality. Org mode often uses the same key for different
@@ -1159,7 +1142,7 @@ will be listed to call @code{org-table-move-column-right}. If you prefer,
you can compile the manual without the command names by unsetting the flag
@code{cmdnames} in @file{org.texi}.
-@node Document Structure, Tables, Introduction, Top
+@node Document structure
@chapter Document structure
@cindex document structure
@cindex structure of document
@@ -1182,7 +1165,7 @@ edit the structure of the document.
* Org syntax:: Formal description of Org's syntax
@end menu
-@node Outlines, Headlines, Document Structure, Document Structure
+@node Outlines
@section Outlines
@cindex outlines
@cindex Outline mode
@@ -1196,7 +1179,7 @@ currently being worked on. Org greatly simplifies the use of
outlines by compressing the entire show/hide functionality into a single
command, @command{org-cycle}, which is bound to the @key{TAB} key.
-@node Headlines, Visibility cycling, Outlines, Document Structure
+@node Headlines
@section Headlines
@cindex headlines
@cindex outline tree
@@ -1209,7 +1192,7 @@ 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}, and
@code{org-ctrl-k-protect-subtree} to configure special behavior of @kbd{C-a},
@kbd{C-e}, and @kbd{C-k} in headlines.} @footnote{Clocking only works with
-headings indented less then 30 stars.}. For example:
+headings indented less than 30 stars.}. For example:
@example
* Top level headline
@@ -1222,7 +1205,12 @@ headings indented less then 30 stars.}. For example:
* Another top level headline
@end example
-@noindent Some people find the many stars too noisy and would prefer an
+@vindex org-footnote-section
+@noindent Note that a headline named after @code{org-footnote-section},
+which defaults to @samp{Footnotes}, is considered as special. A subtree with
+this headline will be silently ignored by exporting functions.
+
+Some people find the many stars too noisy and would prefer an
outline that has whitespace followed by a single star as headline
starters. @ref{Clean view}, describes a setup to realize this.
@@ -1233,7 +1221,7 @@ least two empty lines, one empty line will remain visible after folding
the subtree, in order to structure the collapsed view. See the
variable @code{org-cycle-separator-lines} to modify this behavior.
-@node Visibility cycling, Motion, Headlines, Document Structure
+@node Visibility cycling
@section Visibility cycling
@cindex cycling, visibility
@cindex visibility cycling
@@ -1247,7 +1235,7 @@ variable @code{org-cycle-separator-lines} to modify this behavior.
* Catching invisible edits:: Preventing mistakes when editing invisible parts
@end menu
-@node Global and local cycling, Initial visibility, Visibility cycling, Visibility cycling
+@node Global and local cycling
@subsection Global and local cycling
Outlines make it possible to hide parts of the text in the buffer.
@@ -1269,13 +1257,8 @@ Org uses just two commands, bound to @key{TAB} and
@end example
@vindex org-cycle-emulate-tab
-@vindex org-cycle-global-at-bob
The cursor must be on a headline for this to work@footnote{see, however,
-the option @code{org-cycle-emulate-tab}.}. When the cursor is at the
-beginning of the buffer and the first line is not a headline, then
-@key{TAB} actually runs global cycling (see below)@footnote{see the
-option @code{org-cycle-global-at-bob}.}. Also when called with a prefix
-argument (@kbd{C-u @key{TAB}}), global cycling is invoked.
+the option @code{org-cycle-emulate-tab}.}.
@cindex global visibility states
@cindex global cycling
@@ -1295,11 +1278,16 @@ When @kbd{S-@key{TAB}} is called with a numeric prefix argument N, the
CONTENTS view up to headlines of level N will be shown. Note that inside
tables, @kbd{S-@key{TAB}} jumps to the previous field.
+@vindex org-cycle-global-at-bob
+You can run global cycling using @key{TAB} only if point is at the very
+beginning of the buffer, but not on a headline, and
+@code{org-cycle-global-at-bob} is set to a non-@code{nil} value.
+
@cindex set startup visibility, command
@orgcmd{C-u C-u @key{TAB},org-set-startup-visibility}
Switch back to the startup visibility of the buffer (@pxref{Initial visibility}).
@cindex show all, command
-@orgcmd{C-u C-u C-u @key{TAB},show-all}
+@orgcmd{C-u C-u C-u @key{TAB},outline-show-all}
Show all, including drawers.
@cindex revealing context
@orgcmd{C-c C-r,org-reveal}
@@ -1310,37 +1298,25 @@ exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command
level, all sibling headings. With a double prefix argument, also show the
entire subtree of the parent.
@cindex show branches, command
-@orgcmd{C-c C-k,show-branches}
-Expose all the headings of the subtree, CONTENT view for just one subtree.
+@orgcmd{C-c C-k,outline-show-branches}
+Expose all the headings of the subtree, CONTENTS view for just one subtree.
@cindex show children, command
-@orgcmd{C-c @key{TAB},show-children}
+@orgcmd{C-c @key{TAB},outline-show-children}
Expose all direct children of the subtree. With a numeric prefix argument N,
expose all children down to level N@.
@orgcmd{C-c C-x b,org-tree-to-indirect-buffer}
-Show the current subtree in an indirect buffer@footnote{The indirect
-buffer
-@ifinfo
-(@pxref{Indirect Buffers,,,emacs,GNU Emacs Manual})
-@end ifinfo
-@ifnotinfo
-(see the Emacs manual for more information about indirect buffers)
-@end ifnotinfo
-will contain the entire buffer, but will be narrowed to the current
-tree. Editing the indirect buffer will also change the original buffer,
-but without affecting visibility in that buffer.}. 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.
+Show the current subtree in an indirect buffer@footnote{The indirect buffer
+(@pxref{Indirect Buffers,,,emacs,GNU Emacs Manual}) will contain the entire
+buffer, but will be narrowed to the current tree. Editing the indirect
+buffer will also change the original buffer, but without affecting visibility
+in that buffer.}. 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.
@orgcmd{C-c C-x v,org-copy-visible}
Copy the @i{visible} text in the region into the kill ring.
@end table
-@menu
-* Initial visibility:: Setting the initial visibility state
-* Catching invisible edits:: Preventing mistakes when editing invisible parts
-@end menu
-
-@node Initial visibility, Catching invisible edits, Global and local cycling, Visibility cycling
+@node Initial visibility
@subsection Initial visibility
@cindex visibility, initialize
@@ -1366,14 +1342,10 @@ following lines anywhere in the buffer:
#+STARTUP: showeverything
@end example
-The startup visibility options are ignored when the file is open for the
-first time during the agenda generation: if you want the agenda to honor
-the startup visibility, set @code{org-agenda-inhibit-startup} to @code{nil}.
-
@cindex property, VISIBILITY
@noindent
Furthermore, any entries with a @samp{VISIBILITY} property (@pxref{Properties
-and Columns}) will get their visibility adapted accordingly. Allowed values
+and columns}) will get their visibility adapted accordingly. Allowed values
for this property are @code{folded}, @code{children}, @code{content}, and
@code{all}.
@@ -1384,7 +1356,7 @@ requested by startup options and @samp{VISIBILITY} properties in individual
entries.
@end table
-@node Catching invisible edits, , Initial visibility, Visibility cycling
+@node Catching invisible edits
@subsection Catching invisible edits
@vindex org-catch-invisible-edits
@@ -1395,7 +1367,7 @@ confused on what has been edited and how to undo the mistake. Setting
docstring of this option on how Org should catch invisible edits and process
them.
-@node Motion, Structure editing, Visibility cycling, Document Structure
+@node Motion
@section Motion
@cindex motion, between headlines
@cindex jumping, to headlines
@@ -1403,9 +1375,9 @@ them.
The following commands jump to other headlines in the buffer.
@table @asis
-@orgcmd{C-c C-n,outline-next-visible-heading}
+@orgcmd{C-c C-n,org-next-visible-heading}
Next heading.
-@orgcmd{C-c C-p,outline-previous-visible-heading}
+@orgcmd{C-c C-p,org-previous-visible-heading}
Previous heading.
@orgcmd{C-c C-f,org-forward-same-level}
Next heading same level.
@@ -1435,7 +1407,7 @@ q @r{Quit}
See also the option @code{org-goto-interface}.
@end table
-@node Structure editing, Sparse trees, Motion, Document Structure
+@node Structure editing
@section Structure editing
@cindex structure editing
@cindex headline, promotion and demotion
@@ -1449,26 +1421,25 @@ See also the option @code{org-goto-interface}.
@cindex subtrees, cut and paste
@table @asis
-@orgcmd{M-@key{RET},org-insert-heading}
+@orgcmd{M-@key{RET},org-meta-return}
@vindex org-M-RET-may-split-line
-Insert a new heading/item with the same level than the one at point.
-If the cursor is in a plain list item, a new item is created
-(@pxref{Plain lists}). To prevent this behavior in lists, call the
-command with a prefix argument. When this command is used in the
-middle of a line, the line is split and the rest of the line becomes
-the new item or headline@footnote{If you do not want the line to be
-split, customize the variable @code{org-M-RET-may-split-line}.}. If
-the command is used at the @emph{beginning} of a headline, the new
-headline is created before the current line. If the command is used
-at the @emph{end} of a folded subtree (i.e., behind the ellipses at
-the end of a headline), then a headline will be
-inserted after the end of the subtree. Calling this command with
-@kbd{C-u C-u} will unconditionally respect the headline's content and
-create a new item at the end of the parent subtree.
+Insert a new heading, item or row.
+
+If the command is used at the @emph{beginning} of a line, and if there is
+a heading or a plain list item (@pxref{Plain lists}) at point, the new
+heading/item is created @emph{before} the current line. When used at the
+beginning of a regular line of text, turn that line into a heading.
+
+When this command is used in the middle of a line, the line is split and the
+rest of the line becomes the new item or headline. If you do not want the
+line to be split, customize @code{org-M-RET-may-split-line}.
+
+Calling the command with a @kbd{C-u} prefix unconditionally inserts a new
+heading at the end of the current subtree, thus preserving its contents.
+With a double @kbd{C-u C-u} prefix, the new heading is created at the end of
+the parent subtree instead.
@orgcmd{C-@key{RET},org-insert-heading-respect-content}
-Just like @kbd{M-@key{RET}}, except when adding a new heading below the
-current heading, the new heading is placed after the body instead of before
-it. This command works from anywhere in the entry.
+Insert a new heading at the end of the current subtree.
@orgcmd{M-S-@key{RET},org-insert-todo-heading}
@vindex org-treat-insert-todo-heading-as-state-change
Insert new TODO entry with same level as current heading. See also the
@@ -1490,10 +1461,10 @@ Demote current heading by one level.
Promote the current subtree by one level.
@orgcmd{M-S-@key{right},org-demote-subtree}
Demote the current subtree by one level.
-@orgcmd{M-S-@key{up},org-move-subtree-up}
+@orgcmd{M-@key{up},org-move-subtree-up}
Move subtree up (swap with previous subtree of same
level).
-@orgcmd{M-S-@key{down},org-move-subtree-down}
+@orgcmd{M-@key{down},org-move-subtree-down}
Move subtree down (swap with next subtree of same level).
@orgcmd{M-h,org-mark-element}
Mark the element at point. Hitting repeatedly will mark subsequent elements
@@ -1572,33 +1543,29 @@ inside a table (@pxref{Tables}), the Meta-Cursor keys have different
functionality.
-@node Sparse trees, Plain lists, Structure editing, Document Structure
+@node Sparse trees
@section Sparse trees
@cindex sparse trees
@cindex trees, sparse
@cindex folding, sparse trees
@cindex occur, command
-@vindex org-show-hierarchy-above
-@vindex org-show-following-heading
-@vindex org-show-siblings
-@vindex org-show-entry-below
+@vindex org-show-context-detail
An important feature of Org mode is the ability to construct @emph{sparse
trees} for selected information in an outline tree, so that the entire
document is folded as much as possible, but the selected information is made
visible along with the headline structure above it@footnote{See also the
-variables @code{org-show-hierarchy-above}, @code{org-show-following-heading},
-@code{org-show-siblings}, and @code{org-show-entry-below} for detailed
-control on how much context is shown around each match.}. Just try it out
-and you will see immediately how it works.
+variable @code{org-show-context-detail} to decide how much context is shown
+around each match.}. Just try it out and you will see immediately how it
+works.
-Org mode contains several commands creating such trees, all these
+Org mode contains several commands for creating such trees, all these
commands can be accessed through a dispatcher:
@table @asis
@orgcmd{C-c /,org-sparse-tree}
This prompts for an extra key to select a sparse-tree creating command.
-@orgcmd{C-c / r,org-occur}
+@orgcmdkkc{C-c / r,C-c / /,org-occur}
@vindex org-remove-highlights-with-change
Prompts for a regexp and shows a sparse tree with all matches. If
the match is in a headline, the headline is made visible. If the match is in
@@ -1639,13 +1606,11 @@ tags, or properties and will be discussed later in this manual.
@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 @footnote{This does not work under XEmacs, because
-XEmacs uses selective display for outlining, not text properties.}.
-Or you can use @kbd{C-c C-e C-v} to export only the visible part of
-the document and print the resulting file.
+@code{ps-print-buffer-with-faces} which does not print invisible parts of the
+document. Or you can use @kbd{C-c C-e C-v} to export only the visible part
+of the document and print the resulting file.
-@node Plain lists, Drawers, Sparse trees, Document Structure
+@node Plain lists
@section Plain lists
@cindex plain lists
@cindex lists, plain
@@ -1694,11 +1659,9 @@ line. In particular, if an ordered list reaches number @samp{10.}, then the
list. An item ends before the next line that is less or equally indented
than its bullet/number.
-@vindex org-list-empty-line-terminates-plain-lists
A list ends whenever every item has ended, which means before any line less
or equally indented than items at top level. It also ends before two blank
-lines@footnote{See also @code{org-list-empty-line-terminates-plain-lists}.}.
-In that case, all items are closed. Here is an example:
+lines. In that case, all items are closed. Here is an example:
@example
@group
@@ -1714,25 +1677,23 @@ In that case, all items are closed. Here is an example:
But in the end, no individual scenes matter but the film as a whole.
Important actors in this film are:
- @b{Elijah Wood} :: He plays Frodo
- - @b{Sean Austin} :: He plays Sam, Frodo's friend. I still remember
+ - @b{Sean Astin} :: He plays Sam, Frodo's friend. I still remember
him very well from his role as Mikey Walsh in @i{The Goonies}.
@end group
@end example
Org supports these lists by tuning filling and wrapping commands to deal with
-them correctly@footnote{Org only changes the filling settings for Emacs. For
-XEmacs, you should use Kyle E. Jones' @file{filladapt.el}. To turn this on,
-put into @file{.emacs}: @code{(require 'filladapt)}}, and by exporting them
-properly (@pxref{Exporting}). Since indentation is what governs the
-structure of these lists, many structural constructs like @code{#+BEGIN_...}
-blocks can be indented to signal that they belong to a particular item.
+them correctly, and by exporting them properly (@pxref{Exporting}). Since
+indentation is what governs the structure of these lists, many structural
+constructs like @code{#+BEGIN_...} blocks can be indented to signal that they
+belong to a particular item.
@vindex org-list-demote-modify-bullet
@vindex org-list-indent-offset
If you find that using a different bullet for a sub-list (than that used for
the current list-level) improves readability, customize the variable
@code{org-list-demote-modify-bullet}. To get a greater difference of
-indentation between items and theirs sub-items, customize
+indentation between items and their sub-items, customize
@code{org-list-indent-offset}.
@vindex org-list-automatic-rules
@@ -1824,10 +1785,10 @@ Cycle the entire list level through the different itemize/enumerate bullets
(@samp{-}, @samp{+}, @samp{*}, @samp{1.}, @samp{1)}) or a subset of them,
depending 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 will be changed into an item. With a prefix argument, all lines will be
-converted to list items. If the first line already was a list item, any item
-marker will be removed from the list. Finally, even without an active
+from this list. If there is an active region when calling this, all selected
+lines are converted to list items. With a prefix argument, selected text is
+changed into a single item. If the first line already was a list item, any
+item marker will be removed from the list. Finally, even without an active
region, a normal line will be converted into a list item.
@kindex C-c *
@item C-c *
@@ -1853,20 +1814,17 @@ numerically, alphabetically, by time, by checked status for check lists,
or by a custom function.
@end table
-@node Drawers, Blocks, Plain lists, Document Structure
+@node Drawers
@section Drawers
@cindex drawers
-@cindex #+DRAWERS
@cindex visibility cycling, drawers
-@vindex org-drawers
@cindex org-insert-drawer
@kindex C-c C-x d
Sometimes you want to keep information associated with an entry, but you
-normally don't want to see it. For this, Org mode has @emph{drawers}.
-Drawers need to be configured with the option @code{org-drawers}@footnote{You
-can define additional drawers on a per-file basis with a line like
-@code{#+DRAWERS: HIDDEN STATE}}. Drawers look like this:
+normally don't want to see it. For this, Org mode has @emph{drawers}. They
+can contain anything but a headline and another drawer. Drawers look like
+this:
@example
** This is a headline
@@ -1880,18 +1838,21 @@ can define additional drawers on a per-file basis with a line like
You can interactively insert drawers at point by calling
@code{org-insert-drawer}, which is bound to @key{C-c C-x d}. With an active
region, this command will put the region inside the drawer. With a prefix
-argument, this command calls @code{org-insert-property-drawer} and add a
-property drawer right below the current headline. Completion over drawer
-keywords is also possible using @key{M-TAB}.
+argument, this command calls @code{org-insert-property-drawer} and add
+a property drawer right below the current headline. Completion over drawer
+keywords is also possible using @kbd{M-@key{TAB}}@footnote{Many desktops
+intercept @kbd{M-@key{TAB}} to switch windows. Use @kbd{C-M-i} or
+@kbd{@key{ESC} @key{TAB}} instead for completion (@pxref{Completion}).}.
Visibility cycling (@pxref{Visibility cycling}) on the headline will hide and
show the entry, but keep the drawer collapsed to a single line. In order to
look inside the drawer, you need to move the cursor to the drawer line and
press @key{TAB} there. Org mode uses the @code{PROPERTIES} drawer for
-storing properties (@pxref{Properties and Columns}), and you can also arrange
+storing properties (@pxref{Properties and columns}), and you can also arrange
for state change notes (@pxref{Tracking TODO state changes}) and clock times
(@pxref{Clocking work time}) to be stored in a drawer @code{LOGBOOK}. If you
-want to store a quick note in the LOGBOOK drawer, in a similar way to state changes, use
+want to store a quick note in the LOGBOOK drawer, in a similar way to state
+changes, use
@table @kbd
@kindex C-c C-z
@@ -1900,12 +1861,13 @@ Add a time-stamped note to the LOGBOOK drawer.
@end table
@vindex org-export-with-drawers
+@vindex org-export-with-properties
You can select the name of the drawers which should be exported with
@code{org-export-with-drawers}. In that case, drawer contents will appear in
-export output. Property drawers are not affected by this variable and are
-never exported.
+export output. Property drawers are not affected by this variable: configure
+@code{org-export-with-properties} instead.
-@node Blocks, Footnotes, Drawers, Document Structure
+@node Blocks
@section Blocks
@vindex org-hide-block-startup
@@ -1924,18 +1886,17 @@ or on a per-file basis by using
#+STARTUP: nohideblocks
@end example
-@node Footnotes, Orgstruct mode, Blocks, Document Structure
+@node Footnotes
@section Footnotes
@cindex footnotes
-Org mode supports the creation of footnotes. In contrast to the
-@file{footnote.el} package, Org mode's footnotes are designed for work on
-a larger document, not only for one-off documents like emails.
+Org mode supports the creation of footnotes.
A footnote is started by a footnote marker in square brackets in column 0, no
indentation allowed. It ends at the next footnote definition, headline, or
after two consecutive empty lines. The footnote reference is simply the
-marker in square brackets, inside text. For example:
+marker in square brackets, inside text. Markers always start with
+@code{fn:}. For example:
@example
The Org homepage[fn:1] now looks a lot better than it used to.
@@ -1944,23 +1905,16 @@ The Org homepage[fn:1] now looks a lot better than it used to.
@end example
Org mode extends the number-based syntax to @emph{named} footnotes and
-optional inline definition. Using plain numbers as markers (as
-@file{footnote.el} does) is supported for backward compatibility, but not
-encouraged because of possible conflicts with @LaTeX{} snippets (@pxref{Embedded
-@LaTeX{}}). Here are the valid references:
+optional inline definition. Here are the valid references:
@table @code
-@item [1]
-A plain numeric footnote marker. Compatible with @file{footnote.el}, but not
-recommended because something like @samp{[1]} could easily be part of a code
-snippet.
@item [fn:name]
A named footnote reference, where @code{name} is a unique label word, or, for
simplicity of automatic creation, a number.
-@item [fn:: This is the inline definition of this footnote]
+@item [fn::This is the inline definition of this footnote]
A @LaTeX{}-like anonymous footnote where the definition is given directly at the
reference point.
-@item [fn:name: a definition]
+@item [fn:name:a definition]
An inline definition of a footnote, which also specifies a name for the note.
Since Org allows multiple references to the same note, you can then use
@code{[fn:name]} to create additional references.
@@ -2007,9 +1961,7 @@ r @r{Renumber the simple @code{fn:N} footnotes. Automatic renumbering}
S @r{Short for first @code{r}, then @code{s} action.}
n @r{Normalize the footnotes by collecting all definitions (including}
@r{inline definitions) into a special section, and then numbering them}
- @r{in sequence. The references will then also be numbers. This is}
- @r{meant to be the final step before finishing a document (e.g., sending}
- @r{off an email).}
+ @r{in sequence. The references will then also be numbers.}
d @r{Delete the footnote at point, and all definitions of and references}
@r{to it.}
@end example
@@ -2029,9 +1981,17 @@ location with a prefix argument, offer the same menu as @kbd{C-c C-x f}.
@item C-c C-o @r{or} mouse-1/2
Footnote labels are also links to the corresponding definition/reference, and
you can use the usual commands to follow these links.
+
+@vindex org-edit-footnote-reference
+@kindex C-c '
+@item C-c '
+@item C-c '
+Edit the footnote definition corresponding to the reference at point in
+a separate window. The window can be closed by pressing @kbd{C-c '}.
+
@end table
-@node Orgstruct mode, Org syntax, Footnotes, Document Structure
+@node Orgstruct mode
@section The Orgstruct minor mode
@cindex Orgstruct mode
@cindex minor mode for structure editing
@@ -2066,7 +2026,7 @@ Lisp files, you will be able to fold and unfold headlines in Emacs Lisp
commented lines. Some commands like @code{org-demote} are disabled when the
prefix is set, but folding/unfolding will work correctly.
-@node Org syntax, , Orgstruct mode, Document Structure
+@node Org syntax
@section Org syntax
@cindex Org syntax
@@ -2088,7 +2048,11 @@ abstract structure. The export engine relies on the information stored in
this list. Most interactive commands (e.g., for structure editing) also
rely on the syntactic meaning of the surrounding context.
-@node Tables, Hyperlinks, Document Structure, Top
+@cindex syntax checker
+@cindex linter
+You can check syntax in your documents using @code{org-lint} command.
+
+@node Tables
@chapter Tables
@cindex tables
@cindex editing tables
@@ -2106,7 +2070,7 @@ calculations are supported using the Emacs @file{calc} package
* Org-Plot:: Plotting from org tables
@end menu
-@node Built-in table editor, Column width and alignment, Tables, Tables
+@node Built-in table editor
@section The built-in table editor
@cindex table editor, built-in
@@ -2141,26 +2105,25 @@ create the above table, you would only type
fields. Even faster would be to type @code{|Name|Phone|Age} followed by
@kbd{C-c @key{RET}}.
-@vindex org-enable-table-editor
@vindex org-table-auto-blank-field
-When typing text into a field, Org treats @key{DEL},
-@key{Backspace}, and all character keys in a special way, so that
-inserting and deleting avoids shifting other fields. Also, when
-typing @emph{immediately after the cursor was moved into a new field
-with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or @kbd{@key{RET}}}, the
-field is automatically made blank. If this behavior is too
-unpredictable for you, configure the options
-@code{org-enable-table-editor} and @code{org-table-auto-blank-field}.
+When typing text into a field, Org treats @key{DEL}, @key{Backspace}, and all
+character keys in a special way, so that inserting and deleting avoids
+shifting other fields. Also, when typing @emph{immediately after the cursor
+was moved into a new field with @kbd{@key{TAB}}, @kbd{S-@key{TAB}} or
+@kbd{@key{RET}}}, the field is automatically made blank. If this behavior is
+too unpredictable for you, configure the option
+@code{org-table-auto-blank-field}.
@table @kbd
@tsubheading{Creation and conversion}
@orgcmd{C-c |,org-table-create-or-convert-from-region}
-Convert the active region to table. If every line contains at least one
+Convert the active region to a table. If every line contains at least one
TAB character, the function assumes that the material is tab separated.
If every line contains a comma, comma-separated values (CSV) are assumed.
If not, lines are split at whitespace into fields. You can use a prefix
argument to force a specific separator: @kbd{C-u} forces CSV, @kbd{C-u
-C-u} forces TAB, and a numeric argument N indicates that at least N
+C-u} forces TAB, @kbd{C-u C-u C-u} will prompt for a regular expression to
+match the separator, and a numeric argument N indicates that at least N
consecutive spaces, or alternatively a TAB will be the separator.
@*
If there is no active region, this command creates an empty Org
@@ -2171,7 +2134,10 @@ table. But it is easier just to start typing, like
@orgcmd{C-c C-c,org-table-align}
Re-align the table and don't move to another field.
@c
-@orgcmd{<TAB>,org-table-next-field}
+@orgcmd{C-c SPC,org-table-blank-field}
+Blank the field at point.
+@c
+@orgcmd{TAB,org-table-next-field}
Re-align the table, move to the next field. Creates a new row if
necessary.
@c
@@ -2224,8 +2190,10 @@ point is before the first column, you will be prompted for the sorting
column. If there is an active region, the mark specifies the first line
and the sorting column, while point should be in the last line to be
included into the sorting. The command prompts for the sorting type
-(alphabetically, numerically, or by time). When called with a prefix
-argument, alphabetic sorting will be case-sensitive.
+(alphabetically, numerically, or by time). You can sort in normal or
+reverse order. You can also supply your own key extraction and comparison
+functions. When called with a prefix argument, alphabetic sorting will be
+case-sensitive.
@tsubheading{Regions}
@orgcmd{C-c C-x M-w,org-table-copy-region}
@@ -2322,7 +2290,7 @@ it off with
@noindent Then the only table command that still works is
@kbd{C-c C-c} to do a manual re-align.
-@node Column width and alignment, Column groups, Built-in table editor, Tables
+@node Column width and alignment
@section Column width and alignment
@cindex narrow columns in tables
@cindex alignment in tables
@@ -2333,11 +2301,11 @@ of number-like versus non-number fields in the column.
Sometimes a single field or a few fields need to carry more text, leading to
inconveniently wide columns. Or maybe you want to make a table with several
-columns having a fixed width, regardless of content. To set@footnote{This
-feature does not work on XEmacs.} the width of a column, one field anywhere
-in the column may contain just the string @samp{<N>} where @samp{N} is an
-integer specifying the width of the column in characters. The next re-align
-will then set the width of this column to this value.
+columns having a fixed width, regardless of content. To set the width of
+a column, one field anywhere in the column may contain just the string
+@samp{<N>} where @samp{N} is an integer specifying the width of the column in
+characters. The next re-align will then set the width of this column to this
+value.
@example
@group
@@ -2374,7 +2342,7 @@ on a per-file basis with:
@end example
If you would like to overrule the automatic alignment of number-rich columns
-to the right and of string-rich column to the left, you can use @samp{<r>},
+to the right and of string-rich columns to the left, you can use @samp{<r>},
@samp{<c>}@footnote{Centering does not work inside Emacs, but it does have an
effect when exporting to HTML.} or @samp{<l>} in a similar fashion. You may
also combine alignment and field width like this: @samp{<r10>}.
@@ -2382,30 +2350,29 @@ also combine alignment and field width like this: @samp{<r10>}.
Lines which only contain these formatting cookies will be removed
automatically when exporting the document.
-@node Column groups, Orgtbl mode, Column width and alignment, Tables
+@node Column groups
@section Column groups
@cindex grouping columns in tables
-When Org exports tables, it does so by default without vertical
-lines because that is visually more satisfying in general. Occasionally
-however, vertical lines can be useful to structure a table into groups
-of columns, much like horizontal lines can do for groups of rows. In
-order to specify column groups, you can use a special row where the
-first field contains only @samp{/}. The further fields can either
-contain @samp{<} to indicate that this column should start a group,
-@samp{>} to indicate the end of a column, or @samp{<>} (no space between @samp{<}
-and @samp{>}) to make a column
-a group of its own. Boundaries between column groups will upon export be
-marked with vertical lines. Here is an example:
-
-@example
-| N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) |
-|---+-----+-----+-----+---------+------------|
-| / | < | | > | < | > |
-| 1 | 1 | 1 | 1 | 1 | 1 |
-| 2 | 4 | 8 | 16 | 1.4142 | 1.1892 |
-| 3 | 9 | 27 | 81 | 1.7321 | 1.3161 |
-|---+-----+-----+-----+---------+------------|
+When Org exports tables, it does so by default without vertical lines because
+that is visually more satisfying in general. Occasionally however, vertical
+lines can be useful to structure a table into groups of columns, much like
+horizontal lines can do for groups of rows. In order to specify column
+groups, you can use a special row where the first field contains only
+@samp{/}. The further fields can either contain @samp{<} to indicate that
+this column should start a group, @samp{>} to indicate the end of a group, or
+@samp{<>} (no space between @samp{<} and @samp{>}) to make a column a group
+of its own. Boundaries between column groups will upon export be marked with
+vertical lines. Here is an example:
+
+@example
+| N | N^2 | N^3 | N^4 | ~sqrt(n)~ | ~sqrt[4](N)~ |
+|---+-----+-----+-----+-----------+--------------|
+| / | < | | > | < | > |
+| 1 | 1 | 1 | 1 | 1 | 1 |
+| 2 | 4 | 8 | 16 | 1.4142 | 1.1892 |
+| 3 | 9 | 27 | 81 | 1.7321 | 1.3161 |
+|---+-----+-----+-----+-----------+--------------|
#+TBLFM: $2=$1^2::$3=$1^3::$4=$1^4::$5=sqrt($1)::$6=sqrt(sqrt(($1)))
@end example
@@ -2418,7 +2385,7 @@ every vertical line you would like to have:
| / | < | | | < | |
@end example
-@node Orgtbl mode, The spreadsheet, Column groups, Tables
+@node Orgtbl mode
@section The Orgtbl minor mode
@cindex Orgtbl mode
@cindex minor mode for tables
@@ -2439,7 +2406,7 @@ construct @LaTeX{} tables with the underlying ease and power of
Orgtbl mode, including spreadsheet capabilities. For details, see
@ref{Tables in arbitrary syntax}.
-@node The spreadsheet, Org-Plot, Orgtbl mode, Tables
+@node The spreadsheet
@section The spreadsheet
@cindex calculations, in tables
@cindex spreadsheet capabilities
@@ -2468,7 +2435,7 @@ formula, moving these references by arrow keys
* Advanced features:: Field and column names, parameters and automatic recalc
@end menu
-@node References, Formula syntax for Calc, The spreadsheet, The spreadsheet
+@node References
@subsection References
@cindex references
@@ -2554,7 +2521,7 @@ format at least for the first field (i.e the reference must start with
@example
$1..$3 @r{first three fields in the current row}
$P..$Q @r{range, using column names (see under Advanced)}
-$<<<..$>> @r{start in third column, continue to the one but last}
+$<<<..$>> @r{start in third column, continue to the last but one}
@@2$1..@@4$3 @r{6 fields between these two fields (same as @code{A2..C4})}
@@-1$-2..@@-1 @r{3 fields in the row above, starting from 2 columns on the left}
@@I..II @r{between first and second hline, short for @code{@@I..@@II}}
@@ -2572,21 +2539,28 @@ for Calc}.
@cindex row, of field coordinates
@cindex column, of field coordinates
-For Calc formulas and Lisp formulas @code{@@#} and @code{$#} can be used to
-get the row or column number of the field where the formula result goes.
-The traditional Lisp formula equivalents are @code{org-table-current-dline}
-and @code{org-table-current-column}. Examples:
+One of the very first actions during evaluation of Calc formulas and Lisp
+formulas is to substitute @code{@@#} and @code{$#} in the formula with the
+row or column number of the field where the current result will go to. The
+traditional Lisp formula equivalents are @code{org-table-current-dline} and
+@code{org-table-current-column}. Examples:
-@example
-if(@@# % 2, $#, string("")) @r{column number on odd lines only}
-$3 = remote(FOO, @@@@#$2) @r{copy column 2 from table FOO into}
- @r{column 3 of the current table}
-@end example
+@table @code
+@item if(@@# % 2, $#, string(""))
+Insert column number on odd rows, set field to empty on even rows.
+@item $2 = '(identity remote(FOO, @@@@#$1))
+Copy text or values of each row of column 1 of the table named @code{FOO}
+into column 2 of the current table.
+@item @@3 = 2 * remote(FOO, @@1$$#)
+Insert the doubled value of each column of row 1 of the table named
+@code{FOO} into row 3 of the current table.
+@end table
-@noindent For the second example, table FOO must have at least as many rows
-as the current table. Note that this is inefficient@footnote{The computation time scales as
-O(N^2) because table FOO is parsed for each field to be copied.} for large
-number of rows.
+@noindent For the second/third example, the table named @code{FOO} must have
+at least as many rows/columns as the current table. Note that this is
+inefficient@footnote{The computation time scales as O(N^2) because the table
+named @code{FOO} is parsed for each field to be read.} for large number of
+rows/columns.
@subsubheading Named references
@cindex named references
@@ -2608,7 +2582,7 @@ line like
@noindent
@vindex constants-unit-system
@pindex constants.el
-Also properties (@pxref{Properties and Columns}) can be used as
+Also properties (@pxref{Properties and columns}) can be used as
constants in table formulas: for a property @samp{:Xyz:} use the name
@samp{$PROP_Xyz}, and the property will be searched in the current
outline entry and in the hierarchy above it. If you have the
@@ -2647,7 +2621,13 @@ table in that entry. REF is an absolute field or range reference as
described above for example @code{@@3$3} or @code{$somename}, valid in the
referenced table.
-@node Formula syntax for Calc, Formula syntax for Lisp, References, The spreadsheet
+Indirection of NAME-OR-ID: When NAME-OR-ID has the format @code{@@ROW$COLUMN}
+it will be substituted with the name or ID found in this field of the current
+table. For example @code{remote($1, @@>$2)} => @code{remote(year_2013,
+@@>$1)}. The format @code{B3} is not supported because it can not be
+distinguished from a plain table name or ID.
+
+@node Formula syntax for Calc
@subsection Formula syntax for Calc
@cindex formula syntax, Calc
@cindex syntax, of formulas
@@ -2687,7 +2667,7 @@ calculation precision is greater.
Degree and radian angle modes of Calc.
@item @code{F}, @code{S}
Fraction and symbolic modes of Calc.
-@item @code{T}, @code{t}
+@item @code{T}, @code{t}, @code{U}
Duration computations in Calc or Lisp, @pxref{Durations and time values}.
@item @code{E}
If and how to consider empty fields. Without @samp{E} empty fields in range
@@ -2762,7 +2742,7 @@ should be padded with 0 to the full size.
You can add your own Calc functions defined in Emacs Lisp with @code{defmath}
and use them in formula syntax for Calc.
-@node Formula syntax for Lisp, Durations and time values, Formula syntax for Calc, The spreadsheet
+@node Formula syntax for Lisp
@subsection Emacs Lisp forms as formulas
@cindex Lisp forms, as table formulas
@@ -2798,37 +2778,42 @@ Add columns 1 and 2, equivalent to Calc's @code{$1+$2}.
Compute the sum of columns 1 to 4, like Calc's @code{vsum($1..$4)}.
@end table
-@node Durations and time values, Field and range formulas, Formula syntax for Lisp, The spreadsheet
+@node Durations and time values
@subsection Durations and time values
@cindex Duration, computing
@cindex Time, computing
@vindex org-table-duration-custom-format
-If you want to compute time values use the @code{T} flag, either in Calc
-formulas or Elisp formulas:
+If you want to compute time values use the @code{T}, @code{t}, or @code{U}
+flag, either in Calc formulas or Elisp formulas:
@example
@group
| Task 1 | Task 2 | Total |
|---------+----------+----------|
| 2:12 | 1:47 | 03:59:00 |
+ | 2:12 | 1:47 | 03:59 |
| 3:02:20 | -2:07:00 | 0.92 |
- #+TBLFM: @@2$3=$1+$2;T::@@3$3=$1+$2;t
+ #+TBLFM: @@2$3=$1+$2;T::@@3$3=$1+$2;U::@@4$3=$1+$2;t
@end group
@end example
-Input duration values must be of the form @code{[HH:MM[:SS]}, where seconds
+Input duration values must be of the form @code{HH:MM[:SS]}, where seconds
are optional. With the @code{T} flag, computed durations will be displayed
-as @code{HH:MM:SS} (see the first formula above). With the @code{t} flag,
-computed durations will be displayed according to the value of the option
-@code{org-table-duration-custom-format}, which defaults to @code{'hours} and
-will display the result as a fraction of hours (see the second formula in the
-example above).
+as @code{HH:MM:SS} (see the first formula above). With the @code{U} flag,
+seconds will be omitted so that the result will be only @code{HH:MM} (see
+second formula above). Zero-padding of the hours field will depend upon the
+value of the variable @code{org-table-duration-hour-zero-padding}.
+
+With the @code{t} flag, computed durations will be displayed according to the
+value of the option @code{org-table-duration-custom-format}, which defaults
+to @code{'hours} and will display the result as a fraction of hours (see the
+third formula in the example above).
Negative duration values can be manipulated as well, and integers will be
considered as seconds in addition and subtraction.
-@node Field and range formulas, Column formulas, Durations and time values, The spreadsheet
+@node Field and range formulas
@subsection Field and range formulas
@cindex field formula
@cindex range formula
@@ -2845,13 +2830,13 @@ current field will be replaced with the result.
Formulas are stored in a special line starting with @samp{#+TBLFM:} directly
below the table. If you type the equation in the 4th field of the 3rd data
line in the table, the formula will look like @samp{@@3$4=$1+$2}. When
-inserting/deleting/swapping column and rows with the appropriate commands,
+inserting/deleting/swapping columns and rows with the appropriate commands,
@i{absolute references} (but not relative ones) in stored formulas are
-modified in order to still reference the same field. To avoid this from
-happening, in particular in range references, anchor ranges at the table
-borders (using @code{@@<}, @code{@@>}, @code{$<}, @code{$>}), or at hlines
-using the @code{@@I} notation. Automatic adaptation of field references does
-of course not happen if you edit the table structure with normal editing
+modified in order to still reference the same field. To avoid this, in
+particular in range references, anchor ranges at the table borders (using
+@code{@@<}, @code{@@>}, @code{$<}, @code{$>}), or at hlines using the
+@code{@@I} notation. Automatic adaptation of field references does of course
+not happen if you edit the table structure with normal editing
commands---then you must fix the equations yourself.
Instead of typing an equation into the field, you may also use the following
@@ -2884,7 +2869,7 @@ can also be used to assign a formula to some but not all fields in a row.
Named field, see @ref{Advanced features}.
@end table
-@node Column formulas, Lookup functions, Field and range formulas, The spreadsheet
+@node Column formulas
@subsection Column formulas
@cindex column formula
@cindex formula, for table column
@@ -2908,7 +2893,7 @@ and the current field replaced with the result. If the field contains only
@samp{=}, the previously stored formula for this column is used. For each
column, Org will only remember the most recently used formula. In the
@samp{#+TBLFM:} line, column formulas will look like @samp{$4=$1+$2}. The
-left-hand side of a column formula can not be the name of column, it must be
+left-hand side of a column formula cannot be the name of column, it must be
the numeric column reference or @code{$>}.
Instead of typing an equation into the field, you may also use the
@@ -2923,7 +2908,7 @@ stores it. With a numeric prefix argument(e.g., @kbd{C-5 C-c =}) the command
will apply it to that many consecutive fields in the current column.
@end table
-@node Lookup functions, Editing and debugging formulas, Column formulas, The spreadsheet
+@node Lookup functions
@subsection Lookup functions
@cindex lookup functions in tables
@cindex table lookup functions
@@ -2967,7 +2952,7 @@ matching cells, rank results, group data etc. For practical examples
see @uref{http://orgmode.org/worg/org-tutorials/org-lookups.html, this
tutorial on Worg}.
-@node Editing and debugging formulas, Updating the table, Lookup functions, The spreadsheet
+@node Editing and debugging formulas
@subsection Editing and debugging formulas
@cindex formula editing
@cindex editing, of table formulas
@@ -3026,7 +3011,9 @@ a Lisp formula, format the formula according to Emacs Lisp rules.
Another @key{TAB} collapses the formula back again. In the open
formula, @key{TAB} re-indents just like in Emacs Lisp mode.
@orgcmd{M-@key{TAB},lisp-complete-symbol}
-Complete Lisp symbols, just like in Emacs Lisp mode.
+Complete Lisp symbols, just like in Emacs Lisp mode.@footnote{Many desktops
+intercept @kbd{M-@key{TAB}} to switch windows. Use @kbd{C-M-i} or
+@kbd{@key{ESC} @key{TAB}} instead for completion (@pxref{Completion}).}
@kindex S-@key{up}
@kindex S-@key{down}
@kindex S-@key{left}
@@ -3118,7 +3105,7 @@ turn on formula debugging in the @code{Tbl} menu and repeat the
calculation, for example by pressing @kbd{C-u C-u C-c = @key{RET}} in a
field. Detailed information will be displayed.
-@node Updating the table, Advanced features, Editing and debugging formulas, The spreadsheet
+@node Updating the table
@subsection Updating the table
@cindex recomputing table fields
@cindex updating, table
@@ -3155,7 +3142,7 @@ Iterate all tables in the current buffer, in order to converge table-to-table
dependencies.
@end table
-@node Advanced features, , Updating the table, The spreadsheet
+@node Advanced features
@subsection Advanced features
If you want the recalculation of fields to happen automatically, or if you
@@ -3260,17 +3247,23 @@ functions.
@end group
@end example
-@node Org-Plot, , The spreadsheet, Tables
+@node Org-Plot
@section Org-Plot
@cindex graph, in tables
@cindex plot tables using Gnuplot
@cindex #+PLOT
-Org-Plot can produce 2D and 3D graphs of information stored in org tables
-using @file{Gnuplot} @uref{http://www.gnuplot.info/} and @file{gnuplot-mode}
+Org-Plot can produce graphs of information stored in org tables, either
+graphically or in ASCII-art.
+
+@subheading Graphical plots using @file{Gnuplot}
+
+Org-Plot produces 2D and 3D graphs using @file{Gnuplot}
+@uref{http://www.gnuplot.info/} and @file{gnuplot-mode}
@uref{http://xafs.org/BruceRavel/GnuplotMode}. To see this in action, ensure
that you have both Gnuplot and Gnuplot mode installed on your system, then
-call @code{org-plot/gnuplot} on the following table.
+call @kbd{C-c " g} or @kbd{M-x org-plot/gnuplot @key{RET}} on the following
+table.
@example
@group
@@ -3288,8 +3281,8 @@ call @code{org-plot/gnuplot} on the following table.
Notice that Org Plot is smart enough to apply the table's headers as labels.
Further control over the labels, type, content, and appearance of plots can
be exercised through the @code{#+PLOT:} lines preceding a table. See below
-for a complete list of Org-plot options. For more information and examples
-see the Org-plot tutorial at
+for a complete list of Org-plot options. The @code{#+PLOT:} lines are
+optional. For more information and examples see the Org-plot tutorial at
@uref{http://orgmode.org/worg/org-tutorials/org-plot.html}.
@subsubheading Plot Options
@@ -3345,7 +3338,48 @@ may still want to specify the plot type, as that can impact the content of
the data file.
@end table
-@node Hyperlinks, TODO Items, Tables, Top
+@subheading ASCII bar plots
+
+While the cursor is on a column, typing @kbd{C-c " a} or
+@kbd{M-x orgtbl-ascii-plot @key{RET}} create a new column containing an
+ASCII-art bars plot. The plot is implemented through a regular column
+formula. When the source column changes, the bar plot may be updated by
+refreshing the table, for example typing @kbd{C-u C-c *}.
+
+@example
+@group
+| Sede | Max cites | |
+|---------------+-----------+--------------|
+| Chile | 257.72 | WWWWWWWWWWWW |
+| Leeds | 165.77 | WWWWWWWh |
+| Sao Paolo | 71.00 | WWW; |
+| Stockholm | 134.19 | WWWWWW: |
+| Morelia | 257.56 | WWWWWWWWWWWH |
+| Rochefourchat | 0.00 | |
+#+TBLFM: $3='(orgtbl-ascii-draw $2 0.0 257.72 12)
+@end group
+@end example
+
+The formula is an elisp call:
+@lisp
+(orgtbl-ascii-draw COLUMN MIN MAX WIDTH)
+@end lisp
+
+@table @code
+@item COLUMN
+ is a reference to the source column.
+
+@item MIN MAX
+ are the minimal and maximal values displayed. Sources values
+ outside this range are displayed as @samp{too small}
+ or @samp{too large}.
+
+@item WIDTH
+ is the width in characters of the bar-plot. It defaults to @samp{12}.
+
+@end table
+
+@node Hyperlinks
@chapter Hyperlinks
@cindex hyperlinks
@@ -3363,7 +3397,7 @@ other files, Usenet articles, emails, and much more.
* Custom searches:: When the default search is not enough
@end menu
-@node Link format, Internal links, Hyperlinks, Hyperlinks
+@node Link format
@section Link format
@cindex link format
@cindex format, of links
@@ -3394,7 +3428,7 @@ missing bracket hides the link internals again. To show the
internal structure of all links, use the menu entry
@code{Org->Hyperlinks->Literal links}.
-@node Internal links, External links, Link format, Hyperlinks
+@node Internal links
@section Internal links
@cindex internal links
@cindex links, internal
@@ -3419,8 +3453,8 @@ a @i{dedicated target}: the same string in double angular brackets, like
@cindex #+NAME
If no dedicated target exists, the link will then try to match the exact name
of an element within the buffer. Naming is done with the @code{#+NAME}
-keyword, which has to be put the line before the element it refers to, as in
-the following example
+keyword, which has to be put in the line before the element it refers to, as
+in the following example
@example
#+NAME: My Target
@@ -3465,7 +3499,7 @@ earlier.
* Radio targets:: Make targets trigger links in plain text
@end menu
-@node Radio targets, , Internal links, Internal links
+@node Radio targets
@subsection Radio targets
@cindex radio targets
@cindex targets, radio
@@ -3481,7 +3515,7 @@ for radio targets only when the file is first loaded into Emacs. To
update the target list during editing, press @kbd{C-c C-c} with the
cursor on or at a target.
-@node External links, Handling links, Internal links, Hyperlinks
+@node External links
@section External links
@cindex links, external
@cindex external links
@@ -3504,42 +3538,44 @@ string followed by a colon. There can be no space after the colon. The
following list shows examples for each link type.
@example
-http://www.astro.uva.nl/~dominik @r{on the web}
-doi:10.1000/182 @r{DOI for an electronic resource}
-file:/home/dominik/images/jupiter.jpg @r{file, absolute path}
-/home/dominik/images/jupiter.jpg @r{same as above}
-file:papers/last.pdf @r{file, relative path}
-./papers/last.pdf @r{same as above}
-file:/myself@@some.where:papers/last.pdf @r{file, path on remote machine}
-/myself@@some.where:papers/last.pdf @r{same as above}
-file:sometextfile::NNN @r{file, jump to line number}
-file:projects.org @r{another Org file}
-file:projects.org::some words @r{text search in Org file}@footnote{
+http://www.astro.uva.nl/~dominik @r{on the web}
+doi:10.1000/182 @r{DOI for an electronic resource}
+file:/home/dominik/images/jupiter.jpg @r{file, absolute path}
+/home/dominik/images/jupiter.jpg @r{same as above}
+file:papers/last.pdf @r{file, relative path}
+./papers/last.pdf @r{same as above}
+file:/ssh:myself@@some.where:papers/last.pdf @r{file, path on remote machine}
+/ssh:myself@@some.where:papers/last.pdf @r{same as above}
+file:sometextfile::NNN @r{file, jump to line number}
+file:projects.org @r{another Org file}
+file:projects.org::some words @r{text search in Org file}@footnote{
The actual behavior of the search will depend on the value of
the option @code{org-link-search-must-match-exact-headline}. If its value
-is @code{nil}, then a fuzzy text search will be done. If it is t, then only the
-exact headline will be matched. If the value is @code{'query-to-create},
-then an exact headline will be searched; if it is not found, then the user
-will be queried to create it.}
-file:projects.org::*task title @r{heading search in Org file}
-file+sys:/path/to/file @r{open via OS, like double-click}
-file+emacs:/path/to/file @r{force opening by Emacs}
-docview:papers/last.pdf::NNN @r{open in doc-view mode at page}
-id:B7423F4D-2E8A-471B-8810-C40F074717E9 @r{Link to heading by ID}
-news:comp.emacs @r{Usenet link}
-mailto:adent@@galaxy.net @r{Mail link}
-mhe:folder @r{MH-E folder link}
-mhe:folder#id @r{MH-E message link}
-rmail:folder @r{RMAIL folder link}
-rmail:folder#id @r{RMAIL message link}
-gnus:group @r{Gnus group link}
-gnus:group#id @r{Gnus article link}
-bbdb:R.*Stallman @r{BBDB link (with regexp)}
-irc:/irc.com/#emacs/bob @r{IRC link}
-info:org#External links @r{Info node link}
-shell:ls *.org @r{A shell command}
-elisp:org-agenda @r{Interactive Elisp command}
-elisp:(find-file-other-frame "Elisp.org") @r{Elisp form to evaluate}
+is @code{nil}, then a fuzzy text search will be done. If it is @code{t}, then only
+the exact headline will be matched, ignoring spaces and cookies. If the
+value is @code{query-to-create}, then an exact headline will be searched; if
+it is not found, then the user will be queried to create it.}
+file:projects.org::*task title @r{heading search in Org file}@footnote{
+Headline searches always match the exact headline, ignoring
+spaces and cookies. If the headline is not found and the value of the option
+@code{org-link-search-must-match-exact-headline} is @code{query-to-create},
+then the user will be queried to create it.}
+docview:papers/last.pdf::NNN @r{open in doc-view mode at page}
+id:B7423F4D-2E8A-471B-8810-C40F074717E9 @r{Link to heading by ID}
+news:comp.emacs @r{Usenet link}
+mailto:adent@@galaxy.net @r{Mail link}
+mhe:folder @r{MH-E folder link}
+mhe:folder#id @r{MH-E message link}
+rmail:folder @r{RMAIL folder link}
+rmail:folder#id @r{RMAIL message link}
+gnus:group @r{Gnus group link}
+gnus:group#id @r{Gnus article link}
+bbdb:R.*Stallman @r{BBDB link (with regexp)}
+irc:/irc.com/#emacs/bob @r{IRC link}
+info:org#External links @r{Info node or index link}
+shell:ls *.org @r{A shell command}
+elisp:org-agenda @r{Interactive Elisp command}
+elisp:(find-file-other-frame "Elisp.org") @r{Elisp form to evaluate}
@end example
@cindex VM links
@@ -3550,13 +3586,13 @@ to VM or Wanderlust messages are available when you load the corresponding
libraries from the @code{contrib/} directory:
@example
-vm:folder @r{VM folder link}
-vm:folder#id @r{VM message link}
-vm://myself@@some.where.org/folder#id @r{VM on remote machine}
-vm-imap:account:folder @r{VM IMAP folder link}
-vm-imap:account:folder#id @r{VM IMAP message link}
-wl:folder @r{WANDERLUST folder link}
-wl:folder#id @r{WANDERLUST message link}
+vm:folder @r{VM folder link}
+vm:folder#id @r{VM message link}
+vm://myself@@some.where.org/folder#id @r{VM on remote machine}
+vm-imap:account:folder @r{VM IMAP folder link}
+vm-imap:account:folder#id @r{VM IMAP message link}
+wl:folder @r{WANDERLUST folder link}
+wl:folder#id @r{WANDERLUST message link}
@end example
For customizing Org to add new link types @ref{Adding hyperlink types}.
@@ -3565,7 +3601,7 @@ A link should be enclosed in double brackets and may contain a descriptive
text to be displayed instead of the URL (@pxref{Link format}), for example:
@example
-[[http://www.gnu.org/software/emacs/][GNU Emacs]]
+[[https://www.gnu.org/software/emacs/][GNU Emacs]]
@end example
@noindent
@@ -3582,7 +3618,7 @@ as links. If spaces must be part of the link (for example in
@samp{bbdb:Richard Stallman}), or if you need to remove ambiguities
about the end of the link, enclose them in square brackets.
-@node Handling links, Using links outside Org, External links, Hyperlinks
+@node Handling links
@section Handling links
@cindex links, handling
@@ -3614,9 +3650,9 @@ will be stored. In addition or alternatively (depending on the value of
be created and/or used to construct a link@footnote{The library
@file{org-id.el} must first be loaded, either through @code{org-customize} by
enabling @code{org-id} in @code{org-modules}, or by adding @code{(require
-'org-id)} in your @file{.emacs}.}. So using this command in Org buffers will
-potentially create two links: a human-readable from the custom ID, and one
-that is globally unique and works even if the entry is moved from file to
+'org-id)} in your Emacs init file.}. So using this command in Org buffers
+will potentially create two links: a human-readable from the custom ID, and
+one that is globally unique and works even if the entry is moved from file to
file. Later, when inserting the link, you need to decide which one to use.
@b{Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus}@*
@@ -3624,7 +3660,7 @@ Pretty much all Emacs mail clients are supported. The link will point to the
current article, or, in some GNUS buffers, to the group. The description is
constructed from the author and the subject.
-@b{Web browsers: W3 and W3M}@*
+@b{Web browsers: Eww, W3 and W3M}@*
Here the link will be the current URL, with the page title as description.
@b{Contacts: BBDB}@*
@@ -3656,7 +3692,8 @@ entry referenced by the current line.
@cindex completion, of links
@cindex inserting links
@vindex org-keep-stored-link-after-insertion
-Insert a link@footnote{ Note that you don't have to use this command to
+@vindex org-link-parameters
+Insert a link@footnote{Note that you don't have to use this command to
insert a link. Links in Org are plain text, and you can type or paste them
straight into the buffer. By using this command, the links are automatically
enclosed in double brackets, and you will be asked for the optional
@@ -3676,14 +3713,15 @@ current session are part of the history for this prompt, so you can access
them with @key{up} and @key{down} (or @kbd{M-p/n}).
@b{Completion support}@* Completion with @key{TAB} will help you to insert
-valid link prefixes like @samp{http:} or @samp{ftp:}, including the prefixes
+valid link prefixes like @samp{https:}, including the prefixes
defined through link abbreviations (@pxref{Link abbreviations}). If you
press @key{RET} after inserting only the @var{prefix}, Org will offer
-specific completion support for some link types@footnote{This works by
-calling a special function @code{org-PREFIX-complete-link}.} For
-example, if you type @kbd{file @key{RET}}, file name completion (alternative
-access: @kbd{C-u C-c C-l}, see below) will be offered, and after @kbd{bbdb
-@key{RET}} you can complete contact names.
+specific completion support for some link types@footnote{This works if
+a completion function is defined in the @samp{:complete} property of a link
+in @code{org-link-parameters}.} For example, if you type @kbd{file
+@key{RET}}, file name completion (alternative access: @kbd{C-u C-c C-l}, see
+below) will be offered, and after @kbd{bbdb @key{RET}} you can complete
+contact names.
@orgkey C-u C-c C-l
@cindex file name completion
@cindex completion, of file names
@@ -3729,8 +3767,8 @@ the link at point.
@kindex mouse-1
@item mouse-2
@itemx mouse-1
-On links, @kbd{mouse-2} will open the link just as @kbd{C-c C-o}
-would. Under Emacs 22 and later, @kbd{mouse-1} will also follow a link.
+On links, @kbd{mouse-1} and @kbd{mouse-2} will open the link just as @kbd{C-c
+C-o} would.
@c
@kindex mouse-3
@item mouse-3
@@ -3778,7 +3816,7 @@ to @kbd{C-n} and @kbd{C-p}
@end lisp
@end table
-@node Using links outside Org, Link abbreviations, Handling links, Hyperlinks
+@node Using links outside Org
@section Using links outside Org
You can insert and follow links that have Org syntax not only in
@@ -3791,7 +3829,7 @@ yourself):
(global-set-key "\C-c o" 'org-open-at-point-global)
@end lisp
-@node Link abbreviations, Search options, Using links outside Org, Hyperlinks
+@node Link abbreviations
@section Link abbreviations
@cindex link abbreviations
@cindex abbreviation, links
@@ -3830,8 +3868,8 @@ url-encode the tag (see the example above, where we need to encode
the URL parameter.) Using @samp{%(my-function)} will pass the tag
to a custom function, and replace it by the resulting string.
-If the replacement text don't contain any specifier, it will simply
-be appended to the string in order to create the link.
+If the replacement text doesn't contain any specifier, the tag will simply be
+appended in order to create the link.
Instead of a string, you may also specify a function that will be
called with the tag as the only argument to create the link.
@@ -3855,12 +3893,17 @@ can define them in the file with
@noindent
In-buffer completion (@pxref{Completion}) can be used after @samp{[} to
-complete link abbreviations. You may also define a function
-@code{org-PREFIX-complete-link} that implements special (e.g., completion)
-support for inserting such a link with @kbd{C-c C-l}. Such a function should
-not accept any arguments, and return the full link with prefix.
+complete link abbreviations. You may also define a function that implements
+special (e.g., completion) support for inserting such a link with @kbd{C-c
+C-l}. Such a function should not accept any arguments, and return the full
+link with prefix. You can add a completion function to a link like this:
+
+@lisp
+(org-link-set-parameters ``type'' :complete #'some-function)
+@end lisp
-@node Search options, Custom searches, Link abbreviations, Hyperlinks
+
+@node Search options
@section Search options in file links
@cindex search option in file links
@cindex file links, searching
@@ -3912,7 +3955,7 @@ to search the current file. For example, @code{[[file:::find me]]} does
a search for @samp{find me} in the current file, just as
@samp{[[find me]]} would.
-@node Custom searches, , Search options, Hyperlinks
+@node Custom searches
@section Custom Searches
@cindex custom search strings
@cindex search strings, custom
@@ -3936,7 +3979,7 @@ variables for more information. Org actually uses this mechanism
for Bib@TeX{} database files, and you can use the corresponding code as
an implementation example. See the file @file{org-bibtex.el}.
-@node TODO Items, Tags, Hyperlinks, Top
+@node TODO items
@chapter TODO items
@cindex TODO items
@@ -3961,7 +4004,7 @@ methods to give you an overview of all the things that you have to do.
* Checkboxes:: Tick-off lists
@end menu
-@node TODO basics, TODO extensions, TODO Items, TODO Items
+@node TODO basics
@section Basic TODO functionality
Any headline becomes a TODO item when it starts with the word
@@ -3991,8 +4034,8 @@ states}), you will be prompted for a TODO keyword through the fast selection
interface; this is the default behavior when
@code{org-use-fast-todo-selection} is non-@code{nil}.
-The same rotation can also be done ``remotely'' from the timeline and agenda
-buffers with the @kbd{t} command key (@pxref{Agenda commands}).
+The same rotation can also be done ``remotely'' from agenda buffers with the
+@kbd{t} command key (@pxref{Agenda commands}).
@orgkey{C-u C-c C-t}
When TODO keywords have no selection keys, select a specific keyword using
@@ -4022,7 +4065,7 @@ N, show the tree for the Nth keyword in the option @code{org-todo-keywords}.
With two prefix arguments, find all TODO states, both un-done and done.
@orgcmd{C-c a t,org-todo-list}
Show the global TODO list. Collects the TODO items (with not-DONE states)
-from all agenda files (@pxref{Agenda Views}) into a single buffer. The new
+from all agenda files (@pxref{Agenda views}) into a single buffer. The new
buffer will be in @code{agenda-mode}, which provides commands to examine and
manipulate the TODO entries from the new buffer (@pxref{Agenda commands}).
@xref{Global TODO list}, for more information.
@@ -4035,7 +4078,7 @@ Insert a new TODO entry below the current one.
Changing a TODO state can also trigger tag changes. See the docstring of the
option @code{org-todo-state-tags-triggers} for details.
-@node TODO extensions, Progress logging, TODO basics, TODO Items
+@node TODO extensions
@section Extended use of TODO keywords
@cindex extended TODO keywords
@@ -4059,7 +4102,7 @@ TODO items in particular (@pxref{Tags}).
* TODO dependencies:: When one task needs to wait for others
@end menu
-@node Workflow states, TODO types, TODO extensions, TODO extensions
+@node Workflow states
@subsection TODO keywords as workflow states
@cindex TODO workflow
@cindex workflow states as TODO keywords
@@ -4090,7 +4133,7 @@ define many keywords, you can use in-buffer completion
buffer. Changing a TODO state can be logged with a timestamp, see
@ref{Tracking TODO state changes}, for more information.
-@node TODO types, Multiple sets in one file, Workflow states, TODO extensions
+@node TODO types
@subsection TODO keywords as types
@cindex TODO types
@cindex names as TODO keywords
@@ -4108,21 +4151,21 @@ be set up like this:
@end lisp
In this case, different keywords do not indicate a sequence, but rather
-different types. So the normal work flow would be to assign a task to a
-person, and later to mark it DONE@. Org mode supports this style by adapting
-the workings of the command @kbd{C-c C-t}@footnote{This is also true for the
-@kbd{t} command in the timeline and agenda buffers.}. When used several
-times in succession, it will still cycle through all names, in order to first
-select the right type for a task. But when you return to the item after some
-time and execute @kbd{C-c C-t} again, it will switch from any name directly
-to DONE@. Use prefix arguments or completion to quickly select a specific
-name. You can also review the items of a specific TODO type in a sparse tree
-by using a numeric prefix to @kbd{C-c / t}. For example, to see all things
-Lucy has to do, you would use @kbd{C-3 C-c / t}. To collect Lucy's items
-from all agenda files into a single buffer, you would use the numeric prefix
-argument as well when creating the global TODO list: @kbd{C-3 C-c a t}.
-
-@node Multiple sets in one file, Fast access to TODO states, TODO types, TODO extensions
+different types. So the normal work flow would be to assign a task to
+a person, and later to mark it DONE@. Org mode supports this style by
+adapting the workings of the command @kbd{C-c C-t}@footnote{This is also true
+for the @kbd{t} command in the agenda buffers.}. When used several times in
+succession, it will still cycle through all names, in order to first select
+the right type for a task. But when you return to the item after some time
+and execute @kbd{C-c C-t} again, it will switch from any name directly to
+DONE@. Use prefix arguments or completion to quickly select a specific name.
+You can also review the items of a specific TODO type in a sparse tree by
+using a numeric prefix to @kbd{C-c / t}. For example, to see all things Lucy
+has to do, you would use @kbd{C-3 C-c / t}. To collect Lucy's items from all
+agenda files into a single buffer, you would use the numeric prefix argument
+as well when creating the global TODO list: @kbd{C-3 C-c a t}.
+
+@node Multiple sets in one file
@subsection Multiple keyword sets in one file
@cindex TODO keyword sets
@@ -4164,14 +4207,14 @@ These keys jump from one TODO subset to the next. In the above example,
@kindex S-@key{left}
@item S-@key{right}
@itemx S-@key{left}
-@kbd{S-@key{<left>}} and @kbd{S-@key{<right>}} and walk through @emph{all}
-keywords from all sets, so for example @kbd{S-@key{<right>}} would switch
+@kbd{S-@key{left}} and @kbd{S-@key{right}} and walk through @emph{all}
+keywords from all sets, so for example @kbd{S-@key{right}} would switch
from @code{DONE} to @code{REPORT} in the example above. See also
@ref{Conflicts}, for a discussion of the interaction with
@code{shift-selection-mode}.
@end table
-@node Fast access to TODO states, Per-file keywords, Multiple sets in one file, TODO extensions
+@node Fast access to TODO states
@subsection Fast access to TODO states
If you would like to quickly change an entry to an arbitrary TODO state
@@ -4196,7 +4239,7 @@ state through the tags interface (@pxref{Setting tags}), in case you like to
mingle the two concepts. Note that this means you need to come up with
unique keys across both sets of keywords.}
-@node Per-file keywords, Faces for TODO keywords, Fast access to TODO states, TODO extensions
+@node Per-file keywords
@subsection Setting up keywords for individual files
@cindex keyword options
@cindex per-file keywords
@@ -4205,11 +4248,10 @@ unique keys across both sets of keywords.}
@cindex #+SEQ_TODO
It can be very useful to use different aspects of the TODO mechanism in
-different files. For file-local settings, you need to add special lines
-to the file which set the keywords and interpretation for that file
-only. For example, to set one of the two examples discussed above, you
-need one of the following lines, starting in column zero anywhere in the
-file:
+different files. For file-local settings, you need to add special lines to
+the file which set the keywords and interpretation for that file only. For
+example, to set one of the two examples discussed above, you need one of the
+following lines anywhere in the file:
@example
#+TODO: TODO FEEDBACK VERIFY | DONE CANCELED
@@ -4243,7 +4285,7 @@ Org mode is activated after visiting a file. @kbd{C-c C-c} with the
cursor in a line starting with @samp{#+} is simply restarting Org mode
for the current buffer.}.
-@node Faces for TODO keywords, TODO dependencies, Per-file keywords, TODO extensions
+@node Faces for TODO keywords
@subsection Faces for TODO keywords
@cindex faces, for TODO keywords
@@ -4271,10 +4313,11 @@ special face and use that. A string is interpreted as a color. The option
@code{org-faces-easy-properties} determines if that color is interpreted as a
foreground or a background color.
-@node TODO dependencies, , Faces for TODO keywords, TODO extensions
+@node TODO dependencies
@subsection TODO dependencies
@cindex TODO dependencies
@cindex dependencies, of TODO states
+@cindex TODO dependencies, NOBLOCKING
@vindex org-enforce-todo-dependencies
@cindex property, ORDERED
@@ -4303,6 +4346,16 @@ example:
** TODO c, needs to wait for (a) and (b)
@end example
+You can ensure an entry is never blocked by using the @code{NOBLOCKING}
+property:
+
+@example
+* This entry is never blocked
+ :PROPERTIES:
+ :NOBLOCKING: t
+ :END:
+@end example
+
@table @kbd
@orgcmd{C-c C-x o,org-toggle-ordered-property}
@vindex org-track-ordered-property-with-tag
@@ -4319,7 +4372,7 @@ Change TODO state, circumventing any state blocking.
@vindex org-agenda-dim-blocked-tasks
If you set the option @code{org-agenda-dim-blocked-tasks}, TODO entries
that cannot be closed because of such dependencies will be shown in a dimmed
-font or even made invisible in agenda views (@pxref{Agenda Views}).
+font or even made invisible in agenda views (@pxref{Agenda views}).
@cindex checkboxes and TODO dependencies
@vindex org-enforce-todo-dependencies
@@ -4333,7 +4386,7 @@ between entries in different trees or files, check out the contributed
module @file{org-depend.el}.
@page
-@node Progress logging, Priorities, TODO extensions, TODO Items
+@node Progress logging
@section Progress logging
@cindex progress logging
@cindex logging, of progress
@@ -4351,7 +4404,7 @@ work time}.
* Tracking your habits:: How consistent have you been?
@end menu
-@node Closing items, Tracking TODO state changes, Progress logging, Progress logging
+@node Closing items
@subsection Closing items
The most basic logging is to keep track of @emph{when} a certain TODO
@@ -4382,12 +4435,7 @@ lognotedone}.}
You will then be prompted for a note, and that note will be stored below
the entry with a @samp{Closing Note} heading.
-In the timeline (@pxref{Timeline}) and in the agenda
-(@pxref{Weekly/daily agenda}), you can then use the @kbd{l} key to
-display the TODO items with a @samp{CLOSED} timestamp on each day,
-giving you an overview of what has been done.
-
-@node Tracking TODO state changes, Tracking your habits, Closing items, Progress logging
+@node Tracking TODO state changes
@subsection Tracking TODO state changes
@cindex drawer, for state change recording
@@ -4470,7 +4518,7 @@ settings like @code{TODO(!)}. For example
:END:
@end example
-@node Tracking your habits, , Tracking TODO state changes, Progress logging
+@node Tracking your habits
@subsection Tracking your habits
@cindex habits
@@ -4506,6 +4554,10 @@ actual habit with some history:
@example
** TODO Shave
SCHEDULED: <2009-10-17 Sat .+2d/4d>
+ :PROPERTIES:
+ :STYLE: habit
+ :LAST_REPEAT: [2009-10-19 Mon 00:36]
+ :END:
- State "DONE" from "TODO" [2009-10-15 Thu]
- State "DONE" from "TODO" [2009-10-12 Mon]
- State "DONE" from "TODO" [2009-10-10 Sat]
@@ -4516,10 +4568,6 @@ actual habit with some history:
- State "DONE" from "TODO" [2009-09-19 Sat]
- State "DONE" from "TODO" [2009-09-16 Wed]
- State "DONE" from "TODO" [2009-09-12 Sat]
- :PROPERTIES:
- :STYLE: habit
- :LAST_REPEAT: [2009-10-19 Mon 00:36]
- :END:
@end example
What this habit says is: I want to shave at most every 2 days (given by the
@@ -4570,7 +4618,7 @@ temporarily be disabled and they won't appear at all. Press @kbd{K} again to
bring them back. They are also subject to tag filtering, if you have habits
which should only be done in certain contexts, for example.
-@node Priorities, Breaking down tasks, Progress logging, TODO Items
+@node Priorities
@section Priorities
@cindex priorities
@@ -4601,8 +4649,8 @@ items.
Set the priority of the current headline (@command{org-priority}). The
command prompts for a priority character @samp{A}, @samp{B} or @samp{C}.
When you press @key{SPC} instead, the priority cookie is removed from the
-headline. The priorities can also be changed ``remotely'' from the timeline
-and agenda buffer with the @kbd{,} command (@pxref{Agenda commands}).
+headline. The priorities can also be changed ``remotely'' from the agenda
+buffer with the @kbd{,} command (@pxref{Agenda commands}).
@c
@orgcmdkkcc{S-@key{up},S-@key{down},org-priority-up,org-priority-down}
@vindex org-priority-start-cycle-with-default
@@ -4628,7 +4676,7 @@ priority):
#+PRIORITIES: A C B
@end example
-@node Breaking down tasks, Checkboxes, Priorities, TODO Items
+@node Breaking down tasks
@section Breaking tasks down into subtasks
@cindex tasks, breaking down
@cindex statistics, for TODO items
@@ -4689,7 +4737,7 @@ Another possibility is the use of checkboxes to identify (a hierarchy of) a
large number of subtasks (@pxref{Checkboxes}).
-@node Checkboxes, , Breaking down tasks, TODO Items
+@node Checkboxes
@section Checkboxes
@cindex checkboxes
@@ -4698,7 +4746,7 @@ Every item in a plain list@footnote{With the exception of description
lists. But you can allow it by modifying @code{org-list-automatic-rules}
accordingly.} (@pxref{Plain lists}) can be made into a checkbox by starting
it with the string @samp{[ ]}. This feature is similar to TODO items
-(@pxref{TODO Items}), but is more lightweight. Checkboxes are not included
+(@pxref{TODO items}), but is more lightweight. Checkboxes are not included
in the global TODO list, so they are often great to split a task into a
number of simple steps. Or you can use them in a shopping list. To toggle a
checkbox, use @kbd{C-c C-c}, or use the mouse (thanks to Piotr Zielinski's
@@ -4755,11 +4803,12 @@ off a box while there are unchecked boxes above it.
@table @kbd
@orgcmd{C-c C-c,org-toggle-checkbox}
-Toggle checkbox status or (with prefix arg) checkbox presence at point.
-With a single prefix argument, add an empty checkbox or remove the current
-one@footnote{@kbd{C-u C-c C-c} on the @emph{first} item of a list with no checkbox
-will add checkboxes to the rest of the list.}. With a double prefix argument, set it to @samp{[-]}, which is
-considered to be an intermediate state.
+Toggle checkbox status or (with prefix arg) checkbox presence at point. With
+a single prefix argument, add an empty checkbox or remove the current
+one@footnote{@kbd{C-u C-c C-c} before the @emph{first} bullet in a list with
+no checkbox will add checkboxes to the rest of the list.}. With a double
+prefix argument, set it to @samp{[-]}, which is considered to be an
+intermediate state.
@orgcmd{C-c C-x C-b,org-toggle-checkbox}
Toggle checkbox status or (with prefix arg) checkbox presence at point. With
double prefix argument, set it to @samp{[-]}, which is considered to be an
@@ -4770,8 +4819,10 @@ If there is an active region, toggle the first checkbox in the region
and set all remaining boxes to the same status as the first. With a prefix
arg, add or remove the checkbox for all items in the region.
@item
-If the cursor is in a headline, toggle checkboxes in the region between
-this headline and the next (so @emph{not} the entire subtree).
+If the cursor is in a headline, toggle the state of the first checkbox in the
+region between this headline and the next---so @emph{not} the entire
+subtree---and propagate this new state to all other checkboxes in the same
+area.
@item
If there is no active region, just toggle the checkbox at point.
@end itemize
@@ -4795,7 +4846,7 @@ changing TODO states. If you delete boxes/entries or add/change them by
hand, use this command to get things back into sync.
@end table
-@node Tags, Properties and Columns, TODO Items, Top
+@node Tags
@chapter Tags
@cindex tags
@cindex headline tagging
@@ -4819,11 +4870,11 @@ You may specify special faces for specific tags using the option
@menu
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
@end menu
-@node Tag inheritance, Setting tags, Tags, Tags
+@node Tag inheritance
@section Tag inheritance
@cindex tag inheritance
@cindex inheritance, of tags
@@ -4842,11 +4893,11 @@ well. For example, in the list
@noindent
the final heading will have the tags @samp{:work:}, @samp{:boss:},
@samp{:notes:}, and @samp{:action:} even though the final heading is not
-explicitly marked with those tags. You can also set tags that all entries in
-a file should inherit just as if these tags were defined in a hypothetical
-level zero that surrounds the entire file. Use a line like this@footnote{As
-with all these in-buffer settings, pressing @kbd{C-c C-c} activates any
-changes in the line.}:
+explicitly marked with all those tags. You can also set tags that all
+entries in a file should inherit just as if these tags were defined in
+a hypothetical level zero that surrounds the entire file. Use a line like
+this@footnote{As with all these in-buffer settings, pressing @kbd{C-c C-c}
+activates any changes in the line.}:
@cindex #+FILETAGS
@example
@@ -4877,7 +4928,7 @@ with inherited tags. Set @code{org-agenda-use-tag-inheritance} to control
this: the default value includes all agenda types, but setting this to @code{nil}
can really speed up agenda generation.
-@node Setting tags, Tag groups, Tag inheritance, Tags
+@node Setting tags
@section Setting tags
@cindex setting tags
@cindex tags, setting
@@ -4939,10 +4990,10 @@ By default Org mode uses the standard minibuffer completion facilities for
entering tags. However, it also implements another, quicker, tag selection
method called @emph{fast tag selection}. This allows you to select and
deselect tags with just a single key press. For this to work well you should
-assign unique letters to most of your commonly used tags. You can do this
-globally by configuring the variable @code{org-tag-alist} in your
-@file{.emacs} file. For example, you may find the need to tag many items in
-different files with @samp{:@@home:}. In this case you can set something
+assign unique, case-sensitive, letters to most of your commonly used tags.
+You can do this globally by configuring the variable @code{org-tag-alist} in
+your Emacs init file. For example, you may find the need to tag many items
+in different files with @samp{:@@home:}. In this case you can set something
like:
@lisp
@@ -5004,14 +5055,15 @@ If at least one tag has a selection key then pressing @kbd{C-c C-c} will
automatically present you with a special interface, listing inherited tags,
the tags of the current headline, and a list of all valid tags with
corresponding keys@footnote{Keys will automatically be assigned to tags which
-have no configured keys.}. In this interface, you can use the following
-keys:
+have no configured keys.}.
+
+Pressing keys assigned to tags will add or remove them from the list of tags
+in the current line. Selecting a tag in a group of mutually exclusive tags
+will turn off any other tags from that group.
+
+In this interface, you can also use the following special keys:
@table @kbd
-@item a-z...
-Pressing keys assigned to tags will add or remove them from the list of
-tags in the current line. Selecting a tag in a group of mutually
-exclusive tags will turn off any other tags from that group.
@kindex @key{TAB}
@item @key{TAB}
Enter a tag in the minibuffer, even if the tag is not in the predefined
@@ -5021,16 +5073,21 @@ You can also add several tags: just separate them with a comma.
@kindex @key{SPC}
@item @key{SPC}
Clear all tags for this line.
+
@kindex @key{RET}
@item @key{RET}
Accept the modified set.
+
@item C-g
Abort without installing changes.
+
@item q
If @kbd{q} is not assigned to a tag, it aborts like @kbd{C-g}.
+
@item !
Turn off groups of mutually exclusive tags. Use this to (as an
exception) assign several tags from such a group.
+
@item C-c
Toggle auto-exit after the next change (see below).
If you are using expert mode, the first @kbd{C-c} will display the
@@ -5058,41 +5115,104 @@ instead of @kbd{C-c C-c}). If you set the variable to the value
@code{expert}, the special window is not even shown for single-key tag
selection, it comes up only when you press an extra @kbd{C-c}.
-@node Tag groups, Tag searches, Setting tags, Tags
-@section Tag groups
+@node Tag hierarchy
+@section Tag hierarchy
@cindex group tags
@cindex tags, groups
-In a set of mutually exclusive tags, the first tag can be defined as a
-@emph{group tag}. When you search for a group tag, it will return matches
-for all members in the group. In an agenda view, filtering by a group tag
-will display headlines tagged with at least one of the members of the
-group. This makes tag searches and filters even more flexible.
+@cindex tag hierarchy
+Tags can be defined in hierarchies. A tag can be defined as a @emph{group
+tag} for a set of other tags. The group tag can be seen as the ``broader
+term'' for its set of tags. Defining multiple @emph{group tags} and nesting
+them creates a tag hierarchy.
-You can set group tags by inserting a colon between the group tag and other
-tags---beware that all whitespaces are mandatory so that Org can parse this
-line correctly:
+One use-case is to create a taxonomy of terms (tags) that can be used to
+classify nodes in a document or set of documents.
+
+When you search for a group tag, it will return matches for all members in
+the group and its subgroups. In an agenda view, filtering by a group tag
+will display or hide headlines tagged with at least one of the members of the
+group or any of its subgroups. This makes tag searches and filters even more
+flexible.
+
+You can set group tags by using brackets and inserting a colon between the
+group tag and its related tags---beware that all whitespaces are mandatory so
+that Org can parse this line correctly:
+
+@example
+#+TAGS: [ GTD : Control Persp ]
+@end example
+
+In this example, @samp{GTD} is the @emph{group tag} and it is related to two
+other tags: @samp{Control}, @samp{Persp}. Defining @samp{Control} and
+@samp{Persp} as group tags creates an hierarchy of tags:
@example
-#+TAGS: @{ @@read : @@read_book @@read_ebook @}
+#+TAGS: [ Control : Context Task ]
+#+TAGS: [ Persp : Vision Goal AOF Project ]
@end example
-In this example, @samp{@@read} is a @emph{group tag} for a set of three
-tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
+That can conceptually be seen as a hierarchy of tags:
-You can also use the @code{:grouptags} keyword directly when setting
-@code{org-tag-alist}:
+@example
+- GTD
+ - Persp
+ - Vision
+ - Goal
+ - AOF
+ - Project
+ - Control
+ - Context
+ - Task
+@end example
+
+You can use the @code{:startgrouptag}, @code{:grouptags} and
+@code{:endgrouptag} keyword directly when setting @code{org-tag-alist}
+directly:
@lisp
-(setq org-tag-alist '((:startgroup . nil)
- ("@@read" . nil)
- (:grouptags . nil)
- ("@@read_book" . nil)
- ("@@read_ebook" . nil)
- (:endgroup . nil)))
+(setq org-tag-alist '((:startgrouptag)
+ ("GTD")
+ (:grouptags)
+ ("Control")
+ ("Persp")
+ (:endgrouptag)
+ (:startgrouptag)
+ ("Control")
+ (:grouptags)
+ ("Context")
+ ("Task")
+ (:endgrouptag)))
@end lisp
-You cannot nest group tags or use a group tag as a tag in another group.
+The tags in a group can be mutually exclusive if using the same group syntax
+as is used for grouping mutually exclusive tags together; using curly
+brackets.
+
+@example
+#+TAGS: @{ Context : @@Home @@Work @@Call @}
+@end example
+
+When setting @code{org-tag-alist} you can use @code{:startgroup} &
+@code{:endgroup} instead of @code{:startgrouptag} & @code{:endgrouptag} to
+make the tags mutually exclusive.
+
+Furthermore, the members of a @emph{group tag} can also be regular
+expressions, creating the possibility of a more dynamic and rule-based
+tag structure. The regular expressions in the group must be specified
+within @{ @}. Here is an expanded example:
+
+@example
+#+TAGS: [ Vision : @{V@@@.+@} ]
+#+TAGS: [ Goal : @{G@@@.+@} ]
+#+TAGS: [ AOF : @{AOF@@@.+@} ]
+#+TAGS: [ Project : @{P@@@.+@} ]
+@end example
+
+Searching for the tag @samp{Project} will now list all tags also including
+regular expression matches for @samp{P@@@.+}, and similarly for tag searches on
+@samp{Vision}, @samp{Goal} and @samp{AOF}. For example, this would work well
+for a project tagged with a common project-identifier, e.g. @samp{P@@2014_OrgTags}.
@kindex C-c C-x q
@vindex org-group-tags
@@ -5100,7 +5220,7 @@ If you want to ignore group tags temporarily, toggle group tags support
with @command{org-toggle-tags-groups}, bound to @kbd{C-c C-x q}. If you
want to disable tag groups completely, set @code{org-group-tags} to @code{nil}.
-@node Tag searches, , Tag groups, Tags
+@node Tag searches
@section Tag searches
@cindex tag searches
@cindex searching for tags
@@ -5126,13 +5246,13 @@ only TODO items and force checking subitems (see the option
These commands all prompt for a match string which allows basic Boolean logic
like @samp{+boss+urgent-project1}, to find entries with tags @samp{boss} and
@samp{urgent}, but not @samp{project1}, or @samp{Kathy|Sally} to find entries
-which are tagged, like @samp{Kathy} or @samp{Sally}. The full syntax of the search
-string is rich and allows also matching against TODO keywords, entry levels
-and properties. For a complete description with many examples, see
-@ref{Matching tags and properties}.
+tagged as @samp{Kathy} or @samp{Sally}. The full syntax of the search string
+is rich and allows also matching against TODO keywords, entry levels and
+properties. For a complete description with many examples, see @ref{Matching
+tags and properties}.
-@node Properties and Columns, Dates and Times, Tags, Top
+@node Properties and columns
@chapter Properties and columns
@cindex properties
@@ -5162,16 +5282,18 @@ Properties can be conveniently edited and viewed in column view
* Property API:: Properties for Lisp programmers
@end menu
-@node Property syntax, Special properties, Properties and Columns, Properties and Columns
+@node Property syntax
@section Property syntax
@cindex property syntax
@cindex drawer, for properties
Properties are key-value pairs. When they are associated with a single entry
-or with a tree they need to be inserted into a special
-drawer (@pxref{Drawers}) with the name @code{PROPERTIES}. Each property
-is specified on a single line, with the key (surrounded by colons)
-first, and the value after it. Here is an example:
+or with a tree they need to be inserted into a special drawer
+(@pxref{Drawers}) with the name @code{PROPERTIES}, which has to be located
+right below a headline, and its planning line (@pxref{Deadlines and
+scheduling}) when applicable. Each property is specified on a single line,
+with the key (surrounded by colons) first, and the value after it. Keys are
+case-insensitive. Here is an example:
@example
* CD collection
@@ -5187,7 +5309,7 @@ first, and the value after it. Here is an example:
@end example
Depending on the value of @code{org-use-property-inheritance}, a property set
-this way will either be associated with a single entry, or the sub-tree
+this way will either be associated with a single entry, or the subtree
defined by the entry, see @ref{Property inheritance}.
You may define the allowed values for a particular property @samp{:Xyz:}
@@ -5215,7 +5337,7 @@ file, use a line like
@end example
Contrary to properties set from a special drawer, you have to refresh the
-buffer with @kbd{C-c C-c} to activate this changes.
+buffer with @kbd{C-c C-c} to activate this change.
If you want to add to the value of an existing property, append a @code{+} to
the property name. The following results in the property @code{var} having
@@ -5284,58 +5406,52 @@ Compute the property at point, using the operator and scope from the
nearest column format definition.
@end table
-@node Special properties, Property searches, Property syntax, Properties and Columns
+@node Special properties
@section Special properties
@cindex properties, special
Special properties provide an alternative access method to Org mode features,
like the TODO state or the priority of an entry, discussed in the previous
-chapters. This interface exists so that you can include these states in a
-column view (@pxref{Column view}), or to use them in queries. The following
-property names are special and (except for @code{:CATEGORY:}) should not be
-used as keys in the properties drawer:
+chapters. This interface exists so that you can include these states in
+a column view (@pxref{Column view}), or to use them in queries. The
+following property names are special and should not be used as keys in the
+properties drawer:
-@cindex property, special, ID
-@cindex property, special, TODO
-@cindex property, special, TAGS
@cindex property, special, ALLTAGS
-@cindex property, special, CATEGORY
-@cindex property, special, PRIORITY
+@cindex property, special, BLOCKED
+@cindex property, special, CLOCKSUM
+@cindex property, special, CLOCKSUM_T
+@cindex property, special, CLOSED
@cindex property, special, DEADLINE
+@cindex property, special, FILE
+@cindex property, special, ITEM
+@cindex property, special, PRIORITY
@cindex property, special, SCHEDULED
-@cindex property, special, CLOSED
+@cindex property, special, TAGS
@cindex property, special, TIMESTAMP
@cindex property, special, TIMESTAMP_IA
-@cindex property, special, CLOCKSUM
-@cindex property, special, CLOCKSUM_T
-@cindex property, special, BLOCKED
-@c guessing that ITEM is needed in this area; also, should this list be sorted?
-@cindex property, special, ITEM
-@cindex property, special, FILE
+@cindex property, special, TODO
@example
-ID @r{A globally unique ID used for synchronization during}
- @r{iCalendar or MobileOrg export.}
-TODO @r{The TODO keyword of the entry.}
-TAGS @r{The tags defined directly in the headline.}
ALLTAGS @r{All tags, including inherited ones.}
-CATEGORY @r{The category of an entry.}
-PRIORITY @r{The priority of the entry, a string with a single letter.}
-DEADLINE @r{The deadline time string, without the angular brackets.}
-SCHEDULED @r{The scheduling timestamp, without the angular brackets.}
-CLOSED @r{When was this entry closed?}
-TIMESTAMP @r{The first keyword-less timestamp in the entry.}
-TIMESTAMP_IA @r{The first inactive timestamp in the entry.}
+BLOCKED @r{"t" if task is currently blocked by children or siblings.}
CLOCKSUM @r{The sum of CLOCK intervals in the subtree. @code{org-clock-sum}}
@r{must be run first to compute the values in the current buffer.}
CLOCKSUM_T @r{The sum of CLOCK intervals in the subtree for today.}
@r{@code{org-clock-sum-today} must be run first to compute the}
@r{values in the current buffer.}
-BLOCKED @r{"t" if task is currently blocked by children or siblings}
-ITEM @r{The headline of the entry.}
+CLOSED @r{When was this entry closed?}
+DEADLINE @r{The deadline time string, without the angular brackets.}
FILE @r{The filename the entry is located in.}
+ITEM @r{The headline of the entry.}
+PRIORITY @r{The priority of the entry, a string with a single letter.}
+SCHEDULED @r{The scheduling timestamp, without the angular brackets.}
+TAGS @r{The tags defined directly in the headline.}
+TIMESTAMP @r{The first keyword-less timestamp in the entry.}
+TIMESTAMP_IA @r{The first inactive timestamp in the entry.}
+TODO @r{The TODO keyword of the entry.}
@end example
-@node Property searches, Property inheritance, Special properties, Properties and Columns
+@node Property searches
@section Property searches
@cindex properties, searching
@cindex searching, of properties
@@ -5372,7 +5488,7 @@ value. If you enclose the value in curly braces, it is interpreted as
a regular expression and matched against the property values.
@end table
-@node Property inheritance, Column view, Property searches, Properties and Columns
+@node Property inheritance
@section Property Inheritance
@cindex properties, inheritance
@cindex inheritance, of properties
@@ -5416,7 +5532,7 @@ The LOGGING property may define logging settings for an entry or a
subtree (@pxref{Tracking TODO state changes}).
@end table
-@node Column view, Property API, Property inheritance, Properties and Columns
+@node Column view
@section Column view
A great way to view and edit properties in an outline tree is
@@ -5430,7 +5546,7 @@ view (@kbd{S-@key{TAB} S-@key{TAB}}, or simply @kbd{c} while column view
is active), but you can still open, read, and edit the entry below each
headline. Or, you can switch to column view after executing a sparse
tree command and in this way get a table only for the selected items.
-Column view also works in agenda buffers (@pxref{Agenda Views}) where
+Column view also works in agenda buffers (@pxref{Agenda views}) where
queries have collected selected items, possibly from a number of files.
@menu
@@ -5439,7 +5555,7 @@ queries have collected selected items, possibly from a number of files.
* Capturing column view:: A dynamic block for column view
@end menu
-@node Defining columns, Using column view, Column view, Column view
+@node Defining columns
@subsection Defining columns
@cindex column view, for properties
@cindex properties, column view
@@ -5452,7 +5568,7 @@ done by defining a column format line.
* Column attributes:: Appearance and content of a column
@end menu
-@node Scope of column definitions, Column attributes, Defining columns, Defining columns
+@node Scope of column definitions
@subsubsection Scope of column definitions
To define a column format for an entire file, use a line like
@@ -5479,7 +5595,7 @@ you can define columns on level 1 that are general enough for all
sublevels, and more specific columns further down, when you edit a
deeper part of the tree.
-@node Column attributes, , Scope of column definitions, Defining columns
+@node Column attributes
@subsubsection Column attributes
A column definition sets the attributes of a column. The general
definition looks like this:
@@ -5501,38 +5617,45 @@ optional. The individual parts have the following meaning:
@var{title} @r{The header text for the column. If omitted, the property}
@r{name is used.}
@{@var{summary-type}@} @r{The summary type. If specified, the column values for}
- @r{parent nodes are computed from the children.}
+ @r{parent nodes are computed from the children@footnote{If
+ more than one summary type apply to the property, the parent
+ values are computed according to the first of them.}.}
@r{Supported summary types are:}
@{+@} @r{Sum numbers in this column.}
@{+;%.1f@} @r{Like @samp{+}, but format result with @samp{%.1f}.}
@{$@} @r{Currency, short for @samp{+;%.2f}.}
- @{:@} @r{Sum times, HH:MM, plain numbers are hours.}
- @{X@} @r{Checkbox status, @samp{[X]} if all children are @samp{[X]}.}
- @{X/@} @r{Checkbox status, @samp{[n/m]}.}
- @{X%@} @r{Checkbox status, @samp{[n%]}.}
@{min@} @r{Smallest number in column.}
@{max@} @r{Largest number.}
@{mean@} @r{Arithmetic mean of numbers.}
+ @{X@} @r{Checkbox status, @samp{[X]} if all children are @samp{[X]}.}
+ @{X/@} @r{Checkbox status, @samp{[n/m]}.}
+ @{X%@} @r{Checkbox status, @samp{[n%]}.}
+ @{:@} @r{Sum times, HH:MM, plain numbers are
+ hours@footnote{A time can also be a duration, using effort
+ modifiers defined in @code{org-effort-durations}, e.g.,
+ @samp{3d 1h}. If any value in the column is as such, the
+ summary will also be an effort duration.}.}
@{:min@} @r{Smallest time value in column.}
@{:max@} @r{Largest time value.}
@{:mean@} @r{Arithmetic mean of time values.}
- @{@@min@} @r{Minimum age (in days/hours/mins/seconds).}
+ @{@@min@} @r{Minimum age@footnote{An age is defined as
+ a duration since a given time-stamp (@pxref{Timestamps}). It
+ can also be expressed as days, hours, minutes and seconds,
+ identified by @samp{d}, @samp{h}, @samp{m} and @samp{s}
+ suffixes, all mandatory, e.g., @samp{0d 13h 0m 10s}.} (in
+ days/hours/mins/seconds).}
@{@@max@} @r{Maximum age (in days/hours/mins/seconds).}
@{@@mean@} @r{Arithmetic mean of ages (in days/hours/mins/seconds).}
- @{est+@} @r{Add low-high estimates.}
+ @{est+@} @r{Add @samp{low-high} estimates.}
@end example
-@noindent
-Be aware that you can only have one summary type for any property you
-include. Subsequent columns referencing the same property will all display the
-same summary information.
-
The @code{est+} summary type requires further explanation. It is used for
-combining estimates, expressed as low-high ranges. For example, instead
-of estimating a particular task will take 5 days, you might estimate it as
-5--6 days if you're fairly confident you know how much work is required, or
-1--10 days if you don't really know what needs to be done. Both ranges
-average at 5.5 days, but the first represents a more predictable delivery.
+combining estimates, expressed as @samp{low-high} ranges or plain numbers.
+For example, instead of estimating a particular task will take 5 days, you
+might estimate it as 5--6 days if you're fairly confident you know how much
+work is required, or 1--10 days if you don't really know what needs to be
+done. Both ranges average at 5.5 days, but the first represents a more
+predictable delivery.
When combining a set of such estimates, simply adding the lows and highs
produces an unrealistically wide result. Instead, @code{est+} adds the
@@ -5546,6 +5669,10 @@ full job more realistically, at 10--15 days.
Numbers are right-aligned when a format specifier with an explicit width like
@code{%5d} or @code{%5.1f} is used.
+@vindex org-columns-summary-types
+You can also define custom summary types by setting
+@code{org-columns-summary-types}, which see.
+
Here is an example for a complete columns definition, along with allowed
values.
@@ -5574,7 +5701,7 @@ an @samp{[X]} status if all children have been checked. The
sums of CLOCK intervals in the subtree, either for all clocks or just for
today.
-@node Using column view, Capturing column view, Defining columns, Column view
+@node Using column view
@subsection Using column view
@table @kbd
@@ -5582,14 +5709,15 @@ today.
@orgcmd{C-c C-x C-c,org-columns}
@vindex org-columns-default-format
Turn on column view. If the cursor is before the first headline in the file,
-column view is turned on for the entire file, using the @code{#+COLUMNS}
-definition. If the cursor is somewhere inside the outline, this command
-searches the hierarchy, up from point, for a @code{:COLUMNS:} property that
-defines a format. When one is found, the column view table is established
-for the tree starting at the entry that contains the @code{:COLUMNS:}
-property. If no such property is found, the format is taken from the
-@code{#+COLUMNS} line or from the variable @code{org-columns-default-format},
-and column view is established for the current entry and its subtree.
+or the function called with the universal prefix argument, column view is
+turned on for the entire file, using the @code{#+COLUMNS} definition. If the
+cursor is somewhere inside the outline, this command searches the hierarchy,
+up from point, for a @code{:COLUMNS:} property that defines a format. When
+one is found, the column view table is established for the tree starting at
+the entry that contains the @code{:COLUMNS:} property. If no such property
+is found, the format is taken from the @code{#+COLUMNS} line or from the
+variable @code{org-columns-default-format}, and column view is established
+for the current entry and its subtree.
@orgcmd{r,org-columns-redo}
Recreate the column view, to include recent changes made in the buffer.
@orgcmd{g,org-columns-redo}
@@ -5620,7 +5748,7 @@ View the full value of this property. This is useful if the width of
the column is smaller than that of the value.
@orgcmd{a,org-columns-edit-allowed}
Edit the list of allowed values for this property. If the list is found
-in the hierarchy, the modified values is stored there. If no list is
+in the hierarchy, the modified value is stored there. If no list is
found, the new value is stored in the first entry that is part of the
current column view.
@tsubheading{Modifying the table structure}
@@ -5632,7 +5760,7 @@ Insert a new column, to the left of the current column.
Delete the current column.
@end table
-@node Capturing column view, , Using column view, Column view
+@node Capturing column view
@subsection Capturing column view
Since column view is just an overlay over a buffer, it cannot be
@@ -5677,6 +5805,8 @@ When set to a number, don't capture entries below this level.
@item :skip-empty-rows
When set to @code{t}, skip rows where the only non-empty specifier of the
column view is @code{ITEM}.
+@item :indent
+When non-@code{nil}, indent each @code{ITEM} field according to its level.
@end table
@@ -5688,8 +5818,7 @@ The following commands insert or update the dynamic block:
Insert a dynamic block capturing a column view. You will be prompted
for the scope or ID of the view.
@orgcmdkkc{C-c C-c,C-c C-x C-u,org-dblock-update}
-Update dynamic block at point. The cursor needs to be in the
-@code{#+BEGIN} line of the dynamic block.
+Update dynamic block at point.
@orgcmd{C-u C-c C-x C-u,org-update-all-dblocks}
Update all dynamic blocks (@pxref{Dynamic blocks}). This is useful if
you have several clock table blocks, column-capturing blocks or other dynamic
@@ -5709,7 +5838,7 @@ distributed with the main distribution of Org (visit
properties from entries in a certain scope, and arbitrary Lisp expressions to
process these values before inserting them into a table or a dynamic block.
-@node Property API, , Column view, Properties and Columns
+@node Property API
@section The Property API
@cindex properties, API
@cindex API, for properties
@@ -5719,7 +5848,7 @@ be used by Emacs Lisp programs to work with properties and to implement
features based on them. For more information see @ref{Using the
property API}.
-@node Dates and Times, Capture - Refile - Archive, Properties and Columns, Top
+@node Dates and times
@chapter Dates and times
@cindex dates
@cindex times
@@ -5729,7 +5858,7 @@ property API}.
To assist project planning, TODO items can be labeled with a date and/or
a time. The specially formatted string carrying the date and time
information is called a @emph{timestamp} in Org mode. This may be a
-little confusing because timestamp is often used as indicating when
+little confusing because timestamp is often used to indicate when
something was created or last changed. However, in Org mode this term
is used in a much wider sense.
@@ -5739,12 +5868,11 @@ is used in a much wider sense.
* Deadlines and scheduling:: Planning your work
* Clocking work time:: Tracking how long you spend on a task
* Effort estimates:: Planning work effort in advance
-* Relative timer:: Notes with a running timer
-* Countdown timer:: Starting a countdown timer for a task
+* Timers:: Notes with a running timer
@end menu
-@node Timestamps, Creating timestamps, Dates and Times, Dates and Times
+@node Timestamps
@section Timestamps, deadlines, and scheduling
@cindex timestamps
@cindex ranges, time
@@ -5767,10 +5895,10 @@ agenda (@pxref{Weekly/daily agenda}). We distinguish:
@item Plain timestamp; Event; Appointment
@cindex timestamp
@cindex appointment
-A simple timestamp just assigns a date/time to an item. This is just
-like writing down an appointment or event in a paper agenda. In the
-timeline and agenda displays, the headline of an entry associated with a
-plain timestamp will be shown exactly on that date.
+A simple timestamp just assigns a date/time to an item. This is just like
+writing down an appointment or event in a paper agenda. In the agenda
+display, the headline of an entry associated with a plain timestamp will be
+shown exactly on that date.
@example
* Meet Peter at the movies
@@ -5795,10 +5923,10 @@ following will show up in the agenda every Wednesday:
For more complex date specifications, Org mode supports using the special
sexp diary entries implemented in the Emacs calendar/diary
package@footnote{When working with the standard diary sexp functions, you
-need to be very careful with the order of the arguments. That order depend
+need to be very careful with the order of the arguments. That order depends
evilly on the variable @code{calendar-date-style} (or, for older Emacs
versions, @code{european-calendar-style}). For example, to specify a date
-December 12, 2005, the call might look like @code{(diary-date 12 1 2005)} or
+December 1, 2005, the call might look like @code{(diary-date 12 1 2005)} or
@code{(diary-date 1 12 2005)} or @code{(diary-date 2005 12 1)}, depending on
the settings. This has been the source of much confusion. Org mode users
can resort to special versions of these functions like @code{org-date} or
@@ -5838,7 +5966,7 @@ angular ones. These timestamps are inactive in the sense that they do
@end table
-@node Creating timestamps, Deadlines and scheduling, Timestamps, Dates and Times
+@node Creating timestamps
@section Creating timestamps
@cindex creating timestamps
@cindex timestamps, creating
@@ -5909,7 +6037,7 @@ the following column).
* Custom time format:: Making dates look different
@end menu
-@node The date/time prompt, Custom time format, Creating timestamps, Creating timestamps
+@node The date/time prompt
@subsection The date/time prompt
@cindex date, reading in minibuffer
@cindex time, reading in minibuffer
@@ -5948,7 +6076,7 @@ feb 15 @result{} @b{2007}-02-15
sep 12 9 @result{} 2009-09-12
12:45 @result{} @b{2006}-@b{06}-@b{13} 12:45
22 sept 0:34 @result{} @b{2006}-09-22 00:34
-w4 @result{} ISO week for of the current year @b{2006}
+w4 @result{} ISO week four of the current year @b{2006}
2012 w4 fri @result{} Friday of ISO week 4 in 2012
2012-w04-5 @result{} Same as above
@end example
@@ -6017,14 +6145,18 @@ from the minibuffer:
@kindex M-S-@key{right}
@kindex M-S-@key{left}
@kindex @key{RET}
+@kindex M-S-@key{down}
+@kindex M-S-@key{up}
+
@example
-@key{RET} @r{Choose date at cursor in calendar.}
-mouse-1 @r{Select date by clicking on it.}
-S-@key{right}/@key{left} @r{One day forward/backward.}
-S-@key{down}/@key{up} @r{One week forward/backward.}
-M-S-@key{right}/@key{left} @r{One month forward/backward.}
-> / < @r{Scroll calendar forward/backward by one month.}
-M-v / C-v @r{Scroll calendar forward/backward by 3 months.}
+@key{RET} @r{Choose date at cursor in calendar.}
+mouse-1 @r{Select date by clicking on it.}
+S-@key{right}/@key{left} @r{One day forward/backward.}
+S-@key{down}/@key{up} @r{One week forward/backward.}
+M-S-@key{right}/@key{left} @r{One month forward/backward.}
+> / < @r{Scroll calendar forward/backward by one month.}
+M-v / C-v @r{Scroll calendar forward/backward by 3 months.}
+M-S-@key{down}/@key{up} @r{Scroll calendar forward/backward by one year.}
@end example
@vindex org-read-date-display-live
@@ -6035,7 +6167,7 @@ on, the current interpretation of your input will be displayed live in the
minibuffer@footnote{If you find this distracting, turn the display off with
@code{org-read-date-display-live}.}.
-@node Custom time format, , The date/time prompt, Creating timestamps
+@node Custom time format
@subsection Custom time format
@cindex custom date/time format
@cindex time format, custom
@@ -6083,10 +6215,12 @@ format is shorter, things do work as expected.
@end itemize
-@node Deadlines and scheduling, Clocking work time, Creating timestamps, Dates and Times
+@node Deadlines and scheduling
@section Deadlines and scheduling
-A timestamp may be preceded by special keywords to facilitate planning:
+A timestamp may be preceded by special keywords to facilitate planning. Both
+the timestamp and the keyword have to be positioned immediately after the task
+they refer to.
@table @var
@item DEADLINE
@@ -6110,9 +6244,9 @@ until the entry is marked DONE@. An example:
@end example
You can specify a different lead time for warnings for a specific
-deadlines using the following syntax. Here is an example with a warning
+deadline using the following syntax. Here is an example with a warning
period of 5 days @code{DEADLINE: <2004-02-29 Sun -5d>}. This warning is
-deactivated if the task get scheduled and you set
+deactivated if the task gets scheduled and you set
@code{org-agenda-skip-deadline-prewarning-if-scheduled} to @code{t}.
@item SCHEDULED
@@ -6172,28 +6306,25 @@ sexp entry matches.
* Repeated tasks:: Items that show up again and again
@end menu
-@node Inserting deadline/schedule, Repeated tasks, Deadlines and scheduling, Deadlines and scheduling
+@node Inserting deadline/schedule
@subsection Inserting deadlines or schedules
-The following commands allow you to quickly insert@footnote{The @samp{SCHEDULED} and
-@samp{DEADLINE} dates are inserted on the line right below the headline. Don't put
-any text between this line and the headline.} a deadline or to schedule
+The following commands allow you to quickly insert a deadline or to schedule
an item:
@table @kbd
@c
@orgcmd{C-c C-d,org-deadline}
-Insert @samp{DEADLINE} keyword along with a stamp. The insertion will happen
-in the line directly following the headline. Any CLOSED timestamp will be
-removed. When called with a prefix arg, an existing deadline will be removed
-from the entry. Depending on the variable @code{org-log-redeadline}@footnote{with corresponding
-@code{#+STARTUP} keywords @code{logredeadline}, @code{lognoteredeadline},
-and @code{nologredeadline}}, a note will be taken when changing an existing
+Insert @samp{DEADLINE} keyword along with a stamp. Any CLOSED timestamp will
+be removed. When called with a prefix arg, an existing deadline will be
+removed from the entry. Depending on the variable
+@code{org-log-redeadline}@footnote{with corresponding @code{#+STARTUP}
+keywords @code{logredeadline}, @code{lognoteredeadline}, and
+@code{nologredeadline}}, a note will be taken when changing an existing
deadline.
@orgcmd{C-c C-s,org-schedule}
-Insert @samp{SCHEDULED} keyword along with a stamp. The insertion will
-happen in the line directly following the headline. Any CLOSED timestamp
+Insert @samp{SCHEDULED} keyword along with a stamp. Any CLOSED timestamp
will be removed. When called with a prefix argument, remove the scheduling
date from the entry. Depending on the variable
@code{org-log-reschedule}@footnote{with corresponding @code{#+STARTUP}
@@ -6201,14 +6332,6 @@ keywords @code{logreschedule}, @code{lognotereschedule}, and
@code{nologreschedule}}, a note will be taken when changing an existing
scheduling time.
@c
-@orgcmd{C-c C-x C-k,org-mark-entry-for-agenda-action}
-@kindex k a
-@kindex k s
-Mark the current entry for agenda action. After you have marked the entry
-like this, you can open the agenda or the calendar to find an appropriate
-date. With the cursor on the selected date, press @kbd{k s} or @kbd{k d} to
-schedule the marked item.
-@c
@orgcmd{C-c / d,org-check-deadlines}
@cindex sparse tree, for deadlines
@vindex org-deadline-warning-days
@@ -6230,7 +6353,7 @@ setting the date by indicating a relative time: e.g., +1d will set
the date to the next day after today, and --1w will set the date
to the previous week before any current timestamp.
-@node Repeated tasks, , Inserting deadline/schedule, Deadlines and scheduling
+@node Repeated tasks
@subsection Repeated tasks
@cindex tasks, repeated
@cindex repeated tasks
@@ -6271,6 +6394,9 @@ switch the date like this:
DEADLINE: <2005-11-01 Tue +1m>
@end example
+To mark a task with a repeater as @code{DONE}, use @kbd{C-- 1 C-c C-t}
+(i.e., @code{org-todo} with a numeric prefix argument of -1.)
+
@vindex org-log-repeat
A timestamp@footnote{You can change this using the option
@code{org-log-repeat}, or the @code{#+STARTUP} options @code{logrepeat},
@@ -6299,6 +6425,13 @@ special repeaters @samp{++} and @samp{.+}. For example:
but also by as many weeks as it takes to get this date into
the future. However, it stays on a Sunday, even if you called
and marked it done on Saturday.
+** TODO Empty kitchen trash
+ DEADLINE: <2008-02-08 Fri 20:00 ++1d>
+ Marking this DONE will shift the date by at least one day, and
+ also by as many days as it takes to get the timestamp into the
+ future. Since there is a time in the timestamp, the next
+ deadline in the future will be on today's date if you
+ complete the task before 20:00.
** 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
@@ -6310,7 +6443,9 @@ You may have both scheduling and deadline information for a specific task.
If the repeater is set for the scheduling information only, you probably want
the repeater to be ignored after the deadline. If so, set the variable
@code{org-agenda-skip-scheduled-if-deadline-is-shown} to
-@code{repeated-after-deadline}. If you want both scheduling and deadline
+@code{repeated-after-deadline}. However, any scheduling information without
+a repeater is no longer relevant once the task is done, and thus, removed
+upon repeating the task. If you want both scheduling and deadline
information to repeat after the same interval, set the same repeater for both
timestamps.
@@ -6319,7 +6454,7 @@ subtree, with dates shifted in each copy. The command @kbd{C-c C-x c} was
created for this purpose, it is described in @ref{Structure editing}.
-@node Clocking work time, Effort estimates, Deadlines and scheduling, Dates and Times
+@node Clocking work time
@section Clocking work time
@cindex clocking time
@cindex time clocking
@@ -6330,10 +6465,9 @@ you stop working on that task, or when you mark the task done, the clock is
stopped and the corresponding time interval is 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 hardcoded
-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 tasks absorbing your time.
+limitation of @code{lmax} in @code{org-clock-sum}.} of a project.
+And it remembers a history or tasks 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
@lisp
@@ -6352,7 +6486,7 @@ what to do with it.
* Resolving idle time:: Resolving time when you've been idle
@end menu
-@node Clocking commands, The clock table, Clocking work time, Clocking work time
+@node Clocking commands
@subsection Clocking commands
@table @kbd
@@ -6387,7 +6521,7 @@ reset of the task @footnote{as recorded by the @code{LAST_REPEAT} property}
will be shown. More control over what time is shown can be exercised with
the @code{CLOCK_MODELINE_TOTAL} property. It may have the values
@code{current} to show only the current clocking instance, @code{today} to
-show all time clocked on this tasks today (see also the variable
+show all time clocked on this task today (see also the variable
@code{org-extend-today-until}), @code{all} to include all time, or
@code{auto} which is the default@footnote{See also the variable
@code{org-clock-modeline-total}.}.@* Clicking with @kbd{mouse-1} onto the
@@ -6397,7 +6531,7 @@ mode line entry will pop up a menu with clocking options.
@vindex org-log-note-clock-out
Stop the clock (clock-out). This inserts another timestamp at the same
location where the clock was last started. It also directly computes
-the resulting time in inserts it after the time range as @samp{=>
+the resulting time and inserts it after the time range as @samp{=>
HH:MM}. See the variable @code{org-log-note-clock-out} for the
possibility to record an additional note together with the clock-out
timestamp@footnote{The corresponding in-buffer setting is:
@@ -6444,15 +6578,14 @@ buffer (see variable @code{org-remove-highlights-with-change}) or press
@kbd{C-c C-c}.
@end table
-The @kbd{l} key may be used in the timeline (@pxref{Timeline}) and in
-the agenda (@pxref{Weekly/daily agenda}) to show which tasks have been
-worked on or closed during a day.
+The @kbd{l} key may be used the agenda (@pxref{Weekly/daily agenda}) to show
+which tasks have been worked on or closed during a day.
@strong{Important:} note that both @code{org-clock-out} and
-@code{org-clock-in-last} can have a global keybinding and will not
+@code{org-clock-in-last} can have a global key binding and will not
modify the window disposition.
-@node The clock table, Resolving idle time, Clocking commands, Clocking work time
+@node The clock table
@subsection The clock table
@cindex clocktable, dynamic block
@cindex report, of clocked time
@@ -6470,8 +6603,7 @@ argument, jump to the first clock report in the current document and
update it. The clock table always includes also trees with
@code{:ARCHIVE:} tag.
@orgcmdkkc{C-c C-c,C-c C-x C-u,org-dblock-update}
-Update dynamic block at point. The cursor needs to be in the
-@code{#+BEGIN} line of the dynamic block.
+Update dynamic block at point.
@orgkey{C-u C-c C-x C-u}
Update all dynamic blocks (@pxref{Dynamic blocks}). This is useful if
you have several clock table blocks in a buffer.
@@ -6492,7 +6624,7 @@ buffer with the @kbd{C-c C-x C-r} command:
@end example
@noindent
@vindex org-clocktable-defaults
-The @samp{BEGIN} line and specify a number of options to define the scope,
+The @samp{BEGIN} line specifies 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}.
@@ -6509,10 +6641,11 @@ be selected:
tree @r{the surrounding level 1 tree}
agenda @r{all agenda files}
("file"..) @r{scan these files}
+ function @r{the list of files returned by a function of no argument}
file-with-archives @r{current file and its archives}
agenda-with-archives @r{all agenda files, including archives}
:block @r{The time block to consider. This block is specified either}
- @r{absolute, or relative to the current time and may be any of}
+ @r{absolutely, or relative to the current time and may be any of}
@r{these formats:}
2007-12-31 @r{New year eve 2007}
2007-12 @r{December 2007}
@@ -6523,6 +6656,7 @@ be selected:
thisweek, lastweek, thisweek-@var{N} @r{a relative week}
thismonth, lastmonth, thismonth-@var{N} @r{a relative month}
thisyear, lastyear, thisyear-@var{N} @r{a relative year}
+ untilnow
@r{Use @kbd{S-@key{left}/@key{right}} keys to shift the time interval.}
:tstart @r{A time string specifying when to start considering times.}
@r{Relative times like @code{"<-2w>"} can also be used. See}
@@ -6541,7 +6675,7 @@ be selected:
@r{@ref{Matching tags and properties} for the match syntax.}
@end example
-Then there are options which determine the formatting of the table. There
+Then there are options which determine the formatting of the table. These
options are interpreted by the function @code{org-clocktable-write-default},
but you can specify your own function using the @code{:formatter} parameter.
@example
@@ -6555,6 +6689,8 @@ but you can specify your own function using the @code{:formatter} parameter.
:tcolumns @r{Number of columns to be used for times. If this is smaller}
@r{than @code{:maxlevel}, lower levels will be lumped into one column.}
:level @r{Should a level number column be included?}
+:sort @r{A cons cell like containing the column to sort and a sorting type.}
+ @r{E.g., @code{:sort (1 . ?a)} sorts the first column alphabetically.}
:compact @r{Abbreviation for @code{:level nil :indent t :narrow 40! :tcolumns 1}}
@r{All are overwritten except if there is an explicit @code{:narrow}}
:timestamp @r{A timestamp for the entry, when available. Look for SCHEDULED,}
@@ -6600,7 +6736,7 @@ would be
#+END: clocktable
@end example
-@node Resolving idle time, , The clock table, Clocking work time
+@node Resolving idle time
@subsection Resolving idle time and continuous clocking
@subsubheading Resolving idle time
@@ -6616,7 +6752,7 @@ applying it to another one.
@vindex org-clock-idle-time
By customizing the variable @code{org-clock-idle-time} to some integer, such
as 10 or 15, Emacs can alert you when you get back to your computer after
-being idle for that many minutes@footnote{On computers using macOS,
+being idle for that many minutes@footnote{On computers using Mac OS X,
idleness is based on actual user idleness, not just Emacs' idle time. For
X11, you can install a utility program @file{x11idle.c}, available in the
@code{contrib/scripts} directory of the Org git distribution, or install the
@@ -6685,20 +6821,18 @@ last clocked entry for this session, and start the new clock from there.
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}.
-@node Effort estimates, Relative timer, Clocking work time, Dates and Times
+@node Effort estimates
@section Effort estimates
@cindex effort estimates
@cindex property, Effort
-@vindex org-effort-property
If you want to plan your work in a very detailed way, or if you need 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}@footnote{You may change the property being
-used with the variable @code{org-effort-property}.}. You can set the effort
-for an entry with the following commands:
+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 @code{EFFORT}. You can set the effort for an entry with
+the following commands:
@table @kbd
@orgcmd{C-c C-x e,org-set-effort}
@@ -6748,61 +6882,57 @@ with the @kbd{/} key in the agenda (@pxref{Agenda commands}). If you have
these estimates defined consistently, two or three key presses will narrow
down the list to stuff that fits into an available time slot.
-@node Relative timer, Countdown timer, Effort estimates, Dates and Times
-@section Taking notes with a relative timer
+@node Timers
+@section Taking notes with a timer
@cindex relative timer
+@cindex countdown timer
+@kindex ;
+
+Org provides two types of timers. There is a relative timer that counts up,
+which can be useful when taking notes during, for example, a meeting or
+a video viewing. There is also a countdown timer.
+
+The relative and countdown are started with separate commands.
+
+@table @kbd
+@orgcmd{C-c C-x 0,org-timer-start}
+Start or reset the relative timer. By default, the timer is set to 0. When
+called with a @kbd{C-u} prefix, prompt the user for a starting offset. If
+there is a timer string at point, this is taken as the default, providing a
+convenient way to restart taking notes after a break in the process. When
+called with a double prefix argument @kbd{C-u C-u}, change all timer strings
+in the active region by a certain amount. This can be used to fix timer
+strings if the timer was not started at exactly the right moment.
+@orgcmd{C-c C-x ;,org-timer-set-timer}
+Start a countdown timer. The user is prompted for a duration.
+@code{org-timer-default-timer} sets the default countdown value. Giving
+a numeric prefix argument overrides this default value. This command is
+available as @kbd{;} in agenda buffers.
+@end table
-When taking notes during, for example, a meeting or a video viewing, it can
-be useful to have access to times relative to a starting time. Org provides
-such a relative timer and make it easy to create timed notes.
+Once started, relative and countdown timers are controlled with the same
+commands.
@table @kbd
@orgcmd{C-c C-x .,org-timer}
-Insert a relative time into the buffer. The first time you use this, the
-timer will be started. When called with a prefix argument, the timer is
-restarted.
+Insert the value of the current relative or countdown timer into the buffer.
+If no timer is running, the relative timer will be started. When called with
+a prefix argument, the relative timer is restarted.
@orgcmd{C-c C-x -,org-timer-item}
-Insert a description list item with the current relative time. With a prefix
-argument, first reset the timer to 0.
+Insert a description list item with the value of the current relative or
+countdown timer. With a prefix argument, first reset the relative timer to
+0.
@orgcmd{M-@key{RET},org-insert-heading}
Once the timer list is started, you can also use @kbd{M-@key{RET}} to insert
new timer items.
-@c for key sequences with a comma, command name macros fail :(
-@kindex C-c C-x ,
-@item C-c C-x ,
-Pause the timer, or continue it if it is already paused
-(@command{org-timer-pause-or-continue}).
-@c removed the sentence because it is redundant to the following item
-@kindex C-u C-c C-x ,
-@item C-u C-c C-x ,
+@orgcmd{C-c C-x @comma{},org-timer-pause-or-continue}
+Pause the timer, or continue it if it is already paused.
+@orgcmd{C-c C-x _,org-timer-stop}
Stop the timer. After this, you can only start a new timer, not continue the
old one. This command also removes the timer from the mode line.
-@orgcmd{C-c C-x 0,org-timer-start}
-Reset the timer without inserting anything into the buffer. By default, the
-timer is reset to 0. When called with a @kbd{C-u} prefix, reset the timer to
-specific starting offset. The user is prompted for the offset, with a
-default taken from a timer string at point, if any, So this can be used to
-restart taking notes after a break in the process. When called with a double
-prefix argument @kbd{C-u C-u}, change all timer strings in the active region
-by a certain amount. This can be used to fix timer strings if the timer was
-not started at exactly the right moment.
@end table
-@node Countdown timer, , Relative timer, Dates and Times
-@section Countdown timer
-@cindex Countdown timer
-@kindex C-c C-x ;
-@kindex ;
-
-Calling @code{org-timer-set-timer} from an Org mode buffer runs a countdown
-timer. Use @kbd{;} from agenda buffers, @key{C-c C-x ;} everywhere else.
-
-@code{org-timer-set-timer} prompts the user for a duration and displays a
-countdown timer in the modeline. @code{org-timer-default-timer} sets the
-default countdown value. Giving a prefix numeric argument overrides this
-default value.
-
-@node Capture - Refile - Archive, Agenda Views, Dates and Times, Top
+@node Capture - Refile - Archive
@chapter Capture - Refile - Archive
@cindex capture
@@ -6816,13 +6946,13 @@ trees to an archive file keeps the system compact and fast.
@menu
* Capture:: Capturing new stuff
* Attachments:: Add files to tasks
-* RSS Feeds:: Getting input from RSS feeds
+* RSS feeds:: Getting input from RSS feeds
* Protocols:: External (e.g., Browser) access to Emacs and Org
* Refile and copy:: Moving/copying a tree from one place to another
* Archiving:: What to do with finished projects
@end menu
-@node Capture, Attachments, Capture - Refile - Archive, Capture - Refile - Archive
+@node Capture
@section Capture
@cindex capture
@@ -6849,7 +6979,7 @@ customization.
* Capture templates:: Define the outline of different note types
@end menu
-@node Setting up capture, Using capture, Capture, Capture
+@node Setting up capture
@subsection Setting up capture
The following customization sets a default target file for notes, and defines
@@ -6864,12 +6994,12 @@ suggestion.} for capturing new material.
@end group
@end smalllisp
-@node Using capture, Capture templates, Setting up capture, Capture
+@node Using capture
@subsection Using capture
@table @kbd
@orgcmd{C-c c,org-capture}
-Call the command @code{org-capture}. Note that this keybinding is global and
+Call the command @code{org-capture}. Note that this key binding is global and
not active by default: you need to install it. If you have templates
@cindex date tree
defined @pxref{Capture templates}, it will offer these templates for
@@ -6921,7 +7051,7 @@ automatically be created unless you set @code{org-capture-bookmark} to
To insert the capture at point in an Org buffer, call @code{org-capture} with
a @code{C-0} prefix argument.
-@node Capture templates, , Using capture, Capture
+@node Capture templates
@subsection Capture templates
@cindex templates, for Capture
@@ -6946,7 +7076,7 @@ would look like:
(setq org-capture-templates
'(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks")
"* TODO %?\n %i\n %a")
- ("j" "Journal" entry (file+datetree "~/org/journal.org")
+ ("j" "Journal" entry (file+olp+datetree "~/org/journal.org")
"* %?\nEntered on %U\n %i\n %a")))
@end group
@end smalllisp
@@ -6980,7 +7110,7 @@ like this:
* Templates in contexts:: Only show a template in a specific context
@end menu
-@node Template elements, Template expansion, Capture templates, Capture templates
+@node Template elements
@subsubsection Template elements
Now lets look at the elements of a template definition. Each entry in
@@ -7032,7 +7162,9 @@ files, targets usually define a node. Entries will become children of this
node. Other types will be added to the table or list in the body of this
node. Most target specifications contain a file name. If that file name is
the empty string, it defaults to @code{org-default-notes-file}. A file can
-also be given as a variable, function, or Emacs Lisp form.
+also be given as a variable or as a function called with no argument. When
+an absolute path is not specified for a target, it is taken as relative to
+@code{org-directory}.
Valid values are:
@@ -7052,14 +7184,19 @@ For non-unique headings, the full path is safer.
@item (file+regexp "path/to/file" "regexp to find location")
Use a regular expression to position the cursor.
-@item (file+datetree "path/to/file")
-Will create a heading in a date tree for today's date@footnote{Datetree
-headlines for years accept tags, so if you use both @code{* 2013 :noexport:}
-and @code{* 2013} in your file, the capture will refile the note to the first
-one matched.}.
-
-@item (file+datetree+prompt "path/to/file")
-Will create a heading in a date tree, but will prompt for the date.
+@item (file+olp+datetree "path/to/file" [ "Level 1 heading" ....])
+This target@footnote{Org used to offer four different targets for date/week
+tree capture. Now, Org automatically translates these to use
+@code{file+olp+datetree}, applying the @code{:time-prompt} and
+@code{:tree-type} properties. Please rewrite your date/week-tree targets
+using @code{file+olp+datetree} since the older targets are now deprecated.}
+will create a heading in a date tree@footnote{A date tree is an outline
+structure with years on the highest level, months or ISO-weeks as sublevels
+and then dates on the lowest level. Tags are allowed in the tree structure.}
+for today's date. If the optional outline path is given, the tree will be
+built under the node it is pointing to, instead of at top level. Check out
+the @code{:time-prompt} and @code{:tree-type} properties below for additional
+options.
@item (file+function "path/to/file" function-finding-location)
A function to find the right location in the file.
@@ -7068,8 +7205,8 @@ A function to find the right location in the file.
File to the entry that is currently being clocked.
@item (function function-finding-location)
-Most general way, write your own function to find both
-file and location.
+Most general way: write your own function which both visits
+the file and moves point to the right location.
@end table
@item template
@@ -7111,15 +7248,26 @@ with the capture. Note that @code{:clock-keep} has precedence over
@code{:clock-resume}. When setting both to @code{t}, the current clock will
run and the previous one will not be resumed.
+@item :time-prompt
+Prompt for a date/time to be used for date/week trees and when filling the
+template. Without this property, capture uses the current date and time.
+Even if this property has not been set, you can force the same behavior by
+calling @code{org-capture} with a @kbd{C-1} prefix argument.
+
+@item :tree-type
+When `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.
+
@item :unnarrowed
Do not narrow the target buffer, simply show the full buffer. Default is to
narrow it so that you only see the new material.
@item :table-line-pos
Specification of the location in the table where the new line should be
-inserted. It should be a string like @code{"II-3"} meaning that the new
-line should become the third line before the second horizontal separator
-line.
+inserted. It can be a string, a variable holding a string or a function
+returning a string. The string should look like @code{"II-3"} meaning that
+the new line should become the third line before the second horizontal
+separator line.
@item :kill-buffer
If the target file was not yet visited when capture was invoked, kill the
@@ -7127,7 +7275,7 @@ buffer again after capture is completed.
@end table
@end table
-@node Template expansion, Templates in contexts, Template elements, Capture templates
+@node Template expansion
@subsubsection Template expansion
In the template itself, special @kbd{%}-escapes@footnote{If you need one of
@@ -7169,8 +7317,12 @@ dynamic insertion of content. The templates are expanded in the order given her
@r{You may specify a default value and a completion table with}
@r{%^@{prompt|default|completion2|completion3...@}.}
@r{The arrow keys access a prompt-specific history.}
-%\n @r{Insert the text entered at the nth %^@{@var{prompt}@}, where @code{n} is}
- @r{a number, starting from 1.}
+%\1 @dots{} %\N @r{Insert the text entered at the Nth %^@{@var{prompt}@}, where @code{N} is}
+ @r{a number, starting from 1.@footnote{As required in Emacs
+ Lisp, it is necessary to escape any backslash character in
+ a string with another backslash. So, in order to use
+ @samp{%\1} placeholder, you need to write @samp{%\\1} in
+ the template.}}
%? @r{After completing the template, position cursor here.}
@end smallexample
@@ -7187,17 +7339,18 @@ Link type | Available keywords
---------------------------------+----------------------------------------------
bbdb | %:name %:company
irc | %:server %:port %:nick
-vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id
- | %:from %:fromname %:fromaddress
+vm, vm-imap, wl, mh, mew, rmail, | %:type %:subject %:message-id
+gnus, notmuch | %:from %:fromname %:fromaddress
| %:to %:toname %:toaddress
| %:date @r{(message date header field)}
| %:date-timestamp @r{(date as active timestamp)}
| %:date-timestamp-inactive @r{(date as inactive timestamp)}
| %:fromto @r{(either "to NAME" or "from NAME")@footnote{This will always be the other, not the user. See the variable @code{org-from-is-user-regexp}.}}
gnus | %:group, @r{for messages also all email fields}
-w3, w3m | %:url
+eww, w3, w3m | %:url
info | %:file %:node
calendar | %:date
+org-protocol | %:link %:description %:annotation
@end smallexample
@noindent
@@ -7207,7 +7360,7 @@ To place the cursor after template expansion use:
%? @r{After completing the template, position cursor here.}
@end smallexample
-@node Templates in contexts, , Template expansion, Capture templates
+@node Templates in contexts
@subsubsection Templates in contexts
@vindex org-capture-templates-contexts
@@ -7231,7 +7384,7 @@ template. In that case, add this command key like this:
See the docstring of the variable for more information.
-@node Attachments, RSS Feeds, Capture, Capture - Refile - Archive
+@node Attachments
@section Attachments
@cindex attachments
@@ -7277,6 +7430,9 @@ Note that hard links are not supported on all systems.
Attach a file using the copy/move/link method.
Note that hard links are not supported on all systems.
+@orgcmdtkc{u,C-c C-a u,org-attach-url}
+Attach a file from URL
+
@orgcmdtkc{n,C-c C-a n,org-attach-new}
Create a new attachment as an Emacs buffer.
@@ -7319,7 +7475,7 @@ same directory for attachments as the parent does.
@end table
@end table
-@node RSS Feeds, Protocols, Attachments, Capture - Refile - Archive
+@node RSS feeds
@section RSS feeds
@cindex RSS feeds
@cindex Atom feeds
@@ -7357,31 +7513,220 @@ Prompt for a feed name and go to the inbox configured for this feed.
Under the same headline, Org will create a drawer @samp{FEEDSTATUS} in which
it will store information about the status of items in the feed, to avoid
-adding the same item several times. You should add @samp{FEEDSTATUS} to the
-list of drawers in that file:
-
-@example
-#+DRAWERS: LOGBOOK PROPERTIES FEEDSTATUS
-@end example
+adding the same item several times.
For more information, including how to read atom feeds, see
@file{org-feed.el} and the docstring of @code{org-feed-alist}.
-@node Protocols, Refile and copy, RSS Feeds, Capture - Refile - Archive
+@node Protocols
@section Protocols for external access
@cindex protocols, for external access
-@cindex emacsserver
-You can set up Org for handling protocol calls from outside applications that
-are passed to Emacs through the @file{emacsserver}. For example, you can
+Org protocol is a mean to trigger custom actions in Emacs from external
+applications. Any application that supports calling external programs with
+an URL as argument may be used with this functionality. For example, you can
configure bookmarks in your web browser to send a link to the current page to
-Org and create a note from it using capture (@pxref{Capture}). Or you
-could create a bookmark that will tell Emacs to open the local source file of
-a remote website you are looking at with the browser. See
-@uref{http://orgmode.org/worg/org-contrib/org-protocol.php} for detailed
-documentation and setup instructions.
+Org and create a note from it using capture (@pxref{Capture}). You can also
+create a bookmark that tells Emacs to open the local source file of a remote
+website you are browsing.
+
+@cindex Org protocol, set-up
+@cindex Installing Org protocol
+In order to use Org protocol from an application, you need to register
+@samp{org-protocol://} as a valid scheme-handler. External calls are passed
+to Emacs through the @code{emacsclient} command, so you also need to ensure
+an Emacs server is running. More precisely, when the application calls
+
+@example
+emacsclient org-protocol://PROTOCOL?key1=val1&key2=val2
+@end example
+
+@noindent
+Emacs calls the handler associated to @samp{PROTOCOL} with argument
+@samp{(:key1 val1 :key2 val2)}.
+
+@cindex protocol, new protocol
+@cindex defining new protocols
+Org protocol comes with three predefined protocols, detailed in the following
+sections. Configure @code{org-protocol-protocol-alist} to define your own.
+
+@menu
+* @code{store-link} protocol:: Store a link, push URL to kill-ring.
+* @code{capture} protocol:: Fill a buffer with external information.
+* @code{open-source} protocol:: Edit published contents.
+@end menu
+
+@node @code{store-link} protocol
+@subsection @code{store-link} protocol
+@cindex store-link protocol
+@cindex protocol, store-link
+
+Using @code{store-link} handler, you can copy links, insertable through
+@kbd{M-x org-insert-link} or yanking thereafter. More precisely, the command
+
+@example
+emacsclient org-protocol://store-link?url=URL&title=TITLE
+@end example
+
+@noindent
+stores the following link:
+
+@example
+[[URL][TITLE]]
+@end example
+
+In addition, @samp{URL} is pushed on the kill-ring for yanking. You need to
+encode @samp{URL} and @samp{TITLE} if they contain slashes, and probably
+quote those for the shell.
+
+To use this feature from a browser, add a bookmark with an arbitrary name,
+e.g., @samp{Org: store-link} and enter this as @emph{Location}:
+
+@example
+javascript:location.href='org-protocol://store-link?url='+
+ encodeURIComponent(location.href);
+@end example
+
+@node @code{capture} protocol
+@subsection @code{capture} protocol
+@cindex capture protocol
+@cindex protocol, capture
+
+Activating @code{capture} handler pops up a @samp{Capture} buffer and fills
+the capture template associated to the @samp{X} key with them.
+
+@example
+emacsclient org-protocol://capture?template=X?url=URL?title=TITLE?body=BODY
+@end example
+
+To use this feature, add a bookmark with an arbitrary name, e.g. @samp{Org:
+capture} and enter this as @samp{Location}:
-@node Refile and copy, Archiving, Protocols, Capture - Refile - Archive
+@example
+javascript:location.href='org-protocol://template=x'+
+ '&url='+encodeURIComponent(window.location.href)+
+ '&title='+encodeURIComponent(document.title)+
+ '&body='+encodeURIComponent(window.getSelection());
+@end example
+
+@vindex org-protocol-default-template-key
+The result depends on the capture template used, which is set in the bookmark
+itself, as in the example above, or in
+@code{org-protocol-default-template-key}.
+
+@cindex capture, %:link placeholder
+@cindex %:link template expansion in capture
+@cindex capture, %:description placeholder
+@cindex %:description template expansion in capture
+@cindex capture, %:annotation placeholder
+@cindex %:annotation template expansion in capture
+The following template placeholders are available:
+
+@example
+%:link The URL
+%:description The webpage title
+%:annotation Equivalent to [[%:link][%:description]]
+%i The selected text
+@end example
+
+@node @code{open-source} protocol
+@subsection @code{open-source} protocol
+@cindex open-source protocol
+@cindex protocol, open-source
+
+The @code{open-source} handler is designed to help with editing local sources
+when reading a document. To that effect, you can use a bookmark with the
+following location:
+
+@example
+javascript:location.href='org-protocol://open-source?&url='+
+ encodeURIComponent(location.href)
+@end example
+
+@cindex protocol, open-source, :base-url property
+@cindex :base-url property in open-source protocol
+@cindex protocol, open-source, :working-directory property
+@cindex :working-directory property in open-source protocol
+@cindex protocol, open-source, :online-suffix property
+@cindex :online-suffix property in open-source protocol
+@cindex protocol, open-source, :working-suffix property
+@cindex :working-suffix property in open-source protocol
+@vindex org-protocol-project-alist
+The variable @code{org-protocol-project-alist} maps URLs to local file names,
+by stripping URL parameters from the end and replacing the @code{:base-url}
+with @code{:working-directory} and @code{:online-suffix} with
+@code{:working-suffix}. For example, assuming you own a local copy of
+@url{http://orgmode.org/worg/} contents at @file{/home/user/worg}, you can
+set @code{org-protocol-project-alist} to the following
+
+@lisp
+(setq org-protocol-project-alist
+ '(("Worg"
+ :base-url "http://orgmode.org/worg/"
+ :working-directory "/home/user/worg/"
+ :online-suffix ".html"
+ :working-suffix ".org")))
+@end lisp
+
+@noindent
+If you are now browsing
+@url{http://orgmode.org/worg/org-contrib/org-protocol.html} and find a typo
+or have an idea about how to enhance the documentation, simply click the
+bookmark and start editing.
+
+@cindex handle rewritten URL in open-source protocol
+@cindex protocol, open-source rewritten URL
+However, such mapping may not yield the desired results. Suppose you
+maintain an online store located at @url{http://example.com/}. The local
+sources reside in @file{/home/user/example/}. It is common practice to serve
+all products in such a store through one file and rewrite URLs that do not
+match an existing file on the server. That way, a request to
+@url{http://example.com/print/posters.html} might be rewritten on the server
+to something like
+@url{http://example.com/shop/products.php/posters.html.php}. The
+@code{open-source} handler probably cannot find a file named
+@file{/home/user/example/print/posters.html.php} and fails.
+
+@cindex protocol, open-source, :rewrites property
+@cindex :rewrites property in open-source protocol
+Such an entry in @code{org-protocol-project-alist} may hold an additional
+property @code{:rewrites}. This property is a list of cons cells, each of
+which maps a regular expression to a path relative to the
+@code{:working-directory}.
+
+Now map the URL to the path @file{/home/user/example/products.php} by adding
+@code{:rewrites} rules like this:
+
+@lisp
+(setq org-protocol-project-alist
+ '(("example.com"
+ :base-url "http://example.com/"
+ :working-directory "/home/user/example/"
+ :online-suffix ".php"
+ :working-suffix ".php"
+ :rewrites (("example.com/print/" . "products.php")
+ ("example.com/$" . "index.php")))))
+@end lisp
+
+@noindent
+Since @samp{example.com/$} is used as a regular expression, it maps
+@url{http://example.com/}, @url{https://example.com},
+@url{http://www.example.com/} and similar to
+@file{/home/user/example/index.php}.
+
+The @code{:rewrites} rules are searched as a last resort if and only if no
+existing file name is matched.
+
+@cindex protocol, open-source, set-up mapping
+@cindex set-up mappings in open-source protocol
+@findex org-protocol-create
+@findex org-protocol-create-for-org
+Two functions can help you filling @code{org-protocol-project-alist} with
+valid contents: @code{org-protocol-create} and
+@code{org-protocol-create-for-org}. The latter is of use if you're editing
+an Org file that is part of a publishing project.
+
+@node Refile and copy
@section Refile and copy
@cindex refiling notes
@cindex copying notes
@@ -7438,7 +7783,7 @@ setting @code{org-refile-use-cache}. To make the command see new possible
targets, you have to clear the cache with this command.
@end table
-@node Archiving, , Refile and copy, Capture - Refile - Archive
+@node Archiving
@section Archiving
@cindex archiving
@@ -7459,7 +7804,7 @@ Archive the current entry using the command specified in the variable
* Internal archiving:: Switch off a tree but keep it in the file
@end menu
-@node Moving subtrees, Internal archiving, Archiving, Archiving
+@node Moving subtrees
@subsection Moving a tree to the archive file
@cindex external archiving
@@ -7477,6 +7822,10 @@ the archive. To do this, each subtree is checked for open TODO entries.
If none are found, the command offers to move it to the archive
location. If the cursor is @emph{not} on a headline when this command
is invoked, the level 1 trees will be checked.
+@orgkey{C-u C-u C-c C-x C-s}
+As above, but check subtree for timestamps instead of TODO entries. The
+command will offer to archive the subtree if it @emph{does} contain a
+timestamp, and that timestamp is in the past.
@end table
@cindex archive locations
@@ -7488,14 +7837,7 @@ For information and examples on how to specify the file and the heading,
see the documentation string of the variable
@code{org-archive-location}.
-There is also an in-buffer option for setting this variable, for
-example@footnote{For backward compatibility, the following also works:
-If there are several such lines in a file, each specifies the archive
-location for the text below it. The first such line also applies to any
-text before its definition. However, using this method is
-@emph{strongly} deprecated as it is incompatible with the outline
-structure of the document. The correct method for setting multiple
-archive locations in a buffer is using properties.}:
+There is also an in-buffer option for setting this variable, for example:
@cindex #+ARCHIVE
@example
@@ -7506,7 +7848,7 @@ archive locations in a buffer is using properties.}:
@noindent
If you would like to have a special ARCHIVE location for a single entry
or a (sub)tree, give the entry an @code{:ARCHIVE:} property with the
-location as the value (@pxref{Properties and Columns}).
+location as the value (@pxref{Properties and columns}).
@vindex org-archive-save-context-info
When a subtree is moved, it receives a number of special properties that
@@ -7516,14 +7858,15 @@ outline path the archiving time etc. Configure the variable
added.
-@node Internal archiving, , Moving subtrees, Archiving
+@node Internal archiving
@subsection Internal archiving
-If you want to just switch off (for agenda views) certain subtrees without
-moving them to a different file, you can use the @code{ARCHIVE tag}.
+@cindex archive tag
+If you want to just switch off---for agenda views---certain subtrees without
+moving them to a different file, you can use the archive tag.
-A headline that is marked with the ARCHIVE tag (@pxref{Tags}) stays at
-its location in the outline tree, but behaves in the following way:
+A headline that is marked with the @samp{:ARCHIVE:} tag (@pxref{Tags}) stays
+at its location in the outline tree, but behaves in the following way:
@itemize @minus
@item
@vindex org-cycle-open-archived-trees
@@ -7539,7 +7882,7 @@ archived subtrees are not exposed, unless you configure the option
@code{org-sparse-tree-open-archived-trees}.
@item
@vindex org-agenda-skip-archived-trees
-During agenda view construction (@pxref{Agenda Views}), the content of
+During agenda view construction (@pxref{Agenda views}), the content of
archived trees is ignored unless you configure the option
@code{org-agenda-skip-archived-trees}, in which case these trees will always
be included. In the agenda you can press @kbd{v a} to get archives
@@ -7579,7 +7922,7 @@ outline.
@end table
-@node Agenda Views, Markup, Capture - Refile - Archive, Top
+@node Agenda views
@chapter Agenda views
@cindex agenda views
@@ -7590,7 +7933,7 @@ important for a particular date, this information must be collected,
sorted and displayed in an organized way.
Org can select items based on various criteria and display them
-in a separate buffer. Seven different view types are provided:
+in a separate buffer. Six different view types are provided:
@itemize @bullet
@item
@@ -7603,9 +7946,6 @@ action items,
a @emph{match view}, showings headlines based on the tags, properties, and
TODO state associated with them,
@item
-a @emph{timeline view} that shows all events in a single Org file,
-in time-sorted view,
-@item
a @emph{text search view} that shows all entries from multiple files
that contain specified keywords,
@item
@@ -7622,6 +7962,15 @@ buffer}. This buffer is read-only, but provides commands to visit the
corresponding locations in the original Org files, and even to
edit these files remotely.
+@vindex org-agenda-skip-comment-trees
+@vindex org-agenda-skip-archived-trees
+@cindex commented entries, in agenda views
+@cindex archived entries, in agenda views
+By default, the report ignores commented (@pxref{Comment lines}) and archived
+(@pxref{Internal archiving}) entries. You can override this by setting
+@code{org-agenda-skip-comment-trees} and
+@code{org-agenda-skip-archived-trees} to @code{nil}.
+
@vindex org-agenda-window-setup
@vindex org-agenda-restore-windows-after-quit
Two variables control how the agenda buffer is displayed and whether the
@@ -7636,11 +7985,11 @@ window configuration is restored when the agenda exits:
* Presentation and sorting:: How agenda items are prepared for display
* Agenda commands:: Remote editing of Org trees
* Custom agenda views:: Defining special searches and views
-* Exporting Agenda Views:: Writing a view to a file
+* Exporting agenda views:: Writing a view to a file
* Agenda column view:: Using column view for collected entries
@end menu
-@node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views
+@node Agenda files
@section Agenda files
@cindex agenda files
@cindex files for agenda
@@ -7717,7 +8066,7 @@ effect immediately.
Lift the restriction.
@end table
-@node Agenda dispatcher, Built-in agenda views, Agenda files, Agenda Views
+@node Agenda dispatcher
@section The agenda dispatcher
@cindex agenda dispatcher
@cindex dispatching agenda commands
@@ -7736,8 +8085,6 @@ Create a list of all TODO items (@pxref{Global TODO list}).
@item m @r{/} M
Create a list of headlines matching a TAGS expression (@pxref{Matching
tags and properties}).
-@item L
-Create the timeline view for the current buffer (@pxref{Timeline}).
@item s
Create a list of entries selected by a boolean expression of keywords
and/or regular expressions that must or must not occur in the entry.
@@ -7763,15 +8110,17 @@ current region/subtree.}. After pressing @kbd{< <}, you still need to press the
character selecting the command.
@item *
+@cindex agenda, sticky
@vindex org-agenda-sticky
Toggle sticky agenda views. By default, Org maintains only a single agenda
buffer and rebuilds it each time you change the view, to make sure everything
-is always up to date. If you switch between views often and the build time
-bothers you, you can turn on sticky agenda buffers (make this the default by
-customizing the variable @code{org-agenda-sticky}). With sticky agendas, the
-dispatcher only switches to the selected view, you need to update it by hand
-with @kbd{r} or @kbd{g}. You can toggle sticky agenda view any time with
-@code{org-toggle-sticky-agenda}.
+is always up to date. If you often switch between agenda views and the build
+time bothers you, you can turn on sticky agenda buffers or make this the
+default by customizing the variable @code{org-agenda-sticky}. With sticky
+agendas, the agenda dispatcher will not recreate agenda views from scratch,
+it will only switch to the selected one, and you need to update the agenda by
+hand with @kbd{r} or @kbd{g} when needed. You can toggle sticky agenda view
+any time with @code{org-toggle-sticky-agenda}.
@end table
You can also define custom commands that will be accessible through the
@@ -7780,7 +8129,7 @@ possibility to create extended agenda buffers that contain several
blocks together, for example the weekly agenda, the global TODO list and
a number of special tags matches. @xref{Custom agenda views}.
-@node Built-in agenda views, Presentation and sorting, Agenda dispatcher, Agenda Views
+@node Built-in agenda views
@section The built-in agenda views
In this section we describe the built-in views.
@@ -7789,12 +8138,11 @@ In this section we describe the built-in views.
* Weekly/daily agenda:: The calendar page with current tasks
* Global TODO list:: All unfinished action items
* Matching tags and properties:: Structured information with fine-tuned search
-* Timeline:: Time-sorted view for single file
* Search view:: Find entries by searching for text
* Stuck projects:: Find projects you need to review
@end menu
-@node Weekly/daily agenda, Global TODO list, Built-in agenda views, Built-in agenda views
+@node Weekly/daily agenda
@subsection The weekly/daily agenda
@cindex agenda
@cindex weekly agenda
@@ -7872,10 +8220,16 @@ the following segment of an Org file will be processed and entries
will be made in the agenda:
@example
-* Birthdays and similar stuff
-#+CATEGORY: Holiday
+* Holidays
+ :PROPERTIES:
+ :CATEGORY: Holiday
+ :END:
%%(org-calendar-holiday) ; special function for holiday names
-#+CATEGORY: Ann
+
+* Birthdays
+ :PROPERTIES:
+ :CATEGORY: Ann
+ :END:
%%(org-anniversary 1956 5 14)@footnote{@code{org-anniversary} is just like @code{diary-anniversary}, but the argument order is always according to ISO and therefore independent of the value of @code{calendar-date-style}.} Arthur Dent is %d years old
%%(org-anniversary 1869 10 2) Mahatma Gandhi would be %d years old
@end example
@@ -7919,6 +8273,20 @@ hash with anniversaries. However, from then on things will be very fast---much
faster in fact than a long list of @samp{%%(diary-anniversary)} entries
in an Org or Diary file.
+If you would like to see upcoming anniversaries with a bit of forewarning,
+you can use the following instead:
+
+@example
+* Anniversaries
+ :PROPERTIES:
+ :CATEGORY: Anniv
+ :END:
+%%(org-bbdb-anniversaries-future 3)
+@end example
+
+That will give you three days' warning: on the anniversary date itself and the
+two days prior. The argument is optional: if omitted, it defaults to 7.
+
@subsubheading Appointment reminders
@cindex @file{appt.el}
@cindex appointment reminders
@@ -7933,7 +8301,7 @@ It also reads a @code{APPT_WARNTIME} property which will then override the
value of @code{appt-message-warning-time} for this appointment. See the
docstring for details.
-@node Global TODO list, Matching tags and properties, Weekly/daily agenda, Built-in agenda views
+@node Global TODO list
@subsection The global TODO list
@cindex global TODO list
@cindex TODO list, global
@@ -7944,7 +8312,7 @@ collected into a single place.
@table @kbd
@orgcmd{C-c a t,org-todo-list}
Show the global TODO list. This collects the TODO items from all agenda
-files (@pxref{Agenda Views}) into a single buffer. By default, this lists
+files (@pxref{Agenda views}) into a single buffer. By default, this lists
items with a state the is not a DONE state. The buffer is in
@code{agenda-mode}, so there are commands to examine and manipulate the TODO
entries directly from that buffer (@pxref{Agenda commands}).
@@ -7994,7 +8362,7 @@ and omit the sublevels from the global list. Configure the variable
@code{org-agenda-todo-list-sublevels} to get this behavior.
@end itemize
-@node Matching tags and properties, Timeline, Global TODO list, Built-in agenda views
+@node Matching tags and properties
@subsection Matching tags and properties
@cindex matching, of tags
@cindex matching, of properties
@@ -8002,7 +8370,7 @@ and omit the sublevels from the global list. Configure the variable
@cindex match view
If headlines in the agenda files are marked with @emph{tags} (@pxref{Tags}),
-or have properties (@pxref{Properties and Columns}), you can select headlines
+or have properties (@pxref{Properties and columns}), you can select headlines
based on this metadata and collect them into an agenda buffer. The match
syntax described here also applies when creating sparse trees with @kbd{C-c /
m}.
@@ -8063,31 +8431,29 @@ braces. For example,
@samp{:work:} and any tag @i{starting} with @samp{boss}.
@cindex group tags, as regular expressions
-Group tags (@pxref{Tag groups}) are expanded as regular expressions. E.g.,
+Group tags (@pxref{Tag hierarchy}) are expanded as regular expressions. E.g.,
if @samp{:work:} is a group tag for the group @samp{:work:lab:conf:}, then
searching for @samp{work} will search for @samp{@{\(?:work\|lab\|conf\)@}}
and searching for @samp{-work} will search for all headlines but those with
-one of the tag in the group (i.e., @samp{-@{\(?:work\|lab\|conf\)@}}).
+one of the tags in the group (i.e., @samp{-@{\(?:work\|lab\|conf\)@}}).
@cindex TODO keyword matching, with tags search
@cindex level, require for tags/property match
@cindex category, require for tags/property match
@vindex org-odd-levels-only
-You may also test for properties (@pxref{Properties and Columns}) at the same
+You may also test for properties (@pxref{Properties and columns}) at the same
time as matching tags. The properties may be real properties, or special
properties that represent other metadata (@pxref{Special properties}). For
example, the ``property'' @code{TODO} represents the TODO keyword of the
entry and the ``property'' @code{PRIORITY} represents the PRIORITY keyword of
-the entry. The ITEM special property cannot currently be used in tags/property
-searches@footnote{But @pxref{x-agenda-skip-entry-regexp,
-,skipping entries based on regexp}.}.
+the entry.
-Except the @pxref{Special properties}, one other ``property'' can also be
-used. @code{LEVEL} represents the level of an entry. So a search
-@samp{+LEVEL=3+boss-TODO="DONE"} lists all level three headlines that have
-the tag @samp{boss} and are @emph{not} marked with the TODO keyword DONE@.
-In buffers with @code{org-odd-levels-only} set, @samp{LEVEL} does not count
-the number of stars, but @samp{LEVEL=2} will correspond to 3 stars etc.
+In addition to the properties mentioned above, @code{LEVEL} represents the
+level of an entry. So a search @samp{+LEVEL=3+boss-TODO="DONE"} lists all
+level three headlines that have the tag @samp{boss} and are @emph{not} marked
+with the TODO keyword DONE@. In buffers with @code{org-odd-levels-only} set,
+@samp{LEVEL} does not count the number of stars, but @samp{LEVEL=2} will
+correspond to 3 stars etc.
Here are more examples:
@@ -8141,11 +8507,6 @@ property that is numerically smaller than 2, a @samp{:With:} property that is
matched by the regular expression @samp{Sarah\|Denny}, and that are scheduled
on or after October 11, 2008.
-Accessing TODO, LEVEL, and CATEGORY during a search is fast. Accessing any
-other properties will slow down the search. However, once you have paid the
-price by accessing one property, testing additional properties is cheap
-again.
-
You can configure Org mode to use property inheritance during a search, but
beware that this can slow down searches considerably. See @ref{Property
inheritance}, for details.
@@ -8174,27 +8535,7 @@ Select @samp{:work:}-tagged TODO lines that are either @samp{WAITING} or
@samp{NEXT}.
@end table
-@node Timeline, Search view, Matching tags and properties, Built-in agenda views
-@subsection Timeline for a single file
-@cindex timeline, single file
-@cindex time-sorted view
-
-The timeline summarizes all time-stamped items from a single Org mode
-file in a @emph{time-sorted view}. The main purpose of this command is
-to give an overview over events in a project.
-
-@table @kbd
-@orgcmd{C-c a L,org-timeline}
-Show a time-sorted view of the Org file, with all time-stamped items.
-When called with a @kbd{C-u} prefix, all unfinished TODO entries
-(scheduled or not) are also listed under the current date.
-@end table
-
-@noindent
-The commands available in the timeline buffer are listed in
-@ref{Agenda commands}.
-
-@node Search view, Stuck projects, Timeline, Built-in agenda views
+@node Search view
@subsection Search view
@cindex search view
@cindex text search
@@ -8224,7 +8565,7 @@ the docstring of the command @code{org-search-view}.
Note that in addition to the agenda files, this command will also search
the files listed in @code{org-agenda-text-search-extra-files}.
-@node Stuck projects, , Search view, Built-in agenda views
+@node Stuck projects
@subsection Stuck projects
@pindex GTD, Getting Things Done
@@ -8272,7 +8613,7 @@ correct customization for this is
Note that if a project is identified as non-stuck, the subtree of this entry
will still be searched for stuck projects.
-@node Presentation and sorting, Agenda commands, Built-in agenda views, Agenda Views
+@node Presentation and sorting
@section Presentation and sorting
@cindex presentation, of agenda items
@@ -8294,21 +8635,14 @@ associated with the item.
* Filtering/limiting agenda items:: Dynamically narrow the agenda
@end menu
-@node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting
+@node Categories
@subsection Categories
@cindex category
@cindex #+CATEGORY
-The category is a broad label assigned to each agenda item. By default,
-the category is simply derived from the file name, but you can also
-specify it with a special line in the buffer, like this@footnote{For
-backward compatibility, the following also works: if there are several
-such lines in a file, each specifies the category for the text below it.
-The first category also applies to any text before the first CATEGORY
-line. However, using this method is @emph{strongly} deprecated as it is
-incompatible with the outline structure of the document. The correct
-method for setting multiple categories in a buffer is using a
-property.}:
+The category is a broad label assigned to each agenda item. By default, the
+category is simply derived from the file name, but you can also specify it
+with a special line in the buffer, like this:
@example
#+CATEGORY: Thesis
@@ -8328,7 +8662,7 @@ longer than 10 characters.
You can set up icons for category by customizing the
@code{org-agenda-category-icon-alist} variable.
-@node Time-of-day specifications, Sorting agenda items, Categories, Presentation and sorting
+@node Time-of-day specifications
@subsection Time-of-day specifications
@cindex time-of-day specification
@@ -8379,7 +8713,7 @@ The time grid can be turned on and off with the variable
@code{org-agenda-use-time-grid}, and can be configured with
@code{org-agenda-time-grid}.
-@node Sorting agenda items, Filtering/limiting agenda items, Time-of-day specifications, Presentation and sorting
+@node Sorting agenda items
@subsection Sorting agenda items
@cindex sorting, of agenda items
@cindex priorities, of agenda items
@@ -8413,14 +8747,14 @@ Sorting can be customized using the variable
@code{org-agenda-sorting-strategy}, and may also include criteria based on
the estimated effort of an entry (@pxref{Effort estimates}).
-@node Filtering/limiting agenda items, , Sorting agenda items, Presentation and sorting
+@node Filtering/limiting agenda items
@subsection Filtering/limiting agenda items
Agenda built-in or customized commands are statically defined. Agenda
filters and limits provide two ways of dynamically narrowing down the list of
-agenda entries: @emph{fitlers} and @emph{limits}. Filters only act on the
+agenda entries: @emph{filters} and @emph{limits}. Filters only act on the
display of the items, while limits take effect before the list of agenda
-entries is built. Filter are more often used interactively, while limits are
+entries is built. Filters are more often used interactively, while limits are
mostly useful when defined as local variables within custom agenda commands.
@subsubheading Filtering in the agenda
@@ -8444,34 +8778,14 @@ 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 will be prompted for a tag selection letter; @key{SPC} will mean any tag at
-all. Pressing @key{TAB} at that prompt will offer use completion to select a
-tag (including any tags that do not have a selection character). The command
-then hides all entries that do not contain or inherit this tag. When called
-with prefix arg, remove the entries that @emph{do} have the tag. A second
-@kbd{/} at the prompt will turn off the filter and unhide any hidden entries.
-If the first key you press is either @kbd{+} or @kbd{-}, the previous filter
-will be narrowed by requiring or forbidding the selected additional tag.
-Instead of pressing @kbd{+} or @kbd{-} after @kbd{/}, you can also
-immediately use the @kbd{\} command.
-
-@vindex org-sort-agenda-noeffort-is-high
-In order to filter for effort estimates, you should set up allowed
-efforts globally, for example
-@lisp
-(setq org-global-properties
- '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00")))
-@end lisp
-You can then filter for an effort by first typing an operator, one of
-@kbd{<}, @kbd{>}, and @kbd{=}, and then the one-digit index of an effort
-estimate in your array of allowed values, where @kbd{0} means the 10th value.
-The filter will then restrict to entries with effort smaller-or-equal, equal,
-or larger-or-equal than the selected value. If the digits 0--9 are not used
-as fast access keys to tags, you can also simply press the index digit
-directly without an operator. In this case, @kbd{<} will be assumed. For
-application of the operator, entries without a defined effort will be treated
-according to the value of @code{org-sort-agenda-noeffort-is-high}. To filter
-for tasks without effort definition, press @kbd{?} as the operator.
+You will be prompted for a tag selection letter; @key{SPC} will mean any tag
+at all. Pressing @key{TAB} at that prompt will offer use completion to
+select a tag (including any tags that do not have a selection character).
+The command then hides all entries that do not contain or inherit this tag.
+When called with prefix arg, remove the entries that @emph{do} have the tag.
+A second @kbd{/} at the prompt will turn off the filter and unhide any hidden
+entries. Pressing @kbd{+} or @kbd{-} switches between filtering and
+excluding the next tag.
Org also supports automatic, context-aware tag filtering. If the variable
@code{org-agenda-auto-exclude-function} is set to a user-defined function,
@@ -8499,12 +8813,6 @@ Internet, and outside of business hours, with something like this:
@end group
@end smalllisp
-@orgcmd{\\,org-agenda-filter-by-tag-refine}
-Narrow the current agenda filter by an additional condition. When called with
-prefix arg, remove the entries that @emph{do} have the tag, or that do match
-the effort criterion. You can achieve the same effect by pressing @kbd{+} or
-@kbd{-} as the first key after the @kbd{/} command.
-
@c
@kindex [
@kindex ]
@@ -8525,9 +8833,12 @@ selected.
@vindex org-agenda-category-filter-preset
Filter the current agenda view with respect to the category of the item at
-point. Pressing @code{<} another time will remove this filter. You can add
-a filter preset through the option @code{org-agenda-category-filter-preset}
-(see below.)
+point. Pressing @code{<} another time will remove this filter. When called
+with a prefix argument exclude the category of the item at point from the
+agenda.
+
+You can add a filter preset in custom agenda commands through the option
+@code{org-agenda-category-filter-preset}. @xref{Setting options}.
@orgcmd{^,org-agenda-filter-by-top-headline}
Filter the current agenda view and only display the siblings and the parent
@@ -8540,8 +8851,34 @@ Filter the agenda view by a regular expression: only show agenda entries
matching the regular expression the user entered. When called with a prefix
argument, it will filter @emph{out} entries matching the regexp. With two
universal prefix arguments, it will remove all the regexp filters, which can
-be accumulated. You can add a filter preset through the option
-@code{org-agenda-category-filter-preset} (see below.)
+be accumulated.
+
+You can add a filter preset in custom agenda commands through the option
+@code{org-agenda-regexp-filter-preset}. @xref{Setting options}.
+
+@orgcmd{_,org-agenda-filter-by-effort}
+@vindex org-agenda-effort-filter-preset
+@vindex org-sort-agenda-noeffort-is-high
+Filter the agenda view with respect to effort estimates.
+You first need to set up allowed efforts globally, for example
+@lisp
+(setq org-global-properties
+ '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00")))
+@end lisp
+You can then filter for an effort by first typing an operator, one of
+@kbd{<}, @kbd{>}, and @kbd{=}, and then the one-digit index of an effort
+estimate in your array of allowed values, where @kbd{0} means the 10th value.
+The filter will then restrict to entries with effort smaller-or-equal, equal,
+or larger-or-equal than the selected value. For application of the operator,
+entries without a defined effort will be treated according to the value of
+@code{org-sort-agenda-noeffort-is-high}.
+
+When called with a prefix argument, it will remove entries matching the
+condition. With two universal prefix arguments, it will clear effort
+filters, which can be accumulated.
+
+You can add a filter preset in custom agenda commands through the option
+@code{org-agenda-effort-filter-preset}. @xref{Setting options}.
@orgcmd{|,org-agenda-filter-remove-all}
Remove all filters in the current agenda view.
@@ -8555,9 +8892,9 @@ Remove all filters in the current agenda view.
@vindex org-agenda-max-tags
Here is a list of options that you can set, either globally, or locally in
-your custom agenda views@pxref{Custom agenda views}.
+your custom agenda views (@pxref{Custom agenda views}).
-@table @var
+@table @code
@item org-agenda-max-entries
Limit the number of entries.
@item org-agenda-max-effort
@@ -8570,7 +8907,7 @@ Limit the number of tagged entries.
When set to a positive integer, each option will exclude entries from other
categories: for example, @code{(setq org-agenda-max-effort 100)} will limit
-the agenda to 100 minutes of effort and exclude any entry that as no effort
+the agenda to 100 minutes of effort and exclude any entry that has no effort
property. If you want to include entries with no effort property, use a
negative value for @code{org-agenda-max-effort}.
@@ -8588,15 +8925,15 @@ Once you mark one of these five entry as @code{DONE}, rebuilding the agenda
will again the next five entries again, including the first entry that was
excluded so far.
-You can also dynamically set temporary limits@footnote{Those temporary limits
-are lost when rebuilding the agenda.}:
+You can also dynamically set temporary limits, which will be lost when
+rebuilding the agenda:
@table @kbd
@orgcmd{~,org-agenda-limit-interactively}
This prompts for the type of limit to apply and its value.
@end table
-@node Agenda commands, Custom agenda views, Presentation and sorting, Agenda Views
+@node Agenda commands
@section Commands in the agenda buffer
@cindex commands, in agenda buffer
@@ -8617,11 +8954,14 @@ the other commands, the cursor needs to be in the desired line.
Next line (same as @key{down} and @kbd{C-n}).
@orgcmd{p,org-agenda-previous-line}
Previous line (same as @key{up} and @kbd{C-p}).
+@orgcmd{N,org-agenda-next-item}
+Next item: same as next line, but only consider items.
+@orgcmd{P,org-agenda-previous-item}
+Previous item: same as previous line, but only consider items.
@tsubheading{View/Go to Org file}
@orgcmdkkc{@key{SPC},mouse-3,org-agenda-show-and-scroll-up}
-Display the original location of the item in another window.
-With prefix arg, make sure that the entire entry is made visible in the
-outline, not only the heading.
+Display the original location of the item in another window. With prefix
+arg, make sure that drawers stay folded.
@c
@orgcmd{L,org-agenda-recenter}
Display original location and recenter that window.
@@ -8715,10 +9055,11 @@ prefix arguments @kbd{C-u C-u}, show only logging information, nothing else.
@c
@orgcmdkskc{v [,[,org-agenda-manipulate-query-add}
Include inactive timestamps into the current view. Only for weekly/daily
-agenda and timeline views.
+agenda.
@c
@orgcmd{v a,org-agenda-archives-mode}
@xorgcmd{v A,org-agenda-archives-mode 'files}
+@cindex Archives mode
Toggle Archives mode. In Archives mode, trees that are marked
@code{ARCHIVED} are also scanned when producing the agenda. When you use the
capital @kbd{A}, even all archive files are included. To exit archives mode,
@@ -8789,35 +9130,25 @@ file or subtree (@pxref{Agenda files}).
@tsubheading{Secondary filtering and query editing}
-For a detailed description of these commands, see @pxref{Filtering/limiting
+For a detailed description of these commands, @pxref{Filtering/limiting
agenda items}.
@orgcmd{/,org-agenda-filter-by-tag}
-@vindex org-agenda-tag-filter-preset
Filter the agenda view with respect to a tag and/or effort estimates.
-@orgcmd{\\,org-agenda-filter-by-tag-refine}
-Narrow the current agenda filter by an additional condition.
-
@orgcmd{<,org-agenda-filter-by-category}
-@vindex org-agenda-category-filter-preset
-
Filter the current agenda view with respect to the category of the item at
-point. Pressing @code{<} another time will remove this filter.
+point.
@orgcmd{^,org-agenda-filter-by-top-headline}
Filter the current agenda view and only display the siblings and the parent
headline of the one at point.
@orgcmd{=,org-agenda-filter-by-regexp}
-@vindex org-agenda-regexp-filter-preset
+Filter the agenda view by a regular expression.
-Filter the agenda view by a regular expression: only show agenda entries
-matching the regular expression the user entered. When called with a prefix
-argument, it will filter @emph{out} entries matching the regexp. With two
-universal prefix arguments, it will remove all the regexp filters, which can
-be accumulated. You can add a filter preset through the option
-@code{org-agenda-category-filter-preset} (see below.)
+@orgcmd{_,org-agenda-filter-by-effort}
+Filter the agenda view with respect to effort estimates.
@orgcmd{|,org-agenda-filter-remove-all}
Remove all filters in the current agenda view.
@@ -8996,8 +9327,8 @@ Bulk action: act on all marked entries in the agenda. This will prompt for
another key to select the action to be applied. The prefix arg to @kbd{B}
will be passed through to the @kbd{s} and @kbd{d} commands, to bulk-remove
these special timestamps. By default, marks are removed after the bulk. If
-you want them to persist, set @code{org-agenda-bulk-persistent-marks} to
-@code{t} or hit @kbd{p} at the prompt.
+you want them to persist, set @code{org-agenda-persistent-marks} to @code{t}
+or hit @kbd{p} at the prompt.
@table @kbd
@item *
@@ -9124,7 +9455,7 @@ visit Org files will not be removed.
@end table
-@node Custom agenda views, Exporting Agenda Views, Agenda commands, Agenda Views
+@node Custom agenda views
@section Custom agenda views
@cindex custom agenda views
@cindex agenda views, custom
@@ -9137,10 +9468,10 @@ dispatcher (@pxref{Agenda dispatcher}), just like the default commands.
@menu
* Storing searches:: Type once, use often
* Block agenda:: All the stuff you need in a single buffer
-* Setting Options:: Changing the rules
+* Setting options:: Changing the rules
@end menu
-@node Storing searches, Block agenda, Custom agenda views, Custom agenda views
+@node Storing searches
@subsection Storing searches
The first application of custom searches is the definition of keyboard
@@ -9162,7 +9493,7 @@ buffer).
Custom commands are configured in the variable
@code{org-agenda-custom-commands}. You can customize this variable, for
example by pressing @kbd{C-c a C}. You can also directly set it with Emacs
-Lisp in @file{.emacs}. The following example contains all valid agenda
+Lisp in the Emacs init file. The following example contains all valid agenda
views:
@lisp
@@ -9232,7 +9563,7 @@ Peter, or Kim) as additional tag to match.
Note that the @code{*-tree} agenda views need to be called from an
Org buffer as they operate on the current buffer only.
-@node Block agenda, Setting Options, Storing searches, Custom agenda views
+@node Block agenda
@subsection Block agenda
@cindex block agenda
@cindex agenda, with block views
@@ -9266,7 +9597,7 @@ your agenda for the current week, all TODO items that carry the tag
@samp{home}, and also all lines tagged with @samp{garden}. Finally the
command @kbd{C-c a o} provides a similar view for office tasks.
-@node Setting Options, , Block agenda, Custom agenda views
+@node Setting options
@subsection Setting options for custom commands
@cindex options, for custom agenda views
@@ -9285,8 +9616,7 @@ right spot in @code{org-agenda-custom-commands}. For example:
((org-agenda-sorting-strategy '(priority-down))
(org-agenda-prefix-format " Mixed: ")))
("U" tags-tree "+boss-urgent"
- ((org-show-following-heading nil)
- (org-show-hierarchy-above nil)))
+ ((org-show-context-detail 'minimal)))
("N" search ""
((org-agenda-files '("~org/notes.org"))
(org-agenda-text-search-extra-files nil)))))
@@ -9340,7 +9670,7 @@ yourself.
@vindex org-agenda-custom-commands-contexts
To control whether an agenda command should be accessible from a specific
context, you can customize @code{org-agenda-custom-commands-contexts}. Let's
-say for example that you have an agenda commands @code{"o"} displaying a view
+say for example that you have an agenda command @code{"o"} displaying a view
that you only need when reading emails. Then you would configure this option
like this:
@@ -9359,14 +9689,15 @@ command key @code{"r"}. In that case, add this command key like this:
See the docstring of the variable for more information.
-@node Exporting Agenda Views, Agenda column view, Custom agenda views, Agenda Views
-@section Exporting Agenda Views
+@node Exporting agenda views
+@section Exporting agenda views
@cindex agenda views, exporting
If you are away from your computer, it can be very useful to have a printed
version of some agenda views to carry around. Org mode can export custom
-agenda views as plain text, HTML@footnote{You need to install Hrvoje Niksic's
-@file{htmlize.el}.}, Postscript, PDF@footnote{To create PDF output, the
+agenda views as plain text, HTML@footnote{You need to install
+@file{htmlize.el} from @uref{https://github.com/hniksic/emacs-htmlize,Hrvoje
+Niksic's repository.}}, Postscript, PDF@footnote{To create PDF output, the
ghostscript @file{ps2pdf} utility must be installed on the system. Selecting
a PDF file will also create the postscript file.}, and iCalendar files. If
you want to do this only occasionally, use the command
@@ -9428,13 +9759,13 @@ or absolute.
@end lisp
The extension of the file name determines the type of export. If it is
-@file{.html}, Org mode will use the @file{htmlize.el} package to convert
-the buffer to HTML and save it to this file name. If the extension is
-@file{.ps}, @code{ps-print-buffer-with-faces} is used to produce
-Postscript output. If the extension is @file{.ics}, iCalendar export is
-run export over all files that were used to construct the agenda, and
-limit the export to entries listed in the agenda. Any other
-extension produces a plain ASCII file.
+@file{.html}, Org mode will try to use the @file{htmlize.el} package to
+convert the buffer to HTML and save it to this file name. If the extension
+is @file{.ps}, @code{ps-print-buffer-with-faces} is used to produce
+Postscript output. If the extension is @file{.ics}, iCalendar export is run
+export over all files that were used to construct the agenda, and limit the
+export to entries listed in the agenda. Any other extension produces a plain
+ASCII file.
The export files are @emph{not} created when you use one of those
commands interactively because this might use too much overhead.
@@ -9498,7 +9829,7 @@ processing by other programs. See @ref{Extracting agenda information}, for
more information.
-@node Agenda column view, , Exporting Agenda Views, Agenda Views
+@node Agenda column view
@section Using column view in the agenda
@cindex column view, in agenda
@cindex agenda, column view
@@ -9524,11 +9855,12 @@ This causes the following issues:
Org needs to make a decision which @code{COLUMNS} format to use. Since the
entries in the agenda are collected from different files, and different files
may have different @code{COLUMNS} formats, this is a non-trivial problem.
-Org first checks if the variable @code{org-agenda-overriding-columns-format} is
-currently set, and if so, takes the format from there. Otherwise it takes
+Org first checks if the variable @code{org-agenda-overriding-columns-format}
+is currently set, and if so, takes the format from there. Otherwise it takes
the format associated with the first item in the agenda, or, if that item
-does not have a specific format (defined in a property, or in its file), it
+does not have a specific format---defined in a property, or in its file---it
uses @code{org-columns-default-format}.
+
@item
@cindex property, special, CLOCKSUM
If any of the columns has a summary type defined (@pxref{Column attributes}),
@@ -9537,11 +9869,12 @@ make sure that the computations of this property are up to date. This is
also true for the special @code{CLOCKSUM} property. Org will then sum the
values displayed in the agenda. In the daily/weekly agenda, the sums will
cover a single day; in all other views they cover the entire block. It is
-vital to realize that the agenda may show the same entry @emph{twice} (for
-example as scheduled and as a deadline), and it may show two entries from the
-same hierarchy (for example a @emph{parent} and its @emph{child}). In these
+vital to realize that the agenda may show the same entry @emph{twice}---for
+example as scheduled and as a deadline---and it may show two entries from the
+same hierarchy---for example a @emph{parent} and its @emph{child}. In these
cases, the summation in the agenda will lead to incorrect results because
some values will count double.
+
@item
When the column view in the agenda shows the @code{CLOCKSUM}, that is always
the entire clocked time for this item. So even in the daily/weekly agenda,
@@ -9555,149 +9888,46 @@ the agenda).
@item
@cindex property, special, CLOCKSUM_T
When the column view in the agenda shows the @code{CLOCKSUM_T}, that is
-always today's clocked time for this item. So even in the weekly agenda,
-the clocksum listed in column view only originates from today. This lets
-you compare the time you spent on a task for today, with the time already
-spent (via @code{CLOCKSUM}) and with the planned total effort for it.
+always today's clocked time for this item. So even in the weekly agenda, the
+clocksum listed in column view only originates from today. This lets you
+compare the time you spent on a task for today, with the time already
+spent ---via @code{CLOCKSUM}---and with the planned total effort for it.
@end enumerate
-@node Markup, Exporting, Agenda Views, Top
+@node Markup
@chapter Markup for rich export
When exporting Org mode documents, the exporter tries to reflect the
structure of the document as accurately as possible in the back-end. Since
-export targets like HTML, @LaTeX{} allow much richer formatting, Org mode has
+export targets like HTML and @LaTeX{} allow much richer formatting, Org mode has
rules on how to prepare text for rich export. This section summarizes the
markup rules used in an Org mode buffer.
@menu
-* Structural markup elements:: The basic structure as seen by the exporter
+* Paragraphs:: The basic unit of text
+* Emphasis and monospace:: Bold, italic, etc.
+* Horizontal rules:: Make a line
* Images and tables:: Images, tables and caption mechanism
* Literal examples:: Source code examples with special formatting
-* Include files:: Include additional files into a document
-* Index entries:: Making an index
-* Macro replacement:: Use macros to create templates
+* Special symbols:: Greek letters and other symbols
+* Subscripts and superscripts:: Simple syntax for raising/lowering text
* Embedded @LaTeX{}:: LaTeX can be freely used inside Org documents
-* Special blocks:: Containers targeted at export back-ends
-@end menu
-
-@node Structural markup elements, Images and tables, Markup, Markup
-@section Structural markup elements
-
-@menu
-* Document title:: Where the title is taken from
-* Headings and sections:: The document structure as seen by the exporter
-* Table of contents:: The if and where of the table of contents
-* Lists:: Lists
-* Paragraphs:: Paragraphs
-* Footnote markup:: Footnotes
-* Emphasis and monospace:: Bold, italic, etc.
-* Horizontal rules:: Make a line
-* Comment lines:: What will *not* be exported
@end menu
-@node Document title, Headings and sections, Structural markup elements, Structural markup elements
-@subheading Document title
-@cindex document title, markup rules
-
-@noindent
-The title of the exported document is taken from the special line
-
-@cindex #+TITLE
-@example
-#+TITLE: This is the title of the document
-@end example
-
-@noindent
-If this line does not exist, the title will be the name of the file
-associated to buffer, without extension, or the buffer name.
-
-@cindex property, EXPORT_TITLE
-If you are exporting only a subtree, its heading will become the title of the
-document. If the subtree has a property @code{EXPORT_TITLE}, that will take
-precedence.
-
-@node Headings and sections, Table of contents, Document title, Structural markup elements
-@subheading Headings and sections
-@cindex headings and sections, markup rules
-
-@vindex org-export-headline-levels
-The outline structure of the document as described in @ref{Document
-Structure}, forms the basis for defining sections of the exported document.
-However, since the outline structure is also used for (for example) lists of
-tasks, only the first three outline levels will be used as headings. Deeper
-levels will become itemized lists. You can change the location of this
-switch globally by setting the variable @code{org-export-headline-levels}, or on a
-per-file basis with a line
-
-@cindex #+OPTIONS
-@example
-#+OPTIONS: H:4
-@end example
-
-@node Table of contents, Lists, Headings and sections, Structural markup elements
-@subheading Table of contents
-@cindex table of contents, markup rules
-
-@cindex #+TOC
-@vindex org-export-with-toc
-The table of contents is normally inserted directly before the first headline
-of the file. The depth of the table is by default the same as the number of
-headline levels, but you can choose a smaller number, or turn off the table
-of contents entirely, by configuring the variable @code{org-export-with-toc},
-or on a per-file basis with a line like
-
-@example
-#+OPTIONS: toc:2 (only to two levels in TOC)
-#+OPTIONS: toc:nil (no default TOC at all)
-@end example
-
-If you would like to move the table of contents to a different location, you
-should turn off the default table using @code{org-export-with-toc} or
-@code{#+OPTIONS} and insert @code{#+TOC: headlines N} at the desired
-location(s).
-
-@example
-#+OPTIONS: toc:nil (no default TOC)
-...
-#+TOC: headlines 2 (insert TOC here, with two headline levels)
-@end example
-
-Multiple @code{#+TOC: headline} lines are allowed. The same @code{TOC}
-keyword can also generate a list of all tables (resp.@: all listings) with a
-caption in the buffer.
-
-@example
-#+TOC: listings (build a list of listings)
-#+TOC: tables (build a list of tables)
-@end example
-
-@cindex property, ALT_TITLE
-The headline's title usually determines its corresponding entry in a table of
-contents. However, it is possible to specify an alternative title by
-setting @code{ALT_TITLE} property accordingly. It will then be used when
-building the table.
-
-@node Lists, Paragraphs, Table of contents, Structural markup elements
-@subheading Lists
-@cindex lists, markup rules
-
-Plain lists as described in @ref{Plain lists}, are translated to the back-end's
-syntax for such lists. Most back-ends support unordered, ordered, and
-description lists.
-
-@node Paragraphs, Footnote markup, Lists, Structural markup elements
-@subheading Paragraphs, line breaks, and quoting
+@node Paragraphs
+@section Paragraphs, line breaks, and quoting
@cindex paragraphs, markup rules
Paragraphs are separated by at least one empty line. If you need to enforce
a line break within a paragraph, use @samp{\\} at the end of a line.
-To keep the line breaks in a region, but otherwise use normal formatting, you
-can use this construct, which can also be used to format poetry.
+To preserve the line breaks, indentation and blank lines in a region, but
+otherwise use normal formatting, you can use this construct, which can also
+be used to format poetry.
@cindex #+BEGIN_VERSE
+@cindex verse blocks
@example
#+BEGIN_VERSE
Great clouds overhead
@@ -9713,6 +9943,7 @@ as a paragraph that is indented on both the left and the right margin. You
can include quotations in Org mode documents like this:
@cindex #+BEGIN_QUOTE
+@cindex quote blocks
@example
#+BEGIN_QUOTE
Everything should be made as simple as possible,
@@ -9722,6 +9953,7 @@ but not any simpler -- Albert Einstein
If you would like to center some text, do it like this:
@cindex #+BEGIN_CENTER
+@cindex center blocks
@example
#+BEGIN_CENTER
Everything should be made as simple as possible, \\
@@ -9729,18 +9961,8 @@ but not any simpler
#+END_CENTER
@end example
-
-@node Footnote markup, Emphasis and monospace, Paragraphs, Structural markup elements
-@subheading Footnote markup
-@cindex footnotes, markup rules
-@cindex @file{footnote.el}
-
-Footnotes defined in the way described in @ref{Footnotes}, will be exported
-by all back-ends. Org allows multiple references to the same note, and
-multiple footnotes side by side.
-
-@node Emphasis and monospace, Horizontal rules, Footnote markup, Structural markup elements
-@subheading Emphasis and monospace
+@node Emphasis and monospace
+@section Emphasis and monospace
@cindex underlined text, markup rules
@cindex bold text, markup rules
@@ -9764,32 +9986,13 @@ can tweak @code{org-emphasis-regexp-components}. Beware that changing one of
the above variables will no take effect until you reload Org, for which you
may need to restart Emacs.
-@node Horizontal rules, Comment lines, Emphasis and monospace, Structural markup elements
-@subheading Horizontal rules
+@node Horizontal rules
+@section Horizontal rules
@cindex horizontal rules, markup rules
A line consisting of only dashes, and at least 5 of them, will be exported as
a horizontal line.
-@node Comment lines, , Horizontal rules, Structural markup elements
-@subheading Comment lines
-@cindex comment lines
-@cindex exporting, not
-@cindex #+BEGIN_COMMENT
-
-Lines starting with zero or more whitespace characters followed by one
-@samp{#} and a whitespace are treated as comments and will never be exported.
-Also entire subtrees starting with the word @samp{COMMENT} will never be
-exported. Finally, regions surrounded by @samp{#+BEGIN_COMMENT}
-... @samp{#+END_COMMENT} will not be exported.
-
-@table @kbd
-@kindex C-c ;
-@item C-c ;
-Toggle the COMMENT keyword at the beginning of an entry.
-@end table
-
-
-@node Images and tables, Literal examples, Structural markup elements, Markup
+@node Images and tables
@section Images and Tables
@cindex tables, markup rules
@@ -9837,7 +10040,7 @@ the same caption mechanism can apply to many others (e.g., @LaTeX{}
equations, source code blocks). Depending on the export back-end, those may
or may not be handled.
-@node Literal examples, Include files, Images and tables, Markup
+@node Literal examples
@section Literal examples
@cindex literal examples, markup rules
@cindex code line references, markup rules
@@ -9865,20 +10068,25 @@ Here is an example
@end example
@cindex formatting source code, markup rules
+@vindex org-latex-listings
If the example is source code from a programming language, or any other text
that can be marked up by font-lock in Emacs, you can ask for the example to
look like the fontified Emacs buffer@footnote{This works automatically for
the HTML back-end (it requires version 1.34 of the @file{htmlize.el} package,
-which is distributed with Org). Fontified code chunks in @LaTeX{} can be
-achieved using either the listings or the
-@url{http://code.google.com/p/minted, minted,} package. Refer to
-@code{org-latex-listings} documentation for details.}. This is done
-with the @samp{src} block, where you also need to specify the name of the
-major mode that should be used to fontify the example@footnote{Code in
-@samp{src} blocks may also be evaluated either interactively or on export.
-See @pxref{Working With Source Code} for more information on evaluating code
-blocks.}, see @ref{Easy Templates} for shortcuts to easily insert code
-blocks.
+which you need to install). Fontified code chunks in @LaTeX{} can be
+achieved using either the
+@url{https://www.ctan.org/tex-archive/macros/latex/contrib/listings/?lang=en, listings,}
+or the
+@url{https://github.com/gpoore/minted, minted,} package.
+If you use minted or listing, you must load the packages manually, for
+example by adding the desired package to
+@code{org-latex-packages-alist}. Refer to @code{org-latex-listings}
+for details.}. This is done with the @samp{src} block, where you also need
+to specify the name of the major mode that should be used to fontify the
+example@footnote{Code in @samp{src} blocks may also be evaluated either
+interactively or on export. @xref{Working with source code}, for more
+information on evaluating code blocks.}, see @ref{Easy templates} for
+shortcuts to easily insert code blocks.
@cindex #+BEGIN_SRC
@example
@@ -9891,13 +10099,29 @@ blocks.
Both in @code{example} and in @code{src} snippets, you can add a @code{-n}
switch to the end of the @code{BEGIN} line, to get the lines of the example
-numbered. If you use a @code{+n} switch, the numbering from the previous
-numbered snippet will be continued in the current one. In literal examples,
-Org will interpret strings like @samp{(ref:name)} as labels, and use them as
-targets for special hyperlinks like @code{[[(name)]]} (i.e., the reference name
-enclosed in single parenthesis). In HTML, hovering the mouse over such a
-link will remote-highlight the corresponding code line, which is kind of
-cool.
+numbered. The @code{-n} takes an optional numeric argument specifying the
+starting line number of the block. If you use a @code{+n} switch, the
+numbering from the previous numbered snippet will be continued in the current
+one. The @code{+n} can also take a numeric argument. The value of the
+argument will be added to the last line of the previous block to determine
+the starting line number.
+
+@example
+#+BEGIN_SRC emacs-lisp -n 20
+ ;; this will export with line number 20
+ (message "This is line 21")
+#+END_SRC
+#+BEGIN_SRC emacs-lisp +n 10
+ ;; This will be listed as line 31
+ (message "This is line 32")
+#+END_SRC
+@end example
+
+In literal examples, Org will interpret strings like @samp{(ref:name)} as
+labels, and use them as targets for special hyperlinks like @code{[[(name)]]}
+(i.e., the reference name enclosed in single parenthesis). In HTML, hovering
+the mouse over such a link will remote-highlight the corresponding code line,
+which is kind of cool.
You can also add a @code{-r} switch which @i{removes} the labels from the
source code@footnote{Adding @code{-k} to @code{-n -r} will @i{keep} the
@@ -9916,6 +10140,10 @@ In line [[(sc)]] we remember the current position. [[(jump)][Line (jump)]]
jumps to point-min.
@end example
+@cindex indentation, in source blocks
+Finally, you can use @code{-i} to preserve the indentation of a specific code
+block (@pxref{Editing source code}).
+
@vindex org-coderef-label-format
If the syntax for the label format conflicts with the language syntax, use a
@code{-l} switch to change the format, for example @samp{#+BEGIN_SRC pascal
@@ -9925,8 +10153,8 @@ HTML export also allows examples to be published as text areas (@pxref{Text
areas in HTML export}).
Because the @code{#+BEGIN_...} and @code{#+END_...} patterns need to be added
-so often, shortcuts are provided using the Easy Templates facility
-(@pxref{Easy Templates}).
+so often, shortcuts are provided using the Easy templates facility
+(@pxref{Easy templates}).
@table @kbd
@kindex C-c '
@@ -9952,157 +10180,44 @@ formatting like @samp{(ref:label)} at the end of the current line. Then the
label is stored as a link @samp{(label)}, for retrieval with @kbd{C-c C-l}.
@end table
-
-@node Include files, Index entries, Literal examples, Markup
-@section Include files
-@cindex include files, markup rules
-
-During export, you can include the content of another file. For example, to
-include your @file{.emacs} file, you could use:
-@cindex #+INCLUDE
-
-@example
-#+INCLUDE: "~/.emacs" src emacs-lisp
-@end example
-
-@noindent
-The optional second and third parameter are the markup (i.e., @samp{example}
-or @samp{src}), and, if the markup is @samp{src}, the language for formatting
-the contents. The markup is optional; if it is not given, the text will be
-assumed to be in Org mode format and will be processed normally.
-
-Contents of the included file will belong to the same structure (headline,
-item) containing the @code{INCLUDE} keyword. In particular, headlines within
-the file will become children of the current section. That behavior can be
-changed by providing an additional keyword parameter, @code{:minlevel}. In
-that case, all headlines in the included file will be shifted so the one with
-the lowest level reaches that specified level. For example, to make a file
-become a sibling of the current top-level headline, use
-
-@example
-#+INCLUDE: "~/my-book/chapter2.org" :minlevel 1
-@end example
-
-You can also include a portion of a file by specifying a lines range using
-the @code{:lines} parameter. The line at the upper end of the range will not
-be included. The start and/or the end of the range may be omitted to use the
-obvious defaults.
-
-@example
-#+INCLUDE: "~/.emacs" :lines "5-10" @r{Include lines 5 to 10, 10 excluded}
-#+INCLUDE: "~/.emacs" :lines "-10" @r{Include lines 1 to 10, 10 excluded}
-#+INCLUDE: "~/.emacs" :lines "10-" @r{Include lines from 10 to EOF}
-@end example
-
-@table @kbd
-@kindex C-c '
-@item C-c '
-Visit the include file at point.
-@end table
-
-@node Index entries, Macro replacement, Include files, Markup
-@section Index entries
-@cindex index entries, for publishing
-
-You can specify entries that will be used for generating an index during
-publishing. This is done by lines starting with @code{#+INDEX}. An entry
-the contains an exclamation mark will create a sub item. See @ref{Generating
-an index} for more information.
-
-@example
-* Curriculum Vitae
-#+INDEX: CV
-#+INDEX: Application!CV
-@end example
-
-
-
-
-@node Macro replacement, Embedded @LaTeX{}, Index entries, Markup
-@section Macro replacement
-@cindex macro replacement, during export
-@cindex #+MACRO
-
-You can define text snippets with
-
-@example
-#+MACRO: name replacement text $1, $2 are arguments
-@end example
-
-@noindent which can be referenced in
-paragraphs, verse blocks, table cells and some keywords with
-@code{@{@{@{name(arg1,arg2)@}@}@}}@footnote{Since commas separate arguments,
-commas within arguments have to be escaped with a backslash character.
-Conversely, backslash characters before a comma, and only them, need to be
-escaped with another backslash character.}. In addition to defined macros,
-@code{@{@{@{title@}@}@}}, @code{@{@{@{author@}@}@}}, etc., will reference
-information set by the @code{#+TITLE:}, @code{#+AUTHOR:}, and similar lines.
-Also, @code{@{@{@{time(@var{FORMAT})@}@}@}} and
-@code{@{@{@{modification-time(@var{FORMAT})@}@}@}} refer to current date time
-and to the modification time of the file being exported, respectively.
-@var{FORMAT} should be a format string understood by
-@code{format-time-string}.
-
-Macro expansion takes place during export.
-
-
-@node Embedded @LaTeX{}, Special blocks, Macro replacement, Markup
-@section Embedded @LaTeX{}
-@cindex @TeX{} interpretation
-@cindex @LaTeX{} interpretation
-
-Plain ASCII is normally sufficient for almost all note taking. Exceptions
-include scientific notes, which often require mathematical symbols and the
-occasional formula. @LaTeX{}@footnote{@LaTeX{} is a macro system based on
-Donald E. Knuth's @TeX{} system. Many of the features described here as
-``@LaTeX{}'' are really from @TeX{}, but for simplicity I am blurring this
-distinction.} is widely used to typeset scientific documents. Org mode
-supports embedding @LaTeX{} code into its files, because many academics are
-used to writing and reading @LaTeX{} source code, and because it can be
-readily processed to produce pretty output for a number of export back-ends.
-
-@menu
-* Special symbols:: Greek letters and other symbols
-* Subscripts and superscripts:: Simple syntax for raising/lowering text
-* @LaTeX{} fragments:: Complex formulas made easy
-* Previewing @LaTeX{} fragments:: What will this snippet look like?
-* CDLaTeX mode:: Speed up entering of formulas
-@end menu
-
-@node Special symbols, Subscripts and superscripts, Embedded @LaTeX{}, Embedded @LaTeX{}
-@subsection Special symbols
+@node Special symbols
+@section Special symbols
+@cindex Org entities
@cindex math symbols
@cindex special symbols
-@cindex @TeX{} macros
-@cindex @LaTeX{} fragments, markup rules
@cindex HTML entities
@cindex @LaTeX{} entities
-You can use @LaTeX{}-like syntax to insert special symbols like @samp{\alpha}
-to indicate the Greek letter, or @samp{\to} to indicate an arrow. Completion
-for these symbols is available, just type @samp{\} and maybe a few letters,
-and press @kbd{M-@key{TAB}} to see possible completions. Unlike @LaTeX{}
-code, Org mode allows these symbols to be present without surrounding math
-delimiters, for example:
+You can use @LaTeX{}-like syntax to insert special symbols---named
+entities---like @samp{\alpha} to indicate the Greek letter, or @samp{\to} to
+indicate an arrow. Completion for these symbols is available, just type
+@samp{\} and maybe a few letters, and press @kbd{M-@key{TAB}} to see possible
+completions. If you need such a symbol inside a word, terminate it with
+a pair of curly brackets. For example
@example
-Angles are written as Greek letters \alpha, \beta and \gamma.
+Pro tip: Given a circle \Gamma of diameter d, the length of its circumference
+is \pi@{@}d.
@end example
-@vindex org-entities
-During export, these symbols will be transformed into the native format of
-the exporter back-end. Strings like @code{\alpha} will be exported as
-@code{&alpha;} in the HTML output, and as @code{$\alpha$} in the @LaTeX{}
-output. Similarly, @code{\nbsp} will become @code{&nbsp;} in HTML and
-@code{~} in @LaTeX{}. If you need such a symbol inside a word, terminate it
-like this: @samp{\Aacute@{@}stor}.
-
+@findex org-entities-help
+@vindex org-entities-user
A large number of entities is provided, with names taken from both HTML and
-@LaTeX{}; see the variable @code{org-entities} for the complete list.
-@samp{\-} is treated as a shy hyphen, and @samp{--}, @samp{---}, and
-@samp{...} are all converted into special commands creating hyphens of
-different lengths or a compact set of dots.
+@LaTeX{}; you can comfortably browse the complete list from a dedicated
+buffer using the command @code{org-entities-help}. It is also possible to
+provide your own special symbols in the variable @code{org-entities-user}.
+During export, these symbols are transformed into the native format of the
+exporter back-end. Strings like @code{\alpha} are exported as @code{&alpha;}
+in the HTML output, and as @code{\(\alpha\)} in the @LaTeX{} output.
+Similarly, @code{\nbsp} becomes @code{&nbsp;} in HTML and @code{~} in
+@LaTeX{}.
+
+@cindex escaping characters
+Entities may also be used as a may to escape markup in an Org document, e.g.,
+@samp{\under@{@}not underlined\under} exports as @samp{_not underlined_}.
+
+@cindex special symbols, in-buffer display
If you would like to see entities displayed as UTF-8 characters, use the
following command@footnote{You can turn this on by default by setting the
variable @code{org-pretty-entities}, or on a per-file base with the
@@ -10117,20 +10232,28 @@ buffer content which remains plain ASCII, but it overlays the UTF-8 character
for display purposes only.
@end table
-@node Subscripts and superscripts, @LaTeX{} fragments, Special symbols, Embedded @LaTeX{}
-@subsection Subscripts and superscripts
+@cindex shy hyphen, special symbol
+@cindex dash, special symbol
+@cindex ellipsis, special symbol
+In addition to regular entities defined above, Org exports in a special
+way@footnote{This behaviour can be disabled with @code{-} export setting
+(@pxref{Export settings}).} the following commonly used character
+combinations: @samp{\-} is treated as a shy hyphen, @samp{--} and @samp{---}
+are converted into dashes, and @samp{...} becomes a compact set of dots.
+
+@node Subscripts and superscripts
+@section Subscripts and superscripts
@cindex subscript
@cindex superscript
-Just like in @LaTeX{}, @samp{^} and @samp{_} are used to indicate super- and
-subscripts. Again, these can be used without embedding them in math-mode
-delimiters. To increase the readability of ASCII text, it is not necessary
-(but OK) to surround multi-character sub- and superscripts with curly braces.
-For example
+@samp{^} and @samp{_} are used to indicate super- and subscripts. To
+increase the readability of ASCII text, it is not necessary---but OK---to
+surround multi-character sub- and superscripts with curly braces. Those are,
+however, mandatory, when more than one word is involved. For example
@example
-The mass of the sun is M_sun = 1.989 x 10^30 kg. The radius of
-the sun is R_@{sun@} = 6.96 x 10^8 m.
+The radius of the sun is R_sun = 6.96 x 10^8 m. On the other hand, the
+radius of Alpha Centauri is R_@{Alpha Centauri@} = 1.28 x R_@{sun@}.
@end example
@vindex org-use-sub-superscripts
@@ -10147,46 +10270,58 @@ In addition to showing entities as UTF-8 characters, this command will also
format sub- and superscripts in a WYSIWYM way.
@end table
-@node @LaTeX{} fragments, Previewing @LaTeX{} fragments, Subscripts and superscripts, Embedded @LaTeX{}
+@node Embedded @LaTeX{}
+@section Embedded @LaTeX{}
+@cindex @TeX{} interpretation
+@cindex @LaTeX{} interpretation
+
+Plain ASCII is normally sufficient for almost all note taking. Exceptions
+include scientific notes, which often require mathematical symbols and the
+occasional formula. @LaTeX{}@footnote{@LaTeX{} is a macro system based on
+Donald E. Knuth's @TeX{} system. Many of the features described here as
+``@LaTeX{}'' are really from @TeX{}, but for simplicity I am blurring this
+distinction.} is widely used to typeset scientific documents. Org mode
+supports embedding @LaTeX{} code into its files, because many academics are
+used to writing and reading @LaTeX{} source code, and because it can be
+readily processed to produce pretty output for a number of export back-ends.
+
+@menu
+* @LaTeX{} fragments:: Complex formulas made easy
+* Previewing @LaTeX{} fragments:: What will this snippet look like?
+* CDLaTeX mode:: Speed up entering of formulas
+@end menu
+
+@node @LaTeX{} fragments
@subsection @LaTeX{} fragments
@cindex @LaTeX{} fragments
@vindex org-format-latex-header
-Going beyond symbols and sub- and superscripts, a full formula language is
-needed. Org mode can contain @LaTeX{} math fragments, and it supports ways
-to process these for several export back-ends. When exporting to @LaTeX{},
-the code is obviously left as it is. When exporting to HTML, Org invokes the
-@uref{http://www.mathjax.org, MathJax library} (@pxref{Math formatting in
-HTML export}) to process and display the math@footnote{If you plan to use
-this regularly or on pages with significant page views, you should install
-@file{MathJax} on your own server in order to limit the load of our server.}.
-Finally, it can also process the mathematical expressions into
-images@footnote{For this to work you need to be on a system with a working
-@LaTeX{} installation. You also need the @file{dvipng} program or the
-@file{convert}, respectively available at
-@url{http://sourceforge.net/projects/dvipng/} and from the @file{imagemagick}
-suite. The @LaTeX{} header that will be used when processing a fragment can
-be configured with the variable @code{org-format-latex-header}.} that can be
-displayed in a browser.
+Org mode can contain @LaTeX{} math fragments, and it supports ways to process
+these for several export back-ends. When exporting to @LaTeX{}, the code is
+left as it is. When exporting to HTML, Org can use either
+@uref{http://www.mathjax.org, MathJax} (@pxref{Math formatting in HTML
+export}) or transcode the math into images (see @pxref{Previewing @LaTeX{}
+fragments}).
@LaTeX{} fragments don't need any special marking at all. The following
snippets will be identified as @LaTeX{} source code:
@itemize @bullet
@item
-Environments of any kind@footnote{When @file{MathJax} is used, only the
-environments recognized by @file{MathJax} will be processed. When
-@file{dvipng} program or @file{imagemagick} suite is used to create images,
-any @LaTeX{} environment will be handled.}. The only requirement is that the
-@code{\begin} and @code{\end} statements appear on a new line, at the
+Environments of any kind@footnote{When MathJax is used, only the
+environments recognized by MathJax will be processed. When
+@file{dvipng} program, @file{dvisvgm} program or @file{imagemagick} suite is
+used to create images, any @LaTeX{} environment will be handled.}. The only
+requirement is that the @code{\begin} statement appears on a new line, at the
beginning of the line or after whitespaces only.
@item
Text within the usual @LaTeX{} math delimiters. To avoid conflicts with
currency specifications, single @samp{$} characters are only recognized as
math delimiters if the enclosed text contains at most two line breaks, is
directly attached to the @samp{$} characters with no whitespace in between,
-and if the closing @samp{$} is followed by whitespace, punctuation or a dash.
-For the other delimiters, there is no such restriction, so when in doubt, use
-@samp{\(...\)} as inline math delimiters.
+and if the closing @samp{$} is followed by whitespace or punctuation
+(parentheses and quotes are considered to be punctuation in this
+context). For the other delimiters, there is no such restriction, so when in
+doubt, use @samp{\(...\)} as inline math delimiters.
@end itemize
@noindent For example:
@@ -10210,7 +10345,7 @@ either $$ a=+\sqrt@{2@} $$ or \[ a=-\sqrt@{2@} \].
@vindex org-export-with-latex
@LaTeX{} processing can be configured with the variable
@code{org-export-with-latex}. The default setting is @code{t} which means
-@file{MathJax} for HTML, and no processing for ASCII and @LaTeX{} back-ends.
+MathJax for HTML, and no processing for ASCII and @LaTeX{} back-ends.
You can also set this variable on a per-file basis using one of these
lines:
@@ -10220,16 +10355,26 @@ lines:
#+OPTIONS: tex:verbatim @r{Verbatim export, for jsMath or so}
@end example
-@node Previewing @LaTeX{} fragments, CDLaTeX mode, @LaTeX{} fragments, Embedded @LaTeX{}
+@node Previewing @LaTeX{} fragments
@subsection Previewing @LaTeX{} fragments
@cindex @LaTeX{} fragments, preview
-@vindex org-latex-create-formula-image-program
-If you have @file{dvipng} or @file{imagemagick} installed@footnote{Choose the
-converter by setting the variable
-@code{org-latex-create-formula-image-program} accordingly.}, @LaTeX{}
-fragments can be processed to produce preview images of the typeset
-expressions:
+@vindex org-preview-latex-default-process
+If you have a working @LaTeX{} installation and @file{dvipng}, @file{dvisvgm}
+or @file{convert} installed@footnote{These are respectively available at
+@url{http://sourceforge.net/projects/dvipng/}, @url{http://dvisvgm.bplaced.net/}
+and from the @file{imagemagick} suite. Choose the converter by setting the
+variable @code{org-preview-latex-default-process} accordingly.}, @LaTeX{}
+fragments can be processed to produce images of the typeset expressions to be
+used for inclusion while exporting to HTML (see @pxref{@LaTeX{} fragments}),
+or for inline previewing within Org mode.
+
+@vindex org-format-latex-options
+@vindex org-format-latex-header
+You can customize the variables @code{org-format-latex-options} and
+@code{org-format-latex-header} to influence some aspects of the preview. In
+particular, the @code{:scale} (and for HTML export, @code{:html-scale})
+property of the former can be used to adjust the size of the preview images.
@table @kbd
@kindex C-c C-x C-l
@@ -10245,12 +10390,6 @@ process the entire buffer.
Remove the overlay preview images.
@end table
-@vindex org-format-latex-options
-You can customize the variable @code{org-format-latex-options} to influence
-some aspects of the preview. In particular, the @code{:scale} (and for HTML
-export, @code{:html-scale}) property can be used to adjust the size of the
-preview images.
-
@vindex org-startup-with-latex-preview
You can turn on the previewing of all @LaTeX{} fragments in a file with
@@ -10264,7 +10403,7 @@ To disable it, simply use
#+STARTUP: nolatexpreview
@end example
-@node CDLaTeX mode, , Previewing @LaTeX{} fragments, Embedded @LaTeX{}
+@node CDLaTeX mode
@subsection Using CD@LaTeX{} to enter math
@cindex CD@LaTeX{}
@@ -10273,7 +10412,7 @@ major @LaTeX{} mode like AUC@TeX{} in order to speed-up insertion of
environments and math templates. Inside Org mode, you can make use of
some of the features of CD@LaTeX{} mode. You need to install
@file{cdlatex.el} and @file{texmathp.el} (the latter comes also with
-AUC@TeX{}) from @url{http://www.astro.uva.nl/~dominik/Tools/cdlatex}.
+AUC@TeX{}) from @url{https://staff.fnwi.uva.nl/c.dominik/Tools/cdlatex}.
Don't use CD@LaTeX{} mode itself under Org mode, but use the light
version @code{org-cdlatex-mode} that comes as part of Org mode. Turn it
on for the current buffer with @kbd{M-x org-cdlatex-mode RET}, or for all
@@ -10325,252 +10464,239 @@ modification will work only inside @LaTeX{} fragments; outside the quote
is normal.
@end itemize
-@node Special blocks, , Embedded @LaTeX{}, Markup
-@section Special blocks
-@cindex Special blocks
+@node Exporting
+@chapter Exporting
+@cindex exporting
-Org syntax includes pre-defined blocks (@pxref{Paragraphs} and @ref{Literal
-examples}). It is also possible to create blocks containing raw code
-targeted at a specific back-ends (e.g., @samp{#+BEGIN_LATEX}).
+Sometimes, you may want to pretty print your notes, publish them on the web
+or even share them with people not using Org. In these cases, the Org export
+facilities can be used to convert your documents to a variety of other
+formats, while retaining as much structure (@pxref{Document structure}) and
+markup (@pxref{Markup}) as possible.
-Any other block is a @emph{special block}.
+@cindex export back-end
+Libraries responsible for such translation are called back-ends. Org ships
+with the following ones
-For example, @samp{#+BEGIN_ABSTRACT} and @samp{#+BEGIN_VIDEO} are special
-blocks. The first one is useful when exporting to @LaTeX{}, the second one
-when exporting to HTML5.
+@itemize
+@item ascii (ASCII format)
+@item beamer (@LaTeX{} Beamer format)
+@item html (HTML format)
+@item icalendar (iCalendar format)
+@item latex (@LaTeX{} format)
+@item md (Markdown format)
+@item odt (OpenDocument Text format)
+@item org (Org format)
+@item texinfo (Texinfo format)
+@item man (Man page format)
+@end itemize
-Each export back-end decides if they should be exported, and how. When the
-block is ignored, its contents are still exported, as if the opening and
-closing block lines were not there. For example, when exporting a
-@samp{#+BEGIN_TEST} block, HTML back-end wraps its contents within a
-@samp{<div name="test">} tag.
+@noindent Org also uses additional libraries located in @code{contrib/}
+directory (@pxref{Installation}). Users can install additional export
+libraries for additional formats from the Emacs packaging system. For easy
+discovery, these packages have a common naming scheme: @file{ox-NAME}, where
+NAME is one of the formats. For example, @file{ox-koma-letter} for
+@code{koma-letter} back-end.
-Refer to back-end specific documentation for more information.
+@vindex org-export-backends
+Org loads back-ends for the following formats by default: @code{ascii},
+@code{html}, @code{icalendar}, @code{latex} and @code{odt}.
-@node Exporting, Publishing, Markup, Top
-@chapter Exporting
-@cindex exporting
+Org can load additional back-ends either of two ways: through the
+@code{org-export-backends} variable configuration; or, by requiring the
+library in the Emacs init file like this:
-The Org mode export facilities can be used to export Org documents or parts
-of Org documents to a variety of other formats. In addition, these
-facilities can be used with @code{orgtbl-mode} and/or @code{orgstruct-mode}
-in foreign buffers so you can author tables and lists in Org syntax and
-convert them in place to the target language.
-
-ASCII export produces a readable and simple version of an Org file for
-printing and sharing notes. HTML export allows you to easily publish notes
-on the web, or to build full-fledged websites. @LaTeX{} export lets you use
-Org mode and its structured editing functions to create arbitrarily complex
-@LaTeX{} files for any kind of document. OpenDocument Text (ODT) export
-allows seamless collaboration across organizational boundaries. Markdown
-export lets you seamlessly collaborate with other developers. Finally, iCal
-export can extract entries with deadlines or appointments to produce a file
-in the iCalendar format.
+@lisp
+(require 'ox-md)
+@end lisp
@menu
-* The Export Dispatcher:: The main exporter interface
-* Export back-ends:: Built-in export formats
-* Export settings:: Generic export settings
+* The export dispatcher:: The main interface
+* Export settings:: Common export settings
+* Table of contents:: The if and where of the table of contents
+* Include files:: Include additional files into a document
+* Macro replacement:: Use macros to create templates
+* Comment lines:: What will not be exported
* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding
* Beamer export:: Exporting as a Beamer presentation
* HTML export:: Exporting to HTML
-* @LaTeX{} and PDF export:: Exporting to @LaTeX{}, and processing to PDF
+* @LaTeX{} export:: Exporting to @LaTeX{}, and processing to PDF
* Markdown export:: Exporting to Markdown
* OpenDocument Text export:: Exporting to OpenDocument Text
* Org export:: Exporting to Org
* Texinfo export:: Exporting to Texinfo
* iCalendar export:: Exporting to iCalendar
* Other built-in back-ends:: Exporting to a man page
-* Export in foreign buffers:: Author tables and lists in Org syntax
* Advanced configuration:: Fine-tuning the export output
+* Export in foreign buffers:: Author tables and lists in Org syntax
@end menu
-@node The Export Dispatcher, Export back-ends, Exporting, Exporting
-@section The Export Dispatcher
+@node The export dispatcher
+@section The export dispatcher
@vindex org-export-dispatch-use-expert-ui
@cindex Export, dispatcher
-The main entry point for export related tasks is the dispatcher, a
-hierarchical menu from which it is possible to select an export format and
-toggle export options@footnote{It is also possible to use a less intrusive
-interface by setting @code{org-export-dispatch-use-expert-ui} to a
-non-@code{nil} value. In that case, only a prompt is visible from the
-minibuffer. From there one can still switch back to regular menu by pressing
-@key{?}.} from which it is possible to select an export format and to toggle
-export options.
+The export dispatcher is the main interface for Org's exports. A
+hierarchical menu presents the currently configured export formats. Options
+are shown as easy toggle switches on the same screen.
+
+Org also has a minimal prompt interface for the export dispatcher. When the
+variable @code{org-export-dispatch-use-expert-ui} is set to a non-@code{nil}
+value, Org prompts in the minibuffer. To switch back to the hierarchical
+menu, press @key{?}.
-@c @quotation
@table @asis
@orgcmd{C-c C-e,org-export-dispatch}
-Dispatch for export and publishing commands. When called with a @kbd{C-u}
-prefix argument, repeat the last export command on the current buffer while
-preserving toggled options. If the current buffer hasn't changed and subtree
-export was activated, the command will affect that same subtree.
+Invokes the export dispatcher interface. The options show default settings.
+The @kbd{C-u} prefix argument preserves options from the previous export,
+including any sub-tree selections.
+
@end table
-@c @end quotation
-Normally the entire buffer is exported, but if there is an active region
-only that part of the buffer will be exported.
+Org exports the entire buffer by default. If the Org buffer has an active
+region, then Org exports just that region.
-Several export options (@pxref{Export settings}) can be toggled from the
-export dispatcher with the following key combinations:
+These are the export options, the key combinations that toggle them
+(@pxref{Export settings}):
@table @kbd
@item C-a
@vindex org-export-async-init-file
-Toggle asynchronous export. Asynchronous export uses an external Emacs
-process that is configured with a specified initialization file.
+Toggles asynchronous export. Asynchronous export uses an external Emacs
+process with a specially configured initialization file to complete the
+exporting process in the background thereby releasing the current interface.
+This is particularly useful when exporting long documents.
-While exporting asynchronously, the output is not displayed, but stored in
-a place called ``the export stack''. This stack can be displayed by calling
-the dispatcher with a double @kbd{C-u} prefix argument, or with @kbd{&} key
-from the dispatcher menu.
+Output from an asynchronous export is saved on the ``the export stack''. To
+view this stack, call the export dispatcher with a double @kbd{C-u} prefix
+argument. If already in the export dispatcher menu, @kbd{&} displays the
+stack.
@vindex org-export-in-background
-To make this behavior the default, customize the variable
+To make the background export process the default, customize the variable,
@code{org-export-in-background}.
@item C-b
-Toggle body-only export. Its effect depends on the back-end used.
-Typically, if the back-end has a header section (like @code{<head>...</head>}
-in the HTML back-end), a body-only export will not include this header.
+Toggle body-only export. Useful for excluding headers and footers in the
+export. Affects only those back-end formats that have such sections---like
+@code{<head>...</head>} in HTML.
@item C-s
@vindex org-export-initial-scope
-Toggle subtree export. The top heading becomes the document title.
+Toggle sub-tree export. When turned on, Org exports only the sub-tree starting
+from the cursor position at the time the export dispatcher was invoked. Org
+uses the top heading of this sub-tree as the document's title. If the cursor
+is not on a heading, Org uses the nearest enclosing header. If the cursor is
+in the document preamble, Org signals an error and aborts export.
-You can change the default state of this option by setting
+To make the sub-tree export the default, customize the variable,
@code{org-export-initial-scope}.
@item C-v
-Toggle visible-only export. Only export the text that is currently
-visible, i.e., not hidden by outline visibility in the buffer.
-
+Toggle visible-only export. Useful for exporting only visible parts of an
+Org document by adjusting outline visibility settings.
@end table
-@vindex org-export-copy-to-kill-ring
-With the exception of asynchronous export, a successful export process writes
-its output to the kill-ring. You can configure this behavior by altering the
-option @code{org-export-copy-to-kill-ring}.
-
-@node Export back-ends, Export settings, The Export Dispatcher, Exporting
-@section Export back-ends
-@cindex Export, back-ends
-
-An export back-end is a library that translates Org syntax into a foreign
-format. An export format is not available until the proper back-end has been
-loaded.
-
-@vindex org-export-backends
-By default, the following four back-ends are loaded: @code{ascii},
-@code{html}, @code{icalendar} and @code{latex}. It is possible to add more
-(or remove some) by customizing @code{org-export-backends}.
-
-Built-in back-ends include:
-
-@itemize
-@item ascii (ASCII format)
-@item beamer (@LaTeX{} Beamer format)
-@item html (HTML format)
-@item icalendar (iCalendar format)
-@item latex (@LaTeX{} format)
-@item man (Man page format)
-@item md (Markdown format)
-@item odt (OpenDocument Text format)
-@item org (Org format)
-@item texinfo (Texinfo format)
-@end itemize
-
-Other back-ends might be found in the @code{contrib/} directory
-(@pxref{Installation}).
-
-@node Export settings, ASCII/Latin-1/UTF-8 export, Export back-ends, Exporting
+@node Export settings
@section Export settings
@cindex Export, settings
+@cindex #+OPTIONS
Export options can be set: globally with variables; for an individual file by
making variables buffer-local with in-buffer settings (@pxref{In-buffer
settings}), by setting individual keywords, or by specifying them in a
compact form with the @code{#+OPTIONS} keyword; or for a tree by setting
-properties (@pxref{Properties and Columns}). Options set at a specific level
+properties (@pxref{Properties and columns}). Options set at a specific level
override options set at a more general level.
@cindex #+SETUPFILE
In-buffer settings may appear anywhere in the file, either directly or
-indirectly through a file included using @samp{#+SETUPFILE: filename} syntax.
-Option keyword sets tailored to a particular back-end can be inserted from
-the export dispatcher (@pxref{The Export Dispatcher}) using the @code{Insert
-template} command by pressing @key{#}. To insert keywords individually,
-a good way to make sure the keyword is correct is to type @code{#+} and then
-to use @kbd{M-<TAB>} for completion.
+indirectly through a file included using @samp{#+SETUPFILE: filename or URL}
+syntax. Option keyword sets tailored to a particular back-end can be
+inserted from the export dispatcher (@pxref{The export dispatcher}) using the
+@code{Insert template} command by pressing @key{#}. To insert keywords
+individually, a good way to make sure the keyword is correct is to type
+@code{#+} and then to use @kbd{M-@key{TAB}}@footnote{Many desktops intercept
+@kbd{M-TAB} to switch windows. Use @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}}
+instead.} for completion.
The export keywords available for every back-end, and their equivalent global
variables, include:
@table @samp
@item AUTHOR
+@cindex #+AUTHOR
@vindex user-full-name
The document author (@code{user-full-name}).
@item CREATOR
+@cindex #+CREATOR
@vindex org-export-creator-string
Entity responsible for output generation (@code{org-export-creator-string}).
@item DATE
+@cindex #+DATE
@vindex org-export-date-timestamp-format
A date or a time-stamp@footnote{The variable
@code{org-export-date-timestamp-format} defines how this time-stamp will be
exported.}.
-@item DESCRIPTION
-The document description. Back-ends handle it as they see fit (e.g., for the
-XHTML meta tag), if at all. You can use several such keywords for long
-descriptions.
-
@item EMAIL
+@cindex #+EMAIL
@vindex user-mail-address
The email address (@code{user-mail-address}).
-@item KEYWORDS
-The keywords defining the contents of the document. Back-ends handle it as
-they see fit (e.g., for the XHTML meta tag), if at all. You can use several
-such keywords if the list is long.
-
@item LANGUAGE
+@cindex #+LANGUAGE
@vindex org-export-default-language
-The language used for translating some strings
-(@code{org-export-default-language}). E.g., @samp{#+LANGUAGE: fr} will tell
-Org to translate @emph{File} (english) into @emph{Fichier} (french) in the
-clocktable.
+Language to use for translating certain strings
+(@code{org-export-default-language}). With @samp{#+LANGUAGE: fr}, for
+example, Org translates @emph{Table of contents} to the French @emph{Table
+des matières}.
@item SELECT_TAGS
+@cindex #+SELECT_TAGS
@vindex org-export-select-tags
-The tags that select a tree for export (@code{org-export-select-tags}). The
-default value is @code{:export:}. Within a subtree tagged with
-@code{:export:}, you can still exclude entries with @code{:noexport:} (see
-below). When headlines are selectively exported with @code{:export:}
-anywhere in a file, text before the first headline is ignored.
+The default value is @code{:export:}. When a tree is tagged with
+@code{:export:} (@code{org-export-select-tags}), Org selects that tree and
+its sub-trees for export. Org excludes trees with @code{:noexport:} tags,
+see below. When selectively exporting files with @code{:export:} tags set,
+Org does not export any text that appears before the first headline.
@item EXCLUDE_TAGS
-The tags that exclude a tree from export (@code{org-export-exclude-tags}).
-The default value is @code{:noexport:}. Entries with the @code{:noexport:}
-tag will be unconditionally excluded from the export, even if they have an
-@code{:export:} tag.
+@cindex #+EXCLUDE_TAGS
+@vindex org-export-exclude-tags
+The default value is @code{:noexport:}. When a tree is tagged with
+@code{:noexport:} (@code{org-export-exclude-tags}), Org excludes that tree
+and its sub-trees from export. Entries tagged with @code{:noexport:} will be
+unconditionally excluded from the export, even if they have an
+@code{:export:} tag. Even if a sub-tree is not exported, Org will execute any
+code blocks contained in them.
@item TITLE
-The title to be shown (otherwise derived from buffer's name). You can use
-several such keywords for long titles.
+@cindex #+TITLE
+@cindex document title
+Org displays this title. For long titles, use multiple @code{#+TITLE} lines.
+
+@item EXPORT_FILE_NAME
+@cindex #+EXPORT_FILE_NAME
+The name of the output file to be generated. Otherwise, Org generates the
+file name based on the buffer name and the extension based on the back-end
+format.
@end table
-The @code{#+OPTIONS} keyword is a compact@footnote{If you want to configure
-many options this way, you can use several @code{#+OPTIONS} lines.} form that
-recognizes the following arguments:
+The @code{#+OPTIONS} keyword is a compact form. To configure multiple
+options, use several @code{#+OPTIONS} lines. @code{#+OPTIONS} recognizes the
+following arguments.
@table @code
@item ':
@vindex org-export-with-smart-quotes
-Toggle smart quotes (@code{org-export-with-smart-quotes}).
+Toggle smart quotes (@code{org-export-with-smart-quotes}). Depending on the
+language used, when activated, Org treats pairs of double quotes as primary
+quotes, pairs of single quotes as secondary quotes, and single quote marks as
+apostrophes.
@item *:
Toggle emphasized text (@code{org-export-with-emphasize}).
@@ -10587,12 +10713,12 @@ Toggle fixed-width sections
@item <:
@vindex org-export-with-timestamps
-Toggle inclusion of any time/date active/inactive stamps
+Toggle inclusion of time/date active/inactive stamps
(@code{org-export-with-timestamps}).
-@item :
+@item \n:
@vindex org-export-preserve-breaks
-Toggle line-break-preservation (@code{org-export-preserve-breaks}).
+Toggles whether to preserve line breaks (@code{org-export-preserve-breaks}).
@item ^:
@vindex org-export-with-sub-superscripts
@@ -10602,8 +10728,8 @@ it is (@code{org-export-with-sub-superscripts}).
@item arch:
@vindex org-export-with-archived-trees
-Configure export of archived trees. Can be set to @code{headline} to only
-process the headline, skipping its contents
+Configure how archived trees are exported. When set to @code{headline}, the
+export process skips the contents and processes only the headlines
(@code{org-export-with-archived-trees}).
@item author:
@@ -10611,19 +10737,29 @@ process the headline, skipping its contents
Toggle inclusion of author name into exported file
(@code{org-export-with-author}).
+@item broken-links:
+@vindex org-export-with-broken-links
+Toggles if Org should continue exporting upon finding a broken internal link.
+When set to @code{mark}, Org clearly marks the problem link in the output
+(@code{org-export-with-broken-links}).
+
@item c:
@vindex org-export-with-clocks
Toggle inclusion of CLOCK keywords (@code{org-export-with-clocks}).
@item creator:
@vindex org-export-with-creator
-Configure inclusion of creator info into exported file. It may be set to
-@code{comment} (@code{org-export-with-creator}).
+Toggle inclusion of creator information in the exported file
+(@code{org-export-with-creator}).
@item d:
@vindex org-export-with-drawers
-Toggle inclusion of drawers, or list drawers to include
-(@code{org-export-with-drawers}).
+Toggles inclusion of drawers, or list of drawers to include, or list of
+drawers to exclude (@code{org-export-with-drawers}).
+
+@item date:
+@vindex org-export-with-date
+Toggle inclusion of a date into exported file (@code{org-export-with-date}).
@item e:
@vindex org-export-with-entities
@@ -10650,20 +10786,29 @@ Toggle inclusion of inlinetasks (@code{org-export-with-inlinetasks}).
@item num:
@vindex org-export-with-section-numbers
-Toggle section-numbers (@code{org-export-with-section-numbers}). It can also
-be set to a number @samp{n}, so only headlines at that level or above will be
-numbered.
+@cindex property, UNNUMBERED
+Toggle section-numbers (@code{org-export-with-section-numbers}). When set to
+number @samp{n}, Org numbers only those headlines at level @samp{n} or above.
+Setting @code{UNNUMBERED} property to non-@code{nil} disables numbering of
+a heading. Since subheadings inherit from this property, it affects their
+numbering, too.
@item p:
@vindex org-export-with-planning
Toggle export of planning information (@code{org-export-with-planning}).
-``Planning information'' is the line containing the @code{SCHEDULED:}, the
-@code{DEADLINE:} or the @code{CLOSED:} cookies or a combination of them.
+``Planning information'' comes from lines located right after the headline
+and contain any combination of these cookies: @code{SCHEDULED:},
+@code{DEADLINE:}, or @code{CLOSED:}.
@item pri:
@vindex org-export-with-priority
Toggle inclusion of priority cookies (@code{org-export-with-priority}).
+@item prop:
+@vindex org-export-with-properties
+Toggle inclusion of property drawers, or list the properties to include
+(@code{org-export-with-properties}).
+
@item stat:
@vindex org-export-with-statistics-cookies
Toggle inclusion of statistics cookies
@@ -10676,20 +10821,24 @@ Toggle inclusion of tags, may also be @code{not-in-toc}
@item tasks:
@vindex org-export-with-tasks
-Toggle inclusion of tasks (TODO items), can be @code{nil} to remove all
-tasks, @code{todo} to remove DONE tasks, or a list of keywords to keep
+Toggle inclusion of tasks (TODO items); or @code{nil} to remove all tasks; or
+@code{todo} to remove DONE tasks; or list the keywords to keep
(@code{org-export-with-tasks}).
@item tex:
@vindex org-export-with-latex
-Configure export of @LaTeX{} fragments and environments. It may be set to
-@code{verbatim} (@code{org-export-with-latex}).
+@code{nil} does not export; @code{t} exports; @code{verbatim} keeps
+everything in verbatim (@code{org-export-with-latex}).
@item timestamp:
@vindex org-export-time-stamp-file
-Toggle inclusion of the creation time into exported file
+Toggle inclusion of the creation time in the exported file
(@code{org-export-time-stamp-file}).
+@item title:
+@vindex org-export-with-title
+Toggle inclusion of title (@code{org-export-with-title}).
+
@item toc:
@vindex org-export-with-toc
Toggle inclusion of the table of contents, or set the level limit
@@ -10703,255 +10852,599 @@ Toggle inclusion of TODO keywords into exported text
@item |:
@vindex org-export-with-tables
Toggle inclusion of tables (@code{org-export-with-tables}).
+
@end table
-When exporting only a subtree, each of the previous keywords@footnote{With
-the exception of @samp{SETUPFILE}.} can be overridden locally by special node
-properties. These begin with @samp{EXPORT_}, followed by the name of the
-keyword they supplant. For example, @samp{DATE} and @samp{OPTIONS} keywords
-become, respectively, @samp{EXPORT_DATE} and @samp{EXPORT_OPTIONS}
-properties.
+When exporting sub-trees, special node properties in them can override the
+above keywords. They are special because they have an @samp{EXPORT_} prefix.
+For example, @samp{DATE} and @samp{EXPORT_FILE_NAME} keywords become,
+respectively, @samp{EXPORT_DATE} and @samp{EXPORT_FILE_NAME}. Except for
+@samp{SETUPFILE}, all other keywords listed above have an @samp{EXPORT_}
+equivalent.
@cindex #+BIND
@vindex org-export-allow-bind-keywords
If @code{org-export-allow-bind-keywords} is non-@code{nil}, Emacs variables
can become buffer-local during export by using the BIND keyword. Its syntax
is @samp{#+BIND: variable value}. This is particularly useful for in-buffer
-settings that cannot be changed using specific keywords.
+settings that cannot be changed using keywords.
-@cindex property, EXPORT_FILE_NAME
-The name of the output file to be generated is taken from the file associated
-to the buffer, when possible, or asked to you otherwise. For subtree export,
-you can also set @samp{EXPORT_FILE_NAME} property. In all cases, only the
-base name of the file is retained, and a back-end specific extension is
-added.
+@node Table of contents
+@section Table of contents
+@cindex table of contents
+@cindex list of tables
+@cindex list of listings
+
+@cindex #+TOC
+@vindex org-export-with-toc
+Org normally inserts the table of contents directly before the first headline
+of the file. Org sets the TOC depth the same as the headline levels in the
+file. Use a lower number for lower TOC depth. To turn off TOC entirely, use
+@code{nil}. This is configured in the @code{org-export-with-toc} variable or
+as keywords in an Org file as:
+
+@example
+#+OPTIONS: toc:2 @r{only include two levels in TOC}
+#+OPTIONS: toc:nil @r{no default TOC at all}
+@end example
+
+To move the table of contents to a different location, first turn off the
+default with @code{org-export-with-toc} variable or with @code{#+OPTIONS:
+toc:nil}. Then insert @code{#+TOC: headlines N} at the desired location(s).
+
+@example
+#+OPTIONS: toc:nil @r{no default TOC}
+...
+#+TOC: headlines 2 @r{insert TOC here, with two headline levels}
+@end example
+
+To adjust the TOC depth for a specific section of the Org document, append an
+additional @samp{local} parameter. This parameter becomes a relative depth
+for the current level.
+
+Note that for this feature to work properly in @LaTeX{} export, the Org file
+requires the inclusion of the @code{titletoc} package. Because of
+compatibility issues, @code{titletoc} has to be loaded @emph{before}
+@code{hyperref}. Customize the @code{org-latex-default-packages-alist}
+variable.
+
+@example
+* Section #+TOC: headlines 1 local @r{insert local TOC, with direct children
+only}
+@end example
+
+Use the @code{TOC} keyword to generate list of tables (resp.@: all listings)
+with captions.
+
+@example
+#+TOC: listings @r{build a list of listings}
+#+TOC: tables @r{build a list of tables}
+@end example
+
+@cindex property, ALT_TITLE
+Normally Org uses the headline for its entry in the table of contents. But
+with @code{ALT_TITLE} property, a different entry can be specified for the
+table of contents.
+
+@node Include files
+@section Include files
+@cindex include files, during export
+Include other files during export. For example, to include your @file{.emacs}
+file, you could use:
+@cindex #+INCLUDE
+
+@example
+#+INCLUDE: "~/.emacs" src emacs-lisp
+@end example
+
+@noindent
+The first parameter is the file name to include. The optional second
+parameter specifies the block type: @samp{example}, @samp{export} or
+@samp{src}. The optional third parameter specifies the source code language
+to use for formatting the contents. This is relevant to both @samp{export}
+and @samp{src} block types.
+
+If an include file is specified as having a markup language, Org neither
+checks for valid syntax nor changes the contents in any way. For
+@samp{example} and @samp{src} blocks, Org code-escapes the contents before
+inclusion.
+
+If an include file is not specified as having any markup language, Org
+assumes it be in Org format and proceeds as usual with a few exceptions. Org
+makes the footnote labels (@pxref{Footnotes}) in the included file local to
+that file. The contents of the included file will belong to the same
+structure---headline, item---containing the @code{INCLUDE} keyword. In
+particular, headlines within the file will become children of the current
+section. That behavior can be changed by providing an additional keyword
+parameter, @code{:minlevel}. It shifts the headlines in the included file to
+become the lowest level. For example, this syntax makes the included file
+a sibling of the current top-level headline:
+
+@example
+#+INCLUDE: "~/my-book/chapter2.org" :minlevel 1
+@end example
+
+Inclusion of only portions of files are specified using ranges parameter with
+@code{:lines} keyword. The line at the upper end of the range will not be
+included. The start and/or the end of the range may be omitted to use the
+obvious defaults.
+
+@example
+#+INCLUDE: "~/.emacs" :lines "5-10" @r{Include lines 5 to 10, 10 excluded}
+#+INCLUDE: "~/.emacs" :lines "-10" @r{Include lines 1 to 10, 10 excluded}
+#+INCLUDE: "~/.emacs" :lines "10-" @r{Include lines from 10 to EOF}
+@end example
+
+Inclusions may specify a file-link to extract an object matched by
+@code{org-link-search}@footnote{Note that
+@code{org-link-search-must-match-exact-headline} is locally bound to
+non-@code{nil}. Therefore, @code{org-link-search} only matches headlines and
+named elements.} (@pxref{Search options}).
+
+To extract only the contents of the matched object, set @code{:only-contents}
+property to non-@code{nil}. This will omit any planning lines or property
+drawers. The ranges for @code{:lines} keyword are relative to the requested
+element. Some examples:
+
+@example
+#+INCLUDE: "./paper.org::#theory" :only-contents t
+ @r{Include the body of the heading with the custom id @samp{theory}}
+#+INCLUDE: "./paper.org::mytable" @r{Include named element.}
+#+INCLUDE: "./paper.org::*conclusion" :lines 1-20
+ @r{Include the first 20 lines of the headline named @samp{conclusion}.}
+@end example
+
+@table @kbd
+@kindex C-c '
+@item C-c '
+Visit the include file at point.
+@end table
+
+@node Macro replacement
+@section Macro replacement
+@cindex macro replacement, during export
+@cindex #+MACRO
+
+@vindex org-export-global-macros
+Macros replace text snippets during export. Macros are defined globally in
+@code{org-export-global-macros}, or document-wise with the following syntax:
+
+@example
+#+MACRO: name replacement text $1, $2 are arguments
+@end example
+
+@noindent which can be referenced using
+@code{@{@{@{name(arg1, arg2)@}@}@}}@footnote{Since commas separate the
+arguments, commas within arguments have to be escaped with the backslash
+character. So only those backslash characters before a comma need escaping
+with another backslash character.}.
+
+Org recognizes macro references in following Org markup areas: paragraphs,
+headlines, verse blocks, tables cells and lists. Org also recognizes macro
+references in keywords, such as @code{#+CAPTION}, @code{#+TITLE},
+@code{#+AUTHOR}, @code{#+DATE}, and for some back-end specific export
+options.
+
+Org comes with following pre-defined macros:
-@node ASCII/Latin-1/UTF-8 export, Beamer export, Export settings, Exporting
+@table @code
+@item @{@{@{title@}@}@}
+@itemx @{@{@{author@}@}@}
+@itemx @{@{@{email@}@}@}
+@cindex title, macro
+@cindex author, macro
+@cindex email, macro
+Org replaces these macro references with available information at the time of
+export.
+
+@item @{@{@{date@}@}@}
+@itemx @{@{@{date(@var{FORMAT})@}@}@}
+@cindex date, macro
+This macro refers to the @code{#+DATE} keyword. @var{FORMAT} is an optional
+argument to the @code{@{@{@{date@}@}@}} macro that will be used only if
+@code{#+DATE} is a single timestamp. @var{FORMAT} should be a format string
+understood by @code{format-time-string}.
+
+@item @{@{@{time(@var{FORMAT})@}@}@}
+@itemx @{@{@{modification-time(@var{FORMAT}, @var{VC})@}@}@}
+@cindex time, macro
+@cindex modification time, macro
+These macros refer to the document's date and time of export and date and
+time of modification. @var{FORMAT} is a string understood by
+@code{format-time-string}. If the second argument to the
+@code{modification-time} macro is non-@code{nil}, Org uses @file{vc.el} to
+retrieve the document's modification time from the version control
+system. Otherwise Org reads the file attributes.
+
+@item @{@{@{input-file@}@}@}
+@cindex input file, macro
+This macro refers to the filename of the exported file.
+
+@item @{@{@{property(@var{PROPERTY-NAME})@}@}@}
+@itemx @{@{@{property(@var{PROPERTY-NAME},@var{SEARCH-OPTION})@}@}@}
+@cindex property, macro
+This macro returns the value of property @var{PROPERTY-NAME} in the current
+entry. If @var{SEARCH-OPTION} (@pxref{Search options}) refers to a remote
+entry, that will be used instead.
+
+@item @{@{@{n@}@}@}
+@itemx @{@{@{n(@var{NAME})@}@}@}
+@itemx @{@{@{n(@var{NAME},@var{ACTION})@}@}@}
+@cindex n, macro
+@cindex counter, macro
+This macro implements custom counters by returning the number of times the
+macro has been expanded so far while exporting the buffer. You can create
+more than one counter using different @var{NAME} values. If @var{ACTION} is
+@code{-}, previous value of the counter is held, i.e. the specified counter
+is not incremented. If the value is a number, the specified counter is set
+to that value. If it is any other non-empty string, the specified counter is
+reset to 1. You may leave @var{NAME} empty to reset the default counter.
+@end table
+
+The surrounding brackets can be made invisible by setting
+@code{org-hide-macro-markers} non-@code{nil}.
+
+Org expands macros at the very beginning of the export process.
+
+@node Comment lines
+@section Comment lines
+@cindex exporting, not
+
+@cindex comment lines
+Lines starting with zero or more whitespace characters followed by one
+@samp{#} and a whitespace are treated as comments and, as such, are not
+exported.
+
+@cindex #+BEGIN_COMMENT
+Likewise, regions surrounded by @samp{#+BEGIN_COMMENT}
+... @samp{#+END_COMMENT} are not exported.
+
+@cindex comment trees
+Finally, a @samp{COMMENT} keyword at the beginning of an entry, but after any
+other keyword or priority cookie, comments out the entire subtree. In this
+case, the subtree is not exported and no code block within it is executed
+either@footnote{For a less drastic behavior, consider using a select tag
+(@pxref{Export settings}) instead.}. The command below helps changing the
+comment status of a headline.
+
+@table @kbd
+@kindex C-c ;
+@item C-c ;
+Toggle the @samp{COMMENT} keyword at the beginning of an entry.
+@end table
+
+@node ASCII/Latin-1/UTF-8 export
@section ASCII/Latin-1/UTF-8 export
@cindex ASCII export
@cindex Latin-1 export
@cindex UTF-8 export
-ASCII export produces a simple and very readable version of an Org mode
-file, containing only plain ASCII@. Latin-1 and UTF-8 export augment the file
-with special characters and symbols available in these encodings.
+ASCII export produces an output file containing only plain ASCII characters.
+This is the most simplest and direct text output. It does not contain any
+Org markup either. Latin-1 and UTF-8 export use additional characters and
+symbols available in these encoding standards. All three of these export
+formats offer the most basic of text output for maximum portability.
+
+@vindex org-ascii-text-width
+On export, Org fills and justifies text according to the text width set in
+@code{org-ascii-text-width}.
@vindex org-ascii-links-to-notes
-Links are exported in a footnote-like style, with the descriptive part in the
-text and the link in a note before the next heading. See the variable
-@code{org-ascii-links-to-notes} for details and other options.
+Org exports links using a footnote-like style where the descriptive part is
+in the text and the link is in a note before the next heading. See the
+variable @code{org-ascii-links-to-notes} for details.
@subheading ASCII export commands
@table @kbd
@orgcmd{C-c C-e t a/l/u,org-ascii-export-to-ascii}
-Export as an ASCII file. For an Org file, @file{myfile.org}, the ASCII file
-will be @file{myfile.txt}. The file will be overwritten without warning.
-When the original file is @file{myfile.txt}, the resulting file becomes
-@file{myfile.txt.txt} in order to prevent data loss.
+Export as an ASCII file with a @file{.txt} extension. For @file{myfile.org},
+Org exports to @file{myfile.txt}, overwriting without warning. For
+@file{myfile.txt}, Org exports to @file{myfile.txt.txt} in order to prevent
+data loss.
@orgcmd{C-c C-e t A/L/U,org-ascii-export-as-ascii}
-Export to a temporary buffer. Do not create a file.
+Export to a temporary buffer. Does not create a file.
+@end table
+
+@subheading ASCII specific export settings
+The ASCII export back-end has one extra keyword for customizing ASCII output.
+Setting this keyword works similar to the general options (@pxref{Export
+settings}).
+
+@table @samp
+@item SUBTITLE
+@cindex #+SUBTITLE (ASCII)
+The document subtitle. For long subtitles, use multiple @code{#+SUBTITLE}
+lines in the Org file. Org prints them on one continuous line, wrapping into
+multiple lines if necessary.
@end table
@subheading Header and sectioning structure
-In the exported version, the first three outline levels become headlines,
-defining a general document structure. Additional levels are exported as
-lists. The transition can also occur at a different level (@pxref{Export
-settings}).
+Org converts the first three outline levels into headlines for ASCII export.
+The remaining levels are turned into lists. To change this cut-off point
+where levels become lists, @pxref{Export settings}.
@subheading Quoting ASCII text
-You can insert text that will only appear when using @code{ASCII} back-end
-with the following constructs:
+To insert text within the Org file by the ASCII back-end, use one the
+following constructs, inline, keyword, or export block:
@cindex #+ASCII
-@cindex #+BEGIN_ASCII
+@cindex #+BEGIN_EXPORT ascii
@example
-Text @@@@ascii:and additional text@@@@ within a paragraph.
+Inline text @@@@ascii:and additional text@@@@ within a paragraph.
#+ASCII: Some text
-#+BEGIN_ASCII
-All lines in this block will appear only when using this back-end.
-#+END_ASCII
+#+BEGIN_EXPORT ascii
+Org exports text in this block only when using ASCII back-end.
+#+END_EXPORT
@end example
@subheading ASCII specific attributes
@cindex #+ATTR_ASCII
@cindex horizontal rules, in ASCII export
-@code{ASCII} back-end only understands one attribute, @code{:width}, which
-specifies the length, in characters, of a given horizontal rule. It must be
-specified using an @code{ATTR_ASCII} line, directly preceding the rule.
+ASCII back-end recognizes only one attribute, @code{:width}, which specifies
+the width of an horizontal rule in number of characters. The keyword and
+syntax for specifying widths is:
@example
#+ATTR_ASCII: :width 10
-----
@end example
-@node Beamer export, HTML export, ASCII/Latin-1/UTF-8 export, Exporting
+@subheading ASCII special blocks
+@cindex special blocks, in ASCII export
+@cindex #+BEGIN_JUSTIFYLEFT
+@cindex #+BEGIN_JUSTIFYRIGHT
+
+Besides @code{#+BEGIN_CENTER} blocks (@pxref{Paragraphs}), ASCII back-end has
+these two left and right justification blocks:
+
+@example
+#+BEGIN_JUSTIFYLEFT
+It's just a jump to the left...
+#+END_JUSTIFYLEFT
+
+#+BEGIN_JUSTIFYRIGHT
+...and then a step to the right.
+#+END_JUSTIFYRIGHT
+@end example
+
+@node Beamer export
@section Beamer export
@cindex Beamer export
-The @LaTeX{} class @emph{Beamer} allows production of high quality
-presentations using @LaTeX{} and pdf processing. Org mode has special
-support for turning an Org mode file or tree into a Beamer presentation.
+Org uses @emph{Beamer} export to convert an Org file tree structure into a
+high-quality interactive slides for presentations. @emph{Beamer} is a
+@LaTeX{} document class for creating presentations in PDF, HTML, and other
+popular display formats.
-@subheading Beamer export commands
+@menu
+* Beamer export commands:: For creating Beamer documents.
+* Beamer specific export settings:: For customizing Beamer export.
+* Sectioning Frames and Blocks in Beamer:: For composing Beamer slides.
+* Beamer specific syntax:: For using in Org documents.
+* Editing support:: For using helper functions.
+* A Beamer example:: A complete presentation.
+@end menu
+
+@node Beamer export commands
+@subsection Beamer export commands
@table @kbd
@orgcmd{C-c C-e l b,org-beamer-export-to-latex}
-Export as a @LaTeX{} file. For an Org file @file{myfile.org}, the @LaTeX{}
-file will be @file{myfile.tex}. The file will be overwritten without
-warning.
+Export as @LaTeX{} file with a @file{.tex} extension. For @file{myfile.org},
+Org exports to @file{myfile.tex}, overwriting without warning.
@orgcmd{C-c C-e l B,org-beamer-export-as-latex}
-Export to a temporary buffer. Do not create a file.
+Export to a temporary buffer. Does not create a file.
@orgcmd{C-c C-e l P,org-beamer-export-to-pdf}
-Export as @LaTeX{} and then process to PDF.
+Export as @LaTeX{} file and then convert it to PDF format.
@item C-c C-e l O
-Export as @LaTeX{} and then process to PDF, then open the resulting PDF file.
+Export as @LaTeX{} file, convert it to PDF format, and then open the PDF
+file.
+@end table
+
+@node Beamer specific export settings
+@subsection Beamer specific export settings
+
+Beamer export back-end has several additional keywords for customizing Beamer
+output. These keywords work similar to the general options settings
+(@pxref{Export settings}).
+
+@table @samp
+@item BEAMER_THEME
+@cindex #+BEAMER_THEME
+@vindex org-beamer-theme
+The Beamer layout theme (@code{org-beamer-theme}). Use square brackets for
+options. For example:
+@smallexample
+#+BEAMER_THEME: Rochester [height=20pt]
+@end smallexample
+
+@item BEAMER_FONT_THEME
+@cindex #+BEAMER_FONT_THEME
+The Beamer font theme.
+
+@item BEAMER_INNER_THEME
+@cindex #+BEAMER_INNER_THEME
+The Beamer inner theme.
+
+@item BEAMER_OUTER_THEME
+@cindex #+BEAMER_OUTER_THEME
+The Beamer outer theme.
+
+@item BEAMER_HEADER
+@cindex #+BEAMER_HEADER
+Arbitrary lines inserted in the preamble, just before the @samp{hyperref}
+settings.
+
+@item DESCRIPTION
+@cindex #+DESCRIPTION (Beamer)
+The document description. For long descriptions, use multiple
+@code{#+DESCRIPTION} keywords. By default, @samp{hyperref} inserts
+@code{#+DESCRIPTION} as metadata. Use @code{org-latex-hyperref-template} to
+configure document metadata. Use @code{org-latex-title-command} to configure
+typesetting of description as part of front matter.
+
+@item KEYWORDS
+@cindex #+KEYWORDS (Beamer)
+The keywords for defining the contents of the document. Use multiple
+@code{#+KEYWORDS} lines if necessary. By default, @samp{hyperref} inserts
+@code{#+KEYWORDS} as metadata. Use @code{org-latex-hyperref-template} to
+configure document metadata. Use @code{org-latex-title-command} to configure
+typesetting of keywords as part of front matter.
+
+@item SUBTITLE
+@cindex #+SUBTITLE (Beamer)
+@vindex org-beamer-subtitle-format
+Document's subtitle. For typesetting, use @code{org-beamer-subtitle-format}
+string. Use @code{org-latex-hyperref-template} to configure document
+metadata. Use @code{org-latex-title-command} to configure typesetting of
+subtitle as part of front matter.
@end table
-@subheading Sectioning, Frames and Blocks
+@node Sectioning Frames and Blocks in Beamer
+@subsection Sectioning, Frames and Blocks in Beamer
-Any tree with not-too-deep level nesting should in principle be exportable as
-a Beamer presentation. Headlines fall into three categories: sectioning
-elements, frames and blocks.
+Org transforms heading levels into Beamer's sectioning elements, frames and
+blocks. Any Org tree with a not-too-deep-level nesting should in principle
+be exportable as a Beamer presentation.
@itemize @minus
@item
@vindex org-beamer-frame-level
-Headlines become frames when their level is equal to
+Org headlines become Beamer frames when the heading level in Org is equal to
@code{org-beamer-frame-level} or @code{H} value in an @code{OPTIONS} line
(@pxref{Export settings}).
@cindex property, BEAMER_ENV
-Though, if a headline in the current tree has a @code{BEAMER_ENV} property
-set to either to @code{frame} or @code{fullframe}, its level overrides the
-variable. A @code{fullframe} is a frame with an empty (ignored) title.
+Org overrides headlines to frames conversion for the current tree of an Org
+file if it encounters the @code{BEAMER_ENV} property set to @code{frame} or
+@code{fullframe}. Org ignores whatever @code{org-beamer-frame-level} happens
+to be for that headline level in the Org tree. In Beamer terminology, a
+@code{fullframe} is a frame without its title.
@item
@vindex org-beamer-environments-default
@vindex org-beamer-environments-extra
-All frame's children become @code{block} environments. Special block types
-can be enforced by setting headline's @code{BEAMER_ENV} property@footnote{If
-this property is set, the entry will also get a @code{:B_environment:} tag to
-make this visible. This tag has no semantic meaning, it is only a visual
-aid.} to an appropriate value (see @code{org-beamer-environments-default} for
-supported values and @code{org-beamer-environments-extra} for adding more).
+Org exports a Beamer frame's objects as @code{block} environments. Org can
+enforce wrapping in special block types when @code{BEAMER_ENV} property is
+set@footnote{If @code{BEAMER_ENV} is set, Org export adds
+@code{:B_environment:} tag to make it visible. The tag serves as a visual
+aid and has no semantic relevance.}. For valid values see
+@code{org-beamer-environments-default}. To add more values, see
+@code{org-beamer-environments-extra}.
@item
@cindex property, BEAMER_REF
-As a special case, if the @code{BEAMER_ENV} property is set to either
-@code{appendix}, @code{note}, @code{noteNH} or @code{againframe}, the
-headline will become, respectively, an appendix, a note (within frame or
-between frame, depending on its level), a note with its title ignored or an
-@code{\againframe} command. In the latter case, a @code{BEAMER_REF} property
-is mandatory in order to refer to the frame being resumed, and contents are
-ignored.
-
-Also, a headline with an @code{ignoreheading} environment will have its
-contents only inserted in the output. This special value is useful to have
-data between frames, or to properly close a @code{column} environment.
+If @code{BEAMER_ENV} is set to @code{appendix}, Org exports the entry as an
+appendix. When set to @code{note}, Org exports the entry as a note within
+the frame or between frames, depending on the entry's heading level. When
+set to @code{noteNH}, Org exports the entry as a note without its title.
+When set to @code{againframe}, Org exports the entry with @code{\againframe}
+command, which makes setting the @code{BEAMER_REF} property mandatory because
+@code{\againframe} needs frame to resume.
+
+When @code{ignoreheading} is set, Org export ignores the entry's headline but
+not its content. This is useful for inserting content between frames. It is
+also useful for properly closing a @code{column} environment.
@end itemize
@cindex property, BEAMER_ACT
@cindex property, BEAMER_OPT
-Headlines also support @code{BEAMER_ACT} and @code{BEAMER_OPT} properties.
-The former is translated as an overlay/action specification, or a default
-overlay specification when enclosed within square brackets. The latter
-specifies options@footnote{The @code{fragile} option is added automatically
-if it contains code that requires a verbatim environment, though.} for the
-current frame or block. The export back-end will automatically wrap
-properties within angular or square brackets when appropriate.
+When @code{BEAMER_ACT} is set for a headline, Org export translates that
+headline as an overlay or action specification. When enclosed in square
+brackets, Org export makes the overlay specification a default. Use
+@code{BEAMER_OPT} to set any options applicable to the current Beamer frame
+or block. The Beamer export back-end wraps with appropriate angular or
+square brackets. It also adds the @code{fragile} option for any code that may
+require a verbatim block.
@cindex property, BEAMER_COL
-Moreover, headlines handle the @code{BEAMER_COL} property. Its value should
-be a decimal number representing the width of the column as a fraction of the
-total text width. If the headline has no specific environment, its title
-will be ignored and its contents will fill the column created. Otherwise,
-the block will fill the whole column and the title will be preserved. Two
-contiguous headlines with a non-@code{nil} @code{BEAMER_COL} value share the same
-@code{columns} @LaTeX{} environment. It will end before the next headline
-without such a property. This environment is generated automatically.
-Although, it can also be explicitly created, with a special @code{columns}
-value for @code{BEAMER_ENV} property (if it needs to be set up with some
-specific options, for example).
-
-@subheading Beamer specific syntax
-
-Beamer back-end is an extension of @LaTeX{} back-end. As such, all @LaTeX{}
-specific syntax (e.g., @samp{#+LATEX:} or @samp{#+ATTR_LATEX:}) is
-recognized. See @ref{@LaTeX{} and PDF export} for more information.
-
-@cindex #+BEAMER_THEME
-@cindex #+BEAMER_COLOR_THEME
-@cindex #+BEAMER_FONT_THEME
-@cindex #+BEAMER_INNER_THEME
-@cindex #+BEAMER_OUTER_THEME
-Beamer export introduces a number of keywords to insert code in the
-document's header. Four control appearance of the presentation:
-@code{#+BEAMER_THEME}, @code{#+BEAMER_COLOR_THEME},
-@code{#+BEAMER_FONT_THEME}, @code{#+BEAMER_INNER_THEME} and
-@code{#+BEAMER_OUTER_THEME}. All of them accept optional arguments
-within square brackets. The last one, @code{#+BEAMER_HEADER}, is more
-generic and allows you to append any line of code in the header.
-
-@example
-#+BEAMER_THEME: Rochester [height=20pt]
-#+BEAMER_COLOR_THEME: spruce
-@end example
-
-Table of contents generated from @code{toc:t} @code{OPTION} keyword are
-wrapped within a @code{frame} environment. Those generated from a @code{TOC}
-keyword (@pxref{Table of contents}) are not. In that case, it is also
-possible to specify options, enclosed within square brackets.
+To create a column on the Beamer slide, use the @code{BEAMER_COL} property
+for its headline in the Org file. Set the value of @code{BEAMER_COL} to a
+decimal number representing the fraction of the total text width. Beamer
+export uses this value to set the column's width and fills the column with
+the contents of the Org entry. If the Org entry has no specific environment
+defined, Beamer export ignores the heading. If the Org entry has a defined
+environment, Beamer export uses the heading as title. Behind the scenes,
+Beamer export automatically handles @LaTeX{} column separations for
+contiguous headlines. To manually adjust them for any unique configurations
+needs, use the @code{BEAMER_ENV} property.
+
+@node Beamer specific syntax
+@subsection Beamer specific syntax
+Since Org's Beamer export back-end is an extension of the @LaTeX{} back-end,
+it recognizes other @LaTeX{} specific syntax---for example, @samp{#+LATEX:}
+or @samp{#+ATTR_LATEX:}. @xref{@LaTeX{} export}, for details.
+
+Beamer export wraps the table of contents generated with @code{toc:t}
+@code{OPTION} keyword in a @code{frame} environment. Beamer export does not
+wrap the table of contents generated with @code{TOC} keyword (@pxref{Table of
+contents}). Use square brackets for specifying options.
@example
#+TOC: headlines [currentsection]
@end example
-Beamer specific code can be inserted with the following constructs:
+Insert Beamer-specific code using the following constructs:
@cindex #+BEAMER
-@cindex #+BEGIN_BEAMER
+@cindex #+BEGIN_EXPORT beamer
@example
#+BEAMER: \pause
-#+BEGIN_BEAMER
-All lines in this block will appear only when using this back-end.
+#+BEGIN_EXPORT beamer
+Only Beamer export back-end will export this line.
#+END_BEAMER
Text @@@@beamer:some code@@@@ within a paragraph.
@end example
-In particular, this last example can be used to add overlay specifications to
-objects whose type is among @code{bold}, @code{item}, @code{link},
-@code{radio-target} and @code{target}, when the value is enclosed within
-angular brackets and put at the beginning the object.
+Inline constructs, such as the last one above, are useful for adding overlay
+specifications to objects with @code{bold}, @code{item}, @code{link},
+@code{radio-target} and @code{target} types. Enclose the value in angular
+brackets and place the specification at the beginning the object as shown in
+this example:
@example
A *@@@@beamer:<2->@@@@useful* feature
@end example
@cindex #+ATTR_BEAMER
-Eventually, every plain list has support for @code{:environment},
-@code{:overlay} and @code{:options} attributes through
-@code{ATTR_BEAMER} affiliated keyword. The first one allows the use
-of a different environment, the second sets overlay specifications and
-the last one inserts optional arguments in current list environment.
+Beamer export recognizes the @code{ATTR_BEAMER} keyword with the following
+attributes from Beamer configurations: @code{:environment} for changing local
+Beamer environment, @code{:overlay} for specifying Beamer overlays in angular
+or square brackets, and @code{:options} for inserting optional arguments.
@example
-#+ATTR_BEAMER: :overlay +-
+#+ATTR_BEAMER: :environment nonindentlist
+- item 1, not indented
+- item 2, not indented
+- item 3, not indented
+@end example
+
+@example
+#+ATTR_BEAMER: :overlay <+->
- item 1
- item 2
@end example
-@subheading Editing support
+@example
+#+ATTR_BEAMER: :options [Lagrange]
+Let $G$ be a finite group, and let $H$ be
+a subgroup of $G$. Then the order of $H$ divides the order of $G$.
+@end example
+
+@node Editing support
+@subsection Editing support
+
-You can turn on a special minor mode @code{org-beamer-mode} for faster
-editing with:
+The @code{org-beamer-mode} is a special minor mode for faster editing of
+Beamer documents.
@example
#+STARTUP: beamer
@@ -10959,23 +11452,19 @@ editing with:
@table @kbd
@orgcmd{C-c C-b,org-beamer-select-environment}
-In @code{org-beamer-mode}, this key offers fast selection of a Beamer
-environment or the @code{BEAMER_COL} property.
+The @code{org-beamer-mode} provides this key for quicker selections in Beamer
+normal environments, and for selecting the @code{BEAMER_COL} property.
@end table
-Also, a template for useful in-buffer settings or properties can be inserted
-into the buffer with @kbd{M-x org-beamer-insert-options-template}. Among
-other things, this will install a column view format which is very handy for
-editing special properties used by Beamer.
+@node A Beamer example
+@subsection A Beamer example
-@subheading An example
+Here is an example of an Org document ready for Beamer export.
-Here is a simple example Org document that is intended for Beamer export.
-
-@smallexample
+@example
#+TITLE: Example Presentation
#+AUTHOR: Carsten Dominik
-#+OPTIONS: H:2
+#+OPTIONS: H:2 toc:t num:t
#+LATEX_CLASS: beamer
#+LATEX_CLASS_OPTIONS: [presentation]
#+BEAMER_THEME: Madrid
@@ -10984,91 +11473,148 @@ Here is a simple example Org document that is intended for Beamer export.
* This is the first structural section
** Frame 1
-*** Thanks to Eric Fraga :B_block:BMCOL:
+*** Thanks to Eric Fraga :B_block:
:PROPERTIES:
:BEAMER_COL: 0.48
:BEAMER_ENV: block
:END:
for the first viable Beamer setup in Org
-*** Thanks to everyone else :B_block:BMCOL:
+*** Thanks to everyone else :B_block:
:PROPERTIES:
:BEAMER_COL: 0.48
:BEAMER_ACT: <2->
:BEAMER_ENV: block
:END:
for contributing to the discussion
-**** This will be formatted as a beamer note :B_note:
+**** This will be formatted as a beamer note :B_note:
:PROPERTIES:
:BEAMER_env: note
:END:
** Frame 2 (where we will not use columns)
*** Request
Please test this stuff!
-@end smallexample
+@end example
-@node HTML export, @LaTeX{} and PDF export, Beamer export, Exporting
+@node HTML export
@section HTML export
@cindex HTML export
-Org mode contains an HTML (XHTML 1.0 strict) exporter with extensive
-HTML formatting, in ways similar to John Gruber's @emph{markdown}
-language, but with additional support for tables.
+Org mode contains an HTML exporter with extensive HTML formatting compatible
+with XHTML 1.0 strict standard.
@menu
-* HTML Export commands:: How to invoke HTML export
-* HTML doctypes:: Org can export to various (X)HTML flavors
-* HTML preamble and postamble:: How to insert a preamble and a postamble
-* Quoting HTML tags:: Using direct HTML in Org mode
-* Links in HTML export:: How links will be interpreted and formatted
-* Tables in HTML export:: How to modify the formatting of tables
-* Images in HTML export:: How to insert figures into HTML output
-* Math formatting in HTML export:: Beautiful math also on the web
-* Text areas in HTML export:: An alternative way to show an example
-* CSS support:: Changing the appearance of the output
-* JavaScript support:: Info and Folding in a web browser
+* HTML Export commands:: Invoking HTML export
+* HTML Specific export settings:: Settings for HTML export
+* HTML doctypes:: Exporting various (X)HTML flavors
+* HTML preamble and postamble:: Inserting preamble and postamble
+* Quoting HTML tags:: Using direct HTML in Org files
+* Links in HTML export:: Interpreting and formatting links
+* Tables in HTML export:: Formatting and modifying tables
+* Images in HTML export:: Inserting figures with HTML output
+* Math formatting in HTML export:: Handling math equations
+* Text areas in HTML export:: Showing an alternate approach, an example
+* CSS support:: Styling HTML output
+* JavaScript support:: Folding scripting in the web browser
@end menu
-@node HTML Export commands, HTML doctypes, HTML export, HTML export
+
+@node HTML Export commands
@subsection HTML export commands
@table @kbd
@orgcmd{C-c C-e h h,org-html-export-to-html}
-Export as an HTML file. For an Org file @file{myfile.org},
-the HTML file will be @file{myfile.html}. The file will be overwritten
-without warning.
-@kbd{C-c C-e h o}
-Export as an HTML file and immediately open it with a browser.
+Export as HTML file with a @file{.html} extension. For @file{myfile.org},
+Org exports to @file{myfile.html}, overwriting without warning. @kbd{C-c C-e
+h o} Exports to HTML and opens it in a web browser.
+
@orgcmd{C-c C-e h H,org-html-export-as-html}
-Export to a temporary buffer. Do not create a file.
+Exports to a temporary buffer. Does not create a file.
@end table
-@c FIXME Exporting sublevels
-@c @cindex headline levels, for exporting
-@c In the exported version, the first 3 outline levels will become headlines,
-@c defining a general document structure. Additional levels will be exported as
-@c itemized lists. If you want that transition to occur at a different level,
-@c specify it with a numeric prefix argument. For example,
+@node HTML Specific export settings
+@subsection HTML Specific export settings
+HTML export has a number of keywords, similar to the general options settings
+described in @ref{Export settings}.
-@c @example
-@c @kbd{C-2 C-c C-e b}
-@c @end example
+@table @samp
+@item DESCRIPTION
+@cindex #+DESCRIPTION (HTML)
+This is the document's description, which the HTML exporter inserts it as a
+HTML meta tag in the HTML file. For long descriptions, use multiple
+@code{#+DESCRIPTION} lines. The exporter takes care of wrapping the lines
+properly.
+
+@item HTML_DOCTYPE
+@cindex #+HTML_DOCTYPE
+@vindex org-html-doctype
+Specify the document type, for example: HTML5 (@code{org-html-doctype}).
-@c @noindent
-@c creates two levels of headings and does the rest as items.
+@item HTML_CONTAINER
+@cindex #+HTML_CONTAINER
+@vindex org-html-container-element
+Specify the HTML container, such as @samp{div}, for wrapping sections and
+elements (@code{org-html-container-element}).
+
+@item HTML_LINK_HOME
+@cindex #+HTML_LINK_HOME
+@vindex org-html-link-home
+The URL for home link (@code{org-html-link-home}).
+
+@item HTML_LINK_UP
+@cindex #+HTML_LINK_UP
+@vindex org-html-link-up
+The URL for the up link of exported HTML pages (@code{org-html-link-up}).
+
+@item HTML_MATHJAX
+@cindex #+HTML_MATHJAX
+@vindex org-html-mathjax-options
+Options for MathJax (@code{org-html-mathjax-options}). MathJax is used to
+typeset @LaTeX{} math in HTML documents. @xref{Math formatting in HTML
+export}, for an example.
+
+@item HTML_HEAD
+@cindex #+HTML_HEAD
+@vindex org-html-head
+Arbitrary lines for appending to the HTML document's head
+(@code{org-html-head}).
+
+@item HTML_HEAD_EXTRA
+@cindex #+HTML_HEAD_EXTRA
+@vindex org-html-head-extra
+More arbitrary lines for appending to the HTML document's head
+(@code{org-html-head-extra}).
+
+@item KEYWORDS
+@cindex #+KEYWORDS (HTML)
+Keywords to describe the document's content. HTML exporter inserts these
+keywords as HTML meta tags. For long keywords, use multiple
+@code{#+KEYWORDS} lines.
+
+@item LATEX_HEADER
+@cindex #+LATEX_HEADER (HTML)
+Arbitrary lines for appending to the preamble; HTML exporter appends when
+transcoding @LaTeX{} fragments to images (@pxref{Math formatting in HTML
+export}).
+
+@item SUBTITLE
+@cindex #+SUBTITLE (HTML)
+The document's subtitle. HTML exporter formats subtitle if document type is
+@samp{HTML5} and the CSS has a @samp{subtitle} class.
+@end table
-@node HTML doctypes, HTML preamble and postamble, HTML Export commands, HTML export
+Some of these keywords are explained in more detail in the following sections
+of the manual.
+
+@node HTML doctypes
@subsection HTML doctypes
-@vindex org-html-doctype
-@vindex org-html-doctype-alist
Org can export to various (X)HTML flavors.
-Setting the variable @code{org-html-doctype} allows you to export to different
-(X)HTML variants. The exported HTML will be adjusted according to the syntax
-requirements of that variant. You can either set this variable to a doctype
-string directly, in which case the exporter will try to adjust the syntax
-automatically, or you can use a ready-made doctype. The ready-made options
-are:
+@vindex org-html-doctype
+@vindex org-html-doctype-alist
+Set the @code{org-html-doctype} variable for different (X)HTML variants.
+Depending on the variant, the HTML exporter adjusts the syntax of HTML
+conversion accordingly. Org includes the following ready-made variants:
@itemize
@item
@@ -11091,23 +11637,21 @@ are:
``xhtml5''
@end itemize
-See the variable @code{org-html-doctype-alist} for details. The default is
-``xhtml-strict''.
+@noindent See the variable @code{org-html-doctype-alist} for details.
+The default is ``xhtml-strict''.
-@subsubheading Fancy HTML5 export
@vindex org-html-html5-fancy
-@vindex org-html-html5-elements
-
-HTML5 introduces several new element types. By default, Org will not make
-use of these element types, but you can set @code{org-html-html5-fancy} to
-@code{t} (or set @code{html5-fancy} item in an @code{OPTIONS} line), to
-enable a few new block-level elements. These are created using arbitrary
-#+BEGIN and #+END blocks. For instance:
+@cindex HTML5, export new elements
+Org's HTML exporter does not by default enable new block elements introduced
+with the HTML5 standard. To enable them, set @code{org-html-html5-fancy} to
+non-@code{nil}. Or use an @code{OPTIONS} line in the file to set
+@code{html5-fancy}. HTML5 documents can now have arbitrary @code{#+BEGIN}
+and @code{#+END} blocks. For example:
@example
-#+BEGIN_ASIDE
+#+BEGIN_aside
Lorem ipsum
-#+END_ASIDE
+#+END_aside
@end example
Will export to:
@@ -11122,14 +11666,14 @@ While this:
@example
#+ATTR_HTML: :controls controls :width 350
-#+BEGIN_VIDEO
+#+BEGIN_video
#+HTML: <source src="movie.mp4" type="video/mp4">
#+HTML: <source src="movie.ogg" type="video/ogg">
Your browser does not support the video tag.
-#+END_VIDEO
+#+END_video
@end example
-Becomes:
+Exports to:
@example
<video controls="controls" width="350">
@@ -11139,15 +11683,17 @@ Becomes:
</video>
@end example
-Special blocks that do not correspond to HTML5 elements (see
-@code{org-html-html5-elements}) will revert to the usual behavior, i.e.,
-@code{#+BEGIN_LEDERHOSEN} will still export to @samp{<div class="lederhosen">}.
+@vindex org-html-html5-elements
+When special blocks do not have a corresponding HTML5 element, the HTML
+exporter reverts to standard translation (see
+@code{org-html-html5-elements}). For example, @code{#+BEGIN_lederhosen}
+exports to @samp{<div class="lederhosen">}.
-Headlines cannot appear within special blocks. To wrap a headline and its
-contents in e.g., @samp{<section>} or @samp{<article>} tags, set the
-@code{HTML_CONTAINER} property on the headline itself.
+Special blocks cannot have headlines. For the HTML exporter to wrap the
+headline and its contents in @samp{<section>} or @samp{<article>} tags, set
+the @code{HTML_CONTAINER} property for the headline.
-@node HTML preamble and postamble, Quoting HTML tags, HTML doctypes, HTML export
+@node HTML preamble and postamble
@subsection HTML preamble and postamble
@vindex org-html-preamble
@vindex org-html-postamble
@@ -11157,69 +11703,77 @@ contents in e.g., @samp{<section>} or @samp{<article>} tags, set the
@vindex org-export-creator-string
@vindex org-export-time-stamp-file
-The HTML exporter lets you define a preamble and a postamble.
-
-The default value for @code{org-html-preamble} is @code{t}, which means
-that the preamble is inserted depending on the relevant format string in
-@code{org-html-preamble-format}.
-
-Setting @code{org-html-preamble} to a string will override the default format
-string. If you set it to a function, it will insert the output of the
-function, which must be a string. Setting to @code{nil} will not insert any
-preamble.
-
-The default value for @code{org-html-postamble} is @code{'auto}, which means
-that the HTML exporter will look for information about the author, the email,
-the creator and the date, and build the postamble from these values. Setting
-@code{org-html-postamble} to @code{t} will insert the postamble from the
-relevant format string found in @code{org-html-postamble-format}. Setting it
-to @code{nil} will not insert any postamble.
-
-@node Quoting HTML tags, Links in HTML export, HTML preamble and postamble, HTML export
+The HTML exporter has delineations for preamble and postamble. The default
+value for @code{org-html-preamble} is @code{t}, which makes the HTML exporter
+insert the preamble. See the variable @code{org-html-preamble-format} for
+the format string.
+
+Set @code{org-html-preamble} to a string to override the default format
+string. If the string is a function, the HTML exporter expects the function
+to return a string upon execution. The HTML exporter inserts this string in
+the preamble. The HTML exporter will not insert a preamble if
+@code{org-html-preamble} is set @code{nil}.
+
+The default value for @code{org-html-postamble} is @code{auto}, which makes
+the HTML exporter build a postamble from looking up author's name, email
+address, creator's name, and date. Set @code{org-html-postamble} to @code{t}
+to insert the postamble in the format specified in the
+@code{org-html-postamble-format} variable. The HTML exporter will not insert
+a postamble if @code{org-html-postamble} is set to @code{nil}.
+
+@node Quoting HTML tags
@subsection Quoting HTML tags
-Plain @samp{<} and @samp{>} are always transformed to @samp{&lt;} and
-@samp{&gt;} in HTML export. If you want to include raw HTML code, which
-should only appear in HTML export, mark it with @samp{@@@@html:} as in
-@samp{@@@@html:<b>@@@@bold text@@@@html:</b>@@@@}. For more extensive HTML
-that should be copied verbatim to the exported file use either
+The HTML export back-end transforms @samp{<} and @samp{>} to @samp{&lt;} and
+@samp{&gt;}. To include raw HTML code in the Org file so the HTML export
+back-end can insert that HTML code in the output, use this inline syntax:
+@samp{@@@@html:}. For example: @samp{@@@@html:<b>@@@@bold
+text@@@@html:</b>@@@@}. For larger raw HTML code blocks, use these HTML
+export code blocks:
@cindex #+HTML
-@cindex #+BEGIN_HTML
+@cindex #+BEGIN_EXPORT html
@example
#+HTML: Literal HTML code for export
@end example
@noindent or
-@cindex #+BEGIN_HTML
+@cindex #+BEGIN_EXPORT html
@example
-#+BEGIN_HTML
+#+BEGIN_EXPORT html
All lines between these markers are exported literally
-#+END_HTML
+#+END_EXPORT
@end example
-@node Links in HTML export, Tables in HTML export, Quoting HTML tags, HTML export
+@node Links in HTML export
@subsection Links in HTML export
@cindex links, in HTML export
@cindex internal links, in HTML export
@cindex external links, in HTML export
-Internal links (@pxref{Internal links}) will continue to work in HTML@. This
-includes automatic links created by radio targets (@pxref{Radio
-targets}). Links to external files will still work if the target file is on
-the same @i{relative} path as the published Org file. Links to other
-@file{.org} files will be translated into HTML links under the assumption
-that an HTML version also exists of the linked file, at the same relative
-path. @samp{id:} links can then be used to jump to specific entries across
-files. For information related to linking files while publishing them to a
-publishing directory see @ref{Publishing links}.
-
-If you want to specify attributes for links, you can do so using a special
-@code{#+ATTR_HTML} line to define attributes that will be added to the
-@code{<a>} or @code{<img>} tags. Here is an example that sets @code{title}
-and @code{style} attributes for a link:
+@vindex org-html-link-org-files-as-html
+The HTML export back-end transforms Org's internal links (@pxref{Internal
+links}) to equivalent HTML links in the output. The back-end similarly
+handles Org's automatic links created by radio targets (@pxref{Radio
+targets}) similarly. For Org links to external files, the back-end
+transforms the links to @emph{relative} paths.
+
+For Org links to other @file{.org} files, the back-end automatically changes
+the file extension to @file{.html} and makes file paths relative. If the
+@file{.org} files have an equivalent @file{.html} version at the same
+location, then the converted links should work without any further manual
+intervention. However, to disable this automatic path translation, set
+@code{org-html-link-org-files-as-html} to @code{nil}. When disabled, the
+HTML export back-end substitutes the @samp{id:}-based links in the HTML
+output. For more about linking files when publishing to a directory,
+@pxref{Publishing links}.
+
+Org files can also have special directives to the HTML export back-end. For
+example, by using @code{#+ATTR_HTML} lines to specify new format attributes
+to @code{<a>} or @code{<img>} tags. This example shows changing the link's
+@code{title} and @code{style}:
@cindex #+ATTR_HTML
@example
@@ -11227,15 +11781,15 @@ and @code{style} attributes for a link:
[[http://orgmode.org]]
@end example
-@node Tables in HTML export, Images in HTML export, Links in HTML export, HTML export
-@subsection Tables
+@node Tables in HTML export
+@subsection Tables in HTML export
@cindex tables, in HTML
@vindex org-html-table-default-attributes
-Org mode tables are exported to HTML using the table attributes defined in
-@code{org-html-table-default-attributes}. The default setting makes tables
-without cell borders and frame. If you would like to change this for
-individual tables, place something like the following before the table:
+The HTML export back-end uses @code{org-html-table-default-attributes} when
+exporting Org tables to HTML. By default, the exporter does not draw frames
+and cell borders. To change for this for a table, use the following lines
+before the table in the Org file:
@cindex #+CAPTION
@cindex #+ATTR_HTML
@@ -11244,36 +11798,72 @@ individual tables, place something like the following before the table:
#+ATTR_HTML: :border 2 :rules all :frame border
@end example
+The HTML export back-end preserves column groupings in Org tables
+(@pxref{Column groups}) when exporting to HTML.
+
+Additional options for customizing tables for HTML export.
+
+@table @code
+@vindex org-html-table-align-individual-fields
+@item org-html-table-align-individual-fields
+Non-@code{nil} attaches style attributes for alignment to each table field.
+
+@vindex org-html-table-caption-above
+@item org-html-table-caption-above
+Non-@code{nil} places caption string at the beginning of the table.
+
+@vindex org-html-table-data-tags
+@item org-html-table-data-tags
+Opening and ending tags for table data fields.
+
+@vindex org-html-table-default-attributes
+@item org-html-table-default-attributes
+Default attributes and values for table tags.
+
+@vindex org-html-table-header-tags
+@item org-html-table-header-tags
+Opening and ending tags for table's header fields.
+
@vindex org-html-table-row-tags
-You can also modify the default tags used for each row by setting
-@code{org-html-table-row-tags}. See the docstring for an example on
-how to use this option.
+@item org-html-table-row-tags
+Opening and ending tags for table rows.
+
+@vindex org-html-table-use-header-tags-for-first-column
+@item org-html-table-use-header-tags-for-first-column
+Non-@code{nil} formats column one in tables with header tags.
+@end table
-@node Images in HTML export, Math formatting in HTML export, Tables in HTML export, HTML export
+@node Images in HTML export
@subsection Images in HTML export
@cindex images, inline in HTML
@cindex inlining images in HTML
@vindex org-html-inline-images
-HTML export can inline images given as links in the Org file, and
-it can make an image the clickable part of a link. By
-default@footnote{But see the variable
-@code{org-html-inline-images}.}, images are inlined if a link does
-not have a description. So @samp{[[file:myimg.jpg]]} will be inlined,
-while @samp{[[file:myimg.jpg][the image]]} will just produce a link
-@samp{the image} that points to the image. If the description part
-itself is a @code{file:} link or a @code{http:} URL pointing to an
-image, this image will be inlined and activated so that clicking on the
-image will activate the link. For example, to include a thumbnail that
-will link to a high resolution version of the image, you could use:
+
+The HTML export back-end has features to convert Org image links to HTML
+inline images and HTML clickable image links.
+
+When the link in the Org file has no description, the HTML export back-end by
+default in-lines that image. For example: @samp{[[file:myimg.jpg]]} is
+in-lined, while @samp{[[file:myimg.jpg][the image]]} links to the text,
+@samp{the image}.
+
+For more details, see the variable @code{org-html-inline-images}.
+
+On the other hand, if the description part of the Org link is itself another
+link, such as @code{file:} or @code{http:} URL pointing to an image, the HTML
+export back-end in-lines this image and links to the main image. This Org
+syntax enables the back-end to link low-resolution thumbnail to the
+high-resolution version of the image, as shown in this example:
@example
[[file:highres.jpg][file:thumb.jpg]]
@end example
-If you need to add attributes to an inlined image, use a @code{#+ATTR_HTML}.
-In the example below we specify the @code{alt} and @code{title} attributes to
-support text viewers and accessibility, and align it to the right.
+To change attributes of in-lined images, use @code{#+ATTR_HTML} lines in the
+Org file. This example shows realignment to right, and adds @code{alt} and
+@code{title} attributes in support of text viewers and modern web accessibility
+standards.
@cindex #+CAPTION
@cindex #+ATTR_HTML
@@ -11284,63 +11874,72 @@ support text viewers and accessibility, and align it to the right.
@end example
@noindent
-You could use @code{http} addresses just as well.
+The HTML export back-end copies the @code{http} links from the Org file as
+is.
-@node Math formatting in HTML export, Text areas in HTML export, Images in HTML export, HTML export
+@node Math formatting in HTML export
@subsection Math formatting in HTML export
@cindex MathJax
@cindex dvipng
+@cindex dvisvgm
@cindex imagemagick
@LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be displayed in two
-different ways on HTML pages. The default is to use the
-@uref{http://www.mathjax.org, MathJax system} which should work out of the
-box with Org mode installation because @uref{http://orgmode.org} serves
-@file{MathJax} for Org mode users for small applications and for testing
-purposes. @b{If you plan to use this regularly or on pages with significant
-page views, you should install@footnote{Installation instructions can be
-found on the MathJax website, see
-@uref{http://www.mathjax.org/resources/docs/?installation.html}.} MathJax on
-your own server in order to limit the load of our server.} To configure
-@file{MathJax}, use the variable @code{org-html-mathjax-options} or
-insert something like the following into the buffer:
-
-@example
-#+HTML_MATHJAX: align:"left" mathml:t path:"/MathJax/MathJax.js"
-@end example
+different ways on HTML pages. The default is to use
+@uref{http://www.mathjax.org, MathJax} which should work out of the box with
+Org@footnote{By default Org loads MathJax from @uref{https://cdnjs.com, cdnjs.com} as
+recommended by @uref{http://www.mathjax.org, MathJax}.}. Some MathJax display
+options can be configured via @code{org-html-mathjax-options}, or in the
+buffer. For example, with the following settings,
+@smallexample
+#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
+@end smallexample
+equation labels will be displayed on the left margin and equations will be
+five ems from the left margin.
-@noindent See the docstring of the variable
-@code{org-html-mathjax-options} for the meaning of the parameters in
-this line.
+@noindent See the docstring of
+@code{org-html-mathjax-options} for all supported variables. The MathJax
+template can be configure via @code{org-html-mathjax-template}.
If you prefer, you can also request that @LaTeX{} fragments are processed
into small images that will be inserted into the browser page. Before the
availability of MathJax, this was the default method for Org files. This
-method requires that the @file{dvipng} program or @file{imagemagick} suite is
-available on your system. You can still get this processing with
+method requires that the @file{dvipng} program, @file{dvisvgm} or
+@file{imagemagick} suite is available on your system. You can still get
+this processing with
@example
#+OPTIONS: tex:dvipng
@end example
+@example
+#+OPTIONS: tex:dvisvgm
+@end example
+
or:
@example
#+OPTIONS: tex:imagemagick
@end example
-@node Text areas in HTML export, CSS support, Math formatting in HTML export, HTML export
+@node Text areas in HTML export
@subsection Text areas in HTML export
@cindex text areas, in HTML
-An alternative way to publish literal code examples in HTML is to use text
-areas, where the example can even be edited before pasting it into an
-application. It is triggered by @code{:textarea} attribute at an
-@code{example} or @code{src} block.
+Before Org mode's Babel, one popular approach to publishing code in HTML was
+by using @code{:textarea}. The advantage of this approach was that copying
+and pasting was built into browsers with simple JavaScript commands. Even
+editing before pasting was made simple.
+
+The HTML export back-end can create such text areas. It requires an
+@code{#+ATTR_HTML:} line as shown in the example below with the
+@code{:textarea} option. This must be followed by either an
+@code{example} or a @code{src} code block. Other Org block types will not
+honor the @code{:textarea} option.
-You may also use @code{:height} and @code{:width} attributes to specify the
-height and width of the text area, which default to the number of lines in
-the example, and 80, respectively. For example
+By default, the HTML export back-end creates a text area 80 characters wide
+and height just enough to fit the content. Override these defaults with
+@code{:width} and @code{:height} options on the @code{#+ATTR_HTML:} line.
@example
#+ATTR_HTML: :textarea t :width 40
@@ -11352,7 +11951,7 @@ the example, and 80, respectively. For example
@end example
-@node CSS support, JavaScript support, Text areas in HTML export, HTML export
+@node CSS support
@subsection CSS support
@cindex CSS, for HTML export
@cindex HTML export, CSS
@@ -11371,6 +11970,7 @@ p.author @r{author information, including email}
p.date @r{publishing date}
p.creator @r{creator info, about org mode version}
.title @r{document title}
+.subtitle @r{document subtitle}
.todo @r{TODO keywords, all not-done states}
.done @r{the DONE keywords, all states that count as done}
.WAITING @r{each TODO keyword also uses a class named after itself}
@@ -11388,7 +11988,7 @@ div.outline-text-N @r{extra div for text at outline level N}
.figure-number @r{label like "Figure 1:"}
.table-number @r{label like "Table 1:"}
.listing-number @r{label like "Listing 1:"}
-div.figure @r{how to format an inlined image}
+div.figure @r{how to format an in-lined image}
pre.src @r{formatted source code}
pre.example @r{normal example}
p.verse @r{verse paragraph}
@@ -11396,6 +11996,7 @@ div.footnotes @r{footnote section headline}
p.footnote @r{footnote definition paragraph, containing a footnote}
.footref @r{a footnote reference number (always a <sup>)}
.footnum @r{footnote number in footnote definition (always <sup>)}
+.org-svg @r{default class for a linked @file{.svg} image}
@end example
@vindex org-html-style-default
@@ -11403,15 +12004,10 @@ p.footnote @r{footnote definition paragraph, containing a footnote}
@vindex org-html-head
@vindex org-html-head-extra
@cindex #+HTML_INCLUDE_STYLE
-Each exported file contains a compact default style that defines these
-classes in a basic way@footnote{This style is defined in the constant
-@code{org-html-style-default}, which you should not modify. To turn
-inclusion of these defaults off, customize
-@code{org-html-head-include-default-style} or set @code{html-style} to
-@code{nil} in an @code{OPTIONS} line.}. You may overwrite these settings, or
-add to them by using the variables @code{org-html-head} and
-@code{org-html-head-extra}. You can override the global values of these
-variables for each file by using these keywords:
+The HTML export back-end includes a compact default style in each exported
+HTML file. To override the default style with another style, use these
+keywords in the Org file. They will replace the global defaults the HTML
+exporter uses.
@cindex #+HTML_HEAD
@cindex #+HTML_HEAD_EXTRA
@@ -11420,38 +12016,49 @@ variables for each file by using these keywords:
#+HTML_HEAD_EXTRA: <link rel="alternate stylesheet" type="text/css" href="style2.css" />
@end example
+To just turn off the default style, customize
+@code{org-html-head-include-default-style} variable, or use this option line in
+the Org file.
+
+@example
+#+OPTIONS: html-style:nil
+@end example
+
@noindent
-For longer style definitions, you can use several such lines. You could also
-directly write a @code{<style>} @code{</style>} section in this way, without
-referring to an external file.
+For longer style definitions, either use several @code{#+HTML_HEAD} and
+@code{#+HTML_HEAD_EXTRA} lines, or use @code{<style>} @code{</style>} blocks
+around them. Both of these approaches can avoid referring to an external
+file.
-In order to add styles to a subtree, use the @code{:HTML_CONTAINER_CLASS:}
+In order to add styles to a sub-tree, use the @code{:HTML_CONTAINER_CLASS:}
property to assign a class to the tree. In order to specify CSS styles for a
particular headline, you can use the id specified in a @code{:CUSTOM_ID:}
property.
+Never change the @code{org-html-style-default} constant. Instead use other
+simpler ways of customizing as described above.
+
+
@c FIXME: More about header and footer styles
@c FIXME: Talk about links and targets.
-@node JavaScript support, , CSS support, HTML export
+@node JavaScript support
@subsection JavaScript supported display of web pages
@cindex Rose, Sebastian
Sebastian Rose has written a JavaScript program especially designed to
enhance the web viewing experience of HTML files created with Org. This
-program allows you to view large files in two different ways. The first one
-is an @emph{Info}-like mode where each section is displayed separately and
+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
-view type is a @emph{folding} view much like Org provides inside Emacs. The
-script is available at @url{http://orgmode.org/org-info.js} and you can find
-the documentation for it at @url{http://orgmode.org/worg/code/org-info-js/}.
-We host the script at our site, but if you use it a lot, you might not want
-to be dependent on @url{http://orgmode.org} and prefer to install a local
-copy on your own web server.
+one has a @emph{folding} view, much like Org provides inside Emacs. The
+script is available at @url{http://orgmode.org/org-info.js} and the
+documentation at @url{http://orgmode.org/worg/code/org-info-js/}. The script
+is hosted on @url{http://orgmode.org}, but for reliability, prefer installing
+it on your own web server.
-All it then takes to use this program is adding a single line to the Org
-file:
+To use this program, just add this line to the Org file:
@cindex #+INFOJS_OPT
@example
@@ -11459,12 +12066,12 @@ file:
@end example
@noindent
-If this line is found, the HTML header will automatically contain the code
-needed to invoke the script. Using the line above, you can set the following
-viewing options:
+The HTML header now has the code needed to automatically invoke the script.
+For setting options, use the syntax from the above line for options described
+below:
@example
-path: @r{The path to the script. The default is to grab the script from}
+path: @r{The path to the script. The default grabs the script from}
@r{@url{http://orgmode.org/org-info.js}, but you might want to have}
@r{a local copy and use a path like @samp{../scripts/org-info.js}.}
view: @r{Initial view when the website is first shown. Possible values are:}
@@ -11494,105 +12101,204 @@ buttons: @r{Should view-toggle buttons be everywhere? When @code{nil} (the}
@vindex org-html-infojs-options
@vindex org-html-use-infojs
You can choose default values for these options by customizing the variable
-@code{org-html-infojs-options}. If you always want to apply the script to your
-pages, configure the variable @code{org-html-use-infojs}.
+@code{org-html-infojs-options}. If you want the script to always apply to
+your pages, configure the variable @code{org-html-use-infojs}.
-@node @LaTeX{} and PDF export, Markdown export, HTML export, Exporting
-@section @LaTeX{} and PDF export
+@node @LaTeX{} export
+@section @LaTeX{} export
@cindex @LaTeX{} export
@cindex PDF export
-@LaTeX{} export can produce an arbitrarily complex LaTeX document of any
-standard or custom document class. With further processing@footnote{The
-default @LaTeX{} output is designed for processing with @code{pdftex} or
-@LaTeX{}. It includes packages that are not compatible with @code{xetex} and
-possibly @code{luatex}. The @LaTeX{} exporter can be configured to support
-alternative TeX engines, see the options
-@code{org-latex-default-packages-alist} and @code{org-latex-packages-alist}.},
-which the @LaTeX{} exporter is able to control, this back-end is able to
-produce PDF output. Because the @LaTeX{} exporter can be configured to use
-the @code{hyperref} package, the default setup produces fully-linked PDF
-output.
-
-As in @LaTeX{}, blank lines are meaningful for this back-end: a paragraph
-will not be started if two contiguous syntactical elements are not separated
-by an empty line.
-
-This back-end also offers enhanced support for footnotes. Thus, it handles
-nested footnotes, footnotes in tables and footnotes in a list item's
-description.
+The @LaTeX{} export back-end can handle complex documents, incorporate
+standard or custom @LaTeX{} document classes, generate documents using
+alternate @LaTeX{} engines, and produce fully linked PDF files with indexes,
+bibliographies, and tables of contents, destined for interactive online
+viewing or high-quality print publication.
+
+While the details are covered in-depth in this section, here are some quick
+references to variables for the impatient: for engines, see
+@code{org-latex-compiler}; for build sequences, see
+@code{org-latex-pdf-process}; for packages, see
+@code{org-latex-default-packages-alist} and @code{org-latex-packages-alist}.
+
+An important note about the @LaTeX{} export back-end: it is sensitive to
+blank lines in the Org document. That's because @LaTeX{} itself depends on
+blank lines to tell apart syntactical elements, such as paragraphs.
@menu
-* @LaTeX{} export commands:: How to export to LaTeX and PDF
-* Header and sectioning:: Setting up the export file structure
-* Quoting @LaTeX{} code:: Incorporating literal @LaTeX{} code
-* @LaTeX{} specific attributes:: Controlling @LaTeX{} output
+* @LaTeX{} export commands:: For producing @LaTeX{} and PDF documents.
+* @LaTeX{} specific export settings:: Unique to this @LaTeX{} back-end.
+* @LaTeX{} header and sectioning:: For file structure.
+* Quoting @LaTeX{} code:: Directly in the Org document.
+* Tables in @LaTeX{} export:: Attributes specific to tables.
+* Images in @LaTeX{} export:: Attributes specific to images.
+* Plain lists in @LaTeX{} export:: Attributes specific to lists.
+* Source blocks in @LaTeX{} export:: Attributes specific to source code blocks.
+* Example blocks in @LaTeX{} export:: Attributes specific to example blocks.
+* Special blocks in @LaTeX{} export:: Attributes specific to special blocks.
+* Horizontal rules in @LaTeX{} export:: Attributes specific to horizontal rules.
@end menu
-@node @LaTeX{} export commands, Header and sectioning, @LaTeX{} and PDF export, @LaTeX{} and PDF export
+@node @LaTeX{} export commands
@subsection @LaTeX{} export commands
@table @kbd
@orgcmd{C-c C-e l l,org-latex-export-to-latex}
-Export as a @LaTeX{} file. For an Org file @file{myfile.org}, the @LaTeX{}
-file will be @file{myfile.tex}. The file will be overwritten without
-warning.
+Export as @LaTeX{} file with a @file{.tex} extension. For @file{myfile.org},
+Org exports to @file{myfile.tex}, overwriting without warning. @kbd{C-c C-e
+l l} Exports to @LaTeX{} file.
+
@orgcmd{C-c C-e l L,org-latex-export-as-latex}
Export to a temporary buffer. Do not create a file.
@orgcmd{C-c C-e l p,org-latex-export-to-pdf}
-Export as @LaTeX{} and then process to PDF.
+Export as @LaTeX{} file and convert it to PDF file.
@item C-c C-e l o
-Export as @LaTeX{} and then process to PDF, then open the resulting PDF file.
+Export as @LaTeX{} file and convert it to PDF, then open the PDF using the default viewer.
+@end table
+
+@vindex org-latex-compiler
+@vindex org-latex-bibtex-compiler
+@vindex org-latex-default-packages-alist
+The @LaTeX{} export back-end can use any of these @LaTeX{} engines:
+@samp{pdflatex}, @samp{xelatex}, and @samp{lualatex}. These engines compile
+@LaTeX{} files with different compilers, packages, and output options. The
+@LaTeX{} export back-end finds the compiler version to use from
+@code{org-latex-compiler} variable or the @code{#+LATEX_COMPILER} keyword in
+the Org file. See the docstring for the
+@code{org-latex-default-packages-alist} for loading packages with certain
+compilers. Also see @code{org-latex-bibtex-compiler} to set the bibliography
+compiler@footnote{This does not allow setting different bibliography
+compilers for different files. However, ``smart'' @LaTeX{} compilation
+systems, such as @samp{latexmk}, can select the correct bibliography
+compiler.}.
+
+@node @LaTeX{} specific export settings
+@subsection @LaTeX{} specific export settings
+
+The @LaTeX{} export back-end has several additional keywords for customizing
+@LaTeX{} output. Setting these keywords works similar to the general options
+(@pxref{Export settings}).
+
+@table @samp
+@item DESCRIPTION
+@cindex #+DESCRIPTION (@LaTeX{})
+The document's description. The description along with author name,
+keywords, and related file metadata are inserted in the output file by the
+@samp{hyperref} package. See @code{org-latex-hyperref-template} for
+customizing metadata items. See @code{org-latex-title-command} for
+typesetting description into the document's front matter. Use multiple
+@code{#+DESCRIPTION} lines for long descriptions.
+
+@item LATEX_CLASS
+@cindex #+LATEX_CLASS
+@vindex org-latex-default-class
+@vindex org-latex-classes
+This is @LaTeX{} document class, such as @code{article}, @code{report},
+@code{book}, and so on, which contain predefined preamble and headline level
+mapping that the @LaTeX{} export back-end needs. The back-end reads the
+default class name from the @code{org-latex-default-class} variable. Org has
+@code{article} as the default class. A valid default class must be an
+element of @code{org-latex-classes}.
+
+@item LATEX_CLASS_OPTIONS
+@cindex #+LATEX_CLASS_OPTIONS
+Options the @LaTeX{} export back-end uses when calling the @LaTeX{} document
+class.
+
+@item LATEX_COMPILER
+@cindex #+LATEX_COMPILER
+@vindex org-latex-compiler
+The compiler, such as @samp{pdflatex}, @samp{xelatex}, @samp{lualatex}, for
+producing the PDF (@code{org-latex-compiler}).
+
+@item LATEX_HEADER
+@cindex #+LATEX_HEADER
+@vindex org-latex-classes
+Arbitrary lines to add to the document's preamble, before the @samp{hyperref}
+settings. See @code{org-latex-classes} for adjusting the structure and order
+of the @LaTeX{} headers.
+
+@item LATEX_HEADER_EXTRA
+@cindex #+LATEX_HEADER_EXTRA
+@vindex org-latex-classes
+Arbitrary lines to add to the document's preamble, before the @samp{hyperref}
+settings. See @code{org-latex-classes} for adjusting the structure and order
+of the @LaTeX{} headers.
+
+@item KEYWORDS
+@cindex #+KEYWORDS (@LaTeX{})
+The keywords for the document. The description along with author name,
+keywords, and related file metadata are inserted in the output file by the
+@samp{hyperref} package. See @code{org-latex-hyperref-template} for
+customizing metadata items. See @code{org-latex-title-command} for
+typesetting description into the document's front matter. Use multiple
+@code{#+KEYWORDS} lines if necessary.
+
+@item SUBTITLE
+@cindex #+SUBTITLE (@LaTeX{})
+@vindex org-latex-subtitle-separate
+@vindex org-latex-subtitle-format
+The document's subtitle. It is typeset as per
+@code{org-latex-subtitle-format}. If @code{org-latex-subtitle-separate} is
+non-@code{nil}, it is typed as part of the @samp{\title}-macro. See
+@code{org-latex-hyperref-template} for customizing metadata items. See
+@code{org-latex-title-command} for typesetting description into the
+document's front matter.
@end table
-@node Header and sectioning, Quoting @LaTeX{} code, @LaTeX{} export commands, @LaTeX{} and PDF export
-@subsection Header and sectioning structure
+The following sections have further details.
+
+@node @LaTeX{} header and sectioning
+@subsection @LaTeX{} header and sectioning structure
@cindex @LaTeX{} class
@cindex @LaTeX{} sectioning structure
@cindex @LaTeX{} header
@cindex header, for @LaTeX{} files
@cindex sectioning structure, for @LaTeX{} export
-By default, the first three outline levels become headlines, defining a
-general document structure. Additional levels are exported as @code{itemize}
-or @code{enumerate} lists. The transition can also occur at a different
-level (@pxref{Export settings}).
+The @LaTeX{} export back-end converts the first three of Org's outline levels
+into @LaTeX{} headlines. The remaining Org levels are exported as
+@code{itemize} or @code{enumerate} lists. To change this globally for the
+cut-off point between levels and lists, (@pxref{Export settings}).
-By default, the @LaTeX{} output uses the class @code{article}.
+By default, the @LaTeX{} export back-end uses the @code{article} class.
@vindex org-latex-default-class
@vindex org-latex-classes
@vindex org-latex-default-packages-alist
@vindex org-latex-packages-alist
-You can change this globally by setting a different value for
-@code{org-latex-default-class} or locally by adding an option like
-@code{#+LATEX_CLASS: myclass} in your file, or with
-a @code{EXPORT_LATEX_CLASS} property that applies when exporting a region
-containing only this (sub)tree. The class must be listed in
-@code{org-latex-classes}. This variable defines a header template for each
-class@footnote{Into which the values of
-@code{org-latex-default-packages-alist} and @code{org-latex-packages-alist}
-are spliced.}, and allows you to define the sectioning structure for each
-class. You can also define your own classes there.
+To change the default class globally, edit @code{org-latex-default-class}.
+To change the default class locally in an Org file, add option lines
+@code{#+LATEX_CLASS: myclass}. To change the default class for just a part
+of the Org file, set a sub-tree property, @code{EXPORT_LATEX_CLASS}. The
+class name entered here must be valid member of @code{org-latex-classes}.
+This variable defines a header template for each class into which the
+exporter splices the values of @code{org-latex-default-packages-alist} and
+@code{org-latex-packages-alist}. Use the same three variables to define
+custom sectioning or custom classes.
@cindex #+LATEX_CLASS
@cindex #+LATEX_CLASS_OPTIONS
@cindex property, EXPORT_LATEX_CLASS
@cindex property, EXPORT_LATEX_CLASS_OPTIONS
-The @code{LATEX_CLASS_OPTIONS} keyword or @code{EXPORT_LATEX_CLASS_OPTIONS}
-property can specify the options for the @code{\documentclass} macro. These
-options have to be provided, as expected by @LaTeX{}, within square brackets.
+The @LaTeX{} export back-end sends the @code{LATEX_CLASS_OPTIONS} keyword and
+@code{EXPORT_LATEX_CLASS_OPTIONS} property as options to the @LaTeX{}
+@code{\documentclass} macro. The options and the syntax for specifying them,
+including enclosing them in square brackets, follow @LaTeX{} conventions.
+
+@example
+#+LATEX_CLASS_OPTIONS: [a4paper,11pt,twoside,twocolumn]
+@end example
@cindex #+LATEX_HEADER
@cindex #+LATEX_HEADER_EXTRA
-You can also use the @code{LATEX_HEADER} and
-@code{LATEX_HEADER_EXTRA}@footnote{Unlike @code{LATEX_HEADER}, contents
-from @code{LATEX_HEADER_EXTRA} keywords will not be loaded when previewing
-@LaTeX{} snippets (@pxref{Previewing @LaTeX{} fragments}).} keywords in order
-to add lines to the header. See the docstring of @code{org-latex-classes} for
-more information.
+The @LaTeX{} export back-end appends values from @code{LATEX_HEADER} and
+@code{LATEX_HEADER_EXTRA} keywords to the @LaTeX{} header. The docstring for
+@code{org-latex-classes} explains in more detail. Also note that @LaTeX{}
+export back-end does not append @code{LATEX_HEADER_EXTRA} to the header when
+previewing @LaTeX{} snippets (@pxref{Previewing @LaTeX{} fragments}).
-An example is shown below.
+A sample Org file with the above headers:
@example
#+LATEX_CLASS: article
@@ -11601,103 +12307,117 @@ An example is shown below.
* Headline 1
some text
+* Headline 2
+ some more text
@end example
-@node Quoting @LaTeX{} code, @LaTeX{} specific attributes, Header and sectioning, @LaTeX{} and PDF export
+@node Quoting @LaTeX{} code
@subsection Quoting @LaTeX{} code
-Embedded @LaTeX{} as described in @ref{Embedded @LaTeX{}}, will be correctly
-inserted into the @LaTeX{} file. Furthermore, you can add special code that
-should only be present in @LaTeX{} export with the following constructs:
+The @LaTeX{} export back-end can insert any arbitrary @LaTeX{} code,
+@pxref{Embedded @LaTeX{}}. There are three ways to embed such code in the
+Org file and they all use different quoting syntax.
-@cindex #+LATEX
-@cindex #+BEGIN_LATEX
+Inserting in-line quoted with @ symbols:
+@cindex inline, in @LaTeX{} export
@example
-Code within @@@@latex:some code@@@@ a paragraph.
-
-#+LATEX: Literal @LaTeX{} code for export
-
-#+BEGIN_LATEX
-All lines between these markers are exported literally
-#+END_LATEX
+Code embedded in-line @@@@latex:any arbitrary LaTeX code@@@@ in a paragraph.
@end example
-@node @LaTeX{} specific attributes, , Quoting @LaTeX{} code, @LaTeX{} and PDF export
-@subsection @LaTeX{} specific attributes
-@cindex #+ATTR_LATEX
+Inserting as one or more keyword lines in the Org file:
+@cindex #+LATEX
+@example
+#+LATEX: any arbitrary LaTeX code
+@end example
-@LaTeX{} understands attributes specified in an @code{ATTR_LATEX} line. They
-affect tables, images, plain lists, special blocks and source blocks.
+Inserting as an export block in the Org file, where the back-end exports any
+code between begin and end markers:
+@cindex #+BEGIN_EXPORT latex
+@example
+#+BEGIN_EXPORT latex
+any arbitrary LaTeX code
+#+END_EXPORT
+@end example
-@subsubheading Tables in @LaTeX{} export
+@node Tables in @LaTeX{} export
+@subsection Tables in @LaTeX{} export
@cindex tables, in @LaTeX{} export
+@cindex #+ATTR_LATEX, in tables
-For @LaTeX{} export of a table, you can specify a label and a caption
-(@pxref{Images and tables}). You can also use attributes to control table
-layout and contents. Valid @LaTeX{} attributes include:
+The @LaTeX{} export back-end can pass several @LaTeX{} attributes for table
+contents and layout. Besides specifying label and caption (@pxref{Images and
+tables}), the other valid @LaTeX{} attributes include:
@table @code
@item :mode
@vindex org-latex-default-table-mode
-Nature of table's contents. It can be set to @code{table}, @code{math},
-@code{inline-math} or @code{verbatim}. In particular, when in @code{math} or
-@code{inline-math} mode, every cell is exported as-is, horizontal rules are
-ignored and the table will be wrapped in a math environment. Also,
-contiguous tables sharing the same math mode will be wrapped within the same
-environment. Default mode is determined in
-@code{org-latex-default-table-mode}.
+The @LaTeX{} export back-end wraps the table differently depending on the
+mode for accurate rendering of math symbols. Mode is either @code{table},
+@code{math}, @code{inline-math} or @code{verbatim}. For @code{math} or
+@code{inline-math} mode, @LaTeX{} export back-end wraps the table in a math
+environment, but every cell in it is exported as-is. The @LaTeX{} export
+back-end determines the default mode from
+@code{org-latex-default-table-mode}. For , The @LaTeX{} export back-end
+merges contiguous tables in the same mode into a single environment.
@item :environment
@vindex org-latex-default-table-environment
-Environment used for the table. It can be set to any @LaTeX{} table
-environment, like @code{tabularx}@footnote{Requires adding the
-@code{tabularx} package to @code{org-latex-packages-alist}.},
-@code{longtable}, @code{array}, @code{tabu}@footnote{Requires adding the
-@code{tabu} package to @code{org-latex-packages-alist}.},
-@code{bmatrix}@enddots{} It defaults to
-@code{org-latex-default-table-environment} value.
+Set the default @LaTeX{} table environment for the @LaTeX{} export back-end
+to use when exporting Org tables. Common @LaTeX{} table environments are
+provided by these packages: @code{tabularx}, @code{longtable}, @code{array},
+@code{tabu}, and @code{bmatrix}. For packages, such as @code{tabularx} and
+@code{tabu}, or any newer replacements, include them in the
+@code{org-latex-packages-alist} variable so the @LaTeX{} export back-end can
+insert the appropriate load package headers in the converted @LaTeX{} file.
+Look in the docstring for the @code{org-latex-packages-alist} variable for
+configuring these packages for @LaTeX{} snippet previews, if any.
@item :caption
-@code{#+CAPTION} keyword is the simplest way to set a caption for a table
-(@pxref{Images and tables}). If you need more advanced commands for that
-task, you can use @code{:caption} attribute instead. Its value should be raw
-@LaTeX{} code. It has precedence over @code{#+CAPTION}.
+Use @code{#+CAPTION} keyword to set a simple caption for a table
+(@pxref{Images and tables}). For custom captions, use @code{:caption}
+attribute, which accepts raw @LaTeX{} code. @code{:caption} value overrides
+@code{#+CAPTION} value.
@item :float
@itemx :placement
-Float environment for the table. Possible values are @code{sidewaystable},
-@code{multicolumn}, @code{t} and @code{nil}. When unspecified, a table with
-a caption will have a @code{table} environment. Moreover, @code{:placement}
-attribute can specify the positioning of the float.
+The table environments by default are not floats in @LaTeX{}. To make them
+floating objects use @code{:float} with one of the following options:
+@code{sideways}, @code{multicolumn}, @code{t}, and @code{nil}. Note that
+@code{sidewaystable} has been deprecated since Org 8.3. @LaTeX{} floats can
+also have additional layout @code{:placement} attributes. These are the
+usual @code{[h t b p ! H]} permissions specified in square brackets. Note
+that for @code{:float sideways} tables, the @LaTeX{} export back-end ignores
+@code{:placement} attributes.
@item :align
@itemx :font
@itemx :width
-Set, respectively, the alignment string of the table, its font size and its
-width. They only apply on regular tables.
+The @LaTeX{} export back-end uses these attributes for regular tables to set
+their alignments, fonts, and widths.
@item :spread
-Boolean specific to the @code{tabu} and @code{longtabu} environments, and
-only takes effect when used in conjunction with the @code{:width} attribute.
-When @code{:spread} is non-@code{nil}, the table will be spread or shrunk by the
-value of @code{:width}.
+When @code{:spread} is non-@code{nil}, the @LaTeX{} export back-end spreads
+or shrinks the table by the @code{:width} for @code{tabu} and @code{longtabu}
+environments. @code{:spread} has no effect if @code{:width} is not set.
@item :booktabs
@itemx :center
@itemx :rmlines
@vindex org-latex-tables-booktabs
@vindex org-latex-tables-centered
-They toggle, respectively, @code{booktabs} usage (assuming the package is
-properly loaded), table centering and removal of every horizontal rule but
-the first one (in a "table.el" table only). In particular,
-@code{org-latex-tables-booktabs} (respectively @code{org-latex-tables-centered})
-activates the first (respectively second) attribute globally.
+All three commands are toggles. @code{:booktabs} brings in modern
+typesetting enhancements to regular tables. The @code{booktabs} package has
+to be loaded through @code{org-latex-packages-alist}. @code{:center} is for
+centering the table. @code{:rmlines} removes all but the very first
+horizontal line made of ASCII characters from "table.el" tables only.
@item :math-prefix
@itemx :math-suffix
@itemx :math-arguments
-A string that will be inserted, respectively, before the table within the
-math environment, after the table within the math environment, and between
-the macro name and the contents of the table. The @code{:math-arguments}
-attribute is used for matrix macros that require more than one argument
-(e.g., @code{qbordermatrix}).
+The @LaTeX{} export back-end inserts @code{:math-prefix} string value in a
+math environment before the table. The @LaTeX{} export back-end inserts
+@code{:math-suffix} string value in a math environment after the table. The
+@LaTeX{} export back-end inserts @code{:math-arguments} string value between
+the macro name and the table's contents. @code{:math-arguments} comes in use
+for matrix macros that require more than one argument, such as
+@code{qbordermatrix}.
@end table
-Thus, attributes can be used in a wide array of situations, like writing
-a table that will span over multiple pages, or a matrix product:
+@LaTeX{} table attributes help formatting tables for a wide range of
+situations, such as matrix product or spanning multiple pages:
@example
#+ATTR_LATEX: :environment longtable :align l|lp@{3cm@}r|l
@@ -11712,8 +12432,8 @@ a table that will span over multiple pages, or a matrix product:
| 3 | 4 |
@end example
-In the example below, @LaTeX{} command
-@code{\bicaption@{HeadingA@}@{HeadingB@}} will set the caption.
+Set the caption with the @LaTeX{} command
+@code{\bicaption@{HeadingA@}@{HeadingB@}}:
@example
#+ATTR_LATEX: :caption \bicaption@{HeadingA@}@{HeadingB@}
@@ -11722,128 +12442,203 @@ In the example below, @LaTeX{} command
@end example
-@subsubheading Images in @LaTeX{} export
+@node Images in @LaTeX{} export
+@subsection Images in @LaTeX{} export
@cindex images, inline in @LaTeX{}
@cindex inlining images in @LaTeX{}
+@cindex #+ATTR_LATEX, in images
-Images that are linked to without a description part in the link, like
-@samp{[[file:img.jpg]]} or @samp{[[./img.jpg]]} will be inserted into the PDF
-output file resulting from @LaTeX{} processing. Org will use an
-@code{\includegraphics} macro to insert the image@footnote{In the case of
-TikZ (@url{http://sourceforge.net/projects/pgf/}) images, it will become an
-@code{\input} macro wrapped within a @code{tikzpicture} environment.}.
+The @LaTeX{} export back-end processes image links in Org files that do not
+have descriptions, such as these links @samp{[[file:img.jpg]]} or
+@samp{[[./img.jpg]]}, as direct image insertions in the final PDF output. In
+the PDF, they are no longer links but actual images embedded on the page.
+The @LaTeX{} export back-end uses @code{\includegraphics} macro to insert the
+image. But for TikZ@footnote{@url{http://sourceforge.net/projects/pgf/}}
+images, the back-end uses an @code{\input} macro wrapped within
+a @code{tikzpicture} environment.
-You can specify specify image width or height with, respectively,
-@code{:width} and @code{:height} attributes. It is also possible to add any
-other option with the @code{:options} attribute, as shown in the following
-example:
+For specifying image @code{:width}, @code{:height}, and other
+@code{:options}, use this syntax:
@example
#+ATTR_LATEX: :width 5cm :options angle=90
[[./img/sed-hr4049.pdf]]
@end example
-If you need a specific command for the caption, use @code{:caption}
-attribute. It will override standard @code{#+CAPTION} value, if any.
+For custom commands for captions, use the @code{:caption} attribute. It will
+override the default @code{#+CAPTION} value:
@example
#+ATTR_LATEX: :caption \bicaption@{HeadingA@}@{HeadingB@}
[[./img/sed-hr4049.pdf]]
@end example
-If you have specified a caption as described in @ref{Images and tables}, the
-picture will be wrapped into a @code{figure} environment and thus become
-a floating element. You can also ask Org to export an image as a float
-without specifying caption by setting the @code{:float} attribute. You may
-also set it to:
+When captions follow the method as described in @ref{Images and tables}, the
+@LaTeX{} export back-end wraps the picture in a floating @code{figure}
+environment. To float an image without specifying a caption, set the
+@code{:float} attribute to one of the following:
@itemize @minus
@item
-@code{t}: if you want to use the standard @samp{figure} environment. It is
-used by default if you provide a caption to the image.
+@code{t}: for a standard @samp{figure} environment; used by default whenever
+an image has a caption.
@item
-@code{multicolumn}: if you wish to include an image which spans multiple
-columns in a page. This will export the image wrapped in a @code{figure*}
-environment.
+@code{multicolumn}: to span the image across multiple columns of a page; the
+back-end wraps the image in a @code{figure*} environment.
@item
-@code{wrap}: if you would like to let text flow around the image. It will
-make the figure occupy the left half of the page.
+@code{wrap}: for text to flow around the image on the right; the figure
+occupies the left half of the page.
@item
-@code{nil}: if you need to avoid any floating environment, even when
-a caption is provided.
+@code{sideways}: for a new page with the image sideways, rotated ninety
+degrees, in a @code{sidewaysfigure} environment; overrides @code{:placement}
+setting.
+@item
+@code{nil}: to avoid a @code{:float} even if using a caption.
@end itemize
@noindent
-To modify the placement option of any floating environment, set the
-@code{placement} attribute.
+Use the @code{placement} attribute to modify a floating environment's placement.
@example
-#+ATTR_LATEX: :float wrap :width 0.38\textwidth :placement @{r@}@{0.4\textwidth@}
-[[./img/hst.png]]
+#+ATTR_LATEX: :float wrap :width 0.38\textwidth :placement
+@{r@}@{0.4\textwidth@} [[./img/hst.png]]
@end example
-If the @code{:comment-include} attribute is set to a non-@code{nil} value,
-the @LaTeX{} @code{\includegraphics} macro will be commented out.
+@vindex org-latex-images-centered
+@cindex center image (@LaTeX{} export)
+@cindex image, centering (@LaTeX{} export)
+
+The @LaTeX{} export back-end centers all images by default. Setting
+@code{:center} attribute to @code{nil} disables centering. To disable
+centering globally, set @code{org-latex-images-centered} to @code{t}.
+
+Set the @code{:comment-include} attribute to non-@code{nil} value for the
+@LaTeX{} export back-end to comment out the @code{\includegraphics} macro.
-@subsubheading Plain lists in @LaTeX{} export
+@node Plain lists in @LaTeX{} export
+@subsection Plain lists in @LaTeX{} export
@cindex plain lists, in @LaTeX{} export
+@cindex #+ATTR_LATEX, in plain lists
+
+The @LaTeX{} export back-end accepts the @code{:environment} and
+@code{:options} attributes for plain lists. Both attributes work together
+for customizing lists, as shown in the examples:
+
+@example
+#+LATEX_HEADER: \usepackage[inline]@{enumitem@}
+Some ways to say "Hello":
+#+ATTR_LATEX: :environment itemize*
+#+ATTR_LATEX: :options [label=@{@}, itemjoin=@{,@}, itemjoin*=@{, and@}]
+- Hola
+- Bonjour
+- Guten Tag.
+@end example
-Plain lists accept two optional attributes: @code{:environment} and
-@code{:options}. The first one allows the use of a non-standard environment
-(e.g., @samp{inparaenum}). The second one specifies additional arguments for
-that environment.
+Since @LaTeX{} supports only four levels of nesting for lists, use an
+external package, such as @samp{enumitem} in @LaTeX{}, for levels deeper than
+four:
@example
-#+ATTR_LATEX: :environment compactitem :options [$\circ$]
-- you need ``paralist'' package to reproduce this example.
+#+LATEX_HEADER: \usepackage@{enumitem@}
+#+LATEX_HEADER: \renewlist@{itemize@}@{itemize@}@{9@}
+#+LATEX_HEADER: \setlist[itemize]@{label=$\circ$@}
+- One
+ - Two
+ - Three
+ - Four
+ - Five
@end example
-@subsubheading Source blocks in @LaTeX{} export
+@node Source blocks in @LaTeX{} export
+@subsection Source blocks in @LaTeX{} export
@cindex source blocks, in @LaTeX{} export
+@cindex #+ATTR_LATEX, in source blocks
+
+The @LaTeX{} export back-end can make source code blocks into floating
+objects through the attributes @code{:float} and @code{:options}. For
+@code{:float}:
-In addition to syntax defined in @ref{Literal examples}, names and captions
-(@pxref{Images and tables}), source blocks also accept a @code{:float}
-attribute. You may set it to:
@itemize @minus
@item
-@code{t}: if you want to make the source block a float. It is the default
-value when a caption is provided.
+@code{t}: makes a source block float; by default floats any source block with
+a caption.
@item
-@code{multicolumn}: if you wish to include a source block which spans multiple
-columns in a page.
+@code{multicolumn}: spans the source block across multiple columns of a page.
@item
-@code{nil}: if you need to avoid any floating environment, even when a caption
-is provided. It is useful for source code that may not fit in a single page.
+@code{nil}: avoids a @code{:float} even if using a caption; useful for
+source code blocks that may not fit on a page.
@end itemize
@example
#+ATTR_LATEX: :float nil
#+BEGIN_SRC emacs-lisp
-Code that may not fit in a single page.
+Lisp code that may not fit in a single page.
+#+END_SRC
+@end example
+
+@vindex org-latex-listings-options
+@vindex org-latex-minted-options
+The @LaTeX{} export back-end passes string values in @code{:options} to
+@LaTeX{} packages for customization of that specific source block. In the
+example below, the @code{:options} are set for Minted. Minted is a source
+code highlighting @LaTeX{}package with many configurable options.
+
+@example
+#+ATTR_LATEX: :options commentstyle=\bfseries
+#+BEGIN_SRC emacs-lisp
+ (defun Fib (n)
+ (if (< n 2) n (+ (Fib (- n 1)) (Fib (- n 2)))))
#+END_SRC
@end example
-@subsubheading Special blocks in @LaTeX{} export
+To apply similar configuration options for all source blocks in a file, use
+the @code{org-latex-listings-options} and @code{org-latex-minted-options}
+variables.
+
+@node Example blocks in @LaTeX{} export
+@subsection Example blocks in @LaTeX{} export
+@cindex example blocks, in @LaTeX{} export
+@cindex verbatim blocks, in @LaTeX{} export
+@cindex #+ATTR_LATEX, in example blocks
+
+The @LaTeX{} export back-end wraps the contents of example blocks in a
+@samp{verbatim} environment. To change this behavior to use another
+environment globally, specify an appropriate export filter (@pxref{Advanced
+configuration}). To change this behavior to use another environment for each
+block, use the @code{:environment} parameter to specify a custom environment.
+
+@example
+#+ATTR_LATEX: :environment myverbatim
+#+BEGIN_EXAMPLE
+This sentence is false.
+#+END_EXAMPLE
+@end example
+
+@node Special blocks in @LaTeX{} export
+@subsection Special blocks in @LaTeX{} export
@cindex special blocks, in @LaTeX{} export
@cindex abstract, in @LaTeX{} export
@cindex proof, in @LaTeX{} export
+@cindex #+ATTR_LATEX, in special blocks
+
-In @LaTeX{} back-end, special blocks become environments of the same name.
-Value of @code{:options} attribute will be appended as-is to that
-environment's opening string. For example:
+For other special blocks in the Org file, the @LaTeX{} export back-end makes
+a special environment of the same name. The back-end also takes
+@code{:options}, if any, and appends as-is to that environment's opening
+string. For example:
@example
-#+BEGIN_ABSTRACT
+#+BEGIN_abstract
We demonstrate how to solve the Syracuse problem.
-#+END_ABSTRACT
+#+END_abstract
#+ATTR_LATEX: :options [Proof of important theorem]
-#+BEGIN_PROOF
+#+BEGIN_proof
...
Therefore, any even number greater than 2 is the sum of two primes.
-#+END_PROOF
+#+END_proof
@end example
@noindent
-becomes
+exports to
@example
\begin@{abstract@}
@@ -11862,43 +12657,43 @@ example:
@example
#+ATTR_LATEX: :caption \MyCaption@{HeadingA@}
-#+BEGIN_PROOF
+#+BEGIN_proof
...
-#+END_PROOF
+#+END_proof
@end example
-@subsubheading Horizontal rules
+@node Horizontal rules in @LaTeX{} export
+@subsection Horizontal rules in @LaTeX{} export
@cindex horizontal rules, in @LaTeX{} export
+@cindex #+ATTR_LATEX, in horizontal rules
-Width and thickness of a given horizontal rule can be controlled with,
-respectively, @code{:width} and @code{:thickness} attributes:
+The @LaTeX{} export back-end converts horizontal rules by the specified
+@code{:width} and @code{:thickness} attributes. For example:
@example
#+ATTR_LATEX: :width .6\textwidth :thickness 0.8pt
-----
@end example
-@node Markdown export, OpenDocument Text export, @LaTeX{} and PDF export, Exporting
+@node Markdown export
@section Markdown export
@cindex Markdown export
-@code{md} export back-end generates Markdown syntax@footnote{Vanilla flavor,
-as defined at @url{http://daringfireball.net/projects/markdown/}.} for an Org
-mode buffer.
+The Markdown export back-end, @code{md}, converts an Org file to a Markdown
+format, as defined at @url{http://daringfireball.net/projects/markdown/}.
-It is built over HTML back-end: any construct not supported by Markdown
-syntax (e.g., tables) will be controlled and translated by @code{html}
-back-end (@pxref{HTML export}).
+Since @code{md} is built on top of the HTML back-end, any Org constructs not
+supported by Markdown, such as tables, the underlying @code{html} back-end
+(@pxref{HTML export}) converts them.
@subheading Markdown export commands
@table @kbd
@orgcmd{C-c C-e m m,org-md-export-to-markdown}
-Export as a text file written in Markdown syntax. For an Org file,
-@file{myfile.org}, the resulting file will be @file{myfile.md}. The file
-will be overwritten without warning.
+Export to a text file with Markdown syntax. For @file{myfile.org}, Org
+exports to @file{myfile.md}, overwritten without warning.
@orgcmd{C-c C-e m M,org-md-export-as-markdown}
-Export to a temporary buffer. Do not create a file.
+Export to a temporary buffer. Does not create a file.
@item C-c C-e m o
Export as a text file with Markdown syntax, then open it.
@end table
@@ -11906,54 +12701,52 @@ Export as a text file with Markdown syntax, then open it.
@subheading Header and sectioning structure
@vindex org-md-headline-style
-Markdown export can generate both @code{atx} and @code{setext} types for
-headlines, according to @code{org-md-headline-style}. The former introduces
-a hard limit of two levels, whereas the latter pushes it to six. Headlines
-below that limit are exported as lists. You can also set a soft limit before
-that one (@pxref{Export settings}).
+Based on @code{org-md-headline-style}, markdown export can generate headlines
+of both @code{atx} and @code{setext} types. @code{atx} limits headline
+levels to two. @code{setext} limits headline levels to six. Beyond these
+limits, the export back-end converts headlines to lists. To set a limit to a
+level before the absolute limit (@pxref{Export settings}).
@c begin opendocument
-@node OpenDocument Text export, Org export, Markdown export, Exporting
+@node OpenDocument Text export
@section OpenDocument Text export
@cindex ODT
@cindex OpenDocument
@cindex export, OpenDocument
@cindex LibreOffice
-Org mode@footnote{Versions 7.8 or later} supports export to OpenDocument Text
-(ODT) format. Documents created by this exporter use the
-@cite{OpenDocument-v1.2
+The ODT export back-end handles creating of OpenDocument Text (ODT) format
+files. The format complies with @cite{OpenDocument-v1.2
specification}@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html,
Open Document Format for Office Applications (OpenDocument) Version 1.2}} and
-are compatible with LibreOffice 3.4.
+is compatible with LibreOffice 3.4.
@menu
-* Pre-requisites for ODT export:: What packages ODT exporter relies on
-* ODT export commands:: How to invoke ODT export
-* Extending ODT export:: How to produce @samp{doc}, @samp{pdf} files
-* Applying custom styles:: How to apply custom styles to the output
-* Links in ODT export:: How links will be interpreted and formatted
-* Tables in ODT export:: How Tables are exported
-* Images in ODT export:: How to insert images
-* Math formatting in ODT export:: How @LaTeX{} fragments are formatted
-* Labels and captions in ODT export:: How captions are rendered
-* Literal examples in ODT export:: How source and example blocks are formatted
-* Advanced topics in ODT export:: Read this if you are a power user
+* Pre-requisites for ODT export:: Required packages.
+* ODT export commands:: Invoking export.
+* ODT specific export settings:: Configuration options.
+* Extending ODT export:: Producing @file{.doc}, @file{.pdf} files.
+* Applying custom styles:: Styling the output.
+* Links in ODT export:: Handling and formatting links.
+* Tables in ODT export:: Org table conversions.
+* Images in ODT export:: Inserting images.
+* Math formatting in ODT export:: Formatting @LaTeX{} fragments.
+* Labels and captions in ODT export:: Rendering objects.
+* Literal examples in ODT export:: For source code and example blocks.
+* Advanced topics in ODT export:: For power users.
@end menu
-@node Pre-requisites for ODT export, ODT export commands, OpenDocument Text export, OpenDocument Text export
+@node Pre-requisites for ODT export
@subsection Pre-requisites for ODT export
@cindex zip
-The ODT exporter relies on the @file{zip} program to create the final
-output. Check the availability of this program before proceeding further.
+The ODT export back-end relies on the @file{zip} program to create the final
+compressed ODT output. Check if @file{zip} is locally available and
+executable. Without @file{zip}, export cannot finish.
-@node ODT export commands, Extending ODT export, Pre-requisites for ODT export, OpenDocument Text export
+@node ODT export commands
@subsection ODT export commands
-
-@subsubheading Exporting to ODT
@anchor{x-export-to-odt}
-
@cindex region, active
@cindex active region
@cindex transient-mark-mode
@@ -11964,94 +12757,121 @@ output. Check the availability of this program before proceeding further.
Export as OpenDocument Text file.
@vindex org-odt-preferred-output-format
-If @code{org-odt-preferred-output-format} is specified, automatically convert
-the exported file to that format. @xref{x-export-to-other-formats, ,
-Automatically exporting to other formats}.
-
-For an Org file @file{myfile.org}, the ODT file will be
-@file{myfile.odt}. The file will be overwritten without warning. If there
-is an active region,@footnote{This requires @code{transient-mark-mode} to be
-turned on} only the region will be exported. If the selected region is a
-single tree,@footnote{To select the current subtree, use @kbd{C-c @@}} the
-tree head will become the document title. If the tree head entry has, or
-inherits, an @code{EXPORT_FILE_NAME} property, that name will be used for the
-export.
+If @code{org-odt-preferred-output-format} is specified, the ODT export
+back-end automatically converts the exported file to that format.
+@xref{x-export-to-other-formats, , Automatically exporting to other formats}.
+
+For @file{myfile.org}, Org exports to @file{myfile.odt}, overwriting without
+warning. The ODT export back-end exports a region only if a region was
+active. Note for exporting active regions, the @code{transient-mark-mode}
+has to be turned on.
+
+If the selected region is a single tree, the ODT export back-end makes the
+tree head the document title. Incidentally, @kbd{C-c @@} selects the current
+sub-tree. If the tree head entry has, or inherits, an
+@code{EXPORT_FILE_NAME} property, the ODT export back-end uses that for file
+name.
@kbd{C-c C-e o O}
-Export as an OpenDocument Text file and open the resulting file.
+Export to an OpenDocument Text file format and open it.
@vindex org-odt-preferred-output-format
-If @code{org-odt-preferred-output-format} is specified, open the converted
+When @code{org-odt-preferred-output-format} is specified, open the converted
file instead. @xref{x-export-to-other-formats, , Automatically exporting to
other formats}.
@end table
-@node Extending ODT export, Applying custom styles, ODT export commands, OpenDocument Text export
+@node ODT specific export settings
+@subsection ODT specific export settings
+The ODT export back-end has several additional keywords for customizing ODT
+output. Setting these keywords works similar to the general options
+(@pxref{Export settings}).
+
+@table @samp
+@item DESCRIPTION
+@cindex #+DESCRIPTION (ODT)
+This is the document's description, which the ODT export back-end inserts as
+document metadata. For long descriptions, use multiple @code{#+DESCRIPTION}
+lines.
+
+@item KEYWORDS
+@cindex #+KEYWORDS (ODT)
+The keywords for the document. The ODT export back-end inserts the
+description along with author name, keywords, and related file metadata as
+metadata in the output file. Use multiple @code{#+KEYWORDS} lines if
+necessary.
+
+@item ODT_STYLES_FILE
+@cindex ODT_STYLES_FILE
+@vindex org-odt-styles-file
+The ODT export back-end uses the @code{org-odt-styles-file} by default. See
+@ref{Applying custom styles} for details.
+
+@item SUBTITLE
+@cindex SUBTITLE (ODT)
+The document subtitle.
+@end table
+
+@node Extending ODT export
@subsection Extending ODT export
-The ODT exporter can interface with a variety of document
-converters and supports popular converters out of the box. As a result, you
-can use it to export to formats like @samp{doc} or convert a document from
-one format (say @samp{csv}) to another format (say @samp{ods} or @samp{xls}).
+The ODT export back-end can produce documents in other formats besides ODT
+using a specialized ODT converter process. Its common interface works with
+popular converters to produce formats such as @samp{doc}, or convert a
+document from one format, say @samp{csv}, to another format, say @samp{xls}.
@cindex @file{unoconv}
@cindex LibreOffice
-If you have a working installation of LibreOffice, a document converter is
-pre-configured for you and you can use it right away. If you would like to
-use @file{unoconv} as your preferred converter, customize the variable
-@code{org-odt-convert-process} to point to @code{unoconv}. You can
-also use your own favorite converter or tweak the default settings of the
-@file{LibreOffice} and @samp{unoconv} converters. @xref{Configuring a
-document converter}.
-
-@subsubsection Automatically exporting to other formats
+
+Customize @code{org-odt-convert-process} variable to point to @code{unoconv},
+which is the ODT's preferred converter. Working installations of LibreOffice
+would already have @code{unoconv} installed. Alternatively, other converters
+may be substituted here. @xref{Configuring a document converter}.
+
+@subsubheading Automatically exporting to other formats
@anchor{x-export-to-other-formats}
@vindex org-odt-preferred-output-format
-Very often, you will find yourself exporting to ODT format, only to
-immediately save the exported document to other formats like @samp{doc},
-@samp{docx}, @samp{rtf}, @samp{pdf} etc. In such cases, you can specify your
-preferred output format by customizing the variable
-@code{org-odt-preferred-output-format}. This way, the export commands
-(@pxref{x-export-to-odt,,Exporting to ODT}) can be extended to export to a
-format that is of immediate interest to you.
-
-@subsubsection Converting between document formats
+If ODT format is just an intermediate step to get to other formats, such as
+@samp{doc}, @samp{docx}, @samp{rtf}, or @samp{pdf}, etc., then extend the ODT
+export back-end to directly produce that format. Specify the final format in
+the @code{org-odt-preferred-output-format} variable. This is one way to
+extend (@pxref{x-export-to-odt,,Exporting to ODT}).
+
+@subsubheading Converting between document formats
@anchor{x-convert-to-other-formats}
-There are many document converters in the wild which support conversion to
-and from various file formats, including, but not limited to the
-ODT format. LibreOffice converter, mentioned above, is one such
-converter. Once a converter is configured, you can interact with it using
-the following command.
+The Org export back-end is made to be inter-operable with a wide range of text
+document format converters. Newer generation converters, such as LibreOffice
+and Pandoc, can handle hundreds of formats at once. Org provides a
+consistent interaction with whatever converter is installed. Here are some
+generic commands:
@vindex org-odt-convert
@table @kbd
@item M-x org-odt-convert RET
Convert an existing document from one format to another. With a prefix
-argument, also open the newly produced file.
+argument, opens the newly produced file.
@end table
-@node Applying custom styles, Links in ODT export, Extending ODT export, OpenDocument Text export
+@node Applying custom styles
@subsection Applying custom styles
@cindex styles, custom
@cindex template, custom
-The ODT exporter ships with a set of OpenDocument styles
-(@pxref{Working with OpenDocument style files}) that ensure a well-formatted
-output. These factory styles, however, may not cater to your specific
-tastes. To customize the output, you can either modify the above styles
-files directly, or generate the required styles using an application like
-LibreOffice. The latter method is suitable for expert and non-expert
-users alike, and is described here.
+The ODT export back-end comes with many OpenDocument styles (@pxref{Working
+with OpenDocument style files}). To expand or further customize these
+built-in style sheets, either edit the style sheets directly or generate them
+using an application such as LibreOffice. The example here shows creating a
+style using LibreOffice.
-@subsubsection Applying custom styles: the easy way
+@subsubheading Applying custom styles: the easy way
@enumerate
@item
-Create a sample @file{example.org} file with the below settings and export it
-to ODT format.
+Create a sample @file{example.org} file with settings as shown below, and
+export it to ODT format.
@example
#+OPTIONS: H:10 num:t
@@ -12059,9 +12879,9 @@ to ODT format.
@item
Open the above @file{example.odt} using LibreOffice. Use the @file{Stylist}
-to locate the target styles---these typically have the @samp{Org} prefix---and
-modify those to your taste. Save the modified file either as an
-OpenDocument Text (@file{.odt}) or OpenDocument Template (@file{.ott}) file.
+to locate the target styles, which typically have the @samp{Org} prefix.
+Open one, modify, and save as either OpenDocument Text (@file{.odt}) or
+OpenDocument Template (@file{.ott}) file.
@item
@cindex #+ODT_STYLES_FILE
@@ -12070,8 +12890,8 @@ Customize the variable @code{org-odt-styles-file} and point it to the
newly created file. For additional configuration options
@pxref{x-overriding-factory-styles,,Overriding factory styles}.
-If you would like to choose a style on a per-file basis, you can use the
-@code{#+ODT_STYLES_FILE} option. A typical setting will look like
+To apply and ODT style to a particular file, use the @code{#+ODT_STYLES_FILE}
+option as shown in the example below:
@example
#+ODT_STYLES_FILE: "/path/to/example.ott"
@@ -12085,51 +12905,48 @@ or
@end enumerate
-@subsubsection Using third-party styles and templates
+@subsubheading Using third-party styles and templates
-You can use third-party styles and templates for customizing your output.
-This will produce the desired output only if the template provides all
-style names that the @samp{ODT} exporter relies on. Unless this condition is
-met, the output is going to be less than satisfactory. So it is highly
-recommended that you only work with templates that are directly derived from
-the factory settings.
+The ODT export back-end relies on many templates and style names. Using
+third-party styles and templates can lead to mismatches. Templates derived
+from built in ODT templates and styles seem to have fewer problems.
-@node Links in ODT export, Tables in ODT export, Applying custom styles, OpenDocument Text export
+@node Links in ODT export
@subsection Links in ODT export
@cindex links, in ODT export
-ODT exporter creates native cross-references for internal links. It creates
-Internet-style links for all other links.
+ODT export back-end creates native cross-references for internal links and
+Internet-style links for all other link types.
-A link with no description and destined to a regular (un-itemized) outline
+A link with no description and pointing to a regular---un-itemized---outline
heading is replaced with a cross-reference and section number of the heading.
A @samp{\ref@{label@}}-style reference to an image, table etc.@: is replaced
with a cross-reference and sequence number of the labeled entity.
@xref{Labels and captions in ODT export}.
-@node Tables in ODT export, Images in ODT export, Links in ODT export, OpenDocument Text export
+@node Tables in ODT export
@subsection Tables in ODT export
@cindex tables, in ODT export
-Export of native Org mode tables (@pxref{Tables}) and simple @file{table.el}
-tables is supported. However, export of complex @file{table.el} tables---tables
-that have column or row spans---is not supported. Such tables are
-stripped from the exported document.
+The ODT export back-end handles native Org mode tables (@pxref{Tables}) and
+simple @file{table.el} tables. Complex @file{table.el} tables having column
+or row spans are not supported. Such tables are stripped from the exported
+document.
+
+By default, the ODT export back-end exports a table with top and bottom
+frames and with ruled lines separating row and column groups (@pxref{Column
+groups}). All tables are typeset to occupy the same width. The ODT export
+back-end honors any table alignments and relative widths for columns
+(@pxref{Column width and alignment}).
-By default, a table is exported with top and bottom frames and with rules
-separating row and column groups (@pxref{Column groups}). Furthermore, all
-tables are typeset to occupy the same width. If the table specifies
-alignment and relative width for its columns (@pxref{Column width and
-alignment}) then these are honored on export.@footnote{The column widths are
-interpreted as weighted ratios with the default weight being 1}
+Note that the ODT export back-end interprets column widths as weighted
+ratios, the default weight being 1.
@cindex #+ATTR_ODT
-You can control the width of the table by specifying @code{:rel-width}
-property using an @code{#+ATTR_ODT} line.
-For example, consider the following table which makes use of all the rules
-mentioned above.
+Specifying @code{:rel-width} property on an @code{#+ATTR_ODT} line controls
+the width of the table. For example:
@example
#+ATTR_ODT: :rel-width 50
@@ -12144,25 +12961,25 @@ mentioned above.
| Sum | 16 | 123 | 2560 | 2699 |
@end example
-On export, the table will occupy 50% of text area. The columns will be sized
-(roughly) in the ratio of 13:5:5:5:6. The first column will be left-aligned
-and rest of the columns will be right-aligned. There will be vertical rules
-after separating the header and last columns from other columns. There will
-be horizontal rules separating the header and last rows from other rows.
+On export, the above table takes 50% of text width area. The exporter sizes
+the columns in the ratio: 13:5:5:5:6. The first column is left-aligned and
+rest of the columns, right-aligned. Vertical rules separate the header and
+the last column. Horizontal rules separate the header and the last row.
-If you are not satisfied with the above formatting options, you can create
-custom table styles and associate them with a table using the
-@code{#+ATTR_ODT} line. @xref{Customizing tables in ODT export}.
+For even more customization, create custom table styles and associate them
+with a table using the @code{#+ATTR_ODT} line. @xref{Customizing tables in
+ODT export}.
-@node Images in ODT export, Math formatting in ODT export, Tables in ODT export, OpenDocument Text export
+@node Images in ODT export
@subsection Images in ODT export
@cindex images, embedding in ODT
@cindex embedding images in ODT
@subsubheading Embedding images
-You can embed images within the exported document by providing a link to the
-desired image file with no link description. For example, to embed
-@samp{img.png} do either of the following:
+The ODT export back-end processes image links in Org files that do not have
+descriptions, such as these links @samp{[[file:img.jpg]]} or
+@samp{[[./img.jpg]]}, as direct image insertions in the final output. Either
+of these examples works:
@example
[[file:img.png]]
@@ -12173,10 +12990,9 @@ desired image file with no link description. For example, to embed
@end example
@subsubheading Embedding clickable images
-You can create clickable images by providing a link whose description is a
-link to an image file. For example, to embed a image
-@file{org-mode-unicorn.png} which when clicked jumps to
-@uref{http://Orgmode.org} website, do the following
+For clickable images, provide a link whose description is another link to an
+image file. For example, to embed a image @file{org-mode-unicorn.png} which
+when clicked jumps to @uref{http://Orgmode.org} website, do the following
@example
[[http://orgmode.org][./org-mode-unicorn.png]]
@@ -12185,25 +13001,22 @@ link to an image file. For example, to embed a image
@subsubheading Sizing and scaling of embedded images
@cindex #+ATTR_ODT
-You can control the size and scale of the embedded images using the
-@code{#+ATTR_ODT} attribute.
+Control the size and scale of the embedded images with the @code{#+ATTR_ODT}
+attribute.
@cindex identify, ImageMagick
@vindex org-odt-pixels-per-inch
-The exporter specifies the desired size of the image in the final document in
-units of centimeters. In order to scale the embedded images, the exporter
-queries for pixel dimensions of the images using one of a) ImageMagick's
-@file{identify} program or b) Emacs @code{create-image} and @code{image-size}
-APIs@footnote{Use of @file{ImageMagick} is only desirable. However, if you
-routinely produce documents that have large images or you export your Org
-files that has images using a Emacs batch script, then the use of
-@file{ImageMagick} is mandatory.}. The pixel dimensions are subsequently
-converted in to units of centimeters using
-@code{org-odt-pixels-per-inch}. The default value of this variable is
-set to @code{display-pixels-per-inch}. You can tweak this variable to
-achieve the best results.
-
-The examples below illustrate the various possibilities.
+The ODT export back-end starts with establishing the size of the image in the
+final document. The dimensions of this size is measured in centimeters. The
+back-end then queries the image file for its dimensions measured in pixels.
+For this measurement, the back-end relies on ImageMagick's @file{identify}
+program or Emacs @code{create-image} and @code{image-size} API. ImageMagick
+is the preferred choice for large file sizes or frequent batch operations.
+The back-end then converts the pixel dimensions using
+@code{org-odt-pixels-per-inch} into the familiar 72 dpi or 96 dpi. The
+default value for this is in @code{display-pixels-per-inch}, which can be
+tweaked for better results based on the capabilities of the output device.
+Here are some common image scaling operations:
@table @asis
@item Explicitly size the image
@@ -12244,38 +13057,37 @@ height:width ratio, do the following
@subsubheading Anchoring of images
@cindex #+ATTR_ODT
-You can control the manner in which an image is anchored by setting the
-@code{:anchor} property of it's @code{#+ATTR_ODT} line. You can specify one
-of the following three values for the @code{:anchor} property:
-@samp{"as-char"}, @samp{"paragraph"} and @samp{"page"}.
+The ODT export back-end can anchor images to @samp{"as-char"},
+@samp{"paragraph"}, or @samp{"page"}. Set the preferred anchor using the
+@code{:anchor} property of the @code{#+ATTR_ODT} line.
-To create an image that is anchored to a page, do the following:
+To create an image that is anchored to a page:
@example
#+ATTR_ODT: :anchor "page"
[[./img.png]]
@end example
-@node Math formatting in ODT export, Labels and captions in ODT export, Images in ODT export, OpenDocument Text export
+@node Math formatting in ODT export
@subsection Math formatting in ODT export
-The ODT exporter has special support for handling math.
+The ODT export back-end has special support built-in for handling math.
@menu
-* Working with @LaTeX{} math snippets:: How to embed @LaTeX{} math fragments
-* Working with MathML or OpenDocument formula files:: How to embed equations in native format
+* Working with @LaTeX{} math snippets:: Embedding in @LaTeX{} format.
+* Working with MathML or OpenDocument formula files:: Embedding in native format.
@end menu
-@node Working with @LaTeX{} math snippets, Working with MathML or OpenDocument formula files, Math formatting in ODT export, Math formatting in ODT export
-@subsubsection Working with @LaTeX{} math snippets
+@node Working with @LaTeX{} math snippets
+@subsubheading Working with @LaTeX{} math snippets
-@LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be embedded in the ODT
+@LaTeX{} math snippets (@pxref{@LaTeX{} fragments}) can be embedded in an ODT
document in one of the following ways:
@cindex MathML
@enumerate
@item MathML
-This option is activated on a per-file basis with
+Add this line to the Org file. This option is activated on a per-file basis.
@example
#+OPTIONS: LaTeX:t
@@ -12289,13 +13101,13 @@ the exported document.
@vindex org-latex-to-mathml-convert-command
@vindex org-latex-to-mathml-jar-file
-You can specify the @LaTeX{}-to-MathML converter by customizing the variables
+To specify the @LaTeX{}-to-MathML converter, customize the variables
@code{org-latex-to-mathml-convert-command} and
@code{org-latex-to-mathml-jar-file}.
-If you prefer to use @file{MathToWeb}@footnote{See
-@uref{http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl, MathToWeb}} as your
-converter, you can configure the above variables as shown below.
+To use MathToWeb@footnote{See
+@uref{http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl, MathToWeb}.} as the
+preferred converter, configure the above variables as
@lisp
(setq org-latex-to-mathml-convert-command
@@ -12303,9 +13115,14 @@ converter, you can configure the above variables as shown below.
org-latex-to-mathml-jar-file
"/path/to/mathtoweb.jar")
@end lisp
+To use @LaTeX{}ML@footnote{See @uref{http://dlmf.nist.gov/LaTeXML/}.} use
+@lisp
+(setq org-latex-to-mathml-convert-command
+ "latexmlmath \"%i\" --presentationmathml=%o")
+@end lisp
-You can use the following commands to quickly verify the reliability of
-the @LaTeX{}-to-MathML converter.
+To quickly verify the reliability of the @LaTeX{}-to-MathML converter, use
+the following commands:
@table @kbd
@item M-x org-odt-export-as-odf RET
@@ -12317,34 +13134,39 @@ and open the formula file with the system-registered application.
@end table
@cindex dvipng
+@cindex dvisvgm
@cindex imagemagick
@item PNG images
-This option is activated on a per-file basis with
+Add this line to the Org file. This option is activated on a per-file basis.
@example
#+OPTIONS: tex:dvipng
@end example
+@example
+#+OPTIONS: tex:dvisvgm
+@end example
+
or:
@example
#+OPTIONS: tex:imagemagick
@end example
-With this option, @LaTeX{} fragments are processed into PNG images and the
-resulting images are embedded in the exported document. This method requires
-that the @file{dvipng} program or @file{imagemagick} suite be available on
-your system.
+Under this option, @LaTeX{} fragments are processed into PNG or SVG images
+and the resulting images are embedded in the exported document. This method
+requires @file{dvipng} program, @file{dvisvgm} or @file{imagemagick}
+programs.
@end enumerate
-@node Working with MathML or OpenDocument formula files, , Working with @LaTeX{} math snippets, Math formatting in ODT export
-@subsubsection Working with MathML or OpenDocument formula files
+@node Working with MathML or OpenDocument formula files
+@subsubheading Working with MathML or OpenDocument formula files
-For various reasons, you may find embedding @LaTeX{} math snippets in an
-ODT document less than reliable. In that case, you can embed a
-math equation by linking to its MathML (@file{.mml}) source or its
-OpenDocument formula (@file{.odf}) file as shown below:
+When embedding @LaTeX{} math snippets in ODT documents is not reliable, there
+is one more option to try. Embed an equation by linking to its MathML
+(@file{.mml}) source or its OpenDocument formula (@file{.odf}) file as shown
+below:
@example
[[./equation.mml]]
@@ -12356,19 +13178,14 @@ or
[[./equation.odf]]
@end example
-@node Labels and captions in ODT export, Literal examples in ODT export, Math formatting in ODT export, OpenDocument Text export
+@node Labels and captions in ODT export
@subsection Labels and captions in ODT export
-You can label and caption various category of objects---an inline image, a
-table, a @LaTeX{} fragment or a Math formula---using @code{#+LABEL} and
-@code{#+CAPTION} lines. @xref{Images and tables}. ODT exporter enumerates
-each labeled or captioned object of a given category separately. As a
-result, each such object is assigned a sequence number based on order of it's
-appearance in the Org file.
-
-In the exported document, a user-provided caption is augmented with the
-category and sequence number. Consider the following inline image in an Org
-file.
+ODT format handles labeling and captioning of objects based on their
+types. Inline images, tables, @LaTeX{} fragments, and Math formulas are
+numbered and captioned separately. Each object also gets a unique sequence
+number based on its order of first appearance in the Org file. Each category
+has its own sequence. A caption is just a label applied to these objects.
@example
#+CAPTION: Bell curve
@@ -12376,94 +13193,86 @@ file.
[[./img/a.png]]
@end example
-It could be rendered as shown below in the exported document.
+When rendered, it may show as follows in the exported document:
@example
Figure 2: Bell curve
@end example
@vindex org-odt-category-map-alist
-You can modify the category component of the caption by customizing the
-option @code{org-odt-category-map-alist}. For example, to tag all embedded
-images with the string @samp{Illustration} (instead of the default
-@samp{Figure}) use the following setting:
+To modify the category component of the caption, customize the option
+@code{org-odt-category-map-alist}. For example, to tag embedded images with
+the string @samp{Illustration} instead of the default string @samp{Figure},
+use the following setting:
@lisp
(setq org-odt-category-map-alist
- (("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)))
+ '(("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)))
@end lisp
-With this, previous image will be captioned as below in the exported
-document.
+With the above modification, the previous example changes to:
@example
Illustration 2: Bell curve
@end example
-@node Literal examples in ODT export, Advanced topics in ODT export, Labels and captions in ODT export, OpenDocument Text export
+@node Literal examples in ODT export
@subsection Literal examples in ODT export
-Export of literal examples (@pxref{Literal examples}) with full fontification
-is supported. Internally, the exporter relies on @file{htmlfontify.el} to
-generate all style definitions needed for a fancy listing.@footnote{Your
-@file{htmlfontify.el} library must at least be at Emacs 24.1 levels for
-fontification to be turned on.} The auto-generated styles have @samp{OrgSrc}
-as prefix and inherit their color from the faces used by Emacs
-@code{font-lock} library for the source language.
+The ODT export back-end supports literal examples (@pxref{Literal examples})
+with full fontification. Internally, the ODT export back-end relies on
+@file{htmlfontify.el} to generate the style definitions needed for fancy
+listings. The auto-generated styles get @samp{OrgSrc} prefix and inherit
+colors from the faces used by Emacs @code{font-lock} library for that source
+language.
@vindex org-odt-fontify-srcblocks
-If you prefer to use your own custom styles for fontification, you can do
-so by customizing the option
-@code{org-odt-create-custom-styles-for-srcblocks}.
+For custom fontification styles, customize the
+@code{org-odt-create-custom-styles-for-srcblocks} option.
@vindex org-odt-create-custom-styles-for-srcblocks
-You can turn off fontification of literal examples by customizing the
-option @code{org-odt-fontify-srcblocks}.
+To turn off fontification of literal examples, customize the
+@code{org-odt-fontify-srcblocks} option.
-@node Advanced topics in ODT export, , Literal examples in ODT export, OpenDocument Text export
+@node Advanced topics in ODT export
@subsection Advanced topics in ODT export
-If you rely heavily on ODT export, you may want to exploit the full
-set of features that the exporter offers. This section describes features
-that would be of interest to power users.
+The ODT export back-end has extensive features useful for power users and
+frequent uses of ODT formats.
@menu
-* Configuring a document converter:: How to register a document converter
-* Working with OpenDocument style files:: Explore the internals
-* Creating one-off styles:: How to produce custom highlighting etc
-* Customizing tables in ODT export:: How to define and use Table templates
-* Validating OpenDocument XML:: How to debug corrupt OpenDocument files
+* Configuring a document converter:: Registering a document converter.
+* Working with OpenDocument style files:: Exploring internals.
+* Creating one-off styles:: Customizing styles, highlighting.
+* Customizing tables in ODT export:: Defining table templates.
+* Validating OpenDocument XML:: Debugging corrupted OpenDocument files.
@end menu
-@node Configuring a document converter, Working with OpenDocument style files, Advanced topics in ODT export, Advanced topics in ODT export
-@subsubsection Configuring a document converter
+@node Configuring a document converter
+@subsubheading Configuring a document converter
@cindex convert
@cindex doc, docx, rtf
@cindex converter
-The ODT exporter can work with popular converters with little or no
-extra configuration from your side. @xref{Extending ODT export}.
-If you are using a converter that is not supported by default or if you would
-like to tweak the default converter settings, proceed as below.
+The ODT export back-end works with popular converters with little or no extra
+configuration. @xref{Extending ODT export}. The following is for unsupported
+converters or tweaking existing defaults.
@enumerate
@item Register the converter
@vindex org-odt-convert-processes
-Name your converter and add it to the list of known converters by
-customizing the option @code{org-odt-convert-processes}. Also specify how
-the converter can be invoked via command-line to effect the conversion.
+Add the name of the converter to the @code{org-odt-convert-processes}
+variable. Note that it also requires how the converter is invoked on the
+command line. See the variable's docstring for details.
@item Configure its capabilities
@vindex org-odt-convert-capabilities
-@anchor{x-odt-converter-capabilities} Specify the set of formats the
-converter can handle by customizing the variable
-@code{org-odt-convert-capabilities}. Use the default value for this
-variable as a guide for configuring your converter. As suggested by the
-default setting, you can specify the full set of formats supported by the
-converter and not limit yourself to specifying formats that are related to
-just the OpenDocument Text format.
+@anchor{x-odt-converter-capabilities} Specify which formats the converter can
+handle by customizing the variable @code{org-odt-convert-capabilities}. Use
+the entry for the default values in this variable for configuring the new
+converter. Also see its docstring for details.
@item Choose the converter
@@ -12472,18 +13281,17 @@ Select the newly added converter as the preferred one by customizing the
option @code{org-odt-convert-process}.
@end enumerate
-@node Working with OpenDocument style files, Creating one-off styles, Configuring a document converter, Advanced topics in ODT export
-@subsubsection Working with OpenDocument style files
+@node Working with OpenDocument style files
+@subsubheading Working with OpenDocument style files
@cindex styles, custom
@cindex template, custom
-This section explores the internals of the ODT exporter and the
-means by which it produces styled documents. Read this section if you are
-interested in exploring the automatic and custom OpenDocument styles used by
-the exporter.
+This section explores the internals of the ODT exporter; the means by which
+it produces styled documents; the use of automatic and custom OpenDocument
+styles.
@anchor{x-factory-styles}
-@subsubheading Factory styles
+@subsubheading a) Factory styles
The ODT exporter relies on two files for generating its output.
These files are bundled with the distribution under the directory pointed to
@@ -12524,25 +13332,25 @@ the exporter.
@item
It contains @samp{<text:sequence-decl>}@dots{}@samp{</text:sequence-decl>}
-elements that control how various entities---tables, images, equations,
-etc.---are numbered.
+elements that control numbering of tables, images, equations, and similar
+entities.
@end enumerate
@end itemize
@anchor{x-overriding-factory-styles}
-@subsubheading Overriding factory styles
-The following two variables control the location from which the ODT
-exporter picks up the custom styles and content template files. You can
-customize these variables to override the factory styles used by the
-exporter.
+@subsubheading b) Overriding factory styles
+The following two variables control the location from where the ODT exporter
+picks up the custom styles and content template files. Customize these
+variables to override the factory styles used by the exporter.
@itemize
@anchor{x-org-odt-styles-file}
@item
@code{org-odt-styles-file}
-Use this variable to specify the @file{styles.xml} that will be used in the
-final output. You can specify one of the following values:
+The ODT export back-end uses the file pointed to by this variable, such as
+@file{styles.xml}, for the final output. It can take one of the following
+values:
@enumerate
@item A @file{styles.xml} file
@@ -12576,28 +13384,26 @@ Use this variable to specify the blank @file{content.xml} that will be used
in the final output.
@end itemize
-@node Creating one-off styles, Customizing tables in ODT export, Working with OpenDocument style files, Advanced topics in ODT export
-@subsubsection Creating one-off styles
+@node Creating one-off styles
+@subsubheading Creating one-off styles
-There are times when you would want one-off formatting in the exported
-document. You can achieve this by embedding raw OpenDocument XML in the Org
-file. The use of this feature is better illustrated with couple of examples.
+The ODT export back-end can read embedded raw OpenDocument XML from the Org
+file. Such direct formatting are useful for one-off instances.
@enumerate
@item Embedding ODT tags as part of regular text
-You can inline OpenDocument syntax by enclosing it within
-@samp{@@@@odt:...@@@@} markup. For example, to highlight a region of text do
-the following:
+Enclose OpenDocument syntax in @samp{@@@@odt:...@@@@} for inline markup. For
+example, to highlight a region of text do the following:
@example
-@@@@odt:<text:span text:style-name="Highlight">This is a highlighted
-text</text:span>@@@@. But this is a regular text.
+@@@@odt:<text:span text:style-name="Highlight">This is highlighted
+text</text:span>@@@@. But this is regular text.
@end example
-@strong{Hint:} To see the above example in action, edit your
-@file{styles.xml} (@pxref{x-orgodtstyles-xml,,Factory styles}) and add a
-custom @samp{Highlight} style as shown below.
+@strong{Hint:} To see the above example in action, edit the @file{styles.xml}
+(@pxref{x-orgodtstyles-xml,,Factory styles}) and add a custom
+@samp{Highlight} style as shown below:
@example
<style:style style:name="Highlight" style:family="text">
@@ -12607,8 +13413,8 @@ custom @samp{Highlight} style as shown below.
@item Embedding a one-line OpenDocument XML
-You can add a simple OpenDocument one-liner using the @code{#+ODT:}
-directive. For example, to force a page break do the following:
+The ODT export back-end can read one-liner options with @code{#+ODT:}
+in the Org file. For example, to force a page break:
@example
#+ODT: <text:p text:style-name="PageBreak"/>
@@ -12627,41 +13433,40 @@ custom @samp{PageBreak} style as shown below.
@item Embedding a block of OpenDocument XML
-You can add a large block of OpenDocument XML using the
-@code{#+BEGIN_ODT}@dots{}@code{#+END_ODT} construct.
+The ODT export back-end can also read ODT export blocks for OpenDocument XML.
+Such blocks use the @code{#+BEGIN_EXPORT odt}@dots{}@code{#+END_EXPORT}
+constructs.
For example, to create a one-off paragraph that uses bold text, do the
following:
@example
-#+BEGIN_ODT
+#+BEGIN_EXPORT odt
<text:p text:style-name="Text_20_body_20_bold">
This paragraph is specially formatted and uses bold text.
</text:p>
-#+END_ODT
+#+END_EXPORT
@end example
@end enumerate
-@node Customizing tables in ODT export, Validating OpenDocument XML, Creating one-off styles, Advanced topics in ODT export
-@subsubsection Customizing tables in ODT export
+@node Customizing tables in ODT export
+@subsubheading Customizing tables in ODT export
@cindex tables, in ODT export
@cindex #+ATTR_ODT
-You can override the default formatting of the table by specifying a custom
-table style with the @code{#+ATTR_ODT} line. For a discussion on default
-formatting of tables @pxref{Tables in ODT export}.
+Override the default table format by specifying a custom table style with the
+@code{#+ATTR_ODT} line. For a discussion on default formatting of tables
+@pxref{Tables in ODT export}.
This feature closely mimics the way table templates are defined in the
OpenDocument-v1.2
specification.@footnote{@url{http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html,
OpenDocument-v1.2 Specification}}
-@subsubheading Custom table styles: an illustration
-
@vindex org-odt-table-styles
-To have a quick preview of this feature, install the below setting and
-export the table that follows:
+For quick preview of this feature, install the settings below and export the
+table that follows:
@lisp
(setq org-odt-table-styles
@@ -12675,22 +13480,20 @@ export the table that follows:
@end lisp
@example
-#+ATTR_ODT: :style "TableWithHeaderRowAndColumn"
+#+ATTR_ODT: :style TableWithHeaderRowAndColumn
| Name | Phone | Age |
| Peter | 1234 | 17 |
| Anna | 4321 | 25 |
@end example
-In the above example, you used a template named @samp{Custom} and installed
-two table styles with the names @samp{TableWithHeaderRowAndColumn} and
-@samp{TableWithFirstRowandLastRow}. (@strong{Important:} The OpenDocument
-styles needed for producing the above template have been pre-defined for
-you. These styles are available under the section marked @samp{Custom
-Table Template} in @file{OrgOdtContentTemplate.xml}
-(@pxref{x-orgodtcontenttemplate-xml,,Factory styles}). If you need
-additional templates you have to define these styles yourselves.
+The example above used @samp{Custom} template and installed two table styles
+@samp{TableWithHeaderRowAndColumn} and @samp{TableWithFirstRowandLastRow}.
+@strong{Important:} The OpenDocument styles needed for producing the above
+template were pre-defined. They are available in the section marked
+@samp{Custom Table Template} in @file{OrgOdtContentTemplate.xml}
+(@pxref{x-orgodtcontenttemplate-xml,,Factory styles}. For adding new
+templates, define new styles here.
-@subsubheading Custom table styles: the nitty-gritty
To use this feature proceed as follows:
@enumerate
@@ -12698,8 +13501,8 @@ To use this feature proceed as follows:
Create a table template@footnote{See the @code{<table:table-template>}
element of the OpenDocument-v1.2 specification}
-A table template is nothing but a set of @samp{table-cell} and
-@samp{paragraph} styles for each of the following table cell categories:
+A table template is set of @samp{table-cell} and @samp{paragraph} styles for
+each of the following table cell categories:
@itemize @minus
@item Body
@@ -12809,25 +13612,22 @@ the @code{ATTR_ODT} line as shown below.
@end example
@end enumerate
-@node Validating OpenDocument XML, , Customizing tables in ODT export, Advanced topics in ODT export
-@subsubsection Validating OpenDocument XML
-
-Occasionally, you will discover that the document created by the
-ODT exporter cannot be opened by your favorite application. One of
-the common reasons for this is that the @file{.odt} file is corrupt. In such
-cases, you may want to validate the document against the OpenDocument RELAX
-NG Compact Syntax (RNC) schema.
+@node Validating OpenDocument XML
+@subsubheading Validating OpenDocument XML
-For de-compressing the @file{.odt} file@footnote{@file{.odt} files are
-nothing but @samp{zip} archives}: @inforef{File Archives,,emacs}. For
-general help with validation (and schema-sensitive editing) of XML files:
+Sometimes ODT format files may not open due to @file{.odt} file corruption.
+To verify if the @file{.odt} file is corrupt, validate it against the
+OpenDocument RELAX NG Compact Syntax---RNC---schema. But first the
+@file{.odt} files have to be decompressed using @samp{zip}. Note that
+@file{.odt} files are @samp{zip} archives: @inforef{File Archives,,emacs}.
+The contents of @file{.odt} files are in @file{.xml}. For general help with
+validation---and schema-sensitive editing---of XML files:
@inforef{Introduction,,nxml-mode}.
@vindex org-odt-schema-dir
-If you have ready access to OpenDocument @file{.rnc} files and the needed
-schema-locating rules in a single folder, you can customize the variable
-@code{org-odt-schema-dir} to point to that directory. The ODT exporter
-will take care of updating the @code{rng-schema-locating-files} for you.
+Customize @code{org-odt-schema-dir} to point to a directory with OpenDocument
+@file{.rnc} files and the needed schema-locating rules. The ODT export
+back-end takes care of updating the @code{rng-schema-locating-files}.
@c end opendocument
@@ -12836,102 +13636,146 @@ will take care of updating the @code{rng-schema-locating-files} for you.
@cindex Org export
@code{org} export back-end creates a normalized version of the Org document
-in current buffer. In particular, it evaluates Babel code (@pxref{Evaluating
-code blocks}) and removes other back-ends specific contents.
+in current buffer. The exporter evaluates Babel code (@pxref{Evaluating code
+blocks}) and removes content specific to other back-ends.
@subheading Org export commands
@table @kbd
@orgcmd{C-c C-e O o,org-org-export-to-org}
-Export as an Org document. For an Org file, @file{myfile.org}, the resulting
-file will be @file{myfile.org.org}. The file will be overwritten without
-warning.
+Export as an Org file with a @file{.org} extension. For @file{myfile.org},
+Org exports to @file{myfile.org.org}, overwriting without warning.
+
@orgcmd{C-c C-e O O,org-org-export-as-org}
-Export to a temporary buffer. Do not create a file.
+Export to a temporary buffer. Does not create a file.
@item C-c C-e O v
Export to an Org file, then open it.
@end table
-@node Texinfo export, iCalendar export, Org export, Exporting
+@node Texinfo export
@section Texinfo export
@cindex Texinfo export
-@samp{texinfo} export back-end generates Texinfo code and can compile it into
-an Info file.
+The @samp{texinfo} export back-end generates documents with Texinfo code that
+can compile to Info format.
@menu
-* Texinfo export commands:: How to invoke Texinfo export
-* Document preamble:: File header, title and copyright page
-* Headings and sectioning structure:: Building document structure
-* Indices:: Creating indices
-* Quoting Texinfo code:: Incorporating literal Texinfo code
-* Texinfo specific attributes:: Controlling Texinfo output
-* An example::
+* Texinfo export commands:: Invoking commands.
+* Texinfo specific export settings:: Setting the environment.
+* Texinfo file header:: Generating the header.
+* Texinfo title and copyright page:: Creating preamble pages.
+* Info directory file:: Installing a manual in Info file hierarchy.
+* Headings and sectioning structure:: Building document structure.
+* Indices:: Creating indices.
+* Quoting Texinfo code:: Incorporating literal Texinfo code.
+* Plain lists in Texinfo export:: List attributes.
+* Tables in Texinfo export:: Table attributes.
+* Images in Texinfo export:: Image attributes.
+* Special blocks in Texinfo export:: Special block attributes.
+* A Texinfo example:: Processing Org to Texinfo.
@end menu
-@node Texinfo export commands, Document preamble, Texinfo export, Texinfo export
+@node Texinfo export commands
@subsection Texinfo export commands
@vindex org-texinfo-info-process
@table @kbd
@orgcmd{C-c C-e i t,org-texinfo-export-to-texinfo}
-Export as a Texinfo file. For an Org file, @file{myfile.org}, the resulting
-file will be @file{myfile.texi}. The file will be overwritten without
-warning.
+Export as a Texinfo file with @file{.texi} extension. For @file{myfile.org},
+Org exports to @file{myfile.texi}, overwriting without warning.
@orgcmd{C-c C-e i i,org-texinfo-export-to-info}
-Export to Texinfo and then process to an Info file@footnote{By setting
-@code{org-texinfo-info-process}, it is possible to generate other formats,
-including DocBook.}.
+Export to Texinfo format first and then process it to make an Info file. To
+generate other formats, such as DocBook, customize the
+@code{org-texinfo-info-process} variable.
@end table
-@node Document preamble, Headings and sectioning structure, Texinfo export commands, Texinfo export
-@subsection Document preamble
+@node Texinfo specific export settings
+@subsection Texinfo specific export settings
+The Texinfo export back-end has several additional keywords for customizing
+Texinfo output. Setting these keywords works similar to the general options
+(@pxref{Export settings}).
+
+@table @samp
+
+@item SUBTITLE
+@cindex #+SUBTITLE (Texinfo)
+The document subtitle.
+
+@item SUBAUTHOR
+@cindex #+SUBAUTHOR
+The document subauthor.
+
+@item TEXINFO_FILENAME
+@cindex #+TEXINFO_FILENAME
+The Texinfo filename.
+
+@item TEXINFO_CLASS
+@cindex #+TEXINFO_CLASS
+@vindex org-texinfo-default-class
+The default document class (@code{org-texinfo-default-class}), which must be
+a member of @code{org-texinfo-classes}.
+
+@item TEXINFO_HEADER
+@cindex #+TEXINFO_HEADER
+Arbitrary lines inserted at the end of the header.
+
+@item TEXINFO_POST_HEADER
+@cindex #+TEXINFO_POST_HEADER
+Arbitrary lines inserted after the end of the header.
+
+@item TEXINFO_DIR_CATEGORY
+@cindex #+TEXINFO_DIR_CATEGORY
+The directory category of the document.
+
+@item TEXINFO_DIR_TITLE
+@cindex #+TEXINFO_DIR_TITLE
+The directory title of the document.
+
+@item TEXINFO_DIR_DESC
+@cindex #+TEXINFO_DIR_DESC
+The directory description of the document.
-When processing a document, @samp{texinfo} back-end generates a minimal file
-header along with a title page, a copyright page, and a menu. You control
-the latter through the structure of the document (@pxref{Headings and
-sectioning structure}). Various keywords allow you to tweak the other parts.
-It is also possible to give directions to install the document in the
-@samp{Top} node.
+@item TEXINFO_PRINTED_TITLE
+@cindex #+TEXINFO_PRINTED_TITLE
+The printed title of the document.
+@end table
-@subsubheading File header
+@node Texinfo file header
+@subsection Texinfo file header
@cindex #+TEXINFO_FILENAME
-Upon creating the header of a Texinfo file, the back-end guesses a name for
-the Info file to be compiled. This may not be a sensible choice, e.g., if
-you want to produce the final document in a different directory. Specify an
-alternate path with @code{#+TEXINFO_FILENAME} keyword to override the default
-destination.
+After creating the header for a Texinfo file, the Texinfo back-end
+automatically generates a name and destination path for the Info file. To
+override this default with a more sensible path and name, specify the
+@code{#+TEXINFO_FILENAME} keyword.
@vindex org-texinfo-coding-system
@vindex org-texinfo-classes
@cindex #+TEXINFO_HEADER
@cindex #+TEXINFO_CLASS
-Along with the output file name, the header contains information about the
-language (@pxref{Export settings}) and current encoding used@footnote{See
-@code{org-texinfo-coding-system} for more information.}. Insert
-a @code{#+TEXINFO_HEADER} keyword for each additional command needed, e.g.,
+Along with the output's file name, the Texinfo header also contains language
+details (@pxref{Export settings}) and encoding system as set in the
+@code{org-texinfo-coding-system} variable. Insert @code{#+TEXINFO_HEADER}
+keywords for each additional command in the header, for example:
@@code@{@@synindex@}.
-If you happen to regularly install the same set of commands, it may be easier
-to define your own class in @code{org-texinfo-classes}, which see. Set
-@code{#+TEXINFO_CLASS} keyword accordingly in your document to activate it.
+Instead of repeatedly installing the same set of commands, define a class in
+@code{org-texinfo-classes} once, and then activate it in the document by
+setting the @code{#+TEXINFO_CLASS} keyword to that class.
-@subsubheading Title and copyright page
+@node Texinfo title and copyright page
+@subsection Texinfo title and copyright page
@cindex #+TEXINFO_PRINTED_TITLE
-@cindex #+SUBTITLE
-The default template includes a title page for hard copy output. The title
-and author displayed on this page are extracted from, respectively,
-@code{#+TITLE} and @code{#+AUTHOR} keywords (@pxref{Export settings}). It is
-also possible to print a different, more specific, title with
-@code{#+TEXINFO_PRINTED_TITLE} keyword, and add subtitles with
-@code{#+SUBTITLE} keyword. Both expect raw Texinfo code in their value.
+The default template for hard copy output has a title page with
+@code{#+TITLE} and @code{#+AUTHOR} (@pxref{Export settings}). To replace the
+regular @code{#+TITLE} with something different for the printed version, use
+the @code{#+TEXINFO_PRINTED_TITLE} and @code{#+SUBTITLE} keywords. Both
+expect raw Texinfo code for setting their values.
@cindex #+SUBAUTHOR
-Likewise, information brought by @code{#+AUTHOR} may not be enough. You can
-include other authors with several @code{#+SUBAUTHOR} keywords. Values are
-also expected to be written in Texinfo code.
+If one @code{#+AUTHOR} is not sufficient, add multiple @code{#+SUBAUTHOR}
+keywords. They have to be set in raw Texinfo code.
@example
#+AUTHOR: Jane Smith
@@ -12940,35 +13784,43 @@ also expected to be written in Texinfo code.
@end example
@cindex property, COPYING
-Copying material is defined in a dedicated headline with a non-nil
-@code{:COPYING:} property. The contents are inserted within
-a @code{@@copying} command at the beginning of the document whereas the
-heading itself does not appear in the structure of the document.
+Copying material is defined in a dedicated headline with a non-@code{nil}
+@code{:COPYING:} property. The back-end inserts the contents within a
+@code{@@copying} command at the beginning of the document. The heading
+itself does not appear in the structure of the document.
Copyright information is printed on the back of the title page.
@example
-* Copying
+* Legalese
:PROPERTIES:
:COPYING: t
:END:
This is a short example of a complete Texinfo file, version 1.0.
- Copyright \copy 2017 Free Software Foundation, Inc.
+ Copyright \copy 2016 Free Software Foundation, Inc.
@end example
-@subsubheading The Top node
+@node Info directory file
+@subsection Info directory file
+@cindex @samp{dir} file, in Texinfo export
+@cindex Texinfo export, @samp{dir} file
+@cindex Info directory file, in Texinfo export
+@cindex Texinfo export, Info directory file
+@cindex @code{install-info} parameters, in Texinfo export
+@cindex Texinfo export, @code{install-info} parameters
@cindex #+TEXINFO_DIR_CATEGORY
@cindex #+TEXINFO_DIR_TITLE
@cindex #+TEXINFO_DIR_DESC
-You may ultimately want to install your new Info file to your system. You
-can write an appropriate entry in the top level directory specifying its
-category and title with, respectively, @code{#+TEXINFO_DIR_CATEGORY} and
-@code{#+TEXINFO_DIR_TITLE}. Optionally, you can add a short description
-using @code{#+TEXINFO_DIR_DESC}. The following example would write an entry
-similar to Org's in the @samp{Top} node.
+The end result of the Texinfo export process is the creation of an Info file.
+This Info file's metadata has variables for category, title, and description:
+@code{#+TEXINFO_DIR_CATEGORY}, @code{#+TEXINFO_DIR_TITLE}, and
+@code{#+TEXINFO_DIR_DESC} that establish where in the Info hierarchy the file
+fits.
+
+Here is an example that writes to the Info directory file:
@example
#+TEXINFO_DIR_CATEGORY: Emacs
@@ -12976,34 +13828,38 @@ similar to Org's in the @samp{Top} node.
#+TEXINFO_DIR_DESC: Outline-based notes management and organizer
@end example
-@node Headings and sectioning structure, Indices, Document preamble, Texinfo export
+@node Headings and sectioning structure
@subsection Headings and sectioning structure
@vindex org-texinfo-classes
@vindex org-texinfo-default-class
@cindex #+TEXINFO_CLASS
-@samp{texinfo} uses a pre-defined scheme, or class, to convert headlines into
-Texinfo structuring commands. For example, a top level headline appears as
-@code{@@chapter} if it should be numbered or as @code{@@unnumbered}
-otherwise. If you need to use a different set of commands, e.g., to start
-with @code{@@part} instead of @code{@@chapter}, install a new class in
-@code{org-texinfo-classes}, then activate it with @code{#+TEXINFO_CLASS}
-keyword. Export process defaults to @code{org-texinfo-default-class} when
-there is no such keyword in the document.
-
-If a headline's level has no associated structuring command, or is below
-a certain threshold @pxref{Export settings}, that headline becomes a list in
-Texinfo output.
+The Texinfo export back-end uses a pre-defined scheme to convert Org
+headlines to an equivalent Texinfo structuring commands. A scheme like this
+maps top-level headlines to numbered chapters tagged as @code{@@chapter} and
+lower-level headlines to unnumbered chapters tagged as @code{@@unnumbered}.
+To override such mappings to introduce @code{@@part} or other Texinfo
+structuring commands, define a new class in @code{org-texinfo-classes}.
+Activate the new class with the @code{#+TEXINFO_CLASS} keyword. When no new
+class is defined and activated, the Texinfo export back-end defaults to the
+@code{org-texinfo-default-class}.
+
+If an Org headline's level has no associated Texinfo structuring command, or
+is below a certain threshold (@pxref{Export settings}), then the Texinfo
+export back-end makes it into a list item.
@cindex property, APPENDIX
-As an exception, a headline with a non-nil @code{:APPENDIX:} property becomes
-an appendix, independently on its level and the class used.
+The Texinfo export back-end makes any headline with a non-@code{nil}
+@code{:APPENDIX:} property into an appendix. This happens independent of the
+Org headline level or the @code{#+TEXINFO_CLASS}.
@cindex property, DESCRIPTION
-Each regular sectioning structure creates a menu entry, named after the
-heading. You can provide a different, e.g., shorter, title in
-@code{:ALT_TITLE:} property (@pxref{Table of contents}). Optionally, you can
-specify a description for the item in @code{:DESCRIPTION:} property. E.g.,
+The Texinfo export back-end creates a menu entry after the Org headline for
+each regular sectioning structure. To override this with a shorter menu
+entry, use the @code{:ALT_TITLE:} property (@pxref{Table of contents}).
+Texinfo menu entries also have an option for a longer @code{:DESCRIPTION:}
+property. Here's an example that uses both to override the default menu
+entry:
@example
* Controlling Screen Display
@@ -13013,30 +13869,51 @@ specify a description for the item in @code{:DESCRIPTION:} property. E.g.,
:END:
@end example
-@node Indices, Quoting Texinfo code, Headings and sectioning structure, Texinfo export
+@cindex The Top node, in Texinfo export
+@cindex Texinfo export, Top node
+The text before the first headline belongs to the @samp{Top} node, i.e., the
+node in which a reader enters an Info manual. As such, it is expected not to
+appear in printed output generated from the @file{.texi} file. @inforef{The
+Top Node,,texinfo}, for more information.
+
+@node Indices
@subsection Indices
@cindex #+CINDEX
+@cindex concept index, in Texinfo export
+@cindex Texinfo export, index, concept
@cindex #+FINDEX
+@cindex function index, in Texinfo export
+@cindex Texinfo export, index, function
@cindex #+KINDEX
+@cindex keystroke index, in Texinfo export
+@cindex Texinfo export, keystroke index
@cindex #+PINDEX
+@cindex program index, in Texinfo export
+@cindex Texinfo export, program index
@cindex #+TINDEX
+@cindex data type index, in Texinfo export
+@cindex Texinfo export, data type index
@cindex #+VINDEX
-Index entries are created using dedicated keywords. @samp{texinfo} back-end
-provides one for each predefined type: @code{#+CINDEX}, @code{#+FINDEX},
-@code{#+KINDEX}, @code{#+PINDEX}, @code{#+TINDEX} and @code{#+VINDEX}. For
-custom indices, you can write raw Texinfo code (@pxref{Quoting Texinfo
-code}).
+@cindex variable index, in Texinfo export
+@cindex Texinfo export, variable index
+The Texinfo export back-end recognizes these indexing keywords if used in the
+Org file: @code{#+CINDEX}, @code{#+FINDEX}, @code{#+KINDEX}, @code{#+PINDEX},
+@code{#+TINDEX}, and @code{#+VINDEX}. Write their value as verbatim Texinfo
+code; in particular, @samp{@{}, @samp{@}} and @samp{@@} characters need to be
+escaped with @samp{@@} if they not belong to a Texinfo command.
@example
#+CINDEX: Defining indexing entries
@end example
@cindex property, INDEX
-To generate an index, you need to set the @code{:INDEX:} property of
-a headline to an appropriate abbreviation (e.g., @samp{cp} or @samp{vr}).
-The headline is then exported as an unnumbered chapter or section command and
-the index is inserted after its contents.
+For the back-end to generate an index entry for a headline, set the
+@code{:INDEX:} property to @samp{cp} or @samp{vr}. These abbreviations come
+from Texinfo that stand for concept index and variable index. The Texinfo
+manual has abbreviations for all other kinds of indexes. The back-end
+exports the headline as an unnumbered chapter or section command, and then
+inserts the index after its contents.
@example
* Concept Index
@@ -13045,78 +13922,140 @@ the index is inserted after its contents.
:END:
@end example
-@node Quoting Texinfo code, Texinfo specific attributes, Indices, Texinfo export
+@node Quoting Texinfo code
@subsection Quoting Texinfo code
-It is possible to insert raw Texinfo code using any of the following
-constructs
+Use any of the following three methods to insert or escape raw Texinfo code:
@cindex #+TEXINFO
-@cindex #+BEGIN_TEXINFO
+@cindex #+BEGIN_EXPORT texinfo
@example
Richard @@@@texinfo:@@sc@{@@@@Stallman@@@@texinfo:@}@@@@ commence' GNU.
#+TEXINFO: @@need800
This paragraph is preceded by...
-#+BEGIN_TEXINFO
+#+BEGIN_EXPORT texinfo
@@auindex Johnson, Mark
@@auindex Lakoff, George
-#+END_TEXINFO
+#+END_EXPORT
@end example
-@node Texinfo specific attributes, An example, Quoting Texinfo code, Texinfo export
-@subsection Texinfo specific attributes
+@node Plain lists in Texinfo export
+@subsection Plain lists in Texinfo export
+@cindex #+ATTR_TEXINFO, in plain lists
+@cindex Two-column tables, in Texinfo export
-@cindex #+ATTR_TEXINFO
-@samp{texinfo} back-end understands several attributes in plain lists and
-tables. They must be specified using an @code{#+ATTR_TEXINFO} keyword,
-written just above the list or table.
+@cindex :table-type attribute, in Texinfo export
+The Texinfo export back-end by default converts description lists in the Org
+file using the default command @code{@@table}, which results in a table with
+two columns. To change this behavior, specify @code{:table-type} with
+@code{ftable} or @code{vtable} attributes. For more information,
+@inforef{Two-column Tables,,texinfo}.
-@subsubheading Plain lists
+@vindex org-texinfo-table-default-markup
+@cindex :indic attribute, in Texinfo export
+The Texinfo export back-end by default also applies a text highlight based on
+the defaults stored in @code{org-texinfo-table-default-markup}. To override
+the default highlight command, specify another one with the @code{:indic}
+attribute.
-In Texinfo output, description lists appear as two-column tables, using the
-default command @code{@@table}. You can use @code{@@ftable} or
-@code{@@vtable}@footnote{For more information, @inforef{Two-column
-Tables,,texinfo}.} instead with @code{:table-type} attribute.
+@cindex Multiple entries in two-column tables, in Texinfo export
+@cindex :sep attribute, in Texinfo export
+Org syntax is limited to one entry per list item. Nevertheless, the Texinfo
+export back-end can split that entry according to any text provided through
+the @code{:sep} attribute. Each part then becomes a new entry in the first
+column of the table.
-@vindex org-texinfo-def-table-markup
-In any case, these constructs require a highlighting command for entries in
-the list. You can provide one with @code{:indic} attribute. If you do not,
-it defaults to the value stored in @code{org-texinfo-def-table-markup}, which
-see.
+The following example illustrates all the attributes above:
@example
-#+ATTR_TEXINFO: :indic @@asis
-- foo :: This is the text for /foo/, with no highlighting.
+#+ATTR_TEXINFO: :table-type vtable :sep , :indic asis
+- foo, bar :: This is the common text for variables foo and bar.
@end example
-@subsubheading Tables
+@noindent
+becomes
+
+@example
+@@vtable @@asis
+@@item foo
+@@itemx bar
+This is the common text for variables foo and bar.
+@@end table
+@end example
-When exporting a table, column widths are deduced from the longest cell in
-each column. You can also define them explicitly as fractions of the line
-length, using @code{:columns} attribute.
+@node Tables in Texinfo export
+@subsection Tables in Texinfo export
+@cindex #+ATTR_TEXINFO, in tables
+
+When exporting tables, the Texinfo export back-end uses the widest cell width
+in each column. To override this and instead specify as fractions of line
+length, use the @code{:columns} attribute. See example below.
@example
#+ATTR_TEXINFO: :columns .5 .5
| a cell | another cell |
@end example
-@node An example, , Texinfo specific attributes, Texinfo export
-@subsection An example
+@node Images in Texinfo export
+@subsection Images in Texinfo export
+@cindex #+ATTR_TEXINFO, in images
-Here is a thorough example, taken from @inforef{GNU Sample Texts,,texinfo}.
+Insert a file link to the image in the Org file, and the Texinfo export
+back-end inserts the image. These links must have the usual supported image
+extensions and no descriptions. To scale the image, use @code{:width} and
+@code{:height} attributes. For alternate text, use @code{:alt} and specify
+the text using Texinfo code, as shown in the example:
-@smallexample
-#+MACRO: version 2.0
-#+MACRO: updated last updated 4 March 2014
+@example
+#+ATTR_TEXINFO: :width 1in :alt Alternate @@i@{text@}
+[[ridt.pdf]]
+@end example
-#+OPTIONS: ':t toc:t author:t email:t
+@node Special blocks in Texinfo export
+@subsection Special blocks
+@cindex #+ATTR_TEXINFO, in special blocks
+
+The Texinfo export back-end converts special blocks to commands with the same
+name. It also adds any @code{:options} attributes to the end of the command,
+as shown in this example:
+
+@example
+#+ATTR_TEXINFO: :options org-org-export-to-org ...
+#+begin_defun
+A somewhat obsessive function.
+#+end_defun
+@end example
+
+@noindent
+becomes
+
+@example
+@@defun org-org-export-to-org ...
+A somewhat obsessive function.
+@@end defun
+@end example
+
+@node A Texinfo example
+@subsection A Texinfo example
+
+Here is a more detailed example Org file. See @ref{GNU Sample
+Texts,,,texinfo,GNU Texinfo Manual} for an equivalent example using Texinfo
+code.
+
+@example
#+TITLE: GNU Sample @{@{@{version@}@}@}
+#+SUBTITLE: for version @{@{@{version@}@}@}, @{@{@{updated@}@}@}
#+AUTHOR: A.U. Thor
#+EMAIL: bug-sample@@gnu.org
+
+#+OPTIONS: ':t toc:t author:t email:t
#+LANGUAGE: en
+#+MACRO: version 2.0
+#+MACRO: updated last updated 4 March 2014
+
#+TEXINFO_FILENAME: sample.info
#+TEXINFO_HEADER: @@syncodeindex pg cp
@@ -13125,7 +14064,9 @@ Here is a thorough example, taken from @inforef{GNU Sample Texts,,texinfo}.
#+TEXINFO_DIR_DESC: Invoking sample
#+TEXINFO_PRINTED_TITLE: GNU Sample
-#+SUBTITLE: for version 2.0, last updated 4 March 2014
+
+This manual is for GNU Sample (version @{@{@{version@}@}@},
+@{@{@{updated@}@}@}).
* Copying
:PROPERTIES:
@@ -13135,8 +14076,7 @@ Here is a thorough example, taken from @inforef{GNU Sample Texts,,texinfo}.
This manual is for GNU Sample (version @{@{@{version@}@}@},
@{@{@{updated@}@}@}), which is an example in the Texinfo documentation.
- Copyright @@@@texinfo:@@copyright@{@}@@@@ 2013 Free Software Foundation,
- Inc.
+ Copyright \copy 2016 Free Software Foundation, Inc.
#+BEGIN_QUOTE
Permission is granted to copy, distribute and/or modify this
@@ -13167,9 +14107,9 @@ Here is a thorough example, taken from @inforef{GNU Sample Texts,,texinfo}.
:PROPERTIES:
:INDEX: cp
:END:
-@end smallexample
+@end example
-@node iCalendar export, Other built-in back-ends, Texinfo export, Exporting
+@node iCalendar export
@section iCalendar export
@cindex iCalendar export
@@ -13178,49 +14118,51 @@ Here is a thorough example, taken from @inforef{GNU Sample Texts,,texinfo}.
@vindex org-icalendar-use-scheduled
@vindex org-icalendar-categories
@vindex org-icalendar-alarm-time
-Some people use Org mode for keeping track of projects, but still prefer a
-standard calendar application for anniversaries and appointments. In this
-case it can be useful to show deadlines and other time-stamped items in Org
-files in the calendar application. Org mode can export calendar information
-in the standard iCalendar format. If you also want to have TODO entries
-included in the export, configure the variable
-@code{org-icalendar-include-todo}. Plain timestamps are exported as VEVENT,
-and TODO items as VTODO@. It will also create events from deadlines that are
-in non-TODO items. Deadlines and scheduling dates in TODO items will be used
-to set the start and due dates for the TODO entry@footnote{See the variables
-@code{org-icalendar-use-deadline} and @code{org-icalendar-use-scheduled}.}.
-As categories, it will use the tags locally defined in the heading, and the
-file/tree category@footnote{To add inherited tags or the TODO state,
-configure the variable @code{org-icalendar-categories}.}. See the variable
-@code{org-icalendar-alarm-time} for a way to assign alarms to entries with a
-time.
+A large part of Org mode's inter-operability success is its ability to easily
+export to or import from external applications. The iCalendar export
+back-end takes calendar data from Org files and exports to the standard
+iCalendar format.
+
+The iCalendar export back-end can also incorporate TODO entries based on the
+configuration of the @code{org-icalendar-include-todo} variable. The
+back-end exports plain timestamps as VEVENT, TODO items as VTODO, and also
+create events from deadlines that are in non-TODO items. The back-end uses
+the deadlines and scheduling dates in Org TODO items for setting the start
+and due dates for the iCalendar TODO entry. Consult the
+@code{org-icalendar-use-deadline} and @code{org-icalendar-use-scheduled}
+variables for more details.
+
+For tags on the headline, the iCalendar export back-end makes them into
+iCalendar categories. To tweak the inheritance of tags and TODO states,
+configure the variable @code{org-icalendar-categories}. To assign clock
+alarms based on time, configure the @code{org-icalendar-alarm-time} variable.
@vindex org-icalendar-store-UID
@cindex property, ID
-The iCalendar standard requires each entry to have a globally unique
-identifier (UID). Org creates these identifiers during export. If you set
-the variable @code{org-icalendar-store-UID}, the UID will be stored in the
-@code{:ID:} property of the entry and re-used next time you report this
-entry. Since a single entry can give rise to multiple iCalendar entries (as
-a timestamp, a deadline, a scheduled item, and as a TODO item), Org adds
-prefixes to the UID, depending on what triggered the inclusion of the entry.
-In this way the UID remains unique, but a synchronization program can still
-figure out from which entry all the different instances originate.
+The iCalendar format standard requires globally unique identifier---UID---for
+each entry. The iCalendar export back-end creates UIDs during export. To
+save a copy of the UID in the Org file set the variable
+@code{org-icalendar-store-UID}. The back-end looks for the @code{:ID:}
+property of the entry for re-using the same UID for subsequent exports.
+
+Since a single Org entry can result in multiple iCalendar entries---as
+timestamp, deadline, scheduled item, or TODO item---Org adds prefixes to the
+UID, depending on which part of the Org entry triggered the creation of the
+iCalendar entry. Prefixing ensures UIDs remains unique, yet enable
+synchronization programs trace the connections.
@table @kbd
@orgcmd{C-c C-e c f,org-icalendar-export-to-ics}
-Create iCalendar entries for the current buffer and store them in the same
-directory, using a file extension @file{.ics}.
+Create iCalendar entries from the current Org buffer and store them in the
+same directory, using a file extension @file{.ics}.
@orgcmd{C-c C-e c a, org-icalendar-export-agenda-files}
@vindex org-agenda-files
-Like @kbd{C-c C-e c f}, but do this for all files in
-@code{org-agenda-files}. For each of these files, a separate iCalendar
-file will be written.
+Create iCalendar entries from Org files in @code{org-agenda-files} and store
+in a separate iCalendar file for each Org file.
@orgcmd{C-c C-e c c,org-icalendar-combine-agenda-files}
@vindex org-icalendar-combined-agenda-file
-Create a single large iCalendar file from all files in
-@code{org-agenda-files} and write it to the file given by
-@code{org-icalendar-combined-agenda-file}.
+Create a combined iCalendar file from Org files in @code{org-agenda-files}
+and write it to @code{org-icalendar-combined-agenda-file} file name.
@end table
@vindex org-use-property-inheritance
@@ -13228,72 +14170,61 @@ Create a single large iCalendar file from all files in
@cindex property, SUMMARY
@cindex property, DESCRIPTION
@cindex property, LOCATION
-The export will honor SUMMARY, DESCRIPTION and LOCATION@footnote{The LOCATION
-property can be inherited from higher in the hierarchy if you configure
-@code{org-use-property-inheritance} accordingly.} properties if the selected
-entries have them. If not, the summary will be derived from the headline,
-and the description from the body (limited to
-@code{org-icalendar-include-body} characters).
-
-How this calendar is best read and updated, depends on the application
-you are using. The FAQ covers this issue.
-
-@node Other built-in back-ends, Export in foreign buffers, iCalendar export, Exporting
+@cindex property, TIMEZONE
+The iCalendar export back-end includes SUMMARY, DESCRIPTION, LOCATION and
+TIMEZONE properties from the Org entries when exporting. To force the
+back-end to inherit the LOCATION and TIMEZONE properties, configure the
+@code{org-use-property-inheritance} variable.
+
+When Org entries do not have SUMMARY, DESCRIPTION and LOCATION properties,
+the iCalendar export back-end derives the summary from the headline, and
+derives the description from the body of the Org item. The
+@code{org-icalendar-include-body} variable limits the maximum number of
+characters of the content are turned into its description.
+
+The TIMEZONE property can be used to specify a per-entry time zone, and will
+be applied to any entry with timestamp information. Time zones should be
+specified as per the IANA time zone database format, e.g.@: ``Asia/Almaty''.
+Alternately, the property value can be ``UTC'', to force UTC time for this
+entry only.
+
+Exporting to iCalendar format depends in large part on the capabilities of
+the destination application. Some are more lenient than others. Consult the
+Org mode FAQ for advice on specific applications.
+
+@node Other built-in back-ends
@section Other built-in back-ends
@cindex export back-ends, built-in
@vindex org-export-backends
-On top of the aforementioned back-ends, Org comes with other built-in ones:
+Other export back-ends included with Org are:
@itemize
@item @file{ox-man.el}: export to a man page.
@end itemize
-To activate these export back-end, customize @code{org-export-backends} or
-load them directly with e.g., @code{(require 'ox-man)}. This will add new
-keys in the export dispatcher (@pxref{The Export Dispatcher}).
-
-See the comment section of these files for more information on how to use
-them.
-
-@node Export in foreign buffers, Advanced configuration, Other built-in back-ends, Exporting
-@section Export in foreign buffers
-
-Most built-in back-ends come with a command to convert the selected region
-into a selected format and replace this region by the exported output. Here
-is a list of such conversion commands:
-
-@table @code
-@item org-html-convert-region-to-html
-Convert the selected region into HTML.
-@item org-latex-convert-region-to-latex
-Convert the selected region into @LaTeX{}.
-@item org-texinfo-convert-region-to-texinfo
-Convert the selected region into @code{Texinfo}.
-@item org-md-convert-region-to-md
-Convert the selected region into @code{MarkDown}.
-@end table
+To activate such back-ends, either customize @code{org-export-backends} or
+load directly with @code{(require 'ox-man)}. On successful load, the
+back-end adds new keys in the export dispatcher (@pxref{The export
+dispatcher}).
-This is particularly useful for converting tables and lists in foreign
-buffers. E.g., in an HTML buffer, you can turn on @code{orgstruct-mode}, then
-use Org commands for editing a list, and finally select and convert the list
-with @code{M-x org-html-convert-region-to-html RET}.
+Follow the comment section of such files, for example, @file{ox-man.el}, for
+usage and configuration details.
-@node Advanced configuration, , Export in foreign buffers, Exporting
+@node Advanced configuration
@section Advanced configuration
@subheading Hooks
@vindex org-export-before-processing-hook
@vindex org-export-before-parsing-hook
-Two hooks are run during the first steps of the export process. The first
-one, @code{org-export-before-processing-hook} is called before expanding
-macros, Babel code and include keywords in the buffer. The second one,
-@code{org-export-before-parsing-hook}, as its name suggests, happens just
-before parsing the buffer. Their main use is for heavy duties, that is
-duties involving structural modifications of the document. For example, one
-may want to remove every headline in the buffer during export. The following
-code can achieve this:
+The export process executes two hooks before the actual exporting begins.
+The first hook, @code{org-export-before-processing-hook}, runs before any
+expansions of macros, Babel code, and include keywords in the buffer. The
+second hook, @code{org-export-before-parsing-hook}, runs before the buffer is
+parsed. Both hooks are specified as functions, see example below. Their main
+use is for heavy duty structural modifications of the Org content. For
+example, removing every headline in the buffer during export:
@lisp
@group
@@ -13307,86 +14238,83 @@ BACKEND is the export back-end being used, as a symbol."
@end group
@end lisp
-Note that functions used in these hooks require a mandatory argument,
-a symbol representing the back-end used.
+Note that the hook function must have a mandatory argument that is a symbol
+for the back-end.
@subheading Filters
@cindex Filters, exporting
-Filters are lists of functions applied on a specific part of the output from
-a given back-end. More explicitly, each time a back-end transforms an Org
-object or element into another language, all functions within a given filter
-type are called in turn on the string produced. The string returned by the
-last function will be the one used in the final output.
-
-There are filters sets for each type of element or object, for plain text,
-for the parse tree, for the export options and for the final output. They
-are all named after the same scheme: @code{org-export-filter-TYPE-functions},
-where @code{TYPE} is the type targeted by the filter. Valid types are:
+The Org export process relies on filters to process specific parts of
+conversion process. Filters are just lists of functions to be applied to
+certain parts for a given back-end. The output from the first function in
+the filter is passed on to the next function in the filter. The final output
+is the output from the final function in the filter.
+
+The Org export process has many filter sets applicable to different types of
+objects, plain text, parse trees, export options, and final output formats.
+The filters are named after the element type or object type:
+@code{org-export-filter-TYPE-functions}, where @code{TYPE} is the type
+targeted by the filter. Valid types are:
@multitable @columnfractions .33 .33 .33
-@item bold
+@item body
+@tab bold
@tab babel-call
-@tab center-block
-@item clock
+@item center-block
+@tab clock
@tab code
-@tab comment
-@item comment-block
-@tab diary-sexp
+@item diary-sexp
@tab drawer
-@item dynamic-block
-@tab entity
+@tab dynamic-block
+@item entity
@tab example-block
-@item export-block
-@tab export-snippet
+@tab export-block
+@item export-snippet
@tab final-output
-@item fixed-width
-@tab footnote-definition
+@tab fixed-width
+@item footnote-definition
@tab footnote-reference
-@item headline
-@tab horizontal-rule
+@tab headline
+@item horizontal-rule
@tab inline-babel-call
-@item inline-src-block
-@tab inlinetask
+@tab inline-src-block
+@item inlinetask
@tab italic
-@item item
-@tab keyword
+@tab item
+@item keyword
@tab latex-environment
-@item latex-fragment
-@tab line-break
+@tab latex-fragment
+@item line-break
@tab link
-@item node-property
-@tab options
+@tab node-property
+@item options
@tab paragraph
-@item parse-tree
-@tab plain-list
+@tab parse-tree
+@item plain-list
@tab plain-text
-@item planning
-@tab property-drawer
+@tab planning
+@item property-drawer
@tab quote-block
-@item quote-section
@tab radio-target
-@tab section
-@item special-block
+@item section
+@tab special-block
@tab src-block
-@tab statistics-cookie
-@item strike-through
+@item statistics-cookie
+@tab strike-through
@tab subscript
-@tab superscript
-@item table
+@item superscript
+@tab table
@tab table-cell
-@tab table-row
-@item target
+@item table-row
+@tab target
@tab timestamp
-@tab underline
-@item verbatim
+@item underline
+@tab verbatim
@tab verse-block
-@tab
@end multitable
-For example, the following snippet allows me to use non-breaking spaces in
-the Org buffer and get them translated into @LaTeX{} without using the
-@code{\nbsp} macro (where @code{_} stands for the non-breaking space):
+Here is an example filter that replaces non-breaking spaces @code{~} in the
+Org buffer with @code{_} for the @LaTeX{} back-end.
@lisp
@group
@@ -13400,33 +14328,49 @@ the Org buffer and get them translated into @LaTeX{} without using the
@end group
@end lisp
-Three arguments must be provided to a filter: the code being changed, the
-back-end used, and some information about the export process. You can safely
-ignore the third argument for most purposes. Note the use of
-@code{org-export-derived-backend-p}, which ensures that the filter will only
-be applied when using @code{latex} back-end or any other back-end derived
-from it (e.g., @code{beamer}).
+A filter requires three arguments: the code to be transformed, the name of
+the back-end, and some optional information about the export process. The
+third argument can be safely ignored. Note the use of
+@code{org-export-derived-backend-p} predicate that tests for @code{latex}
+back-end or any other back-end, such as @code{beamer}, derived from
+@code{latex}.
-@subheading Extending an existing back-end
+@subheading Defining filters for individual files
+
+The Org export can filter not just for back-ends, but also for specific files
+through the @code{#+BIND} keyword. Here is an example with two filters; one
+removes brackets from time stamps, and the other removes strike-through text.
+The filter functions are defined in a @samp{src} code block in the same Org
+file, which is a handy location for debugging.
+
+@example
+#+BIND: org-export-filter-timestamp-functions (tmp-f-timestamp)
+#+BIND: org-export-filter-strike-through-functions (tmp-f-strike-through)
+#+begin_src emacs-lisp :exports results :results none
+ (defun tmp-f-timestamp (s backend info)
+ (replace-regexp-in-string "&[lg]t;\\|[][]" "" s))
+ (defun tmp-f-strike-through (s backend info) "")
+#+end_src
+@end example
-This is obviously the most powerful customization, since the changes happen
-at the parser level. Indeed, some export back-ends are built as extensions
-of other ones (e.g., Markdown back-end an extension of HTML back-end).
+@subheading Extending an existing back-end
-Extending a back-end means that if an element type is not transcoded by the
-new back-end, it will be handled by the original one. Hence you can extend
-specific parts of a back-end without too much work.
+Some parts of the conversion process can be extended for certain elements so
+as to introduce a new or revised translation. That is how the HTML export
+back-end was extended to handle Markdown format. The extensions work
+seamlessly so any aspect of filtering not done by the extended back-end is
+handled by the original back-end. Of all the export customization in Org,
+extending is very powerful as it operates at the parser level.
-As an example, imagine we want the @code{ascii} back-end to display the
-language used in a source block, when it is available, but only when some
-attribute is non-@code{nil}, like the following:
+For this example, make the @code{ascii} back-end display the language used in
+a source code block. Also make it display only when some attribute is
+non-@code{nil}, like the following:
@example
#+ATTR_ASCII: :language t
@end example
-Because that back-end is lacking in that area, we are going to create a new
-back-end, @code{my-ascii} that will do the job.
+Then extend @code{ascii} back-end with a custom @code{my-ascii} back-end.
@lisp
@group
@@ -13450,20 +14394,47 @@ channel."
@end lisp
The @code{my-ascii-src-block} function looks at the attribute above the
-element. If it isn't true, it gives hand to the @code{ascii} back-end.
-Otherwise, it creates a box around the code, leaving room for the language.
-A new back-end is then created. It only changes its behavior when
-translating @code{src-block} type element. Now, all it takes to use the new
-back-end is calling the following from an Org buffer:
+current element. If not true, hands over to @code{ascii} back-end. If true,
+which it is in this example, it creates a box around the code and leaves room
+for the inserting a string for language. The last form creates the new
+back-end that springs to action only when translating @code{src-block} type
+elements.
+
+To use the newly defined back-end, call the following from an Org buffer:
@smalllisp
(org-export-to-buffer 'my-ascii "*Org MY-ASCII Export*")
@end smalllisp
-It is obviously possible to write an interactive function for this, install
-it in the export dispatcher menu, and so on.
+Further steps to consider would be an interactive function, self-installing
+an item in the export dispatcher menu, and other user-friendly improvements.
+
+@node Export in foreign buffers
+@section Export in foreign buffers
+
+The export back-ends in Org often include commands to convert selected
+regions. A convenient feature of this in-place conversion is that the
+exported output replaces the original source. Here are such functions:
+
+@table @code
+@item org-html-convert-region-to-html
+Convert the selected region into HTML.
+@item org-latex-convert-region-to-latex
+Convert the selected region into @LaTeX{}.
+@item org-texinfo-convert-region-to-texinfo
+Convert the selected region into @code{Texinfo}.
+@item org-md-convert-region-to-md
+Convert the selected region into @code{MarkDown}.
+@end table
+
+In-place conversions are particularly handy for quick conversion of tables
+and lists in foreign buffers. For example, turn on the minor mode @code{M-x
+orgstruct-mode} in an HTML buffer, then use the convenient Org keyboard
+commands to create a list, select it, and covert it to HTML with @code{M-x
+org-html-convert-region-to-html RET}.
-@node Publishing, Working With Source Code, Exporting, Top
+
+@node Publishing
@chapter Publishing
@cindex publishing
@@ -13485,7 +14456,7 @@ Publishing has been contributed to Org by David O'Toole.
* Triggering publication:: Publication commands
@end menu
-@node Configuration, Uploading files, Publishing, Publishing
+@node Configuration
@section Configuration
Publishing needs significant configuration to specify files, destination
@@ -13502,7 +14473,7 @@ and many other properties of a project.
* Generating an index:: An index that reaches across pages
@end menu
-@node Project alist, Sources and destinations, Configuration, Configuration
+@node Project alist
@subsection The variable @code{org-publish-project-alist}
@cindex org-publish-project-alist
@cindex projects, for publishing
@@ -13529,7 +14500,7 @@ together files requiring different publishing options. When you publish such
a ``meta-project'', all the components will also be published, in the
sequence given.
-@node Sources and destinations, Selecting files, Project alist, Configuration
+@node Sources and destinations
@subsection Sources and destinations for files
@cindex directories, for publishing
@@ -13548,17 +14519,17 @@ use external tools to upload your website (@pxref{Uploading files}).
@item @code{:preparation-function}
@tab Function or list of functions to be called before starting the
publishing process, for example, to run @code{make} for updating files to be
-published. The project property list is scoped into this call as the
-variable @code{project-plist}.
+published. Each preparation function is called with a single argument, the
+project property list.
@item @code{:completion-function}
@tab Function or list of functions called after finishing the publishing
-process, for example, to change permissions of the resulting files. The
-project property list is scoped into this call as the variable
-@code{project-plist}.
+process, for example, to change permissions of the resulting files. Each
+completion function is called with a single argument, the project property
+list.
@end multitable
@noindent
-@node Selecting files, Publishing action, Sources and destinations, Configuration
+@node Selecting files
@subsection Selecting files
@cindex files, selecting for publishing
@@ -13584,7 +14555,7 @@ and @code{:exclude}.
@tab non-@code{nil} means, check base-directory recursively for files to publish.
@end multitable
-@node Publishing action, Publishing options, Selecting files, Configuration
+@node Publishing action
@subsection Publishing action
@cindex action, for publishing
@@ -13623,46 +14594,26 @@ and the path to the publishing directory of the output file. It should take
the specified file, make the necessary transformation (if any) and place the
result into the destination folder.
-@node Publishing options, Publishing links, Publishing action, Configuration
+@node Publishing options
@subsection Options for the exporters
@cindex options, for publishing
-The property list can be used to set many export options for the exporters.
-In most cases, these properties correspond to user variables in Org. The
-first table below lists these properties along with the variable they belong
-to. The second table list HTML specific properties. See the documentation
-string of these options for details.
+The property list can be used to set export options during the publishing
+process. In most cases, these properties correspond to user variables in
+Org. While some properties are available for all export back-ends, most of
+them are back-end specific. The following sections list properties along
+with the variable they belong to. See the documentation string of these
+options for details.
-@vindex org-display-custom-times
-@vindex org-export-default-language
-@vindex org-export-exclude-tags
-@vindex org-export-headline-levels
-@vindex org-export-preserve-breaks
-@vindex org-export-publishing-directory
-@vindex org-export-select-tags
-@vindex org-export-with-archived-trees
-@vindex org-export-with-author
-@vindex org-export-with-creator
-@vindex org-export-with-drawers
-@vindex org-export-with-email
-@vindex org-export-with-emphasize
-@vindex org-export-with-fixed-width
-@vindex org-export-with-footnotes
-@vindex org-export-with-latex
-@vindex org-export-with-planning
-@vindex org-export-with-priority
-@vindex org-export-with-section-numbers
-@vindex org-export-with-special-strings
-@vindex org-export-with-sub-superscripts
-@vindex org-export-with-tables
-@vindex org-export-with-tags
-@vindex org-export-with-tasks
-@vindex org-export-with-timestamps
-@vindex org-export-with-toc
-@vindex org-export-with-todo-keywords
-@vindex user-mail-address
+@vindex org-publish-project-alist
+When a property is given a value in @code{org-publish-project-alist}, its
+setting overrides the value of the corresponding user variable (if any)
+during publishing. Options set within a file (@pxref{Export settings}),
+however, override everything.
+
+@subsubheading Generic properties
-@multitable @columnfractions 0.32 0.68
+@multitable {@code{:with-sub-superscript}} {@code{org-export-with-sub-superscripts}}
@item @code{:archived-trees} @tab @code{org-export-with-archived-trees}
@item @code{:exclude-tags} @tab @code{org-export-exclude-tags}
@item @code{:headline-levels} @tab @code{org-export-headline-levels}
@@ -13671,7 +14622,10 @@ string of these options for details.
@item @code{:section-numbers} @tab @code{org-export-with-section-numbers}
@item @code{:select-tags} @tab @code{org-export-select-tags}
@item @code{:with-author} @tab @code{org-export-with-author}
+@item @code{:with-broken-links} @tab @code{org-export-with-broken-links}
+@item @code{:with-clocks} @tab @code{org-export-with-clocks}
@item @code{:with-creator} @tab @code{org-export-with-creator}
+@item @code{:with-date} @tab @code{org-export-with-date}
@item @code{:with-drawers} @tab @code{org-export-with-drawers}
@item @code{:with-email} @tab @code{org-export-with-email}
@item @code{:with-emphasize} @tab @code{org-export-with-emphasize}
@@ -13680,83 +14634,225 @@ string of these options for details.
@item @code{:with-latex} @tab @code{org-export-with-latex}
@item @code{:with-planning} @tab @code{org-export-with-planning}
@item @code{:with-priority} @tab @code{org-export-with-priority}
+@item @code{:with-properties} @tab @code{org-export-with-properties}
@item @code{:with-special-strings} @tab @code{org-export-with-special-strings}
@item @code{:with-sub-superscript} @tab @code{org-export-with-sub-superscripts}
@item @code{:with-tables} @tab @code{org-export-with-tables}
@item @code{:with-tags} @tab @code{org-export-with-tags}
@item @code{:with-tasks} @tab @code{org-export-with-tasks}
@item @code{:with-timestamps} @tab @code{org-export-with-timestamps}
+@item @code{:with-title} @tab @code{org-export-with-title}
@item @code{:with-toc} @tab @code{org-export-with-toc}
@item @code{:with-todo-keywords} @tab @code{org-export-with-todo-keywords}
@end multitable
-@vindex org-html-doctype
-@vindex org-html-container-element
-@vindex org-html-html5-fancy
-@vindex org-html-xml-declaration
-@vindex org-html-link-up
-@vindex org-html-link-home
-@vindex org-html-link-org-files-as-html
-@vindex org-html-link-use-abs-url
-@vindex org-html-head
-@vindex org-html-head-extra
-@vindex org-html-inline-images
-@vindex org-html-extension
-@vindex org-html-preamble
-@vindex org-html-postamble
-@vindex org-html-table-default-attributes
-@vindex org-html-table-row-tags
-@vindex org-html-head-include-default-style
-@vindex org-html-head-include-scripts
-@multitable @columnfractions 0.32 0.68
-@item @code{:html-doctype} @tab @code{org-html-doctype}
-@item @code{:html-container} @tab @code{org-html-container-element}
-@item @code{:html-html5-fancy} @tab @code{org-html-html5-fancy}
-@item @code{:html-xml-declaration} @tab @code{org-html-xml-declaration}
-@item @code{:html-link-up} @tab @code{org-html-link-up}
-@item @code{:html-link-home} @tab @code{org-html-link-home}
-@item @code{:html-link-org-as-html} @tab @code{org-html-link-org-files-as-html}
-@item @code{:html-link-use-abs-url} @tab @code{org-html-link-use-abs-url}
-@item @code{:html-head} @tab @code{org-html-head}
-@item @code{:html-head-extra} @tab @code{org-html-head-extra}
-@item @code{:html-inline-images} @tab @code{org-html-inline-images}
-@item @code{:html-extension} @tab @code{org-html-extension}
-@item @code{:html-preamble} @tab @code{org-html-preamble}
-@item @code{:html-postamble} @tab @code{org-html-postamble}
-@item @code{:html-table-attributes} @tab @code{org-html-table-default-attributes}
-@item @code{:html-table-row-tags} @tab @code{org-html-table-row-tags}
+@subsubheading ASCII specific properties
+
+@multitable {@code{:ascii-table-keep-all-vertical-lines}} {@code{org-ascii-table-keep-all-vertical-lines}}
+@item @code{:ascii-bullets} @tab @code{org-ascii-bullets}
+@item @code{:ascii-caption-above} @tab @code{org-ascii-caption-above}
+@item @code{:ascii-charset} @tab @code{org-ascii-charset}
+@item @code{:ascii-global-margin} @tab @code{org-ascii-global-margin}
+@item @code{:ascii-format-drawer-function} @tab @code{org-ascii-format-drawer-function}
+@item @code{:ascii-format-inlinetask-function} @tab @code{org-ascii-format-inlinetask-function}
+@item @code{:ascii-headline-spacing} @tab @code{org-ascii-headline-spacing}
+@item @code{:ascii-indented-line-width} @tab @code{org-ascii-indented-line-width}
+@item @code{:ascii-inlinetask-width} @tab @code{org-ascii-inlinetask-width}
+@item @code{:ascii-inner-margin} @tab @code{org-ascii-inner-margin}
+@item @code{:ascii-links-to-notes} @tab @code{org-ascii-links-to-notes}
+@item @code{:ascii-list-margin} @tab @code{org-ascii-list-margin}
+@item @code{:ascii-paragraph-spacing} @tab @code{org-ascii-paragraph-spacing}
+@item @code{:ascii-quote-margin} @tab @code{org-ascii-quote-margin}
+@item @code{:ascii-table-keep-all-vertical-lines} @tab @code{org-ascii-table-keep-all-vertical-lines}
+@item @code{:ascii-table-use-ascii-art} @tab @code{org-ascii-table-use-ascii-art}
+@item @code{:ascii-table-widen-columns} @tab @code{org-ascii-table-widen-columns}
+@item @code{:ascii-text-width} @tab @code{org-ascii-text-width}
+@item @code{:ascii-underline} @tab @code{org-ascii-underline}
+@item @code{:ascii-verbatim-format} @tab @code{org-ascii-verbatim-format}
+@end multitable
+
+@subsubheading Beamer specific properties
+
+@multitable {@code{:beamer-frame-default-options}} {@code{org-beamer-frame-default-options}}
+@item @code{:beamer-theme} @tab @code{org-beamer-theme}
+@item @code{:beamer-column-view-format} @tab @code{org-beamer-column-view-format}
+@item @code{:beamer-environments-extra} @tab @code{org-beamer-environments-extra}
+@item @code{:beamer-frame-default-options} @tab @code{org-beamer-frame-default-options}
+@item @code{:beamer-outline-frame-options} @tab @code{org-beamer-outline-frame-options}
+@item @code{:beamer-outline-frame-title} @tab @code{org-beamer-outline-frame-title}
+@item @code{:beamer-subtitle-format} @tab @code{org-beamer-subtitle-format}
+@end multitable
+
+@subsubheading HTML specific properties
+
+@multitable {@code{:html-table-use-header-tags-for-first-column}} {@code{org-html-table-use-header-tags-for-first-column}}
+@item @code{:html-allow-name-attribute-in-anchors} @tab @code{org-html-allow-name-attribute-in-anchors}
+@item @code{:html-checkbox-type} @tab @code{org-html-checkbox-type}
+@item @code{:html-container} @tab @code{org-html-container-element}
+@item @code{:html-divs} @tab @code{org-html-divs}
+@item @code{:html-doctype} @tab @code{org-html-doctype}
+@item @code{:html-extension} @tab @code{org-html-extension}
+@item @code{:html-footnote-format} @tab @code{org-html-footnote-format}
+@item @code{:html-footnote-separator} @tab @code{org-html-footnote-separator}
+@item @code{:html-footnotes-section} @tab @code{org-html-footnotes-section}
+@item @code{:html-format-drawer-function} @tab @code{org-html-format-drawer-function}
+@item @code{:html-format-headline-function} @tab @code{org-html-format-headline-function}
+@item @code{:html-format-inlinetask-function} @tab @code{org-html-format-inlinetask-function}
+@item @code{:html-head-extra} @tab @code{org-html-head-extra}
@item @code{:html-head-include-default-style} @tab @code{org-html-head-include-default-style}
-@item @code{:html-head-include-scripts} @tab @code{org-html-head-include-scripts}
+@item @code{:html-head-include-scripts} @tab @code{org-html-head-include-scripts}
+@item @code{:html-head} @tab @code{org-html-head}
+@item @code{:html-home/up-format} @tab @code{org-html-home/up-format}
+@item @code{:html-html5-fancy} @tab @code{org-html-html5-fancy}
+@item @code{:html-indent} @tab @code{org-html-indent}
+@item @code{:html-infojs-options} @tab @code{org-html-infojs-options}
+@item @code{:html-infojs-template} @tab @code{org-html-infojs-template}
+@item @code{:html-inline-image-rules} @tab @code{org-html-inline-image-rules}
+@item @code{:html-inline-images} @tab @code{org-html-inline-images}
+@item @code{:html-link-home} @tab @code{org-html-link-home}
+@item @code{:html-link-org-files-as-html} @tab @code{org-html-link-org-files-as-html}
+@item @code{:html-link-up} @tab @code{org-html-link-up}
+@item @code{:html-link-use-abs-url} @tab @code{org-html-link-use-abs-url}
+@item @code{:html-mathjax-options} @tab @code{org-html-mathjax-options}
+@item @code{:html-mathjax-template} @tab @code{org-html-mathjax-template}
+@item @code{:html-metadata-timestamp-format} @tab @code{org-html-metadata-timestamp-format}
+@item @code{:html-postamble-format} @tab @code{org-html-postamble-format}
+@item @code{:html-postamble} @tab @code{org-html-postamble}
+@item @code{:html-preamble-format} @tab @code{org-html-preamble-format}
+@item @code{:html-preamble} @tab @code{org-html-preamble}
+@item @code{:html-table-align-individual-fields} @tab @code{org-html-table-align-individual-fields}
+@item @code{:html-table-attributes} @tab @code{org-html-table-default-attributes}
+@item @code{:html-table-caption-above} @tab @code{org-html-table-caption-above}
+@item @code{:html-table-data-tags} @tab @code{org-html-table-data-tags}
+@item @code{:html-table-header-tags} @tab @code{org-html-table-header-tags}
+@item @code{:html-table-row-tags} @tab @code{org-html-table-row-tags}
+@item @code{:html-table-use-header-tags-for-first-column} @tab @code{org-html-table-use-header-tags-for-first-column}
+@item @code{:html-tag-class-prefix} @tab @code{org-html-tag-class-prefix}
+@item @code{:html-text-markup-alist} @tab @code{org-html-text-markup-alist}
+@item @code{:html-todo-kwd-class-prefix} @tab @code{org-html-todo-kwd-class-prefix}
+@item @code{:html-toplevel-hlevel} @tab @code{org-html-toplevel-hlevel}
+@item @code{:html-use-infojs} @tab @code{org-html-use-infojs}
+@item @code{:html-validation-link} @tab @code{org-html-validation-link}
+@item @code{:html-viewport} @tab @code{org-html-viewport}
+@item @code{:html-xml-declaration} @tab @code{org-html-xml-declaration}
@end multitable
-Most of the @code{org-export-with-*} variables have the same effect in each
-exporter.
+@subsubheading @LaTeX{} specific properties
+
+@multitable {@code{:latex-link-with-unknown-path-format}} {@code{org-latex-link-with-unknown-path-format}}
+@item @code{:latex-active-timestamp-format} @tab @code{org-latex-active-timestamp-format}
+@item @code{:latex-caption-above} @tab @code{org-latex-caption-above}
+@item @code{:latex-classes} @tab @code{org-latex-classes}
+@item @code{:latex-class} @tab @code{org-latex-default-class}
+@item @code{:latex-compiler} @tab @code{org-latex-compiler}
+@item @code{:latex-default-figure-position} @tab @code{org-latex-default-figure-position}
+@item @code{:latex-default-table-environment} @tab @code{org-latex-default-table-environment}
+@item @code{:latex-default-table-mode} @tab @code{org-latex-default-table-mode}
+@item @code{:latex-diary-timestamp-format} @tab @code{org-latex-diary-timestamp-format}
+@item @code{:latex-footnote-defined-format} @tab @code{org-latex-footnote-defined-format}
+@item @code{:latex-footnote-separator} @tab @code{org-latex-footnote-separator}
+@item @code{:latex-format-drawer-function} @tab @code{org-latex-format-drawer-function}
+@item @code{:latex-format-headline-function} @tab @code{org-latex-format-headline-function}
+@item @code{:latex-format-inlinetask-function} @tab @code{org-latex-format-inlinetask-function}
+@item @code{:latex-hyperref-template} @tab @code{org-latex-hyperref-template}
+@item @code{:latex-image-default-height} @tab @code{org-latex-image-default-height}
+@item @code{:latex-image-default-option} @tab @code{org-latex-image-default-option}
+@item @code{:latex-image-default-width} @tab @code{org-latex-image-default-width}
+@item @code{:latex-images-centered} @tab @code{org-latex-images-centered}
+@item @code{:latex-inactive-timestamp-format} @tab @code{org-latex-inactive-timestamp-format}
+@item @code{:latex-inline-image-rules} @tab @code{org-latex-inline-image-rules}
+@item @code{:latex-link-with-unknown-path-format} @tab @code{org-latex-link-with-unknown-path-format}
+@item @code{:latex-listings-langs} @tab @code{org-latex-listings-langs}
+@item @code{:latex-listings-options} @tab @code{org-latex-listings-options}
+@item @code{:latex-listings} @tab @code{org-latex-listings}
+@item @code{:latex-minted-langs} @tab @code{org-latex-minted-langs}
+@item @code{:latex-minted-options} @tab @code{org-latex-minted-options}
+@item @code{:latex-prefer-user-labels} @tab @code{org-latex-prefer-user-labels}
+@item @code{:latex-subtitle-format} @tab @code{org-latex-subtitle-format}
+@item @code{:latex-subtitle-separate} @tab @code{org-latex-subtitle-separate}
+@item @code{:latex-table-scientific-notation} @tab @code{org-latex-table-scientific-notation}
+@item @code{:latex-tables-booktabs} @tab @code{org-latex-tables-booktabs}
+@item @code{:latex-tables-centered} @tab @code{org-latex-tables-centered}
+@item @code{:latex-text-markup-alist} @tab @code{org-latex-text-markup-alist}
+@item @code{:latex-title-command} @tab @code{org-latex-title-command}
+@item @code{:latex-toc-command} @tab @code{org-latex-toc-command}
+@end multitable
-@vindex org-publish-project-alist
-When a property is given a value in @code{org-publish-project-alist}, its
-setting overrides the value of the corresponding user variable (if any)
-during publishing. Options set within a file (@pxref{Export settings}),
-however, override everything.
+@subsubheading Markdown specific properties
+
+@multitable {@code{:md-footnotes-section}} {@code{org-md-footnotes-section}}
+@item @code{:md-footnote-format} @tab @code{org-md-footnote-format}
+@item @code{:md-footnotes-section} @tab @code{org-md-footnotes-section}
+@item @code{:md-headline-style} @tab @code{org-md-headline-style}
+@end multitable
-@node Publishing links, Sitemap, Publishing options, Configuration
+@subsubheading ODT specific properties
+
+@multitable {@code{:odt-format-inlinetask-function}} {@code{org-odt-format-inlinetask-function}}
+@item @code{:odt-content-template-file} @tab @code{org-odt-content-template-file}
+@item @code{:odt-display-outline-level} @tab @code{org-odt-display-outline-level}
+@item @code{:odt-fontify-srcblocks} @tab @code{org-odt-fontify-srcblocks}
+@item @code{:odt-format-drawer-function} @tab @code{org-odt-format-drawer-function}
+@item @code{:odt-format-headline-function} @tab @code{org-odt-format-headline-function}
+@item @code{:odt-format-inlinetask-function} @tab @code{org-odt-format-inlinetask-function}
+@item @code{:odt-inline-formula-rules} @tab @code{org-odt-inline-formula-rules}
+@item @code{:odt-inline-image-rules} @tab @code{org-odt-inline-image-rules}
+@item @code{:odt-pixels-per-inch} @tab @code{org-odt-pixels-per-inch}
+@item @code{:odt-styles-file} @tab @code{org-odt-styles-file}
+@item @code{:odt-table-styles} @tab @code{org-odt-table-styles}
+@item @code{:odt-use-date-fields} @tab @code{org-odt-use-date-fields}
+@end multitable
+
+@subsubheading Texinfo specific properties
+
+@multitable {@code{:texinfo-link-with-unknown-path-format}} {@code{org-texinfo-link-with-unknown-path-format}}
+@item @code{:texinfo-active-timestamp-format} @tab @code{org-texinfo-active-timestamp-format}
+@item @code{:texinfo-classes} @tab @code{org-texinfo-classes}
+@item @code{:texinfo-class} @tab @code{org-texinfo-default-class}
+@item @code{:texinfo-table-default-markup} @tab @code{org-texinfo-table-default-markup}
+@item @code{:texinfo-diary-timestamp-format} @tab @code{org-texinfo-diary-timestamp-format}
+@item @code{:texinfo-filename} @tab @code{org-texinfo-filename}
+@item @code{:texinfo-format-drawer-function} @tab @code{org-texinfo-format-drawer-function}
+@item @code{:texinfo-format-headline-function} @tab @code{org-texinfo-format-headline-function}
+@item @code{:texinfo-format-inlinetask-function} @tab @code{org-texinfo-format-inlinetask-function}
+@item @code{:texinfo-inactive-timestamp-format} @tab @code{org-texinfo-inactive-timestamp-format}
+@item @code{:texinfo-link-with-unknown-path-format} @tab @code{org-texinfo-link-with-unknown-path-format}
+@item @code{:texinfo-node-description-column} @tab @code{org-texinfo-node-description-column}
+@item @code{:texinfo-table-scientific-notation} @tab @code{org-texinfo-table-scientific-notation}
+@item @code{:texinfo-tables-verbatim} @tab @code{org-texinfo-tables-verbatim}
+@item @code{:texinfo-text-markup-alist} @tab @code{org-texinfo-text-markup-alist}
+@end multitable
+
+@node Publishing links
@subsection Links between published files
@cindex links, publishing
To create a link from one Org file to another, you would use something like
-@samp{[[file:foo.org][The foo]]} or simply @samp{file:foo.org.}
-(@pxref{Hyperlinks}). When published, this link becomes a link to
-@file{foo.html}. You can thus interlink the pages of your "org web" project
-and the links will work as expected when you publish them to HTML@. If you
-also publish the Org source file and want to link to it, use an @code{http:}
-link instead of a @code{file:} link, because @code{file:} links are converted
-to link to the corresponding @file{html} file.
+@samp{[[file:foo.org][The foo]]} or simply @samp{file:foo.org}
+(@pxref{External links}). When published, this link becomes a link to
+@file{foo.html}. You can thus interlink the pages of your ``org web''
+project and the links will work as expected when you publish them to HTML.
+If you also publish the Org source file and want to link to it, use an
+@code{http:} link instead of a @code{file:} link, because @code{file:} links
+are converted to link to the corresponding @file{html} file.
You may also link to related files, such as images. Provided you are careful
with relative file names, and provided you have also configured Org to upload
the related files, these links will work too. See @ref{Complex example}, for
an example of this usage.
-@node Sitemap, Generating an index, Publishing links, Configuration
+Eventually, links between published documents can contain some search options
+(@pxref{Search options}), which will be resolved to the appropriate location
+in the linked file. For example, once published to HTML, the following links
+all point to a dedicated anchor in @file{foo.html}.
+
+@example
+[[file:foo.org::*heading]]
+[[file:foo.org::#custom-id]]
+[[file:foo.org::target]]
+@end example
+
+@node Sitemap
@subsection Generating a sitemap
@cindex sitemap, of published pages
@@ -13775,15 +14871,30 @@ becomes @file{sitemap.html}).
@item @code{:sitemap-title}
@tab Title of sitemap page. Defaults to name of file.
+@item @code{:sitemap-format-entry}
+@tab With this option one can tell how a site-map entry is formatted in the
+site-map. It is a function called with three arguments: the file or
+directory name relative to base directory of the project, the site-map style
+and the current project. It is expected to return a string. Default value
+turns file names into links and use document titles as descriptions. For
+specific formatting needs, one can use @code{org-publish-find-date},
+@code{org-publish-find-title} and @code{org-publish-find-property}, to
+retrieve additional information about published documents.
+
@item @code{:sitemap-function}
-@tab Plug-in function to use for generation of the sitemap.
-Defaults to @code{org-publish-org-sitemap}, which generates a plain list
-of links to all files in the project.
+@tab Plug-in function to use for generation of the sitemap. It is called
+with two arguments: the title of the site-map and a representation of the
+files and directories involved in the project as a radio list (@pxref{Radio
+lists}). The latter can further be transformed using
+@code{org-list-to-generic}, @code{org-list-to-subtree} and alike. Default
+value generates a plain list of links to all files in the project.
@item @code{:sitemap-sort-folders}
@tab Where folders should appear in the sitemap. Set this to @code{first}
-(default) or @code{last} to display folders first or last,
-respectively. Any other value will mix files and folders.
+(default) or @code{last} to display folders first or last, respectively.
+When set to @code{ignore}, folders are ignored altogether. Any other value
+will mix files and folders. This variable has no effect when site-map style
+is @code{tree}.
@item @code{:sitemap-sort-files}
@tab How the files are sorted in the site map. Set this to
@@ -13796,27 +14907,14 @@ a file is retrieved with @code{org-publish-find-date}.
@item @code{:sitemap-ignore-case}
@tab Should sorting be case-sensitive? Default @code{nil}.
-@item @code{:sitemap-file-entry-format}
-@tab With this option one can tell how a sitemap's entry is formatted in the
-sitemap. This is a format string with some escape sequences: @code{%t} stands
-for the title of the file, @code{%a} stands for the author of the file and
-@code{%d} stands for the date of the file. The date is retrieved with the
-@code{org-publish-find-date} function and formatted with
-@code{org-publish-sitemap-date-format}. Default @code{%t}.
-
@item @code{:sitemap-date-format}
@tab Format string for the @code{format-time-string} function that tells how
a sitemap entry's date is to be formatted. This property bypasses
@code{org-publish-sitemap-date-format} which defaults to @code{%Y-%m-%d}.
-@item @code{:sitemap-sans-extension}
-@tab When non-@code{nil}, remove filenames' extensions from the generated sitemap.
-Useful to have cool URIs (see @uref{http://www.w3.org/Provider/Style/URI}).
-Defaults to @code{nil}.
-
@end multitable
-@node Generating an index, , Sitemap, Configuration
+@node Generating an index
@subsection Generating an index
@cindex index, in a publishing project
@@ -13833,7 +14931,17 @@ The file will be created when first publishing a project with the
"theindex.inc"}. You can then build around this include statement by adding
a title, style information, etc.
-@node Uploading files, Sample configuration, Configuration, Publishing
+@cindex #+INDEX
+Index entries are specified with @code{#+INDEX} keyword. An entry that
+contains an exclamation mark will create a sub item.
+
+@example
+* Curriculum Vitae
+#+INDEX: CV
+#+INDEX: Application!CV
+@end example
+
+@node Uploading files
@section Uploading files
@cindex rsync
@cindex unison
@@ -13866,7 +14974,7 @@ benefit of re-including any changed external files such as source example
files you might include with @code{#+INCLUDE:}. The timestamp mechanism in
Org is not smart enough to detect if included files have been modified.
-@node Sample configuration, Triggering publication, Uploading files, Publishing
+@node Sample configuration
@section Sample configuration
Below we provide two example configurations. The first one is a simple
@@ -13878,7 +14986,7 @@ more complex, with a multi-component project.
* Complex example:: A multi-component publishing example
@end menu
-@node Simple example, Complex example, Sample configuration, Sample configuration
+@node Simple example
@subsection Example: simple publishing configuration
This example publishes a set of Org files to the @file{public_html}
@@ -13889,6 +14997,7 @@ directory on the local machine.
'(("org"
:base-directory "~/org/"
:publishing-directory "~/public_html"
+ :publishing-function org-html-publish-to-html
:section-numbers nil
:with-toc nil
:html-head "<link rel=\"stylesheet\"
@@ -13896,7 +15005,7 @@ directory on the local machine.
type=\"text/css\"/>")))
@end lisp
-@node Complex example, , Simple example, Sample configuration
+@node Complex example
@subsection Example: complex publishing configuration
This more complicated example publishes an entire website, including
@@ -13946,7 +15055,7 @@ right place on the web server, and publishing images to it.
("website" :components ("orgfiles" "images" "other"))))
@end lisp
-@node Triggering publication, , Sample configuration, Publishing
+@node Triggering publication
@section Triggering publication
Once properly configured, Org can publish with the following commands:
@@ -13970,17 +15079,20 @@ above, or by customizing the variable @code{org-publish-use-timestamps-flag}.
This may be necessary in particular if files include other files via
@code{#+SETUPFILE:} or @code{#+INCLUDE:}.
-@comment node-name, next, previous, up
-@comment Working With Source Code, Miscellaneous, Publishing, Top
-@node Working With Source Code, Miscellaneous, Publishing, Top
+@node Working with source code
@chapter Working with source code
@cindex Schulte, Eric
@cindex Davison, Dan
@cindex source code, working with
-Source code can be included in Org mode documents using a @samp{src} block,
-e.g.:
+Source code here refers to any code typed in Org mode documents. Org can
+manage source code in any Org file once such code is tagged with begin and
+end markers. Working with source code begins with tagging source code
+blocks. Tagged @samp{src} code blocks are not restricted to the preamble or
+the end of an Org document; they can go anywhere---with a few exceptions,
+such as not inside comments and fixed width areas. Here's a sample
+@samp{src} code block in emacs-lisp:
@example
#+BEGIN_SRC emacs-lisp
@@ -13990,14 +15102,57 @@ e.g.:
#+END_SRC
@end example
-Org mode provides a number of features for working with live source code,
-including editing of code blocks in their native major-mode, evaluation of
-code blocks, converting code blocks into source files (known as @dfn{tangling}
-in literate programming), and exporting code blocks and their
-results in several formats. This functionality was contributed by Eric
-Schulte and Dan Davison, and was originally named Org-babel.
-
-The following sections describe Org mode's code block handling facilities.
+Org can take the code in the block between the @samp{#+BEGIN_SRC} and
+@samp{#+END_SRC} tags, and format, compile, execute, and show the results.
+Org can simplify many housekeeping tasks essential to modern code
+maintenance. That's why these blocks in Org mode literature are sometimes
+referred to as @samp{live code} blocks (as compared to the static text and
+documentation around it). Users can control how @samp{live} they want each
+block by tweaking the headers for compiling, execution, extraction.
+
+Org's @samp{src} code block type is one of many block types, such as quote,
+export, verse, latex, example, and verbatim. This section pertains to
+@samp{src} code blocks between @samp{#+BEGIN_SRC} and @samp{#+END_SRC}
+
+For editing @samp{src} code blocks, Org provides native Emacs major-modes.
+That leverages the latest Emacs features for that source code language mode.
+
+For exporting, Org can then extract @samp{src} code blocks into compilable
+source files (in a conversion process known as @dfn{tangling} in literate
+programming terminology).
+
+For publishing, Org's back-ends can handle the @samp{src} code blocks and the
+text for output to a variety of formats with native syntax highlighting.
+
+For executing the source code in the @samp{src} code blocks, Org provides
+facilities that glue the tasks of compiling, collecting the results of the
+execution, and inserting them back to the Org file. Besides text output,
+results may include links to other data types that Emacs can handle: audio,
+video, and graphics.
+
+An important feature of Org's execution of the @samp{src} code blocks is
+passing variables, functions, and results between @samp{src} blocks. Such
+interoperability uses a common syntax even if these @samp{src} blocks are in
+different source code languages. The integration extends to linking the
+debugger's error messages to the line in the @samp{src} code block in the Org
+file. That should partly explain why this functionality by the original
+contributors, Eric Schulte and Dan Davison, was called @samp{Org Babel}.
+
+In literate programming, the main appeal is code and documentation
+co-existing in one file. Org mode takes this several steps further. First
+by enabling execution, and then by inserting results of that execution back
+into the Org file. Along the way, Org provides extensive formatting
+features, including handling tables. Org handles multiple source code
+languages in one file, and provides a common syntax for passing variables,
+functions, and results between @samp{src} code blocks.
+
+Org mode fulfills the promise of easy verification and maintenance of
+publishing reproducible research by keeping all these in the same file: text,
+data, code, configuration settings of the execution environment, the results
+of the execution, and associated narratives, claims, references, and internal
+and external links.
+
+Details of Org's facilities for working with source code are shown next.
@menu
* Structure of code blocks:: Code block syntax described
@@ -14014,19 +15169,18 @@ The following sections describe Org mode's code block handling facilities.
* Batch execution:: Call functions from the command line
@end menu
-@comment node-name, next, previous, up
-@comment Structure of code blocks, Editing source code, Working With Source Code, Working With Source Code
-@node Structure of code blocks, Editing source code, Working With Source Code, Working With Source Code
+@node Structure of code blocks
@section Structure of code blocks
@cindex code block, structure
@cindex source code, block structure
@cindex #+NAME
@cindex #+BEGIN_SRC
-Live code blocks can be specified with a @samp{src} block or
-inline.@footnote{Note that @samp{src} blocks may be inserted using Org mode's
-@ref{Easy Templates} system} The structure of a @samp{src} block is
+Org offers two ways to structure source code in Org documents: in a
+@samp{src} block, and directly inline. Both specifications are shown below.
+
+A @samp{src} block conforms to this structure:
@example
#+NAME: <name>
@@ -14035,12 +15189,15 @@ inline.@footnote{Note that @samp{src} blocks may be inserted using Org mode's
#+END_SRC
@end example
-The @code{#+NAME:} line is optional, and can be used to name the code
-block. Live code blocks require that a language be specified on the
-@code{#+BEGIN_SRC} line. Switches and header arguments are optional.
-@cindex source code, inline
+Org mode's templates system (@pxref{Easy templates}) speeds up creating
+@samp{src} code blocks with just three keystrokes. Do not be put-off by
+having to remember the source block syntax. Org also works with other
+completion systems in Emacs, some of which predate Org and have custom
+domain-specific languages for defining templates. Regular use of templates
+reduces errors, increases accuracy, and maintains consistency.
-Live code blocks can also be specified inline using
+@cindex source code, inline
+An inline code block conforms to this structure:
@example
src_<language>@{<body>@}
@@ -14053,36 +15210,39 @@ src_<language>[<header arguments>]@{<body>@}
@end example
@table @code
-@item <#+NAME: name>
-This line associates a name with the code block. This is similar to the
-@code{#+NAME: Name} lines that can be used to name tables in Org mode
-files. Referencing the name of a code block makes it possible to evaluate
-the block from other places in the file, from other files, or from Org mode
-table formulas (see @ref{The spreadsheet}). Names are assumed to be unique
-and the behavior of Org mode when two or more blocks share the same name is
-undefined.
+@item #+NAME: <name>
+Optional. Names the @samp{src} block so it can be called, like a function,
+from other @samp{src} blocks or inline blocks to evaluate or to capture the
+results. Code from other blocks, other files, and from table formulas
+(@pxref{The spreadsheet}) can use the name to reference a @samp{src} block.
+This naming serves the same purpose as naming Org tables. Org mode requires
+unique names. For duplicate names, Org mode's behavior is undefined.
@cindex #+NAME
+@item #+BEGIN_SRC
+@item #+END_SRC
+Mandatory. They mark the start and end of a block that Org requires. The
+@code{#+BEGIN_SRC} line takes additional arguments, as described next.
+@cindex begin block, end block
@item <language>
-The language of the code in the block (see @ref{Languages}).
+Mandatory for live code blocks. It is the identifier of the source code
+language in the block. @xref{Languages}, for identifiers of supported
+languages.
@cindex source code, language
@item <switches>
-Optional switches control code block export (see the discussion of switches in
-@ref{Literal examples})
+Optional. Switches provide finer control of the code execution, export, and
+format (see the discussion of switches in @ref{Literal examples})
@cindex source code, switches
@item <header arguments>
-Optional header arguments control many aspects of evaluation, export and
-tangling of code blocks (see @ref{Header arguments}).
-Header arguments can also be set on a per-buffer or per-subtree
-basis using properties.
+Optional. Heading arguments control many aspects of evaluation, export and
+tangling of code blocks (@pxref{Header arguments}). Using Org's properties
+feature, header arguments can be selectively applied to the entire buffer or
+specific sub-trees of the Org document.
@item source code, header arguments
@item <body>
-Source code in the specified language.
+Source code in the dialect of the specified language identifier.
@end table
-@comment node-name, next, previous, up
-@comment Editing source code, Exporting code blocks, Structure of code blocks, Working With Source Code
-
-@node Editing source code, Exporting code blocks, Structure of code blocks, Working With Source Code
+@node Editing source code
@section Editing source code
@cindex code block, editing
@cindex source code, editing
@@ -14090,116 +15250,147 @@ Source code in the specified language.
@vindex org-edit-src-auto-save-idle-delay
@vindex org-edit-src-turn-on-auto-save
@kindex C-c '
-Use @kbd{C-c '} to edit the current code block. This brings up a language
-major-mode edit buffer containing the body of the code block. Manually
-saving this buffer with @key{C-x C-s} will write the contents back to the Org
-buffer. You can also set @code{org-edit-src-auto-save-idle-delay} to save the
-base buffer after some idle delay, or @code{org-edit-src-turn-on-auto-save}
-to auto-save this buffer into a separate file using @code{auto-save-mode}.
-Use @kbd{C-c '} again to exit.
-
-The @code{org-src-mode} minor mode will be active in the edit buffer. The
-following variables can be used to configure the behavior of the edit
-buffer. See also the customization group @code{org-edit-structure} for
-further configuration options.
+@kbd{C-c '} for editing the current code block. It opens a new major-mode
+edit buffer containing the body of the @samp{src} code block, ready for any
+edits. @kbd{C-c '} again to close the buffer and return to the Org buffer.
+
+@key{C-x C-s} saves the buffer and updates the contents of the Org buffer.
+
+Set @code{org-edit-src-auto-save-idle-delay} to save the base buffer after
+a certain idle delay time.
+
+Set @code{org-edit-src-turn-on-auto-save} to auto-save this buffer into a
+separate file using @code{auto-save-mode}.
+
+@kbd{C-c '} to close the major-mode buffer and return back to the Org buffer.
+
+While editing the source code in the major-mode, the @code{org-src-mode}
+minor mode remains active. It provides these customization variables as
+described below. For even more variables, look in the customization
+group @code{org-edit-structure}.
@table @code
@item org-src-lang-modes
-If an Emacs major-mode named @code{<lang>-mode} exists, where
-@code{<lang>} is the language named in the header line of the code block,
-then the edit buffer will be placed in that major-mode. This variable
-can be used to map arbitrary language names to existing major modes.
+If an Emacs major-mode named @code{<lang>-mode} exists, where @code{<lang>}
+is the language identifier from code block's header line, then the edit
+buffer uses that major-mode. Use this variable to arbitrarily map language
+identifiers to major modes.
@item org-src-window-setup
-Controls the way Emacs windows are rearranged when the edit buffer is created.
+For specifying Emacs window arrangement when the new edit buffer is created.
@item org-src-preserve-indentation
-By default, the value is @code{nil}, which means that when code blocks are
-evaluated during export or tangled, they are re-inserted into the code block,
-which may replace sequences of spaces with tab characters. When non-nil,
-whitespace in code blocks will be preserved during export or tangling,
-exactly as it appears. This variable is especially useful for tangling
-languages such as Python, in which whitespace indentation in the output is
-critical.
+@cindex indentation, in source blocks
+Default is @code{nil}. Source code is indented. This indentation applies
+during export or tangling, and depending on the context, may alter leading
+spaces and tabs. When non-@code{nil}, source code is aligned with the
+leftmost column. No lines are modified during export or tangling, which is
+very useful for white-space sensitive languages, such as Python.
@item org-src-ask-before-returning-to-edit-buffer
-By default, Org will ask before returning to an open edit buffer. Set this
-variable to @code{nil} to switch without asking.
+When @code{nil}, Org returns to the edit buffer without further prompts. The
+default prompts for a confirmation.
@end table
-To turn on native code fontification in the @emph{Org} buffer, configure the
-variable @code{org-src-fontify-natively}.
+Set @code{org-src-fontify-natively} to non-@code{nil} to turn on native code
+fontification in the @emph{Org} buffer. Fontification of @samp{src} code
+blocks can give visual separation of text and code on the display page. To
+further customize the appearance of @code{org-block} for specific languages,
+customize @code{org-src-block-faces}. The following example shades the
+background of regular blocks, and colors source blocks only for Python and
+Emacs-Lisp languages.
+@lisp
+(require 'color)
+(set-face-attribute 'org-block nil :background
+ (color-darken-name
+ (face-attribute 'default :background) 3))
-@comment node-name, next, previous, up
-@comment Exporting code blocks, Extracting source code, Editing source code, Working With Source Code
+(setq org-src-block-faces '(("emacs-lisp" (:background "#EEE2FF"))
+ ("python" (:background "#E5FFB8"))))
+@end lisp
-@node Exporting code blocks, Extracting source code, Editing source code, Working With Source Code
+@node Exporting code blocks
@section Exporting code blocks
@cindex code block, exporting
@cindex source code, exporting
-It is possible to export the @emph{code} of code blocks, the @emph{results}
-of code block evaluation, @emph{both} the code and the results of code block
-evaluation, or @emph{none}. For most languages, the default exports code.
-However, for some languages (e.g., @code{ditaa}) the default exports the
-results of code block evaluation. For information on exporting code block
-bodies, see @ref{Literal examples}.
+Org can flexibly export just the @emph{code} from the code blocks, just the
+@emph{results} of evaluation of the code block, @emph{both} the code and the
+results of the code block evaluation, or @emph{none}. Org defaults to
+exporting @emph{code} for most languages. For some languages, such as
+@code{ditaa}, Org defaults to @emph{results}. To export just the body of
+code blocks, @pxref{Literal examples}. To selectively export sub-trees of
+an Org document, @pxref{Exporting}.
-The @code{:exports} header argument can be used to specify export
-behavior:
+The @code{:exports} header arguments control exporting code blocks only and
+not inline code:
@subsubheading Header arguments:
@table @code
+@cindex @code{:exports}, src header argument
@item :exports code
-The default in most languages. The body of the code block is exported, as
-described in @ref{Literal examples}.
+This is the default for most languages where the body of the code block is
+exported. See @ref{Literal examples} for more.
@item :exports results
-The code block will be evaluated and the results will be placed in the
-Org mode buffer for export, either updating previous results of the code
-block located anywhere in the buffer or, if no previous results exist,
-placing the results immediately after the code block. The body of the code
-block will not be exported.
+On export, Org includes only the results and not the code block. After each
+evaluation, Org inserts the results after the end of code block in the Org
+buffer. By default, Org replaces any previous results. Org can also append
+results.
@item :exports both
-Both the code block and its results will be exported.
+Org exports both the code block and the results.
@item :exports none
-Neither the code block nor its results will be exported.
+Org does not export the code block nor the results.
@end table
-It is possible to inhibit the evaluation of code blocks during export.
-Setting the @code{org-export-babel-evaluate} variable to @code{nil} will
-ensure that no code blocks are evaluated as part of the export process. This
-can be useful in situations where potentially untrusted Org mode files are
-exported in an automated fashion, for example when Org mode is used as the
-markup language for a wiki. It is also possible to set this variable to
-@code{'inline-only}. In that case, only inline code blocks will be
-evaluated, in order to insert their results. Non-inline code blocks are
-assumed to have their results already inserted in the buffer by manual
-evaluation. This setting is useful to avoid expensive recalculations during
-export, not to provide security.
-
-@comment node-name, next, previous, up
-@comment Extracting source code, Evaluating code blocks, Exporting code blocks, Working With Source Code
-@node Extracting source code, Evaluating code blocks, Exporting code blocks, Working With Source Code
+@vindex org-export-use-babel
+To stop Org from evaluating code blocks to speed exports, use the header
+argument @code{:eval never-export} (@pxref{eval}). To stop Org from
+evaluating code blocks for greater security, set the
+@code{org-export-use-babel} variable to @code{nil}, but understand that
+header arguments will have no effect.
+
+Turning off evaluation comes in handy when batch processing. For example,
+markup languages for wikis, which have a high risk of untrusted code.
+Stopping code block evaluation also stops evaluation of all header arguments
+of the code block. This may not be desirable in some circumstances. So
+during export, to allow evaluation of just the header arguments but not any
+code evaluation in the source block, set @code{:eval never-export}
+(@pxref{eval}).
+
+Org never evaluates code blocks in commented sub-trees when exporting
+(@pxref{Comment lines}). On the other hand, Org does evaluate code blocks in
+sub-trees excluded from export (@pxref{Export settings}).
+
+@node Extracting source code
@section Extracting source code
@cindex tangling
@cindex source code, extracting
@cindex code block, extracting source code
-Creating pure source code files by extracting code from source blocks is
-referred to as ``tangling''---a term adopted from the literate programming
-community. During ``tangling'' of code blocks their bodies are expanded
-using @code{org-babel-expand-src-block} which can expand both variable and
-``noweb'' style references (see @ref{Noweb reference syntax}).
+Extracting source code from code blocks is a basic task in literate
+programming. Org has features to make this easy. In literate programming
+parlance, documents on creation are @emph{woven} with code and documentation,
+and on export, the code is @emph{tangled} for execution by a computer. Org
+facilitates weaving and tangling for producing, maintaining, sharing, and
+exporting literate programming documents. Org provides extensive
+customization options for extracting source code.
+
+When Org tangles @samp{src} 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 @emph{tangling} process, Org
+expands variables in the source code, and resolves any Noweb style references
+(@pxref{Noweb reference syntax}).
@subsubheading Header arguments
@table @code
+@cindex @code{:tangle}, src header argument
@item :tangle no
-The default. The code block is not included in the tangled output.
+By default, Org does not tangle the @samp{src} code block on export.
@item :tangle yes
-Include the code block in the tangled output. The output file name is the
-name of the org file with the extension @samp{.org} replaced by the extension
-for the block language.
+Org extracts the contents of the code block for the tangled output. By
+default, the output file name is the same as the Org file but with a file
+extension derived from the language identifier of the @samp{src} code block.
@item :tangle filename
-Include the code block in the tangled output to file @samp{filename}.
+Override the default file name with this one for the tangled output.
@end table
@kindex C-c C-v t
@@ -14209,7 +15400,7 @@ Include the code block in the tangled output to file @samp{filename}.
@item org-babel-tangle
Tangle the current file. Bound to @kbd{C-c C-v t}.
-With prefix argument only tangle the current code block.
+With prefix argument only tangle the current @samp{src} code block.
@item org-babel-tangle-file
Choose a file to tangle. Bound to @kbd{C-c C-v f}.
@end table
@@ -14218,72 +15409,67 @@ Choose a file to tangle. Bound to @kbd{C-c C-v f}.
@table @code
@item org-babel-post-tangle-hook
-This hook is run from within code files tangled by @code{org-babel-tangle}.
-Example applications could include post-processing, compilation or evaluation
-of tangled code files.
+This hook runs from within code tangled by @code{org-babel-tangle}, making it
+suitable for post-processing, compilation, and evaluation of code in the
+tangled files.
@end table
@subsubheading Jumping between code and Org
-When tangling code from an Org-mode buffer to a source code file, you'll
-frequently find yourself viewing the file of tangled source code (e.g., many
-debuggers point to lines of the source code file). It is useful to be able
-to navigate from the tangled source to the Org-mode buffer from which the
-code originated.
-
-The @code{org-babel-tangle-jump-to-org} function provides this jumping from
-code to Org-mode functionality. Two header arguments are required for
-jumping to work, first the @code{padline} (@ref{padline}) option must be set
-to true (the default setting), second the @code{comments} (@ref{comments})
-header argument must be set to @code{links}, which will insert comments into
-the source code buffer which point back to the original Org-mode file.
+Debuggers normally link errors and messages back to the source code. But for
+tangled files, we want to link back to the Org file, not to the tangled
+source file. To make this extra jump, Org uses
+@code{org-babel-tangle-jump-to-org} function with two additional source code
+block header arguments: One, set @code{padline} (@pxref{padline}) to true
+(the default setting). Two, set @code{comments} (@pxref{comments}) to
+@code{link}, which makes Org insert links to the Org file.
-@node Evaluating code blocks, Library of Babel, Extracting source code, Working With Source Code
+@node Evaluating code blocks
@section Evaluating code blocks
@cindex code block, evaluating
@cindex source code, evaluating
@cindex #+RESULTS
-Code blocks can be evaluated@footnote{Whenever code is evaluated there is a
-potential for that code to do harm. Org mode provides safeguards to ensure
-that code is only evaluated after explicit confirmation from the user. For
-information on these safeguards (and on how to disable them) see @ref{Code
-evaluation security}.} and the results of evaluation optionally placed in the
-Org mode buffer. The results of evaluation are placed following a line that
-begins by default with @code{#+RESULTS} and optionally a cache identifier
-and/or the name of the evaluated code block. The default value of
-@code{#+RESULTS} can be changed with the customizable variable
-@code{org-babel-results-keyword}.
-
-By default, the evaluation facility is only enabled for Lisp code blocks
-specified as @code{emacs-lisp}. However, source code blocks in many languages
-can be evaluated within Org mode (see @ref{Languages} for a list of supported
-languages and @ref{Structure of code blocks} for information on the syntax
-used to define a code block).
+A note about security: With code evaluation comes the risk of harm. Org
+safeguards by prompting for user's permission before executing any code in
+the source block. To customize this safeguard (or disable it) see @ref{Code
+evaluation security}.
+
+Org captures the results of the @samp{src} code block evaluation and inserts
+them in the Org file, right after the @samp{src} code block. The insertion
+point is after a newline and the @code{#+RESULTS} label. Org creates the
+@code{#+RESULTS} label if one is not already there.
+
+By default, Org enables only @code{emacs-lisp} @samp{src} code blocks for
+execution. See @ref{Languages} for identifiers to enable other languages.
@kindex C-c C-c
-There are a number of ways to evaluate code blocks. The simplest is to press
-@kbd{C-c C-c} or @kbd{C-c C-v e} with the point on a code block@footnote{The
-option @code{org-babel-no-eval-on-ctrl-c-ctrl-c} can be used to remove code
-evaluation from the @kbd{C-c C-c} key binding.}. This will call the
-@code{org-babel-execute-src-block} function to evaluate the block and insert
-its results into the Org mode buffer.
-@cindex #+CALL
+Org provides many ways to execute @samp{src} code blocks. @kbd{C-c C-c} or
+@kbd{C-c C-v e} with the point on a @samp{src} code block@footnote{The option
+@code{org-babel-no-eval-on-ctrl-c-ctrl-c} can be used to remove code
+evaluation from the @kbd{C-c C-c} key binding.} calls the
+@code{org-babel-execute-src-block} function, which executes the code in the
+block, collects the results, and inserts them in the buffer.
-It is also possible to evaluate named code blocks from anywhere in an Org
-mode buffer or an Org mode table. Live code blocks located in the current
-Org mode buffer or in the ``Library of Babel'' (see @ref{Library of Babel})
-can be executed. Named code blocks can be executed with a separate
-@code{#+CALL:} line or inline within a block of text.
+@cindex #+CALL
+By calling a named code block@footnote{Actually, the constructs call_<name>()
+and src_<lang>@{@} are not evaluated when they appear in a keyword line
+(i.e. lines starting with @code{#+KEYWORD:}, @pxref{In-buffer settings}).}
+from an Org mode buffer or a table. Org can call the named @samp{src} code
+blocks from the current Org mode buffer or from the ``Library of Babel''
+(@pxref{Library of Babel}). Whether inline syntax or the @code{#+CALL:}
+syntax is used, the result is wrapped based on the variable
+@code{org-babel-inline-result-wrap}, which by default is set to @code{"=%s="}
+to produce verbatim text suitable for markup.
-The syntax of the @code{#+CALL:} line is
+The syntax for @code{#+CALL:} is
@example
#+CALL: <name>(<arguments>)
#+CALL: <name>[<inside header arguments>](<arguments>) <end header arguments>
@end example
-The syntax for inline evaluation of named code blocks is
+The syntax for inline named code block is
@example
... call_<name>(<arguments>) ...
@@ -14292,98 +15478,90 @@ The syntax for inline evaluation of named code blocks is
@table @code
@item <name>
-The name of the code block to be evaluated (see @ref{Structure of code blocks}).
+This is the name of the code block to be evaluated (@pxref{Structure of
+code blocks}).
@item <arguments>
-Arguments specified in this section will be passed to the code block. These
-arguments use standard function call syntax, rather than
-header argument syntax. For example, a @code{#+CALL:} line that passes the
-number four to a code block named @code{double}, which declares the header
-argument @code{:var n=2}, would be written as @code{#+CALL: double(n=4)}.
+Org passes arguments to the code block using standard function call syntax.
+For example, a @code{#+CALL:} line that passes @samp{4} to a code block named
+@code{double}, which declares the header argument @code{:var n=2}, would be
+written as @code{#+CALL: double(n=4)}. Note how this function call syntax is
+different from the header argument syntax.
@item <inside header arguments>
-Inside header arguments are passed through and applied to the named code
-block. These arguments use header argument syntax rather than standard
-function call syntax. Inside header arguments affect how the code block is
-evaluated. For example, @code{[:results output]} will collect the results of
-everything printed to @code{STDOUT} during execution of the code block.
+Org passes inside header arguments to the named @samp{src} code block using
+the header argument syntax. Inside header arguments apply to code block
+evaluation. For example, @code{[:results output]} collects results printed
+to @code{STDOUT} during code execution of that block. Note how this header
+argument syntax is different from the function call syntax.
@item <end header arguments>
-End header arguments are applied to the calling instance and do not affect
-evaluation of the named code block. They affect how the results are
-incorporated into the Org mode buffer and how the call line is exported. For
-example, @code{:results html} will insert the results of the call line
-evaluation in the Org buffer, wrapped in a @code{BEGIN_HTML:} block.
-
-For more examples of passing header arguments to @code{#+CALL:} lines see
-@ref{Header arguments in function calls}.
+End header arguments affect the results returned by the code block. For
+example, @code{:results html} wraps the results in a @code{BEGIN_EXPORT html}
+block before inserting the results in the Org buffer.
+
+For more examples of header arguments for @code{#+CALL:} lines,
+@pxref{Arguments in function calls}.
@end table
-@node Library of Babel, Languages, Evaluating code blocks, Working With Source Code
+@node Library of Babel
@section Library of Babel
@cindex babel, library of
@cindex source code, library
@cindex code block, library
-The ``Library of Babel'' consists of code blocks that can be called from any
-Org mode file. Code blocks defined in the ``Library of Babel'' can be called
-remotely as if they were in the current Org mode buffer (see @ref{Evaluating
-code blocks} for information on the syntax of remote code block evaluation).
-
-
-The central repository of code blocks in the ``Library of Babel'' is housed
-in an Org mode file located in the @samp{contrib} directory of Org mode.
-
-Users can add code blocks they believe to be generally useful to their
-``Library of Babel.'' The code blocks can be stored in any Org mode file and
-then loaded into the library with @code{org-babel-lob-ingest}.
-
+The ``Library of Babel'' is a collection of code blocks. Like a function
+library, these code blocks can be called from other Org files. A collection
+of useful code blocks is available on
+@uref{http://orgmode.org/worg/library-of-babel.html,Worg}. For remote code
+block evaluation syntax, @pxref{Evaluating code blocks}.
@kindex C-c C-v i
-Code blocks located in any Org mode file can be loaded into the ``Library of
-Babel'' with the @code{org-babel-lob-ingest} function, bound to @kbd{C-c C-v
-i}.
+For any user to add code to the library, first save the code in regular
+@samp{src} code blocks of an Org file, and then load the Org file with
+@code{org-babel-lob-ingest}, which is bound to @kbd{C-c C-v i}.
-@node Languages, Header arguments, Library of Babel, Working With Source Code
+@node Languages
@section Languages
@cindex babel, languages
@cindex source code, languages
@cindex code block, languages
-Code blocks in the following languages are supported.
+Org supports the following languages for the @samp{src} code blocks:
-@multitable @columnfractions 0.28 0.3 0.22 0.2
-@item @b{Language} @tab @b{Identifier} @tab @b{Language} @tab @b{Identifier}
+@multitable @columnfractions 0.25 0.25 0.25 0.25
+@headitem @b{Language} @tab @b{Identifier} @tab @b{Language} @tab @b{Identifier}
@item Asymptote @tab asymptote @tab Awk @tab awk
-@item Emacs Calc @tab calc @tab C @tab C
-@item C++ @tab C++ @tab Clojure @tab clojure
-@item CSS @tab css @tab ditaa @tab ditaa
-@item Graphviz @tab dot @tab Emacs Lisp @tab emacs-lisp
+@item C @tab C @tab C++ @tab C++
+@item Clojure @tab clojure @tab CSS @tab css
+@item D @tab d @tab ditaa @tab ditaa
+@item Graphviz @tab dot @tab Emacs Calc @tab calc
+@item Emacs Lisp @tab emacs-lisp @tab Fortran @tab fortran
@item gnuplot @tab gnuplot @tab Haskell @tab haskell
-@item Java @tab java @tab @tab
-@item Javascript @tab js @tab LaTeX @tab latex
-@item Ledger @tab ledger @tab Lisp @tab lisp
-@item Lilypond @tab lilypond @tab MATLAB @tab matlab
+@item Java @tab java @tab Javascript @tab js
+@item LaTeX @tab latex @tab Ledger @tab ledger
+@item Lisp @tab lisp @tab Lilypond @tab lilypond
+@item Lua @tab lua @tab MATLAB @tab matlab
@item Mscgen @tab mscgen @tab Objective Caml @tab ocaml
@item Octave @tab octave @tab Org mode @tab org
@item Oz @tab oz @tab Perl @tab perl
-@item Plantuml @tab plantuml @tab Python @tab python
-@item R @tab R @tab Ruby @tab ruby
-@item Sass @tab sass @tab Scheme @tab scheme
-@item GNU Screen @tab screen @tab shell @tab sh
+@item Plantuml @tab plantuml @tab Processing.js @tab processing
+@item Python @tab python @tab R @tab R
+@item Ruby @tab ruby @tab Sass @tab sass
+@item Scheme @tab scheme @tab GNU Screen @tab screen
+@item Sed @tab sed @tab shell @tab sh
@item SQL @tab sql @tab SQLite @tab sqlite
+@item Vala @tab vala
@end multitable
-Language-specific documentation is available for some languages. If
-available, it can be found at
+Additional documentation for some languages are at
@uref{http://orgmode.org/worg/org-contrib/babel/languages.html}.
-The option @code{org-babel-load-languages} controls which languages are
-enabled for evaluation (by default only @code{emacs-lisp} is enabled). This
-variable can be set using the customization interface or by adding code like
-the following to your emacs configuration.
+@vindex org-babel-load-languages
+By default, only @code{emacs-lisp} is enabled for evaluation. To enable or
+disable other languages, customize the @code{org-babel-load-languages}
+variable either through the Emacs customization interface, or by adding code
+to the init file as shown next:
-@quotation
-The following disables @code{emacs-lisp} evaluation and enables evaluation of
-@code{R} code blocks.
-@end quotation
+In this example, evaluation is disabled for @code{emacs-lisp}, and enabled
+for @code{R}.
@lisp
(org-babel-do-load-languages
@@ -14392,55 +15570,54 @@ The following disables @code{emacs-lisp} evaluation and enables evaluation of
(R . t)))
@end lisp
-It is also possible to enable support for a language by loading the related
-elisp file with @code{require}.
-
-@quotation
-The following adds support for evaluating @code{clojure} code blocks.
-@end quotation
+Note that this is not the only way to enable a language. Org also enables
+languages when loaded with @code{require} statement. For example, the
+following enables execution of @code{clojure} code blocks:
@lisp
(require 'ob-clojure)
@end lisp
-@node Header arguments, Results of evaluation, Languages, Working With Source Code
+@node Header arguments
@section Header arguments
@cindex code block, header arguments
@cindex source code, block header arguments
-Code block functionality can be configured with header arguments. This
-section provides an overview of the use of header arguments, and then
-describes each header argument in detail.
+Details of configuring header arguments are shown here.
@menu
* Using header arguments:: Different ways to set header arguments
* Specific header arguments:: List of header arguments
@end menu
-@node Using header arguments, Specific header arguments, Header arguments, Header arguments
+@node Using header arguments
@subsection Using header arguments
-The values of header arguments can be set in several way. When the header
-arguments in each layer have been determined, they are combined in order from
-the first, least specific (having the lowest priority) up to the last, most
-specific (having the highest priority). A header argument with a higher
-priority replaces the same header argument specified at lower priority.
+Since header arguments can be set in several ways, Org prioritizes them in
+case of overlaps or conflicts by giving local settings a higher priority.
+Header values in function calls, for example, override header values from
+global defaults.
@menu
-* System-wide header arguments:: Set global default values
-* Language-specific header arguments:: Set default values by language
-* Header arguments in Org mode properties:: Set default values for a buffer or heading
-* Language-specific header arguments in Org mode properties:: Set language-specific default values for a buffer or heading
-* Code block specific header arguments:: The most common way to set values
-* Header arguments in function calls:: The most specific level
+* System-wide header arguments:: Set globally, language-specific
+* Language-specific header arguments:: Set in the Org file's headers
+* Header arguments in Org mode properties:: Set in the Org file
+* Language-specific mode properties::
+* Code block specific header arguments:: The most commonly used method
+* Arguments in function calls:: The most specific level, takes highest priority
@end menu
-@node System-wide header arguments, Language-specific header arguments, Using header arguments, Using header arguments
+@node System-wide header arguments
@subsubheading System-wide header arguments
@vindex org-babel-default-header-args
System-wide values of header arguments can be specified by adapting the
@code{org-babel-default-header-args} variable:
+@cindex @code{:session}, src header argument
+@cindex @code{:results}, src header argument
+@cindex @code{:exports}, src header argument
+@cindex @code{:cache}, src header argument
+@cindex @code{:noweb}, src header argument
@example
:session => "none"
:results => "replace"
@@ -14449,10 +15626,8 @@ System-wide values of header arguments can be specified by adapting the
:noweb => "no"
@end example
-For example, the following example could be used to set the default value of
-@code{:noweb} header arguments to @code{yes}. This would have the effect of
-expanding @code{:noweb} references by default when evaluating source code
-blocks.
+This example sets @code{:noweb} header arguments to @code{yes}, which makes
+Org expand @code{:noweb} references by default.
@lisp
(setq org-babel-default-header-args
@@ -14460,48 +15635,40 @@ blocks.
(assq-delete-all :noweb org-babel-default-header-args)))
@end lisp
-@node Language-specific header arguments, Header arguments in Org mode properties, System-wide header arguments, Using header arguments
+@node Language-specific header arguments
@subsubheading Language-specific header arguments
-Each language can define its own set of default header arguments in variable
-@code{org-babel-default-header-args:<lang>}, where @code{<lang>} is the name
-of the language. See the language-specific documentation available online at
-@uref{http://orgmode.org/worg/org-contrib/babel}.
+Each language can have separate default header arguments by customizing the
+variable @code{org-babel-default-header-args:<lang>}, where @code{<lang>} is
+the name of the language. For details, see the language-specific online
+documentation at @uref{http://orgmode.org/worg/org-contrib/babel}.
-@node Header arguments in Org mode properties, Language-specific header arguments in Org mode properties, Language-specific header arguments, Using header arguments
+@node Header arguments in Org mode properties
@subsubheading Header arguments in Org mode properties
-Buffer-wide header arguments may be specified as properties through the use
-of @code{#+PROPERTY:} lines placed anywhere in an Org mode file (see
-@ref{Property syntax}).
+For header arguments applicable to the buffer, use @code{#+PROPERTY:} lines
+anywhere in the Org mode file (@pxref{Property syntax}).
-For example the following would set @code{session} to @code{*R*} (only for R
-code blocks), and @code{results} to @code{silent} for every code block in the
-buffer, ensuring that all execution took place in the same session, and no
-results would be inserted into the buffer.
+The following example sets only for @samp{R} code blocks to @code{session},
+making all the @samp{R} code blocks execute in the same session. Setting
+@code{results} to @code{silent} ignores the results of executions for all
+blocks, not just @samp{R} code blocks; no results inserted for any block.
@example
#+PROPERTY: header-args:R :session *R*
#+PROPERTY: header-args :results silent
@end example
-Header arguments read from Org mode properties can also be set on a
-per-subtree basis using property drawers (see @ref{Property syntax}).
@vindex org-use-property-inheritance
-When properties are used to set default header arguments, they are always
-looked up with inheritance, regardless of the value of
-@code{org-use-property-inheritance}. Properties are evaluated as seen by the
-outermost call or source block.@footnote{The deprecated syntax for default
-header argument properties, using the name of the header argument as a
-property name directly, evaluates the property as seen by the corresponding
-source block definition. This behavior has been kept for backwards
-compatibility.}
+Header arguments set through Org's property drawers (@pxref{Property syntax})
+apply at the sub-tree level on down. Since these property drawers can appear
+anywhere in the file hierarchy, Org uses outermost call or source block to
+resolve the values. Org ignores @code{org-use-property-inheritance} setting.
-In the following example the value of
-the @code{:cache} header argument will default to @code{yes} in all code
-blocks in the subtree rooted at the following heading:
+In this example, @code{:cache} defaults to @code{yes} for all code blocks in
+the sub-tree starting with @samp{sample header}.
@example
-* outline header
+* sample header
:PROPERTIES:
:header-args: :cache yes
:END:
@@ -14509,17 +15676,16 @@ blocks in the subtree rooted at the following heading:
@kindex C-c C-x p
@vindex org-babel-default-header-args
-Properties defined in this way override the properties set in
-@code{org-babel-default-header-args} and are applied for all activated
-languages. It is convenient to use the @code{org-set-property} function
-bound to @kbd{C-c C-x p} to set properties in Org mode documents.
+Properties defined through @code{org-set-property} function, bound to
+@kbd{C-c C-x p}, apply to all active languages. They override properties set
+in @code{org-babel-default-header-args}.
-@node Language-specific header arguments in Org mode properties, Code block specific header arguments, Header arguments in Org mode properties, Using header arguments
-@subsubheading Language-specific header arguments in Org mode properties
+@node Language-specific mode properties
+@subsubheading Language-specific mode properties
Language-specific header arguments are also read from properties
-@code{header-args:<lang>} where @code{<lang>} is the name of the language
-targeted. As an example
+@code{header-args:<lang>} where @code{<lang>} is the language identifier.
+For example,
@example
* Heading
@@ -14533,24 +15699,21 @@ targeted. As an example
:END:
@end example
-would independently set a default session header argument for R and clojure
-for calls and source blocks under subtree ``Heading'' and change to a
-different clojure setting for evaluations under subtree ``Subheading'', while
-the R session is inherited from ``Heading'' and therefore unchanged.
+would force separate sessions for clojure blocks in Heading and Subheading,
+but use the same session for all @samp{R} blocks. Blocks in Subheading
+inherit settings from Heading.
-@node Code block specific header arguments, Header arguments in function calls, Language-specific header arguments in Org mode properties, Using header arguments
+@node Code block specific header arguments
@subsubheading Code block specific header arguments
-The most common way to assign values to header arguments is at the
-code block level. This can be done by listing a sequence of header
-arguments and their values as part of the @code{#+BEGIN_SRC} line.
-Properties set in this way override both the values of
-@code{org-babel-default-header-args} and header arguments specified as
-properties. In the following example, the @code{:results} header argument
-is set to @code{silent}, meaning the results of execution will not be
-inserted in the buffer, and the @code{:exports} header argument is set to
-@code{code}, meaning only the body of the code block will be
-preserved on export to HTML or @LaTeX{}.
+Header arguments are most commonly set at the @samp{src} code block level, on
+the @code{#+BEGIN_SRC} line. Arguments set at this level take precedence
+over those set in the @code{org-babel-default-header-args} variable, and also
+those set as header properties.
+
+In the following example, setting @code{results} to @code{silent} makes it
+ignore results of the code execution. Setting @code{:exports} to @code{code}
+exports only the body of the @samp{src} code block to HTML or @LaTeX{}.:
@example
#+NAME: factorial
@@ -14559,93 +15722,93 @@ fac 0 = 1
fac n = n * fac (n-1)
#+END_SRC
@end example
-Similarly, it is possible to set header arguments for inline code blocks
+
+The same header arguments in an inline @samp{src} code block:
@example
src_haskell[:exports both]@{fac 5@}
@end example
-Code block header arguments can span multiple lines using @code{#+HEADER:} or
-@code{#+HEADERS:} lines preceding a code block or nested between the
-@code{#+NAME:} line and the @code{#+BEGIN_SRC} line of a named code block.
+Code block header arguments can span multiple lines using @code{#+HEADER:} on
+each line. Note that Org currently accepts the plural spelling of
+@code{#+HEADER:} only as a convenience for backward-compatibility. It may be
+removed at some point.
+
@cindex #+HEADER:
-@cindex #+HEADERS:
-Multi-line header arguments on an un-named code block:
+Multi-line header arguments on an unnamed @samp{src} code block:
@example
- #+HEADERS: :var data1=1
- #+BEGIN_SRC emacs-lisp :var data2=2
+#+HEADER: :var data1=1
+#+BEGIN_SRC emacs-lisp :var data2=2
(message "data1:%S, data2:%S" data1 data2)
- #+END_SRC
+#+END_SRC
- #+RESULTS:
- : data1:1, data2:2
+#+RESULTS:
+: data1:1, data2:2
@end example
-Multi-line header arguments on a named code block:
+Multi-line header arguments on a named @samp{src} code block:
@example
- #+NAME: named-block
- #+HEADER: :var data=2
- #+BEGIN_SRC emacs-lisp
- (message "data:%S" data)
- #+END_SRC
+#+NAME: named-block
+#+HEADER: :var data=2
+#+BEGIN_SRC emacs-lisp
+ (message "data:%S" data)
+#+END_SRC
- #+RESULTS: named-block
- : data:2
+#+RESULTS: named-block
+ : data:2
@end example
-@node Header arguments in function calls, , Code block specific header arguments, Using header arguments
-@comment node-name, next, previous, up
-@subsubheading Header arguments in function calls
+@node Arguments in function calls
+@subsubheading Arguments in function calls
-At the most specific level, header arguments for ``Library of Babel'' or
-@code{#+CALL:} lines can be set as shown in the two examples below. For more
-information on the structure of @code{#+CALL:} lines see @ref{Evaluating code
-blocks}.
+Header arguments in function calls are the most specific and override all
+other settings in case of an overlap. They get the highest priority. Two
+@code{#+CALL:} examples are shown below. For the complete syntax of
+@code{#+CALL:} lines, see @ref{Evaluating code blocks}.
-The following will apply the @code{:exports results} header argument to the
+In this example, @code{:exports results} header argument is applied to the
evaluation of the @code{#+CALL:} line.
@example
#+CALL: factorial(n=5) :exports results
@end example
-The following will apply the @code{:session special} header argument to the
-evaluation of the @code{factorial} code block.
+In this example, @code{:session special} header argument is applied to the
+evaluation of @code{factorial} code block.
@example
#+CALL: factorial[:session special](n=5)
@end example
-@node Specific header arguments, , Using header arguments, Header arguments
+@node Specific header arguments
@subsection Specific header arguments
-Header arguments consist of an initial colon followed by the name of the
-argument in lowercase letters. The following header arguments are defined:
+Org comes with many header arguments common to all languages. New header
+arguments are added for specific languages as they become available for use
+in @samp{src} code blocks. A header argument is specified with an initial
+colon followed by the argument's name in lowercase. Common header arguments
+are:
@menu
-* var:: Pass arguments to code blocks
-* results:: Specify the type of results and how they will
- be collected and handled
-* file:: Specify a path for file output
+* var:: Pass arguments to @samp{src} code blocks
+* results:: Specify results type; how to collect
+* file:: Specify a path for output file
* file-desc:: Specify a description for file results
-* dir:: Specify the default (possibly remote)
- directory for code block execution
-* exports:: Export code and/or results
-* tangle:: Toggle tangling and specify file name
-* mkdirp:: Toggle creation of parent directories of target
- files during tangling
-* comments:: Toggle insertion of comments in tangled
- code files
-* padline:: Control insertion of padding lines in tangled
- code files
-* no-expand:: Turn off variable assignment and noweb
- expansion during tangling
+* file-ext:: Specify an extension for file output
+* output-dir:: Specify a directory for output file
+* dir:: Specify the default directory for code block execution
+* exports:: Specify exporting code, results, both, none
+* tangle:: Toggle tangling; or specify file name
+* mkdirp:: Toggle for parent directory creation for target files during tangling
+* comments:: Toggle insertion of comments in tangled code files
+* padline:: Control insertion of padding lines in tangled code files
+* no-expand:: Turn off variable assignment and noweb expansion during tangling
* session:: Preserve the state of code evaluation
* noweb:: Toggle expansion of noweb references
* noweb-ref:: Specify block's noweb reference resolution target
-* noweb-sep:: String used to separate noweb references
+* noweb-sep:: String to separate noweb references
* cache:: Avoid re-evaluating unchanged code blocks
* sep:: Delimiter for writing tabular results outside Org
* hlines:: Handle horizontal lines in tables
@@ -14655,45 +15818,46 @@ argument in lowercase letters. The following header arguments are defined:
* tangle-mode:: Set permission of tangled files
* eval:: Limit evaluation of specific code blocks
* wrap:: Mark source block evaluation results
-* post:: Post processing of code block results
-* prologue:: Text to prepend to code block body
-* epilogue:: Text to append to code block body
+* post:: Post processing of results of code block evaluation
+* prologue:: Text to prepend to body of code block
+* epilogue:: Text to append to body of code block
@end menu
-Additional header arguments are defined on a language-specific basis, see
-@ref{Languages}.
+For language-specific header arguments, see @ref{Languages}.
-@node var, results, Specific header arguments, Specific header arguments
+@node var
@subsubsection @code{:var}
-The @code{:var} header argument is used to pass arguments to code blocks.
-The specifics of how arguments are included in a code block vary by language;
-these are addressed in the language-specific documentation. However, the
-syntax used to specify arguments is the same across all languages. In every
-case, variables require a default value when they are declared.
+@cindex @code{:var}, src header argument
+Use @code{:var} for passing arguments to @samp{src} code blocks. The
+specifics of variables in @samp{src} code blocks vary by the source language
+and are covered in the language-specific documentation. The syntax for
+@code{:var}, however, is the same for all languages. This includes declaring
+a variable, and assigning a default value.
-The values passed to arguments can either be literal values, references, or
-Emacs Lisp code (see @ref{var, Emacs Lisp evaluation of variables}).
-References include anything in the Org mode file that takes a @code{#+NAME:}
-or @code{#+RESULTS:} line: tables, lists, @code{#+BEGIN_EXAMPLE} blocks,
-other code blocks and the results of other code blocks.
+Arguments can take values as literals, or as references, or even as Emacs
+Lisp code (@pxref{var, Emacs Lisp evaluation of variables}). References are
+names from the Org file from the lines @code{#+NAME:} or @code{#+RESULTS:}.
+References can also refer to tables, lists, @code{#+BEGIN_EXAMPLE} blocks,
+other types of @samp{src} code blocks, or the results of execution of
+@samp{src} code blocks.
-Note: When a reference is made to another code block, the referenced block
-will be evaluated unless it has current cached results (see @ref{cache}).
+For better performance, Org can cache results of evaluations. But caching
+comes with severe limitations (@pxref{cache}).
-Argument values can be indexed in a manner similar to arrays (see @ref{var,
-Indexable variable values}).
+Argument values are indexed like arrays (@pxref{var, Indexable variable
+values}).
-The following syntax is used to pass arguments to code blocks using the
-@code{:var} header argument.
+The following syntax is used to pass arguments to @samp{src} code blocks
+using the @code{:var} header argument.
@example
:var name=assign
@end example
-The argument, @code{assign}, can either be a literal value, such as a string
-@samp{"string"} or a number @samp{9}, or a reference to a table, a list, a
-literal example, another code block (with or without arguments), or the
-results of evaluating another code block.
+The @code{assign} is a literal value, such as a string @samp{"string"}, a
+number @samp{9}, a reference to a table, a list, a literal example, another
+code block (with or without arguments), or the results from evaluating a code
+block.
Here are examples of passing values by reference:
@@ -14719,8 +15883,8 @@ an Org mode table named with either a @code{#+NAME:} line
@end example
@item list
-a simple list named with a @code{#+NAME:} line (note that nesting is not
-carried through to the source code block)
+a simple list named with a @code{#+NAME:} line. Note that only the top level
+list items are passed along. Nested list items are ignored.
@example
#+NAME: example-list
@@ -14751,9 +15915,9 @@ optionally followed by parentheses
@end example
@item code block with arguments
-a code block name, as assigned by @code{#+NAME:}, followed by parentheses and
-optional arguments passed within the parentheses following the
-code block name using standard function call syntax
+a @samp{src} code block name, as assigned by @code{#+NAME:}, followed by
+parentheses and optional arguments passed within the parentheses following
+the @samp{src} code block name using standard function call syntax
@example
#+NAME: double
@@ -14765,7 +15929,7 @@ code block name using standard function call syntax
: 16
#+NAME: squared
-#+BEGIN_SRC emacs-lisp :var input=double(input=1)
+#+BEGIN_SRC emacs-lisp :var input=double(input=2)
(* input input)
#+END_SRC
@@ -14797,14 +15961,14 @@ on two lines
@end table
@subsubheading Indexable variable values
-It is possible to reference portions of variable values by ``indexing'' into
-the variables. Indexes are 0 based with negative values counting back from
-the end. If an index is separated by @code{,}s then each subsequent section
-will index into the next deepest nesting or dimension of the value. Note
-that this indexing occurs @emph{before} other table related header arguments
-like @code{:hlines}, @code{:colnames} and @code{:rownames} are applied. The
-following example assigns the last cell of the first row the table
-@code{example-table} to the variable @code{data}:
+Indexing variable values enables referencing portions of a variable. Indexes
+are 0 based with negative values counting backwards from the end. If an
+index is separated by @code{,}s then each subsequent section will index as
+the next dimension. Note that this indexing occurs @emph{before} other
+table-related header arguments are applied, such as @code{:hlines},
+@code{:colnames} and @code{:rownames}. The following example assigns the
+last cell of the first row the table @code{example-table} to the variable
+@code{data}:
@example
#+NAME: example-table
@@ -14844,10 +16008,9 @@ to @code{data}.
| 4 | d |
@end example
-Additionally, an empty index, or the single character @code{*}, are both
-interpreted to mean the entire range and as such are equivalent to
-@code{0:-1}, as shown in the following example in which the entire first
-column is referenced.
+To pick the entire range, use an empty index, or the single character
+@code{*}. @code{0:-1} does the same thing. Example below shows how to
+reference the first column only.
@example
#+NAME: example-table
@@ -14864,9 +16027,9 @@ column is referenced.
| 1 | 2 | 3 | 4 |
@end example
-It is possible to index into the results of code blocks as well as tables.
-Any number of dimensions can be indexed. Dimensions are separated from one
-another by commas, as shown in the following example.
+Index referencing can be used for tables and code blocks. Index referencing
+can handle any number of dimensions. Commas delimit multiple dimensions, as
+shown below.
@example
#+NAME: 3D
@@ -14886,14 +16049,13 @@ another by commas, as shown in the following example.
@subsubheading Emacs Lisp evaluation of variables
-Emacs lisp code can be used to initialize variable values. When a variable
-value starts with @code{(}, @code{[}, @code{'} or @code{`} it will be
-evaluated as Emacs Lisp and the result of the evaluation will be assigned as
-the variable value. The following example demonstrates use of this
-evaluation to reliably pass the file-name of the Org mode buffer to a code
-block---note that evaluation of header arguments is guaranteed to take place
-in the original Org mode file, while there is no such guarantee for
-evaluation of the code block body.
+Emacs lisp code can set the values for variables. To differentiate a value
+from lisp code, Org interprets any value starting with @code{(}, @code{[},
+@code{'} or @code{`} as Emacs Lisp code. The result of evaluating that code
+is then assigned to the value of that variable. The following example shows
+how to reliably query and pass file name of the Org mode buffer to a code
+block using headers. We need reliability here because the file's name could
+change once the code in the block starts executing.
@example
#+BEGIN_SRC sh :var filename=(buffer-file-name) :exports both
@@ -14901,14 +16063,14 @@ evaluation of the code block body.
#+END_SRC
@end example
-Note that values read from tables and lists will not be evaluated as
-Emacs Lisp, as shown in the following example.
+Note that values read from tables and lists will not be mistakenly evaluated
+as Emacs Lisp code, as illustrated in the following example.
@example
#+NAME: table
| (a b c) |
-#+HEADERS: :var data=table[0,0]
+#+HEADER: :var data=table[0,0]
#+BEGIN_SRC perl
$data
#+END_SRC
@@ -14917,167 +16079,171 @@ Emacs Lisp, as shown in the following example.
: (a b c)
@end example
-@node results, file, var, Specific header arguments
+@node results
@subsubsection @code{:results}
+@cindex @code{:results}, src header argument
-There are four classes of @code{:results} header argument. Only one option
-per class may be supplied per code block.
+There are four classes of @code{:results} header arguments. Each @samp{src}
+code block can take only one option per class.
@itemize @bullet
@item
-@b{collection} header arguments specify how the results should be collected
-from the code block
+@b{collection} for how the results should be collected from the @samp{src}
+code block
@item
-@b{type} header arguments specify what type of result the code block will
-return---which has implications for how they will be processed before
-insertion into the Org mode buffer
+@b{type} for which type of result the code block will return; affects how Org
+processes and inserts results in the Org buffer
@item
-@b{format} header arguments specify what type of result the code block will
-return---which has implications for how they will be inserted into the
-Org mode buffer
+@b{format} for the result; affects how Org processes and inserts results in
+the Org buffer
@item
-@b{handling} header arguments specify how the results of evaluating the code
-block should be handled.
+@b{handling} for processing results after evaluation of the @samp{src} code
+block
@end itemize
@subsubheading Collection
-The following options are mutually exclusive, and specify how the results
-should be collected from the code block.
+Collection options specify the results. Choose one of the options; they are
+mutually exclusive.
@itemize @bullet
@item @code{value}
-This is the default. The result is the value of the last statement in the
-code block. This header argument places the evaluation in functional
-mode. Note that in some languages, e.g., Python, use of this result type
-requires that a @code{return} statement be included in the body of the source
-code block. E.g., @code{:results value}.
+Default. Functional mode. Result is the value returned by the last
+statement in the @samp{src} code block. Languages like Python may require an
+explicit @code{return} statement in the @samp{src} code block. Usage
+example: @code{:results value}.
@item @code{output}
-The result is the collection of everything printed to STDOUT during the
-execution of the code block. This header argument places the
-evaluation in scripting mode. E.g., @code{:results output}.
+Scripting mode. Result is collected from STDOUT during execution of the code
+in the @samp{src} code block. Usage example: @code{:results output}.
@end itemize
@subsubheading Type
-
-The following options are mutually exclusive and specify what type of results
-the code block will return. By default, results are inserted as either a
-table or scalar depending on their value.
+Type tells what result types to expect from the execution of the code
+block. Choose one of the options; they are mutually exclusive. The default
+behavior is to automatically determine the result type.
@itemize @bullet
@item @code{table}, @code{vector}
-The results should be interpreted as an Org mode table. If a single value is
-returned, it will be converted into a table with one row and one column.
-E.g., @code{:results value table}.
+Interpret the results as an Org table. If the result is a single value,
+create a table with one row and one column. Usage example: @code{:results
+value table}.
@item @code{list}
-The results should be interpreted as an Org mode list. If a single scalar
-value is returned it will be converted into a list with only one element.
+Interpret the results as an Org list. If the result is a single value,
+create a list of one element.
@item @code{scalar}, @code{verbatim}
-The results should be interpreted literally---they will not be
-converted into a table. The results will be inserted into the Org mode
-buffer as quoted text. E.g., @code{:results value verbatim}.
+Interpret literally and insert as quoted text. Do not create a table. Usage
+example: @code{:results value verbatim}.
@item @code{file}
-The results will be interpreted as the path to a file, and will be inserted
-into the Org mode buffer as a file link. E.g., @code{:results value file}.
+Interpret as path to a file. Inserts a link to the file. Usage example:
+@code{:results value file}.
@end itemize
@subsubheading Format
-
-The following options are mutually exclusive and specify what type of results
-the code block will return. By default, results are inserted according to the
-type as specified above.
+Format pertains to the type of the result returned by the @samp{src} code
+block. Choose one of the options; they are mutually exclusive. The default
+follows from the type specified above.
@itemize @bullet
@item @code{raw}
-The results are interpreted as raw Org mode code and are inserted directly
-into the buffer. If the results look like a table they will be aligned as
-such by Org mode. E.g., @code{:results value raw}.
+Interpreted as raw Org mode. Inserted directly into the buffer. Aligned if
+it is a table. Usage example: @code{:results value raw}.
@item @code{org}
-The results are will be enclosed in a @code{BEGIN_SRC org} block.
-They are not comma-escaped by default but they will be if you hit @kbd{TAB}
-in the block and/or if you export the file. E.g., @code{:results value org}.
+Results enclosed in a @code{BEGIN_SRC org} block. For comma-escape, either
+@kbd{TAB} in the block, or export the file. Usage example: @code{:results
+value org}.
@item @code{html}
-Results are assumed to be HTML and will be enclosed in a @code{BEGIN_HTML}
-block. E.g., @code{:results value html}.
+Results enclosed in a @code{BEGIN_EXPORT html} block. Usage example:
+@code{:results value html}.
@item @code{latex}
-Results assumed to be @LaTeX{} and are enclosed in a @code{BEGIN_LaTeX} block.
-E.g., @code{:results value latex}.
+Results enclosed in a @code{BEGIN_EXPORT latex} block. Usage example:
+@code{:results value latex}.
@item @code{code}
-Result are assumed to be parsable code and are enclosed in a code block.
-E.g., @code{:results value code}.
+Result enclosed in a @samp{src} code block. Useful for parsing. Usage
+example: @code{:results value code}.
@item @code{pp}
-The result is converted to pretty-printed code and is enclosed in a code
-block. This option currently supports Emacs Lisp, Python, and Ruby. E.g.,
+Result converted to pretty-print source code. Enclosed in a @samp{src} code
+block. Languages supported: Emacs Lisp, Python, and Ruby. Usage example:
@code{:results value pp}.
@item @code{drawer}
-The result is wrapped in a RESULTS drawer. This can be useful for
-inserting @code{raw} or @code{org} syntax results in such a way that their
-extent is known and they can be automatically removed or replaced.
+Result wrapped in a RESULTS drawer. Useful for containing @code{raw} or
+@code{org} results for later scripting and automated processing. Usage
+example: @code{:results value drawer}.
@end itemize
@subsubheading Handling
-The following results options indicate what happens with the
-results once they are collected.
+Handling options after collecting the results.
@itemize @bullet
@item @code{silent}
-The results will be echoed in the minibuffer but will not be inserted into
-the Org mode buffer. E.g., @code{:results output silent}.
+Do not insert results in the Org mode buffer, but echo them in the
+minibuffer. Usage example: @code{:results output silent}.
@item @code{replace}
-The default value. Any existing results will be removed, and the new results
-will be inserted into the Org mode buffer in their place. E.g.,
-@code{:results output replace}.
+Default. Insert results in the Org buffer. Remove previous results. Usage
+example: @code{:results output replace}.
@item @code{append}
-If there are pre-existing results of the code block then the new results will
-be appended to the existing results. Otherwise the new results will be
-inserted as with @code{replace}.
+Append results to the Org buffer. Latest results are at the bottom. Does
+not remove previous results. Usage example: @code{:results output append}.
@item @code{prepend}
-If there are pre-existing results of the code block then the new results will
-be prepended to the existing results. Otherwise the new results will be
-inserted as with @code{replace}.
+Prepend results to the Org buffer. Latest results are at the top. Does not
+remove previous results. Usage example: @code{:results output prepend}.
@end itemize
-@node file, file-desc, results, Specific header arguments
+@node file
@subsubsection @code{:file}
+@cindex @code{:file}, src header argument
+
+An external @code{:file} that saves the results of execution of the code
+block. The @code{:file} is either a file name or two strings, where the
+first is the file name and the second is the description. A link to the file
+is inserted. It uses an Org mode style @code{[[file:]]} link (@pxref{Link
+format}). Some languages, such as @samp{R}, @samp{dot}, @samp{ditaa}, and
+@samp{gnuplot}, automatically wrap the source code in additional boilerplate
+code. Such code wrapping helps recreate the output, especially graphics
+output, by executing just the @code{:file} contents.
+
+@node file-desc
+@subsubsection @code{:file-desc}
-The header argument @code{:file} is used to specify an external file in which
-to save code block results. After code block evaluation an Org mode style
-@code{[[file:]]} link (see @ref{Link format}) to the file will be inserted
-into the Org mode buffer. Some languages including R, gnuplot, dot, and
-ditaa provide special handling of the @code{:file} header argument
-automatically wrapping the code block body in the boilerplate code required
-to save output to the specified file. This is often useful for saving
-graphical output of a code block to the specified file.
+A description of the results file. Org uses this description for the link
+(see @ref{Link format}) it inserts in the Org file. If the @code{:file-desc}
+has no value, Org will use file name for both the ``link'' and the
+``description'' portion of the Org mode link.
-The argument to @code{:file} should be either a string specifying the path to
-a file, or a list of two strings in which case the first element of the list
-should be the path to a file and the second a description for the link.
+@node file-ext
+@subsubsection @code{:file-ext}
+@cindex @code{:file-ext}, src header argument
-@node file-desc, dir, file, Specific header arguments
-@subsubsection @code{:file-desc}
+File name extension for the output file. Org generates the file's complete
+name, and extension by combining @code{:file-ext}, @code{#+NAME:} of the
+source block, and the @ref{output-dir} header argument. To override this
+auto generated file name, use the @code{:file} header argument.
-The value of the @code{:file-desc} header argument is used to provide a
-description for file code block results which are inserted as Org mode links
-(see @ref{Link format}). If the @code{:file-desc} header argument is given
-with no value the link path will be placed in both the ``link'' and the
-``description'' portion of the Org mode link.
+@node output-dir
+@subsubsection @code{:output-dir}
+@cindex @code{:output-dir}, src header argument
+
+Specifies the @code{:output-dir} for the results file. Org accepts an
+absolute path (beginning with @code{/}) or a relative directory (without
+@code{/}). The value can be combined with @code{#+NAME:} of the source block
+and @ref{file} or @ref{file-ext} header arguments.
-@node dir, exports, file-desc, Specific header arguments
+@node dir
@subsubsection @code{:dir} and remote execution
+@cindex @code{:dir}, src header argument
While the @code{:file} header argument can be used to specify the path to the
-output file, @code{:dir} specifies the default directory during code block
-execution. If it is absent, then the directory associated with the current
-buffer is used. In other words, supplying @code{:dir path} temporarily has
-the same effect as changing the current directory with @kbd{M-x cd path RET}, and
-then not supplying @code{:dir}. Under the surface, @code{:dir} simply sets
-the value of the Emacs variable @code{default-directory}.
+output file, @code{:dir} specifies the default directory during @samp{src}
+code block execution. If it is absent, then the directory associated with
+the current buffer is used. In other words, supplying @code{:dir path}
+temporarily has the same effect as changing the current directory with
+@kbd{M-x cd path RET}, and then not supplying @code{:dir}. Under the
+surface, @code{:dir} simply sets the value of the Emacs variable
+@code{default-directory}.
-When using @code{:dir}, you should supply a relative path for file output
-(e.g., @code{:file myfile.jpg} or @code{:file results/myfile.jpg}) in which
-case that path will be interpreted relative to the default directory.
+When using @code{:dir}, relative paths (for example, @code{:file myfile.jpg}
+or @code{:file results/myfile.jpg}) become relative to the default directory.
-In other words, if you want your plot to go into a folder called @file{Work}
-in your home directory, you could use
+For example, to save the plot file in the @samp{Work} folder of the home
+directory (notice tilde is expanded):
@example
#+BEGIN_SRC R :file myplot.png :dir ~/Work
@@ -15086,8 +16252,8 @@ matplot(matrix(rnorm(100), 10), type="l")
@end example
@subsubheading Remote execution
-A directory on a remote machine can be specified using tramp file syntax, in
-which case the code will be evaluated on the remote machine. An example is
+To evaluate the @samp{src} code block on a remote machine, supply a remote s
+directory name using @samp{Tramp} syntax. For example:
@example
#+BEGIN_SRC R :file plot.png :dir /scp:dand@@yakuba.princeton.edu:
@@ -15095,192 +16261,212 @@ plot(1:10, main=system("hostname", intern=TRUE))
#+END_SRC
@end example
-Text results will be returned to the local Org mode buffer as usual, and file
-output will be created on the remote machine with relative paths interpreted
-relative to the remote directory. An Org mode link to the remote file will be
-created.
-
-So, in the above example a plot will be created on the remote machine,
-and a link of the following form will be inserted in the org buffer:
+Org first captures the text results as usual for insertion in the Org file.
+Then Org also inserts a link to the remote file, thanks to Emacs
+@samp{Tramp}. Org constructs the remote path to the file name from
+@code{:dir} and @code{default-directory}, as illustrated here:
@example
[[file:/scp:dand@@yakuba.princeton.edu:/home/dand/plot.png][plot.png]]
@end example
-Most of this functionality follows immediately from the fact that @code{:dir}
-sets the value of the Emacs variable @code{default-directory}, thanks to
-tramp. Those using XEmacs, or GNU Emacs prior to version 23 may need to
-install tramp separately in order for these features to work correctly.
-@subsubheading Further points
+@subsubheading Some more warnings
@itemize @bullet
@item
-If @code{:dir} is used in conjunction with @code{:session}, although it will
-determine the starting directory for a new session as expected, no attempt is
-currently made to alter the directory associated with an existing session.
+When @code{:dir} is used with @code{:session}, Org sets the starting
+directory for a new session. But Org will not alter the directory of an
+already existing session.
@item
-@code{:dir} should typically not be used to create files during export with
-@code{:exports results} or @code{:exports both}. The reason is that, in order
-to retain portability of exported material between machines, during export
-links inserted into the buffer will @emph{not} be expanded against @code{default
-directory}. Therefore, if @code{default-directory} is altered using
-@code{:dir}, it is probable that the file will be created in a location to
-which the link does not point.
+Do not use @code{:dir} with @code{:exports results} or with @code{:exports
+both} to avoid Org inserting incorrect links to remote files. That is because
+Org does not expand @code{default directory} to avoid some underlying
+portability issues.
@end itemize
-@node exports, tangle, dir, Specific header arguments
+@node exports
@subsubsection @code{:exports}
+@cindex @code{:exports}, src header argument
-The @code{:exports} header argument specifies what should be included in HTML
-or @LaTeX{} exports of the Org mode file.
+The @code{:exports} header argument is to specify if that part of the Org
+file is exported to, say, HTML or @LaTeX{} formats. Note that
+@code{:exports} affects only @samp{src} code blocks and not inline code.
@itemize @bullet
@item @code{code}
-The default. The body of code is included into the exported file. E.g.,
+The default. The body of code is included into the exported file. Example:
@code{:exports code}.
@item @code{results}
-The result of evaluating the code is included in the exported file. E.g.,
-@code{:exports results}.
+The results of evaluation of the code is included in the exported file.
+Example: @code{:exports results}.
@item @code{both}
-Both the code and results are included in the exported file. E.g.,
-@code{:exports both}.
+Both the code and results of evaluation are included in the exported file.
+Example: @code{:exports both}.
@item @code{none}
-Nothing is included in the exported file. E.g., @code{:exports none}.
+Neither the code nor the results of evaluation is included in the exported
+file. Whether the code is evaluated at all depends on other
+options. Example: @code{:exports none}.
@end itemize
-@node tangle, mkdirp, exports, Specific header arguments
+@node tangle
@subsubsection @code{:tangle}
+@cindex @code{:tangle}, src header argument
-The @code{:tangle} header argument specifies whether or not the code
-block should be included in tangled extraction of source code files.
+The @code{:tangle} header argument specifies if the @samp{src} code block is
+exported to source file(s).
@itemize @bullet
@item @code{tangle}
-The code block is exported to a source code file named after the full path
-(including the directory) and file name (w/o extension) of the Org mode file.
-E.g., @code{:tangle yes}.
+Export the @samp{src} code block to source file. The file name for the
+source file is derived from the name of the Org file, and the file extension
+is derived from the source code language identifier. Example: @code{:tangle
+yes}.
@item @code{no}
-The default. The code block is not exported to a source code file.
-E.g., @code{:tangle no}.
+The default. Do not extract the code a source code file. Example:
+@code{:tangle no}.
@item other
-Any other string passed to the @code{:tangle} header argument is interpreted
-as a path (directory and file name relative to the directory of the Org mode
-file) to which the block will be exported. E.g., @code{:tangle path}.
+Export the @samp{src} code block to source file whose file name is derived
+from any string passed to the @code{:tangle} header argument. Org derives
+the file name as being relative to the directory of the Org file's location.
+Example: @code{:tangle path}.
@end itemize
-@node mkdirp, comments, tangle, Specific header arguments
+@node mkdirp
@subsubsection @code{:mkdirp}
+@cindex @code{:mkdirp}, src header argument
-The @code{:mkdirp} header argument can be used to create parent directories
-of tangled files when missing. This can be set to @code{yes} to enable
-directory creation or to @code{no} to inhibit directory creation.
+The @code{:mkdirp} header argument creates parent directories for tangled
+files if the directory does not exist. @code{yes} enables directory creation
+and @code{no} inhibits directory creation.
-@node comments, padline, mkdirp, Specific header arguments
+@node comments
@subsubsection @code{:comments}
-By default code blocks are tangled to source-code files without any insertion
-of comments beyond those which may already exist in the body of the code
-block. The @code{:comments} header argument can be set as follows to control
-the insertion of extra comments into the tangled code file.
+@cindex @code{:comments}, src header argument
+Controls inserting comments into tangled files. These are above and beyond
+whatever comments may already exist in the @samp{src} code block.
@itemize @bullet
@item @code{no}
-The default. No extra comments are inserted during tangling.
+The default. Do not insert any extra comments during tangling.
@item @code{link}
-The code block is wrapped in comments which contain pointers back to the
-original Org file from which the code was tangled.
+Wrap the @samp{src} code block in comments. Include links pointing back to
+the place in the Org file from where the code was tangled.
@item @code{yes}
-A synonym for ``link'' to maintain backwards compatibility.
+Kept for backward compatibility; same as ``link''.
@item @code{org}
-Include text from the Org mode file as a comment.
-The text is picked from the leading context of the tangled code and is
-limited by the nearest headline or source block as the case may be.
+Nearest headline text from Org file is inserted as comment. The exact text
+that is inserted is picked from the leading context of the source block.
@item @code{both}
-Turns on both the ``link'' and ``org'' comment options.
+Includes both ``link'' and ``org'' comment options.
@item @code{noweb}
-Turns on the ``link'' comment option, and additionally wraps expanded noweb
-references in the code block body in link comments.
+Includes ``link'' comment option, expands noweb references, and wraps them in
+link comments inside the body of the @samp{src} code block.
@end itemize
-@node padline, no-expand, comments, Specific header arguments
+@node padline
@subsubsection @code{:padline}
-Control in insertion of padding lines around code block bodies in tangled
-code files. The default value is @code{yes} which results in insertion of
-newlines before and after each tangled code block. The following arguments
-are accepted.
-
+@cindex @code{:padline}, src header argument
+Control insertion of newlines to pad @samp{src} code blocks in the tangled
+file.
@itemize @bullet
@item @code{yes}
-Insert newlines before and after each code block body in tangled code files.
+Default. Insert a newline before and after each @samp{src} code block in the
+tangled file.
@item @code{no}
-Do not insert any newline padding in tangled output.
+Do not insert newlines to pad the tangled @samp{src} code blocks.
@end itemize
-@node no-expand, session, padline, Specific header arguments
+@node no-expand
@subsubsection @code{:no-expand}
-
-By default, code blocks are expanded with @code{org-babel-expand-src-block}
-during tangling. This has the effect of assigning values to variables
-specified with @code{:var} (see @ref{var}), and of replacing ``noweb''
-references (see @ref{Noweb reference syntax}) with their targets. The
-@code{:no-expand} header argument can be used to turn off this behavior.
-
-@node session, noweb, no-expand, Specific header arguments
+@cindex @code{:no-expand}, src header argument
+
+By default Org expands @samp{src} code blocks during tangling. The
+@code{: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 to @code{:var} (@pxref{var}) variables. Expansions also replace Noweb
+references with their targets (@pxref{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 @samp{src} code blocks for execution have to be expanded anyway.
+
+@node session
@subsubsection @code{:session}
+@cindex @code{:session}, src header argument
-The @code{:session} header argument starts a session for an interpreted
-language where state is preserved.
+The @code{:session} header argument is for running multiple source code
+blocks under one session. Org runs @samp{src} code blocks with the same
+session name in the same interpreter process.
-By default, a session is not started.
-
-A string passed to the @code{:session} header argument will give the session
-a name. This makes it possible to run concurrent sessions for each
-interpreted language.
+@itemize @bullet
+@item @code{none}
+Default. Each @samp{src} code block gets a new interpreter process to
+execute. The process terminates once the block is evaluated.
+@item @code{other}
+Any string besides @code{none} turns that string into the name of that
+session. For example, @code{:session mysession} names it @samp{mysession}.
+If @code{:session} has no argument, then the session name is derived from the
+source language identifier. Subsequent blocks with the same source code
+language use the same session. Depending on the language, state variables,
+code from other blocks, and the overall interpreted environment may be
+shared. Some interpreted languages support concurrent sessions when
+subsequent source code language blocks change session names.
+@end itemize
-@node noweb, noweb-ref, session, Specific header arguments
+@node noweb
@subsubsection @code{:noweb}
+@cindex @code{:noweb}, src header argument
-The @code{:noweb} header argument controls expansion of ``noweb'' syntax
-references (see @ref{Noweb reference syntax}) when the code block is
-evaluated, tangled, or exported. The @code{:noweb} header argument can have
-one of the five values: @code{no}, @code{yes}, @code{tangle}, or
-@code{no-export} @code{strip-export}.
+The @code{:noweb} header argument controls expansion of Noweb syntax
+references (@pxref{Noweb reference syntax}). Expansions occur when source
+code blocks are evaluated, tangled, or exported.
@itemize @bullet
@item @code{no}
-The default. ``Noweb'' syntax references in the body of the code block will
-not be expanded before the code block is evaluated, tangled or exported.
+Default. No expansion of Noweb syntax references in the body of the code
+when evaluating, tangling, or exporting.
@item @code{yes}
-``Noweb'' syntax references in the body of the code block will be
-expanded before the code block is evaluated, tangled or exported.
+Expansion of Noweb syntax references in the body of the @samp{src} code block
+when evaluating, tangling, or exporting.
@item @code{tangle}
-``Noweb'' syntax references in the body of the code block will be expanded
-before the code block is tangled. However, ``noweb'' syntax references will
-not be expanded when the code block is evaluated or exported.
+Expansion of Noweb syntax references in the body of the @samp{src} code block
+when tangling. No expansion when evaluating or exporting.
@item @code{no-export}
-``Noweb'' syntax references in the body of the code block will be expanded
-before the block is evaluated or tangled. However, ``noweb'' syntax
-references will not be expanded when the code block is exported.
+Expansion of Noweb syntax references in the body of the @samp{src} code block
+when evaluating or tangling. No expansion when exporting.
@item @code{strip-export}
-``Noweb'' syntax references in the body of the code block will be expanded
-before the block is evaluated or tangled. However, ``noweb'' syntax
-references will be removed when the code block is exported.
+Expansion of Noweb syntax references in the body of the @samp{src} code block
+when expanding prior to evaluating or tangling. Removes Noweb syntax
+references when exporting.
@item @code{eval}
-``Noweb'' syntax references in the body of the code block will only be
-expanded before the block is evaluated.
+Expansion of Noweb syntax references in the body of the @samp{src} code block
+only before evaluating.
@end itemize
@subsubheading Noweb prefix lines
-Noweb insertions are now placed behind the line prefix of the
-@code{<<reference>>}.
+Noweb insertions now honor prefix characters that appear before the Noweb
+syntax reference.
+
This behavior is illustrated in the following example. Because the
@code{<<example>>} noweb reference appears behind the SQL comment syntax,
each line of the expanded noweb reference will be commented.
-This code block:
+With:
+
+@example
+#+NAME: example
+#+BEGIN_SRC text
+this is the
+multi-line body of example
+#+END_SRC
+@end example
+
+this @samp{src} code block:
@example
+#+BEGIN_SRC sql :noweb yes
-- <<example>>
+#+END_SRC
@end example
expands to:
@@ -15290,23 +16476,63 @@ expands to:
-- multi-line body of example
@end example
-Note that noweb replacement text that does not contain any newlines will not
-be affected by this change, so it is still possible to use inline noweb
-references.
+Since this change will 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
+
+this @samp{src} code block:
-@node noweb-ref, noweb-sep, noweb, Specific header arguments
+@example
+#+BEGIN_SRC python :noweb yes :results output
+if True:
+ <<if-true>>
+else:
+ <<if-false>>
+#+END_SRC
+@end example
+
+expands to:
+
+@example
+if True:
+ print('Do things when True')
+else:
+ print('Do things when False')
+@end example
+
+and evaluates to:
+
+@example
+Do things when True
+@end example
+
+@node noweb-ref
@subsubsection @code{:noweb-ref}
-When expanding ``noweb'' style references the bodies of all code block with
-@emph{either} a block name matching the reference name @emph{or} a
-@code{:noweb-ref} header argument matching the reference name will be
-concatenated together to form the replacement text.
+@cindex @code{:noweb-ref}, src header argument
-By setting this header argument at the sub-tree or file level, simple code
-block concatenation may be achieved. For example, when tangling the
-following Org mode file, the bodies of code blocks will be concatenated into
-the resulting pure code file@footnote{(The example needs property inheritance
-to be turned on for the @code{noweb-ref} property, see @ref{Property
-inheritance}).}.
+When expanding Noweb style references, Org concatenates @samp{src} code
+blocks by matching the reference name to either the code block name or the
+@code{:noweb-ref} header argument.
+
+For simple concatenation, set this @code{: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.
@example
#+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh
@@ -15314,7 +16540,7 @@ inheritance}).}.
#+END_SRC
* the mount point of the fullest disk
:PROPERTIES:
- :noweb-ref: fullest-disk
+ :header-args: :noweb-ref fullest-disk
:END:
** query all mounted disks
@@ -15333,45 +16559,60 @@ inheritance}).}.
#+END_SRC
@end example
-The @code{:noweb-sep} (see @ref{noweb-sep}) header argument holds the string
-used to separate accumulate noweb references like those above. By default a
-newline is used.
-
-@node noweb-sep, cache, noweb-ref, Specific header arguments
+@node noweb-sep
@subsubsection @code{:noweb-sep}
+@cindex @code{:noweb-sep}, src header argument
-The @code{:noweb-sep} header argument holds the string used to separate
-accumulate noweb references (see @ref{noweb-ref}). By default a newline is
-used.
+By default a newline separates each noweb reference concatenation. To change
+this newline separator, edit the @code{:noweb-sep} (@pxref{noweb-sep}) header
+argument.
-@node cache, sep, noweb-sep, Specific header arguments
+@node cache
@subsubsection @code{:cache}
-
-The @code{:cache} header argument controls the use of in-buffer caching of
-the results of evaluating code blocks. It can be used to avoid re-evaluating
-unchanged code blocks. Note that the @code{:cache} header argument will not
-attempt to cache results when the @code{:session} header argument is used,
-because the results of the code block execution may be stored in the session
-outside of the Org mode buffer. The @code{:cache} header argument can have
-one of two values: @code{yes} or @code{no}.
+@cindex @code{:cache}, src header argument
+
+The @code{:cache} header argument is for caching results of evaluating code
+blocks. Caching results can avoid re-evaluating @samp{src} code blocks that
+have not changed since the previous run. To benefit from the cache and avoid
+redundant evaluations, the source block must have a result already present in
+the buffer, and neither the header arguments (including the value of
+@code{:var} references) nor the text of the block itself has changed since
+the result was last computed. This feature greatly helps avoid long-running
+calculations. For some edge cases, however, the cached results may not be
+reliable.
+
+The caching feature is best for when @samp{src} blocks are pure functions,
+that is functions that return the same value for the same input arguments
+(@pxref{var}), and that do not have side effects, and do not rely on external
+variables other than the input arguments. Functions that depend on a timer,
+file system objects, and random number generators are clearly unsuitable for
+caching.
+
+A note of warning: when @code{:cache} is used for a @code{:session}, caching
+may cause unexpected results.
+
+When the caching mechanism tests for any source code changes, it will not
+expand Noweb style references (@pxref{Noweb reference syntax}). For reasons
+why, see @uref{http://thread.gmane.org/gmane.emacs.orgmode/79046}.
+
+The @code{:cache} header argument can have one of two values: @code{yes} or
+@code{no}.
@itemize @bullet
@item @code{no}
-The default. No caching takes place, and the code block will be evaluated
-every time it is called.
+Default. No caching of results; @samp{src} code block evaluated every time.
@item @code{yes}
-Every time the code block is run a SHA1 hash of the code and arguments
-passed to the block will be generated. This hash is packed into the
-@code{#+RESULTS:} line and will be checked on subsequent
-executions of the code block. If the code block has not
-changed since the last time it was evaluated, it will not be re-evaluated.
+Whether to run the code or return the cached results is determined by
+comparing the SHA1 hash value of the combined @samp{src} code block and
+arguments passed to it. This hash value is packed on the @code{#+RESULTS:}
+line from previous evaluation. When hash values match, Org does not evaluate
+the @samp{src} code block. When hash values mismatch, Org evaluates the
+@samp{src} code block, inserts the results, recalculates the hash value, and
+updates @code{#+RESULTS:} line.
@end itemize
-Code block caches notice if the value of a variable argument
-to the code block has changed. If this is the case, the cache is
-invalidated and the code block is re-run. In the following example,
-@code{caller} will not be re-run unless the results of @code{random} have
-changed since it was last run.
+In this example, both functions are cached. But @code{caller} runs only if
+the result from @code{random} has changed since the last run.
@example
#+NAME: random
@@ -15391,32 +16632,31 @@ changed since it was last run.
0.254227238707244
@end example
-@node sep, hlines, cache, Specific header arguments
+@node sep
@subsubsection @code{:sep}
+@cindex @code{:sep}, src header argument
-The @code{:sep} header argument can be used to control the delimiter used
-when writing tabular results out to files external to Org mode. This is used
-either when opening tabular results of a code block by calling the
-@code{org-open-at-point} function bound to @kbd{C-c C-o} on the code block,
-or when writing code block results to an external file (see @ref{file})
-header argument.
-
-By default, when @code{:sep} is not specified output tables are tab
-delimited.
+The @code{:sep} header argument is the delimiter for saving results as tables
+to files (@pxref{file}) external to Org mode. Org defaults to tab delimited
+output. The function, @code{org-open-at-point}, which is bound to @kbd{C-c
+C-o}, also uses @code{:sep} for opening tabular results.
-@node hlines, colnames, sep, Specific header arguments
+@node hlines
@subsubsection @code{:hlines}
+@cindex @code{:hlines}, src header argument
-Tables are frequently represented with one or more horizontal lines, or
-hlines. The @code{:hlines} argument to a code block accepts the
-values @code{yes} or @code{no}, with a default value of @code{no}.
+In-between each table row or below the table headings, sometimes results have
+horizontal lines, which are also known as hlines. The @code{:hlines}
+argument with the value @code{yes} accepts such lines. The default is
+@code{no}.
@itemize @bullet
@item @code{no}
-Strips horizontal lines from the input table. In most languages this is the
-desired effect because an @code{hline} symbol is interpreted as an unbound
-variable and raises an error. Setting @code{:hlines no} or relying on the
-default value yields the following results.
+Strips horizontal lines from the input table. For most code, this is
+desirable, or else those @code{hline} symbols raise unbound variable errors.
+
+The default is @code{:hlines no}. The example shows hlines removed from the
+input table.
@example
#+NAME: many-cols
@@ -15438,7 +16678,7 @@ default value yields the following results.
@end example
@item @code{yes}
-Leaves hlines in the table. Setting @code{:hlines yes} has this effect.
+For @code{:hlines yes}, the example shows hlines unchanged.
@example
#+NAME: many-cols
@@ -15462,20 +16702,20 @@ Leaves hlines in the table. Setting @code{:hlines yes} has this effect.
@end example
@end itemize
-@node colnames, rownames, hlines, Specific header arguments
+@node colnames
@subsubsection @code{:colnames}
+@cindex @code{:colnames}, src header argument
-The @code{:colnames} header argument accepts the values @code{yes},
-@code{no}, or @code{nil} for unassigned. The default value is @code{nil}.
-Note that the behavior of the @code{:colnames} header argument may differ
-across languages.
+The @code{:colnames} header argument accepts @code{yes}, @code{no}, or
+@code{nil} values. The default value is @code{nil}, which is unassigned.
+But this header argument behaves differently depending on the source code
+language.
@itemize @bullet
@item @code{nil}
-If an input table looks like it has column names
-(because its second row is an hline), then the column
-names will be removed from the table before
-processing, then reapplied to the results.
+If an input table has column names (because the second row is an hline), then
+Org removes the column names, processes the table, puts back the column
+names, and then writes the table to the results block.
@example
#+NAME: less-cols
@@ -15496,33 +16736,36 @@ processing, then reapplied to the results.
| c* |
@end example
-Please note that column names are not removed before the table is indexed
-using variable indexing @xref{var, Indexable variable values}.
+Note that column names have to accounted for when using variable indexing
+(@pxref{var, Indexable variable values}) because column names are not removed
+for indexing.
@item @code{no}
-No column name pre-processing takes place
+Do not pre-process column names.
@item @code{yes}
-Column names are removed and reapplied as with @code{nil} even if the table
-does not ``look like'' it has column names (i.e., the second row is not an
-hline)
+For an input table that has no hlines, process it like the @code{nil}
+value. That is, Org removes the column names, processes the table, puts back
+the column names, and then writes the table to the results block.
@end itemize
-@node rownames, shebang, colnames, Specific header arguments
+@node rownames
@subsubsection @code{:rownames}
+@cindex @code{:rownames}, src header argument
-The @code{:rownames} header argument can take on the values @code{yes} or
-@code{no}, with a default value of @code{no}. Note that Emacs Lisp code
-blocks ignore the @code{:rownames} header argument entirely given the ease
-with which tables with row names may be handled directly in Emacs Lisp.
+The @code{:rownames} header argument can take on values @code{yes} or
+@code{no} values. The default is @code{no}. Note that @code{emacs-lisp}
+code blocks ignore @code{:rownames} header argument because of the ease of
+table-handling in Emacs.
@itemize @bullet
@item @code{no}
-No row name pre-processing will take place.
+Org will not pre-process row names.
@item @code{yes}
-The first column of the table is removed from the table before processing,
-and is then reapplied to the results.
+If an input table has row names, then Org removes the row names, processes
+the table, puts back the row names, and then writes the table to the results
+block.
@example
#+NAME: with-rownames
@@ -15539,82 +16782,88 @@ and is then reapplied to the results.
| two | 16 | 17 | 18 | 19 | 20 |
@end example
-Please note that row names are not removed before the table is indexed using
-variable indexing @xref{var, Indexable variable values}.
+Note that row names have to accounted for when using variable indexing
+(@pxref{var, Indexable variable values}) because row names are not removed
+for indexing.
@end itemize
-@node shebang, tangle-mode, rownames, Specific header arguments
+@node shebang
@subsubsection @code{:shebang}
+@cindex @code{:shebang}, src header argument
-Setting the @code{:shebang} header argument to a string value
-(e.g., @code{:shebang "#!/bin/bash"}) causes the string to be inserted as the
-first line of any tangled file holding the code block, and the file
-permissions of the tangled file are set to make it executable.
-
+This header argument can turn results into executable script files. By
+setting the @code{:shebang} header argument to a string value (for example,
+@code{:shebang "#!/bin/bash"}), Org inserts that string as the first line of
+the tangled file that the @samp{src} code block is extracted to. Org then
+turns on the tangled file's executable permission.
-@node tangle-mode, eval, shebang, Specific header arguments
+@node tangle-mode
@subsubsection @code{:tangle-mode}
+@cindex @code{:tangle-mode}, src header argument
-The @code{tangle-mode} header argument controls the permission set on tangled
-files. The value of this header argument will be passed to
-@code{set-file-modes}. For example, to set a tangled file as read only use
-@code{:tangle-mode (identity #o444)}, or to set a tangled file as executable
-use @code{:tangle-mode (identity #o755)}. Blocks with @code{shebang}
-(@ref{shebang}) header arguments will automatically be made executable unless
-the @code{tangle-mode} header argument is also used. The behavior is
-undefined if multiple code blocks with different values for the
-@code{tangle-mode} header argument are tangled to the same file.
-
-@node eval, wrap, tangle-mode, Specific header arguments
+The @code{tangle-mode} header argument specifies what permissions to set for
+tangled files by @code{set-file-modes}. For example, to make read-only
+tangled file, use @code{:tangle-mode (identity #o444)}. To make it
+executable, use @code{:tangle-mode (identity #o755)}.
+
+On @samp{src} code blocks with @code{shebang} (@pxref{shebang}) header
+argument, Org will automatically set the tangled file to executable
+permissions. But this can be overridden with custom permissions using
+@code{tangle-mode} header argument.
+
+When multiple @samp{src} code blocks tangle to a single file with different
+and conflicting @code{tangle-mode} header arguments, Org's behavior is
+undefined.
+
+@node eval
@subsubsection @code{:eval}
-The @code{:eval} header argument can be used to limit the evaluation of
-specific code blocks. The @code{:eval} header argument can be useful for
-protecting against the evaluation of dangerous code blocks or to ensure that
-evaluation will require a query regardless of the value of the
-@code{org-confirm-babel-evaluate} variable. The possible values of
-@code{:eval} and their effects are shown below.
+@cindex @code{:eval}, src header argument
+The @code{:eval} header argument can limit evaluation of specific code
+blocks. It is useful for protection against evaluating untrusted @samp{src}
+code blocks by prompting for a confirmation. This protection is independent
+of the @code{org-confirm-babel-evaluate} setting.
@table @code
@item never or no
-The code block will not be evaluated under any circumstances.
+Org will never evaluate this @samp{src} code block.
@item query
-Evaluation of the code block will require a query.
+Org prompts the user for permission to evaluate this @samp{src} code block.
@item never-export or no-export
-The code block will not be evaluated during export but may still be called
-interactively.
+Org will not evaluate this @samp{src} code block when exporting, yet the user
+can evaluate this source block interactively.
@item query-export
-Evaluation of the code block during export will require a query.
+Org prompts the user for permission to export this @samp{src} code block.
@end table
-If this header argument is not set then evaluation is determined by the value
-of the @code{org-confirm-babel-evaluate} variable see @ref{Code evaluation
-security}.
+If @code{:eval} header argument is not set for a source block, then Org
+determines whether to evaluate from the @code{org-confirm-babel-evaluate}
+variable (@pxref{Code evaluation security}).
-@node wrap, post, eval, Specific header arguments
+@node wrap
@subsubsection @code{:wrap}
-The @code{:wrap} header argument is used to mark the results of source block
-evaluation. The header argument can be passed a string that will be appended
-to @code{#+BEGIN_} and @code{#+END_}, which will then be used to wrap the
-results. If not string is specified then the results will be wrapped in a
-@code{#+BEGIN/END_RESULTS} block.
+@cindex @code{:wrap}, src header argument
+The @code{:wrap} header argument marks the results block by appending strings
+to @code{#+BEGIN_} and @code{#+END_}. If no string is specified, Org wraps
+the results in a @code{#+BEGIN/END_RESULTS} block.
-@node post, prologue, wrap, Specific header arguments
+@node post
@subsubsection @code{:post}
-The @code{:post} header argument is used to post-process the results of a
-code block execution. When a post argument is given, the results of the code
-block will temporarily be bound to the @code{*this*} variable. This variable
-may then be included in header argument forms such as those used in @ref{var}
-header argument specifications allowing passing of results to other code
-blocks, or direct execution via Emacs Lisp.
-
-The following example illustrates the usage of the @code{:post} header
-argument.
+@cindex @code{:post}, src header argument
+The @code{:post} header argument is for post-processing results from
+@samp{src} block evaluation. When @code{:post} has any value, Org binds the
+results to @code{*this*} variable for easy passing to @ref{var} header
+argument specifications. That makes results available to other @samp{src}
+code blocks, or for even direct Emacs Lisp code execution.
+
+The following two examples illustrate @code{:post} header argument in action.
+The first one shows how to attach @code{#+ATTR_LATEX:} line using
+@code{:post}.
@example
#+name: attr_wrap
#+begin_src sh :var data="" :var width="\\textwidth" :results output
- echo "#+ATTR_LATEX :width $width"
+ echo "#+ATTR_LATEX: :width $width"
echo "$data"
#+end_src
@@ -15634,33 +16883,65 @@ argument.
:END:
@end example
-@node prologue, epilogue, post, Specific header arguments
+The second example shows use of @code{:colnames} in @code{:post} to pass
+data between @samp{src} code blocks.
+
+@example
+#+name: round-tbl
+#+begin_src emacs-lisp :var tbl="" fmt="%.3f"
+ (mapcar (lambda (row)
+ (mapcar (lambda (cell)
+ (if (numberp cell)
+ (format fmt cell)
+ cell))
+ row))
+ tbl)
+#+end_src
+
+#+begin_src R :colnames yes :post round-tbl[:colnames yes](*this*)
+set.seed(42)
+data.frame(foo=rnorm(1))
+#+end_src
+
+#+RESULTS:
+| foo |
+|-------|
+| 1.371 |
+@end example
+
+@node prologue
@subsubsection @code{:prologue}
-The value of the @code{prologue} header argument will be prepended to the
-code block body before execution. For example, @code{:prologue "reset"} may
-be used to reset a gnuplot session before execution of a particular code
-block, or the following configuration may be used to do this for all gnuplot
-code blocks. Also see @ref{epilogue}.
+@cindex @code{:prologue}, src header argument
+The @code{prologue} header argument is for appending to the top of the code
+block for execution. For example, a clear or reset code at the start of new
+execution of a @samp{src} code block. A @code{reset} for @samp{gnuplot}:
+@code{:prologue "reset"}. See also @ref{epilogue}.
@lisp
(add-to-list 'org-babel-default-header-args:gnuplot
'((:prologue . "reset")))
@end lisp
-@node epilogue, , prologue, Specific header arguments
+@node epilogue
@subsubsection @code{:epilogue}
-The value of the @code{epilogue} header argument will be appended to the code
-block body before execution. Also see @ref{prologue}.
+@cindex @code{:epilogue}, src header argument
+The value of the @code{epilogue} header argument is for appending to the end
+of the code block for execution. See also @ref{prologue}.
-@node Results of evaluation, Noweb reference syntax, Header arguments, Working With Source Code
+@node Results of evaluation
@section Results of evaluation
@cindex code block, results of evaluation
@cindex source code, results of evaluation
-The way in which results are handled depends on whether a session is invoked,
-as well as on whether @code{:results value} or @code{:results output} is
-used. The following table shows the table possibilities. For a full listing
-of the possible results header arguments see @ref{results}.
+How Org handles results of a code block execution depends on many header
+arguments working together. Here is only a summary of these. For an
+enumeration of all the header arguments that affect results, see
+@ref{results}.
+
+The primary determinant is the execution context. Is it in a @code{:session}
+or not? Orthogonal to that is if the expected result is a @code{:results
+value} or @code{:results output}, which is a concatenation of output from
+start to finish of the @samp{src} code block's evaluation.
@multitable @columnfractions 0.26 0.33 0.41
@item @tab @b{Non-session} @tab @b{Session}
@@ -15668,51 +16949,54 @@ of the possible results header arguments see @ref{results}.
@item @code{:results output} @tab contents of STDOUT @tab concatenation of interpreter output
@end multitable
-Note: With @code{:results value}, the result in both @code{:session} and
-non-session is returned to Org mode as a table (a one- or two-dimensional
-vector of strings or numbers) when appropriate.
+For @code{:session} and non-session, the @code{:results value} turns the
+results into an Org mode table format. Single values are wrapped in a one
+dimensional vector. Rows and columns of a table are wrapped in a
+two-dimensional vector.
@subsection Non-session
@subsubsection @code{:results value}
-This is the default. Internally, the value is obtained by wrapping the code
-in a function definition in the external language, and evaluating that
-function. Therefore, code should be written as if it were the body of such a
-function. In particular, note that Python does not automatically return a
-value from a function unless a @code{return} statement is present, and so a
-@samp{return} statement will usually be required in Python.
+@cindex @code{:results}, src header argument
+Default. Org gets the value by wrapping the code in a function definition in
+the language of the @samp{src} block. That is why when using @code{: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 @code{:results value}.
-This is the only one of the four evaluation contexts in which the code is
-automatically wrapped in a function definition.
+This is one of four evaluation contexts where Org automatically wraps the
+code in a function definition.
@subsubsection @code{:results output}
-The code is passed to the interpreter as an external process, and the
-contents of the standard output stream are returned as text. (In certain
-languages this also contains the error output stream; this is an area for
-future work.)
+@cindex @code{:results}, src header argument
+For @code{:results output}, the code is passed to an external process running
+the interpreter. Org returns the contents of the standard output stream as
+as text results.
@subsection Session
@subsubsection @code{:results value}
-The code is passed to an interpreter running as an interactive Emacs inferior
-process. Only languages which provide tools for interactive evaluation of
-code have session support, so some language (e.g., C and ditaa) do not
-support the @code{:session} header argument, and in other languages (e.g.,
-Python and Haskell) which have limitations on the code which may be entered
-into interactive sessions, those limitations apply to the code in code blocks
-using the @code{:session} header argument as well.
-
-Unless the @code{:results output} option is supplied (see below) the result
-returned is the result of the last evaluation performed by the
-interpreter. (This is obtained in a language-specific manner: the value of
-the variable @code{_} in Python and Ruby, and the value of @code{.Last.value}
-in R).
+@cindex @code{:results}, src header argument
+For @code{:results value} from a @code{:session}, Org passes the code to an
+interpreter running as an interactive Emacs inferior process. So only
+languages that provide interactive evaluation can have session support. Not
+all languages provide this support, such as @samp{C} and @samp{ditaa}. Even
+those that do support, such as @samp{Python} and @samp{Haskell}, they impose
+limitations on allowable language constructs that can run interactively. Org
+inherits those limitations for those @samp{src} code blocks running in a
+@code{:session}.
+
+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 @samp{Python} and @samp{Ruby}, and the
+value of @code{.Last.value} in @samp{R}).
@subsubsection @code{:results output}
-The code is passed to the interpreter running as an interactive Emacs
-inferior process. The result returned is the concatenation of the sequence of
-(text) output from the interactive interpreter. Notice that this is not
-necessarily the same as what would be sent to @code{STDOUT} if the same code
-were passed to a non-interactive interpreter running as an external
-process. For example, compare the following two blocks:
+@cindex @code{:results}, src header argument
+For @code{:results output}, Org passes the code to the interpreter running as
+an interactive Emacs inferior process. Org concatenates whatever text output
+emitted by the interpreter to return the collection as a result. Note that
+this collection is not the same as collected from @code{STDOUT} of a
+non-interactive interpreter running as an external process. Compare for
+example these two blocks:
@example
#+BEGIN_SRC python :results output
@@ -15726,7 +17010,8 @@ process. For example, compare the following two blocks:
: bye
@end example
-In non-session mode, the ``2'' is not printed and does not appear.
+In the above non-session mode, the ``2'' is not printed; so does not appear
+in results.
@example
#+BEGIN_SRC python :results output :session
@@ -15741,60 +17026,103 @@ In non-session mode, the ``2'' is not printed and does not appear.
: bye
@end example
-But in @code{:session} mode, the interactive interpreter receives input ``2''
-and prints out its value, ``2''. (Indeed, the other print statements are
-unnecessary here).
+In the above @code{:session} mode, the interactive interpreter receives and
+prints ``2''. Results show that.
-@node Noweb reference syntax, Key bindings and useful functions, Results of evaluation, Working With Source Code
+@node Noweb reference syntax
@section Noweb reference syntax
@cindex code block, noweb reference
@cindex syntax, noweb
@cindex source code, noweb reference
-The ``noweb'' (see @uref{http://www.cs.tufts.edu/~nr/noweb/}) Literate
-Programming system allows named blocks of code to be referenced by using the
-familiar Noweb syntax:
+Org supports named blocks in Noweb style syntax. For Noweb literate
+programming details, see @uref{http://www.cs.tufts.edu/~nr/noweb/}).
@example
<<code-block-name>>
@end example
-When a code block is tangled or evaluated, whether or not ``noweb''
-references are expanded depends upon the value of the @code{:noweb} header
-argument. If @code{:noweb yes}, then a Noweb reference is expanded before
-evaluation. If @code{:noweb no}, the default, then the reference is not
-expanded before evaluation. See the @ref{noweb-ref} header argument for
-a more flexible way to resolve noweb references.
+For the header argument @code{:noweb yes}, Org expands Noweb style references
+in the @samp{src} code block before evaluation.
+
+For the header argument @code{:noweb no}, Org does not expand Noweb style
+references in the @samp{src} code block before evaluation.
+
+The default is @code{:noweb no}. Org defaults to @code{:noweb no} so as not
+to cause errors in languages where Noweb syntax is ambiguous. Change Org's
+default to @code{:noweb yes} for languages where there is no risk of
+confusion.
-It is possible to include the @emph{results} of a code block rather than the
-body. This is done by appending parenthesis to the code block name which may
-optionally contain arguments to the code block as shown below.
+Org offers a more flexible way to resolve Noweb style references
+(@pxref{noweb-ref}).
+
+Org can include the @emph{results} of a code block rather than its body. To
+that effect, append parentheses, possibly including arguments, to the code
+block name, as show below.
@example
<<code-block-name(optional arguments)>>
@end example
-Note: the default value, @code{:noweb no}, was chosen to ensure that
-correct code is not broken in a language, such as Ruby, where
-@code{<<arg>>} is a syntactically valid construct. If @code{<<arg>>} is not
-syntactically valid in languages that you use, then please consider setting
-the default value.
+Note that when using the above approach to a code block's results, the code
+block name set by @code{#+NAME} keyword is required; the reference set by
+@code{:noweb-ref} will not work.
+
+Here is an example that demonstrates how the exported content changes when
+Noweb style references are used with parentheses versus without.
+
+With:
+
+@example
+#+NAME: some-code
+#+BEGIN_SRC python :var num=0 :results output :exports none
+print(num*10)
+#+END_SRC
+@end example
+
+this code block:
+
+@example
+#+BEGIN_SRC text :noweb yes
+<<some-code>>
+#+END_SRC
+@end example
+
+expands to:
+
+@example
+print(num*10)
+@end example
+
+Below, a similar Noweb style reference is used, but with parentheses, while
+setting a variable @code{num} to 10:
+
+@example
+#+BEGIN_SRC text :noweb yes
+<<some-code(num=10)>>
+#+END_SRC
+@end example
+
+Note that now the expansion contains the @emph{results} of the code block
+@code{some-code}, not the code block itself:
-Note: if noweb tangling is slow in large Org mode files consider setting the
+@example
+100
+@end example
+
+For faster tangling of large Org mode files, set
@code{org-babel-use-quick-and-dirty-noweb-expansion} variable to @code{t}.
-This will result in faster noweb reference resolution at the expense of not
-correctly resolving inherited values of the @code{:noweb-ref} header
-argument.
+The speedup comes at the expense of not correctly resolving inherited values
+of the @code{:noweb-ref} header argument.
-@node Key bindings and useful functions, Batch execution, Noweb reference syntax, Working With Source Code
+
+@node Key bindings and useful functions
@section Key bindings and useful functions
@cindex code block, key bindings
-Many common Org mode key sequences are re-bound depending on
-the context.
+Many common Org mode key sequences are re-bound depending on the context.
-Within a code block, the following key bindings
-are active:
+Active key bindings in code blocks:
@multitable @columnfractions 0.25 0.75
@kindex C-c C-c
@@ -15807,9 +17135,9 @@ are active:
@item @kbd{M-@key{down}} @tab @code{org-babel-switch-to-session}
@end multitable
-In an Org mode buffer, the following key bindings are active:
+Active key bindings in Org mode buffer:
-@multitable @columnfractions 0.45 0.55
+@multitable @columnfractions 0.5 0.5
@kindex C-c C-v p
@kindex C-c C-v C-p
@item @kbd{C-c C-v p} @ @ @r{or} @ @ @kbd{C-c C-v C-p} @tab @code{org-babel-previous-src-block}
@@ -15878,8 +17206,7 @@ In an Org mode buffer, the following key bindings are active:
@item @kbd{C-c C-v x} @ @ @r{or} @ @ @kbd{C-c C-v C-x} @tab @code{org-babel-do-key-sequence-in-edit-buffer}
@end multitable
-@c When possible these keybindings were extended to work when the control key is
-@c kept pressed, resulting in the following additional keybindings.
+@c Extended key bindings when control key is kept pressed:
@c @multitable @columnfractions 0.25 0.75
@c @item @kbd{C-c C-v C-a} @tab @code{org-babel-sha1-hash}
@@ -15892,60 +17219,51 @@ In an Org mode buffer, the following key bindings are active:
@c @item @kbd{C-c C-v C-z} @tab @code{org-babel-switch-to-session}
@c @end multitable
-@node Batch execution, , Key bindings and useful functions, Working With Source Code
+@node Batch execution
@section Batch execution
@cindex code block, batch execution
@cindex source code, batch execution
-It is possible to call functions from the command line. This shell
-script calls @code{org-babel-tangle} on every one of its arguments.
+Org mode features, including working with source code facilities can be
+invoked from the command line. This enables building shell scripts for batch
+processing, running automated system tasks, and expanding Org mode's
+usefulness.
-Be sure to adjust the paths to fit your system.
+The sample script shows batch processing of multiple files using
+@code{org-babel-tangle}.
@example
#!/bin/sh
-# -*- mode: shell-script -*-
-#
# tangle files with org-mode
#
-DIR=`pwd`
-FILES=""
-
-# wrap each argument in the code required to call tangle on it
-for i in $@@; do
- FILES="$FILES \"$i\""
-done
-
-emacs -Q --batch \
---eval "(progn
-(add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\"))
-(add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\" t))
-(require 'org)(require 'org-exp)(require 'ob)(require 'ob-tangle)
-(mapc (lambda (file)
- (find-file (expand-file-name file \"$DIR\"))
- (org-babel-tangle)
- (kill-buffer)) '($FILES)))" 2>&1 |grep tangled
-@end example
-
-@node Miscellaneous, Hacking, Working With Source Code, Top
+emacs -Q --batch --eval "
+ (progn
+ (require 'ob-tangle)
+ (dolist (file command-line-args-left)
+ (with-current-buffer (find-file-noselect file)
+ (org-babel-tangle))))
+ " "$@@"
+@end example
+
+@node Miscellaneous
@chapter Miscellaneous
@menu
-* Completion:: M-TAB knows what you need
-* Easy Templates:: Quick insertion of structural elements
+* Completion:: M-TAB guesses completions
+* Easy templates:: Quick insertion of structural elements
* Speed keys:: Electric commands at the beginning of a headline
* Code evaluation security:: Org mode files evaluate inline code
-* Customization:: Adapting Org to your taste
+* Customization:: Adapting Org to changing tastes
* In-buffer settings:: Overview of the #+KEYWORDS
* The very busy C-c C-c key:: When in doubt, press C-c C-c
* Clean view:: Getting rid of leading stars in the outline
* TTY keys:: Using Org on a tty
-* Interaction:: Other Emacs packages
+* Interaction:: With other Emacs packages
* org-crypt:: Encrypting Org files
@end menu
-@node Completion, Easy Templates, Miscellaneous, Miscellaneous
+@node Completion
@section Completion
@cindex completion, of @TeX{} symbols
@cindex completion, of TODO keywords
@@ -15961,15 +17279,13 @@ emacs -Q --batch \
@cindex tag completion
@cindex link abbreviations, completion of
-Emacs would not be Emacs without completion, and Org mode uses it whenever it
-makes sense. If you prefer an @i{iswitchb}- or @i{ido}-like interface for
-some of the completion prompts, you can specify your preference by setting at
-most one of the variables @code{org-completion-use-iswitchb}
-@code{org-completion-use-ido}.
-
-Org supports in-buffer completion. This type of completion does
-not make use of the minibuffer. You simply type a few letters into
-the buffer and use the key to complete text right there.
+Org has in-buffer completions. Unlike minibuffer completions, which are
+useful for quick command interactions, Org's in-buffer completions are more
+suitable for content creation in Org documents. Type one or more letters and
+invoke the hot key to complete the text in-place. Depending on the context
+and the keys, Org will offer different types of completions. No minibuffer
+is involved. Such mode-specific hot keys have become an integral part of
+Emacs and Org provides several shortcuts.
@table @kbd
@kindex M-@key{TAB}
@@ -15996,112 +17312,121 @@ buffer.
After @samp{[}, complete link abbreviations (@pxref{Link abbreviations}).
@item
After @samp{#+}, complete the special keywords like @samp{TYP_TODO} or
-@samp{OPTIONS} which set file-specific options for Org mode. When the
-option keyword is already complete, pressing @kbd{M-@key{TAB}} again
-will insert example settings for this keyword.
+file-specific @samp{OPTIONS}. After option keyword is complete, pressing
+@kbd{M-@key{TAB}} again will insert example settings for that option.
@item
-In the line after @samp{#+STARTUP: }, complete startup keywords,
-i.e., valid keys for this line.
+After @samp{#+STARTUP: }, complete startup keywords.
@item
-Elsewhere, complete dictionary words using Ispell.
+When the point is anywhere else, complete dictionary words using Ispell.
@end itemize
+@kindex C-M-i
+If your desktop intercepts the combo @kbd{M-@key{TAB}} to switch windows, use
+@kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}} as an alternative or customize your
+environment.
@end table
-@node Easy Templates, Speed keys, Completion, Miscellaneous
-@section Easy Templates
+@node Easy templates
+@section Easy templates
@cindex template insertion
@cindex insertion, of templates
-Org mode supports insertion of empty structural elements (like
-@code{#+BEGIN_SRC} and @code{#+END_SRC} pairs) with just a few key
-strokes. This is achieved through a native template expansion mechanism.
-Note that Emacs has several other template mechanisms which could be used in
-a similar way, for example @file{yasnippet}.
+With just a few keystrokes, Org's easy templates inserts empty pairs of
+structural elements, such as @code{#+BEGIN_SRC} and @code{#+END_SRC}. Easy
+templates use an expansion mechanism, which is native to Org, in a process
+similar to @file{yasnippet} and other Emacs template expansion packages.
+
+@kbd{<} @kbd{s} @kbd{@key{TAB}} expands to a @samp{src} code block.
+
+@kbd{<} @kbd{l} @kbd{@key{TAB}} expands to:
-To insert a structural element, type a @samp{<}, followed by a template
-selector and @kbd{@key{TAB}}. Completion takes effect only when the above
-keystrokes are typed on a line by itself.
+#+BEGIN_EXPORT latex
-The following template selectors are currently supported.
+#+END_EXPORT
+
+Org comes with these pre-defined easy templates:
@multitable @columnfractions 0.1 0.9
-@item @kbd{s} @tab @code{#+BEGIN_SRC ... #+END_SRC}
+@item @kbd{s} @tab @code{#+BEGIN_SRC ... #+END_SRC}
@item @kbd{e} @tab @code{#+BEGIN_EXAMPLE ... #+END_EXAMPLE}
-@item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE}
-@item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE}
-@item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER}
-@item @kbd{l} @tab @code{#+BEGIN_LaTeX ... #+END_LaTeX}
-@item @kbd{L} @tab @code{#+LaTeX:}
-@item @kbd{h} @tab @code{#+BEGIN_HTML ... #+END_HTML}
+@item @kbd{q} @tab @code{#+BEGIN_QUOTE ... #+END_QUOTE}
+@item @kbd{v} @tab @code{#+BEGIN_VERSE ... #+END_VERSE}
+@item @kbd{c} @tab @code{#+BEGIN_CENTER ... #+END_CENTER}
+@item @kbd{C} @tab @code{#+BEGIN_COMMENT ... #+END_COMMENT}
+@item @kbd{l} @tab @code{#+BEGIN_EXPORT latex ... #+END_EXPORT}
+@item @kbd{L} @tab @code{#+LATEX:}
+@item @kbd{h} @tab @code{#+BEGIN_EXPORT html ... #+END_EXPORT}
@item @kbd{H} @tab @code{#+HTML:}
-@item @kbd{a} @tab @code{#+BEGIN_ASCII ... #+END_ASCII}
+@item @kbd{a} @tab @code{#+BEGIN_EXPORT ascii ... #+END_EXPORT}
@item @kbd{A} @tab @code{#+ASCII:}
@item @kbd{i} @tab @code{#+INDEX:} line
@item @kbd{I} @tab @code{#+INCLUDE:} line
@end multitable
-For example, on an empty line, typing "<e" and then pressing TAB, will expand
-into a complete EXAMPLE template.
-
-You can install additional templates by customizing the variable
-@code{org-structure-template-alist}. See the docstring of the variable for
-additional details.
+More templates can added by customizing the variable
+@code{org-structure-template-alist}, whose docstring has additional details.
-@node Speed keys, Code evaluation security, Easy Templates, Miscellaneous
+@node Speed keys
@section Speed keys
@cindex speed keys
+
+Single keystrokes can execute custom commands in an Org file when the cursor
+is on a headline. Without the extra burden of a meta or modifier key, Speed
+Keys can speed navigation or execute custom commands. Besides faster
+navigation, Speed Keys may come in handy on small mobile devices that do not
+have full keyboards. Speed Keys may also work on TTY devices known for their
+problems when entering Emacs keychords.
+
@vindex org-use-speed-commands
-@vindex org-speed-commands-user
+By default, Org has Speed Keys disabled. To activate Speed Keys, set the
+variable @code{org-use-speed-commands} to a non-@code{nil} value. To trigger
+a Speed Key, the cursor must be at the beginning of an Org headline, before
+any of the stars.
-Single keys can be made to execute commands when the cursor is at the
-beginning of a headline, i.e., before the first star. Configure the variable
-@code{org-use-speed-commands} to activate this feature. There is a
-pre-defined list of commands, and you can add more such commands using the
-variable @code{org-speed-commands-user}. Speed keys do not only speed up
-navigation and other commands, but they also provide an alternative way to
-execute commands bound to keys that are not or not easily available on a TTY,
-or on a small mobile device with a limited keyboard.
+@vindex org-speed-commands-user
+@findex org-speed-command-help
+Org comes with a pre-defined list of Speed Keys. To add or modify Speed
+Keys, customize the variable, @code{org-speed-commands-user}. For more
+details, see the variable's docstring. With Speed Keys activated, @kbd{M-x
+org-speed-command-help}, or @kbd{?} when cursor is at the beginning of an Org
+headline, shows currently active Speed Keys, including the user-defined ones.
-To see which commands are available, activate the feature and press @kbd{?}
-with the cursor at the beginning of a headline.
-@node Code evaluation security, Customization, Speed keys, Miscellaneous
+@node Code evaluation security
@section Code evaluation and security issues
-Org provides tools to work with the code snippets, including evaluating them.
-
-Running code on your machine always comes with a security risk. Badly
-written or malicious code can be executed on purpose or by accident. Org has
-default settings which will only evaluate such code if you give explicit
-permission to do so, and as a casual user of these features you should leave
-these precautions intact.
+Unlike plain text, running code comes with risk. Each @samp{src} code block,
+in terms of risk, is equivalent to an executable file. Org therefore puts a
+few confirmation prompts by default. This is to alert the casual user from
+accidentally running untrusted code.
-For people who regularly work with such code, the confirmation prompts can
-become annoying, and you might want to turn them off. This can be done, but
-you must be aware of the risks that are involved.
+For users who do not run code blocks or write code regularly, Org's default
+settings should suffice. However, some users may want to tweak the prompts
+for fewer interruptions. To weigh the risks of automatic execution of code
+blocks, here are some details about code evaluation.
-Code evaluation can happen under the following circumstances:
+Org evaluates code in the following circumstances:
@table @i
@item Source code blocks
-Source code blocks can be evaluated during export, or when pressing @kbd{C-c
-C-c} in the block. The most important thing to realize here is that Org mode
-files which contain code snippets are, in a certain sense, like executable
-files. So you should accept them and load them into Emacs only from trusted
-sources---just like you would do with a program you install on your computer.
-
-Make sure you know what you are doing before customizing the variables
-which take off the default security brakes.
+Org evaluates @samp{src} code blocks in an Org file during export. Org also
+evaluates a @samp{src} code block with the @kbd{C-c C-c} key chord. Users
+exporting or running code blocks must load files only from trusted sources.
+Be wary of customizing variables that remove or alter default security
+measures.
@defopt org-confirm-babel-evaluate
-When t (the default), the user is asked before every code block evaluation.
-When @code{nil}, the user is not asked. When set to a function, it is called with
-two arguments (language and body of the code block) and should return t to
-ask and @code{nil} not to ask.
+When @code{t}, Org prompts the user for confirmation before executing each
+code block. When @code{nil}, Org executes code blocks without prompting the
+user for confirmation. When this option is set to a custom function, Org
+invokes the function with these two arguments: the source code language and
+the body of the code block. The custom function must return either a
+@code{t} or @code{nil}, which determines if the user is prompted. Each
+source code language can be handled separately through this function
+argument.
@end defopt
-For example, here is how to execute "ditaa" code (which is considered safe)
-without asking:
+For example, this function enables execution of @samp{ditaa} code +blocks
+without prompting:
@lisp
(defun my-org-confirm-babel-evaluate (lang body)
@@ -16110,86 +17435,73 @@ without asking:
@end lisp
@item Following @code{shell} and @code{elisp} links
-Org has two link types that can directly evaluate code (@pxref{External
-links}). These links can be problematic because the code to be evaluated is
-not visible.
+Org has two link types that can also directly evaluate code (@pxref{External
+links}). Because such code is not visible, these links have a potential
+risk. Org therefore prompts the user when it encounters such links. The
+customization variables are:
@defopt org-confirm-shell-link-function
-Function to queries user about shell link execution.
+Function that prompts the user before executing a shell link.
@end defopt
@defopt org-confirm-elisp-link-function
-Functions to query user for Emacs Lisp link execution.
+Function that prompts the user before executing an Emacs Lisp link.
@end defopt
@item Formulas in tables
-Formulas in tables (@pxref{The spreadsheet}) are code that is evaluated
-either by the @i{calc} interpreter, or by the @i{Emacs Lisp} interpreter.
+Org executes formulas in tables (@pxref{The spreadsheet}) either through the
+@emph{calc} or the @emph{Emacs Lisp} interpreters.
@end table
-@node Customization, In-buffer settings, Code evaluation security, Miscellaneous
+@node Customization
@section Customization
@cindex customization
@cindex options, for customization
@cindex variables, for customization
-There are more than 500 variables that can be used to customize
-Org. For the sake of compactness of the manual, I am not
-describing the variables here. A structured overview of customization
-variables is available with @kbd{M-x org-customize RET}. Or select
-@code{Browse Org Group} from the @code{Org->Customization} menu. Many
-settings can also be activated on a per-file basis, by putting special
-lines into the buffer (@pxref{In-buffer settings}).
+Org has more than 500 variables for customization. They can be accessed
+through the usual @kbd{M-x org-customize RET} command. Or through the Org
+menu, @code{Org->Customization->Browse Org Group}. Org also has per-file
+settings for some variables (@pxref{In-buffer settings}).
-@node In-buffer settings, The very busy C-c C-c key, Customization, Miscellaneous
+@node In-buffer settings
@section Summary of in-buffer settings
@cindex in-buffer settings
@cindex special keywords
+In-buffer settings start with @samp{#+}, followed by a keyword, a colon, and
+then a word for each setting. Org accepts multiple settings on the same
+line. Org also accepts multiple lines for a keyword. This manual describes
+these settings throughout. A summary follows here.
-Org mode uses special lines in the buffer to define settings on a
-per-file basis. These lines start with a @samp{#+} followed by a
-keyword, a colon, and then individual words defining a setting. Several
-setting words can be in the same line, but you can also have multiple
-lines for the keyword. While these settings are described throughout
-the manual, here is a summary. After changing any of those lines in the
-buffer, press @kbd{C-c C-c} with the cursor still in the line to
-activate the changes immediately. Otherwise they become effective only
-when the file is visited again in a new Emacs session.
+@kbd{C-c C-c} activates any changes to the in-buffer settings. Closing and
+reopening the Org file in Emacs also activates the changes.
@vindex org-archive-location
@table @kbd
@item #+ARCHIVE: %s_done::
-This line sets the archive location for the agenda file. It applies for
-all subsequent lines until the next @samp{#+ARCHIVE} line, or the end
-of the file. The first such line also applies to any entries before it.
+Sets the archive location of the agenda file. This location applies to the
+lines until the next @samp{#+ARCHIVE} line, if any, in the Org file. The
+first archive location in the Org file also applies to any entries before it.
The corresponding variable is @code{org-archive-location}.
@item #+CATEGORY:
-This line sets the category for the agenda file. The category applies
-for all subsequent lines until the next @samp{#+CATEGORY} line, or the
-end of the file. The first such line also applies to any entries before it.
+Sets the category of the agenda file, which applies to the entire document.
@item #+COLUMNS: %25ITEM ...
@cindex property, COLUMNS
-Set the default format for columns view. This format applies when
-columns view is invoked in locations where no @code{COLUMNS} property
-applies.
+Sets the default format for columns view. Org uses this format for column
+views where there is no @code{COLUMNS} property.
@item #+CONSTANTS: name1=value1 ...
@vindex org-table-formula-constants
@vindex org-table-formula
-Set file-local values for constants to be used in table formulas. This
-line sets the local variable @code{org-table-formula-constants-local}.
-The global version of this variable is
-@code{org-table-formula-constants}.
+Set file-local values for constants that table formulas can use. This line
+sets the local variable @code{org-table-formula-constants-local}. The global
+version of this variable is @code{org-table-formula-constants}.
@item #+FILETAGS: :tag1:tag2:tag3:
-Set tags that can be inherited by any entry in the file, including the
+Set tags that all entries in the file will inherit from here, including the
top-level entries.
-@item #+DRAWERS: NAME1 ...
-@vindex org-drawers
-Set the file-local set of additional drawers. The corresponding global
-variable is @code{org-drawers}.
@item #+LINK: linkword replace
@vindex org-link-abbrev-alist
-These lines (several are allowed) specify link abbreviations.
-@xref{Link abbreviations}. The corresponding variable is
-@code{org-link-abbrev-alist}.
+Each line specifies one abbreviation for one link. Use multiple
+@code{#+LINK:} lines for more, @pxref{Link abbreviations}. The corresponding
+variable is @code{org-link-abbrev-alist}.
@item #+PRIORITIES: highest lowest default
@vindex org-highest-priority
@vindex org-lowest-priority
@@ -16201,23 +17513,25 @@ have a lower ASCII number than the lowest priority.
This line sets a default inheritance value for entries in the current
buffer, most useful for specifying the allowed values of a property.
@cindex #+SETUPFILE
-@item #+SETUPFILE: file
-This line defines a file that holds more in-buffer setup. Normally this is
-entirely ignored. Only when the buffer is parsed for option-setting lines
-(i.e., when starting Org mode for a file, when pressing @kbd{C-c C-c} in a
-settings line, or when exporting), then the contents of this file are parsed
-as if they had been included in the buffer. In particular, the file can be
-any other Org mode file with internal setup. You can visit the file the
-cursor is in the line with @kbd{C-c '}.
+@item #+SETUPFILE: file or URL
+The setup file or a URL pointing to such file is for additional in-buffer
+settings. Org loads this file and parses it for any settings in it only when
+Org opens the main file. If URL is specified, the contents are downloaded
+and stored in a temporary file cache. @kbd{C-c C-c} on the settings line
+will parse and load the file, and also reset the temporary file cache. Org
+also parses and loads the document during normal exporting process. Org
+parses the contents of this document as if it was included in the buffer. It
+can be another Org file. To visit the file (not a URL), @kbd{C-c '} while
+the cursor is on the line with the file name.
@item #+STARTUP:
@cindex #+STARTUP
-This line sets options to be used at startup of Org mode, when an
-Org file is being visited.
+Startup options Org uses when first visiting a file.
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 @code{t}, which means
-@code{overview}.
+@code{org-startup-folded} with a default value of @code{t}, which is the same
+as @code{overview}.
+
@vindex org-startup-folded
@cindex @code{overview}, STARTUP keyword
@cindex @code{content}, STARTUP keyword
@@ -16234,17 +17548,17 @@ showeverything @r{show even drawer contents}
@cindex @code{indent}, STARTUP keyword
@cindex @code{noindent}, STARTUP keyword
Dynamic virtual indentation is controlled by the variable
-@code{org-startup-indented}@footnote{Emacs 23 and Org mode 6.29 are required}
+@code{org-startup-indented}
@example
indent @r{start with @code{org-indent-mode} turned on}
noindent @r{start with @code{org-indent-mode} turned off}
@end example
@vindex org-startup-align-all-tables
-Then there are options for aligning tables upon visiting a file. This
-is useful in files containing narrowed table columns. The corresponding
-variable is @code{org-startup-align-all-tables}, with a default value
-@code{nil}.
+Aligns tables consistently upon visiting a file; useful for restoring
+narrowed table columns. The corresponding variable is
+@code{org-startup-align-all-tables} with @code{nil} as default value.
+
@cindex @code{align}, STARTUP keyword
@cindex @code{noalign}, STARTUP keyword
@example
@@ -16253,9 +17567,9 @@ noalign @r{don't align tables on startup}
@end example
@vindex org-startup-with-inline-images
-When visiting a file, inline images can be automatically displayed. The
-corresponding variable is @code{org-startup-with-inline-images}, with a
-default value @code{nil} to avoid delays when visiting a file.
+Whether Org should automatically display inline images. The corresponding
+variable is @code{org-startup-with-inline-images}, with a default value
+@code{nil} to avoid delays when visiting a file.
@cindex @code{inlineimages}, STARTUP keyword
@cindex @code{noinlineimages}, STARTUP keyword
@example
@@ -16264,10 +17578,9 @@ noinlineimages @r{don't show inline images on startup}
@end example
@vindex org-startup-with-latex-preview
-When visiting a file, @LaTeX{} fragments can be converted to images
-automatically. The variable @code{org-startup-with-latex-preview} which
-controls this behavior, is set to @code{nil} by default to avoid delays on
-startup.
+Whether Org should automatically convert @LaTeX{} fragments to images. The
+variable @code{org-startup-with-latex-preview}, which controls this setting,
+is set to @code{nil} by default to avoid startup delays.
@cindex @code{latexpreview}, STARTUP keyword
@cindex @code{nolatexpreview}, STARTUP keyword
@example
@@ -16328,21 +17641,21 @@ nologstatesreversed @r{do not reverse the order of states notes}
@vindex org-hide-leading-stars
@vindex org-odd-levels-only
-Here are the options for hiding leading stars in outline headings, and for
-indenting outlines. The corresponding variables are
-@code{org-hide-leading-stars} and @code{org-odd-levels-only}, both with a
-default setting @code{nil} (meaning @code{showstars} and @code{oddeven}).
+These options hide leading stars in outline headings, and indent outlines.
+The corresponding variables are @code{org-hide-leading-stars} and
+@code{org-odd-levels-only}, both with a default setting of @code{nil}
+(meaning @code{showstars} and @code{oddeven}).
@cindex @code{hidestars}, STARTUP keyword
@cindex @code{showstars}, STARTUP keyword
@cindex @code{odd}, STARTUP keyword
@cindex @code{even}, STARTUP keyword
@example
-hidestars @r{make all but one of the stars starting a headline invisible.}
-showstars @r{show all stars starting a headline}
-indent @r{virtual indentation according to outline level}
-noindent @r{no virtual indentation according to outline level}
-odd @r{allow only odd outline levels (1,3,...)}
-oddeven @r{allow all outline levels}
+hidestars @r{hide all stars on the headline except one.}
+showstars @r{show all stars on the headline}
+indent @r{virtual indents according to the outline level}
+noindent @r{no virtual indents}
+odd @r{show odd outline levels only (1,3,...)}
+oddeven @r{show all outline levels}
@end example
@vindex org-put-time-stamp-overlays
@@ -16368,8 +17681,8 @@ constSI @r{@file{constants.el} should use the SI unit system}
@vindex org-footnote-define-inline
@vindex org-footnote-auto-label
@vindex org-footnote-auto-adjust
-To influence footnote settings, use the following keywords. The
-corresponding variables are @code{org-footnote-define-inline},
+For footnote settings, use the following keywords. The corresponding
+variables are @code{org-footnote-define-inline},
@code{org-footnote-auto-label}, and @code{org-footnote-auto-adjust}.
@cindex @code{fninline}, STARTUP keyword
@cindex @code{nofninline}, STARTUP keyword
@@ -16414,67 +17727,59 @@ entitiesplain @r{Leave entities plain}
@item #+TAGS: TAG1(c1) TAG2(c2)
@vindex org-tag-alist
-These lines (several such lines are allowed) specify the valid tags in
-this file, and (potentially) the corresponding @emph{fast tag selection}
-keys. The corresponding variable is @code{org-tag-alist}.
+These lines specify valid tags for this file. Org accepts multiple tags
+lines. Tags could correspond to the @emph{fast tag selection} keys. The
+corresponding variable is @code{org-tag-alist}.
@cindex #+TBLFM
@item #+TBLFM:
-This line contains the formulas for the table directly above the line.
-
-Table can have multiple lines containing @samp{#+TBLFM:}. Note
-that only the first line of @samp{#+TBLFM:} will be applied when
-you recalculate the table. For more details see @ref{Using
-multiple #+TBLFM lines} in @ref{Editing and debugging formulas}.
-
+This line is for formulas for the table directly above. A table can have
+multiple @samp{#+TBLFM:} lines. On table recalculation, Org applies only the
+first @samp{#+TBLFM:} line. For details see @ref{Using multiple #+TBLFM
+lines} in @ref{Editing and debugging formulas}.
@item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+DATE:,
@itemx #+OPTIONS:, #+BIND:,
-@itemx #+DESCRIPTION:, #+KEYWORDS:,
-@itemx #+LaTeX_HEADER:, #+LaTeX_HEADER_EXTRA:,
-@itemx #+HTML_HEAD:, #+HTML_HEAD_EXTRA:, #+HTML_LINK_UP:, #+HTML_LINK_HOME:,
@itemx #+SELECT_TAGS:, #+EXCLUDE_TAGS:
These lines provide settings for exporting files. For more details see
@ref{Export settings}.
@item #+TODO: #+SEQ_TODO: #+TYP_TODO:
@vindex org-todo-keywords
-These lines set the TODO keywords and their interpretation in the
-current file. The corresponding variable is @code{org-todo-keywords}.
+These lines set the TODO keywords and their significance to the current file.
+The corresponding variable is @code{org-todo-keywords}.
@end table
-@node The very busy C-c C-c key, Clean view, In-buffer settings, Miscellaneous
+@node The very busy C-c C-c key
@section The very busy C-c C-c key
@kindex C-c C-c
@cindex C-c C-c, overview
-The key @kbd{C-c C-c} has many purposes in Org, which are all
-mentioned scattered throughout this manual. One specific function of
-this key is to add @emph{tags} to a headline (@pxref{Tags}). In many
-other circumstances it means something like @emph{``Hey Org, look
-here and update according to what you see here''}. Here is a summary of
-what this means in different contexts.
+The @kbd{C-c C-c} key in Org serves many purposes depending on the context.
+It is probably the most over-worked, multi-purpose key combination in Org.
+Its uses are well-documented through out this manual, but here is a
+consolidated list for easy reference.
@itemize @minus
@item
-If there are highlights in the buffer from the creation of a sparse
-tree, or from clock display, remove these highlights.
+If any highlights shown in the buffer from the creation of a sparse tree, or
+from clock display, remove such highlights.
@item
-If the cursor is in one of the special @code{#+KEYWORD} lines, this
-triggers scanning the buffer for these lines and updating the
-information.
+If the cursor is in one of the special @code{#+KEYWORD} lines, scan the
+buffer for these lines and update the information. Also reset the Org file
+cache used to temporary store the contents of URLs used as values for
+keywords like @code{#+SETUPFILE}.
@item
-If the cursor is inside a table, realign the table. This command
-works even if the automatic table editor has been turned off.
+If the cursor is inside a table, realign the table. The table realigns even
+if automatic table editor is turned off.
@item
If the cursor is on a @code{#+TBLFM} line, re-apply the formulas to
the entire table.
@item
-If the current buffer is a capture buffer, close the note and file it.
-With a prefix argument, file it, without further interaction, to the
-default location.
+If the current buffer is a capture buffer, close the note and file it. With
+a prefix argument, also jump to the target location after saving the note.
@item
If the cursor is on a @code{<<<target>>>}, update radio targets and
corresponding links in this buffer.
@item
-If the cursor is in a property line or at the start or end of a property
+If the cursor is on a property line or at the start or end of a property
drawer, offer property commands.
@item
If the cursor is at a footnote reference, go to the corresponding
@@ -16494,18 +17799,18 @@ block is updated.
If the cursor is at a timestamp, fix the day name in the timestamp.
@end itemize
-@node Clean view, TTY keys, The very busy C-c C-c key, Miscellaneous
+@node Clean view
@section A cleaner outline view
@cindex hiding leading stars
@cindex dynamic indentation
@cindex odd-levels-only outlines
@cindex clean outline view
-Some people find it noisy and distracting that the Org headlines start with a
-potentially large number of stars, and that text below the headlines is not
-indented. While this is no problem when writing a @emph{book-like} document
-where the outline headings are really section headings, in a more
-@emph{list-oriented} outline, indented structure is a lot cleaner:
+Org's default outline with stars and no indents can become too cluttered for
+short documents. For @emph{book-like} long documents, the effect is not as
+noticeable. Org provides an alternate stars and indentation scheme, as shown
+on the right in the following table. It uses only one star and indents text
+to line with the heading:
@example
@group
@@ -16521,38 +17826,40 @@ more text | more text
@noindent
-If you are using at least Emacs 23.2@footnote{Emacs 23.1 can actually crash
-with @code{org-indent-mode}} and version 6.29 of Org, this kind of view can
-be achieved dynamically at display time using @code{org-indent-mode}. In
-this minor mode, all lines are prefixed for display with the necessary amount
-of space@footnote{@code{org-indent-mode} also sets the @code{wrap-prefix}
-property, such that @code{visual-line-mode} (or purely setting
-@code{word-wrap}) wraps long lines (including headlines) correctly indented.
-}. Also headlines are prefixed with additional stars, so that the amount of
-indentation shifts by two@footnote{See the variable
-@code{org-indent-indentation-per-level}.} spaces per level. All headline
-stars but the last one are made invisible using the @code{org-hide}
-face@footnote{Turning on @code{org-indent-mode} sets
+To turn this mode on, use the minor mode, @code{org-indent-mode}. Text lines
+that are not headlines are prefixed with spaces to vertically align with the
+headline text@footnote{The @code{org-indent-mode} also sets the
+@code{wrap-prefix} correctly for indenting and wrapping long lines of
+headlines or text. This minor mode handles @code{visual-line-mode} and
+directly applied settings through @code{word-wrap}.}.
+
+To make more horizontal space, the headlines are shifted by two stars. This
+can be configured by the @code{org-indent-indentation-per-level} variable.
+Only one star on each headline is visible, the rest are masked with the same
+font color as the background. This font face can be configured with the
+@code{org-hide} variable.
+
+Note that turning on @code{org-indent-mode} sets
@code{org-hide-leading-stars} to @code{t} and @code{org-adapt-indentation} to
-@code{nil}.}; see below under @samp{2.} for more information on how this
-works. You can turn on @code{org-indent-mode} for all files by customizing
-the variable @code{org-startup-indented}, or you can turn it on for
-individual files using
+@code{nil}; @samp{2.} below shows how this works.
+
+To globally turn on @code{org-indent-mode} for all files, customize the
+variable @code{org-startup-indented}.
+
+To turn on indenting for individual files, use @code{#+STARTUP} option as
+follows:
@example
#+STARTUP: indent
@end example
-If you want a similar effect in an earlier version of Emacs and/or Org, or if
-you want the indentation to be hard space characters so that the plain text
-file looks as similar as possible to the Emacs display, Org supports you in
-the following way:
+Indent on startup makes Org use hard spaces to align text with headings as
+shown in examples below.
@enumerate
@item
@emph{Indentation of text below headlines}@*
-You may indent text below each headline to make the left boundary line up
-with the headline, like
+Indent text to align with the headline.
@example
*** 3rd level
@@ -16560,23 +17867,21 @@ with the headline, like
@end example
@vindex org-adapt-indentation
-Org supports this with paragraph filling, line wrapping, and structure
-editing@footnote{See also the variable @code{org-adapt-indentation}.},
-preserving or adapting the indentation as appropriate.
+Org adapts indentations with paragraph filling, line wrapping, and structure
+editing@footnote{Also see the variable @code{org-adapt-indentation}.}.
@item
@vindex org-hide-leading-stars
-@emph{Hiding leading stars}@* You can modify the display in such a way that
-all leading stars become invisible. To do this in a global way, configure
-the variable @code{org-hide-leading-stars} or change this on a per-file basis
-with
+@emph{Hiding leading stars}@* Org can make leading stars invisible. For
+global preference, configure the variable @code{org-hide-leading-stars}. For
+per-file preference, use these file @code{#+STARTUP} options:
@example
#+STARTUP: hidestars
#+STARTUP: showstars
@end example
-With hidden stars, the tree becomes:
+With stars hidden, the tree is shown as:
@example
@group
@@ -16589,50 +17894,39 @@ With hidden stars, the tree becomes:
@noindent
@vindex org-hide @r{(face)}
-The leading stars are not truly replaced by whitespace, they are only
-fontified with the face @code{org-hide} that uses the background color as
-font color. If you are not using either white or black background, you may
-have to customize this face to get the wanted effect. Another possibility is
-to set this font such that the extra stars are @i{almost} invisible, for
-example using the color @code{grey90} on a white background.
+Because Org makes the font color same as the background color to hide to
+stars, sometimes @code{org-hide} face may need tweaking to get the effect
+right. For some black and white combinations, @code{grey90} on a white
+background might mask the stars better.
@item
@vindex org-odd-levels-only
-Things become cleaner still if you skip all the even levels and use only odd
-levels 1, 3, 5..., effectively adding two stars to go from one outline level
-to the next@footnote{When you need to specify a level for a property search
-or refile targets, @samp{LEVEL=2} will correspond to 3 stars, etc.}. In this
-way we get the outline view shown at the beginning of this section. In order
-to make the structure editing and export commands handle this convention
-correctly, configure the variable @code{org-odd-levels-only}, or set this on
-a per-file basis with one of the following lines:
+Using stars for only odd levels, 1, 3, 5, @dots{}, can also clean up the
+clutter. This removes two stars from each level@footnote{Because
+@samp{LEVEL=2} has 3 stars, @samp{LEVEL=3} has 4 stars, and so on}. For Org
+to properly handle this cleaner structure during edits and exports, configure
+the variable @code{org-odd-levels-only}. To set this per-file, use either
+one of the following lines:
@example
#+STARTUP: odd
#+STARTUP: oddeven
@end example
-You can convert an Org file from single-star-per-level to the
-double-star-per-level convention with @kbd{M-x org-convert-to-odd-levels
-RET} in that file. The reverse operation is @kbd{M-x
-org-convert-to-oddeven-levels}.
+To switch between single and double stars layouts, use @kbd{M-x
+org-convert-to-odd-levels RET} and @kbd{M-x org-convert-to-oddeven-levels}.
@end enumerate
-@node TTY keys, Interaction, Clean view, Miscellaneous
+@node TTY keys
@section Using Org on a tty
@cindex tty key bindings
-Because Org contains a large number of commands, by default many of
-Org's core commands are bound to keys that are generally not
-accessible on a tty, such as the cursor keys (@key{left}, @key{right},
-@key{up}, @key{down}), @key{TAB} and @key{RET}, in particular when used
-together with modifiers like @key{Meta} and/or @key{Shift}. To access
-these commands on a tty when special keys are unavailable, the following
-alternative bindings can be used. The tty bindings below will likely be
-more cumbersome; you may find for some of the bindings below that a
-customized workaround suits you better. For example, changing a timestamp
-is really only fun with @kbd{S-@key{cursor}} keys, whereas on a
-tty you would rather use @kbd{C-c .} to re-insert the timestamp.
+Org provides alternative key bindings for TTY and modern mobile devices that
+cannot handle cursor keys and complex modifier key chords. Some of these
+workarounds may be more cumbersome than necessary. Users should look into
+customizing these further based on their usage needs. For example, the
+normal @kbd{S-@key{cursor}} for editing timestamp might be better with
+@kbd{C-c .} chord.
@multitable @columnfractions 0.15 0.2 0.1 0.2
@item @b{Default} @tab @b{Alternative 1} @tab @b{Speed key} @tab @b{Alternative 2}
@@ -16657,74 +17951,62 @@ tty you would rather use @kbd{C-c .} to re-insert the timestamp.
@end multitable
-@node Interaction, org-crypt, TTY keys, Miscellaneous
+@node Interaction
@section Interaction with other packages
@cindex packages, interaction with other
-Org lives in the world of GNU Emacs and interacts in various ways
-with other code out there.
+Org's compatibility and the level of interaction with other Emacs packages
+are documented here.
+
@menu
* Cooperation:: Packages Org cooperates with
* Conflicts:: Packages that lead to conflicts
@end menu
-@node Cooperation, Conflicts, Interaction, Interaction
+@node Cooperation
@subsection Packages that Org cooperates with
@table @asis
@cindex @file{calc.el}
@cindex Gillespie, Dave
@item @file{calc.el} by Dave Gillespie
-Org uses the Calc package for implementing spreadsheet
-functionality in its tables (@pxref{The spreadsheet}). Org
-checks for the availability of Calc by looking for the function
-@code{calc-eval} which will have been autoloaded during setup if Calc has
-been installed properly. As of Emacs 22, Calc is part of the Emacs
-distribution. Another possibility for interaction between the two
-packages is using Calc for embedded calculations. @xref{Embedded Mode,
-, Embedded Mode, calc, GNU Emacs Calc Manual}.
+Org uses the Calc package for tables to implement spreadsheet functionality
+(@pxref{The spreadsheet}). Org also uses Calc for embedded calculations.
+@xref{Embedded Mode, , Embedded Mode, calc, GNU Emacs Calc Manual}.
@item @file{constants.el} by Carsten Dominik
@cindex @file{constants.el}
@cindex Dominik, Carsten
@vindex org-table-formula-constants
-In a table formula (@pxref{The spreadsheet}), it is possible to use
-names for natural constants or units. Instead of defining your own
-constants in the variable @code{org-table-formula-constants}, install
-the @file{constants} package which defines a large number of constants
-and units, and lets you use unit prefixes like @samp{M} for
-@samp{Mega}, etc. You will need version 2.0 of this package, available
-at @url{http://www.astro.uva.nl/~dominik/Tools}. Org checks for
-the function @code{constants-get}, which has to be autoloaded in your
-setup. See the installation instructions in the file
-@file{constants.el}.
+Org can use names for constants in formulas in tables. Org can also use
+calculation suffixes for units, such as @samp{M} for @samp{Mega}. For a
+standard collection of such constants, install the @file{constants} package.
+Install version 2.0 of this package, available at
+@url{https://staff.fnwi.uva.nl/c.dominik/Tools/}. Org checks if the function
+@code{constants-get} has been autoloaded. Installation instructions are in
+the file, @file{constants.el}.
@item @file{cdlatex.el} by Carsten Dominik
@cindex @file{cdlatex.el}
@cindex Dominik, Carsten
-Org mode can make use of the CD@LaTeX{} package to efficiently enter
-@LaTeX{} fragments into Org files. See @ref{CDLaTeX mode}.
+Org mode can use CD@LaTeX{} package to efficiently enter @LaTeX{} fragments
+into Org files (@pxref{CDLaTeX mode}).
@item @file{imenu.el} by Ake Stenhoff and Lars Lindberg
@cindex @file{imenu.el}
-Imenu allows menu access to an index of items in a file. Org mode
-supports Imenu---all you need to do to get the index is the following:
+Imenu creates dynamic menus based on an index of items in a file. Org mode
+supports Imenu menus. Enable it with a mode hook as follows:
@lisp
(add-hook 'org-mode-hook
(lambda () (imenu-add-to-menubar "Imenu")))
@end lisp
@vindex org-imenu-depth
-By default the index is two levels deep---you can modify the depth using
-the option @code{org-imenu-depth}.
-@item @file{remember.el} by John Wiegley
-@cindex @file{remember.el}
-@cindex Wiegley, John
-Org used to use this package for capture, but no longer does.
+By default the Imenu index is two levels deep. Change the index depth using
+thes variable, @code{org-imenu-depth}.
@item @file{speedbar.el} by Eric M. Ludlam
@cindex @file{speedbar.el}
@cindex Ludlam, Eric M.
-Speedbar is a package that creates a special frame displaying files and
-index items in files. Org mode supports Speedbar and allows you to
-drill into Org files directly from the Speedbar. It also allows you to
-restrict the scope of agenda commands to a file or a subtree by using
-the command @kbd{<} in the Speedbar frame.
+Speedbar package creates a special Emacs frame for displaying files and index
+items in files. Org mode supports Speedbar; users can drill into Org files
+directly from the Speedbar. The @kbd{<} in the Speedbar frame tweaks the
+agenda commands to that file or to a subtree.
@cindex @file{table.el}
@item @file{table.el} by Takaaki Ota
@kindex C-c C-c
@@ -16733,13 +18015,11 @@ the command @kbd{<} in the Speedbar frame.
@cindex Ota, Takaaki
Complex ASCII tables with automatic line wrapping, column- and row-spanning,
-and alignment can be created using the Emacs table package by Takaaki Ota
-(@uref{http://sourceforge.net/projects/table}, and also part of Emacs 22).
-Org mode will recognize these tables and export them properly. Because of
-interference with other Org mode functionality, you unfortunately cannot edit
-these tables directly in the buffer. Instead, you need to use the command
-@kbd{C-c '} to edit them, similar to source code snippets.
-
+and alignment can be created using the Emacs table package by Takaaki Ota.
+Org mode recognizes such tables and export them properly. @kbd{C-c '} to
+edit these tables in a special buffer, much like Org's @samp{src} code
+blocks. Because of interference with other Org mode functionality, Takaaki
+Ota tables cannot be edited directly in the Org buffer.
@table @kbd
@orgcmd{C-c ',org-edit-special}
Edit a @file{table.el} table. Works when the cursor is in a table.el table.
@@ -16747,50 +18027,37 @@ Edit a @file{table.el} table. Works when the cursor is in a table.el table.
@orgcmd{C-c ~,org-table-create-with-table.el}
Insert a @file{table.el} table. If there is already a table at point, this
command converts it between the @file{table.el} format and the Org mode
-format. See the documentation string of the command
-@code{org-convert-table} for the restrictions under which this is
-possible.
+format. See the documentation string of the command @code{org-convert-table}
+for details.
@end table
-@file{table.el} is part of Emacs since Emacs 22.
-@item @file{footnote.el} by Steven L. Baur
-@cindex @file{footnote.el}
-@cindex Baur, Steven L.
-Org mode recognizes numerical footnotes as provided by this package.
-However, Org mode also has its own footnote support (@pxref{Footnotes}),
-which makes using @file{footnote.el} unnecessary.
@end table
-@node Conflicts, , Cooperation, Interaction
-@subsection Packages that lead to conflicts with Org mode
+@node Conflicts
+@subsection Packages that conflict with Org mode
@table @asis
@cindex @code{shift-selection-mode}
@vindex org-support-shift-select
-In Emacs 23, @code{shift-selection-mode} is on by default, meaning that
-cursor motions combined with the shift key should start or enlarge regions.
-This conflicts with the use of @kbd{S-@key{cursor}} commands in Org to change
-timestamps, TODO keywords, priorities, and item bullet types if the cursor is
-at such a location. By default, @kbd{S-@key{cursor}} commands outside
-special contexts don't do anything, but you can customize the variable
-@code{org-support-shift-select}. Org mode then tries to accommodate shift
-selection by (i) using it outside of the special contexts where special
-commands apply, and by (ii) extending an existing active region even if the
-cursor moves across a special context.
+In Emacs, @code{shift-selection-mode} combines cursor motions with shift key
+to enlarge regions. Emacs sets this mode by default. This conflicts with
+Org's use of @kbd{S-@key{cursor}} commands to change timestamps, TODO
+keywords, priorities, and item bullet types, etc. Since @kbd{S-@key{cursor}}
+commands outside of specific contexts don't do anything, Org offers the
+variable @code{org-support-shift-select} for customization. Org mode
+accommodates shift selection by (i) making it available outside of the
+special contexts where special commands apply, and (ii) extending an
+existing active region even if the cursor moves across a special context.
@item @file{CUA.el} by Kim. F. Storm
@cindex @file{CUA.el}
@cindex Storm, Kim. F.
@vindex org-replace-disputed-keys
-Key bindings in Org conflict with the @kbd{S-<cursor>} keys used by CUA mode
-(as well as @code{pc-select-mode} and @code{s-region-mode}) to select and extend the
-region. In fact, Emacs 23 has this built-in in the form of
-@code{shift-selection-mode}, see previous paragraph. If you are using Emacs
-23, you probably don't want to use another package for this purpose. However,
-if you prefer to leave these keys to a different package while working in
-Org mode, configure the variable @code{org-replace-disputed-keys}. When set,
-Org will move the following key bindings in Org files, and in the agenda
-buffer (but not during date selection).
+Org key bindings conflict with @kbd{S-<cursor>} keys used by CUA mode. For
+Org to relinquish these bindings to CUA mode, configure the variable
+@code{org-replace-disputed-keys}. When set, Org moves the following key
+bindings in Org files, and in the agenda buffer (but not during date
+selection).
@example
S-UP @result{} M-p S-DOWN @result{} M-n
@@ -16799,9 +18066,8 @@ C-S-LEFT @result{} M-S-- C-S-RIGHT @result{} M-S-+
@end example
@vindex org-disputed-keys
-Yes, these are unfortunately more difficult to remember. If you want
-to have other replacement keys, look at the variable
-@code{org-disputed-keys}.
+Yes, these are unfortunately more difficult to remember. To define a
+different replacement keys, look at the variable @code{org-disputed-keys}.
@item @file{ecomplete.el} by Lars Magne Ingebrigtsen @email{larsi@@gnus.org}
@cindex @file{ecomplete.el}
@@ -16819,9 +18085,8 @@ manually when needed in the messages body.
@cindex @file{filladapt.el}
Org mode tries to do the right thing when filling paragraphs, list items and
-other elements. Many users reported they had problems using both
-@file{filladapt.el} and Org mode, so a safe thing to do is to disable it like
-this:
+other elements. Many users reported problems using both @file{filladapt.el}
+and Org mode, so a safe thing to do is to disable filladapt like this:
@lisp
(add-hook 'org-mode-hook 'turn-off-filladapt-mode)
@@ -16836,20 +18101,19 @@ fixed this problem:
@lisp
(add-hook 'org-mode-hook
(lambda ()
- (org-set-local 'yas/trigger-key [tab])
+ (setq-local yas/trigger-key [tab])
(define-key yas/keymap [tab] 'yas/next-field-or-maybe-expand)))
@end lisp
The latest version of yasnippet doesn't play well with Org mode. If the
-above code does not fix the conflict, start by defining the following
-function:
+above code does not fix the conflict, first define the following function:
@lisp
(defun yas/org-very-safe-expand ()
(let ((yas/fallback-behavior 'return-nil)) (yas/expand)))
@end lisp
-Then, tell Org mode what to do with the new function:
+Then tell Org mode to use that function:
@lisp
(add-hook 'org-mode-hook
@@ -16892,21 +18156,19 @@ another key for this command, or override the key in
@end table
-@node org-crypt, , Interaction, Miscellaneous
+@node org-crypt
@section org-crypt.el
@cindex @file{org-crypt.el}
@cindex @code{org-decrypt-entry}
-Org-crypt will encrypt the text of an entry, but not the headline, or
-properties. Org-crypt uses the Emacs EasyPG library to encrypt and decrypt
-files.
+Org crypt encrypts the text of an Org entry, but not the headline, or
+properties. Org crypt uses the Emacs EasyPG library to encrypt and decrypt.
Any text below a headline that has a @samp{:crypt:} tag will be automatically
-be encrypted when the file is saved. If you want to use a different tag just
-customize the @code{org-crypt-tag-matcher} setting.
+be encrypted when the file is saved. To use a different tag, customize the
+@code{org-crypt-tag-matcher} variable.
-To use org-crypt it is suggested that you have the following in your
-@file{.emacs}:
+Suggested Org crypt settings in Emacs init file:
@lisp
(require 'org-crypt)
@@ -16928,14 +18190,14 @@ To use org-crypt it is suggested that you have the following in your
;; # -*- buffer-auto-save-file-name: nil; -*-
@end lisp
-Excluding the crypt tag from inheritance prevents already encrypted text
-being encrypted again.
+Excluding the crypt tag from inheritance prevents encrypting previously
+encrypted text.
-@node Hacking, MobileOrg, Miscellaneous, Top
+@node Hacking
@appendix Hacking
@cindex hacking
-This appendix covers some aspects where users can extend the functionality of
+This appendix covers some areas where users can extend the functionality of
Org.
@menu
@@ -16953,38 +18215,35 @@ Org.
* Using the mapping API:: Mapping over all or selected entries
@end menu
-@node Hooks, Add-on packages, Hacking, Hacking
+@node Hooks
@section Hooks
@cindex hooks
-Org has a large number of hook variables that can be used to add
-functionality. This appendix about hacking is going to illustrate the
-use of some of them. A complete list of all hooks with documentation is
-maintained by the Worg project and can be found at
-@uref{http://orgmode.org/worg/org-configs/org-hooks.php}.
+Org has a large number of hook variables for adding functionality. This
+appendix illustrates using a few. A complete list of hooks with
+documentation is maintained by the Worg project at
+@uref{http://orgmode.org/worg/doc.html#hooks}.
-@node Add-on packages, Adding hyperlink types, Hooks, Hacking
+@node Add-on packages
@section Add-on packages
@cindex add-on packages
-A large number of add-on packages have been written by various authors.
+Various authors wrote a large number of add-on packages for Org.
These packages are not part of Emacs, but they are distributed as contributed
packages with the separate release available at @uref{http://orgmode.org}.
See the @file{contrib/README} file in the source code directory for a list of
-contributed files. You may also find some more information on the Worg page:
+contributed files. Worg page with more information is at:
@uref{http://orgmode.org/worg/org-contrib/}.
-@node Adding hyperlink types, Adding export back-ends, Add-on packages, Hacking
+@node Adding hyperlink types
@section Adding hyperlink types
@cindex hyperlinks, adding new types
-Org has a large number of hyperlink types built-in
-(@pxref{Hyperlinks}). If you would like to add new link types, Org
-provides an interface for doing so. Let's look at an example file,
-@file{org-man.el}, that will add support for creating links like
-@samp{[[man:printf][The printf manpage]]} to show Unix manual pages inside
-Emacs:
+Org has many built-in hyperlink types (@pxref{Hyperlinks}), and an interface
+for adding new link types. The example file, @file{org-man.el}, shows the
+process of adding Org links to Unix man pages, which look like this:
+@samp{[[man:printf][The printf manpage]]}:
@lisp
;;; org-man.el - Support for links to manpages in Org
@@ -17029,149 +18288,118 @@ PATH should be a topic that can be thrown at the man command."
@end lisp
@noindent
-You would activate this new link type in @file{.emacs} with
+To activate links to man pages in Org, enter this in the init file:
@lisp
(require 'org-man)
@end lisp
@noindent
-Let's go through the file and see what it does.
+A review of @file{org-man.el}:
@enumerate
@item
-It does @code{(require 'org)} to make sure that @file{org.el} has been
-loaded.
+First, @code{(require 'org)} ensures @file{org.el} is loaded.
@item
-The next line calls @code{org-add-link-type} to define a new link type
-with prefix @samp{man}. The call also contains the name of a function
-that will be called to follow such a link.
+The @code{org-add-link-type} defines a new link type with @samp{man} prefix.
+The call contains the function to call that follows the link type.
@item
@vindex org-store-link-functions
-The next line adds a function to @code{org-store-link-functions}, in
-order to allow the command @kbd{C-c l} to record a useful link in a
-buffer displaying a man page.
+The next line adds a function to @code{org-store-link-functions} that records
+a useful link with the command @kbd{C-c l} in a buffer displaying a man page.
@end enumerate
-The rest of the file defines the necessary variables and functions.
-First there is a customization variable that determines which Emacs
-command should be used to display man pages. There are two options,
-@code{man} and @code{woman}. Then the function to follow a link is
-defined. It gets the link path as an argument---in this case the link
-path is just a topic for the manual command. The function calls the
-value of @code{org-man-command} to display the man page.
-
-Finally the function @code{org-man-store-link} is defined. When you try
-to store a link with @kbd{C-c l}, this function will be called to
-try to make a link. The function must first decide if it is supposed to
-create the link for this buffer type; we do this by checking the value
-of the variable @code{major-mode}. If not, the function must exit and
-return the value @code{nil}. If yes, the link is created by getting the
-manual topic from the buffer name and prefixing it with the string
-@samp{man:}. Then it must call the command @code{org-store-link-props}
-and set the @code{:type} and @code{:link} properties. Optionally you
-can also set the @code{:description} property to provide a default for
-the link description when the link is later inserted into an Org
-buffer with @kbd{C-c C-l}.
-
-When it makes sense for your new link type, you may also define a function
-@code{org-PREFIX-complete-link} that implements special (e.g., completion)
-support for inserting such a link with @kbd{C-c C-l}. Such a function should
-not accept any arguments, and return the full link with prefix.
-
-@node Adding export back-ends, Context-sensitive commands, Adding hyperlink types, Hacking
+The rest of the file defines necessary variables and functions. First is the
+customization variable @code{org-man-command}. It has two options,
+@code{man} and @code{woman}. Next is a function whose argument is the link
+path, which for man pages is the topic of the man command. To follow the
+link, the function calls the @code{org-man-command} to display the man page.
+
+
+@kbd{C-c l} constructs and stores the link.
+
+@kbd{C-c l} calls the function @code{org-man-store-link}, which first checks
+if the @code{major-mode} is appropriate. If check fails, the function
+returns @code{nil}. Otherwise the function makes a link string by combining
+the @samp{man:} prefix with the man topic. The function then calls
+@code{org-store-link-props} with @code{:type} and @code{:link} properties. A
+@code{:description} property is an optional string that is displayed when the
+function inserts the link in the Org buffer.
+
+@kbd{C-c C-l} inserts the stored link.
+
+To define new link types, define a function that implements completion
+support with @kbd{C-c C-l}. This function should not accept any arguments
+but return the appropriate prefix and complete link string.
+
+@node Adding export back-ends
@section Adding export back-ends
@cindex Export, writing back-ends
-Org 8.0 comes with a completely rewritten export engine which makes it easy
-to write new export back-ends, either from scratch, or from deriving them
-from existing ones.
-
-Your two entry points are respectively @code{org-export-define-backend} and
-@code{org-export-define-derived-backend}. To grok these functions, you
-should first have a look at @file{ox-latex.el} (for how to define a new
-back-end from scratch) and @file{ox-beamer.el} (for how to derive a new
-back-end from an existing one.
-
-When creating a new back-end from scratch, the basic idea is to set the name
-of the back-end (as a symbol) and an an alist of elements and export
-functions. On top of this, you will need to set additional keywords like
-@code{:menu-entry} (to display the back-end in the export dispatcher),
-@code{:export-block} (to specify what blocks should not be exported by this
-back-end), and @code{:options-alist} (to let the user set export options that
-are specific to this back-end.)
-
-Deriving a new back-end is similar, except that you need to set
-@code{:translate-alist} to an alist of export functions that should be used
-instead of the parent back-end functions.
-
-For a complete reference documentation, see
+Org's export engine makes it easy for writing new back-ends. The framework
+on which the engine was built makes it easy to derive new back-ends from
+existing ones.
+
+The two main entry points to the export engine are:
+@code{org-export-define-backend} and
+@code{org-export-define-derived-backend}. To grok these functions, see
+@file{ox-latex.el} for an example of defining a new back-end from scratch,
+and @file{ox-beamer.el} for an example of deriving from an existing engine.
+
+For creating a new back-end from scratch, first set its name as a symbol in
+an alist consisting of elements and export functions. To make the back-end
+visible to the export dispatcher, set @code{:menu-entry} keyword. For export
+options specific to this back-end, set the @code{:options-alist}.
+
+For creating a new back-end from an existing one, set @code{:translate-alist}
+to an alist of export functions. This alist replaces the parent back-end
+functions.
+
+For complete documentation, see
@url{http://orgmode.org/worg/dev/org-export-reference.html, the Org Export
Reference on Worg}.
-@node Context-sensitive commands, Tables in arbitrary syntax, Adding export back-ends, Hacking
+@node Context-sensitive commands
@section Context-sensitive commands
@cindex context-sensitive commands, hooks
@cindex add-ons, context-sensitive commands
@vindex org-ctrl-c-ctrl-c-hook
-Org has several commands that act differently depending on context. The most
-important example is the @kbd{C-c C-c} (@pxref{The very busy C-c C-c key}).
-Also the @kbd{M-cursor} and @kbd{M-S-cursor} keys have this property.
-
-Add-ons can tap into this functionality by providing a function that detects
-special context for that add-on and executes functionality appropriate for
-the context. Here is an example from Dan Davison's @file{org-R.el} which
-allows you to evaluate commands based on the @file{R} programming language
-@footnote{@file{org-R.el} has been replaced by the Org mode functionality
-described in @ref{Working With Source Code} and is now obsolete.}. For this
-package, special contexts are lines that start with @code{#+R:} or
-@code{#+RR:}.
-
-@lisp
-(defun org-R-apply-maybe ()
- "Detect if this is context for org-R and execute R commands."
- (if (save-excursion
- (beginning-of-line 1)
- (looking-at "#\\+RR?:"))
- (progn (call-interactively 'org-R-apply)
- t) ;; to signal that we took action
- nil)) ;; to signal that we did not
-
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-R-apply-maybe)
-@end lisp
+Org has facilities for building context sensitive commands. Authors of Org
+add-ons can tap into this functionality.
-The function first checks if the cursor is in such a line. If that is the
-case, @code{org-R-apply} is called and the function returns @code{t} to
-signal that action was taken, and @kbd{C-c C-c} will stop looking for other
-contexts. If the function finds it should do nothing locally, it returns
-@code{nil} so that other, similar functions can have a try.
+Some Org commands change depending on the context. The most important
+example of this behavior is the @kbd{C-c C-c} (@pxref{The very busy C-c C-c
+key}). Other examples are @kbd{M-cursor} and @kbd{M-S-cursor}.
+These context sensitive commands work by providing a function that detects
+special context for that add-on and executes functionality appropriate for
+that context.
-@node Tables in arbitrary syntax, Dynamic blocks, Context-sensitive commands, Hacking
+@node Tables in arbitrary syntax
@section Tables and lists in arbitrary syntax
@cindex tables, in other modes
@cindex lists, in other modes
@cindex Orgtbl mode
-Since Orgtbl mode can be used as a minor mode in arbitrary buffers, a
-frequent feature request has been to make it work with native tables in
-specific languages, for example @LaTeX{}. However, this is extremely
-hard to do in a general way, would lead to a customization nightmare,
-and would take away much of the simplicity of the Orgtbl mode table
-editor.
-
-This appendix describes a different approach. We keep the Orgtbl mode
-table in its native format (the @i{source table}), and use a custom
-function to @i{translate} the table to the correct syntax, and to
-@i{install} it in the right location (the @i{target table}). This puts
-the burden of writing conversion functions on the user, but it allows
-for a very flexible system.
-
-Bastien added the ability to do the same with lists, in Orgstruct mode. You
-can use Org's facilities to edit and structure lists by turning
-@code{orgstruct-mode} on, then locally exporting such lists in another format
-(HTML, @LaTeX{} or Texinfo.)
-
+Because of Org's success in handling tables with Orgtbl, a frequently asked
+feature is to Org's usability functions to other table formats native to
+other modem's, such as @LaTeX{}. This would be hard to do in a general way
+without complicated customization nightmares. Moreover, that would take Org
+away from its simplicity roots that Orgtbl has proven. There is, however, an
+alternate approach to accomplishing the same.
+
+This approach involves implementing a custom @emph{translate} function that
+operates on a native Org @emph{source table} to produce a table in another
+format. This strategy would keep the excellently working Orgtbl simple and
+isolate complications, if any, confined to the translate function. To add
+more alien table formats, we just add more translate functions. Also the
+burden of developing custom translate functions for new table formats will be
+in the hands of those who know those formats best.
+
+For an example of how this strategy works, see Orgstruct mode. In that mode,
+Bastien added the ability to use Org's facilities to edit and re-structure
+lists. He did by turning @code{orgstruct-mode} on, and then exporting the
+list locally to another format, such as HTML, @LaTeX{} or Texinfo.
@menu
* Radio tables:: Sending and receiving radio tables
@@ -17180,15 +18408,17 @@ can use Org's facilities to edit and structure lists by turning
* Radio lists:: Sending and receiving lists
@end menu
-@node Radio tables, A @LaTeX{} example, Tables in arbitrary syntax, Tables in arbitrary syntax
+@node Radio tables
@subsection Radio tables
@cindex radio tables
-To define the location of the target table, you first need to create two
-lines that are comments in the current mode, but contain magic words
-@code{BEGIN/END RECEIVE ORGTBL} for Orgtbl mode to find. Orgtbl mode will
-insert the translated table between these lines, replacing whatever was there
-before. For example in C mode where comments are between @code{/* ... */}:
+Radio tables are target locations for translated tables that are not near
+their source. Org finds the target location and inserts the translated
+table.
+
+The key to finding the target location are the magic words @code{BEGIN/END
+RECEIVE ORGTBL}. They have to appear as comments in the current mode. If
+the mode is C, then:
@example
/* BEGIN RECEIVE ORGTBL table_name */
@@ -17196,8 +18426,8 @@ before. For example in C mode where comments are between @code{/* ... */}:
@end example
@noindent
-Just above the source table, we put a special line that tells
-Orgtbl mode how to translate this table and where to install it. For
+At the location of source, Org needs a special line to direct Orgtbl to
+translate and to find the target for inserting the translated table. For
example:
@cindex #+ORGTBL
@example
@@ -17205,67 +18435,53 @@ example:
@end example
@noindent
-@code{table_name} is the reference name for the table that is also used
-in the receiver lines. @code{translation_function} is the Lisp function
-that does the translation. Furthermore, the line can contain a list of
-arguments (alternating key and value) at the end. The arguments will be
-passed as a property list to the translation function for
-interpretation. A few standard parameters are already recognized and
-acted upon before the translation function is called:
+@code{table_name} is the table's reference name, which is also used in the
+receiver lines, and the @code{translation_function} is the Lisp function that
+translates. This line, in addition, may also contain alternating key and
+value arguments at the end. The translation function gets these values as a
+property list. A few standard parameters are already recognized and acted
+upon before the translation function is called:
@table @code
@item :skip N
-Skip the first N lines of the table. Hlines do count as separate lines for
-this parameter!
+Skip the first N lines of the table. Hlines do count; include them if they
+are to be skipped.
@item :skipcols (n1 n2 ...)
-List of columns that should be skipped. If the table has a column with
-calculation marks, that column is automatically discarded as well.
-Please note that the translator function sees the table @emph{after} the
-removal of these columns, the function never knows that there have been
-additional columns.
-
-@item :no-escape t
-When non-@code{nil}, do not escape special characters @code{&%#_^} when exporting
-the table. The default value is @code{nil}.
+List of columns to be skipped. First Org automatically discards columns with
+calculation marks and then sends the table to the translator function, which
+then skips columns as specified in @samp{skipcols}.
@end table
@noindent
-The one problem remaining is how to keep the source table in the buffer
-without disturbing the normal workings of the file, for example during
-compilation of a C file or processing of a @LaTeX{} file. There are a
-number of different solutions:
+To keep the source table intact in the buffer without being disturbed when
+the source file is compiled or otherwise being worked on, use one of these
+strategies:
@itemize @bullet
@item
-The table could be placed in a block comment if that is supported by the
-language. For example, in C mode you could wrap the table between
-@samp{/*} and @samp{*/} lines.
+Place the table in a block comment. For example, in C mode you could wrap
+the table between @samp{/*} and @samp{*/} lines.
@item
-Sometimes it is possible to put the table after some kind of @i{END}
-statement, for example @samp{\bye} in @TeX{} and @samp{\end@{document@}}
-in @LaTeX{}.
+Put the table after an @samp{END} statement. For example @samp{\bye} in
+@TeX{} and @samp{\end@{document@}} in @LaTeX{}.
@item
-You can just comment the table line-by-line whenever you want to process
-the file, and uncomment it whenever you need to edit the table. This
-only sounds tedious---the command @kbd{M-x orgtbl-toggle-comment RET}
-makes this comment-toggling very easy, in particular if you bind it to a
-key.
+Comment and uncomment each line of the table during edits. The @kbd{M-x
+orgtbl-toggle-comment RET} command makes toggling easy.
@end itemize
-@node A @LaTeX{} example, Translator functions, Radio tables, Tables in arbitrary syntax
+@node A @LaTeX{} example
@subsection A @LaTeX{} example of radio tables
@cindex @LaTeX{}, and Orgtbl mode
-The best way to wrap the source table in @LaTeX{} is to use the
-@code{comment} environment provided by @file{comment.sty}. It has to be
-activated by placing @code{\usepackage@{comment@}} into the document
-header. Orgtbl mode can insert a radio table skeleton@footnote{By
-default this works only for @LaTeX{}, HTML, and Texinfo. Configure the
-variable @code{orgtbl-radio-table-templates} to install templates for other
-modes.} with the command @kbd{M-x orgtbl-insert-radio-table RET}. You will
-be prompted for a table name, let's say we use @samp{salesfigures}. You
-will then get the following template:
+To wrap a source table in @LaTeX{}, use the @code{comment} environment
+provided by @file{comment.sty}. To activate it, put
+@code{\usepackage@{comment@}} in the document header. Orgtbl mode inserts a
+radio table skeleton@footnote{By default this works only for @LaTeX{}, HTML,
+and Texinfo. Configure the variable @code{orgtbl-radio-table-templates} to
+install templates for other export formats.} with the command @kbd{M-x
+orgtbl-insert-radio-table RET}, which prompts for a table name. For example,
+if @samp{salesfigures} is the name, the template inserts:
@cindex #+ORGTBL, SEND
@example
@@ -17279,17 +18495,17 @@ will then get the following template:
@noindent
@vindex @LaTeX{}-verbatim-environments
-The @code{#+ORGTBL: SEND} line tells Orgtbl mode to use the function
-@code{orgtbl-to-latex} to convert the table into @LaTeX{} and to put it
-into the receiver location with name @code{salesfigures}. You may now
-fill in the table---feel free to use the spreadsheet features@footnote{If
-the @samp{#+TBLFM} line contains an odd number of dollar characters,
-this may cause problems with font-lock in @LaTeX{} mode. As shown in the
-example you can fix this by adding an extra line inside the
-@code{comment} environment that is used to balance the dollar
-expressions. If you are using AUC@TeX{} with the font-latex library, a
-much better solution is to add the @code{comment} environment to the
-variable @code{LaTeX-verbatim-environments}.}:
+The line @code{#+ORGTBL: SEND} tells Orgtbl mode to use the function
+@code{orgtbl-to-latex} to convert the table to @LaTeX{} format, then insert
+the table at the target (receive) location named @code{salesfigures}. Now
+the table is ready for data entry. It can even use spreadsheet
+features@footnote{If the @samp{#+TBLFM} line contains an odd number of dollar
+characters, this may cause problems with font-lock in @LaTeX{} mode. As
+shown in the example you can fix this by adding an extra line inside the
+@code{comment} environment that is used to balance the dollar expressions.
+If you are using AUC@TeX{} with the font-latex library, a much better
+solution is to add the @code{comment} environment to the variable
+@code{LaTeX-verbatim-environments}.}:
@example
% BEGIN RECEIVE ORGTBL salesfigures
@@ -17307,14 +18523,12 @@ variable @code{LaTeX-verbatim-environments}.}:
@end example
@noindent
-When you are done, press @kbd{C-c C-c} in the table to get the converted
-table inserted between the two marker lines.
+After editing, @kbd{C-c C-c} inserts translated table at the target location,
+between the two marker lines.
-Now let's assume you want to make the table header by hand, because you
-want to control how columns are aligned, etc. In this case we make sure
-that the table translator skips the first 2 lines of the source
-table, and tell the command to work as a @i{splice}, i.e., to not produce
-header and footer commands of the target table:
+For hand-made custom tables, note that the translator needs to skip the first
+two lines of the source table. Also the command has to @emph{splice} out the
+target table without the header and footer.
@example
\begin@{tabular@}@{lrrr@}
@@ -17335,135 +18549,109 @@ Month & \multicolumn@{1@}@{c@}@{Days@} & Nr.\ sold & per day\\
@end example
The @LaTeX{} translator function @code{orgtbl-to-latex} is already part of
-Orgtbl mode. It uses a @code{tabular} environment to typeset the table
-and marks horizontal lines with @code{\hline}. Furthermore, it
-interprets the following parameters (see also @pxref{Translator functions}):
+Orgtbl mode and uses @code{tabular} environment by default to typeset the
+table and mark the horizontal lines with @code{\hline}. For additional
+parameters to control output, @pxref{Translator functions}:
@table @code
@item :splice nil/t
-When set to t, return only table body lines, don't wrap them into a
-tabular environment. Default is @code{nil}.
+When non-@code{nil}, returns only table body lines; not wrapped in tabular
+environment. Default is @code{nil}.
@item :fmt fmt
-A format to be used to wrap each field, it should contain @code{%s} for the
-original field value. For example, to wrap each field value in dollars,
-you could use @code{:fmt "$%s$"}. This may also be a property list with
+Format to warp each field. It should contain @code{%s} for the original
+field value. For example, to wrap each field value in dollar symbol, you
+could use @code{:fmt "$%s$"}. Format can also wrap a property list with
column numbers and formats, for example @code{:fmt (2 "$%s$" 4 "%s\\%%")}.
-A function of one argument can be used in place of the strings; the
-function must return a formatted string.
+In place of a string, a function of one argument can be used; the function
+must return a formatted string.
@item :efmt efmt
-Use this format to print numbers with exponentials. The format should
-have @code{%s} twice for inserting mantissa and exponent, for example
-@code{"%s\\times10^@{%s@}"}. The default is @code{"%s\\,(%s)"}. This
-may also be a property list with column numbers and formats, for example
+Format numbers as exponentials. The spec should have @code{%s} twice for
+inserting mantissa and exponent, for example @code{"%s\\times10^@{%s@}"}.
+This may also be a property list with column numbers and formats, for example
@code{:efmt (2 "$%s\\times10^@{%s@}$" 4 "$%s\\cdot10^@{%s@}$")}. After
-@code{efmt} has been applied to a value, @code{fmt} will also be
-applied. Similar to @code{fmt}, functions of two arguments can be
-supplied instead of strings.
+@code{efmt} has been applied to a value, @code{fmt} will also be applied.
+Functions with two arguments can be supplied instead of strings. By default,
+no special formatting is applied.
@end table
-@node Translator functions, Radio lists, A @LaTeX{} example, Tables in arbitrary syntax
+@node Translator functions
@subsection Translator functions
@cindex HTML, and Orgtbl mode
@cindex translator function
-Orgtbl mode has several translator functions built-in: @code{orgtbl-to-csv}
-(comma-separated values), @code{orgtbl-to-tsv} (TAB-separated values)
-@code{orgtbl-to-latex}, @code{orgtbl-to-html}, and @code{orgtbl-to-texinfo}.
-Except for @code{orgtbl-to-html}@footnote{The HTML translator uses the same
-code that produces tables during HTML export.}, these all use a generic
-translator, @code{orgtbl-to-generic}. For example, @code{orgtbl-to-latex}
-itself is a very short function that computes the column definitions for the
-@code{tabular} environment, defines a few field and line separators and then
-hands processing over to the generic translator. Here is the entire code:
-
-@lisp
-@group
-(defun orgtbl-to-latex (table params)
- "Convert the Orgtbl mode TABLE to LaTeX."
- (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
- org-table-last-alignment ""))
- (params2
- (list
- :tstart (concat "\\begin@{tabular@}@{" alignment "@}")
- :tend "\\end@{tabular@}"
- :lstart "" :lend " \\\\" :sep " & "
- :efmt "%s\\,(%s)" :hline "\\hline")))
- (orgtbl-to-generic table (org-combine-plists params2 params))))
-@end group
-@end lisp
+Orgtbl mode has built-in translator functions: @code{orgtbl-to-csv}
+(comma-separated values), @code{orgtbl-to-tsv} (TAB-separated values),
+@code{orgtbl-to-latex}, @code{orgtbl-to-html}, @code{orgtbl-to-texinfo},
+@code{orgtbl-to-unicode} and @code{orgtbl-to-orgtbl}. They use the generic
+translator, @code{orgtbl-to-generic}, which delegates translations to various
+export back-ends.
-As you can see, the properties passed into the function (variable
-@var{PARAMS}) are combined with the ones newly defined in the function
-(variable @var{PARAMS2}). The ones passed into the function (i.e., the
-ones set by the @samp{ORGTBL SEND} line) take precedence. So if you
-would like to use the @LaTeX{} translator, but wanted the line endings to
-be @samp{\\[2mm]} instead of the default @samp{\\}, you could just
-overrule the default with
+Properties passed to the function through the @samp{ORGTBL SEND} line take
+precedence over properties defined inside the function. For example, this
+overrides the default @LaTeX{} line endings, @samp{\\}, with @samp{\\[2mm]}:
@example
#+ORGTBL: SEND test orgtbl-to-latex :lend " \\\\[2mm]"
@end example
-For a new language, you can either write your own converter function in
-analogy with the @LaTeX{} translator, or you can use the generic function
-directly. For example, if you have a language where a table is started
-with @samp{!BTBL!}, ended with @samp{!ETBL!}, and where table lines are
-started with @samp{!BL!}, ended with @samp{!EL!}, and where the field
-separator is a TAB, you could call the generic translator like this (on
-a single line!):
+For a new language translator, define a converter function. It can be a
+generic function, such as shown in this example. It marks a beginning and
+ending of a table with @samp{!BTBL!} and @samp{!ETBL!}; a beginning and
+ending of lines with @samp{!BL!} and @samp{!EL!}; and uses a TAB for a field
+separator:
-@example
-#+ORGTBL: SEND test orgtbl-to-generic :tstart "!BTBL!" :tend "!ETBL!"
- :lstart "!BL! " :lend " !EL!" :sep "\t"
-@end example
+@lisp
+(defun orgtbl-to-language (table params)
+ "Convert the orgtbl-mode TABLE to language."
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ '(:tstart "!BTBL!" :tend "!ETBL!" :lstart "!BL!" :lend "!EL!" :sep "\t")
+ params)))
+@end lisp
@noindent
-Please check the documentation string of the function
-@code{orgtbl-to-generic} for a full list of parameters understood by
-that function, and remember that you can pass each of them into
+The documentation for the @code{orgtbl-to-generic} function shows a complete
+list of parameters, each of which can be passed through to
@code{orgtbl-to-latex}, @code{orgtbl-to-texinfo}, and any other function
-using the generic function.
-
-Of course you can also write a completely new function doing complicated
-things the generic translator cannot do. A translator function takes
-two arguments. The first argument is the table, a list of lines, each
-line either the symbol @code{hline} or a list of fields. The second
-argument is the property list containing all parameters specified in the
-@samp{#+ORGTBL: SEND} line. The function must return a single string
-containing the formatted table. If you write a generally useful
-translator, please post it on @email{emacs-orgmode@@gnu.org} so that
-others can benefit from your work.
-
-@node Radio lists, , Translator functions, Tables in arbitrary syntax
+using that generic function.
+
+For complicated translations the generic translator function could be
+replaced by a custom translator function. Such a custom function must take
+two arguments and return a single string containing the formatted table. The
+first argument is the table whose lines are a list of fields or the symbol
+@code{hline}. The second argument is the property list consisting of
+parameters specified in the @samp{#+ORGTBL: SEND} line. Please share your
+translator functions by posting them to the Org users mailing list,
+@email{emacs-orgmode@@gnu.org}.
+
+@node Radio lists
@subsection Radio lists
@cindex radio lists
@cindex org-list-insert-radio-list
-Sending and receiving radio lists works exactly the same way as sending and
-receiving radio tables (@pxref{Radio tables}). As for radio tables, you can
-insert radio list templates in HTML, @LaTeX{} and Texinfo modes by calling
-@code{org-list-insert-radio-list}.
-
-Here are the differences with radio tables:
+Call the @code{org-list-insert-radio-list} function to insert a radio list
+template in HTML, @LaTeX{}, and Texinfo mode documents. Sending and
+receiving radio lists works is the same as for radio tables (@pxref{Radio
+tables}) except for these differences:
+@cindex #+ORGLST
@itemize @minus
@item
Orgstruct mode must be active.
@item
-Use the @code{ORGLST} keyword instead of @code{ORGTBL}.
+Use @code{ORGLST} keyword instead of @code{ORGTBL}.
@item
-The available translation functions for radio lists don't take
-parameters.
-@item
-@kbd{C-c C-c} will work when pressed on the first item of the list.
+@kbd{C-c C-c} works only on the first list item.
@end itemize
-Here is a @LaTeX{} example. Let's say that you have this in your
-@LaTeX{} file:
+Built-in translators functions are: @code{org-list-to-latex},
+@code{org-list-to-html} and @code{org-list-to-texinfo}. They use the
+@code{org-list-to-generic} translator function. See its documentation for
+parameters for accurate customizations of lists. Here is a @LaTeX{} example:
-@cindex #+ORGLST
@example
% BEGIN RECEIVE ORGLST to-buy
% END RECEIVE ORGLST to-buy
@@ -17477,21 +18665,21 @@ Here is a @LaTeX{} example. Let's say that you have this in your
\end@{comment@}
@end example
-Pressing @kbd{C-c C-c} on @code{a new house} and will insert the converted
-@LaTeX{} list between the two marker lines.
+@kbd{C-c C-c} on @samp{a new house} inserts the translated @LaTeX{} list
+in-between the BEGIN and END marker lines.
-@node Dynamic blocks, Special agenda views, Tables in arbitrary syntax, Hacking
+@node Dynamic blocks
@section Dynamic blocks
@cindex dynamic blocks
-Org documents can contain @emph{dynamic blocks}. These are
-specially marked regions that are updated by some user-written function.
-A good example for such a block is the clock table inserted by the
-command @kbd{C-c C-x C-r} (@pxref{Clocking work time}).
+Org supports @emph{dynamic blocks} in Org documents. They are inserted with
+begin and end markers like any other @samp{src} code block, but the contents
+are updated automatically by a user function. For example, @kbd{C-c C-x C-r}
+inserts a dynamic table that updates the work time (@pxref{Clocking work
+time}).
-Dynamic blocks are enclosed by a BEGIN-END structure that assigns a name
-to the block and can also specify parameters for the function producing
-the content of the block.
+Dynamic blocks can have names and function parameters. The syntax is similar
+to @samp{src} code block specifications:
@cindex #+BEGIN:dynamic block
@example
@@ -17500,7 +18688,7 @@ the content of the block.
#+END:
@end example
-Dynamic blocks are updated with the following commands
+These command update dynamic blocks:
@table @kbd
@orgcmd{C-c C-x C-u,org-dblock-update}
@@ -17509,17 +18697,16 @@ Update dynamic block at point.
Update all dynamic blocks in the current file.
@end table
-Updating a dynamic block means to remove all the text between BEGIN and
-END, parse the BEGIN line for parameters and then call the specific
-writer function for this block to insert the new content. If you want
-to use the original content in the writer function, you can use the
-extra parameter @code{:content}.
+Before updating a dynamic block, Org removes content between the BEGIN and
+END markers. Org then reads the parameters on the BEGIN line for passing to
+the writer function. If the function expects to access the removed content,
+then Org expects an extra parameter, @code{:content}, on the BEGIN line.
-For a block with name @code{myblock}, the writer function is
-@code{org-dblock-write:myblock} with as only parameter a property list
-with the parameters given in the begin line. Here is a trivial example
-of a block that keeps track of when the block update function was last
-run:
+To syntax for calling a writer function with a named block, @code{myblock}
+is: @code{org-dblock-write:myblock}. Parameters come from the BEGIN line.
+
+The following is an example of a dynamic block and a block writer function
+that updates the time when the function was last run:
@example
#+BEGIN: block-update-time :format "on %m/%d/%Y at %H:%M"
@@ -17528,7 +18715,7 @@ run:
@end example
@noindent
-The corresponding block writer function could look like this:
+The dynamic block's writer function:
@lisp
(defun org-dblock-write:block-update-time (params)
@@ -17537,47 +18724,40 @@ The corresponding block writer function could look like this:
(format-time-string fmt))))
@end lisp
-If you want to make sure that all dynamic blocks are always up-to-date,
-you could add the function @code{org-update-all-dblocks} to a hook, for
-example @code{before-save-hook}. @code{org-update-all-dblocks} is
-written in a way such that it does nothing in buffers that are not in
-@code{org-mode}.
+To keep dynamic blocks up-to-date in an Org file, use the function,
+@code{org-update-all-dblocks} in hook, such as @code{before-save-hook}. The
+@code{org-update-all-dblocks} function does not run if the file is not in
+Org mode.
-You can narrow the current buffer to the current dynamic block (like any
-other block) with @code{org-narrow-to-block}.
+Dynamic blocks, like any other block, can be narrowed with
+@code{org-narrow-to-block}.
-@node Special agenda views, Speeding up your agendas, Dynamic blocks, Hacking
+@node Special agenda views
@section Special agenda views
@cindex agenda views, user-defined
@vindex org-agenda-skip-function
@vindex org-agenda-skip-function-global
-Org provides a special hook that can be used to narrow down the selection
-made by these agenda views: @code{agenda}, @code{agenda*}@footnote{The
-@code{agenda*} view is the same than @code{agenda} except that it only
-considers @emph{appointments}, i.e., scheduled and deadline items that have a
-time specification @code{[h]h:mm} in their time-stamps.}, @code{todo},
-@code{alltodo}, @code{tags}, @code{tags-todo}, @code{tags-tree}. You may
-specify a function that is used at each match to verify if the match should
-indeed be part of the agenda view, and if not, how much should be skipped.
-You can specify a global condition that will be applied to all agenda views,
-this condition would be stored in the variable
-@code{org-agenda-skip-function-global}. More commonly, such a definition is
-applied only to specific custom searches, using
-@code{org-agenda-skip-function}.
-
-Let's say you want to produce a list of projects that contain a WAITING
-tag anywhere in the project tree. Let's further assume that you have
-marked all tree headings that define a project with the TODO keyword
-PROJECT@. In this case you would run a TODO search for the keyword
-PROJECT, but skip the match unless there is a WAITING tag anywhere in
-the subtree belonging to the project line.
-
-To achieve this, you must write a function that searches the subtree for
-the tag. If the tag is found, the function must return @code{nil} to
-indicate that this match should not be skipped. If there is no such
-tag, return the location of the end of the subtree, to indicate that
-search should continue from there.
+Org provides a special hook to further limit items in agenda views:
+@code{agenda}, @code{agenda*}@footnote{The @code{agenda*} view is the same as
+@code{agenda} except that it only considers @emph{appointments}, i.e.,
+scheduled and deadline items that have a time specification @samp{[h]h:mm} in
+their time-stamps.}, @code{todo}, @code{alltodo}, @code{tags},
+@code{tags-todo}, @code{tags-tree}. Specify a custom function that tests
+inclusion of every matched item in the view. This function can also
+skip as much as is needed.
+
+For a global condition applicable to agenda views, use the
+@code{org-agenda-skip-function-global} variable. Org uses a global condition
+with @code{org-agenda-skip-function} for custom searching.
+
+This example defines a function for a custom view showing TODO items with
+WAITING status. Manually this is a multi step search process, but with a
+custom view, this can be automated as follows:
+
+The custom function searches the subtree for the WAITING tag and returns
+@code{nil} on match. Otherwise it gives the location from where the search
+continues.
@lisp
(defun my-skip-unless-waiting ()
@@ -17588,8 +18768,7 @@ search should continue from there.
subtree-end))) ; tag not found, continue after end of subtree
@end lisp
-Now you may use this function in an agenda custom command, for example
-like this:
+To use this custom function in a custom agenda command:
@lisp
(org-add-agenda-custom-command
@@ -17599,22 +18778,20 @@ like this:
@end lisp
@vindex org-agenda-overriding-header
-Note that this also binds @code{org-agenda-overriding-header} to get a
-meaningful header in the agenda view.
+Note that this also binds @code{org-agenda-overriding-header} to a more
+meaningful string suitable for the agenda view.
@vindex org-odd-levels-only
@vindex org-agenda-skip-function
-A general way to create custom searches is to base them on a search for
-entries with a certain level limit. If you want to study all entries with
-your custom search function, simply do a search for
-@samp{LEVEL>0}@footnote{Note that, when using @code{org-odd-levels-only}, a
-level number corresponds to order in the hierarchy, not to the number of
-stars.}, and then use @code{org-agenda-skip-function} to select the entries
-you really want to have.
-
-You may also put a Lisp form into @code{org-agenda-skip-function}. In
-particular, you may use the functions @code{org-agenda-skip-entry-if}
-and @code{org-agenda-skip-subtree-if} in this form, for example:
+
+Search for entries with a limit set on levels for the custom search. This is
+a general approach to creating custom searches in Org. To include all
+levels, use @samp{LEVEL>0}@footnote{Note that, for
+@code{org-odd-levels-only}, a level number corresponds to order in the
+hierarchy, not to the number of stars.}. Then to selectively pick the
+matched entries, use @code{org-agenda-skip-function}, which also accepts Lisp
+forms, such as @code{org-agenda-skip-entry-if} and
+@code{org-agenda-skip-subtree-if}. For example:
@table @code
@item (org-agenda-skip-entry-if 'scheduled)
@@ -17640,8 +18817,8 @@ Skip current entry unless the regular expression matches.
Same as above, but check and skip the entire subtree.
@end table
-Therefore we could also have written the search for WAITING projects
-like this, even without defining a special function:
+The following is an example of a search for @samp{WAITING} without the
+special function:
@lisp
(org-add-agenda-custom-command
@@ -17651,72 +18828,71 @@ like this, even without defining a special function:
(org-agenda-overriding-header "Projects waiting for something: "))))
@end lisp
-@node Speeding up your agendas, Extracting agenda information, Special agenda views, Hacking
+@node Speeding up your agendas
@section Speeding up your agendas
@cindex agenda views, optimization
-When your Org files grow in both number and size, agenda commands may start
-to become slow. Below are some tips on how to speed up the agenda commands.
+Some agenda commands slow down when the Org files grow in size or number.
+Here are tips to speed up:
@enumerate
@item
-Reduce the number of Org agenda files: this will reduce the slowness caused
-by accessing a hard drive.
+Reduce the number of Org agenda files to avoid slowdowns due to hard drive
+accesses.
@item
-Reduce the number of DONE and archived headlines: this way the agenda does
-not need to skip them.
+Reduce the number of @samp{DONE} and archived headlines so agenda operations
+that skip over these can finish faster.
@item
@vindex org-agenda-dim-blocked-tasks
-Inhibit the dimming of blocked tasks:
+Do not dim blocked tasks:
@lisp
(setq org-agenda-dim-blocked-tasks nil)
@end lisp
@item
@vindex org-startup-folded
@vindex org-agenda-inhibit-startup
-Inhibit agenda files startup options:
+Stop preparing agenda buffers on startup:
@lisp
(setq org-agenda-inhibit-startup nil)
@end lisp
@item
@vindex org-agenda-show-inherited-tags
@vindex org-agenda-use-tag-inheritance
-Disable tag inheritance in agenda:
+Disable tag inheritance for agendas:
@lisp
(setq org-agenda-use-tag-inheritance nil)
@end lisp
@end enumerate
-You can set these options for specific agenda views only. See the docstrings
-of these variables for details on why they affect the agenda generation, and
-this @uref{http://orgmode.org/worg/agenda-optimization.html, dedicated Worg
-page} for further explanations.
+These options can be applied to selected agenda views. For more details
+about generation of agenda views, see the docstrings for the relevant
+variables, and this @uref{http://orgmode.org/worg/agenda-optimization.html,
+dedicated Worg page} for agenda optimization.
-@node Extracting agenda information, Using the property API, Speeding up your agendas, Hacking
+@node Extracting agenda information
@section Extracting agenda information
@cindex agenda, pipe
@cindex Scripts, for agenda processing
@vindex org-agenda-custom-commands
-Org provides commands to access agenda information for the command
-line in Emacs batch mode. This extracted information can be sent
-directly to a printer, or it can be read by a program that does further
-processing of the data. The first of these commands is the function
-@code{org-batch-agenda}, that produces an agenda view and sends it as
-ASCII text to STDOUT@. The command takes a single string as parameter.
-If the string has length 1, it is used as a key to one of the commands
-you have configured in @code{org-agenda-custom-commands}, basically any
-key you can use after @kbd{C-c a}. For example, to directly print the
-current TODO list, you could use
+Org provides commands to access agendas through Emacs batch mode. Through
+this command-line interface, agendas are automated for further processing or
+printing.
+
+@code{org-batch-agenda} creates an agenda view in ASCII and outputs to
+STDOUT. This command takes one string parameter. When string length=1, Org
+uses it as a key to @code{org-agenda-custom-commands}. These are the same
+ones available through @kbd{C-c a}.
+
+This example command line directly prints the TODO list to the printer:
@example
emacs -batch -l ~/.emacs -eval '(org-batch-agenda "t")' | lpr
@end example
-If the parameter is a string with 2 or more characters, it is used as a
-tags/TODO match string. For example, to print your local shopping list
-(all items with the tag @samp{shop}, but excluding the tag
-@samp{NewYork}), you could use
+When the string parameter length is two or more characters, Org matches it
+with tags/TODO strings. For example, this example command line prints items
+tagged with @samp{shop}, but excludes items tagged with @samp{NewYork}:
@example
emacs -batch -l ~/.emacs \
@@ -17724,7 +18900,7 @@ emacs -batch -l ~/.emacs \
@end example
@noindent
-You may also modify parameters on the fly like this:
+An example showing on-the-fly parameter modifications:
@example
emacs -batch -l ~/.emacs \
@@ -17736,14 +18912,11 @@ emacs -batch -l ~/.emacs \
@end example
@noindent
-which will produce a 30-day agenda, fully restricted to the Org file
-@file{~/org/projects.org}, not even including the diary.
+which will produce an agenda for the next 30 days from just the
+@file{~/org/projects.org} file.
-If you want to process the agenda data in more sophisticated ways, you
-can use the command @code{org-batch-agenda-csv} to get a comma-separated
-list of values for each agenda item. Each line in the output will
-contain a number of fields separated by commas. The fields in a line
-are:
+For structured processing of agenda output, use @code{org-batch-agenda-csv}
+with the following fields:
@example
category @r{The category of the item}
@@ -17769,12 +18942,15 @@ priority-n @r{The computed numerical priority}
@end example
@noindent
-Time and date will only be given if a timestamp (or deadline/scheduled)
-led to the selection of the item.
+If the selection of the agenda item was based on a timestamp, including those
+items with @samp{DEADLINE} and @samp{SCHEDULED} keywords, then Org includes
+date and time in the output.
+
+If the selection of the agenda item was based on a timestamp (or
+deadline/scheduled), then Org includes date and time in the output.
-A CSV list like this is very easy to use in a post-processing script.
-For example, here is a Perl program that gets the TODO list from
-Emacs/Org and prints all the items, preceded by a checkbox:
+Here is an example of a post-processing script in Perl. It takes the CSV
+output from Emacs and prints with a checkbox:
@example
#!/usr/bin/perl
@@ -17795,13 +18971,12 @@ foreach $line (split(/\n/,$agenda)) @{
@}
@end example
-@node Using the property API, Using the mapping API, Extracting agenda information, Hacking
+@node Using the property API
@section Using the property API
@cindex API, for properties
@cindex properties, API
-Here is a description of the functions that can be used to work with
-properties.
+Functions for working with properties.
@defun org-entry-properties &optional pom which
Get all properties of the entry at point-or-marker POM.@*
@@ -17813,14 +18988,15 @@ POM may also be @code{nil}, in which case the current entry is used.
If WHICH is @code{nil} or @code{all}, get all properties. If WHICH is
@code{special} or @code{standard}, only get that subclass.
@end defun
+
@vindex org-use-property-inheritance
@findex org-insert-property-drawer
@defun org-entry-get pom property &optional inherit
-Get value of @code{PROPERTY} for entry at point-or-marker @code{POM}@. By default,
-this only looks at properties defined locally in the entry. If @code{INHERIT}
-is non-@code{nil} and the entry does not have the property, then also check
-higher levels of the hierarchy. If @code{INHERIT} is the symbol
-@code{selective}, use inheritance if and only if the setting of
+Get value of @code{PROPERTY} for entry at point-or-marker @code{POM}@. By
+default, this only looks at properties defined locally in the entry. If
+@code{INHERIT} is non-@code{nil} and the entry does not have the property,
+then also check higher levels of the hierarchy. If @code{INHERIT} is the
+symbol @code{selective}, use inheritance if and only if the setting of
@code{org-use-property-inheritance} selects @code{PROPERTY} for inheritance.
@end defun
@@ -17837,7 +19013,7 @@ Get all property keys in the current buffer.
@end defun
@defun org-insert-property-drawer
-Insert a property drawer for the current entry. Also
+Insert a property drawer for the current entry.
@end defun
@defun org-entry-put-multivalued-property pom property &rest values
@@ -17875,41 +19051,37 @@ to be entered. The functions must return @code{nil} if they are not
responsible for this property.
@end defopt
-@node Using the mapping API, , Using the property API, Hacking
+@node Using the mapping API
@section Using the mapping API
@cindex API, for mapping
@cindex mapping entries, API
-Org has sophisticated mapping capabilities to find all entries satisfying
-certain criteria. Internally, this functionality is used to produce agenda
-views, but there is also an API that can be used to execute arbitrary
-functions for each or selected entries. The main entry point for this API
-is:
+Org has sophisticated mapping capabilities for finding entries. Org uses
+this functionality internally for generating agenda views. Org also exposes
+an API for executing arbitrary functions for each selected entry. The API's
+main entry point is:
@defun org-map-entries func &optional match scope &rest skip
-Call @code{FUNC} at each headline selected by @code{MATCH} in @code{SCOPE}.
+Call @samp{FUNC} at each headline selected by @code{MATCH} in @code{SCOPE}.
-@code{FUNC} is a function or a Lisp form. The function will be called
-without arguments, with the cursor positioned at the beginning of the
-headline. The return values of all calls to the function will be collected
-and returned as a list.
+@samp{FUNC} is a function or a Lisp form. With the cursor positioned at the
+beginning of the headline, call the function without arguments. Org returns
+an alist of return values of calls to the function.
-The call to @code{FUNC} will be wrapped into a save-excursion form, so
-@code{FUNC} does not need to preserve point. After evaluation, the cursor
-will be moved to the end of the line (presumably of the headline of the
-processed entry) and search continues from there. Under some circumstances,
-this may not produce the wanted results. For example, if you have removed
-(e.g., archived) the current (sub)tree it could mean that the next entry will
-be skipped entirely. In such cases, you can specify the position from where
-search should continue by making @code{FUNC} set the variable
-@code{org-map-continue-from} to the desired buffer position.
+To avoid preserving point, Org wraps the call to @code{FUNC} in
+save-excursion form. After evaluation, Org moves the cursor to the end of
+the line that was just processed. Search continues from that point forward.
+This may not always work as expected under some conditions, such as if the
+current sub-tree was removed by a previous archiving operation. In such rare
+circumstances, Org skips the next entry entirely when it should not. To stop
+Org from such skips, make @samp{FUNC} set the variable
+@code{org-map-continue-from} to a specific buffer position.
-@code{MATCH} is a tags/property/todo match as it is used in the agenda match
-view. Only headlines that are matched by this query will be considered
-during the iteration. When @code{MATCH} is @code{nil} or @code{t}, all
-headlines will be visited by the iteration.
+@samp{MATCH} is a tags/property/TODO match. Org iterates only matched
+headlines. Org iterates over all headlines when @code{MATCH} is @code{nil}
+or @code{t}.
-@code{SCOPE} determines the scope of this command. It can be any of:
+@samp{SCOPE} determines the scope of this command. It can be any of:
@example
nil @r{the current buffer, respecting the restriction if any}
@@ -17925,8 +19097,8 @@ agenda-with-archives
@r{if this is a list, all files in the list will be scanned}
@end example
@noindent
-The remaining args are treated as settings for the skipping facilities of
-the scanner. The following items can be given here:
+The remaining args are treated as settings for the scanner's skipping
+facilities. Valid args are:
@vindex org-agenda-skip-function
@example
@@ -17940,10 +19112,9 @@ function or Lisp form
@end example
@end defun
-The function given to that mapping routine can really do anything you like.
-It can use the property API (@pxref{Using the property API}) to gather more
-information about the entry, or in order to change metadata in the entry.
-Here are a couple of functions that might be handy:
+The mapping routine can call any arbitrary function, even functions that
+change meta data or query the property API (@pxref{Using the property API}).
+Here are some handy functions:
@defun org-todo &optional arg
Change the TODO state of the entry. See the docstring of the functions for
@@ -17969,9 +19140,9 @@ Promote the current entry.
Demote the current entry.
@end defun
-Here is a simple example that will turn all entries in the current file with
-a tag @code{TOMORROW} into TODO entries with the keyword @code{UPCOMING}.
-Entries in comment trees and in archive trees will be ignored.
+This example turns all entries tagged with @code{TOMORROW} into TODO entries
+with keyword @code{UPCOMING}. Org ignores entries in comment trees and
+archive trees.
@lisp
(org-map-entries
@@ -17986,105 +19157,103 @@ The following example counts the number of entries with TODO keyword
(length (org-map-entries t "/+WAITING" 'agenda))
@end lisp
-@node MobileOrg, History and Acknowledgments, Hacking, Top
+@node MobileOrg
@appendix MobileOrg
@cindex iPhone
@cindex MobileOrg
-@i{MobileOrg} is the name of the mobile companion app for Org mode, currently
-available for iOS and for Android. @i{MobileOrg} offers offline viewing and
-capture support for an Org mode system rooted on a ``real'' computer. It
-does also allow you to record changes to existing entries. The
-@uref{https://github.com/MobileOrg/, iOS implementation} for the
-@i{iPhone/iPod Touch/iPad} series of devices, was started by Richard Moreland
-and is now in the hands Sean Escriva. Android users should check out
-@uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg Android}
-by Matt Jones. The two implementations are not identical but offer similar
-features.
-
-This appendix describes the support Org has for creating agenda views in a
-format that can be displayed by @i{MobileOrg}, and for integrating notes
-captured and changes made by @i{MobileOrg} into the main system.
-
-For changing tags and TODO states in MobileOrg, you should have set up the
-customization variables @code{org-todo-keywords} and @code{org-tag-alist} to
-cover all important tags and TODO keywords, even if individual files use only
-part of these. MobileOrg will also offer you states and tags set up with
-in-buffer settings, but it will understand the logistics of TODO state
-@i{sets} (@pxref{Per-file keywords}) and @i{mutually exclusive} tags
+MobileOrg is a companion mobile app that runs on iOS and Android devices.
+MobileOrg enables offline-views and capture support for an Org mode system
+that is rooted on a ``real'' computer. MobileOrg can record changes to
+existing entries.
+
+The @uref{https://github.com/MobileOrg/, iOS implementation} for the
+@emph{iPhone/iPod Touch/iPad} series of devices, was started by Richard
+Moreland and is now in the hands Sean Escriva. Android users should check
+out @uref{http://wiki.github.com/matburt/mobileorg-android/, MobileOrg
+Android} by Matt Jones. Though the two implementations are not identical,
+they offer similar features.
+
+This appendix describes Org's support for agenda view formats compatible with
+MobileOrg. It also describes synchronizing changes, such as to notes,
+between MobileOrg and the computer.
+
+To change tags and TODO states in MobileOrg, 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 MobileOrg has in-buffer settings, it understands TODO states
+@emph{sets} (@pxref{Per-file keywords}) and @emph{mutually exclusive} tags
(@pxref{Setting tags}) only for those set in these variables.
@menu
-* Setting up the staging area:: Where to interact with the mobile device
+* Setting up the staging area:: For the mobile device
* Pushing to MobileOrg:: Uploading Org files and agendas
* Pulling from MobileOrg:: Integrating captured and flagged items
@end menu
-@node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg
+@node Setting up the staging area
@section Setting up the staging area
-MobileOrg needs to interact with Emacs through a directory on a server. If you
-are using a public server, you should consider to encrypt the files that are
-uploaded to the server. This can be done with Org mode 7.02 and with
-@i{MobileOrg 1.5} (iPhone version), and you need an @file{openssl}
-installation on your system. To turn on encryption, set a password in
-@i{MobileOrg} and, on the Emacs side, configure the variable
-@code{org-mobile-use-encryption}@footnote{If you can safely store the
-password in your Emacs setup, you might also want to configure
-@code{org-mobile-encryption-password}. Please read the docstring of that
-variable. Note that encryption will apply only to the contents of the
-@file{.org} files. The file names themselves will remain visible.}.
-
-The easiest way to create that directory is to use a free
-@uref{http://dropbox.com,Dropbox.com} account@footnote{If you cannot use
-Dropbox, or if your version of MobileOrg does not support it, you can use a
-webdav server. For more information, check out the documentation of MobileOrg and also this
+MobileOrg needs access to a file directory on a server to interact with
+Emacs. With a public server, consider encrypting the files. MobileOrg
+version 1.5 supports encryption for the iPhone. Org also requires
+@file{openssl} installed on the local computer. To turn on encryption, set
+the same password in MobileOrg and in Emacs. Set the password in the
+variable @code{org-mobile-use-encryption}@footnote{If Emacs is configured for
+safe storing of passwords, then configure the variable,
+@code{org-mobile-encryption-password}; please read the docstring of that
+variable.}. Note that even after MobileOrg encrypts the file contents, the
+file names will remain visible on the file systems of the local computer, the
+server, and the mobile device.
+
+For a server to host files, consider options like
+@uref{http://dropbox.com,Dropbox.com} account@footnote{An alternative is to
+use webdav server. MobileOrg documentation has details of webdav server
+configuration. Additional help is at
@uref{http://orgmode.org/worg/org-faq.html#mobileorg_webdav, FAQ entry}.}.
-When MobileOrg first connects to your Dropbox, it will create a directory
-@i{MobileOrg} inside the Dropbox. After the directory has been created, tell
-Emacs about it:
+On first connection, MobileOrg creates a directory @file{MobileOrg/} on
+Dropbox. Pass its location to Emacs through an init file variable as
+follows:
@lisp
(setq org-mobile-directory "~/Dropbox/MobileOrg")
@end lisp
-Org mode has commands to put files for @i{MobileOrg} into that directory,
-and to read captured notes from there.
+Org copies files to the above directory for MobileOrg. Org also uses the
+same directory for sharing notes between Org and MobileOrg.
-@node Pushing to MobileOrg, Pulling from MobileOrg, Setting up the staging area, MobileOrg
+@node Pushing to MobileOrg
@section Pushing to MobileOrg
-This operation copies all files currently listed in @code{org-mobile-files}
-to the directory @code{org-mobile-directory}. By default this list contains
-all agenda files (as listed in @code{org-agenda-files}), but additional files
-can be included by customizing @code{org-mobile-files}. File names will be
-staged with paths relative to @code{org-directory}, so all files should be
-inside this directory@footnote{Symbolic links in @code{org-directory} need to
-have the same name than their targets.}.
-
-The push operation also creates a special Org file @file{agendas.org} with
-all custom agenda view defined by the user@footnote{While creating the
-agendas, Org mode will force ID properties on all referenced entries, so that
-these entries can be uniquely identified if @i{MobileOrg} flags them for
-further action. If you do not want to get these properties in so many
-entries, you can set the variable @code{org-mobile-force-id-on-agenda-items}
-to @code{nil}. Org mode will then rely on outline paths, in the hope that
-these will be unique enough.}.
-
-Finally, Org writes the file @file{index.org}, containing links to all other
-files. @i{MobileOrg} first reads this file from the server, and then
-downloads all agendas and Org files listed in it. To speed up the download,
-MobileOrg will only read files whose checksums@footnote{Checksums are stored
-automatically in the file @file{checksums.dat}} have changed.
-
-@node Pulling from MobileOrg, , Pushing to MobileOrg, MobileOrg
+Org pushes files listed in @code{org-mobile-files} to
+@code{org-mobile-directory}. Files include agenda files (as listed in
+@code{org-agenda-files}). Customize @code{org-mobile-files} to add other
+files. File names will be staged with paths relative to
+@code{org-directory}, so all files should be inside this
+directory@footnote{Symbolic links in @code{org-directory} should have the
+same name as their targets.}.
+
+Push creates a special Org file @file{agendas.org} with custom agenda views
+defined by the user@footnote{While creating the agendas, Org mode will force
+ID properties on all referenced entries, so that these entries can be
+uniquely identified if MobileOrg flags them for further action. To avoid
+setting properties configure the variable
+@code{org-mobile-force-id-on-agenda-items} to @code{nil}. Org mode will then
+rely on outline paths, assuming they are unique.}.
+
+Org writes the file @file{index.org}, containing links to other files.
+MobileOrg reads this file first from the server to determine what other files
+to download for agendas. For faster downloads, MobileOrg will read only
+those files whose checksums@footnote{Checksums are stored automatically in
+the file @file{checksums.dat}.} have changed.
+
+@node Pulling from MobileOrg
@section Pulling from MobileOrg
-When @i{MobileOrg} synchronizes with the server, it not only pulls the Org
-files for viewing. It also appends captured entries and pointers to flagged
-and changed entries to the file @file{mobileorg.org} on the server. Org has
-a @emph{pull} operation that integrates this information into an inbox file
-and operates on the pointers to flagged entries. Here is how it works:
+When MobileOrg synchronizes with the server, it pulls the Org files for
+viewing. It then appends to the file @file{mobileorg.org} on the server the
+captured entries, pointers to flagged and changed entries. Org integrates
+its data in an inbox file format.
@enumerate
@item
@@ -18092,46 +19261,37 @@ Org moves all entries found in
@file{mobileorg.org}@footnote{@file{mobileorg.org} will be empty after this
operation.} and appends them to the file pointed to by the variable
@code{org-mobile-inbox-for-pull}. Each captured entry and each editing event
-will be a top-level entry in the inbox file.
+is a top-level entry in the inbox file.
@item
-After moving the entries, Org will attempt to implement the changes made in
-@i{MobileOrg}. Some changes are applied directly and without user
-interaction. Examples are all changes to tags, TODO state, headline and body
-text that can be cleanly applied. Entries that have been flagged for further
-action will receive a tag @code{:FLAGGED:}, so that they can be easily found
-again. When there is a problem finding an entry or applying the change, the
-pointer entry will remain in the inbox and will be marked with an error
-message. You need to later resolve these issues by hand.
+After moving the entries, Org attempts changes to MobileOrg. Some changes
+are applied directly and without user interaction. Examples include changes
+to tags, TODO state, headline and body text. Entries for further action are
+tagged as @code{:FLAGGED:}. Org marks entries with problems with an error
+message in the inbox. They have to be resolved manually.
@item
-Org will then generate an agenda view with all flagged entries. The user
-should then go through these entries and do whatever actions are necessary.
-If a note has been stored while flagging an entry in @i{MobileOrg}, that note
-will be displayed in the echo area when the cursor is on the corresponding
-agenda line.
+Org generates an agenda view for flagged entries for user intervention to
+clean up. For notes stored in flagged entries, MobileOrg displays them in
+the echo area when the cursor is on the corresponding agenda item.
@table @kbd
@kindex ?
@item ?
-Pressing @kbd{?} in that special agenda will display the full flagging note in
-another window and also push it onto the kill ring. So you could use @kbd{?
-z C-y C-c C-c} to store that flagging note as a normal note in the entry.
-Pressing @kbd{?} twice in succession will offer to remove the
-@code{:FLAGGED:} tag along with the recorded flagging note (which is stored
-in a property). In this way you indicate that the intended processing for
-this flagged entry is finished.
+Pressing @kbd{?} displays the entire flagged note in another window. Org
+also pushes it to the kill ring. To store flagged note as a normal note, use
+@kbd{? z C-y C-c C-c}. Pressing @kbd{?} twice does these things: first it
+removes the @code{:FLAGGED:} tag; second, it removes the flagged note from
+the property drawer; third, it signals that manual editing of the flagged
+entry is now finished.
@end table
@end enumerate
@kindex C-c a ?
-If you are not able to process all flagged entries directly, you can always
-return to this agenda view@footnote{Note, however, that there is a subtle
-difference. The view created automatically by @kbd{M-x org-mobile-pull RET}
-is guaranteed to search all files that have been addressed by the last pull.
-This might include a file that is not currently in your list of agenda files.
-If you later use @kbd{C-c a ?} to regenerate the view, only the current
-agenda files will be searched.} using @kbd{C-c a ?}.
-
-@node History and Acknowledgments, GNU Free Documentation License, MobileOrg, Top
+@kbd{C-c a ?} returns to the agenda view to finish processing flagged
+entries. Note that these entries may not be the most recent since MobileOrg
+searches files that were last pulled. To get an updated agenda view with
+changes since the last pull, pull again.
+
+@node History and acknowledgments
@appendix History and acknowledgments
@cindex acknowledgments
@cindex history
@@ -18143,17 +19303,17 @@ Org was born in 2003, out of frustration over the user interface of the Emacs
Outline mode. I was trying to organize my notes and projects, and using
Emacs seemed to be the natural way to go. However, having to remember eleven
different commands with two or three keys per command, only to hide and show
-parts of the outline tree, that seemed entirely unacceptable to me. Also,
-when using outlines to take notes, I constantly wanted to restructure the
-tree, organizing it parallel to my thoughts and plans. @emph{Visibility
-cycling} and @emph{structure editing} were originally implemented in the
-package @file{outline-magic.el}, but quickly moved to the more general
-@file{org.el}. As this environment became comfortable for project planning,
-the next step was adding @emph{TODO entries}, basic @emph{timestamps}, and
-@emph{table support}. These areas highlighted the two main goals that Org
-still has today: to be a new, outline-based, plain text mode with innovative
-and intuitive editing features, and to incorporate project planning
-functionality directly into a notes file.
+parts of the outline tree, that seemed entirely unacceptable. Also, when
+using outlines to take notes, I constantly wanted to restructure the tree,
+organizing it paralleling my thoughts and plans. @emph{Visibility cycling}
+and @emph{structure editing} were originally implemented in the package
+@file{outline-magic.el}, but quickly moved to the more general @file{org.el}.
+As this environment became comfortable for project planning, the next step
+was adding @emph{TODO entries}, basic @emph{timestamps}, and @emph{table
+support}. These areas highlighted the two main goals that Org still has
+today: to be a new, outline-based, plain text mode with innovative and
+intuitive editing features, and to incorporate project planning functionality
+directly into a notes file.
Since the first release, literally thousands of emails to me or to
@email{emacs-orgmode@@gnu.org} have provided a constant stream of bug
@@ -18169,15 +19329,17 @@ Before I get to this list, a few special mentions are in order:
@table @i
@item Bastien Guerry
Bastien has written a large number of extensions to Org (most of them
-integrated into the core by now), including the @LaTeX{} exporter and the plain
-list parser. His support during the early days, when he basically acted as
-co-maintainer, was central to the success of this project. Bastien also
-invented Worg, helped establishing the Web presence of Org, and sponsored
-hosting costs for the orgmode.org website.
+integrated into the core by now), including the @LaTeX{} exporter and the
+plain list parser. His support during the early days was central to the
+success of this project. Bastien also invented Worg, helped establishing the
+Web presence of Org, and sponsored hosting costs for the orgmode.org website.
+Bastien stepped in as maintainer of Org between 2011 and 2013, at a time when
+I desperately needed a break.
@item Eric Schulte and Dan Davison
Eric and Dan are jointly responsible for the Org-babel system, which turns
Org into a multi-language environment for evaluating code and doing literate
-programming and reproducible research.
+programming and reproducible research. This has become one of Org's killer
+features that define what Org is today.
@item John Wiegley
John has contributed a number of great ideas and patches directly to Org,
including the attachment system (@file{org-attach.el}), integration with
@@ -18198,9 +19360,8 @@ let me know what I am missing here!
@section From Bastien
-I (Bastien) have been maintaining Org since January 2011. This appendix
-would not be complete without adding a few more acknowledgements and thanks
-to Carsten's ones above.
+I (Bastien) have been maintaining Org between 2011 and 2013. This appendix
+would not be complete without adding a few more acknowledgments and thanks.
I am first grateful to Carsten for his trust while handing me over the
maintainership of Org. His unremitting support is what really helped me
@@ -18218,13 +19379,13 @@ Eric is maintaining the Babel parts of Org. His reactivity here kept me away
from worrying about possible bugs here and let me focus on other parts.
@item Nicolas Goaziou
-Nicolas is maintaining the consistency of the deepest parts of Org. His
-work on @file{org-element.el} and @file{ox.el} has been outstanding, and
-opened the doors for many new ideas and features. He rewrote many of the
-old exporters to use the new export engine, and helped with documenting
-this major change. More importantly (if that's possible), he has been more
-than reliable during all the work done for Org 8.0, and always very
-reactive on the mailing list.
+Nicolas is maintaining the consistency of the deepest parts of Org. His work
+on @file{org-element.el} and @file{ox.el} has been outstanding, and it opened
+the doors for many new ideas and features. He rewrote many of the old
+exporters to use the new export engine, and helped with documenting this
+major change. More importantly (if that's possible), he has been more than
+reliable during all the work done for Org 8.0, and always very reactive on
+the mailing list.
@item Achim Gratz
Achim rewrote the building process of Org, turning some @emph{ad hoc} tools
@@ -18280,13 +19441,14 @@ specified time.
calculations and improved XEmacs compatibility, in particular by porting
@file{nouline.el} to XEmacs.
@item
-@i{Sacha Chua} suggested copying some linking code from Planner.
+@i{Sacha Chua} suggested copying some linking code from Planner, and helped
+make Org popular through her blog.
@item
@i{Toby S. Cubitt} contributed to the code for clock formats.
@item
-@i{Baoqiu Cui} contributed the DocBook exporter. It has been deleted from
-Org 8.0: you can now export to Texinfo and export the @file{.texi} file to
-DocBook using @code{makeinfo}.
+@i{Baoqiu Cui} contributed the first DocBook exporter. In Org 8.0, we go a
+different route: you can now export to Texinfo and export the @file{.texi}
+file to DocBook using @code{makeinfo}.
@item
@i{Eddward DeVilla} proposed and tested checkbox statistics. He also
came up with the idea of properties, and that there should be an API for
@@ -18383,7 +19545,7 @@ basis.
@i{Stefan Monnier} provided a patch to keep the Emacs-Lisp compiler
happy.
@item
-@i{Richard Moreland} wrote @i{MobileOrg} for the iPhone.
+@i{Richard Moreland} wrote MobileOrg for the iPhone.
@item
@i{Rick Moynihan} proposed allowing multiple TODO sequences in a file
and being able to quickly restrict the agenda to a subtree.
@@ -18501,35 +19663,37 @@ work on a tty.
@item
@i{Piotr Zielinski} wrote @file{org-mouse.el}, proposed agenda blocks
and contributed various ideas and code snippets.
+@item
+@i{Marco Wahl} wrote @file{org-eww.el}.
@end itemize
-@node GNU Free Documentation License, Main Index, History and Acknowledgments, Top
+@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
-@node Main Index, Key Index, GNU Free Documentation License, Top
+@node Main Index
@unnumbered Concept index
@printindex cp
-@node Key Index, Command and Function Index, Main Index, Top
+@node Key Index
@unnumbered Key index
@printindex ky
-@node Command and Function Index, Variable Index, Key Index, Top
+@node Command and Function Index
@unnumbered Command and function index
@printindex fn
-@node Variable Index, , Command and Function Index, Top
+@node Variable Index
@unnumbered Variable index
This is not a complete index of variables and faces, only the ones that are
-mentioned in the manual. For a more complete list, use @kbd{M-x
-org-customize @key{RET}} and then click yourself through the tree.
+mentioned in the manual. For a complete list, use @kbd{M-x org-customize
+@key{RET}}.
@printindex vr
diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi
index 4cf38bd1f0e..1e3aeb45fd3 100644
--- a/doc/misc/pcl-cvs.texi
+++ b/doc/misc/pcl-cvs.texi
@@ -1389,7 +1389,7 @@ the @url{http://lists.xemacs.org/mailman/listinfo/xemacs-beta,
XEmacs mailing list}.
If you have problems using PCL-CVS or other questions, send them to
-the @url{http://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
+the @url{https://lists.gnu.org/mailman/listinfo/help-gnu-emacs,
help-gnu-emacs mailing list}. This is a good place to get help, as is
the @url{http://lists.nongnu.org/mailman/listinfo/info-cvs, info-cvs list}.
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index dfe0eccebaf..e7eef9eba24 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -31,8 +31,8 @@ Con@TeX{}t
@include emacsver.texi
@set VERSION @value{EMACSVER}
-@set AUCTEXSITE @uref{http://www.gnu.org/software/auctex/,@AUCTeX{} web site}
-@set MAINTAINERSITE @uref{http://www.gnu.org/software/auctex/reftex.html,@RefTeX{} web page}
+@set AUCTEXSITE @uref{https://www.gnu.org/software/auctex/,@AUCTeX{} web site}
+@set MAINTAINERSITE @uref{https://www.gnu.org/software/auctex/reftex.html,@RefTeX{} web page}
@set MAINTAINERCONTACT @uref{mailto:auctex-devel@@gnu.org,contact the maintainers}
@set MAINTAINER the @AUCTeX{} project
@set SUPPORTADDRESS @AUCTeX{} user mailing list (@email{auctex@@gnu.org})
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index 4e395f7a112..374c72402a5 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -953,7 +953,7 @@ list, you can use @kbd{M-x semanticdb-find-test-translate-path}.
@xref{Semanticdb search debugging commands}.
If items should be loaded but aren't, or if you see some tables that
-have no tags in them, then you you may have an incorrectly-set search
+have no tags in them, then you may have an incorrectly-set search
throttle (@pxref{Search Throttle}). For example,
@example
diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi
index cac874d0f02..5f9a0f59721 100644
--- a/doc/misc/ses.texi
+++ b/doc/misc/ses.texi
@@ -292,7 +292,13 @@ Self-insert an expression. The right-parenthesis is inserted for you
(@code{ses-read-cell}). To access another cell's value, just use its
identifier in your expression. Whenever the other cell is changed,
this cell's formula will be reevaluated. While typing in the
-expression, you can use @kbd{M-@key{TAB}} to complete symbol names.
+expression, you can use the following keys:
+@table @kbd
+@item M-@key{TAB}
+to complete symbol names, and
+@item C-h C-n
+to list the named cells symbols in a help buffer.
+@end table
@item ' @r{(apostrophe)}
Enter a symbol (ses-read-symbol). @acronym{SES} remembers all symbols that have
@@ -458,11 +464,22 @@ Enter the default printer for the spreadsheet
(@code{ses-read-default-printer}).
@end table
-The @code{ses-read-@var{xxx}-printer} commands have their own
-minibuffer history, which is preloaded with the set of all printers
-used in this spreadsheet, plus the standard printers (@pxref{Standard
-printer functions}) and the local printers (@pxref{Local printer
-functions}).
+The @code{ses-read-@var{xxx}-printer} allows the following commands during editing:
+
+@table @kbd
+@item @key{arrow-up}
+@itemx @key{arrow-down}
+To browse history: the @code{ses-read-@var{xxx}-printer} commands have
+their own minibuffer history, which is preloaded with the set of all
+printers used in this spreadsheet, plus the standard printers
+(@pxref{Standard printer functions}) and the local printers
+(@pxref{Local printer functions}).
+@item @key{TAB}
+To complete the local printer symbols, and
+@item C-h C-p
+To list the local printers in a help buffer.
+@end table
+
@node Standard printer functions
@subsection Standard printer functions
@@ -567,7 +584,7 @@ This example will:
When the cell is empty (ie.@: when @code{val} is @code{nil}), print an
empty string @code{""}
@item
-When the cell value is a non negative number, format the the value in
+When the cell value is a non negative number, format the value in
fixed-point notation with one decimal after point
@item
Otherwise, handle the value as erroneous by printing it as an
diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi
index 824945856ac..e45ec0616ff 100644
--- a/doc/misc/smtpmail.texi
+++ b/doc/misc/smtpmail.texi
@@ -290,7 +290,7 @@ and @code{plain} for no encryption.
Use of any form of TLS/SSL requires support in Emacs. You can either
use the built-in support (in Emacs 24.1 and later), or the
@file{starttls.el} Lisp library. The built-in support uses the GnuTLS
-@footnote{@url{http://www.gnu.org/software/gnutls/}} library.
+@footnote{@url{https://www.gnu.org/software/gnutls/}} library.
If your Emacs has GnuTLS support built-in, the function
@code{gnutls-available-p} is defined and returns non-@code{nil}.
Otherwise, you must use the @file{starttls.el} library (see that file for
@@ -300,7 +300,7 @@ requires one of the following external tools to be installed:
@enumerate
@item
The GnuTLS command line tool @samp{gnutls-cli}, which you can get from
-@url{http://www.gnu.org/software/gnutls/}. This is the recommended
+@url{https://www.gnu.org/software/gnutls/}. This is the recommended
tool, mainly because it can verify server certificates.
@item
diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi
index 74904f37e1e..80bf85c3a71 100644
--- a/doc/misc/srecode.texi
+++ b/doc/misc/srecode.texi
@@ -511,7 +511,7 @@ to insert it anywhere in the template search list.
If there are multiple templates with the same context and name, the
template with the highest priority number will be used.
-If multiple files have the same priority, then then sort order is
+If multiple files have the same priority, then the sort order is
unpredictable. If no template names match, then it doesn't matter.
Example:
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index b40a6e2a2be..e2bf51af8c0 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{2017-06-04.19}
+\def\texinfoversion{2017-11-17.06}
%
% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -21,7 +21,7 @@
% General Public License for more details.
%
% You should have received a copy of the GNU General Public License
-% along with this program. If not, see <http://www.gnu.org/licenses/>.
+% along with this program. If not, see <https://www.gnu.org/licenses/>.
%
% As a special exception, when this file is read by TeX when processing
% a Texinfo source document, you may use the result without
@@ -30,9 +30,9 @@
%
% Please try the latest version of texinfo.tex before submitting bug
% reports; you can get the latest version from:
-% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
-% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
-% http://www.gnu.org/software/texinfo/ (the Texinfo home page)
+% https://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
+% https://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
+% https://www.gnu.org/software/texinfo/ (the Texinfo home page)
% The texinfo.tex in any given distribution could well be out
% of date, so if that's what you're using, please check.
%
@@ -56,7 +56,7 @@
% extent. You can get the existing language-specific files from the
% full Texinfo distribution.
%
-% The GNU Texinfo home page is http://www.gnu.org/software/texinfo.
+% The GNU Texinfo home page is https://www.gnu.org/software/texinfo.
\message{Loading texinfo [version \texinfoversion]:}
@@ -5696,10 +5696,13 @@ end
\advance\dimen@ii by 1\dimen@i
\ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line
\ifdim\dimen@ > 0.8\dimen@ii % due to long index text
- \dimen@ = 0.7\dimen@ % Try to split the text roughly evenly
+ % Try to split the text roughly evenly. \dimen@ will be the length of
+ % the first line.
+ \dimen@ = 0.7\dimen@
\dimen@ii = \hsize
\ifnum\dimen@>\dimen@ii
- % If the entry is too long, use the whole line
+ % If the entry is too long (for example, if it needs more than
+ % two lines), use all the space in the first line.
\dimen@ = \dimen@ii
\fi
\advance\leftskip by 0pt plus 1fill % ragged right
@@ -5709,8 +5712,9 @@ end
% instead of using \parshape with explicit line lengths, but TeX
% doesn't seem to provide a way to do such a thing.
%
- \leftskip = 1em
- \parindent = -1em
+ % Indent all lines but the first one.
+ \advance\leftskip by 1em
+ \advance\parindent by -1em
\fi\fi
\indent % start paragraph
\unhbox\boxA
@@ -5965,24 +5969,30 @@ end
% Split the last of the double-column material.
\savemarks
\balancecolumns
- %
+ }%
+ \eject % call the \output just set
+ \ifdim\pagetotal=0pt
% Having called \balancecolumns once, we do not
% want to call it again. Therefore, reset \output to its normal
% definition right away.
\global\output = {\onepageout{\pagecontents\PAGE}}%
- }%
- \eject
- \endgroup % started in \begindoublecolumns
- \restoremarks
- % Leave the double-column material on the current page, no automatic
- % page break.
- \box\balancedcolumns
- %
- % \pagegoal was set to the doubled \vsize above, since we restarted
- % the current page. We're now back to normal single-column
- % typesetting, so reset \pagegoal to the normal \vsize.
- \global\vsize = \txipageheight %
- \pagegoal = \txipageheight %
+ %
+ \endgroup % started in \begindoublecolumns
+ \restoremarks
+ % Leave the double-column material on the current page, no automatic
+ % page break.
+ \box\balancedcolumns
+ %
+ % \pagegoal was set to the doubled \vsize above, since we restarted
+ % the current page. We're now back to normal single-column
+ % typesetting, so reset \pagegoal to the normal \vsize.
+ \global\vsize = \txipageheight %
+ \pagegoal = \txipageheight %
+ \else
+ % We had some left-over material. This might happen when \doublecolumnout
+ % is called in \balancecolumns. Try again.
+ \expandafter\enddoublecolumns
+ \fi
}
\newbox\balancedcolumns
\setbox\balancedcolumns=\vbox{shouldnt see this}%
@@ -5997,6 +6007,7 @@ end
\ifdim\dimen@<5\baselineskip
% Don't split a short final column in two.
\setbox2=\vbox{}%
+ \global\setbox\balancedcolumns=\vbox{\pagesofar}%
\else
\divide\dimen@ by 2 % target to split to
\dimen@ii = \dimen@
@@ -6012,15 +6023,15 @@ end
\repeat
}%
% Now the left column is in box 1, and the right column in box 3.
+ %
% Check whether the left column has come out higher than the page itself.
% (Note that we have doubled \vsize for the double columns, so
% the actual height of the page is 0.5\vsize).
\ifdim2\ht1>\vsize
- % Just split the last of the double column material roughly in half.
- \setbox2=\box0
- \setbox0 = \vsplit2 to \dimen@ii
- \setbox0=\vbox to \dimen@ii {\unvbox0\vfill}%
- \setbox2=\vbox to \dimen@ii {\unvbox2\vfill}%
+ % It appears that we have been called upon to balance too much material.
+ % Output some of it with \doublecolumnout, leaving the rest on the page.
+ \setbox\PAGE=\box0
+ \doublecolumnout
\else
% Compare the heights of the two columns.
\ifdim4\ht1>5\ht3
@@ -6033,10 +6044,10 @@ end
\setbox2=\vbox to\ht1{\unvbox3\unskip}%
\setbox0=\vbox to\ht1{\unvbox1\unskip}%
\fi
+ \global\setbox\balancedcolumns=\vbox{\pagesofar}%
\fi
\fi
%
- \global\setbox\balancedcolumns=\vbox{\pagesofar}%
}
\catcode`\@ = \other
@@ -6943,7 +6954,15 @@ end
% exist, with an empty box. Let's hope all the numbers have the same width.
% Also ignore the page number, which is conventionally not printed.
\def\numeralbox{\setbox0=\hbox{8}\hbox to \wd0{\hfil}}
-\def\partentry#1#2#3#4{\dochapentry{\numeralbox\labelspace#1}{}}
+\def\partentry#1#2#3#4{%
+ % Add stretch and a bonus for breaking the page before the part heading.
+ % This reduces the chance of the page being broken immediately after the
+ % part heading, before a following chapter heading.
+ \vskip 0pt plus 5\baselineskip
+ \penalty-300
+ \vskip 0pt plus -5\baselineskip
+ \dochapentry{\numeralbox\labelspace#1}{}%
+}
%
% Parts, in the short toc.
\def\shortpartentry#1#2#3#4{%
@@ -9434,7 +9453,7 @@ end
\newif\ifwarnednoepsf
\newhelp\noepsfhelp{epsf.tex must be installed for images to
work. It is also included in the Texinfo distribution, or you can get
- it from ftp://tug.org/tex/epsf.tex.}
+ it from https://ctan.org/texarchive/macros/texinfo/texinfo/doc/epsf.tex.}
%
\def\image#1{%
\ifx\epsfbox\thisisundefined
@@ -11009,7 +11028,6 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{2113}{\ensuremath\ell}%
\DeclareUnicodeCharacter{2118}{\ensuremath\wp}%
\DeclareUnicodeCharacter{211C}{\ensuremath\Re}%
- \DeclareUnicodeCharacter{2127}{\ensuremath\mho}%
\DeclareUnicodeCharacter{2135}{\ensuremath\aleph}%
\DeclareUnicodeCharacter{2190}{\ensuremath\leftarrow}%
\DeclareUnicodeCharacter{2191}{\ensuremath\uparrow}%
@@ -11025,7 +11043,6 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{21AA}{\ensuremath\hookrightarrow}%
\DeclareUnicodeCharacter{21BC}{\ensuremath\leftharpoonup}%
\DeclareUnicodeCharacter{21BD}{\ensuremath\leftharpoondown}%
- \DeclareUnicodeCharacter{21BE}{\ensuremath\upharpoonright}%
\DeclareUnicodeCharacter{21C0}{\ensuremath\rightharpoonup}%
\DeclareUnicodeCharacter{21C1}{\ensuremath\rightharpoondown}%
\DeclareUnicodeCharacter{21CC}{\ensuremath\rightleftharpoons}%
@@ -11034,8 +11051,6 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{21D3}{\ensuremath\Downarrow}%
\DeclareUnicodeCharacter{21D4}{\ensuremath\Leftrightarrow}%
\DeclareUnicodeCharacter{21D5}{\ensuremath\Updownarrow}%
- \DeclareUnicodeCharacter{21DD}{\ensuremath\leadsto}%
- \DeclareUnicodeCharacter{2201}{\ensuremath\complement}%
\DeclareUnicodeCharacter{2202}{\ensuremath\partial}%
\DeclareUnicodeCharacter{2205}{\ensuremath\emptyset}%
\DeclareUnicodeCharacter{2207}{\ensuremath\nabla}%
@@ -11069,8 +11084,6 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{2283}{\ensuremath\supset}%
\DeclareUnicodeCharacter{2286}{\ensuremath\subseteq}%
\DeclareUnicodeCharacter{228E}{\ensuremath\uplus}%
- \DeclareUnicodeCharacter{228F}{\ensuremath\sqsubset}%
- \DeclareUnicodeCharacter{2290}{\ensuremath\sqsupset}%
\DeclareUnicodeCharacter{2291}{\ensuremath\sqsubseteq}%
\DeclareUnicodeCharacter{2292}{\ensuremath\sqsupseteq}%
\DeclareUnicodeCharacter{2293}{\ensuremath\sqcap}%
@@ -11085,8 +11098,6 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{22A4}{\ensuremath\ptextop}%
\DeclareUnicodeCharacter{22A5}{\ensuremath\bot}%
\DeclareUnicodeCharacter{22A8}{\ensuremath\models}%
- \DeclareUnicodeCharacter{22B4}{\ensuremath\unlhd}%
- \DeclareUnicodeCharacter{22B5}{\ensuremath\unrhd}%
\DeclareUnicodeCharacter{22C0}{\ensuremath\bigwedge}%
\DeclareUnicodeCharacter{22C1}{\ensuremath\bigvee}%
\DeclareUnicodeCharacter{22C2}{\ensuremath\bigcap}%
@@ -11102,12 +11113,11 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{2322}{\ensuremath\frown}%
\DeclareUnicodeCharacter{2323}{\ensuremath\smile}%
%
- \DeclareUnicodeCharacter{25A1}{\ensuremath\Box}%
\DeclareUnicodeCharacter{25B3}{\ensuremath\triangle}%
\DeclareUnicodeCharacter{25B7}{\ensuremath\triangleright}%
\DeclareUnicodeCharacter{25BD}{\ensuremath\bigtriangledown}%
\DeclareUnicodeCharacter{25C1}{\ensuremath\triangleleft}%
- \DeclareUnicodeCharacter{25C7}{\ensuremath\Diamond}%
+ \DeclareUnicodeCharacter{25C7}{\ensuremath\diamond}%
\DeclareUnicodeCharacter{2660}{\ensuremath\spadesuit}%
\DeclareUnicodeCharacter{2661}{\ensuremath\heartsuit}%
\DeclareUnicodeCharacter{2662}{\ensuremath\diamondsuit}%
@@ -11129,7 +11139,6 @@ directory should work if nowhere else does.}
\DeclareUnicodeCharacter{2A02}{\ensuremath\bigotimes}%
\DeclareUnicodeCharacter{2A04}{\ensuremath\biguplus}%
\DeclareUnicodeCharacter{2A06}{\ensuremath\bigsqcup}%
- \DeclareUnicodeCharacter{2A1D}{\ensuremath\Join}%
\DeclareUnicodeCharacter{2A3F}{\ensuremath\amalg}%
\DeclareUnicodeCharacter{2AAF}{\ensuremath\preceq}%
\DeclareUnicodeCharacter{2AB0}{\ensuremath\succeq}%
@@ -11423,9 +11432,11 @@ directory should work if nowhere else does.}
%
\dimen0 = #1\relax
\advance\dimen0 by \voffset
+ \advance\dimen0 by 1in % reference point for DVI is 1 inch from top of page
%
\dimen2 = \hsize
\advance\dimen2 by \normaloffset
+ \advance\dimen2 by 1in % reference point is 1 inch from left edge of page
%
\internalpagesizes{#1}{\hsize}%
{\voffset}{\normaloffset}%
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index a42dc6ed3c0..e7d9cb15dee 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -43,7 +43,7 @@ copy and modify this GNU manual.''
@c Entries for @command{install-info} to use
@dircategory Emacs network features
@direntry
-* TRAMP: (tramp). Transparent Remote Access, Multiple Protocol
+* @value{tramp}: (tramp). Transparent Remote Access, Multiple Protocol
Emacs remote file access via ssh and scp.
@end direntry
@@ -72,21 +72,21 @@ local and the remote host, whereas @value{tramp} uses a combination of
@command{ssh}/@command{scp}.
You can find the latest version of this document on the web at
-@uref{http://www.gnu.org/software/tramp/}.
+@uref{https://www.gnu.org/software/tramp/}.
@ifhtml
The latest release of @value{tramp} is available for
-@uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see
-@ref{Obtaining Tramp} for more details, including the Git server
-details.
+@uref{https://ftp.gnu.org/gnu/tramp/, download}, or you may see
+@ref{Obtaining @value{tramp}} for more details, including the Git
+server details.
-@value{tramp} also has a @uref{http://savannah.gnu.org/projects/tramp/,
+@value{tramp} also has a @uref{https://savannah.gnu.org/projects/tramp/,
Savannah Project Page}.
@end ifhtml
There is a mailing list for @value{tramp}, available at
@email{tramp-devel@@gnu.org}, and archived at
-@uref{http://lists.gnu.org/archive/html/tramp-devel/, the
+@uref{https://lists.gnu.org/r/tramp-devel/, the
@value{tramp} Mail Archive}.
@page
@@ -97,11 +97,12 @@ There is a mailing list for @value{tramp}, available at
For the end user:
-* Obtaining Tramp:: How to obtain @value{tramp}.
+* Obtaining @value{tramp}:: How to obtain @value{tramp}.
* History:: History of @value{tramp}.
@ifset installchapter
* Installation:: Installing @value{tramp} with your Emacs.
@end ifset
+* Quick Start Guide:: Short introduction how to use @value{tramp}.
* Configuration:: Configuring @value{tramp} for use.
* Usage:: An overview of the operation of @value{tramp}.
* Bug Reports:: Reporting Bugs and Problems.
@@ -185,14 +186,14 @@ transparency extends to editing, version control, and @code{dired}.
@value{tramp} can access remote hosts using any number of access
methods, such as @command{rsh}, @command{rlogin}, @command{telnet},
and related programs. If these programs can successfully pass
-@acronym{ASCII]} characters, @value{tramp} can use them.
+@acronym{ASCII} characters, @value{tramp} can use them.
@value{tramp} does not require or mandate 8-bit clean connections.
@value{tramp}'s most common access method is through @command{ssh}, a
more secure alternative to @command{ftp} and other older access
methods.
-@value{tramp} on Windows operating systems is integrated with the
+@value{tramp} on MS Windows operating systems is integrated with the
PuTTY package, and uses the @command{plink} program.
@value{tramp} mostly operates transparently in the background using
@@ -207,7 +208,7 @@ benefit of direct integration of @value{tramp} in Emacs.
@value{tramp} can transfer files using any number of available host
programs for remote files, such as @command{rcp}, @command{scp},
-@command{rsync} or (under Windows) @command{pscp}. @value{tramp}
+@command{rsync} or (under MS Windows) @command{pscp}. @value{tramp}
provides easy ways to specify these programs and customize them to
specific files, hosts, or access methods.
@@ -314,14 +315,14 @@ behind the scenes when you open a file with @value{tramp}.
@c For the end user
-@node Obtaining Tramp
+@node Obtaining @value{tramp}
@chapter Obtaining @value{tramp}
-@cindex obtaining Tramp
+@cindex obtaining @value{tramp}
@value{tramp} is included as part of Emacs (since Emacs version 22.1).
@value{tramp} is also freely packaged for download on the Internet at
-@uref{ftp://ftp.gnu.org/gnu/tramp/}.
+@uref{https://ftp.gnu.org/gnu/tramp/}.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features.
@@ -331,15 +332,15 @@ page at the following URL and then clicking on the Git link in the
navigation bar at the top.
@noindent
-@uref{http://savannah.gnu.org/projects/tramp/}
+@uref{https://savannah.gnu.org/projects/tramp/}
@noindent
Another way is to follow the terminal session below:
@example
@group
-] @strong{cd ~/emacs}
-] @strong{git clone git://git.savannah.gnu.org/tramp.git}
+$ cd ~/emacs
+$ git clone git://git.savannah.gnu.org/tramp.git
@end group
@end example
@@ -348,16 +349,16 @@ From behind a firewall:
@example
@group
-] @strong{git config --global http.proxy http://user:pwd@@proxy.server.com:8080}
-] @strong{git clone http://git.savannah.gnu.org/r/tramp.git}
+$ git config --global http.proxy http://user:pwd@@proxy.server.com:8080
+$ git clone https://git.savannah.gnu.org/r/tramp.git
@end group
@end example
@noindent
-Tramp developers:
+@value{tramp} developers:
@example
-] @strong{git clone login@@git.sv.gnu.org:/srv/git/tramp.git}
+$ git clone login@@git.sv.gnu.org:/srv/git/tramp.git
@end example
@noindent
@@ -369,8 +370,8 @@ To fetch updates from the repository, use git pull:
@example
@group
-] @strong{cd ~/emacs/tramp}
-] @strong{git pull}
+$ cd ~/emacs/tramp
+$ git pull
@end group
@end example
@@ -380,8 +381,8 @@ Run @command{autoconf} as follows to generate an up-to-date
@example
@group
-] @strong{cd ~/emacs/tramp}
-] @strong{autoconf}
+$ cd ~/emacs/tramp
+$ autoconf
@end group
@end example
@@ -403,7 +404,7 @@ July 2002, @value{tramp} unified file names with Ange FTP@. In July
2004, proxy hosts replaced multi-hop methods. Running commands on
remote hosts was introduced in December 2005. Support for gateways
since April 2007 (and removed in December 2016). GVFS integration
-started in February 2009. Remote commands on Windows hosts since
+started in February 2009. Remote commands on MS Windows hosts since
September 2011. Ad-hoc multi-hop methods (with a changed syntax)
re-enabled in November 2011. In November 2012, added Juergen
Hoetzel's @file{tramp-adb.el}.
@@ -418,6 +419,147 @@ XEmacs support was stopped in January 2016. Since March 2017,
@end ifset
+@node Quick Start Guide
+@chapter Short introduction how to use @value{tramp}
+@cindex quick start guide
+
+@value{tramp} extends the Emacs file name syntax by a remote
+component. A remote file name looks always like
+@file{@trampfn{method,user@@host,/path/to/file}}.
+
+You can use remote files exactly like ordinary files, that means you
+could open a file or directory by @kbd{C-x C-f
+@trampfn{method,user@@host,/path/to/file} @key{RET}}, edit the file,
+and save it. You can also mix local files and remote files in file
+operations with two arguments, like @code{copy-file} or
+@code{rename-file}. And finally, you can run even processes on a
+remote host, when the buffer you call the process from has a remote
+@code{default-directory}.
+
+
+@anchor{Quick Start Guide: File name syntax}
+@section File name syntax
+@cindex file name syntax
+
+Remote file names are prepended by the @code{method}, @code{user} and
+@code{host} parts. All of them, and also the local file name part,
+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}.
+
+The @code{method} part describes the connection method used to reach
+the remote host, see below.
+
+The @code{user} part is the user name for accessing the remote host.
+For the @option{smb} method, this could also require a domain name, in
+this case it is written as @code{user%domain}.
+
+The @code{host} part must be a host name which could be resolved on
+your local host. It could be a short host name, a fully qualified
+domain name, an IPv4 or IPv6 address, @ref{File name syntax}. Some
+connection methods support also a notation of the port to be used, in
+this case it is written as @code{host#port}.
+
+
+@anchor{Quick Start Guide: @option{ssh} and @option{plink} methods}
+@section Using @option{ssh} and @option{plink}
+@cindex method ssh
+@cindex ssh method
+@cindex method plink
+@cindex plink method
+
+If your local host runs an SSH client, and the remote host runs an SSH
+server, the most simple remote file name is
+@file{@trampfn{ssh,user@@host,/path/to/file}}. The remote file name
+@file{@trampfn{ssh,,}} opens a remote connection to yourself on the
+local host, and is taken often for testing @value{tramp}.
+
+On MS Windows, PuTTY is often used as SSH client. Its @command{plink}
+method can be used there to open a connection to a remote host running
+an @command{ssh} server:
+@file{@trampfn{plink,user@@host,/path/to/file}}.
+
+
+@anchor{Quick Start Guide: @option{su}, @option{sudo} and @option{sg} methods}
+@section Using @option{su}, @option{sudo} and @option{sg}
+@cindex method su
+@cindex su method
+@cindex method sudo
+@cindex sudo method
+@cindex method sg
+@cindex sg method
+
+Sometimes, it is necessary to work on your local host under different
+permissions. For this, you could use the @option{su} or @option{sudo}
+connection method. Both methods use @samp{root} as default user name
+and the return value of @code{(system-name)} as default host name.
+Therefore, it is convenient to open a file as
+@file{@trampfn{sudo,,/path/to/file}}.
+
+The method @option{sg} stands for ``switch group''; the changed group
+must be used here as user name. The default host name is the same.
+
+
+@anchor{Quick Start Guide: @option{smb} method}
+@section Using @command{smbclient}
+@cindex method smb
+@cindex smb method
+@cindex ms windows (with smb method)
+@cindex smbclient
+
+In order to access a remote MS Windows host or Samba server, the
+@command{smbclient} client is used. The remote file name syntax is
+@file{@trampfn{smb,user%domain@@host,/path/to/file}}. The first part
+of the local file name is the share exported by the remote host,
+@samp{path} in this example.
+
+
+@anchor{Quick Start Guide: GVFS-based methods}
+@section Using GVFS-based methods
+@cindex methods, gvfs
+@cindex gvfs based methods
+@cindex method sftp
+@cindex sftp method
+@cindex method afp
+@cindex afp method
+@cindex method dav
+@cindex method davs
+@cindex dav method
+@cindex davs method
+
+On systems, which have installed the virtual file system for the Gnome
+Desktop (GVFS), its offered methods could be used by @value{tramp}.
+Examples 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}} and
+@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares).
+
+
+@anchor{Quick Start Guide: Google Drive}
+@section Using Google Drive
+@cindex method gdrive
+@cindex gdrive method
+@cindex google drive
+
+Another GVFS-based method allows to access a Google Drive file system.
+The file name syntax is here always
+@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}.
+@samp{john.doe@@gmail.com} stands here for your Google Drive account.
+
+
+@anchor{Quick Start Guide: Android}
+@section Using Android
+@cindex method adb
+@cindex adb method
+@cindex android
+
+An Android device, which is connected via USB to your local host, can
+be accessed via the @command{adb} command. No user or host name is
+needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}.
+
+
@node Configuration
@chapter Configuring @value{tramp}
@cindex configuration
@@ -439,10 +581,7 @@ not auto loaded by Emacs. All examples require @value{tramp} is
installed and loaded:
@lisp
-@group
-(custom-set-variables
- '(tramp-verbose 6 nil (tramp) "Enable remote command traces"))
-@end group
+(customize-set-variable 'tramp-verbose 6 "Enable remote command traces")
@end lisp
@@ -610,16 +749,16 @@ continue connecting?''. @value{tramp} cannot handle such questions.
Connections will have to be setup where logins can proceed without
such questions.
-@option{sshx} is useful for Windows users when @command{ssh} triggers
-an error about allocating a pseudo tty. This happens due to missing
-shell prompts that confuses @value{tramp}.
+@option{sshx} is useful for MS Windows users when @command{ssh}
+triggers an error about allocating a pseudo tty. This happens due to
+missing shell prompts that confuses @value{tramp}.
@option{sshx} supports the @samp{-p} argument.
@item @option{krlogin}
@cindex method krlogin
@cindex krlogin method
-@cindex Kerberos (with krlogin method)
+@cindex kerberos (with krlogin method)
This method is also similar to @option{ssh}. It uses the
@command{krlogin -x} command only for remote host login.
@@ -627,7 +766,7 @@ This method is also similar to @option{ssh}. It uses the
@item @option{ksu}
@cindex method ksu
@cindex ksu method
-@cindex Kerberos (with ksu method)
+@cindex kerberos (with ksu method)
This is another method from the Kerberos suite. It behaves like @option{su}.
@@ -635,7 +774,7 @@ This is another method from the Kerberos suite. It behaves like @option{su}.
@cindex method plink
@cindex plink method
-@option{plink} method is for Windows users with the PuTTY
+@option{plink} method is for MS Windows users with the PuTTY
implementation of SSH@. It uses @samp{plink -ssh} to log in to the
remote host.
@@ -648,9 +787,9 @@ session.
@cindex method plinkx
@cindex plinkx method
-Another method using PuTTY on Windows with session names instead of
-host names. @option{plinkx} calls @samp{plink -load @var{session} -t}.
-User names and port numbers must be defined in the session.
+Another method using PuTTY on MS Windows with session names instead of
+host names. @option{plinkx} calls @samp{plink -load @var{session}
+-t}. User names and port numbers must be defined in the session.
Check the @samp{Share SSH connections if possible} control for that
session.
@@ -730,9 +869,9 @@ This method supports the @samp{-p} argument.
in performance to @option{scp}. @option{scpx} uses @samp{ssh -t -t
@var{host} -l @var{user} /bin/sh} to open a connection.
-@option{scpx} is useful for Windows users when @command{ssh} triggers
-an error about allocating a pseudo tty. This happens due to missing
-shell prompts that confuses @value{tramp}.
+@option{scpx} is useful for MS Windows users when @command{ssh}
+triggers an error about allocating a pseudo tty. This happens due to
+missing shell prompts that confuses @value{tramp}.
This method supports the @samp{-p} argument.
@@ -742,17 +881,17 @@ This method supports the @samp{-p} argument.
@cindex pscp method
@cindex pscp (with pscp method)
@cindex plink (with pscp method)
-@cindex PuTTY (with pscp method)
+@cindex putty (with pscp method)
@cindex method psftp
@cindex psftp method
@cindex pscp (with psftp method)
@cindex plink (with psftp method)
-@cindex PuTTY (with psftp method)
+@cindex putty (with psftp method)
These methods are similar to @option{scp} or @option{sftp}, but they
use the @command{plink} command to connect to the remote host, and
they use @command{pscp} or @command{psftp} for transferring the files.
-These programs are part of PuTTY, an SSH implementation for Windows.
+These programs are part of PuTTY, an SSH implementation for MS Windows.
Check the @samp{Share SSH connections if possible} control for that
session.
@@ -805,6 +944,8 @@ capable of servicing requests from @value{tramp}.
@item @option{smb}
@cindex method smb
@cindex smb method
+@cindex ms windows (with smb method)
+@cindex smbclient
This non-native @value{tramp} method connects via the Server Message
Block (SMB) networking protocol to hosts running file servers that are
@@ -831,15 +972,16 @@ handling}.
To accommodate user name/domain name syntax required by MS Windows
authorization, @value{tramp} provides for an extended syntax in
-@code{user%domain} format (where user is user name, @code{%} is the
-percent symbol, and domain is the windows domain name). An example:
+@code{user%domain} format (where @code{user} is the user name,
+@code{%} is the percent symbol, and @code{domain} is the MS Windows
+domain name). An example:
@example
@trampfn{smb,daniel%BIZARRE@@melancholia,/daniel$$/.emacs}
@end example
where user @code{daniel} connects as a domain user to the SMB host
-@code{melancholia} in the windows domain @code{BIZARRE} to edit
+@code{melancholia} in the MS Windows domain @code{BIZARRE} to edit
@file{.emacs} located in the home directory (share @code{daniel$}).
Alternatively, for local WINS users (as opposed to domain users),
@@ -876,6 +1018,7 @@ can.
@item @option{adb}
@cindex method adb
@cindex adb method
+@cindex android (with adb method)
This method uses Android Debug Bridge program for accessing Android
devices. The Android Debug Bridge must be installed locally for
@@ -917,7 +1060,7 @@ numbers are not applicable to Android devices connected through USB@.
@cindex dbus
GVFS is the virtual file system for the Gnome Desktop,
-@uref{http://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are
+@uref{https://en.wikipedia.org/wiki/GVFS}. Remote files on GVFS are
mounted locally through FUSE and @value{tramp} uses this locally
mounted directory internally.
@@ -949,7 +1092,7 @@ but with SSL encryption. Both methods support the port numbers.
@item @option{gdrive}
@cindex method gdrive
@cindex gdrive method
-@cindex Google Drive
+@cindex google drive
Via the @option{gdrive} method it is possible to access your Google
Drive online storage. User and host name of the remote file name are
@@ -981,8 +1124,8 @@ that for security reasons refuse @command{ssh} connections.
@cindex method synce
@cindex synce method
-@option{synce} method allows connecting to Windows Mobile devices. It
-uses GVFS for mounting remote files and directories via FUSE and
+@option{synce} method allows connecting to MS Windows Mobile devices.
+It uses GVFS for mounting remote files and directories via FUSE and
requires the SYNCE-GVFS plugin.
@end table
@@ -1009,7 +1152,7 @@ option to determine the default method for remote file names that do
not have one specified.
@lisp
-(custom-set-variables '(tramp-default-method "ssh" nil (tramp)))
+(customize-set-variable 'tramp-default-method "ssh")
@end lisp
@end defopt
@@ -1070,7 +1213,7 @@ access and it has the most reasonable security protocols, use
@end example
If @option{ssh} is unavailable for whatever reason, look for other
-obvious options. For Windows, try the @option{plink} method. For
+obvious options. For MS Windows, try the @option{plink} method. For
Kerberos, try @option{krlogin}.
For editing local files as @option{su} or @option{sudo} methods, try
@@ -1096,7 +1239,7 @@ this substitution can be overridden with @option{tramp-default-user}.
For example:
@lisp
-(custom-set-variables'(tramp-default-user "root" nil (tramp)))
+(customize-set-variable 'tramp-default-user "root")
@end lisp
@end defopt
@@ -1152,9 +1295,9 @@ follows:
@lisp
@group
(custom-set-variables
- '(tramp-default-method "ssh" nil (tramp))
- '(tramp-default-user "john" nil (tramp))
- '(tramp-default-host "target" nil (tramp)))
+ '(tramp-default-method "ssh")
+ '(tramp-default-user "john")
+ '(tramp-default-host "target"))
@end group
@end lisp
@@ -1289,8 +1432,8 @@ restricted shell:
@node Firewalls
@section Passing firewalls
-@cindex HTTP tunnel
-@cindex proxy hosts, HTTP tunnel
+@cindex http tunnel
+@cindex proxy hosts, http tunnel
Sometimes, it is not possible to reach a remote host directly. A
firewall might be in the way, which could be passed via a proxy
@@ -1549,18 +1692,6 @@ new one on next Emacs startup.
Set @option{tramp-persistency-file-name} to @code{nil} to disable
storing connections persistently.
-To reuse connection information from the persistent list,
-@value{tramp} needs to uniquely identify every host. However in some
-cases, two different connections may result in the same persistent
-information. For example, connecting to a host using @command{ssh} and
-connecting to the same host through @code{sshd} on port 3001. Both
-access methods result in nearly identical persistent specifications
-@file{@trampfn{ssh,localhost,}} and @file{@trampfn{ssh,localhost#3001,}}.
-
-Changing host names could avoid duplicates. One way is to add a
-@option{Host} section in @file{~/.ssh/config} (@pxref{Frequently Asked
-Questions}). Another way is to apply multiple hops (@pxref{Multi-hops}).
-
When @value{tramp} detects a change in the operating system version in
a remote host (via the command @command{uname -sr}), it flushes all
connection related information for that host and creates a new entry.
@@ -1724,21 +1855,20 @@ example below:
@lisp
@group
-(custom-set-variables
- '(tramp-password-prompt-regexp
- (concat
- "^.*"
- (regexp-opt
- '("passphrase" "Passphrase"
- ;; English
- "password" "Password"
- ;; Deutsch
- "passwort" "Passwort"
- ;; Français
- "mot de passe" "Mot de passe")
- t)
- ".*:\0? *")
- nil (tramp)))
+(customize-set-variable
+ 'tramp-password-prompt-regexp
+ (concat
+ "^.*"
+ (regexp-opt
+ '("passphrase" "Passphrase"
+ ;; English
+ "password" "Password"
+ ;; Deutsch
+ "passwort" "Passwort"
+ ;; Français
+ "mot de passe" "Mot de passe")
+ t)
+ ".*:\0? *"))
@end group
@end lisp
@@ -1746,8 +1876,8 @@ Similar localization may be necessary for handling wrong password
prompts, for which @value{tramp} uses @option{tramp-wrong-passwd-regexp}.
@item @command{tset} and other questions
-@cindex Unix command tset
-@cindex tset Unix command
+@cindex unix command tset
+@cindex tset unix command
@vindex tramp-terminal-type
To suppress inappropriate prompts for terminal type, @value{tramp}
@@ -1847,7 +1977,7 @@ Then re-set the prompt string in @file{~/.emacs_SHELLNAME} as follows:
@example
@group
-# Reset the prompt for remote Tramp shells.
+# Reset the prompt for remote @value{tramp} shells.
if [ "$@{INSIDE_EMACS/*tramp*/tramp@}" == "tramp" ] ; then
PS1="[\u@@\h \w]$ "
fi
@@ -1859,14 +1989,14 @@ fi
@end ifinfo
@item @command{busybox} / @command{nc}
-@cindex Unix command nc
-@cindex nc Unix command
+@cindex unix command nc
+@cindex nc unix command
@value{tramp}'s @option{nc} method uses the @command{nc} command to
install and execute a listener as follows (see @code{tramp-methods}):
@example
-# nc -l -p 42
+$ nc -l -p 42
@end example
The above command-line syntax has changed with @command{busybox}
@@ -1891,17 +2021,21 @@ where @samp{192.168.0.1} is the remote host IP address
@node Android shell setup
@section Android shell setup hints
-@cindex android shell setup
+@cindex android shell setup for ssh
@value{tramp} uses the @option{adb} method to access Android devices.
Android devices provide a restricted shell access through an USB
connection. The local host must have the @command{adb} program
-installed.
+installed. Usually, it is sufficient to open the file
+@file{@trampfn{adb,,/}}. Then you can navigate in the filesystem via
+@code{dired}.
-Applications such as @code{SSHDroid} that run @command{sshd} process
-on the Android device can accept any @option{ssh}-based methods
-provided these settings are adjusted:
+Alternatively, applications such as @code{SSHDroid} that run
+@command{sshd} process on the Android device can accept any
+@option{ssh}-based methods provided these settings are adjusted:
+@itemize
+@item
@command{sh} must be specified for remote shell since Android devices
do not provide @command{/bin/sh}. @command{sh} will then invoke
whatever shell is installed on the device with this setting:
@@ -1917,6 +2051,7 @@ whatever shell is installed on the device with this setting:
where @samp{192.168.0.26} is the Android device's IP address.
(@pxref{Predefined connection information}).
+@item
@value{tramp} requires preserving @env{PATH} environment variable from
user settings. Android devices prefer @file{/system/xbin} path over
@file{/system/bin}. Both of these are set as follows:
@@ -1928,7 +2063,7 @@ user settings. Android devices prefer @file{/system/xbin} path over
@end group
@end lisp
-@noindent
+@item
When the Android device is not @samp{rooted}, specify a writable
directory for temporary files:
@@ -1936,7 +2071,7 @@ directory for temporary files:
(add-to-list 'tramp-remote-process-environment "TMPDIR=$HOME")
@end lisp
-@noindent
+@item
Open a remote connection with the command @kbd{C-x C-f
@trampfn{ssh,192.168.0.26#2222,}}, where @command{sshd} is listening
on port @samp{2222}.
@@ -1967,6 +2102,7 @@ the previous example, fix the connection properties as follows:
@noindent
Open a remote connection with a more concise command @kbd{C-x C-f
@trampfn{ssh,android,}}.
+@end itemize
@node Auto-save and Backup
@@ -2035,8 +2171,8 @@ Example:
@group
(add-to-list 'backup-directory-alist
(cons "." "~/.emacs.d/backups/"))
-(custom-set-variables
- '(tramp-backup-directory-alist backup-directory-alist 6 nil (tramp)))
+(customize-set-variable
+ 'tramp-backup-directory-alist backup-directory-alist)
@end group
@end lisp
@@ -2066,12 +2202,12 @@ to direct all auto saves to that location.
@node Windows setup hints
@section Issues with Cygwin ssh
-@cindex Cygwin, issues
+@cindex cygwin, issues
This section is incomplete. Please share your solutions.
-@cindex method sshx with Cygwin
-@cindex sshx method with Cygwin
+@cindex method sshx with cygwin
+@cindex sshx method with cygwin
Cygwin's @command{ssh} works only with a Cygwin version of Emacs. To
check for compatibility: type @kbd{M-x eshell}, and start @kbd{ssh
@@ -2083,36 +2219,36 @@ Pseudo-terminal will not be allocated because stdin is not a terminal.
Some older versions of Cygwin's @command{ssh} work with the
@option{sshx} access method. Consult Cygwin's FAQ at
-@uref{http://cygwin.com/faq/} for details.
+@uref{https://cygwin.com/faq/} for details.
-@cindex Cygwin and fakecygpty
-@cindex fakecygpty and Cygwin
+@cindex cygwin and fakecygpty
+@cindex fakecygpty and cygwin
On @uref{https://www.emacswiki.org/emacs/SshWithNTEmacs, the Emacs
Wiki} it is explained how to use the helper program @code{fakecygpty}
to fix this problem.
-@cindex method scpx with Cygwin
-@cindex scpx method with Cygwin
+@cindex method scpx with cygwin
+@cindex scpx method with cygwin
When using the @option{scpx} access method, Emacs may call
-@command{scp} with Windows file naming, such as @code{c:/foo}. But
+@command{scp} with MS Windows file naming, such as @code{c:/foo}. But
the version of @command{scp} that is installed with Cygwin does not
-know about Windows file naming, which causes it to incorrectly look
+know about MS Windows file naming, which causes it to incorrectly look
for a host named @code{c}.
A workaround: write a wrapper script for @option{scp} to convert
Windows file names to Cygwin file names.
-@cindex Cygwin and ssh-agent
-@cindex SSH_AUTH_SOCK and Emacs on Windows
+@cindex cygwin and ssh-agent
+@cindex SSH_AUTH_SOCK and emacs on ms windows
-When using the @command{ssh-agent} on Windows for password-less
+When using the @command{ssh-agent} on MS Windows for password-less
interaction, @option{ssh} methods depend on the environment variable
@env{SSH_AUTH_SOCK}. But this variable is not set when Emacs is
started from a Desktop shortcut and authentication fails.
-One workaround is to use a Windows based SSH Agent, such as
+One workaround is to use an MS Windows based SSH Agent, such as
Pageant. It is part of the Putty Suite of tools.
The fallback is to start Emacs from a shell.
@@ -2409,7 +2545,7 @@ For ad-hoc definitions to be saved automatically in
@option{tramp-save-ad-hoc-proxies} to non-@code{nil}.
@lisp
-(custom-set-variables '(tramp-save-ad-hoc-proxies t nil (tramp)))
+(customize-set-variable 'tramp-save-ad-hoc-proxies t)
@end lisp
@end defopt
@@ -2710,11 +2846,11 @@ Arguments of the program to be debugged must be literal, can take
relative or absolute paths, but not remote paths.
-@subsection Running remote processes on Windows hosts
+@subsection Running remote processes on MS Windows hosts
@cindex winexe
@cindex powershell
-@command{winexe} runs processes on a remote Windows host, and
+@command{winexe} runs processes on a remote MS Windows host, and
@value{tramp} can use it for @code{process-file} and
@code{start-file-process}.
@@ -2724,7 +2860,7 @@ processes triggered from @value{tramp}.
@option{explicit-shell-file-name} and @option{explicit-*-args} have to
be set properly so @kbd{M-x shell} can open a proper remote shell on a
-Windows host. To open @command{cmd}, set it as follows:
+MS Windows host. To open @command{cmd}, set it as follows:
@lisp
@group
@@ -2797,7 +2933,7 @@ this address go to all the subscribers. This is @emph{not} the
address to send subscription requests to.
To subscribe to the mailing list, visit:
-@uref{http://lists.gnu.org/mailman/listinfo/tramp-devel/, the
+@uref{https://lists.gnu.org/mailman/listinfo/tramp-devel/, the
@value{tramp} Mail Subscription Page}.
@ifset installchapter
@@ -2849,13 +2985,13 @@ Where is the latest @value{tramp}?
@value{tramp} is available at the GNU URL:
@noindent
-@uref{ftp://ftp.gnu.org/gnu/tramp/}
+@uref{https://ftp.gnu.org/gnu/tramp/}
@noindent
@value{tramp}'s GNU project page is located here:
@noindent
-@uref{http://savannah.gnu.org/projects/tramp/}
+@uref{https://savannah.gnu.org/projects/tramp/}
@item
@@ -2903,6 +3039,14 @@ Disable version control to avoid delays:
@end group
@end lisp
+If this is too radical, because you want to use version control
+remotely, trim @code{vc-handled-backends} to just those you care
+about, for example:
+
+@lisp
+(setq vc-handled-backends '(SVN Git))
+@end lisp
+
Disable excessive traces. Set @code{tramp-verbose} to 3 or lower,
default being 3. Increase trace levels temporarily when hunting for
bugs.
@@ -3041,10 +3185,11 @@ which allows you to set the @code{ControlPath} provided the variable
@lisp
@group
-(setq tramp-ssh-controlmaster-options
- (concat
- "-o ControlPath=/tmp/ssh-ControlPath-%%r@@%%h:%%p "
- "-o ControlMaster=auto -o ControlPersist=yes"))
+(customize-set-variable
+ 'tramp-ssh-controlmaster-options
+ (concat
+ "-o ControlPath=/tmp/ssh-ControlPath-%%r@@%%h:%%p "
+ "-o ControlMaster=auto -o ControlPersist=yes"))
@end group
@end lisp
@@ -3057,10 +3202,7 @@ behavior, then any changes to @command{ssh} can be suppressed with
this @code{nil} setting:
@lisp
-@group
-(custom-set-variables
- '(tramp-use-ssh-controlmaster-options nil nil (tramp)))
-@end group
+(customize-set-variable 'tramp-use-ssh-controlmaster-options nil)
@end lisp
@@ -3216,8 +3358,8 @@ You can define default methods and user names for hosts,
@lisp
@group
(custom-set-variables
- '(tramp-default-method "ssh" nil (tramp))
- '(tramp-default-user "news" nil (tramp)))
+ '(tramp-default-method "ssh")
+ '(tramp-default-user "news"))
@end group
@end lisp
@@ -3277,7 +3419,7 @@ Redefine another key sequence in Emacs for @kbd{C-x C-f}:
(interactive)
(find-file
(read-file-name
- "Find Tramp file: "
+ "Find @value{tramp} file: "
"@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}"))))
@end group
@end lisp
@@ -3347,7 +3489,7 @@ The minibuffer expands for further editing.
@item Use bookmarks:
-Use bookmarks to save Tramp file names.
+Use bookmarks to save @value{tramp} file names.
@ifinfo
@pxref{Bookmarks, , , emacs}.
@end ifinfo
@@ -3511,7 +3653,7 @@ disable such features.
Disable @value{tramp} file name completion:
@lisp
-(custom-set-variables '(ido-enable-tramp-completion nil))
+(customize-set-variable 'ido-enable-tramp-completion nil)
@end lisp
@item
@@ -3534,15 +3676,16 @@ To keep Ange FTP as default the remote files access package, set this
in @file{.emacs}:
@lisp
-(custom-set-variables '(tramp-default-method "ftp" nil (tramp)))
+(customize-set-variable 'tramp-default-method "ftp")
@end lisp
@item
To disable both @value{tramp} (and Ange FTP), set @code{tramp-mode} to
-@code{nil} in @file{.emacs}.
+@code{nil} in @file{.emacs}. @strong{Note}, that we don't use
+@code{customize-set-variable}, in order to avoid loading @value{tramp}.
@lisp
-(custom-set-variables '(tramp-mode nil nil (tramp)))
+(setq tramp-mode nil)
@end lisp
@item
@@ -3685,6 +3828,10 @@ both the error and the signal have to be set as follows:
@end group
@end lisp
+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.
+
To enable stepping through @value{tramp} function call traces, they
have to be specifically enabled as shown in this code:
@@ -3730,4 +3877,3 @@ strings from being written to @file{*trace-output*}.
@c * Explain how tramp.el works in principle: open a shell on a remote
@c host and then send commands to it.
@c * Consistent small or capitalized words especially in menus.
-@c * Make a unique declaration of @trampfn.
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index f1cb60b9d25..5d9dcc5635d 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
@c In the Tramp GIT, the version number is auto-frobbed from
@c configure.ac, so you should edit that file and run
@c "autoconf && ./configure" to change the version number.
-@set trampver 2.3.2-pre
+@set trampver 2.3.3-pre
@c Other flags from configuration
@set instprefix /usr/local
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index a3c625edce1..075d0f6fed1 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -112,11 +112,11 @@ technically obsolete despite its widespread vernacular usage.)
meaning. For example, the URI
@example
-http://www.gnu.org/software/emacs/
+https://www.gnu.org/software/emacs/
@end example
@noindent
-specifies the scheme component @samp{http}, the hostname component
+specifies the scheme component @samp{https}, the hostname component
@samp{www.gnu.org}, and the path component @samp{/software/emacs/}.
@cindex parsed URIs
@@ -401,7 +401,7 @@ gateway method to be used. @xref{Gateways in general}.
@defopt url-honor-refresh-requests
If this option is non-@code{nil} (the default), the @code{url} library
honors the HTTP @samp{Refresh} header, which is used by servers to
-direct clients to reload documents from the same URL or a or different
+direct clients to reload documents from the same URL or a different
one. If the value is @code{nil}, the @samp{Refresh} header is
ignored; any other value means to ask the user on each request.
@end defopt
diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi
index 95cc0d1b80d..fa12f9c35aa 100644
--- a/doc/misc/woman.texi
+++ b/doc/misc/woman.texi
@@ -939,7 +939,7 @@ is
Any environment variables (names of which must have the Unix-style form
@code{$NAME}, e.g., @code{$HOME}, @code{$EMACSDATA}, @code{$EMACS_DIR},
regardless of platform) are evaluated first but each element must
-evaluate to a @emph{single} directory name. Trailing @file{/}s are
+evaluate to a @emph{single} name of a directory. Trailing @file{/}s are
ignored. (Specific directories in @code{woman-path} are also searched.)
On Microsoft platforms I recommend including drive letters explicitly,
@@ -989,7 +989,7 @@ and on other platforms is @code{nil}.
Any environment variables (names of which must have the Unix-style form
@code{$NAME}, e.g., @code{$HOME}, @code{$EMACSDATA}, @code{$EMACS_DIR},
regardless of platform) are evaluated first but each element must
-evaluate to a @emph{single} directory name (regexp, see above). For
+evaluate to a @emph{single} name of a directory (regexp, see above). For
example
@lisp
@@ -1290,7 +1290,7 @@ inelegantly, then please
@enumerate
@item
try the latest version of @file{woman.el} from the Emacs repository
-on @uref{http://savannah.gnu.org/projects/emacs/}. If it still fails, please
+on @uref{https://savannah.gnu.org/projects/emacs/}. If it still fails, please
@item
use @kbd{M-x report-emacs-bug} to send a bug report.
diff --git a/etc/CALC-NEWS b/etc/CALC-NEWS
index 844b9767342..95189398b0d 100644
--- a/etc/CALC-NEWS
+++ b/etc/CALC-NEWS
@@ -1167,7 +1167,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/CENSORSHIP b/etc/CENSORSHIP
index a276331c576..cd779e4915c 100644
--- a/etc/CENSORSHIP
+++ b/etc/CENSORSHIP
@@ -5,4 +5,4 @@ Note added March 2014:
This file is obsolete and will be removed in future.
Please update any references to use
-<http://www.gnu.org/philosophy/censoring-emacs.html>
+<https://www.gnu.org/philosophy/censoring-emacs.html>
diff --git a/etc/COPYING b/etc/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/etc/COPYING
+++ b/etc/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/etc/ChangeLog.1 b/etc/ChangeLog.1
index e502c6539d1..05b782f7994 100644
--- a/etc/ChangeLog.1
+++ b/etc/ChangeLog.1
@@ -195,7 +195,7 @@
Fix minor Bazaar leftovers.
Reported by Perry E. Metzger in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00745.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg00745.html
* CONTRIBUTE: More git transition.
2014-11-11 Eric S. Raymond <esr@thyrsus.com>
@@ -1695,7 +1695,7 @@
Redo spelling of Makefile variables to conform to POSIX.
POSIX does not allow "-" in Makefile variable names.
Reported by Bruno Haible in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00990.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00990.html>.
* refcards/Makefile (DIRED_REFCARDS_PDF): Rename from
DIRED-REFCARDS_PDF.
(MISC_REFCARDS_PDF): Rename from MISC-REFCARDS_PDF.
@@ -4762,7 +4762,7 @@
2005-07-07 Lute Kamstra <lute@gnu.org>
* tasks.texi: Delete file. The GNU Task List is obsolete and has
- been replaced by http://savannah.gnu.org/projects/tasklist.
+ been replaced by https://savannah.gnu.org/projects/tasklist.
2005-07-07 Lute Kamstra <lute@gnu.org>
@@ -6906,4 +6906,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/DEBUG b/etc/DEBUG
index 3719c3e6f66..f5efbe0ff9a 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -622,6 +622,15 @@ Setting a breakpoint in the function 'x_error_quitter' and looking at
the backtrace when Emacs stops inside that function will show what
code causes the X protocol errors.
+Note that the -xrm option may have no effect when you make an Emacs
+process invoked with the -nw option a server and want to trace X
+protocol errors from subsequent invocations of emacsclient in a GUI
+frame. In that case calling the initial Emacs via
+
+emacs -nw --eval '(setq x-command-line-resources "emacs.synchronous: true")'
+
+should give more reliable results.
+
Some bugs related to the X protocol disappear when Emacs runs in a
synchronous mode. To track down those bugs, we suggest the following
procedure:
@@ -668,7 +677,7 @@ procedure:
** If Emacs causes errors or memory leaks in your X server
You can trace the traffic between Emacs and your X server with a tool
-like xmon, available at ftp://ftp.x.org/contrib/devel_tools/.
+like xmon.
Xmon can be used to see exactly what Emacs sends when X protocol errors
happen. If Emacs causes the X server memory usage to increase you can
@@ -942,7 +951,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/DISTRIB b/etc/DISTRIB
index 7e3a3517f19..d7d01dbd1ab 100644
--- a/etc/DISTRIB
+++ b/etc/DISTRIB
@@ -26,9 +26,9 @@ are designed to make sure that everyone who has a copy of GNU Emacs
change it.
For information on how to get GNU software, see
-http://www.gnu.org/software/software.html. Printed copies of GNU
+https://www.gnu.org/software/software.html. Printed copies of GNU
manuals, including the Emacs manual, are available from the FSF's
-online store at http://shop.fsf.org.
+online store at https://shop.fsf.org.
Emacs has been run on GNU/Linux, FreeBSD, NetBSD, OpenBSD, and on many
Unix systems, on a variety of types of CPU, as well as on MS-DOS,
@@ -41,7 +41,7 @@ License for full details, in the file 'COPYING' in this directory (see
above)), and neither I nor the Free Software Foundation promises any
kind of support or assistance to users. The foundation keeps a list
of people who are willing to offer support and assistance for hire.
-See http://www.gnu.org/help/gethelp.html.
+See https://www.gnu.org/help/gethelp.html.
However, we plan to continue to improve GNU Emacs and keep it
reliable, so please send us any complaints and suggestions you have.
@@ -93,4 +93,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index b140e44630d..cee32816f63 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -313,8 +313,8 @@ This makes it easier to find modules by name.
appear in the version of ERC that is bundled with Emacs 22. These
extras files may be found at:
- o http://ftp.gnu.org/gnu/erc/erc-5.2-extras.tar.gz, or
- o http://ftp.gnu.org/gnu/erc/erc-5.2-extras.zip.
+ o https://ftp.gnu.org/gnu/erc/erc-5.2-extras.tar.gz, or
+ o https://ftp.gnu.org/gnu/erc/erc-5.2-extras.zip.
** Renamed files
@@ -1343,4 +1343,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/ETAGS.EBNF b/etc/ETAGS.EBNF
index fc20b9f8584..5928cea3bad 100644
--- a/etc/ETAGS.EBNF
+++ b/etc/ETAGS.EBNF
@@ -109,4 +109,4 @@ COPYING PERMISSIONS:
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/ETAGS.README b/etc/ETAGS.README
index f14a102057c..62965a4c517 100644
--- a/etc/ETAGS.README
+++ b/etc/ETAGS.README
@@ -44,4 +44,4 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>.
+along with this program. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/FTP b/etc/FTP
index 2fcfa22c55c..ebd2695da17 100644
--- a/etc/FTP
+++ b/etc/FTP
@@ -1,8 +1,8 @@
For information about how to download GNU Emacs, please see:
-<http://www.gnu.org/software/emacs/>
+<https://www.gnu.org/software/emacs/>
For general GNU software downloading, please see
-<http://www.gnu.org/order/ftp.html>
+<https://www.gnu.org/order/ftp.html>
Note added January 2014:
This file is obsolete and will be removed in future.
diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS
index 546686b8e64..0196e61d98c 100644
--- a/etc/GNUS-NEWS
+++ b/etc/GNUS-NEWS
@@ -102,7 +102,7 @@ are not reused when you select another article. *Note Sticky Articles::.
** International host names (IDNA) can now be decoded inside article bodies
using 'W i' ('gnus-summary-idna-message'). This requires that GNU Libidn
-(<http://www.gnu.org/software/libidn/>) has been installed.
+(<https://www.gnu.org/software/libidn/>) has been installed.
** The non-ASCII group names handling has been much improved. The back ends
that fully support non-ASCII group names are now 'nntp', 'nnml', and
@@ -307,7 +307,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/HELLO b/etc/HELLO
index f5339f224d9..ceaff7e3fc7 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -90,7 +90,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Local Variables:
;;; tab-width: 32
diff --git a/etc/HISTORY b/etc/HISTORY
index ad38b3262d2..095e6cb9142 100644
--- a/etc/HISTORY
+++ b/etc/HISTORY
@@ -3,7 +3,7 @@
For more details about release contents, see the NEWS* files.
Most of the development history of GNU Emacs is available in its
-source code repository <http://savannah.gnu.org/git/?group=emacs>.
+source code repository <https://savannah.gnu.org/git/?group=emacs>.
However, in the early days GNU Emacs was developed without using
version control systems and was published via half-inch 9-track
1600-bpi magnetic tape reels. Although information about this early
@@ -211,6 +211,8 @@ GNU Emacs 25.1 (2016-09-16) emacs-25.1
GNU Emacs 25.2 (2017-04-20) emacs-25.2
+GNU Emacs 25.3 (2017-09-11) emacs-25.3
+
----------------------------------------------------------------------
This file is part of GNU Emacs.
@@ -226,4 +228,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/LINUX-GNU b/etc/LINUX-GNU
index 9e1c1a513a1..0f45e15ac1d 100644
--- a/etc/LINUX-GNU
+++ b/etc/LINUX-GNU
@@ -5,4 +5,4 @@ Note added March 2014:
This file is obsolete and will be removed in future.
Please update any references to use
-<http://www.gnu.org/gnu/linux-and-gnu.html>
+<https://www.gnu.org/gnu/linux-and-gnu.html>
diff --git a/etc/MACHINES b/etc/MACHINES
index 95073e0da57..49befca3fca 100644
--- a/etc/MACHINES
+++ b/etc/MACHINES
@@ -40,7 +40,7 @@ the list at the end of this file.
these systems relate to the GNU project, because that will help
spread the GNU idea that software should be free--and thus encourage
people to write more free software. For more information, see
- <http://www.gnu.org/gnu/linux-and-gnu.html>.
+ <https://www.gnu.org/gnu/linux-and-gnu.html>.
*** 64-bit GNU/Linux
@@ -127,4 +127,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS
index 6e1f4db1edf..6b1b66e80cb 100644
--- a/etc/MH-E-NEWS
+++ b/etc/MH-E-NEWS
@@ -380,7 +380,7 @@ gatewayed at gmane.org (closes SF #979308).
If you want to see the release notes for the alpha and beta releases
leading up this release, please see:
- http://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup
+ https://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup
@@ -2363,7 +2363,7 @@ new customization variables `mh-show-use-xface-flag' and `mh-x-face-file'
(closes SF #480770).
MH-E depends on the external x-face package found in
-ftp://ftp.jpl.org/pub/elisp/ to do this. The `uncompface' binary is
+http://www.jpl.org/pub/elisp/ to do this. The `uncompface' binary is
also required to be in the execute PATH. It can be obtained from:
http://freshmeat.net/redir/compface/1439/url_tgz/compface-1.4.tar.gz.
@@ -3394,7 +3394,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS b/etc/NEWS
index 6bf124cfce1..abc79af0ffc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1,16 +1,16 @@
GNU Emacs NEWS -- history of user-visible changes.
-Copyright (C) 2014-2017 Free Software Foundation, Inc.
+Copyright (C) 2017 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
If possible, use M-x report-emacs-bug.
-This file is about changes in Emacs version 26.
+This file is about changes in Emacs version 27.
See file HISTORY for a list of GNU Emacs versions and release dates.
-See files NEWS.25, NEWS.24, NEWS.23, NEWS.22, NEWS.21, NEWS.20,
-NEWS.19, NEWS.18, and NEWS.1-17 for changes in older Emacs versions.
+See files NEWS.26, NEWS.25, ..., NEWS.18, and NEWS.1-17 for changes
+in older Emacs versions.
You can narrow news to a specific version by calling 'view-emacs-news'
with a prefix argument or by typing C-u C-h C-n.
@@ -22,451 +22,30 @@ Temporary note:
When you add a new item, use the appropriate mark if you are sure it applies,
-* Installation Changes in Emacs 26.1
-
-** By default libgnutls is now required when building Emacs.
-Use 'configure --with-gnutls=no' to build even when GnuTLS is missing.
-
-** GnuTLS version 2.12.2 or later is now required, instead of merely
-version 2.6.6 or later.
-
-** The new option 'configure --with-mailutils' causes Emacs to rely on
-GNU Mailutils 'movemail' to retrieve email. By default, the Emacs
-build procedure continues to build and install a limited and insecure
-'movemail' substitute. Although --with-mailutils is recommended, it
-is not yet the default due to backward-compatibility concerns.
-
-** The new option 'configure --enable-gcc-warnings=warn-only' causes
-GCC to issue warnings without stopping the build. This behavior is
-now the default in developer builds. As before, use
-'--disable-gcc-warnings' to suppress GCC's warnings, and
-'--enable-gcc-warnings' to stop the build if GCC issues warnings.
-
-** When GCC warnings are enabled, '--enable-check-lisp-object-type' is
-now enabled by default when configuring.
-
-+++
-** The Emacs server now has socket-launching support. This allows
-socket based activation, where an external process like systemd can
-invoke the Emacs server process upon a socket connection event and
-hand the socket over to Emacs. Emacs uses this socket to service
-emacsclient commands. This new functionality can be disabled with the
-configure option '--disable-libsystemd'.
-
-+++
-** A systemd user unit file is provided. Use it in the standard way:
-systemctl --user enable emacs
-(If your Emacs is installed in a non-standard location, you may
-need to copy the emacs.service file to eg ~/.config/systemd/user/)
-
-** New configure option '--disable-build-details' attempts to build an
-Emacs that is more likely to be reproducible; that is, if you build
-and install Emacs twice, the second Emacs is a copy of the first.
-Deterministic builds omit the build date from the output of the
-emacs-version and erc-cmd-SV functions, and the leave the following
-variables nil: emacs-build-system, emacs-build-time,
-erc-emacs-build-time.
-
-** The configure option '--with-gameuser' now defaults to 'no',
-as this appears to be the most common configuration in practice.
-When it is 'no', the shared game directory and the auxiliary program
-update-game-score are no longer needed and are not installed.
-
-** Emacs no longer works on IRIX. We expect that Emacs users are not
-affected by this, as SGI stopped supporting IRIX in December 2013.
+* Installation Changes in Emacs 27.1
-* Startup Changes in Emacs 26.1
-
-+++
-** New option '--fg-daemon'. This is the same as '--daemon', except
-it runs in the foreground and does not fork. This is intended for
-modern init systems such as systemd, which manage many of the traditional
-aspects of daemon behavior themselves. '--bg-daemon' is now an alias
-for '--daemon'.
-
-** New option '--module-assertions'. If the user supplies this
-option, Emacs will perform expensive correctness checks when dealing
-with dynamic modules. This is intended for module authors that wish
-to verify that their module conforms to the module requirements. The
-option makes Emacs abort if a module-related assertion triggers.
-
-+++
-** Emacs now supports 24-bit colors on capable text terminals
-Terminal is automatically initialized to use 24-bit colors if the
-required capabilities are found in terminfo. See the FAQ node
-"Colors on a TTY" for more information.
+* Startup Changes in Emacs 27.1
-* Changes in Emacs 26.1
-
-** The variable 'emacs-version' no longer includes the build number.
-This is now stored separately in a new variable, 'emacs-build-number'.
-
-+++
-** The new function 'mapbacktrace' applies a function to all frames of
-the current stack trace.
-
-+++
-** Emacs now provides a limited form of concurrency with Lisp threads.
-Concurrency in Emacs Lisp is "mostly cooperative", meaning that
-Emacs will only switch execution between threads at well-defined
-times: when Emacs waits for input, during blocking operations related
-to threads (such as mutex locking), or when the current thread
-explicitly yields. Global variables are shared among all threads, but
-a 'let' binding is thread-local. Each thread also has its own current
-buffer and its own match data.
-
-See the chapter "Threads" in the ELisp manual for full documentation
-of these facilities.
-
-+++
-** The new function 'file-name-case-insensitive-p' tests whether a
-given file is on a case-insensitive filesystem.
-
-+++
-** The new user variable 'electric-quote-chars' provides a list
-of curved quotes for 'electric-quote-mode', allowing user to choose
-the types of quotes to be used.
-
-+++
-** The new user variable 'dired-omit-case-fold' allows the user to
-customize the case-sensitivity of dired-omit-mode. It defaults to
-the same sensitivity as that of the filesystem for the corresponding
-dired buffer.
-
-+++
-** Emacs now uses double buffering to reduce flicker when editing and
-resizing graphical Emacs frames on the X Window System. This support
-requires the DOUBLE-BUFFER extension, which major X servers have
-supported for many years. If your system has this extension, but an
-Emacs built with double buffering misbehaves on some displays you use,
-you can disable the feature by adding
-
- '(inhibit-double-buffering . t)
-
-to default-frame-alist. Or inject this parameter into the selected
-frame by evaluating this form:
-
- (modify-frame-parameters nil '((inhibit-double-buffering . t)))
-
----
-The group 'wp', whose label was "text", is now deprecated.
-Use the new group 'text', which inherits from 'wp', instead.
-
-+++
-** The new function 'call-shell-region' executes a command in an
-inferior shell with the buffer region as input.
-
-+++
-** The new user option 'shell-command-dont-erase-buffer' controls
-if the output buffer is erased between shell commands; if non-nil,
-the output buffer is not erased; this variable also controls where
-to set the point in the output buffer: beginning of the output,
-end of the buffer or save the point.
-When 'shell-command-dont-erase-buffer' is nil, the default value,
-the behavior of 'shell-command', 'shell-command-on-region' and
-'async-shell-command' is as usual.
-
-+++
-** The new user option 'mouse-select-region-move-to-beginning'
-controls the position of point when double-clicking mouse-1 on the end
-of a parenthetical grouping or string-delimiter: the default value nil
-keeps point at the end of the region, setting it to non-nil moves
-point to the beginning of the region.
-
-+++
-** The new user option 'mouse-drag-and-drop-region' allows to drag the
-entire region of text to another place or another buffer.
-
-+++
-** The new user option 'confirm-kill-processes' allows the user to
-skip a confirmation prompt for killing subprocesses when exiting
-Emacs. When set to t (the default), Emacs will prompt for
-confirmation before killing subprocesses on exit, which is the same
-behavior as before.
-
----
-** 'find-library-name' will now fall back on looking at 'load-history'
-to try to locate libraries that have been loaded with an explicit path
-outside 'load-path'.
-
-+++
-** Faces in 'minibuffer-prompt-properties' no longer overwrite properties
-in the text in functions like 'read-from-minibuffer', but instead are
-added to the end of the face list. This allows users to say things
-like '(read-from-minibuffer (propertize "Enter something: " 'face 'bold))'.
-
-+++
-** The new variable 'extended-command-suggest-shorter' has been added
-to control whether to suggest shorter 'M-x' commands or not.
-
----
-** icomplete now respects 'completion-ignored-extensions'.
-
-+++
-** Non-breaking hyphens are now displayed with the 'nobreak-hyphen'
-face instead of the 'escape-glyph' face.
-
-+++
-** Approximations to quotes are now displayed with the new 'homoglyph'
-face instead of the 'escape-glyph' face.
-
----
-** 'C-x h' ('mark-whole-buffer') will now avoid marking the prompt
-part of minibuffers.
-
----
-** 'find-library' now takes a prefix argument to pop to a different
-window.
-
----
-** 'process-attributes' on Darwin systems now returns more information.
-
-+++
-** Several accessors for the value returned by 'file-attributes'
-have been added. They are: 'file-attribute-type',
-'file-attribute-link-number', 'file-attribute-user-id',
-'file-attribute-group-id', 'file-attribute-access-time',
-'file-attribute-modification-time',
-'file-attribute-status-change-time', 'file-attribute-size',
-'file-attribute-modes', 'file-attribute-inode-number',
-'file-attribute-device-number' and 'file-attribute-collect'.
-
-+++
-** The new function 'buffer-hash' computes a fast, non-consing hash of
-a buffer's contents.
-
----
-** 'fill-paragraph' no longer marks the buffer as changed unless it
-actually changed something.
-
----
-** The locale language name 'ca' is now mapped to the language
-environment 'Catalan', which has been added.
+* Changes in Emacs 27.1
---
-** 'align-regexp' has a separate history for its interactive argument.
-'align-regexp' no longer shares its history with all other
-history-less functions that use 'read-string'.
-
-+++
-** The networking code has been reworked so that it's more
-asynchronous than it was (when specifying :nowait t in
-'make-network-process'). How asynchronous it is varies based on the
-capabilities of the system, but on a typical GNU/Linux system the DNS
-resolution, the connection, and (for TLS streams) the TLS negotiation
-are all done without blocking the main Emacs thread. To get
-asynchronous TLS, the TLS boot parameters have to be passed in (see
-the manual for details).
-
-Certain process oriented functions (like 'process-datagram-address')
-will block until socket setup has been performed. The recommended way
-to deal with asynchronous sockets is to avoid interacting with them
-until they have changed status to "run". This is most easily done
-from a process sentinel.
-
-** 'make-network-process' and 'open-network-stream' sometimes allowed
-:service to be an integer string (e.g., :service "993") and sometimes
-required an integer (e.g., :service 993). This difference has been
-eliminated, and integer strings work everywhere.
-
-** It is possible to disable attempted recovery on fatal signals.
-
-Two new variables support disabling attempts to recover from stack
-overflow and to avoid automatic auto-save when Emacs is delivered a
-fatal signal. 'attempt-stack-overflow-recovery', if set to 'nil',
-will disable attempts to recover from C stack overflows; Emacs will
-then crash as with any other fatal signal.
-'attempt-orderly-shutdown-on-fatal-signal', if set to 'nil', will
-disable attempts to auto-save the session and shut down in an orderly
-fashion when Emacs receives a fatal signal; instead, Emacs will
-terminate immediately. Both variables are non-'nil' by default.
-These variables are for users who would like to avoid the small
-probability of data corruption due to techniques Emacs uses to recover
-in these situations.
+** The new option 'tooltip-resize-echo-area' avoids truncating tooltip text
+on GUI frames when tooltips are displayed in the echo area. Instead,
+it resizes the echo area as needed to accommodate the full tool-tip
+text.
+++
-** File local and directory local variables are now initialized each
-time the major mode is set, not just when the file is first visited.
-These local variables will thus not vanish on setting a major mode.
+** New function 'logcount' calculates an integer's Hamming weight.
+++
-** A second dir-local file (.dir-locals-2.el) is now accepted.
-See the variable 'dir-locals-file-2' for more information.
-
-+++
-** Connection-local variables can be used to specify local variables
-with a value depending on the connected remote server. For details,
-see the node "Connection Local Variables" in the ELisp manual.
-
----
-** International domain names (IDNA) are now encoded via the new
-puny.el library, so that one can visit web sites with non-ASCII URLs.
-
-+++
-** The new 'timer-list' command lists all active timers in a buffer,
-where you can cancel them with the 'c' command.
-
-+++
-** The new function 'read-multiple-choice' prompts for multiple-choice
-questions, with a handy way to display help texts.
-
-+++
-** 'switch-to-buffer-preserve-window-point' now defaults to t.
-
-+++
-** The new variable 'debugger-stack-frame-as-list' allows displaying
-all call stack frames in a Lisp backtrace buffer as lists. Both
-debug.el and edebug.el have been updated to heed to this variable.
-
-+++
-** The new variable 'x-ctrl-keysym' has been added to the existing
-roster of X keysyms. It can be used in combination with another
-variable of this kind to swap modifiers in Emacs.
-
----
-** New input methods: 'cyrillic-tuvan', 'polish-prefix'.
-
-+++
-** File name quoting by adding the prefix "/:" is now possible for the
-local part of a remote file name. Thus, if you have a directory named
-"/~" on the remote host "foo", you can prevent it from being
-substituted by a home directory by writing it as "/foo:/:/~/file".
-
-+++
-** The new variable 'maximum-scroll-margin' allows having effective
-settings of 'scroll-margin' up to half the window size, instead of
-always restricting the margin to a quarter of the window.
-
-+++
-** Emacs can scroll horizontally using mouse, touchpad, and trackbar.
-You can enable this by customizing 'mwheel-tilt-scroll-p'. If you
-want to reverse the direction of the scroll, customize
-'mwheel-flip-direction'.
-
-+++
-** Emacsclient has a new option -u/--suppress-output. The option
-suppresses display of return values from the server process.
-
----
-** New user option 'dig-program-options' and extended functionality
-for DNS-querying functions 'nslookup-host', 'dns-lookup-host',
-and 'run-dig'. Each function now accepts an optional name server
-argument interactively (with a prefix argument) and non-interactively.
-
-+++
-** Emacsclient has a new option -T/--tramp.
-This helps with using a local Emacs session as the server for a remote
-emacsclient. With appropriate setup, one can now set the EDITOR
-environment variable on a remote machine to emacsclient, and
-use the local Emacs to edit remote files via Tramp. See the node
-"emacsclient Options" in the user manual for the details.
-
-+++
-** The new variable 'eval-expression-print-maximum-character' prevents
-large integers from being displayed as characters.
-
-** Two new commands for finding the source code of Emacs Lisp
-libraries: 'find-library-other-window' and 'find-library-other-frame'.
-
-+++
-** The new variable 'display-raw-bytes-as-hex' allows to change the
-display of raw bytes from octal to hex.
-
-** You can now provide explicit field numbers in format specifiers.
-For example, '(format "%2$s %1$s" "X" "Y")' produces "Y X".
-
-
-* Editing Changes in Emacs 26.1
-
-+++
-** New variable 'column-number-indicator-zero-based'.
-Traditionally, in Column Number mode, the displayed column number
-counts from zero starting at the left margin of the window. This
-behavior is now controlled by 'column-number-indicator-zero-based'.
-If you would prefer for the displayed column number to count from one,
-you may set this variable to nil. (Behind the scenes, there is now a
-new mode line construct, '%C', which operates exactly as '%c' does
-except that it counts from one.)
-
-+++
-** New single-line horizontal scrolling mode.
-The 'auto-hscroll-mode' variable can now have a new special value,
-'current-line', which causes only the line where the cursor is
-displayed to be horizontally scrolled when lines are truncated on
-display and point moves outside the left or right window margin.
-
-+++
-** New mode line constructs '%o' and '%q', and user option
-'mode-line-percent-position'. '%o' displays the "degree of travel" of
-the window through the buffer. Unlike the default '%p', this
-percentage approaches 100% as the window approaches the end of the
-buffer. '%q' displays the percentage offsets of both the start and
-the end of the window, e.g. "5-17%". The new option
-'mode-line-percent-position' makes it easier to switch between '%p',
-'%P', and these new constructs.
-
-+++
-** Two new user options 'list-matching-lines-jump-to-current-line' and
-'list-matching-lines-current-line-face' to show highlighted the current
-line in *Occur* buffer.
-
-+++
-** The 'occur' command can now operate on the region.
-
-+++
-** New bindings for 'query-replace-map'.
-'undo', undo the last replacement; bound to 'u'.
-'undo-all', undo all replacements; bound to 'U'.
-
-** 'delete-trailing-whitespace' deletes whitespace after form feed.
-In modes where form feed was treated as a whitespace character,
-'delete-trailing-whitespace' would keep lines containing it unchanged.
-It now deletes whitespace after the last form feed thus behaving the
-same as in modes where the character is not whitespace.
-
-** No more prompt about changed file when the file's content is unchanged.
-Instead of only checking the modification time, Emacs now also checks
-the file's actual content before prompting the user.
-
-** Various casing improvements.
-
-*** 'upcase', 'upcase-region' et al. convert title case characters
-(such as Dz) into their upper case form (such as DZ).
-
-*** 'capitalize', 'upcase-initials' et al. make use of title-case forms
-of initial characters (correctly producing for example Džungla instead
-of incorrect DŽungla).
-
-*** Characters which turn into multiple ones when cased are correctly handled.
-For example, fi ligature is converted to FI when upper cased.
-
-*** Greek small sigma is correctly handled when at the end of the word.
-Strings such as ΌΣΟΣ are now correctly converted to Όσος when
-capitalized instead of incorrect Όσοσ (compare lowercase sigma at the
-end of the word).
-
-** Emacs can now auto-save buffers to visited files in a more robust
-manner via the new mode 'auto-save-visited-mode'. Unlike
-'auto-save-visited-file-name', this mode uses the normal saving
-procedure and therefore obeys saving hooks.
-'auto-save-visited-file-name' is now obsolete.
-
-+++
-** New behavior of 'mark-defun' implemented
-Prefix argument selects that many (or that many more) defuns.
-Negative prefix arg flips the direction of selection. Also,
-'mark-defun' between defuns correctly selects N following defuns (or
--N previous for negative arguments). Finally, comments preceding the
-defun are selected unless they are separated from the defun by a blank
-line.
-
-** New command 'replace-buffer-contents'.
-This command replaces the contents of the accessible portion of the
-current buffer with the contents of the accessible portion of a
-different buffer while keeping point, mark, markers, and text
-properties as intact as possible.
+** New function 'libxml-available-p'.
+This function returns non-nil if libxml support is both compiled in
+and available at run time. Lisp programs should use this function to
+detect built-in libxml support, instead of testing for that
+indirectly, e.g., by checking that functions like
+'libxml-parse-html-region' return nil.
+++
** New function 'fill-polish-nobreak-p', to be used in 'fill-nobreak-predicate'.
@@ -474,900 +53,115 @@ It blocks line breaking after a one-letter word, also in the case when
this word is preceded by a non-space, but non-alphanumeric character.
-* Changes in Specialized Modes and Packages in Emacs 26.1
-
-*** smerge-refine-regions can refine regions in separate buffers
-
-*** Info menu and index completion uses substring completion by default.
-This can be customized via the info-menu category in
-completion-category-override.
-
-+++
-*** The ancestor buffer is shown by default in 3way merges.
-A new option ediff-show-ancestor and a new toggle
-ediff-toggle-show-ancestor.
-
-** TeX: Add luatex and xetex as alternatives to pdftex
-
-** Electric-Buffer-menu
-
-+++
-*** Key 'U' is bound to 'Buffer-menu-unmark-all' and key 'M-DEL' is
-bound to 'Buffer-menu-unmark-all-buffers'.
-
-** bs
+* Editing Changes in Emacs 27.1
---
-*** Two new commands 'bs-unmark-all', bound to 'U', and
-'bs-unmark-previous', bound to <backspace>.
-
-** Buffer-menu
+** New variable 'x-wait-for-event-timeout'.
+This controls how long Emacs will wait for updates to the graphical
+state to take effect (making a frame visible, for example).
+++
-*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and
-'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'.
+** The new user option 'electric-quote-replace-double' controls
+whether '"' is also replaced in 'electric-quote-mode'. If non-nil,
+'"' is replaced by a double typographic quote.
-** Gnus
+
+* Changes in Specialized Modes and Packages in Emacs 27.1
----
-*** The .newsrc file will now only be saved if the native select
-method is an NNTP select method.
+** Dired
+++
-*** A new command for sorting articles by readedness marks has been
-added: 'C-c C-s C-m C-m'.
+*** The new user option 'dired-create-destination-dirs' controls whether
+'dired-do-copy' and 'dired-rename-file' should create non-existent
+directories in the destination.
** Ibuffer
---
-*** New command 'ibuffer-jump'.
-
----
-*** New filter commands 'ibuffer-filter-by-basename',
-'ibuffer-filter-by-file-extension', 'ibuffer-filter-by-directory',
-'ibuffer-filter-by-starred-name', 'ibuffer-filter-by-modified'
-and 'ibuffer-filter-by-visiting-file'; bound respectively
-to '/b', '/.', '//', '/*', '/i' and '/v'.
-
----
-*** Two new commands 'ibuffer-filter-chosen-by-completion'
-and 'ibuffer-and-filter', the second bound to '/&'.
-
----
-*** The commands 'ibuffer-pop-filter', 'ibuffer-pop-filter-group',
-'ibuffer-or-filter' and 'ibuffer-filter-disable' have the alternative
-bindings '/<up>', '/S-<up>', '/|' and '/DEL', respectively.
-
----
-*** The data format specifying filters has been extended to allow
-explicit logical 'and', and a more flexible form for logical 'not'.
-See 'ibuffer-filtering-qualifiers' doc string for full details.
-
----
-*** A new command 'ibuffer-copy-buffername-as-kill'; bound
-to 'B'.
-
----
-*** New command 'ibuffer-change-marks'; bound to '* c'.
-
----
-*** A new command 'ibuffer-mark-by-locked' to mark
-all locked buffers; bound to '% L'.
-
----
-*** A new option 'ibuffer-locked-char' to indicate
-locked buffers; Ibuffer shows a new column displaying
-'ibuffer-locked-char' for locked buffers.
-
----
-*** A new command 'ibuffer-unmark-all-marks' to unmark
-all buffers without asking confirmation; bound to
-'U'; 'ibuffer-do-replace-regexp' bound to 'r'.
-
----
-*** A new command 'ibuffer-mark-by-content-regexp' to mark buffers
-whose content matches a regexp; bound to '% g'.
-
----
-*** Two new options 'ibuffer-never-search-content-name' and
-'ibuffer-never-search-content-mode' used by
-'ibuffer-mark-by-content-regexp'.
-
-** Browse-URL
-
-*** Support for opening links to man pages in Man or WoMan mode.
-
-** Comint
-
----
-*** New user option 'comint-move-point-for-matching-input' to control
-where to place point after C-c M-r and C-c M-s.
-
-** Compilation mode
-
----
-*** Messages from CMake are now recognized.
-
-+++
-*** A new option 'dired-always-read-filesystem' default to nil.
-If non-nil, buffers visiting files are reverted before search them;
-for instance, in 'dired-mark-files-containing-regexp' a non-nil value
-of this option means the file is revisited in a temporary buffer;
-this temporary buffer is the actual buffer searched: the original buffer
-visiting the file is not modified.
-
-+++
-*** In wdired, when editing files to contain slash characters,
-the resulting directories are automatically created. Whether to do
-this is controlled by the 'wdired-create-parent-directories' variable.
-
-+++
-*** 'W' is now bound to 'browse-url-of-dired-file', and is useful for
-viewing HTML files and the like.
+*** New filter ibuffer-filter-by-process; bound to '/E'.
** Edebug
-*** Edebug can be prevented from pausing 1 second after reaching a
-breakpoint (e.g. with "f" and "o") by customizing the new option
-'edebug-sit-on-break'.
-
-+++
-*** New customizable option 'edebug-max-depth'
-This allows to enlarge the maximum recursion depth when instrumenting
-code.
-
-** Eshell
-
-*** 'eshell-input-filter's value is now a named function
-'eshell-input-filter-default', and has a new custom option
-'eshell-input-filter-initial-space' to ignore adding commands prefixed
-with blank space to eshell history.
-
-** eww
-
+++
-*** New 'M-RET' command for opening a link at point in a new eww buffer.
+*** The runtime behavior of Edebug's instrumentation can be changed
+using the new variables 'edebug-behavior-alist',
+'edebug-after-instrumentation-function' and
+'edebug-new-definition-function'. Edebug's behavior can be changed
+globally or for individual definitions.
-+++
-*** A new 's' command for switching to another eww buffer via the minibuffer.
-
----
-*** The 'o' command ('shr-save-contents') has moved to 'O' to avoid collision
-with the 'o' command from 'image-map'.
-
-+++
-*** A new command 'C' ('eww-toggle-colors') can be used to toggle
-whether to use the HTML-specified colors or not. The user can also
-customize the 'shr-use-colors' variable.
-
----
-*** Images that are being loaded are now marked with gray
-"placeholder" images of the size specified by the HTML. They are then
-replaced by the real images asynchronously, which will also now
-respect width/height HTML specs (unless they specify widths/heights
-bigger than the current window).
+** Enhanced xterm support
-** Ido
+*** New variable 'xterm-set-window-title' controls whether Emacs sets
+the XTerm window title. This feature is experimental and is disabled
+by default.
-*** The commands 'find-alternate-file-other-window',
-'dired-other-window', 'dired-other-frame', and
-'display-buffer-other-window' are now remapped to Ido equivalents if
-Ido mode is active.
+** Gamegrid
-** Images
+** ERT
+++
-*** Images are automatically scaled before displaying based on the
-'image-scaling-factor' variable (if Emacs supports scaling the images
-in question).
-
-+++
-*** Images inserted with 'insert-image' and related functions get a
-keymap put into the text properties (or overlays) that span the
-image. This keymap binds keystrokes for manipulating size and
-rotation, as well as saving the image to a file. These commands are
-also available in 'image-mode'.
-
-+++
-*** A new library for creating and manipulating SVG images has been
-added. See the "SVG Images" section in the Lisp reference manual for
-details.
-
-+++
-*** New setf-able function to access and set image parameters is
-provided: 'image-property'.
+*** New variable 'ert-quiet' allows to make ERT output in batch mode
+less verbose by removing non-essential information.
---
-*** New commands 'image-scroll-left' and 'image-scroll-right'
-for 'image-mode' that complement 'image-scroll-up' and
-'image-scroll-down': they have the same prefix arg behavior and stop
-at image boundaries.
-
-** Image-Dired
+*** Gamegrid now determines its default glyph size based on display
+dimensions, instead of always using 16 pixels. As a result, Tetris,
+Snake and Pong are more playable on HiDPI displays.
-*** Now provides a minor mode 'image-dired-minor-mode' which replaces
-the function 'image-dired-setup-dired-keybindings'.
-
-*** Thumbnail generation is now asynchronous
-The number of concurrent processes is limited by the variable
-'image-dired-thumb-job-limit'.
-
-*** 'image-dired-thumbnail-storage' has a new option 'standard-large'
-for generating 256x256 thumbnails according to the Thumbnail Managing
-Standard.
-
-*** Inherits movement keys from 'image-mode' for viewing full images.
-This includes the usual char, line, and page movement commands.
-
-*** All the -options types have been changed to argument lists
-instead of shell command strings. This change affects
-'image-dired-cmd-create-thumbnail-options',
-'image-dired-cmd-create-temp-image-options',
-'image-dired-cmd-rotate-thumbnail-options',
-'image-dired-cmd-rotate-original-options',
-'image-dired-cmd-write-exif-data-options',
-'image-dired-cmd-read-exif-data-options', and introduces
-'image-dired-cmd-pngnq-options', 'image-dired-cmd-pngcrush-options',
-'image-dired-cmd-create-standard-thumbnail-options'
-
-*** Recognizes more tools by default, including pngnq-s9 and OptiPNG
-
-*** 'find-file' and related commands now work on thumbnails and
-displayed images, providing a default argument of the original file name
-via an addition to 'file-name-at-point-functions'.
+** Filecache
---
-** The default 'Info-default-directory-list' no longer checks some obsolete
-directory suffixes (gnu, gnu/lib, gnu/lib/emacs, emacs, lib, lib/emacs)
-when searching for info directories.
+*** Completing filenames in the minibuffer via 'C-TAB' now uses the
+styles as configured by the variable 'completion-styles'.
-+++
-** The commands that add ChangeLog entries now prefer a VCS root directory
-for the ChangeLog file, if none already exists. Customize
-'change-log-directory-files' to nil for the old behavior.
+** New macros 'thunk-let' and 'thunk-let*'.
+These macros are analogue to 'let' and 'let*', but create bindings that
+are evaluated lazily.
----
-** Support for non-string values of 'time-stamp-format' has been removed.
-
-** Message
-
----
-*** 'message-use-idna' now defaults to t (because Emacs comes with
-built-in IDNA support now).
-
----
-*** When sending HTML messages with embedded images, and you have
-exiftool installed, and you rotate images with EXIF data (i.e.,
-JPEGs), the rotational information will be inserted into the outgoing
-image in the message. (The original image will not have its
-orientation affected.)
-
----
-*** The 'message-valid-fqdn-regexp' variable has been removed, since
-there are now top-level domains added all the time. Message will no
-longer warn about sending emails to top-level domains it hasn't heard
-about.
-
-*** 'message-beginning-of-line' (bound to C-a) understands folded headers.
-In 'visual-line-mode' it will look for the true beginning of a header
-while in non-'visual-line-mode' it will move the point to the indented
-header's value.
-
-** Package
-
-+++
-*** The new variable 'package-gnupghome-dir' has been added to control
-where the GnuPG home directory (used for signature verification) is
-located and whether GnuPG's option "--homedir" is used or not.
-
-** Tramp
-
-+++
-*** The method part of remote file names is mandatory now. A valid
-remote file name starts with "/method:host:" or "/method:user@host:".
-
-+++
-*** The new pseudo method "-" is a marker for the default method.
-"/-::" is the shortest remote file name then.
-
-+++
-*** The command 'tramp-change-syntax' allows to choose an alternative
-remote file name syntax.
-
-+++
-*** New connection method "sg", which supports editing files under a
-different group ID.
-
-+++
-*** New connection method "doas" for OpenBSD hosts.
-
-+++
-*** New connection method "gdrive", which allows to access Google
-Drive onsite repositories.
-
-+++
-*** Gateway methods in Tramp have been removed. Instead, the Tramp
-manual documents how to configure ssh and PuTTY accordingly.
-
-+++
-*** Setting the "ENV" environment variable in
-'tramp-remote-process-environment' enables reading of shell
-initialization files.
-
----
-*** Variable 'tramp-completion-mode' is obsoleted.
-
----
-** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'.
-
----
-** JS mode now sets 'comment-multi-line' to t.
-
-** CSS mode
-
----
-*** Support for completing attribute values, at-rules, bang-rules,
-HTML tags, classes and IDs using the 'completion-at-point' command.
-Completion candidates for HTML classes and IDs are retrieved from open
-HTML mode buffers.
-
----
-*** CSS mode now binds 'C-h S' to a function that will show
-information about a CSS construct (an at-rule, property, pseudo-class,
-pseudo-element, with the default being guessed from context). By
-default the information is looked up on the Mozilla Developer Network,
-but this can be customized using 'css-lookup-url-format'.
-
----
-*** CSS colors are fontified using the color they represent as the
-background. For instance, #ff0000 would be fontified with a red
-background.
-
-+++
-** Emacs now supports character name escape sequences in character and
-string literals. The syntax variants \N{character name} and
-\N{U+code} are supported.
-
-+++
-** Prog mode has some support for multi-mode indentation.
-This allows better indentation support in modes that support multiple
-programming languages in the same buffer, like literate programming
-environments or ANTLR programs with embedded Python code.
-
-A major mode can provide indentation context for a sub-mode through
-the 'prog-indentation-context' variable. To support this, modes that
-provide indentation should use 'prog-widen' instead of 'widen' and
-'prog-first-column' instead of a literal zero. See the node
-"Mode-Specific Indent" in the ELisp manual for more details.
-
-** ERC
-
-*** New variable 'erc-default-port-tls' used to connect to TLS IRC
-servers.
-
-** URL
-
-+++
-*** The new function 'url-cookie-delete-cookie' can be used to
-programmatically delete all cookies, or cookies from a specific
-domain.
-
-+++
-*** 'url-retrieve-synchronously' now takes an optional timeout parameter.
-
----
-*** The URL package now support HTTPS over proxies supporting CONNECT.
-
-+++
-*** 'url-user-agent' now defaults to 'default', and the User-Agent
-string is computed dynamically based on 'url-privacy-level'.
-
-** VC and related modes
-
----
-*** The VC state indicator in the mode line now defaults to more
-colorful faces to make it more obvious to the user what the state is.
-See the 'vc-faces' customization group.
-
-+++
-*** 'vc-dir-mode' now binds 'vc-log-outgoing' to 'O'; and has various
-branch-related commands on a keymap bound to 'B'.
-
-** CC mode
-
-*** Opening a .h file will turn C or C++ mode depending on language used.
-This is done with the help of 'c-or-c++-mode' function which analyses
-contents of the buffer to determine whether it's a C or C++ source
-file.
+** Eshell
---
-** New DNS mode command 'dns-mode-ipv6-to-nibbles' to convert IPv6 addresses
-to a format suitable for reverse lookup zone files.
-
-** Flymake
+*** Expansion of history event designators is disabled by default.
+To restore the old behavior, use
-+++
-*** Emacs does no longer prompt the user before killing Flymake
-processes on exit.
+ (add-hook 'eshell-expand-input-functions
+ #'eshell-expand-history-references)
-* New Modes and Packages in Emacs 26.1
-
-** New Elisp data-structure library 'radix-tree'.
-
-** New library 'xdg' with utilities for some XDG standards and specs.
-
-** HTML
-
-+++
-*** A new submode of 'html-mode', 'mhtml-mode', is now the default
-mode for *.html files. This mode handles indentation,
-fontification, and commenting for embedded JavaScript and CSS.
-
-** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling.
+* New Modes and Packages in Emacs 27.1
-* Incompatible Lisp Changes in Emacs 26.1
+* Incompatible Lisp Changes in Emacs 27.1
-+++
-*** Command 'dired-mark-extension' now automatically prepends a '.' to the
-extension when not present. The new command 'dired-mark-suffix' behaves
-similarly but it doesn't prepend a '.'.
-
-+++
-** Certain cond/pcase/cl-case forms are now compiled using a faster jump
-table implementation. This uses a new bytecode op 'switch', which isn't
-compatible with previous Emacs versions. This functionality can be disabled
-by setting 'byte-compile-cond-use-jump-table' to nil.
-
-** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term
-mode to send the same escape sequences that xterm does. This makes
-things like forward-word in readline work.
+** The FILENAME argument to 'file-name-base' is now mandatory and no
+longer defaults to 'buffer-file-name'.
---
-** hideshow mode got four key bindings that are analogous to outline
-mode bindings: 'C-c @ C-a', 'C-c @ C-t', 'C-c @ C-d', and 'C-c @ C-e.'
-
-** The grep/rgrep/lgrep functions will now ask about saving files
-before running. This is controlled by the 'grep-save-buffers'
-variable.
-
----
-** Customizable variable 'query-replace-from-to-separator'
-now doesn't propertize the string value of the separator.
-Instead, text properties are added by query-replace-read-from.
-Additionally, the new nil value restores pre-24.5 behavior
-of not providing replacement pairs via the history.
-
-** Some obsolete functions, variables, and faces have been removed:
-*** make-variable-frame-local. Variables cannot be frame-local any more.
-*** From subr.el: window-dot, set-window-dot, read-input, show-buffer,
-eval-current-buffer, string-to-int
-*** icomplete-prospects-length.
-*** All the default-FOO variables that hold the default value of the
-FOO variable. Use 'default-value' and 'setq-default' to access and
-change FOO, respectively. The exhaustive list of removed variables is:
-'default-mode-line-format', 'default-header-line-format',
-'default-line-spacing', 'default-abbrev-mode', 'default-ctl-arrow',
-'default-truncate-lines', 'default-left-margin', 'default-tab-width',
-'default-case-fold-search', 'default-left-margin-width',
-'default-right-margin-width', 'default-left-fringe-width',
-'default-right-fringe-width', 'default-fringes-outside-margins',
-'default-scroll-bar-width', 'default-vertical-scroll-bar',
-'default-indicate-empty-lines', 'default-indicate-buffer-boundaries',
-'default-fringe-indicator-alist', 'default-fringe-cursor-alist',
-'default-scroll-up-aggressively', 'default-scroll-down-aggressively',
-'default-fill-column', 'default-cursor-type',
-'default-cursor-in-non-selected-windows',
-'default-buffer-file-coding-system', 'default-major-mode', and
-'default-enable-multibyte-characters'.
-*** Many variables obsoleted in 22.1 referring to face symbols
-
-+++
-** The variable 'text-quoting-style' no longer affects the treatment
-of curved quotes in format arguments to functions like 'message' and
-'format-message'. In particular, when this variable's value is
-'grave', all quotes in formats are output as-is.
-
-** Functions like 'check-declare-file' and 'check-declare-directory'
-now generate less chatter and more-compact diagnostics. The auxiliary
-function 'check-declare-errmsg' has been removed.
-
-+++
-** The regular expression character class [:blank:] now matches
-Unicode horizontal whitespace as defined in the Unicode Technical
-Standard #18. If you only want to match space and tab, use [ \t]
-instead.
-
-+++
-** 'min' and 'max' no longer round their results. Formerly, they
-returned a floating-point value if any argument was floating-point,
-which was sometimes numerically incorrect. For example, on a 64-bit
-host (max 1e16 10000000000000001) now returns its second argument
-instead of its first.
-
-+++
-** The variable 'old-style-backquotes' has been made internal and
-renamed to 'lread--old-style-backquotes'. No user code should use
-this variable.
-
-+++
-** Module functions are now implemented slightly differently; in
-particular, the function 'internal--module-call' has been removed.
-Code that depends on undocumented internals of the module system might
-break.
+** The function 'eldoc-message' now accepts a single argument.
+Programs that called it with multiple arguments before should pass
+them through 'format' first. Even that is discouraged: for ElDoc
+support, you should set 'eldoc-documentation-function' instead of
+calling 'eldoc-message' directly.
-* Lisp Changes in Emacs 26.1
-
-** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2
-contain the same elements, regardless of the order.
-
-+++
-** Emacs now supports records for user-defined types, via the new
-functions 'make-record', 'record', and 'recordp'. Records are now
-used internally to represent cl-defstruct and defclass instances, for
-example.
-
-+++
-** 'save-some-buffers' now uses 'save-some-buffers-default-predicate'
-to decide which buffers to ask about, if the PRED argument is nil.
-The default value of 'save-some-buffers-default-predicate' is nil,
-which means ask about all file-visiting buffers.
-
-** string-(to|as|make)-(uni|multi)byte are now declared obsolete.
-** New variable 'while-no-input-ignore-events' which allow
-setting which special events 'while-no-input' should ignore.
-It is a list of symbols.
-
-** New function 'undo-amalgamate-change-group' to get rid of
-undo-boundaries between two states.
-
-** New var 'definition-prefixes' is a hash table mapping prefixes to
-the files where corresponding definitions can be found. This can be
-used to fetch definitions that are not yet loaded, for example for
-'C-h f'.
-
-** New var 'syntax-ppss-table' to control the syntax-table used in
-'syntax-ppss'.
-
-+++
-** 'define-derived-mode' can now specify an :after-hook form, which
-gets evaluated after the new mode's hook has run. This can be used to
-incorporate configuration changes made in the mode hook into the
-mode's setup.
-
-** Autoload files can be generated without timestamps,
-by setting 'autoload-timestamps' to nil.
-FIXME As an experiment, nil is the current default.
-If no insurmountable problems before next release, it can stay that way.
-
----
-** 'gnutls-boot' now takes a parameter ':complete-negotiation' that
-says that negotiation should complete even on non-blocking sockets.
-
----
-** There is now a new variable 'flyspell-sort-corrections-function'
-that allows changing the way corrections are sorted.
-
----
-** The new command 'fortune-message' has been added, which displays
-fortunes in the echo area.
-
-+++
-** New function 'func-arity' returns information about the argument list
-of an arbitrary function. This generalizes 'subr-arity' for functions
-that are not built-in primitives. We recommend using this new
-function instead of 'subr-arity'.
-
-** New function 'region-bounds' can be used in the interactive spec
-to provide region boundaries (for rectangular regions more than one)
-to an interactively callable function as a single argument instead of
-two separate arguments region-beginning and region-end.
-
-+++
-** 'parse-partial-sexp' state has a new element. Element 10 is
-non-nil when the last character scanned might be the first character
-of a two character construct, i.e., a comment delimiter or escaped
-character. Its value is the syntax of that last character.
-
-+++
-** 'parse-partial-sexp's state, element 9, has now been confirmed as
-permanent and documented, and may be used by Lisp programs. Its value
-is a list of currently open parenthesis positions, starting with the
-outermost parenthesis.
-
----
-** 'read-color' will now display the color names using the color itself
-as the background color.
-
-** The function 'redirect-debugging-output' now works on platforms
-other than GNU/Linux.
-
-+++
-** The new function 'string-version-lessp' compares strings by
-interpreting consecutive runs of numerical characters as numbers, and
-compares their numerical values. According to this predicate,
-"foo2.png" is smaller than "foo12.png".
-
----
-** Numeric comparisons and 'logb' no longer return incorrect answers
-due to internal rounding errors. For example, (< most-positive-fixnum
-(+ 1.0 most-positive-fixnum)) now correctly returns t on 64-bit hosts.
+* Lisp Changes in Emacs 27.1
---
-** The functions 'ffloor', 'fceiling', 'ftruncate' and 'fround' now
-accept only floating-point arguments, as per their documentation.
-Formerly, they quietly accepted integer arguments and sometimes
-returned nonsensical answers, e.g., (< N (ffloor N)) could return t.
+** The 'file-system-info' function is now available on all platforms.
+instead of just Microsoft platforms. This fixes a 'get-free-disk-space'
+bug on OS X 10.8 and later (Bug#28639).
---
-** On hosts like GNU/Linux x86-64 where a 'long double' fraction
-contains at least EMACS_INT_WIDTH - 3 bits, 'format' no longer returns
-incorrect answers due to internal rounding errors when formatting
-Emacs integers with %e, %f, or %g conversions. For example, on these
-hosts (eql N (string-to-number (format "%.0f" N))) now returns t for
-all Emacs integers N.
-
----
-** Calls that accept floating-point integers (for use on hosts with
-limited integer range) now signal an error if arguments are not
-integral. For example (decode-char 'ascii 0.5) now signals an error.
-
-+++
-** The new function 'char-from-name' converts a Unicode name string
-to the corresponding character code.
-
-+++
-** New functions 'sxhash-eq' and 'sxhash-eql' return hash codes of a
-Lisp object suitable for use with 'eq' and 'eql' correspondingly. If
-two objects are 'eq' ('eql'), then the result of 'sxhash-eq'
-('sxhash-eql') on them will be the same.
-
-+++
-** Function 'sxhash' has been renamed to 'sxhash-equal' for
-consistency with the new functions. For compatibility, 'sxhash'
-remains as an alias to 'sxhash-equal'.
-
-+++
-** 'make-hash-table' now defaults to a rehash threshold of 0.8125
-instead of 0.8, to avoid rounding glitches.
-
-+++
-** New function 'add-variable-watcher' can be used to call a function
-when a symbol's value is changed. This is used to implement the new
-debugger command 'debug-on-variable-change'.
-
-+++
-** Time conversion functions that accept a time zone rule argument now
-allow it to be OFFSET or a list (OFFSET ABBR), where the integer
-OFFSET is a count of seconds east of Universal Time, and the string
-ABBR is a time zone abbreviation. The affected functions are
-'current-time-string', 'current-time-zone', 'decode-time',
-'format-time-string', and 'set-time-zone-rule'.
-
-+++
-** 'format-time-string' now formats "%q" to the calendar quarter.
-
-** New built-in function 'mapcan' which avoids unnecessary consing (and garbage
-collection).
-
-+++
-** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp.
-
----
-** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el.
-The incumbent 'if-let' and 'when-let' are now aliases.
-
-** Low-level list functions like 'length' and 'member' now do a better
-job of signaling list cycles instead of looping indefinitely.
-
-+++
-** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
-can be used for creation of temporary files of remote or mounted directories.
-
-+++
-** The new function 'file-local-name' can be used to specify arguments
-of remote processes.
-
-+++
-** The new functions 'file-name-quote', 'file-name-unquote' and
-'file-name-quoted-p' can be used to quote / unquote file names with
-the prefix "/:".
-
-+++
-** The new error 'file-missing', a subcategory of 'file-error', is now
-signaled instead of 'file-error' if a file operation acts on a file
-that does not exist.
-
-+++
-** The function 'delete-directory' no longer signals an error when
-operating recursively and when some other process deletes the directory
-or its files before 'delete-directory' gets to them.
-
-+++
-*** New error type 'user-search-failed' like 'search-failed' but
-avoids debugger like 'user-error'.
-
-** Changes in Frame- and Window- Handling
-
-+++
-*** Resizing a frame no longer runs 'window-configuration-change-hook'.
-'window-size-change-functions' should be used instead.
-
-+++
-*** The new function 'frame-size-changed-p' can tell whether a frame has
-been resized since the last time 'window-size-change-functions' has been
-run.
-
-+++
-*** The function 'frame-geometry' now also returns the width of a
-frame's outer border.
-
-+++
-*** New frame parameters
-
-+++
-**** 'z-group' positions a frame above or below all others.
+** The function 'get-free-disk-space' returns now a non-nil value for
+remote systems, which support this check.
+++
-**** 'min-width' and 'min-height' specify the absolute minimum size of a
-frame.
+** The function 'make-string' accepts an additional optional argument.
+If the optional third argument is non-nil, 'make-string' will produce
+a multibyte string even if its second argument is an ASCII character.
-+++
-**** 'parent-frame' makes a frame the child frame of another Emacs
-frame. The section "Child Frames" in the Elisp manual describes the
-intrinsics of that relationship.
-
-+++
-**** 'delete-before' triggers deletion of one frame before that of
-another.
-
-+++
-**** 'mouse-wheel-frame' specifies another frame whose windows shall be
-scrolled instead.
-
-+++
-**** 'no-other-frame' has 'next-frame' and 'previous-frame' skip this
-frame.
-
-+++
-**** 'skip-taskbar' removes a frame's icon from the taskbar and has
-Alt-<TAB> skip this frame.
-
-+++
-**** 'no-focus-on-map' avoids that a frame gets input focus when mapped.
-
-+++
-**** 'no-accept-focus' means that a frame does not want to get input
-focus via the mouse.
-
-+++
-**** 'undecorated' removes the window manager decorations from a frame.
-
-+++
-**** 'override-redirect' tells the window manager to disregard this
-frame.
-
-+++
-*** The 'width' and 'height' frame parameters allow to specify pixel
-values now.
-
-+++
-*** The new function 'frame-list-z-order' returns a list of all frames
-in Z (stacking) order.
-
-+++
-*** The function 'x-focus-frame' optionally tries to not activate its
-frame.
-
-+++
-*** The variable 'focus-follows-mouse' has a third meaningful value
-'auto-raise' to indicate that the window manager automatically raises a
-frame when the mouse pointer enters it.
-
-+++
-*** The new function 'frame-restack' puts a frame above or below
-another on the display.
-
-+++
-*** The new face 'internal-border' specifies the background of a frame's
-internal border.
-
-+++
-*** The NORECORD argument of 'select-window' now has a meaningful value
-'mark-for-redisplay' which is like any other non-nil value but marks
-WINDOW for redisplay.
-
-+++
-*** Support for side windows is now official. The display action
-function 'display-buffer-in-side-window' will display its buffer in a
-side window. Functions for toggling all side windows on a frame,
-changing and reversing the layout of side windows and returning the main
-(major non-side) window of a frame are provided. For details consult
-the section "Side Windows" in the Elisp manual.
-
-+++
-*** Support for atomic windows - rectangular compositions of windows
-treated by 'split-window', 'delete-window' and 'delete-other-windows'
-like a single live window - is now official. For details consult the
-section "Atomic Windows" in the Elisp manual.
-
-+++
-*** New 'display-buffer' alist entry 'window-parameters' allows to
-assign window parameters to the window used for displaying the buffer.
-
-+++
-*** New function 'display-buffer-reuse-mode-window' is an action function
-suitable for use in 'display-buffer-alist'. For example, to avoid creating
-a new window when opening man pages when there's already one, use
-(add-to-list 'display-buffer-alist
- '("\\`\\*Man .*\\*\\'" .
- (display-buffer-reuse-mode-window
- (inhibit-same-window . nil)
- (mode . Man-mode))))
-
-+++
-*** New window parameter 'no-delete-other-window' prevents that
-its window gets deleted by 'delete-other-windows'.
-
-+++
-*** New command 'window-swap-states' swaps the states of two live
-windows.
-
-+++
-*** New functions 'window-pixel-width-before-size-change' and
-'window-pixel-height-before-size-change' support detecting which
-window changed size when 'window-size-change-functions' are run.
-
-+++
-*** The semantics of 'mouse-autoselect-window' has changed slightly.
-For details see the section "Mouse Window Auto-selection" in the Elisp
-manual.
-* Changes in Emacs 26.1 on Non-Free Operating Systems
-
-** Intercepting hotkeys on Windows 7 and later now works better.
-The new keyboard hooking code properly grabs system hotkeys such as
-Win-* and Alt-TAB, in a way that Emacs can get at them before the
-system. This makes the 'w32-register-hot-key' functionality work
-again on all versions of MS-Windows starting with Windows 7. On
-Windows NT and later you can now register any hotkey combination. (On
-Windows 9X, the previous limitations, spelled out in the Emacs manual,
-still apply.)
-
-** 'convert-standard-filename' no longer mirrors slashes on MS-Windows.
-Previously, on MS-Windows this function converted slash characters in
-file names into backslashes. It no longer does that. If your Lisp
-program used 'convert-standard-filename' to prepare file names to be
-passed to subprocesses (which is not the recommended usage of that
-function), you will now have to mirror slashes in your application
-code. One possible way is this:
-
- (let ((start 0))
- (while (string-match "/" file-name start)
- (aset file-name (match-beginning 0) ?\\)
- (setq start (match-end 0))))
-
-** GUI sessions now treat SIGINT like Posix platforms do.
-The effect of delivering a Ctrl-C (SIGINT) signal to a GUI Emacs on
-MS-Windows is now the same as on Posix platforms -- Emacs saves the
-session and exits. In particular, this will happen if you start
-emacs.exe from the Windows shell, then type Ctrl-C into that shell's
-window.
-
----
-** 'signal-process' supports SIGTRAP on Windows XP and later.
-The 'kill' emulation on Windows now maps SIGTRAP to a call to the
-'DebugBreakProcess' API. This causes the receiving process to break
-execution and return control to the debugger. If no debugger is
-attached to the receiving process, the call is typically ignored.
-This is in contrast to the default action on POSIX Systems, where it
-causes the receiving process to terminate with a core dump if no
-debugger has been attached to it.
-
-** `set-mouse-position' and `set-mouse-absolute-pixel-position' work
-on macOS.
+* Changes in Emacs 27.1 on Non-Free Operating Systems
----------------------------------------------------------------------
@@ -1384,7 +178,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17
index 0a7ca052d7c..b956442c391 100644
--- a/etc/NEWS.1-17
+++ b/etc/NEWS.1-17
@@ -2524,7 +2524,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.18 b/etc/NEWS.18
index 93e07df806a..87dac546375 100644
--- a/etc/NEWS.18
+++ b/etc/NEWS.18
@@ -1120,7 +1120,7 @@ used as mode elements, and what they do in the display:
the symbol's value is processed as a mode element.
list (whose first element is a string or list or cons cell)
- the elements of the list are treated as as mode elements,
+ the elements of the list are treated as mode elements,
so that the output they generate is concatenated,
list (whose car is a symbol)
@@ -1614,7 +1614,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.19 b/etc/NEWS.19
index 70f8673534c..955dcfbdd43 100644
--- a/etc/NEWS.19
+++ b/etc/NEWS.19
@@ -614,7 +614,7 @@ be different.
It is generally recommended to use `system-configuration' rather
than `system-type'.
-See <http://www.gnu.org/gnu/linux-and-gnu.html> for more about this.
+See <https://www.gnu.org/gnu/linux-and-gnu.html> for more about this.
** The functions shell-command and dired-call-process
now run file name handlers for default-directory, if it has them.
@@ -6533,7 +6533,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.20 b/etc/NEWS.20
index 3e829d1a163..572ae5b4289 100644
--- a/etc/NEWS.20
+++ b/etc/NEWS.20
@@ -4506,7 +4506,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.21 b/etc/NEWS.21
index 4a214cb3d2f..eebacf857eb 100644
--- a/etc/NEWS.21
+++ b/etc/NEWS.21
@@ -3367,7 +3367,7 @@ be strings that are compared case-insensitively.
(sxhash (upcase a)))
(define-hash-table-test 'case-fold 'case-fold-string=
- 'case-fold-string-hash))
+ 'case-fold-string-hash)
(make-hash-table :test 'case-fold)
@@ -4893,7 +4893,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index 689eff9c858..6426a9dbd8c 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -5598,7 +5598,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.23 b/etc/NEWS.23
index 78802d288d7..84b840912af 100644
--- a/etc/NEWS.23
+++ b/etc/NEWS.23
@@ -2558,7 +2558,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.24 b/etc/NEWS.24
index fc52ffffd67..4c26f47c15e 100644
--- a/etc/NEWS.24
+++ b/etc/NEWS.24
@@ -2542,7 +2542,7 @@ automatically select it.
** An Emacs Lisp package manager is now included.
This is a convenient way to download and install additional packages,
-from a package repository at http://elpa.gnu.org.
+from a package repository at https://elpa.gnu.org.
*** M-x list-packages shows a list of packages, which can be
selected for installation.
@@ -3853,7 +3853,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index 539e56e42a0..aac60c46887 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -16,6 +16,32 @@ You can narrow news to a specific version by calling 'view-emacs-news'
with a prefix argument or by typing C-u C-h C-n.
+* Changes in Emacs 25.3
+
+This is an emergency release to fix a security vulnerability in Emacs.
+
+** Security vulnerability related to Enriched Text mode is removed.
+
+*** Enriched Text mode has its support for decoding 'x-display' disabled.
+This feature allows saving 'display' properties as part of text.
+Emacs 'display' properties support evaluation of arbitrary Lisp forms
+as part of instantiating the property, so decoding 'x-display' is
+vulnerable to executing arbitrary malicious Lisp code included in the
+text (e.g., sent as part of an email message).
+
+This vulnerability was introduced in Emacs 21.1. To work around that
+in Emacs versions before 25.3, append the following to your ~/.emacs
+init file:
+
+ (eval-after-load "enriched"
+ '(defun enriched-decode-display-prop (start end &optional param)
+ (list start end)))
+
+*** Gnus no longer supports "richtext" and "enriched" inline MIME objects.
+This support was disabled to avoid evaluation of arbitrary Lisp code
+contained in email messages and news articles.
+
+
* Changes in Emacs 25.2
This is mainly a bug-fix release, but there are some other changes.
@@ -686,7 +712,9 @@ CLOS class and slot documentation.
*** Rectangle Mark mode can have corners past EOL or in the middle of a TAB.
*** 'C-x C-x' in 'rectangle-mark-mode' now cycles through the four corners.
+
*** 'string-rectangle' provides on-the-fly preview of the result.
+Customize 'rectangle-preview' to nil for the old behavior.
** New font-lock functions 'font-lock-ensure' and 'font-lock-flush'.
These should be used in preference to 'font-lock-fontify-buffer' when
@@ -1071,7 +1099,7 @@ be added to the archive.
Emacs is compiled with file notification support.
*** 'auto-revert-use-notify' is set to nil in 'global-auto-revert-mode'.
-See <http://debbugs.gnu.org/22814>.
+See <https://debbugs.gnu.org/22814>.
** File Notifications
@@ -1787,7 +1815,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/NEWS.26 b/etc/NEWS.26
new file mode 100644
index 00000000000..4ccf468693c
--- /dev/null
+++ b/etc/NEWS.26
@@ -0,0 +1,2046 @@
+GNU Emacs NEWS -- history of user-visible changes.
+
+Copyright (C) 2016-2017 Free Software Foundation, Inc.
+See the end of the file for license conditions.
+
+Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
+If possible, use M-x report-emacs-bug.
+
+This file is about changes in Emacs version 26.
+
+See file HISTORY for a list of GNU Emacs versions and release dates.
+See files NEWS.25, NEWS.24, ..., NEWS.18, and NEWS.1-17 for changes
+in older Emacs versions.
+
+You can narrow news to a specific version by calling 'view-emacs-news'
+with a prefix argument or by typing C-u C-h C-n.
+
+Temporary note:
++++ indicates that all necessary documentation updates have been done.
+ (This means all the relevant manuals in doc/ AND lisp doc-strings.)
+--- means doc strings are updated, and no change in the manuals is needed.
+When you add a new item, use the appropriate mark if you are sure it applies,
+
+
+* Installation Changes in Emacs 26.1
+
+---
+** By default libgnutls is now required when building Emacs.
+Use 'configure --with-gnutls=no' to build even when GnuTLS is missing.
+
+---
+** GnuTLS version 2.12.2 or later is now required, instead of merely
+version 2.6.6 or later.
+
++++
+** The new option 'configure --with-mailutils' causes Emacs to rely on
+GNU Mailutils to retrieve email. It is recommended, and is the
+default if GNU Mailutils is installed. When --with-mailutils is not
+in effect, the Emacs build procedure by default continues to build and
+install a limited 'movemail' substitute that retrieves POP3 email only
+via insecure channels. To avoid this problem, use either
+--with-mailutils or --without-pop when configuring; --without-pop
+is the default on platforms other than native MS-Windows.
+
+---
+** The new option 'configure --enable-gcc-warnings=warn-only' causes
+GCC to issue warnings without stopping the build. This behavior is
+now the default in developer builds. As before, use
+'--disable-gcc-warnings' to suppress GCC's warnings, and
+'--enable-gcc-warnings' to stop the build if GCC issues warnings.
+
+---
+** When GCC warnings are enabled, '--enable-check-lisp-object-type' is
+now enabled by default when configuring.
+
++++
+** The Emacs server now has socket-launching support. This allows
+socket based activation, where an external process like systemd can
+invoke the Emacs server process upon a socket connection event and
+hand the socket over to Emacs. Emacs uses this socket to service
+emacsclient commands. This new functionality can be disabled with the
+configure option '--disable-libsystemd'.
+
++++
+** A systemd user unit file is provided. Use it in the standard way:
+'systemctl --user enable emacs'.
+(If your Emacs is installed in a non-standard location, you may
+need to copy the emacs.service file to eg ~/.config/systemd/user/)
+
+---
+** New configure option '--disable-build-details' attempts to build an
+Emacs that is more likely to be reproducible; that is, if you build
+and install Emacs twice, the second Emacs is a copy of the first.
+Deterministic builds omit the build date from the output of the
+'emacs-version' and 'erc-cmd-SV' functions, and the leave the
+following variables nil: 'emacs-build-system', 'emacs-build-time',
+'erc-emacs-build-time'.
+
+---
+** Emacs can now be built with support for Little CMS.
+
+If the lcms2 library is installed, Emacs will enable features built on
+top of that library. The new configure option '--without-lcms2' can
+be used to build without lcms2 support even if it is installed. Emacs
+linked to Little CMS exposes color management functions in Lisp: the
+color metrics 'lcms-cie-de2000' and 'lcms-cam02-ucs', as well as
+functions for conversion to and from CIE CAM02 and CAM02-UCS.
+
+---
+** The configure option '--with-gameuser' now defaults to 'no',
+as this appears to be the most common configuration in practice.
+When it is 'no', the shared game directory and the auxiliary program
+update-game-score are no longer needed and are not installed.
+
+---
+** Emacs no longer works on IRIX. We expect that Emacs users are not
+affected by this, as SGI stopped supporting IRIX in December 2013.
+
+
+* Startup Changes in Emacs 26.1
+
++++
+** New option '--fg-daemon'. This is the same as '--daemon', except
+it runs in the foreground and does not fork. This is intended for
+modern init systems such as systemd, which manage many of the traditional
+aspects of daemon behavior themselves. '--bg-daemon' is now an alias
+for '--daemon'.
+
++++
+** New option '--module-assertions'.
+When given this option, Emacs will perform expensive correctness
+checks when dealing with dynamic modules. This is intended for module
+authors that wish to verify that their module conforms to the module
+requirements. The option makes Emacs abort if a module-related
+assertion triggers.
+
++++
+** Emacs now supports 24-bit colors on capable text terminals.
+Terminal is automatically initialized to use 24-bit colors if the
+required capabilities are found in terminfo. See the FAQ node
+"(efaq) Colors on a TTY" for more information.
+
++++
+** Emacs now obeys the X resource "scrollBar" at startup.
+The effect is similar to that of "toolBar" resource on the tool bar.
+
+
+* Changes in Emacs 26.1
+
++++
+** Option 'buffer-offer-save' can be set to new value, 'always'. When
+set to 'always', the command 'save-some-buffers' will always offer
+this buffer for saving.
+
+** Security vulnerability related to Enriched Text mode is removed.
+
++++
+*** Enriched Text mode does not evaluate Lisp in 'display' properties.
+This feature allows saving 'display' properties as part of text.
+Emacs 'display' properties support evaluation of arbitrary Lisp forms
+as part of processing the property for display, so displaying Enriched
+Text could be vulnerable to executing arbitrary malicious Lisp code
+included in the text (e.g., sent as part of an email message).
+Therefore, execution of arbitrary Lisp forms in 'display' properties
+decoded by Enriched Text mode is now disabled by default. Customize
+the new option 'enriched-allow-eval-in-display-props' to a non-nil
+value to allow Lisp evaluation in decoded 'display' properties.
+
+This vulnerability was introduced in Emacs 21.1. To work around that
+in Emacs versions before 25.3, append the following to your ~/.emacs
+init file:
+
+ (eval-after-load "enriched"
+ '(defun enriched-decode-display-prop (start end &optional param)
+ (list start end)))
+
++++
+** Functions in 'write-contents-functions' can fully short-circuit the
+'save-buffer' process. Previously, saving a buffer that was not
+visiting a file would always prompt for a file name. Now it only does
+so if 'write-contents-functions' is nil (or all its functions return
+nil).
+
+---
+** New variable 'executable-prefix-env' for inserting magic signatures.
+This variable affects the format of the interpreter magic number
+inserted by 'executable-set-magic'. If non-nil, the magic number now
+takes the form "#!/usr/bin/env interpreter", otherwise the value
+determined by 'executable-prefix', which is by default
+"#!/path/to/interpreter". By default, 'executable-prefix-env' is nil,
+so the default behavior is not changed.
+
++++
+** The variable 'emacs-version' no longer includes the build number.
+This is now stored separately in a new variable, 'emacs-build-number'.
+
++++
+** Emacs now provides a limited form of concurrency with Lisp threads.
+Concurrency in Emacs Lisp is "mostly cooperative", meaning that
+Emacs will only switch execution between threads at well-defined
+times: when Emacs waits for input, during blocking operations related
+to threads (such as mutex locking), or when the current thread
+explicitly yields. Global variables are shared among all threads, but
+a 'let' binding is thread-local. Each thread also has its own current
+buffer and its own match data.
+
+See the chapter "(elisp) Threads" in the ELisp manual for full
+documentation of these facilities.
+
++++
+** The new user variable 'electric-quote-chars' provides a list
+of curved quotes for 'electric-quote-mode', allowing user to choose
+the types of quotes to be used.
+
+---
+** The new user option 'electric-quote-context-sensitive' makes
+'electric-quote-mode' context sensitive. If it is non-nil, you can
+type an ASCII apostrophe to insert an opening or closing quote,
+depending on context. Emacs will replace the apostrophe by an opening
+quote character at the beginning of the buffer, the beginning of a
+line, after a whitespace character, and after an opening parenthesis;
+and it will replace the apostrophe by a closing quote character in all
+other cases.
+
+---
+** The new variable 'electric-quote-inhibit-functions' controls when
+to disable electric quoting based on context. Major modes can add
+functions to this list; Emacs will temporarily disable
+'electric-quote-mode' whenever any of the functions returns non-nil.
+This can be used by major modes that derive from 'text-mode' but allow
+inline code segments, such as 'markdown-mode'.
+
++++
+** The new user variable 'dired-omit-case-fold' allows the user to
+customize the case-sensitivity of dired-omit-mode. It defaults to
+the same sensitivity as that of the filesystem for the corresponding
+dired buffer.
+
++++
+** Emacs now uses double buffering to reduce flicker when editing and
+resizing graphical Emacs frames on the X Window System. This support
+requires the DOUBLE-BUFFER extension, which major X servers have
+supported for many years. If your system has this extension, but an
+Emacs built with double buffering misbehaves on some displays you use,
+you can disable the feature by adding
+
+ '(inhibit-double-buffering . t)
+
+to default-frame-alist. Or inject this parameter into the selected
+frame by evaluating this form:
+
+ (modify-frame-parameters nil '((inhibit-double-buffering . t)))
+
+---
+** The customization group 'wp', whose label was "text", is now
+deprecated. Use the new group 'text', which inherits from 'wp',
+instead.
+
++++
+** The new function 'call-shell-region' executes a command in an
+inferior shell with the buffer region as input.
+
++++
+** The new user option 'shell-command-dont-erase-buffer' controls
+if the output buffer is erased between shell commands; if non-nil,
+the output buffer is not erased; this variable also controls where
+to set the point in the output buffer: beginning of the output,
+end of the buffer or save the point.
+When 'shell-command-dont-erase-buffer' is nil, the default value,
+the behavior of 'shell-command', 'shell-command-on-region' and
+'async-shell-command' is as usual.
+
++++
+** The new user option 'async-shell-command-display-buffer' controls
+whether the output buffer of an asynchronous command is shown
+immediately, or only when there is output.
+
++++
+** The new user option 'mouse-select-region-move-to-beginning'
+controls the position of point when double-clicking mouse-1 on the end
+of a parenthetical grouping or string-delimiter: the default value nil
+keeps point at the end of the region, setting it to non-nil moves
+point to the beginning of the region.
+
++++
+** The new user option 'mouse-drag-and-drop-region' allows to drag the
+entire region of text to another place or another buffer.
+
++++
+** The new user option 'confirm-kill-processes' allows the user to
+skip a confirmation prompt for killing subprocesses when exiting
+Emacs. When set to t (the default), Emacs will prompt for
+confirmation before killing subprocesses on exit, which is the same
+behavior as before.
+
+---
+** 'find-library-name' will now fall back on looking at 'load-history'
+to try to locate libraries that have been loaded with an explicit path
+outside 'load-path'.
+
++++
+** Faces in 'minibuffer-prompt-properties' no longer overwrite properties
+in the text in functions like 'read-from-minibuffer', but instead are
+added to the end of the face list. This allows users to say things
+like '(read-from-minibuffer (propertize "Enter something: " 'face 'bold))'.
+
++++
+** The new variable 'extended-command-suggest-shorter' has been added
+to control whether to suggest shorter 'M-x' commands or not.
+
+---
+** icomplete now respects 'completion-ignored-extensions'.
+
++++
+** Non-breaking hyphens are now displayed with the 'nobreak-hyphen'
+face instead of the 'escape-glyph' face.
+
++++
+** Approximations to quotes are now displayed with the new 'homoglyph'
+face instead of the 'escape-glyph' face.
+
++++
+** New face 'header-line-highlight'.
+This face is the header-line analogue of 'mode-line-highlight'; it
+should be the preferred mouse-face for mouse-sensitive elements in the
+header line.
+
+---
+** 'C-x h' ('mark-whole-buffer') will now avoid marking the prompt
+part of minibuffers.
+
+---
+** 'fill-paragraph' no longer marks the buffer as changed unless it
+actually changed something.
+
+---
+** The locale language name 'ca' is now mapped to the language
+environment 'Catalan', which has been added.
+
+---
+** 'align-regexp' has a separate history for its interactive argument.
+'align-regexp' no longer shares its history with all other
+history-less functions that use 'read-string'.
+
++++
+** The networking code has been reworked so that it's more
+asynchronous than it was (when specifying :nowait t in
+'make-network-process'). How asynchronous it is varies based on the
+capabilities of the system, but on a typical GNU/Linux system the DNS
+resolution, the connection, and (for TLS streams) the TLS negotiation
+are all done without blocking the main Emacs thread. To get
+asynchronous TLS, the TLS boot parameters have to be passed in (see
+the manual for details).
+
+Certain process oriented functions (like 'process-datagram-address')
+will block until socket setup has been performed. The recommended way
+to deal with asynchronous sockets is to avoid interacting with them
+until they have changed status to "run". This is most easily done
+from a process sentinel.
+
+---
+** 'make-network-process' and 'open-network-stream' sometimes allowed
+:service to be an integer string (e.g., :service "993") and sometimes
+required an integer (e.g., :service 993). This difference has been
+eliminated, and integer strings work everywhere.
+
+---
+** It is possible to disable attempted recovery on fatal signals.
+Two new variables support disabling attempts to recover from stack
+overflow and to avoid automatic auto-save when Emacs is delivered a
+fatal signal. 'attempt-stack-overflow-recovery', if set to nil,
+will disable attempts to recover from C stack overflows; Emacs will
+then crash as with any other fatal signal.
+'attempt-orderly-shutdown-on-fatal-signal', if set to nil, will
+disable attempts to auto-save the session and shut down in an orderly
+fashion when Emacs receives a fatal signal; instead, Emacs will
+terminate immediately. Both variables are non-nil by default.
+These variables are for users who would like to avoid the small
+probability of data corruption due to techniques Emacs uses to recover
+in these situations.
+
++++
+** File local and directory local variables are now initialized each
+time the major mode is set, not just when the file is first visited.
+These local variables will thus not vanish on setting a major mode.
+
++++
+** A second dir-local file (.dir-locals-2.el) is now accepted.
+See the doc string of 'dir-locals-file' for more information.
+
++++
+** Connection-local variables can be used to specify local variables
+with a value depending on the connected remote server. For details,
+see the node "(elisp) Connection Local Variables" in the ELisp manual.
+
+---
+** International domain names (IDNA) are now encoded via the new
+puny.el library, so that one can visit Web sites with non-ASCII URLs.
+
++++
+** The new 'list-timers' command lists all active timers in a buffer,
+where you can cancel them with the 'c' command.
+
++++
+** 'switch-to-buffer-preserve-window-point' now defaults to t.
+Applications that call 'switch-to-buffer' and want to show the buffer at
+the position of its point should use 'pop-to-buffer-same-window' in lieu
+of 'switch-to-buffer'.
+
++++
+** The new variable 'debugger-stack-frame-as-list' allows displaying
+all call stack frames in a Lisp backtrace buffer as lists. Both
+debug.el and edebug.el have been updated to heed to this variable.
+
+---
+** Values in call stack frames are now displayed using 'cl-prin1'.
+The old behavior of using 'prin1' can be restored by customizing the
+new option 'debugger-print-function'.
+
++++
+** NUL bytes in text copied to the system clipboard are now replaced with "\0".
+
++++
+** The new variable 'x-ctrl-keysym' has been added to the existing
+roster of X keysyms. It can be used in combination with another
+variable of this kind to swap modifiers in Emacs.
+
+---
+** New input methods: 'cyrillic-tuvan', 'polish-prefix', 'uzbek-cyrillic'.
+
+---
+** The 'dutch' input method no longer attempts to support Turkish too.
+Also, it no longer converts 'IJ' and 'ij' to the compatibility
+characters U+0132 LATIN CAPITAL LIGATURE IJ and U+0133 LATIN SMALL
+LIGATURE IJ.
+
++++
+** File name quoting by adding the prefix "/:" is now possible for the
+local part of a remote file name. Thus, if you have a directory named
+"/~" on the remote host "foo", you can prevent it from being
+substituted by a home directory by writing it as "/foo:/:/~/file".
+
++++
+** The new variable 'maximum-scroll-margin' allows having effective
+settings of 'scroll-margin' up to half the window size, instead of
+always restricting the margin to a quarter of the window.
+
++++
+** Emacs can scroll horizontally using mouse, touchpad, and trackbar.
+You can enable this by customizing 'mwheel-tilt-scroll-p'. If you
+want to reverse the direction of the scroll, customize
+'mwheel-flip-direction'.
+
+** Emacsclient changes
+
++++
+*** Emacsclient has a new option '-u' / '--suppress-output'.
+This option suppresses display of return values from the server
+process.
+
++++
+*** Emacsclient has a new option '-T' / '--tramp'.
+This helps with using a local Emacs session as the server for a remote
+emacsclient. With appropriate setup, one can now set the EDITOR
+environment variable on a remote machine to emacsclient, and
+use the local Emacs to edit remote files via Tramp. See the node
+"(emacs) emacsclient Options" in the user manual for the details.
+
++++
+*** Emacsclient now accepts command-line options in ALTERNATE_EDITOR
+and '--alternate-editor'. For example, ALTERNATE_EDITOR="emacs -Q -nw".
+Arguments may be quoted "like this", so that for example an absolute
+path containing a space may be specified; quote escaping is not
+supported.
+
+---
+** New user option 'dig-program-options' and extended functionality
+for DNS-querying functions 'nslookup-host', 'dns-lookup-host',
+and 'run-dig'. Each function now accepts an optional name server
+argument interactively (with a prefix argument) and non-interactively.
+
++++
+** 'describe-key-briefly' now ignores mouse movement events.
+
++++
+** The new variable 'eval-expression-print-maximum-character' prevents
+large integers from being displayed as characters by 'M-:' and similar
+commands.
+
+---
+** Two new commands for finding the source code of Emacs Lisp
+libraries: 'find-library-other-window' and 'find-library-other-frame'.
+
++++
+** The new variable 'display-raw-bytes-as-hex' allows to change the
+display of raw bytes from octal to hex.
+
++++
+** You can now provide explicit field numbers in format specifiers.
+For example, '(format "%2$s %1$s %2$s" "X" "Y")' produces "Y X Y".
+
++++
+** Emacs now supports optional display of line numbers in the buffer.
+This is similar to what 'linum-mode' provides, but much faster and
+doesn't usurp the display margin for the line numbers. Customize the
+buffer-local variable 'display-line-numbers' to activate this optional
+display. Alternatively, you can use the 'display-line-numbers-mode'
+minor mode or the global 'global-display-line-numbers-mode'. When
+using these modes, customize 'display-line-numbers-type' with the same
+value as you would use with 'display-line-numbers'.
+
+Line numbers are not displayed at all in minibuffer windows and in
+tooltips, as they are not useful there.
+
+Lisp programs can disable line-number display for a particular screen
+line by putting the 'display-line-numbers-disable' text property or
+overlay property on the first character of that screen line. This is
+intended for add-on packages that need a finer control of the display.
+
+Lisp programs that need to know how much screen estate is used up for
+line-number display in a window can use the new function
+'line-number-display-width'.
+
+'linum-mode' and all similar packages are henceforth becoming obsolete.
+Users and developers are encouraged to switch to this new feature
+instead.
+
+---
+** The new user option 'arabic-shaper-ZWNJ-handling' controls how to
+handle ZWNJ in Arabic text rendering.
+
+
+* Editing Changes in Emacs 26.1
+
++++
+** New variable 'column-number-indicator-zero-based'.
+Traditionally, in Column Number mode, the displayed column number
+counts from zero starting at the left margin of the window. This
+behavior is now controlled by 'column-number-indicator-zero-based'.
+If you would prefer for the displayed column number to count from one,
+you may set this variable to nil. (Behind the scenes, there is now a
+new mode line construct, '%C', which operates exactly as '%c' does
+except that it counts from one.)
+
++++
+** New single-line horizontal scrolling mode.
+The 'auto-hscroll-mode' variable can now have a new special value,
+'current-line', which causes only the line where the cursor is
+displayed to be horizontally scrolled when lines are truncated on
+display and point moves outside the left or right window margin.
+
++++
+** New mode line constructs '%o' and '%q', and user option
+'mode-line-percent-position'. '%o' displays the "degree of travel" of
+the window through the buffer. Unlike the default '%p', this
+percentage approaches 100% as the window approaches the end of the
+buffer. '%q' displays the percentage offsets of both the start and
+the end of the window, e.g. "5-17%". The new option
+'mode-line-percent-position' makes it easier to switch between '%p',
+'%P', and these new constructs.
+
++++
+** Two new user options 'list-matching-lines-jump-to-current-line' and
+'list-matching-lines-current-line-face' to show the current line
+highlighted in *Occur* buffer.
+
++++
+** The 'occur' command can now operate on the region.
+
++++
+** New bindings for 'query-replace-map'.
+'undo', undo the last replacement; bound to 'u'.
+'undo-all', undo all replacements; bound to 'U'.
+
+---
+** 'delete-trailing-whitespace' deletes whitespace after form feed.
+In modes where form feed was treated as a whitespace character,
+'delete-trailing-whitespace' would keep lines containing it unchanged.
+It now deletes whitespace after the last form feed thus behaving the
+same as in modes where the character is not whitespace.
+
+---
+** Emacs no longer prompts about editing a changed file when the file's
+content is unchanged. Instead of only checking the modification time,
+Emacs now also checks the file's actual content before prompting the user.
+
+---
+** Various casing improvements.
+
+*** 'upcase', 'upcase-region' et al. convert title case characters
+(such as Dz) into their upper case form (such as DZ).
+
+*** 'capitalize', 'upcase-initials' et al. make use of title-case forms
+of initial characters (correctly producing for example Džungla instead
+of incorrect DŽungla).
+
+*** Characters which turn into multiple ones when cased are correctly handled.
+For example, fi ligature is converted to FI when upper cased.
+
+*** Greek small sigma is correctly handled when at the end of the word.
+Strings such as ΌΣΟΣ are now correctly converted to Όσος when
+capitalized instead of incorrect Όσοσ (compare lowercase sigma at the
+end of the word).
+
++++
+** Emacs can now auto-save buffers to visited files in a more robust
+manner via the new mode 'auto-save-visited-mode'. Unlike
+'auto-save-visited-file-name', this mode uses the normal saving
+procedure and therefore obeys saving hooks.
+'auto-save-visited-file-name' is now obsolete.
+
++++
+** New behavior of 'mark-defun'.
+Prefix argument selects that many (or that many more) defuns.
+Negative prefix arg flips the direction of selection. Also,
+'mark-defun' between defuns correctly selects N following defuns (or
+-N previous for negative arguments). Finally, comments preceding the
+defun are selected unless they are separated from the defun by a blank
+line.
+
+---
+** New command 'replace-buffer-contents'.
+This command replaces the contents of the accessible portion of the
+current buffer with the contents of the accessible portion of a
+different buffer while keeping point, mark, markers, and text
+properties as intact as possible.
+
++++
+** New commands 'apropos-local-variable' and 'apropos-local-value'.
+These are buffer-local versions of 'apropos-variable' and
+'apropos-value', respectively. They show buffer-local variables whose
+names and values, respectively, match a given pattern.
+
++++
+** More user control of reordering bidirectional text for display.
+The two new variables, 'bidi-paragraph-start-re' and
+'bidi-paragraph-separate-re', allow customization of what exactly are
+paragraphs, for the purposes of bidirectional display.
+
+---
+** New variable 'x-wait-for-event-timeout'.
+This controls how long Emacs will wait for updates to the graphical
+state to take effect (making a frame visible, for example).
+
+
+* Changes in Specialized Modes and Packages in Emacs 26.1
+
+---
+** Emacs 26.1 comes with Org v9.1.2.
+See the file ORG-NEWS for user-visible changes in Org.
+
+---
+** New function 'cl-generic-p'.
+
+** Dired
+
++++
+*** You can answer 'all' in 'dired-do-delete' to delete recursively all
+remaining directories without more prompts.
+
++++
+*** Dired supports wildcards in the directory part of the file names.
+
++++
+*** You can now use '`?`' in 'dired-do-shell-command'.
+It gets replaced by the current file name, like ' ? '.
+
++++
+*** A new option 'dired-always-read-filesystem' defaulting to nil.
+If non-nil, buffers visiting files are reverted before they are
+searched; for instance, in 'dired-mark-files-containing-regexp' a
+non-nil value of this option means the file is revisited in a
+temporary buffer; this temporary buffer is the actual buffer searched:
+the original buffer visiting the file is not modified.
+
+---
+*** Users can now customize mouse clicks in Dired in a more flexible way.
+The new command 'dired-mouse-find-file' can be bound to a mouse click
+and used to visit files/directories in Dired in the selected window.
+The new command 'dired-mouse-find-file-other-frame' similarly visits
+files/directories in another frame. You can write your own commands
+that invoke 'dired-mouse-find-file' with non-default optional
+arguments, to tailor the effects of mouse clicks on file names in
+Dired buffers.
+
++++
+*** In wdired, when editing files to contain slash characters,
+the resulting directories are automatically created. Whether to do
+this is controlled by the 'wdired-create-parent-directories' variable.
+
++++
+*** 'W' is now bound to 'browse-url-of-dired-file', and is useful for
+viewing HTML files and the like.
+
+---
+*** New variable 'dired-clean-confirm-killing-deleted-buffers'
+controls whether Dired asks to kill buffers visiting deleted files and
+directories. The default is t, so Dired asks for confirmation, to
+keep previous behavior.
+
+---
+** html2text is now marked obsolete.
+
+---
+** smerge-refine-regions can refine regions in separate buffers.
+
+---
+** Info menu and index completion uses substring completion by default.
+This can be customized via the 'info-menu' category in
+'completion-category-overrides'.
+
++++
+** The ancestor buffer is shown by default in 3-way merges.
+A new option 'ediff-show-ancestor' and a new toggle
+'ediff-toggle-show-ancestor'.
+
+---
+** TeX: Add luatex and xetex as alternatives to pdftex
+
+** Electric-Buffer-menu
+
++++
+*** Key 'U' is bound to 'Buffer-menu-unmark-all' and key 'M-DEL' is
+bound to 'Buffer-menu-unmark-all-buffers'.
+
++++
+** hideshow mode got four key bindings that are analogous to outline
+mode bindings: 'C-c @ C-a', 'C-c @ C-t', 'C-c @ C-d', and 'C-c @ C-e'.
+
+** bs
+
+---
+*** Two new commands 'bs-unmark-all', bound to 'U', and
+'bs-unmark-previous', bound to <backspace>.
+
+** Buffer-menu
+
++++
+*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and
+'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'.
+
+---
+** Checkdoc
+
+*** 'checkdoc-arguments-in-order-flag' now defaults to nil.
+
+** Gnus
+
+---
+*** The ~/.newsrc file will now only be saved if the native select
+method is an NNTP select method.
+
++++
+*** A new command for sorting articles by readedness marks has been
+added: 'C-c C-s C-m C-m'.
+
++++
+*** In 'message-citation-line-format' the '%Z' format is now the time
+zone name instead of the numeric form. The '%z' format continues to
+be the numeric form. The new behavior is compatible with
+'format-time-string'.
+
+** Ibuffer
+
+---
+*** New command 'ibuffer-jump'.
+
+---
+*** New filter commands 'ibuffer-filter-by-basename',
+'ibuffer-filter-by-file-extension', 'ibuffer-filter-by-directory',
+'ibuffer-filter-by-starred-name', 'ibuffer-filter-by-modified'
+and 'ibuffer-filter-by-visiting-file'; bound respectively
+to '/b', '/.', '//', '/*', '/i' and '/v'.
+
+---
+*** Two new commands 'ibuffer-filter-chosen-by-completion'
+and 'ibuffer-and-filter', the second bound to '/&'.
+
+---
+*** The commands 'ibuffer-pop-filter', 'ibuffer-pop-filter-group',
+'ibuffer-or-filter' and 'ibuffer-filter-disable' have the alternative
+bindings '/<up>', '/S-<up>', '/|' and '/DEL', respectively.
+
+---
+*** The data format specifying filters has been extended to allow
+explicit logical 'and', and a more flexible form for logical 'not'.
+See 'ibuffer-filtering-qualifiers' doc string for full details.
+
+---
+*** A new command 'ibuffer-copy-buffername-as-kill'; bound
+to 'B'.
+
+---
+*** New command 'ibuffer-change-marks'; bound to '* c'.
+
+---
+*** A new command 'ibuffer-mark-by-locked' to mark
+all locked buffers; bound to '% L'.
+
+---
+*** A new option 'ibuffer-locked-char' to indicate
+locked buffers; Ibuffer shows a new column displaying
+'ibuffer-locked-char' for locked buffers.
+
+---
+*** A new command 'ibuffer-unmark-all-marks' to unmark
+all buffers without asking confirmation; bound to
+'U'; 'ibuffer-do-replace-regexp' bound to 'r'.
+
+---
+*** A new command 'ibuffer-mark-by-content-regexp' to mark buffers
+whose content matches a regexp; bound to '% g'.
+
+---
+*** Two new options 'ibuffer-never-search-content-name' and
+'ibuffer-never-search-content-mode' used by
+'ibuffer-mark-by-content-regexp'.
+
+** Browse-URL
+
+---
+*** Support for opening links to man pages in Man or WoMan mode.
+
+** Comint
+
+---
+*** New user option 'comint-move-point-for-matching-input' to control
+where to place point after 'C-c M-r' and 'C-c M-s'.
+
+** Compilation mode
+
+---
+*** Messages from CMake are now recognized.
+
++++
+*** The number of errors, warnings, and informational messages is now
+displayed in the mode line. These are updated as compilation
+proceeds.
+
+** Grep
+
+---
+*** Grep commands will now use GNU grep's '--null' option if
+available, which allows distinguishing the filename from contents if
+they contain colons. This can be controlled by the new custom option
+'grep-use-null-filename-separator'.
+
+---
+*** The grep/rgrep/lgrep functions will now ask about saving files
+before running. This is controlled by the 'grep-save-buffers'
+variable.
+
+** Edebug
+
+---
+*** Edebug can be prevented from pausing 1 second after reaching a
+breakpoint (e.g. with "f" and "o") by customizing the new option
+'edebug-sit-on-break'.
+
++++
+*** New customizable option 'edebug-max-depth'.
+This allows to enlarge the maximum recursion depth when instrumenting
+code.
+
+** Eshell
+
+---
+*** 'eshell-input-filter's value is now a named function
+'eshell-input-filter-default', and has a new custom option
+'eshell-input-filter-initial-space' to ignore adding commands prefixed
+with blank space to eshell history.
+
+** EUDC
+
+---
+*** Backward compatibility support for BBDB versions less than 3
+(i.e., BBDB 2.x) is deprecated and will likely be removed in the next
+major release of Emacs. Users of BBDB 2.x should plan to upgrade to
+BBDB 3.x.
+
+** eww
+
++++
+*** New 'M-RET' command for opening a link at point in a new eww buffer.
+
++++
+*** A new 's' command for switching to another eww buffer via the minibuffer.
+
+---
+*** The 'o' command ('shr-save-contents') has moved to 'O' to avoid collision
+with the 'o' command from 'image-map'.
+
++++
+*** A new command 'C' ('eww-toggle-colors') can be used to toggle
+whether to use the HTML-specified colors or not. The user can also
+customize the 'shr-use-colors' variable.
+
+---
+*** Images that are being loaded are now marked with gray
+"placeholder" images of the size specified by the HTML. They are then
+replaced by the real images asynchronously, which will also now
+respect width/height HTML specs (unless they specify widths/heights
+bigger than the current window).
+
+---
+*** The 'w' command on links is now 'shr-maybe-probe-and-copy-url'.
+'shr-copy-url' now only copies the url at point; users who wish to
+avoid accidentally accessing remote links may rebind 'w' and 'u' in
+'eww-link-keymap' to it.
+
+** Ido
+
+---
+*** The commands 'find-alternate-file-other-window',
+'dired-other-window', 'dired-other-frame', and
+'display-buffer-other-window' are now remapped to Ido equivalents if
+Ido mode is active.
+
+** Images
+
++++
+*** Images are automatically scaled before displaying based on the
+'image-scaling-factor' variable (if Emacs supports scaling the images
+in question).
+
++++
+*** It's now possible to specify aspect-ratio preserving combinations
+of :width/:max-height and :height/:max-width keywords. In either
+case, the "max" keywords win. (Previously some combinations would,
+depending on the aspect ratio of the image, just be ignored and in
+other instances this would lead to the aspect ratio not being
+preserved.)
+
++++
+*** Images inserted with 'insert-image' and related functions get a
+keymap put into the text properties (or overlays) that span the
+image. This keymap binds keystrokes for manipulating size and
+rotation, as well as saving the image to a file. These commands are
+also available in 'image-mode'.
+
++++
+*** A new library for creating and manipulating SVG images has been
+added. See the "(elisp) SVG Images" section in the ELisp reference
+manual for details.
+
++++
+*** New setf-able function to access and set image parameters is
+provided: 'image-property'.
+
+---
+*** New commands 'image-scroll-left' and 'image-scroll-right'
+for 'image-mode' that complement 'image-scroll-up' and
+'image-scroll-down': they have the same prefix arg behavior and stop
+at image boundaries.
+
+** Image-Dired
+
+---
+*** Now provides a minor mode 'image-dired-minor-mode' which replaces
+the function 'image-dired-setup-dired-keybindings'.
+
+---
+*** Thumbnail generation is now asynchronous.
+The number of concurrent processes is limited by the variable
+'image-dired-thumb-job-limit'.
+
+---
+*** 'image-dired-thumbnail-storage' has a new option 'standard-large'
+for generating 256x256 thumbnails according to the Thumbnail Managing
+Standard.
+
+---
+*** Inherits movement keys from 'image-mode' for viewing full images.
+This includes the usual char, line, and page movement commands.
+
+---
+*** All the -options types have been changed to argument lists
+instead of shell command strings. This change affects
+'image-dired-cmd-create-thumbnail-options',
+'image-dired-cmd-create-temp-image-options',
+'image-dired-cmd-rotate-thumbnail-options',
+'image-dired-cmd-rotate-original-options',
+'image-dired-cmd-write-exif-data-options',
+'image-dired-cmd-read-exif-data-options', and introduces
+'image-dired-cmd-pngnq-options', 'image-dired-cmd-pngcrush-options',
+'image-dired-cmd-create-standard-thumbnail-options'.
+
+---
+*** Recognizes more tools by default, including pngnq-s9 and OptiPNG.
+
+---
+*** 'find-file' and related commands now work on thumbnails and
+displayed images, providing a default argument of the original file name
+via an addition to 'file-name-at-point-functions'.
+
+---
+** The default 'Info-default-directory-list' no longer checks some obsolete
+directory suffixes (gnu, gnu/lib, gnu/lib/emacs, emacs, lib, lib/emacs)
+when searching for info directories.
+
++++
+** The commands that add ChangeLog entries now prefer a VCS root directory
+for the ChangeLog file, if none already exists. Customize
+'change-log-directory-files' to nil for the old behavior.
+
+---
+** Support for non-string values of 'time-stamp-format' has been removed.
+
+** Message
+
+---
+*** 'message-use-idna' now defaults to t (because Emacs comes with
+built-in IDNA support now).
+
+---
+*** When sending HTML messages with embedded images, and you have
+exiftool installed, and you rotate images with EXIF data (i.e.,
+JPEGs), the rotational information will be inserted into the outgoing
+image in the message. (The original image will not have its
+orientation affected.)
+
+---
+*** The 'message-valid-fqdn-regexp' variable has been removed, since
+there are now top-level domains added all the time. Message will no
+longer warn about sending emails to top-level domains it hasn't heard
+about.
+
+---
+*** 'message-beginning-of-line' (bound to 'C-a') understands folded headers.
+In 'visual-line-mode' it will look for the true beginning of a header
+while in non-'visual-line-mode' it will move the point to the indented
+header's value.
+
+** Package
+
++++
+*** The new variable 'package-gnupghome-dir' has been added to control
+where the GnuPG home directory (used for signature verification) is
+located and whether GnuPG's option '--homedir' is used or not.
+
+---
+*** Deleting a package no longer respects 'delete-by-moving-to-trash'.
+
+** Tramp
+
++++
+*** The method part of remote file names is mandatory now.
+A valid remote file name starts with "/method:host:" or
+"/method:user@host:".
+
++++
+*** The new pseudo method "-" is a marker for the default method.
+"/-::" is the shortest remote file name then.
+
++++
+*** The command 'tramp-change-syntax' allows to choose an alternative
+remote file name syntax.
+
++++
+*** New connection method "sg", which supports editing files under a
+different group ID.
+
++++
+*** New connection method "doas" for OpenBSD hosts.
+
++++
+*** New connection method "gdrive", which allows to access Google
+Drive onsite repositories.
+
++++
+*** Gateway methods in Tramp have been removed.
+Instead, the Tramp manual documents how to configure ssh and PuTTY
+accordingly.
+
++++
+*** Setting the "ENV" environment variable in
+'tramp-remote-process-environment' enables reading of shell
+initialization files.
+
+---
+*** Tramp is able now to send SIGINT to remote asynchronous processes.
+
+---
+*** Variable 'tramp-completion-mode' is obsoleted.
+
+---
+** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'.
+
+** JS mode
+
+---
+*** JS mode now sets 'comment-multi-line' to t.
+
+---
+*** New variable 'js-indent-align-list-continuation', when set to nil,
+will not align continuations of bracketed lists, but will indent them
+by the fixed width 'js-indent-level'.
+
+** CSS mode
+
+---
+*** Support for completing attribute values, at-rules, bang-rules,
+HTML tags, classes and IDs using the 'completion-at-point' command.
+Completion candidates for HTML classes and IDs are retrieved from open
+HTML mode buffers.
+
+---
+*** CSS mode now binds 'C-h S' to a function that will show
+information about a CSS construct (an at-rule, property, pseudo-class,
+pseudo-element, with the default being guessed from context). By
+default the information is looked up on the Mozilla Developer Network,
+but this can be customized using 'css-lookup-url-format'.
+
+---
+*** CSS colors are fontified using the color they represent as the
+background. For instance, #ff0000 would be fontified with a red
+background.
+
++++
+** Emacs now supports character name escape sequences in character and
+string literals. The syntax variants '\N{character name}' and
+'\N{U+code}' are supported.
+
++++
+** Prog mode has some support for multi-mode indentation.
+This allows better indentation support in modes that support multiple
+programming languages in the same buffer, like literate programming
+environments or ANTLR programs with embedded Python code.
+
+A major mode can provide indentation context for a sub-mode through
+the 'prog-indentation-context' variable. To support this, modes that
+provide indentation should use 'prog-widen' instead of 'widen' and
+'prog-first-column' instead of a literal zero. See the node
+"(elisp) Mode-Specific Indent" in the ELisp manual for more details.
+
+** ERC
+
+---
+*** New variable 'erc-default-port-tls' used to connect to TLS IRC
+servers.
+
+** URL
+
++++
+*** The new function 'url-cookie-delete-cookie' can be used to
+programmatically delete all cookies, or cookies from a specific
+domain.
+
++++
+*** 'url-retrieve-synchronously' now takes an optional timeout parameter.
+
+---
+*** The URL package now supports HTTPS over proxies supporting CONNECT.
+
++++
+*** 'url-user-agent' now defaults to 'default', and the User-Agent
+string is computed dynamically based on 'url-privacy-level'.
+
+** VC and related modes
+
++++
+*** 'vc-dir-mode' now binds 'vc-log-outgoing' to 'O'; and has various
+branch-related commands on a keymap bound to 'B'.
+
++++
+*** 'vc-region-history' is now bound to 'C-x v h', replacing the older
+'vc-insert-headers' binding.
+
+** CC mode
+
+---
+*** Opening a .h file will turn C or C++ mode depending on language used.
+This is done with the help of the 'c-or-c++-mode' function, which
+analyzes buffer contents to infer whether it's a C or C++ source file.
+
+---
+** New option 'cpp-message-min-time-interval' to allow user control
+of progress messages in cpp.el.
+
+---
+** New DNS mode command 'dns-mode-ipv6-to-nibbles' to convert IPv6 addresses
+to a format suitable for reverse lookup zone files.
+
+** Ispell
+
++++
+*** Enchant is now supported as a spell-checker.
+
+Enchant is a meta-spell-checker that uses providers such as Hunspell
+to do the actual checking. With it, users can use spell-checkers not
+directly supported by Emacs, such as Voikko, Hspell and AppleSpell,
+more easily share personal word-lists with other programs, and
+configure different spelling-checkers for different languages.
+(Version 2.1.0 or later of Enchant is required.)
+
+** Flymake
+
++++
+*** Flymake has been completely redesigned
+
+Flymake now annotates arbitrary buffer regions, not just lines. It
+supports arbitrary diagnostic types, not just errors and warnings (see
+variable 'flymake-diagnostic-types-alist').
+
+It also supports multiple simultaneous backends, meaning that you can
+check your buffer from different perspectives (see variable
+'flymake-diagnostic-functions'). Backends for Emacs Lisp mode are
+provided.
+
+The old Flymake behavior is preserved in the so-called "legacy
+backend", which has been updated to benefit from the new UI features.
+
+** Term
+
+---
+*** `term-char-mode' now makes its buffer read-only.
+
+The buffer is made read-only to prevent changes from being made by
+anything other than the process filter; and movements of point away
+from the process mark are counter-acted so that the cursor is in the
+correct position after each command. This is needed to avoid states
+which are inconsistent with the state of the terminal understood by
+the inferior process.
+
+New user options `term-char-mode-buffer-read-only' and
+`term-char-mode-point-at-process-mark' control these behaviors, and
+are non-nil by default. Customize these options to nil if you want
+the previous behavior.
+
+** Xref
+
++++
+*** When an *xref* buffer is needed, 'TAB' quits and jumps to an xref.
+
+A new command 'xref-quit-and-goto-xref', bound to 'TAB' in *xref*
+buffers, quits the window before jumping to the destination. In many
+situations, the intended window configuration is restored, just as if
+the *xref* buffer hadn't been necessary in the first place.
+
+
+* New Modes and Packages in Emacs 26.1
+
+---
+** New Elisp data-structure library 'radix-tree'.
+
+---
+** New library 'xdg' with utilities for some XDG standards and specs.
+
+** HTML
+
++++
+*** A new submode of 'html-mode', 'mhtml-mode', is now the default
+mode for *.html files. This mode handles indentation,
+fontification, and commenting for embedded JavaScript and CSS.
+
+---
+** New mode 'conf-toml-mode' is a sub-mode of 'conf-mode', specialized
+for editing TOML files.
+
+---
+** New mode 'conf-desktop-mode' is a sub-mode of 'conf-unix-mode',
+specialized for editing freedesktop.org desktop entries.
+
+---
+** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling.
+
+---
+** New major mode 'less-css-mode' (a minor variant of 'css-mode') for
+editing Less files.
+
+
+* Incompatible Lisp Changes in Emacs 26.1
+
+---
+** 'password-data' is now a hash-table so that 'password-read' can use
+any object for the 'key' argument.
+
++++
+** Command 'dired-mark-extension' now automatically prepends a '.' to the
+extension when not present. The new command 'dired-mark-suffix' behaves
+similarly but it doesn't prepend a '.'.
+
++++
+** Certain cond/pcase/cl-case forms are now compiled using a faster jump
+table implementation. This uses a new bytecode op 'switch', which
+isn't compatible with previous Emacs versions. This functionality can
+be disabled by setting 'byte-compile-cond-use-jump-table' to nil.
+
++++
+** If 'comment-auto-fill-only-comments' is non-nil, 'auto-fill-function'
+is now called only if either no comment syntax is defined for the
+current buffer or the self-insertion takes place within a comment.
+
+---
+** The alist 'ucs-names' is now a hash table.
+
+---
+** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'.
+The incumbent 'if-let' and 'when-let' are now marked obsolete.
+'if-let*' and 'when-let*' do not accept the single tuple special case.
+New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax
+of the same name. 'if-let*' and 'when-let*' now accept the same
+binding syntax as 'and-let*'.
+
+---
+** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term
+mode to send the same escape sequences that xterm does. This makes
+things like 'forward-word' in readline work.
+
+---
+** Customizable variable 'query-replace-from-to-separator'
+now doesn't propertize the string value of the separator.
+Instead, text properties are added by 'query-replace-read-from'.
+Additionally, the new nil value restores pre-24.5 behavior
+of not providing replacement pairs via the history.
+
+---
+** Some obsolete functions, variables, and faces have been removed:
+
+*** 'make-variable-frame-local'. Variables cannot be frame-local any more.
+
+*** From subr.el: 'window-dot', 'set-window-dot', 'read-input',
+'show-buffer', 'eval-current-buffer', 'string-to-int'.
+
+*** 'icomplete-prospects-length'.
+
+*** All the default-FOO variables that hold the default value of the
+FOO variable. Use 'default-value' and 'setq-default' to access and
+change FOO, respectively. The exhaustive list of removed variables is:
+'default-mode-line-format', 'default-header-line-format',
+'default-line-spacing', 'default-abbrev-mode', 'default-ctl-arrow',
+'default-truncate-lines', 'default-left-margin', 'default-tab-width',
+'default-case-fold-search', 'default-left-margin-width',
+'default-right-margin-width', 'default-left-fringe-width',
+'default-right-fringe-width', 'default-fringes-outside-margins',
+'default-scroll-bar-width', 'default-vertical-scroll-bar',
+'default-indicate-empty-lines', 'default-indicate-buffer-boundaries',
+'default-fringe-indicator-alist', 'default-fringe-cursor-alist',
+'default-scroll-up-aggressively', 'default-scroll-down-aggressively',
+'default-fill-column', 'default-cursor-type',
+'default-cursor-in-non-selected-windows',
+'default-buffer-file-coding-system', 'default-major-mode', and
+'default-enable-multibyte-characters'.
+
+*** Many variables obsoleted in 22.1 referring to face symbols.
+
++++
+** The variable 'text-quoting-style' is now a customizable option. It
+controls whether to and how to translate ASCII quotes in messages and
+help output. Its possible values and their semantics remain unchanged
+from Emacs 25. In particular, when this variable's value is 'grave',
+all quotes in formats are output as-is.
+
+---
+** Functions like 'check-declare-file' and 'check-declare-directory'
+now generate less chatter and more-compact diagnostics. The auxiliary
+function 'check-declare-errmsg' has been removed.
+
++++
+** The regular expression character class '[:blank:]' now matches
+Unicode horizontal whitespace as defined in the Unicode Technical
+Standard #18. If you only want to match space and tab, use '[ \t]'
+instead.
+
++++
+** 'min' and 'max' no longer round their results.
+Formerly, they returned a floating-point value if any argument was
+floating-point, which was sometimes numerically incorrect. For
+example, on a 64-bit host (max 1e16 10000000000000001) now returns its
+second argument instead of its first.
+
++++
+** The variable 'old-style-backquotes' has been made internal and
+renamed to 'lread--old-style-backquotes'. No user code should use
+this variable.
+
+---
+** To avoid confusion caused by "smart quotes", the reader no longer
+accepts Lisp symbols which begin with the following quotation
+characters: ‘’‛“”‟〞"', unless they are escaped with backslash.
+
++++
+** 'default-file-name-coding-system' now defaults to a coding system
+that does not process CRLF. For example, it defaults to 'utf-8-unix'
+instead of to 'utf-8'. Before this change, Emacs would sometimes
+mishandle file names containing these control characters.
+
++++
+** 'file-attributes', 'file-symlink-p' and 'make-symbolic-link' no
+longer quietly mutate the target of a local symbolic link, so that
+Emacs can access and copy them reliably regardless of their contents.
+The following changes are involved.
+
+---
+*** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to
+symbolic links whose targets begin with "/" and contain ":". For
+example, if a symbolic link "x" has a target "/y:z:", '(file-symlink-p
+"x")' now returns "/y:z:" rather than "/:/y:z:".
+
+---
+*** 'make-symbolic-link' no longer looks for file name handlers of
+target when creating a symbolic link. For example,
+'(make-symbolic-link "/y:z:" "x")' now creates a symbolic link to
+"/y:z:" instead of failing.
+
++++
+*** 'make-symbolic-link' removes the remote part of a link target if
+target and newname have the same remote part. For example,
+'(make-symbolic-link "/x:y:a" "/x:y:b")' creates a link with the
+literal string "a"; and '(make-symbolic-link "/x:y:a" "/x:z:b")'
+creates a link with the literal string "/x:y:a" instead of failing.
+
++++
+*** 'make-symbolic-link' now expands a link target with leading "~"
+only when the optional third arg is an integer, as when invoked
+interactively. For example, '(make-symbolic-link "~y" "x")' now
+creates a link with target the literal string "~y"; to get the old
+behavior, use '(make-symbolic-link (expand-file-name "~y") "x")'. To
+avoid this expansion in interactive use, you can now prefix the link
+target with "/:". For example, '(make-symbolic-link "/:~y" "x" 1)'
+now creates a link to literal "~y".
+
++++
+** 'file-truename' returns a quoted file name if the target of a
+symbolic link has remote file name syntax.
+
++++
+** Module functions are now implemented slightly differently; in
+particular, the function 'internal--module-call' has been removed.
+Code that depends on undocumented internals of the module system might
+break.
+
+---
+** The argument LOCKNAME of 'write-region' is propagated to file name
+handlers now.
+
+---
+** When built against recent versions of GTK+, Emacs always uses
+gtk_window_move for moving frames and ignores the value of the
+variable 'x-gtk-use-window-move'. The variable is now obsolete.
+
++++
+** Several functions that create or rename files now treat their
+destination argument specially only when it is a directory name, i.e.,
+when it ends in '/' on GNU and other POSIX-like systems. When the
+destination argument D of one of these functions is an existing
+directory and the intent is to act on an entry in that directory, D
+should now be a directory name. For example, (rename-file "e" "f/")
+renames to 'f/e'. Although this formerly happened sometimes even when
+D was not a directory name, as in (rename-file "e" "f") where 'f'
+happened to be a directory, the old behavior often contradicted the
+documentation and had inherent races that led to security holes. A
+call like (rename-file C D) that used the old, undocumented behavior
+can be written as (rename-file C (file-name-as-directory D)), a
+formulation portable to both older and newer versions of Emacs.
+Affected functions include 'add-name-to-file', 'copy-directory',
+'copy-file', 'format-write-file', 'gnus-copy-file',
+'make-symbolic-link', 'rename-file', 'thumbs-rename-images', and
+'write-file'.
+
+---
+** The list returned by 'overlays-at' is now in decreasing priority order.
+The documentation of this function always said the order should be
+that of decreasing priority, if the 2nd argument of the function is
+non-nil, but the code returned the list in the increasing order of
+priority instead. Now the code does what the documentation says it
+should do.
+
++++
+** 'format' now avoids allocating a new string in more cases.
+'format' was previously documented to return a newly-allocated string,
+but this documentation was not correct, as (eq x (format x)) returned
+t when x was the empty string. 'format' is no longer documented to
+return a newly-allocated string, and the implementation now takes
+advantage of the doc change to avoid making copies of strings in
+common cases like (format "foo") and (format "%s" "foo").
+
+---
+** The function 'eldoc-message' now accepts a single argument.
+Programs that called it with multiple arguments before should pass
+them through 'format' first. Even that is discouraged: for ElDoc
+support, you should set 'eldoc-documentation-function' instead of
+calling 'eldoc-message' directly.
+
+
+* Lisp Changes in Emacs 26.1
+
++++
+** The function 'assoc' now takes an optional third argument TESTFN.
+This argument, when non-nil, is used for comparison instead of
+'equal'.
+
++++
+** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'.
+If non-nil, the argument specifies a function to use for comparison,
+instead of, respectively, 'assq' and 'eql'.
+
++++
+** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2
+contain the same elements, regardless of the order.
+
++++
+** The new function 'mapbacktrace' applies a function to all frames of
+the current stack trace.
+
++++
+** The new function 'file-name-case-insensitive-p' tests whether a
+given file is on a case-insensitive filesystem.
+
++++
+** Several accessors for the value returned by 'file-attributes'
+have been added. They are: 'file-attribute-type',
+'file-attribute-link-number', 'file-attribute-user-id',
+'file-attribute-group-id', 'file-attribute-access-time',
+'file-attribute-modification-time',
+'file-attribute-status-change-time', 'file-attribute-size',
+'file-attribute-modes', 'file-attribute-inode-number',
+'file-attribute-device-number' and 'file-attribute-collect'.
+
++++
+** The new function 'buffer-hash' computes a fast, non-consing hash of
+a buffer's contents.
+
++++
+** 'interrupt-process' now consults the list 'interrupt-process-functions',
+to determine which function has to be called in order to deliver the
+SIGINT signal. This allows Tramp to send the SIGINT signal to remote
+asynchronous processes. The hitherto existing implementation has been
+moved to 'internal-default-interrupt-process'.
+
++++
+** The new function 'read-multiple-choice' prompts for multiple-choice
+questions, with a handy way to display help texts.
+
+---
+** 'comment-indent-function' values may now return a cons to specify a
+range of indentation.
+
++++
+** New optional argument TEXT in 'make-temp-file'.
+
+---
+** New function 'define-symbol-prop'.
+
++++
+** New function 'secure-hash-algorithms' to list the algorithms that
+'secure-hash' supports.
+See the node "(elisp) Checksum/Hash" in the ELisp manual for details.
+
++++
+** Emacs now exposes the GnuTLS cryptographic API with the functions
+'gnutls-macs' and 'gnutls-hash-mac'; 'gnutls-digests' and
+'gnutls-hash-digest'; 'gnutls-ciphers' and 'gnutls-symmetric-encrypt'
+and 'gnutls-symmetric-decrypt'.
+See the node "(elisp) GnuTLS Cryptography" in the ELisp manual for details.
+
++++
+** The function 'gnutls-available-p' now returns a list of capabilities
+supported by the GnuTLS library used by Emacs.
+
++++
+** Emacs now supports records for user-defined types, via the new
+functions 'make-record', 'record', and 'recordp'. Records are now
+used internally to represent cl-defstruct and defclass instances, for
+example.
+
++++
+** 'save-some-buffers' now uses 'save-some-buffers-default-predicate'
+to decide which buffers to ask about, if the PRED argument is nil.
+The default value of 'save-some-buffers-default-predicate' is nil,
+which means ask about all file-visiting buffers.
+
+---
+** string-(to|as|make)-(uni|multi)byte are now declared obsolete.
+
++++
+** New variable 'while-no-input-ignore-events' which allow
+setting which special events 'while-no-input' should ignore.
+It is a list of symbols.
+
+---
+** New function 'undo-amalgamate-change-group' to get rid of
+undo-boundaries between two states.
+
+---
+** New var 'definition-prefixes' is a hash table mapping prefixes to
+the files where corresponding definitions can be found. This can be
+used to fetch definitions that are not yet loaded, for example for
+'C-h f'.
+
+---
+** New var 'syntax-ppss-table' to control the syntax-table used in
+'syntax-ppss'.
+
++++
+** 'define-derived-mode' can now specify an :after-hook form, which
+gets evaluated after the new mode's hook has run. This can be used to
+incorporate configuration changes made in the mode hook into the
+mode's setup.
+
+---
+** Autoload files can be generated without timestamps,
+by setting 'autoload-timestamps' to nil.
+FIXME As an experiment, nil is the current default.
+If no insurmountable problems before next release, it can stay that way.
+
+---
+** 'gnutls-boot' now takes a parameter ':complete-negotiation' that
+says that negotiation should complete even on non-blocking sockets.
+
+---
+** There is now a new variable 'flyspell-sort-corrections-function'
+that allows changing the way corrections are sorted.
+
+---
+** The new command 'fortune-message' has been added, which displays
+fortunes in the echo area.
+
++++
+** New function 'func-arity' returns information about the argument list
+of an arbitrary function. This generalizes 'subr-arity' for functions
+that are not built-in primitives. We recommend using this new
+function instead of 'subr-arity'.
+
+---
+** New function 'region-bounds' can be used in the interactive spec
+to provide region boundaries (for rectangular regions more than one)
+to an interactively callable function as a single argument instead of
+two separate arguments 'region-beginning' and 'region-end'.
+
++++
+** 'parse-partial-sexp' state has a new element. Element 10 is
+non-nil when the last character scanned might be the first character
+of a two character construct, i.e., a comment delimiter or escaped
+character. Its value is the syntax of that last character.
+
++++
+** 'parse-partial-sexp's state, element 9, has now been confirmed as
+permanent and documented, and may be used by Lisp programs. Its value
+is a list of currently open parenthesis positions, starting with the
+outermost parenthesis.
+
+---
+** 'read-color' will now display the color names using the color itself
+as the background color.
+
+---
+** The function 'redirect-debugging-output' now works on platforms
+other than GNU/Linux.
+
++++
+** The new function 'string-version-lessp' compares strings by
+interpreting consecutive runs of numerical characters as numbers, and
+compares their numerical values. According to this predicate,
+"foo2.png" is smaller than "foo12.png".
+
+---
+** Numeric comparisons and 'logb' no longer return incorrect answers
+due to internal rounding errors. For example, '(< most-positive-fixnum
+(+ 1.0 most-positive-fixnum))' now correctly returns t on 64-bit hosts.
+
+---
+** The functions 'ffloor', 'fceiling', 'ftruncate' and 'fround' now
+accept only floating-point arguments, as per their documentation.
+Formerly, they quietly accepted integer arguments and sometimes
+returned nonsensical answers, e.g., '(< N (ffloor N))' could return t.
+
+---
+** On hosts like GNU/Linux x86-64 where a 'long double' fraction
+contains at least EMACS_INT_WIDTH - 3 bits, 'format' no longer returns
+incorrect answers due to internal rounding errors when formatting
+Emacs integers with '%e', '%f', or '%g' conversions. For example, on
+these hosts '(eql N (string-to-number (format "%.0f" N)))' now returns
+t for all Emacs integers N.
+
+---
+** Calls that accept floating-point integers (for use on hosts with
+limited integer range) now signal an error if arguments are not
+integral. For example '(decode-char 'ascii 0.5)' now signals an error.
+
++++
+** The new function 'char-from-name' converts a Unicode name string
+to the corresponding character code.
+
++++
+** New functions 'sxhash-eq' and 'sxhash-eql' return hash codes of a
+Lisp object suitable for use with 'eq' and 'eql' correspondingly. If
+two objects are 'eq' ('eql'), then the result of 'sxhash-eq'
+('sxhash-eql') on them will be the same.
+
++++
+** Function 'sxhash' has been renamed to 'sxhash-equal' for
+consistency with the new functions. For compatibility, 'sxhash'
+remains as an alias to 'sxhash-equal'.
+
++++
+** 'make-hash-table' now defaults to a rehash threshold of 0.8125
+instead of 0.8, to avoid rounding glitches.
+
++++
+** New function 'add-variable-watcher' can be used to call a function
+when a symbol's value is changed. This is used to implement the new
+debugger command 'debug-on-variable-change'.
+
++++
+** Time conversion functions that accept a time zone rule argument now
+allow it to be OFFSET or a list (OFFSET ABBR), where the integer
+OFFSET is a count of seconds east of Universal Time, and the string
+ABBR is a time zone abbreviation. The affected functions are
+'current-time-string', 'current-time-zone', 'decode-time',
+'format-time-string', and 'set-time-zone-rule'.
+
++++
+** 'format-time-string' now formats '%q' to the calendar quarter.
+
++++
+** New built-in function 'mapcan'.
+It avoids unnecessary consing (and garbage collection).
+
++++
+** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp.
+
++++
+** 'gensym' is now part of Elisp.
+
+---
+** Low-level list functions like 'length' and 'member' now do a better
+job of signaling list cycles instead of looping indefinitely.
+
++++
+** The new functions 'make-nearby-temp-file' and 'temporary-file-directory'
+can be used for creation of temporary files on remote or mounted directories.
+
++++
+** On GNU platforms when operating on a local file, 'file-attributes'
+no longer suffers from a race when called while another process is
+altering the filesystem. On non-GNU platforms 'file-attributes'
+attempts to detect the race, and returns nil if it does so.
+
++++
+** The new function 'file-local-name' can be used to specify arguments
+of remote processes.
+
++++
+** The new functions 'file-name-quote', 'file-name-unquote' and
+'file-name-quoted-p' can be used to quote / unquote file names with
+the prefix "/:".
+
++++
+** The new error 'file-missing', a subcategory of 'file-error', is now
+signaled instead of 'file-error' if a file operation acts on a file
+that does not exist.
+
++++
+** The function 'delete-directory' no longer signals an error when
+operating recursively and when some other process deletes the directory
+or its files before 'delete-directory' gets to them.
+
++++
+** New error type 'user-search-failed' like 'search-failed' but
+avoids debugger like 'user-error'.
+
++++
+** The function 'line-number-at-pos' now takes a second optional
+argument 'absolute'. If this parameter is nil, the default, this
+function keeps on returning the line number taking potential narrowing
+into account. If this parameter is non-nil, the function ignores
+narrowing and returns the absolute line number.
+
+---
+** The function 'color-distance' now takes a second optional argument
+'metric'. When non-nil, it should be a function of two arguments that
+accepts two colors and returns a number.
+
+** Changes in Frame and Window Handling
+
++++
+*** Resizing a frame no longer runs 'window-configuration-change-hook'.
+'window-size-change-functions' should be used instead.
+
++++
+*** The new function 'frame-size-changed-p' can tell whether a frame has
+been resized since the last time 'window-size-change-functions' has been
+run.
+
++++
+*** The function 'frame-geometry' now also returns the width of a
+frame's outer border.
+
++++
+*** New frame parameters and changed semantics for older ones:
+
++++
+**** 'z-group' positions a frame above or below all others.
+
++++
+**** 'min-width' and 'min-height' specify the absolute minimum size of a
+frame.
+
++++
+**** 'parent-frame' makes a frame the child frame of another Emacs
+frame. The section "(elisp) Child Frames" in the ELisp manual
+describes the intrinsics of that relationship.
+
++++
+**** 'delete-before' triggers deletion of one frame before that of
+another.
+
++++
+**** 'mouse-wheel-frame' specifies another frame whose windows shall be
+scrolled instead.
+
++++
+**** 'no-other-frame' has 'next-frame' and 'previous-frame' skip this
+frame.
+
++++
+**** 'skip-taskbar' removes a frame's icon from the taskbar and has
+'Alt-<TAB>' skip this frame.
+
++++
+**** 'no-focus-on-map' avoids that a frame gets input focus when mapped.
+
++++
+**** 'no-accept-focus' means that a frame does not want to get input
+focus via the mouse.
+
++++
+**** 'undecorated' removes the window manager decorations from a frame.
+
++++
+**** 'override-redirect' tells the window manager to disregard this
+frame.
+
++++
+**** 'width' and 'height' allow to specify pixel values and ratios now.
+
++++
+**** 'left' and 'top' allow to specify ratios now.
+
++++
+**** 'keep-ratio' preserves size and position of child frames when their
+parent frame is resized.
+
++++
+**** 'no-special-glyphs' suppresses display of truncation and
+continuation glyphs in a frame.
+
++++
+**** 'auto-hide-function' and 'minibuffer-exit' handle auto hiding of
+frames and exiting from minibuffer individually.
+
++++
+**** 'fit-frame-to-buffer-margins' and 'fit-frame-to-buffer-sizes'
+handle fitting a frame to its buffer individually.
+
++++
+**** 'drag-internal-border', 'drag-with-header-line',
+'drag-with-mode-line', 'snap-width', 'top-visible' and 'bottom-visible'
+allow to drag and resize frames with the mouse.
+
++++
+**** 'minibuffer' is now set to the default minibuffer window when
+initially specified as nil and is not reset to nil when initially
+specifying a minibuffer window.
+
+*** The new function 'frame-list-z-order' returns a list of all frames
+in Z (stacking) order.
+
++++
+*** The function 'x-focus-frame' optionally tries to not activate its
+frame.
+
++++
+*** The variable 'focus-follows-mouse' has a third meaningful value
+'auto-raise' to indicate that the window manager automatically raises a
+frame when the mouse pointer enters it.
+
++++
+*** The new function 'frame-restack' puts a frame above or below
+another on the display.
+
++++
+*** The new face 'internal-border' specifies the background of a frame's
+internal border.
+
++++
+*** The NORECORD argument of 'select-window' now has a meaningful value
+'mark-for-redisplay' which is like any other non-nil value but marks
+WINDOW for redisplay.
+
++++
+*** Support for side windows is now official. The display action
+function 'display-buffer-in-side-window' will display its buffer in a
+side window. Functions for toggling all side windows on a frame,
+changing and reversing the layout of side windows and returning the
+main (major non-side) window of a frame are provided. For details
+consult the section "(elisp) Side Windows" in the ELisp manual.
+
++++
+*** Support for atomic windows - rectangular compositions of windows
+treated by 'split-window', 'delete-window' and 'delete-other-windows'
+like a single live window - is now official. For details consult the
+section "(elisp) Atomic Windows" in the ELisp manual.
+
++++
+*** New 'display-buffer' alist entry 'window-parameters' allows to
+assign window parameters to the window used for displaying the buffer.
+
++++
+*** New function 'display-buffer-reuse-mode-window' is an action function
+suitable for use in 'display-buffer-alist'. For example, to avoid
+creating a new window when opening man pages when there's already one,
+use
+
+(add-to-list 'display-buffer-alist
+ '("\\`\\*Man .*\\*\\'" .
+ (display-buffer-reuse-mode-window
+ (inhibit-same-window . nil)
+ (mode . Man-mode))))
+
++++
+*** New window parameter 'no-delete-other-windows' prevents that
+its window gets deleted by 'delete-other-windows'.
+
++++
+*** New window parameters 'mode-line-format' and 'header-line-format'
+allow to override the buffer-local formats for this window.
+
++++
+*** New command 'window-swap-states' swaps the states of two live
+windows.
+
++++
+*** New functions 'window-pixel-width-before-size-change' and
+'window-pixel-height-before-size-change' support detecting which
+window changed size when 'window-size-change-functions' are run.
+
++++
+*** The new function 'window-lines-pixel-dimensions' returns the pixel
+dimensions of a window's text lines.
+
++++
+*** The new function 'window-largest-empty-rectangle' returns the
+dimensions of the largest rectangular area not occupying any text in a
+window's body.
+
++++
+*** The semantics of 'mouse-autoselect-window' has changed slightly.
+For details see the section "(elisp) Mouse Window Auto-selection" in
+the ELisp manual.
+
+---
+*** 'select-frame-by-name' now may return a frame on another display
+if it does not find a suitable one on the current display.
+
+---
+** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality
+can be replicated simply by setting 'comment-auto-fill-only-comments'.
+
+** New pcase pattern 'rx' to match against an rx-style regular expression.
+For details, see the doc string of 'rx--pcase-macroexpander'.
+
+---
+** New functions to set region from secondary selection and vice versa.
+The new functions 'secondary-selection-to-region' and
+'secondary-selection-from-region' let you set the beginning and the
+end of the region from those of the secondary selection and vice
+versa.
+
+** New function 'lgstring-remove-glyph' can be used to modify a
+gstring returned by the underlying layout engine (e.g. m17n-flt,
+uniscribe).
+
+
+* Changes in Emacs 26.1 on Non-Free Operating Systems
+
++++
+** Intercepting hotkeys on Windows 7 and later now works better.
+The new keyboard hooking code properly grabs system hotkeys such as
+'Win-*' and 'Alt-TAB', in a way that Emacs can get at them before the
+system. This makes the 'w32-register-hot-key' functionality work
+again on all versions of MS-Windows starting with Windows 7. On
+Windows NT and later you can now register any hotkey combination. (On
+Windows 9X, the previous limitations, spelled out in the Emacs manual,
+still apply.)
+
+---
+** 'convert-standard-filename' no longer mirrors slashes on MS-Windows.
+Previously, on MS-Windows this function converted slash characters in
+file names into backslashes. It no longer does that. If your Lisp
+program used 'convert-standard-filename' to prepare file names to be
+passed to subprocesses (which is not the recommended usage of that
+function), you will now have to mirror slashes in your application
+code. One possible way is this:
+
+ (let ((start 0))
+ (while (string-match "/" file-name start)
+ (aset file-name (match-beginning 0) ?\\)
+ (setq start (match-end 0))))
+
+---
+** GUI sessions on MS-Windows now treat SIGINT like Posix platforms do.
+The effect of delivering a Ctrl-C (SIGINT) signal to a GUI Emacs on
+MS-Windows is now the same as on Posix platforms -- Emacs saves the
+session and exits. In particular, this will happen if you start
+emacs.exe from the Windows shell, then type Ctrl-C into that shell's
+window.
+
+---
+** 'signal-process' supports SIGTRAP on Windows XP and later.
+The 'kill' emulation on Windows now maps SIGTRAP to a call to the
+'DebugBreakProcess' API. This causes the receiving process to break
+execution and return control to the debugger. If no debugger is
+attached to the receiving process, the call is typically ignored.
+This is in contrast to the default action on POSIX Systems, where it
+causes the receiving process to terminate with a core dump if no
+debugger has been attached to it.
+
+---
+** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work
+on macOS.
+
+---
+** Emacs can now be run as a GUI application from the command line on
+macOS.
+
++++
+** 'ns-appearance' and 'ns-transparent-titlebar' change the appearance
+of frame decorations on macOS 10.9+.
+
+---
+** 'ns-use-thin-smoothing' enables thin font smoothing on macOS 10.8+.
+
+---
+** 'process-attributes' on Darwin systems now returns more information.
+
+---
+** Mousewheel and trackpad scrolling on macOS 10.7+ now behaves more
+like the macOS default. The new variables 'ns-mwheel-line-height',
+'ns-use-mwheel-acceleration' and 'ns-use-mwheel-momentum' can be used
+to customize the behavior.
+
+
+----------------------------------------------------------------------
+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/>.
+
+
+Local variables:
+coding: utf-8
+mode: outline
+paragraph-separate: "[ ]*$"
+end:
diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP
index d3e4828f89a..f657e04ae1f 100644
--- a/etc/NEXTSTEP
+++ b/etc/NEXTSTEP
@@ -310,4 +310,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/NXML-NEWS b/etc/NXML-NEWS
index edf7c137423..751ed374a73 100644
--- a/etc/NXML-NEWS
+++ b/etc/NXML-NEWS
@@ -220,4 +220,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 38df7b2bd87..7ed839a1847 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -1,17 +1,1858 @@
ORG NEWS -- history of user-visible changes. -*- mode: org; coding: utf-8 -*-
#+LINK: doc http://orgmode.org/worg/doc.html#%s
-#+LINK: git http://orgmode.org/w/?p=org-mode.git;a=commit;h=%s
+#+LINK: git http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=%s
Copyright (C) 2012-2017 Free Software Foundation, Inc.
See the end of the file for license conditions.
-Please send Org bug reports to emacs-orgmode@gnu.org.
+Please send Org bug reports to mailto:emacs-orgmode@gnu.org.
-* Version 8.2.3
+* Version 9.1
** Incompatible changes
+*** Variables relative to clocksum duration are obsolete
+
+~org-time-clocksum-format~, ~org-time-clocksum-use-fractional~ and
+~org-time-clocksum-fractional-format~ are obsolete. If you changed
+them, consider modifying ~org-duration-format~ instead.
+
+Variable ~org-time-clocksum-use-effort-durations~ is also obsolete.
+Consider setting ~org-duration-units~ instead.
+
+*** ~org-at-timestamp-p~ optional argument accepts different values
+
+See docstrings for the allowed values. For backward compatibility,
+~(org-at-timestamp-p t)~ is still supported, but should be updated
+accordingly.
+
+*** ~org-capture-templates~ no longer accepts S-expressions as file names
+
+Since functions are allowed there, a straightforward way to migrate
+is to turn, e.g.,
+
+: (file (sexp))
+
+into
+
+: (file (lambda () (sexp)))
+
+*** Deleted contributed packages
+
+=org-ebib.el, =org-bullets.el= and =org-mime.el= have been deleted
+from the contrib/ directory.
+
+You can now find them here :
+
+- https://github.com/joostkremers/ebib
+- https://github.com/sabof/org-bullets
+- https://github.com/org-mime/org-mime
+
+*** Change ~org-texinfo-classes~ value
+The value cannot support functions to create sectioning commands
+anymore. Also, the sectioning commands should include commands for
+appendices. See the docstring for more information.
+*** Removal of ~:sitemap-sans-extension~
+
+The publishing property is no longer recognized, as a consequence of
+changes to site-map generation.
+
+You can get the same functionality by setting ~:sitemap-format-entry~
+to the following
+
+#+BEGIN_SRC elisp
+(lambda (entry style project)
+ (cond ((not (directory-name-p entry))
+ (format "[[file:%s][%s]]"
+ (file-name-sans-extension entry)
+ (org-publish-find-title entry project)))
+ ((eq style 'tree) (file-name-nondirectory (directory-file-name entry)))
+ (t entry)))
+#+END_SRC
+
+*** Change signature for ~:sitemap-function~
+
+~:sitemap-function~ now expects to be called with two arguments. See
+~org-publish-project-alist~ for details.
+
+*** Change signature for some properties in ~org-list-to-generic~
+
+~:istart~, ~:icount~, ~:iend~ and ~:isep~ now expect the type of the
+list as their first argument.
+
+*** Change signature for ~org-get-repeater~
+The optional argument is now a string to extract the repeater from.
+See docstring for details.
+
+*** Change signature for ~org-time-string-to-time~
+See docstring for changes.
+
+*** Change order of items in ~org-agenda-time-grid~
+~org-agenda-time-grid~ gained an extra item to allow users to customize
+the string displayed after times in the agenda. See docstring for
+details.
+
+*** ~tags-todo~ custom searches now include DONE keywords
+
+Use "/!" markup when filtering TODO keywords to get only not-done TODO
+keywords.
+
+*** ~org-split-string~ returns ~("")~ when called on an empty string
+It used to return nil.
+*** Removal of =ob-scala.el=
+
+See [[https://github.com/ensime/emacs-scala-mode/issues/114][this github issue]].
+
+You can use =ob-scala.el= as packaged in scala-mode, available from the
+MELPA repository.
+
+** New features
+*** iCalendar export uses inheritance for TIMEZONE and LOCATION properties
+Both these properties can be inherited during iCalendar export,
+depending on the value of ~org-use-property-inheritance~.
+*** iCalendar export respects a TIMEZONE property
+Set the TIMEZONE property on an entry to specify a time zone for that
+entry only during iCalendar export. The property value should be
+specified as in "Europe/London".
+*** ~org-attach~ can move directory contents
+When setting a new directory for an entry, org-attach offers to move
+files over from the old directory. Using a prefix arg will reset the
+directory to old, ID based one.
+*** New Org duration library
+This new library implements tools to read and print time durations in
+various formats (e.g., "H:MM", or "1d 2h 3min"...).
+
+See ~org-duration-to-minutes~ and ~org-duration-from-minutes~
+docstrings.
+
+*** Agenda
+**** New variable : ~org-agenda-show-future-repeats~
+**** New variable : ~org-agenda-prefer-last-repeat~
+**** New variable : ~org-deadline-past-days~
+See docstring for details.
+**** Binding C-c C-x < for ~org-agenda-set-restriction-lock-from-agenda~
+**** New auto-align default setting for =org-agenda-tags-column=
+
+=org-agenda-tags-column= can now be set to =auto=, which will
+automatically align tags to the right edge of the window. This is now
+the default setting.
+
+*** New value for ~org-publish-sitemap-sort-folders~
+
+The new ~ignore~ value effectively allows toggling inclusion of
+directories in published site-maps.
+
+*** Babel
+
+**** Scheme: support for tables
+**** Scheme: new variable: ~org-babel-scheme-null-to~
+
+This new custom option allows to use a empty list or null symbol to
+format the table output, initially assigned to ~hlines~.
+
+**** Scheme: new header ~:prologue~
+
+A new block code header has been created for Org Babel that enables
+developers to prepend code to the scheme block being processed.
+
+Multiple ~:prologue~ headers can be added each of them using a string
+with the content to be added.
+
+The scheme blocks are prepared by surrounding the code in the block
+with a let form. The content of the ~:prologue~ headers are prepended
+before this let form.
+
+**** Support for hledger accounting reports added
+**** Clojure: new setting ~org-babel-clojure-sync-nrepl-timeout~
+
+Creation of a new setting to specify the Cider timeout. By setting
+the =org-babel-clojure-sync-nrepl-timeout= setting option. The value
+is in seconds and if set to =nil= then no timeout will occur.
+**** Clojure: new header ~:show-process~
+
+A new block code header has been created for Org Babel that enables
+developers to output the process of an ongoing process into a new
+window/buffer.
+
+You can tell Org Babel to output the process of a running code block.
+
+To show that output you only have to specify the =:show-process=
+option in the code block's header like this:
+
+#+begin_example
+,#+BEGIN_SRC clojure :results output :show-process t
+ (dotimes [n 10]
+ (println n ".")
+ (Thread/sleep 500))
+,#+END_SRC
+#+end_example
+
+If =:show-process= is specified that way, then when you will run the
+code using =C-c C-c= a new window will open in Emacs. Everything that
+is output by the REPL will immediately be added to that new window.
+
+When the processing of the code is finished, then the window and its
+buffer will be closed and the results will be reported in the
+=#+RESULTS= section.
+
+Note that the =:results= parameter's behavior is *not* changed. If
+=silent= is specified, then no result will be displayed. If =output=
+is specified then all the output from the window will appears in the
+results section. If =value= is specified, then only the last returned
+value of the code will be displayed in the results section.
+
+**** Maxima: new headers ~:prologue~ and ~:epilogue~
+Babel options ~:prologue~ and ~:epilogue~ have been implemented for
+Maxima src blocks which prepend and append, respectively, the given
+code strings. This can be useful for specifying formatting settings
+which would add clutter to exported code. For instance, you can use
+this ~:prologue "fpprintprec: 2; linel: 50;"~ for presenting Maxima
+results in a beamer presentation.
+**** PlantUML: add support for header arguments
+
+[[http://plantuml.com/][Plantuml]] source blocks now support the [[http://orgmode.org/manual/prologue.html#prologue][~:prologue~]], [[http://orgmode.org/manual/epilogue.html#epilogue][~:epilogue~]] and
+[[http://orgmode.org/manual/var.html#var][~:var~]] header arguments.
+
+**** SQL: new engine added ~sqsh~
+
+A new engine was added to support ~sqsh~ command line utility for use
+against Microsoft SQL Server or Sybase SQL server.
+
+More information on ~sqsh~ can be found here: [[https://sourceforge.net/projects/sqsh/][sourceforge/sqsh]]
+
+To use ~sqsh~ in an *sql* =SRC_BLK= set the =:engine= like this:
+
+#+begin_example
+,#+BEGIN_SRC sql :engine sqsh :dbhost my_host :dbuser master :dbpassword pass :database support
+Select * From Users
+Where clue > 0
+,#+END_SRC
+#+end_example
+
+**** SQL: new engine added =vertica=
+
+A new engine was added to support vsql command line utility for use
+against HP Vertica.
+
+More information on =vsql= can be found here: [[https://my.vertica.com/docs/7.2.x/HTML/index.htm#Authoring/ConnectingToHPVertica/vsql/UsingVsql.htm][my.vertica.com]]
+
+To use =vertica= in an sql =SRC_BLK= set the =:engine= like this:
+
+#+BEGIN_EXAMPLE
+ ,#+BEGIN_SRC sql :engine vertica :dbhost my_host :dbuser dbadmin :dbpassword pw :database vmart
+ SELECT * FROM nodes;
+ ,#+END_SRC
+#+END_EXAMPLE
+**** C++: New header ~:namespaces~
+
+The new ~:namespaces~ export option can be used to specify namespaces
+to be used within a C++ org source block. Its usage is similar to
+~:includes~, in that it can accept multiple, space-separated
+namespaces to use. This header is equivalent to adding ~using
+namespace <name>;~ in the source block. Here is a "Hello World" in C++
+using ~:namespaces~:
+
+#+begin_example
+ ,#+BEGIN_SRC C++ :results output :namespaces std :includes <iostream>
+ cout << "Hello World" << endl;
+ ,#+END_SRC
+#+end_example
+
+**** Support for Vala language
+
+[[https://wiki.gnome.org/Projects/Vala][Vala]] language blocks support two special header arguments:
+
+- ~:flags~ passes arguments to the compiler
+- ~:cmdline~ passes commandline arguments to the generated executable
+
+Support for [[http://orgmode.org/manual/var.html#var][~:var~]] does not exist yet, also there is no [[http://orgmode.org/manual/session.html#session][~:session~]]
+support because Vala is a compiled language.
+
+The Vala compiler binary can be changed via the ~defcustom~
+~org-babel-vala-compiler~.
+
+*** New ~function~ scope argument for the Clock Table
+Added a nullary function that returns a list of files as a possible
+argument for the scope of the clock table.
+*** Export
+**** Implement vernacular table of contents in Markdown exporter
+Global table of contents are generated using vanilla Markdown syntax
+instead of HTML. Also #+TOC keyword, including local table of
+contents, are now supported.
+**** Add Slovenian translations
+**** Implement ~org-export-insert-image-links~
+This new function is meant to be used in back-ends supporting images
+as descriptions of links, a.k.a. image links. See its docstring for
+details.
+**** New macro : ~{{{n}}}~
+This macro creates and increment multiple counters in a document. See
+manual for details.
+**** Add global macros through ~org-export-global-macros~
+With this variable, one can define macros available for all documents.
+**** New keyword ~#+EXPORT_FILE_NAME~
+Similarly to ~:EXPORT_FILE_NAME:~ property, this keyword allows the
+user to specify the name of the output file upon exporting the
+document. This also has an effect on publishing.
+**** Horizontal rules are no longer ignored in LaTeX table math mode
+**** Use ~compilation-mode~ for compilation output
+**** Plain lists accept a new ~:separator~ attribute in Texinfo
+
+The new ~:separator~ attribute splits a tag from a description list
+item into multiple parts. This allows to have two-column tables with
+multiple entries in the first column. See manual for more details.
+
+**** ~latex-environment~ elements support ~caption~ keywords for LaTeX export
+*** ~org-edit-special~ can edit LaTeX environments
+
+Using ~C-c '~ on a LaTeX environment opens a sub-editing buffer. By
+default, major mode in that buffer is ~latex-mode~, but it can be
+changed by configuring ~org-src-lang-modes~.
+
+*** ~org-list-to-generic~ includes a new property: ~:ifmt~
+
+~:ifmt~ is a function to be called on the body of each item. See
+~org-list-to-generic~ documentation for details.
+
+*** New variable : ~org-bibtex-headline-format-function~
+This allow to use a different title than entry title.
+
+*** ~org-attach~ supports attaching files from URLs
+
+Using ~C-c C-a u~ prompts for a URL pointing to a file to be attached
+to the document.
+
+*** New option for ~org-refile-use-outline-path~
+~org-refile-use-outline-path~ now supports the setting ~buffer-name~,
+which causes refile targets to be prefixed with the buffer’s
+name. This is particularly useful when used in conjunction with
+~uniquify.el~.
+
+*** ~org-file-contents~ now allows the FILE argument to be a URL.
+This allows ~#+SETUPFILE:~ to accept a URL instead of a local file
+path. The URL contents are auto-downloaded and saved to a temporary
+cache ~org--file-cache~. A new optional argument ~NOCACHE~ is added
+to ~org-file-contents~.
+
+*** ~org-mode-restart~ now resets the newly added ~org--file-cache~.
+Using ~C-c C-c~ on any keyword (like ~#+SETUPFILE~) will reset the
+that file cache.
+
+*** New option : ~org-table-duration-hour-zero-padding~
+This variable allow computed durations in tables to be zero-padded.
+
+*** New mode switch for table formulas : =U=
+This mode omits seconds in durations.
+
+** Removed functions
+
+*** Org Timeline
+
+This feature has been removed. Use a custom agenda view, possibly
+narrowed to current buffer to achieve a similar functionality.
+
+*** ~org-agenda-skip-entry-when-regexp-matches~ is obsolete
+
+Use ~org-agenda-skip-if~ instead.
+
+*** ~org-agenda-skip-subtree-when-regexp-matches~ is obsolete
+
+Use ~org-agenda-skip-if~ instead.
+
+*** ~org-agenda-skip-entry-when-regexp-matches-in-subtree~ is obsolete
+
+Use ~org-agenda-skip-if~ instead.
+
+*** ~org-minutes-to-clocksum-string~ is obsolete
+
+Use ~org-duration-from-minutes~ instead.
+
+*** ~org-hh:mm-string-to-minutes~ is obsolete
+
+Use ~org-duration-to-minutes~ instead.
+
+*** ~org-duration-string-to-minutes~ is obsolete
+
+Use ~org-duration-to-minutes~ instead.
+
+*** ~org-gnus-nnimap-cached-article-number~ is removed.
+
+This function relied on ~nnimap-group-overview-filename~, which was
+removed from Gnus circa September 2010.
+
+** Removed options
+
+*** ~org-agenda-repeating-timestamp-show-all~ is removed.
+
+For an equivalent to a ~nil~ value, set
+~org-agenda-show-future-repeats~ to nil and
+~org-agenda-prefer-last-repeat~ to ~t~.
+
+*** ~org-gnus-nnimap-query-article-no-from-file~ is removed.
+
+This variable has no effect, as it was relying on a function that was
+removed from Gnus circa September 2010.
+
+*** ~org-usenet-links-prefer-google~ is obsolete.
+
+Use ~org-gnus-prefer-web-links~ instead.
+
+*** ~org-publish-sitemap-file-entry-format~ is deprecated
+
+One can provide new ~:sitemap-format-entry~ property for a function
+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
+keys).
+
+*** ~org-export-use-babel~ cannot be set to ~inline-only~
+
+The variable is now a boolean.
+
+*** ~org-texinfo-def-table-markup~ is obsolete
+
+Use ~org-texinfo-table-default-markup~ instead.
+
+** New functions
+
+*** ~org-publish-find-property~
+
+This function can be used as a tool to format entries in a site-map,
+in addition to ~org-publish-find-title~ and ~org-publish-find-date~.
+
+*** ~org-list-to-org~
+
+It is the reciprocal of ~org-list-to-lisp~, which see.
+
+*** ~org-agenda-set-restriction-lock-from-agenda~
+
+Call ~org-agenda-set-restriction-lock~ from the agenda.
+
+** Miscellaneous
+
+*** The Library of Babel now on Worg
+
+The library-of-babel.org used to be accessible from the =doc/=
+directory, distributed with Org’s core. It is now accessible
+from the Worg community-driven documentation [[http://orgmode.org/worg/library-of-babel.html][here]].
+
+If you want to contribute to it, please see [[http://orgmode.org/worg/org-contribute.html][how to contribute]].
+
+*** Allow multiple columns view
+
+Columns view is not limited to a single buffer anymore.
+*** Org Attach obeys ~dired-dwim-target~
+
+When a Dired buffer is opened next to the Org document being edited,
+the prompt for file to attach can start in the Dired buffer's
+directory if `dired-dwim-target' in non-nil.
+
+*** ~org-fill-paragraph~ can now fill a whole region
+*** More specific anniversary descriptions
+
+Anniversary descriptions (used in the agenda view, for instance)
+include the point in time, when the anniversary appears. This is,
+in its most general form, just the date of the anniversary. Or
+more specific terms, like "today", "tomorrow" or "in n days" are
+used to describe the time span.
+
+This feature allows to automatically change the description of an
+anniversary, depending on if it occurs in the next few days or
+far away in the future.
+
+*** Computed dates in tables appear as inactive time stamps
+
+*** Save point before opening a file with an unknown search option
+
+When following a file link with a search option (e.g., =::#custom-id=)
+that doesn't exist in the target file, save position before raising an
+error. As a consequence, it is possible to jump back to the original
+document with ~org-mark-ring-goto~ (default binding =C-c &=).
+
+*** ~org-get-heading~ accepts two more optional arguments
+
+See docstring for details.
+
+*** New option ~org-babel-uppercase-example-markers~
+
+This variable is a ~defcustom~ and replaces the variable
+~org-babel-capitalize-example-region-markers~, which is a ~defvar~ and
+is now obsolete.
+*** =INCLUDE= keywords in commented trees are now ignored.
+*** Default value for ~org-texinfo-text-markup-alist~ changed.
+
+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 src 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.
+
+*** Add (C) =COMMENT= support to ~org-structure-template-alist~
+
+* Version 9.0
+
+** Incompatible changes
+
+*** Emacs 23 support has been dropped
+
+From now on, Org expects at least Emacs 24.3, although Emacs 24.4 or
+above is suggested.
+
+*** XEmacs support has been dropped
+
+Incomplete compatibility layer with XEmacs has been removed. If you
+want to take over maintenance of this compatibility, please contact
+our mailing list.
+
+*** New syntax for export blocks
+
+Export blocks are explicitly marked as such at the syntax level to
+disambiguate their parsing from special blocks. The new syntax is
+
+#+BEGIN_SRC org
+,#+BEGIN_EXPORT backend
+...
+,#+END_EXPORT
+#+END_SRC
+
+instead of
+
+#+BEGIN_SRC org
+,#+BEGIN_backend
+...
+,#+END_backend
+#+END_SRC
+
+As a consequence, =INCLUDE= keywords syntax is modified, e.g.,
+
+#+BEGIN_SRC org
+,#+INCLUDE: "file.org" HTML
+#+END_SRC
+
+becomes
+
+#+BEGIN_SRC org
+,#+INCLUDE: "file.org" export html
+#+END_SRC
+
+The following function repairs export blocks and =INCLUDE= keywords
+using previous syntax:
+
+#+BEGIN_SRC emacs-lisp
+(defun org-repair-export-blocks ()
+ "Repair export blocks and INCLUDE keywords in current buffer."
+ (interactive)
+ (when (eq major-mode 'org-mode)
+ (let ((case-fold-search t)
+ (back-end-re (regexp-opt
+ '("HTML" "ASCII" "LATEX" "ODT" "MARKDOWN" "MD" "ORG"
+ "MAN" "BEAMER" "TEXINFO" "GROFF" "KOMA-LETTER")
+ t)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((block-re (concat "^[ \t]*#\\+BEGIN_" back-end-re)))
+ (save-excursion
+ (while (re-search-forward block-re nil t)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type element) 'special-block)
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (save-match-data (search-backward "_"))
+ (forward-char)
+ (insert "EXPORT")
+ (delete-region (point) (line-end-position)))
+ (replace-match "EXPORT \\1" nil nil nil 1))))))
+ (let ((include-re
+ (format "^[ \t]*#\\+INCLUDE: .*?%s[ \t]*$" back-end-re)))
+ (while (re-search-forward include-re nil t)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (and (eq (org-element-type element) 'keyword)
+ (string= (org-element-property :key element) "INCLUDE"))
+ (replace-match "EXPORT \\1" nil nil nil 1)))))))))
+#+END_SRC
+
+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
+
+**** [1]-like constructs are not valid footnotes
+
+Using =[1]= as a footnote was already discouraged in the manual, since
+it introduced too many false-positives in many Org documents. These
+constructs are now unsupported.
+
+If you used =[N]= in some of your documents, consider turning them into
+=[fn:N]=.
+
+**** /Org Footnote/ library doesn't handle non-Org buffers
+
+Commands for footnotes in an Org document no longer try to do
+something in non-Org ones. If you need to have footnotes there,
+consider using the =footnote.el= library, shipped with Emacs.
+
+In particular, ~org-footnote-tag-for-non-org-mode-files~ no longer
+exists.
+
+*** ~org-file-apps~ no longer accepts S-expressions as commands
+
+The variable now accepts functions of two arguments instead of plain
+S-expressions. Replacing an S-expression with an appropriate function
+is straightforward. For example
+
+: ("pdf" . (foo))
+
+becomes
+
+: ("pdf" . (lambda (file link) (foo)))
+
+*** The ~{{{modification-time}}}~ macro can get time via =vc=
+
+The modification time will be determined via =vc.el= if the second
+argument is non-nil. See the manual for details.
+
+*** Preparation and completion functions in publishing projects change signature
+
+Preparation and completion functions are now called with an argument,
+which is the project property list. It used to be dynamically scoped
+through the ~project-plist~ variable.
+
+*** Old Babel header properties are no longer supported
+
+Using header arguments as property names is no longer possible. As
+such, the following
+
+#+BEGIN_EXAMPLE
+,* Headline
+:PROPERTIES:
+:exports: code
+:var: a=1 b=2
+:var+: c=3
+:END:
+#+END_EXAMPLE
+
+should be written instead
+
+#+BEGIN_EXAMPLE
+,* Headline
+:PROPERTIES:
+:header-args: :exports code
+:header-args+: :var a=1 b=2
+:header-args+: :var c=3
+:END:
+#+END_EXAMPLE
+
+Please note that, however, old properties were defined at the source
+block definition. Current ones are defined where the block is called.
+
+** New features
+
+*** ~org-eww~ has been moved into core
+*** New org-protocol key=value syntax
+
+Org-protocol can now handle query-style parameters such as:
+
+#+begin_example
+org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
+org-protocol://capture?template=x&title=Hello&body=World&url=http:%2F%2Fexample.com
+#+end_example
+
+Old-style links such as
+: org-protocol://store-link:/http:%2F%2Flocalhost%2Findex.html/The%20title
+continue to be supported.
+
+If you have defined your own handler functions for
+~org-protocol-protocol-alist~, change them to accept either a property
+list (for new-style links) or a string (for old-style links). Use
+~org-protocol-parse-parameters~ to convert old-style links into property
+lists.
+
+*** New Org linter library
+
+~org-lint~ can check syntax and report common issues in Org documents.
+
+*** New option ~date-tree-last~ for ~org-agenda-insert-diary-strategy~
+
+When ~org-agenda-insert-diary-strategy~ is set to ~date-tree-last~, diary
+entries are added to last in the date tree.
+
+*** New ~vbar~ entity
+
+~\vbar~ or ~\vbar{}~ will be exported unconditionally as a =|=,
+unlike to existing ~\vert~, which is expanded as ~&vert;~ when using
+a HTML derived export back-end.
+
+*** Export
+
+**** New =#+latex_compiler= keyword to set LaTeX compiler.
+
+PDFLaTeX, XeLaTeX, and LuaLaTeX are supported. See the manual for
+details.
+
+**** New option ~org-export-with-broken-links~
+
+This option tells the export process how to behave when encountering
+a broken internal link. See its docstring for more information.
+
+**** Attributes support in custom language environments for LaTeX export
+
+Custom language environments for LaTeX export can now define the
+string to be inserted during export, using attributes to indicate the
+position of the elements. See variable ~org-latex-custom-lang-environments~
+for more details.
+
+**** New Texinfo ~options~ attribute on special blocks
+
+Using ~:options~ as a Texinfo attribute, it is possible to add
+information to custom environments. See manual for details.
+
+**** New HTML ~id~ attributes on special, example and quote blocks
+
+If the block has a =#+NAME:= attribute assigned, then the HTML element
+will have an ~id~ attribute with that name in the HTML export. This
+enables one to create links to these elements in other places, e.g.,
+~<a href="#name">text</a>~.
+
+**** Listings with captions are now numbered in HTML export
+
+The class associated to the numbering is "listing-number". If you
+don't want these blocks to be numbered, as it was the case until now,
+You may want to add ~.listing-number { display: none; }~ to the CSS
+used.
+
+**** Line Numbering in SRC/EXAMPLE blocks support arbitrary start number
+
+The ~-n~ option to ~SRC~ and ~EXAMPLE~ blocks can now take a numeric
+argument to specify the staring line number for the source or example
+block. The ~+n~ option can now take a numeric argument that will be
+added to the last line number from the previous block as the starting
+point for the SRC/EXAMPLE block.
+
+#+BEGIN_SRC org
+,#+BEGIN_SRC emacs-lisp -n 20
+;; this will export with line number 20
+(message "This is line 21")
+,#+END_SRC
+,#+BEGIN_SRC emacs-lisp +n 10
+;; This will be listed as line 31
+(message "This is line 32")
+,#+END_SRC
+#+END_SRC
+
+**** Allow toggling center for images in LaTeX export
+
+With the global variable ~org-latex-images-centered~ or the local
+attribute ~:center~ it is now possible to center an image in LaTeX
+export.
+
+**** Default CSS class ~org-svg~ for SVG images in HTML export
+
+SVG images exported in HTML are now by default assigned a CSS class
+~org-svg~ if no CSS class is specified with the ~:class~ attribute. By
+default, the CSS styling of class ~org-svg~ specifies an image width of
+90\thinsp{}% of the container the image.
+
+**** Markdown footnote export customization
+
+Variables ~org-md-footnotes-section~ and ~org-md-footnote-format~
+introduced for =ox-md.el=. Both new variables define template strings
+which can be used to customize the format of the exported footnotes
+section and individual footnotes, respectively.
+
+*** Babel
+
+**** Blocks with coderefs labels can now be evaluated
+
+The labels are removed prior to evaluating the block.
+
+**** Support for Lua language
+**** Support for SLY in Lisp blocks
+
+See ~org-babel-lisp-eval-fn~ to activate it.
+
+**** Support for Stan language
+
+New ob-stan.el library.
+
+Evaluating a Stan block can produce two different results.
+
+1. Dump the source code contents to a file.
+
+ This file can then be used as a variable in other blocks, which
+ allows interfaces like RStan to use the model.
+
+2. Compile the contents to a model file.
+
+ This provides access to the CmdStan interface. To use this, set
+ ~org-babel-stan-cmdstan-directory~ and provide a ~:file~ argument
+ that does not end in ".stan".
+
+For more information and usage examples, visit
+http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
+
+**** Support for Oracle databases via ~sqlplus~
+
+=ob-sql= library supports running SQL blocks against an Oracle
+database using ~sqlplus~. Use with properties like this (all
+mandatory):
+
+#+BEGIN_EXAMPLE
+:engine oracle
+:dbhost <host.com>
+:dbport <1521>
+:dbuser <username>
+:database <database>
+:dbpassword <secret>
+#+END_EXAMPLE
+
+**** Improved support to Microsoft SQL Server via ~sqlcmd~
+
+=ob-sql= library removes support to the ~msosql~ engine which uses the
+deprecated ~osql~ command line tool, and replaces it with ~mssql~
+engine which uses the ~sqlcmd~ command line tool. Use with properties
+like this:
+
+#+BEGIN_EXAMPLE
+:engine mssql
+:dbhost <host.com>
+:dbuser <username>
+:dbpassword <secret>
+:database <database>
+#+END_EXAMPLE
+
+If you want to use the *trusted connection* feature, omit *both* the
+=dbuser= and =dbpassword= properties and add =cmdline -E= to the properties.
+
+If your Emacs is running in a Cygwin environment, the =ob-sql= library
+can pass the converted path to the =sqlcmd= tool.
+
+**** Improved support of header arguments for postgresql
+
+The postgresql engine in a sql code block supports now ~:dbport~ nd
+~:dbpassword~ as header arguments.
+
+**** Support for additional plantuml output formats
+
+The support for output formats of [[http://plantuml.com/][plantuml]] has been extended to now
+include:
+
+All Diagrams:
+- png ::
+- svg ::
+- eps ::
+- pdf ::
+- vdx ::
+- txt :: ASCII art
+- utxt :: ASCII art using unicode characters
+
+Class Diagrams:
+- xmi ::
+- html ::
+
+State Diagrams:
+- scxml ::
+
+The output formats are determined by the file extension specified
+using the :file property, e.g.:
+
+#+begin_src plantuml :file diagram.png
+@startuml
+Alice -> Bob: Authentication Request
+Bob --> Alice: Authentication Response
+
+Alice -> Bob: Another authentication Request
+Alice <-- Bob: another authentication Response
+@enduml
+#+end_src
+
+Please note that *pdf* *does not work out of the box* and needs additional
+setup in addition to plantuml. See [[http://plantuml.com/pdf.html]] for
+details and setup information.
+
+*** Rewrite of radio lists
+
+Radio lists, i.e, Org plain lists in foreign buffers, have been
+rewritten to be on par with Radio tables. You can use a large set of
+parameters to control how a given list should be rendered. See manual
+for details.
+
+*** org-bbdb-anniversaries-future
+
+Used like ~org-bbdb-anniversaries~, it provides a few days warning for
+upcoming anniversaries (default: 7 days).
+
+*** Clear non-repeated SCHEDULED upon repeating a task
+
+If the task is repeated, and therefore done at least one, scheduling
+information is no longer relevant. It is therefore removed.
+
+See [[git:481719fbd5751aaa9c672b762cb43aea8ee986b0][commit message]] for more information.
+
+*** Support for ISO week trees
+
+ISO week trees are an alternative date tree format that orders entries
+by ISO week and not by month.
+
+For example:
+
+: * 2015
+: ** 2015-W35
+: ** 2015-W36
+: *** 2015-08-31 Monday
+
+They are supported in org-capture via ~file+weektree~ and
+~file+weektree+prompt~ target specifications.
+
+*** Accept ~:indent~ parameter when capturing column view
+
+When defining a "columnview" dynamic block, it is now possible to add
+an :indent parameter, much like the one in the clock table.
+
+On the other hand, stars no longer appear in an ITEM field.
+
+*** Columns view
+
+**** ~org-columns~ accepts a prefix argument
+
+When called with a prefix argument, ~org-columns~ apply to the whole
+buffer unconditionally.
+
+**** New variable : ~org-agenda-view-columns-initially~
+
+The variable used to be a ~defvar~, it is now a ~defcustom~.
+
+**** Allow custom summaries
+
+It is now possible to add new summary types, or override those
+provided by Org by customizing ~org-columns-summary-types~, which see.
+
+**** Allow multiple summaries for any property
+
+Columns can now summarize the same property using different summary
+types.
+
+*** Preview LaTeX snippets in buffers not visiting files
+*** New option ~org-attach-commit~
+
+When non-nil, commit attachments with git, assuming the document is in
+a git repository.
+
+*** Allow conditional case-fold searches in ~org-occur~
+
+When set to ~smart~, the new variable ~org-occur-case-fold-search~ allows
+to mimic =isearch.el=: if the regexp searched contains any upper case
+character (or character class), the search is case sensitive.
+Otherwise, it is case insensitive.
+
+*** More robust repeated =ox-latex= footnote handling
+
+Repeated footnotes are now numbered by referring to a label in the
+first footnote.
+
+*** The ~org-block~ face is inherited by ~src-blocks~
+
+This works also when =org-src-fontify-natively= is non-nil. It is also
+possible to specify per-languages faces. See =org-src-block-faces= and
+the manual for details.
+
+*** Links are now customizable
+
+Links can now have custom colors, tooltips, keymaps, display behavior,
+etc. Links are now centralized in ~org-link-parameters~.
+
+** New functions
+
+*** ~org-next-line-empty-p~
+
+It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~.
+
+*** ~org-show-children~
+
+It is a faster implementation of ~outline-show-children~.
+
+** Removed functions
+
+*** ~org-agenda-filter-by-tag-refine~ has been removed.
+
+Use ~org-agenda-filter-by-tag~ instead.
+
+*** ~org-agenda-todayp~ is deprecated.
+
+Use ~org-agenda-today-p~ instead.
+
+*** ~org-babel-get-header~ is removed.
+
+Use ~org-babel--get-vars~ or ~assq~ instead, as applicable.
+
+*** ~org-babel-trim~ is deprecated.
+
+Use ~org-trim~ instead.
+
+*** ~org-element-remove-indentation~ is deprecated.
+
+Use ~org-remove-indentation~ instead.
+
+*** ~org-image-file-name-regexp~ is deprecated
+
+Use ~image-file-name-regexp~ instead.
+The never-used-in-core ~extensions~ argument has been dropped.
+
+*** ~org-list-parse-list~ is deprecated
+
+Use ~org-list-to-lisp~ instead.
+
+*** ~org-on-heading-p~ is deprecated
+
+A comment to this effect was in the source code since 7.8.03, but
+now a byte-compiler warning will be generated as well.
+
+*** ~org-table-p~ is deprecated
+
+Use ~org-at-table-p~ instead.
+
+*** ~org-table-recognize-table.el~ is deprecated
+
+It was not called by any org code since 2010.
+
+*** Various reimplementations of cl-lib functions are deprecated
+
+The affected functions are:
+- ~org-count~
+- ~org-remove-if~
+- ~org-remove-if-not~
+- ~org-reduce~
+- ~org-every~
+- ~org-some~
+
+Additionally, ~org-sublist~ is deprecated in favor of ~cl-subseq~. Note
+the differences in indexing conventions: ~org-sublist~ is 1-based and
+end-inclusive; ~cl-subseq~ is 0-based and end-exclusive.
+
+** Removed options
+
+*** Remove all options related to ~ido~ or ~iswitchb~
+
+This includes ~org-completion-use-iswitchb~ and ~org-completion-use-ido~.
+Instead Org uses regular functions, e.g., ~completion-read~ so as to
+let those libraries operate.
+
+*** Remove ~org-list-empty-line-terminates-plain-lists~
+
+Two consecutive blank lines always terminate all levels of current
+plain list.
+
+*** ~fixltx2e~ is removed from ~org-latex-default-packages-alist~
+
+fixltx2e is obsolete, see LaTeX News 22.
+
+** Miscellaneous
+*** Add Icelandic smart quotes
+*** Allow multiple receiver locations in radio tables and lists
+*** Allow angular links within link descriptions
+
+It is now allowed to write, e.g.,
+~[[http:orgmode.org][<file:unicorn.png>]]~ as an equivalent to
+~[[http:orgmode.org][file:unicorn.png]]~. The advantage of the former
+is that spaces are allowed within the path.
+
+*** Beamer export back-ends uses ~org-latex-prefer-user-labels~
+*** ~:preparation-function~ called earlier during publishing
+
+Functions in this list are called before any file is associated to the
+current project. Thus, they can be used to generate to be published
+Org files.
+
+*** Function ~org-remove-indentation~ changes.
+
+The new algorithm doesn't remove TAB characters not used for
+indentation.
+
+*** Secure placeholders in capture templates
+
+Placeholders in capture templates are no longer expanded recursively.
+However, ~%(...)~ constructs are expanded very late, so you can fill
+the contents of the S-exp with the replacement text of non-interactive
+placeholders. As before, interactive ones are still expanded as the
+very last step, so the previous statement doesn't apply to them.
+
+Note that only ~%(...)~ placeholders initially present in the
+template, or introduced using a file placeholder, i.e., ~%[...]~ are
+expanded. This prevents evaluating potentially malicious code when
+another placeholder, e.g., ~%i~ expands to a S-exp.
+
+*** Links stored by ~org-gnus-store-link~ in nnir groups
+
+Since gnus nnir groups are temporary, ~org-gnus-store-link~ now refers
+to the article's original group.
+
+*** ~org-babel-check-confirm-evaluate~ is now a function instead of a macro
+
+The calling convention has changed.
+
+*** HTML export table row customization changes
+
+Variable ~org-html-table-row-tags~ has been split into
+~org-html-table-row-open-tag~ and ~org-html-table-row-close-tag~.
+Both new variables can be either a string or a function which will be
+called with 6 parameters.
+
+*** =ITEM= special property returns headline without stars
+*** Rename ~org-insert-columns-dblock~ into ~org-columns-insert-dblock~
+
+The previous name is, for the time being, kept as an obsolete alias.
+
+*** ~org-trim~ can preserve leading indentation.
+
+When setting a new optional argument to a non-nil value, ~org-trim~
+preserves leading indentation while removing blank lines at the
+beginning of the string. The behavior is identical for white space at
+the end of the string.
+
+*** Function ~org-info-export~ changes.
+
+HTML links created from certain info links now point to =gnu.org= URL's rather
+than just to local files. For example info links such as =info:emacs#List
+Buffers= used to be converted to HTML links like this:
+
+: <a href="emacs.html#List-Buffers">emacs#List Buffers</a>
+
+where local file =emacs.html= is referenced.
+For most folks this file does not exist.
+Thus the new behavior is to generate this HTML link instead:
+
+: <a href="https://www.gnu.org/software/emacs/manual/html_mono/emacs.html#List-Buffers">emacs#List Buffers</a>
+
+All emacs related info links are similarly translated plus few other
+=gnu.org= manuals.
+
+*** Repeaters with a ~++~ interval and a time can be shifted to later today
+
+Previously, if a recurring task had a timestamp of
+~<2016-01-01 Fri 20:00 ++1d>~ and was completed on =2016-01-02= at
+=08:00=, the task would skip =2016-01-02= and would be rescheduled for
+=2016-01-03=. Timestamps with ~++~ cookies and a specific time will
+now shift to the first possible future occurrence, even if the
+occurrence is later the same day the task is completed. (Timestamps
+already in the future are still shifted one time further into the
+future.)
+
+*** ~org-mobile-action-alist~ is now a defconst
+
+It used to be a defcustom, with a warning that it shouldn't be
+modified anyway.
+
+*** ~file+emacs~ and ~file+sys~ link types are deprecated
+
+They are still supported in Org 9.0 but will eventually be removed in
+a later release. Use ~file~ link type along with universal arguments
+to force opening it in either Emacs or with system application.
+
+*** New defcustom ~org-babel-J-command~ stores the j command
+*** New defalias ~org-babel-execute:j~
+
+Allows J source blocks be indicated by letter j. Previously the
+indication letter was solely J.
+
+*** ~org-open-line~ ignores tables at the very beginning of the buffer
+
+When ~org-special-ctrl-o~ is non-nil, it is impractical to create
+a blank line above a table at the beginning of the document. Now, as
+a special case, ~org-open-line~ behaves normally in this situation.
+
+*** ~org-babel-hash-show-time~ is now customizable
+
+The experimental variable used to be more or less confidential, as
+a ~defvar~.
+
+*** New ~:format~ property to parsed links
+
+It defines the format of the original link. Possible values are:
+~plain~, ~bracket~ and ~angle~.
+
+* Version 8.3
+
+** Incompatible changes
+
+*** Properties drawers syntax changes
+
+Properties drawers are now required to be located right after a
+headline and its planning line, when applicable.
+
+It will break some documents as TODO states changes were sometimes
+logged before the property drawer.
+
+The following function will repair them:
+
+#+BEGIN_SRC emacs-lisp
+(defun org-repair-property-drawers ()
+ "Fix properties drawers in current buffer.
+Ignore non Org buffers."
+ (when (eq major-mode 'org-mode)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (inline-re (and (featurep 'org-inlinetask)
+ (concat (org-inlinetask-outline-regexp)
+ "END[ \t]*$"))))
+ (org-map-entries
+ (lambda ()
+ (unless (and inline-re (org-looking-at-p inline-re))
+ (save-excursion
+ (let ((end (save-excursion (outline-next-heading) (point))))
+ (forward-line)
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (and (< (point) end)
+ (not (org-looking-at-p org-property-drawer-re))
+ (save-excursion
+ (and (re-search-forward org-property-drawer-re end t)
+ (eq (org-element-type
+ (save-match-data (org-element-at-point)))
+ 'drawer))))
+ (insert (delete-and-extract-region
+ (match-beginning 0)
+ (min (1+ (match-end 0)) end)))
+ (unless (bolp) (insert "\n"))))))))))))
+#+END_SRC
+
+*** Using "COMMENT" is now equivalent to commenting with "#"
+
+If you used "COMMENT" in headlines to prevent a subtree from being
+exported, you can still do it but all information within the subtree
+is now commented out, i.e. no #+OPTIONS line will be parsed or taken
+into account when exporting.
+
+If you want to exclude a headline from export while using its contents
+for setting options, use =:noexport:= (see =org-export-exclude-tags=.)
+
+*** =#+CATEGORY= keywords no longer apply partially to document
+
+It was possible to use several such keywords and have them apply to
+the text below until the next one, but strongly deprecated since Org
+5.14 (2008).
+
+=#+CATEGORY= keywords are now global to the document. You can use node
+properties to set category for a subtree, e.g.,
+
+#+BEGIN_SRC org
+,* Headline
+ :PROPERTIES:
+ :CATEGORY: some category
+ :END:
+#+END_SRC
+
+*** New variable to control visibility when revealing a location
+
+~org-show-following-heading~, ~org-show-siblings~, ~org-show-entry-below~
+and ~org-show-hierarchy-above~ no longer exist. Instead, visibility is
+controlled through a single variable: ~org-show-context-detail~, which
+see.
+
+*** Replace disputed keys again when reading a date
+
+~org-replace-disputed-keys~ has been ignored when reading date since
+version 8.1, but the former behavior is restored again.
+
+Keybinding for reading date can be customized with a new variable
+~org-read-date-minibuffer-local-map~.
+
+*** No default title is provided when =TITLE= keyword is missing
+
+Skipping =TITLE= keyword no longer provides the current file name, or
+buffer name, as the title. Instead, simply ignore the title.
+
+*** Default bindings of =C-c C-n= and =C-c C-p= changed
+
+The key sequences =C-c C-n= and =C-c C-p= are now bound to
+~org-next-visible-heading~ and ~org-previous-visible-heading~
+respectively, rather than the =outline-mode= versions of these
+functions. The Org version of these functions skips over inline tasks
+(and even-level headlines when ~org-odd-levels-only~ is set).
+
+*** ~org-element-context~ no longer return objects in keywords
+
+~org-element-context~ used to return objects on some keywords, i.e.,
+=TITLE=, =DATE= and =AUTHOR=. It now returns only the keyword.
+
+*** ~org-timer-default-timer~ type changed from number to string
+
+If you have, in your configuration, something like =(setq
+org-timer-default-timer 10)= replace it with =(setq
+org-timer-default-timer "10")=.
+
+*** Functions signature changes
+
+The following functions require an additional argument. See their
+docstring for more information.
+
+- ~org-export-collect-footnote-definitions~
+- ~org-html-format-headline-function~
+- ~org-html-format-inlinetask-function~
+- ~org-latex-format-headline-function~
+- ~org-latex-format-inlinetask-function~
+- ~org-link-search~
+
+** New features
+
+*** Default lexical evaluation of emacs-lisp src blocks
+
+Emacs-lisp src blocks in babel are now evaluated using lexical
+scoping. There is a new header to control this behavior.
+
+The default results in an eval with lexical scoping.
+:lexical yes
+
+This turns lexical scoping off in the eval (the former behavior).
+:lexical no
+
+This uses the lexical environment with x=42 in the eval.
+:lexical '((x . 42))
+
+*** Behavior of ~org-return~ changed
+
+If point is before or after the headline title, insert a new line
+without changing the headline.
+
+*** Hierarchies of tags
+
+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".
+
+The following in-buffer definition:
+
+#+BEGIN_SRC org
+ ,#+TAGS: [ Group : SubOne SubTwo ]
+ ,#+TAGS: [ SubOne : SubOne1 SubOne2 ]
+ ,#+TAGS: [ SubTwo : SubTwo1 SubTwo2 ]
+#+END_SRC
+
+Should be seen as the following tree of tags:
+
+- Group
+ - SubOne
+ - SubOne1
+ - SubOne2
+ - SubTwo
+ - SubTwo1
+ - SubTwo2
+
+Searching for "Group" should return all tags defined above. Filtering
+on SubOne filters also it's sub-tags. Etc.
+
+There is no limit on the depth for the tag hierarchy.
+
+*** Additional syntax for non-unique grouptags
+
+Additional syntax is defined for grouptags if the tags in the group
+don't have to be distinct on a heading.
+
+Grouptags had to previously be defined with { }. This syntax is
+already used for exclusive tags and Grouptags need their own,
+non-exclusive syntax. This behaviour is achieved with [ ]. Note: { }
+can still be used also for Grouptags but then only one of the given
+tags can be used on the headline at the same time. Example:
+
+[ group : sub1 sub2 ]
+
+#+BEGIN_SRC org
+,* Test :sub1:sub2:
+#+END_SRC
+
+This is a more general case than the already existing syntax for
+grouptags; { }.
+
+*** Define regular expression patterns as tags
+
+Tags can be defined as grouptags with regular expressions as
+"sub-tags".
+
+The regular expressions in the group must be marked up within { }.
+Example use:
+
+: #+TAGS: [ Project : {P@.+} ]
+
+Searching for the tag Project will now list all tags also including
+regular expression matches for P@.+. This is good for example for
+projects tagged with a common identifier, i.e. P@2014_OrgTags.
+
+*** Filtering in the agenda on grouptags (Tag hierarchies)
+
+Filtering in the agenda on grouptags filters all of the related tags.
+Except if a filter is applied with a (double) prefix-argument.
+
+Filtering in the agenda on subcategories does not filter the "above"
+levels anymore.
+
+If a grouptag contains a regular expression the regular expression
+is also used as a filter.
+
+*** Minor refactoring of ~org-agenda-filter-by-tag~
+
+Now uses the argument ARG and optional argument exclude instead of
+strip and narrow. ARG because the argument has multiple purposes and
+makes more sense than strip now. The term "narrowing" is changed to
+exclude.
+
+The main purpose is for the function to make more logical sense when
+filtering on tags now when tags can be structured in hierarchies.
+
+*** Babel: support for sed scripts
+
+Thanks to Bjarte Johansen for this feature.
+
+*** Babel: support for Processing language
+
+New ob-processing.el library.
+
+This library implements necessary functions for implementing editing
+of Processing code blocks, viewing the resulting sketches in an
+external viewer, and HTML export of the sketches.
+
+Check the documentation for more details.
+
+Thanks to Jarmo Hurri for this feature.
+
+*** New behaviour for ~org-toggle-latex-fragment~
+
+The new behaviour is the following:
+
+- With a double prefix argument or with a single prefix argument when
+ point is before the first headline, toggle overlays in the whole
+ buffer;
+
+- With a single prefix argument, toggle overlays in the current
+ subtree;
+
+- On latex code, toggle overlay at point;
+
+- Otherwise, toggle overlays in the current section.
+
+*** Additional markup with =#+INCLUDE= keyword
+
+The content of the included file can now be optionally marked up, for
+instance as HTML. See the documentation for details.
+
+*** File links with =#+INCLUDE= keyword
+
+Objects can be extracted via =#+INCLUDE= using file links. It is
+possible to include only the contents of the object. See manual for
+more information.
+
+*** Drawers do not need anymore to be referenced in =#+DRAWERS=
+
+One can use a drawer without listing it in the =#+DRAWERS= keyword,
+which is now obsolete. As a consequence, this change also deprecates
+~org-drawers~ variable.
+
+*** ~org-edit-special~ can edit export blocks
+
+Using C-c ' on an export block now opens a sub-editing buffer. Major
+mode in that buffer is determined by export backend name (e.g.,
+"latex" \to "latex-mode"). You can define exceptions to this rule by
+configuring ~org-src-lang-modes~, which see.
+
+*** Additional =:hline= processing to ob-shell
+
+If the argument =:hlines yes= is present in a babel call, an optional
+argument =:hlines-string= can be used to define a string to use as a
+representation for the lisp symbol ='hline= in the shell program. The
+default is =hline=.
+
+*** Markdown export supports switches in source blocks
+
+For example, it is now possible to number lines using the =-n= switch in
+a source block.
+
+*** New option in ASCII export
+
+Plain lists can have an extra margin by setting ~org-ascii-list-margin~
+variable to an appropriate integer.
+
+*** New blocks in ASCII export
+
+ASCII export now supports =#+BEGIN_JUSTIFYRIGHT= and =#+BEGIN_JUSTIFYLEFT=
+blocks. See documentation for details.
+
+*** More back-end specific publishing options
+
+The number of publishing options specific to each back-end has been
+increased. See manual for details.
+
+*** Export inline source blocks
+
+Inline source code was used to be removed upon exporting. They are
+now handled as standard code blocks, i.e., the source code can appear
+in the output, depending on the parameters.
+
+*** Extend ~org-export-first-sibling-p~ and ~org-export-last-sibling-p~
+
+These functions now support any element or object, not only headlines.
+
+*** New function: ~org-export-table-row-in-header-p~
+
+*** New function: ~org-export-get-reference~
+
+*** New function: ~org-element-lineage~
+
+This function deprecates ~org-export-get-genealogy~. It also provides
+more features. See docstring for details.
+
+*** New function: ~org-element-copy~
+
+*** New filter: ~org-export-filter-body-functions~
+
+Functions in this filter are applied on the body of the exported
+document, before wrapping it within the template.
+
+*** New :environment parameter when exporting example blocks to LaTeX
+
+: #+ATTR_LATEX: :environment myverbatim
+: #+BEGIN_EXAMPLE
+: This sentence is false.
+: #+END_EXAMPLE
+
+will be exported using =@samp(myverbatim)= instead of =@samp(verbatim)=.
+
+*** Various improvements on radio tables
+
+Radio tables feature now relies on Org's export framework ("ox.el").
+~:no-escape~ parameter no longer exists, but additional global
+parameters are now supported: ~:raw~, ~:backend~. Moreover, there are new
+parameters specific to some pre-defined translators, e.g.,
+~:environment~ and ~:booktabs~ for ~orgtbl-to-latex~. See translators
+docstrings (including ~orgtbl-to-generic~) for details.
+
+*** Non-floating minted listings in Latex export
+
+It is not possible to specify =#+attr_latex: :float nil= in conjunction
+with source blocks exported by the minted package.
+
+*** Field formulas can now create columns as needed
+
+Previously, evaluating formulas that referenced out-of-bounds columns
+would throw an error. A new variable ~org-table-formula-create-columns~
+was added to adjust this behavior. It is now possible to silently add
+new columns, to do so with a warning or to explicitly ask the user
+each time.
+
+*** ASCII plot
+
+Ability to plot values in a column through ASCII-art bars. See manual
+for details.
+
+*** New hook: ~org-archive-hook~
+
+This hook is called after successfully archiving a subtree, with point
+on the original subtree, not yet deleted.
+
+*** New option: ~org-attach-archive-delete~
+
+When non-nil, attachments from archived subtrees are removed.
+
+*** New option: ~org-latex-caption-above~
+
+This variable generalizes ~org-latex-table-caption-above~, which is now
+deprecated. In addition to tables, it applies to source blocks,
+special blocks and images. See docstring for more information.
+
+*** New option: ~org-latex-prefer-user-labels~
+
+See the docstring for more information.
+
+*** Export unnumbered headlines
+
+Headlines, for which the property ~UNNUMBERED~ is non-nil, are now
+exported without section numbers irrespective of their levels. The
+property is inherited by children.
+
+*** Tables can be sorted with an arbitrary function
+
+It is now possible to specify a function, both programmatically,
+through a new optional argument, and interactively with ~f~ or ~F~ keys,
+to sort a table.
+
+*** Table of contents can be local to a section
+
+The ~TOC~ keywords now accepts an optional ~local~ parameter. See manual
+for details.
+
+*** Countdown timers can now be paused
+
+~org-timer-pause-time~ now pauses and restarts both relative and
+countdown timers.
+
+*** New option ~only-window~ for ~org-agenda-window-setup~
+
+When ~org-agenda-window-setup~ is set to ~only-window~, the agenda is
+displayed as the sole window of the current frame.
+
+*** ~{{{date}}}~ macro supports optional formatting argument
+
+It is now possible to supply and optional formatting argument to
+~{{{date}}}~. See manual for details.
+
+*** ~{{{property}}}~ macro supports optional search argument
+
+It is now possible to supply an optional search option to
+~{{{property}}}~ in order to retrieve remote properties optional. See
+manual for details.
+
+*** New option ~org-export-with-title~
+
+It is possible to suppress the title insertion with ~#+OPTIONS:
+title:nil~ or globally using the variable ~org-export-with-title~.
+
+*** New entities family: "\_ "
+
+"\_ " are used to insert up to 20 contiguous spaces in various
+back-ends. In particular, this family can be used to introduce
+leading spaces within table cells.
+
+*** New MathJax configuration options
+
+Org uses the MathJax CDN by default. See the manual and the docstring
+of ~org-html-mathjax-options~ for details.
+
+*** New behaviour in `org-export-options-alist'
+
+When defining a back-end, it is now possible to specify to give
+`parse' behaviour on a keyword. It is equivalent to call
+`org-element-parse-secondary-string' on the value.
+
+However, parsed =KEYWORD= is automatically associated to an
+=:EXPORT_KEYWORD:= property, which can be used to override the keyword
+value during a subtree export. Moreover, macros are expanded in such
+keywords and properties.
+
+*** Viewport support in html export
+
+Viewport for mobile-optimized website is now automatically inserted
+when exporting to html. See ~org-html-viewport~ for details.
+
+*** New ~#+SUBTITLE~ export keyword
+
+Org can typeset a subtitle in some export backends. See the manual
+for details.
+
+*** Remotely edit a footnote definition
+
+Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference
+allows to edit its definition, as long as it is not anonymous, in a
+dedicated buffer. It works even if buffer is currently narrowed.
+
+*** New function ~org-delete-indentation~ bound to ~M-^~
+
+Work as ~delete-indentation~ unless at heading, in which case text is
+added to headline text.
+
+*** Support for images in Texinfo export
+
+~Texinfo~ back-end now handles images. See the manual for details.
+
+*** Support for captions in Texinfo export
+
+Tables and source blocks can now have captions. Additionally, lists
+of tables and lists of listings can be inserted in the document with
+=#+TOC= keyword.
+
+*** Countdown timer support hh:mm:ss format
+
+In addition to setting countdown timers in minutes, they can also be
+set using the hh:mm:ss format.
+
+*** Extend ~org-clone-subtree-with-time-shift~
+
+~org-clone-subtree-with-time-shift~ now accepts 0 as an argument for the
+number of clones, which removes the repeater from the original subtree
+and creates one shifted, repeating clone.
+
+*** New time block for clock tables: ~untilnow~
+
+It encompasses all past closed clocks.
+
+*** Support for the ~polyglossia~ LaTeX package
+
+See the docstring of ~org-latex-classes~ and
+~org-latex-guess-polyglossia-language~ for details.
+
+*** None-floating tables, graphics and blocks can have captions
+
+*** `org-insert-heading' can be forced to insert top-level headline
+
+** Removed functions
+
+*** Removed function ~org-translate-time~
+
+Use ~org-timestamp-translate~ instead.
+
+*** Removed function ~org-beamer-insert-options-template~
+
+This function inserted a Beamer specific template at point or in
+current subtree. Use ~org-export-insert-default-template~ instead, as
+it provides more features and covers all export back-ends. It is also
+accessible from the export dispatcher.
+
+*** Removed function ~org-timer-cancel-timer~
+
+~org-timer-stop~ now stops both relative and countdown timers.
+
+*** Removed function ~org-export-solidify-link-text~
+
+This function, being non-bijective, introduced bug in internal
+references. Use ~org-export-get-reference~ instead.
+
+*** Removed function ~org-end-of-meta-data-and-drawers~
+
+The function is superseded by ~org-end-of-meta-data~, called with an
+optional argument.
+
+*** Removed functions ~org-table-colgroup-line-p~, ~org-table-cookie-line-p~
+
+These functions were left-over from pre 8.0 era. They are not correct
+anymore. Since they are not needed, they have no replacement.
+
+** Removed options
+
+*** ~org-list-empty-line-terminates-plain-lists~ is deprecated
+
+It will be kept in code base until next release, for backward
+compatibility.
+
+If you need to separate consecutive lists with blank lines, always use
+two of them, as if this option was nil (default value).
+
+*** ~org-export-with-creator~ is a boolean
+
+Special ~comment~ value is no longer allowed. It is possible to use a
+body filter to add comments about the creator at the end of the
+document instead.
+
+*** Removed option =org-html-use-unicode-chars=
+
+Setting this to non-nil was problematic as it converted characters
+everywhere in the buffer, possibly corrupting URLs.
+
+*** Removed option =org-babel-sh-command=
+
+This undocumented option defaulted to the value of =shell-file-name= at
+the time of loading =ob-shell=. The new behaviour is to use the value
+of =shell-file-name= directly when the shell langage is =shell=. To chose
+a different shell, either customize =shell-file-name= or bind this
+variable locally.
+
+*** Removed option =org-babel-sh-var-quote-fmt=
+
+This undocumented option was supposed to provide different quoting
+styles when changing the shell type. Changing the shell type can now
+be done directly from the source block and the quoting style has to be
+compatible across all shells, so a customization doesn't make sense
+anymore. The chosen hard coded quoting style conforms to POSIX.
+
+*** Removed option ~org-insert-labeled-timestamps-at-point~
+
+Setting this option to anything else that the default value (nil)
+would create invalid planning info. This dangerous option is now
+removed.
+
+*** Removed option ~org-koma-letter-use-title~
+
+Use org-export-with-title instead. See also below.
+
+*** Removed option ~org-entities-ascii-explanatory~
+
+This variable has no effect since Org 8.0.
+
+*** Removed option ~org-table-error-on-row-ref-crossing-hline~
+
+This variable has no effect since August 2009.
+
+*** Removed MathML-related options from ~org-html-mathjax-options~
+
+MathJax automatically chooses the best display technology based on the
+end-users browser. You may force initial usage of MathML via
+~org-html-mathjax-template~ or by setting the ~path~ property of
+~org-html-mathjax-options~.
+
+*** Removed comment-related filters
+
+~org-export-filter-comment-functions~ and
+~org-export-filter-comment-block-functions~ variables do not exist
+anymore.
+
+** Miscellaneous
+
+*** Strip all meta data from ITEM special property
+
+ITEM special property does not contain TODO, priority or tags anymore.
+
+*** File names in links accept are now compatible with URI syntax
+
+Absolute file names can now start with =///= in addition to =/=. E.g.,
+=[[file:///home/me/unicorn.jpg]]=.
+
+*** Footnotes in included files are now local to the file
+
+As a consequence, it is possible to include multiple Org files with
+footnotes in a master document without being concerned about footnote
+labels colliding.
+
+*** Mailto links now use regular URI syntax
+
+This change deprecates old Org syntax for mailto links:
+=mailto:user@domain::Subject=.
+
+*** =QUOTE= keywords do not exist anymore
+
+=QUOTE= keywords have been deprecated since Org 8.2.
+
+*** Select tests to perform with the build system
+
+The build system has been enhanced to allow test selection with a
+regular expression by defining =BTEST_RE= during the test invocation.
+This is especially useful during bisection to find just when a
+particular test failure was introduced.
+
+*** Exact heading search for external links ignore spaces and cookies
+
+Exact heading search for links now ignore spaces and cookies. This is
+the case for links of the form ~file:projects.org::*task title~, as well
+as links of the form ~file:projects.org::some words~ when
+~org-link-search-must-match-exact-headline~ is not nil.
+
+*** ~org-latex-hyperref-template~, ~org-latex-title-command~ formatting
+
+New formatting keys are supported. See the respective docstrings.
+Note, ~org-latex-hyperref-template~ has a new default value.
+
+*** ~float, wasysym, marvosym~ are removed from ~org-latex-default-packages-alist~
+
+If you require any of these package add them to your preamble via
+~org-latex-packages-alist~. Org also uses default LaTeX ~\tolerance~ now.
+
+*** When exporting, throw an error on unresolved id/fuzzy links and code refs
+
+This helps spotting wrong links.
+
+* Version 8.2
+
+** Incompatible changes
+*** =ob-sh.el= renamed to =ob-shell=
+This may require two changes in user config.
+
+1. In =org-babel-do-load-languages=, change =(sh . t)= to =(shell . t)=.
+2. Edit =local.mk= files to change the value of =BTEST_OB_LANGUAGES=
+ to remove "sh" and include "shell".
+
*** Combine org-mac-message.el and org-mac-link-grabber into org-mac-link.el
Please remove calls to =(require 'org-mac-message)= and =(require
@@ -148,7 +1989,7 @@ This enables SVG generation from latex code blocks.
*** New option: [[doc:org-habit-show-done-always-green][org-habit-show-done-always-green]]
-See [[http://lists.gnu.org/archive/html/emacs-orgmode/2013-05/msg00214.html][this message]] from Max Mikhanosha.
+See [[https://lists.gnu.org/r/emacs-orgmode/2013-05/msg00214.html][this message]] from Max Mikhanosha.
*** New option: [[doc:org-babel-inline-result-wrap][org-babel-inline-result-wrap]]
@@ -171,6 +2012,18 @@ then inline code snippets will be wrapped into the formatting string.
- =org-screenshot.el= by Max Mikhanosha :: an utility to handle
screenshots easily from Org, using the external tool [[http://freecode.com/projects/scrot][scrot]].
+** Miscellaneous
+
+*** "QUOTE" keywords in headlines are deprecated
+
+"QUOTE" keywords are an undocumented feature in Org. When a headline
+starts with the keyword "QUOTE", its contents are parsed as
+a ~quote-section~ and treated as an example block. You can achieve
+the same with example blocks.
+
+This feature is deprecated and will be removed in the next Org
+release.
+
* Version 8.0.1
** Installation
@@ -312,7 +2165,7 @@ manual for details and check [[http://orgmode.org/worg/org-8.0.html][this Worg p
*** ~ox-texinfo.el~ by Jonathan Leech-Pepin
- =ox-texinfo.el= allows you to export Org files to [[http://www.gnu.org/software/texinfo/][Texinfo]] files.
+ =ox-texinfo.el= allows you to export Org files to [[https://www.gnu.org/software/texinfo/][Texinfo]] files.
** New packages in contrib
@@ -365,7 +2218,7 @@ manual for details and check [[http://orgmode.org/worg/org-8.0.html][this Worg p
*** ~ox-groff.el~ by Luis Anaya and Nicolas Goaziou
- The [[http://www.gnu.org/software/groff/][groff]] (GNU troff) software is a typesetting package which reads
+ The [[https://www.gnu.org/software/groff/][groff]] (GNU troff) software is a typesetting package which reads
plain text mixed with formatting commands and produces formatted
output.
@@ -1021,6 +2874,13 @@ consistent with using the `:' key in agenda view.
You can now use `=' for [[doc::org-columns][org-columns]].
** =org-float= is now obsolete, use =diary-float= instead
+** No GPL manual anymore
+
+There used to be a GPL version of the Org manual, but this is not the
+case anymore, the Free Software Foundation does not permit this.
+
+The GNU FDL license is now included in the manual directly.
+
** Enhanced compatibility with Emacs 22 and XEmacs
Thanks to Achim for his work on enhancing Org's compatibility with
@@ -1038,7 +2898,7 @@ You can now add the Org ELPA repository like this:
#+END_SRC
It contains both the =org-*.tar= package (the core Org distribution, also
-available through http://elpa.gnu.org) and the =org-plus*.tar= package (the
+available through https://elpa.gnu.org) and the =org-plus*.tar= package (the
extended Org distribution, with non-GNU packages from the =contrib/=
directory.)
@@ -1058,7 +2918,7 @@ See http://orgmode.org/elpa/
| =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] |
| | =#= | [[doc::org-toggle-comment][org-toggle-comment]] |
| | =:= | [[doc::org-columns][org-columns]] |
- | | =W= | Set =APPT_WARNTIME= |
+ | | =W= | Set =APPT_WARNTIME= |
| =k= | | [[doc::org-agenda-capture][org-agenda-capture]] |
| C-c , | , | [[doc::org-priority][org-priority]] |
@@ -1066,7 +2926,7 @@ See http://orgmode.org/elpa/
*** =org-eshell.el= by Konrad Hinsen is now in Org
- =org-eshell.el= allows you to create links from [[http://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]].
+ =org-eshell.el= allows you to create links from [[https://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]].
*** Support for execution of Scala code blocks (see ob-scala.el)
*** Support for execution of IO code blocks (see ob-io.el)
@@ -1225,7 +3085,7 @@ See http://orgmode.org/elpa/
**** New =todo-unblocked= and =nottodo-unblocked= skip conditions
- See the [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3Df426da][git commit]] for more explanations.
+ See the [[http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=f426da][git commit]] for more explanations.
**** Allow category filtering in the agenda
@@ -1542,7 +3402,7 @@ See http://orgmode.org/elpa/
Thanks to Carsten for implementing this.
**** ODT: Add support for ODT export in org-bbdb.el
-**** ODT: Add support for indented tables (see [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3De9fd33][this commit]] for details)
+**** ODT: Add support for indented tables (see [[http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=e9fd33][this commit]] for details)
**** ODT: Improve the conversion from ODT to other formats
**** ASCII: Swap the level-1/level-2 characters to underline the headlines
**** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese
@@ -1666,7 +3526,7 @@ that Calc formulas can operate on them.
=org-export-html-scripts= is now a variable, so that you can adapt
the code and the license to your needs.
- See http://www.gnu.org/philosophy/javascript-trap.html for
+ See https://www.gnu.org/philosophy/javascript-trap.html for
explanations on why these changes were necessary.
* Version 7.8.11
@@ -2451,4 +4311,4 @@ that Calc formulas can operate on them.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index 713e44fcef9..75b1f1febd0 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -120,8 +120,8 @@ load-path.
This version of GCC is buggy: see
- http://debbugs.gnu.org/6031
- http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43904
+ https://debbugs.gnu.org/6031
+ https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43904
You can work around this error in gcc-4.5 by omitting sibling call
optimization. To do this, configure Emacs with
@@ -166,7 +166,7 @@ untar it :-).
** Emacs can crash when displaying PNG images with transparency.
This is due to a bug introduced in ImageMagick 6.8.2-3. The bug should
-be fixed in ImageMagick 6.8.3-10. See <URL:http://debbugs.gnu.org/13867>.
+be fixed in ImageMagick 6.8.3-10. See <URL:https://debbugs.gnu.org/13867>.
** Crashes when displaying GIF images in Emacs built with version
libungif-4.1.0 are resolved by using version libungif-4.1.0b1.
@@ -540,7 +540,7 @@ to the variable 'locate-dominating-stop-dir-regexp'. For example, if
the problem relates to "/smb/.dir-locals.el", set that variable
to a new value where you replace "net\\|afs" with "net\\|afs\\|smb".
(The default value already matches common auto-mount prefixes.)
-See http://lists.gnu.org/archive/html/help-gnu-emacs/2015-02/msg00461.html .
+See https://lists.gnu.org/r/help-gnu-emacs/2015-02/msg00461.html .
*** Attempting to visit remote files via ange-ftp fails.
@@ -557,7 +557,7 @@ and then choose /usr/bin/netkit-ftp.
*** Dired is very slow.
-This could happen if invocation of the 'df' program takes a long
+This could happen if getting a file system's status takes a long
time. Possible reasons for this include:
- ClearCase mounted filesystems (VOBs) that sometimes make 'df'
@@ -565,12 +565,8 @@ time. Possible reasons for this include:
- slow automounters on some old versions of Unix;
- - slow operation of some versions of 'df'.
-
-To work around the problem, you could either (a) set the variable
-'directory-free-space-program' to nil, and thus prevent Emacs from
-invoking 'df'; (b) use 'df' from the GNU Coreutils package; or
-(c) use CVS, which is Free Software, instead of ClearCase.
+To work around the problem, you could use Git or some other
+free-software program, instead of ClearCase.
*** ps-print commands fail to find prologue files ps-prin*.ps.
@@ -634,7 +630,7 @@ can cause this error. Remove that file, execute 'ispell-kill-ispell'
in Emacs, and then try spell-checking again.
*** TLS problems, e.g., Gnus hangs when fetching via imaps
-http://debbugs.gnu.org/24247
+https://debbugs.gnu.org/24247
gnutls-cli 3.5.3 (2016-08-09) does not generate a "- Handshake was
completed" message that tls.el relies upon, causing affected Emacs
@@ -671,9 +667,10 @@ problem by installing additional fonts.
The intlfonts distribution includes a full spectrum of fonts that can
display all the characters Emacs supports. The etl-unicode collection
-of fonts (available from <URL:ftp://ftp.x.org/contrib/fonts/>) includes
-fonts that can display many Unicode characters; they can also be used
-by ps-print and ps-mule to print Unicode characters.
+of fonts (available from
+<https://ftp.nluug.nl/windowing/X/contrib/fonts/>) includes fonts that
+can display many Unicode characters; they can also be used by ps-print
+and ps-mule to print Unicode characters.
** Under X, some characters appear improperly aligned in their lines.
@@ -688,7 +685,7 @@ On some systems, there exists a font that is actually named Monospace,
which takes over the virtual font. This is considered an operating
system bug; see
-http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00696.html
+https://lists.gnu.org/r/emacs-devel/2008-10/msg00696.html
If you encounter this problem, set the default font to a specific font
in your .Xresources or initialization file. For instance, you can put
@@ -829,6 +826,36 @@ index 45cc554..0cc5e76 100644
If you can't modify that file directly, copy it to the directory
~/.m17n.d/ (create it if it doesn't exist), and apply the patch.
+** Emacs running on GNU/Linux system with the m17n library Ver.1.7.1 or the
+earlier version has a problem with rendering Lao script with OpenType font.
+
+The problem can be fixed by installing the newer version of the m17n
+library (if any), or by following this procedure:
+
+1. Locate the file LAOO-OTF.flt installed on your system as part of the
+m17n library. Usually it is under the directory /usr/share/m17n.
+
+2. Apply the following patch to LAOO-OTF.flt
+
+------------------------------------------------------------
+diff --git a/FLT/LAOO-OTF.flt b/FLT/LAOO-OTF.flt
+index 5504171..431adf8 100644
+--- a/FLT/LAOO-OTF.flt
++++ b/FLT/LAOO-OTF.flt
+@@ -3,7 +3,7 @@
+ ;; See the end for copying conditions.
+
+ (font layouter laoo-otf nil
+- (font (nil phetsarath\ ot unicode-bmp)))
++ (font (nil nil unicode-bmp :otf=lao\ )))
+
+ ;;; <li> LAOO-OTF.flt
+
+------------------------------------------------------------
+
+If you can't modify that file directly, copy it to the directory
+~/.m17n.d/ (create it if it doesn't exist), and apply the patch.
+
* Internationalization problems
** M-{ does not work on a Spanish PC keyboard.
@@ -1063,10 +1090,10 @@ reported to refuse such attempts and snap back to the width needed to
show the full menu bar (wmii) or at least cause the screen to flicker
during such resizing attempts (i3, IceWM).
-See also http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15700,
-http://debbugs.gnu.org/cgi/bugreport.cgi?bug=22000,
-http://debbugs.gnu.org/cgi/bugreport.cgi?bug=22898 and
-http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg00154.html.
+See also https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15700,
+https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22000,
+https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22898 and
+https://lists.gnu.org/r/emacs-devel/2016-07/msg00154.html.
*** Metacity: Resizing Emacs or ALT-Tab causes X to be unresponsive.
@@ -1086,14 +1113,6 @@ to happen in *.UTF-8 locales; zh_CN.GB2312 and zh_CN.GBK locales, for
example, work fine. A bug report has been filed in the Gnome
bugzilla: http://bugzilla.gnome.org/show_bug.cgi?id=357032
-*** Gnome: Emacs's xterm-mouse-mode doesn't work on the Gnome terminal.
-
-A symptom of this bug is that double-clicks insert a control sequence
-into the buffer. The reason this happens is an apparent
-incompatibility of the Gnome terminal with Xterm, which also affects
-other programs using the Xterm mouse interface. A problem report has
-been filed.
-
*** Gnome: GPaste clipboard manager causes erratic behavior of 'yank'
The symptom is that 'kill-line' followed by 'yank' often (but not
@@ -1743,7 +1762,7 @@ global-font-lock-mode RET" or by customizing the variable
'global-font-lock-mode'.
** Unexpected characters inserted into the buffer when you start Emacs.
-See e.g. <URL:http://debbugs.gnu.org/11129>
+See e.g. <URL:https://debbugs.gnu.org/11129>
This can happen when you start Emacs in -nw mode in an Xterm.
For example, in the *scratch* buffer, you might see something like:
@@ -1782,7 +1801,7 @@ exec 2> >(exec cat >&2 2>/dev/null)
exec ssh "$@"
*** GNU/Linux: Truncated svn annotate output with SSH.
-http://debbugs.gnu.org/7791
+https://debbugs.gnu.org/7791
The symptoms are: you are accessing a svn repository over SSH.
You use vc-annotate on a large (several thousand line) file, and the
@@ -2032,6 +2051,19 @@ Definitions" to make them defined.
We list bugs in current versions here. See also the section on legacy
systems.
+*** On Solaris 10, Emacs crashes during the build process.
+This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun
+Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C
+5.15), and intermittently for sparc-sun-solaris2.10 with Oracle
+Developer Studio 12.5 (Sun C 5.14). Disabling compiler optimization
+seems to fix the bug, as does upgrading the Solaris 10 operating
+system to Update 11. The cause of the bug is unknown: it may be that
+Emacs's archaic memory-allocation scheme is not compatible with
+slightly-older versions of Solaris and/or Oracle Studio, or it may be
+something else. Since the cause is not known, possibly the bug is
+still present in newer versions of Emacs, Oracle Studio, and/or
+Solaris. See Bug#26638.
+
*** On Solaris, C-x doesn't get through to Emacs when you use the console.
This is a Solaris feature (at least on Intel x86 cpus). Type C-r
@@ -2601,7 +2633,7 @@ This is a consequence of a change to src/dired.c on 2010-07-27. The
issue is that Cygwin 1.5.19 did not have d_ino in 'struct dirent'.
See
- http://lists.gnu.org/archive/html/emacs-devel/2010-07/msg01266.html
+ https://lists.gnu.org/r/emacs-devel/2010-07/msg01266.html
*** Building the native MS-Windows port fails due to unresolved externals
@@ -2702,7 +2734,7 @@ Errors and warnings can look like this:
This happens when paths using backslashes are passed to the compiler or
linker (via -I and possibly other compiler flags); when these paths are
included in source code, the backslashes are interpreted as escape sequences.
-See http://lists.gnu.org/archive/html/emacs-devel/2010-07/msg00995.html
+See https://lists.gnu.org/r/emacs-devel/2010-07/msg00995.html
The fix is to use forward slashes in all paths passed to the compiler.
@@ -2757,7 +2789,7 @@ Compiling the lisp files fails at random places, complaining:
"No rule to make target '/path/to/some/lisp.elc'".
The causes of this problem are not understood. Using GNU make 3.81 compiled
from source, rather than the Ubuntu version, worked.
-See <URL:http://debbugs.gnu.org/327>, <URL:http://debbugs.gnu.org/821>.
+See <URL:https://debbugs.gnu.org/327>, <URL:https://debbugs.gnu.org/821>.
** Dumping
@@ -2927,20 +2959,6 @@ release was reported to work without problems. It worked OK on
another system with Solaris 8 using apparently the same 5.0 compiler
and the default CFLAGS.
-**** Solaris 2.x: Emacs dumps core when built with Motif.
-
-The Solaris Motif libraries are buggy, at least up through Solaris 2.5.1.
-Install the current Motif runtime library patch appropriate for your host.
-(Make sure the patch is current; some older patch versions still have the bug.)
-You should install the other patches recommended by Sun for your host, too.
-You can obtain Sun patches from ftp://sunsolve.sun.com/pub/patches/;
-look for files with names ending in '.PatchReport' to see which patches
-are currently recommended for your host.
-
-On Solaris 2.6, Emacs is said to work with Motif when Solaris patch
-105284-12 is installed, but fail when 105284-15 is installed.
-105284-18 might fix it again.
-
**** Solaris 2.6 and 7: the Compose key does not work.
This is a bug in Motif in Solaris. Supposedly it has been fixed for
@@ -3201,7 +3219,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Local variables:
diff --git a/etc/TERMS b/etc/TERMS
index 52379724c76..0b558a6a844 100644
--- a/etc/TERMS
+++ b/etc/TERMS
@@ -245,4 +245,4 @@ COPYING PERMISSIONS:
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/THE-GNU-PROJECT b/etc/THE-GNU-PROJECT
index ece9aa6d888..d2aa15565e0 100644
--- a/etc/THE-GNU-PROJECT
+++ b/etc/THE-GNU-PROJECT
@@ -5,4 +5,4 @@ Note added March 2014:
This file is obsolete and will be removed in future.
Please update any references to use
-<http://www.gnu.org/gnu/thegnuproject.html>
+<https://www.gnu.org/gnu/thegnuproject.html>
diff --git a/etc/TODO b/etc/TODO
index af2f41bf966..6d087c1ed97 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -21,7 +21,7 @@ answers), at the emacs-devel@gnu.org mailing list.
For more information about getting involved, see the CONTRIBUTE file.
As well as the issues listed here, there are bug reports at
-<http://debbugs.gnu.org>. Bugs tagged "easy" ought to be suitable for
+<https://debbugs.gnu.org>. Bugs tagged "easy" ought to be suitable for
beginners to work on, but unfortunately we are not very good at using
this tag. Bugs tagged "help" are ones where assistance is required,
but may be difficult to fix. Bugs with severity "important" or higher
@@ -95,17 +95,17 @@ make it.
** Move idlwave to elpa.gnu.org.
Need to sync up the Emacs and external versions.
-See <http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00008.html>
+See <https://lists.gnu.org/r/emacs-devel/2014-07/msg00008.html>
** Move Org mode to elpa.gnu.org.
-See <http://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00300.html>
-<http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00257.html>
+See <https://lists.gnu.org/r/emacs-devel/2014-08/msg00300.html>
+<https://lists.gnu.org/r/emacs-devel/2014-11/msg00257.html>
** Move verilog-mode to elpa.gnu.org.
-See <http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg01180.html>
+See <https://lists.gnu.org/r/emacs-devel/2015-02/msg01180.html>
** Move vhdl-mode to elpa.gnu.org.
-See <http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg01180.html>
+See <https://lists.gnu.org/r/emacs-devel/2015-02/msg01180.html>
* Simple tasks. These don't require much Emacs knowledge, they are
suitable for anyone from beginners to experts.
@@ -157,7 +157,7 @@ for users to customize.
** revert-buffer should eliminate overlays and the mark.
For related problems consult the thread starting with
- http://lists.gnu.org/archive/html/emacs-devel/2005-11/msg01346.html
+ https://lists.gnu.org/r/emacs-devel/2005-11/msg01346.html
** erase-buffer should perhaps disregard read-only properties of text.
@@ -185,7 +185,7 @@ for users to customize.
** Define recompute-arg and recompute-arg-if for fix_command to use.
See rms message of 11 Dec 05 in
- http://lists.gnu.org/archive/html/emacs-pretest-bug/2005-12/msg00165.html,
+ https://lists.gnu.org/r/emacs-pretest-bug/2005-12/msg00165.html,
and the rest of that discussion.
** In Emacs Info, examples of using Customize should be clickable
@@ -202,10 +202,10 @@ for users to customize.
** make back_comment use syntax-ppss or equivalent.
** Consider improving src/sysdep.c's search for a fqdn.
-http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg00782.html
+https://lists.gnu.org/r/emacs-devel/2007-04/msg00782.html
** Find a proper fix for rcirc multiline nick adding.
-http://lists.gnu.org/archive/html/emacs-devel/2007-04/msg00684.html
+https://lists.gnu.org/r/emacs-devel/2007-04/msg00684.html
** Check for any included packages that define obsolete bug-reporting commands.
Change them to use report-emacs-bug.
@@ -228,12 +228,12 @@ like make-backup-file-name-function for non-numeric backup files.
dired buffers and DTRT WRT 'auto-revert-mode'.
** Check uses of prin1 for error-handling.
-http://lists.gnu.org/archive/html/emacs-devel/2008-08/msg00456.html
+https://lists.gnu.org/r/emacs-devel/2008-08/msg00456.html
* Important features:
** "Emacs as word processor"
-http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00515.html
+https://lists.gnu.org/r/emacs-devel/2013-11/msg00515.html
rms writes:
25 years ago I hoped we would extend Emacs to do WYSIWYG word
processing. That is why we added text properties and variable
@@ -311,15 +311,15 @@ never really made it work for this.
Perspectives also need to interact with the tabs.
** FFI (foreign function interface)
-See eg http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00246.html
+See eg https://lists.gnu.org/r/emacs-devel/2013-10/msg00246.html
One way of doing this is to start with fx's dynamic loading, and use it
to implement things like auto-loaded buffer parsers and database
access in cases which need more than Lisp.
** Replace unexec with a more portable form of dumping
-See eg http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01034.html
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00452.html
+See eg https://lists.gnu.org/r/emacs-devel/2014-01/msg01034.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00452.html
One way is to provide portable undumping using mmap (per gerd design).
@@ -345,7 +345,7 @@ scroll bars are extensible.
** Program Enriched mode to read and save in RTF. [Is there actually a
decent single definition of RTF? Maybe see info at
http://latex2rtf.sourceforge.net/.] This task seems to be addressed
- by http://savannah.nongnu.org/projects/emacs-rtf/, which is still in
+ by https://savannah.nongnu.org/projects/emacs-rtf/, which is still in
very early stages.
Another place to look is the Wikipedia article at
@@ -399,8 +399,8 @@ familiar with GNUstep and Objective C.
** A more modern printing interface. One that pops up a dialog that lets
you choose printer, page style, etc.
Integration with the Gtk print dialog is apparently difficult. See eg:
-http://lists.gnu.org/archive/html/emacs-devel/2009-03/msg00501.html
-http://lists.gnu.org/archive/html/emacs-devel/2009-04/msg00034.html
+https://lists.gnu.org/r/emacs-devel/2009-03/msg00501.html
+https://lists.gnu.org/r/emacs-devel/2009-04/msg00034.html
** Allow frames(terminals) created by emacsclient to inherit their environment
from the emacsclient process.
@@ -499,7 +499,7 @@ from the emacsclient process.
** Get some major packages installed: W3 (development version needs
significant work), PSGML, _possibly_ ECB.
- http://lists.gnu.org/archive/html/emacs-devel/2007-05/msg01493.html
+ https://lists.gnu.org/r/emacs-devel/2007-05/msg01493.html
Check the assignments file for other packages which might go in and
have been missed.
@@ -645,17 +645,17 @@ from the emacsclient process.
** Possibly make 'list-holidays' eval items in the calendar-holidays variable.
See thread
- <http://lists.gnu.org/archive/html/emacs-devel/2006-02/msg01034.html>.
+ <https://lists.gnu.org/r/emacs-devel/2006-02/msg01034.html>.
[rgm@gnu.org will look at this after 22.1]
** Possibly make cal-dst use the system timezone database directly.
See thread
- <http://lists.gnu.org/archive/html/emacs-pretest-bug/2006-11/msg00060.html>
+ <https://lists.gnu.org/r/emacs-pretest-bug/2006-11/msg00060.html>
** Possibly add a "close" button to the modeline.
The idea is to add an "X" of some kind, that when clicked deletes
the window associated with that modeline.
- http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html
+ https://lists.gnu.org/r/emacs-devel/2007-09/msg02416.html
* Things to be done for specific packages or features
@@ -805,8 +805,8 @@ One could envision asymmetrical variants as well, however, this is
inappropriate for the default setting.
See the discussion on emacs-devel:
-https://lists.gnu.org/archive/html/emacs-devel/2015-12/msg01575.html
-https://lists.gnu.org/archive/html/emacs-devel/2016-01/msg00008.html
+https://lists.gnu.org/r/emacs-devel/2015-12/msg01575.html
+https://lists.gnu.org/r/emacs-devel/2016-01/msg00008.html
*** Internal development features
@@ -824,7 +824,7 @@ of unique features.
**** Existing packages
Note that there is a generic UI test named frame-test.el, see
-http://debbugs.gnu.org/21415#284 .
+https://debbugs.gnu.org/21415#284 .
The NS interface passes this, with the exception of two toolbar-related errors.
**** Anders frame test
@@ -872,9 +872,9 @@ of the two patches, Emacs responds that s-9 was pressed.
More investigation is needed to fix this problem.
Links:
-- http://debbugs.gnu.org/19977
-- http://debbugs.gnu.org/21330
-- http://debbugs.gnu.org/21551
+- https://debbugs.gnu.org/19977
+- https://debbugs.gnu.org/21330
+- https://debbugs.gnu.org/21551
**** Toggling the toolbar in fullheight or maximized modes
@@ -1492,7 +1492,7 @@ presence of multi-file documents.
or just an extension of buff-menu.el.
** Replace linum.el with nlinum.el
- http://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00379.html
+ https://lists.gnu.org/r/emacs-devel/2013-08/msg00379.html
** Merge sendmail.el and messages.el.
Probably not a complete merge, but at least arrange for messages.el to be
@@ -1507,7 +1507,7 @@ presence of multi-file documents.
** Rewrite make-docfile to be clean and maintainable.
It might be better to replace it with Lisp, using the byte compiler.
- http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00037.html
+ https://lists.gnu.org/r/emacs-devel/2012-06/msg00037.html
** Add an inferior-comint-minor-mode to capture the common set of operations
offered by major modes that offer an associated inferior
@@ -1523,7 +1523,7 @@ presence of multi-file documents.
* Wishlist items:
** Maybe replace etags.c with a Lisp implementation.
-http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00354.html
+https://lists.gnu.org/r/emacs-devel/2012-06/msg00354.html
** Maybe replace lib-src/rcs2log with a Lisp implementation.
It wouldn't have to be a complete replacement, just enough
@@ -1550,7 +1550,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/etc/WHY-FREE b/etc/WHY-FREE
index a70232d84a6..cd2c2fcf8d8 100644
--- a/etc/WHY-FREE
+++ b/etc/WHY-FREE
@@ -5,4 +5,4 @@ Note added March 2014:
This file is obsolete and will be removed in future.
Please update any references to use
-<http://www.gnu.org/philosophy/why-free.html>
+<https://www.gnu.org/philosophy/why-free.html>
diff --git a/etc/charsets/README b/etc/charsets/README
index 315c3643452..101e0567a23 100644
--- a/etc/charsets/README
+++ b/etc/charsets/README
@@ -18,7 +18,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(1) Format of mapping files
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 85e3632b7c9..970c04e972f 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -640,4 +640,4 @@ COPYING PERMISSIONS:
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/edt-user.el b/etc/edt-user.el
index 80f3b7e578f..6d729a7b672 100644
--- a/etc/edt-user.el
+++ b/etc/edt-user.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb
index 48e9a5dac1b..7d9d6488ee8 100644
--- a/etc/emacs-buffer.gdb
+++ b/etc/emacs-buffer.gdb
@@ -18,7 +18,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Commentary:
diff --git a/etc/emacs.appdata.xml b/etc/emacs.appdata.xml
index 0ba305c4522..c3b1afb6284 100644
--- a/etc/emacs.appdata.xml
+++ b/etc/emacs.appdata.xml
@@ -25,9 +25,9 @@
</ul>
</description>
<screenshots>
- <screenshot type="default" width="632" height="354">http://www.gnu.org/software/emacs/images/appdata.png</screenshot>
+ <screenshot type="default" width="632" height="354">https://www.gnu.org/software/emacs/images/appdata.png</screenshot>
</screenshots>
- <url type="homepage">http://www.gnu.org/software/emacs</url>
+ <url type="homepage">https://www.gnu.org/software/emacs</url>
<updatecontact>emacs-devel_at_gnu.org</updatecontact>
<project_group>GNU</project_group>
</application>
diff --git a/etc/enriched.txt b/etc/enriched.txt
index e1f2d6cc15d..0a29116716a 100644
--- a/etc/enriched.txt
+++ b/etc/enriched.txt
@@ -254,4 +254,4 @@ COPYING PERMISSIONS:
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <<http://www.gnu.org/licenses/>.
+ along with this program. If not, see <<https://www.gnu.org/licenses/>.
diff --git a/etc/forms/forms-d2.el b/etc/forms/forms-d2.el
index edd1a2dd590..96a49dad10f 100644
--- a/etc/forms/forms-d2.el
+++ b/etc/forms/forms-d2.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt
index 74b110f4798..3d2d7423825 100644
--- a/etc/gnus-tut.txt
+++ b/etc/gnus-tut.txt
@@ -42,7 +42,7 @@ heart's delight at <URL:http://www.ifi.uio.no/~larsi/larsi.html>.
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
From lars Thu Feb 23 23:20:38 1995
From: larsi@ifi.uio.no (ding)
diff --git a/etc/grep.txt b/etc/grep.txt
index 582bc5fd012..f01a96bf46a 100644
--- a/etc/grep.txt
+++ b/etc/grep.txt
@@ -112,7 +112,7 @@ COPYING PERMISSIONS:
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Local Variables:
diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm
index 033da686d5d..c41cb90df8f 100644
--- a/etc/images/checked.xpm
+++ b/etc/images/checked.xpm
@@ -16,7 +16,7 @@
* 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 <http://www.gnu.org/licenses/>.
+ * along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
static char * checked_xpm[] = {
"12 12 5 1",
diff --git a/etc/images/gnus/gnus.svg b/etc/images/gnus/gnus.svg
index 0d9d863b112..ba2186def61 100644
--- a/etc/images/gnus/gnus.svg
+++ b/etc/images/gnus/gnus.svg
@@ -18,7 +18,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-->
<!-- Created with Inkscape (http://www.inkscape.org/) -->
@@ -49,7 +49,7 @@
<dc:type
rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
<cc:license
- rdf:resource="http://www.gnu.org/copyleft/gpl.html" />
+ rdf:resource="https://www.gnu.org/copyleft/gpl.html" />
<dc:title>gnus</dc:title>
<dc:date>2008/06/28</dc:date>
<dc:creator>
@@ -64,7 +64,7 @@
</dc:rights>
<dc:description>gnus splash image</dc:description>
<cc:license
- rdf:resource="http://www.gnu.org/copyleft/gpl.html" />
+ rdf:resource="https://www.gnu.org/copyleft/gpl.html" />
</cc:Work>
</rdf:RDF>
</metadata>
diff --git a/etc/images/icons/hicolor/scalable/apps/emacs.ico b/etc/images/icons/hicolor/scalable/apps/emacs.ico
new file mode 100644
index 00000000000..70591275217
--- /dev/null
+++ b/etc/images/icons/hicolor/scalable/apps/emacs.ico
Binary files differ
diff --git a/etc/images/icons/hicolor/scalable/apps/emacs.svg b/etc/images/icons/hicolor/scalable/apps/emacs.svg
index 632d53ef2af..d329199df7e 100644
--- a/etc/images/icons/hicolor/scalable/apps/emacs.svg
+++ b/etc/images/icons/hicolor/scalable/apps/emacs.svg
@@ -32,7 +32,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
--><!-- Created with Inkscape (http://www.inkscape.org/) --><defs
id="defs4770"><linearGradient
diff --git a/etc/images/icons/hicolor/scalable/apps/emacs23.svg b/etc/images/icons/hicolor/scalable/apps/emacs23.svg
index 3e2168f6088..d3145385bf6 100644
--- a/etc/images/icons/hicolor/scalable/apps/emacs23.svg
+++ b/etc/images/icons/hicolor/scalable/apps/emacs23.svg
@@ -25,7 +25,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-->
<!-- Created with Inkscape (http://www.inkscape.org/) -->
diff --git a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg
index e4f4dc6f2bd..4451a97550f 100644
--- a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg
+++ b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg
@@ -16,7 +16,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-->
<!-- Created with Inkscape (http://www.inkscape.org/) -->
diff --git a/etc/images/mh-logo.xpm b/etc/images/mh-logo.xpm
index b2017c6f637..fe7474184ce 100644
--- a/etc/images/mh-logo.xpm
+++ b/etc/images/mh-logo.xpm
@@ -18,7 +18,7 @@
* 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 <http://www.gnu.org/licenses/>.
+ * along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
static char *mh-e[] = {
/* width height num_colors chars_per_pixel */
diff --git a/etc/images/splash.bmp b/etc/images/splash.bmp
new file mode 100644
index 00000000000..3ec4c276d53
--- /dev/null
+++ b/etc/images/splash.bmp
Binary files differ
diff --git a/etc/images/splash.svg b/etc/images/splash.svg
index 4957d824fe9..ea919bd90e0 100644
--- a/etc/images/splash.svg
+++ b/etc/images/splash.svg
@@ -19,7 +19,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-->
@@ -89,7 +89,7 @@
</cc:Agent>
</dc:contributor>
<cc:license
- rdf:resource="http://www.gnu.org/copyleft/gpl.html" />
+ rdf:resource="https://www.gnu.org/copyleft/gpl.html" />
</cc:Work>
</rdf:RDF>
</metadata>
diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm
index f7ca8609f23..04f7556406d 100644
--- a/etc/images/unchecked.xpm
+++ b/etc/images/unchecked.xpm
@@ -16,7 +16,7 @@
* 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 <http://www.gnu.org/licenses/>.
+ * along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
static char * unchecked_xpm[] = {
"12 12 5 1",
diff --git a/etc/org/OrgOdtStyles.xml b/etc/org/OrgOdtStyles.xml
index f41d9840cbe..1a8edee99b4 100644
--- a/etc/org/OrgOdtStyles.xml
+++ b/etc/org/OrgOdtStyles.xml
@@ -110,33 +110,53 @@
<style:style style:name="Heading_20_1" style:display-name="Heading 1" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="1" style:class="text">
<style:text-properties fo:font-size="115%" fo:font-weight="bold" style:font-size-asian="115%" style:font-weight-asian="bold" style:font-size-complex="115%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_1_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_1" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_2" style:display-name="Heading 2" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="2" style:class="text">
<style:text-properties fo:font-size="14pt" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="14pt" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-style-complex="italic" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_2_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_2" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_3" style:display-name="Heading 3" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="3" style:class="text">
<style:text-properties fo:font-size="14pt" fo:font-weight="bold" style:font-size-asian="14pt" style:font-weight-asian="bold" style:font-size-complex="14pt" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_3_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_3" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_4" style:display-name="Heading 4" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="4" style:class="text">
<style:text-properties fo:font-size="85%" fo:font-style="italic" fo:font-weight="bold" style:font-size-asian="85%" style:font-style-asian="italic" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-style-complex="italic" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_4_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_4" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_5" style:display-name="Heading 5" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="5" style:class="text">
<style:text-properties fo:font-size="85%" fo:font-weight="bold" style:font-size-asian="85%" style:font-weight-asian="bold" style:font-size-complex="85%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_5_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_5" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_6" style:display-name="Heading 6" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="6" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_6_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_6" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_7" style:display-name="Heading 7" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="7" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_7_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_7" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_8" style:display-name="Heading 8" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="8" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_8_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_8" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_9" style:display-name="Heading 9" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="9" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_9_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_9" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_10" style:display-name="Heading 10" style:family="paragraph" style:parent-style-name="Heading" style:next-style-name="Text_20_body" style:default-outline-level="10" style:class="text">
<style:text-properties fo:font-size="75%" fo:font-weight="bold" style:font-size-asian="75%" style:font-weight-asian="bold" style:font-size-complex="75%" style:font-weight-complex="bold"/>
</style:style>
+ <style:style style:name="Heading_20_10_unnumbered" style:family="paragraph" style:parent-style-name="Heading_20_10" style:list-style-name="">
+ </style:style>
<style:style style:name="Heading_20_1.title" style:display-name="Heading 1.title" style:family="paragraph" style:parent-style-name="Heading_20_1">
<style:paragraph-properties fo:text-align="center" style:justify-single-word="false"/>
</style:style>
diff --git a/etc/org/README b/etc/org/README
index 68905add814..9d11c07b39f 100644
--- a/etc/org/README
+++ b/etc/org/README
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Author: Jambunathan K <kjambunathan at gmail dot com>
diff --git a/etc/ps-prin0.ps b/etc/ps-prin0.ps
index 66e46eac50b..b2d148fc694 100644
--- a/etc/ps-prin0.ps
+++ b/etc/ps-prin0.ps
@@ -16,7 +16,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% As a special exception, the copyright holders of this module give
% you permission to include the module in a Postscript file generated
diff --git a/etc/ps-prin1.ps b/etc/ps-prin1.ps
index c45aa6a40ea..b46f312fa31 100644
--- a/etc/ps-prin1.ps
+++ b/etc/ps-prin1.ps
@@ -16,7 +16,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% As a special exception, the copyright holders of this module give
% you permission to include the module in a Postscript file generated
diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile
index e998ab7abc6..3a8ca60045d 100644
--- a/etc/refcards/Makefile
+++ b/etc/refcards/Makefile
@@ -15,7 +15,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/etc/refcards/README b/etc/refcards/README
index 178cb9290d6..492833d2d82 100644
--- a/etc/refcards/README
+++ b/etc/refcards/README
@@ -20,8 +20,8 @@ To only generate the cards for a specific language, use e.g.
to install extra TeX packages for some languages.
PDF and PS copies of these cards are also available at
-<http://www.gnu.org/software/emacs/refcards>. The FSF online
-store <http://shop.fsf.org/> sometimes has printed copies for sale.
+<https://www.gnu.org/software/emacs/refcards>. The FSF online
+store <https://shop.fsf.org/> sometimes has printed copies for sale.
@@ -50,4 +50,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/refcards/calccard.tex b/etc/refcards/calccard.tex
index 45072722ab8..93aa007834f 100644
--- a/etc/refcards/calccard.tex
+++ b/etc/refcards/calccard.tex
@@ -39,7 +39,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
%
@@ -82,7 +82,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
@@ -670,4 +670,3 @@ Variable names are single digits or whole words.
% Local variables:
% compile-command: "pdftex calccard"
% End:
-
diff --git a/etc/refcards/cs-dired-ref.tex b/etc/refcards/cs-dired-ref.tex
index 8a05babfaee..6c4c3d6c370 100644
--- a/etc/refcards/cs-dired-ref.tex
+++ b/etc/refcards/cs-dired-ref.tex
@@ -22,7 +22,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% See dired-ref.tex.
@@ -64,7 +64,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex
index 69128934a3e..14434581ab7 100644
--- a/etc/refcards/cs-refcard.tex
+++ b/etc/refcards/cs-refcard.tex
@@ -25,7 +25,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -81,7 +81,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex
index bb140917217..0770100bd98 100644
--- a/etc/refcards/cs-survival.tex
+++ b/etc/refcards/cs-survival.tex
@@ -22,7 +22,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% See survival.tex.
@@ -72,7 +72,7 @@
For more Emacs documentation, and the \TeX{} source for this card,
see the Emacs distribution, or
- {\tt http://www.gnu.org/software/emacs}\par}}
+ {\tt https://www.gnu.org/software/emacs}\par}}
\hsize 3.2in
\vsize 7.95in
diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex
index b5ca8629172..82e4f9863a6 100644
--- a/etc/refcards/de-refcard.tex
+++ b/etc/refcards/de-refcard.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -83,7 +83,7 @@ Released under the terms of the GNU General Public License
version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
@@ -679,4 +679,3 @@ wird. F\"ur n\"ahere Details geben Sie \kbd{C-h f interactive} ein.
% Local variables:
% compile-command: "pdftex de-refcard"
% End:
-
diff --git a/etc/refcards/dired-ref.tex b/etc/refcards/dired-ref.tex
index 86c53d079e1..26b2a2852ff 100644
--- a/etc/refcards/dired-ref.tex
+++ b/etc/refcards/dired-ref.tex
@@ -21,7 +21,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -37,7 +37,7 @@
\newcount\columnsperpage
% This file can be printed with 1, 2, or 3 columns per page.
-% Specify how many you want here.
+% Specify how many you want here.
% The reference card looks OK with 2 columns per page, portrait mode.
% I haven't tried it with 3 columns per page.
\columnsperpage=2
@@ -65,7 +65,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
@@ -405,4 +405,3 @@ see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
\copyrightnotice
\bye
-
diff --git a/etc/refcards/fr-dired-ref.tex b/etc/refcards/fr-dired-ref.tex
index 68e492fbab9..183b086c5df 100644
--- a/etc/refcards/fr-dired-ref.tex
+++ b/etc/refcards/fr-dired-ref.tex
@@ -22,7 +22,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% See dired-ref.tex.
@@ -59,7 +59,7 @@ Released under the terms of the GNU General Public License
version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex
index 294e3ad69c9..dbeb2baffe0 100644
--- a/etc/refcards/fr-refcard.tex
+++ b/etc/refcards/fr-refcard.tex
@@ -24,7 +24,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -79,7 +79,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex
index f0885e5923a..047190c1ecb 100644
--- a/etc/refcards/fr-survival.tex
+++ b/etc/refcards/fr-survival.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% See survival.tex.
@@ -67,7 +67,7 @@
For more Emacs documentation, and the \TeX{} source for this card,
see the Emacs distribution,
- or {\tt http://www.gnu.org/software/emacs}\par}}
+ or {\tt https://www.gnu.org/software/emacs}\par}}
\hsize 3.2in
\vsize 7.95in
diff --git a/etc/refcards/gnus-logo.eps b/etc/refcards/gnus-logo.eps
index aff7a31cbc3..34301e6e70c 100644
--- a/etc/refcards/gnus-logo.eps
+++ b/etc/refcards/gnus-logo.eps
@@ -16,7 +16,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
%
%%Title: gnuslogo1.ps
%%BoundingBox: 0 0 493 505
diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex
index 676820835f0..bc52733bfb1 100644
--- a/etc/refcards/gnus-refcard.tex
+++ b/etc/refcards/gnus-refcard.tex
@@ -126,7 +126,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
- see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+ see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}
Please send corrections, additions and suggestions to the
current maintainer's email address. \Guide{} last edited on \date.
diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex
index b12ae7be592..ad0d3bc13e5 100644
--- a/etc/refcards/orgcard.tex
+++ b/etc/refcards/orgcard.tex
@@ -1,6 +1,6 @@
% Reference Card for Org Mode
-\def\orgversionnumber{8.2}
-\def\versionyear{2014} % latest update
+\def\orgversionnumber{9.1.4}
+\def\versionyear{2017} % latest update
\input emacsver.tex
%**start of header
@@ -37,7 +37,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
%
@@ -81,7 +81,7 @@
\centerline{version 3 or later.}
\centerline{For more Emacs documentation, and the \TeX{} source for this card, see}
-\centerline{the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}}
+\centerline{the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}}
\endgroup}
@@ -312,10 +312,11 @@
\key{turn item/line into headline}{C-c *}
\key{promote/demote heading}{M-LEFT/RIGHT}
\metax{promote/demote current subtree}{M-S-LEFT/RIGHT}
-\metax{move subtree/list item up/down}{M-S-UP/DOWN}
+\metax{move subtree/list item up/down}{M-UP/DOWN}
+\metax{move the line at point up/down}{M-S-UP/DOWN}
\metax{sort subtree/region/plain-list}{C-c \^{}}
\metax{clone a subtree}{C-c C-x c}
-\metax{copy visible text}{C-c C-x v}
+\metax{copy visible parts of the region}{C-c C-x v}
\metax{kill/copy subtree}{C-c C-x C-w/M-w}
\metax{yank subtree}{C-c C-x C-y or C-y}
\metax{narrow buffer to subtree / widen}{C-x n s/w}
@@ -333,7 +334,6 @@
\key{construct a sparse tree by various criteria}{C-c /}
\key{view TODO's in sparse tree}{C-c / t/T}
\key{global TODO list in agenda mode}{C-c a t \noteone}
-\key{time sorted view of current org file}{C-c a L}
\section{Tables}
@@ -375,7 +375,6 @@ Outside of tables, the same keys may have other functionality.
\metax{cut/copy/paste rectangular region}{C-c C-x C-w/M-w/C-y}
%\key{copy rectangular region}{C-c C-x M-w}
%\key{paste rectangular region}{C-c C-x C-y}
-\key{fill paragraph across selected cells}{C-c C-q}
{\bf Miscellaneous}
@@ -574,7 +573,6 @@ after ``{\tt :}'', and dictionary words elsewhere.
\key{match tags, TODO kwds, properties}{C-c a m \noteone}
\key{match only in TODO entries}{C-c a M \noteone}
\key{find stuck projects}{C-c a \# \noteone}
-\key{show timeline of current org file}{C-c a L \noteone}
\key{configure custom commands}{C-c a C \noteone}
%\key{configure stuck projects}{C-c a ! \noteone}
\key{agenda for date at cursor}{C-c C-o}
@@ -661,8 +659,11 @@ some other place.
\key{export/publish dispatcher}{C-c C-e}
-\key{export visible part only}{C-c C-e v}
-\key{insert template of export options}{C-c C-e t}
+\key{toggle asynchronous export}{C-c C-e C-a}
+\key{toggle body/visible only export}{C-c C-e C-b/v}
+\key{toggle subtree export}{C-c C-e C-s}
+\key{insert template of export options}{C-c C-e \#}
+
\key{toggle fixed width for entry or region}{C-c :}
\key{toggle pretty display of scripts, entities}{C-c C-x {\tt\char`\\}}
@@ -690,6 +691,5 @@ your own key as shown under ACTIVATION.
\bye
% Local variables:
-% compile-command: "tex refcard"
+% compile-command: "pdftex orgcard"
% End:
-
diff --git a/etc/refcards/pdflayout.sty b/etc/refcards/pdflayout.sty
index affb47520fd..90bf6bd0025 100644
--- a/etc/refcards/pdflayout.sty
+++ b/etc/refcards/pdflayout.sty
@@ -13,7 +13,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file defines `\pdflayout':
% - \pdflayout=(0) is A4 portrait,
diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex
index 0bddea458ca..ac0eca1b983 100644
--- a/etc/refcards/pl-refcard.tex
+++ b/etc/refcards/pl-refcard.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -91,7 +91,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http:////www.gnu.org//software//emacs}
+see 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
@@ -992,4 +992,3 @@ przez wywo/lanie \kbd{C-h f interactive}.
% Local variables:
% compile-command: "pdftex pl-refcard"
% End:
-
diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex
index 1ba50fa1c78..dc9f0ae355f 100644
--- a/etc/refcards/pt-br-refcard.tex
+++ b/etc/refcards/pt-br-refcard.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -84,7 +84,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex
index 0a57fcf9ced..37808978177 100644
--- a/etc/refcards/refcard.tex
+++ b/etc/refcards/refcard.tex
@@ -22,7 +22,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -82,7 +82,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
@@ -696,4 +696,3 @@ Type \kbd{C-h f interactive RET} for more details.
% Local variables:
% compile-command: "pdftex refcard"
% End:
-
diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex
index fad75ddda47..a168e085255 100644
--- a/etc/refcards/ru-refcard.tex
+++ b/etc/refcards/ru-refcard.tex
@@ -20,7 +20,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
\documentclass[10pt]{article}
\usepackage{multicol,tabularx}
@@ -40,7 +40,7 @@
\newlength{\ColThreeWidth}
\setlength{\ColThreeWidth}{25mm}
-\newcommand{\versionemacs}[0]{26} % version of Emacs this is for
+\newcommand{\versionemacs}[0]{27} % version of Emacs this is for
\newcommand{\cyear}[0]{2017} % copyright year
\newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill
@@ -58,7 +58,7 @@
version 3 or later.}
\centerline{For more Emacs documentation, and the \TeX{} source for this card,}
-\centerline{see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}}
+\centerline{see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}}
\endgroup}
\hyphenation{mini-buf-fer}
diff --git a/etc/refcards/sk-dired-ref.tex b/etc/refcards/sk-dired-ref.tex
index 9af5499b84b..9818add524c 100644
--- a/etc/refcards/sk-dired-ref.tex
+++ b/etc/refcards/sk-dired-ref.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% See dired-ref.tex.
@@ -65,7 +65,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex
index dae3d8b6f05..eb5f91acfc0 100644
--- a/etc/refcards/sk-refcard.tex
+++ b/etc/refcards/sk-refcard.tex
@@ -26,7 +26,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -82,7 +82,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex
index 52e1eefd855..f07197704d1 100644
--- a/etc/refcards/sk-survival.tex
+++ b/etc/refcards/sk-survival.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% See survival.tex.
@@ -74,7 +74,7 @@
For more Emacs documentation, and the \TeX{} source for this card,
see the Emacs distribution,
- or {\tt http://www.gnu.org/software/emacs}\par}}
+ or {\tt https://www.gnu.org/software/emacs}\par}}
\hsize 3.2in
\vsize 7.95in
diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex
index 81ee44e39d0..7b5325b0096 100644
--- a/etc/refcards/survival.tex
+++ b/etc/refcards/survival.tex
@@ -22,7 +22,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
%**start of header
@@ -61,7 +61,7 @@
For more Emacs documentation, and the \TeX{} source for this card,
see the Emacs distribution,
- or {\tt http://www.gnu.org/software/emacs}\par}}
+ or {\tt https://www.gnu.org/software/emacs}\par}}
\hsize 3.2in
\vsize 7.95in
@@ -416,4 +416,3 @@ contains names of the current modes, in parentheses.
% Local variables:
% compile-command: "pdftex survival"
% End:
-
diff --git a/etc/refcards/vipcard.tex b/etc/refcards/vipcard.tex
index 5913dd4070a..61ccdd53c71 100644
--- a/etc/refcards/vipcard.tex
+++ b/etc/refcards/vipcard.tex
@@ -21,7 +21,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -74,7 +74,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
@@ -679,4 +679,3 @@ moves 11 lines below current line to the end of buffer.
% Local variables:
% compile-command: "pdftex vipcard"
% End:
-
diff --git a/etc/refcards/viperCard.tex b/etc/refcards/viperCard.tex
index 6561a48b08d..cebe485cf7c 100644
--- a/etc/refcards/viperCard.tex
+++ b/etc/refcards/viperCard.tex
@@ -23,7 +23,7 @@
% 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 <http://www.gnu.org/licenses/>.
+% along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
% This file is intended to be processed by plain TeX (TeX82).
@@ -78,7 +78,7 @@
Released under the terms of the GNU General Public License version 3 or later.
For more Emacs documentation, and the \TeX{} source for this card,
-see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}
+see 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
@@ -740,4 +740,3 @@ Ex commands can be made to have history. See the manual for details.
% Local variables:
% compile-command: "pdftex viperCard"
% End:
-
diff --git a/etc/schema/locate.rnc b/etc/schema/locate.rnc
index 9af01981054..3f4e7bba125 100644
--- a/etc/schema/locate.rnc
+++ b/etc/schema/locate.rnc
@@ -13,7 +13,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
default namespace this = "http://thaiopensource.com/ns/locating-rules/1.0"
namespace local = ""
@@ -36,7 +36,7 @@ rule =
| typeId
# | typeIdBase
| extensionRule
-
+
## Group of rules. Useful with xml:base.
group = element group { common, rule* }
@@ -212,6 +212,6 @@ extensionRule =
anyElement = element * { attribute * { text }*, (text|anyElement)* }
-common =
+common =
# attribute xml:base { xsd:anyURI }?,
attribute * - (xml:base|this:*|local:*) { text }*
diff --git a/etc/schema/od-manifest-schema-v1.2-os.rnc b/etc/schema/od-manifest-schema-v1.2-os.rnc
new file mode 100644
index 00000000000..87f84d1ea87
--- /dev/null
+++ b/etc/schema/od-manifest-schema-v1.2-os.rnc
@@ -0,0 +1,88 @@
+# Open Document Format for Office Applications (OpenDocument) Version 1.2
+# OASIS Standard, 29 September 2011
+# Manifest Relax-NG Schema
+# Source: http://docs.oasis-open.org/office/v1.2/os/
+# Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved.
+#
+# All capitalized terms in the following text have the meanings assigned to them
+# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The
+# full Policy may be found at the OASIS website.
+#
+# This document and translations of it may be copied and furnished to others, and
+# derivative works that comment on or otherwise explain it or assist in its
+# implementation may be prepared, copied, published, and distributed, in whole or
+# in part, without restriction of any kind, provided that the above copyright
+# notice and this section are included on all such copies and derivative works.
+# However, this document itself may not be modified in any way, including by
+# removing the copyright notice or references to OASIS, except as needed for the
+# purpose of developing any document or deliverable produced by an OASIS
+# Technical Committee (in which case the rules applicable to copyrights, as set
+# forth in the OASIS IPR Policy, must be followed) or as required to translate it
+# into languages other than English.
+#
+# The limited permissions granted above are perpetual and will not be revoked by
+# OASIS or its successors or assigns.
+#
+# This document and the information contained herein is provided on an "AS IS"
+# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT
+# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT
+# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR
+# FITNESS FOR A PARTICULAR PURPOSE.
+
+namespace manifest =
+ "urn:oasis:names:tc:opendocument:xmlns:manifest:1.0"
+
+start = manifest
+manifest = element manifest:manifest { manifest-attlist, file-entry+ }
+manifest-attlist = attribute manifest:version { "1.2" }
+file-entry =
+ element manifest:file-entry { file-entry-attlist, encryption-data? }
+file-entry-attlist =
+ attribute manifest:full-path { \string }
+ & attribute manifest:size { nonNegativeInteger }?
+ & attribute manifest:media-type { \string }
+ & attribute manifest:preferred-view-mode {
+ "edit" | "presentation-slide-show" | "read-only" | namespacedToken
+ }?
+ & attribute manifest:version { \string }?
+encryption-data =
+ element manifest:encryption-data {
+ encryption-data-attlist,
+ algorithm,
+ start-key-generation?,
+ key-derivation
+ }
+encryption-data-attlist =
+ attribute manifest:checksum-type { "SHA1/1K" | anyURI }
+ & attribute manifest:checksum { base64Binary }
+algorithm =
+ element manifest:algorithm { algorithm-attlist, anyElements }
+algorithm-attlist =
+ attribute manifest:algorithm-name { "Blowfish CFB" | anyURI }
+ & attribute manifest:initialisation-vector { base64Binary }
+anyAttListOrElements =
+ attribute * { text }*,
+ anyElements
+anyElements =
+ element * {
+ mixed { anyAttListOrElements }
+ }*
+key-derivation =
+ element manifest:key-derivation { key-derivation-attlist, empty }
+key-derivation-attlist =
+ attribute manifest:key-derivation-name { "PBKDF2" | anyURI }
+ & attribute manifest:salt { base64Binary }
+ & attribute manifest:iteration-count { nonNegativeInteger }
+ & attribute manifest:key-size { nonNegativeInteger }?
+start-key-generation =
+ element manifest:start-key-generation {
+ start-key-generation-attlist, empty
+ }
+start-key-generation-attlist =
+ attribute manifest:start-key-generation-name { "SHA1" | anyURI }
+ & attribute manifest:key-size { nonNegativeInteger }?
+base64Binary = xsd:base64Binary
+namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" }
+nonNegativeInteger = xsd:nonNegativeInteger
+\string = xsd:string
+anyURI = xsd:anyURI
diff --git a/etc/schema/od-schema-v1.2-os.rnc b/etc/schema/od-schema-v1.2-os.rnc
new file mode 100644
index 00000000000..8d679d62e4e
--- /dev/null
+++ b/etc/schema/od-schema-v1.2-os.rnc
@@ -0,0 +1,6280 @@
+# Open Document Format for Office Applications (OpenDocument) Version 1.2
+# OASIS Standard, 29 September 2011
+# Relax-NG Schema
+# Source: http://docs.oasis-open.org/office/v1.2/os/
+# Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved.
+#
+# All capitalized terms in the following text have the meanings assigned to them
+# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The
+# full Policy may be found at the OASIS website.
+#
+# This document and translations of it may be copied and furnished to others, and
+# derivative works that comment on or otherwise explain it or assist in its
+# implementation may be prepared, copied, published, and distributed, in whole or
+# in part, without restriction of any kind, provided that the above copyright
+# notice and this section are included on all such copies and derivative works.
+# However, this document itself may not be modified in any way, including by
+# removing the copyright notice or references to OASIS, except as needed for the
+# purpose of developing any document or deliverable produced by an OASIS
+# Technical Committee (in which case the rules applicable to copyrights, as set
+# forth in the OASIS IPR Policy, must be followed) or as required to translate it
+# into languages other than English.
+#
+# The limited permissions granted above are perpetual and will not be revoked by
+# OASIS or its successors or assigns.
+#
+# This document and the information contained herein is provided on an "AS IS"
+# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT
+# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT
+# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR
+# FITNESS FOR A PARTICULAR PURPOSE.
+
+namespace anim = "urn:oasis:names:tc:opendocument:xmlns:animation:1.0"
+namespace chart = "urn:oasis:names:tc:opendocument:xmlns:chart:1.0"
+namespace config = "urn:oasis:names:tc:opendocument:xmlns:config:1.0"
+namespace db = "urn:oasis:names:tc:opendocument:xmlns:database:1.0"
+namespace dc = "http://purl.org/dc/elements/1.1/"
+namespace dr3d = "urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0"
+namespace draw = "urn:oasis:names:tc:opendocument:xmlns:drawing:1.0"
+namespace fo =
+ "urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0"
+namespace form = "urn:oasis:names:tc:opendocument:xmlns:form:1.0"
+namespace grddl = "http://www.w3.org/2003/g/data-view#"
+namespace math = "http://www.w3.org/1998/Math/MathML"
+namespace meta = "urn:oasis:names:tc:opendocument:xmlns:meta:1.0"
+namespace number = "urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0"
+namespace office = "urn:oasis:names:tc:opendocument:xmlns:office:1.0"
+namespace presentation =
+ "urn:oasis:names:tc:opendocument:xmlns:presentation:1.0"
+namespace script = "urn:oasis:names:tc:opendocument:xmlns:script:1.0"
+namespace smil =
+ "urn:oasis:names:tc:opendocument:xmlns:smil-compatible:1.0"
+namespace style = "urn:oasis:names:tc:opendocument:xmlns:style:1.0"
+namespace svg =
+ "urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0"
+namespace table = "urn:oasis:names:tc:opendocument:xmlns:table:1.0"
+namespace text = "urn:oasis:names:tc:opendocument:xmlns:text:1.0"
+namespace xforms = "http://www.w3.org/2002/xforms"
+namespace xhtml = "http://www.w3.org/1999/xhtml"
+namespace xlink = "http://www.w3.org/1999/xlink"
+
+office-process-content = attribute office:process-content { boolean }?
+start =
+ office-document
+ | office-document-content
+ | office-document-styles
+ | office-document-meta
+ | office-document-settings
+office-document =
+ element office:document {
+ office-document-attrs,
+ office-document-common-attrs,
+ office-meta,
+ office-settings,
+ office-scripts,
+ office-font-face-decls,
+ office-styles,
+ office-automatic-styles,
+ office-master-styles,
+ office-body
+ }
+office-document-content =
+ element office:document-content {
+ office-document-common-attrs,
+ office-scripts,
+ office-font-face-decls,
+ office-automatic-styles,
+ office-body
+ }
+office-document-styles =
+ element office:document-styles {
+ office-document-common-attrs,
+ office-font-face-decls,
+ office-styles,
+ office-automatic-styles,
+ office-master-styles
+ }
+office-document-meta =
+ element office:document-meta {
+ office-document-common-attrs, office-meta
+ }
+office-document-settings =
+ element office:document-settings {
+ office-document-common-attrs, office-settings
+ }
+office-document-common-attrs =
+ attribute office:version { "1.2" }
+ & attribute grddl:transformation {
+ list { anyIRI* }
+ }?
+office-document-attrs = attribute office:mimetype { \string }
+office-meta = element office:meta { office-meta-content-strict }?
+office-meta-content-strict = office-meta-data*
+office-body = element office:body { office-body-content }
+office-body-content =
+ element office:text {
+ office-text-attlist,
+ office-text-content-prelude,
+ office-text-content-main,
+ office-text-content-epilogue
+ }
+ | element office:drawing {
+ office-drawing-attlist,
+ office-drawing-content-prelude,
+ office-drawing-content-main,
+ office-drawing-content-epilogue
+ }
+ | element office:presentation {
+ office-presentation-attlist,
+ office-presentation-content-prelude,
+ office-presentation-content-main,
+ office-presentation-content-epilogue
+ }
+ | element office:spreadsheet {
+ office-spreadsheet-attlist,
+ office-spreadsheet-content-prelude,
+ office-spreadsheet-content-main,
+ office-spreadsheet-content-epilogue
+ }
+ | element office:chart {
+ office-chart-attlist,
+ office-chart-content-prelude,
+ office-chart-content-main,
+ office-chart-content-epilogue
+ }
+ | element office:image {
+ office-image-attlist,
+ office-image-content-prelude,
+ office-image-content-main,
+ office-image-content-epilogue
+ }
+ | office-database
+office-text-content-prelude =
+ office-forms, text-tracked-changes, text-decls, table-decls
+office-text-content-main =
+ text-content*
+ | (text-page-sequence, (shape)*)
+text-content =
+ text-h
+ | text-p
+ | text-list
+ | text-numbered-paragraph
+ | table-table
+ | text-section
+ | text-soft-page-break
+ | text-table-of-content
+ | text-illustration-index
+ | text-table-index
+ | text-object-index
+ | text-user-index
+ | text-alphabetical-index
+ | text-bibliography
+ | shape
+ | change-marks
+office-text-content-epilogue = table-functions
+office-text-attlist =
+ attribute text:global { boolean }?
+ & attribute text:use-soft-page-breaks { boolean }?
+office-drawing-attlist = empty
+office-drawing-content-prelude = text-decls, table-decls
+office-drawing-content-main = draw-page*
+office-drawing-content-epilogue = table-functions
+office-presentation-attlist = empty
+office-presentation-content-prelude =
+ text-decls, table-decls, presentation-decls
+office-presentation-content-main = draw-page*
+office-presentation-content-epilogue =
+ presentation-settings, table-functions
+office-spreadsheet-content-prelude =
+ table-tracked-changes?, text-decls, table-decls
+table-decls =
+ table-calculation-settings?,
+ table-content-validations?,
+ table-label-ranges?
+office-spreadsheet-content-main = table-table*
+office-spreadsheet-content-epilogue = table-functions
+table-functions =
+ table-named-expressions?,
+ table-database-ranges?,
+ table-data-pilot-tables?,
+ table-consolidation?,
+ table-dde-links?
+office-chart-attlist = empty
+office-chart-content-prelude = text-decls, table-decls
+office-chart-content-main = chart-chart
+office-chart-content-epilogue = table-functions
+office-image-attlist = empty
+office-image-content-prelude = empty
+office-image-content-main = draw-frame
+office-image-content-epilogue = empty
+office-settings = element office:settings { config-config-item-set+ }?
+config-config-item-set =
+ element config:config-item-set {
+ config-config-item-set-attlist, config-items
+ }
+config-items =
+ (config-config-item
+ | config-config-item-set
+ | config-config-item-map-named
+ | config-config-item-map-indexed)+
+config-config-item-set-attlist = attribute config:name { \string }
+config-config-item =
+ element config:config-item { config-config-item-attlist, text }
+config-config-item-attlist =
+ attribute config:name { \string }
+ & attribute config:type {
+ "boolean"
+ | "short"
+ | "int"
+ | "long"
+ | "double"
+ | "string"
+ | "datetime"
+ | "base64Binary"
+ }
+config-config-item-map-indexed =
+ element config:config-item-map-indexed {
+ config-config-item-map-indexed-attlist,
+ config-config-item-map-entry+
+ }
+config-config-item-map-indexed-attlist =
+ attribute config:name { \string }
+config-config-item-map-entry =
+ element config:config-item-map-entry {
+ config-config-item-map-entry-attlist, config-items
+ }
+config-config-item-map-entry-attlist =
+ attribute config:name { \string }?
+config-config-item-map-named =
+ element config:config-item-map-named {
+ config-config-item-map-named-attlist, config-config-item-map-entry+
+ }
+config-config-item-map-named-attlist = attribute config:name { \string }
+office-scripts =
+ element office:scripts { office-script*, office-event-listeners? }?
+office-script =
+ element office:script {
+ office-script-attlist,
+ mixed { anyElements }
+ }
+office-script-attlist = attribute script:language { \string }
+office-font-face-decls =
+ element office:font-face-decls { style-font-face* }?
+office-styles =
+ element office:styles {
+ styles
+ & style-default-style*
+ & style-default-page-layout?
+ & text-outline-style?
+ & text-notes-configuration*
+ & text-bibliography-configuration?
+ & text-linenumbering-configuration?
+ & draw-gradient*
+ & svg-linearGradient*
+ & svg-radialGradient*
+ & draw-hatch*
+ & draw-fill-image*
+ & draw-marker*
+ & draw-stroke-dash*
+ & draw-opacity*
+ & style-presentation-page-layout*
+ & table-table-template*
+ }?
+office-automatic-styles =
+ element office:automatic-styles { styles & style-page-layout* }?
+office-master-styles =
+ element office:master-styles {
+ style-master-page* & style-handout-master? & draw-layer-set?
+ }?
+styles =
+ style-style*
+ & text-list-style*
+ & number-number-style*
+ & number-currency-style*
+ & number-percentage-style*
+ & number-date-style*
+ & number-time-style*
+ & number-boolean-style*
+ & number-text-style*
+office-meta-data =
+ element meta:generator { \string }
+ | element dc:title { \string }
+ | element dc:description { \string }
+ | element dc:subject { \string }
+ | element meta:keyword { \string }
+ | element meta:initial-creator { \string }
+ | dc-creator
+ | element meta:printed-by { \string }
+ | element meta:creation-date { dateTime }
+ | dc-date
+ | element meta:print-date { dateTime }
+ | element meta:template {
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?,
+ attribute xlink:title { \string }?,
+ attribute meta:date { dateTime }?
+ }
+ | element meta:auto-reload {
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "replace" }?,
+ attribute xlink:actuate { "onLoad" }?)?,
+ attribute meta:delay { duration }?
+ }
+ | element meta:hyperlink-behaviour {
+ attribute office:target-frame-name { targetFrameName }?,
+ attribute xlink:show { "new" | "replace" }?
+ }
+ | element dc:language { language }
+ | element meta:editing-cycles { nonNegativeInteger }
+ | element meta:editing-duration { duration }
+ | element meta:document-statistic {
+ attribute meta:page-count { nonNegativeInteger }?,
+ attribute meta:table-count { nonNegativeInteger }?,
+ attribute meta:draw-count { nonNegativeInteger }?,
+ attribute meta:image-count { nonNegativeInteger }?,
+ attribute meta:ole-object-count { nonNegativeInteger }?,
+ attribute meta:object-count { nonNegativeInteger }?,
+ attribute meta:paragraph-count { nonNegativeInteger }?,
+ attribute meta:word-count { nonNegativeInteger }?,
+ attribute meta:character-count { nonNegativeInteger }?,
+ attribute meta:frame-count { nonNegativeInteger }?,
+ attribute meta:sentence-count { nonNegativeInteger }?,
+ attribute meta:syllable-count { nonNegativeInteger }?,
+ attribute meta:non-whitespace-character-count {
+ nonNegativeInteger
+ }?,
+ attribute meta:row-count { nonNegativeInteger }?,
+ attribute meta:cell-count { nonNegativeInteger }?
+ }
+ | element meta:user-defined {
+ attribute meta:name { \string },
+ ((attribute meta:value-type { "float" },
+ double)
+ | (attribute meta:value-type { "date" },
+ dateOrDateTime)
+ | (attribute meta:value-type { "time" },
+ duration)
+ | (attribute meta:value-type { "boolean" },
+ boolean)
+ | (attribute meta:value-type { "string" },
+ \string)
+ | text)
+ }
+dc-creator = element dc:creator { \string }
+dc-date = element dc:date { dateTime }
+text-h =
+ element text:h {
+ heading-attrs,
+ paragraph-attrs,
+ text-number?,
+ paragraph-content-or-hyperlink*
+ }
+heading-attrs =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:restart-numbering { boolean }?
+ & attribute text:start-value { nonNegativeInteger }?
+ & attribute text:is-list-header { boolean }?
+text-number = element text:number { \string }
+text-p =
+ element text:p { paragraph-attrs, paragraph-content-or-hyperlink* }
+paragraph-attrs =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:class-names { styleNameRefs }?
+ & attribute text:cond-style-name { styleNameRef }?
+ & (xml-id,
+ attribute text:id { NCName }?)?
+ & common-in-content-meta-attlist?
+text-page-sequence = element text:page-sequence { text-page+ }
+text-page = element text:page { text-page-attlist, empty }
+text-page-attlist = attribute text:master-page-name { styleNameRef }
+text-list =
+ element text:list {
+ text-list-attr, text-list-header?, text-list-item*
+ }
+text-list-attr =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:continue-numbering { boolean }?
+ & attribute text:continue-list { IDREF }?
+ & xml-id?
+text-list-item =
+ element text:list-item { text-list-item-attr, text-list-item-content }
+text-list-item-content =
+ text-number?, (text-p | text-h | text-list | text-soft-page-break)*
+text-list-item-attr =
+ attribute text:start-value { nonNegativeInteger }?
+ & attribute text:style-override { styleNameRef }?
+ & xml-id?
+text-list-header =
+ element text:list-header {
+ text-list-header-attr, text-list-item-content
+ }
+text-list-header-attr = xml-id?
+text-numbered-paragraph =
+ element text:numbered-paragraph {
+ text-numbered-paragraph-attr, text-number?, (text-p | text-h)
+ }
+text-numbered-paragraph-attr =
+ attribute text:list-id { NCName }
+ & attribute text:level { positiveInteger }?
+ & (attribute text:style-name { styleNameRef },
+ attribute text:continue-numbering { boolean },
+ attribute text:start-value { nonNegativeInteger })?
+ & xml-id?
+text-section =
+ element text:section {
+ text-section-attlist,
+ (text-section-source | text-section-source-dde | empty),
+ text-content*
+ }
+text-section-attlist =
+ common-section-attlist
+ & (attribute text:display { "true" | "none" }
+ | (attribute text:display { "condition" },
+ attribute text:condition { \string })
+ | empty)
+common-section-attlist =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:name { \string }
+ & attribute text:protected { boolean }?
+ & attribute text:protection-key { \string }?
+ & attribute text:protection-key-digest-algorithm { anyIRI }?
+ & xml-id?
+text-section-source =
+ element text:section-source { text-section-source-attr }
+text-section-source-attr =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?)?
+ & attribute text:section-name { \string }?
+ & attribute text:filter-name { \string }?
+text-section-source-dde = office-dde-source
+text-tracked-changes =
+ element text:tracked-changes {
+ text-tracked-changes-attr, text-changed-region*
+ }?
+text-tracked-changes-attr = attribute text:track-changes { boolean }?
+text-changed-region =
+ element text:changed-region {
+ text-changed-region-attr, text-changed-region-content
+ }
+text-changed-region-attr =
+ xml-id,
+ attribute text:id { NCName }?
+text-changed-region-content =
+ element text:insertion { office-change-info }
+ | element text:deletion { office-change-info, text-content* }
+ | element text:format-change { office-change-info }
+change-marks =
+ element text:change { change-mark-attr }
+ | element text:change-start { change-mark-attr }
+ | element text:change-end { change-mark-attr }
+change-mark-attr = attribute text:change-id { IDREF }
+text-soft-page-break = element text:soft-page-break { empty }
+text-decls =
+ element text:variable-decls { text-variable-decl* }?,
+ element text:sequence-decls { text-sequence-decl* }?,
+ element text:user-field-decls { text-user-field-decl* }?,
+ element text:dde-connection-decls { text-dde-connection-decl* }?,
+ text-alphabetical-index-auto-mark-file?
+paragraph-content-or-hyperlink = paragraph-content | text-a
+paragraph-content =
+ text
+ | element text:s {
+ attribute text:c { nonNegativeInteger }?
+ }
+ | element text:tab { text-tab-attr }
+ | element text:line-break { empty }
+ | text-soft-page-break
+ | element text:span {
+ attribute text:style-name { styleNameRef }?,
+ attribute text:class-names { styleNameRefs }?,
+ paragraph-content-or-hyperlink*
+ }
+ | element text:meta {
+ text-meta-attlist, paragraph-content-or-hyperlink*
+ }
+ | (text-bookmark | text-bookmark-start | text-bookmark-end)
+ | element text:reference-mark {
+ attribute text:name { \string }
+ }
+ | (element text:reference-mark-start {
+ attribute text:name { \string }
+ }
+ | element text:reference-mark-end {
+ attribute text:name { \string }
+ })
+ | element text:note {
+ text-note-class,
+ attribute text:id { \string }?,
+ element text:note-citation {
+ attribute text:label { \string }?,
+ text
+ },
+ element text:note-body { text-content* }
+ }
+ | element text:ruby {
+ attribute text:style-name { styleNameRef }?,
+ element text:ruby-base { paragraph-content-or-hyperlink* },
+ element text:ruby-text {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+ }
+ | (office-annotation | office-annotation-end)
+ | change-marks
+ | shape
+ | element text:date { text-date-attlist, text }
+ | element text:time { text-time-attlist, text }
+ | element text:page-number { text-page-number-attlist, text }
+ | element text:page-continuation {
+ text-page-continuation-attlist, text
+ }
+ | element text:sender-firstname { common-field-fixed-attlist, text }
+ | element text:sender-lastname { common-field-fixed-attlist, text }
+ | element text:sender-initials { common-field-fixed-attlist, text }
+ | element text:sender-title { common-field-fixed-attlist, text }
+ | element text:sender-position { common-field-fixed-attlist, text }
+ | element text:sender-email { common-field-fixed-attlist, text }
+ | element text:sender-phone-private {
+ common-field-fixed-attlist, text
+ }
+ | element text:sender-fax { common-field-fixed-attlist, text }
+ | element text:sender-company { common-field-fixed-attlist, text }
+ | element text:sender-phone-work { common-field-fixed-attlist, text }
+ | element text:sender-street { common-field-fixed-attlist, text }
+ | element text:sender-city { common-field-fixed-attlist, text }
+ | element text:sender-postal-code { common-field-fixed-attlist, text }
+ | element text:sender-country { common-field-fixed-attlist, text }
+ | element text:sender-state-or-province {
+ common-field-fixed-attlist, text
+ }
+ | element text:author-name { common-field-fixed-attlist, text }
+ | element text:author-initials { common-field-fixed-attlist, text }
+ | element text:chapter { text-chapter-attlist, text }
+ | element text:file-name { text-file-name-attlist, text }
+ | element text:template-name { text-template-name-attlist, text }
+ | element text:sheet-name { text }
+ | element text:variable-set {
+ (common-field-name-attlist
+ & common-field-formula-attlist
+ & common-value-and-type-attlist
+ & common-field-display-value-none-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:variable-get {
+ (common-field-name-attlist
+ & common-field-display-value-formula-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:variable-input {
+ (common-field-name-attlist
+ & common-field-description-attlist
+ & common-value-type-attlist
+ & common-field-display-value-none-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:user-field-get {
+ (common-field-name-attlist
+ & common-field-display-value-formula-none-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:user-field-input {
+ (common-field-name-attlist
+ & common-field-description-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:sequence {
+ (common-field-name-attlist
+ & common-field-formula-attlist
+ & common-field-num-format-attlist
+ & text-sequence-ref-name),
+ text
+ }
+ | element text:expression {
+ (common-field-formula-attlist
+ & common-value-and-type-attlist?
+ & common-field-display-value-formula-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:text-input { common-field-description-attlist, text }
+ | element text:initial-creator { common-field-fixed-attlist, text }
+ | element text:creation-date {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:date-value { dateOrDateTime }?),
+ text
+ }
+ | element text:creation-time {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:time-value { timeOrDateTime }?),
+ text
+ }
+ | element text:description { common-field-fixed-attlist, text }
+ | element text:user-defined {
+ (common-field-fixed-attlist
+ & attribute text:name { \string }
+ & common-field-data-style-name-attlist
+ & attribute office:value { double }?
+ & attribute office:date-value { dateOrDateTime }?
+ & attribute office:time-value { duration }?
+ & attribute office:boolean-value { boolean }?
+ & attribute office:string-value { \string }?),
+ text
+ }
+ | element text:print-time {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:time-value { time }?),
+ text
+ }
+ | element text:print-date {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:date-value { date }?),
+ text
+ }
+ | element text:printed-by { common-field-fixed-attlist, text }
+ | element text:title { common-field-fixed-attlist, text }
+ | element text:subject { common-field-fixed-attlist, text }
+ | element text:keywords { common-field-fixed-attlist, text }
+ | element text:editing-cycles { common-field-fixed-attlist, text }
+ | element text:editing-duration {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:duration { duration }?),
+ text
+ }
+ | element text:modification-time {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:time-value { time }?),
+ text
+ }
+ | element text:modification-date {
+ (common-field-fixed-attlist
+ & common-field-data-style-name-attlist
+ & attribute text:date-value { date }?),
+ text
+ }
+ | element text:creator { common-field-fixed-attlist, text }
+ | element text:page-count
+ | text:paragraph-count
+ | text:word-count
+ | text:character-count
+ | text:table-count
+ | text:image-count
+ | text:object-count {
+ common-field-num-format-attlist, text
+ }
+ | element text:database-display {
+ text-database-display-attlist, text
+ }
+ | element text:database-next { text-database-next-attlist }
+ | element text:database-row-select {
+ text-database-row-select-attlist
+ }
+ | element text:database-row-number {
+ (common-field-database-table
+ & common-field-num-format-attlist
+ & attribute text:value { nonNegativeInteger }?),
+ text
+ }
+ | element text:database-name { common-field-database-table, text }
+ | element text:page-variable-set {
+ text-set-page-variable-attlist, text
+ }
+ | element text:page-variable-get {
+ text-get-page-variable-attlist, text
+ }
+ | element text:placeholder { text-placeholder-attlist, text }
+ | element text:conditional-text {
+ text-conditional-text-attlist, text
+ }
+ | element text:hidden-text { text-hidden-text-attlist, text }
+ | element text:reference-ref | text:bookmark-ref {
+ text-common-ref-content & text-bookmark-ref-content
+ }
+ | element text:note-ref {
+ text-common-ref-content & text-note-ref-content
+ }
+ | element text:sequence-ref {
+ text-common-ref-content & text-sequence-ref-content
+ }
+ | element text:script {
+ ((attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI })
+ | text)
+ & attribute script:language { \string }?
+ }
+ | element text:execute-macro {
+ attribute text:name { \string }?,
+ office-event-listeners?,
+ text
+ }
+ | element text:hidden-paragraph {
+ text-hidden-paragraph-attlist, text
+ }
+ | element text:dde-connection {
+ attribute text:connection-name { \string },
+ text
+ }
+ | element text:measure {
+ attribute text:kind { "value" | "unit" | "gap" },
+ text
+ }
+ | element text:table-formula {
+ (common-field-formula-attlist
+ & common-field-display-value-formula-attlist
+ & common-field-data-style-name-attlist),
+ text
+ }
+ | element text:meta-field {
+ text-meta-field-attlist, paragraph-content-or-hyperlink*
+ }
+ | element text:toc-mark-start { text-toc-mark-start-attrs }
+ | element text:toc-mark-end { text-id }
+ | element text:toc-mark {
+ attribute text:string-value { \string },
+ text-outline-level
+ }
+ | element text:user-index-mark-start {
+ text-id, text-outline-level, text-index-name
+ }
+ | element text:user-index-mark-end { text-id }
+ | element text:user-index-mark {
+ attribute text:string-value { \string },
+ text-outline-level,
+ text-index-name
+ }
+ | element text:alphabetical-index-mark-start {
+ text-id, text-alphabetical-index-mark-attrs
+ }
+ | element text:alphabetical-index-mark-end { text-id }
+ | element text:alphabetical-index-mark {
+ attribute text:string-value { \string },
+ text-alphabetical-index-mark-attrs
+ }
+ | element text:bibliography-mark {
+ attribute text:bibliography-type { text-bibliography-types },
+ attribute text:identifier
+ | text:address
+ | text:annote
+ | text:author
+ | text:booktitle
+ | text:chapter
+ | text:edition
+ | text:editor
+ | text:howpublished
+ | text:institution
+ | text:journal
+ | text:month
+ | text:note
+ | text:number
+ | text:organizations
+ | text:pages
+ | text:publisher
+ | text:school
+ | text:series
+ | text:title
+ | text:report-type
+ | text:volume
+ | text:year
+ | text:url
+ | text:custom1
+ | text:custom2
+ | text:custom3
+ | text:custom4
+ | text:custom5
+ | text:isbn
+ | text:issn { \string }*,
+ text
+ }
+ | element presentation:header { empty }
+ | element presentation:footer { empty }
+ | element presentation:date-time { empty }
+text-tab-attr = attribute text:tab-ref { nonNegativeInteger }?
+text-a =
+ element text:a {
+ text-a-attlist, office-event-listeners?, paragraph-content*
+ }
+text-a-attlist =
+ attribute office:name { \string }?
+ & attribute office:title { \string }?
+ & attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute xlink:actuate { "onRequest" }?
+ & attribute office:target-frame-name { targetFrameName }?
+ & attribute xlink:show { "new" | "replace" }?
+ & attribute text:style-name { styleNameRef }?
+ & attribute text:visited-style-name { styleNameRef }?
+text-meta-attlist = common-in-content-meta-attlist? & xml-id?
+text-bookmark = element text:bookmark { text-bookmark-attlist, empty }
+text-bookmark-start =
+ element text:bookmark-start { text-bookmark-start-attlist, empty }
+text-bookmark-end =
+ element text:bookmark-end { text-bookmark-end-attlist, empty }
+text-bookmark-attlist =
+ attribute text:name { \string }
+ & xml-id?
+text-bookmark-start-attlist =
+ attribute text:name { \string }
+ & xml-id?
+ & common-in-content-meta-attlist?
+text-bookmark-end-attlist = attribute text:name { \string }
+text-note-class = attribute text:note-class { "footnote" | "endnote" }
+text-date-attlist =
+ (common-field-fixed-attlist & common-field-data-style-name-attlist)
+ & attribute text:date-value { dateOrDateTime }?
+ & attribute text:date-adjust { duration }?
+text-time-attlist =
+ (common-field-fixed-attlist & common-field-data-style-name-attlist)
+ & attribute text:time-value { timeOrDateTime }?
+ & attribute text:time-adjust { duration }?
+text-page-number-attlist =
+ (common-field-num-format-attlist & common-field-fixed-attlist)
+ & attribute text:page-adjust { integer }?
+ & attribute text:select-page { "previous" | "current" | "next" }?
+text-page-continuation-attlist =
+ attribute text:select-page { "previous" | "next" }
+ & attribute text:string-value { \string }?
+text-chapter-attlist =
+ attribute text:display {
+ "name"
+ | "number"
+ | "number-and-name"
+ | "plain-number-and-name"
+ | "plain-number"
+ }
+ & attribute text:outline-level { nonNegativeInteger }
+text-file-name-attlist =
+ attribute text:display {
+ "full" | "path" | "name" | "name-and-extension"
+ }?
+ & common-field-fixed-attlist
+text-template-name-attlist =
+ attribute text:display {
+ "full" | "path" | "name" | "name-and-extension" | "area" | "title"
+ }?
+text-variable-decl =
+ element text:variable-decl {
+ common-field-name-attlist, common-value-type-attlist
+ }
+text-user-field-decl =
+ element text:user-field-decl {
+ common-field-name-attlist,
+ common-field-formula-attlist?,
+ common-value-and-type-attlist
+ }
+text-sequence-decl =
+ element text:sequence-decl { text-sequence-decl-attlist }
+text-sequence-decl-attlist =
+ common-field-name-attlist
+ & attribute text:display-outline-level { nonNegativeInteger }
+ & attribute text:separation-character { character }?
+text-sequence-ref-name = attribute text:ref-name { \string }?
+common-field-database-table =
+ common-field-database-table-attlist, common-field-database-name
+common-field-database-name =
+ attribute text:database-name { \string }?
+ | form-connection-resource
+common-field-database-table-attlist =
+ attribute text:table-name { \string }
+ & attribute text:table-type { "table" | "query" | "command" }?
+text-database-display-attlist =
+ common-field-database-table
+ & common-field-data-style-name-attlist
+ & attribute text:column-name { \string }
+text-database-next-attlist =
+ common-field-database-table
+ & attribute text:condition { \string }?
+text-database-row-select-attlist =
+ common-field-database-table
+ & attribute text:condition { \string }?
+ & attribute text:row-number { nonNegativeInteger }?
+text-set-page-variable-attlist =
+ attribute text:active { boolean }?
+ & attribute text:page-adjust { integer }?
+text-get-page-variable-attlist = common-field-num-format-attlist
+text-placeholder-attlist =
+ attribute text:placeholder-type {
+ "text" | "table" | "text-box" | "image" | "object"
+ }
+ & common-field-description-attlist
+text-conditional-text-attlist =
+ attribute text:condition { \string }
+ & attribute text:string-value-if-true { \string }
+ & attribute text:string-value-if-false { \string }
+ & attribute text:current-value { boolean }?
+text-hidden-text-attlist =
+ attribute text:condition { \string }
+ & attribute text:string-value { \string }
+ & attribute text:is-hidden { boolean }?
+text-common-ref-content =
+ text
+ & attribute text:ref-name { \string }?
+text-bookmark-ref-content =
+ attribute text:reference-format {
+ common-ref-format-values
+ | "number-no-superior"
+ | "number-all-superior"
+ | "number"
+ }?
+text-note-ref-content =
+ attribute text:reference-format { common-ref-format-values }?
+ & text-note-class
+text-sequence-ref-content =
+ attribute text:reference-format {
+ common-ref-format-values
+ | "category-and-value"
+ | "caption"
+ | "value"
+ }?
+common-ref-format-values = "page" | "chapter" | "direction" | "text"
+text-hidden-paragraph-attlist =
+ attribute text:condition { \string }
+ & attribute text:is-hidden { boolean }?
+text-meta-field-attlist = xml-id & common-field-data-style-name-attlist
+common-value-type-attlist = attribute office:value-type { valueType }
+common-value-and-type-attlist =
+ (attribute office:value-type { "float" },
+ attribute office:value { double })
+ | (attribute office:value-type { "percentage" },
+ attribute office:value { double })
+ | (attribute office:value-type { "currency" },
+ attribute office:value { double },
+ attribute office:currency { \string }?)
+ | (attribute office:value-type { "date" },
+ attribute office:date-value { dateOrDateTime })
+ | (attribute office:value-type { "time" },
+ attribute office:time-value { duration })
+ | (attribute office:value-type { "boolean" },
+ attribute office:boolean-value { boolean })
+ | (attribute office:value-type { "string" },
+ attribute office:string-value { \string }?)
+common-field-fixed-attlist = attribute text:fixed { boolean }?
+common-field-name-attlist = attribute text:name { variableName }
+common-field-description-attlist =
+ attribute text:description { \string }?
+common-field-display-value-none-attlist =
+ attribute text:display { "value" | "none" }?
+common-field-display-value-formula-none-attlist =
+ attribute text:display { "value" | "formula" | "none" }?
+common-field-display-value-formula-attlist =
+ attribute text:display { "value" | "formula" }?
+common-field-formula-attlist = attribute text:formula { \string }?
+common-field-data-style-name-attlist =
+ attribute style:data-style-name { styleNameRef }?
+common-field-num-format-attlist = common-num-format-attlist?
+text-toc-mark-start-attrs = text-id, text-outline-level
+text-outline-level = attribute text:outline-level { positiveInteger }?
+text-id = attribute text:id { \string }
+text-index-name = attribute text:index-name { \string }
+text-alphabetical-index-mark-attrs =
+ attribute text:key1 { \string }?
+ & attribute text:key2 { \string }?
+ & attribute text:string-value-phonetic { \string }?
+ & attribute text:key1-phonetic { \string }?
+ & attribute text:key2-phonetic { \string }?
+ & attribute text:main-entry { boolean }?
+text-bibliography-types =
+ "article"
+ | "book"
+ | "booklet"
+ | "conference"
+ | "custom1"
+ | "custom2"
+ | "custom3"
+ | "custom4"
+ | "custom5"
+ | "email"
+ | "inbook"
+ | "incollection"
+ | "inproceedings"
+ | "journal"
+ | "manual"
+ | "mastersthesis"
+ | "misc"
+ | "phdthesis"
+ | "proceedings"
+ | "techreport"
+ | "unpublished"
+ | "www"
+text-index-body = element text:index-body { index-content-main* }
+index-content-main = text-content | text-index-title
+text-index-title =
+ element text:index-title {
+ common-section-attlist, index-content-main*
+ }
+text-table-of-content =
+ element text:table-of-content {
+ common-section-attlist,
+ text-table-of-content-source,
+ text-index-body
+ }
+text-table-of-content-source =
+ element text:table-of-content-source {
+ text-table-of-content-source-attlist,
+ text-index-title-template?,
+ text-table-of-content-entry-template*,
+ text-index-source-styles*
+ }
+text-table-of-content-source-attlist =
+ attribute text:outline-level { positiveInteger }?
+ & attribute text:use-outline-level { boolean }?
+ & attribute text:use-index-marks { boolean }?
+ & attribute text:use-index-source-styles { boolean }?
+ & attribute text:index-scope { "document" | "chapter" }?
+ & attribute text:relative-tab-stop-position { boolean }?
+text-table-of-content-entry-template =
+ element text:table-of-content-entry-template {
+ text-table-of-content-entry-template-attlist,
+ text-table-of-content-children*
+ }
+text-table-of-content-children =
+ text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop
+ | text-index-entry-link-start
+ | text-index-entry-link-end
+text-table-of-content-entry-template-attlist =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:style-name { styleNameRef }
+text-illustration-index =
+ element text:illustration-index {
+ common-section-attlist,
+ text-illustration-index-source,
+ text-index-body
+ }
+text-illustration-index-source =
+ element text:illustration-index-source {
+ text-illustration-index-source-attrs,
+ text-index-title-template?,
+ text-illustration-index-entry-template?
+ }
+text-illustration-index-source-attrs =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:use-caption { boolean }?
+ & attribute text:caption-sequence-name { \string }?
+ & attribute text:caption-sequence-format {
+ "text" | "category-and-value" | "caption"
+ }?
+text-index-scope-attr =
+ attribute text:index-scope { "document" | "chapter" }?
+text-relative-tab-stop-position-attr =
+ attribute text:relative-tab-stop-position { boolean }?
+text-illustration-index-entry-template =
+ element text:illustration-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-illustration-index-entry-content =
+ text-illustration-index-entry-template-attrs,
+ (text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop)*
+text-illustration-index-entry-template-attrs =
+ attribute text:style-name { styleNameRef }
+text-table-index =
+ element text:table-index {
+ common-section-attlist, text-table-index-source, text-index-body
+ }
+text-table-index-source =
+ element text:table-index-source {
+ text-illustration-index-source-attrs,
+ text-index-title-template?,
+ text-table-index-entry-template?
+ }
+text-table-index-entry-template =
+ element text:table-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-object-index =
+ element text:object-index {
+ common-section-attlist, text-object-index-source, text-index-body
+ }
+text-object-index-source =
+ element text:object-index-source {
+ text-object-index-source-attrs,
+ text-index-title-template?,
+ text-object-index-entry-template?
+ }
+text-object-index-source-attrs =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:use-spreadsheet-objects { boolean }?
+ & attribute text:use-math-objects { boolean }?
+ & attribute text:use-draw-objects { boolean }?
+ & attribute text:use-chart-objects { boolean }?
+ & attribute text:use-other-objects { boolean }?
+text-object-index-entry-template =
+ element text:object-index-entry-template {
+ text-illustration-index-entry-content
+ }
+text-user-index =
+ element text:user-index {
+ common-section-attlist, text-user-index-source, text-index-body
+ }
+text-user-index-source =
+ element text:user-index-source {
+ text-user-index-source-attr,
+ text-index-title-template?,
+ text-user-index-entry-template*,
+ text-index-source-styles*
+ }
+text-user-index-source-attr =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:use-index-marks { boolean }?
+ & attribute text:use-index-source-styles { boolean }?
+ & attribute text:use-graphics { boolean }?
+ & attribute text:use-tables { boolean }?
+ & attribute text:use-floating-frames { boolean }?
+ & attribute text:use-objects { boolean }?
+ & attribute text:copy-outline-levels { boolean }?
+ & attribute text:index-name { \string }
+text-user-index-entry-template =
+ element text:user-index-entry-template {
+ text-user-index-entry-template-attrs,
+ (text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop)*
+ }
+text-user-index-entry-template-attrs =
+ attribute text:outline-level { positiveInteger }
+ & attribute text:style-name { styleNameRef }
+text-alphabetical-index =
+ element text:alphabetical-index {
+ common-section-attlist,
+ text-alphabetical-index-source,
+ text-index-body
+ }
+text-alphabetical-index-source =
+ element text:alphabetical-index-source {
+ text-alphabetical-index-source-attrs,
+ text-index-title-template?,
+ text-alphabetical-index-entry-template*
+ }
+text-alphabetical-index-source-attrs =
+ text-index-scope-attr
+ & text-relative-tab-stop-position-attr
+ & attribute text:ignore-case { boolean }?
+ & attribute text:main-entry-style-name { styleNameRef }?
+ & attribute text:alphabetical-separators { boolean }?
+ & attribute text:combine-entries { boolean }?
+ & attribute text:combine-entries-with-dash { boolean }?
+ & attribute text:combine-entries-with-pp { boolean }?
+ & attribute text:use-keys-as-entries { boolean }?
+ & attribute text:capitalize-entries { boolean }?
+ & attribute text:comma-separated { boolean }?
+ & attribute fo:language { languageCode }?
+ & attribute fo:country { countryCode }?
+ & attribute fo:script { scriptCode }?
+ & attribute style:rfc-language-tag { language }?
+ & attribute text:sort-algorithm { \string }?
+text-alphabetical-index-auto-mark-file =
+ element text:alphabetical-index-auto-mark-file {
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI }
+ }
+text-alphabetical-index-entry-template =
+ element text:alphabetical-index-entry-template {
+ text-alphabetical-index-entry-template-attrs,
+ (text-index-entry-chapter
+ | text-index-entry-page-number
+ | text-index-entry-text
+ | text-index-entry-span
+ | text-index-entry-tab-stop)*
+ }
+text-alphabetical-index-entry-template-attrs =
+ attribute text:outline-level { "1" | "2" | "3" | "separator" }
+ & attribute text:style-name { styleNameRef }
+text-bibliography =
+ element text:bibliography {
+ common-section-attlist, text-bibliography-source, text-index-body
+ }
+text-bibliography-source =
+ element text:bibliography-source {
+ text-index-title-template?, text-bibliography-entry-template*
+ }
+text-bibliography-entry-template =
+ element text:bibliography-entry-template {
+ text-bibliography-entry-template-attrs,
+ (text-index-entry-span
+ | text-index-entry-tab-stop
+ | text-index-entry-bibliography)*
+ }
+text-bibliography-entry-template-attrs =
+ attribute text:bibliography-type { text-bibliography-types }
+ & attribute text:style-name { styleNameRef }
+text-index-source-styles =
+ element text:index-source-styles {
+ attribute text:outline-level { positiveInteger },
+ text-index-source-style*
+ }
+text-index-source-style =
+ element text:index-source-style {
+ attribute text:style-name { styleName },
+ empty
+ }
+text-index-title-template =
+ element text:index-title-template {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+text-index-entry-chapter =
+ element text:index-entry-chapter {
+ attribute text:style-name { styleNameRef }?,
+ text-index-entry-chapter-attrs
+ }
+text-index-entry-chapter-attrs =
+ attribute text:display {
+ "name"
+ | "number"
+ | "number-and-name"
+ | "plain-number"
+ | "plain-number-and-name"
+ }?
+ & attribute text:outline-level { positiveInteger }?
+text-index-entry-text =
+ element text:index-entry-text {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-page-number =
+ element text:index-entry-page-number {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-span =
+ element text:index-entry-span {
+ attribute text:style-name { styleNameRef }?,
+ text
+ }
+text-index-entry-bibliography =
+ element text:index-entry-bibliography {
+ text-index-entry-bibliography-attrs
+ }
+text-index-entry-bibliography-attrs =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:bibliography-data-field {
+ "address"
+ | "annote"
+ | "author"
+ | "bibliography-type"
+ | "booktitle"
+ | "chapter"
+ | "custom1"
+ | "custom2"
+ | "custom3"
+ | "custom4"
+ | "custom5"
+ | "edition"
+ | "editor"
+ | "howpublished"
+ | "identifier"
+ | "institution"
+ | "isbn"
+ | "issn"
+ | "journal"
+ | "month"
+ | "note"
+ | "number"
+ | "organizations"
+ | "pages"
+ | "publisher"
+ | "report-type"
+ | "school"
+ | "series"
+ | "title"
+ | "url"
+ | "volume"
+ | "year"
+ }
+text-index-entry-tab-stop =
+ element text:index-entry-tab-stop {
+ attribute text:style-name { styleNameRef }?,
+ text-index-entry-tab-stop-attrs
+ }
+text-index-entry-tab-stop-attrs =
+ attribute style:leader-char { character }?
+ & (attribute style:type { "right" }
+ | (attribute style:type { "left" },
+ attribute style:position { length }))
+text-index-entry-link-start =
+ element text:index-entry-link-start {
+ attribute text:style-name { styleNameRef }?
+ }
+text-index-entry-link-end =
+ element text:index-entry-link-end {
+ attribute text:style-name { styleNameRef }?
+ }
+table-table =
+ element table:table {
+ table-table-attlist,
+ table-title?,
+ table-desc?,
+ table-table-source?,
+ office-dde-source?,
+ table-scenario?,
+ office-forms?,
+ table-shapes?,
+ table-columns-and-groups,
+ table-rows-and-groups,
+ table-named-expressions?
+ }
+table-columns-and-groups =
+ (table-table-column-group | table-columns-no-group)+
+table-columns-no-group =
+ (table-columns, (table-table-header-columns, table-columns?)?)
+ | (table-table-header-columns, table-columns?)
+table-columns = table-table-columns | table-table-column+
+table-rows-and-groups = (table-table-row-group | table-rows-no-group)+
+table-rows-no-group =
+ (table-rows, (table-table-header-rows, table-rows?)?)
+ | (table-table-header-rows, table-rows?)
+table-rows =
+ table-table-rows | (text-soft-page-break?, table-table-row)+
+table-table-attlist =
+ attribute table:name { \string }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:template-name { \string }?
+ & attribute table:use-first-row-styles { boolean }?
+ & attribute table:use-last-row-styles { boolean }?
+ & attribute table:use-first-column-styles { boolean }?
+ & attribute table:use-last-column-styles { boolean }?
+ & attribute table:use-banding-rows-styles { boolean }?
+ & attribute table:use-banding-columns-styles { boolean }?
+ & attribute table:protected { boolean }?
+ & attribute table:protection-key { \string }?
+ & attribute table:protection-key-digest-algorithm { anyIRI }?
+ & attribute table:print { boolean }?
+ & attribute table:print-ranges { cellRangeAddressList }?
+ & xml-id?
+ & attribute table:is-sub-table { boolean }?
+table-title = element table:title { text }
+table-desc = element table:desc { text }
+table-table-row =
+ element table:table-row {
+ table-table-row-attlist,
+ (table-table-cell | table-covered-table-cell)+
+ }
+table-table-row-attlist =
+ attribute table:number-rows-repeated { positiveInteger }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:default-cell-style-name { styleNameRef }?
+ & attribute table:visibility { table-visibility-value }?
+ & xml-id?
+table-visibility-value = "visible" | "collapse" | "filter"
+table-table-cell =
+ element table:table-cell {
+ table-table-cell-attlist,
+ table-table-cell-attlist-extra,
+ table-table-cell-content
+ }
+table-covered-table-cell =
+ element table:covered-table-cell {
+ table-table-cell-attlist, table-table-cell-content
+ }
+table-table-cell-content =
+ table-cell-range-source?,
+ office-annotation?,
+ table-detective?,
+ text-content*
+table-table-cell-attlist =
+ attribute table:number-columns-repeated { positiveInteger }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:content-validation-name { \string }?
+ & attribute table:formula { \string }?
+ & common-value-and-type-attlist?
+ & attribute table:protect { boolean }?
+ & attribute table:protected { boolean }?
+ & xml-id?
+ & common-in-content-meta-attlist?
+table-table-cell-attlist-extra =
+ attribute table:number-columns-spanned { positiveInteger }?
+ & attribute table:number-rows-spanned { positiveInteger }?
+ & attribute table:number-matrix-columns-spanned { positiveInteger }?
+ & attribute table:number-matrix-rows-spanned { positiveInteger }?
+table-table-column =
+ element table:table-column { table-table-column-attlist, empty }
+table-table-column-attlist =
+ attribute table:number-columns-repeated { positiveInteger }?
+ & attribute table:style-name { styleNameRef }?
+ & attribute table:visibility { table-visibility-value }?
+ & attribute table:default-cell-style-name { styleNameRef }?
+ & xml-id?
+table-table-header-columns =
+ element table:table-header-columns { table-table-column+ }
+table-table-columns =
+ element table:table-columns { table-table-column+ }
+table-table-column-group =
+ element table:table-column-group {
+ table-table-column-group-attlist, table-columns-and-groups
+ }
+table-table-column-group-attlist = attribute table:display { boolean }?
+table-table-header-rows =
+ element table:table-header-rows {
+ (text-soft-page-break?, table-table-row)+
+ }
+table-table-rows =
+ element table:table-rows { (text-soft-page-break?, table-table-row)+ }
+table-table-row-group =
+ element table:table-row-group {
+ table-table-row-group-attlist, table-rows-and-groups
+ }
+table-table-row-group-attlist = attribute table:display { boolean }?
+cellAddress =
+ xsd:string {
+ pattern = "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+"
+ }
+cellRangeAddress =
+ xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+(:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+)?"
+ }
+ | xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[0-9]+:($?([^\. ']+|'([^']|'')+'))?\.$?[0-9]+"
+ }
+ | xsd:string {
+ pattern =
+ "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+"
+ }
+cellRangeAddressList =
+ xsd:string
+ >> dc:description [
+ 'Value is a space separated list of "cellRangeAddress" patterns'
+ ]
+table-table-source =
+ element table:table-source {
+ table-table-source-attlist, table-linked-source-attlist, empty
+ }
+table-table-source-attlist =
+ attribute table:mode { "copy-all" | "copy-results-only" }?
+ & attribute table:table-name { \string }?
+table-linked-source-attlist =
+ attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute xlink:actuate { "onRequest" }?
+ & attribute table:filter-name { \string }?
+ & attribute table:filter-options { \string }?
+ & attribute table:refresh-delay { duration }?
+table-scenario =
+ element table:scenario { table-scenario-attlist, empty }
+table-scenario-attlist =
+ attribute table:scenario-ranges { cellRangeAddressList }
+ & attribute table:is-active { boolean }
+ & attribute table:display-border { boolean }?
+ & attribute table:border-color { color }?
+ & attribute table:copy-back { boolean }?
+ & attribute table:copy-styles { boolean }?
+ & attribute table:copy-formulas { boolean }?
+ & attribute table:comment { \string }?
+ & attribute table:protected { boolean }?
+table-shapes = element table:shapes { shape+ }
+table-cell-range-source =
+ element table:cell-range-source {
+ table-table-cell-range-source-attlist,
+ table-linked-source-attlist,
+ empty
+ }
+table-table-cell-range-source-attlist =
+ attribute table:name { \string }
+ & attribute table:last-column-spanned { positiveInteger }
+ & attribute table:last-row-spanned { positiveInteger }
+table-detective =
+ element table:detective { table-highlighted-range*, table-operation* }
+table-operation =
+ element table:operation { table-operation-attlist, empty }
+table-operation-attlist =
+ attribute table:name {
+ "trace-dependents"
+ | "remove-dependents"
+ | "trace-precedents"
+ | "remove-precedents"
+ | "trace-errors"
+ }
+ & attribute table:index { nonNegativeInteger }
+table-highlighted-range =
+ element table:highlighted-range {
+ (table-highlighted-range-attlist
+ | table-highlighted-range-attlist-invalid),
+ empty
+ }
+table-highlighted-range-attlist =
+ attribute table:cell-range-address { cellRangeAddress }?
+ & attribute table:direction {
+ "from-another-table" | "to-another-table" | "from-same-table"
+ }
+ & attribute table:contains-error { boolean }?
+table-highlighted-range-attlist-invalid =
+ attribute table:marked-invalid { boolean }
+office-spreadsheet-attlist =
+ attribute table:structure-protected { boolean }?,
+ attribute table:protection-key { \string }?,
+ attribute table:protection-key-digest-algorithm { anyIRI }?
+table-calculation-settings =
+ element table:calculation-settings {
+ table-calculation-setting-attlist,
+ table-null-date?,
+ table-iteration?
+ }
+table-calculation-setting-attlist =
+ attribute table:case-sensitive { boolean }?
+ & attribute table:precision-as-shown { boolean }?
+ & attribute table:search-criteria-must-apply-to-whole-cell {
+ boolean
+ }?
+ & attribute table:automatic-find-labels { boolean }?
+ & attribute table:use-regular-expressions { boolean }?
+ & attribute table:use-wildcards { boolean }?
+ & attribute table:null-year { positiveInteger }?
+table-null-date =
+ element table:null-date {
+ attribute table:value-type { "date" }?,
+ attribute table:date-value { date }?,
+ empty
+ }
+table-iteration =
+ element table:iteration {
+ attribute table:status { "enable" | "disable" }?,
+ attribute table:steps { positiveInteger }?,
+ attribute table:maximum-difference { double }?,
+ empty
+ }
+table-content-validations =
+ element table:content-validations { table-content-validation+ }
+table-content-validation =
+ element table:content-validation {
+ table-validation-attlist,
+ table-help-message?,
+ (table-error-message | (table-error-macro, office-event-listeners))?
+ }
+table-validation-attlist =
+ attribute table:name { \string }
+ & attribute table:condition { \string }?
+ & attribute table:base-cell-address { cellAddress }?
+ & attribute table:allow-empty-cell { boolean }?
+ & attribute table:display-list {
+ "none" | "unsorted" | "sort-ascending"
+ }?
+table-help-message =
+ element table:help-message {
+ attribute table:title { \string }?,
+ attribute table:display { boolean }?,
+ text-p*
+ }
+table-error-message =
+ element table:error-message {
+ attribute table:title { \string }?,
+ attribute table:display { boolean }?,
+ attribute table:message-type {
+ "stop" | "warning" | "information"
+ }?,
+ text-p*
+ }
+table-error-macro =
+ element table:error-macro {
+ attribute table:execute { boolean }?
+ }
+table-label-ranges = element table:label-ranges { table-label-range* }
+table-label-range =
+ element table:label-range { table-label-range-attlist, empty }
+table-label-range-attlist =
+ attribute table:label-cell-range-address { cellRangeAddress }
+ & attribute table:data-cell-range-address { cellRangeAddress }
+ & attribute table:orientation { "column" | "row" }
+table-named-expressions =
+ element table:named-expressions {
+ (table-named-range | table-named-expression)*
+ }
+table-named-range =
+ element table:named-range { table-named-range-attlist, empty }
+table-named-range-attlist =
+ attribute table:name { \string },
+ attribute table:cell-range-address { cellRangeAddress },
+ attribute table:base-cell-address { cellAddress }?,
+ attribute table:range-usable-as {
+ "none"
+ | list {
+ ("print-range" | "filter" | "repeat-row" | "repeat-column")+
+ }
+ }?
+table-named-expression =
+ element table:named-expression {
+ table-named-expression-attlist, empty
+ }
+table-named-expression-attlist =
+ attribute table:name { \string },
+ attribute table:expression { \string },
+ attribute table:base-cell-address { cellAddress }?
+table-database-ranges =
+ element table:database-ranges { table-database-range* }
+table-database-range =
+ element table:database-range {
+ table-database-range-attlist,
+ (table-database-source-sql
+ | table-database-source-table
+ | table-database-source-query)?,
+ table-filter?,
+ table-sort?,
+ table-subtotal-rules?
+ }
+table-database-range-attlist =
+ attribute table:name { \string }?
+ & attribute table:is-selection { boolean }?
+ & attribute table:on-update-keep-styles { boolean }?
+ & attribute table:on-update-keep-size { boolean }?
+ & attribute table:has-persistent-data { boolean }?
+ & attribute table:orientation { "column" | "row" }?
+ & attribute table:contains-header { boolean }?
+ & attribute table:display-filter-buttons { boolean }?
+ & attribute table:target-range-address { cellRangeAddress }
+ & attribute table:refresh-delay { boolean }?
+table-database-source-sql =
+ element table:database-source-sql {
+ table-database-source-sql-attlist, empty
+ }
+table-database-source-sql-attlist =
+ attribute table:database-name { \string }
+ & attribute table:sql-statement { \string }
+ & attribute table:parse-sql-statement { boolean }?
+table-database-source-query =
+ element table:database-source-table {
+ table-database-source-table-attlist, empty
+ }
+table-database-source-table-attlist =
+ attribute table:database-name { \string }
+ & attribute table:database-table-name { \string }
+table-database-source-table =
+ element table:database-source-query {
+ table-database-source-query-attlist, empty
+ }
+table-database-source-query-attlist =
+ attribute table:database-name { \string }
+ & attribute table:query-name { \string }
+table-sort = element table:sort { table-sort-attlist, table-sort-by+ }
+table-sort-attlist =
+ attribute table:bind-styles-to-content { boolean }?
+ & attribute table:target-range-address { cellRangeAddress }?
+ & attribute table:case-sensitive { boolean }?
+ & attribute table:language { languageCode }?
+ & attribute table:country { countryCode }?
+ & attribute table:script { scriptCode }?
+ & attribute table:rfc-language-tag { language }?
+ & attribute table:algorithm { \string }?
+ & attribute table:embedded-number-behavior {
+ "alpha-numeric" | "integer" | "double"
+ }?
+table-sort-by = element table:sort-by { table-sort-by-attlist, empty }
+table-sort-by-attlist =
+ attribute table:field-number { nonNegativeInteger }
+ & attribute table:data-type {
+ "text" | "number" | "automatic" | \string
+ }?
+ & attribute table:order { "ascending" | "descending" }?
+table-subtotal-rules =
+ element table:subtotal-rules {
+ table-subtotal-rules-attlist,
+ table-sort-groups?,
+ table-subtotal-rule*
+ }
+table-subtotal-rules-attlist =
+ attribute table:bind-styles-to-content { boolean }?
+ & attribute table:case-sensitive { boolean }?
+ & attribute table:page-breaks-on-group-change { boolean }?
+table-sort-groups =
+ element table:sort-groups { table-sort-groups-attlist, empty }
+table-sort-groups-attlist =
+ attribute table:data-type {
+ "text" | "number" | "automatic" | \string
+ }?
+ & attribute table:order { "ascending" | "descending" }?
+table-subtotal-rule =
+ element table:subtotal-rule {
+ table-subtotal-rule-attlist, table-subtotal-field*
+ }
+table-subtotal-rule-attlist =
+ attribute table:group-by-field-number { nonNegativeInteger }
+table-subtotal-field =
+ element table:subtotal-field { table-subtotal-field-attlist, empty }
+table-subtotal-field-attlist =
+ attribute table:field-number { nonNegativeInteger }
+ & attribute table:function {
+ "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }
+table-filter =
+ element table:filter {
+ table-filter-attlist,
+ (table-filter-condition | table-filter-and | table-filter-or)
+ }
+table-filter-attlist =
+ attribute table:target-range-address { cellRangeAddress }?
+ & attribute table:condition-source { "self" | "cell-range" }?
+ & attribute table:condition-source-range-address { cellRangeAddress }?
+ & attribute table:display-duplicates { boolean }?
+table-filter-and =
+ element table:filter-and {
+ (table-filter-or | table-filter-condition)+
+ }
+table-filter-or =
+ element table:filter-or {
+ (table-filter-and | table-filter-condition)+
+ }
+table-filter-condition =
+ element table:filter-condition {
+ table-filter-condition-attlist, table-filter-set-item*
+ }
+table-filter-condition-attlist =
+ attribute table:field-number { nonNegativeInteger }
+ & attribute table:value { \string | double }
+ & attribute table:operator { \string }
+ & attribute table:case-sensitive { \string }?
+ & attribute table:data-type { "text" | "number" }?
+table-filter-set-item =
+ element table:filter-set-item {
+ attribute table:value { \string },
+ empty
+ }
+table-data-pilot-tables =
+ element table:data-pilot-tables { table-data-pilot-table* }
+table-data-pilot-table =
+ element table:data-pilot-table {
+ table-data-pilot-table-attlist,
+ (table-database-source-sql
+ | table-database-source-table
+ | table-database-source-query
+ | table-source-service
+ | table-source-cell-range)?,
+ table-data-pilot-field+
+ }
+table-data-pilot-table-attlist =
+ attribute table:name { \string }
+ & attribute table:application-data { \string }?
+ & attribute table:grand-total { "none" | "row" | "column" | "both" }?
+ & attribute table:ignore-empty-rows { boolean }?
+ & attribute table:identify-categories { boolean }?
+ & attribute table:target-range-address { cellRangeAddress }
+ & attribute table:buttons { cellRangeAddressList }?
+ & attribute table:show-filter-button { boolean }?
+ & attribute table:drill-down-on-double-click { boolean }?
+table-source-cell-range =
+ element table:source-cell-range {
+ table-source-cell-range-attlist, table-filter?
+ }
+table-source-cell-range-attlist =
+ attribute table:cell-range-address { cellRangeAddress }
+table-source-service =
+ element table:source-service { table-source-service-attlist, empty }
+table-source-service-attlist =
+ attribute table:name { \string }
+ & attribute table:source-name { \string }
+ & attribute table:object-name { \string }
+ & attribute table:user-name { \string }?
+ & attribute table:password { \string }?
+table-data-pilot-field =
+ element table:data-pilot-field {
+ table-data-pilot-field-attlist,
+ table-data-pilot-level?,
+ table-data-pilot-field-reference?,
+ table-data-pilot-groups?
+ }
+table-data-pilot-field-attlist =
+ attribute table:source-field-name { \string }
+ & (attribute table:orientation {
+ "row" | "column" | "data" | "hidden"
+ }
+ | (attribute table:orientation { "page" },
+ attribute table:selected-page { \string }))
+ & attribute table:is-data-layout-field { \string }?
+ & attribute table:function {
+ "auto"
+ | "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }?
+ & attribute table:used-hierarchy { integer }?
+table-data-pilot-level =
+ element table:data-pilot-level {
+ table-data-pilot-level-attlist,
+ table-data-pilot-subtotals?,
+ table-data-pilot-members?,
+ table-data-pilot-display-info?,
+ table-data-pilot-sort-info?,
+ table-data-pilot-layout-info?
+ }
+table-data-pilot-level-attlist = attribute table:show-empty { boolean }?
+table-data-pilot-subtotals =
+ element table:data-pilot-subtotals { table-data-pilot-subtotal* }
+table-data-pilot-subtotal =
+ element table:data-pilot-subtotal {
+ table-data-pilot-subtotal-attlist, empty
+ }
+table-data-pilot-subtotal-attlist =
+ attribute table:function {
+ "auto"
+ | "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }
+table-data-pilot-members =
+ element table:data-pilot-members { table-data-pilot-member* }
+table-data-pilot-member =
+ element table:data-pilot-member {
+ table-data-pilot-member-attlist, empty
+ }
+table-data-pilot-member-attlist =
+ attribute table:name { \string }
+ & attribute table:display { boolean }?
+ & attribute table:show-details { boolean }?
+table-data-pilot-display-info =
+ element table:data-pilot-display-info {
+ table-data-pilot-display-info-attlist, empty
+ }
+table-data-pilot-display-info-attlist =
+ attribute table:enabled { boolean }
+ & attribute table:data-field { \string }
+ & attribute table:member-count { nonNegativeInteger }
+ & attribute table:display-member-mode { "from-top" | "from-bottom" }
+table-data-pilot-sort-info =
+ element table:data-pilot-sort-info {
+ table-data-pilot-sort-info-attlist, empty
+ }
+table-data-pilot-sort-info-attlist =
+ ((attribute table:sort-mode { "data" },
+ attribute table:data-field { \string })
+ | attribute table:sort-mode { "none" | "manual" | "name" })
+ & attribute table:order { "ascending" | "descending" }
+table-data-pilot-layout-info =
+ element table:data-pilot-layout-info {
+ table-data-pilot-layout-info-attlist, empty
+ }
+table-data-pilot-layout-info-attlist =
+ attribute table:layout-mode {
+ "tabular-layout"
+ | "outline-subtotals-top"
+ | "outline-subtotals-bottom"
+ }
+ & attribute table:add-empty-lines { boolean }
+table-data-pilot-field-reference =
+ element table:data-pilot-field-reference {
+ table-data-pilot-field-reference-attlist
+ }
+table-data-pilot-field-reference-attlist =
+ attribute table:field-name { \string }
+ & ((attribute table:member-type { "named" },
+ attribute table:member-name { \string })
+ | attribute table:member-type { "previous" | "next" })
+ & attribute table:type {
+ "none"
+ | "member-difference"
+ | "member-percentage"
+ | "member-percentage-difference"
+ | "running-total"
+ | "row-percentage"
+ | "column-percentage"
+ | "total-percentage"
+ | "index"
+ }
+table-data-pilot-groups =
+ element table:data-pilot-groups {
+ table-data-pilot-groups-attlist, table-data-pilot-group+
+ }
+table-data-pilot-groups-attlist =
+ attribute table:source-field-name { \string }
+ & (attribute table:date-start { dateOrDateTime | "auto" }
+ | attribute table:start { double | "auto" })
+ & (attribute table:date-end { dateOrDateTime | "auto" }
+ | attribute table:end { double | "auto" })
+ & attribute table:step { double }
+ & attribute table:grouped-by {
+ "seconds"
+ | "minutes"
+ | "hours"
+ | "days"
+ | "months"
+ | "quarters"
+ | "years"
+ }
+table-data-pilot-group =
+ element table:data-pilot-group {
+ table-data-pilot-group-attlist, table-data-pilot-group-member+
+ }
+table-data-pilot-group-attlist = attribute table:name { \string }
+table-data-pilot-group-member =
+ element table:data-pilot-group-member {
+ table-data-pilot-group-member-attlist
+ }
+table-data-pilot-group-member-attlist = attribute table:name { \string }
+table-consolidation =
+ element table:consolidation { table-consolidation-attlist, empty }
+table-consolidation-attlist =
+ attribute table:function {
+ "average"
+ | "count"
+ | "countnums"
+ | "max"
+ | "min"
+ | "product"
+ | "stdev"
+ | "stdevp"
+ | "sum"
+ | "var"
+ | "varp"
+ | \string
+ }
+ & attribute table:source-cell-range-addresses { cellRangeAddressList }
+ & attribute table:target-cell-address { cellAddress }
+ & attribute table:use-labels { "none" | "row" | "column" | "both" }?
+ & attribute table:link-to-source-data { boolean }?
+table-dde-links = element table:dde-links { table-dde-link+ }
+table-tracked-changes =
+ element table:tracked-changes {
+ table-tracked-changes-attlist,
+ (table-cell-content-change
+ | table-insertion
+ | table-deletion
+ | table-movement)*
+ }
+table-tracked-changes-attlist =
+ attribute table:track-changes { boolean }?
+table-insertion =
+ element table:insertion {
+ table-insertion-attlist,
+ common-table-change-attlist,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?
+ }
+table-insertion-attlist =
+ attribute table:type { "row" | "column" | "table" }
+ & attribute table:position { integer }
+ & attribute table:count { positiveInteger }?
+ & attribute table:table { integer }?
+table-dependencies = element table:dependencies { table-dependency+ }
+table-dependency =
+ element table:dependency {
+ attribute table:id { \string },
+ empty
+ }
+table-deletions =
+ element table:deletions {
+ (table-cell-content-deletion | table-change-deletion)+
+ }
+table-cell-content-deletion =
+ element table:cell-content-deletion {
+ attribute table:id { \string }?,
+ table-cell-address?,
+ table-change-track-table-cell?
+ }
+table-change-deletion =
+ element table:change-deletion {
+ attribute table:id { \string }?,
+ empty
+ }
+table-deletion =
+ element table:deletion {
+ table-deletion-attlist,
+ common-table-change-attlist,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?,
+ table-cut-offs?
+ }
+table-deletion-attlist =
+ attribute table:type { "row" | "column" | "table" }
+ & attribute table:position { integer }
+ & attribute table:table { integer }?
+ & attribute table:multi-deletion-spanned { integer }?
+table-cut-offs =
+ element table:cut-offs {
+ table-movement-cut-off+
+ | (table-insertion-cut-off, table-movement-cut-off*)
+ }
+table-insertion-cut-off =
+ element table:insertion-cut-off {
+ table-insertion-cut-off-attlist, empty
+ }
+table-insertion-cut-off-attlist =
+ attribute table:id { \string }
+ & attribute table:position { integer }
+table-movement-cut-off =
+ element table:movement-cut-off {
+ table-movement-cut-off-attlist, empty
+ }
+table-movement-cut-off-attlist =
+ attribute table:position { integer }
+ | (attribute table:start-position { integer },
+ attribute table:end-position { integer })
+table-movement =
+ element table:movement {
+ common-table-change-attlist,
+ table-source-range-address,
+ table-target-range-address,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?
+ }
+table-source-range-address =
+ element table:source-range-address {
+ common-table-range-attlist, empty
+ }
+table-target-range-address =
+ element table:target-range-address {
+ common-table-range-attlist, empty
+ }
+common-table-range-attlist =
+ common-table-cell-address-attlist
+ | common-table-cell-range-address-attlist
+common-table-cell-address-attlist =
+ attribute table:column { integer },
+ attribute table:row { integer },
+ attribute table:table { integer }
+common-table-cell-range-address-attlist =
+ attribute table:start-column { integer },
+ attribute table:start-row { integer },
+ attribute table:start-table { integer },
+ attribute table:end-column { integer },
+ attribute table:end-row { integer },
+ attribute table:end-table { integer }
+table-change-track-table-cell =
+ element table:change-track-table-cell {
+ table-change-track-table-cell-attlist, text-p*
+ }
+table-change-track-table-cell-attlist =
+ attribute table:cell-address { cellAddress }?
+ & attribute table:matrix-covered { boolean }?
+ & attribute table:formula { \string }?
+ & attribute table:number-matrix-columns-spanned { positiveInteger }?
+ & attribute table:number-matrix-rows-spanned { positiveInteger }?
+ & common-value-and-type-attlist?
+table-cell-content-change =
+ element table:cell-content-change {
+ common-table-change-attlist,
+ table-cell-address,
+ office-change-info,
+ table-dependencies?,
+ table-deletions?,
+ table-previous
+ }
+table-cell-address =
+ element table:cell-address {
+ common-table-cell-address-attlist, empty
+ }
+table-previous =
+ element table:previous {
+ attribute table:id { \string }?,
+ table-change-track-table-cell
+ }
+common-table-change-attlist =
+ attribute table:id { \string }
+ & attribute table:acceptance-state {
+ "accepted" | "rejected" | "pending"
+ }?
+ & attribute table:rejecting-change-id { \string }?
+style-handout-master =
+ element style:handout-master {
+ common-presentation-header-footer-attlist,
+ style-handout-master-attlist,
+ shape*
+ }
+style-handout-master-attlist =
+ attribute presentation:presentation-page-layout-name { styleNameRef }?
+ & attribute style:page-layout-name { styleNameRef }
+ & attribute draw:style-name { styleNameRef }?
+draw-layer-set = element draw:layer-set { draw-layer* }
+draw-layer =
+ element draw:layer { draw-layer-attlist, svg-title?, svg-desc? }
+draw-layer-attlist =
+ attribute draw:name { \string }
+ & attribute draw:protected { boolean }?
+ & attribute draw:display { "always" | "screen" | "printer" | "none" }?
+draw-page =
+ element draw:page {
+ common-presentation-header-footer-attlist,
+ draw-page-attlist,
+ svg-title?,
+ svg-desc?,
+ draw-layer-set?,
+ office-forms?,
+ shape*,
+ (presentation-animations | animation-element)?,
+ presentation-notes?
+ }
+draw-page-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:style-name { styleNameRef }?
+ & attribute draw:master-page-name { styleNameRef }
+ & attribute presentation:presentation-page-layout-name {
+ styleNameRef
+ }?
+ & (xml-id,
+ attribute draw:id { NCName }?)?
+ & attribute draw:nav-order { IDREFS }?
+common-presentation-header-footer-attlist =
+ attribute presentation:use-header-name { \string }?
+ & attribute presentation:use-footer-name { \string }?
+ & attribute presentation:use-date-time-name { \string }?
+shape = shape-instance | draw-a
+shape-instance =
+ draw-rect
+ | draw-line
+ | draw-polyline
+ | draw-polygon
+ | draw-regular-polygon
+ | draw-path
+ | draw-circle
+ | draw-ellipse
+ | draw-g
+ | draw-page-thumbnail
+ | draw-frame
+ | draw-measure
+ | draw-caption
+ | draw-connector
+ | draw-control
+ | dr3d-scene
+ | draw-custom-shape
+draw-rect =
+ element draw:rect {
+ draw-rect-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-rect-attlist =
+ attribute draw:corner-radius { nonNegativeLength }?
+ | (attribute svg:rx { nonNegativeLength }?,
+ attribute svg:ry { nonNegativeLength }?)
+draw-line =
+ element draw:line {
+ draw-line-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-line-attlist =
+ attribute svg:x1 { coordinate }
+ & attribute svg:y1 { coordinate }
+ & attribute svg:x2 { coordinate }
+ & attribute svg:y2 { coordinate }
+draw-polyline =
+ element draw:polyline {
+ common-draw-points-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+common-draw-points-attlist = attribute draw:points { points }
+draw-polygon =
+ element draw:polygon {
+ common-draw-points-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-regular-polygon =
+ element draw:regular-polygon {
+ draw-regular-polygon-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-regular-polygon-attlist =
+ (attribute draw:concave { "false" }
+ | (attribute draw:concave { "true" },
+ draw-regular-polygon-sharpness-attlist))
+ & attribute draw:corners { positiveInteger }
+draw-regular-polygon-sharpness-attlist =
+ attribute draw:sharpness { percent }
+draw-path =
+ element draw:path {
+ common-draw-path-data-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+common-draw-path-data-attlist = attribute svg:d { pathData }
+draw-circle =
+ element draw:circle {
+ ((draw-circle-attlist, common-draw-circle-ellipse-pos-attlist)
+ | (common-draw-position-attlist, common-draw-size-attlist)),
+ common-draw-circle-ellipse-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+common-draw-circle-ellipse-pos-attlist =
+ attribute svg:cx { coordinate },
+ attribute svg:cy { coordinate }
+draw-circle-attlist = attribute svg:r { length }
+common-draw-circle-ellipse-attlist =
+ attribute draw:kind { "full" | "section" | "cut" | "arc" }?
+ & attribute draw:start-angle { angle }?
+ & attribute draw:end-angle { angle }?
+draw-ellipse =
+ element draw:ellipse {
+ ((draw-ellipse-attlist, common-draw-circle-ellipse-pos-attlist)
+ | (common-draw-position-attlist, common-draw-size-attlist)),
+ common-draw-circle-ellipse-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-ellipse-attlist =
+ attribute svg:rx { length },
+ attribute svg:ry { length }
+draw-connector =
+ element draw:connector {
+ draw-connector-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ common-draw-viewbox-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-connector-attlist =
+ attribute draw:type { "standard" | "lines" | "line" | "curve" }?
+ & (attribute svg:x1 { coordinate },
+ attribute svg:y1 { coordinate })?
+ & attribute draw:start-shape { IDREF }?
+ & attribute draw:start-glue-point { nonNegativeInteger }?
+ & (attribute svg:x2 { coordinate },
+ attribute svg:y2 { coordinate })?
+ & attribute draw:end-shape { IDREF }?
+ & attribute draw:end-glue-point { nonNegativeInteger }?
+ & attribute draw:line-skew {
+ list { length, (length, length?)? }
+ }?
+ & attribute svg:d { pathData }?
+draw-caption =
+ element draw:caption {
+ draw-caption-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-caption-attlist =
+ (attribute draw:caption-point-x { coordinate },
+ attribute draw:caption-point-y { coordinate })?
+ & attribute draw:corner-radius { nonNegativeLength }?
+draw-measure =
+ element draw:measure {
+ draw-measure-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text
+ }
+draw-measure-attlist =
+ attribute svg:x1 { coordinate }
+ & attribute svg:y1 { coordinate }
+ & attribute svg:x2 { coordinate }
+ & attribute svg:y2 { coordinate }
+draw-control =
+ element draw:control {
+ draw-control-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ draw-glue-point*
+ }
+draw-control-attlist = attribute draw:control { IDREF }
+draw-page-thumbnail =
+ element draw:page-thumbnail {
+ draw-page-thumbnail-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ presentation-shape-attlist,
+ common-draw-shape-with-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?
+ }
+draw-page-thumbnail-attlist =
+ attribute draw:page-number { positiveInteger }?
+draw-g =
+ element draw:g {
+ draw-g-attlist,
+ common-draw-z-index-attlist,
+ common-draw-name-attlist,
+ common-draw-id-attlist,
+ common-draw-style-name-attlist,
+ common-text-spreadsheet-shape-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ shape*
+ }
+draw-g-attlist = attribute svg:y { coordinate }?
+common-draw-name-attlist = attribute draw:name { \string }?
+common-draw-caption-id-attlist = attribute draw:caption-id { IDREF }?
+common-draw-position-attlist =
+ attribute svg:x { coordinate }?,
+ attribute svg:y { coordinate }?
+common-draw-size-attlist =
+ attribute svg:width { length }?,
+ attribute svg:height { length }?
+common-draw-transform-attlist = attribute draw:transform { \string }?
+common-draw-viewbox-attlist =
+ attribute svg:viewBox {
+ list { integer, integer, integer, integer }
+ }
+common-draw-style-name-attlist =
+ (attribute draw:style-name { styleNameRef }?,
+ attribute draw:class-names { styleNameRefs }?)
+ | (attribute presentation:style-name { styleNameRef }?,
+ attribute presentation:class-names { styleNameRefs }?)
+common-draw-text-style-name-attlist =
+ attribute draw:text-style-name { styleNameRef }?
+common-draw-layer-name-attlist = attribute draw:layer { \string }?
+common-draw-id-attlist =
+ (xml-id,
+ attribute draw:id { NCName }?)?
+common-draw-z-index-attlist =
+ attribute draw:z-index { nonNegativeInteger }?
+common-text-spreadsheet-shape-attlist =
+ attribute table:end-cell-address { cellAddress }?
+ & attribute table:end-x { coordinate }?
+ & attribute table:end-y { coordinate }?
+ & attribute table:table-background { boolean }?
+ & common-text-anchor-attlist
+common-text-anchor-attlist =
+ attribute text:anchor-type {
+ "page" | "frame" | "paragraph" | "char" | "as-char"
+ }?
+ & attribute text:anchor-page-number { positiveInteger }?
+draw-text = (text-p | text-list)*
+common-draw-shape-with-styles-attlist =
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-draw-transform-attlist,
+ common-draw-name-attlist,
+ common-text-spreadsheet-shape-attlist
+common-draw-shape-with-text-and-styles-attlist =
+ common-draw-shape-with-styles-attlist,
+ common-draw-text-style-name-attlist
+draw-glue-point =
+ element draw:glue-point { draw-glue-point-attlist, empty }
+draw-glue-point-attlist =
+ attribute draw:id { nonNegativeInteger }
+ & attribute svg:x { distance | percent }
+ & attribute svg:y { distance | percent }
+ & attribute draw:align {
+ "top-left"
+ | "top"
+ | "top-right"
+ | "left"
+ | "center"
+ | "right"
+ | "bottom-left"
+ | "bottom-right"
+ }?
+ & attribute draw:escape-direction {
+ "auto"
+ | "left"
+ | "right"
+ | "up"
+ | "down"
+ | "horizontal"
+ | "vertical"
+ }
+svg-title = element svg:title { text }
+svg-desc = element svg:desc { text }
+draw-frame =
+ element draw:frame {
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-position-attlist,
+ common-draw-rel-size-attlist,
+ common-draw-caption-id-attlist,
+ presentation-shape-attlist,
+ draw-frame-attlist,
+ (draw-text-box
+ | draw-image
+ | draw-object
+ | draw-object-ole
+ | draw-applet
+ | draw-floating-frame
+ | draw-plugin
+ | table-table)*,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-image-map?,
+ svg-title?,
+ svg-desc?,
+ (draw-contour-polygon | draw-contour-path)?
+ }
+common-draw-rel-size-attlist =
+ common-draw-size-attlist,
+ attribute style:rel-width { percent | "scale" | "scale-min" }?,
+ attribute style:rel-height { percent | "scale" | "scale-min" }?
+draw-frame-attlist = attribute draw:copy-of { \string }?
+draw-text-box =
+ element draw:text-box { draw-text-box-attlist, text-content* }
+draw-text-box-attlist =
+ attribute draw:chain-next-name { \string }?
+ & attribute draw:corner-radius { nonNegativeLength }?
+ & attribute fo:min-height { length | percent }?
+ & attribute fo:min-width { length | percent }?
+ & attribute fo:max-height { length | percent }?
+ & attribute fo:max-width { length | percent }?
+ & (xml-id,
+ attribute text:id { NCName }?)?
+draw-image =
+ element draw:image {
+ draw-image-attlist,
+ (common-draw-data-attlist | office-binary-data),
+ draw-text
+ }
+common-draw-data-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onLoad" }?
+office-binary-data = element office:binary-data { base64Binary }
+draw-image-attlist =
+ attribute draw:filter-name { \string }?
+ & xml-id?
+draw-object =
+ element draw:object {
+ draw-object-attlist,
+ (common-draw-data-attlist | office-document | math-math)
+ }
+draw-object-ole =
+ element draw:object-ole {
+ draw-object-ole-attlist,
+ (common-draw-data-attlist | office-binary-data)
+ }
+draw-object-attlist =
+ attribute draw:notify-on-update-of-ranges {
+ cellRangeAddressList | \string
+ }?
+ & xml-id?
+draw-object-ole-attlist =
+ attribute draw:class-id { \string }?
+ & xml-id?
+draw-applet =
+ element draw:applet {
+ draw-applet-attlist, common-draw-data-attlist?, draw-param*
+ }
+draw-applet-attlist =
+ attribute draw:code { \string }?
+ & attribute draw:object { \string }?
+ & attribute draw:archive { \string }?
+ & attribute draw:may-script { boolean }?
+ & xml-id?
+draw-plugin =
+ element draw:plugin {
+ draw-plugin-attlist, common-draw-data-attlist, draw-param*
+ }
+draw-plugin-attlist =
+ attribute draw:mime-type { \string }?
+ & xml-id?
+draw-param = element draw:param { draw-param-attlist, empty }
+draw-param-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:value { \string }?
+draw-floating-frame =
+ element draw:floating-frame {
+ draw-floating-frame-attlist, common-draw-data-attlist
+ }
+draw-floating-frame-attlist =
+ attribute draw:frame-name { \string }?
+ & xml-id?
+draw-contour-polygon =
+ element draw:contour-polygon {
+ common-contour-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-points-attlist,
+ empty
+ }
+draw-contour-path =
+ element draw:contour-path {
+ common-contour-attlist,
+ common-draw-size-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ empty
+ }
+common-contour-attlist = attribute draw:recreate-on-edit { boolean }
+draw-a = element draw:a { draw-a-attlist, shape-instance }
+draw-a-attlist =
+ attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute xlink:actuate { "onRequest" }?
+ & attribute office:target-frame-name { targetFrameName }?
+ & attribute xlink:show { "new" | "replace" }?
+ & attribute office:name { \string }?
+ & attribute office:title { \string }?
+ & attribute office:server-map { boolean }?
+ & xml-id?
+draw-image-map =
+ element draw:image-map {
+ (draw-area-rectangle | draw-area-circle | draw-area-polygon)*
+ }
+draw-area-rectangle =
+ element draw:area-rectangle {
+ common-draw-area-attlist,
+ attribute svg:x { coordinate },
+ attribute svg:y { coordinate },
+ attribute svg:width { length },
+ attribute svg:height { length },
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?
+ }
+draw-area-circle =
+ element draw:area-circle {
+ common-draw-area-attlist,
+ attribute svg:cx { coordinate },
+ attribute svg:cy { coordinate },
+ attribute svg:r { length },
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?
+ }
+draw-area-polygon =
+ element draw:area-polygon {
+ common-draw-area-attlist,
+ attribute svg:x { coordinate },
+ attribute svg:y { coordinate },
+ attribute svg:width { length },
+ attribute svg:height { length },
+ common-draw-viewbox-attlist,
+ common-draw-points-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?
+ }
+common-draw-area-attlist =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute office:target-frame-name { targetFrameName }?,
+ attribute xlink:show { "new" | "replace" }?)?
+ & attribute office:name { \string }?
+ & attribute draw:nohref { "nohref" }?
+dr3d-scene =
+ element dr3d:scene {
+ dr3d-scene-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-style-name-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-text-spreadsheet-shape-attlist,
+ common-dr3d-transform-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ dr3d-light*,
+ shapes3d*,
+ draw-glue-point*
+ }
+shapes3d =
+ dr3d-scene | dr3d-extrude | dr3d-sphere | dr3d-rotate | dr3d-cube
+dr3d-scene-attlist =
+ attribute dr3d:vrp { vector3D }?
+ & attribute dr3d:vpn { vector3D }?
+ & attribute dr3d:vup { vector3D }?
+ & attribute dr3d:projection { "parallel" | "perspective" }?
+ & attribute dr3d:distance { length }?
+ & attribute dr3d:focal-length { length }?
+ & attribute dr3d:shadow-slant { angle }?
+ & attribute dr3d:shade-mode {
+ "flat" | "phong" | "gouraud" | "draft"
+ }?
+ & attribute dr3d:ambient-color { color }?
+ & attribute dr3d:lighting-mode { boolean }?
+common-dr3d-transform-attlist = attribute dr3d:transform { \string }?
+dr3d-light = element dr3d:light { dr3d-light-attlist, empty }
+dr3d-light-attlist =
+ attribute dr3d:diffuse-color { color }?
+ & attribute dr3d:direction { vector3D }
+ & attribute dr3d:enabled { boolean }?
+ & attribute dr3d:specular { boolean }?
+dr3d-cube =
+ element dr3d:cube {
+ dr3d-cube-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+dr3d-cube-attlist =
+ attribute dr3d:min-edge { vector3D }?,
+ attribute dr3d:max-edge { vector3D }?
+dr3d-sphere =
+ element dr3d:sphere {
+ dr3d-sphere-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+dr3d-sphere-attlist =
+ attribute dr3d:center { vector3D }?
+ & attribute dr3d:size { vector3D }?
+dr3d-extrude =
+ element dr3d:extrude {
+ common-draw-path-data-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-id-attlist,
+ common-draw-z-index-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+dr3d-rotate =
+ element dr3d:rotate {
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ common-draw-z-index-attlist,
+ common-draw-id-attlist,
+ common-draw-layer-name-attlist,
+ common-draw-style-name-attlist,
+ common-dr3d-transform-attlist,
+ empty
+ }
+draw-custom-shape =
+ element draw:custom-shape {
+ draw-custom-shape-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ common-draw-caption-id-attlist,
+ svg-title?,
+ svg-desc?,
+ office-event-listeners?,
+ draw-glue-point*,
+ draw-text,
+ draw-enhanced-geometry?
+ }
+draw-custom-shape-attlist =
+ attribute draw:engine { namespacedToken }?
+ & attribute draw:data { \string }?
+draw-enhanced-geometry =
+ element draw:enhanced-geometry {
+ draw-enhanced-geometry-attlist, draw-equation*, draw-handle*
+ }
+draw-enhanced-geometry-attlist =
+ attribute draw:type { custom-shape-type }?
+ & attribute svg:viewBox {
+ list { integer, integer, integer, integer }
+ }?
+ & attribute draw:mirror-vertical { boolean }?
+ & attribute draw:mirror-horizontal { boolean }?
+ & attribute draw:text-rotate-angle { angle }?
+ & attribute draw:extrusion-allowed { boolean }?
+ & attribute draw:text-path-allowed { boolean }?
+ & attribute draw:concentric-gradient-fill-allowed { boolean }?
+ & attribute draw:extrusion { boolean }?
+ & attribute draw:extrusion-brightness { zeroToHundredPercent }?
+ & attribute draw:extrusion-depth {
+ list { length, double }
+ }?
+ & attribute draw:extrusion-diffusion { percent }?
+ & attribute draw:extrusion-number-of-line-segments { integer }?
+ & attribute draw:extrusion-light-face { boolean }?
+ & attribute draw:extrusion-first-light-harsh { boolean }?
+ & attribute draw:extrusion-second-light-harsh { boolean }?
+ & attribute draw:extrusion-first-light-level { zeroToHundredPercent }?
+ & attribute draw:extrusion-second-light-level {
+ zeroToHundredPercent
+ }?
+ & attribute draw:extrusion-first-light-direction { vector3D }?
+ & attribute draw:extrusion-second-light-direction { vector3D }?
+ & attribute draw:extrusion-metal { boolean }?
+ & attribute dr3d:shade-mode {
+ "flat" | "phong" | "gouraud" | "draft"
+ }?
+ & attribute draw:extrusion-rotation-angle {
+ list { angle, angle }
+ }?
+ & attribute draw:extrusion-rotation-center { vector3D }?
+ & attribute draw:extrusion-shininess { zeroToHundredPercent }?
+ & attribute draw:extrusion-skew {
+ list { double, angle }
+ }?
+ & attribute draw:extrusion-specularity { zeroToHundredPercent }?
+ & attribute dr3d:projection { "parallel" | "perspective" }?
+ & attribute draw:extrusion-viewpoint { point3D }?
+ & attribute draw:extrusion-origin {
+ list { extrusionOrigin, extrusionOrigin }
+ }?
+ & attribute draw:extrusion-color { boolean }?
+ & attribute draw:enhanced-path { \string }?
+ & attribute draw:path-stretchpoint-x { double }?
+ & attribute draw:path-stretchpoint-y { double }?
+ & attribute draw:text-areas { \string }?
+ & attribute draw:glue-points { \string }?
+ & attribute draw:glue-point-type {
+ "none" | "segments" | "rectangle"
+ }?
+ & attribute draw:glue-point-leaving-directions { \string }?
+ & attribute draw:text-path { boolean }?
+ & attribute draw:text-path-mode { "normal" | "path" | "shape" }?
+ & attribute draw:text-path-scale { "path" | "shape" }?
+ & attribute draw:text-path-same-letter-heights { boolean }?
+ & attribute draw:modifiers { \string }?
+custom-shape-type = "non-primitive" | \string
+point3D =
+ xsd:string {
+ pattern =
+ "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))){2}[ ]*\)"
+ }
+extrusionOrigin =
+ xsd:double { minInclusive = "-0.5" maxInclusive = "0.5" }
+draw-equation = element draw:equation { draw-equation-attlist, empty }
+draw-equation-attlist =
+ attribute draw:name { \string }?
+ & attribute draw:formula { \string }?
+draw-handle = element draw:handle { draw-handle-attlist, empty }
+draw-handle-attlist =
+ attribute draw:handle-mirror-vertical { boolean }?
+ & attribute draw:handle-mirror-horizontal { boolean }?
+ & attribute draw:handle-switched { boolean }?
+ & attribute draw:handle-position { \string }
+ & attribute draw:handle-range-x-minimum { \string }?
+ & attribute draw:handle-range-x-maximum { \string }?
+ & attribute draw:handle-range-y-minimum { \string }?
+ & attribute draw:handle-range-y-maximum { \string }?
+ & attribute draw:handle-polar { \string }?
+ & attribute draw:handle-radius-range-minimum { \string }?
+ & attribute draw:handle-radius-range-maximum { \string }?
+presentation-shape-attlist =
+ attribute presentation:class { presentation-classes }?
+ & attribute presentation:placeholder { boolean }?
+ & attribute presentation:user-transformed { boolean }?
+presentation-classes =
+ "title"
+ | "outline"
+ | "subtitle"
+ | "text"
+ | "graphic"
+ | "object"
+ | "chart"
+ | "table"
+ | "orgchart"
+ | "page"
+ | "notes"
+ | "handout"
+ | "header"
+ | "footer"
+ | "date-time"
+ | "page-number"
+presentation-animations =
+ element presentation:animations {
+ (presentation-animation-elements | presentation-animation-group)*
+ }
+presentation-animation-elements =
+ presentation-show-shape
+ | presentation-show-text
+ | presentation-hide-shape
+ | presentation-hide-text
+ | presentation-dim
+ | presentation-play
+presentation-sound =
+ element presentation:sound {
+ presentation-sound-attlist,
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?,
+ attribute xlink:show { "new" | "replace" }?,
+ empty
+ }
+presentation-sound-attlist =
+ attribute presentation:play-full { boolean }?
+ & xml-id?
+presentation-show-shape =
+ element presentation:show-shape {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+common-presentation-effect-attlist =
+ attribute draw:shape-id { IDREF }
+ & attribute presentation:effect { presentationEffects }?
+ & attribute presentation:direction { presentationEffectDirections }?
+ & attribute presentation:speed { presentationSpeeds }?
+ & attribute presentation:delay { duration }?
+ & attribute presentation:start-scale { percent }?
+ & attribute presentation:path-id { \string }?
+presentationEffects =
+ "none"
+ | "fade"
+ | "move"
+ | "stripes"
+ | "open"
+ | "close"
+ | "dissolve"
+ | "wavyline"
+ | "random"
+ | "lines"
+ | "laser"
+ | "appear"
+ | "hide"
+ | "move-short"
+ | "checkerboard"
+ | "rotate"
+ | "stretch"
+presentationEffectDirections =
+ "none"
+ | "from-left"
+ | "from-top"
+ | "from-right"
+ | "from-bottom"
+ | "from-center"
+ | "from-upper-left"
+ | "from-upper-right"
+ | "from-lower-left"
+ | "from-lower-right"
+ | "to-left"
+ | "to-top"
+ | "to-right"
+ | "to-bottom"
+ | "to-upper-left"
+ | "to-upper-right"
+ | "to-lower-right"
+ | "to-lower-left"
+ | "path"
+ | "spiral-inward-left"
+ | "spiral-inward-right"
+ | "spiral-outward-left"
+ | "spiral-outward-right"
+ | "vertical"
+ | "horizontal"
+ | "to-center"
+ | "clockwise"
+ | "counter-clockwise"
+presentationSpeeds = "slow" | "medium" | "fast"
+presentation-show-text =
+ element presentation:show-text {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+presentation-hide-shape =
+ element presentation:hide-shape {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+presentation-hide-text =
+ element presentation:hide-text {
+ common-presentation-effect-attlist, presentation-sound?
+ }
+presentation-dim =
+ element presentation:dim {
+ presentation-dim-attlist, presentation-sound?
+ }
+presentation-dim-attlist =
+ attribute draw:shape-id { IDREF }
+ & attribute draw:color { color }
+presentation-play =
+ element presentation:play { presentation-play-attlist, empty }
+presentation-play-attlist =
+ attribute draw:shape-id { IDREF },
+ attribute presentation:speed { presentationSpeeds }?
+presentation-animation-group =
+ element presentation:animation-group {
+ presentation-animation-elements*
+ }
+common-anim-attlist =
+ attribute presentation:node-type {
+ "default"
+ | "on-click"
+ | "with-previous"
+ | "after-previous"
+ | "timing-root"
+ | "main-sequence"
+ | "interactive-sequence"
+ }?
+ & attribute presentation:preset-id { \string }?
+ & attribute presentation:preset-sub-type { \string }?
+ & attribute presentation:preset-class {
+ "custom"
+ | "entrance"
+ | "exit"
+ | "emphasis"
+ | "motion-path"
+ | "ole-action"
+ | "media-call"
+ }?
+ & attribute presentation:master-element { IDREF }?
+ & attribute presentation:group-id { \string }?
+ & (xml-id,
+ attribute anim:id { NCName }?)?
+presentation-event-listener =
+ element presentation:event-listener {
+ presentation-event-listener-attlist, presentation-sound?
+ }
+presentation-event-listener-attlist =
+ attribute script:event-name { \string }
+ & attribute presentation:action {
+ "none"
+ | "previous-page"
+ | "next-page"
+ | "first-page"
+ | "last-page"
+ | "hide"
+ | "stop"
+ | "execute"
+ | "show"
+ | "verb"
+ | "fade-out"
+ | "sound"
+ | "last-visited-page"
+ }
+ & attribute presentation:effect { presentationEffects }?
+ & attribute presentation:direction { presentationEffectDirections }?
+ & attribute presentation:speed { presentationSpeeds }?
+ & attribute presentation:start-scale { percent }?
+ & (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onRequest" }?)?
+ & attribute presentation:verb { nonNegativeInteger }?
+presentation-decls = presentation-decl*
+presentation-decl =
+ element presentation:header-decl {
+ presentation-header-decl-attlist, text
+ }
+ | element presentation:footer-decl {
+ presentation-footer-decl-attlist, text
+ }
+ | element presentation:date-time-decl {
+ presentation-date-time-decl-attlist, text
+ }
+presentation-header-decl-attlist =
+ attribute presentation:name { \string }
+presentation-footer-decl-attlist =
+ attribute presentation:name { \string }
+presentation-date-time-decl-attlist =
+ attribute presentation:name { \string }
+ & attribute presentation:source { "fixed" | "current-date" }
+ & attribute style:data-style-name { styleNameRef }?
+presentation-settings =
+ element presentation:settings {
+ presentation-settings-attlist, presentation-show*
+ }?
+presentation-settings-attlist =
+ attribute presentation:start-page { \string }?
+ & attribute presentation:show { \string }?
+ & attribute presentation:full-screen { boolean }?
+ & attribute presentation:endless { boolean }?
+ & attribute presentation:pause { duration }?
+ & attribute presentation:show-logo { boolean }?
+ & attribute presentation:force-manual { boolean }?
+ & attribute presentation:mouse-visible { boolean }?
+ & attribute presentation:mouse-as-pen { boolean }?
+ & attribute presentation:start-with-navigator { boolean }?
+ & attribute presentation:animations { "enabled" | "disabled" }?
+ & attribute presentation:transition-on-click {
+ "enabled" | "disabled"
+ }?
+ & attribute presentation:stay-on-top { boolean }?
+ & attribute presentation:show-end-of-presentation-slide { boolean }?
+presentation-show =
+ element presentation:show { presentation-show-attlist, empty }
+presentation-show-attlist =
+ attribute presentation:name { \string }
+ & attribute presentation:pages { \string }
+chart-chart =
+ element chart:chart {
+ chart-chart-attlist,
+ chart-title?,
+ chart-subtitle?,
+ chart-footer?,
+ chart-legend?,
+ chart-plot-area,
+ table-table?
+ }
+chart-chart-attlist =
+ attribute chart:class { namespacedToken }
+ & common-draw-size-attlist
+ & attribute chart:column-mapping { \string }?
+ & attribute chart:row-mapping { \string }?
+ & attribute chart:style-name { styleNameRef }?
+ & (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI })?
+ & xml-id?
+chart-title = element chart:title { chart-title-attlist, text-p? }
+chart-title-attlist =
+ attribute table:cell-range { cellRangeAddressList }?
+ & common-draw-position-attlist
+ & attribute chart:style-name { styleNameRef }?
+chart-subtitle = element chart:subtitle { chart-title-attlist, text-p? }
+chart-footer = element chart:footer { chart-title-attlist, text-p? }
+chart-legend = element chart:legend { chart-legend-attlist, text-p? }
+chart-legend-attlist =
+ ((attribute chart:legend-position {
+ "start" | "end" | "top" | "bottom"
+ },
+ attribute chart:legend-align { "start" | "center" | "end" }?)
+ | attribute chart:legend-position {
+ "top-start" | "bottom-start" | "top-end" | "bottom-end"
+ }
+ | empty)
+ & common-draw-position-attlist
+ & (attribute style:legend-expansion { "wide" | "high" | "balanced" }
+ | (attribute style:legend-expansion { "custom" },
+ attribute style:legend-expansion-aspect-ratio { double })
+ | empty)
+ & attribute chart:style-name { styleNameRef }?
+chart-plot-area =
+ element chart:plot-area {
+ chart-plot-area-attlist,
+ dr3d-light*,
+ chart-axis*,
+ chart-series*,
+ chart-stock-gain-marker?,
+ chart-stock-loss-marker?,
+ chart-stock-range-line?,
+ chart-wall?,
+ chart-floor?
+ }
+chart-plot-area-attlist =
+ common-draw-position-attlist
+ & common-draw-size-attlist
+ & attribute chart:style-name { styleNameRef }?
+ & attribute table:cell-range-address { cellRangeAddressList }?
+ & attribute chart:data-source-has-labels {
+ "none" | "row" | "column" | "both"
+ }?
+ & dr3d-scene-attlist
+ & common-dr3d-transform-attlist
+ & xml-id?
+chart-wall = element chart:wall { chart-wall-attlist, empty }
+chart-wall-attlist =
+ attribute svg:width { length }?
+ & attribute chart:style-name { styleNameRef }?
+chart-floor = element chart:floor { chart-floor-attlist, empty }
+chart-floor-attlist =
+ attribute svg:width { length }?
+ & attribute chart:style-name { styleNameRef }?
+chart-axis =
+ element chart:axis {
+ chart-axis-attlist, chart-title?, chart-categories?, chart-grid*
+ }
+chart-axis-attlist =
+ attribute chart:dimension { chart-dimension }
+ & attribute chart:name { \string }?
+ & attribute chart:style-name { styleNameRef }?
+chart-dimension = "x" | "y" | "z"
+chart-categories =
+ element chart:categories {
+ attribute table:cell-range-address { cellRangeAddressList }?
+ }
+chart-grid = element chart:grid { chart-grid-attlist }
+chart-grid-attlist =
+ attribute chart:class { "major" | "minor" }?
+ & attribute chart:style-name { styleNameRef }?
+chart-series =
+ element chart:series {
+ chart-series-attlist,
+ chart-domain*,
+ chart-mean-value?,
+ chart-regression-curve*,
+ chart-error-indicator*,
+ chart-data-point*,
+ chart-data-label?
+ }
+chart-series-attlist =
+ attribute chart:values-cell-range-address { cellRangeAddressList }?
+ & attribute chart:label-cell-address { cellRangeAddressList }?
+ & attribute chart:class { namespacedToken }?
+ & attribute chart:attached-axis { \string }?
+ & attribute chart:style-name { styleNameRef }?
+ & xml-id?
+chart-domain =
+ element chart:domain {
+ attribute table:cell-range-address { cellRangeAddressList }?
+ }
+chart-data-point =
+ element chart:data-point {
+ chart-data-point-attlist, chart-data-label?
+ }
+chart-data-point-attlist =
+ attribute chart:repeated { positiveInteger }?
+ & attribute chart:style-name { styleNameRef }?
+ & xml-id?
+chart-data-label =
+ element chart:data-label { chart-data-label-attlist, text-p? }
+chart-data-label-attlist =
+ common-draw-position-attlist
+ & attribute chart:style-name { styleNameRef }?
+chart-mean-value =
+ element chart:mean-value { chart-mean-value-attlist, empty }
+chart-mean-value-attlist = attribute chart:style-name { styleNameRef }?
+chart-error-indicator =
+ element chart:error-indicator { chart-error-indicator-attlist, empty }
+chart-error-indicator-attlist =
+ attribute chart:style-name { styleNameRef }?
+ & attribute chart:dimension { chart-dimension }
+chart-regression-curve =
+ element chart:regression-curve {
+ chart-regression-curve-attlist, chart-equation?
+ }
+chart-regression-curve-attlist =
+ attribute chart:style-name { styleNameRef }?
+chart-equation =
+ element chart:equation { chart-equation-attlist, text-p? }
+chart-equation-attlist =
+ attribute chart:automatic-content { boolean }?
+ & attribute chart:display-r-square { boolean }?
+ & attribute chart:display-equation { boolean }?
+ & common-draw-position-attlist
+ & attribute chart:style-name { styleNameRef }?
+chart-stock-gain-marker =
+ element chart:stock-gain-marker { common-stock-marker-attlist }
+chart-stock-loss-marker =
+ element chart:stock-loss-marker { common-stock-marker-attlist }
+chart-stock-range-line =
+ element chart:stock-range-line { common-stock-marker-attlist }
+common-stock-marker-attlist =
+ attribute chart:style-name { styleNameRef }?
+office-database =
+ element office:database {
+ db-data-source,
+ db-forms?,
+ db-reports?,
+ db-queries?,
+ db-table-presentations?,
+ db-schema-definition?
+ }
+db-data-source =
+ element db:data-source {
+ db-data-source-attlist,
+ db-connection-data,
+ db-driver-settings?,
+ db-application-connection-settings?
+ }
+db-data-source-attlist = empty
+db-connection-data =
+ element db:connection-data {
+ db-connection-data-attlist,
+ (db-database-description | db-connection-resource),
+ db-login?
+ }
+db-connection-data-attlist = empty
+db-database-description =
+ element db:database-description {
+ db-database-description-attlist,
+ (db-file-based-database | db-server-database)
+ }
+db-database-description-attlist = empty
+db-file-based-database =
+ element db:file-based-database { db-file-based-database-attlist }
+db-file-based-database-attlist =
+ attribute xlink:type { "simple" }
+ & attribute xlink:href { anyIRI }
+ & attribute db:media-type { \string }
+ & attribute db:extension { \string }?
+db-server-database =
+ element db:server-database { db-server-database-attlist, empty }
+db-server-database-attlist =
+ attribute db:type { namespacedToken }
+ & (db-host-and-port | db-local-socket-name)
+ & attribute db:database-name { \string }?
+db-host-and-port =
+ attribute db:hostname { \string },
+ attribute db:port { positiveInteger }?
+db-local-socket-name = attribute db:local-socket { \string }?
+db-connection-resource =
+ element db:connection-resource {
+ db-connection-resource-attlist, empty
+ }
+db-connection-resource-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "none" }?,
+ attribute xlink:actuate { "onRequest" }?
+db-login = element db:login { db-login-attlist, empty }
+db-login-attlist =
+ (attribute db:user-name { \string }
+ | attribute db:use-system-user { boolean })?
+ & attribute db:is-password-required { boolean }?
+ & attribute db:login-timeout { positiveInteger }?
+db-driver-settings =
+ element db:driver-settings {
+ db-driver-settings-attlist,
+ db-auto-increment?,
+ db-delimiter?,
+ db-character-set?,
+ db-table-settings?
+ }
+db-driver-settings-attlist =
+ db-show-deleted
+ & attribute db:system-driver-settings { \string }?
+ & attribute db:base-dn { \string }?
+ & db-is-first-row-header-line
+ & attribute db:parameter-name-substitution { boolean }?
+db-show-deleted = attribute db:show-deleted { boolean }?
+db-is-first-row-header-line =
+ attribute db:is-first-row-header-line { boolean }?
+db-auto-increment =
+ element db:auto-increment { db-auto-increment-attlist, empty }
+db-auto-increment-attlist =
+ attribute db:additional-column-statement { \string }?
+ & attribute db:row-retrieving-statement { \string }?
+db-delimiter = element db:delimiter { db-delimiter-attlist, empty }
+db-delimiter-attlist =
+ attribute db:field { \string }?
+ & attribute db:string { \string }?
+ & attribute db:decimal { \string }?
+ & attribute db:thousand { \string }?
+db-character-set =
+ element db:character-set { db-character-set-attlist, empty }
+db-character-set-attlist = attribute db:encoding { textEncoding }?
+db-table-settings = element db:table-settings { db-table-setting* }
+db-table-setting =
+ element db:table-setting {
+ db-table-setting-attlist, db-delimiter?, db-character-set?, empty
+ }
+db-table-setting-attlist = db-is-first-row-header-line, db-show-deleted
+db-application-connection-settings =
+ element db:application-connection-settings {
+ db-application-connection-settings-attlist,
+ db-table-filter?,
+ db-table-type-filter?,
+ db-data-source-settings?
+ }
+db-application-connection-settings-attlist =
+ attribute db:is-table-name-length-limited { boolean }?
+ & attribute db:enable-sql92-check { boolean }?
+ & attribute db:append-table-alias-name { boolean }?
+ & attribute db:ignore-driver-privileges { boolean }?
+ & attribute db:boolean-comparison-mode {
+ "equal-integer"
+ | "is-boolean"
+ | "equal-boolean"
+ | "equal-use-only-zero"
+ }?
+ & attribute db:use-catalog { boolean }?
+ & attribute db:max-row-count { integer }?
+ & attribute db:suppress-version-columns { boolean }?
+db-table-filter =
+ element db:table-filter {
+ db-table-filter-attlist,
+ db-table-include-filter?,
+ db-table-exclude-filter?
+ }
+db-table-filter-attlist = empty
+db-table-include-filter =
+ element db:table-include-filter {
+ db-table-include-filter-attlist, db-table-filter-pattern+
+ }
+db-table-include-filter-attlist = empty
+db-table-exclude-filter =
+ element db:table-exclude-filter {
+ db-table-exclude-filter-attlist, db-table-filter-pattern+
+ }
+db-table-exclude-filter-attlist = empty
+db-table-filter-pattern =
+ element db:table-filter-pattern {
+ db-table-filter-pattern-attlist, \string
+ }
+db-table-filter-pattern-attlist = empty
+db-table-type-filter =
+ element db:table-type-filter {
+ db-table-type-filter-attlist, db-table-type*
+ }
+db-table-type-filter-attlist = empty
+db-table-type = element db:table-type { db-table-type-attlist, \string }
+db-table-type-attlist = empty
+db-data-source-settings =
+ element db:data-source-settings {
+ db-data-source-settings-attlist, db-data-source-setting+
+ }
+db-data-source-settings-attlist = empty
+db-data-source-setting =
+ element db:data-source-setting {
+ db-data-source-setting-attlist, db-data-source-setting-value+
+ }
+db-data-source-setting-attlist =
+ attribute db:data-source-setting-is-list { boolean }?
+ & attribute db:data-source-setting-name { \string }
+ & attribute db:data-source-setting-type {
+ db-data-source-setting-types
+ }
+db-data-source-setting-types =
+ "boolean" | "short" | "int" | "long" | "double" | "string"
+db-data-source-setting-value =
+ element db:data-source-setting-value {
+ db-data-source-setting-value-attlist, \string
+ }
+db-data-source-setting-value-attlist = empty
+db-forms =
+ element db:forms {
+ db-forms-attlist, (db-component | db-component-collection)*
+ }
+db-forms-attlist = empty
+db-reports =
+ element db:reports {
+ db-reports-attlist, (db-component | db-component-collection)*
+ }
+db-reports-attlist = empty
+db-component-collection =
+ element db:component-collection {
+ db-component-collection-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ (db-component | db-component-collection)*
+ }
+db-component-collection-attlist = empty
+db-component =
+ element db:component {
+ db-component-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ (office-document | math-math)?
+ }
+db-component-attlist =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "none" }?,
+ attribute xlink:actuate { "onRequest" }?)?
+ & attribute db:as-template { boolean }?
+db-queries =
+ element db:queries {
+ db-queries-attlist, (db-query | db-query-collection)*
+ }
+db-queries-attlist = empty
+db-query-collection =
+ element db:query-collection {
+ db-query-collection-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ (db-query | db-query-collection)*
+ }
+db-query-collection-attlist = empty
+db-query =
+ element db:query {
+ db-query-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ common-db-table-style-name,
+ db-order-statement?,
+ db-filter-statement?,
+ db-columns?,
+ db-update-table?
+ }
+db-query-attlist =
+ attribute db:command { \string }
+ & attribute db:escape-processing { boolean }?
+db-order-statement =
+ element db:order-statement { db-command, db-apply-command, empty }
+db-filter-statement =
+ element db:filter-statement { db-command, db-apply-command, empty }
+db-update-table =
+ element db:update-table { common-db-table-name-attlist }
+db-table-presentations =
+ element db:table-representations {
+ db-table-presentations-attlist, db-table-presentation*
+ }
+db-table-presentations-attlist = empty
+db-table-presentation =
+ element db:table-representation {
+ db-table-presentation-attlist,
+ common-db-table-name-attlist,
+ common-db-object-title,
+ common-db-object-description,
+ common-db-table-style-name,
+ db-order-statement?,
+ db-filter-statement?,
+ db-columns?
+ }
+db-table-presentation-attlist = empty
+db-columns = element db:columns { db-columns-attlist, db-column+ }
+db-columns-attlist = empty
+db-column =
+ element db:column {
+ db-column-attlist,
+ common-db-object-name,
+ common-db-object-title,
+ common-db-object-description,
+ common-db-default-value
+ }
+db-column-attlist =
+ attribute db:visible { boolean }?
+ & attribute db:style-name { styleNameRef }?
+ & attribute db:default-cell-style-name { styleNameRef }?
+db-command = attribute db:command { \string }
+db-apply-command = attribute db:apply-command { boolean }?
+common-db-table-name-attlist =
+ attribute db:name { \string }
+ & attribute db:catalog-name { \string }?
+ & attribute db:schema-name { \string }?
+common-db-object-name = attribute db:name { \string }
+common-db-object-title = attribute db:title { \string }?
+common-db-object-description = attribute db:description { \string }?
+common-db-table-style-name =
+ attribute db:style-name { styleNameRef }?
+ & attribute db:default-row-style-name { styleNameRef }?
+common-db-default-value = common-value-and-type-attlist?
+db-schema-definition =
+ element db:schema-definition {
+ db-schema-definition-attlist, db-table-definitions
+ }
+db-schema-definition-attlist = empty
+db-table-definitions =
+ element db:table-definitions {
+ db-table-definitions-attlist, db-table-definition*
+ }
+db-table-definitions-attlist = empty
+db-table-definition =
+ element db:table-definition {
+ common-db-table-name-attlist,
+ db-table-definition-attlist,
+ db-column-definitions,
+ db-keys?,
+ db-indices?
+ }
+db-table-definition-attlist = attribute db:type { \string }?
+db-column-definitions =
+ element db:column-definitions {
+ db-column-definitions-attlist, db-column-definition+
+ }
+db-column-definitions-attlist = empty
+db-column-definition =
+ element db:column-definition {
+ db-column-definition-attlist, common-db-default-value
+ }
+db-column-definition-attlist =
+ attribute db:name { \string }
+ & attribute db:data-type { db-data-types }?
+ & attribute db:type-name { \string }?
+ & attribute db:precision { positiveInteger }?
+ & attribute db:scale { positiveInteger }?
+ & attribute db:is-nullable { "no-nulls" | "nullable" }?
+ & attribute db:is-empty-allowed { boolean }?
+ & attribute db:is-autoincrement { boolean }?
+db-data-types =
+ "bit"
+ | "boolean"
+ | "tinyint"
+ | "smallint"
+ | "integer"
+ | "bigint"
+ | "float"
+ | "real"
+ | "double"
+ | "numeric"
+ | "decimal"
+ | "char"
+ | "varchar"
+ | "longvarchar"
+ | "date"
+ | "time"
+ | "timestmp"
+ | "binary"
+ | "varbinary"
+ | "longvarbinary"
+ | "sqlnull"
+ | "other"
+ | "object"
+ | "distinct"
+ | "struct"
+ | "array"
+ | "blob"
+ | "clob"
+ | "ref"
+db-keys = element db:keys { db-keys-attlist, db-key+ }
+db-keys-attlist = empty
+db-key = element db:key { db-key-attlist, db-key-columns+ }
+db-key-attlist =
+ attribute db:name { \string }?
+ & attribute db:type { "primary" | "unique" | "foreign" }
+ & attribute db:referenced-table-name { \string }?
+ & attribute db:update-rule {
+ "cascade" | "restrict" | "set-null" | "no-action" | "set-default"
+ }?
+ & attribute db:delete-rule {
+ "cascade" | "restrict" | "set-null" | "no-action" | "set-default"
+ }?
+db-key-columns =
+ element db:key-columns { db-key-columns-attlist, db-key-column+ }
+db-key-columns-attlist = empty
+db-key-column = element db:key-column { db-key-column-attlist, empty }
+db-key-column-attlist =
+ attribute db:name { \string }?
+ & attribute db:related-column-name { \string }?
+db-indices = element db:indices { db-indices-attlist, db-index+ }
+db-indices-attlist = empty
+db-index = element db:index { db-index-attlist, db-index-columns+ }
+db-index-attlist =
+ attribute db:name { \string }
+ & attribute db:catalog-name { \string }?
+ & attribute db:is-unique { boolean }?
+ & attribute db:is-clustered { boolean }?
+db-index-columns = element db:index-columns { db-index-column+ }
+db-index-column =
+ element db:index-column { db-index-column-attlist, empty }
+db-index-column-attlist =
+ attribute db:name { \string }
+ & attribute db:is-ascending { boolean }?
+office-forms =
+ element office:forms {
+ office-forms-attlist, (form-form | xforms-model)*
+ }?
+office-forms-attlist =
+ attribute form:automatic-focus { boolean }?
+ & attribute form:apply-design-mode { boolean }?
+form-form =
+ element form:form {
+ common-form-control-attlist,
+ form-form-attlist,
+ form-properties?,
+ office-event-listeners?,
+ (controls | form-form)*,
+ form-connection-resource?
+ }
+form-form-attlist =
+ (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?)?
+ & attribute office:target-frame { targetFrameName }?
+ & attribute form:method { "get" | "post" | \string }?
+ & attribute form:enctype { \string }?
+ & attribute form:allow-deletes { boolean }?
+ & attribute form:allow-inserts { boolean }?
+ & attribute form:allow-updates { boolean }?
+ & attribute form:apply-filter { boolean }?
+ & attribute form:command-type { "table" | "query" | "command" }?
+ & attribute form:command { \string }?
+ & attribute form:datasource { anyIRI | \string }?
+ & attribute form:master-fields { \string }?
+ & attribute form:detail-fields { \string }?
+ & attribute form:escape-processing { boolean }?
+ & attribute form:filter { \string }?
+ & attribute form:ignore-result { boolean }?
+ & attribute form:navigation-mode { navigation }?
+ & attribute form:order { \string }?
+ & attribute form:tab-cycle { tab-cycles }?
+navigation = "none" | "current" | "parent"
+tab-cycles = "records" | "current" | "page"
+form-connection-resource =
+ element form:connection-resource {
+ attribute xlink:href { anyIRI },
+ empty
+ }
+xforms-model = element xforms:model { anyAttListOrElements }
+column-controls =
+ element form:text { form-text-attlist, common-form-control-content }
+ | element form:textarea {
+ form-textarea-attlist, common-form-control-content, text-p*
+ }
+ | element form:formatted-text {
+ form-formatted-text-attlist, common-form-control-content
+ }
+ | element form:number {
+ form-number-attlist,
+ common-numeric-control-attlist,
+ common-form-control-content,
+ common-linked-cell,
+ common-spin-button,
+ common-repeat,
+ common-delay-for-repeat
+ }
+ | element form:date {
+ form-date-attlist,
+ common-numeric-control-attlist,
+ common-form-control-content,
+ common-linked-cell,
+ common-spin-button,
+ common-repeat,
+ common-delay-for-repeat
+ }
+ | element form:time {
+ form-time-attlist,
+ common-numeric-control-attlist,
+ common-form-control-content,
+ common-linked-cell,
+ common-spin-button,
+ common-repeat,
+ common-delay-for-repeat
+ }
+ | element form:combobox {
+ form-combobox-attlist, common-form-control-content, form-item*
+ }
+ | element form:listbox {
+ form-listbox-attlist, common-form-control-content, form-option*
+ }
+ | element form:checkbox {
+ form-checkbox-attlist, common-form-control-content
+ }
+controls =
+ column-controls
+ | element form:password {
+ form-password-attlist, common-form-control-content
+ }
+ | element form:file { form-file-attlist, common-form-control-content }
+ | element form:fixed-text {
+ form-fixed-text-attlist, common-form-control-content
+ }
+ | element form:button {
+ form-button-attlist, common-form-control-content
+ }
+ | element form:image {
+ form-image-attlist, common-form-control-content
+ }
+ | element form:radio {
+ form-radio-attlist, common-form-control-content
+ }
+ | element form:frame {
+ form-frame-attlist, common-form-control-content
+ }
+ | element form:image-frame {
+ form-image-frame-attlist, common-form-control-content
+ }
+ | element form:hidden {
+ form-hidden-attlist, common-form-control-content
+ }
+ | element form:grid {
+ form-grid-attlist, common-form-control-content, form-column*
+ }
+ | element form:value-range {
+ form-value-range-attlist, common-form-control-content
+ }
+ | element form:generic-control {
+ form-generic-control-attlist, common-form-control-content
+ }
+form-text-attlist =
+ form-control-attlist,
+ common-current-value-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-convert-empty-attlist,
+ common-data-field-attlist,
+ common-linked-cell
+form-control-attlist =
+ common-form-control-attlist,
+ common-control-id-attlist,
+ xforms-bind-attlist
+common-form-control-content = form-properties?, office-event-listeners?
+form-textarea-attlist =
+ form-control-attlist,
+ common-current-value-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-convert-empty-attlist,
+ common-data-field-attlist,
+ common-linked-cell
+form-password-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & common-maxlength-attlist
+ & common-printable-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-convert-empty-attlist
+ & common-linked-cell
+ & attribute form:echo-char { character }?
+form-file-attlist =
+ form-control-attlist,
+ common-current-value-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-linked-cell
+form-formatted-text-attlist =
+ form-control-attlist
+ & common-current-value-attlist
+ & common-disabled-attlist
+ & common-maxlength-attlist
+ & common-printable-attlist
+ & common-readonly-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-convert-empty-attlist
+ & common-data-field-attlist
+ & common-linked-cell
+ & common-spin-button
+ & common-repeat
+ & common-delay-for-repeat
+ & attribute form:max-value { \string }?
+ & attribute form:min-value { \string }?
+ & attribute form:validation { boolean }?
+common-numeric-control-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ common-maxlength-attlist,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-tab-attlist,
+ common-title-attlist,
+ common-convert-empty-attlist,
+ common-data-field-attlist
+form-number-attlist =
+ attribute form:value { double }?
+ & attribute form:current-value { double }?
+ & attribute form:min-value { double }?
+ & attribute form:max-value { double }?
+form-date-attlist =
+ attribute form:value { date }?
+ & attribute form:current-value { date }?
+ & attribute form:min-value { date }?
+ & attribute form:max-value { date }?
+form-time-attlist =
+ attribute form:value { time }?
+ & attribute form:current-value { time }?
+ & attribute form:min-value { time }?
+ & attribute form:max-value { time }?
+form-fixed-text-attlist =
+ form-control-attlist
+ & for
+ & common-disabled-attlist
+ & label
+ & common-printable-attlist
+ & common-title-attlist
+ & attribute form:multi-line { boolean }?
+form-combobox-attlist =
+ form-control-attlist
+ & common-current-value-attlist
+ & common-disabled-attlist
+ & dropdown
+ & common-maxlength-attlist
+ & common-printable-attlist
+ & common-readonly-attlist
+ & size
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-convert-empty-attlist
+ & common-data-field-attlist
+ & list-source
+ & list-source-type
+ & common-linked-cell
+ & common-source-cell-range
+ & attribute form:auto-complete { boolean }?
+form-item = element form:item { form-item-attlist, text }
+form-item-attlist = label
+form-listbox-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & dropdown
+ & common-printable-attlist
+ & size
+ & common-tab-attlist
+ & common-title-attlist
+ & bound-column
+ & common-data-field-attlist
+ & list-source
+ & list-source-type
+ & common-linked-cell
+ & list-linkage-type
+ & common-source-cell-range
+ & attribute form:multiple { boolean }?
+ & attribute form:xforms-list-source { \string }?
+list-linkage-type =
+ attribute form:list-linkage-type {
+ "selection" | "selection-indices"
+ }?
+form-option = element form:option { form-option-attlist, text }
+form-option-attlist =
+ current-selected, selected, label, common-value-attlist
+form-button-attlist =
+ form-control-attlist
+ & button-type
+ & common-disabled-attlist
+ & label
+ & image-data
+ & common-printable-attlist
+ & common-tab-attlist
+ & target-frame
+ & target-location
+ & common-title-attlist
+ & common-value-attlist
+ & common-form-relative-image-position-attlist
+ & common-repeat
+ & common-delay-for-repeat
+ & attribute form:default-button { boolean }?
+ & attribute form:toggle { boolean }?
+ & attribute form:focus-on-click { boolean }?
+ & attribute form:xforms-submission { \string }?
+form-image-attlist =
+ form-control-attlist,
+ button-type,
+ common-disabled-attlist,
+ image-data,
+ common-printable-attlist,
+ common-tab-attlist,
+ target-frame,
+ target-location,
+ common-title-attlist,
+ common-value-attlist
+form-checkbox-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & label
+ & common-printable-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-data-field-attlist
+ & common-form-visual-effect-attlist
+ & common-form-relative-image-position-attlist
+ & common-linked-cell
+ & attribute form:current-state { states }?
+ & attribute form:is-tristate { boolean }?
+ & attribute form:state { states }?
+states = "unchecked" | "checked" | "unknown"
+form-radio-attlist =
+ form-control-attlist,
+ current-selected,
+ common-disabled-attlist,
+ label,
+ common-printable-attlist,
+ selected,
+ common-tab-attlist,
+ common-title-attlist,
+ common-value-attlist,
+ common-data-field-attlist,
+ common-form-visual-effect-attlist,
+ common-form-relative-image-position-attlist,
+ common-linked-cell
+form-frame-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ for,
+ label,
+ common-printable-attlist,
+ common-title-attlist
+form-image-frame-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ image-data,
+ common-printable-attlist,
+ common-readonly-attlist,
+ common-title-attlist,
+ common-data-field-attlist
+form-hidden-attlist = form-control-attlist, common-value-attlist
+form-grid-attlist =
+ form-control-attlist,
+ common-disabled-attlist,
+ common-printable-attlist,
+ common-tab-attlist,
+ common-title-attlist
+form-column =
+ element form:column { form-column-attlist, column-controls+ }
+form-column-attlist =
+ common-form-control-attlist, label, text-style-name
+text-style-name = attribute form:text-style-name { styleNameRef }?
+form-value-range-attlist =
+ form-control-attlist
+ & common-disabled-attlist
+ & common-printable-attlist
+ & common-tab-attlist
+ & common-title-attlist
+ & common-value-attlist
+ & common-linked-cell
+ & common-repeat
+ & common-delay-for-repeat
+ & attribute form:max-value { integer }?
+ & attribute form:min-value { integer }?
+ & attribute form:step-size { positiveInteger }?
+ & attribute form:page-step-size { positiveInteger }?
+ & attribute form:orientation { "horizontal" | "vertical" }?
+form-generic-control-attlist = form-control-attlist
+common-form-control-attlist =
+ attribute form:name { \string }?
+ & attribute form:control-implementation { namespacedToken }?
+xforms-bind-attlist = attribute xforms:bind { \string }?
+types = "submit" | "reset" | "push" | "url"
+button-type = attribute form:button-type { types }?
+common-control-id-attlist =
+ xml-id,
+ attribute form:id { NCName }?
+current-selected = attribute form:current-selected { boolean }?
+common-value-attlist = attribute form:value { \string }?
+common-current-value-attlist = attribute form:current-value { \string }?
+common-disabled-attlist = attribute form:disabled { boolean }?
+dropdown = attribute form:dropdown { boolean }?
+for = attribute form:for { \string }?
+image-data = attribute form:image-data { anyIRI }?
+label = attribute form:label { \string }?
+common-maxlength-attlist =
+ attribute form:max-length { nonNegativeInteger }?
+common-printable-attlist = attribute form:printable { boolean }?
+common-readonly-attlist = attribute form:readonly { boolean }?
+selected = attribute form:selected { boolean }?
+size = attribute form:size { nonNegativeInteger }?
+common-tab-attlist =
+ attribute form:tab-index { nonNegativeInteger }?
+ & attribute form:tab-stop { boolean }?
+target-frame = attribute office:target-frame { targetFrameName }?
+target-location = attribute xlink:href { anyIRI }?
+common-title-attlist = attribute form:title { \string }?
+common-form-visual-effect-attlist =
+ attribute form:visual-effect { "flat" | "3d" }?
+common-form-relative-image-position-attlist =
+ attribute form:image-position { "center" }?
+ | (attribute form:image-position {
+ "start" | "end" | "top" | "bottom"
+ },
+ attribute form:image-align { "start" | "center" | "end" }?)
+bound-column = attribute form:bound-column { \string }?
+common-convert-empty-attlist =
+ attribute form:convert-empty-to-null { boolean }?
+common-data-field-attlist = attribute form:data-field { \string }?
+list-source = attribute form:list-source { \string }?
+list-source-type =
+ attribute form:list-source-type {
+ "table"
+ | "query"
+ | "sql"
+ | "sql-pass-through"
+ | "value-list"
+ | "table-fields"
+ }?
+common-linked-cell =
+ attribute form:linked-cell { cellAddress | \string }?
+common-source-cell-range =
+ attribute form:source-cell-range { cellRangeAddress | \string }?
+common-spin-button = attribute form:spin-button { boolean }?
+common-repeat = attribute form:repeat { boolean }?
+common-delay-for-repeat = attribute form:delay-for-repeat { duration }?
+form-properties = element form:properties { form-property+ }
+form-property =
+ element form:property {
+ form-property-name, form-property-value-and-type-attlist
+ }
+ | element form:list-property {
+ form-property-name, form-property-type-and-value-list
+ }
+form-property-name = attribute form:property-name { \string }
+form-property-value-and-type-attlist =
+ common-value-and-type-attlist
+ | attribute office:value-type { "void" }
+form-property-type-and-value-list =
+ (attribute office:value-type { "float" },
+ element form:list-value {
+ attribute office:value { double }
+ }*)
+ | (attribute office:value-type { "percentage" },
+ element form:list-value {
+ attribute office:value { double }
+ }*)
+ | (attribute office:value-type { "currency" },
+ element form:list-value {
+ attribute office:value { double },
+ attribute office:currency { \string }?
+ }*)
+ | (attribute office:value-type { "date" },
+ element form:list-value {
+ attribute office:date-value { dateOrDateTime }
+ }*)
+ | (attribute office:value-type { "time" },
+ element form:list-value {
+ attribute office:time-value { duration }
+ }*)
+ | (attribute office:value-type { "boolean" },
+ element form:list-value {
+ attribute office:boolean-value { boolean }
+ }*)
+ | (attribute office:value-type { "string" },
+ element form:list-value {
+ attribute office:string-value { \string }
+ }*)
+ | attribute office:value-type { "void" }
+office-annotation =
+ element office:annotation {
+ office-annotation-attlist,
+ draw-caption-attlist,
+ common-draw-position-attlist,
+ common-draw-size-attlist,
+ common-draw-shape-with-text-and-styles-attlist,
+ dc-creator?,
+ dc-date?,
+ meta-date-string?,
+ (text-p | text-list)*
+ }
+office-annotation-end =
+ element office:annotation-end { office-annotation-end-attlist }
+office-annotation-attlist =
+ attribute office:display { boolean }?
+ & common-office-annotation-name-attlist?
+office-annotation-end-attlist = common-office-annotation-name-attlist
+common-office-annotation-name-attlist =
+ attribute office:name { \string }
+meta-date-string = element meta:date-string { \string }
+common-num-format-prefix-suffix-attlist =
+ attribute style:num-prefix { \string }?,
+ attribute style:num-suffix { \string }?
+common-num-format-attlist =
+ attribute style:num-format { "1" | "i" | "I" | \string | empty }
+ | (attribute style:num-format { "a" | "A" },
+ style-num-letter-sync-attlist)
+ | empty
+style-num-letter-sync-attlist =
+ attribute style:num-letter-sync { boolean }?
+office-change-info =
+ element office:change-info { dc-creator, dc-date, text-p* }
+office-event-listeners =
+ element office:event-listeners {
+ (script-event-listener | presentation-event-listener)*
+ }
+script-event-listener =
+ element script:event-listener { script-event-listener-attlist, empty }
+script-event-listener-attlist =
+ attribute script:event-name { \string }
+ & attribute script:language { \string }
+ & (attribute script:macro-name { \string }
+ | (attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?))
+math-math = element math:math { mathMarkup }
+[
+ dc:description [
+ "To avoid inclusion of the complete MathML schema, anything is allowed within a math:math top-level element"
+ ]
+]
+mathMarkup =
+ (attribute * { text }
+ | text
+ | element * { mathMarkup })*
+text-dde-connection-decl =
+ element text:dde-connection-decl {
+ text-dde-connection-decl-attlist, common-dde-connection-decl-attlist
+ }
+text-dde-connection-decl-attlist = attribute office:name { \string }
+common-dde-connection-decl-attlist =
+ attribute office:dde-application { \string }
+ & attribute office:dde-topic { \string }
+ & attribute office:dde-item { \string }
+ & attribute office:automatic-update { boolean }?
+table-dde-link =
+ element table:dde-link { office-dde-source, table-table }
+office-dde-source =
+ element office:dde-source {
+ office-dde-source-attlist, common-dde-connection-decl-attlist
+ }
+office-dde-source-attlist =
+ attribute office:name { \string }?
+ & attribute office:conversion-mode {
+ "into-default-style-data-style"
+ | "into-english-number"
+ | "keep-text"
+ }?
+animation-element =
+ element anim:animate {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-values-attlist,
+ common-anim-spline-mode-attlist,
+ common-spline-anim-value-attlist,
+ common-timing-attlist,
+ common-anim-add-accum-attlist
+ }
+ | element anim:set {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-set-values-attlist,
+ common-timing-attlist,
+ common-anim-add-accum-attlist
+ }
+ | element anim:animateMotion {
+ anim-animate-motion-attlist,
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ common-timing-attlist,
+ common-spline-anim-value-attlist
+ }
+ | element anim:animateColor {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ common-anim-spline-mode-attlist,
+ common-spline-anim-value-attlist,
+ anim-animate-color-attlist,
+ common-timing-attlist
+ }
+ | element anim:animateTransform {
+ common-anim-target-attlist,
+ common-anim-named-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ anim-animate-transform-attlist,
+ common-timing-attlist
+ }
+ | element anim:transitionFilter {
+ common-anim-target-attlist,
+ common-anim-add-accum-attlist,
+ common-anim-values-attlist,
+ common-anim-spline-mode-attlist,
+ anim-transition-filter-attlist,
+ common-timing-attlist
+ }
+ | element anim:par {
+ common-anim-attlist,
+ common-timing-attlist,
+ common-endsync-timing-attlist,
+ animation-element*
+ }
+ | element anim:seq {
+ common-anim-attlist,
+ common-endsync-timing-attlist,
+ common-timing-attlist,
+ animation-element*
+ }
+ | element anim:iterate {
+ common-anim-attlist,
+ anim-iterate-attlist,
+ common-timing-attlist,
+ common-endsync-timing-attlist,
+ animation-element*
+ }
+ | element anim:audio {
+ common-anim-attlist,
+ anim-audio-attlist,
+ common-basic-timing-attlist
+ }
+ | element anim:command {
+ common-anim-attlist,
+ anim-command-attlist,
+ common-begin-end-timing-attlist,
+ common-anim-target-attlist,
+ element anim:param {
+ attribute anim:name { \string },
+ attribute anim:value { \string }
+ }*
+ }
+anim-animate-motion-attlist =
+ attribute svg:path { pathData }?
+ & attribute svg:origin { \string }?
+ & attribute smil:calcMode {
+ "discrete" | "linear" | "paced" | "spline"
+ }?
+anim-animate-color-attlist =
+ attribute anim:color-interpolation { "rgb" | "hsl" }?
+ & attribute anim:color-interpolation-direction {
+ "clockwise" | "counter-clockwise"
+ }?
+anim-animate-transform-attlist =
+ attribute svg:type {
+ "translate" | "scale" | "rotate" | "skewX" | "skewY"
+ }
+anim-transition-filter-attlist =
+ attribute smil:type { \string }
+ & attribute smil:subtype { \string }?
+ & attribute smil:direction { "forward" | "reverse" }?
+ & attribute smil:fadeColor { color }?
+ & attribute smil:mode { "in" | "out" }?
+common-anim-target-attlist =
+ attribute smil:targetElement { IDREF }?
+ & attribute anim:sub-item { \string }?
+common-anim-named-target-attlist =
+ attribute smil:attributeName { \string }
+common-anim-values-attlist =
+ attribute smil:values { \string }?
+ & attribute anim:formula { \string }?
+ & common-anim-set-values-attlist
+ & attribute smil:from { \string }?
+ & attribute smil:by { \string }?
+common-anim-spline-mode-attlist =
+ attribute smil:calcMode {
+ "discrete" | "linear" | "paced" | "spline"
+ }?
+common-spline-anim-value-attlist =
+ attribute smil:keyTimes { \string }?
+ & attribute smil:keySplines { \string }?
+common-anim-add-accum-attlist =
+ attribute smil:accumulate { "none" | "sum" }?
+ & attribute smil:additive { "replace" | "sum" }?
+common-anim-set-values-attlist = attribute smil:to { \string }?
+common-begin-end-timing-attlist =
+ attribute smil:begin { \string }?
+ & attribute smil:end { \string }?
+common-dur-timing-attlist = attribute smil:dur { \string }?
+common-endsync-timing-attlist =
+ attribute smil:endsync { "first" | "last" | "all" | "media" | IDREF }?
+common-repeat-timing-attlist =
+ attribute smil:repeatDur { \string }?,
+ attribute smil:repeatCount { nonNegativeDecimal | "indefinite" }?
+nonNegativeDecimal = xsd:decimal { minInclusive = "0.0" }
+common-fill-timing-attlist =
+ attribute smil:fill {
+ "remove" | "freeze" | "hold" | "auto" | "default" | "transition"
+ }?
+common-fill-default-attlist =
+ attribute smil:fillDefault {
+ "remove" | "freeze" | "hold" | "transition" | "auto" | "inherit"
+ }?
+common-restart-timing-attlist =
+ attribute smil:restart {
+ "never" | "always" | "whenNotActive" | "default"
+ }?
+common-restart-default-attlist =
+ attribute smil:restartDefault {
+ "never" | "always" | "whenNotActive" | "inherit"
+ }?
+common-time-manip-attlist =
+ attribute smil:accelerate { zeroToOneDecimal }?
+ & attribute smil:decelerate { zeroToOneDecimal }?
+ & attribute smil:autoReverse { boolean }?
+zeroToOneDecimal = xsd:decimal { minInclusive = "0" maxInclusive = "1" }
+common-basic-timing-attlist =
+ common-begin-end-timing-attlist,
+ common-dur-timing-attlist,
+ common-repeat-timing-attlist,
+ common-restart-timing-attlist,
+ common-restart-default-attlist,
+ common-fill-timing-attlist,
+ common-fill-default-attlist
+common-timing-attlist =
+ common-basic-timing-attlist, common-time-manip-attlist
+anim-iterate-attlist =
+ common-anim-target-attlist
+ & attribute anim:iterate-type { \string }?
+ & attribute anim:iterate-interval { duration }?
+anim-audio-attlist =
+ attribute xlink:href { anyIRI }?
+ & attribute anim:audio-level { double }?
+anim-command-attlist = attribute anim:command { \string }
+style-style =
+ element style:style {
+ style-style-attlist, style-style-content, style-map*
+ }
+common-in-content-meta-attlist =
+ attribute xhtml:about { URIorSafeCURIE },
+ attribute xhtml:property { CURIEs },
+ common-meta-literal-attlist
+common-meta-literal-attlist =
+ attribute xhtml:datatype { CURIE }?,
+ attribute xhtml:content { \string }?
+xml-id = attribute xml:id { ID }
+style-style-attlist =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute style:parent-style-name { styleNameRef }?
+ & attribute style:next-style-name { styleNameRef }?
+ & attribute style:list-level { positiveInteger | empty }?
+ & attribute style:list-style-name { styleName | empty }?
+ & attribute style:master-page-name { styleNameRef }?
+ & attribute style:auto-update { boolean }?
+ & attribute style:data-style-name { styleNameRef }?
+ & attribute style:percentage-data-style-name { styleNameRef }?
+ & attribute style:class { \string }?
+ & attribute style:default-outline-level { positiveInteger | empty }?
+style-map = element style:map { style-map-attlist, empty }
+style-map-attlist =
+ attribute style:condition { \string }
+ & attribute style:apply-style-name { styleNameRef }
+ & attribute style:base-cell-address { cellAddress }?
+style-default-style =
+ element style:default-style { style-style-content }
+style-page-layout =
+ element style:page-layout {
+ style-page-layout-attlist, style-page-layout-content
+ }
+style-page-layout-content =
+ style-page-layout-properties?,
+ style-header-style?,
+ style-footer-style?
+style-page-layout-attlist =
+ attribute style:name { styleName }
+ & attribute style:page-usage {
+ "all" | "left" | "right" | "mirrored"
+ }?
+style-header-style =
+ element style:header-style { style-header-footer-properties? }
+style-footer-style =
+ element style:footer-style { style-header-footer-properties? }
+style-default-page-layout =
+ element style:default-page-layout { style-page-layout-content }
+style-master-page =
+ element style:master-page {
+ style-master-page-attlist,
+ (style-header, style-header-left?)?,
+ (style-footer, style-footer-left?)?,
+ draw-layer-set?,
+ office-forms?,
+ shape*,
+ animation-element?,
+ presentation-notes?
+ }
+style-master-page-attlist =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute style:page-layout-name { styleNameRef }
+ & attribute draw:style-name { styleNameRef }?
+ & attribute style:next-style-name { styleNameRef }?
+style-header =
+ element style:header {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-footer =
+ element style:footer {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-header-left =
+ element style:header-left {
+ common-style-header-footer-attlist, header-footer-content
+ }
+style-footer-left =
+ element style:footer-left {
+ common-style-header-footer-attlist, header-footer-content
+ }
+header-footer-content =
+ (text-tracked-changes,
+ text-decls,
+ (text-h
+ | text-p
+ | text-list
+ | table-table
+ | text-section
+ | text-table-of-content
+ | text-illustration-index
+ | text-table-index
+ | text-object-index
+ | text-user-index
+ | text-alphabetical-index
+ | text-bibliography
+ | text-index-title
+ | change-marks)*)
+ | (style-region-left?, style-region-center?, style-region-right?)
+common-style-header-footer-attlist =
+ attribute style:display { boolean }?
+style-region-left = element style:region-left { region-content }
+style-region-center = element style:region-center { region-content }
+style-region-right = element style:region-right { region-content }
+region-content = text-p*
+presentation-notes =
+ element presentation:notes {
+ common-presentation-header-footer-attlist,
+ presentation-notes-attlist,
+ office-forms,
+ shape*
+ }
+presentation-notes-attlist =
+ attribute style:page-layout-name { styleNameRef }?
+ & attribute draw:style-name { styleNameRef }?
+table-table-template =
+ element table:table-template {
+ table-table-template-attlist,
+ table-first-row?,
+ table-last-row?,
+ table-first-column?,
+ table-last-column?,
+ table-body,
+ table-even-rows?,
+ table-odd-rows?,
+ table-even-columns?,
+ table-odd-columns?,
+ table-background?
+ }
+table-table-template-attlist =
+ attribute table:name { \string }
+ & attribute table:first-row-start-column { rowOrCol }
+ & attribute table:first-row-end-column { rowOrCol }
+ & attribute table:last-row-start-column { rowOrCol }
+ & attribute table:last-row-end-column { rowOrCol }
+rowOrCol = "row" | "column"
+table-first-row =
+ element table:first-row { common-table-template-attlist, empty }
+table-last-row =
+ element table:last-row { common-table-template-attlist, empty }
+table-first-column =
+ element table:first-column { common-table-template-attlist, empty }
+table-last-column =
+ element table:last-column { common-table-template-attlist, empty }
+table-body = element table:body { common-table-template-attlist, empty }
+table-even-rows =
+ element table:even-rows { common-table-template-attlist, empty }
+table-odd-rows =
+ element table:odd-rows { common-table-template-attlist, empty }
+table-even-columns =
+ element table:even-columns { common-table-template-attlist, empty }
+table-odd-columns =
+ element table:odd-columns { common-table-template-attlist, empty }
+common-table-template-attlist =
+ attribute table:style-name { styleNameRef },
+ attribute table:paragraph-style-name { styleNameRef }?
+table-background =
+ element table:background { table-background-attlist, empty }
+table-background-attlist = attribute table:style-name { styleNameRef }
+style-font-face =
+ element style:font-face {
+ style-font-face-attlist, svg-font-face-src?, svg-definition-src?
+ }
+style-font-face-attlist =
+ attribute svg:font-family { \string }?
+ & attribute svg:font-style { fontStyle }?
+ & attribute svg:font-variant { fontVariant }?
+ & attribute svg:font-weight { fontWeight }?
+ & attribute svg:font-stretch {
+ "normal"
+ | "ultra-condensed"
+ | "extra-condensed"
+ | "condensed"
+ | "semi-condensed"
+ | "semi-expanded"
+ | "expanded"
+ | "extra-expanded"
+ | "ultra-expanded"
+ }?
+ & attribute svg:font-size { positiveLength }?
+ & attribute svg:unicode-range { \string }?
+ & attribute svg:units-per-em { integer }?
+ & attribute svg:panose-1 { \string }?
+ & attribute svg:stemv { integer }?
+ & attribute svg:stemh { integer }?
+ & attribute svg:slope { integer }?
+ & attribute svg:cap-height { integer }?
+ & attribute svg:x-height { integer }?
+ & attribute svg:accent-height { integer }?
+ & attribute svg:ascent { integer }?
+ & attribute svg:descent { integer }?
+ & attribute svg:widths { \string }?
+ & attribute svg:bbox { \string }?
+ & attribute svg:ideographic { integer }?
+ & attribute svg:alphabetic { integer }?
+ & attribute svg:mathematical { integer }?
+ & attribute svg:hanging { integer }?
+ & attribute svg:v-ideographic { integer }?
+ & attribute svg:v-alphabetic { integer }?
+ & attribute svg:v-mathematical { integer }?
+ & attribute svg:v-hanging { integer }?
+ & attribute svg:underline-position { integer }?
+ & attribute svg:underline-thickness { integer }?
+ & attribute svg:strikethrough-position { integer }?
+ & attribute svg:strikethrough-thickness { integer }?
+ & attribute svg:overline-position { integer }?
+ & attribute svg:overline-thickness { integer }?
+ & attribute style:name { \string }
+ & attribute style:font-adornments { \string }?
+ & attribute style:font-family-generic { fontFamilyGeneric }?
+ & attribute style:font-pitch { fontPitch }?
+ & attribute style:font-charset { textEncoding }?
+svg-font-face-src =
+ element svg:font-face-src {
+ (svg-font-face-uri | svg-font-face-name)+
+ }
+svg-font-face-uri =
+ element svg:font-face-uri {
+ common-svg-font-face-xlink-attlist, svg-font-face-format*
+ }
+svg-font-face-format =
+ element svg:font-face-format {
+ attribute svg:string { \string }?,
+ empty
+ }
+svg-font-face-name =
+ element svg:font-face-name {
+ attribute svg:name { \string }?,
+ empty
+ }
+svg-definition-src =
+ element svg:definition-src {
+ common-svg-font-face-xlink-attlist, empty
+ }
+common-svg-font-face-xlink-attlist =
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:actuate { "onRequest" }?
+number-number-style =
+ element number:number-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (any-number, number-text?)?,
+ style-map*
+ }
+any-number = number-number | number-scientific-number | number-fraction
+number-number =
+ element number:number {
+ number-number-attlist,
+ common-decimal-places-attlist,
+ common-number-attlist,
+ number-embedded-text*
+ }
+number-number-attlist =
+ attribute number:decimal-replacement { \string }?
+ & attribute number:display-factor { double }?
+number-embedded-text =
+ element number:embedded-text { number-embedded-text-attlist, text }
+number-embedded-text-attlist = attribute number:position { integer }
+number-scientific-number =
+ element number:scientific-number {
+ number-scientific-number-attlist,
+ common-decimal-places-attlist,
+ common-number-attlist,
+ empty
+ }
+number-scientific-number-attlist =
+ attribute number:min-exponent-digits { integer }?
+number-fraction =
+ element number:fraction {
+ number-fraction-attlist, common-number-attlist, empty
+ }
+number-fraction-attlist =
+ attribute number:min-numerator-digits { integer }?
+ & attribute number:min-denominator-digits { integer }?
+ & attribute number:denominator-value { integer }?
+number-currency-style =
+ element number:currency-style {
+ common-data-style-attlist,
+ common-auto-reorder-attlist,
+ style-text-properties?,
+ number-text?,
+ ((number-and-text, currency-symbol-and-text?)
+ | (currency-symbol-and-text, number-and-text?))?,
+ style-map*
+ }
+currency-symbol-and-text = number-currency-symbol, number-text?
+number-and-text = number-number, number-text?
+number-currency-symbol =
+ element number:currency-symbol {
+ number-currency-symbol-attlist, text
+ }
+number-currency-symbol-attlist =
+ attribute number:language { languageCode }?,
+ attribute number:country { countryCode }?,
+ attribute number:script { scriptCode }?,
+ attribute number:rfc-language-tag { language }?
+number-percentage-style =
+ element number:percentage-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ number-and-text?,
+ style-map*
+ }
+number-date-style =
+ element number:date-style {
+ common-data-style-attlist,
+ common-auto-reorder-attlist,
+ common-format-source-attlist,
+ style-text-properties?,
+ number-text?,
+ (any-date, number-text?)+,
+ style-map*
+ }
+any-date =
+ number-day
+ | number-month
+ | number-year
+ | number-era
+ | number-day-of-week
+ | number-week-of-year
+ | number-quarter
+ | number-hours
+ | number-am-pm
+ | number-minutes
+ | number-seconds
+number-day =
+ element number:day {
+ number-day-attlist, common-calendar-attlist, empty
+ }
+number-day-attlist = attribute number:style { "short" | "long" }?
+number-month =
+ element number:month {
+ number-month-attlist, common-calendar-attlist, empty
+ }
+number-month-attlist =
+ attribute number:textual { boolean }?
+ & attribute number:possessive-form { boolean }?
+ & attribute number:style { "short" | "long" }?
+number-year =
+ element number:year {
+ number-year-attlist, common-calendar-attlist, empty
+ }
+number-year-attlist = attribute number:style { "short" | "long" }?
+number-era =
+ element number:era {
+ number-era-attlist, common-calendar-attlist, empty
+ }
+number-era-attlist = attribute number:style { "short" | "long" }?
+number-day-of-week =
+ element number:day-of-week {
+ number-day-of-week-attlist, common-calendar-attlist, empty
+ }
+number-day-of-week-attlist =
+ attribute number:style { "short" | "long" }?
+number-week-of-year =
+ element number:week-of-year { common-calendar-attlist, empty }
+number-quarter =
+ element number:quarter {
+ number-quarter-attlist, common-calendar-attlist, empty
+ }
+number-quarter-attlist = attribute number:style { "short" | "long" }?
+number-time-style =
+ element number:time-style {
+ number-time-style-attlist,
+ common-data-style-attlist,
+ common-format-source-attlist,
+ style-text-properties?,
+ number-text?,
+ (any-time, number-text?)+,
+ style-map*
+ }
+any-time = number-hours | number-am-pm | number-minutes | number-seconds
+number-time-style-attlist =
+ attribute number:truncate-on-overflow { boolean }?
+number-hours = element number:hours { number-hours-attlist, empty }
+number-hours-attlist = attribute number:style { "short" | "long" }?
+number-minutes =
+ element number:minutes { number-minutes-attlist, empty }
+number-minutes-attlist = attribute number:style { "short" | "long" }?
+number-seconds =
+ element number:seconds { number-seconds-attlist, empty }
+number-seconds-attlist =
+ attribute number:style { "short" | "long" }?
+ & attribute number:decimal-places { integer }?
+number-am-pm = element number:am-pm { empty }
+number-boolean-style =
+ element number:boolean-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (number-boolean, number-text?)?,
+ style-map*
+ }
+number-boolean = element number:boolean { empty }
+number-text-style =
+ element number:text-style {
+ common-data-style-attlist,
+ style-text-properties?,
+ number-text?,
+ (number-text-content, number-text?)*,
+ style-map*
+ }
+number-text = element number:text { text }
+number-text-content = element number:text-content { empty }
+common-data-style-attlist =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute number:language { languageCode }?
+ & attribute number:country { countryCode }?
+ & attribute number:script { scriptCode }?
+ & attribute number:rfc-language-tag { language }?
+ & attribute number:title { \string }?
+ & attribute style:volatile { boolean }?
+ & attribute number:transliteration-format { \string }?
+ & attribute number:transliteration-language { countryCode }?
+ & attribute number:transliteration-country { countryCode }?
+ & attribute number:transliteration-style {
+ "short" | "medium" | "long"
+ }?
+common-auto-reorder-attlist =
+ attribute number:automatic-order { boolean }?
+common-format-source-attlist =
+ attribute number:format-source { "fixed" | "language" }?
+common-decimal-places-attlist =
+ attribute number:decimal-places { integer }?
+common-number-attlist =
+ attribute number:min-integer-digits { integer }?
+ & attribute number:grouping { boolean }?
+common-calendar-attlist =
+ attribute number:calendar {
+ "gregorian"
+ | "gengou"
+ | "ROC"
+ | "hanja_yoil"
+ | "hanja"
+ | "hijri"
+ | "jewish"
+ | "buddhist"
+ | \string
+ }?
+style-style-content =
+ (attribute style:family { "text" },
+ style-text-properties?)
+ | (attribute style:family { "paragraph" },
+ style-paragraph-properties?,
+ style-text-properties?)
+ | (attribute style:family { "section" },
+ style-section-properties?)
+ | (attribute style:family { "ruby" },
+ style-ruby-properties?)
+ | (attribute style:family { "table" },
+ style-table-properties?)
+ | (attribute style:family { "table-column" },
+ style-table-column-properties?)
+ | (attribute style:family { "table-row" },
+ style-table-row-properties?)
+ | (attribute style:family { "table-cell" },
+ style-table-cell-properties?,
+ style-paragraph-properties?,
+ style-text-properties?)
+ | (attribute style:family { "graphic" | "presentation" },
+ style-graphic-properties?,
+ style-paragraph-properties?,
+ style-text-properties?)
+ | (attribute style:family { "drawing-page" },
+ style-drawing-page-properties?)
+ | (attribute style:family { "chart" },
+ style-chart-properties?,
+ style-graphic-properties?,
+ style-paragraph-properties?,
+ style-text-properties?)
+text-linenumbering-configuration =
+ element text:linenumbering-configuration {
+ text-linenumbering-configuration-attlist,
+ text-linenumbering-separator?
+ }
+text-linenumbering-configuration-attlist =
+ attribute text:number-lines { boolean }?
+ & common-num-format-attlist?
+ & attribute text:style-name { styleNameRef }?
+ & attribute text:increment { nonNegativeInteger }?
+ & attribute text:number-position {
+ "left" | "right" | "inner" | "outer"
+ }?
+ & attribute text:offset { nonNegativeLength }?
+ & attribute text:count-empty-lines { boolean }?
+ & attribute text:count-in-text-boxes { boolean }?
+ & attribute text:restart-on-page { boolean }?
+text-linenumbering-separator =
+ element text:linenumbering-separator {
+ attribute text:increment { nonNegativeInteger }?,
+ text
+ }
+text-notes-configuration =
+ element text:notes-configuration { text-notes-configuration-content }
+text-notes-configuration-content =
+ text-note-class
+ & attribute text:citation-style-name { styleNameRef }?
+ & attribute text:citation-body-style-name { styleNameRef }?
+ & attribute text:default-style-name { styleNameRef }?
+ & attribute text:master-page-name { styleNameRef }?
+ & attribute text:start-value { nonNegativeInteger }?
+ & common-num-format-prefix-suffix-attlist
+ & common-num-format-attlist?
+ & attribute text:start-numbering-at {
+ "document" | "chapter" | "page"
+ }?
+ & attribute text:footnotes-position {
+ "text" | "page" | "section" | "document"
+ }?
+ & element text:note-continuation-notice-forward { text }?
+ & element text:note-continuation-notice-backward { text }?
+text-bibliography-configuration =
+ element text:bibliography-configuration {
+ text-bibliography-configuration-attlist, text-sort-key*
+ }
+text-bibliography-configuration-attlist =
+ attribute text:prefix { \string }?
+ & attribute text:suffix { \string }?
+ & attribute text:numbered-entries { boolean }?
+ & attribute text:sort-by-position { boolean }?
+ & attribute fo:language { languageCode }?
+ & attribute fo:country { countryCode }?
+ & attribute fo:script { scriptCode }?
+ & attribute style:rfc-language-tag { language }?
+ & attribute text:sort-algorithm { \string }?
+text-sort-key = element text:sort-key { text-sort-key-attlist, empty }
+text-sort-key-attlist =
+ attribute text:key {
+ "address"
+ | "annote"
+ | "author"
+ | "bibliography-type"
+ | "booktitle"
+ | "chapter"
+ | "custom1"
+ | "custom2"
+ | "custom3"
+ | "custom4"
+ | "custom5"
+ | "edition"
+ | "editor"
+ | "howpublished"
+ | "identifier"
+ | "institution"
+ | "isbn"
+ | "issn"
+ | "journal"
+ | "month"
+ | "note"
+ | "number"
+ | "organizations"
+ | "pages"
+ | "publisher"
+ | "report-type"
+ | "school"
+ | "series"
+ | "title"
+ | "url"
+ | "volume"
+ | "year"
+ },
+ attribute text:sort-ascending { boolean }?
+text-list-style =
+ element text:list-style {
+ text-list-style-attr, text-list-style-content*
+ }
+text-list-style-attr =
+ attribute style:name { styleName }
+ & attribute style:display-name { \string }?
+ & attribute text:consecutive-numbering { boolean }?
+text-list-style-content =
+ element text:list-level-style-number {
+ text-list-level-style-attr,
+ text-list-level-style-number-attr,
+ style-list-level-properties?,
+ style-text-properties?
+ }
+ | element text:list-level-style-bullet {
+ text-list-level-style-attr,
+ text-list-level-style-bullet-attr,
+ style-list-level-properties?,
+ style-text-properties?
+ }
+ | element text:list-level-style-image {
+ text-list-level-style-attr,
+ text-list-level-style-image-attr,
+ style-list-level-properties?
+ }
+text-list-level-style-number-attr =
+ attribute text:style-name { styleNameRef }?
+ & common-num-format-attlist
+ & common-num-format-prefix-suffix-attlist
+ & attribute text:display-levels { positiveInteger }?
+ & attribute text:start-value { positiveInteger }?
+text-list-level-style-bullet-attr =
+ attribute text:style-name { styleNameRef }?
+ & attribute text:bullet-char { character }
+ & common-num-format-prefix-suffix-attlist
+ & attribute text:bullet-relative-size { percent }?
+text-list-level-style-image-attr =
+ common-draw-data-attlist | office-binary-data
+text-list-level-style-attr = attribute text:level { positiveInteger }
+text-outline-style =
+ element text:outline-style {
+ text-outline-style-attr, text-outline-level-style+
+ }
+text-outline-style-attr = attribute style:name { styleName }
+text-outline-level-style =
+ element text:outline-level-style {
+ text-outline-level-style-attlist,
+ style-list-level-properties?,
+ style-text-properties?
+ }
+text-outline-level-style-attlist =
+ attribute text:level { positiveInteger }
+ & attribute text:style-name { styleNameRef }?
+ & common-num-format-attlist
+ & common-num-format-prefix-suffix-attlist
+ & attribute text:display-levels { positiveInteger }?
+ & attribute text:start-value { positiveInteger }?
+style-graphic-properties =
+ element style:graphic-properties {
+ style-graphic-properties-content-strict
+ }
+style-graphic-properties-content-strict =
+ style-graphic-properties-attlist,
+ style-graphic-fill-properties-attlist,
+ style-graphic-properties-elements
+style-drawing-page-properties =
+ element style:drawing-page-properties {
+ style-drawing-page-properties-content-strict
+ }
+style-drawing-page-properties-content-strict =
+ style-graphic-fill-properties-attlist,
+ style-drawing-page-properties-attlist,
+ style-drawing-page-properties-elements
+draw-gradient =
+ element draw:gradient {
+ common-draw-gradient-attlist, draw-gradient-attlist, empty
+ }
+common-draw-gradient-attlist =
+ attribute draw:name { styleName }?
+ & attribute draw:display-name { \string }?
+ & attribute draw:style { gradient-style }
+ & attribute draw:cx { percent }?
+ & attribute draw:cy { percent }?
+ & attribute draw:angle { angle }?
+ & attribute draw:border { percent }?
+gradient-style =
+ "linear" | "axial" | "radial" | "ellipsoid" | "square" | "rectangular"
+draw-gradient-attlist =
+ attribute draw:start-color { color }?
+ & attribute draw:end-color { color }?
+ & attribute draw:start-intensity { zeroToHundredPercent }?
+ & attribute draw:end-intensity { zeroToHundredPercent }?
+svg-linearGradient =
+ element svg:linearGradient {
+ common-svg-gradient-attlist,
+ attribute svg:x1 { coordinate | percent }?,
+ attribute svg:y1 { coordinate | percent }?,
+ attribute svg:x2 { coordinate | percent }?,
+ attribute svg:y2 { coordinate | percent }?,
+ svg-stop*
+ }
+svg-radialGradient =
+ element svg:radialGradient {
+ common-svg-gradient-attlist,
+ attribute svg:cx { coordinate | percent }?,
+ attribute svg:cy { coordinate | percent }?,
+ attribute svg:r { coordinate | percent }?,
+ attribute svg:fx { coordinate | percent }?,
+ attribute svg:fy { coordinate | percent }?,
+ svg-stop*
+ }
+svg-stop =
+ element svg:stop {
+ attribute svg:offset { double | percent },
+ attribute svg:stop-color { color }?,
+ attribute svg:stop-opacity { double }?
+ }
+common-svg-gradient-attlist =
+ attribute svg:gradientUnits { "objectBoundingBox" }?
+ & attribute svg:gradientTransform { \string }?
+ & attribute svg:spreadMethod { "pad" | "reflect" | "repeat" }?
+ & attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+draw-hatch = element draw:hatch { draw-hatch-attlist, empty }
+draw-hatch-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute draw:style { "single" | "double" | "triple" }
+ & attribute draw:color { color }?
+ & attribute draw:distance { length }?
+ & attribute draw:rotation { angle }?
+draw-fill-image =
+ element draw:fill-image {
+ draw-fill-image-attlist,
+ attribute xlink:type { "simple" },
+ attribute xlink:href { anyIRI },
+ attribute xlink:show { "embed" }?,
+ attribute xlink:actuate { "onLoad" }?,
+ empty
+ }
+draw-fill-image-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute svg:width { length }?
+ & attribute svg:height { length }?
+draw-opacity =
+ element draw:opacity {
+ common-draw-gradient-attlist, draw-opacity-attlist, empty
+ }
+draw-opacity-attlist =
+ attribute draw:start { zeroToHundredPercent }?,
+ attribute draw:end { zeroToHundredPercent }?
+draw-marker =
+ element draw:marker {
+ draw-marker-attlist,
+ common-draw-viewbox-attlist,
+ common-draw-path-data-attlist,
+ empty
+ }
+draw-marker-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+draw-stroke-dash =
+ element draw:stroke-dash { draw-stroke-dash-attlist, empty }
+draw-stroke-dash-attlist =
+ attribute draw:name { styleName }
+ & attribute draw:display-name { \string }?
+ & attribute draw:style { "rect" | "round" }?
+ & attribute draw:dots1 { integer }?
+ & attribute draw:dots1-length { length | percent }?
+ & attribute draw:dots2 { integer }?
+ & attribute draw:dots2-length { length | percent }?
+ & attribute draw:distance { length | percent }?
+style-presentation-page-layout =
+ element style:presentation-page-layout {
+ attribute style:name { styleName },
+ attribute style:display-name { \string }?,
+ presentation-placeholder*
+ }
+presentation-placeholder =
+ element presentation:placeholder {
+ attribute presentation:object { presentation-classes },
+ attribute svg:x { coordinate | percent },
+ attribute svg:y { coordinate | percent },
+ attribute svg:width { length | percent },
+ attribute svg:height { length | percent },
+ empty
+ }
+style-page-layout-properties =
+ element style:page-layout-properties {
+ style-page-layout-properties-content-strict
+ }
+style-page-layout-properties-content-strict =
+ style-page-layout-properties-attlist,
+ style-page-layout-properties-elements
+style-page-layout-properties-attlist =
+ attribute fo:page-width { length }?
+ & attribute fo:page-height { length }?
+ & common-num-format-attlist?
+ & common-num-format-prefix-suffix-attlist
+ & attribute style:paper-tray-name { "default" | \string }?
+ & attribute style:print-orientation { "portrait" | "landscape" }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & common-shadow-attlist
+ & common-background-color-attlist
+ & attribute style:register-truth-ref-style-name { styleNameRef }?
+ & attribute style:print {
+ list {
+ ("headers"
+ | "grid"
+ | "annotations"
+ | "objects"
+ | "charts"
+ | "drawings"
+ | "formulas"
+ | "zero-values")*
+ }
+ }?
+ & attribute style:print-page-order { "ttb" | "ltr" }?
+ & attribute style:first-page-number { positiveInteger | "continue" }?
+ & attribute style:scale-to { percent }?
+ & attribute style:scale-to-pages { positiveInteger }?
+ & attribute style:table-centering {
+ "horizontal" | "vertical" | "both" | "none"
+ }?
+ & attribute style:footnote-max-height { length }?
+ & common-writing-mode-attlist
+ & attribute style:layout-grid-mode { "none" | "line" | "both" }?
+ & attribute style:layout-grid-standard-mode { boolean }?
+ & attribute style:layout-grid-base-height { length }?
+ & attribute style:layout-grid-ruby-height { length }?
+ & attribute style:layout-grid-lines { positiveInteger }?
+ & attribute style:layout-grid-base-width { length }?
+ & attribute style:layout-grid-color { color }?
+ & attribute style:layout-grid-ruby-below { boolean }?
+ & attribute style:layout-grid-print { boolean }?
+ & attribute style:layout-grid-display { boolean }?
+ & attribute style:layout-grid-snap-to { boolean }?
+style-page-layout-properties-elements =
+ style-background-image & style-columns & style-footnote-sep
+style-footnote-sep =
+ element style:footnote-sep { style-footnote-sep-attlist, empty }?
+style-footnote-sep-attlist =
+ attribute style:width { length }?,
+ attribute style:rel-width { percent }?,
+ attribute style:color { color }?,
+ attribute style:line-style { lineStyle }?,
+ attribute style:adjustment { "left" | "center" | "right" }?,
+ attribute style:distance-before-sep { length }?,
+ attribute style:distance-after-sep { length }?
+style-header-footer-properties =
+ element style:header-footer-properties {
+ style-header-footer-properties-content-strict
+ }
+style-header-footer-properties-content-strict =
+ style-header-footer-properties-attlist,
+ style-header-footer-properties-elements
+style-header-footer-properties-attlist =
+ attribute svg:height { length }?
+ & attribute fo:min-height { length }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & common-background-color-attlist
+ & common-shadow-attlist
+ & attribute style:dynamic-spacing { boolean }?
+style-header-footer-properties-elements = style-background-image
+style-text-properties =
+ element style:text-properties { style-text-properties-content-strict }
+style-text-properties-content-strict =
+ style-text-properties-attlist, style-text-properties-elements
+style-text-properties-elements = empty
+style-text-properties-attlist =
+ attribute fo:font-variant { fontVariant }?
+ & attribute fo:text-transform {
+ "none" | "lowercase" | "uppercase" | "capitalize"
+ }?
+ & attribute fo:color { color }?
+ & attribute style:use-window-font-color { boolean }?
+ & attribute style:text-outline { boolean }?
+ & attribute style:text-line-through-type { lineType }?
+ & attribute style:text-line-through-style { lineStyle }?
+ & attribute style:text-line-through-width { lineWidth }?
+ & attribute style:text-line-through-color { "font-color" | color }?
+ & attribute style:text-line-through-text { \string }?
+ & attribute style:text-line-through-text-style { styleNameRef }?
+ & attribute style:text-position {
+ list { (percent | "super" | "sub"), percent? }
+ }?
+ & attribute style:font-name { \string }?
+ & attribute style:font-name-asian { \string }?
+ & attribute style:font-name-complex { \string }?
+ & attribute fo:font-family { \string }?
+ & attribute style:font-family-asian { \string }?
+ & attribute style:font-family-complex { \string }?
+ & attribute style:font-family-generic { fontFamilyGeneric }?
+ & attribute style:font-family-generic-asian { fontFamilyGeneric }?
+ & attribute style:font-family-generic-complex { fontFamilyGeneric }?
+ & attribute style:font-style-name { \string }?
+ & attribute style:font-style-name-asian { \string }?
+ & attribute style:font-style-name-complex { \string }?
+ & attribute style:font-pitch { fontPitch }?
+ & attribute style:font-pitch-asian { fontPitch }?
+ & attribute style:font-pitch-complex { fontPitch }?
+ & attribute style:font-charset { textEncoding }?
+ & attribute style:font-charset-asian { textEncoding }?
+ & attribute style:font-charset-complex { textEncoding }?
+ & attribute fo:font-size { positiveLength | percent }?
+ & attribute style:font-size-asian { positiveLength | percent }?
+ & attribute style:font-size-complex { positiveLength | percent }?
+ & attribute style:font-size-rel { length }?
+ & attribute style:font-size-rel-asian { length }?
+ & attribute style:font-size-rel-complex { length }?
+ & attribute style:script-type {
+ "latin" | "asian" | "complex" | "ignore"
+ }?
+ & attribute fo:letter-spacing { length | "normal" }?
+ & attribute fo:language { languageCode }?
+ & attribute style:language-asian { languageCode }?
+ & attribute style:language-complex { languageCode }?
+ & attribute fo:country { countryCode }?
+ & attribute style:country-asian { countryCode }?
+ & attribute style:country-complex { countryCode }?
+ & attribute fo:script { scriptCode }?
+ & attribute style:script-asian { scriptCode }?
+ & attribute style:script-complex { scriptCode }?
+ & attribute style:rfc-language-tag { language }?
+ & attribute style:rfc-language-tag-asian { language }?
+ & attribute style:rfc-language-tag-complex { language }?
+ & attribute fo:font-style { fontStyle }?
+ & attribute style:font-style-asian { fontStyle }?
+ & attribute style:font-style-complex { fontStyle }?
+ & attribute style:font-relief { "none" | "embossed" | "engraved" }?
+ & attribute fo:text-shadow { shadowType }?
+ & attribute style:text-underline-type { lineType }?
+ & attribute style:text-underline-style { lineStyle }?
+ & attribute style:text-underline-width { lineWidth }?
+ & attribute style:text-underline-color { "font-color" | color }?
+ & attribute style:text-overline-type { lineType }?
+ & attribute style:text-overline-style { lineStyle }?
+ & attribute style:text-overline-width { lineWidth }?
+ & attribute style:text-overline-color { "font-color" | color }?
+ & attribute style:text-overline-mode { lineMode }?
+ & attribute fo:font-weight { fontWeight }?
+ & attribute style:font-weight-asian { fontWeight }?
+ & attribute style:font-weight-complex { fontWeight }?
+ & attribute style:text-underline-mode { lineMode }?
+ & attribute style:text-line-through-mode { lineMode }?
+ & attribute style:letter-kerning { boolean }?
+ & attribute style:text-blinking { boolean }?
+ & common-background-color-attlist
+ & attribute style:text-combine { "none" | "letters" | "lines" }?
+ & attribute style:text-combine-start-char { character }?
+ & attribute style:text-combine-end-char { character }?
+ & attribute style:text-emphasize {
+ "none"
+ | list {
+ ("none" | "accent" | "dot" | "circle" | "disc"),
+ ("above" | "below")
+ }
+ }?
+ & attribute style:text-scale { percent }?
+ & attribute style:text-rotation-angle { angle }?
+ & attribute style:text-rotation-scale { "fixed" | "line-height" }?
+ & attribute fo:hyphenate { boolean }?
+ & attribute fo:hyphenation-remain-char-count { positiveInteger }?
+ & attribute fo:hyphenation-push-char-count { positiveInteger }?
+ & (attribute text:display { "true" }
+ | attribute text:display { "none" }
+ | (attribute text:display { "condition" },
+ attribute text:condition { "none" })
+ | empty)
+fontVariant = "normal" | "small-caps"
+fontFamilyGeneric =
+ "roman" | "swiss" | "modern" | "decorative" | "script" | "system"
+fontPitch = "fixed" | "variable"
+textEncoding = xsd:string { pattern = "[A-Za-z][A-Za-z0-9._\-]*" }
+fontStyle = "normal" | "italic" | "oblique"
+shadowType = "none" | \string
+lineType = "none" | "single" | "double"
+lineStyle =
+ "none"
+ | "solid"
+ | "dotted"
+ | "dash"
+ | "long-dash"
+ | "dot-dash"
+ | "dot-dot-dash"
+ | "wave"
+lineWidth =
+ "auto"
+ | "normal"
+ | "bold"
+ | "thin"
+ | "medium"
+ | "thick"
+ | positiveInteger
+ | percent
+ | positiveLength
+fontWeight =
+ "normal"
+ | "bold"
+ | "100"
+ | "200"
+ | "300"
+ | "400"
+ | "500"
+ | "600"
+ | "700"
+ | "800"
+ | "900"
+lineMode = "continuous" | "skip-white-space"
+style-paragraph-properties =
+ element style:paragraph-properties {
+ style-paragraph-properties-content-strict
+ }
+style-paragraph-properties-content-strict =
+ style-paragraph-properties-attlist,
+ style-paragraph-properties-elements
+style-paragraph-properties-attlist =
+ attribute fo:line-height { "normal" | nonNegativeLength | percent }?
+ & attribute style:line-height-at-least { nonNegativeLength }?
+ & attribute style:line-spacing { length }?
+ & attribute style:font-independent-line-spacing { boolean }?
+ & common-text-align
+ & attribute fo:text-align-last { "start" | "center" | "justify" }?
+ & attribute style:justify-single-word { boolean }?
+ & attribute fo:keep-together { "auto" | "always" }?
+ & attribute fo:widows { nonNegativeInteger }?
+ & attribute fo:orphans { nonNegativeInteger }?
+ & attribute style:tab-stop-distance { nonNegativeLength }?
+ & attribute fo:hyphenation-keep { "auto" | "page" }?
+ & attribute fo:hyphenation-ladder-count {
+ "no-limit" | positiveInteger
+ }?
+ & attribute style:register-true { boolean }?
+ & common-horizontal-margin-attlist
+ & attribute fo:text-indent { length | percent }?
+ & attribute style:auto-text-indent { boolean }?
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-break-attlist
+ & common-background-color-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & attribute style:join-border { boolean }?
+ & common-padding-attlist
+ & common-shadow-attlist
+ & common-keep-with-next-attlist
+ & attribute text:number-lines { boolean }?
+ & attribute text:line-number { nonNegativeInteger }?
+ & attribute style:text-autospace { "none" | "ideograph-alpha" }?
+ & attribute style:punctuation-wrap { "simple" | "hanging" }?
+ & attribute style:line-break { "normal" | "strict" }?
+ & attribute style:vertical-align {
+ "top" | "middle" | "bottom" | "auto" | "baseline"
+ }?
+ & common-writing-mode-attlist
+ & attribute style:writing-mode-automatic { boolean }?
+ & attribute style:snap-to-layout-grid { boolean }?
+ & common-page-number-attlist
+ & common-background-transparency-attlist
+common-text-align =
+ attribute fo:text-align {
+ "start" | "end" | "left" | "right" | "center" | "justify"
+ }?
+style-paragraph-properties-elements =
+ style-tab-stops & style-drop-cap & style-background-image
+style-tab-stops = element style:tab-stops { style-tab-stop* }?
+style-tab-stop =
+ element style:tab-stop { style-tab-stop-attlist, empty }
+style-tab-stop-attlist =
+ attribute style:position { length }
+ & (attribute style:type { "left" | "center" | "right" }?
+ | (attribute style:type { "char" },
+ style-tab-stop-char-attlist))
+ & attribute style:leader-type { lineType }?
+ & attribute style:leader-style { lineStyle }?
+ & attribute style:leader-width { lineWidth }?
+ & attribute style:leader-color { "font-color" | color }?
+ & attribute style:leader-text { character }?
+ & attribute style:leader-text-style { styleNameRef }?
+style-tab-stop-char-attlist = attribute style:char { character }
+style-drop-cap =
+ element style:drop-cap { style-drop-cap-attlist, empty }?
+style-drop-cap-attlist =
+ attribute style:length { "word" | positiveInteger }?
+ & attribute style:lines { positiveInteger }?
+ & attribute style:distance { length }?
+ & attribute style:style-name { styleNameRef }?
+common-horizontal-margin-attlist =
+ attribute fo:margin-left { length | percent }?,
+ attribute fo:margin-right { length | percent }?
+common-vertical-margin-attlist =
+ attribute fo:margin-top { nonNegativeLength | percent }?,
+ attribute fo:margin-bottom { nonNegativeLength | percent }?
+common-margin-attlist =
+ attribute fo:margin { nonNegativeLength | percent }?
+common-break-attlist =
+ attribute fo:break-before { "auto" | "column" | "page" }?,
+ attribute fo:break-after { "auto" | "column" | "page" }?
+common-background-color-attlist =
+ attribute fo:background-color { "transparent" | color }?
+style-background-image =
+ element style:background-image {
+ style-background-image-attlist,
+ (common-draw-data-attlist | office-binary-data | empty)
+ }?
+style-background-image-attlist =
+ attribute style:repeat { "no-repeat" | "repeat" | "stretch" }?
+ & attribute style:position {
+ "left"
+ | "center"
+ | "right"
+ | "top"
+ | "bottom"
+ | list { horiBackPos, vertBackPos }
+ | list { vertBackPos, horiBackPos }
+ }?
+ & attribute style:filter-name { \string }?
+ & attribute draw:opacity { zeroToHundredPercent }?
+horiBackPos = "left" | "center" | "right"
+vertBackPos = "top" | "center" | "bottom"
+common-border-attlist =
+ attribute fo:border { \string }?,
+ attribute fo:border-top { \string }?,
+ attribute fo:border-bottom { \string }?,
+ attribute fo:border-left { \string }?,
+ attribute fo:border-right { \string }?
+common-border-line-width-attlist =
+ attribute style:border-line-width { borderWidths }?,
+ attribute style:border-line-width-top { borderWidths }?,
+ attribute style:border-line-width-bottom { borderWidths }?,
+ attribute style:border-line-width-left { borderWidths }?,
+ attribute style:border-line-width-right { borderWidths }?
+borderWidths = list { positiveLength, positiveLength, positiveLength }
+common-padding-attlist =
+ attribute fo:padding { nonNegativeLength }?,
+ attribute fo:padding-top { nonNegativeLength }?,
+ attribute fo:padding-bottom { nonNegativeLength }?,
+ attribute fo:padding-left { nonNegativeLength }?,
+ attribute fo:padding-right { nonNegativeLength }?
+common-shadow-attlist = attribute style:shadow { shadowType }?
+common-keep-with-next-attlist =
+ attribute fo:keep-with-next { "auto" | "always" }?
+common-writing-mode-attlist =
+ attribute style:writing-mode {
+ "lr-tb" | "rl-tb" | "tb-rl" | "tb-lr" | "lr" | "rl" | "tb" | "page"
+ }?
+common-page-number-attlist =
+ attribute style:page-number { positiveInteger | "auto" }?
+common-background-transparency-attlist =
+ attribute style:background-transparency { zeroToHundredPercent }?
+style-ruby-properties =
+ element style:ruby-properties { style-ruby-properties-content-strict }
+style-ruby-properties-content-strict =
+ style-ruby-properties-attlist, style-ruby-properties-elements
+style-ruby-properties-elements = empty
+style-ruby-properties-attlist =
+ attribute style:ruby-position { "above" | "below" }?
+ & attribute style:ruby-align {
+ "left"
+ | "center"
+ | "right"
+ | "distribute-letter"
+ | "distribute-space"
+ }?
+style-section-properties =
+ element style:section-properties {
+ style-section-properties-content-strict
+ }
+style-section-properties-content-strict =
+ style-section-properties-attlist, style-section-properties-elements
+style-section-properties-attlist =
+ common-background-color-attlist
+ & common-horizontal-margin-attlist
+ & attribute style:protect { boolean }?
+ & common-editable-attlist
+ & attribute text:dont-balance-text-columns { boolean }?
+ & common-writing-mode-attlist
+style-section-properties-elements =
+ style-background-image & style-columns & text-notes-configuration*
+style-columns =
+ element style:columns {
+ style-columns-attlist, style-column-sep?, style-column*
+ }?
+style-columns-attlist =
+ attribute fo:column-count { positiveInteger }
+ & attribute fo:column-gap { length }?
+style-column = element style:column { style-column-attlist }
+style-column-attlist =
+ attribute style:rel-width { relativeLength }
+ & attribute fo:start-indent { length }?
+ & attribute fo:end-indent { length }?
+ & attribute fo:space-before { length }?
+ & attribute fo:space-after { length }?
+style-column-sep = element style:column-sep { style-column-sep-attlist }
+style-column-sep-attlist =
+ attribute style:style {
+ "none" | "solid" | "dotted" | "dashed" | "dot-dashed"
+ }?
+ & attribute style:width { length }
+ & attribute style:height { zeroToHundredPercent }?
+ & attribute style:vertical-align { "top" | "middle" | "bottom" }?
+ & attribute style:color { color }?
+style-table-properties =
+ element style:table-properties {
+ style-table-properties-content-strict
+ }
+style-table-properties-content-strict =
+ style-table-properties-attlist, style-table-properties-elements
+style-table-properties-attlist =
+ attribute style:width { positiveLength }?
+ & attribute style:rel-width { percent }?
+ & attribute table:align { "left" | "center" | "right" | "margins" }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & common-page-number-attlist
+ & common-break-attlist
+ & common-background-color-attlist
+ & common-shadow-attlist
+ & common-keep-with-next-attlist
+ & attribute style:may-break-between-rows { boolean }?
+ & attribute table:border-model { "collapsing" | "separating" }?
+ & common-writing-mode-attlist
+ & attribute table:display { boolean }?
+style-table-properties-elements = style-background-image
+style-table-column-properties =
+ element style:table-column-properties {
+ style-table-column-properties-content-strict
+ }
+style-table-column-properties-content-strict =
+ style-table-column-properties-attlist,
+ style-table-column-properties-elements
+style-table-column-properties-elements = empty
+style-table-column-properties-attlist =
+ attribute style:column-width { positiveLength }?
+ & attribute style:rel-column-width { relativeLength }?
+ & attribute style:use-optimal-column-width { boolean }?
+ & common-break-attlist
+style-table-row-properties =
+ element style:table-row-properties {
+ style-table-row-properties-content-strict
+ }
+style-table-row-properties-content-strict =
+ style-table-row-properties-attlist,
+ style-table-row-properties-elements
+style-table-row-properties-attlist =
+ attribute style:row-height { positiveLength }?
+ & attribute style:min-row-height { nonNegativeLength }?
+ & attribute style:use-optimal-row-height { boolean }?
+ & common-background-color-attlist
+ & common-break-attlist
+ & attribute fo:keep-together { "auto" | "always" }?
+style-table-row-properties-elements = style-background-image
+style-table-cell-properties =
+ element style:table-cell-properties {
+ style-table-cell-properties-content-strict
+ }
+style-table-cell-properties-content-strict =
+ style-table-cell-properties-attlist,
+ style-table-cell-properties-elements
+style-table-cell-properties-attlist =
+ attribute style:vertical-align {
+ "top" | "middle" | "bottom" | "automatic"
+ }?
+ & attribute style:text-align-source { "fix" | "value-type" }?
+ & common-style-direction-attlist
+ & attribute style:glyph-orientation-vertical {
+ "auto" | "0" | "0deg" | "0rad" | "0grad"
+ }?
+ & common-writing-mode-attlist
+ & common-shadow-attlist
+ & common-background-color-attlist
+ & common-border-attlist
+ & attribute style:diagonal-tl-br { \string }?
+ & attribute style:diagonal-tl-br-widths { borderWidths }?
+ & attribute style:diagonal-bl-tr { \string }?
+ & attribute style:diagonal-bl-tr-widths { borderWidths }?
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & attribute fo:wrap-option { "no-wrap" | "wrap" }?
+ & common-rotation-angle-attlist
+ & attribute style:rotation-align {
+ "none" | "bottom" | "top" | "center"
+ }?
+ & attribute style:cell-protect {
+ "none"
+ | "hidden-and-protected"
+ | list { ("protected" | "formula-hidden")+ }
+ }?
+ & attribute style:print-content { boolean }?
+ & attribute style:decimal-places { nonNegativeInteger }?
+ & attribute style:repeat-content { boolean }?
+ & attribute style:shrink-to-fit { boolean }?
+common-style-direction-attlist =
+ attribute style:direction { "ltr" | "ttb" }?
+style-table-cell-properties-elements = style-background-image
+common-rotation-angle-attlist =
+ attribute style:rotation-angle { angle }?
+style-list-level-properties =
+ element style:list-level-properties {
+ style-list-level-properties-content-strict
+ }
+style-list-level-properties-content-strict =
+ style-list-level-properties-attlist,
+ style-list-level-properties-elements
+style-list-level-properties-attlist =
+ common-text-align
+ & attribute text:space-before { length }?
+ & attribute text:min-label-width { nonNegativeLength }?
+ & attribute text:min-label-distance { nonNegativeLength }?
+ & attribute style:font-name { \string }?
+ & attribute fo:width { positiveLength }?
+ & attribute fo:height { positiveLength }?
+ & common-vertical-rel-attlist
+ & common-vertical-pos-attlist
+ & attribute text:list-level-position-and-space-mode {
+ "label-width-and-position" | "label-alignment"
+ }?
+style-list-level-properties-elements = style-list-level-label-alignment
+style-list-level-label-alignment =
+ element style:list-level-label-alignment {
+ style-list-level-label-alignment-attlist, empty
+ }?
+style-list-level-label-alignment-attlist =
+ attribute text:label-followed-by { "listtab" | "space" | "nothing" }
+ & attribute text:list-tab-stop-position { length }?
+ & attribute fo:text-indent { length }?
+ & attribute fo:margin-left { length }?
+style-graphic-properties-attlist =
+ attribute draw:stroke { "none" | "dash" | "solid" }?
+ & attribute draw:stroke-dash { styleNameRef }?
+ & attribute draw:stroke-dash-names { styleNameRefs }?
+ & attribute svg:stroke-width { length }?
+ & attribute svg:stroke-color { color }?
+ & attribute draw:marker-start { styleNameRef }?
+ & attribute draw:marker-end { styleNameRef }?
+ & attribute draw:marker-start-width { length }?
+ & attribute draw:marker-end-width { length }?
+ & attribute draw:marker-start-center { boolean }?
+ & attribute draw:marker-end-center { boolean }?
+ & attribute svg:stroke-opacity {
+ xsd:double { minInclusive = "0" maxInclusive = "1" }
+ | zeroToHundredPercent
+ }?
+ & attribute draw:stroke-linejoin {
+ "miter" | "round" | "bevel" | "middle" | "none"
+ }?
+ & attribute svg:stroke-linecap { "butt" | "square" | "round" }?
+ & attribute draw:symbol-color { color }?
+ & attribute text:animation {
+ "none" | "scroll" | "alternate" | "slide"
+ }?
+ & attribute text:animation-direction {
+ "left" | "right" | "up" | "down"
+ }?
+ & attribute text:animation-start-inside { boolean }?
+ & attribute text:animation-stop-inside { boolean }?
+ & attribute text:animation-repeat { nonNegativeInteger }?
+ & attribute text:animation-delay { duration }?
+ & attribute text:animation-steps { length }?
+ & attribute draw:auto-grow-width { boolean }?
+ & attribute draw:auto-grow-height { boolean }?
+ & attribute draw:fit-to-size { boolean }?
+ & attribute draw:fit-to-contour { boolean }?
+ & attribute draw:textarea-vertical-align {
+ "top" | "middle" | "bottom" | "justify"
+ }?
+ & attribute draw:textarea-horizontal-align {
+ "left" | "center" | "right" | "justify"
+ }?
+ & attribute fo:wrap-option { "no-wrap" | "wrap" }?
+ & attribute style:shrink-to-fit { boolean }?
+ & attribute draw:color-mode {
+ "greyscale" | "mono" | "watermark" | "standard"
+ }?
+ & attribute draw:color-inversion { boolean }?
+ & attribute draw:luminance { zeroToHundredPercent }?
+ & attribute draw:contrast { percent }?
+ & attribute draw:gamma { percent }?
+ & attribute draw:red { signedZeroToHundredPercent }?
+ & attribute draw:green { signedZeroToHundredPercent }?
+ & attribute draw:blue { signedZeroToHundredPercent }?
+ & attribute draw:image-opacity { zeroToHundredPercent }?
+ & attribute draw:shadow { "visible" | "hidden" }?
+ & attribute draw:shadow-offset-x { length }?
+ & attribute draw:shadow-offset-y { length }?
+ & attribute draw:shadow-color { color }?
+ & attribute draw:shadow-opacity { zeroToHundredPercent }?
+ & attribute draw:start-line-spacing-horizontal { distance }?
+ & attribute draw:start-line-spacing-vertical { distance }?
+ & attribute draw:end-line-spacing-horizontal { distance }?
+ & attribute draw:end-line-spacing-vertical { distance }?
+ & attribute draw:line-distance { distance }?
+ & attribute draw:guide-overhang { length }?
+ & attribute draw:guide-distance { distance }?
+ & attribute draw:start-guide { length }?
+ & attribute draw:end-guide { length }?
+ & attribute draw:placing { "below" | "above" }?
+ & attribute draw:parallel { boolean }?
+ & attribute draw:measure-align {
+ "automatic" | "left-outside" | "inside" | "right-outside"
+ }?
+ & attribute draw:measure-vertical-align {
+ "automatic" | "above" | "below" | "center"
+ }?
+ & attribute draw:unit {
+ "automatic"
+ | "mm"
+ | "cm"
+ | "m"
+ | "km"
+ | "pt"
+ | "pc"
+ | "inch"
+ | "ft"
+ | "mi"
+ }?
+ & attribute draw:show-unit { boolean }?
+ & attribute draw:decimal-places { nonNegativeInteger }?
+ & attribute draw:caption-type {
+ "straight-line" | "angled-line" | "angled-connector-line"
+ }?
+ & attribute draw:caption-angle-type { "fixed" | "free" }?
+ & attribute draw:caption-angle { angle }?
+ & attribute draw:caption-gap { distance }?
+ & attribute draw:caption-escape-direction {
+ "horizontal" | "vertical" | "auto"
+ }?
+ & attribute draw:caption-escape { length | percent }?
+ & attribute draw:caption-line-length { length }?
+ & attribute draw:caption-fit-line-length { boolean }?
+ & attribute dr3d:horizontal-segments { nonNegativeInteger }?
+ & attribute dr3d:vertical-segments { nonNegativeInteger }?
+ & attribute dr3d:edge-rounding { percent }?
+ & attribute dr3d:edge-rounding-mode { "correct" | "attractive" }?
+ & attribute dr3d:back-scale { percent }?
+ & attribute dr3d:depth { length }?
+ & attribute dr3d:backface-culling { "enabled" | "disabled" }?
+ & attribute dr3d:end-angle { angle }?
+ & attribute dr3d:close-front { boolean }?
+ & attribute dr3d:close-back { boolean }?
+ & attribute dr3d:lighting-mode { "standard" | "double-sided" }?
+ & attribute dr3d:normals-kind { "object" | "flat" | "sphere" }?
+ & attribute dr3d:normals-direction { "normal" | "inverse" }?
+ & attribute dr3d:texture-generation-mode-x {
+ "object" | "parallel" | "sphere"
+ }?
+ & attribute dr3d:texture-generation-mode-y {
+ "object" | "parallel" | "sphere"
+ }?
+ & attribute dr3d:texture-kind { "luminance" | "intensity" | "color" }?
+ & attribute dr3d:texture-filter { "enabled" | "disabled" }?
+ & attribute dr3d:texture-mode { "replace" | "modulate" | "blend" }?
+ & attribute dr3d:ambient-color { color }?
+ & attribute dr3d:emissive-color { color }?
+ & attribute dr3d:specular-color { color }?
+ & attribute dr3d:diffuse-color { color }?
+ & attribute dr3d:shininess { percent }?
+ & attribute dr3d:shadow { "visible" | "hidden" }?
+ & common-draw-rel-size-attlist
+ & attribute fo:min-width { length | percent }?
+ & attribute fo:min-height { length | percent }?
+ & attribute fo:max-height { length | percent }?
+ & attribute fo:max-width { length | percent }?
+ & common-horizontal-margin-attlist
+ & common-vertical-margin-attlist
+ & common-margin-attlist
+ & attribute style:print-content { boolean }?
+ & attribute style:protect {
+ "none"
+ | list { ("content" | "position" | "size")+ }
+ }?
+ & attribute style:horizontal-pos {
+ "left"
+ | "center"
+ | "right"
+ | "from-left"
+ | "inside"
+ | "outside"
+ | "from-inside"
+ }?
+ & attribute svg:x { coordinate }?
+ & attribute style:horizontal-rel {
+ "page"
+ | "page-content"
+ | "page-start-margin"
+ | "page-end-margin"
+ | "frame"
+ | "frame-content"
+ | "frame-start-margin"
+ | "frame-end-margin"
+ | "paragraph"
+ | "paragraph-content"
+ | "paragraph-start-margin"
+ | "paragraph-end-margin"
+ | "char"
+ }?
+ & common-vertical-pos-attlist
+ & common-vertical-rel-attlist
+ & common-text-anchor-attlist
+ & common-border-attlist
+ & common-border-line-width-attlist
+ & common-padding-attlist
+ & common-shadow-attlist
+ & common-background-color-attlist
+ & common-background-transparency-attlist
+ & common-editable-attlist
+ & attribute style:wrap {
+ "none"
+ | "left"
+ | "right"
+ | "parallel"
+ | "dynamic"
+ | "run-through"
+ | "biggest"
+ }?
+ & attribute style:wrap-dynamic-threshold { nonNegativeLength }?
+ & attribute style:number-wrapped-paragraphs {
+ "no-limit" | positiveInteger
+ }?
+ & attribute style:wrap-contour { boolean }?
+ & attribute style:wrap-contour-mode { "full" | "outside" }?
+ & attribute style:run-through { "foreground" | "background" }?
+ & attribute style:flow-with-text { boolean }?
+ & attribute style:overflow-behavior {
+ "clip" | "auto-create-new-frame"
+ }?
+ & attribute style:mirror {
+ "none"
+ | "vertical"
+ | horizontal-mirror
+ | list { "vertical", horizontal-mirror }
+ | list { horizontal-mirror, "vertical" }
+ }?
+ & attribute fo:clip { "auto" | clipShape }?
+ & attribute draw:wrap-influence-on-position {
+ "iterative" | "once-concurrent" | "once-successive"
+ }?
+ & common-writing-mode-attlist
+ & attribute draw:frame-display-scrollbar { boolean }?
+ & attribute draw:frame-display-border { boolean }?
+ & attribute draw:frame-margin-horizontal { nonNegativePixelLength }?
+ & attribute draw:frame-margin-vertical { nonNegativePixelLength }?
+ & attribute draw:visible-area-left { nonNegativeLength }?
+ & attribute draw:visible-area-top { nonNegativeLength }?
+ & attribute draw:visible-area-width { positiveLength }?
+ & attribute draw:visible-area-height { positiveLength }?
+ & attribute draw:draw-aspect {
+ "content" | "thumbnail" | "icon" | "print-view"
+ }?
+ & attribute draw:ole-draw-aspect { nonNegativeInteger }?
+style-graphic-fill-properties-attlist =
+ attribute draw:fill {
+ "none" | "solid" | "bitmap" | "gradient" | "hatch"
+ }?
+ & attribute draw:fill-color { color }?
+ & attribute draw:secondary-fill-color { color }?
+ & attribute draw:fill-gradient-name { styleNameRef }?
+ & attribute draw:gradient-step-count { nonNegativeInteger }?
+ & attribute draw:fill-hatch-name { styleNameRef }?
+ & attribute draw:fill-hatch-solid { boolean }?
+ & attribute draw:fill-image-name { styleNameRef }?
+ & attribute style:repeat { "no-repeat" | "repeat" | "stretch" }?
+ & attribute draw:fill-image-width { length | percent }?
+ & attribute draw:fill-image-height { length | percent }?
+ & attribute draw:fill-image-ref-point-x { percent }?
+ & attribute draw:fill-image-ref-point-y { percent }?
+ & attribute draw:fill-image-ref-point {
+ "top-left"
+ | "top"
+ | "top-right"
+ | "left"
+ | "center"
+ | "right"
+ | "bottom-left"
+ | "bottom"
+ | "bottom-right"
+ }?
+ & attribute draw:tile-repeat-offset {
+ list { zeroToHundredPercent, ("horizontal" | "vertical") }
+ }?
+ & attribute draw:opacity { zeroToHundredPercent }?
+ & attribute draw:opacity-name { styleNameRef }?
+ & attribute svg:fill-rule { "nonzero" | "evenodd" }?
+style-graphic-properties-elements =
+ text-list-style? & style-background-image & style-columns
+common-vertical-pos-attlist =
+ attribute style:vertical-pos {
+ "top" | "middle" | "bottom" | "from-top" | "below"
+ }?,
+ attribute svg:y { coordinate }?
+common-vertical-rel-attlist =
+ attribute style:vertical-rel {
+ "page"
+ | "page-content"
+ | "frame"
+ | "frame-content"
+ | "paragraph"
+ | "paragraph-content"
+ | "char"
+ | "line"
+ | "baseline"
+ | "text"
+ }?
+common-editable-attlist = attribute style:editable { boolean }?
+horizontal-mirror =
+ "horizontal" | "horizontal-on-odd" | "horizontal-on-even"
+clipShape =
+ xsd:string {
+ pattern =
+ "rect\([ ]*((-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)))|(auto))([ ]*,[ ]*((-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))))|(auto)){3}[ ]*\)"
+ }
+nonNegativePixelLength =
+ xsd:string { pattern = "([0-9]+(\.[0-9]*)?|\.[0-9]+)(px)" }
+style-chart-properties =
+ element style:chart-properties {
+ style-chart-properties-content-strict
+ }
+style-chart-properties-content-strict =
+ style-chart-properties-attlist, style-chart-properties-elements
+style-chart-properties-elements = empty
+style-chart-properties-attlist =
+ attribute chart:scale-text { boolean }?
+ & attribute chart:three-dimensional { boolean }?
+ & attribute chart:deep { boolean }?
+ & attribute chart:right-angled-axes { boolean }?
+ & (attribute chart:symbol-type { "none" }
+ | attribute chart:symbol-type { "automatic" }
+ | (attribute chart:symbol-type { "named-symbol" },
+ attribute chart:symbol-name {
+ "square"
+ | "diamond"
+ | "arrow-down"
+ | "arrow-up"
+ | "arrow-right"
+ | "arrow-left"
+ | "bow-tie"
+ | "hourglass"
+ | "circle"
+ | "star"
+ | "x"
+ | "plus"
+ | "asterisk"
+ | "horizontal-bar"
+ | "vertical-bar"
+ })
+ | (attribute chart:symbol-type { "image" },
+ element chart:symbol-image {
+ attribute xlink:href { anyIRI }
+ })
+ | empty)
+ & attribute chart:symbol-width { nonNegativeLength }?
+ & attribute chart:symbol-height { nonNegativeLength }?
+ & attribute chart:sort-by-x-values { boolean }?
+ & attribute chart:vertical { boolean }?
+ & attribute chart:connect-bars { boolean }?
+ & attribute chart:gap-width { integer }?
+ & attribute chart:overlap { integer }?
+ & attribute chart:group-bars-per-axis { boolean }?
+ & attribute chart:japanese-candle-stick { boolean }?
+ & attribute chart:interpolation {
+ "none" | "cubic-spline" | "b-spline"
+ }?
+ & attribute chart:spline-order { positiveInteger }?
+ & attribute chart:spline-resolution { positiveInteger }?
+ & attribute chart:pie-offset { nonNegativeInteger }?
+ & attribute chart:angle-offset { angle }?
+ & attribute chart:hole-size { percent }?
+ & attribute chart:lines { boolean }?
+ & attribute chart:solid-type {
+ "cuboid" | "cylinder" | "cone" | "pyramid"
+ }?
+ & attribute chart:stacked { boolean }?
+ & attribute chart:percentage { boolean }?
+ & attribute chart:treat-empty-cells {
+ "use-zero" | "leave-gap" | "ignore"
+ }?
+ & attribute chart:link-data-style-to-source { boolean }?
+ & attribute chart:logarithmic { boolean }?
+ & attribute chart:maximum { double }?
+ & attribute chart:minimum { double }?
+ & attribute chart:origin { double }?
+ & attribute chart:interval-major { double }?
+ & attribute chart:interval-minor-divisor { positiveInteger }?
+ & attribute chart:tick-marks-major-inner { boolean }?
+ & attribute chart:tick-marks-major-outer { boolean }?
+ & attribute chart:tick-marks-minor-inner { boolean }?
+ & attribute chart:tick-marks-minor-outer { boolean }?
+ & attribute chart:reverse-direction { boolean }?
+ & attribute chart:display-label { boolean }?
+ & attribute chart:text-overlap { boolean }?
+ & attribute text:line-break { boolean }?
+ & attribute chart:label-arrangement {
+ "side-by-side" | "stagger-even" | "stagger-odd"
+ }?
+ & common-style-direction-attlist
+ & common-rotation-angle-attlist
+ & attribute chart:data-label-number {
+ "none" | "value" | "percentage" | "value-and-percentage"
+ }?
+ & attribute chart:data-label-text { boolean }?
+ & attribute chart:data-label-symbol { boolean }?
+ & element chart:label-separator { text-p }?
+ & attribute chart:label-position { labelPositions }?
+ & attribute chart:label-position-negative { labelPositions }?
+ & attribute chart:visible { boolean }?
+ & attribute chart:auto-position { boolean }?
+ & attribute chart:auto-size { boolean }?
+ & attribute chart:mean-value { boolean }?
+ & attribute chart:error-category {
+ "none"
+ | "variance"
+ | "standard-deviation"
+ | "percentage"
+ | "error-margin"
+ | "constant"
+ | "standard-error"
+ | "cell-range"
+ }?
+ & attribute chart:error-percentage { double }?
+ & attribute chart:error-margin { double }?
+ & attribute chart:error-lower-limit { double }?
+ & attribute chart:error-upper-limit { double }?
+ & attribute chart:error-upper-indicator { boolean }?
+ & attribute chart:error-lower-indicator { boolean }?
+ & attribute chart:error-lower-range { cellRangeAddressList }?
+ & attribute chart:error-upper-range { cellRangeAddressList }?
+ & attribute chart:series-source { "columns" | "rows" }?
+ & attribute chart:regression-type {
+ "none" | "linear" | "logarithmic" | "exponential" | "power"
+ }?
+ & attribute chart:axis-position { "start" | "end" | double }?
+ & attribute chart:axis-label-position {
+ "near-axis"
+ | "near-axis-other-side"
+ | "outside-start"
+ | "outside-end"
+ }?
+ & attribute chart:tick-mark-position {
+ "at-labels" | "at-axis" | "at-labels-and-axis"
+ }?
+ & attribute chart:include-hidden-cells { boolean }?
+labelPositions =
+ "avoid-overlap"
+ | "center"
+ | "top"
+ | "top-right"
+ | "right"
+ | "bottom-right"
+ | "bottom"
+ | "bottom-left"
+ | "left"
+ | "top-left"
+ | "inside"
+ | "outside"
+ | "near-origin"
+style-drawing-page-properties-attlist =
+ attribute presentation:transition-type {
+ "manual" | "automatic" | "semi-automatic"
+ }?
+ & attribute presentation:transition-style {
+ "none"
+ | "fade-from-left"
+ | "fade-from-top"
+ | "fade-from-right"
+ | "fade-from-bottom"
+ | "fade-from-upperleft"
+ | "fade-from-upperright"
+ | "fade-from-lowerleft"
+ | "fade-from-lowerright"
+ | "move-from-left"
+ | "move-from-top"
+ | "move-from-right"
+ | "move-from-bottom"
+ | "move-from-upperleft"
+ | "move-from-upperright"
+ | "move-from-lowerleft"
+ | "move-from-lowerright"
+ | "uncover-to-left"
+ | "uncover-to-top"
+ | "uncover-to-right"
+ | "uncover-to-bottom"
+ | "uncover-to-upperleft"
+ | "uncover-to-upperright"
+ | "uncover-to-lowerleft"
+ | "uncover-to-lowerright"
+ | "fade-to-center"
+ | "fade-from-center"
+ | "vertical-stripes"
+ | "horizontal-stripes"
+ | "clockwise"
+ | "counterclockwise"
+ | "open-vertical"
+ | "open-horizontal"
+ | "close-vertical"
+ | "close-horizontal"
+ | "wavyline-from-left"
+ | "wavyline-from-top"
+ | "wavyline-from-right"
+ | "wavyline-from-bottom"
+ | "spiralin-left"
+ | "spiralin-right"
+ | "spiralout-left"
+ | "spiralout-right"
+ | "roll-from-top"
+ | "roll-from-left"
+ | "roll-from-right"
+ | "roll-from-bottom"
+ | "stretch-from-left"
+ | "stretch-from-top"
+ | "stretch-from-right"
+ | "stretch-from-bottom"
+ | "vertical-lines"
+ | "horizontal-lines"
+ | "dissolve"
+ | "random"
+ | "vertical-checkerboard"
+ | "horizontal-checkerboard"
+ | "interlocking-horizontal-left"
+ | "interlocking-horizontal-right"
+ | "interlocking-vertical-top"
+ | "interlocking-vertical-bottom"
+ | "fly-away"
+ | "open"
+ | "close"
+ | "melt"
+ }?
+ & attribute presentation:transition-speed { presentationSpeeds }?
+ & attribute smil:type { \string }?
+ & attribute smil:subtype { \string }?
+ & attribute smil:direction { "forward" | "reverse" }?
+ & attribute smil:fadeColor { color }?
+ & attribute presentation:duration { duration }?
+ & attribute presentation:visibility { "visible" | "hidden" }?
+ & attribute draw:background-size { "full" | "border" }?
+ & attribute presentation:background-objects-visible { boolean }?
+ & attribute presentation:background-visible { boolean }?
+ & attribute presentation:display-header { boolean }?
+ & attribute presentation:display-footer { boolean }?
+ & attribute presentation:display-page-number { boolean }?
+ & attribute presentation:display-date-time { boolean }?
+style-drawing-page-properties-elements = presentation-sound?
+\string = xsd:string
+date = xsd:date
+time = xsd:time
+dateTime = xsd:dateTime
+duration = xsd:duration
+integer = xsd:integer
+nonNegativeInteger = xsd:nonNegativeInteger
+positiveInteger = xsd:positiveInteger
+double = xsd:double
+anyURI = xsd:anyURI
+base64Binary = xsd:base64Binary
+ID = xsd:ID
+IDREF = xsd:IDREF
+IDREFS = xsd:IDREFS
+NCName = xsd:NCName
+boolean = "true" | "false"
+dateOrDateTime = xsd:date | xsd:dateTime
+timeOrDateTime = xsd:time | xsd:dateTime
+language = xsd:language
+countryCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" }
+languageCode = xsd:token { pattern = "[A-Za-z]{1,8}" }
+scriptCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" }
+character = xsd:string { length = "1" }
+length =
+ xsd:string {
+ pattern =
+ "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+nonNegativeLength =
+ xsd:string {
+ pattern =
+ "([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+positiveLength =
+ xsd:string {
+ pattern =
+ "([0-9]*[1-9][0-9]*(\.[0-9]*)?|0+\.[0-9]*[1-9][0-9]*|\.[0-9]*[1-9][0-9]*)((cm)|(mm)|(in)|(pt)|(pc)|(px))"
+ }
+percent = xsd:string { pattern = "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)%" }
+zeroToHundredPercent =
+ xsd:string {
+ pattern = "([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+ }
+signedZeroToHundredPercent =
+ xsd:string {
+ pattern = "-?([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%"
+ }
+relativeLength = xsd:string { pattern = "[0-9]+\*" }
+coordinate = length
+distance = length
+color = xsd:string { pattern = "#[0-9a-fA-F]{6}" }
+angle = xsd:string
+CURIE =
+ xsd:string { pattern = "(([\i-[:]][\c-[:]]*)?:)?.+" minLength = "1" }
+CURIEs = list { CURIE+ }
+SafeCURIE =
+ xsd:string {
+ pattern = "\[(([\i-[:]][\c-[:]]*)?:)?.+\]"
+ minLength = "3"
+ }
+URIorSafeCURIE = anyURI | SafeCURIE
+styleName = xsd:NCName
+styleNameRef = xsd:NCName | empty
+styleNameRefs = list { xsd:NCName* }
+variableName = xsd:string
+targetFrameName = "_self" | "_blank" | "_parent" | "_top" | \string
+valueType =
+ "float"
+ | "time"
+ | "date"
+ | "percentage"
+ | "currency"
+ | "boolean"
+ | "string"
+points =
+ xsd:string { pattern = "-?[0-9]+,-?[0-9]+([ ]+-?[0-9]+,-?[0-9]+)*" }
+pathData = xsd:string
+vector3D =
+ xsd:string {
+ pattern =
+ "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)){2}[ ]*\)"
+ }
+namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" }
+anyIRI =
+ xsd:anyURI
+ >> dc:description [
+ "An IRI-reference as defined in [RFC3987]. See ODF 1.2 Part 1 section 18.3."
+ ]
+anyAttListOrElements =
+ attribute * { text }*,
+ anyElements
+anyElements =
+ element * {
+ mixed { anyAttListOrElements }
+ }*
diff --git a/etc/schema/relaxng.rnc b/etc/schema/relaxng.rnc
index fae2bf1f012..7961457dd00 100644
--- a/etc/schema/relaxng.rnc
+++ b/etc/schema/relaxng.rnc
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
default namespace rng = "http://relaxng.org/ns/structure/1.0"
namespace local = ""
@@ -39,7 +39,7 @@ param = element param { commonAttributes, nameNCName, xsd:string }
exceptPattern = element except { common & pattern+ }
-grammarContent =
+grammarContent =
definition
| element div { common & grammarContent* }
| element include { href, (common & includeContent*) }
@@ -54,7 +54,7 @@ definition =
combine = attribute combine { "choice" | "interleave" }
-nameClass =
+nameClass =
element name { commonAttributes, xsd:QName }
| element anyName { common & exceptNameClass? }
| element nsName { common & exceptNameClass? }
@@ -69,7 +69,7 @@ type = attribute type { xsd:NCName }
common = commonAttributes, foreignElement*
-commonAttributes =
+commonAttributes =
attribute ns { xsd:string }?,
attribute datatypeLibrary { xsd:anyURI }?,
foreignAttribute*
diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml
index d217d6edfb3..ef4a0b3e0ef 100644
--- a/etc/schema/schemas.xml
+++ b/etc/schema/schemas.xml
@@ -13,7 +13,7 @@ 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 <http://www.gnu.org/licenses/>. -->
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. -->
<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">
<transformURI fromPattern="*.xml" toPattern="*.rnc"/>
@@ -55,4 +55,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -->
<typeId id="XHTML" uri="xhtml.rnc"/>
<typeId id="DocBook" uri="docbook.rnc"/>
<typeId id="RDF" uri="rdfxml.rnc"/>
+
+ <documentElement prefix="office" typeId="OpenDocument"/>
+ <documentElement prefix="manifest" localName="manifest" typeId="OpenDocument Manifest"/>
+ <typeId id="OpenDocument" uri="od-schema-v1.2-os.rnc"/>
+ <typeId id="OpenDocument Manifest" uri="od-manifest-schema-v1.2-os.rnc"/>
+
</locatingRules>
diff --git a/etc/ses-example.ses b/etc/ses-example.ses
index 5c0a281b1ae..51a16849555 100644
--- a/etc/ses-example.ses
+++ b/etc/ses-example.ses
@@ -220,4 +220,4 @@ Sales summary - Acme fundraising
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
diff --git a/etc/srecode/c.srt b/etc/srecode/c.srt
index 720da3daab4..fe029a3c32b 100644
--- a/etc/srecode/c.srt
+++ b/etc/srecode/c.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "c-mode"
@@ -131,7 +131,7 @@ Override this with your own preference to avoid using doxygen"
----
;;; DOXYGEN FEATURES
-;;
+;;
;;
context declaration
diff --git a/etc/srecode/cpp.srt b/etc/srecode/cpp.srt
index 444c14d819d..6468eadc1d5 100644
--- a/etc/srecode/cpp.srt
+++ b/etc/srecode/cpp.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "c++-mode"
@@ -56,7 +56,7 @@ Override this to affect applications, or the outer class structure for
the user-facing template."
----
class {{?NAME}} {{#PARENTS}}{{#FIRST}}: {{/FIRST}}public {{NAME}}{{/PARENTS}}
-{
+{
{{^}}
};
----
@@ -111,7 +111,7 @@ Override this with your own preference to avoid using doxygen."
----
;;; DOXYGEN FEATURES
-;;
+;;
;;
context classdecl
diff --git a/etc/srecode/default.srt b/etc/srecode/default.srt
index f7a8f09fc3a..d8c7cd1be11 100644
--- a/etc/srecode/default.srt
+++ b/etc/srecode/default.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "default"
@@ -34,7 +34,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see http://www.gnu.org/licenses/."
+along with this program. If not, see https://www.gnu.org/licenses/."
set DOLLAR "$"
diff --git a/etc/srecode/doc-cpp.srt b/etc/srecode/doc-cpp.srt
index 486bb630574..e23b37b8836 100644
--- a/etc/srecode/doc-cpp.srt
+++ b/etc/srecode/doc-cpp.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "c-mode"
diff --git a/etc/srecode/doc-default.srt b/etc/srecode/doc-default.srt
index 30a83118637..3290d6a84c2 100644
--- a/etc/srecode/doc-default.srt
+++ b/etc/srecode/doc-default.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "default"
diff --git a/etc/srecode/doc-java.srt b/etc/srecode/doc-java.srt
index a3a294d67fb..ab0edb8193a 100644
--- a/etc/srecode/doc-java.srt
+++ b/etc/srecode/doc-java.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "java-mode"
diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt
index c25416eb13c..c75997dc00e 100644
--- a/etc/srecode/ede-autoconf.srt
+++ b/etc/srecode/ede-autoconf.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "autoconf-mode"
set escape_start "{{"
diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt
index 448534234c9..0c7d5668754 100644
--- a/etc/srecode/ede-make.srt
+++ b/etc/srecode/ede-make.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "makefile-mode"
set escape_start "{{"
diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt
index cc3f1e8e81b..66db5666c0b 100644
--- a/etc/srecode/el.srt
+++ b/etc/srecode/el.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set escape_start "$"
set escape_end "$"
@@ -307,5 +307,3 @@ bind "s"
;; end
-
-
diff --git a/etc/srecode/getset-cpp.srt b/etc/srecode/getset-cpp.srt
index 9f4341d039a..50f5d224cbe 100644
--- a/etc/srecode/getset-cpp.srt
+++ b/etc/srecode/getset-cpp.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "c++-mode"
set application "getset"
@@ -47,4 +47,3 @@ f{{NAME}}(){{#NOTLAST}},{{/NOTLAST}}
----
;; end
-
diff --git a/etc/srecode/java.srt b/etc/srecode/java.srt
index db154dbf687..cfc55f8d794 100644
--- a/etc/srecode/java.srt
+++ b/etc/srecode/java.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "java-mode"
set escape_start "{{"
@@ -162,8 +162,8 @@ template javadoc-class :indent :blank :time :user :tag
* Created: {{DATE}}
*
* @author {{AUTHOR}}
- * @version
- * @since
+ * @version
+ * @since
*/
----
diff --git a/etc/srecode/make.srt b/etc/srecode/make.srt
index af2e950cfe8..ef5f1bece7d 100644
--- a/etc/srecode/make.srt
+++ b/etc/srecode/make.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "makefile-mode"
set escape_start "{{"
diff --git a/etc/srecode/template.srt b/etc/srecode/template.srt
index deb901f2db3..8403a698614 100644
--- a/etc/srecode/template.srt
+++ b/etc/srecode/template.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set escape_start "$"
set escape_end "$"
diff --git a/etc/srecode/test.srt b/etc/srecode/test.srt
index 4e567adf79b..9843e5338a7 100644
--- a/etc/srecode/test.srt
+++ b/etc/srecode/test.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "srecode-template-mode"
set escape_start "$"
@@ -83,7 +83,7 @@ template gapsomething :blank
template inlinetext
"Insert text that has no newlines"
----
- *In the middle*
+ *In the middle*
----
template includable :blank
diff --git a/etc/srecode/texi.srt b/etc/srecode/texi.srt
index 52acb77f21a..def3b48d231 100644
--- a/etc/srecode/texi.srt
+++ b/etc/srecode/texi.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "texinfo-mode"
diff --git a/etc/srecode/wisent.srt b/etc/srecode/wisent.srt
index ac59d770f5e..7e8726cbac1 100644
--- a/etc/srecode/wisent.srt
+++ b/etc/srecode/wisent.srt
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
set mode "wisent-grammar-mode"
set comment_start ";;"
diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el
index 5c9df3dc247..7171c4a7085 100644
--- a/etc/themes/adwaita-theme.el
+++ b/etc/themes/adwaita-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index d1111de96a1..568411fd23d 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index c32d18ce3de..ed4b4f3df73 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index c15bd41bf81..a181b7351bf 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -4,7 +4,7 @@
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; URL: https://github.com/fniessen/emacs-leuven-theme
-;; Version: 20140929.1232
+;; Version: 20170912.2328
;; Keywords: color theme
;; This file is part of GNU Emacs.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -600,6 +600,15 @@ Semantic, and Ansi-Color faces are included -- and much more...")
`(rainbow-delimiters-depth-9-face ((,class (:foreground "#887070"))))
`(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched)))
`(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched)))
+ `(realgud-overlay-arrow1 ((,class (:foreground "#005522"))))
+ `(realgud-overlay-arrow2 ((,class (:foreground "#c18401"))))
+ `(realgud-overlay-arrow3 ((,class (:foreground "#909183"))))
+ `(realgud-bp-disabled-face ((,class (:foreground "#909183"))))
+ `(realgud-bp-line-enabled-face ((,class (:underline "red"))))
+ `(realgud-bp-line-disabled-face ((,class (:underline "#909183"))))
+ `(realgud-file-name ((,class :foreground "#005522")))
+ `(realgud-line-number ((,class :foreground "#A535AE")))
+ `(realgud-backtrace-number ((,class :foreground "#A535AE" :weight bold)))
`(recover-this-file ((,class (:weight bold :background "#FF3F3F"))))
`(rng-error ((,class (:weight bold :foreground "red" :background "#FBE3E4"))))
`(sh-heredoc ((,class (:foreground "blue" :background "#EEF5FE"))))
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index 319b5f3e474..48d65d2690b 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index 87a2af74f10..dc1f9e6c7bc 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -602,6 +602,16 @@ jarring angry fruit salad look to reduce eye fatigue.")
'(paren-no-match-face ((t (:bold t :background "white" :foreground "red"))))
'(query-replace ((t (:foreground "brown4" :background "palevioletred2"))))
'(region ((t (:background "blue3"))))
+ '(realgud-overlay-arrow1 ((t (:foreground "medium sea green"))))
+ '(realgud-overlay-arrow2 ((t (:foreground "white"))))
+ '(realgud-overlay-arrow3 ((t (:foreground "indian red"))))
+ '(realgud-bp-enabled-face ((t (:inherit error))))
+ '(realgud-bp-disabled-face ((t (:underline t))))
+ '(realgud-bp-line-enabled-face ((t (:foreground "orange"))))
+ '(realgud-bp-line-disabled-face ((t (:underline t))))
+ '(realgud-file-name ((t (:foreground "cyan"))))
+ '(realgud-line-number ((t (:foreground "yellow"))))
+ '(realgud-backtrace-number ((t (:foreground "yellow" :weight bold))))
'(scroll-bar ((t (:background "grey75" :foreground "WhiteSmoke"))))
'(secondary-selection ((t (:background "SkyBlue4"))))
'(semantic-dirty-token-face ((t (:background "lightyellow"))))
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index 53772fbb3ee..74de3efa457 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index ba7484c8cee..58a2a5937d1 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary
@@ -140,6 +140,16 @@ Semantic, and Ansi-Color faces are included.")
;; Flyspell faces
`(flyspell-duplicate ((,class (:underline ,orange-1))))
`(flyspell-incorrect ((,class (:underline ,red-1))))
+ ;; Realgud
+ `(realgud-overlay-arrow1 ((,class (:foreground "green"))))
+ `(realgud-overlay-arrow2 ((,class (:foreground ,orange-1))))
+ `(realgud-overlay-arrow3 ((,class (:foreground ,plum-0))))
+ `(realgud-bp-disabled-face ((,class (:foreground ,blue-3))))
+ `(realgud-bp-line-enabled-face ((,class (:underline "red"))))
+ `(realgud-bp-line-disabled-face ((,class (:underline ,blue-3))))
+ `(realgud-file-name ((,class :foreground ,blue-1)))
+ `(realgud-line-number ((,class :foreground ,plum-0)))
+ `(realgud-backtrace-number ((,class :foreground ,plum-0 :weight bold)))
;; Semantic faces
`(semantic-decoration-on-includes ((,class (:underline ,alum-4))))
`(semantic-decoration-on-private-members-face
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index 50b8a964fb2..820c4639d1e 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary
@@ -124,6 +124,16 @@ Semantic, and Ansi-Color faces are included.")
;; Flyspell
`(flyspell-duplicate ((,class (:underline ,orange-1))))
`(flyspell-incorrect ((,class (:underline ,red-1))))
+ ;; Realgud
+ `(realgud-overlay-arrow1 ((,class (:foreground "dark green"))))
+ `(realgud-overlay-arrow2 ((,class (:foreground "#7a4c02"))))
+ `(realgud-overlay-arrow3 ((,class (:foreground ,orange-1))))
+ `(realgud-bp-disabled-face ((,class (:foreground ,plum-1))))
+ `(realgud-bp-line-enabled-face ((,class (:underline "red"))))
+ `(realgud-bp-line-disabled-face ((,class (:underline ,plum-1))))
+ `(realgud-file-name ((,class :foreground "dark green")))
+ `(realgud-line-number ((,class :foreground ,blue-3)))
+ `(realgud-backtrace-number ((,class :foreground ,blue-3 :weight bold)))
;; Semantic faces
`(semantic-decoration-on-includes ((,class (:underline ,cham-4))))
`(semantic-decoration-on-private-members-face
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index cd94a71bd38..881d1909a33 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -118,6 +118,16 @@
'(outline-6 ((t (:foreground "light salmon" :weight bold))))
'(outline-7 ((t (:foreground "pale goldenrod" :weight bold))))
'(outline-8 ((t (:foreground "OliveDrab1" :weight bold))))
+ '(realgud-overlay-arrow1 ((t (:foreground "medium spring green"))))
+ '(realgud-overlay-arrow2 ((t (:foreground "OliveDrab1"))))
+ '(realgud-overlay-arrow3 ((t (:foreground "light salmon"))))
+ '(realgud-bp-enabled-face ((t (:inherit error))))
+ '(realgud-bp-disabled-face ((t (:foreground "gray35"))))
+ '(realgud-bp-line-enabled-face ((t (:foreground "light salmon"))))
+ '(realgud-bp-line-disabled-face ((t (:foreground "medium spring green"))))
+ '(realgud-file-name ((t (:foreground "dark khaki"))))
+ '(realgud-line-number ((t (:foreground "cyan3"))))
+ '(realgud-backtrace-number ((t (:foreground "cyan3" :weight bold))))
'(rcirc-my-nick ((t (:foreground "SpringGreen1" :weight bold))) t)
'(rcirc-other-nick ((t (:foreground "dodger blue"))) t)
'(rcirc-track-keyword ((t (:foreground "DodgerBlue" :weight bold))) t)
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index e8174803e2d..0d2c0063b5d 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -64,7 +64,7 @@ Used and created by Tassilo Horn.")
'(gnus-group-news-3-empty ((t (:foreground "tomato2")))) '(header-line ((t (:inherit mode-line :inverse-video t))))
'(hl-line ((t (:background "#f0f0f1"))))
'(hl-paren-face ((t (:weight bold))) t)
- '(minibuffer-prompt ((t (:foreground "#0184bc" :family "DeJaVu" :box (:line-width -1 :style released-button) :weight bold))))
+ '(minibuffer-prompt ((t (:foreground "#0184bc" :box (:line-width -1 :style released-button) :weight bold))))
'(mode-line ((t (:background "#f0f0f1" :box (:line-width 1 :color "#383a42")))))
'(mode-line-inactive ((t (:inherit mode-line :foreground "#a0a1a7"))))
'(org-agenda-date ((t (:inherit org-agenda-structure))))
@@ -90,6 +90,15 @@ Used and created by Tassilo Horn.")
'(outline-7 ((t (:inherit font-lock-builtin-face :weight bold))))
'(outline-8 ((t (:inherit font-lock-string-face :weight bold))))
'(rcirc-my-nick ((t (:foreground "LightSkyBlue" :weight bold))))
+ '(realgud-overlay-arrow1 ((t (:foreground "dark green"))))
+ '(realgud-overlay-arrow2 ((t (:foreground "#c18401"))))
+ '(realgud-overlay-arrow3 ((t (:foreground "gray60"))))
+ '(realgud-bp-disabled-face ((t (:foreground "gray60"))))
+ '(realgud-bp-line-enabled-face ((t (:underline "red"))))
+ '(realgud-bp-line-disabled-face ((t (:underline "gray60"))))
+ '(realgud-file-name ((t :foreground "dark green")))
+ '(realgud-line-number ((t :foreground "#0184bc")))
+ '(realgud-backtrace-number ((t :foreground "#0184bc" :weight bold)))
'(region ((t (:background "lightgoldenrod1"))))
'(show-paren-match ((t (:background "Cyan1" :weight bold))))
'(show-paren-mismatch ((t (:background "deep pink" :weight bold))))
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index 291e839d3bc..bdfedadb95f 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -68,7 +68,18 @@ of green, brown, and blue.")
`(message-header-subject ((,class (:foreground "pale turquoise"))))
`(message-header-to ((,class (:foreground "pale green"))))
`(message-cited-text ((,class (:foreground "SpringGreen3"))))
- `(message-separator ((,class (:foreground "deep sky blue"))))))
+ `(message-separator ((,class (:foreground "deep sky blue"))))
+ ;; Realgud faces
+ `(realgud-overlay-arrow1 ((,class (:foreground "SpringGreen3"))))
+ `(realgud-overlay-arrow2 ((,class (:foreground "white"))))
+ `(realgud-overlay-arrow3 ((,class (:foreground "wheat"))))
+ `(realgud-bp-enabled-face ((,class (:inherit error))))
+ `(realgud-bp-disabled-face ((,class (:foreground "dark slate gray"))))
+ `(realgud-bp-line-enabled-face ((,class (:underline "SpringGreen3"))))
+ `(realgud-bp-line-disabled-face ((,class (:underline "salmon"))))
+ `(realgud-file-name ((,class (:foreground "dark khaki"))))
+ `(realgud-line-number ((,class (:foreground "dark cyan"))))
+ `(realgud-backtrace-number ((,class (:foreground "dark cyan" :weight bold))))))
(provide-theme 'wheatgrass)
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index 5e2f466acc4..eedf9abbba0 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -83,6 +83,16 @@
`(outline-4 ((,class (:foreground "RoyalBlue"))))
`(outline-5 ((,class (:foreground "DeepSkyBlue"))))
`(primary-selection ((,class (:background "blue3"))))
+ `(realgud-overlay-arrow1 ((,class (:foreground "DarkGreen"))))
+ `(realgud-overlay-arrow2 ((,class (:foreground "DarkOliveGreen"))))
+ `(realgud-overlay-arrow3 ((,class (:foreground "gray60"))))
+ `(realgud-bp-disabled-face ((,class (:foreground "gray60"))))
+ `(realgud-bp-line-enabled-face ((,class (:underline "red"))))
+ `(realgud-bp-line-disabled-face ((,class (:underline "gray60"))))
+ `(realgud-file-name ((,class :foreground "DarkGreen")))
+ `(realgud-line-number ((,class :foreground "blue3")))
+ `(realgud-backtrace-number ((,class :foreground "blue3" :weight bold)))
+
`(region ((,class (:background "SkyBlue1"))))
`(show-paren-match-face ((,class (:background "dodgerblue1" :foreground "white"))))
`(show-paren-mismatch-face ((,class (:background "red1" :foreground "white"))))
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index 80bac921a1e..da0c2898628 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL
index 3419c63c1fb..e099fe8dd13 100644
--- a/etc/tutorials/TUTORIAL
+++ b/etc/tutorials/TUTORIAL
@@ -17,15 +17,19 @@ The characters ">>" at the left margin indicate directions for you to
try using a command. For instance:
<<Blank lines inserted around following line by help-with-tutorial>>
[Middle of page left blank for didactic purposes. Text continues below]
->> Now type C-v (View next screen) to move to the next screen.
+>> Now type C-v (View next screen) to scroll down in the tutorial.
(go ahead, do it by holding down the CONTROL key while typing v).
- From now on, you should do this again whenever you finish
- reading the screen.
+ From now on, please do this whenever you reach the end of the screen.
-Note that there is an overlap of two lines when you move from screen
-to screen; this provides some continuity so you can continue reading
+Note that there is an overlap of two lines when you scroll a whole
+screenful; this provides some continuity so you can continue reading
the text.
+This is a copy of the Emacs tutorial text, customized slightly for
+you. Later on we will instruct you to try various commands to alter
+this text. Don't worry if you change this text before we tell you to;
+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
@@ -33,6 +37,7 @@ and type v, or type <ESC>v if you do not have a META, EDIT, or ALT key).
>> Try typing M-v and then C-v, a few times.
+It is ok to scroll this text in other ways, if you know how.
* SUMMARY
---------
@@ -56,7 +61,6 @@ You can also use the PageUp and PageDn keys to move by screenfuls, if
your terminal has them, but you can edit more efficiently if you use
C-v and M-v.
-
* BASIC CURSOR CONTROL
----------------------
@@ -1128,7 +1132,7 @@ and comes with permission to distribute copies on certain conditions:
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Please read the file COPYING and then do give copies of GNU Emacs to
your friends. Help stamp out software obstructionism ("ownership") by
diff --git a/etc/tutorials/TUTORIAL.bg b/etc/tutorials/TUTORIAL.bg
index ed6f29c6d81..f34153932f2 100644
--- a/etc/tutorials/TUTORIAL.bg
+++ b/etc/tutorials/TUTORIAL.bg
@@ -1178,7 +1178,7 @@ comes with permission to distribute copies on certain conditions:
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Моля, прочетете файла COPYING и тогава давайте копия на ГНУ Емакс на
свои приятели. Помогнете да спрем затвореността на програмите
diff --git a/etc/tutorials/TUTORIAL.cn b/etc/tutorials/TUTORIAL.cn
index fe8f500aafb..a9fc6f0bbf0 100644
--- a/etc/tutorials/TUTORIAL.cn
+++ b/etc/tutorials/TUTORIAL.cn
@@ -1013,7 +1013,7 @@ and comes with permission to distribute copies on certain conditions:
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Please read the file COPYING and then do give copies of GNU Emacs to
your friends. Help stamp out software obstructionism ("ownership") by
@@ -1039,7 +1039,7 @@ using, writing, and sharing free software!
售性或特定目的适用性所为的默示性担保。详情请参照GNU通用公共授权。
您应已收到附随于 GNU Emacs 的GNU通用公共授权的副本;如果没有,请参照
- <http://www.gnu.org/licenses/>.
+ <https://www.gnu.org/licenses/>.
敬请阅读文件“COPYING”,然后向你的朋友们分发 GNU Emacs 拷贝。让我们以使
用、编写和分享自由软件的实际行动来共同祛除软件障碍主义(所谓的“所有
diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he
index 49997164630..f3e6bee9553 100644
--- a/etc/tutorials/TUTORIAL.he
+++ b/etc/tutorials/TUTORIAL.he
@@ -17,13 +17,18 @@
לדוגמה:
<<שורות ריקות תתווספנה סביב השורה הבאה ע״י help-with-tutorial>>
[אמצע העמוד הושאר ריק למטרות לימודיות. הטקסט ממשיך להלן]
->> הקישו עתה C-v (הצג העמוד הבא) על־מנת להתקדם לעמוד הבא. (קדימה, נסו
- זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.)
+>> הקישו עתה C-v (הצג העמוד הבא) על־מנת לגלול תצוגה לעמוד הבא. (קדימה,
+ נסו זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.)
מעתה והלאה, עליכם לעשות זאת בכל פעם שתסיימו לקרוא את המוצג על המסך.
-שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למשך, מה שמבטיח רציפות
+שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למסך, מה שמבטיח רציפות
מסוימת בעת קריאת הטקסט.
+הטקסט שלפניכם הינו עותק של שיעור בשימוש ב־‫Emacs‬ שהותאם קלות עבורכם.
+בהמשך תקבלו הוראות לנסות פקודות שונות כדי לבצע שינויים בטקסט הזה. אם
+במקרה תשנו את הטקסט לפני שנבקש, אל דאגה: זוהי "עריכה" שהיא יעודו של
+Emacs.
+
דבר ראשון שעליכם ללמוד הוא כיצד לנוע ממקום אחד למשנהו בתוך הטקסט. אתם
כבר יודעים כיצד להתקדם לעמוד הבא, עם C-v. לחזרה לעמוד הקודם הקישו M-v
(החזיקו מקש META והקישו v או הקישו ‪<ESC>v‬ אם אין במקלדת מקש META
@@ -31,6 +36,7 @@
>> נסו עתה כמה פעמים להקיש M-v ואחר־כך C-v.
+אפשר לגלול טקסט גם באמצעים אחרים, אם אתם יודעים כיצד לעשות זאת.
* סיכום עד כאן
--------------
@@ -1010,7 +1016,7 @@ Software Foundation, אם בגרסא 3 של הרשיון, ואם (כאופציה
אנא עיינו ב־GNU General Public License.
‏GNU Emacs אמור להיות מלווה בעותק של GNU General Public License; אם לא
-קיבלתם אותו, תוכלו למצוא אותו ב־‪<http://www.gnu.org/licenses/>‬.
+קיבלתם אותו, תוכלו למצוא אותו sב־‪<https://www.gnu.org/licenses/>‬.
הנכם מוזמנים לקרוא את הקובץ COPYING ואז אכן לחלק עותקים של GNU Emacs
לחבריכם. עזרו לנו לחסל את "הבעלות" על תוכנה שאינה אלא חבלה בתוכנה,
diff --git a/etc/tutorials/TUTORIAL.nl b/etc/tutorials/TUTORIAL.nl
index d0453bdfd64..6f70e2cf840 100644
--- a/etc/tutorials/TUTORIAL.nl
+++ b/etc/tutorials/TUTORIAL.nl
@@ -1254,7 +1254,7 @@ and comes with permission to distribute copies on certain conditions:
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Please read the file COPYING and then do give copies of GNU Emacs to
your friends. Help stamp out software obstructionism ("ownership") by
diff --git a/etc/tutorials/TUTORIAL.sl b/etc/tutorials/TUTORIAL.sl
index 4e59341f8c5..a9b8991a199 100644
--- a/etc/tutorials/TUTORIAL.sl
+++ b/etc/tutorials/TUTORIAL.sl
@@ -1134,7 +1134,7 @@ Copyright © 1985, 1996, 1998, 2001-2017 Free Software Foundation, Inc.
General Public License«.
Kopijo »GNU General Public License« bi morali prejeti skupaj s paketom
- GNU Emacs. Če je niste, je na voljo na <http://www.gnu.org/licenses/>.
+ GNU Emacs. Če je niste, je na voljo na <https://www.gnu.org/licenses/>.
Prosimo, preberite datoteko COPYING in potem ponudite kopijo programa
GNU Emacs svojim prijateljem. Pomagajte zatreti obstrukcionizem
diff --git a/etc/tutorials/TUTORIAL.sv b/etc/tutorials/TUTORIAL.sv
index 30608c56883..a0b041f31ab 100644
--- a/etc/tutorials/TUTORIAL.sv
+++ b/etc/tutorials/TUTORIAL.sv
@@ -18,13 +18,18 @@ 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 hoppa till nästa skärmbild.
+>> Tryck C-v (View next screen) 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 är färdig med en skärmbild.
+ fortsättningen när du når slutet av en skärmbild.
-Notera att det är ett överlapp på två rader när du byter från
-skärmbild till skärmbild. Detta är för att behålla sammanhanget när du
-bläddrar framåt i filen.
+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.
+
+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 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,
@@ -34,6 +39,7 @@ META-, EDIT- 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.
* SAMMANFATTNING
----------------
@@ -1149,7 +1155,7 @@ This file is part of GNU Emacs.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Please read the file COPYING and then do give copies of GNU Emacs to
your friends. Help stamp out software obstructionism ("ownership") by
diff --git a/etc/tutorials/TUTORIAL.zh b/etc/tutorials/TUTORIAL.zh
index c677cbd3f59..07c3e1f03c9 100644
--- a/etc/tutorials/TUTORIAL.zh
+++ b/etc/tutorials/TUTORIAL.zh
@@ -960,7 +960,7 @@ Emacs,請使用 C-z 。
本快速指南的翻譯人員列表如下,如果您在閱讀本文之前,「完全」對 Emacs
沒有概念,請告訴我們您的意見以作為本文後續的改進依據。翻譯也提供了一份
《GNU Emacs 中文處理說明》在
-http://www.gnu.org/software/chinese/guide/emacs-chinese.zh.html 〈部份
+https://www.gnu.org/software/chinese/guide/emacs-chinese.zh.html 〈部份
內容已經整理到本快速指南〉,也請您自行參閱。
編輯器是電腦使用者最常接觸到的應用程式,因此不應該讓初學者感到過於困難,
@@ -972,7 +972,7 @@ http://www.gnu.org/software/chinese/guide/emacs-chinese.zh.html 〈部份
issue here>」。
如果您是 Emacs 老手,GNU Chinese Translators Team (GNU/CTT)
-<http://www.gnu.org/software/chinese/> 歡迎您的加入,我們現在正需要願
+<https://www.gnu.org/software/chinese/> 歡迎您的加入,我們現在正需要願
意投入翻譯 Emacs 使用手冊的人員。
本快速指南並沒有採用習慣上編輯器所使用的翻譯術語,一方面因為它的實際意
diff --git a/leim/COPYING b/leim/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/leim/COPYING
+++ b/leim/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/leim/ChangeLog.1 b/leim/ChangeLog.1
index e7f8a46a865..485698113f2 100644
--- a/leim/ChangeLog.1
+++ b/leim/ChangeLog.1
@@ -454,7 +454,7 @@
Redo spelling of Makefile variables to conform to POSIX.
POSIX does not allow "-" in Makefile variable names.
Reported by Bruno Haible in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00990.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-01/msg00990.html>.
* Makefile.in (BUILT_EMACS): Rename from BUILT-EMACS.
(TIT_GB): Rename from TIT-GB.
(CHINESE_TIT): Rename from CHINESE-TIT.
@@ -2593,4 +2593,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/leim/Makefile.in b/leim/Makefile.in
index a21c2d95153..f18010af602 100644
--- a/leim/Makefile.in
+++ b/leim/Makefile.in
@@ -19,7 +19,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
diff --git a/leim/README b/leim/README
index 7bcdbd37f20..26c511ed911 100644
--- a/leim/README
+++ b/leim/README
@@ -51,4 +51,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/leim/leim-ext.el b/leim/leim-ext.el
index c0779c32a58..0e6430ba748 100644
--- a/leim/leim-ext.el
+++ b/leim/leim-ext.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lib-src/COPYING b/lib-src/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/lib-src/COPYING
+++ b/lib-src/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/lib-src/ChangeLog.1 b/lib-src/ChangeLog.1
index a9783e9f60b..87a0d7b943f 100644
--- a/lib-src/ChangeLog.1
+++ b/lib-src/ChangeLog.1
@@ -5,7 +5,7 @@
is not part of Emacs and is typically not installed.
Instead, just invoke xmalloc and xrealloc as usual.
Problem reported by Nicolas Richard in:
- http://bugs.gnu.org/20191#20
+ https://bugs.gnu.org/20191#20
(xrnew): Avoid no-longer-needed cast to 'char *'.
(xrealloc): First arg is now void *, not char *.
@@ -65,7 +65,7 @@
Better support for future plugins
See the thread containing:
- http://lists.gnu.org/archive/html/emacs-devel/2015-02/msg00720.html
+ https://lists.gnu.org/r/emacs-devel/2015-02/msg00720.html
* make-docfile.c (write_globals): Generate code that #defines
Qxxx macros other than Qnil only if DEFINE_NONNIL_Q_SYMBOL_MACROS.
Qnil is safe to define even in plugins, since it must be zero for
@@ -329,7 +329,7 @@
2014-05-26 Paul Eggert <eggert@cs.ucla.edu>
Fix rcs2log problems with CVS. Reported by Glenn Morris in
- <http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00277.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-05/msg00277.html>.
Plus, fix some security and filename quoting problems.
* rcs2log (logdir): Prefer mktemp if available.
(logdir, llogdir): Work even if TMPDIR begins with '-' or has spaces.
@@ -937,13 +937,13 @@
* movemail.c: Add missing 'defined'.
Suggested by Sven Joachim in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00218.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00218.html>.
2012-07-11 Paul Eggert <eggert@cs.ucla.edu>
Port 'movemail' again to Solaris and similar hosts.
See Susan Cragin's report in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00199.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00199.html>.
* movemail.c (xmalloc): Also define if !DISABLE_DIRECT_ACCESS &&
!MAIL_USE_MMDF && !MAIL_USE_SYSTEM_LOCK. Move up, so it doesn't
need a forward declaration.
@@ -1212,7 +1212,7 @@
Assume less-ancient POSIX support.
* update-game-score.c: Include <getopt.h> rather than rolling our
own decls for optarg, optind, opterr. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-12/msg00720.html>.
2012-04-14 Juanma Barranquero <lekktu@gmail.com>
@@ -1271,7 +1271,7 @@
instead, treat both -c and -t as always requesting a new "tty" frame,
and let server.el decide which kind is actually required.
Reported by Uwe Siart <usenet@siart.de> in this thread:
- http://lists.gnu.org/archive/html/emacs-devel/2011-11/msg00303.html
+ https://lists.gnu.org/r/emacs-devel/2011-11/msg00303.html
2011-11-30 Chong Yidong <cyd@gnu.org>
@@ -3684,7 +3684,7 @@
* rcs2log (Help): Clarify wording of the usage message.
Reported by Alan Mackenzie in
- <http://mail.gnu.org/archive/html/bug-gnu-emacs/2004-04/msg00188.html>.
+ <https://mail.gnu.org/archive/html/bug-gnu-emacs/2004-04/msg00188.html>.
2004-04-07 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -3715,7 +3715,7 @@
and the path. Allow :/ in repository path, since CVS does.
Fix typo: "pository" should be set from $CVSROOT, not $repository.
This fixes a bug reported by Wolfgang Scherer in
- <http://mail.gnu.org/archive/html/bug-gnu-emacs/2004-02/msg00085.html>,
+ <https://mail.gnu.org/archive/html/bug-gnu-emacs/2004-02/msg00085.html>,
along with some related bugs I discovered by inspecting how
CVS itself parses $CVSROOT.
@@ -3752,7 +3752,7 @@
* rcs2log (rlog_options): Append -rbranchtag if CVS/Tag indicates
a tag, and if the user has not specified an rlog option.
Adapted from a suggestion by Martin Stjernholm in
- <http://mail.gnu.org/archive/html/bug-gnu-emacs/2003-07/msg00066.html>.
+ <https://mail.gnu.org/archive/html/bug-gnu-emacs/2003-07/msg00066.html>.
(Copyright): Update to 2003.
2003-12-24 Thien-Thi Nguyen <ttn@gnu.org>
@@ -5643,7 +5643,7 @@
1998-04-06 Andreas Schwab <schwab@gnu.org>
Silence -Wimplicit:
- * movemail.c: Move cancelations up. Include <stdlib.h> if
+ * movemail.c: Move cancellations up. Include <stdlib.h> if
available.
* fakemail.c (_XOPEN_SOURCE): Define for declaration of cuserid.
(parse_header): Explicitly declare return type.
@@ -8624,4 +8624,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in
index fa8de0bcc94..5947fbde822 100644
--- a/lib-src/Makefile.in
+++ b/lib-src/Makefile.in
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 51d181997b1..d444a54b9a8 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -15,26 +15,26 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stddef.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <assert.h>
#include <getopt.h>
+#include <flexmember.h>
+#include <min-max.h>
+#include <unlocked-io.h>
+
/* The SunOS compiler doesn't have SEEK_END. */
#ifndef SEEK_END
#define SEEK_END 2
#endif
-#include <flexmember.h>
-#include <min-max.h>
-
/* Files are read in chunks of this number of bytes. */
enum { READ_CHUNK_SIZE = 100 * 1024 };
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 8828b7652de..b3ebb84ca0a 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -73,7 +73,6 @@ char *w32_getenv (const char *);
#include <stdarg.h>
#include <ctype.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <getopt.h>
@@ -84,6 +83,8 @@ char *w32_getenv (const char *);
#include <signal.h>
#include <errno.h>
+#include <unlocked-io.h>
+
#ifndef VERSION
#define VERSION "unspecified"
#endif
@@ -109,6 +110,9 @@ char *w32_getenv (const char *);
/* Name used to invoke this program. */
const char *progname;
+/* The first argument to main. */
+int main_argc;
+
/* The second argument to main. */
char **main_argv;
@@ -200,6 +204,35 @@ xmalloc (size_t size)
return result;
}
+/* Like realloc but get fatal error if memory is exhausted. */
+
+static void *
+xrealloc (void *ptr, size_t size)
+{
+ void *result = realloc (ptr, size);
+ if (result == NULL)
+ {
+ perror ("realloc");
+ exit (EXIT_FAILURE);
+ }
+ return result;
+}
+
+/* Like strdup but get a fatal error if memory is exhausted. */
+char *xstrdup (const char *);
+
+char *
+xstrdup (const char *s)
+{
+ char *result = strdup (s);
+ if (result == NULL)
+ {
+ perror ("strdup");
+ exit (EXIT_FAILURE);
+ }
+ return result;
+}
+
/* From sysdep.c */
#if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME)
@@ -263,21 +296,6 @@ get_current_dir_name (void)
#ifdef WINDOWSNT
-/* Like strdup but get a fatal error if memory is exhausted. */
-char *xstrdup (const char *);
-
-char *
-xstrdup (const char *s)
-{
- char *result = strdup (s);
- if (result == NULL)
- {
- perror ("strdup");
- exit (EXIT_FAILURE);
- }
- return result;
-}
-
#define REG_ROOT "SOFTWARE\\GNU\\Emacs"
char *w32_get_resource (HKEY, const char *, LPDWORD);
@@ -672,7 +690,7 @@ Report bugs with M-x report-emacs-bug.\n");
}
/* Try to run a different command, or --if no alternate editor is
- defined-- exit with an errorcode.
+ defined-- exit with an error code.
Uses argv, but gets it from the global variable main_argv. */
static _Noreturn void
@@ -680,9 +698,38 @@ fail (void)
{
if (alternate_editor)
{
- int i = optind - 1;
+ size_t extra_args_size = (main_argc - optind + 1) * sizeof (char *);
+ size_t new_argv_size = extra_args_size;
+ char **new_argv = NULL;
+ char *s = xstrdup (alternate_editor);
+ unsigned toks = 0;
+
+ /* Unpack alternate_editor's space-separated tokens into new_argv. */
+ for (char *tok = s; tok != NULL && *tok != '\0';)
+ {
+ /* Allocate new token. */
+ ++toks;
+ new_argv = xrealloc (new_argv, new_argv_size + toks * sizeof (char *));
+
+ /* Skip leading delimiters, and set separator, skipping any
+ opening quote. */
+ size_t skip = strspn (tok, " \"");
+ tok += skip;
+ char sep = (skip > 0 && tok[-1] == '"') ? '"' : ' ';
+
+ /* Record start of token. */
+ new_argv[toks - 1] = tok;
+
+ /* Find end of token and overwrite it with NUL. */
+ tok = strchr (tok, sep);
+ if (tok != NULL)
+ *tok++ = '\0';
+ }
+
+ /* Append main_argv arguments to new_argv. */
+ memcpy (&new_argv[toks], main_argv + optind, extra_args_size);
- execvp (alternate_editor, main_argv + i);
+ execvp (*new_argv, new_argv);
message (true, "%s: error executing alternate editor \"%s\"\n",
progname, alternate_editor);
}
@@ -695,6 +742,7 @@ fail (void)
int
main (int argc, char **argv)
{
+ main_argc = argc;
main_argv = argv;
progname = argv[0];
message (true, "%s: Sorry, the Emacs server is supported only\n"
@@ -1628,6 +1676,7 @@ main (int argc, char **argv)
int start_daemon_if_needed;
int exit_status = EXIT_SUCCESS;
+ main_argc = argc;
main_argv = argv;
progname = argv[0];
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 6f280d8ab40..cc7631f647e 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -44,7 +44,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* NB To comply with the above BSD license, copyright information is
@@ -111,6 +111,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
# undef HAVE_NTGUI
# undef DOS_NT
# define DOS_NT
+/* The WINDOWSNT build doesn't use Gnulib's fcntl.h. */
# define O_CLOEXEC O_NOINHERIT
#endif /* WINDOWSNT */
@@ -123,6 +124,7 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4";
#include <errno.h>
#include <fcntl.h>
#include <binary-io.h>
+#include <unlocked-io.h>
#include <c-ctype.h>
#include <c-strcase.h>
@@ -372,6 +374,7 @@ static void readline (linebuffer *, FILE *);
static long readline_internal (linebuffer *, FILE *, char const *);
static bool nocase_tail (const char *);
static void get_tag (char *, char **);
+static void get_lispy_tag (char *);
static void analyze_regex (char *);
static void free_regexps (void);
@@ -459,6 +462,7 @@ static bool cplusplus; /* .[hc] means C++, not C (undocumented) */
static bool ignoreindent; /* -I: ignore indentation in C */
static int packages_only; /* --packages-only: in Ada, only tag packages*/
static int class_qualify; /* -Q: produce class-qualified tags in C++/Java */
+static int debug; /* --debug */
/* STDIN is defined in LynxOS system headers */
#ifdef STDIN
@@ -476,6 +480,7 @@ static struct option longopts[] =
{ "append", no_argument, NULL, 'a' },
{ "packages-only", no_argument, &packages_only, 1 },
{ "c++", no_argument, NULL, 'C' },
+ { "debug", no_argument, &debug, 1 },
{ "declarations", no_argument, &declarations, 1 },
{ "no-line-directive", no_argument, &no_line_directive, 1 },
{ "no-duplicates", no_argument, &no_duplicates, 1 },
@@ -1525,7 +1530,7 @@ process_file_name (char *file, language *lang)
fdesc *fdp;
compressor *compr;
char *compressed_name, *uncompressed_name;
- char *ext, *real_name, *tmp_name;
+ char *ext, *real_name UNINIT, *tmp_name UNINIT;
int retval;
canonicalize_filename (file);
@@ -1914,6 +1919,10 @@ make_tag (const char *name, /* tag name, or NULL if unnamed */
bool named = (name != NULL && namelen > 0);
char *nname = NULL;
+ if (debug)
+ fprintf (stderr, "%s on %s:%d: %s\n",
+ named ? name : "(unnamed)", curfdp->taggedfname, lno, linestart);
+
if (!CTAGS && named) /* maybe set named to false */
/* Let's try to make an implicit tag name, that is, create an unnamed tag
such that etags.el can guess a name from it. */
@@ -4965,6 +4974,9 @@ Ruby_functions (FILE *inf)
memcpy (wr_name + name_len - 1, "=", 2);
pfnote (wr_name, true, lb.buffer, cp - lb.buffer + 1,
lineno, linecharno);
+ if (debug)
+ fprintf (stderr, "%s on %s:%d: %s\n", wr_name,
+ curfdp->taggedfname, lineno, lb.buffer);
continuation = false;
}
if (alias)
@@ -5346,7 +5358,7 @@ L_getit (void)
/* Ok, then skip "(" before name in (defstruct (foo)) */
dbp = skip_spaces (dbp);
}
- get_tag (dbp, NULL);
+ get_lispy_tag (dbp);
}
static void
@@ -5548,14 +5560,14 @@ Scheme_functions (FILE *inf)
if (strneq (bp, "(def", 4) || strneq (bp, "(DEF", 4))
{
bp = skip_non_spaces (bp+4);
- /* Skip over open parens and white space. Don't continue past
- '\0'. */
- while (*bp && notinname (*bp))
+ /* Skip over open parens and white space.
+ Don't continue past '\0' or '='. */
+ while (*bp && notinname (*bp) && *bp != '=')
bp++;
- get_tag (bp, NULL);
+ get_lispy_tag (bp);
}
if (LOOKING_AT (bp, "(SET!") || LOOKING_AT (bp, "(set!"))
- get_tag (bp, NULL);
+ get_lispy_tag (bp);
}
}
@@ -5591,7 +5603,7 @@ TeX_commands (FILE *inf)
linebuffer *key;
char TEX_esc = '\0';
- char TEX_opgrp, TEX_clgrp;
+ char TEX_opgrp UNINIT, TEX_clgrp UNINIT;
/* Initialize token table once from environment. */
if (TEX_toktab == NULL)
@@ -6544,9 +6556,16 @@ regex_tag_multiline (void)
else /* make a named tag */
name = substitute (buffer, rp->name, &rp->regs);
if (rp->force_explicit_name)
- /* Force explicit tag name, if a name is there. */
- pfnote (name, true, buffer + linecharno,
- charno - linecharno + 1, lineno, linecharno);
+ {
+ /* Force explicit tag name, if a name is there. */
+ pfnote (name, true, buffer + linecharno,
+ charno - linecharno + 1, lineno, linecharno);
+
+ if (debug)
+ fprintf (stderr, "%s on %s:%d: %s\n",
+ name ? name : "(unnamed)", curfdp->taggedfname,
+ lineno, buffer + linecharno);
+ }
else
make_tag (name, strlen (name), true, buffer + linecharno,
charno - linecharno + 1, lineno, linecharno);
@@ -6590,6 +6609,22 @@ get_tag (register char *bp, char **namepp)
*namepp = savenstr (bp, cp - bp);
}
+/* Similar to get_tag, but include '=' as part of the tag. */
+static void
+get_lispy_tag (register char *bp)
+{
+ register char *cp = bp;
+
+ if (*bp != '\0')
+ {
+ /* Go till you get to white space or a syntactic break */
+ for (cp = bp + 1; !notinname (*cp) || *cp == '='; cp++)
+ continue;
+ make_tag (bp, cp - bp, true,
+ lb.buffer, cp - lb.buffer + 1, lineno, linecharno);
+ }
+}
+
/*
* Read a line of text from `stream' into `lbp', excluding the
* newline or CR-NL, if any. Return the number of characters read from
@@ -6851,8 +6886,14 @@ readline (linebuffer *lbp, FILE *stream)
else /* make a named tag */
name = substitute (lbp->buffer, rp->name, &rp->regs);
if (rp->force_explicit_name)
- /* Force explicit tag name, if a name is there. */
- pfnote (name, true, lbp->buffer, match, lineno, linecharno);
+ {
+ /* Force explicit tag name, if a name is there. */
+ pfnote (name, true, lbp->buffer, match, lineno, linecharno);
+ if (debug)
+ fprintf (stderr, "%s on %s:%d: %s\n",
+ name ? name : "(unnamed)", curfdp->taggedfname,
+ lineno, lbp->buffer);
+ }
else
make_tag (name, strlen (name), true,
lbp->buffer, match, lineno, linecharno);
@@ -7027,14 +7068,16 @@ etags_mktmp (void)
errno = temp_errno;
templt = NULL;
}
-
#if defined (DOS_NT)
- /* The file name will be used in shell redirection, so it needs to have
- DOS-style backslashes, or else the Windows shell will barf. */
- char *p;
- for (p = templt; *p; p++)
- if (*p == '/')
- *p = '\\';
+ else
+ {
+ /* The file name will be used in shell redirection, so it needs to have
+ DOS-style backslashes, or else the Windows shell will barf. */
+ char *p;
+ for (p = templt; *p; p++)
+ if (*p == '/')
+ *p = '\\';
+ }
#endif
return templt;
diff --git a/lib-src/hexl.c b/lib-src/hexl.c
index 319ce8bc890..df49a598cac 100644
--- a/lib-src/hexl.c
+++ b/lib-src/hexl.c
@@ -16,17 +16,17 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <inttypes.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <binary-io.h>
+#include <unlocked-io.h>
static char *progname;
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index 9470bd635f5..9e4755b63ac 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* The arguments given to this program are all the C and Lisp source files
@@ -39,10 +39,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdarg.h>
#include <stddef.h>
#include <stdint.h>
-#include <stdio.h>
#include <stdlib.h>
#include <string.h>
+#include <binary-io.h>
+#include <intprops.h>
+#include <min-max.h>
+#include <unlocked-io.h>
+
#ifdef WINDOWSNT
/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this
is really just insurance. */
@@ -50,10 +54,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <direct.h>
#endif /* WINDOWSNT */
-#include <binary-io.h>
-#include <intprops.h>
-#include <min-max.h>
-
#ifdef DOS_NT
/* Defined to be sys_chdir in ms-w32.h, but only #ifdef emacs, so this
is really just insurance.
@@ -592,7 +592,7 @@ struct global
};
/* Bit values for FLAGS field from the above. Applied for DEFUNs only. */
-enum { DEFUN_noreturn = 1, DEFUN_const = 2 };
+enum { DEFUN_noreturn = 1, DEFUN_const = 2, DEFUN_noinline = 4 };
/* All the variable names we saw while scanning C sources in `-g'
mode. */
@@ -667,7 +667,7 @@ close_emacs_globals (ptrdiff_t num_symbols)
"#ifndef DEFINE_SYMBOLS\n"
"extern\n"
"#endif\n"
- "struct Lisp_Symbol alignas (GCALIGNMENT) lispsym[%td];\n"),
+ "struct Lisp_Symbol lispsym[%td];\n"),
num_symbols);
}
@@ -740,6 +740,8 @@ write_globals (void)
{
if (globals[i].flags & DEFUN_noreturn)
fputs ("_Noreturn ", stdout);
+ if (globals[i].flags & DEFUN_noinline)
+ fputs ("NO_INLINE ", stdout);
printf ("EXFUN (%s, ", globals[i].name);
if (globals[i].v.value == -1)
@@ -1060,7 +1062,8 @@ scan_c_stream (FILE *infile)
attributes: attribute1 attribute2 ...)
(Lisp_Object arg...)
- Now only 'noreturn' and 'const' attributes are used. */
+ Now only ’const’, ’noinline’ and 'noreturn' attributes
+ are used. */
/* Advance to the end of docstring. */
c = getc (infile);
@@ -1106,6 +1109,8 @@ scan_c_stream (FILE *infile)
g->flags |= DEFUN_noreturn;
if (strstr (input_buffer, "const"))
g->flags |= DEFUN_const;
+ if (strstr (input_buffer, "noinline"))
+ g->flags |= DEFUN_noinline;
}
continue;
}
diff --git a/lib-src/movemail.c b/lib-src/movemail.c
index cd12c48ed36..ce8dfd2ad95 100644
--- a/lib-src/movemail.c
+++ b/lib-src/movemail.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will
@@ -59,7 +59,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
-#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <time.h>
@@ -69,6 +68,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <fcntl.h>
#include <signal.h>
#include <string.h>
+
+#include <unlocked-io.h>
+
#include "syswait.h"
#ifdef MAIL_USE_POP
#include "pop.h"
diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c
index 78ba9061f6b..3754f914e33 100644
--- a/lib-src/ntlib.c
+++ b/lib-src/ntlib.c
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <windows.h>
#include <stdlib.h>
@@ -36,9 +36,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
char *sys_ctime (const time_t *);
FILE *sys_fopen (const char *, const char *);
+int sys_mkdir (const char *, mode_t);
int sys_chdir (const char *);
int mkostemp (char *, int);
int sys_rename (const char *, const char *);
+int sys_open (const char *, int, int);
/* MinGW64 defines _TIMEZONE_DEFINED and defines 'struct timespec' in
its system headers. */
@@ -245,6 +247,12 @@ sys_chdir (const char * path)
return _chdir (path);
}
+int
+sys_mkdir (const char * path, mode_t mode)
+{
+ return _mkdir (path);
+}
+
static FILETIME utc_base_ft;
static long double utc_base;
static int init = 0;
@@ -396,61 +404,6 @@ lstat (const char * path, struct stat * buf)
return stat (path, buf);
}
-/* Implementation of mkostemp for MS-Windows, to avoid race conditions
- when using mktemp. Copied from w32.c.
-
- This is used only in update-game-score.c. It is overkill for that
- use case, since update-game-score renames the temporary file into
- the game score file, which isn't atomic on MS-Windows anyway, when
- the game score already existed before running the program, which it
- almost always does. But using a simpler implementation just to
- make a point is uneconomical... */
-
-int
-mkostemp (char * template, int flags)
-{
- char * p;
- int i, fd = -1;
- unsigned uid = GetCurrentThreadId ();
- int save_errno = errno;
- static char first_char[] = "abcdefghijklmnopqrstuvwyz0123456789!%-_@#";
-
- errno = EINVAL;
- if (template == NULL)
- return -1;
-
- p = template + strlen (template);
- i = 5;
- /* replace up to the last 5 X's with uid in decimal */
- while (--p >= template && p[0] == 'X' && --i >= 0)
- {
- p[0] = '0' + uid % 10;
- uid /= 10;
- }
-
- if (i < 0 && p[0] == 'X')
- {
- i = 0;
- do
- {
- p[0] = first_char[i];
- if ((fd = open (template,
- flags | _O_CREAT | _O_EXCL | _O_RDWR,
- S_IRUSR | S_IWUSR)) >= 0
- || errno != EEXIST)
- {
- if (fd >= 0)
- errno = save_errno;
- return fd;
- }
- }
- while (++i < sizeof (first_char));
- }
-
- /* Template is badly formed or else we can't generate a unique name. */
- return -1;
-}
-
/* On Windows, you cannot rename into an existing file. */
int
sys_rename (const char *from, const char *to)
@@ -464,3 +417,9 @@ sys_rename (const char *from, const char *to)
}
return retval;
}
+
+int
+sys_open (const char * path, int oflag, int mode)
+{
+ return _open (path, oflag, mode);
+}
diff --git a/lib-src/ntlib.h b/lib-src/ntlib.h
index 32189dcc7a0..f7ee305e861 100644
--- a/lib-src/ntlib.h
+++ b/lib-src/ntlib.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <pwd.h>
#include <malloc.h>
@@ -58,10 +58,6 @@ int fchown (int fd, unsigned uid, unsigned gid);
#undef dup2
#define dup2 _dup2
#undef fopen
-#undef mkdir
-#define mkdir _mkdir
-#undef open
-#define open _open
#undef pipe
#define pipe _pipe
#undef read
diff --git a/lib-src/pop.c b/lib-src/pop.c
index 1a85bd23e7f..ba5ac6eb825 100644
--- a/lib-src/pop.c
+++ b/lib-src/pop.c
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib-src/pop.h b/lib-src/pop.h
index 474cf1a8dbc..81949851208 100644
--- a/lib-src/pop.h
+++ b/lib-src/pop.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <stdio.h>
diff --git a/lib-src/profile.c b/lib-src/profile.c
index 253f00e2d80..6308041fbce 100644
--- a/lib-src/profile.c
+++ b/lib-src/profile.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/**
@@ -34,11 +34,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <inttypes.h>
-#include <stdio.h>
#include <stdlib.h>
#include <intprops.h>
#include <systime.h>
+#include <unlocked-io.h>
static struct timespec TV1;
static int watch_not_started = 1; /* flag */
diff --git a/lib-src/rcs2log b/lib-src/rcs2log
index 1a1771b2b24..50276f245de 100755
--- a/lib-src/rcs2log
+++ b/lib-src/rcs2log
@@ -17,7 +17,7 @@
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
Copyright='Copyright (C) 2017 Free Software Foundation, Inc.
@@ -45,7 +45,7 @@ Each entry looks something like this:
* rcs2log (Help): Clarify wording of the usage message.
Problem reported by Alan Mackenzie in
- <http://mail.gnu.org/archive/html/bug-gnu-emacs/2004-04/msg00188.html>.
+ <https://mail.gnu.org/archive/html/bug-gnu-emacs/2004-04/msg00188.html>.
ChangeLog entries contain the current date, full name, email address
including hostname, the name of the affected file, and commentary.
diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c
index 5edc8e79569..5816edf1d24 100644
--- a/lib-src/update-game-score.c
+++ b/lib-src/update-game-score.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* This program allows a game to securely and atomically update a
@@ -39,7 +39,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <limits.h>
#include <string.h>
#include <stdlib.h>
-#include <stdio.h>
#include <time.h>
#include <pwd.h>
#include <ctype.h>
@@ -47,6 +46,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/stat.h>
#include <getopt.h>
+#include <unlocked-io.h>
+
#ifdef WINDOWSNT
#include "ntlib.h"
#endif
diff --git a/lib/COPYING b/lib/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/lib/COPYING
+++ b/lib/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/lib/Makefile.in b/lib/Makefile.in
index ee41ea3e55e..1f5b154f355 100644
--- a/lib/Makefile.in
+++ b/lib/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
srcdir = @srcdir@
VPATH = @srcdir@
diff --git a/lib/acl-errno-valid.c b/lib/acl-errno-valid.c
index a633985663b..1e96974dd12 100644
--- a/lib/acl-errno-valid.c
+++ b/lib/acl-errno-valid.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert. */
diff --git a/lib/acl-internal.c b/lib/acl-internal.c
index 2a2dee947d3..63e6b6b997c 100644
--- a/lib/acl-internal.c
+++ b/lib/acl-internal.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
diff --git a/lib/acl-internal.h b/lib/acl-internal.h
index e7bda0eadeb..ebd24217bb6 100644
--- a/lib/acl-internal.h
+++ b/lib/acl-internal.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
diff --git a/lib/acl.h b/lib/acl.h
index b13370c5912..d3b048022e3 100644
--- a/lib/acl.h
+++ b/lib/acl.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert. */
diff --git a/lib/acl_entries.c b/lib/acl_entries.c
index 1df6a844dfe..c7efaefd52f 100644
--- a/lib/acl_entries.c
+++ b/lib/acl_entries.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert and Andreas Gruenbacher. */
diff --git a/lib/alloca.in.h b/lib/alloca.in.h
index c3dc38a5b94..1881e74f5dc 100644
--- a/lib/alloca.in.h
+++ b/lib/alloca.in.h
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with this program; if not, see
- <http://www.gnu.org/licenses/>.
+ <https://www.gnu.org/licenses/>.
*/
/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H
diff --git a/lib/allocator.h b/lib/allocator.h
index 650f8e071ea..fc3d646aa54 100644
--- a/lib/allocator.h
+++ b/lib/allocator.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
@@ -29,7 +29,7 @@ struct allocator
/* Do not use GCC attributes such as __attribute__ ((malloc)) with
the function types pointed at by these members, because these
attributes do not work with pointers to functions. See
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-04/msg00007.html>. */
+ <https://lists.gnu.org/r/bug-gnulib/2011-04/msg00007.html>. */
/* Call ALLOCATE to allocate memory, like 'malloc'. On failure ALLOCATE
should return NULL, though not necessarily set errno. When given
diff --git a/lib/arg-nonnull.h b/lib/arg-nonnull.h
index 1e62cc89827..61ee0712747 100644
--- a/lib/arg-nonnull.h
+++ b/lib/arg-nonnull.h
@@ -12,7 +12,7 @@
General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools
that the values passed as arguments n, ..., m must be non-NULL pointers.
diff --git a/lib/at-func.c b/lib/at-func.c
index 9eaa9932fab..2a3e375e9a2 100644
--- a/lib/at-func.c
+++ b/lib/at-func.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/binary-io.c b/lib/binary-io.c
index a7558b20fd1..2cee469781c 100644
--- a/lib/binary-io.c
+++ b/lib/binary-io.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/binary-io.h b/lib/binary-io.h
index 9f1dde108eb..75adb33c918 100644
--- a/lib/binary-io.h
+++ b/lib/binary-io.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _BINARY_H
#define _BINARY_H
diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h
index 5fc0663defa..32385a289c6 100644
--- a/lib/byteswap.in.h
+++ b/lib/byteswap.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _GL_BYTESWAP_H
#define _GL_BYTESWAP_H
diff --git a/lib/c++defs.h b/lib/c++defs.h
index f03f3591c35..09dcd3e0687 100644
--- a/lib/c++defs.h
+++ b/lib/c++defs.h
@@ -12,7 +12,7 @@
General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _GL_CXXDEFS_H
#define _GL_CXXDEFS_H
@@ -266,7 +266,7 @@
_GL_CXXALIASWARN_1 (func, GNULIB_NAMESPACE)
# define _GL_CXXALIASWARN_1(func,namespace) \
_GL_CXXALIASWARN_2 (func, namespace)
-/* To work around GCC bug <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
+/* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
we enable the warning only when not optimizing. */
# if !__OPTIMIZE__
# define _GL_CXXALIASWARN_2(func,namespace) \
@@ -294,7 +294,7 @@
GNULIB_NAMESPACE)
# define _GL_CXXALIASWARN1_1(func,rettype,parameters_and_attributes,namespace) \
_GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace)
-/* To work around GCC bug <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
+/* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>,
we enable the warning only when not optimizing. */
# if !__OPTIMIZE__
# define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \
diff --git a/lib/c-ctype.h b/lib/c-ctype.h
index bcdba6b9962..9ad3c18d471 100644
--- a/lib/c-ctype.h
+++ b/lib/c-ctype.h
@@ -18,7 +18,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program; if not, see <http://www.gnu.org/licenses/>. */
+along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef C_CTYPE_H
#define C_CTYPE_H
diff --git a/lib/c-strcase.h b/lib/c-strcase.h
index c82dab1dbe6..220d21d34ec 100644
--- a/lib/c-strcase.h
+++ b/lib/c-strcase.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef C_STRCASE_H
#define C_STRCASE_H
diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c
index 5bce873d7b2..b2880a2e6c7 100644
--- a/lib/c-strcasecmp.c
+++ b/lib/c-strcasecmp.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c
index ada62d70b7b..982e17915bc 100644
--- a/lib/c-strncasecmp.c
+++ b/lib/c-strncasecmp.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index 455e00efe00..e2af54f0984 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */
diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h
index 528a8289e56..d436c691eaa 100644
--- a/lib/careadlinkat.h
+++ b/lib/careadlinkat.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */
diff --git a/lib/cloexec.c b/lib/cloexec.c
new file mode 100644
index 00000000000..2b67a0102e7
--- /dev/null
+++ b/lib/cloexec.c
@@ -0,0 +1,83 @@
+/* cloexec.c - set or clear the close-on-exec descriptor flag
+
+ Copyright (C) 1991, 2004-2006, 2009-2017 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/>.
+
+ The code is taken from glibc/manual/llio.texi */
+
+#include <config.h>
+
+#include "cloexec.h"
+
+#include <errno.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+/* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true,
+ or clear the flag if VALUE is false.
+ Return 0 on success, or -1 on error with 'errno' set.
+
+ Note that on MingW, this function does NOT protect DESC from being
+ inherited into spawned children. Instead, either use dup_cloexec
+ followed by closing the original DESC, or use interfaces such as
+ open or pipe2 that accept flags like O_CLOEXEC to create DESC
+ non-inheritable in the first place. */
+
+int
+set_cloexec_flag (int desc, bool value)
+{
+#ifdef F_SETFD
+
+ int flags = fcntl (desc, F_GETFD, 0);
+
+ if (0 <= flags)
+ {
+ int newflags = (value ? flags | FD_CLOEXEC : flags & ~FD_CLOEXEC);
+
+ if (flags == newflags
+ || fcntl (desc, F_SETFD, newflags) != -1)
+ return 0;
+ }
+
+ return -1;
+
+#else /* !F_SETFD */
+
+ /* Use dup2 to reject invalid file descriptors; the cloexec flag
+ will be unaffected. */
+ if (desc < 0)
+ {
+ errno = EBADF;
+ return -1;
+ }
+ if (dup2 (desc, desc) < 0)
+ /* errno is EBADF here. */
+ return -1;
+
+ /* There is nothing we can do on this kind of platform. Punt. */
+ return 0;
+#endif /* !F_SETFD */
+}
+
+
+/* Duplicates a file handle FD, while marking the copy to be closed
+ prior to exec or spawn. Returns -1 and sets errno if FD could not
+ be duplicated. */
+
+int
+dup_cloexec (int fd)
+{
+ return fcntl (fd, F_DUPFD_CLOEXEC, 0);
+}
diff --git a/lib/cloexec.h b/lib/cloexec.h
new file mode 100644
index 00000000000..d937a406817
--- /dev/null
+++ b/lib/cloexec.h
@@ -0,0 +1,38 @@
+/* cloexec.c - set or clear the close-on-exec descriptor flag
+
+ Copyright (C) 2004, 2009-2017 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 <stdbool.h>
+
+/* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true,
+ or clear the flag if VALUE is false.
+ Return 0 on success, or -1 on error with 'errno' set.
+
+ Note that on MingW, this function does NOT protect DESC from being
+ inherited into spawned children. Instead, either use dup_cloexec
+ followed by closing the original DESC, or use interfaces such as
+ open or pipe2 that accept flags like O_CLOEXEC to create DESC
+ non-inheritable in the first place. */
+
+int set_cloexec_flag (int desc, bool value);
+
+/* Duplicates a file handle FD, while marking the copy to be closed
+ prior to exec or spawn. Returns -1 and sets errno if FD could not
+ be duplicated. */
+
+int dup_cloexec (int fd);
diff --git a/lib/close-stream.c b/lib/close-stream.c
index 96c126536cc..19707626fa2 100644
--- a/lib/close-stream.c
+++ b/lib/close-stream.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h
index e197137e66e..c8b3dc05110 100644
--- a/lib/count-leading-zeros.h
+++ b/lib/count-leading-zeros.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Eric Blake. */
@@ -70,7 +70,8 @@ _GL_INLINE_HEADER_BEGIN
COUNT_LEADING_ZEROS_INLINE int
count_leading_zeros_32 (unsigned int x)
{
- /* http://graphics.stanford.edu/~seander/bithacks.html */
+ /* <https://github.com/gibsjose/BitHacks>
+ <http://www.fit.vutbr.cz/~ibarina/pub/bithacks.pdf> */
static const char de_Bruijn_lookup[32] = {
31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1,
23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0
diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h
index fb5fb927ff4..1576b08481b 100644
--- a/lib/count-one-bits.h
+++ b/lib/count-one-bits.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Ben Pfaff. */
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h
index 4a0a109d991..9f9f07f5a0d 100644
--- a/lib/count-trailing-zeros.h
+++ b/lib/count-trailing-zeros.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
@@ -68,7 +68,8 @@ _GL_INLINE_HEADER_BEGIN
COUNT_TRAILING_ZEROS_INLINE int
count_trailing_zeros_32 (unsigned int x)
{
- /* http://graphics.stanford.edu/~seander/bithacks.html */
+ /* <https://github.com/gibsjose/BitHacks>
+ <http://www.fit.vutbr.cz/~ibarina/pub/bithacks.pdf> */
static const char de_Bruijn_lookup[32] = {
0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,
31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
diff --git a/lib/diffseq.h b/lib/diffseq.h
index d7a374357c7..b6f9f6f9d19 100644
--- a/lib/diffseq.h
+++ b/lib/diffseq.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* The basic idea is to consider two vectors as similar if, when
@@ -279,6 +279,11 @@ diag (OFFSET xoff, OFFSET xlim, OFFSET yoff, OFFSET ylim, bool find_minimal,
continue;
#ifdef USE_HEURISTIC
+ bool heuristic = ctxt->heuristic;
+#else
+ bool heuristic = false;
+#endif
+
/* Heuristic: check occasionally for a diagonal that has made lots
of progress compared with the edit distance. If we have any
such, find the one that has made the most progress and return it
@@ -287,7 +292,7 @@ diag (OFFSET xoff, OFFSET xlim, OFFSET yoff, OFFSET ylim, bool find_minimal,
With this heuristic, for vectors with a constant small density
of changes, the algorithm is linear in the vector size. */
- if (200 < c && big_snake && ctxt->heuristic)
+ if (200 < c && big_snake && heuristic)
{
{
OFFSET best = 0;
@@ -367,7 +372,6 @@ diag (OFFSET xoff, OFFSET xlim, OFFSET yoff, OFFSET ylim, bool find_minimal,
}
}
}
-#endif /* USE_HEURISTIC */
/* Heuristic: if we've gone well beyond the call of duty, give up
and report halfway between our best results so far. */
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index f59178751b1..5b235731e04 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_DIRENT_H
diff --git a/lib/dirfd.c b/lib/dirfd.c
index 6b1a7b27443..7e38fabdac2 100644
--- a/lib/dirfd.c
+++ b/lib/dirfd.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Jim Meyering. */
diff --git a/lib/dosname.h b/lib/dosname.h
index dd5c177725c..255d57e4d6b 100644
--- a/lib/dosname.h
+++ b/lib/dosname.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
From Paul Eggert and Jim Meyering. */
diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c
index 3ca5a9cfd35..8f2e8150c9b 100644
--- a/lib/dtotimespec.c
+++ b/lib/dtotimespec.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Paul Eggert */
diff --git a/lib/dup2.c b/lib/dup2.c
index 002dc8c76cb..85c1a44401a 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Paul Eggert */
@@ -88,7 +88,7 @@ ms_windows_dup2 (int fd, int desired_fd)
}
/* Wine 1.0.1 return 0 when desired_fd is negative but not -1:
- http://bugs.winehq.org/show_bug.cgi?id=21289 */
+ https://bugs.winehq.org/show_bug.cgi?id=21289 */
if (desired_fd < 0)
{
errno = EBADF;
diff --git a/lib/errno.in.h b/lib/errno.in.h
index 13194f9d291..aaf5fecd73b 100644
--- a/lib/errno.in.h
+++ b/lib/errno.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_ERRNO_H
diff --git a/lib/euidaccess.c b/lib/euidaccess.c
index da2bda9be0c..298c4459477 100644
--- a/lib/euidaccess.c
+++ b/lib/euidaccess.c
@@ -16,7 +16,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by David MacKenzie and Torbjorn Granlund.
Adapted for GNU C library by Roland McGrath. */
diff --git a/lib/execinfo.in.h b/lib/execinfo.in.h
index 065a78dbffa..f2269269c53 100644
--- a/lib/execinfo.in.h
+++ b/lib/execinfo.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
new file mode 100644
index 00000000000..09093467769
--- /dev/null
+++ b/lib/explicit_bzero.c
@@ -0,0 +1,48 @@
+/* Erasure of sensitive data, generic implementation.
+ Copyright (C) 2016-2017 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/>. */
+
+/* An assembler implementation of explicit_bzero can be created as an
+ assembler alias of an optimized bzero implementation.
+ Architecture-specific implementations also need to define
+ __explicit_bzero_chk. */
+
+#if !_LIBC
+# include <config.h>
+#endif
+
+#include <string.h>
+
+/* glibc-internal users use __explicit_bzero_chk, and explicit_bzero
+ redirects to that. */
+#undef explicit_bzero
+
+/* Set LEN bytes of S to 0. The compiler will not delete a call to
+ this function, even if S is dead after the call. */
+void
+explicit_bzero (void *s, size_t len)
+{
+#ifdef HAVE_EXPLICIT_MEMSET
+ explicit_memset (s, 0, len);
+#else
+ memset (s, '\0', len);
+# ifdef __GNUC__
+ /* Compiler barrier. */
+ asm volatile ("" ::: "memory");
+# endif
+#endif
+}
diff --git a/lib/faccessat.c b/lib/faccessat.c
index f9458e83039..fa9235820dc 100644
--- a/lib/faccessat.c
+++ b/lib/faccessat.c
@@ -12,14 +12,35 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Eric Blake */
+/* If the user's config.h happens to include <unistd.h>, let it include only
+ the system's <unistd.h> here, so that orig_faccessat doesn't recurse to
+ rpl_faccessat. */
+#define _GL_INCLUDING_UNISTD_H
#include <config.h>
#include <unistd.h>
+#include <errno.h>
#include <fcntl.h>
+#include <string.h>
+#include <sys/stat.h>
+#undef _GL_INCLUDING_UNISTD_H
+
+#if HAVE_FACCESSAT
+static int
+orig_faccessat (int fd, char const *name, int mode, int flag)
+{
+ return faccessat (fd, name, mode, flag);
+}
+#endif
+
+/* Write "unistd.h" here, not <unistd.h>, otherwise OSF/1 5.1 DTK cc
+ eliminates this include because of the preliminary #include <unistd.h>
+ above. */
+#include "unistd.h"
#ifndef HAVE_ACCESS
/* Mingw lacks access, but it also lacks real vs. effective ids, so
@@ -28,6 +49,29 @@
# define access euidaccess
#endif
+#if HAVE_FACCESSAT
+
+int
+rpl_faccessat (int fd, char const *file, int mode, int flag)
+{
+ int result = orig_faccessat (fd, file, mode, flag);
+
+ if (result == 0 && file[strlen (file) - 1] == '/')
+ {
+ struct stat st;
+ result = fstatat (fd, file, &st, 0);
+ if (result == 0 && !S_ISDIR (st.st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+
+ return result;
+}
+
+#else /* !HAVE_FACCESSAT */
+
/* Invoke access or euidaccess on file, FILE, using mode MODE, in the directory
open on descriptor FD. If possible, do it without changing the
working directory. Otherwise, resort to using save_cwd/fchdir, then
@@ -36,10 +80,12 @@
Note that this implementation only supports AT_EACCESS, although some
native versions also support AT_SYMLINK_NOFOLLOW. */
-#define AT_FUNC_NAME faccessat
-#define AT_FUNC_F1 euidaccess
-#define AT_FUNC_F2 access
-#define AT_FUNC_USE_F1_COND AT_EACCESS
-#define AT_FUNC_POST_FILE_PARAM_DECLS , int mode, int flag
-#define AT_FUNC_POST_FILE_ARGS , mode
-#include "at-func.c"
+# define AT_FUNC_NAME faccessat
+# define AT_FUNC_F1 euidaccess
+# define AT_FUNC_F2 access
+# define AT_FUNC_USE_F1_COND AT_EACCESS
+# define AT_FUNC_POST_FILE_PARAM_DECLS , int mode, int flag
+# define AT_FUNC_POST_FILE_ARGS , mode
+# include "at-func.c"
+
+#endif
diff --git a/lib/fcntl.c b/lib/fcntl.c
index d4dd144e05d..91efd12c2ba 100644
--- a/lib/fcntl.c
+++ b/lib/fcntl.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Eric Blake <ebb9@byu.net>. */
diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h
index 4a1d40af6df..00b270c958d 100644
--- a/lib/fcntl.in.h
+++ b/lib/fcntl.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Paul Eggert */
@@ -213,7 +213,10 @@ _GL_WARN_ON_USE (openat, "openat is not portable - "
#endif
#ifndef O_CLOEXEC
-# define O_CLOEXEC 0
+# define O_CLOEXEC 0x40000000 /* Try to not collide with system O_* flags. */
+# define GNULIB_defined_O_CLOEXEC 1
+#else
+# define GNULIB_defined_O_CLOEXEC 0
#endif
#ifndef O_DIRECT
diff --git a/lib/fdatasync.c b/lib/fdatasync.c
index 6875fa4c69c..25fd74049fb 100644
--- a/lib/fdatasync.c
+++ b/lib/fdatasync.c
@@ -13,7 +13,7 @@
General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <unistd.h>
diff --git a/lib/fdopendir.c b/lib/fdopendir.c
index 03be92adc1f..7f72258598d 100644
--- a/lib/fdopendir.c
+++ b/lib/fdopendir.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/filemode.c b/lib/filemode.c
index d62f70bc9bd..c6cf1f3196c 100644
--- a/lib/filemode.c
+++ b/lib/filemode.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/filemode.h b/lib/filemode.h
index 5fbb79146d8..809bf7eb0fb 100644
--- a/lib/filemode.h
+++ b/lib/filemode.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef FILEMODE_H_
diff --git a/lib/filevercmp.c b/lib/filevercmp.c
index 0396867c7e5..4026097b38e 100644
--- a/lib/filevercmp.c
+++ b/lib/filevercmp.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include "filevercmp.h"
@@ -79,7 +79,7 @@ order (unsigned char c)
specification can be found in the Debian Policy Manual in the
section on the 'Version' control field. This version of the code
implements that from s5.6.12 of Debian Policy v3.8.0.1
- http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */
+ https://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */
static int _GL_ATTRIBUTE_PURE
verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len)
{
diff --git a/lib/filevercmp.h b/lib/filevercmp.h
index d6989911726..25cc6f624cd 100644
--- a/lib/filevercmp.h
+++ b/lib/filevercmp.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef FILEVERCMP_H
#define FILEVERCMP_H
diff --git a/lib/flexmember.h b/lib/flexmember.h
index c71ea651036..7e4f95d3c89 100644
--- a/lib/flexmember.h
+++ b/lib/flexmember.h
@@ -2,18 +2,21 @@
Copyright 2016-2017 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 file is part of the GNU C Library.
- This program is distributed in the hope that it will be useful,
+ 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.
+ 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/>.
+ 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/>.
Written by Paul Eggert. */
diff --git a/lib/fpending.c b/lib/fpending.c
index c9b77866858..5811a4a7475 100644
--- a/lib/fpending.c
+++ b/lib/fpending.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Jim Meyering. */
@@ -41,7 +41,7 @@ __fpending (FILE *fp)
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 */
+#elif defined _IOERR /* AIX, HP-UX, IRIX, OSF/1, Solaris, OpenServer, 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);
@@ -51,8 +51,6 @@ __fpending (FILE *fp)
return fp->__bufp - fp->__buffer;
#elif defined EPLAN9 /* Plan9 */
return fp->wp - fp->buf;
-#elif defined __VMS /* VMS */
- return (*fp)->_ptr - (*fp)->_base;
#else
# error "Please port gnulib fpending.c to your platform!"
return 1;
diff --git a/lib/fpending.h b/lib/fpending.h
index a901deee4b0..73c7d795c18 100644
--- a/lib/fpending.h
+++ b/lib/fpending.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Jim Meyering. */
diff --git a/lib/fstatat.c b/lib/fstatat.c
index 70799bebcd3..237e68c5da7 100644
--- a/lib/fstatat.c
+++ b/lib/fstatat.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert and Jim Meyering. */
@@ -28,7 +28,7 @@
#include <sys/stat.h>
#undef __need_system_sys_stat_h
-#if HAVE_FSTATAT
+#if HAVE_FSTATAT && HAVE_WORKING_FSTATAT_ZERO_FLAG
static int
orig_fstatat (int fd, char const *filename, struct stat *buf, int flags)
{
@@ -41,6 +41,8 @@ orig_fstatat (int fd, char const *filename, struct stat *buf, int flags)
above. */
#include "sys/stat.h"
+#include "stat-time.h"
+
#include <errno.h>
#include <fcntl.h>
#include <string.h>
@@ -51,6 +53,12 @@ orig_fstatat (int fd, char const *filename, struct stat *buf, int flags)
# define LSTAT_FOLLOWS_SLASHED_SYMLINK 0
# endif
+static int
+normal_fstatat (int fd, char const *file, struct stat *st, int flag)
+{
+ return stat_time_normalize (orig_fstatat (fd, file, st, flag), st);
+}
+
/* fstatat should always follow symbolic links that end in /, but on
Solaris 9 it doesn't if AT_SYMLINK_NOFOLLOW is specified.
Likewise, trailing slash on a non-directory should be an error.
@@ -63,7 +71,7 @@ orig_fstatat (int fd, char const *filename, struct stat *buf, int flags)
int
rpl_fstatat (int fd, char const *file, struct stat *st, int flag)
{
- int result = orig_fstatat (fd, file, st, flag);
+ int result = normal_fstatat (fd, file, st, flag);
size_t len;
if (LSTAT_FOLLOWS_SLASHED_SYMLINK || result != 0)
@@ -79,7 +87,7 @@ rpl_fstatat (int fd, char const *file, struct stat *st, int flag)
errno = ENOTDIR;
return -1;
}
- result = orig_fstatat (fd, file, st, flag & ~AT_SYMLINK_NOFOLLOW);
+ result = normal_fstatat (fd, file, st, flag & ~AT_SYMLINK_NOFOLLOW);
}
/* Fix stat behavior. */
if (result == 0 && !S_ISDIR (st->st_mode) && file[len - 1] == '/')
@@ -111,7 +119,7 @@ stat_func (char const *name, struct stat *st)
# endif
/* Replacement for Solaris' function by the same name.
- <http://www.google.com/search?q=fstatat+site:docs.sun.com>
+ <https://www.google.com/search?q=fstatat+site:docs.oracle.com>
First, try to simulate it via l?stat ("/proc/self/fd/FD/FILE").
Failing that, simulate it via save_cwd/fchdir/(stat|lstat)/restore_cwd.
If either the save_cwd or the restore_cwd fails (relatively unlikely),
diff --git a/lib/fsusage.c b/lib/fsusage.c
new file mode 100644
index 00000000000..b670c0c43a1
--- /dev/null
+++ b/lib/fsusage.c
@@ -0,0 +1,287 @@
+/* fsusage.c -- return space usage of mounted file systems
+
+ Copyright (C) 1991-1992, 1996, 1998-1999, 2002-2006, 2009-2017 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>
+
+#include "fsusage.h"
+
+#include <limits.h>
+#include <sys/types.h>
+
+#if STAT_STATVFS || STAT_STATVFS64 /* POSIX 1003.1-2001 (and later) with XSI */
+# include <sys/statvfs.h>
+#else
+/* Don't include backward-compatibility files unless they're needed.
+ Eventually we'd like to remove all this cruft. */
+# include <fcntl.h>
+# include <unistd.h>
+# include <sys/stat.h>
+#if HAVE_SYS_PARAM_H
+# include <sys/param.h>
+#endif
+#if HAVE_SYS_MOUNT_H
+# include <sys/mount.h>
+#endif
+#if HAVE_SYS_VFS_H
+# include <sys/vfs.h>
+#endif
+# if HAVE_SYS_FS_S5PARAM_H /* Fujitsu UXP/V */
+# include <sys/fs/s5param.h>
+# endif
+# if HAVE_SYS_STATFS_H
+# include <sys/statfs.h>
+# endif
+# if HAVE_DUSTAT_H /* AIX PS/2 */
+# include <sys/dustat.h>
+# endif
+#endif
+
+/* Many space usage primitives use all 1 bits to denote a value that is
+ not applicable or unknown. Propagate this information by returning
+ a uintmax_t value that is all 1 bits if X is all 1 bits, even if X
+ is unsigned and narrower than uintmax_t. */
+#define PROPAGATE_ALL_ONES(x) \
+ ((sizeof (x) < sizeof (uintmax_t) \
+ && (~ (x) == (sizeof (x) < sizeof (int) \
+ ? - (1 << (sizeof (x) * CHAR_BIT)) \
+ : 0))) \
+ ? UINTMAX_MAX : (uintmax_t) (x))
+
+/* Extract the top bit of X as an uintmax_t value. */
+#define EXTRACT_TOP_BIT(x) ((x) \
+ & ((uintmax_t) 1 << (sizeof (x) * CHAR_BIT - 1)))
+
+/* If a value is negative, many space usage primitives store it into an
+ integer variable by assignment, even if the variable's type is unsigned.
+ So, if a space usage variable X's top bit is set, convert X to the
+ uintmax_t value V such that (- (uintmax_t) V) is the negative of
+ the original value. If X's top bit is clear, just yield X.
+ Use PROPAGATE_TOP_BIT if the original value might be negative;
+ otherwise, use PROPAGATE_ALL_ONES. */
+#define PROPAGATE_TOP_BIT(x) ((x) | ~ (EXTRACT_TOP_BIT (x) - 1))
+
+#ifdef STAT_STATVFS
+/* Return true if statvfs works. This is false for statvfs on systems
+ with GNU libc on Linux kernels before 2.6.36, which stats all
+ preceding entries in /proc/mounts; that makes df hang if even one
+ of the corresponding file systems is hard-mounted but not available. */
+# if ! (__linux__ && (__GLIBC__ || __UCLIBC__))
+/* The FRSIZE fallback is not required in this case. */
+# undef STAT_STATFS2_FRSIZE
+static int statvfs_works (void) { return 1; }
+# else
+# include <string.h> /* for strverscmp */
+# include <sys/utsname.h>
+# include <sys/statfs.h>
+# define STAT_STATFS2_BSIZE 1
+
+static int
+statvfs_works (void)
+{
+ static int statvfs_works_cache = -1;
+ struct utsname name;
+ if (statvfs_works_cache < 0)
+ statvfs_works_cache = (uname (&name) == 0
+ && 0 <= strverscmp (name.release, "2.6.36"));
+ return statvfs_works_cache;
+}
+# endif
+#endif
+
+
+/* Fill in the fields of FSP with information about space usage for
+ the file system on which FILE resides.
+ DISK is the device on which FILE is mounted, for space-getting
+ methods that need to know it.
+ Return 0 if successful, -1 if not. When returning -1, ensure that
+ ERRNO is either a system error value, or zero if DISK is NULL
+ on a system that requires a non-NULL value. */
+int
+get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp)
+{
+#ifdef STAT_STATVFS /* POSIX, except pre-2.6.36 glibc/Linux */
+
+ if (statvfs_works ())
+ {
+ struct statvfs vfsd;
+
+ if (statvfs (file, &vfsd) < 0)
+ return -1;
+
+ /* f_frsize isn't guaranteed to be supported. */
+ fsp->fsu_blocksize = (vfsd.f_frsize
+ ? PROPAGATE_ALL_ONES (vfsd.f_frsize)
+ : PROPAGATE_ALL_ONES (vfsd.f_bsize));
+
+ fsp->fsu_blocks = PROPAGATE_ALL_ONES (vfsd.f_blocks);
+ fsp->fsu_bfree = PROPAGATE_ALL_ONES (vfsd.f_bfree);
+ fsp->fsu_bavail = PROPAGATE_TOP_BIT (vfsd.f_bavail);
+ fsp->fsu_bavail_top_bit_set = EXTRACT_TOP_BIT (vfsd.f_bavail) != 0;
+ fsp->fsu_files = PROPAGATE_ALL_ONES (vfsd.f_files);
+ fsp->fsu_ffree = PROPAGATE_ALL_ONES (vfsd.f_ffree);
+ return 0;
+ }
+
+#endif
+
+#if defined STAT_STATVFS64 /* AIX */
+
+ struct statvfs64 fsd;
+
+ if (statvfs64 (file, &fsd) < 0)
+ return -1;
+
+ /* f_frsize isn't guaranteed to be supported. */
+ fsp->fsu_blocksize = (fsd.f_frsize
+ ? PROPAGATE_ALL_ONES (fsd.f_frsize)
+ : PROPAGATE_ALL_ONES (fsd.f_bsize));
+
+#elif defined STAT_STATFS2_FS_DATA /* Ultrix */
+
+ struct fs_data fsd;
+
+ if (statfs (file, &fsd) != 1)
+ return -1;
+
+ fsp->fsu_blocksize = 1024;
+ fsp->fsu_blocks = PROPAGATE_ALL_ONES (fsd.fd_req.btot);
+ fsp->fsu_bfree = PROPAGATE_ALL_ONES (fsd.fd_req.bfree);
+ fsp->fsu_bavail = PROPAGATE_TOP_BIT (fsd.fd_req.bfreen);
+ fsp->fsu_bavail_top_bit_set = EXTRACT_TOP_BIT (fsd.fd_req.bfreen) != 0;
+ fsp->fsu_files = PROPAGATE_ALL_ONES (fsd.fd_req.gtot);
+ fsp->fsu_ffree = PROPAGATE_ALL_ONES (fsd.fd_req.gfree);
+
+#elif defined STAT_STATFS3_OSF1 /* OSF/1 */
+
+ struct statfs fsd;
+
+ if (statfs (file, &fsd, sizeof (struct statfs)) != 0)
+ return -1;
+
+ fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_fsize);
+
+#elif defined STAT_STATFS2_FRSIZE /* 2.6 < glibc/Linux < 2.6.36 */
+
+ struct statfs fsd;
+
+ if (statfs (file, &fsd) < 0)
+ return -1;
+
+ fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_frsize);
+
+#elif defined STAT_STATFS2_BSIZE /* glibc/Linux < 2.6, 4.3BSD, SunOS 4, \
+ Mac OS X < 10.4, FreeBSD < 5.0, \
+ NetBSD < 3.0, OpenBSD < 4.4 */
+
+ struct statfs fsd;
+
+ if (statfs (file, &fsd) < 0)
+ return -1;
+
+ fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_bsize);
+
+# ifdef STATFS_TRUNCATES_BLOCK_COUNTS
+
+ /* In SunOS 4.1.2, 4.1.3, and 4.1.3_U1, the block counts in the
+ struct statfs are truncated to 2GB. These conditions detect that
+ truncation, presumably without botching the 4.1.1 case, in which
+ the values are not truncated. The correct counts are stored in
+ undocumented spare fields. */
+ if (fsd.f_blocks == 0x7fffffff / fsd.f_bsize && fsd.f_spare[0] > 0)
+ {
+ fsd.f_blocks = fsd.f_spare[0];
+ fsd.f_bfree = fsd.f_spare[1];
+ fsd.f_bavail = fsd.f_spare[2];
+ }
+# endif /* STATFS_TRUNCATES_BLOCK_COUNTS */
+
+#elif defined STAT_STATFS2_FSIZE /* 4.4BSD and older NetBSD */
+
+ struct statfs fsd;
+
+ if (statfs (file, &fsd) < 0)
+ return -1;
+
+ fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_fsize);
+
+#elif defined STAT_STATFS4 /* SVR3, Dynix, old Irix, old AIX, \
+ Dolphin */
+
+# if !_AIX && !defined _SEQUENT_ && !defined DOLPHIN
+# define f_bavail f_bfree
+# endif
+
+ struct statfs fsd;
+
+ if (statfs (file, &fsd, sizeof fsd, 0) < 0)
+ return -1;
+
+ /* Empirically, the block counts on most SVR3 and SVR3-derived
+ systems seem to always be in terms of 512-byte blocks,
+ no matter what value f_bsize has. */
+# if _AIX || defined _CRAY
+ fsp->fsu_blocksize = PROPAGATE_ALL_ONES (fsd.f_bsize);
+# else
+ fsp->fsu_blocksize = 512;
+# endif
+
+#endif
+
+#if (defined STAT_STATVFS64 || defined STAT_STATFS3_OSF1 \
+ || defined STAT_STATFS2_FRSIZE || defined STAT_STATFS2_BSIZE \
+ || defined STAT_STATFS2_FSIZE || defined STAT_STATFS4)
+
+ fsp->fsu_blocks = PROPAGATE_ALL_ONES (fsd.f_blocks);
+ fsp->fsu_bfree = PROPAGATE_ALL_ONES (fsd.f_bfree);
+ fsp->fsu_bavail = PROPAGATE_TOP_BIT (fsd.f_bavail);
+ fsp->fsu_bavail_top_bit_set = EXTRACT_TOP_BIT (fsd.f_bavail) != 0;
+ fsp->fsu_files = PROPAGATE_ALL_ONES (fsd.f_files);
+ fsp->fsu_ffree = PROPAGATE_ALL_ONES (fsd.f_ffree);
+
+#endif
+
+ (void) disk; /* avoid argument-unused warning */
+ return 0;
+}
+
+#if defined _AIX && defined _I386
+/* AIX PS/2 does not supply statfs. */
+
+int
+statfs (char *file, struct statfs *fsb)
+{
+ struct stat stats;
+ struct dustat fsd;
+
+ if (stat (file, &stats) != 0)
+ return -1;
+ if (dustat (stats.st_dev, 0, &fsd, sizeof (fsd)))
+ return -1;
+ fsb->f_type = 0;
+ fsb->f_bsize = fsd.du_bsize;
+ fsb->f_blocks = fsd.du_fsize - fsd.du_isize;
+ fsb->f_bfree = fsd.du_tfree;
+ fsb->f_bavail = fsd.du_tfree;
+ fsb->f_files = (fsd.du_isize - 2) * fsd.du_inopb;
+ fsb->f_ffree = fsd.du_tinode;
+ fsb->f_fsid.val[0] = fsd.du_site;
+ fsb->f_fsid.val[1] = fsd.du_pckno;
+ return 0;
+}
+
+#endif /* _AIX && _I386 */
diff --git a/lib/fsusage.h b/lib/fsusage.h
new file mode 100644
index 00000000000..f78edc6a0cb
--- /dev/null
+++ b/lib/fsusage.h
@@ -0,0 +1,40 @@
+/* fsusage.h -- declarations for file system space usage info
+
+ Copyright (C) 1991-1992, 1997, 2003-2006, 2009-2017 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/>. */
+
+/* Space usage statistics for a file system. Blocks are 512-byte. */
+
+#if !defined FSUSAGE_H_
+# define FSUSAGE_H_
+
+# include <stdint.h>
+# include <stdbool.h>
+
+struct fs_usage
+{
+ uintmax_t fsu_blocksize; /* Size of a block. */
+ uintmax_t fsu_blocks; /* Total blocks. */
+ uintmax_t fsu_bfree; /* Free blocks available to superuser. */
+ uintmax_t fsu_bavail; /* Free blocks available to non-superuser. */
+ bool fsu_bavail_top_bit_set; /* 1 if fsu_bavail represents a value < 0. */
+ uintmax_t fsu_files; /* Total file nodes. */
+ uintmax_t fsu_ffree; /* Free file nodes. */
+};
+
+int get_fs_usage (char const *file, char const *disk, struct fs_usage *fsp);
+
+#endif
diff --git a/lib/fsync.c b/lib/fsync.c
index 5a4945ef2bf..c25f1db6575 100644
--- a/lib/fsync.c
+++ b/lib/fsync.c
@@ -2,8 +2,8 @@
cross-compilers like MinGW.
This is derived from sqlite3 sources.
- http://www.sqlite.org/cvstrac/rlog?f=sqlite/src/os_win.c
- http://www.sqlite.org/copyright.html
+ https://www.sqlite.org/src/finfo?name=src/os_win.c
+ https://www.sqlite.org/copyright.html
Written by Richard W.M. Jones <rjones.at.redhat.com>
@@ -20,7 +20,7 @@
General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <unistd.h>
diff --git a/lib/ftoastr.c b/lib/ftoastr.c
index f2434161db8..bcc79f03673 100644
--- a/lib/ftoastr.c
+++ b/lib/ftoastr.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
@@ -108,7 +108,7 @@ FTOASTR (char *buf, size_t bufsize, int flags, int width, FLOAT x)
Andrysco M, Jhala R, Lerner S. Printing floating-point numbers:
a faster, always correct method. ACM SIGPLAN notices - POPL '16.
2016;51(1):555-67 <http://dx.doi.org/10.1145/2914770.2837654>; draft at
- <http://cseweb.ucsd.edu/~lerner/papers/fp-printing-popl16.pdf>. */
+ <https://cseweb.ucsd.edu/~lerner/papers/fp-printing-popl16.pdf>. */
PROMOTED_FLOAT promoted_x = x;
char format[sizeof "%-+ 0*.*Lg"];
diff --git a/lib/ftoastr.h b/lib/ftoastr.h
index 74a855ac21a..f73712c9415 100644
--- a/lib/ftoastr.h
+++ b/lib/ftoastr.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
@@ -96,7 +96,7 @@ enum
DIG digits. For why the "+ 1" is needed, see "Binary to Decimal
Conversion" in David Goldberg's paper "What Every Computer
Scientist Should Know About Floating-Point Arithmetic"
- <http://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html>. */
+ <https://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html>. */
# define _GL_FLOAT_PREC_BOUND(dig) \
(INT_BITS_STRLEN_BOUND ((dig) * _GL_FLOAT_DIG_BITS_BOUND) + 1)
diff --git a/lib/get-permissions.c b/lib/get-permissions.c
index dc77748af19..c54d71c1c56 100644
--- a/lib/get-permissions.c
+++ b/lib/get-permissions.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
diff --git a/lib/getdtablesize.c b/lib/getdtablesize.c
index c356cf4aa97..d0a5ecaf5d6 100644
--- a/lib/getdtablesize.c
+++ b/lib/getdtablesize.c
@@ -1,4 +1,4 @@
-/* getdtablesize() function for platforms that don't have it.
+/* getdtablesize() function: Return maximum possible file descriptor value + 1.
Copyright (C) 2008-2017 Free Software Foundation, Inc.
Written by Bruno Haible <bruno@clisp.org>, 2008.
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/getgroups.c b/lib/getgroups.c
index dce0f2d0034..52473a5a230 100644
--- a/lib/getgroups.c
+++ b/lib/getgroups.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/getloadavg.c b/lib/getloadavg.c
index 0fe23bb9a59..5f2dfabb6fd 100644
--- a/lib/getloadavg.c
+++ b/lib/getloadavg.c
@@ -17,7 +17,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Compile-time symbols that this file uses:
diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h
index c71a4f11f64..83a18f9a75e 100644
--- a/lib/getopt-cdefs.in.h
+++ b/lib/getopt-cdefs.in.h
@@ -4,19 +4,19 @@
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library.
- gnulib is free software; you can redistribute it and/or modify it
+ 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 of
the License, or (at your option) any later version.
- gnulib is distributed in the hope that it will be useful, but
+ 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 gnulib; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _GETOPT_CDEFS_H
#define _GETOPT_CDEFS_H 1
diff --git a/lib/getopt-core.h b/lib/getopt-core.h
index d315891aefd..ec0734c7230 100644
--- a/lib/getopt-core.h
+++ b/lib/getopt-core.h
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _GETOPT_CORE_H
#define _GETOPT_CORE_H 1
diff --git a/lib/getopt-ext.h b/lib/getopt-ext.h
index e4da22f54f5..4cdbfb0e7a5 100644
--- a/lib/getopt-ext.h
+++ b/lib/getopt-ext.h
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _GETOPT_EXT_H
#define _GETOPT_EXT_H 1
diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h
index db5f15c22d7..02b2b5064d3 100644
--- a/lib/getopt-pfx-core.h
+++ b/lib/getopt-pfx-core.h
@@ -4,19 +4,19 @@
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library.
- gnulib is free software; you can redistribute it and/or modify it
+ 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 of
the License, or (at your option) any later version.
- gnulib is distributed in the hope that it will be useful, but
+ 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 gnulib; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _GETOPT_PFX_CORE_H
#define _GETOPT_PFX_CORE_H 1
diff --git a/lib/getopt-pfx-ext.h b/lib/getopt-pfx-ext.h
index 91f4df1720f..75e6fd32fe0 100644
--- a/lib/getopt-pfx-ext.h
+++ b/lib/getopt-pfx-ext.h
@@ -4,19 +4,19 @@
Unlike most of the getopt implementation, it is NOT shared
with the GNU C Library.
- gnulib is free software; you can redistribute it and/or modify it
+ 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 of
the License, or (at your option) any later version.
- gnulib is distributed in the hope that it will be useful, but
+ 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 gnulib; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _GETOPT_PFX_EXT_H
#define _GETOPT_PFX_EXT_H 1
diff --git a/lib/getopt.c b/lib/getopt.c
index 9a2867db277..b0cc35bfb1b 100644
--- a/lib/getopt.c
+++ b/lib/getopt.c
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _LIBC
# include <config.h>
diff --git a/lib/getopt.in.h b/lib/getopt.in.h
index 4ce1eb485af..594ed8092a1 100644
--- a/lib/getopt.in.h
+++ b/lib/getopt.in.h
@@ -5,18 +5,18 @@
with the GNU C Library, which supplies a different version of
this file.
- gnulib is free software; you can redistribute it and/or modify it
+ 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 of
the License, or (at your option) any later version.
- gnulib is distributed in the hope that it will be useful, but
+ 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 gnulib; if not, see <http://www.gnu.org/licenses/>. */
+ License along with gnulib; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_GETOPT_H
diff --git a/lib/getopt1.c b/lib/getopt1.c
index 2bc5926016a..d689f4ce67a 100644
--- a/lib/getopt1.c
+++ b/lib/getopt1.c
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _LIBC
# include <config.h>
diff --git a/lib/getopt_.h b/lib/getopt_.h
deleted file mode 100644
index 7c77a1c8d4f..00000000000
--- a/lib/getopt_.h
+++ /dev/null
@@ -1,285 +0,0 @@
-/* Declarations for getopt.
- Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2017 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.
-
- 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/>. */
-
-#ifndef _GL_GETOPT_H
-
-#if __GNUC__ >= 3
-#pragma GCC system_header
-#endif
-
-
-/* The include_next requires a split double-inclusion guard. We must
- also inform the replacement unistd.h to not recursively use
- <getopt.h>; our definitions will be present soon enough. */
-#if HAVE_GETOPT_H
-# define _GL_SYSTEM_GETOPT
-# ifndef __GNUC__
-# include <next_getopt.h>
-# else
-# include_next <getopt.h>
-# endif
-# undef _GL_SYSTEM_GETOPT
-#endif
-
-#ifndef _GL_GETOPT_H
-
-#ifndef __need_getopt
-# define _GL_GETOPT_H 1
-#endif
-
-/* Standalone applications should #define __GETOPT_PREFIX to an
- identifier that prefixes the external functions and variables
- defined in this header. When this happens, include the
- headers that might declare getopt so that they will not cause
- confusion if included after this file (if the system had <getopt.h>,
- we have already included it). Then systematically rename
- identifiers so that they do not collide with the system functions
- and variables. Renaming avoids problems with some compilers and
- linkers. */
-#if defined __GETOPT_PREFIX && !defined __need_getopt
-# if !HAVE_GETOPT_H
-# define __need_system_stdlib_h
-# include <stdlib.h>
-# undef __need_system_stdlib_h
-# include <stdio.h>
-# include <unistd.h>
-# endif
-# undef __need_getopt
-# undef getopt
-# undef getopt_long
-# undef getopt_long_only
-# undef optarg
-# undef opterr
-# undef optind
-# undef optopt
-# undef option
-# define __GETOPT_CONCAT(x, y) x ## y
-# define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y)
-# define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y)
-# define getopt __GETOPT_ID (getopt)
-# define getopt_long __GETOPT_ID (getopt_long)
-# define getopt_long_only __GETOPT_ID (getopt_long_only)
-# define optarg __GETOPT_ID (optarg)
-# define opterr __GETOPT_ID (opterr)
-# define optind __GETOPT_ID (optind)
-# define optopt __GETOPT_ID (optopt)
-# define option __GETOPT_ID (option)
-# define _getopt_internal __GETOPT_ID (getopt_internal)
-#endif
-
-/* Standalone applications get correct prototypes for getopt_long and
- getopt_long_only; they declare "char **argv". libc uses prototypes
- with "char *const *argv" that are incorrect because getopt_long and
- getopt_long_only can permute argv; this is required for backward
- compatibility (e.g., for LSB 2.0.1).
-
- This used to be '#if defined __GETOPT_PREFIX && !defined __need_getopt',
- but it caused redefinition warnings if both unistd.h and getopt.h were
- included, since unistd.h includes getopt.h having previously defined
- __need_getopt.
-
- The only place where __getopt_argv_const is used is in definitions
- of getopt_long and getopt_long_only below, but these are visible
- only if __need_getopt is not defined, so it is quite safe to rewrite
- the conditional as follows:
-*/
-#if !defined __need_getopt
-# if defined __GETOPT_PREFIX
-# define __getopt_argv_const /* empty */
-# else
-# define __getopt_argv_const const
-# endif
-#endif
-
-/* If __GNU_LIBRARY__ is not already defined, either we are being used
- standalone, or this is the first header included in the source file.
- If we are being used with glibc, we need to include <features.h>, but
- that does not exist if we are standalone. So: if __GNU_LIBRARY__ is
- not defined, include <ctype.h>, which will pull in <features.h> for us
- if it's from glibc. (Why ctype.h? It's guaranteed to exist and it
- doesn't flood the namespace with stuff the way some other headers do.) */
-#if !defined __GNU_LIBRARY__
-# include <ctype.h>
-#endif
-
-#ifndef __THROW
-# ifndef __GNUC_PREREQ
-# define __GNUC_PREREQ(maj, min) (0)
-# endif
-# if defined __cplusplus && __GNUC_PREREQ (2,8)
-# define __THROW throw ()
-# else
-# define __THROW
-# endif
-#endif
-
-/* The definition of _GL_ARG_NONNULL is copied here. */
-/* A C macro for declaring that specific arguments must not be NULL.
- Copyright (C) 2009-2017 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 <http://www.gnu.org/licenses/>. */
-
-/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools
- that the values passed as arguments n, ..., m must be non-NULL pointers.
- n = 1 stands for the first argument, n = 2 for the second argument etc. */
-#ifndef _GL_ARG_NONNULL
-# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3
-# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params))
-# else
-# define _GL_ARG_NONNULL(params)
-# endif
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* For communication from 'getopt' to the caller.
- When 'getopt' finds an option that takes an argument,
- the argument value is returned here.
- Also, when 'ordering' is RETURN_IN_ORDER,
- each non-option ARGV-element is returned here. */
-
-extern char *optarg;
-
-/* Index in ARGV of the next element to be scanned.
- This is used for communication to and from the caller
- and for communication between successive calls to 'getopt'.
-
- On entry to 'getopt', zero means this is the first call; initialize.
-
- When 'getopt' returns -1, this is the index of the first of the
- non-option elements that the caller should itself scan.
-
- Otherwise, 'optind' communicates from one call to the next
- how much of ARGV has been scanned so far. */
-
-extern int optind;
-
-/* Callers store zero here to inhibit the error message 'getopt' prints
- for unrecognized options. */
-
-extern int opterr;
-
-/* Set to an option character which was unrecognized. */
-
-extern int optopt;
-
-#ifndef __need_getopt
-/* Describe the long-named options requested by the application.
- The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
- of 'struct option' terminated by an element containing a name which is
- zero.
-
- The field 'has_arg' is:
- no_argument (or 0) if the option does not take an argument,
- required_argument (or 1) if the option requires an argument,
- optional_argument (or 2) if the option takes an optional argument.
-
- If the field 'flag' is not NULL, it points to a variable that is set
- to the value given in the field 'val' when the option is found, but
- left unchanged if the option is not found.
-
- To have a long-named option do something other than set an 'int' to
- a compiled-in constant, such as set a value from 'optarg', set the
- option's 'flag' field to zero and its 'val' field to a nonzero
- value (the equivalent single-letter option character, if there is
- one). For long options that have a zero 'flag' field, 'getopt'
- returns the contents of the 'val' field. */
-
-# if !GNULIB_defined_struct_option
-struct option
-{
- const char *name;
- /* has_arg can't be an enum because some compilers complain about
- type mismatches in all the code that assumes it is an int. */
- int has_arg;
- int *flag;
- int val;
-};
-# define GNULIB_defined_struct_option 1
-# endif
-
-/* Names for the values of the 'has_arg' field of 'struct option'. */
-
-# define no_argument 0
-# define required_argument 1
-# define optional_argument 2
-#endif /* need getopt */
-
-
-/* Get definitions and prototypes for functions to process the
- arguments in ARGV (ARGC of them, minus the program name) for
- options given in OPTS.
-
- Return the option character from OPTS just read. Return -1 when
- there are no more options. For unrecognized options, or options
- missing arguments, 'optopt' is set to the option letter, and '?' is
- returned.
-
- The OPTS string is a list of characters which are recognized option
- letters, optionally followed by colons, specifying that that letter
- takes an argument, to be placed in 'optarg'.
-
- If a letter in OPTS is followed by two colons, its argument is
- optional. This behavior is specific to the GNU 'getopt'.
-
- The argument '--' causes premature termination of argument
- scanning, explicitly telling 'getopt' that there are no more
- options.
-
- If OPTS begins with '-', then non-option arguments are treated as
- arguments to the option '\1'. This behavior is specific to the GNU
- 'getopt'. If OPTS begins with '+', or POSIXLY_CORRECT is set in
- the environment, then do not permute arguments. */
-
-extern int getopt (int ___argc, char *const *___argv, const char *__shortopts)
- __THROW _GL_ARG_NONNULL ((2, 3));
-
-#ifndef __need_getopt
-extern int getopt_long (int ___argc, char *__getopt_argv_const *___argv,
- const char *__shortopts,
- const struct option *__longopts, int *__longind)
- __THROW _GL_ARG_NONNULL ((2, 3));
-extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv,
- const char *__shortopts,
- const struct option *__longopts, int *__longind)
- __THROW _GL_ARG_NONNULL ((2, 3));
-
-#endif
-
-#ifdef __cplusplus
-}
-#endif
-
-/* Make sure we later can get all the definitions and declarations. */
-#undef __need_getopt
-
-#endif /* _GL_GETOPT_H */
-#endif /* _GL_GETOPT_H */
diff --git a/lib/getopt_int.h b/lib/getopt_int.h
index a5562195123..e33856ce9b9 100644
--- a/lib/getopt_int.h
+++ b/lib/getopt_int.h
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifndef _GETOPT_INT_H
#define _GETOPT_INT_H 1
diff --git a/lib/gettext.h b/lib/gettext.h
index e7520af252f..f6150be6523 100644
--- a/lib/gettext.h
+++ b/lib/gettext.h
@@ -13,7 +13,7 @@
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/>. */
+ with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _LIBGETTEXT_H
#define _LIBGETTEXT_H 1
@@ -185,7 +185,8 @@ npgettext_aux (const char *domain,
#include <string.h>
#if (((__GNUC__ >= 3 || __GNUG__ >= 2) && !defined __STRICT_ANSI__) \
- /* || __STDC_VERSION__ >= 199901L */ )
+ /* || __STDC_VERSION__ == 199901L
+ || (__STDC_VERSION__ >= 201112L && !defined __STDC_NO_VLA__) */ )
# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 1
#else
# define _LIBGETTEXT_HAVE_VARIABLE_SIZE_ARRAYS 0
diff --git a/lib/gettime.c b/lib/gettime.c
index 4ae313e78ea..e5af26c9902 100644
--- a/lib/gettime.c
+++ b/lib/gettime.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c
index 8ae7622af31..a11b1830c4c 100644
--- a/lib/gettimeofday.c
+++ b/lib/gettimeofday.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 509089e6391..a7b33ba34e8 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -13,7 +13,7 @@
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this file. If not, see <http://www.gnu.org/licenses/>.
+# along with this file. If not, see <https://www.gnu.org/licenses/>.
#
# As a special exception to the GNU General Public License,
# this file may be distributed as part of a program that
@@ -21,7 +21,7 @@
# the same distribution terms as the rest of that program.
#
# Generated by gnulib-tool.
-# Reproduce by: gnulib-tool --import --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=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright utimens vla warnings
+# Reproduce by: gnulib-tool --import --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=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsusage fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings
MOSTLYCLEANFILES += core *.stackdump
@@ -125,6 +125,7 @@ GNULIB_DUP2 = @GNULIB_DUP2@
GNULIB_DUP3 = @GNULIB_DUP3@
GNULIB_ENVIRON = @GNULIB_ENVIRON@
GNULIB_EUIDACCESS = @GNULIB_EUIDACCESS@
+GNULIB_EXPLICIT_BZERO = @GNULIB_EXPLICIT_BZERO@
GNULIB_FACCESSAT = @GNULIB_FACCESSAT@
GNULIB_FCHDIR = @GNULIB_FCHDIR@
GNULIB_FCHMODAT = @GNULIB_FCHMODAT@
@@ -254,6 +255,7 @@ GNULIB_READ = @GNULIB_READ@
GNULIB_READDIR = @GNULIB_READDIR@
GNULIB_READLINK = @GNULIB_READLINK@
GNULIB_READLINKAT = @GNULIB_READLINKAT@
+GNULIB_REALLOCARRAY = @GNULIB_REALLOCARRAY@
GNULIB_REALLOC_POSIX = @GNULIB_REALLOC_POSIX@
GNULIB_REALPATH = @GNULIB_REALPATH@
GNULIB_REMOVE = @GNULIB_REMOVE@
@@ -367,12 +369,14 @@ HAVE_DECL_GETPAGESIZE = @HAVE_DECL_GETPAGESIZE@
HAVE_DECL_GETUSERSHELL = @HAVE_DECL_GETUSERSHELL@
HAVE_DECL_IMAXABS = @HAVE_DECL_IMAXABS@
HAVE_DECL_IMAXDIV = @HAVE_DECL_IMAXDIV@
+HAVE_DECL_INITSTATE = @HAVE_DECL_INITSTATE@
HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@
HAVE_DECL_MEMMEM = @HAVE_DECL_MEMMEM@
HAVE_DECL_MEMRCHR = @HAVE_DECL_MEMRCHR@
HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@
HAVE_DECL_SETENV = @HAVE_DECL_SETENV@
HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@
+HAVE_DECL_SETSTATE = @HAVE_DECL_SETSTATE@
HAVE_DECL_SNPRINTF = @HAVE_DECL_SNPRINTF@
HAVE_DECL_STRDUP = @HAVE_DECL_STRDUP@
HAVE_DECL_STRERROR_R = @HAVE_DECL_STRERROR_R@
@@ -390,6 +394,7 @@ HAVE_DPRINTF = @HAVE_DPRINTF@
HAVE_DUP2 = @HAVE_DUP2@
HAVE_DUP3 = @HAVE_DUP3@
HAVE_EUIDACCESS = @HAVE_EUIDACCESS@
+HAVE_EXPLICIT_BZERO = @HAVE_EXPLICIT_BZERO@
HAVE_FACCESSAT = @HAVE_FACCESSAT@
HAVE_FCHDIR = @HAVE_FCHDIR@
HAVE_FCHMODAT = @HAVE_FCHMODAT@
@@ -463,6 +468,7 @@ HAVE_RAWMEMCHR = @HAVE_RAWMEMCHR@
HAVE_READDIR = @HAVE_READDIR@
HAVE_READLINK = @HAVE_READLINK@
HAVE_READLINKAT = @HAVE_READLINKAT@
+HAVE_REALLOCARRAY = @HAVE_REALLOCARRAY@
HAVE_REALPATH = @HAVE_REALPATH@
HAVE_RENAMEAT = @HAVE_RENAMEAT@
HAVE_REWINDDIR = @HAVE_REWINDDIR@
@@ -544,8 +550,6 @@ LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@
LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@
LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@
LIBGIF = @LIBGIF@
-LIBGNUTLS3_CFLAGS = @LIBGNUTLS3_CFLAGS@
-LIBGNUTLS3_LIBS = @LIBGNUTLS3_LIBS@
LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@
LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@
LIBGNU_LIBDEPS = @LIBGNU_LIBDEPS@
@@ -554,6 +558,7 @@ LIBGPM = @LIBGPM@
LIBHESIOD = @LIBHESIOD@
LIBINTL = @LIBINTL@
LIBJPEG = @LIBJPEG@
+LIBLCMS2 = @LIBLCMS2@
LIBMODULES = @LIBMODULES@
LIBOBJS = @LIBOBJS@
LIBOTF_CFLAGS = @LIBOTF_CFLAGS@
@@ -684,6 +689,7 @@ REPLACE_DIRFD = @REPLACE_DIRFD@
REPLACE_DPRINTF = @REPLACE_DPRINTF@
REPLACE_DUP = @REPLACE_DUP@
REPLACE_DUP2 = @REPLACE_DUP2@
+REPLACE_FACCESSAT = @REPLACE_FACCESSAT@
REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@
REPLACE_FCLOSE = @REPLACE_FCLOSE@
REPLACE_FCNTL = @REPLACE_FCNTL@
@@ -898,14 +904,14 @@ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e973
gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec = @gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec@
gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 = @gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1@
gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36@
+gl_GNULIB_ENABLED_cloexec = @gl_GNULIB_ENABLED_cloexec@
gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@
gl_GNULIB_ENABLED_dosname = @gl_GNULIB_ENABLED_dosname@
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_secure_getenv = @gl_GNULIB_ENABLED_secure_getenv@
+gl_GNULIB_ENABLED_open = @gl_GNULIB_ENABLED_open@
gl_GNULIB_ENABLED_strtoll = @gl_GNULIB_ENABLED_strtoll@
-gl_GNULIB_ENABLED_tempname = @gl_GNULIB_ENABLED_tempname@
gl_LIBOBJS = @gl_LIBOBJS@
gl_LTLIBOBJS = @gl_LTLIBOBJS@
gltests_LIBOBJS = @gltests_LIBOBJS@
@@ -1087,6 +1093,18 @@ EXTRA_DIST += careadlinkat.h
endif
## end gnulib module careadlinkat
+## begin gnulib module cloexec
+ifeq (,$(OMIT_GNULIB_MODULE_cloexec))
+
+ifneq (,$(gl_GNULIB_ENABLED_cloexec))
+libgnu_a_SOURCES += cloexec.c
+
+endif
+EXTRA_DIST += cloexec.h
+
+endif
+## end gnulib module cloexec
+
## begin gnulib module close-stream
ifeq (,$(OMIT_GNULIB_MODULE_close-stream))
@@ -1356,6 +1374,17 @@ EXTRA_libgnu_a_SOURCES += execinfo.c
endif
## end gnulib module execinfo
+## begin gnulib module explicit_bzero
+ifeq (,$(OMIT_GNULIB_MODULE_explicit_bzero))
+
+
+EXTRA_DIST += explicit_bzero.c
+
+EXTRA_libgnu_a_SOURCES += explicit_bzero.c
+
+endif
+## end gnulib module explicit_bzero
+
## begin gnulib module faccessat
ifeq (,$(OMIT_GNULIB_MODULE_faccessat))
@@ -1488,6 +1517,17 @@ EXTRA_libgnu_a_SOURCES += at-func.c fstatat.c
endif
## end gnulib module fstatat
+## begin gnulib module fsusage
+ifeq (,$(OMIT_GNULIB_MODULE_fsusage))
+
+
+EXTRA_DIST += fsusage.c fsusage.h
+
+EXTRA_libgnu_a_SOURCES += fsusage.c
+
+endif
+## end gnulib module fsusage
+
## begin gnulib module fsync
ifeq (,$(OMIT_GNULIB_MODULE_fsync))
@@ -1798,6 +1838,29 @@ EXTRA_libgnu_a_SOURCES += mktime.c
endif
## end gnulib module mktime-internal
+## begin gnulib module nstrftime
+ifeq (,$(OMIT_GNULIB_MODULE_nstrftime))
+
+libgnu_a_SOURCES += nstrftime.c
+
+EXTRA_DIST += strftime.h
+
+endif
+## end gnulib module nstrftime
+
+## begin gnulib module open
+ifeq (,$(OMIT_GNULIB_MODULE_open))
+
+ifneq (,$(gl_GNULIB_ENABLED_open))
+
+endif
+EXTRA_DIST += open.c
+
+EXTRA_libgnu_a_SOURCES += open.c
+
+endif
+## end gnulib module open
+
## begin gnulib module openat-h
ifeq (,$(OMIT_GNULIB_MODULE_openat-h))
@@ -1891,19 +1954,6 @@ EXTRA_DIST += root-uid.h
endif
## end gnulib module root-uid
-## begin gnulib module secure_getenv
-ifeq (,$(OMIT_GNULIB_MODULE_secure_getenv))
-
-ifneq (,$(gl_GNULIB_ENABLED_secure_getenv))
-
-endif
-EXTRA_DIST += secure_getenv.c
-
-EXTRA_libgnu_a_SOURCES += secure_getenv.c
-
-endif
-## end gnulib module secure_getenv
-
## begin gnulib module sig2str
ifeq (,$(OMIT_GNULIB_MODULE_sig2str))
@@ -2305,6 +2355,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \
-e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \
-e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \
+ -e 's/@''GNULIB_REALLOCARRAY''@/$(GNULIB_REALLOCARRAY)/g' \
-e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \
-e 's/@''GNULIB_RPMATCH''@/$(GNULIB_RPMATCH)/g' \
-e 's/@''GNULIB_SECURE_GETENV''@/$(GNULIB_SECURE_GETENV)/g' \
@@ -2323,6 +2374,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \
-e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \
-e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \
+ -e 's|@''HAVE_DECL_INITSTATE''@|$(HAVE_DECL_INITSTATE)|g' \
-e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \
-e 's|@''HAVE_MKOSTEMP''@|$(HAVE_MKOSTEMP)|g' \
-e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \
@@ -2335,10 +2387,12 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \
-e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \
-e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \
-e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \
+ -e 's|@''HAVE_REALLOCARRAY''@|$(HAVE_REALLOCARRAY)|g' \
-e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \
-e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \
-e 's|@''HAVE_SECURE_GETENV''@|$(HAVE_SECURE_GETENV)|g' \
-e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \
+ -e 's|@''HAVE_DECL_SETSTATE''@|$(HAVE_DECL_SETSTATE)|g' \
-e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \
-e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \
-e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \
@@ -2386,16 +2440,6 @@ EXTRA_libgnu_a_SOURCES += stpcpy.c
endif
## end gnulib module stpcpy
-## begin gnulib module strftime
-ifeq (,$(OMIT_GNULIB_MODULE_strftime))
-
-libgnu_a_SOURCES += strftime.c
-
-EXTRA_DIST += strftime.h
-
-endif
-## end gnulib module strftime
-
## begin gnulib module string
ifeq (,$(OMIT_GNULIB_MODULE_string))
@@ -2411,6 +2455,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \
-e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \
-e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \
+ -e 's/@''GNULIB_EXPLICIT_BZERO''@/$(GNULIB_EXPLICIT_BZERO)/g' \
-e 's/@''GNULIB_FFSL''@/$(GNULIB_FFSL)/g' \
-e 's/@''GNULIB_FFSLL''@/$(GNULIB_FFSLL)/g' \
-e 's/@''GNULIB_MBSLEN''@/$(GNULIB_MBSLEN)/g' \
@@ -2449,7 +2494,8 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \
-e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \
< $(srcdir)/string.in.h | \
- sed -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \
+ sed -e 's|@''HAVE_EXPLICIT_BZERO''@|$(HAVE_EXPLICIT_BZERO)|g' \
+ -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \
-e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \
-e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \
-e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \
@@ -2470,20 +2516,20 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H
-e 's|@''HAVE_DECL_STRERROR_R''@|$(HAVE_DECL_STRERROR_R)|g' \
-e 's|@''HAVE_DECL_STRSIGNAL''@|$(HAVE_DECL_STRSIGNAL)|g' \
-e 's|@''HAVE_STRVERSCMP''@|$(HAVE_STRVERSCMP)|g' \
- -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \
-e 's|@''REPLACE_MEMCHR''@|$(REPLACE_MEMCHR)|g' \
-e 's|@''REPLACE_MEMMEM''@|$(REPLACE_MEMMEM)|g' \
- -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \
+ -e 's|@''REPLACE_STPNCPY''@|$(REPLACE_STPNCPY)|g' \
-e 's|@''REPLACE_STRCHRNUL''@|$(REPLACE_STRCHRNUL)|g' \
-e 's|@''REPLACE_STRDUP''@|$(REPLACE_STRDUP)|g' \
- -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \
- -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \
- -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \
-e 's|@''REPLACE_STRNCAT''@|$(REPLACE_STRNCAT)|g' \
-e 's|@''REPLACE_STRNDUP''@|$(REPLACE_STRNDUP)|g' \
-e 's|@''REPLACE_STRNLEN''@|$(REPLACE_STRNLEN)|g' \
- -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \
+ -e 's|@''REPLACE_STRSTR''@|$(REPLACE_STRSTR)|g' \
+ -e 's|@''REPLACE_STRCASESTR''@|$(REPLACE_STRCASESTR)|g' \
-e 's|@''REPLACE_STRTOK_R''@|$(REPLACE_STRTOK_R)|g' \
+ -e 's|@''REPLACE_STRERROR''@|$(REPLACE_STRERROR)|g' \
+ -e 's|@''REPLACE_STRERROR_R''@|$(REPLACE_STRERROR_R)|g' \
+ -e 's|@''REPLACE_STRSIGNAL''@|$(REPLACE_STRSIGNAL)|g' \
-e 's|@''UNDEFINE_STRTOK_R''@|$(UNDEFINE_STRTOK_R)|g' \
-e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \
-e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \
@@ -2702,10 +2748,8 @@ endif
## begin gnulib module tempname
ifeq (,$(OMIT_GNULIB_MODULE_tempname))
-ifneq (,$(gl_GNULIB_ENABLED_tempname))
libgnu_a_SOURCES += tempname.c
-endif
EXTRA_DIST += tempname.h
endif
@@ -2954,6 +2998,7 @@ 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_FACCESSAT''@|$(REPLACE_FACCESSAT)|g' \
-e 's|@''REPLACE_FCHOWNAT''@|$(REPLACE_FCHOWNAT)|g' \
-e 's|@''REPLACE_FTRUNCATE''@|$(REPLACE_FTRUNCATE)|g' \
-e 's|@''REPLACE_GETCWD''@|$(REPLACE_GETCWD)|g' \
@@ -2996,6 +3041,15 @@ EXTRA_DIST += unistd.in.h
endif
## end gnulib module unistd
+## begin gnulib module unlocked-io
+ifeq (,$(OMIT_GNULIB_MODULE_unlocked-io))
+
+
+EXTRA_DIST += unlocked-io.h
+
+endif
+## end gnulib module unlocked-io
+
## begin gnulib module update-copyright
ifeq (,$(OMIT_GNULIB_MODULE_update-copyright))
diff --git a/lib/group-member.c b/lib/group-member.c
index 20f8ee8b67f..7c4ce496753 100644
--- a/lib/group-member.c
+++ b/lib/group-member.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/ignore-value.h b/lib/ignore-value.h
index 2439d9506a7..8ef3fe782f7 100644
--- a/lib/ignore-value.h
+++ b/lib/ignore-value.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Jim Meyering, Eric Blake and Pádraig Brady. */
diff --git a/lib/intprops.h b/lib/intprops.h
index 28f43613fe2..2df7b1f9f69 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
@@ -26,7 +26,7 @@
#define _GL_INT_CONVERT(e, v) (0 * (e) + (v))
/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00406.html>. */
+ <https://lists.gnu.org/r/bug-gnulib/2011-05/msg00406.html>. */
#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v))
/* The extra casts in the following macros work around compiler bugs,
@@ -179,7 +179,7 @@
/* Return 1 if A * B would overflow in [MIN,MAX] arithmetic.
See above for restrictions. Avoid && and || as they tickle
bugs in Sun C 5.11 2010/08/13 and other compilers; see
- <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00401.html>. */
+ <https://lists.gnu.org/r/bug-gnulib/2011-05/msg00401.html>. */
#define INT_MULTIPLY_RANGE_OVERFLOW(a, b, min, max) \
((b) < 0 \
? ((a) < 0 \
@@ -443,7 +443,7 @@
implementation-defined result or signal for values outside T's
range. However, code that works around this theoretical problem
runs afoul of a compiler bug in Oracle Studio 12.3 x86. See:
- http://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html
+ https://lists.gnu.org/r/bug-gnulib/2017-04/msg00049.html
As the compiler bug is real, don't try to work around the
theoretical problem. */
diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h
index 69b12a839a8..e7357e96acc 100644
--- a/lib/inttypes.in.h
+++ b/lib/inttypes.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/*
* ISO C 99 <inttypes.h> for platforms that lack it.
diff --git a/lib/limits.in.h b/lib/limits.in.h
index 08d3c328c4a..78dcf31037e 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_LIMITS_H
diff --git a/lib/localtime-buffer.c b/lib/localtime-buffer.c
index f84ad3e8238..c96c577ac1f 100644
--- a/lib/localtime-buffer.c
+++ b/lib/localtime-buffer.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/localtime-buffer.h b/lib/localtime-buffer.h
index 483a579bda4..0a0389da073 100644
--- a/lib/localtime-buffer.h
+++ b/lib/localtime-buffer.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/lstat.c b/lib/lstat.c
index f4dc43ec642..f3c61779540 100644
--- a/lib/lstat.c
+++ b/lib/lstat.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
@@ -47,6 +47,8 @@ orig_lstat (const char *filename, struct stat *buf)
above. */
# include "sys/stat.h"
+# include "stat-time.h"
+
# include <string.h>
# include <errno.h>
@@ -66,32 +68,33 @@ orig_lstat (const char *filename, struct stat *buf)
int
rpl_lstat (const char *file, struct stat *sbuf)
{
- size_t len;
- int lstat_result = orig_lstat (file, sbuf);
-
- if (lstat_result != 0)
- return lstat_result;
+ int result = orig_lstat (file, sbuf);
/* This replacement file can blindly check against '/' rather than
using the ISSLASH macro, because all platforms with '\\' either
lack symlinks (mingw) or have working lstat (cygwin) and thus do
not compile this file. 0 len should have already been filtered
out above, with a failure return of ENOENT. */
- len = strlen (file);
- if (file[len - 1] != '/' || S_ISDIR (sbuf->st_mode))
- return 0;
-
- /* At this point, a trailing slash is only permitted on
- symlink-to-dir; but it should have found information on the
- directory, not the symlink. Call stat() to get info about the
- link's referent. Our replacement stat guarantees valid results,
- even if the symlink is not pointing to a directory. */
- if (!S_ISLNK (sbuf->st_mode))
+ if (result == 0)
{
- errno = ENOTDIR;
- return -1;
+ if (S_ISDIR (sbuf->st_mode) || file[strlen (file) - 1] != '/')
+ result = stat_time_normalize (result, sbuf);
+ else
+ {
+ /* At this point, a trailing slash is permitted only on
+ symlink-to-dir; but it should have found information on the
+ directory, not the symlink. Call 'stat' to get info about the
+ link's referent. Our replacement stat guarantees valid results,
+ even if the symlink is not pointing to a directory. */
+ if (!S_ISLNK (sbuf->st_mode))
+ {
+ errno = ENOTDIR;
+ return -1;
+ }
+ result = stat (file, sbuf);
+ }
}
- return stat (file, sbuf);
+ return result;
}
#endif /* HAVE_LSTAT */
diff --git a/lib/md5.c b/lib/md5.c
index dcbba45ddff..e16da5990f3 100644
--- a/lib/md5.c
+++ b/lib/md5.c
@@ -15,7 +15,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, 1995. */
diff --git a/lib/md5.h b/lib/md5.h
index e38a6198708..8b94bfcf0e0 100644
--- a/lib/md5.h
+++ b/lib/md5.h
@@ -15,7 +15,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _MD5_H
#define _MD5_H 1
diff --git a/lib/memrchr.c b/lib/memrchr.c
index fefe16cc517..29e56984cb1 100644
--- a/lib/memrchr.c
+++ b/lib/memrchr.c
@@ -20,7 +20,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#if defined _LIBC
# include <memcopy.h>
diff --git a/lib/minmax.h b/lib/minmax.h
index 6b602a94fdb..bbf14163c1b 100644
--- a/lib/minmax.h
+++ b/lib/minmax.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _MINMAX_H
#define _MINMAX_H
diff --git a/lib/mkostemp.c b/lib/mkostemp.c
index 56c22a4464c..f1ce93babea 100644
--- a/lib/mkostemp.c
+++ b/lib/mkostemp.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#if !_LIBC
# include <config.h>
diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h
index 6c8b2e7f526..00e58abdd6c 100644
--- a/lib/mktime-internal.h
+++ b/lib/mktime-internal.h
@@ -14,7 +14,7 @@
You should have received a copy of the GNU General Public
License along with this program; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#include <time.h>
diff --git a/lib/mktime.c b/lib/mktime.c
index 058ab65c03e..dd7f0a3ab34 100644
--- a/lib/mktime.c
+++ b/lib/mktime.c
@@ -15,7 +15,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
/* Define this to 1 to have a standalone program to test this implementation of
mktime. */
diff --git a/lib/strftime.c b/lib/nstrftime.c
index 99bee4ef978..8795cd729d7 100644
--- a/lib/strftime.c
+++ b/lib/nstrftime.c
@@ -13,7 +13,7 @@
You should have received a copy of the GNU General Public
License along with the GNU C Library; if not, see
- <http://www.gnu.org/licenses/>. */
+ <https://www.gnu.org/licenses/>. */
#ifdef _LIBC
# define USE_IN_EXTENDED_LOCALE_MODEL 1
diff --git a/lib/open.c b/lib/open.c
new file mode 100644
index 00000000000..b5452b56afd
--- /dev/null
+++ b/lib/open.c
@@ -0,0 +1,208 @@
+/* Open a descriptor to a file.
+ Copyright (C) 2007-2017 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 Bruno Haible <bruno@clisp.org>, 2007. */
+
+/* If the user's config.h happens to include <fcntl.h>, let it include only
+ the system's <fcntl.h> here, so that orig_open doesn't recurse to
+ rpl_open. */
+#define __need_system_fcntl_h
+#include <config.h>
+
+/* Get the original definition of open. It might be defined as a macro. */
+#include <fcntl.h>
+#include <sys/types.h>
+#undef __need_system_fcntl_h
+
+static int
+orig_open (const char *filename, int flags, mode_t mode)
+{
+ return open (filename, flags, mode);
+}
+
+/* Specification. */
+/* Write "fcntl.h" here, not <fcntl.h>, otherwise OSF/1 5.1 DTK cc eliminates
+ this include because of the preliminary #include <fcntl.h> above. */
+#include "fcntl.h"
+
+#include "cloexec.h"
+
+#include <errno.h>
+#include <stdarg.h>
+#include <string.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#ifndef REPLACE_OPEN_DIRECTORY
+# define REPLACE_OPEN_DIRECTORY 0
+#endif
+
+int
+open (const char *filename, int flags, ...)
+{
+ /* 0 = unknown, 1 = yes, -1 = no. */
+#if GNULIB_defined_O_CLOEXEC
+ int have_cloexec = -1;
+#else
+ static int have_cloexec;
+#endif
+
+ mode_t mode;
+ int fd;
+
+ mode = 0;
+ if (flags & O_CREAT)
+ {
+ va_list arg;
+ va_start (arg, flags);
+
+ /* We have to use PROMOTED_MODE_T instead of mode_t, otherwise GCC 4
+ creates crashing code when 'mode_t' is smaller than 'int'. */
+ mode = va_arg (arg, PROMOTED_MODE_T);
+
+ va_end (arg);
+ }
+
+#if GNULIB_defined_O_NONBLOCK
+ /* The only known platform that lacks O_NONBLOCK is mingw, but it
+ also lacks named pipes and Unix sockets, which are the only two
+ file types that require non-blocking handling in open().
+ Therefore, it is safe to ignore O_NONBLOCK here. It is handy
+ that mingw also lacks openat(), so that is also covered here. */
+ flags &= ~O_NONBLOCK;
+#endif
+
+#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__
+ if (strcmp (filename, "/dev/null") == 0)
+ filename = "NUL";
+#endif
+
+#if OPEN_TRAILING_SLASH_BUG
+ /* If the filename ends in a slash and one of O_CREAT, O_WRONLY, O_RDWR
+ is specified, then fail.
+ Rationale: POSIX <http://www.opengroup.org/susv3/basedefs/xbd_chap04.html>
+ says that
+ "A pathname that contains at least one non-slash character and that
+ ends with one or more trailing slashes shall be resolved as if a
+ single dot character ( '.' ) were appended to the pathname."
+ and
+ "The special filename dot shall refer to the directory specified by
+ its predecessor."
+ If the named file already exists as a directory, then
+ - if O_CREAT is specified, open() must fail because of the semantics
+ of O_CREAT,
+ - if O_WRONLY or O_RDWR is specified, open() must fail because POSIX
+ <http://www.opengroup.org/susv3/functions/open.html> says that it
+ fails with errno = EISDIR in this case.
+ If the named file does not exist or does not name a directory, then
+ - if O_CREAT is specified, open() must fail since open() cannot create
+ directories,
+ - if O_WRONLY or O_RDWR is specified, open() must fail because the
+ file does not contain a '.' directory. */
+ if (flags & (O_CREAT | O_WRONLY | O_RDWR))
+ {
+ size_t len = strlen (filename);
+ if (len > 0 && filename[len - 1] == '/')
+ {
+ errno = EISDIR;
+ return -1;
+ }
+ }
+#endif
+
+ fd = orig_open (filename,
+ flags & ~(have_cloexec <= 0 ? O_CLOEXEC : 0), mode);
+
+ if (flags & O_CLOEXEC)
+ {
+ if (! have_cloexec)
+ {
+ if (0 <= fd)
+ have_cloexec = 1;
+ else if (errno == EINVAL)
+ {
+ fd = orig_open (filename, flags & ~O_CLOEXEC, mode);
+ have_cloexec = -1;
+ }
+ }
+ if (have_cloexec < 0 && 0 <= fd)
+ set_cloexec_flag (fd, true);
+ }
+
+
+#if REPLACE_FCHDIR
+ /* Implementing fchdir and fdopendir requires the ability to open a
+ directory file descriptor. If open doesn't support that (as on
+ mingw), we use a dummy file that behaves the same as directories
+ on Linux (ie. always reports EOF on attempts to read()), and
+ override fstat() in fchdir.c to hide the fact that we have a
+ dummy. */
+ if (REPLACE_OPEN_DIRECTORY && fd < 0 && errno == EACCES
+ && ((flags & O_ACCMODE) == O_RDONLY
+ || (O_SEARCH != O_RDONLY && (flags & O_ACCMODE) == O_SEARCH)))
+ {
+ struct stat statbuf;
+ if (stat (filename, &statbuf) == 0 && S_ISDIR (statbuf.st_mode))
+ {
+ /* Maximum recursion depth of 1. */
+ fd = open ("/dev/null", flags, mode);
+ if (0 <= fd)
+ fd = _gl_register_fd (fd, filename);
+ }
+ else
+ errno = EACCES;
+ }
+#endif
+
+#if OPEN_TRAILING_SLASH_BUG
+ /* If the filename ends in a slash and fd does not refer to a directory,
+ then fail.
+ Rationale: POSIX <http://www.opengroup.org/susv3/basedefs/xbd_chap04.html>
+ says that
+ "A pathname that contains at least one non-slash character and that
+ ends with one or more trailing slashes shall be resolved as if a
+ single dot character ( '.' ) were appended to the pathname."
+ and
+ "The special filename dot shall refer to the directory specified by
+ its predecessor."
+ If the named file without the slash is not a directory, open() must fail
+ with ENOTDIR. */
+ if (fd >= 0)
+ {
+ /* We know len is positive, since open did not fail with ENOENT. */
+ size_t len = strlen (filename);
+ if (filename[len - 1] == '/')
+ {
+ struct stat statbuf;
+
+ if (fstat (fd, &statbuf) >= 0 && !S_ISDIR (statbuf.st_mode))
+ {
+ close (fd);
+ errno = ENOTDIR;
+ return -1;
+ }
+ }
+ }
+#endif
+
+#if REPLACE_FCHDIR
+ if (!REPLACE_OPEN_DIRECTORY && 0 <= fd)
+ fd = _gl_register_fd (fd, filename);
+#endif
+
+ return fd;
+}
diff --git a/lib/openat-priv.h b/lib/openat-priv.h
index 2598719eccf..b5a411b944b 100644
--- a/lib/openat-priv.h
+++ b/lib/openat-priv.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/openat-proc.c b/lib/openat-proc.c
index 101449bbb7f..6d2b598c8b2 100644
--- a/lib/openat-proc.c
+++ b/lib/openat-proc.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/openat.h b/lib/openat.h
index a036081e0af..1c4f64a32ed 100644
--- a/lib/openat.h
+++ b/lib/openat.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Jim Meyering */
diff --git a/lib/pipe2.c b/lib/pipe2.c
index 830f006bd36..741cee99ff6 100644
--- a/lib/pipe2.c
+++ b/lib/pipe2.c
@@ -12,7 +12,7 @@
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/>. */
+ with this program; if not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/pselect.c b/lib/pselect.c
index 0c44ca9c0ff..2ea7c45307c 100644
--- a/lib/pselect.c
+++ b/lib/pselect.c
@@ -15,7 +15,7 @@
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/>. */
+ with this program; if not, see <https://www.gnu.org/licenses/>. */
/* written by Paul Eggert */
diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c
index cb213303fbd..9ccf89b51fb 100644
--- a/lib/pthread_sigmask.c
+++ b/lib/pthread_sigmask.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/putenv.c b/lib/putenv.c
index b55e2620932..7831864478e 100644
--- a/lib/putenv.c
+++ b/lib/putenv.c
@@ -15,7 +15,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c
index fdf0a052b98..003cb42b7db 100644
--- a/lib/qcopy-acl.c
+++ b/lib/qcopy-acl.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
diff --git a/lib/readlink.c b/lib/readlink.c
index bf0cedc5fa2..cd9604b224c 100644
--- a/lib/readlink.c
+++ b/lib/readlink.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/readlinkat.c b/lib/readlinkat.c
index 29a71ddfc27..c9880e1c704 100644
--- a/lib/readlinkat.c
+++ b/lib/readlinkat.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* written by Eric Blake */
diff --git a/lib/root-uid.h b/lib/root-uid.h
index 3a0037a4863..4aa9dfe24f0 100644
--- a/lib/root-uid.h
+++ b/lib/root-uid.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert. */
diff --git a/lib/save-cwd.c b/lib/save-cwd.c
index c1de48e87de..fbd944bb722 100644
--- a/lib/save-cwd.c
+++ b/lib/save-cwd.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Gnulib needs to save and restore the current working directory to
fully emulate functions like fstatat. But Emacs doesn't care what
diff --git a/lib/save-cwd.h b/lib/save-cwd.h
index d066a0e5644..577bc35dc07 100644
--- a/lib/save-cwd.h
+++ b/lib/save-cwd.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Jim Meyering. */
diff --git a/lib/secure_getenv.c b/lib/secure_getenv.c
deleted file mode 100644
index df53dea0b2f..00000000000
--- a/lib/secure_getenv.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/* Look up an environment variable, returning NULL in insecure situations.
-
- Copyright 2013-2017 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 <http://www.gnu.org/licenses/>. */
-
-#include <config.h>
-
-#include <stdlib.h>
-
-#if !HAVE___SECURE_GETENV
-# if HAVE_ISSETUGID || (HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID)
-# include <unistd.h>
-# endif
-#endif
-
-char *
-secure_getenv (char const *name)
-{
-#if HAVE___SECURE_GETENV /* glibc */
- return __secure_getenv (name);
-#elif HAVE_ISSETUGID /* OS X, FreeBSD, NetBSD, OpenBSD */
- if (issetugid ())
- return NULL;
- return getenv (name);
-#elif HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID /* other Unix */
- if (geteuid () != getuid () || getegid () != getgid ())
- return NULL;
- return getenv (name);
-#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ /* native Windows */
- /* On native Windows, there is no such concept as setuid or setgid binaries.
- - Programs launched as system services have high privileges, but they don't
- inherit environment variables from a user.
- - Programs launched by a user with "Run as Administrator" have high
- privileges and use the environment variables, but the user has been asked
- whether he agrees.
- - Programs launched by a user without "Run as Administrator" cannot gain
- high privileges, therefore there is no risk. */
- return getenv (name);
-#else
- return NULL;
-#endif
-}
diff --git a/lib/set-permissions.c b/lib/set-permissions.c
index 75bb2dcce42..b30841fca40 100644
--- a/lib/set-permissions.c
+++ b/lib/set-permissions.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */
diff --git a/lib/sha1.c b/lib/sha1.c
index a57814131d6..ca3eabc45e7 100644
--- a/lib/sha1.c
+++ b/lib/sha1.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Scott G. Miller
Credits:
diff --git a/lib/sha1.h b/lib/sha1.h
index fcef9ce2c60..dd48889fa4c 100644
--- a/lib/sha1.h
+++ b/lib/sha1.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef SHA1_H
# define SHA1_H 1
diff --git a/lib/sha256.c b/lib/sha256.c
index c0fb8beecfe..449a9b7b712 100644
--- a/lib/sha256.c
+++ b/lib/sha256.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by David Madore, considerably copypasting from
Scott G. Miller's sha1.c
diff --git a/lib/sha256.h b/lib/sha256.h
index 348b76ef265..b998aa4b634 100644
--- a/lib/sha256.h
+++ b/lib/sha256.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef SHA256_H
# define SHA256_H 1
diff --git a/lib/sha512.c b/lib/sha512.c
index dbde67183b7..e666231148e 100644
--- a/lib/sha512.c
+++ b/lib/sha512.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by David Madore, considerably copypasting from
Scott G. Miller's sha1.c
diff --git a/lib/sha512.h b/lib/sha512.h
index 4460e6c9b76..70a3f9ad6cb 100644
--- a/lib/sha512.h
+++ b/lib/sha512.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef SHA512_H
# define SHA512_H 1
diff --git a/lib/sig2str.c b/lib/sig2str.c
index c50c612b397..a3ed970063e 100644
--- a/lib/sig2str.c
+++ b/lib/sig2str.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/sig2str.h b/lib/sig2str.h
index 9bec78ed6af..4e43ea404c1 100644
--- a/lib/sig2str.h
+++ b/lib/sig2str.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/signal.in.h b/lib/signal.in.h
index 1ffba37e239..e8107c37bf5 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -200,7 +200,7 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1];
/* When also using extern inline, suppress the use of static inline in
standard headers of problematic Apple configurations, as Libc at
least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
- <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2012-12/msg00023.html>.
Perhaps Apple will fix this some day. */
#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \
&& (defined __i386__ || defined __x86_64__))
diff --git a/lib/stat-time.h b/lib/stat-time.h
index 9e45e855655..1cf821992ed 100644
--- a/lib/stat-time.h
+++ b/lib/stat-time.h
@@ -13,13 +13,17 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
#ifndef STAT_TIME_H
#define STAT_TIME_H 1
+#include "intprops.h"
+
+#include <errno.h>
+#include <stddef.h>
#include <sys/stat.h>
#include <time.h>
@@ -202,6 +206,47 @@ get_stat_birthtime (struct stat const *st)
return t;
}
+/* If a stat-like function returned RESULT, normalize the timestamps
+ in *ST, in case this platform suffers from the Solaris 11 bug where
+ tv_nsec might be negative. Return the adjusted RESULT, setting
+ errno to EOVERFLOW if normalization overflowed. This function
+ is intended to be private to this .h file. */
+_GL_STAT_TIME_INLINE int
+stat_time_normalize (int result, struct stat *st)
+{
+#if defined __sun && defined STAT_TIMESPEC
+ if (result == 0)
+ {
+ long int timespec_resolution = 1000000000;
+ short int const ts_off[] = { offsetof (struct stat, st_atim),
+ offsetof (struct stat, st_mtim),
+ offsetof (struct stat, st_ctim) };
+ int i;
+ for (i = 0; i < sizeof ts_off / sizeof *ts_off; i++)
+ {
+ struct timespec *ts = (struct timespec *) ((char *) st + ts_off[i]);
+ long int q = ts->tv_nsec / timespec_resolution;
+ long int r = ts->tv_nsec % timespec_resolution;
+ if (r < 0)
+ {
+ r += timespec_resolution;
+ q--;
+ }
+ ts->tv_nsec = r;
+ /* Overflow is possible, as Solaris 11 stat can yield
+ tv_sec == TYPE_MINIMUM (time_t) && tv_nsec == -1000000000.
+ INT_ADD_WRAPV is OK, since time_t is signed on Solaris. */
+ if (INT_ADD_WRAPV (q, ts->tv_sec, &ts->tv_sec))
+ {
+ errno = EOVERFLOW;
+ return -1;
+ }
+ }
+ }
+#endif
+ return result;
+}
+
#ifdef __cplusplus
}
#endif
diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h
index ea248231701..68e889e053c 100644
--- a/lib/stdalign.in.h
+++ b/lib/stdalign.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert and Bruno Haible. */
@@ -53,7 +53,7 @@
#undef _Alignof
/* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
#if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \
|| (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9)))
# ifdef __cplusplus
diff --git a/lib/stddef.in.h b/lib/stddef.in.h
index 5b496a68320..758ccf63386 100644
--- a/lib/stddef.in.h
+++ b/lib/stddef.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Eric Blake. */
@@ -85,24 +85,28 @@
a hack in case the configure-time test was done with g++ even though
we are currently compiling with gcc. */
#if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T)
+# if !GNULIB_defined_max_align_t
/* On the x86, the maximum storage alignment of double, long, etc. is 4,
but GCC's C11 ABI for x86 says that max_align_t has an alignment of 8,
and the C11 standard allows this. Work around this problem by
using __alignof__ (which returns 8 for double) rather than _Alignof
(which returns 4), and align each union member accordingly. */
-# ifdef __GNUC__
-# define _GL_STDDEF_ALIGNAS(type) \
- __attribute__ ((__aligned__ (__alignof__ (type))))
-# else
-# define _GL_STDDEF_ALIGNAS(type) /* */
-# endif
+# ifdef __GNUC__
+# define _GL_STDDEF_ALIGNAS(type) \
+ __attribute__ ((__aligned__ (__alignof__ (type))))
+# else
+# define _GL_STDDEF_ALIGNAS(type) /* */
+# endif
typedef union
{
char *__p _GL_STDDEF_ALIGNAS (char *);
double __d _GL_STDDEF_ALIGNAS (double);
long double __ld _GL_STDDEF_ALIGNAS (long double);
long int __i _GL_STDDEF_ALIGNAS (long int);
-} max_align_t;
+} rpl_max_align_t;
+# define max_align_t rpl_max_align_t
+# define GNULIB_defined_max_align_t 1
+# endif
#endif
# endif /* _@GUARD_PREFIX@_STDDEF_H */
diff --git a/lib/stdint.in.h b/lib/stdint.in.h
index 5fbec34310f..df8b37d3d49 100644
--- a/lib/stdint.in.h
+++ b/lib/stdint.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/*
* ISO C 99 <stdint.h> for platforms that lack it.
diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h
index 75a945eb724..329801ad23b 100644
--- a/lib/stdio-impl.h
+++ b/lib/stdio-impl.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Many stdio implementations have the same logic and therefore can share
the same implementation of stdio extension API, except that some fields
@@ -32,7 +32,7 @@
/* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin, Minix 3, Android */
# if defined __DragonFly__ /* DragonFly */
- /* See <http://www.dragonflybsd.org/cvsweb/src/lib/libc/stdio/priv_stdio.h?rev=HEAD&content-type=text/x-cvsweb-markup>. */
+ /* See <https://gitweb.dragonflybsd.org/dragonfly.git/blob_plain/HEAD:/lib/libc/stdio/priv_stdio.h>. */
# define fp_ ((struct { struct __FILE_public pub; \
struct { unsigned char *_base; int _size; } _bf; \
void *cookie; \
@@ -49,7 +49,7 @@
fpos_t _offset; \
/* More fields, not relevant here. */ \
} *) fp)
- /* See <http://www.dragonflybsd.org/cvsweb/src/include/stdio.h?rev=HEAD&content-type=text/x-cvsweb-markup>. */
+ /* See <https://gitweb.dragonflybsd.org/dragonfly.git/blob_plain/HEAD:/include/stdio.h>. */
# define _p pub._p
# define _flags pub._flags
# define _r pub._r
@@ -60,7 +60,7 @@
# if (defined __NetBSD__ && __NetBSD_Version__ >= 105270000) || defined __OpenBSD__ || defined __minix || defined __ANDROID__ /* NetBSD >= 1.5ZA, OpenBSD, Minix 3, Android */
/* See <http://cvsweb.netbsd.org/bsdweb.cgi/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup>
- and <http://www.openbsd.org/cgi-bin/cvsweb/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup> */
+ and <https://cvsweb.openbsd.org/cgi-bin/cvsweb/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup> */
struct __sfileext
{
struct __sbuf _ub; /* ungetc buffer */
@@ -81,7 +81,7 @@
#ifdef __TANDEM /* NonStop Kernel */
# ifndef _IOERR
/* These values were determined by the program 'stdioext-flags' at
- <http://lists.gnu.org/archive/html/bug-gnulib/2010-12/msg00165.html>. */
+ <https://lists.gnu.org/r/bug-gnulib/2010-12/msg00165.html>. */
# define _IOERR 0x40
# define _IOREAD 0x80
# define _IOWRT 0x4
@@ -99,6 +99,8 @@
int _file; \
unsigned int _flag; \
} *) fp)
+# elif defined __VMS /* OpenVMS */
+# define fp_ ((struct _iobuf *) fp)
# else
# define fp_ fp
# endif
@@ -130,7 +132,7 @@ struct _gl_real_FILE
# define fp_ ((struct _gl_real_FILE *) fp)
/* These values were determined by a program similar to the one at
- <http://lists.gnu.org/archive/html/bug-gnulib/2010-12/msg00165.html>. */
+ <https://lists.gnu.org/r/bug-gnulib/2010-12/msg00165.html>. */
# define _IOREAD 0x1
# define _IOWRT 0x2
# define _IORW 0x4
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index d706377f984..505f3f49f4e 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -111,9 +111,9 @@
#define _GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM(formatstring_parameter, first_argument) \
_GL_ATTRIBUTE_FORMAT ((__scanf__, formatstring_parameter, first_argument))
-/* Solaris 10 declares renameat in <unistd.h>, not in <stdio.h>. */
+/* Solaris 10 and NetBSD 7.0 declare renameat in <unistd.h>, not in <stdio.h>. */
/* But in any case avoid namespace pollution on glibc systems. */
-#if (@GNULIB_RENAMEAT@ || defined GNULIB_POSIXCHECK) && defined __sun \
+#if (@GNULIB_RENAMEAT@ || defined GNULIB_POSIXCHECK) && (defined __sun || defined __NetBSD__) \
&& ! defined __GLIBC__
# include <unistd.h>
#endif
@@ -152,7 +152,7 @@
/* When also using extern inline, suppress the use of static inline in
standard headers of problematic Apple configurations, as Libc at
least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
- <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2012-12/msg00023.html>.
Perhaps Apple will fix this some day. */
#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \
&& defined __GNUC__ && defined __STDC__)
@@ -610,7 +610,7 @@ _GL_CXXALIAS_SYS (fwrite, size_t,
(const void *ptr, size_t s, size_t n, FILE *stream));
/* Work around bug 11959 when fortifying glibc 2.4 through 2.15
- <http://sources.redhat.com/bugzilla/show_bug.cgi?id=11959>,
+ <https://sourceware.org/bugzilla/show_bug.cgi?id=11959>,
which sometimes causes an unwanted diagnostic for fwrite calls.
This affects only function declaration attributes under certain
versions of gcc and clang, and is not needed for C++. */
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index b5cf9d36958..d5fa02b57ab 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -597,7 +597,7 @@ _GL_WARN_ON_USE (srandom, "srandom is unportable - "
#endif
#if @GNULIB_RANDOM@
-# if !@HAVE_RANDOM@
+# if !@HAVE_RANDOM@ || !@HAVE_DECL_INITSTATE@
_GL_FUNCDECL_SYS (initstate, char *,
(unsigned int seed, char *buf, size_t buf_size)
_GL_ARG_NONNULL ((2)));
@@ -614,7 +614,7 @@ _GL_WARN_ON_USE (initstate, "initstate is unportable - "
#endif
#if @GNULIB_RANDOM@
-# if !@HAVE_RANDOM@
+# if !@HAVE_RANDOM@ || !@HAVE_DECL_SETSTATE@
_GL_FUNCDECL_SYS (setstate, char *, (char *arg_state) _GL_ARG_NONNULL ((1)));
# endif
_GL_CXXALIAS_SYS (setstate, char *, (char *arg_state));
@@ -765,6 +765,23 @@ _GL_WARN_ON_USE (realloc, "realloc is not POSIX compliant everywhere - "
"use gnulib module realloc-posix for portability");
#endif
+
+#if @GNULIB_REALLOCARRAY@
+# if ! @HAVE_REALLOCARRAY@
+_GL_FUNCDECL_SYS (reallocarray, void *,
+ (void *ptr, size_t nmemb, size_t size));
+# endif
+_GL_CXXALIAS_SYS (reallocarray, void *,
+ (void *ptr, size_t nmemb, size_t size));
+_GL_CXXALIASWARN (reallocarray);
+#elif defined GNULIB_POSIXCHECK
+# undef reallocarray
+# if HAVE_RAW_DECL_REALLOCARRAY
+_GL_WARN_ON_USE (reallocarray, "reallocarray is not portable - "
+ "use gnulib module reallocarray for portability");
+# endif
+#endif
+
#if @GNULIB_REALPATH@
# if @REPLACE_REALPATH@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
diff --git a/lib/stpcpy.c b/lib/stpcpy.c
index 154d95f89eb..079599db868 100644
--- a/lib/stpcpy.c
+++ b/lib/stpcpy.c
@@ -16,7 +16,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/strftime.h b/lib/strftime.h
index 27a8d624125..9d91e5139cd 100644
--- a/lib/strftime.h
+++ b/lib/strftime.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <time.h>
diff --git a/lib/string.in.h b/lib/string.in.h
index 9a6b311d007..0e0e0c51f5e 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
@@ -74,6 +74,23 @@
/* The definition of _GL_WARN_ON_USE is copied here. */
+/* Clear a block of memory. The compiler will not delete a call to
+ this function, even if the block is dead after the call. */
+#if @GNULIB_EXPLICIT_BZERO@
+# if ! @HAVE_EXPLICIT_BZERO@
+_GL_FUNCDECL_SYS (explicit_bzero, void,
+ (void *__dest, size_t __n) _GL_ARG_NONNULL ((1)));
+# endif
+_GL_CXXALIAS_SYS (explicit_bzero, void, (void *__dest, size_t __n));
+_GL_CXXALIASWARN (explicit_bzero);
+#elif defined GNULIB_POSIXCHECK
+# undef explicit_bzero
+# if HAVE_RAW_DECL_EXPLICIT_BZERO
+_GL_WARN_ON_USE (explicit_bzero, "explicit_bzero is unportable - "
+ "use gnulib module explicit_bzero for portability");
+# endif
+#endif
+
/* Find the index of the least-significant set bit. */
#if @GNULIB_FFSL@
# if !@HAVE_FFSL@
diff --git a/lib/strtoimax.c b/lib/strtoimax.c
index 3f31fe913ad..f7d46f040d7 100644
--- a/lib/strtoimax.c
+++ b/lib/strtoimax.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/strtol.c b/lib/strtol.c
index 751d1e0f1e8..1ef88700fca 100644
--- a/lib/strtol.c
+++ b/lib/strtol.c
@@ -17,7 +17,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifdef _LIBC
# define USE_NUMBER_GROUPING
diff --git a/lib/strtoll.c b/lib/strtoll.c
index d770e81db39..f6952f3cd23 100644
--- a/lib/strtoll.c
+++ b/lib/strtoll.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#define QUAD 1
diff --git a/lib/symlink.c b/lib/symlink.c
index 60d4c14feab..427f1f5f00c 100644
--- a/lib/symlink.c
+++ b/lib/symlink.c
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h
index 616e77dd4cf..3bda2122277 100644
--- a/lib/sys_select.in.h
+++ b/lib/sys_select.in.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
# if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h
index 1831740900b..f0919e90d5c 100644
--- a/lib/sys_stat.in.h
+++ b/lib/sys_stat.in.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Eric Blake, Paul Eggert, and Jim Meyering. */
diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h
index 57739bc4c56..8a3c87d11d8 100644
--- a/lib/sys_time.in.h
+++ b/lib/sys_time.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h
index 3cea44884e3..b0d6132a163 100644
--- a/lib/sys_types.in.h
+++ b/lib/sys_types.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
diff --git a/lib/tempname.c b/lib/tempname.c
index 2cd90328bda..2e3f95f3fb1 100644
--- a/lib/tempname.c
+++ b/lib/tempname.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Extracted from glibc sysdeps/posix/tempname.c. See also tmpdir.c. */
@@ -69,7 +69,6 @@
# define __mkdir mkdir
# define __open open
# define __lxstat64(version, file, buf) lstat (file, buf)
-# define __secure_getenv secure_getenv
#endif
#ifdef _LIBC
@@ -279,7 +278,7 @@ try_nocreate (char *tmpl, void *flags _GL_UNUSED)
{
struct_stat64 st;
- if (__lxstat64 (_STAT_VER, tmpl, &st) == 0)
+ if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW)
__set_errno (EEXIST);
return errno == ENOENT ? 0 : -1;
}
diff --git a/lib/tempname.h b/lib/tempname.h
index 1ca97484fb4..245c8161abe 100644
--- a/lib/tempname.h
+++ b/lib/tempname.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* header written by Eric Blake */
diff --git a/lib/time-internal.h b/lib/time-internal.h
index bf22834b2e1..8caf11d8746 100644
--- a/lib/time-internal.h
+++ b/lib/time-internal.h
@@ -13,7 +13,7 @@
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/>. */
+ with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/time.in.h b/lib/time.in.h
index f0c7ef86667..d210fbf80b1 100644
--- a/lib/time.in.h
+++ b/lib/time.in.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
diff --git a/lib/time_r.c b/lib/time_r.c
index 708a98b3241..8cf8329fe5d 100644
--- a/lib/time_r.c
+++ b/lib/time_r.c
@@ -13,7 +13,7 @@
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/>. */
+ with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/time_rz.c b/lib/time_rz.c
index 17bc11c20e9..ad02edb23cb 100644
--- a/lib/time_rz.c
+++ b/lib/time_rz.c
@@ -13,7 +13,7 @@
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/>. */
+ with this program; if not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/timegm.c b/lib/timegm.c
index 957a3b830c9..1cabf648264 100644
--- a/lib/timegm.c
+++ b/lib/timegm.c
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _LIBC
# include <config.h>
diff --git a/lib/timespec-add.c b/lib/timespec-add.c
index e6c87c65683..faa45829445 100644
--- a/lib/timespec-add.c
+++ b/lib/timespec-add.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c
index 5d9276dd0f7..3872f1bc2db 100644
--- a/lib/timespec-sub.c
+++ b/lib/timespec-sub.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/timespec.h b/lib/timespec.h
index f5d823aefe9..84c8146a3ea 100644
--- a/lib/timespec.h
+++ b/lib/timespec.h
@@ -14,7 +14,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#if ! defined TIMESPEC_H
# define TIMESPEC_H
@@ -33,6 +33,8 @@ _GL_INLINE_HEADER_BEGIN
extern "C" {
#endif
+#include "verify.h"
+
/* Resolution of timespec timestamps (in units per second), and log
base 10 of the resolution. */
@@ -67,23 +69,29 @@ make_timespec (time_t s, long int ns)
any platform of interest to the GNU project, since all such
platforms have 32-bit int or wider.
- Replacing "(int) (a.tv_nsec - b.tv_nsec)" with something like
+ Replacing "a.tv_nsec - b.tv_nsec" with something like
"a.tv_nsec < b.tv_nsec ? -1 : a.tv_nsec > b.tv_nsec" would cause
this function to work in some cases where the above assumption is
violated, but not in all cases (e.g., a.tv_sec==1, a.tv_nsec==-2,
b.tv_sec==0, b.tv_nsec==999999999) and is arguably not worth the
extra instructions. Using a subtraction has the advantage of
detecting some invalid cases on platforms that detect integer
- overflow.
-
- The (int) cast avoids a gcc -Wconversion warning. */
+ overflow. */
_GL_TIMESPEC_INLINE int _GL_ATTRIBUTE_PURE
timespec_cmp (struct timespec a, struct timespec b)
{
- return (a.tv_sec < b.tv_sec ? -1
- : a.tv_sec > b.tv_sec ? 1
- : (int) (a.tv_nsec - b.tv_nsec));
+ if (a.tv_sec < b.tv_sec)
+ return -1;
+ if (a.tv_sec > b.tv_sec)
+ return 1;
+
+ /* Pacify gcc -Wstrict-overflow (bleeding-edge circa 2017-10-02). See:
+ http://lists.gnu.org/r/bug-gnulib/2017-10/msg00006.html */
+ assume (-1 <= a.tv_nsec && a.tv_nsec <= 2 * TIMESPEC_RESOLUTION);
+ assume (-1 <= b.tv_nsec && b.tv_nsec <= 2 * TIMESPEC_RESOLUTION);
+
+ return a.tv_nsec - b.tv_nsec;
}
/* Return -1, 0, 1, depending on the sign of A. A.tv_nsec must be
diff --git a/lib/u64.h b/lib/u64.h
index a8601932a13..f56cc382339 100644
--- a/lib/u64.h
+++ b/lib/u64.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index f366caffa55..91447835811 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -12,7 +12,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, see <http://www.gnu.org/licenses/>. */
+ along with this program; if not, see <https://www.gnu.org/licenses/>. */
#ifndef _@GUARD_PREFIX@_UNISTD_H
@@ -134,9 +134,8 @@
/* The definition of _GL_WARN_ON_USE is copied here. */
-/* Get getopt(), optarg, optind, opterr, optopt.
- But avoid namespace pollution on glibc systems. */
-#if @GNULIB_UNISTD_H_GETOPT@ && !defined __GLIBC__ && !defined _GL_SYSTEM_GETOPT
+/* Get getopt(), optarg, optind, opterr, optopt. */
+#if @GNULIB_UNISTD_H_GETOPT@ && !defined _GL_SYSTEM_GETOPT
# include <getopt-cdefs.h>
# include <getopt-pfx-core.h>
#endif
@@ -379,7 +378,7 @@ _GL_WARN_ON_USE (dup2, "dup2 is unportable - "
Close NEWFD first if it is open.
Return newfd if successful, otherwise -1 and errno set.
See the Linux man page at
- <http://www.kernel.org/doc/man-pages/online/pages/man2/dup3.2.html>. */
+ <https://www.kernel.org/doc/man-pages/online/pages/man2/dup3.2.html>. */
# if @HAVE_DUP3@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define dup3 rpl_dup3
@@ -462,13 +461,25 @@ _GL_WARN_ON_USE (euidaccess, "euidaccess is unportable - "
#if @GNULIB_FACCESSAT@
-# if !@HAVE_FACCESSAT@
+# if @REPLACE_FACCESSAT@
+# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
+# undef faccessat
+# define faccessat rpl_faccessat
+# endif
+_GL_FUNCDECL_RPL (faccessat, int,
+ (int fd, char const *name, int mode, int flag)
+ _GL_ARG_NONNULL ((2)));
+_GL_CXXALIAS_RPL (faccessat, int,
+ (int fd, char const *name, int mode, int flag));
+# else
+# if !@HAVE_FACCESSAT@
_GL_FUNCDECL_SYS (faccessat, int,
(int fd, char const *file, int mode, int flag)
_GL_ARG_NONNULL ((2)));
-# endif
+# endif
_GL_CXXALIAS_SYS (faccessat, int,
(int fd, char const *file, int mode, int flag));
+# endif
_GL_CXXALIASWARN (faccessat);
#elif defined GNULIB_POSIXCHECK
# undef faccessat
@@ -1149,7 +1160,7 @@ _GL_WARN_ON_USE (pipe, "pipe is unportable - "
Store the read-end as fd[0] and the write-end as fd[1].
Return 0 upon success, or -1 with errno set upon failure.
See also the Linux man page at
- <http://www.kernel.org/doc/man-pages/online/pages/man2/pipe2.2.html>. */
+ <https://www.kernel.org/doc/man-pages/online/pages/man2/pipe2.2.html>. */
# if @HAVE_PIPE2@
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
# define pipe2 rpl_pipe2
diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h
new file mode 100644
index 00000000000..be5d2b5d847
--- /dev/null
+++ b/lib/unlocked-io.h
@@ -0,0 +1,136 @@
+/* Prefer faster, non-thread-safe stdio functions if available.
+
+ Copyright (C) 2001-2004, 2009-2017 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 Jim Meyering. */
+
+#ifndef UNLOCKED_IO_H
+# define UNLOCKED_IO_H 1
+
+/* These are wrappers for functions/macros from the GNU C library, and
+ from other C libraries supporting POSIX's optional thread-safe functions.
+
+ The standard I/O functions are thread-safe. These *_unlocked ones are
+ more efficient but not thread-safe. That they're not thread-safe is
+ fine since all of the applications in this package are single threaded.
+
+ Also, some code that is shared with the GNU C library may invoke
+ the *_unlocked functions directly. On hosts that lack those
+ functions, invoke the non-thread-safe versions instead. */
+
+# include <stdio.h>
+
+# if HAVE_DECL_CLEARERR_UNLOCKED
+# undef clearerr
+# define clearerr(x) clearerr_unlocked (x)
+# else
+# define clearerr_unlocked(x) clearerr (x)
+# endif
+
+# if HAVE_DECL_FEOF_UNLOCKED
+# undef feof
+# define feof(x) feof_unlocked (x)
+# else
+# define feof_unlocked(x) feof (x)
+# endif
+
+# if HAVE_DECL_FERROR_UNLOCKED
+# undef ferror
+# define ferror(x) ferror_unlocked (x)
+# else
+# define ferror_unlocked(x) ferror (x)
+# endif
+
+# if HAVE_DECL_FFLUSH_UNLOCKED
+# undef fflush
+# define fflush(x) fflush_unlocked (x)
+# else
+# define fflush_unlocked(x) fflush (x)
+# endif
+
+# if HAVE_DECL_FGETS_UNLOCKED
+# undef fgets
+# define fgets(x,y,z) fgets_unlocked (x,y,z)
+# else
+# define fgets_unlocked(x,y,z) fgets (x,y,z)
+# endif
+
+# if HAVE_DECL_FPUTC_UNLOCKED
+# undef fputc
+# define fputc(x,y) fputc_unlocked (x,y)
+# else
+# define fputc_unlocked(x,y) fputc (x,y)
+# endif
+
+# if HAVE_DECL_FPUTS_UNLOCKED
+# undef fputs
+# define fputs(x,y) fputs_unlocked (x,y)
+# else
+# define fputs_unlocked(x,y) fputs (x,y)
+# endif
+
+# if HAVE_DECL_FREAD_UNLOCKED
+# undef fread
+# define fread(w,x,y,z) fread_unlocked (w,x,y,z)
+# else
+# define fread_unlocked(w,x,y,z) fread (w,x,y,z)
+# endif
+
+# if HAVE_DECL_FWRITE_UNLOCKED
+# undef fwrite
+# define fwrite(w,x,y,z) fwrite_unlocked (w,x,y,z)
+# else
+# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
+# endif
+
+# if HAVE_DECL_GETC_UNLOCKED
+# undef getc
+# define getc(x) getc_unlocked (x)
+# else
+# define getc_unlocked(x) getc (x)
+# endif
+
+# if HAVE_DECL_GETCHAR_UNLOCKED
+# undef getchar
+# define getchar() getchar_unlocked ()
+# else
+# define getchar_unlocked() getchar ()
+# endif
+
+# if HAVE_DECL_PUTC_UNLOCKED
+# undef putc
+# define putc(x,y) putc_unlocked (x,y)
+# else
+# define putc_unlocked(x,y) putc (x,y)
+# endif
+
+# if HAVE_DECL_PUTCHAR_UNLOCKED
+# undef putchar
+# define putchar(x) putchar_unlocked (x)
+# else
+# define putchar_unlocked(x) putchar (x)
+# endif
+
+# undef flockfile
+# define flockfile(x) ((void) 0)
+
+# undef ftrylockfile
+# define ftrylockfile(x) 0
+
+# undef funlockfile
+# define funlockfile(x) ((void) 0)
+
+#endif /* UNLOCKED_IO_H */
diff --git a/lib/utimens.c b/lib/utimens.c
index ff4eab073c1..55545e8ce9b 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
@@ -196,7 +196,7 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
/* Some Linux-based NFS clients are buggy, and mishandle timestamps
of files in NFS file systems in some cases. We have no
configure-time test for this, but please see
- <http://bugs.gentoo.org/show_bug.cgi?id=132673> for references to
+ <https://bugs.gentoo.org/show_bug.cgi?id=132673> for references to
some of the problems with Linux 2.6.16. If this affects you,
compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to
help in some cases, albeit at a cost in performance. But you
@@ -250,8 +250,8 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
result = utimensat (AT_FDCWD, file, ts, 0);
# ifdef __linux__
/* Work around a kernel bug:
- http://bugzilla.redhat.com/442352
- http://bugzilla.redhat.com/449910
+ https://bugzilla.redhat.com/show_bug.cgi?id=442352
+ https://bugzilla.redhat.com/show_bug.cgi?id=449910
It appears that utimensat can mistakenly return 280 rather
than -1 upon ENOSYS failure.
FIXME: remove in 2010 or whenever the offending kernels
@@ -566,8 +566,8 @@ lutimens (char const *file, struct timespec const timespec[2])
result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW);
# ifdef __linux__
/* Work around a kernel bug:
- http://bugzilla.redhat.com/442352
- http://bugzilla.redhat.com/449910
+ https://bugzilla.redhat.com/show_bug.cgi?id=442352
+ https://bugzilla.redhat.com/show_bug.cgi?id=449910
It appears that utimensat can mistakenly return 280 rather
than -1 upon ENOSYS failure.
FIXME: remove in 2010 or whenever the offending kernels
diff --git a/lib/utimens.h b/lib/utimens.h
index 4d9c18edad1..f1dd9884dc1 100644
--- a/lib/utimens.h
+++ b/lib/utimens.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert. */
diff --git a/lib/verify.h b/lib/verify.h
index dcba9c8cb0a..e0b48613374 100644
--- a/lib/verify.h
+++ b/lib/verify.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */
diff --git a/lib/vla.h b/lib/vla.h
index 5bbf56bb398..59de9a6bcd6 100644
--- a/lib/vla.h
+++ b/lib/vla.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Written by Paul Eggert. */
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 3c0eb579fa2..cae8c3eec5c 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -12,7 +12,7 @@
General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* _GL_WARN_ON_USE (function, "literal string") issues a declaration
for FUNCTION which will then trigger a compiler warning containing
diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h
index ff0efc6ba40..ae4fbc77f98 100644
--- a/lib/xalloc-oversized.h
+++ b/lib/xalloc-oversized.h
@@ -13,7 +13,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef XALLOC_OVERSIZED_H_
#define XALLOC_OVERSIZED_H_
@@ -44,7 +44,7 @@ typedef size_t __xalloc_count_type;
#if 7 <= __GNUC__
# define xalloc_oversized(n, s) \
__builtin_mul_overflow_p (n, s, (__xalloc_count_type) 1)
-#elif 5 <= __GNUC__ && !__STRICT_ANSI__
+#elif 5 <= __GNUC__ && !defined __ICC && !__STRICT_ANSI__
# define xalloc_oversized(n, s) \
(__builtin_constant_p (n) && __builtin_constant_p (s) \
? __xalloc_oversized (n, s) \
diff --git a/lisp/COPYING b/lisp/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/lisp/COPYING
+++ b/lisp/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/lisp/ChangeLog.1 b/lisp/ChangeLog.1
index 65997e189f1..b44f640dd55 100644
--- a/lisp/ChangeLog.1
+++ b/lisp/ChangeLog.1
@@ -3259,4 +3259,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 918825e6ac9..d654291739f 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -23556,4 +23556,4 @@ See ChangeLog.9 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.11 b/lisp/ChangeLog.11
index f3d9840c0df..94a3cbfb582 100644
--- a/lisp/ChangeLog.11
+++ b/lisp/ChangeLog.11
@@ -6395,7 +6395,7 @@
* vc-svn.el (vc-svn-checkin): Use `nconc' instead of `list*',
because the latter is a CL-ism. This fixes the bug reported by
Shawn Boyette <mdxi@collapsar.net> in
- http://lists.gnu.org/archive/html/emacs-devel/2004-05/msg00442.html.
+ https://lists.gnu.org/r/emacs-devel/2004-05/msg00442.html.
2004-06-04 Miles Bader <miles@gnu.org>
@@ -14336,4 +14336,4 @@ See ChangeLog.10 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index 04c5d8138dc..0d3bd88f3e2 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -33349,4 +33349,4 @@ See ChangeLog.11 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index f86590bf273..d14325b5ff1 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -4667,7 +4667,7 @@
2008-01-02 Karl Fogel <kfogel@red-bean.com>
Change a return type, for greater extensibility.
- See http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg01077.html
+ See https://lists.gnu.org/r/emacs-devel/2007-12/msg01077.html
and its thread for discussion leading to this change.
* bookmark.el (bookmark-jump-noselect):
@@ -11475,7 +11475,7 @@
(fancy-about-text): Add links "Authors" and "Contributing".
(fancy-splash-head): Add text "Welcome to " on the startup screen,
and "This is " on the about screen. Add link to
- "http://www.gnu.org/software/emacs/" for "GNU Emacs".
+ "https://www.gnu.org/software/emacs/" for "GNU Emacs".
For the about screen move emacs version to the header from
`fancy-splash-tail' (as it's done already for normal about screen).
(fancy-splash-tail): Insert emacs version only for startup screen.
@@ -14464,7 +14464,7 @@
* bookmark.el: Revert 2007-07-13T18:16:17Z!kfogel@red-bean.com,
thus restoring bookmark bindings to three slots under C-x r. See
- http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00705.html.
+ https://lists.gnu.org/r/emacs-devel/2007-07/msg00705.html.
2007-07-15 Jeff Miller <jmiller@cablespeed.com> (tiny change)
@@ -14511,7 +14511,7 @@
* bookmark.el (bookmark-jump-other-window): New function.
(bookmark-map): Bind it to "o".
- http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html
+ https://lists.gnu.org/r/emacs-devel/2007-07/msg00633.html
and its thread contains discussion about this change.
The original patch was slightly tweaked by Karl Fogel
<kfogel@red-bean.com> before committing.
@@ -14525,7 +14525,7 @@
* bookmark.el: Don't define bookmark keys under the "C-xr" map;
instead, make "C-xp" a prefix for bookmark-map. Patch by Drew
Adams <drew.adams@oracle.com>, mildly tweaked by me. See
- http://lists.gnu.org/archive/html/emacs-devel/2007-07/msg00633.html.
+ https://lists.gnu.org/r/emacs-devel/2007-07/msg00633.html.
2007-07-13 Carsten Dominik <dominik@science.uva.nl>
@@ -16712,4 +16712,4 @@ See ChangeLog.12 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index a3397b1e470..48f5c07b187 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -20562,4 +20562,4 @@ See ChangeLog.13 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 2512d35564f..11bc31f3b29 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -9833,7 +9833,7 @@
* window.el (pop-to-buffer): Remove the conditional that
compares new-window and old-window, so it will reselect
the selected window unconditionally.
- http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00078.html
+ https://lists.gnu.org/r/emacs-devel/2010-06/msg00078.html
2010-06-07 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -9882,7 +9882,7 @@
of kill-ring: don't call menu-bar-update-yank-menu, don't push
interprogram-paste strings to kill-ring, and don't push the input
argument `string' to kill-ring.
- http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00072.html
+ https://lists.gnu.org/r/emacs-devel/2010-06/msg00072.html
2010-06-04 Juanma Barranquero <lekktu@gmail.com>
@@ -10445,7 +10445,7 @@
* dired-x.el (dired-jump, dired-jump-other-window): Add arg
FILE-NAME to read from the minibuffer when called interactively
with prefix argument instead of using buffer-file-name.
- http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00534.html
+ https://lists.gnu.org/r/emacs-devel/2010-05/msg00534.html
* dired.el: Update autoloads.
@@ -11998,7 +11998,7 @@
2010-04-05 Juri Linkov <juri@jurta.org>
Scrolling commands which scroll a line instead of full screen.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01452.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg01452.html
* simple.el (scroll-up-line, scroll-down-line): New commands.
Put property isearch-scroll=t on them.
@@ -12009,7 +12009,7 @@
2010-04-05 Juri Linkov <juri@jurta.org>
Scrolling commands which do not signal errors at top/bottom.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01452.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg01452.html
* simple.el (scroll-up-command, scroll-down-command): New commands.
Put property isearch-scroll=t on them.
@@ -12063,7 +12063,7 @@
(electric-help-mode): Set it to original major-mode. Doc fix.
(with-electric-help): Use `electric-help-orig-major-mode' instead
of (default-value 'major-mode). Doc fix.
- http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00069.html
+ https://lists.gnu.org/r/emacs-devel/2010-04/msg00069.html
2010-04-02 Sam Steingold <sds@gnu.org>
@@ -12089,13 +12089,13 @@
* simple.el (next-line, previous-line): Re-throw a signal
with `signal' instead of using `ding'.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01432.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg01432.html
2010-03-31 Juri Linkov <juri@jurta.org>
* simple.el (keyboard-escape-quit): Raise deselecting the active
region higher than exiting the minibuffer.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00904.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg00904.html
2010-03-31 Juri Linkov <juri@jurta.org>
@@ -12184,7 +12184,7 @@
2010-03-30 Juri Linkov <juri@jurta.org>
Make occur handle multi-line matches cleanly with context.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01280.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg01280.html
* replace.el (occur-accumulate-lines): Add optional arg `pt'.
(occur-engine): Add local variables `ret', `prev-after-lines',
@@ -12379,7 +12379,7 @@
2010-03-23 Juri Linkov <juri@jurta.org>
Implement Occur multi-line matches.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg01044.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg01044.html
* replace.el (occur): Doc fix.
(occur-engine): Set `begpt' to the beginning of the first line.
@@ -12456,7 +12456,7 @@
2010-03-21 Juri Linkov <juri@jurta.org>
Fix message of multi-line occur regexps and multi-buffer header lines.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00457.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg00457.html
* replace.el (occur-1): Don't display regexp if it is longer
than window-width. Use `query-replace-descr' to display regexp.
@@ -12750,7 +12750,7 @@
2010-03-10 Kim F. Storm <storm@cua.dk>
Animated image API.
- http://lists.gnu.org/archive/html/emacs-devel/2010-03/msg00211.html
+ https://lists.gnu.org/r/emacs-devel/2010-03/msg00211.html
* image.el (image-animate-max-time): New defcustom.
(image-animated-types): New defconst.
@@ -13908,7 +13908,7 @@
positions by using `bookmark-bmenu-marks-width', instead of hardcoding.
This fixes the `bookmark-bmenu-execute-deletions' bug reported here:
- http://lists.gnu.org/archive/html/emacs-devel/2009-12/msg00819.html
+ https://lists.gnu.org/r/emacs-devel/2009-12/msg00819.html
From: Sun Yijiang <sunyijiang {_AT_} gmail.com>
To: emacs-devel {_AT_} gnu.org
Subject: bookmark.el bug report
@@ -19816,7 +19816,7 @@
* files.el (find-alternate-file): If the old buffer is modified
and visiting a file, behave similarly to `kill-buffer' when
killing it, thus reverting to the pre-1.878 behavior; see
- http://lists.gnu.org/archive/html/emacs-devel/2009-09/msg00101.html
+ https://lists.gnu.org/r/emacs-devel/2009-09/msg00101.html
for discussion. Also, consult `buffer-file-name' as a variable
not as a function, for consistency with the rest of the code.
@@ -22817,4 +22817,4 @@ See ChangeLog.14 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index 691b7945bf4..dcf2fd071d0 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -1371,7 +1371,7 @@
* frame.el (toggle-frame-maximized, toggle-frame-fullscreen):
Use fullboth as an alias for fullscreen. Suggested by Jan Djärv in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00203.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-01/msg00203.html>.
2013-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -2422,7 +2422,7 @@
* epg.el: Support pinentry-curses.
Suggested by Werner Koch in
- <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html>.
+ <https://lists.gnu.org/r/emacs-devel/2007-02/msg00755.html>.
(epg-agent-file, epg-agent-mtime): New variable.
(epg--start): Record the modified time of gpg-agent socket file,
to restore Emacs frame after pinentry-curses termination.
@@ -2448,7 +2448,7 @@
(toggle-frame-maximized): Rewrite and bind to M-<f10>.
(toggle-frame-fullscreen): New command bound to <f11> instead of
`toggle-frame-maximized'.
- http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00703.html
+ https://lists.gnu.org/r/emacs-devel/2012-12/msg00703.html
2012-12-27 Michael Albinus <michael.albinus@gmx.de>
@@ -2686,7 +2686,7 @@
(isearch-insert-char-by-name): New command.
* international/mule-cmds.el (read-char-by-name): Let-bind
`enable-recursive-minibuffers' to t.
- http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00234.html
+ https://lists.gnu.org/r/emacs-devel/2012-12/msg00234.html
2012-12-15 Juri Linkov <juri@jurta.org>
@@ -2728,7 +2728,7 @@
* vc/ediff-util.el (ediff-buffer-type): New function.
(ediff-clone-buffer-for-current-diff-comparison): Compute the buf-type
- rather than taking it as as argument.
+ rather than taking it as an argument.
(ediff-inferior-compare-regions): Adjust calls accordingly (bug#11319).
2012-12-14 Ryan Crum <ryan.crum@eleostech.com>
@@ -4831,7 +4831,7 @@
* progmodes/compile.el (compilation-error-regexp-alist-alist):
Adjust the msft regexp to the output of Studio 2010, and move msft
before edg-1. See the discussion on emacs-devel,
- http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00579.html,
+ https://lists.gnu.org/r/emacs-devel/2012-09/msg00579.html,
for the details.
2012-10-14 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -5453,7 +5453,7 @@
* profiler.el (profiler-sampling-interval): Change default back to 1.
See Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00863.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00863.html>.
2012-10-01 Fabián Ezequiel Gallina <fgallina@cuca>
@@ -6641,7 +6641,7 @@
search-whitespace-regexp if isearch-lax-whitespace or
isearch-regexp-lax-whitespace is non-nil.
(Info-mode): Don't set local variable search-whitespace-regexp.
- http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00811.html
+ https://lists.gnu.org/r/emacs-devel/2012-08/msg00811.html
2012-09-12 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -7037,7 +7037,7 @@
2012-09-02 Juri Linkov <juri@jurta.org>
Toggle whitespace matching mode with M-s SPC.
- http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00008.html
+ https://lists.gnu.org/r/emacs-devel/2012-09/msg00008.html
* isearch.el (search-whitespace-regexp): Doc fix.
Remove cons cell customization.
@@ -8109,7 +8109,7 @@
* whitespace.el (whitespace-display-mappings): Use Unicode
codepoints, instead of emacs-mule codepoints. See
- http://lists.gnu.org/archive/html/help-gnu-emacs/2012-07/msg00366.html
+ https://lists.gnu.org/r/help-gnu-emacs/2012-07/msg00366.html
for the details.
* files.el (file-truename): Don't skip symlink-chasing part on
@@ -8164,7 +8164,7 @@
* international/mule-cmds.el: Create
inactivate-current-input-method-function as an obsolete alias for
deactivate-current-input-method-function. See Katsumi Yamaoka in
- <http://bugs.gnu.org/10150#46>.
+ <https://bugs.gnu.org/10150#46>.
2012-08-01 Jay Belanger <jay.p.belanger@gmail.com>
@@ -8513,7 +8513,7 @@
* startup.el (command-line): Don't display an empty user name in
the error message about non-existent home directory, when
init-file-user was set to an empty string. See
- http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00835.html
+ https://lists.gnu.org/r/bug-gnu-emacs/2012-07/msg00835.html
for the details and context.
2012-07-22 Vincent Belaïche <vincentb1@users.sourceforge.net>
@@ -9419,7 +9419,7 @@
* calendar/calendar.el (calendar-exit): Don't try to delete or
iconify last frame. See:
- http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00372.html
+ https://lists.gnu.org/r/emacs-devel/2012-06/msg00372.html
2012-06-25 Jim Diamond <Jim.Diamond@AcadiaU.ca> (tiny change)
@@ -10430,7 +10430,7 @@
* descr-text.el (describe-char): Mention how to insert the
character, if the current input method doesn't support it.
See the discussion in this thread for the details:
- http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00533.html.
+ https://lists.gnu.org/r/emacs-devel/2012-05/msg00533.html.
2012-06-08 Sam Steingold <sds@gnu.org>
@@ -11992,11 +11992,11 @@
* progmodes/verilog-mode.el (verilog-pretty-expr): Don't line up
assignment with tests in ifs and for loops.
(verilog-extended-complete-re, verilog-complete-reg): Change so
- that DPI inport functions don't look like fuction declarations.
+ that DPI inport functions don't look like function declarations.
(verilog-pretty-expr): Don't line up assignment
operations to the test and increment in if and for loops
(verilog-extended-complete-re, verilog-complete-reg): Change so
- that DPI inport functions don't look like fuction declarations.
+ that DPI inport functions don't look like function declarations.
2012-05-03 Kenichi Handa <handa@m17n.org>
@@ -13909,7 +13909,7 @@
Insert invisible LRM characters before each character in a keyboard
layout cell, to prevent their reordering by bidi display engine.
For details, see the discussion in
- http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00085.html.
+ https://lists.gnu.org/r/emacs-devel/2012-03/msg00085.html.
2012-03-08 Alan Mackenzie <acm@muc.de>
@@ -13927,7 +13927,7 @@
* international/quail.el (quail-help):
Force bidi-paragraph-direction be left-to-right. See discussion in
- http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00062.html
+ https://lists.gnu.org/r/emacs-devel/2012-03/msg00062.html
for the reason.
2012-03-07 Michael Albinus <michael.albinus@gmx.de>
@@ -15004,7 +15004,7 @@
* descr-text.el (describe-char): Show the raw character, not only
its display form at POS. Suggested by Kenichi Handa <handa@m17n.org>.
- See http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00760.html
+ See https://lists.gnu.org/r/emacs-devel/2012-01/msg00760.html
for the reasons.
2012-01-28 Phil Hagelberg <phil@hagelb.org>
@@ -15362,7 +15362,7 @@
* time.el (display-time-load-average)
(display-time-default-load-average): Doc fixes. See the thread
starting at
- http://lists.gnu.org/archive/html/help-gnu-emacs/2012-01/msg00059.html
+ https://lists.gnu.org/r/help-gnu-emacs/2012-01/msg00059.html
for the details.
2012-01-06 Glenn Morris <rgm@gnu.org>
@@ -15769,7 +15769,7 @@
(texinfo-insert-master-menu-list): Improve the error message
displayed if there's no menu in the Top node.
(Bug#2975) See also this thread:
- http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00156.html.
+ https://lists.gnu.org/r/emacs-devel/2011-12/msg00156.html.
2011-12-09 Manuel Gómez <mgrojo@gmail.com> (tiny change)
@@ -20919,7 +20919,7 @@
(ses-formula-references): Robustify against self-referring cells.
(ses-mode): Use ses-set-localvars.
(ses-command-hook): Add call to ses-initialize-Dijkstra-attempt
- before lauching the update processing.
+ before launching the update processing.
(ses-initialize-Dijkstra-attempt): New function.
(ses-recalculate-cell): Update for cycle detection based on
Dijkstra algorithm.
@@ -24381,7 +24381,7 @@
* help-fns.el (describe-variable): Complete all variables having
documentation, including keywords.
- http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00112.html
+ https://lists.gnu.org/r/emacs-devel/2011-04/msg00112.html
2011-04-04 Juanma Barranquero <lekktu@gmail.com>
@@ -25238,4 +25238,4 @@ See ChangeLog.15 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
index 6dfddf72e8f..b2d315c53f3 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -3598,7 +3598,7 @@
* comint.el (comint-history-isearch-message): Use field-beginning
instead of comint-line-beginning-position - that's more fixes for
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg00305.html
(comint-history-isearch-message): Fix args of isearch-message-prefix.
2014-12-29 Juri Linkov <juri@linkov.net>
@@ -3698,7 +3698,7 @@
* language/misc-lang.el (composition-function-table): Add Syriac
characters and also ZWJ/ZWNJ.
- See http://lists.gnu.org/archive/html/help-gnu-emacs/2014-12/msg00248.html
+ See https://lists.gnu.org/r/help-gnu-emacs/2014-12/msg00248.html
for the details.
2014-12-27 Fabián Ezequiel Gallina <fgallina@gnu.org>
@@ -4489,14 +4489,14 @@
comint-line-beginning-position.
(comint-send-input): Go to the end of the field instead of the end
of the line to accept whole multi-line input.
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00305.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg00305.html
2014-12-05 Juri Linkov <juri@linkov.net>
* minibuffer.el (minibuffer-completion-help):
Compare selected-window with minibuffer-window to check whether
completions should be displayed near the minibuffer. (Bug#17809)
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00311.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg00311.html
2014-12-05 Michael Albinus <michael.albinus@gmx.de>
@@ -4605,7 +4605,7 @@
the remote repository were unreachable, because the VC hooks tried
to run "svn status -u" on the file, where the "-u" tells svn to
get update information from the remote repository.
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg00174.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg00174.html
* vc/vc-svn.el (vc-svn-state): Remove optional `localp'
argument and always pass "-v" to "svn status", never "-u".
@@ -5306,7 +5306,7 @@
(query-replace-read-from): Call custom-reevaluate-setting on
query-replace-from-to-separator to reevaluate the separator
depending on the return value of char-displayable-p.
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00466.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg00466.html
2014-11-18 Juri Linkov <juri@linkov.net>
@@ -5316,7 +5316,7 @@
* simple.el (next-line-or-history-element)
(previous-line-or-history-element): New commands.
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00822.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg00822.html
2014-11-18 Leo Liu <sdl.web@gmail.com>
@@ -5441,7 +5441,7 @@
Improve time stamp handling, and be more consistent about it.
This implements a suggestion made in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00587.html
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00587.html
Among other things, this means timer.el no longer needs to
autoload the time-date module.
* allout-widgets.el (allout-elapsed-time-seconds): Doc fix.
@@ -5682,7 +5682,7 @@
2014-11-10 Sylvain Chouleur <sylvain.chouleur@gmail.com> (tiny change)
Allow VTIMEZONE where daylight and standard time zones are equal.
- See: http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00494.html
+ See: https://lists.gnu.org/r/emacs-devel/2014-11/msg00494.html
* calendar/icalendar.el (icalendar--convert-tz-offset):
Support timezone without daylight saving time.
@@ -5813,7 +5813,7 @@
to the history variables.
(query-replace-read-to): Add FROM-TO pairs to query-replace-defaults.
(query-replace-regexp-eval): Let-bind query-replace-defaults to nil.
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg00253.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg00253.html
* isearch.el (isearch-text-char-description): Keep characters
intact and put formatted strings with the `display' property.
@@ -7565,7 +7565,7 @@
(lisp--form-quoted-p): New functions.
(lisp-completion-at-point): Use them to see if we're completing a
variable reference, a function name, or just any symbol.
- http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html
+ https://lists.gnu.org/r/emacs-devel/2014-02/msg00229.html
2014-09-18 Ivan Kanis <ivan@kanis.fr>
@@ -9937,7 +9937,7 @@
`window-configuration-change-hook'.
(desktop-auto-save-set-timer): Change REPEAT arg of
`run-with-idle-timer' from t to nil.
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00147.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00147.html
2014-06-08 Santiago Payà i Miralta <santiagopim@gmail.com>
@@ -10488,7 +10488,7 @@
* emacs-lisp/package.el (package-generate-description-file):
Output first-line comment to set buffer-local var `no-byte-compile'.
Suggested by Dmitry Gutov:
- <http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00401.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-05/msg00401.html>.
2014-05-25 Thien-Thi Nguyen <ttn@gnu.org>
@@ -12170,7 +12170,7 @@
to `comment-start-skip' if not `comment-use-syntax'. (Bug#16971)
(comment-beginning): Use `narrow-to-region' instead of moving back
one character.
- (http://lists.gnu.org/archive/html/emacs-devel/2014-03/msg00488.html)
+ (https://lists.gnu.org/r/emacs-devel/2014-03/msg00488.html)
(comment-start-skip): Update the docstring.
2014-03-18 Richard Stallman <rms@gnu.org>
@@ -12467,7 +12467,7 @@
from `xterm-standard-colors' that look well on the default white
background (and also on the black background) to avoid illegible
color combinations like yellow-on-white and white-on-white.
- http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00157.html
+ https://lists.gnu.org/r/emacs-devel/2014-02/msg00157.html
2014-03-08 Juanma Barranquero <lekktu@gmail.com>
@@ -13224,7 +13224,7 @@
2014-02-12 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/js.el (js-indent-line): Don't widen.
- http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00276.html
+ https://lists.gnu.org/r/emacs-devel/2012-06/msg00276.html
2014-02-12 Glenn Morris <rgm@gnu.org>
@@ -13965,7 +13965,7 @@
choices.
(ruby-smie-rules): Instead of using a hardcoded list of alignable
keywords, check against the value of `ruby-alignable-keywords'
- (http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01439.html).
+ (https://lists.gnu.org/r/emacs-devel/2014-01/msg01439.html).
2014-01-17 Glenn Morris <rgm@gnu.org>
@@ -14161,7 +14161,7 @@
2014-01-10 Eric S. Raymond <esr@thyrsus.com>
- * version.el (emacs-bzr-get-version): Restore compatibilty with
+ * version.el (emacs-bzr-get-version): Restore compatibility with
24.3 (Tested).
2014-01-10 Bozhidar Batsov <bozhidar@batsov.com>
@@ -15408,7 +15408,7 @@
* simple.el (blink-matching--overlay): New variable.
(blink-matching-open): Instead of moving point, highlight the
matching paren with an overlay
- (http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00333.html).
+ (https://lists.gnu.org/r/emacs-devel/2013-12/msg00333.html).
* faces.el (paren-showing-faces, show-paren-match)
(show-paren-mismatch): Move from paren.el.
@@ -16628,7 +16628,7 @@
* textmodes/ispell.el (ispell-lookup-words): When `look' is not
available and the word has no wildcards, append one to the grep pattern.
- http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00258.html
+ https://lists.gnu.org/r/emacs-devel/2013-11/msg00258.html
(ispell-complete-word): Call `ispell-lookup-words' with the value
independent of `ispell-look-p'.
@@ -18282,7 +18282,7 @@
* emacs-lisp/package.el (package-buffer-info, describe-package-1):
Use :url instead of :homepage, as per
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00622.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00622.html
* newcomment.el (comment-beginning): When `comment-use-syntax' is
non-nil, use `syntax-ppss' (Bug#15251).
@@ -19828,7 +19828,7 @@
* xml.el (xml-parse-tag-1): Use looking-at (this reverts change in
2013-08-11T00:07:48Z!lekktu@gmail.com, which breaks the test suite).
- https://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00263.html
+ https://lists.gnu.org/r/emacs-devel/2013-08/msg00263.html
2013-08-12 Eli Zaretskii <eliz@gnu.org>
@@ -21942,7 +21942,7 @@
2013-06-25 Martin Rudalics <rudalics@gmx.at>
* window.el (window--state-get-1): Workaround for bug#14527.
- http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00941.html
+ https://lists.gnu.org/r/emacs-devel/2013-06/msg00941.html
2013-06-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -22055,7 +22055,7 @@
* progmodes/ruby-mode.el (ruby-font-lock-keywords): Move `catch',
add some more keyword-like methods.
- http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00911.html
+ https://lists.gnu.org/r/emacs-devel/2013-06/msg00911.html
2013-06-22 Juanma Barranquero <lekktu@gmail.com>
@@ -22674,7 +22674,7 @@
2013-06-18 Matthias Meulien <orontee@gmail.com>
* tabify.el (untabify, tabify): With prefix, apply to entire buffer.
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00545.html>
+ <https://lists.gnu.org/r/emacs-devel/2013-03/msg00545.html>
2013-06-18 Glenn Morris <rgm@gnu.org>
@@ -22704,7 +22704,7 @@
* emacs-lisp/package.el (package-load-descriptor):
Remove `with-syntax-table' call, `read' doesn't need it.
- http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00539.html
+ https://lists.gnu.org/r/emacs-devel/2013-06/msg00539.html
2013-06-17 Juanma Barranquero <lekktu@gmail.com>
@@ -23666,7 +23666,7 @@
2013-05-28 Alan Mackenzie <acm@muc.de>
- Handle "capitalised keywords" correctly.
+ Handle "capitalized keywords" correctly.
* progmodes/cc-mode.el (c-after-change): Bind case-fold-search to nil.
2013-05-28 Aidan Gauland <aidalgol@amuri.net>
@@ -25118,7 +25118,7 @@
(desktop-auto-save, desktop-auto-save-set-timer): New functions.
(after-init-hook): Call `desktop-auto-save-set-timer'.
Suggested by Reuben Thomas <rrt@sc3d.org> in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00327.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-04/msg00327.html>.
2013-04-27 Leo Liu <sdl.web@gmail.com>
@@ -25144,7 +25144,7 @@
* ls-lisp.el (ls-lisp-insert-directory): If no files are
displayed, move point to after the totals line.
- See http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00677.html
+ See https://lists.gnu.org/r/emacs-devel/2013-04/msg00677.html
for the details.
2013-04-27 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -25757,7 +25757,7 @@
Do not set x-display-name until X connection is established.
This is needed to prevent from weird situation described at
- <http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00212.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-04/msg00212.html>.
* frame.el (make-frame): Set x-display-name after call to
window system initialization function, not before.
* term/x-win.el (x-initialize-window-system): Add optional
@@ -26079,7 +26079,7 @@
(batch-skkdic-convert): Suppress most of the chatter.
It's not needed so much now that machines are faster,
and its non-ASCII component was confusing; see Dmitry Gutov in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00508.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-03/msg00508.html>.
2013-03-20 Leo Liu <sdl.web@gmail.com>
@@ -26223,7 +26223,7 @@
* startup.el (command-line-normalize-file-name): Fix handling of
backslashes in DOS and Windows file names. Reported by Xue Fuqiao
<xfq.free@gmail.com> in
- http://lists.gnu.org/archive/html/help-gnu-emacs/2013-03/msg00245.html.
+ https://lists.gnu.org/r/help-gnu-emacs/2013-03/msg00245.html.
2013-03-15 Michael Albinus <michael.albinus@gmx.de>
@@ -26309,4 +26309,4 @@ See ChangeLog.16 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.2 b/lisp/ChangeLog.2
index 7a4845374f8..5087b943e3a 100644
--- a/lisp/ChangeLog.2
+++ b/lisp/ChangeLog.2
@@ -4007,4 +4007,4 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3
index 3bac72a69da..1ba33b1085f 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -12448,4 +12448,4 @@ See ChangeLog.2 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4
index 00ce74e5150..00798e590c5 100644
--- a/lisp/ChangeLog.4
+++ b/lisp/ChangeLog.4
@@ -8949,4 +8949,4 @@ See ChangeLog.3 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.5 b/lisp/ChangeLog.5
index 800277b1239..64abfe988f5 100644
--- a/lisp/ChangeLog.5
+++ b/lisp/ChangeLog.5
@@ -9283,4 +9283,4 @@ See ChangeLog.4 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index 84826379890..64a9d4df8ed 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -1473,7 +1473,7 @@
1996-04-18 Richard Stallman <rms@mole.gnu.ai.mit.edu>
* term/win32-win.el (x-select-text): Remember selected text.
- (x-get-selection-value): Return nil if the clipboard data is
+ (x-get-selection-value): Return nil if the clipboard data
is the same as the remembered selected text.
1996-04-18 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
@@ -8036,4 +8036,4 @@ See ChangeLog.5 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 52a0180c633..62ee295b899 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -23126,4 +23126,4 @@ See ChangeLog.6 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 7e4522f53f4..57b5584ebe4 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -10007,4 +10007,4 @@ See ChangeLog.7 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index e51c0c5dad3..16e0a88052b 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -2033,7 +2033,7 @@
(uniquify-get-proposed-name): Arguments changed, callers changed.
(uniquify-rationalize-conflicting-sublist): Explicitly reset the
uniquify-possibly-resolvable flag, which is no more bound locally.
- (uniquify-rename-buffer): Do not set the old unrationalised-buffer
+ (uniquify-rename-buffer): Do not set the old unrationalized-buffer
flag, which does not exist any more.
2001-07-23 Eli Zaretskii <eliz@is.elta.co.il>
@@ -20700,4 +20700,4 @@ See ChangeLog.8 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 653200577db..de3dc186170 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
SHELL = @SHELL@
@@ -132,13 +132,13 @@ PHONY_EXTRAS =
# This could lead to problems in parallel builds if automatically
# generated *.el files (eg loaddefs etc) were being changed at the same time.
# One solution was to add autoloads as a prerequisite:
-# http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
-# http://lists.gnu.org/archive/html/bug-gnu-emacs/2007-12/msg00171.html
+# https://lists.gnu.org/r/emacs-pretest-bug/2007-01/msg00469.html
+# https://lists.gnu.org/r/bug-gnu-emacs/2007-12/msg00171.html
# However, this meant that running these targets modified loaddefs.el,
# every time (due to time-stamping). Calling these rules from
# bootstrap-after would modify loaddefs after src/emacs, resulting
# in make install remaking src/emacs for no real reason:
-# http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg00311.html
+# https://lists.gnu.org/r/emacs-devel/2008-02/msg00311.html
# Nowadays these commands don't scan automatically generated files,
# since they will never contain any useful information
# (see finder-no-scan-regexp and custom-dependencies-no-scan-regexp).
@@ -481,7 +481,7 @@ check-defun-dups:
## ones that don't change very often at that) seems pretty pointless
## to me.
-# http://debbugs.gnu.org/1004
+# https://debbugs.gnu.org/1004
# CC Mode uses a compile time macro system which causes a compile time
# dependency in cc-*.elc files on the macros in other cc-*.el and the
# version string in cc-defs.el.
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 01ad3d478fc..dbda5b5d2ec 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/align.el b/lisp/align.el
index 081f587d4b2..084cd21b402 100644
--- a/lisp/align.el
+++ b/lisp/align.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index c07bbd0b768..9fa927ddcb3 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -768,8 +768,7 @@ Optional RECURSING is for internal use, to limit recursion."
(if allout-widgets-time-decoration-activity
(setq allout-widgets-last-decoration-timing
- (list (allout-elapsed-time-seconds (current-time)
- start-time)
+ (list (allout-elapsed-time-seconds nil start-time)
allout-widgets-changes-record)))
(setq allout-widgets-changes-record nil)
diff --git a/lisp/allout.el b/lisp/allout.el
index 529de85cd42..9e83a2fb2c8 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -357,7 +357,7 @@ Examples:
grandchildren, but completely collapse the final top-level topic.
(-1 () : 1 0)
Close the first topic so only the immediate subtopics are shown,
- leave the subsequent topics exposed as they are until the second
+ leave the subsequent topics exposed as they are until the
second to last topic, which is exposed at least one level, and
completely close the last topic.
(-2 : -1 *)
@@ -1687,7 +1687,7 @@ from what it did before, for backwards compatibility.
MODE is the activation mode - see `allout-auto-activation' for
valid values."
(declare (obsolete allout-auto-activation "23.3"))
- (custom-set-variables (list 'allout-auto-activation (format "%s" mode)))
+ (customize-set-variable 'allout-auto-activation (format "%s" mode))
(format "%s" mode))
;;;_ > allout-setup-menubar ()
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 47437bb7c87..71b79223429 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -150,17 +150,14 @@ foreground and background colors, respectively."
:version "24.4" ; default colors copied from `xterm-standard-colors'
:group 'ansi-colors)
-(defconst ansi-color-regexp "\033\\[\\([0-9;]*m\\)"
- "Regexp that matches SGR control sequences.")
-
-(defconst ansi-color-drop-regexp
- "\033\\[\\([ABCDsuK]\\|[12][JK]\\|=[0-9]+[hI]\\|[0-9;]*[Hf]\\|\\?[0-9]+[hl]\\)"
- "Regexp that matches ANSI control sequences to silently drop.")
+(defconst ansi-color-control-seq-regexp
+ ;; See ECMA 48, section 5.4 "Control Sequences".
+ "\e\\[[\x30-\x3F]*[\x20-\x2F]*[\x40-\x7E]"
+ "Regexp matching an ANSI control sequence.")
(defconst ansi-color-parameter-regexp "\\([0-9]*\\)[m;]"
"Regexp that matches SGR control sequence parameters.")
-
;; Convenience functions for comint modes (eg. shell-mode)
@@ -185,7 +182,7 @@ in shell buffers. You set this variable by calling one of:
:group 'ansi-colors
:version "23.2")
-(defvar ansi-color-apply-face-function 'ansi-color-apply-overlay-face
+(defvar ansi-color-apply-face-function #'ansi-color-apply-overlay-face
"Function for applying an Ansi Color face to text in a buffer.
This function should accept three arguments: BEG, END, and FACE,
and it should apply face FACE to the text between BEG and END.")
@@ -259,22 +256,20 @@ This function can be added to `comint-preoutput-filter-functions'."
(setq string (concat (cadr ansi-color-context) string)
ansi-color-context nil))
;; find the next escape sequence
- (while (setq end (string-match ansi-color-regexp string start))
- (setq result (concat result (substring string start end))
- start (match-end 0)))
- ;; eliminate unrecognized escape sequences
- (while (string-match ansi-color-drop-regexp string)
- (setq string
- (replace-match "" nil nil string)))
+ (while (setq end (string-match ansi-color-control-seq-regexp string start))
+ (push (substring string start end) result)
+ (setq start (match-end 0)))
;; save context, add the remainder of the string to the result
(let (fragment)
- (if (string-match "\033" string start)
- (let ((pos (match-beginning 0)))
- (setq fragment (substring string pos)
- result (concat result (substring string start pos))))
- (setq result (concat result (substring string start))))
+ (push (substring string start
+ (if (string-match "\033" string start)
+ (let ((pos (match-beginning 0)))
+ (setq fragment (substring string pos))
+ pos)
+ nil))
+ result)
(setq ansi-color-context (if fragment (list nil fragment))))
- result))
+ (apply #'concat (nreverse result))))
(defun ansi-color--find-face (codes)
"Return the face corresponding to CODES."
@@ -306,35 +301,29 @@ Set `ansi-color-context' to nil if you don't want this.
This function can be added to `comint-preoutput-filter-functions'."
(let ((codes (car ansi-color-context))
- (start 0) end escape-sequence result
- colorized-substring)
+ (start 0) end result)
;; If context was saved and is a string, prepend it.
(if (cadr ansi-color-context)
(setq string (concat (cadr ansi-color-context) string)
ansi-color-context nil))
;; Find the next escape sequence.
- (while (setq end (string-match ansi-color-regexp string start))
- (setq escape-sequence (match-string 1 string))
- ;; Colorize the old block from start to end using old face.
- (when codes
- (put-text-property start end 'font-lock-face (ansi-color--find-face codes) string))
- (setq colorized-substring (substring string start end)
- start (match-end 0))
- ;; Eliminate unrecognized ANSI sequences.
- (while (string-match ansi-color-drop-regexp colorized-substring)
- (setq colorized-substring
- (replace-match "" nil nil colorized-substring)))
- (push colorized-substring result)
- ;; Create new face, by applying escape sequence parameters.
- (setq codes (ansi-color-apply-sequence escape-sequence codes)))
+ (while (setq end (string-match ansi-color-control-seq-regexp string start))
+ (let ((esc-end (match-end 0)))
+ ;; Colorize the old block from start to end using old face.
+ (when codes
+ (put-text-property start end 'font-lock-face
+ (ansi-color--find-face codes) string))
+ (push (substring string start end) result)
+ (setq start (match-end 0))
+ ;; If this is a color escape sequence,
+ (when (eq (aref string (1- esc-end)) ?m)
+ ;; create a new face from it.
+ (setq codes (ansi-color-apply-sequence
+ (substring string end esc-end) codes)))))
;; if the rest of the string should have a face, put it there
(when codes
(put-text-property start (length string)
'font-lock-face (ansi-color--find-face codes) string))
- ;; eliminate unrecognized escape sequences
- (while (string-match ansi-color-drop-regexp string)
- (setq string
- (replace-match "" nil nil string)))
;; save context, add the remainder of the string to the result
(let (fragment)
(if (string-match "\033" string start)
@@ -367,13 +356,9 @@ it will override BEGIN, the start of the region. Set
(start (or (cadr ansi-color-context-region) begin)))
(save-excursion
(goto-char start)
- ;; Delete unrecognized escape sequences.
- (while (re-search-forward ansi-color-drop-regexp end-marker t)
- (replace-match ""))
- (goto-char start)
- ;; Delete SGR escape sequences.
- (while (re-search-forward ansi-color-regexp end-marker t)
- (replace-match ""))
+ ;; Delete escape sequences.
+ (while (re-search-forward ansi-color-control-seq-regexp end-marker t)
+ (delete-region (match-beginning 0) (match-end 0)))
;; save context, add the remainder of the string to the result
(if (re-search-forward "\033" end-marker t)
(setq ansi-color-context-region (list nil (match-beginning 0)))
@@ -400,28 +385,24 @@ this."
(let ((codes (car ansi-color-context-region))
(start-marker (or (cadr ansi-color-context-region)
(copy-marker begin)))
- (end-marker (copy-marker end))
- escape-sequence)
- ;; First, eliminate unrecognized ANSI control sequences.
- (save-excursion
- (goto-char start-marker)
- (while (re-search-forward ansi-color-drop-regexp end-marker t)
- (replace-match "")))
+ (end-marker (copy-marker end)))
(save-excursion
(goto-char start-marker)
- ;; Find the next SGR sequence.
- (while (re-search-forward ansi-color-regexp end-marker t)
- ;; Colorize the old block from start to end using old face.
- (funcall ansi-color-apply-face-function
- start-marker (match-beginning 0)
- (ansi-color--find-face codes))
- ;; store escape sequence and new start position
- (setq escape-sequence (match-string 1)
- start-marker (copy-marker (match-end 0)))
- ;; delete the escape sequence
- (replace-match "")
- ;; Update the list of ansi codes.
- (setq codes (ansi-color-apply-sequence escape-sequence codes)))
+ ;; 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
+ (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)
+ ;; Store new start position.
+ (set-marker start-marker (point)))
+ (match-beginning 0) (ansi-color--find-face codes))
+ ;; If this is a color sequence,
+ (when (eq (aref esc-seq (1- (length esc-seq))) ?m)
+ ;; update the list of ansi codes.
+ (setq codes (ansi-color-apply-sequence esc-seq codes)))))
;; search for the possible start of a new escape sequence
(if (re-search-forward "\033" end-marker t)
(progn
@@ -499,7 +480,9 @@ Emacs requires OBJECT to be a buffer."
;; In order to avoid this, we use the `insert-behind-hooks' overlay
;; property to make sure it works.
(let ((overlay (make-overlay from to object)))
+ (overlay-put overlay 'evaporate t)
(overlay-put overlay 'modification-hooks '(ansi-color-freeze-overlay))
+ (overlay-put overlay 'insert-behind-hooks '(ansi-color-freeze-overlay))
overlay)))
(defun ansi-color-freeze-overlay (overlay is-after begin end &optional len)
diff --git a/lisp/apropos.el b/lisp/apropos.el
index cbd9c71d3e3..807fd854c19 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -514,6 +514,19 @@ options only, i.e. behave like `apropos-user-option'."
(let ((apropos-do-all (if do-not-all nil t)))
(apropos-user-option pattern)))
+;;;###autoload
+(defun apropos-local-variable (pattern &optional buffer)
+ "Show buffer-local variables that match PATTERN.
+Optional arg BUFFER (default: current buffer) is the buffer to check.
+
+The output includes variables that are not yet set in BUFFER, but that
+will be buffer-local when set."
+ (interactive (list (apropos-read-pattern "buffer-local variable")))
+ (unless buffer (setq buffer (current-buffer)))
+ (apropos-command pattern nil (lambda (symbol)
+ (and (local-variable-if-set-p symbol)
+ (get symbol 'variable-documentation)))))
+
;; For auld lang syne:
;;;###autoload
(defalias 'command-apropos 'apropos-command)
@@ -795,6 +808,35 @@ Returns list of symbols and values found."
(let ((apropos-multi-type do-all))
(apropos-print nil "\n----------------\n")))
+;;;###autoload
+(defun apropos-local-value (pattern &optional buffer)
+ "Show buffer-local variables whose values match PATTERN.
+This is like `apropos-value', but only for buffer-local variables.
+Optional arg BUFFER (default: current buffer) is the buffer to check."
+ (interactive (list (apropos-read-pattern "value of buffer-local variable")))
+ (unless buffer (setq buffer (current-buffer)))
+ (apropos-parse-pattern pattern)
+ (setq apropos-accumulator ())
+ (let ((var nil))
+ (mapatoms
+ (lambda (symb)
+ (unless (memq symb '(apropos-regexp apropos-pattern apropos-all-words-regexp
+ apropos-words apropos-all-words apropos-accumulator symb var))
+ (setq var (apropos-value-internal 'local-variable-if-set-p symb 'symbol-value)))
+ (when (and (fboundp 'apropos-false-hit-str) (apropos-false-hit-str var))
+ (setq var nil))
+ (when var
+ (setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var)
+ apropos-accumulator))))))
+ (let ((apropos-multi-type nil))
+ (if (> emacs-major-version 20)
+ (apropos-print
+ nil "\n----------------\n"
+ (format "Buffer `%s' has the following local variables\nmatching %s`%s':"
+ (buffer-name buffer)
+ (if (consp pattern) "keywords " "")
+ pattern))
+ (apropos-print nil "\n----------------\n"))))
;;;###autoload
(defun apropos-documentation (pattern &optional do-all)
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index bd7548b704f..b06c07fea87 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -559,13 +559,13 @@ FLOAT, if non-nil, means generate and return a float instead of an integer
(if (zerop (logand 256 mode)) ?- ?r)
(if (zerop (logand 128 mode)) ?- ?w)
(if (zerop (logand 64 mode))
- (if (zerop (logand 1024 mode)) ?- ?S)
- (if (zerop (logand 1024 mode)) ?x ?s))
+ (if (zerop (logand 2048 mode)) ?- ?S)
+ (if (zerop (logand 2048 mode)) ?x ?s))
(if (zerop (logand 32 mode)) ?- ?r)
(if (zerop (logand 16 mode)) ?- ?w)
(if (zerop (logand 8 mode))
- (if (zerop (logand 2048 mode)) ?- ?S)
- (if (zerop (logand 2048 mode)) ?x ?s))
+ (if (zerop (logand 1024 mode)) ?- ?S)
+ (if (zerop (logand 1024 mode)) ?x ?s))
(if (zerop (logand 4 mode)) ?- ?r)
(if (zerop (logand 2 mode)) ?- ?w)
(if (zerop (logand 1 mode)) ?- ?x)))
diff --git a/lisp/array.el b/lisp/array.el
index 1481ff26df2..d9554618db4 100644
--- a/lisp/array.el
+++ b/lisp/array.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 529e3024a62..f4f096160ef 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -139,11 +139,6 @@ CONTENTS is the contents of a password-store formatted file."
(mapconcat #'identity (cdr pair) ":")))))
(cdr lines)))))
-(defun auth-source-pass--user-match-p (entry user)
- "Return true iff ENTRY match USER."
- (or (null user)
- (string= user (auth-source-pass-get "user" entry))))
-
(defun auth-source-pass--hostname (host)
"Extract hostname from HOST."
(let ((url (url-generic-parse-url host)))
@@ -159,6 +154,11 @@ CONTENTS is the contents of a password-store formatted file."
(hostname hostname)
(t host))))
+(defun auth-source-pass--user (host)
+ "Extract user from HOST and return it.
+Return nil if no match was found."
+ (url-user (url-generic-parse-url host)))
+
(defun auth-source-pass--do-debug (&rest msg)
"Call `auth-source-do-debug` with MSG and a prefix."
(apply #'auth-source-do-debug
@@ -235,14 +235,17 @@ matching USER."
If many matches are found, return the first one. If no match is
found, return nil."
(or
- (if (url-user (url-generic-parse-url host))
+ (if (auth-source-pass--user host)
;; if HOST contains a user (e.g., "user@host.com"), <HOST>
(auth-source-pass--find-one-by-entry-name (auth-source-pass--hostname-with-user host) user)
;; otherwise, if USER is provided, search for <USER>@<HOST>
(when (stringp user)
(auth-source-pass--find-one-by-entry-name (concat user "@" (auth-source-pass--hostname host)) user)))
- ;; if that didn't work, search for HOST without it's user component if any
+ ;; if that didn't work, search for HOST without its user component, if any
(auth-source-pass--find-one-by-entry-name (auth-source-pass--hostname host) user)
+ ;; if that didn't work, search for HOST with user extracted from it
+ (auth-source-pass--find-one-by-entry-name
+ (auth-source-pass--hostname host) (auth-source-pass--user host))
;; if that didn't work, remove subdomain: foo.bar.com -> bar.com
(let ((components (split-string host "\\.")))
(when (= (length components) 3)
diff --git a/lisp/auth-source.el b/lisp/auth-source.el
index 01d12c26141..1cb7f5d57ef 100644
--- a/lisp/auth-source.el
+++ b/lisp/auth-source.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -200,8 +200,6 @@ Note that if EPA/EPG is not available, this should NOT be used."
(const :tag "Save GPG-encrypted password tokens" gpg)
(const :tag "Don't encrypt tokens" never))))))
-(defvar auth-source-magic "auth-source-magic ")
-
(defcustom auth-source-do-cache t
"Whether auth-source should cache information with `password-cache'."
:group 'auth-source
@@ -782,16 +780,16 @@ Returns the deleted entries."
(defun auth-source-forget-all-cached ()
"Forget all cached auth-source data."
(interactive)
- (cl-do-symbols (sym password-data)
- ;; when the symbol name starts with auth-source-magic
- (when (string-match (concat "^" auth-source-magic) (symbol-name sym))
- ;; remove that key
- (password-cache-remove (symbol-name sym))))
+ (maphash (lambda (key _password)
+ (when (eq 'auth-source (car-safe key))
+ ;; remove that key
+ (password-cache-remove key)))
+ password-data)
(setq auth-source-netrc-cache nil))
(defun auth-source-format-cache-entry (spec)
"Format SPEC entry to put it in the password cache."
- (concat auth-source-magic (format "%S" spec)))
+ `(auth-source . ,spec))
(defun auth-source-remember (spec found)
"Remember FOUND search results for SPEC."
@@ -822,18 +820,16 @@ This is not a full `auth-source-search' spec but works similarly.
For instance, \(:host \"myhost\" \"yourhost\") would find all the
cached data that was found with a search for those two hosts,
while \(:host t) would find all host entries."
- (let ((count 0)
- sname)
- (cl-do-symbols (sym password-data)
- ;; when the symbol name matches with auth-source-magic
- (when (and (setq sname (symbol-name sym))
- (string-match (concat "^" auth-source-magic "\\(.+\\)")
- sname)
- ;; and the spec matches what was stored in the cache
- (auth-source-specmatchp spec (read (match-string 1 sname))))
- ;; remove that key
- (password-cache-remove sname)
- (cl-incf count)))
+ (let ((count 0))
+ (maphash
+ (lambda (key _password)
+ (when (and (eq 'auth-source (car-safe key))
+ ;; and the spec matches what was stored in the cache
+ (auth-source-specmatchp spec (cdr key)))
+ ;; remove that key
+ (password-cache-remove key)
+ (cl-incf count)))
+ password-data)
count))
(defun auth-source-specmatchp (spec stored)
@@ -934,7 +930,7 @@ Note that the MAX parameter is used so we can exit the parse early."
(or
;; the required list of keys is nil, or
(null require)
- ;; every element of require is in n(ormalized)
+ ;; every element of require is in n (normalized)
(let ((n (nth 0 (auth-source-netrc-normalize
(list alist) file))))
(cl-loop for req in require
diff --git a/lisp/autoarg.el b/lisp/autoarg.el
index 79916933edb..7677b9ed7ba 100644
--- a/lisp/autoarg.el
+++ b/lisp/autoarg.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index fef42161bf3..a43e068a4dc 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -141,14 +141,14 @@ If this contains a %s, that will be replaced by the matching rule."
"
.\\\" You may distribute this file under the terms of the GNU Free
.\\\" Documentation License.
-.TH " (file-name-base)
+.TH " (file-name-base (buffer-file-name))
" " (file-name-extension (buffer-file-name))
" " (format-time-string "%Y-%m-%d ")
"\n.SH NAME\n"
- (file-name-base)
+ (file-name-base (buffer-file-name))
" \\- " str
"\n.SH SYNOPSIS
-.B " (file-name-base)
+.B " (file-name-base (buffer-file-name))
"\n"
_
"
@@ -200,7 +200,7 @@ If this contains a %s, that will be replaced by the matching rule."
\;; GNU General Public License for more details.
\;; You should have received a copy of the GNU General Public License
-\;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+\;; along with this program. If not, see <https://www.gnu.org/licenses/>.
\;;; Commentary:
@@ -211,7 +211,7 @@ If this contains a %s, that will be replaced by the matching rule."
\(provide '"
- (file-name-base)
+ (file-name-base (buffer-file-name))
")
\;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")
(("\\.texi\\(nfo\\)?\\'" . "Texinfo file skeleton")
@@ -219,7 +219,7 @@ If this contains a %s, that will be replaced by the matching rule."
"\\input texinfo @c -*-texinfo-*-
@c %**start of header
@setfilename "
- (file-name-base) ".info\n"
+ (file-name-base (buffer-file-name)) ".info\n"
"@settitle " str "
@c %**end of header
@copying\n"
@@ -237,7 +237,7 @@ A copy of the license is included in the section entitled ``GNU
Free Documentation License''.
A copy of the license is also available from the Free Software
-Foundation Web site at @url{http://www.gnu.org/licenses/fdl.html}.
+Foundation Web site at @url{https://www.gnu.org/licenses/fdl.html}.
@end quotation
@@ -284,7 +284,7 @@ The document was typeset with
* GNU Free Documentation License:: License for copying this manual.
@end menu
-@c Get fdl.texi from http://www.gnu.org/licenses/fdl.html
+@c Get fdl.texi from https://www.gnu.org/licenses/fdl.html
@include fdl.texi
@node Index
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 79291624523..4b70f73fe3e 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -319,10 +319,12 @@ the list of old buffers.")
(defvar auto-revert-tail-pos 0
"Position of last known end of file.")
+(defun auto-revert-find-file-function ()
+ (setq-local auto-revert-tail-pos
+ (nth 7 (file-attributes buffer-file-name))))
+
(add-hook 'find-file-hook
- (lambda ()
- (setq-local auto-revert-tail-pos
- (nth 7 (file-attributes buffer-file-name)))))
+ #'auto-revert-find-file-function)
(defvar auto-revert-notify-watch-descriptor-hash-list
(make-hash-table :test 'equal)
@@ -341,6 +343,11 @@ This has been reported by a file notification event.")
;; Functions:
+(defun auto-revert-remove-current-buffer ()
+ "Remove dead buffer from `auto-revert-buffer-list'."
+ (setq auto-revert-buffer-list
+ (delq (current-buffer) auto-revert-buffer-list)))
+
;;;###autoload
(define-minor-mode auto-revert-mode
"Toggle reverting buffer when the file changes (Auto-Revert Mode).
@@ -364,13 +371,10 @@ without being changed in the part that is already in the buffer."
(push (current-buffer) auto-revert-buffer-list)
(add-hook
'kill-buffer-hook
- (lambda ()
- (setq auto-revert-buffer-list
- (delq (current-buffer) auto-revert-buffer-list)))
+ #'auto-revert-remove-current-buffer
nil t))
(when auto-revert-use-notify (auto-revert-notify-rm-watch))
- (setq auto-revert-buffer-list
- (delq (current-buffer) auto-revert-buffer-list)))
+ (auto-revert-remove-current-buffer))
(auto-revert-set-timer)
(when auto-revert-mode
(auto-revert-buffers)
@@ -786,24 +790,24 @@ the timer when no buffers need to be checked."
(not (and auto-revert-stop-on-user-input
(input-pending-p))))
(let ((buf (car bufs)))
- (if (buffer-live-p buf)
- (with-current-buffer buf
- ;; Test if someone has turned off Auto-Revert Mode in a
- ;; non-standard way, for example by changing major mode.
- (if (and (not auto-revert-mode)
- (not auto-revert-tail-mode)
- (memq buf auto-revert-buffer-list))
- (setq auto-revert-buffer-list
- (delq buf auto-revert-buffer-list)))
- (when (auto-revert-active-p)
- ;; Enable file notification.
- (when (and auto-revert-use-notify
- (not auto-revert-notify-watch-descriptor))
- (auto-revert-notify-add-watch))
- (auto-revert-handler)))
- ;; Remove dead buffer from `auto-revert-buffer-list'.
- (setq auto-revert-buffer-list
- (delq buf auto-revert-buffer-list))))
+ (with-current-buffer buf
+ (if (buffer-live-p buf)
+ (progn
+ ;; Test if someone has turned off Auto-Revert Mode
+ ;; in a non-standard way, for example by changing
+ ;; major mode.
+ (if (and (not auto-revert-mode)
+ (not auto-revert-tail-mode)
+ (memq buf auto-revert-buffer-list))
+ (auto-revert-remove-current-buffer))
+ (when (auto-revert-active-p)
+ ;; Enable file notification.
+ (when (and auto-revert-use-notify
+ (not auto-revert-notify-watch-descriptor))
+ (auto-revert-notify-add-watch))
+ (auto-revert-handler)))
+ ;; Remove dead buffer from `auto-revert-buffer-list'.
+ (auto-revert-remove-current-buffer))))
(setq bufs (cdr bufs)))
(setq auto-revert-remaining-buffers bufs)
;; Check if we should cancel the timer.
diff --git a/lisp/avoid.el b/lisp/avoid.el
index a4935c48895..1a471983fc8 100644
--- a/lisp/avoid.el
+++ b/lisp/avoid.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/battery.el b/lisp/battery.el
index b1834f06ff8..570cee140b1 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/bindings.el b/lisp/bindings.el
index be44b45136e..2bad90351c4 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -689,6 +689,7 @@ okay. See `mode-line-format'.")
;; `kill-all-local-variables', because they have no default value.
;; For consistency, we give them the `permanent-local' property, even
;; though `kill-all-local-variables' does not actually consult it.
+;; See init_buffer_once in buffer.c for the origins of this list.
(mapc (lambda (sym) (put sym 'permanent-local t))
'(buffer-file-name default-directory buffer-backed-up
@@ -697,7 +698,8 @@ okay. See `mode-line-format'.")
point-before-scroll buffer-file-truename
buffer-file-format buffer-auto-save-file-format
buffer-display-count buffer-display-time
- enable-multibyte-characters))
+ enable-multibyte-characters
+ buffer-file-coding-system truncate-lines))
;; We have base64, md5 and sha1 functions built in now.
(provide 'base64)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 5b8ded7b22a..1c8ff3df23e 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/bs.el b/lisp/bs.el
index c626698faf9..07d23e465e3 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index 83d6bb6b0e9..cb107548280 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/button.el b/lisp/button.el
index 99c03d9d687..32cd995f5e4 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -36,7 +36,7 @@
;; represented by the overlay itself, or text-properties, in which case
;; the button is represented by a marker or buffer-position pointing
;; somewhere in the button. In the latter case, no markers into the
-;; buffer are retained, which is important for speed if there are are
+;; buffer are retained, which is important for speed if there are
;; extremely large numbers of buttons. Note however that if there is
;; an existing face text-property at the site of the button, the
;; button face may not be visible. Using overlays avoids this.
@@ -232,7 +232,7 @@ property instead of `action'; if the button has no `mouse-action',
the value of `action' is used instead.
The action can either be a marker or a function. If it's a
-marker then goto it. Otherwise it it is a function then it is
+marker then goto it. Otherwise if it is a function then it is
called with BUTTON as only argument. BUTTON is either an
overlay, a buffer position, or (for buttons in the mode-line or
header-line) a string."
diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el
index 4e074d6b241..997ac3d583f 100644
--- a/lisp/calc/calc-aent.el
+++ b/lisp/calc/calc-aent.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -728,7 +728,9 @@ in Calc algebraic input.")
math-exp-str (1- math-exp-pos))
(1- math-exp-pos))))))
(or (and (memq calc-language calc-lang-c-type-hex)
- (string-match "0[xX][0-9a-fA-F]+" math-exp-str math-exp-pos))
+ (eq (string-match "0[xX][0-9a-fA-F]+" math-exp-str
+ math-exp-pos)
+ math-exp-pos))
(string-match "_?\\([0-9]+.?0*@ *\\)?\\([0-9]+.?0*' *\\)?\\(0*\\([2-9]\\|1[0-4]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-dA-D.]+[eE][-+_]?[0-9]+\\|0*\\([2-9]\\|[0-2][0-9]\\|3[0-6]\\)\\(#[#]?\\|\\^\\^\\)[0-9a-zA-Zα-ωΑ-Ω:.]+\\|[0-9]+:[0-9:]+\\|[0-9.]+\\([eE][-+_]?[0-9]+\\)?\"?\\)?"
math-exp-str math-exp-pos))
(setq math-exp-token 'number
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 9db901a9753..e64308bad67 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -544,7 +544,7 @@
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
(unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq)
(eq (car-safe (nth 1 math-simplify-expr)) 'var)
- (not (math-expr-contains (nth 2 math-simplify-expr)
+ (not (math-expr-contains (nth 2 math-simplify-expr)
(nth 1 math-simplify-expr))))
(setcar (cdr math-simplify-expr)
(math-mul (nth 2 nn) (nth 1 math-simplify-expr)))
diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el
index ec08ea4dd36..008d5480dd3 100644
--- a/lisp/calc/calc-arith.el
+++ b/lisp/calc/calc-arith.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -448,7 +448,7 @@
((Math-negp a) 1)
((Math-zerop a) 2)
((eq (car a) 'intv)
- (cond
+ (cond
((math-known-posp (nth 2 a)) 4)
((math-known-negp (nth 3 a)) 1)
((Math-zerop (nth 2 a)) 6)
@@ -1436,12 +1436,12 @@
(and (math-identity-matrix-p a t)
(or (and (eq (car-safe b) 'calcFunc-idn)
(= (length b) 2)
- (list 'calcFunc-idn (math-mul
+ (list 'calcFunc-idn (math-mul
(nth 1 (nth 1 a))
(nth 1 b))
(1- (length a))))
(and (math-known-scalarp b)
- (list 'calcFunc-idn (math-mul
+ (list 'calcFunc-idn (math-mul
(nth 1 (nth 1 a)) b)
(1- (length a))))
(and (math-known-matrixp b)
@@ -1449,11 +1449,11 @@
(and (math-identity-matrix-p b t)
(or (and (eq (car-safe a) 'calcFunc-idn)
(= (length a) 2)
- (list 'calcFunc-idn (math-mul (nth 1 a)
+ (list 'calcFunc-idn (math-mul (nth 1 a)
(nth 1 (nth 1 b)))
(1- (length b))))
(and (math-known-scalarp a)
- (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b)))
+ (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b)))
(1- (length b))))
(and (math-known-matrixp a)
(math-mul a (nth 1 (nth 1 b))))))
@@ -1717,7 +1717,7 @@
(defun math-div-new-non-trig (ntr)
(if math-div-non-trig
- (setq math-div-non-trig
+ (setq math-div-non-trig
(list '* ntr math-div-non-trig))
(setq math-div-non-trig ntr)))
@@ -1958,7 +1958,7 @@
(not (equal a math-simplify-only)))
(list '^ a b))
((and (eq (car-safe a) '*)
- (or
+ (or
(and
(math-known-matrixp (nth 1 a))
(math-known-matrixp (nth 2 a)))
@@ -1970,7 +1970,7 @@
(if (and (= b -1)
(math-known-square-matrixp (nth 1 a))
(math-known-square-matrixp (nth 2 a)))
- (math-mul (math-pow-fancy (nth 2 a) -1)
+ (math-mul (math-pow-fancy (nth 2 a) -1)
(math-pow-fancy (nth 1 a) -1))
(list '^ a b)))
((and (eq (car-safe a) '*)
@@ -2358,7 +2358,7 @@
(defalias 'calcFunc-float 'math-float)
-;; The variable math-trunc-prec is local to math-trunc in calc-misc.el,
+;; The variable math-trunc-prec is local to math-trunc in calc-misc.el,
;; but used by math-trunc-fancy which is called by math-trunc.
(defvar math-trunc-prec)
diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el
index ffca7c37e61..3a7807bae5e 100644
--- a/lisp/calc/calc-bin.el
+++ b/lisp/calc/calc-bin.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -32,7 +32,7 @@
(defconst math-bignum-logb-digit-size
(logb math-bignum-digit-size)
"The logb of the size of a bignum digit.
-This is the largest value of B such that 2^B is less than
+This is the largest value of B such that 2^B is less than
the size of a Calc bignum digit.")
(defconst math-bignum-digit-power-of-two
@@ -171,7 +171,7 @@ the size of a Calc bignum digit.")
(calc-wrapper
(if (and (>= n 2) (<= n 36))
(progn
- (calc-change-mode
+ (calc-change-mode
(list 'calc-number-radix 'calc-twos-complement-mode)
(list n (or arg (calc-is-option))) t)
;; also change global value so minibuffer sees it
@@ -424,7 +424,7 @@ the size of a Calc bignum digit.")
(math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q))
(- w math-bignum-logb-digit-size))
math-bignum-digit-power-of-two
- (logxor (cdr q)
+ (logxor (cdr q)
(1- math-bignum-digit-power-of-two))))))
(defun calcFunc-lsh (a &optional n w) ; [I I] [Public]
@@ -845,7 +845,7 @@ the size of a Calc bignum digit.")
(setq num (concat (make-string (- digs len) ?0) num))))
(when calc-group-digits
(setq num (math-group-float num)))
- (concat
+ (concat
(number-to-string calc-number-radix)
"##"
num)))
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index 91fbb7b2b8a..20b24060fc1 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el
index a00adc00992..06c9dc9d108 100644
--- a/lisp/calc/calc-cplx.el
+++ b/lisp/calc/calc-cplx.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el
index 14ab97fbed8..bc88401752a 100644
--- a/lisp/calc/calc-embed.el
+++ b/lisp/calc/calc-embed.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el
index d93a86ac06f..7973fc182bd 100644
--- a/lisp/calc/calc-ext.el
+++ b/lisp/calc/calc-ext.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el
index 647574684e4..92ef8f3a440 100644
--- a/lisp/calc/calc-fin.el
+++ b/lisp/calc/calc-fin.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 6aa421ec205..338967159d6 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el
index d98cdda4ea4..3aa9eb8b97e 100644
--- a/lisp/calc/calc-frac.el
+++ b/lisp/calc/calc-frac.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -206,7 +206,7 @@
(defun calcFunc-fdiv (a b) ; [R I I] [Public]
(cond
((Math-num-integerp a)
- (cond
+ (cond
((Math-num-integerp b)
(if (Math-zerop b)
(math-reject-arg a "*Division by zero")
@@ -217,7 +217,7 @@
(math-make-frac (math-mul (math-trunc a) (nth 2 b)) (nth 1 b))))
(t (math-reject-arg b 'integerp))))
((eq (car-safe a) 'frac)
- (cond
+ (cond
((Math-num-integerp b)
(if (Math-zerop b)
(math-reject-arg a "*Division by zero")
@@ -227,7 +227,7 @@
(math-reject-arg a "*Division by zero")
(math-make-frac (math-mul (nth 1 a) (nth 2 b)) (math-mul (nth 2 a) (nth 1 b)))))
(t (math-reject-arg b 'integerp))))
- (t
+ (t
(math-reject-arg a 'integerp))))
(provide 'calc-frac)
diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el
index 2bb460df3c9..1dde2ede878 100644
--- a/lisp/calc/calc-funcs.el
+++ b/lisp/calc/calc-funcs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -564,7 +564,7 @@
((Math-lessp '(float 8 0) (math-abs-approx x))
(let* ((z (math-div '(float 8 0) x))
(y (math-sqr z))
- (xx (math-add x
+ (xx (math-add x
(math-read-number-simple "-0.785398164")))
(a1 (math-poly-eval y
(list
@@ -633,7 +633,7 @@
(setq sc (cons (math-neg (cdr sc)) (car sc)))
(if (math-negp x)
(setq sc (cons (math-neg (car sc)) (math-neg (cdr sc))))))
- (math-mul (math-sqrt (math-div
+ (math-mul (math-sqrt (math-div
(math-read-number-simple "0.636619722")
x))
(math-sub (math-mul (cdr sc) a1)
@@ -813,39 +813,39 @@
(defvar math-bernoulli-b-cache
(list
- (list 'frac
+ (list 'frac
-174611
(math-read-number-simple "802857662698291200000"))
- (list 'frac
- 43867
+ (list 'frac
+ 43867
(math-read-number-simple "5109094217170944000"))
- (list 'frac
- -3617
+ (list 'frac
+ -3617
(math-read-number-simple "10670622842880000"))
- (list 'frac
- 1
+ (list 'frac
+ 1
(math-read-number-simple "74724249600"))
- (list 'frac
- -691
+ (list 'frac
+ -691
(math-read-number-simple "1307674368000"))
- (list 'frac
- 1
+ (list 'frac
+ 1
(math-read-number-simple "47900160"))
- (list 'frac
- -1
+ (list 'frac
+ -1
(math-read-number-simple "1209600"))
- (list 'frac
- 1
- 30240)
- (list 'frac
- -1
+ (list 'frac
+ 1
+ 30240)
+ (list 'frac
+ -1
720)
- (list 'frac
- 1
- 12)
+ (list 'frac
+ 1
+ 12)
1 ))
-(defvar math-bernoulli-B-cache
+(defvar math-bernoulli-B-cache
'((frac -174611 330) (frac 43867 798)
(frac -3617 510) (frac 7 6) (frac -691 2730)
(frac 5 66) (frac -1 30) (frac 1 42)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index bc05ffe427e..c0598e6015a 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el
index 356e571c99c..3f957992842 100644
--- a/lisp/calc/calc-help.el
+++ b/lisp/calc/calc-help.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el
index 59b591510dd..1ff50e20446 100644
--- a/lisp/calc/calc-incom.el
+++ b/lisp/calc/calc-incom.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el
index dc49f2888cf..cc3bfcf2cd0 100644
--- a/lisp/calc/calc-keypd.el
+++ b/lisp/calc/calc-keypd.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el
index ce1ddb56956..50a7eec1dae 100644
--- a/lisp/calc/calc-lang.el
+++ b/lisp/calc/calc-lang.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el
index b2cd580c2ee..394c2e298e7 100644
--- a/lisp/calc/calc-macs.el
+++ b/lisp/calc/calc-macs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el
index 76a58f4e9c1..6f60d2eca77 100644
--- a/lisp/calc/calc-map.el
+++ b/lisp/calc/calc-map.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -795,8 +795,8 @@
;;; Do substitutions in parallel to avoid crosstalk.
-;; The variables math-ms-temp and math-ms-args are local to
-;; math-multi-subst, but are used by math-multi-subst-rec, which
+;; The variables math-ms-temp and math-ms-args are local to
+;; math-multi-subst, but are used by math-multi-subst-rec, which
;; is called by math-multi-subst.
(defvar math-ms-temp)
(defvar math-ms-args)
@@ -811,7 +811,7 @@
(math-multi-subst-rec expr)))
(defun math-multi-subst-rec (expr)
- (cond ((setq math-ms-temp (assoc expr math-ms-args))
+ (cond ((setq math-ms-temp (assoc expr math-ms-args))
(cdr math-ms-temp))
((Math-primp expr) expr)
((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2))
@@ -820,7 +820,7 @@
(while (cdr (setq expr (cdr expr)))
(setq new (cons (car expr) new))
(if (assoc (car expr) math-ms-args)
- (setq math-ms-args (cons (cons (car expr) (car expr))
+ (setq math-ms-args (cons (cons (car expr) (car expr))
math-ms-args))))
(nreverse (cons (math-multi-subst-rec (car expr)) new))))
(t
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index 2590761d539..6d51536ac7a 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -44,15 +44,15 @@
(1- n))
"The number of digits in an Emacs float.")
-;;; Find the largest power of 10 which is an Emacs float,
-;;; then back off by one so that any float d.dddd...eN
+;;; Find the largest power of 10 which is an Emacs float,
+;;; then back off by one so that any float d.dddd...eN
;;; is an Emacs float, for acceptable d.dddd....
(defvar math-largest-emacs-expt
(let ((x 1)
(pow 1e2))
- ;; The following loop is for efficiency; it should stop when
- ;; 10^(2x) is too large. This could be indicated by a range
+ ;; The following loop is for efficiency; it should stop when
+ ;; 10^(2x) is too large. This could be indicated by a range
;; error when computing 10^(2x) or an infinite value for 10^(2x).
(while (and
pow
@@ -102,9 +102,9 @@ If this can't be done, return NIL."
(condition-case nil
(math-read-number
(number-to-string
- (funcall fn
- (string-to-number
- (let
+ (funcall fn
+ (string-to-number
+ (let
((calc-number-radix 10)
(calc-twos-complement-mode nil)
(calc-float-format (list 'float calc-internal-prec))
@@ -948,7 +948,7 @@ If this can't be done, return NIL."
(math-mul xs (car sc))
(math-sqr (cdr sc)))))))
(math-make-sdev (calcFunc-sec (nth 1 x))
- (math-div
+ (math-div
(math-mul (nth 2 x)
(calcFunc-sin (nth 1 x)))
(math-sqr (calcFunc-cos (nth 1 x)))))))
@@ -1010,7 +1010,7 @@ If this can't be done, return NIL."
(math-mul xs (cdr sc))
(math-sqr (car sc)))))))
(math-make-sdev (calcFunc-csc (nth 1 x))
- (math-div
+ (math-div
(math-mul (nth 2 x)
(calcFunc-cos (nth 1 x)))
(math-sqr (calcFunc-sin (nth 1 x)))))))
@@ -1114,7 +1114,7 @@ If this can't be done, return NIL."
(sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1)))
(ch (math-mul-float (math-add-float expx expmx) '(float 5 -1)))
(sc (math-sin-cos-raw (nth 1 x)))
- (d (math-add-float
+ (d (math-add-float
(math-mul-float (math-sqr (car sc))
(math-sqr sh))
(math-mul-float (math-sqr (cdr sc))
@@ -1139,7 +1139,7 @@ If this can't be done, return NIL."
(sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1)))
(ch (math-mul-float (math-add-float expx expmx) '(float 5 -1)))
(sc (math-sin-cos-raw (nth 1 x)))
- (d (math-add-float
+ (d (math-add-float
(math-mul-float (math-sqr (car sc))
(math-sqr ch))
(math-mul-float (math-sqr (cdr sc))
@@ -1164,17 +1164,17 @@ If this can't be done, return NIL."
(sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1)))
(ch (math-mul-float (math-add-float expx expmx) '(float 5 -1)))
(sc (math-sin-cos-raw (nth 1 x)))
- (d (math-add-float
+ (d (math-add-float
(math-sqr (car sc))
(math-sqr sh))))
(and (not (eq (nth 1 d) 0))
(list 'cplx
- (math-div-float
+ (math-div-float
(math-mul-float (car sc) (cdr sc))
d)
(math-neg
- (math-div-float
- (math-mul-float sh ch)
+ (math-div-float
+ (math-mul-float sh ch)
d))))))
((eq (car x) 'polar)
(math-polar (math-cot-raw (math-complex x))))
@@ -1223,7 +1223,7 @@ If this can't be done, return NIL."
(math-cos-raw-2 xmpo2 orgx))
((math-lessp-float x (math-neg (math-pi-over-4)))
(math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx)))
- ((math-with-extra-prec -1 (math-nearly-zerop-float x orgx))
+ ((math-with-extra-prec -1 (math-nearly-zerop-float x orgx))
'(float 0 0))
((math-use-emacs-fn 'sin x))
(calc-symbolic-mode (signal 'inexact-result nil))
@@ -1765,7 +1765,7 @@ If this can't be done, return NIL."
'(float 0 0))
(calc-symbolic-mode (signal 'inexact-result nil))
((math-posp (nth 1 x)) ; positive and real
- (cond
+ (cond
((math-use-emacs-fn 'log x))
(t
(let ((xdigs (1- (math-numdigs (nth 1 x)))))
@@ -1818,7 +1818,7 @@ If this can't be done, return NIL."
(defconst math-approx-ln-10
(math-read-number-simple "2.302585092994045684018")
"An approximation for ln(10).")
-
+
(math-defcache math-ln-10 math-approx-ln-10
(math-ln-raw-2 '(float 1 1)))
@@ -1963,7 +1963,7 @@ If this can't be done, return NIL."
(math-div '(float 2 0) (math-add expx (math-div -1 expx))))))
((eq (car-safe x) 'sdev)
(math-make-sdev (calcFunc-csch (nth 1 x))
- (math-mul (nth 2 x)
+ (math-mul (nth 2 x)
(math-mul (calcFunc-csch (nth 1 x))
(calcFunc-coth (nth 1 x))))))
((eq (car x) 'intv)
diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el
index e0305e36e24..546e65091fc 100644
--- a/lisp/calc/calc-menu.el
+++ b/lisp/calc/calc-menu.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el
index e6af0920639..a3e41cae8a6 100644
--- a/lisp/calc/calc-misc.el
+++ b/lisp/calc/calc-misc.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el
index 3b378815992..4a87281a39a 100644
--- a/lisp/calc/calc-mode.el
+++ b/lisp/calc/calc-mode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index dc97c45766f..77769e47daf 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el
index 684d0f17b79..b3335bbb007 100644
--- a/lisp/calc/calc-nlfit.el
+++ b/lisp/calc/calc-nlfit.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el
index a36213077f4..b2f69bc2331 100644
--- a/lisp/calc/calc-poly.el
+++ b/lisp/calc/calc-poly.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 6e9322fc04c..610e4dc5ba9 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el
index e50f8e1566e..4f0d71a2760 100644
--- a/lisp/calc/calc-rewr.el
+++ b/lisp/calc/calc-rewr.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,7 +30,7 @@
(defvar math-rewrite-default-iters 100)
-;; The variable calc-rewr-sel is local to calc-rewrite-selection and
+;; The variable calc-rewr-sel is local to calc-rewrite-selection and
;; calc-rewrite, but is used by calc-locate-selection-marker.
(defvar calc-rewr-sel)
@@ -219,7 +219,7 @@
(not (equal math-rewrite-whole-expr save-expr))))
(if (symbolp (car sched))
(progn
- (setq math-rewrite-whole-expr
+ (setq math-rewrite-whole-expr
(math-normalize (list (car sched) math-rewrite-whole-expr)))
(if trace-buffer
(let ((fmt (math-format-stack-value
@@ -490,13 +490,13 @@
;; The variable math-import-list is local to part of math-compile-rewrites,
;; but is also used in a different part, and so the local version could
-;; be affected by the non-local version when math-compile-rewrites calls itself.
+;; be affected by the non-local version when math-compile-rewrites calls itself.
(defvar math-import-list nil)
-;; The variables math-regs, math-num-regs, math-prog-last, math-bound-vars,
+;; The variables math-regs, math-num-regs, math-prog-last, math-bound-vars,
;; math-conds, math-copy-neg, math-rhs, math-pattern, math-remembering and
-;; math-aliased-vars are local to math-compile-rewrites,
-;; but are used by many functions math-rwcomp-*, which are called by
+;; math-aliased-vars are local to math-compile-rewrites,
+;; but are used by many functions math-rwcomp-*, which are called by
;; math-compile-rewrites.
(defvar math-regs)
(defvar math-num-regs)
@@ -753,8 +753,8 @@
(list expr)))
;; The variables math-rewrite-heads-heads (i.e.; heads for math-rewrite-heads)
-;; math-rewrite-heads-blanks and math-rewrite-heads-skips are local to
-;; math-rewrite-heads, but used by math-rewrite-heads-rec, which is called by
+;; math-rewrite-heads-blanks and math-rewrite-heads-skips are local to
+;; math-rewrite-heads, but used by math-rewrite-heads-rec, which is called by
;; math-rewrite-heads.
(defvar math-rewrite-heads-heads)
(defvar math-rewrite-heads-skips)
@@ -844,7 +844,7 @@
(cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new)
((Math-primp expr) expr)
(t (if (eq (car expr) math-rwcomp-subst-old-func)
- (math-build-call math-rwcomp-subst-new-func
+ (math-build-call math-rwcomp-subst-new-func
(mapcar 'math-rwcomp-subst-rec
(cdr expr)))
(cons (car expr)
@@ -1489,12 +1489,12 @@
(progn (terpri) (princ (car pc))
(if (and (natnump (nth 1 (car pc)))
(< (nth 1 (car pc)) (length math-apply-rw-regs)))
- (princ
+ (princ
(format "\n part = %s"
(aref math-apply-rw-regs (nth 1 (car pc))))))))
(cond ((eq (setq op (car (setq inst (car pc)))) 'func)
- (if (and (consp
+ (if (and (consp
(setq part (aref math-apply-rw-regs (car (cdr inst)))))
(eq (car part)
(car (setq inst (cdr (cdr inst)))))
@@ -1533,7 +1533,7 @@
(aset mark 2 0))
((eq op 'try)
- (if (and (consp (setq part
+ (if (and (consp (setq part
(aref math-apply-rw-regs (car (cdr inst)))))
(memq (car part) (nth 2 inst))
(= (length part) 3)
@@ -1658,7 +1658,7 @@
op (aref mark 2))
(cond ((eq op 0)
(if (setq op (cdr (aref mark 1)))
- (aset math-apply-rw-regs (nth 4 inst)
+ (aset math-apply-rw-regs (nth 4 inst)
(car (aset mark 1 op)))
(if (nth 5 inst)
(progn
@@ -1668,7 +1668,7 @@
(math-rwfail t))))
((eq op 1)
(if (setq op (cdr (aref mark 1)))
- (aset math-apply-rw-regs (nth 4 inst)
+ (aset math-apply-rw-regs (nth 4 inst)
(car (aset mark 1 op)))
(if (= (aref mark 3) 1)
(if (nth 5 inst)
@@ -1725,7 +1725,7 @@
(t (math-rwfail t))))
((eq op 'integer)
- (if (Math-integerp (setq part
+ (if (Math-integerp (setq part
(aref math-apply-rw-regs (nth 1 inst))))
(setq pc (cdr pc))
(if (Math-primp part)
@@ -1756,7 +1756,7 @@
(math-rwfail)))))
((eq op 'negative)
- (if (math-looks-negp (setq part
+ (if (math-looks-negp (setq part
(aref math-apply-rw-regs (nth 1 inst))))
(setq pc (cdr pc))
(if (Math-primp part)
@@ -1774,7 +1774,7 @@
(setq part (math-rweval
(math-simplify
(calcFunc-sign
- (math-sub
+ (math-sub
(aref math-apply-rw-regs (nth 1 inst))
(aref math-apply-rw-regs (nth 3 inst))))))))
(if (cond ((eq op 'calcFunc-eq)
@@ -1793,7 +1793,7 @@
(math-rwfail)))
((eq op 'func-def)
- (if (and
+ (if (and
(consp (setq part (aref math-apply-rw-regs (car (cdr inst)))))
(eq (car part)
(car (setq inst (cdr (cdr inst))))))
@@ -1815,8 +1815,8 @@
(math-rwfail)))
((eq op 'func-opt)
- (if (or (not
- (and
+ (if (or (not
+ (and
(consp
(setq part (aref math-apply-rw-regs (car (cdr inst)))))
(eq (car part) (nth 2 inst))))
@@ -1833,7 +1833,7 @@
(setq pc (cdr pc))))
((eq op 'mod)
- (if (if (Math-zerop
+ (if (if (Math-zerop
(setq part (aref math-apply-rw-regs (nth 1 inst))))
(Math-zerop (nth 3 inst))
(and (not (Math-zerop (nth 2 inst)))
@@ -1847,7 +1847,7 @@
(math-rwfail)))
((eq op 'apply)
- (if (and (consp
+ (if (and (consp
(setq part (aref math-apply-rw-regs (car (cdr inst)))))
(not (Math-objvecp part))
(not (eq (car part) 'var)))
@@ -1860,19 +1860,19 @@
(math-rwfail)))
((eq op 'cons)
- (if (and (consp
+ (if (and (consp
(setq part (aref math-apply-rw-regs (car (cdr inst)))))
(eq (car part) 'vec)
(cdr part))
(progn
(aset math-apply-rw-regs (nth 2 inst) (nth 1 part))
- (aset math-apply-rw-regs (nth 3 inst)
+ (aset math-apply-rw-regs (nth 3 inst)
(cons 'vec (cdr (cdr part))))
(setq pc (cdr pc)))
(math-rwfail)))
((eq op 'rcons)
- (if (and (consp
+ (if (and (consp
(setq part (aref math-apply-rw-regs (car (cdr inst)))))
(eq (car part) 'vec)
(cdr part))
@@ -1898,7 +1898,7 @@
(setq pc (cdr pc)))
((eq op 'copy)
- (aset math-apply-rw-regs (nth 2 inst)
+ (aset math-apply-rw-regs (nth 2 inst)
(aref math-apply-rw-regs (nth 1 inst)))
(setq pc (cdr pc)))
diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el
index bcace468168..b29e5bf349b 100644
--- a/lisp/calc/calc-rules.el
+++ b/lisp/calc/calc-rules.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el
index d7f87f49108..a363469450f 100644
--- a/lisp/calc/calc-sel.el
+++ b/lisp/calc/calc-sel.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -140,8 +140,8 @@
(calc-change-current-selection sel)
(error "%d is not a valid sub-formula index" num)))))
-;; The variables calc-fnp-op and calc-fnp-num are local to
-;; calc-find-nth-part (and calc-select-previous) but used by
+;; The variables calc-fnp-op and calc-fnp-num are local to
+;; calc-find-nth-part (and calc-select-previous) but used by
;; calc-find-nth-part-rec, which is called by them.
(defvar calc-fnp-op)
(defvar calc-fnp-num)
@@ -650,7 +650,7 @@
alg)
(let ((calc-dollar-values (list sel))
(calc-dollar-used 0))
- (setq alg (calc-do-alg-entry "" "Replace selection with: " nil
+ (setq alg (calc-do-alg-entry "" "Replace selection with: " nil
'calc-selection-history))
(and alg
(progn
diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el
index 2b79712f301..d70d4cd40ef 100644
--- a/lisp/calc/calc-stat.el
+++ b/lisp/calc/calc-stat.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el
index 67931a74472..16d35f28ec0 100644
--- a/lisp/calc/calc-store.el
+++ b/lisp/calc/calc-store.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el
index 48e3a3404d3..afdeac1b6f6 100644
--- a/lisp/calc/calc-stuff.el
+++ b/lisp/calc/calc-stuff.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el
index a9e294354bc..9f949675b2e 100644
--- a/lisp/calc/calc-trail.el
+++ b/lisp/calc/calc-trail.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el
index 06181f8c5c2..17e1633c989 100644
--- a/lisp/calc/calc-undo.el
+++ b/lisp/calc/calc-undo.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -75,7 +75,7 @@
(let ((v (intern (nth 1 action))))
(calc-record-undo (list 'store (nth 1 action)
(and (boundp v) (symbol-value v))))
- (if (y-or-n-p (format "Un-store variable %s? "
+ (if (y-or-n-p (format "Un-store variable %s? "
(calc-var-name (nth 1 action))))
(progn
(if (nth 2 action)
diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el
index 0e3715eb4cf..b7b43acefcc 100644
--- a/lisp/calc/calc-units.el
+++ b/lisp/calc/calc-units.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -825,21 +825,18 @@ If COMP or STD is non-nil, put that in the units table instead."
(forward-char -1))
(insert ";;; Custom units stored by Calc on " (current-time-string) "\n")
(if math-additional-units
- (progn
+ (let (expr)
(insert "(setq math-additional-units '(\n")
- (let ((list math-additional-units))
- (while list
- (insert " (" (symbol-name (car (car list))) " "
- (if (nth 1 (car list))
- (if (stringp (nth 1 (car list)))
- (prin1-to-string (nth 1 (car list)))
- (prin1-to-string (math-format-flat-expr
- (nth 1 (car list)) 0)))
- "nil")
- " "
- (prin1-to-string (nth 2 (car list)))
- ")\n")
- (setq list (cdr list))))
+ (dolist (u math-additional-units)
+ (insert " (" (symbol-name (car u)) " "
+ (if (setq expr (nth 1 u))
+ (if (stringp expr)
+ (prin1-to-string expr)
+ (prin1-to-string (math-format-flat-expr expr 0)))
+ "nil")
+ " "
+ (prin1-to-string (nth 2 u))
+ ")\n"))
(insert "))\n"))
(insert ";;; (no custom units defined)\n"))
(insert ";;; End of custom units\n")
@@ -916,15 +913,13 @@ If COMP or STD is non-nil, put that in the units table instead."
(defun math-find-base-units-rec (expr pow)
(let ((u (math-check-unit-name expr)))
(cond (u
- (let ((ulist (math-find-base-units u)))
- (while ulist
- (let ((p (* (cdr (car ulist)) pow))
- (old (assq (car (car ulist)) math-fbu-base)))
- (if old
- (setcdr old (+ (cdr old) p))
- (setq math-fbu-base
- (cons (cons (car (car ulist)) p) math-fbu-base))))
- (setq ulist (cdr ulist)))))
+ (dolist (x (math-find-base-units u))
+ (let ((p (* (cdr x) pow))
+ (old (assq (car x) math-fbu-base)))
+ (if old
+ (setcdr old (+ (cdr old) p))
+ (setq math-fbu-base
+ (cons (cons (car x) p) math-fbu-base))))))
((math-scalarp expr))
((and (eq (car expr) '^)
(integerp (nth 2 expr)))
@@ -1377,20 +1372,15 @@ If COMP or STD is non-nil, put that in the units table instead."
(if (eq pow1 1)
(math-to-standard-units (list '/ n d) nil)
(list '^ (math-to-standard-units (list '/ n d) nil) pow1))
- (let (ud1)
- (setq un (nth 4 un)
- ud (nth 4 ud))
- (while un
- (setq ud1 ud)
- (while ud1
- (and (eq (car (car un)) (car (car ud1)))
- (setq math-try-cancel-units
- (+ math-try-cancel-units
- (- (* (cdr (car un)) pow1)
- (* (cdr (car ud)) pow2)))))
- (setq ud1 (cdr ud1)))
- (setq un (cdr un)))
- nil))))))
+ (setq un (nth 4 un)
+ ud (nth 4 ud))
+ (dolist (x un)
+ (dolist (y ud)
+ (when (eq (car x) (car y))
+ (setq math-try-cancel-units
+ (+ math-try-cancel-units
+ (- (* (cdr x) pow1)
+ (* (cdr (car ud)) pow2))))))))))))
(math-defsimplify ^
(and math-simplifying-units
@@ -1578,9 +1568,8 @@ If COMP or STD is non-nil, put that in the units table instead."
(insert "Calculator Units Table:\n\n")
(insert "(All definitions are exact unless marked with an asterisk (*).)\n\n")
(insert "Unit Type Definition Description\n\n")
- (while uptr
- (setq u (car uptr)
- name (nth 2 u))
+ (dolist (u uptr)
+ (setq name (nth 2 u))
(when (eq (car u) 'm)
(setq std t))
(setq shadowed (and std (assq (car u) math-additional-units)))
@@ -1618,8 +1607,7 @@ If COMP or STD is non-nil, put that in the units table instead."
(insert " (redefined above)")
(unless (nth 1 u)
(insert " (base unit)")))
- (insert "\n")
- (setq uptr (cdr uptr)))
+ (insert "\n"))
(insert "\n\nUnit Prefix Table:\n\n")
(setq uptr math-unit-prefixes)
(while uptr
diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el
index 0ce0d422f2f..c049933eeb5 100644
--- a/lisp/calc/calc-vec.el
+++ b/lisp/calc/calc-vec.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el
index e97d8789414..fec2512266b 100644
--- a/lisp/calc/calc-yank.el
+++ b/lisp/calc/calc-yank.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index 6a9af44181d..d9e8cff16a5 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index bb4c30e1235..48446c3c4c5 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -2354,7 +2354,7 @@
;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
;; are local to math-try-solve-for, but are used by math-try-solve-prod.
-;; (math-solve-lhs and math-solve-rhs are is also local to
+;; (math-solve-lhs and math-solve-rhs are also local to
;; math-decompose-poly, but used by math-solve-poly-funny-powers.)
(defvar math-solve-lhs)
(defvar math-solve-rhs)
diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el
index dc6ac93e20a..11e6342be28 100644
--- a/lisp/calc/calcalg3.el
+++ b/lisp/calc/calcalg3.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -120,7 +120,7 @@
(defvar calc-curve-fit-history nil
"History for calc-curve-fit.")
-(defun calc-curve-fit (arg &optional calc-curve-model
+(defun calc-curve-fit (arg &optional calc-curve-model
calc-curve-coefnames calc-curve-varnames)
(interactive "P")
(calc-slow-wrapper
@@ -148,7 +148,7 @@
"P prefix = plot result"
"' = alg entry, $ = stack, u = Model1, U = Model2")))
(while (not calc-curve-model)
- (message
+ (message
"Fit to model: %s:%s%s"
(nth which msgs)
(if plot "P" " ")
@@ -194,27 +194,27 @@
calc-curve-varnames nil)
nil))
((= key ?1) ; linear or multilinear
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames))))))
((and (>= key ?2) (<= key ?9)) ; polynomial
(calc-get-fit-variables 1 (- key ?0 -1) (and homog 0))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-build-polynomial-expr (cdr calc-curve-coefnames)
(nth 1 calc-curve-varnames))))
((= key ?i) ; exact polynomial
(calc-get-fit-variables 1 (1- (length (nth 1 data)))
(and homog 0))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-build-polynomial-expr (cdr calc-curve-coefnames)
(nth 1 calc-curve-varnames))))
((= key ?p) ; power law
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
- (setq calc-curve-model
- (math-mul
+ (setq calc-curve-model
+ (math-mul
(nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
@@ -223,9 +223,9 @@
calc-curve-varnames
(cons 'vec (cdr (cdr calc-curve-coefnames))))))))
((= key ?^) ; exponential law
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
@@ -258,9 +258,9 @@
(cdr (nth 1 plot)))))))
(calc-fit-hubbert-linear-curve func))
((memq key '(?e ?E))
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 1))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-mul (nth 1 calc-curve-coefnames)
(calcFunc-reduce
'(var mul var-mul)
@@ -275,18 +275,18 @@
(cons 'vec (cdr (cdr calc-curve-coefnames)))
calc-curve-varnames))))))
((memq key '(?x ?X))
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec (cons 1 (cdr calc-curve-varnames)))))
(setq calc-curve-model (if (eq key ?x)
(list 'calcFunc-exp calc-curve-model)
(list '^ 10 calc-curve-model))))
((memq key '(?l ?L))
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ calc-curve-nvars) (and homog 0))
- (setq calc-curve-model
+ (setq calc-curve-model
(math-mul calc-curve-coefnames
(cons 'vec
(cons 1 (cdr (calcFunc-map
@@ -296,7 +296,7 @@
var-log10))
calc-curve-varnames)))))))
((= key ?q)
- (calc-get-fit-variables calc-curve-nvars
+ (calc-get-fit-variables calc-curve-nvars
(1+ (* 2 calc-curve-nvars)) (and homog 0))
(let ((c calc-curve-coefnames)
(v calc-curve-varnames))
@@ -310,15 +310,15 @@
(list '- (car v) (nth 1 c))
2)))))))
((= key ?g)
- (setq
- calc-curve-model
- (math-read-expr
+ (setq
+ calc-curve-model
+ (math-read-expr
"(AFit / BFit sqrt(2 pi)) exp(-0.5 * ((XFit - CFit) / BFit)^2)")
calc-curve-varnames '(vec (var XFit var-XFit))
calc-curve-coefnames '(vec (var AFit var-AFit)
(var BFit var-BFit)
(var CFit var-CFit)))
- (calc-get-fit-variables 1 (1- (length calc-curve-coefnames))
+ (calc-get-fit-variables 1 (1- (length calc-curve-coefnames))
(and homog 1)))
((memq key '(?\$ ?\' ?u ?U))
(let* ((defvars nil)
@@ -327,7 +327,7 @@
(let* ((calc-dollar-values calc-arg-values)
(calc-dollar-used 0)
(calc-hashes-used 0))
- (setq calc-curve-model
+ (setq calc-curve-model
(calc-do-alg-entry "" "Model formula: "
nil 'calc-curve-fit-history))
(if (/= (length calc-curve-model) 1)
@@ -358,19 +358,19 @@
(or (null (nth 3 calc-curve-model))
(math-vectorp (nth 3 calc-curve-model))))
(setq calc-curve-varnames (nth 2 calc-curve-model)
- calc-curve-coefnames
+ calc-curve-coefnames
(or (nth 3 calc-curve-model)
(cons 'vec
(math-all-vars-but
- calc-curve-model
+ calc-curve-model
calc-curve-varnames)))
calc-curve-model (nth 1 calc-curve-model))
(error "Incorrect model specifier")))))
(or calc-curve-varnames
- (let ((with-y
+ (let ((with-y
(eq (car-safe calc-curve-model) 'calcFunc-eq)))
(if calc-curve-coefnames
- (calc-get-fit-variables
+ (calc-get-fit-variables
(if with-y (1+ calc-curve-nvars) calc-curve-nvars)
(1- (length calc-curve-coefnames))
(math-all-vars-but
@@ -378,9 +378,9 @@
nil with-y)
(let* ((coefs (math-all-vars-but calc-curve-model nil))
(vars nil)
- (n (-
- (length coefs)
- calc-curve-nvars
+ (n (-
+ (length coefs)
+ calc-curve-nvars
(if with-y 2 1)))
p)
(if (< n 0)
@@ -388,12 +388,12 @@
(setq p (nthcdr n coefs))
(setq vars (cdr p))
(setcdr p nil)
- (calc-get-fit-variables
+ (calc-get-fit-variables
(if with-y (1+ calc-curve-nvars) calc-curve-nvars)
(length coefs)
vars coefs with-y)))))
(if record-entry
- (calc-record (list 'vec calc-curve-model
+ (calc-record (list 'vec calc-curve-model
calc-curve-varnames calc-curve-coefnames)
"modl"))))
(t (beep))))
@@ -422,7 +422,7 @@
(calc-graph-set-styles nil nil)
(calc-graph-point-style nil))
(setq plot (cdr (nth 1 plot)))
- (setq plot
+ (setq plot
(list 'intv
3
(math-sub
@@ -1446,7 +1446,7 @@
;;; Open Romberg method; "qromo" in section 4.4.
;; The variable math-ninteg-temp is local to math-ninteg-romberg,
-;; but is used by math-ninteg-midpoint, which is used by
+;; but is used by math-ninteg-midpoint, which is used by
;; math-ninteg-romberg.
(defvar math-ninteg-temp)
@@ -1564,7 +1564,7 @@
;; The variables math-fit-first-var, math-fit-first-coef and
;; math-fit-new-coefs are local to math-general-fit, but are used by
-;; calcFunc-fitvar, calcFunc-fitparam and calcFunc-fitdummy
+;; calcFunc-fitvar, calcFunc-fitparam and calcFunc-fitdummy
;; (respectively), which are used by math-general-fit.
(defvar math-fit-first-var)
(defvar math-fit-first-coef)
@@ -1903,7 +1903,7 @@
(function (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
+;; math-all-vars-found are local to math-all-vars-in, but are used by
;; math-all-vars-rec which is called by math-all-vars-in.
(defvar math-all-vars-vars)
(defvar math-all-vars-found)
diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el
index 7c8013aa907..fe0a882cfb9 100644
--- a/lisp/calc/calccomp.el
+++ b/lisp/calc/calccomp.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el
index 73497f049f1..2299cd3da2a 100644
--- a/lisp/calc/calcsel2.el
+++ b/lisp/calc/calcsel2.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 5366a9b9596..e5488b8ae1e 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;=====================================================================
;;; Commentary:
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 08f1bf49788..2fc5040a756 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index 6e624542cbf..e0b7f4a3c22 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 72e7675a78c..5761e576817 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 920ec7d5ce0..bff0ade6547 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index be709f5e1c9..6b55ea479f1 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -1,4 +1,4 @@
-;;; cal-dst.el --- calendar functions for daylight saving rules
+;;; cal-dst.el --- calendar functions for daylight saving rules -*- lexical-binding:t -*-
;; Copyright (C) 1993-1996, 2001-2017 Free Software Foundation, Inc.
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -220,35 +220,36 @@ The result has the proper form for `calendar-daylight-savings-starts'."
'((calendar-gregorian-from-absolute
(calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
(prevday-sec (- -1 utc-diff)) ; last sec of previous local day
- (year (1+ y))
new-rules)
- ;; Scan through the next few years until only one rule remains.
- (while (cdr candidate-rules)
- (dolist (rule candidate-rules)
- ;; The rule we return should give a Gregorian date, but here
- ;; we require an absolute date. The following is for efficiency.
- (setq date (cond ((eq (car rule) 'calendar-nth-named-day)
- (eval (cons 'calendar-nth-named-absday (cdr rule))))
- ((eq (car rule) 'calendar-gregorian-from-absolute)
- (eval (cadr rule)))
- (t (calendar-absolute-from-gregorian (eval rule)))))
- (or (equal (current-time-zone
- (calendar-time-from-absolute date prevday-sec))
- (current-time-zone
- (calendar-time-from-absolute (1+ date) prevday-sec)))
- (setq new-rules (cons rule new-rules))))
- ;; If no rules remain, just use the first candidate rule;
- ;; it's wrong in general, but it's right for at least one year.
- (setq candidate-rules (if new-rules (nreverse new-rules)
- (list (car candidate-rules)))
- new-rules nil
- year (1+ year)))
+ (calendar-dlet* ((year (1+ y)))
+ ;; Scan through the next few years until only one rule remains.
+ (while (cdr candidate-rules)
+ (dolist (rule candidate-rules)
+ ;; The rule we return should give a Gregorian date, but here
+ ;; we require an absolute date. The following is for efficiency.
+ (setq date (cond ((eq (car rule) #'calendar-nth-named-day)
+ (eval (cons #'calendar-nth-named-absday
+ (cdr rule))))
+ ((eq (car rule) #'calendar-gregorian-from-absolute)
+ (eval (cadr rule)))
+ (t (calendar-absolute-from-gregorian (eval rule)))))
+ (or (equal (current-time-zone
+ (calendar-time-from-absolute date prevday-sec))
+ (current-time-zone
+ (calendar-time-from-absolute (1+ date) prevday-sec)))
+ (setq new-rules (cons rule new-rules))))
+ ;; If no rules remain, just use the first candidate rule;
+ ;; it's wrong in general, but it's right for at least one year.
+ (setq candidate-rules (if new-rules (nreverse new-rules)
+ (list (car candidate-rules)))
+ new-rules nil
+ year (1+ year))))
(car candidate-rules)))
;; TODO it might be better to extract this information directly from
;; the system timezone database. But cross-platform...?
;; See thread
-;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2006-11/msg00060.html
+;; https://lists.gnu.org/r/emacs-pretest-bug/2006-11/msg00060.html
(defun calendar-dst-find-data (&optional time)
"Find data on the first daylight saving time transitions after TIME.
TIME defaults to `current-time'. Return value is as described
@@ -405,8 +406,9 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
- ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/.
+ (calendar-dlet* ((year year))
+ (if expr (eval expr))))
+ ;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 2 0 3 year))))
@@ -416,8 +418,9 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
- ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/.
+ (calendar-dlet* ((year year))
+ (if expr (eval expr))))
+ ;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 1 0 11 year))))
@@ -425,25 +428,25 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(defun dst-in-effect (date)
"True if on absolute DATE daylight saving time is in effect.
Fractional part of DATE is local standard time of day."
- (let* ((year (calendar-extract-year
- (calendar-gregorian-from-absolute (floor date))))
- (dst-starts-gregorian (eval calendar-daylight-savings-starts))
- (dst-ends-gregorian (eval calendar-daylight-savings-ends))
- (dst-starts (and dst-starts-gregorian
+ (calendar-dlet* ((year (calendar-extract-year
+ (calendar-gregorian-from-absolute (floor date)))))
+ (let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts))
+ (dst-ends-gregorian (eval calendar-daylight-savings-ends))
+ (dst-starts (and dst-starts-gregorian
+ (+ (calendar-absolute-from-gregorian
+ dst-starts-gregorian)
+ (/ calendar-daylight-savings-starts-time
+ 60.0 24.0))))
+ (dst-ends (and dst-ends-gregorian
(+ (calendar-absolute-from-gregorian
- dst-starts-gregorian)
- (/ calendar-daylight-savings-starts-time
- 60.0 24.0))))
- (dst-ends (and dst-ends-gregorian
- (+ (calendar-absolute-from-gregorian
- dst-ends-gregorian)
- (/ (- calendar-daylight-savings-ends-time
- calendar-daylight-time-offset)
- 60.0 24.0)))))
- (and dst-starts dst-ends
- (if (< dst-starts dst-ends)
- (and (<= dst-starts date) (< date dst-ends))
- (or (<= dst-starts date) (< date dst-ends))))))
+ dst-ends-gregorian)
+ (/ (- calendar-daylight-savings-ends-time
+ calendar-daylight-time-offset)
+ 60.0 24.0)))))
+ (and dst-starts dst-ends
+ (if (< dst-starts dst-ends)
+ (and (<= dst-starts date) (< date dst-ends))
+ (or (<= dst-starts date) (< date dst-ends)))))))
;; used by calc, lunar, solar.
(defun dst-adjust-time (date time)
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index 3ecd90a86e0..ede38217ee6 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
index 15de7cde032..ba18b92ff9d 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el
index f002133900e..41463cfc94a 100644
--- a/lisp/calendar/cal-html.el
+++ b/lisp/calendar/cal-html.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index c6478937800..3650db493cf 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index c802c848e01..427fc22b8e5 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 40887b41712..2ad3017d625 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index 2363cf535b6..8f3a4a4a5a5 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index 1039b49591e..b2079797b6c 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -100,7 +100,7 @@
;; Show 11 years--5 before, 5 after year of middle month.
;; We used to use :suffix rather than :label and bumped into
;; an easymenu bug:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01813.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-11/msg01813.html
;; The bug has since been fixed.
(dotimes (i 11)
(push (vector (format "hol-year-%d" i)
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index a845348b964..0ed5dc0bfb5 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index 571b397828b..3365ae71a00 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 1ea10bf9d70..1d295606f23 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -259,12 +259,33 @@ This definition is the heart of the calendar!")
(defun cal-tex-preamble (&optional args)
"Insert the LaTeX calendar preamble into `cal-tex-buffer'.
Preamble includes initial definitions for various LaTeX commands.
-Optional string ARGS are included as options for the article document class."
+Optional string ARGS are included as options for the article
+document class with inclusion of default values \"12pt\" for
+size, and \"a4paper\" for paper unless size or paper are already
+specified in ARGS. When ARGS is omitted, by default the option
+\"12pt,a4paper\" is passed. When ARGS has any other value, then
+no option is passed to the class.
+
+Insert the \"\\usepackage{geometry}\" directive when ARGS
+contains the \"landscape\" string."
(set-buffer (generate-new-buffer cal-tex-buffer))
- (insert (format "\\documentclass%s{article}\n"
- (if (stringp args)
- (format "[%s]" args)
- "")))
+ (save-match-data
+ (insert (format "\\documentclass%s{article}\n"
+ (cond
+ ((stringp args)
+ ;; set default size
+ (unless (string-match "\\(^\\|,\\) *[0-9]+pt *\\(,\\|$\\)" args)
+ (setq args (concat args ",12pt")))
+ ;; set default paper
+ (unless (string-match "\\(^\\|,\\) *\\([ab][4-5]\\|le\\(tter\\|gal\\)\\|executive\\)paper *\\(,\\|$\\)" args)
+ (setq args (concat args ",a4paper")))
+ (when (string= (substring args 0 1) ",")
+ (setq args (substring args 1)))
+ (if (string= args "") "" (format "[%s]" args)))
+ ((null args) "[12pt]")
+ (t ""))))
+ (if (and (stringp args) (string-match "\\<landscape\\>" args))
+ (insert "\\usepackage{geometry}\n")))
(if (stringp cal-tex-preamble-extra)
(insert cal-tex-preamble-extra "\n"))
;; FIXME boxwidth and boxheight unused?
@@ -320,7 +341,7 @@ Optional EVENT indicates a buffer position to use instead of point."
There are four rows of three months each, unless optional
LANDSCAPE is non-nil, in which case the calendar is printed in
landscape mode with three rows of four months each."
- (cal-tex-insert-preamble 1 landscape "12pt")
+ (cal-tex-insert-preamble 1 (and landscape "landscape"))
(if landscape
(cal-tex-vspace "-.6cm")
(cal-tex-vspace "-3.1cm"))
@@ -476,7 +497,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2)))
(holidays (if cal-tex-holidays (holiday-in-range d1 d2)))
other-month other-year small-months-at-start)
- (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt")
+ (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) "landscape")
(cal-tex-cmd cal-tex-cal-one-month)
(dotimes (i n)
(setq other-month month
@@ -515,7 +536,7 @@ Optional EVENT indicates a buffer position to use instead of point."
(calendar-increment-month month year 1)
(cal-tex-vspace "-2cm")
(cal-tex-insert-preamble
- (cal-tex-number-weeks month year 1) t "12pt" t))))
+ (cal-tex-number-weeks month year 1) "landscape" t))))
(cal-tex-end-document)
(run-hooks 'cal-tex-hook))
@@ -545,7 +566,7 @@ indicates a buffer position to use instead of point."
end-year))))
(diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2)))
(holidays (if cal-tex-holidays (holiday-in-range d1 d2))))
- (cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil "12pt")
+ (cal-tex-insert-preamble (cal-tex-number-weeks month year n))
(if (> n 1)
(cal-tex-cmd cal-tex-cal-multi-month)
(cal-tex-cmd cal-tex-cal-one-month))
@@ -1615,24 +1636,27 @@ informative header, and run HOOK."
\t\tM-x tex-buffer RET
\t\tM-x tex-print RET")))
-(defun cal-tex-insert-preamble (weeks landscape size &optional append)
+(defun cal-tex-insert-preamble (weeks &optional class-options append)
"Initialize the output LaTeX calendar buffer, `cal-tex-buffer'.
Select the output buffer, and insert the preamble for a calendar
-of WEEKS weeks. Insert code for landscape mode if LANDSCAPE is
-non-nil. Use point-size SIZE. Optional argument APPEND, if
-non-nil, means add to end of buffer without erasing current contents."
- (let ((width "18cm")
+of WEEKS weeks. Pass string CLASS-OPTIONS as options for the
+article document class. If it contains \"landscape\", use the
+geometry package to produce landscape format. Optional argument
+APPEND, if non-nil, means add to end of buffer without erasing
+current contents."
+ (let ((landscape (and class-options
+ (string-match "\\<landscape\\>" class-options)))
+ (width "18cm")
(height "24cm"))
(when landscape
- (setq width "24cm"
- height "18cm"))
+ (let ((swap width))
+ (setq width height height swap)))
(unless append
- (cal-tex-preamble size)
+ (cal-tex-preamble class-options)
(if (not landscape)
(progn
(cal-tex-cmd "\\oddsidemargin -1.75cm")
(cal-tex-cmd "\\def\\holidaymult" ".06"))
- (cal-tex-cmd "\\special" "landscape")
(cal-tex-cmd "\\textwidth 9.5in")
(cal-tex-cmd "\\textheight 7in")
(cal-tex-comment)
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index f7ca3695a07..aca9d1c510e 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 84282209ddd..76b077ba95c 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -115,6 +115,37 @@
(load "cal-loaddefs" nil t)
+;; Calendar has historically relied heavily on dynamic scoping.
+;; Concretely, this manifests in the use of references to let-bound variables
+;; in Custom vars as well as code in diary files.
+;; `eval` is hence the core of the culprit. It's used on:
+;; - calendar-date-display-form
+;; - calendar-time-display-form
+;; - calendar-chinese-time-zone
+;; - in cal-dst's there are various calls to `eval' but they seem not to refer
+;; to let-bound variables, surprisingly.
+;; - calendar-date-echo-text
+;; - calendar-mode-line-format
+;; - cal-tex-daily-string
+;; - diary-date-forms
+;; - diary-remind-message
+;; - calendar-holidays
+;; - calendar-location-name
+;; - whatever is passed to calendar-string-spread
+;; - whatever is passed to calendar-insert-at-column
+;; - whatever is passed to diary-sexp-entry
+;; - whatever is passed to diary-remind
+
+(defmacro calendar-dlet* (binders &rest body)
+ "Like `let*' but using dynamic scoping."
+ (declare (indent 1) (debug let))
+ `(progn
+ (with-no-warnings ;Silence "lacks a prefix" warnings!
+ ,@(mapcar (lambda (binder)
+ `(defvar ,(if (consp binder) (car binder) binder)))
+ binders))
+ (let* ,binders ,@body)))
+
;; Avoid recursive load of calendar when loading cal-menu. Yuck.
(provide 'calendar)
(require 'cal-menu)
@@ -835,7 +866,7 @@ For examples of three common styles, see `diary-american-date-forms',
diary-american-date-forms)
:initialize 'custom-initialize-default
:set (lambda (symbol value)
- (unless (equal value (eval symbol))
+ (unless (equal value (default-value symbol))
(custom-set-default symbol value)
(setq diary-font-lock-keywords (diary-font-lock-keywords))
;; Need to redraw not just to get new font-locking, but also
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 4ee6719d326..4e7cbb313db 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,4 +1,4 @@
-;;; diary-lib.el --- diary functions
+;;; diary-lib.el --- diary functions -*- lexical-binding:t -*-
;; Copyright (C) 1989-1990, 1992-1995, 2001-2017 Free Software
;; Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -119,7 +119,7 @@ are: `string', `symbol', `int', `tnil', `stringtnil.'"
:type 'boolean
:group 'diary)
-(defcustom diary-file-name-prefix-function 'identity
+(defcustom diary-file-name-prefix-function #'identity
"The function that will take a diary file name and return the desired prefix."
:type 'function
:group 'diary)
@@ -156,7 +156,7 @@ Used for example by the appointment package - see `appt-activate'."
:type 'hook
:group 'diary)
-(defcustom diary-display-function 'diary-fancy-display
+(defcustom diary-display-function #'diary-fancy-display
"Function used to display the diary.
The two standard options are `diary-fancy-display' and `diary-simple-display'.
@@ -185,9 +185,9 @@ diary buffer to be displayed with diary entries from various
included files, each day's entries sorted into lexicographic
order, add the following to your init file:
- (setq diary-display-function \\='diary-fancy-display)
- (add-hook \\='diary-list-entries-hook \\='diary-include-other-diary-files)
- (add-hook \\='diary-list-entries-hook \\='diary-sort-entries t)
+ (setq diary-display-function #\\='diary-fancy-display)
+ (add-hook \\='diary-list-entries-hook #\\='diary-include-other-diary-files)
+ (add-hook \\='diary-list-entries-hook #\\='diary-sort-entries t)
Note how the sort function is placed last, so that it can sort
the entries included from other files.
@@ -251,7 +251,7 @@ use `diary-mark-entries-hook', which runs only for the main diary file."
diary-islamic-mark-entries)
:group 'diary)
-(defcustom diary-print-entries-hook 'lpr-buffer
+(defcustom diary-print-entries-hook #'lpr-buffer
"Run by `diary-print-entries' after preparing a temporary diary buffer.
The buffer shows only the diary entries currently visible in the
diary buffer. The default just does the printing. Other uses
@@ -328,7 +328,8 @@ Returns a string using match elements 1-5, where:
;; use the standard function calendar-date-string.
(concat (if month
(calendar-date-string (list month (string-to-number day)
- (string-to-number year)) nil t)
+ (string-to-number year))
+ nil t)
(cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD
((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY
(t "\\1 \\2 \\3"))) ; MDY
@@ -425,7 +426,7 @@ Only used if `diary-header-line-flag' is non-nil."
;; display does not create the fancy buffer, nor does it set
;; diary-selective-display in the diary buffer. This means some
;; customizations will not take effect, eg:
-;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html
+;; https://lists.gnu.org/r/emacs-pretest-bug/2007-03/msg00466.html
;; So the check for diary-selective-display was dropped. This means the
;; diary will be displayed if one customizes a diary variable while
;; just visiting the diary-file. This is i) unlikely, and ii) no great loss.
@@ -552,42 +553,40 @@ If ENTRY is a string, search for matches in that string, and remove them.
Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
pairs."
- (let (regexp regnum attrname attrname attrvalue type ret-attr)
+ (let (ret-attr)
(if (null entry)
(save-excursion
(dolist (attr diary-face-attrs)
;; FIXME inefficient searching.
(goto-char (point-min))
- (setq regexp (concat diary-glob-file-regexp-prefix (car attr))
- regnum (cadr attr)
- attrname (nth 2 attr)
- type (nth 3 attr)
- attrvalue (if (re-search-forward regexp nil t)
- (match-string-no-properties regnum)))
- (and attrvalue
- (setq attrvalue (diary-attrtype-convert attrvalue type))
- (setq ret-attr (append ret-attr
- (list attrname attrvalue))))))
+ (let* ((regexp (concat diary-glob-file-regexp-prefix (car attr)))
+ (regnum (cadr attr))
+ (attrname (nth 2 attr))
+ (type (nth 3 attr))
+ (attrvalue (if (re-search-forward regexp nil t)
+ (match-string-no-properties regnum))))
+ (and attrvalue
+ (setq attrvalue (diary-attrtype-convert attrvalue type))
+ (setq ret-attr (append ret-attr
+ (list attrname attrvalue)))))))
(setq ret-attr fileglobattrs)
(dolist (attr diary-face-attrs)
- (setq regexp (car attr)
- regnum (cadr attr)
- attrname (nth 2 attr)
- type (nth 3 attr)
- attrvalue nil)
- ;; If multiple matches, replace all, use the last (which may
- ;; be the first instance in the line, if the regexp is
- ;; anchored with $).
- (while (string-match regexp entry)
- (setq attrvalue (match-string-no-properties regnum entry)
- entry (replace-match "" t t entry)))
- (and attrvalue
- (setq attrvalue (diary-attrtype-convert attrvalue type))
- (setq ret-attr (append ret-attr (list attrname attrvalue))))))
+ (let ((regexp (car attr))
+ (regnum (cadr attr))
+ (attrname (nth 2 attr))
+ (type (nth 3 attr))
+ (attrvalue nil))
+ ;; If multiple matches, replace all, use the last (which may
+ ;; be the first instance in the line, if the regexp is
+ ;; anchored with $).
+ (while (string-match regexp entry)
+ (setq attrvalue (match-string-no-properties regnum entry)
+ entry (replace-match "" t t entry)))
+ (and attrvalue
+ (setq attrvalue (diary-attrtype-convert attrvalue type))
+ (setq ret-attr (append ret-attr (list attrname attrvalue)))))))
(list entry ret-attr)))
-
-
(defvar diary-modify-entry-list-string-function nil
"Function applied to entry string before putting it into the entries list.
Can be used by programs integrating a diary list into other buffers (e.g.
@@ -656,9 +655,12 @@ any entries were found."
(let* ((month (calendar-extract-month date))
(day (calendar-extract-day date))
(year (calendar-extract-year date))
- (dayname (format "%s\\|%s\\.?" (calendar-day-name date)
- (calendar-day-name date 'abbrev)))
(calendar-month-name-array (or months calendar-month-name-array))
+ (case-fold-search t)
+ entry-found)
+ (calendar-dlet*
+ ((dayname (format "%s\\|%s\\.?" (calendar-day-name date)
+ (calendar-day-name date 'abbrev)))
(monthname (format "\\*\\|%s%s" (calendar-month-name month)
(if months ""
(format "\\|%s\\.?"
@@ -668,61 +670,60 @@ any entries were found."
(year (format "\\*\\|0*%d%s" year
(if diary-abbreviated-year-flag
(format "\\|%02d" (% year 100))
- "")))
- (case-fold-search t)
- entry-found)
- (dolist (date-form diary-date-forms)
- (let ((backup (when (eq (car date-form) 'backup)
- (setq date-form (cdr date-form))
- t))
- ;; date-form uses day etc as set above.
- (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
- (if symbol (regexp-quote symbol) "")
- (mapconcat 'eval date-form "\\)\\(?:")))
- entry-start date-start temp)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (if backup (re-search-backward "\\<" nil t))
- ;; regexp moves us past the end of date, onto the next line.
- ;; Trailing whitespace after date not allowed (see diary-file).
- (if (and (bolp) (not (looking-at "[ \t]")))
- ;; Diary entry that consists only of date.
- (backward-char 1)
- ;; Found a nonempty diary entry--make it
- ;; visible and add it to the list.
- (setq date-start (line-end-position 0))
- ;; Actual entry starts on the next-line?
- (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
- (setq entry-found t
- entry-start (point))
- (forward-line 1)
- (while (looking-at "[ \t]") ; continued entry
- (forward-line 1))
- (unless (and (eobp) (not (bolp)))
- (backward-char 1))
- (unless list-only
- (remove-overlays date-start (point) 'invisible 'diary))
- (setq temp (diary-pull-attrs
- (buffer-substring-no-properties
- entry-start (point)) globattr))
- (diary-add-to-list
- (or gdate date) (car temp)
- (buffer-substring-no-properties (1+ date-start) (1- entry-start))
- (copy-marker entry-start) (cadr temp))))))
- entry-found))
+ ""))))
+ (dolist (date-form diary-date-forms)
+ (let ((backup (when (eq (car date-form) 'backup)
+ (setq date-form (cdr date-form))
+ t))
+ ;; date-form uses day etc as set above.
+ (regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
+ (if symbol (regexp-quote symbol) "")
+ (mapconcat #'eval date-form "\\)\\(?:")))
+ entry-start date-start temp)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (if backup (re-search-backward "\\<" nil t))
+ ;; regexp moves us past the end of date, onto the next line.
+ ;; Trailing whitespace after date not allowed (see diary-file).
+ (if (and (bolp) (not (looking-at "[ \t]")))
+ ;; Diary entry that consists only of date.
+ (backward-char 1)
+ ;; Found a nonempty diary entry--make it
+ ;; visible and add it to the list.
+ (setq date-start (line-end-position 0))
+ ;; Actual entry starts on the next-line?
+ (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
+ (setq entry-found t
+ entry-start (point))
+ (forward-line 1)
+ (while (looking-at "[ \t]") ; continued entry
+ (forward-line 1))
+ (unless (and (eobp) (not (bolp)))
+ (backward-char 1))
+ (unless list-only
+ (remove-overlays date-start (point) 'invisible 'diary))
+ (setq temp (diary-pull-attrs
+ (buffer-substring-no-properties
+ entry-start (point))
+ globattr))
+ (diary-add-to-list
+ (or gdate date) (car temp)
+ (buffer-substring-no-properties
+ (1+ date-start) (1- entry-start))
+ (copy-marker entry-start) (cadr temp))))))
+ entry-found)))
(defvar original-date) ; from diary-list-entries
(defvar file-glob-attrs)
-(defvar list-only)
-(defvar number)
(defun diary-list-entries-1 (months symbol absfunc)
"List diary entries of a certain type.
MONTHS is an array of month names. SYMBOL marks diary entries of the type
in question. ABSFUNC is a function that converts absolute dates to dates
of the appropriate type."
+ (with-no-warnings (defvar number) (defvar list-only))
(let ((gdate original-date))
- (dotimes (_idummy number)
+ (dotimes (_ number)
(diary-list-entries-2
(funcall absfunc (calendar-absolute-from-gregorian gdate))
diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate)
@@ -735,6 +736,10 @@ of the appropriate type."
"List of any diary files included in the last call to `diary-list-entries'.
Or to `diary-mark-entries'.")
+(defvar diary-saved-point) ; bound in diary-list-entries
+(defvar diary-including)
+(defvar date-string) ; bound in diary-list-entries
+
(defun diary-list-entries (date number &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'.
Selects entries for NUMBER days starting with date DATE. Hides any
@@ -814,8 +819,8 @@ LIST-ONLY is non-nil, in which case it just returns the list."
;; diary-header-line-flag after diary has been displayed
;; take effect. Unconditionally calling (diary-mode)
;; clobbers file local variables.
- ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html
- ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html
+ ;; https://lists.gnu.org/r/emacs-pretest-bug/2007-03/msg00363.html
+ ;; https://lists.gnu.org/r/emacs-pretest-bug/2007-04/msg00404.html
(if (eq major-mode 'diary-mode)
(setq header-line-format (and diary-header-line-flag
diary-header-line-format)))))
@@ -832,7 +837,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(set (make-local-variable 'diary-selective-display) t)
(overlay-put ol 'invisible 'diary)
(overlay-put ol 'evaporate t)))
- (dotimes (_idummy number)
+ (dotimes (_ number)
(let ((sexp-found (diary-list-sexp-entries date))
(entry-found (diary-list-entries-2
date diary-nonmarking-symbol
@@ -848,8 +853,10 @@ LIST-ONLY is non-nil, in which case it just returns the list."
;; every time, diary-include-other-diary-files
;; binds it to nil (essentially) when it runs
;; in included files.
- (run-hooks 'diary-nongregorian-listing-hook
- 'diary-list-entries-hook)
+ (calendar-dlet* ((number number)
+ (list-only list-only))
+ (run-hooks 'diary-nongregorian-listing-hook
+ 'diary-list-entries-hook))
;; We could make this explicit:
;;; (run-hooks 'diary-nongregorian-listing-hook)
;;; (if d-incp
@@ -878,8 +885,6 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(remove-overlays (point-min) (point-max) 'invisible 'diary))
(kill-local-variable 'mode-line-format))
-(defvar original-date) ; bound in diary-list-entries
-;(defvar number) ; already declared above
(defun diary-include-files (&optional mark)
"Process diary entries from included diary files.
@@ -894,8 +899,8 @@ This is recursive; that is, included files may include other files."
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
nil t)
(let ((diary-file (match-string-no-properties 1))
- (diary-mark-entries-hook 'diary-mark-included-diary-files)
- (diary-list-entries-hook 'diary-include-other-diary-files)
+ (diary-mark-entries-hook #'diary-mark-included-diary-files)
+ (diary-list-entries-hook #'diary-include-other-diary-files)
(diary-including t)
diary-hook diary-list-include-blanks efile)
(if (file-exists-p diary-file)
@@ -907,6 +912,13 @@ This is recursive; that is, included files may include other files."
(append diary-included-files (list efile)))
(if mark
(diary-mark-entries)
+ ;; FIXME: `diary-include-files' can be run from
+ ;; diary-mark-entries-hook (via
+ ;; diary-mark-included-diary-files) or from
+ ;; diary-list-entries-hook (via
+ ;; diary-include-other-diary-files). In the "list" case,
+ ;; `number' is dynamically bound, but not in the "mark" case!
+ (with-no-warnings (defvar number))
(setq diary-entries-list
(append diary-entries-list
(diary-list-entries original-date number t)))))
@@ -929,8 +941,6 @@ For details, see `diary-include-files'.
See also `diary-mark-included-diary-files'."
(diary-include-files))
-(defvar date-string) ; bound in diary-list-entries
-
(defun diary-display-no-entries ()
"Common subroutine of `diary-simple-display' and `diary-fancy-display'.
Handles the case where there are no diary entries.
@@ -940,7 +950,7 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
(hol-string (format "%s%s%s"
date-string
(if holiday-list ": " "")
- (mapconcat 'identity holiday-list "; ")))
+ (mapconcat #'identity holiday-list "; ")))
(msg (format "No diary entries for %s" hol-string))
;; Empty list, or single item with no text.
;; FIXME multiple items with no text?
@@ -957,13 +967,11 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
;; holiday-list which is too wide for a message gets a buffer.
(calendar-in-read-only-buffer holiday-buffer
(calendar-set-mode-line (format "Holidays for %s" date-string))
- (insert (mapconcat 'identity holiday-list "\n")))
+ (insert (mapconcat #'identity holiday-list "\n")))
(message "No diary entries for %s" date-string)))
(cons noentries hol-string)))
-(defvar diary-saved-point) ; bound in diary-list-entries
-
(defun diary-simple-display ()
"Display the diary buffer if there are any relevant entries or holidays.
Entries that do not apply are made invisible. Holidays are shown
@@ -987,7 +995,7 @@ in the mode line. This is an option for `diary-display-function'."
(set-window-point window diary-saved-point)
(set-window-start window (point-min)))))))
-(defvar diary-goto-entry-function 'diary-goto-entry
+(defvar diary-goto-entry-function #'diary-goto-entry
"Function called to jump to a diary entry.
Modes that require special handling of the included file
containing the diary entry can assign a suitable function to this
@@ -1022,6 +1030,9 @@ variable.")
(goto-char (match-beginning 1)))))
(message "Unable to locate this diary entry")))))
+(defvar displayed-year) ; bound in calendar-generate
+(defvar displayed-month)
+
(defun diary-fancy-display ()
"Prepare a diary buffer with relevant entries in a fancy, noneditable form.
Holidays are shown unless `diary-show-holidays-flag' is nil.
@@ -1204,7 +1215,7 @@ ensure that all relevant variables are set.
(interactive "P")
(if (string-equal diary-mail-addr "")
(user-error "You must set `diary-mail-addr' to use this command")
- (let ((diary-display-function 'diary-fancy-display))
+ (let ((diary-display-function #'diary-fancy-display))
(diary-list-entries (calendar-current-date) (or ndays diary-mail-days)))
(compose-mail diary-mail-addr
(concat "Diary entries generated "
@@ -1242,109 +1253,111 @@ MARKFUNC is a function that marks entries of the appropriate type
matching a given date pattern. MONTHS is an array of month names.
SYMBOL marks diary entries of the type in question. ABSFUNC is a
function that converts absolute dates to dates of the appropriate type. "
- (let ((dayname (diary-name-pattern calendar-day-name-array
- calendar-day-abbrev-array))
- (monthname (format "%s\\|\\*"
- (if months
- (diary-name-pattern months)
- (diary-name-pattern calendar-month-name-array
- calendar-month-abbrev-array))))
- (month "[0-9]+\\|\\*")
- (day "[0-9]+\\|\\*")
- (year "[0-9]+\\|\\*")
- (case-fold-search t)
- marks)
- (dolist (date-form diary-date-forms)
- (if (eq (car date-form) 'backup) ; ignore 'backup directive
- (setq date-form (cdr date-form)))
- (let* ((l (length date-form))
- (d-name-pos (- l (length (memq 'dayname date-form))))
- (d-name-pos (if (/= l d-name-pos) (1+ d-name-pos)))
- (m-name-pos (- l (length (memq 'monthname date-form))))
- (m-name-pos (if (/= l m-name-pos) (1+ m-name-pos)))
- (d-pos (- l (length (memq 'day date-form))))
- (d-pos (if (/= l d-pos) (1+ d-pos)))
- (m-pos (- l (length (memq 'month date-form))))
- (m-pos (if (/= l m-pos) (1+ m-pos)))
- (y-pos (- l (length (memq 'year date-form))))
- (y-pos (if (/= l y-pos) (1+ y-pos)))
- (regexp (format "^%s\\(%s\\)"
- (if symbol (regexp-quote symbol) "")
- (mapconcat 'eval date-form "\\)\\("))))
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let* ((dd-name
- (if d-name-pos
- (match-string-no-properties d-name-pos)))
- (mm-name
- (if m-name-pos
- (match-string-no-properties m-name-pos)))
- (mm (string-to-number
- (if m-pos
- (match-string-no-properties m-pos)
- "")))
- (dd (string-to-number
- (if d-pos
- (match-string-no-properties d-pos)
- "")))
- (y-str (if y-pos
- (match-string-no-properties y-pos)))
- (yy (if (not y-str)
- 0
- (if (and (= (length y-str) 2)
- diary-abbreviated-year-flag)
- (let* ((current-y
- (calendar-extract-year
- (if absfunc
- (funcall
- absfunc
- (calendar-absolute-from-gregorian
- (calendar-current-date)))
- (calendar-current-date))))
- (y (+ (string-to-number y-str)
- ;; Current century, eg 2000.
- (* 100 (/ current-y 100))))
- (offset (- y current-y)))
- ;; Add 2-digit year to current century.
- ;; If more than 50 years in the future,
- ;; assume last century. If more than 50
- ;; years in the past, assume next century.
- (if (> offset 50)
- (- y 100)
- (if (< offset -50)
- (+ y 100)
- y)))
- (string-to-number y-str)))))
- (setq marks (cadr (diary-pull-attrs
- (buffer-substring-no-properties
- (point) (line-end-position))
- file-glob-attrs)))
- ;; Only mark all days of a given name if the pattern
- ;; contains no more specific elements.
- (if (and dd-name (not (or d-pos m-pos y-pos)))
- (calendar-mark-days-named
- (cdr (assoc-string dd-name
+ (calendar-dlet*
+ ((dayname (diary-name-pattern calendar-day-name-array
+ calendar-day-abbrev-array))
+ (monthname (format "%s\\|\\*"
+ (if months
+ (diary-name-pattern months)
+ (diary-name-pattern calendar-month-name-array
+ calendar-month-abbrev-array))))
+ (month "[0-9]+\\|\\*")
+ (day "[0-9]+\\|\\*")
+ (year "[0-9]+\\|\\*"))
+ (let* ((case-fold-search t)
+ marks)
+ (dolist (date-form diary-date-forms)
+ (if (eq (car date-form) 'backup) ; ignore 'backup directive
+ (setq date-form (cdr date-form)))
+ (let* ((l (length date-form))
+ (d-name-pos (- l (length (memq 'dayname date-form))))
+ (d-name-pos (if (/= l d-name-pos) (1+ d-name-pos)))
+ (m-name-pos (- l (length (memq 'monthname date-form))))
+ (m-name-pos (if (/= l m-name-pos) (1+ m-name-pos)))
+ (d-pos (- l (length (memq 'day date-form))))
+ (d-pos (if (/= l d-pos) (1+ d-pos)))
+ (m-pos (- l (length (memq 'month date-form))))
+ (m-pos (if (/= l m-pos) (1+ m-pos)))
+ (y-pos (- l (length (memq 'year date-form))))
+ (y-pos (if (/= l y-pos) (1+ y-pos)))
+ (regexp (format "^%s\\(%s\\)"
+ (if symbol (regexp-quote symbol) "")
+ (mapconcat #'eval date-form "\\)\\("))))
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let* ((dd-name
+ (if d-name-pos
+ (match-string-no-properties d-name-pos)))
+ (mm-name
+ (if m-name-pos
+ (match-string-no-properties m-name-pos)))
+ (mm (string-to-number
+ (if m-pos
+ (match-string-no-properties m-pos)
+ "")))
+ (dd (string-to-number
+ (if d-pos
+ (match-string-no-properties d-pos)
+ "")))
+ (y-str (if y-pos
+ (match-string-no-properties y-pos)))
+ (yy (if (not y-str)
+ 0
+ (if (and (= (length y-str) 2)
+ diary-abbreviated-year-flag)
+ (let* ((current-y
+ (calendar-extract-year
+ (if absfunc
+ (funcall
+ absfunc
+ (calendar-absolute-from-gregorian
+ (calendar-current-date)))
+ (calendar-current-date))))
+ (y (+ (string-to-number y-str)
+ ;; Current century, eg 2000.
+ (* 100 (/ current-y 100))))
+ (offset (- y current-y)))
+ ;; Add 2-digit year to current century.
+ ;; If more than 50 years in the future,
+ ;; assume last century. If more than 50
+ ;; years in the past, assume next century.
+ (if (> offset 50)
+ (- y 100)
+ (if (< offset -50)
+ (+ y 100)
+ y)))
+ (string-to-number y-str)))))
+ (setq marks (cadr (diary-pull-attrs
+ (buffer-substring-no-properties
+ (point) (line-end-position))
+ file-glob-attrs)))
+ ;; Only mark all days of a given name if the pattern
+ ;; contains no more specific elements.
+ (if (and dd-name (not (or d-pos m-pos y-pos)))
+ (calendar-mark-days-named
+ (cdr (assoc-string dd-name
+ (calendar-make-alist
+ calendar-day-name-array
+ 0 nil calendar-day-abbrev-array
+ (mapcar (lambda (e)
+ (format "%s." e))
+ calendar-day-abbrev-array))
+ t))
+ marks)
+ (if mm-name
+ (setq mm
+ (if (string-equal mm-name "*") 0
+ (cdr (assoc-string
+ mm-name
+ (if months (calendar-make-alist months)
(calendar-make-alist
- calendar-day-name-array
- 0 nil calendar-day-abbrev-array
+ calendar-month-name-array
+ 1 nil calendar-month-abbrev-array
(mapcar (lambda (e)
(format "%s." e))
- calendar-day-abbrev-array))
- t)) marks)
- (if mm-name
- (setq mm
- (if (string-equal mm-name "*") 0
- (cdr (assoc-string
- mm-name
- (if months (calendar-make-alist months)
- (calendar-make-alist
- calendar-month-name-array
- 1 nil calendar-month-abbrev-array
- (mapcar (lambda (e)
- (format "%s." e))
- calendar-month-abbrev-array)))
- t)))))
- (funcall markfunc mm dd yy marks))))))))
+ calendar-month-abbrev-array)))
+ t)))))
+ (funcall markfunc mm dd yy marks)))))))))
;;;###cal-autoload
(defun diary-mark-entries (&optional redraw)
@@ -1406,30 +1419,30 @@ marks. This is intended to deal with deleted diary entries."
(defun diary-sexp-entry (sexp entry date)
"Process a SEXP diary ENTRY for DATE."
- (let ((result (if calendar-debug-sexp
- (let ((debug-on-error t))
- (eval (car (read-from-string sexp))))
- (let (err)
- (condition-case err
- (eval (car (read-from-string sexp)))
- (error
- (display-warning
- 'diary
- (format "Bad diary sexp at line %d in %s:\n%s\n\
-Error: %s\n"
- (count-lines (point-min) (point))
- diary-file sexp err)
- :error)
- nil))))))
+ (let ((result
+ (calendar-dlet* ((date date)
+ (entry entry))
+ (if calendar-debug-sexp
+ (let ((debug-on-error t))
+ (eval (car (read-from-string sexp))))
+ (condition-case err
+ (eval (car (read-from-string sexp)))
+ (error
+ (display-warning
+ 'diary
+ (format "Bad diary sexp at line %d in %s:\n%s\n\
+Error: %S\n"
+ (count-lines (point-min) (point))
+ diary-file sexp err)
+ :error)
+ nil))))))
(cond ((stringp result) result)
((and (consp result)
- (stringp (cdr result))) result)
+ (stringp (cdr result)))
+ result)
(result entry)
(t nil))))
-(defvar displayed-year) ; bound in calendar-generate
-(defvar displayed-month)
-
(defun diary-mark-sexp-entries ()
"Mark days in the calendar window that have sexp diary entries.
Each entry in the diary file (or included files) visible in the calendar window
@@ -1532,7 +1545,7 @@ passed to `calendar-mark-visible-date' as MARK."
(let ((m displayed-month)
(y displayed-year))
(calendar-increment-month m y -1)
- (dotimes (_idummy 3)
+ (dotimes (_ 3)
(calendar-mark-month m y month day year color)
(calendar-increment-month m y 1)))))
@@ -1814,9 +1827,6 @@ form used internally by the calendar and diary."
;;; Sexp diary functions.
-(defvar date)
-(defvar entry)
-
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
(defun diary-date (month day year &optional mark)
"Specific date(s) diary entry.
@@ -1827,6 +1837,7 @@ of the input parameters changes according to `calendar-date-style'
An optional parameter MARK specifies a face or single-character string
to use when highlighting the day in the calendar."
+ (with-no-warnings (defvar date) (defvar entry))
(let* ((ddate (diary-make-date month day year))
(dd (calendar-extract-day ddate))
(mm (calendar-extract-month ddate))
@@ -1855,6 +1866,7 @@ of the input parameters changes according to `calendar-date-style'
An optional parameter MARK specifies a face or single-character string
to use when highlighting the day in the calendar."
+ (with-no-warnings (defvar date) (defvar entry))
(let ((date1 (calendar-absolute-from-gregorian
(diary-make-date m1 d1 y1)))
(date2 (calendar-absolute-from-gregorian
@@ -1873,6 +1885,7 @@ DAY defaults to 1 if N>0, and MONTH's last day otherwise.
MONTH can be a list of months, an integer, or t (meaning all months).
Optional MARK specifies a face or single-character string to use when
highlighting the day in the calendar."
+ (with-no-warnings (defvar date) (defvar entry))
;; This is messy because the diary entry may apply, but the date on which it
;; is based can be in a different month/year. For example, asking for the
;; first Monday after December 30. For large values of |n| the problem is
@@ -1951,6 +1964,7 @@ is considered to be March 1 in non-leap years.
An optional parameter MARK specifies a face or single-character
string to use when highlighting the day in the calendar."
+ (with-no-warnings (defvar date) (defvar entry))
(let* ((ddate (diary-make-date month day year))
(dd (calendar-extract-day ddate))
(mm (calendar-extract-month ddate))
@@ -1975,6 +1989,7 @@ and %s by the ordinal ending of that number (that is, `st', `nd',
An optional parameter MARK specifies a face or single-character
string to use when highlighting the day in the calendar."
+ (with-no-warnings (defvar date) (defvar entry))
(or (> n 0)
(user-error "Day count must be positive"))
(let* ((diff (- (calendar-absolute-from-gregorian date)
@@ -1986,6 +2001,7 @@ string to use when highlighting the day in the calendar."
(defun diary-day-of-year ()
"Day of year and number of days remaining in the year of date diary entry."
+ (with-no-warnings (defvar date))
(calendar-day-of-year-string date))
(defun diary-remind (sexp days &optional marking)
@@ -2007,11 +2023,12 @@ whether the entry itself is a marking or nonmarking; if optional
parameter MARKING is non-nil then the reminders are marked on the
calendar."
;; `date' has a value at this point, from diary-sexp-entry.
+ (with-no-warnings (defvar date))
;; Convert a negative number to a list of days.
(and (integerp days)
(< days 0)
(setq days (number-sequence 1 (- days))))
- (let ((diary-entry (eval sexp)))
+ (calendar-dlet* ((diary-entry (eval sexp)))
(cond
;; Diary entry applies on date.
((and diary-entry
@@ -2027,7 +2044,7 @@ calendar."
(when (setq diary-entry (eval sexp))
;; Discard any mark portion from diary-anniversary, etc.
(if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
- (mapconcat 'eval diary-remind-message ""))))
+ (mapconcat #'eval diary-remind-message ""))))
;; Diary entry may apply to one of a list of days before date.
((and (listp days) days)
(or (diary-remind sexp (car days) marking)
@@ -2224,18 +2241,19 @@ If given, optional SYMBOL must be a prefix to entries. If
optional ABBREV-ARRAY is present, also matches the abbreviations
from this array (with or without a final `.'), in addition to the
full month names."
- (let ((dayname (diary-name-pattern calendar-day-name-array
- calendar-day-abbrev-array t))
- (monthname (format "\\(%s\\|\\*\\)"
- (diary-name-pattern month-array abbrev-array)))
- (month "\\([0-9]+\\|\\*\\)")
- (day "\\([0-9]+\\|\\*\\)")
- (year "-?\\([0-9]+\\|\\*\\)"))
+ (calendar-dlet*
+ ((dayname (diary-name-pattern calendar-day-name-array
+ calendar-day-abbrev-array t))
+ (monthname (format "\\(%s\\|\\*\\)"
+ (diary-name-pattern month-array abbrev-array)))
+ (month "\\([0-9]+\\|\\*\\)")
+ (day "\\([0-9]+\\|\\*\\)")
+ (year "-?\\([0-9]+\\|\\*\\)"))
(mapcar (lambda (x)
(cons
(concat "^" (regexp-quote diary-nonmarking-symbol) "?"
(if symbol (regexp-quote symbol) "") "\\("
- (mapconcat 'eval
+ (mapconcat #'eval
;; If backup, omit first item (backup)
;; and last item (not part of date).
(if (equal (car x) 'backup)
@@ -2312,7 +2330,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
'font-lock-constant-face)
(cons
(format "^%s?%s" (regexp-quote diary-nonmarking-symbol)
- (regexp-opt (mapcar 'regexp-quote
+ (regexp-opt (mapcar #'regexp-quote
(list diary-hebrew-entry-symbol
diary-islamic-entry-symbol
diary-bahai-entry-symbol
@@ -2345,10 +2363,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
(set (make-local-variable 'comment-start) diary-comment-start)
(set (make-local-variable 'comment-end) diary-comment-end)
(add-to-invisibility-spec '(diary . nil))
- (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
+ (add-hook 'after-save-hook #'diary-redraw-calendar nil t)
;; In case the file was modified externally, refresh the calendar
;; after refreshing the diary buffer.
- (add-hook 'after-revert-hook 'diary-redraw-calendar nil t)
+ (add-hook 'after-revert-hook #'diary-redraw-calendar nil t)
(if diary-header-line-flag
(setq header-line-format diary-header-line-format)))
@@ -2359,18 +2377,19 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
"Return a regexp matching the first line of a fancy diary date header.
This depends on the calendar date style."
(concat
- (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
- (monthname (diary-name-pattern calendar-month-name-array nil t))
- (day "1")
- (month "2")
- ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
- (year "3"))
+ (calendar-dlet*
+ ((dayname (diary-name-pattern calendar-day-name-array nil t))
+ (monthname (diary-name-pattern calendar-month-name-array nil t))
+ (day "1")
+ (month "2")
+ ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
+ (year "3"))
;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
;; string form"; eg the iso version calls string-to-number on some.
;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
;; Assumes no integers in c-day/month-name-array.
(replace-regexp-in-string "[0-9]+" "[0-9]+"
- (mapconcat 'eval calendar-date-display-form "")
+ (mapconcat #'eval calendar-date-display-form "")
nil t))
;; Optional ": holiday name" after the date.
"\\(: .*\\)?"))
@@ -2391,7 +2410,8 @@ This depends on the calendar date style."
("^Day.*omer.*$" . font-lock-builtin-face)
("^Parashat.*$" . font-lock-comment-face)
(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
- diary-time-regexp) . 'diary-time))
+ diary-time-regexp)
+ . 'diary-time))
"Keywords to highlight in fancy diary display.")
;; If region looks like it might start or end in the middle of a
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 5b51b16d223..0a80b79f442 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index aa092b233ef..129cd6d9ad3 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 4d39b15aa03..9f7fad99f46 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index b781cb0eb48..dc405b9d972 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index f5cde3feac4..84e8bb3d259 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1,4 +1,4 @@
-;;; solar.el --- calendar functions for solar events
+;;; solar.el --- calendar functions for solar events -*- lexical-binding:t -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2017 Free Software
;; Foundation, Inc.
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -552,12 +552,14 @@ degrees to find out if polar regions have 24 hours of sun or only night."
"Printable form for decimal fraction TIME in TIME-ZONE.
Format used is given by `calendar-time-display-form'."
(let* ((time (round (* 60 time)))
- (24-hours (/ time 60))
+ (24-hours (/ time 60)))
+ (calendar-dlet*
+ ((time-zone time-zone)
(minutes (format "%02d" (% time 60)))
(12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
(am-pm (if (>= 24-hours 12) "pm" "am"))
(24-hours (format "%02d" 24-hours)))
- (mapconcat 'eval calendar-time-display-form "")))
+ (mapconcat #'eval calendar-time-display-form ""))))
(defun solar-daylight (time)
"Printable form for TIME expressed in hours."
@@ -661,10 +663,10 @@ Optional NOLOCATION non-nil means do not print the location."
(format
"%s, %s%s (%s hrs daylight)"
(if (car l)
- (concat "Sunrise " (apply 'solar-time-string (car l)))
+ (concat "Sunrise " (apply #'solar-time-string (car l)))
"No sunrise")
(if (cadr l)
- (concat "sunset " (apply 'solar-time-string (cadr l)))
+ (concat "sunset " (apply #'solar-time-string (cadr l)))
"no sunset")
(if nolocation ""
(format " at %s" (eval calendar-location-name)))
@@ -749,7 +751,7 @@ The values of `calendar-daylight-savings-starts',
(+ 4.9353929
(* 62833.1961680 U)
(* 0.0000001
- (apply '+
+ (apply #'+
(mapcar (lambda (x)
(* (car x)
(sin (mod
@@ -889,13 +891,12 @@ Accurate to a few seconds."
(insert (format "%s %2d: " (calendar-month-name month t) (1+ i))
(solar-sunrise-sunset-string date t) "\n")))))
-(defvar date)
-
-;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-sunrise-sunset ()
"Local time of sunrise and sunset as a diary entry.
Accurate to a few seconds."
+ ;; To be called from diary-list-sexp-entries, where DATE is bound.
+ (with-no-warnings (defvar date))
(or (and calendar-latitude calendar-longitude calendar-time-zone)
(solar-setup))
(solar-sunrise-sunset-string date))
@@ -938,7 +939,7 @@ Accurate to within a minute between 1951 and 2050."
(W (- (* 35999.373 T) 2.47))
(Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
(* 0.0007 (solar-cosine-degrees (* 2 W)))))
- (S (apply '+ (mapcar (lambda(x)
+ (S (apply #'+ (mapcar (lambda(x)
(* (car x) (solar-cosine-degrees
(+ (* (nth 2 x) T) (cadr x)))))
solar-seasons-data)))
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index d9986231fdd..61722f61ea0 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index a4709c3b4b5..a70e3ee416c 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index 7b27e7049d1..df3953f7a70 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1,4 +1,4 @@
-;;; todo-mode.el --- facilities for making and maintaining todo lists
+;;; todo-mode.el --- facilities for making and maintaining todo lists -*- lexical-binding:t -*-
;; Copyright (C) 1997, 1999, 2001-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -72,14 +72,14 @@ file truenames in `todo-directory' with the extension
\".todo\". With non-nil ARCHIVES return the list of archive file
truenames (those with the extension \".toda\")."
(let ((files (if (file-exists-p todo-directory)
- (mapcar 'file-truename
+ (mapcar #'file-truename
(directory-files todo-directory t
- (if archives "\\.toda$" "\\.todo$") t)))))
+ (if archives "\\.toda\\'" "\\.todo\\'") t)))))
(sort files (lambda (s1 s2) (let ((cis1 (upcase s1))
(cis2 (upcase s2)))
(string< cis1 cis2))))))
-(defcustom todo-files-function 'todo-files
+(defcustom todo-files-function #'todo-files
"Function returning the value of the variable `todo-files'.
This function should take an optional argument that, if non-nil,
makes it return the value of the variable `todo-archives'."
@@ -191,14 +191,15 @@ The final element is \"*\", indicating an unspecified month.")
(defconst todo-date-pattern
(let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
(concat "\\(?4:\\(?5:" dayname "\\)\\|"
- (let ((dayname)
- (monthname (format "\\(?6:%s\\)" (diary-name-pattern
- todo-month-name-array
- todo-month-abbrev-array)))
- (month "\\(?7:[0-9]+\\|\\*\\)")
- (day "\\(?8:[0-9]+\\|\\*\\)")
- (year "-?\\(?9:[0-9]+\\|\\*\\)"))
- (mapconcat 'eval calendar-date-display-form ""))
+ (calendar-dlet*
+ ((dayname)
+ (monthname (format "\\(?6:%s\\)" (diary-name-pattern
+ todo-month-name-array
+ todo-month-abbrev-array)))
+ (month "\\(?7:[0-9]+\\|\\*\\)")
+ (day "\\(?8:[0-9]+\\|\\*\\)")
+ (year "-?\\(?9:[0-9]+\\|\\*\\)"))
+ (mapconcat #'eval calendar-date-display-form ""))
"\\)"))
"Regular expression matching a todo item date header.")
@@ -260,7 +261,7 @@ This function is the value of the user variable
(let ((file (todo-short-file-name todo-current-todo-file)))
(format "%s category %d: %s" file todo-category-number cat)))
-(defcustom todo-mode-line-function 'todo-mode-line-control
+(defcustom todo-mode-line-function #'todo-mode-line-control
"Function that returns a mode line control for Todo mode buffers.
The function expects one argument holding the name of the current
todo category. The resulting control becomes the local value of
@@ -555,13 +556,15 @@ This lacks the extension and directory components."
(when (stringp file)
(file-name-sans-extension (file-name-nondirectory file))))
+(defun todo--files-type-list ()
+ (mapcar (lambda (f) (list 'const (todo-short-file-name f)))
+ (funcall todo-files-function)))
+
(defcustom todo-default-todo-file (todo-short-file-name
(car (funcall todo-files-function)))
"Todo file visited by first session invocation of `todo-show'."
:type (when todo-files
- `(radio ,@(mapcar (lambda (f) (list 'const f))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function)))))
+ `(radio ,@(todo--files-type-list)))
:group 'todo)
(defcustom todo-show-current-file t
@@ -598,9 +601,7 @@ Otherwise, `todo-show' always visits `todo-default-todo-file'."
(defcustom todo-category-completions-files nil
"List of files for building `todo-read-category' completions."
- :type `(set ,@(mapcar (lambda (f) (list 'const f))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function))))
+ :type `(set ,@(todo--files-type-list))
:group 'todo)
(defcustom todo-completion-ignore-case nil
@@ -692,7 +693,8 @@ and done items are always shown on visiting a category."
;; We just initialized the first todo file, so make it the default.
(setq todo-default-todo-file (todo-short-file-name file)
first-file t)
- (todo-reevaluate-default-file-defcustom))
+ (put 'todo-default-todo-file 'custom-type
+ `(radio ,@(todo--files-type-list))))
(unless (member file todo-visited)
;; Can't setq t-c-t-f here, otherwise wrong file shown when
;; todo-show is called from todo-show-categories-table.
@@ -707,11 +709,12 @@ and done items are always shown on visiting a category."
(let ((rxfiles (directory-files todo-directory t
".*\\.todr$" t)))
(when (and rxfiles (> (length rxfiles) 1))
- (let ((rxf (mapcar 'todo-short-file-name rxfiles)))
+ (let ((rxf (mapcar #'todo-short-file-name rxfiles)))
(setq fi-file (todo-absolute-file-name
(completing-read
"Choose a regexp items file: "
- rxf) 'regexp))))))
+ rxf)
+ 'regexp))))))
(if (file-exists-p fi-file)
(progn
(set-window-buffer
@@ -770,7 +773,8 @@ and done items are always shown on visiting a category."
(when first-file
(setq todo-default-todo-file nil
todo-current-todo-file nil)
- (todo-reevaluate-default-file-defcustom))
+ (put 'todo-default-todo-file 'custom-type
+ `(radio ,@(todo--files-type-list))))
(kill-buffer)
(keyboard-quit)))))
(save-excursion (todo-category-select))
@@ -823,7 +827,7 @@ buries it and restores state as needed."
(when (buffer-live-p buf) (kill-buffer buf)))
((eq major-mode 'todo-mode)
(todo-save)
- (bury-buffer)))))
+ (quit-window)))))
;; -----------------------------------------------------------------------------
;;; Navigation between and within categories
@@ -857,7 +861,7 @@ category is the first)."
(zerop (todo-get-count 'done))
(not (zerop (todo-get-count 'archived))))
(setq todo-category-number
- (apply (if back '1- '1+) (list todo-category-number)))))
+ (funcall (if back #'1- #'1+) todo-category-number))))
(todo-category-select)
(goto-char (point-min)))
@@ -944,7 +948,7 @@ called with a prefix argument only moves point to a lower item,
e.g., with point on the last todo item and called with prefix 1,
it moves point to the first done item; but if called with point
on the last todo item without a prefix argument, it moves point
-the the empty line above the done items separator."
+to the empty line above the done items separator."
(interactive "p")
;; It's not worth the trouble to allow prefix arg value < 1, since
;; we have the corresponding command.
@@ -964,7 +968,7 @@ If the category's done items are visible, this command called
with a prefix argument only moves point to a higher item, e.g.,
with point on the first done item and called with prefix 1, it
moves to the last todo item; but if called with point on the
-first done item without a prefix argument, it moves point the the
+first done item without a prefix argument, it moves point to the
empty line above the done items separator."
(interactive "p")
;; Avoid moving to bob if on the first item but not at bob.
@@ -1034,29 +1038,41 @@ empty line above the done items separator."
(hl-line-mode -1)
(hl-line-mode 1))))
+(defvar todo--item-headers-hidden nil
+ "Non-nil if item date-time headers in current buffer are hidden.")
+
(defun todo-toggle-item-header ()
"Hide or show item date-time headers in the current file.
With done items, this hides only the done date-time string, not
-the the original date-time string."
+the original date-time string."
(interactive)
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (let ((ov (todo-get-overlay 'header)))
- (if ov
- (remove-overlays 1 (1+ (buffer-size)) 'todo 'header)
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (when (re-search-forward
- (concat todo-item-start
- "\\( " diary-time-regexp "\\)?"
- (regexp-quote todo-nondiary-end) "? ")
- nil t)
- (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
- (overlay-put ov 'todo 'header)
- (overlay-put ov 'display ""))
- (todo-forward-item)))))))
+ (unless (catch 'nonempty
+ (dolist (type '(todo done))
+ (dolist (c todo-categories)
+ (let ((count (todo-get-count type (car c))))
+ (unless (zerop count)
+ (throw 'nonempty t))))))
+ (user-error "This file has no items"))
+ (if todo--item-headers-hidden
+ (progn
+ (remove-overlays 1 (1+ (buffer-size)) 'todo 'header)
+ (setq todo--item-headers-hidden nil))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (let (ov)
+ (while (not (eobp))
+ (when (re-search-forward
+ (concat todo-item-start
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "? ")
+ nil t)
+ (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
+ (overlay-put ov 'todo 'header)
+ (overlay-put ov 'display ""))
+ (forward-line)))
+ (setq todo--item-headers-hidden t)))))
;; -----------------------------------------------------------------------------
;;; File and category editing
@@ -1080,7 +1096,7 @@ Noninteractively, return the name of the new file."
(write-region (point-min) (point-max) file nil 'nomessage nil t)
(kill-buffer file))
(setq todo-files (funcall todo-files-function))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(if (called-interactively-p 'any)
(progn
(set-window-buffer (selected-window)
@@ -1105,7 +1121,8 @@ these files, also rename them accordingly."
(snname (todo-short-file-name nname))
(files (directory-files todo-directory t
(concat ".*" (regexp-quote soname)
- ".*\\.tod[aorty]$") t)))
+ ".*\\.tod[aorty]$")
+ t)))
(dolist (f files)
(let* ((sfname (todo-short-file-name f))
(fext (file-name-extension f t))
@@ -1133,7 +1150,7 @@ these files, also rename them accordingly."
(setq todo-default-todo-file snname))
(when (string= todo-global-current-todo-file oname)
(setq todo-global-current-todo-file nname))
- (todo-reevaluate-filelist-defcustoms)))
+ (todo-update-filelist-defcustoms)))
(defun todo-delete-file ()
"Delete the current todo, archive or filtered items file.
@@ -1194,7 +1211,7 @@ visiting the deleted files."
(when (or (string= file1 todo-global-current-todo-file)
(and delete2 (string= file2 todo-global-current-todo-file)))
(setq todo-global-current-todo-file nil))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(message (concat (cond (todo "Todo") (archive "Archive")) " file \"%s\" "
(when delete2
(concat "and its "
@@ -1351,10 +1368,12 @@ todo or done items."
(let ((buffer-read-only)
(beg (re-search-backward
(concat "^" (regexp-quote (concat todo-category-beg cat))
- "\n") nil t))
+ "\n")
+ nil t))
(end (if (re-search-forward
(concat "\n\\(" (regexp-quote todo-category-beg)
- ".*\n\\)") nil t)
+ ".*\n\\)")
+ nil t)
(match-beginning 1)
(point-max))))
(remove-overlays beg end)
@@ -1362,7 +1381,7 @@ todo or done items."
(if (= (length todo-categories) 1)
;; If deleted category was the only one, delete the file.
(progn
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
;; Skip confirming killing the archive buffer if it has been
;; modified and not saved.
(set-buffer-modified-p nil)
@@ -1405,7 +1424,7 @@ the archive of the file moved to, creating it if it does not exist."
(write-region (point-min) (point-max) nfile nil 'nomessage nil t)
(kill-buffer nfile))
(setq todo-files (funcall todo-files-function))
- (todo-reevaluate-filelist-defcustoms))
+ (todo-update-filelist-defcustoms))
(dolist (buf buffers)
;; Make sure archive file is in Todo Archive mode so that
;; todo-categories has correct value.
@@ -1463,7 +1482,8 @@ the archive of the file moved to, creating it if it does not exist."
(goto-char (point-max))
(re-search-backward
(concat "^" (regexp-quote todo-category-beg)
- "\\(" (regexp-quote cat) "\\)$") nil t)
+ "\\(" (regexp-quote cat) "\\)$")
+ nil t)
(replace-match new nil nil nil 1))
(setq todo-categories
(append todo-categories (list (cons (or new cat) counts))))
@@ -1498,7 +1518,7 @@ the archive of the file moved to, creating it if it does not exist."
(delete-file todo-current-todo-file)
(kill-buffer)
(when (member todo-current-todo-file todo-files)
- (todo-reevaluate-filelist-defcustoms)))
+ (todo-update-filelist-defcustoms)))
(setq todo-categories (delete (assoc cat todo-categories)
todo-categories))
(todo-update-categories-sexp)
@@ -1728,49 +1748,52 @@ means prompt user and omit comment only on confirmation."
With positive numerical prefix argument N, change the marking of
the next N items in the current category. If both the todo and
done items sections are visible, the sequence of N items can
-consist of the the last todo items and the first done items."
+consist of the last todo items and the first done items."
(interactive "p")
(when (todo-item-string)
- (unless (> n 1) (setq n 1))
- (catch 'end
- (dotimes (i n)
- (let* ((cat (todo-current-category))
- (marks (assoc cat todo-categories-with-marks))
- (ov (progn
- (unless (looking-at todo-item-start)
- (todo-item-start))
- (todo-get-overlay 'prefix)))
- (pref (overlay-get ov 'before-string)))
- (if (todo-marked-item-p)
- (progn
- (overlay-put ov 'before-string (substring pref 1))
- (if (= (cdr marks) 1) ; Deleted last mark in this category.
- (setq todo-categories-with-marks
- (assq-delete-all cat todo-categories-with-marks))
- (setcdr marks (1- (cdr marks)))))
- (overlay-put ov 'before-string (concat todo-item-mark pref))
- (if marks
- (setcdr marks (1+ (cdr marks)))
- (push (cons cat 1) todo-categories-with-marks))))
- (todo-forward-item)
- ;; Don't try to mark the empty lines at the end of the todo
- ;; and done items sections.
- (when (looking-at "^$")
- (if (eobp)
- (throw 'end nil)
- (todo-forward-item)))))))
+ (let ((cat (todo-current-category)))
+ (unless (> n 1) (setq n 1))
+ (catch 'end
+ (dotimes (_ n)
+ (let* ((marks (assoc cat todo-categories-with-marks))
+ (ov (progn
+ (unless (looking-at todo-item-start)
+ (todo-item-start))
+ (todo-get-overlay 'prefix)))
+ (pref (overlay-get ov 'before-string)))
+ (if (todo-marked-item-p)
+ (progn
+ (overlay-put ov 'before-string (substring pref 1))
+ (if (= (cdr marks) 1) ; Deleted last mark in this category.
+ (setq todo-categories-with-marks
+ (assq-delete-all cat todo-categories-with-marks))
+ (setcdr marks (1- (cdr marks)))))
+ (overlay-put ov 'before-string (concat todo-item-mark pref))
+ (if marks
+ (setcdr marks (1+ (cdr marks)))
+ (push (cons cat 1) todo-categories-with-marks))))
+ (todo-forward-item)
+ ;; Don't try to mark the empty lines at the end of the todo
+ ;; and done items sections.
+ (when (looking-at "^$")
+ (if (eobp)
+ (throw 'end nil)
+ (todo-forward-item))))))))
(defun todo-mark-category ()
"Mark all visible items in this category with `todo-item-mark'."
(interactive)
- (let* ((cat (todo-current-category))
- (marks (assoc cat todo-categories-with-marks)))
+ (let ((cat (todo-current-category)))
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (let* ((ov (todo-get-overlay 'prefix))
- (pref (overlay-get ov 'before-string)))
- (unless (todo-marked-item-p)
+ (let* ((marks (assoc cat todo-categories-with-marks))
+ (ov (todo-get-overlay 'prefix))
+ ;; When done items are shown and there are no todo items, the
+ ;; loop starts on the empty line in the todo items sections,
+ ;; which has no overlay, so don't try to get it.
+ (pref (when ov (overlay-get ov 'before-string))))
+ (unless (or (todo-marked-item-p) (not ov))
(overlay-put ov 'before-string (concat todo-item-mark pref))
(if marks
(setcdr marks (1+ (cdr marks)))
@@ -1791,7 +1814,7 @@ consist of the the last todo items and the first done items."
(goto-char (point-min))
(while (not (eobp))
(let* ((ov (todo-get-overlay 'prefix))
- ;; No overlay on empty line between todo and done items.
+ ;; See comment above in `todo-mark-category'.
(pref (when ov (overlay-get ov 'before-string))))
(when (todo-marked-item-p)
(overlay-put ov 'before-string (substring pref 1)))
@@ -2119,7 +2142,8 @@ the item at point."
(todo-item-start)
(re-search-forward
(concat " \\[" (regexp-quote todo-comment-string)
- ": \\([^]]+\\)\\]") end t)))
+ ": \\([^]]+\\)\\]")
+ end t)))
(prompt (if comment "Edit comment: " "Enter a comment: "))
(buffer-read-only nil))
;; When there are marked items, user can invoke todo-edit-item
@@ -2135,7 +2159,8 @@ the item at point."
(todo-item-start)
(if (re-search-forward (concat " \\["
(regexp-quote todo-comment-string)
- ": \\([^]]+\\)\\]") end t)
+ ": \\([^]]+\\)\\]")
+ end t)
(if comment-delete
(when (todo-y-or-n-p "Delete comment? ")
(delete-region (match-beginning 0) (match-end 0)))
@@ -2167,7 +2192,8 @@ the item at point."
(cons item 0))))))
(when include-header
(while (not (string-match (concat todo-date-string-start
- todo-date-pattern) new))
+ todo-date-pattern)
+ new))
(setq new (read-from-minibuffer
"Item must start with a date: " new))))
;; Ensure lines following hard newlines are indented.
@@ -2196,7 +2222,8 @@ made in the number or names of categories."
(regex "\\(\n\\)[^[:blank:]]")
(buf (buffer-base-buffer)))
(while (not (string-match (concat todo-date-string-start
- todo-date-pattern) item))
+ todo-date-pattern)
+ item))
(setq item (read-from-minibuffer
"Item must start with a date: " item)))
;; Ensure lines following hard newlines are indented.
@@ -2239,8 +2266,8 @@ made in the number or names of categories."
;; `todo-edit-item' as e.g. `-' or `C-u'.
(inc (prefix-numeric-value inc))
(buffer-read-only nil)
- ndate ntime year monthname month day
- dayname) ; Needed by calendar-date-display-form.
+ ndate ntime
+ year monthname month day dayname)
(when marked (todo--user-error-if-marked-done-item))
(save-excursion
(or (and marked (goto-char (point-min))) (todo-item-start))
@@ -2255,8 +2282,7 @@ made in the number or names of categories."
"\\)\\(?2: " diary-time-regexp "\\)?"
(regexp-quote todo-nondiary-end) "?")
(line-end-position) t)
- (let* ((odate (match-string-no-properties 1))
- (otime (match-string-no-properties 2))
+ (let* ((otime (match-string-no-properties 2))
(odayname (match-string-no-properties 5))
(omonthname (match-string-no-properties 6))
(omonth (match-string-no-properties 7))
@@ -2367,7 +2393,8 @@ made in the number or names of categories."
(calendar-current-date))))
(date (calendar-gregorian-from-absolute
(+ (calendar-absolute-from-gregorian
- (list mm dd yy)) inc)))
+ (list mm dd yy))
+ inc)))
(adjmm (nth 0 date)))
;; Set year and month(name) to adjusted values.
(unless (string= year "*")
@@ -2381,7 +2408,15 @@ made in the number or names of categories."
;; If year, month or day date string components were
;; changed, rebuild the date string.
(when (memq what '(year month day))
- (setq ndate (mapconcat 'eval calendar-date-display-form ""))))
+ (setq ndate
+ (calendar-dlet*
+ ;; Needed by calendar-date-display-form.
+ ((year year)
+ (monthname monthname)
+ (month month)
+ (day day)
+ (dayname dayname))
+ (mapconcat #'eval calendar-date-display-form "")))))
(when ndate (replace-match ndate nil nil nil 1))
;; Add new time string to the header, if it was supplied.
(when ntime
@@ -2408,7 +2443,7 @@ made in the number or names of categories."
(when marked (goto-char (point-min)))
(while (not (eobp))
(unless (and marked (not (todo-marked-item-p)))
- (let* ((beg (todo-item-start))
+ (let* ((_beg (todo-item-start))
(lim (save-excursion (todo-item-end)))
(end (save-excursion
(or (todo-time-string-matcher lim)
@@ -2455,7 +2490,7 @@ items."
(while (not (eobp))
(if (todo-done-item-p) ; We've gone too far.
(throw 'stop nil)
- (let* ((beg (todo-item-start))
+ (let* ((_beg (todo-item-start))
(lim (save-excursion (todo-item-end)))
(end (save-excursion
(or (todo-time-string-matcher lim)
@@ -2513,7 +2548,7 @@ numerical prefix argument, or noninteractively by argument ARG,
whose value can be either of the symbols `raise' or `lower',
meaning to raise or lower the item's priority by one."
(interactive)
- (unless (and (called-interactively-p 'any)
+ (unless (and (or (called-interactively-p 'any) (memq arg '(raise lower)))
(or (todo-done-item-p) (looking-at "^$")))
(let* ((item (or item (todo-item-string)))
(marked (todo-marked-item-p))
@@ -2530,7 +2565,7 @@ meaning to raise or lower the item's priority by one."
(re-search-forward regexp1 nil t)
(match-string-no-properties 1)))))))
curnum
- (todo (cond ((or (eq arg 'raise) (eq arg 'lower)
+ (todo (cond ((or (memq arg '(raise lower))
(eq major-mode 'todo-filtered-items-mode))
(save-excursion
(let ((curstart (todo-item-start))
@@ -2667,10 +2702,8 @@ section in the category moved to."
(not marked))
(let* ((buffer-read-only)
(file1 todo-current-todo-file)
- (num todo-category-number)
(item (todo-item-string))
- (diary-item (todo-diary-item-p))
- (done-item (and (todo-done-item-p) (concat item "\n")))
+ (done-item (and (todo-done-item-p) item))
(omark (save-excursion (todo-item-start) (point-marker)))
(todo 0)
(diary 0)
@@ -2700,43 +2733,51 @@ section in the category moved to."
(while (not (eobp))
(when (todo-marked-item-p)
(if (todo-done-item-p)
- (setq done-items (concat done-items
- (todo-item-string) "\n")
- done (1+ done))
- (setq todo-items (concat todo-items
- (todo-item-string) "\n")
- todo (1+ todo))
+ (progn
+ (push (todo-item-string) done-items)
+ (setq done (1+ done)))
+ (push (todo-item-string) todo-items)
+ (setq todo (1+ todo))
(when (todo-diary-item-p)
(setq diary (1+ diary)))))
(todo-forward-item))
- ;; Chop off last newline of multiple todo item string,
- ;; since it will be reinserted when setting priority
- ;; (but with done items priority is not set, so keep
- ;; last newline).
- (and todo-items
- (setq todo-items (substring todo-items 0 -1))))
+ (setq todo-items (nreverse todo-items))
+ (setq done-items (nreverse done-items)))
(if (todo-done-item-p)
- (setq done 1)
- (setq todo 1)
+ (progn
+ (push done-item done-items)
+ (setq done 1))
+ (push item todo-items)
+ (setq todo 1)
(when (todo-diary-item-p) (setq diary 1))))
(set-window-buffer (selected-window)
(set-buffer (find-file-noselect file2 'nowarn)))
(unwind-protect
- (progn
- (when (or todo-items (and item (not done-item)))
- (todo-set-item-priority (or todo-items item) cat2 t))
+ (let (here)
+ (when todo-items
+ (todo-set-item-priority (pop todo-items) cat2 t)
+ (setq here (point))
+ (while todo-items
+ (todo-forward-item)
+ (todo-insert-with-overlays (pop todo-items))))
;; Move done items en bloc to top of done items section.
- (when (or done-items done-item)
+ (when done-items
(todo-category-number cat2)
(widen)
(goto-char (point-min))
(re-search-forward
- (concat "^" (regexp-quote (concat todo-category-beg cat2))
- "$") nil t)
+ (concat "^" (regexp-quote (concat todo-category-beg cat2)) "$")
+ nil t)
(re-search-forward
(concat "^" (regexp-quote todo-category-done)) nil t)
(forward-line)
- (insert (or done-items done-item)))
+ (unless here (setq here (point)))
+ (while done-items
+ (todo-insert-with-overlays (pop done-items))
+ (todo-forward-item)))
+ ;; If only done items were moved, move point to the top
+ ;; one, otherwise, move point to the top moved todo item.
+ (goto-char here)
(setq moved t))
(cond
;; Move succeeded, so remove item from starting category,
@@ -2761,10 +2802,13 @@ section in the category moved to."
(forward-line)
(setq beg (point))
(setq end (if (re-search-forward
- (concat "^" (regexp-quote
- todo-category-beg)) nil t)
- (match-beginning 0)
- (point-max)))
+ (concat "^"
+ (regexp-quote todo-category-beg))
+ nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (point-marker))
+ (point-max-marker)))
(goto-char beg)
(while (< (point) end)
(if (todo-marked-item-p)
@@ -2781,7 +2825,7 @@ section in the category moved to."
(set-window-buffer (selected-window)
(set-buffer (find-file-noselect file2 'nowarn)))
(setq todo-category-number (todo-category-number cat2))
- (let ((todo-show-with-done (or done-items done-item)))
+ (let ((todo-show-with-done (> done 0)))
(todo-category-select))
(goto-char nmark)
;; If item is moved to end of (just first?) category, make
@@ -2830,12 +2874,13 @@ visible."
(goto-char (point-min))
(re-search-forward todo-done-string-start nil t)))
(buffer-read-only nil)
- item done-item
+ header item done-items
(opoint (point)))
;; Don't add empty comment to done item.
(setq comment (unless (zerop (length comment))
(concat " [" todo-comment-string ": " comment "]")))
(and marked (goto-char (point-min)))
+ (setq header (todo-get-overlay 'header))
(catch 'done
;; Stop looping when we hit the empty line below the last
;; todo item (this is eobp if only done items are hidden).
@@ -2843,17 +2888,15 @@ visible."
(if (or (not marked) (and marked (todo-marked-item-p)))
(progn
(setq item (todo-item-string))
- (setq done-item (concat done-item done-prefix item
- comment (and marked "\n")))
+ (push (concat done-prefix item comment) done-items)
(setq item-count (1+ item-count))
(when (todo-diary-item-p)
(setq diary-count (1+ diary-count)))
(todo-remove-item)
(unless marked (throw 'done nil)))
(todo-forward-item))))
+ (setq done-items (nreverse done-items))
(when marked
- ;; Chop off last newline of done item string.
- (setq done-item (substring done-item 0 -1))
(setq todo-categories-with-marks
(assq-delete-all cat todo-categories-with-marks)))
(save-excursion
@@ -2862,7 +2905,17 @@ visible."
(concat "^" (regexp-quote todo-category-done)) nil t)
(forward-char)
(when show-done (setq opoint (point)))
- (insert done-item "\n"))
+ (while done-items
+ (insert (pop done-items) "\n")
+ (when header (let ((copy (copy-overlay header)))
+ (re-search-backward
+ (concat todo-item-start
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "? ")
+ nil t)
+ (move-overlay copy (match-beginning 0) (match-end 0)))
+ (todo-item-end)
+ (forward-char))))
(todo-update-count 'todo (- item-count))
(todo-update-count 'done item-count)
(todo-update-count 'diary (- diary-count))
@@ -2921,7 +2974,8 @@ comments without asking."
;; affirmed, omit subsequent comments without asking.
(when (re-search-forward
(concat " \\[" (regexp-quote todo-comment-string)
- ": [^]]+\\]") end t)
+ ": [^]]+\\]")
+ end t)
(unwind-protect
(if (eq first 'first)
(setq first
@@ -3089,7 +3143,9 @@ this category does not exist in the archive, it is created."
(throw 'end (message "Only done items can be archived"))
(with-current-buffer archive
(unless (derived-mode-p 'todo-archive-mode) (todo-archive-mode))
- (let (buffer-read-only)
+ (let ((headers-hidden todo--item-headers-hidden)
+ buffer-read-only)
+ (if headers-hidden (todo-toggle-item-header))
(widen)
(goto-char (point-min))
(if (and (re-search-forward
@@ -3115,7 +3171,8 @@ this category does not exist in the archive, it is created."
(unless (nth 7 (file-attributes afile))
(write-region nil nil afile t t)
(setq todo-archives (funcall todo-files-function t))
- (todo-archive-mode))))
+ (todo-archive-mode))
+ (if headers-hidden (todo-toggle-item-header))))
(with-current-buffer tbuf
(cond
(all
@@ -3178,7 +3235,8 @@ the only category in the archive, the archive file is deleted."
(let* ((cat (todo-current-category))
(tbuf (find-file-noselect
(concat (file-name-sans-extension todo-current-todo-file)
- ".todo") t))
+ ".todo")
+ t))
(marked (assoc cat todo-categories-with-marks))
(item (concat (todo-item-string) "\n"))
(marked-count 0)
@@ -3194,14 +3252,17 @@ the only category in the archive, the archive file is deleted."
(todo-forward-item))))
;; Restore items to top of category's done section and update counts.
(with-current-buffer tbuf
- (let (buffer-read-only newcat)
+ (let ((headers-hidden todo--item-headers-hidden)
+ buffer-read-only newcat)
+ (if headers-hidden (todo-toggle-item-header))
(widen)
(goto-char (point-min))
;; Find the corresponding todo category, or if there isn't
;; one, add it.
(unless (re-search-forward
(concat "^" (regexp-quote (concat todo-category-beg cat))
- "$") nil t)
+ "$")
+ nil t)
(todo-add-category nil cat)
(setq newcat t))
;; Go to top of category's done section.
@@ -3218,6 +3279,7 @@ the only category in the archive, the archive file is deleted."
(todo-update-count 'done 1 cat)
(unless newcat ; Newly added category has no archive.
(todo-update-count 'archived -1 cat))))
+ (if headers-hidden (todo-toggle-item-header))
(todo-update-categories-sexp)))
;; Delete restored items from archive.
(when marked
@@ -3263,6 +3325,10 @@ the only category in the archive, the archive file is deleted."
(set-buffer (find-file-noselect tfile)))
(todo-category-number cat)
(todo-category-select)
+ ;; Selecting the category leaves point at the end of the done
+ ;; items separator string, so move it to the (first) restored
+ ;; done item.
+ (forward-line)
(message "Items unarchived.")))))
(defun todo-jump-to-archive-category (&optional file)
@@ -3404,9 +3470,9 @@ decreasing or increasing its number."
(unless prompt (setq priority candidate)))
(let* ((lower (< curnum priority)) ; Priority is being lowered.
(head (butlast todo-categories
- (apply (if lower 'identity '1+)
- (list (- maxnum priority)))))
- (tail (nthcdr (apply (if lower 'identity '1-) (list priority))
+ (funcall (if lower #'identity #'1+)
+ (- maxnum priority))))
+ (tail (nthcdr (funcall (if lower #'identity #'1-) priority)
todo-categories))
;; Category's name and items counts list.
(catcons (nth (1- curnum) todo-categories))
@@ -3492,7 +3558,7 @@ decreasing or increasing its number."
"Return adjusted length of category label button.
The adjustment ensures proper tabular alignment in Todo
Categories mode."
- (let* ((categories (mapcar 'car todo-categories))
+ (let* ((categories (mapcar #'car todo-categories))
(longest (todo-longest-category-name-length categories))
(catlablen (length todo-categories-category-label))
(lc-diff (- longest catlablen)))
@@ -3578,24 +3644,24 @@ LABEL determines which type of count is sorted."
ov)
(insert-button str 'face nil
'action
- `(lambda (button)
- (let ((key (todo-label-to-key ,label)))
- (if (and (member key todo-descending-counts)
- (eq key 'alpha))
- (progn
- ;; If display is alphabetical, switch back to
- ;; category priority order.
- (todo-display-sorted nil)
- (setq todo-descending-counts
- (delete key todo-descending-counts)))
- (todo-display-sorted key)))))
+ (lambda (_button)
+ (let ((key (todo-label-to-key label)))
+ (if (and (member key todo-descending-counts)
+ (eq key 'alpha))
+ (progn
+ ;; If display is alphabetical, switch back to
+ ;; category priority order.
+ (todo-display-sorted nil)
+ (setq todo-descending-counts
+ (delete key todo-descending-counts)))
+ (todo-display-sorted key)))))
(setq ov (make-overlay beg end))
(overlay-put ov 'face 'todo-button)))
(defun todo-total-item-counts ()
"Return a list of total item counts for the current file."
- (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i))
- (mapcar 'cdr todo-categories))))
+ (mapcar (lambda (i) (apply #'+ (mapcar (lambda (x) (aref (cdr x) i))
+ todo-categories)))
(list 0 1 2 3)))
(defvar todo-categories-category-number 0
@@ -3640,9 +3706,10 @@ which is the value of the user option
(not (zerop (todo-get-count 'archived cat))))
'todo-archived-only
nil)
- 'action `(lambda (button) (let ((buf (current-buffer)))
- (todo-jump-to-category nil ,cat)
- (kill-buffer buf))))
+ 'action (lambda (_button)
+ (let ((buf (current-buffer)))
+ (todo-jump-to-category nil cat)
+ (kill-buffer buf))))
;; Highlight the sorted count column.
(let* ((beg (+ opoint 7 (length str)))
end ovl)
@@ -3721,8 +3788,8 @@ which is the value of the user option
(delete-region (point) (point-max))
;; Fill in the table with buttonized lines, each showing a category and
;; its item counts.
- (mapc (lambda (cat) (todo-insert-category-line cat sortkey))
- (mapcar 'car cats))
+ (dolist (cat cats)
+ (todo-insert-category-line (car cat) sortkey))
(newline)
;; Add a line showing item count totals.
(insert (make-string (+ 4 (length todo-categories-number-separator)) 32)
@@ -3778,7 +3845,8 @@ face."
(when (looking-at todo-done-string-start)
(setq in-done t))
(re-search-backward (concat "^" (regexp-quote todo-category-beg)
- "\\(.*\\)\n") nil t)
+ "\\(.*\\)\n")
+ nil t)
(setq cat (match-string-no-properties 1))
(todo-category-number cat)
(todo-category-select)
@@ -3840,9 +3908,7 @@ This variable should be set interactively by
(defcustom todo-filter-files nil
"List of default files for multifile item filtering."
- :type `(set ,@(mapcar (lambda (f) (list 'const f))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function))))
+ :type `(set ,@(todo--files-type-list))
:group 'todo-filtered)
(defcustom todo-filter-done-items nil
@@ -4022,19 +4088,17 @@ regexp items."
(widget-insert "Select files for generating the top priorities list.\n\n")
(setq todo-multiple-filter-files-widget
(widget-create
- `(set ,@(mapcar (lambda (x) (list 'const x))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function))))))
+ `(set ,@(todo--files-type-list))))
(widget-insert "\n")
(widget-create 'push-button
- :notify (lambda (widget &rest ignore)
+ :notify (lambda (&rest _)
(setq todo-multiple-filter-files 'quit)
(quit-window t)
(exit-recursive-edit))
"Cancel")
(widget-insert " ")
(widget-create 'push-button
- :notify (lambda (&rest ignore)
+ :notify (lambda (&rest _)
(setq todo-multiple-filter-files
(mapcar (lambda (f)
(file-truename
@@ -4092,7 +4156,7 @@ multifile commands for further details."
;; Pressed `cancel' in t-m-f-f file selection dialog.
(keyboard-quit)
(concat todo-directory
- (mapconcat 'todo-short-file-name flist "-")
+ (mapconcat #'todo-short-file-name flist "-")
(cond (top ".todt")
(diary ".tody")
(regexp ".todr")))))
@@ -4105,10 +4169,11 @@ multifile commands for further details."
(todo-filter-items-1 (cons 'top new) flist))
((and (not new) file-exists)
(when (and rxfiles (> (length rxfiles) 1))
- (let ((rxf (mapcar 'todo-short-file-name rxfiles)))
+ (let ((rxf (mapcar #'todo-short-file-name rxfiles)))
(setq fname (todo-absolute-file-name
(completing-read "Choose a regexp items file: "
- rxf) 'regexp))))
+ rxf)
+ 'regexp))))
(find-file fname)
(unless (derived-mode-p 'todo-filtered-items-mode)
(todo-filtered-items-mode))
@@ -4119,12 +4184,13 @@ multifile commands for further details."
(dolist (s (split-string (todo-short-file-name fname) "-"))
(setq bufname (if bufname
(concat bufname (if (member s (mapcar
- 'todo-short-file-name
+ #'todo-short-file-name
todo-files))
- ", " "-") s)
+ ", " "-")
+ s)
s)))
- (rename-buffer (format (concat "%s for file" (if multi "s" "")
- " \"%s\"") buf bufname))))
+ (rename-buffer (format (concat "%s for file" (if multi "s" "") " \"%s\"")
+ buf bufname))))
(defun todo-filter-items-1 (filter file-list)
"Build a list of items by applying FILTER to FILE-LIST.
@@ -4190,7 +4256,8 @@ the values of FILTER and FILE-LIST."
todo-top-priorities)))
(while (re-search-forward
(concat "^" (regexp-quote todo-category-beg)
- "\\(.+\\)\n") nil t)
+ "\\(.+\\)\n")
+ nil t)
(setq cat (match-string 1))
(let (cnum)
;; Unless the number of top priorities to show was
@@ -4344,7 +4411,8 @@ its priority has changed, and `same' otherwise."
"\\]"
(regexp-quote todo-nondiary-end)) "?"
"\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?"
- "\\(?1:.*\\)\\]\\).*$") str)
+ "\\(?1:.*\\)\\]\\).*$")
+ str)
(let ((cat (match-string 1 str))
(file (match-string 2 str))
(archive (string= (match-string 3 str) "(archive) "))
@@ -4459,8 +4527,11 @@ If the file already exists, overwrite it only on confirmation."
;;; Printing Todo mode buffers
;; -----------------------------------------------------------------------------
-(defcustom todo-print-buffer-function 'ps-print-buffer-with-faces
- "Function called by the command `todo-print-buffer'."
+(defcustom todo-print-buffer-function #'ps-print-buffer-with-faces
+ "Function called by `todo-print-buffer' to print Todo mode buffers.
+Called with one argument which can either be:
+- a string, naming a file to save the print image to.
+- nil, to send the image to the printer."
:type 'symbol
:group 'todo)
@@ -4486,8 +4557,7 @@ otherwise, send it to the default printer."
'face 'todo-prefix-string))
(num 0)
(fill-prefix (make-string todo-indent-to-here 32))
- (content (buffer-string))
- file)
+ (content (buffer-string)))
(with-current-buffer (get-buffer-create buf)
(insert content)
(goto-char (point-min))
@@ -4511,10 +4581,9 @@ otherwise, send it to the default printer."
(goto-char (point-min))
(insert header)
(newline 2)
- (if to-file
- (let ((file (read-file-name "Print to file: ")))
- (funcall todo-print-buffer-function file))
- (funcall todo-print-buffer-function)))
+ (funcall todo-print-buffer-function
+ (if to-file nil
+ (read-file-name "Print to file: "))))
(kill-buffer buf)))
(defun todo-print-buffer-to-file ()
@@ -4544,14 +4613,15 @@ strings built using the default value of
(defun todo-convert-legacy-date-time ()
"Return converted date-time string.
Helper function for `todo-convert-legacy-files'."
- (let* ((year (match-string 1))
- (month (match-string 2))
- (monthname (calendar-month-name (string-to-number month) t))
- (day (match-string 3))
- (time (match-string 4))
- dayname)
+ (calendar-dlet*
+ ((year (match-string 1))
+ (month (match-string 2))
+ (monthname (calendar-month-name (string-to-number month) t))
+ (day (match-string 3))
+ (time (match-string 4))
+ dayname)
(replace-match "")
- (insert (mapconcat 'eval calendar-date-display-form "")
+ (insert (mapconcat #'eval calendar-date-display-form "")
(when time (concat " " time)))))
(defun todo-convert-legacy-files ()
@@ -4675,7 +4745,8 @@ name in `todo-directory'. See also the documentation string of
(unless (save-excursion
(re-search-backward
(concat "^" (regexp-quote todo-category-beg)
- "\\(.*\\)$") nil t)
+ "\\(.*\\)$")
+ nil t)
(string= (match-string 1) cat))
;; Else move it to its category.
(setq item (buffer-substring-no-properties beg end))
@@ -4689,7 +4760,8 @@ name in `todo-directory'. See also the documentation string of
(forward-line)
(if (re-search-forward
(concat "^" (regexp-quote todo-category-beg)
- "\\(.*\\)$") nil t)
+ "\\(.*\\)$")
+ nil t)
(progn (goto-char (match-beginning 0))
(newline)
(forward-line -1))
@@ -4730,7 +4802,7 @@ name in `todo-directory'. See also the documentation string of
(prin1 sexp (current-buffer)))
(write-region (point-min) (point-max) file nil 'nomessage))
(setq todo-archives (funcall todo-files-function t)))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(when (y-or-n-p (concat "Format conversion done; do you want to "
"visit the converted file now? "))
(setq todo-current-todo-file file)
@@ -4783,10 +4855,7 @@ buffer, clean up the state and return nil."
(setq todo-files (funcall todo-files-function))
(setq todo-archives (funcall todo-files-function t))
t)
- (let* ((files (append todo-files todo-archives))
- (tctf todo-current-todo-file)
- (tgctf todo-global-current-todo-file)
- (tdtf (todo-absolute-file-name todo-default-todo-file)))
+ (let* ((files (append todo-files todo-archives)))
(unless (or (not todo-current-todo-file)
(member todo-current-todo-file files))
(setq todo-current-todo-file nil))
@@ -4797,7 +4866,7 @@ buffer, clean up the state and return nil."
(member todo-default-todo-file files))
(setq todo-default-todo-file (todo-short-file-name
(car todo-files))))
- (todo-reevaluate-filelist-defcustoms)
+ (todo-update-filelist-defcustoms)
(when buf (kill-buffer buf))
nil)))))
@@ -4805,7 +4874,7 @@ buffer, clean up the state and return nil."
"Return the number of category CAT in this todo file.
The buffer-local variable `todo-category-number' holds this
number as its value."
- (let ((categories (mapcar 'car todo-categories)))
+ (let ((categories (mapcar #'car todo-categories)))
(setq todo-category-number
;; Increment by one, so that the number of the first
;; category is one rather than zero.
@@ -4835,7 +4904,8 @@ number as its value."
(todo-prefix-overlays)
(goto-char (point-min))
(if (re-search-forward (concat "\n\\(" (regexp-quote todo-category-done)
- "\\)") nil t)
+ "\\)")
+ nil t)
(progn
(setq done-start (match-beginning 0))
(setq done-sep-start (match-beginning 1))
@@ -5141,12 +5211,22 @@ If the category's done items are visible, this command called
with a prefix argument only moves point to a higher item, e.g.,
with point on the first done item and called with prefix 1, it
moves to the last todo item; but if called with point on the
-first done item without a prefix argument, it moves point the the
+first done item without a prefix argument, it moves point to the
empty line above the done items separator."
(let* ((done (todo-done-item-p)))
(todo-item-start)
(unless (bobp)
- (re-search-backward todo-item-start nil t (or count 1)))
+ (re-search-backward (concat todo-item-start
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "? ")
+ nil t (or count 1))
+ ;; If the item date-time header is hidden, the display engine
+ ;; moves point to the next earlier displayable position, which
+ ;; is the end of the next item above, so we move it to the start
+ ;; of the current item's text (that's what the display engine
+ ;; does with todo-forward-item in this case.)
+ ;; FIXME: would it be better to use cursor-sensor-functions?
+ (when todo--item-headers-hidden (goto-char (match-end 0))))
;; Unless this is a regexp filtered items buffer (which can contain
;; intermixed todo and done items), if points advances by one from a
;; done to a todo item, go back to the space above
@@ -5162,10 +5242,12 @@ empty line above the done items separator."
(defun todo-remove-item ()
"Internal function called in editing, deleting or moving items."
- (let* ((end (progn (todo-item-end) (1+ (point))))
- (beg (todo-item-start))
- (ov (todo-get-overlay 'prefix)))
- (when ov (delete-overlay ov))
+ (let ((end (progn (todo-item-end) (1+ (point))))
+ (beg (todo-item-start))
+ ovs)
+ (push (todo-get-overlay 'prefix) ovs)
+ (push (todo-get-overlay 'header) ovs)
+ (dolist (ov ovs) (when ov (delete-overlay ov)))
(delete-region beg end)))
(defun todo-diary-item-p ()
@@ -5207,7 +5289,8 @@ Overrides `diary-goto-entry'."
(when (eq major-mode 'todo-mode)
(let ((opoint (point)))
(re-search-backward (concat "^" (regexp-quote todo-category-beg)
- "\\(.*\\)\n") nil t)
+ "\\(.*\\)\n")
+ nil t)
(todo-category-number (match-string 1))
(todo-category-select)
(goto-char opoint))))))
@@ -5221,7 +5304,10 @@ Also preserve category display, if applicable."
(let ((revert-buffer-function nil))
(revert-buffer ignore-auto noconfirm 'preserve-modes)
(when (memq major-mode '(todo-mode todo-archive-mode))
- (todo-category-select))))
+ (save-excursion (todo-category-select))
+ ;; revert-buffer--default calls after-find-file, which makes
+ ;; buffer writable.
+ (setq buffer-read-only t))))
(defun todo-desktop-save-buffer (_dir)
`((catnum . ,(todo-category-number (todo-current-category)))))
@@ -5296,15 +5382,21 @@ marked) not done todo items."
(defun todo-get-overlay (val)
"Return the overlay at point whose `todo' property has value VAL."
- ;; Use overlays-in to find prefix overlays and check over two
- ;; positions to find done separator overlay.
- (let ((ovs (overlays-in (point) (1+ (point))))
- ov)
- (catch 'done
- (while ovs
- (setq ov (pop ovs))
- (when (eq (overlay-get ov 'todo) val)
- (throw 'done ov))))))
+ (save-excursion
+ ;; When headers are hidden, the display engine makes item's start
+ ;; inaccessible to commands, so then we have to go there
+ ;; non-interactively to check for prefix and header overlays.
+ (when (memq val '(prefix header))
+ (unless (looking-at todo-item-start) (todo-item-start)))
+ ;; Use overlays-in to find prefix overlays and check over two
+ ;; positions to find done separator overlay.
+ (let ((ovs (overlays-in (point) (1+ (point))))
+ ov)
+ (catch 'done
+ (while ovs
+ (setq ov (pop ovs))
+ (when (eq (overlay-get ov 'todo) val)
+ (throw 'done ov)))))))
(defun todo-marked-item-p ()
"Non-nil if this item begins with `todo-item-mark'.
@@ -5320,16 +5412,26 @@ In that case, return the item's prefix overlay."
(when marked ov)))
(defun todo-insert-with-overlays (item)
- "Insert ITEM at point and update prefix/priority number overlays."
+ "Insert ITEM at point and update prefix and header overlays."
(todo-item-start)
- ;; Insertion pushes item down but not its prefix overlay. When the
- ;; overlay includes a mark, this would now mark the inserted ITEM,
- ;; so move it to the pushed down item.
(let ((ov (todo-get-overlay 'prefix))
(marked (todo-marked-item-p)))
(insert item "\n")
- (when marked (move-overlay ov (point) (point))))
- (todo-backward-item)
+ ;; Insertion pushes item down but not its prefix overlay. When
+ ;; the overlay includes a mark, this would now mark the inserted
+ ;; ITEM, so move it to the pushed down item.
+ (when marked (move-overlay ov (point) (point)))
+ (todo-backward-item)
+ ;; With hidden headers, todo-backward-item puts point on first
+ ;; visible character after header, so we have to search backward.
+ (when todo--item-headers-hidden
+ (re-search-backward (concat todo-item-start
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "? ")
+ nil t)
+ (setq ov (make-overlay (match-beginning 0) (match-end 0) nil t))
+ (overlay-put ov 'todo 'header)
+ (overlay-put ov 'display "")))
(todo-prefix-overlays))
(defun todo-prefix-overlays ()
@@ -5572,8 +5674,7 @@ already entered and those still available."
(defvar todo-edit-item--prompt "Press a key (so far `e'): ")
(defun todo-edit-item--next-key (params &optional arg)
- (let* ((map (make-sparse-keymap))
- (p->k (mapconcat (lambda (elt)
+ (let* ((p->k (mapconcat (lambda (elt)
(format "%s=>%s"
(propertize (cdr elt) 'face
'todo-key-prompt)
@@ -5652,7 +5753,8 @@ have been removed."
" been deleted and removed from\n"
"the list of category completion files")
names))
- (todo-reevaluate-category-completions-files-defcustom)
+ (put 'todo-category-completions-files 'custom-type
+ `(set ,@(todo--files-type-list)))
(custom-set-default 'todo-category-completions-files
(symbol-value 'todo-category-completions-files))
(sleep-for 1.5)))
@@ -5661,14 +5763,14 @@ have been removed."
todo-global-current-todo-file)
(todo-absolute-file-name todo-default-todo-file)))
(files (or (unless archive
- (mapcar 'todo-absolute-file-name
+ (mapcar #'todo-absolute-file-name
todo-category-completions-files))
(list curfile)))
listall listf)
;; If file was just added, it has no category completions.
(unless (zerop (buffer-size (find-buffer-visiting curfile)))
(unless (member curfile todo-archives)
- (add-to-list 'files curfile))
+ (cl-pushnew curfile files :test #'equal))
(dolist (f files listall)
(with-current-buffer (find-file-noselect f 'nowarn)
(if archive
@@ -5708,7 +5810,7 @@ return the absolute truename of a todo archive file. With non-nil
MUSTMATCH the name of an existing file must be chosen;
otherwise, a new file name is allowed."
(let* ((completion-ignore-case todo-completion-ignore-case)
- (files (mapcar 'todo-short-file-name
+ (files (mapcar #'todo-short-file-name
;; (funcall todo-files-function archive)))
(if archive todo-archives todo-files)))
(file (completing-read prompt files nil mustmatch nil nil
@@ -5757,7 +5859,8 @@ categories from `todo-category-completions-files'."
(todo-read-file-name (concat "Choose a" (if archive
"n archive"
" todo")
- " file: ") archive t)))
+ " file: ")
+ archive t)))
(completions (unless file0 (todo-category-completions archive)))
(categories (cond (file0
(with-current-buffer
@@ -5798,7 +5901,7 @@ categories from `todo-category-completions-files'."
(if (atom catfil)
catfil
(todo-absolute-file-name
- (let ((files (mapcar 'todo-short-file-name catfil)))
+ (let ((files (mapcar #'todo-short-file-name catfil)))
(completing-read (format str cat) files)))))))
;; Default to the current file.
(unless file0 (setq file0 todo-current-todo-file))
@@ -5832,7 +5935,7 @@ categories from `todo-category-completions-files'."
"Prompt for new NAME for TYPE until it is valid, then return it.
TYPE can be either of the symbols `file' or `category'."
(let ((categories todo-categories)
- (files (mapcar 'todo-short-file-name todo-files))
+ (files (mapcar #'todo-short-file-name todo-files))
prompt)
(while
(and
@@ -5888,8 +5991,8 @@ indicating an unspecified month, day, or year.
When ARG is `day', non-nil arguments MO and YR determine the
number of the last the day of the month."
- (let (year monthname month day
- dayname) ; Needed by calendar-date-display-form.
+ (calendar-dlet*
+ (year monthname month day dayname) ;Needed by calendar-date-display-form.
(when (or (not arg) (eq arg 'year))
(while (if (natnump year) (< year 1) (not (eq year '*)))
(setq year (read-from-minibuffer
@@ -5906,8 +6009,8 @@ number of the last the day of the month."
(setq monthname (completing-read
"Month name (RET for current month, * for any month): "
mlist nil t nil nil
- (calendar-month-name (calendar-extract-month
- (calendar-current-date)) t))
+ (calendar-month-name
+ (calendar-extract-month (calendar-current-date)) t))
month (1+ (- (length mlist)
(length (or (member monthname mlist)
(member monthname mablist))))))
@@ -5948,7 +6051,7 @@ number of the last the day of the month."
(if (memq 'month calendar-date-display-form)
month
monthname)))
- (mapconcat 'eval calendar-date-display-form ""))))
+ (mapconcat #'eval calendar-date-display-form ""))))
(defun todo-read-dayname ()
"Choose name of a day of the week with completion and return it."
@@ -6013,8 +6116,8 @@ the empty string (i.e., no time string)."
"The :set function for user option `todo-show-current-file'."
(custom-set-default symbol value)
(if value
- (add-hook 'pre-command-hook 'todo-show-current-file nil t)
- (remove-hook 'pre-command-hook 'todo-show-current-file t)))
+ (add-hook 'pre-command-hook #'todo-show-current-file nil t)
+ (remove-hook 'pre-command-hook #'todo-show-current-file t)))
(defun todo-reset-prefix (symbol value)
"The :set function for `todo-prefix' and `todo-number-prefix'."
@@ -6151,57 +6254,12 @@ the empty string (i.e., no time string)."
(hl-line-mode 1)
(hl-line-mode -1)))))))))
-(defun todo-reevaluate-filelist-defcustoms ()
- "Reevaluate defcustoms that provide choice list of todo files."
- (custom-set-default 'todo-default-todo-file
- (symbol-value 'todo-default-todo-file))
- (todo-reevaluate-default-file-defcustom)
- (custom-set-default 'todo-filter-files (symbol-value 'todo-filter-files))
- (todo-reevaluate-filter-files-defcustom)
- (custom-set-default 'todo-category-completions-files
- (symbol-value 'todo-category-completions-files))
- (todo-reevaluate-category-completions-files-defcustom))
-
-(defun todo-reevaluate-default-file-defcustom ()
- "Reevaluate defcustom of `todo-default-todo-file'.
-Called after adding or deleting a todo file. If the value of
-`todo-default-todo-file' before calling this function was
-associated with an existing file, keep that value."
- ;; (let ((curval todo-default-todo-file))
- (eval
- (defcustom todo-default-todo-file (todo-short-file-name
- (car (funcall todo-files-function)))
- "Todo file visited by first session invocation of `todo-show'."
- :type (when todo-files
- `(radio ,@(mapcar (lambda (f) (list 'const f))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function)))))
- :group 'todo))
- ;; (when (and curval (file-exists-p (todo-absolute-file-name curval)))
- ;; (custom-set-default 'todo-default-todo-file curval)
- ;; ;; (custom-reevaluate-setting 'todo-default-todo-file)
- ;; )))
- )
-
-(defun todo-reevaluate-category-completions-files-defcustom ()
- "Reevaluate defcustom of `todo-category-completions-files'.
-Called after adding or deleting a todo file."
- (eval (defcustom todo-category-completions-files nil
- "List of files for building `todo-read-category' completions."
- :type `(set ,@(mapcar (lambda (f) (list 'const f))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function))))
- :group 'todo)))
-
-(defun todo-reevaluate-filter-files-defcustom ()
- "Reevaluate defcustom of `todo-filter-files'.
-Called after adding or deleting a todo file."
- (eval (defcustom todo-filter-files nil
- "List of files for multifile item filtering."
- :type `(set ,@(mapcar (lambda (f) (list 'const f))
- (mapcar 'todo-short-file-name
- (funcall todo-files-function))))
- :group 'todo)))
+(defun todo-update-filelist-defcustoms ()
+ "Update defcustoms that provide choice list of todo files."
+ (put 'todo-default-todo-file 'custom-type `(radio ,@(todo--files-type-list)))
+ (put 'todo-category-completions-files 'custom-type
+ `(set ,@(todo--files-type-list)))
+ (put 'todo-filter-files 'custom-type `(set ,@(todo--files-type-list))))
;; -----------------------------------------------------------------------------
;;; Font locking
@@ -6217,7 +6275,8 @@ Called after adding or deleting a todo file."
(defun todo-diary-nonmarking-matcher (lim)
"Search for diary nonmarking symbol within LIM for font-locking."
(re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol)
- "\\)" todo-date-pattern) lim t))
+ "\\)" todo-date-pattern)
+ lim t))
(defun todo-date-string-matcher (lim)
"Search for todo item date string within LIM for font-locking."
@@ -6227,14 +6286,16 @@ Called after adding or deleting a todo file."
(defun todo-time-string-matcher (lim)
"Search for todo item time string within LIM for font-locking."
(re-search-forward (concat todo-date-string-start todo-date-pattern
- " \\(?1:" diary-time-regexp "\\)") lim t))
+ " \\(?1:" diary-time-regexp "\\)")
+ lim t))
(defun todo-diary-expired-matcher (lim)
"Search for expired diary item date within LIM for font-locking."
(when (re-search-forward (concat "^\\(?:"
(regexp-quote diary-nonmarking-symbol)
"\\)?\\(?1:" todo-date-pattern "\\) \\(?2:"
- diary-time-regexp "\\)?") lim t)
+ diary-time-regexp "\\)?")
+ lim t)
(let* ((date (match-string-no-properties 1))
(time (match-string-no-properties 2))
;; Function days-between requires a non-empty time string.
@@ -6389,8 +6450,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-mode-map
(let ((map (make-keymap)))
- ;; Don't suppress digit keys, so they can supply prefix arguments.
- (suppress-keymap map)
(dolist (kb todo-key-bindings-t)
(define-key map (nth 0 kb) (nth 1 kb)))
(dolist (kb todo-key-bindings-t+a+f)
@@ -6404,7 +6463,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-archive-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
(dolist (kb todo-key-bindings-t+a+f)
(define-key map (nth 0 kb) (nth 1 kb)))
(dolist (kb todo-key-bindings-t+a)
@@ -6423,7 +6481,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-categories-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
(define-key map "c" 'todo-sort-categories-alphabetically-or-numerically)
(define-key map "t" 'todo-sort-categories-by-todo)
(define-key map "y" 'todo-sort-categories-by-diary)
@@ -6442,7 +6499,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-filtered-items-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
(dolist (kb todo-key-bindings-t+a+f)
(define-key map (nth 0 kb) (nth 1 kb)))
(dolist (kb todo-key-bindings-t+f)
@@ -6576,9 +6632,9 @@ Added to `window-configuration-change-hook' in Todo mode."
(defun todo-modes-set-1 ()
"Make some settings that apply to multiple Todo modes."
(setq-local font-lock-defaults '(todo-font-lock-keywords t))
- (setq-local revert-buffer-function 'todo-revert-buffer)
+ (setq-local revert-buffer-function #'todo-revert-buffer)
(setq-local tab-width todo-indent-to-here)
- (setq-local indent-line-function 'todo-indent)
+ (setq-local indent-line-function #'todo-indent)
(when todo-wrap-lines
(visual-line-mode)
(setq wrap-prefix (make-string todo-indent-to-here 32))))
@@ -6594,14 +6650,15 @@ Added to `window-configuration-change-hook' in Todo mode."
"Make some settings that apply to multiple Todo modes."
(add-to-invisibility-spec 'todo)
(setq buffer-read-only t)
+ (setq-local todo--item-headers-hidden nil)
(setq-local desktop-save-buffer 'todo-desktop-save-buffer)
- (setq-local hl-line-range-function 'todo-hl-line-range))
+ (setq-local hl-line-range-function #'todo-hl-line-range))
(defun todo-modes-set-3 ()
"Make some settings that apply to multiple Todo modes."
(setq-local todo-categories (todo-set-categories))
(setq-local todo-category-number 1)
- ;; (add-hook 'find-file-hook 'todo-display-as-todo-file nil t)
+ ;; (add-hook 'find-file-hook #'todo-display-as-todo-file nil t)
)
(put 'todo-mode 'mode-class 'special)
@@ -6624,13 +6681,13 @@ Added to `window-configuration-change-hook' in Todo mode."
(setq-local todo-current-todo-file (file-truename (buffer-file-name))))
(setq-local todo-show-done-only nil)
(setq-local todo-categories-with-marks nil)
- ;; (add-hook 'find-file-hook 'todo-add-to-buffer-list nil t)
- (add-hook 'post-command-hook 'todo-update-buffer-list nil t)
+ ;; (add-hook 'find-file-hook #'todo-add-to-buffer-list nil t)
+ (add-hook 'post-command-hook #'todo-update-buffer-list nil t)
(when todo-show-current-file
- (add-hook 'pre-command-hook 'todo-show-current-file nil t))
+ (add-hook 'pre-command-hook #'todo-show-current-file nil t))
(add-hook 'window-configuration-change-hook
- 'todo-reset-and-enable-done-separator nil t)
- (add-hook 'kill-buffer-hook 'todo-reset-global-current-todo-file nil t)))
+ #'todo-reset-and-enable-done-separator nil t)
+ (add-hook 'kill-buffer-hook #'todo-reset-global-current-todo-file nil t)))
(put 'todo-archive-mode 'mode-class 'special)
diff --git a/lisp/case-table.el b/lisp/case-table.el
index 271bb0a4786..174e3f0afc0 100644
--- a/lisp/case-table.el
+++ b/lisp/case-table.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cdl.el b/lisp/cdl.el
index 16ba7e7d527..80ef76ace14 100644
--- a/lisp/cdl.el
+++ b/lisp/cdl.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1
index c0223cbc78a..35cdf80e4b3 100644
--- a/lisp/cedet/ChangeLog.1
+++ b/lisp/cedet/ChangeLog.1
@@ -457,7 +457,7 @@
complete local variables.
* semantic/scope.el (semantic-analyze-scoped-types-default): If we
- cannot find a type in the typecache, also look into the the types
+ cannot find a type in the typecache, also look into the types
we already found. This is necessary since in C++, a 'using
namespace' can be dependend on a previous one.
(semantic-completable-tags-from-type): When creating the list of
@@ -3475,4 +3475,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el
index 913f960b2a6..faee7feeb25 100644
--- a/lisp/cedet/cedet-cscope.el
+++ b/lisp/cedet/cedet-cscope.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el
index 0798e7c0c5b..e18e66a12dd 100644
--- a/lisp/cedet/cedet-files.el
+++ b/lisp/cedet/cedet-files.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el
index ee2265bec6d..871fd94aebd 100644
--- a/lisp/cedet/cedet-global.el
+++ b/lisp/cedet/cedet-global.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el
index dbcce2d99b3..48e1b2d09b1 100644
--- a/lisp/cedet/cedet-idutils.el
+++ b/lisp/cedet/cedet-idutils.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -98,7 +98,7 @@ Return the created buffer with program output."
(defun cedet-idutils-lid-call (flags)
"Call ID Utils lid with the list of FLAGS.
-Return the created buffer with with program output."
+Return the created buffer with program output."
(let ((b (get-buffer-create "*CEDET lid*"))
(cd default-directory)
)
diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index a0b06f2820d..bedbd98df3e 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index b12e2a378f7..5325bf52b57 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 87d73b2e42b..1dcafc453f4 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -998,7 +998,7 @@ Argument PROMPT is the prompt to use when querying the user for a target."
(project-add-file this file))
(cl-defmethod project-add-file ((ot ede-target) _file)
- "Add the current buffer into project project target OT.
+ "Add the current buffer into project target OT.
Argument FILE is the file to add."
(error "add-file not supported by %s" (eieio-object-name ot)))
diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el
index 6c0e5885cf5..75f2d6bd7a9 100644
--- a/lisp/cedet/ede/auto.el
+++ b/lisp/cedet/ede/auto.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el
index c9783cae8b6..e7481aad267 100644
--- a/lisp/cedet/ede/autoconf-edit.el
+++ b/lisp/cedet/ede/autoconf-edit.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el
index 13d721a5f9a..bfb5834d622 100644
--- a/lisp/cedet/ede/base.el
+++ b/lisp/cedet/ede/base.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el
index a517ed18e02..64170fa1d0c 100644
--- a/lisp/cedet/ede/config.el
+++ b/lisp/cedet/ede/config.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el
index 319854e07c4..9643578fa3c 100644
--- a/lisp/cedet/ede/cpp-root.el
+++ b/lisp/cedet/ede/cpp-root.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el
index 1c4e849d2df..55d4b4a5a9d 100644
--- a/lisp/cedet/ede/custom.el
+++ b/lisp/cedet/ede/custom.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el
index 54d48a20500..25426dfeba6 100644
--- a/lisp/cedet/ede/detect.el
+++ b/lisp/cedet/ede/detect.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -195,11 +195,10 @@ Return a cons cell:
"Run a quick test for autodetecting on BUFFER."
(interactive)
(let ((start (current-time))
- (ans (ede-detect-directory-for-project default-directory))
- (end (current-time)))
+ (ans (ede-detect-directory-for-project default-directory)))
(if ans
(message "Project found in %d sec @ %s of type %s"
- (float-time (time-subtract end start))
+ (float-time (time-subtract nil start))
(car ans)
(eieio-object-name-string (cdr ans)))
(message "No Project found.") )))
diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el
index 2555fab3a37..361881855f8 100644
--- a/lisp/cedet/ede/dired.el
+++ b/lisp/cedet/ede/dired.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el
index cac66fa7348..f3ba4c3e1ef 100644
--- a/lisp/cedet/ede/emacs.el
+++ b/lisp/cedet/ede/emacs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el
index 889cac8d954..4ba4ab19178 100644
--- a/lisp/cedet/ede/files.el
+++ b/lisp/cedet/ede/files.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el
index f7f98e618f3..cf91c33f1f7 100644
--- a/lisp/cedet/ede/generic.el
+++ b/lisp/cedet/ede/generic.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el
index 22f5c3ed218..3a183b317ef 100644
--- a/lisp/cedet/ede/linux.el
+++ b/lisp/cedet/ede/linux.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index 845a491b882..f61ce34ba92 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el
index 13591f6dc57..8fcaf52a96f 100644
--- a/lisp/cedet/ede/make.el
+++ b/lisp/cedet/ede/make.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index 90d48fc7639..e82577f4d35 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el
index f8d9e0b746f..8dc7f689ee8 100644
--- a/lisp/cedet/ede/pconf.el
+++ b/lisp/cedet/ede/pconf.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el
index 6feb9600e03..b836eafa8ce 100644
--- a/lisp/cedet/ede/pmake.el
+++ b/lisp/cedet/ede/pmake.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -277,7 +277,7 @@ Execute BODY in a location where a value can be placed."
;;; SOURCE VARIABLE NAME CONSTRUCTION
(defsubst ede-pmake-varname (obj)
- "Convert OBJ into a variable name name.
+ "Convert OBJ into a variable name.
Change . to _ in the variable name."
(let ((name (oref obj name)))
(while (string-match "\\." name)
diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el
index 460df69f415..a9f3c708c0c 100644
--- a/lisp/cedet/ede/proj-archive.el
+++ b/lisp/cedet/ede/proj-archive.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el
index 3b60eea7c2e..8c5dfa7cf77 100644
--- a/lisp/cedet/ede/proj-aux.el
+++ b/lisp/cedet/ede/proj-aux.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el
index 80950ca7042..0537946bed4 100644
--- a/lisp/cedet/ede/proj-comp.el
+++ b/lisp/cedet/ede/proj-comp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index 9f4e69f01f9..d48311548e4 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el
index d430e089c6f..9ec73924254 100644
--- a/lisp/cedet/ede/proj-info.el
+++ b/lisp/cedet/ede/proj-info.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el
index 6d1070a7f73..75e409bd74e 100644
--- a/lisp/cedet/ede/proj-misc.el
+++ b/lisp/cedet/ede/proj-misc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el
index e7fa7730bd8..9fb94124c61 100644
--- a/lisp/cedet/ede/proj-obj.el
+++ b/lisp/cedet/ede/proj-obj.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el
index 3a149072718..2a9ea1a5131 100644
--- a/lisp/cedet/ede/proj-prog.el
+++ b/lisp/cedet/ede/proj-prog.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el
index 5ac2efa557a..0c6f602fb07 100644
--- a/lisp/cedet/ede/proj-scheme.el
+++ b/lisp/cedet/ede/proj-scheme.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el
index 6c17504a02b..f4c8e7b7944 100644
--- a/lisp/cedet/ede/proj-shared.el
+++ b/lisp/cedet/ede/proj-shared.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index a7f64ac5f3d..daedd37a25c 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index 86b707a99f5..de99b2939f9 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el
index 37beea0b427..dc31840ca62 100644
--- a/lisp/cedet/ede/shell.el
+++ b/lisp/cedet/ede/shell.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el
index d618b938e64..8f084754f0c 100644
--- a/lisp/cedet/ede/simple.el
+++ b/lisp/cedet/ede/simple.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el
index d72d0db3935..b2d7680e3ca 100644
--- a/lisp/cedet/ede/source.el
+++ b/lisp/cedet/ede/source.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el
index f938f209a46..4012fdadf71 100644
--- a/lisp/cedet/ede/speedbar.el
+++ b/lisp/cedet/ede/speedbar.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el
index 4193684dcf6..0658491f445 100644
--- a/lisp/cedet/ede/srecode.el
+++ b/lisp/cedet/ede/srecode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index 42172ce5dc0..f5ac3e39803 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el
index eb364d7eafb..5535eff1e1b 100644
--- a/lisp/cedet/ede/util.el
+++ b/lisp/cedet/ede/util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el
index ec54276af16..253336f973f 100644
--- a/lisp/cedet/inversion.el
+++ b/lisp/cedet/inversion.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index 88ee4001414..964f5c2db0f 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 913c183a7e6..3554ee242b8 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -196,11 +196,11 @@ Optional argument FACE specifies the face to do the highlighting."
(pulse-reset-face face)
(setq pulse-momentary-timer
(run-with-timer 0 pulse-delay #'pulse-tick
- (time-add (current-time)
+ (time-add nil
(* pulse-delay pulse-iterations)))))))
(defun pulse-tick (stop-time)
- (if (time-less-p (current-time) stop-time)
+ (if (time-less-p nil stop-time)
(pulse-lighten-highlight)
(pulse-momentary-unhighlight)))
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index c38afed3964..cae6e049f44 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -389,10 +389,9 @@ the output buffer."
(if clear (semantic-clear-toplevel-cache))
(if (eq clear '-) (setq clear -1))
(let* ((start (current-time))
- (out (semantic-fetch-tags))
- (end (current-time)))
+ (out (semantic-fetch-tags)))
(message "Retrieving tags took %.2f seconds."
- (semantic-elapsed-time start end))
+ (semantic-elapsed-time start nil))
(when (or (null clear) (not (listp clear))
(and (numberp clear) (< 0 clear)))
(pop-to-buffer "*Parser Output*")
diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el
index c7062fb24cd..b528487887a 100644
--- a/lisp/cedet/semantic/analyze.el
+++ b/lisp/cedet/semantic/analyze.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -440,12 +440,11 @@ to provide a large number of non-cached analysis for filtering symbols."
(defun semantic-analyze-current-symbol-default (analyzehookfcn position)
"Call ANALYZEHOOKFCN on the analyzed symbol at POSITION."
(let* ((semantic-analyze-error-stack nil)
- (LLstart (current-time))
+ ;; (LLstart (current-time))
(prefixandbounds (semantic-ctxt-current-symbol-and-bounds (or position (point))))
(prefix (car prefixandbounds))
(bounds (nth 2 prefixandbounds))
(scope (semantic-calculate-scope position))
- (end nil)
)
;; Only do work if we have bounds (meaning a prefix to complete)
(when bounds
@@ -464,15 +463,13 @@ to provide a large number of non-cached analysis for filtering symbols."
prefix scope 'prefixtypes))
(error (semantic-analyze-push-error err))))
- (setq end (current-time))
- ;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart end))
+ ;;(message "Analysis took %.2f sec" (semantic-elapsed-time LLstart nil))
)
(when prefix
(prog1
(funcall analyzehookfcn (car bounds) (cdr bounds) prefix)
- ;;(setq end (current-time))
- ;;(message "hookfcn took %.5f sec" (semantic-elapsed-time LLstart end))
+ ;;(message "hookfcn took %.5f sec" (semantic-elapsed-time LLstart nil))
)
)))
@@ -723,12 +720,11 @@ Optional argument CTXT is the context to show."
(interactive)
(require 'data-debug)
(let ((start (current-time))
- (ctxt (or ctxt (semantic-analyze-current-context)))
- (end (current-time)))
+ (ctxt (or ctxt (semantic-analyze-current-context))))
(if (not ctxt)
(message "No Analyzer Results")
(message "Analysis took %.2f seconds."
- (semantic-elapsed-time start end))
+ (semantic-elapsed-time start nil))
(semantic-analyze-pulse ctxt)
(if ctxt
(progn
diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el
index 1ddbe131e6a..1a450683701 100644
--- a/lisp/cedet/semantic/analyze/complete.el
+++ b/lisp/cedet/semantic/analyze/complete.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el
index fd218b67827..8e68e3b856b 100644
--- a/lisp/cedet/semantic/analyze/debug.el
+++ b/lisp/cedet/semantic/analyze/debug.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el
index 1abbca5158e..29a1ac9165b 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el
index 7fbaa2ce974..84c60e2dae8 100644
--- a/lisp/cedet/semantic/analyze/refs.el
+++ b/lisp/cedet/semantic/analyze/refs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -317,9 +317,8 @@ Only works for tags in the global namespace."
(let* ((tag (semantic-current-tag))
(start (current-time))
(sac (semantic-analyze-tag-references tag))
- (end (current-time))
)
- (message "Analysis took %.2f seconds." (semantic-elapsed-time start end))
+ (message "Analysis took %.2f seconds." (semantic-elapsed-time start nil))
(if sac
(progn
(require 'eieio-datadebug)
@@ -348,7 +347,7 @@ Only works for tags in the global namespace."
(push-mark)
(semantic-go-to-tag target)
- (switch-to-buffer (current-buffer))
+ (pop-to-buffer-same-window (current-buffer))
(semantic-momentary-highlight-tag target))
)
diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el
index 3c33eebb493..a3776b8d64f 100644
--- a/lisp/cedet/semantic/bovine.el
+++ b/lisp/cedet/semantic/bovine.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index 3200a5c1435..8dc04886158 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el
index f7bc20687e4..79aa400180f 100644
--- a/lisp/cedet/semantic/bovine/debug.el
+++ b/lisp/cedet/semantic/bovine/debug.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el
index ba6b05d7600..f5931e4f2cc 100644
--- a/lisp/cedet/semantic/bovine/el.el
+++ b/lisp/cedet/semantic/bovine/el.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el
index e4864bc6ca5..36f09354490 100644
--- a/lisp/cedet/semantic/bovine/gcc.el
+++ b/lisp/cedet/semantic/bovine/gcc.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el
index d34850f8032..28af05d95ef 100644
--- a/lisp/cedet/semantic/bovine/grammar.el
+++ b/lisp/cedet/semantic/bovine/grammar.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -505,7 +505,7 @@ Menu items are appended to the common grammar menu.")
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el
index 2a224bd99be..691ac0e85a0 100644
--- a/lisp/cedet/semantic/bovine/make.el
+++ b/lisp/cedet/semantic/bovine/make.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el
index 2e87993d0fe..547ca7a5fcd 100644
--- a/lisp/cedet/semantic/bovine/scm.el
+++ b/lisp/cedet/semantic/bovine/scm.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el
index 4f8ae245bd4..8063f2cbb15 100644
--- a/lisp/cedet/semantic/chart.el
+++ b/lisp/cedet/semantic/chart.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index 5bd76f018a1..325ca1f4414 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -2120,7 +2120,7 @@ completion works."
(when (semantic-tag-p tag)
(push-mark)
(semantic-go-to-tag tag)
- (switch-to-buffer (current-buffer))
+ (pop-to-buffer-same-window (current-buffer))
(semantic-momentary-highlight-tag tag)
(message "%S: %s "
(semantic-tag-class tag)
diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el
index 01e156267af..13bea302658 100644
--- a/lisp/cedet/semantic/ctxt.el
+++ b/lisp/cedet/semantic/ctxt.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el
index 9e6d725f4e6..8595cceeca2 100644
--- a/lisp/cedet/semantic/db-debug.el
+++ b/lisp/cedet/semantic/db-debug.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el
index 187f72242d5..5b4e7eba27d 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el
index 89bbd1c0c29..768af034c62 100644
--- a/lisp/cedet/semantic/db-el.el
+++ b/lisp/cedet/semantic/db-el.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el
index ed8d7bb144b..1e398c5a283 100644
--- a/lisp/cedet/semantic/db-file.el
+++ b/lisp/cedet/semantic/db-file.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index c09af59ea70..1f5de71c53d 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -930,7 +930,7 @@ but should be good enough for debugging assertions."
(length result))))
(defun semanticdb-find-result-with-nil-p (resultp)
- "Non-nil of RESULTP is in the form of a semanticdb search result.
+ "Non-nil if RESULTP is in the form of a semanticdb search result.
The value nil is valid where a TABLE usually is, but only if the TAG
results include overlays.
This query only really tests the first entry in the list that is RESULTP,
diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el
index 0afa6619d25..38fec0203a5 100644
--- a/lisp/cedet/semantic/db-global.el
+++ b/lisp/cedet/semantic/db-global.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el
index e8a3edcaf02..348512a212f 100644
--- a/lisp/cedet/semantic/db-javascript.el
+++ b/lisp/cedet/semantic/db-javascript.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 3bd991b368a..8072ca9e69c 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el
index a75a73ce103..049420ee746 100644
--- a/lisp/cedet/semantic/db-ref.el
+++ b/lisp/cedet/semantic/db-ref.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el
index 8c8cf15eaf2..68f9e200ede 100644
--- a/lisp/cedet/semantic/db-typecache.el
+++ b/lisp/cedet/semantic/db-typecache.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el
index 0ba9f2f9c68..4d9daaf54ef 100644
--- a/lisp/cedet/semantic/db.el
+++ b/lisp/cedet/semantic/db.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -595,7 +595,7 @@ This will call `semantic-fetch-tags' if that file is in memory."
(kill-buffer buff))))))
(cl-defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
- "Return non-nil of OBJ's tag list is out of date.
+ "Return non-nil if OBJ's tag list is out of date.
The file associated with OBJ does not need to be in a buffer."
(let* ((ff (semanticdb-full-filename obj))
(buff (semanticdb-in-buffer-p obj))
diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el
index 5c793e44aa9..c0a5fcb5e25 100644
--- a/lisp/cedet/semantic/debug.el
+++ b/lisp/cedet/semantic/debug.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el
index fc00a527bf3..ad866e9fe0f 100644
--- a/lisp/cedet/semantic/decorate.el
+++ b/lisp/cedet/semantic/decorate.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el
index c7b5eb55ef1..975ba343469 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -467,7 +467,7 @@ its contents.
(error "Could not location include %s"
(semantic-tag-name tag)))
((get-file-buffer file)
- (switch-to-buffer (get-file-buffer file)))
+ (pop-to-buffer-same-window (get-file-buffer file)))
((stringp file)
(find-file file))
))))
diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el
index a749fca9ccd..fb05a35cce9 100644
--- a/lisp/cedet/semantic/decorate/mode.el
+++ b/lisp/cedet/semantic/decorate/mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el
index 8c3ec0e06f3..f8d830bc29e 100644
--- a/lisp/cedet/semantic/dep.el
+++ b/lisp/cedet/semantic/dep.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el
index c8be665727c..d2b075655da 100644
--- a/lisp/cedet/semantic/doc.el
+++ b/lisp/cedet/semantic/doc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
index d982b6e258d..967af0bc359 100644
--- a/lisp/cedet/semantic/ede-grammar.el
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 9c7ae69081f..fc0a05a6a6e 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -221,7 +221,7 @@ Argument START, END, and LENGTH specify the bounds of the change."
)
(defun semantic-edits-change-in-one-tag-p (change hits)
- "Return non-nil of the overlay CHANGE exists solely in one leaf tag.
+ "Return non-nil if the overlay CHANGE exists solely in one leaf tag.
HITS is the list of tags that CHANGE is in. It can have more than
one tag in it if the leaf tag is within a parent tag."
(and (< (semantic-tag-start (car hits))
diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el
index bf8eb9df116..0959dfc7255 100644
--- a/lisp/cedet/semantic/find.el
+++ b/lisp/cedet/semantic/find.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el
index b724429850a..1ec8e68c372 100644
--- a/lisp/cedet/semantic/format.el
+++ b/lisp/cedet/semantic/format.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el
index 3527f3e6af8..ea3fc2a2d6e 100644
--- a/lisp/cedet/semantic/fw.el
+++ b/lisp/cedet/semantic/fw.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
index 9b5370815e1..6e7a1ad398f 100644
--- a/lisp/cedet/semantic/grammar-wy.el
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
index f57c54a25bb..61266bcc608 100644
--- a/lisp/cedet/semantic/grammar.el
+++ b/lisp/cedet/semantic/grammar.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -583,7 +583,7 @@ Typically a DEFINE expression should look like this:
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el
index 7901d6aec2d..4485a1f44c9 100644
--- a/lisp/cedet/semantic/html.el
+++ b/lisp/cedet/semantic/html.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el
index 7901dd53ddb..d7e1acae93b 100644
--- a/lisp/cedet/semantic/ia-sb.el
+++ b/lisp/cedet/semantic/ia-sb.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el
index 4696388a9c0..625c3ae9757 100644
--- a/lisp/cedet/semantic/ia.el
+++ b/lisp/cedet/semantic/ia.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -163,7 +163,7 @@ Completion options are calculated with `semantic-analyze-possible-completions'."
(if (not syms)
(progn
(message "No smart completions found.")
- ;; Disabled - see http://debbugs.gnu.org/14522
+ ;; Disabled - see https://debbugs.gnu.org/14522
;; (message "No smart completions found. Trying Senator.")
;; (when (semantic-analyze-context-p a)
;; ;; This is a quick way of getting a nice completion list
@@ -322,7 +322,7 @@ This helper manages the mark, buffer switching, and pulsing."
(semantic-go-to-tag dest)
;; 3) go-to-tag doesn't switch the buffer in the current window,
;; so it is like find-file-noselect. Bring it forward.
- (switch-to-buffer (current-buffer))
+ (pop-to-buffer-same-window (current-buffer))
;; 4) Fancy pulsing.
(pulse-momentary-highlight-one-line (point))
)
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 787748692e1..a106725f86c 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el
index a521f313f99..5018e039d03 100644
--- a/lisp/cedet/semantic/imenu.el
+++ b/lisp/cedet/semantic/imenu.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -488,7 +488,7 @@ Clears all imenu menus that may be depending on the database."
;;; Which function support
;;
;; The which-function library will display the current function in the
-;; mode line. It tries do do this through imenu. With a semantic parsed
+;; mode line. It tries to do this through imenu. With a semantic parsed
;; buffer, there is a much more efficient way of doing this.
;; Advise `which-function' so that we optionally use semantic tags
;; instead, and get better stuff.
diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el
index 00f9ee783b5..3c81b7ae65f 100644
--- a/lisp/cedet/semantic/java.el
+++ b/lisp/cedet/semantic/java.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el
index cb33e483a6b..35d77a8f87a 100644
--- a/lisp/cedet/semantic/lex-spp.el
+++ b/lisp/cedet/semantic/lex-spp.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el
index b2a63cdcc3c..835888db2ad 100644
--- a/lisp/cedet/semantic/lex.el
+++ b/lisp/cedet/semantic/lex.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -657,10 +657,9 @@ If universal argument ARG, then try the whole buffer."
(let* ((start (current-time))
(result (semantic-lex
(if arg (point-min) (point))
- (point-max)))
- (end (current-time)))
+ (point-max))))
(message "Elapsed Time: %.2f seconds."
- (semantic-elapsed-time start end))
+ (semantic-elapsed-time start nil))
(pop-to-buffer "*Lexer Output*")
(require 'pp)
(erase-buffer)
@@ -810,7 +809,7 @@ analyzer which might mistake a number for as a symbol."
tmp-start (car semantic-lex-token-stream)))
(setq tmp-start semantic-lex-end-point)
(goto-char semantic-lex-end-point)
- ;;(when (> (semantic-elapsed-time starttime (current-time))
+ ;;(when (> (semantic-elapsed-time starttime nil)
;; semantic-lex-timeout)
;; (error "Timeout during lex at char %d" (point)))
(semantic-throw-on-input 'lex)
diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el
index 067439d4772..24863de01b1 100644
--- a/lisp/cedet/semantic/mru-bookmark.el
+++ b/lisp/cedet/semantic/mru-bookmark.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -113,7 +113,7 @@ Uses `semantic-go-to-tag' and highlighting."
(forward-char o))
(error nil))
;; make it visible
- (switch-to-buffer (current-buffer))
+ (pop-to-buffer-same-window (current-buffer))
(semantic-momentary-highlight-tag tag)
))
diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el
index 41fe8857ccf..fbec9f2b019 100644
--- a/lisp/cedet/semantic/sb.el
+++ b/lisp/cedet/semantic/sb.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 9bade569659..717c2e30119 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el
index f1918c40918..ea796dd19f9 100644
--- a/lisp/cedet/semantic/senator.el
+++ b/lisp/cedet/semantic/senator.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -530,11 +530,11 @@ Some tags such as includes have other reference features."
;; A tag
((semantic-tag-p result)
(semantic-go-to-tag result)
- (switch-to-buffer (current-buffer))
+ (pop-to-buffer-same-window (current-buffer))
(semantic-momentary-highlight-tag result))
;; Buffers
((bufferp result)
- (switch-to-buffer result)
+ (pop-to-buffer-same-window result)
(pulse-momentary-highlight-one-line (point)))
;; Files
((and (stringp result) (file-exists-p result))
diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el
index e77b64f7bab..32e39d7454f 100644
--- a/lisp/cedet/semantic/sort.el
+++ b/lisp/cedet/semantic/sort.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el
index a16672e39de..b9fe63d684b 100644
--- a/lisp/cedet/semantic/symref.el
+++ b/lisp/cedet/semantic/symref.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el
index 181e3997681..502c3ef9f3b 100644
--- a/lisp/cedet/semantic/symref/cscope.el
+++ b/lisp/cedet/semantic/symref/cscope.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el
index e3860333194..d5766af9b6e 100644
--- a/lisp/cedet/semantic/symref/filter.el
+++ b/lisp/cedet/semantic/symref/filter.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -103,7 +103,7 @@ tag that contains point, and return that."
(when (called-interactively-p 'interactive)
(message "Found %d occurrences of %s in %.2f seconds"
Lcount (semantic-tag-name target)
- (semantic-elapsed-time start (current-time))))
+ (semantic-elapsed-time start nil)))
Lcount)))
(defun semantic-symref-rename-local-variable ()
diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el
index e91ecf07bcc..35f6a249d99 100644
--- a/lisp/cedet/semantic/symref/global.el
+++ b/lisp/cedet/semantic/symref/global.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el
index 42dc40cce04..0b263d8cc2d 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -38,16 +38,22 @@
(
)
"A symref tool implementation using grep.
-This tool uses EDE to find he root of the project, then executes
-find-grep in the project. The output is parsed for hits
-and those hits returned.")
+This tool uses EDE to find the root of the project, then executes
+find-grep in the project. The output is parsed for hits and
+those hits returned.")
(defvar semantic-symref-filepattern-alist
'((c-mode "*.[ch]")
(c++-mode "*.[chCH]" "*.[ch]pp" "*.cc" "*.hh")
- (html-mode "*.s?html" "*.php")
+ (html-mode "*.html" "*.shtml" "*.php")
+ (mhtml-mode "*.html" "*.shtml" "*.php") ; FIXME: remove
+ ; duplication of
+ ; HTML-related patterns.
+ ; Maybe they belong in the
+ ; major mode definition?
(ruby-mode "*.r[bu]" "*.rake" "*.gemspec" "*.erb" "*.haml"
"Rakefile" "Thorfile" "Capfile" "Guardfile" "Vagrantfile")
+ (python-mode "*.py" "*.pyi" "*.pyw")
(perl-mode "*.pl" "*.PL")
(cperl-mode "*.pl" "*.PL")
(lisp-interaction-mode "*.el" "*.ede" ".emacs" "_emacs")
@@ -58,7 +64,7 @@ See find -name man page for format.")
(defun semantic-symref-derive-find-filepatterns (&optional mode)
;; FIXME: This should be moved to grep.el, where it could be used
;; for "C-u M-x grep" as well.
- "Derive a list of file patterns for the current buffer.
+ "Derive a list of file (glob) patterns for the current buffer.
Looks first in `semantic-symref-filepattern-alist'. If it is not
there, it then looks in `auto-mode-alist', and attempts to derive something
from that.
@@ -78,23 +84,20 @@ Optional argument MODE specifies the `major-mode' to test."
(error "Customize `semantic-symref-filepattern-alist' for %S"
major-mode)
(let ((args `("-name" ,(car pat))))
- (if (null (cdr args))
+ (if (null (cdr pat))
args
`("(" ,@args
,@(mapcan (lambda (s) `("-o" "-name" ,s)) pat)
")"))))))
-(defvar grepflags)
-(defvar greppattern)
+(defvar semantic-symref-grep-flags)
(defvar semantic-symref-grep-expand-keywords
(condition-case nil
(let* ((kw (copy-alist grep-expand-keywords))
- (C (assoc "<C>" kw))
- (R (assoc "<R>" kw)))
- (setcdr C 'grepflags)
- (setcdr R 'greppattern)
- kw)
+ (C (assoc "<C>" kw)))
+ (setcdr C 'semantic-symref-grep-flags)
+ kw)
(error nil))
"Grep expand keywords used when expanding templates for symref.")
@@ -102,15 +105,15 @@ Optional argument MODE specifies the `major-mode' to test."
"Use the grep template expand feature to create a grep command.
ROOTDIR is the root location to run the `find' from.
FILEPATTERN is a string representing find flags for searching file patterns.
-GREPFLAGS are flags passed to grep, such as -n or -l.
-GREPPATTERN is the pattern used by grep."
+FLAGS are flags passed to Grep, such as -n or -l.
+PATTERN is the pattern used by Grep."
;; We have grep-compute-defaults. Let's use it.
(grep-compute-defaults)
- (let* ((grepflags flags)
- (greppattern pattern)
+ (let* ((semantic-symref-grep-flags flags)
(grep-expand-keywords semantic-symref-grep-expand-keywords)
(cmd (grep-expand-template
(if (memq system-type '(windows-nt ms-dos))
+ ;; FIXME: Is this still needed?
;; grep-find uses '--color=always' on MS-Windows
;; because it wants the colorized output, to show
;; it to the user. By contrast, here we don't show
@@ -119,13 +122,9 @@ GREPPATTERN is the pattern used by grep."
(replace-regexp-in-string "--color=always" ""
grep-find-template t t)
grep-find-template)
- greppattern
+ pattern
filepattern
rootdir)))
- ;; http://debbugs.gnu.org/20719
- (when (string-match "find \\(\\.\\)" cmd)
- (setq cmd (replace-match rootdir t t cmd 1)))
- ;;(message "New command: %s" cmd)
cmd))
(defcustom semantic-symref-grep-shell shell-file-name
@@ -137,7 +136,7 @@ This shell should support pipe redirect syntax."
(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep."
;; Grep doesn't support some types of searches.
- (let ((st (oref tool :searchtype)))
+ (let ((st (oref tool searchtype)))
(when (not (memq st '(symbol regexp)))
(error "Symref impl GREP does not support searchtype of %s" st))
)
@@ -147,20 +146,19 @@ This shell should support pipe redirect syntax."
(filepatterns (semantic-symref-derive-find-filepatterns))
(filepattern (mapconcat #'shell-quote-argument filepatterns " "))
;; Grep based flags.
- (grepflags (cond ((eq (oref tool :resulttype) 'file)
+ (grepflags (cond ((eq (oref tool resulttype) 'file)
"-l ")
- ((eq (oref tool :searchtype) 'regexp)
+ ((eq (oref tool searchtype) 'regexp)
"-nE ")
(t "-n ")))
- (greppat (shell-quote-argument
- (cond ((eq (oref tool :searchtype) 'regexp)
- (oref tool searchfor))
- (t
- ;; Can't use the word boundaries: Grep
- ;; doesn't always agrees with the language
- ;; syntax on those.
- (format "\\(^\\|\\W\\)%s\\(\\W\\|$\\)"
- (oref tool searchfor))))))
+ (greppat (cond ((eq (oref tool searchtype) 'regexp)
+ (oref tool searchfor))
+ (t
+ ;; Can't use the word boundaries: Grep
+ ;; doesn't always agree with the language
+ ;; syntax on those.
+ (format "\\(^\\|\\W\\)%s\\(\\W\\|$\\)"
+ (oref tool searchfor)))))
;; Misc
(b (get-buffer-create "*Semantic SymRef*"))
(ans nil)
@@ -189,26 +187,25 @@ This shell should support pipe redirect syntax."
;; Return the answer
ans))
-(defconst semantic-symref-grep--line-re
- "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):")
-
(cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep))
"Parse one line of grep output, and return it as a match list.
Moves cursor to end of the match."
- (cond ((eq (oref tool :resulttype) 'file)
- ;; Search for files
- (when (re-search-forward "^\\([^\n]+\\)$" nil t)
- (match-string 1)))
- ((eq (oref tool :resulttype) 'line-and-text)
- (when (re-search-forward semantic-symref-grep--line-re nil t)
- (list (string-to-number (match-string 2))
- (match-string 1)
- (buffer-substring-no-properties (point) (line-end-position)))))
- (t
- (when (re-search-forward semantic-symref-grep--line-re nil t)
- (cons (string-to-number (match-string 2))
- (match-string 1))
- ))))
+ (pcase-let
+ ((`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)))
+ (cond ((eq (oref tool resulttype) 'file)
+ ;; Search for files
+ (when (re-search-forward "^\\([^\n]+\\)$" nil t)
+ (match-string 1)))
+ ((eq (oref tool resulttype) 'line-and-text)
+ (when (re-search-forward grep-re nil t)
+ (list (string-to-number (match-string line-group))
+ (match-string file-group)
+ (buffer-substring-no-properties (point) (line-end-position)))))
+ (t
+ (when (re-search-forward grep-re nil t)
+ (cons (string-to-number (match-string line-group))
+ (match-string file-group))
+ )))))
(provide 'semantic/symref/grep)
diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el
index 3c94f01c6d9..290bed12245 100644
--- a/lisp/cedet/semantic/symref/idutils.el
+++ b/lisp/cedet/semantic/symref/idutils.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el
index e1a789d673a..d0ad23934d9 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el
index ac11dbeb44c..65d9e2cae53 100644
--- a/lisp/cedet/semantic/tag-file.el
+++ b/lisp/cedet/semantic/tag-file.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el
index 3a66fc7df5c..aa9b4b97142 100644
--- a/lisp/cedet/semantic/tag-ls.el
+++ b/lisp/cedet/semantic/tag-ls.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el
index 76a1d79e10d..6ce77edf102 100644
--- a/lisp/cedet/semantic/tag-write.el
+++ b/lisp/cedet/semantic/tag-write.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 6b2a49558d6..59788c774e9 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el
index 79f879899d3..e9bc3415e33 100644
--- a/lisp/cedet/semantic/texi.el
+++ b/lisp/cedet/semantic/texi.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el
index 70f3a343343..b31fd07f3c3 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el
index 31562bc16ab..f5d9054bdc3 100644
--- a/lisp/cedet/semantic/util.el
+++ b/lisp/cedet/semantic/util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 90a863bd3c1..235f83821d5 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el
index cb19b1b861f..0ed9ba32597 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el
index d0dc3e7b39a..29106da5f9f 100644
--- a/lisp/cedet/semantic/wisent/grammar.el
+++ b/lisp/cedet/semantic/wisent/grammar.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -370,7 +370,7 @@ Menu items are appended to the common grammar menu.")
;; 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 <http://www.gnu.org/licenses/>.")
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.")
(defvar wisent-make-parsers--python-license
";; It is derived in part from the Python grammar, used under the
diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el
index 9deb997435f..479fc7fbe87 100644
--- a/lisp/cedet/semantic/wisent/java-tags.el
+++ b/lisp/cedet/semantic/wisent/java-tags.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -75,7 +75,7 @@ This function override `get-local-variables'."
;; Add 'this' if in a fcn
(when (semantic-tag-of-class-p ct 'function)
;; Append a new tag THIS into our space.
- (setq vars (cons (semantic-tag-new-variable
+ (setq vars (cons (semantic-tag-new-variable
"this" (semantic-tag-name (semantic-current-tag-parent))
nil)
vars)))
diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el
index cf1911b46c4..b73cb01819a 100644
--- a/lisp/cedet/semantic/wisent/javascript.el
+++ b/lisp/cedet/semantic/wisent/javascript.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el
index 4e7ee3d0cf5..591895d5aa4 100644
--- a/lisp/cedet/semantic/wisent/python.el
+++ b/lisp/cedet/semantic/wisent/python.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el
index 08cad524aed..d4d2b3d2ace 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el
index e824062f7be..c8eee15bae4 100644
--- a/lisp/cedet/srecode.el
+++ b/lisp/cedet/srecode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el
index facf96e9afb..c4a15a2d6ae 100644
--- a/lisp/cedet/srecode/args.el
+++ b/lisp/cedet/srecode/args.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el
index 1b6cd704095..21ab9b8f2e7 100644
--- a/lisp/cedet/srecode/compile.el
+++ b/lisp/cedet/srecode/compile.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el
index 8f9c0832844..fe1dd77ae92 100644
--- a/lisp/cedet/srecode/cpp.el
+++ b/lisp/cedet/srecode/cpp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el
index 28dbd367399..664e06d73e7 100644
--- a/lisp/cedet/srecode/ctxt.el
+++ b/lisp/cedet/srecode/ctxt.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el
index 2844c1b52da..6c8fd655d7b 100644
--- a/lisp/cedet/srecode/dictionary.el
+++ b/lisp/cedet/srecode/dictionary.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -612,10 +612,9 @@ STATE is the current compiler state."
(srecode-get-mode-table modesym))
(error "No table found for mode %S" modesym)))
(dict (srecode-create-dictionary (current-buffer)))
- (end (current-time))
)
(message "Creating a dictionary took %.2f seconds."
- (semantic-elapsed-time start end))
+ (semantic-elapsed-time start nil))
(data-debug-new-buffer "*SRECODE ADEBUG*")
(data-debug-insert-object-slots dict "*")))
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index babd177c9bd..f8fcdef5840 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el
index 526a2a21070..e725074b7a6 100644
--- a/lisp/cedet/srecode/el.el
+++ b/lisp/cedet/srecode/el.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el
index 74742f66d7e..87bcdb3b944 100644
--- a/lisp/cedet/srecode/expandproto.el
+++ b/lisp/cedet/srecode/expandproto.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 34771859d69..bbde255b413 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 0bef8545ebe..7818a66a576 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el
index 7b9b9798f5d..1be451be281 100644
--- a/lisp/cedet/srecode/filters.el
+++ b/lisp/cedet/srecode/filters.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -54,4 +54,3 @@
(provide 'srecode/filters)
;;; srecode/filters.el ends here
-
diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el
index 913013c259c..35b3753c915 100644
--- a/lisp/cedet/srecode/find.el
+++ b/lisp/cedet/srecode/find.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el
index 0b32af2351d..b23ae8ecebe 100644
--- a/lisp/cedet/srecode/getset.el
+++ b/lisp/cedet/srecode/getset.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index c582e328b2b..1e2cbc84e6a 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el
index 30734f2b9e3..0ede5d28b07 100644
--- a/lisp/cedet/srecode/java.el
+++ b/lisp/cedet/srecode/java.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el
index d5b4c5ffc8c..5b5d1fdd47d 100644
--- a/lisp/cedet/srecode/map.el
+++ b/lisp/cedet/srecode/map.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -224,10 +224,9 @@ Optional argument RESET forces a reset of the current map."
(require 'data-debug)
(let ((start (current-time))
(p (srecode-get-maps t)) ;; Time the reset.
- (end (current-time))
)
(message "Updating the map took %.2f seconds."
- (semantic-elapsed-time start end))
+ (semantic-elapsed-time start nil))
(data-debug-new-buffer "*SRECODE ADEBUG*")
(data-debug-insert-stuff-list p "*")))
diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el
index 566ab5d366a..ddbce0a63c5 100644
--- a/lisp/cedet/srecode/mode.el
+++ b/lisp/cedet/srecode/mode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index 7e24a320483..44c5248ad96 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el
index d3ce72aef80..602a1ce843f 100644
--- a/lisp/cedet/srecode/srt-mode.el
+++ b/lisp/cedet/srecode/srt-mode.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el
index 070261c47c2..4c885fe9abf 100644
--- a/lisp/cedet/srecode/srt.el
+++ b/lisp/cedet/srecode/srt.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el
index 98e0c2d1d14..f85a88165ff 100644
--- a/lisp/cedet/srecode/table.el
+++ b/lisp/cedet/srecode/table.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -288,4 +288,3 @@ Use PREDICATE is the same as for the `sort' function."
(provide 'srecode/table)
;;; srecode/table.el ends here
-
diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el
index 95510772ca4..7da896989f0 100644
--- a/lisp/cedet/srecode/template.el
+++ b/lisp/cedet/srecode/template.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el
index 5cc57bebee5..9bf52e10f60 100644
--- a/lisp/cedet/srecode/texi.el
+++ b/lisp/cedet/srecode/texi.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/char-fold.el b/lisp/char-fold.el
index ea4486353a7..b24363530f3 100644
--- a/lisp/char-fold.el
+++ b/lisp/char-fold.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -196,7 +196,7 @@ from which to start."
;;; If N suffixes match, we "branch" out into N+1 executions for the
;;; length of the longest match. This means "fix" will match "fix" but
;;; not "fⅸ", but it's necessary to keep the regexp size from scaling
-;;; exponentially. See https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html
+;;; exponentially. See https://lists.gnu.org/r/emacs-devel/2015-11/msg02562.html
(let ((subs (substring string (1+ i) (+ i 1 max-length))))
;; `i' is still going to inc by 1 below.
(setq i (+ i max-length))
diff --git a/lisp/chistory.el b/lisp/chistory.el
index 8b6f3d1525e..c270bffe115 100644
--- a/lisp/chistory.el
+++ b/lisp/chistory.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
index 0a41a401af1..1bf79f3c1ae 100644
--- a/lisp/cmuscheme.el
+++ b/lisp/cmuscheme.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/color.el b/lisp/color.el
index 6dbf3d55cbc..2db01a53c84 100644
--- a/lisp/color.el
+++ b/lisp/color.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -42,7 +42,7 @@
(defun color-name-to-rgb (color &optional frame)
"Convert COLOR string to a list of normalized RGB components.
COLOR should be a color name (e.g. \"white\") or an RGB triplet
-string (e.g. \"#ff12ec\").
+string (e.g. \"#ffff1122eecc\").
Normally the return value is a list of three floating-point
numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive.
@@ -68,7 +68,8 @@ or 2; use the latter if you need a 24-bit specification of a color."
(defun color-complement (color-name)
"Return the color that is the complement of COLOR-NAME.
COLOR-NAME should be a string naming a color (e.g. \"white\"), or
-a string specifying a color's RGB components (e.g. \"#ff12ec\")."
+a string specifying a color's RGB
+components (e.g. \"#ffff1212ecec\")."
(let ((color (color-name-to-rgb color-name)))
(list (- 1.0 (nth 0 color))
(- 1.0 (nth 1 color))
@@ -82,9 +83,10 @@ resulting list."
(let* ((r (nth 0 start))
(g (nth 1 start))
(b (nth 2 start))
- (r-step (/ (- (nth 0 stop) r) (1+ step-number)))
- (g-step (/ (- (nth 1 stop) g) (1+ step-number)))
- (b-step (/ (- (nth 2 stop) b) (1+ step-number)))
+ (interval (float (1+ step-number)))
+ (r-step (/ (- (nth 0 stop) r) interval))
+ (g-step (/ (- (nth 1 stop) g) interval))
+ (b-step (/ (- (nth 2 stop) b) interval))
result)
(dotimes (_ step-number)
(push (list (setq r (+ r r-step))
@@ -177,7 +179,8 @@ each element is between 0.0 and 1.0, inclusive."
((= r max) (- bc gc))
((= g max) (+ 2.0 rc (- bc)))
(t (+ 4.0 gc (- rc))))
- 6.0) 1.0)))
+ 6.0)
+ 1.0)))
(list h s l)))))
(defun color-srgb-to-xyz (red green blue)
@@ -211,9 +214,18 @@ RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive."
(* 12.92 b)
(- (* 1.055 (expt b (/ 2.4))) 0.055)))))
+(defconst color-d75-xyz '(0.9497 1.0 1.2264)
+ "D75 white point in CIE XYZ.")
+
(defconst color-d65-xyz '(0.950455 1.0 1.088753)
"D65 white point in CIE XYZ.")
+(defconst color-d55-xyz '(0.9568 1.0 0.9215)
+ "D55 white point in CIE XYZ.")
+
+(defconst color-d50-xyz '(0.9642 1.0 0.8249)
+ "D50 white point in CIE XYZ.")
+
(defconst color-cie-ε (/ 216 24389.0))
(defconst color-cie-κ (/ 24389 27.0))
@@ -268,6 +280,24 @@ conversion. If omitted or nil, use `color-d65-xyz'."
"Convert CIE L*a*b* to RGB."
(apply 'color-xyz-to-srgb (color-lab-to-xyz L a b)))
+(defun color-xyz-to-xyy (X Y Z)
+ "Convert CIE XYZ to xyY."
+ (let ((d (float (+ X Y Z))))
+ (list (/ X d) (/ Y d) Y)))
+
+(defun color-xyy-to-xyz (x y Y)
+ "Convert CIE xyY to XYZ."
+ (let ((y (float y)))
+ (list (/ (* Y x) y) Y (/ (* Y (- 1 x y)) y))))
+
+(defun color-lab-to-lch (L a b)
+ "Convert CIE L*a*b* to L*C*h*"
+ (list L (sqrt (+ (* a a) (* b b))) (atan b a)))
+
+(defun color-lch-to-lab (L C h)
+ "Convert CIE L*a*b* to L*C*h*"
+ (list L (* C (cos h)) (* C (sin h))))
+
(defun color-cie-de2000 (color1 color2 &optional kL kC kH)
"Return the CIEDE2000 color distance between COLOR1 and COLOR2.
Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as
diff --git a/lisp/comint.el b/lisp/comint.el
index 51b659167d5..aa7dab28f32 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -678,7 +678,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
;; comint-scroll-show-maximum-output is nil, and no-one can remember
;; what the original problem was. If there are problems with point
;; not going to the end, consider re-enabling this.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00827.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00827.html
;;
;; This makes it really work to keep point at the bottom.
;; (make-local-variable 'scroll-conservatively)
diff --git a/lisp/completion.el b/lisp/completion.el
index d56ea93ad1b..42366acbf7a 100644
--- a/lisp/completion.el
+++ b/lisp/completion.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/composite.el b/lisp/composite.el
index a3e00013466..29fc753d5ae 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -337,8 +337,9 @@ When Automatic Composition mode is on, this function also finds a
chunk of text that is automatically composed. If such a chunk is
found closer to POS than the position that has `composition'
property, the value is a list of FROM, TO, and a glyph-string
-that specifies how the chunk is to be composed. See the function
-`composition-get-gstring' for the format of the glyph-string."
+that specifies how the chunk is to be composed; DETAIL-P is
+ignored in this case. See the function `composition-get-gstring'
+for the format of the glyph-string."
(let ((result (find-composition-internal pos limit string detail-p)))
(if (and detail-p (> (length result) 3) (nth 2 result) (not (nth 3 result)))
;; This is a valid rule-base composition.
@@ -442,8 +443,10 @@ after a sequence of character events."
(defsubst lglyph-set-adjustment (glyph &optional xoff yoff wadjust)
(aset glyph 9 (vector (or xoff 0) (or yoff 0) (or wadjust 0))))
+;; Return the shallow Copy of GLYPH.
(defsubst lglyph-copy (glyph) (copy-sequence glyph))
+;; Insert GLYPH at the index IDX of GSTRING.
(defun lgstring-insert-glyph (gstring idx glyph)
(let ((nglyphs (lgstring-glyph-len gstring))
(i idx))
@@ -459,6 +462,18 @@ after a sequence of character events."
(lgstring-set-glyph gstring i glyph)
gstring))
+;; Remove glyph at IDX from GSTRING.
+(defun lgstring-remove-glyph (gstring idx)
+ (setq gstring (copy-sequence gstring))
+ (lgstring-set-id gstring nil)
+ (let ((len (length gstring)))
+ (setq idx (+ idx 3))
+ (while (< idx len)
+ (aset gstring (1- idx) (aref gstring idx))
+ (setq idx (1+ idx)))
+ (aset gstring (1- len) nil))
+ gstring)
+
(defun compose-glyph-string (gstring from to)
(let ((glyph (lgstring-glyph gstring from))
from-pos to-pos)
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index ecdda4e7023..6c513640bb3 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index ca6b8a38d99..4965adfd56c 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -986,7 +986,7 @@ If given a prefix (or a COMMENT argument), also prompt for a comment."
current-prefix-arg))
(custom-load-symbol variable)
(custom-push-theme 'theme-value variable 'user 'set (custom-quote value))
- (funcall (or (get variable 'custom-set) 'set-default) variable value)
+ (funcall (or (get variable 'custom-set) #'set-default) variable value)
(put variable 'customized-value (list (custom-quote value)))
(cond ((string= comment "")
(put variable 'variable-comment nil)
@@ -1159,7 +1159,7 @@ Show the buffer in another window, but don't select it."
(unless (eq symbol basevar)
(message "`%s' is an alias for `%s'" symbol basevar))))
-(defvar customize-changed-options-previous-release "24.5"
+(defvar customize-changed-options-previous-release "25.3"
"Version for `customize-changed-options' to refer back to by default.")
;; Packages will update this variable, so make it available.
@@ -2518,7 +2518,10 @@ try matching its doc string against `custom-guess-doc-alist'."
(copy-sequence type)
(list type))))
(when options
- (widget-put tmp :options options))
+ ;; This used to use widget-put, but with strict plists that
+ ;; fails when type is an even-length list, eg (repeat character).
+ ;; Passing our result through widget-convert makes it a valid widget.
+ (setcdr tmp (append (list :options options) (cdr tmp))))
tmp))
(defun custom-variable-value-create (widget)
@@ -2796,7 +2799,7 @@ If STATE is nil, the value is computed by `custom-variable-state'."
;; init-file-user rather than user-init-file. This is in case
;; cus-edit is loaded by something in site-start.el, because
;; user-init-file is not set at that stage.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00310.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-10/msg00310.html
,@(when (or custom-file init-file-user)
'(("Save for Future Sessions" custom-variable-save
(lambda (widget)
diff --git a/lisp/cus-face.el b/lisp/cus-face.el
index aa5ecd2e223..0fc084e69b3 100644
--- a/lisp/cus-face.el
+++ b/lisp/cus-face.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index 744fe7f69ee..a5ec223fe51 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -223,6 +223,14 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(visible-bell display boolean)
(no-redraw-on-reenter display boolean)
+ ;; doc.c
+ (text-quoting-style display
+ (choice
+ (const :tag "Prefer \\=‘curved\\=’ quotes, if possible" nil)
+ (const :tag "\\=‘Curved\\=’ quotes" curved)
+ (const :tag "\\='Straight\\=' quotes" straight)
+ (const :tag "\\=`Grave\\=' quotes (no translation)" grave)))
+
;; dosfns.c
(dos-display-scancodes display boolean)
(dos-hyper-key keyboard integer)
@@ -319,6 +327,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of
(const :tag "Always" t)
(repeat (symbol :tag "Parameter")))
"25.1")
+ (iconify-child-frame frames
+ (choice
+ (const :tag "Do nothing" nil)
+ (const :tag "Iconify top level frame instead" iconify-top-level)
+ (const :tag "Make frame invisible instead" make-invisible)
+ (const :tag "Iconify" t))
+ "26.1")
(tooltip-reuse-hidden-frame tooltip boolean "26.1")
;; fringe.c
(overflow-newline-into-fringe fringe boolean)
@@ -584,6 +599,38 @@ since it could result in memory overflow and make Emacs crash."
(const :tag "Grow only" :value grow-only))
"25.1")
(display-raw-bytes-as-hex display boolean "26.1")
+ (display-line-numbers display-line-numbers
+ (choice
+ (const :tag "Off (nil)" :value nil)
+ (const :tag "Absolute line numbers"
+ :value t)
+ (const :tag "Relative line numbers"
+ :value relative)
+ (const :tag "Visually relative line numbers"
+ :value visual))
+ "26.1")
+ (display-line-numbers-width display-line-numbers
+ (choice
+ (const :tag "Dynamically computed"
+ :value nil)
+ (integer :menu-tag "Fixed number of columns"
+ :value 2
+ :format "%v"))
+ "26.1")
+ (display-line-numbers-current-absolute display-line-numbers
+ (choice
+ (const :tag "Display actual number of current line"
+ :value t)
+ (const :tag "Display zero as number of current line"
+ :value nil))
+ "26.1")
+ (display-line-numbers-widen display-line-numbers
+ (choice
+ (const :tag "Disregard narrowing when calculating line numbers"
+ :value t)
+ (const :tag "Count lines from beginning of narrowed region"
+ :value nil))
+ "26.1")
;; xfaces.c
(scalable-fonts-allowed display boolean "22.1")
;; xfns.c
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index d2ee14d8bdf..1aac7bf631d 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/custom.el b/lisp/custom.el
index ecfa34db5bb..352fc6bd530 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 86eb4e737df..4bdfffe864a 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/delim-col.el b/lisp/delim-col.el
index db89206f32f..175bf375162 100644
--- a/lisp/delim-col.el
+++ b/lisp/delim-col.el
@@ -2,8 +2,8 @@
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Version: 2.1
;; Keywords: internal
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/delsel.el b/lisp/delsel.el
index d5f4736fddb..65b2cb85cea 100644
--- a/lisp/delsel.el
+++ b/lisp/delsel.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -70,9 +70,12 @@ Value must be the register (key) to use.")
;;;###autoload
(define-minor-mode delete-selection-mode
"Toggle Delete Selection mode.
-With a prefix argument ARG, enable Delete Selection mode if ARG
-is positive, and disable it otherwise. If called from Lisp,
-enable the mode if ARG is omitted or nil.
+Interactively, with a prefix argument, enable
+Delete Selection mode if the prefix argument is positive,
+and disable it otherwise. If called from Lisp, toggle
+the mode if ARG is `toggle', disable the mode if ARG is
+a non-positive integer, and enable the mode otherwise
+\(including if ARG is omitted or nil or a positive integer).
When Delete Selection mode is enabled, typed text replaces the selection
if the selection is active. Otherwise, typed text is just inserted at
@@ -253,12 +256,18 @@ See `delete-selection-helper'."
(get this-command 'delete-selection)))))
(defun delete-selection-uses-region-p ()
- "Return t when the current command will be using the region
-rather than having `delete-selection' delete it, nil otherwise.
+ "Return t when `delete-selection-mode' should not delete the region.
+
+The `self-insert-command' could be the current command or may be
+called by the current command. If this function returns nil,
+then `delete-selection' is allowed to delete the region.
This function is intended for use as the value of the
`delete-selection' property of a command, and shouldn't be used
-for anything else."
+for anything else. In particular, `self-insert-command' has this
+function as its `delete-selection' property, so that \"electric\"
+self-insert commands that act on the region could adapt themselves
+to `delete-selection-mode'."
(not (run-hook-with-args-until-success
'self-insert-uses-region-functions)))
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index 6a6a8ea4479..12d0016de38 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -413,12 +413,11 @@ relevant to POS."
(multibyte-p enable-multibyte-characters)
(overlays (mapcar (lambda (o) (overlay-properties o))
(overlays-at pos)))
- (char-description (if (not multibyte-p)
+ (char-description (if (< char 128)
(single-key-description char)
- (if (< char 128)
- (single-key-description char)
- (string-to-multibyte
- (char-to-string char)))))
+ (string (if (not multibyte-p)
+ (decode-char 'eight-bit char)
+ char))))
(text-props-desc
(let ((tmp-buf (generate-new-buffer " *text-props*")))
(unwind-protect
@@ -618,16 +617,16 @@ relevant to POS."
(list
(let* ((names (ucs-names))
(name
- (or (when (= char 7)
+ (or (when (= char ?\a)
;; Special case for "BELL" which is
;; apparently the only char which
;; doesn't have a new name and whose
;; old-name is shadowed by a newer char
;; with that name (bug#25641).
- (car (rassoc char names)))
+ "BELL (BEL)")
(get-char-code-property char 'name)
(get-char-code-property char 'old-name))))
- (if (and name (assoc-string name names))
+ (if (and name (gethash name names))
(format
"type \"C-x 8 RET %x\" or \"C-x 8 RET %s\""
char name)
@@ -635,7 +634,9 @@ relevant to POS."
("buffer code"
,(if multibyte-p
(encoded-string-description
- (string-as-unibyte (char-to-string char)) nil)
+ (encode-coding-string (char-to-string char)
+ 'emacs-internal)
+ nil)
(format "#x%02X" char)))
("file code"
,@(if multibyte-p
@@ -704,7 +705,6 @@ relevant to POS."
(called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (set-buffer-multibyte multibyte-p)
(let ((formatter (format "%%%ds:" max-width)))
(dolist (elt item-list)
(when (cadr elt)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 540d0e3b11d..5257c609dde 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -216,8 +216,9 @@ determine where the desktop is saved."
:version "22.1")
(defcustom desktop-auto-save-timeout auto-save-timeout
- "Number of seconds idle time before auto-save of the desktop.
-The idle timer activates auto-saving only when window configuration changes.
+ "Number of seconds of idle time before auto-saving the desktop.
+The desktop will be auto-saved when this amount of idle time have
+passed after some change in the window configuration.
This applies to an existing desktop file when `desktop-save-mode' is enabled.
Zero or nil means disable auto-saving due to idleness."
:type '(choice (const :tag "Off" nil)
@@ -709,8 +710,8 @@ if different)."
(setq desktop-io-file-version nil)
(dolist (var desktop-globals-to-clear)
(if (symbolp var)
- (eval `(setq-default ,var nil))
- (eval `(setq-default ,(car var) ,(cdr var)))))
+ (set-default var nil)
+ (set-default var (eval (cdr var)))))
(let ((preserve-regexp (concat "^\\("
(mapconcat (lambda (regexp)
(concat "\\(" regexp "\\)"))
@@ -1046,7 +1047,8 @@ without further confirmation."
(or (not new-modtime) ; nothing to overwrite
(equal desktop-file-modtime new-modtime)
(yes-or-no-p (if desktop-file-modtime
- (if (> (float-time new-modtime) (float-time desktop-file-modtime))
+ (if (time-less-p desktop-file-modtime
+ new-modtime)
"Desktop file is more recent than the one loaded. Save anyway? "
"Desktop file isn't the one loaded. Overwrite it? ")
"Current desktop was not loaded from a file. Overwrite this desktop file? "))
@@ -1238,7 +1240,13 @@ Using it may cause conflicts. Use it anyway? " owner)))))
;; disabled when loading the desktop fails with errors,
;; thus not overwriting the desktop with broken contents.
(setq desktop-autosave-was-enabled
- (memq 'desktop-auto-save-set-timer window-configuration-change-hook))
+ (memq 'desktop-auto-save-set-timer
+ ;; Use the toplevel value of the hook, in case some
+ ;; feature makes window-configuration-change-hook
+ ;; buffer-local, and puts there stuff which
+ ;; doesn't include our timer.
+ (default-toplevel-value
+ 'window-configuration-change-hook)))
(desktop-auto-save-disable)
;; Evaluate desktop buffer and remember when it was modified.
(setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))
@@ -1361,10 +1369,11 @@ Called by the timer created in `desktop-auto-save-set-timer'."
(desktop-save desktop-dirname nil t)))
(defun desktop-auto-save-set-timer ()
- "Set the auto-save timer.
+ "Set the desktop auto-save timer.
Cancel any previous timer. When `desktop-auto-save-timeout' is a positive
-integer, start a new idle timer to call `desktop-auto-save' repeatedly
-after that many seconds of idle time."
+integer, start a new idle timer to call `desktop-auto-save' after that many
+seconds of idle time.
+This function is called from `window-configuration-change-hook'."
(desktop-auto-save-cancel-timer)
(when (and (integerp desktop-auto-save-timeout)
(> desktop-auto-save-timeout 0))
@@ -1554,8 +1563,7 @@ and try to load that."
(setq buffer-display-time
(if buffer-display-time
(time-add buffer-display-time
- (time-subtract (current-time)
- desktop-file-modtime))
+ (time-subtract nil desktop-file-modtime))
(current-time)))
(unless (< desktop-file-version 208) ; Don't misinterpret any old custom args
(dolist (record compacted-vars)
diff --git a/lisp/dframe.el b/lisp/dframe.el
index f60fffe7a79..7f77d8991ff 100644
--- a/lisp/dframe.el
+++ b/lisp/dframe.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index ec07f9bf735..f1f7cf0b0ef 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1,4 +1,4 @@
-;;; dired-aux.el --- less commonly used parts of dired
+;;; dired-aux.el --- less commonly used parts of dired -*- lexical-binding: t -*-
;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2017 Free Software
;; Foundation, Inc.
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -51,6 +51,33 @@ into this list; they also should call `dired-log' to log the errors.")
(defconst dired-star-subst-regexp "\\(^\\|[ \t]\\)\\*\\([ \t]\\|$\\)")
(defconst dired-quark-subst-regexp "\\(^\\|[ \t]\\)\\?\\([ \t]\\|$\\)")
+(make-obsolete-variable 'dired-star-subst-regexp nil "26.1")
+(make-obsolete-variable 'dired-quark-subst-regexp nil "26.1")
+
+(defun dired-isolated-string-re (string)
+ "Return a regexp to match STRING isolated.
+Isolated means that STRING is surrounded by spaces or at the beginning/end
+of a string followed/prefixed with an space.
+The regexp capture the preceding blank, STRING and the following blank as
+the groups 1, 2 and 3 respectively."
+ (format "\\(\\`\\|[ \t]\\)\\(%s\\)\\([ \t]\\|\\'\\)" string))
+
+(defun dired--star-or-qmark-p (string match &optional keep)
+ "Return non-nil if STRING contains isolated MATCH or `\\=`?\\=`'.
+MATCH should be the strings \"?\", `\\=`?\\=`', \"*\" or nil. The latter
+means STRING contains either \"?\" or `\\=`?\\=`' or \"*\".
+If optional arg KEEP is non-nil, then preserve the match data. Otherwise,
+this function changes it and saves MATCH as the second match group.
+
+Isolated means that MATCH is surrounded by spaces or at the beginning/end
+of STRING followed/prefixed with an space. A match to `\\=`?\\=`',
+isolated or not, is also valid."
+ (let ((regexps (list (dired-isolated-string-re (if match (regexp-quote match) "[*?]")))))
+ (when (or (null match) (equal match "?"))
+ (setq regexps (append (list "\\(\\)\\(`\\?`\\)\\(\\)") regexps)))
+ (cl-some (lambda (x)
+ (funcall (if keep #'string-match-p #'string-match) x string))
+ regexps)))
;;;###autoload
(defun dired-diff (file &optional switches)
@@ -308,7 +335,7 @@ List has a form of (file-name full-file-name (attribute-list))."
failures)
(setq failures
(dired-bunch-files 10000
- (function dired-check-process)
+ #'dired-check-process
(append
(list operation program)
(unless (or (string-equal new-attribute "")
@@ -512,7 +539,7 @@ with a prefix argument."
;; If the file has numeric backup versions,
;; put on dired-file-version-alist an element of the form
;; (FILENAME . VERSION-NUMBER-LIST)
- (dired-map-dired-file-lines (function dired-collect-file-versions))
+ (dired-map-dired-file-lines #'dired-collect-file-versions)
;; Sort each VERSION-NUMBER-LIST,
;; and remove the versions not to be deleted.
(let ((fval dired-file-version-alist))
@@ -528,7 +555,7 @@ with a prefix argument."
(setq fval (cdr fval))))
;; Look at each file. If it is a numeric backup file,
;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
- (dired-map-dired-file-lines (function dired-trample-file-versions))
+ (dired-map-dired-file-lines #'dired-trample-file-versions)
(message "Cleaning numerical backups...done")))
;;; Subroutines of dired-clean-directory.
@@ -592,8 +619,9 @@ with a prefix argument."
This function is used to add all related commands retrieved by `mailcap'
to the end of the list of defaults just after the default value."
(interactive)
- (let ((commands (and (boundp 'files) (require 'mailcap nil t)
- (mailcap-file-default-commands files))))
+ (let* ((files minibuffer-completion-table)
+ (commands (and (require 'mailcap nil t)
+ (mailcap-file-default-commands files))))
(if (listp minibuffer-default)
(append minibuffer-default commands)
(cons minibuffer-default commands))))
@@ -611,6 +639,7 @@ This normally reads using `read-shell-command', but if the
offer a smarter default choice of shell command."
(minibuffer-with-setup-hook
(lambda ()
+ (set (make-local-variable 'minibuffer-completion-table) files)
(set (make-local-variable 'minibuffer-default-add-function)
'minibuffer-default-add-dired-shell-commands))
(setq prompt (format prompt (dired-mark-prompt arg files)))
@@ -658,13 +687,13 @@ If there is a `*' in COMMAND, surrounded by whitespace, this runs
COMMAND just once with the entire file list substituted there.
If there is no `*', but there is a `?' in COMMAND, surrounded by
-whitespace, this runs COMMAND on each file individually with the
-file name substituted for `?'.
+whitespace, or a `\\=`?\\=`' this runs COMMAND on each file
+individually with the file name substituted for `?' or `\\=`?\\=`'.
Otherwise, this runs COMMAND on each file individually with the
file name added at the end of COMMAND (separated by a space).
-`*' and `?' when not surrounded by whitespace have no special
+`*' and `?' when not surrounded by whitespace nor `\\=`' have no special
significance for `dired-do-shell-command', and are passed through
normally to the shell, but you must confirm first.
@@ -704,32 +733,38 @@ can be produced by `dired-get-marked-files', for example."
(dired-read-shell-command "! on %s: " current-prefix-arg files)
current-prefix-arg
files)))
- (let* ((on-each (not (string-match-p dired-star-subst-regexp command)))
- (no-subst (not (string-match-p dired-quark-subst-regexp command)))
- (star (string-match-p "\\*" command))
- (qmark (string-match-p "\\?" command)))
- ;; Get confirmation for wildcards that may have been meant
- ;; to control substitution of a file name or the file name list.
- (if (cond ((not (or on-each no-subst))
- (error "You can not combine `*' and `?' substitution marks"))
- ((and star on-each)
- (y-or-n-p (format-message
- "Confirm--do you mean to use `*' as a wildcard? ")))
- ((and qmark no-subst)
- (y-or-n-p (format-message
- "Confirm--do you mean to use `?' as a wildcard? ")))
- (t))
- (if on-each
- (dired-bunch-files
- (- 10000 (length command))
- (function (lambda (&rest files)
- (dired-run-shell-command
- (dired-shell-stuff-it command files t arg))))
- nil
- file-list)
- ;; execute the shell command
- (dired-run-shell-command
- (dired-shell-stuff-it command file-list nil arg))))))
+ (cl-flet ((need-confirm-p
+ (cmd str)
+ (let ((res cmd)
+ (regexp (regexp-quote str)))
+ ;; Drop all ? and * surrounded by spaces and `?`.
+ (while (and (string-match regexp res)
+ (dired--star-or-qmark-p res str))
+ (setq res (replace-match "" t t res 2)))
+ (string-match regexp res))))
+ (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep)))
+ (no-subst (not (dired--star-or-qmark-p command "?" 'keep)))
+ ;; Get confirmation for wildcards that may have been meant
+ ;; to control substitution of a file name or the file name list.
+ (ok (cond ((not (or on-each no-subst))
+ (error "You can not combine `*' and `?' substitution marks"))
+ ((need-confirm-p command "*")
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `*' as a wildcard? ")))
+ ((need-confirm-p command "?")
+ (y-or-n-p (format-message
+ "Confirm--do you mean to use `?' as a wildcard? ")))
+ (t))))
+ (when ok
+ (if on-each
+ (dired-bunch-files (- 10000 (length command))
+ (lambda (&rest files)
+ (dired-run-shell-command
+ (dired-shell-stuff-it command files t arg)))
+ nil file-list)
+ ;; execute the shell command
+ (dired-run-shell-command
+ (dired-shell-stuff-it command file-list nil arg)))))))
;; Might use {,} for bash or csh:
(defvar dired-mark-prefix ""
@@ -769,12 +804,10 @@ can be produced by `dired-get-marked-files', for example."
";"
"&"))
(stuff-it
- (if (or (string-match-p dired-star-subst-regexp command)
- (string-match-p dired-quark-subst-regexp command))
+ (if (dired--star-or-qmark-p command nil 'keep)
(lambda (x)
(let ((retval (concat cmd-prefix command)))
- (while (string-match
- "\\(^\\|[ \t]\\)\\([*?]\\)\\([ \t]\\|$\\)" retval)
+ (while (dired--star-or-qmark-p retval nil)
(setq retval (replace-match x t t retval 2)))
retval))
(lambda (x) (concat cmd-prefix command dired-mark-separator x)))))
@@ -981,7 +1014,7 @@ ARGS are command switches passed to PROGRAM.")
"Control the compression shell command for `dired-do-compress-to'.
Each element is (REGEXP . CMD), where REGEXP is the name of the
-archive to which you want to compress, and CMD the the
+archive to which you want to compress, and CMD is the
corresponding command.
Within CMD, %i denotes the input file(s), and %o denotes the
@@ -1122,7 +1155,7 @@ Return nil if no change in files."
(let ((files (dired-get-marked-files t arg nil t))
(string (if (eq op-symbol 'compress) "Compress or uncompress"
(capitalize (symbol-name op-symbol)))))
- (dired-mark-pop-up nil op-symbol files (function y-or-n-p)
+ (dired-mark-pop-up nil op-symbol files #'y-or-n-p
(concat string " "
(dired-mark-prompt arg files) "? ")))))
@@ -1190,7 +1223,7 @@ return t; if SYM is q or ESC, return nil."
(defun dired-do-compress (&optional arg)
"Compress or uncompress marked (or next ARG) files."
(interactive "P")
- (dired-map-over-marks-check (function dired-compress) arg 'compress t))
+ (dired-map-over-marks-check #'dired-compress arg 'compress t))
;; Commands for Emacs Lisp files - load and byte compile
@@ -1218,7 +1251,7 @@ return t; if SYM is q or ESC, return nil."
(defun dired-do-byte-compile (&optional arg)
"Byte compile marked (or next ARG) Emacs Lisp files."
(interactive "P")
- (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t))
+ (dired-map-over-marks-check #'dired-byte-compile arg 'byte-compile t))
(defun dired-load ()
;; Return nil for success, offending file name else.
@@ -1235,7 +1268,7 @@ return t; if SYM is q or ESC, return nil."
(defun dired-do-load (&optional arg)
"Load the marked (or next ARG) Emacs Lisp files."
(interactive "P")
- (dired-map-over-marks-check (function dired-load) arg 'load t))
+ (dired-map-over-marks-check #'dired-load arg 'load t))
;;;###autoload
(defun dired-do-redisplay (&optional arg test-for-subdir)
@@ -1308,7 +1341,7 @@ See Info node `(emacs)Subdir switches' for more details."
(defun dired-add-file (filename &optional marker-char)
(dired-fun-in-all-buffers
(file-name-directory filename) (file-name-nondirectory filename)
- (function dired-add-entry) filename marker-char))
+ #'dired-add-entry filename marker-char))
(defvar dired-omit-mode)
(declare-function dired-omit-regexp "dired-x" ())
@@ -1366,7 +1399,7 @@ files matching `dired-omit-regexp'."
;; else try to find correct place to insert
(if (dired-goto-subdir directory)
(progn ;; unhide if necessary
- (if (looking-at-p "\r")
+ (if (= (following-char) ?\r)
;; Point is at end of subdir line.
(dired-unhide-subdir))
;; found - skip subdir and `total' line
@@ -1445,7 +1478,7 @@ files matching `dired-omit-regexp'."
(defun dired-remove-file (file)
(dired-fun-in-all-buffers
(file-name-directory file) (file-name-nondirectory file)
- (function dired-remove-entry) file))
+ #'dired-remove-entry file))
(defun dired-remove-entry (file)
(save-excursion
@@ -1459,7 +1492,7 @@ files matching `dired-omit-regexp'."
"Create or update the line for FILE in all Dired buffers it would belong in."
(dired-fun-in-all-buffers (file-name-directory file)
(file-name-nondirectory file)
- (function dired-relist-entry) file))
+ #'dired-relist-entry file))
(defun dired-relist-entry (file)
;; Relist the line for FILE, or just add it if it did not exist.
@@ -1515,6 +1548,24 @@ Special value `always' suppresses confirmation."
(declare-function make-symbolic-link "fileio.c")
+(defcustom dired-create-destination-dirs nil
+ "Whether Dired should create destination dirs when copying/removing files.
+If nil, don't create them.
+If `always', create them without ask.
+If `ask', ask for user confirmation."
+ :type '(choice (const :tag "Never create non-existent dirs" nil)
+ (const :tag "Always create non-existent dirs" always)
+ (const :tag "Ask for user confirmation" ask))
+ :group 'dired
+ :version "27.1")
+
+(defun dired-maybe-create-dirs (dir)
+ "Create DIR if doesn't exist according to `dired-create-destination-dirs'."
+ (when (and dired-create-destination-dirs (not (file-exists-p dir)))
+ (if (or (eq dired-create-destination-dirs 'always)
+ (yes-or-no-p (format "Create destination dir `%s'? " dir)))
+ (dired-create-directory dir))))
+
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
(when (and (eq t (car (file-attributes from)))
@@ -1531,6 +1582,7 @@ Special value `always' suppresses confirmation."
(if (stringp (car attrs))
;; It is a symlink
(make-symbolic-link (car attrs) to ok-flag)
+ (dired-maybe-create-dirs (file-name-directory to))
(copy-file from to ok-flag preserve-time))
(file-date-error
(push (dired-make-relative from)
@@ -1540,6 +1592,7 @@ Special value `always' suppresses confirmation."
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
(dired-handle-overwrite newname)
+ (dired-maybe-create-dirs (file-name-directory newname))
(rename-file file newname ok-if-already-exists) ; error is caught in -create-files
;; Silently rename the visited file of any buffer visiting this file.
(and (get-file-buffer file)
@@ -1553,7 +1606,7 @@ Special value `always' suppresses confirmation."
(setq from-dir (file-name-as-directory from-dir)
to-dir (file-name-as-directory to-dir))
(dired-fun-in-all-buffers from-dir nil
- (function dired-rename-subdir-1) from-dir to-dir)
+ #'dired-rename-subdir-1 from-dir to-dir)
;; Update visited file name of all affected buffers
(let ((expanded-from-dir (expand-file-name from-dir))
(blist (buffer-list)))
@@ -1590,10 +1643,14 @@ Special value `always' suppresses confirmation."
(setq default-directory to
dired-directory (expand-file-name;; this is correct
;; with and without wildcards
- (file-name-nondirectory dired-directory)
+ (file-name-nondirectory (if (stringp dired-directory)
+ dired-directory
+ (car dired-directory)))
to))
(let ((new-name (file-name-nondirectory
- (directory-file-name dired-directory))))
+ (directory-file-name (if (stringp dired-directory)
+ dired-directory
+ (car dired-directory))))))
;; try to rename buffer, but just leave old name if new
;; name would already exist (don't try appending "<%d>")
(or (get-buffer new-name)
@@ -1788,7 +1845,7 @@ Optional arg HOW-TO determines how to treat the target.
For any other return value, TARGET is treated as a directory."
(or op1 (setq op1 operation))
(let* ((fn-list (dired-get-marked-files nil arg))
- (rfn-list (mapcar (function dired-make-relative) fn-list))
+ (rfn-list (mapcar #'dired-make-relative fn-list))
(dired-one-file ; fluid variable inside dired-create-files
(and (consp fn-list) (null (cdr fn-list)) (car fn-list)))
(target-dir (dired-dwim-target-directory))
@@ -1838,10 +1895,9 @@ Optional arg HOW-TO determines how to treat the target.
(if into-dir ; target is a directory
;; This function uses fluid variable target when called
;; inside dired-create-files:
- (function
- (lambda (from)
- (expand-file-name (file-name-nondirectory from) target)))
- (function (lambda (_from) target)))
+ (lambda (from)
+ (expand-file-name (file-name-nondirectory from) target))
+ (lambda (_from) target))
marker-char))))
;; Read arguments for a marked-files command that wants a file name,
@@ -1857,7 +1913,7 @@ Optional arg HOW-TO determines how to treat the target.
&optional default)
(dired-mark-pop-up
nil op-symbol files
- (function read-file-name)
+ #'read-file-name
(format prompt (dired-mark-prompt arg files)) dir default))
(defun dired-dwim-target-directory ()
@@ -1929,6 +1985,7 @@ Optional arg HOW-TO determines how to treat the target.
;;;###autoload
(defun dired-create-directory (directory)
"Create a directory called DIRECTORY.
+Parent directories of DIRECTORY are created as needed.
If DIRECTORY already exists, signal an error."
(interactive
(list (read-file-name "Create directory: " (dired-current-directory))))
@@ -1985,7 +2042,7 @@ This command copies symbolic links by creating new ones, similar
to the \"-d\" option for the \"cp\" shell command."
(interactive "P")
(let ((dired-recursive-copies dired-recursive-copies))
- (dired-do-create-files 'copy (function dired-copy-file)
+ (dired-do-create-files 'copy #'dired-copy-file
"Copy"
arg dired-keep-marker-copy
nil dired-copy-how-to-fn)))
@@ -2002,7 +2059,7 @@ suggested for the target directory depends on the value of
For relative symlinks, use \\[dired-do-relsymlink]."
(interactive "P")
- (dired-do-create-files 'symlink (function make-symbolic-link)
+ (dired-do-create-files 'symlink #'make-symbolic-link
"Symlink" arg dired-keep-marker-symlink))
;;;###autoload
@@ -2015,7 +2072,7 @@ with the same names that the files currently have. The default
suggested for the target directory depends on the value of
`dired-dwim-target', which see."
(interactive "P")
- (dired-do-create-files 'hardlink (function dired-hardlink)
+ (dired-do-create-files 'hardlink #'dired-hardlink
"Hardlink" arg dired-keep-marker-hardlink))
(defun dired-hardlink (file newname &optional ok-if-already-exists)
@@ -2034,7 +2091,7 @@ This command also renames any buffers that are visiting the files.
The default suggested for the target directory depends on the value
of `dired-dwim-target', which see."
(interactive "P")
- (dired-do-create-files 'move (function dired-rename-file)
+ (dired-do-create-files 'move #'dired-rename-file
"Move" arg dired-keep-marker-rename "Rename"))
;;;###end dired-cp.el
@@ -2062,37 +2119,35 @@ Type SPC or `y' to %s one match, DEL or `n' to skip to next,
(regexp-name-constructor
;; Function to construct new filename using REGEXP and NEWNAME:
(if whole-name ; easy (but rare) case
- (function
- (lambda (from)
- (let ((to (dired-string-replace-match regexp from newname))
- ;; must bind help-form directly around call to
- ;; dired-query
- (help-form rename-regexp-help-form))
- (if to
- (and (dired-query 'rename-regexp-query
- operation-prompt
- from
- to)
- to)
- (dired-log "%s: %s did not match regexp %s\n"
- operation from regexp)))))
- ;; not whole-name, replace non-directory part only
- (function
- (lambda (from)
- (let* ((new (dired-string-replace-match
- regexp (file-name-nondirectory from) newname))
- (to (and new ; nil means there was no match
- (expand-file-name new
- (file-name-directory from))))
+ (lambda (from)
+ (let ((to (dired-string-replace-match regexp from newname))
+ ;; must bind help-form directly around call to
+ ;; dired-query
(help-form rename-regexp-help-form))
- (if to
- (and (dired-query 'rename-regexp-query
- operation-prompt
- (dired-make-relative from)
- (dired-make-relative to))
- to)
- (dired-log "%s: %s did not match regexp %s\n"
- operation (file-name-nondirectory from) regexp)))))))
+ (if to
+ (and (dired-query 'rename-regexp-query
+ operation-prompt
+ from
+ to)
+ to)
+ (dired-log "%s: %s did not match regexp %s\n"
+ operation from regexp))))
+ ;; not whole-name, replace non-directory part only
+ (lambda (from)
+ (let* ((new (dired-string-replace-match
+ regexp (file-name-nondirectory from) newname))
+ (to (and new ; nil means there was no match
+ (expand-file-name new
+ (file-name-directory from))))
+ (help-form rename-regexp-help-form))
+ (if to
+ (and (dired-query 'rename-regexp-query
+ operation-prompt
+ (dired-make-relative from)
+ (dired-make-relative to))
+ to)
+ (dired-log "%s: %s did not match regexp %s\n"
+ operation (file-name-nondirectory from) regexp))))))
rename-regexp-query)
(dired-create-files
file-creator operation fn-list regexp-name-constructor marker-char)))
@@ -2130,7 +2185,7 @@ With a zero prefix arg, renaming by regexp affects the absolute file name.
Normally, only the non-directory part of the file name is used and changed."
(interactive (dired-mark-read-regexp "Rename"))
(dired-do-create-files-regexp
- (function dired-rename-file)
+ #'dired-rename-file
"Rename" arg regexp newname whole-name dired-keep-marker-rename))
;;;###autoload
@@ -2140,7 +2195,7 @@ See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "Copy"))
(let ((dired-recursive-copies nil)) ; No recursive copies.
(dired-do-create-files-regexp
- (function dired-copy-file)
+ #'dired-copy-file
(if dired-copy-preserve-time "Copy [-p]" "Copy")
arg regexp newname whole-name dired-keep-marker-copy)))
@@ -2150,7 +2205,7 @@ See function `dired-do-rename-regexp' for more info."
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "HardLink"))
(dired-do-create-files-regexp
- (function add-name-to-file)
+ #'add-name-to-file
"HardLink" arg regexp newname whole-name dired-keep-marker-hardlink))
;;;###autoload
@@ -2159,7 +2214,7 @@ See function `dired-do-rename-regexp' for more info."
See function `dired-do-rename-regexp' for more info."
(interactive (dired-mark-read-regexp "SymLink"))
(dired-do-create-files-regexp
- (function make-symbolic-link)
+ #'make-symbolic-link
"SymLink" arg regexp newname whole-name dired-keep-marker-symlink))
(defvar rename-non-directory-query)
@@ -2174,39 +2229,38 @@ See function `dired-do-rename-regexp' for more info."
file-creator
operation
(dired-get-marked-files nil arg)
- (function
- (lambda (from)
- (let ((to (concat (file-name-directory from)
- (funcall basename-constructor
- (file-name-nondirectory from)))))
- (and (let ((help-form (format-message "\
+ (lambda (from)
+ (let ((to (concat (file-name-directory from)
+ (funcall basename-constructor
+ (file-name-nondirectory from)))))
+ (and (let ((help-form (format-message "\
Type SPC or `y' to %s one file, DEL or `n' to skip to next,
`!' to %s all remaining matches with no more questions."
- (downcase operation)
- (downcase operation))))
- (dired-query 'rename-non-directory-query
- (concat operation " `%s' to `%s'")
- (dired-make-relative from)
- (dired-make-relative to)))
- to))))
+ (downcase operation)
+ (downcase operation))))
+ (dired-query 'rename-non-directory-query
+ (concat operation " `%s' to `%s'")
+ (dired-make-relative from)
+ (dired-make-relative to)))
+ to)))
dired-keep-marker-rename)))
(defun dired-rename-non-directory (basename-constructor operation arg)
(dired-create-files-non-directory
- (function dired-rename-file)
+ #'dired-rename-file
basename-constructor operation arg))
;;;###autoload
(defun dired-upcase (&optional arg)
"Rename all marked (or next ARG) files to upper case."
(interactive "P")
- (dired-rename-non-directory (function upcase) "Rename upcase" arg))
+ (dired-rename-non-directory #'upcase "Rename upcase" arg))
;;;###autoload
(defun dired-downcase (&optional arg)
"Rename all marked (or next ARG) files to lower case."
(interactive "P")
- (dired-rename-non-directory (function downcase) "Rename downcase" arg))
+ (dired-rename-non-directory #'downcase "Rename downcase" arg))
;;;###end dired-re.el
@@ -2316,12 +2370,11 @@ This function takes some pains to conform to `ls -lR' output."
(when real-switches
(let (case-fold-search)
(mapcar
- (function
- (lambda (x)
- (or (eq (null (string-match-p x real-switches))
- (null (string-match-p x dired-actual-switches)))
- (error
- "Can't have dirs with and without -%s switches together" x))))
+ (lambda (x)
+ (or (eq (null (string-match-p x real-switches))
+ (null (string-match-p x dired-actual-switches)))
+ (error
+ "Can't have dirs with and without -%s switches together" x)))
;; all switches that make a difference to dired-get-filename:
'("F" "b"))))))
@@ -2334,9 +2387,9 @@ This function takes some pains to conform to `ls -lR' output."
;; Keep the alist sorted on buffer position.
(setq dired-subdir-alist
(sort dired-subdir-alist
- (function (lambda (elt1 elt2)
- (> (dired-get-subdir-min elt1)
- (dired-get-subdir-min elt2)))))))
+ (lambda (elt1 elt2)
+ (> (dired-get-subdir-min elt1)
+ (dired-get-subdir-min elt2))))))
(defun dired-kill-tree (dirname &optional remember-marks kill-root)
"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
@@ -2611,7 +2664,7 @@ Lower levels are unaffected."
(and selective-display
(save-excursion
(dired-goto-subdir dir)
- (looking-at-p "\r"))))
+ (= (following-char) ?\r))))
;;;###autoload
(defun dired-hide-subdir (arg)
@@ -2715,9 +2768,9 @@ Intended to be added to `isearch-mode-hook'."
(remove-hook 'isearch-mode-end-hook 'dired-isearch-filenames-end t))
(defun dired-isearch-filter-filenames (beg end)
- "Test whether the current search hit is a file name.
-Return non-nil if the text from BEG to END is part of a file
-name (has the text property `dired-filename')."
+ "Test whether some part of the current search match is inside a file name.
+This function returns non-nil if some part of the text between BEG and END
+is part of a file name (i.e., has the text property `dired-filename')."
(text-property-not-all (min beg end) (max beg end)
'dired-filename nil))
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
index 527685acf37..5fa28d3e3e8 100644
--- a/lisp/dired-x.el
+++ b/lisp/dired-x.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -57,7 +57,7 @@
(defcustom dired-bind-vm nil
"Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'.
-RMAIL files in the old Babyl format (used before before Emacs 23.1)
+RMAIL files in the old Babyl format (used before Emacs 23.1)
contain \"-*- rmail -*-\" at the top, so `dired-find-file'
will run `rmail' on these files. New RMAIL files use the standard
mbox format, and so cannot be distinguished in this way."
@@ -243,6 +243,12 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used."
:type 'boolean
:group 'dired-x)
+(defcustom dired-clean-confirm-killing-deleted-buffers t
+ "If nil, don't ask whether to kill buffers visiting deleted files."
+ :version "26.1"
+ :type 'boolean
+ :group 'dired-x)
+
;;; KEY BINDINGS.
(define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode)
@@ -546,7 +552,9 @@ Should never be used as marker by the user or other packages.")
(interactive)
(let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files
(dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp
- (dired-omit-case-fold-p dired-directory)))
+ (dired-omit-case-fold-p (if (stringp dired-directory)
+ dired-directory
+ (car dired-directory)))))
(defcustom dired-omit-extensions
(append completion-ignored-extensions
@@ -591,7 +599,9 @@ This functions works by temporarily binding `dired-marker-char' to
(let ((dired-marker-char dired-omit-marker-char))
(when dired-omit-verbose (message "Omitting..."))
(if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp
- (dired-omit-case-fold-p dired-directory))
+ (dired-omit-case-fold-p (if (stringp dired-directory)
+ dired-directory
+ (car dired-directory))))
(progn
(setq count (dired-do-kill-lines
nil
@@ -634,7 +644,7 @@ Optional fifth argument CASE-FOLD-P specifies the value of
(dired-mark-if
(and
;; not already marked
- (looking-at-p " ")
+ (= (following-char) ?\s)
;; uninteresting
(let ((fn (dired-get-filename localp t))
;; Match patterns case-insensitively on case-insensitive
@@ -1530,7 +1540,7 @@ refer at all to the underlying file system. Contrast this with
(setq mode (buffer-substring (point) (+ mode-len (point))))
(forward-char mode-len)
;; Skip any extended attributes marker ("." or "+").
- (or (looking-at " ")
+ (or (= (following-char) ?\s)
(forward-char 1))
(setq nlink (read (current-buffer)))
;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid.
@@ -1625,10 +1635,11 @@ Binding direction based on `dired-x-hands-off-my-keys'."
(if (called-interactively-p 'interactive)
(setq dired-x-hands-off-my-keys
(not (y-or-n-p "Bind dired-x-find-file over find-file? "))))
- (define-key (current-global-map) [remap find-file]
- (if (not dired-x-hands-off-my-keys) 'dired-x-find-file))
- (define-key (current-global-map) [remap find-file-other-window]
- (if (not dired-x-hands-off-my-keys) 'dired-x-find-file-other-window)))
+ (unless dired-x-hands-off-my-keys
+ (define-key (current-global-map) [remap find-file]
+ 'dired-x-find-file)
+ (define-key (current-global-map) [remap find-file-other-window]
+ 'dired-x-find-file-other-window)))
;; Now call it so binding is correct. This could go in the :initialize
;; slot, but then dired-x-bind-find-file has to be defined before the
diff --git a/lisp/dired.el b/lisp/dired.el
index 909735a3b54..ba762277ae7 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -34,6 +34,7 @@
;;; Code:
+(eval-when-compile (require 'subr-x))
;; When bootstrapping dired-loaddefs has not been generated.
(require 'dired-loaddefs nil t)
@@ -60,7 +61,7 @@ May contain all other options that don't contradict `-l';
may contain even `F', `b', `i' and `s'. See also the variable
`dired-ls-F-marks-symlinks' concerning the `F' switch.
Options that include embedded whitespace must be quoted
-like this: \\\"--option=value with spaces\\\"; you can use
+like this: \"--option=value with spaces\"; you can use
`combine-and-quote-strings' to produce the correct quoting of
each option.
On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
@@ -133,7 +134,7 @@ always set this variable to t."
:type 'boolean
:group 'dired-mark)
-(defcustom dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#")
+(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#")
"Regexp of files to skip when finding first file of a directory.
A value of nil means move to the subdir line.
A value of t means move to first file."
@@ -197,8 +198,10 @@ The target is used in the prompt for file copy, rename etc."
; These variables were deleted and the replacements are on files.el.
; We leave aliases behind for back-compatibility.
-(defvaralias 'dired-free-space-program 'directory-free-space-program)
-(defvaralias 'dired-free-space-args 'directory-free-space-args)
+(define-obsolete-variable-alias 'dired-free-space-program
+ 'directory-free-space-program "27.1")
+(define-obsolete-variable-alias 'dired-free-space-args
+ 'directory-free-space-args "27.1")
;;; Hook variables
@@ -335,9 +338,8 @@ The directory name must be absolute, but need not be fully expanded.")
(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d[^:]"))
(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l[^:]"))
(defvar dired-re-exe;; match ls permission string of an executable file
- (mapconcat (function
- (lambda (x)
- (concat dired-re-maybe-mark dired-re-inode-size x)))
+ (mapconcat (lambda (x)
+ (concat dired-re-maybe-mark dired-re-inode-size x))
'("-[-r][-w][xs][-r][-w].[-r][-w]."
"-[-r][-w].[-r][-w][xs][-r][-w]."
"-[-r][-w].[-r][-w].[-r][-w][xst]")
@@ -607,9 +609,9 @@ marked file, return (t FILENAME) instead of (FILENAME)."
(progn ;; no save-excursion, want to move point.
(dired-repeat-over-lines
,arg
- (function (lambda ()
- (if ,show-progress (sit-for 0))
- (setq results (cons ,body results)))))
+ (lambda ()
+ (if ,show-progress (sit-for 0))
+ (setq results (cons ,body results))))
(if (< ,arg 0)
(nreverse results)
results))
@@ -786,7 +788,7 @@ Type \\[describe-mode] after entering Dired for more info.
If DIRNAME is already in a Dired buffer, that buffer is used without refresh."
;; Cannot use (interactive "D") because of wildcards.
(interactive (dired-read-dir-and-switches ""))
- (switch-to-buffer (dired-noselect dirname switches)))
+ (pop-to-buffer-same-window (dired-noselect dirname switches)))
;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
;;;###autoload
@@ -872,14 +874,56 @@ periodically reverts at specified time intervals."
:group 'dired
:version "23.2")
+(defun dired--need-align-p ()
+ "Return non-nil if some file names are misaligned.
+The return value is the target column for the file names."
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ ;; Use point difference instead of `current-column', because
+ ;; the former works when `dired-hide-details-mode' is enabled.
+ (let* ((first (- (point) (point-at-bol)))
+ (target first))
+ (while (and (not (eobp))
+ (progn
+ (forward-line)
+ (dired-move-to-filename)))
+ (when-let* ((distance (- (point) (point-at-bol)))
+ (higher (> distance target)))
+ (setq target distance)))
+ (and (/= first target) target))))
+
+(defun dired--align-all-files ()
+ "Align all files adding spaces in front of the size column."
+ (let ((target (dired--need-align-p))
+ (regexp directory-listing-before-filename-regexp))
+ (when target
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (while (dired-move-to-filename)
+ ;; Use point difference instead of `current-column', because
+ ;; the former works when `dired-hide-details-mode' is enabled.
+ (let ((distance (- target (- (point) (point-at-bol))))
+ (inhibit-read-only t))
+ (unless (zerop distance)
+ (re-search-backward regexp nil t)
+ (goto-char (match-beginning 0))
+ (search-backward-regexp "[[:space:]]" nil t)
+ (skip-chars-forward "[:space:]")
+ (insert-char ?\s distance 'inherit))
+ (forward-line)))))))
+
(defun dired-internal-noselect (dir-or-list &optional switches mode)
- ;; If there is an existing dired buffer for DIRNAME, just leave
- ;; buffer as it is (don't even call dired-revert).
+ ;; If DIR-OR-LIST is a string and there is an existing dired buffer
+ ;; for it, just leave buffer as it is (don't even call dired-revert).
;; This saves time especially for deep trees or with ange-ftp.
;; The user can type `g' easily, and it is more consistent with find-file.
;; But if SWITCHES are given they are probably different from the
;; buffer's old value, so call dired-sort-other, which does
;; revert the buffer.
+ ;; Revert the buffer if DIR-OR-LIST is a cons or `dired-directory'
+ ;; is a cons and DIR-OR-LIST is a string.
;; A pity we can't possibly do "Directory has changed - refresh? "
;; like find-file does.
;; Optional argument MODE is passed to dired-find-buffer-nocreate,
@@ -899,6 +943,11 @@ periodically reverts at specified time intervals."
(setq dired-directory dir-or-list)
;; this calls dired-revert
(dired-sort-other switches))
+ ;; Always revert when `dir-or-list' is a cons. Also revert
+ ;; if `dired-directory' is a cons but `dir-or-list' is not.
+ ((or (consp dir-or-list) (consp dired-directory))
+ (setq dired-directory dir-or-list)
+ (revert-buffer))
;; Always revert regardless of whether it has changed or not.
((eq dired-auto-revert-buffer t)
(revert-buffer))
@@ -914,11 +963,12 @@ periodically reverts at specified time intervals."
"Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
;; Else a new buffer
(setq default-directory
- ;; We can do this unconditionally
- ;; because dired-noselect ensures that the name
- ;; is passed in directory name syntax
- ;; if it was the name of a directory at all.
- (file-name-directory dirname))
+ (or (car-safe (insert-directory-wildcard-in-dir-p dirname))
+ ;; We can do this unconditionally
+ ;; because dired-noselect ensures that the name
+ ;; is passed in directory name syntax
+ ;; if it was the name of a directory at all.
+ (file-name-directory dirname)))
(or switches (setq switches dired-listing-switches))
(if mode (funcall mode)
(dired-mode dir-or-list switches))
@@ -933,6 +983,8 @@ periodically reverts at specified time intervals."
(if failed (kill-buffer buffer))))
(goto-char (point-min))
(dired-initial-position dirname))
+ (when (consp dired-directory)
+ (dired--align-all-files))
(set-buffer old-buf)
buffer))
@@ -996,7 +1048,7 @@ wildcards, erases the buffer, and builds the subdir-alist anew
;; default-directory and dired-actual-switches must be buffer-local
;; and initialized by now.
(let (dirname
- ;; This makes readin much much faster.
+ ;; This makes read-in much faster.
;; In particular, it prevents the font lock hook from running
;; until the directory is all read in.
(inhibit-modification-hooks t))
@@ -1050,13 +1102,14 @@ wildcards, erases the buffer, and builds the subdir-alist anew
(not file-list))
;; If we are reading a whole single directory...
(dired-insert-directory dir dired-actual-switches nil nil t)
- (if (not (file-readable-p
- (directory-file-name (file-name-directory dir))))
- (error "Directory %s inaccessible or nonexistent" dir)
- ;; Else treat it as a wildcard spec
- ;; unless we have an explicit list of files.
- (dired-insert-directory dir dired-actual-switches
- file-list (not file-list) t)))))
+ (if (and (not (insert-directory-wildcard-in-dir-p dir))
+ (not (file-readable-p
+ (directory-file-name (file-name-directory dir)))))
+ (error "Directory %s inaccessible or nonexistent" dir))
+ ;; Else treat it as a wildcard spec
+ ;; unless we have an explicit list of files.
+ (dired-insert-directory dir dired-actual-switches
+ file-list (not file-list) t))))
(defun dired-align-file (beg end)
"Align the fields of a file to the ones of surrounding lines.
@@ -1154,7 +1207,7 @@ BEG..END is the line where the file info is located."
(setq file-col (+ spaces file-col))
(if (> file-col other-col)
(setq spaces (- spaces (- file-col other-col))))
- (insert-char ?\s spaces)
+ (insert-char ?\s spaces 'inherit)
;; Let's just make really sure we did not mess up.
(unless (save-excursion
(eq (dired-move-to-filename) (marker-position file)))
@@ -1201,29 +1254,56 @@ If HDR is non-nil, insert a header line with the directory name."
;; as indicated by `ls-lisp-use-insert-directory-program'.
(not (and (featurep 'ls-lisp)
(null ls-lisp-use-insert-directory-program)))
- (or (if (eq dired-use-ls-dired 'unspecified)
+ (not (and (featurep 'eshell)
+ (bound-and-true-p eshell-ls-use-in-dired)))
+ (or (file-remote-p dir)
+ (if (eq dired-use-ls-dired 'unspecified)
;; Check whether "ls --dired" gives exit code 0, and
;; save the answer in `dired-use-ls-dired'.
(or (setq dired-use-ls-dired
(eq 0 (call-process insert-directory-program
- nil nil nil "--dired")))
+ nil nil nil "--dired")))
(progn
(message "ls does not support --dired; \
see `dired-use-ls-dired' for more details.")
nil))
- dired-use-ls-dired)
- (file-remote-p dir)))
+ dired-use-ls-dired)))
(setq switches (concat "--dired " switches)))
- ;; We used to specify the C locale here, to force English month names;
- ;; but this should not be necessary any more,
- ;; with the new value of `directory-listing-before-filename-regexp'.
- (if file-list
- (dolist (f file-list)
- (let ((beg (point)))
- (insert-directory f switches nil nil)
- ;; Re-align fields, if necessary.
- (dired-align-file beg (point))))
- (insert-directory dir switches wildcard (not wildcard)))
+ ;; Expand directory wildcards and fill file-list.
+ (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir)))
+ (cond (dir-wildcard
+ (setq switches (concat "-d " switches))
+ ;; We don't know whether the remote ls supports
+ ;; "--dired", so we cannot add it to the `process-file'
+ ;; call for wildcards.
+ (when (file-remote-p dir)
+ (setq switches (dired-replace-in-string "--dired" "" switches)))
+ (let* ((default-directory (car dir-wildcard))
+ (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 "sh")))
+ (switch (if remotep "-c" shell-command-switch)))
+ (unless
+ (zerop
+ (process-file sh nil (current-buffer) nil switch script))
+ (user-error
+ "%s: No files matching wildcard" (cdr dir-wildcard)))
+ (insert-directory-clean (point) switches)))
+ (t
+ ;; We used to specify the C locale here, to force English
+ ;; month names; but this should not be necessary any
+ ;; more, with the new value of
+ ;; `directory-listing-before-filename-regexp'.
+ (if file-list
+ (dolist (f file-list)
+ (let ((beg (point)))
+ (insert-directory f switches nil nil)
+ ;; Re-align fields, if necessary.
+ (dired-align-file beg (point))))
+ (insert-directory dir switches wildcard (not wildcard))))))
;; Quote certain characters, unless ls quoted them for us.
(if (not (dired-switches-escape-p dired-actual-switches))
(save-excursion
@@ -1273,11 +1353,14 @@ see `dired-use-ls-dired' for more details.")
;; Note that dired-build-subdir-alist will replace the name
;; by its expansion, so it does not matter whether what we insert
;; here is fully expanded, but it should be absolute.
- (insert " " (directory-file-name (file-name-directory dir)) ":\n")
+ (insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir))
+ (directory-file-name (file-name-directory dir))) ":\n")
(setq content-point (point)))
(when wildcard
;; Insert "wildcard" line where "total" line would be for a full dir.
- (insert " wildcard " (file-name-nondirectory dir) "\n")))
+ (insert " wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir))
+ (file-name-nondirectory dir))
+ "\n")))
(dired-insert-set-properties content-point (point)))))
(defun dired-insert-set-properties (beg end)
@@ -1363,18 +1446,22 @@ ARG and NOCONFIRM, passed from `revert-buffer', are ignored."
The positions have the form (BUFFER-POSITION WINDOW-POSITIONS).
BUFFER-POSITION is the point position in the current Dired buffer.
-It has the form (BUFFER DIRED-FILENAME BUFFER-POINT).
+It has the form (BUFFER DIRED-FILENAME BUFFER-LINE-NUMBER).
WINDOW-POSITIONS are current positions in all windows displaying
this dired buffer. The window positions have the form (WINDOW
-DIRED-FILENAME WINDOW-POINT)."
+DIRED-FILENAME WINDOW-LINE-NUMBER).
+
+We store line numbers instead of point positions because the header
+lines might change as well: when this happen the line number doesn't
+change; the point does."
(list
- (list (current-buffer) (dired-get-filename nil t) (point))
+ (list (current-buffer) (dired-get-filename nil t) (line-number-at-pos))
(mapcar (lambda (w)
- (list w
- (with-selected-window w
- (dired-get-filename nil t))
- (window-point w)))
+ (with-selected-window w
+ (list w
+ (dired-get-filename nil t)
+ (line-number-at-pos (window-point w)))))
(get-buffer-window-list nil 0 t))))
(defun dired-restore-positions (positions)
@@ -1383,7 +1470,8 @@ DIRED-FILENAME WINDOW-POINT)."
(buffer (nth 0 buf-file-pos)))
(unless (and (nth 1 buf-file-pos)
(dired-goto-file (nth 1 buf-file-pos)))
- (goto-char (nth 2 buf-file-pos))
+ (goto-char (point-min))
+ (forward-line (1- (nth 2 buf-file-pos)))
(dired-move-to-filename))
(dolist (win-file-pos (nth 1 positions))
;; Ensure that window still displays the original buffer.
@@ -1391,7 +1479,8 @@ DIRED-FILENAME WINDOW-POINT)."
(with-selected-window (nth 0 win-file-pos)
(unless (and (nth 1 win-file-pos)
(dired-goto-file (nth 1 win-file-pos)))
- (goto-char (nth 2 win-file-pos))
+ (goto-char (point-min))
+ (forward-line (1- (nth 2 win-file-pos)))
(dired-move-to-filename)))))))
(defun dired-remember-marks (beg end)
@@ -1995,8 +2084,8 @@ Keybindings:
;; Ignore dired-hide-details-* value of invisible text property by default.
(when (eq buffer-invisibility-spec t)
(setq buffer-invisibility-spec (list t)))
- (setq-local revert-buffer-function (function dired-revert))
- (setq-local buffer-stale-function (function dired-buffer-stale-p))
+ (setq-local revert-buffer-function #'dired-revert)
+ (setq-local buffer-stale-function #'dired-buffer-stale-p)
(setq-local page-delimiter "\n\n")
(setq-local dired-directory (or dirname default-directory))
;; list-buffers uses this to display the dir being edited in this buffer.
@@ -2139,16 +2228,23 @@ directory in another window."
(find-file (dired-get-file-for-visit))))
(defun dired-find-alternate-file ()
- "In Dired, visit this file or directory instead of the Dired buffer."
+ "In Dired, visit file or directory on current line via `find-alternate-file'.
+This kills the Dired buffer, then visits the current line's file or directory."
(interactive)
(set-buffer-modified-p nil)
(find-alternate-file (dired-get-file-for-visit)))
;; Don't override the setting from .emacs.
;;;###autoload (put 'dired-find-alternate-file 'disabled t)
-(defun dired-mouse-find-file-other-window (event)
- "In Dired, visit the file or directory name you click on."
+(defun dired-mouse-find-file (event &optional find-file-func find-dir-func)
+ "In Dired, visit the file or directory name you click on.
+The optional arguments FIND-FILE-FUNC and FIND-DIR-FUNC specify
+functions to visit the file and directory, respectively. If
+omitted or nil, these arguments default to `find-file' and `dired',
+respectively."
(interactive "e")
+ (or find-file-func (setq find-file-func 'find-file))
+ (or find-dir-func (setq find-dir-func 'dired))
(let (window pos file)
(save-excursion
(setq window (posn-window (event-end event))
@@ -2163,9 +2259,19 @@ directory in another window."
(dired-goto-subdir file))
(progn
(select-window window)
- (dired-other-window file)))
+ (funcall find-dir-func file)))
(select-window window)
- (find-file-other-window (file-name-sans-versions file t)))))
+ (funcall 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."
+ (interactive "e")
+ (dired-mouse-find-file event 'find-file-other-window 'dired-other-window))
+
+(defun dired-mouse-find-file-other-frame (event)
+ "In Dired, visit the file or directory name you click on in another frame."
+ (interactive "e")
+ (dired-mouse-find-file event 'find-file-other-frame 'dired-other-frame))
(defun dired-view-file ()
"In Dired, examine a file in view mode, returning to Dired when done.
@@ -2245,10 +2351,7 @@ Otherwise, an error occurs in these cases."
(if (and enable-multibyte-characters
(not (multibyte-string-p file)))
(setq file (string-to-multibyte file)))))
- (and file (file-name-absolute-p file)
- ;; A relative file name can start with ~.
- ;; Don't treat it as absolute in this context.
- (not (eq (aref file 0) ?~))
+ (and file (files--name-absolute-system-p file)
(setq already-absolute t))
(cond
((null file)
@@ -2469,7 +2572,7 @@ You can then feed the file name(s) to other commands with \\[yank]."
(interactive "P")
(let ((string
(or (dired-get-subdir)
- (mapconcat (function identity)
+ (mapconcat #'identity
(if arg
(cond ((zerop (prefix-numeric-value arg))
(dired-get-marked-files))
@@ -2894,6 +2997,37 @@ Any other value means to ask for each directory."
;; Match anything but `.' and `..'.
(defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
+(defconst dired-delete-help
+ "Type:
+`yes' to delete recursively the current directory,
+`no' to skip to next,
+`all' to delete all remaining directories with no more questions,
+`quit' to exit,
+`help' to show this help message.")
+
+(defun dired--yes-no-all-quit-help (prompt &optional help-msg)
+ "Ask a question with valid answers: yes, no, all, quit, help.
+PROMPT must end with '? ', for instance, 'Delete it? '.
+If optional arg HELP-MSG is non-nil, then is a message to show when
+the user answers 'help'. Otherwise, default to `dired-delete-help'."
+ (let ((valid-answers (list "yes" "no" "all" "quit"))
+ (answer "")
+ (input-fn (lambda ()
+ (read-string
+ (format "%s [yes, no, all, quit, help] " prompt)))))
+ (setq answer (funcall input-fn))
+ (when (string= answer "help")
+ (with-help-window "*Help*"
+ (with-current-buffer "*Help*"
+ (insert (or help-msg dired-delete-help)))))
+ (while (not (member answer valid-answers))
+ (unless (string= answer "help")
+ (beep)
+ (message "Please answer `yes' or `no' or `all' or `quit'")
+ (sleep-for 2))
+ (setq answer (funcall input-fn)))
+ answer))
+
;; Delete file, possibly delete a directory and all its files.
;; This function is useful outside of dired. One could change its name
;; to e.g. recursive-delete-file and put it somewhere else.
@@ -2909,23 +3043,27 @@ its possible values is:
TRASH non-nil means to trash the file instead of deleting, provided
`delete-by-moving-to-trash' (which see) is non-nil."
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (if (not (eq t (car (file-attributes file))))
- (delete-file file trash)
- (if (and recursive
- (directory-files file t dired-re-no-dot) ; Not empty.
- (or (eq recursive 'always)
- (yes-or-no-p (format "Recursively %s %s? "
- (if (and trash
- delete-by-moving-to-trash)
- "trash"
- "delete")
- (dired-make-relative file)))))
- (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
- (setq recursive nil))
- (delete-directory file recursive trash)))
+ ;; This test is equivalent to
+ ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+ ;; but more efficient
+ (if (not (eq t (car (file-attributes file))))
+ (delete-file file trash)
+ (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot))))
+ (if (and recursive (not empty-dir-p))
+ (unless (eq recursive 'always)
+ (let ((prompt
+ (format "Recursively %s %s? "
+ (if (and trash delete-by-moving-to-trash)
+ "trash"
+ "delete")
+ (dired-make-relative file))))
+ (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
+ ('"all" (setq recursive 'always dired-recursive-deletes recursive))
+ ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
+ ('"no" (setq recursive nil))
+ ('"quit" (keyboard-quit)))))
+ (setq recursive nil)) ; Empty dir or recursive is nil.
+ (delete-directory file recursive trash))))
(defun dired-do-flagged-delete (&optional nomessage)
"In Dired, delete the files flagged for deletion.
@@ -2940,9 +3078,10 @@ non-empty directories is allowed."
(if (save-excursion (goto-char (point-min))
(re-search-forward regexp nil t))
(dired-internal-do-deletions
- ;; this can't move point since ARG is nil
- (dired-map-over-marks (cons (dired-get-filename) (point))
- nil)
+ (nreverse
+ ;; this can't move point since ARG is nil
+ (dired-map-over-marks (cons (dired-get-filename) (point))
+ nil))
nil t)
(or nomessage
(message "(No deletions requested)")))))
@@ -2955,9 +3094,10 @@ non-empty directories is allowed."
;; dired-do-flagged-delete.
(interactive "P")
(dired-internal-do-deletions
- ;; this may move point if ARG is an integer
- (dired-map-over-marks (cons (dired-get-filename) (point))
- arg)
+ (nreverse
+ ;; this may move point if ARG is an integer
+ (dired-map-over-marks (cons (dired-get-filename) (point))
+ arg))
arg t))
(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
@@ -2971,18 +3111,22 @@ non-empty directories is allowed."
;; lines still to be changed, so the (point) values in L stay valid.
;; Also, for subdirs in natural order, a subdir's files are deleted
;; before the subdir itself - the other way around would not work.
- (let* ((files (mapcar (function car) l))
+ (let* ((files (mapcar #'car l))
(count (length l))
(succ 0)
+ ;; Bind `dired-recursive-deletes' so that we can change it
+ ;; locally according with the user answer within `dired-delete-file'.
+ (dired-recursive-deletes dired-recursive-deletes)
(trashing (and trash delete-by-moving-to-trash)))
;; canonicalize file list for pop up
- (setq files (nreverse (mapcar (function dired-make-relative) files)))
+ (setq files (nreverse (mapcar #'dired-make-relative files)))
(if (dired-mark-pop-up
" *Deletions*" 'delete files dired-deletion-confirmer
(format "%s %s "
(if trashing "Trash" "Delete")
(dired-mark-prompt arg files)))
(save-excursion
+ (catch '--delete-cancel
(let ((progress-reporter
(make-progress-reporter
(if trashing "Trashing..." "Deleting...")
@@ -2999,9 +3143,10 @@ non-empty directories is allowed."
(progress-reporter-update progress-reporter succ)
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
- (function dired-delete-entry) fn))
+ #'dired-delete-entry fn))
+ (quit (throw '--delete-cancel (message "OK, canceled")))
(error ;; catch errors from failed deletions
- (dired-log "%s\n" err)
+ (dired-log "%s: %s\n" (car err) (error-message-string err))
(setq failures (cons (car (car l)) failures)))))
(setq l (cdr l)))
(if (not failures)
@@ -3010,7 +3155,7 @@ non-empty directories is allowed."
(format "%d of %d deletion%s failed"
(length failures) count
(dired-plural-s count))
- failures))))
+ failures)))))
(message "(No deletions performed)")))
(dired-move-to-filename))
@@ -3038,12 +3183,15 @@ non-empty directories is allowed."
(dired-clean-up-after-deletion file))
(defvar dired-clean-up-buffers-too)
+(defvar dired-clean-confirm-killing-deleted-buffers)
(defun dired-clean-up-after-deletion (fn)
"Clean up after a deleted file or directory FN.
-Removes any expanded subdirectory of deleted directory.
-If `dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil,
-also offers to kill buffers visiting deleted files and directories."
+Removes any expanded subdirectory of deleted directory. If
+`dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil,
+kill any buffers visiting those files, prompting for
+confirmation. To disable the confirmation, see
+`dired-clean-confirm-killing-deleted-buffers'."
(save-excursion (and (cdr dired-subdir-alist)
(dired-goto-subdir fn)
(dired-kill-subdir)))
@@ -3051,15 +3199,17 @@ also offers to kill buffers visiting deleted files and directories."
(when (and (featurep 'dired-x) dired-clean-up-buffers-too)
(let ((buf (get-file-buffer fn)))
(and buf
- (funcall #'y-or-n-p
- (format "Kill buffer of %s, too? "
- (file-name-nondirectory fn)))
+ (and dired-clean-confirm-killing-deleted-buffers
+ (funcall #'y-or-n-p
+ (format "Kill buffer of %s, too? "
+ (file-name-nondirectory fn))))
(kill-buffer buf)))
(let ((buf-list (dired-buffers-for-dir (expand-file-name fn))))
(and buf-list
- (y-or-n-p (format "Kill Dired buffer%s of %s, too? "
- (dired-plural-s (length buf-list))
- (file-name-nondirectory fn)))
+ (and dired-clean-confirm-killing-deleted-buffers
+ (y-or-n-p (format "Kill Dired buffer%s of %s, too? "
+ (dired-plural-s (length buf-list))
+ (file-name-nondirectory fn))))
(dolist (buf buf-list)
(kill-buffer buf))))))
@@ -3215,9 +3365,14 @@ argument or confirmation)."
(save-excursion (not (dired-move-to-filename))))
(defun dired-next-marked-file (arg &optional wrap opoint)
- "Move to the next marked file.
-If WRAP is non-nil, wrap around to the beginning of the buffer if
-we reach the end."
+ "Move to the ARGth next marked file.
+ARG is the numeric prefix argument and defaults to 1.
+If WRAP is non-nil, which happens interactively, wrap around
+to the beginning of the buffer and search from there, if no
+marked file is found after this line.
+Optional argument OPOINT specifies the buffer position to
+return to if no ARGth marked file is found; it defaults to
+the position where this command was invoked."
(interactive "p\np")
(or opoint (setq opoint (point)));; return to where interactively started
(if (if (> arg 0)
@@ -3234,9 +3389,11 @@ we reach the end."
(dired-next-marked-file arg nil opoint))))
(defun dired-prev-marked-file (arg &optional wrap)
- "Move to the previous marked file.
-If WRAP is non-nil, wrap around to the end of the buffer if we
-reach the beginning of the buffer."
+ "Move to the ARGth previous marked file.
+ARG is the numeric prefix argument and defaults to 1.
+If WRAP is non-nil, which happens interactively, wrap around
+to the end of the buffer and search backwards from there, if
+no ARGth marked file is found before this line."
(interactive "p\np")
(dired-next-marked-file (- arg) wrap))
@@ -3293,7 +3450,7 @@ this subdir."
(let ((inhibit-read-only t))
(dired-repeat-over-lines
(prefix-numeric-value arg)
- (function (lambda () (delete-char 1) (insert dired-marker-char))))))))
+ (lambda () (delete-char 1) (insert dired-marker-char)))))))
(defun dired-unmark (arg &optional interactive)
"Unmark the file at point in the Dired buffer.
@@ -3928,7 +4085,7 @@ Ask means pop up a menu for the user to select one of copy, move or link."
(cdr
(nreverse
(mapcar
- (function (lambda (f) (desktop-file-name (car f) dirname)))
+ (lambda (f) (desktop-file-name (car f) dirname))
dired-subdir-alist)))))
(defun dired-restore-desktop-buffer (_file-name
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
index 6004c7c7ca2..137a0cbfa50 100644
--- a/lisp/dirtrack.el
+++ b/lisp/dirtrack.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
index 59cc8d61ee2..1410e273298 100644
--- a/lisp/disp-table.el
+++ b/lisp/disp-table.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el
new file mode 100644
index 00000000000..15e04279156
--- /dev/null
+++ b/lisp/display-line-numbers.el
@@ -0,0 +1,106 @@
+;;; display-line-numbers.el --- interface for display-line-numbers -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: convenience
+
+;; 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:
+
+;; Provides a minor mode interface for `display-line-numbers'.
+;;
+;; Toggle display of line numbers with M-x display-line-numbers-mode.
+;; To enable line numbering in all buffers, use M-x
+;; global-display-line-numbers-mode. To change the default type of
+;; line numbers displayed, customize display-line-numbers-type.
+
+;; NOTE: Customization variables for `display-line-numbers' itself are
+;; defined in cus-start.el.
+
+;;; Code:
+
+(defgroup display-line-numbers nil
+ "Display line numbers in the buffer."
+ :group 'convenience
+ :group 'display)
+
+(defcustom display-line-numbers-type t
+ "The default type of line numbers to use in `display-line-numbers-mode'.
+See `display-line-numbers' for value options."
+ :group 'display-line-numbers
+ :type '(choice (const :tag "Relative line numbers" relative)
+ (const :tag "Relative visual line numbers" visual)
+ (other :tag "Absolute line numbers" t))
+ :version "26.1")
+
+(defcustom display-line-numbers-grow-only nil
+ "If non-nil, do not shrink line number width."
+ :group 'display-line-numbers
+ :type 'boolean
+ :version "26.1")
+
+(defcustom display-line-numbers-width-start nil
+ "If non-nil, count number of lines to use for line number width.
+When `display-line-numbers-mode' is turned on,
+`display-line-numbers-width' is set to the minimum width necessary
+to display all line numbers in the buffer."
+ :group 'display-line-numbers
+ :type 'boolean
+ :version "26.1")
+
+(defun display-line-numbers-update-width ()
+ "Prevent the line number width from shrinking."
+ (let ((width (line-number-display-width)))
+ (when (> width (or display-line-numbers-width 1))
+ (setq display-line-numbers-width width))))
+
+;;;###autoload
+(define-minor-mode display-line-numbers-mode
+ "Toggle display of line numbers in the buffer.
+This uses `display-line-numbers' internally.
+
+To change the type of line numbers displayed by default,
+customize `display-line-numbers-type'. To change the type while
+the mode is on, set `display-line-numbers' directly."
+ :lighter nil
+ (if display-line-numbers-mode
+ (progn
+ (when display-line-numbers-width-start
+ (setq display-line-numbers-width
+ (length (number-to-string
+ (count-lines (point-min) (point-max))))))
+ (when display-line-numbers-grow-only
+ (add-hook 'pre-command-hook #'display-line-numbers-update-width nil t))
+ (setq display-line-numbers display-line-numbers-type))
+ (remove-hook 'pre-command-hook #'display-line-numbers-update-width t)
+ (setq display-line-numbers nil)))
+
+(defun display-line-numbers--turn-on ()
+ "Turn on `display-line-numbers-mode'."
+ (unless (or (minibufferp)
+ ;; taken from linum.el
+ (and (daemonp) (null (frame-parameter nil 'client))))
+ (display-line-numbers-mode)))
+
+;;;###autoload
+(define-globalized-minor-mode global-display-line-numbers-mode
+ display-line-numbers-mode display-line-numbers--turn-on)
+
+(provide 'display-line-numbers)
+
+;;; display-line-numbers.el ends here
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 3ae5e4f8945..c5ee8975ac6 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -144,7 +144,7 @@ Return nil if URI is not a local file."
str))
uri t t))
-;; http://lists.gnu.org/archive/html/emacs-devel/2006-05/msg01060.html
+;; https://lists.gnu.org/r/emacs-devel/2006-05/msg01060.html
(defun dnd-get-local-file-name (uri &optional must-exist)
"Return file name converted from file:/// or file: syntax.
URI is the uri for the file. If MUST-EXIST is given and non-nil,
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 2eb555821d9..7213ea2ff6b 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Requirements:
@@ -451,7 +451,7 @@ Typically \"page-%s.png\".")
(if (and (eq 'pdf doc-view-doc-type)
(executable-find "pdfinfo"))
;; We don't want to revert if the PDF file is corrupted which
- ;; might happen when it it currently recompiled from a tex
+ ;; might happen when it is currently recompiled from a tex
;; file. (TODO: We'd like to have something like that also
;; for other types, at least PS, but I don't know a good way
;; to test if a PS file is complete.)
diff --git a/lisp/dom.el b/lisp/dom.el
index 4d0d4233db3..70938f539be 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -162,7 +162,7 @@ ATTRIBUTE would typically be `class', `id' or the like."
(defun dom-previous-sibling (dom node)
"Return the previous sibling of NODE in DOM."
- (when-let (parent (dom-parent dom node))
+ (when-let* ((parent (dom-parent dom node)))
(let ((siblings (dom-children parent))
(previous nil))
(while siblings
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
index 1d48371912f..f69335d2c21 100644
--- a/lisp/dos-fns.el
+++ b/lisp/dos-fns.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el
index d552d518a01..90052ce0282 100644
--- a/lisp/dos-vars.el
+++ b/lisp/dos-vars.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
index ff5310e1fb3..affadee2fe7 100644
--- a/lisp/dos-w32.el
+++ b/lisp/dos-w32.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/double.el b/lisp/double.el
index ab9e23b301f..91dc095fed9 100644
--- a/lisp/double.el
+++ b/lisp/double.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 3d80f9dd9af..41667e61880 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -92,4 +92,3 @@ Changes can be
(define-key special-event-map [config-changed-event]
'dynamic-setting-handle-config-changed-event)
-
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
index b399be5d303..51c33c64be4 100644
--- a/lisp/ebuff-menu.el
+++ b/lisp/ebuff-menu.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/echistory.el b/lisp/echistory.el
index 2146faae1d7..588f60521dd 100644
--- a/lisp/echistory.el
+++ b/lisp/echistory.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index 70277facb0a..014b4b21122 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -55,7 +55,7 @@
(defun ecomplete-add-item (type key text)
(let ((elems (assq type ecomplete-database))
- (now (string-to-number (format "%.0f" (float-time))))
+ (now (string-to-number (format-time-string "%s")))
entry)
(unless elems
(push (setq elems (list type)) ecomplete-database))
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
index 5fefc3102d0..dc840ef1f19 100644
--- a/lisp/edmacro.el
+++ b/lisp/edmacro.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -88,20 +88,26 @@ Default nil means to write characters above \\177 in octal notation."
(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
"Edit a keyboard macro.
At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
-the last 300 keystrokes as a keyboard macro, or `\\[execute-extended-command]' to edit a macro by
-its command name.
+Or, type `\\[kmacro-end-and-call-macro]' or RET to edit the last
+keyboard macro, `\\[view-lossage]' to edit the last 300
+keystrokes as a keyboard macro, or `\\[execute-extended-command]'
+to edit a macro by its command name.
With a prefix argument, format the macro in a more concise way."
- (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
+ (interactive
+ (list (read-key-sequence (substitute-command-keys "Keyboard macro to edit \
+\(\\[kmacro-end-and-call-macro], \\[execute-extended-command], \\[view-lossage],\
+ or keys): "))
+ current-prefix-arg))
(when keys
(let ((cmd (if (arrayp keys) (key-binding keys) keys))
+ (cmd-noremap (when (arrayp keys) (key-binding keys nil t)))
(mac nil) (mac-counter nil) (mac-format nil)
kmacro)
(cond (store-hook
(setq mac keys)
(setq cmd nil))
- ((or (memq cmd '(call-last-kbd-macro kmacro-call-macro
- kmacro-end-or-call-macro kmacro-end-and-call-macro))
+ ((or (memq cmd '(call-last-kbd-macro kmacro-call-macro kmacro-end-or-call-macro kmacro-end-and-call-macro))
+ (memq cmd-noremap '(call-last-kbd-macro kmacro-call-macro kmacro-end-or-call-macro kmacro-end-and-call-macro))
(member keys '("\r" [return])))
(or last-kbd-macro
(y-or-n-p "No keyboard macro defined. Create one? ")
@@ -109,13 +115,14 @@ With a prefix argument, format the macro in a more concise way."
(setq mac (or last-kbd-macro ""))
(setq keys nil)
(setq cmd 'last-kbd-macro))
- ((eq cmd 'execute-extended-command)
+ ((memq 'execute-extended-command (list cmd cmd-noremap))
(setq cmd (read-command "Name of keyboard macro to edit: "))
(if (string-equal cmd "")
(error "No command name given"))
(setq keys nil)
(setq mac (symbol-function cmd)))
- ((memq cmd '(view-lossage electric-view-lossage))
+ ((or (memq cmd '(view-lossage electric-view-lossage))
+ (memq cmd-noremap '(view-lossage electric-view-lossage)))
(setq mac (recent-keys))
(setq keys nil)
(setq cmd 'last-kbd-macro))
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index a3719f63915..1e89f84313c 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el
index 87e82e24fb1..7f523d1df45 100644
--- a/lisp/elec-pair.el
+++ b/lisp/elec-pair.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,9 +28,9 @@
;;; Electric pairing.
(defcustom electric-pair-pairs
- '((?\" . ?\")
- ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars))
- ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars)))
+ `((?\" . ?\")
+ (,(nth 0 electric-quote-chars) . ,(nth 1 electric-quote-chars))
+ (,(nth 2 electric-quote-chars) . ,(nth 3 electric-quote-chars)))
"Alist of pairs that should be used regardless of major mode.
Pairs of delimiters in this list are a fallback in case they have
@@ -42,11 +42,10 @@ See also the variable `electric-pair-text-pairs'."
:group 'electricity
:type '(repeat (cons character character)))
-;;;###autoload
(defcustom electric-pair-text-pairs
- '((?\" . ?\" )
- ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars))
- ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars)))
+ `((?\" . ?\")
+ (,(nth 0 electric-quote-chars) . ,(nth 1 electric-quote-chars))
+ (,(nth 2 electric-quote-chars) . ,(nth 3 electric-quote-chars)))
"Alist of pairs that should always be used in comments and strings.
Pairs of delimiters in this list are a fallback in case they have
diff --git a/lisp/electric.el b/lisp/electric.el
index 4078ef8193e..cee35621397 100644
--- a/lisp/electric.el
+++ b/lisp/electric.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -227,7 +227,7 @@ Python does not lend itself to fully automatic indentation.")
haskell-indentation-indent-line haskell-indent-cycle haskell-simple-indent
yaml-indent-line)
"List of indent functions that can't reindent.
-If `line-indent-function' is one of those, then `electric-indent-mode' will
+If `indent-line-function' is one of those, then `electric-indent-mode' will
not try to reindent lines. It is normally better to make the major
mode set `electric-indent-inhibit', but this can be used as a workaround.")
@@ -443,49 +443,95 @@ quote, left double quote, and right double quote, respectively."
:version "25.1"
:type 'boolean :safe 'booleanp :group 'electricity)
+(defcustom electric-quote-context-sensitive nil
+ "Non-nil means to replace \\=' with an electric quote depending on context.
+If `electric-quote-context-sensitive' is non-nil, Emacs replaces
+\\=' and \\='\\=' with an opening quote after a line break,
+whitespace, opening parenthesis, or quote and leaves \\=` alone."
+ :version "26.1"
+ :type 'boolean :safe #'booleanp :group 'electricity)
+
+(defcustom electric-quote-replace-double nil
+ "Non-nil means to replace \" with an electric double quote.
+Emacs replaces \" with an opening double quote after a line
+break, whitespace, opening parenthesis, or quote, and with a
+closing double quote otherwise."
+ :version "26.1"
+ :type 'boolean :safe #'booleanp :group 'electricity)
+
+(defvar electric-quote-inhibit-functions ()
+ "List of functions that should inhibit electric quoting.
+When the variable `electric-quote-mode' is non-nil, Emacs will
+call these functions in order after the user has typed an \\=` or
+\\=' character. If one of them returns non-nil, electric quote
+substitution is inhibited. The functions are called after the
+\\=` or \\=' character has been inserted with point directly
+after the inserted character. The functions in this hook should
+not move point or change the current buffer.")
+
+(defvar electric-pair-text-pairs)
+
(defun electric-quote-post-self-insert-function ()
"Function that `electric-quote-mode' adds to `post-self-insert-hook'.
This requotes when a quoting key is typed."
(when (and electric-quote-mode
- (memq last-command-event '(?\' ?\`)))
- (let ((start
- (if (and comment-start comment-use-syntax)
- (when (or electric-quote-comment electric-quote-string)
- (let* ((syntax (syntax-ppss))
- (beg (nth 8 syntax)))
- (and beg
- (or (and electric-quote-comment (nth 4 syntax))
- (and electric-quote-string (nth 3 syntax)))
- ;; Do not requote a quote that starts or ends
- ;; a comment or string.
- (eq beg (nth 8 (save-excursion
- (syntax-ppss (1- (point)))))))))
- (and electric-quote-paragraph
- (derived-mode-p 'text-mode)
- (or (eq last-command-event ?\`)
- (save-excursion (backward-paragraph) (point)))))))
- (pcase electric-quote-chars
- (`(,q< ,q> ,q<< ,q>>)
- (when start
- (save-excursion
- (if (eq last-command-event ?\`)
- (cond ((search-backward (string q< ?`) (- (point) 2) t)
- (replace-match (string q<<))
- (when (and electric-pair-mode
- (eq (cdr-safe
- (assq q< electric-pair-text-pairs))
- (char-after)))
- (delete-char 1))
- (setq last-command-event q<<))
- ((search-backward "`" (1- (point)) t)
- (replace-match (string q<))
- (setq last-command-event q<)))
- (cond ((search-backward (string q> ?') (- (point) 2) t)
- (replace-match (string q>>))
- (setq last-command-event q>>))
- ((search-backward "'" (1- (point)) t)
- (replace-match (string q>))
- (setq last-command-event q>)))))))))))
+ (or (eq last-command-event ?\')
+ (and (not electric-quote-context-sensitive)
+ (eq last-command-event ?\`))
+ (and electric-quote-replace-double
+ (eq last-command-event ?\")))
+ (not (run-hook-with-args-until-success
+ 'electric-quote-inhibit-functions))
+ (if (derived-mode-p 'text-mode)
+ electric-quote-paragraph
+ (and comment-start comment-use-syntax
+ (or electric-quote-comment electric-quote-string)
+ (let* ((syntax (syntax-ppss))
+ (beg (nth 8 syntax)))
+ (and beg
+ (or (and electric-quote-comment (nth 4 syntax))
+ (and electric-quote-string (nth 3 syntax)))
+ ;; Do not requote a quote that starts or ends
+ ;; a comment or string.
+ (eq beg (nth 8 (save-excursion
+ (syntax-ppss (1- (point)))))))))))
+ (pcase electric-quote-chars
+ (`(,q< ,q> ,q<< ,q>>)
+ (save-excursion
+ (let ((backtick ?\`))
+ (if (or (eq last-command-event ?\`)
+ (and (or electric-quote-context-sensitive
+ electric-quote-replace-double)
+ (save-excursion
+ (backward-char)
+ (or (bobp) (bolp)
+ (memq (char-before) (list q< q<<))
+ (memq (char-syntax (char-before))
+ '(?\s ?\())))
+ (setq backtick ?\')))
+ (cond ((search-backward (string q< backtick) (- (point) 2) t)
+ (replace-match (string q<<))
+ (when (and electric-pair-mode
+ (eq (cdr-safe
+ (assq q< electric-pair-text-pairs))
+ (char-after)))
+ (delete-char 1))
+ (setq last-command-event q<<))
+ ((search-backward (string backtick) (1- (point)) t)
+ (replace-match (string q<))
+ (setq last-command-event q<))
+ ((search-backward "\"" (1- (point)) t)
+ (replace-match (string q<<))
+ (setq last-command-event q<<)))
+ (cond ((search-backward (string q> ?') (- (point) 2) t)
+ (replace-match (string q>>))
+ (setq last-command-event q>>))
+ ((search-backward "'" (1- (point)) t)
+ (replace-match (string q>))
+ (setq last-command-event q>))
+ ((search-backward "\"" (1- (point)) t)
+ (replace-match (string q>>))
+ (setq last-command-event q>>))))))))))
(put 'electric-quote-post-self-insert-function 'priority 10)
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 3904edd7f64..c6d8c9009b9 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -57,7 +57,7 @@ If not, see <http://www\\.gnu\\.org/licenses/>\\)\\.")
"SUCH DAMAGE\\.") ; BSD
("Permission is hereby granted, free of charge" . ; X11
"authorization from the X Consortium\\."))
- "Alist of regexps defining start end end of text to elide.
+ "Alist of regexps defining start and end of text to elide.
The cars of elements of the list are searched for in order. Text is
elided with an invisible overlay from the end of the line where the
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index 3342bea209a..82867667756 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; LCD Archive Entry:
;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
@@ -502,7 +502,7 @@
;; important advantage is that it allows the implementation of forward advice.
;; Advice information for a certain function accumulates as the value of the
;; `advice-info' property of the function symbol. This accumulation is
-;; completely independent of the fact that that function might not yet be
+;; completely independent of the fact that the function might not yet be
;; defined. The macros `defun' and `defmacro' check whether the
;; function/macro they defined had advice information
;; associated with it. If so and forward advice is enabled, the original
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
index 8fe94013700..71fc51e27b0 100644
--- a/lisp/emacs-lisp/autoload.el
+++ b/lisp/emacs-lisp/autoload.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -497,6 +497,7 @@ Return non-nil in the case where no autoloads were added at point."
Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines
variables or functions that use \"foo-\" as prefix, that will not be registered.
But all other prefixes will be included.")
+(put 'autoload-compute-prefixes 'safe #'booleanp)
(defconst autoload-def-prefixes-max-entries 5
"Target length of the list of definition prefixes per file.
@@ -761,6 +762,7 @@ FILE's modification time."
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
+ "define-erc-module"
"define-erc-response-handler"
"defun-rcirc-command"))))
(push (match-string 2) defs))
@@ -873,18 +875,24 @@ FILE's modification time."
;; For parallel builds, to stop another process reading a half-written file.
(defun autoload--save-buffer ()
"Save current buffer to its file, atomically."
- ;; Copied from byte-compile-file.
+ ;; Similar to byte-compile-file.
(let* ((version-control 'never)
- (tempfile (make-temp-name buffer-file-name))
+ (tempfile (make-temp-file buffer-file-name))
+ (default-modes (default-file-modes))
+ (temp-modes (logand default-modes #o600))
+ (desired-modes (logand default-modes
+ (or (file-modes buffer-file-name) #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))
(write-region (point-min) (point-max) tempfile nil 1)
(backup-buffer)
- (rename-file tempfile buffer-file-name t)
- (set-buffer-modified-p nil)
- (set-visited-file-modtime)
- (or noninteractive (message "Wrote %s" buffer-file-name))))
+ (rename-file tempfile buffer-file-name t))
+ (set-buffer-modified-p nil)
+ (set-visited-file-modtime)
+ (or noninteractive (message "Wrote %s" buffer-file-name)))
(defun autoload-save-buffers ()
(while autoload-modified-buffers
@@ -892,7 +900,7 @@ FILE's modification time."
(autoload--save-buffer))))
;; FIXME This command should be deprecated.
-;; See http://debbugs.gnu.org/22213#41
+;; See https://debbugs.gnu.org/22213#41
;;;###autoload
(defun update-file-autoloads (file &optional save-after outfile)
"Update the autoloads for FILE.
@@ -911,7 +919,7 @@ Return FILE if there was no autoload cookie in it, else nil."
(let* ((generated-autoload-file (or outfile generated-autoload-file))
(autoload-modified-buffers nil)
;; We need this only if the output file handles more than one input.
- ;; See http://debbugs.gnu.org/22213#38 and subsequent.
+ ;; See https://debbugs.gnu.org/22213#38 and subsequent.
(autoload-timestamps t)
(no-autoloads (autoload-generate-file-autoloads file)))
(if autoload-modified-buffers
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 17f1ffa9f61..8435b29b04a 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -52,7 +52,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-
+(require 'generator)
;; ================================================================
@@ -670,6 +670,21 @@ a null element stored in the AVL tree.)"
(null (avl-tree--stack-store avl-tree-stack)))
+(iter-defun avl-tree-iter (tree &optional reverse)
+ "Return an AVL tree iterator object.
+
+Calling `iter-next' on this object will retrieve the next element
+from TREE. If REVERSE is non-nil, elements are returned in
+reverse order.
+
+Note that any modification to TREE *immediately* invalidates all
+iterators created from TREE before the modification (in
+particular, calling `iter-next' will give unpredictable results)."
+ (let ((stack (avl-tree-stack tree reverse)))
+ (while (not (avl-tree-stack-empty-p stack))
+ (iter-yield (avl-tree-stack-pop stack)))))
+
+
(provide 'avl-tree)
;;; avl-tree.el ends here
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
index bb877dd2c97..4649cf343c4 100644
--- a/lisp/emacs-lisp/backquote.el
+++ b/lisp/emacs-lisp/backquote.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index a2217d20953..02db21a7e53 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -34,13 +34,11 @@
(defmacro benchmark-elapse (&rest forms)
"Return the time in seconds elapsed for execution of FORMS."
(declare (indent 0) (debug t))
- (let ((t1 (make-symbol "t1"))
- (t2 (make-symbol "t2")))
- `(let (,t1 ,t2)
+ (let ((t1 (make-symbol "t1")))
+ `(let (,t1)
(setq ,t1 (current-time))
,@forms
- (setq ,t2 (current-time))
- (float-time (time-subtract ,t2 ,t1)))))
+ (float-time (time-subtract nil ,t1)))))
;;;###autoload
(defmacro benchmark-run (&optional repetitions &rest forms)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index d345151907b..0f86923518c 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 962a7ae5cde..623985f44f9 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1281,7 +1281,10 @@
;; errors to compile time.
(let ((pure-fns
- '(concat symbol-name regexp-opt regexp-quote string-to-syntax)))
+ '(concat symbol-name regexp-opt regexp-quote string-to-syntax
+ string-to-char
+ ash lsh logb lognot logior logxor
+ ceiling floor)))
(while pure-fns
(put (car pure-fns) 'pure t)
(setq pure-fns (cdr pure-fns)))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 4fa31dd4c27..d6c43ecf462 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -285,9 +285,13 @@ The return value is undefined.
def))))
-;; Redefined in byte-optimize.el.
-;; This is not documented--it's not clear that we should promote it.
-(fset 'inline 'progn)
+;; Redefined in byte-opt.el.
+;; This was undocumented and unused for decades.
+(defalias 'inline 'progn
+ "Like `progn', but when compiled inline top-level function calls in body.
+You don't need this. (See bytecomp.el commentary for more details.)
+
+\(fn BODY...)")
;;; Interface to inline functions.
@@ -318,6 +322,7 @@ The return value is undefined.
(defmacro defsubst (name arglist &rest body)
"Define an inline function. The syntax is just like that of `defun'.
+
\(fn NAME ARGLIST &optional DOCSTRING DECL &rest BODY)"
(declare (debug defun) (doc-string 3))
(or (memq (get name 'byte-optimizer)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e5b9b47b1d0..f69ac7f342a 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -144,14 +144,20 @@
(defcustom emacs-lisp-file-regexp "\\.el\\'"
"Regexp which matches Emacs Lisp source files.
-If you change this, you might want to set `byte-compile-dest-file-function'."
+If you change this, you might want to set `byte-compile-dest-file-function'.
+\(Note that the assumption of a \".elc\" suffix for compiled files
+is hard-coded in various places in Emacs.)"
+ ;; Eg is_elc in Fload.
:group 'bytecomp
:type 'regexp)
(defcustom byte-compile-dest-file-function nil
"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."
+file name, and return the name of the compiled file.
+\(Note that the assumption that the source and compiled files
+are found in the same directory is hard-coded in various places in Emacs.)"
+ ;; Eg load-prefer-newer, documentation lookup IIRC.
:group 'bytecomp
:type '(choice (const nil) function)
:version "23.2")
@@ -166,12 +172,19 @@ file name, and return the name of the compiled file."
(funcall handler 'byte-compiler-base-file-name filename)
filename)))
+;; Sadly automake relies on this misfeature up to at least version 1.15.1.
+(if (fboundp 'byte-compile-dest-file)
+ (or (featurep 'bytecomp)
+ (display-warning 'bytecomp (format-message "\
+Changing `byte-compile-dest-file' is obsolete (as of 23.2);
+set `byte-compile-dest-file-function' instead.")))
(defun byte-compile-dest-file (filename)
"Convert an Emacs Lisp source file name to a compiled file name.
If `byte-compile-dest-file-function' is non-nil, uses that
function to do the work. Otherwise, if FILENAME matches
-`emacs-lisp-file-regexp' (by default, files with the extension `.el'),
-adds `c' to it; otherwise adds `.elc'."
+`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
@@ -179,6 +192,7 @@ adds `c' to it; otherwise adds `.elc'."
(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")
@@ -1183,7 +1197,29 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(compilation-forget-errors)
pt))))
+(defvar byte-compile-log-warning-function
+ #'byte-compile--log-warning-for-byte-compile
+ "Function called when encountering a warning or error.
+Called with arguments (STRING POSITION FILL LEVEL). STRING is a
+message describing the problem. POSITION is a buffer position
+where the problem was detected. FILL is a prefix as in
+`warning-fill-prefix'. LEVEL is the level of the
+problem (`:warning' or `:error'). POSITION, FILL and LEVEL may be
+nil.")
+
(defun byte-compile-log-warning (string &optional fill level)
+ "Log a byte-compilation warning.
+STRING, FILL and LEVEL are as described in
+`byte-compile-log-warning-function', which see."
+ (funcall byte-compile-log-warning-function
+ string byte-compile-last-position
+ fill
+ level))
+
+(defun byte-compile--log-warning-for-byte-compile (string &optional
+ _position
+ fill
+ level)
"Log a message STRING in `byte-compile-log-buffer'.
Also log the current function and file if not already done. If
FILL is non-nil, set `warning-fill-prefix' to four spaces. LEVEL
@@ -1263,12 +1299,6 @@ when printing the error message."
(defun byte-compile-arglist-signature (arglist)
(cond
- ;; New style byte-code arglist.
- ((integerp arglist)
- (cons (logand arglist 127) ;Mandatory.
- (if (zerop (logand arglist 128)) ;No &rest.
- (lsh arglist -8)))) ;Nonrest.
- ;; Old style byte-code, or interpreted function.
((listp arglist)
(let ((args 0)
opts
@@ -1289,6 +1319,19 @@ when printing the error message."
;; Unknown arglist.
(t '(0))))
+(defun byte-compile--function-signature (f)
+ ;; Similar to help-function-arglist, except that it returns the info
+ ;; in a different format.
+ (and (eq 'macro (car-safe f)) (setq f (cdr f)))
+ ;; Advice wrappers have "catch all" args, so fetch the actual underlying
+ ;; function to find the real arguments.
+ (while (advice--p f) (setq f (advice--cdr f)))
+ (if (eq (car-safe f) 'declared)
+ (byte-compile-arglist-signature (nth 1 f))
+ (condition-case nil
+ (let ((sig (func-arity f)))
+ (if (numberp (cdr sig)) sig (list (car sig))))
+ (error '(0)))))
(defun byte-compile-arglist-signatures-congruent-p (old new)
(not (or
@@ -1330,19 +1373,7 @@ when printing the error message."
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
(byte-compile-fdefinition (car form) t)))
- (sig (if (and def (not (eq def t)))
- (progn
- (and (eq (car-safe def) 'macro)
- (eq (car-safe (cdr-safe def)) 'lambda)
- (setq def (cdr def)))
- (byte-compile-arglist-signature
- (if (memq (car-safe def) '(declared lambda))
- (nth 1 def)
- (if (byte-code-function-p def)
- (aref def 0)
- '(&rest def)))))
- (if (subrp (symbol-function (car form)))
- (subr-arity (symbol-function (car form))))))
+ (sig (byte-compile--function-signature def))
(ncall (length (cdr form))))
;; Check many or unevalled from subr-arity.
(if (and (cdr-safe sig)
@@ -1461,15 +1492,7 @@ extra args."
(and initial (symbolp initial)
(setq old (byte-compile-fdefinition initial nil)))
(when (and old (not (eq old t)))
- (and (eq 'macro (car-safe old))
- (eq 'lambda (car-safe (cdr-safe old)))
- (setq old (cdr old)))
- (let ((sig1 (byte-compile-arglist-signature
- (pcase old
- (`(lambda ,args . ,_) args)
- (`(closure ,_ ,args . ,_) args)
- ((pred byte-code-function-p) (aref old 0))
- (_ '(&rest def)))))
+ (let ((sig1 (byte-compile--function-signature old))
(sig2 (byte-compile-arglist-signature arglist)))
(unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
(byte-compile-set-symbol-position name)
@@ -1585,6 +1608,7 @@ extra args."
;; macroenvironment.
(copy-alist byte-compile-initial-macro-environment))
(byte-compile--outbuffer nil)
+ (overriding-plist-environment nil)
(byte-compile-function-environment nil)
(byte-compile-bound-variables nil)
(byte-compile-lexical-variables nil)
@@ -1901,25 +1925,33 @@ The value is non-nil if there were no errors, nil if errors."
(insert "\n") ; aaah, unix.
(if (file-writable-p 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-name target-file))
- (kill-emacs-hook
- (cons (lambda () (ignore-errors (delete-file tempfile)))
- kill-emacs-hook)))
- (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)
+ (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 (file-name-nondirectory 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))
+ (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)))
;; This is just to give a better error message than write-region
(let ((exists (file-exists-p target-file)))
@@ -2574,7 +2606,7 @@ not to take responsibility for the actual compilation of the code."
(let ((index
;; If there's no doc string, provide -1 as the "doc string
;; index" so that no element will be treated as a doc string.
- (if (not (stringp (car body))) -1 4)))
+ (if (not (stringp (documentation code t))) -1 4)))
;; Output the form by hand, that's much simpler than having
;; b-c-output-file-form analyze the defalias.
(byte-compile-output-docform
@@ -3347,15 +3379,14 @@ for symbols generated by the byte compiler itself."
(defun byte-compile-constant (const)
(if byte-compile--for-effect
(setq byte-compile--for-effect nil)
- (when (symbolp const)
- (byte-compile-set-symbol-position const))
- (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
+ (inline (byte-compile-push-constant const))))
;; Use this for a constant that is not the value of its containing form.
;; This ignores byte-compile--for-effect.
(defun byte-compile-push-constant (const)
- (let ((byte-compile--for-effect nil))
- (inline (byte-compile-constant const))))
+ (when (symbolp const)
+ (byte-compile-set-symbol-position const))
+ (byte-compile-out 'byte-constant (byte-compile-get-constant const)))
;; Compile those primitive ordinary functions
;; which have special byte codes just for speed.
@@ -4725,6 +4756,35 @@ binding slots have been popped."
'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
+
+(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop)
+(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop)
+(defun byte-compile-define-symbol-prop (form)
+ (pcase form
+ ((and `(,op ,fun ,prop ,val)
+ (guard (and (macroexp-const-p fun)
+ (macroexp-const-p prop)
+ (or (macroexp-const-p val)
+ ;; Also accept anonymous functions, since
+ ;; we're at top-level which implies they're
+ ;; also constants.
+ (pcase val (`(function (lambda . ,_)) t))))))
+ (byte-compile-push-constant op)
+ (byte-compile-form fun)
+ (byte-compile-form prop)
+ (let* ((fun (eval fun))
+ (prop (eval prop))
+ (val (if (macroexp-const-p val)
+ (eval val)
+ (byte-compile-lambda (cadr val)))))
+ (push `(,fun
+ . (,prop ,val ,@(alist-get fun overriding-plist-environment)))
+ overriding-plist-environment)
+ (byte-compile-push-constant val)
+ (byte-compile-out 'byte-call 3)
+ nil))
+
+ (_ (byte-compile-keep-pending form))))
;;; tags
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 4507af7a59b..fe92288d548 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el
index dc108f956c2..2c37923353c 100644
--- a/lisp/emacs-lisp/chart.el
+++ b/lisp/emacs-lisp/chart.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index c46426cd366..6d503bae2df 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 1d6fdfa4e87..fe6cd4160ed 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -171,6 +171,7 @@
(defvar checkdoc-version "0.6.1"
"Release version of checkdoc you are currently running.")
+(eval-when-compile (require 'cl-lib))
(require 'help-mode) ;; for help-xref-info-regexp
(require 'thingatpt) ;; for handy thing-at-point-looking-at
@@ -258,12 +259,13 @@ Any more than this and a warning is generated suggesting that the construct
\\ {keymap} be used instead."
:type 'integer)
-(defcustom checkdoc-arguments-in-order-flag t
+(defcustom checkdoc-arguments-in-order-flag nil
"Non-nil means warn if arguments appear out of order.
Setting this to nil will mean only checking that all the arguments
appear in the proper form in the documentation, not that they are in
the same order as they appear in the argument list. No mention is
made in the style guide relating to order."
+ :version "26.1"
:type 'boolean)
;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp)
@@ -435,23 +437,6 @@ be re-created.")
st)
"Syntax table used by checkdoc in document strings.")
-;;; Compatibility
-;;
-(defalias 'checkdoc-make-overlay
- (if (featurep 'xemacs) #'make-extent #'make-overlay))
-(defalias 'checkdoc-overlay-put
- (if (featurep 'xemacs) #'set-extent-property #'overlay-put))
-(defalias 'checkdoc-delete-overlay
- (if (featurep 'xemacs) #'delete-extent #'delete-overlay))
-(defalias 'checkdoc-overlay-start
- (if (featurep 'xemacs) #'extent-start #'overlay-start))
-(defalias 'checkdoc-overlay-end
- (if (featurep 'xemacs) #'extent-end #'overlay-end))
-(defalias 'checkdoc-mode-line-update
- (if (featurep 'xemacs) #'redraw-modeline #'force-mode-line-update))
-(defalias 'checkdoc-char=
- (if (featurep 'xemacs) #'char= #'=))
-
;;; User level commands
;;
;;;###autoload
@@ -474,32 +459,31 @@ the users will view as each check is completed."
tmp)
(checkdoc-display-status-buffer status)
;; check the comments
- (if (not buffer-file-name)
- (setcar status "Not checked")
- (if (checkdoc-file-comments-engine)
- (setcar status "Errors")
- (setcar status "Ok")))
- (setcar (cdr status) "Checking...")
+ (setf (nth 0 status)
+ (cond
+ ((not buffer-file-name) "Not checked")
+ ((checkdoc-file-comments-engine) "Errors")
+ (t "Ok")))
+ (setf (nth 1 status) "Checking...")
(checkdoc-display-status-buffer status)
;; Check the documentation
(setq tmp (checkdoc-interactive nil t))
- (if tmp
- (setcar (cdr status) (format "%d Errors" (length tmp)))
- (setcar (cdr status) "Ok"))
- (setcar (cdr (cdr status)) "Checking...")
+ (setf (nth 1 status)
+ (if tmp (format "%d Errors" (length tmp)) "Ok"))
+ (setf (nth 2 status) "Checking...")
(checkdoc-display-status-buffer status)
;; Check the message text
- (if (setq tmp (checkdoc-message-interactive nil t))
- (setcar (cdr (cdr status)) (format "%d Errors" (length tmp)))
- (setcar (cdr (cdr status)) "Ok"))
- (setcar (cdr (cdr (cdr status))) "Checking...")
+ (setf (nth 2 status)
+ (if (setq tmp (checkdoc-message-interactive nil t))
+ (format "%d Errors" (length tmp))
+ "Ok"))
+ (setf (nth 3 status) "Checking...")
(checkdoc-display-status-buffer status)
;; Rogue spacing
- (if (condition-case nil
- (checkdoc-rogue-spaces nil t)
- (error t))
- (setcar (cdr (cdr (cdr status))) "Errors")
- (setcar (cdr (cdr (cdr status))) "Ok"))
+ (setf (nth 3 status)
+ (if (ignore-errors (checkdoc-rogue-spaces nil t))
+ "Errors"
+ "Ok"))
(checkdoc-display-status-buffer status)))
(defun checkdoc-display-status-buffer (check)
@@ -591,16 +575,16 @@ style."
(while err-list
(goto-char (cdr (car err-list)))
;; The cursor should be just in front of the offending doc string
- (if (stringp (car (car err-list)))
- (setq cdo (save-excursion (checkdoc-make-overlay
+ (setq cdo (if (stringp (car (car err-list)))
+ (save-excursion (make-overlay
(point) (progn (forward-sexp 1)
- (point)))))
- (setq cdo (checkdoc-make-overlay
+ (point))))
+ (make-overlay
(checkdoc-error-start (car (car err-list)))
(checkdoc-error-end (car (car err-list))))))
(unwind-protect
(progn
- (checkdoc-overlay-put cdo 'face 'highlight)
+ (overlay-put cdo 'face 'highlight)
;; Make sure the whole doc string is visible if possible.
(sit-for 0)
(if (and (= (following-char) ?\")
@@ -626,10 +610,10 @@ style."
(if (not (integerp c)) (setq c ??))
(cond
;; Exit condition
- ((checkdoc-char= c ?\C-g) (signal 'quit nil))
+ ((eq c ?\C-g) (signal 'quit nil))
;; Request an auto-fix
- ((or (checkdoc-char= c ?y) (checkdoc-char= c ?f))
- (checkdoc-delete-overlay cdo)
+ ((memq c '(?y ?f))
+ (delete-overlay cdo)
(setq cdo nil)
(goto-char (cdr (car err-list)))
;; `automatic-then-never' tells the autofix function
@@ -658,7 +642,7 @@ style."
"No Additional style errors. Continuing...")
(sit-for 2))))))
;; Move to the next error (if available)
- ((or (checkdoc-char= c ?n) (checkdoc-char= c ?\s))
+ ((memq c '(?n ?\s))
(let ((ne (funcall findfunc nil)))
(if (not ne)
(if showstatus
@@ -670,7 +654,7 @@ style."
(sit-for 2))
(setq err-list (cons ne err-list)))))
;; Go backwards in the list of errors
- ((or (checkdoc-char= c ?p) (checkdoc-char= c ?\C-?))
+ ((memq c '(?p ?\C-?))
(if (/= (length err-list) 1)
(progn
(setq err-list (cdr err-list))
@@ -679,10 +663,10 @@ style."
(message "No Previous Errors.")
(sit-for 2)))
;; Edit the buffer recursively.
- ((checkdoc-char= c ?e)
+ ((eq c ?e)
(checkdoc-recursive-edit
(checkdoc-error-text (car (car err-list))))
- (checkdoc-delete-overlay cdo)
+ (delete-overlay cdo)
(setq err-list (cdr err-list)) ;back up the error found.
(beginning-of-defun)
(let ((ne (funcall findfunc nil)))
@@ -694,7 +678,7 @@ style."
(sit-for 2))
(setq err-list (cons ne err-list)))))
;; Quit checkdoc
- ((checkdoc-char= c ?q)
+ ((eq c ?q)
(setq returnme err-list
err-list nil
begin (point)))
@@ -722,7 +706,7 @@ style."
"C-h - Toggle this help buffer.")))
(shrink-window-if-larger-than-buffer
(get-buffer-window "*Checkdoc Help*"))))))
- (if cdo (checkdoc-delete-overlay cdo)))))
+ (if cdo (delete-overlay cdo)))))
(goto-char begin)
(if (get-buffer "*Checkdoc Help*") (kill-buffer "*Checkdoc Help*"))
(message "Checkdoc: Done.")
@@ -1146,38 +1130,40 @@ Prefix argument is the same as for `checkdoc-defun'"
;; features and behaviors, so we need some ways of specifying
;; them, and making them easier to use in the wacked-out interfaces
;; people are requesting
-(defun checkdoc-create-error (text start end &optional unfixable)
- "Used to create the return error text returned from all engines.
+
+(cl-defstruct (checkdoc-error
+ (:constructor nil)
+ (:constructor checkdoc--create-error (text start end &optional unfixable)))
+ (text nil :read-only t)
+ (start nil :read-only t)
+ (end nil :read-only t)
+ (unfixable nil :read-only t))
+
+(defvar checkdoc-create-error-function #'checkdoc--create-error-for-checkdoc
+ "Function called when Checkdoc encounters an error.
+Should accept as arguments (TEXT START END &optional UNFIXABLE).
+
TEXT is the descriptive text of the error. START and END define the region
it is sensible to highlight when describing the problem.
Optional argument UNFIXABLE means that the error has no auto-fix available.
-A list of the form (TEXT START END UNFIXABLE) is returned if we are not
-generating a buffered list of errors."
+An object of type `checkdoc-error' is returned if we are not
+generating a buffered list of errors.")
+
+(defun checkdoc-create-error (text start end &optional unfixable)
+ "Used to create the return error text returned from all engines.
+TEXT, START, END and UNFIXABLE conform to
+`checkdoc-create-error-function', which see."
+ (funcall checkdoc-create-error-function text start end unfixable))
+
+(defun checkdoc--create-error-for-checkdoc (text start end &optional unfixable)
+ "Create an error for Checkdoc.
+TEXT, START, END and UNFIXABLE conform to
+`checkdoc-create-error-function', which see."
(if checkdoc-generate-compile-warnings-flag
(progn (checkdoc-error start text)
nil)
- (list text start end unfixable)))
-
-(defun checkdoc-error-text (err)
- "Return the text specified in the checkdoc ERR."
- ;; string-p part is for backwards compatibility
- (if (stringp err) err (car err)))
-
-(defun checkdoc-error-start (err)
- "Return the start point specified in the checkdoc ERR."
- ;; string-p part is for backwards compatibility
- (if (stringp err) nil (nth 1 err)))
-
-(defun checkdoc-error-end (err)
- "Return the end point specified in the checkdoc ERR."
- ;; string-p part is for backwards compatibility
- (if (stringp err) nil (nth 2 err)))
-
-(defun checkdoc-error-unfixable (err)
- "Return the t if we cannot autofix the error specified in the checkdoc ERR."
- ;; string-p part is for backwards compatibility
- (if (stringp err) nil (nth 3 err)))
+ (checkdoc--create-error text start end unfixable)))
;;; Minor Mode specification
;;
@@ -1328,7 +1314,7 @@ See the style guide in the Emacs Lisp manual for more details."
(if (and (not (nth 1 fp)) ; not a variable
(or (nth 2 fp) ; is interactive
checkdoc-force-docstrings-flag) ;or we always complain
- (not (checkdoc-char= (following-char) ?\"))) ; no doc string
+ (not (eq (following-char) ?\"))) ; no doc string
;; Sometimes old code has comments where the documentation should
;; be. Let's see if we can find the comment, and offer to turn it
;; into documentation for them.
@@ -1457,9 +1443,9 @@ regexp short cuts work. FP is the function defun information."
(if (> (point) e) (goto-char e)) ;of the form (defun n () "doc" nil)
(forward-char -1)
(cond
- ((and (checkdoc-char= (following-char) ?\")
+ ((and (eq (following-char) ?\")
;; A backslashed double quote at the end of a sentence
- (not (checkdoc-char= (preceding-char) ?\\)))
+ (not (eq (preceding-char) ?\\)))
;; We might have to add a period in this case
(forward-char -1)
(if (looking-at "[.!?]")
@@ -1782,7 +1768,7 @@ function,command,variable,option or symbol." ms1))))))
(let ((lim (save-excursion
(end-of-line)
;; check string-continuation
- (if (checkdoc-char= (preceding-char) ?\\)
+ (if (eq (preceding-char) ?\\)
(line-end-position 2)
(point))))
(rs nil) replace original (case-fold-search t))
@@ -2579,12 +2565,12 @@ This function returns non-nil if the text was replaced.
This function will not modify `match-data'."
(if (and checkdoc-autofix-flag
(not (eq checkdoc-autofix-flag 'never)))
- (let ((o (checkdoc-make-overlay start end))
+ (let ((o (make-overlay start end))
(ret nil)
(md (match-data)))
(unwind-protect
(progn
- (checkdoc-overlay-put o 'face 'highlight)
+ (overlay-put o 'face 'highlight)
(if (or (eq checkdoc-autofix-flag 'automatic)
(eq checkdoc-autofix-flag 'automatic-then-never)
(and (eq checkdoc-autofix-flag 'semiautomatic)
@@ -2601,9 +2587,9 @@ This function will not modify `match-data'."
(insert replacewith)
(if checkdoc-bouncy-flag (sit-for 0))
(setq ret t)))
- (checkdoc-delete-overlay o)
+ (delete-overlay o)
(set-match-data md))
- (checkdoc-delete-overlay o)
+ (delete-overlay o)
(set-match-data md))
(if (eq checkdoc-autofix-flag 'automatic-then-never)
(setq checkdoc-autofix-flag 'never))
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 3852ceb6c31..214adbc5817 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -437,22 +437,38 @@ as an integer unless JUNK-ALLOWED is non-nil."
;; Random numbers.
+(defun cl--random-time ()
+ (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
+ (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
+ v))
+
+;;;###autoload (autoload 'cl-random-state-p "cl-extra")
+(cl-defstruct (cl--random-state
+ (:copier nil)
+ (:predicate cl-random-state-p)
+ (:constructor nil)
+ (:constructor cl--make-random-state (vec)))
+ (i -1) (j 30) vec)
+
+(defvar cl--random-state (cl--make-random-state (cl--random-time)))
+
;;;###autoload
(defun cl-random (lim &optional state)
"Return a random nonnegative number less than LIM, an integer or float.
Optional second arg STATE is a random-state object."
(or state (setq state cl--random-state))
;; Inspired by "ran3" from Numerical Recipes. Additive congruential method.
- (let ((vec (aref state 3)))
+ (let ((vec (cl--random-state-vec state)))
(if (integerp vec)
(let ((i 0) (j (- 1357335 (abs (% vec 1357333)))) (k 1))
- (aset state 3 (setq vec (make-vector 55 nil)))
+ (setf (cl--random-state-vec state)
+ (setq vec (make-vector 55 nil)))
(aset vec 0 j)
(while (> (setq i (% (+ i 21) 55)) 0)
(aset vec i (setq j (prog1 k (setq k (- j k))))))
(while (< (setq i (1+ i)) 200) (cl-random 2 state))))
- (let* ((i (aset state 1 (% (1+ (aref state 1)) 55)))
- (j (aset state 2 (% (1+ (aref state 2)) 55)))
+ (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state)))
+ (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state)))
(n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
(if (integerp lim)
(if (<= lim 512) (% n lim)
@@ -466,17 +482,10 @@ Optional second arg STATE is a random-state object."
(defun cl-make-random-state (&optional state)
"Return a copy of random-state STATE, or of the internal state if omitted.
If STATE is t, return a new state object seeded from the time of day."
- (cond ((null state) (cl-make-random-state cl--random-state))
- ((vectorp state) (copy-tree state t))
- ((integerp state) (vector 'cl--random-state-tag -1 30 state))
- (t (cl-make-random-state (cl--random-time)))))
-
-;;;###autoload
-(defun cl-random-state-p (object)
- "Return t if OBJECT is a random-state object."
- (and (vectorp object) (= (length object) 4)
- (eq (aref object 0) 'cl--random-state-tag)))
-
+ (unless state (setq state cl--random-state))
+ (if (cl-random-state-p state)
+ (copy-tree state t)
+ (cl--make-random-state (if (integerp state) state (cl--random-time)))))
;; Implementation limits.
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index c64376b940f..00278996792 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
(defmacro cl--generic (name)
`(get ,name 'cl--generic))
+(defun cl-generic-p (f)
+ "Return non-nil if F is a generic function."
+ (and (symbolp f) (cl--generic f)))
+
(defun cl-generic-ensure-function (name &optional noerror)
(let (generic
(origname name))
@@ -182,8 +186,7 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
origname))
(if generic
(cl-assert (eq name (cl--generic-name generic)))
- (setf (cl--generic name) (setq generic (cl--generic-make name)))
- (defalias name (cl--generic-make-function generic)))
+ (setf (cl--generic name) (setq generic (cl--generic-make name))))
generic))
;;;###autoload
@@ -201,7 +204,17 @@ OPTIONS-AND-METHODS currently understands:
DEFAULT-BODY, if present, is used as the body of a default method.
\(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
- (declare (indent 2) (doc-string 3))
+ (declare (indent 2) (doc-string 3)
+ (debug
+ (&define [&or name ("setf" name :name setf)] listp
+ lambda-doc
+ [&rest [&or
+ ("declare" &rest sexp)
+ (":argument-precedence-order" &rest sexp)
+ (&define ":method" [&rest atom]
+ cl-generic-method-args lambda-doc
+ def-body)]]
+ def-body)))
(let* ((doc (if (stringp (car-safe options-and-methods))
(pop options-and-methods)))
(declarations nil)
@@ -410,7 +423,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
\(and can be extended) by the various methods of `cl-generic-generalizers'.
\(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)"
- (declare (doc-string 3) (indent 2)
+ (declare (doc-string 3) (indent defun)
(debug
(&define ; this means we are defining something
[&or name ("setf" name :name setf)]
@@ -419,7 +432,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
; Like in CLOS spec, we support
; any non-list values.
cl-generic-method-args ; arguments
- [ &optional stringp ] ; documentation string
+ lambda-doc ; documentation string
def-body))) ; part to be debugged
(let ((qualifiers nil))
(while (not (listp args))
@@ -501,25 +514,26 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
(cons method mt)
;; Keep the ordering; important for methods with :extra qualifiers.
(mapcar (lambda (x) (if (eq x (car me)) method x)) mt)))
- (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
- (cl--generic-name generic)
- qualifiers specializers))
- current-load-list :test #'equal)
- ;; FIXME: Try to avoid re-constructing a new function if the old one
- ;; is still valid (e.g. still empty method cache)?
- (let ((gfun (cl--generic-make-function generic))
- ;; Prevent `defalias' from recording this as the definition site of
- ;; the generic function.
- current-load-list)
- ;; For aliases, cl--generic-name gives us the actual name.
- (let ((purify-flag
- ;; BEWARE! Don't purify this function definition, since that leads
- ;; to memory corruption if the hash-tables it holds are modified
- ;; (the GC doesn't trace those pointers).
- nil))
+ (let ((sym (cl--generic-name generic))) ; Actual name (for aliases).
+ (unless (symbol-function sym)
+ (defalias sym 'dummy)) ;Record definition into load-history.
+ (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format
+ (cl--generic-name generic)
+ qualifiers specializers))
+ current-load-list :test #'equal)
+ ;; FIXME: Try to avoid re-constructing a new function if the old one
+ ;; is still valid (e.g. still empty method cache)?
+ (let ((gfun (cl--generic-make-function generic))
+ ;; Prevent `defalias' from recording this as the definition site of
+ ;; the generic function.
+ current-load-list
+ ;; BEWARE! Don't purify this function definition, since that leads
+ ;; to memory corruption if the hash-tables it holds are modified
+ ;; (the GC doesn't trace those pointers).
+ (purify-flag nil))
;; But do use `defalias', so that it interacts properly with nadvice,
;; e.g. for tracing/debug-on-entry.
- (defalias (cl--generic-name generic) gfun)))))
+ (defalias sym gfun)))))
(defmacro cl--generic-with-memoization (place &rest code)
(declare (indent 1) (debug t))
@@ -1023,6 +1037,20 @@ The value returned is a list of elements of the form
(push (cl--generic-method-info method) docs))))
docs))
+(defun cl--generic-method-files (method)
+ "Return a list of files where METHOD is defined by `cl-defmethod'.
+The list will have entries of the form (FILE . (METHOD ...))
+where (METHOD ...) contains the qualifiers and specializers of
+the method and is a suitable argument for
+`find-function-search-for-symbol'. Filenames are absolute."
+ (let (result)
+ (pcase-dolist (`(,file . ,defs) load-history)
+ (dolist (def defs)
+ (when (and (eq (car-safe def) 'cl-defmethod)
+ (eq (cadr def) method))
+ (push (cons file (cdr def)) result))))
+ result))
+
;;; Support for (head <val>) specializers.
;; For both the `eql' and the `head' specializers, the dispatch
@@ -1210,5 +1238,18 @@ Used internally for the (major-mode MODE) context specializers."
(progn (cl-assert (null modes)) mode)
`(derived-mode ,mode . ,modes))))
+;;; Support for unloading.
+
+(cl-defmethod loadhist-unload-element ((x (head cl-defmethod)))
+ (pcase-let*
+ ((`(,name ,qualifiers . ,specializers) (cdr x))
+ (generic (cl-generic-ensure-function name 'noerror)))
+ (when generic
+ (let* ((mt (cl--generic-method-table generic))
+ (me (cl--generic-member-method specializers qualifiers mt)))
+ (when me
+ (setf (cl--generic-method-table generic) (delq (car me) mt)))))))
+
+
(provide 'cl-generic)
;;; cl-generic.el ends here
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index df0e0a88583..17e2434f589 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el
index 936c852526c..da7176f662d 100644
--- a/lisp/emacs-lisp/cl-lib.el
+++ b/lisp/emacs-lisp/cl-lib.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -288,14 +288,6 @@ If true return the decimal value of digit CHAR in RADIX."
(let ((n (aref cl-digit-char-table char)))
(and n (< n (or radix 10)) n)))
-(defun cl--random-time ()
- (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
- (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i))))
- v))
-
-(defvar cl--random-state
- (vector 'cl--random-state-tag -1 30 (cl--random-time)))
-
(defconst cl-most-positive-float nil
"The largest value that a Lisp float can hold.
If your system supports infinities, this is the largest finite value.
@@ -639,7 +631,7 @@ If ALIST is non-nil, the new pairs are prepended to it."
(require 'cl-seq))
(defun cl--old-struct-type-of (orig-fun object)
- (or (and (vectorp object)
+ (or (and (vectorp object) (> (length object) 0)
(let ((tag (aref object 0)))
(when (and (symbolp tag)
(string-prefix-p "cl-struct-" (symbol-name tag)))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b1ada00f4a4..f5311041cce 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -172,14 +172,15 @@ The name is made by appending a number to PREFIX, default \"G\"."
(setq cl--gensym-counter (1+ cl--gensym-counter))))))
(make-symbol (format "%s%d" pfix num))))
+(defvar cl--gentemp-counter 0)
;;;###autoload
(defun cl-gentemp (&optional prefix)
"Generate a new interned symbol with a unique name.
-The name is made by appending a number to PREFIX, default \"G\"."
- (let ((pfix (if (stringp prefix) prefix "G"))
+The name is made by appending a number to PREFIX, default \"T\"."
+ (let ((pfix (if (stringp prefix) prefix "T"))
name)
- (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter)))
- (setq cl--gensym-counter (1+ cl--gensym-counter)))
+ (while (intern-soft (setq name (format "%s%d" pfix cl--gentemp-counter)))
+ (setq cl--gentemp-counter (1+ cl--gentemp-counter)))
(intern name)))
@@ -189,23 +190,37 @@ The name is made by appending a number to PREFIX, default \"G\"."
(&rest ("cl-declare" &rest sexp)))
(def-edebug-spec cl-declarations-or-string
- (&or stringp cl-declarations))
+ (&or lambda-doc cl-declarations))
(def-edebug-spec cl-lambda-list
- (([&rest arg]
+ (([&rest cl-lambda-arg]
[&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" arg]]
+ [&optional ["&rest" cl-lambda-arg]]
[&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
&optional "&allow-other-keys"]]
[&optional ["&aux" &rest
&or (symbolp &optional def-form) symbolp]]
- )))
+ . [&or arg nil])))
(def-edebug-spec cl-&optional-arg
- (&or (arg &optional def-form arg) arg))
+ (&or (cl-lambda-arg &optional def-form arg) arg))
(def-edebug-spec cl-&key-arg
- (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
+ (&or ([&or (symbolp cl-lambda-arg) arg] &optional def-form arg) arg))
+
+(def-edebug-spec cl-lambda-arg
+ (&or arg cl-lambda-list1))
+
+(def-edebug-spec cl-lambda-list1
+ (([&optional ["&whole" arg]] ;; only allowed at lower levels
+ [&rest cl-lambda-arg]
+ [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+ [&optional ["&rest" cl-lambda-arg]]
+ [&optional ["&key" cl-&key-arg &rest cl-&key-arg
+ &optional "&allow-other-keys"]]
+ [&optional ["&aux" &rest
+ &or (symbolp &optional def-form) symbolp]]
+ . [&or arg nil])))
(def-edebug-spec cl-type-spec sexp)
@@ -335,8 +350,8 @@ The full form of a Common Lisp function argument list is
[&key (([KEYWORD] VAR) [INITFORM [SVAR]])... [&allow-other-keys]]
[&aux (VAR [INITFORM])...])
-VAR maybe be replaced recursively with an argument list for
-destructing, `&whole' is supported within these sublists. If
+VAR may be replaced recursively with an argument list for
+destructuring, `&whole' is supported within these sublists. If
SVAR, INITFORM, and KEYWORD are all omitted, then `(VAR)' may be
written simply `VAR'. See the Info node `(cl)Argument Lists' for
more details.
@@ -429,8 +444,8 @@ The full form of a Common Lisp macro argument list is
[&aux (VAR [INITFORM])...]
[&environment VAR])
-VAR maybe be replaced recursively with an argument list for
-destructing, `&whole' is supported within these sublists. If
+VAR may be replaced recursively with an argument list for
+destructuring, `&whole' is supported within these sublists. If
SVAR, INITFORM, and KEYWORD are all omitted, then `(VAR)' may be
written simply `VAR'. See the Info node `(cl)Argument Lists' for
more details.
@@ -446,8 +461,8 @@ more details.
(def-edebug-spec cl-lambda-expr
(&define ("lambda" cl-lambda-list
- ;;cl-declarations-or-string
- ;;[&optional ("interactive" interactive)]
+ cl-declarations-or-string
+ [&optional ("interactive" interactive)]
def-body)))
;; Redefine function-form to also match cl-function
@@ -540,7 +555,7 @@ its argument list allows full Common Lisp conventions."
(if (memq '&environment args) (error "&environment used incorrectly"))
(let ((restarg (memq '&rest args))
(safety (if (cl--compiling-file) cl--optimize-safety 3))
- (keys nil)
+ (keys t)
(laterarg nil) (exactarg nil) minarg)
(or num (setq num 0))
(setq restarg (if (listp (cadr restarg))
@@ -595,6 +610,7 @@ its argument list allows full Common Lisp conventions."
(+ ,num (length ,restarg)))))
cl--bind-forms)))
(while (and (eq (car args) '&key) (pop args))
+ (unless (listp keys) (setq keys nil))
(while (and args (not (memq (car args) cl--lambda-list-keywords)))
(let ((arg (pop args)))
(or (consp arg) (setq arg (list arg)))
@@ -633,23 +649,32 @@ its argument list allows full Common Lisp conventions."
`'(nil ,(cl--const-expr-val def))
`(list nil ,def))))))))
(push karg keys)))))
- (setq keys (nreverse keys))
+ (when (consp keys) (setq keys (nreverse keys)))
(or (and (eq (car args) '&allow-other-keys) (pop args))
- (null keys) (= safety 0)
- (let* ((var (make-symbol "--cl-keys--"))
- (allow '(:allow-other-keys))
- (check `(while ,var
- (cond
- ((memq (car ,var) ',(append keys allow))
- (setq ,var (cdr (cdr ,var))))
- ((car (cdr (memq (quote ,@allow) ,restarg)))
- (setq ,var nil))
- (t
- (error
- ,(format "Keyword argument %%s not one of %s"
- keys)
- (car ,var)))))))
- (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))
+ (= safety 0)
+ (cond
+ ((eq keys t) nil) ;No &keys at all
+ ((null keys) ;A &key but no actual keys specified.
+ (push `(when ,restarg
+ (error ,(format "Keyword argument %%s not one of %s"
+ keys)
+ (car ,restarg)))
+ cl--bind-forms))
+ (t
+ (let* ((var (make-symbol "--cl-keys--"))
+ (allow '(:allow-other-keys))
+ (check `(while ,var
+ (cond
+ ((memq (car ,var) ',(append keys allow))
+ (setq ,var (cdr (cdr ,var))))
+ ((car (cdr (memq (quote ,@allow) ,restarg)))
+ (setq ,var nil))
+ (t
+ (error
+ ,(format "Keyword argument %%s not one of %s"
+ keys)
+ (car ,var)))))))
+ (push `(let ((,var ,restarg)) ,check) cl--bind-forms)))))
(cl--do-&aux args)
nil)))
@@ -669,7 +694,7 @@ its argument list allows full Common Lisp conventions."
(defmacro cl-destructuring-bind (args expr &rest body)
"Bind the variables in ARGS to the result of EXPR and execute BODY."
(declare (indent 2)
- (debug (&define cl-macro-list def-form cl-declarations def-body)))
+ (debug (&define cl-macro-list1 def-form cl-declarations def-body)))
(let* ((cl--bind-lets nil) (cl--bind-forms nil)
(cl--bind-defs nil) (cl--bind-block 'cl-none) (cl--bind-enquote nil))
(cl--do-arglist (or args '(&aux)) expr)
@@ -2073,60 +2098,65 @@ except that it additionally expands symbol macros."
(setq exp (cons 'setq args))
;; Don't loop further.
nil)))
- (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
- ;; CL's symbol-macrolet treats re-bindings as candidates for
- ;; expansion (turning the let into a letf if needed), contrary to
- ;; Common-Lisp where such re-bindings hide the symbol-macro.
- (let ((letf nil) (found nil) (nbs ()))
- (dolist (binding bindings)
- (let* ((var (if (symbolp binding) binding (car binding)))
- (sm (assq var venv)))
- (push (if (not (cdr sm))
- binding
- (let ((nexp (cadr sm)))
- (setq found t)
- (unless (symbolp nexp) (setq letf t))
- (cons nexp (cdr-safe binding))))
- nbs)))
- (when found
- (setq exp `(,(if letf
- (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
- (car exp))
- ,(nreverse nbs)
- ,@body)))))
- ;; FIXME: The behavior of CL made sense in a dynamically scoped
- ;; language, but for lexical scoping, Common-Lisp's behavior might
- ;; make more sense (and indeed, CL behaves like Common-Lisp w.r.t
- ;; lexical-let), so maybe we should adjust the behavior based on
- ;; the use of lexical-binding.
+ ;; CL's symbol-macrolet used to treat re-bindings as candidates for
+ ;; expansion (turning the let into a letf if needed), contrary to
+ ;; Common-Lisp where such re-bindings hide the symbol-macro.
+ ;; Not sure if there actually is code out there which depends
+ ;; on this behavior (haven't found any yet).
+ ;; Such code should explicitly use `cl-letf' instead, I think.
+ ;;
;; (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
- ;; (let ((nbs ()) (found nil))
+ ;; (let ((letf nil) (found nil) (nbs ()))
;; (dolist (binding bindings)
;; (let* ((var (if (symbolp binding) binding (car binding)))
- ;; (name (symbol-name var))
- ;; (val (and found (consp binding) (eq 'let* (car exp))
- ;; (list (macroexpand-all (cadr binding)
- ;; env)))))
- ;; (push (if (assq name env)
- ;; ;; This binding should hide its symbol-macro,
- ;; ;; but given the way macroexpand-all works, we
- ;; ;; can't prevent application of `env' to the
- ;; ;; sub-expressions, so we need to α-rename this
- ;; ;; variable instead.
- ;; (let ((nvar (make-symbol
- ;; (copy-sequence name))))
- ;; (setq found t)
- ;; (push (list name nvar) env)
- ;; (cons nvar (or val (cdr-safe binding))))
- ;; (if val (cons var val) binding))
+ ;; (sm (assq var venv)))
+ ;; (push (if (not (cdr sm))
+ ;; binding
+ ;; (let ((nexp (cadr sm)))
+ ;; (setq found t)
+ ;; (unless (symbolp nexp) (setq letf t))
+ ;; (cons nexp (cdr-safe binding))))
;; nbs)))
;; (when found
- ;; (setq exp `(,(car exp)
+ ;; (setq exp `(,(if letf
+ ;; (if (eq (car exp) 'let) 'cl-letf 'cl-letf*)
+ ;; (car exp))
;; ,(nreverse nbs)
- ;; ,@(macroexp-unprogn
- ;; (macroexpand-all (macroexp-progn body)
- ;; env)))))
- ;; nil))
+ ;; ,@body)))))
+ ;;
+ ;; We implement the Common-Lisp behavior, instead (see bug#26073):
+ ;; The behavior of CL made sense in a dynamically scoped
+ ;; language, but nowadays, lexical scoping semantics is more often
+ ;; expected.
+ (`(,(or `let `let*) . ,(or `(,bindings . ,body) dontcare))
+ (let ((nbs ()) (found nil))
+ (dolist (binding bindings)
+ (let* ((var (if (symbolp binding) binding (car binding)))
+ (val (and found (consp binding) (eq 'let* (car exp))
+ (list (macroexpand-all (cadr binding)
+ env)))))
+ (push (if (assq var venv)
+ ;; This binding should hide its symbol-macro,
+ ;; but given the way macroexpand-all works
+ ;; (i.e. the `env' we receive as input will be
+ ;; (re)applied to the code we return), we can't
+ ;; prevent application of `env' to the
+ ;; sub-expressions, so we need to α-rename this
+ ;; variable instead.
+ (let ((nvar (make-symbol (symbol-name var))))
+ (setq found t)
+ (push (list var nvar) venv)
+ (push (cons :cl-symbol-macros venv) env)
+ (cons nvar (or val (cdr-safe binding))))
+ (if val (cons var val) binding))
+ nbs)))
+ (when found
+ (setq exp `(,(car exp)
+ ,(nreverse nbs)
+ ,@(macroexp-unprogn
+ (macroexpand-all (macroexp-progn body)
+ env)))))
+ nil))
)))
exp))
@@ -2410,10 +2440,11 @@ Each PLACE may be a symbol, or any generalized variable allowed by `setf'.
(pcase-let ((`(,vold ,_getter ,setter ,_vnew) x))
(funcall setter vold)))
binds))))
- (let ((binding (car bindings)))
- (gv-letplace (getter setter) (car binding)
+ (let* ((binding (car bindings))
+ (place (macroexpand (car binding) macroexpand-all-environment)))
+ (gv-letplace (getter setter) place
(macroexp-let2 nil vnew (cadr binding)
- (if (symbolp (car binding))
+ (if (symbolp place)
;; Special-case for simple variables.
(cl--letf (cdr bindings)
(cons `(,getter ,(if (cdr binding) vnew getter))
@@ -2437,8 +2468,12 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
the PLACE is not modified before executing BODY.
\(fn ((PLACE VALUE) ...) BODY...)"
- (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body)))
- (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
+ (declare (indent 1) (debug ((&rest [&or (symbolp form)
+ (gate gv-place &optional form)])
+ body)))
+ (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))
+ (not (assq (caar bindings)
+ (alist-get :cl-symbol-macros macroexpand-all-environment))))
`(let ,bindings ,@body)
(cl--letf bindings () () body)))
@@ -2503,8 +2538,9 @@ The function's arguments should be treated as immutable.
,(if (memq '&key args)
`(&whole cl-whole &cl-quote ,@args)
(cons '&cl-quote args))
+ ,(format "compiler-macro for inlining `%s'." name)
(cl--defsubst-expand
- ',argns '(cl-block ,name ,@body)
+ ',argns '(cl-block ,name ,@(cdr (macroexp-parse-body body)))
;; We used to pass `simple' as
;; (not (or unsafe (cl-expr-access-order pbody argns)))
;; But this is much too simplistic since it
diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index ab6354de7cd..e550f5a095f 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index 89a71d1b6c5..4fc178c29aa 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -78,6 +78,16 @@ call other entry points instead, such as `cl-prin1'."
(cl-print-object (aref object i) stream))
(princ "]" stream))
+(cl-defmethod cl-print-object ((object hash-table) stream)
+ (princ "#<hash-table " stream)
+ (princ (hash-table-test object) stream)
+ (princ " " stream)
+ (princ (hash-table-count object) stream)
+ (princ "/" stream)
+ (princ (hash-table-size object) stream)
+ (princ (format " 0x%x" (sxhash object)) stream)
+ (princ ">" stream))
+
(define-button-type 'help-byte-code
'follow-link t
'action (lambda (button)
@@ -85,12 +95,13 @@ call other entry points instead, such as `cl-prin1'."
'help-echo (purecopy "mouse-2, RET: disassemble this function"))
(defvar cl-print-compiled nil
- "Control how to print byte-compiled functions. Can be:
+ "Control how to print byte-compiled functions.
+Acceptable values include:
- `static' to print the vector of constants.
- `disassemble' to print the disassembly of the code.
- nil to skip printing any details about the code.")
-(defvar cl-print-compiled-button nil
+(defvar cl-print-compiled-button t
"Control how to print byte-compiled functions into buffers.
When the stream is a buffer, make the bytecode part of the output
into a button whose action shows the function's disassembly.")
@@ -105,10 +116,11 @@ into a button whose action shows the function's disassembly.")
(if args
(prin1 args stream)
(princ "()" stream)))
- (let ((doc (documentation object 'raw)))
- (when doc
- (princ " " stream)
- (prin1 doc stream)))
+ (pcase (help-split-fundoc (documentation object 'raw) object)
+ ;; Drop args which `help-function-arglist' already printed.
+ (`(,_usage . ,(and doc (guard (stringp doc))))
+ (princ " " stream)
+ (prin1 doc stream)))
(let ((inter (interactive-form object)))
(when inter
(princ " " stream)
@@ -130,7 +142,7 @@ into a button whose action shows the function's disassembly.")
(let ((button-start (and cl-print-compiled-button
(bufferp stream)
(with-current-buffer stream (point)))))
- (princ "#<bytecode>" stream)
+ (princ (format "#<bytecode 0x%x>" (sxhash object)) stream)
(when (eq cl-print-compiled 'static)
(princ " " stream)
(cl-print-object (aref object 2) stream))
@@ -252,6 +264,11 @@ into a button whose action shows the function's disassembly.")
;;;###autoload
(defun cl-prin1 (object &optional stream)
+ "Print OBJECT on STREAM according to its type.
+Output is further controlled by the variables
+`cl-print-readably', `cl-print-compiled', along with output
+variables for the standard printing functions. See Info
+node `(elisp)Output Variables'."
(cond
(cl-print-readably (prin1 object stream))
((not print-circle) (cl-print-object object stream))
@@ -261,6 +278,7 @@ into a button whose action shows the function's disassembly.")
;;;###autoload
(defun cl-prin1-to-string (object)
+ "Return a string containing the `cl-prin1'-printed representation of OBJECT."
(with-temp-buffer
(cl-prin1 object (current-buffer))
(buffer-string)))
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
index 67ff1a00bd3..6a21936ebcf 100644
--- a/lisp/emacs-lisp/cl-seq.el
+++ b/lisp/emacs-lisp/cl-seq.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index 73eb9a4e866..5ac40234f0f 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -250,7 +250,6 @@
eval-when
destructuring-bind
gentemp
- gensym
pairlis
acons
subst
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
index b6936131fc7..25dc77c7258 100644
--- a/lisp/emacs-lisp/copyright.el
+++ b/lisp/emacs-lisp/copyright.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -186,9 +186,10 @@ skips to the end of all the years."
(substring copyright-current-year -2))
(if (or noquery
(save-window-excursion
- (switch-to-buffer (current-buffer))
- ;; Fixes some point-moving oddness (bug#2209).
+ ;; switch-to-buffer might move point when
+ ;; switch-to-buffer-preserve-window-point is non-nil.
(save-excursion
+ (switch-to-buffer (current-buffer))
(y-or-n-p (if replace
(concat "Replace copyright year(s) by "
copyright-current-year "? ")
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 0fad27cafe9..2a417f1758b 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el
index e68b429258d..b6e25b9684f 100644
--- a/lisp/emacs-lisp/cursor-sensor.el
+++ b/lisp/emacs-lisp/cursor-sensor.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 83456fc31a2..1ebbc0e0086 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -49,6 +49,13 @@ the middle is discarded, and just the beginning and end are displayed."
:group 'debugger
:version "21.1")
+(defcustom debugger-print-function #'cl-prin1
+ "Function used to print values in the debugger backtraces."
+ :type '(choice (const cl-prin1)
+ (const prin1)
+ function)
+ :version "26.1")
+
(defcustom debugger-bury-or-kill 'bury
"What to do with the debugger buffer when exiting `debug'.
The value affects the behavior of operations on any window
@@ -247,7 +254,9 @@ first will be printed into the backtrace buffer."
;; Unshow debugger-buffer.
(quit-restore-window debugger-window debugger-bury-or-kill)
;; Restore current buffer (Bug#12502).
- (set-buffer debugger-old-buffer))))
+ (set-buffer debugger-old-buffer)))
+ ;; Forget debugger window, it won't be back (Bug#17882).
+ (setq debugger-previous-window nil))
;; Restore previous state of debugger-buffer in case we were
;; in a recursive invocation of the debugger, otherwise just
;; erase the buffer and put it into fundamental mode.
@@ -264,6 +273,46 @@ first will be printed into the backtrace buffer."
(setq debug-on-next-call debugger-step-after-exit)
debugger-value)))
+(defun debugger--print (obj &optional stream)
+ (condition-case err
+ (funcall debugger-print-function obj stream)
+ (error
+ (message "Error in debug printer: %S" err)
+ (prin1 obj stream))))
+
+(defun debugger-insert-backtrace (frames do-xrefs)
+ "Format and insert the backtrace FRAMES at point.
+Make functions into cross-reference buttons if DO-XREFS is non-nil."
+ (let ((standard-output (current-buffer))
+ (eval-buffers eval-buffer-list))
+ (require 'help-mode) ; Define `help-function-def' button type.
+ (pcase-dolist (`(,evald ,fun ,args ,flags) frames)
+ (insert (if (plist-get flags :debug-on-exit)
+ "* " " "))
+ (let ((fun-file (and do-xrefs (symbol-file fun 'defun)))
+ (fun-pt (point)))
+ (cond
+ ((and evald (not debugger-stack-frame-as-list))
+ (debugger--print fun)
+ (if args (debugger--print args) (princ "()")))
+ (t
+ (debugger--print (cons fun args))
+ (cl-incf fun-pt)))
+ (when fun-file
+ (make-text-button fun-pt (+ fun-pt (length (symbol-name fun)))
+ :type 'help-function-def
+ 'help-args (list fun fun-file))))
+ ;; After any frame that uses eval-buffer, insert a line that
+ ;; states the buffer position it's reading at.
+ (when (and eval-buffers (memq fun '(eval-buffer eval-region)))
+ (insert (format " ; Reading at buffer position %d"
+ ;; This will get the wrong result if there are
+ ;; two nested eval-region calls for the same
+ ;; buffer. That's not a very useful case.
+ (with-current-buffer (pop eval-buffers)
+ (point)))))
+ (insert "\n"))))
+
(defun debugger-setup-buffer (args)
"Initialize the `*Backtrace*' buffer for entry to the debugger.
That buffer should be current already."
@@ -271,27 +320,20 @@ That buffer should be current already."
(erase-buffer)
(set-buffer-multibyte t) ;Why was it nil ? -stef
(setq buffer-undo-list t)
- (let ((standard-output (current-buffer))
- (print-escape-newlines t)
- (print-level 8)
- (print-length 50))
- ;; FIXME the debugger could pass a custom callback to mapbacktrace
- ;; instead of manipulating printed results.
- (mapbacktrace #'backtrace--print-frame 'debug))
- (goto-char (point-min))
- (delete-region (point)
- (progn
- (forward-line (if (eq (car args) 'debug)
- ;; Remove debug--implement-debug-on-entry
- ;; and the advice's `apply' frame.
- 3
- 1))
- (point)))
(insert "Debugger entered")
- ;; lambda is for debug-on-call when a function call is next.
- ;; debug is for debug-on-entry function called.
- (let ((pos (point)))
+ (let ((frames (nthcdr
+ ;; Remove debug--implement-debug-on-entry and the
+ ;; advice's `apply' frame.
+ (if (eq (car args) 'debug) 3 1)
+ (backtrace-frames 'debug)))
+ (print-escape-newlines t)
+ (print-escape-control-characters t)
+ (print-level 8)
+ (print-length 50)
+ (pos (point)))
(pcase (car args)
+ ;; lambda is for debug-on-call when a function call is next.
+ ;; debug is for debug-on-entry function called.
((or `lambda `debug)
(insert "--entering a function:\n")
(setq pos (1- (point))))
@@ -300,11 +342,9 @@ That buffer should be current already."
(insert "--returning value: ")
(setq pos (point))
(setq debugger-value (nth 1 args))
- (prin1 debugger-value (current-buffer))
- (insert ?\n)
- (delete-char 1)
- (insert ? )
- (beginning-of-line))
+ (debugger--print debugger-value (current-buffer))
+ (setf (cl-getf (nth 3 (car frames)) :debug-on-exit) nil)
+ (insert ?\n))
;; Watchpoint triggered.
((and `watchpoint (let `(,symbol ,newval . ,details) (cdr args)))
(insert
@@ -327,7 +367,7 @@ That buffer should be current already."
(`error
(insert "--Lisp error: ")
(setq pos (point))
- (prin1 (nth 1 args) (current-buffer))
+ (debugger--print (nth 1 args) (current-buffer))
(insert ?\n))
;; debug-on-call, when the next thing is an eval.
(`t
@@ -337,98 +377,15 @@ That buffer should be current already."
(_
(insert ": ")
(setq pos (point))
- (prin1 (if (eq (car args) 'nil)
- (cdr args) args)
- (current-buffer))
+ (debugger--print
+ (if (eq (car args) 'nil)
+ (cdr args) args)
+ (current-buffer))
(insert ?\n)))
+ (debugger-insert-backtrace frames t)
;; Place point on "stack frame 0" (bug#15101).
- (goto-char pos))
- ;; After any frame that uses eval-buffer,
- ;; insert a line that states the buffer position it's reading at.
- (save-excursion
- (let ((tem eval-buffer-list))
- (while (and tem
- (re-search-forward "^ eval-\\(buffer\\|region\\)(" nil t))
- (end-of-line)
- (insert (format " ; Reading at buffer position %d"
- ;; This will get the wrong result
- ;; if there are two nested eval-region calls
- ;; for the same buffer. That's not a very useful case.
- (with-current-buffer (car tem)
- (point))))
- (pop tem))))
- (debugger-make-xrefs))
-
-(defun debugger-make-xrefs (&optional buffer)
- "Attach cross-references to function names in the `*Backtrace*' buffer."
- (interactive "b")
- (with-current-buffer (or buffer (current-buffer))
- (save-excursion
- (setq buffer (current-buffer))
- (let ((inhibit-read-only t)
- (old-end (point-min)) (new-end (point-min)))
- ;; If we saved an old backtrace, find the common part
- ;; between the new and the old.
- ;; Compare line by line, starting from the end,
- ;; because that's the part that is likely to be unchanged.
- (if debugger-previous-backtrace
- (let (old-start new-start (all-match t))
- (goto-char (point-max))
- (with-temp-buffer
- (insert debugger-previous-backtrace)
- (while (and all-match (not (bobp)))
- (setq old-end (point))
- (forward-line -1)
- (setq old-start (point))
- (with-current-buffer buffer
- (setq new-end (point))
- (forward-line -1)
- (setq new-start (point)))
- (if (not (zerop
- (let ((case-fold-search nil))
- (compare-buffer-substrings
- (current-buffer) old-start old-end
- buffer new-start new-end))))
- (setq all-match nil))))
- ;; Now new-end is the position of the start of the
- ;; unchanged part in the current buffer, and old-end is
- ;; the position of that same text in the saved old
- ;; backtrace. But we must subtract (point-min) since strings are
- ;; indexed in origin 0.
-
- ;; Replace the unchanged part of the backtrace
- ;; with the text from debugger-previous-backtrace,
- ;; since that already has the proper xrefs.
- ;; With this optimization, we only need to scan
- ;; the changed part of the backtrace.
- (delete-region new-end (point-max))
- (goto-char (point-max))
- (insert (substring debugger-previous-backtrace
- (- old-end (point-min))))
- ;; Make the unchanged part of the backtrace inaccessible
- ;; so it won't be scanned.
- (narrow-to-region (point-min) new-end)))
-
- ;; Scan the new part of the backtrace, inserting xrefs.
- (goto-char (point-min))
- (while (progn
- (goto-char (+ (point) 2))
- (skip-syntax-forward "^w_")
- (not (eobp)))
- (let* ((beg (point))
- (end (progn (skip-syntax-forward "w_") (point)))
- (sym (intern-soft (buffer-substring-no-properties
- beg end)))
- (file (and sym (symbol-file sym 'defun))))
- (when file
- (goto-char beg)
- ;; help-xref-button needs to operate on something matched
- ;; by a regexp, so set that up for it.
- (re-search-forward "\\(\\sw\\|\\s_\\)+")
- (help-xref-button 0 'help-function-def sym file)))
- (forward-line 1))
- (widen))
- (setq debugger-previous-backtrace (buffer-string)))))
+ (goto-char pos)))
+
(defun debugger-step-through ()
"Proceed, stepping through subexpressions of this expression.
@@ -466,7 +423,7 @@ will be used, such as in a debug on exit from a frame."
"from an error" "at function entrance")))
(setq debugger-value val)
(princ "Returning " t)
- (prin1 debugger-value)
+ (debugger--print debugger-value)
(save-excursion
;; Check to see if we've flagged some frame for debug-on-exit, in which
;; case we'll probably come back to the debugger soon.
@@ -581,7 +538,7 @@ The environment used is the one when entering the activation frame at point."
(debugger-env-macro
(let ((val (backtrace-eval exp nframe base)))
(prog1
- (prin1 val t)
+ (debugger--print val t)
(let ((str (eval-expression-print-format val)))
(if str (princ str t))))))))
@@ -603,7 +560,7 @@ The environment used is the one when entering the activation frame at point."
(insert "\n ")
(prin1 symbol (current-buffer))
(insert " = ")
- (prin1 value (current-buffer))))))))
+ (debugger--print value (current-buffer))))))))
(defun debugger--show-locals ()
"For the frame at point, insert locals and add text properties."
@@ -866,9 +823,13 @@ To specify a nil argument interactively, exit with an empty minibuffer."
'type 'help-function
'help-args (list fun))
(terpri))
- (terpri)
- (princ "Note: if you have redefined a function, then it may no longer\n")
- (princ "be set to debug on entry, even if it is in the list."))))))
+ ;; Now that debug--function-list uses advice-member-p, its
+ ;; output should be reliable (except for bugs and the exceptional
+ ;; case where some other advice ends up overriding ours).
+ ;;(terpri)
+ ;;(princ "Note: if you have redefined a function, then it may no longer\n")
+ ;;(princ "be set to debug on entry, even if it is in the list.")
+ )))))
(defun debug--implement-debug-watch (symbol newval op where)
"Conditionally call the debugger.
diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el
index fffe972460c..751291afa88 100644
--- a/lisp/emacs-lisp/derived.el
+++ b/lisp/emacs-lisp/derived.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -203,11 +203,13 @@ See Info node `(elisp)Derived Modes' for more details."
parent child docstring syntax abbrev))
`(progn
- (defvar ,hook nil
- ,(format "Hook run after entering %s mode.
+ (defvar ,hook nil)
+ (unless (get ',hook 'variable-documentation)
+ (put ',hook 'variable-documentation
+ ,(format "Hook run after entering %s mode.
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
- name))
+ name)))
(unless (boundp ',map)
(put ',map 'definition-name ',child))
(with-no-warnings (defvar ,map (make-sparse-keymap)))
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 66673b4d26c..90d5001c841 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el
index 158b9212fbd..6293d71470d 100644
--- a/lisp/emacs-lisp/easy-mmode.el
+++ b/lisp/emacs-lisp/easy-mmode.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -309,11 +309,13 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
;; up-to-here.
:autoload-end
- (defvar ,hook nil
- ,(format "Hook run after entering or leaving `%s'.
+ (defvar ,hook nil)
+ (unless (get ',hook 'variable-documentation)
+ (put ',hook 'variable-documentation
+ ,(format "Hook run after entering or leaving `%s'.
No problems result if this variable is not bound.
`add-hook' automatically binds it. (This is true for all hook variables.)"
- modefun))
+ modefun)))
;; Define the minor-mode keymap.
,(unless (symbolp keymap) ;nil is also a symbol.
@@ -543,6 +545,7 @@ Valid keywords and arguments are:
"Define a constant M whose value is the result of `easy-mmode-define-keymap'.
The M, BS, and ARGS arguments are as per that function. DOC is
the constant's documentation."
+ (declare (indent 1))
`(defconst ,m
(easy-mmode-define-keymap ,bs nil (if (boundp ',m) ,m) ,(cons 'list args))
,doc))
@@ -569,6 +572,7 @@ the constant's documentation."
(defmacro easy-mmode-defsyntax (st css doc &rest args)
"Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX)."
+ (declare (indent 1))
`(progn
(autoload 'easy-mmode-define-syntax "easy-mmode")
(defconst ,st (easy-mmode-define-syntax ,css ,(cons 'list args)) ,doc)))
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
index 4fc9a783a5e..35b2af1a3f7 100644
--- a/lisp/emacs-lisp/easymenu.el
+++ b/lisp/emacs-lisp/easymenu.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 65e30f86778..dec986ae3e3 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -906,7 +906,7 @@ circular objects. Let `read' read everything else."
;; with the object itself, wherever it occurs.
(forward-char 1)
(let ((obj (edebug-read-storing-offsets stream)))
- (substitute-object-in-subtree obj placeholder)
+ (lread--substitute-object-in-subtree obj placeholder t)
(throw 'return (setf (cdr elem) obj)))))
((eq ?# (following-char))
;; #n# returns a previously read object.
@@ -950,7 +950,8 @@ circular objects. Let `read' read everything else."
;;; Cursors for traversal of list and vector elements with offsets.
-(defvar edebug-dotted-spec nil)
+(defvar edebug-dotted-spec nil
+ "Set to t when matching after the dot in a dotted spec list.")
(defun edebug-new-cursor (expressions offsets)
;; Return a new cursor for EXPRESSIONS with OFFSETS.
@@ -1065,6 +1066,32 @@ circular objects. Let `read' read everything else."
(defvar edebug-error-point nil)
(defvar edebug-best-error nil)
+;; Functions which may be used to extend Edebug's functionality. See
+;; Testcover for an example.
+(defvar edebug-after-instrumentation-function #'identity
+ "Function to run on code after instrumentation for debugging.
+The function is called with one argument, a FORM which has just
+been instrumented for Edebugging, and it should return either FORM
+or a replacement form to use in its place.")
+
+(defvar edebug-new-definition-function #'edebug-new-definition
+ "Function to call after Edebug wraps a new definition.
+After Edebug has initialized its own data, this function is
+called with one argument, the symbol associated with the
+definition, which may be the actual symbol defined or one
+generated by Edebug.")
+
+(defvar edebug-behavior-alist
+ '((edebug edebug-default-enter edebug-slow-before edebug-slow-after))
+ "Alist describing the runtime behavior of Edebug's instrumented code.
+Each definition instrumented by Edebug will have a
+`edebug-behavior' property which is a key to this alist. When
+the instrumented code is running, Edebug will look here for the
+implementations of `edebug-enter', `edebug-before', and
+`edebug-after'. Edebug's instrumentation may be used for a new
+purpose by adding an entry to this alist, and setting
+`edebug-new-definition-function' to a function which sets
+`edebug-behavior' for the definition.")
(defun edebug-read-and-maybe-wrap-form ()
;; Read a form and wrap it with edebug calls, if the conditions are right.
@@ -1124,47 +1151,47 @@ circular objects. Let `read' read everything else."
(eq 'symbol (edebug-next-token-class)))
(read (current-buffer))))))
;;;(message "all defs: %s all forms: %s" edebug-all-defs edebug-all-forms)
- (cond
- (defining-form-p
- (if (or edebug-all-defs edebug-all-forms)
- ;; If it is a defining form and we are edebugging defs,
- ;; then let edebug-list-form start it.
- (let ((cursor (edebug-new-cursor
- (list (edebug-read-storing-offsets (current-buffer)))
- (list edebug-offsets))))
- (car
- (edebug-make-form-wrapper
- cursor
- (edebug-before-offset cursor)
- (1- (edebug-after-offset cursor))
- (list (cons (symbol-name def-kind) (cdr spec))))))
-
- ;; Not edebugging this form, so reset the symbol's edebug
- ;; property to be just a marker at the definition's source code.
- ;; This only works for defs with simple names.
- (put def-name 'edebug (point-marker))
- ;; Also nil out dependent defs.
- '(mapcar (function
- (lambda (def)
- (put def-name 'edebug nil)))
- (get def-name 'edebug-dependents))
- (edebug-read-sexp)))
-
- ;; If all forms are being edebugged, explicitly wrap it.
- (edebug-all-forms
- (let ((cursor (edebug-new-cursor
- (list (edebug-read-storing-offsets (current-buffer)))
- (list edebug-offsets))))
- (edebug-make-form-wrapper
- cursor
- (edebug-before-offset cursor)
- (edebug-after-offset cursor)
- nil)))
-
- ;; Not a defining form, and not edebugging.
- (t (edebug-read-sexp)))
- ))
-
+ (let ((result
+ (cond
+ (defining-form-p
+ (if (or edebug-all-defs edebug-all-forms)
+ ;; If it is a defining form and we are edebugging defs,
+ ;; then let edebug-list-form start it.
+ (let ((cursor (edebug-new-cursor
+ (list (edebug-read-storing-offsets (current-buffer)))
+ (list edebug-offsets))))
+ (car
+ (edebug-make-form-wrapper
+ cursor
+ (edebug-before-offset cursor)
+ (1- (edebug-after-offset cursor))
+ (list (cons (symbol-name def-kind) (cdr spec))))))
+
+ ;; Not edebugging this form, so reset the symbol's edebug
+ ;; property to be just a marker at the definition's source code.
+ ;; This only works for defs with simple names.
+ (put def-name 'edebug (point-marker))
+ ;; Also nil out dependent defs.
+ '(mapcar (function
+ (lambda (def)
+ (put def-name 'edebug nil)))
+ (get def-name 'edebug-dependents))
+ (edebug-read-sexp)))
+
+ ;; If all forms are being edebugged, explicitly wrap it.
+ (edebug-all-forms
+ (let ((cursor (edebug-new-cursor
+ (list (edebug-read-storing-offsets (current-buffer)))
+ (list edebug-offsets))))
+ (edebug-make-form-wrapper
+ cursor
+ (edebug-before-offset cursor)
+ (edebug-after-offset cursor)
+ nil)))
+
+ ;; Not a defining form, and not edebugging.
+ (t (edebug-read-sexp)))))
+ (funcall edebug-after-instrumentation-function result))))
(defvar edebug-def-args) ; args of defining form.
(defvar edebug-def-interactive) ; is it an emacs interactive function?
@@ -1193,7 +1220,7 @@ circular objects. Let `read' read everything else."
;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
;; Do this after parsing since that may find a name.
(setq edebug-def-name
- (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon")))
+ (or edebug-def-name edebug-old-def-name (gensym "edebug-anon")))
`(edebug-enter
(quote ,edebug-def-name)
,(if edebug-inside-func
@@ -1332,7 +1359,6 @@ expressions; a `progn' form will be returned enclosing these forms."
;; (message "defining: %s" edebug-def-name) (sit-for 2)
(edebug-make-top-form-data-entry form-data-entry)
- (message "Edebug: %s" edebug-def-name)
;;(debug edebug-def-name)
;; Destructively reverse edebug-offset-list and make vector from it.
@@ -1358,9 +1384,16 @@ expressions; a `progn' form will be returned enclosing these forms."
edebug-offset-list
edebug-top-window-data
))
+
+ (funcall edebug-new-definition-function edebug-def-name)
result
)))
+(defun edebug-new-definition (def-name)
+ "Set up DEF-NAME to use Edebug's instrumentation functions."
+ (put def-name 'edebug-behavior 'edebug)
+ (message "Edebug: %s" def-name))
+
(defun edebug-clear-frequency-count (name)
;; Create initial frequency count vector.
@@ -1494,8 +1527,6 @@ expressions; a `progn' form will be returned enclosing these forms."
;;; Matching of specs.
-(defvar edebug-after-dotted-spec nil)
-
(defvar edebug-matching-depth 0) ;; initial value
@@ -1556,36 +1587,48 @@ expressions; a `progn' form will be returned enclosing these forms."
(let ((edebug-dotted-spec t));; Containing spec list was dotted.
(edebug-match-specs cursor (list specs) remainder-handler)))
- ;; Is the form dotted?
- ((not (listp (edebug-cursor-expressions cursor)));; allow nil
+ ;; The reason for processing here &optional, &rest, and vectors
+ ;; which might contain them even when the form is dotted is to
+ ;; allow them to match nothing, so we can advance to the dotted
+ ;; part of the spec.
+ ((or (listp (edebug-cursor-expressions cursor))
+ (vectorp (car specs))
+ (memq (car specs) '(&optional &rest))) ; Process normally.
+ ;; (message "%scursor=%s specs=%s"
+ ;; (make-string edebug-matching-depth ?|) cursor (car specs))
+ (let* ((spec (car specs))
+ (rest)
+ (first-char (and (symbolp spec) (aref (symbol-name spec) 0)))
+ (match (cond
+ ((eq ?& first-char);; "&" symbols take all following specs.
+ (funcall (get-edebug-spec spec) cursor (cdr specs)))
+ ((eq ?: first-char);; ":" symbols take one following spec.
+ (setq rest (cdr (cdr specs)))
+ (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
+ (t;; Any other normal spec.
+ (setq rest (cdr specs))
+ (edebug-match-one-spec cursor spec)))))
+ ;; The first match result may not be a list, which can happen
+ ;; when matching the tail of a dotted list. In that case
+ ;; there is no remainder.
+ (if (listp match)
+ (nconc match
+ (funcall remainder-handler cursor rest remainder-handler))
+ match)))
+
+ ;; Must be a dotted form, with no remaining &rest or &optional specs to
+ ;; match.
+ (t
(if (not edebug-dotted-spec)
(edebug-no-match cursor "Dotted spec required."))
;; Cancel dotted spec and dotted form.
(let ((edebug-dotted-spec)
- (this-form (edebug-cursor-expressions cursor))
- (this-offset (edebug-cursor-offsets cursor)))
- ;; Wrap the form in a list, (by changing the cursor??)...
+ (this-form (edebug-cursor-expressions cursor))
+ (this-offset (edebug-cursor-offsets cursor)))
+ ;; Wrap the form in a list, by changing the cursor.
(edebug-set-cursor cursor (list this-form) this-offset)
- ;; and process normally, then unwrap the result.
- (car (edebug-match-specs cursor specs remainder-handler))))
-
- (t;; Process normally.
- (let* ((spec (car specs))
- (rest)
- (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
- ;;(message "spec = %s first char = %s" spec first-char) (sit-for 1)
- (nconc
- (cond
- ((eq ?& first-char);; "&" symbols take all following specs.
- (funcall (get-edebug-spec spec) cursor (cdr specs)))
- ((eq ?: first-char);; ":" symbols take one following spec.
- (setq rest (cdr (cdr specs)))
- (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
- (t;; Any other normal spec.
- (setq rest (cdr specs))
- (edebug-match-one-spec cursor spec)))
- (funcall remainder-handler cursor rest remainder-handler)))))))
-
+ ;; Process normally, then unwrap the result.
+ (car (edebug-match-specs cursor specs remainder-handler)))))))
;; Define specs for all the symbol specs with functions used to process them.
;; Perhaps we shouldn't be doing this with edebug-form-specs since the
@@ -1986,15 +2029,14 @@ expressions; a `progn' form will be returned enclosing these forms."
(def-edebug-spec defvar (symbolp &optional form stringp))
(def-edebug-spec defun
- (&define name lambda-list
- [&optional stringp]
+ (&define name lambda-list lambda-doc
[&optional ("declare" &rest sexp)]
[&optional ("interactive" interactive)]
def-body))
(def-edebug-spec defmacro
;; FIXME: Improve `declare' so we can Edebug gv-expander and
;; gv-setter declarations.
- (&define name lambda-list [&optional stringp]
+ (&define name lambda-list lambda-doc
[&optional ("declare" &rest sexp)] def-body))
(def-edebug-spec arglist lambda-list) ;; deprecated - use lambda-list.
@@ -2005,6 +2047,10 @@ expressions; a `progn' form will be returned enclosing these forms."
&optional ["&rest" arg]
)))
+(def-edebug-spec lambda-doc
+ (&optional [&or stringp
+ (&define ":documentation" def-form)]))
+
(def-edebug-spec interactive
(&optional &or stringp def-form))
@@ -2167,7 +2213,21 @@ error is signaled again."
;;; Entering Edebug
-(defun edebug-enter (function args body)
+(defun edebug-enter (func args body)
+ "Enter Edebug for a function.
+FUNC should be the symbol with the Edebug information, ARGS is
+the list of arguments and BODY is the code.
+
+Look up the `edebug-behavior' for FUNC in `edebug-behavior-alist'
+and run its entry function, and set up `edebug-before' and
+`edebug-after'."
+ (cl-letf* ((behavior (get func 'edebug-behavior))
+ (functions (cdr (assoc behavior edebug-behavior-alist)))
+ ((symbol-function #'edebug-before) (nth 1 functions))
+ ((symbol-function #'edebug-after) (nth 2 functions)))
+ (funcall (nth 0 functions) func args body)))
+
+(defun edebug-default-enter (function args body)
;; Entering FUNC. The arguments are ARGS, and the body is BODY.
;; Setup edebug variables and evaluate BODY. This function is called
;; when a function evaluated with edebug-eval-top-level-form is entered.
@@ -2198,7 +2258,7 @@ error is signaled again."
edebug-initial-mode
edebug-execution-mode)
edebug-next-execution-mode nil)
- (edebug-enter function args body))))
+ (edebug-default-enter function args body))))
(let* ((edebug-data (get function 'edebug))
(edebug-def-mark (car edebug-data)) ; mark at def start
@@ -2317,22 +2377,27 @@ MSG is printed after `::::} '."
value
(edebug-debugger after-index 'after value)
)))
-
(defun edebug-fast-after (_before-index _after-index value)
;; Do nothing but return the value.
value)
(defun edebug-run-slow ()
- (defalias 'edebug-before 'edebug-slow-before)
- (defalias 'edebug-after 'edebug-slow-after))
+ "Set up Edebug's normal behavior."
+ (setf (cdr (assq 'edebug edebug-behavior-alist))
+ '(edebug-default-enter edebug-slow-before edebug-slow-after)))
;; This is not used, yet.
(defun edebug-run-fast ()
- (defalias 'edebug-before 'edebug-fast-before)
- (defalias 'edebug-after 'edebug-fast-after))
-
-(edebug-run-slow)
+ "Disable Edebug without de-instrumenting code."
+ (setf (cdr (assq 'edebug edebug-behavior-alist))
+ '(edebug-default-enter edebug-fast-before edebug-fast-after)))
+(defalias 'edebug-before nil
+ "Function called by Edebug before a form is evaluated.
+See `edebug-behavior-alist' for implementations.")
+(defalias 'edebug-after nil
+ "Function called by Edebug after a form is evaluated.
+See `edebug-behavior-alist' for implementations.")
(defun edebug--update-coverage (after-index value)
(let ((old-result (aref edebug-coverage after-index)))
@@ -3204,17 +3269,8 @@ generated symbols for methods. If a function or method to
instrument cannot be found, signal an error."
(let ((func-marker (get func 'edebug)))
(cond
- ((and (markerp func-marker) (marker-buffer func-marker))
- ;; It is uninstrumented, so instrument it.
- (with-current-buffer (marker-buffer func-marker)
- (goto-char func-marker)
- (edebug-eval-top-level-form)
- (list func)))
- ((consp func-marker)
- (message "%s is already instrumented." func)
- (list func))
- ((get func 'cl--generic)
- (let ((method-defs (method-files func))
+ ((cl-generic-p func)
+ (let ((method-defs (cl--generic-method-files func))
symbols)
(unless method-defs
(error "Could not find any method definitions for %s" func))
@@ -3227,6 +3283,15 @@ instrument cannot be found, signal an error."
(edebug-eval-top-level-form)
(push (edebug-form-data-symbol) symbols))))
symbols))
+ ((and (markerp func-marker) (marker-buffer func-marker))
+ ;; It is uninstrumented, so instrument it.
+ (with-current-buffer (marker-buffer func-marker)
+ (goto-char func-marker)
+ (edebug-eval-top-level-form)
+ (list func)))
+ ((consp func-marker)
+ (message "%s is already instrumented." func)
+ (list func))
(t
(let ((loc (find-function-noselect func t)))
(unless (cdr loc)
diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el
index 33c71ec5807..58dcd09d7ea 100644
--- a/lisp/emacs-lisp/eieio-base.el
+++ b/lisp/emacs-lisp/eieio-base.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -31,6 +31,7 @@
;;; Code:
(require 'eieio)
+(require 'seq)
(eval-when-compile (require 'cl-lib))
;;; eieio-instance-inheritor
@@ -255,8 +256,11 @@ malicious code.
Note: This function recurses when a slot of :type of some object is
identified, and needing more object creation."
(let* ((objclass (nth 0 inputlist))
- ;; (objname (nth 1 inputlist))
- (slots (nthcdr 2 inputlist))
+ ;; Earlier versions of `object-write' added a string name for
+ ;; the object, now obsolete.
+ (slots (nthcdr
+ (if (stringp (nth 1 inputlist)) 2 1)
+ inputlist))
(createslots nil)
(class
(progn
@@ -308,14 +312,6 @@ Second, any text properties will be stripped from strings."
(= (length proposed-value) 1))
nil)
- ;; We have a slot with a single object that can be
- ;; saved here. Recurse and evaluate that
- ;; sub-object.
- ((and classtype (class-p classtype)
- (child-of-class-p (car proposed-value) classtype))
- (eieio-persistent-convert-list-to-object
- proposed-value))
-
;; List of object constructors.
((and (eq (car proposed-value) 'list)
;; 2nd item is a list.
@@ -346,6 +342,16 @@ Second, any text properties will be stripped from strings."
objlist))
;; return the list of objects ... reversed.
(nreverse objlist)))
+ ;; We have a slot with a single object that can be
+ ;; saved here. Recurse and evaluate that
+ ;; sub-object.
+ ((and classtype
+ (seq-some
+ (lambda (elt)
+ (child-of-class-p (car proposed-value) elt))
+ classtype))
+ (eieio-persistent-convert-list-to-object
+ proposed-value))
(t
proposed-value))))
@@ -402,13 +408,9 @@ If no class is referenced there, then return nil."
type))
((eq (car-safe type) 'or)
- ;; If type is a list, and is an or, it is possibly something
- ;; like (or null myclass), so check for that.
- (let ((ans nil))
- (dolist (subtype (cdr type))
- (setq ans (eieio-persistent-slot-type-is-class-p
- subtype)))
- ans))
+ ;; If type is a list, and is an `or', return all valid class
+ ;; types within the `or' statement.
+ (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type)))
(t
;; No match, not a class.
@@ -465,7 +467,7 @@ instance."
(cl-defmethod eieio-object-name-string ((obj eieio-named))
"Return a string which is OBJ's name."
(or (slot-value obj 'object-name)
- (symbol-name (eieio-object-class obj))))
+ (cl-call-next-method)))
(cl-defmethod eieio-object-set-name-string ((obj eieio-named) name)
"Set the string which is OBJ's NAME."
diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el
index e6e6d118709..bf0bc857358 100644
--- a/lisp/emacs-lisp/eieio-compat.el
+++ b/lisp/emacs-lisp/eieio-compat.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -165,7 +165,8 @@ Summary:
(if (memq method '(no-next-method no-applicable-method))
(symbol-function method)
(let ((generic (cl-generic-ensure-function method)))
- (symbol-function (cl--generic-name generic)))))
+ (or (symbol-function (cl--generic-name generic))
+ (cl--generic-make-function generic)))))
;;;###autoload
(defun eieio--defmethod (method kind argclass code)
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index dfe1c06bfaf..22bf812fcb9 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -84,7 +84,7 @@ Currently under control of this var:
(progn
;; Arrange for field access not to bother checking if the access is indeed
;; made to an eieio--class object.
- (cl-declaim (optimize (safety 0)))
+ (eval-when-compile (cl-declaim (optimize (safety 0))))
(cl-defstruct (eieio--class
(:constructor nil)
@@ -103,8 +103,12 @@ Currently under control of this var:
options ;; storage location of tagged class option
; Stored outright without modifications or stripping
)
- ;; Set it back to the default value.
- (cl-declaim (optimize (safety 1))))
+ ;; Set it back to the default value. NOTE: Using the default
+ ;; `safety' value does NOT give the default
+ ;; `byte-compile-delete-errors' value. Therefore limit this (and
+ ;; the above `cl-declaim') to compile time so that we don't affect
+ ;; code which only loads this library.
+ (eval-when-compile (cl-declaim (optimize (safety 1)))))
(eval-and-compile
diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el
index e82eaa2b01f..745bd89f062 100644
--- a/lisp/emacs-lisp/eieio-custom.el
+++ b/lisp/emacs-lisp/eieio-custom.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el
index 8ef92df513e..da8d9a017bb 100644
--- a/lisp/emacs-lisp/eieio-datadebug.el
+++ b/lisp/emacs-lisp/eieio-datadebug.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el
index ba4331f126b..f464d024670 100644
--- a/lisp/emacs-lisp/eieio-opt.el
+++ b/lisp/emacs-lisp/eieio-opt.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el
index 36ab2c165cf..fb57453f39e 100644
--- a/lisp/emacs-lisp/eieio-speedbar.el
+++ b/lisp/emacs-lisp/eieio-speedbar.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 1a7de55fcef..d0d2ff5145c 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -246,7 +246,7 @@ This method is obsolete."
;; test, so we can let typep have the CLOS documented behavior
;; while keeping our above predicate clean.
- (put ',name 'cl-deftype-satisfies #',testsym2)
+ (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2)
(eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc)
@@ -377,9 +377,21 @@ is a shorthand for (NAME NAME)."
(define-obsolete-function-alias
'object-class-fast #'eieio-object-class "24.4")
+;; In the past, every EIEIO object had a `name' field, so we had the
+;; two methods `eieio-object-name-string' and
+;; `eieio-object-set-name-string' "for free". Since this field is
+;; very rarely used, we got rid of it and instead we keep it in a weak
+;; hash-tables, for those very rare objects that use it.
+;; Really, those rare objects should inherit from `eieio-named' instead!
+(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key))
+
(cl-defgeneric eieio-object-name-string (obj)
"Return a string which is OBJ's name."
- (declare (obsolete eieio-named "25.1")))
+ (or (gethash obj eieio--object-names)
+ (format "%s-%x" (eieio-object-class obj) (sxhash-eq obj))))
+
+(define-obsolete-function-alias
+ 'object-name-string #'eieio-object-name-string "24.4")
(defun eieio-object-name (obj &optional extra)
"Return a printed representation for object OBJ.
@@ -389,21 +401,9 @@ If EXTRA, include that in the string returned to represent the symbol."
(eieio-object-name-string obj) (or extra "")))
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
-(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key))
-
-;; In the past, every EIEIO object had a `name' field, so we had the two method
-;; below "for free". Since this field is very rarely used, we got rid of it
-;; and instead we keep it in a weak hash-tables, for those very rare objects
-;; that use it.
-(cl-defmethod eieio-object-name-string (obj)
- (or (gethash obj eieio--object-names)
- (symbol-name (eieio-object-class obj))))
-(define-obsolete-function-alias
- 'object-name-string #'eieio-object-name-string "24.4")
-
-(cl-defmethod eieio-object-set-name-string (obj name)
+(cl-defgeneric eieio-object-set-name-string (obj name)
"Set the string which is OBJ's NAME."
- (declare (obsolete eieio-named "25.1"))
+ (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
@@ -847,7 +847,16 @@ to prepend a space."
(princ (object-print object) stream))
(defvar eieio-print-depth 0
- "When printing, keep track of the current indentation depth.")
+ "The current indentation depth while printing.
+Ignored if `eieio-print-indentation' is nil.")
+
+(defvar eieio-print-indentation t
+ "When non-nil, indent contents of printed objects.")
+
+(defvar eieio-print-object-name t
+ "When non-nil write the object name in `object-write'.
+Does not affect objects subclassing `eieio-named'. Note that
+Emacs<26 requires that object names be present.")
(cl-defgeneric object-write (this &optional comment)
"Write out object THIS to the current stream.
@@ -859,10 +868,11 @@ This writes out the vector version of this object. Complex and recursive
object are discouraged from being written.
If optional COMMENT is non-nil, include comments when outputting
this object."
- (when comment
+ (when (and comment eieio-print-object-name)
(princ ";; Object ")
(princ (eieio-object-name-string this))
- (princ "\n")
+ (princ "\n"))
+ (when comment
(princ comment)
(princ "\n"))
(let* ((cl (eieio-object-class this))
@@ -871,12 +881,14 @@ this object."
;; It should look like this:
;; (<constructor> <name> <slot> <slot> ... )
;; Each slot's slot is writen using its :writer.
- (princ (make-string (* eieio-print-depth 2) ? ))
+ (when eieio-print-indentation
+ (princ (make-string (* eieio-print-depth 2) ? )))
(princ "(")
(princ (symbol-name (eieio--class-constructor (eieio-object-class this))))
- (princ " ")
- (prin1 (eieio-object-name-string this))
- (princ "\n")
+ (when eieio-print-object-name
+ (princ " ")
+ (prin1 (eieio-object-name-string this))
+ (princ "\n"))
;; Loop over all the public slots
(let ((slots (eieio--class-slots cv))
(eieio-print-depth (1+ eieio-print-depth)))
@@ -889,7 +901,8 @@ this object."
(unless (or (not i) (equal v (cl--slot-descriptor-initform slot)))
(unless (bolp)
(princ "\n"))
- (princ (make-string (* eieio-print-depth 2) ? ))
+ (when eieio-print-indentation
+ (princ (make-string (* eieio-print-depth 2) ? )))
(princ (symbol-name i))
(if (alist-get :printer (cl--slot-descriptor-props slot))
;; Use our public printer
@@ -904,7 +917,7 @@ this object."
"\n" " "))
(eieio-override-prin1 v))))))))
(princ ")")
- (when (= eieio-print-depth 0)
+ (when (zerop eieio-print-depth)
(princ "\n"))))
(defun eieio-override-prin1 (thing)
@@ -923,14 +936,16 @@ this object."
(progn
(princ "'")
(prin1 list))
- (princ (make-string (* eieio-print-depth 2) ? ))
+ (when eieio-print-indentation
+ (princ (make-string (* eieio-print-depth 2) ? )))
(princ "(list")
(let ((eieio-print-depth (1+ eieio-print-depth)))
(while list
(princ "\n")
(if (eieio-object-p (car list))
(object-write (car list))
- (princ (make-string (* eieio-print-depth 2) ? ))
+ (when eieio-print-indentation
+ (princ (make-string (* eieio-print-depth) ? )))
(eieio-override-prin1 (car list)))
(setq list (cdr list))))
(princ ")")))
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index a05bd7cc4d4..ad08977b81a 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -160,6 +160,10 @@ This is used to determine if `eldoc-idle-delay' is changed by the user.")
It should receive the same arguments as `message'.")
(defun eldoc-edit-message-commands ()
+ "Return an obarray containing common editing commands.
+
+When `eldoc-print-after-edit' is non-nil, ElDoc messages are only
+printed after commands contained in this obarray."
(let ((cmds (make-vector 31 0))
(re (regexp-opt '("delete" "insert" "edit" "electric" "newline"))))
(mapatoms (lambda (s)
@@ -211,16 +215,21 @@ expression point is on."
;;;###autoload
(defun turn-on-eldoc-mode ()
- "Turn on `eldoc-mode' if the buffer has eldoc support enabled.
+ "Turn on `eldoc-mode' if the buffer has ElDoc support enabled.
See `eldoc-documentation-function' for more detail."
(when (eldoc--supported-p)
(eldoc-mode 1)))
(defun eldoc--supported-p ()
+ "Non-nil if an ElDoc function is set for this buffer."
(not (memq eldoc-documentation-function '(nil ignore))))
(defun eldoc-schedule-timer ()
+ "Ensure `eldoc-timer' is running.
+
+If the user has changed `eldoc-idle-delay', update the timer to
+reflect the change."
(or (and eldoc-timer
(memq eldoc-timer timer-idle-list)) ;FIXME: Why?
(setq eldoc-timer
@@ -229,8 +238,7 @@ See `eldoc-documentation-function' for more detail."
(lambda ()
(when (or eldoc-mode
(and global-eldoc-mode
- (not (memq eldoc-documentation-function
- '(nil ignore)))))
+ (eldoc--supported-p)))
(eldoc-print-current-symbol-info))))))
;; If user has changed the idle delay, update the timer.
@@ -248,7 +256,7 @@ Otherwise work like `message'."
(progn
(add-hook 'minibuffer-exit-hook
(lambda () (setq eldoc-mode-line-string nil
- ;; http://debbugs.gnu.org/16920
+ ;; https://debbugs.gnu.org/16920
eldoc-last-message nil))
nil t)
(with-current-buffer
@@ -256,28 +264,25 @@ Otherwise work like `message'."
(or (window-in-direction 'above (minibuffer-window))
(minibuffer-selected-window)
(get-largest-window)))
+ (when mode-line-format
(unless (and (listp mode-line-format)
(assq 'eldoc-mode-line-string mode-line-format))
(setq mode-line-format
(list "" '(eldoc-mode-line-string
(" " eldoc-mode-line-string " "))
- mode-line-format)))
+ mode-line-format))))
(setq eldoc-mode-line-string
(when (stringp format-string)
(apply #'format-message format-string args)))
(force-mode-line-update)))
(apply 'message format-string args)))
-(defun eldoc-message (&rest args)
+(defun eldoc-message (&optional string)
+ "Display STRING as an ElDoc message if it's non-nil.
+
+Also store it in `eldoc-last-message' and return that value."
(let ((omessage eldoc-last-message))
- (setq eldoc-last-message
- (cond ((eq (car args) eldoc-last-message) eldoc-last-message)
- ((null (car args)) nil)
- ;; If only one arg, no formatting to do, so put it in
- ;; eldoc-last-message so eq test above might succeed on
- ;; subsequent calls.
- ((null (cdr args)) (car args))
- (t (apply #'format-message args))))
+ (setq eldoc-last-message string)
;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
;; are recorded in a log. Do not put eldoc messages in that log since
;; they are Legion.
@@ -289,6 +294,7 @@ Otherwise work like `message'."
eldoc-last-message)
(defun eldoc--message-command-p (command)
+ "Return non-nil if COMMAND is in `eldoc-message-commands'."
(and (symbolp command)
(intern-soft (symbol-name command) eldoc-message-commands)))
@@ -299,6 +305,7 @@ Otherwise work like `message'."
;; before the next command executes, which does away with the flicker.
;; This doesn't seem to be required for Emacs 19.28 and earlier.
(defun eldoc-pre-command-refresh-echo-area ()
+ "Reprint `eldoc-last-message' in the echo area."
(and eldoc-last-message
(not (minibufferp)) ;We don't use the echo area when in minibuffer.
(if (and (eldoc-display-message-no-interference-p)
@@ -310,6 +317,7 @@ Otherwise work like `message'."
;; Decide whether now is a good time to display a message.
(defun eldoc-display-message-p ()
+ "Return non-nil when it is appropriate to display an ElDoc message."
(and (eldoc-display-message-no-interference-p)
;; If this-command is non-nil while running via an idle
;; timer, we're still in the middle of executing a command,
@@ -322,6 +330,7 @@ Otherwise work like `message'."
;; Check various conditions about the current environment that might make
;; it undesirable to print eldoc messages right this instant.
(defun eldoc-display-message-no-interference-p ()
+ "Return nil if displaying a message would cause interference."
(not (or executing-kbd-macro (bound-and-true-p edebug-active))))
@@ -347,6 +356,7 @@ variable) is taken into account if the major mode specific function does not
return any documentation.")
(defun eldoc-print-current-symbol-info ()
+ "Print the text produced by `eldoc-documentation-function'."
;; This is run from post-command-hook or some idle timer thing,
;; so we need to be careful that errors aren't ignored.
(with-demoted-errors "eldoc error: %s"
@@ -361,6 +371,13 @@ return any documentation.")
;; truncated or eliminated entirely from the output to make room for the
;; description.
(defun eldoc-docstring-format-sym-doc (prefix doc &optional face)
+ "Combine PREFIX and DOC, and shorten the result to fit in the echo area.
+
+When PREFIX is a symbol, propertize its symbol name with FACE
+before combining it with DOC. If FACE is not provided, just
+apply the nil face.
+
+See also: `eldoc-echo-area-use-multiline-p'."
(when (symbolp prefix)
(setq prefix (concat (propertize (symbol-name prefix) 'face face) ": ")))
(let* ((ea-multi eldoc-echo-area-use-multiline-p)
@@ -390,22 +407,26 @@ return any documentation.")
;; These functions do display-command table management.
(defun eldoc-add-command (&rest cmds)
+ "Add each of CMDS to the obarray `eldoc-message-commands'."
(dolist (name cmds)
(and (symbolp name)
(setq name (symbol-name name)))
(set (intern name eldoc-message-commands) t)))
(defun eldoc-add-command-completions (&rest names)
+ "Pass every prefix completion of NAMES to `eldoc-add-command'."
(dolist (name names)
(apply #'eldoc-add-command (all-completions name obarray 'commandp))))
(defun eldoc-remove-command (&rest cmds)
+ "Remove each of CMDS from the obarray `eldoc-message-commands'."
(dolist (name cmds)
(and (symbolp name)
(setq name (symbol-name name)))
(unintern name eldoc-message-commands)))
(defun eldoc-remove-command-completions (&rest names)
+ "Pass every prefix completion of NAMES to `eldoc-remove-command'."
(dolist (name names)
(apply #'eldoc-remove-command
(all-completions name eldoc-message-commands))))
@@ -418,9 +439,9 @@ return any documentation.")
"down-list" "end-of-" "exchange-point-and-mark" "forward-" "goto-"
"handle-select-window" "indent-for-tab-command" "left-" "mark-page"
"mark-paragraph" "mouse-set-point" "move-" "move-beginning-of-"
- "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" "previous-"
- "recenter" "right-" "scroll-" "self-insert-command" "split-window-"
- "up-list")
+ "move-end-of-" "newline" "next-" "other-window" "pop-global-mark"
+ "previous-" "recenter" "right-" "scroll-" "self-insert-command"
+ "split-window-" "up-list")
(provide 'eldoc)
diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el
index cce9553ff6a..643d7160dbb 100644
--- a/lisp/emacs-lisp/elint.el
+++ b/lisp/emacs-lisp/elint.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -463,21 +463,9 @@ Return nil if there are no more forms, t otherwise."
;; Import variable definitions
((memq (car form) '(require cc-require cc-require-when-compile))
(let ((name (eval (cadr form)))
- (file (eval (nth 2 form)))
- (elint-doing-cl (bound-and-true-p elint-doing-cl)))
+ (file (eval (nth 2 form))))
(unless (memq name elint-features)
(add-to-list 'elint-features name)
- ;; cl loads cl-macs in an opaque manner.
- ;; Since cl-macs requires cl, we can just process cl-macs.
- ;; FIXME: AFAIK, `cl' now behaves properly and does not need any
- ;; special treatment any more. Can someone who understands this
- ;; code confirm? --Stef
- (and (eq name 'cl) (not elint-doing-cl)
- ;; We need cl if elint-form is to be able to expand cl macros.
- (require 'cl)
- (setq name 'cl-macs
- file nil
- elint-doing-cl t)) ; blech
(setq elint-env (elint-add-required-env elint-env name file))))))
elint-env)
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
index d4500f131a2..905718dad68 100644
--- a/lisp/emacs-lisp/elp.el
+++ b/lisp/emacs-lisp/elp.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -382,14 +382,13 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
;; and return the results.
(setq result (apply func args))
;; we are recording times
- (let (enter-time exit-time)
+ (let (enter-time)
;; increment the call-counter
(cl-incf (aref info 0))
(setq enter-time (current-time)
- result (apply func args)
- exit-time (current-time))
+ result (apply func args))
;; calculate total time in function
- (cl-incf (aref info 1) (elp-elapsed-time enter-time exit-time))
+ (cl-incf (aref info 1) (elp-elapsed-time enter-time nil))
))
;; turn off recording if this is the master function
(if (and elp-master
@@ -583,6 +582,11 @@ displayed."
(elp-restore-all)
;; continue standard unloading
nil)
+
+(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun)))
+ "Un-instrument before unloading a function."
+ (elp-restore-function (cdr x)))
+
(provide 'elp)
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 4cf9d9609e9..71d46c11077 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -286,27 +286,60 @@ BUFFER defaults to current buffer. Does not modify BUFFER."
(defmacro ert-with-message-capture (var &rest body)
- "Execute BODY while collecting anything written with `message' in VAR.
+ "Execute BODY while collecting messages in VAR.
-Capture all messages produced by `message' when it is called from
-Lisp, and concatenate them separated by newlines into one string.
+Capture messages issued by Lisp code and concatenate them
+separated by newlines into one string. This includes messages
+written by `message' as well as objects printed by `print',
+`prin1' and `princ' to the echo area. Messages issued from C
+code using the above mentioned functions will not be captured.
This is useful for separating the issuance of messages by the
code under test from the behavior of the *Messages* buffer."
(declare (debug (symbolp body))
(indent 1))
- (let ((g-advice (cl-gensym)))
+ (let ((g-message-advice (gensym))
+ (g-print-advice (gensym))
+ (g-collector (gensym)))
`(let* ((,var "")
- (,g-advice (lambda (func &rest args)
- (if (or (null args) (equal (car args) ""))
- (apply func args)
- (let ((msg (apply #'format-message args)))
- (setq ,var (concat ,var msg "\n"))
- (funcall func "%s" msg))))))
- (advice-add 'message :around ,g-advice)
+ (,g-collector (lambda (msg) (setq ,var (concat ,var msg))))
+ (,g-message-advice (ert--make-message-advice ,g-collector))
+ (,g-print-advice (ert--make-print-advice ,g-collector)))
+ (advice-add 'message :around ,g-message-advice)
+ (advice-add 'prin1 :around ,g-print-advice)
+ (advice-add 'princ :around ,g-print-advice)
+ (advice-add 'print :around ,g-print-advice)
(unwind-protect
(progn ,@body)
- (advice-remove 'message ,g-advice)))))
+ (advice-remove 'print ,g-print-advice)
+ (advice-remove 'princ ,g-print-advice)
+ (advice-remove 'prin1 ,g-print-advice)
+ (advice-remove 'message ,g-message-advice)))))
+
+(defun ert--make-message-advice (collector)
+ "Create around advice for `message' for `ert-collect-messages'.
+COLLECTOR will be called with the message before it is passed
+to the real `message'."
+ (lambda (func &rest args)
+ (if (or (null args) (equal (car args) ""))
+ (apply func args)
+ (let ((msg (apply #'format-message args)))
+ (funcall collector (concat msg "\n"))
+ (funcall func "%s" msg)))))
+
+(defun ert--make-print-advice (collector)
+ "Create around advice for print functions for `ert-collect-messages'.
+The created advice function will just call the original function
+unless the output is going to the echo area (when PRINTCHARFUN is
+t or PRINTCHARFUN is nil and `standard-output' is t). If the
+output is destined for the echo area, the advice function will
+convert it to a string and pass it to COLLECTOR first."
+ (lambda (func object &optional printcharfun)
+ (if (not (eq t (or printcharfun standard-output)))
+ (funcall func object printcharfun)
+ (funcall collector (with-output-to-string
+ (funcall func object)))
+ (funcall func object printcharfun))))
(provide 'ert-x)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 2c49a634e35..1d69af80639 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -73,6 +73,11 @@
:prefix "ert-"
:group 'lisp)
+(defcustom ert-batch-backtrace-right-margin 70
+ "Maximum length of lines in ERT backtraces in batch mode.
+Use nil for no limit (caution: backtrace lines can be very long)."
+ :type '(choice (const :tag "No truncation" nil) integer))
+
(defface ert-test-result-expected '((((class color) (background light))
:background "green1")
(((class color) (background dark))
@@ -97,7 +102,7 @@ This is like `equal-including-properties' except that it compares
the property values of text properties structurally (by
recursing) rather than with `eq'. Perhaps this is what
`equal-including-properties' should do in the first place; see
-Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
+Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
;; This implementation is inefficient. Rather than making it
;; efficient, let's hope bug 6581 gets fixed so that we can delete
;; it altogether.
@@ -135,7 +140,7 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'."
;; Note that nil is still a valid value for the `name' slot in
;; ert-test objects. It designates an anonymous test.
(error "Attempt to define a test named nil"))
- (put symbol 'ert--test definition)
+ (define-symbol-prop symbol 'ert--test definition)
definition)
(defun ert-make-test-unbound (symbol)
@@ -214,12 +219,6 @@ description of valid values for RESULT-TYPE.
,@(when tags-supplied-p
`(:tags ,tags))
:body (lambda () ,@body)))
- ;; This hack allows `symbol-file' to associate `ert-deftest'
- ;; forms with files, and therefore enables `find-function' to
- ;; work with tests. However, it leads to warnings in
- ;; `unload-feature', which doesn't know how to undefine tests
- ;; and has no mechanism for extension.
- (push '(ert-deftest . ,name) current-load-list)
',name))))
;; We use these `put' forms in addition to the (declare (indent)) in
@@ -266,6 +265,14 @@ DATA is displayed to the user and should state the reason for skipping."
(when ert--should-execution-observer
(funcall ert--should-execution-observer form-description)))
+;; See Bug#24402 for why this exists
+(defun ert--should-signal-hook (error-symbol data)
+ "Stupid hack to stop `condition-case' from catching ert signals.
+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)))
+
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
(and (symbolp thing)
@@ -273,20 +280,26 @@ DATA is displayed to the user and should state the reason for skipping."
(and (subrp definition)
(eql (cdr (subr-arity definition)) 'unevalled)))))
+;; FIXME: Code inside of here should probably be evaluated like it is
+;; outside of tests, with the sole exception of error handling
(defun ert--expand-should-1 (whole form inner-expander)
"Helper function for the `should' macro and its variants."
(let ((form
- (macroexpand form (append (bound-and-true-p
- byte-compile-macro-environment)
- (cond
- ((boundp 'macroexpand-all-environment)
- macroexpand-all-environment)
- ((boundp 'cl-macro-environment)
- cl-macro-environment))))))
+ ;; catch macroexpansion errors
+ (condition-case err
+ (macroexpand-all form
+ (append (bound-and-true-p
+ byte-compile-macro-environment)
+ (cond
+ ((boundp 'macroexpand-all-environment)
+ macroexpand-all-environment)
+ ((boundp 'cl-macro-environment)
+ cl-macro-environment))))
+ (error `(signal ',(car err) ',(cdr err))))))
(cond
((or (atom form) (ert--special-operator-p (car form)))
- (let ((value (cl-gensym "value-")))
- `(let ((,value (cl-gensym "ert-form-evaluation-aborted-")))
+ (let ((value (gensym "value-")))
+ `(let ((,value (gensym "ert-form-evaluation-aborted-")))
,(funcall inner-expander
`(setq ,value ,form)
`(list ',whole :form ',form :value ,value)
@@ -299,12 +312,17 @@ DATA is displayed to the user and should state the reason for skipping."
(and (consp fn-name)
(eql (car fn-name) 'lambda)
(listp (cdr fn-name)))))
- (let ((fn (cl-gensym "fn-"))
- (args (cl-gensym "args-"))
- (value (cl-gensym "value-"))
- (default-value (cl-gensym "ert-form-evaluation-aborted-")))
- `(let ((,fn (function ,fn-name))
- (,args (list ,@arg-forms)))
+ (let ((fn (gensym "fn-"))
+ (args (gensym "args-"))
+ (value (gensym "value-"))
+ (default-value (gensym "ert-form-evaluation-aborted-")))
+ `(let* ((,fn (function ,fn-name))
+ (,args (condition-case err
+ (let ((signal-hook-function #'ert--should-signal-hook))
+ (list ,@arg-forms))
+ (error (progn (setq ,fn #'signal)
+ (list (car err)
+ (cdr err)))))))
(let ((,value ',default-value))
,(funcall inner-expander
`(setq ,value (apply ,fn ,args))
@@ -339,7 +357,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM."
(ert--expand-should-1
whole form
(lambda (inner-form form-description-form value-var)
- (let ((form-description (cl-gensym "form-description-")))
+ (let ((form-description (gensym "form-description-")))
`(let (,form-description)
,(funcall inner-expander
`(unwind-protect
@@ -417,8 +435,8 @@ failed."
`(should-error ,form ,@keys)
form
(lambda (inner-form form-description-form value-var)
- (let ((errorp (cl-gensym "errorp"))
- (form-description-fn (cl-gensym "form-description-fn-")))
+ (let ((errorp (gensym "errorp"))
+ (form-description-fn (gensym "form-description-fn-")))
`(let ((,errorp nil)
(,form-description-fn (lambda () ,form-description-form)))
(condition-case -condition-
@@ -670,48 +688,12 @@ and is displayed in front of the value of MESSAGE-FORM."
(cl-defstruct (ert-test-aborted-with-non-local-exit
(:include ert-test-result)))
-
-(defun ert--record-backtrace ()
- "Record the current backtrace (as a list) and return it."
- ;; Since the backtrace is stored in the result object, result
- ;; objects must only be printed with appropriate limits
- ;; (`print-level' and `print-length') in place. For interactive
- ;; use, the cost of ensuring this possibly outweighs the advantage
- ;; of storing the backtrace for
- ;; `ert-results-pop-to-backtrace-for-test-at-point' given that we
- ;; already have `ert-results-rerun-test-debugging-errors-at-point'.
- ;; For batch use, however, printing the backtrace may be useful.
- (cl-loop
- ;; 6 is the number of frames our own debugger adds (when
- ;; compiled; more when interpreted). FIXME: Need to describe a
- ;; procedure for determining this constant.
- for i from 6
- for frame = (backtrace-frame i)
- while frame
- collect frame))
-
-(defun ert--print-backtrace (backtrace)
+(defun ert--print-backtrace (backtrace do-xrefs)
"Format the backtrace BACKTRACE to the current buffer."
- ;; This is essentially a reimplementation of Fbacktrace
- ;; (src/eval.c), but for a saved backtrace, not the current one.
(let ((print-escape-newlines t)
(print-level 8)
(print-length 50))
- (dolist (frame backtrace)
- (pcase-exhaustive frame
- (`(nil ,special-operator . ,arg-forms)
- ;; Special operator.
- (insert
- (format " %S\n" (cons special-operator arg-forms))))
- (`(t ,fn . ,args)
- ;; Function call.
- (insert (format " %S(" fn))
- (cl-loop for firstp = t then nil
- for arg in args do
- (unless firstp
- (insert " "))
- (insert (format "%S" arg)))
- (insert ")\n"))))))
+ (debugger-insert-backtrace backtrace do-xrefs)))
;; A container for the state of the execution of a single test and
;; environment data needed during its execution.
@@ -750,7 +732,18 @@ run. ARGS are the arguments to `debugger'."
((quit) 'quit)
((ert-test-skipped) 'skipped)
(otherwise 'failed)))
- (backtrace (ert--record-backtrace))
+ ;; We store the backtrace in the result object for
+ ;; `ert-results-pop-to-backtrace-for-test-at-point'.
+ ;; This means we have to limit `print-level' and
+ ;; `print-length' when printing result objects. That
+ ;; might not be worth while when we can also use
+ ;; `ert-results-rerun-test-debugging-errors-at-point',
+ ;; (i.e., when running interactively) but having the
+ ;; backtrace ready for printing is important for batch
+ ;; use.
+ ;;
+ ;; Grab the frames above the debugger.
+ (backtrace (cdr (backtrace-frames debugger)))
(infos (reverse ert--infos)))
(setf (ert--test-execution-info-result info)
(cl-ecase type
@@ -790,6 +783,10 @@ This mainly sets up debugger-related bindings."
;; too expensive, we can remove it.
(with-temp-buffer
(save-window-excursion
+ ;; FIXME: Use `signal-hook-function' instead of `debugger' to
+ ;; handle ert errors. Once that's done, remove
+ ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for
+ ;; details.
(let ((debugger (lambda (&rest args)
(ert--run-test-debugger test-execution-info
args)))
@@ -1336,8 +1333,8 @@ RESULT must be an `ert-test-result-with-condition'."
;;; Running tests in batch mode.
-(defvar ert-batch-backtrace-right-margin 70
- "The maximum line length for printing backtraces in `ert-run-tests-batch'.")
+(defvar ert-quiet nil
+ "Non-nil makes ERT only print important information in batch mode.")
;;;###autoload
(defun ert-run-tests-batch (&optional selector)
@@ -1355,10 +1352,11 @@ Returns the stats object."
(lambda (event-type &rest event-args)
(cl-ecase event-type
(run-started
- (cl-destructuring-bind (stats) event-args
- (message "Running %s tests (%s)"
- (length (ert--stats-tests stats))
- (ert--format-time-iso8601 (ert--stats-start-time stats)))))
+ (unless ert-quiet
+ (cl-destructuring-bind (stats) event-args
+ (message "Running %s tests (%s)"
+ (length (ert--stats-tests stats))
+ (ert--format-time-iso8601 (ert--stats-start-time stats))))))
(run-ended
(cl-destructuring-bind (stats abortedp) event-args
(let ((unexpected (ert-stats-completed-unexpected stats))
@@ -1409,17 +1407,23 @@ Returns the stats object."
(ert-test-result-with-condition
(message "Test %S backtrace:" (ert-test-name test))
(with-temp-buffer
- (ert--print-backtrace (ert-test-result-with-condition-backtrace
- result))
- (goto-char (point-min))
- (while (not (eobp))
- (let ((start (point))
- (end (progn (end-of-line) (point))))
- (setq end (min end
- (+ start ert-batch-backtrace-right-margin)))
- (message "%s" (buffer-substring-no-properties
- start end)))
- (forward-line 1)))
+ (ert--print-backtrace
+ (ert-test-result-with-condition-backtrace result)
+ nil)
+ (if (not ert-batch-backtrace-right-margin)
+ (message "%s"
+ (buffer-substring-no-properties (point-min)
+ (point-max)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((start (point))
+ (end (line-end-position)))
+ (setq end (min end
+ (+ start
+ ert-batch-backtrace-right-margin)))
+ (message "%s" (buffer-substring-no-properties
+ start end)))
+ (forward-line 1))))
(with-temp-buffer
(ert--insert-infos result)
(insert " ")
@@ -1438,16 +1442,17 @@ Returns the stats object."
(ert-test-name test)))
(ert-test-quit
(message "Quit during %S" (ert-test-name test)))))
- (let* ((max (prin1-to-string (length (ert--stats-tests stats))))
- (format-string (concat "%9s %"
- (prin1-to-string (length max))
- "s/" max " %S")))
- (message format-string
- (ert-string-for-test-result result
- (ert-test-result-expected-p
- test result))
- (1+ (ert--stats-test-pos stats test))
- (ert-test-name test)))))))
+ (unless ert-quiet
+ (let* ((max (prin1-to-string (length (ert--stats-tests stats))))
+ (format-string (concat "%9s %"
+ (prin1-to-string (length max))
+ "s/" max " %S")))
+ (message format-string
+ (ert-string-for-test-result result
+ (ert-test-result-expected-p
+ test result))
+ (1+ (ert--stats-test-pos stats test))
+ (ert-test-name test))))))))
nil))
;;;###autoload
@@ -1491,7 +1496,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'."
(with-temp-buffer
(while (setq logfile (pop command-line-args-left))
(erase-buffer)
- (insert-file-contents logfile)
+ (when (file-readable-p logfile) (insert-file-contents logfile))
(if (not (re-search-forward "^Running \\([0-9]+\\) tests" nil t))
(push logfile notests)
(setq ntests (+ ntests (string-to-number (match-string 1))))
@@ -1535,7 +1540,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\
(message "%d files contained unexpected results:" (length unexpected))
(mapc (lambda (l) (message " %s" l)) unexpected))
;; More details on hydra, where the logs are harder to get to.
- (when (and (getenv "NIX_STORE")
+ (when (and (getenv "EMACS_HYDRA_CI")
(not (zerop (+ nunexpected nskipped))))
(message "\nDETAILS")
(message "-------")
@@ -1625,7 +1630,7 @@ default (if any)."
(defun ert-find-test-other-window (test-name)
"Find, in another window, the definition of TEST-NAME."
(interactive (list (ert-read-test-name-at-point "Find test definition: ")))
- (find-function-do-it test-name 'ert-deftest 'switch-to-buffer-other-window))
+ (find-function-do-it test-name 'ert--test 'switch-to-buffer-other-window))
(defun ert-delete-test (test-name)
"Make the test TEST-NAME unbound.
@@ -1828,12 +1833,23 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'."
BEGIN and END specify a region in the current buffer."
(save-excursion
- (save-restriction
- (narrow-to-region begin end)
- ;; Inhibit optimization in `debugger-make-xrefs' that would
- ;; sometimes insert unrelated backtrace info into our buffer.
- (let ((debugger-previous-backtrace nil))
- (debugger-make-xrefs)))))
+ (goto-char begin)
+ (while (progn
+ (goto-char (+ (point) 2))
+ (skip-syntax-forward "^w_")
+ (< (point) end))
+ (let* ((beg (point))
+ (end (progn (skip-syntax-forward "w_") (point)))
+ (sym (intern-soft (buffer-substring-no-properties
+ beg end)))
+ (file (and sym (symbol-file sym 'defun))))
+ (when file
+ (goto-char beg)
+ ;; help-xref-button needs to operate on something matched
+ ;; by a regexp, so set that up for it.
+ (re-search-forward "\\(\\sw\\|\\s_\\)+")
+ (help-xref-button 0 'help-function-def sym file)))
+ (forward-line 1))))
(defun ert--string-first-line (s)
"Return the first line of S, or S if it contains no newlines.
@@ -2417,11 +2433,9 @@ To be used in the ERT results buffer."
(buffer-disable-undo)
(erase-buffer)
(ert-simple-view-mode)
- ;; Use unibyte because `debugger-setup-buffer' also does so.
- (set-buffer-multibyte nil)
+ (set-buffer-multibyte t) ; mimic debugger-setup-buffer
(setq truncate-lines t)
- (ert--print-backtrace backtrace)
- (debugger-make-xrefs)
+ (ert--print-backtrace backtrace t)
(goto-char (point-min))
(insert (substitute-command-keys "Backtrace for test `"))
(ert-insert-test-name-button (ert-test-name test))
@@ -2552,7 +2566,7 @@ To be used in the ERT results buffer."
(insert (if test-name (format "%S" test-name) "<anonymous test>"))
(insert " is a test")
(let ((file-name (and test-name
- (symbol-file test-name 'ert-deftest))))
+ (symbol-file test-name 'ert--test))))
(when file-name
(insert (format-message " defined in `%s'"
(file-name-nondirectory file-name)))
@@ -2585,7 +2599,7 @@ To be used in the ERT results buffer."
;;; Actions on load/unload.
-(add-to-list 'find-function-regexp-alist '(ert-deftest . ert--find-test-regexp))
+(add-to-list 'find-function-regexp-alist '(ert--test . ert--find-test-regexp))
(add-to-list 'minor-mode-alist '(ert--current-run-stats
(:eval
(ert--tests-running-mode-line-indicator))))
diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el
index cc574568d50..e1b94a3ec90 100644
--- a/lisp/emacs-lisp/ewoc.el
+++ b/lisp/emacs-lisp/ewoc.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el
new file mode 100644
index 00000000000..8d2818fbab8
--- /dev/null
+++ b/lisp/emacs-lisp/faceup.el
@@ -0,0 +1,1180 @@
+;;; faceup.el --- Markup language for faces and font-lock regression testing -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
+
+;; Author: Anders Lindgren
+;; Version: 0.0.6
+;; Created: 2013-01-21
+;; Keywords: faces languages
+;; URL: https://github.com/Lindydancer/faceup
+
+;; 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:
+
+;; Emacs is capable of highlighting buffers based on language-specific
+;; `font-lock' rules. This package makes it possible to perform
+;; regression test for packages that provide font-lock rules.
+;;
+;; The underlying idea is to convert text with highlights ("faces")
+;; into a plain text representation using the Faceup markup
+;; language. This language is semi-human readable, for example:
+;;
+;; «k:this» is a keyword
+;;
+;; By comparing the current highlight with a highlight performed with
+;; stable versions of a package, it's possible to automatically find
+;; problems that otherwise would have been hard to spot.
+;;
+;; This package is designed to be used in conjunction with Ert, the
+;; standard Emacs regression test system.
+;;
+;; The Faceup markup language is a generic markup language, regression
+;; testing is merely one way to use it.
+
+;; Regression test examples:
+;;
+;; This section describes the two typical ways regression testing with
+;; this package is performed.
+;;
+;;
+;; Full source file highlighting:
+;;
+;; The most straight-forward way to perform regression testing is to
+;; collect a number of representative source files. From each source
+;; file, say `alpha.mylang', you can use `M-x faceup-write-file RET'
+;; to generate a Faceup file named `alpha.mylang.faceup', this file
+;; use the Faceup markup language to represent the text with
+;; highlights and is used as a reference in future tests.
+;;
+;; An Ert test case can be defined as follows:
+;;
+;; (require 'faceup)
+;;
+;; (defvar mylang-font-lock-test-dir (faceup-this-file-directory))
+;;
+;; (defun mylang-font-lock-test-apps (file)
+;; "Test that the mylang FILE is fontifies as the .faceup file describes."
+;; (faceup-test-font-lock-file 'mylang-mode
+;; (concat mylang-font-lock-test-dir file)))
+;; (faceup-defexplainer mylang-font-lock-test-apps)
+;;
+;; (ert-deftest mylang-font-lock-file-test ()
+;; (should (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
+;; ;; ... Add more test files here ...
+;; )
+;;
+;; To execute the tests, run something like `M-x ert RET t RET'.
+;;
+;;
+;; Source snippets:
+;;
+;; To test smaller snippets of code, you can use the
+;; `faceup-test-font-lock-string'. It takes a major mode and a string
+;; written using the Faceup markup language. The functions strips away
+;; the Faceup markup, inserts the plain text into a temporary buffer,
+;; highlights it, converts the result back into the Faceup markup
+;; language, and finally compares the result with the original Faceup
+;; string.
+;;
+;; For example:
+;;
+;; (defun mylang-font-lock-test (faceup)
+;; (faceup-test-font-lock-string 'mylang-mode faceup))
+;; (faceup-defexplainer mylang-font-lock-test)
+;;
+;; (ert-deftest mylang-font-lock-test-simple ()
+;; "Simple MyLang font-lock tests."
+;; (should (mylang-font-lock-test "«k:this» is a keyword"))
+;; (should (mylang-font-lock-test "«k:function» «f:myfunc» («v:var»)")))
+;;
+
+;; Executing the tests:
+;;
+;; Once the tests have been defined, you can use `M-x ert RET t RET'
+;; to execute them. Hopefully, you will be given the "all clear".
+;; However, if there is a problem, you will be presented with
+;; something like:
+;;
+;; F mylang-font-lock-file-test
+;; (ert-test-failed
+;; ((should
+;; (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang"))
+;; :form
+;; (mylang-font-lock-test-apps "apps/FirstApp/alpha.mylang")
+;; :value nil :explanation
+;; ((on-line 2
+;; ("but_«k:this»_is_not_a_keyword")
+;; ("but_this_is_not_a_keyword")))))
+;;
+;; You should read this that on line 2, the old font-lock rules
+;; highlighted `this' inside `but_this_is_not_a_keyword' (which is
+;; clearly wrong), whereas the new doesn't. Of course, if this is the
+;; desired result (for example, the result of a recent change) you can
+;; simply regenerate the .faceup file and store it as the reference
+;; file for the future.
+
+;; The Faceup markup language:
+;;
+;; The Faceup markup language is designed to be human-readable and
+;; minimalistic.
+;;
+;; The two special characters `«' and `»' marks the start and end of a
+;; range of a face.
+;;
+;;
+;; Compact format for special faces:
+;;
+;; The compact format `«<LETTER>:text»' is used for a number of common
+;; faces. For example, `«U:abc»' means that the text `abc' is
+;; underlined.
+;;
+;; See `faceup-face-short-alist' for the known faces and the
+;; corresponding letter.
+;;
+;;
+;; Full format:
+;;
+;; The format `«:<NAME OF FACE>:text»' is used use to encode other
+;; faces.
+;;
+;; For example `«:my-special-face:abc»' meanst that `abc' has the face
+;; `my-special-face'.
+;;
+;;
+;; Anonymous faces:
+;;
+;; An "anonymous face" is when the `face' property contains a property
+;; list (plist) on the form `(:key value)'. This is represented using
+;; a variant of the full format: `«:(:key value):text»'.
+;;
+;; For example, `«:(:background "red"):abc»' represent the text `abc'
+;; with a red background.
+;;
+;;
+;; Multiple properties:
+;;
+;; In case a text contains more than one face property, they are
+;; represented using nested sections.
+;;
+;; For example:
+;;
+;; * `«B:abc«U:def»»' represent the text `abcdef' that is both *bold*
+;; and *underlined*.
+;;
+;; * `«W:abc«U:def»ghi»' represent the text `abcdefghi' where the
+;; entire text is in *warning* face and `def' is *underlined*.
+;;
+;; In case two faces partially overlap, the ranges will be split when
+;; represented in Faceup. For example:
+;;
+;; * `«B:abc«U:def»»«U:ghi»' represent the text `abcdefghi' where
+;; `abcdef' is bold and `defghi' is underlined.
+;;
+;;
+;; Escaping start and end markers:
+;;
+;; Any occurrence of the start or end markers in the original text
+;; will be escaped using the start marker in the Faceup
+;; representation. In other words, the sequences `««' and `«»'
+;; represent a start and end marker, respectively.
+;;
+;;
+;; Other properties:
+;;
+;; In addition to representing the `face' property (or, more
+;; correctly, the value of `faceup-default-property') other properties
+;; can be encoded. The variable `faceup-properties' contains a list of
+;; properties to track. If a property behaves like the `face'
+;; property, it is encoded as described above, with the addition of
+;; the property name placed in parentheses, for example:
+;; `«(my-face)U:abd»'.
+;;
+;; The variable `faceup-face-like-properties' contains a list of
+;; properties considered face-like.
+;;
+;; Properties that are not considered face-like are always encoded
+;; using the full format and the don't nest. For example:
+;; `«(my-fibonacci-property):(1 1 2 3 5 8):abd»'.
+;;
+;; Examples of properties that could be tracked are:
+;;
+;; * `font-lock-face' -- an alias to `face' when `font-lock-mode' is
+;; enabled.
+;;
+;; * `syntax-table' -- used by a custom `syntax-propertize' to
+;; override the default syntax table.
+;;
+;; * `help-echo' -- provides tooltip text displayed when the mouse is
+;; held over a text.
+
+;; Reference section:
+;;
+;; Faceup commands and functions:
+;;
+;; `M-x faceup-write-file RET' - generate a Faceup file based on the
+;; current buffer.
+;;
+;; `M-x faceup-view-file RET' - view the current buffer converted to
+;; Faceup.
+;;
+;; `faceup-markup-{string,buffer}' - convert text with properties to
+;; the Faceup markup language.
+;;
+;; `faceup-render-view-buffer' - convert buffer with Faceup markup to
+;; a buffer with real text properties and display it.
+;;
+;; `faceup-render-string' - return string with real text properties
+;; from a string with Faceup markup.
+;;
+;; `faceup-render-to-{buffer,string}' - convert buffer with Faceup
+;; markup to a buffer/string with real text properties.
+;;
+;; `faceup-clean-{buffer,string}' - remove Faceup markup from buffer
+;; or string.
+;;
+;;
+;; Regression test support:
+;;
+;; The following functions can be used as Ert test functions, or can
+;; be used to implement new Ert test functions.
+;;
+;; `faceup-test-equal' - Test function, work like Ert:s `equal', but
+;; more ergonomically when reporting multi-line string errors.
+;; Concretely, it breaks down multi-line strings into lines and
+;; reports which line number the error occurred on and the content of
+;; that line.
+;;
+;; `faceup-test-font-lock-buffer' - Test that a buffer is highlighted
+;; according to a reference Faceup text, for a specific major mode.
+;;
+;; `faceup-test-font-lock-string' - Test that a text with Faceup
+;; markup is refontified to match the original Faceup markup.
+;;
+;; `faceup-test-font-lock-file' - Test that a file is highlighted
+;; according to a reference .faceup file.
+;;
+;; `faceup-defexplainer' - Macro, define an explainer function and set
+;; the `ert-explainer' property on the original function, for
+;; functions based on the above test functions.
+;;
+;; `faceup-this-file-directory' - Macro, the directory of the current
+;; file.
+
+;; Real-world examples:
+;;
+;; The following are examples of real-world package that use faceup to
+;; test their font-lock keywords.
+;;
+;; * [cmake-font-lock](https://github.com/Lindydancer/cmake-font-lock)
+;; an advanced set of font-lock keywords for the CMake language
+;;
+;; * [objc-font-lock](https://github.com/Lindydancer/objc-font-lock)
+;; highlight Objective-C function calls.
+;;
+
+;; Other Font Lock Tools:
+;;
+;; This package is part of a suite of font-lock tools. The other
+;; tools in the suite are:
+;;
+;;
+;; Font Lock Studio:
+;;
+;; Interactive debugger for font-lock keywords (Emacs syntax
+;; highlighting rules).
+;;
+;; Font Lock Studio lets you *single-step* Font Lock keywords --
+;; matchers, highlights, and anchored rules, so that you can see what
+;; happens when a buffer is fontified. You can set *breakpoints* on
+;; or inside rules and *run* until one has been hit. When inside a
+;; rule, matches are *visualized* using a palette of background
+;; colors. The *explainer* can describe a rule in plain-text English.
+;; Tight integration with *Edebug* allows you to step into Lisp
+;; expressions that are part of the Font Lock keywords.
+;;
+;;
+;; Font Lock Profiler:
+;;
+;; A profiler for font-lock keywords. This package measures time and
+;; counts the number of times each part of a font-lock keyword is
+;; used. For matchers, it counts the total number and the number of
+;; successful matches.
+;;
+;; The result is presented in table that can be sorted by count or
+;; time. The table can be expanded to include each part of the
+;; font-lock keyword.
+;;
+;; In addition, this package can generate a log of all font-lock
+;; events. This can be used to verify font-lock implementations,
+;; concretely, this is used for back-to-back tests of the real
+;; font-lock engine and Font Lock Studio, an interactive debugger for
+;; font-lock keywords.
+;;
+;;
+;; Highlight Refontification:
+;;
+;; Minor mode that visualizes how font-lock refontifies a buffer.
+;; This is useful when developing or debugging font-lock keywords,
+;; especially for keywords that span multiple lines.
+;;
+;; The background of the buffer is painted in a rainbow of colors,
+;; where each band in the rainbow represent a region of the buffer
+;; that has been refontified. When the buffer is modified, the
+;; rainbow is updated.
+;;
+;;
+;; Face Explorer:
+;;
+;; Library and tools for faces and text properties.
+;;
+;; This library is useful for packages that convert syntax highlighted
+;; buffers to other formats. The functions can be used to determine
+;; how a face or a face text property looks, in terms of primitive
+;; face attributes (e.g. foreground and background colors). Two sets
+;; of functions are provided, one for existing frames and one for
+;; fictitious displays, like 8 color tty.
+;;
+;; In addition, the following tools are provided:
+;;
+;; - `face-explorer-list-faces' -- list all available faces. Like
+;; `list-faces-display' but with information on how a face is
+;; defined. In addition, a sample for the selected frame and for a
+;; fictitious display is shown.
+;;
+;; - `face-explorer-describe-face' -- Print detailed information on
+;; how a face is defined, and list all underlying definitions.
+;;
+;; - `face-explorer-describe-face-prop' -- Describe the `face' text
+;; property at the point in terms of primitive face attributes.
+;; Also show how it would look on a fictitious display.
+;;
+;; - `face-explorer-list-display-features' -- Show which features a
+;; display supports. Most graphical displays support all, or most,
+;; features. However, many tty:s don't support, for example,
+;; strike-through. Using specially constructed faces, the resulting
+;; buffer will render differently in different displays, e.g. a
+;; graphical frame and a tty connected using `emacsclient -nw'.
+;;
+;; - `face-explorer-list-face-prop-examples' -- Show a buffer with an
+;; assortment of `face' text properties. A sample text is shown in
+;; four variants: Native, a manually maintained reference vector,
+;; the result of `face-explorer-face-prop-attributes' and
+;; `face-explorer-face-prop-attributes-for-fictitious-display'. Any
+;; package that convert a buffer to another format (like HTML, ANSI,
+;; or LaTeX) could use this buffer to ensure that everything work as
+;; intended.
+;;
+;; - `face-explorer-list-overlay-examples' -- Show a buffer with a
+;; number of examples of overlays, some are mixed with `face' text
+;; properties. Any package that convert a buffer to another format
+;; (like HTML, ANSI, or LaTeX) could use this buffer to ensure that
+;; everything work as intended.
+;;
+;; - `face-explorer-tooltip-mode' -- Minor mode that shows tooltips
+;; containing text properties and overlays at the mouse pointer.
+;;
+;; - `face-explorer-simulate-display-mode' -- Minor mode for make a
+;; buffer look like it would on a fictitious display. Using this
+;; you can, for example, see how a theme would look in using dark or
+;; light background, a 8 color tty, or on a grayscale graphical
+;; monitor.
+;;
+;;
+;; Font Lock Regression Suite:
+;;
+;; A collection of example source files for a large number of
+;; programming languages, with ERT tests to ensure that syntax
+;; highlighting does not accidentally change.
+;;
+;; For each source file, font-lock reference files are provided for
+;; various Emacs versions. The reference files contains a plain-text
+;; representation of source file with syntax highlighting, using the
+;; format "faceup".
+;;
+;; Of course, the collection source file can be used for other kinds
+;; of testing, not limited to font-lock regression testing.
+
+;;; Code:
+
+
+(defvar faceup-default-property 'face
+ "The property that should be represented in Faceup without the (prop) part.")
+
+(defvar faceup-properties '(face)
+ "List of properties that should be converted to the Faceup format.
+
+Only face-like property use the short format. All other use the
+non-nesting full format. (See `faceup-face-like-properties'.)" )
+
+
+(defvar faceup-face-like-properties '(face font-lock-face)
+ "List of properties that behave like `face'.
+
+The following properties are assumed about face-like properties:
+
+* Elements are either symbols or property lists, or lists thereof.
+
+* A plain element and a list containing the same element are
+ treated as equal
+
+* Property lists and sequences of property lists are considered
+ equal. For example:
+
+ ((:underline t :foreground \"red\"))
+
+ and
+
+ ((:underline t) (:foreground \"red\"))
+
+Face-like properties are converted to faceup in a nesting fashion.
+
+For example, the string AAAXXXAAA (where the property `prop' has
+the value `(a)' on the A:s and `(a b)' on the X:s) is converted
+as follows, when treated as a face-like property:
+
+ «(prop):a:AAA«(prop):b:XXX»AAAA»
+
+When treated as a non-face-like property:
+
+ «(prop):(a):AAA»«(prop):(a b):XXX»«(prop):(a):AAA»")
+
+
+(defvar faceup-markup-start-char ?«)
+(defvar faceup-markup-end-char ?»)
+
+(defvar faceup-face-short-alist
+ '(;; Generic faces (uppercase letters)
+ (bold . "B")
+ (bold-italic . "Q")
+ (default . "D")
+ (error . "E")
+ (highlight . "H")
+ (italic . "I")
+ (underline . "U")
+ (warning . "W")
+ ;; font-lock-specific faces (lowercase letters)
+ (font-lock-builtin-face . "b")
+ (font-lock-comment-delimiter-face . "m")
+ (font-lock-comment-face . "x")
+ (font-lock-constant-face . "c")
+ (font-lock-doc-face . "d")
+ (font-lock-function-name-face . "f")
+ (font-lock-keyword-face . "k")
+ (font-lock-negation-char-face . "n")
+ (font-lock-preprocessor-face . "p")
+ (font-lock-regexp-grouping-backslash . "h")
+ (font-lock-regexp-grouping-construct . "o")
+ (font-lock-string-face . "s")
+ (font-lock-type-face . "t")
+ (font-lock-variable-name-face . "v")
+ (font-lock-warning-face . "w"))
+ "Alist from faces to one-character representation.")
+
+
+;; Plain: «W....»
+;; Nested: «W...«W...»»
+
+;; Overlapping: xxxxxxxxxx
+;; yyyyyyyyyyyy
+;; «X..«Y..»»«Y...»
+
+
+(defun faceup-markup-string (s)
+ "Return the faceup version of the string S."
+ (with-temp-buffer
+ (insert s)
+ (faceup-markup-buffer)))
+
+
+;;;###autoload
+(defun faceup-view-buffer ()
+ "Display the faceup representation of the current buffer."
+ (interactive)
+ (let ((buffer (get-buffer-create "*FaceUp*")))
+ (with-current-buffer buffer
+ (delete-region (point-min) (point-max)))
+ (faceup-markup-to-buffer buffer)
+ (display-buffer buffer)))
+
+
+;;;###autoload
+(defun faceup-write-file (&optional file-name confirm)
+ "Save the faceup representation of the current buffer to the file FILE-NAME.
+
+Unless a name is given, the file will be named xxx.faceup, where
+xxx is the file name associated with the buffer.
+
+If optional second arg CONFIRM is non-nil, this function
+asks for confirmation before overwriting an existing file.
+Interactively, confirmation is required unless you supply a prefix argument."
+ (interactive
+ (let ((suggested-name (and (buffer-file-name)
+ (concat (buffer-file-name)
+ ".faceup"))))
+ (list (read-file-name "Write faceup file: "
+ default-directory
+ suggested-name
+ nil
+ (file-name-nondirectory suggested-name))
+ (not current-prefix-arg))))
+ (unless file-name
+ (setq file-name (concat (buffer-file-name) ".faceup")))
+ (let ((buffer (current-buffer)))
+ (with-temp-buffer
+ (faceup-markup-to-buffer (current-buffer) buffer)
+ ;; Note: Must set `require-final-newline' inside
+ ;; `with-temp-buffer', otherwise the value will be overridden by
+ ;; the buffers local value.
+ ;;
+ ;; Clear `window-size-change-functions' as a workaround for
+ ;; Emacs bug#19576 (`write-file' saves the wrong buffer if a
+ ;; function in the list change current buffer).
+ (let ((require-final-newline nil)
+ (window-size-change-functions '()))
+ (write-file file-name confirm)))))
+
+
+(defun faceup-markup-buffer ()
+ "Return a string with the content of the buffer using faceup markup."
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (faceup-markup-to-buffer (current-buffer) buf)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+
+
+;; Idea:
+;;
+;; Typically, only one face is used. However, when two faces are used,
+;; the one of top is typically shorter. Hence, the faceup variant
+;; should treat the inner group of nested ranges the upper (i.e. the
+;; one towards the front.) For example:
+;;
+;; «f:aaaaaaa«U:xxxx»aaaaaa»
+
+(defun faceup-copy-and-quote (start end to-buffer)
+ "Quote and insert the text between START and END into TO-BUFFER."
+ (let ((not-markup (concat "^"
+ (make-string 1 faceup-markup-start-char)
+ (make-string 1 faceup-markup-end-char))))
+ (save-excursion
+ (goto-char start)
+ (while (< (point) end)
+ (let ((old (point)))
+ (skip-chars-forward not-markup end)
+ (let ((s (buffer-substring-no-properties old (point))))
+ (with-current-buffer to-buffer
+ (insert s))))
+ ;; Quote stray markup characters.
+ (unless (= (point) end)
+ (let ((next-char (following-char)))
+ (with-current-buffer to-buffer
+ (insert faceup-markup-start-char)
+ (insert next-char)))
+ (forward-char))))))
+
+
+;; A face (string or symbol) can be on the top level.
+;;
+;; A face text property can be a arbitrary deep lisp structure. Each
+;; list in the tree structure contains faces (symbols or strings) up
+;; to the first keyword, e.g. :foreground, thereafter the list is
+;; considered a property list, regardless of the content. A special
+;; case are `(foreground-color . COLOR)' and `(background-color
+;; . COLOR)', old forms used to represent the foreground and
+;; background colors, respectively.
+;;
+;; Some of this is undocumented, and took some effort to reverse
+;; engineer.
+(defun faceup-normalize-face-property (value)
+ "Normalize VALUES into a list of faces and (KEY VALUE) entries."
+ (cond ((null value)
+ '())
+ ((symbolp value)
+ (list value))
+ ((stringp value)
+ (list (intern value)))
+ ((consp value)
+ (cond ((eq (car value) 'foreground-color)
+ (list (list :foreground (cdr value))))
+ ((eq (car value) 'background-color)
+ (list (list :background (cdr value))))
+ (t
+ ;; A list
+ (if (keywordp (car value))
+ ;; Once a keyword has been seen, the rest of the
+ ;; list is treated as a property list, regardless
+ ;; of what it contains.
+ (let ((res '()))
+ (while value
+ (let ((key (pop value))
+ (val (pop value)))
+ (when (keywordp key)
+ (push (list key val) res))))
+ res)
+ (append
+ (faceup-normalize-face-property (car value))
+ (faceup-normalize-face-property (cdr value)))))))
+ (t
+ (error "Unexpected text property %s" value))))
+
+
+(defun faceup-get-text-properties (pos)
+ "Alist of properties and values at POS.
+
+Face-like properties are normalized -- value is a list of
+faces (symbols) and short (KEY VALUE) lists. The list is
+reversed to that later elements take precedence over earlier."
+ (let ((res '()))
+ (dolist (prop faceup-properties)
+ (let ((value (get-text-property pos prop)))
+ (when value
+ (when (memq prop faceup-face-like-properties)
+ ;; Normalize face-like properties.
+ (setq value (reverse (faceup-normalize-face-property value))))
+ (push (cons prop value) res))))
+ res))
+
+
+(defun faceup-markup-to-buffer (to-buffer &optional buffer)
+ "Convert content of BUFFER to faceup form and insert in TO-BUFFER."
+ (save-excursion
+ (if buffer
+ (set-buffer buffer))
+ ;; Font-lock often only fontifies the visible sections. This
+ ;; ensures that the entire buffer is fontified before converting
+ ;; it.
+ (if (and font-lock-mode
+ ;; Prevent clearing out face attributes explicitly
+ ;; inserted by functions like `list-faces-display'.
+ ;; (Font-lock mode is enabled, for some reason, in those
+ ;; buffers.)
+ (not (and (eq major-mode 'help-mode)
+ (not font-lock-defaults))))
+ (font-lock-fontify-region (point-min) (point-max)))
+ (let ((last-pos (point-min))
+ (pos nil)
+ ;; List of (prop . value), representing open faceup blocks.
+ (state '()))
+ (while (setq pos (faceup-next-property-change pos))
+ ;; Insert content.
+ (faceup-copy-and-quote last-pos pos to-buffer)
+ (setq last-pos pos)
+ (let ((prop-values (faceup-get-text-properties pos)))
+ (let ((next-state '()))
+ (setq state (reverse state))
+ ;; Find all existing sequences that should continue.
+ (let ((cont t))
+ (while (and state
+ prop-values
+ cont)
+ (let* ((prop (car (car state)))
+ (value (cdr (car state)))
+ (pair (assq prop prop-values)))
+ (if (memq prop faceup-face-like-properties)
+ ;; Element by element.
+ (if (equal value (car (cdr pair)))
+ (setcdr pair (cdr (cdr pair)))
+ (setq cont nil))
+ ;; Full value.
+ ;;
+ ;; Note: Comparison is done by `eq', since (at
+ ;; least) the `display' property treats
+ ;; eq-identical values differently than when
+ ;; comparing using `equal'. See "Display Specs
+ ;; That Replace The Text" in the elisp manual.
+ (if (eq value (cdr pair))
+ (setq prop-values (delq pair prop-values))
+ (setq cont nil))))
+ (when cont
+ (push (pop state) next-state))))
+ ;; End values that should not be included in the next state.
+ (while state
+ (with-current-buffer to-buffer
+ (insert (make-string 1 faceup-markup-end-char)))
+ (pop state))
+ ;; Start new ranges.
+ (with-current-buffer to-buffer
+ (while prop-values
+ (let ((pair (pop prop-values)))
+ (if (memq (car pair) faceup-face-like-properties)
+ ;; Face-like.
+ (dolist (element (cdr pair))
+ (insert (make-string 1 faceup-markup-start-char))
+ (unless (eq (car pair) faceup-default-property)
+ (insert "(")
+ (insert (symbol-name (car pair)))
+ (insert "):"))
+ (if (symbolp element)
+ (let ((short
+ (assq element faceup-face-short-alist)))
+ (if short
+ (insert (cdr short) ":")
+ (insert ":" (symbol-name element) ":")))
+ (insert ":")
+ (prin1 element (current-buffer))
+ (insert ":"))
+ (push (cons (car pair) element) next-state))
+ ;; Not face-like.
+ (insert (make-string 1 faceup-markup-start-char))
+ (insert "(")
+ (insert (symbol-name (car pair)))
+ (insert "):")
+ (prin1 (cdr pair) (current-buffer))
+ (insert ":")
+ (push pair next-state)))))
+ ;; Insert content.
+ (setq state next-state))))
+ ;; Insert whatever is left after the last face change.
+ (faceup-copy-and-quote last-pos (point-max) to-buffer))))
+
+
+
+;; Some basic facts:
+;;
+;; (get-text-property (point-max) ...) always return nil. To check the
+;; last character in the buffer, use (- (point-max) 1).
+;;
+;; If a text has more than one face, the first one in the list
+;; takes precedence, when being viewed in Emacs.
+;;
+;; (let ((s "ABCDEF"))
+;; (set-text-properties 1 4
+;; '(face (font-lock-warning-face font-lock-variable-name-face)) s)
+;; (insert s))
+;;
+;; => ABCDEF
+;;
+;; Where DEF is drawn in "warning" face.
+
+
+(defun faceup-has-any-text-property (pos)
+ "True if any properties in `faceup-properties' are defined at POS."
+ (let ((res nil))
+ (dolist (prop faceup-properties)
+ (when (get-text-property pos prop)
+ (setq res t)))
+ res))
+
+
+(defun faceup-next-single-property-change (pos)
+ "Next position a property in `faceup-properties' changes after POS, or nil."
+ (let ((res nil))
+ (dolist (prop faceup-properties)
+ (let ((next (next-single-property-change pos prop)))
+ (when next
+ (setq res (if res
+ (min res next)
+ next)))))
+ res))
+
+
+(defun faceup-next-property-change (pos)
+ "Next position after POS where one of the tracked properties change.
+
+If POS is nil, also include `point-min' in the search.
+If last character contains a tracked property, return `point-max'.
+
+See `faceup-properties' for a list of tracked properties."
+ (if (eq pos (point-max))
+ ;; Last search returned `point-max'. There is no more to search
+ ;; for.
+ nil
+ (if (and (null pos)
+ (faceup-has-any-text-property (point-min)))
+ ;; `pos' is `nil' and the character at `point-min' contains a
+ ;; tracked property, return `point-min'.
+ (point-min)
+ (unless pos
+ ;; Start from the beginning.
+ (setq pos (point-min)))
+ ;; Do a normal search. Compensate for that
+ ;; `next-single-property-change' does not include the end of the
+ ;; buffer, even when a property reach it.
+ (let ((res (faceup-next-single-property-change pos)))
+ (if (and (not res) ; No more found.
+ (not (eq pos (point-max))) ; Not already at the end.
+ (not (eq (point-min) (point-max))) ; Not an empty buffer.
+ (faceup-has-any-text-property (- (point-max) 1)))
+ ;; If a property goes all the way to the end of the
+ ;; buffer, return `point-max'.
+ (point-max)
+ res)))))
+
+
+;; ----------------------------------------------------------------------
+;; Renderer
+;;
+
+;; Functions to convert from the faceup textual representation to text
+;; with real properties.
+
+(defun faceup-render-string (faceup)
+ "Return string with properties from FACEUP written with Faceup markup."
+ (with-temp-buffer
+ (insert faceup)
+ (faceup-render-to-string)))
+
+
+;;;###autoload
+(defun faceup-render-view-buffer (&optional buffer)
+ "Convert BUFFER containing Faceup markup to a new buffer and display it."
+ (interactive)
+ (with-current-buffer (or buffer (current-buffer))
+ (let ((dest-buffer (get-buffer-create "*FaceUp rendering*")))
+ (with-current-buffer dest-buffer
+ (delete-region (point-min) (point-max)))
+ (faceup-render-to-buffer dest-buffer)
+ (display-buffer dest-buffer))))
+
+
+(defun faceup-render-to-string (&optional buffer)
+ "Convert BUFFER containing faceup markup to a string with faces."
+ (unless buffer
+ (setq buffer (current-buffer)))
+ (with-temp-buffer
+ (faceup-render-to-buffer (current-buffer) buffer)
+ (buffer-substring (point-min) (point-max))))
+
+
+(defun faceup-render-to-buffer (to-buffer &optional buffer)
+ "Convert BUFFER containing faceup markup into text with faces in TO-BUFFER."
+ (with-current-buffer (or buffer (current-buffer))
+ (goto-char (point-min))
+ (let ((last-point (point))
+ (state '()) ; List of (prop . element)
+ (not-markup (concat
+ "^"
+ (make-string 1 faceup-markup-start-char)
+ (make-string 1 faceup-markup-end-char))))
+ (while (progn
+ (skip-chars-forward not-markup)
+ (if (not (eq last-point (point)))
+ (let ((text (buffer-substring-no-properties
+ last-point (point)))
+ (prop-elements-alist '()))
+ ;; Accumulate all values for each property.
+ (dolist (prop-element state)
+ (let ((property (car prop-element))
+ (element (cdr prop-element)))
+ (let ((pair (assq property prop-elements-alist)))
+ (unless pair
+ (setq pair (cons property '()))
+ (push pair prop-elements-alist))
+ (push element (cdr pair)))))
+ ;; Apply all properties.
+ (dolist (pair prop-elements-alist)
+ (let ((property (car pair))
+ (elements (reverse (cdr pair))))
+ ;; Create one of:
+ ;; (property element) or
+ ;; (property (element element ...))
+ (when (eq (length elements) 1)
+ ;; This ensures that non-face-like
+ ;; properties are restored to their
+ ;; original state.
+ (setq elements (car elements)))
+ (add-text-properties 0 (length text)
+ (list property elements)
+ text)))
+ (with-current-buffer to-buffer
+ (insert text))
+ (setq last-point (point))))
+ (not (eobp)))
+ (if (eq (following-char) faceup-markup-start-char)
+ ;; Start marker.
+ (progn
+ (forward-char)
+ (if (or (eq (following-char) faceup-markup-start-char)
+ (eq (following-char) faceup-markup-end-char))
+ ;; Escaped markup character.
+ (progn
+ (setq last-point (point))
+ (forward-char))
+ ;; Markup sequence.
+ (let ((property faceup-default-property))
+ (when (eq (following-char) ?\( )
+ (forward-char) ; "("
+ (let ((p (point)))
+ (forward-sexp)
+ (setq property (intern (buffer-substring p (point)))))
+ (forward-char)) ; ")"
+ (let ((element
+ (if (eq (following-char) ?:)
+ ;; :element:
+ (progn
+ (forward-char)
+ (prog1
+ (let ((p (point)))
+ (forward-sexp)
+ ;; Note: (read (current-buffer))
+ ;; doesn't work, as it reads more
+ ;; than a sexp.
+ (read (buffer-substring p (point))))
+ (forward-char)))
+ ;; X:
+ (prog1
+ (car (rassoc (buffer-substring-no-properties
+ (point) (+ (point) 1))
+ faceup-face-short-alist))
+ (forward-char 2)))))
+ (push (cons property element) state)))
+ (setq last-point (point))))
+ ;; End marker.
+ (pop state)
+ (forward-char)
+ (setq last-point (point)))))))
+
+;; ----------------------------------------------------------------------
+
+;;;###autoload
+(defun faceup-clean-buffer ()
+ "Remove faceup markup from buffer."
+ (interactive)
+ (goto-char (point-min))
+ (let ((not-markup (concat
+ "^"
+ (make-string 1 faceup-markup-start-char)
+ (make-string 1 faceup-markup-end-char))))
+ (while (progn (skip-chars-forward not-markup)
+ (not (eobp)))
+ (if (eq (following-char) faceup-markup-end-char)
+ ;; End markers are always on their own.
+ (delete-char 1)
+ ;; Start marker.
+ (delete-char 1)
+ (if (or (eq (following-char) faceup-markup-start-char)
+ (eq (following-char) faceup-markup-end-char))
+ ;; Escaped markup character, delete the escape and skip
+ ;; the original character.
+ (forward-char)
+ ;; Property name (if present)
+ (if (eq (following-char) ?\( )
+ (let ((p (point)))
+ (forward-sexp)
+ (delete-region p (point))))
+ ;; Markup sequence.
+ (if (eq (following-char) ?:)
+ ;; :value:
+ (let ((p (point)))
+ (forward-char)
+ (forward-sexp)
+ (unless (eobp)
+ (forward-char))
+ (delete-region p (point)))
+ ;; X:
+ (delete-char 1) ; The one-letter form.
+ (delete-char 1))))))) ; The colon.
+
+
+(defun faceup-clean-string (s)
+ "Remove faceup markup from string S."
+ (with-temp-buffer
+ (insert s)
+ (faceup-clean-buffer)
+ (buffer-substring (point-min) (point-max))))
+
+
+;; ----------------------------------------------------------------------
+;; Regression test support
+;;
+
+(defvar faceup-test-explain nil
+ "When non-nil, tester functions returns a text description on failure.
+
+Of course, this only work for test functions aware of this
+variable, like `faceup-test-equal' and functions based on this
+function.
+
+This is intended to be used to simplify `ert' explain functions,
+which could be defined as:
+
+ (defun my-test (args...) ...)
+ (defun my-test-explain (args...)
+ (let ((faceup-test-explain t))
+ (the-test args...)))
+ (put 'my-test 'ert-explainer 'my-test-explain)
+
+Alternative, you can use the macro `faceup-defexplainer' as follows:
+
+ (defun my-test (args...) ...)
+ (faceup-defexplainer my-test)
+
+Test functions, like `faceup-test-font-lock-buffer', built on top
+of `faceup-test-equal', and other functions that adhere to this
+variable, can easily define their own explainer functions.")
+
+;;;###autoload
+(defmacro faceup-defexplainer (function)
+ "Define an Ert explainer function for FUNCTION.
+
+FUNCTION must return an explanation when the test fails and
+`faceup-test-explain' is set."
+ (let ((name (intern (concat (symbol-name function) "-explainer"))))
+ `(progn
+ (defun ,name (&rest args)
+ (let ((faceup-test-explain t))
+ (apply (quote ,function) args)))
+ (put (quote ,function) 'ert-explainer (quote ,name)))))
+
+
+;; ------------------------------
+;; Multi-line string support.
+;;
+
+(defun faceup-test-equal (lhs rhs)
+ "Compares two (multi-line) strings, LHS and RHS, for equality.
+
+This is intended to be used in Ert regression test rules.
+
+When `faceup-test-explain' is non-nil, instead of returning nil
+on inequality, a list is returned with a explanation what
+differs. Currently, this function reports 1) if the number of
+lines in the strings differ. 2) the lines and the line numbers on
+which the string differed.
+
+For example:
+ (let ((a \"ABC\\nDEF\\nGHI\")
+ (b \"ABC\\nXXX\\nGHI\\nZZZ\")
+ (faceup-test-explain t))
+ (message \"%s\" (faceup-test-equal a b)))
+
+ ==> (4 3 number-of-lines-differ (on-line 2 (DEF) (XXX)))
+
+When used in an `ert' rule, the output is as below:
+
+ (ert-deftest faceup-test-equal-example ()
+ (let ((a \"ABC\\nDEF\\nGHI\")
+ (b \"ABC\\nXXX\\nGHI\\nZZZ\"))
+ (should (faceup-test-equal a b))))
+
+ F faceup-test-equal-example
+ (ert-test-failed
+ ((should
+ (faceup-test-equal a b))
+ :form
+ (faceup-test-equal \"ABC\\nDEF\\nGHI\" \"ABC\\nXXX\\nGHI\\nZZZ\")
+ :value nil :explanation
+ (4 3 number-of-lines-differ
+ (on-line 2
+ (\"DEF\")
+ (\"XXX\")))))"
+ (if (equal lhs rhs)
+ t
+ (if faceup-test-explain
+ (let ((lhs-lines (split-string lhs "\n"))
+ (rhs-lines (split-string rhs "\n"))
+ (explanation '())
+ (line 1))
+ (unless (= (length lhs-lines) (length rhs-lines))
+ (setq explanation (list 'number-of-lines-differ
+ (length lhs-lines) (length rhs-lines))))
+ (while lhs-lines
+ (let ((one (pop lhs-lines))
+ (two (pop rhs-lines)))
+ (unless (equal one two)
+ (setq explanation
+ (cons (list 'on-line line (list one) (list two))
+ explanation)))
+ (setq line (+ line 1))))
+ (nreverse explanation))
+ nil)))
+
+(faceup-defexplainer faceup-test-equal)
+
+
+;; ------------------------------
+;; Font-lock regression test support.
+;;
+
+(defun faceup-test-font-lock-buffer (mode faceup &optional buffer)
+ "Verify that BUFFER is fontified as FACEUP for major mode MODE.
+
+If BUFFER is not specified the current buffer is used.
+
+Note that the major mode of the buffer is set to MODE and that
+the buffer is fontified.
+
+If MODE is a list, the first element is the major mode, the
+remaining are additional functions to call, e.g. minor modes."
+ (save-excursion
+ (if buffer
+ (set-buffer buffer))
+ (if (listp mode)
+ (dolist (m mode)
+ (funcall m))
+ (funcall mode))
+ (font-lock-fontify-region (point-min) (point-max))
+ (let ((result (faceup-markup-buffer)))
+ (faceup-test-equal faceup result))))
+
+(faceup-defexplainer faceup-test-font-lock-buffer)
+
+
+(defun faceup-test-font-lock-string (mode faceup)
+ "True if FACEUP is re-fontified as the faceup markup for major mode MODE.
+
+The string FACEUP is stripped from markup, inserted into a
+buffer, the requested major mode activated, the buffer is
+fontified, the result is again converted to the faceup form, and
+compared with the original string."
+ (with-temp-buffer
+ (insert faceup)
+ (faceup-clean-buffer)
+ (faceup-test-font-lock-buffer mode faceup)))
+
+(faceup-defexplainer faceup-test-font-lock-string)
+
+
+(defun faceup-test-font-lock-file (mode file &optional faceup-file)
+ "Verify that FILE is fontified as FACEUP-FILE for major mode MODE.
+
+If FACEUP-FILE is omitted, FILE.faceup is used."
+ (unless faceup-file
+ (setq faceup-file (concat file ".faceup")))
+ (let ((faceup (with-temp-buffer
+ (insert-file-contents faceup-file)
+ (buffer-substring-no-properties (point-min) (point-max)))))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (faceup-test-font-lock-buffer mode faceup))))
+
+(faceup-defexplainer faceup-test-font-lock-file)
+
+
+;; ------------------------------
+;; Get current file directory. Test cases can use this to locate test
+;; files.
+;;
+
+(defun faceup-this-file-directory ()
+ "The directory of the file where the call to this function is located in.
+Intended to be called when a file is loaded."
+ (expand-file-name
+ (if load-file-name
+ ;; File is being loaded.
+ (file-name-directory load-file-name)
+ ;; File is being evaluated using, for example, `eval-buffer'.
+ default-directory)))
+
+
+;; ----------------------------------------------------------------------
+;; The end
+;;
+
+(provide 'faceup)
+
+;;; faceup.el ends here
diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el
index 9b98f05ae81..29c42f36938 100644
--- a/lisp/emacs-lisp/find-func.el
+++ b/lisp/emacs-lisp/find-func.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index a33937cd752..18ba834b91a 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el
index c96b400809b..ef6cfba420c 100644
--- a/lisp/emacs-lisp/generator.el
+++ b/lisp/emacs-lisp/generator.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -86,10 +86,7 @@
(defvar cps--cleanup-function nil)
(defmacro cps--gensym (fmt &rest args)
- ;; Change this function to use `cl-gensym' if you want the generated
- ;; code to be easier to read and debug.
- ;; (cl-gensym (apply #'format fmt args))
- `(progn (ignore ,@args) (make-symbol ,fmt)))
+ `(gensym (format ,fmt ,@args)))
(defvar cps--dynamic-wrappers '(identity)
"List of transformer functions to apply to atomic forms we
@@ -145,8 +142,7 @@ the CPS state machinery.
`(let ((,dynamic-var ,static-var))
(unwind-protect ; Update the static shadow after evaluation is done
,form
- (setf ,static-var ,dynamic-var))
- ,form)))
+ (setf ,static-var ,dynamic-var)))))
(defmacro cps--with-dynamic-binding (dynamic-var static-var &rest body)
"Evaluate BODY such that generated atomic evaluations run with
@@ -684,7 +680,8 @@ sub-iterator function returns via `iter-end-of-sequence'."
When called as a function, NAME returns an iterator value that
encapsulates the state of a computation that produces a sequence
of values. Callers can retrieve each value using `iter-next'."
- (declare (indent defun))
+ (declare (indent defun)
+ (debug (&define name lambda-list lambda-doc def-body)))
(cl-assert lexical-binding)
(let* ((parsed-body (macroexp-parse-body body))
(declarations (car parsed-body))
@@ -696,7 +693,8 @@ of values. Callers can retrieve each value using `iter-next'."
(defmacro iter-lambda (arglist &rest body)
"Return a lambda generator.
`iter-lambda' is to `iter-defun' as `lambda' is to `defun'."
- (declare (indent defun))
+ (declare (indent defun)
+ (debug (&define lambda-list lambda-doc def-body)))
(cl-assert lexical-binding)
`(lambda ,arglist
,(cps-generate-evaluator body)))
@@ -720,7 +718,8 @@ is blocked."
"Loop over values from an iterator.
Evaluate BODY with VAR bound to each value from ITERATOR.
Return the value with which ITERATOR finished iteration."
- (declare (indent 1))
+ (declare (indent 1)
+ (debug ((symbolp form) body)))
(let ((done-symbol (cps--gensym "iter-do-iterator-done"))
(condition-symbol (cps--gensym "iter-do-condition"))
(it-symbol (cps--gensym "iter-do-iterator"))
diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el
index 165b0d4507d..14208857bc4 100644
--- a/lisp/emacs-lisp/generic.el
+++ b/lisp/emacs-lisp/generic.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index c5c12a6414c..777b955d90d 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -146,12 +146,7 @@ NAME is a symbol: the name of a function, macro, or special form.
HANDLER is a function which takes an argument DO followed by the same
arguments as NAME. DO is a function as defined in `gv-get'."
(declare (indent 1) (debug (sexp form)))
- ;; Use eval-and-compile so the method can be used in the same file as it
- ;; is defined.
- ;; FIXME: Just like byte-compile-macro-environment, we should have something
- ;; like byte-compile-symbolprop-environment so as to handle these things
- ;; cleanly without affecting the running Emacs.
- `(eval-and-compile (put ',name 'gv-expander ,handler)))
+ `(function-put ',name 'gv-expander ,handler))
;;;###autoload
(defun gv--defun-declaration (symbol name args handler &optional fix)
@@ -308,7 +303,9 @@ The return value is the last VAL in the list.
(lambda (do before index place)
(gv-letplace (getter setter) place
(funcall do `(edebug-after ,before ,index ,getter)
- setter))))
+ (lambda (store)
+ `(progn (edebug-after ,before ,index ,getter)
+ ,(funcall setter store)))))))
;;; The common generalized variables.
@@ -377,10 +374,12 @@ The return value is the last VAL in the list.
`(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
(gv-define-expander alist-get
- (lambda (do key alist &optional default remove)
+ (lambda (do key alist &optional default remove testfn)
(macroexp-let2 macroexp-copyable-p k key
(gv-letplace (getter setter) alist
- (macroexp-let2 nil p `(assq ,k ,getter)
+ (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
+ (assoc ,k ,getter ,testfn)
+ (assq ,k ,getter))
(funcall do (if (null default) `(cdr ,p)
`(if ,p (cdr ,p) ,default))
(lambda (v)
@@ -434,7 +433,7 @@ The return value is the last VAL in the list.
;; code is large, but otherwise results in more efficient code.
`(if ,test ,(gv-get then do)
,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
- (let ((v (make-symbol "v")))
+ (let ((v (gensym "v")))
(macroexp-let2 nil
gv `(if ,test ,(gv-letplace (getter setter) then
`(cons (lambda () ,getter)
@@ -459,7 +458,7 @@ The return value is the last VAL in the list.
(gv-get (macroexp-progn (cdr branch)) do)))
(gv-get (car branch) do)))
branches))
- (let ((v (make-symbol "v")))
+ (let ((v (gensym "v")))
(macroexp-let2 nil
gv `(cond
,@(mapcar
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
index 78611c661ab..9dc59467ffd 100644
--- a/lisp/emacs-lisp/helper.el
+++ b/lisp/emacs-lisp/helper.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el
index ce46f66aef8..ff27158f836 100644
--- a/lisp/emacs-lisp/inline.el
+++ b/lisp/emacs-lisp/inline.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -59,7 +59,7 @@
;; and then M-: (macroexpand-all '(my-test1 y)) RET)
;; There is still one downside shared with the defmacro and cl-defsubst
;; approach: when the function is inlined, the scoping rules (dynamic or
-;; lexical) will be inherited from the the call site.
+;; lexical) will be inherited from the call site.
;; Of course, since define-inline defines a compiler macro, you can also do
;; call-site optimizations, just like you can with `defmacro', but not with
@@ -218,7 +218,7 @@ After VARS is handled, BODY is evaluated in the new environment."
`(let* ((,bsym ())
(,listvar (mapcar (lambda (e)
(if (macroexp-copyable-p e) e
- (let ((v (make-symbol "v")))
+ (let ((v (gensym "v")))
(push (list v e) ,bsym)
v)))
,listvar)))
diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el
index cf82fe3ec63..70a58c4b1c6 100644
--- a/lisp/emacs-lisp/let-alist.el
+++ b/lisp/emacs-lisp/let-alist.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
index fc3caf3359a..4e4957faa1f 100644
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ b/lisp/emacs-lisp/lisp-mnt.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -326,12 +326,13 @@ Return argument is of the form (\"HOLDER\" \"YEAR1\" ... \"YEARN\")"
(start (point))
(end (line-end-position)))
;; Cope with multi-line copyright `lines'. Assume the second
- ;; line is indented (with the same commenting style).
+ ;; line is indented at least as much as the original, with the
+ ;; same commenting style.
(save-excursion
(beginning-of-line 2)
- (let ((str (concat (match-string-no-properties 1) "[ \t]+")))
+ (let ((str (match-string-no-properties 1)))
(beginning-of-line)
- (while (looking-at str)
+ (while (and (looking-at str) (not (looking-at lm-copyright-prefix)))
(setq end (line-end-position))
(beginning-of-line 2))))
;; Make a single line and parse that.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 59db00d5f96..7d38052fd40 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -461,11 +461,6 @@ This will generate compile-time constants from BINDINGS."
(throw 'found t)))))))
(1 'font-lock-regexp-grouping-backslash prepend)
(3 'font-lock-regexp-grouping-construct prepend))
- ;; This is too general -- rms.
- ;; A user complained that he has functions whose names start with `do'
- ;; and that they get the wrong color.
- ;; ;; CL `with-' and `do-' constructs
- ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 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?")))
@@ -491,6 +486,11 @@ This will generate compile-time constants from BINDINGS."
(,(concat "[`‘]\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)"
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
+ (,(concat "\\(#:\\)\\(" lisp-mode-symbol-regexp "\\)")
+ (1 font-lock-comment-delimiter-face)
+ (2 font-lock-doc-face))
;; Constant values.
(,(concat "\\_<:" lisp-mode-symbol-regexp "\\_>")
(0 font-lock-builtin-face))
@@ -500,8 +500,10 @@ This will generate compile-time constants from BINDINGS."
;; This is too general -- rms.
;; A user complained that he has functions whose names start with `do'
;; and that they get the wrong color.
- ;; ;; CL `with-' and `do-' constructs
- ;;("(\\(\\(do-\\|with-\\)\\(\\s_\\|\\w\\)*\\)" 1 font-lock-keyword-face)
+ ;; That user has violated the http://www.cliki.net/Naming+conventions:
+ ;; CL (but not EL!) `with-' (context) and `do-' (iteration)
+ (,(concat "(\\(\\(do-\\|with-\\)" lisp-mode-symbol-regexp "\\)")
+ (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?")))
@@ -602,6 +604,7 @@ font-lock keywords will not be case sensitive."
;;(set (make-local-variable '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)
(setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
(setq-local outline-level 'lisp-outline-level)
(setq-local add-log-current-defun-function #'lisp-current-defun-name)
@@ -735,9 +738,17 @@ or to switch back to an existing one."
(autoload 'lisp-eval-defun "inf-lisp" nil t)
-;; May still be used by some external Lisp-mode variant.
-(define-obsolete-function-alias 'lisp-comment-indent
- 'comment-indent-default "22.1")
+(defun lisp-comment-indent ()
+ "Like `comment-indent-default', but don't put space after open paren."
+ (or (when (looking-at "\\s<\\s<")
+ (let ((pt (point)))
+ (skip-syntax-backward " ")
+ (if (eq (preceding-char) ?\()
+ (cons (current-column) (current-column))
+ (goto-char pt)
+ nil)))
+ (comment-indent-default)))
+
(define-obsolete-function-alias 'lisp-mode-auto-fill 'do-auto-fill "23.1")
(defcustom lisp-indent-offset nil
@@ -1258,7 +1269,8 @@ and initial semicolons."
;; case). The `;' and `:' stop the paragraph being filled at following
;; comment lines and at keywords (e.g., in `defcustom'). Left parens are
;; escaped to keep font-locking, filling, & paren matching in the source
- ;; file happy.
+ ;; file happy. The `:' must be preceded by whitespace so that keywords
+ ;; inside of the docstring don't start new paragraphs (Bug#7751).
;;
;; `paragraph-separate': A clever regexp distinguishes the first line of
;; a docstring and identifies it as a paragraph separator, so that it
@@ -1271,13 +1283,7 @@ and initial semicolons."
;; `emacs-lisp-docstring-fill-column' if that value is an integer.
(let ((paragraph-start
(concat paragraph-start
- (format "\\|\\s-*\\([(;%s\"]\\|`(\\|#'(\\)"
- ;; If we're inside a string (like the doc
- ;; string), don't consider a colon to be
- ;; a paragraph-start character.
- (if (nth 3 (syntax-ppss))
- ""
- ":"))))
+ "\\|\\s-*\\([(;\"]\\|\\s-:\\|`(\\|#'(\\)"))
(paragraph-separate
(concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
(fill-column (if (and (integerp emacs-lisp-docstring-fill-column)
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 0c1fe42fedb..6952ef4cf49 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -402,7 +402,7 @@ is called as a function to find the defun's beginning."
"Return non-nil if the point is in an \"emptyish\" line.
This means a line that consists entirely of comments and/or
whitespace."
-;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html
+;; See https://lists.gnu.org/r/help-gnu-emacs/2016-08/msg00141.html
(save-excursion
(forward-line 0)
(< (line-end-position)
@@ -525,7 +525,7 @@ the one(s) already marked."
(interactive "p")
(setq arg (or arg 1))
;; There is no `mark-defun-back' function - see
- ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-11/msg00079.html
+ ;; https://lists.gnu.org/r/bug-gnu-emacs/2016-11/msg00079.html
;; for explanation
(when (eq last-command 'mark-defun-back)
(setq arg (- arg)))
@@ -574,7 +574,7 @@ the one(s) already marked."
(goto-char beg)
(unless (= arg -1) ; beginning-of-defun behaves
; strange with zero arg - see
- ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html
+ ; https://lists.gnu.org/r/bug-gnu-emacs/2017-02/msg00196.html
(beginning-of-defun (1- (- arg))))
(push-mark end nil t))))))
(skip-chars-backward "[:space:]\n")
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 9bc194c478c..b7496d5a602 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index af7a9ee4abb..d055a54fb39 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index a89457e877d..2a3e1d0a4b0 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -4,7 +4,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 1.1
+;; Version: 1.2
;; Package: map
;; Maintainer: emacs-devel@gnu.org
@@ -22,7 +22,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -73,7 +73,8 @@ KEYS can also be a list of (KEY VARNAME) pairs, in which case
KEY is an unquoted form.
MAP can be a list, hash-table or array."
- (declare (indent 2) (debug t))
+ (declare (indent 2)
+ (debug ((&rest &or symbolp ([form symbolp])) form body)))
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
,@body))
@@ -93,11 +94,13 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
((arrayp ,map-var) ,(plist-get args :array))
(t (error "Unsupported map: %s" ,map-var)))))
-(defun map-elt (map key &optional default)
+(defun map-elt (map key &optional default testfn)
"Lookup KEY in MAP and return its associated value.
If KEY is not found, return DEFAULT which defaults to nil.
-If MAP is a list, `eql' is used to lookup KEY.
+If MAP is a list, `eql' is used to lookup KEY. Optional argument
+TESTFN, if non-nil, means use its function definition instead of
+`eql'.
MAP can be a list, hash-table or array."
(declare
@@ -106,30 +109,31 @@ MAP can be a list, hash-table or array."
(gv-letplace (mgetter msetter) `(gv-delay-error ,map)
(macroexp-let2* nil
;; Eval them once and for all in the right order.
- ((key key) (default default))
+ ((key key) (default default) (testfn testfn))
`(if (listp ,mgetter)
;; Special case the alist case, since it can't be handled by the
;; map--put function.
,(gv-get `(alist-get ,key (gv-synthetic-place
,mgetter ,msetter)
- ,default)
+ ,default nil ,testfn)
do)
,(funcall do `(map-elt ,mgetter ,key ,default)
(lambda (v) `(map--put ,mgetter ,key ,v)))))))))
(map--dispatch map
- :list (alist-get key map default)
+ :list (alist-get key map default nil testfn)
:hash-table (gethash key map default)
:array (if (and (>= key 0) (< key (seq-length map)))
(seq-elt map key)
default)))
-(defmacro map-put (map key value)
+(defmacro map-put (map key value &optional testfn)
"Associate KEY with VALUE in MAP and return VALUE.
If KEY is already present in MAP, replace the associated value
with VALUE.
+When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'.
MAP can be a list, hash-table or array."
- `(setf (map-elt ,map ,key) ,value))
+ `(setf (map-elt ,map ,key nil ,testfn) ,value))
(defun map-delete (map key)
"Delete KEY from MAP and return MAP.
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index fd1cd2c7aaf..c638d5df51c 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -17,7 +17,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -385,6 +385,18 @@ of the piece of advice."
(defun advice--defalias-fset (fsetfun symbol newdef)
(unless fsetfun (setq fsetfun #'fset))
+ ;; `newdef' shouldn't include advice wrappers, since that's what *we* manage!
+ ;; So if `newdef' includes advice wrappers, it's usually because someone
+ ;; naively took (symbol-function F) and then passed that back to `defalias':
+ ;; let's strip them away.
+ (cond
+ ((advice--p newdef) (setq newdef (advice--cd*r newdef)))
+ ((and (eq 'macro (car-safe newdef))
+ (advice--p (cdr newdef)))
+ (setq newdef `(macro . ,(advice--cd*r (cdr newdef))))))
+ ;; The saved-rewrite is specific to the current value, so since we are about
+ ;; to overwrite that current value with new value, the old saved-rewrite is
+ ;; not relevant any more.
(when (get symbol 'advice--saved-rewrite)
(put symbol 'advice--saved-rewrite nil))
(setq newdef (advice--normalize symbol newdef))
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index a3d90f4fb1b..923da4681a5 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index bebfd18d7a6..f8b4cc888dd 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -101,7 +101,7 @@
;; Michael Olson <mwolson@member.fsf.org>
;; Sebastian Tennant <sebyte@smolny.plus.com>
;; Stefan Monnier <monnier@iro.umontreal.ca>
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Phil Hagelberg <phil@hagelb.org>
;;; ToDo:
@@ -708,24 +708,26 @@ correspond to previously loaded files (those returned by
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
(package-desc-full-name pkg-desc)))
- ;; Activate its dependencies recursively.
- ;; FIXME: This doesn't check whether the activated version is the
- ;; required version.
- (when deps
- (dolist (req (package-desc-reqs pkg-desc))
- (unless (package-activate (car req))
- (error "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
- name (car req) (package-version-join (cadr req))))))
- (package--load-files-for-activation pkg-desc reload)
- ;; Add info node.
- (when (file-exists-p (expand-file-name "dir" pkg-dir))
- ;; FIXME: not the friendliest, but simple.
- (require 'info)
- (info-initialize)
- (push pkg-dir Info-directory-list))
- (push name package-activated-list)
- ;; Don't return nil.
- t))
+ (catch 'exit
+ ;; Activate its dependencies recursively.
+ ;; FIXME: This doesn't check whether the activated version is the
+ ;; required version.
+ (when deps
+ (dolist (req (package-desc-reqs pkg-desc))
+ (unless (package-activate (car req))
+ (message "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
+ name (car req) (package-version-join (cadr req)))
+ (throw 'exit nil))))
+ (package--load-files-for-activation pkg-desc reload)
+ ;; Add info node.
+ (when (file-exists-p (expand-file-name "dir" pkg-dir))
+ ;; FIXME: not the friendliest, but simple.
+ (require 'info)
+ (info-initialize)
+ (push pkg-dir Info-directory-list))
+ (push name package-activated-list)
+ ;; Don't return nil.
+ t)))
(declare-function find-library-name "find-func" (library))
@@ -866,14 +868,14 @@ untar into a directory named DIR; otherwise, signal an error."
;; Activation has to be done before compilation, so that if we're
;; upgrading and macros have changed we load the new definitions
;; before compiling.
- (package-activate-1 new-desc :reload :deps)
- ;; FIXME: Compilation should be done as a separate, optional, step.
- ;; E.g. for multi-package installs, we should first install all packages
- ;; and then compile them.
- (package--compile new-desc)
- ;; After compilation, load again any files loaded by
- ;; `activate-1', so that we use the byte-compiled definitions.
- (package--load-files-for-activation new-desc :reload))
+ (when (package-activate-1 new-desc :reload :deps)
+ ;; FIXME: Compilation should be done as a separate, optional, step.
+ ;; E.g. for multi-package installs, we should first install all packages
+ ;; and then compile them.
+ (package--compile new-desc)
+ ;; After compilation, load again any files loaded by
+ ;; `activate-1', so that we use the byte-compiled definitions.
+ (package--load-files-for-activation new-desc :reload)))
pkg-dir))
(defun package-generate-description-file (pkg-desc pkg-file)
@@ -959,17 +961,12 @@ This assumes that `pkg-desc' has already been activated with
(defun package-read-from-string (str)
"Read a Lisp expression from STR.
Signal an error if the entire string was not used."
- (let* ((read-data (read-from-string str))
- (more-left
- (condition-case nil
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string
- (substring str (cdr read-data))))
- t)
- (end-of-file nil))))
- (if more-left
- (error "Can't read whole string")
- (car read-data))))
+ (pcase-let ((`(,expr . ,offset) (read-from-string str)))
+ (condition-case ()
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string str offset))
+ (error "Can't read whole string"))
+ (end-of-file expr))))
(defun package--prepare-dependencies (deps)
"Turn DEPS into an acceptable list of dependencies.
@@ -1190,7 +1187,7 @@ errors signaled by ERROR-FORM or by BODY).
(let ((,b-sym (current-buffer)))
(require 'url-handlers)
(unless-error ,body
- (when-let ((er (plist-get status :error)))
+ (when-let* ((er (plist-get status :error)))
(error "Error retrieving: %s %S" ,url-sym er))
(with-current-buffer ,b-sym
(goto-char (point-min))
@@ -1463,7 +1460,11 @@ taken care of by `package-initialize'."
(package-read-all-archive-contents)
(unless no-activate
(dolist (elt package-alist)
- (package-activate (car elt))))
+ (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))))))
(setq package--initialized t)
;; This uses `package--mapc' so it must be called after
;; `package--initialized' is t.
@@ -1764,8 +1765,8 @@ Only these packages will be in the return value an their cdrs are
destructively set to nil in ONLY."
(let ((out))
(dolist (dep (package-desc-reqs package))
- (when-let ((cell (assq (car dep) only))
- (dep-package (cdr-safe cell)))
+ (when-let* ((cell (assq (car dep) only))
+ (dep-package (cdr-safe cell)))
(setcdr cell nil)
(setq out (append (package--sort-deps-in-alist dep-package only)
out))))
@@ -1784,7 +1785,7 @@ if all the in-between dependencies are also in PACKAGE-LIST."
(dolist (cell alist out-list)
;; `package--sort-deps-in-alist' destructively changes alist, so
;; some cells might already be empty. We check this here.
- (when-let ((pkg-desc (cdr cell)))
+ (when-let* ((pkg-desc (cdr cell)))
(setcdr cell nil)
(setq out-list
(append (package--sort-deps-in-alist pkg-desc alist)
@@ -1841,7 +1842,7 @@ if all the in-between dependencies are also in PACKAGE-LIST."
;; Update the old pkg-desc which will be shown on the description buffer.
(setf (package-desc-signed pkg-desc) t)
;; Update the new (activated) pkg-desc as well.
- (when-let ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist))))
+ (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist))))
(setf (package-desc-signed (car pkg-descs)) t))))))))))
(defun package-installed-p (package &optional min-version)
@@ -1964,12 +1965,12 @@ to install it but still mark it as selected."
(unless (or dont-select (package--user-selected-p name))
(package--save-selected-packages
(cons name package-selected-packages)))
- (if-let ((transaction
- (if (package-desc-p pkg)
- (unless (package-installed-p pkg)
- (package-compute-transaction (list pkg)
- (package-desc-reqs pkg)))
- (package-compute-transaction () (list (list pkg))))))
+ (if-let* ((transaction
+ (if (package-desc-p pkg)
+ (unless (package-installed-p pkg)
+ (package-compute-transaction (list pkg)
+ (package-desc-reqs pkg)))
+ (package-compute-transaction () (list (list pkg))))))
(package-download-transaction transaction)
(message "`%s' is already installed" name))))
@@ -2127,7 +2128,7 @@ If NOSAVE is non-nil, the package is not removed from
(package-desc-name pkg-used-elsewhere-by)))
(t
(add-hook 'post-command-hook #'package-menu--post-refresh)
- (delete-directory dir t t)
+ (delete-directory dir t)
;; Remove NAME-VERSION.signed and NAME-readme.txt files.
(dolist (suffix '(".signed" "readme.txt"))
(let* ((version (package-version-join (package-desc-version pkg-desc)))
@@ -2254,6 +2255,7 @@ Otherwise no newline is inserted."
(archive (if desc (package-desc-archive desc)))
(extras (and desc (package-desc-extras desc)))
(homepage (cdr (assoc :url extras)))
+ (commit (cdr (assoc :commit extras)))
(keywords (if desc (package-desc--keywords desc)))
(built-in (eq pkg-dir 'builtin))
(installable (and archive (not built-in)))
@@ -2326,6 +2328,8 @@ Otherwise no newline is inserted."
(and version
(package--print-help-section "Version"
(package-version-join version)))
+ (when commit
+ (package--print-help-section "Commit" commit))
(when desc
(package--print-help-section "Summary"
(package-desc-summary desc)))
@@ -2751,6 +2755,7 @@ KEYWORDS should be nil or a list of keywords."
(push pkg info-list))))))
;; Print the result.
+ (tabulated-list-init-header)
(setq tabulated-list-entries
(mapcar #'package-menu--print-info-simple info-list))))
@@ -3274,7 +3279,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm."
(package--update-selected-packages .install .delete)
(package-menu--perform-transaction install-list delete-list)
(when package-selected-packages
- (if-let ((removable (package--removable-packages)))
+ (if-let* ((removable (package--removable-packages)))
(message "Package menu: Operation finished. %d packages %s"
(length removable)
(substitute-command-keys
@@ -3346,7 +3351,7 @@ Store this list in `package-menu--new-package-list'."
(defun package-menu--find-and-notify-upgrades ()
"Notify the user of upgradable packages."
- (when-let ((upgrades (package-menu--find-upgrades)))
+ (when-let* ((upgrades (package-menu--find-upgrades)))
(message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
(length upgrades)
(if (= (length upgrades) 1) "" "s")
@@ -3387,7 +3392,9 @@ This function is called after `package-refresh-contents'."
"Display a list of packages.
This first fetches the updated list of packages before
displaying, unless a prefix argument NO-FETCH is specified.
-The list is displayed in a buffer named `*Packages*'."
+The list is displayed in a buffer named `*Packages*', and
+includes the package's version, availability status, and a
+short description."
(interactive "P")
(require 'finder-inf nil t)
;; Initialize the package system if necessary.
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 4a06ab25d3e..36af88423c8 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -213,7 +213,7 @@ Emacs Lisp manual for more information and examples."
(defmacro pcase-exhaustive (exp &rest cases)
"The exhaustive version of `pcase' (which see)."
(declare (indent 1) (debug pcase))
- (let* ((x (make-symbol "x"))
+ (let* ((x (gensym "x"))
(pcase--dontwarn-upats (cons x pcase--dontwarn-upats)))
(pcase--expand
;; FIXME: Could we add the FILE:LINE data in the error message?
@@ -226,7 +226,7 @@ I.e. accepts the usual &optional and &rest keywords, but every
formal argument can be any pattern accepted by `pcase' (a mere
variable name being but a special case of it)."
(declare (doc-string 2) (indent defun)
- (debug ((&rest pcase-PAT) body)))
+ (debug (&define (&rest pcase-PAT) lambda-doc def-body)))
(let* ((bindings ())
(parsed-body (macroexp-parse-body body))
(args (mapcar (lambda (pat)
@@ -304,7 +304,7 @@ any kind of error."
(declare (indent 1) (debug ((pcase-PAT form) body)))
(if (pcase--trivial-upat-p (car spec))
`(dolist ,spec ,@body)
- (let ((tmpvar (make-symbol "x")))
+ (let ((tmpvar (gensym "x")))
`(dolist (,tmpvar ,@(cdr spec))
(pcase-let* ((,(car spec) ,tmpvar))
,@body)))))
@@ -418,8 +418,8 @@ to this macro."
(when decl (setq body (remove decl body)))
`(progn
(defun ,fsym ,args ,@body)
- (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
- (put ',name 'pcase-macroexpander #',fsym))))
+ (define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
+ (define-symbol-prop ',name 'pcase-macroexpander #',fsym))))
(defun pcase--match (val upat)
"Build a MATCH structure, hoisting all `or's and `and's outside."
@@ -715,7 +715,7 @@ MATCH is the pattern that needs to be matched, of the form:
(call (progn
(when (memq arg vs)
;; `arg' is shadowed by `env'.
- (let ((newsym (make-symbol "x")))
+ (let ((newsym (gensym "x")))
(push (list newsym arg) env)
(setq arg newsym)))
(if (functionp fun)
@@ -842,7 +842,7 @@ Otherwise, it defers to REST which is a list of branches of the form
;; A upat of the form (app FUN PAT)
(pcase--mark-used sym)
(let* ((fun (nth 1 upat))
- (nsym (make-symbol "x"))
+ (nsym (gensym "x"))
(body
;; We don't change `matches' to reuse the newly computed value,
;; because we assume there shouldn't be such redundancy in there.
@@ -930,6 +930,5 @@ QPAT can take the following forms:
((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat)
(t (error "Unknown QPAT: %S" qpat))))
-
(provide 'pcase)
;;; pcase.el ends here
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
index 7ef46a48bde..d9cd37e9ec3 100644
--- a/lisp/emacs-lisp/pp.el
+++ b/lisp/emacs-lisp/pp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el
index b5e7589b951..053dd452ea2 100644
--- a/lisp/emacs-lisp/radix-tree.el
+++ b/lisp/emacs-lisp/radix-tree.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index f60d723a883..84925cb335c 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -64,8 +64,8 @@
;; syntax and string syntax are both delimited by `"'s and behave
;; according to their name. With the `string' syntax there's no need
;; to escape the backslashes and double quotes simplifying the editing
-;; somewhat. The other three allow editing of symbolic regular
-;; expressions supported by the packages of the same name.
+;; somewhat. The `rx' syntax allows editing of symbolic regular
+;; expressions supported by the package of the same name.
;; Editing symbolic expressions is done through a major mode derived
;; from `emacs-lisp-mode' so you'll get all the good stuff like
diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el
index 5feaad88c7b..ef91eb4b979 100644
--- a/lisp/emacs-lisp/regexp-opt.el
+++ b/lisp/emacs-lisp/regexp-opt.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el
index 351dba560f4..9f612a146a6 100644
--- a/lisp/emacs-lisp/regi.el
+++ b/lisp/emacs-lisp/regi.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
index b0ec3bcbe01..69754b05e23 100644
--- a/lisp/emacs-lisp/ring.el
+++ b/lisp/emacs-lisp/ring.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
new file mode 100644
index 00000000000..ca11c596638
--- /dev/null
+++ b/lisp/emacs-lisp/rmc.el
@@ -0,0 +1,201 @@
+;;; rmc.el --- read from a multiple choice question -*- lexical-binding: t -*-
+
+;; Copyright (C) 2016-2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'seq)
+
+;;;###autoload
+(defun read-multiple-choice (prompt choices)
+ "Ask user a multiple choice question.
+PROMPT should be a string that will be displayed as the prompt.
+
+CHOICES is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for
+the entry to be displayed while prompting (if there's room, it
+might be shortened), and the third, optional entry is a longer
+explanation that will be displayed in a help buffer if the user
+requests more help.
+
+This function translates user input into responses by consulting
+the bindings in `query-replace-map'; see the documentation of
+that variable for more information. In this case, the useful
+bindings are `recenter', `scroll-up', and `scroll-down'. If the
+user enters `recenter', `scroll-up', or `scroll-down' responses,
+perform the requested window recentering or scrolling and ask
+again.
+
+When `use-dialog-box' is t (the default), this function can pop
+up a dialog window to collect the user input. That functionality
+requires `display-popup-menus-p' to return t. Otherwise, a text
+dialog will be used.
+
+The return value is the matching entry from the CHOICES list.
+
+Usage example:
+
+\(read-multiple-choice \"Continue connecting?\"
+ \\='((?a \"always\")
+ (?s \"session only\")
+ (?n \"no\")))"
+ (let* ((altered-names nil)
+ (full-prompt
+ (format
+ "%s (%s): "
+ prompt
+ (mapconcat
+ (lambda (elem)
+ (let* ((name (cadr elem))
+ (pos (seq-position name (car elem)))
+ (altered-name
+ (cond
+ ;; Not in the name string.
+ ((not pos)
+ (format "[%c] %s" (car elem) name))
+ ;; The prompt character is in the name, so highlight
+ ;; it on graphical terminals...
+ ((display-supports-face-attributes-p
+ '(:underline t) (window-frame))
+ (setq name (copy-sequence name))
+ (put-text-property pos (1+ pos)
+ 'face 'read-multiple-choice-face
+ name)
+ name)
+ ;; And put it in [bracket] on non-graphical terminals.
+ (t
+ (concat
+ (substring name 0 pos)
+ "["
+ (upcase (substring name pos (1+ pos)))
+ "]"
+ (substring name (1+ pos)))))))
+ (push (cons (car elem) altered-name)
+ altered-names)
+ altered-name))
+ (append choices '((?? "?")))
+ ", ")))
+ tchar buf wrong-char answer)
+ (save-window-excursion
+ (save-excursion
+ (while (not tchar)
+ (message "%s%s"
+ (if wrong-char
+ "Invalid choice. "
+ "")
+ full-prompt)
+ (setq tchar
+ (if (and (display-popup-menus-p)
+ last-input-event ; not during startup
+ (listp last-nonmenu-event)
+ use-dialog-box)
+ (x-popup-dialog
+ t
+ (cons prompt
+ (mapcar
+ (lambda (elem)
+ (cons (capitalize (cadr elem))
+ (car elem)))
+ choices)))
+ (condition-case nil
+ (let ((cursor-in-echo-area t))
+ (read-char))
+ (error nil))))
+ (setq answer (lookup-key query-replace-map (vector tchar) t))
+ (setq tchar
+ (cond
+ ((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)
+ (t tchar)))
+ (when (eq tchar t)
+ (setq wrong-char nil
+ tchar nil))
+ ;; The user has entered an invalid choice, so display the
+ ;; help messages.
+ (when (and (not (eq tchar nil))
+ (not (assq tchar choices)))
+ (setq wrong-char (not (memq tchar '(?? ?\C-h)))
+ tchar nil)
+ (when wrong-char
+ (ding))
+ (with-help-window (setq buf (get-buffer-create
+ "*Multiple Choice Help*"))
+ (with-current-buffer buf
+ (erase-buffer)
+ (pop-to-buffer buf)
+ (insert prompt "\n\n")
+ (let* ((columns (/ (window-width) 25))
+ (fill-column 21)
+ (times 0)
+ (start (point)))
+ (dolist (elem choices)
+ (goto-char start)
+ (unless (zerop times)
+ (if (zerop (mod times columns))
+ ;; Go to the next "line".
+ (goto-char (setq start (point-max)))
+ ;; Add padding.
+ (while (not (eobp))
+ (end-of-line)
+ (insert (make-string (max (- (* (mod times columns)
+ (+ fill-column 4))
+ (current-column))
+ 0)
+ ?\s))
+ (forward-line 1))))
+ (setq times (1+ times))
+ (let ((text
+ (with-temp-buffer
+ (insert (format
+ "%c: %s\n"
+ (car elem)
+ (cdr (assq (car elem) altered-names))))
+ (fill-region (point-min) (point-max))
+ (when (nth 2 elem)
+ (let ((start (point)))
+ (insert (nth 2 elem))
+ (unless (bolp)
+ (insert "\n"))
+ (fill-region start (point-max))))
+ (buffer-string))))
+ (goto-char start)
+ (dolist (line (split-string text "\n"))
+ (end-of-line)
+ (if (bolp)
+ (insert line "\n")
+ (insert line))
+ (forward-line 1)))))))))))
+ (when (buffer-live-p buf)
+ (kill-buffer buf))
+ (assq tchar choices)))
+
+(provide 'rmc)
+
+;;; rmc.el ends here
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 386232c6eef..54755a7dc12 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1169,6 +1169,62 @@ enclosed in `(and ...)'.
(rx-to-string `(and ,@regexps) t))
(t
(rx-to-string (car regexps) t))))
+
+
+(pcase-defmacro rx (&rest regexps)
+ "Build a `pcase' pattern matching `rx' regexps.
+The REGEXPS are interpreted as by `rx'. The pattern matches if
+the regular expression so constructed matches the object, as if
+by `string-match'.
+
+In addition to the usual `rx' constructs, REGEXPS can contain the
+following constructs:
+
+ (let VAR FORM...) creates a new explicitly numbered submatch
+ that matches FORM and binds the match to
+ VAR.
+ (backref VAR) creates a backreference to the submatch
+ introduced by a previous (let VAR ...)
+ construct.
+
+The VARs are associated with explicitly numbered submatches
+starting from 1. Multiple occurrences of the same VAR refer to
+the same submatch.
+
+If a case matches, the match data is modified as usual so you can
+use it in the case body, but you still have to pass the correct
+string as argument to `match-string'."
+ (let* ((vars ())
+ (rx-constituents
+ `((let
+ ,(lambda (form)
+ (rx-check form)
+ (let ((var (cadr form)))
+ (cl-check-type var symbol)
+ (let ((i (or (cl-position var vars :test #'eq)
+ (prog1 (length vars)
+ (setq vars `(,@vars ,var))))))
+ (rx-form `(submatch-n ,(1+ i) ,@(cddr form))))))
+ 1 nil)
+ (backref
+ ,(lambda (form)
+ (rx-check form)
+ (rx-backref
+ `(backref ,(let ((var (cadr form)))
+ (if (integerp var) var
+ (1+ (cl-position var vars :test #'eq)))))))
+ 1 1
+ ,(lambda (var)
+ (cond ((integerp var) (rx-check-backref var))
+ ((memq var vars) t)
+ (t (error "rx `backref' variable must be one of %s: %s"
+ vars var)))))
+ ,@rx-constituents))
+ (regexp (rx-to-string `(seq ,@regexps) :no-group)))
+ `(and (pred (string-match ,regexp))
+ ,@(cl-loop for i from 1
+ for var in vars
+ collect `(app (match-string ,i) ,var)))))
;; ;; sregex.el replacement
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 23e444fe241..2861ed75ce7 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
index df586486d32..103e131ea39 100644
--- a/lisp/emacs-lisp/shadow.el
+++ b/lisp/emacs-lisp/shadow.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 7baccbc7524..da1e12b1408 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -18,7 +18,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1956,7 +1956,7 @@ E.g. provided via a file-local call to `smie-config-local'.")
(defvar smie-config--modefuns nil)
(defun smie-config--setter (var value)
- (setq-default var value)
+ (set-default var value)
(let ((old-modefuns smie-config--modefuns))
(setq smie-config--modefuns nil)
(pcase-dolist (`(,mode . ,rules) value)
@@ -1982,7 +1982,7 @@ value with which to replace it."
;; FIXME improve value-type.
:type '(choice (const nil)
(alist :key-type symbol))
- :initialize 'custom-initialize-default
+ :initialize 'custom-initialize-set
:set #'smie-config--setter)
(defun smie-config-local (rules)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 849ac19d6a5..37bcfc2003d 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,7 +28,7 @@
;; in subr.el.
;; Do not document these functions in the lispref.
-;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01006.html
+;; https://lists.gnu.org/r/emacs-devel/2014-01/msg01006.html
;; NB If you want to use this library, it's almost always correct to use:
;; (eval-when-compile (require 'subr-x))
@@ -83,10 +83,13 @@ threading."
`(internal--thread-argument nil ,@forms))
(defsubst internal--listify (elt)
- "Wrap ELT in a list if it is not one."
- (if (not (listp elt))
- (list elt)
- elt))
+ "Wrap ELT in a list if it is not one.
+If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol."
+ (cond
+ ((symbolp elt) (list elt elt))
+ ((null (cdr elt))
+ (list (make-symbol "s") (car elt)))
+ (t elt)))
(defsubst internal--check-binding (binding)
"Check BINDING is properly formed."
@@ -98,7 +101,8 @@ threading."
(defsubst internal--build-binding-value-form (binding prev-var)
"Build the conditional value form for BINDING using PREV-VAR."
- `(,(car binding) (and ,prev-var ,(cadr binding))))
+ (let ((var (car binding)))
+ `(,var (and ,prev-var ,(cadr binding)))))
(defun internal--build-binding (binding prev-var)
"Check and build a single BINDING with PREV-VAR."
@@ -117,44 +121,71 @@ threading."
binding))
bindings)))
-(defmacro if-let* (bindings then &rest else)
+(defmacro if-let* (varlist then &rest else)
"Bind variables according to VARLIST and eval THEN or ELSE.
-Each binding is evaluated in turn with `let*', and evaluation
-stops if a binding value is nil. If all are non-nil, the value
-of THEN is returned, or the last form in ELSE is returned.
-Each element of VARLIST is a symbol (which is bound to nil)
-or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
-In the special case you only want to bind a single value,
-VARLIST can just be a plain tuple.
-\n(fn VARLIST THEN ELSE...)"
+Each binding is evaluated in turn, and evaluation stops if a
+binding value is nil. If all are non-nil, the value of THEN is
+returned, or the last form in ELSE is returned.
+
+Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
+SYMBOL to the value of VALUEFORM. An element can additionally
+be of the form (VALUEFORM), which is evaluated and checked for
+nil; i.e. SYMBOL can be omitted if only the test result is of
+interest."
(declare (indent 2)
- (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)]
+ (debug ((&rest [&or symbolp (symbolp form) (form)])
form body)))
- (when (and (<= (length bindings) 2)
- (not (listp (car bindings))))
- ;; Adjust the single binding case
- (setq bindings (list bindings)))
- `(let* ,(internal--build-bindings bindings)
- (if ,(car (internal--listify (car (last bindings))))
- ,then
- ,@else)))
+ (if varlist
+ `(let* ,(setq varlist (internal--build-bindings varlist))
+ (if ,(caar (last varlist))
+ ,then
+ ,@else))
+ `(let* () ,then)))
+
+(defmacro when-let* (varlist &rest body)
+ "Bind variables according to VARLIST and conditionally eval BODY.
+Each binding is evaluated in turn, and evaluation stops if a
+binding value is nil. If all are non-nil, the value of the last
+form in BODY is returned.
-(defmacro when-let* (bindings &rest body)
+VARLIST is the same as in `if-let*'."
+ (declare (indent 1) (debug if-let*))
+ (list 'if-let* varlist (macroexp-progn body)))
+
+(defmacro and-let* (varlist &rest body)
"Bind variables according to VARLIST and conditionally eval BODY.
-Each binding is evaluated in turn with `let*', and evaluation
-stops if a binding value is nil. If all are non-nil, the value
-of the last form in BODY is returned.
-Each element of VARLIST is a symbol (which is bound to nil)
-or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).
-In the special case you only want to bind a single value,
-VARLIST can just be a plain tuple.
-\n(fn VARLIST BODY...)"
- (declare (indent 1) (debug if-let))
- (list 'if-let bindings (macroexp-progn body)))
-
-(defalias 'if-let 'if-let*)
-(defalias 'when-let 'when-let*)
-(defalias 'and-let* 'when-let*)
+Like `when-let*', except if BODY is empty and all the bindings
+are non-nil, then the result is non-nil."
+ (declare (indent 1)
+ (debug ((&rest [&or symbolp (symbolp form) (form)])
+ body)))
+ (let (res)
+ (if varlist
+ `(let* ,(setq varlist (internal--build-bindings varlist))
+ (if ,(setq res (caar (last varlist)))
+ ,@(or body `(,res))))
+ `(let* () ,@(or body '(t))))))
+
+(defmacro if-let (spec then &rest else)
+ "Bind variables according to SPEC and eval THEN or ELSE.
+Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
+ (declare (indent 2)
+ (debug ([&or (&rest [&or symbolp (symbolp form) (form)])
+ (symbolp form)]
+ form body))
+ (obsolete "use `if-let*' instead." "26.1"))
+ (when (and (<= (length spec) 2)
+ (not (listp (car spec))))
+ ;; Adjust the single binding case
+ (setq spec (list spec)))
+ (list 'if-let* spec then (macroexp-progn else)))
+
+(defmacro when-let (spec &rest body)
+ "Bind variables according to SPEC and conditionally eval BODY.
+Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)."
+ (declare (indent 1) (debug if-let)
+ (obsolete "use `when-let*' instead." "26.1"))
+ (list 'if-let spec (macroexp-progn body)))
(defsubst hash-table-empty-p (hash-table)
"Check whether HASH-TABLE is empty (has 0 elements)."
@@ -216,176 +247,6 @@ TRIM-LEFT and TRIM-RIGHT default to \"[ \\t\\n\\r]+\"."
(substring string 0 (- (length string) (length suffix)))
string))
-(defun read-multiple-choice (prompt choices)
- "Ask user a multiple choice question.
-PROMPT should be a string that will be displayed as the prompt.
-
-CHOICES is an alist where the first element in each entry is a
-character to be entered, the second element is a short name for
-the entry to be displayed while prompting (if there's room, it
-might be shortened), and the third, optional entry is a longer
-explanation that will be displayed in a help buffer if the user
-requests more help.
-
-This function translates user input into responses by consulting
-the bindings in `query-replace-map'; see the documentation of
-that variable for more information. In this case, the useful
-bindings are `recenter', `scroll-up', and `scroll-down'. If the
-user enters `recenter', `scroll-up', or `scroll-down' responses,
-perform the requested window recentering or scrolling and ask
-again.
-
-When `use-dialog-box' is t (the default), this function can pop
-up a dialog window to collect the user input. That functionality
-requires `display-popup-menus-p' to return t. Otherwise, a text
-dialog will be used.
-
-The return value is the matching entry from the CHOICES list.
-
-Usage example:
-
-\(read-multiple-choice \"Continue connecting?\"
- \\='((?a \"always\")
- (?s \"session only\")
- (?n \"no\")))"
- (let* ((altered-names nil)
- (full-prompt
- (format
- "%s (%s): "
- prompt
- (mapconcat
- (lambda (elem)
- (let* ((name (cadr elem))
- (pos (seq-position name (car elem)))
- (altered-name
- (cond
- ;; Not in the name string.
- ((not pos)
- (format "[%c] %s" (car elem) name))
- ;; The prompt character is in the name, so highlight
- ;; it on graphical terminals...
- ((display-supports-face-attributes-p
- '(:underline t) (window-frame))
- (setq name (copy-sequence name))
- (put-text-property pos (1+ pos)
- 'face 'read-multiple-choice-face
- name)
- name)
- ;; And put it in [bracket] on non-graphical terminals.
- (t
- (concat
- (substring name 0 pos)
- "["
- (upcase (substring name pos (1+ pos)))
- "]"
- (substring name (1+ pos)))))))
- (push (cons (car elem) altered-name)
- altered-names)
- altered-name))
- (append choices '((?? "?")))
- ", ")))
- tchar buf wrong-char answer)
- (save-window-excursion
- (save-excursion
- (while (not tchar)
- (message "%s%s"
- (if wrong-char
- "Invalid choice. "
- "")
- full-prompt)
- (setq tchar
- (if (and (display-popup-menus-p)
- last-input-event ; not during startup
- (listp last-nonmenu-event)
- use-dialog-box)
- (x-popup-dialog
- t
- (cons prompt
- (mapcar
- (lambda (elem)
- (cons (capitalize (cadr elem))
- (car elem)))
- choices)))
- (condition-case nil
- (let ((cursor-in-echo-area t))
- (read-char))
- (error nil))))
- (setq answer (lookup-key query-replace-map (vector tchar) t))
- (setq tchar
- (cond
- ((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)
- (t tchar)))
- (when (eq tchar t)
- (setq wrong-char nil
- tchar nil))
- ;; The user has entered an invalid choice, so display the
- ;; help messages.
- (when (and (not (eq tchar nil))
- (not (assq tchar choices)))
- (setq wrong-char (not (memq tchar '(?? ?\C-h)))
- tchar nil)
- (when wrong-char
- (ding))
- (with-help-window (setq buf (get-buffer-create
- "*Multiple Choice Help*"))
- (with-current-buffer buf
- (erase-buffer)
- (pop-to-buffer buf)
- (insert prompt "\n\n")
- (let* ((columns (/ (window-width) 25))
- (fill-column 21)
- (times 0)
- (start (point)))
- (dolist (elem choices)
- (goto-char start)
- (unless (zerop times)
- (if (zerop (mod times columns))
- ;; Go to the next "line".
- (goto-char (setq start (point-max)))
- ;; Add padding.
- (while (not (eobp))
- (end-of-line)
- (insert (make-string (max (- (* (mod times columns)
- (+ fill-column 4))
- (current-column))
- 0)
- ?\s))
- (forward-line 1))))
- (setq times (1+ times))
- (let ((text
- (with-temp-buffer
- (insert (format
- "%c: %s\n"
- (car elem)
- (cdr (assq (car elem) altered-names))))
- (fill-region (point-min) (point-max))
- (when (nth 2 elem)
- (let ((start (point)))
- (insert (nth 2 elem))
- (unless (bolp)
- (insert "\n"))
- (fill-region start (point-max))))
- (buffer-string))))
- (goto-char start)
- (dolist (line (split-string text "\n"))
- (end-of-line)
- (if (bolp)
- (insert line "\n")
- (insert line))
- (forward-line 1)))))))))))
- (when (buffer-live-p buf)
- (kill-buffer buf))
- (assq tchar choices)))
-
(provide 'subr-x)
;;; subr-x.el ends here
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index d1d5176944c..9eb6bde7454 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -381,10 +381,26 @@ This function should move the cursor back to some syntactically safe
point (where the PPSS is equivalent to nil).")
(make-obsolete-variable 'syntax-begin-function nil "25.1")
-(defvar-local syntax-ppss-cache nil
- "List of (POS . PPSS) pairs, in decreasing POS order.")
-(defvar-local syntax-ppss-last nil
- "Cache of (LAST-POS . LAST-PPSS).")
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Several caches.
+;;
+;; Because `syntax-ppss' is equivalent to (parse-partial-sexp
+;; (POINT-MIN) x), we need either to empty the cache when we narrow
+;; the buffer, which is suboptimal, or we need to use several caches.
+;; We use two of them, one for widened buffer, and one for narrowing.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar-local syntax-ppss-wide nil
+ "Cons of two elements (LAST . CACHE).
+Where LAST is a pair (LAST-POS . LAST-PPS) caching the last invocation
+and CACHE is a list of (POS . PPSS) pairs, in decreasing POS order.
+These are valid when the buffer has no restriction.")
+
+(defvar-local syntax-ppss-narrow nil
+ "Same as `syntax-ppss-wide' but for a narrowed buffer.")
+
+(defvar-local syntax-ppss-narrow-start nil
+ "Start position of the narrowing for `syntax-ppss-narrow'.")
(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
(defun syntax-ppss-flush-cache (beg &rest ignored)
@@ -392,24 +408,29 @@ point (where the PPSS is equivalent to nil).")
;; Set syntax-propertize to refontify anything past beg.
(setq syntax-propertize--done (min beg syntax-propertize--done))
;; Flush invalid cache entries.
- (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg))
- (setq syntax-ppss-cache (cdr syntax-ppss-cache)))
- ;; Throw away `last' value if made invalid.
- (when (< beg (or (car syntax-ppss-last) 0))
- ;; If syntax-begin-function jumped to BEG, then the old state at BEG can
- ;; depend on the text after BEG (which is presumably changed). So if
- ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the
- ;; assumed nil state at BEG may not be valid any more.
- (if (<= beg (or (syntax-ppss-toplevel-pos (cdr syntax-ppss-last))
- (nth 3 syntax-ppss-last)
- 0))
- (setq syntax-ppss-last nil)
- (setcar syntax-ppss-last nil)))
- ;; Unregister if there's no cache left. Sadly this doesn't work
- ;; because `before-change-functions' is temporarily bound to nil here.
- ;; (unless syntax-ppss-cache
- ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
- )
+ (dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
+ (pcase cell
+ (`(,last . ,cache)
+ (while (and cache (> (caar cache) beg))
+ (setq cache (cdr cache)))
+ ;; Throw away `last' value if made invalid.
+ (when (< beg (or (car last) 0))
+ ;; If syntax-begin-function jumped to BEG, then the old state at BEG can
+ ;; depend on the text after BEG (which is presumably changed). So if
+ ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the
+ ;; assumed nil state at BEG may not be valid any more.
+ (if (<= beg (or (syntax-ppss-toplevel-pos (cdr last))
+ (nth 3 last)
+ 0))
+ (setq last nil)
+ (setcar last nil)))
+ ;; Unregister if there's no cache left. Sadly this doesn't work
+ ;; because `before-change-functions' is temporarily bound to nil here.
+ ;; (unless cache
+ ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
+ (setcar cell last)
+ (setcdr cell cache)))
+ ))
(defvar syntax-ppss-stats
[(0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (1 . 2500.0)])
@@ -423,6 +444,17 @@ point (where the PPSS is equivalent to nil).")
(defvar-local syntax-ppss-table nil
"Syntax-table to use during `syntax-ppss', if any.")
+(defun syntax-ppss--data ()
+ (if (eq (point-min) 1)
+ (progn
+ (unless syntax-ppss-wide
+ (setq syntax-ppss-wide (cons nil nil)))
+ syntax-ppss-wide)
+ (unless (eq syntax-ppss-narrow-start (point-min))
+ (setq syntax-ppss-narrow-start (point-min))
+ (setq syntax-ppss-narrow (cons nil nil)))
+ syntax-ppss-narrow))
+
(defun syntax-ppss (&optional pos)
"Parse-Partial-Sexp State at POS, defaulting to point.
The returned value is the same as that of `parse-partial-sexp'
@@ -439,10 +471,13 @@ running the hook."
(syntax-propertize pos)
;;
(with-syntax-table (or syntax-ppss-table (syntax-table))
- (let ((old-ppss (cdr syntax-ppss-last))
- (old-pos (car syntax-ppss-last))
- (ppss nil)
- (pt-min (point-min)))
+ (let* ((cell (syntax-ppss--data))
+ (ppss-last (car cell))
+ (ppss-cache (cdr cell))
+ (old-ppss (cdr ppss-last))
+ (old-pos (car ppss-last))
+ (ppss nil)
+ (pt-min (point-min)))
(if (and old-pos (> old-pos pos)) (setq old-pos nil))
;; Use the OLD-POS if usable and close. Don't update the `last' cache.
(condition-case nil
@@ -475,7 +510,7 @@ running the hook."
;; The OLD-* data can't be used. Consult the cache.
(t
(let ((cache-pred nil)
- (cache syntax-ppss-cache)
+ (cache ppss-cache)
(pt-min (point-min))
;; I differentiate between PT-MIN and PT-BEST because
;; I feel like it might be important to ensure that the
@@ -491,7 +526,7 @@ running the hook."
(if cache (setq pt-min (caar cache) ppss (cdar cache)))
;; Setup the before-change function if necessary.
- (unless (or syntax-ppss-cache syntax-ppss-last)
+ (unless (or ppss-cache ppss-last)
(add-hook 'before-change-functions
'syntax-ppss-flush-cache t t))
@@ -541,7 +576,7 @@ running the hook."
pt-min (setq pt-min (/ (+ pt-min pos) 2))
nil nil ppss))
(push (cons pt-min ppss)
- (if cache-pred (cdr cache-pred) syntax-ppss-cache)))
+ (if cache-pred (cdr cache-pred) ppss-cache)))
;; Compute the actual return value.
(setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
@@ -562,13 +597,15 @@ running the hook."
(if (> (- (caar cache-pred) pos) syntax-ppss-max-span)
(push pair (cdr cache-pred))
(setcar cache-pred pair))
- (if (or (null syntax-ppss-cache)
- (> (- (caar syntax-ppss-cache) pos)
+ (if (or (null ppss-cache)
+ (> (- (caar ppss-cache) pos)
syntax-ppss-max-span))
- (push pair syntax-ppss-cache)
- (setcar syntax-ppss-cache pair)))))))))
+ (push pair ppss-cache)
+ (setcar ppss-cache pair)))))))))
- (setq syntax-ppss-last (cons pos ppss))
+ (setq ppss-last (cons pos ppss))
+ (setcar cell ppss-last)
+ (setcdr cell ppss-cache)
ppss)
(args-out-of-range
;; If the buffer is more narrowed than when we built the cache,
@@ -582,7 +619,7 @@ running the hook."
(defun syntax-ppss-debug ()
(let ((pt nil)
(min-diffs nil))
- (dolist (x (append syntax-ppss-cache (list (cons (point-min) nil))))
+ (dolist (x (append (cdr (syntax-ppss--data)) (list (cons (point-min) nil))))
(when pt (push (- pt (car x)) min-diffs))
(setq pt (car x)))
min-diffs))
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index b6b49b1bfa2..3889ba8e587 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -186,14 +186,29 @@ If ADVANCE is non-nil, move forward by one line afterwards."
Populated by `tabulated-list-init-header'.")
(defvar tabulated-list--header-overlay nil)
+(defun tabulated-list-line-number-width ()
+ "Return the width taken by display-line-numbers in the current buffer."
+ ;; line-number-display-width returns the value for the selected
+ ;; window, which might not be the window in which the current buffer
+ ;; is displayed.
+ (if (not display-line-numbers)
+ 0
+ (let ((cbuf-window (get-buffer-window (current-buffer) t)))
+ (if (window-live-p cbuf-window)
+ (with-selected-window cbuf-window
+ (line-number-display-width 'columns))
+ 4))))
+
(defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer."
;; 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 highlight
+ mouse-face header-line-highlight
keymap ,tabulated-list-sort-button-map))
(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))
(let* ((col (aref tabulated-list-format n))
@@ -368,7 +383,7 @@ changing `tabulated-list-sort-key'."
(equal entry-id id)
(setq entry-id nil
saved-pt (point)))
- ;; If the buffer this empty, simply print each elt.
+ ;; If the buffer is empty, simply print each elt.
(if (or (not update) (eobp))
(apply tabulated-list-printer elt)
(while (let ((local-id (tabulated-list-get-id)))
@@ -582,6 +597,23 @@ With a numeric prefix argument N, sort the Nth column."
(tabulated-list-init-header)
(tabulated-list-print t)))
+(defvar tabulated-list--current-lnum-width nil)
+(defun tabulated-list-watch-line-number-width (_window)
+ (if display-line-numbers
+ (let ((lnum-width (tabulated-list-line-number-width)))
+ (when (not (= tabulated-list--current-lnum-width lnum-width))
+ (setq-local tabulated-list--current-lnum-width lnum-width)
+ (tabulated-list-init-header)))))
+
+(defun tabulated-list-window-scroll-function (window _start)
+ (if display-line-numbers
+ (let ((lnum-width
+ (with-selected-window window
+ (line-number-display-width 'columns))))
+ (when (not (= tabulated-list--current-lnum-width lnum-width))
+ (setq-local tabulated-list--current-lnum-width lnum-width)
+ (tabulated-list-init-header)))))
+
;;; The mode definition:
(define-derived-mode tabulated-list-mode special-mode "Tabulated"
@@ -624,7 +656,16 @@ as the ewoc pretty-printer."
(setq-local glyphless-char-display tabulated-list-glyphless-char-display)
;; 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))
+ (setq bidi-paragraph-direction 'left-to-right)
+ ;; This is for if/when they turn on display-line-numbers
+ (add-hook 'display-line-numbers-mode-hook #'tabulated-list-revert nil t)
+ ;; This is for if/when they customize the line-number face or when
+ ;; the line-number width needs to change due to scrolling.
+ (setq-local tabulated-list--current-lnum-width 0)
+ (add-hook 'pre-redisplay-functions
+ #'tabulated-list-watch-line-number-width nil t)
+ (add-hook 'window-scroll-functions
+ #'tabulated-list-window-scroll-function nil t))
(put 'tabulated-list-mode 'mode-class 'special)
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index efcaeedd117..7e4beb6743e 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(require 'testcover)
diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el
index f9bf9a4c734..69ae175eff7 100644
--- a/lisp/emacs-lisp/tcover-unsafep.el
+++ b/lisp/emacs-lisp/tcover-unsafep.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(require 'testcover)
diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el
index 433ad38a147..797cc682171 100644
--- a/lisp/emacs-lisp/testcover.el
+++ b/lisp/emacs-lisp/testcover.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -33,7 +33,9 @@
;; that has a splotch.
;; * Basic algorithm: use `edebug' to mark up the function text with
-;; instrumentation callbacks, then replace edebug's callbacks with ours.
+;; instrumentation callbacks, walk the instrumented code looking for
+;; forms which don't return or always return the same value, then use
+;; Edebug's before and after hooks to replace its code coverage with ours.
;; * To show good coverage, we want to see two values for every form, except
;; functions that always return the same value and `defconst' variables
;; need show only one value for good coverage. To avoid the brown
@@ -47,11 +49,10 @@
;; function being called is capable of returning in other cases.
;; Problems:
-;; * To detect different values, we store the form's result in a vector and
-;; compare the next result using `equal'. We don't copy the form's
-;; result, so if caller alters it (`setcar', etc.) we'll think the next
-;; call has the same value! Also, equal thinks two strings are the same
-;; if they differ only in properties.
+;; * `equal', which is used to compare the results of repeatedly executing
+;; a form, has a couple of shortcomings. It considers strings to be the same
+;; if they only differ in properties, and it raises an error when asked to
+;; compare circular lists.
;; * Because we have only a "1value" class and no "always nil" class, we have
;; to treat as potentially 1-valued any `and' whose last term is 1-valued,
;; in case the last term is always nil. Example:
@@ -89,16 +90,14 @@ these. This list is quite incomplete!"
buffer-disable-undo buffer-enable-undo current-global-map
deactivate-mark delete-backward-char delete-char delete-region ding
forward-char function* insert insert-and-inherit kill-all-local-variables
- kill-line kill-paragraph kill-region kill-sexp lambda
+ kill-line kill-paragraph kill-region kill-sexp
minibuffer-complete-and-exit narrow-to-region next-line push-mark
put-text-property run-hooks set-match-data signal
substitute-key-definition suppress-keymap undo use-local-map while widen
yank)
- "Functions that always return the same value. No brown splotch is shown
-for these. This list is quite incomplete! Notes: Nobody ever changes the
-current global map. The macro `lambda' is self-evaluating, hence always
-returns the same value (the function it defines may return varying values
-when called)."
+ "Functions that always return the same value, according to `equal'.
+No brown splotch is shown for these. This list is quite
+incomplete! Notes: Nobody ever changes the current global map."
:group 'testcover
:type '(repeat symbol))
@@ -111,7 +110,7 @@ them as having returned nil just before calling them."
(defcustom testcover-compose-functions
'(+ - * / = append length list make-keymap make-sparse-keymap
- mapcar message propertize replace-regexp-in-string
+ message propertize replace-regexp-in-string
run-with-idle-timer set-buffer-modified-p)
"Functions that are 1-valued if all their args are either constants or
calls to one of the `testcover-1value-functions', so if that's true then no
@@ -186,19 +185,18 @@ call to one of the `testcover-1value-functions'."
;;;###autoload
(defun testcover-start (filename &optional byte-compile)
- "Uses edebug to instrument all macros and functions in FILENAME, then
-changes the instrumentation from edebug to testcover--much faster, no
-problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is
-non-nil, byte-compiles each function after instrumenting."
+ "Use Edebug to instrument for coverage all macros and functions in FILENAME.
+If BYTE-COMPILE is non-nil, byte compile each function after instrumenting."
(interactive "fStart covering file: ")
- (let ((buf (find-file filename))
- (load-read-function load-read-function))
- (add-function :around load-read-function
- #'testcover--read)
- (setq edebug-form-data nil
- testcover-module-constants nil
- testcover-module-1value-functions nil)
- (eval-buffer buf))
+ (let ((buf (find-file filename)))
+ (setq edebug-form-data nil
+ testcover-module-constants nil
+ testcover-module-1value-functions nil
+ testcover-module-potentially-1value-functions nil)
+ (let ((edebug-all-defs t)
+ (edebug-after-instrumentation-function #'testcover-after-instrumentation)
+ (edebug-new-definition-function #'testcover-init-definition))
+ (eval-buffer buf)))
(when byte-compile
(dolist (x (reverse edebug-form-data))
(when (fboundp (car x))
@@ -209,229 +207,10 @@ non-nil, byte-compiles each function after instrumenting."
(defun testcover-this-defun ()
"Start coverage on function under point."
(interactive)
- (let ((x (let ((edebug-all-defs t))
- (symbol-function (eval-defun nil)))))
- (testcover-reinstrument x)
- x))
-
-(defun testcover--read (orig &optional stream)
- "Read a form using edebug, changing edebug callbacks to testcover callbacks."
- (or stream (setq stream standard-input))
- (if (eq stream (current-buffer))
- (let ((x (let ((edebug-all-defs t))
- (edebug-read-and-maybe-wrap-form))))
- (testcover-reinstrument x)
- x)
- (funcall (or orig #'read) stream)))
-
-(defun testcover-reinstrument (form)
- "Reinstruments FORM to use testcover instead of edebug. This
-function modifies the list that FORM points to. Result is nil if
-FORM should return multiple values, t if should always return same
-value, `maybe' if either is acceptable."
- (let ((fun (car-safe form))
- id val)
- (cond
- ((not fun) ;Atom
- (when (or (not (symbolp form))
- (memq form testcover-constants)
- (memq form testcover-module-constants))
- t))
- ((consp fun) ;Embedded list
- (testcover-reinstrument fun)
- (testcover-reinstrument-list (cdr form))
- nil)
- ((or (memq fun testcover-1value-functions)
- (memq fun testcover-module-1value-functions))
- ;;Should always return same value
- (testcover-reinstrument-list (cdr form))
- t)
- ((or (memq fun testcover-potentially-1value-functions)
- (memq fun testcover-module-potentially-1value-functions))
- ;;Might always return same value
- (testcover-reinstrument-list (cdr form))
- 'maybe)
- ((memq fun testcover-progn-functions)
- ;;1-valued if last argument is
- (testcover-reinstrument-list (cdr form)))
- ((memq fun testcover-prog1-functions)
- ;;1-valued if first argument is
- (testcover-reinstrument-list (cddr form))
- (testcover-reinstrument (cadr form)))
- ((memq fun testcover-compose-functions)
- ;;1-valued if all arguments are. Potentially 1-valued if all
- ;;arguments are either definitely or potentially.
- (testcover-reinstrument-compose (cdr form) 'testcover-reinstrument))
- ((eq fun 'edebug-enter)
- ;;(edebug-enter 'SYM ARGS #'(lambda nil FORMS))
- ;; => (testcover-enter 'SYM #'(lambda nil FORMS))
- (setcar form 'testcover-enter)
- (setcdr (nthcdr 1 form) (nthcdr 3 form))
- (let ((testcover-vector (get (cadr (cadr form)) 'edebug-coverage)))
- (testcover-reinstrument-list (nthcdr 2 (cadr (nth 2 form))))))
- ((eq fun 'edebug-after)
- ;;(edebug-after (edebug-before XXX) YYY FORM)
- ;; => (testcover-after YYY FORM), mark XXX as ok-coverage
- (unless (eq (cadr form) 0)
- (aset testcover-vector (cadr (cadr form)) 'ok-coverage))
- (setq id (nth 2 form))
- (setcdr form (nthcdr 2 form))
- (setq val (testcover-reinstrument (nth 2 form)))
- (setcar form (if (eq val t)
- 'testcover-1value
- 'testcover-after))
- (when val
- ;;1-valued or potentially 1-valued
- (aset testcover-vector id '1value))
- (cond
- ((memq (car-safe (nth 2 form)) testcover-noreturn-functions)
- ;;This function won't return, so set the value in advance
- ;;(edebug-after (edebug-before XXX) YYY FORM)
- ;; => (progn (edebug-after YYY nil) FORM)
- (setcar (cdr form) `(,(car form) ,id nil))
- (setcar form 'progn)
- (aset testcover-vector id '1value)
- (setq val t))
- ((eq (car-safe (nth 2 form)) '1value)
- ;;This function is always supposed to return the same value
- (setq val t)
- (aset testcover-vector id '1value)
- (setcar form 'testcover-1value)))
- val)
- ((eq fun 'defun)
- (setq val (testcover-reinstrument-list (nthcdr 3 form)))
- (when (eq val t)
- (push (cadr form) testcover-module-1value-functions))
- (when (eq val 'maybe)
- (push (cadr form) testcover-module-potentially-1value-functions)))
- ((memq fun '(defconst defcustom))
- ;;Define this symbol as 1-valued
- (push (cadr form) testcover-module-constants)
- (testcover-reinstrument-list (cddr form)))
- ((memq fun '(dotimes dolist))
- ;;Always returns third value from SPEC
- (testcover-reinstrument-list (cddr form))
- (setq val (testcover-reinstrument-list (cadr form)))
- (if (nth 2 (cadr form))
- val
- ;;No third value, always returns nil
- t))
- ((memq fun '(let let*))
- ;;Special parsing for second argument
- (mapc 'testcover-reinstrument-list (cadr form))
- (testcover-reinstrument-list (cddr form)))
- ((eq fun 'if)
- ;;Potentially 1-valued if both THEN and ELSE clauses are
- (testcover-reinstrument (cadr form))
- (let ((then (testcover-reinstrument (nth 2 form)))
- (else (testcover-reinstrument-list (nthcdr 3 form))))
- (and then else 'maybe)))
- ((eq fun 'cond)
- ;;Potentially 1-valued if all clauses are
- (when (testcover-reinstrument-compose (cdr form)
- 'testcover-reinstrument-list)
- 'maybe))
- ((eq fun 'condition-case)
- ;;Potentially 1-valued if BODYFORM is and all HANDLERS are
- (let ((body (testcover-reinstrument (nth 2 form)))
- (errs (testcover-reinstrument-compose
- (mapcar #'cdr (nthcdr 3 form))
- 'testcover-reinstrument-list)))
- (and body errs 'maybe)))
- ((eq fun 'quote)
- ;;Don't reinstrument what's inside!
- ;;This doesn't apply within a backquote
- t)
- ((eq fun '\`)
- ;;Quotes are not special within backquotes
- (let ((testcover-1value-functions
- (cons 'quote testcover-1value-functions)))
- (testcover-reinstrument (cadr form))))
- ((eq fun '\,)
- ;;In commas inside backquotes, quotes are special again
- (let ((testcover-1value-functions
- (remq 'quote testcover-1value-functions)))
- (testcover-reinstrument (cadr form))))
- ((eq fun '1value)
- ;;Hack - pretend the arg is 1-valued here
- (cond
- ((symbolp (cadr form))
- ;;A pseudoconstant variable
- t)
- ((and (eq (car (cadr form)) 'edebug-after)
- (symbolp (nth 3 (cadr form))))
- ;;Reference to pseudoconstant
- (aset testcover-vector (nth 2 (cadr form)) '1value)
- (setcar (cdr form) `(testcover-1value ,(nth 2 (cadr form))
- ,(nth 3 (cadr form))))
- t)
- (t
- (setq id (car (if (eq (car (cadr form)) 'edebug-after)
- (nth 3 (cadr form))
- (cadr form))))
- (let ((testcover-1value-functions
- (cons id testcover-1value-functions)))
- (testcover-reinstrument (cadr form))))))
- ((eq fun 'noreturn)
- ;;Hack - pretend the arg has no return
- (cond
- ((symbolp (cadr form))
- ;;A pseudoconstant variable
- 'maybe)
- ((and (eq (car (cadr form)) 'edebug-after)
- (symbolp (nth 3 (cadr form))))
- ;;Reference to pseudoconstant
- (aset testcover-vector (nth 2 (cadr form)) '1value)
- (setcar (cdr form) `(progn (testcover-after ,(nth 2 (cadr form)) nil)
- ,(nth 3 (cadr form))))
- 'maybe)
- (t
- (setq id (car (if (eq (car (cadr form)) 'edebug-after)
- (nth 3 (cadr form))
- (cadr form))))
- (let ((testcover-noreturn-functions
- (cons id testcover-noreturn-functions)))
- (testcover-reinstrument (cadr form))))))
- ((and (eq fun 'apply)
- (eq (car-safe (cadr form)) 'quote)
- (symbolp (cadr (cadr form))))
- ;;Apply of a constant symbol. Process as 1value or noreturn
- ;;depending on symbol.
- (setq fun (cons (cadr (cadr form)) (cddr form))
- val (testcover-reinstrument fun))
- (setcdr (cdr form) (cdr fun))
- val)
- (t ;Some other function or weird thing
- (testcover-reinstrument-list (cdr form))
- nil))))
-
-(defun testcover-reinstrument-list (list)
- "Reinstruments each form in LIST to use testcover instead of edebug.
-This function modifies the forms in LIST. Result is `testcover-reinstrument's
-value for the last form in LIST. If the LIST is empty, its evaluation will
-always be nil, so we return t for 1-valued."
- (let ((result t))
- (while (consp list)
- (setq result (testcover-reinstrument (pop list))))
- result))
-
-(defun testcover-reinstrument-compose (list fun)
- "For a compositional function, the result is 1-valued if all
-arguments are, potentially 1-valued if all arguments are either
-definitely or potentially 1-valued, and multi-valued otherwise.
-FUN should be `testcover-reinstrument' for compositional functions,
- `testcover-reinstrument-list' for clauses in a `cond'."
- (let ((result t))
- (mapc #'(lambda (x)
- (setq x (funcall fun x))
- (cond
- ((eq result t)
- (setq result x))
- ((eq result 'maybe)
- (when (not x)
- (setq result nil)))))
- list)
- result))
+ (let ((edebug-all-defs t)
+ (edebug-after-instrumentation-function #'testcover-after-instrumentation)
+ (edebug-new-definition-function #'testcover-init-definition))
+ (eval-defun nil)))
(defun testcover-end (filename)
"Turn off instrumentation of all macros and functions in FILENAME."
@@ -444,42 +223,108 @@ FUN should be `testcover-reinstrument' for compositional functions,
;;; Accumulate coverage data
;;;=========================================================================
-(defun testcover-enter (testcover-sym testcover-fun)
- "Internal function for coverage testing. Invokes TESTCOVER-FUN while
-binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM
-\(the name of the current function)."
- (let ((testcover-vector (get testcover-sym 'edebug-coverage)))
- (funcall testcover-fun)))
-
-(defun testcover-after (idx val)
- "Internal function for coverage testing. Returns VAL after installing it in
-`testcover-vector' at offset IDX."
- (declare (gv-expander (lambda (do)
- (gv-letplace (getter setter) val
- (funcall do getter
- (lambda (store)
- `(progn (testcover-after ,idx ,getter)
- ,(funcall setter store))))))))
- (cond
- ((eq (aref testcover-vector idx) 'unknown)
- (aset testcover-vector idx val))
- ((not (equal (aref testcover-vector idx) val))
- (aset testcover-vector idx 'ok-coverage)))
- val)
-
-(defun testcover-1value (idx val)
- "Internal function for coverage testing. Returns VAL after installing it in
-`testcover-vector' at offset IDX. Error if FORM does not always return the
-same value during coverage testing."
- (cond
- ((eq (aref testcover-vector idx) '1value)
- (aset testcover-vector idx (cons '1value val)))
- ((not (and (eq (car-safe (aref testcover-vector idx)) '1value)
- (equal (cdr (aref testcover-vector idx)) val)))
- (error "Value of form marked with `1value' does vary: %s" val)))
- val)
-
-
+(defun testcover-after-instrumentation (form)
+ "Analyze FORM for code coverage."
+ (testcover-analyze-coverage form)
+ form)
+
+(defun testcover-init-definition (sym)
+ "Mark SYM as under test coverage."
+ (message "Testcover: %s" sym)
+ (put sym 'edebug-behavior 'testcover))
+
+(defun testcover-enter (func _args body)
+ "Begin execution of a function under coverage testing.
+Bind `testcover-vector' to the code-coverage vector for FUNC and
+return the result of evaluating BODY."
+ (let ((testcover-vector (get func 'edebug-coverage)))
+ (funcall body)))
+
+(defun testcover-before (before-index)
+ "Update code coverage before a form is evaluated.
+BEFORE-INDEX is the form's index into the code-coverage vector."
+ (let ((before-entry (aref testcover-vector before-index)))
+ (when (eq (car-safe before-entry) 'noreturn)
+ (let* ((after-index (cdr before-entry)))
+ (aset testcover-vector after-index 'ok-coverage)))))
+
+(defun testcover-after (_before-index after-index value)
+ "Update code coverage with the result of a form's evaluation.
+AFTER-INDEX is the form's index into the code-coverage
+vector. Return VALUE."
+ (let ((old-result (aref testcover-vector after-index)))
+ (cond
+ ((eq 'unknown old-result)
+ (aset testcover-vector after-index (testcover--copy-object value)))
+ ((eq 'maybe old-result)
+ (aset testcover-vector after-index 'ok-coverage))
+ ((eq '1value old-result)
+ (aset testcover-vector after-index
+ (cons old-result (testcover--copy-object value))))
+ ((and (eq (car-safe old-result) '1value)
+ (not (condition-case ()
+ (equal (cdr old-result) value)
+ (circular-list t))))
+ (error "Value of form expected to be constant does vary, from %s to %s"
+ old-result value))
+ ;; Test if a different result.
+ ((not (condition-case ()
+ (equal value old-result)
+ (circular-list nil)))
+ (aset testcover-vector after-index 'ok-coverage))))
+ value)
+
+;; Add these behaviors to Edebug.
+(unless (assoc 'testcover edebug-behavior-alist)
+ (push '(testcover testcover-enter testcover-before testcover-after)
+ edebug-behavior-alist))
+
+(defun testcover--copy-object (obj)
+ "Make a copy of OBJ.
+If OBJ is a cons cell, copy both its car and its cdr.
+Contrast to `copy-tree' which does the same but fails on circular
+structures, and `copy-sequence', which copies only along the
+cdrs. Copy vectors as well as conses."
+ (let ((ht (make-hash-table :test 'eq)))
+ (testcover--copy-object1 obj t ht)))
+
+(defun testcover--copy-object1 (obj vecp hash-table)
+ "Make a copy of OBJ, using a HASH-TABLE of objects already copied.
+If OBJ is a cons cell, this recursively copies its car and
+iteratively copies its cdr. When VECP is non-nil, copy
+vectors as well as conses."
+ (if (and (atom obj) (or (not vecp) (not (vectorp obj))))
+ obj
+ (let ((copy (gethash obj hash-table nil)))
+ (unless copy
+ (cond
+ ((consp obj)
+ (let* ((rest obj) current)
+ (setq copy (cons nil nil)
+ current copy)
+ (while
+ (progn
+ (puthash rest current hash-table)
+ (setf (car current)
+ (testcover--copy-object1 (car rest) vecp hash-table))
+ (setq rest (cdr rest))
+ (cond
+ ((atom rest)
+ (setf (cdr current)
+ (testcover--copy-object1 rest vecp hash-table))
+ nil)
+ ((gethash rest hash-table nil)
+ (setf (cdr current) (gethash rest hash-table nil))
+ nil)
+ (t (setq current
+ (setf (cdr current) (cons nil nil)))))))))
+ (t ; (and vecp (vectorp obj)) is true due to test in if above.
+ (setq copy (copy-sequence obj))
+ (puthash obj copy hash-table)
+ (dotimes (i (length copy))
+ (aset copy i
+ (testcover--copy-object1 (aref copy i) vecp hash-table))))))
+ copy)))
;;;=========================================================================
;;; Display the coverage data as color splotches on your code.
@@ -511,12 +356,13 @@ eliminated by adding more test cases."
(while (> len 0)
(setq len (1- len)
data (aref coverage len))
- (when (and (not (eq data 'ok-coverage))
- (not (eq (car-safe data) '1value))
- (setq j (+ def-mark (aref points len))))
+ (when (and (not (eq data 'ok-coverage))
+ (not (memq (car-safe data)
+ '(1value maybe noreturn)))
+ (setq j (+ def-mark (aref points len))))
(setq ov (make-overlay (1- j) j))
(overlay-put ov 'face
- (if (memq data '(unknown 1value))
+ (if (memq data '(unknown maybe 1value))
'testcover-nohits
'testcover-1value))))
(set-buffer-modified-p changed))))
@@ -547,4 +393,284 @@ coverage tests. This function creates many overlays."
(goto-char (next-overlay-change (point)))
(end-of-line))
+
+;;; Coverage Analysis
+
+;; The top level function for initializing code coverage is
+;; `testcover-analyze-coverage', which recursively walks the form it is
+;; passed, which should have already been instrumented by
+;; edebug-read-and-maybe-wrap-form, and initializes the associated
+;; code coverage vectors, which should have already been created by
+;; `edebug-clear-coverage'.
+;;
+;; The purpose of the analysis is to identify forms which can only
+;; ever return a single value. These forms can be considered to have
+;; adequate code coverage even if only executed once. In addition,
+;; forms which will never return, such as error signals, can be
+;; identified and treated correctly.
+;;
+;; The code coverage vector entries for the beginnings of forms will
+;; be changed to `ok-coverage.', except for the beginnings of forms
+;; which should never return, which will be changed to
+;; (noreturn . AFTER-INDEX) so that testcover-before can set the entry
+;; for the end of the form just before it is executed.
+;;
+;; Entries for the ends of forms may be changed to `1value' if
+;; analysis determines the form will only ever return a single value,
+;; or `maybe' if the form could potentially only ever return a single
+;; value.
+;;
+;; An example of a potentially 1-valued form is an `and' whose last
+;; term is 1-valued, in case the last term is always nil. Example:
+;;
+;; (and (< (point) 1000) (forward-char 10))
+;;
+;; This form always returns nil. Similarly, `or', `if', and `cond'
+;; are treated as potentially 1-valued if all clauses are, in case
+;; those values are always nil. Unlike truly 1-valued functions, it
+;; is not an error if these "potentially" 1-valued forms actually
+;; return differing values.
+
+(defun testcover-analyze-coverage (form)
+ "Analyze FORM and initialize coverage vectors for definitions found within.
+Return 1value, maybe or nil depending on if the form is determined
+to return only a single value, potentially return only a single value,
+or return multiple values."
+ (pcase form
+ (`(edebug-enter ',sym ,_ (function (lambda nil . ,body)))
+ (let ((testcover-vector (get sym 'edebug-coverage)))
+ (testcover-analyze-coverage-progn body)))
+
+ (`(edebug-after ,(and before-form
+ (or `(edebug-before ,before-id) before-id))
+ ,after-id ,wrapped-form)
+ (testcover-analyze-coverage-edebug-after
+ form before-form before-id after-id wrapped-form))
+
+ (`(defconst ,sym . ,args)
+ (push sym testcover-module-constants)
+ (testcover-analyze-coverage-progn args)
+ '1value)
+
+ (`(defun ,name ,_ . ,doc-and-body)
+ (let ((val (testcover-analyze-coverage-progn doc-and-body)))
+ (cl-case val
+ ((1value) (push name testcover-module-1value-functions))
+ ((maybe) (push name testcover-module-potentially-1value-functions)))
+ nil))
+
+ (`(quote . ,_)
+ ;; A quoted form is 1value. Edebug could have instrumented
+ ;; something inside the form if an Edebug spec contained a quote.
+ ;; It's also possible that the quoted form is a circular object.
+ ;; To avoid infinite recursion, don't examine quoted objects.
+ ;; This will cause the coverage marks on an instrumented quoted
+ ;; form to look odd. See bug#25316.
+ '1value)
+
+ (`(\` ,bq-form)
+ (testcover-analyze-coverage-backquote-form bq-form))
+
+ ((or 't 'nil (pred keywordp))
+ '1value)
+
+ ((pred vectorp)
+ (testcover-analyze-coverage-compose (append form nil)
+ #'testcover-analyze-coverage))
+
+ ((pred symbolp)
+ nil)
+
+ ((pred atom)
+ '1value)
+
+ (_
+ ;; Whatever we have here, it's not wrapped, so treat it as a list of forms.
+ (testcover-analyze-coverage-compose form #'testcover-analyze-coverage))))
+
+(defun testcover-analyze-coverage-progn (forms)
+ "Analyze FORMS, which should be a list of forms, for code coverage.
+Analyze all the forms in FORMS and return 1value, maybe or nil
+depending on the analysis of the last one. Find the coverage
+vectors referenced by `edebug-enter' forms nested within FORMS and
+update them with the results of the analysis."
+ (let ((result '1value))
+ (while (consp forms)
+ (setq result (testcover-analyze-coverage (pop forms))))
+ result))
+
+(defun testcover-analyze-coverage-edebug-after (_form before-form before-id
+ after-id wrapped-form
+ &optional wrapper)
+ "Analyze a _FORM wrapped by `edebug-after' for code coverage.
+_FORM should be either:
+ (edebug-after (edebug-before BEFORE-ID) AFTER-ID WRAPPED-FORM)
+or:
+ (edebug-after 0 AFTER-ID WRAPPED-FORM)
+
+where BEFORE-FORM is bound to either (edebug-before BEFORE-ID) or
+0. WRAPPER may be 1value or noreturn, and if so it forces the
+form to be treated accordingly."
+ (let (val)
+ (unless (eql before-form 0)
+ (aset testcover-vector before-id 'ok-coverage))
+
+ (setq val (testcover-analyze-coverage-wrapped-form wrapped-form))
+ (when (or (eq wrapper '1value) val)
+ ;; The form is 1-valued or potentially 1-valued.
+ (aset testcover-vector after-id (or val '1value)))
+
+ (cond
+ ((or (eq wrapper 'noreturn)
+ (memq (car-safe wrapped-form) testcover-noreturn-functions))
+ ;; This function won't return, so indicate to testcover-before that
+ ;; it should record coverage.
+ (aset testcover-vector before-id (cons 'noreturn after-id))
+ (aset testcover-vector after-id '1value)
+ (setq val '1value))
+
+ ((eq (car-safe wrapped-form) '1value)
+ ;; This function is always supposed to return the same value.
+ (setq val '1value)
+ (aset testcover-vector after-id '1value)))
+ val))
+
+(defun testcover-analyze-coverage-wrapped-form (form)
+ "Analyze a FORM for code coverage which was wrapped by `edebug-after'.
+FORM is treated as if it will be evaluated."
+ (pcase form
+ ((pred keywordp)
+ '1value)
+ ((pred symbolp)
+ (when (or (memq form testcover-constants)
+ (memq form testcover-module-constants))
+ '1value))
+ ((pred atom)
+ '1value)
+ (`(\` ,bq-form)
+ (testcover-analyze-coverage-backquote-form bq-form))
+ (`(defconst ,sym ,val . ,_)
+ (push sym testcover-module-constants)
+ (testcover-analyze-coverage val)
+ '1value)
+ (`(,(or 'dotimes 'dolist) (,_ ,expr . ,result) . ,body)
+ ;; These always return RESULT if provided.
+ (testcover-analyze-coverage expr)
+ (testcover-analyze-coverage-progn body)
+ (let ((val (testcover-analyze-coverage-progn result)))
+ ;; If the third value is not present, the loop always returns nil.
+ (if result val '1value)))
+ (`(,(or 'let 'let*) ,bindings . ,body)
+ (testcover-analyze-coverage-progn bindings)
+ (testcover-analyze-coverage-progn body))
+ (`(if ,test ,then-form . ,else-body)
+ ;; `if' is potentially 1-valued if both THEN and ELSE clauses are.
+ (testcover-analyze-coverage test)
+ (let ((then (testcover-analyze-coverage then-form))
+ (else (testcover-analyze-coverage else-body)))
+ (and then else 'maybe)))
+ (`(cond . ,clauses)
+ ;; `cond' is potentially 1-valued if all clauses are.
+ (when (testcover-analyze-coverage-compose clauses #'testcover-analyze-coverage-progn)
+ 'maybe))
+ (`(condition-case ,_ ,body-form . ,handlers)
+ ;; `condition-case' is potentially 1-valued if BODY-FORM is and all
+ ;; HANDLERS are.
+ (let ((body (testcover-analyze-coverage body-form))
+ (errs (testcover-analyze-coverage-compose
+ (mapcar #'cdr handlers)
+ #'testcover-analyze-coverage-progn)))
+ (and body errs 'maybe)))
+ (`(apply (quote ,(and func (pred symbolp))) . ,args)
+ ;; Process application of a constant symbol as 1value or noreturn
+ ;; depending on the symbol.
+ (let ((temp-form (cons func args)))
+ (testcover-analyze-coverage-wrapped-form temp-form)))
+ (`(,(and func (or '1value 'noreturn)) ,inner-form)
+ ;; 1value and noreturn change how the edebug-after they wrap is handled.
+ (let ((val (if (eq func '1value) '1value 'maybe)))
+ (pcase inner-form
+ (`(edebug-after ,(and before-form
+ (or `(edebug-before ,before-id) before-id))
+ ,after-id ,wrapped-form)
+ (testcover-analyze-coverage-edebug-after inner-form before-form
+ before-id after-id
+ wrapped-form func))
+ (_ (testcover-analyze-coverage inner-form)))
+ val))
+ (`(,func . ,args)
+ (testcover-analyze-coverage-wrapped-application func args))))
+
+(defun testcover-analyze-coverage-wrapped-application (func args)
+ "Analyze the application of FUNC to ARGS for code coverage."
+ (cond
+ ((eq func 'quote) '1value)
+ ((or (memq func testcover-1value-functions)
+ (memq func testcover-module-1value-functions))
+ ;; The function should always return the same value.
+ (testcover-analyze-coverage-progn args)
+ '1value)
+ ((or (memq func testcover-potentially-1value-functions)
+ (memq func testcover-module-potentially-1value-functions))
+ ;; The function might always return the same value.
+ (testcover-analyze-coverage-progn args)
+ 'maybe)
+ ((memq func testcover-progn-functions)
+ ;; The function is 1-valued if the last argument is.
+ (testcover-analyze-coverage-progn args))
+ ((memq func testcover-prog1-functions)
+ ;; The function is 1-valued if first argument is.
+ (testcover-analyze-coverage-progn (cdr args))
+ (testcover-analyze-coverage (car args)))
+ ((memq func testcover-compose-functions)
+ ;; The function is 1-valued if all arguments are, and potentially
+ ;; 1-valued if all arguments are either definitely or potentially.
+ (testcover-analyze-coverage-compose args #'testcover-analyze-coverage))
+ (t (testcover-analyze-coverage-progn args)
+ nil)))
+
+(defun testcover-coverage-combine (result val)
+ "Combine RESULT with VAL and return the new result.
+If either argument is nil, return nil, otherwise if either
+argument is maybe, return maybe. Return 1value only if both arguments
+are 1value."
+ (cl-case val
+ (1value result)
+ (maybe (and result 'maybe))
+ (nil nil)))
+
+(defun testcover-analyze-coverage-compose (forms func)
+ "Analyze a list of FORMS for code coverage using FUNC.
+The list is 1valued if all of its constituent elements are also 1valued."
+ (let ((result '1value))
+ (dolist (form forms)
+ (let ((val (funcall func form)))
+ (setq result (testcover-coverage-combine result val))))
+ result))
+
+(defun testcover-analyze-coverage-backquote (bq-list)
+ "Analyze BQ-LIST, the body of a backquoted list, for code coverage."
+ (let ((result '1value))
+ (while (consp bq-list)
+ (let ((form (car bq-list))
+ val)
+ (if (memq form (list '\, '\,@))
+ ;; Correctly handle `(foo bar . ,(baz).
+ (progn
+ (setq val (testcover-analyze-coverage (cdr bq-list)))
+ (setq bq-list nil))
+ (setq val (testcover-analyze-coverage-backquote-form form))
+ (setq bq-list (cdr bq-list)))
+ (setq result (testcover-coverage-combine result val))))
+ result))
+
+(defun testcover-analyze-coverage-backquote-form (form)
+ "Analyze a single FORM from a backquoted list for code coverage."
+ (cond
+ ((vectorp form) (testcover-analyze-coverage-backquote (append form nil)))
+ ((atom form) '1value)
+ ((memq (car form) (list '\, '\,@))
+ (testcover-analyze-coverage (cadr form)))
+ (t (testcover-analyze-coverage-backquote form))))
+
;; testcover.el ends here.
diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el
index f4c075d22ce..895fa86722d 100644
--- a/lisp/emacs-lisp/thunk.el
+++ b/lisp/emacs-lisp/thunk.el
@@ -22,16 +22,16 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Thunk provides functions and macros to delay the evaluation of
;; forms.
;;
-;; Use `thunk-delay' to delay the evaluation of a form, and
-;; `thunk-force' to evaluate it. The result of the evaluation is
-;; cached, and only happens once.
+;; Use `thunk-delay' to delay the evaluation of a form (requires
+;; lexical-binding), and `thunk-force' to evaluate it. The result of
+;; the evaluation is cached, and only happens once.
;;
;; Here is an example of a form which evaluation is delayed:
;;
@@ -41,12 +41,19 @@
;; following:
;;
;; (thunk-force delayed)
+;;
+;; This file also defines macros `thunk-let' and `thunk-let*' that are
+;; analogous to `let' and `let*' but provide lazy evaluation of
+;; bindings by using thunks implicitly (i.e. in the expansion).
;;; Code:
+(eval-when-compile (require 'cl-macs))
+
(defmacro thunk-delay (&rest body)
"Delay the evaluation of BODY."
(declare (debug t))
+ (cl-assert lexical-binding)
(let ((forced (make-symbol "forced"))
(val (make-symbol "val")))
`(let (,forced ,val)
@@ -68,5 +75,60 @@ with the same DELAYED argument."
"Return non-nil if DELAYED has been evaluated."
(funcall delayed t))
+(defmacro thunk-let (bindings &rest body)
+ "Like `let' but create lazy bindings.
+
+BINDINGS is a list of elements of the form (SYMBOL EXPRESSION).
+Any binding EXPRESSION is not evaluated before the variable
+SYMBOL is used for the first time when evaluating the BODY.
+
+It is not allowed to set `thunk-let' or `thunk-let*' bound
+variables.
+
+Using `thunk-let' and `thunk-let*' requires `lexical-binding'."
+ (declare (indent 1) (debug let))
+ (cl-callf2 mapcar
+ (lambda (binding)
+ (pcase binding
+ (`(,(pred symbolp) ,_) binding)
+ (_ (signal 'error (cons "Bad binding in thunk-let"
+ (list binding))))))
+ bindings)
+ (cl-callf2 mapcar
+ (pcase-lambda (`(,var ,binding))
+ (list (make-symbol (concat (symbol-name var) "-thunk"))
+ var binding))
+ bindings)
+ `(let ,(mapcar
+ (pcase-lambda (`(,thunk-var ,_var ,binding))
+ `(,thunk-var (thunk-delay ,binding)))
+ bindings)
+ (cl-symbol-macrolet
+ ,(mapcar (pcase-lambda (`(,thunk-var ,var ,_binding))
+ `(,var (thunk-force ,thunk-var)))
+ bindings)
+ ,@body)))
+
+(defmacro thunk-let* (bindings &rest body)
+ "Like `let*' but create lazy bindings.
+
+BINDINGS is a list of elements of the form (SYMBOL EXPRESSION).
+Any binding EXPRESSION is not evaluated before the variable
+SYMBOL is used for the first time when evaluating the BODY.
+
+It is not allowed to set `thunk-let' or `thunk-let*' bound
+variables.
+
+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)
+ :initial-value (macroexp-progn body)))
+
+;; (defalias 'lazy-let #'thunk-let)
+;; (defalias 'lazy-let* #'thunk-let*)
+
+
(provide 'thunk)
;;; thunk.el ends here
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 1a38254bcba..69c67419835 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -18,14 +18,14 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
;;;###autoload
-(defun timer-list (&optional _ignore-auto _nonconfirm)
+(defun list-timers (&optional _ignore-auto _nonconfirm)
"List all timers in a buffer."
(interactive)
(pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
@@ -35,9 +35,7 @@
(dolist (timer (append timer-list timer-idle-list))
(insert (format "%4s %10s %8s %s"
;; Idle.
- (if (aref timer 7)
- "*"
- " ")
+ (if (aref timer 7) "*" " ")
;; Next time.
(let ((time (float-time (list (aref timer 1)
(aref timer 2)
@@ -59,16 +57,9 @@
(t
(format "%s" repeat))))
;; Function.
- (let ((function (aref timer 5)))
- (replace-regexp-in-string
- "\n" " "
- (cond
- ((byte-code-function-p function)
- (replace-regexp-in-string
- "[^-A-Za-z0-9 ]" ""
- (format "%s" function)))
- (t
- (format "%s" function)))))))
+ (let ((cl-print-compiled 'static)
+ (cl-print-compiled-button nil))
+ (cl-prin1-to-string (aref timer 5)))))
(put-text-property (line-beginning-position)
(1+ (line-beginning-position))
'timer timer)
@@ -76,21 +67,24 @@
(goto-char (point-min)))
;; This command can be destructive if they don't know what they are
;; doing. Kids, don't try this at home!
-;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
+;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
(defvar timer-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'timer-list-cancel)
+ (define-key map "n" 'next-line)
+ (define-key map "p" 'previous-line)
(easy-menu-define nil map ""
'("Timers"
["Cancel" timer-list-cancel t]))
map))
-(define-derived-mode timer-list-mode special-mode "timer-list"
+(define-derived-mode timer-list-mode special-mode "Timer-List"
"Mode for listing and controlling timers."
+ (setq bidi-paragraph-direction 'left-to-right)
(setq truncate-lines t)
(buffer-disable-undo)
- (setq-local revert-buffer-function 'timer-list)
+ (setq-local revert-buffer-function #'list-timers)
(setq buffer-read-only t)
(setq header-line-format
(format "%4s %10s %8s %s"
diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el
index d872256dad4..1de3043cd94 100644
--- a/lisp/emacs-lisp/timer.el
+++ b/lisp/emacs-lisp/timer.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
index 3f5d78df31c..31bb9d1b965 100644
--- a/lisp/emacs-lisp/tq.el
+++ b/lisp/emacs-lisp/tq.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
index 1c57d7363c2..4a83937acb3 100644
--- a/lisp/emacs-lisp/trace.el
+++ b/lisp/emacs-lisp/trace.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; LCD Archive Entry:
;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el
index 1ab65a044e0..88f053d9f73 100644
--- a/lisp/emacs-lisp/unsafep.el
+++ b/lisp/emacs-lisp/unsafep.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 671d2795c37..2765877f3ef 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
index dbf6ac88443..6624c99cdb5 100644
--- a/lisp/emacs-lock.el
+++ b/lisp/emacs-lock.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index 63b8e9bf934..9d97fee4e3d 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el
index baa430e5b79..9d51f4a7171 100644
--- a/lisp/emulation/cua-gmrk.el
+++ b/lisp/emulation/cua-gmrk.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el
index 3538181dfad..339203414ee 100644
--- a/lisp/emulation/cua-rect.el
+++ b/lisp/emulation/cua-rect.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Acknowledgments
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
index 9afb25ca099..354d2889853 100644
--- a/lisp/emulation/edt-lk201.el
+++ b/lisp/emulation/edt-lk201.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
index 457ad55dd6c..963da2ba59e 100644
--- a/lisp/emulation/edt-mapper.el
+++ b/lisp/emulation/edt-mapper.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
index 3ea249fe79a..c59ad9799da 100644
--- a/lisp/emulation/edt-pc.el
+++ b/lisp/emulation/edt-pc.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
index a8c186b166b..98f51dabc10 100644
--- a/lisp/emulation/edt-vt100.el
+++ b/lisp/emulation/edt-vt100.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index a6b2d785ac5..bdb606c69ed 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el
index 0c7135e78b9..aea2440627d 100644
--- a/lisp/emulation/keypad.el
+++ b/lisp/emulation/keypad.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index a697aa7d032..21200ae02a7 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index ca067033e63..7d52d5a3a1c 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -401,13 +401,14 @@ reversed."
(setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
(set-buffer viper-ex-work-buf)
(skip-chars-forward " \t|")
- (let ((case-fold-search t))
- (cond ((looking-at "#")
+ (let ((case-fold-search t)
+ (char (following-char)))
+ (cond ((= char ?#)
(setq ex-token-type 'command)
- (setq ex-token (char-to-string (following-char)))
+ (setq ex-token (char-to-string char))
(forward-char 1))
((looking-at "[a-z]") (viper-get-ex-com-subr))
- ((looking-at "\\.")
+ ((= char ?.)
(forward-char 1)
(setq ex-token-type 'dot))
((looking-at "[0-9]")
@@ -419,13 +420,13 @@ reversed."
(t 'abs-number)))
(setq ex-token
(string-to-number (buffer-substring (point) (mark t)))))
- ((looking-at "\\$")
+ ((= char ?$)
(forward-char 1)
(setq ex-token-type 'end))
- ((looking-at "%")
+ ((= char ?%)
(forward-char 1)
(setq ex-token-type 'whole))
- ((looking-at "+")
+ ((= char ?+)
(cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
(forward-char 1)
(insert "1")
@@ -436,7 +437,7 @@ reversed."
(setq ex-token-type 'plus))
(t
(error viper-BadAddress))))
- ((looking-at "-")
+ ((= char ?-)
(cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
(forward-char 1)
(insert "1")
@@ -447,7 +448,7 @@ reversed."
(setq ex-token-type 'minus))
(t
(error viper-BadAddress))))
- ((looking-at "/")
+ ((= char ?/)
(forward-char 1)
(set-mark (point))
(let ((cont t))
@@ -459,9 +460,9 @@ reversed."
(setq cont nil))))
(backward-char 1)
(setq ex-token (buffer-substring (point) (mark t)))
- (if (looking-at "/") (forward-char 1))
+ (when (= (following-char) ?/) (forward-char 1))
(setq ex-token-type 'search-forward))
- ((looking-at "\\?")
+ ((= char ??)
(forward-char 1)
(set-mark (point))
(let ((cont t))
@@ -472,27 +473,27 @@ reversed."
(line-beginning-position 0)))
(setq cont nil))
(backward-char 1)
- (if (not (looking-at "\n")) (forward-char 1))))
+ (when (/= (following-char) ?\n) (forward-char 1))))
(setq ex-token-type 'search-backward)
(setq ex-token (buffer-substring (1- (point)) (mark t))))
- ((looking-at ",")
+ ((= char ?,)
(forward-char 1)
(setq ex-token-type 'comma))
- ((looking-at ";")
+ ((= char ?\;)
(forward-char 1)
(setq ex-token-type 'semi-colon))
((looking-at "[!=><&~]")
(setq ex-token-type 'command)
- (setq ex-token (char-to-string (following-char)))
+ (setq ex-token (char-to-string char))
(forward-char 1))
- ((looking-at "'")
+ ((= char ?\')
(setq ex-token-type 'goto-mark)
(forward-char 1)
- (cond ((looking-at "'") (setq ex-token nil))
+ (cond ((= (following-char) ?\') (setq ex-token nil))
((looking-at "[a-z]") (setq ex-token (following-char)))
(t (error "%s" "Marks are ' and a-z")))
(forward-char 1))
- ((looking-at "\n")
+ ((= char ?\n)
(setq ex-token-type 'end-mark)
(setq ex-token "goto"))
(t
@@ -687,9 +688,9 @@ reversed."
(get-buffer-create viper-ex-work-buf-name))
(set-buffer viper-ex-work-buf)
(skip-chars-forward " \t")
- (cond ((looking-at "|")
+ (cond ((= (following-char) ?|)
(forward-char 1))
- ((looking-at "\n")
+ ((= (following-char) ?\n)
(setq cont nil))
(t (error
"`%s': %s" ex-token viper-SpuriousText)))
@@ -994,33 +995,31 @@ reversed."
(with-current-buffer (setq viper-ex-work-buf
(get-buffer-create viper-ex-work-buf-name))
(skip-chars-forward " \t")
- (if (looking-at "!")
- (if (and (not (looking-back "[ \t]" (1- (point))))
- ;; read doesn't have a corresponding :r! form, so ! is
- ;; immediately interpreted as a shell command.
- (not (string= ex-token "read")))
- (progn
- (setq ex-variant t)
- (forward-char 1)
- (skip-chars-forward " \t"))
- (setq ex-cmdfile t)
- (forward-char 1)
- (skip-chars-forward " \t")))
- (if (looking-at ">>")
- (progn
- (setq ex-append t
- ex-variant t)
- (forward-char 2)
- (skip-chars-forward " \t")))
- (if (looking-at "+")
- (progn
- (forward-char 1)
- (set-mark (point))
- (re-search-forward "[ \t\n]")
- (backward-char 1)
- (setq ex-offset (buffer-substring (point) (mark t)))
- (forward-char 1)
- (skip-chars-forward " \t")))
+ (when (= (following-char) ?!)
+ (if (and (not (memq (preceding-char) '(?\s ?\t)))
+ ;; read doesn't have a corresponding :r! form, so ! is
+ ;; immediately interpreted as a shell command.
+ (not (string= ex-token "read")))
+ (progn
+ (setq ex-variant t)
+ (forward-char 1)
+ (skip-chars-forward " \t"))
+ (setq ex-cmdfile t)
+ (forward-char 1)
+ (skip-chars-forward " \t")))
+ (when (looking-at ">>")
+ (setq ex-append t
+ ex-variant t)
+ (forward-char 2)
+ (skip-chars-forward " \t"))
+ (when (= (following-char) ?+)
+ (forward-char 1)
+ (set-mark (point))
+ (re-search-forward "[ \t\n]")
+ (backward-char 1)
+ (setq ex-offset (buffer-substring (point) (mark t)))
+ (forward-char 1)
+ (skip-chars-forward " \t"))
;; this takes care of :r, :w, etc., when they get file names
;; from the history list
(if (member ex-token '("read" "write" "edit" "visual" "next"))
@@ -1602,7 +1601,7 @@ reversed."
;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
(with-current-buffer (setq viper-ex-work-buf
(get-buffer-create viper-ex-work-buf-name))
- (if (looking-at "!") (forward-char 1)))
+ (when (= (following-char) ?!) (forward-char 1)))
(if (< viper-expert-level 3)
(save-buffers-kill-emacs)
(kill-buffer (current-buffer))))
@@ -2322,8 +2321,4 @@ Type `mak ' (including the space) to run make with no args."
(with-output-to-temp-buffer " *viper-info*"
(princ lines))))))
-
-
-
-
;;; viper-ex.el ends here
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 0d478011238..3fd492b3dd3 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -344,9 +344,7 @@ Use `\\[viper-set-expert-level]' to change this.")
(quail-delete-overlays))
(setq describe-current-input-method-function nil)
(setq current-input-method nil)
- (run-hooks
- 'input-method-inactivate-hook ; for backward compatibility
- 'input-method-deactivate-hook)
+ (run-hooks 'input-method-deactivate-hook)
(force-mode-line-update))
))
(defun viper-activate-input-method ()
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index a18833d2502..6227e33417a 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index 1353f7e1772..d79fa454f37 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index 2600c503224..d36f57352f5 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index e32b41f5750..e09a2bb9a65 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index bded174b0d3..2a66262f6cf 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -30,7 +30,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/env.el b/lisp/env.el
index 859f2808023..5f8c4f5e5c0 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el
index 5eb6ca50a34..cbf8b974d8e 100644
--- a/lisp/epa-dired.el
+++ b/lisp/epa-dired.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/epa-file.el b/lisp/epa-file.el
index c97acb837aa..7b5ad38f70a 100644
--- a/lisp/epa-file.el
+++ b/lisp/epa-file.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el
index c6577c81eb5..5f12a153362 100644
--- a/lisp/epa-hook.el
+++ b/lisp/epa-hook.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el
index 7069273afa1..1eb73e31327 100644
--- a/lisp/epa-mail.el
+++ b/lisp/epa-mail.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/epa.el b/lisp/epa.el
index 52963b6d3cd..aca9aaa7d22 100644
--- a/lisp/epa.el
+++ b/lisp/epa.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -561,7 +561,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
(epg-sub-key-creation-time (car pointer)))
(error "????-??-??"))
(if (epg-sub-key-expiration-time (car pointer))
- (format (if (time-less-p (current-time)
+ (format (if (time-less-p nil
(epg-sub-key-expiration-time
(car pointer)))
"\n\tExpires: %s"
diff --git a/lisp/epg-config.el b/lisp/epg-config.el
index 7b963add881..dff5e99a8de 100644
--- a/lisp/epg-config.el
+++ b/lisp/epg-config.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -210,34 +210,16 @@ version requirement is met."
(declare (obsolete epg-find-configuration "25.1"))
(epg-config--make-gpg-configuration epg-gpg-program))
-(defun epg-config--parse-version (string)
- (let ((index 0)
- version)
- (while (eq index (string-match "\\([0-9]+\\)\\.?" string index))
- (setq version (cons (string-to-number (match-string 1 string))
- version)
- index (match-end 0)))
- (nreverse version)))
-
-(defun epg-config--compare-version (v1 v2)
- (while (and v1 v2 (= (car v1) (car v2)))
- (setq v1 (cdr v1) v2 (cdr v2)))
- (- (or (car v1) 0) (or (car v2) 0)))
-
;;;###autoload
(defun epg-check-configuration (config &optional minimum-version)
"Verify that a sufficient version of GnuPG is installed."
- (let ((entry (assq 'version config))
- version)
- (unless (and entry
- (stringp (cdr entry)))
- (error "Undetermined version: %S" entry))
- (setq version (epg-config--parse-version (cdr entry))
- minimum-version (epg-config--parse-version
- (or minimum-version
- epg-gpg-minimum-version)))
- (unless (>= (epg-config--compare-version version minimum-version) 0)
- (error "Unsupported version: %s" (cdr entry)))))
+ (let ((version (alist-get 'version config)))
+ (unless (stringp version)
+ (error "Undetermined version: %S" version))
+ (unless (version<= (or minimum-version
+ epg-gpg-minimum-version)
+ version)
+ (error "Unsupported version: %s" version))))
;;;###autoload
(defun epg-expand-group (config group)
diff --git a/lisp/epg.el b/lisp/epg.el
index 587271b0003..b2d80023f0f 100644
--- a/lisp/epg.el
+++ b/lisp/epg.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -551,8 +551,6 @@ callback data (if any)."
(defun epg-errors-to-string (errors)
(mapconcat #'epg-error-to-string errors "; "))
-(declare-function pinentry-start "pinentry" (&optional quiet))
-
(defun epg--start (context args)
"Start `epg-gpg-program' in a subprocess with given ARGS."
(if (and (epg-context-process context)
@@ -604,30 +602,13 @@ callback data (if any)."
(setq process-environment
(cons (concat "GPG_TTY=" terminal-name)
(cons "TERM=xterm" process-environment))))
- ;; Automatically start the Emacs Pinentry server if appropriate.
- (when (and (fboundp 'pinentry-start)
- ;; Emacs Pinentry is useless if Emacs has no interactive session.
- (not noninteractive)
- ;; Prefer pinentry-mode over Emacs Pinentry.
- (null (epg-context-pinentry-mode context))
- ;; Check if the allow-emacs-pinentry option is set.
- (executable-find epg-gpgconf-program)
- (with-temp-buffer
- (when (= (call-process epg-gpgconf-program nil t nil
- "--list-options" "gpg-agent")
- 0)
- (goto-char (point-min))
- (re-search-forward
- "^allow-emacs-pinentry:\\(?:.*:\\)\\{8\\}1"
- nil t))))
- (pinentry-start 'quiet))
(setq process-environment
(cons (format "INSIDE_EMACS=%s,epg" emacs-version)
process-environment))
;; Record modified time of gpg-agent socket to restore the Emacs
;; frame on text terminal in `epg-wait-for-completion'.
;; See
- ;; <http://lists.gnu.org/archive/html/emacs-devel/2007-02/msg00755.html>
+ ;; <https://lists.gnu.org/r/emacs-devel/2007-02/msg00755.html>
;; for more details.
(when (and agent-info (string-match "\\(.*\\):[0-9]+:[0-9]+" agent-info))
(setq agent-file (match-string 1 agent-info)
@@ -757,9 +738,8 @@ callback data (if any)."
;; Restore Emacs frame on text terminal, when pinentry-curses has terminated.
(if (with-current-buffer (process-buffer (epg-context-process context))
(and epg-agent-file
- (> (float-time (or (nth 5 (file-attributes epg-agent-file))
- '(0 0 0 0)))
- (float-time epg-agent-mtime))))
+ (time-less-p epg-agent-mtime
+ (or (nth 5 (file-attributes epg-agent-file)) 0))))
(redraw-frame))
(epg-context-set-result-for
context 'error
@@ -1047,7 +1027,7 @@ callback data (if any)."
(defun epg--status-TRUST_MARGINAL (context _string)
(let ((signature (car (epg-context-result-for context 'verify))))
(if (and signature
- (eq (epg-signature-status signature) 'marginal))
+ (eq (epg-signature-status signature) 'good))
(setf (epg-signature-validity signature) 'marginal))))
(defun epg--status-TRUST_FULLY (context _string)
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index 2d5403fdc17..eefbbe924bf 100644
--- a/lisp/erc/ChangeLog.1
+++ b/lisp/erc/ChangeLog.1
@@ -11717,7 +11717,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/erc/ChangeLog.2 b/lisp/erc/ChangeLog.2
index d961fbfd08a..36b01e235c7 100644
--- a/lisp/erc/ChangeLog.2
+++ b/lisp/erc/ChangeLog.2
@@ -120,7 +120,7 @@
2014-09-25 Kelvin White <kwhite@gnu.org>
- * erc.el: Follow Emacs version instead of tracking it seperately.
+ * erc.el: Follow Emacs version instead of tracking it separately.
(erc-quit/part-reason-default) : Clean up quit/part message
functions by abstracting repetitive code, change version string.
(erc-quit-reason-various, erc-quit-reason-normal, erc-quit-reason-zippy)
@@ -772,7 +772,7 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el
index 827527966ca..86ca5610abc 100644
--- a/lisp/erc/erc-autoaway.el
+++ b/lisp/erc/erc-autoaway.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -82,7 +82,7 @@ This is used when `erc-autoaway-idle-method' is 'user."
(unless (erc-autoaway-some-server-buffer)
(remove-hook 'post-command-hook 'erc-autoaway-reset-idle-user)))
-;;;###autoload (autoload 'erc-autoaway-mode "erc-autoaway")
+;;;###autoload(autoload 'erc-autoaway-mode "erc-autoaway")
(define-erc-module autoaway nil
"In ERC autoaway mode, you can be set away automatically.
If `erc-auto-set-away' is set, then you will be set away after
@@ -282,6 +282,7 @@ active server buffer available."
;;; erc-autoaway.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 3368d6701ae..68b30a9216d 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -644,22 +644,24 @@ Make sure you are in an ERC buffer when running this."
(erc-log-irc-protocol line nil)
(erc-parse-server-response process line)))))))
-(defsubst erc-server-reconnect-p (event)
+(define-inline erc-server-reconnect-p (event)
"Return non-nil if ERC should attempt to reconnect automatically.
EVENT is the message received from the closed connection process."
- (or erc-server-reconnecting
- (and erc-server-auto-reconnect
- (not erc-server-banned)
- ;; make sure we don't infinitely try to reconnect, unless the
- ;; user wants that
- (or (eq erc-server-reconnect-attempts t)
- (and (integerp erc-server-reconnect-attempts)
- (< erc-server-reconnect-count
- erc-server-reconnect-attempts)))
- (or erc-server-timed-out
- (not (string-match "^deleted" event)))
- ;; open-network-stream-nowait error for connection refused
- (if (string-match "^failed with code 111" event) 'nonblocking t))))
+ (inline-letevals (event)
+ (inline-quote
+ (or erc-server-reconnecting
+ (and erc-server-auto-reconnect
+ (not erc-server-banned)
+ ;; make sure we don't infinitely try to reconnect, unless the
+ ;; user wants that
+ (or (eq erc-server-reconnect-attempts t)
+ (and (integerp erc-server-reconnect-attempts)
+ (< erc-server-reconnect-count
+ erc-server-reconnect-attempts)))
+ (or erc-server-timed-out
+ (not (string-match "^deleted" ,event)))
+ ;; open-network-stream-nowait error for connection refused
+ (if (string-match "^failed with code 111" ,event) 'nonblocking t))))))
(defun erc-process-sentinel-2 (event buffer)
"Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index ee5d6fe09ee..04f3096650c 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -49,7 +49,7 @@
"Define how text can be turned into clickable buttons."
:group 'erc)
-;;;###autoload (autoload 'erc-button-mode "erc-button" nil t)
+;;;###autoload(autoload 'erc-button-mode "erc-button" nil t)
(define-erc-module button nil
"This mode buttonizes all messages according to `erc-button-alist'."
((add-hook 'erc-insert-modify-hook 'erc-button-add-buttons 'append)
@@ -545,5 +545,6 @@ and `apropos' for other symbols."
;;; erc-button.el ends here
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: nil
;; End:
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index 0d3b23701c4..1830cca40ed 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -90,7 +90,7 @@ character not found in IRC nicknames to avoid confusion."
;;; Define module:
-;;;###autoload (autoload 'erc-capab-identify-mode "erc-capab" nil t)
+;;;###autoload(autoload 'erc-capab-identify-mode "erc-capab" nil t)
(define-erc-module capab-identify nil
"Handle dancer-ircd's CAPAB IDENTIFY-MSG and IDENTIFY-CTCP."
;; append so that `erc-server-parameters' is already set by `erc-server-005'
@@ -207,3 +207,7 @@ PARSED is an `erc-parsed' response struct."
(provide 'erc-capab)
;;; erc-capab.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 1ad66802fec..d4e07029107 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,7 +29,7 @@
(require 'format-spec)
-;;;###autoload (autoload 'erc-define-minor-mode "erc-compat")
+;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(defalias 'erc-define-minor-mode 'define-minor-mode)
(put 'erc-define-minor-mode 'edebug-form-spec 'define-minor-mode)
@@ -161,6 +161,7 @@ If START or END is negative, it counts from the end."
;;; erc-compat.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 542e1909cb6..0ab3a30364a 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -56,7 +56,7 @@
(require 'erc)
(eval-when-compile (require 'pcomplete))
-;;;###autoload (autoload 'erc-dcc-mode "erc-dcc")
+;;;###autoload(autoload 'erc-dcc-mode "erc-dcc")
(define-erc-module dcc nil
"Provide Direct Client-to-Client support for ERC."
((add-hook 'erc-server-401-functions 'erc-dcc-no-such-nick))
@@ -649,9 +649,10 @@ that subcommand."
"\"\\(\\(.*?\\(\\\\\"\\)?\\)+?\\)\"\\|\\([^ ]+\\)"
"\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)"))
-(defsubst erc-dcc-unquote-filename (filename)
- (erc-replace-regexp-in-string "\\\\\\\\" "\\"
- (erc-replace-regexp-in-string "\\\\\"" "\"" filename t t) t t))
+(define-inline erc-dcc-unquote-filename (filename)
+ (inline-quote
+ (erc-replace-regexp-in-string "\\\\\\\\" "\\"
+ (erc-replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t)))
(defun erc-dcc-handle-ctcp-send (proc query nick login host to)
"This is called if a CTCP DCC SEND subcommand is sent to the client.
@@ -780,8 +781,8 @@ unconfirmed."
:group 'erc-dcc
:type '(choice (const nil) integer))
-(defsubst erc-dcc-get-parent (proc)
- (plist-get (erc-dcc-member :peer proc) :parent))
+(define-inline erc-dcc-get-parent (proc)
+ (inline-quote (plist-get (erc-dcc-member :peer ,proc) :parent)))
(defun erc-dcc-send-block (proc)
"Send one block of data.
@@ -1257,5 +1258,6 @@ other client."
;;; erc-dcc.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: nil
;; End:
diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el
index 113f1cffa60..b35b713fc65 100644
--- a/lisp/erc/erc-desktop-notifications.el
+++ b/lisp/erc/erc-desktop-notifications.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -98,3 +98,7 @@ This will replace the last notification sent with this function."
(provide 'erc-desktop-notifications)
;;; erc-desktop-notifications.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el
index 94735787e20..45baa1d1a4c 100644
--- a/lisp/erc/erc-ezbounce.el
+++ b/lisp/erc/erc-ezbounce.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -175,3 +175,7 @@ in the alist is nil, prompt for the appropriate values."
(provide 'erc-ezbounce)
;;; erc-ezbounce.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el
index d58ccfa9a9f..35571ab362a 100644
--- a/lisp/erc/erc-fill.el
+++ b/lisp/erc/erc-fill.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -37,7 +37,7 @@
"Filling means to reformat long lines in different ways."
:group 'erc)
-;;;###autoload (autoload 'erc-fill-mode "erc-fill" nil t)
+;;;###autoload(autoload 'erc-fill-mode "erc-fill" nil t)
(erc-define-minor-mode erc-fill-mode
"Toggle ERC fill mode.
With a prefix argument ARG, enable ERC fill mode if ARG is
@@ -193,5 +193,6 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'."
;;; erc-fill.el ends here
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: nil
;; End:
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 1f27036f40e..8906da1e47d 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -147,7 +147,19 @@ Put this function on `erc-insert-post-hook' and/or `erc-send-post-hook'."
(>= (point) erc-insert-marker))
(deactivate-mark)
(goto-char (erc-beg-of-input-line))
- (forward-line -1)))
+ (forward-line -1)
+ ;; if `switch-to-buffer-preserve-window-point' is set,
+ ;; we cannot rely on point being saved, and must commit
+ ;; it to window-prev-buffers.
+ (when switch-to-buffer-preserve-window-point
+ (dolist (frame (frame-list))
+ (walk-window-tree
+ (lambda (window)
+ (let ((prev (assq (current-buffer)
+ (window-prev-buffers window))))
+ (when prev
+ (setf (nth 2 prev) (point-marker)))))
+ frame nil 'nominibuf)))))
;;; Distinguish non-commands
(defvar erc-noncommands-list '(erc-cmd-ME
diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el
index cb9c21fc3c9..03d51d9879c 100644
--- a/lisp/erc/erc-ibuffer.el
+++ b/lisp/erc/erc-ibuffer.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -189,4 +189,3 @@
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el
index 61360f40f5c..42133110a23 100644
--- a/lisp/erc/erc-identd.el
+++ b/lisp/erc/erc-identd.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -55,7 +55,7 @@ This can be either a string or a number."
(integer :tag "Port number")
(string :tag "Port string")))
-;;;###autoload (autoload 'erc-identd-mode "erc-identd")
+;;;###autoload(autoload 'erc-identd-mode "erc-identd")
(define-erc-module identd nil
"This mode launches an identd server on port 8113."
((add-hook 'erc-connect-pre-hook 'erc-identd-quickstart)
@@ -115,7 +115,7 @@ The default port is specified by `erc-identd-port'."
;;; erc-identd.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el
index 95c2b35c699..f74674b8f98 100644
--- a/lisp/erc/erc-imenu.el
+++ b/lisp/erc/erc-imenu.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -131,7 +131,7 @@ Don't rely on this function, read it first!"
;;; erc-imenu.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index aa83ffe92ac..c4d80f0ada5 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -39,7 +39,7 @@
"Enable autojoining."
:group 'erc)
-;;;###autoload (autoload 'erc-autojoin-mode "erc-join" nil t)
+;;;###autoload(autoload 'erc-autojoin-mode "erc-join" nil t)
(define-erc-module autojoin nil
"Makes ERC autojoin on connects and reconnects."
((add-hook 'erc-after-connect 'erc-autojoin-channels)
@@ -215,7 +215,7 @@ This function is run from `erc-nickserv-identified-hook'."
;;; erc-join.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el
index 4aa31529dae..7551b1d2e13 100644
--- a/lisp/erc/erc-lang.el
+++ b/lisp/erc/erc-lang.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -180,7 +180,7 @@ This is based on the technical contents of ISO 639:1988 (E/F)
\"Code for the representation of names of languages\".
Typed by Keld.Simonsen@dkuug.dk 1990-11-30
- <ftp://dkuug.dk/i18n/ISO_639>
+ <ftp://std.dkuug.dk/i18n/iso_639>
Minor corrections, 1992-09-08 by Keld Simonsen
Sundanese corrected, 1992-11-11 by Keld Simonsen
Telugu corrected, 1995-08-24 by Keld Simonsen
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el
index 5110239f61e..7a6ba821134 100644
--- a/lisp/erc/erc-list.el
+++ b/lisp/erc/erc-list.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -55,7 +55,7 @@
(defvar erc-list-server-buffer nil)
;; Define module:
-;;;###autoload (autoload 'erc-list-mode "erc-list")
+;;;###autoload(autoload 'erc-list-mode "erc-list")
(define-erc-module list nil
"List channels nicely in a separate buffer."
((remove-hook 'erc-server-321-functions 'erc-server-321-message)
@@ -145,7 +145,7 @@
(erc-propertize title
'column-number column
'help-echo "mouse-1: sort by column"
- 'mouse-face 'highlight
+ 'mouse-face 'header-line-highlight
'keymap erc-list-menu-sort-button-map))
(define-derived-mode erc-list-menu-mode special-mode "ERC-List"
@@ -225,7 +225,7 @@ to RFC and send the LIST header (#321) at start of list transmission."
;;; erc-list.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el
index 09cffdcd84c..e48d5ff80ee 100644
--- a/lisp/erc/erc-log.el
+++ b/lisp/erc/erc-log.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -215,7 +215,7 @@ The function should take one argument, which is the text to filter."
(const :tag "No filtering" nil)))
-;;;###autoload (autoload 'erc-log-mode "erc-log" nil t)
+;;;###autoload(autoload 'erc-log-mode "erc-log" nil t)
(define-erc-module log nil
"Automatically logs things you receive on IRC into files.
Files are stored in `erc-log-channels-directory'; file name
@@ -455,6 +455,7 @@ You can save every individual message by putting this function on
;;; erc-log.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el
index 3f6b1e546a9..b13b6f7d44a 100644
--- a/lisp/erc/erc-match.el
+++ b/lisp/erc/erc-match.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -44,7 +44,7 @@ Group containing all things concerning pattern matching in ERC
messages."
:group 'erc)
-;;;###autoload (autoload 'erc-match-mode "erc-match")
+;;;###autoload(autoload 'erc-match-mode "erc-match")
(define-erc-module match nil
"This mode checks whether messages match certain patterns. If so,
they are hidden or highlighted. This is controlled via the variables
@@ -648,6 +648,7 @@ This function is meant to be called from `erc-text-matched-hook'."
;;; erc-match.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el
index 9db1e754351..3702886aa3c 100644
--- a/lisp/erc/erc-menu.el
+++ b/lisp/erc/erc-menu.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -107,7 +107,7 @@
"Internal variable used to keep track of whether we've defined the
ERC menu yet.")
-;;;###autoload (autoload 'erc-menu-mode "erc-menu" nil t)
+;;;###autoload(autoload 'erc-menu-mode "erc-menu" nil t)
(define-erc-module menu nil
"Enable a menu in ERC buffers."
((unless erc-menu-defined
@@ -148,7 +148,7 @@ ERC menu yet.")
;;; erc-menu.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el
index 583e071c677..52b671c6114 100644
--- a/lisp/erc/erc-netsplit.el
+++ b/lisp/erc/erc-netsplit.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -38,7 +38,7 @@ netsplit happens, and filters the QUIT messages. It also keeps
track of netsplits, so that it can filter the JOIN messages on a netjoin too."
:group 'erc)
-;;;###autoload (autoload 'erc-netsplit-mode "erc-netsplit")
+;;;###autoload(autoload 'erc-netsplit-mode "erc-netsplit")
(define-erc-module netsplit nil
"This mode hides quit/join messages if a netsplit occurs."
((erc-netsplit-install-message-catalogs)
@@ -151,7 +151,7 @@ join from that split has been detected or not.")
(when (nth 2 ass)
;; There was already a netjoin for this netsplit, it
;; seems like the old one didn't get finished...
- (erc-display-message
+ (erc-display-message
parsed 'notice (process-buffer proc)
'netsplit ?s split)
(setcar (nthcdr 2 ass) t)
@@ -205,7 +205,7 @@ join from that split has been detected or not.")
;;; erc-netsplit.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 59a9356c2ae..bf964bc6ba1 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el
index 54c8bebab30..3f235d3d452 100644
--- a/lisp/erc/erc-notify.el
+++ b/lisp/erc/erc-notify.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -92,7 +92,7 @@ strings."
(notify_on . "Detected %n on IRC network %m")
(notify_off . "%n has left IRC network %m"))))
-;;;###autoload (autoload 'erc-notify-mode "erc-notify" nil t)
+;;;###autoload(autoload 'erc-notify-mode "erc-notify" nil t)
(define-erc-module notify nil
"Periodically check for the online status of certain users and report
changes."
@@ -253,6 +253,7 @@ with args, toggle notify status of people."
;;; erc-notify.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el
index d441b099bb7..20811407e32 100644
--- a/lisp/erc/erc-page.el
+++ b/lisp/erc/erc-page.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,7 +30,7 @@
(require 'erc)
-;;;###autoload (autoload 'erc-page-mode "erc-page")
+;;;###autoload(autoload 'erc-page-mode "erc-page")
(define-erc-module page ctcp-page
"Process CTCP PAGE requests from IRC."
nil nil)
@@ -107,7 +107,7 @@ receive pages if `erc-page-mode' is on."
;;; erc-page.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index 6dfe0a77862..bf20f5c3472 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -60,7 +60,7 @@ the most recent speakers are listed first."
:group 'erc-pcomplete
:type 'boolean)
-;;;###autoload (autoload 'erc-completion-mode "erc-pcomplete" nil t)
+;;;###autoload(autoload 'erc-completion-mode "erc-pcomplete" nil t)
(define-erc-module pcomplete Completion
"In ERC Completion mode, the TAB key does completion whenever possible."
((add-hook 'erc-mode-hook 'pcomplete-erc-setup)
@@ -225,7 +225,7 @@ If optional argument IGNORE-SELF is non-nil, don't return the current nick."
(erc-get-channel-user-list)))
(nicks nil))
(dolist (user users)
- (unless (or (not user)
+ (unless (or (not user)
(and ignore-self
(string= (erc-server-user-nickname (car user))
(erc-current-nick))))
@@ -284,6 +284,6 @@ up to where point is right now."
;;; erc-pcomplete.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: nil
;; End:
-
diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el
index ec443ec0224..35be533939c 100644
--- a/lisp/erc/erc-replace.el
+++ b/lisp/erc/erc-replace.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -77,7 +77,7 @@ It replaces text according to `erc-replace-alist'."
(eval to))))))
erc-replace-alist))
-;;;###autoload (autoload 'erc-replace-mode "erc-replace")
+;;;###autoload(autoload 'erc-replace-mode "erc-replace")
(define-erc-module replace nil
"This mode replaces incoming text according to `erc-replace-alist'."
((add-hook 'erc-insert-modify-hook
@@ -90,7 +90,7 @@ It replaces text according to `erc-replace-alist'."
;;; erc-replace.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el
index 4e31ec20a67..2d6152ccea8 100644
--- a/lisp/erc/erc-ring.el
+++ b/lisp/erc/erc-ring.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -42,7 +42,7 @@
"An input ring for ERC."
:group 'erc)
-;;;###autoload (autoload 'erc-ring-mode "erc-ring" nil t)
+;;;###autoload(autoload 'erc-ring-mode "erc-ring" nil t)
(define-erc-module ring nil
"Stores input in a ring so that previous commands and messages can
be recalled using M-p and M-n."
@@ -146,5 +146,6 @@ containing a password."
;;; erc-ring.el ends here
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: nil
;; End:
diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el
index 6e7c918316a..f18b9d29b5b 100644
--- a/lisp/erc/erc-services.el
+++ b/lisp/erc/erc-services.el
@@ -1,4 +1,4 @@
-;;; erc-services.el --- Identify to NickServ
+;;; erc-services.el --- Identify to NickServ -*- lexical-binding:t -*-
;; Copyright (C) 2002-2004, 2006-2017 Free Software Foundation, Inc.
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -89,7 +89,7 @@ Possible settings are:.
latter.
nil - Disables automatic Nickserv identification.
-You can also use M-x erc-nickserv-identify-mode to change modes."
+You can also use \\[erc-nickserv-identify-mode] to change modes."
:group 'erc-services
:type '(choice (const autodetect)
(const nick-change)
@@ -101,7 +101,7 @@ You can also use M-x erc-nickserv-identify-mode to change modes."
(when (featurep 'erc-services)
(erc-nickserv-identify-mode val))))
-;;;###autoload (autoload 'erc-services-mode "erc-services" nil t)
+;;;###autoload(autoload 'erc-services-mode "erc-services" nil t)
(define-erc-module services nickserv
"This mode automates communication with services."
((erc-nickserv-identify-mode erc-nickserv-identify-mode))
@@ -312,26 +312,33 @@ The last two elements are optional."
(const :tag "Do not try to detect success" nil)))))
-(defsubst erc-nickserv-alist-sender (network &optional entry)
- (nth 1 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-sender (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 1 (or ,entry (assoc ,network erc-nickserv-alist))))))
-(defsubst erc-nickserv-alist-regexp (network &optional entry)
- (nth 2 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-regexp (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 2 (or ,entry (assoc ,network erc-nickserv-alist))))))
-(defsubst erc-nickserv-alist-nickserv (network &optional entry)
- (nth 3 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-nickserv (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 3 (or ,entry (assoc ,network erc-nickserv-alist))))))
-(defsubst erc-nickserv-alist-ident-keyword (network &optional entry)
- (nth 4 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-ident-keyword (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 4 (or ,entry (assoc ,network erc-nickserv-alist))))))
-(defsubst erc-nickserv-alist-use-nick-p (network &optional entry)
- (nth 5 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-use-nick-p (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 5 (or ,entry (assoc ,network erc-nickserv-alist))))))
-(defsubst erc-nickserv-alist-ident-command (network &optional entry)
- (nth 6 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-ident-command (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 6 (or ,entry (assoc ,network erc-nickserv-alist))))))
-(defsubst erc-nickserv-alist-identified-regexp (network &optional entry)
- (nth 7 (or entry (assoc network erc-nickserv-alist))))
+(define-inline erc-nickserv-alist-identified-regexp (network &optional entry)
+ (inline-letevals (network entry)
+ (inline-quote (nth 7 (or ,entry (assoc ,network erc-nickserv-alist))))))
;; Functions:
@@ -341,7 +348,7 @@ Hooks are called with arguments (NETWORK NICK)."
:group 'erc-services
:type 'hook)
-(defun erc-nickserv-identification-autodetect (proc parsed)
+(defun erc-nickserv-identification-autodetect (_proc parsed)
"Check for NickServ's successful identification notice.
Make sure it is the real NickServ for this network and that it has
specifically confirmed a successful identification attempt.
@@ -361,7 +368,7 @@ If this is the case, run `erc-nickserv-identified-hook'."
(run-hook-with-args 'erc-nickserv-identified-hook network nick)
nil)))
-(defun erc-nickserv-identify-autodetect (proc parsed)
+(defun erc-nickserv-identify-autodetect (_proc parsed)
"Identify to NickServ when an identify request is received.
Make sure it is the real NickServ for this network.
If `erc-prompt-for-nickserv-password' is non-nil, prompt the user for the
@@ -383,7 +390,7 @@ password for this nickname, otherwise try to send it automatically."
(erc-nickserv-call-identify-function nick)
nil))))
-(defun erc-nickserv-identify-on-connect (server nick)
+(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))
@@ -391,7 +398,7 @@ password for this nickname, otherwise try to send it automatically."
(erc-nickserv-alist-regexp (erc-network))))
(erc-nickserv-call-identify-function nick)))
-(defun erc-nickserv-identify-on-nick-change (nick old-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))
@@ -400,9 +407,9 @@ password for this nickname, otherwise try to send it automatically."
(erc-nickserv-call-identify-function nick)))
(defun erc-nickserv-call-identify-function (nickname)
- "Call `erc-nickserv-identify' interactively or run it with NICKNAME's
-password.
-The action is determined by the value of `erc-prompt-for-nickserv-password'."
+ "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
@@ -411,6 +418,8 @@ The action is determined by the value of `erc-prompt-for-nickserv-password'."
(nth 1 (assoc (erc-network)
erc-nickserv-passwords))))))))
+(defvar erc-auto-discard-away)
+
;;;###autoload
(defun erc-nickserv-identify (password)
"Send an \"identify <PASSWORD>\" message to NickServ.
@@ -444,6 +453,7 @@ When called interactively, read the password using `read-passwd'."
;;; erc-services.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el
index 4ca7a59bbba..ddf32b6dd7a 100644
--- a/lisp/erc/erc-sound.el
+++ b/lisp/erc/erc-sound.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,7 +46,7 @@
(require 'erc)
-;;;###autoload (autoload 'erc-sound-mode "erc-sound")
+;;;###autoload(autoload 'erc-sound-mode "erc-sound")
(define-erc-module sound ctcp-sound
"In ERC sound mode, the client will respond to CTCP SOUND requests
and play sound files as requested."
@@ -145,7 +145,7 @@ See also `play-sound-file'."
;;; erc-sound.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el
index 4f44f415fdd..5b052f0686c 100644
--- a/lisp/erc/erc-speedbar.el
+++ b/lisp/erc/erc-speedbar.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -361,6 +361,7 @@ The INDENT level is ignored."
;;; erc-speedbar.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el
index 9b0e5faaf64..25c5450161b 100644
--- a/lisp/erc/erc-spelling.el
+++ b/lisp/erc/erc-spelling.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -33,7 +33,7 @@
(require 'erc)
(require 'flyspell)
-;;;###autoload (autoload 'erc-spelling-mode "erc-spelling" nil t)
+;;;###autoload(autoload 'erc-spelling-mode "erc-spelling" nil t)
(define-erc-module spelling nil
"Enable flyspell mode in ERC buffers."
;; Use erc-connect-pre-hook instead of erc-mode-hook as pre-hook is
@@ -109,3 +109,7 @@ The cadr is the beginning and the caddr is the end."
(provide 'erc-spelling)
;;; erc-spelling.el ends here
+
+;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
+;; End:
diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el
index 7ce22b380db..9f1b7fc968a 100644
--- a/lisp/erc/erc-stamp.el
+++ b/lisp/erc/erc-stamp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -158,7 +158,7 @@ from entering them and instead jump over them."
"ERC timestamp face."
:group 'erc-faces)
-;;;###autoload (autoload 'erc-timestamp-mode "erc-stamp" nil t)
+;;;###autoload(autoload 'erc-timestamp-mode "erc-stamp" nil t)
(define-erc-module stamp timestamp
"This mode timestamps messages in the channel buffers."
((add-hook 'erc-mode-hook #'erc-munge-invisibility-spec)
@@ -417,7 +417,7 @@ enabled when the message was inserted."
;;; erc-stamp.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el
index c49971e872a..b94b6de8833 100644
--- a/lisp/erc/erc-track.el
+++ b/lisp/erc/erc-track.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -542,7 +542,7 @@ keybindings will not do anything useful."
;;; Module
-;;;###autoload (autoload 'erc-track-mode "erc-track" nil t)
+;;;###autoload(autoload 'erc-track-mode "erc-track" nil t)
(define-erc-module track nil
"This mode tracks ERC channel buffers with activity."
;; Enable:
@@ -974,6 +974,7 @@ switch back to the last non-ERC buffer visited. Next is defined by
;;; erc-track.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el
index 7f5bb326b7f..acd8f63bb16 100644
--- a/lisp/erc/erc-truncate.el
+++ b/lisp/erc/erc-truncate.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -43,7 +43,7 @@ Used only when auto-truncation is enabled.
:group 'erc-truncate
:type 'integer)
-;;;###autoload (autoload 'erc-truncate-mode "erc-truncate" nil t)
+;;;###autoload(autoload 'erc-truncate-mode "erc-truncate" nil t)
(define-erc-module truncate nil
"Truncate a query buffer if it gets too large.
This prevents the query buffer from getting too large, which can
@@ -112,7 +112,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'."
;;; erc-truncate.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el
index 4b0b7b9afa2..6732c9cdc6e 100644
--- a/lisp/erc/erc-xdcc.el
+++ b/lisp/erc/erc-xdcc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -61,7 +61,7 @@ being evaluated and should return strings."
:group 'erc-dcc
:type '(repeat (repeat :tag "Message" (choice string sexp))))
-;;;###autoload (autoload 'erc-xdcc-mode "erc-xdcc")
+;;;###autoload(autoload 'erc-xdcc-mode "erc-xdcc")
(define-erc-module xdcc nil
"Act as an XDCC file-server."
nil nil)
@@ -133,7 +133,7 @@ being evaluated and should return strings."
;;; erc-xdcc.el ends here
;;
;; Local Variables:
+;; generated-autoload-file: "erc-loaddefs.el"
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 8547821f080..eee79464a9a 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -28,20 +28,20 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; ERC is a powerful, modular, and extensible IRC client for Emacs.
;; For more information, see the following URLs:
-;; * http://sv.gnu.org/projects/erc/
+;; * https://sv.gnu.org/projects/erc/
;; * http://www.emacswiki.org/cgi-bin/wiki/ERC
;; As of 2006-06-13, ERC development is now hosted on Savannah
-;; (http://sv.gnu.org/projects/erc). I invite everyone who wants to
+;; (https://sv.gnu.org/projects/erc). I invite everyone who wants to
;; hack on it to contact me <mwolson@gnu.org> in order to get write
;; access to the shared Arch archive.
@@ -67,6 +67,8 @@
;;; Code:
+(load "erc-loaddefs" nil t)
+
(eval-when-compile (require 'cl-lib))
(require 'font-lock)
(require 'pp)
@@ -75,7 +77,7 @@
(require 'erc-compat)
(defvar erc-official-location
- "http://emacswiki.org/cgi-bin/wiki/ERC (mailing list: erc-discuss@gnu.org)"
+ "https://emacswiki.org/cgi-bin/wiki/ERC (mailing list: erc-discuss@gnu.org)"
"Location of the ERC client on the Internet.")
(defgroup erc nil
@@ -399,25 +401,28 @@ If no server buffer exists, return nil."
;; This is useful for ordered name completion.
(last-message-time nil))
-(defsubst erc-get-channel-user (nick)
+(define-inline erc-get-channel-user (nick)
"Find the (USER . CHANNEL-DATA) element corresponding to NICK
in the current buffer's `erc-channel-users' hash table."
- (gethash (erc-downcase nick) erc-channel-users))
+ (inline-quote (gethash (erc-downcase ,nick) erc-channel-users)))
-(defsubst erc-get-server-user (nick)
+(define-inline erc-get-server-user (nick)
"Find the USER corresponding to NICK in the current server's
`erc-server-users' hash table."
- (erc-with-server-buffer
- (gethash (erc-downcase nick) erc-server-users)))
+ (inline-letevals (nick)
+ (inline-quote (erc-with-server-buffer
+ (gethash (erc-downcase ,nick) erc-server-users)))))
-(defsubst erc-add-server-user (nick user)
+(define-inline erc-add-server-user (nick user)
"This function is for internal use only.
Adds USER with nickname NICK to the `erc-server-users' hash table."
- (erc-with-server-buffer
- (puthash (erc-downcase nick) user erc-server-users)))
+ (inline-letevals (nick user)
+ (inline-quote
+ (erc-with-server-buffer
+ (puthash (erc-downcase ,nick) ,user erc-server-users)))))
-(defsubst erc-remove-server-user (nick)
+(define-inline erc-remove-server-user (nick)
"This function is for internal use only.
Removes the user with nickname NICK from the `erc-server-users'
@@ -425,8 +430,10 @@ hash table. This user is not removed from the
`erc-channel-users' lists of other buffers.
See also: `erc-remove-user'."
- (erc-with-server-buffer
- (remhash (erc-downcase nick) erc-server-users)))
+ (inline-letevals (nick)
+ (inline-quote
+ (erc-with-server-buffer
+ (remhash (erc-downcase ,nick) erc-server-users)))))
(defun erc-change-user-nickname (user new-nick)
"This function is for internal use only.
@@ -497,45 +504,55 @@ Removes all users in the current channel. This is called by
erc-channel-users)
(clrhash erc-channel-users)))
-(defsubst erc-channel-user-owner-p (nick)
+(define-inline erc-channel-user-owner-p (nick)
"Return non-nil if NICK is an owner of the current channel."
- (and nick
- (hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user nick)))
- (and cdata (cdr cdata)
- (erc-channel-user-owner (cdr cdata))))))
-
-(defsubst erc-channel-user-admin-p (nick)
+ (inline-letevals (nick)
+ (inline-quote
+ (and ,nick
+ (hash-table-p erc-channel-users)
+ (let ((cdata (erc-get-channel-user ,nick)))
+ (and cdata (cdr cdata)
+ (erc-channel-user-owner (cdr cdata))))))))
+
+(define-inline erc-channel-user-admin-p (nick)
"Return non-nil if NICK is an admin in the current channel."
- (and nick
+ (inline-letevals (nick)
+ (inline-quote
+ (and ,nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user nick)))
+ (let ((cdata (erc-get-channel-user ,nick)))
(and cdata (cdr cdata)
- (erc-channel-user-admin (cdr cdata))))))
+ (erc-channel-user-admin (cdr cdata))))))))
-(defsubst erc-channel-user-op-p (nick)
+(define-inline erc-channel-user-op-p (nick)
"Return non-nil if NICK is an operator in the current channel."
- (and nick
+ (inline-letevals (nick)
+ (inline-quote
+ (and ,nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user nick)))
+ (let ((cdata (erc-get-channel-user ,nick)))
(and cdata (cdr cdata)
- (erc-channel-user-op (cdr cdata))))))
+ (erc-channel-user-op (cdr cdata))))))))
-(defsubst erc-channel-user-halfop-p (nick)
+(define-inline erc-channel-user-halfop-p (nick)
"Return non-nil if NICK is a half-operator in the current channel."
- (and nick
+ (inline-letevals (nick)
+ (inline-quote
+ (and ,nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user nick)))
+ (let ((cdata (erc-get-channel-user ,nick)))
(and cdata (cdr cdata)
- (erc-channel-user-halfop (cdr cdata))))))
+ (erc-channel-user-halfop (cdr cdata))))))))
-(defsubst erc-channel-user-voice-p (nick)
+(define-inline erc-channel-user-voice-p (nick)
"Return non-nil if NICK has voice in the current channel."
- (and nick
+ (inline-letevals (nick)
+ (inline-quote
+ (and ,nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user nick)))
+ (let ((cdata (erc-get-channel-user ,nick)))
(and cdata (cdr cdata)
- (erc-channel-user-voice (cdr cdata))))))
+ (erc-channel-user-voice (cdr cdata))))))))
(defun erc-get-channel-user-list ()
"Return a list of users in the current channel. Each element
@@ -1260,7 +1277,7 @@ erc-NAME-enable, and erc-NAME-disable.
Example:
- ;;;###autoload (autoload \\='erc-replace-mode \"erc-replace\")
+ ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\")
(define-erc-module replace nil
\"This mode replaces incoming text according to `erc-replace-alist'.\"
((add-hook \\='erc-insert-modify-hook
@@ -1343,10 +1360,11 @@ capabilities."
(add-hook hook fun nil t)
fun))
-(defsubst erc-log (string)
+(define-inline erc-log (string)
"Logs STRING if logging is on (see `erc-log-p')."
- (when erc-log-p
- (erc-log-aux string)))
+ (inline-quote
+ (when erc-log-p
+ (erc-log-aux ,string))))
(defun erc-server-buffer ()
"Return the server buffer for the current buffer's process.
@@ -2548,9 +2566,7 @@ consumption for long-lived IRC or Emacs sessions."
(maphash
(lambda (nick last-PRIVMSG-time)
(when
- (> (float-time (time-subtract
- (current-time)
- last-PRIVMSG-time))
+ (> (float-time (time-subtract nil last-PRIVMSG-time))
erc-lurker-threshold-time)
(remhash nick hash)))
hash)
@@ -2617,7 +2633,7 @@ server within `erc-lurker-threshold-time'. See also
(gethash server erc-lurker-state (make-hash-table)))))
(or (null last-PRIVMSG-time)
(> (float-time
- (time-subtract (current-time) last-PRIVMSG-time))
+ (time-subtract nil last-PRIVMSG-time))
erc-lurker-threshold-time))))
(defcustom erc-common-server-suffixes
@@ -2650,9 +2666,9 @@ otherwise `erc-server-announced-name'. SERVER is matched against
"Predicate indicating whether the parsed ERC response PARSED should be hidden.
Messages are always hidden if the message type of PARSED appears in
-`erc-hide-list'. Message types that appear in `erc-network-hide-list'
-or `erc-channel-hide-list' are are only hidden if the target matches
-the network or channel in the list. In addition, messages whose type
+`erc-hide-list'. Message types that appear in `erc-network-hide-list'
+or `erc-channel-hide-list' are only hidden if the target matches
+the network or channel in the list. In addition, messages whose type
is a member of `erc-lurker-hide-list' are hidden if `erc-lurker-p'
returns non-nil."
(let* ((command (erc-response.command parsed))
diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el
index 5bf80b2310a..742234574f3 100644
--- a/lisp/eshell/em-alias.el
+++ b/lisp/eshell/em-alias.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -214,8 +214,8 @@ file named by `eshell-aliases-file'.")
(defvar eshell-prevent-alias-expansion nil)
-(defun eshell-maybe-replace-by-alias (command args)
- "If COMMAND has an alias definition, call that instead using ARGS."
+(defun eshell-maybe-replace-by-alias (command _args)
+ "Call COMMAND's alias definition, if it exists."
(unless (and eshell-prevent-alias-expansion
(member command eshell-prevent-alias-expansion))
(let ((alias (eshell-lookup-alias command)))
diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el
index aee7daa49f3..268b4289f4a 100644
--- a/lisp/eshell/em-banner.el
+++ b/lisp/eshell/em-banner.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el
index c570d7cca89..33ce3b5e93a 100644
--- a/lisp/eshell/em-basic.el
+++ b/lisp/eshell/em-basic.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -50,12 +50,6 @@
;;
;; The umask command changes the default file permissions for newly
;; created files. It uses the same syntax as bash.
-;;
-;;;_* `version'
-;;
-;; This command reports the version number for Eshell and all its
-;; dependent module, including the date when those modules were last
-;; modified.
;;; Code:
diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el
index 571348620bf..89826bebb76 100644
--- a/lisp/eshell/em-cmpl.el
+++ b/lisp/eshell/em-cmpl.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -136,75 +136,70 @@ to writing a completion function."
:type '(repeat (cons string regexp))
:group 'eshell-cmpl)
+(defun eshell-cmpl--custom-variable-docstring (pcomplete-var)
+ "Generate the docstring of a variable derived from a pcomplete-* variable."
+ (format "%s\n\nIts value is assigned to `%s' locally after eshell starts."
+ (documentation-property pcomplete-var
+ 'variable-documentation t)
+ (symbol-name pcomplete-var)))
+
(defcustom eshell-cmpl-file-ignore "~\\'"
- (documentation-property 'pcomplete-file-ignore
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-file-ignore)
:type (get 'pcomplete-file-ignore 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-dir-ignore "\\`\\(\\.\\.?\\|CVS\\)/\\'"
- (documentation-property 'pcomplete-dir-ignore
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-dir-ignore)
:type (get 'pcomplete-dir-ignore 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-ignore-case (eshell-under-windows-p)
- (documentation-property 'pcomplete-ignore-case
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-ignore-case)
:type (get 'pcomplete-ignore-case 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-autolist nil
- (documentation-property 'pcomplete-autolist
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-autolist)
:type (get 'pcomplete-autolist 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-suffix-list (list ?/ ?:)
- (documentation-property 'pcomplete-suffix-list
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-suffix-list)
:type (get 'pcomplete-suffix-list 'custom-type)
:group 'pcomplete)
(defcustom eshell-cmpl-recexact nil
- (documentation-property 'pcomplete-recexact
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-recexact)
:type (get 'pcomplete-recexact 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-man-function 'man
- (documentation-property 'pcomplete-man-function
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-man-function)
:type (get 'pcomplete-man-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-compare-entry-function 'file-newer-than-file-p
- (documentation-property 'pcomplete-compare-entry-function
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-compare-entry-function)
:type (get 'pcomplete-compare-entry-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-expand-before-complete nil
- (documentation-property 'pcomplete-expand-before-complete
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-expand-before-complete)
:type (get 'pcomplete-expand-before-complete 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-cycle-completions t
- (documentation-property 'pcomplete-cycle-completions
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-cycle-completions)
:type (get 'pcomplete-cycle-completions 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-cycle-cutoff-length 5
- (documentation-property 'pcomplete-cycle-cutoff-length
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-cycle-cutoff-length)
:type (get 'pcomplete-cycle-cutoff-length 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-restore-window-delay 1
- (documentation-property 'pcomplete-restore-window-delay
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-restore-window-delay)
:type (get 'pcomplete-restore-window-delay 'custom-type)
:group 'eshell-cmpl)
@@ -212,15 +207,13 @@ to writing a completion function."
(function
(lambda ()
(pcomplete-here (eshell-complete-commands-list))))
- (documentation-property 'pcomplete-command-completion-function
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-command-completion-function)
:type (get 'pcomplete-command-completion-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-command-name-function
'eshell-completion-command-name
- (documentation-property 'pcomplete-command-name-function
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-command-name-function)
:type (get 'pcomplete-command-name-function 'custom-type)
:group 'eshell-cmpl)
@@ -231,13 +224,12 @@ to writing a completion function."
(pcomplete-dirs-or-entries
(cdr (assoc (funcall eshell-cmpl-command-name-function)
eshell-command-completions-alist)))))))
- (documentation-property 'pcomplete-default-completion-function
- 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-default-completion-function)
:type (get 'pcomplete-default-completion-function 'custom-type)
:group 'eshell-cmpl)
(defcustom eshell-cmpl-use-paring t
- (documentation-property 'pcomplete-use-paring 'variable-documentation)
+ (eshell-cmpl--custom-variable-docstring 'pcomplete-use-paring)
:type (get 'pcomplete-use-paring 'custom-type)
:group 'eshell-cmpl)
diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el
index c10ff16ef26..0d87f2a599e 100644
--- a/lisp/eshell/em-dirs.el
+++ b/lisp/eshell/em-dirs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el
index fee3ff20981..11d7ffcfc53 100644
--- a/lisp/eshell/em-glob.el
+++ b/lisp/eshell/em-glob.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el
index 5c6e6291209..df462a70587 100644
--- a/lisp/eshell/em-hist.el
+++ b/lisp/eshell/em-hist.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -218,9 +218,6 @@ Returns nil if INPUT is prepended by blank space, otherwise non-nil."
(defun eshell-hist-initialize ()
"Initialize the history management code for one Eshell buffer."
- (add-hook 'eshell-expand-input-functions
- 'eshell-expand-history-references nil t)
-
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-history-reference nil t))
@@ -444,7 +441,6 @@ line, with the most recent command last. See also
(ignore-dups eshell-hist-ignoredups))
(with-temp-buffer
(insert-file-contents file)
- ;; Save restriction in case file is already visited...
;; Watch for those date stamps in history files!
(goto-char (point-max))
(while (and (< count size)
@@ -488,7 +484,9 @@ See also `eshell-read-history'."
(while (> index 0)
(setq index (1- index))
(let ((start (point)))
- (insert (ring-ref ring index) ?\n)
+ ;; Remove properties before inserting, to avoid trouble
+ ;; with read-only strings (Bug#28700).
+ (insert (substring-no-properties (ring-ref ring index)) ?\n)
(subst-char-in-region start (1- (point)) ?\n ?\177)))
(eshell-with-private-file-modes
(write-region (point-min) (point-max) file append
diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el
index 79799db30bc..bb087d2feba 100644
--- a/lisp/eshell/em-ls.el
+++ b/lisp/eshell/em-ls.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -65,17 +65,19 @@ This is useful for enabling human-readable format (-h), for example."
"If non-nil, use `eshell-ls' to read directories in Dired.
Changing this without using customize has no effect."
:set (lambda (symbol value)
- (if value
- (advice-add 'insert-directory :around
- #'eshell-ls--insert-directory)
- (advice-remove 'insert-directory
- #'eshell-ls--insert-directory))
+ (cond (value
+ (require 'dired)
+ (advice-add 'insert-directory :around
+ #'eshell-ls--insert-directory)
+ (advice-add 'dired :around #'eshell-ls--dired))
+ (t
+ (advice-remove 'insert-directory
+ #'eshell-ls--insert-directory)
+ (advice-remove 'dired #'eshell-ls--dired)))
(set symbol value))
:type 'boolean
:require 'em-ls)
-(add-hook 'eshell-ls-unload-hook
- (lambda () (advice-remove 'insert-directory
- #'eshell-ls--insert-directory)))
+(add-hook 'eshell-ls-unload-hook #'eshell-ls-unload-function)
(defcustom eshell-ls-default-blocksize 1024
@@ -241,6 +243,9 @@ scope during the evaluation of TEST-SEXP."
;;; Functions:
+(declare-function eshell-extended-glob "em-glob" (glob))
+(defvar eshell-error-if-no-glob)
+
(defun eshell-ls--insert-directory
(orig-fun file switches &optional wildcard full-directory-p)
"Insert directory listing for FILE, formatted according to SWITCHES.
@@ -273,11 +278,53 @@ instead."
(set 'font-lock-buffers
(delq (current-buffer)
(symbol-value 'font-lock-buffers)))))
- (let ((insert-func 'insert)
- (error-func 'insert)
- (flush-func 'ignore)
- eshell-ls-dired-initial-args)
- (eshell-do-ls (append switches (list file)))))))))
+ (require 'em-glob)
+ (let* ((insert-func 'insert)
+ (error-func 'insert)
+ (flush-func 'ignore)
+ (eshell-error-if-no-glob t)
+ (target ; Expand the shell wildcards if any.
+ (if (and (atom file)
+ (string-match "[[?*]" file)
+ (not (file-exists-p file)))
+ (mapcar #'file-relative-name (eshell-extended-glob file))
+ (file-relative-name file)))
+ (switches
+ (append eshell-ls-dired-initial-args
+ (and (or (consp dired-directory) wildcard) (list "-d"))
+ switches)))
+ (eshell-do-ls (nconc switches (list target)))))))))
+
+
+(declare-function eshell-extended-glob "em-glob" (glob))
+(declare-function dired-read-dir-and-switches "dired" (str))
+(declare-function dired-goto-next-file "dired" ())
+
+(defun eshell-ls--dired (orig-fun dir-or-list &optional switches)
+ (interactive (dired-read-dir-and-switches ""))
+ (require 'em-glob)
+ (if (consp dir-or-list)
+ (funcall orig-fun dir-or-list switches)
+ (let ((dir-wildcard (insert-directory-wildcard-in-dir-p
+ (expand-file-name dir-or-list))))
+ (if (not dir-wildcard)
+ (funcall orig-fun dir-or-list switches)
+ (let* ((default-directory (car dir-wildcard))
+ (files (eshell-extended-glob (cdr dir-wildcard)))
+ (dir (car dir-wildcard)))
+ (if files
+ (let ((inhibit-read-only t)
+ (buf
+ (apply orig-fun
+ (nconc (list dir) files)
+ (and switches (list switches)))))
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (forward-line 0)
+ (insert " wildcard " (cdr dir-wildcard) "\n"))))
+ (user-error "No files matching regexp")))))))
(defsubst eshell/ls (&rest args)
"An alias version of `eshell-do-ls'."
@@ -909,6 +956,11 @@ to use, and each member of which is the width of that column
(car file)))))
(car file))
+(defun eshell-ls-unload-function ()
+ (advice-remove 'insert-directory #'eshell-ls--insert-directory)
+ (advice-remove 'dired #'eshell-ls--dired)
+ nil)
+
(provide 'em-ls)
;; Local Variables:
diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el
index 9e6890ebc97..72a7bc4afcb 100644
--- a/lisp/eshell/em-pred.el
+++ b/lisp/eshell/em-pred.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index 53a83e6a67b..76dd13ff842 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -117,6 +117,8 @@ arriving, or after."
(defun eshell-emit-prompt ()
"Emit a prompt if eshell is being used interactively."
+ (when (boundp 'ansi-color-context-region)
+ (setq ansi-color-context-region nil))
(run-hooks 'eshell-before-prompt-hook)
(if (not eshell-prompt-function)
(set-marker eshell-last-output-end (point))
@@ -159,14 +161,25 @@ If N is negative, find the previous or Nth previous match."
"Move to end of Nth next prompt in the buffer.
See `eshell-prompt-regexp'."
(interactive "p")
- (forward-paragraph n)
+ (if eshell-highlight-prompt
+ (progn
+ (while (< n 0)
+ (while (and (re-search-backward eshell-prompt-regexp nil t)
+ (not (get-text-property (match-beginning 0) 'read-only))))
+ (setq n (1+ n)))
+ (while (> n 0)
+ (while (and (re-search-forward eshell-prompt-regexp nil t)
+ (not (get-text-property (match-beginning 0) 'read-only))))
+ (setq n (1- n))))
+ (re-search-forward eshell-prompt-regexp nil t n))
(eshell-skip-prompt))
(defun eshell-previous-prompt (n)
"Move to end of Nth previous prompt in the buffer.
See `eshell-prompt-regexp'."
(interactive "p")
- (eshell-next-prompt (- (1+ n))))
+ (beginning-of-line) ; Don't count prompt on current line.
+ (eshell-next-prompt (- n)))
(defun eshell-skip-prompt ()
"Skip past the text matching regexp `eshell-prompt-regexp'.
diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el
index a1f9054daed..07f4318e58c 100644
--- a/lisp/eshell/em-rebind.el
+++ b/lisp/eshell/em-rebind.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index b8333adf550..bbc2f9acf6b 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index 718198689f3..f79f46387b7 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el
index ea38f12124a..261a32e97cf 100644
--- a/lisp/eshell/em-term.el
+++ b/lisp/eshell/em-term.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index d2697227bc0..e322cea1e21 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 86e0d829a14..e5c799ea167 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -961,7 +961,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
;; after setting
(throw 'eshell-replace-command
(eshell-parse-command (car time-args)
-;;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2007-08/msg00205.html
+;;; https://lists.gnu.org/r/bug-gnu-emacs/2007-08/msg00205.html
(eshell-stringify-list
(eshell-flatten-list (cdr time-args))))))))
diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el
index fe839de03ac..7b80f64d629 100644
--- a/lisp/eshell/em-xtra.el
+++ b/lisp/eshell/em-xtra.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 7843ca166be..b317f4e1d2a 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 86e7b83c281..6c26af8999f 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1148,6 +1148,8 @@ be finished later after the completion of an asynchronous subprocess."
;; command invocation
+(declare-function help-fns-function-description-header "help-fns")
+
(defun eshell/which (command &rest names)
"Identify the COMMAND, and where it is located."
(dolist (name (cons command names))
@@ -1164,25 +1166,17 @@ be finished later after the completion of an asynchronous subprocess."
(concat name " is an alias, defined as \""
(cadr alias) "\"")))
(unless program
- (setq program (eshell-search-path name))
- (let* ((esym (eshell-find-alias-function name))
- (sym (or esym (intern-soft name))))
- (if (and (or esym (and sym (fboundp sym)))
- (or eshell-prefer-lisp-functions (not direct)))
- (let ((desc (let ((inhibit-redisplay t))
- (save-window-excursion
- (prog1
- (describe-function sym)
- (message nil))))))
- (setq desc (if desc (substring desc 0
- (1- (or (string-match "\n" desc)
- (length desc))))
- ;; This should not happen.
- (format "%s is defined, \
-but no documentation was found" name)))
- (if (buffer-live-p (get-buffer "*Help*"))
- (kill-buffer "*Help*"))
- (setq program (or desc name))))))
+ (setq program
+ (let* ((esym (eshell-find-alias-function name))
+ (sym (or esym (intern-soft name))))
+ (if (and (or esym (and sym (fboundp sym)))
+ (or eshell-prefer-lisp-functions (not direct)))
+ (or (with-output-to-string
+ (require 'help-fns)
+ (princ (format "%s is " sym))
+ (help-fns-function-description-header sym))
+ name)
+ (eshell-search-path name)))))
(if (not program)
(eshell-error (format "which: no %s in (%s)\n"
name (getenv "PATH")))
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index 0b292306ff1..14ae6b4ae1d 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el
index 97d48c1fd08..ca791982f56 100644
--- a/lisp/eshell/esh-io.el
+++ b/lisp/eshell/esh-io.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 0fd0c183016..ea2fe1a6c26 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -726,7 +726,9 @@ This is done after all necessary filtering has been done."
(setq obeg (+ obeg nchars)))
(if (<= (point) oend)
(setq oend (+ oend nchars)))
- (insert-before-markers string)
+ ;; Let the ansi-color overlay hooks run.
+ (let ((inhibit-modification-hooks nil))
+ (insert-before-markers string))
(if (= (window-start) (point))
(set-window-start (selected-window)
(- (point) nchars)))
diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el
index cbff8c84115..fe4c88e1cfd 100644
--- a/lisp/eshell/esh-module.el
+++ b/lisp/eshell/esh-module.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el
index 59757ab6ebb..c141fe0bcea 100644
--- a/lisp/eshell/esh-opt.el
+++ b/lisp/eshell/esh-opt.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index ba5cb5c2db7..3e9ac281a10 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index d65839b72a0..8b24ec3c430 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -142,7 +142,7 @@ function `string-to-number'."
(defmacro eshell-condition-case (tag form &rest handlers)
"If `eshell-handle-errors' is non-nil, this is `condition-case'.
Otherwise, evaluates FORM with no error handling."
- (declare (indent 2))
+ (declare (indent 2) (debug (sexp form &rest form)))
(if eshell-handle-errors
`(condition-case-unless-debug ,tag
,form
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index cdd05bd7e9a..d038609d957 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index faf5f89d64f..f85f0e82b38 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/expand.el b/lisp/expand.el
index d06287e6f9b..7dab2051f11 100644
--- a/lisp/expand.el
+++ b/lisp/expand.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/ezimage.el b/lisp/ezimage.el
index 25e0ed306a7..115ebc5670c 100644
--- a/lisp/ezimage.el
+++ b/lisp/ezimage.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 4e6ada8acd3..129b90301ba 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
index ae5865d7399..5db640ba254 100644
--- a/lisp/facemenu.el
+++ b/lisp/facemenu.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/faces.el b/lisp/faces.el
index 9a8a1344caf..d8ec454e626 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -102,11 +102,18 @@ a font height that isn't optimal."
;; Monospace Serif is an Emacs invention, intended to work around
;; portability problems when using Courier. It should work well
;; when combined with Monospaced and with other standard fonts.
+ ;; One of its uses is for 'tex-verbatim' and 'Info-quoted' faces,
+ ;; so the result must be different from the default face's font,
+ ;; and must be monospaced. For 'tex-verbatim', it is desirable
+ ;; that the font really is a Serif font, so as to look like
+ ;; TeX's 'verbatim'.
("Monospace Serif"
;; This looks good on GNU/Linux.
"Courier 10 Pitch"
- ;; This looks good on MS-Windows and OS X.
+ ;; This looks good on MS-Windows and OS X. Note that this is
+ ;; actually a sans-serif font, but it's here for lack of a better
+ ;; alternative.
"Consolas"
;; This looks good on macOS. "Courier" looks good too, but is
;; jagged on GNU/Linux and so is listed later as "courier".
@@ -1447,7 +1454,7 @@ If FRAME is omitted or nil, use the selected frame."
(setq face (list face)))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (dolist (f face)
+ (dolist (f face (buffer-string))
(if (stringp f) (setq f (intern f)))
;; We may get called for anonymous faces (i.e., faces
;; expressed using prop-value plists). Those can't be
@@ -2354,7 +2361,7 @@ If you set `term-file-prefix' to nil, this function does nothing."
(defface variable-pitch
'((((type w32))
;; This is a workaround for an issue discussed in
- ;; http://lists.gnu.org/archive/html/emacs-devel/2016-04/msg00746.html.
+ ;; https://lists.gnu.org/r/emacs-devel/2016-04/msg00746.html.
;; We need (a) the splash screen not to pick up bold-italics variant of
;; the font, and (b) still be able to request bold/italic/larger size
;; variants in the likes of EWW.
@@ -2465,6 +2472,35 @@ If you set `term-file-prefix' to nil, this function does nothing."
:version "21.1"
:group 'basic-faces)
+;; Definition stolen from linum.el.
+(defface line-number
+ '((t :inherit (shadow default)))
+ "Face for displaying line numbers.
+This face is used when `display-line-numbers' is non-nil.
+
+If you customize the font of this face, make sure it is a
+monospaced font, otherwise line numbers will not line up,
+and text lines might move horizontally as you move through
+the buffer."
+ :version "26.1"
+ :group 'basic-faces
+ :group 'display-line-numbers)
+
+(defface line-number-current-line
+ '((t :inherit line-number))
+ "Face for displaying the current line number.
+This face is used when `display-line-numbers' is non-nil.
+
+If you customize the font of this face, make sure it is a
+monospaced font, otherwise line numbers will not line up,
+and text lines might move horizontally as you move through
+the buffer. Similarly, making this face's font different
+from that of the `line-number' face could produce such
+unwanted effects."
+ :version "26.1"
+ :group 'basic-faces
+ :group 'display-line-numbers)
+
(defface escape-glyph
'((((background dark)) :foreground "cyan")
;; See the comment in minibuffer-prompt for
@@ -2594,6 +2630,11 @@ Use the face `mode-line-highlight' for features that can be selected."
:version "21.1"
:group 'basic-faces)
+(defface header-line-highlight '((t :inherit highlight))
+ "Basic header line face for highlighting."
+ :version "26.1"
+ :group 'basic-faces)
+
(defface vertical-border
'((((type tty)) :inherit mode-line-inactive))
"Face used for vertical window dividers on ttys."
@@ -2815,6 +2856,13 @@ It is used for characters of no fonts too."
"Face used for a matching paren."
:group 'paren-showing-faces)
+(defface show-paren-match-expression
+ '((t :inherit show-paren-match))
+ "Face used for a matching paren when highlighting the whole expression.
+This face is used by `show-paren-mode'."
+ :group 'paren-showing-faces
+ :version "26.1")
+
(defface show-paren-mismatch
'((((class color)) (:foreground "white" :background "purple"))
(t (:inverse-video t)))
diff --git a/lisp/ffap.el b/lisp/ffap.el
index 87531110b86..a776668d109 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -6,7 +6,6 @@
;; Maintainer: emacs-devel@gnu.org
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
-;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
;; This file is part of GNU Emacs.
@@ -21,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -787,7 +786,7 @@ This uses `ffap-file-exists-string', which may try adding suffixes from
("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z|
;; This used to have a blank, but ffap-string-at-point doesn't
;; handle blanks.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01058.html
+ ;; https://lists.gnu.org/r/emacs-devel/2008-01/msg01058.html
("\\`[Rr][Ff][Cc][-#]?\\([0-9]+\\)" ; no $
. ffap-rfc) ; "100% RFC2100 compliant"
(dired-mode . ffap-dired) ; maybe in a subdirectory
@@ -1536,7 +1535,8 @@ If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
-and the functions `ffap-file-at-point' and `ffap-url-at-point'."
+`ffap-url-unwrap-local', `ffap-url-unwrap-remote', and the functions
+`ffap-file-at-point' and `ffap-url-at-point'."
(interactive)
(if (and (called-interactively-p 'interactive)
(if ffap-require-prefix (not current-prefix-arg)
diff --git a/lisp/filecache.el b/lisp/filecache.el
index 02b5f79c07a..ea7cbcb6f10 100644
--- a/lisp/filecache.el
+++ b/lisp/filecache.el
@@ -1,4 +1,4 @@
-;;; filecache.el --- find files using a pre-loaded cache
+;;; filecache.el --- find files using a pre-loaded cache -*- lexical-binding:t -*-
;; Copyright (C) 1996, 2000-2017 Free Software Foundation, Inc.
@@ -19,22 +19,22 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The file-cache package is an attempt to make it easy to locate files
;; by name, without having to remember exactly where they are located.
-;; This is very handy when working with source trees. You can also add
+;; This is very handy when working with source trees. You can also add
;; frequently used files to the cache to create a hotlist effect.
;; The cache can be used with any interactive command which takes a
;; filename as an argument.
;;
;; It is worth noting that this package works best when most of the files
;; in the cache have unique names, or (if they have the same name) exist in
-;; only a few directories. The worst case is many files all with
+;; only a few directories. The worst case is many files all with
;; the same name and in different directories, for example a big source tree
-;; with a Makefile in each directory. In such a case, you should probably
+;; with a Makefile in each directory. In such a case, you should probably
;; use an alternate strategy to find the files.
;;
;; ADDING FILES TO THE CACHE:
@@ -49,11 +49,11 @@
;; `file-cache-delete-regexps' to eliminate unwanted files:
;;
;; * `file-cache-add-directory': Adds the files in a directory to the
-;; cache. You can also specify a regular expression to match the files
+;; cache. You can also specify a regular expression to match the files
;; which should be added.
;;
;; * `file-cache-add-directory-list': Same as above, but acts on a list
-;; of directories. You can use `load-path', `exec-path' and the like.
+;; of directories. You can use `load-path', `exec-path' and the like.
;;
;; * `file-cache-add-directory-using-find': Uses the `find' command to
;; add a directory tree to the cache.
@@ -65,7 +65,7 @@
;; add all files matching a pattern to the cache.
;;
;; Use the function `file-cache-clear-cache' to remove all items from the
-;; cache. There are a number of `file-cache-delete' functions provided
+;; cache. There are a number of `file-cache-delete' functions provided
;; as well, but in general it is probably better to not worry too much
;; about extra files in the cache.
;;
@@ -76,7 +76,7 @@
;; FINDING FILES USING THE CACHE:
;;
;; You can use the file-cache with any function that expects a filename as
-;; an argument. For example:
+;; an argument. For example:
;;
;; 1) Invoke a function which expects a filename as an argument:
;; M-x find-file
@@ -160,13 +160,11 @@ File names which match these expressions will not be added to the cache.
Note that the functions `file-cache-add-file' and `file-cache-add-file-list'
do not use this variable."
:version "25.1" ; added "/\\.#"
- :type '(repeat regexp)
- :group 'file-cache)
+ :type '(repeat regexp))
(defcustom file-cache-find-command "find"
"External program used by `file-cache-add-directory-using-find'."
- :type 'string
- :group 'file-cache)
+ :type 'string)
(defcustom file-cache-find-command-posix-flag 'not-defined
"Set to t, if `file-cache-find-command' handles wildcards POSIX style.
@@ -178,30 +176,25 @@ Under Windows operating system where Cygwin is available, this value
should be t."
:type '(choice (const :tag "Yes" t)
(const :tag "No" nil)
- (const :tag "Unknown" not-defined))
- :group 'file-cache)
+ (const :tag "Unknown" not-defined)))
(defcustom file-cache-locate-command "locate"
"External program used by `file-cache-add-directory-using-locate'."
- :type 'string
- :group 'file-cache)
+ :type 'string)
;; Minibuffer messages
(defcustom file-cache-no-match-message " [File Cache: No match]"
"Message to display when there is no completion."
- :type 'string
- :group 'file-cache)
+ :type 'string)
(defcustom file-cache-sole-match-message " [File Cache: sole completion]"
"Message to display when there is only one completion."
- :type 'string
- :group 'file-cache)
+ :type 'string)
(defcustom file-cache-non-unique-message
" [File Cache: complete but not unique]"
"Message to display when there is a non-unique completion."
- :type 'string
- :group 'file-cache)
+ :type 'string)
(defcustom file-cache-completion-ignore-case
(if (memq system-type '(ms-dos windows-nt cygwin))
@@ -209,8 +202,7 @@ should be t."
completion-ignore-case)
"If non-nil, file-cache completion should ignore case.
Defaults to the value of `completion-ignore-case'."
- :type 'boolean
- :group 'file-cache)
+ :type 'boolean)
(defcustom file-cache-case-fold-search
(if (memq system-type '(ms-dos windows-nt cygwin))
@@ -218,15 +210,13 @@ Defaults to the value of `completion-ignore-case'."
case-fold-search)
"If non-nil, file-cache completion should ignore case.
Defaults to the value of `case-fold-search'."
- :type 'boolean
- :group 'file-cache)
+ :type 'boolean)
(defcustom file-cache-ignore-case
(memq system-type '(ms-dos windows-nt cygwin))
"Non-nil means ignore case when checking completions in the file cache.
Defaults to nil on DOS and Windows, and t on other systems."
- :type 'boolean
- :group 'file-cache)
+ :type 'boolean)
(defvar file-cache-multiple-directory-message nil)
@@ -235,18 +225,10 @@ Defaults to nil on DOS and Windows, and t on other systems."
;; switch-to-completions in simple.el expects
(defcustom file-cache-completions-buffer "*Completions*"
"Buffer to display completions when using the file cache."
- :type 'string
- :group 'file-cache)
+ :type 'string)
-(defcustom file-cache-buffer "*File Cache*"
- "Buffer to hold the cache of file names."
- :type 'string
- :group 'file-cache)
-
-(defcustom file-cache-buffer-default-regexp "^.+$"
- "Regexp to match files in `file-cache-buffer'."
- :type 'regexp
- :group 'file-cache)
+(defvar file-cache-buffer-default-regexp "^.+$"
+ "Regexp to match files in find and locate's output.")
(defvar file-cache-last-completion nil)
@@ -362,36 +344,31 @@ Find is run in DIRECTORY."
(if (eq file-cache-find-command-posix-flag 'not-defined)
(setq file-cache-find-command-posix-flag
(executable-command-find-posix-p file-cache-find-command))))
- (set-buffer (get-buffer-create file-cache-buffer))
- (erase-buffer)
- (call-process file-cache-find-command nil
- (get-buffer file-cache-buffer) nil
- dir "-name"
- (if (memq system-type '(windows-nt cygwin))
- (if file-cache-find-command-posix-flag
- "\\*"
- "'*'")
- "*")
- "-print")
- (file-cache-add-from-file-cache-buffer)))
+ (with-temp-buffer
+ (call-process file-cache-find-command nil t nil
+ dir "-name"
+ (if (memq system-type '(windows-nt cygwin))
+ (if file-cache-find-command-posix-flag
+ "\\*"
+ "'*'")
+ "*")
+ "-print")
+ (file-cache--add-from-buffer))))
;;;###autoload
(defun file-cache-add-directory-using-locate (string)
"Use the `locate' command to add files to the file cache.
STRING is passed as an argument to the locate command."
(interactive "sAdd files using locate string: ")
- (set-buffer (get-buffer-create file-cache-buffer))
- (erase-buffer)
- (call-process file-cache-locate-command nil
- (get-buffer file-cache-buffer) nil
- string)
- (file-cache-add-from-file-cache-buffer))
+ (with-temp-buffer
+ (call-process file-cache-locate-command nil t nil string)
+ (file-cache--add-from-buffer)))
(autoload 'find-lisp-find-files "find-lisp")
;;;###autoload
(defun file-cache-add-directory-recursively (dir &optional regexp)
- "Adds DIR and any subdirectories to the file-cache.
+ "Add DIR and any subdirectories to the file-cache.
This function does not use any external programs.
If the optional REGEXP argument is non-nil, only files which match it
will be added to the cache. Note that the REGEXP is applied to the
@@ -408,22 +385,16 @@ files in each directory, not to the directory list itself."
(file-cache-add-file file)))
(find-lisp-find-files dir (or regexp "^"))))
-(defun file-cache-add-from-file-cache-buffer (&optional regexp)
- "Add any entries found in the file cache buffer.
+(defun file-cache--add-from-buffer ()
+ "Add any entries found in the current buffer.
Each entry matches the regular expression `file-cache-buffer-default-regexp'
or the optional REGEXP argument."
- (set-buffer file-cache-buffer)
(dolist (elt file-cache-filter-regexps)
(goto-char (point-min))
(delete-matching-lines elt))
(goto-char (point-min))
- (let ((full-filename))
- (while (re-search-forward
- (or regexp file-cache-buffer-default-regexp)
- (point-max) t)
- (setq full-filename (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (file-cache-add-file full-filename))))
+ (while (re-search-forward file-cache-buffer-default-regexp nil t)
+ (file-cache-add-file (match-string-no-properties 0))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions to delete from the cache
@@ -566,68 +537,65 @@ the directories that the name is available in. With a prefix argument,
the name is considered already unique; only the second substitution
\(directories) is done."
(interactive "P")
- (let*
- (
- (completion-ignore-case file-cache-completion-ignore-case)
- (case-fold-search file-cache-case-fold-search)
- (string (file-name-nondirectory (minibuffer-contents)))
- (completion-string (try-completion string file-cache-alist))
- (completion-list)
- (len)
- (file-cache-string))
+ (let* ((completion-ignore-case file-cache-completion-ignore-case)
+ (case-fold-search file-cache-case-fold-search)
+ (string (file-name-nondirectory (minibuffer-contents)))
+ (completion (completion-try-completion
+ string file-cache-alist nil 0)))
(cond
;; If it's the only match, replace the original contents
- ((or arg (eq completion-string t))
- (setq file-cache-string (file-cache-file-name string))
- (if (string= file-cache-string (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-cache-string)
- (if file-cache-multiple-directory-message
- (minibuffer-message file-cache-multiple-directory-message))))
+ ((or arg (eq completion t))
+ (let ((file-name (file-cache-file-name string)))
+ (if (string= file-name (minibuffer-contents))
+ (minibuffer-message file-cache-sole-match-message)
+ (delete-minibuffer-contents)
+ (insert file-name)
+ (if file-cache-multiple-directory-message
+ (minibuffer-message file-cache-multiple-directory-message)))))
;; If it's the longest match, insert it
- ((stringp completion-string)
- ;; If we've already inserted a unique string, see if the user
- ;; wants to use that one
- (if (and (string= string completion-string)
- (assoc-string string file-cache-alist
- file-cache-ignore-case))
- (if (and (eq last-command this-command)
- (string= file-cache-last-completion completion-string))
- (progn
- (delete-minibuffer-contents)
- (insert (file-cache-file-name completion-string))
- (setq file-cache-last-completion nil))
- (minibuffer-message file-cache-non-unique-message)
- (setq file-cache-last-completion string))
- (setq file-cache-last-completion string)
- (setq completion-list (all-completions string file-cache-alist)
- len (length completion-list))
- (if (> len 1)
- (progn
- (goto-char (point-max))
- (insert
- (substring completion-string (length string)))
- ;; Add our own setup function to the Completions Buffer
- (let ((completion-setup-hook
- (append completion-setup-hook
- (list 'file-cache-completion-setup-function))))
- (with-output-to-temp-buffer file-cache-completions-buffer
- (display-completion-list
- (completion-hilit-commonality completion-list
- (length string))))))
- (setq file-cache-string (file-cache-file-name completion-string))
- (if (string= file-cache-string (minibuffer-contents))
- (minibuffer-message file-cache-sole-match-message)
- (delete-minibuffer-contents)
- (insert file-cache-string)
- (if file-cache-multiple-directory-message
- (minibuffer-message file-cache-multiple-directory-message)))
- )))
+ ((consp completion)
+ (let ((newstring (car completion))
+ (newpoint (cdr completion)))
+ ;; If we've already inserted a unique string, see if the user
+ ;; wants to use that one
+ (if (and (string= string newstring)
+ (assoc-string string file-cache-alist
+ file-cache-ignore-case))
+ (if (and (eq last-command this-command)
+ (string= file-cache-last-completion newstring))
+ (progn
+ (delete-minibuffer-contents)
+ (insert (file-cache-file-name newstring))
+ (setq file-cache-last-completion nil))
+ (minibuffer-message file-cache-non-unique-message)
+ (setq file-cache-last-completion string))
+ (setq file-cache-last-completion string)
+ (let* ((completion-list (completion-all-completions
+ newstring file-cache-alist nil newpoint))
+ (base-size (cdr (last completion-list))))
+ (when base-size
+ (setcdr (last completion-list) nil))
+ (if (> (length completion-list) 1)
+ (progn
+ (delete-region (- (point-max) (length string)) (point-max))
+ (save-excursion (insert newstring))
+ (forward-char newpoint)
+ (with-output-to-temp-buffer file-cache-completions-buffer
+ (display-completion-list completion-list)
+ ;; Add our own setup function to the Completions Buffer
+ (file-cache-completion-setup-function)))
+ (let ((file-name (file-cache-file-name newstring)))
+ (if (string= file-name (minibuffer-contents))
+ (minibuffer-message file-cache-sole-match-message)
+ (delete-minibuffer-contents)
+ (insert file-name)
+ (if file-cache-multiple-directory-message
+ (minibuffer-message
+ file-cache-multiple-directory-message)))))))))
;; No match
- ((eq completion-string nil)
+ ((eq completion nil)
(minibuffer-message file-cache-no-match-message)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -647,7 +615,7 @@ the name is considered already unique; only the second substitution
(file-cache-minibuffer-complete nil)))
(define-obsolete-function-alias 'file-cache-mouse-choose-completion
- 'file-cache-choose-completion "23.2")
+ #'file-cache-choose-completion "23.2")
(defun file-cache-complete ()
"Complete the word at point, using the filecache."
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index 64cfab143ec..18c44ec3e1e 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary
@@ -71,7 +71,7 @@ struct.")
"Remove DESCRIPTOR from `file-notify-descriptors'.
DESCRIPTOR should be an object returned by `file-notify-add-watch'.
If it is registered in `file-notify-descriptors', a stopped event is sent."
- (when-let (watch (gethash descriptor file-notify-descriptors))
+ (when-let* ((watch (gethash descriptor file-notify-descriptors)))
;; Send `stopped' event.
(unwind-protect
(funcall
@@ -106,12 +106,12 @@ It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).")
(defun file-notify--event-watched-file (event)
"Return file or directory being watched.
Could be different from the directory watched by the backend library."
- (when-let (watch (gethash (car event) file-notify-descriptors))
+ (when-let* ((watch (gethash (car event) file-notify-descriptors)))
(file-notify--watch-absolute-filename watch)))
(defun file-notify--event-file-name (event)
"Return file name of file notification event, or nil."
- (when-let (watch (gethash (car event) file-notify-descriptors))
+ (when-let* ((watch (gethash (car event) file-notify-descriptors)))
(directory-file-name
(expand-file-name
(or (and (stringp (nth 2 event)) (nth 2 event)) "")
@@ -121,7 +121,7 @@ Could be different from the directory watched by the backend library."
(defun file-notify--event-file1-name (event)
"Return second file name of file notification event, or nil.
This is available in case a file has been moved."
- (when-let (watch (gethash (car event) file-notify-descriptors))
+ (when-let* ((watch (gethash (car event) file-notify-descriptors)))
(and (stringp (nth 3 event))
(directory-file-name
(expand-file-name
@@ -375,7 +375,7 @@ FILE is the name of the file whose event is being reported."
(defun file-notify-rm-watch (descriptor)
"Remove an existing watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
- (when-let (watch (gethash descriptor file-notify-descriptors))
+ (when-let* ((watch (gethash descriptor file-notify-descriptors)))
(let ((handler (find-file-name-handler
(file-notify--watch-directory watch)
'file-notify-rm-watch)))
@@ -399,7 +399,7 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
(defun file-notify-valid-p (descriptor)
"Check a watch specified by its DESCRIPTOR.
DESCRIPTOR should be an object returned by `file-notify-add-watch'."
- (when-let (watch (gethash descriptor file-notify-descriptors))
+ (when-let* ((watch (gethash descriptor file-notify-descriptors)))
(let ((handler (find-file-name-handler
(file-notify--watch-directory watch)
'file-notify-valid-p)))
diff --git a/lisp/files-x.el b/lisp/files-x.el
index b7c6f51e658..667737075ed 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/files.el b/lisp/files.el
index 8ac1993754e..a7ad40b76cd 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -150,8 +150,13 @@ Called with an absolute file name as argument, it returns t to enable backup.")
(defcustom buffer-offer-save nil
"Non-nil in a buffer means always offer to save buffer on exit.
Do so even if the buffer is not visiting a file.
-Automatically local in all buffers."
- :type 'boolean
+Automatically local in all buffers.
+
+Set to the symbol `always' to offer to save buffer whenever
+`save-some-buffers' is called."
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "On Emacs exit" t)
+ (const :tag "Whenever save-some-buffers is called" always))
:group 'backup)
(make-variable-buffer-local 'buffer-offer-save)
(put 'buffer-offer-save 'permanent-local t)
@@ -434,8 +439,11 @@ and toggle it if ARG is `toggle'."
(not (and buffer-auto-save-file-name
auto-save-visited-file-name)))))))
+;; The 'set' part is so we don't get a warning for using this variable
+;; above, while still catching code that _sets_ the variable to get
+;; the same effect as the new auto-save-visited-mode.
(make-obsolete-variable 'auto-save-visited-file-name 'auto-save-visited-mode
- "Emacs 26.1")
+ "Emacs 26.1" 'set)
(defcustom save-abbrevs t
"Non-nil means save word abbrevs too when files are saved.
@@ -514,10 +522,12 @@ updates before the buffer is saved, use `before-save-hook'.")
'write-contents-functions "22.1")
(defvar write-contents-functions nil
"List of functions to be called before writing out a buffer to a file.
-Only used by `save-buffer'.
-If one of them returns non-nil, the file is considered already written
-and the rest are not called and neither are the functions in
-`write-file-functions'.
+
+Only used by `save-buffer'. If one of them returns non-nil, the
+file is considered already written and the rest are not called
+and neither are the functions in `write-file-functions'. This
+hook can thus be used to create save behavior for buffers that
+are not visiting a file at all.
This variable is meant to be used for hooks that pertain to the
buffer's contents, not to the particular visited file; thus,
@@ -591,13 +601,14 @@ settings being applied, but still respect file-local ones.")
;; ignore. So AFAICS the only reason this variable exists is for a
;; minor convenience feature for handling of an obsolete Rmail file format.
(defvar local-enable-local-variables t
- "Like `enable-local-variables' but meant for buffer-local bindings.
+ "Like `enable-local-variables', except for major mode in a -*- line.
The meaningful values are nil and non-nil. The default is non-nil.
-If a major mode sets this to nil, buffer-locally, then any local
-variables list in a file visited in that mode will be ignored.
+It should be set in a buffer-local fashion.
-This variable does not affect the use of major modes specified
-in a -*- line.")
+Setting this to nil has the same effect as setting `enable-local-variables'
+to nil, except that it does not ignore any mode: setting in a -*- line.
+Unless this difference matters to you, you should set `enable-local-variables'
+instead of this variable.")
(defcustom enable-local-eval 'maybe
"Control processing of the \"variable\" `eval' in a file's local variables.
@@ -788,16 +799,6 @@ The path separator is colon in GNU and GNU-like systems."
(lambda (f) (and (file-directory-p f) 'dir-ok)))
(error "No such directory found via CDPATH environment variable"))))
-(defsubst directory-name-p (name)
- "Return non-nil if NAME ends with a directory separator character."
- (let ((len (length name))
- (lastc ?.))
- (if (> len 0)
- (setq lastc (aref name (1- len))))
- (or (= lastc ?/)
- (and (memq system-type '(windows-nt ms-dos))
- (= lastc ?\\)))))
-
(defun directory-files-recursively (dir regexp &optional include-directories)
"Return list of all files under DIR that have file names matching REGEXP.
This function works recursively. Files are returned in \"depth first\"
@@ -943,68 +944,23 @@ The default regexp prevents fruitless and time-consuming attempts to find
special files in directories in which filenames are interpreted as hostnames,
or mount points potentially requiring authentication as a different user.")
-;; (defun locate-dominating-files (file regexp)
-;; "Look up the directory hierarchy from FILE for a file matching REGEXP.
-;; Stop at the first parent where a matching file is found and return the list
-;; of files that that match in this directory."
-;; (catch 'found
-;; ;; `user' is not initialized yet because `file' may not exist, so we may
-;; ;; have to walk up part of the hierarchy before we find the "initial UID".
-;; (let ((user nil)
-;; ;; Abbreviate, so as to stop when we cross ~/.
-;; (dir (abbreviate-file-name (file-name-as-directory file)))
-;; files)
-;; (while (and dir
-;; ;; As a heuristic, we stop looking up the hierarchy of
-;; ;; directories as soon as we find a directory belonging to
-;; ;; another user. This should save us from looking in
-;; ;; things like /net and /afs. This assumes that all the
-;; ;; files inside a project belong to the same user.
-;; (let ((prev-user user))
-;; (setq user (nth 2 (file-attributes dir)))
-;; (or (null prev-user) (equal user prev-user))))
-;; (if (setq files (condition-case nil
-;; (directory-files dir 'full regexp 'nosort)
-;; (error nil)))
-;; (throw 'found files)
-;; (if (equal dir
-;; (setq dir (file-name-directory
-;; (directory-file-name dir))))
-;; (setq dir nil))))
-;; nil)))
-
(defun locate-dominating-file (file name)
- "Look up the directory hierarchy from FILE for a directory containing NAME.
+ "Starting at FILE, look up directory hierarchy for directory containing NAME.
+FILE can be a file or a directory. If it's a file, its directory will
+serve as the starting point for searching the hierarchy of directories.
Stop at the first parent directory containing a file NAME,
and return the directory. Return nil if not found.
Instead of a string, NAME can also be a predicate taking one argument
\(a directory) and returning a non-nil value if that directory is the one for
-which we're looking."
- ;; We used to use the above locate-dominating-files code, but the
- ;; directory-files call is very costly, so we're much better off doing
- ;; multiple calls using the code in here.
- ;;
+which we're looking. The predicate will be called with every file/directory
+the function needs to examine, starting with FILE."
;; Represent /home/luser/foo as ~/foo so that we don't try to look for
;; `name' in /home or in /.
(setq file (abbreviate-file-name (expand-file-name file)))
(let ((root nil)
- ;; `user' is not initialized outside the loop because
- ;; `file' may not exist, so we may have to walk up part of the
- ;; hierarchy before we find the "initial UID". Note: currently unused
- ;; (user nil)
try)
(while (not (or root
(null file)
- ;; FIXME: Disabled this heuristic because it is sometimes
- ;; inappropriate.
- ;; As a heuristic, we stop looking up the hierarchy of
- ;; directories as soon as we find a directory belonging
- ;; to another user. This should save us from looking in
- ;; things like /net and /afs. This assumes that all the
- ;; files inside a project belong to the same user.
- ;; (let ((prev-user user))
- ;; (setq user (nth 2 (file-attributes file)))
- ;; (and prev-user (not (equal user prev-user))))
(string-match locate-dominating-stop-dir-regexp file)))
(setq try (if (stringp name)
(file-exists-p (expand-file-name name file))
@@ -1197,6 +1153,29 @@ accessible."
(funcall handler 'file-local-copy file)
nil)))
+(defun files--name-absolute-system-p (file)
+ "Return non-nil if FILE is an absolute name to the operating system.
+This is like `file-name-absolute-p', except that it returns nil for
+names beginning with `~'."
+ (and (file-name-absolute-p file)
+ (not (eq (aref file 0) ?~))))
+
+(defun files--splice-dirname-file (dirname file)
+ "Splice DIRNAME to FILE like the operating system would.
+If FILE is relative, return DIRNAME concatenated to FILE.
+Otherwise return FILE, quoted as needed if DIRNAME and FILE have
+different handlers; although this quoting is dubious if DIRNAME
+is magic, it is not clear what would be better. This function
+differs from `expand-file-name' in that DIRNAME must be a
+directory name and leading `~' and `/:' are not special in FILE."
+ (let ((unquoted (if (files--name-absolute-system-p file)
+ file
+ (concat dirname file))))
+ (if (eq (find-file-name-handler dirname 'file-symlink-p)
+ (find-file-name-handler unquoted 'file-symlink-p))
+ unquoted
+ (let (file-name-handler-alist) (file-name-quote unquoted)))))
+
(defun file-truename (filename &optional counter prev-dirs)
"Return the truename of FILENAME.
If FILENAME is not absolute, first expands it against `default-directory'.
@@ -1297,10 +1276,7 @@ containing it, until no links are left at any level.
;; We can't safely use expand-file-name here
;; since target might look like foo/../bar where foo
;; is itself a link. Instead, we handle . and .. above.
- (setq filename
- (if (file-name-absolute-p target)
- target
- (concat dir target))
+ (setq filename (files--splice-dirname-file dir target)
done nil)
;; No, we are done!
(setq done t))))))))
@@ -1335,7 +1311,8 @@ it means chase no more than that many links and then stop."
(directory-file-name (file-name-directory newname))))
;; Now find the parent of that dir.
(setq newname (file-name-directory newname)))
- (setq newname (expand-file-name tem (file-name-directory newname)))
+ (setq newname (files--splice-dirname-file (file-name-directory newname)
+ tem))
(setq count (1+ count))))
newname))
@@ -1400,35 +1377,46 @@ the variable `temporary-file-directory' is returned."
default-directory
temporary-file-directory))))
-(defun make-temp-file (prefix &optional dir-flag suffix)
+(defun make-temp-file (prefix &optional dir-flag suffix text)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
of PREFIX, and expanding against `temporary-file-directory' if necessary),
-is guaranteed to point to a newly created empty file.
+is guaranteed to point to a newly created file.
You can then use `write-region' to write new data into the file.
If DIR-FLAG is non-nil, create a new empty directory instead of a file.
-If SUFFIX is non-nil, add that at the end of the file name."
+If SUFFIX is non-nil, add that at the end of the file name.
+
+If TEXT is a string, insert it into the new file; DIR-FLAG should be nil.
+Otherwise the file will be empty."
+ (let ((absolute-prefix
+ (if (or (zerop (length prefix)) (member prefix '("." "..")))
+ (concat (file-name-as-directory temporary-file-directory) prefix)
+ (expand-file-name prefix temporary-file-directory))))
+ (if (find-file-name-handler absolute-prefix 'write-region)
+ (files--make-magic-temp-file absolute-prefix dir-flag suffix text)
+ (make-temp-file-internal absolute-prefix
+ (if dir-flag t) (or suffix "") text))))
+
+(defun files--make-magic-temp-file (absolute-prefix
+ &optional dir-flag suffix text)
+ "Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX TEXT).
+This implementation works on magic file names."
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
(with-file-modes ?\700
- (let (file)
+ (let ((contents (if (stringp text) text ""))
+ file)
(while (condition-case ()
(progn
- (setq file
- (make-temp-name
- (if (zerop (length prefix))
- (file-name-as-directory
- temporary-file-directory)
- (expand-file-name prefix
- temporary-file-directory))))
+ (setq file (make-temp-name absolute-prefix))
(if suffix
(setq file (concat file suffix)))
(if dir-flag
(make-directory file)
- (write-region "" nil file nil 'silent nil 'excl))
+ (write-region contents nil file nil 'silent nil 'excl))
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
@@ -1572,7 +1560,15 @@ Switch to a buffer visiting file FILENAME,
creating one if none already exists.
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
-type M-n to pull it into the minibuffer.
+type \\[next-history-element] to pull it into the minibuffer.
+
+The first time \\[next-history-element] is used after Emacs prompts for
+the file name, the result is affected by `file-name-at-point-functions',
+which by default try to guess the file name by looking at point in the
+current buffer. Customize the value of `file-name-at-point-functions'
+or set it to nil, if you want only the visited file name and the
+current directory to be available on first \\[next-history-element]
+request.
You can visit files on remote machines by specifying something
like /ssh:SOME_REMOTE_MACHINE:FILE for the file name. You can
@@ -1592,8 +1588,8 @@ automatically choosing a major mode, use \\[find-file-literally]."
(confirm-nonexistent-file-or-buffer)))
(let ((value (find-file-noselect filename nil nil wildcards)))
(if (listp value)
- (mapcar 'switch-to-buffer (nreverse value))
- (switch-to-buffer value))))
+ (mapcar 'pop-to-buffer-same-window (nreverse value))
+ (pop-to-buffer-same-window value))))
(defun find-file-other-window (filename &optional wildcards)
"Edit file FILENAME, in another window.
@@ -1603,7 +1599,15 @@ an existing one. See the function `display-buffer'.
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
-type M-n to pull it into the minibuffer.
+type \\[next-history-element] to pull it into the minibuffer.
+
+The first time \\[next-history-element] is used after Emacs prompts for
+the file name, the result is affected by `file-name-at-point-functions',
+which by default try to guess the file name by looking at point in the
+current buffer. Customize the value of `file-name-at-point-functions'
+or set it to nil, if you want only the visited file name and the
+current directory to be available on first \\[next-history-element]
+request.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
@@ -1627,7 +1631,15 @@ an existing one. See the function `display-buffer'.
Interactively, the default if you just type RET is the current directory,
but the visited file name is available through the minibuffer history:
-type M-n to pull it into the minibuffer.
+type \\[next-history-element] to pull it into the minibuffer.
+
+The first time \\[next-history-element] is used after Emacs prompts for
+the file name, the result is affected by `file-name-at-point-functions',
+which by default try to guess the file name by looking at point in the
+current buffer. Customize the value of `file-name-at-point-functions'
+or set it to nil, if you want only the visited file name and the
+current directory to be available on first \\[next-history-element]
+request.
Interactively, or if WILDCARDS is non-nil in a call from Lisp,
expand wildcards (if any) and visit multiple files."
@@ -1789,7 +1801,11 @@ killed."
(setq buffer-file-truename nil)
;; Likewise for dired buffers.
(setq dired-directory nil)
- (find-file filename wildcards))
+ ;; Don't use `find-file' because it may end up using another window
+ ;; in some corner cases, e.g. when the selected window is
+ ;; softly-dedicated.
+ (let ((newbuf (find-file-noselect filename wildcards)))
+ (switch-to-buffer newbuf)))
(when (eq obuf (current-buffer))
;; This executes if find-file gets an error
;; and does not really find anything.
@@ -1843,7 +1859,13 @@ The value includes abbreviation according to `directory-abbrev-alist'.")
"Return a version of FILENAME shortened using `directory-abbrev-alist'.
This also substitutes \"~\" for the user's home directory (unless the
home directory is a root directory) and removes automounter prefixes
-\(see the variable `automount-dir-prefix')."
+\(see the variable `automount-dir-prefix').
+
+When this function is first called, it caches the user's home
+directory as a regexp in `abbreviated-home-dir', and reuses it
+afterwards (so long as the home directory does not change;
+if you want to permanently change your home directory after having
+started Emacs, set `abbreviated-home-dir' to nil so it will be recalculated)."
;; Get rid of the prefixes added by the automounter.
(save-match-data
(if (and automount-dir-prefix
@@ -1865,29 +1887,37 @@ home directory is a root directory) and removes automounter prefixes
;; give time for directory-abbrev-alist to be set properly.
;; We include a slash at the end, to avoid spurious matches
;; such as `/usr/foobar' when the home dir is `/usr/foo'.
- (or abbreviated-home-dir
- (setq abbreviated-home-dir
- (let ((abbreviated-home-dir "$foo"))
- (setq abbreviated-home-dir
- (concat "\\`"
- (abbreviate-file-name (expand-file-name "~"))
- "\\(/\\|\\'\\)"))
- ;; Depending on whether default-directory does or
- ;; doesn't include non-ASCII characters, the value
- ;; of abbreviated-home-dir could be multibyte or
- ;; unibyte. In the latter case, we need to decode
- ;; it. Note that this function is called for the
- ;; first time (from startup.el) when
- ;; locale-coding-system is already set up.
- (if (multibyte-string-p abbreviated-home-dir)
- abbreviated-home-dir
- (decode-coding-string abbreviated-home-dir
- (if (eq system-type 'windows-nt)
- 'utf-8
- locale-coding-system))))))
+ (unless abbreviated-home-dir
+ (put 'abbreviated-home-dir 'home (expand-file-name "~"))
+ (setq abbreviated-home-dir
+ (let ((abbreviated-home-dir "$foo"))
+ (setq abbreviated-home-dir
+ (concat "\\`"
+ (abbreviate-file-name
+ (get 'abbreviated-home-dir 'home))
+ "\\(/\\|\\'\\)"))
+ ;; Depending on whether default-directory does or
+ ;; doesn't include non-ASCII characters, the value
+ ;; of abbreviated-home-dir could be multibyte or
+ ;; unibyte. In the latter case, we need to decode
+ ;; it. Note that this function is called for the
+ ;; first time (from startup.el) when
+ ;; locale-coding-system is already set up.
+ (if (multibyte-string-p abbreviated-home-dir)
+ abbreviated-home-dir
+ (decode-coding-string abbreviated-home-dir
+ (if (eq system-type 'windows-nt)
+ 'utf-8
+ locale-coding-system))))))
;; If FILENAME starts with the abbreviated homedir,
+ ;; and ~ hasn't changed since abbreviated-home-dir was set,
;; make it start with `~' instead.
+ ;; If ~ has changed, we ignore abbreviated-home-dir rather than
+ ;; invalidating it, on the assumption that a change in HOME
+ ;; is likely temporary (eg for testing).
+ ;; FIXME Is it even worth caching abbreviated-home-dir?
+ ;; Ref: https://debbugs.gnu.org/19657#20
(if (and (string-match abbreviated-home-dir filename)
;; If the home dir is just /, don't change it.
(not (and (= (match-end 0) 1)
@@ -1896,7 +1926,9 @@ home directory is a root directory) and removes automounter prefixes
;; Novell Netware allows drive letters beyond `Z:'.
(not (and (memq system-type '(ms-dos windows-nt cygwin))
(save-match-data
- (string-match "^[a-zA-`]:/$" filename)))))
+ (string-match "^[a-zA-`]:/$" filename))))
+ (equal (get 'abbreviated-home-dir 'home)
+ (expand-file-name "~")))
(setq filename
(concat "~"
(match-string 1 filename)
@@ -2539,7 +2571,7 @@ since only a single case-insensitive search through the alist is made."
("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
("\\.bash\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode)
- ("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
+ ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
("\\.m?spec\\'" . sh-mode)
("\\.m[mes]\\'" . nroff-mode)
@@ -2641,10 +2673,12 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo
("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode)
;; Windows candidates may be opened case sensitively on Unix
("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode)
- ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode)
+ ("\\.la\\'" . conf-unix-mode)
("\\.ppd\\'" . conf-ppd-mode)
("java.+\\.conf\\'" . conf-javaprop-mode)
("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode)
+ ("\\.toml\\'" . conf-toml-mode)
+ ("\\.desktop\\'" . conf-desktop-mode)
("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode)
("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode)
;; ChangeLog.old etc. Other change-log-mode entries are above;
@@ -3875,16 +3909,16 @@ VARIABLES list of the class. The list is processed in order.
"File that contains directory-local variables.
It has to be constant to enforce uniform values across different
environments and users.
-See also `dir-locals-file-2', whose values override this one's.
-See Info node `(elisp)Directory Local Variables' for details.")
-(defconst dir-locals-file-2 ".dir-locals-2.el"
- "File that contains directory-local variables.
-This essentially a second file that can be used like
-`dir-locals-file', so that users can have specify their personal
-dir-local variables even if the current directory already has a
-`dir-locals-file' that is shared with other users (such as in a
-git repository).
+A second dir-locals file can be used by a user to specify their
+personal dir-local variables even if the current directory
+already has a `dir-locals-file' that is shared with other
+users (such as in a git repository). The name of this second
+file is derived by appending \"-2\" to the base name of
+`dir-locals-file'. With the default value of `dir-locals-file',
+a \".dir-locals-2.el\" file in the same directory will override
+the \".dir-locals.el\".
+
See Info node `(elisp)Directory Local Variables' for details.")
(defun dir-locals--all-files (directory)
@@ -3957,11 +3991,12 @@ This function returns either:
;; The entry MTIME should match the most recent
;; MTIME among matching files.
(and cached-files
- (= (float-time (nth 2 dir-elt))
- (apply #'max (mapcar (lambda (f)
- (float-time
- (nth 5 (file-attributes f))))
- cached-files))))))
+ (equal (nth 2 dir-elt)
+ (let ((latest 0))
+ (dolist (f cached-files latest)
+ (let ((f-time (nth 5 (file-attributes f))))
+ (if (time-less-p latest f-time)
+ (setq latest f-time)))))))))
;; This cache entry is OK.
dir-elt
;; This cache entry is invalid; clear it.
@@ -3983,10 +4018,15 @@ Return the new class name, which is a symbol named DIR."
(let* ((class-name (intern dir))
(files (dir-locals--all-files dir))
(read-circle nil)
- (success nil)
+ ;; If there was a problem, use the values we could get but
+ ;; don't let the cache prevent future reads.
+ (latest 0) (success 0)
(variables))
(with-demoted-errors "Error reading dir-locals: %S"
(dolist (file files)
+ (let ((file-time (nth 5 (file-attributes file))))
+ (if (time-less-p latest file-time)
+ (setq latest file-time)))
(with-temp-buffer
(insert-file-contents file)
(condition-case-unless-debug nil
@@ -3995,18 +4035,9 @@ Return the new class name, which is a symbol named DIR."
variables
(read (current-buffer))))
(end-of-file nil))))
- (setq success t))
+ (setq success latest))
(dir-locals-set-class-variables class-name variables)
- (dir-locals-set-directory-class
- dir class-name
- (seconds-to-time
- (if success
- (apply #'max (mapcar (lambda (file)
- (float-time (nth 5 (file-attributes file))))
- files))
- ;; If there was a problem, use the values we could get but
- ;; don't let the cache prevent future reads.
- 0)))
+ (dir-locals-set-directory-class dir class-name success)
class-name))
(define-obsolete-function-alias 'dir-locals-read-from-file
@@ -4229,10 +4260,10 @@ Interactively, confirmation is required unless you supply a prefix argument."
(not current-prefix-arg)))
(or (null filename) (string-equal filename "")
(progn
- ;; If arg is just a directory,
+ ;; If arg is a directory name,
;; use the default file name, but in that directory.
- (if (file-directory-p filename)
- (setq filename (concat (file-name-as-directory filename)
+ (if (directory-name-p filename)
+ (setq filename (concat filename
(file-name-nondirectory
(or buffer-file-name (buffer-name))))))
(and confirm
@@ -4494,8 +4525,8 @@ extension, the value is \"\"."
"")))))
(defun file-name-base (&optional filename)
- "Return the base name of the FILENAME: no directory, no extension.
-FILENAME defaults to `buffer-file-name'."
+ "Return the base name of the FILENAME: no directory, no extension."
+ (declare (advertised-calling-convention (filename) "27.1"))
(file-name-sans-extension
(file-name-nondirectory (or filename (buffer-file-name)))))
@@ -4626,17 +4657,27 @@ The function `find-backup-file-name' also uses this."
;; "/drive_x".
(or (file-name-absolute-p file)
(setq file (expand-file-name file))) ; make defaults explicit
- ;; Replace any invalid file-name characters (for the
- ;; case of backing up remote files).
- (setq file (expand-file-name (convert-standard-filename file)))
- (if (eq (aref file 1) ?:)
- (setq file (concat "/"
- "drive_"
- (char-to-string (downcase (aref file 0)))
- (if (eq (aref file 2) ?/)
- ""
- "/")
- (substring file 2)))))
+ (cond
+ ((file-remote-p file)
+ ;; Remove the leading slash, if any, to prevent
+ ;; convert-standard-filename from converting that to a
+ ;; backslash.
+ (and (memq (aref file 0) '(?/ ?\\))
+ (setq file (substring file 1)))
+ ;; Replace any invalid file-name characters, then
+ ;; prepend the leading slash back.
+ (setq file (concat "/" (convert-standard-filename file))))
+ (t
+ ;; Replace any invalid file-name characters.
+ (setq file (expand-file-name (convert-standard-filename file)))
+ (if (eq (aref file 1) ?:)
+ (setq file (concat "/"
+ "drive_"
+ (char-to-string (downcase (aref file 0)))
+ (if (eq (aref file 2) ?/)
+ ""
+ "/")
+ (substring file 2)))))))
;; Make the name unique by substituting directory
;; separators. It may not really be worth bothering about
;; doubling `!'s in the original name...
@@ -4724,46 +4765,6 @@ Uses `backup-directory-alist' in the same way as
"Return number of names file FILENAME has."
(car (cdr (file-attributes filename))))
-;; (defun file-relative-name (filename &optional directory)
-;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
-;; This function returns a relative file name which is equivalent to FILENAME
-;; when used with that default directory as the default.
-;; If this is impossible (which can happen on MSDOS and Windows
-;; when the file name and directory use different drive names)
-;; then it returns FILENAME."
-;; (save-match-data
-;; (let ((fname (expand-file-name filename)))
-;; (setq directory (file-name-as-directory
-;; (expand-file-name (or directory default-directory))))
-;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different
-;; ;; drive names, they can't be relative, so return the absolute name.
-;; (if (and (or (eq system-type 'ms-dos)
-;; (eq system-type 'cygwin)
-;; (eq system-type 'windows-nt))
-;; (not (string-equal (substring fname 0 2)
-;; (substring directory 0 2))))
-;; filename
-;; (let ((ancestor ".")
-;; (fname-dir (file-name-as-directory fname)))
-;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir))
-;; (not (string-match (concat "^" (regexp-quote directory)) fname)))
-;; (setq directory (file-name-directory (substring directory 0 -1))
-;; ancestor (if (equal ancestor ".")
-;; ".."
-;; (concat "../" ancestor))))
-;; ;; Now ancestor is empty, or .., or ../.., etc.
-;; (if (string-match (concat "^" (regexp-quote directory)) fname)
-;; ;; We matched within FNAME's directory part.
-;; ;; Add the rest of FNAME onto ANCESTOR.
-;; (let ((rest (substring fname (match-end 0))))
-;; (if (and (equal ancestor ".")
-;; (not (equal rest "")))
-;; ;; But don't bother with ANCESTOR if it would give us `./'.
-;; rest
-;; (concat (file-name-as-directory ancestor) rest)))
-;; ;; We matched FNAME's directory equivalent.
-;; ancestor))))))
-
(defun file-relative-name (filename &optional directory)
"Convert FILENAME to be relative to DIRECTORY (default: `default-directory').
This function returns a relative file name which is equivalent to FILENAME
@@ -4932,9 +4933,12 @@ in such cases.")
(defun basic-save-buffer (&optional called-interactively)
"Save the current buffer in its visited file, if it has been modified.
-The hooks `write-contents-functions' and `write-file-functions' get a chance
-to do the job of saving; if they do not, then the buffer is saved in
-the visited file in the usual way.
+
+The hooks `write-contents-functions', `local-write-file-hooks'
+and `write-file-functions' get a chance to do the job of saving;
+if they do not, then the buffer is saved in the visited file in
+the usual way.
+
Before and after saving the buffer, this function runs
`before-save-hook' and `after-save-hook', respectively."
(interactive '(called-interactively))
@@ -4943,29 +4947,14 @@ Before and after saving the buffer, this function runs
(if (buffer-base-buffer)
(set-buffer (buffer-base-buffer)))
(if (or (buffer-modified-p)
- ;; handle the case when no modification has been made but
- ;; the file disappeared since visited
+ ;; Handle the case when no modification has been made but
+ ;; the file disappeared since visited.
(and buffer-file-name
(not (file-exists-p buffer-file-name))))
(let ((recent-save (recent-auto-save-p))
setmodes)
- ;; If buffer has no file name, ask user for one.
- (or buffer-file-name
- (let ((filename
- (expand-file-name
- (read-file-name "File to save in: "
- nil (expand-file-name (buffer-name))))))
- (if (file-exists-p filename)
- (if (file-directory-p filename)
- ;; Signal an error if the user specified the name of an
- ;; existing directory.
- (error "%s is a directory" filename)
- (unless (y-or-n-p (format-message
- "File `%s' exists; overwrite? "
- filename))
- (error "Canceled"))))
- (set-visited-file-name filename)))
- (or (verify-visited-file-modtime (current-buffer))
+ (or (null buffer-file-name)
+ (verify-visited-file-modtime (current-buffer))
(not (file-exists-p buffer-file-name))
(yes-or-no-p
(format
@@ -4977,6 +4966,7 @@ Before and after saving the buffer, this function runs
(save-excursion
(and (> (point-max) (point-min))
(not find-file-literally)
+ (null buffer-read-only)
(/= (char-after (1- (point-max))) ?\n)
(not (and (eq selective-display t)
(= (char-after (1- (point-max))) ?\r)))
@@ -4989,46 +4979,65 @@ Before and after saving the buffer, this function runs
(save-excursion
(goto-char (point-max))
(insert ?\n))))
- ;; Support VC version backups.
- (vc-before-save)
;; Don't let errors prevent saving the buffer.
(with-demoted-errors (run-hooks 'before-save-hook))
- (or (run-hook-with-args-until-success 'write-contents-functions)
- (run-hook-with-args-until-success 'local-write-file-hooks)
- (run-hook-with-args-until-success 'write-file-functions)
- ;; If a hook returned t, file is already "written".
- ;; Otherwise, write it the usual way now.
- (let ((dir (file-name-directory
- (expand-file-name buffer-file-name))))
- (unless (file-exists-p dir)
- (if (y-or-n-p
- (format-message
- "Directory `%s' does not exist; create? " dir))
- (make-directory dir t)
- (error "Canceled")))
- (setq setmodes (basic-save-buffer-1))))
+ ;; Give `write-contents-functions' a chance to
+ ;; short-circuit the whole process.
+ (unless (run-hook-with-args-until-success 'write-contents-functions)
+ ;; If buffer has no file name, ask user for one.
+ (or buffer-file-name
+ (let ((filename
+ (expand-file-name
+ (read-file-name "File to save in: "
+ nil (expand-file-name (buffer-name))))))
+ (if (file-exists-p filename)
+ (if (file-directory-p filename)
+ ;; Signal an error if the user specified the name of an
+ ;; existing directory.
+ (error "%s is a directory" filename)
+ (unless (y-or-n-p (format-message
+ "File `%s' exists; overwrite? "
+ filename))
+ (error "Canceled"))))
+ (set-visited-file-name filename)))
+ ;; Support VC version backups.
+ (vc-before-save)
+ (or (run-hook-with-args-until-success 'local-write-file-hooks)
+ (run-hook-with-args-until-success 'write-file-functions)
+ ;; If a hook returned t, file is already "written".
+ ;; Otherwise, write it the usual way now.
+ (let ((dir (file-name-directory
+ (expand-file-name buffer-file-name))))
+ (unless (file-exists-p dir)
+ (if (y-or-n-p
+ (format-message
+ "Directory `%s' does not exist; create? " dir))
+ (make-directory dir t)
+ (error "Canceled")))
+ (setq setmodes (basic-save-buffer-1)))))
;; Now we have saved the current buffer. Let's make sure
;; that buffer-file-coding-system is fixed to what
;; actually used for saving by binding it locally.
- (if save-buffer-coding-system
- (setq save-buffer-coding-system last-coding-system-used)
- (setq buffer-file-coding-system last-coding-system-used))
- (setq buffer-file-number
- (nthcdr 10 (file-attributes buffer-file-name)))
- (if setmodes
- (condition-case ()
- (progn
- (unless
- (with-demoted-errors
- (set-file-modes buffer-file-name (car setmodes)))
- (set-file-extended-attributes buffer-file-name
- (nth 1 setmodes))))
- (error nil))))
- ;; If the auto-save file was recent before this command,
- ;; delete it now.
- (delete-auto-save-file-if-necessary recent-save)
- ;; Support VC `implicit' locking.
- (vc-after-save)
+ (when buffer-file-name
+ (if save-buffer-coding-system
+ (setq save-buffer-coding-system last-coding-system-used)
+ (setq buffer-file-coding-system last-coding-system-used))
+ (setq buffer-file-number
+ (nthcdr 10 (file-attributes buffer-file-name)))
+ (if setmodes
+ (condition-case ()
+ (progn
+ (unless
+ (with-demoted-errors
+ (set-file-modes buffer-file-name (car setmodes)))
+ (set-file-extended-attributes buffer-file-name
+ (nth 1 setmodes))))
+ (error nil)))
+ ;; Support VC `implicit' locking.
+ (vc-after-save))
+ ;; If the auto-save file was recent before this command,
+ ;; delete it now.
+ (delete-auto-save-file-if-necessary recent-save))
(run-hooks 'after-save-hook))
(or noninteractive
(not called-interactively)
@@ -5083,48 +5092,33 @@ Before and after saving the buffer, this function runs
;; This requires write access to the containing dir,
;; which is why we don't try it if we don't have that access.
(let ((realname buffer-file-name)
- tempname succeed
- (umask (default-file-modes))
+ tempname
(old-modtime (visited-file-modtime)))
;; Create temp files with strict access rights. It's easy to
;; loosen them later, whereas it's impossible to close the
;; time-window of loose permissions otherwise.
- (unwind-protect
+ (condition-case err
(progn
(clear-visited-file-modtime)
- (set-default-file-modes ?\700)
- ;; Try various temporary names.
- ;; This code follows the example of make-temp-file,
- ;; but it calls write-region in the appropriate way
+ ;; Call write-region in the appropriate way
;; for saving the buffer.
- (while (condition-case ()
- (progn
- (setq tempname
- (make-temp-name
- (expand-file-name "tmp" dir)))
- ;; Pass in nil&nil rather than point-min&max
- ;; cause we're saving the whole buffer.
- ;; write-region-annotate-functions may use it.
- (write-region nil nil
- tempname nil realname
- buffer-file-truename 'excl)
- (when save-silently (message nil))
- nil)
- (file-already-exists t))
- ;; The file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- (setq succeed t))
- ;; Reset the umask.
- (set-default-file-modes umask)
+ (setq tempname
+ (make-temp-file
+ (expand-file-name "tmp" dir)))
+ ;; Pass in nil&nil rather than point-min&max
+ ;; cause we're saving the whole buffer.
+ ;; write-region-annotate-functions may use it.
+ (write-region nil nil tempname nil realname
+ buffer-file-truename)
+ (when save-silently (message nil)))
;; If we failed, restore the buffer's modtime.
- (unless succeed
- (set-visited-file-modtime old-modtime)))
+ (error (set-visited-file-modtime old-modtime)
+ (signal (car err) (cdr err))))
;; Since we have created an entirely new file,
;; make sure it gets the right permission bits set.
(setq setmodes (or setmodes
(list (or (file-modes buffer-file-name)
- (logand ?\666 umask))
+ (logand ?\666 (default-file-modes)))
(file-extended-attributes buffer-file-name)
buffer-file-name)))
;; We succeeded in writing the temp file,
@@ -5152,7 +5146,7 @@ Before and after saving the buffer, this function runs
(progn
;; Pass in nil&nil rather than point-min&max to indicate
;; we're saving the buffer rather than just a region.
- ;; write-region-annotate-functions may make us of it.
+ ;; write-region-annotate-functions may make use of it.
(write-region nil nil
buffer-file-name nil t buffer-file-truename)
(when save-silently (message nil))
@@ -5252,10 +5246,9 @@ change the additional actions you can take on files."
(not (buffer-base-buffer buffer))
(or
(buffer-file-name buffer)
- (and pred
- (progn
- (set-buffer buffer)
- (and buffer-offer-save (> (buffer-size) 0)))))
+ (with-current-buffer buffer
+ (or (eq buffer-offer-save 'always)
+ (and pred buffer-offer-save (> (buffer-size) 0)))))
(or (not (functionp pred))
(with-current-buffer buffer (funcall pred)))
(if arg
@@ -5392,6 +5385,14 @@ instance of such commands."
(rename-buffer (generate-new-buffer-name base-name))
(force-mode-line-update))))
+(defun files--ensure-directory (dir)
+ "Make directory DIR if it is not already a directory. Return nil."
+ (condition-case err
+ (make-directory-internal dir)
+ (error
+ (unless (file-directory-p dir)
+ (signal (car err) (cdr err))))))
+
(defun make-directory (dir &optional parents)
"Create the directory DIR and optionally any nonexistent parent dirs.
If DIR already exists as a directory, signal an error, unless
@@ -5420,18 +5421,19 @@ raised."
(if (not parents)
(make-directory-internal dir)
(let ((dir (directory-file-name (expand-file-name dir)))
- create-list)
- (while (and (not (file-exists-p dir))
- ;; If directory is its own parent, then we can't
- ;; keep looping forever
- (not (equal dir
- (directory-file-name
- (file-name-directory dir)))))
+ create-list parent)
+ (while (progn
+ (setq parent (directory-file-name
+ (file-name-directory dir)))
+ (condition-case ()
+ (files--ensure-directory dir)
+ (file-missing
+ ;; Do not loop if root does not exist (Bug#2309).
+ (not (string= dir parent)))))
(setq create-list (cons dir create-list)
- dir (directory-file-name (file-name-directory dir))))
- (while create-list
- (make-directory-internal (car create-list))
- (setq create-list (cdr create-list))))))))
+ dir parent))
+ (dolist (dir create-list)
+ (files--ensure-directory dir)))))))
(defconst directory-files-no-dot-files-regexp
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"
@@ -5564,10 +5566,10 @@ Noninteractively, the last argument PARENTS says whether to
create parent directories if they don't exist. Interactively,
this happens by default.
-If NEWNAME names an existing directory, copy DIRECTORY as a
-subdirectory there. However, if called from Lisp with a non-nil
-optional argument COPY-CONTENTS, copy the contents of DIRECTORY
-directly into NEWNAME instead."
+If NEWNAME is a directory name, copy DIRECTORY as a subdirectory
+there. However, if called from Lisp with a non-nil optional
+argument COPY-CONTENTS, copy the contents of DIRECTORY directly
+into NEWNAME instead."
(interactive
(let ((dir (read-directory-name
"Copy directory: " default-directory default-directory t nil)))
@@ -5589,35 +5591,32 @@ directly into NEWNAME instead."
;; Compute target name.
(setq directory (directory-file-name (expand-file-name directory))
- newname (directory-file-name (expand-file-name newname)))
+ newname (expand-file-name newname))
- (cond ((not (file-directory-p newname))
- ;; If NEWNAME is not an existing directory, create it;
+ (cond ((not (directory-name-p newname))
+ ;; If NEWNAME is not a directory name, create it;
;; that is where we will copy the files of DIRECTORY.
(make-directory newname parents))
- ;; If NEWNAME is an existing directory and COPY-CONTENTS
- ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME].
- ((not copy-contents)
- (setq newname (expand-file-name
- (file-name-nondirectory
- (directory-file-name directory))
- newname))
- (and (file-exists-p newname)
- (not (file-directory-p newname))
- (error "Cannot overwrite non-directory %s with a directory"
- newname))
- (make-directory newname t)))
+ ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
+ ;; create NEWNAME if it is not already a directory;
+ ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
+ ((if copy-contents
+ (or parents (not (file-directory-p newname)))
+ (setq newname (concat newname
+ (file-name-nondirectory directory))))
+ (make-directory (directory-file-name newname) parents)))
;; Copy recursively.
(dolist (file
;; We do not want to copy "." and "..".
(directory-files directory 'full
directory-files-no-dot-files-regexp))
- (let ((target (expand-file-name (file-name-nondirectory file) newname))
+ (let ((target (concat (file-name-as-directory newname)
+ (file-name-nondirectory file)))
(filetype (car (file-attributes file))))
(cond
((eq filetype t) ; Directory but not a symlink.
- (copy-directory file newname keep-time parents))
+ (copy-directory file target keep-time parents t))
((stringp filetype) ; Symbolic link
(make-symbolic-link filetype target t))
((copy-file file target t keep-time)))))
@@ -5906,7 +5905,11 @@ an auto-save file."
(error "%s is an auto-save file" (abbreviate-file-name file)))
(let ((file-name (let ((buffer-file-name file))
(make-auto-save-file-name))))
- (cond ((if (file-exists-p file)
+ (cond ((and (file-exists-p file)
+ (not (file-exists-p file-name)))
+ (error "Auto save file %s does not exist"
+ (abbreviate-file-name file-name)))
+ ((if (file-exists-p file)
(not (file-newer-than-file-p file-name file))
(not (file-exists-p file-name)))
(error "Auto-save file %s not current"
@@ -6076,16 +6079,18 @@ specifies the list of buffers to kill, asking for approval for each one."
(kill-buffer-ask buffer)))
(setq list (cdr list))))
-(defun kill-matching-buffers (regexp &optional internal-too)
+(defun kill-matching-buffers (regexp &optional internal-too no-ask)
"Kill buffers whose name matches the specified REGEXP.
-The optional second argument indicates whether to kill internal buffers too."
+Ignores buffers whose name starts with a space, unless optional
+prefix argument INTERNAL-TOO is non-nil. Asks before killing
+each buffer, unless NO-ASK is non-nil."
(interactive "sKill buffers matching this regular expression: \nP")
(dolist (buffer (buffer-list))
(let ((name (buffer-name buffer)))
(when (and name (not (string-equal name ""))
(or internal-too (/= (aref name 0) ?\s))
(string-match regexp name))
- (kill-buffer-ask buffer)))))
+ (funcall (if no-ask 'kill-buffer 'kill-buffer-ask) buffer)))))
(defun rename-auto-save-file ()
@@ -6436,58 +6441,31 @@ if you want to specify options, use `directory-free-space-args'.
A value of nil disables this feature.
-If the function `file-system-info' is defined, it is always used in
-preference to the program given by this variable."
+This variable is obsolete; Emacs no longer uses it."
:type '(choice (string :tag "Program") (const :tag "None" nil))
:group 'dired)
+(make-obsolete-variable 'directory-free-space-program
+ "ignored, as Emacs uses `file-system-info' instead"
+ "27.1")
(defcustom directory-free-space-args
(purecopy (if (eq system-type 'darwin) "-k" "-Pk"))
"Options to use when running `directory-free-space-program'."
:type 'string
:group 'dired)
+(make-obsolete-variable 'directory-free-space-args
+ "ignored, as Emacs uses `file-system-info' instead"
+ "27.1")
(defun get-free-disk-space (dir)
"Return the amount of free space on directory DIR's file system.
The return value is a string describing the amount of free
space (normally, the number of free 1KB blocks).
-This function calls `file-system-info' if it is available, or
-invokes the program specified by `directory-free-space-program'
-and `directory-free-space-args'. If the system call or program
-is unsuccessful, or if DIR is a remote directory, this function
-returns nil."
- (unless (file-remote-p (expand-file-name dir))
- ;; Try to find the number of free blocks. Non-Posix systems don't
- ;; always have df, but might have an equivalent system call.
- (if (fboundp 'file-system-info)
- (let ((fsinfo (file-system-info dir)))
- (if fsinfo
- (format "%.0f" (/ (nth 2 fsinfo) 1024))))
- (setq dir (expand-file-name dir))
- (save-match-data
- (with-temp-buffer
- (when (and directory-free-space-program
- ;; Avoid failure if the default directory does
- ;; not exist (Bug#2631, Bug#3911).
- (let ((default-directory
- (locate-dominating-file dir 'file-directory-p)))
- (eq (process-file directory-free-space-program
- nil t nil
- directory-free-space-args
- (file-relative-name dir))
- 0)))
- ;; Assume that the "available" column is before the
- ;; "capacity" column. Find the "%" and scan backward.
- (goto-char (point-min))
- (forward-line 1)
- (when (re-search-forward
- "[[:space:]]+[^[:space:]]+%[^%]*$"
- (line-end-position) t)
- (goto-char (match-beginning 0))
- (let ((endpt (point)))
- (skip-chars-backward "^[:space:]")
- (buffer-substring-no-properties (point) endpt)))))))))
+If DIR's free space cannot be obtained, this function returns nil."
+ (let ((avail (nth 2 (file-system-info dir))))
+ (if avail
+ (format "%.0f" (/ avail 1024)))))
;; The following expression replaces `dired-move-to-filename-regexp'.
(defvar directory-listing-before-filename-regexp
@@ -6546,6 +6524,75 @@ regardless of the language.")
(defvar insert-directory-ls-version 'unknown)
+(defun insert-directory-wildcard-in-dir-p (dir)
+ "Return non-nil if DIR contents a shell wildcard in the directory part.
+The return value is a cons (DIR . WILDCARDS); DIR is the
+`default-directory' in the Dired buffer, and WILDCARDS are the wildcards.
+
+Valid wildcards are '*', '?', '[abc]' and '[a-z]'."
+ (let ((wildcards "[?*"))
+ (when (and (or (not (featurep 'ls-lisp))
+ ls-lisp-support-shell-wildcards)
+ (string-match (concat "[" wildcards "]") (file-name-directory dir))
+ (not (file-exists-p dir))) ; Prefer an existing file to wildcards.
+ (let ((regexp (format "\\`\\([^%s]*/\\)\\([^%s]*[%s].*\\)"
+ wildcards wildcards wildcards)))
+ (string-match regexp dir)
+ (cons (match-string 1 dir) (match-string 2 dir))))))
+
+(defun insert-directory-clean (beg switches)
+ (when (if (stringp switches)
+ (string-match "--dired\\>" switches)
+ (member "--dired" switches))
+ ;; The following overshoots by one line for an empty
+ ;; directory listed with "--dired", but without "-a"
+ ;; switch, where the ls output contains a
+ ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
+ ;; We take care of that case later.
+ (forward-line -2)
+ (when (looking-at "//SUBDIRED//")
+ (delete-region (point) (progn (forward-line 1) (point)))
+ (forward-line -1))
+ (if (looking-at "//DIRED//")
+ (let ((end (line-end-position))
+ (linebeg (point))
+ error-lines)
+ ;; Find all the lines that are error messages,
+ ;; and record the bounds of each one.
+ (goto-char beg)
+ (while (< (point) linebeg)
+ (or (eql (following-char) ?\s)
+ (push (list (point) (line-end-position)) error-lines))
+ (forward-line 1))
+ (setq error-lines (nreverse error-lines))
+ ;; Now read the numeric positions of file names.
+ (goto-char linebeg)
+ (forward-word-strictly 1)
+ (forward-char 3)
+ (while (< (point) end)
+ (let ((start (insert-directory-adj-pos
+ (+ beg (read (current-buffer)))
+ error-lines))
+ (end (insert-directory-adj-pos
+ (+ beg (read (current-buffer)))
+ error-lines)))
+ (if (memq (char-after end) '(?\n ?\s))
+ ;; End is followed by \n or by " -> ".
+ (put-text-property start end 'dired-filename t)
+ ;; It seems that we can't trust ls's output as to
+ ;; byte positions of filenames.
+ (put-text-property beg (point) 'dired-filename nil)
+ (end-of-line))))
+ (goto-char end)
+ (beginning-of-line)
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; Take care of the case where the ls output contains a
+ ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
+ ;; and we went one line too far back (see above).
+ (forward-line 1))
+ (if (looking-at "//DIRED-OPTIONS//")
+ (delete-region (point) (progn (forward-line 1) (point))))))
+
;; insert-directory
;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
;; FULL-DIRECTORY-P is nil.
@@ -6605,19 +6652,25 @@ normally equivalent short `-D' option is just passed on to
default-file-name-coding-system))))
(setq result
(if wildcard
- ;; Run ls in the directory part of the file pattern
- ;; using the last component as argument.
- (let ((default-directory
- (if (file-name-absolute-p file)
- (file-name-directory file)
- (file-name-directory (expand-file-name file))))
- (pattern (file-name-nondirectory file)))
+ ;; If the wildcard is just in the file part, then run ls in
+ ;; the directory part of the file pattern using the last
+ ;; component as argument. Otherwise, run ls in the longest
+ ;; subdirectory of the directory part free of wildcards; use
+ ;; the remaining of the file pattern as argument.
+ (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file))
+ (default-directory
+ (cond (dir-wildcard (car dir-wildcard))
+ (t
+ (if (file-name-absolute-p file)
+ (file-name-directory file)
+ (file-name-directory (expand-file-name file))))))
+ (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file))))
;; NB since switches is passed to the shell, be
;; careful of malicious values, eg "-l;reboot".
;; See eg dired-safe-switches-p.
(call-process
shell-file-name nil t nil
- "-c"
+ shell-command-switch
(concat (if (memq system-type '(ms-dos windows-nt))
""
"\\") ; Disregard Unix shell aliases!
@@ -6659,7 +6712,8 @@ normally equivalent short `-D' option is just passed on to
(setq file (expand-file-name file)))
(list
(if full-directory-p
- (concat (file-name-as-directory file) ".")
+ ;; (concat (file-name-as-directory file) ".")
+ file
file))))))))
;; If we got "//DIRED//" in the output, it means we got a real
@@ -6730,59 +6784,7 @@ normally equivalent short `-D' option is just passed on to
;; Unix. Access the file to get a suitable error.
(access-file file "Reading directory")
(error "Listing directory failed but `access-file' worked")))
-
- (when (if (stringp switches)
- (string-match "--dired\\>" switches)
- (member "--dired" switches))
- ;; The following overshoots by one line for an empty
- ;; directory listed with "--dired", but without "-a"
- ;; switch, where the ls output contains a
- ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line.
- ;; We take care of that case later.
- (forward-line -2)
- (when (looking-at "//SUBDIRED//")
- (delete-region (point) (progn (forward-line 1) (point)))
- (forward-line -1))
- (if (looking-at "//DIRED//")
- (let ((end (line-end-position))
- (linebeg (point))
- error-lines)
- ;; Find all the lines that are error messages,
- ;; and record the bounds of each one.
- (goto-char beg)
- (while (< (point) linebeg)
- (or (eql (following-char) ?\s)
- (push (list (point) (line-end-position)) error-lines))
- (forward-line 1))
- (setq error-lines (nreverse error-lines))
- ;; Now read the numeric positions of file names.
- (goto-char linebeg)
- (forward-word-strictly 1)
- (forward-char 3)
- (while (< (point) end)
- (let ((start (insert-directory-adj-pos
- (+ beg (read (current-buffer)))
- error-lines))
- (end (insert-directory-adj-pos
- (+ beg (read (current-buffer)))
- error-lines)))
- (if (memq (char-after end) '(?\n ?\s))
- ;; End is followed by \n or by " -> ".
- (put-text-property start end 'dired-filename t)
- ;; It seems that we can't trust ls's output as to
- ;; byte positions of filenames.
- (put-text-property beg (point) 'dired-filename nil)
- (end-of-line))))
- (goto-char end)
- (beginning-of-line)
- (delete-region (point) (progn (forward-line 1) (point))))
- ;; Take care of the case where the ls output contains a
- ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line
- ;; and we went one line too far back (see above).
- (forward-line 1))
- (if (looking-at "//DIRED-OPTIONS//")
- (delete-region (point) (progn (forward-line 1) (point)))))
-
+ (insert-directory-clean beg switches)
;; Now decode what read if necessary.
(let ((coding (or coding-system-for-read
file-name-coding-system
@@ -7023,7 +7025,7 @@ only these files will be asked to be saved."
(setq file-arg-indices (cdr file-arg-indices))))
(pcase method
(`identity (car arguments))
- (`add (concat "/:" (apply operation arguments)))
+ (`add (file-name-quote (apply operation arguments)))
(`insert-file-contents
(let ((visit (nth 1 arguments)))
(unwind-protect
@@ -7217,8 +7219,8 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
;; If `trash-directory' is non-nil, move the file there.
(let* ((trash-dir (expand-file-name trash-directory))
(fn (directory-file-name (expand-file-name filename)))
- (new-fn (expand-file-name (file-name-nondirectory fn)
- trash-dir)))
+ (new-fn (concat (file-name-as-directory trash-dir)
+ (file-name-nondirectory fn))))
;; We can't trash a parent directory of trash-directory.
(if (string-prefix-p fn trash-dir)
(error "Trash directory `%s' is a subdirectory of `%s'"
@@ -7297,37 +7299,25 @@ Otherwise, trash FILENAME using the freedesktop.org conventions,
(format-time-string "%Y-%m-%dT%T")
"\n")
- ;; Attempt to make .trashinfo file, trying up to 5
- ;; times. The .trashinfo file is opened with O_EXCL,
- ;; as per trash-spec 0.7, even if that can be a problem
- ;; on old NFS versions...
- (let* ((tries 5)
- (base-fn (expand-file-name
- (file-name-nondirectory fn)
- trash-files-dir))
- (new-fn base-fn)
- success info-fn)
- (while (> tries 0)
- (setq info-fn (expand-file-name
- (concat (file-name-nondirectory new-fn)
- ".trashinfo")
- trash-info-dir))
- (unless (condition-case nil
- (progn
- (write-region nil nil info-fn nil
- 'quiet info-fn 'excl)
- (setq tries 0 success t))
- (file-already-exists nil))
- (setq tries (1- tries))
- ;; Uniquify new-fn. (Some file managers do not
- ;; like Emacs-style backup file names---e.g. bug
- ;; 170956 in Konqueror bug tracker.)
- (setq new-fn (make-temp-name (concat base-fn "_")))))
- (unless success
- (error "Cannot move %s to trash: Lock failed" filename))
-
+ ;; Make a .trashinfo file. Use O_EXCL, as per trash-spec 1.0.
+ (let* ((files-base (file-name-nondirectory fn))
+ (info-fn (expand-file-name
+ (concat files-base ".trashinfo")
+ trash-info-dir)))
+ (condition-case nil
+ (write-region nil nil info-fn nil 'quiet info-fn 'excl)
+ (file-already-exists
+ ;; Uniquify new-fn. Some file managers do not
+ ;; like Emacs-style backup file names. E.g.:
+ ;; https://bugs.kde.org/170956
+ (setq info-fn (make-temp-file
+ (expand-file-name files-base trash-info-dir)
+ nil ".trashinfo"))
+ (setq files-base (file-name-nondirectory info-fn))
+ (write-region nil nil info-fn nil 'quiet info-fn)))
;; Finally, try to move the file to the trashcan.
- (let ((delete-by-moving-to-trash nil))
+ (let ((delete-by-moving-to-trash nil)
+ (new-fn (expand-file-name files-base trash-files-dir)))
(rename-file fn new-fn)))))))))
(defsubst file-attribute-type (attributes)
diff --git a/lisp/filesets.el b/lisp/filesets.el
index 4542d6a5ef8..c2bdec0e6d7 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el
index 93abe02f14e..9801ee3afa3 100644
--- a/lisp/find-cmd.el
+++ b/lisp/find-cmd.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
index a92d477e1e0..3b0613b2806 100644
--- a/lisp/find-dired.el
+++ b/lisp/find-dired.el
@@ -1,4 +1,4 @@
-;;; find-dired.el --- run a `find' command and dired the output
+;;; find-dired.el --- run a `find' command and dired the output -*- lexical-binding: t -*-
;; Copyright (C) 1992, 1994-1995, 2000-2017 Free Software Foundation,
;; Inc.
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -255,14 +255,14 @@ See `find-name-arg' to customize the arguments."
(defalias 'lookfor-dired 'find-grep-dired)
;;;###autoload
(defun find-grep-dired (dir regexp)
- "Find files in DIR matching a regexp REGEXP and start Dired on output.
+ "Find files in DIR that contain matches for REGEXP and start Dired on output.
The command run (after changing into DIR) is
find . \\( -type f -exec `grep-program' `find-grep-options' \\
-e REGEXP {} \\; \\) -ls
-where the car of the variable `find-ls-option' specifies what to
-use in place of \"-ls\" as the final argument."
+where the first string in the value of the variable `find-ls-option'
+specifies what to use in place of \"-ls\" as the final argument."
;; Doc used to say "Thus ARG can also contain additional grep options."
;; i) Presumably ARG == REGEXP?
;; ii) No it can't have options, since it gets shell-quoted.
diff --git a/lisp/find-file.el b/lisp/find-file.el
index d3691694d17..8b45c9d5bed 100644
--- a/lisp/find-file.el
+++ b/lisp/find-file.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el
index e9f844487bc..e079e15b0aa 100644
--- a/lisp/find-lisp.el
+++ b/lisp/find-lisp.el
@@ -1,4 +1,4 @@
-;;; find-lisp.el --- emulation of find in Emacs Lisp
+;;; find-lisp.el --- emulation of find in Emacs Lisp -*- lexical-binding: t -*-
;; Author: Peter Breton
;; Created: Fri Mar 26 1999
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/finder.el b/lisp/finder.el
index 361572f7c2d..1cebad7b546 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -129,7 +129,7 @@ Keywords and package names both should be symbols.")
;; Skip autogenerated files, because they will never contain anything
;; useful, and because in parallel builds of Emacs they may get
;; modified while we are trying to read them.
-;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
+;; https://lists.gnu.org/r/emacs-pretest-bug/2007-01/msg00469.html
;; ldefs-boot is not auto-generated, but has nothing useful.
(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
@@ -209,7 +209,7 @@ from; the default is `load-path'."
;; There are multiple files in the tree with the same basename.
;; So skipping files based on basename means you randomly (depending
;; on which order the files are traversed in) miss some packages.
-;; http://debbugs.gnu.org/14010
+;; https://debbugs.gnu.org/14010
;; You might think this could lead to two files providing the same package,
;; but it does not, because the duplicates are (at time of writing)
;; all due to files in cedet, which end up with package-override set.
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
index c0609b0c3ab..5b16ee4214b 100644
--- a/lisp/flow-ctrl.el
+++ b/lisp/flow-ctrl.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/foldout.el b/lisp/foldout.el
index da69f8b259a..3f6485434d0 100644
--- a/lisp/foldout.el
+++ b/lisp/foldout.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/follow.el b/lisp/follow.el
index 5dd74f37a18..1ec6ff30f26 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -416,6 +416,7 @@ This command runs the normal hook `follow-mode-hook'.
Keys specific to Follow mode:
\\{follow-mode-map}"
+ :lighter follow-mode-line-text
:keymap follow-mode-map
(if follow-mode
(progn
@@ -1117,7 +1118,7 @@ Otherwise, return nil."
;;; Redisplay
;; Redraw all the windows on the screen, starting with the top window.
-;; The window used as as marker is WIN, or the selected window if WIN
+;; The window used as marker is WIN, or the selected window if WIN
;; is nil. Start every window directly after the end of the previous
;; window, to make sure long lines are displayed correctly.
diff --git a/lisp/font-core.el b/lisp/font-core.el
index f64e1b646ae..06b36a23512 100644
--- a/lisp/font-core.el
+++ b/lisp/font-core.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index 5eedb7849a0..3c9660dc64a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/format-spec.el b/lisp/format-spec.el
index 95ed000452c..fecf9d77b59 100644
--- a/lisp/format-spec.el
+++ b/lisp/format-spec.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/format.el b/lisp/format.el
index cbcba8250d4..8d3dd36fe5b 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -84,7 +84,7 @@
iso-sgml2iso iso-iso2sgml t nil)
(rot13 ,(purecopy "rot13")
nil
- ,(purecopy "tr a-mn-z n-za-m") ,(purecopy "tr a-mn-z n-za-m") t nil)
+ rot13-region rot13-region t nil)
(duden ,(purecopy "Duden Ersatzdarstellung")
nil
,(purecopy "diac") iso-iso2duden t nil)
diff --git a/lisp/forms.el b/lisp/forms.el
index e13dc170cb9..dacbd8c4671 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/frame.el b/lisp/frame.el
index b7a55169281..2e925325a9e 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -604,11 +604,12 @@ new frame."
(select-frame (make-frame))))
(defvar before-make-frame-hook nil
- "Functions to run before a frame is created.")
+ "Functions to run before `make-frame' creates a new frame.")
(defvar after-make-frame-functions nil
- "Functions to run after a frame is created.
-The functions are run with one arg, the newly created frame.")
+ "Functions to run after `make-frame' created a new frame.
+The functions are run with one argument, the newly created
+frame.")
(defvar after-setting-font-hook nil
"Functions to run after a frame's font has been changed.")
@@ -617,7 +618,7 @@ The functions are run with one arg, the newly created frame.")
(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
(defvar frame-inherited-parameters '()
- "Parameters `make-frame' copies from the `selected-frame' to the new frame.")
+ "Parameters `make-frame' copies from the selected to the new frame.")
(defvar x-display-name)
@@ -632,9 +633,6 @@ form (NAME . VALUE), for example:
(width . NUMBER) The frame should be NUMBER characters in width.
(height . NUMBER) The frame should be NUMBER text lines high.
-You cannot specify either `width' or `height', you must specify
-neither or both.
-
(minibuffer . t) The frame should have a minibuffer.
(minibuffer . nil) The frame should have no minibuffer.
(minibuffer . only) The frame should contain only a minibuffer.
@@ -650,10 +648,10 @@ neither or both.
In addition, any parameter specified in `default-frame-alist',
but not present in PARAMETERS, is applied.
-Before creating the frame (via `frame-creation-function-alist'),
-this function runs the hook `before-make-frame-hook'. After
-creating the frame, it runs the hook `after-make-frame-functions'
-with one arg, the newly created frame.
+Before creating the frame (via `frame-creation-function'), this
+function runs the hook `before-make-frame-hook'. After creating
+the frame, it runs the hook `after-make-frame-functions' with one
+argument, the newly created frame.
If a display parameter is supplied and a window-system is not,
guess the window-system from the display.
@@ -894,7 +892,8 @@ Calls `suspend-emacs' if invoked from the controlling tty device,
(defvar frame-name-history nil)
(defun select-frame-by-name (name)
- "Select the frame on the current terminal whose name is NAME and raise it.
+ "Select the frame whose name is NAME and raise it.
+Frames on the current terminal are checked first.
If there is no frame by that name, signal an error."
(interactive
(let* ((frame-names-alist (make-frame-names-alist))
@@ -905,11 +904,14 @@ If there is no frame by that name, signal an error."
(if (= (length input) 0)
(list default)
(list input))))
- (let* ((frame-names-alist (make-frame-names-alist))
- (frame (cdr (assoc name frame-names-alist))))
- (if frame
- (select-frame-set-input-focus frame)
- (error "There is no frame named `%s'" name))))
+ (select-frame-set-input-focus
+ ;; Prefer frames on the current display.
+ (or (cdr (assoc name (make-frame-names-alist)))
+ (catch 'done
+ (dolist (frame (frame-list))
+ (when (equal (frame-parameter frame 'name) name)
+ (throw 'done frame))))
+ (error "There is no frame named `%s'" name))))
;;;; Background mode.
@@ -1073,7 +1075,7 @@ is given and non-nil, the unwanted frames are iconified instead."
(when mini (setq parms (delq mini parms)))
;; Leave name in iff it was set explicitly.
;; This should fix the behavior reported in
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg01632.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg01632.html
(when (and name (not explicit-name))
(setq parms (delq name parms)))
parms))
@@ -1110,6 +1112,38 @@ differing font heights."
If FRAME is omitted, describe the currently selected frame."
(cdr (assq 'width (frame-parameters frame))))
+(defalias 'frame-border-width 'frame-internal-border-width)
+(defalias 'frame-pixel-width 'frame-native-width)
+(defalias 'frame-pixel-height 'frame-native-height)
+
+(defun frame-inner-width (&optional frame)
+ "Return inner width of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (- (frame-native-width frame)
+ (* 2 (frame-internal-border-width frame))))
+
+(defun frame-inner-height (&optional frame)
+ "Return inner height of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (- (frame-native-height frame)
+ (* 2 (frame-internal-border-width frame))))
+
+(defun frame-outer-width (&optional frame)
+ "Return outer width of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (let ((edges (frame-edges frame 'outer-edges)))
+ (- (nth 2 edges) (nth 0 edges))))
+
+(defun frame-outer-height (&optional frame)
+ "Return outer height of FRAME in pixels.
+FRAME defaults to the selected frame."
+ (setq frame (window-normalize-frame frame))
+ (let ((edges (frame-edges frame 'outer-edges)))
+ (- (nth 3 edges) (nth 1 edges))))
+
(declare-function x-list-fonts "xfaces.c"
(pattern &optional face frame maximum width))
@@ -1450,6 +1484,7 @@ FRAME."
(declare-function w32-mouse-absolute-pixel-position "w32fns.c")
(declare-function x-mouse-absolute-pixel-position "xfns.c")
+(declare-function ns-mouse-absolute-pixel-position "nsfns.c")
(defun mouse-absolute-pixel-position ()
"Return absolute position of mouse cursor in pixels.
@@ -1462,6 +1497,8 @@ position (0, 0) of the selected frame's terminal."
(x-mouse-absolute-pixel-position))
((eq frame-type 'w32)
(w32-mouse-absolute-pixel-position))
+ ((eq frame-type 'ns)
+ (ns-mouse-absolute-pixel-position))
(t
(cons 0 0)))))
@@ -2123,7 +2160,7 @@ To adjust bottom dividers for frames individually, use the frame
parameter `bottom-divider-width'."
:type '(restricted-sexp
:tag "Default width of bottom dividers"
- :match-alternatives (frame-window-divider-width-valid-p))
+ :match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
@@ -2140,7 +2177,7 @@ To adjust right dividers for frames individually, use the frame
parameter `right-divider-width'."
:type '(restricted-sexp
:tag "Default width of right dividers"
- :match-alternatives (frame-window-divider-width-valid-p))
+ :match-alternatives (window-divider-width-valid-p))
:initialize 'custom-initialize-default
:set (lambda (symbol value)
(set-default symbol value)
@@ -2401,7 +2438,11 @@ See also `toggle-frame-maximized'."
(set-frame-parameter nil 'fullscreen fullscreen-restore)
(set-frame-parameter nil 'fullscreen nil)))
(modify-frame-parameters
- nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))))
+ nil `((fullscreen . fullboth) (fullscreen-restore . ,fullscreen))))
+ ;; Manipulating a frame without waiting for the fullscreen
+ ;; animation to complete can cause a crash, or other unexpected
+ ;; behaviour, on macOS (bug#28496).
+ (when (featurep 'cocoa) (sleep-for 0.5))))
;;;; Key bindings
@@ -2426,7 +2467,13 @@ See also `toggle-frame-maximized'."
(make-obsolete-variable
'window-system-version "it does not give useful information." "24.3")
-;; Variables which should trigger redisplay of the current buffer.
+;; Variables whose change of value should trigger redisplay of the
+;; current buffer.
+;; To test whether a given variable needs to be added to this list,
+;; write a simple interactive function that changes the variable's
+;; value and bind that function to a simple key, like F5. If typing
+;; F5 then produces the correct effect, the variable doesn't need
+;; to be in this list; otherwise, it does.
(mapc (lambda (var)
(add-variable-watcher var (symbol-function 'set-buffer-redisplay)))
'(line-spacing
@@ -2434,6 +2481,10 @@ See also `toggle-frame-maximized'."
line-prefix
wrap-prefix
truncate-lines
+ display-line-numbers
+ display-line-numbers-width
+ display-line-numbers-current-absolute
+ display-line-numbers-widen
bidi-paragraph-direction
bidi-display-reordering))
diff --git a/lisp/frameset.el b/lisp/frameset.el
index ebf09d3ab5c..16940f814a9 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -446,8 +446,12 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
(buffer-list . :never)
(buffer-predicate . :never)
(buried-buffer-list . :never)
+ ;; Don't save the 'client' parameter to avoid that a subsequent
+ ;; `save-buffers-kill-terminal' in a non-client session barks at
+ ;; the user (Bug#29067).
+ (client . :never)
(delete-before . :never)
- (font . frameset-filter-shelve-param)
+ (font . frameset-filter-font-param)
(foreground-color . frameset-filter-sanitize-color)
(fullscreen . frameset-filter-shelve-param)
(GUI:font . frameset-filter-unshelve-param)
@@ -631,6 +635,17 @@ see `frameset-filter-alist'."
(setcdr found val)
nil))))
+(defun frameset-filter-font-param (current filtered parameters saving
+ &optional prefix)
+ "When switching from a tty frame to a GUI frame, remove the FONT param.
+
+When switching from a GUI frame to a tty frame, behave
+as `frameset-filter-shelve-param' does."
+ (or saving
+ (if (frameset-switch-to-tty-p parameters)
+ (frameset-filter-shelve-param current filtered parameters saving
+ prefix))))
+
(defun frameset-filter-iconified (_current _filtered parameters saving)
"Remove CURRENT when saving an iconified frame.
This is used for positional parameters `left' and `top', which are
@@ -1024,6 +1039,12 @@ Internal use only."
(frameset--initial-params filtered-cfg))))
(puthash frame :created frameset--action-map))
+ ;; Remove `border-width' from the list of parameters. If it has not
+ ;; been assigned via `make-frame-on-display', any attempt to assign
+ ;; it now via `modify-frame-parameters' may result in an error on X
+ ;; (Bug#28873).
+ (setq filtered-cfg (assq-delete-all 'border-width filtered-cfg))
+
;; Try to assign parent-frame right here - it will improve things
;; for minibuffer-less child frames.
(let* ((frame-id (frame-parameter frame 'frameset--parent-frame))
diff --git a/lisp/fringe.el b/lisp/fringe.el
index acd13b54b1f..3cb6f9d115b 100644
--- a/lisp/fringe.el
+++ b/lisp/fringe.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 8823faac0ff..09a5488a178 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index 4cf5129dcd5..c21d59bf706 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -3717,7 +3717,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2
index d7ff3b6205e..f1633389246 100644
--- a/lisp/gnus/ChangeLog.2
+++ b/lisp/gnus/ChangeLog.2
@@ -18553,7 +18553,7 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3
index a799f73f583..2d030b61b99 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -955,7 +955,7 @@
* gnus-sum.el (gnus-summary-read-group-1): Initialize the spam code if
that's needed.
- * spam.el (spam-initialize): Allow calling repeatedly, but only run the
+ * spam.el (spam-initialize): Allow calling repeatedly, but only run
the code once (bug#9069).
2014-01-18 Steinar Bang <sb@dod.no>
@@ -3819,7 +3819,7 @@
2012-02-15 Paul Eggert <eggert@cs.ucla.edu>
* shr.el (shr-rescale-image): Undo previous change; see
- <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00540.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-02/msg00540.html>.
2012-02-13 Lars Ingebrigtsen <larsi@gnus.org>
@@ -9303,7 +9303,7 @@
* mail-source.el, message.el, mm-bodies.el, mm-decode.el, mm-extern.el:
* mm-util.el, mm-view.el, mml-smime.el, mml.el, mml1991.el, mml2015.el:
* nnfolder.el, nnheader.el, nnmail.el, nnmaildir.el, nnrss.el, nntp.el:
- * rfc1843.el, sieve-manage.el, smime.el, spam.el:
+ * gnus-rfc1843.el, sieve-manage.el, smime.el, spam.el:
Fix comment for declare-function.
2010-10-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -10470,7 +10470,7 @@
2010-09-25 Julien Danjou <julien@danjou.info>
- * rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function
+ * gnus-rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function
variables.
* nnheader.el: Remove useless variables news-reply-yank-from and
@@ -14716,14 +14716,14 @@
* mml2015.el (gnus-buffer-live-p, gnus-get-buffer-create):
* nnfolder.el (gnus-request-group):
* nnheader.el (ietf-drums-unfold-fws):
- * rfc1843.el (mail-header-parse-content-type, message-narrow-to-head):
+ * gnus-rfc1843.el (mail-header-parse-content-type, message-narrow-to-head):
* smime.el (gnus-run-mode-hooks):
* spam-stat.el (gnus-message): Autoload.
* gnus-cache.el, gnus-fun.el, gnus-group.el, gnus.el, mail-source.el:
* mm-bodies.el, mm-decode.el, mm-extern.el, mm-util.el:
* mml-smime.el, mml.el, mml1991.el, mml2015.el, nndb.el, nnfolder.el:
- * nnmail.el, nnmaildir.el, nnrss.el, rfc1843.el, spam.el:
+ * nnmail.el, nnmaildir.el, nnrss.el, gnus-rfc1843.el, spam.el:
Add declare-function compatibility definition.
* gnus-cache.el (nnvirtual-find-group-art):
@@ -14753,7 +14753,7 @@
* nnmail.el (gnus-activate-group, gnus-group-mark-article-read):
* nnmaildir.el (gnus-group-mark-article-read):
* nnrss.el (w3-parse-buffer, gnus-group-make-rss-group):
- * rfc1843.el (message-fetch-field):
+ * gnus-rfc1843.el (message-fetch-field):
* spam.el (gnus-extract-address-components):
Declare as functions.
@@ -19139,7 +19139,7 @@
(mml-insert-parameter): Fold lines properly even if a parameter is
segmented into two or more lines; change the max column to 76.
- * rfc1843.el (rfc1843-decode-article-body): Don't use
+ * gnus-rfc1843.el (rfc1843-decode-article-body): Don't use
ignore-errors when calling mail-header-parse-content-type.
* rfc2231.el (rfc2231-parse-string): Return at least type if
@@ -20525,7 +20525,7 @@
* mml1991.el (mc-pgp-always-sign):
* mml2015.el (mc-pgp-always-sign):
* nnheader.el (nnmail-extra-headers):
- * rfc1843.el (gnus-decode-encoded-word-function)
+ * gnus-rfc1843.el (gnus-decode-encoded-word-function)
(gnus-decode-header-function, gnus-newsgroup-name):
* spam-stat.el (gnus-original-article-buffer): Add defvars.
@@ -26340,7 +26340,7 @@ See ChangeLog.2 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el
index 5157256594d..bb666ff934f 100644
--- a/lisp/gnus/canlock.el
+++ b/lisp/gnus/canlock.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el
index af8ccf182e4..897ca7048ba 100644
--- a/lisp/gnus/deuglify.el
+++ b/lisp/gnus/deuglify.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 45035646f76..4050046aab4 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el
index 93d86526af0..466da535605 100644
--- a/lisp/gnus/gnus-agent.el
+++ b/lisp/gnus/gnus-agent.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1108,7 +1108,7 @@ downloadable."
gnus-newsgroup-cached)
(setq articles (gnus-sorted-ndifference
(gnus-sorted-ndifference
- (gnus-copy-sequence articles)
+ (copy-tree articles)
gnus-newsgroup-downloadable)
gnus-newsgroup-cached)))
@@ -1123,7 +1123,7 @@ downloadable."
(when gnus-newsgroup-processable
(setq gnus-newsgroup-downloadable
(let* ((dl gnus-newsgroup-downloadable)
- (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
+ (processable (sort (copy-tree gnus-newsgroup-processable) '<))
(gnus-newsgroup-downloadable processable))
(gnus-agent-summary-fetch-group)
@@ -1513,7 +1513,7 @@ downloaded into the agent."
(let* ((fetched-articles (list nil))
(tail-fetched-articles fetched-articles)
(dir (gnus-agent-group-pathname group))
- (date (time-to-days (current-time)))
+ (date (time-to-days nil))
(case-fold-search t)
pos crosses
(file-name-coding-system nnmail-pathname-coding-system))
@@ -2833,7 +2833,7 @@ The following commands are available:
"Copy the current category."
(interactive (list (gnus-category-name) (intern (read-string "New name: "))))
(let ((info (assq category gnus-category-alist)))
- (push (let ((newcat (gnus-copy-sequence info)))
+ (push (let ((newcat (copy-tree info)))
(setf (gnus-agent-cat-name newcat) to)
(setf (gnus-agent-cat-groups newcat) nil)
newcat)
@@ -3089,7 +3089,7 @@ FORCE is equivalent to setting the expiration predicates to true."
(nov-entries-deleted 0)
(info (gnus-get-info group))
(alist gnus-agent-article-alist)
- (day (- (time-to-days (current-time))
+ (day (- (time-to-days nil)
(gnus-agent-find-parameter group 'agent-days-until-old)))
(specials (if (and alist
(not force))
@@ -3824,7 +3824,7 @@ has been fetched."
;; be expired later.
(gnus-agent-load-alist group)
(gnus-agent-save-alist group (list article)
- (time-to-days (current-time))))))
+ (time-to-days nil)))))
(defun gnus-agent-regenerate-group (group &optional reread)
"Regenerate GROUP.
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 66c9fbea871..97aa878ab63 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -3430,13 +3430,20 @@ possible values."
(progn
(goto-char date-position)
(setq date (get-text-property (point) 'original-date))
+ (beginning-of-line)
(when (looking-at "[^:]+:[\t ]*")
(setq bface (get-text-property (match-beginning 0) 'face)
eface (get-text-property (match-end 0) 'face)))
- (delete-region (point)
- (progn
- (gnus-article-forward-header)
- (point)))
+ (goto-char date-position)
+ (delete-region
+ (or (and (bolp) date-position)
+ ;; There might be space(s) added for line unfolding.
+ (and (get-text-property date-position 'gnus-date-type)
+ (< (skip-chars-backward "\t ") 0)
+ (text-property-any (point) date-position
+ 'gnus-date-type nil))
+ date-position)
+ (progn (gnus-article-forward-header) (point)))
(article-transform-date date type bface eface))
(save-restriction
(widen)
@@ -3455,9 +3462,14 @@ possible values."
(when (looking-at "[^:]+:[\t ]*")
(setq bface (get-text-property (match-beginning 0) 'face)
eface (get-text-property (match-end 0) 'face)))
- (delete-region pos (or (text-property-any pos (point-max)
- 'gnus-date-type nil)
- (point-max))))
+ ;; Note: a feature like `gnus-treat-unfold-headers' breaks
+ ;; the continuity of text props of a multi-line Date header,
+ ;; that a user-defined date format might create, by adding
+ ;; spaces. So, don't rely on gnus-date-type or original-date
+ ;; text prop in case of searching for the header boundary.
+ (delete-region pos (progn
+ (gnus-article-forward-header)
+ (point))))
(unless date ;; the 1st time
(goto-char (point-min))
(while (re-search-forward "^Date:[\t ]*" nil t)
@@ -3477,32 +3489,48 @@ possible values."
(widen)))))))
(defun article-transform-date (date type bface eface)
- (dolist (this-type (cond
- ((null type)
- (list 'ut))
- ((atom type)
- (list type))
- (t
- type)))
- (goto-char
- (prog1
- (point)
- (add-text-properties
- (point)
- (progn
- (insert (article-make-date-line date (or this-type 'ut)) "\n")
- (point))
- (list 'original-date date 'gnus-date-type this-type))))
- ;; Do highlighting.
- (when (looking-at
- "\\([^:]+:\\)[\t ]*\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?")
- (put-text-property (match-beginning 1) (match-end 1) 'face bface)
+ (let (begin date-line)
+ (dolist (this-type (cond ((null type)
+ (list 'ut))
+ ((atom type)
+ (list type))
+ (t
+ type)))
+ (setq begin (point)
+ date-line (article-make-date-line date (or this-type 'ut)))
+ (if (and (eq this-type 'user-defined) (bolp)
+ ;; Test if this is not a continuation.
+ (not (get-text-property
+ (prog2 (end-of-line 0) (point) (goto-char begin))
+ 'gnus-date-type)))
+ (progn
+ (string-match "\\`\\([^\t\n :]+:\\)?[\t ]*" date-line)
+ (if (match-beginning 1)
+ (insert date-line "\n")
+ ;; This user-defined date seems to intend to be a continuation
+ ;; line of a multi-line Date header like this:
+ ;; Date: Thu, Jan 1 00:00:00 1970 +0000
+ ;; (47 years, 5 months, 20 days ago)
+ (insert "Date: " (substring date-line (match-end 0)) "\n")))
+ (insert date-line "\n"))
+ (add-text-properties begin (point) (list 'original-date date
+ 'gnus-date-type this-type))
+ (goto-char begin)
+ ;; Do highlighting.
+ (beginning-of-line)
+ (looking-at
+ "\\([^\n:]+:\\)?[\t ]*\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?")
+ (when (and bface (match-beginning 1))
+ (put-text-property (match-beginning 1) (match-end 1) 'face bface))
(when (match-beginning 2)
- (put-text-property (match-beginning 2) (match-end 2) 'face eface))
- (while (and (zerop (forward-line 1))
- (looking-at "[\t ]+\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?"))
- (when (match-beginning 1)
- (put-text-property (match-beginning 1) (match-end 1) 'face eface))))))
+ (when eface
+ (put-text-property (match-beginning 2) (match-end 2) 'face eface))
+ (while (and (zerop (forward-line 1))
+ (looking-at
+ "[\t ]+\\(\\(?:[^\t\n ]+[\t ]+\\)*[^\t\n ]+\\)?"))
+ (when (and eface (match-beginning 1))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'face eface)))))))
(defun article-make-date-line (date type)
"Return a DATE line of TYPE."
@@ -3600,8 +3628,7 @@ possible values."
(defun article-lapsed-string (time &optional max-segments)
;; If the date is seriously mangled, the timezone functions are
;; liable to bug out, so we ignore all errors.
- (let* ((now (current-time))
- (real-time (time-subtract now time))
+ (let* ((real-time (time-subtract nil time))
(real-sec (and real-time
(+ (* (float (car real-time)) 65536)
(cadr real-time))))
@@ -3735,7 +3762,7 @@ is to run."
"Convert the current article date to the user-defined format.
This format is defined by the `gnus-article-time-format' variable."
(interactive (list t))
- (article-date-ut 'user highlight))
+ (article-date-ut 'user-defined highlight))
(defun article-date-iso8601 (&optional highlight)
"Convert the current article date to ISO8601."
@@ -4216,7 +4243,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(defun article-verify-x-pgp-sig ()
"Verify X-PGP-Sig."
- ;; <ftp://ftp.isc.org/pub/pgpcontrol/FORMAT>
+ ;; <https://ftp.isc.org/pub/pgpcontrol/FORMAT>
(interactive)
(if (gnus-buffer-live-p gnus-original-article-buffer)
(let ((sig (with-current-buffer gnus-original-article-buffer
@@ -5030,11 +5057,14 @@ and `gnus-mime-delete-part', and not provided at run-time normally."
(gnus-article-edit-done))
(gnus-configure-windows 'article)
(sit-for 0)
- (when (and current-id (integerp gnus-auto-select-part))
- (gnus-article-jump-to-part
- (min (max (+ current-id gnus-auto-select-part) 1)
- (with-current-buffer gnus-article-buffer
- (length gnus-article-mime-handle-alist)))))))
+ (let ((handles (with-current-buffer gnus-article-buffer
+ gnus-article-mime-handle-alist)))
+ ;; `handles' will be nil if there is the only one part
+ ;; in the article and is deleted.
+ (when (and handles current-id (integerp gnus-auto-select-part))
+ (gnus-article-jump-to-part
+ (min (max (+ current-id gnus-auto-select-part) 1)
+ (length handles)))))))
(defun gnus-mime-replace-part (file)
"Replace MIME part under point with an external body."
@@ -6311,8 +6341,9 @@ Provided for backwards compatibility."
;; in each element are in the increasing order.
(dolist (handle (reverse gnus-article-mime-handle-alist))
(if (stringp (cadr handle))
- (setq flat (nconc flat (gnus-article-mime-handles
- (cddr handle) (list (car handle)) flat)))
+ (when (cddr handle)
+ (setq flat (nconc flat (gnus-article-mime-handles
+ (cddr handle) (list (car handle)) flat))))
(delq (rassq (cdr handle) flat) flat)
(setq flat (nconc flat (list (cons (list (car handle))
(cdr handle)))))))
@@ -6335,7 +6366,7 @@ buttons to be added to the header are only the ones that aren't inlined
in the body. Use `gnus-header-face-alist' to highlight buttons."
(interactive (list t))
(gnus-with-article-buffer
- (let ((case-fold-search t) buttons handle type st)
+ (let ((case-fold-search t) buttons st)
(save-excursion
(save-restriction
(widen)
@@ -6356,22 +6387,7 @@ in the body. Use `gnus-header-face-alist' to highlight buttons."
;; Find buttons.
(setq buttons nil)
(dolist (button (gnus-article-mime-handles))
- (setq handle (cdr button)
- type (mm-handle-media-type handle))
- (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer)
- (with-current-buffer gnus-summary-buffer
- gnus-inhibit-images)
- gnus-inhibit-images)
- (string-match "\\`image/" type))
- (mm-inline-override-p handle)
- (and (mm-handle-disposition handle)
- (not (equal (car (mm-handle-disposition handle))
- "inline"))
- (not (mm-attachment-override-p handle)))
- (not (mm-automatic-display-p handle))
- (not (or (and (mm-inlinable-p handle)
- (mm-inlined-p handle))
- (mm-automatic-external-display-p type))))
+ (unless (mm-handle-undisplayer (cdr button))
(push button buttons)))
(when buttons
;; Add header buttons.
@@ -6382,8 +6398,7 @@ in the body. Use `gnus-header-face-alist' to highlight buttons."
(dolist (button (nreverse buttons))
(setq st (point))
(insert " ")
- (mm-handle-set-undisplayer (setq handle (cdr button)) nil)
- (gnus-insert-mime-button handle (car button))
+ (gnus-insert-mime-button (cdr button) (car button))
(skip-chars-backward "\t\n ")
(delete-region (point) (point-max))
(when (> (current-column) (window-width))
@@ -6968,6 +6983,7 @@ If given a prefix, show the hidden text instead."
(save-excursion
(erase-buffer)
(gnus-kill-all-overlays)
+ (setq bidi-paragraph-direction nil)
(setq group (or group gnus-newsgroup-name))
;; Using `gnus-request-article' directly will insert the article into
@@ -7075,6 +7091,7 @@ If given a prefix, show the hidden text instead."
(while (not result)
(erase-buffer)
(gnus-kill-all-overlays)
+ (setq bidi-paragraph-direction nil)
(let ((gnus-newsgroup-name group))
(gnus-check-group-server))
(cond
diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el
index 11e765d2d77..b9aa763bcd6 100644
--- a/lisp/gnus/gnus-async.el
+++ b/lisp/gnus/gnus-async.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el
index d85448e109f..30f377feea3 100644
--- a/lisp/gnus/gnus-bcklg.el
+++ b/lisp/gnus/gnus-bcklg.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -144,8 +144,8 @@
(setq end
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
- (with-current-buffer (or (current-buffer) buffer)
- (let ((buffer-read-only nil))
+ (with-current-buffer (or buffer (current-buffer))
+ (let ((inhibit-read-only t))
(erase-buffer)
(insert-buffer-substring gnus-backlog-buffer beg end)))
t))))
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 655881396c0..cef7df5e91c 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el
index fa3df7b14aa..801728d2f26 100644
--- a/lisp/gnus/gnus-cache.el
+++ b/lisp/gnus/gnus-cache.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -735,7 +735,7 @@ If LOW, update the lower bound instead."
;; `gnus-cache-unified-group-names' needless.
(gnus-sethash (or (cdr (assoc group gnus-cache-unified-group-names))
group)
- (cons (car nums) (gnus-last-element nums))
+ (cons (car nums) (car (last nums)))
gnus-cache-active-hashtb))
;; Go through all the other files.
(dolist (file alphs)
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index 3194e966f0f..3cd98ce680d 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 605dda2509b..c57576cf3c7 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -219,7 +219,7 @@ easy interactive way to set this from the Server buffer."
Use old data if FORCE-OLDER is not nil."
(let* ((contents (plist-get elem :contents))
(date (or (plist-get elem :timestamp) "0"))
- (now (gnus-cloud-timestamp (current-time)))
+ (now (gnus-cloud-timestamp nil))
(newer (string-lessp date now))
(group-info (gnus-get-info group)))
(if (and contents
@@ -486,7 +486,7 @@ Otherwise, returns the Gnus Cloud data chunks."
(gnus-method-to-server
(gnus-find-method-for-group (gnus-info-group info))))
- (push `(:type :newsrc-data :name ,(gnus-info-group info) :contents ,info :timestamp ,(gnus-cloud-timestamp (current-time)))
+ (push `(:type :newsrc-data :name ,(gnus-info-group info) :contents ,info :timestamp ,(gnus-cloud-timestamp nil))
infos)))
infos))
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index e5787e86257..f698d806171 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -406,7 +406,7 @@ category."))
;; every duplicate ends up being displayed. So, rather than
;; display them, remove them from the list.
- (let ((tmp (setq values (gnus-copy-sequence values)))
+ (let ((tmp (setq values (copy-tree values)))
elem)
(while (cdr tmp)
(while (setq elem (assq (caar tmp) (cdr tmp)))
@@ -454,7 +454,7 @@ Set variables local to the group you are entering.
If you want to turn threading off in `news.answers', you could put
`(gnus-show-threads nil)' in the group parameters of that group.
`gnus-show-threads' will be made into a local variable in the summary
-buffer you enter, and the form nil will be `eval'ed there.
+buffer you enter, and the form nil will be `eval'uated there.
This can also be used as a group-specific hook function, if you'd
like. If you want to hear a beep when you enter a group, you could
@@ -535,7 +535,7 @@ These files will not be loaded, even though they would normally be so,
for some reason or other.")
(eval (sexp :tag "Eval" :value nil) "\
-The value of this entry will be `eval'el.
+The value of this entry will be `eval'uated.
This element will be ignored when handling global score files.")
(read-only (boolean :tag "Read-only" :value t) "\
diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el
index 7b599679125..0917b023af8 100644
--- a/lisp/gnus/gnus-delay.el
+++ b/lisp/gnus/gnus-delay.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el
index 81f9650ae3f..28e2699a6a4 100644
--- a/lisp/gnus/gnus-demon.el
+++ b/lisp/gnus/gnus-demon.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el
index b81c6d08f5e..5000486d19b 100644
--- a/lisp/gnus/gnus-diary.el
+++ b/lisp/gnus/gnus-diary.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el
index 10533cafd97..9394c3d7702 100644
--- a/lisp/gnus/gnus-dired.el
+++ b/lisp/gnus/gnus-dired.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el
index 6e7b307770c..77bf93af50c 100644
--- a/lisp/gnus/gnus-draft.el
+++ b/lisp/gnus/gnus-draft.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el
index f91ebbeff12..2f21efb6ee3 100644
--- a/lisp/gnus/gnus-dup.el
+++ b/lisp/gnus/gnus-dup.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el
index 93af05f4b3f..6f8722b0c71 100644
--- a/lisp/gnus/gnus-eform.el
+++ b/lisp/gnus/gnus-eform.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el
index 787c0e3a0f5..1b45847c0b3 100644
--- a/lisp/gnus/gnus-fun.el
+++ b/lisp/gnus/gnus-fun.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index b4763c76814..bcf09f434e9 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 8a061b70bf6..63e59e94e2e 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1359,6 +1359,8 @@ if it is a string, only list groups matching REGEXP."
(and gnus-permanently-visible-groups
(string-match gnus-permanently-visible-groups
group))
+ ;; Marked groups are always visible.
+ (member group gnus-group-marked)
(memq 'visible params)
(cdr (assq 'visible params)))))))
(gnus-group-insert-group-line
@@ -2373,7 +2375,10 @@ specified by `gnus-gmane-group-download-format'."
(with-temp-file tmpfile
(url-insert-file-contents
(format gnus-gmane-group-download-format
- group start (+ start range)))
+ group start (+ start range))
+ t)
+ ;; `url-insert-file-contents' sets this because of the 2nd arg.
+ (setq buffer-file-name nil)
(write-region (point-min) (point-max) tmpfile)
(gnus-group-read-ephemeral-group
(format "nndoc+ephemeral:%s.start-%s.range-%s" group start range)
@@ -2429,7 +2434,7 @@ Valid input formats include:
(gnus-read-ephemeral-gmane-group group start range)))
(defcustom gnus-bug-group-download-format-alist
- '((emacs . "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes")
+ '((emacs . "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes")
(debian
. "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes"))
"Alist of symbols for bug trackers and the corresponding URL format string.
@@ -2463,13 +2468,11 @@ the bug number, and browsing the URL must return mbox output."
(if (and (not gnus-plugged)
(file-exists-p file))
(insert-file-contents file)
- (url-insert-file-contents (format mbox-url id)))))
+ (url-insert-file-contents (format mbox-url id) t))))
;; Add the debbugs address so that we can respond to reports easily.
(let ((address
(format "%s@%s" (car ids)
- (replace-regexp-in-string
- "/.*$" ""
- (replace-regexp-in-string "^http://" "" mbox-url)))))
+ (url-host (url-generic-parse-url mbox-url)))))
(goto-char (point-min))
(while (re-search-forward (concat "^" message-unix-mail-delimiter)
nil t)
@@ -2490,7 +2493,9 @@ the bug number, and browsing the URL must return mbox output."
(insert ", " address))
(insert "To: " address "\n")))
(goto-char (point-max))
- (widen)))))
+ (widen)))
+ ;; `url-insert-file-contents' sets this because of the 2nd arg.
+ (setq buffer-file-name nil)))
(gnus-group-read-ephemeral-group
(format "nndoc+ephemeral:bug#%s"
(mapconcat 'number-to-string ids ","))
@@ -2514,6 +2519,8 @@ the bug number, and browsing the URL must return mbox output."
(interactive (list (string-to-number
(read-string "Enter bug number: "
(thing-at-point 'word) nil))))
+ (when (stringp ids)
+ (setq ids (string-to-number ids)))
(unless (listp ids)
(setq ids (list ids)))
(gnus-read-ephemeral-bug-group
@@ -2993,7 +3000,7 @@ and NEW-NAME will be prompted for."
;; Set the info.
(if (not (and info new-group))
(gnus-group-set-info form (or new-group group) part)
- (setq info (gnus-copy-sequence info))
+ (setq info (copy-tree info))
(setcar info new-group)
(unless (gnus-server-equal method "native")
(unless (nthcdr 3 info)
@@ -3016,7 +3023,7 @@ and NEW-NAME will be prompted for."
;; Don't use `caddr' here since macros within the `interactive'
;; form won't be expanded.
(car (cddr entry)))))
- (setq method (gnus-copy-sequence method))
+ (setq method (copy-tree method))
(let (entry)
(while (setq entry (memq (assq 'eval method) method))
(setcar entry (eval (cadar entry)))))
@@ -4560,7 +4567,7 @@ or `gnus-group-catchup-group-hook'."
"Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
(let* ((time (or (gnus-group-timestamp group)
(list 0 0)))
- (delta (time-subtract (current-time) time)))
+ (delta (time-subtract nil time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))
diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el
index d4dccfb7b1f..7fa36359f67 100644
--- a/lisp/gnus/gnus-html.el
+++ b/lisp/gnus/gnus-html.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -99,11 +99,7 @@ fit these criteria."
(not (file-exists-p (url-cache-create-filename url))))
(t (let ((cache-time (url-is-cached url)))
(if cache-time
- (time-less-p
- (time-add
- cache-time
- ttl)
- (current-time))
+ (time-less-p (time-add cache-time ttl) nil)
t)))))
;;;###autoload
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el
index 1f194f888d2..cca4a81d1c0 100644
--- a/lisp/gnus/gnus-icalendar.el
+++ b/lisp/gnus/gnus-icalendar.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el
index aaeba4a4331..0c7381286cd 100644
--- a/lisp/gnus/gnus-int.el
+++ b/lisp/gnus/gnus-int.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el
index c405c04e38e..4c15471b97a 100644
--- a/lisp/gnus/gnus-kill.el
+++ b/lisp/gnus/gnus-kill.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el
index b1499722f48..4762025bf75 100644
--- a/lisp/gnus/gnus-logic.el
+++ b/lisp/gnus/gnus-logic.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el
index 502b295cd60..90622926733 100644
--- a/lisp/gnus/gnus-mh.el
+++ b/lisp/gnus/gnus-mh.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el
index 32cf1713317..e3cdd9c3932 100644
--- a/lisp/gnus/gnus-ml.el
+++ b/lisp/gnus/gnus-ml.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el
index c42c34adceb..d0810ca8221 100644
--- a/lisp/gnus/gnus-mlspl.el
+++ b/lisp/gnus/gnus-mlspl.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -72,8 +72,7 @@ match any of the group-specified splitting rules. See
;;;###autoload
(defun gnus-group-split-update (&optional catch-all)
"Computes nnmail-split-fancy from group params and CATCH-ALL.
-It does this by calling by calling (gnus-group-split-fancy nil
-nil CATCH-ALL).
+It does this by calling (gnus-group-split-fancy nil nil CATCH-ALL).
If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used
instead. This variable is set by `gnus-group-split-setup'."
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 85969edc81b..7a28be19d4a 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el
index 288dbe1b9f2..6e8dbb5c35e 100644
--- a/lisp/gnus/gnus-notifications.el
+++ b/lisp/gnus/gnus-notifications.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -154,7 +154,7 @@ This is typically a function to add in
(dolist (entry gnus-newsrc-alist)
(let ((group (car entry)))
;; Check that the group level is less than
- ;; `gnus-notifications-minimum-level' and the the group has unread
+ ;; `gnus-notifications-minimum-level' and the group has unread
;; messages.
(when (and (<= (gnus-group-level group) gnus-notifications-minimum-level)
(let ((unread (gnus-group-unread group)))
diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el
index 41463e3f02f..da56b4eef05 100644
--- a/lisp/gnus/gnus-picon.el
+++ b/lisp/gnus/gnus-picon.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el
index 0680123e347..70548d02804 100644
--- a/lisp/gnus/gnus-range.el
+++ b/lisp/gnus/gnus-range.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -38,17 +38,9 @@ If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
(while (cdr list)
(setq list (cdr list)))
(car list))
+(make-obsolete 'gnus-last-element "use `car' of `last' instead." "27.1")
-(defun gnus-copy-sequence (list)
- "Do a complete, total copy of a list."
- (let (out)
- (while (consp list)
- (if (consp (car list))
- (push (gnus-copy-sequence (pop list)) out)
- (push (pop list) out)))
- (if list
- (nconc (nreverse out) list)
- (nreverse out))))
+(define-obsolete-function-alias 'gnus-copy-sequence 'copy-tree "27.1")
(defun gnus-set-difference (list1 list2)
"Return a list of elements of LIST1 that do not appear in LIST2."
@@ -455,7 +447,7 @@ modified."
(if (or (null range1) (null range2))
range1
(let (out r1 r2 r1_min r1_max r2_min r2_max
- (range2 (gnus-copy-sequence range2)))
+ (range2 (copy-tree range2)))
(setq range1 (if (listp (cdr range1)) range1 (list range1))
range2 (sort (if (listp (cdr range2)) range2 (list range2))
(lambda (e1 e2)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 51f6459d2f8..466238d2523 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index a47e19b8f0d..6477d0114a7 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el
index 7037328b7a4..ab2ffa9228e 100644
--- a/lisp/gnus/gnus-salt.el
+++ b/lisp/gnus/gnus-salt.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el
index 2defa76f50d..765dfab570a 100644
--- a/lisp/gnus/gnus-score.el
+++ b/lisp/gnus/gnus-score.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -43,7 +43,7 @@ for each score file or each score file directory. Gnus will decide
by itself what score files are applicable to which group.
Say you want to use the single score file
-\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
+\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" and all
score files in the \"/ftp.some-where:/pub/score\" directory.
(setq gnus-global-score-files
@@ -1078,11 +1078,11 @@ EXTRA is the possible non-standard header."
"Return the score of the current article.
With prefix ARG, return the total score of the current (sub)thread."
(interactive "P")
- (gnus-message 1 "%s" (if arg
- (gnus-thread-total-score
- (gnus-id-to-thread
- (mail-header-id (gnus-summary-article-header))))
- (gnus-summary-article-score))))
+ (message "%s" (if arg
+ (gnus-thread-total-score
+ (gnus-id-to-thread
+ (mail-header-id (gnus-summary-article-header))))
+ (gnus-summary-article-score))))
(defun gnus-score-change-score-file (file)
"Change current score alist."
@@ -1238,7 +1238,7 @@ If FORMAT, also format the current score file."
(or (not decay)
(gnus-decay-scores alist decay)))
(gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
+ (gnus-score-set 'decay (list (time-to-days nil)) alist))
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
@@ -2318,7 +2318,7 @@ score in `gnus-newsgroup-scored' by SCORE."
(when (or (not (listp gnus-newsgroup-adaptive))
(memq 'line gnus-newsgroup-adaptive))
(save-excursion
- (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
+ (let* ((malist (copy-tree gnus-adaptive-score-alist))
(alist malist)
(date (current-time-string))
(data gnus-newsgroup-data)
@@ -2731,8 +2731,10 @@ GROUP using BNews sys file syntax."
(insert (car sfiles))
(goto-char (point-min))
;; First remove the suffix itself.
- (when (re-search-forward (concat "." score-regexp) nil t)
- (replace-match "" t t)
+ (when (re-search-forward score-regexp nil t)
+ (unless (= (match-end 0) (match-beginning 0)) ; non-empty suffix
+ (replace-match "" t t)
+ (delete-char -1)) ; remove the "." before the suffix
(goto-char (point-min))
(if (looking-at (regexp-quote kill-dir))
;; If the file name was just "SCORE", `klen' is one character
@@ -2961,8 +2963,8 @@ The list is determined from the variable `gnus-score-file-alist'."
(expand-file-name suffix gnus-kill-files-directory))
((gnus-use-long-file-name 'not-score)
;; Append ".SCORE" to newsgroup name.
- (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
- "." suffix)
+ (expand-file-name (let ((name (gnus-newsgroup-savable-name newsgroup)))
+ (if (string= "" suffix) name (concat name "." suffix)))
gnus-kill-files-directory))
(t
;; Place "SCORE" under the hierarchical directory.
@@ -3060,7 +3062,7 @@ If ADAPT, return the home adaptive file instead."
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
- (let ((times (- (time-to-days (current-time)) day))
+ (let ((times (- (time-to-days nil) day))
kill entry updated score n)
(unless (zerop times) ;Done decays today already?
(while (setq entry (pop alist))
diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el
index 2c5fd34f8ca..00f0636cf77 100644
--- a/lisp/gnus/gnus-sieve.el
+++ b/lisp/gnus/gnus-sieve.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el
index 809371d6109..a6149062587 100644
--- a/lisp/gnus/gnus-spec.el
+++ b/lisp/gnus/gnus-spec.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index bed5993b9c1..a3341470fa2 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -452,7 +452,8 @@ The following commands are available:
(if server (error "No such server: %s" server)
(error "No server on the current line")))
(unless (assoc server gnus-server-alist)
- (error "Read-only server %s" server))
+ (error "Server %s must be deleted from your configuration files"
+ server))
(gnus-dribble-touch)
(let ((buffer-read-only nil))
(gnus-delete-line))
@@ -608,7 +609,7 @@ The following commands are available:
(error "%s already exists" to))
(unless (gnus-server-to-method from)
(error "%s: no such server" from))
- (let ((to-entry (cons from (gnus-copy-sequence
+ (let ((to-entry (cons from (copy-tree
(gnus-server-to-method from)))))
(setcar to-entry to)
(setcar (nthcdr 2 to-entry) to)
@@ -642,7 +643,8 @@ The following commands are available:
(unless server
(error "No server on current line"))
(unless (assoc server gnus-server-alist)
- (error "This server can't be edited"))
+ (error "Server %s must be edited in your configuration files"
+ server))
(let ((info (cdr (assoc server gnus-server-alist))))
(gnus-close-server info)
(gnus-edit-form
@@ -1157,7 +1159,7 @@ Requesting compaction of %s... (this may take a long time)"
(error "The server under point can't host the Emacs Cloud"))
(when (not (string-equal gnus-cloud-method server))
- (custom-set-variables '(gnus-cloud-method server))
+ (customize-set-variable 'gnus-cloud-method server)
;; Note we can't use `Custom-save' here.
(when (gnus-yes-or-no-p
(format "The new cloud host server is %S now. Save it? " server))
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index aaa8ab9a888..3c3c594fe7b 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 9bdd0c66f56..e599a8460f3 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -3992,7 +3992,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(spam-initialize))
;; Save the active value in effect when the group was entered.
(setq gnus-newsgroup-active
- (gnus-copy-sequence
+ (copy-tree
(gnus-active gnus-newsgroup-name)))
(setq gnus-newsgroup-highest (cdr gnus-newsgroup-active))
;; You can change the summary buffer in some way with this hook.
@@ -5737,7 +5737,7 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(mail-header-number (car gnus-newsgroup-headers))
gnus-newsgroup-end
(mail-header-number
- (gnus-last-element gnus-newsgroup-headers))))
+ (car (last gnus-newsgroup-headers)))))
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
@@ -6076,12 +6076,12 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(del
(gnus-list-range-intersection
gnus-newsgroup-articles
- (gnus-remove-from-range (gnus-copy-sequence old) list)))
+ (gnus-remove-from-range (copy-tree old) list)))
(add
(gnus-list-range-intersection
gnus-newsgroup-articles
(gnus-remove-from-range
- (gnus-copy-sequence list) old))))
+ (copy-tree list) old))))
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
@@ -6931,7 +6931,7 @@ displayed, no centering will be performed."
(save-excursion
;; Take care of tree window mode.
(if (get-buffer-window gnus-group-buffer 0)
- (pop-to-buffer gnus-group-buffer)
+ (pop-to-buffer gnus-group-buffer t)
(set-buffer gnus-group-buffer))
(gnus-group-jump-to-group newsgroup))))
@@ -9780,8 +9780,11 @@ If ARG is a negative number, hide the unwanted header lines."
(inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
- (or (not (looking-at "[^ \t\n]+:"))
- (gnus-article-hidden-text-p 'headers))))
+ (or
+ ;; The case where there's no visible header
+ ;; that matches `gnus-visible-headers'.
+ (looking-at "\n?\\'")
+ (gnus-article-hidden-text-p 'headers))))
s e)
(delete-region (point-min) (point-max))
(with-current-buffer gnus-original-article-buffer
@@ -9841,7 +9844,7 @@ IDNA encoded domain names looks like `xn--bar'. If a string
remain unencoded after running this function, it is likely an
invalid IDNA string (`xn--bar' is invalid).
-You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
+You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/')
installed for this command to work."
(interactive "P")
(gnus-summary-select-article)
@@ -10291,7 +10294,6 @@ latter case, they will be copied into the relevant groups."
"Import an arbitrary file into a mail newsgroup."
(interactive "fImport file: \nP")
(let ((group gnus-newsgroup-name)
- (now (current-time))
atts lines group-art)
(unless (gnus-check-backend-function 'request-accept-article group)
(error "%s does not support article importing" group))
@@ -10310,6 +10312,7 @@ latter case, they will be copied into the relevant groups."
(goto-char (point-min))
(unless (re-search-forward "^date:" nil t)
(goto-char (point-max))
+ (setq atts (file-attributes file))
(insert "Date: " (message-make-date (nth 5 atts)) "\n")))
;; This doesn't look like an article, so we fudge some headers.
(setq atts (file-attributes file)
@@ -11959,7 +11962,7 @@ Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'chars reverse))
-(defun gnus-summary-sort-by-mark (&optional reverse)
+(defun gnus-summary-sort-by-marks (&optional reverse)
"Sort the summary buffer by article marks.
Argument REVERSE means reverse order."
(interactive "P")
@@ -12912,7 +12915,7 @@ returned."
(mail-header-number (car gnus-newsgroup-headers))
gnus-newsgroup-end
(mail-header-number
- (gnus-last-element gnus-newsgroup-headers))))
+ (car (last gnus-newsgroup-headers)))))
(when gnus-use-scoring
(gnus-possibly-score-headers))))
@@ -12999,7 +13002,7 @@ If ALL is a number, fetch this number of articles."
i new)
(unless new-active
(error "Couldn't fetch new data"))
- (setq gnus-newsgroup-active (gnus-copy-sequence new-active))
+ (setq gnus-newsgroup-active (copy-tree new-active))
(setq i (cdr gnus-newsgroup-active)
gnus-newsgroup-highest i)
(while (> i old-high)
diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el
index 6d6e20dc129..ba756e0314c 100644
--- a/lisp/gnus/gnus-topic.el
+++ b/lisp/gnus/gnus-topic.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -220,6 +220,8 @@ If RECURSIVE is t, return groups in its subtopics too."
;; Check for permanent visibility.
(and gnus-permanently-visible-groups
(string-match gnus-permanently-visible-groups group))
+ ;; Marked groups are always visible.
+ (member group gnus-group-marked)
(memq 'visible params)
(cdr (assq 'visible params)))
;; Add this group to the list of visible groups.
diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el
index 74e0601c6e3..23cabadad6a 100644
--- a/lisp/gnus/gnus-undo.el
+++ b/lisp/gnus/gnus-undo.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index b509d8ad448..b7477a7fa80 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -594,9 +594,6 @@ If N, return the Nth ancestor instead."
(read-file-name "Copy file to: " default-directory)))
(unless to
(setq to (read-file-name "Copy file to: " default-directory)))
- (when (file-directory-p to)
- (setq to (concat (file-name-as-directory to)
- (file-name-nondirectory file))))
(copy-file file to))
(defvar gnus-work-buffer " *gnus work*")
diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el
index 62192173498..526d00754b7 100644
--- a/lisp/gnus/gnus-uu.el
+++ b/lisp/gnus/gnus-uu.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el
index 143500cc048..e05f849bb37 100644
--- a/lisp/gnus/gnus-vm.el
+++ b/lisp/gnus/gnus-vm.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el
index 255bb5f42eb..8e47ae3f984 100644
--- a/lisp/gnus/gnus-win.el
+++ b/lisp/gnus/gnus-win.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index d3edcd08513..3458fdea718 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1,4 +1,4 @@
-;;; gnus.el --- a newsreader for GNU Emacs
+;;; gnus.el --- a newsreader for GNU Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1987-1990, 1993-1998, 2000-2017 Free Software
;; Foundation, Inc.
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,7 +29,7 @@
(run-hooks 'gnus-load-hook)
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'wid-edit)
(require 'mm-util)
(require 'nnheader)
@@ -335,21 +335,6 @@ be set in `.emacs' instead."
;; We define these group faces here to avoid the display
;; update forced when creating new faces.
-(defface gnus-group-news-1
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "ForestGreen" :bold t))
- (t
- ()))
- "Level 1 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
-(put 'gnus-group-news-1-face 'obsolete-face "22.1")
-
(defface gnus-group-news-1-empty
'((((class color)
(background dark))
@@ -365,25 +350,18 @@ be set in `.emacs' instead."
(put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty)
(put 'gnus-group-news-1-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-2
- '((((class color)
- (background dark))
- (:foreground "turquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "CadetBlue4" :bold t))
- (t
- ()))
- "Level 2 newsgroup face."
+(defface gnus-group-news-1
+ '((t (:inherit gnus-group-news-1-empty :bold t)))
+ "Level 1 newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
-(put 'gnus-group-news-2-face 'obsolete-face "22.1")
+(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
+(put 'gnus-group-news-1-face 'obsolete-face "22.1")
(defface gnus-group-news-2-empty
'((((class color)
(background dark))
- (:foreground "turquoise"))
+ (:foreground "turquoise4"))
(((class color)
(background light))
(:foreground "CadetBlue4"))
@@ -395,28 +373,21 @@ be set in `.emacs' instead."
(put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty)
(put 'gnus-group-news-2-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-3
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 3 newsgroup face."
+(defface gnus-group-news-2
+ '((t (:inherit gnus-group-news-2-empty :bold t)))
+ "Level 2 newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
-(put 'gnus-group-news-3-face 'obsolete-face "22.1")
+(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
+(put 'gnus-group-news-2-face 'obsolete-face "22.1")
(defface gnus-group-news-3-empty
'((((class color)
(background dark))
- ())
+ (:foreground "turquoise3"))
(((class color)
(background light))
- ())
+ (:foreground "DeepSkyBlue4"))
(t
()))
"Level 3 empty newsgroup face."
@@ -425,28 +396,21 @@ be set in `.emacs' instead."
(put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty)
(put 'gnus-group-news-3-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-4
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 4 newsgroup face."
+(defface gnus-group-news-3
+ '((t (:inherit gnus-group-news-3-empty :bold t)))
+ "Level 3 newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
-(put 'gnus-group-news-4-face 'obsolete-face "22.1")
+(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
+(put 'gnus-group-news-3-face 'obsolete-face "22.1")
(defface gnus-group-news-4-empty
'((((class color)
(background dark))
- ())
+ (:foreground "turquoise2"))
(((class color)
(background light))
- ())
+ (:foreground "DeepSkyBlue3"))
(t
()))
"Level 4 empty newsgroup face."
@@ -455,28 +419,21 @@ be set in `.emacs' instead."
(put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty)
(put 'gnus-group-news-4-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-5
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 5 newsgroup face."
+(defface gnus-group-news-4
+ '((t (:inherit gnus-group-news-4-empty :bold t)))
+ "Level 4 newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
-(put 'gnus-group-news-5-face 'obsolete-face "22.1")
+(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
+(put 'gnus-group-news-4-face 'obsolete-face "22.1")
(defface gnus-group-news-5-empty
'((((class color)
(background dark))
- ())
+ (:foreground "turquoise1"))
(((class color)
(background light))
- ())
+ (:foreground "DeepSkyBlue2"))
(t
()))
"Level 5 empty newsgroup face."
@@ -485,20 +442,13 @@ be set in `.emacs' instead."
(put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty)
(put 'gnus-group-news-5-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-6
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 6 newsgroup face."
+(defface gnus-group-news-5
+ '((t (:inherit gnus-group-news-5-empty :bold t)))
+ "Level 5 newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
-(put 'gnus-group-news-6-face 'obsolete-face "22.1")
+(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
+(put 'gnus-group-news-5-face 'obsolete-face "22.1")
(defface gnus-group-news-6-empty
'((((class color)
@@ -515,20 +465,13 @@ be set in `.emacs' instead."
(put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty)
(put 'gnus-group-news-6-empty-face 'obsolete-face "22.1")
-(defface gnus-group-news-low
- '((((class color)
- (background dark))
- (:foreground "DarkTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen" :bold t))
- (t
- ()))
- "Low level newsgroup face."
+(defface gnus-group-news-6
+ '((t (:inherit gnus-group-news-6-empty :bold t)))
+ "Level 6 newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
-(put 'gnus-group-news-low-face 'obsolete-face "22.1")
+(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
+(put 'gnus-group-news-6-face 'obsolete-face "22.1")
(defface gnus-group-news-low-empty
'((((class color)
@@ -545,20 +488,13 @@ be set in `.emacs' instead."
(put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty)
(put 'gnus-group-news-low-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-1
- '((((class color)
- (background dark))
- (:foreground "#e1ffe1" :bold t))
- (((class color)
- (background light))
- (:foreground "DeepPink3" :bold t))
- (t
- (:bold t)))
- "Level 1 mailgroup face."
+(defface gnus-group-news-low
+ '((t (:inherit gnus-group-news-low-empty :bold t)))
+ "Low level newsgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
-(put 'gnus-group-mail-1-face 'obsolete-face "22.1")
+(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
+(put 'gnus-group-news-low-face 'obsolete-face "22.1")
(defface gnus-group-mail-1-empty
'((((class color)
@@ -568,27 +504,20 @@ be set in `.emacs' instead."
(background light))
(:foreground "DeepPink3"))
(t
- (:italic t :bold t)))
+ (:italic t)))
"Level 1 empty mailgroup face."
:group 'gnus-group)
;; backward-compatibility alias
(put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty)
(put 'gnus-group-mail-1-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-2
- '((((class color)
- (background dark))
- (:foreground "DarkSeaGreen1" :bold t))
- (((class color)
- (background light))
- (:foreground "HotPink3" :bold t))
- (t
- (:bold t)))
- "Level 2 mailgroup face."
+(defface gnus-group-mail-1
+ '((t (:inherit gnus-group-mail-1-empty :bold t)))
+ "Level 1 mailgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
-(put 'gnus-group-mail-2-face 'obsolete-face "22.1")
+(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
+(put 'gnus-group-mail-1-face 'obsolete-face "22.1")
(defface gnus-group-mail-2-empty
'((((class color)
@@ -598,27 +527,20 @@ be set in `.emacs' instead."
(background light))
(:foreground "HotPink3"))
(t
- (:bold t)))
+ (:italic t)))
"Level 2 empty mailgroup face."
:group 'gnus-group)
;; backward-compatibility alias
(put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty)
(put 'gnus-group-mail-2-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-3
- '((((class color)
- (background dark))
- (:foreground "aquamarine1" :bold t))
- (((class color)
- (background light))
- (:foreground "magenta4" :bold t))
- (t
- (:bold t)))
- "Level 3 mailgroup face."
+(defface gnus-group-mail-2
+ '((t (:inherit gnus-group-mail-2-empty :bold t)))
+ "Level 2 mailgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
-(put 'gnus-group-mail-3-face 'obsolete-face "22.1")
+(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
+(put 'gnus-group-mail-2-face 'obsolete-face "22.1")
(defface gnus-group-mail-3-empty
'((((class color)
@@ -635,20 +557,13 @@ be set in `.emacs' instead."
(put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty)
(put 'gnus-group-mail-3-empty-face 'obsolete-face "22.1")
-(defface gnus-group-mail-low
- '((((class color)
- (background dark))
- (:foreground "aquamarine2" :bold t))
- (((class color)
- (background light))
- (:foreground "DeepPink4" :bold t))
- (t
- (:bold t)))
- "Low level mailgroup face."
+(defface gnus-group-mail-3
+ '((t (:inherit gnus-group-mail-3-empty :bold t)))
+ "Level 3 mailgroup face."
:group 'gnus-group)
;; backward-compatibility alias
-(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
-(put 'gnus-group-mail-low-face 'obsolete-face "22.1")
+(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
+(put 'gnus-group-mail-3-face 'obsolete-face "22.1")
(defface gnus-group-mail-low-empty
'((((class color)
@@ -665,6 +580,14 @@ be set in `.emacs' instead."
(put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty)
(put 'gnus-group-mail-low-empty-face 'obsolete-face "22.1")
+(defface gnus-group-mail-low
+ '((t (:inherit gnus-group-mail-low-empty :bold t)))
+ "Low level mailgroup face."
+ :group 'gnus-group)
+;; backward-compatibility alias
+(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
+(put 'gnus-group-mail-low-face 'obsolete-face "22.1")
+
;; Summary mode faces.
(defface gnus-summary-selected '((t (:underline t)))
@@ -683,15 +606,23 @@ be set in `.emacs' instead."
(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
(put 'gnus-summary-cancelled-face 'obsolete-face "22.1")
-(defface gnus-summary-high-ticked
+(defface gnus-summary-normal-ticked
'((((class color)
(background dark))
- (:foreground "pink" :bold t))
+ (:foreground "pink"))
(((class color)
(background light))
- (:foreground "firebrick" :bold t))
+ (:foreground "firebrick"))
(t
- (:bold t)))
+ ()))
+ "Face used for normal interest ticked articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
+(put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1")
+
+(defface gnus-summary-high-ticked
+ '((t (:inherit gnus-summary-normal-ticked :bold t)))
"Face used for high interest ticked articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -699,44 +630,30 @@ be set in `.emacs' instead."
(put 'gnus-summary-high-ticked-face 'obsolete-face "22.1")
(defface gnus-summary-low-ticked
- '((((class color)
- (background dark))
- (:foreground "pink" :italic t))
- (((class color)
- (background light))
- (:foreground "firebrick" :italic t))
- (t
- (:italic t)))
+ '((t (:inherit gnus-summary-normal-ticked :italic t)))
"Face used for low interest ticked articles."
:group 'gnus-summary)
;; backward-compatibility alias
(put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked)
(put 'gnus-summary-low-ticked-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-ticked
+(defface gnus-summary-normal-ancient
'((((class color)
(background dark))
- (:foreground "pink"))
+ (:foreground "SkyBlue"))
(((class color)
(background light))
- (:foreground "firebrick"))
+ (:foreground "RoyalBlue"))
(t
()))
- "Face used for normal interest ticked articles."
+ "Face used for normal interest ancient articles."
:group 'gnus-summary)
;; backward-compatibility alias
-(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
-(put 'gnus-summary-normal-ticked-face 'obsolete-face "22.1")
+(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
+(put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1")
(defface gnus-summary-high-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
+ '((t (:inherit gnus-summary-normal-ancient :bold t)))
"Face used for high interest ancient articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -744,42 +661,28 @@ be set in `.emacs' instead."
(put 'gnus-summary-high-ancient-face 'obsolete-face "22.1")
(defface gnus-summary-low-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :italic t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :italic t))
- (t
- (:italic t)))
+ '((t (:inherit gnus-summary-normal-ancient :italic t)))
"Face used for low interest ancient articles."
:group 'gnus-summary)
;; backward-compatibility alias
(put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient)
(put 'gnus-summary-low-ancient-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue"))
- (((class color)
- (background light))
- (:foreground "RoyalBlue"))
- (t
- ()))
- "Face used for normal interest ancient articles."
+(defface gnus-summary-normal-undownloaded
+ '((((class color)
+ (background light))
+ (:foreground "cyan4" :bold nil))
+ (((class color) (background dark))
+ (:foreground "LightGray" :bold nil))
+ (t (:inverse-video t)))
+ "Face used for normal interest uncached articles."
:group 'gnus-summary)
;; backward-compatibility alias
-(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
-(put 'gnus-summary-normal-ancient-face 'obsolete-face "22.1")
+(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
+(put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1")
(defface gnus-summary-high-undownloaded
- '((((class color)
- (background light))
- (:bold t :foreground "cyan4"))
- (((class color) (background dark))
- (:bold t :foreground "LightGray"))
- (t (:inverse-video t :bold t)))
+ '((t (:inherit gnus-summary-normal-undownloaded :bold t)))
"Face used for high interest uncached articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -787,34 +690,24 @@ be set in `.emacs' instead."
(put 'gnus-summary-high-undownloaded-face 'obsolete-face "22.1")
(defface gnus-summary-low-undownloaded
- '((((class color)
- (background light))
- (:italic t :foreground "cyan4" :bold nil))
- (((class color) (background dark))
- (:italic t :foreground "LightGray" :bold nil))
- (t (:inverse-video t :italic t)))
+ '((t (:inherit gnus-summary-normal-undownloaded :italic t)))
"Face used for low interest uncached articles."
:group 'gnus-summary)
;; backward-compatibility alias
(put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded)
(put 'gnus-summary-low-undownloaded-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-undownloaded
- '((((class color)
- (background light))
- (:foreground "cyan4" :bold nil))
- (((class color) (background dark))
- (:foreground "LightGray" :bold nil))
- (t (:inverse-video t)))
- "Face used for normal interest uncached articles."
+(defface gnus-summary-normal-unread
+ '((t
+ ()))
+ "Face used for normal interest unread articles."
:group 'gnus-summary)
;; backward-compatibility alias
-(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
-(put 'gnus-summary-normal-undownloaded-face 'obsolete-face "22.1")
+(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
+(put 'gnus-summary-normal-unread-face 'obsolete-face "22.1")
(defface gnus-summary-high-unread
- '((t
- (:bold t)))
+ '((t (:inherit gnus-summary-normal-unread :bold t)))
"Face used for high interest unread articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -822,34 +715,30 @@ be set in `.emacs' instead."
(put 'gnus-summary-high-unread-face 'obsolete-face "22.1")
(defface gnus-summary-low-unread
- '((t
- (:italic t)))
+ '((t (:inherit gnus-summary-normal-unread :italic t)))
"Face used for low interest unread articles."
:group 'gnus-summary)
;; backward-compatibility alias
(put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread)
(put 'gnus-summary-low-unread-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-unread
- '((t
- ()))
- "Face used for normal interest unread articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
-(put 'gnus-summary-normal-unread-face 'obsolete-face "22.1")
-
-(defface gnus-summary-high-read
+(defface gnus-summary-normal-read
'((((class color)
(background dark))
- (:foreground "PaleGreen"
- :bold t))
+ (:foreground "PaleGreen"))
(((class color)
(background light))
- (:foreground "DarkGreen"
- :bold t))
+ (:foreground "DarkGreen"))
(t
- (:bold t)))
+ ()))
+ "Face used for normal interest read articles."
+ :group 'gnus-summary)
+;; backward-compatibility alias
+(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
+(put 'gnus-summary-normal-read-face 'obsolete-face "22.1")
+
+(defface gnus-summary-high-read
+ '((t (:inherit gnus-summary-normal-read :bold t)))
"Face used for high interest read articles."
:group 'gnus-summary)
;; backward-compatibility alias
@@ -857,37 +746,13 @@ be set in `.emacs' instead."
(put 'gnus-summary-high-read-face 'obsolete-face "22.1")
(defface gnus-summary-low-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :italic t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :italic t))
- (t
- (:italic t)))
+ '((t (:inherit gnus-summary-normal-read :italic t)))
"Face used for low interest read articles."
:group 'gnus-summary)
;; backward-compatibility alias
(put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read)
(put 'gnus-summary-low-read-face 'obsolete-face "22.1")
-(defface gnus-summary-normal-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- ()))
- "Face used for normal interest read articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
-(put 'gnus-summary-normal-read-face 'obsolete-face "22.1")
-
;;;
;;; Gnus buffers
@@ -1106,12 +971,11 @@ be set in `.emacs' instead."
(cons (car list) (list :type type :data data)))
list)))
-(eval-when (load)
- (let ((command (format "%s" this-command)))
- (when (string-match "gnus" command)
- (if (string-match "gnus-other-frame" command)
- (gnus-get-buffer-create gnus-group-buffer)
- (gnus-splash)))))
+(let ((command (format "%s" this-command)))
+ (when (string-match "gnus" command)
+ (if (eq 'gnus-other-frame this-command)
+ (gnus-get-buffer-create gnus-group-buffer)
+ (gnus-splash))))
;;; Do the rest.
@@ -2479,7 +2343,7 @@ Disabling the agent may result in noticeable loss of performance."
:group 'gnus-agent
:type 'boolean)
-(defcustom gnus-other-frame-function 'gnus
+(defcustom gnus-other-frame-function #'gnus
"Function called by the command `gnus-other-frame' when starting Gnus."
:group 'gnus-start
:type '(choice (function-item gnus)
@@ -2487,7 +2351,9 @@ Disabling the agent may result in noticeable loss of performance."
(function-item gnus-slave)
(function-item gnus-slave-no-server)))
-(defcustom gnus-other-frame-resume-function 'gnus-group-get-new-news
+(declare-function gnus-group-get-new-news "gnus-group")
+
+(defcustom gnus-other-frame-resume-function #'gnus-group-get-new-news
"Function called by the command `gnus-other-frame' when resuming Gnus."
:version "24.4"
:group 'gnus-start
@@ -2555,7 +2421,7 @@ a string, be sure to use a valid format, see RFC 2616."
)
(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
(defvar gnus-draft-meta-information-header "X-Draft-From")
-(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
+(defvar gnus-group-get-parameter-function #'gnus-group-get-parameter)
(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-newsgroup-name nil)
(defvar gnus-ephemeral-servers nil)
@@ -2592,7 +2458,9 @@ a string, be sure to use a valid format, see RFC 2616."
(defvar gnus-group-history nil)
(defvar gnus-server-alist nil
- "List of available servers.")
+ "Servers created by Gnus, or via the server buffer.
+Servers defined in the user's config files do not appear here.
+This variable is persisted in the user's .newsrc.eld file.")
(defcustom gnus-cache-directory
(nnheader-concat gnus-directory "cache/")
@@ -2755,7 +2623,6 @@ gnus-registry.el will populate this if it's loaded.")
(nthcdr 3 package)
(cdr package)))))
'(("info" :interactive t Info-goto-node)
- ("pp" pp-to-string)
("qp" quoted-printable-decode-region quoted-printable-decode-string)
("ps-print" ps-print-preprint)
("message" :interactive t
@@ -2902,7 +2769,6 @@ gnus-registry.el will populate this if it's loaded.")
gnus-check-reasonable-setup)
("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
gnus-dup-enter-articles)
- ("gnus-range" gnus-copy-sequence)
("gnus-eform" gnus-edit-form)
("gnus-logic" gnus-score-advanced)
("gnus-undo" gnus-undo-mode gnus-undo-register)
@@ -3179,9 +3045,9 @@ with a `subscribed' parameter."
(or (gnus-group-fast-parameter group 'to-address)
(gnus-group-fast-parameter group 'to-list))))
(when address
- (add-to-list 'addresses address))))
+ (cl-pushnew address addresses :test #'equal))))
(when addresses
- (list (mapconcat 'regexp-quote addresses "\\|")))))
+ (list (mapconcat #'regexp-quote addresses "\\|")))))
(defmacro gnus-string-or (&rest strings)
"Return the first element of STRINGS that is a non-blank string.
@@ -3234,6 +3100,8 @@ If ARG, insert string at point."
minor least)
(format "%d.%02d%02d" major minor least))))))
+(defvar gnus-info-buffer)
+
(defun gnus-info-find-node (&optional nodename)
"Find Info documentation of Gnus."
(interactive)
@@ -3253,7 +3121,7 @@ If ARG, insert string at point."
(defvar gnus-current-prefix-symbols nil
"List of current prefix symbols.")
-(defun gnus-interactive (string &optional params)
+(defun gnus-interactive (string)
"Return a list that can be fed to `interactive'.
See `interactive' for full documentation.
@@ -3345,9 +3213,9 @@ g -- Group name."
(setq out (delq 'gnus-prefix-nil out))
(nreverse out)))
-(defun gnus-symbolic-argument (&optional arg)
+(defun gnus-symbolic-argument ()
"Read a symbolic argument and a command, and then execute command."
- (interactive "P")
+ (interactive)
(let* ((in-command (this-command-keys))
(command in-command)
gnus-current-prefix-symbols
@@ -3463,16 +3331,15 @@ that that variable is buffer-local to the summary buffers."
(throw 'server-name (car name-method))))
gnus-server-method-cache))
- (mapc
- (lambda (server-alist)
- (mapc (lambda (name-method)
- (when (gnus-methods-equal-p (cdr name-method) method)
- (unless (member name-method gnus-server-method-cache)
- (push name-method gnus-server-method-cache))
- (throw 'server-name (car name-method))))
- server-alist))
- (list gnus-server-alist
- gnus-predefined-server-alist))
+ (dolist (server-alist
+ (list gnus-server-alist
+ gnus-predefined-server-alist))
+ (mapc (lambda (name-method)
+ (when (gnus-methods-equal-p (cdr name-method) method)
+ (unless (member name-method gnus-server-method-cache)
+ (push name-method gnus-server-method-cache))
+ (throw 'server-name (car name-method))))
+ server-alist))
(let* ((name (if (member (cadr method) '(nil ""))
(format "%s" (car method))
@@ -3574,26 +3441,26 @@ that that variable is buffer-local to the summary buffers."
(let ((p1 (copy-sequence (cddr m1)))
(p2 (copy-sequence (cddr m2)))
e1 e2)
- (block nil
+ (cl-block nil
(while (setq e1 (pop p1))
(unless (setq e2 (assq (car e1) p2))
;; The parameter doesn't exist in p2.
- (return nil))
+ (cl-return nil))
(setq p2 (delq e2 p2))
(unless (equal e1 e2)
(if (not (and (stringp (cadr e1))
(stringp (cadr e2))))
- (return nil)
+ (cl-return nil)
;; Special-case string parameter comparison so that we
;; can uniquify them.
(let ((s1 (cadr e1))
(s2 (cadr e2)))
- (when (string-match "/$" s1)
+ (when (string-match "/\\'" s1)
(setq s1 (directory-file-name s1)))
- (when (string-match "/$" s2)
+ (when (string-match "/\\'" s2)
(setq s2 (directory-file-name s2)))
(unless (equal s1 s2)
- (return nil))))))
+ (cl-return nil))))))
;; If p2 now is empty, they were equal.
(null p2))))
@@ -3981,8 +3848,7 @@ If SCORE is nil, add 1 to the score of GROUP."
"Collapse GROUP name LEVELS.
Select methods are stripped and any remote host name is stripped down to
just the host name."
- (let* ((name "")
- (foreign "")
+ (let* ((foreign "")
(depth 0)
(skip 1)
(levels (or levels
@@ -4024,13 +3890,13 @@ just the host name."
gsep "."))
(setq levels (- glen levels))
(dolist (g glist)
- (push (if (>= (decf levels) 0)
+ (push (if (>= (cl-decf levels) 0)
(if (zerop (length g))
""
(substring g 0 1))
g)
res))
- (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
+ (concat foreign (mapconcat #'identity (nreverse res) gsep))))))
(defun gnus-narrow-to-body ()
"Narrow to the body of an article."
@@ -4272,7 +4138,7 @@ Allow completion over sensible values."
gnus-server-alist))
(method
(gnus-completing-read
- prompt (mapcar 'car servers)
+ prompt (mapcar #'car servers)
t nil 'gnus-method-history)))
(cond
((equal method "")
@@ -4385,13 +4251,13 @@ current display is used."
(progn (switch-to-buffer gnus-group-buffer)
(funcall gnus-other-frame-resume-function arg))
(funcall gnus-other-frame-function arg)
- (add-hook 'gnus-exit-gnus-hook 'gnus-delete-gnus-frame)
+ (add-hook 'gnus-exit-gnus-hook #'gnus-delete-gnus-frame)
;; One might argue that `gnus-delete-gnus-frame' should not be called
;; from `gnus-suspend-gnus-hook', but, on the other hand, one might
;; argue that it should. No matter what you think, for the sake of
;; those who want it to be called from it, please keep (defun
;; gnus-delete-gnus-frame) even if you remove the next `add-hook'.
- (add-hook 'gnus-suspend-gnus-hook 'gnus-delete-gnus-frame)))))
+ (add-hook 'gnus-suspend-gnus-hook #'gnus-delete-gnus-frame)))))
;;;###autoload
(defun gnus (&optional arg dont-connect slave)
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el
index b569c7f16c6..b6801f78852 100644
--- a/lisp/gnus/gssapi.el
+++ b/lisp/gnus/gssapi.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el
index e51181ef5f8..84db6c3528b 100644
--- a/lisp/gnus/legacy-gnus-agent.el
+++ b/lisp/gnus/legacy-gnus-agent.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el
index e15d820a274..93f03be72d0 100644
--- a/lisp/gnus/mail-source.el
+++ b/lisp/gnus/mail-source.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -591,25 +591,21 @@ Return the number of files that were found."
If CONFIRM is non-nil, ask for confirmation before removing a file."
(interactive "P")
(require 'gnus-util)
- (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days
- (low2days (/ 1.0 65536.0)) ;; convert low bits to days
+ (let* ((now (current-time))
(diff (if (natnump age) age 30));; fallback, if no valid AGE given
- currday files)
+ files)
(setq files (directory-files
mail-source-directory t
(concat "\\`"
- (regexp-quote mail-source-incoming-file-prefix)))
- currday (* (car (current-time)) high2days)
- currday (+ currday (* low2days (nth 1 (current-time)))))
+ (regexp-quote mail-source-incoming-file-prefix))))
(while files
(let* ((ffile (car files))
(bfile (replace-regexp-in-string "\\`.*/\\([^/]+\\)\\'" "\\1"
ffile))
- (filetime (nth 5 (file-attributes ffile)))
- (fileday (* (car filetime) high2days))
- (fileday (+ fileday (* low2days (nth 1 filetime)))))
+ (filetime (nth 5 (file-attributes ffile))))
(setq files (cdr files))
- (when (and (> (- currday fileday) diff)
+ (when (and (> (time-to-number-of-days (time-subtract now filetime))
+ diff)
(if confirm
(y-or-n-p
(format-message "\
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 0f8fdfc9c7f..0f99cb697dc 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,8 +28,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl-lib))
(require 'mailheader)
(require 'gmm-utils)
@@ -49,7 +48,8 @@
(require 'mm-util)
(require 'rfc2047)
(require 'puny)
-(require 'subr-x) ; read-multiple-choice
+(require 'rmc) ; read-multiple-choice
+(eval-when-compile (require 'subr-x)) ; when-let*
(autoload 'mailclient-send-it "mailclient")
@@ -306,7 +306,7 @@ any confusion."
(defcustom message-subject-trailing-was-query t
"What to do with trailing \"(was: <old subject>)\" in subject lines.
If nil, leave the subject unchanged. If it is the symbol `ask', query
-the user what do do. In this case, the subject is matched against
+the user what to do. In this case, the subject is matched against
`message-subject-trailing-was-ask-regexp'. If
`message-subject-trailing-was-query' is t, always strip the trailing
old subject. In this case, `message-subject-trailing-was-regexp' is
@@ -991,7 +991,6 @@ are replaced:
%F The first name if present, e.g.: \"John\", else fall
back to the mail address.
%L The last name if present, e.g.: \"Doe\".
- %Z, %z The time zone in the numeric form, e.g.:\"+0000\".
All other format specifiers are passed to `format-time-string'
which is called using the date from the article your replying to, but
@@ -1434,7 +1433,7 @@ starting with `not' and followed by regexps."
(:foreground "MidnightBlue" :bold t))
(t
(:bold t :italic t)))
- "Face used for displaying From headers."
+ "Face used for displaying To headers."
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-to-face 'face-alias 'message-header-to)
@@ -1464,7 +1463,7 @@ starting with `not' and followed by regexps."
(:foreground "navy blue" :bold t))
(t
(:bold t)))
- "Face used for displaying subject headers."
+ "Face used for displaying Subject headers."
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-subject-face 'face-alias 'message-header-subject)
@@ -1479,7 +1478,7 @@ starting with `not' and followed by regexps."
(:foreground "blue4" :bold t :italic t))
(t
(:bold t :italic t)))
- "Face used for displaying newsgroups headers."
+ "Face used for displaying Newsgroups headers."
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
@@ -1494,7 +1493,7 @@ starting with `not' and followed by regexps."
(:foreground "steel blue"))
(t
(:bold t :italic t)))
- "Face used for displaying newsgroups headers."
+ "Face used for displaying other headers."
:group 'message-faces)
;; backward-compatibility alias
(put 'message-header-other-face 'face-alias 'message-header-other)
@@ -2325,7 +2324,7 @@ With prefix-argument just set Follow-Up, don't cross-post."
(setq message-cross-post-old-target target-group))
(defun message-cross-post-insert-note (target-group cross-post in-old
- old-groups)
+ _old-groups)
"Insert a in message body note about a set Followup or Crosspost.
If there have been previous notes, delete them. TARGET-GROUP specifies the
group to Followup-To. When CROSS-POST is t, insert note about
@@ -2444,7 +2443,7 @@ Return the number of headers removed."
(not (looking-at regexp))
(looking-at regexp))
(progn
- (incf number)
+ (cl-incf number)
(when first
(setq last t))
(delete-region
@@ -2469,10 +2468,10 @@ Return the number of headers removed."
(save-excursion
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (incf count)))
+ (cl-incf count)))
(while (> count 1)
(message-remove-header header nil t)
- (decf count))))
+ (cl-decf count))))
(defun message-narrow-to-headers ()
"Narrow the buffer to the head of the message."
@@ -2843,7 +2842,7 @@ These properties are essential to work, so we should never strip them."
(eq message-mail-alias-type type)
(memq type message-mail-alias-type)))
-(defun message-strip-forbidden-properties (begin end &optional old-length)
+(defun message-strip-forbidden-properties (begin end &optional _old-length)
"Strip forbidden properties between BEGIN and END, ignoring the third arg.
This function is intended to be called from `after-change-functions'.
See also `message-forbidden-properties'."
@@ -3227,13 +3226,13 @@ or in the synonym headers, defined by `message-header-synonyms'."
(dolist (header headers)
(let* ((header-name (symbol-name (car header)))
(new-header (cdr header))
- (synonyms (loop for synonym in message-header-synonyms
- when (memq (car header) synonym) return synonym))
+ (synonyms (cl-loop for synonym in message-header-synonyms
+ when (memq (car header) synonym) return synonym))
(old-header
- (loop for synonym in synonyms
- for old-header = (mail-fetch-field (symbol-name synonym))
- when (and old-header (string-match new-header old-header))
- return synonym)))
+ (cl-loop for synonym in synonyms
+ for old-header = (mail-fetch-field (symbol-name synonym))
+ when (and old-header (string-match new-header old-header))
+ return synonym)))
(if old-header
(message "already have `%s' in `%s'" new-header old-header)
(when (and (message-position-on-field header-name)
@@ -3593,7 +3592,7 @@ text was killed."
"Create a rot table with offset N."
(let ((i -1)
(table (make-string 256 0)))
- (while (< (incf i) 256)
+ (while (< (cl-incf i) 256)
(aset table i i))
(concat
(substring table 0 ?A)
@@ -3761,13 +3760,13 @@ To use this automatically, you may add this function to
(goto-char (mark t))
(insert-before-markers ?\n)
(goto-char pt))))
- (case message-cite-reply-position
- (above
+ (pcase message-cite-reply-position
+ ('above
(message-goto-body)
(insert body-text)
(insert (if (bolp) "\n" "\n\n"))
(message-goto-body))
- (below
+ ('below
(message-goto-signature)))
;; Add a `message-setup-very-last-hook' here?
;; Add `gnus-article-highlight-citation' here?
@@ -4095,7 +4094,7 @@ Instead, just auto-save the buffer and then bury it."
"Bury this mail BUFFER."
;; Note that this is not quite the same as (bury-buffer buffer),
;; since bury-buffer does extra stuff with a nil argument.
- ;; Eg http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg00539.html
+ ;; Eg https://lists.gnu.org/r/emacs-devel/2014-01/msg00539.html
(with-current-buffer buffer (bury-buffer))
(if message-return-action
(apply (car message-return-action) (cdr message-return-action))))
@@ -4346,7 +4345,7 @@ conformance."
RECIPIENTS is a mail header. Return a list of potentially bogus
addresses. If none is found, return nil.
-An address might be bogus if if there's a matching entry in
+An address might be bogus if there's a matching entry in
`message-bogus-addresses'."
;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"?
(let (found)
@@ -4390,7 +4389,7 @@ This function could be useful in `message-setup-hook'."
(if (string= encoded bog)
""
(format " (%s)" encoded))))))
- (error "Bogus address"))))))))
+ (user-error "Bogus address"))))))))
(custom-add-option 'message-setup-hook 'message-check-recipients)
@@ -4612,9 +4611,9 @@ This function could be useful in `message-setup-hook'."
(with-current-buffer mailbuf
message-courtesy-message)))
;; Let's make sure we encoded all the body.
- (assert (save-excursion
- (goto-char (point-min))
- (not (re-search-forward "[^\000-\377]" nil t))))
+ (cl-assert (save-excursion
+ (goto-char (point-min))
+ (not (re-search-forward "[^\000-\377]" nil t))))
(mm-disable-multibyte)
(if (or (not message-send-mail-partially-limit)
(< (buffer-size) message-send-mail-partially-limit)
@@ -4768,14 +4767,14 @@ to find out how to use this."
(replace-match "\n")
(run-hooks 'message-send-mail-hook)
;; send the message
- (case
+ (pcase
(let ((coding-system-for-write message-send-coding-system))
(apply
'call-process-region (point-min) (point-max)
message-qmail-inject-program nil nil nil
;; qmail-inject's default behavior is to look for addresses on the
;; command line; if there're none, it scans the headers.
- ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
+ ;; yes, it does The Right Thing w.r.t. Resent-To and its kin.
;;
;; in general, ALL of qmail-inject's defaults are perfect for simply
;; reading a formatted (i. e., at least a To: or Resent-To header)
@@ -4793,13 +4792,13 @@ to find out how to use this."
(if (functionp message-qmail-inject-args)
(funcall message-qmail-inject-args)
message-qmail-inject-args)))
- ;; qmail-inject doesn't say anything on it's stdout/stderr,
+ ;; qmail-inject doesn't say anything on its stdout/stderr,
;; we have to look at the retval instead
(0 nil)
(100 (error "qmail-inject reported permanent failure"))
(111 (error "qmail-inject reported transient failure"))
;; should never happen
- (t (error "qmail-inject reported unknown failure"))))
+ (_ (error "qmail-inject reported unknown failure"))))
(defvar mh-previous-window-config)
@@ -4842,17 +4841,13 @@ command evaluates `message-send-mail-hook' just before sending a message."
(run-hooks 'message-send-mail-hook)
(mailclient-send-it))
-(defvar sha1-maximum-internal-length)
-
(defun message-canlock-generate ()
"Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
- (require 'sha1)
- (let (sha1-maximum-internal-length)
- (sha1 (concat (message-unique-id)
- (format "%x%x%x" (random) (random) (random))
- (prin1-to-string (recent-keys))
- (prin1-to-string (garbage-collect))))))
+ (sha1 (concat (message-unique-id)
+ (format "%x%x%x" (random) (random) (random))
+ (prin1-to-string (recent-keys))
+ (prin1-to-string (garbage-collect)))))
(defvar canlock-password)
(defvar canlock-password-for-verify)
@@ -5326,7 +5321,9 @@ Otherwise, generate and save a value for `canlock-password' first."
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward
- (string-to-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
+ (eval-when-compile
+ (decode-coding-string "[\000-\007\013\015-\032\034-\037\200-\237]"
+ 'binary))
nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
@@ -5782,7 +5779,10 @@ give as trustworthy answer as possible."
(not (string-match message-bogus-system-names message-user-fqdn)))
;; `message-user-fqdn' seems to be valid
message-user-fqdn)
- ((not (string-match message-bogus-system-names sysname))
+ ;; A system name without any dots is unlikely to be a good fully
+ ;; qualified domain name.
+ ((and (string-match "[.]" sysname)
+ (not (string-match message-bogus-system-names sysname)))
;; `system-name' returned the right result.
sysname)
;; Try `mail-host-address'.
@@ -5850,10 +5850,10 @@ subscribed address (and not the additional To and Cc header contents)."
message-subscribed-address-functions))))
(save-match-data
(let ((list
- (loop for recipient in recipients
- when (loop for regexp in mft-regexps
- when (string-match regexp recipient) return t)
- return recipient)))
+ (cl-loop for recipient in recipients
+ when (cl-loop for regexp in mft-regexps
+ thereis (string-match regexp recipient))
+ return recipient)))
(when list
(if only-show-subscribed
list
@@ -6202,7 +6202,7 @@ they are."
(when (> count maxcount)
(let ((surplus (- count maxcount)))
(message-shorten-1 refs cut surplus)
- (decf count surplus)))
+ (cl-decf count surplus)))
;; When sending via news, make sure the total folded length will
;; be less than 998 characters. This is to cater to broken INN
@@ -6680,7 +6680,7 @@ is a function used to switch to and display the mail buffer."
;; C-h f compose-mail says that headers should be specified as
;; (string . value); however all the rest of message expects
;; headers to be symbols, not strings (eg message-header-format-alist).
- ;; http://lists.gnu.org/archive/html/emacs-devel/2011-01/msg00337.html
+ ;; https://lists.gnu.org/r/emacs-devel/2011-01/msg00337.html
;; We need to convert any string input, eg from rmail-start-mail.
(dolist (h other-headers other-headers)
(if (stringp (car h)) (setcar h (intern (capitalize (car h)))))))
@@ -6727,9 +6727,9 @@ The function is called with one parameter, a cons cell ..."
;; Gmane renames "To". Look at "Original-To", too, if it is present in
;; message-header-synonyms.
(setq to (or (message-fetch-field "to")
- (and (loop for synonym in message-header-synonyms
- when (memq 'Original-To synonym)
- return t)
+ (and (cl-loop for synonym in message-header-synonyms
+ when (memq 'Original-To synonym)
+ return t)
(message-fetch-field "original-to")))
cc (message-fetch-field "cc")
extra (when message-extra-wide-headers
@@ -8061,8 +8061,12 @@ regexp VARSTR."
(or (null varstr)
(string-match varstr (symbol-name (car local)))))
(ignore-errors
- (set (make-local-variable (car local))
- (cdr local)))))
+ ;; Cloning message-default-charset could cause an already
+ ;; encoded text to be encoded again, yielding raw bytes
+ ;; instead of characters in the message.
+ (unless (eq 'message-default-charset (car local))
+ (set (make-local-variable (car local))
+ (cdr local))))))
locals)))
;;;
@@ -8130,11 +8134,12 @@ From headers in the original article."
(message-tokenize-header
(mail-strip-quoted-names
(mapconcat 'message-fetch-reply-field fields ","))))
- (email (cond ((functionp message-alternative-emails)
- (car (cl-remove-if-not message-alternative-emails emails)))
- (t (loop for email in emails
- if (string-match-p message-alternative-emails email)
- return email)))))
+ (email
+ (cond ((functionp message-alternative-emails)
+ (car (cl-remove-if-not message-alternative-emails emails)))
+ (t (cl-loop for email in emails
+ if (string-match-p message-alternative-emails email)
+ return email)))))
(unless (or (not email) (equal email user-mail-address))
(message-remove-header "From")
(goto-char (point-max))
@@ -8414,7 +8419,7 @@ Used in `message-simplify-recipients'."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (when-let ((props (get-text-property (point) 'display)))
+ (when-let* ((props (get-text-property (point) 'display)))
(when (and (consp props)
(eq (car props) 'image))
(put-text-property (point) (1+ (point)) 'display nil)
diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el
index 103cc89c357..0451f217582 100644
--- a/lisp/gnus/mm-archive.el
+++ b/lisp/gnus/mm-archive.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index d773289722f..319d789c002 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index c6a0be36c40..82b378e6270 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -676,7 +676,7 @@ MIME-Version header before proceeding."
(mm-alist-to-plist (cdr ctl)) (car ctl))
;; what really needs to be done here is a way to link a
- ;; MIME handle back to it's parent MIME handle (in a multilevel
+ ;; MIME handle back to its parent MIME handle (in a multilevel
;; MIME article). That would probably require changing
;; the mm-handle API so we simply store the multipart buffer
;; name as a text property of the "multipart/whatever" string.
@@ -1363,7 +1363,7 @@ PROMPT overrides the default one used to ask user for a file name."
(mm-handle-disposition handle) 'filename)
(mail-content-type-get
(mm-handle-type handle) 'name)))
- file)
+ file directory)
(when filename
(setq filename (gnus-map-function mm-file-name-rewrite-functions
(file-name-nondirectory filename))))
@@ -1372,16 +1372,20 @@ PROMPT overrides the default one used to ask user for a file name."
(setq file
(read-file-name
(or prompt
- (format "Save MIME part to (default %s): "
- (or filename "")))
- (or mm-default-directory default-directory)
- (expand-file-name (or filename "")
- (or mm-default-directory default-directory))))
+ (format "Save MIME part to%s: "
+ (if filename
+ (format " (default %s)" filename)
+ "")))
+ (or directory mm-default-directory default-directory)
+ (expand-file-name
+ (or filename "")
+ (or directory mm-default-directory default-directory))))
(cond ((or (not file) (equal file ""))
(message "Please enter a file name")
t)
((and (file-directory-p file)
(not filename))
+ (setq directory file)
(message "Please enter a non-directory file name")
t)
(t nil)))
diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el
index 1a9b5ab3de9..248992ea96d 100644
--- a/lisp/gnus/mm-encode.el
+++ b/lisp/gnus/mm-encode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el
index a6e76ff7be3..79d9ae37411 100644
--- a/lisp/gnus/mm-extern.el
+++ b/lisp/gnus/mm-extern.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el
index e3e6f5d7805..68008ea0d27 100644
--- a/lisp/gnus/mm-partial.el
+++ b/lisp/gnus/mm-partial.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el
index 5c8f99b0483..39e1af94924 100644
--- a/lisp/gnus/mm-url.el
+++ b/lisp/gnus/mm-url.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 89f397e3ed0..a7db3dadbc1 100644
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 10cdeed3fbb..436235c4631 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -393,7 +393,7 @@ apply the face `mm-uu-extract'."
(defun mm-uu-org-src-code-block-extract ()
(mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("text/x-org")))
+ '("text/x-org" (charset . gnus-decoded))))
(defvar gnus-newsgroup-name)
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index dd64bfed60a..d7a41b84930 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -475,12 +475,12 @@ If MODE is not set, try to find mode automatically."
(require 'font-lock)
;; I find font-lock a bit too verbose.
(let ((font-lock-verbose nil)
- (font-lock-support-mode nil))
+ (font-lock-support-mode nil)
+ (enable-local-variables nil))
;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
;; Note: XEmacs people use `font-lock-mode-hook' to run those modes.
(set (make-local-variable 'font-lock-mode-hook) nil)
(setq buffer-file-name (mm-handle-filename handle))
- (set (make-local-variable 'enable-local-variables) nil)
(with-demoted-errors
(if mode
(save-window-excursion
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el
index 57c371a65f4..80bd8d0e066 100644
--- a/lisp/gnus/mml-sec.el
+++ b/lisp/gnus/mml-sec.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el
index 1821d1a49fc..c6bc612a8f1 100644
--- a/lisp/gnus/mml-smime.el
+++ b/lisp/gnus/mml-smime.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index ce28607a04a..9ee2c95b7cb 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el
index 0df908f2a2e..86370729de1 100644
--- a/lisp/gnus/mml1991.el
+++ b/lisp/gnus/mml1991.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el
index f973670e8e9..11f3f750f3f 100644
--- a/lisp/gnus/mml2015.el
+++ b/lisp/gnus/mml2015.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el
index 2b4843488c4..025c3d3cad4 100644
--- a/lisp/gnus/nnagent.el
+++ b/lisp/gnus/nnagent.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el
index 5aa481e0673..c61cbc8d7c3 100644
--- a/lisp/gnus/nnbabyl.el
+++ b/lisp/gnus/nnbabyl.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el
index 0390b5b8d28..ca4dca4189d 100644
--- a/lisp/gnus/nndiary.el
+++ b/lisp/gnus/nndiary.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1532,7 +1532,7 @@ all. This may very well take some time.")
;; past. A permanent schedule never expires.
(and sched
(setq sched (nndiary-last-occurrence sched))
- (time-less-p sched (current-time))))
+ (time-less-p sched nil)))
;; else
(nnheader-report 'nndiary "Could not read file %s" file)
nil)
diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el
index 718306abce0..7eb3e824bca 100644
--- a/lisp/gnus/nndir.el
+++ b/lisp/gnus/nndir.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index 7f7db8721db..e9e769cac57 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el
index 12a1b2b284a..62a15752703 100644
--- a/lisp/gnus/nndraft.el
+++ b/lisp/gnus/nndraft.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el
index 6850cad2e60..f6bf5866970 100644
--- a/lisp/gnus/nneething.el
+++ b/lisp/gnus/nneething.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el
index 18c92f9f77b..9b1317347a7 100644
--- a/lisp/gnus/nnfolder.el
+++ b/lisp/gnus/nnfolder.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el
index 1e57f7c6f60..63bd063cbde 100644
--- a/lisp/gnus/nngateway.el
+++ b/lisp/gnus/nngateway.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el
index 4440f17c2bb..0ea99d53a4a 100644
--- a/lisp/gnus/nnheader.el
+++ b/lisp/gnus/nnheader.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 2943c8dc7d2..297e2923ee6 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -27,7 +27,8 @@
;;; Code:
(eval-when-compile
- (require 'cl))
+ (require 'cl)
+ (require 'subr-x))
(require 'nnheader)
(require 'gnus-util)
@@ -950,7 +951,7 @@ textual parts.")
internal-move-group server message-id
nnimap-request-articles-find-limit)))))
;; Move the article to a different method.
- (when-let ((result (eval accept-form)))
+ (when-let* ((result (eval accept-form)))
(nnimap-change-group group server)
(nnimap-delete-article article)
result))))))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 9640f2c746f..be42ab74e4a 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -64,7 +64,7 @@
;; also be correct, see the documentation for `nnir-namazu-remove-prefix'
;; above.
;;
-;; It is particularly important not to pass any any switches to namazu
+;; It is particularly important not to pass any switches to namazu
;; that will change the output format. Good switches to use include
;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu
;; documentation for further information on valid switches.
diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el
index 71d9631776d..ad58d292082 100644
--- a/lisp/gnus/nnmail.el
+++ b/lisp/gnus/nnmail.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1883,7 +1883,7 @@ If TIME is nil, then return the cutoff time for oldness instead."
(setq days (days-to-time days))
;; Compare the time with the current time.
(if (null time)
- (time-subtract (current-time) days)
+ (time-subtract nil days)
(ignore-errors (time-less-p days (time-since time)))))))))
(declare-function gnus-group-mark-article-read "gnus-group" (group article))
diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el
index 03cb445675c..708a3426af1 100644
--- a/lisp/gnus/nnmaildir.el
+++ b/lisp/gnus/nnmaildir.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -814,7 +814,7 @@ This variable is set by `nnmaildir-request-article'.")
(when (or isnew nattr)
(dolist (file (funcall ls ndir nil "\\`[^.]" 'nosort))
(setq x (concat ndir file))
- (and (time-less-p (nth 5 (file-attributes x)) (current-time))
+ (and (time-less-p (nth 5 (file-attributes x)) nil)
(rename-file x (concat cdir (nnmaildir--ensure-suffix file)))))
(setf (nnmaildir--grp-new group) nattr))
(setq cattr (nth 5 (file-attributes cdir)))
diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el
index a678a797439..7c96171623e 100644
--- a/lisp/gnus/nnmairix.el
+++ b/lisp/gnus/nnmairix.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el
index c854f19c7c2..3a33fb90751 100644
--- a/lisp/gnus/nnmbox.el
+++ b/lisp/gnus/nnmbox.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el
index bec174db86a..050f0cd2dde 100644
--- a/lisp/gnus/nnmh.el
+++ b/lisp/gnus/nnmh.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el
index b0c7bf41add..b7d1bc2237e 100644
--- a/lisp/gnus/nnml.el
+++ b/lisp/gnus/nnml.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el
index e40126d6e0d..7d400791fa2 100644
--- a/lisp/gnus/nnnil.el
+++ b/lisp/gnus/nnnil.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el
index 77e7f2a2d0e..be38f8d1d75 100644
--- a/lisp/gnus/nnoo.el
+++ b/lisp/gnus/nnoo.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el
index b1a2416e2fd..fac332af97a 100644
--- a/lisp/gnus/nnregistry.el
+++ b/lisp/gnus/nnregistry.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 8115057723c..9a3a562a5dd 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el
index 1db0a4192a1..b14b5cde8d2 100644
--- a/lisp/gnus/nnspool.el
+++ b/lisp/gnus/nnspool.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el
index a71f4c7b5dd..ad93815b9c2 100644
--- a/lisp/gnus/nntp.el
+++ b/lisp/gnus/nntp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index dcd610317ef..543f7b66c47 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el
index 8e5b20047f4..4327824c7e8 100644
--- a/lisp/gnus/nnweb.el
+++ b/lisp/gnus/nnweb.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el
index d106cf0c271..3e7428493e4 100644
--- a/lisp/gnus/score-mode.el
+++ b/lisp/gnus/score-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -85,7 +85,7 @@ This mode is an extended emacs-lisp mode.
(defun gnus-score-edit-insert-date ()
"Insert date in numerical format."
(interactive)
- (princ (time-to-days (current-time)) (current-buffer)))
+ (princ (time-to-days nil) (current-buffer)))
(defun gnus-score-pretty-print ()
"Format the current score file."
diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el
index 763a1cd5be7..3a948636331 100644
--- a/lisp/gnus/smiley.el
+++ b/lisp/gnus/smiley.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index e3c284f033c..21f8c09e1cb 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -67,7 +67,7 @@
;;
;; To be able to verify messages you need to build up trust with
;; someone. Perhaps you trust the CA that issued your certificate, at
-;; least I did, so I export it's certificates from my PKCS#12
+;; least I did, so I export its certificates from my PKCS#12
;; certificate with:
;;
;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem
diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el
index 17a7f89ae91..b45b487d9e0 100644
--- a/lisp/gnus/spam-report.el
+++ b/lisp/gnus/spam-report.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el
index 5466cf9edd9..08d382bcbdc 100644
--- a/lisp/gnus/spam-stat.el
+++ b/lisp/gnus/spam-stat.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el
index bcdde736b38..04e62903d97 100644
--- a/lisp/gnus/spam-wash.el
+++ b/lisp/gnus/spam-wash.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el
index 5f0ea94b283..f14af741f75 100644
--- a/lisp/gnus/spam.el
+++ b/lisp/gnus/spam.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -628,7 +628,7 @@ order for SpamAssassin to recognize the new registered spam."
:group 'spam-spamassassin)
(defcustom spam-sa-learn-unregister-switch "--forget"
- "The switch that sa-learn uses to unregister messages messages."
+ "The switch that sa-learn uses to unregister messages."
:type 'string
:group 'spam-spamassassin)
diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el
index 87b9e50c9d3..46229bcb91b 100644
--- a/lisp/help-at-pt.el
+++ b/lisp/help-at-pt.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 2c635ffa500..643b0cbbc53 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -560,10 +560,12 @@ FILE is the file where FUNCTION was probably defined."
(setq short rel))))
short))
-;;;###autoload
-(defun describe-function-1 (function)
+(defun help-fns--analyze-function (function)
+ ;; FIXME: Document/explain the differences between FUNCTION,
+ ;; REAL-FUNCTION, DEF, and REAL-DEF.
+ "Return information about FUNCTION.
+Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
(let* ((advised (and (symbolp function)
- (featurep 'nadvice)
(advice--p (advice--symbol-function function))))
;; If the function is advised, use the symbol that has the
;; real definition, if that symbol is already set up.
@@ -594,22 +596,24 @@ FILE is the file where FUNCTION was probably defined."
(setq f (symbol-function f)))
f))
((subrp def) (intern (subr-name def)))
- (t def)))
- (sig-key (if (subrp def)
- (indirect-function real-def)
- real-def))
- (file-name (find-lisp-object-file-name function (if aliased 'defun
- def)))
- (pt1 (with-current-buffer (help-buffer) (point)))
- (beg (if (and (or (byte-code-function-p def)
- (keymapp def)
- (memq (car-safe def) '(macro lambda closure)))
- (stringp file-name)
- (help-fns--autoloaded-p function file-name))
- (if (commandp def)
- "an interactive autoloaded "
- "an autoloaded ")
- (if (commandp def) "an interactive " "a "))))
+ (t def))))
+ (list real-function def aliased real-def)))
+
+(defun help-fns-function-description-header (function)
+ "Print a line describing FUNCTION to `standard-output'."
+ (pcase-let* ((`(,_real-function ,def ,aliased ,real-def)
+ (help-fns--analyze-function function))
+ (file-name (find-lisp-object-file-name function (if aliased 'defun
+ def)))
+ (beg (if (and (or (byte-code-function-p def)
+ (keymapp def)
+ (memq (car-safe def) '(macro lambda closure)))
+ (stringp file-name)
+ (help-fns--autoloaded-p function file-name))
+ (if (commandp def)
+ "an interactive autoloaded "
+ "an autoloaded ")
+ (if (commandp def) "an interactive " "a "))))
;; Print what kind of function-like object FUNCTION is.
(princ (cond ((or (stringp def) (vectorp def))
@@ -676,34 +680,56 @@ FILE is the file where FUNCTION was probably defined."
(re-search-backward (substitute-command-keys "`\\([^`']+\\)'")
nil t)
(help-xref-button 1 'help-function-def function file-name))))
- (princ ".")
- (with-current-buffer (help-buffer)
- (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
- (point)))
- (terpri)(terpri)
-
- (let ((doc-raw (documentation function t))
- (key-bindings-buffer (current-buffer)))
-
- ;; If the function is autoloaded, and its docstring has
- ;; key substitution constructs, load the library.
- (and (autoloadp real-def) doc-raw
- help-enable-auto-load
- (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
- (autoload-do-load real-def))
-
- (help-fns--key-bindings function)
- (with-current-buffer standard-output
- (let ((doc (help-fns--signature function doc-raw sig-key
- real-function key-bindings-buffer)))
- (run-hook-with-args 'help-fns-describe-function-functions function)
- (insert "\n"
- (or doc "Not documented."))
- ;; Avoid asking the user annoying questions if she decides
- ;; to save the help buffer, when her locale's codeset
- ;; isn't UTF-8.
- (unless (memq text-quoting-style '(straight grave))
- (set-buffer-file-coding-system 'utf-8))))))))
+ (princ "."))))
+
+;;;###autoload
+(defun describe-function-1 (function)
+ (let ((pt1 (with-current-buffer (help-buffer) (point))))
+ (help-fns-function-description-header function)
+ (with-current-buffer (help-buffer)
+ (fill-region-as-paragraph (save-excursion (goto-char pt1) (forward-line 0) (point))
+ (point))))
+ (terpri)(terpri)
+
+ (pcase-let* ((`(,real-function ,def ,_aliased ,real-def)
+ (help-fns--analyze-function function))
+ (doc-raw (condition-case nil
+ ;; FIXME: Maybe `documentation' should return nil
+ ;; for invalid functions i.s.o. signaling an error.
+ (documentation function t)
+ ;; E.g. an alias for a not yet defined function.
+ ((invalid-function void-function) nil)))
+ (key-bindings-buffer (current-buffer)))
+
+ ;; If the function is autoloaded, and its docstring has
+ ;; key substitution constructs, load the library.
+ (and (autoloadp real-def) doc-raw
+ help-enable-auto-load
+ (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
+ (autoload-do-load real-def))
+
+ (help-fns--key-bindings function)
+ (with-current-buffer standard-output
+ (let ((doc (condition-case nil
+ ;; FIXME: Maybe `help-fns--signature' should return `doc'
+ ;; for invalid functions i.s.o. signaling an error.
+ (help-fns--signature
+ function doc-raw
+ (if (subrp def) (indirect-function real-def) real-def)
+ real-function key-bindings-buffer)
+ ;; E.g. an alias for a not yet defined function.
+ ((invalid-function void-function) doc-raw))))
+ (run-hook-with-args 'help-fns-describe-function-functions function)
+ (insert "\n" (or doc "Not documented.")))
+ (when (or (function-get function 'pure)
+ (function-get function 'side-effect-free))
+ (insert "\nThis function does not change global state, "
+ "including the match data."))
+ ;; Avoid asking the user annoying questions if she decides
+ ;; to save the help buffer, when her locale's codeset
+ ;; isn't UTF-8.
+ (unless (memq text-quoting-style '(straight grave))
+ (set-buffer-file-coding-system 'utf-8)))))
;; Add defaults to `help-fns-describe-function-functions'.
(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
@@ -873,7 +899,10 @@ it is displayed along with the global value."
(not (equal origval :help-eval-error)))
(princ "\nOriginal value was \n")
(setq from (point))
- (pp origval)
+ (cl-prin1 origval)
+ (save-restriction
+ (narrow-to-region from (point))
+ (save-excursion (pp-buffer)))
(if (< (point) (+ from 20))
(delete-region (1- from) from)))))))
(terpri)
@@ -899,7 +928,10 @@ it is displayed along with the global value."
;; probably print it raw once and check it's a
;; sensible size before prettyprinting. -- fx
(let ((from (point)))
- (pp global-val)
+ (cl-prin1 global-val)
+ (save-restriction
+ (narrow-to-region from (point))
+ (save-excursion (pp-buffer)))
;; See previous comment for this function.
;; (help-xref-on-pp from (point))
(if (< (point) (+ from 20))
@@ -1260,14 +1292,14 @@ BUFFER should be a buffer or a buffer name."
(insert-file-contents file)
(let (notfirst)
(while (search-forward "" nil 'move)
- (if (looking-at "S")
+ (if (= (following-char) ?S)
(delete-region (1- (point)) (line-end-position))
(delete-char -1)
(if notfirst
(insert "\n.DE\n")
(setq notfirst t))
(insert "\n.SH ")
- (insert (if (looking-at "F") "Function " "Variable "))
+ (insert (if (= (following-char) ?F) "Function " "Variable "))
(delete-char 1)
(forward-line 1)
(insert ".DS L\n"))))
@@ -1293,7 +1325,7 @@ BUFFER should be a buffer or a buffer name."
(forward-char 1))
(goto-char (point-min))
(while (search-forward "" nil t)
- (unless (looking-at "S")
+ (when (/= (following-char) ?S)
(setq type (char-after)
name (buffer-substring (1+ (point)) (line-end-position))
doc (buffer-substring (line-beginning-position 2)
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index c8f93bc5e59..3181a492ff8 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index 3fb793e7aa5..a98bce0138b 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -393,12 +393,12 @@ it does not already exist."
(defvar describe-symbol-backends
`((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s)))
- ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))
(nil
,(lambda (symbol)
(or (and (boundp symbol) (not (keywordp symbol)))
(get symbol 'variable-documentation)))
- ,#'describe-variable)))
+ ,#'describe-variable)
+ ("face" ,#'facep ,(lambda (s _b _f) (describe-face s)))))
;;;###autoload
(defun help-make-xrefs (&optional buffer)
diff --git a/lisp/help.el b/lisp/help.el
index 361ab2a01ee..212e3679dad 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -306,7 +306,7 @@ If that doesn't give a function, return nil."
(defun describe-gnu-project ()
"Browse online information on the GNU project."
(interactive)
- (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
+ (browse-url "https://www.gnu.org/gnu/thegnuproject.html"))
(define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2")
@@ -593,6 +593,39 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
string
(format "%s (translated from %s)" string otherstring))))))
+(defun help--analyze-key (key untranslated)
+ "Get information about KEY its corresponding UNTRANSLATED events.
+Returns a list of the form (BRIEF-DESC DEFN EVENT MOUSE-MSG)."
+ (if (numberp untranslated)
+ (setq untranslated (this-single-command-raw-keys)))
+ (let* ((event (aref key (if (and (symbolp (aref key 0))
+ (> (length key) 1)
+ (consp (aref key 1)))
+ 1
+ 0)))
+ (modifiers (event-modifiers event))
+ (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
+ (memq 'drag modifiers)) " at that spot" ""))
+ (defn (key-binding key t)))
+ ;; Handle the case where we faked an entry in "Select and Paste" menu.
+ (when (and (eq defn nil)
+ (stringp (aref key (1- (length key))))
+ (eq (key-binding (substring key 0 -1)) 'yank-menu))
+ (setq defn 'menu-bar-select-yank))
+ ;; Don't bother user with strings from (e.g.) the select-paste menu.
+ (when (stringp (aref key (1- (length key))))
+ (aset key (1- (length key)) "(any string)"))
+ (when (and untranslated
+ (stringp (aref untranslated (1- (length untranslated)))))
+ (aset untranslated (1- (length untranslated)) "(any string)"))
+ (list
+ ;; Now describe the key, perhaps as changed.
+ (let ((key-desc (help-key-description key untranslated)))
+ (if (or (null defn) (integerp defn) (equal defn 'undefined))
+ (format "%s%s is undefined" key-desc mouse-msg)
+ (format "%s%s runs the command %S" key-desc mouse-msg defn)))
+ defn event mouse-msg)))
+
(defun describe-key-briefly (&optional key insert untranslated)
"Print the name of the function KEY invokes. KEY is a string.
If INSERT (the prefix arg) is non-nil, insert the message in the buffer.
@@ -603,73 +636,12 @@ the last key hit are used.
If KEY is a menu item or a tool-bar button that is disabled, this command
temporarily enables it to allow getting help on disabled items and buttons."
(interactive
- (let ((enable-disabled-menus-and-buttons t)
- (cursor-in-echo-area t)
- saved-yank-menu)
- (unwind-protect
- (let (key)
- ;; If yank-menu is empty, populate it temporarily, so that
- ;; "Select and Paste" menu can generate a complete event.
- (when (null (cdr yank-menu))
- (setq saved-yank-menu (copy-sequence yank-menu))
- (menu-bar-update-yank-menu "(any string)" nil))
- (while
- (progn
- (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: "))
- (and (vectorp key)
- (consp (aref key 0))
- (symbolp (car (aref key 0)))
- (string-match "\\(mouse\\|down\\|click\\|drag\\)"
- (symbol-name (car (aref key 0))))
- (not (sit-for (/ double-click-time 1000.0) t)))))
- ;; Clear the echo area message (Bug#7014).
- (message nil)
- ;; If KEY is a down-event, read and discard the
- ;; corresponding up-event. Note that there are also
- ;; down-events on scroll bars and mode lines: the actual
- ;; event then is in the second element of the vector.
- (and (vectorp key)
- (let ((last-idx (1- (length key))))
- (and (eventp (aref key last-idx))
- (memq 'down (event-modifiers (aref key last-idx)))))
- (read-event))
- (list
- key
- (if current-prefix-arg (prefix-numeric-value current-prefix-arg))
- 1))
- ;; Put yank-menu back as it was, if we changed it.
- (when saved-yank-menu
- (setq yank-menu (copy-sequence saved-yank-menu))
- (fset 'yank-menu (cons 'keymap yank-menu))))))
- (if (numberp untranslated)
- (setq untranslated (this-single-command-raw-keys)))
- (let* ((event (if (and (symbolp (aref key 0))
- (> (length key) 1)
- (consp (aref key 1)))
- (aref key 1)
- (aref key 0)))
- (modifiers (event-modifiers event))
- (standard-output (if insert (current-buffer) standard-output))
- (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
- (memq 'drag modifiers)) " at that spot" ""))
- (defn (key-binding key t))
- key-desc)
- ;; Handle the case where we faked an entry in "Select and Paste" menu.
- (if (and (eq defn nil)
- (stringp (aref key (1- (length key))))
- (eq (key-binding (substring key 0 -1)) 'yank-menu))
- (setq defn 'menu-bar-select-yank))
- ;; Don't bother user with strings from (e.g.) the select-paste menu.
- (if (stringp (aref key (1- (length key))))
- (aset key (1- (length key)) "(any string)"))
- (if (and (> (length untranslated) 0)
- (stringp (aref untranslated (1- (length untranslated)))))
- (aset untranslated (1- (length untranslated)) "(any string)"))
- ;; Now describe the key, perhaps as changed.
- (setq key-desc (help-key-description key untranslated))
- (if (or (null defn) (integerp defn) (equal defn 'undefined))
- (princ (format "%s%s is undefined" key-desc mouse-msg))
- (princ (format "%s%s runs the command %S" key-desc mouse-msg defn)))))
+ ;; Ignore mouse movement events because it's too easy to miss the
+ ;; message while moving the mouse.
+ (pcase-let ((`(,key ,_up-event) (help-read-key-sequence 'no-mouse-movement)))
+ `(,key ,current-prefix-arg 1)))
+ (princ (car (help--analyze-key key untranslated))
+ (if insert (current-buffer) standard-output)))
(defun help--key-binding-keymap (key &optional accept-default no-remap position)
"Return a keymap holding a binding for KEY within current keymaps.
@@ -734,6 +706,69 @@ function `key-binding'."
(throw 'found x))))
nil)))))
+(defun help-read-key-sequence (&optional no-mouse-movement)
+ "Reads a key sequence from the user.
+Returns a list of the form (KEY UP-EVENT), where KEY is the key
+sequence, and UP-EVENT is the up-event that was discarded by
+reading KEY, or nil.
+If NO-MOUSE-MOVEMENT is non-nil, ignore key sequences starting
+with `mouse-movement' events."
+ (let ((enable-disabled-menus-and-buttons t)
+ (cursor-in-echo-area t)
+ saved-yank-menu)
+ (unwind-protect
+ (let (key down-ev)
+ ;; If yank-menu is empty, populate it temporarily, so that
+ ;; "Select and Paste" menu can generate a complete event.
+ (when (null (cdr yank-menu))
+ (setq saved-yank-menu (copy-sequence yank-menu))
+ (menu-bar-update-yank-menu "(any string)" nil))
+ (while
+ (pcase (setq key (read-key-sequence "\
+Describe the following key, mouse click, or menu item: "))
+ ((and (pred vectorp) (let `(,key0 . ,_) (aref key 0))
+ (guard (symbolp key0)) (let keyname (symbol-name key0)))
+ (or
+ (and no-mouse-movement
+ (string-match "mouse-movement" keyname))
+ (and (string-match "\\(mouse\\|down\\|click\\|drag\\)"
+ keyname)
+ (progn
+ ;; Discard events (e.g. <help-echo>) which might
+ ;; spuriously trigger the `sit-for'.
+ (sleep-for 0.01)
+ (while (read-event nil nil 0.01))
+ (not (sit-for (/ double-click-time 1000.0) t))))))))
+ (list
+ key
+ ;; If KEY is a down-event, read and include the
+ ;; corresponding up-event. Note that there are also
+ ;; down-events on scroll bars and mode lines: the actual
+ ;; event then is in the second element of the vector.
+ (and (vectorp key)
+ (let ((last-idx (1- (length key))))
+ (and (eventp (aref key last-idx))
+ (memq 'down (event-modifiers (aref key last-idx)))))
+ (or (and (eventp (setq down-ev (aref key 0)))
+ (memq 'down (event-modifiers down-ev))
+ ;; However, for the C-down-mouse-2 popup
+ ;; menu, there is no subsequent up-event. In
+ ;; this case, the up-event is the next
+ ;; element in the supplied vector.
+ (= (length key) 1))
+ (and (> (length key) 1)
+ (eventp (setq down-ev (aref key 1)))
+ (memq 'down (event-modifiers down-ev))))
+ (if (and (terminal-parameter nil 'xterm-mouse-mode)
+ (equal (terminal-parameter nil 'xterm-mouse-last-down)
+ down-ev))
+ (aref (read-key-sequence-vector nil) 0)
+ (read-event)))))
+ ;; Put yank-menu back as it was, if we changed it.
+ (when saved-yank-menu
+ (setq yank-menu (copy-sequence saved-yank-menu))
+ (fset 'yank-menu (cons 'keymap yank-menu))))))
+
(defun describe-key (&optional key untranslated up-event)
"Display documentation of the function invoked by KEY.
KEY can be any kind of a key sequence; it can include keyboard events,
@@ -748,83 +783,20 @@ UP-EVENT is the up-event that was discarded by reading KEY, or nil.
If KEY is a menu item or a tool-bar button that is disabled, this command
temporarily enables it to allow getting help on disabled items and buttons."
(interactive
- (let ((enable-disabled-menus-and-buttons t)
- (cursor-in-echo-area t)
- saved-yank-menu)
- (unwind-protect
- (let (key)
- ;; If yank-menu is empty, populate it temporarily, so that
- ;; "Select and Paste" menu can generate a complete event.
- (when (null (cdr yank-menu))
- (setq saved-yank-menu (copy-sequence yank-menu))
- (menu-bar-update-yank-menu "(any string)" nil))
- (while
- (progn
- (setq key (read-key-sequence "Describe the following key, mouse click, or menu item: "))
- (and (vectorp key)
- (consp (aref key 0))
- (symbolp (car (aref key 0)))
- (string-match "\\(mouse\\|down\\|click\\|drag\\)"
- (symbol-name (car (aref key 0))))
- (not (sit-for (/ double-click-time 1000.0) t)))))
- (list
- key
- (prefix-numeric-value current-prefix-arg)
- ;; If KEY is a down-event, read and include the
- ;; corresponding up-event. Note that there are also
- ;; down-events on scroll bars and mode lines: the actual
- ;; event then is in the second element of the vector.
- (and (vectorp key)
- (let ((last-idx (1- (length key))))
- (and (eventp (aref key last-idx))
- (memq 'down (event-modifiers (aref key last-idx)))))
- (or (and (eventp (aref key 0))
- (memq 'down (event-modifiers (aref key 0)))
- ;; However, for the C-down-mouse-2 popup
- ;; menu, there is no subsequent up-event. In
- ;; this case, the up-event is the next
- ;; element in the supplied vector.
- (= (length key) 1))
- (and (> (length key) 1)
- (eventp (aref key 1))
- (memq 'down (event-modifiers (aref key 1)))))
- (read-event))))
- ;; Put yank-menu back as it was, if we changed it.
- (when saved-yank-menu
- (setq yank-menu (copy-sequence saved-yank-menu))
- (fset 'yank-menu (cons 'keymap yank-menu))))))
- (if (numberp untranslated)
- (setq untranslated (this-single-command-raw-keys)))
- (let* ((event (aref key (if (and (symbolp (aref key 0))
- (> (length key) 1)
- (consp (aref key 1)))
- 1
- 0)))
- (modifiers (event-modifiers event))
- (mouse-msg (if (or (memq 'click modifiers) (memq 'down modifiers)
- (memq 'drag modifiers)) " at that spot" ""))
- (defn (key-binding key t))
- key-locus key-locus-up key-locus-up-tricky
- defn-up defn-up-tricky ev-type
- mouse-1-remapped mouse-1-tricky)
-
- ;; Handle the case where we faked an entry in "Select and Paste" menu.
- (when (and (eq defn nil)
- (stringp (aref key (1- (length key))))
- (eq (key-binding (substring key 0 -1)) 'yank-menu))
- (setq defn 'menu-bar-select-yank))
- (if (or (null defn) (integerp defn) (equal defn 'undefined))
- (message "%s%s is undefined"
- (help-key-description key untranslated) mouse-msg)
+ (pcase-let ((`(,key ,up-event) (help-read-key-sequence)))
+ `(,key ,(prefix-numeric-value current-prefix-arg) ,up-event)))
+ (pcase-let ((`(,brief-desc ,defn ,event ,mouse-msg)
+ (help--analyze-key key untranslated))
+ (defn-up nil) (defn-up-tricky nil)
+ (key-locus-up nil) (key-locus-up-tricky nil)
+ (mouse-1-remapped nil) (mouse-1-tricky nil)
+ (ev-type nil))
+ (if (or (null defn)
+ (integerp defn)
+ (equal defn 'undefined))
+ (message "%s" brief-desc)
(help-setup-xref (list #'describe-function defn)
(called-interactively-p 'interactive))
- ;; Don't bother user with strings from (e.g.) the select-paste menu.
- (when (stringp (aref key (1- (length key))))
- (aset key (1- (length key)) "(any string)"))
- (when (and untranslated
- (stringp (aref untranslated (1- (length untranslated)))))
- (aset untranslated (1- (length untranslated))
- "(any string)"))
;; Need to do this before erasing *Help* buffer in case event
;; is a mouse click in an existing *Help* buffer.
(when up-event
@@ -849,13 +821,12 @@ temporarily enables it to allow getting help on disabled items and buttons."
(aset sequence 0 'mouse-1)
(setq defn-up-tricky (key-binding sequence nil nil (event-start up-event)))
(setq key-locus-up-tricky (help--binding-locus sequence (event-start up-event))))))
- (setq key-locus (help--binding-locus key (event-start event)))
(with-help-window (help-buffer)
- (princ (help-key-description key untranslated))
- (princ (format "%s runs the command %S%s, which is "
- mouse-msg defn (if key-locus
- (format " (found in %s)" key-locus)
- "")))
+ (princ brief-desc)
+ (let ((key-locus (help--binding-locus key (event-start event))))
+ (when key-locus
+ (princ (format " (found in %s)" key-locus))))
+ (princ ", which is ")
(describe-function-1 defn)
(when up-event
(unless (or (null defn-up)
@@ -1374,7 +1345,7 @@ The result, when formatted by `substitute-command-keys', should equal STRING."
;; The following functions used to be in help-fns.el, which is not preloaded.
;; But for various reasons, they are more widely needed, so they were
-;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001
+;; moved to this file, which is preloaded. https://debbugs.gnu.org/17001
(defun help-split-fundoc (docstring def)
"Split a function DOCSTRING into the actual doc and the usage info.
@@ -1423,6 +1394,9 @@ If PRESERVE-NAMES is non-nil, return a formal arglist that uses
the same names as used in the original source code, when possible."
;; Handle symbols aliased to other symbols.
(if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
+ ;; Advice wrappers have "catch all" args, so fetch the actual underlying
+ ;; function to find the real arguments.
+ (while (advice--p def) (setq def (advice--cdr def)))
;; If definition is a macro, find the function inside it.
(if (eq (car-safe def) 'macro) (setq def (cdr def)))
(cond
diff --git a/lisp/hex-util.el b/lisp/hex-util.el
index e2e3d7f07c0..5289f06f4ea 100644
--- a/lisp/hex-util.el
+++ b/lisp/hex-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/hexl.el b/lisp/hexl.el
index 0a598b22f66..f591439558a 100644
--- a/lisp/hexl.el
+++ b/lisp/hexl.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el
index 6fcaad085de..4dddc17b59c 100644
--- a/lisp/hfy-cmap.el
+++ b/lisp/hfy-cmap.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 5139e01fa84..e3552fcac3f 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -693,7 +693,8 @@ with completion and history."
"Highlight REGEXP with face FACE."
;; Hashcons the regexp, so it can be passed to remove-overlays later.
(setq regexp (hi-lock--hashcons regexp))
- (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))))
+ (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend)))
+ (no-matches t))
;; Refuse to highlight a text that is already highlighted.
(if (assoc regexp hi-lock-interactive-patterns)
(add-to-list 'hi-lock--unused-faces (face-name face))
@@ -713,11 +714,16 @@ with completion and history."
(save-excursion
(goto-char search-start)
(while (re-search-forward regexp search-end t)
+ (when no-matches (setq no-matches nil))
(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
(overlay-put overlay 'hi-lock-overlay t)
(overlay-put overlay 'hi-lock-overlay-regexp regexp)
(overlay-put overlay 'face face))
- (goto-char (match-end 0)))))))))
+ (goto-char (match-end 0)))
+ (when no-matches
+ (add-to-list 'hi-lock--unused-faces (face-name face))
+ (setq hi-lock-interactive-patterns
+ (cdr hi-lock-interactive-patterns)))))))))
(defun hi-lock-set-file-patterns (patterns)
"Replace file patterns list with PATTERNS and refontify."
diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el
index 1a410564814..4979ed84b6a 100644
--- a/lisp/hilit-chg.el
+++ b/lisp/hilit-chg.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
index 8dc53bd8ec1..be3fedf0afd 100644
--- a/lisp/hippie-exp.el
+++ b/lisp/hippie-exp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 38fe683785a..9ccc354e845 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 74393ffbaeb..cb4c83d33e0 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -29,7 +29,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -461,7 +461,7 @@ and so on."
optimization - If on, preserve overlay highlighting
(cf ediff or goo-font-lock) as well as basic faces.\n
body-text-only : Emit only body-text. In concrete terms,
- 1. Suppress calls to `hfy-page-header'and
+ 1. Suppress calls to `hfy-page-header' and
`hfy-page-footer'
2. Pretend that `div-wrapper' option above is
turned off
@@ -650,7 +650,7 @@ STYLE is the inline CSS stylesheet (or tag referring to an external sheet)."
var even = false;
// if arguments are provided to specify the colors
- // of the even & odd rows, then use the them;
+ // of the even & odd rows, then use them;
// otherwise use the following defaults:
var evenColor = arguments[1] ? arguments[1] : \"#fff\";
var oddColor = arguments[2] ? arguments[2] : \"#ddd\";
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el
index 2a68f777d95..1ef7cb118cc 100644
--- a/lisp/ibuf-ext.el
+++ b/lisp/ibuf-ext.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -375,7 +375,7 @@ format. See `ibuffer-update-saved-filters-format' and
(let ((fixed (ibuffer-update-saved-filters-format ibuffer-saved-filters)))
(prog1
(setq ibuffer-saved-filters (cdr fixed))
- (when-let (old-format-detected (car fixed))
+ (when-let* ((old-format-detected (car fixed)))
(let ((warning-series t)
(updated-form
(with-output-to-string
@@ -1033,8 +1033,11 @@ group definitions by setting `ibuffer-filter-groups' to nil."
(ibuffer-jump-to-buffer (buffer-name buf)))))
(defun ibuffer-push-filter (filter-specification)
- "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'."
- (push filter-specification ibuffer-filtering-qualifiers))
+ "Add FILTER-SPECIFICATION to `ibuffer-filtering-qualifiers'.
+If FILTER-SPECIFICATION is already in the list then return nil. Otherwise,
+return the updated list."
+ (unless (member filter-specification ibuffer-filtering-qualifiers)
+ (push filter-specification ibuffer-filtering-qualifiers)))
;;;###autoload
(defun ibuffer-decompose-filter ()
@@ -1283,6 +1286,12 @@ currently used by buffers."
:reader (read-from-minibuffer "Filter by name (regexp): "))
(string-match qualifier (buffer-name buf)))
+;;;###autoload (autoload 'ibuffer-filter-by-process "ibuf-ext")
+(define-ibuffer-filter process
+ "Limit current view to buffers running a process."
+ (:description "process")
+ (get-buffer-process buf))
+
;;;###autoload (autoload 'ibuffer-filter-by-starred-name "ibuf-ext")
(define-ibuffer-filter starred-name
"Limit current view to buffers with name beginning and ending
diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el
index 2e751cebd6e..c30067f2f58 100644
--- a/lisp/ibuf-macs.el
+++ b/lisp/ibuf-macs.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -301,12 +301,16 @@ bound to the current value of the filter.
(defun ,fn-name (qualifier)
,(or documentation "This filter is not documented.")
(interactive (list ,reader))
- (ibuffer-push-filter (cons ',name qualifier))
- (message "%s"
- (format ,(concat (format "Filter by %s added: " description)
- " %s")
- qualifier))
- (ibuffer-update nil t))
+ (if (null (ibuffer-push-filter (cons ',name qualifier)))
+ (message "%s"
+ (format ,(concat (format "Filter by %s already applied: " description)
+ " %s")
+ qualifier))
+ (message "%s"
+ (format ,(concat (format "Filter by %s added: " description)
+ " %s")
+ qualifier))
+ (ibuffer-update nil t)))
(push (list ',name ,description
(lambda (buf qualifier)
(condition-case nil
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index c83c21315a1..7ed77d29921 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -522,6 +522,7 @@ directory, like `default-directory'."
(define-key map (kbd "/ m") 'ibuffer-filter-by-used-mode)
(define-key map (kbd "/ M") 'ibuffer-filter-by-derived-mode)
(define-key map (kbd "/ n") 'ibuffer-filter-by-name)
+ (define-key map (kbd "/ E") 'ibuffer-filter-by-process)
(define-key map (kbd "/ *") 'ibuffer-filter-by-starred-name)
(define-key map (kbd "/ f") 'ibuffer-filter-by-filename)
(define-key map (kbd "/ b") 'ibuffer-filter-by-basename)
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index a4153e806df..038f58f730d 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ido.el b/lisp/ido.el
index 07a5bcf7229..96a362f7608 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1,4 +1,4 @@
-;;; ido.el --- interactively do things with buffers and files
+;;; ido.el --- interactively do things with buffers and files -*- lexical-binding: t -*-
;; Copyright (C) 1996-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -443,7 +443,7 @@ Possible values:
`other-window' Show new file in another window (same frame)
`display' Display file in another window without selecting to it
`other-frame' Show new file in another frame
-`maybe-frame' If a file is visible in another frame, prompt to ask if you
+`maybe-frame' If a file is visible in another frame, prompt to ask if
you want to see the file in the same window of the current
frame or in the other frame
`raise-frame' If a file is visible in another frame, raise that
@@ -497,7 +497,7 @@ as first char even if `ido-enable-prefix' is nil."
:type 'boolean
:group 'ido)
-;; See http://debbugs.gnu.org/2042 for more info.
+;; See https://debbugs.gnu.org/2042 for more info.
(defcustom ido-buffer-disable-smart-matches t
"Non-nil means not to re-order matches for buffer switching.
By default, Ido arranges matches in the following order:
@@ -3678,7 +3678,7 @@ in this list."
ido-temp-list)))))
(ido-to-end ;; move . files to end
(delq nil (mapcar
- (lambda (x) (if (string-equal (substring x 0 1) ".") x))
+ (lambda (x) (if (string-match "\\`\\." x) x))
ido-temp-list)))
(if (and default (member default ido-temp-list))
(if (or ido-rotate-temp ido-rotate-file-list-default)
@@ -4302,7 +4302,7 @@ For details of keybindings, see `ido-find-file'."
;;;###autoload
(defun ido-find-alternate-file ()
- "Switch to another file and show it in another window.
+ "Find another file, select its buffer, kill previous buffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'."
(interactive)
@@ -4701,7 +4701,7 @@ Modified from `icomplete-completions'."
(if (and ido-use-faces comps)
(let* ((fn (ido-name (car comps)))
(ln (length fn)))
- (setq first (format "%s" fn))
+ (setq first (copy-sequence fn))
(put-text-property 0 ln 'face
(if (= (length comps) 1)
(if ido-incomplete-regexp
@@ -4835,7 +4835,7 @@ Modified from `icomplete-completions'."
(put 'dired 'ido 'dir)
(put 'dired-other-window 'ido 'dir)
(put 'dired-other-frame 'ido 'dir)
-;; See http://debbugs.gnu.org/11954 for reasons.
+;; See https://debbugs.gnu.org/11954 for reasons.
(put 'dired-do-copy 'ido 'ignore)
(put 'dired-do-rename 'ido 'ignore)
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 42b065fe62d..4ec195528c7 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/iimage.el b/lisp/iimage.el
index abb88ec5029..7226476fac0 100644
--- a/lisp/iimage.el
+++ b/lisp/iimage.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/image-dired.el b/lisp/image-dired.el
index 49dba52c884..175d9df5e8c 100644
--- a/lisp/image-dired.el
+++ b/lisp/image-dired.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -582,10 +582,11 @@ Create the thumbnails directory if it does not exist."
"Return the image descriptor for a thumbnail of image file FILE."
(unless (string-match (image-file-name-regexp) file)
(error "%s is not a valid image file" file))
- (let ((thumb-file (image-dired-thumb-name file)))
- (unless (and (file-exists-p thumb-file)
- (<= (float-time (nth 5 (file-attributes file)))
- (float-time (nth 5 (file-attributes thumb-file)))))
+ (let* ((thumb-file (image-dired-thumb-name file))
+ (thumb-attr (file-attributes thumb-file)))
+ (when (or (not thumb-attr)
+ (time-less-p (nth 5 thumb-attr)
+ (nth 5 (file-attributes file))))
(image-dired-create-thumb file thumb-file))
(create-image thumb-file)
;; (list 'image :type 'jpeg
@@ -748,7 +749,8 @@ Increase at own risk.")
'image-dired-cmd-create-thumbnail-program)
(let* ((width (int-to-string (image-dired-thumb-size 'width)))
(height (int-to-string (image-dired-thumb-size 'height)))
- (modif-time (floor (float-time (nth 5 (file-attributes original-file)))))
+ (modif-time (format-time-string
+ "%s" (nth 5 (file-attributes original-file))))
(thumbnail-nq8-file (replace-regexp-in-string ".png\\'" "-nq8.png"
thumbnail-file))
(spec
diff --git a/lisp/image-file.el b/lisp/image-file.el
index 33cea95d538..285151df90a 100644
--- a/lisp/image-file.el
+++ b/lisp/image-file.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 4b92e8673a9..87d18fd3c47 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/image.el b/lisp/image.el
index 8cea7fb2c8b..ed32307ae24 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -34,8 +34,8 @@
(defconst image-type-header-regexps
`(("\\`/[\t\n\r ]*\\*.*XPM.\\*/" . xpm)
("\\`P[1-6]\\(?:\
-\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[[:space:]]\\)+\
-\\(?:\\(?:#[^\r\n]*[\r\n]\\)?[0-9]\\)+\
+\\(?:\\(?:#[^\r\n]*[\r\n]\\)*[[:space:]]\\)+\
+\\(?:\\(?:#[^\r\n]*[\r\n]\\)*[0-9]\\)+\
\\)\\{2\\}" . pbm)
("\\`GIF8[79]a" . gif)
("\\`\x89PNG\r\n\x1a\n" . png)
@@ -976,11 +976,12 @@ default is 20%."
image))
(defun image--get-imagemagick-and-warn ()
- (unless (fboundp 'imagemagick-types)
+ (unless (or (fboundp 'imagemagick-types) (featurep 'ns))
(error "Can't rescale images without ImageMagick support"))
(let ((image (image--get-image)))
(image-flush image)
- (plist-put (cdr image) :type 'imagemagick)
+ (when (fboundp 'imagemagick-types)
+ (plist-put (cdr image) :type 'imagemagick))
image))
(defun image--change-size (factor)
diff --git a/lisp/image/compface.el b/lisp/image/compface.el
index f4c3d5f4df0..ccbd0a3e3b5 100644
--- a/lisp/image/compface.el
+++ b/lisp/image/compface.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el
index 54ca3be96ae..6173c8527eb 100644
--- a/lisp/image/gravatar.el
+++ b/lisp/image/gravatar.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -77,11 +77,7 @@
(not (file-exists-p (url-cache-create-filename url))))
(t (let ((cache-time (url-is-cached url)))
(if cache-time
- (time-less-p
- (time-add
- cache-time
- gravatar-cache-ttl)
- (current-time))
+ (time-less-p (time-add cache-time gravatar-cache-ttl) nil)
t)))))
(defun gravatar-get-data ()
diff --git a/lisp/imenu.el b/lisp/imenu.el
index c1fd4005ab6..e2c946c3a06 100644
--- a/lisp/imenu.el
+++ b/lisp/imenu.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/indent.el b/lisp/indent.el
index e7a30b885d7..d5ba0bd8491 100644
--- a/lisp/indent.el
+++ b/lisp/indent.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 6963c782704..f52f48edec2 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -31,9 +31,9 @@
;;
;; Scheme: <URL:http://groups.csail.mit.edu/mac/ftpdir/scm/r5rs.info.tar.gz>
;; LaTeX:
-;; <URL:ftp://ctan.tug.org/tex-archive/info/latex2e-help-texinfo/latex2e.texi>
+;; <URL:http://ctan.tug.org/tex-archive/info/latex2e-help-texinfo/latex2e.texi>
;; (or CTAN mirrors)
-;; Perl: <URL:ftp://ftp.cpan.org/pub/CPAN/doc/manual/texinfo/> (or CPAN mirrors)
+;; Perl: <URL:http://ftp.cpan.org/pub/CPAN/doc/manual/texinfo/> (or CPAN mirrors)
;; Traditionally, makeinfo quoted `like this', but version 5 and later
;; quotes 'like this' or ‘like this’. Doc specs with patterns
@@ -959,7 +959,7 @@ Return nil if there is nothing appropriate in the buffer near point."
:mode 'scheme-mode
:regexp "[^()`'‘’,\" \t\n]+"
:ignore-case t
- ;; Aubrey Jaffer's rendition from <URL:ftp://ftp-swiss.ai.mit.edu/pub/scm>
+ ;; Aubrey Jaffer's rendition from <https://people.csail.mit.edu/jaffer/SCM>
:doc-spec '(("(r5rs)Index" nil
"^[ \t]+-+ [^:]+:[ \t]*" "\\b")))
diff --git a/lisp/info-xref.el b/lisp/info-xref.el
index 8c029d46b30..4fc7c4f699a 100644
--- a/lisp/info-xref.el
+++ b/lisp/info-xref.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/info.el b/lisp/info.el
index a2071533d8f..0a4f672b9f2 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -171,7 +171,11 @@ A header-line does not scroll with the rest of the buffer."
;; 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.
+;; 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.
;;;###autoload
(progn
(defcustom Info-default-directory-list
@@ -436,22 +440,33 @@ Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).")
(defvar Info-virtual-files nil
"List of definitions of virtual Info files.
-Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...)
-where FILENAME is a regexp that matches a class of virtual Info file names.
-It should be carefully chosen to not cause file name clashes with
-existing file names. OPERATION is one of the following operation
-symbols `find-file', `find-node', `toc-nodes' that define what HANDLER
-function to call instead of calling the default corresponding function
-to override it.")
+Each element of the list has the form (FILENAME (OPERATION . HANDLER) EXTRA)
+where FILENAME is a regexp that matches a class of virtual Info file names,
+it should be carefully chosen to not cause file name clashes with
+existing file names;
+OPERATION is one of the symbols `find-file', `find-node', `toc-nodes';
+and HANDLER is a function to call when OPERATION is invoked on a
+virtual Info file.
+EXTRA, if present, is one or more cons cells specifying extra
+attributes important to some applications which use this data.
+For example, desktop saving and desktop restoring use the `slow'
+attribute to avoid restoration of nodes that could be expensive
+to compute.")
(defvar Info-virtual-nodes nil
"List of definitions of virtual Info nodes.
-Each element of the list has the format (NODENAME (OPERATION . HANDLER) ...)
-where NODENAME is a regexp that matches a class of virtual Info node names.
-It should be carefully chosen to not cause node name clashes with
-existing node names. OPERATION is one of the following operation
-symbols `find-node' that define what HANDLER function to call instead
-of calling the default corresponding function to override it.")
+Each element of the list has the form (NODENAME (OPERATION . HANDLER) EXTRA)
+where NODENAME is a regexp that matches a class of virtual Info node names,
+it should be carefully chosen to not cause node name clashes with
+existing node names;
+OPERATION is the symbol `find-node';
+and HANDLER is a function to call when OPERATION is invoked on a
+virtual Info node.
+EXTRA, if present, is one or more cons cells specifying extra
+attributes important to some applications which use this data.
+For example, desktop saving and desktop restoring use the `slow'
+attribute to avoid restoration of nodes that could be expensive
+to compute.")
(defvar-local Info-current-node-virtual nil
"Non-nil if the current Info node is virtual.")
@@ -634,7 +649,7 @@ Do the right thing if the file has been compressed or zipped."
(attribs-new (and (stringp fullname) (file-attributes fullname)))
(modtime-new (and attribs-new (nth 5 attribs-new))))
(when (and modtime-old modtime-new
- (> (float-time modtime-new) (float-time modtime-old)))
+ (time-less-p modtime-old modtime-new))
(setq Info-index-nodes (remove (assoc (or Info-current-file filename)
Info-index-nodes)
Info-index-nodes))
@@ -1332,7 +1347,7 @@ is non-nil)."
;; Shouldn't really happen, but sometimes does,
;; eg on Debian systems with buggy packages;
;; so may as well try it.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00005.html
+ ;; https://lists.gnu.org/r/emacs-devel/2012-03/msg00005.html
(progn (setq file (expand-file-name "dir.gz" truename))
(file-attributes file)))))
(setq dirs-done
@@ -4008,7 +4023,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
(define-key map "h" 'Info-help)
;; This is for compatibility with standalone info (>~ version 5.2).
;; Though for some time, standalone info had H and h reversed.
- ;; See <http://debbugs.gnu.org/16455>.
+ ;; See <https://debbugs.gnu.org/16455>.
(define-key map "H" 'describe-mode)
(define-key map "i" 'Info-index)
(define-key map "I" 'Info-virtual-index)
@@ -4650,7 +4665,7 @@ first line or header line, and for breadcrumb links.")
(if (string-equal (downcase tag) "node")
(put-text-property nbeg nend 'font-lock-face 'info-header-node)
(put-text-property nbeg nend 'font-lock-face 'info-header-xref)
- (put-text-property tbeg nend 'mouse-face 'highlight)
+ (put-text-property tbeg nend 'mouse-face 'header-line-highlight)
(put-text-property tbeg nend
'help-echo
(concat "mouse-2: Go to node "
diff --git a/lisp/informat.el b/lisp/informat.el
index b35e2ed379d..a1ed7a94843 100644
--- a/lisp/informat.el
+++ b/lisp/informat.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el
index aa9bd2d11c3..0ac79562e23 100644
--- a/lisp/international/ccl.el
+++ b/lisp/international/ccl.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 33cb3d85223..51d8765f8b0 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -148,6 +148,7 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry '(#xF900 . #xFAFF) ?C)
(modify-category-entry '(#xF900 . #xFAFF) ?c)
(modify-category-entry '(#xF900 . #xFAFF) ?|)
+(modify-category-entry '(#x1B170 . #x1B2FF) ?c)
(modify-category-entry '(#x20000 . #x2FFFF) ?|)
(modify-category-entry '(#x20000 . #x2FFFF) ?C)
(modify-category-entry '(#x20000 . #x2FFFF) ?c)
@@ -221,6 +222,8 @@ with L, LRE, or LRO Unicode bidi character type.")
(modify-category-entry #x30A0 ?H)
(modify-category-entry #x30FC ?H)
+(modify-category-entry '(#x1B000 . #x1B1FF) ?j)
+
;; JISX0208
(map-charset-chars #'modify-syntax-entry 'japanese-jisx0208 "_" #x2121 #x227E)
@@ -1196,10 +1199,11 @@ with L, LRE, or LRO Unicode bidi character type.")
(#xFE30 . #xFE6F)
(#xFF01 . #xFF60)
(#xFFE0 . #xFFE6)
- (#x16FE0 . #x16FE0)
+ (#x16FE0 . #x16FE1)
(#x17000 . #x187EC)
(#x18800 . #x18AF2)
- (#x1B000 . #x1B001)
+ (#x1B000 . #x1B11E)
+ (#x1B170 . #x1B2FB)
(#x1F004 . #x1F004)
(#x1F0CF . #x1F0CF)
(#x1F18E . #x1F18E)
@@ -1229,15 +1233,13 @@ with L, LRE, or LRO Unicode bidi character type.")
(#x1F6CC . #x1F6CC)
(#x1F6D0 . #x1F6D2)
(#x1F6EB . #x1F6EC)
- (#x1F6F4 . #x1F6F6)
- (#x1F910 . #x1F91E)
- (#x1F920 . #x1F927)
- (#x1F930 . #x1F930)
- (#x1F933 . #x1F93E)
- (#x1F940 . #x1F94B)
- (#x1F950 . #x1F95E)
- (#x1F980 . #x1F991)
+ (#x1F6F4 . #x1F6F8)
+ (#x1F910 . #x1F93E)
+ (#x1F940 . #x1F94C)
+ (#x1F950 . #x1F96B)
+ (#x1F980 . #x1F997)
(#x1F9C0 . #x1F9C0)
+ (#x1F9D0 . #x1F9E6)
(#x20000 . #x2FFFF)
(#x30000 . #x3FFFF))))
(dolist (elt l)
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index e023d253693..c6c62ef0a0c 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -227,9 +227,12 @@
(modi #x11600)
(takri #x11680)
(warang-citi #x118A1)
+ (zanabazar-square #x11A00)
+ (soyombo #x11A50)
(pau-cin-hau #x11AC0)
(bhaiksuki #x11C00)
(marchen #x11C72)
+ (masaram-gondi #x11D00)
(cuneiform #x12000)
(cuneiform-numbers-and-punctuation #x12400)
(mro #x16A40)
@@ -237,6 +240,7 @@
(pahawh-hmong #x16B11)
(tangut #x17000)
(tangut-components #x18800)
+ (nushu #x1B170)
(duployan-shorthand #x1BC20)
(byzantine-musical-symbol #x1D000)
(musical-symbol #x1D100)
diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el
index 40bdb38b223..dce323e4296 100644
--- a/lisp/international/isearch-x.el
+++ b/lisp/international/isearch-x.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
index 39f1e9f46ba..327657512a4 100644
--- a/lisp/international/iso-ascii.el
+++ b/lisp/international/iso-ascii.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
index ebf90a31224..69969d68576 100644
--- a/lisp/international/iso-cvt.el
+++ b/lisp/international/iso-cvt.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This lisp code is a general framework for translating various
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
index a665a39b63c..86958474828 100644
--- a/lisp/international/iso-transl.el
+++ b/lisp/international/iso-transl.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el
index e80b1b28810..f5220b04cd4 100644
--- a/lisp/international/ja-dic-cnv.el
+++ b/lisp/international/ja-dic-cnv.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -125,10 +125,10 @@
;; Search postfix entries.
(while (re-search-forward "^[#<>?]\\(\\(\\cH\\|$B!<(B\\)+\\) " nil t)
- (let ((kana (match-string 1))
+ (let ((kana (match-string-no-properties 1))
str candidates)
(while (looking-at "/[#0-9 ]*\\([^/\n]*\\)/")
- (setq str (match-string 1))
+ (setq str (match-string-no-properties 1))
(if (not (member str candidates))
(setq candidates (cons str candidates)))
(goto-char (match-end 1)))
@@ -158,10 +158,10 @@
"(skkdic-set-prefix\n"))
(save-excursion
(while (re-search-forward "^\\(\\(\\cH\\|$B!<(B\\)+\\)[<>?] " nil t)
- (let ((kana (match-string 1))
+ (let ((kana (match-string-no-properties 1))
str candidates)
(while (looking-at "/\\([^/\n]+\\)/")
- (setq str (match-string 1))
+ (setq str (match-string-no-properties 1))
(if (not (member str candidates))
(setq candidates (cons str candidates)))
(goto-char (match-end 1)))
@@ -180,8 +180,8 @@
(let (candidates)
(goto-char from)
(while (re-search-forward "/[^/ \n]+" to t)
- (setq candidates (cons (buffer-substring (1+ (match-beginning 0))
- (match-end 0))
+ (setq candidates (cons (buffer-substring-no-properties
+ (1+ (match-beginning 0)) (match-end 0))
candidates)))
candidates))
@@ -251,12 +251,16 @@
;; Return list of candidates which excludes some from CANDIDATES.
;; Excluded candidates can be derived from another entry.
+(defconst skkdic--japanese-category-set (make-category-set "j"))
+
(defun skkdic-reduced-candidates (skkbuf kana candidates)
(let (elt l)
(while candidates
(setq elt (car candidates))
(if (or (= (length elt) 1)
- (and (string-match "^\\cj" elt)
+ (and (bool-vector-subsetp
+ skkdic--japanese-category-set
+ (char-category-set (aref elt 0)))
(not (skkdic-breakup-string skkbuf kana elt 0 (length elt)
'first))))
(setq l (cons elt l)))
@@ -267,24 +271,18 @@
(defvar skkdic-okuri-nasi-entries-count 0)
(defun skkdic-collect-okuri-nasi ()
- (message "Collecting OKURI-NASI entries ...")
(save-excursion
- (let ((prev-ratio 0)
- ratio)
+ (let ((progress (make-progress-reporter "Collecting OKURI-NASI entries"
+ (point) (point-max)
+ nil 10)))
(while (re-search-forward "^\\(\\(\\cH\\|$B!<(B\\)+\\) \\(/\\cj.*\\)/$"
nil t)
- (let ((kana (match-string 1))
+ (let ((kana (match-string-no-properties 1))
(candidates (skkdic-get-candidate-list (match-beginning 3)
(match-end 3))))
(setq skkdic-okuri-nasi-entries
- (cons (cons kana candidates) skkdic-okuri-nasi-entries)
- skkdic-okuri-nasi-entries-count
- (1+ skkdic-okuri-nasi-entries-count))
- (setq ratio (floor (* (point) 100.0) (point-max)))
- (if (/= (/ prev-ratio 10) (/ ratio 10))
- (progn
- (message "collected %2d%% ..." ratio)
- (setq prev-ratio ratio)))
+ (cons (cons kana candidates) skkdic-okuri-nasi-entries))
+ (progress-reporter-update progress (point))
(while candidates
(let ((entry (lookup-nested-alist (car candidates)
skkdic-word-list nil nil t)))
@@ -292,26 +290,24 @@
(setcar entry (cons kana (car entry)))
(set-nested-alist (car candidates) (list kana)
skkdic-word-list)))
- (setq candidates (cdr candidates))))))))
+ (setq candidates (cdr candidates)))))
+ (setq skkdic-okuri-nasi-entries-count (length skkdic-okuri-nasi-entries))
+ (progress-reporter-done progress))))
(defun skkdic-convert-okuri-nasi (skkbuf buf)
- (message "Processing OKURI-NASI entries ...")
(with-current-buffer buf
(insert ";; Setting okuri-nasi entries.\n"
"(skkdic-set-okuri-nasi\n")
(let ((l (nreverse skkdic-okuri-nasi-entries))
- (count 0)
- (prev-ratio 0)
- ratio)
+ (progress (make-progress-reporter "Processing OKURI-NASI entries"
+ 0 skkdic-okuri-nasi-entries-count
+ nil 10))
+ (count 0))
(while l
(let ((kana (car (car l)))
(candidates (cdr (car l))))
- (setq ratio (floor (* count 100.0) skkdic-okuri-nasi-entries-count)
- count (1+ count))
- (if (/= (/ prev-ratio 10) (/ ratio 10))
- (progn
- (message "processed %2d%% ..." ratio)
- (setq prev-ratio ratio)))
+ (setq count (1+ count))
+ (progress-reporter-update progress count)
(if (setq candidates
(skkdic-reduced-candidates skkbuf kana candidates))
(progn
@@ -320,7 +316,8 @@
(insert " " (car candidates))
(setq candidates (cdr candidates)))
(insert "\"\n"))))
- (setq l (cdr l))))
+ (setq l (cdr l)))
+ (progress-reporter-done progress))
(insert ")\n\n")))
(defun skkdic-convert (filename &optional dirname)
@@ -467,7 +464,7 @@ To get complete usage, invoke:
(i (match-end 0))
candidates)
(while (string-match "[^ ]+" entry i)
- (setq candidates (cons (match-string 0 entry) candidates))
+ (setq candidates (cons (match-string-no-properties 0 entry) candidates))
(setq i (match-end 0)))
(cons (skkdic-get-kana-compact-codes kana) candidates)))
diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el
index 7005ba85726..86ba3749df8 100644
--- a/lisp/international/ja-dic-utl.el
+++ b/lisp/international/ja-dic-utl.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el
index f87d2e9ed16..9f20b3e978e 100644
--- a/lisp/international/kinsoku.el
+++ b/lisp/international/kinsoku.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el
index 17a3b6c2dbf..261c1c658c8 100644
--- a/lisp/international/kkc.el
+++ b/lisp/international/kkc.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el
index 4b09bfbd193..761b9643d96 100644
--- a/lisp/international/latexenc.el
+++ b/lisp/international/latexenc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el
index d9b71c8f44b..79192486677 100644
--- a/lisp/international/latin1-disp.el
+++ b/lisp/international/latin1-disp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index bdba8eeb112..9d22d6e8dd2 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -354,11 +354,12 @@ This also sets the following values:
(if (eq system-type 'darwin)
;; The file-name coding system on Darwin systems is always utf-8.
- (setq default-file-name-coding-system 'utf-8)
+ (setq default-file-name-coding-system 'utf-8-unix)
(if (and (default-value 'enable-multibyte-characters)
(or (not coding-system)
(coding-system-get coding-system 'ascii-compatible-p)))
- (setq default-file-name-coding-system coding-system)))
+ (setq default-file-name-coding-system
+ (coding-system-change-eol-conversion coding-system 'unix))))
(setq default-terminal-coding-system coding-system)
;; Prevent default-terminal-coding-system from converting ^M to ^J.
(setq default-keyboard-coding-system
@@ -414,7 +415,7 @@ To prefer, for instance, utf-8, say the following:
(coding-system-change-eol-conversion base eol-type)))
(set-default-coding-systems base)
(if (called-interactively-p 'interactive)
- (or (eq base default-file-name-coding-system)
+ (or (eq base (coding-system-type default-file-name-coding-system))
(message "The default value of `file-name-coding-system' was not changed because the specified coding system is not suitable for file names.")))))
(defvar sort-coding-systems-predicate nil
@@ -1482,9 +1483,7 @@ If INPUT-METHOD is nil, deactivate any current input method."
current-input-method-title nil)
(funcall deactivate-current-input-method-function))
(unwind-protect
- (run-hooks
- 'input-method-inactivate-hook ; for backward compatibility
- 'input-method-deactivate-hook)
+ (run-hooks 'input-method-deactivate-hook)
(setq current-input-method nil)
(force-mode-line-update)))))
@@ -1799,9 +1798,9 @@ The default status is as follows:
(set-default-coding-systems nil)
(setq default-sendmail-coding-system 'iso-latin-1)
- ;; On Darwin systems, this should be utf-8, but when this file is loaded
- ;; utf-8 is not yet defined, so we set it in set-locale-environment instead.
- (setq default-file-name-coding-system 'iso-latin-1)
+ ;; On Darwin systems, this should be utf-8-unix, but when this file is loaded
+ ;; that is not yet defined, so we set it in set-locale-environment instead.
+ (setq default-file-name-coding-system 'iso-latin-1-unix)
;; Preserve eol-type from existing default-process-coding-systems.
;; On non-unix-like systems in particular, these may have been set
;; carefully by the user, or by the startup code, to deal with the
@@ -2724,7 +2723,7 @@ See also `locale-charset-language-names', `locale-language-names',
(when (eq system-type 'darwin)
;; On Darwin, file names are always encoded in utf-8, no matter
;; the locale.
- (setq default-file-name-coding-system 'utf-8)
+ (setq default-file-name-coding-system 'utf-8-unix)
;; macOS's Terminal.app by default uses utf-8 regardless of
;; the locale.
(when (and (null window-system)
@@ -2924,10 +2923,10 @@ on encoding."
(make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1")
(defvar ucs-names nil
- "Alist of cached (CHAR-NAME . CHAR-CODE) pairs.")
+ "Hash table of cached CHAR-NAME keys to CHAR-CODE values.")
(defun ucs-names ()
- "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'."
+ "Return table of CHAR-NAME keys and CHAR-CODE values cached in `ucs-names'."
(or ucs-names
(let ((ranges
'((#x0000 . #x33FF)
@@ -2945,46 +2944,49 @@ on encoding."
;; (#x17000 . #x187FF) Tangut Ideographs
;; (#x18800 . #x18AFF) Tangut Components
;; (#x18B00 . #x1AFFF) unused
- (#x1B000 . #x1B0FF)
- ;; (#x1B100 . #x1BBFF) unused
+ (#x1B000 . #x1B12F)
+ ;; (#x1B130 . #x1B16F) unused
+ (#x1B170 . #x1B2FF)
+ ;; (#x1B300 . #x1BBFF) unused
(#x1BC00 . #x1BCAF)
;; (#x1BCB0 . #x1CFFF) unused
(#x1D000 . #x1FFFF)
;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused
(#xE0000 . #xE01FF)))
(gc-cons-threshold 10000000)
- names)
- (dolist (range ranges)
- (let ((c (car range))
- (end (cdr range)))
- (while (<= c end)
+ (names (make-hash-table :size 42943 :test #'equal)))
+ (dolist (range ranges)
+ (let ((c (car range))
+ (end (cdr range)))
+ (while (<= c end)
(let ((new-name (get-char-code-property c 'name))
(old-name (get-char-code-property c 'old-name)))
- ;; In theory this code could end up pushing an "old-name" that
- ;; shadows a "new-name" but in practice every time an
- ;; `old-name' conflicts with a `new-name', the newer one has a
- ;; higher code, so it gets pushed later!
- (if new-name (push (cons new-name c) names))
- (if old-name (push (cons old-name c) names))
- (setq c (1+ c))))))
- ;; Special case for "BELL" which is apparently the only char which
- ;; doesn't have a new name and whose old-name is shadowed by a newer
- ;; char with that name.
- (setq ucs-names `(("BELL (BEL)" . 7) ,@names)))))
+ ;; In theory this code could end up pushing an "old-name" that
+ ;; shadows a "new-name" but in practice every time an
+ ;; `old-name' conflicts with a `new-name', the newer one has a
+ ;; higher code, so it gets pushed later!
+ (if new-name (puthash new-name c names))
+ (if old-name (puthash old-name c names))
+ (setq c (1+ c))))))
+ ;; Special case for "BELL" which is apparently the only char which
+ ;; doesn't have a new name and whose old-name is shadowed by a newer
+ ;; char with that name.
+ (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 (assoc name ucs-names)))
- (when char (format " (%c)" (cdr char)))))
+ (let ((char (gethash name ucs-names)))
+ (when char (format " (%c)" char))))
(defun char-from-name (string &optional ignore-case)
"Return a character as a number from its Unicode name STRING.
If optional IGNORE-CASE is non-nil, ignore case in STRING.
Return nil if STRING does not name a character."
- (or (cdr (assoc-string string (ucs-names) ignore-case))
+ (or (gethash (if ignore-case (upcase string) string) (ucs-names))
(let ((minus (string-match-p "-[0-9A-F]+\\'" string)))
(when minus
;; Parse names like "VARIATION SELECTOR-17" and "CJK
diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el
index 68a412f206e..d4bdfd49583 100644
--- a/lisp/international/mule-conf.el
+++ b/lisp/international/mule-conf.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1175,7 +1175,8 @@
:short-name "CNS11643-15"
:long-name "CNS11643-15 (Chinese traditional)"
:code-space [33 126 33 126]
- :code-offset #x27A000)
+ :code-offset #x27A000
+ :unify-map "CNS-F")
(unify-charset 'chinese-gb2312)
(unify-charset 'chinese-gbk)
@@ -1186,6 +1187,7 @@
(unify-charset 'chinese-cns11643-5)
(unify-charset 'chinese-cns11643-6)
(unify-charset 'chinese-cns11643-7)
+(unify-charset 'chinese-cns11643-15)
(unify-charset 'big5)
(unify-charset 'chinese-big5-1)
(unify-charset 'chinese-big5-2)
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index c274621f772..e1e60d192ed 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -838,7 +838,8 @@ The font must be already used by Emacs."
(interactive "sFont name (default current choice for ASCII chars): ")
(or (and window-system (fboundp 'fontset-list))
(error "No fonts being used"))
- (let (font-info)
+ (let ((xref-item (list #'describe-font fontname))
+ font-info)
(if (or (not fontname) (= (length fontname) 0))
(setq fontname (face-attribute 'default :font)))
(setq font-info (font-info fontname))
@@ -850,6 +851,7 @@ The font must be already used by Emacs."
;; this problem.
(message "No information about \"%s\"" (font-xlfd-name fontname))
(message "No matching font found"))
+ (help-setup-xref xref-item (called-interactively-p 'interactive))
(with-output-to-temp-buffer "*Help*"
(describe-font-internal font-info)))))
diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el
index e34b01c3064..ca84a230779 100644
--- a/lisp/international/mule-util.el
+++ b/lisp/international/mule-util.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -143,20 +143,43 @@ longer than KEYSEQ.
See the documentation of `nested-alist-p' for more detail."
(or (nested-alist-p alist)
(error "Invalid argument %s" alist))
- (let ((islist (listp keyseq))
- (len (or len (length keyseq)))
- (i 0)
- key-elt slot)
- (while (< i len)
- (if (null (nested-alist-p alist))
- (error "Keyseq %s is too long for this nested alist" keyseq))
- (setq key-elt (if islist (nth i keyseq) (aref keyseq i)))
- (setq slot (assoc key-elt (cdr alist)))
- (unless slot
- (setq slot (cons key-elt (list t)))
- (setcdr alist (cons slot (cdr alist))))
- (setq alist (cdr slot))
- (setq i (1+ i)))
+ (let ((len (or len (length keyseq)))
+ (i 0))
+ (cond
+ ((stringp keyseq) ; We can use `assq' for characters.
+ (while (< i len)
+ (if (null (nested-alist-p alist))
+ (error "Keyseq %s is too long for this nested alist" keyseq))
+ (let* ((key-elt (aref keyseq i))
+ (slot (assq key-elt (cdr alist))))
+ (unless slot
+ (setq slot (list key-elt t))
+ (push slot (cdr alist)))
+ (setq alist (cdr slot)))
+ (setq i (1+ i))))
+ ((arrayp keyseq)
+ (while (< i len)
+ (if (null (nested-alist-p alist))
+ (error "Keyseq %s is too long for this nested alist" keyseq))
+ (let* ((key-elt (aref keyseq i))
+ (slot (assoc key-elt (cdr alist))))
+ (unless slot
+ (setq slot (list key-elt t))
+ (push slot (cdr alist)))
+ (setq alist (cdr slot)))
+ (setq i (1+ i))))
+ ((listp keyseq)
+ (while (< i len)
+ (if (null (nested-alist-p alist))
+ (error "Keyseq %s is too long for this nested alist" keyseq))
+ (let* ((key-elt (pop keyseq))
+ (slot (assoc key-elt (cdr alist))))
+ (unless slot
+ (setq slot (list key-elt t))
+ (push slot (cdr alist)))
+ (setq alist (cdr slot)))
+ (setq i (1+ i))))
+ (t (signal 'wrong-type-argument (list keyseq))))
(setcar alist entry)
(if branches
(setcdr (last alist) branches))))
@@ -179,15 +202,23 @@ Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil
(setq len (length keyseq)))
(let ((i (or start 0)))
(if (catch 'lookup-nested-alist-tag
- (if (listp keyseq)
- (while (< i len)
- (if (setq alist (cdr (assoc (nth i keyseq) (cdr alist))))
- (setq i (1+ i))
- (throw 'lookup-nested-alist-tag t))))
- (while (< i len)
- (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist))))
- (setq i (1+ i))
- (throw 'lookup-nested-alist-tag t))))
+ (cond ((stringp keyseq) ; We can use `assq' for characters.
+ (while (< i len)
+ (if (setq alist (cdr (assq (aref keyseq i) (cdr alist))))
+ (setq i (1+ i))
+ (throw 'lookup-nested-alist-tag t))))
+ ((arrayp keyseq)
+ (while (< i len)
+ (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist))))
+ (setq i (1+ i))
+ (throw 'lookup-nested-alist-tag t))))
+ ((listp keyseq)
+ (setq keyseq (nthcdr i keyseq))
+ (while (< i len)
+ (if (setq alist (cdr (assoc (pop keyseq) (cdr alist))))
+ (setq i (1+ i))
+ (throw 'lookup-nested-alist-tag t))))
+ (t (signal 'wrong-type-argument (list keyseq)))))
;; KEYSEQ is too long.
(if nil-for-too-long nil i)
alist)))
diff --git a/lisp/international/mule.el b/lisp/international/mule.el
index 6cfb7e6d457..857fa800eb4 100644
--- a/lisp/international/mule.el
+++ b/lisp/international/mule.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -773,7 +773,7 @@ never used by the other charsets.
If it is a list, the elements must be charsets, nil, 94, or 96. GN
can be used by all the listed charsets. If the list contains 94, any
iso-2022 charset whose code-space ranges are 94 long can be designated
-to GN. If the list contains 96, any charsets whose whose ranges are
+to GN. If the list contains 96, any charsets whose ranges are
96 long can be designated to GN. If the first element is a charset,
that charset is initially designated to GN.
diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el
index ef3a980f19a..bdd621fe9a1 100644
--- a/lisp/international/ogonek.el
+++ b/lisp/international/ogonek.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -301,13 +301,12 @@ Store the name in the parameter-variable DEFAULT-NAME-VAR.
PROMPT is a string to be shown when the user is asked for a name."
(let ((encoding
(completing-read
- (format "%s (default %s): " prompt (eval default-name-var))
+ (format "%s (default %s): " prompt (symbol-value default-name-var))
ogonek-name-encoding-alist nil t)))
- ;; change the default name to the one just read
- (set default-name-var
- (if (string= encoding "") (eval default-name-var) encoding))
+ ;; change the default name to the one just read, and
;; return the new default as the name you read
- (eval default-name-var)))
+ (set default-name-var
+ (if (string= encoding "") (symbol-value default-name-var) encoding))))
(defun ogonek-read-prefix (prompt default-prefix-var)
"Read a prefix character for prefix notation.
diff --git a/lisp/international/quail.el b/lisp/international/quail.el
index 036b80eb028..1bbbb174d49 100644
--- a/lisp/international/quail.el
+++ b/lisp/international/quail.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -569,9 +569,7 @@ While this input method is active, the variable
(setq describe-current-input-method-function nil)
(quail-hide-guidance)
(remove-hook 'post-command-hook 'quail-show-guidance t)
- (run-hooks
- 'quail-inactivate-hook ; for backward compatibility
- 'quail-deactivate-hook))
+ (run-hooks 'quail-deactivate-hook))
(kill-local-variable 'input-method-function))
;; Let's activate Quail input method.
(if (null quail-current-package)
@@ -2515,7 +2513,7 @@ package to describe."
(setq buffer-read-only nil)
;; Without this, a keyboard layout with R2L characters might be
;; displayed reversed, right to left. See the thread starting at
- ;; http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00062.html
+ ;; https://lists.gnu.org/r/emacs-devel/2012-03/msg00062.html
;; for a description of one such situation.
(setq bidi-paragraph-direction 'left-to-right)
(insert "Input method: " (quail-name)
@@ -3049,7 +3047,7 @@ of each directory."
(while quail-dirs
(setq dirname (car quail-dirs))
(when dirname
- (setq pkg-list (directory-files dirname 'full "\\.el$" 'nosort))
+ (setq pkg-list (directory-files dirname 'full "\\.el$"))
(while pkg-list
(message "Checking %s ..." (car pkg-list))
(with-temp-buffer
diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el
index 9b918547141..494de1d5a99 100644
--- a/lisp/international/rfc1843.el
+++ b/lisp/international/rfc1843.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -54,9 +54,7 @@ HZ-encoded are decoded."
"HZ+ decoding support if non-nil.
HZ+ specification (also known as HZP) is to provide a standardized
7-bit representation of mixed Big5, GB, and ASCII text for convenient
-e-mail transmission, news posting, etc.
-The document of HZ+ 0.78 specification can be found at
-ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
+e-mail transmission, news posting, etc."
:type 'boolean
:group 'mime)
diff --git a/lisp/international/robin.el b/lisp/international/robin.el
index 0ef90b18932..94d2bf18088 100644
--- a/lisp/international/robin.el
+++ b/lisp/international/robin.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -413,9 +413,7 @@ While this input method is active, the variable
(progn
(setq robin-mode nil)
(setq describe-current-input-method-function nil)
- (run-hooks
- 'robin-inactivate-hook ; for backward compatibility
- 'robin-deactivate-hook))
+ (run-hooks 'robin-deactivate-hook))
(kill-local-variable 'input-method-function))
;; activate robin input method.
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index 130bc742a51..5c6db19bb37 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -647,7 +647,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; details.
;;
;; You should have received a copy of the GNU General Public License along with
-;; CCE. If not, see <http://www.gnu.org/licenses/>.")
+;; CCE. If not, see <https://www.gnu.org/licenses/>.")
("chinese-ziranma" "$AWTH;(B"
"ziranma.cin" cn-gb-2312 "ZIRANMA.el"
@@ -675,7 +675,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; details.
;;
;; You should have received a copy of the GNU General Public License along with
-;; CCE. If not, see <http://www.gnu.org/licenses/>.")
+;; CCE. If not, see <https://www.gnu.org/licenses/>.")
("chinese-ctlau" "$AAuTA(B"
"CTLau.html" cn-gb-2312 "CTLau.el"
@@ -700,7 +700,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # GNU General Public License for more details.
;; #
;; # You should have received a copy of the GNU General Public License
-;; # along with this program. If not, see <http://www.gnu.org/licenses/>.")
+;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
("chinese-ctlaub" "$(0N,Gn(B"
"CTLau-b5.html" big5 "CTLau-b5.el"
@@ -725,7 +725,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"."
;; # GNU General Public License for more details.
;; #
;; # You should have received a copy of the GNU General Public License
-;; # along with this program. If not, see <http://www.gnu.org/licenses/>.")
+;; # along with this program. If not, see <https://www.gnu.org/licenses/>.")
))
;; Generate a code of a Quail package in the current buffer from Tsang
diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el
index b510fe1aec1..08231080f86 100644
--- a/lisp/international/ucs-normalize.el
+++ b/lisp/international/ucs-normalize.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el
index 16942ceceea..82f725cccbf 100644
--- a/lisp/international/utf-7.el
+++ b/lisp/international/utf-7.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -79,7 +79,7 @@ ESC and SKIP-CHARS are adjusted for the normal and IMAP versions."
(esc (if imap ?& ?+))
;; These are characters which can be encoded asis.
(skip-chars (if imap
- "\t\n\r\x20-\x25\x27-\x7e" ; rfc2060
+ "\t\n\r\x20-\x25\x27-\x7e" ; rfc2060
;; This includes the rfc2152 optional set.
;; Perhaps it shouldn't (like iconv).
"\t\n\r -*,-[]-}"))
diff --git a/lisp/international/utf7.el b/lisp/international/utf7.el
index f245d7eb696..68081b23a83 100644
--- a/lisp/international/utf7.el
+++ b/lisp/international/utf7.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 5f34dcadb5d..13fa97ea71f 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -128,9 +128,10 @@ a tab, a carriage return (control-M), a newline, and `]+'."
"If t incremental search/query-replace can match hidden text.
A nil value means don't match invisible text.
When the value is `open', if the text matched is made invisible by
-an overlay having an `invisible' property and that overlay has a property
-`isearch-open-invisible', then incremental search will show the contents.
-\(This applies when using `outline.el' and `hideshow.el'.)
+an overlay having a non-nil `invisible' property, and that overlay
+has a non-nil property `isearch-open-invisible', then incremental
+search will show the hidden text. (This applies when using `outline.el'
+and `hideshow.el'.)
To temporarily change the value for an active incremental search,
use \\<isearch-mode-map>\\[isearch-toggle-invisible].
diff --git a/lisp/isearchb.el b/lisp/isearchb.el
index 16a08dc9e45..86275f80f85 100644
--- a/lisp/isearchb.el
+++ b/lisp/isearchb.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 8537dae7f8b..33a941676db 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -602,7 +602,7 @@ non-nil in a repeated invocation of this function."
(save-restriction
;; Don't be blindsided by narrowing that starts in the middle
;; of a jit-lock-defer-multiline.
- (widen)
+ (widen)
(when (and (>= jit-lock-context-unfontify-pos (point-min))
(< jit-lock-context-unfontify-pos (point-max)))
;; If we're in text that matches a complex multi-line
diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el
index 0dedaa5ba0d..b1bdc278fe5 100644
--- a/lisp/jka-cmpr-hook.el
+++ b/lisp/jka-cmpr-hook.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 26a7cf506fd..07b9033e24e 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -252,7 +252,8 @@ There should be no more than seven characters after the final `/'."
"This routine will return the name of a new file."
(make-temp-file jka-compr-temp-name-template))
-(defun jka-compr-write-region (start end file &optional append visit)
+(defun jka-compr-write-region (start end file &optional
+ append visit lockname mustbenew)
(let* ((filename (expand-file-name file))
(visit-file (if (stringp visit) (expand-file-name visit) filename))
(info (jka-compr-get-compression-info visit-file))
@@ -334,7 +335,8 @@ There should be no more than seven characters after the final `/'."
(jka-compr-run-real-handler 'write-region
(list (point-min) (point-max)
filename
- (and append can-append) 'dont))
+ (and append can-append) 'dont
+ lockname mustbenew))
(erase-buffer)) )
(delete-file temp-file)
@@ -365,7 +367,8 @@ There should be no more than seven characters after the final `/'."
nil)
(jka-compr-run-real-handler 'write-region
- (list start end filename append visit)))))
+ (list start end filename append visit
+ lockname mustbenew)))))
(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
diff --git a/lisp/json.el b/lisp/json.el
index 3def94ce042..d5f05fed95f 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -187,30 +187,30 @@ Unlike `reverse', this keeps the property-value pairs intact."
;; Reader utilities
-(defsubst json-advance (&optional n)
+(define-inline json-advance (&optional n)
"Advance N characters forward."
- (forward-char n))
+ (inline-quote (forward-char ,n)))
-(defsubst json-peek ()
+(define-inline json-peek ()
"Return the character at point."
- (let ((char (char-after (point))))
- (or char :json-eof)))
+ (inline-quote (following-char)))
-(defsubst json-pop ()
+(define-inline json-pop ()
"Advance past the character at point, returning it."
- (let ((char (json-peek)))
- (if (eq char :json-eof)
- (signal 'json-end-of-file nil)
- (json-advance)
- char)))
-
-(defun json-skip-whitespace ()
+ (inline-quote
+ (let ((char (json-peek)))
+ (if (zerop char)
+ (signal 'json-end-of-file nil)
+ (json-advance)
+ char))))
+
+(define-inline json-skip-whitespace ()
"Skip past the whitespace at point."
;; See
;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
;; or https://tools.ietf.org/html/rfc7159#section-2 for the
;; definition of whitespace in JSON.
- (skip-chars-forward "\t\r\n "))
+ (inline-quote (skip-chars-forward "\t\r\n ")))
@@ -304,7 +304,8 @@ KEYWORD is the keyword expected."
(thing-at-point 'word)))))
(json-advance))
keyword)
- (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)")
+ (json-skip-whitespace)
+ (unless (looking-at "\\([],}]\\|$\\)")
(signal 'json-unknown-keyword
(list (save-excursion
(backward-word-strictly 1)
@@ -381,7 +382,7 @@ representation will be parsed correctly."
(special (cdr special))
((not (eq char ?u)) char)
;; Special-case UTF-16 surrogate pairs,
- ;; cf. https://tools.ietf.org/html/rfc7159#section-7. Note that
+ ;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that
;; this clause overlaps with the next one and therefore has to
;; come first.
((looking-at
@@ -407,6 +408,8 @@ representation will be parsed correctly."
(let ((characters '())
(char (json-peek)))
(while (not (= char ?\"))
+ (when (< char 32)
+ (signal 'json-string-format (list (prin1-char char))))
(push (if (= char ?\\)
(json-read-escaped-char)
(json-pop))
@@ -415,7 +418,7 @@ representation will be parsed correctly."
;; Skip over the '"'
(json-advance)
(if characters
- (apply 'string (nreverse characters))
+ (concat (nreverse characters))
"")))
;; String encoding
@@ -469,11 +472,10 @@ Returns the updated object, which you should save, e.g.:
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
(let ((json-key-type
- (if (eq json-key-type nil)
+ (or json-key-type
(cdr (assq json-object-type '((hash-table . string)
(alist . symbol)
- (plist . keyword))))
- json-key-type)))
+ (plist . keyword)))))))
(setq key
(cond ((eq json-key-type 'string)
key)
@@ -639,7 +641,9 @@ become JSON objects."
(signal 'json-error (list 'bleah)))))
;; Skip over the "]"
(json-advance)
- (apply json-array-type (nreverse elements))))
+ (pcase json-array-type
+ (`vector (nreverse (vconcat elements)))
+ (`list (nreverse elements)))))
;; Array encoding
@@ -666,31 +670,31 @@ become JSON objects."
;;; JSON reader.
-(defvar json-readtable
+(defmacro json-readtable-dispatch (char)
+ "Dispatch reader function for CHAR."
+ (declare (debug (symbolp)))
(let ((table
'((?t json-read-keyword "true")
(?f json-read-keyword "false")
(?n json-read-keyword "null")
(?{ json-read-object)
(?\[ json-read-array)
- (?\" json-read-string))))
- (mapc (lambda (char)
- (push (list char 'json-read-number) table))
- '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- table)
- "Readtable for JSON reader.")
+ (?\" json-read-string)))
+ res)
+ (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
+ (push (list c 'json-read-number) table))
+ (pcase-dolist (`(,c . ,rest) table)
+ (push `((eq ,char ,c) (,@rest)) res))
+ `(cond ,@res (t (signal 'json-readtable-error ,char)))))
(defun json-read ()
"Parse and return the JSON object following point.
Advances point just past JSON object."
(json-skip-whitespace)
(let ((char (json-peek)))
- (if (not (eq char :json-eof))
- (let ((record (cdr (assq char json-readtable))))
- (if (functionp (car record))
- (apply (car record) (cdr record))
- (signal 'json-readtable-error record)))
- (signal 'json-end-of-file nil))))
+ (if (zerop char)
+ (signal 'json-end-of-file nil)
+ (json-readtable-dispatch char))))
;; Syntactic sugar for the reader
diff --git a/lisp/kermit.el b/lisp/kermit.el
index f1900b48531..8863f2ed1a9 100644
--- a/lisp/kermit.el
+++ b/lisp/kermit.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/kmacro.el b/lisp/kmacro.el
index 838a492b6cb..da02ab5aca4 100644
--- a/lisp/kmacro.el
+++ b/lisp/kmacro.el
@@ -1,4 +1,4 @@
-;;; kmacro.el --- enhanced keyboard macros
+;;; kmacro.el --- enhanced keyboard macros -*- lexical-binding: t -*-
;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -111,6 +111,7 @@
;;; Code:
;; Customization:
+(require 'replace)
(defgroup kmacro nil
"Simplified keyboard macro user interface."
@@ -123,13 +124,11 @@
(defcustom kmacro-call-mouse-event 'S-mouse-3
"The mouse event used by kmacro to call a macro.
Set to nil if no mouse binding is desired."
- :type 'symbol
- :group 'kmacro)
+ :type 'symbol)
(defcustom kmacro-ring-max 8
"Maximum number of keyboard macros to save in macro ring."
- :type 'integer
- :group 'kmacro)
+ :type 'integer)
(defcustom kmacro-execute-before-append t
@@ -140,32 +139,27 @@ execute the macro.
Otherwise, a single \\[universal-argument] prefix does not execute the
macro, while more than one \\[universal-argument] prefix causes the
macro to be executed before appending to it."
- :type 'boolean
- :group 'kmacro)
+ :type 'boolean)
(defcustom kmacro-repeat-no-prefix t
"Allow repeating certain macro commands without entering the C-x C-k prefix."
- :type 'boolean
- :group 'kmacro)
+ :type 'boolean)
(defcustom kmacro-call-repeat-key t
"Allow repeating macro call using last key or a specific key."
:type '(choice (const :tag "Disabled" nil)
(const :tag "Last key" t)
(character :tag "Character" :value ?e)
- (symbol :tag "Key symbol" :value RET))
- :group 'kmacro)
+ (symbol :tag "Key symbol" :value RET)))
(defcustom kmacro-call-repeat-with-arg nil
"Repeat macro call with original arg when non-nil; repeat once if nil."
- :type 'boolean
- :group 'kmacro)
+ :type 'boolean)
(defcustom kmacro-step-edit-mini-window-height 0.75
"Override `max-mini-window-height' when step edit keyboard macro."
- :type 'number
- :group 'kmacro)
+ :type 'number)
;; Keymap
@@ -260,7 +254,7 @@ previous `kmacro-counter', and do not modify counter."
(if kmacro-initial-counter-value
(setq kmacro-counter kmacro-initial-counter-value
kmacro-initial-counter-value nil))
- (if (and arg (listp arg))
+ (if (consp arg)
(insert (format kmacro-counter-format kmacro-last-counter))
(insert (format kmacro-counter-format kmacro-counter))
(kmacro-add-counter (prefix-numeric-value arg))))
@@ -279,8 +273,8 @@ previous `kmacro-counter', and do not modify counter."
(defun kmacro-display-counter (&optional value)
"Display current counter value."
(unless value (setq value kmacro-counter))
- (message "New macro counter value: %s (%d)" (format kmacro-counter-format value) value))
-
+ (message "New macro counter value: %s (%d)"
+ (format kmacro-counter-format value) value))
(defun kmacro-set-counter (arg)
"Set `kmacro-counter' to ARG or prompt if missing.
@@ -565,7 +559,8 @@ Use \\[kmacro-insert-counter] to insert (and increment) the macro counter.
The counter value can be set or modified via \\[kmacro-set-counter] and \\[kmacro-add-counter].
The format of the counter can be modified via \\[kmacro-set-format].
-Use \\[kmacro-name-last-macro] to give it a permanent name.
+Use \\[kmacro-name-last-macro] to give it a name that will remain valid even
+after another macro is defined.
Use \\[kmacro-bind-to-key] to bind it to a key sequence."
(interactive "P")
(if (or defining-kbd-macro executing-kbd-macro)
@@ -628,8 +623,8 @@ just the last key in the key sequence that you used to call this
command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg'
for details on how to adjust or disable this behavior.
-To make a macro permanent so you can call it even after defining
-others, use \\[kmacro-name-last-macro]."
+To give a macro a name so you can call it even after defining others,
+use \\[kmacro-name-last-macro]."
(interactive "p")
(let ((repeat-key (and (or (and (null no-repeat)
(> (length (this-single-command-keys)) 1))
@@ -730,8 +725,8 @@ With \\[universal-argument], call second macro in macro ring."
With numeric prefix ARG, repeat macro that many times.
Zero argument means repeat until there is an error.
-To give a macro a permanent name, so you can call it
-even after defining other macros, use \\[kmacro-name-last-macro]."
+To give a macro a name, so you can call it even after defining other
+macros, use \\[kmacro-name-last-macro]."
(interactive "P")
(if defining-kbd-macro
(kmacro-end-macro nil))
@@ -772,19 +767,18 @@ If kbd macro currently being defined end it before activating it."
(defun kmacro-extract-lambda (mac)
"Extract kmacro from a kmacro lambda form."
- (and (consp mac)
- (eq (car mac) 'lambda)
+ (and (eq (car-safe mac) 'lambda)
(setq mac (assoc 'kmacro-exec-ring-item mac))
- (consp (cdr mac))
- (consp (car (cdr mac)))
- (consp (cdr (car (cdr mac))))
- (setq mac (car (cdr (car (cdr mac)))))
+ (setq mac (car-safe (cdr-safe (car-safe (cdr-safe mac)))))
(listp mac)
(= (length mac) 3)
(arrayp (car mac))
mac))
+(defalias 'kmacro-p #'kmacro-extract-lambda
+ "Return non-nil if MAC is a kmacro keyboard macro.")
+
(defun kmacro-bind-to-key (_arg)
"When not defining or executing a macro, offer to bind last macro to a key.
The key sequences [C-x C-k 0] through [C-x C-k 9] and [C-x C-k A]
@@ -825,6 +819,13 @@ The ARG parameter is unused."
(kmacro-lambda-form (kmacro-ring-head)))
(message "Keyboard macro bound to %s" (format-kbd-macro key-seq))))))
+(defun kmacro-keyboard-macro-p (symbol)
+ "Return non-nil if SYMBOL is the name of some sort of keyboard macro."
+ (let ((f (symbol-function symbol)))
+ (when f
+ (or (stringp f)
+ (vectorp f)
+ (kmacro-p f)))))
(defun kmacro-name-last-macro (symbol)
"Assign a name to the last keyboard macro defined.
@@ -835,14 +836,18 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command
(or last-kbd-macro
(error "No keyboard macro defined"))
(and (fboundp symbol)
- (not (get symbol 'kmacro))
- (not (stringp (symbol-function symbol)))
- (not (vectorp (symbol-function symbol)))
+ (not (kmacro-keyboard-macro-p symbol))
(error "Function %s is already defined and not a keyboard macro"
symbol))
(if (string-equal symbol "")
(error "No command name given"))
+ ;; FIXME: Use plain old `last-kbd-macro' for kmacros where it doesn't
+ ;; make a difference?
(fset symbol (kmacro-lambda-form (kmacro-ring-head)))
+ ;; This used to be used to detect when a symbol corresponds to a kmacro.
+ ;; Nowadays it's unused because we used `kmacro-p' instead to see if the
+ ;; symbol's function definition matches that of a kmacro, which is more
+ ;; reliable.
(put symbol 'kmacro t))
@@ -936,7 +941,7 @@ without repeating the prefix."
;;; Single-step editing of keyboard macros
-(defvar kmacro-step-edit-active) ;; step-editing active
+(defvar kmacro-step-edit-active nil) ;; step-editing active
(defvar kmacro-step-edit-new-macro) ;; storage for new macro
(defvar kmacro-step-edit-inserting) ;; inserting into macro
(defvar kmacro-step-edit-appending) ;; append to end of macro
@@ -1201,7 +1206,7 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq kmacro-step-edit-key-index next-index)))
(defun kmacro-step-edit-pre-command ()
- (remove-hook 'post-command-hook 'kmacro-step-edit-post-command)
+ (remove-hook 'post-command-hook #'kmacro-step-edit-post-command)
(when kmacro-step-edit-active
(cond
((eq kmacro-step-edit-active 'ignore)
@@ -1221,17 +1226,17 @@ following additional answers: `insert', `insert-1', `replace', `replace-1',
(setq kmacro-step-edit-appending nil
kmacro-step-edit-active 'ignore)))))
(when (eq kmacro-step-edit-active t)
- (add-hook 'post-command-hook 'kmacro-step-edit-post-command t)))
+ (add-hook 'post-command-hook #'kmacro-step-edit-post-command t)))
(defun kmacro-step-edit-minibuf-setup ()
- (remove-hook 'pre-command-hook 'kmacro-step-edit-pre-command t)
+ (remove-hook 'pre-command-hook #'kmacro-step-edit-pre-command t)
(when kmacro-step-edit-active
- (add-hook 'pre-command-hook 'kmacro-step-edit-pre-command nil t)))
+ (add-hook 'pre-command-hook #'kmacro-step-edit-pre-command nil t)))
(defun kmacro-step-edit-post-command ()
- (remove-hook 'pre-command-hook 'kmacro-step-edit-pre-command)
+ (remove-hook 'pre-command-hook #'kmacro-step-edit-pre-command)
(when kmacro-step-edit-active
- (add-hook 'pre-command-hook 'kmacro-step-edit-pre-command nil nil)
+ (add-hook 'pre-command-hook #'kmacro-step-edit-pre-command nil nil)
(if kmacro-step-edit-key-index
(setq executing-kbd-macro-index kmacro-step-edit-key-index)
(setq kmacro-step-edit-key-index executing-kbd-macro-index))))
@@ -1254,9 +1259,9 @@ To customize possible responses, change the \"bindings\" in `kmacro-step-edit-ma
(pre-command-hook pre-command-hook)
(post-command-hook post-command-hook)
(minibuffer-setup-hook minibuffer-setup-hook))
- (add-hook 'pre-command-hook 'kmacro-step-edit-pre-command nil)
- (add-hook 'post-command-hook 'kmacro-step-edit-post-command t)
- (add-hook 'minibuffer-setup-hook 'kmacro-step-edit-minibuf-setup t)
+ (add-hook 'pre-command-hook #'kmacro-step-edit-pre-command nil)
+ (add-hook 'post-command-hook #'kmacro-step-edit-post-command t)
+ (add-hook 'minibuffer-setup-hook #'kmacro-step-edit-minibuf-setup t)
(call-last-kbd-macro nil nil)
(when (and kmacro-step-edit-replace
kmacro-step-edit-new-macro
diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el
index 420e8d74919..25425ec4858 100644
--- a/lisp/language/burmese.el
+++ b/lisp/language/burmese.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -56,4 +56,3 @@
(vector "." 0 'font-shape-gstring))))
(set-char-table-range composition-function-table '(#x1000 . #x107F) elt)
(set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt))
-
diff --git a/lisp/language/cham.el b/lisp/language/cham.el
index a025ff0d209..4749f2e8db4 100644
--- a/lisp/language/cham.el
+++ b/lisp/language/cham.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el
index 955c2999b8c..f5174fb5e93 100644
--- a/lisp/language/china-util.el
+++ b/lisp/language/china-util.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el
index a412838af73..9ba178d7239 100644
--- a/lisp/language/chinese.el
+++ b/lisp/language/chinese.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el
index a96f2fb0475..7644064c5a0 100644
--- a/lisp/language/cyril-util.el
+++ b/lisp/language/cyril-util.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el
index 1e47057e9b5..ba985a4754f 100644
--- a/lisp/language/cyrillic.el
+++ b/lisp/language/cyrillic.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/czech.el b/lisp/language/czech.el
index 0ebf2cb7bde..21213c65fd5 100644
--- a/lisp/language/czech.el
+++ b/lisp/language/czech.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/english.el b/lisp/language/english.el
index fefb24171a0..3e8f3123c3f 100644
--- a/lisp/language/english.el
+++ b/lisp/language/english.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 4d7ccd12692..cdf41ba909e 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 3e71d437bdd..f0bb049fdbb 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Author: TAKAHASHI Naoto <ntakahas@m17n.org>
diff --git a/lisp/language/european.el b/lisp/language/european.el
index 6c0232efd3b..d9ce05c24ae 100644
--- a/lisp/language/european.el
+++ b/lisp/language/european.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el
index 14e35108445..43718092959 100644
--- a/lisp/language/georgian.el
+++ b/lisp/language/georgian.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/greek.el b/lisp/language/greek.el
index 357f0633a69..1a401480642 100644
--- a/lisp/language/greek.el
+++ b/lisp/language/greek.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el
index 200ae896b05..6af47982bae 100644
--- a/lisp/language/hanja-util.el
+++ b/lisp/language/hanja-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el
index 4e33fb63bca..9e049de8b5f 100644
--- a/lisp/language/hebrew.el
+++ b/lisp/language/hebrew.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 930cba1bd91..fc8f4c9d983 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/indian.el b/lisp/language/indian.el
index c84c8fede6c..0bb123e1899 100644
--- a/lisp/language/indian.el
+++ b/lisp/language/indian.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -116,7 +116,7 @@ South Indian Language Telugu is supported in this language environment."))
(sample-text . "Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ")
(documentation . "\
Kannada language and script is supported in this language
-environment."))
+environment."))
'("Indian"))
(set-language-info-alist
@@ -140,7 +140,7 @@ South Indian language Malayalam is supported in this language environment."))
(defconst devanagari-composable-pattern
(let ((table
'(("a" . "[\u0900-\u0902]") ; vowel modifier (above)
- ("A" . "\u0903") ; vowel modifier (post)
+ ("A" . "\u0903") ; vowel modifier (post)
("V" . "[\u0904-\u0914\u0960-\u0961\u0972]") ; independent vowel
("C" . "[\u0915-\u0939\u0958-\u095F\u0979-\u097F]") ; consonant
("R" . "\u0930") ; RA
@@ -347,7 +347,7 @@ South Indian language Malayalam is supported in this language environment."))
(let ((table
'(("A" . "[\u0D02-\u0D03]") ; SIGN ANUSVARA .. VISARGA
("V" . "[\u0D05-\u0D14\u0D60-\u0D61]") ; independent vowel
- ("C" . "[\u0D15-\u0D39]") ; consonant
+ ("C" . "[\u0D15-\u0D39]") ; consonant
("Y" . "[\u0D2F-\u0D30\u0D32\u0D35]") ; YA, RA, LA, VA
("v" . "[\u0D3E-\u0D4C\u0D57\u0D62-\u0D63]") ; postbase matra
("H" . "\u0D4D") ; SIGN VIRAMA
diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el
index 01cdd8bef9e..988b925409e 100644
--- a/lisp/language/japan-util.el
+++ b/lisp/language/japan-util.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index 4203c4cc940..57147f62e33 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -185,7 +185,7 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
"Shift_JIS 8-bit encoding for Japanese (MIME:SHIFT_JIS-2004)"
:coding-type 'shift-jis
:mnemonic ?S
- :charset-list '(ascii katakana-jisx0201
+ :charset-list '(ascii katakana-jisx0201
japanese-jisx0213.2004-1 japanese-jisx0213-2))
(define-coding-system-alias 'shift_jis-2004 'japanese-shift-jis-2004)
@@ -197,15 +197,15 @@ eucJP-ms is defined in <http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(tutorial . "TUTORIAL.ja")
(charset japanese-jisx0208
japanese-jisx0212 latin-jisx0201 katakana-jisx0201
- japanese-jisx0213.2004-1 japanese-jisx0213-1
+ japanese-jisx0213.2004-1 japanese-jisx0213-1
japanese-jisx0213-2 japanese-jisx0208-1978)
(coding-system iso-2022-jp japanese-iso-8bit
japanese-shift-jis japanese-iso-7bit-1978-irv
iso-2022-jp-2004 japanese-shift-jis-2004
euc-jis-2004)
(coding-priority iso-2022-jp japanese-iso-8bit
- japanese-shift-jis
- iso-2022-jp-2004 euc-jis-2004
+ japanese-shift-jis
+ iso-2022-jp-2004 euc-jis-2004
japanese-shift-jis-2004
iso-2022-jp-2)
(input-method . "japanese")
diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el
index 8663ff22ca0..4a070321961 100644
--- a/lisp/language/khmer.el
+++ b/lisp/language/khmer.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el
index 12bb1e10bd3..c49e627ea9b 100644
--- a/lisp/language/korea-util.el
+++ b/lisp/language/korea-util.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/korean.el b/lisp/language/korean.el
index a8a30110c79..52560d6fb4d 100644
--- a/lisp/language/korean.el
+++ b/lisp/language/korean.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index 28b2043ed51..94504ff9ba6 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/lao.el b/lisp/language/lao.el
index 03519c9beec..266c3c634f7 100644
--- a/lisp/language/lao.el
+++ b/lisp/language/lao.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index c03fd429fe9..c1aa79cae45 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -75,12 +75,71 @@ and Italian.")))
(sample-text . "Persian فارسی")
(documentation . "Bidirectional editing is supported.")))
+(defcustom arabic-shaper-ZWNJ-handling nil
+ "How to handle ZWMJ in Arabic text rendering.
+This variable controls the way to handle a glyph for ZWNJ
+returned by the underling shaping engine.
+
+The default value is nil, which means that the ZWNJ glyph is
+displayed as is.
+
+If the value is `absorb', ZWNJ is absorbed into the previous
+grapheme cluster, and not displayed.
+
+If the value is `as-space', the glyph is displayed by a
+thin (i.e. 1-dot width) space."
+ :group 'mule
+ :version "26.1"
+ :type '(choice
+ (const :tag "default" nil)
+ (const :tag "as space" as-space)
+ (const :tag "absorb" absorb))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (clear-composition-cache)))
+
+;; Record error in arabic-change-gstring.
+(defvar arabic-shape-log nil)
+
+(defun arabic-shape-gstring (gstring)
+ (setq gstring (font-shape-gstring gstring))
+ (condition-case err
+ (when arabic-shaper-ZWNJ-handling
+ (let ((font (lgstring-font gstring))
+ (i 1)
+ (len (lgstring-glyph-len gstring))
+ (modified nil))
+ (while (< i len)
+ (let ((glyph (lgstring-glyph gstring i)))
+ (when (eq (lglyph-char glyph) #x200c)
+ (cond
+ ((eq arabic-shaper-ZWNJ-handling 'as-space)
+ (if (> (- (lglyph-rbearing glyph) (lglyph-lbearing glyph)) 0)
+ (let ((space-glyph (aref (font-get-glyphs font 0 1 " ") 0)))
+ (when space-glyph
+ (lglyph-set-code glyph (aref space-glyph 3))
+ (lglyph-set-width glyph (aref space-glyph 4)))))
+ (lglyph-set-adjustment glyph 0 0 1)
+ (setq modified t))
+ ((eq arabic-shaper-ZWNJ-handling 'absorb)
+ (let ((prev (lgstring-glyph gstring (1- i))))
+ (lglyph-set-from-to prev (lglyph-from prev) (lglyph-to glyph))
+ (setq gstring (lgstring-remove-glyph gstring i))
+ (setq len (1- len)))
+ (setq modified t)))))
+ (setq i (1+ i)))
+ (if modified
+ (lgstring-set-id gstring nil))))
+ (error (push err arabic-shape-log)))
+ gstring)
+
(set-char-table-range
composition-function-table
'(#x600 . #x74F)
- (list (vector "[\u0600-\u074F\u200C\u200D]+" 0 'font-shape-gstring)
- (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+"
- 1 'font-shape-gstring)))
+ (list (vector "[\u0600-\u074F\u200C\u200D]+" 0
+ 'arabic-shape-gstring)
+ (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+" 1
+ 'arabic-shape-gstring)))
(provide 'misc-lang)
diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el
index 421ddcdd1ac..00deb698848 100644
--- a/lisp/language/romanian.el
+++ b/lisp/language/romanian.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el
index 037d753f52a..efd8aacc5ac 100644
--- a/lisp/language/sinhala.el
+++ b/lisp/language/sinhala.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -30,7 +30,7 @@
(sample-text . "Sinhala (සිංහල) ආයුබෝවන්")
(documentation . t)))
-(set-char-table-range
+(set-char-table-range
composition-function-table
'(#xD80 . #xDFF)
(list (vector
diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el
index 6c729424d2f..9682722e6ee 100644
--- a/lisp/language/slovak.el
+++ b/lisp/language/slovak.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el
index f4074ae2714..3c589106254 100644
--- a/lisp/language/tai-viet.el
+++ b/lisp/language/tai-viet.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el
index db421ebd5a6..c8c844fbe25 100644
--- a/lisp/language/thai-util.el
+++ b/lisp/language/thai-util.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el
index d3c00f9ac36..e67dd093430 100644
--- a/lisp/language/thai-word.el
+++ b/lisp/language/thai-word.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; The used Thai word list has been taken from IBM's ICU4J project
;; (file `thai6.ucs', version 1.4, converted to TIS encoding, with
diff --git a/lisp/language/thai.el b/lisp/language/thai.el
index 4d199842bcd..945ea31c8d7 100644
--- a/lisp/language/thai.el
+++ b/lisp/language/thai.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 624da5c6d2c..f3648c9b204 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; History:
;; 1997.03.13 Modification in treatment of text properties;
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index f24e3b373fc..962dd2bee5b 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; History:
diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el
index ba1ee668825..a667956a060 100644
--- a/lisp/language/tv-util.el
+++ b/lisp/language/tv-util.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code
@@ -72,7 +72,7 @@
(tone-rule '(tr . bl))
(prev-viet nil)
ch info pos components overhang)
- (while (< from to)
+ (while (< from to)
(or ch
(setq ch (char-after from)
info (aref tai-viet-glyph-info ch)))
@@ -138,4 +138,3 @@
;;
(provide 'tai-viet-util)
-
diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el
index 40aec43d7eb..4156bf5766b 100644
--- a/lisp/language/utf-8-lang.el
+++ b/lisp/language/utf-8-lang.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el
index ca670d80ff0..f1946f6b69f 100644
--- a/lisp/language/viet-util.el
+++ b/lisp/language/viet-util.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el
index cd36580d768..c170216062d 100644
--- a/lisp/language/vietnamese.el
+++ b/lisp/language/vietnamese.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index ae28ba93e61..b1f582c4044 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1102,6 +1102,15 @@ options only, i.e. behave like `apropos-user-option'.
\(fn PATTERN &optional DO-NOT-ALL)" t nil)
+(autoload 'apropos-local-variable "apropos" "\
+Show buffer-local variables that match PATTERN.
+Optional arg BUFFER (default: current buffer) is the buffer to check.
+
+The output includes variables that are not yet set in BUFFER, but that
+will be buffer-local when set.
+
+\(fn PATTERN &optional BUFFER)" t nil)
+
(defalias 'command-apropos 'apropos-command)
(autoload 'apropos-command "apropos" "\
@@ -1167,6 +1176,13 @@ Returns list of symbols and values found.
\(fn PATTERN &optional DO-ALL)" t nil)
+(autoload 'apropos-local-value "apropos" "\
+Show buffer-local variables whose values match PATTERN.
+This is like `apropos-value', but only for buffer-local variables.
+Optional arg BUFFER (default: current buffer) is the buffer to check.
+
+\(fn PATTERN &optional BUFFER)" t nil)
+
(autoload 'apropos-documentation "apropos" "\
Show symbols whose documentation contains matches for PATTERN.
PATTERN can be a word, a list of words (separated by spaces),
@@ -2878,6 +2894,8 @@ columns on its right towards the left.
(put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format)))))
+(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
+
(autoload 'bug-reference-mode "bug-reference" "\
Toggle hyperlinking bug references in the buffer (Bug Reference mode).
With a prefix argument ARG, enable Bug Reference mode if ARG is
@@ -3840,7 +3858,7 @@ Key bindings:
\(fn)" t nil)
(autoload 'c-or-c++-mode "cc-mode" "\
-Analyse buffer and enable either C or C++ mode.
+Analyze buffer and enable either C or C++ mode.
Some people and projects use .h extension for C++ header files
which is also the one used for C header files. This makes
@@ -4943,16 +4961,20 @@ call other entry points instead, such as `cl-prin1'.
\(fn OBJECT STREAM)" nil nil)
(autoload 'cl-prin1 "cl-print" "\
-
+Print OBJECT on STREAM according to its type.
+Output is further controlled by the variables
+`cl-print-readably', `cl-print-compiled', along with output
+variables for the standard printing functions. See Info
+node `(elisp)Output Variables'.
\(fn OBJECT &optional STREAM)" nil nil)
(autoload 'cl-prin1-to-string "cl-print" "\
-
+Return a string containing the `cl-prin1'-printed representation of OBJECT.
\(fn OBJECT)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "cl-print" '("cl-print-" "help-byte-code")))
;;;***
@@ -5014,7 +5036,7 @@ is run).
(autoload 'color-name-to-rgb "color" "\
Convert COLOR string to a list of normalized RGB components.
COLOR should be a color name (e.g. \"white\") or an RGB triplet
-string (e.g. \"#ff12ec\").
+string (e.g. \"#ffff1122eecc\").
Normally the return value is a list of three floating-point
numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive.
@@ -5426,16 +5448,7 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode',
(autoload 'conf-unix-mode "conf-mode" "\
Conf Mode starter for Unix style Conf files.
-Comments start with `#'.
-For details see `conf-mode'. Example:
-
-# Conf mode font-locks this right on Unix and with \\[conf-unix-mode]
-
-\[Desktop Entry]
- Encoding=UTF-8
- Name=The GIMP
- Name[ca]=El GIMP
- Name[cs]=GIMP
+Comments start with `#'. For details see `conf-mode'.
\(fn)" t nil)
@@ -5541,6 +5554,32 @@ For details see `conf-mode'. Example:
\(fn)" t nil)
+(autoload 'conf-toml-mode "conf-mode" "\
+Conf Mode starter for TOML files.
+Comments start with `#' and \"assignments\" are with `='.
+For details see `conf-mode'. Example:
+
+# Conf mode font-locks this right with \\[conf-toml-mode]
+
+\[entry]
+value = \"some string\"
+
+\(fn)" t nil)
+
+(autoload 'conf-desktop-mode "conf-mode" "\
+Conf Mode started for freedesktop.org Desktop files.
+Comments start with `#' and \"assignments\" are with `='.
+For details see `conf-mode'.
+
+# Conf mode font-locks this correctly with \\[conf-desktop-mode]
+ [Desktop Entry]
+ Name=GNU Image Manipulation Program
+ Name[oc]=Editor d'imatge GIMP
+ Exec=gimp-2.8 %U
+ Terminal=false
+
+\(fn)" t nil)
+
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "conf-mode" '("conf-")))
;;;***
@@ -6812,9 +6851,12 @@ or call the function `delete-selection-mode'.")
(autoload 'delete-selection-mode "delsel" "\
Toggle Delete Selection mode.
-With a prefix argument ARG, enable Delete Selection mode if ARG
-is positive, and disable it otherwise. If called from Lisp,
-enable the mode if ARG is omitted or nil.
+Interactively, with a prefix argument, enable
+Delete Selection mode if the prefix argument is positive,
+and disable it otherwise. If called from Lisp, toggle
+the mode if ARG is `toggle', disable the mode if ARG is
+a non-positive integer, and enable the mode otherwise
+\(including if ARG is omitted or nil or a positive integer).
When Delete Selection mode is enabled, typed text replaces the selection
if the selection is active. Otherwise, typed text is just inserted at
@@ -7374,7 +7416,7 @@ May contain all other options that don't contradict `-l';
may contain even `F', `b', `i' and `s'. See also the variable
`dired-ls-F-marks-symlinks' concerning the `F' switch.
Options that include embedded whitespace must be quoted
-like this: \\\"--option=value with spaces\\\"; you can use
+like this: \"--option=value with spaces\"; you can use
`combine-and-quote-strings' to produce the correct quoting of
each option.
On systems such as MS-DOS and MS-Windows, which use `ls' emulation in Lisp,
@@ -7684,6 +7726,46 @@ in `.emacs'.
;;;***
+;;;### (autoloads nil "display-line-numbers" "display-line-numbers.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from display-line-numbers.el
+
+(autoload 'display-line-numbers-mode "display-line-numbers" "\
+Toggle display of line numbers in the buffer.
+This uses `display-line-numbers' internally.
+
+To change the type of line numbers displayed by default,
+customize `display-line-numbers-type'. To change the type while
+the mode is on, set `display-line-numbers' directly.
+
+\(fn &optional ARG)" t nil)
+
+(defvar global-display-line-numbers-mode nil "\
+Non-nil if Global Display-Line-Numbers mode is enabled.
+See the `global-display-line-numbers-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `global-display-line-numbers-mode'.")
+
+(custom-autoload 'global-display-line-numbers-mode "display-line-numbers" nil)
+
+(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.
+
+Display-Line-Numbers mode is enabled in all buffers where
+`display-line-numbers--turn-on' would do it.
+See `display-line-numbers-mode' for more information on Display-Line-Numbers mode.
+
+\(fn &optional ARG)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-")))
+
+;;;***
+
;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0))
;;; Generated autoloads from play/dissociate.el
@@ -8017,12 +8099,16 @@ the constant's documentation.
\(fn M BS DOC &rest ARGS)" nil t)
+(function-put 'easy-mmode-defmap 'lisp-indent-function '1)
+
(autoload 'easy-mmode-defsyntax "easy-mmode" "\
Define variable ST as a syntax-table.
CSS contains a list of syntax specifications of the form (CHAR . SYNTAX).
\(fn ST CSS DOC &rest ARGS)" nil t)
+(function-put 'easy-mmode-defsyntax 'lisp-indent-function '1)
+
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "easy-mmode" '("easy-mmode-")))
;;;***
@@ -8251,7 +8337,7 @@ See also `ebnf-print-buffer'.
(autoload 'ebnf-print-buffer "ebnf2ps" "\
Generate and print a PostScript syntactic chart image of the buffer.
-When called with a numeric prefix argument (C-u), prompts the user for
+When called with a numeric prefix argument (\\[universal-argument]), prompts the user for
the name of a file to save the PostScript image in, instead of sending
it to the printer.
@@ -8373,7 +8459,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing
\(fn FROM TO)" t nil)
-(defalias 'ebnf-despool 'ps-despool)
+(defalias 'ebnf-despool #'ps-despool)
(autoload 'ebnf-syntax-directory "ebnf2ps" "\
Do a syntactic analysis of the files in DIRECTORY.
@@ -9068,11 +9154,15 @@ Toggle edebugging of all forms.
(autoload 'ediff-files "ediff" "\
Run Ediff on a pair of files, FILE-A and FILE-B.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn FILE-A FILE-B &optional STARTUP-HOOKS)" t nil)
(autoload 'ediff-files3 "ediff" "\
Run Ediff on three files, FILE-A, FILE-B, and FILE-C.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn FILE-A FILE-B FILE-C &optional STARTUP-HOOKS)" t nil)
@@ -9096,6 +9186,13 @@ If this file is a backup, `ediff' it with its original.
(autoload 'ediff-buffers "ediff" "\
Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. JOB-NAME is a
+symbol describing the Ediff job type; it defaults to
+`ediff-buffers', but can also be one of
+`ediff-merge-files-with-ancestor', `ediff-last-dir-ancestor',
+`ediff-last-dir-C', `ediff-buffers3', `ediff-merge-buffers', or
+`ediff-merge-buffers-with-ancestor'.
\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME)" t nil)
@@ -9103,6 +9200,13 @@ Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B.
(autoload 'ediff-buffers3 "ediff" "\
Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. JOB-NAME is a
+symbol describing the Ediff job type; it defaults to
+`ediff-buffers3', but can also be one of
+`ediff-merge-files-with-ancestor', `ediff-last-dir-ancestor',
+`ediff-last-dir-C', `ediff-buffers', `ediff-merge-buffers', or
+`ediff-merge-buffers-with-ancestor'.
\(fn BUFFER-A BUFFER-B BUFFER-C &optional STARTUP-HOOKS JOB-NAME)" t nil)
@@ -9139,6 +9243,7 @@ regular expression; only file names that match the regexp are considered.
Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
the same name in both. The third argument, REGEXP, is nil or a regular
expression; only file names that match the regexp are considered.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
\(fn DIR1 DIR2 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
@@ -9150,6 +9255,7 @@ Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge
without ancestor. The fourth argument, REGEXP, is nil or a regular expression;
only file names that match the regexp are considered.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
\(fn DIR1 DIR2 ANCESTOR-DIR REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
@@ -9157,6 +9263,7 @@ only file names that match the regexp are considered.
Run Ediff on a directory, DIR1, merging its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
@@ -9166,6 +9273,7 @@ names. Only the files that are under revision control are taken into account.
Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors.
The second argument, REGEXP, is a regular expression that filters the file
names. Only the files that are under revision control are taken into account.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files.
\(fn DIR1 REGEXP &optional MERGE-AUTOSTORE-DIR)" t nil)
@@ -9179,6 +9287,8 @@ With prefix argument, DUMB-MODE, or on a non-windowing display, works as
follows:
If WIND-A is nil, use selected window.
If WIND-B is nil, use window next to WIND-A.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
@@ -9188,23 +9298,31 @@ With prefix argument, DUMB-MODE, or on a non-windowing display, works as
follows:
If WIND-A is nil, use selected window.
If WIND-B is nil, use window next to WIND-A.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn DUMB-MODE &optional WIND-A WIND-B STARTUP-HOOKS)" t nil)
(autoload 'ediff-regions-wordwise "ediff" "\
Run Ediff on a pair of regions in specified buffers.
+BUFFER-A and BUFFER-B are the buffers to be compared.
Regions (i.e., point and mark) can be set in advance or marked interactively.
This function is effective only for relatively small regions, up to 200
lines. For large regions, use `ediff-regions-linewise'.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
(autoload 'ediff-regions-linewise "ediff" "\
Run Ediff on a pair of regions in specified buffers.
+BUFFER-A and BUFFER-B are the buffers to be compared.
Regions (i.e., point and mark) can be set in advance or marked interactively.
Each region is enlarged to contain full lines.
This function is effective for large regions, over 100-200
lines. For small regions, use `ediff-regions-wordwise'.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS)" t nil)
@@ -9212,11 +9330,20 @@ lines. For small regions, use `ediff-regions-wordwise'.
(autoload 'ediff-merge-files "ediff" "\
Merge two files without ancestor.
+FILE-A and FILE-B are the names of the files to be merged.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. MERGE-BUFFER-FILE
+is the name of the file to be associated with the merge buffer..
\(fn FILE-A FILE-B &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-files-with-ancestor "ediff" "\
Merge two files with ancestor.
+FILE-A and FILE-B are the names of the files to be merged, and
+FILE-ANCESTOR is the name of the ancestor file. STARTUP-HOOKS is
+a list of functions that Emacs calls without arguments after
+setting up the Ediff buffers. MERGE-BUFFER-FILE is the name of
+the file to be associated with the merge buffer.
\(fn FILE-A FILE-B FILE-ANCESTOR &optional STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
@@ -9224,25 +9351,49 @@ Merge two files with ancestor.
(autoload 'ediff-merge-buffers "ediff" "\
Merge buffers without ancestor.
+BUFFER-A and BUFFER-B are the buffers to be merged.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. JOB-NAME is a
+symbol describing the Ediff job type; it defaults to
+`ediff-merge-buffers', but can also be one of
+`ediff-merge-files-with-ancestor', `ediff-last-dir-ancestor',
+`ediff-last-dir-C', `ediff-buffers', `ediff-buffers3', or
+`ediff-merge-buffers-with-ancestor'. MERGE-BUFFER-FILE is the
+name of the file to be associated with the merge buffer.
\(fn BUFFER-A BUFFER-B &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-buffers-with-ancestor "ediff" "\
Merge buffers with ancestor.
+BUFFER-A and BUFFER-B are the buffers to be merged, and
+BUFFER-ANCESTOR is their ancestor. STARTUP-HOOKS is a list of
+functions that Emacs calls without arguments after setting up the
+Ediff buffers. JOB-NAME is a symbol describing the Ediff job
+type; it defaults to `ediff-merge-buffers-with-ancestor', but can
+also be one of `ediff-merge-files-with-ancestor',
+`ediff-last-dir-ancestor', `ediff-last-dir-C', `ediff-buffers',
+`ediff-buffers3', or `ediff-merge-buffers'. MERGE-BUFFER-FILE is
+the name of the file to be associated with the merge buffer.
\(fn BUFFER-A BUFFER-B BUFFER-ANCESTOR &optional STARTUP-HOOKS JOB-NAME MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-revisions "ediff" "\
Run Ediff by merging two revisions of a file.
-The file is the optional FILE argument or the file visited by the current
-buffer.
+The file is the optional FILE argument or the file visited by the
+current buffer. STARTUP-HOOKS is a list of functions that Emacs
+calls without arguments after setting up the Ediff buffers.
+MERGE-BUFFER-FILE is the name of the file to be associated with
+the merge buffer.
\(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
(autoload 'ediff-merge-revisions-with-ancestor "ediff" "\
Run Ediff by merging two revisions of a file with a common ancestor.
-The file is the optional FILE argument or the file visited by the current
-buffer.
+The file is the optional FILE argument or the file visited by the
+current buffer. STARTUP-HOOKS is a list of functions that Emacs
+calls without arguments after setting up the Ediff buffers.
+MERGE-BUFFER-FILE is the name of the file to be associated with
+the merge buffer.
\(fn &optional FILE STARTUP-HOOKS MERGE-BUFFER-FILE)" t nil)
@@ -9250,8 +9401,8 @@ buffer.
Query for a file name, and then run Ediff by patching that file.
If optional PATCH-BUF is given, use the patch in that buffer
and don't ask the user.
-If prefix argument, then: if even argument, assume that the patch is in a
-buffer. If odd -- assume it is in a file.
+If prefix argument ARG, then: if even argument, assume that the
+patch is in a buffer. If odd -- assume it is in a file.
\(fn &optional ARG PATCH-BUF)" t nil)
@@ -9262,7 +9413,7 @@ prompts for the buffer or a file, depending on the answer.
With ARG=1, assumes the patch is in a file and prompts for the file.
With ARG=2, assumes the patch is in a buffer and prompts for the buffer.
PATCH-BUF is an optional argument, which specifies the buffer that contains the
-patch. If not given, the user is prompted according to the prefix argument.
+patch. If not given, the user is prompted according to the prefix argument.
\(fn &optional ARG PATCH-BUF)" t nil)
@@ -9275,6 +9426,8 @@ Run Ediff by comparing versions of a file.
The file is an optional FILE argument or the file entered at the prompt.
Default: the file visited by the current buffer.
Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers.
\(fn &optional FILE STARTUP-HOOKS)" t nil)
@@ -9293,42 +9446,42 @@ With optional NODE, goes to that node.
\(fn &optional NODE)" t nil)
(autoload 'ediff-files-command "ediff" "\
-
+Call `ediff-files' with the next two command line arguments.
\(fn)" nil nil)
(autoload 'ediff3-files-command "ediff" "\
-
+Call `ediff3-files' with the next three command line arguments.
\(fn)" nil nil)
(autoload 'ediff-merge-command "ediff" "\
-
+Call `ediff-merge-files' with the next two command line arguments.
\(fn)" nil nil)
(autoload 'ediff-merge-with-ancestor-command "ediff" "\
-
+Call `ediff-merge-files-with-ancestor' with the next three command line arguments.
\(fn)" nil nil)
(autoload 'ediff-directories-command "ediff" "\
-
+Call `ediff-directories' with the next three command line arguments.
\(fn)" nil nil)
(autoload 'ediff-directories3-command "ediff" "\
-
+Call `ediff-directories3' with the next four command line arguments.
\(fn)" nil nil)
(autoload 'ediff-merge-directories-command "ediff" "\
-
+Call `ediff-merge-directories' with the next three command line arguments.
\(fn)" nil nil)
(autoload 'ediff-merge-directories-with-ancestor-command "ediff" "\
-
+Call `ediff-merge-directories-with-ancestor' with the next four command line arguments.
\(fn)" nil nil)
@@ -9642,15 +9795,6 @@ It creates an autoload function for CNAME's constructor.
;;;### (autoloads nil "elec-pair" "elec-pair.el" (0 0 0 0))
;;; Generated autoloads from elec-pair.el
-(defvar electric-pair-text-pairs '((34 . 34) ((nth 0 electric-quote-chars) nth 1 electric-quote-chars) ((nth 2 electric-quote-chars) nth 3 electric-quote-chars)) "\
-Alist of pairs that should always be used in comments and strings.
-
-Pairs of delimiters in this list are a fallback in case they have
-no syntax relevant to `electric-pair-mode' in the syntax table
-defined in `electric-pair-text-syntax-table'")
-
-(custom-autoload 'electric-pair-text-pairs "elec-pair" t)
-
(defvar electric-pair-mode nil "\
Non-nil if Electric-Pair mode is enabled.
See the `electric-pair-mode' command
@@ -10470,12 +10614,11 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;***
-;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-autoaway"
+;;;;;; "erc/erc-autoaway.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-autoaway.el
- (autoload 'erc-autoaway-mode "erc-autoaway")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-autoaway" '("erc-auto" "autoaway")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-autoaway" '("erc-auto")))
;;;***
@@ -10486,144 +10629,57 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
;;;***
-;;;### (autoloads nil "erc-button" "erc/erc-button.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-button" "erc/erc-button.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-button.el
- (autoload 'erc-button-mode "erc-button" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-button" '("erc-" "button")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-button" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-capab" "erc/erc-capab.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-capab.el
- (autoload 'erc-capab-identify-mode "erc-capab" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-capab" '("erc-capab-identify-" "capab-identify")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-capab" '("erc-capab-identify-")))
;;;***
-;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-compat" "erc/erc-compat.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-compat.el
- (autoload 'erc-define-minor-mode "erc-compat")
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-compat" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-dcc" "erc/erc-dcc.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-dcc" "erc/erc-dcc.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-dcc.el
- (autoload 'erc-dcc-mode "erc-dcc")
-
-(autoload 'erc-cmd-DCC "erc-dcc" "\
-Parser for /dcc command.
-This figures out the dcc subcommand and calls the appropriate routine to
-handle it. The function dispatched should be named \"erc-dcc-do-FOO-command\",
-where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc.
-
-\(fn CMD &rest ARGS)" nil nil)
-(autoload 'pcomplete/erc-mode/DCC "erc-dcc" "\
-Provides completion for the /DCC command.
-
-\(fn)" nil nil)
-
-(defvar erc-ctcp-query-DCC-hook '(erc-ctcp-query-DCC) "\
-Hook variable for CTCP DCC queries.")
-
-(autoload 'erc-ctcp-query-DCC "erc-dcc" "\
-The function called when a CTCP DCC request is detected by the client.
-It examines the DCC subcommand, and calls the appropriate routine for
-that subcommand.
-
-\(fn PROC NICK LOGIN HOST TO QUERY)" nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/" "dcc")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-dcc" '("erc-" "pcomplete/erc-mode/")))
;;;***
-;;;### (autoloads nil "erc-desktop-notifications" "erc/erc-desktop-notifications.el"
-;;;;;; (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-desktop-notifications"
+;;;;;; "erc/erc-desktop-notifications.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-desktop-notifications.el
-(autoload 'erc-notifications-mode "erc-desktop-notifications" "" t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-desktop-notifications" '("notifications" "erc-notifications-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-desktop-notifications" '("erc-notifications-")))
;;;***
-;;;### (autoloads nil "erc-ezbounce" "erc/erc-ezbounce.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-ezbounce"
+;;;;;; "erc/erc-ezbounce.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-ezbounce.el
-(autoload 'erc-cmd-ezb "erc-ezbounce" "\
-Send EZB commands to the EZBouncer verbatim.
-
-\(fn LINE &optional FORCE)" nil nil)
-
-(autoload 'erc-ezb-get-login "erc-ezbounce" "\
-Return an appropriate EZBounce login for SERVER and PORT.
-Look up entries in `erc-ezb-login-alist'. If the username or password
-in the alist is nil, prompt for the appropriate values.
-
-\(fn SERVER PORT)" nil nil)
-
-(autoload 'erc-ezb-lookup-action "erc-ezbounce" "\
-
-
-\(fn MESSAGE)" nil nil)
-
-(autoload 'erc-ezb-notice-autodetect "erc-ezbounce" "\
-React on an EZBounce NOTICE request.
-
-\(fn PROC PARSED)" nil nil)
-
-(autoload 'erc-ezb-identify "erc-ezbounce" "\
-Identify to the EZBouncer server.
-
-\(fn MESSAGE)" nil nil)
-
-(autoload 'erc-ezb-init-session-list "erc-ezbounce" "\
-Reset the EZBounce session list to nil.
-
-\(fn MESSAGE)" nil nil)
-
-(autoload 'erc-ezb-end-of-session-list "erc-ezbounce" "\
-Indicate the end of the EZBounce session listing.
-
-\(fn MESSAGE)" nil nil)
-
-(autoload 'erc-ezb-add-session "erc-ezbounce" "\
-Add an EZBounce session to the session list.
-
-\(fn MESSAGE)" nil nil)
-
-(autoload 'erc-ezb-select "erc-ezbounce" "\
-Select an IRC server to use by EZBounce, in ERC style.
-
-\(fn MESSAGE)" nil nil)
-
-(autoload 'erc-ezb-select-session "erc-ezbounce" "\
-Select a detached EZBounce session.
-
-\(fn)" nil nil)
-
-(autoload 'erc-ezb-initialize "erc-ezbounce" "\
-Add EZBouncer convenience functions to ERC.
-
-\(fn)" nil nil)
-
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ezbounce" '("erc-ezb-")))
;;;***
-;;;### (autoloads nil "erc-fill" "erc/erc-fill.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-fill" "erc/erc-fill.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-fill.el
- (autoload 'erc-fill-mode "erc-fill" nil t)
-
-(autoload 'erc-fill "erc-fill" "\
-Fill a region using the function referenced in `erc-fill-function'.
-You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'.
-
-\(fn)" nil nil)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-fill" '("erc-")))
@@ -10632,7 +10688,7 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'.
;;;### (autoloads nil "erc-goodies" "erc/erc-goodies.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-goodies.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-goodies" '("erc-" "unmorse" "scrolltobottom" "smiley" "irccontrols" "noncommands" "keep-place" "move-to-prompt" "readonly")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-goodies" '("erc-")))
;;;***
@@ -10643,46 +10699,27 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'.
;;;***
-;;;### (autoloads nil "erc-identd" "erc/erc-identd.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-identd" "erc/erc-identd.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-identd.el
- (autoload 'erc-identd-mode "erc-identd")
-
-(autoload 'erc-identd-start "erc-identd" "\
-Start an identd server listening to port 8113.
-Port 113 (auth) will need to be redirected to port 8113 on your
-machine -- using iptables, or a program like redir which can be
-run from inetd. The idea is to provide a simple identd server
-when you need one, without having to install one globally on your
-system.
-\(fn &optional PORT)" t nil)
-
-(autoload 'erc-identd-stop "erc-identd" "\
-
-
-\(fn &rest IGNORE)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-identd" '("erc-identd-" "identd")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-identd" '("erc-identd-")))
;;;***
-;;;### (autoloads nil "erc-imenu" "erc/erc-imenu.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-imenu" "erc/erc-imenu.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-imenu.el
-(autoload 'erc-create-imenu-index "erc-imenu" "\
-
-
-\(fn)" nil nil)
-
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-imenu" '("erc-unfill-notice")))
;;;***
-;;;### (autoloads nil "erc-join" "erc/erc-join.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-join" "erc/erc-join.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-join.el
- (autoload 'erc-autojoin-mode "erc-join" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-join" '("erc-" "autojoin")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-join" '("erc-")))
;;;***
@@ -10693,112 +10730,43 @@ system.
;;;***
-;;;### (autoloads nil "erc-list" "erc/erc-list.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-list" "erc/erc-list.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-list.el
- (autoload 'erc-list-mode "erc-list")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-list" '("erc-" "list")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-list" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-log" "erc/erc-log.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-log" "erc/erc-log.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-log.el
- (autoload 'erc-log-mode "erc-log" nil t)
-(autoload 'erc-logging-enabled "erc-log" "\
-Return non-nil if logging is enabled for BUFFER.
-If BUFFER is nil, the value of `current-buffer' is used.
-Logging is enabled if `erc-log-channels-directory' is non-nil, the directory
-is writable (it will be created as necessary) and
-`erc-enable-logging' returns a non-nil value.
-
-\(fn &optional BUFFER)" nil nil)
-
-(autoload 'erc-save-buffer-in-logs "erc-log" "\
-Append BUFFER contents to the log file, if logging is enabled.
-If BUFFER is not provided, current buffer is used.
-Logging is enabled if `erc-logging-enabled' returns non-nil.
-
-This is normally done on exit, to save the unsaved portion of the
-buffer, since only the text that runs off the buffer limit is logged
-automatically.
-
-You can save every individual message by putting this function on
-`erc-insert-post-hook'.
-
-\(fn &optional BUFFER)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-log" '("erc-" "log")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-log" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-match" "erc/erc-match.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-match" "erc/erc-match.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-match.el
- (autoload 'erc-match-mode "erc-match")
-
-(autoload 'erc-add-pal "erc-match" "\
-Add pal interactively to `erc-pals'.
-
-\(fn)" t nil)
-
-(autoload 'erc-delete-pal "erc-match" "\
-Delete pal interactively to `erc-pals'.
-\(fn)" t nil)
-
-(autoload 'erc-add-fool "erc-match" "\
-Add fool interactively to `erc-fools'.
-
-\(fn)" t nil)
-
-(autoload 'erc-delete-fool "erc-match" "\
-Delete fool interactively to `erc-fools'.
-
-\(fn)" t nil)
-
-(autoload 'erc-add-keyword "erc-match" "\
-Add keyword interactively to `erc-keywords'.
-
-\(fn)" t nil)
-
-(autoload 'erc-delete-keyword "erc-match" "\
-Delete keyword interactively to `erc-keywords'.
-
-\(fn)" t nil)
-
-(autoload 'erc-add-dangerous-host "erc-match" "\
-Add dangerous-host interactively to `erc-dangerous-hosts'.
-
-\(fn)" t nil)
-
-(autoload 'erc-delete-dangerous-host "erc-match" "\
-Delete dangerous-host interactively to `erc-dangerous-hosts'.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-match" '("erc-" "match")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-match" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-menu" "erc/erc-menu.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-menu.el
- (autoload 'erc-menu-mode "erc-menu" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-menu" '("erc-menu-" "menu")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-menu" '("erc-menu-")))
;;;***
-;;;### (autoloads nil "erc-netsplit" "erc/erc-netsplit.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-netsplit"
+;;;;;; "erc/erc-netsplit.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-netsplit.el
- (autoload 'erc-netsplit-mode "erc-netsplit")
-
-(autoload 'erc-cmd-WHOLEFT "erc-netsplit" "\
-Show who's gone.
-\(fn)" nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-netsplit" '("erc-" "netsplit")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-netsplit" '("erc-")))
;;;***
@@ -10818,182 +10786,111 @@ Interactively select a server to connect to using `erc-server-alist'.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-networks" '("erc-" "networks")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-networks" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-notify" "erc/erc-notify.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-notify" "erc/erc-notify.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-notify.el
- (autoload 'erc-notify-mode "erc-notify" nil t)
-(autoload 'erc-cmd-NOTIFY "erc-notify" "\
-Change `erc-notify-list' or list current notify-list members online.
-Without args, list the current list of notified people online,
-with args, toggle notify status of people.
-
-\(fn &rest ARGS)" nil nil)
-
-(autoload 'pcomplete/erc-mode/NOTIFY "erc-notify" "\
-
-
-\(fn)" nil nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-notify" '("erc-" "notify")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-notify" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-page" "erc/erc-page.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-page" "erc/erc-page.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-page.el
- (autoload 'erc-page-mode "erc-page")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-page" '("erc-" "page")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-page" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (0 0
-;;;;;; 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-pcomplete"
+;;;;;; "erc/erc-pcomplete.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-pcomplete.el
- (autoload 'erc-completion-mode "erc-pcomplete" nil t)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-pcomplete" '("pcomplete" "erc-pcomplet")))
;;;***
-;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-replace"
+;;;;;; "erc/erc-replace.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-replace.el
- (autoload 'erc-replace-mode "erc-replace")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-replace" '("replace" "erc-replace-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-replace" '("erc-replace-")))
;;;***
-;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-ring" "erc/erc-ring.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-ring.el
- (autoload 'erc-ring-mode "erc-ring" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ring" '("erc-" "ring")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-ring" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-services" "erc/erc-services.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-services"
+;;;;;; "erc/erc-services.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-services.el
- (autoload 'erc-services-mode "erc-services" nil t)
-
-(autoload 'erc-nickserv-identify-mode "erc-services" "\
-Set up hooks according to which MODE the user has chosen.
-
-\(fn MODE)" t nil)
-
-(autoload 'erc-nickserv-identify "erc-services" "\
-Send an \"identify <PASSWORD>\" message to NickServ.
-When called interactively, read the password using `read-passwd'.
-
-\(fn PASSWORD)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-services" '("erc-" "services")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-services" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-sound" "erc/erc-sound.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-sound.el
- (autoload 'erc-sound-mode "erc-sound")
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-sound" '("erc-" "sound")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-sound" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-speedbar" "erc/erc-speedbar.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-speedbar"
+;;;;;; "erc/erc-speedbar.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-speedbar.el
-(autoload 'erc-speedbar-browser "erc-speedbar" "\
-Initialize speedbar to display an ERC browser.
-This will add a speedbar major display mode.
-
-\(fn)" t nil)
-
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-speedbar" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-spelling"
+;;;;;; "erc/erc-spelling.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-spelling.el
- (autoload 'erc-spelling-mode "erc-spelling" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-spelling" '("erc-spelling-" "spelling")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-spelling" '("erc-spelling-")))
;;;***
-;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-stamp" "erc/erc-stamp.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-stamp.el
- (autoload 'erc-timestamp-mode "erc-stamp" nil t)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-stamp" '("erc-" "stamp")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-stamp" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-track" "erc/erc-track.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-track" "erc/erc-track.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-track.el
-(defvar erc-track-minor-mode nil "\
-Non-nil if Erc-Track minor mode is enabled.
-See the `erc-track-minor-mode' command
-for a description of this minor mode.")
-
-(custom-autoload 'erc-track-minor-mode "erc-track" nil)
-
-(autoload 'erc-track-minor-mode "erc-track" "\
-Toggle mode line display of ERC activity (ERC Track minor mode).
-With a prefix argument ARG, enable ERC Track minor mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
-
-ERC Track minor mode is a global minor mode. It exists for the
-sole purpose of providing the C-c C-SPC and C-c C-@ keybindings.
-Make sure that you have enabled the track module, otherwise the
-keybindings will not do anything useful.
-
-\(fn &optional ARG)" t nil)
- (autoload 'erc-track-mode "erc-track" nil t)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-track" '("erc-" "track")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-track" '("erc-")))
;;;***
-;;;### (autoloads nil "erc-truncate" "erc/erc-truncate.el" (0 0 0
-;;;;;; 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-truncate"
+;;;;;; "erc/erc-truncate.el" (0 0 0 0))
;;; Generated autoloads from erc/erc-truncate.el
- (autoload 'erc-truncate-mode "erc-truncate" nil t)
-(autoload 'erc-truncate-buffer-to-size "erc-truncate" "\
-Truncates the buffer to the size SIZE.
-If BUFFER is not provided, the current buffer is assumed. The deleted
-region is logged if `erc-logging-enabled' returns non-nil.
-
-\(fn SIZE &optional BUFFER)" nil nil)
-
-(autoload 'erc-truncate-buffer "erc-truncate" "\
-Truncates the current buffer to `erc-max-buffer-size'.
-Meant to be used in hooks, like `erc-insert-post-hook'.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-truncate" '("truncate" "erc-max-buffer-size")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-truncate" '("erc-max-buffer-size")))
;;;***
-;;;### (autoloads nil "erc-xdcc" "erc/erc-xdcc.el" (0 0 0 0))
+;;;### (autoloads "actual autoloads are elsewhere" "erc-xdcc" "erc/erc-xdcc.el"
+;;;;;; (0 0 0 0))
;;; Generated autoloads from erc/erc-xdcc.el
- (autoload 'erc-xdcc-mode "erc-xdcc")
-
-(autoload 'erc-xdcc-add-file "erc-xdcc" "\
-Add a file to `erc-xdcc-files'.
-
-\(fn FILE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-xdcc" '("erc-" "xdcc")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "erc-xdcc" '("erc-")))
;;;***
@@ -11892,9 +11789,12 @@ Render FILE using EWW.
(autoload 'eww-search-words "eww" "\
Search the web for the text between BEG and END.
-See the `eww-search-prefix' variable for the search engine used.
+If region is active (and not whitespace), search the web for
+the text between BEG and END. Else, prompt the user for a search
+string. See the `eww-search-prefix' variable for the search
+engine used.
-\(fn &optional BEG END)" t nil)
+\(fn)" t nil)
(autoload 'eww-mode "eww" "\
Mode for browsing the web.
@@ -11935,7 +11835,7 @@ command to find the next error. The buffer is also in `comint-mode' and
(autoload 'executable-set-magic "executable" "\
Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
+The variables `executable-magicless-file-regexp', `executable-prefix-env',
`executable-insert', `executable-query' and `executable-chmod' control
when and how magic numbers are inserted or replaced and scripts made
executable.
@@ -12241,6 +12141,49 @@ Besides the choice of face, it is the same as `buffer-face-mode'.
;;;***
+;;;### (autoloads nil "faceup" "emacs-lisp/faceup.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/faceup.el
+(push (purecopy '(faceup 0 0 6)) package--builtin-versions)
+
+(autoload 'faceup-view-buffer "faceup" "\
+Display the faceup representation of the current buffer.
+
+\(fn)" t nil)
+
+(autoload 'faceup-write-file "faceup" "\
+Save the faceup representation of the current buffer to the file FILE-NAME.
+
+Unless a name is given, the file will be named xxx.faceup, where
+xxx is the file name associated with the buffer.
+
+If optional second arg CONFIRM is non-nil, this function
+asks for confirmation before overwriting an existing file.
+Interactively, confirmation is required unless you supply a prefix argument.
+
+\(fn &optional FILE-NAME CONFIRM)" t nil)
+
+(autoload 'faceup-render-view-buffer "faceup" "\
+Convert BUFFER containing Faceup markup to a new buffer and display it.
+
+\(fn &optional BUFFER)" t nil)
+
+(autoload 'faceup-clean-buffer "faceup" "\
+Remove faceup markup from buffer.
+
+\(fn)" t nil)
+
+(autoload 'faceup-defexplainer "faceup" "\
+Defines an Ert explainer function for FUNCTION.
+
+FUNCTION must return an explanation when the test fails and
+`faceup-test-explain' is set.
+
+\(fn FUNCTION)" nil t)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "faceup" '("faceup-")))
+
+;;;***
+
;;;### (autoloads nil "feedmail" "mail/feedmail.el" (0 0 0 0))
;;; Generated autoloads from mail/feedmail.el
(push (purecopy '(feedmail 11)) package--builtin-versions)
@@ -12316,7 +12259,8 @@ If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
-and the functions `ffap-file-at-point' and `ffap-url-at-point'.
+`ffap-url-unwrap-local', `ffap-url-unwrap-remote', and the functions
+`ffap-file-at-point' and `ffap-url-at-point'.
\(fn &optional FILENAME)" t nil)
@@ -12399,7 +12343,7 @@ STRING is passed as an argument to the locate command.
\(fn STRING)" t nil)
(autoload 'file-cache-add-directory-recursively "filecache" "\
-Adds DIR and any subdirectories to the file-cache.
+Add DIR and any subdirectories to the file-cache.
This function does not use any external programs.
If the optional REGEXP argument is non-nil, only files which match it
will be added to the cache. Note that the REGEXP is applied to the
@@ -12614,14 +12558,14 @@ See `find-name-arg' to customize the arguments.
\(fn DIR PATTERN)" t nil)
(autoload 'find-grep-dired "find-dired" "\
-Find files in DIR matching a regexp REGEXP and start Dired on output.
+Find files in DIR that contain matches for REGEXP and start Dired on output.
The command run (after changing into DIR) is
find . \\( -type f -exec `grep-program' `find-grep-options' \\
-e REGEXP {} \\; \\) -ls
-where the car of the variable `find-ls-option' specifies what to
-use in place of \"-ls\" as the final argument.
+where the first string in the value of the variable `find-ls-option'
+specifies what to use in place of \"-ls\" as the final argument.
\(fn DIR REGEXP)" t nil)
@@ -12999,31 +12943,96 @@ to get the effect of a C-q.
;;; Generated autoloads from progmodes/flymake.el
(push (purecopy '(flymake 0 3)) package--builtin-versions)
+(autoload 'flymake-log "flymake" "\
+Log, at level LEVEL, the message MSG formatted with ARGS.
+LEVEL is passed to `display-warning', which is used to display
+the warning. If this form is included in a byte-compiled file,
+the generated warning contains an indication of the file that
+generated it.
+
+\(fn LEVEL MSG &rest ARGS)" nil t)
+
+(autoload 'flymake-make-diagnostic "flymake" "\
+Make a Flymake diagnostic for BUFFER's region from BEG to END.
+TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a
+description of the problem detected in this region.
+
+\(fn BUFFER BEG END TYPE TEXT)" nil nil)
+
+(autoload 'flymake-diagnostics "flymake" "\
+Get Flymake diagnostics in region determined by BEG and END.
+
+If neither BEG or END is supplied, use the whole buffer,
+otherwise if BEG is non-nil and END is nil, consider only
+diagnostics at BEG.
+
+\(fn &optional BEG END)" nil nil)
+
+(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.
+
+\(fn BUFFER LINE &optional COL)" nil nil)
+
(autoload 'flymake-mode "flymake" "\
Toggle Flymake mode on or off.
With a prefix argument ARG, enable Flymake mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
-\\{flymake-mode-map}
+
+Flymake is an Emacs minor mode for on-the-fly syntax checking.
+Flymake collects diagnostic information from multiple sources,
+called backends, and visually annotates the buffer with the
+results.
+
+Flymake performs these checks while the user is editing. The
+customization variables `flymake-start-on-flymake-mode',
+`flymake-no-changes-timeout' and
+`flymake-start-syntax-check-on-newline' determine the exact
+circumstances whereupon Flymake decides to initiate a check of
+the buffer.
+
+The commands `flymake-goto-next-error' and
+`flymake-goto-prev-error' can be used to navigate among Flymake
+diagnostics annotated in the buffer.
+
+The visual appearance of each type of diagnostic can be changed
+in the variable `flymake-diagnostic-types-alist'.
+
+Activation or deactivation of backends used by Flymake in each
+buffer happens via the special hook
+`flymake-diagnostic-functions'.
+
+Some backends may take longer than others to respond or complete,
+and some may decide to disable themselves if they are not
+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.
\(fn &optional ARG)" t nil)
(autoload 'flymake-mode-on "flymake" "\
-Turn flymake mode on.
+Turn Flymake mode on.
\(fn)" nil nil)
(autoload 'flymake-mode-off "flymake" "\
-Turn flymake mode off.
+Turn Flymake mode off.
\(fn)" nil nil)
-(autoload 'flymake-find-file-hook "flymake" "\
-
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-")))
-\(fn)" nil nil)
+;;;***
+
+;;;### (autoloads nil "flymake-proc" "progmodes/flymake-proc.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from progmodes/flymake-proc.el
+(push (purecopy '(flymake-proc 0 3)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-proc-")))
;;;***
@@ -13448,7 +13457,7 @@ and choose the directory as the fortune-file.
Minimum set of parameters to filter for live (on-session) framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
-(defvar frameset-persistent-filter-alist (nconc '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (delete-before . :never) (font . frameset-filter-shelve-param) (foreground-color . frameset-filter-sanitize-color) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
+(defvar frameset-persistent-filter-alist (nconc '((background-color . frameset-filter-sanitize-color) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) (client . :never) (delete-before . :never) (font . frameset-filter-font-param) (foreground-color . frameset-filter-sanitize-color) (fullscreen . frameset-filter-shelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) (outer-window-id . :never) (parent-frame . :never) (parent-id . :never) (mouse-wheel-frame . :never) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) (window-id . :never) (window-system . :never)) frameset-session-filter-alist) "\
Parameters to filter for persistent framesets.
DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
@@ -14484,8 +14493,7 @@ match any of the group-specified splitting rules. See
(autoload 'gnus-group-split-update "gnus-mlspl" "\
Computes nnmail-split-fancy from group params and CATCH-ALL.
-It does this by calling by calling (gnus-group-split-fancy nil
-nil CATCH-ALL).
+It does this by calling (gnus-group-split-fancy nil nil CATCH-ALL).
If CATCH-ALL is nil, `gnus-group-split-default-catch-all-group' is used
instead. This variable is set by `gnus-group-split-setup'.
@@ -14998,8 +15006,9 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').")
(custom-autoload 'grep-setup-hook "grep" t)
-(defconst grep-regexp-alist '(("^\\(.*?[^/\n]\\):[ ]*\\([1-9][0-9]*\\)[ ]*:" 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)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\
-Regexp used to match grep hits. See `compilation-error-regexp-alist'.")
+(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^
+Regexp used to match grep hits.
+See `compilation-error-regexp-alist' for format details.")
(defvar grep-program (purecopy "grep") "\
The default grep program for `grep-command' and `grep-find-command'.
@@ -15085,7 +15094,9 @@ easily repeat a find command.
Run grep, searching for REGEXP in FILES in directory DIR.
The search is limited to file names matching shell pattern FILES.
FILES may use abbreviations defined in `grep-files-aliases', e.g.
-entering `ch' is equivalent to `*.[ch]'.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
With \\[universal-argument] prefix, you can edit the constructed shell command line
before it is executed.
@@ -15103,7 +15114,9 @@ This command shares argument histories with \\[rgrep] and \\[grep].
Recursively grep for REGEXP in FILES in directory tree rooted at DIR.
The search is limited to file names matching shell pattern FILES.
FILES may use abbreviations defined in `grep-files-aliases', e.g.
-entering `ch' is equivalent to `*.[ch]'.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
With \\[universal-argument] prefix, you can edit the constructed shell command line
before it is executed.
@@ -16544,18 +16557,6 @@ The optional LABEL is used to label the buffer created.
;;;***
-;;;### (autoloads nil "html2text" "net/html2text.el" (0 0 0 0))
-;;; Generated autoloads from net/html2text.el
-
-(autoload 'html2text "html2text" "\
-Convert HTML to plain text in the current buffer.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "html2text" '("html2text-")))
-
-;;;***
-
;;;### (autoloads nil "htmlfontify" "htmlfontify.el" (0 0 0 0))
;;; Generated autoloads from htmlfontify.el
(push (purecopy '(htmlfontify 0 21)) package--builtin-versions)
@@ -16596,7 +16597,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'.
;;;;;; (0 0 0 0))
;;; Generated autoloads from ibuf-ext.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-ext" '("ibuffer-" "file" "shell-command-" "starred-name" "size" "alphabetic" "major-mode" "mod" "print" "predicate" "content" "view-and-eval" "visiting-file" "derived-mode" "directory" "basename" "name" "used-mode" "query-replace" "rename-uniquely" "revert" "replace-regexp" "eval")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ibuf-ext" '("ibuffer-" "file" "shell-command-" "starred-name" "size" "alphabetic" "major-mode" "mod" "print" "process" "predicate" "content" "view-and-eval" "visiting-file" "derived-mode" "directory" "basename" "name" "used-mode" "query-replace" "rename-uniquely" "revert" "replace-regexp" "eval")))
;;;***
@@ -17245,7 +17246,7 @@ For details of keybindings, see `ido-find-file'.
\(fn)" t nil)
(autoload 'ido-find-alternate-file "ido" "\
-Switch to another file and show it in another window.
+Find another file, select its buffer, kill previous buffer.
The file name is selected interactively by typing a substring.
For details of keybindings, see `ido-find-file'.
@@ -19159,7 +19160,8 @@ Use \\[kmacro-insert-counter] to insert (and increment) the macro counter.
The counter value can be set or modified via \\[kmacro-set-counter] and \\[kmacro-add-counter].
The format of the counter can be modified via \\[kmacro-set-format].
-Use \\[kmacro-name-last-macro] to give it a permanent name.
+Use \\[kmacro-name-last-macro] to give it a name that will remain valid even
+after another macro is defined.
Use \\[kmacro-bind-to-key] to bind it to a key sequence.
\(fn ARG)" t nil)
@@ -19187,8 +19189,8 @@ just the last key in the key sequence that you used to call this
command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg'
for details on how to adjust or disable this behavior.
-To make a macro permanent so you can call it even after defining
-others, use \\[kmacro-name-last-macro].
+To give a macro a name so you can call it even after defining others,
+use \\[kmacro-name-last-macro].
\(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil)
@@ -19223,8 +19225,8 @@ Call last keyboard macro, ending it first if currently being defined.
With numeric prefix ARG, repeat macro that many times.
Zero argument means repeat until there is an error.
-To give a macro a permanent name, so you can call it
-even after defining other macros, use \\[kmacro-name-last-macro].
+To give a macro a name, so you can call it even after defining other
+macros, use \\[kmacro-name-last-macro].
\(fn ARG &optional NO-REPEAT)" t nil)
@@ -19400,6 +19402,30 @@ A major mode to edit GNU ld script files
;;;***
+;;;### (autoloads nil "less-css-mode" "textmodes/less-css-mode.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from textmodes/less-css-mode.el
+
+(put 'less-css-compile-at-save 'safe-local-variable 'booleanp)
+
+(put 'less-css-lessc-options 'safe-local-variable t)
+
+(put 'less-css-output-directory 'safe-local-variable 'stringp)
+
+(put 'less-css-input-file-name 'safe-local-variable 'stringp)
+ (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode))
+
+(autoload 'less-css-mode "less-css-mode" "\
+Major mode for editing Less files (http://lesscss.org/).
+Special commands:
+\\{less-css-mode-map}
+
+\(fn)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "less-css-mode" '("less-css-")))
+
+;;;***
+
;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from emacs-lisp/let-alist.el
@@ -19534,7 +19560,7 @@ something strange, such as redefining an Emacs function.
\(fn FEATURE &optional FORCE)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("unload-" "loadhist-hook-functions" "read-feature" "feature-" "file-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("loadhist-" "unload-" "read-feature" "feature-" "file-")))
;;;***
@@ -19776,13 +19802,7 @@ A major mode to edit m4 macro files.
;;;### (autoloads nil "macros" "macros.el" (0 0 0 0))
;;; Generated autoloads from macros.el
-(autoload 'name-last-kbd-macro "macros" "\
-Assign a name to the last keyboard macro defined.
-Argument SYMBOL is the name to define.
-The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid editor command.
-
-\(fn SYMBOL)" t nil)
+(defalias 'name-last-kbd-macro #'kmacro-name-last-macro)
(autoload 'insert-kbd-macro "macros" "\
Insert in buffer the definition of kbd macro MACRONAME, as Lisp code.
@@ -20372,7 +20392,7 @@ Default bookmark handler for Man buffers.
;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 1 1)) package--builtin-versions)
+(push (purecopy '(map 1 2)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "map" '("map")))
@@ -22722,10 +22742,25 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-J" "org/ob-J.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-J.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0))
;;; Generated autoloads from org/ob-R.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("org-babel-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-")))
+
+;;;***
+
+;;;### (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)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-")))
;;;***
@@ -22765,6 +22800,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-coq" "org/ob-coq.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-coq.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("org-babel-" "coq-program-name")))
+
+;;;***
+
;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el"
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/ob-core.el
@@ -22794,6 +22836,14 @@ 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)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-emacs-lisp" "org/ob-emacs-lisp.el" (0 0
;;;;;; 0 0))
;;; Generated autoloads from org/ob-emacs-lisp.el
@@ -22816,6 +22866,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-forth.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0))
;;; Generated autoloads from org/ob-fortran.el
@@ -22830,6 +22887,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-groovy.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0))
;;; Generated autoloads from org/ob-haskell.el
@@ -22837,6 +22901,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-hledger" "org/ob-hledger.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-hledger.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-hledger" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-io" "org/ob-io.el" (0 0 0 0))
;;; Generated autoloads from org/ob-io.el
@@ -22869,7 +22940,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0))
;;; Generated autoloads from org/ob-latex.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-" "convert-pdf")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-")))
;;;***
@@ -22902,6 +22973,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-lua.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0))
;;; Generated autoloads from org/ob-makefile.el
@@ -22965,6 +23043,14 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-processing" "org/ob-processing.el" (0 0
+;;;;;; 0 0))
+;;; Generated autoloads from org/ob-processing.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0))
;;; Generated autoloads from org/ob-python.el
@@ -22993,13 +23079,6 @@ Many aspects this mode can be customized using
;;;***
-;;;### (autoloads nil "ob-scala" "org/ob-scala.el" (0 0 0 0))
-;;; Generated autoloads from org/ob-scala.el
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-scala" '("org-babel-")))
-
-;;;***
-
;;;### (autoloads nil "ob-scheme" "org/ob-scheme.el" (0 0 0 0))
;;; Generated autoloads from org/ob-scheme.el
@@ -23014,10 +23093,18 @@ Many aspects this mode can be customized using
;;;***
-;;;### (autoloads nil "ob-sh" "org/ob-sh.el" (0 0 0 0))
-;;; Generated autoloads from org/ob-sh.el
+;;;### (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 0)) package--builtin-versions)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sh" '("org-babel-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-")))
+
+;;;***
+
+;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-shell.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-")))
;;;***
@@ -23031,7 +23118,7 @@ Many aspects this mode can be customized using
;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0))
;;; Generated autoloads from org/ob-sql.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-" "dbstring-mysql")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-")))
;;;***
@@ -23042,6 +23129,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-stan" "org/ob-stan.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-stan.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0))
;;; Generated autoloads from org/ob-table.el
@@ -23057,6 +23151,13 @@ Many aspects this mode can be customized using
;;;***
+;;;### (autoloads nil "ob-vala" "org/ob-vala.el" (0 0 0 0))
+;;; Generated autoloads from org/ob-vala.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-vala" '("org-babel-")))
+
+;;;***
+
;;;### (autoloads nil "octave" "progmodes/octave.el" (0 0 0 0))
;;; Generated autoloads from progmodes/octave.el
@@ -23149,7 +23250,7 @@ Load the languages defined in `org-babel-load-languages'.
\(fn SYM VALUE)" nil nil)
(autoload 'org-babel-load-file "org" "\
-Load Emacs Lisp source code blocks in the Org-mode FILE.
+Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
@@ -23158,10 +23259,11 @@ file to byte-code before it is loaded.
\(fn FILE &optional COMPILE)" t nil)
(autoload 'org-version "org" "\
-Show the org-mode version in the echo area.
-With prefix argument HERE, insert it at point.
-When FULL is non-nil, use a verbose version string.
-When MESSAGE is non-nil, display a message with the version.
+Show the Org version.
+Interactively, or when MESSAGE is non-nil, show it in echo area.
+With prefix argument, or when HERE is non-nil, insert it at point.
+In non-interactive uses, a reduced version string is output unless
+FULL is given.
\(fn &optional HERE FULL MESSAGE)" t nil)
@@ -23179,15 +23281,15 @@ Set up hooks for clock persistence.
Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
-Org-mode develops organizational tasks around a NOTES file which
-contains information about projects as plain text. Org-mode is
-implemented on top of outline-mode, which is ideal to keep the content
+Org mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org mode is
+implemented on top of Outline mode, which is ideal to keep the content
of large files well structured. It supports ToDo items, deadlines and
time stamps, which magically appear in the diary listing of the Emacs
calendar. Tables are easily created with a built-in table editor.
Plain text URL-like links connect to websites, emails (VM), Usenet
messages (Gnus), BBDB entries, and any files related to the project.
-For printing and sharing of notes, an Org-mode file (or a part of it)
+For printing and sharing of notes, an Org file (or a part of it)
can be exported as a structured ASCII or HTML file.
The following commands are available:
@@ -23197,58 +23299,60 @@ The following commands are available:
\(fn)" t nil)
(autoload 'org-cycle "org" "\
-TAB-action and visibility cycling for Org-mode.
+TAB-action and visibility cycling for Org mode.
-This is the command invoked in Org-mode by the TAB key. Its main purpose
-is outline visibility cycling, but it also invokes other actions
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
-- When this function is called with a prefix argument, rotate the entire
- buffer through 3 states (global cycling)
+When this function is called with a `\\[universal-argument]' prefix, rotate the entire
+buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
- When called with two `C-u C-u' prefixes, switch to the startup visibility,
- determined by the variable `org-startup-folded', and by any VISIBILITY
- properties in the buffer.
- When called with three `C-u C-u C-u' prefixed, show the entire buffer,
- including any drawers.
-- When inside a table, re-align the table and move to the next field.
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, switch to the startup visibility,
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
+
+With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix argument, show the entire buffer, including
+any drawers.
-- When point is at the beginning of a headline, rotate the subtree started
- by this line through 3 different states (local cycling)
+When inside a table, re-align the table and move to the next field.
+
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
- If there is no subtree, switch directly from CHILDREN to FOLDED.
+If there is no subtree, switch directly from CHILDREN to FOLDED.
-- When point is at the beginning of an empty headline and the variable
- `org-cycle-level-after-item/entry-creation' is set, cycle the level
- of the headline by demoting and promoting it to likely levels. This
- speeds up creation document structure by pressing TAB once or several
- times right after creating a new headline.
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
-- When there is a numeric prefix, go up to a heading with level ARG, do
- a `show-subtree' and return to the previous cursor position. If ARG
- is negative, go up that many levels.
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
-- 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.
+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.
-- 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
- (C-u TAB, same as S-TAB) also when called without prefix arg.
- But only if also the variable `org-cycle-global-at-bob' is t.
+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.
\(fn &optional ARG)" t nil)
(autoload 'org-global-cycle "org" "\
Cycle the global visibility. For details see `org-cycle'.
-With \\[universal-argument] prefix arg, switch to startup visibility.
+With `\\[universal-argument]' prefix ARG, switch to startup visibility.
With a numeric prefix, show all headlines up to that level.
\(fn &optional ARG)" t nil)
@@ -23256,10 +23360,10 @@ With a numeric prefix, show all headlines up to that level.
(autoload 'orgstruct-mode "org" "\
Toggle the minor mode `orgstruct-mode'.
-This mode is for using Org-mode structure commands in other
-modes. The following keys behave as if Org-mode were active, if
+This mode is for using Org mode structure commands in other
+modes. The following keys behave as if Org mode were active, if
the cursor is on a headline, or on a plain list item (both as
-defined by Org-mode).
+defined by Org mode).
\(fn &optional ARG)" t nil)
@@ -23274,61 +23378,59 @@ Unconditionally turn on `orgstruct++-mode'.
\(fn)" nil nil)
(autoload 'org-run-like-in-org-mode "org" "\
-Run a command, pretending that the current buffer is in Org-mode.
+Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
-Org-mode to the values they have in Org-mode, and then interactively
+Org mode to the values they have in Org mode, and then interactively
call CMD.
\(fn CMD)" nil nil)
(autoload 'org-store-link "org" "\
-\\<org-mode-map>Store an org-link to the current location.
+Store an org-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].
+into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
-For some link types, a prefix arg is interpreted.
-For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'.
+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 double prefix arg force skipping storing functions that are not
-part of Org's core.
+A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not
+part of Org core.
-A triple prefix arg force storing a link for each line in the
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the
active region.
\(fn ARG)" t nil)
(autoload 'org-insert-link-global "org" "\
-Insert a link like Org-mode does.
-This command can be called in any mode to insert a link in Org-mode syntax.
+Insert a link like Org mode does.
+This command can be called in any mode to insert a link in Org syntax.
\(fn)" t nil)
(autoload 'org-open-at-point-global "org" "\
-Follow a link like Org-mode does.
-This command can be called in any mode to follow a link that has
-Org-mode syntax.
+Follow a link or time-stamp like Org mode does.
+This command can be called in any mode to follow an external link
+or a time-stamp that has Org mode syntax. Its behavior is
+undefined when called on internal links (e.g., fuzzy links).
+Raise an error when there is nothing to follow.
\(fn)" t nil)
(autoload 'org-open-link-from-string "org" "\
-Open a link in the string S, as if it was in Org-mode.
+Open a link in the string S, as if it was in Org mode.
\(fn S &optional ARG REFERENCE-BUFFER)" t nil)
(autoload 'org-switchb "org" "\
Switch between Org buffers.
-With one prefix argument, restrict available buffers to files.
-With two prefix arguments, restrict available buffers to agenda files.
-
-Defaults to `iswitchb' for buffer name completion.
-Set `org-completion-use-ido' to make it use ido instead.
-\(fn &optional ARG)" t nil)
+With `\\[universal-argument]' prefix, restrict available buffers to files.
-(defalias 'org-ido-switchb 'org-switchb)
+With `\\[universal-argument] \\[universal-argument]' prefix, restrict available buffers to agenda files.
-(defalias 'org-iswitchb 'org-switchb)
+\(fn &optional ARG)" t nil)
(autoload 'org-cycle-agenda-files "org" "\
Cycle through the files in `org-agenda-files'.
@@ -23338,13 +23440,13 @@ If the current buffer does not, find the first agenda file.
\(fn)" t nil)
(autoload 'org-submit-bug-report "org" "\
-Submit a bug report on Org-mode via mail.
+Submit a bug report on Org via mail.
Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
-information about your Org-mode version and configuration.
+information about your Org version and configuration.
\(fn)" t nil)
@@ -23383,7 +23485,6 @@ T Call `org-todo-list' to display the global todo list, select only
m Call `org-tags-view' to display headlines with tags matching
a condition (the user is prompted for the condition).
M Like `m', but select only TODO entries, no ordinary headlines.
-L Create a timeline for the current buffer.
e Export views to associated files.
s Search entries for keywords.
S Search entries for keywords, only with TODO keywords.
@@ -23400,9 +23501,9 @@ More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
-If the current buffer is in Org-mode and visiting a file, you can also
+If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
-\(until the next use of \\[org-agenda]) restricted to the current file.
+\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active).
@@ -23523,15 +23624,16 @@ as a whole, to include whitespace.
with a colon, this will mean that the (non-regexp) snippets of the
Boolean search must match as full words.
-This command searches the agenda files, and in addition the files listed
-in `org-agenda-text-search-extra-files'.
+This command searches the agenda files, and in addition the files
+listed in `org-agenda-text-search-extra-files' unless a restriction lock
+is active.
\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil)
(autoload 'org-todo-list "org-agenda" "\
Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
-the list to these. When using \\[universal-argument], you will be prompted
+the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'.
@@ -23587,22 +23689,22 @@ Do we have a reason to ignore this TODO entry because it has a time stamp?
(autoload 'org-agenda-set-restriction-lock "org-agenda" "\
Set restriction lock for agenda, to current subtree or file.
-Restriction will be the file if TYPE is `file', or if TYPE is the
-universal prefix `(4)', or if the cursor is before the first headline
+Restriction will be the file if TYPE is `file', or if type is the
+universal prefix \\='(4), or if the cursor is before the first headline
in the file. Otherwise, restriction will be to the current subtree.
\(fn &optional TYPE)" t nil)
(autoload 'org-calendar-goto-agenda "org-agenda" "\
-Compute the Org-mode agenda for the calendar date displayed at the cursor.
+Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'.
\(fn)" t nil)
(autoload 'org-agenda-to-appt "org-agenda" "\
Activate appointments found in `org-agenda-files'.
-With a \\[universal-argument] prefix, refresh the list of
-appointments.
+
+With a `\\[universal-argument]' prefix, refresh the list of appointments.
If FILTER is t, interactively prompt the user for a regular
expression, and filter out entries that don't match it.
@@ -23617,8 +23719,8 @@ argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
- ((headline \"IMPORTANT\")
- (category \"Work\"))
+ \\='((headline \"IMPORTANT\")
+ (category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
@@ -23680,19 +23782,23 @@ Capture STRING with the template selected by KEYS.
(autoload 'org-capture "org-capture" "\
Capture something.
\\<org-capture-mode-map>
-This will let you select a template from `org-capture-templates', and then
-file the newly captured information. The text is immediately inserted
-at the target location, and an indirect buffer is shown where you can
-edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
-of Emacs, so that you can continue your work.
+This will let you select a template from `org-capture-templates', and
+then file the newly captured information. The text is immediately
+inserted at the target location, and an indirect buffer is shown where
+you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the previous
+state of Emacs, so that you can continue your work.
+
+When called interactively with a `\\[universal-argument]' prefix argument GOTO, don't
+capture anything, just go to the file/headline where the selected
+template stores its notes.
-When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
-anything, just go to the file/headline where the selected template
-stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note
-stored.
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
+When called with a `C-1' (one) prefix, force prompting for a date when
+a datetree entry is made.
+
ELisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
@@ -23735,26 +23841,29 @@ Remove all currently active column overlays.
\(fn)" nil nil)
(autoload 'org-columns "org-colview" "\
-Turn on column view on an org-mode file.
+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 COLUMNS-FMT-STRING)" t nil)
+\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil)
(autoload 'org-columns-compute "org-colview" "\
-Sum the values of property PROPERTY hierarchically, for the entire buffer.
+Summarize the values of PROPERTY hierarchically.
+Also update existing values for PROPERTY according to the first
+column specification.
\(fn PROPERTY)" t nil)
-(autoload 'org-columns-number-to-string "org-colview" "\
-Convert a computed column number to a string value, according to FMT.
-
-\(fn N FMT &optional PRINTF)" nil nil)
-
(autoload 'org-dblock-write:columnview "org-colview" "\
Write the column view table.
PARAMS is a property list of parameters:
-:width enforce same column widths with <N> specifiers.
:id 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
@@ -23764,15 +23873,17 @@ PARAMS is a property list of parameters:
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
+:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
+:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use.
\(fn PARAMS)" nil nil)
-(autoload 'org-insert-columns-dblock "org-colview" "\
+(autoload 'org-columns-insert-dblock "org-colview" "\
Create a dynamic block capturing a column view table.
\(fn)" t nil)
@@ -23808,7 +23919,7 @@ Try very hard to provide sensible version strings.
;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0))
;;; Generated autoloads from org/org-ctags.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-" "y-or-n-minibuffer")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-")))
;;;***
@@ -23827,6 +23938,63 @@ Try very hard to provide sensible version strings.
;;;***
+;;;### (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.
+
+\(fn)" 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)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-duration" '("org-duration-")))
+
+;;;***
+
;;;### (autoloads "actual autoloads are elsewhere" "org-element"
;;;;;; "org/org-element.el" (0 0 0 0))
;;; Generated autoloads from org/org-element.el
@@ -23839,7 +24007,7 @@ Try very hard to provide sensible version strings.
;;;;;; 0))
;;; Generated autoloads from org/org-entities.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("replace-amp" "org-entit")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit")))
;;;***
@@ -23850,6 +24018,13 @@ Try very hard to provide sensible version strings.
;;;***
+;;;### (autoloads nil "org-eww" "org/org-eww.el" (0 0 0 0))
+;;; Generated autoloads from org/org-eww.el
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eww" '("org-eww-")))
+
+;;;***
+
;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0))
;;; Generated autoloads from org/org-faces.el
@@ -23926,6 +24101,24 @@ Try very hard to provide sensible version strings.
;;;***
+;;;### (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)
+
+(if (fboundp 'register-definition-prefixes) (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
@@ -23944,7 +24137,7 @@ Try very hard to provide sensible version strings.
;;; Generated autoloads from org/org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
-Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it.
+Load FILE with optional arguments NOERROR and MUSTSUFFIX.
\(fn FILE)" nil t)
@@ -24016,7 +24209,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a
;;;;;; (0 0 0 0))
;;; Generated autoloads from org/org-table.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org" "*orgtbl-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org")))
;;;***
@@ -24032,14 +24225,14 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a
;;; Generated autoloads from org/org-version.el
(autoload 'org-release "org-version" "\
-The release version of org-mode.
- Inserted by installing org-mode or when a release is made.
+The release version of Org.
+Inserted by installing Org mode or when a release is made.
\(fn)" nil nil)
(autoload 'org-git-version "org-version" "\
The Git version of org-mode.
- Inserted by installing org-mode or when a release is made.
+Inserted by installing Org or when a release is made.
\(fn)" nil nil)
@@ -24303,7 +24496,9 @@ Display the full documentation of PACKAGE (a symbol).
Display a list of packages.
This first fetches the updated list of packages before
displaying, unless a prefix argument NO-FETCH is specified.
-The list is displayed in a buffer named `*Packages*'.
+The list is displayed in a buffer named `*Packages*', and
+includes the package's version, availability status, and a
+short description.
\(fn &optional NO-FETCH)" t nil)
@@ -24914,6 +25109,14 @@ Global menu used by PCL-CVS.")
(put 'perl-brace-imaginary-offset 'safe-local-variable 'integerp)
(put 'perl-label-offset 'safe-local-variable 'integerp)
+(autoload 'perl-flymake "perl-mode" "\
+Perl backend for Flymake. Launches
+`perl-flymake-command' (which see) and passes to its standard
+input the contents of the current buffer. The output of this
+command is analyzed for error and warning messages.
+
+\(fn REPORT-FN &rest ARGS)" nil nil)
+
(autoload 'perl-mode "perl-mode" "\
Major mode for editing Perl code.
Expression and list commands understand all Perl brackets.
@@ -25050,25 +25253,6 @@ they are not by default assigned to keys.
;;;***
-;;;### (autoloads nil "pinentry" "net/pinentry.el" (0 0 0 0))
-;;; Generated autoloads from net/pinentry.el
-(push (purecopy '(pinentry 0 1)) package--builtin-versions)
-
-(autoload 'pinentry-start "pinentry" "\
-Start a Pinentry service.
-
-Once the environment is properly set, subsequent invocations of
-the gpg command will interact with Emacs for passphrase input.
-
-If the optional QUIET argument is non-nil, messages at startup
-will not be shown.
-
-\(fn &optional QUIET)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pinentry" '("pinentry-")))
-
-;;;***
-
;;;### (autoloads nil "pixel-scroll" "pixel-scroll.el" (0 0 0 0))
;;; Generated autoloads from pixel-scroll.el
@@ -25862,7 +26046,11 @@ is not a part of a detectable project either, return a
(autoload 'project-find-regexp "project" "\
Find all matches for REGEXP in the current project's roots.
With \\[universal-argument] prefix, you can specify the directory
-to search in, and the file name pattern to search for.
+to search in, and the file name pattern to search for. The
+pattern may use abbreviations defined in `grep-files-aliases',
+e.g. entering `ch' is equivalent to `*.[ch]'. As whitespace
+triggers completion when entering a pattern, including it
+requires quoting, e.g. `\\[quoted-insert]<space>'.
\(fn REGEXP)" t nil)
@@ -26232,7 +26420,7 @@ Optional argument FACE specifies the face to do the highlighting.
;;; Generated autoloads from progmodes/python.el
(push (purecopy '(python 0 25 2)) package--builtin-versions)
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode))
@@ -26896,6 +27084,10 @@ With a prefix (or a FILL) argument, also fill too short lines.
Replace rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width.
+When called interactively and option `rectangle-preview' is
+non-nil, display the result as the user enters the string into
+the minibuffer.
+
Called from a program, takes three args; START, END and STRING.
\(fn START END STRING)" t nil)
@@ -27795,6 +27987,46 @@ than appending to it. Deletes the message after writing if
;;;***
+;;;### (autoloads nil "rmc" "emacs-lisp/rmc.el" (0 0 0 0))
+;;; Generated autoloads from emacs-lisp/rmc.el
+
+(autoload 'read-multiple-choice "rmc" "\
+Ask user a multiple choice question.
+PROMPT should be a string that will be displayed as the prompt.
+
+CHOICES is an alist where the first element in each entry is a
+character to be entered, the second element is a short name for
+the entry to be displayed while prompting (if there's room, it
+might be shortened), and the third, optional entry is a longer
+explanation that will be displayed in a help buffer if the user
+requests more help.
+
+This function translates user input into responses by consulting
+the bindings in `query-replace-map'; see the documentation of
+that variable for more information. In this case, the useful
+bindings are `recenter', `scroll-up', and `scroll-down'. If the
+user enters `recenter', `scroll-up', or `scroll-down' responses,
+perform the requested window recentering or scrolling and ask
+again.
+
+When `use-dialog-box' is t (the default), this function can pop
+up a dialog window to collect the user input. That functionality
+requires `display-popup-menus-p' to return t. Otherwise, a text
+dialog will be used.
+
+The return value is the matching entry from the CHOICES list.
+
+Usage example:
+
+\(read-multiple-choice \"Continue connecting?\"
+ \\='((?a \"always\")
+ (?s \"session only\")
+ (?n \"no\")))
+
+\(fn PROMPT CHOICES)" nil nil)
+
+;;;***
+
;;;### (autoloads nil "rng-cmpct" "nxml/rng-cmpct.el" (0 0 0 0))
;;; Generated autoloads from nxml/rng-cmpct.el
@@ -30399,7 +30631,7 @@ then `snmpv2-mode-hook'.
;;;### (autoloads nil "soap-client" "net/soap-client.el" (0 0 0 0))
;;; Generated autoloads from net/soap-client.el
-(push (purecopy '(soap-client 3 1 2)) package--builtin-versions)
+(push (purecopy '(soap-client 3 1 3)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "soap-client" '("soap-")))
@@ -30616,7 +30848,7 @@ the sort order.
\(fn FIELD BEG END)" t nil)
(autoload 'sort-regexp-fields "sort" "\
-Sort the text in the region region lexicographically.
+Sort the text in the region lexicographically.
If called interactively, prompt for two regular expressions,
RECORD-REGEXP and KEY-REGEXP.
@@ -30818,7 +31050,7 @@ Return a vector containing the lines from `spook-phrases-file'.
;;;### (autoloads nil "sql" "progmodes/sql.el" (0 0 0 0))
;;; Generated autoloads from progmodes/sql.el
-(push (purecopy '(sql 3 5)) package--builtin-versions)
+(push (purecopy '(sql 3 6)) package--builtin-versions)
(autoload 'sql-add-product-keywords "sql" "\
Add highlighting KEYWORDS for SQL PRODUCT.
@@ -30880,7 +31112,7 @@ their settings.
The user will not be prompted for any login parameters if a value
is specified in the connection settings.
-\(fn CONNECTION &optional NEW-NAME)" t nil)
+\(fn CONNECTION &optional BUF-NAME)" t nil)
(autoload 'sql-product-interactive "sql" "\
Run PRODUCT interpreter as an inferior process.
@@ -31639,7 +31871,7 @@ Studlify-case the current buffer.
;;;### (autoloads nil "subr-x" "emacs-lisp/subr-x.el" (0 0 0 0))
;;; Generated autoloads from emacs-lisp/subr-x.el
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subr-x" '("read-multiple-choice" "string-" "hash-table-" "and-let*" "when-let" "internal--" "if-let" "thread-")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "subr-x" '("string-" "hash-table-" "when-let" "internal--" "if-let" "and-let*" "thread-")))
;;;***
@@ -32617,10 +32849,8 @@ use in that buffer.
;;; Generated autoloads from emacs-lisp/testcover.el
(autoload 'testcover-start "testcover" "\
-Uses edebug to instrument all macros and functions in FILENAME, then
-changes the instrumentation from edebug to testcover--much faster, no
-problems with type-ahead or post-command-hook, etc. If BYTE-COMPILE is
-non-nil, byte-compiles each function after instrumenting.
+Use Edebug to instrument for coverage all macros and functions in FILENAME.
+If BYTE-COMPILE is non-nil, byte compile each function after instrumenting.
\(fn FILENAME &optional BYTE-COMPILE)" t nil)
@@ -33198,7 +33428,7 @@ Return the Lisp list at point, or nil if none is found.
\(fn)" nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("form-at-point" "thing-at-point-" "sentence-at-point" "word-at-point" "in-string-p" "end-of-thing" "beginning-of-thing")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "thingatpt" '("filename" "form-at-point" "thing-at-point-" "sentence-at-point" "word-at-point" "define-thing-chars" "in-string-p" "end-of-thing" "beginning-of-thing")))
;;;***
@@ -33451,7 +33681,7 @@ Return a string giving the duration of the Emacs initialization.
\(fn)" t nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "legacy-style-world-list" "zoneinfo-style-world-list")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "time" '("display-time-" "time--display-world-list" "legacy-style-world-list" "zoneinfo-style-world-list")))
;;;***
@@ -33714,11 +33944,11 @@ relative only to the time worked today, and not to past time.
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/timer-list.el
-(autoload 'timer-list "timer-list" "\
+(autoload 'list-timers "timer-list" "\
List all timers in a buffer.
\(fn &optional IGNORE-AUTO NONCONFIRM)" t nil)
- (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
+ (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "timer-list" '("timer-list-")))
@@ -34025,62 +34255,31 @@ If it is set to nil, all remote file names are used literally.")
(custom-autoload 'tramp-mode "tramp" t)
-(defvar tramp-syntax 'default "\
-Tramp filename syntax to be used.
-
-It can have the following values:
-
- `default' -- Default syntax
- `simplified' -- Ange-FTP like syntax
- `separate' -- Syntax as defined for XEmacs originally
-
-Do not change the value by `setq', it must be changed only by
-`custom-set-variables'. See also `tramp-change-syntax'.")
-
-(custom-autoload 'tramp-syntax "tramp" nil)
-
(defconst tramp-initial-file-name-regexp "\\`/.+:.*:" "\
Value for `tramp-file-name-regexp' for autoload.
It must match the initial `tramp-syntax' settings.")
(defvar tramp-file-name-regexp tramp-initial-file-name-regexp "\
-Value for `tramp-file-name-regexp' for autoload.
-It must match the initial `tramp-syntax' settings.")
-
-(defconst tramp-completion-file-name-regexp-default (concat "\\`/\\(" "\\([^/|:]+:[^/|:]*|\\)*" (if (memq system-type '(cygwin windows-nt)) "\\(-\\|[^/|:]\\{2,\\}\\)" "[^/|:]+") "\\(:[^/|:]*\\)?" "\\)?\\'") "\
-Value for `tramp-completion-file-name-regexp' for default remoting.
-See `tramp-file-name-structure' for more explanations.
-
-On W32 systems, the volume letter must be ignored.")
-
-(defconst tramp-initial-completion-file-name-regexp tramp-completion-file-name-regexp-default "\
-Value for `tramp-completion-file-name-regexp' for autoload.
-It must match the initial `tramp-syntax' settings.")
-
-(defconst tramp-completion-file-name-handler-alist '((file-name-all-completions . tramp-completion-handle-file-name-all-completions) (file-name-completion . tramp-completion-handle-file-name-completion)) "\
-Alist of completion handler functions.
-Used for file names matching `tramp-completion-file-name-regexp'.
-Operations not mentioned here will be handled by Tramp's file
-name handler functions, or the normal Emacs functions.")
+Regular expression matching file names handled by Tramp.
+This regexp should match Tramp file names but no other file
+names. When calling `tramp-register-file-name-handlers', the
+initial value is overwritten by the car of `tramp-file-name-structure'.")
-(autoload 'tramp-completion-file-name-handler "tramp" "\
-Invoke Tramp file name completion handler.
-Falls back to normal file name handler if no Tramp file name handler exists.
-
-\(fn OPERATION &rest ARGS)" nil nil)
+(defconst tramp-autoload-file-name-regexp (concat "\\`/" (if (memq system-type '(cygwin windows-nt)) "\\(-\\|[^/|:]\\{2,\\}\\)" "[^/|:]+") ":") "\
+Regular expression matching file names handled by Tramp autoload.
+It must match the initial `tramp-syntax' settings. It should not
+match file names at root of the underlying local file system,
+like \"/sys\" or \"/C:\".")
(defun tramp-autoload-file-name-handler (operation &rest args) "\
-Load Tramp file name handler, and perform OPERATION." (let ((default-directory temporary-file-directory)) (load "tramp" (quote noerror) (quote nomessage))) (apply operation args))
+Load Tramp file name handler, and perform OPERATION." (if tramp-mode (let ((default-directory temporary-file-directory)) (load "tramp" (quote noerror) (quote nomessage))) (tramp-unload-file-name-handlers)) (apply operation args))
(defun tramp-register-autoload-file-name-handlers nil "\
-Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list (quote file-name-handler-alist) (cons tramp-initial-file-name-regexp (quote tramp-autoload-file-name-handler))) (put (quote tramp-autoload-file-name-handler) (quote safe-magic) t) (add-to-list (quote file-name-handler-alist) (cons tramp-initial-completion-file-name-regexp (quote tramp-completion-file-name-handler))) (put (quote tramp-completion-file-name-handler) (quote safe-magic) t) (put (quote tramp-completion-file-name-handler) (quote operations) (mapcar (quote car) tramp-completion-file-name-handler-alist)))
-
-(tramp-register-autoload-file-name-handlers)
+Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list (quote file-name-handler-alist) (cons tramp-autoload-file-name-regexp (quote tramp-autoload-file-name-handler))) (put (quote tramp-autoload-file-name-handler) (quote safe-magic) t))
+ (tramp-register-autoload-file-name-handlers)
-(autoload 'tramp-unload-file-name-handlers "tramp" "\
-Unload Tramp file name handlers from `file-name-handler-alist'.
-
-\(fn)" nil nil)
+(defun tramp-unload-file-name-handlers nil "\
+Unload Tramp file name handlers from `file-name-handler-alist'." (dolist (fnh (quote (tramp-file-name-handler tramp-completion-file-name-handler tramp-autoload-file-name-handler))) (let ((a1 (rassq fnh file-name-handler-alist))) (setq file-name-handler-alist (delq a1 file-name-handler-alist)))))
(defvar tramp-completion-mode nil "\
If non-nil, external packages signal that they are in file name completion.")
@@ -34165,7 +34364,7 @@ Reenable Ange-FTP, when Tramp is unloaded.
;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0))
;;; Generated autoloads from net/trampver.el
-(push (purecopy '(tramp 2 3 2 -1)) package--builtin-versions)
+(push (purecopy '(tramp 2 3 3 -1)) package--builtin-versions)
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-")))
@@ -35634,7 +35833,7 @@ When called interactively with a prefix argument, prompt for LIMIT.
\(fn &optional LIMIT)" t nil)
(autoload 'vc-print-branch-log "vc" "\
-
+Show the change log for BRANCH in a window.
\(fn BRANCH)" t nil)
@@ -38230,17 +38429,26 @@ Zone out, completely.
;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eldoc.el" "emacs-lisp/float-sup.el"
;;;;;; "emacs-lisp/lisp-mode.el" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el"
;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/syntax.el"
-;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "eshell/em-alias.el"
-;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el"
-;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el"
-;;;;;; "eshell/em-ls.el" "eshell/em-pred.el" "eshell/em-prompt.el"
-;;;;;; "eshell/em-rebind.el" "eshell/em-script.el" "eshell/em-smart.el"
-;;;;;; "eshell/em-term.el" "eshell/em-tramp.el" "eshell/em-unix.el"
-;;;;;; "eshell/em-xtra.el" "facemenu.el" "faces.el" "files.el" "font-core.el"
-;;;;;; "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"
+;;;;;; "emacs-lisp/timer.el" "env.el" "epa-hook.el" "erc/erc-autoaway.el"
+;;;;;; "erc/erc-button.el" "erc/erc-capab.el" "erc/erc-compat.el"
+;;;;;; "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" "erc/erc-ezbounce.el"
+;;;;;; "erc/erc-fill.el" "erc/erc-identd.el" "erc/erc-imenu.el"
+;;;;;; "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" "erc/erc-match.el"
+;;;;;; "erc/erc-menu.el" "erc/erc-netsplit.el" "erc/erc-notify.el"
+;;;;;; "erc/erc-page.el" "erc/erc-pcomplete.el" "erc/erc-replace.el"
+;;;;;; "erc/erc-ring.el" "erc/erc-services.el" "erc/erc-sound.el"
+;;;;;; "erc/erc-speedbar.el" "erc/erc-spelling.el" "erc/erc-stamp.el"
+;;;;;; "erc/erc-track.el" "erc/erc-truncate.el" "erc/erc-xdcc.el"
+;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el"
+;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el"
+;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el"
+;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el"
+;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-tramp.el"
+;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "facemenu.el" "faces.el"
+;;;;;; "files.el" "font-core.el" "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"
diff --git a/lisp/leim/quail/arabic.el b/lisp/leim/quail/arabic.el
index 22d61172177..b027d4019fe 100644
--- a/lisp/leim/quail/arabic.el
+++ b/lisp/leim/quail/arabic.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/croatian.el b/lisp/leim/quail/croatian.el
index 7ebf8758aa6..a9b1ca85165 100644
--- a/lisp/leim/quail/croatian.el
+++ b/lisp/leim/quail/croatian.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/cyril-jis.el b/lisp/leim/quail/cyril-jis.el
index 609b6015686..210fe97f5a3 100644
--- a/lisp/leim/quail/cyril-jis.el
+++ b/lisp/leim/quail/cyril-jis.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el
index 600193ddc18..2218095f880 100644
--- a/lisp/leim/quail/cyrillic.el
+++ b/lisp/leim/quail/cyrillic.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -831,6 +831,120 @@ Sorry, but `ghe with upturn' is not included in ISO 8859-5."
("|" ?Ґ))
;;
+(quail-define-package
+ "uzbek-cyrillic" "Ўзбекча" "Ўзб" nil
+ "ЙЦУКЕН Uzbek computer layout"
+ nil t t t t nil nil nil nil nil t)
+
+;; Ё 1! 2" 3№ 4; 5% 6: 7? 8* 9( 0) Ғ Ҳ
+;; Й Ц У К Е Н Г Ш Ў З Х Ъ \|
+;; Ф Қ В А П Р О Л Д Ж Э
+;; Я Ч С М И Т Ь Б Ю .,
+
+(quail-define-rules
+ ("`" ?ё)
+ ("1" ?1)
+ ("2" ?2)
+ ("3" ?3)
+ ("4" ?4)
+ ("5" ?5)
+ ("6" ?6)
+ ("7" ?7)
+ ("8" ?8)
+ ("9" ?9)
+ ("0" ?0)
+ ("-" ?ғ)
+ ("=" ?ҳ)
+
+ ("q" ?й)
+ ("w" ?ц)
+ ("e" ?у)
+ ("r" ?к)
+ ("t" ?е)
+ ("y" ?н)
+ ("u" ?г)
+ ("i" ?ш)
+ ("o" ?ў)
+ ("p" ?з)
+ ("[" ?х)
+ ("]" ?ъ)
+ ("\\" ?\\)
+
+ ("a" ?ф)
+ ("s" ?қ)
+ ("d" ?в)
+ ("f" ?а)
+ ("g" ?п)
+ ("h" ?р)
+ ("j" ?о)
+ ("k" ?л)
+ ("l" ?д)
+ (";" ?ж)
+ ("'" ?э)
+
+ ("z" ?я)
+ ("x" ?ч)
+ ("c" ?с)
+ ("v" ?м)
+ ("b" ?и)
+ ("n" ?т)
+ ("m" ?ь)
+ ("," ?б)
+ ("." ?ю)
+ ("/" ?.)
+
+ ("~" ?Ё)
+ ("!" ?!)
+ ("@" ?\")
+ ("#" ?№)
+ ("$" ?\;)
+ ("%" ?%)
+ ("^" ?:)
+ ("&" ??)
+ ("*" ?*)
+ ("(" ?\()
+ (")" ?\))
+ ("_" ?Ғ)
+ ("+" ?Ҳ)
+
+ ("Q" ?Й)
+ ("W" ?Ц)
+ ("E" ?У)
+ ("R" ?К)
+ ("T" ?Е)
+ ("Y" ?Н)
+ ("U" ?Г)
+ ("I" ?Ш)
+ ("O" ?Ў)
+ ("P" ?З)
+ ("{" ?Х)
+ ("}" ?Ъ)
+ ("|" ?|)
+
+ ("A" ?Ф)
+ ("S" ?Қ)
+ ("D" ?В)
+ ("F" ?А)
+ ("G" ?П)
+ ("H" ?Р)
+ ("J" ?О)
+ ("K" ?Л)
+ ("L" ?Д)
+ (":" ?Ж)
+ ("\"" ?Э)
+
+ ("Z" ?Я)
+ ("X" ?Ч)
+ ("C" ?С)
+ ("V" ?М)
+ ("B" ?И)
+ ("N" ?Т)
+ ("M" ?Ь)
+ ("<" ?Б)
+ (">" ?Ю)
+ ("?" ?,))
+
+
;; Alexander Mikhailian says this is of limited use. It has been
;; popular among emigrants or foreigners who have to type in Cyrillic
;; (mostly Russian) from time to time.
diff --git a/lisp/leim/quail/czech.el b/lisp/leim/quail/czech.el
index 762d702f435..26f30f36ec6 100644
--- a/lisp/leim/quail/czech.el
+++ b/lisp/leim/quail/czech.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el
index eaf3a03bafa..8d19a233709 100644
--- a/lisp/leim/quail/ethiopic.el
+++ b/lisp/leim/quail/ethiopic.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
diff --git a/lisp/leim/quail/georgian.el b/lisp/leim/quail/georgian.el
index df297156592..bc3b5d2f6d1 100644
--- a/lisp/leim/quail/georgian.el
+++ b/lisp/leim/quail/georgian.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/greek.el b/lisp/leim/quail/greek.el
index 05351e0e556..d1414abddcd 100644
--- a/lisp/leim/quail/greek.el
+++ b/lisp/leim/quail/greek.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el
index 782d8d50a72..5d509c96e8a 100644
--- a/lisp/leim/quail/hangul.el
+++ b/lisp/leim/quail/hangul.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/hanja-jis.el b/lisp/leim/quail/hanja-jis.el
index 2c7eebb8345..79730b816ef 100644
--- a/lisp/leim/quail/hanja-jis.el
+++ b/lisp/leim/quail/hanja-jis.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/hanja.el b/lisp/leim/quail/hanja.el
index 8c00ad1bbf7..9c659e224ea 100644
--- a/lisp/leim/quail/hanja.el
+++ b/lisp/leim/quail/hanja.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/hanja3.el b/lisp/leim/quail/hanja3.el
index c140f902235..0b58f6762df 100644
--- a/lisp/leim/quail/hanja3.el
+++ b/lisp/leim/quail/hanja3.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/hebrew.el b/lisp/leim/quail/hebrew.el
index d90b362407b..772da70b5ce 100644
--- a/lisp/leim/quail/hebrew.el
+++ b/lisp/leim/quail/hebrew.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 8f549ae226b..c1a9b2e4f84 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el
index 42bc2010cb9..2c1c8df5f0d 100644
--- a/lisp/leim/quail/ipa-praat.el
+++ b/lisp/leim/quail/ipa-praat.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el
index 6f0368c9811..e513c5f0552 100644
--- a/lisp/leim/quail/ipa.el
+++ b/lisp/leim/quail/ipa.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index 98865aceb74..2d39d5e2fd9 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/lao.el b/lisp/leim/quail/lao.el
index 14cf9268287..af3b5892629 100644
--- a/lisp/leim/quail/lao.el
+++ b/lisp/leim/quail/lao.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el
index 6c0dab28b41..a6a5ac84592 100644
--- a/lisp/leim/quail/latin-alt.el
+++ b/lisp/leim/quail/latin-alt.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Author (of latin-post.el): TAKAHASHI Naoto <ntakahas@etl.go.jp>
@@ -1152,7 +1152,7 @@ Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^
(quail-define-package
"dutch" "Dutch" "NL" t
"Dutch character mixfix input method.
-Caters for French and Turkish as well as Dutch.
+Caters for French and Dutch.
| | examples
------------+---------+----------
@@ -1163,8 +1163,6 @@ Caters for French and Turkish as well as Dutch.
acute | \\=' | a\\=' -> á
grave | \\=` | a\\=` -> à
circumflex | ^ | a^ -> â
- Turkish | various | i/ -> ı s, -> ş g^ -> ğ I/ -> İ
- | | S, -> Ş G^ -> Ğ
------------+---------+----------
| prefix |
------------+---------+----------
@@ -1176,9 +1174,6 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
(quail-define-rules
("fl." ?ƒ) ;; LATIN SMALL LETTER F WITH HOOK (florin currency symbol)
("eur." ?€) ;; EURO SIGN
- ;; “The 25th letter of the Dutch alphabet.”
- ("ij" ?ij) ;; LATIN SMALL LIGATURE IJ
- ("IJ" ?IJ) ;; LATIN CAPITAL LIGATURE IJ
;; “Trema on the second letter of vowel pair.” Yudit uses `:', not `"'.
("\"a" ?ä) ;; LATIN SMALL LETTER A WITH DIAERESIS
("\"e" ?ë) ;; LATIN SMALL LETTER E WITH DIAERESIS
@@ -1226,15 +1221,6 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\='
("I^" ?Î) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX
("O^" ?Ô) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX
("U^" ?Û) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX
- ;; “Follow the example of the Dutch POSIX locale, using ISO-8859-9 to
- ;; cater to the many Turks in Dutch society.” Perhaps German methods
- ;; should do so too. Follow turkish-alt-postfix here.
- ("i/" ?ı) ;; LATIN SMALL LETTER I WITH NO DOT
- ("s," ?ş) ;; LATIN SMALL LETTER S WITH CEDILLA
- ("g^" ?ğ) ;; LATIN SMALL LETTER G WITH BREVE
- ("I/" ?İ) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE
- ("S," ?Ş) ;; LATIN CAPITAL LETTER S WITH CEDILLA
- ("G^" ?Ğ) ;; LATIN CAPITAL LETTER G WITH BREVE
)
;; Originally from Yudit, discussed with Albertas Agejevas
diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el
index 6c5afcd4f93..313de991d89 100644
--- a/lisp/leim/quail/latin-ltx.el
+++ b/lisp/leim/quail/latin-ltx.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -75,20 +75,20 @@ system, including many technical ones. Examples:
(`(,seq ,re)
(let ((count 0)
(re (eval re t)))
- (dolist (pair (ucs-names))
- (let ((name (car pair))
- (char (cdr pair)))
- (when (and (characterp char) ;; Ignore char-ranges.
- (string-match re name))
- (let ((keys (if (stringp seq)
- (replace-match seq nil nil name)
- (funcall seq name char))))
- (if (listp keys)
- (dolist (x keys)
- (setq count (1+ count))
- (push (list x char) newrules))
- (setq count (1+ count))
- (push (list keys char) newrules))))))
+ (maphash
+ (lambda (name char)
+ (when (and (characterp char) ;; Ignore char-ranges.
+ (string-match re name))
+ (let ((keys (if (stringp seq)
+ (replace-match seq nil nil name)
+ (funcall seq name char))))
+ (if (listp keys)
+ (dolist (x keys)
+ (setq count (1+ count))
+ (push (list x char) newrules))
+ (setq count (1+ count))
+ (push (list keys char) newrules)))))
+ (ucs-names))
;; (message "latin-ltx: %d mappings for %S" count re)
))))
(setq newrules (delete-dups newrules))
@@ -206,7 +206,7 @@ system, including many technical ones. Examples:
((lambda (name char)
(let* ((base (concat (match-string 1 name) (match-string 3 name)))
- (basechar (cdr (assoc base (ucs-names)))))
+ (basechar (gethash base (ucs-names))))
(when (latin-ltx--ascii-p basechar)
(string (if (match-end 2) ?^ ?_) basechar))))
"\\(.*\\)SU\\(?:B\\|\\(PER\\)\\)SCRIPT \\(.*\\)")
@@ -547,7 +547,7 @@ system, including many technical ones. Examples:
("\\propto" ?∝)
("\\qed" ?∎)
("\\quad" ? )
- ("\\rangle" ?⟩) ;; Was ?〉, see bug#12948.
+ ("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948.
("\\rbrace" ?})
("\\rbrack" ?\])
("\\rceil" ?⌉)
@@ -739,8 +739,8 @@ system, including many technical ones. Examples:
("\\textdiscount" ?⁒)
("\\textestimated" ?℮)
("\\textopenbullet" ?◦)
- ("\\textlquill" ?⁅)
- ("\\textrquill" ?⁆)
+ ("\\textlquill" ?\⁅)
+ ("\\textrquill" ?\⁆)
("\\textcircledP" ?℗)
("\\textreferencemark" ?※)
)
diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el
index a5564483ee2..238b0efc093 100644
--- a/lisp/leim/quail/latin-post.el
+++ b/lisp/leim/quail/latin-post.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Author: TAKAHASHI Naoto <ntakahas@etl.go.jp>
diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el
index 9e4726abffb..ca9c5f6e467 100644
--- a/lisp/leim/quail/latin-pre.el
+++ b/lisp/leim/quail/latin-pre.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el
index d3cfce68634..bad41559528 100644
--- a/lisp/leim/quail/lrt.el
+++ b/lisp/leim/quail/lrt.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el
index 56ba145daf6..093d30665da 100644
--- a/lisp/leim/quail/persian.el
+++ b/lisp/leim/quail/persian.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -215,7 +215,7 @@
(">" ?<)
("?" ?؟)
- ;; Level 3 Entered with \
+ ;; Level 3 Entered with \
;;
("\\" ?\\) ;; خط اريب وارو
("\\\\" ?\\)
diff --git a/lisp/leim/quail/programmer-dvorak.el b/lisp/leim/quail/programmer-dvorak.el
index 1dc8edc1efb..00d9a3c594d 100644
--- a/lisp/leim/quail/programmer-dvorak.el
+++ b/lisp/leim/quail/programmer-dvorak.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/py-punct.el b/lisp/leim/quail/py-punct.el
index 9fe06c07c01..39809af14b3 100644
--- a/lisp/leim/quail/py-punct.el
+++ b/lisp/leim/quail/py-punct.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/pypunct-b5.el b/lisp/leim/quail/pypunct-b5.el
index 37c12659cc3..ef5863101d2 100644
--- a/lisp/leim/quail/pypunct-b5.el
+++ b/lisp/leim/quail/pypunct-b5.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/rfc1345.el b/lisp/leim/quail/rfc1345.el
index 74f7d095653..5b66d91b5a6 100644
--- a/lisp/leim/quail/rfc1345.el
+++ b/lisp/leim/quail/rfc1345.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/sgml-input.el b/lisp/leim/quail/sgml-input.el
index c334b51cb4d..7383683120c 100644
--- a/lisp/leim/quail/sgml-input.el
+++ b/lisp/leim/quail/sgml-input.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el
index 8a1ddcff1e0..bbc251ab553 100644
--- a/lisp/leim/quail/sisheng.el
+++ b/lisp/leim/quail/sisheng.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el
index 817dcd08c4b..779f9b0c282 100644
--- a/lisp/leim/quail/slovak.el
+++ b/lisp/leim/quail/slovak.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el
index 31e839bfe82..70a54c7be63 100644
--- a/lisp/leim/quail/symbol-ksc.el
+++ b/lisp/leim/quail/symbol-ksc.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; 94.10.24 Written for Mule Ver.2.0 (koaunghi.un@zdv.uni-tuebingen.de)
;;; 94.11.04 Updated for Mule Ver.2.1 (koaunghi.un@zdv.uni-tuebingen.de)
diff --git a/lisp/leim/quail/tamil-dvorak.el b/lisp/leim/quail/tamil-dvorak.el
index a625d900015..d080f7e5968 100644
--- a/lisp/leim/quail/tamil-dvorak.el
+++ b/lisp/leim/quail/tamil-dvorak.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/thai.el b/lisp/leim/quail/thai.el
index 02f8b78d76b..7cf11daf9d0 100644
--- a/lisp/leim/quail/thai.el
+++ b/lisp/leim/quail/thai.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
index 4e1c5b51c52..8971b1ddf79 100644
--- a/lisp/leim/quail/tibetan.el
+++ b/lisp/leim/quail/tibetan.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Author: Toru TOMABECHI <Toru.Tomabechi@orient.unil.ch>
diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el
index 595155e026b..744edc61470 100644
--- a/lisp/leim/quail/uni-input.el
+++ b/lisp/leim/quail/uni-input.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/viqr.el b/lisp/leim/quail/viqr.el
index 879fba4da2c..b7591b15e05 100644
--- a/lisp/leim/quail/viqr.el
+++ b/lisp/leim/quail/viqr.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/vntelex.el b/lisp/leim/quail/vntelex.el
index 074b806bd41..210e26ad18d 100644
--- a/lisp/leim/quail/vntelex.el
+++ b/lisp/leim/quail/vntelex.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el
index 5d21030a524..327ebb847b5 100644
--- a/lisp/leim/quail/vnvni.el
+++ b/lisp/leim/quail/vnvni.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/leim/quail/welsh.el b/lisp/leim/quail/welsh.el
index 7b0ca2c2dfe..c524139d2e1 100644
--- a/lisp/leim/quail/welsh.el
+++ b/lisp/leim/quail/welsh.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/linum.el b/lisp/linum.el
index 9cfb94dab68..3bee384708f 100644
--- a/lisp/linum.el
+++ b/lisp/linum.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 28d0b18c812..5d42ed958e5 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -162,6 +162,70 @@ documentation of `unload-feature' for details.")
;; mode, or proposed is not nil and not major-mode, and so we use it.
(funcall (or proposed 'fundamental-mode)))))))
+(cl-defgeneric loadhist-unload-element (x)
+ "Unload an element from the `load-history'."
+ (message "Unexpected element %S in load-history" x))
+
+;; In `load-history', the definition of a previously autoloaded
+;; function is represented by 2 entries: (t . SYMBOL) comes before
+;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when
+;; we undefine it.
+;; So we use this auxiliary variable to keep track of the last (t . SYMBOL)
+;; that occurred.
+(defvar loadhist--restore-autoload
+ "If non-nil, this is a symbol for which we should
+restore a previous autoload if possible.")
+
+(cl-defmethod loadhist-unload-element ((x (head t)))
+ (setq loadhist--restore-autoload (cdr x)))
+
+(defun loadhist--unload-function (x)
+ (let ((fun (cdr x)))
+ (when (fboundp fun)
+ (when (fboundp 'ad-unadvise)
+ (ad-unadvise fun))
+ (let ((aload (get fun 'autoload)))
+ (defalias fun
+ (if (and aload (eq fun loadhist--restore-autoload))
+ (cons 'autoload aload)
+ nil)))))
+ (setq loadhist--restore-autoload nil))
+
+(cl-defmethod loadhist-unload-element ((x (head defun)))
+ (loadhist--unload-function x))
+(cl-defmethod loadhist-unload-element ((x (head autoload)))
+ (loadhist--unload-function x))
+
+(cl-defmethod loadhist-unload-element ((_ (head require))) nil)
+(cl-defmethod loadhist-unload-element ((_ (head defface))) nil)
+
+(cl-defmethod loadhist-unload-element ((x (head provide)))
+ ;; Remove any feature names that this file provided.
+ (setq features (delq (cdr x) features)))
+
+(cl-defmethod loadhist-unload-element ((x symbol))
+ ;; Kill local values as much as possible.
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (if (and (boundp x) (timerp (symbol-value x)))
+ (cancel-timer (symbol-value x)))
+ (kill-local-variable x)))
+ (if (and (boundp x) (timerp (symbol-value x)))
+ (cancel-timer (symbol-value x)))
+ ;; Get rid of the default binding if we can.
+ (unless (local-variable-if-set-p x)
+ (makunbound x)))
+
+(cl-defmethod loadhist-unload-element ((x (head define-type)))
+ (let* ((name (cdr x)))
+ ;; Remove the struct.
+ (setf (cl--find-class name) nil)))
+
+(cl-defmethod loadhist-unload-element ((x (head define-symbol-props)))
+ (pcase-dolist (`(,symbol . ,props) (cdr x))
+ (dolist (prop props)
+ (put symbol prop nil))))
+
;;;###autoload
(defun unload-feature (feature &optional force)
"Unload the library that provided FEATURE.
@@ -200,9 +264,6 @@ something strange, such as redefining an Emacs function."
(prin1-to-string dependents) file))))
(let* ((unload-function-defs-list (feature-symbols feature))
(file (pop unload-function-defs-list))
- ;; If non-nil, this is a symbol for which we should
- ;; restore a previous autoload if possible.
- restore-autoload
(name (symbol-name feature))
(unload-hook (intern-soft (concat name "-unload-hook")))
(unload-func (intern-soft (concat name "-unload-function"))))
@@ -245,43 +306,7 @@ something strange, such as redefining an Emacs function."
;; Change major mode in all buffers using one defined in the feature being unloaded.
(unload--set-major-mode)
- (when (fboundp 'elp-restore-function) ; remove ELP stuff first
- (dolist (elt unload-function-defs-list)
- (when (symbolp elt)
- (elp-restore-function elt))))
-
- (dolist (x unload-function-defs-list)
- (if (consp x)
- (pcase (car x)
- ;; Remove any feature names that this file provided.
- (`provide
- (setq features (delq (cdr x) features)))
- ((or `defun `autoload)
- (let ((fun (cdr x)))
- (when (fboundp fun)
- (when (fboundp 'ad-unadvise)
- (ad-unadvise fun))
- (let ((aload (get fun 'autoload)))
- (if (and aload (eq fun restore-autoload))
- (fset fun (cons 'autoload aload))
- (fmakunbound fun))))))
- ;; (t . SYMBOL) comes before (defun . SYMBOL)
- ;; and says we should restore SYMBOL's autoload
- ;; when we undefine it.
- (`t (setq restore-autoload (cdr x)))
- ((or `require `defface) nil)
- (_ (message "Unexpected element %s in load-history" x)))
- ;; Kill local values as much as possible.
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (if (and (boundp x) (timerp (symbol-value x)))
- (cancel-timer (symbol-value x)))
- (kill-local-variable x)))
- (if (and (boundp x) (timerp (symbol-value x)))
- (cancel-timer (symbol-value x)))
- ;; Get rid of the default binding if we can.
- (unless (local-variable-if-set-p x)
- (makunbound x))))
+ (mapc #'loadhist-unload-element unload-function-defs-list)
;; Delete the load-history element for this file.
(setq load-history (delq (assoc file load-history) load-history))))
;; Don't return load-history, it is not useful.
diff --git a/lisp/loadup.el b/lisp/loadup.el
index af42cd97111..40e5651aa1d 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -76,6 +76,7 @@
(setq max-lisp-eval-depth 2200)
(setq load-path (list (expand-file-name "." dir)
(expand-file-name "emacs-lisp" dir)
+ (expand-file-name "progmodes" dir)
(expand-file-name "language" dir)
(expand-file-name "international" dir)
(expand-file-name "textmodes" dir)
@@ -337,7 +338,7 @@
;; We reset load-path after dumping.
;; For a permanent change in load-path, use configure's
;; --enable-locallisppath option.
- ;; See http://debbugs.gnu.org/16107 for more details.
+ ;; See https://debbugs.gnu.org/16107 for more details.
(or (equal lp load-path)
(message "Warning: Change in load-path due to site-load will be \
lost after dumping")))
diff --git a/lisp/locate.el b/lisp/locate.el
index 738c333ac2d..20b05c234f6 100644
--- a/lisp/locate.el
+++ b/lisp/locate.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/lpr.el b/lisp/lpr.el
index 4c8dc2c3e75..b0a6e94975f 100644
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
index 7ae23434415..ad2a770430f 100644
--- a/lisp/ls-lisp.el
+++ b/lisp/ls-lisp.el
@@ -1,4 +1,4 @@
-;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
+;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -*- lexical-binding: t -*-
;; Copyright (C) 1992, 1994, 2000-2017 Free Software Foundation, Inc.
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -60,6 +60,8 @@
;;; Code:
+
+
(defgroup ls-lisp nil
"Emulate the ls program completely in Emacs Lisp."
:version "21.1"
@@ -245,11 +247,11 @@ to fail to line up, e.g. if month names are not all of the same length."
"Format to display integer GIDs.")
(defvar ls-lisp-gid-s-fmt " %s"
"Format to display user group names.")
-(defvar ls-lisp-filesize-d-fmt "%d"
+(defvar ls-lisp-filesize-d-fmt " %d"
"Format to display integer file sizes.")
-(defvar ls-lisp-filesize-f-fmt "%.0f"
+(defvar ls-lisp-filesize-f-fmt " %.0f"
"Format to display float file sizes.")
-(defvar ls-lisp-filesize-b-fmt "%.0f"
+(defvar ls-lisp-filesize-b-fmt " %.0f"
"Format to display file sizes in blocks (for the -s switch).")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -477,6 +479,34 @@ not contain `d', so that a full listing is expected."
(message "%s: doesn't exist or is inaccessible" file)
(ding) (sit-for 2))))) ; to show user the message!
+(declare-function dired-read-dir-and-switches "dired" (str))
+(declare-function dired-goto-next-file "dired" ())
+
+(defun ls-lisp--dired (orig-fun dir-or-list &optional switches)
+ (interactive (dired-read-dir-and-switches ""))
+ (if (consp dir-or-list)
+ (funcall orig-fun dir-or-list switches)
+ (let ((dir-wildcard (insert-directory-wildcard-in-dir-p
+ (expand-file-name dir-or-list))))
+ (if (not dir-wildcard)
+ (funcall orig-fun dir-or-list switches)
+ (let* ((default-directory (car dir-wildcard))
+ (files (file-expand-wildcards (cdr dir-wildcard)))
+ (dir (car dir-wildcard)))
+ (if files
+ (let ((inhibit-read-only t)
+ (buf
+ (apply orig-fun (nconc (list dir) files) (and switches (list switches)))))
+ (with-current-buffer buf
+ (save-excursion
+ (goto-char (point-min))
+ (dired-goto-next-file)
+ (forward-line 0)
+ (insert " wildcard " (cdr dir-wildcard) "\n"))))
+ (user-error "No files matching regexp")))))))
+
+(advice-add 'dired :around #'ls-lisp--dired)
+
(defun ls-lisp-sanitize (file-alist)
"Sanitize the elements in FILE-ALIST.
Fixes any elements in the alist for directory entries whose file
@@ -537,6 +567,8 @@ Responds to the window width as ls should but may not!"
(setq list (cdr list)))
result))
+(defvar w32-collate-ignore-punctuation) ; Declare for non-w32 builds.
+
(defsubst ls-lisp-string-lessp (s1 s2)
"Return t if string S1 should sort before string S2.
Case is significant if `ls-lisp-ignore-case' is nil.
@@ -681,23 +713,26 @@ SWITCHES is a list of characters. Default sorting is alphabetic."
(defun ls-lisp-classify-file (filename fattr)
"Append a character to FILENAME indicating the file type.
+This function puts the `dired-filename' property on FILENAME, but
+not on the character indicator it appends.
FATTR is the file attributes returned by `file-attributes' for the file.
The file type indicators are `/' for directories, `@' for symbolic
links, `|' for FIFOs, `=' for sockets, `*' for regular files that
are executable, and nothing for other types of files."
(let* ((type (car fattr))
(modestr (nth 8 fattr))
- (typestr (substring modestr 0 1)))
+ (typestr (substring modestr 0 1))
+ (file-name (propertize filename 'dired-filename t)))
(cond
(type
- (concat filename (if (eq type t) "/" "@")))
+ (concat file-name (if (eq type t) "/" "@")))
((string-match "x" modestr)
- (concat filename "*"))
+ (concat file-name "*"))
((string= "p" typestr)
- (concat filename "|"))
+ (concat file-name "|"))
((string= "s" typestr)
- (concat filename "="))
- (t filename))))
+ (concat file-name "="))
+ (t file-name))))
(defun ls-lisp-classify (filedata)
"Append a character to file name in FILEDATA indicating the file type.
@@ -710,7 +745,6 @@ links, `|' for FIFOs, `=' for sockets, `*' for regular files that
are executable, and nothing for other types of files."
(let ((file-name (car filedata))
(fattr (cdr filedata)))
- (setq file-name (propertize file-name 'dired-filename t))
(cons (ls-lisp-classify-file file-name fattr) fattr)))
(defun ls-lisp-extension (filename)
@@ -809,7 +843,7 @@ SWITCHES and TIME-INDEX give the full switch list and time data."
" "
(ls-lisp-format-time file-attr time-index)
" "
- (if (not (memq ?F switches)) ; ls-lisp-classify already did that
+ (if (not (memq ?F switches)) ; ls-lisp-classify-file already did that
(propertize file-name 'dired-filename t)
file-name)
(if (stringp file-type) ; is a symbolic link
@@ -831,7 +865,7 @@ Use the same method as ls to decide whether to show time-of-day or year,
depending on distance between file date and the current time.
All ls time options, namely c, t and u, are handled."
(let* ((time (nth (or time-index 5) file-attr)) ; default is last modtime
- (diff (- (float-time time) (float-time)))
+ (diff (time-subtract time nil))
;; Consider a time to be recent if it is within the past six
;; months. A Gregorian year has 365.2425 * 24 * 60 * 60 ==
;; 31556952 seconds on the average, and half of that is 15778476.
@@ -848,7 +882,8 @@ All ls time options, namely c, t and u, are handled."
(if (member locale '("C" "POSIX"))
(setq locale nil))
(format-time-string
- (if (and (<= past-cutoff diff) (<= diff 0))
+ (if (and (not (time-less-p diff past-cutoff))
+ (not (time-less-p 0 diff)))
(if (and locale (not ls-lisp-use-localized-time-format))
"%m-%d %H:%M"
(nth 0 ls-lisp-format-time-list))
@@ -866,6 +901,13 @@ All ls time options, namely c, t and u, are handled."
file-size)
(format " %6s" (file-size-human-readable file-size))))
+(defun ls-lisp-unload-function ()
+ "Unload ls-lisp library."
+ (advice-remove 'insert-directory #'ls-lisp--insert-directory)
+ (advice-remove 'dired #'ls-lisp--dired)
+ ;; Continue standard unloading.
+ nil)
+
(provide 'ls-lisp)
;;; ls-lisp.el ends here
diff --git a/lisp/macros.el b/lisp/macros.el
index fc65489fe65..5583c02f68b 100644
--- a/lisp/macros.el
+++ b/lisp/macros.el
@@ -1,4 +1,4 @@
-;;; macros.el --- non-primitive commands for keyboard macros
+;;; macros.el --- non-primitive commands for keyboard macros -*- lexical-binding:t -*-
;; Copyright (C) 1985-1987, 1992, 1994-1995, 2001-2017 Free Software
;; Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -31,23 +31,10 @@
;;; Code:
+(require 'kmacro)
+
;;;###autoload
-(defun name-last-kbd-macro (symbol)
- "Assign a name to the last keyboard macro defined.
-Argument SYMBOL is the name to define.
-The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid editor command."
- (interactive "SName for last kbd macro: ")
- (or last-kbd-macro
- (user-error "No keyboard macro defined"))
- (and (fboundp symbol)
- (not (stringp (symbol-function symbol)))
- (not (vectorp (symbol-function symbol)))
- (user-error "Function %s is already defined and not a keyboard macro"
- symbol))
- (if (string-equal symbol "")
- (user-error "No command name given"))
- (fset symbol last-kbd-macro))
+(defalias 'name-last-kbd-macro #'kmacro-name-last-macro)
;;;###autoload
(defun insert-kbd-macro (macroname &optional keys)
@@ -66,11 +53,7 @@ To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
use this command, and then save the file."
(interactive (list (intern (completing-read "Insert kbd macro (name): "
obarray
- (lambda (elt)
- (and (fboundp elt)
- (or (stringp (symbol-function elt))
- (vectorp (symbol-function elt))
- (get elt 'kmacro))))
+ #'kmacro-keyboard-macro-p
t))
current-prefix-arg))
(let (definition)
@@ -137,6 +120,9 @@ use this command, and then save the file."
(prin1 char (current-buffer))
(princ (prin1-char char) (current-buffer))))
(insert ?\]))
+ ;; FIXME: For kmacros, we shouldn't write the (lambda ...)
+ ;; gunk but instead we should write something more abstract like
+ ;; (kmacro-create [<keys>] 0 "%d").
(prin1 definition (current-buffer))))
(insert ")\n")
(if keys
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el
index 1d6828b44bb..f055215a8c6 100644
--- a/lisp/mail/binhex.el
+++ b/lisp/mail/binhex.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index fc3b9618d68..c5e634607a3 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index c1aec6923fb..92f39659360 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -179,7 +179,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
'action (lambda (button)
- (browse-url "http://lists.gnu.org/archive/html/bug-gnu-emacs/"))
+ (browse-url "https://lists.gnu.org/r/bug-gnu-emacs/"))
'follow-link t)
(insert " mailing list\nand the GNU bug tracker at ")
(insert-text-button
@@ -187,7 +187,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
'face 'link
'help-echo (concat "mouse-2, RET: Follow this link")
'action (lambda (button)
- (browse-url "http://debbugs.gnu.org/"))
+ (browse-url "https://debbugs.gnu.org/"))
'follow-link t)
(insert ". Please check that
diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el
index 860d353002c..130e1640572 100644
--- a/lisp/mail/flow-fill.el
+++ b/lisp/mail/flow-fill.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 07e24bd78be..5e18d892d4a 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index 71567b4c0fd..ff00ce4069e 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index fd793a28309..86496beb0fd 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 180d195d553..81af0d541cf 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index b056739c655..b525d8972c3 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index 0578b98c933..49df82c38b0 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mail-prsvr.el b/lisp/mail/mail-prsvr.el
index 07f650942c0..9703e47fc30 100644
--- a/lisp/mail/mail-prsvr.el
+++ b/lisp/mail/mail-prsvr.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index c23af873650..0164ffdc46f 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 4e3a3f9d118..ef0e40f0201 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 8f3f901c22a..56fdd26b383 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 88624199df7..102730f476a 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index bceba77c46d..b388c32c73b 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el
index 4e0802804f4..e4886eabe61 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/mail/metamail.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 21856c325c7..13a39e52119 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el
index 262191db4ac..9533697c778 100644
--- a/lisp/mail/qp.el
+++ b/lisp/mail/qp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index b13da94c407..6cb5e4a8873 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rfc2045.el b/lisp/mail/rfc2045.el
index 11a6151887a..f5185d22f74 100644
--- a/lisp/mail/rfc2045.el
+++ b/lisp/mail/rfc2045.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; RFC 2045 is: "Multipurpose Internet Mail Extensions (MIME) Part
;; One: Format of Internet Message Bodies".
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index e2af86b3246..0c93331de8b 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index 66f539f6986..e27113a9e39 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 6cb243ce5c1..3f09f87f1b3 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index 5edcef54284..e8bbea32573 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index 648aa22aaa5..dee2d1c5133 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; -----------
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index df07140d87b..994570edcb2 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -278,7 +278,7 @@ Otherwise, look for `movemail' in the directories in
;; rmail-insert-inbox-text before r1.439 fell back to using
;; (expand-file-name "movemail" exec-directory) and just
;; assuming it would work.
- ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00087.html
+ ;; https://lists.gnu.org/r/bug-gnu-emacs/2008-02/msg00087.html
(let ((progname (expand-file-name
(concat "movemail"
(if (memq system-type '(ms-dos windows-nt))
@@ -534,7 +534,7 @@ still the current message in the Rmail buffer.")
;; It's not clear what it should do now, since there is nothing that
;; records when a message is shown for the first time (unseen is not
;; necessarily the same thing).
-;; See http://lists.gnu.org/archive/html/emacs-devel/2009-03/msg00013.html
+;; See https://lists.gnu.org/r/emacs-devel/2009-03/msg00013.html
(defcustom rmail-message-filter nil
"If non-nil, a filter function for new messages in RMAIL.
Called with region narrowed to the message, including headers,
@@ -2828,8 +2828,6 @@ 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))
- (setq showing-message t)
- (message "Showing message %d..." msg)
(set (make-local-variable 'rmail-mime-decoded) t)
(funcall rmail-show-mime-function))
(setq body-start (search-forward "\n\n" nil t))
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index df1577fa915..640febd0473 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -188,10 +188,6 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(beginning-of-line)
(insert ">")
(forward-line)))
- ;; Make sure buffer ends with a blank line so as not to run this
- ;; message together with the following one.
- (goto-char (point-max))
- (rmail-ensure-blank-line)
(let ((old rmail-old-text)
(pruned rmail-old-pruned)
(mime-state rmail-old-mime-state)
@@ -224,10 +220,9 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(setq old nil)
(goto-char (point-min))
(search-forward "\n\n")
- (setq headers-end (point-marker))
- (goto-char (point-min))
+ (setq headers-end (point-marker)) ; first character of body
(save-restriction
- (narrow-to-region (point) headers-end)
+ (narrow-to-region (point-min) headers-end)
;; If they changed the message's encoding, rewrite the charset=
;; header for them, so that subsequent rmail-show-message
;; decodes it correctly.
@@ -240,6 +235,38 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
'us-ascii
new-coding))))
old-coding mime-beg mime-end content-type)
+ ;; If there's no content-type in the edited headers, look for one
+ ;; in the original headers and add it to the edited headers
+ ;; (Bug #26918)
+ (unless (mail-fetch-field "Content-Type")
+ (let (old-content-type
+ (msgbeg (rmail-msgbeg rmail-current-message))
+ (msgend (rmail-msgend rmail-current-message)))
+ (with-current-buffer rmail-view-buffer ; really the mbox buffer
+ (save-restriction
+ (narrow-to-region msgbeg msgend)
+ (goto-char (point-min))
+ (setq limit (search-forward "\n\n"))
+ (narrow-to-region (point-min) limit)
+ (goto-char (point-min))
+ (when (re-search-forward "^content-type:" limit t)
+ (forward-line)
+ (setq old-content-type (buffer-substring
+ (match-beginning 0) (point))))))
+ (when old-content-type
+ (save-excursion
+ (goto-char headers-end) ; first char of body
+ (backward-char) ; add header before second newline
+ (insert old-content-type)
+ ;;Add it to rmail-old-headers as though it had been
+ ;;there originally, to avoid rmail-edit-update-headers
+ ;;an extra copy
+ (let ((header (substring old-content-type 0
+ (length "content-type"))))
+ (unless (assoc header rmail-old-headers)
+ (push (cons header old-content-type) rmail-old-headers)))
+ ))))
+ (goto-char (point-min))
(if (re-search-forward rmail-mime-charset-pattern nil 'move)
(setq mime-beg (match-beginning 1)
mime-end (match-end 1)
@@ -281,29 +308,40 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'.
(setq character-coding (downcase character-coding)))
(goto-char limit)
- (let ((inhibit-read-only t))
- (let ((data-buffer (current-buffer))
- (end (copy-marker (point) t)))
- (with-current-buffer rmail-view-buffer
- (encode-coding-region headers-end (point-max) coding-system
- data-buffer))
- (delete-region end (point-max)))
-
+ (let ((inhibit-read-only t)
+ (data-buffer (current-buffer))
+ (start (copy-marker (point) nil)) ; new body will be between
+ (end (copy-marker (point) t))) ; these two markers
+ (if mime-state
+ ;; Message is already in encoded state
+ (insert-buffer-substring rmail-view-buffer headers-end
+ (with-current-buffer rmail-view-buffer
+ (point-max)))
+ (with-current-buffer rmail-view-buffer
+ (encode-coding-region headers-end (point-max) coding-system
+ data-buffer)))
;; Apply to the mbox buffer any changes in header fields
;; that the user made while editing in the view buffer.
- (rmail-edit-update-headers (rmail-edit-diff-headers
+ (rmail-edit-update-headers (rmail-edit-diff-headers
rmail-old-headers new-headers))
-
;; Re-apply content-transfer-encoding, if any, on the message body.
(cond
+ (mime-state) ; if set, already transfer-encoded
((string= character-coding "quoted-printable")
- (mail-quote-printable-region (point) (point-max)))
+ (mail-quote-printable-region start end))
((and (string= character-coding "base64") is-text-message)
- (base64-encode-region (point) (point-max)))
+ (base64-encode-region start end))
((and (eq character-coding 'uuencode) is-text-message)
- (error "uuencoded messages are not supported"))))
+ (error "uuencoded messages are not supported")))
+ ;; After encoding, make sure buffer ends with a blank line so as not to
+ ;; run this message together with the following one.
+ (goto-char end)
+ (rmail-ensure-blank-line)
+ ;; Delete previous body. This must be after all insertions at the end,
+ ;; so the marker for the beginning of the next message isn't messed up.
+ (delete-region end (point-max)))
(rmail-set-attribute rmail-edited-attr-index t))
- ;;??? BROKEN perhaps.
+;;;??? BROKEN perhaps.
;;; (if (boundp 'rmail-summary-vector)
;;; (aset rmail-summary-vector (1- rmail-current-message) nil))
(rmail-show-message)
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index 761a58f9311..b366e5c71bc 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 1ffd4668ac8..60b2066b2c2 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index ac151f97fa6..b53b95ea52c 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index a2f9320446e..8b918ec6e6c 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index 681a9c4340c..a668d2e0bd8 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 37ac46c6af6..95d9b63f14f 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 12d69aa23c3..cd802115276 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -243,15 +243,6 @@ Used by `mail-yank-original' via `mail-indent-citation'."
:type 'integer
:group 'sendmail)
-(defvar mail-yank-hooks nil
- "Obsolete hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between (point) and (mark t).
-And each hook function should leave point and mark around the citation
-text as modified.
-This is a normal hook, misnamed for historical reasons.
-It is obsolete and mail agents should no longer use it.")
-(make-obsolete-variable 'mail-yank-hooks 'mail-citation-hook "19.34")
-
;;;###autoload
(defcustom mail-citation-hook nil
"Hook for modifying a citation just inserted in the mail buffer.
@@ -1718,8 +1709,6 @@ and don't delete any header fields."
(rfc822-goto-eoh)
(point))))))
(run-hooks 'mail-citation-hook)))
- (mail-yank-hooks
- (run-hooks 'mail-yank-hooks))
(t
(mail-indent-citation)))))
;; This is like exchange-point-and-mark, but doesn't activate the mark.
@@ -1788,9 +1777,7 @@ and don't delete any header fields."
(rfc822-goto-eoh)
(point))))))
(run-hooks 'mail-citation-hook))
- (if mail-yank-hooks
- (run-hooks 'mail-yank-hooks)
- (mail-indent-citation))))))))
+ (mail-indent-citation)))))))
(defun mail-split-line ()
"Split current line, moving portion beyond point vertically down.
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 93bfe0e39d8..aff90d33ed3 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index f3a6e3115bd..4a424ece0b1 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; LCD Archive Entry
;; supercite|Barry A. Warsaw|supercite-help@python.org
@@ -713,7 +713,7 @@ the list should be unique."
;; regi functions
-;; http://lists.gnu.org/archive/html/emacs-devel/2009-02/msg00691.html
+;; https://lists.gnu.org/r/emacs-devel/2009-02/msg00691.html
;; When rmail replies to a message with full headers visible, the "From "
;; line can be included.
(defun sc-mail-check-from ()
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 3dce1c69023..db50c4e6bf6 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 73d7464bc13..77e97c7be91 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 2ff66467478..16e1ba3995f 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el
index e68acbd2b8f..2811b0bf44a 100644
--- a/lisp/mail/uudecode.el
+++ b/lisp/mail/uudecode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mail/yenc.el b/lisp/mail/yenc.el
index c8e2d2c7bcd..b84b16144d3 100644
--- a/lisp/mail/yenc.el
+++ b/lisp/mail/yenc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/makesum.el b/lisp/makesum.el
index 48f51dee4c9..ffebf15db91 100644
--- a/lisp/makesum.el
+++ b/lisp/makesum.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/man.el b/lisp/man.el
index 0e1c92956b3..798e78bbe76 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -278,7 +278,7 @@ Used in `bookmark-set' to get the default bookmark name."
:type 'hook
:group 'man)
-(defvar Man-name-regexp "[-a-zA-Z0-9_­+][-a-zA-Z0-9_.:­+]*"
+(defvar Man-name-regexp "[-[:alnum:]_­+][-[:alnum:]_.:­+]*"
"Regular expression describing the name of a manpage (without section).")
(defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]"
@@ -286,16 +286,16 @@ Used in `bookmark-set' to get the default bookmark name."
(defvar Man-page-header-regexp
(if (string-match "-solaris2\\." system-configuration)
- (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
+ (concat "^[-[:alnum:]_].*[ \t]\\(" Man-name-regexp
"(\\(" Man-section-regexp "\\))\\)$")
(concat "^[ \t]*\\(" Man-name-regexp
"(\\(" Man-section-regexp "\\))\\).*\\1"))
"Regular expression describing the heading of a page.")
-(defvar Man-heading-regexp "^\\([A-Z][A-Z0-9 /-]+\\)$"
+(defvar Man-heading-regexp "^\\([[:upper:]][[:upper:]0-9 /-]+\\)$"
"Regular expression describing a manpage heading entry.")
-(defvar Man-see-also-regexp "SEE ALSO"
+(defvar Man-see-also-regexp "\\(SEE ALSO\\|VOIR AUSSI\\|SIEHE AUCH\\|VÉASE TAMBIÉN\\|VEJA TAMBÉM\\|VEDERE ANCHE\\|ZOBACZ TAKŻE\\|İLGİLİ BELGELER\\|参照\\|参见 SEE ALSO\\|參見 SEE ALSO\\)"
"Regular expression for SEE ALSO heading (or your equivalent).
This regexp should not start with a `^' character.")
@@ -1174,10 +1174,7 @@ See the variable `Man-notify-method' for the different notification behaviors."
(unless (eq t (compare-strings "latin-" 0 nil
current-language-environment 0 6 t))
(goto-char (point-min))
- (let ((str "\255"))
- (if enable-multibyte-characters
- (setq str (string-as-multibyte str)))
- (while (search-forward str nil t) (replace-match "-")))))
+ (while (search-forward "­" nil t) (replace-match "-"))))
(defun Man-fontify-manpage ()
"Convert overstriking and underlining to the correct fonts.
@@ -1516,16 +1513,17 @@ The following key bindings are currently in effect in the buffer:
(set (make-local-variable 'bookmark-make-record-function)
'Man-bookmark-make-record))
-(defsubst Man-build-section-alist ()
+(defun Man-build-section-list ()
"Build the list of manpage sections."
- (setq Man--sections nil)
+ (setq Man--sections ())
(goto-char (point-min))
(let ((case-fold-search nil))
- (while (re-search-forward Man-heading-regexp (point-max) t)
+ (while (re-search-forward Man-heading-regexp nil t)
(let ((section (match-string 1)))
(unless (member section Man--sections)
(push section Man--sections)))
- (forward-line 1))))
+ (forward-line)))
+ (setq Man--sections (nreverse Man--sections)))
(defsubst Man-build-references-alist ()
"Build the list of references (in the SEE ALSO section)."
@@ -1805,7 +1803,7 @@ Specify which REFERENCE to use; default is based on word at point."
(widen)
(goto-char page-start)
(narrow-to-region page-start page-end)
- (Man-build-section-alist)
+ (Man-build-section-list)
(Man-build-references-alist)
(goto-char (point-min)))))
diff --git a/lisp/master.el b/lisp/master.el
index 07e9ee5abc0..3745e216c4f 100644
--- a/lisp/master.el
+++ b/lisp/master.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el
index 57fe7abde51..5bdf8b9dda3 100644
--- a/lisp/mb-depth.el
+++ b/lisp/mb-depth.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/md4.el b/lisp/md4.el
index 23d00ab0609..10f3d188830 100644
--- a/lisp/md4.el
+++ b/lisp/md4.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 9c7bcffbaab..2b38cb5f2b0 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Avishai Yacobi suggested some menu rearrangements.
@@ -669,7 +669,8 @@ The selected font will be the default on both the existing and future frames."
(let ((need-save nil))
;; These are set with menu-bar-make-mm-toggle, which does not
;; put on a customized-value property.
- (dolist (elt '(line-number-mode column-number-mode size-indication-mode
+ (dolist (elt '(global-display-line-numbers-mode display-line-numbers-type
+ line-number-mode column-number-mode size-indication-mode
cua-mode show-paren-mode transient-mark-mode
blink-cursor-mode display-time-mode display-battery-mode
;; These are set by other functions that don't set
@@ -1101,17 +1102,78 @@ The selected font will be the default on both the existing and future frames."
:button (:radio . (eq tool-bar-mode nil))))
menu)))
+(defvar display-line-numbers-type)
+(defun menu-bar-display-line-numbers-mode (type)
+ (setq display-line-numbers-type type)
+ (if global-display-line-numbers-mode
+ (global-display-line-numbers-mode)
+ (display-line-numbers-mode)))
+
+(defvar menu-bar-showhide-line-numbers-menu
+ (let ((menu (make-sparse-keymap "Line Numbers")))
+
+ (bindings--define-key menu [visual]
+ `(menu-item "Visual Line Numbers"
+ ,(lambda ()
+ (interactive)
+ (menu-bar-display-line-numbers-mode 'visual)
+ (message "Visual line numbers enabled"))
+ :help "Enable visual line numbers"
+ :button (:radio . (eq display-line-numbers 'visual))
+ :visible (menu-bar-menu-frame-live-and-visible-p)))
+
+ (bindings--define-key menu [relative]
+ `(menu-item "Relative Line Numbers"
+ ,(lambda ()
+ (interactive)
+ (menu-bar-display-line-numbers-mode 'relative)
+ (message "Relative line numbers enabled"))
+ :help "Enable relative line numbers"
+ :button (:radio . (eq display-line-numbers 'relative))
+ :visible (menu-bar-menu-frame-live-and-visible-p)))
+
+ (bindings--define-key menu [absolute]
+ `(menu-item "Absolute Line Numbers"
+ ,(lambda ()
+ (interactive)
+ (menu-bar-display-line-numbers-mode t)
+ (setq display-line-numbers t)
+ (message "Absolute line numbers enabled"))
+ :help "Enable absolute line numbers"
+ :button (:radio . (eq display-line-numbers t))
+ :visible (menu-bar-menu-frame-live-and-visible-p)))
+
+ (bindings--define-key menu [none]
+ `(menu-item "No Line Numbers"
+ ,(lambda ()
+ (interactive)
+ (menu-bar-display-line-numbers-mode nil)
+ (message "Line numbers disabled"))
+ :help "Disable line numbers"
+ :button (:radio . (null display-line-numbers))
+ :visible (menu-bar-menu-frame-live-and-visible-p)))
+
+ (bindings--define-key menu [global]
+ (menu-bar-make-mm-toggle global-display-line-numbers-mode
+ "Global Line Numbers Mode"
+ "Set line numbers globally"))
+ menu))
+
(defvar menu-bar-showhide-menu
(let ((menu (make-sparse-keymap "Show/Hide")))
+ (bindings--define-key menu [display-line-numbers]
+ `(menu-item "Line Numbers for All Lines"
+ ,menu-bar-showhide-line-numbers-menu))
+
(bindings--define-key menu [column-number-mode]
(menu-bar-make-mm-toggle column-number-mode
- "Column Numbers"
+ "Column Numbers in Mode Line"
"Show the current column number in the mode line"))
(bindings--define-key menu [line-number-mode]
(menu-bar-make-mm-toggle line-number-mode
- "Line Numbers"
+ "Line Numbers in Mode Line"
"Show the current line number in the mode line"))
(bindings--define-key menu [size-indication-mode]
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index 31a9ea7651b..9bf28b0f132 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -11434,7 +11434,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/mh-e/ChangeLog.2 b/lisp/mh-e/ChangeLog.2
index 487198663e3..c3f28ae8164 100644
--- a/lisp/mh-e/ChangeLog.2
+++ b/lisp/mh-e/ChangeLog.2
@@ -3688,7 +3688,7 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Local Variables:
;; coding: utf-8
diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el
index d424247a4fc..86248feff6d 100644
--- a/lisp/mh-e/mh-acros.el
+++ b/lisp/mh-e/mh-acros.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el
index d62ac671ea1..7e69e7556cd 100644
--- a/lisp/mh-e/mh-alias.el
+++ b/lisp/mh-e/mh-alias.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el
index 233f8988f07..e088bca48b2 100644
--- a/lisp/mh-e/mh-buffers.el
+++ b/lisp/mh-e/mh-buffers.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el
index c0523989230..98067ce1293 100644
--- a/lisp/mh-e/mh-comp.el
+++ b/lisp/mh-e/mh-comp.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el
index dbdadb10bf6..3dc7a62f3c9 100644
--- a/lisp/mh-e/mh-compat.el
+++ b/lisp/mh-e/mh-compat.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index 38558f2dc09..f511bf7dc40 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -3035,12 +3035,12 @@ XEmacs. For more information, see URL
`ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent
versions of XEmacs have internal support for \"X-Face:\" images. If
your version of XEmacs does not, then you'll need both \"uncompface\"
-and the x-face package (see URL `ftp://ftp.jpl.org/pub/elisp/').
+and the x-face package (see URL `http://www.jpl.org/ftp/pub/elisp/').
Finally, MH-E will display images referenced by the \"X-Image-URL:\"
header field if neither the \"Face:\" nor the \"X-Face:\" fields are
present. The display of the images requires \"wget\" (see URL
-`http://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\"
+`https://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\"
to fetch the image and the \"convert\" program from the ImageMagick
suite (see URL `http://www.imagemagick.org/'). Of the three header
fields this is the most efficient in terms of network usage since the
diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el
index f846f179433..49cf3d3dff0 100644
--- a/lisp/mh-e/mh-folder.el
+++ b/lisp/mh-e/mh-folder.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el
index 5252f92966f..cfff8cb6629 100644
--- a/lisp/mh-e/mh-funcs.el
+++ b/lisp/mh-e/mh-funcs.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el
index 318759ddc1b..33673251c95 100644
--- a/lisp/mh-e/mh-gnus.el
+++ b/lisp/mh-e/mh-gnus.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el
index ecc7f7e5430..9518e967993 100644
--- a/lisp/mh-e/mh-identity.el
+++ b/lisp/mh-e/mh-identity.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el
index a7ff8f31467..fcdb3f02274 100644
--- a/lisp/mh-e/mh-inc.el
+++ b/lisp/mh-e/mh-inc.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index 25e116cb28e..9057af43d66 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el
index ca4ec39733e..871ba49522a 100644
--- a/lisp/mh-e/mh-letter.el
+++ b/lisp/mh-e/mh-letter.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -60,17 +60,6 @@
(to . mh-alias-letter-expand-alias))
"Alist of header fields and completion functions to use.")
-(defvar mh-yank-hooks nil
- "Obsolete hook for modifying a citation just inserted in the mail buffer.
-
-Each hook function can find the citation between point and mark.
-And each hook function should leave point and mark around the
-citation text as modified.
-
-This is a normal hook, misnamed for historical reasons.
-It is obsolete and is only used if `mail-citation-hook' is nil.")
-(mh-make-obsolete-variable 'mh-yank-hooks 'mail-citation-hook "19.34")
-
;;; Letter Menu
@@ -972,8 +961,6 @@ Otherwise, simply insert MH-INS-STRING before each line."
(sc-cite-original))
(mail-citation-hook
(run-hooks 'mail-citation-hook))
- (mh-yank-hooks ;old hook name
- (run-hooks 'mh-yank-hooks))
(t
(or (bolp) (forward-line 1))
(while (< (point) (point-max))
diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el
index bc4a0066420..280bcc683f5 100644
--- a/lisp/mh-e/mh-limit.el
+++ b/lisp/mh-e/mh-limit.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 7238de08b9b..69c57e0afdc 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -659,6 +659,7 @@ buttons for alternative parts that are usually suppressed."
(attachmentp (equal (car (mm-handle-disposition handle))
"attachment"))
(inlinep (and (equal (car (mm-handle-disposition handle)) "inline")
+ (mm-automatic-display-p handle)
(mm-inlinable-p handle)
(mm-inlined-p handle)))
(displayp (or inlinep ; show if inline OR
@@ -669,6 +670,7 @@ buttons for alternative parts that are usually suppressed."
(and (not (equal
(mm-handle-media-supertype handle)
"image"))
+ (mm-automatic-display-p handle)
(mm-inlinable-p handle)
(mm-inlined-p handle)))))))
(save-restriction
diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el
index 906899d3b6d..d7b686cfec4 100644
--- a/lisp/mh-e/mh-print.el
+++ b/lisp/mh-e/mh-print.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 1e708e529cf..936d451e2d2 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el
index b0fdfce8e87..95a5a08b1af 100644
--- a/lisp/mh-e/mh-search.el
+++ b/lisp/mh-e/mh-search.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el
index 6fc518b57c4..9d3bd2dcd2d 100644
--- a/lisp/mh-e/mh-seq.el
+++ b/lisp/mh-e/mh-seq.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el
index ab320caf604..ce843a6a7cf 100644
--- a/lisp/mh-e/mh-show.el
+++ b/lisp/mh-e/mh-show.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el
index 8d14d852397..4438bf2c8e1 100644
--- a/lisp/mh-e/mh-speed.el
+++ b/lisp/mh-e/mh-speed.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el
index b1b1512614a..9b9ef341507 100644
--- a/lisp/mh-e/mh-thread.el
+++ b/lisp/mh-e/mh-thread.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el
index 07dd29b4be3..3add54f03e2 100644
--- a/lisp/mh-e/mh-tool-bar.el
+++ b/lisp/mh-e/mh-tool-bar.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 1ed2e0f8713..7cb52ffa9ef 100644
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el
index dbfaa35c738..92afd63262b 100644
--- a/lisp/mh-e/mh-xface.el
+++ b/lisp/mh-e/mh-xface.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/midnight.el b/lisp/midnight.el
index b9893fbfced..dfe0df33397 100644
--- a/lisp/midnight.el
+++ b/lisp/midnight.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index 096800155bb..1d223e6fd0f 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 0377cd549a2..3b1d6f447a5 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -392,7 +392,7 @@ obeys predicates."
(and (funcall pred1 x) (funcall pred2 x)))))
;; If completion failed and we're not applying pred1 strictly, try
;; again without pred1.
- (and (not strict) pred1 pred2
+ (and (not strict) pred1
(complete-with-action action table string pred2))))))
(defun completion-table-in-turn (&rest tables)
@@ -746,7 +746,7 @@ If the current buffer is not a minibuffer, erase its entire contents."
(defcustom completion-auto-help t
"Non-nil means automatically provide help for invalid completion input.
-If the value is t the *Completion* buffer is displayed whenever completion
+If the value is t the *Completions* buffer is displayed whenever completion
is requested but cannot be done.
If the value is `lazy', the *Completions* buffer is only displayed after
the second failed attempt to complete."
@@ -896,8 +896,15 @@ This overrides the defaults specified in `completion-category-defaults'."
;; than from completion-extra-properties) because it may apply only to some
;; part of the string (e.g. substitute-in-file-name).
(let ((requote
- (when (completion-metadata-get metadata 'completion--unquote-requote)
- (cl-assert (functionp table))
+ (when (and
+ (completion-metadata-get metadata 'completion--unquote-requote)
+ ;; Sometimes a table's metadata is used on another
+ ;; table (typically that other table is just a list taken
+ ;; from the output of `all-completions' or something equivalent,
+ ;; for progressive refinement). See bug#28898 and bug#16274.
+ ;; FIXME: Rather than do nothing, we should somehow call
+ ;; the original table, in that case!
+ (functionp table))
(let ((new (funcall table string point 'completion--unquote)))
(setq string (pop new))
(setq table (pop new))
@@ -1312,7 +1319,7 @@ Repeated uses step through the possible completions."
(defvar minibuffer-confirm-exit-commands
'(completion-at-point minibuffer-complete
minibuffer-complete-word PC-complete PC-complete-word)
- "A list of commands which cause an immediately following
+ "List of commands which cause an immediately following
`minibuffer-complete-and-exit' to ask for extra confirmation.")
(defun minibuffer-complete-and-exit ()
@@ -2979,6 +2986,17 @@ or a symbol, see `completion-pcm--merge-completions'."
(setq re (replace-match "" t t re 1)))
re))
+(defun completion-pcm--pattern-point-idx (pattern)
+ "Return index of subgroup corresponding to `point' element of PATTERN.
+Return nil if there's no such element."
+ (let ((idx nil)
+ (i 0))
+ (dolist (x pattern)
+ (unless (stringp x)
+ (cl-incf i)
+ (if (eq x 'point) (setq idx i))))
+ idx))
+
(defun completion-pcm--all-completions (prefix pattern table pred)
"Find all completions for PATTERN in TABLE obeying PRED.
PATTERN is as returned by `completion-pcm--string->pattern'."
@@ -3006,11 +3024,12 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
(let ((poss ()))
(dolist (c compl)
(when (string-match-p regex c) (push c poss)))
- poss)))))
+ (nreverse poss))))))
(defun completion-pcm--hilit-commonality (pattern completions)
(when completions
- (let* ((re (completion-pcm--pattern->regex pattern '(point)))
+ (let* ((re (completion-pcm--pattern->regex pattern 'group))
+ (point-idx (completion-pcm--pattern-point-idx pattern))
(case-fold-search completion-ignore-case))
(mapcar
(lambda (str)
@@ -3018,8 +3037,16 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
(setq str (copy-sequence str))
(unless (string-match re str)
(error "Internal error: %s does not match %s" re str))
- (let ((pos (or (match-beginning 1) (match-end 0))))
- (put-text-property 0 pos
+ (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
+ (md (match-data))
+ (start (pop md))
+ (end (pop md)))
+ (while md
+ (put-text-property start (pop md)
+ 'font-lock-face 'completions-common-part
+ str)
+ (setq start (pop md)))
+ (put-text-property start end
'font-lock-face 'completions-common-part
str)
(if (> (length str) pos)
@@ -3258,7 +3285,7 @@ the same set of elements."
"\\)\\'")))
(dolist (f all)
(unless (string-match-p re f) (push f try)))
- (or try all))))
+ (or (nreverse try) all))))
(defun completion-pcm--merge-try (pattern all prefix suffix)
diff --git a/lisp/misc.el b/lisp/misc.el
index dc47c37dbc0..8806ac83837 100644
--- a/lisp/misc.el
+++ b/lisp/misc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/misearch.el b/lisp/misearch.el
index 884b33020a8..89b437f1f16 100644
--- a/lisp/misearch.el
+++ b/lisp/misearch.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
index 44d9973e630..4da25dee9c1 100644
--- a/lisp/mouse-copy.el
+++ b/lisp/mouse-copy.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
index 5a83e57347b..775a464b236 100644
--- a/lisp/mouse-drag.el
+++ b/lisp/mouse-drag.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 9b6b169e568..17d1732e501 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -380,7 +380,7 @@ This command must be bound to a mouse click."
(defun mouse-drag-line (start-event line)
"Drag a mode line, header line, or vertical line with the mouse.
-START-EVENT is the starting mouse-event of the drag action. LINE
+START-EVENT is the starting mouse event of the drag action. LINE
must be one of the symbols `header', `mode', or `vertical'."
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
@@ -405,29 +405,15 @@ must be one of the symbols `header', `mode', or `vertical'."
;; window's edge we drag.
(cond
((eq line 'header)
- (if (window-at-side-p window 'top)
- ;; We can't drag the header line of a topmost window.
- (setq draggable nil)
- ;; Drag bottom edge of window above the header line.
- (setq window (window-in-direction 'above window t))))
- ((eq line 'mode)
- (if (and (window-at-side-p window 'bottom)
- ;; Allow resizing the minibuffer window if it's on the
- ;; same frame as and immediately below `window', and it's
- ;; either active or `resize-mini-windows' is nil.
- (let ((minibuffer-window (minibuffer-window frame)))
- (not (and (eq (window-frame minibuffer-window) frame)
- (or (not resize-mini-windows)
- (eq minibuffer-window
- (active-minibuffer-window)))))))
- (setq draggable nil)))
+ ;; Drag bottom edge of window above the header line.
+ (setq window (window-in-direction 'above window t)))
+ ((eq line 'mode))
((eq line 'vertical)
(let ((divider-width (frame-right-divider-width frame)))
(when (and (or (not (numberp divider-width))
(zerop divider-width))
(eq (frame-parameter frame 'vertical-scroll-bars) 'left))
(setq window (window-in-direction 'left window t))))))
-
(let* ((exitfun nil)
(move
(lambda (event) (interactive "e")
@@ -530,20 +516,405 @@ must be one of the symbols `header', `mode', or `vertical'."
t (lambda () (setq track-mouse old-track-mouse)))))))
(defun mouse-drag-mode-line (start-event)
- "Change the height of a window by dragging on the mode line."
+ "Change the height of a window by dragging on its mode line.
+START-EVENT is the starting mouse event of the drag action.
+
+If the drag happens in a mode line on the bottom of a frame and
+that frame's `drag-with-mode-line' parameter is non-nil, drag the
+frame instead."
(interactive "e")
- (mouse-drag-line start-event 'mode))
+ (let* ((start (event-start start-event))
+ (window (posn-window start))
+ (frame (window-frame window)))
+ (cond
+ ((not (window-live-p window)))
+ ((or (not (window-at-side-p window 'bottom))
+ ;; Allow resizing the minibuffer window if it's on the
+ ;; same frame as and immediately below `window', and it's
+ ;; either active or `resize-mini-windows' is nil.
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (and (eq (window-frame minibuffer-window) frame)
+ (or (not resize-mini-windows)
+ (eq minibuffer-window
+ (active-minibuffer-window))))))
+ (mouse-drag-line start-event 'mode))
+ ((and (frame-parameter frame 'drag-with-mode-line)
+ (window-at-side-p window 'bottom)
+ (let ((minibuffer-window (minibuffer-window frame)))
+ (not (eq (window-frame minibuffer-window) frame))))
+ ;; Drag frame when the window is on the bottom of its frame and
+ ;; there is no minibuffer window below.
+ (mouse-drag-frame start-event 'move)))))
(defun mouse-drag-header-line (start-event)
- "Change the height of a window by dragging on the header line."
+ "Change the height of a window by dragging on its header line.
+START-EVENT is the starting mouse event of the drag action.
+
+If the drag happens in a header line on the top of a frame and
+that frame's `drag-with-header-line' parameter is non-nil, drag
+the frame instead."
(interactive "e")
- (mouse-drag-line start-event 'header))
+ (let* ((start (event-start start-event))
+ (window (posn-window start)))
+ (if (and (window-live-p window)
+ (not (window-at-side-p window 'top)))
+ (mouse-drag-line start-event 'header)
+ (let ((frame (window-frame window)))
+ (when (frame-parameter frame 'drag-with-header-line)
+ (mouse-drag-frame start-event 'move))))))
(defun mouse-drag-vertical-line (start-event)
- "Change the width of a window by dragging on the vertical line."
+ "Change the width of a window by dragging on a vertical line.
+START-EVENT is the starting mouse event of the drag action."
(interactive "e")
(mouse-drag-line start-event 'vertical))
+(defun mouse-resize-frame (frame x-diff y-diff &optional x-move y-move)
+ "Helper function for `mouse-drag-frame'."
+ (let* ((frame-x-y (frame-position frame))
+ (frame-x (car frame-x-y))
+ (frame-y (cdr frame-x-y))
+ alist)
+ (if (> x-diff 0)
+ (when x-move
+ (setq x-diff (min x-diff frame-x))
+ (setq x-move (- frame-x x-diff)))
+ (let* ((min-width (frame-windows-min-size frame t nil t))
+ (min-diff (max 0 (- (frame-inner-width frame) min-width))))
+ (setq x-diff (max x-diff (- min-diff)))
+ (when x-move
+ (setq x-move (+ frame-x (- x-diff))))))
+
+ (if (> y-diff 0)
+ (when y-move
+ (setq y-diff (min y-diff frame-y))
+ (setq y-move (- frame-y y-diff)))
+ (let* ((min-height (frame-windows-min-size frame nil nil t))
+ (min-diff (max 0 (- (frame-inner-height frame) min-height))))
+ (setq y-diff (max y-diff (- min-diff)))
+ (when y-move
+ (setq y-move (+ frame-y (- y-diff))))))
+
+ (unless (zerop x-diff)
+ (when x-move
+ (push `(left . ,x-move) alist))
+ (push `(width . (text-pixels . ,(+ (frame-text-width frame) x-diff)))
+ alist))
+ (unless (zerop y-diff)
+ (when y-move
+ (push `(top . ,y-move) alist))
+ (push `(height . (text-pixels . ,(+ (frame-text-height frame) y-diff)))
+ alist))
+ (when alist
+ (modify-frame-parameters frame alist))))
+
+(defun mouse-drag-frame (start-event part)
+ "Drag a frame or one of its edges with the mouse.
+START-EVENT is the starting mouse event of the drag action. Its
+position window denotes the frame that will be dragged.
+
+PART specifies the part that has been dragged and must be one of
+the symbols 'left', 'top', 'right', 'bottom', 'top-left',
+'top-right', 'bottom-left', 'bottom-right' to drag an internal
+border or edge. If PART equals 'move', this means to move the
+frame with the mouse."
+ ;; Give temporary modes such as isearch a chance to turn off.
+ (run-hooks 'mouse-leave-buffer-hook)
+ (let* ((echo-keystrokes 0)
+ (start (event-start start-event))
+ (window (posn-window start))
+ ;; FRAME is the frame to drag.
+ (frame (if (window-live-p window)
+ (window-frame window)
+ window))
+ (width (frame-native-width frame))
+ (height (frame-native-height frame))
+ ;; PARENT is the parent frame of FRAME or, if FRAME is a
+ ;; top-level frame, FRAME's workarea.
+ (parent (frame-parent frame))
+ (parent-edges
+ (if parent
+ `(0 0 ,(frame-native-width parent) ,(frame-native-height parent))
+ (let* ((attributes
+ (car (display-monitor-attributes-list)))
+ (workarea (assq 'workarea attributes)))
+ (and workarea
+ `(,(nth 1 workarea) ,(nth 2 workarea)
+ ,(+ (nth 1 workarea) (nth 3 workarea))
+ ,(+ (nth 2 workarea) (nth 4 workarea)))))))
+ (parent-left (and parent-edges (nth 0 parent-edges)))
+ (parent-top (and parent-edges (nth 1 parent-edges)))
+ (parent-right (and parent-edges (nth 2 parent-edges)))
+ (parent-bottom (and parent-edges (nth 3 parent-edges)))
+ ;; `pos-x' and `pos-y' record the x- and y-coordinates of the
+ ;; last sampled mouse position. Note that we sample absolute
+ ;; mouse positions to avoid that moving the mouse from one
+ ;; frame into another gets into our way. `last-x' and `last-y'
+ ;; records the x- and y-coordinates of the previously sampled
+ ;; position. The differences between `last-x' and `pos-x' as
+ ;; well as `last-y' and `pos-y' determine the amount the mouse
+ ;; has been dragged between the last two samples.
+ pos-x-y pos-x pos-y
+ (last-x-y (mouse-absolute-pixel-position))
+ (last-x (car last-x-y))
+ (last-y (cdr last-x-y))
+ ;; `snap-x' and `snap-y' record the x- and y-coordinates of the
+ ;; mouse position when FRAME snapped. As soon as the
+ ;; difference between `pos-x' and `snap-x' (or `pos-y' and
+ ;; `snap-y') exceeds the value of FRAME's `snap-width'
+ ;; parameter, unsnap FRAME (at the respective side). `snap-x'
+ ;; and `snap-y' nil mean FRAME is currently not snapped.
+ snap-x snap-y
+ (exitfun nil)
+ (move
+ (lambda (event)
+ (interactive "e")
+ (when (consp event)
+ (setq pos-x-y (mouse-absolute-pixel-position))
+ (setq pos-x (car pos-x-y))
+ (setq pos-y (cdr pos-x-y))
+ (cond
+ ((eq part 'left)
+ (mouse-resize-frame frame (- last-x pos-x) 0 t))
+ ((eq part 'top)
+ (mouse-resize-frame frame 0 (- last-y pos-y) nil t))
+ ((eq part 'right)
+ (mouse-resize-frame frame (- pos-x last-x) 0))
+ ((eq part 'bottom)
+ (mouse-resize-frame frame 0 (- pos-y last-y)))
+ ((eq part 'top-left)
+ (mouse-resize-frame
+ frame (- last-x pos-x) (- last-y pos-y) t t))
+ ((eq part 'top-right)
+ (mouse-resize-frame
+ frame (- pos-x last-x) (- last-y pos-y) nil t))
+ ((eq part 'bottom-left)
+ (mouse-resize-frame
+ frame (- last-x pos-x) (- pos-y last-y) t))
+ ((eq part 'bottom-right)
+ (mouse-resize-frame
+ frame (- pos-x last-x) (- pos-y last-y)))
+ ((eq part 'move)
+ (let* ((old-position (frame-position frame))
+ (old-left (car old-position))
+ (old-top (cdr old-position))
+ (left (+ old-left (- pos-x last-x)))
+ (top (+ old-top (- pos-y last-y)))
+ right bottom
+ ;; `snap-width' (maybe also a yet to be provided
+ ;; `snap-height') could become floats to handle
+ ;; proportionality wrt PARENT. We don't do any
+ ;; checks on this parameter so far.
+ (snap-width (frame-parameter frame 'snap-width)))
+ ;; Docking and constraining.
+ (when (and (numberp snap-width) parent-edges)
+ (cond
+ ;; Docking at the left parent edge.
+ ((< pos-x last-x)
+ (cond
+ ((and (> left parent-left)
+ (<= (- left parent-left) snap-width))
+ ;; Snap when the mouse moved leftward and
+ ;; FRAME's left edge would end up within
+ ;; `snap-width' pixels from PARENT's left edge.
+ (setq snap-x pos-x)
+ (setq left parent-left))
+ ((and (<= left parent-left)
+ (<= (- parent-left left) snap-width)
+ snap-x (<= (- snap-x pos-x) snap-width))
+ ;; Stay snapped when the mouse moved leftward
+ ;; but not more than `snap-width' pixels from
+ ;; the time FRAME snapped.
+ (setq left parent-left))
+ (t
+ ;; Unsnap when the mouse moved more than
+ ;; `snap-width' pixels leftward from the time
+ ;; FRAME snapped.
+ (setq snap-x nil))))
+ ((> pos-x last-x)
+ (setq right (+ left width))
+ (cond
+ ((and (< right parent-right)
+ (<= (- parent-right right) snap-width))
+ ;; Snap when the mouse moved rightward and
+ ;; FRAME's right edge would end up within
+ ;; `snap-width' pixels from PARENT's right edge.
+ (setq snap-x pos-x)
+ (setq left (- parent-right width)))
+ ((and (>= right parent-right)
+ (<= (- right parent-right) snap-width)
+ snap-x (<= (- pos-x snap-x) snap-width))
+ ;; Stay snapped when the mouse moved rightward
+ ;; but not more more than `snap-width' pixels
+ ;; from the time FRAME snapped.
+ (setq left (- parent-right width)))
+ (t
+ ;; Unsnap when the mouse moved rightward more
+ ;; than `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-x nil)))))
+
+ (cond
+ ((< pos-y last-y)
+ (cond
+ ((and (> top parent-top)
+ (<= (- top parent-top) snap-width))
+ ;; Snap when the mouse moved upward and FRAME's
+ ;; top edge would end up within `snap-width'
+ ;; pixels from PARENT's top edge.
+ (setq snap-y pos-y)
+ (setq top parent-top))
+ ((and (<= top parent-top)
+ (<= (- parent-top top) snap-width)
+ snap-y (<= (- snap-y pos-y) snap-width))
+ ;; Stay snapped when the mouse moved upward but
+ ;; not more more than `snap-width' pixels from
+ ;; the time FRAME snapped.
+ (setq top parent-top))
+ (t
+ ;; Unsnap when the mouse moved upward more than
+ ;; `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))
+ ((> pos-y last-y)
+ (setq bottom (+ top height))
+ (cond
+ ((and (< bottom parent-bottom)
+ (<= (- parent-bottom bottom) snap-width))
+ ;; Snap when the mouse moved downward and
+ ;; FRAME's bottom edge would end up within
+ ;; `snap-width' pixels from PARENT's bottom
+ ;; edge.
+ (setq snap-y pos-y)
+ (setq top (- parent-bottom height)))
+ ((and (>= bottom parent-bottom)
+ (<= (- bottom parent-bottom) snap-width)
+ snap-y (<= (- pos-y snap-y) snap-width))
+ ;; Stay snapped when the mouse moved downward
+ ;; but not more more than `snap-width' pixels
+ ;; from the time FRAME snapped.
+ (setq top (- parent-bottom height)))
+ (t
+ ;; Unsnap when the mouse moved downward more
+ ;; than `snap-width' pixels from the time FRAME
+ ;; snapped.
+ (setq snap-y nil))))))
+
+ ;; If requested, constrain FRAME's draggable areas to
+ ;; PARENT's edges. The `top-visible' parameter should
+ ;; be set when FRAME has a draggable header-line. If
+ ;; set to a number, it ascertains that the top of
+ ;; FRAME is always constrained to the top of PARENT
+ ;; and that at least as many pixels of FRAME as
+ ;; specified by that number are visible on each of the
+ ;; three remaining sides of PARENT.
+ ;;
+ ;; The `bottom-visible' parameter should be set when
+ ;; FRAME has a draggable mode-line. If set to a
+ ;; number, it ascertains that the bottom of FRAME is
+ ;; always constrained to the bottom of PARENT and that
+ ;; at least as many pixels of FRAME as specified by
+ ;; that number are visible on each of the three
+ ;; remaining sides of PARENT.
+ (let ((par (frame-parameter frame 'top-visible))
+ bottom-visible)
+ (unless par
+ (setq par (frame-parameter frame 'bottom-visible))
+ (setq bottom-visible t))
+ (when (and (numberp par) parent-edges)
+ (setq left
+ (max (min (- parent-right par) left)
+ (+ (- parent-left width) par)))
+ (setq top
+ (if bottom-visible
+ (min (max top (- parent-top (- height par)))
+ (- parent-bottom height))
+ (min (max top parent-top)
+ (- parent-bottom par))))))
+
+ ;; Use `modify-frame-parameters' since `left' and
+ ;; `top' may want to move FRAME out of its PARENT.
+ (modify-frame-parameters
+ frame
+ `((left . (+ ,left)) (top . (+ ,top)))))))
+ (setq last-x pos-x)
+ (setq last-y pos-y))))
+ (old-track-mouse track-mouse))
+ ;; Start tracking. The special value 'dragging' signals the
+ ;; display engine to freeze the mouse pointer shape for as long
+ ;; as we drag.
+ (setq track-mouse 'dragging)
+ ;; Loop reading events and sampling the position of the mouse.
+ (setq exitfun
+ (set-transient-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [switch-frame] #'ignore)
+ (define-key map [select-window] #'ignore)
+ (define-key map [scroll-bar-movement] #'ignore)
+ (define-key map [mouse-movement] move)
+ ;; Swallow drag-mouse-1 events to avoid selecting some other window.
+ (define-key map [drag-mouse-1]
+ (lambda () (interactive) (funcall exitfun)))
+ ;; Some of the events will of course end up looked up
+ ;; with a mode-line, header-line or vertical-line prefix ...
+ (define-key map [mode-line] map)
+ (define-key map [header-line] map)
+ (define-key map [vertical-line] map)
+ ;; ... and some maybe even with a right- or bottom-divider
+ ;; prefix.
+ (define-key map [right-divider] map)
+ (define-key map [bottom-divider] map)
+ map)
+ t (lambda () (setq track-mouse old-track-mouse))))))
+
+(defun mouse-drag-left-edge (start-event)
+ "Drag left edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'left))
+
+(defun mouse-drag-top-left-corner (start-event)
+ "Drag top left corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'top-left))
+
+(defun mouse-drag-top-edge (start-event)
+ "Drag top edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'top))
+
+(defun mouse-drag-top-right-corner (start-event)
+ "Drag top right corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'top-right))
+
+(defun mouse-drag-right-edge (start-event)
+ "Drag right edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'right))
+
+(defun mouse-drag-bottom-right-corner (start-event)
+ "Drag bottom right corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'bottom-right))
+
+(defun mouse-drag-bottom-edge (start-event)
+ "Drag bottom edge of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'bottom))
+
+(defun mouse-drag-bottom-left-corner (start-event)
+ "Drag bottom left corner of a frame with the mouse.
+START-EVENT is the starting mouse event of the drag action."
+ (interactive "e")
+ (mouse-drag-frame start-event 'bottom-left))
+
(defcustom mouse-select-region-move-to-beginning nil
"Effect of selecting a region extending backward from double click.
Nil means keep point at the position clicked (region end);
@@ -1545,6 +1916,34 @@ CLICK position, kill the secondary selection."
(> (length str) 0)
(gui-set-selection 'SECONDARY str))))
+(defun secondary-selection-exist-p ()
+ "Return non-nil if the secondary selection exists in the current buffer."
+ (memq mouse-secondary-overlay (overlays-in (point-min) (point-max))))
+
+(defun secondary-selection-to-region ()
+ "Set beginning and end of the region to those of the secondary selection.
+This puts mark and point at the beginning and the end of the
+secondary selection, respectively. This works when the secondary
+selection exists and the region does not exist in current buffer;
+the secondary selection will be deleted afterward.
+If the region is active, or the secondary selection doesn't exist,
+this function does nothing."
+ (when (and (not (region-active-p))
+ (secondary-selection-exist-p))
+ (let ((beg (overlay-start mouse-secondary-overlay))
+ (end (overlay-end mouse-secondary-overlay)))
+ (push-mark beg t t)
+ (goto-char end))
+ ;; Delete the secondary selection on current buffer.
+ (delete-overlay mouse-secondary-overlay)))
+
+(defun secondary-selection-from-region ()
+ "Set beginning and end of the secondary selection to those of the region.
+When there is no region, this function does nothing."
+ (when (region-active-p) ; Create the secondary selection from the region.
+ (delete-overlay mouse-secondary-overlay) ; Delete the secondary selection even on a different buffer.
+ (move-overlay mouse-secondary-overlay (region-beginning) (region-end))))
+
(defcustom mouse-buffer-menu-maxlen 20
"Number of buffers in one pane (submenu) of the buffer menu.
@@ -1950,7 +2349,15 @@ choose a font."
If the value is a modifier, such as `control' or `shift' or `meta',
then if that modifier key is pressed when dropping the region, region
text is copied instead of being cut."
- :type 'symbol
+ :type `(choice
+ (const :tag "Disable dragging the region" nil)
+ ,@(mapcar
+ (lambda (modifier)
+ `(const :tag ,(format "Enable, but copy with the %s modifier"
+ modifier)
+ modifier))
+ '(alt super hyper shift control meta))
+ (other :tag "Enable dragging the region" t))
:version "26.1"
:group 'mouse)
@@ -1973,7 +2380,9 @@ is copied instead of being cut."
;; When event was click instead of drag, skip loop
(while (progn
(setq event (read-event))
- (mouse-movement-p event))
+ (or (mouse-movement-p event)
+ ;; Handle `mouse-autoselect-window'.
+ (eq (car-safe event) 'select-window)))
(unless value-selection ; initialization
(delete-overlay mouse-secondary-overlay)
(setq value-selection (buffer-substring start end))
@@ -2078,6 +2487,22 @@ is copied instead of being cut."
(global-set-key [bottom-divider down-mouse-1] 'mouse-drag-mode-line)
(global-set-key [bottom-divider mouse-1] 'ignore)
(global-set-key [bottom-divider C-mouse-2] 'mouse-split-window-horizontally)
+(global-set-key [left-edge down-mouse-1] 'mouse-drag-left-edge)
+(global-set-key [left-edge mouse-1] 'ignore)
+(global-set-key [top-left-corner down-mouse-1] 'mouse-drag-top-left-corner)
+(global-set-key [top-left-corner mouse-1] 'ignore)
+(global-set-key [top-edge down-mouse-1] 'mouse-drag-top-edge)
+(global-set-key [top-edge mouse-1] 'ignore)
+(global-set-key [top-right-corner down-mouse-1] 'mouse-drag-top-right-corner)
+(global-set-key [top-right-corner mouse-1] 'ignore)
+(global-set-key [right-edge down-mouse-1] 'mouse-drag-right-edge)
+(global-set-key [right-edge mouse-1] 'ignore)
+(global-set-key [bottom-right-corner down-mouse-1] 'mouse-drag-bottom-right-corner)
+(global-set-key [bottom-right-corner mouse-1] 'ignore)
+(global-set-key [bottom-edge down-mouse-1] 'mouse-drag-bottom-edge)
+(global-set-key [bottom-edge mouse-1] 'ignore)
+(global-set-key [bottom-left-corner down-mouse-1] 'mouse-drag-bottom-left-corner)
+(global-set-key [bottom-left-corner mouse-1] 'ignore)
(provide 'mouse)
diff --git a/lisp/mpc.el b/lisp/mpc.el
index cce752739be..98f4a031834 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1029,12 +1029,12 @@ If PLAYLIST is t or nil or missing, use the main playlist."
(let ((dir (file-name-directory (cdr (assq 'file info)))))
;; (debug)
(push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred)
- (if-let ((covers '(".folder.png" "cover.jpg" "folder.jpg"))
- (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir))
- if (member (downcase file) covers)
- return (concat dir file)))
- (file (with-demoted-errors "MPC: %s"
- (mpc-file-local-copy cover))))
+ (if-let* ((covers '(".folder.png" "cover.jpg" "folder.jpg"))
+ (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir))
+ if (member (downcase file) covers)
+ return (concat dir file)))
+ (file (with-demoted-errors "MPC: %s"
+ (mpc-file-local-copy cover))))
(let (image)
(if (null size) (setq image (create-image file))
(let ((tempfile (make-temp-file "mpc" nil ".jpg")))
@@ -2403,10 +2403,38 @@ This is used so that they can be compared with `eq', which is needed for
(interactive)
(mpc-cmd-pause "0"))
+(defun mpc-read-seek (prompt)
+ "Read a seek time.
+Returns a string suitable for MPD \"seekcur\" protocol command."
+ (let* ((str (read-from-minibuffer prompt nil nil nil nil nil t))
+ (seconds "\\(?1:[[:digit:]]+\\(?:\\.[[:digit:]]*\\)?\\)")
+ (minsec (concat "\\(?2:[[:digit:]]+\\):" seconds "?"))
+ (hrminsec (concat "\\(?3:[[:digit:]]+\\):\\(?:" minsec "?\\|:\\)"))
+ time sign)
+ (setq str (string-trim str))
+ (when (memq (string-to-char str) '(?+ ?-))
+ (setq sign (string (string-to-char str)))
+ (setq str (substring str 1)))
+ (setq time
+ ;; `string-to-number' returns 0 on failure
+ (cond
+ ((string-match (concat "^" hrminsec "$") str)
+ (+ (* 3600 (string-to-number (match-string 3 str)))
+ (* 60 (string-to-number (or (match-string 2 str) "")))
+ (string-to-number (or (match-string 1 str) ""))))
+ ((string-match (concat "^" minsec "$") str)
+ (+ (* 60 (string-to-number (match-string 2 str)))
+ (string-to-number (match-string 1 str))))
+ ((string-match (concat "^" seconds "$") str)
+ (string-to-number (match-string 1 str)))
+ (t (user-error "Invalid time"))))
+ (setq time (number-to-string time))
+ (if (null sign) time (concat sign time))))
+
(defun mpc-seek-current (pos)
"Seek within current track."
(interactive
- (list (read-string "Position to go ([+-]seconds): ")))
+ (list (mpc-read-seek "Position to go ([+-][[H:]M:]seconds): ")))
(mpc-cmd-seekcur pos))
(defun mpc-toggle-play ()
diff --git a/lisp/msb.el b/lisp/msb.el
index 7b48af729e1..c2ab2f5e9b8 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 1428e5f4d01..0c0dcb3beb1 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -232,6 +232,7 @@ non-Windows systems."
;; When the double-mouse-N comes in, a mouse-N has been executed already,
;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
(setq amt (* amt (event-click-count event))))
+ (when (numberp amt) (setq amt (* amt (event-line-count event))))
(unwind-protect
(let ((button (mwheel-event-button event)))
(cond ((eq button mouse-wheel-down-event)
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index ecb60e5a4f4..cf65e10e510 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -530,33 +530,8 @@
;; to fix its files hashtable. A cookie to anyone who can think of a
;; fast, sure-fire way to recognize ULTRIX over ftp.
-;; If you find any bugs or problems with this package, PLEASE either e-mail
-;; the above author, or send a message to the ange-ftp-lovers mailing list
-;; below. Ideas and constructive comments are especially welcome.
-
-;; ange-ftp-lovers:
-;;
-;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All
-;; users of ange-ftp are welcome to subscribe (see below) and to discuss
-;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to
-;; the mailing list.
-
-;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the
-;; list, please mail one of the following addresses:
-;;
-;; ange-ftp-lovers-request@hplb.hpl.hp.com
-;;
-;; Please don't forget the -request part.
-;;
-;; For mail to be posted directly to ange-ftp-lovers, send to one of the
-;; following addresses:
-;;
-;; ange-ftp-lovers@hplb.hpl.hp.com
-;;
-;; Alternatively, there is a mailing list that only gets announcements of new
-;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be
-;; subscribed to by e-mailing to the -request address as above. Please make
-;; it clear in the request which mailing list you wish to join.
+;; If you find any bugs or problems with this package, PLEASE report a
+;; bug to the Emacs maintainers via M-x report-emacs-bug.
;; -----------------------------------------------------------
;; Technical information on this package:
@@ -714,10 +689,17 @@ parenthesized expressions in REGEXP for the components (in that order)."
;; authentication methods (typically) at connection establishment. Non
;; security-aware FTP servers should respond to this with a 500 code,
;; which we ignore.
+
+;; Further messages are needed to support ftp-ssl.
(defcustom ange-ftp-skip-msgs
(concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
"^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
"^Data connection \\|"
+ "^200 PBSZ\\|" "^200 Protection set to Private\\|"
+ "^234 AUTH TLS successful\\|"
+ "^SSL not available\\|"
+ "^\\[SSL Cipher .+\\]\\|"
+ "^\\[Encrypted data transfer\\.\\]\\|"
"^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
"^500 .*AUTH\\|^KERBEROS\\|"
"^500 This security scheme is not implemented\\|"
@@ -727,7 +709,7 @@ parenthesized expressions in REGEXP for the components (in that order)."
"^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT\\|^500 .*EPSV")
"Regular expression matching FTP messages that can be ignored."
:group 'ange-ftp
- :version "24.4" ; add EPSV
+ :version "26.1"
:type 'regexp)
(defcustom ange-ftp-fatal-msgs
@@ -3223,8 +3205,12 @@ system TYPE.")
(defun ange-ftp-binary-file (file)
(string-match-p ange-ftp-binary-file-name-regexp file))
-(defun ange-ftp-write-region (start end filename &optional append visit)
+(defun ange-ftp-write-region
+ (start end filename &optional append visit _lockname mustbenew)
(setq filename (expand-file-name filename))
+ (when mustbenew
+ (ange-ftp-barf-or-query-if-file-exists
+ filename "overwrite" (not (eq mustbenew 'excl))))
(let ((parsed (ange-ftp-ftp-name filename)))
(if parsed
(let* ((host (nth 0 parsed))
@@ -3493,7 +3479,7 @@ system TYPE.")
(f2-mt (nth 5 (file-attributes f2))))
(cond ((null f1-mt) nil)
((null f2-mt) t)
- (t (> (float-time f1-mt) (float-time f2-mt)))))
+ (t (time-less-p f2-mt f1-mt))))
(ange-ftp-real-file-newer-than-file-p f1 f2))))
(defun ange-ftp-file-writable-p (file)
@@ -3575,7 +3561,7 @@ Value is (0 0) if the modification time cannot be determined."
(let ((file-mdtm (ange-ftp-file-modtime name))
(buf-mdtm (with-current-buffer buf (visited-file-modtime))))
(or (zerop (car file-mdtm))
- (<= (float-time file-mdtm) (float-time buf-mdtm))))
+ (not (time-less-p buf-mdtm file-mdtm))))
(ange-ftp-real-verify-visited-file-modtime buf))))
(defun ange-ftp-file-size (file &optional ascii-mode)
@@ -3867,12 +3853,12 @@ E.g.,
(unless okay-p (error "%s: %s" 'ange-ftp-copy-files-async line))
(if files
(let* ((ff (car files))
- (from-file (nth 0 ff))
- (to-file (nth 1 ff))
- (ok-if-exists (nth 2 ff))
- (keep-date (nth 3 ff)))
+ (from-file (nth 0 ff))
+ (to-file (nth 1 ff))
+ (ok-if-already-exists (nth 2 ff))
+ (keep-date (nth 3 ff)))
(ange-ftp-copy-file-internal
- from-file to-file ok-if-exists keep-date
+ from-file to-file ok-if-already-exists keep-date
(and verbose-p (format "%s --> %s" from-file to-file))
(list 'ange-ftp-copy-files-async verbose-p (cdr files))
t))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 20ae072f652..b104148d548 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1317,7 +1317,7 @@ used instead of `browse-url-new-window-flag'."
(if (file-exists-p
(setq pidfile (format "/tmp/Mosaic.%d" pid)))
(delete-file pidfile))
- ;; http://debbugs.gnu.org/17428. Use O_EXCL.
+ ;; https://debbugs.gnu.org/17428. Use O_EXCL.
(write-region nil nil pidfile nil 'silent nil 'excl)))
;; Send signal SIGUSR to Mosaic
(message "Signaling Mosaic...")
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index d740829f99c..e79e326dbe2 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/dig.el b/lisp/net/dig.el
index 7e733675b63..ee98e5c444d 100644
--- a/lisp/net/dig.el
+++ b/lisp/net/dig.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/dns.el b/lisp/net/dns.el
index 8615813e074..b4500bd4323 100644
--- a/lisp/net/dns.el
+++ b/lisp/net/dns.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el
index 661ef51e60e..899cdb00a49 100644
--- a/lisp/net/eudc-bob.el
+++ b/lisp/net/eudc-bob.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el
index 222673247b0..1077cc4e8bf 100644
--- a/lisp/net/eudc-export.el
+++ b/lisp/net/eudc-export.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el
index 083fd7fe7e4..05f682d2675 100644
--- a/lisp/net/eudc-hotlist.el
+++ b/lisp/net/eudc-hotlist.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index 79d6f2ebc69..6a831b1265e 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 644df7ab786..b19a838e640 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides a common interface to query directory servers using
diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el
index bfca103bdb0..8dff028b9f1 100644
--- a/lisp/net/eudcb-bbdb.el
+++ b/lisp/net/eudcb-bbdb.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides an interface to use BBDB as a backend of
diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el
index e1900e71ff2..bdc72ef6216 100644
--- a/lisp/net/eudcb-ldap.el
+++ b/lisp/net/eudcb-ldap.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides specific LDAP protocol support for the
diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el
index 43384e2d6fd..2653cfab697 100644
--- a/lisp/net/eudcb-mab.el
+++ b/lisp/net/eudcb-mab.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This library provides an interface to use the Mac's AddressBook,
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index fe316579142..bff592c3fe2 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -297,7 +297,8 @@ word(s) will be searched for via `eww-search-prefix'."
(when (string= (url-filename (url-generic-parse-url url)) "")
(setq url (concat url "/"))))
(setq url (concat eww-search-prefix
- (replace-regexp-in-string " " "+" url))))))
+ (mapconcat
+ #'url-hexify-string (split-string url) "+"))))))
url)
;;;###autoload (defalias 'browse-web 'eww)
@@ -312,11 +313,19 @@ word(s) will be searched for via `eww-search-prefix'."
(expand-file-name file))))
;;;###autoload
-(defun eww-search-words (&optional beg end)
+(defun eww-search-words ()
"Search the web for the text between BEG and END.
-See the `eww-search-prefix' variable for the search engine used."
- (interactive "r")
- (eww (buffer-substring beg end)))
+If region is active (and not whitespace), search the web for
+the text between BEG and END. Else, prompt the user for a search
+string. See the `eww-search-prefix' variable for the search
+engine used."
+ (interactive)
+ (if (use-region-p)
+ (let ((region-string (buffer-substring (region-beginning) (region-end))))
+ (if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
+ (eww region-string)
+ (call-interactively 'eww)))
+ (call-interactively 'eww)))
(defun eww-open-in-new-buffer ()
"Fetch link at point in a new EWW buffer."
@@ -512,7 +521,7 @@ Currently this means either text/html or application/xhtml+xml."
(defun eww-tag-meta (dom)
(when (and (cl-equalp (dom-attr dom 'http-equiv) "refresh")
(< eww-redirect-level 5))
- (when-let (refresh (dom-attr dom 'content))
+ (when-let* ((refresh (dom-attr dom 'content)))
(when (or (string-match "^\\([0-9]+\\) *;.*url=\"\\([^\"]+\\)\"" refresh)
(string-match "^\\([0-9]+\\) *;.*url='\\([^']+\\)'" refresh)
(string-match "^\\([0-9]+\\) *;.*url=\\([^ ]+\\)" refresh))
@@ -1101,13 +1110,13 @@ just re-display the HTML already fetched."
See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(defun eww-process-text-input (beg end replace-length)
- (when-let (pos (and (< (1+ end) (point-max))
- (> (1- end) (point-min))
- (cond
- ((get-text-property (1+ end) 'eww-form)
- (1+ end))
- ((get-text-property (1- end) 'eww-form)
- (1- end)))))
+ (when-let* ((pos (and (< (1+ end) (point-max))
+ (> (1- end) (point-min))
+ (cond
+ ((get-text-property (1+ end) 'eww-form)
+ (1+ end))
+ ((get-text-property (1- end) 'eww-form)
+ (1- end))))))
(let* ((form (get-text-property pos 'eww-form))
(properties (text-properties-at pos))
(buffer-undo-list t)
@@ -1790,8 +1799,8 @@ If CHARSET is nil then use UTF-8."
(setq eww-data (list :title ""))
;; Don't let the history grow infinitely. We store quite a lot of
;; data per page.
- (when-let (tail (and eww-history-limit
- (nthcdr eww-history-limit eww-history)))
+ (when-let* ((tail (and eww-history-limit
+ (nthcdr eww-history-limit eww-history))))
(setcdr tail nil)))
(defvar eww-current-buffer)
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 5db87329c36..d4943a33031 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 2c2274d41ba..6356b9047fb 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el
index 246683444f4..24246af02e7 100644
--- a/lisp/net/hmac-def.el
+++ b/lisp/net/hmac-def.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 53fa153a1eb..b4ef54038ee 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/imap.el b/lisp/net/imap.el
index 7b293921a43..34206ef84cc 100644
--- a/lisp/net/imap.el
+++ b/lisp/net/imap.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index d5303387663..22873ba2334 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 89f6c91156b..b4b38707c89 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -1,4 +1,4 @@
-;;; mailcap.el --- MIME media types configuration
+;;; mailcap.el --- MIME media types configuration -*- lexical-binding: t -*-
;; Copyright (C) 1998-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,7 +29,6 @@
;;; Code:
-(eval-when-compile (require 'cl-lib))
(autoload 'mail-header-parse-content-type "mail-parse")
(defgroup mailcap nil
@@ -70,11 +69,10 @@
(defun mailcap--set-user-mime-data (sym val)
(let (res)
- (dolist (entry val)
- (push `((viewer . ,(car entry))
- (type . ,(cadr entry))
- ,@(when (cl-caddr entry)
- `((test . ,(cl-caddr entry)))))
+ (pcase-dolist (`(,viewer ,type ,test) val)
+ (push `((viewer . ,viewer)
+ (type . ,type)
+ ,@(when test `((test . ,test))))
res))
(set-default sym (nreverse res))))
@@ -121,12 +119,6 @@ is consulted."
(viewer . "gnumeric %s")
(test . (getenv "DISPLAY"))
(type . "application/vnd.ms-excel"))
- ("x-x509-ca-cert"
- (viewer . ssl-view-site-cert)
- (type . "application/x-x509-ca-cert"))
- ("x-x509-user-cert"
- (viewer . ssl-view-user-cert)
- (type . "application/x-x509-user-cert"))
("octet-stream"
(viewer . mailcap-save-binary-file)
(non-viewer . t)
@@ -175,11 +167,11 @@ is consulted."
("pdf"
(viewer . pdf-view-mode)
(type . "application/pdf")
- (test . (eq window-system 'x)))
+ (test . window-system))
("pdf"
(viewer . doc-view-mode)
(type . "application/pdf")
- (test . (eq window-system 'x)))
+ (test . window-system))
("pdf"
(viewer . "gv -safer %s")
(type . "application/pdf")
@@ -331,7 +323,7 @@ means the viewer is always valid. If it is a Lisp function, it is
called with a list of items from any extra fields from the
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'led to yield the validity. If it
+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.")
(put 'mailcap-mime-data 'risky-local-variable t)
@@ -434,9 +426,8 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
(if (stringp path)
(split-string path path-separator t)
path)))
- (if (and (file-readable-p fname)
- (file-regular-p fname))
- (mailcap-parse-mailcap fname)))
+ (when (and (file-readable-p fname) (file-regular-p fname))
+ (mailcap-parse-mailcap fname)))
(setq mailcap-parsed-p t)))
(defun mailcap-parse-mailcap (fname)
@@ -597,13 +588,12 @@ the test clause will be unchanged."
"Return a list of possible viewers from MAJOR for minor type MINOR."
(let ((exact '())
(wildcard '()))
- (while major
+ (pcase-dolist (`(,type . ,attrs) major)
(cond
- ((equal (car (car major)) minor)
- (push (cdr (car major)) exact))
- ((and minor (string-match (concat "^" (car (car major)) "$") minor))
- (push (cdr (car major)) wildcard)))
- (setq major (cdr major)))
+ ((equal type minor)
+ (push attrs exact))
+ ((and minor (string-match (concat "^" type "$") minor))
+ (push attrs wildcard))))
(nconc exact wildcard)))
(defun mailcap-unescape-mime-test (test type-info)
@@ -801,10 +791,9 @@ If NO-DECODE is non-nil, don't decode STRING."
(setq info (mapcar (lambda (a) (cons (symbol-name (car a))
(cdr a)))
(cdr ctl)))
- (while viewers
- (if (mailcap-viewer-passes-test (car viewers) info)
- (push (car viewers) passed))
- (setq viewers (cdr viewers)))
+ (dolist (entry viewers)
+ (when (mailcap-viewer-passes-test entry info)
+ (push entry passed)))
(setq passed (sort passed 'mailcap-viewer-lessp))
(setq viewer (car passed))))
(when (and (stringp (cdr (assq 'viewer viewer)))
@@ -971,8 +960,8 @@ If FORCE, re-parse even if already parsed."
(dolist (fname (reverse (if (stringp path)
(split-string path path-separator t)
path)))
- (if (and (file-readable-p fname))
- (mailcap-parse-mimetype-file fname)))
+ (when (file-readable-p fname)
+ (mailcap-parse-mimetype-file fname)))
(setq mailcap-mimetypes-parsed-p t)))
(defun mailcap-parse-mimetype-file (fname)
@@ -980,7 +969,7 @@ If FORCE, re-parse even if already parsed."
(let (type ; The MIME type for this line
extns ; The extensions for this line
save-pos ; Misc. saved buffer positions
- )
+ save-extn)
(with-temp-buffer
(insert-file-contents fname)
(mailcap-replace-regexp "#.*" "")
@@ -1000,15 +989,13 @@ If FORCE, re-parse even if already parsed."
(skip-chars-forward " \t")
(setq save-pos (point))
(skip-chars-forward "^ \t\n")
- (setq extns (cons (buffer-substring save-pos (point)) extns)))
- (while extns
- (setq mailcap-mime-extensions
- (cons
- (cons (if (= (string-to-char (car extns)) ?.)
- (car extns)
- (concat "." (car extns))) type)
- mailcap-mime-extensions)
- extns (cdr extns)))))))
+ (setq save-extn (buffer-substring save-pos (point)))
+ (push (cons (if (= (string-to-char save-extn) ?.)
+ save-extn (concat "." save-extn))
+ type)
+ extns))
+ (setq mailcap-mime-extensions (append extns mailcap-mime-extensions)
+ extns nil)))))
(defun mailcap-extension-to-mime (extn)
"Return the MIME content type of the file extensions EXTN."
@@ -1018,29 +1005,19 @@ If FORCE, re-parse even if already parsed."
(setq extn (concat "." extn)))
(cdr (assoc (downcase extn) mailcap-mime-extensions)))
-;; Unused?
-(defalias 'mailcap-command-p 'executable-find)
-
(defun mailcap-mime-types ()
"Return a list of MIME media types."
(mailcap-parse-mimetypes)
(delete-dups
(nconc
(mapcar 'cdr mailcap-mime-extensions)
- (apply
- 'nconc
- (mapcar
- (lambda (l)
- (delq nil
- (mapcar
- (lambda (m)
- (let ((type (cdr (assq 'type (cdr m)))))
- (if (equal (cadr (split-string type "/"))
- "*")
- nil
- type)))
- (cdr l))))
- mailcap-mime-data)))))
+ (let (res type)
+ (dolist (data mailcap-mime-data)
+ (dolist (info (cdr data))
+ (setq type (cdr (assq 'type (cdr info))))
+ (unless (string-match-p "\\*" type)
+ (push type res))))
+ (nreverse res)))))
;;;
;;; Useful supplementary functions
@@ -1067,32 +1044,31 @@ If FORCE, re-parse even if already parsed."
;; Intersection of mime-infos from different mime-types;
;; or just the first MIME info for a single MIME type
(if (cdr all-mime-info)
- (delq nil (mapcar (lambda (mi1)
- (unless (memq nil (mapcar
- (lambda (mi2)
- (member mi1 mi2))
- (cdr all-mime-info)))
- mi1))
- (car all-mime-info)))
- (car all-mime-info)))
- (commands
- ;; Command strings from `viewer' field of the MIME info
- (delete-dups
- (delq nil (mapcar
- (lambda (mime-info)
- (let ((command (cdr (assoc 'viewer mime-info))))
- (if (stringp command)
- (replace-regexp-in-string
- ;; Replace mailcap's `%s' placeholder
- ;; with dired's `?' placeholder
- "%s" "?"
- (replace-regexp-in-string
- ;; Remove the final filename placeholder
- "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" ""
- command nil t)
- nil t))))
- common-mime-info)))))
- commands))
+ (let (res)
+ (dolist (mi1 (car all-mime-info))
+ (dolist (mi2 (cdr all-mime-info))
+ (when (member mi1 mi2)
+ (push mi1 res))))
+ (nreverse res))
+ (car all-mime-info))))
+ ;; Command strings from `viewer' field of the MIME info
+ (delete-dups
+ (let (res command)
+ (dolist (mime-info common-mime-info)
+ (setq command (cdr (assq 'viewer mime-info)))
+ (when (stringp command)
+ (push
+ (replace-regexp-in-string
+ ;; Replace mailcap's `%s' placeholder
+ ;; with dired's `?' placeholder
+ "%s" "?"
+ (replace-regexp-in-string
+ ;; Remove the final filename placeholder
+ "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" ""
+ command nil t)
+ nil t)
+ res)))
+ (nreverse res)))))
(defun mailcap-view-mime (type)
"View the data in the current buffer that has MIME type TYPE.
diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el
index 00806a178b3..5dd190c101a 100644
--- a/lisp/net/mairix.el
+++ b/lisp/net/mairix.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el
index 280c6674707..d15df6974b2 100644
--- a/lisp/net/net-utils.el
+++ b/lisp/net/net-utils.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el
index a30d9f6aad8..46a93ee76b3 100644
--- a/lisp/net/netrc.el
+++ b/lisp/net/netrc.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index bf60eee673c..7d8f996fd2d 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index f38c72a26b0..0b3881428e2 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -1,4 +1,4 @@
-;;; newst-backend.el --- Retrieval backend for newsticker.
+;;; newst-backend.el --- Retrieval backend for newsticker -*- lexical-binding:t -*-
;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; ======================================================================
@@ -72,13 +72,9 @@ considered to be running if the newsticker timer list is not empty."
("Debian Security Advisories - Long format"
"http://www.debian.org/security/dsa-long.en.rdf")
("Emacs Wiki"
- "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss"
+ "https://www.emacswiki.org/emacs?action=rss"
nil
3600)
- ("Freshmeat.net"
- "http://freshmeat.net/index.atom")
- ("Kuro5hin.org"
- "http://www.kuro5hin.org/backend.rdf")
("LWN (Linux Weekly News)"
"http://lwn.net/headlines/rss")
("NY Times: Technology"
@@ -102,9 +98,7 @@ considered to be running if the newsticker timer list is not empty."
("Tagesschau (german)"
"http://www.tagesschau.de/newsticker.rdf"
nil
- 1800)
- ("Telepolis (german)"
- "http://www.heise.de/tp/news.rdf"))
+ 1800))
"Default URL list in raw form.
This list is fed into defcustom via `newsticker--splicer'.")
@@ -392,12 +386,12 @@ This hook is run at the very end of `newsticker-stop'."
(defcustom newsticker-new-item-functions
nil
"List of functions run after a new headline has been retrieved.
-Each function is called with the following three arguments:
-FEED the name of the corresponding news feed,
-TITLE the title of the headline,
-DESC the decoded description of the headline.
+Each function is called with the following two arguments:
+FEEDNAME the name of the corresponding news feed,
+ITEM the decoded headline.
-See `newsticker-download-images', and
+See `newsticker-new-item-functions-sample',
+`newsticker-download-images', and
`newsticker-download-enclosures' for sample functions.
Please note that these functions are called only once for a
@@ -605,7 +599,7 @@ name/timer pair to `newsticker--retrieval-timer-list'."
(cons feed-name timer))))))
;;;###autoload
-(defun newsticker-start (&optional do-not-complain-if-running)
+(defun newsticker-start (&optional _do-not-complain-if-running)
"Start the newsticker.
Start the timers for display and retrieval. If the newsticker, i.e. the
timers, are running already a warning message is printed unless
@@ -641,9 +635,8 @@ if newsticker has been running."
(when (fboundp 'newsticker-stop-ticker) ; silence compiler warnings
(newsticker-stop-ticker))
(when (newsticker-running-p)
- (mapc (lambda (name-and-timer)
- (newsticker--stop-feed (car name-and-timer)))
- newsticker--retrieval-timer-list)
+ (dolist (name-and-timer newsticker--retrieval-timer-list)
+ (newsticker--stop-feed (car name-and-timer)))
(setq newsticker--retrieval-timer-list nil)
(run-hooks 'newsticker-stop-hook)
(message "Newsticker stopped!")))
@@ -653,9 +646,8 @@ if newsticker has been running."
This does NOT start the retrieval timers."
(interactive)
;; launch retrieval of news
- (mapc (lambda (item)
- (newsticker-get-news (car item)))
- (append newsticker-url-list-defaults newsticker-url-list)))
+ (dolist (item (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker-get-news (car item))))
(defun newsticker-save-item (feed item)
"Save FEED ITEM."
@@ -711,7 +703,7 @@ See `newsticker-get-news'."
(let ((buffername (concat " *newsticker-funcall-" feed-name "*")))
(with-current-buffer (get-buffer-create buffername)
(erase-buffer)
- (insert (string-to-multibyte (funcall function feed-name)))
+ (newsticker--insert-bytes (funcall function feed-name))
(newsticker--sentinel-work nil t feed-name function
(current-buffer)))))
@@ -732,10 +724,10 @@ STATUS is the return status as delivered by `url-retrieve', and
FEED-NAME is the name of the feed that the news were retrieved
from."
(let ((buf (get-buffer-create (concat " *newsticker-url-" feed-name "*")))
- (result (string-to-multibyte (buffer-string))))
+ (result (buffer-string)))
(set-buffer buf)
(erase-buffer)
- (insert result)
+ (newsticker--insert-bytes result)
;; remove MIME header
(goto-char (point-min))
(search-forward "\n\n" nil t)
@@ -1257,9 +1249,6 @@ For the RSS 0.91 specification see URL `http://backend.userland.com/rss091'
or URL `http://my.netscape.com/publish/formats/rss-spec-0.91.html'."
(newsticker--debug-msg "Parsing RSS 0.91 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
- (pub-date (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children channelnode 'pubDate))))))
is-new-feed has-new-items)
(setq is-new-feed (newsticker--parse-generic-feed
name time
@@ -1295,7 +1284,7 @@ or URL `http://my.netscape.com/publish/formats/rss-spec-0.91.html'."
(car (xml-node-children
(car (xml-get-children node 'pubDate))))))
;; guid-fn
- (lambda (node)
+ (lambda (_node)
nil)
;; extra-fn
(lambda (node)
@@ -1310,9 +1299,6 @@ same as in `newsticker--parse-atom-1.0'.
For the RSS 0.92 specification see URL `http://backend.userland.com/rss092'."
(newsticker--debug-msg "Parsing RSS 0.92 feed %s" name)
(let* ((channelnode (car (xml-get-children topnode 'channel)))
- (pub-date (newsticker--decode-rfc822-date
- (car (xml-node-children
- (car (xml-get-children channelnode 'pubDate))))))
is-new-feed has-new-items)
(setq is-new-feed (newsticker--parse-generic-feed
name time
@@ -1348,7 +1334,7 @@ For the RSS 0.92 specification see URL `http://backend.userland.com/rss092'."
(car (xml-node-children
(car (xml-get-children node 'pubDate))))))
;; guid-fn
- (lambda (node)
+ (lambda (_node)
nil)
;; extra-fn
(lambda (node)
@@ -1407,7 +1393,7 @@ For the RSS 1.0 specification see URL `http://web.resource.org/rss/1.0/spec'."
(car (xml-node-children
(car (xml-get-children node 'date)))))))
;; guid-fn
- (lambda (node)
+ (lambda (_node)
nil)
;; extra-fn
(lambda (node)
@@ -1488,7 +1474,6 @@ The arguments TITLE, DESC, LINK, and EXTRA-ELEMENTS give the feed's title,
description, link, and extra elements resp."
(let ((title (or title "[untitled]"))
(link (or link ""))
- (old-item nil)
(position 0)
(something-was-added nil))
;; decode numeric entities
@@ -1524,89 +1509,89 @@ The arguments TITLE-FN, DESC-FN, LINK-FN, TIME-FN, GUID-FN, and
EXTRA-FN give functions for extracting title, description, link,
time, guid, and extra-elements resp. They are called with one
argument, which is one of the items in ITEMLIST."
- (let (title desc link
- (old-item nil)
- (position 0)
+ (let ((position 0)
(something-was-added nil))
;; gather all items for this feed
- (mapc (lambda (node)
- (setq position (1+ position))
- (setq title (or (funcall title-fn node) "[untitled]"))
- (setq desc (funcall desc-fn node))
- (setq link (or (funcall link-fn node) ""))
- (setq time (or (funcall time-fn node) time))
- ;; It happened that the title or description
- ;; contained evil HTML code that confused the
- ;; xml parser. Therefore:
- (unless (stringp title)
- (setq title (prin1-to-string title)))
- (unless (or (stringp desc) (not desc))
- (setq desc (prin1-to-string desc)))
- ;; ignore items with empty title AND empty desc
- (when (or (> (length title) 0)
- (> (length desc) 0))
- ;; decode numeric entities
- (setq title (xml-substitute-numeric-entities title))
- (when desc
- (setq desc (xml-substitute-numeric-entities desc)))
- (setq link (xml-substitute-numeric-entities link))
- ;; remove whitespace from title, desc, and link
- (setq title (newsticker--remove-whitespace title))
- (setq desc (newsticker--remove-whitespace desc))
- (setq link (newsticker--remove-whitespace link))
- ;; add data to cache
- ;; do we have this item already?
- (let* ((guid (funcall guid-fn node)))
- ;;(message "guid=%s" guid)
- (setq old-item
- (newsticker--cache-contains newsticker--cache
- (intern name) title
- desc link nil guid)))
- ;; add this item, or mark it as old, or do nothing
- (let ((age1 'new)
- (age2 'old)
- (item-new-p nil))
- (if old-item
- (let ((prev-age (newsticker--age old-item)))
- (unless newsticker-automatically-mark-items-as-old
- ;; Some feeds deliver items multiply, the
- ;; first time we find an 'obsolete-old one in
- ;; the cache, the following times we find an
- ;; 'old one
- (if (memq prev-age '(obsolete-old old))
- (setq age2 'old)
- (setq age2 'new)))
- (if (eq prev-age 'immortal)
- (setq age2 'immortal))
- (setq time (newsticker--time old-item)))
- ;; item was not there
- (setq item-new-p t)
- (setq something-was-added t))
- (let ((extra-elements-with-guid (funcall extra-fn node)))
- (unless (assoc 'guid extra-elements-with-guid)
- (setq extra-elements-with-guid
- (cons `(guid nil ,(funcall guid-fn node))
- extra-elements-with-guid)))
- (setq newsticker--cache
- (newsticker--cache-add
- newsticker--cache (intern name) title desc link
- time age1 position extra-elements-with-guid
- time age2)))
- (when item-new-p
- (let ((item (newsticker--cache-contains
- newsticker--cache (intern name) title
- desc link nil)))
- (if newsticker-auto-mark-filter-list
- (newsticker--run-auto-mark-filter name item))
- (run-hook-with-args
- 'newsticker-new-item-functions name item))))))
- itemlist)
+ (dolist (node itemlist)
+ (setq position (1+ position))
+ (let ((title (or (funcall title-fn node) "[untitled]"))
+ (desc (funcall desc-fn node))
+ (link (or (funcall link-fn node) "")))
+ (setq time (or (funcall time-fn node) time))
+ ;; It happened that the title or description
+ ;; contained evil HTML code that confused the
+ ;; xml parser. Therefore:
+ (unless (stringp title)
+ (setq title (prin1-to-string title)))
+ (unless (or (stringp desc) (not desc))
+ (setq desc (prin1-to-string desc)))
+ ;; ignore items with empty title AND empty desc
+ (when (or (> (length title) 0)
+ (> (length desc) 0))
+ ;; decode numeric entities
+ (setq title (xml-substitute-numeric-entities title))
+ (when desc
+ (setq desc (xml-substitute-numeric-entities desc)))
+ (setq link (xml-substitute-numeric-entities link))
+ ;; remove whitespace from title, desc, and link
+ (setq title (newsticker--remove-whitespace title))
+ (setq desc (newsticker--remove-whitespace desc))
+ (setq link (newsticker--remove-whitespace link))
+ ;; add data to cache
+ ;; do we have this item already?
+ (let ((old-item
+ (let* ((guid (funcall guid-fn node)))
+ ;;(message "guid=%s" guid)
+ (newsticker--cache-contains newsticker--cache
+ (intern name) title
+ desc link nil guid)))
+ (age1 'new)
+ (age2 'old)
+ (item-new-p nil))
+ ;; Add this item, or mark it as old, or do nothing
+ (if old-item
+ (let ((prev-age (newsticker--age old-item)))
+ (unless newsticker-automatically-mark-items-as-old
+ ;; Some feeds deliver items multiply, the
+ ;; first time we find an 'obsolete-old one in
+ ;; the cache, the following times we find an
+ ;; 'old one
+ (if (memq prev-age '(obsolete-old old))
+ (setq age2 'old)
+ (setq age2 'new)))
+ (if (eq prev-age 'immortal)
+ (setq age2 'immortal))
+ (setq time (newsticker--time old-item)))
+ ;; item was not there
+ (setq item-new-p t)
+ (setq something-was-added t))
+ (let ((extra-elements-with-guid (funcall extra-fn node)))
+ (unless (assoc 'guid extra-elements-with-guid)
+ (setq extra-elements-with-guid
+ (cons `(guid nil ,(funcall guid-fn node))
+ extra-elements-with-guid)))
+ (setq newsticker--cache
+ (newsticker--cache-add
+ newsticker--cache (intern name) title desc link
+ time age1 position extra-elements-with-guid
+ time age2)))
+ (when item-new-p
+ (let ((item (newsticker--cache-contains
+ newsticker--cache (intern name) title
+ desc link nil)))
+ (if newsticker-auto-mark-filter-list
+ (newsticker--run-auto-mark-filter name item))
+ (run-hook-with-args
+ 'newsticker-new-item-functions name item)))))))
something-was-added))
;; ======================================================================
;;; Misc
;; ======================================================================
+(defun newsticker--insert-bytes (bytes)
+ (insert (decode-coding-string bytes 'binary)))
+
(defun newsticker--remove-whitespace (string)
"Remove leading and trailing whitespace from STRING."
;; we must have ...+ but not ...* in the regexps otherwise xemacs loops
@@ -1761,12 +1746,11 @@ Sat, 07 Sep 2002 00:00:01 GMT
(setq minute (+ minute offset-minute)))))
(condition-case error-data
(let ((i 1))
- (mapc (lambda (m)
- (if (string= month-name m)
- (setq month i))
- (setq i (1+ i)))
- '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
- "Sep" "Oct" "Nov" "Dec"))
+ (dolist (m '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug"
+ "Sep" "Oct" "Nov" "Dec"))
+ (if (string= month-name m)
+ (setq month i))
+ (setq i (1+ i)))
(encode-time second minute hour day month year t))
(error
(message "Cannot decode \"%s\": %s %s" rfc822-string
@@ -1777,22 +1761,19 @@ Sat, 07 Sep 2002 00:00:01 GMT
(defun newsticker--lists-intersect-p (list1 list2)
"Return t if LIST1 and LIST2 share elements."
(let ((result nil))
- (mapc (lambda (elt)
- (if (memq elt list2)
- (setq result t)))
- list1)
+ (dolist (elt list1)
+ (if (memq elt list2)
+ (setq result t)))
result))
(defun newsticker--update-process-ids ()
"Update list of ids of active newsticker processes.
Checks list of active processes against list of newsticker processes."
- (let ((active-procs (process-list))
- (new-list nil))
- (mapc (lambda (proc)
- (let ((id (process-id proc)))
- (if (memq id newsticker--process-ids)
- (setq new-list (cons id new-list)))))
- active-procs)
+ (let ((new-list nil))
+ (dolist (proc (process-list))
+ (let ((id (process-id proc)))
+ (if (memq id newsticker--process-ids)
+ (setq new-list (cons id new-list)))))
(setq newsticker--process-ids new-list))
(force-mode-line-update))
@@ -1813,7 +1794,7 @@ If the file does no exist or if it is older than 24 hours
download it from URL first."
(let ((image-name (concat directory feed-name)))
(if (and (file-exists-p image-name)
- (time-less-p (current-time)
+ (time-less-p nil
(time-add (nth 5 (file-attributes image-name))
(seconds-to-time 86400))))
(newsticker--debug-msg "%s: Getting image for %s skipped"
@@ -1855,7 +1836,7 @@ Save image as FILENAME in DIRECTORY, download it from URL."
(process-put proc 'nt-feed-name feed-name)
(process-put proc 'nt-filename filename)))))
-(defun newsticker--image-sentinel (process event)
+(defun newsticker--image-sentinel (process _event)
"Sentinel for image-retrieving PROCESS caused by EVENT."
(let* ((p-status (process-status process))
(exit-status (process-exit-status process))
@@ -1916,21 +1897,21 @@ from.
The image is saved in DIRECTORY as FILENAME."
(let ((do-save
(or (not status)
- (let ((status-type (car status))
- (status-details (cdr status)))
- (cond ((eq status-type :redirect)
- ;; don't care about redirects
- t)
- ((eq status-type :error)
- ;; silently ignore errors
- nil))))))
+ ;; (let ((status-type (car status)))
+ ;; (cond ((eq status-type :redirect)
+ ;; ;; don't care about redirects
+ ;; t)
+ ;; ((eq status-type :error)
+ ;; ;; silently ignore errors
+ ;; nil)))
+ (eq (car status) :redirect))))
(when do-save
(let ((buf (get-buffer-create (concat " *newsticker-url-image-" feed-name "-"
directory "*")))
- (result (string-to-multibyte (buffer-string))))
+ (result (buffer-string)))
(set-buffer buf)
(erase-buffer)
- (insert result)
+ (newsticker--insert-bytes result)
;; remove MIME header
(goto-char (point-min))
(search-forward "\n\n")
@@ -2010,7 +1991,7 @@ older than TIME."
(when (eq (newsticker--age item) old-age)
(let ((exp-time (time-add (newsticker--time item)
(seconds-to-time time))))
- (when (time-less-p exp-time (current-time))
+ (when (time-less-p exp-time nil)
(newsticker--debug-msg
"Item `%s' from %s has expired on %s"
(newsticker--title item)
@@ -2022,7 +2003,7 @@ older than TIME."
data)
data)
-(defun newsticker--cache-contains (data feed title desc link age
+(defun newsticker--cache-contains (data feed title desc link _age
&optional guid)
"Check DATA whether FEED contains an item with the given properties.
This function returns the contained item or nil if it is not
@@ -2295,9 +2276,8 @@ FEED is a symbol!"
(newsticker--cache-read-version1))
(when (y-or-n-p (format "Delete old newsticker cache file? "))
(delete-file newsticker-cache-filename)))
- (mapc (lambda (f)
- (newsticker--cache-read-feed (car f)))
- (append newsticker-url-list-defaults newsticker-url-list))))
+ (dolist (f (append newsticker-url-list-defaults newsticker-url-list))
+ (newsticker--cache-read-feed (car f)))))
(defun newsticker--cache-read-feed (feed-name)
"Read cache data for feed named FEED-NAME."
@@ -2364,14 +2344,13 @@ Export subscriptions to a buffer in OPML Format."
" <ownerName>" (user-full-name) "</ownerName>\n"
" </head>\n"
" <body>\n"))
- (mapc (lambda (sub)
- (insert " <outline text=\"")
- (insert (newsticker--title sub))
- (insert "\" xmlUrl=\"")
- (insert (xml-escape-string (let ((url (cadr sub)))
- (if (stringp url) url (prin1-to-string url)))))
- (insert "\"/>\n"))
- (append newsticker-url-list newsticker-url-list-defaults))
+ (dolist (sub (append newsticker-url-list newsticker-url-list-defaults))
+ (insert " <outline text=\"")
+ (insert (newsticker--title sub))
+ (insert "\" xmlUrl=\"")
+ (insert (xml-escape-string (let ((url (cadr sub)))
+ (if (stringp url) url (prin1-to-string url)))))
+ (insert "\"/>\n"))
(insert " </body>\n</opml>\n"))
(pop-to-buffer "*OPML Export*")
(when (fboundp 'sgml-mode)
@@ -2411,28 +2390,26 @@ removed."
This function checks the variable `newsticker-auto-mark-filter-list'
for an entry that matches FEED and ITEM."
(let ((case-fold-search t))
- (mapc (lambda (filter)
- (let ((filter-feed (car filter))
- (pattern-list (cadr filter)))
- (when (string-match filter-feed feed)
- (newsticker--do-run-auto-mark-filter item pattern-list))))
- newsticker-auto-mark-filter-list)))
+ (dolist (filter newsticker-auto-mark-filter-list)
+ (let ((filter-feed (car filter))
+ (pattern-list (cadr filter)))
+ (when (string-match filter-feed feed)
+ (newsticker--do-run-auto-mark-filter item pattern-list))))))
(defun newsticker--do-run-auto-mark-filter (item list)
"Actually compare ITEM against the pattern-LIST.
LIST must be an element of `newsticker-auto-mark-filter-list'."
- (mapc (lambda (pattern)
- (let ((place (nth 1 pattern))
- (regexp (nth 2 pattern))
- (title (newsticker--title item))
- (desc (newsticker--desc item)))
- (when (or (eq place 'title) (eq place 'all))
- (when (and title (string-match regexp title))
- (newsticker--process-auto-mark-filter-match item pattern)))
- (when (or (eq place 'description) (eq place 'all))
- (when (and desc (string-match regexp desc))
- (newsticker--process-auto-mark-filter-match item pattern)))))
- list))
+ (dolist (pattern list)
+ (let ((place (nth 1 pattern))
+ (regexp (nth 2 pattern))
+ (title (newsticker--title item))
+ (desc (newsticker--desc item)))
+ (when (or (eq place 'title) (eq place 'all))
+ (when (and title (string-match regexp title))
+ (newsticker--process-auto-mark-filter-match item pattern)))
+ (when (or (eq place 'description) (eq place 'all))
+ (when (and desc (string-match regexp desc))
+ (newsticker--process-auto-mark-filter-match item pattern))))))
(defun newsticker--process-auto-mark-filter-match (item pattern)
"Process ITEM that matches an auto-mark-filter PATTERN."
@@ -2450,24 +2427,25 @@ LIST must be an element of `newsticker-auto-mark-filter-list'."
;; ======================================================================
;;; Hook samples
;; ======================================================================
-(defun newsticker-new-item-functions-sample (feed item)
+(defun newsticker-new-item-functions-sample (feedname item)
"Demonstrate the use of the `newsticker-new-item-functions' hook.
-This function just prints out the values of the FEED and title of the ITEM."
+This function just prints out the values of the FEEDNAME and title of the ITEM."
(message (concat "newsticker-new-item-functions-sample: feed=`%s', "
"title=`%s'")
- feed (newsticker--title item)))
+ feedname (newsticker--title item)))
-(defun newsticker-download-images (feed item)
+(defun newsticker-download-images (feedname item)
"Download the first image.
-If FEED equals \"imagefeed\" download the first image URL found
-in the description=contents of ITEM to the directory
-\"~/tmp/newsticker/FEED/TITLE\" where TITLE is the title of the item."
- (when (string= feed "imagefeed")
+If FEEDNAME equals \"imagefeed\" download the first image URL
+found in the description=contents of ITEM to the directory
+\"~/tmp/newsticker/FEEDNAME/TITLE\" where TITLE is the title of
+the item."
+ (when (string= feedname "imagefeed")
(let ((title (newsticker--title item))
(desc (newsticker--desc item)))
(when (string-match "<img src=\"\\(http://[^ \"]+\\)\"" desc)
(let ((url (substring desc (match-beginning 1) (match-end 1)))
- (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
+ (temp-dir (concat "~/tmp/newsticker/" feedname "/" title))
(org-dir default-directory))
(unless (file-directory-p temp-dir)
(make-directory temp-dir t))
@@ -2479,17 +2457,17 @@ in the description=contents of ITEM to the directory
(list url))
(cd org-dir))))))
-(defun newsticker-download-enclosures (feed item)
- "In all FEEDs download the enclosed object of the news ITEM.
-The object is saved to the directory \"~/tmp/newsticker/FEED/TITLE\", which
+(defun newsticker-download-enclosures (feedname item)
+ "In all feeds download the enclosed object of the news ITEM.
+The object is saved to the directory \"~/tmp/newsticker/FEEDNAME/TITLE\", which
is created if it does not exist. TITLE is the title of the news
-item. Argument FEED is ignored.
+item. Argument FEEDNAME is ignored.
This function is suited for adding it to `newsticker-new-item-functions'."
(let ((title (newsticker--title item))
(enclosure (newsticker--enclosure item)))
(when enclosure
(let ((url (cdr (assoc 'url enclosure)))
- (temp-dir (concat "~/tmp/newsticker/" feed "/" title))
+ (temp-dir (concat "~/tmp/newsticker/" feedname "/" title))
(org-dir default-directory))
(unless (file-directory-p temp-dir)
(make-directory temp-dir t))
@@ -2504,7 +2482,7 @@ This function is suited for adding it to `newsticker-new-item-functions'."
;; ======================================================================
;;; Retrieve samples
;; ======================================================================
-(defun newsticker-retrieve-random-message (feed-name)
+(defun newsticker-retrieve-random-message (_feed-name)
"Return an artificial RSS string under the name FEED-NAME."
(concat "<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?><rss version=\"0.91\">"
"<channel>"
diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el
index eab3e244411..d5c9d32a07d 100644
--- a/lisp/net/newst-plainview.el
+++ b/lisp/net/newst-plainview.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; ======================================================================
;;; Commentary:
diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el
index c781f0dfec1..97bb21ee649 100644
--- a/lisp/net/newst-reader.el
+++ b/lisp/net/newst-reader.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; ======================================================================
;;; Commentary:
diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el
index 93198e3dbad..eb6ff19d5c2 100644
--- a/lisp/net/newst-ticker.el
+++ b/lisp/net/newst-ticker.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; ======================================================================
@@ -118,7 +118,7 @@ been added between the last two retrievals."
(defcustom newsticker-hide-obsolete-items-in-echo-area
t
- "Decides whether to show obsolete items items in the ticker.
+ "Decides whether to show obsolete items in the ticker.
If t the echo area will not show obsolete items. See also
`newsticker-hide-old-items-in-echo-area'."
:type 'boolean
diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el
index e93da3e1c47..61b98165d1b 100644
--- a/lisp/net/newst-treeview.el
+++ b/lisp/net/newst-treeview.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; ======================================================================
;;; Commentary:
diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el
index 971bdf64f41..075671e0fb9 100644
--- a/lisp/net/newsticker.el
+++ b/lisp/net/newsticker.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(defconst newsticker-version "1.99" "Version number of newsticker.el.")
(make-obsolete-variable 'newsticker-version 'emacs-version "25.1")
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 8d3463ef0a5..87fa9778b6d 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -18,14 +18,14 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'cl-lib)
-(require 'subr-x) ; read-multiple-choice
+(require 'rmc) ; read-multiple-choice
(defvar nsm-permanent-host-settings nil)
(defvar nsm-temporary-host-settings nil)
diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 4baa8f2081a..137231c9af7 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el
deleted file mode 100644
index 3e43b7d9dea..00000000000
--- a/lisp/net/pinentry.el
+++ /dev/null
@@ -1,460 +0,0 @@
-;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding: t -*-
-
-;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@gnu.org>
-;; Version: 0.1
-;; Keywords: GnuPG
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This package allows GnuPG passphrase to be prompted through the
-;; minibuffer instead of graphical dialog.
-;;
-;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf",
-;; reload the configuration with "gpgconf --reload gpg-agent", and
-;; start the server with M-x pinentry-start.
-;;
-;; The actual communication path between the relevant components is
-;; as follows:
-;;
-;; gpg --> gpg-agent --> pinentry --> Emacs
-;;
-;; where pinentry and Emacs communicate through a Unix domain socket
-;; created at:
-;;
-;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry
-;;
-;; under the same directory which server.el uses. The protocol is a
-;; subset of the Pinentry Assuan protocol described in (info
-;; "(pinentry) Protocol").
-;;
-;; NOTE: As of August 2015, this feature requires newer versions of
-;; GnuPG (2.1.5+) and Pinentry (0.9.5+).
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-
-(defgroup pinentry nil
- "The Pinentry server"
- :version "25.1"
- :group 'external)
-
-(defcustom pinentry-popup-prompt-window t
- "If non-nil, display multiline prompt in another window."
- :type 'boolean
- :group 'pinentry)
-
-(defcustom pinentry-prompt-window-height 5
- "Number of lines used to display multiline prompt."
- :type 'integer
- :group 'pinentry)
-
-(defvar pinentry-debug nil)
-(defvar pinentry-debug-buffer nil)
-(defvar pinentry--server-process nil)
-(defvar pinentry--connection-process-list nil)
-
-(defvar pinentry--labels nil)
-(put 'pinentry-read-point 'permanent-local t)
-(defvar pinentry--read-point nil)
-(put 'pinentry--read-point 'permanent-local t)
-
-(defvar pinentry--prompt-buffer nil)
-
-;; We use the same location as `server-socket-dir', when local sockets
-;; are supported.
-(defvar pinentry--socket-dir
- (format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))
- "The directory in which to place the server socket.
-If local sockets are not supported, this is nil.")
-
-(defconst pinentry--set-label-commands
- '("SETPROMPT" "SETTITLE" "SETDESC"
- "SETREPEAT" "SETREPEATERROR"
- "SETOK" "SETCANCEL" "SETNOTOK"))
-
-;; These error codes are defined in libgpg-error/src/err-codes.h.in.
-(defmacro pinentry--error-code (code)
- (logior (lsh 5 24) code))
-(defconst pinentry--error-not-implemented
- (cons (pinentry--error-code 69) "not implemented"))
-(defconst pinentry--error-cancelled
- (cons (pinentry--error-code 99) "cancelled"))
-(defconst pinentry--error-not-confirmed
- (cons (pinentry--error-code 114) "not confirmed"))
-
-(autoload 'server-ensure-safe-dir "server")
-
-(defvar pinentry-prompt-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "q" 'quit-window)
- keymap))
-
-(define-derived-mode pinentry-prompt-mode special-mode "Pinentry"
- "Major mode for `pinentry--prompt-buffer'."
- (buffer-disable-undo)
- (setq truncate-lines t
- buffer-read-only t))
-
-(defun pinentry--prompt (labels query-function &rest query-args)
- (let ((desc (cdr (assq 'desc labels)))
- (error (cdr (assq 'error labels)))
- (prompt (cdr (assq 'prompt labels))))
- (when (string-match "[ \n]*\\'" prompt)
- (setq prompt (concat
- (substring
- prompt 0 (match-beginning 0)) " ")))
- (when error
- (setq desc (concat "Error: " (propertize error 'face 'error)
- "\n" desc)))
- (if (and desc pinentry-popup-prompt-window)
- (save-window-excursion
- (delete-other-windows)
- (unless (and pinentry--prompt-buffer
- (buffer-live-p pinentry--prompt-buffer))
- (setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*")))
- (if (get-buffer-window pinentry--prompt-buffer)
- (delete-window (get-buffer-window pinentry--prompt-buffer)))
- (with-current-buffer pinentry--prompt-buffer
- (let ((inhibit-read-only t)
- buffer-read-only)
- (erase-buffer)
- (insert desc))
- (pinentry-prompt-mode)
- (goto-char (point-min)))
- (if (> (window-height)
- pinentry-prompt-window-height)
- (set-window-buffer (split-window nil
- (- (window-height)
- pinentry-prompt-window-height))
- pinentry--prompt-buffer)
- (pop-to-buffer pinentry--prompt-buffer)
- (if (> (window-height) pinentry-prompt-window-height)
- (shrink-window (- (window-height)
- pinentry-prompt-window-height))))
- (prog1 (apply query-function prompt query-args)
- (quit-window)))
- (apply query-function (concat desc "\n" prompt) query-args))))
-
-;;;###autoload
-(defun pinentry-start (&optional quiet)
- "Start a Pinentry service.
-
-Once the environment is properly set, subsequent invocations of
-the gpg command will interact with Emacs for passphrase input.
-
-If the optional QUIET argument is non-nil, messages at startup
-will not be shown."
- (interactive)
- (unless (featurep 'make-network-process '(:family local))
- (error "local sockets are not supported"))
- (if (process-live-p pinentry--server-process)
- (unless quiet
- (message "Pinentry service is already running"))
- (let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir)))
- (server-ensure-safe-dir pinentry--socket-dir)
- ;; Delete the socket files made by previous server invocations.
- (ignore-errors
- (let (delete-by-moving-to-trash)
- (delete-file server-file)))
- (cl-letf (((default-file-modes) ?\700))
- (setq pinentry--server-process
- (make-network-process
- :name "pinentry"
- :server t
- :noquery t
- :sentinel #'pinentry--process-sentinel
- :filter #'pinentry--process-filter
- :coding 'no-conversion
- :family 'local
- :service server-file))
- (process-put pinentry--server-process :server-file server-file)))))
-
-(defun pinentry-stop ()
- "Stop a Pinentry service."
- (interactive)
- (when (process-live-p pinentry--server-process)
- (delete-process pinentry--server-process))
- (setq pinentry--server-process nil)
- (dolist (process pinentry--connection-process-list)
- (when (buffer-live-p (process-buffer process))
- (kill-buffer (process-buffer process))))
- (setq pinentry--connection-process-list nil))
-
-(defun pinentry--labels-to-shortcuts (labels)
- "Convert strings in LABEL by stripping mnemonics."
- (mapcar (lambda (label)
- (when label
- (let (c)
- (if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label)
- (let ((key (match-string 1 label)))
- (setq c (downcase (aref key 0)))
- (setq label (replace-match
- (propertize key 'face 'underline)
- t t label)))
- (setq c (if (= (length label) 0)
- ??
- (downcase (aref label 0)))))
- ;; Double underscores mean a single underscore.
- (when (string-match "__" label)
- (setq label (replace-match "_" t t label)))
- (cons c label))))
- labels))
-
-(defun pinentry--escape-string (string)
- "Escape STRING in the Assuan percent escape."
- (let ((length (length string))
- (index 0)
- (count 0))
- (while (< index length)
- (if (memq (aref string index) '(?\n ?\r ?%))
- (setq count (1+ count)))
- (setq index (1+ index)))
- (setq index 0)
- (let ((result (make-string (+ length (* count 2)) ?\0))
- (result-index 0)
- c)
- (while (< index length)
- (setq c (aref string index))
- (if (memq c '(?\n ?\r ?%))
- (let ((hex (format "%02X" c)))
- (aset result result-index ?%)
- (setq result-index (1+ result-index))
- (aset result result-index (aref hex 0))
- (setq result-index (1+ result-index))
- (aset result result-index (aref hex 1))
- (setq result-index (1+ result-index)))
- (aset result result-index c)
- (setq result-index (1+ result-index)))
- (setq index (1+ index)))
- result)))
-
-(defun pinentry--unescape-string (string)
- "Unescape STRING in the Assuan percent escape."
- (let ((length (length string))
- (index 0))
- (let ((result (make-string length ?\0))
- (result-index 0)
- c)
- (while (< index length)
- (setq c (aref string index))
- (if (and (eq c '?%) (< (+ index 2) length))
- (progn
- (aset result result-index
- (string-to-number (substring string
- (1+ index)
- (+ index 3))
- 16))
- (setq result-index (1+ result-index))
- (setq index (+ index 2)))
- (aset result result-index c)
- (setq result-index (1+ result-index)))
- (setq index (1+ index)))
- (substring result 0 result-index))))
-
-(defun pinentry--send-data (process escaped)
- "Send a string ESCAPED to a process PROCESS.
-ESCAPED will be split if it exceeds the line length limit of the
-Assuan protocol."
- (let ((length (length escaped))
- (index 0))
- (if (= length 0)
- (process-send-string process "D \n")
- (while (< index length)
- ;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n")
- (let* ((sub-length (min (- length index) 997))
- (sub (substring escaped index (+ index sub-length))))
- (unwind-protect
- (progn
- (process-send-string process "D ")
- (process-send-string process sub)
- (process-send-string process "\n"))
- (clear-string sub))
- (setq index (+ index sub-length)))))))
-
-(defun pinentry--send-error (process error)
- (process-send-string process (format "ERR %d %s\n" (car error) (cdr error))))
-
-(defun pinentry--process-filter (process input)
- (unless (buffer-live-p (process-buffer process))
- (let ((buffer (generate-new-buffer " *pinentry*")))
- (set-process-buffer process buffer)
- (with-current-buffer buffer
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
- (make-local-variable 'pinentry--read-point)
- (setq pinentry--read-point (point-min))
- (make-local-variable 'pinentry--labels))))
- (with-current-buffer (process-buffer process)
- (when pinentry-debug
- (with-current-buffer
- (or pinentry-debug-buffer
- (setq pinentry-debug-buffer (generate-new-buffer
- " *pinentry-debug*")))
- (goto-char (point-max))
- (insert input)))
- (save-excursion
- (goto-char (point-max))
- (insert input)
- (goto-char pinentry--read-point)
- (beginning-of-line)
- (while (looking-at ".*\n") ;the input line finished
- (if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)")
- (let ((command (match-string 1))
- (string (pinentry--unescape-string (match-string 2))))
- (pcase command
- ((and set (guard (member set pinentry--set-label-commands)))
- (when (> (length string) 0)
- (let* ((symbol (intern (downcase (substring set 3))))
- (entry (assq symbol pinentry--labels))
- (label (decode-coding-string string 'utf-8)))
- (if entry
- (setcdr entry label)
- (push (cons symbol label) pinentry--labels))))
- (ignore-errors
- (process-send-string process "OK\n")))
- ("NOP"
- (ignore-errors
- (process-send-string process "OK\n")))
- ("GETPIN"
- (let ((confirm (not (null (assq 'repeat pinentry--labels))))
- passphrase escaped-passphrase encoded-passphrase)
- (unwind-protect
- (condition-case err
- (progn
- (setq passphrase
- (pinentry--prompt
- pinentry--labels
- #'read-passwd confirm))
- (setq escaped-passphrase
- (pinentry--escape-string
- passphrase))
- (setq encoded-passphrase (encode-coding-string
- escaped-passphrase
- 'utf-8))
- (ignore-errors
- (pinentry--send-data
- process encoded-passphrase)
- (process-send-string process "OK\n")))
- (error
- (message "GETPIN error %S" err)
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-cancelled))))
- (if passphrase
- (clear-string passphrase))
- (if escaped-passphrase
- (clear-string escaped-passphrase))
- (if encoded-passphrase
- (clear-string encoded-passphrase))))
- (setq pinentry--labels nil))
- ("CONFIRM"
- (let ((prompt
- (or (cdr (assq 'prompt pinentry--labels))
- "Confirm? "))
- (buttons
- (delq nil
- (pinentry--labels-to-shortcuts
- (list (cdr (assq 'ok pinentry--labels))
- (cdr (assq 'notok pinentry--labels))
- (cdr (assq 'cancel pinentry--labels))))))
- entry)
- (if buttons
- (progn
- (setq prompt
- (concat prompt " ("
- (mapconcat #'cdr buttons
- ", ")
- ") "))
- (if (setq entry (assq 'prompt pinentry--labels))
- (setcdr entry prompt)
- (setq pinentry--labels (cons (cons 'prompt prompt)
- pinentry--labels)))
- (condition-case nil
- (let ((result (pinentry--prompt pinentry--labels
- #'read-char)))
- (if (eq result (caar buttons))
- (ignore-errors
- (process-send-string process "OK\n"))
- (if (eq result (car (nth 1 buttons)))
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-not-confirmed))
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-cancelled)))))
- (error
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-cancelled)))))
- (if (setq entry (assq 'prompt pinentry--labels))
- (setcdr entry prompt)
- (setq pinentry--labels (cons (cons 'prompt prompt)
- pinentry--labels)))
- (if (condition-case nil
- (pinentry--prompt pinentry--labels #'y-or-n-p)
- (quit))
- (ignore-errors
- (process-send-string process "OK\n"))
- (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-not-confirmed))))
- (setq pinentry--labels nil)))
- (_ (ignore-errors
- (pinentry--send-error
- process
- pinentry--error-not-implemented))))
- (forward-line)
- (setq pinentry--read-point (point))))))))
-
-(defun pinentry--process-sentinel (process _status)
- "The process sentinel for Emacs server connections."
- ;; If this is a new client process, set the query-on-exit flag to nil
- ;; for this process (it isn't inherited from the server process).
- (when (and (eq (process-status process) 'open)
- (process-query-on-exit-flag process))
- (push process pinentry--connection-process-list)
- (set-process-query-on-exit-flag process nil)
- (ignore-errors
- (process-send-string process "OK Your orders please\n")))
- ;; Kill the process buffer of the connection process.
- (when (and (not (process-contact process :server))
- (eq (process-status process) 'closed))
- (when (buffer-live-p (process-buffer process))
- (kill-buffer (process-buffer process)))
- (setq pinentry--connection-process-list
- (delq process pinentry--connection-process-list)))
- ;; Delete the associated connection file, if applicable.
- ;; Although there's no 100% guarantee that the file is owned by the
- ;; running Emacs instance, server-start uses server-running-p to check
- ;; for possible servers before doing anything, so it *should* be ours.
- (and (process-contact process :server)
- (eq (process-status process) 'closed)
- (ignore-errors
- (delete-file (process-get process :server-file)))))
-
-(provide 'pinentry)
-
-;;; pinentry.el ends here
diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el
index 2ef63217256..91408b8278a 100644
--- a/lisp/net/pop3.el
+++ b/lisp/net/pop3.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index bdd59be070a..af9b031bf21 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el
index 652eb2ffe82..c9b17937df1 100644
--- a/lisp/net/quickurl.el
+++ b/lisp/net/quickurl.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -39,7 +39,7 @@
;; where <Lookup> is a string that acts as the keyword lookup and <URL> is
;; the URL associated with it. An example might be:
;;
-;; ("GNU" . "http://www.gnu.org/")
+;; ("GNU" . "https://www.gnu.org/")
;;
;; A list entry looks like:
;;
@@ -50,12 +50,12 @@
;; used when presenting a list of URLS using `quickurl-list'. An example
;; might be:
;;
-;; ("FSF" "http://www.fsf.org/" "The Free Software Foundation")
+;; ("FSF" "https://www.fsf.org/" "The Free Software Foundation")
;;
;; Given the above, your quickurl file might look like:
;;
-;; (("GNU" . "http://www.gnu.org/")
-;; ("FSF" "http://www.fsf.org/" "The Free Software Foundation")
+;; (("GNU" . "https://www.gnu.org/")
+;; ("FSF" "https://www.fsf.org/" "The Free Software Foundation")
;; ("emacs" . "http://www.emacs.org/")
;; ("davep" "http://www.davep.org/" "Dave's homepage"))
;;
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index ddff25c1e92..3b6b6c8c807 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -176,10 +176,30 @@ underneath each nick."
"If non-nil, activity in this buffer is considered low priority.")
(make-variable-buffer-local 'rcirc-low-priority-flag)
-(defvar rcirc-omit-mode nil
- "Non-nil if Rcirc-Omit mode is enabled.
-Use the command `rcirc-omit-mode' to change this variable.")
-(make-variable-buffer-local 'rcirc-omit-mode)
+(defcustom rcirc-omit-responses
+ '("JOIN" "PART" "QUIT" "NICK")
+ "Responses which will be hidden when `rcirc-omit-mode' is enabled."
+ :type '(repeat string)
+ :group 'rcirc)
+
+(define-minor-mode rcirc-omit-mode
+ "Toggle the hiding of \"uninteresting\" lines.
+With a prefix argument ARG, enable Rcirc-Omit mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil.
+
+Uninteresting lines are those whose responses are listed in
+`rcirc-omit-responses'."
+ nil " Omit" nil
+ (if rcirc-omit-mode
+ (progn
+ (add-to-invisibility-spec '(rcirc-omit . nil))
+ (message "Rcirc-Omit mode enabled"))
+ (remove-from-invisibility-spec '(rcirc-omit . nil))
+ (message "Rcirc-Omit mode disabled"))
+ (dolist (window (get-buffer-window-list (current-buffer)))
+ (with-selected-window window
+ (recenter (when (> (point) rcirc-prompt-start-marker) -1)))))
(defcustom rcirc-time-format "%H:%M "
"Describes how timestamps are printed.
@@ -1405,12 +1425,6 @@ the of the following escape sequences replaced by the described values:
:value-type string)
:group 'rcirc)
-(defcustom rcirc-omit-responses
- '("JOIN" "PART" "QUIT" "NICK")
- "Responses which will be hidden when `rcirc-omit-mode' is enabled."
- :type '(repeat string)
- :group 'rcirc)
-
(defun rcirc-format-response-string (process sender response target text)
"Return a nicely-formatted response string, incorporating TEXT
\(and perhaps other arguments). The specific formatting used
@@ -1881,9 +1895,6 @@ if ARG is omitted or nil."
(or (assq 'rcirc-low-priority-flag minor-mode-alist)
(setq minor-mode-alist
(cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist)))
-(or (assq 'rcirc-omit-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons '(rcirc-omit-mode " Omit") minor-mode-alist)))
(defun rcirc-toggle-ignore-buffer-activity ()
"Toggle the value of `rcirc-ignore-buffer-activity-flag'."
@@ -1905,23 +1916,6 @@ if ARG is omitted or nil."
"Activity in this buffer is normal priority"))
(force-mode-line-update))
-(defun rcirc-omit-mode ()
- "Toggle the Rcirc-Omit mode.
-If enabled, \"uninteresting\" lines are not shown.
-Uninteresting lines are those whose responses are listed in
-`rcirc-omit-responses'."
- (interactive)
- (setq rcirc-omit-mode (not rcirc-omit-mode))
- (if rcirc-omit-mode
- (progn
- (add-to-invisibility-spec '(rcirc-omit . nil))
- (message "Rcirc-Omit mode enabled"))
- (remove-from-invisibility-spec '(rcirc-omit . nil))
- (message "Rcirc-Omit mode disabled"))
- (dolist (window (get-buffer-window-list (current-buffer)))
- (with-selected-window window
- (recenter (when (> (point) rcirc-prompt-start-marker) -1)))))
-
(defun rcirc-switch-to-server-buffer ()
"Switch to the server buffer associated with current channel buffer."
(interactive)
@@ -2339,7 +2333,7 @@ With a prefix arg, prompt for new topic."
(defun rcirc-ctcp-sender-PING (process target _request)
"Send a CTCP PING message to TARGET."
- (let ((timestamp (format "%.0f" (float-time))))
+ (let ((timestamp (format-time-string "%s")))
(rcirc-send-ctcp process target "PING" timestamp)))
(defun rcirc-cmd-me (args &optional process target)
@@ -2505,12 +2499,15 @@ If ARG is given, opens the URL in a new browser window."
(end (match-end 0))
(url (match-string-no-properties 0))
(link-text (buffer-substring-no-properties start end)))
- (make-button start end
- 'face 'rcirc-url
- 'follow-link t
- 'rcirc-url url
- 'action (lambda (button)
- (browse-url (button-get button 'rcirc-url))))
+ ;; Add a button for the URL. Note that we use `make-text-button',
+ ;; rather than `make-button', as text-buttons are much faster in
+ ;; large buffers.
+ (make-text-button start end
+ 'face 'rcirc-url
+ 'follow-link t
+ 'rcirc-url url
+ 'action (lambda (button)
+ (browse-url (button-get button 'rcirc-url))))
;; record the url if it is not already the latest stored url
(when (not (string= link-text (caar rcirc-urls)))
(push (cons link-text start) rcirc-urls)))))
diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el
index 71cf5bd8283..7d85c34ff61 100644
--- a/lisp/net/rfc2104.el
+++ b/lisp/net/rfc2104.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el
index a07c4901545..2843833a27a 100644
--- a/lisp/net/rlogin.el
+++ b/lisp/net/rlogin.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -38,7 +38,7 @@
;; FIXME?
;; Maybe this file should be obsolete.
-;; http://lists.gnu.org/archive/html/emacs-devel/2013-02/msg00517.html
+;; https://lists.gnu.org/r/emacs-devel/2013-02/msg00517.html
;; It only adds rlogin-directory-tracking-mode. Is that useful?
(require 'comint)
diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el
index cd6c7e1a583..269e9a5462c 100644
--- a/lisp/net/sasl-cram.el
+++ b/lisp/net/sasl-cram.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el
index 445d4bf37b3..e74b90dabcd 100644
--- a/lisp/net/sasl-digest.el
+++ b/lisp/net/sasl-digest.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el
index cb6961b14b5..606aa036078 100644
--- a/lisp/net/sasl-ntlm.el
+++ b/lisp/net/sasl-ntlm.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el
index 1dc4803c828..18415359b86 100644
--- a/lisp/net/sasl-scram-rfc.el
+++ b/lisp/net/sasl-scram-rfc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el
index 6128b91b1db..2a166db7cee 100644
--- a/lisp/net/sasl.el
+++ b/lisp/net/sasl.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el
index 9bcfc378f42..fa49b646b04 100644
--- a/lisp/net/secrets.el
+++ b/lisp/net/secrets.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el
index b0c706eb5da..65ab544bb50 100644
--- a/lisp/net/shr-color.el
+++ b/lisp/net/shr-color.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 2a6b3960c46..ad5d869531c 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -185,8 +185,8 @@ and other things:
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'shr-browse-url)
(define-key map "I" 'shr-insert-image)
- (define-key map "w" 'shr-copy-url)
- (define-key map "u" 'shr-copy-url)
+ (define-key map "w" 'shr-maybe-probe-and-copy-url)
+ (define-key map "u" 'shr-maybe-probe-and-copy-url)
(define-key map "v" 'shr-browse-url)
(define-key map "O" 'shr-save-contents)
(define-key map "\r" 'shr-browse-url)
@@ -290,43 +290,59 @@ DOM should be a parse tree as generated by
(forward-line 1)
(delete-region (point) (point-max))))))
-(defun shr-copy-url (&optional image-url)
+(defun shr-url-at-point (image-url)
+ "Return the URL under point as a string.
+If IMAGE-URL is non-nil, or there is no link under point, but
+there is an image under point then copy the URL of the image
+under point instead."
+ (if image-url
+ (get-text-property (point) 'image-url)
+ (or (get-text-property (point) 'shr-url)
+ (get-text-property (point) 'image-url))))
+
+(defun shr-copy-url (url)
"Copy the URL under point to the kill ring.
If IMAGE-URL (the prefix) is non-nil, or there is no link under
point, but there is an image under point then copy the URL of the
-image under point instead.
-If called twice, then try to fetch the URL and see whether it
-redirects somewhere else."
+image under point instead."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if (not url)
+ (message "No URL under point")
+ (setq url (url-encode-url url))
+ (kill-new url)
+ (message "Copied %s" url)))
+
+(defun shr-probe-url (url cont)
+ "Pass URL's redirect destination to CONT, if it has one.
+CONT should be a function of one argument, the redirect
+destination URL. If URL is not redirected, then CONT is never
+called."
(interactive "P")
- (let ((url (if image-url
- (get-text-property (point) 'image-url)
- (or (get-text-property (point) 'shr-url)
- (get-text-property (point) 'image-url)))))
- (cond
- ((not url)
- (message "No URL under point"))
- ;; Resolve redirected URLs.
- ((equal url (car kill-ring))
- (url-retrieve
- url
- (lambda (a)
- (when (and (consp a)
- (eq (car a) :redirect))
- (with-temp-buffer
- (insert (cadr a))
- (goto-char (point-min))
- ;; Remove common tracking junk from the URL.
- (when (re-search-forward ".utm_.*" nil t)
- (replace-match "" t t))
- (message "Copied %s" (buffer-string))
- (copy-region-as-kill (point-min) (point-max)))))
- nil t))
- ;; Copy the URL to the kill ring.
- (t
- (with-temp-buffer
- (insert (url-encode-url url))
- (copy-region-as-kill (point-min) (point-max))
- (message "Copied %s" (buffer-string)))))))
+ (url-retrieve
+ url (lambda (a)
+ (pcase a
+ (`(:redirect ,destination . ,_)
+ ;; Remove common tracking junk from the URL.
+ (funcall cont (replace-regexp-in-string
+ ".utm_.*" "" destination)))))
+ nil t))
+
+(defun shr-probe-and-copy-url (url)
+ "Copy the URL under point to the kill ring.
+Like `shr-copy-url', but additionally fetch URL and use its
+redirection destination if it has one."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if url (shr-probe-url url #'shr-copy-url)
+ (shr-copy-url url)))
+
+(defun shr-maybe-probe-and-copy-url (url)
+ "Copy the URL under point to the kill ring.
+If the URL is already at the front of the kill ring act like
+`shr-probe-and-copy-url', otherwise like `shr-copy-url'."
+ (interactive (list (shr-url-at-point current-prefix-arg)))
+ (if (equal url (car kill-ring))
+ (shr-probe-and-copy-url url)
+ (shr-copy-url url)))
(defun shr-next-link ()
"Skip to the next link."
@@ -454,6 +470,18 @@ size, and full-buffer size."
(shr-insert sub)
(shr-descend sub))))
+(defun shr-indirect-call (tag-name dom &rest args)
+ (let ((function (intern (concat "shr-tag-" (symbol-name tag-name)) obarray))
+ ;; Allow other packages to override (or provide) rendering
+ ;; of elements.
+ (external (cdr (assq tag-name shr-external-rendering-functions))))
+ (cond (external
+ (apply external dom args))
+ ((fboundp function)
+ (apply function dom args))
+ (t
+ (apply 'shr-generic dom args)))))
+
(defun shr-descend (dom)
(let ((function
(intern (concat "shr-tag-" (symbol-name (dom-tag dom))) obarray))
@@ -474,6 +502,11 @@ size, and full-buffer size."
(setq style nil)))
;; If we have a display:none, then just ignore this part of the DOM.
(unless (equal (cdr (assq 'display shr-stylesheet)) "none")
+ ;; We don't use shr-indirect-call here, since shr-descend is
+ ;; the central bit of shr.el, and should be as fast as
+ ;; possible. Having one more level of indirection with its
+ ;; negative effect on performance is deemed unjustified in
+ ;; this case.
(cond (external
(funcall external dom))
((fboundp function)
@@ -512,6 +545,7 @@ size, and full-buffer size."
(* (frame-char-width) 2)
0))))
(shr-insert text)
+ (shr-fill-lines (point-min) (point-max))
(buffer-string)))))
(define-inline shr-char-breakable-p (char)
@@ -601,7 +635,7 @@ size, and full-buffer size."
(replace-match " " t t))
(shr--translate-insertion-chars)
(goto-char (point-max)))
- ;; We may have removed everything we inserted if if was just
+ ;; We may have removed everything we inserted if it was just
;; spaces.
(unless (= font-start (point))
;; Mark all lines that should possibly be folded afterwards.
@@ -666,12 +700,16 @@ size, and full-buffer size."
;; Success; continue.
(when (= (preceding-char) ?\s)
(delete-char -1))
- (let ((props (text-properties-at (point)))
+ (let ((props `(face ,(get-text-property (point) 'face)
+ ;; Don't break the image-displayer property
+ ;; as it will cause `gnus-article-show-images'
+ ;; to show the two or more same images.
+ image-displayer
+ ,(get-text-property (point) 'image-displayer)))
(gap-start (point)))
(insert "\n")
(shr-indent)
- (when props
- (add-text-properties gap-start (point) props)))
+ (add-text-properties gap-start (point) props))
(setq start (point))
(shr-vertical-motion shr-internal-width)
(when (looking-at " $")
@@ -928,6 +966,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
(when (and (buffer-name buffer)
(not (plist-get status :error)))
(url-store-in-cache image-buffer)
+ (goto-char (point-min))
(when (or (search-forward "\n\n" nil t)
(search-forward "\r\n\r\n" nil t))
(let ((data (shr-parse-image-data)))
@@ -955,7 +994,8 @@ If EXTERNAL, browse the URL using `shr-external-browser'."
data)
(let ((param (match-string 4 data))
(payload (url-unhex-string (match-string 5 data))))
- (when (string-match "^.*\\(;[ \t]*base64\\)$" param)
+ (when (and param
+ (string-match "^.*\\(;[ \t]*base64\\)$" param))
(setq payload (ignore-errors
(base64-decode-string payload))))
payload)))
@@ -981,7 +1021,7 @@ element is the data blob and the second element is the content-type."
(create-image data nil t :ascent 100
:format content-type))
((eq content-type 'image/svg+xml)
- (create-image data 'imagemagick t :ascent 100))
+ (create-image data 'svg t :ascent 100))
((eq size 'full)
(ignore-errors
(shr-rescale-image data content-type
@@ -1345,7 +1385,7 @@ ones, in case fg and bg are nil."
plist)))
(defun shr-tag-base (dom)
- (when-let (base (dom-attr dom 'href))
+ (when-let* ((base (dom-attr dom 'href)))
(setq shr-base (shr-parse-base base)))
(shr-generic dom))
@@ -1370,7 +1410,7 @@ ones, in case fg and bg are nil."
(unless shr-inhibit-images
(let ((start (point))
url multimedia image)
- (when-let (type (dom-attr dom 'type))
+ (when-let* ((type (dom-attr dom 'type)))
(when (string-match "\\`image/svg" type)
(setq url (dom-attr dom 'data)
image t)))
@@ -1386,7 +1426,7 @@ ones, in case fg and bg are nil."
(when url
(cond
(image
- (shr-tag-img dom url)
+ (shr-indirect-call 'img dom url)
(setq dom nil))
(multimedia
(shr-insert " [multimedia] ")
@@ -1451,7 +1491,7 @@ The preference is a float determined from `shr-prefer-media-type'."
(unless url
(setq url (car (shr--extract-best-source dom))))
(if (> (length image) 0)
- (shr-tag-img nil image)
+ (shr-indirect-call 'img nil image)
(shr-insert " [video] "))
(shr-urlify start (shr-expand-url url))))
@@ -1946,9 +1986,9 @@ flags that control whether to collect or render objects."
do (setq tag (dom-tag child)) and
unless (memq tag '(comment style))
if (eq tag 'img)
- do (shr-tag-img child)
+ do (shr-indirect-call 'img child)
else if (eq tag 'object)
- do (shr-tag-object child)
+ do (shr-indirect-call 'object child)
else
do (setq recurse t) and
if (eq tag 'tr)
@@ -1962,7 +2002,7 @@ flags that control whether to collect or render objects."
do (setq flags nil)
else if (car flags)
do (setq recurse nil)
- (shr-tag-table child)
+ (shr-indirect-call 'table child)
end end end end end end end end end end
when recurse
append (shr-collect-extra-strings-in-table child flags)))
@@ -2160,7 +2200,7 @@ flags that control whether to collect or render objects."
(when (and (not (stringp column))
(or (memq (dom-tag column) '(td th))
(not column)))
- (when-let (span (dom-attr column 'rowspan))
+ (when-let* ((span (dom-attr column 'rowspan)))
(aset rowspans i (+ (aref rowspans i)
(1- (string-to-number span)))))
;; Sanity check for invalid column-spans.
@@ -2250,8 +2290,10 @@ flags that control whether to collect or render objects."
(<= (car (cdr attr)) width))
(setq result (cdr attr)))))))
result))
- (let ((result (shr-render-td-1 dom width fill)))
+ (let* ((pt (point))
+ (result (shr-render-td-1 dom width fill)))
(dom-set-attribute dom cache result)
+ (goto-char pt)
result))))
(defun shr-render-td-1 (dom width fill)
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 1a54e1aa738..832b443b12f 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el
index 87bb3a245b8..165bbbd8d40 100644
--- a/lisp/net/sieve-mode.el
+++ b/lisp/net/sieve-mode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el
index 665a0a8e15d..c3acd36fa45 100644
--- a/lisp/net/sieve.el
+++ b/lisp/net/sieve.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el
index e6a27f43a08..413882ae861 100644
--- a/lisp/net/snmp-mode.el
+++ b/lisp/net/snmp-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el
index c0b71cdf170..4fdd0382444 100644
--- a/lisp/net/soap-client.el
+++ b/lisp/net/soap-client.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el
index 2516bc99248..722d4d62882 100644
--- a/lisp/net/soap-inspect.el
+++ b/lisp/net/soap-inspect.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/net/socks.el b/lisp/net/socks.el
index f18e69514bb..63a65069c55 100644
--- a/lisp/net/socks.el
+++ b/lisp/net/socks.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/starttls.el b/lisp/net/starttls.el
index 4de3d69e4f8..276807a374b 100644
--- a/lisp/net/starttls.el
+++ b/lisp/net/starttls.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -42,7 +42,7 @@
;; it performs more verification of the certificates.
;; The GnuTLS support requires GnuTLS 0.9.90 (released 2003-10-08) or
-;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls"
+;; later, from <https://www.gnu.org/software/gnutls/>, or "starttls"
;; from <ftp://ftp.opaopa.org/pub/elisp/>.
;; Usage is similar to `open-network-stream'. For example:
diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el
index b38ef6c654a..03569415edb 100644
--- a/lisp/net/telnet.el
+++ b/lisp/net/telnet.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/tls.el b/lisp/net/tls.el
index 11aae635aae..76c39b0bece 100644
--- a/lisp/net/tls.el
+++ b/lisp/net/tls.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -106,7 +106,7 @@ successful negotiation."
(repeat :inline t :tag "Other" (string)))
(list :tag "List of commands"
(repeat :tag "Command" (string))))
- :version "25.3" ; remove s_client
+ :version "26.1" ; remove s_client
:group 'tls)
(defcustom tls-process-connection-type nil
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 23aa90186a6..8399c02923d 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -72,7 +72,7 @@ It is used for TCP/IP devices."
(defconst tramp-adb-ls-toolbox-regexp
(concat
"^[[:space:]]*\\([-[:alpha:]]+\\)" ; \1 permissions
- "\\(?:[[:space:]][[:digit:]]+\\)?" ; links (Android 7/ToolBox)
+ "\\(?:[[:space:]]+[[:digit:]]+\\)?" ; links (Android 7/toybox)
"[[:space:]]*\\([^[:space:]]+\\)" ; \2 username
"[[:space:]]+\\([^[:space:]]+\\)" ; \3 group
"[[:space:]]+\\([[:digit:]]+\\)" ; \4 size
@@ -97,7 +97,7 @@ It is used for TCP/IP devices."
;;;###tramp-autoload
(defconst tramp-adb-file-name-handler-alist
'((access-file . ignore)
- (add-name-to-file . tramp-adb-handle-copy-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
(copy-file . tramp-adb-handle-copy-file)
@@ -137,8 +137,9 @@ It is used for TCP/IP devices."
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . ignore)
+ (file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-adb-handle-file-system-info)
(file-truename . tramp-adb-handle-file-truename)
(file-writable-p . tramp-adb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -255,6 +256,30 @@ pass to the OPERATION."
(file-attributes (file-truename filename)))
t))
+(defun tramp-adb-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-adb-send-command
+ v (format "df -k %s" (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (concat "[[:space:]]*[^[:space:]]+"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
+ ;; The values are given as 1k numbers, so we must change
+ ;; them to number of bytes.
+ (list (* 1024 (string-to-number (concat (match-string 1) "e0")))
+ ;; The second value is the used size. We need the
+ ;; free size.
+ (* 1024 (- (string-to-number (concat (match-string 1) "e0"))
+ (string-to-number (concat (match-string 2) "e0"))))
+ (* 1024 (string-to-number (concat (match-string 3) "e0")))))))))
+
;; This is derived from `tramp-sh-handle-file-truename'. Maybe the
;; code could be shared?
(defun tramp-adb-handle-file-truename (filename)
@@ -411,15 +436,17 @@ pass to the OPERATION."
(tramp-adb-get-ls-command v)
(tramp-shell-quote-argument localname)))
;; We insert also filename/. and filename/.., because "ls" doesn't.
- (narrow-to-region (point) (point))
- (tramp-adb-send-command
- v (format "%s -d -a -l %s %s"
- (tramp-adb-get-ls-command v)
- (tramp-shell-quote-argument
- (concat (file-name-as-directory localname) "."))
- (tramp-shell-quote-argument
- (concat (file-name-as-directory localname) ".."))))
- (widen))
+ ;; Looks like it does include them in toybox, since Android 6.
+ (unless (re-search-backward "\\.$" nil t)
+ (narrow-to-region (point-max) (point-max))
+ (tramp-adb-send-command
+ v (format "%s -d -a -l %s %s"
+ (tramp-adb-get-ls-command v)
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) "."))
+ (tramp-shell-quote-argument
+ (concat (file-name-as-directory localname) ".."))))
+ (widen)))
(tramp-adb-sh-fix-ls-output)
(let ((result (tramp-do-parse-file-attributes-with-ls
v (or id-format 'integer))))
@@ -443,11 +470,12 @@ pass to the OPERATION."
(with-tramp-connection-property vec "ls"
(tramp-message vec 5 "Finding a suitable `ls' command")
(cond
- ;; Can't disable coloring explicitly for toybox ls command
- ((tramp-adb-send-command-and-check vec "toybox") "ls")
+ ;; Can't disable coloring explicitly for toybox ls command. We
+ ;; must force "ls" to print just one column.
+ ((tramp-adb-send-command-and-check vec "toybox") "env COLUMNS=1 ls")
;; On CyanogenMod based system BusyBox is used and "ls" output
- ;; coloring is enabled by default. So we try to disable it
- ;; when possible.
+ ;; 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")
"ls --color=never")
(t "ls"))))
@@ -521,11 +549,12 @@ Emacs dired can't find files."
(let ((par (expand-file-name ".." dir)))
(unless (file-directory-p par)
(make-directory par parents))))
- (tramp-adb-barf-unless-okay
- v (format "mkdir %s" (tramp-shell-quote-argument localname))
- "Couldn't make directory %s" dir)
(tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-directory-property v localname)))
+ (tramp-flush-directory-property v localname)
+ (unless (or (tramp-adb-send-command-and-check
+ v (format "mkdir %s" (tramp-shell-quote-argument localname)))
+ (and parents (file-directory-p dir)))
+ (tramp-error v 'file-error "Couldn't make directory %s" dir))))
(defun tramp-adb-handle-delete-directory (directory &optional recursive _trash)
"Like `delete-directory' for Tramp files."
@@ -569,13 +598,17 @@ Emacs dired can't find files."
(file-name-as-directory f)
f))
(with-current-buffer (tramp-get-buffer v)
- (append
- '("." "..")
- (delq
- nil
- (mapcar
- (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
- (split-string (buffer-string) "\n")))))))))))
+ (delete-dups
+ (append
+ ;; In older Android versions, "." and ".." are not
+ ;; included. In newer versions (toybox, since Android
+ ;; 6) they are. We fix this by `delete-dups'.
+ '("." "..")
+ (delq
+ nil
+ (mapcar
+ (lambda (l) (and (not (string-match "^[[:space:]]*$" l)) l))
+ (split-string (buffer-string) "\n"))))))))))))
(defun tramp-adb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
@@ -623,14 +656,17 @@ But handle the case, if the \"test\" command is not available."
rw-path)))))))
(defun tramp-adb-handle-write-region
- (start end filename &optional append visit lockname confirm)
+ (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (when (and confirm (file-exists-p filename))
- (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
- filename))
- (tramp-error v 'file-error "File not overwritten")))
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v (file-name-directory localname))
@@ -643,8 +679,7 @@ But handle the case, if the \"test\" command is not available."
tmpfile
(logior (or (file-modes tmpfile) 0) (string-to-number "0600" 8))))
(tramp-run-real-handler
- 'write-region
- (list start end tmpfile append 'no-message lockname confirm))
+ 'write-region (list start end tmpfile append 'no-message lockname))
(with-tramp-progress-reporter
v 3 (format-message
"Moving tmp file `%s' to `%s'" tmpfile filename)
@@ -730,7 +765,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(signal (car err) (cdr err))))
;; Remote newname.
- (when (file-directory-p newname)
+ (when (and (file-directory-p newname)
+ (tramp-compat-directory-name-p newname))
(setq newname
(expand-file-name
(file-name-nondirectory filename) newname)))
@@ -766,38 +802,43 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname)))
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
-
- (if (and t1 t2
- (tramp-equal-remote filename newname)
- (not (file-directory-p filename)))
- (let ((l1 (file-remote-p filename 'localname))
- (l2 (file-remote-p newname 'localname)))
- (when (and (not ok-if-already-exists)
- (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v (file-name-directory l1))
- (tramp-flush-file-property v l1)
- (tramp-flush-file-property v (file-name-directory l2))
- (tramp-flush-file-property v l2)
- ;; Short track.
- (tramp-adb-barf-unless-okay
- v (format
- "mv -f %s %s"
- (tramp-shell-quote-argument l1)
- (tramp-shell-quote-argument l2))
- "Error renaming %s to %s" filename newname))
-
- ;; Rename by copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (delete-file filename))))))
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname t t)
+ (delete-directory filename 'recursive))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname)))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+
+ (if (and t1 t2
+ (tramp-equal-remote filename newname)
+ (not (file-directory-p filename)))
+ (let ((l1 (file-remote-p filename 'localname))
+ (l2 (file-remote-p newname 'localname)))
+ (when (and (not ok-if-already-exists)
+ (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory l1))
+ (tramp-flush-file-property v l1)
+ (tramp-flush-file-property v (file-name-directory l2))
+ (tramp-flush-file-property v l2)
+ ;; Short track.
+ (tramp-adb-barf-unless-okay
+ v (format
+ "mv -f %s %s"
+ (tramp-shell-quote-argument l1)
+ (tramp-shell-quote-argument l2))
+ "Error renaming %s to %s" filename newname))
+
+ ;; Rename by copy.
+ (copy-file
+ filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
+ (delete-file filename)))))))
(defun tramp-adb-handle-process-file
(program &optional infile destination display &rest args)
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index ac5a9c45bbd..dc97501be3d 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -136,7 +136,11 @@ Returns DEFAULT if not set."
(tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
- (val (or (and (boundp var) (symbol-value var)) 0)))
+ (val (or (bound-and-true-p var)
+ (progn
+ (add-hook 'tramp-cache-unload-hook
+ (lambda () (makunbound var)))
+ 0))))
(set var (1+ val))))
value))
@@ -156,7 +160,11 @@ Returns VALUE."
(tramp-message key 8 "%s %s %s" file property value)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-set-count-" property)))
- (val (or (and (boundp var) (symbol-value var)) 0)))
+ (val (or (bound-and-true-p var)
+ (progn
+ (add-hook 'tramp-cache-unload-hook
+ (lambda () (makunbound var)))
+ 0))))
(set var (1+ val))))
value))
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 4c5a12d33ba..37a6521680b 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -49,7 +49,7 @@ SYNTAX can be one of the symbols `default' (default),
(unless (string-equal input "")
(list (intern input)))))
(when syntax
- (custom-set-variables `(tramp-syntax ',syntax))))
+ (customize-set-variable 'tramp-syntax syntax)))
(defun tramp-list-tramp-buffers ()
"Return a list of all Tramp connection buffers."
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index c998df814c1..9326f7b1864 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -19,12 +19,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; Tramp's main Emacs version for development is Emacs 26. This
-;; package provides compatibility functions for Emacs 24 and Emacs 25.
+;; Tramp's main Emacs version for development is Emacs 27. This
+;; package provides compatibility functions for Emacs 24, Emacs 25 and
+;; Emacs 26.
;;; Code:
@@ -50,33 +51,6 @@
`(when (functionp ,function)
(with-no-warnings (funcall ,function ,@arguments))))
-;; We currently use "[" and "]" in the filename format for IPv6 hosts
-;; of GNU Emacs. This means that Emacs wants to expand wildcards if
-;; `find-file-wildcards' is non-nil, and then barfs because no
-;; expansion could be found. We detect this situation and do
-;; something really awful: we have `file-expand-wildcards' return the
-;; original filename if it can't expand anything. Let's just hope
-;; that this doesn't break anything else. It is not needed anymore
-;; since GNU Emacs 23.2.
-(unless (featurep 'files 'remote-wildcards)
- (defadvice file-expand-wildcards
- (around tramp-advice-file-expand-wildcards activate)
- (let ((name (ad-get-arg 0)))
- ;; If it's a Tramp file, look if wildcards need to be expanded
- ;; at all.
- (if (and
- (tramp-tramp-file-p name)
- (not (string-match "[[*?]" (file-remote-p name 'localname))))
- (setq ad-return-value (list name))
- ;; Otherwise, just run the original function.
- ad-do-it)))
- (add-hook
- 'tramp-unload-hook
- (lambda ()
- (ad-remove-advice
- 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
- (ad-activate 'file-expand-wildcards))))
-
(defsubst tramp-compat-temporary-file-directory ()
"Return name of directory for temporary files.
It is the default value of `temporary-file-directory'."
@@ -131,6 +105,10 @@ Add the extension of F, if existing."
'tramp-error vec-or-proc
(if (fboundp 'user-error) 'user-error 'error) format args))
+;; `default-toplevel-value' has been declared in Emacs 24.4.
+(unless (fboundp 'default-toplevel-value)
+ (defalias 'default-toplevel-value 'symbol-value))
+
;; `file-attribute-*' are introduced in Emacs 25.1.
(if (fboundp 'file-attribute-type)
@@ -190,14 +168,23 @@ This is a floating point number if the size is too large for an integer."
This is a string of ten letters or dashes as in ls -l."
(nth 8 attributes)))
-;; `default-toplevel-value' has been declared in Emacs 24.4.
-(unless (fboundp 'default-toplevel-value)
- (defalias 'default-toplevel-value 'symbol-value))
-
;; `format-message' is new in Emacs 25.1.
(unless (fboundp 'format-message)
(defalias 'format-message 'format))
+;; `directory-name-p' is new in Emacs 25.1.
+(if (fboundp 'directory-name-p)
+ (defalias 'tramp-compat-directory-name-p 'directory-name-p)
+ (defsubst tramp-compat-directory-name-p (name)
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\))))))
+
;; `file-missing' is introduced in Emacs 26.1.
(defconst tramp-file-missing
(if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
@@ -248,11 +235,11 @@ If NAME is a remote file name, the local part of NAME is unquoted."
((eq tramp-syntax 'sep) 'separate)
(t tramp-syntax)))
-;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
-(eval-after-load 'tramp
- '(unless
- (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
- (tramp-change-syntax (tramp-compat-tramp-syntax))))
+;; `cl-struct-slot-info' has been introduced with Emacs 25.
+(defmacro tramp-compat-tramp-file-name-slots ()
+ (if (fboundp 'cl-struct-slot-info)
+ `(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name)))
+ `(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots)))))
(provide 'tramp-compat)
diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el
index 8e489eee801..9fd2e6d9dec 100644
--- a/lisp/net/tramp-ftp.el
+++ b/lisp/net/tramp-ftp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -121,10 +121,10 @@ pass to the OPERATION."
(or (boundp 'ange-ftp-name-format)
(let (file-name-handler-alist) (require 'ange-ftp)))
(let ((ange-ftp-name-format
- (list (nth 0 (tramp-file-name-structure))
- (nth 3 (tramp-file-name-structure))
- (nth 2 (tramp-file-name-structure))
- (nth 4 (tramp-file-name-structure))))
+ (list (nth 0 tramp-file-name-structure)
+ (nth 3 tramp-file-name-structure)
+ (nth 2 tramp-file-name-structure)
+ (nth 4 tramp-file-name-structure)))
;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res'
;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active,
;; there could be incorrect values from previous calls in case the
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 4c750df3c40..fe5a98909e0 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -416,6 +416,19 @@ Every entry is a list (NAME ADDRESS).")
(defconst tramp-hal-interface-device "org.freedesktop.Hal.Device"
"The device interface of the HAL daemon.")
+;; "gvfs-<command>" utilities have been deprecated in GVFS 1.31.1. We
+;; must use "gio <command>" tool instead.
+(defconst tramp-gvfs-gio-mapping
+ '(("gvfs-copy" . "copy")
+ ("gvfs-info" . "info")
+ ("gvfs-ls" . "list")
+ ("gvfs-mkdir" . "mkdir")
+ ("gvfs-monitor-file" . "monitor")
+ ("gvfs-move" . "move")
+ ("gvfs-rm" . "remove")
+ ("gvfs-trash" . "trash"))
+ "List of cons cells, mapping \"gvfs-<command>\" to \"gio <command>\".")
+
(defconst tramp-gvfs-file-attributes
'("name"
"type"
@@ -448,12 +461,24 @@ Every entry is a list (NAME ADDRESS).")
":[[:blank:]]+\\(.*\\)$")
"Regexp to parse GVFS file attributes with `gvfs-info'.")
+(defconst tramp-gvfs-file-system-attributes
+ '("filesystem::free"
+ "filesystem::size"
+ "filesystem::used")
+ "GVFS file system attributes.")
+
+(defconst tramp-gvfs-file-system-attributes-regexp
+ (concat "^[[:blank:]]*"
+ (regexp-opt tramp-gvfs-file-system-attributes t)
+ ":[[:blank:]]+\\(.*\\)$")
+ "Regexp to parse GVFS file system attributes with `gvfs-info'.")
+
;; New handlers should be added here.
;;;###tramp-autoload
(defconst tramp-gvfs-file-name-handler-alist
'((access-file . ignore)
- (add-name-to-file . tramp-gvfs-handle-copy-file)
+ (add-name-to-file . tramp-handle-add-name-to-file)
;; `byte-compiler-base-file-name' performed by default handler.
;; `copy-directory' performed by default handler.
(copy-file . tramp-gvfs-handle-copy-file)
@@ -492,9 +517,10 @@ Every entry is a list (NAME ADDRESS).")
(file-readable-p . tramp-gvfs-handle-file-readable-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
- (file-selinux-context . ignore)
+ (file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
- ;; `file-truename' performed by default handler.
+ (file-system-info . tramp-gvfs-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-gvfs-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.
@@ -649,6 +675,11 @@ file names."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
+ (if (file-directory-p filename)
+ (progn
+ (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))
@@ -658,8 +689,7 @@ file names."
(with-parsed-tramp-file-name (if t1 filename newname) nil
(when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error
- v 'file-already-exists "File %s already exists" newname))
+ (tramp-error v 'file-already-exists newname))
(if (or (and equal-remote
(tramp-get-connection-property v "direct-copy-failed" nil))
@@ -713,7 +743,7 @@ file names."
(when t2
(with-parsed-tramp-file-name newname nil
(tramp-flush-file-property v (file-name-directory localname))
- (tramp-flush-file-property v localname)))))))
+ (tramp-flush-file-property v localname))))))))
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
@@ -826,7 +856,7 @@ file names."
(let ((last-coding-system-used last-coding-system-used)
result)
(with-parsed-tramp-file-name directory nil
- (with-tramp-file-property v localname "directory-gvfs-attributes"
+ (with-tramp-file-property v localname "directory-attributes"
(tramp-message v 5 "directory gvfs attributes: %s" localname)
;; Send command.
(tramp-gvfs-send-command
@@ -861,23 +891,34 @@ file names."
(forward-line)))
result)))))
-(defun tramp-gvfs-get-root-attributes (filename)
- "Return GVFS attributes association list of FILENAME."
+(defun tramp-gvfs-get-root-attributes (filename &optional file-system)
+ "Return GVFS attributes association list of FILENAME.
+If FILE-SYSTEM is non-nil, return file system attributes."
(ignore-errors
;; Don't modify `last-coding-system-used' by accident.
(let ((last-coding-system-used last-coding-system-used)
result)
(with-parsed-tramp-file-name filename nil
- (with-tramp-file-property v localname "file-gvfs-attributes"
- (tramp-message v 5 "file gvfs attributes: %s" localname)
+ (with-tramp-file-property
+ v localname
+ (if file-system "file-system-attributes" "file-attributes")
+ (tramp-message
+ v 5 "file%s gvfs attributes: %s"
+ (if file-system " system" "") localname)
;; Send command.
- (tramp-gvfs-send-command
- v "gvfs-info" (tramp-gvfs-url-file-name filename))
+ (if file-system
+ (tramp-gvfs-send-command
+ v "gvfs-info" "--filesystem" (tramp-gvfs-url-file-name filename))
+ (tramp-gvfs-send-command
+ v "gvfs-info" (tramp-gvfs-url-file-name filename)))
;; Parse output.
(with-current-buffer (tramp-get-connection-buffer v)
(goto-char (point-min))
(while (re-search-forward
- tramp-gvfs-file-attributes-with-gvfs-info-regexp nil t)
+ (if file-system
+ tramp-gvfs-file-system-attributes-regexp
+ tramp-gvfs-file-attributes-with-gvfs-info-regexp)
+ nil t)
(push (cons (match-string 1) (match-string 2)) result))
result))))))
@@ -951,7 +992,7 @@ file names."
(tramp-file-mode-from-int (string-to-number n))
(format
"%s%s%s%s------"
- (if dirp "d" "-")
+ (if dirp "d" (if res-symlink-target "l" "-"))
(if (equal (cdr (assoc "access::can-read" attributes))
"FALSE")
"-" "r")
@@ -1015,11 +1056,11 @@ file names."
(defun tramp-gvfs-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
+ (unless (file-exists-p filename)
+ (tramp-error
+ v tramp-file-missing
+ "Cannot make local copy of non-existing file `%s'" filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
- (unless (file-exists-p filename)
- (tramp-error
- v tramp-file-missing
- "Cannot make local copy of non-existing file `%s'" filename))
(copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
tmpfile)))
@@ -1055,9 +1096,12 @@ file names."
((memq 'change flags)
'(created changed changes-done-hint moved deleted))
((memq 'attribute-change flags) '(attribute-changed))))
- (p (start-process
- "gvfs-monitor-file" (generate-new-buffer " *gvfs-monitor-file*")
- "gvfs-monitor-file" (tramp-gvfs-url-file-name file-name))))
+ (p (apply
+ 'start-process
+ "gvfs-monitor" (generate-new-buffer " *gvfs-monitor*")
+ (if (tramp-gvfs-gio-tool-p v)
+ `("gio" "monitor" ,(tramp-gvfs-url-file-name file-name)))
+ `("gvfs-monitor-file" (tramp-gvfs-url-file-name file-name)))))
(if (not (processp p))
(tramp-error
v 'file-notify-error "Monitoring not supported for `%s'" file-name)
@@ -1128,6 +1172,22 @@ file-notify events."
(with-tramp-file-property v localname "file-readable-p"
(tramp-check-cached-permissions v ?r))))
+(defun tramp-gvfs-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (setq filename (directory-file-name (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ ;; We don't use cached values.
+ (tramp-set-file-property v localname "file-system-attributes" 'undef)
+ (let* ((attr (tramp-gvfs-get-root-attributes filename 'file-system))
+ (size (cdr (assoc "filesystem::size" attr)))
+ (used (cdr (assoc "filesystem::used" attr)))
+ (free (cdr (assoc "filesystem::free" attr))))
+ (when (and (stringp size) (stringp used) (stringp free))
+ (list (string-to-number (concat size "e0"))
+ (- (string-to-number (concat size "e0"))
+ (string-to-number (concat used "e0")))
+ (string-to-number (concat free "e0")))))))
+
(defun tramp-gvfs-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(with-parsed-tramp-file-name filename nil
@@ -1151,8 +1211,9 @@ file-notify events."
(when (and parents (not (file-directory-p ldir)))
(make-directory ldir parents))
;; Just do it.
- (unless (tramp-gvfs-send-command
- v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (unless (or (tramp-gvfs-send-command
+ v "gvfs-mkdir" (tramp-gvfs-url-file-name dir))
+ (and parents (file-directory-p dir)))
(tramp-error v 'file-error "Couldn't make directory %s" dir))))))
(defun tramp-gvfs-handle-rename-file
@@ -1172,12 +1233,16 @@ file-notify events."
'rename-file (list filename newname ok-if-already-exists))))
(defun tramp-gvfs-handle-write-region
- (start end filename &optional append visit lockname confirm)
+ (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
+ (setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (when (and confirm (file-exists-p filename))
- (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
- (tramp-error v 'file-error "File not overwritten")))
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
(let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
@@ -1186,10 +1251,7 @@ file-notify events."
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
(tramp-run-real-handler
- 'write-region
- (if confirm ; don't pass this arg unless defined for backward compat.
- (list start end tmpfile append 'no-message lockname confirm)
- (list start end tmpfile append 'no-message lockname)))
+ 'write-region (list start end tmpfile append 'no-message lockname))
(condition-case nil
(rename-file tmpfile filename 'ok-if-already-exists)
(error
@@ -1230,7 +1292,8 @@ file-notify events."
(when (and user domain)
(setq user (concat domain ";" user)))
(url-parse-make-urlobj
- method (and user (url-hexify-string user)) nil host
+ method (and user (url-hexify-string user))
+ nil (and host (url-hexify-string host))
(if (stringp port) (string-to-number port) port)
(and localname (url-hexify-string localname)) nil nil t))
(url-parse-make-urlobj
@@ -1745,10 +1808,16 @@ connection if a previous connection has died for some reason."
(tramp-gvfs-get-remote-uid vec 'string)
(tramp-gvfs-get-remote-gid vec 'string))))
+(defun tramp-gvfs-gio-tool-p (vec)
+ "Check, whether the gio tool is available."
+ (with-tramp-connection-property vec "gio-tool"
+ (zerop (tramp-call-process vec "gio" nil nil nil "version"))))
+
(defun tramp-gvfs-send-command (vec command &rest args)
"Send the COMMAND with its ARGS to connection VEC.
-COMMAND is usually a command from the gvfs-* utilities.
-`call-process' is applied, and it returns t if the return code is zero."
+COMMAND is a command from the gvfs-* utilities. It is replaced
+by the corresponding gio tool call if available. `call-process'
+is applied, and it returns t if the return code is zero."
(let* ((locale (tramp-get-local-locale vec))
(process-environment
(append
@@ -1756,6 +1825,11 @@ COMMAND is usually a command from the gvfs-* utilities.
,(format "LANGUAGE=%s" locale)
,(format "LC_ALL=%s" locale))
process-environment)))
+ (when (tramp-gvfs-gio-tool-p vec)
+ ;; Use gio tool.
+ (setq args (cons (cdr (assoc command tramp-gvfs-gio-mapping)) args)
+ command "gio"))
+
(with-current-buffer (tramp-get-connection-buffer vec)
(tramp-gvfs-maybe-open-connection vec)
(erase-buffer)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index f7b457ebf04..acb5a12ba2a 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -533,9 +533,7 @@ the list by the special value `tramp-own-remote-path'."
;;;###tramp-autoload
(defcustom tramp-remote-process-environment
- `("ENV=''" "TMOUT=0" "LC_CTYPE=''"
- ,(format "TERM=%s" tramp-terminal-type)
- ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version)
+ '("ENV=''" "TMOUT=0" "LC_CTYPE=''"
"CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat"
"autocorrect=" "correct=")
"List of environment variables to be set on the remote host.
@@ -544,8 +542,15 @@ Each element should be a string of the form ENVVARNAME=VALUE. An
entry ENVVARNAME= disables the corresponding environment variable,
which might have been set in the init files like ~/.profile.
-Special handling is applied to the PATH environment, which should
-not be set here. Instead, it should be set via `tramp-remote-path'."
+Special handling is applied to some environment variables,
+which should not be set here:
+
+The PATH environment variable should be set via `tramp-remote-path'.
+
+The TERM environment variable should be set via `tramp-terminal-type'.
+
+The INSIDE_EMACS environment variable will automatically be set
+based on the TRAMP and Emacs versions, and should not be set here."
:group 'tramp
:version "26.1"
:type '(repeat string)
@@ -562,11 +567,7 @@ This variable is only used when Tramp needs to start up another shell
for tilde expansion. The extra arguments should typically prevent the
shell from reading its init file."
:group 'tramp
- ;; This might be the wrong way to test whether the widget type
- ;; `alist' is available. Who knows the right way to test it?
- :type (if (get 'alist 'widget-type)
- '(alist :key-type string :value-type string)
- '(repeat (cons string string)))
+ :type '(alist :key-type regexp :value-type string)
:require 'tramp)
(defconst tramp-actions-before-shell
@@ -617,7 +618,7 @@ use Cwd \"realpath\";
sub myrealpath {
my ($file) = @_;
- return realpath($file) if -e $file;
+ return realpath($file) if (-e $file || -l $file);
}
sub recursive {
@@ -1024,6 +1025,7 @@ of command line.")
(file-remote-p . tramp-handle-file-remote-p)
(file-selinux-context . tramp-sh-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
+ (file-system-info . tramp-sh-handle-file-system-info)
(file-truename . tramp-sh-handle-file-truename)
(file-writable-p . tramp-sh-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
@@ -1057,63 +1059,69 @@ Operations not mentioned here will be handled by the normal Emacs functions.")
;;; File Name Handler Functions:
(defun tramp-sh-handle-make-symbolic-link
- (filename linkname &optional ok-if-already-exists)
+ (target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
-If LINKNAME is a non-Tramp file, it is used verbatim as the target of
-the symlink. If LINKNAME is a Tramp file, only the localname component is
-used as the target of the symlink.
-
-If LINKNAME is a Tramp file and the localname component is relative, then
-it is expanded first, before the localname component is taken. Note that
-this can give surprising results if the user/host for the source and
-target of the symlink differ."
- (with-parsed-tramp-file-name linkname l
- (let ((ln (tramp-get-remote-ln l))
- (cwd (tramp-run-real-handler
- 'file-name-directory (list l-localname))))
- (unless ln
- (tramp-error
- l 'file-error
- "Making a symbolic link. ln(1) does not exist on the remote host."))
-
- ;; Do the 'confirm if exists' thing.
- (when (file-exists-p linkname)
- ;; What to do?
- (if (or (null ok-if-already-exists) ; not allowed to exist
- (and (numberp ok-if-already-exists)
- (not (yes-or-no-p
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink."
+ (if (not (tramp-tramp-file-p (expand-file-name linkname)))
+ (tramp-run-real-handler
+ 'make-symbolic-link (list target linkname ok-if-already-exists))
+
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
+ linkname ok-if-already-exists)
+
+ (let ((ln (tramp-get-remote-ln v))
+ (cwd (tramp-run-real-handler
+ 'file-name-directory (list localname))))
+ (unless ln
+ (tramp-error
+ v 'file-error
+ "Making a symbolic link. ln(1) does not exist on the remote host."))
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not
+ (yes-or-no-p
(format
"File %s already exists; make it a link anyway? "
- l-localname)))))
- (tramp-error
- l 'file-already-exists "File %s already exists" l-localname)
- (delete-file linkname)))
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
- ;; If FILENAME is a Tramp name, use just the localname component.
- (when (tramp-tramp-file-p filename)
- (setq filename
- (tramp-file-name-localname
- (tramp-dissect-file-name (expand-file-name filename)))))
-
- (tramp-flush-file-property l (file-name-directory l-localname))
- (tramp-flush-file-property l l-localname)
-
- ;; Right, they are on the same host, regardless of user, method,
- ;; etc. We now make the link on the remote machine. This will
- ;; occur as the user that FILENAME belongs to.
- (and (tramp-send-command-and-check
- l (format "cd %s" (tramp-shell-quote-argument cwd)))
- (tramp-send-command-and-check
- l (format
- "%s -sf %s %s"
- ln
- (tramp-shell-quote-argument filename)
- ;; The command could exceed PATH_MAX, so we use
- ;; relative file names. However, relative file names
- ;; could start with "-". `tramp-shell-quote-argument'
- ;; does not handle this, we must do it ourselves.
- (tramp-shell-quote-argument
- (concat "./" (file-name-nondirectory l-localname)))))))))
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+
+ ;; Right, they are on the same host, regardless of user,
+ ;; method, etc. We now make the link on the remote
+ ;; machine. This will occur as the user that TARGET belongs to.
+ (and (tramp-send-command-and-check
+ v (format "cd %s" (tramp-shell-quote-argument cwd)))
+ (tramp-send-command-and-check
+ v (format
+ "%s -sf %s %s" ln
+ (tramp-shell-quote-argument target)
+ ;; The command could exceed PATH_MAX, so we use
+ ;; relative file names. However, relative file
+ ;; names could start with "-".
+ ;; `tramp-shell-quote-argument' does not handle
+ ;; this, we must do it ourselves.
+ (tramp-shell-quote-argument
+ (concat "./" (file-name-nondirectory localname)))))))))))
(defun tramp-sh-handle-file-truename (filename)
"Like `file-truename' for Tramp files."
@@ -1191,16 +1199,6 @@ target of the symlink differ."
(setq numchase (1+ numchase))
(when (file-name-absolute-p symlink-target)
(setq result nil))
- ;; If the symlink was absolute, we'll get a
- ;; string like "/user@host:/some/target";
- ;; extract the "/some/target" part from it.
- (when (tramp-tramp-file-p symlink-target)
- (unless (tramp-equal-remote filename symlink-target)
- (tramp-error
- v 'file-error
- "Symlink target `%s' on wrong host"
- symlink-target))
- (setq symlink-target localname))
(setq steps
(append
(split-string symlink-target "/" 'omit) steps)))
@@ -1220,7 +1218,17 @@ target of the symlink differ."
(when (string= "" result)
(setq result "/")))))
- (when quoted (setq result (tramp-compat-file-name-quote result)))
+ ;; Detect cycle.
+ (when (and (file-symlink-p filename)
+ (string-equal result localname))
+ (tramp-error
+ v 'file-error
+ "Apparent cycle of symbolic links for %s" filename))
+ ;; If the resulting localname looks remote, we must quote it
+ ;; for security reasons.
+ (when (or quoted (file-remote-p result))
+ (let (file-name-handler-alist)
+ (setq result (tramp-compat-file-name-quote result))))
(tramp-message v 4 "True name of `%s' is `%s'" localname result)
result))))
@@ -1919,16 +1927,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(with-parsed-tramp-file-name filename v1
(with-parsed-tramp-file-name newname v2
(let ((ln (when v1 (tramp-get-remote-ln v1))))
- (when (and (numberp ok-if-already-exists)
- (file-exists-p newname)
- (yes-or-no-p
- (format
- "File %s already exists; make it a new name anyway? "
- newname)))
- (tramp-error
- v2 'file-already-exists
- "add-name-to-file: file %s already exists" newname))
- (when ok-if-already-exists (setq ln (concat ln " -f")))
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
(tramp-flush-file-property v2 (file-name-directory v2-localname))
(tramp-flush-file-property v2 v2-localname)
(tramp-barf-unless-okay
@@ -1972,24 +1982,26 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
(tramp-dissect-file-name newname)))))
;; scp or rsync DTRT.
(progn
+ (when (and (file-directory-p newname)
+ (not (tramp-compat-directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
(setq dirname (directory-file-name (expand-file-name dirname))
newname (directory-file-name (expand-file-name newname)))
- (if (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (if (not (file-directory-p (file-name-directory newname)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory dirname) newname)))
+ (when (not (file-directory-p (file-name-directory newname)))
(make-directory (file-name-directory newname) parents))
(tramp-do-copy-or-rename-file-out-of-band
'copy dirname newname keep-date))
+
;; We must do it file-wise.
(tramp-run-real-handler
'copy-directory
- (if copy-contents
- (list dirname newname keep-date parents copy-contents)
- (list dirname newname keep-date parents))))
+ (list dirname newname keep-date parents copy-contents)))
;; When newname did exist, we have wrong cached values.
(when t2
@@ -2032,97 +2044,102 @@ of `copy' and `rename'. FILENAME and NEWNAME must be absolute
file names."
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (length (tramp-compat-file-attribute-size
- (file-attributes (file-truename filename))))
- (attributes (and preserve-extended-attributes
- (apply 'file-extended-attributes (list filename)))))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error
- v 'file-already-exists "File %s already exists" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s"
- (if (eq op 'copy) "Copying" "Renaming")
- filename newname)
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for
- ;; both files, we invoke `cp' or `mv' on the remote
- ;; host directly.
- ((tramp-equal-remote filename newname)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((and
- (tramp-method-out-of-band-p v1 length)
- (tramp-method-out-of-band-p v2 length))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; No shortcut was possible. So we copy the file
- ;; first. If the operation was `rename', we go back
- ;; and delete the original file (if the copy was
- ;; successful). The approach is simple-minded: we
- ;; create a new buffer, insert the contents of the
- ;; source file into it, then write out the buffer to
- ;; the target file. The advantage is that it doesn't
- ;; matter which file name handlers are used for the
- ;; source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))))
-
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
- (cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
+ (if (file-directory-p filename)
+ (progn
+ (copy-directory filename newname keep-date t)
+ (when (eq op 'rename) (delete-directory filename 'recursive)))
- ;; If the Tramp file has an out-of-band method, the
- ;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p v length)
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname keep-date))
-
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname keep-date))))
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (length (tramp-compat-file-attribute-size
+ (file-attributes (file-truename filename))))
+ (attributes (and preserve-extended-attributes
+ (apply 'file-extended-attributes (list filename)))))
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- (when attributes
- (ignore-errors
- (apply 'set-file-extended-attributes (list newname attributes))))
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s"
+ (if (eq op 'copy) "Copying" "Renaming")
+ filename newname)
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-property v1 (file-name-directory v1-localname))
- (tramp-flush-file-property v1 v1-localname)))
+ (cond
+ ;; Both are Tramp files.
+ ((and t1 t2)
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (cond
+ ;; Shortcut: if method, host, user are the same for
+ ;; both files, we invoke `cp' or `mv' on the remote
+ ;; host directly.
+ ((tramp-equal-remote filename newname)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; Try out-of-band operation.
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname keep-date))
+
+ ;; No shortcut was possible. So we copy the file
+ ;; first. If the operation was `rename', we go back
+ ;; and delete the original file (if the copy was
+ ;; successful). The approach is simple-minded: we
+ ;; create a new buffer, insert the contents of the
+ ;; source file into it, then write out the buffer to
+ ;; the target file. The advantage is that it doesn't
+ ;; matter which file name handlers are used for the
+ ;; source and target file.
+ (t
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date))))))
+
+ ;; One file is a Tramp file, the other one is local.
+ ((or t1 t2)
+ (cond
+ ;; Fast track on local machine.
+ ((tramp-local-host-p v)
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; If the Tramp file has an out-of-band method, the
+ ;; corresponding copy-program can be invoked.
+ ((tramp-method-out-of-band-p v length)
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname keep-date))
+
+ ;; Use the inline method via a Tramp buffer.
+ (t (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname keep-date))))
- ;; When newname did exist, we have wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-property v2 (file-name-directory v2-localname))
- (tramp-flush-file-property v2 v2-localname)))))))
+ (t
+ ;; One of them must be a Tramp file.
+ (error "Tramp implementation says this cannot happen")))
+
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (apply 'set-file-extended-attributes (list newname attributes))))
+
+ ;; In case of `rename', we must flush the cache of the source file.
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-property v1 (file-name-directory v1-localname))
+ (tramp-flush-file-property v1 v1-localname)))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-property v2 (file-name-directory v2-localname))
+ (tramp-flush-file-property v2 v2-localname))))))))
(defun tramp-do-copy-or-rename-file-via-buffer (op filename newname keep-date)
"Use an Emacs buffer to copy or rename a file.
@@ -2734,6 +2751,17 @@ The method used must be an out-of-band method."
beg 'noerror)
(replace-match (file-relative-name filename) t))
+ ;; Try to insert the amount of free space.
+ (goto-char (point-min))
+ ;; First find the line to put it on.
+ (when (re-search-forward "^\\([[:space:]]*total\\)" nil t)
+ (let ((available (get-free-disk-space ".")))
+ (when available
+ ;; Replace "total" with "total used", to avoid confusion.
+ (replace-match "\\1 used in directory")
+ (end-of-line)
+ (insert " available " available))))
+
(goto-char (point-max)))))))
;; Canonicalization of file names.
@@ -2879,7 +2907,8 @@ the result will be a local, non-Tramp, file name."
;; We do not want to raise an error when
;; `start-file-process' has been started several times in
;; `eshell' and friends.
- (tramp-current-connection nil))
+ (tramp-current-connection nil)
+ p)
(while (get-process name1)
;; NAME must be unique as process name.
@@ -2909,33 +2938,37 @@ the result will be a local, non-Tramp, file name."
;; to cleanup the prompt afterwards.
(catch 'suppress
(tramp-maybe-open-connection v)
+ (setq p (tramp-get-connection-process v))
+ ;; Set the pid of the remote shell. This is
+ ;; needed when sending signals remotely.
+ (let ((pid (tramp-send-command-and-read v "echo $$")))
+ (process-put p 'remote-pid pid)
+ (tramp-set-connection-property p "remote-pid" pid))
(widen)
- (delete-region mark (point))
+ (delete-region mark (point-max))
(narrow-to-region (point-max) (point-max))
;; Now do it.
(if command
;; Send the command.
(tramp-send-command v command nil t) ; nooutput
;; Check, whether a pty is associated.
- (unless (process-get
- (tramp-get-connection-process v) 'remote-tty)
+ (unless (process-get p 'remote-tty)
(tramp-error
v 'file-error
"pty association is not supported for `%s'" name))))
- (let ((p (tramp-get-connection-process v)))
- ;; Set query flag and process marker for this
- ;; process. We ignore errors, because the process
- ;; could have finished already.
- (ignore-errors
- (set-process-query-on-exit-flag p t)
- (set-marker (process-mark p) (point)))
- ;; Return process.
- p))))
+ ;; Set query flag and process marker for this
+ ;; process. We ignore errors, because the process
+ ;; could have finished already.
+ (ignore-errors
+ (set-process-query-on-exit-flag p t)
+ (set-marker (process-mark p) (point)))
+ ;; Return process.
+ p)))
;; Save exit.
(if (string-match tramp-temp-buffer-name (buffer-name))
(ignore-errors
- (set-process-buffer (tramp-get-connection-process v) nil)
+ (set-process-buffer p nil)
(kill-buffer (current-buffer)))
(set-buffer-modified-p bmp))
(tramp-set-connection-property v "process-name" nil)
@@ -3071,7 +3104,7 @@ the result will be a local, non-Tramp, file name."
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(with-parsed-tramp-file-name filename nil
- (unless (file-exists-p filename)
+ (unless (file-exists-p (file-truename filename))
(tramp-error
v tramp-file-missing
"Cannot make local copy of non-existing file `%s'" filename))
@@ -3150,23 +3183,16 @@ the result will be a local, non-Tramp, file name."
;; CCC grok LOCKNAME
(defun tramp-sh-handle-write-region
- (start end filename &optional append visit lockname confirm)
+ (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- ;; Following part commented out because we don't know what to do about
- ;; file locking, and it does not appear to be a problem to ignore it.
- ;; Ange-ftp ignores it, too.
- ;; (when (and lockname (stringp lockname))
- ;; (setq lockname (expand-file-name lockname)))
- ;; (unless (or (eq lockname nil)
- ;; (string= lockname filename))
- ;; (error
- ;; "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME"))
-
- (when (and confirm (file-exists-p filename))
- (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename))
- (tramp-error v 'file-error "File not overwritten")))
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
(let ((uid (or (tramp-compat-file-attribute-user-id
(file-attributes filename 'integer))
@@ -3185,8 +3211,7 @@ the result will be a local, non-Tramp, file name."
(file-writable-p localname)))))
;; Short track: if we are on the local host, we can run directly.
(tramp-run-real-handler
- 'write-region
- (list start end localname append 'no-message lockname confirm))
+ 'write-region (list start end localname append 'no-message lockname))
(let* ((modes (save-excursion (tramp-default-file-modes filename)))
;; We use this to save the value of
@@ -3223,7 +3248,7 @@ the result will be a local, non-Tramp, file name."
(condition-case err
(tramp-run-real-handler
'write-region
- (list start end tmpfile append 'no-message lockname confirm))
+ (list start end tmpfile append 'no-message lockname))
((error quit)
(setq tramp-temp-buffer-file-name nil)
(delete-file tmpfile)
@@ -3429,10 +3454,12 @@ the result will be a local, non-Tramp, file name."
(let (tramp-vc-registered-file-names
(remote-file-name-inhibit-cache (current-time))
(file-name-handler-alist
- `((,(tramp-file-name-regexp) . tramp-vc-file-name-handler))))
+ `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation.
- (ignore-errors (tramp-run-real-handler 'vc-registered (list file)))
+ (tramp-with-demoted-errors
+ v "Error in 1st pass of `vc-registered': %s"
+ (tramp-run-real-handler 'vc-registered (list file)))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache.
@@ -3493,28 +3520,18 @@ the result will be a local, non-Tramp, file name."
v vc-hg-program (tramp-get-remote-path v)))))
(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
;; Run.
- (ignore-errors
+ (tramp-with-demoted-errors
+ v "Error in 2nd pass of `vc-registered': %s"
(tramp-run-real-handler 'vc-registered (list file))))))))
;;;###tramp-autoload
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
- (when (and tramp-locked (not tramp-locker))
- (setq tramp-locked nil)
- (tramp-error
- (car-safe tramp-current-connection) 'file-error
- "Forbidden reentrant call of Tramp"))
- (let ((tl tramp-locked))
- (setq tramp-locked t)
- (unwind-protect
- (let ((tramp-locker t))
- (save-match-data
- (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if fn
- (apply (cdr fn) args)
- (tramp-run-real-handler operation args)))))
- (setq tramp-locked tl))))
+ (let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (if fn
+ (save-match-data (apply (cdr fn) args))
+ (tramp-run-real-handler operation args))))
;; This must be the last entry, because `identity' always matches.
;;;###tramp-autoload
@@ -3707,6 +3724,30 @@ file-notify events."
'file-notify-handle-event
`(file-notify ,object file-notify-callback)))))))
+(defun tramp-sh-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (when (tramp-get-remote-df v)
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-send-command
+ v (format
+ "%s --block-size=1 --output=size,used,avail %s"
+ (tramp-get-remote-df v) (tramp-shell-quote-argument localname)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"
+ "[[:space:]]+\\([[:digit:]]+\\)"))
+ (list (string-to-number (concat (match-string 1) "e0"))
+ ;; The second value is the used size. We need the
+ ;; free size.
+ (- (string-to-number (concat (match-string 1) "e0"))
+ (string-to-number (concat (match-string 2) "e0")))
+ (string-to-number (concat (match-string 3) "e0")))))))))
+
;;; Internal Functions:
(defun tramp-maybe-send-script (vec script name)
@@ -3912,9 +3953,17 @@ file exists and nonzero exit status otherwise."
;; file clobbering $PS1. $PROMPT_COMMAND is another way to set
;; the prompt in /bin/bash, it must be discarded as well.
;; $HISTFILE is set according to `tramp-histfile-override'.
+ ;; $TERM and $INSIDE_EMACS set here to 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.)
(tramp-send-command
vec (format
- "exec env ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
+ (concat
+ "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
+ "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s")
+ tramp-terminal-type
+ emacs-version tramp-version ; INSIDE_EMACS
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -4131,7 +4180,8 @@ process to set up. VEC specifies the connection."
;; Set `remote-tty' process property.
(let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
(unless (zerop (length tty))
- (process-put proc 'remote-tty tty)))
+ (process-put proc 'remote-tty tty)
+ (tramp-set-connection-property proc "remote-tty" tty)))
;; Dump stty settings in the traces.
(when (>= tramp-verbose 9)
@@ -4467,7 +4517,7 @@ Goes through the list `tramp-inline-compress-commands'."
(let ((user (tramp-file-name-user item))
(host (tramp-file-name-host item))
(proxy (concat
- (tramp-prefix-format) proxy (tramp-postfix-host-format))))
+ tramp-prefix-format proxy tramp-postfix-host-format)))
(tramp-message
vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")"
(and (stringp host) (regexp-quote host))
@@ -5409,6 +5459,17 @@ This command is returned only if `delete-by-moving-to-trash' is non-nil."
(delete-file tmpfile))
result)))
+(defun tramp-get-remote-df (vec)
+ "Determine remote `df' command."
+ (with-tramp-connection-property vec "df"
+ (tramp-message vec 5 "Finding a suitable `df' command")
+ (let ((result (tramp-find-executable vec "df" (tramp-get-remote-path vec))))
+ (and
+ result
+ (tramp-send-command-and-check
+ vec (format "%s --block-size=1 --output=size,used,avail /" result))
+ result))))
+
(defun tramp-get-remote-gvfs-monitor-dir (vec)
"Determine remote `gvfs-monitor-dir' command."
(with-tramp-connection-property vec "gvfs-monitor-dir"
@@ -5707,9 +5768,6 @@ function cell is returned to be applied on a buffer."
;; * Reconnect directly to a compliant shell without first going
;; through the user's default shell. (Pete Forman)
;;
-;; * How can I interrupt the remote process with a signal
-;; (interrupt-process seems not to work)? (Markus Triska)
-;;
;; * Avoid the local shell entirely for starting remote processes. If
;; so, I think even a signal, when delivered directly to the local
;; SSH instance, would correctly be propagated to the remote process
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 1aadd14fb41..eb0d6b50731 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -130,6 +130,7 @@ call, letting the SMB client use the default one."
"NT_STATUS_ACCOUNT_LOCKED_OUT"
"NT_STATUS_BAD_NETWORK_NAME"
"NT_STATUS_CANNOT_DELETE"
+ "NT_STATUS_CONNECTION_DISCONNECTED"
"NT_STATUS_CONNECTION_REFUSED"
"NT_STATUS_DIRECTORY_NOT_EMPTY"
"NT_STATUS_DUPLICATE_NAME"
@@ -137,6 +138,7 @@ call, letting the SMB client use the default one."
"NT_STATUS_HOST_UNREACHABLE"
"NT_STATUS_IMAGE_ALREADY_LOADED"
"NT_STATUS_INVALID_LEVEL"
+ "NT_STATUS_INVALID_PARAMETER_MIX"
"NT_STATUS_IO_TIMEOUT"
"NT_STATUS_LOGON_FAILURE"
"NT_STATUS_NETWORK_ACCESS_DENIED"
@@ -147,6 +149,7 @@ call, letting the SMB client use the default one."
"NT_STATUS_OBJECT_NAME_COLLISION"
"NT_STATUS_OBJECT_NAME_INVALID"
"NT_STATUS_OBJECT_NAME_NOT_FOUND"
+ "NT_STATUS_OBJECT_PATH_SYNTAX_BAD"
"NT_STATUS_PASSWORD_MUST_CHANGE"
"NT_STATUS_SHARING_VIOLATION"
"NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE"
@@ -250,9 +253,10 @@ See `tramp-actions-before-shell' for more info.")
(file-readable-p . tramp-handle-file-exists-p)
(file-regular-p . tramp-handle-file-regular-p)
(file-remote-p . tramp-handle-file-remote-p)
- ;; `file-selinux-context' performed by default handler.
+ (file-selinux-context . tramp-handle-file-selinux-context)
(file-symlink-p . tramp-handle-file-symlink-p)
- ;; `file-truename' performed by default handler.
+ (file-system-info . tramp-smb-handle-file-system-info)
+ (file-truename . tramp-handle-file-truename)
(file-writable-p . tramp-smb-handle-file-writable-p)
(find-backup-file-name . tramp-handle-find-backup-file-name)
;; `find-file-noselect' performed by default handler.
@@ -353,16 +357,17 @@ pass to the OPERATION."
(tramp-error
v2 'file-error
"add-name-to-file: %s must not be a directory" filename))
- (when (and (not ok-if-already-exists)
- (file-exists-p newname)
- (not (numberp ok-if-already-exists))
- (y-or-n-p
- (format
- "File %s already exists; make it a new name anyway? "
- newname)))
- (tramp-error
- v2 'file-error
- "add-name-to-file: file %s already exists" newname))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ v2-localname)))))
+ (tramp-error v2 'file-already-exists newname)
+ (delete-file newname)))
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v2 (file-name-directory v2-localname))
@@ -410,6 +415,9 @@ pass to the OPERATION."
(with-parsed-tramp-file-name (if t1 dirname newname) nil
(with-tramp-progress-reporter
v 0 (format "Copying %s to %s" dirname newname)
+ (when (and (file-directory-p newname)
+ (not (tramp-compat-directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
(cond
;; We must use a local temporary directory.
((and t1 t2)
@@ -421,14 +429,16 @@ pass to the OPERATION."
(unwind-protect
(progn
(make-directory tmpdir)
- (copy-directory dirname tmpdir keep-date 'parents)
+ (copy-directory
+ dirname (file-name-as-directory tmpdir) keep-date 'parents)
(copy-directory
(expand-file-name (file-name-nondirectory dirname) tmpdir)
newname keep-date parents))
(delete-directory tmpdir 'recursive))))
;; We can copy recursively.
- ((and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
+ ;; Does not work reliably.
+ (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v))
(when (and (file-directory-p newname)
(not (string-equal (file-name-nondirectory dirname)
(file-name-nondirectory newname))))
@@ -526,7 +536,7 @@ pass to the OPERATION."
;; Reset the transfer process properties.
(tramp-set-connection-property v "process-name" nil)
(tramp-set-connection-property v "process-buffer" nil)
- (when t1 (delete-directory tmpdir 'recurse))))
+ (when t1 (delete-directory tmpdir 'recursive))))
;; Handle KEEP-DATE argument.
(when keep-date
@@ -564,8 +574,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
0 (format "Copying %s to %s" filename newname)
(if (file-directory-p filename)
- (copy-directory
- filename newname keep-date 'parents 'copy-contents)
+ (copy-directory filename newname keep-date 'parents 'copy-contents)
(let ((tmpfile (file-local-copy filename)))
(if tmpfile
@@ -577,7 +586,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(signal (car err) (cdr err))))
;; Remote newname.
- (when (file-directory-p newname)
+ (when (and (file-directory-p newname)
+ (tramp-compat-directory-name-p newname))
(setq newname
(expand-file-name (file-name-nondirectory filename) newname)))
@@ -886,9 +896,20 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(string-to-number (match-string 2)) ;; month
(string-to-number (match-string 1)))))) ;; year
(forward-line))
+
+ ;; Resolve symlink.
+ (when (and (stringp id)
+ (tramp-smb-send-command
+ vec
+ (format "readlink \"%s\"" (tramp-smb-get-localname vec))))
+ (goto-char (point-min))
+ (and (looking-at ".+ -> \\(.+\\)")
+ (setq id (match-string 1))))
+
;; Return the result.
- (list id link uid gid atime mtime ctime size mode nil inode
- (tramp-get-device vec)))))))
+ (when (or id link uid gid atime mtime ctime size mode inode)
+ (list id link uid gid atime mtime ctime size mode nil inode
+ (tramp-get-device vec))))))))
(defun tramp-smb-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
@@ -899,8 +920,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(defun tramp-smb-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (unless (file-exists-p filename)
+ (with-parsed-tramp-file-name (file-truename filename) nil
+ (unless (file-exists-p (file-truename filename))
(tramp-error
v tramp-file-missing
"Cannot make local copy of non-existing file `%s'" filename))
@@ -934,6 +955,38 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(nth 0 x))))
(tramp-smb-get-file-entries directory))))))))
+(defun tramp-smb-handle-file-system-info (filename)
+ "Like `file-system-info' for Tramp files."
+ (ignore-errors
+ (unless (file-directory-p filename)
+ (setq filename (file-name-directory filename)))
+ (with-parsed-tramp-file-name (expand-file-name filename) nil
+ (tramp-message v 5 "file system info: %s" localname)
+ (tramp-smb-send-command v (format "du %s/*" (tramp-smb-get-localname v)))
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (let (total avail blocksize)
+ (goto-char (point-min))
+ (forward-line)
+ (when (looking-at
+ (concat "[[:space:]]*\\([[:digit:]]+\\)"
+ " blocks of size \\([[:digit:]]+\\)"
+ "\\. \\([[:digit:]]+\\) blocks available"))
+ (setq blocksize (string-to-number (concat (match-string 2) "e0"))
+ total (* blocksize
+ (string-to-number (concat (match-string 1) "e0")))
+ avail (* blocksize
+ (string-to-number (concat (match-string 3) "e0")))))
+ (forward-line)
+ (when (looking-at "Total number of bytes: \\([[:digit:]]+\\)")
+ ;; The used number of bytes is not part of the result. As
+ ;; side effect, we store it as file property.
+ (tramp-set-file-property
+ v localname "used-bytes"
+ (string-to-number (concat (match-string 1) "e0"))))
+ ;; Result.
+ (when (and total avail)
+ (list total (- total avail) avail)))))))
+
(defun tramp-smb-handle-file-writable-p (filename)
"Like `file-writable-p' for Tramp files."
(if (file-exists-p filename)
@@ -964,7 +1017,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
;; We should not destroy the cache entry.
(entries (copy-sequence
(tramp-smb-get-file-entries
- (file-name-directory filename)))))
+ (file-name-directory filename))))
+ (avail (get-free-disk-space filename))
+ ;; `get-free-disk-space' calls `file-system-info', which
+ ;; sets file property "used-bytes" as side effect.
+ (used
+ (format
+ "%.0f"
+ (/ (tramp-get-file-property v localname "used-bytes" 0) 1024))))
(when wildcard
(string-match "\\." base)
@@ -1012,15 +1072,25 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setcar x (concat (car x) "*"))))))
entries))
+ ;; Insert size information.
+ (when full-directory-p
+ (insert
+ (if avail
+ (format "total used in directory %s available %s\n" used avail)
+ (format "total %s\n" used))))
+
;; Print entries.
(mapc
(lambda (x)
(when (not (zerop (length (nth 0 x))))
- (when (string-match "l" switches)
- (let ((attr
- (when (tramp-smb-get-stat-capability v)
- (ignore-errors
- (file-attributes filename 'string)))))
+ (let ((attr
+ (when (tramp-smb-get-stat-capability v)
+ (ignore-errors
+ (file-attributes
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ 'string)))))
+ (when (string-match "l" switches)
(insert
(format
"%10s %3d %-8s %-8s %8s %s "
@@ -1034,20 +1104,27 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
tramp-half-a-year)
"%b %e %R"
"%b %e %Y")
- (nth 3 x)))))) ; date
-
- ;; We mark the file name. The inserted name could be
- ;; from somewhere else, so we use the relative file name
- ;; of `default-directory'.
- (let ((start (point)))
- (insert
- (format
- "%s\n"
- (file-relative-name
- (expand-file-name
- (nth 0 x) (file-name-directory filename))
- (when full-directory-p (file-name-directory filename)))))
- (put-text-property start (1- (point)) 'dired-filename t))
+ (nth 3 x))))) ; date
+
+ ;; We mark the file name. The inserted name could be
+ ;; from somewhere else, so we use the relative file name
+ ;; of `default-directory'.
+ (let ((start (point)))
+ (insert
+ (format
+ "%s"
+ (file-relative-name
+ (expand-file-name
+ (nth 0 x) (file-name-directory filename))
+ (when full-directory-p (file-name-directory filename)))))
+ (put-text-property start (point) 'dired-filename t))
+
+ ;; Insert symlink.
+ (when (and (string-match "l" switches)
+ (stringp (tramp-compat-file-attribute-type attr)))
+ (insert " -> " (tramp-compat-file-attribute-type attr))))
+
+ (insert "\n")
(forward-line)
(beginning-of-line)))
entries))))))
@@ -1094,56 +1171,58 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
v 'file-error "Couldn't make directory %s" directory))))))
(defun tramp-smb-handle-make-symbolic-link
- (filename linkname &optional ok-if-already-exists)
+ (target linkname &optional ok-if-already-exists)
"Like `make-symbolic-link' for Tramp files.
-If LINKNAME is a non-Tramp file, it is used verbatim as the target of
-the symlink. If LINKNAME is a Tramp file, only the localname component is
-used as the target of the symlink.
-
-If LINKNAME is a Tramp file and the localname component is relative, then
-it is expanded first, before the localname component is taken. Note that
-this can give surprising results if the user/host for the source and
-target of the symlink differ."
- (unless (tramp-equal-remote filename linkname)
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename linkname) nil
- (tramp-error
- v 'file-error
- "make-symbolic-link: %s"
- "only implemented for same method, same user, same host")))
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name linkname v2
- (when (file-directory-p filename)
- (tramp-error
- v2 'file-error
- "make-symbolic-link: %s must not be a directory" filename))
- (when (and (not ok-if-already-exists)
- (file-exists-p linkname)
- (not (numberp ok-if-already-exists))
- (y-or-n-p
- (format
- "File %s already exists; make it a new name anyway? "
- linkname)))
- (tramp-error
- v2 'file-already-exists
- "make-symbolic-link: file %s already exists" linkname))
- (unless (tramp-smb-get-cifs-capabilities v1)
- (tramp-error v2 'file-error "make-symbolic-link not supported"))
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-property v2 (file-name-directory v2-localname))
- (tramp-flush-file-property v2 v2-localname)
- (unless
- (tramp-smb-send-command
- v1
- (format
- "symlink \"%s\" \"%s\""
- (tramp-smb-get-localname v1)
- (tramp-smb-get-localname v2)))
- (tramp-error
- v2 'file-error
- "error with make-symbolic-link, see buffer `%s' for details"
- (buffer-name))))))
+If TARGET is a non-Tramp file, it is used verbatim as the target
+of the symlink. If TARGET is a Tramp file, only the localname
+component is used as the target of the symlink."
+ (if (not (tramp-tramp-file-p (expand-file-name linkname)))
+ (tramp-run-real-handler
+ 'make-symbolic-link (list target linkname ok-if-already-exists))
+
+ (with-parsed-tramp-file-name linkname nil
+ ;; If TARGET is a Tramp name, use just the localname component.
+ (when (and (tramp-tramp-file-p target)
+ (tramp-file-name-equal-p v (tramp-dissect-file-name target)))
+ (setq target
+ (tramp-file-name-localname
+ (tramp-dissect-file-name (expand-file-name target)))))
+
+ ;; If TARGET is still remote, quote it.
+ (if (tramp-tramp-file-p target)
+ (make-symbolic-link
+ (let (file-name-handler-alist) (tramp-compat-file-name-quote target))
+ linkname ok-if-already-exists)
+
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p linkname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ localname)))))
+ (tramp-error v 'file-already-exists localname)
+ (delete-file linkname)))
+
+ (unless (tramp-smb-get-cifs-capabilities v)
+ (tramp-error v 'file-error "make-symbolic-link not supported"))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+
+ (unless
+ (tramp-smb-send-command
+ v (format "symlink \"%s\" \"%s\""
+ (tramp-compat-file-name-unquote target)
+ (tramp-smb-get-localname v)))
+ (tramp-error
+ v 'file-error
+ "error with make-symbolic-link, see buffer `%s' for details"
+ (buffer-name)))))))
(defun tramp-smb-handle-process-file
(program &optional infile destination display &rest args)
@@ -1469,14 +1548,17 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
(error filename))))
(defun tramp-smb-handle-write-region
- (start end filename &optional append visit lockname confirm)
+ (start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
(setq filename (expand-file-name filename))
(with-parsed-tramp-file-name filename nil
- (when (and confirm (file-exists-p filename))
- (unless (y-or-n-p (format "File %s exists; overwrite anyway? "
- filename))
- (tramp-error v 'file-error "File not overwritten")))
+ (when (and mustbenew (file-exists-p filename)
+ (or (eq mustbenew 'excl)
+ (not
+ (y-or-n-p
+ (format "File %s exists; overwrite anyway? " filename)))))
+ (tramp-error v 'file-already-exists filename))
+
;; We must also flush the cache of the directory, because
;; `file-attributes' reads the values from there.
(tramp-flush-file-property v (file-name-directory localname))
@@ -1489,10 +1571,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
;; modtime data to be clobbered from the temp file. We call
;; `set-visited-file-modtime' ourselves later on.
(tramp-run-real-handler
- 'write-region
- (if confirm ; don't pass this arg unless defined for backward compat.
- (list start end tmpfile append 'no-message lockname confirm)
- (list start end tmpfile append 'no-message lockname)))
+ 'write-region (list start end tmpfile append 'no-message lockname))
(with-tramp-progress-reporter
v 3 (format "Moving tmp file %s to %s" tmpfile filename)
@@ -1551,6 +1630,10 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
"Read entries which match DIRECTORY.
Either the shares are listed, or the `dir' command is executed.
Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
+ ;; If CIFS capabilities are enabled, symlinks are not listed
+ ;; by `dir'. This is a consequence of
+ ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
+ ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
(with-parsed-tramp-file-name (file-name-as-directory directory) nil
(setq localname (or localname "/"))
(with-tramp-file-property v localname "file-entries"
@@ -1696,13 +1779,17 @@ Result is the list (LOCALNAME MODE SIZE MTIME)."
(if (string-match "\\([0-9]+\\)$" line)
(let ((length (- (max 10 (1+ (length (match-string 1 line)))))))
(setq size (string-to-number (match-string 1 line)))
- (when (string-match "\\([ADHRSV]+\\)" (substring line length))
+ (when (string-match
+ "\\([ACDEHNORrsSTV]+\\)" (substring line length))
(setq length (+ length (match-end 0))))
(setq line (substring line 0 length)))
(cl-return))
- ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID.
- (if (string-match "\\([ADHRSV]+\\)?$" line)
+ ;; mode: ARCHIVE, COMPRESSED, DIRECTORY, ENCRYPTED, HIDDEN,
+ ;; NONINDEXED, NORMAL, OFFLINE, READONLY,
+ ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID.
+
+ (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line)
(setq
mode (or (match-string 1 line) "")
mode (save-match-data (format
diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el
index 5e5f05da4a8..12d4cd4d9d5 100644
--- a/lisp/net/tramp-uu.el
+++ b/lisp/net/tramp-uu.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8d81ac64aa2..433baed6ed6 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -40,16 +40,16 @@
;; Also see the todo list at the bottom of this file.
;;
;; The current version of Tramp can be retrieved from the following URL:
-;; http://ftp.gnu.org/gnu/tramp/
+;; https://ftp.gnu.org/gnu/tramp/
;;
;; There's a mailing list for this, as well. Its name is:
;; tramp-devel@gnu.org
;; You can use the Web to subscribe, under the following URL:
-;; http://lists.gnu.org/mailman/listinfo/tramp-devel
+;; https://lists.gnu.org/mailman/listinfo/tramp-devel
;;
;; For the adventurous, the current development sources are available
;; via Git. You can find instructions about this at the following URL:
-;; http://savannah.gnu.org/projects/tramp/
+;; https://savannah.gnu.org/projects/tramp/
;;
;; Don't forget to put on your asbestos longjohns, first!
@@ -660,7 +660,7 @@ Useful for \"rsync\" like methods.")
(make-variable-buffer-local 'tramp-temp-buffer-file-name)
(put 'tramp-temp-buffer-file-name 'permanent-local t)
-;;;###autoload
+;;;###tramp-autoload
(defcustom tramp-syntax 'default
"Tramp filename syntax to be used.
@@ -670,29 +670,58 @@ It can have the following values:
`simplified' -- Ange-FTP like syntax
`separate' -- Syntax as defined for XEmacs originally
-Do not change the value by `setq', it must be changed only by
-`custom-set-variables'. See also `tramp-change-syntax'."
+Do not change the value by `setq', it must be changed only via
+Customize. See also `tramp-change-syntax'."
:group 'tramp
:version "26.1"
- :package-version '(Tramp . "2.3.2")
+ :package-version '(Tramp . "2.3.3")
:type '(choice (const :tag "Default" default)
(const :tag "Ange-FTP" simplified)
(const :tag "XEmacs" separate))
:require 'tramp
:initialize 'custom-initialize-set
- :set (lambda (symbol value)
- ;; Check allowed values.
- (unless (memq value (tramp-syntax-values))
- (tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax))
- ;; Cleanup existing buffers.
- (unless (eq (symbol-value symbol) value)
- (tramp-cleanup-all-buffers))
- ;; Set the value:
- (set-default symbol value)
- ;; Reset `tramp-file-name-regexp'.
- (setq tramp-file-name-regexp (tramp-file-name-regexp))
- ;; Rearrange file name handlers.
- (tramp-register-file-name-handlers)))
+ :set 'tramp-set-syntax)
+
+(defun tramp-set-syntax (symbol value)
+ "Set SYMBOL to value VALUE.
+Used in user option `tramp-syntax'. There are further variables
+to be set, depending on VALUE."
+ ;; Check allowed values.
+ (unless (memq value (tramp-syntax-values))
+ (tramp-compat-user-error "Wrong `tramp-syntax' %s" tramp-syntax))
+ ;; Cleanup existing buffers.
+ (unless (eq (symbol-value symbol) value)
+ (tramp-cleanup-all-buffers))
+ ;; Set the value:
+ (set-default symbol value)
+ ;; Reset the depending variables.
+ (with-no-warnings
+ (setq tramp-prefix-format (tramp-build-prefix-format)
+ tramp-prefix-regexp (tramp-build-prefix-regexp)
+ tramp-method-regexp (tramp-build-method-regexp)
+ tramp-postfix-method-format (tramp-build-postfix-method-format)
+ tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
+ tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
+ tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
+ tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
+ tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
+ tramp-postfix-host-format (tramp-build-postfix-host-format)
+ tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
+ tramp-remote-file-name-spec-regexp
+ (tramp-build-remote-file-name-spec-regexp)
+ tramp-file-name-structure (tramp-build-file-name-structure)
+ tramp-file-name-regexp (tramp-build-file-name-regexp)
+ tramp-completion-file-name-regexp
+ (tramp-build-completion-file-name-regexp)))
+ ;; Rearrange file name handlers.
+ (tramp-register-file-name-handlers))
+
+;; Initialize the Tramp syntax variables. We want to override initial
+;; value of `tramp-file-name-regexp'. Other Tramp syntax variables
+;; must be initialized as well to proper values. We do not call
+;; `custom-set-variable', this would load Tramp via custom.el.
+(eval-after-load 'tramp
+ '(tramp-set-syntax 'tramp-syntax (tramp-compat-tramp-syntax)))
(defun tramp-syntax-values ()
"Return possible values of `tramp-syntax', a list"
@@ -700,40 +729,65 @@ Do not change the value by `setq', it must be changed only by
(setq values (mapcar 'last values)
values (mapcar 'car values))))
-(defun tramp-prefix-format ()
+(defun tramp-lookup-syntax (alist)
+ "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax.'
+Raise an error if `tramp-syntax' is invalid."
+ (or (cdr (assq (tramp-compat-tramp-syntax) alist))
+ (error "Wrong `tramp-syntax' %s" tramp-syntax)))
+
+(defconst tramp-prefix-format-alist
+ '((default . "/")
+ (simplified . "/")
+ (separate . "/["))
+ "Alist mapping Tramp syntax to strings beginning Tramp file names.")
+
+(defun tramp-build-prefix-format ()
+ (tramp-lookup-syntax tramp-prefix-format-alist))
+
+(defvar tramp-prefix-format (tramp-build-prefix-format)
"String matching the very beginning of Tramp file names.
-Used in `tramp-make-tramp-file-name'."
- (cond ((eq (tramp-compat-tramp-syntax) 'default) "/")
- ((eq (tramp-compat-tramp-syntax) 'simplified) "/")
- ((eq (tramp-compat-tramp-syntax) 'separate) "/[")
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+Used in `tramp-make-tramp-file-name'.")
-(defun tramp-prefix-regexp ()
+(defun tramp-build-prefix-regexp ()
+ (concat "^" (regexp-quote tramp-prefix-format)))
+
+(defvar tramp-prefix-regexp (tramp-build-prefix-regexp)
"Regexp matching the very beginning of Tramp file names.
-Should always start with \"^\". Derived from `tramp-prefix-format'."
- (concat "^" (regexp-quote (tramp-prefix-format))))
+Should always start with \"^\". Derived from `tramp-prefix-format'.")
+
+(defconst tramp-method-regexp-alist
+ '((default . "[a-zA-Z0-9-]+")
+ (simplified . "")
+ (separate . "[a-zA-Z0-9-]*"))
+ "Alist mapping Tramp syntax to regexps matching methods identifiers.")
-(defun tramp-method-regexp ()
+(defun tramp-build-method-regexp ()
+ (tramp-lookup-syntax tramp-method-regexp-alist))
+
+(defvar tramp-method-regexp (tramp-build-method-regexp)
"Regexp matching methods identifiers.
-The `ftp' syntax does not support methods."
- (cond ((eq (tramp-compat-tramp-syntax) 'default) "[a-zA-Z0-9-]+")
- ((eq (tramp-compat-tramp-syntax) 'simplified) "")
- ((eq (tramp-compat-tramp-syntax) 'separate) "[a-zA-Z0-9-]*")
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+The `ftp' syntax does not support methods.")
+
+(defconst tramp-postfix-method-format-alist
+ '((default . ":")
+ (simplified . "")
+ (separate . "/"))
+ "Alist mapping Tramp syntax to the delimiter after the method.")
-(defun tramp-postfix-method-format ()
+(defun tramp-build-postfix-method-format ()
+ (tramp-lookup-syntax tramp-postfix-method-format-alist))
+
+(defvar tramp-postfix-method-format (tramp-build-postfix-method-format)
"String matching delimiter between method and user or host names.
The `ftp' syntax does not support methods.
-Used in `tramp-make-tramp-file-name'."
- (cond ((eq (tramp-compat-tramp-syntax) 'default) ":")
- ((eq (tramp-compat-tramp-syntax) 'simplified) "")
- ((eq (tramp-compat-tramp-syntax) 'separate) "/")
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+Used in `tramp-make-tramp-file-name'.")
-(defun tramp-postfix-method-regexp ()
+(defun tramp-build-postfix-method-regexp ()
+ (regexp-quote tramp-postfix-method-format))
+
+(defvar tramp-postfix-method-regexp (tramp-build-postfix-method-regexp)
"Regexp matching delimiter between method and user or host names.
-Derived from `tramp-postfix-method-format'."
- (regexp-quote (tramp-postfix-method-format)))
+Derived from `tramp-postfix-method-format'.")
(defconst tramp-user-regexp "[^/|: \t]+"
"Regexp matching user names.")
@@ -743,8 +797,7 @@ Derived from `tramp-postfix-method-format'."
"String matching delimiter between user and domain names.")
;;;###tramp-autoload
-(defconst tramp-prefix-domain-regexp
- (regexp-quote tramp-prefix-domain-format)
+(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format)
"Regexp matching delimiter between user and domain names.
Derived from `tramp-prefix-domain-format'.")
@@ -761,52 +814,63 @@ Derived from `tramp-prefix-domain-format'.")
"String matching delimiter between user and host names.
Used in `tramp-make-tramp-file-name'.")
-(defconst tramp-postfix-user-regexp
- (regexp-quote tramp-postfix-user-format)
+(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format)
"Regexp matching delimiter between user and host names.
Derived from `tramp-postfix-user-format'.")
-(defconst tramp-host-regexp "[a-zA-Z0-9_.-]+"
+(defconst tramp-host-regexp "[a-zA-Z0-9_.%-]+"
"Regexp matching host names.")
-(defun tramp-prefix-ipv6-format ()
+(defconst tramp-prefix-ipv6-format-alist
+ '((default . "[")
+ (simplified . "[")
+ (separate . ""))
+ "Alist mapping Tramp syntax to strings prefixing IPv6 addresses.")
+
+(defun tramp-build-prefix-ipv6-format ()
+ (tramp-lookup-syntax tramp-prefix-ipv6-format-alist))
+
+(defvar tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format)
"String matching left hand side of IPv6 addresses.
-Used in `tramp-make-tramp-file-name'."
- (cond ((eq (tramp-compat-tramp-syntax) 'default) "[")
- ((eq (tramp-compat-tramp-syntax) 'simplified) "[")
- ((eq (tramp-compat-tramp-syntax) 'separate) "")
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+Used in `tramp-make-tramp-file-name'.")
-(defun tramp-prefix-ipv6-regexp ()
+(defun tramp-build-prefix-ipv6-regexp ()
+ (regexp-quote tramp-prefix-ipv6-format))
+
+(defvar tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp)
"Regexp matching left hand side of IPv6 addresses.
-Derived from `tramp-prefix-ipv6-format'."
- (regexp-quote (tramp-prefix-ipv6-format)))
+Derived from `tramp-prefix-ipv6-format'.")
;; The following regexp is a bit sloppy. But it shall serve our
;; purposes. It covers also IPv4 mapped IPv6 addresses, like in
;; "::ffff:192.168.0.1".
-(defconst tramp-ipv6-regexp
- "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
+(defconst tramp-ipv6-regexp "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+"
"Regexp matching IPv6 addresses.")
-(defun tramp-postfix-ipv6-format ()
+(defconst tramp-postfix-ipv6-format-alist
+ '((default . "]")
+ (simplified . "]")
+ (separate . ""))
+ "Alist mapping Tramp syntax to suffix for IPv6 addresses.")
+
+(defun tramp-build-postfix-ipv6-format ()
+ (tramp-lookup-syntax tramp-postfix-ipv6-format-alist))
+
+(defvar tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format)
"String matching right hand side of IPv6 addresses.
-Used in `tramp-make-tramp-file-name'."
- (cond ((eq (tramp-compat-tramp-syntax) 'default) "]")
- ((eq (tramp-compat-tramp-syntax) 'simplified) "]")
- ((eq (tramp-compat-tramp-syntax) 'separate) "")
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+Used in `tramp-make-tramp-file-name'.")
-(defun tramp-postfix-ipv6-regexp ()
+(defun tramp-build-postfix-ipv6-regexp ()
+ (regexp-quote tramp-postfix-ipv6-format))
+
+(defvar tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp)
"Regexp matching right hand side of IPv6 addresses.
-Derived from `tramp-postfix-ipv6-format'."
- (regexp-quote (tramp-postfix-ipv6-format)))
+Derived from `tramp-postfix-ipv6-format'.")
(defconst tramp-prefix-port-format "#"
"String matching delimiter between host names and port numbers.")
-(defconst tramp-prefix-port-regexp
- (regexp-quote tramp-prefix-port-format)
+(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format)
"Regexp matching delimiter between host names and port numbers.
Derived from `tramp-prefix-port-format'.")
@@ -822,23 +886,29 @@ Derived from `tramp-prefix-port-format'.")
(defconst tramp-postfix-hop-format "|"
"String matching delimiter after ad-hoc hop definitions.")
-(defconst tramp-postfix-hop-regexp
- (regexp-quote tramp-postfix-hop-format)
+(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format)
"Regexp matching delimiter after ad-hoc hop definitions.
Derived from `tramp-postfix-hop-format'.")
-(defun tramp-postfix-host-format ()
+(defconst tramp-postfix-host-format-alist
+ '((default . ":")
+ (simplified . ":")
+ (separate . "]"))
+ "Alist mapping Tramp syntax to strings between host and local names.")
+
+(defun tramp-build-postfix-host-format ()
+ (tramp-lookup-syntax tramp-postfix-host-format-alist))
+
+(defvar tramp-postfix-host-format (tramp-build-postfix-host-format)
"String matching delimiter between host names and localnames.
-Used in `tramp-make-tramp-file-name'."
- (cond ((eq (tramp-compat-tramp-syntax) 'default) ":")
- ((eq (tramp-compat-tramp-syntax) 'simplified) ":")
- ((eq (tramp-compat-tramp-syntax) 'separate) "]")
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+Used in `tramp-make-tramp-file-name'.")
-(defun tramp-postfix-host-regexp ()
+(defun tramp-build-postfix-host-regexp ()
+ (regexp-quote tramp-postfix-host-format))
+
+(defvar tramp-postfix-host-regexp (tramp-build-postfix-host-regexp)
"Regexp matching delimiter between host names and localnames.
-Derived from `tramp-postfix-host-format'."
- (regexp-quote (tramp-postfix-host-format)))
+Derived from `tramp-postfix-host-format'.")
(defconst tramp-localname-regexp ".*$"
"Regexp matching localnames.")
@@ -851,18 +921,35 @@ Derived from `tramp-postfix-host-format'."
;;; File name format:
-(defun tramp-remote-file-name-spec-regexp ()
- "Regular expression matching a Tramp file name between prefix and postfix."
+(defun tramp-build-remote-file-name-spec-regexp ()
+ "Construct a regexp matching a Tramp file name for a Tramp syntax.
+It is expected, that `tramp-syntax' has the proper value."
(concat
- "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
- "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
- "\\(" "\\(?:" tramp-host-regexp "\\|"
- (tramp-prefix-ipv6-regexp)
- "\\(?:" tramp-ipv6-regexp "\\)?"
- (tramp-postfix-ipv6-regexp) "\\)?"
- "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
-
-(defun tramp-file-name-structure ()
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?"
+ "\\(" "\\(?:" tramp-host-regexp "\\|"
+ tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?"
+ tramp-postfix-ipv6-regexp "\\)"
+ "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))
+
+(defvar tramp-remote-file-name-spec-regexp
+ (tramp-build-remote-file-name-spec-regexp)
+ "Regular expression matching a Tramp file name between prefix and postfix.")
+
+(defun tramp-build-file-name-structure ()
+ "Construct the Tramp file name structure for a Tramp syntax.
+It is expected, that `tramp-syntax' has the proper value.
+See `tramp-file-name-structure'."
+ (list
+ (concat
+ tramp-prefix-regexp
+ "\\(" "\\(?:" tramp-remote-file-name-spec-regexp
+ tramp-postfix-hop-regexp "\\)+" "\\)?"
+ tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp
+ "\\(" tramp-localname-regexp "\\)")
+ 5 6 7 8 1))
+
+(defvar tramp-file-name-structure (tramp-build-file-name-structure)
"List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \
the Tramp file name structure.
@@ -880,34 +967,23 @@ cascade of several hops.
These numbers are passed directly to `match-string', which see. That
means the opening parentheses are counted to identify the pair.
-See also `tramp-file-name-regexp'."
- (list
- (concat
- (tramp-prefix-regexp)
- "\\(" "\\(?:" (tramp-remote-file-name-spec-regexp)
- tramp-postfix-hop-regexp "\\)+" "\\)?"
- (tramp-remote-file-name-spec-regexp) (tramp-postfix-host-regexp)
- "\\(" tramp-localname-regexp "\\)")
- 5 6 7 8 1))
+See also `tramp-file-name-regexp'.")
-(defun tramp-file-name-regexp ()
- "Regular expression matching file names handled by Tramp.
-This regexp should match Tramp file names but no other file names."
- (car (tramp-file-name-structure)))
+(defun tramp-build-file-name-regexp ()
+ (car tramp-file-name-structure))
;;;###autoload
(defconst tramp-initial-file-name-regexp "\\`/.+:.*:"
"Value for `tramp-file-name-regexp' for autoload.
It must match the initial `tramp-syntax' settings.")
-;; External packages use constant `tramp-file-name-regexp'. In order
-;; not to break them, we still provide it. It is a variable now.
;;;###autoload
(defvar tramp-file-name-regexp tramp-initial-file-name-regexp
- "Value for `tramp-file-name-regexp' for autoload.
-It must match the initial `tramp-syntax' settings.")
+ "Regular expression matching file names handled by Tramp.
+This regexp should match Tramp file names but no other file
+names. When calling `tramp-register-file-name-handlers', the
+initial value is overwritten by the car of `tramp-file-name-structure'.")
-;;;###autoload
(defconst tramp-completion-file-name-regexp-default
(concat
"\\`/\\("
@@ -949,7 +1025,17 @@ On W32 systems, the volume letter must be ignored.")
"Value for `tramp-completion-file-name-regexp' for separate remoting.
See `tramp-file-name-structure' for more explanations.")
-(defun tramp-completion-file-name-regexp ()
+(defconst tramp-completion-file-name-regexp-alist
+ `((default . ,tramp-completion-file-name-regexp-default)
+ (simplified . ,tramp-completion-file-name-regexp-simplified)
+ (separate . ,tramp-completion-file-name-regexp-separate))
+ "Alist mapping incomplete Tramp file names.")
+
+(defun tramp-build-completion-file-name-regexp ()
+ (tramp-lookup-syntax tramp-completion-file-name-regexp-alist))
+
+(defvar tramp-completion-file-name-regexp
+ (tramp-build-completion-file-name-regexp)
"Regular expression matching file names handled by Tramp completion.
This regexp should match partial Tramp file names only.
@@ -958,20 +1044,22 @@ this file \(tramp.el) is loaded. This means that this variable must be set
before loading tramp.el. Alternatively, `file-name-handler-alist' can be
updated after changing this variable.
-Also see `tramp-file-name-structure'."
- (cond ((eq (tramp-compat-tramp-syntax) 'default)
- tramp-completion-file-name-regexp-default)
- ((eq (tramp-compat-tramp-syntax) 'simplified)
- tramp-completion-file-name-regexp-simplified)
- ((eq (tramp-compat-tramp-syntax) 'separate)
- tramp-completion-file-name-regexp-separate)
- (t (error "Wrong `tramp-syntax' %s" tramp-syntax))))
+Also see `tramp-file-name-structure'.")
;;;###autoload
-(defconst tramp-initial-completion-file-name-regexp
- tramp-completion-file-name-regexp-default
- "Value for `tramp-completion-file-name-regexp' for autoload.
-It must match the initial `tramp-syntax' settings.")
+(defconst tramp-autoload-file-name-regexp
+ (concat
+ "\\`/"
+ (if (memq system-type '(cygwin windows-nt))
+ ;; The method is either "-", or at least two characters.
+ "\\(-\\|[^/|:]\\{2,\\}\\)"
+ ;; At least one character for method.
+ "[^/|:]+")
+ ":")
+ "Regular expression matching file names handled by Tramp autoload.
+It must match the initial `tramp-syntax' settings. It should not
+match file names at root of the underlying local file system,
+like \"/sys\" or \"/C:\".")
;; Chunked sending kludge. We set this to 500 for black-listed constellations
;; known to have a bug in `process-send-string'; some ssh connections appear
@@ -1112,7 +1200,6 @@ means to use always cached values for the directory contents."
(defvar tramp-current-connection nil
"Last connection timestamp.")
-;;;###autoload
(defconst tramp-completion-file-name-handler-alist
'((file-name-all-completions
. tramp-completion-handle-file-name-all-completions)
@@ -1195,14 +1282,14 @@ entry does not exist, return nil."
;;;###tramp-autoload
(defun tramp-tramp-file-p (name)
"Return t if NAME is a string with Tramp file name syntax."
- (save-match-data
- (and (stringp name)
- ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
- (not (string-match
- (if (memq system-type '(cygwin windows-nt))
- "^/[[:alpha:]]?:" "^/:")
- name))
- (string-match (tramp-file-name-regexp) name))))
+ (and (stringp name)
+ ;; No "/:" and "/c:". This is not covered by `tramp-file-name-regexp'.
+ (not (string-match-p
+ (if (memq system-type '(cygwin windows-nt))
+ "^/[[:alpha:]]?:" "^/:")
+ name))
+ (string-match-p tramp-file-name-regexp name)
+ t))
(defun tramp-find-method (method user host)
"Return the right method string to use.
@@ -1274,13 +1361,13 @@ values."
(save-match-data
(unless (tramp-tramp-file-p name)
(tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name))
- (if (not (string-match (nth 0 (tramp-file-name-structure)) name))
+ (if (not (string-match (nth 0 tramp-file-name-structure) name))
(error "`tramp-file-name-structure' didn't match!")
- (let ((method (match-string (nth 1 (tramp-file-name-structure)) name))
- (user (match-string (nth 2 (tramp-file-name-structure)) name))
- (host (match-string (nth 3 (tramp-file-name-structure)) name))
- (localname (match-string (nth 4 (tramp-file-name-structure)) name))
- (hop (match-string (nth 5 (tramp-file-name-structure)) name))
+ (let ((method (match-string (nth 1 tramp-file-name-structure) name))
+ (user (match-string (nth 2 tramp-file-name-structure) name))
+ (host (match-string (nth 3 tramp-file-name-structure) name))
+ (localname (match-string (nth 4 tramp-file-name-structure) name))
+ (hop (match-string (nth 5 tramp-file-name-structure) name))
domain port)
(when user
(when (string-match tramp-user-with-domain-regexp user)
@@ -1291,9 +1378,9 @@ values."
(when (string-match tramp-host-with-port-regexp host)
(setq port (match-string 2 host)
host (match-string 1 host)))
- (when (string-match (tramp-prefix-ipv6-regexp) host)
+ (when (string-match tramp-prefix-ipv6-regexp host)
(setq host (replace-match "" nil t host)))
- (when (string-match (tramp-postfix-ipv6-regexp) host)
+ (when (string-match tramp-postfix-ipv6-regexp host)
(setq host (replace-match "" nil t host))))
(unless nodefault
@@ -1318,42 +1405,41 @@ values."
(method user domain host port localname &optional hop)
"Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
When not nil, optional DOMAIN, PORT and HOP are used."
- (concat (tramp-prefix-format) hop
+ (concat tramp-prefix-format hop
(unless (or (zerop (length method))
- (zerop (length (tramp-postfix-method-format))))
- (concat method (tramp-postfix-method-format)))
+ (zerop (length tramp-postfix-method-format)))
+ (concat method tramp-postfix-method-format))
user
(unless (zerop (length domain))
(concat tramp-prefix-domain-format domain))
(unless (zerop (length user))
- tramp-postfix-user-format)
+ tramp-postfix-user-format)
(when host
(if (string-match tramp-ipv6-regexp host)
- (concat
- (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format))
+ (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host))
(unless (zerop (length port))
(concat tramp-prefix-port-format port))
- (tramp-postfix-host-format)
+ tramp-postfix-host-format
(when localname localname)))
(defun tramp-completion-make-tramp-file-name (method user host localname)
"Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME.
It must not be a complete Tramp file name, but as long as there are
necessary only. This function will be used in file name completion."
- (concat (tramp-prefix-format)
+ (concat tramp-prefix-format
(unless (or (zerop (length method))
- (zerop (length (tramp-postfix-method-format))))
- (concat method (tramp-postfix-method-format)))
+ (zerop (length tramp-postfix-method-format)))
+ (concat method tramp-postfix-method-format))
(unless (zerop (length user))
(concat user tramp-postfix-user-format))
(unless (zerop (length host))
(concat
(if (string-match tramp-ipv6-regexp host)
(concat
- (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format))
+ tramp-prefix-ipv6-format host tramp-postfix-ipv6-format)
host)
- (tramp-postfix-host-format)))
+ tramp-postfix-host-format))
(when localname localname)))
(defun tramp-get-buffer (vec)
@@ -1597,6 +1683,12 @@ signal identifier to be raised, remaining arguments passed to
`tramp-message'. Finally, signal SIGNAL is raised."
(let (tramp-message-show-message)
(tramp-backtrace vec-or-proc)
+ (unless arguments
+ ;; FMT-STRING could be just a file name, as in
+ ;; `file-already-exists' errors. It could contain the ?\%
+ ;; character, as in smb domain spec.
+ (setq arguments (list fmt-string)
+ fmt-string "%s"))
(when vec-or-proc
(tramp-message
vec-or-proc 1 "%s"
@@ -1641,6 +1733,18 @@ an input event arrives. The other arguments are passed to `tramp-error'."
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
+(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body)
+ "Execute BODY while redirecting the error message to `tramp-message'.
+BODY is executed like wrapped by `with-demoted-errors'. FORMAT
+is a format-string containing a %-sequence meaning to substitute
+the resulting error message."
+ (declare (debug (symbolp body))
+ (indent 2))
+ (let ((err (make-symbol "err")))
+ `(condition-case-unless-debug ,err
+ (progn ,@body)
+ (error (tramp-message ,vec-or-proc 3 ,format ,err) nil))))
+
(defmacro with-parsed-tramp-file-name (filename var &rest body)
"Parse a Tramp filename and make components available in the body.
@@ -1649,20 +1753,20 @@ Second arg VAR is a symbol. It is used as a variable name to hold
the filename structure. It is also used as a prefix for the variables
holding the components. For example, if VAR is the symbol `foo', then
`foo' will be bound to the whole structure, `foo-method' will be bound to
-the method component, and so on for `foo-user', `foo-host', `foo-localname',
-`foo-hop'.
+the method component, and so on for `foo-user', `foo-domain', `foo-host',
+`foo-port', `foo-localname', `foo-hop'.
Remaining args are Lisp expressions to be evaluated (inside an implicit
`progn').
If VAR is nil, then we bind `v' to the structure and `method', `user',
-`host', `localname', `hop' to the components."
+`domain', `host', `port', `localname', `hop' to the components."
(let ((bindings
(mapcar (lambda (elem)
`(,(if var (intern (format "%s-%s" var elem)) elem)
(,(intern (format "tramp-file-name-%s" elem))
,(or var 'v))))
- '(method user domain host port localname hop))))
+ `,(tramp-compat-tramp-file-name-slots))))
`(let* ((,(or var 'v) (tramp-dissect-file-name ,filename))
,@bindings)
;; We don't know which of those vars will be used, so we bind them all,
@@ -1847,7 +1951,7 @@ special handling of `substitute-in-file-name'."
'tramp-rfn-eshadow-setup-minibuffer)))
(defun tramp-rfn-eshadow-update-overlay-regexp ()
- (format "[^%s/~]*\\(/\\|~\\)" (tramp-postfix-host-format)))
+ (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format))
(defun tramp-rfn-eshadow-update-overlay ()
"Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input.
@@ -1988,7 +2092,9 @@ ARGS are the arguments OPERATION has been called with."
substitute-in-file-name unhandled-file-name-directory
vc-registered
;; Emacs 26+ only.
- file-name-case-insensitive-p))
+ file-name-case-insensitive-p
+ ;; Emacs 27+ only.
+ file-system-info))
(if (file-name-absolute-p (nth 0 args))
(nth 0 args)
default-directory))
@@ -1997,6 +2103,11 @@ ARGS are the arguments OPERATION has been called with."
'(add-name-to-file copy-directory copy-file expand-file-name
file-equal-p file-in-directory-p
file-name-all-completions file-name-completion
+ ;; Starting with Emacs 26.1, just the 2nd argument of
+ ;; `make-symbolic-link' matters. For backward
+ ;; compatibility, we still accept the first argument as
+ ;; file name to be checked. Handled properly in
+ ;; `tramp-handle-*-make-symbolic-link'.
file-newer-than-file-p make-symbolic-link rename-file))
(save-match-data
(cond
@@ -2053,6 +2164,33 @@ ARGS are the arguments OPERATION has been called with."
`(let ((debug-on-error tramp-debug-on-error))
(condition-case-unless-debug ,var ,bodyform ,@handlers)))
+;; 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.
@@ -2090,7 +2228,18 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(setq result
(catch 'non-essential
(catch 'suppress
- (apply foreign operation args))))
+ (when (and tramp-locked (not tramp-locker))
+ (setq tramp-locked nil)
+ (tramp-error
+ (car-safe tramp-current-connection)
+ '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))))))
(cond
((eq result 'non-essential)
(tramp-message
@@ -2145,34 +2294,6 @@ Falls back to normal file name handler if no Tramp file name handler exists."
;; we don't do anything.
(tramp-run-real-handler operation args))))
-;; 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.")
-
-;;;###autoload
(defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists."
@@ -2184,8 +2305,10 @@ Falls back to normal file name handler if no Tramp file name handler exists."
;;;###autoload
(progn (defun tramp-autoload-file-name-handler (operation &rest args)
"Load Tramp file name handler, and perform OPERATION."
- (let ((default-directory temporary-file-directory))
- (load "tramp" 'noerror 'nomessage))
+ (if tramp-mode
+ (let ((default-directory temporary-file-directory))
+ (load "tramp" 'noerror 'nomessage))
+ (tramp-unload-file-name-handlers))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
@@ -2195,20 +2318,11 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(progn (defun tramp-register-autoload-file-name-handlers ()
"Add Tramp file name handlers to `file-name-handler-alist' during autoload."
(add-to-list 'file-name-handler-alist
- (cons tramp-initial-file-name-regexp
+ (cons tramp-autoload-file-name-regexp
'tramp-autoload-file-name-handler))
- (put 'tramp-autoload-file-name-handler 'safe-magic t)
+ (put 'tramp-autoload-file-name-handler 'safe-magic t)))
- (add-to-list 'file-name-handler-alist
- (cons tramp-initial-completion-file-name-regexp
- 'tramp-completion-file-name-handler))
- (put 'tramp-completion-file-name-handler 'safe-magic t)
- ;; Mark `operations' the handler is responsible for.
- (put 'tramp-completion-file-name-handler 'operations
- (mapcar 'car tramp-completion-file-name-handler-alist))))
-
-;;;###autoload
-(tramp-register-autoload-file-name-handlers)
+;;;###autoload (tramp-register-autoload-file-name-handlers)
(defun tramp-use-absolute-autoload-file-names ()
"Change Tramp autoload objects to use absolute file names.
@@ -2249,11 +2363,11 @@ remote file names."
;; property of `tramp-file-name-handler', this shall be done by the
;; respective foreign handlers.
(add-to-list 'file-name-handler-alist
- (cons (tramp-file-name-regexp) 'tramp-file-name-handler))
+ (cons tramp-file-name-regexp 'tramp-file-name-handler))
(put 'tramp-file-name-handler 'safe-magic t)
(add-to-list 'file-name-handler-alist
- (cons (tramp-completion-file-name-regexp)
+ (cons tramp-completion-file-name-regexp
'tramp-completion-file-name-handler))
(put 'tramp-completion-file-name-handler 'safe-magic t)
;; Mark `operations' the handler is responsible for.
@@ -2309,12 +2423,13 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
(equal (apply operation args) operation))))
;;;###autoload
-(defun tramp-unload-file-name-handlers ()
+(progn (defun tramp-unload-file-name-handlers ()
"Unload Tramp file name handlers from `file-name-handler-alist'."
(dolist (fnh '(tramp-file-name-handler
- tramp-completion-file-name-handler))
+ tramp-completion-file-name-handler
+ tramp-autoload-file-name-handler))
(let ((a1 (rassq fnh file-name-handler-alist)))
- (setq file-name-handler-alist (delq a1 file-name-handler-alist)))))
+ (setq file-name-handler-alist (delq a1 file-name-handler-alist))))))
(add-hook 'tramp-unload-hook 'tramp-unload-file-name-handlers)
@@ -2346,7 +2461,8 @@ not in completion mode."
;; Method, host name and user name completion.
;; `tramp-completion-dissect-file-name' returns a list of
-;; tramp-file-name structures. For all of them we return possible completions.
+;; `tramp-file-name' structures. For all of them we return possible
+;; completions.
(defun tramp-completion-handle-file-name-all-completions (filename directory)
"Like `file-name-all-completions' for partial Tramp files."
@@ -2357,8 +2473,8 @@ not in completion mode."
;; Suppress hop from completion.
(when (string-match
(concat
- (tramp-prefix-regexp)
- "\\(" "\\(" (tramp-remote-file-name-spec-regexp)
+ tramp-prefix-regexp
+ "\\(" "\\(" tramp-remote-file-name-spec-regexp
tramp-postfix-hop-regexp
"\\)+" "\\)")
fullname)
@@ -2403,9 +2519,8 @@ not in completion mode."
;; Unify list, add hop, remove nil elements.
(dolist (elt result)
(when elt
- (string-match (tramp-prefix-regexp) elt)
- (setq elt
- (replace-match (concat (tramp-prefix-format) hop) nil nil elt))
+ (string-match tramp-prefix-regexp elt)
+ (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt))
(push
(substring elt (length (tramp-drop-volume-letter directory)))
result1)))
@@ -2428,9 +2543,9 @@ not in completion mode."
(tramp-connectable-p (expand-file-name filename directory)))
(lambda (x) (funcall predicate (expand-file-name (car x) directory))))))
-;; I misuse a little bit the tramp-file-name structure in order to
+;; I misuse a little bit the `tramp-file-name' structure in order to
;; handle completion possibilities for partial methods / user names /
-;; host names. Return value is a list of tramp-file-name structures
+;; host names. Return value is a list of `tramp-file-name' structures
;; according to possible completions. If "localname" is non-nil it
;; means there shouldn't be a completion anymore.
@@ -2453,58 +2568,58 @@ They are collected by `tramp-completion-dissect-file-name1'."
(tramp-completion-ipv6-regexp
(format
"[^%s]*"
- (if (zerop (length (tramp-postfix-ipv6-format)))
- (tramp-postfix-host-format)
- (tramp-postfix-ipv6-format))))
+ (if (zerop (length tramp-postfix-ipv6-format))
+ tramp-postfix-host-format
+ tramp-postfix-ipv6-format)))
;; "/method" "/[method"
(tramp-completion-file-name-structure1
(list
(concat
- (tramp-prefix-regexp)
- "\\(" (tramp-method-regexp) x-nil "\\)$")
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp x-nil "\\)$")
1 nil nil nil))
;; "/method:user" "/[method/user"
(tramp-completion-file-name-structure2
(list
(concat
- (tramp-prefix-regexp)
- "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
- "\\(" tramp-user-regexp x-nil "\\)$")
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-user-regexp x-nil "\\)$")
1 2 nil nil))
;; "/method:host" "/[method/host"
(tramp-completion-file-name-structure3
(list
(concat
- (tramp-prefix-regexp)
- "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
- "\\(" tramp-host-regexp x-nil "\\)$")
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-host-regexp x-nil "\\)$")
1 nil 2 nil))
;; "/method:[ipv6" "/[method/ipv6"
(tramp-completion-file-name-structure4
(list
(concat
- (tramp-prefix-regexp)
- "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
- (tramp-prefix-ipv6-regexp)
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
1 nil 2 nil))
;; "/method:user@host" "/[method/user@host"
(tramp-completion-file-name-structure5
(list
(concat
- (tramp-prefix-regexp)
- "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- "\\(" tramp-host-regexp x-nil "\\)$")
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
+ "\\(" tramp-host-regexp x-nil "\\)$")
1 2 3 nil))
;; "/method:user@[ipv6" "/[method/user@ipv6"
(tramp-completion-file-name-structure6
(list
(concat
- (tramp-prefix-regexp)
- "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp)
- "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
- (tramp-prefix-ipv6-regexp)
+ tramp-prefix-regexp
+ "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp
+ "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp
+ tramp-prefix-ipv6-regexp
"\\(" tramp-completion-ipv6-regexp x-nil "\\)$")
1 2 3 nil)))
(delq
@@ -2790,18 +2905,44 @@ User is always nil."
(defvar tramp-handle-write-region-hook nil
"Normal hook to be run at the end of `tramp-*-handle-write-region'.")
+(defun tramp-handle-add-name-to-file
+ (filename newname &optional ok-if-already-exists)
+ "Like `add-name-to-file' for Tramp files."
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p newname) newname filename) nil
+ (unless (tramp-equal-remote filename newname)
+ (tramp-error
+ v 'file-error
+ "add-name-to-file: %s"
+ "only implemented for same method, same user, same host"))
+ ;; Do the 'confirm if exists' thing.
+ (when (file-exists-p newname)
+ ;; What to do?
+ (if (or (null ok-if-already-exists) ; not allowed to exist
+ (and (numberp ok-if-already-exists)
+ (not (yes-or-no-p
+ (format
+ "File %s already exists; make it a link anyway? "
+ localname)))))
+ (tramp-error v 'file-already-exists newname)
+ (delete-file newname)))
+ (tramp-flush-file-property v (file-name-directory localname))
+ (tramp-flush-file-property v localname)
+ (copy-file
+ filename newname 'ok-if-already-exists 'keep-time
+ 'preserve-uid-gid 'preserve-permissions)))
+
(defun tramp-handle-directory-file-name (directory)
"Like `directory-file-name' for Tramp files."
;; If localname component of filename is "/", leave it unchanged.
;; Otherwise, remove any trailing slash from localname component.
- ;; Method, host, etc, are unchanged. Does it make sense to try
- ;; to avoid parsing the filename?
- (with-parsed-tramp-file-name directory nil
- (if (and (not (zerop (length localname)))
- (eq (aref localname (1- (length localname))) ?/)
- (not (string= localname "/")))
- (substring directory 0 -1)
- directory)))
+ ;; Method, host, etc, are unchanged.
+ (while (with-parsed-tramp-file-name directory nil
+ (and (not (zerop (length localname)))
+ (eq (aref localname (1- (length localname))) ?/)
+ (not (string= localname "/"))))
+ (setq directory (substring directory 0 -1)))
+ directory)
(defun tramp-handle-directory-files (directory &optional full match nosort)
"Like `directory-files' for Tramp files."
@@ -3029,14 +3170,57 @@ User is always nil."
(t (tramp-make-tramp-file-name
method user domain host port "" hop)))))))))
+(defun tramp-handle-file-selinux-context (_filename)
+ "Like `file-selinux-context' for Tramp files."
+ ;; Return nil context.
+ '(nil nil nil nil))
+
(defun tramp-handle-file-symlink-p (filename)
"Like `file-symlink-p' for Tramp files."
- (with-parsed-tramp-file-name filename nil
- (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
- (when (stringp x)
- (if (file-name-absolute-p x)
- (tramp-make-tramp-file-name method user domain host port x)
- x)))))
+ (let ((x (tramp-compat-file-attribute-type (file-attributes filename))))
+ (and (stringp x) x)))
+
+(defun tramp-handle-file-truename (filename)
+ "Like `file-truename' for Tramp files."
+ (let ((result (expand-file-name filename))
+ (numchase 0)
+ ;; Don't make the following value larger than
+ ;; necessary. People expect an error message in a
+ ;; timely fashion when something is wrong;
+ ;; otherwise they might think that Emacs is hung.
+ ;; Of course, correctness has to come first.
+ (numchase-limit 20)
+ symlink-target)
+ (format
+ "%s%s"
+ (with-parsed-tramp-file-name result v1
+ (with-tramp-file-property v1 v1-localname "file-truename"
+ (while (and (setq symlink-target (file-symlink-p result))
+ (< numchase numchase-limit))
+ (setq numchase (1+ numchase)
+ result
+ (with-parsed-tramp-file-name (expand-file-name result) v2
+ (tramp-make-tramp-file-name
+ v2-method v2-user v2-domain v2-host v2-port
+ (funcall
+ (if (tramp-compat-file-name-quoted-p v2-localname)
+ 'tramp-compat-file-name-quote 'identity)
+
+ (if (stringp symlink-target)
+ (if (file-remote-p symlink-target)
+ (let (file-name-handler-alist)
+ (tramp-compat-file-name-quote symlink-target))
+ (expand-file-name
+ symlink-target (file-name-directory v2-localname)))
+ v2-localname)))))
+ (when (>= numchase numchase-limit)
+ (tramp-error
+ v1 'file-error
+ "Maximum number (%d) of symlinks exceeded" numchase-limit)))
+ result))
+
+ ;; Preserve trailing "/".
+ (if (string-equal (file-name-nondirectory filename) "") "/" ""))))
(defun tramp-handle-find-backup-file-name (filename)
"Like `find-backup-file-name' for Tramp files."
@@ -3049,9 +3233,9 @@ User is always nil."
(car x)
(if (and (stringp (cdr x))
(file-name-absolute-p (cdr x))
- (not (tramp-file-name-p (cdr x))))
+ (not (tramp-tramp-file-p (cdr x))))
(tramp-make-tramp-file-name
- method user domain host port (cdr x))
+ method user domain host port (cdr x) hop)
(cdr x))))
tramp-backup-directory-alist)
backup-directory-alist)))
@@ -3239,11 +3423,18 @@ User is always nil."
t)))
(defun tramp-handle-make-symbolic-link
- (filename linkname &optional _ok-if-already-exists)
- "Like `make-symbolic-link' for Tramp files."
- (with-parsed-tramp-file-name
- (if (tramp-tramp-file-p filename) filename linkname) nil
- (tramp-error v 'file-error "make-symbolic-link not supported")))
+ (target linkname &optional ok-if-already-exists)
+ "Like `make-symbolic-link' for Tramp files.
+This is the fallback implementation for backends which do not
+support symbolic links."
+ (if (tramp-tramp-file-p (expand-file-name linkname))
+ (tramp-error
+ (tramp-dissect-file-name (expand-file-name linkname)) 'file-error
+ "make-symbolic-link not supported")
+ ;; This is needed prior Emacs 26.1, where TARGET has also be
+ ;; checked for a file name handler.
+ (tramp-run-real-handler
+ 'make-symbolic-link (list target linkname ok-if-already-exists))))
(defun tramp-handle-shell-command
(command &optional output-buffer error-buffer)
@@ -3631,31 +3822,17 @@ connection buffer."
"Like `accept-process-output' for Tramp processes.
This is needed in order to hide `last-coding-system-used', which is set
for process communication also."
- ;; FIXME: There are problems, when an asynchronous process runs in
- ;; parallel, and also timers are active. See
- ;; <http://lists.gnu.org/archive/html/tramp-devel/2017-01/msg00010.html>.
- (when (and timer-event-last
- (string-prefix-p "*tramp/" (process-name proc))
- (let (result)
- (maphash
- (lambda (key _value)
- (and (processp key)
- (not (string-prefix-p "*tramp/" (process-name key)))
- (process-live-p key)
- (setq result t)))
- tramp-cache-data)
- result))
- (sit-for 0.01 'nodisp))
(with-current-buffer (process-buffer proc)
(let (buffer-read-only last-coding-system-used)
- ;; Under Windows XP, accept-process-output doesn't return
+ ;; Under Windows XP, `accept-process-output' doesn't return
;; sometimes. So we add an additional timeout. JUST-THIS-ONE
- ;; is set due to Bug#12145.
+ ;; is set due to Bug#12145. It is an integer, in order to avoid
+ ;; running timers as well.
(tramp-message
proc 10 "%s %s %s\n%s"
proc (process-status proc)
(with-timeout (timeout)
- (accept-process-output proc timeout nil t))
+ (accept-process-output proc timeout nil 0))
(buffer-string)))))
(defun tramp-check-for-regexp (proc regexp)
@@ -3687,7 +3864,7 @@ Erase echoed commands if exists."
(min (+ (point-min) tramp-echo-mark-marker-length)
(point-max))))))
;; No echo to be handled, now we can look for the regexp.
- ;; Sometimes, lines are much to long, and we run into a "Stack
+ ;; Sometimes, lines are much too long, and we run into a "Stack
;; overflow in regexp matcher". For example, //DIRED// lines of
;; directory listings with some thousand files. Therefore, we
;; look from the end.
@@ -4306,10 +4483,10 @@ Invokes `password-read' if available, `read-passwd' else."
(tramp-clear-passwd
(tramp-dissect-file-name
(concat
- (tramp-prefix-format)
+ tramp-prefix-format
(replace-regexp-in-string
(concat tramp-postfix-hop-regexp "$")
- (tramp-postfix-host-format) hop)))))
+ tramp-postfix-host-format hop)))))
(auth-source-forget
`(:max 1 ,(and user-domain :user) ,user-domain
:host ,host-port :port ,method))
@@ -4369,6 +4546,47 @@ Only works for Bourne-like shells."
t t result)))
result))))
+;;; Signal handling. This works for remote processes, which have set
+;;; the process property `remote-pid'.
+
+(defun tramp-interrupt-process (&optional process _current-group)
+ "Interrupt remote process PROC."
+ ;; CURRENT-GROUP is not implemented yet.
+ (let ((proc (cond
+ ((processp process) process)
+ ((bufferp process) (get-buffer-process process))
+ ((stringp process) (or (get-process process)
+ (get-buffer-process process)))
+ ((null process) (get-buffer-process (current-buffer)))
+ (t process)))
+ pid)
+ ;; If it's a Tramp process, send the INT signal remotely.
+ (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
+ (if (not (process-live-p proc))
+ (tramp-error proc 'error "Process %s is not active" proc)
+ (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
+ ;; This is for tramp-sh.el. Other backends do not support this (yet).
+ (tramp-compat-funcall
+ 'tramp-send-command
+ (tramp-get-connection-property proc "vector" nil)
+ (format "kill -2 %d" pid))
+ ;; Wait, until the process has disappeared.
+ (with-timeout
+ (1 (tramp-error proc 'error "Process %s did not interrupt" proc))
+ (while (process-live-p proc)
+ ;; We cannot run `tramp-accept-process-output', it blocks timers.
+ (accept-process-output proc 0.1)))
+ ;; Report success.
+ proc))))
+
+;; `interrupt-process-functions' exists since Emacs 26.1.
+(when (boundp 'interrupt-process-functions)
+ (add-hook 'interrupt-process-functions 'tramp-interrupt-process)
+ (add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (remove-hook 'interrupt-process-functions 'tramp-interrupt-process))))
+
;;; Integration of eshell.el:
;; eshell.el keeps the path in `eshell-path-env'. We must change it
@@ -4420,9 +4638,6 @@ Only works for Bourne-like shells."
(provide 'tramp)
;;; TODO:
-
-;; * In Emacs 21, `insert-directory' shows total number of bytes used
-;; by the files in that directory. Add this here.
;;
;; * Avoid screen blanking when hitting `g' in dired. (Eli Tziperman)
;;
@@ -4438,7 +4653,7 @@ Only works for Bourne-like shells."
;; are. (Andrea Crotti)
;;
;; * Run emerge on two remote files. Bug is described here:
-;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
+;; <https://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>.
;; (Bug#6850)
;;
;; * Refactor code from different handlers. Start with
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 387a3c8bb36..51af455e635 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.3.2-pre
+;; Version: 2.3.3-pre
;; This file is part of GNU Emacs.
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -33,7 +33,7 @@
;; should be changed only there.
;;;###tramp-autoload
-(defconst tramp-version "2.3.2-pre"
+(defconst tramp-version "2.3.3-pre"
"This version of Tramp.")
;;;###tramp-autoload
@@ -55,7 +55,7 @@
;; Check for Emacs version.
(let ((x (if (>= emacs-major-version 24)
"ok"
- (format "Tramp 2.3.2-pre is not fit for %s"
+ (format "Tramp 2.3.3-pre is not fit for %s"
(when (string-match "^.*$" (emacs-version))
(match-string 0 (emacs-version)))))))
(unless (string-match "\\`ok\\'" x) (error "%s" x)))
@@ -68,7 +68,9 @@
("2.1.20" . "23.3") ("2.1.21-pre" . "23.4")
("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3")
("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5")
- ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2")))
+ ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2")
+ ("2.2.13.25.2" . "25.3")
+ ("2.3.3.26.1" . "26.1")))
(add-hook 'tramp-unload-hook
(lambda ()
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index f6e0cf87b9c..79a06021e1e 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -76,9 +76,9 @@
'(
;; FSF, not including Emacs-specific.
("GNU Project FTP Archive" .
- ;; GNU FTP Mirror List from http://www.gnu.org/order/ftp.html
- [mirrors "ftp://ftp.gnu.org/pub/gnu/"
- "http://ftpmirror.gnu.org"])
+ ;; GNU FTP Mirror List from https://www.gnu.org/order/ftp.html
+ [mirrors "https://ftp.gnu.org/pub/gnu/"
+ "https://ftpmirror.gnu.org"])
("GNU Project Home Page" . "www.gnu.org")
;; Emacs.
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index 393f3a549f9..7ad9c9f5c9b 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 4b261c34c65..56ae14dee41 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -69,6 +69,9 @@
;;; Code:
+(eval-when-compile
+ (require 'subr-x))
+
;;;###autoload
(defalias 'indent-for-comment 'comment-indent)
;;;###autoload
@@ -142,9 +145,10 @@ Should be an empty string if comments are terminated by end-of-line.")
;;;###autoload
(defvar comment-indent-function 'comment-indent-default
"Function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter and should return either the desired
-column indentation or nil.
+This function is called with no args with point at the beginning
+of the comment's starting delimiter and should return either the
+desired column indentation, a range of acceptable
+indentation (MIN . MAX), or nil.
If nil is returned, indentation is delegated to `indent-according-to-mode'.")
;;;###autoload
@@ -523,7 +527,7 @@ Ensure that `comment-normalize-vars' has been called before you use this."
;; comment-search-backward is only used to find the comment-column (in
;; comment-set-column) and to find the comment-start string (via
;; comment-beginning) in indent-new-comment-line, it should be harmless.
- (if (not (re-search-backward comment-start-skip limit t))
+ (if (not (re-search-backward comment-start-skip limit 'move))
(unless noerror (error "No comment"))
(beginning-of-line)
(let* ((end (match-end 0))
@@ -649,13 +653,20 @@ The criteria are (in this order):
- prefer INDENT (or `comment-column' if nil).
Point is expected to be at the start of the comment."
(unless indent (setq indent comment-column))
- ;; Avoid moving comments past the fill-column.
- (let ((max (+ (current-column)
- (- (or comment-fill-column fill-column)
- (save-excursion (end-of-line) (current-column)))))
- (other nil)
- (min (save-excursion (skip-chars-backward " \t")
- (if (bolp) 0 (+ comment-inline-offset (current-column))))))
+ (let ((other nil)
+ min max)
+ (pcase indent
+ (`(,lo . ,hi) (setq min lo) (setq max hi)
+ (setq indent comment-column))
+ (_ ;; Avoid moving comments past the fill-column.
+ (setq max (+ (current-column)
+ (- (or comment-fill-column fill-column)
+ (save-excursion (end-of-line) (current-column)))))
+ (setq min (save-excursion
+ (skip-chars-backward " \t")
+ ;; Leave at least `comment-inline-offset' space after
+ ;; other nonwhite text on the line.
+ (if (bolp) 0 (+ comment-inline-offset (current-column)))))))
;; Fix up the range.
(if (< max min) (setq max min))
;; Don't move past the fill column.
@@ -750,13 +761,6 @@ If CONTINUE is non-nil, use the `comment-continue' markers if any."
;; If the comment is at the right of code, adjust the indentation.
(unless (save-excursion (skip-chars-backward " \t") (bolp))
(setq indent (comment-choose-indent indent)))
- ;; Update INDENT to leave at least one space
- ;; after other nonwhite text on the line.
- (save-excursion
- (skip-chars-backward " \t")
- (unless (bolp)
- (setq indent (max indent
- (+ (current-column) comment-inline-offset)))))
;; If that's different from comment's current position, change it.
(unless (= (current-column) indent)
(delete-region (point) (progn (skip-chars-backward " \t") (point)))
@@ -815,7 +819,7 @@ N defaults to 0.
If N is `re', a regexp is returned instead, that would match
the string for any N."
(setq n (or n 0))
- (when (and (stringp str) (not (string= "" str)))
+ (when (and (stringp str) (string-match "\\S-" str))
;; Separate the actual string from any leading/trailing padding
(string-match "\\`\\s-*\\(.*?\\)\\s-*\\'" str)
(let ((s (match-string 1 str)) ;actual string
@@ -1140,6 +1144,9 @@ the region rather than at left margin."
;; make the leading and trailing lines if requested
(when lines
+ ;; Trim trailing whitespace from cs if there's some.
+ (setq cs (string-trim-right cs))
+
(let ((csce
(comment-make-extra-lines
cs ce ccs cce min-indent max-indent block)))
@@ -1210,7 +1217,7 @@ changed with `comment-style'."
(progn (goto-char end) (end-of-line) (skip-syntax-backward " ")
(<= (point) end))
(or block (not (string= "" comment-end)))
- (or block (progn (goto-char beg) (search-forward "\n" end t)))))
+ (or block (progn (goto-char beg) (re-search-forward "$" end t)))))
;; don't add end-markers just because the user asked for `block'
(unless (or lines (string= "" comment-end)) (setq block nil))
diff --git a/lisp/notifications.el b/lisp/notifications.el
index 194b0894a9b..9290f71d4ee 100644
--- a/lisp/notifications.el
+++ b/lisp/notifications.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/novice.el b/lisp/novice.el
index a5ad2a0c565..72c16af5feb 100644
--- a/lisp/novice.el
+++ b/lisp/novice.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el
index b359076ef4d..1a82b917754 100644
--- a/lisp/nxml/nxml-enc.el
+++ b/lisp/nxml/nxml-enc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -91,7 +91,7 @@
;; no-conversion gives the user a chance to fix it.
'no-conversion)
;; There are other things we might try here in the future
- ;; eg UTF-8 BOM, UTF-16 with no BOM
+ ;; eg UTF-8 BOM, UTF-16 with no BOM
;; translate to EBCDIC
(t
(let ((enc-pos (xmltok-get-declared-encoding-position limit)))
diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el
index 55abca18e05..9ba2b3287df 100644
--- a/lisp/nxml/nxml-maint.el
+++ b/lisp/nxml/nxml-maint.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index 7e33e743de0..3f4dce261d9 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el
index a9388d98824..c4845a67f81 100644
--- a/lisp/nxml/nxml-ns.el
+++ b/lisp/nxml/nxml-ns.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el
index 2c414e489da..5a2ecae220e 100644
--- a/lisp/nxml/nxml-outln.el
+++ b/lisp/nxml/nxml-outln.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el
index bce8cc9ee0b..6c00dc7375e 100644
--- a/lisp/nxml/nxml-parse.el
+++ b/lisp/nxml/nxml-parse.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el
index 0132a2b9234..daec948f1c8 100644
--- a/lisp/nxml/nxml-rap.el
+++ b/lisp/nxml/nxml-rap.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 9f085458d88..dcb3ef4bf60 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index a09c77c51ae..b35774f4710 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el
index 6e60609445e..b62ba57dc27 100644
--- a/lisp/nxml/rng-dt.el
+++ b/lisp/nxml/rng-dt.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el
index 359a7178684..891f1019089 100644
--- a/lisp/nxml/rng-loc.el
+++ b/lisp/nxml/rng-loc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el
index 8378b1d6491..8d85f2ea06b 100644
--- a/lisp/nxml/rng-maint.el
+++ b/lisp/nxml/rng-maint.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -226,11 +226,10 @@
(defun rng-time-function (function &rest args)
(let* ((start (current-time))
- (val (apply function args))
- (end (current-time)))
+ (val (apply function args)))
(message "%s ran in %g seconds"
function
- (float-time (time-subtract end start)))
+ (float-time (time-subtract nil start)))
val))
(defun rng-time-tokenize-buffer ()
diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el
index e3401741fbf..075695bd5cb 100644
--- a/lisp/nxml/rng-match.el
+++ b/lisp/nxml/rng-match.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index caa3d63e390..e878cfefaa0 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el
index f3afbdd07de..9796c8a70c8 100644
--- a/lisp/nxml/rng-parse.el
+++ b/lisp/nxml/rng-parse.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el
index 29b55816a79..6975f3c1b78 100644
--- a/lisp/nxml/rng-pttrn.el
+++ b/lisp/nxml/rng-pttrn.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 6b3190a1b09..4bd619eb6d4 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el
index a804771e33a..f49a6814cd3 100644
--- a/lisp/nxml/rng-util.el
+++ b/lisp/nxml/rng-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index 6837424857c..a96aedfdc4c 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el
index 51a05f8cad5..79039abf183 100644
--- a/lisp/nxml/rng-xsd.el
+++ b/lisp/nxml/rng-xsd.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el
index 69dc541bc51..5d31392aa99 100644
--- a/lisp/nxml/xmltok.el
+++ b/lisp/nxml/xmltok.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el
index d56960c9fa9..e22d6f75421 100644
--- a/lisp/nxml/xsd-regexp.el
+++ b/lisp/nxml/xsd-regexp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obarray.el b/lisp/obarray.el
index b1160ebea43..0915e22a72c 100644
--- a/lisp/obarray.el
+++ b/lisp/obarray.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el
index ebef215fcc0..34393b3d797 100644
--- a/lisp/obsolete/abbrevlist.el
+++ b/lisp/obsolete/abbrevlist.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/assoc.el b/lisp/obsolete/assoc.el
index eab8d13a81e..6313006f7d1 100644
--- a/lisp/obsolete/assoc.el
+++ b/lisp/obsolete/assoc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el
index 6af597d9fe5..99f33b0d126 100644
--- a/lisp/obsolete/bruce.el
+++ b/lisp/obsolete/bruce.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -39,7 +39,7 @@
;; reading your meeting schedule notices or other email boring to everyone
;; but you and (you hope) the recipient. See below (I left in the original
;; writeup when I made this conversion), or the emacs documentation at
-;; ftp://prep.ai.mit.edu/pub/gnu/emacs-manual*.
+;; https://www.gnu.org/software/emacs/manual/.
;; Bruce is a direct copy of spook, with the word "spook" replaced with
;; the word "bruce". Thanks to "esr", whoever he, she or it may be, this
diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el
index c9fdf739f1d..6d05eec8e4e 100644
--- a/lisp/obsolete/cc-compat.el
+++ b/lisp/obsolete/cc-compat.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -106,7 +106,7 @@ This is in addition to c-continued-statement-offset.")
(if (eq (char-before) ?{)
(forward-char -1)
(goto-char (cdr langelem)))
- (let* ((curcol (save-excursion
+ (let* ((curcol (save-excursion
(goto-char (cdr langelem))
(current-column)))
(bocm-lossage
@@ -138,7 +138,7 @@ This is in addition to c-continued-statement-offset.")
(defun cc-block-close-offset (langelem)
(save-excursion
(let* ((here (point))
- bracep
+ bracep
(curcol (progn
(goto-char (cdr langelem))
(current-column)))
@@ -154,7 +154,7 @@ This is in addition to c-continued-statement-offset.")
(current-column))))
(- bocm-lossage curcol
(if bracep 0 c-indent-level)))))
-
+
(defun cc-substatement-open-offset (langelem)
(+ c-continued-statement-offset c-continued-brace-offset))
diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el
index 930b59e89d3..d021c68571e 100644
--- a/lisp/obsolete/cl-compat.el
+++ b/lisp/obsolete/cl-compat.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el
index 6a7fdc59c22..1f154a4d2e9 100644
--- a/lisp/obsolete/complete.el
+++ b/lisp/obsolete/complete.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -924,7 +924,7 @@ or properties are considered."
(or (boundp sym) (fboundp sym)
(symbol-plist sym))))))
(PC-not-minibuffer t))
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-03/msg01211.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-03/msg01211.html
;;
;; This deals with cases like running PC-l-c-s on "M-: (n-f".
;; The first call to PC-l-c-s expands this to "(ne-f", and moves
diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el
index aa13be1bc6d..85fd4dcdaf3 100644
--- a/lisp/obsolete/crisp.el
+++ b/lisp/obsolete/crisp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el
index b9aef43e0ba..8c12306112e 100644
--- a/lisp/obsolete/cust-print.el
+++ b/lisp/obsolete/cust-print.el
@@ -24,7 +24,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el
index 4b0b8efa6a3..b1201eb9a9a 100644
--- a/lisp/obsolete/erc-hecomplete.el
+++ b/lisp/obsolete/erc-hecomplete.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -219,4 +219,3 @@ Window configurations are stored in
;; indent-tabs-mode: t
;; tab-width: 8
;; End:
-
diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el
index 06d6f52f5b4..28b9be0ffac 100644
--- a/lisp/obsolete/eudcb-ph.el
+++ b/lisp/obsolete/eudcb-ph.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el
index d1e2c24febc..ebcdd235cf4 100644
--- a/lisp/obsolete/fast-lock.el
+++ b/lisp/obsolete/fast-lock.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el
index 5bc77d8c349..c821ebf79f8 100644
--- a/lisp/obsolete/gs.el
+++ b/lisp/obsolete/gs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/gulp.el b/lisp/obsolete/gulp.el
index 11a7e02ab96..5aa4fb4e1da 100644
--- a/lisp/obsolete/gulp.el
+++ b/lisp/obsolete/gulp.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/net/html2text.el b/lisp/obsolete/html2text.el
index 87c71dc504a..d1dc876f289 100644
--- a/lisp/net/html2text.el
+++ b/lisp/obsolete/html2text.el
@@ -3,6 +3,7 @@
;; Copyright (C) 2002-2017 Free Software Foundation, Inc.
;; Author: Joakim Hove <hove@phys.ntnu.no>
+;; Obsolete-since: 26.1
;; This file is part of GNU Emacs.
@@ -17,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,14 +30,14 @@
;;
;; The main function is `html2text'.
+;; This package was obsoleted by shr.el.
+
;;; Code:
;;
;; <Global variables>
;;
-(eval-when-compile
- (require 'cl))
(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
@@ -297,7 +298,7 @@ formatting, and then moved afterward.")
(defun html2text-clean-blockquote (p1 p2 p3 p4)
(html2text-delete-tags p1 p2 p3 p4))
-(defun html2text-clean-anchor (p1 p2 p3 p4)
+(defun html2text-clean-anchor (p1 p2 _p3 p4)
;; If someone can explain how to make the URL clickable I will surely
;; improve upon this.
;; Maybe `goto-addr.el' can be used here.
diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el
index 71cc917938d..59c2ee7eb00 100644
--- a/lisp/obsolete/iswitchb.el
+++ b/lisp/obsolete/iswitchb.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el
index b6bbca44801..7795279bf42 100644
--- a/lisp/obsolete/landmark.el
+++ b/lisp/obsolete/landmark.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -260,7 +260,7 @@ is non-nil. One interesting value is `turn-on-font-lock'."
"Vector recording the actual score of the free squares.")
-;; The key point point about the algorithm is that, rather than considering
+;; The key point about the algorithm is that, rather than considering
;; the board as just a set of squares, we prefer to see it as a "space" of
;; internested 5-tuples of contiguous squares (called qtuples).
;;
diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el
index 5fa8fa48fa8..64304391bb8 100644
--- a/lisp/obsolete/lazy-lock.el
+++ b/lisp/obsolete/lazy-lock.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el
index 3dde96c3bb7..9cf6f7629f4 100644
--- a/lisp/obsolete/ledit.el
+++ b/lisp/obsolete/ledit.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
index e445b1ac553..b9b153553d7 100644
--- a/lisp/obsolete/levents.el
+++ b/lisp/obsolete/levents.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -113,7 +113,7 @@ In actual Lucid Emacs, you MUST NOT use this event object after
calling this function with it. You will lose. It is not necessary to
call this function, as event objects are garbage- collected like all
other objects; however, it may be more efficient to explicitly
-deallocate events when you are sure that that is safe.
+deallocate events when you are sure that this is safe.
This emulation does not actually deallocate or reuse events
except via garbage collection and `cons'."
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el
index a790d211485..44ef617031b 100644
--- a/lisp/obsolete/lmenu.el
+++ b/lisp/obsolete/lmenu.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el
index a6c6a0c9fcf..b45b4a4af9a 100644
--- a/lisp/obsolete/longlines.el
+++ b/lisp/obsolete/longlines.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el
index bf8347bf9e6..562c60aee2d 100644
--- a/lisp/obsolete/lucid.el
+++ b/lisp/obsolete/lucid.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el
index 46adf836005..6dc4df0cc88 100644
--- a/lisp/obsolete/messcompat.el
+++ b/lisp/obsolete/messcompat.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el
index 3e673725aea..aee1ef8e82b 100644
--- a/lisp/obsolete/mouse-sel.el
+++ b/lisp/obsolete/mouse-sel.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el
index 233c105dc0d..61986fe1fce 100644
--- a/lisp/obsolete/old-emacs-lock.el
+++ b/lisp/obsolete/old-emacs-lock.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
index defd18b35aa..0b96c52a741 100644
--- a/lisp/obsolete/old-whitespace.el
+++ b/lisp/obsolete/old-whitespace.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el
index 2a61dc01ca3..ae1ad3b9ab6 100644
--- a/lisp/obsolete/options.el
+++ b/lisp/obsolete/options.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el
index 5784601674c..dd25e336f0a 100644
--- a/lisp/obsolete/otodo-mode.el
+++ b/lisp/obsolete/otodo-mode.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; ---------------------------------------------------------------------------
@@ -164,7 +164,7 @@
;; might be nicer and to that effect a function has been declared
;; further down in the code. You may wish to auto-load this.
;;
-;; Carsten also writes that that *changing* the prefix after the
+;; Carsten also writes that *changing* the prefix after the
;; todo list is already established is not as simple as changing
;; the variable - the todo files have to be changed by hand.
;;
diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el
index c1b7ff92c70..fe282ffee56 100644
--- a/lisp/obsolete/pc-mode.el
+++ b/lisp/obsolete/pc-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el
index 59da29391d7..5353859a627 100644
--- a/lisp/obsolete/pc-select.el
+++ b/lisp/obsolete/pc-select.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el
index 8d59c688b9d..25827269b28 100644
--- a/lisp/obsolete/pgg-def.el
+++ b/lisp/obsolete/pgg-def.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el
index 189b119bfae..1c08755bff6 100644
--- a/lisp/obsolete/pgg-gpg.el
+++ b/lisp/obsolete/pgg-gpg.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el
index b44117773d9..019d53d660d 100644
--- a/lisp/obsolete/pgg-parse.el
+++ b/lisp/obsolete/pgg-parse.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el
index 507fbbb9136..cac5240a1bb 100644
--- a/lisp/obsolete/pgg-pgp.el
+++ b/lisp/obsolete/pgg-pgp.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el
index 8fd976fc23f..1504283b692 100644
--- a/lisp/obsolete/pgg-pgp5.el
+++ b/lisp/obsolete/pgg-pgp5.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el
index f99d759ec45..d84dc92e53b 100644
--- a/lisp/obsolete/pgg.el
+++ b/lisp/obsolete/pgg.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el
index dd2506841fd..1ad4f5a07f3 100644
--- a/lisp/obsolete/rcompile.el
+++ b/lisp/obsolete/rcompile.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el
index 8a85f3c7961..9898f5f47a8 100644
--- a/lisp/obsolete/s-region.el
+++ b/lisp/obsolete/s-region.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el
index f57befa5043..9790e7ffbcc 100644
--- a/lisp/obsolete/sregex.el
+++ b/lisp/obsolete/sregex.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el
index 4aabe41951d..28822e1fbcd 100644
--- a/lisp/obsolete/sup-mouse.el
+++ b/lisp/obsolete/sup-mouse.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el
index e5d85e69a3b..4e5f3694031 100644
--- a/lisp/obsolete/terminal.el
+++ b/lisp/obsolete/terminal.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
index ee1c2771640..cebb426a2db 100644
--- a/lisp/obsolete/tpu-edt.el
+++ b/lisp/obsolete/tpu-edt.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey.
diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el
index 06291ce5734..56ccbf09a8a 100644
--- a/lisp/obsolete/tpu-extras.el
+++ b/lisp/obsolete/tpu-extras.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
index bb7e28b03c4..c44eba213d1 100644
--- a/lisp/obsolete/tpu-mapper.el
+++ b/lisp/obsolete/tpu-mapper.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el
index 92eaa62be85..d153f9add12 100644
--- a/lisp/obsolete/vc-arch.el
+++ b/lisp/obsolete/vc-arch.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
index 4d70d6a5dfc..c6a5d236b04 100644
--- a/lisp/obsolete/vip.el
+++ b/lisp/obsolete/vip.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el
index 62cccf725af..c276cfcc4a7 100644
--- a/lisp/obsolete/ws-mode.el
+++ b/lisp/obsolete/ws-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/xesam.el b/lisp/obsolete/xesam.el
index c553d0023b5..62844b94cbe 100644
--- a/lisp/obsolete/xesam.el
+++ b/lisp/obsolete/xesam.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el
index 55f19a80e5f..df8302e19ff 100644
--- a/lisp/obsolete/yow.el
+++ b/lisp/obsolete/yow.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 366a3ee9fcd..b7cfd1e4aa1 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -5015,10 +5015,10 @@
* ox-latex.el (org-latex-listings): Update docstring.
* org-pcomplete.el (pcomplete/org-mode/file-option/options):
- Apply changes to export back-end definiton.
+ Apply changes to export back-end definition.
* org.el (org-get-export-keywords): Apply changes to export
- back-end definiton.
+ back-end definition.
* ox-html.el (org-html--format-toc-headline): Make use of
anonymous back-ends.
@@ -11560,7 +11560,7 @@
break after the last footnote definition. This is an an implicit
assumption made by the org-lparse.el library. With this change,
footnote definitions can reliably be exported with ODT backend.
- See http://lists.gnu.org/archive/html/emacs-orgmode/2012-02/msg01013.html.
+ See https://lists.gnu.org/r/emacs-orgmode/2012-02/msg01013.html.
2012-04-01 Eric Schulte <eric.schulte@gmx.com>
@@ -13952,7 +13952,7 @@
* org.el (org-mode): Force left-to-right paragraphs in Org
buffers. For a related discussions, see
- https://lists.gnu.org/archive/html/emacs-devel/2011-09/msg00349.html.
+ https://lists.gnu.org/r/emacs-devel/2011-09/msg00349.html.
2012-01-03 Nicolas Goaziou <n.goaziou@gmail.com>
@@ -14933,7 +14933,7 @@
* org.el (org-mode): Force left-to-right paragraphs in Org
buffers. For a related discussions, see
- https://lists.gnu.org/archive/html/emacs-devel/2011-09/msg00349.html.
+ https://lists.gnu.org/r/emacs-devel/2011-09/msg00349.html.
2011-09-17 Juanma Barranquero <lekktu@gmail.com>
@@ -32848,4 +32848,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el
index 77cfd537857..78528a882bc 100644
--- a/lisp/org/ob-C.el
+++ b/lisp/org/ob-C.el
@@ -1,8 +1,9 @@
-;;; ob-C.el --- org-babel functions for C and similar languages
+;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
;; Author: Eric Schulte
+;; Thierry Banel
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -19,41 +20,74 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; Org-Babel support for evaluating C code.
+;; Org-Babel support for evaluating C, C++, D code.
;;
;; very limited implementation:
;; - currently only support :results output
;; - not much in the way of error feedback
;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'ob)
+
(require 'cc-mode)
+(require 'ob)
-(declare-function org-entry-get "org"
- (pom property &optional inherit literal-nil))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp"))
+(add-to-list 'org-babel-tangle-lang-exts '("D" . "d"))
(defvar org-babel-default-header-args:C '())
-(defvar org-babel-C-compiler "gcc"
- "Command used to compile a C source code file into an
-executable.")
-
-(defvar org-babel-C++-compiler "g++"
- "Command used to compile a C++ source code file into an
-executable.")
+(defconst org-babel-header-args:C '((includes . :any)
+ (defines . :any)
+ (main . :any)
+ (flags . :any)
+ (cmdline . :any)
+ (libs . :any))
+ "C/C++-specific header arguments.")
+
+(defconst org-babel-header-args:C++
+ (append '((namespaces . :any))
+ org-babel-header-args:C)
+ "C++-specific header arguments.")
+
+(defcustom org-babel-C-compiler "gcc"
+ "Command used to compile a C source code file into an executable.
+May be either a command in the path, like gcc
+or an absolute path name, like /usr/local/bin/gcc
+parameter may be used, like gcc -v"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-babel-C++-compiler "g++"
+ "Command used to compile a C++ source code file into an executable.
+May be either a command in the path, like g++
+or an absolute path name, like /usr/local/bin/g++
+parameter may be used, like g++ -v"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-babel-D-compiler "rdmd"
+ "Command used to compile and execute a D source code file.
+May be either a command in the path, like rdmd
+or an absolute path name, like /usr/local/bin/rdmd
+parameter may be used, like rdmd --chatty"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
(defvar org-babel-c-variant nil
- "Internal variable used to hold which type of C (e.g. C or C++)
+ "Internal variable used to hold which type of C (e.g. C or C++ or D)
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
@@ -61,88 +95,197 @@ is currently being evaluated.")
This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
+(defun org-babel-expand-body:cpp (body params)
+ "Expand a block of C++ code with org-babel according to its
+header arguments."
+ (org-babel-expand-body:C++ body params))
+
(defun org-babel-execute:C++ (body params)
"Execute a block of C++ code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C++ (body params)
- "Expand a block of C++ code with org-babel according to it's
-header arguments (calls `org-babel-C-expand')."
- (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
+ "Expand a block of C++ code with org-babel according to its
+header arguments."
+ (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params)))
+
+(defun org-babel-execute:D (body params)
+ "Execute a block of D code with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params)))
+
+(defun org-babel-expand-body:D (body params)
+ "Expand a block of D code with org-babel according to its
+header arguments."
+ (let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params)))
(defun org-babel-execute:C (body params)
"Execute a block of C code with org-babel.
This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
-(defun org-babel-expand-body:c (body params)
- "Expand a block of C code with org-babel according to it's
-header arguments (calls `org-babel-C-expand')."
- (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params)))
+(defun org-babel-expand-body:C (body params)
+ "Expand a block of C code with org-babel according to its
+header arguments."
+ (let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params)))
(defun org-babel-C-execute (body params)
"This function should only be called by `org-babel-execute:C'
-or `org-babel-execute:C++'."
+or `org-babel-execute:C++' or `org-babel-execute:D'."
(let* ((tmp-src-file (org-babel-temp-file
"C-src-"
- (cond
- ((equal org-babel-c-variant 'c) ".c")
- ((equal org-babel-c-variant 'cpp) ".cpp"))))
- (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext))
- (cmdline (cdr (assoc :cmdline params)))
- (flags (cdr (assoc :flags params)))
- (full-body (org-babel-C-expand body params))
- (compile
- (progn
- (with-temp-file tmp-src-file (insert full-body))
- (org-babel-eval
- (format "%s -o %s %s %s"
- (cond
- ((equal org-babel-c-variant 'c) org-babel-C-compiler)
- ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler))
- (org-babel-process-file-name tmp-bin-file)
- (mapconcat 'identity
- (if (listp flags) flags (list flags)) " ")
- (org-babel-process-file-name tmp-src-file)) ""))))
+ (pcase org-babel-c-variant
+ (`c ".c") (`cpp ".cpp") (`d ".d"))))
+ (tmp-bin-file ;not used for D
+ (org-babel-process-file-name
+ (org-babel-temp-file "C-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))
+ " "))
+ (full-body
+ (pcase org-babel-c-variant
+ (`c (org-babel-C-expand-C body params))
+ (`cpp (org-babel-C-expand-C++ body params))
+ (`d (org-babel-C-expand-D body params)))))
+ (with-temp-file tmp-src-file (insert full-body))
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
+ (org-babel-eval
+ (format "%s -o %s %s %s %s"
+ (pcase org-babel-c-variant
+ (`c org-babel-C-compiler)
+ (`cpp org-babel-C++-compiler))
+ tmp-bin-file
+ flags
+ (org-babel-process-file-name tmp-src-file)
+ libs)
+ ""))
+ (`d nil)) ;; no separate compilation for D
(let ((results
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
- (org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
- (org-babel-read results)
- (let ((tmp-file (org-babel-temp-file "c-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))
- ))
-
-(defun org-babel-C-expand (body params)
+ (org-babel-eval
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
+ (concat tmp-bin-file cmdline))
+ (`d
+ (format "%s %s %s %s"
+ org-babel-D-compiler
+ flags
+ (org-babel-process-file-name tmp-src-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 "c-")))
+ (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-C-expand-C++ (body params)
"Expand a block of C or C++ code with org-babel according to
-it's header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (main-p (not (string= (cdr (assoc :main params)) "no")))
- (includes (or (cdr (assoc :includes params))
- (org-babel-read (org-entry-get nil "includes" t))))
- (defines (org-babel-read
- (or (cdr (assoc :defines params))
- (org-babel-read (org-entry-get nil "defines" t))))))
+its header arguments."
+ (org-babel-C-expand-C body params))
+
+(defun org-babel-C-expand-C (body params)
+ "Expand a block of C or C++ code with org-babel according to
+its header arguments."
+ (let ((vars (org-babel--get-vars params))
+ (colnames (cdr (assq :colname-names params)))
+ (main-p (not (string= (cdr (assq :main params)) "no")))
+ (includes (org-babel-read
+ (cdr (assq :includes params))
+ nil))
+ (defines (org-babel-read
+ (cdr (assq :defines params))
+ nil))
+ (namespaces (org-babel-read
+ (cdr (assq :namespaces params))
+ nil)))
+ (when (stringp includes)
+ (setq includes (split-string includes)))
+ (when (stringp namespaces)
+ (setq namespaces (split-string namespaces)))
+ (when (stringp defines)
+ (let ((y nil)
+ (result (list t)))
+ (dolist (x (split-string defines))
+ (if (null y)
+ (setq y x)
+ (nconc result (list (concat y " " x)))
+ (setq y nil)))
+ (setq defines (cdr result))))
(mapconcat 'identity
(list
;; includes
(mapconcat
(lambda (inc) (format "#include %s" inc))
- (if (listp includes) includes (list includes)) "\n")
+ includes "\n")
;; defines
(mapconcat
(lambda (inc) (format "#define %s" inc))
(if (listp defines) defines (list defines)) "\n")
+ ;; namespaces
+ (mapconcat
+ (lambda (inc) (format "using namespace %s;" inc))
+ namespaces
+ "\n")
;; variables
(mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; table sizes
+ (mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
+ ;; tables headers utility
+ (when colnames
+ (org-babel-C-utility-header-to-C))
+ ;; tables headers
+ (mapconcat 'org-babel-C-header-to-C colnames "\n")
+ ;; body
+ (if main-p
+ (org-babel-C-ensure-main-wrap body)
+ body) "\n") "\n")))
+
+(defun org-babel-C-expand-D (body params)
+ "Expand a block of D code with org-babel according to
+its header arguments."
+ (let ((vars (org-babel--get-vars params))
+ (colnames (cdr (assq :colname-names params)))
+ (main-p (not (string= (cdr (assq :main params)) "no")))
+ (imports (or (cdr (assq :imports params))
+ (org-babel-read (org-entry-get nil "imports" t)))))
+ (when (stringp imports)
+ (setq imports (split-string imports)))
+ (setq imports (append imports '("std.stdio" "std.conv")))
+ (mapconcat 'identity
+ (list
+ "module mmm;"
+ ;; imports
+ (mapconcat
+ (lambda (inc) (format "import %s;" inc))
+ imports "\n")
+ ;; variables
+ (mapconcat 'org-babel-C-var-to-C vars "\n")
+ ;; table sizes
+ (mapconcat 'org-babel-C-table-sizes-to-C vars "\n")
+ ;; tables headers utility
+ (when colnames
+ (org-babel-C-utility-header-to-C))
+ ;; tables headers
+ (mapconcat 'org-babel-C-header-to-C colnames "\n")
;; body
(if main-p
(org-babel-C-ensure-main-wrap body)
@@ -154,12 +297,12 @@ it's header arguments."
body
(format "int main() {\n%s\nreturn 0;\n}\n" body)))
-(defun org-babel-prep-session:C (session params)
+(defun org-babel-prep-session:C (_session _params)
"This function does nothing as C is a compiled language with no
support for sessions"
(error "C is a compiled language -- no support for sessions"))
-(defun org-babel-load-session:C (session body params)
+(defun org-babel-load-session:C (_session _body _params)
"This function does nothing as C is a compiled language with no
support for sessions"
(error "C is a compiled language -- no support for sessions"))
@@ -177,58 +320,79 @@ support for sessions"
"Determine the type of VAL.
Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
FORMAT can be either a format string or a function which is called with VAL."
+ (let* ((basetype (org-babel-C-val-to-base-type val))
+ (type
+ (pcase basetype
+ (`integerp '("int" "%d"))
+ (`floatp '("double" "%f"))
+ (`stringp
+ (list
+ (if (eq org-babel-c-variant 'd) "string" "const char*")
+ "\"%s\""))
+ (_ (error "unknown type %S" basetype)))))
+ (cond
+ ((integerp val) type) ;; an integer declared in the #+begin_src line
+ ((floatp val) type) ;; a numeric declared in the #+begin_src line
+ ((and (listp val) (listp (car val))) ;; a table
+ `(,(car type)
+ (lambda (val)
+ (cons
+ (format "[%d][%d]" (length val) (length (car val)))
+ (concat
+ (if (eq org-babel-c-variant 'd) "[\n" "{\n")
+ (mapconcat
+ (lambda (v)
+ (concat
+ (if (eq org-babel-c-variant 'd) " [" " {")
+ (mapconcat (lambda (w) (format ,(cadr type) w)) v ",")
+ (if (eq org-babel-c-variant 'd) "]" "}")))
+ val
+ ",\n")
+ (if (eq org-babel-c-variant 'd) "\n]" "\n}"))))))
+ ((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line
+ `(,(car type)
+ (lambda (val)
+ (cons
+ (format "[%d]" (length val))
+ (concat
+ (if (eq org-babel-c-variant 'd) "[" "{")
+ (mapconcat (lambda (v) (format ,(cadr type) v)) val ",")
+ (if (eq org-babel-c-variant 'd) "]" "}"))))))
+ (t ;; treat unknown types as string
+ type))))
+
+(defun org-babel-C-val-to-base-type (val)
+ "Determine the base type of VAL which may be
+`integerp' if all base values are integers
+`floatp' if all base values are either floating points or integers
+`stringp' otherwise."
(cond
- ((integerp val) '("int" "%d"))
- ((floatp val) '("double" "%f"))
+ ((integerp val) 'integerp)
+ ((floatp val) 'floatp)
((or (listp val) (vectorp val))
- (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
- (list (car type)
- (lambda (val)
- (cons
- (format "[%d]%s"
- (length val)
- (car (org-babel-C-format-val type (elt val 0))))
- (concat "{ "
- (mapconcat (lambda (v)
- (cdr (org-babel-C-format-val type v)))
- val
- ", ")
- " }"))))))
- (t ;; treat unknown types as string
- '("char" (lambda (val)
- (let ((s (format "%s" val))) ;; convert to string for unknown types
- (cons (format "[%d]" (1+ (length s)))
- (concat "\"" s "\""))))))))
-
-(defun org-babel-C-val-to-C-list-type (val)
- "Determine the C array type of a VAL."
- (let (type)
- (mapc
- #'(lambda (i)
- (let* ((tmp-type (org-babel-C-val-to-C-type i))
- (type-name (car type))
- (tmp-type-name (car tmp-type)))
- (when (and type (not (string= type-name tmp-type-name)))
- (if (and (member type-name '("int" "double" "int32_t"))
- (member tmp-type-name '("int" "double" "int32_t")))
- (setq tmp-type '("double" "" "%f"))
- (error "Only homogeneous lists are supported by C. You can not mix %s and %s"
- type-name
- tmp-type-name)))
- (setq type tmp-type)))
- val)
- type))
+ (let ((type nil))
+ (mapc (lambda (v)
+ (pcase (org-babel-C-val-to-base-type v)
+ (`stringp (setq type 'stringp))
+ (`floatp
+ (if (or (not type) (eq type 'integerp))
+ (setq type 'floatp)))
+ (`integerp
+ (unless type (setq type 'integerp)))))
+ val)
+ type))
+ (t 'stringp)))
(defun org-babel-C-var-to-C (pair)
"Convert an elisp val into a string of C code specifying a var
of the same value."
;; TODO list support
(let ((var (car pair))
- (val (cdr pair)))
+ (val (cdr pair)))
(when (symbolp val)
(setq val (symbol-name val))
(when (= (length val) 1)
- (setq val (string-to-char val))))
+ (setq val (string-to-char val))))
(let* ((type-data (org-babel-C-val-to-C-type val))
(type (car type-data))
(formated (org-babel-C-format-val type-data val))
@@ -240,6 +404,66 @@ of the same value."
suffix
data))))
+(defun org-babel-C-table-sizes-to-C (pair)
+ "Create constants of table dimensions, if PAIR is a table."
+ (when (listp (cdr pair))
+ (cond
+ ((listp (cadr pair)) ;; a table
+ (concat
+ (format "const int %s_rows = %d;" (car pair) (length (cdr pair)))
+ "\n"
+ (format "const int %s_cols = %d;" (car pair) (length (cadr pair)))))
+ (t ;; a list declared in the #+begin_src line
+ (format "const int %s_cols = %d;" (car pair) (length (cdr pair)))))))
+
+(defun org-babel-C-utility-header-to-C ()
+ "Generate a utility function to convert a column name
+into a column number."
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
+ "int get_column_num (int nbcols, const char** header, const char* column)
+{
+ int c;
+ for (c=0; c<nbcols; c++)
+ if (strcmp(header[c],column)==0)
+ return c;
+ return -1;
+}
+")
+ (`d
+ "int get_column_num (string[] header, string column)
+{
+ foreach (c, h; header)
+ if (h==column)
+ return to!int(c);
+ return -1;
+}
+")))
+
+(defun org-babel-C-header-to-C (head)
+ "Convert an elisp list of header table into a C or D vector
+specifying a variable with the name of the table."
+ (let ((table (car head))
+ (headers (cdr head)))
+ (concat
+ (format
+ (pcase org-babel-c-variant
+ ((or `c `cpp) "const char* %s_header[%d] = {%s};")
+ (`d "string %s_header[%d] = [%s];"))
+ table
+ (length headers)
+ (mapconcat (lambda (h) (format "%S" h)) headers ","))
+ "\n"
+ (pcase org-babel-c-variant
+ ((or `c `cpp)
+ (format
+ "const char* %s_h (int row, const char* col) { return %s[row][get_column_num(%d,%s_header,col)]; }"
+ table table (length headers) table))
+ (`d
+ (format
+ "string %s_h (size_t row, string col) { return %s[row][get_column_num(%s_header,col)]; }"
+ table table table))))))
+
(provide 'ob-C)
;;; ob-C.el ends here
diff --git a/lisp/org/ob-J.el b/lisp/org/ob-J.el
new file mode 100644
index 00000000000..eaccac81212
--- /dev/null
+++ b/lisp/org/ob-J.el
@@ -0,0 +1,186 @@
+;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating J code.
+;;
+;; Session interaction depends on `j-console' from package `j-mode'
+;; (available in MELPA).
+
+;;; Code:
+
+(require 'ob)
+
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function j-console-ensure-session "ext:j-console" ())
+
+(defcustom org-babel-J-command "jconsole"
+ "Command to call J."
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type 'string)
+
+(defun org-babel-expand-body:J (body _params &optional _processed-params)
+ "Expand BODY according to PARAMS, return the expanded body.
+PROCESSED-PARAMS isn't used yet."
+ (org-babel-J-interleave-echos-except-functions body))
+
+(defun org-babel-J-interleave-echos (body)
+ "Interleave echo',' between each source line of BODY."
+ (mapconcat #'identity (split-string body "\n") "\necho','\n"))
+
+(defun org-babel-J-interleave-echos-except-functions (body)
+ "Interleave echo',' between source lines of BODY that aren't functions."
+ (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body)
+ (let ((s1 (substring body 0 (match-beginning 0)))
+ (s2 (match-string 0 body))
+ (s3 (substring body (match-end 0))))
+ (concat
+ (if (string= s1 "")
+ ""
+ (concat (org-babel-J-interleave-echos s1)
+ "\necho','\n"))
+ s2
+ "\necho','\n"
+ (org-babel-J-interleave-echos-except-functions s3)))
+ (org-babel-J-interleave-echos body)))
+
+(defalias 'org-babel-execute:j 'org-babel-execute:J)
+
+(defun org-babel-execute:J (body params)
+ "Execute a block of J code BODY.
+PARAMS are given by org-babel.
+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)))
+ (full-body (org-babel-expand-body:J
+ body params processed-params))
+ (tmp-script-file (org-babel-temp-file "J-src")))
+ (org-babel-j-initiate-session sessionp)
+ (org-babel-J-strip-whitespace
+ (if (string= sessionp "none")
+ (progn
+ (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)))))
+
+(defun org-babel-J-eval-string (str)
+ "Sends STR to the `j-console-cmd' session and executes it."
+ (let ((session (j-console-ensure-session)))
+ (with-current-buffer (process-buffer session)
+ (goto-char (point-max))
+ (insert (format "\n%s\n" str))
+ (let ((beg (point)))
+ (comint-send-input)
+ (sit-for .1)
+ (buffer-substring-no-properties
+ beg (point-max))))))
+
+(defun org-babel-J-strip-whitespace (str)
+ "Remove whitespace from jconsole output STR."
+ (mapconcat
+ #'identity
+ (delete "" (mapcar
+ #'org-babel-J-print-block
+ (split-string str "^ *,\n" t)))
+ "\n\n"))
+
+(defun obj-get-string-alignment (str)
+ "Return a number to describe STR alignment.
+STR represents a table.
+Positive/negative/zero result means right/left/undetermined.
+Don't trust first line."
+ (let* ((str (org-trim str))
+ (lines (split-string str "\n" t))
+ n1 n2)
+ (cond ((<= (length lines) 1)
+ 0)
+ ((= (length lines) 2)
+ ;; numbers are right-aligned
+ (if (and
+ (numberp (read (car lines)))
+ (numberp (read (cadr lines)))
+ (setq n1 (obj-match-second-space-right (nth 0 lines)))
+ (setq n2 (obj-match-second-space-right (nth 1 lines))))
+ n2
+ 0))
+ ((not (obj-match-second-space-left (nth 0 lines)))
+ 0)
+ ((and
+ (setq n1 (obj-match-second-space-left (nth 1 lines)))
+ (setq n2 (obj-match-second-space-left (nth 2 lines)))
+ (= n1 n2))
+ n1)
+ ((and
+ (setq n1 (obj-match-second-space-right (nth 1 lines)))
+ (setq n2 (obj-match-second-space-right (nth 2 lines)))
+ (= n1 n2))
+ (- n1))
+ (t 0))))
+
+(defun org-babel-J-print-block (x)
+ "Prettify jconsole output X."
+ (let* ((x (org-trim x))
+ (a (obj-get-string-alignment x))
+ (lines (split-string x "\n" t))
+ b)
+ (cond ((< a 0)
+ (setq b (obj-match-second-space-right (nth 0 lines)))
+ (concat (make-string (+ a b) ? ) x))
+ ((> a 0)
+ (setq b (obj-match-second-space-left (nth 0 lines)))
+ (concat (make-string (- a b) ? ) x))
+ (t x))))
+
+(defun obj-match-second-space-left (s)
+ "Return position of leftmost space in second space block of S or nil."
+ (and (string-match "^ *[^ ]+\\( \\)" s)
+ (match-beginning 1)))
+
+(defun obj-match-second-space-right (s)
+ "Return position of rightmost space in second space block of S or nil."
+ (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s)
+ (match-beginning 1)))
+
+(defun obj-string-match-m (regexp string &optional start)
+ "Call (string-match REGEXP STRING START).
+REGEXP is modified so that .* matches newlines as well."
+ (string-match
+ (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp)
+ string
+ start))
+
+(defun org-babel-j-initiate-session (&optional session)
+ "Initiate a J session.
+SESSION is a parameter given by org-babel."
+ (unless (string= session "none")
+ (require 'j-console)
+ (j-console-ensure-session)))
+
+(provide 'ob-J)
+
+;;; ob-J.el ends here
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index 51d342702ce..6781fb30a3b 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -1,4 +1,4 @@
-;;; ob-R.el --- org-babel functions for R code evaluation
+;;; ob-R.el --- Babel Functions for R -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,23 +20,24 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Org-Babel support for evaluating R code
;;; Code:
+
+(require 'cl-lib)
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function orgtbl-to-tsv "org-table" (table params))
(declare-function R "ext:essd-r" (&optional start-args))
(declare-function inferior-ess-send-input "ext:ess-inf" ())
(declare-function ess-make-buffer-current "ext:ess-inf" ())
(declare-function ess-eval-buffer "ext:ess-inf" (vis))
-(declare-function org-number-sequence "org-compat" (from &optional to inc))
-(declare-function org-remove-if-not "org" (predicate seq))
+(declare-function ess-wait-for-process "ext:ess-inf"
+ (&optional proc sec-prompt wait force-redisplay))
(defconst org-babel-header-args:R
'((width . :any)
@@ -60,12 +61,25 @@
(useDingbats . :any)
(horizontal . :any)
(results . ((file list vector table scalar verbatim)
- (raw org html latex code pp wrap)
- (replace silent append prepend)
+ (raw html latex org code pp drawer)
+ (replace silent none append prepend)
(output value graphics))))
"R-specific header arguments.")
+(defconst ob-R-safe-header-args
+ (append org-babel-safe-header-args
+ '(:width :height :bg :units :pointsize :antialias :quality
+ :compression :res :type :family :title :fonts
+ :version :paper :encoding :pagecentre :colormodel
+ :useDingbats :horizontal))
+ "Header args which are safe for R babel blocks.
+
+See `org-babel-safe-header-args' for documentation of the format of
+this variable.")
+
(defvar org-babel-default-header-args:R '())
+(put 'org-babel-default-header-args:R 'safe-local-variable
+ (org-babel-header-args-safe-fn ob-R-safe-header-args))
(defcustom org-babel-R-command "R --slave --no-save"
"Name of command to use for executing R code."
@@ -73,56 +87,103 @@
:version "24.1"
:type 'string)
-(defvar ess-local-process-name) ; dynamically scoped
+(defvar ess-current-process-name) ; dynamically scoped
+(defvar ess-local-process-name) ; dynamically scoped
(defun org-babel-edit-prep:R (info)
- (let ((session (cdr (assoc :session (nth 2 info)))))
- (when (and session (string-match "^\\*\\(.+?\\)\\*$" session))
- (save-match-data (org-babel-R-initiate-session session nil)))))
-
-(defun org-babel-expand-body:R (body params &optional graphics-file)
+ (let ((session (cdr (assq :session (nth 2 info)))))
+ (when (and session
+ (string-prefix-p "*" session)
+ (string-suffix-p "*" session))
+ (org-babel-R-initiate-session session nil))))
+
+;; The usage of utils::read.table() ensures that the command
+;; read.table() can be found even in circumstances when the utils
+;; package is not in the search path from R.
+(defconst ob-R-transfer-variable-table-with-header
+ "%s <- local({
+ con <- textConnection(
+ %S
+ )
+ res <- utils::read.table(
+ con,
+ header = %s,
+ row.names = %s,
+ sep = \"\\t\",
+ as.is = TRUE
+ )
+ close(con)
+ res
+ })"
+ "R code used to transfer a table defined as a variable from org to R.
+
+This function is used when the table contains a header.")
+
+(defconst ob-R-transfer-variable-table-without-header
+ "%s <- local({
+ con <- textConnection(
+ %S
+ )
+ res <- utils::read.table(
+ con,
+ header = %s,
+ row.names = %s,
+ sep = \"\\t\",
+ as.is = TRUE,
+ fill = TRUE,
+ col.names = paste(\"V\", seq_len(%d), sep =\"\")
+ )
+ close(con)
+ res
+ })"
+ "R code used to transfer a table defined as a variable from org to R.
+
+This function is used when the table does not contain a header.")
+
+(defun org-babel-expand-body:R (body params &optional _graphics-file)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((graphics-file
- (or graphics-file (org-babel-R-graphical-output-file params))))
- (mapconcat
- #'identity
- (let ((inside
- (append
- (when (cdr (assoc :prologue params))
- (list (cdr (assoc :prologue params))))
- (org-babel-variable-assignments:R params)
- (list body)
- (when (cdr (assoc :epilogue params))
- (list (cdr (assoc :epilogue params)))))))
- (if graphics-file
- (append
- (list (org-babel-R-construct-graphics-device-call
- graphics-file params))
- inside
- (list "dev.off()"))
- inside))
- "\n")))
+ (mapconcat 'identity
+ (append
+ (when (cdr (assq :prologue params))
+ (list (cdr (assq :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assq :epilogue params))
+ (list (cdr (assq :epilogue params)))))
+ "\n"))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
This function is called by `org-babel-execute-src-block'."
(save-excursion
- (let* ((result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(session (org-babel-R-initiate-session
- (cdr (assoc :session params)) params))
- (colnames-p (cdr (assoc :colnames params)))
- (rownames-p (cdr (assoc :rownames params)))
- (graphics-file (org-babel-R-graphical-output-file params))
- (full-body (org-babel-expand-body:R body params graphics-file))
+ (cdr (assq :session params)) params))
+ (graphics-file (and (member "graphics" (assq :result-params params))
+ (org-babel-graphical-output-file params)))
+ (colnames-p (unless graphics-file (cdr (assq :colnames params))))
+ (rownames-p (unless graphics-file (cdr (assq :rownames params))))
+ (full-body
+ (let ((inside
+ (list (org-babel-expand-body:R body params graphics-file))))
+ (mapconcat 'identity
+ (if graphics-file
+ (append
+ (list (org-babel-R-construct-graphics-device-call
+ graphics-file params))
+ inside
+ (list "},error=function(e){plot(x=-1:1, y=-1:1, type='n', xlab='', ylab='', axes=FALSE); text(x=0, y=0, labels=e$message, col='red'); paste('ERROR', e$message, sep=' : ')}); dev.off()"))
+ inside)
+ "\n")))
(result
(org-babel-R-evaluate
session full-body result-type result-params
(or (equal "yes" colnames-p)
(org-babel-pick-name
- (cdr (assoc :colname-names params)) colnames-p))
+ (cdr (assq :colname-names params)) colnames-p))
(or (equal "yes" rownames-p)
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) rownames-p)))))
+ (cdr (assq :rowname-names params)) rownames-p)))))
(if graphics-file nil result))))
(defun org-babel-prep-session:R (session params)
@@ -148,21 +209,21 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-variable-assignments:R (params)
"Return list of R statements assigning the block's variables."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapcar
(lambda (pair)
(org-babel-R-assign-elisp
(car pair) (cdr pair)
- (equal "yes" (cdr (assoc :colnames params)))
- (equal "yes" (cdr (assoc :rownames params)))))
+ (equal "yes" (cdr (assq :colnames params)))
+ (equal "yes" (cdr (assq :rownames params)))))
(mapcar
(lambda (i)
(cons (car (nth i vars))
(org-babel-reassemble-table
(cdr (nth i vars))
- (cdr (nth i (cdr (assoc :colname-names params))))
- (cdr (nth i (cdr (assoc :rowname-names params)))))))
- (org-number-sequence 0 (1- (length vars)))))))
+ (cdr (nth i (cdr (assq :colname-names params))))
+ (cdr (nth i (cdr (assq :rowname-names params)))))))
+ (number-sequence 0 (1- (length vars)))))))
(defun org-babel-R-quote-tsv-field (s)
"Quote field S for export to R."
@@ -173,35 +234,25 @@ This function is called by `org-babel-execute-src-block'."
(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
- (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value)))
+ (let* ((lengths (mapcar 'length (cl-remove-if-not 'sequencep value)))
(max (if lengths (apply 'max lengths) 0))
- (min (if lengths (apply 'min lengths) 0))
- (transition-file (org-babel-temp-file "R-import-")))
+ (min (if lengths (apply 'min lengths) 0)))
;; Ensure VALUE has an orgtbl structure (depth of at least 2).
(unless (listp (car value)) (setq value (list value)))
- (with-temp-file transition-file
- (insert
- (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))
- "\n"))
- (let ((file (org-babel-process-file-name transition-file 'noquote))
+ (let ((file (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)))
(header (if (or (eq (nth 1 value) 'hline) colnames-p)
"TRUE" "FALSE"))
(row-names (if rownames-p "1" "NULL")))
(if (= max min)
- (format "%s <- read.table(\"%s\",
- header=%s,
- row.names=%s,
- sep=\"\\t\",
- as.is=TRUE)" name file header row-names)
- (format "%s <- read.table(\"%s\",
- header=%s,
- row.names=%s,
- sep=\"\\t\",
- as.is=TRUE,
- fill=TRUE,
- col.names = paste(\"V\", seq_len(%d), sep =\"\"))"
+ (format ob-R-transfer-variable-table-with-header
+ name file header row-names)
+ (format ob-R-transfer-variable-table-without-header
name file header row-names max))))
- (format "%s <- %s" name (org-babel-R-quote-tsv-field value))))
+ (cond ((integerp value) (format "%s <- %s" name (concat (number-to-string value) "L")))
+ ((floatp value) (format "%s <- %s" name value))
+ ((stringp value) (format "%s <- %S" name (org-no-properties value)))
+ (t (format "%s <- %S" name (prin1-to-string value))))))
+
(defvar ess-ask-for-ess-directory) ; dynamically scoped
(defun org-babel-R-initiate-session (session params)
@@ -209,8 +260,9 @@ This function is called by `org-babel-execute-src-block'."
(unless (string= session "none")
(let ((session (or session "*R*"))
(ess-ask-for-ess-directory
- (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory)
- (not (cdr (assoc :dir params))))))
+ (and (boundp 'ess-ask-for-ess-directory)
+ ess-ask-for-ess-directory
+ (not (cdr (assq :dir params))))))
(if (org-babel-comint-buffer-livep session)
session
(save-window-excursion
@@ -218,6 +270,10 @@ This function is called by `org-babel-execute-src-block'."
;; Session buffer exists, but with dead process
(set-buffer session))
(require 'ess) (R)
+ (let ((R-proc (get-process (or ess-local-process-name
+ ess-current-process-name))))
+ (while (process-get R-proc 'callbacks)
+ (ess-wait-for-process R-proc)))
(rename-buffer
(if (bufferp session)
(buffer-name session)
@@ -234,11 +290,6 @@ current code buffer."
(process-name (get-buffer-process session)))
(ess-make-buffer-current))
-(defun org-babel-R-graphical-output-file (params)
- "Name of file to which R should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
(defvar org-babel-R-graphics-devices
'((:bmp "bmp" "filename")
(:jpg "jpeg" "filename")
@@ -265,8 +316,7 @@ Each member of this list is a list with three members:
:type :family :title :fonts :version
:paper :encoding :pagecentre :colormodel
:useDingbats :horizontal))
- (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
- (match-string 1 out-file)))
+ (device (file-name-extension out-file))
(device-info (or (assq (intern (concat ":" device))
org-babel-R-graphics-devices)
(assq :png org-babel-R-graphics-devices)))
@@ -280,14 +330,43 @@ Each member of this list is a list with three members:
(substring (symbol-name (car pair)) 1)
(cdr pair)) ""))
params ""))
- (format "%s(%s=\"%s\"%s%s%s)"
+ (format "%s(%s=\"%s\"%s%s%s); tryCatch({"
device filearg out-file args
(if extra-args "," "") (or extra-args ""))))
-(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'")
-(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
-
-(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")")
+(defconst org-babel-R-eoe-indicator "'org_babel_R_eoe'")
+(defconst org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"")
+
+(defconst org-babel-R-write-object-command "{
+ function(object,transfer.file) {
+ object
+ invisible(
+ if (
+ inherits(
+ try(
+ {
+ tfile<-tempfile()
+ write.table(object, file=tfile, sep=\"\\t\",
+ na=\"nil\",row.names=%s,col.names=%s,
+ quote=FALSE)
+ file.rename(tfile,transfer.file)
+ },
+ silent=TRUE),
+ \"try-error\"))
+ {
+ if(!file.exists(transfer.file))
+ file.create(transfer.file)
+ }
+ )
+ }
+}(object=%s,transfer.file=\"%s\")"
+ "A template for an R command to evaluate a block of code and write the result to a file.
+
+Has four %s escapes to be filled in:
+1. Row names, \"TRUE\" or \"FALSE\"
+2. Column names, \"TRUE\" or \"FALSE\"
+3. The code to be run (must be an expression, not a statement)
+4. The name of the file to write to")
(defun org-babel-R-evaluate
(session body result-type result-params column-names-p row-names-p)
@@ -299,12 +378,12 @@ Each member of this list is a list with three members:
body result-type result-params column-names-p row-names-p)))
(defun org-babel-R-evaluate-external-process
- (body result-type result-params column-names-p row-names-p)
+ (body result-type result-params column-names-p row-names-p)
"Evaluate BODY in external R process.
-If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+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."
- (case result-type
+ (cl-case result-type
(value
(let ((tmp-file (org-babel-temp-file "R-")))
(org-babel-eval org-babel-R-command
@@ -319,7 +398,7 @@ last statement in BODY, as elisp."
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
- (buffer-string))
+ (org-babel-chomp (buffer-string) "\n"))
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output (org-babel-eval org-babel-R-command body))))
@@ -327,12 +406,12 @@ last statement in BODY, as elisp."
(defvar ess-eval-visibly-p)
(defun org-babel-R-evaluate-session
- (session body result-type result-params column-names-p row-names-p)
+ (session body result-type result-params column-names-p row-names-p)
"Evaluate BODY 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
+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."
- (case result-type
+ (cl-case result-type
(value
(with-temp-buffer
(insert (org-babel-chomp body))
@@ -353,12 +432,12 @@ last statement in BODY, as elisp."
(org-babel-result-cond result-params
(with-temp-buffer
(insert-file-contents tmp-file)
- (buffer-string))
+ (org-babel-chomp (buffer-string) "\n"))
(org-babel-import-elisp-from-file tmp-file '(16)))
column-names-p)))
(output
(mapconcat
- #'org-babel-chomp
+ 'org-babel-chomp
(butlast
(delq nil
(mapcar
@@ -366,11 +445,12 @@ last statement in BODY, as elisp."
(mapcar
(lambda (line) ;; cleanup extra prompts left in output
(if (string-match
- "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line)
+ "^\\([>+.]\\([ ][>.+]\\)*[ ]\\)"
+ (car (split-string line "\n")))
(substring line (match-end 1))
line))
(org-babel-comint-with-output (session org-babel-R-eoe-output)
- (insert (mapconcat #'org-babel-chomp
+ (insert (mapconcat 'org-babel-chomp
(list body org-babel-R-eoe-indicator)
"\n"))
(inferior-ess-send-input)))))) "\n"))))
diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el
new file mode 100644
index 00000000000..693c5d8f60f
--- /dev/null
+++ b/lisp/org/ob-abc.el
@@ -0,0 +1,90 @@
+;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
+
+;; Author: William Waites
+;; Keywords: literate programming, music
+;; Homepage: http://www.tardis.ed.ac.uk/wwaites
+;; Version: 0.01
+
+;; 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 adds support to Org Babel for music in ABC notation.
+;;; It requires that the abcm2ps program is installed.
+;;; See http://moinejf.free.fr/
+
+(require 'ob)
+
+;; optionally define a file extension for this language
+(add-to-list 'org-babel-tangle-lang-exts '("abc" . "abc"))
+
+;; optionally declare default header arguments for this language
+(defvar org-babel-default-header-args:abc
+ '((:results . "file") (:exports . "results"))
+ "Default arguments to use when evaluating an ABC source block.")
+
+(defun org-babel-expand-body:abc (body params)
+ "Expand BODY according to PARAMS, return the expanded body."
+ (let ((vars (org-babel--get-vars params)))
+ (mapc
+ (lambda (pair)
+ (let ((name (symbol-name (car pair)))
+ (value (cdr pair)))
+ (setq body
+ (replace-regexp-in-string
+ (concat "\$" (regexp-quote name))
+ (if (stringp value) value (format "%S" value))
+ body))))
+ vars)
+ body))
+
+(defun org-babel-execute:abc (body params)
+ "Execute a block of ABC code with org-babel. This function is
+ called by `org-babel-execute-src-block'"
+ (message "executing Abc source code block")
+ (let* ((cmdline (cdr (assq :cmdline params)))
+ (out-file (let ((file (cdr (assq :file params))))
+ (if file (replace-regexp-in-string "\.pdf$" ".ps" file)
+ (error "abc code block requires :file header argument"))))
+ (in-file (org-babel-temp-file "abc-"))
+ (render (concat "abcm2ps" " " cmdline
+ " -O " (org-babel-process-file-name out-file)
+ " " (org-babel-process-file-name in-file))))
+ (with-temp-file in-file (insert (org-babel-expand-body:abc body params)))
+ (org-babel-eval render "")
+ ;;; handle where abcm2ps changes the file name (to support multiple files
+ (when (or (string= (file-name-extension out-file) "eps")
+ (string= (file-name-extension out-file) "svg"))
+ (rename-file (concat
+ (file-name-sans-extension out-file) "001."
+ (file-name-extension out-file))
+ out-file t))
+ ;;; if we were asked for a pdf...
+ (when (string= (file-name-extension (cdr (assq :file params))) "pdf")
+ (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assq :file params))) ""))
+ ;;; indicate that the file has been written
+ nil))
+
+;; This function should be used to assign any variables in params in
+;; the context of the session environment.
+(defun org-babel-prep-session:abc (_session _params)
+ "Return an error because abc does not support sessions."
+ (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 e3b73c19ac9..819273aecef 100644
--- a/lisp/org/ob-asymptote.el
+++ b/lisp/org/ob-asymptote.el
@@ -1,4 +1,4 @@
-;;; ob-asymptote.el --- org-babel functions for asymptote evaluation
+;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -43,11 +43,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
-
-(declare-function orgtbl-to-generic "org-table"
- (table params &optional backend))
-(declare-function org-combine-plists "org" (&rest plists))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy"))
@@ -59,13 +54,10 @@
(defun org-babel-execute:asymptote (body params)
"Execute a block of Asymptote code.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file (cdr (assoc :file params)))
- (format (or (and out-file
- (string-match ".+\\.\\(.+\\)" out-file)
- (match-string 1 out-file))
+ (let* ((out-file (cdr (assq :file params)))
+ (format (or (file-name-extension out-file)
"pdf"))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "asymptote-"))
(cmd
(concat "asy "
@@ -83,7 +75,7 @@ This function is called by `org-babel-execute-src-block'."
(message cmd) (shell-command cmd)
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:asymptote (session params)
+(defun org-babel-prep-session:asymptote (_session _params)
"Return an error if the :session header argument is set.
Asymptote does not support sessions"
(error "Asymptote does not support sessions"))
@@ -91,7 +83,7 @@ Asymptote does not support sessions"
(defun org-babel-variable-assignments:asymptote (params)
"Return list of asymptote statements assigning the block's variables."
(mapcar #'org-babel-asymptote-var-to-asymptote
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-asymptote-var-to-asymptote (pair)
"Convert an elisp value into an Asymptote variable.
@@ -128,21 +120,17 @@ a variable of the same value."
DATA is a list. Return type as a symbol.
-The type is `string' if any element in DATA is
-a string. Otherwise, it is either `real', if some elements are
-floats, or `int'."
- (let* ((type 'int)
- find-type ; for byte-compiler
- (find-type
- (function
- (lambda (row)
- (catch 'exit
- (mapc (lambda (el)
- (cond ((listp el) (funcall find-type el))
- ((stringp el) (throw 'exit (setq type 'string)))
- ((floatp el) (setq type 'real))))
- row))))))
- (funcall find-type data) type))
+The type is `string' if any element in DATA is a string.
+Otherwise, it is either `real', if some elements are floats, or
+`int'."
+ (letrec ((type 'int)
+ (find-type
+ (lambda (row)
+ (dolist (e row type)
+ (cond ((listp e) (setq type (funcall find-type e)))
+ ((stringp e) (throw 'exit 'string))
+ ((floatp e) (setq type 'real)))))))
+ (catch 'exit (funcall find-type data)) type))
(provide 'ob-asymptote)
diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el
index c2ac5cac3bf..e2eec9bf7f0 100644
--- a/lisp/org/ob-awk.el
+++ b/lisp/org/ob-awk.el
@@ -1,4 +1,4 @@
-;;; ob-awk.el --- org-babel functions for awk evaluation
+;;; ob-awk.el --- Babel Functions for Awk -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -27,17 +27,15 @@
;;
;; - :in-file takes a path to a file of data to be processed by awk
;;
-;; - :stdin takes an Org-mode data or code block reference, the value
-;; of which will be passed to the awk process through STDIN
+;; - :stdin takes an Org data or code block reference, the value of
+;; which will be passed to the awk process through STDIN
;;; Code:
(require 'ob)
(require 'org-compat)
-(eval-when-compile (require 'cl))
(declare-function org-babel-ref-resolve "ob-ref" (ref))
-(declare-function orgtbl-to-generic "org-table"
- (table params &optional backend))
+(declare-function orgtbl-to-generic "org-table" (table params))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk"))
@@ -45,34 +43,38 @@
(defvar org-babel-awk-command "awk"
"Name of the awk executable command.")
-(defun org-babel-expand-body:awk (body params)
+(defun org-babel-expand-body:awk (body _params)
"Expand BODY according to PARAMS, return the expanded body."
- (dolist (pair (mapcar #'cdr (org-babel-get-header params :var)))
- (setf body (replace-regexp-in-string
- (regexp-quote (format "$%s" (car pair))) (cdr pair) body)))
body)
(defun org-babel-execute:awk (body params)
"Execute a block of Awk code with org-babel. This function is
called by `org-babel-execute-src-block'"
(message "executing Awk source code block")
- (let* ((result-params (cdr (assoc :result-params params)))
- (cmd-line (cdr (assoc :cmd-line params)))
- (in-file (cdr (assoc :in-file params)))
+ (let* ((result-params (cdr (assq :result-params params)))
+ (cmd-line (cdr (assq :cmd-line params)))
+ (in-file (cdr (assq :in-file params)))
(full-body (org-babel-expand-body:awk body params))
(code-file (let ((file (org-babel-temp-file "awk-")))
(with-temp-file file (insert full-body)) file))
- (stdin (let ((stdin (cdr (assoc :stdin params))))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
(when stdin
(let ((tmp (org-babel-temp-file "awk-stdin-"))
(res (org-babel-ref-resolve stdin)))
(with-temp-file tmp
(insert (org-babel-awk-var-to-awk res)))
tmp))))
- (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command
- "-f" code-file
- cmd-line
- in-file))
+ (cmd (mapconcat #'identity
+ (append
+ (list org-babel-awk-command
+ "-f" code-file cmd-line)
+ (mapcar (lambda (pair)
+ (format "-v %s='%s'"
+ (car pair)
+ (org-babel-awk-var-to-awk
+ (cdr pair))))
+ (org-babel--get-vars params))
+ (list in-file))
" ")))
(org-babel-reassemble-table
(let ((results
@@ -88,9 +90,9 @@ called by `org-babel-execute-src-block'"
(with-temp-file tmp (insert results))
(org-babel-import-elisp-from-file tmp)))))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defun org-babel-awk-var-to-awk (var &optional sep)
"Return a printed value of VAR suitable for parsing with awk."
@@ -102,11 +104,6 @@ called by `org-babel-execute-src-block'"
(mapconcat echo-var var "\n"))
(t (funcall echo-var var)))))
-(defun org-babel-awk-table-or-string (results)
- "If the results look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
(provide 'ob-awk)
diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el
index 6298bba522a..76d36cf7801 100644
--- a/lisp/org/ob-calc.el
+++ b/lisp/org/ob-calc.el
@@ -1,4 +1,4 @@
-;;; ob-calc.el --- org-babel functions for calc code evaluation
+;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,18 +28,18 @@
;;; Code:
(require 'ob)
(require 'calc)
-(unless (featurep 'xemacs)
- (require 'calc-trail)
- (require 'calc-store))
+(require 'calc-trail)
+(require 'calc-store)
(declare-function calc-store-into "calc-store" (&optional var))
(declare-function calc-recall "calc-store" (&optional var))
(declare-function math-evaluate-expr "calc-ext" (x))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:calc nil
"Default arguments for evaluating an calc source block.")
-(defun org-babel-expand-body:calc (body params)
+(defun org-babel-expand-body:calc (body _params)
"Expand BODY according to PARAMS, return the expanded body." body)
(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc
@@ -48,7 +48,7 @@
"Execute a block of calc code with Babel."
(unless (get-buffer "*Calculator*")
(save-window-excursion (calc) (calc-quit)))
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
+ (let* ((vars (org-babel--get-vars params))
(org--var-syms (mapcar #'car vars))
(var-names (mapcar #'symbol-name org--var-syms)))
(mapc
@@ -85,15 +85,17 @@
;; parse line into calc objects
(car (math-read-exprs line)))))))))
))))))
- (mapcar #'org-babel-trim
+ (mapcar #'org-trim
(split-string (org-babel-expand-body:calc body params) "[\n\r]"))))
(save-excursion
(with-current-buffer (get-buffer "*Calculator*")
- (calc-eval (calc-top 1)))))
+ (prog1
+ (calc-eval (calc-top 1))
+ (calc-pop 1)))))
(defun org-babel-calc-maybe-resolve-var (el)
(if (consp el)
- (if (and (equal 'var (car el)) (member (cadr el) org--var-syms))
+ (if (and (eq 'var (car el)) (member (cadr el) org--var-syms))
(progn
(calc-recall (cadr el))
(prog1 (calc-top 1)
diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el
index b9af45adfeb..b49bfe58898 100644
--- a/lisp/org/ob-clojure.el
+++ b/lisp/org/ob-clojure.el
@@ -1,9 +1,9 @@
-;;; ob-clojure.el --- org-babel functions for clojure evaluation
+;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
-;; Author: Joel Boehland
-;; Eric Schulte
+;; Author: Joel Boehland, Eric Schulte, Oleh Krehel, Frederick Giasson
+;;
;; Keywords: literate programming, reproducible research
;; Homepage: http://orgmode.org
@@ -20,76 +20,179 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; Support for evaluating clojure code, relies on slime for all eval.
+;; Support for evaluating clojure code
-;;; Requirements:
+;; Requirements:
;; - clojure (at least 1.2.0)
;; - clojure-mode
-;; - slime
+;; - either cider or SLIME
-;; By far, the best way to install these components is by following
+;; For Cider, 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)
+(declare-function cider-current-connection "ext:cider-client" (&optional type))
+(declare-function cider-current-ns "ext:cider-client" ())
+(declare-function nrepl--merge "ext:nrepl-client" (dict1 dict2))
+(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 session ns line column additional-params))
+(declare-function nrepl-sync-request:eval "ext:nrepl-client"
+ (input connection session &optional ns))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function slime-eval "ext:slime" (sexp &optional package))
+(defvar nrepl-sync-request-timeout)
+
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj"))
(defvar org-babel-default-header-args:clojure '())
(defvar org-babel-header-args:clojure '((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))
+ "Backend used to evaluate Clojure code blocks."
+ :group 'org-babel
+ :type '(choice
+ (const :tag "cider" cider)
+ (const :tag "SLIME" slime)))
+
(defun org-babel-expand-body:clojure (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((vars (org-babel--get-vars params))
+ (result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
- (body (org-babel-trim
- (if (> (length vars) 0)
- (concat "(let ["
- (mapconcat
- (lambda (var)
- (format "%S (quote %S)" (car var) (cdr var)))
- vars "\n ")
- "]\n" body ")")
- body))))
- (cond ((or (member "code" result-params) (member "pp" result-params))
- (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] "
- "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch "
- "(clojure.pprint/pprint (do %s) org-mode-print-catcher) "
- "(str org-mode-print-catcher)))")
- (if (member "code" result-params) "code" "simple") body))
- ;; if (:results output), collect printed output
- ((member "output" result-params)
- (format "(clojure.core/with-out-str %s)" body))
- (t body))))
+ (body (org-trim
+ (if (null vars) (org-trim body)
+ (concat "(let ["
+ (mapconcat
+ (lambda (var)
+ (format "%S (quote %S)" (car var) (cdr var)))
+ vars "\n ")
+ "]\n" body ")")))))
+ (if (or (member "code" result-params)
+ (member "pp" result-params))
+ (format "(clojure.pprint/pprint (do %s))" body)
+ body)))
(defun org-babel-execute:clojure (body params)
- "Execute a block of Clojure code with Babel."
- (require 'slime)
- (with-temp-buffer
- (insert (org-babel-expand-body:clojure body params))
- (let ((result
- (slime-eval
- `(swank:eval-and-grab-output
- ,(buffer-substring-no-properties (point-min) (point-max)))
- (cdr (assoc :package params)))))
- (let ((result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- result
- (condition-case nil (org-babel-script-escape result)
- (error result)))))))
+ "Execute a block of Clojure code with Babel.
+The underlying process performed by the code block can be output
+using the :show-process parameter."
+ (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)
+ (cider-current-ns))))
+ (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)
+ (cider-current-ns))
+
+ ;; 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
+ (condition-case nil (org-babel-script-escape result)
+ (error result)))))
(provide 'ob-clojure)
-
-
;;; ob-clojure.el ends here
diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el
index 78c5021b1b2..2a1d274365c 100644
--- a/lisp/org/ob-comint.el
+++ b/lisp/org/ob-comint.el
@@ -1,4 +1,4 @@
-;;; ob-comint.el --- org-babel functions for interaction with comint buffers
+;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -33,10 +33,6 @@
(require 'ob-core)
(require 'org-compat)
(require 'comint)
-(eval-when-compile (require 'cl))
-(declare-function with-parsed-tramp-file-name "tramp"
- (filename var &rest body) t)
-(declare-function tramp-flush-directory-property "tramp-cache" (key directory))
(defun org-babel-comint-buffer-livep (buffer)
"Check if BUFFER is a comint buffer with a live process."
@@ -49,12 +45,14 @@ BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is
executed inside the protection of `save-excursion' and
`save-match-data'."
(declare (indent 1))
- `(save-excursion
+ `(progn
+ (unless (org-babel-comint-buffer-livep ,buffer)
+ (error "Buffer %s does not exist or has no process" ,buffer))
(save-match-data
- (unless (org-babel-comint-buffer-livep ,buffer)
- (error "Buffer %s does not exist or has no process" ,buffer))
- (set-buffer ,buffer)
- ,@body)))
+ (with-current-buffer ,buffer
+ (save-excursion
+ (let ((comint-input-filter (lambda (_input) nil)))
+ ,@body))))))
(def-edebug-spec org-babel-comint-in-buffer (form body))
(defmacro org-babel-comint-with-output (meta &rest body)
@@ -70,53 +68,49 @@ elements are optional.
This macro ensures that the filter is removed in case of an error
or user `keyboard-quit' during execution of body."
(declare (indent 1))
- (let ((buffer (car meta))
- (eoe-indicator (cadr meta))
- (remove-echo (cadr (cdr meta)))
- (full-body (cadr (cdr (cdr meta)))))
+ (let ((buffer (nth 0 meta))
+ (eoe-indicator (nth 1 meta))
+ (remove-echo (nth 2 meta))
+ (full-body (nth 3 meta)))
`(org-babel-comint-in-buffer ,buffer
- (let ((string-buffer "") dangling-text raw)
- ;; setup filter
- (setq comint-output-filter-functions
+ (let* ((string-buffer "")
+ (comint-output-filter-functions
(cons (lambda (text) (setq string-buffer (concat string-buffer text)))
comint-output-filter-functions))
- (unwind-protect
- (progn
- ;; got located, and save dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (let ((start (point))
- (end (point-max)))
- (setq dangling-text (buffer-substring start end))
- (delete-region start end))
- ;; pass FULL-BODY to process
- ,@body
- ;; wait for end-of-evaluation indicator
- (while (progn
- (goto-char comint-last-input-end)
- (not (save-excursion
- (and (re-search-forward
- (regexp-quote ,eoe-indicator) nil t)
- (re-search-forward
- comint-prompt-regexp nil t)))))
- (accept-process-output (get-buffer-process (current-buffer)))
- ;; thought the following this would allow async
- ;; background running, but I was wrong...
- ;; (run-with-timer .5 .5 'accept-process-output
- ;; (get-buffer-process (current-buffer)))
- )
- ;; replace cut dangling text
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (insert dangling-text))
- ;; remove filter
- (setq comint-output-filter-functions
- (cdr comint-output-filter-functions)))
+ dangling-text)
+ ;; got located, and save dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (let ((start (point))
+ (end (point-max)))
+ (setq dangling-text (buffer-substring start end))
+ (delete-region start end))
+ ;; pass FULL-BODY to process
+ ,@body
+ ;; wait for end-of-evaluation indicator
+ (while (progn
+ (goto-char comint-last-input-end)
+ (not (save-excursion
+ (and (re-search-forward
+ (regexp-quote ,eoe-indicator) nil t)
+ (re-search-forward
+ comint-prompt-regexp nil t)))))
+ (accept-process-output (get-buffer-process (current-buffer)))
+ ;; thought the following this would allow async
+ ;; background running, but I was wrong...
+ ;; (run-with-timer .5 .5 'accept-process-output
+ ;; (get-buffer-process (current-buffer)))
+ )
+ ;; replace cut dangling text
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert dangling-text)
+
;; remove echo'd FULL-BODY from input
- (if (and ,remove-echo ,full-body
- (string-match
- (replace-regexp-in-string
- "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
- string-buffer))
- (setq raw (substring string-buffer (match-end 0))))
+ (when (and ,remove-echo ,full-body
+ (string-match
+ (replace-regexp-in-string
+ "\n" "[\r\n]+" (regexp-quote (or ,full-body "")))
+ string-buffer))
+ (setq string-buffer (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
(def-edebug-spec org-babel-comint-with-output (sexp body))
@@ -149,15 +143,10 @@ Don't return until FILE exists. Code in STRING must ensure that
FILE exists at end of evaluation."
(unless (org-babel-comint-buffer-livep buffer)
(error "Buffer %s does not exist or has no process" buffer))
- (if (file-exists-p file) (delete-file file))
+ (when (file-exists-p file) (delete-file file))
(process-send-string
(get-buffer-process buffer)
- (if (string-match "\n$" string) string (concat string "\n")))
- ;; From Tramp 2.1.19 the following cache flush is not necessary
- (if (file-remote-p default-directory)
- (let (v)
- (with-parsed-tramp-file-name default-directory nil
- (tramp-flush-directory-property v ""))))
+ (if (= (aref string (1- (length string))) ?\n) string (concat string "\n")))
(while (not (file-exists-p file)) (sit-for (or period 0.25))))
(provide 'ob-comint)
diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el
new file mode 100644
index 00000000000..76bfc5add90
--- /dev/null
+++ b/lisp/org/ob-coq.el
@@ -0,0 +1,78 @@
+;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Rudimentary support for evaluating Coq code blocks. Currently only
+;; session evaluation is supported. Requires both coq.el and
+;; coq-inferior.el, both of which are distributed with Coq.
+;;
+;; http://coq.inria.fr/
+
+;;; Code:
+(require 'ob)
+
+(declare-function run-coq "ext:coq-inferior.el" (cmd))
+(declare-function coq-proc "ext:coq-inferior.el" ())
+
+(defvar coq-program-name "coqtop"
+ "Name of the coq toplevel to run.")
+
+(defvar org-babel-coq-buffer "*coq*"
+ "Buffer in which to evaluate coq code blocks.")
+
+(defun org-babel-coq-clean-prompt (string)
+ (if (string-match "^[^[:space:]]+ < " string)
+ (substring string 0 (match-beginning 0))
+ string))
+
+(defun org-babel-execute:coq (body params)
+ (let ((full-body (org-babel-expand-body:generic body params))
+ (session (org-babel-coq-initiate-session))
+ (pt (lambda ()
+ (marker-position
+ (process-mark (get-buffer-process (current-buffer)))))))
+ (org-babel-coq-clean-prompt
+ (org-babel-comint-in-buffer session
+ (let ((start (funcall pt)))
+ (with-temp-buffer
+ (insert full-body)
+ (comint-send-region (coq-proc) (point-min) (point-max))
+ (comint-send-string (coq-proc)
+ (if (string= (buffer-substring (- (point-max) 1) (point-max)) ".")
+ "\n"
+ ".\n")))
+ (while (equal start (funcall pt)) (sleep-for 0.1))
+ (buffer-substring start (funcall pt)))))))
+
+(defun org-babel-coq-initiate-session ()
+ "Initiate a coq session.
+If there is not a current inferior-process-buffer in SESSION then
+create one. Return the initialized session."
+ (unless (fboundp 'run-coq)
+ (error "`run-coq' not defined, load coq-inferior.el"))
+ (save-window-excursion (run-coq coq-program-name))
+ (sit-for 0.1)
+ (get-buffer org-babel-coq-buffer))
+
+(provide 'ob-coq)
diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el
index cfbcbe6eced..17aae68434a 100644
--- a/lisp/org/ob-core.el
+++ b/lisp/org/ob-core.el
@@ -1,4 +1,4 @@
-;;; ob-core.el --- working with code blocks in org-mode
+;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,11 +20,10 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'ob-eval)
(require 'org-macs)
(require 'org-compat)
@@ -33,66 +32,69 @@
(if (memq system-type '(windows-nt cygwin))
".exe"
nil))
-;; dynamically scoped for tramp
-(defvar org-babel-call-process-region-original nil)
-(defvar org-src-lang-modes)
+
(defvar org-babel-library-of-babel)
-(declare-function outline-show-all "outline" ())
-(declare-function org-every "org" (pred seq))
-(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
+(defvar org-edit-src-content-indentation)
+(defvar org-src-lang-modes)
+(defvar org-src-preserve-indentation)
+
+(declare-function org-at-item-p "org-list" ())
+(declare-function org-at-table-p "org" (&optional table-type))
+(declare-function org-babel-lob-execute-maybe "ob-lob" ())
+(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
+(declare-function org-babel-ref-headline-body "ob-ref" ())
+(declare-function org-babel-ref-parse "ob-ref" (assignment))
+(declare-function org-babel-ref-resolve "ob-ref" (ref))
+(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
+(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
+(declare-function org-completing-read "org" (&rest args))
+(declare-function org-current-level "org" ())
+(declare-function org-cycle "org" (&optional arg))
+(declare-function org-do-remove-indentation "org" (&optional n))
+(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name))
+(declare-function org-edit-src-exit "org-src" ())
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-normalize-string "org-element" (s))
+(declare-function org-element-property "org-element" (property element))
+(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-get-indentation "org" (&optional line))
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-in-regexp "org" (regexp &optional nlines visually))
+(declare-function org-indent-line "org" ())
+(declare-function org-list-get-list-end "org-list" (item struct prevs))
+(declare-function org-list-prevs-alist "org-list" (struct))
+(declare-function org-list-struct "org-list" ())
+(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 tramp-compat-make-temp-file "tramp-compat"
- (filename &optional dir-flag))
-(declare-function org-icompleting-read "org" (&rest args))
-(declare-function org-edit-src-code "org-src"
- (&optional context code edit-buffer-name))
-(declare-function org-edit-src-exit "org-src" (&optional context))
-(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
-(declare-function org-outline-overlay-data "org" (&optional use-markers))
-(declare-function org-set-outline-overlay-data "org" (data))
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-entry-get "org"
- (pom property &optional inherit literal-nil))
-(declare-function org-make-options-regexp "org" (kwds &optional extra))
-(declare-function org-do-remove-indentation "org" (&optional n))
(declare-function org-next-block "org" (arg &optional backward block-regexp))
+(declare-function org-number-sequence "org-compat" (from &optional to inc))
+(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer))
+(declare-function org-outline-overlay-data "org" (&optional use-markers))
(declare-function org-previous-block "org" (arg &optional block-regexp))
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-reverse-string "org" (string))
+(declare-function org-set-outline-overlay-data "org" (data))
(declare-function org-show-context "org" (&optional key))
-(declare-function org-at-table-p "org" (&optional table-type))
-(declare-function org-cycle "org" (&optional arg))
-(declare-function org-uniquify "org" (list))
-(declare-function org-current-level "org" ())
-(declare-function org-table-import "org-table" (file arg))
-(declare-function org-add-hook "org-compat"
- (hook function &optional append local))
+(declare-function org-src-coderef-format "org-src" (element))
+(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-table-align "org-table" ())
(declare-function org-table-end "org-table" (&optional table-type))
-(declare-function orgtbl-to-generic "org-table"
- (table params &optional backend))
-(declare-function orgtbl-to-orgtbl "org-table" (table params))
-(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info))
-(declare-function org-babel-lob-get-info "ob-lob" nil)
-(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
-(declare-function org-babel-ref-parse "ob-ref" (assignment))
-(declare-function org-babel-ref-resolve "ob-ref" (ref))
-(declare-function org-babel-ref-goto-headline-id "ob-ref" (id))
-(declare-function org-babel-ref-headline-body "ob-ref" ())
-(declare-function org-babel-lob-execute-maybe "ob-lob" ())
-(declare-function org-number-sequence "org-compat" (from &optional to inc))
-(declare-function org-at-item-p "org-list" ())
-(declare-function org-list-parse-list "org-list" (&optional delete))
-(declare-function org-list-to-generic "org-list" (LIST PARAMS))
-(declare-function org-list-struct "org-list" ())
-(declare-function org-list-prevs-alist "org-list" (struct))
-(declare-function org-list-get-list-end "org-list" (item struct prevs))
-(declare-function org-remove-if "org" (predicate seq))
-(declare-function org-completing-read "org" (&rest args))
-(declare-function org-escape-code-in-region "org-src" (beg end))
-(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-table-import "org-table" (file arg))
(declare-function org-table-to-lisp "org-table" (&optional txt))
-(declare-function org-reverse-string "org" (string))
-(declare-function org-element-context "org-element" (&optional ELEMENT))
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function org-unescape-code-in-string "org-src" (s))
+(declare-function org-uniquify "org" (list))
+(declare-function orgtbl-to-generic "org-table" (table params))
+(declare-function orgtbl-to-orgtbl "org-table" (table params))
+(declare-function outline-show-all "outline" ())
+(declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@@ -101,11 +103,12 @@
(defcustom org-confirm-babel-evaluate t
"Confirm before evaluation.
+\\<org-mode-map>\
Require confirmation before interactively evaluating code
-blocks in Org-mode buffers. The default value of this variable
-is t, meaning confirmation is required for any code block
-evaluation. This variable can be set to nil to inhibit any
-future confirmation requests. This variable can also be set to a
+blocks in Org buffers. The default value of this variable is t,
+meaning confirmation is required for any code block evaluation.
+This variable can be set to nil to inhibit any future
+confirmation requests. This variable can also be set to a
function which takes two arguments the language of the code block
and the body of the code block. Such a function should then
return a non-nil value if the user should be prompted for
@@ -113,10 +116,11 @@ execution or nil if no prompt is required.
Warning: Disabling confirmation may result in accidental
evaluation of potentially harmful code. It may be advisable
-remove code block execution from C-c C-c as further protection
+remove code block execution from `\\[org-ctrl-c-ctrl-c]' \
+as further protection
against accidental code block evaluation. The
`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to
-remove code block execution from the C-c C-c keybinding."
+remove code block execution from the `\\[org-ctrl-c-ctrl-c]' keybinding."
:group 'org-babel
:version "24.1"
:type '(choice boolean function))
@@ -124,19 +128,24 @@ remove code block execution from the C-c C-c keybinding."
(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t)))
(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil
- "Remove code block evaluation from the C-c C-c key binding."
+ "\\<org-mode-map>\
+Remove code block evaluation from the `\\[org-ctrl-c-ctrl-c]' key binding."
:group 'org-babel
:version "24.1"
:type 'boolean)
(defcustom org-babel-results-keyword "RESULTS"
"Keyword used to name results generated by code blocks.
-Should be either RESULTS or NAME however any capitalization may
-be used."
+It should be \"RESULTS\". However any capitalization may be
+used."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type 'string
+ :safe (lambda (v)
+ (and (stringp v)
+ (eq (compare-strings "RESULTS" nil nil v nil nil t)
+ t))))
(defcustom org-babel-noweb-wrap-start "<<"
"String used to begin a noweb reference in a code block.
@@ -155,6 +164,27 @@ See also `org-babel-noweb-wrap-start'."
This string must include a \"%s\" which will be replaced by the results."
:group 'org-babel
:type 'string)
+(put 'org-babel-inline-result-wrap
+ 'safe-local-variable
+ (lambda (value)
+ (and (stringp value)
+ (string-match-p "%s" value))))
+
+(defcustom org-babel-hash-show-time nil
+ "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)
+
+(defcustom org-babel-uppercase-example-markers nil
+ "When non-nil, begin/end example markers will be inserted in upper case."
+ :group 'org-babel
+ :type 'boolean
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe #'booleanp)
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
@@ -169,14 +199,6 @@ This string must include a \"%s\" which will be replaced by the results."
"^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$"
"Regular expression used to match multi-line header arguments.")
-(defvar org-babel-src-name-w-name-regexp
- (concat org-babel-src-name-regexp
- "\\("
- org-babel-multi-line-header-regexp
- "\\)*"
- "\\([^ ()\f\t\n\r\v]+\\)")
- "Regular expression matching source name lines with a name.")
-
(defvar org-babel-src-block-regexp
(concat
;; (1) indentation (2) lang
@@ -189,168 +211,98 @@ This string must include a \"%s\" which will be replaced by the results."
"\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
"Regexp used to identify code blocks.")
-(defvar org-babel-inline-src-block-regexp
- (concat
- ;; (1) replacement target (2) lang
- "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)"
- ;; (3,4) (unused, headers)
- "\\(\\|\\[\\(.*?\\)\\]\\)"
- ;; (5) body
- "{\\([^\f\n\r\v]+?\\)}\\)")
- "Regexp used to identify inline src-blocks.")
-
-(defun org-babel-get-header (params key &optional others)
- "Select only header argument of type KEY from a list.
-Optional argument OTHERS indicates that only the header that do
-not match KEY should be returned."
- (delq nil
- (mapcar
- (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p))
- params)))
-
-(defun org-babel-get-inline-src-block-matches()
- "Set match data if within body of an inline source block.
-Returns non-nil if match-data set"
- (let ((src-at-0-p (save-excursion
- (beginning-of-line 1)
- (string= "src" (thing-at-point 'word))))
- (first-line-p (= (line-beginning-position) (point-min)))
- (orig (point)))
- (let ((search-for (cond ((and src-at-0-p first-line-p "src_"))
- (first-line-p "[[:punct:] \t]src_")
- (t "[[:punct:] \f\t\n\r\v]src_")))
- (lower-limit (if first-line-p
- nil
- (- (point-at-bol) 1))))
- (save-excursion
- (when (or (and src-at-0-p (bobp))
- (and (re-search-forward "}" (point-at-eol) t)
- (re-search-backward search-for lower-limit t)
- (> orig (point))))
- (when (looking-at org-babel-inline-src-block-regexp)
- t ))))))
-
-(defvar org-babel-inline-lob-one-liner-regexp)
-(defun org-babel-get-lob-one-liner-matches()
- "Set match data if on line of an lob one liner.
-Returns non-nil if match-data set"
- (save-excursion
- (unless (= (point) (point-at-bol)) ;; move before inline block
- (re-search-backward "[ \f\t\n\r\v]" nil t))
- (if (looking-at org-babel-inline-lob-one-liner-regexp)
- t
- nil)))
-
-(defun org-babel-get-src-block-info (&optional light)
- "Get information on the current source block.
-
-Optional argument LIGHT does not resolve remote variable
-references; a process which could likely result in the execution
-of other code blocks.
+(defun org-babel--get-vars (params)
+ "Return the babel variable assignments in PARAMS.
+
+PARAMS is a quasi-alist of header args, which may contain
+multiple entries for the key `:var'. This function returns a
+list of the cdr of all the `:var' entries."
+ (mapcar #'cdr
+ (cl-remove-if-not (lambda (x) (eq (car x) :var)) params)))
+
+(defvar org-babel-exp-reference-buffer nil
+ "Buffer containing original contents of the exported buffer.
+This is used by Babel to resolve references in source blocks.
+Its value is dynamically bound during export.")
+
+(defun org-babel-check-confirm-evaluate (info)
+ "Check whether INFO allows code block evaluation.
+
+Returns nil if evaluation is disallowed, t if it is
+unconditionally allowed, and the symbol `query' if the user
+should be asked whether to allow evaluation."
+ (let* ((headers (nth 2 info))
+ (eval (or (cdr (assq :eval headers))
+ (when (assq :noeval headers) "no")))
+ (eval-no (member eval '("no" "never")))
+ (export org-babel-exp-reference-buffer)
+ (eval-no-export (and export (member eval '("no-export" "never-export"))))
+ (noeval (or eval-no eval-no-export))
+ (query (or (equal eval "query")
+ (and export (equal eval "query-export"))
+ (if (functionp org-confirm-babel-evaluate)
+ (funcall org-confirm-babel-evaluate
+ ;; Language, code block body.
+ (nth 0 info) (nth 1 info))
+ org-confirm-babel-evaluate))))
+ (cond
+ (noeval nil)
+ (query 'query)
+ (t t))))
-Returns a list
- (language body header-arguments-alist switches name indent block-head)."
- (let ((case-fold-search t) head info name indent)
- ;; full code block
- (if (setq head (org-babel-where-is-src-block-head))
- (save-excursion
- (goto-char head)
- (setq info (org-babel-parse-src-block-match))
- (setq indent (car (last info)))
- (setq info (butlast info))
- (while (and (forward-line -1)
- (looking-at org-babel-multi-line-header-regexp))
- (setf (nth 2 info)
- (org-babel-merge-params
- (nth 2 info)
- (org-babel-parse-header-arguments (match-string 1)))))
- (when (looking-at org-babel-src-name-w-name-regexp)
- (setq name (org-no-properties (match-string 3)))))
- ;; inline source block
- (when (org-babel-get-inline-src-block-matches)
- (setq info (org-babel-parse-inline-src-block-match))))
- ;; resolve variable references and add summary parameters
- (when (and info (not light))
- (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
- (when info (append info (list name indent head)))))
-
-(defvar org-current-export-file) ; dynamically bound
-(defmacro org-babel-check-confirm-evaluate (info &rest body)
- "Evaluate BODY with special execution confirmation variables set.
-
-Specifically; NOEVAL will indicate if evaluation is allowed,
-QUERY will indicate if a user query is required, CODE-BLOCK will
-hold the language of the code block, and BLOCK-NAME will hold the
-name of the code block."
- (declare (indent defun))
- (org-with-gensyms
- (lang block-body headers name eval eval-no export eval-no-export)
- `(let* ((,lang (nth 0 ,info))
- (,block-body (nth 1 ,info))
- (,headers (nth 2 ,info))
- (,name (nth 4 ,info))
- (,eval (or (cdr (assoc :eval ,headers))
- (when (assoc :noeval ,headers) "no")))
- (,eval-no (or (equal ,eval "no")
- (equal ,eval "never")))
- (,export (org-bound-and-true-p org-current-export-file))
- (,eval-no-export (and ,export (or (equal ,eval "no-export")
- (equal ,eval "never-export"))))
- (noeval (or ,eval-no ,eval-no-export))
- (query (or (equal ,eval "query")
- (and ,export (equal ,eval "query-export"))
- (if (functionp org-confirm-babel-evaluate)
- (funcall org-confirm-babel-evaluate
- ,lang ,block-body)
- org-confirm-babel-evaluate)))
- (code-block (if ,info (format " %s " ,lang) " "))
- (block-name (if ,name (format " (%s) " ,name) " ")))
- ;; Silence byte-compiler is `body' doesn't use those vars.
- (ignore noeval query)
- ,@body)))
-
-(defsubst org-babel-check-evaluate (info)
+(defun org-babel-check-evaluate (info)
"Check if code block INFO should be evaluated.
-Do not query the user."
- (org-babel-check-confirm-evaluate info
- (not (when noeval
- (message "Evaluation of this%scode-block%sis disabled."
- code-block block-name)))))
-
- ;; dynamically scoped for asynchronous export
+Do not query the user, but do display an informative message if
+evaluation is blocked. Returns non-nil if evaluation is not blocked."
+ (let ((confirmed (org-babel-check-confirm-evaluate info)))
+ (unless confirmed
+ (message "Evaluation of this %s code block%sis disabled."
+ (nth 0 info)
+ (let ((name (nth 4 info)))
+ (if name (format " (%s) " name) " "))))
+ confirmed))
+
+;; Dynamically scoped for asynchronous export.
(defvar org-babel-confirm-evaluate-answer-no)
-(defsubst org-babel-confirm-evaluate (info)
+(defun org-babel-confirm-evaluate (info)
"Confirm evaluation of the code block INFO.
-If the variable `org-babel-confirm-evaluate-answer-no' is bound
-to a non-nil value, auto-answer with \"no\".
-
This query can also be suppressed by setting the value of
`org-confirm-babel-evaluate' to nil, in which case all future
interactive code block evaluations will proceed without any
confirmation from the user.
Note disabling confirmation may result in accidental evaluation
-of potentially harmful code."
- (org-babel-check-confirm-evaluate info
- (not (when query
- (unless
- (and (not (org-bound-and-true-p
+of potentially harmful code.
+
+The variable `org-babel-confirm-evaluate-answer-no' is used by
+the async export process, which requires a non-interactive
+environment, to override this check."
+ (let* ((evalp (org-babel-check-confirm-evaluate info))
+ (lang (nth 0 info))
+ (name (nth 4 info))
+ (name-string (if name (format " (%s) " name) " ")))
+ (pcase evalp
+ (`nil nil)
+ (`t t)
+ (`query (or
+ (and (not (bound-and-true-p
org-babel-confirm-evaluate-answer-no))
(yes-or-no-p
- (format "Evaluate this%scode block%son your system? "
- code-block block-name)))
- (message "Evaluation of this%scode-block%sis aborted."
- code-block block-name))))))
+ (format "Evaluate this %s code block%son your system? "
+ lang name-string)))
+ (progn
+ (message "Evaluation of this %s code block%sis aborted."
+ lang name-string)
+ nil)))
+ (x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x)))))
;;;###autoload
(defun org-babel-execute-safely-maybe ()
(unless org-babel-no-eval-on-ctrl-c-ctrl-c
(org-babel-execute-maybe)))
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe)
-
;;;###autoload
(defun org-babel-execute-maybe ()
(interactive)
@@ -361,8 +313,8 @@ of potentially harmful code."
"Execute BODY if point is in a source block and return t.
Otherwise do nothing and return nil."
- `(if (or (org-babel-where-is-src-block-head)
- (org-babel-get-inline-src-block-matches))
+ `(if (memq (org-element-type (org-element-context))
+ '(inline-src-block src-block))
(progn
,@body
t)
@@ -394,12 +346,16 @@ a window into the `org-babel-get-src-block-info' function."
(header-args (nth 2 info)))
(when name (funcall printf "Name: %s\n" name))
(when lang (funcall printf "Lang: %s\n" lang))
+ (funcall printf "Properties:\n")
+ (funcall printf "\t:header-args \t%s\n" (org-entry-get (point) "header-args" t))
+ (funcall printf "\t:header-args:%s \t%s\n" lang (org-entry-get (point) (concat "header-args:" lang) t))
+
(when (funcall full switches) (funcall printf "Switches: %s\n" switches))
(funcall printf "Header Arguments:\n")
(dolist (pair (sort header-args
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
- (when (funcall full (cdr pair))
+ (when (funcall full (format "%s" (cdr pair)))
(funcall printf "\t%S%s\t%s\n"
(car pair)
(if (> (length (format "%S" (car pair))) 7) "" "\t")
@@ -442,11 +398,13 @@ then run `org-babel-switch-to-session'."
(colnames . ((nil no yes)))
(comments . ((no link yes org both noweb)))
(dir . :any)
- (eval . ((never query)))
+ (eval . ((yes no no-export strip-export never-export eval never
+ query)))
(exports . ((code results both none)))
(epilogue . :any)
(file . :any)
(file-desc . :any)
+ (file-ext . :any)
(hlines . ((no yes)))
(mkdirp . ((yes no)))
(no-expand)
@@ -454,6 +412,7 @@ then run `org-babel-switch-to-session'."
(noweb . ((yes no tangle no-export strip-export)))
(noweb-ref . :any)
(noweb-sep . :any)
+ (output-dir . :any)
(padline . ((yes no)))
(post . :any)
(prologue . :any)
@@ -476,31 +435,76 @@ then run `org-babel-switch-to-session'."
Note that individual languages may define their own language
specific header arguments as well.")
+(defconst org-babel-safe-header-args
+ '(:cache :colnames :comments :exports :epilogue :hlines :noeval
+ :noweb :noweb-ref :noweb-sep :padline :prologue :rownames
+ :sep :session :tangle :wrap
+ (:eval . ("never" "query"))
+ (:results . (lambda (str) (not (string-match "file" str)))))
+ "A list of safe header arguments for babel source blocks.
+
+The list can have entries of the following forms:
+- :ARG -> :ARG is always a safe header arg
+- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is
+ `equal' to one of the VALs.
+- (:ARG . FN) -> :ARG is safe as a header arg if the function FN
+ returns non-nil. FN is passed one
+ argument, the value of the header arg
+ (as a string).")
+
+(defmacro org-babel-header-args-safe-fn (safe-list)
+ "Return a function that determines whether a list of header args are safe.
+
+Intended usage is:
+\(put \\='org-babel-default-header-args \\='safe-local-variable
+ (org-babel-header-args-safe-p org-babel-safe-header-args)
+
+This allows org-babel languages to extend the list of safe values for
+their `org-babel-default-header-args:foo' variable.
+
+For the format of SAFE-LIST, see `org-babel-safe-header-args'."
+ `(lambda (value)
+ (and (listp value)
+ (cl-every
+ (lambda (pair)
+ (and (consp pair)
+ (org-babel-one-header-arg-safe-p pair ,safe-list)))
+ value))))
+
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code")
(:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
"Default arguments to use when evaluating a source block.")
+(put 'org-babel-default-header-args 'safe-local-variable
+ (org-babel-header-args-safe-fn org-babel-safe-header-args))
(defvar org-babel-default-inline-header-args
- '((:session . "none") (:results . "replace") (:exports . "results"))
+ '((:session . "none") (:results . "replace")
+ (:exports . "results") (:hlines . "yes"))
"Default arguments to use when evaluating an inline source block.")
-
-(defvar org-babel-data-names '("tblname" "results" "name"))
-
-(defvar org-babel-result-regexp
- (concat "^[ \t]*#\\+"
- (regexp-opt org-babel-data-names t)
- "\\(\\[\\("
- ;; FIXME The string below is `org-ts-regexp'
- "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>"
- " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*")
+(put 'org-babel-default-inline-header-args 'safe-local-variable
+ (org-babel-header-args-safe-fn org-babel-safe-header-args))
+
+(defconst org-babel-name-regexp
+ (format "^[ \t]*#\\+%s:[ \t]*"
+ ;; FIXME: TBLNAME is for backward compatibility.
+ (regexp-opt '("NAME" "TBLNAME")))
+ "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\\}\\)>")
"Regular expression used to match result lines.
If the results are associated with a hash key then the hash will
-be saved in the second match data.")
+be saved in match group 1.")
-(defvar org-babel-result-w-name-regexp
- (concat org-babel-result-regexp
- "\\([^ ()\f\t\n\r\v]+\\)\\((\\(.*\\))\\|\\)"))
+(defconst org-babel-result-w-name-regexp
+ (concat org-babel-result-regexp "\\(?9:[^ \t\n\r\v\f]+\\)")
+ "Regexp matching a RESULTS keyword with a name.
+Name is saved in match group 9.")
(defvar org-babel-min-lines-for-block-output 10
"The minimum number of lines for block output.
@@ -510,33 +514,58 @@ block. Otherwise the output is marked as literal by inserting
colons at the starts of the lines. This variable only takes
effect if the :results output option is in effect.")
+(defvar org-babel-noweb-error-all-langs nil
+ "Raise errors when noweb references don't resolve.
+Also see `org-babel-noweb-error-langs' to control noweb errors on
+a language by language bases.")
+
(defvar org-babel-noweb-error-langs nil
"Languages for which Babel will raise literate programming errors.
List of languages for which errors should be raised when the
source code block satisfying a noweb reference in this language
-can not be resolved.")
+can not be resolved. Also see `org-babel-noweb-error-all-langs'
+to raise errors for all languages.")
(defvar org-babel-hash-show 4
"Number of initial characters to show of a hidden results hash.")
-(defvar org-babel-hash-show-time nil
- "Non-nil means show the time the code block was evaluated in the result hash.")
-
(defvar org-babel-after-execute-hook nil
"Hook for functions to be called after `org-babel-execute-src-block'")
-(defun org-babel-named-src-block-regexp-for-name (name)
- "This generates a regexp used to match a src block named NAME."
- (concat org-babel-src-name-regexp (regexp-quote name)
- "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*"
+(defun org-babel-named-src-block-regexp-for-name (&optional name)
+ "This generates a regexp used to match a src block named NAME.
+If NAME is nil, match any name. Matched name is then put in
+match group 9. Other match groups are defined in
+`org-babel-src-block-regexp'."
+ (concat org-babel-src-name-regexp
+ (concat (if name (regexp-quote name) "\\(?9:.*?\\)") "[ \t]*" )
+ "\\(?:\n[ \t]*#\\+\\S-+:.*\\)*?"
+ "\n"
(substring org-babel-src-block-regexp 1)))
(defun org-babel-named-data-regexp-for-name (name)
"This generates a regexp used to match data named NAME."
- (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)"))
+ (concat org-babel-name-regexp (regexp-quote name) "[ \t]*$"))
+
+(defun org-babel--normalize-body (datum)
+ "Normalize body for element or object DATUM.
+DATUM is a source block element or an inline source block object.
+Remove final newline character and spurious indentation."
+ (let* ((value (org-element-property :value datum))
+ (body (if (string-suffix-p "\n" value)
+ (substring value 0 -1)
+ value)))
+ (cond ((eq (org-element-type datum) 'inline-src-block)
+ ;; Newline characters and indentation in an inline
+ ;; src-block are not meaningful, since they could come from
+ ;; some paragraph filling. Treat them as a white space.
+ (replace-regexp-in-string "\n[ \t]*" " " body))
+ ((or org-src-preserve-indentation
+ (org-element-property :preserve-indent datum))
+ body)
+ (t (org-remove-indentation body)))))
;;; functions
-(defvar call-process-region)
(defvar org-babel-current-src-block-location nil
"Marker pointing to the src block currently being executed.
This may also point to a call line or an inline code block. If
@@ -546,6 +575,56 @@ the outer-most code block.")
(defvar *this*)
+(defun org-babel-get-src-block-info (&optional light datum)
+ "Extract information from a source block or inline source block.
+
+Optional argument LIGHT does not resolve remote variable
+references; a process which could likely result in the execution
+of other code blocks.
+
+By default, consider the block at point. However, when optional
+argument DATUM is provided, extract information from that parsed
+object instead.
+
+Return nil if point is not on a source block. Otherwise, return
+a list with the following pattern:
+
+ (language body arguments switches name start coderef)"
+ (let* ((datum (or datum (org-element-context)))
+ (type (org-element-type datum))
+ (inline (eq type 'inline-src-block)))
+ (when (memq type '(inline-src-block src-block))
+ (let* ((lang (org-element-property :language datum))
+ (lang-headers (intern
+ (concat "org-babel-default-header-args:" lang)))
+ (name (org-element-property :name datum))
+ (info
+ (list
+ lang
+ (org-babel--normalize-body datum)
+ (apply #'org-babel-merge-params
+ (if inline org-babel-default-inline-header-args
+ org-babel-default-header-args)
+ (and (boundp lang-headers) (eval lang-headers t))
+ (append
+ ;; If DATUM is provided, make sure we get node
+ ;; properties applicable to its location within
+ ;; the document.
+ (org-with-point-at (org-element-property :begin datum)
+ (org-babel-params-from-properties lang))
+ (mapcar #'org-babel-parse-header-arguments
+ (cons (org-element-property :parameters datum)
+ (org-element-property :header datum)))))
+ (or (org-element-property :switches datum) "")
+ name
+ (org-element-property (if inline :begin :post-affiliated)
+ datum)
+ (and (not inline) (org-src-coderef-format datum)))))
+ (unless light
+ (setf (nth 2 info) (org-babel-process-params (nth 2 info))))
+ (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info)))
+ info))))
+
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
"Execute the current source code block.
@@ -565,110 +644,91 @@ block."
(interactive)
(let* ((org-babel-current-src-block-location
(or org-babel-current-src-block-location
- (nth 6 info)
+ (nth 5 info)
(org-babel-where-is-src-block-head)))
- (info (if info
- (copy-tree info)
- (org-babel-get-src-block-info)))
- (merged-params (org-babel-merge-params (nth 2 info) params)))
- (when (org-babel-check-evaluate
- (let ((i info)) (setf (nth 2 i) merged-params) i))
- (let* ((params (if params
- (org-babel-process-params merged-params)
- (nth 2 info)))
- (cachep (and (not arg) (cdr (assoc :cache params))
- (string= "yes" (cdr (assoc :cache params)))))
- (new-hash (when cachep (org-babel-sha1-hash info)))
- (old-hash (when cachep (org-babel-current-result-hash)))
- (cache-current-p (and (not arg) new-hash
- (equal new-hash old-hash))))
+ (info (if info (copy-tree info) (org-babel-get-src-block-info))))
+ ;; Merge PARAMS with INFO before considering source block
+ ;; evaluation since both could disagree.
+ (cl-callf org-babel-merge-params (nth 2 info) params)
+ (when (org-babel-check-evaluate info)
+ (cl-callf org-babel-process-params (nth 2 info))
+ (let* ((params (nth 2 info))
+ (cache (let ((c (cdr (assq :cache params))))
+ (and (not arg) c (string= "yes" c))))
+ (new-hash (and cache (org-babel-sha1-hash info)))
+ (old-hash (and cache (org-babel-current-result-hash)))
+ (current-cache (and new-hash (equal new-hash old-hash))))
(cond
- (cache-current-p
- (save-excursion ;; return cached result
+ (current-cache
+ (save-excursion ;Return cached result.
(goto-char (org-babel-where-is-src-block-result nil info))
- (end-of-line 1) (forward-char 1)
+ (forward-line)
+ (skip-chars-forward " \t")
(let ((result (org-babel-read-result)))
- (message (replace-regexp-in-string
- "%" "%%" (format "%S" result)))
- result)))
- ((org-babel-confirm-evaluate
- (let ((i info)) (setf (nth 2 i) merged-params) i))
+ (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
+ result)))
+ ((org-babel-confirm-evaluate info)
(let* ((lang (nth 0 info))
- (result-params (cdr (assoc :result-params params)))
- (body (setf (nth 1 info)
- (if (org-babel-noweb-p params :eval)
- (org-babel-expand-noweb-references info)
- (nth 1 info))))
- (dir (cdr (assoc :dir params)))
+ (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))))
+ (dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory (expand-file-name dir)))
default-directory))
- (org-babel-call-process-region-original ;; for tramp handler
- (or (org-bound-and-true-p
- org-babel-call-process-region-original)
- (symbol-function 'call-process-region)))
- (indent (nth 5 info))
- result cmd)
- (unwind-protect
- (let ((call-process-region
- (lambda (&rest args)
- (apply 'org-babel-tramp-handle-call-process-region
- args))))
- (let ((lang-check
- (lambda (f)
- (let ((f (intern (concat "org-babel-execute:" f))))
- (when (fboundp f) f)))))
- (setq cmd
- (or (funcall lang-check lang)
- (funcall lang-check
- (symbol-name
- (cdr (assoc lang org-src-lang-modes))))
- (error "No org-babel-execute function for %s!"
- lang))))
- (message "executing %s code block%s..."
- (capitalize lang)
- (if (nth 4 info) (format " (%s)" (nth 4 info)) ""))
- (if (member "none" result-params)
- (progn
- (funcall cmd body params)
- (message "result silenced")
- (setq result nil))
- (setq result
- (let ((result (funcall cmd body params)))
- (if (and (eq (cdr (assoc :result-type params))
- 'value)
- (or (member "vector" result-params)
- (member "table" result-params))
- (not (listp result)))
- (list (list result)) result)))
- ;; If non-empty result and :file then write to :file.
- (when (cdr (assoc :file params))
- (when result
- (with-temp-file (cdr (assoc :file params))
- (insert
- (org-babel-format-result
- result (cdr (assoc :sep (nth 2 info)))))))
- (setq result (cdr (assoc :file params))))
- ;; Possibly perform post process provided its appropriate.
- (when (cdr (assoc :post params))
- (let ((*this* (if (cdr (assoc :file params))
- (org-babel-result-to-file
- (cdr (assoc :file params))
- (when (assoc :file-desc params)
- (or (cdr (assoc :file-desc params))
- result)))
- result)))
- (setq result (org-babel-ref-resolve
- (cdr (assoc :post params))))
- (when (cdr (assoc :file params))
- (setq result-params
- (remove "file" result-params)))))
- (org-babel-insert-result
- result result-params info new-hash indent lang))
- (run-hooks 'org-babel-after-execute-hook)
- result)
- (setq call-process-region
- 'org-babel-call-process-region-original)))))))))
+ (cmd (intern (concat "org-babel-execute:" lang)))
+ result)
+ (unless (fboundp cmd)
+ (error "No org-babel-execute function for %s!" lang))
+ (message "executing %s code block%s..."
+ (capitalize lang)
+ (let ((name (nth 4 info)))
+ (if name (format " (%s)" name) "")))
+ (if (member "none" result-params)
+ (progn (funcall cmd body params)
+ (message "result silenced"))
+ (setq result
+ (let ((r (funcall cmd body params)))
+ (if (and (eq (cdr (assq :result-type params)) 'value)
+ (or (member "vector" result-params)
+ (member "table" result-params))
+ (not (listp r)))
+ (list (list r))
+ r)))
+ (let ((file (cdr (assq :file params))))
+ ;; If non-empty result and :file then write to :file.
+ (when file
+ (when result
+ (with-temp-file file
+ (insert (org-babel-format-result
+ result (cdr (assq :sep params))))))
+ (setq result file))
+ ;; Possibly perform post process provided its
+ ;; appropriate. Dynamically bind "*this*" to the
+ ;; actual results of the block.
+ (let ((post (cdr (assq :post params))))
+ (when post
+ (let ((*this* (if (not file) result
+ (org-babel-result-to-file
+ file
+ (let ((desc (assq :file-desc params)))
+ (and desc (or (cdr desc) result)))))))
+ (setq result (org-babel-ref-resolve post))
+ (when file
+ (setq result-params (remove "file" result-params))))))
+ (org-babel-insert-result
+ result result-params info new-hash lang)))
+ (run-hooks 'org-babel-after-execute-hook)
+ result)))))))
(defun org-babel-expand-body:generic (body params &optional var-lines)
"Expand BODY with PARAMS.
@@ -676,8 +736,8 @@ Expand a block of code with org-babel according to its header
arguments. This generic implementation of body expansion is
called for languages which have not defined their own specific
org-babel-expand-body:lang function."
- (let ((pro (cdr (assoc :prologue params)))
- (epi (cdr (assoc :epilogue params))))
+ (let ((pro (cdr (assq :prologue params)))
+ (epi (cdr (assq :epilogue params))))
(mapconcat #'identity
(append (when pro (list pro))
var-lines
@@ -708,10 +768,9 @@ arguments and pop open the results in a preview buffer."
(org-babel-expand-body:generic
body params (and (fboundp assignments-cmd)
(funcall assignments-cmd params))))))
- (if (org-called-interactively-p 'any)
+ (if (called-interactively-p 'any)
(org-edit-src-code
- nil expanded
- (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
+ expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*"))
expanded)))
(defun org-babel-edit-distance (s1 s2)
@@ -742,7 +801,7 @@ arguments and pop open the results in a preview buffer."
(dolist (arg-pair new-list)
(let ((header (car arg-pair)))
(setq results
- (cons arg-pair (org-remove-if
+ (cons arg-pair (cl-remove-if
(lambda (pair) (equal header (car pair)))
results))))))
results))
@@ -770,37 +829,43 @@ arguments and pop open the results in a preview buffer."
(message "No suspicious header arguments found.")))
;;;###autoload
-(defun org-babel-insert-header-arg ()
+(defun org-babel-insert-header-arg (&optional header-arg value)
"Insert a header argument selecting from lists of common args and values."
(interactive)
- (let* ((lang (car (org-babel-get-src-block-info 'light)))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (lang (car info))
+ (begin (nth 5 info))
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values
- (when (boundp lang-headers) (eval lang-headers))))
- (arg (org-icompleting-read
- "Header Arg: "
- (mapcar
- (lambda (header-spec) (symbol-name (car header-spec)))
- headers))))
- (insert ":" arg)
- (let ((vals (cdr (assoc (intern arg) headers))))
- (when vals
- (insert
- " "
- (cond
- ((eq vals :any)
- (read-from-minibuffer "value: "))
- ((listp vals)
- (mapconcat
- (lambda (group)
- (let ((arg (org-icompleting-read
- "value: "
- (cons "default" (mapcar #'symbol-name group)))))
- (if (and arg (not (string= "default" arg)))
- (concat arg " ")
- "")))
- vals ""))))))))
+ (when (boundp lang-headers) (eval lang-headers t))))
+ (header-arg (or header-arg
+ (completing-read
+ "Header Arg: "
+ (mapcar
+ (lambda (header-spec) (symbol-name (car header-spec)))
+ headers))))
+ (vals (cdr (assoc (intern header-arg) headers)))
+ (value (or value
+ (cond
+ ((eq vals :any)
+ (read-from-minibuffer "value: "))
+ ((listp vals)
+ (mapconcat
+ (lambda (group)
+ (let ((arg (completing-read
+ "Value: "
+ (cons "default"
+ (mapcar #'symbol-name group)))))
+ (if (and arg (not (string= "default" arg)))
+ (concat arg " ")
+ "")))
+ vals ""))))))
+ (save-excursion
+ (goto-char begin)
+ (goto-char (point-at-eol))
+ (unless (= (char-before (point)) ?\ ) (insert " "))
+ (insert ":" header-arg) (when value (insert " " value)))))
;; Add support for completing-read insertion of header arguments after ":"
(defun org-babel-header-arg-expand ()
@@ -811,7 +876,7 @@ arguments and pop open the results in a preview buffer."
(defun org-babel-enter-header-arg-w-completion (&optional lang)
"Insert header argument appropriate for LANG with completion."
(let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang)))
- (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var)))
+ (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t)))
(headers-w-values (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values lang-headers))
(headers (mapcar #'symbol-name (mapcar #'car headers-w-values)))
@@ -842,8 +907,8 @@ session."
(if (org-babel-noweb-p params :eval)
(org-babel-expand-noweb-references info)
(nth 1 info)))))
- (session (cdr (assoc :session params)))
- (dir (cdr (assoc :dir params)))
+ (session (cdr (assq :session params)))
+ (dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(cmd (intern (concat "org-babel-load-session:" lang))))
@@ -863,17 +928,17 @@ the session. Copy the body of the code block to the kill ring."
(lang (nth 0 info))
(body (nth 1 info))
(params (nth 2 info))
- (session (cdr (assoc :session params)))
- (dir (cdr (assoc :dir params)))
+ (session (cdr (assq :session params)))
+ (dir (cdr (assq :dir params)))
(default-directory
(or (and dir (file-name-as-directory dir)) default-directory))
(init-cmd (intern (format "org-babel-%s-initiate-session" lang)))
(prep-cmd (intern (concat "org-babel-prep-session:" lang))))
- (if (and (stringp session) (string= session "none"))
- (error "This block is not using a session!"))
+ (when (and (stringp session) (string= session "none"))
+ (error "This block is not using a session!"))
(unless (fboundp init-cmd)
(error "No org-babel-initiate-session function for %s!" lang))
- (with-temp-buffer (insert (org-babel-trim body))
+ (with-temp-buffer (insert (org-trim body))
(copy-region-as-kill (point-min) (point-max)))
(when arg
(unless (fboundp prep-cmd)
@@ -912,15 +977,15 @@ with a prefix argument then this is passed on to
(org-edit-src-code)
(funcall swap-windows)))
+;;;###autoload
(defmacro org-babel-do-in-edit-buffer (&rest body)
"Evaluate BODY in edit buffer if there is a code block at point.
Return t if a code block was found at point, nil otherwise."
`(let ((org-src-window-setup 'switch-invisibly))
(when (and (org-babel-where-is-src-block-head)
- (org-edit-src-code nil nil nil))
+ (org-edit-src-code))
(unwind-protect (progn ,@body)
- (if (org-bound-and-true-p org-edit-src-from-org-mode)
- (org-edit-src-exit)))
+ (org-edit-src-exit))
t)))
(def-edebug-spec org-babel-do-in-edit-buffer (body))
@@ -928,10 +993,10 @@ Return t if a code block was found at point, nil otherwise."
"Read key sequence and execute the command in edit buffer.
Enter a key sequence to be executed in the language major-mode
edit buffer. For example, TAB will alter the contents of the
-Org-mode code block according to the effect of TAB in the
-language major-mode buffer. For languages that support
-interactive sessions, this can be used to send code from the Org
-buffer to the session for evaluation using the native major-mode
+Org code block according to the effect of TAB in the language
+major mode buffer. For languages that support interactive
+sessions, this can be used to send code from the Org buffer
+to the session for evaluation using the native major mode
evaluation mechanisms."
(interactive "kEnter key-sequence to execute in edit buffer: ")
(org-babel-do-in-edit-buffer
@@ -941,7 +1006,7 @@ evaluation mechanisms."
(defvar org-bracket-link-regexp)
(defun org-babel-active-location-p ()
- (memq (car (save-match-data (org-element-context)))
+ (memq (org-element-type (save-match-data (org-element-context)))
'(babel-call inline-babel-call inline-src-block src-block)))
;;;###autoload
@@ -965,7 +1030,7 @@ results already exist."
;; file results
(org-open-at-point)
(let ((r (org-babel-format-result
- (org-babel-read-result) (cdr (assoc :sep (nth 2 info))))))
+ (org-babel-read-result) (cdr (assq :sep (nth 2 info))))))
(pop-to-buffer (get-buffer-create "*Org-Babel Results*"))
(delete-region (point-min) (point-max))
(insert r)))
@@ -995,7 +1060,8 @@ beg-body --------- point at the beginning of the body
end-body --------- point at the end of the body"
(declare (indent 1))
(let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
(visited-p (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
(point (point)) to-be-removed)
@@ -1035,80 +1101,91 @@ end-body --------- point at the end of the body"
;;;###autoload
(defmacro org-babel-map-inline-src-blocks (file &rest body)
- "Evaluate BODY forms on each inline source-block in FILE.
+ "Evaluate BODY forms on each inline source block in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
- (visited-p (or (null ,tempvar)
+ (declare (indent 1) (debug (form body)))
+ (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
+ (,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
+ (,point (point))
+ ,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
+ (setq ,to-be-removed (current-buffer))
(goto-char (point-min))
- (while (re-search-forward org-babel-inline-src-block-regexp nil t)
- (when (org-babel-active-location-p)
- (goto-char (match-beginning 1))
- (save-match-data ,@body))
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-inline-src-blocks (form body))
-
-(defvar org-babel-lob-one-liner-regexp)
+ (while (re-search-forward "src_\\S-" nil t)
+ (let ((,datum (save-match-data (org-element-context))))
+ (when (eq (org-element-type ,datum) 'inline-src-block)
+ (goto-char (match-beginning 0))
+ (let ((,end (copy-marker (org-element-property :end ,datum))))
+ ,@body
+ (goto-char ,end)
+ (set-marker ,end nil))))))
+ (unless ,visitedp (kill-buffer ,to-be-removed))
+ (goto-char ,point))))
;;;###autoload
(defmacro org-babel-map-call-lines (file &rest body)
"Evaluate BODY forms on each call line in FILE.
If FILE is nil evaluate BODY forms on source blocks in current
buffer."
- (declare (indent 1))
- (let ((tempvar (make-symbol "file")))
- `(let* ((,tempvar ,file)
- (visited-p (or (null ,tempvar)
+ (declare (indent 1) (debug (form body)))
+ (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
+ (,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
+ (,point (point))
+ ,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
+ (setq ,to-be-removed (current-buffer))
(goto-char (point-min))
- (while (re-search-forward org-babel-lob-one-liner-regexp nil t)
- (when (org-babel-active-location-p)
- (goto-char (match-beginning 1))
- (save-match-data ,@body))
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-call-lines (form body))
+ (while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t)
+ (let ((,datum (save-match-data (org-element-context))))
+ (when (memq (org-element-type ,datum)
+ '(babel-call inline-babel-call))
+ (goto-char (match-beginning 0))
+ (let ((,end (copy-marker (org-element-property :end ,datum))))
+ ,@body
+ (goto-char ,end)
+ (set-marker ,end nil))))))
+ (unless ,visitedp (kill-buffer ,to-be-removed))
+ (goto-char ,point))))
;;;###autoload
(defmacro org-babel-map-executables (file &rest body)
- (declare (indent 1))
- (let ((tempvar (make-symbol "file"))
- (rx (make-symbol "rx")))
- `(let* ((,tempvar ,file)
- (,rx (concat "\\(" org-babel-src-block-regexp
- "\\|" org-babel-inline-src-block-regexp
- "\\|" org-babel-lob-one-liner-regexp "\\)"))
- (visited-p (or (null ,tempvar)
+ "Evaluate BODY forms on each active Babel code in FILE.
+If FILE is nil evaluate BODY forms on source blocks in current
+buffer."
+ (declare (indent 1) (debug (form body)))
+ (org-with-gensyms (datum end point tempvar to-be-removed visitedp)
+ `(let* ((case-fold-search t)
+ (,tempvar ,file)
+ (,visitedp (or (null ,tempvar)
(get-file-buffer (expand-file-name ,tempvar))))
- (point (point)) to-be-removed)
+ (,point (point))
+ ,to-be-removed)
(save-window-excursion
(when ,tempvar (find-file ,tempvar))
- (setq to-be-removed (current-buffer))
+ (setq ,to-be-removed (current-buffer))
(goto-char (point-min))
- (while (re-search-forward ,rx nil t)
- (when (org-babel-active-location-p)
- (goto-char (match-beginning 1))
- (when (looking-at org-babel-inline-src-block-regexp)
- (forward-char 1))
- (save-match-data ,@body))
- (goto-char (match-end 0))))
- (unless visited-p (kill-buffer to-be-removed))
- (goto-char point))))
-(def-edebug-spec org-babel-map-executables (form body))
+ (while (re-search-forward
+ "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t)
+ (let ((,datum (save-match-data (org-element-context))))
+ (when (memq (org-element-type ,datum)
+ '(babel-call inline-babel-call inline-src-block
+ src-block))
+ (goto-char (match-beginning 0))
+ (let ((,end (copy-marker (org-element-property :end ,datum))))
+ ,@body
+ (goto-char ,end)
+ (set-marker ,end nil))))))
+ (unless ,visitedp (kill-buffer ,to-be-removed))
+ (goto-char ,point))))
;;;###autoload
(defun org-babel-execute-buffer (&optional arg)
@@ -1119,7 +1196,8 @@ the current buffer."
(org-babel-eval-wipe-error-buffer)
(org-save-outline-visibility t
(org-babel-map-executables nil
- (if (looking-at org-babel-lob-one-liner-regexp)
+ (if (memq (org-element-type (org-element-context))
+ '(babel-call inline-babel-call))
(org-babel-lob-execute-maybe)
(org-babel-execute-src-block arg)))))
@@ -1164,7 +1242,20 @@ the current subtree."
(member (car arg) '(:results :exports)))
(mapconcat #'identity (sort (funcall rm (split-string v))
#'string<) " "))
- (t v)))))))
+ (t v))))))
+ ;; expanded body
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (body (if (org-babel-noweb-p params :eval)
+ (org-babel-expand-noweb-references info) (nth 1 info)))
+ (expand-cmd (intern (concat "org-babel-expand-body:" lang)))
+ (assignments-cmd (intern (concat "org-babel-variable-assignments:"
+ lang)))
+ (expanded
+ (if (fboundp expand-cmd) (funcall expand-cmd body params)
+ (org-babel-expand-body:generic
+ body params (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
(let* ((it (format "%s-%s"
(mapconcat
#'identity
@@ -1173,26 +1264,32 @@ the current subtree."
(when normalized
(format "%S" normalized))))
(nth 2 info))) ":")
- (nth 1 info)))
+ expanded))
(hash (sha1 it)))
- (when (org-called-interactively-p 'interactive) (message hash))
+ (when (called-interactively-p 'interactive) (message hash))
hash))))
-(defun org-babel-current-result-hash ()
+(defun org-babel-current-result-hash (&optional info)
"Return the current in-buffer hash."
- (org-babel-where-is-src-block-result)
- (org-no-properties (match-string 5)))
+ (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)))))
-(defun org-babel-set-current-result-hash (hash)
+(defun org-babel-set-current-result-hash (hash info)
"Set the current in-buffer hash to HASH."
- (org-babel-where-is-src-block-result)
- (save-excursion (goto-char (match-beginning 5))
- (mapc #'delete-overlay (overlays-at (point)))
- (forward-char org-babel-hash-show)
- (mapc #'delete-overlay (overlays-at (point)))
- (replace-match hash nil nil nil 5)
- (goto-char (point-at-bol))
- (org-babel-hide-hash)))
+ (org-with-wide-buffer
+ (goto-char (org-babel-where-is-src-block-result nil info))
+ (looking-at org-babel-result-regexp)
+ (goto-char (match-beginning 1))
+ (mapc #'delete-overlay (overlays-at (point)))
+ (forward-char org-babel-hash-show)
+ (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 1)
+ (beginning-of-line)
+ (org-babel-hide-hash)))
(defun org-babel-hide-hash ()
"Hide the hash in the current results line.
@@ -1201,11 +1298,11 @@ 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)
- (match-string 5))
- (let* ((start (match-beginning 5))
+ (match-string 1))
+ (let* ((start (match-beginning 1))
(hide-start (+ org-babel-hash-show start))
- (end (match-end 5))
- (hash (match-string 5))
+ (end (match-end 1))
+ (hash (match-string 1))
ov1 ov2)
(setq ov1 (make-overlay start hide-start))
(setq ov2 (make-overlay hide-start end))
@@ -1227,14 +1324,14 @@ the `org-mode-hook'."
(defun org-babel-hash-at-point (&optional point)
"Return the value of the hash at POINT.
+\\<org-mode-map>\
The hash is also added as the last element of the kill ring.
-This can be called with C-c C-c."
+This can be called with `\\[org-ctrl-c-ctrl-c]'."
(interactive)
(let ((hash (car (delq nil (mapcar
(lambda (ol) (overlay-get ol 'babel-hash))
(overlays-at (or point (point))))))))
(when hash (kill-new hash) (message hash))))
-(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point)
(defun org-babel-result-hide-spec ()
"Hide portions of results lines.
@@ -1288,15 +1385,15 @@ portions of results lines."
(eq (overlay-get overlay 'invisible)
'org-babel-hide-result))
(overlays-at start)))
- (if (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)))
+ (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
@@ -1316,8 +1413,8 @@ portions of results lines."
(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe)
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
- (lambda () (org-add-hook 'change-major-mode-hook
- 'org-babel-show-result-all 'append 'local)))
+ (lambda () (add-hook 'change-major-mode-hook
+ 'org-babel-show-result-all 'append 'local)))
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
@@ -1326,122 +1423,98 @@ Return a list of association lists of source block params
specified in the properties of the current outline entry."
(save-match-data
(list
- ;; DEPRECATED header arguments specified as separate property at
- ;; point of definition
- (let (val sym)
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (header-arg)
- (and (setq val (org-entry-get (point) header-arg t))
- (cons (intern (concat ":" header-arg))
- (org-babel-read val))))
- (mapcar
- #'symbol-name
- (mapcar
- #'car
- (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (progn
- (setq sym (intern (concat "org-babel-header-args:" lang)))
- (and (boundp sym) (eval sym))))))))))
;; header arguments specified with the header-args property at
- ;; point of call
+ ;; point of call.
(org-babel-parse-header-arguments
(org-entry-get org-babel-current-src-block-location
- "header-args" 'inherit))
- (when lang ;; language-specific header arguments at point of call
- (org-babel-parse-header-arguments
- (org-entry-get org-babel-current-src-block-location
- (concat "header-args:" lang) 'inherit))))))
-
-(defvar org-src-preserve-indentation) ;; declare defcustom from org-src
-(defun org-babel-parse-src-block-match ()
- "Parse the results from a match of the `org-babel-src-block-regexp'."
- (let* ((block-indentation (length (match-string 1)))
- (lang (org-no-properties (match-string 2)))
- (lang-headers (intern (concat "org-babel-default-header-args:" lang)))
- (switches (match-string 3))
- (body (org-no-properties
- (let* ((body (match-string 5))
- (sub-length (- (length body) 1)))
- (if (and (> sub-length 0)
- (string= "\n" (substring body sub-length)))
- (substring body 0 sub-length)
- (or body "")))))
- (preserve-indentation (or org-src-preserve-indentation
- (save-match-data
- (string-match "-i\\>" switches)))))
- (list lang
- ;; get block body less properties, protective commas, and indentation
- (with-temp-buffer
- (save-match-data
- (insert (org-unescape-code-in-string body))
- (unless preserve-indentation (org-do-remove-indentation))
- (buffer-string)))
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- (when (boundp lang-headers) (eval lang-headers))
- (append
- (org-babel-params-from-properties lang)
- (list (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) ""))))))
- switches
- block-indentation)))
-
-(defun org-babel-parse-inline-src-block-match ()
- "Parse the results from a match of the `org-babel-inline-src-block-regexp'."
- (let* ((lang (org-no-properties (match-string 2)))
- (lang-headers (intern (concat "org-babel-default-header-args:" lang))))
- (list lang
- (org-unescape-code-in-string (org-no-properties (match-string 5)))
- (apply #'org-babel-merge-params
- org-babel-default-inline-header-args
- (if (boundp lang-headers) (eval lang-headers) nil)
- (append
- (org-babel-params-from-properties lang)
- (list (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) "")))))))))
+ "header-args"
+ 'inherit))
+ (and lang ; language-specific header arguments at point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ (concat "header-args:" lang)
+ 'inherit))))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
-ALTS is a cons of two character options where each option may be
-either the numeric code of a single character or a list of
-character alternatives. For example to split on balanced
-instances of \"[ \t]:\" set ALTS to ((32 9) . 58)."
- (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch))))
- (matched (lambda (ch last)
- (if (consp alts)
- (and (funcall matches ch (cdr alts))
- (funcall matches last (car alts)))
- (funcall matches ch alts))))
- (balance 0) (last 0)
- quote partial lst)
- (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]:
- (setq balance (+ balance
- (cond ((or (equal 91 ch) (equal 40 ch)) 1)
- ((or (equal 93 ch) (equal 41 ch)) -1)
- (t 0))))
- (when (and (equal 34 ch) (not (equal 92 last)))
- (setq quote (not quote)))
- (setq partial (cons ch partial))
- (when (and (= balance 0) (not quote) (funcall matched ch last))
- (setq lst (cons (apply #'string (nreverse
- (if (consp alts)
- (cddr partial)
- (cdr partial))))
- lst))
- (setq partial nil))
- (setq last ch))
- (string-to-list string))
- (nreverse (cons (apply #'string (nreverse partial)) lst))))
+ALTS is a character, or cons of two character options where each
+option may be either the numeric code of a single character or
+a list of character alternatives. For example, to split on
+balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)."
+ (with-temp-buffer
+ (insert string)
+ (goto-char (point-min))
+ (let ((splitp (lambda (past next)
+ ;; Non-nil when there should be a split after NEXT
+ ;; character. PAST is the character before NEXT.
+ (pcase alts
+ (`(,(and first (pred consp)) . ,(and second (pred consp)))
+ (and (memq past first) (memq next second)))
+ (`(,first . ,(and second (pred consp)))
+ (and (eq past first) (memq next second)))
+ (`(,(and first (pred consp)) . ,second)
+ (and (memq past first) (eq next second)))
+ (`(,first . ,second)
+ (and (eq past first) (eq next second)))
+ ((pred (eq next)) t)
+ (_ nil))))
+ (partial nil)
+ (result nil))
+ (while (not (eobp))
+ (cond
+ ((funcall splitp (char-before) (char-after))
+ ;; There is a split after point. If ALTS is two-folds,
+ ;; remove last parsed character as it belongs to ALTS.
+ (when (consp alts) (pop partial))
+ ;; Include elements parsed so far in RESULTS and flush
+ ;; partial parsing.
+ (when partial
+ (push (apply #'string (nreverse partial)) result)
+ (setq partial nil))
+ (forward-char))
+ ((memq (char-after) '(?\( ?\[))
+ ;; Include everything between balanced brackets.
+ (let* ((origin (point))
+ (after (char-after))
+ (openings (list after)))
+ (forward-char)
+ (while (and openings (re-search-forward "[]()]" nil t))
+ (pcase (char-before)
+ ((and match (or ?\[ ?\()) (push match openings))
+ (?\] (when (eq ?\[ (car openings)) (pop openings)))
+ (_ (when (eq ?\( (car openings)) (pop openings)))))
+ (if (null openings)
+ (setq partial
+ (nconc (nreverse (string-to-list
+ (buffer-substring origin (point))))
+ partial))
+ ;; Un-balanced bracket. Backtrack.
+ (push after partial)
+ (goto-char (1+ origin)))))
+ ((and (eq ?\" (char-after)) (not (eq ?\\ (char-before))))
+ ;; Include everything from current double quote to next
+ ;; non-escaped double quote.
+ (let ((origin (point)))
+ (if (re-search-forward "[^\\]\"" nil t)
+ (setq partial
+ (nconc (nreverse (string-to-list
+ (buffer-substring origin (point))))
+ partial))
+ ;; No closing double quote. Backtrack.
+ (push ?\" partial)
+ (forward-char))))
+ (t (push (char-after) partial)
+ (forward-char))))
+ ;; Add pending parsing and return result.
+ (when partial (push (apply #'string (nreverse partial)) result))
+ (nreverse result))))
(defun org-babel-join-splits-near-ch (ch list)
"Join splits where \"=\" is on either end of the split."
(let ((last= (lambda (str) (= ch (aref str (1- (length str))))))
(first= (lambda (str) (= ch (aref str 0)))))
(reverse
- (org-reduce (lambda (acc el)
+ (cl-reduce (lambda (acc el)
(let ((head (car acc)))
(if (and head (or (funcall last= head) (funcall first= el)))
(cons (concat head el) (cdr acc))
@@ -1474,7 +1547,7 @@ shown below.
(let (results)
(mapc (lambda (pair)
(if (eq (car pair) :var)
- (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results))
+ (mapcar (lambda (v) (push (cons :var (org-trim v)) results))
(org-babel-join-splits-near-ch
61 (org-babel-balanced-split (cdr pair) 32)))
(push pair results)))
@@ -1484,48 +1557,52 @@ shown below.
(defun org-babel-process-params (params)
"Expand variables in PARAMS and add summary parameters."
(let* ((processed-vars (mapcar (lambda (el)
- (if (consp (cdr el))
- (cdr el)
- (org-babel-ref-parse (cdr el))))
- (org-babel-get-header params :var)))
- (vars-and-names (if (and (assoc :colname-names params)
- (assoc :rowname-names params))
+ (if (consp el)
+ el
+ (org-babel-ref-parse el)))
+ (org-babel--get-vars params)))
+ (vars-and-names (if (and (assq :colname-names params)
+ (assq :rowname-names params))
(list processed-vars)
(org-babel-disassemble-tables
processed-vars
- (cdr (assoc :hlines params))
- (cdr (assoc :colnames params))
- (cdr (assoc :rownames params)))))
- (raw-result (or (cdr (assoc :results params)) ""))
- (result-params (append
- (split-string (if (stringp raw-result)
- raw-result
- (eval raw-result)))
- (cdr (assoc :result-params params)))))
+ (cdr (assq :hlines params))
+ (cdr (assq :colnames params))
+ (cdr (assq :rownames params)))))
+ (raw-result (or (cdr (assq :results params)) ""))
+ (result-params (delete-dups
+ (append
+ (split-string (if (stringp raw-result)
+ raw-result
+ (eval raw-result t)))
+ (cdr (assq :result-params params))))))
(append
(mapcar (lambda (var) (cons :var var)) (car vars-and-names))
(list
- (cons :colname-names (or (cdr (assoc :colname-names params))
+ (cons :colname-names (or (cdr (assq :colname-names params))
(cadr vars-and-names)))
- (cons :rowname-names (or (cdr (assoc :rowname-names params))
- (caddr vars-and-names)))
+ (cons :rowname-names (or (cdr (assq :rowname-names params))
+ (cl-caddr vars-and-names)))
(cons :result-params result-params)
(cons :result-type (cond ((member "output" result-params) 'output)
((member "value" result-params) 'value)
(t 'value))))
- (org-babel-get-header params :var 'other))))
+ (cl-remove-if
+ (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params
+ :result-type :var)))
+ params))))
;; row and column names
(defun org-babel-del-hlines (table)
"Remove all `hline's from TABLE."
- (remove 'hline table))
+ (remq 'hline table))
(defun org-babel-get-colnames (table)
"Return the column names of TABLE.
Return a cons cell, the `car' of which contains the TABLE less
colnames, and the `cdr' of which contains a list of the column
names."
- (if (equal 'hline (nth 1 table))
+ (if (eq 'hline (nth 1 table))
(cons (cddr table) (car table))
(cons (cdr table) (car table))))
@@ -1583,7 +1660,7 @@ of the vars, cnames and rnames."
(lambda (var)
(when (listp (cdr var))
(when (and (not (equal colnames "no"))
- (or colnames (and (equal (nth 1 (cdr var)) 'hline)
+ (or colnames (and (eq (nth 1 (cdr var)) 'hline)
(not (member 'hline (cddr (cdr var)))))))
(let ((both (org-babel-get-colnames (cdr var))))
(setq cnames (cons (cons (car var) (cdr both))
@@ -1612,35 +1689,26 @@ to the table for reinsertion to org-mode."
(org-babel-put-colnames table colnames) table))
table))
-(defun org-babel-where-is-src-block-head ()
+(defun org-babel-where-is-src-block-head (&optional src-block)
"Find where the current source block begins.
-Return the point at the beginning of the current source
-block. Specifically at the beginning of the #+BEGIN_SRC line.
+
+If optional argument SRC-BLOCK is `src-block' type element, find
+its current beginning instead.
+
+Return the point at the beginning of the current source block.
+Specifically at the beginning of the #+BEGIN_SRC line. Also set
+match-data relatively to `org-babel-src-block-regexp', which see.
If the point is not on a source block then return nil."
- (let ((initial (point)) (case-fold-search t) top bottom)
- (or
- (save-excursion ;; on a source name line or a #+header line
- (beginning-of-line 1)
- (and (or (looking-at org-babel-src-name-regexp)
- (looking-at org-babel-multi-line-header-regexp))
- (progn
- (while (and (forward-line 1)
- (or (looking-at org-babel-src-name-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (looking-at org-babel-src-block-regexp))
- (point)))
- (save-excursion ;; on a #+begin_src line
- (beginning-of-line 1)
- (and (looking-at org-babel-src-block-regexp)
- (point)))
- (save-excursion ;; inside a src block
- (and
- (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point))
- (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point))
- (< top initial) (< initial bottom)
- (progn (goto-char top) (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp))
- (point-marker))))))
+ (let ((element (or src-block (org-element-at-point))))
+ (when (eq (org-element-type element) 'src-block)
+ (let ((end (org-element-property :end element)))
+ (org-with-wide-buffer
+ ;; Ensure point is not on a blank line after the block.
+ (beginning-of-line)
+ (skip-chars-forward " \r\t\n" end)
+ (when (< (point) end)
+ (prog1 (goto-char (org-element-property :post-affiliated element))
+ (looking-at org-babel-src-block-regexp))))))))
;;;###autoload
(defun org-babel-goto-src-block-head ()
@@ -1655,90 +1723,90 @@ If the point is not on a source block then return nil."
(interactive
(let ((completion-ignore-case t)
(case-fold-search t)
- (under-point (thing-at-point 'line)))
- (list (org-icompleting-read
- "source-block name: " (org-babel-src-block-names) nil t
- (cond
- ;; noweb
- ((string-match (org-babel-noweb-wrap) under-point)
- (let ((block-name (match-string 1 under-point)))
- (string-match "[^(]*" block-name)
- (match-string 0 block-name)))
- ;; #+call:
- ((string-match org-babel-lob-one-liner-regexp under-point)
- (let ((source-info (car (org-babel-lob-get-info))))
- (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info)
- (let ((source-name (match-string 1 source-info)))
- source-name))))
- ;; #+results:
- ((string-match (concat "#\\+" org-babel-results-keyword
- "\\:\s+\\([^\\(]*\\)") under-point)
- (match-string 1 under-point))
- ;; symbol-at-point
- ((and (thing-at-point 'symbol))
- (org-babel-find-named-block (thing-at-point 'symbol))
- (thing-at-point 'symbol))
- (""))))))
+ (all-block-names (org-babel-src-block-names)))
+ (list (completing-read
+ "source-block name: " all-block-names nil t
+ (let* ((context (org-element-context))
+ (type (org-element-type context))
+ (noweb-ref
+ (and (memq type '(inline-src-block src-block))
+ (org-in-regexp (org-babel-noweb-wrap)))))
+ (cond
+ (noweb-ref
+ (buffer-substring
+ (+ (car noweb-ref) (length org-babel-noweb-wrap-start))
+ (- (cdr noweb-ref) (length org-babel-noweb-wrap-end))))
+ ((memq type '(babel-call inline-babel-call)) ;#+CALL:
+ (org-element-property :call context))
+ ((car (org-element-property :results context))) ;#+RESULTS:
+ ((let ((symbol (thing-at-point 'symbol))) ;Symbol.
+ (and symbol
+ (member-ignore-case symbol all-block-names)
+ symbol)))
+ (t "")))))))
(let ((point (org-babel-find-named-block name)))
(if point
- ;; taken from `org-open-at-point'
+ ;; Taken from `org-open-at-point'.
(progn (org-mark-ring-push) (goto-char point) (org-show-context))
(message "source-code block `%s' not found in this buffer" name))))
(defun org-babel-find-named-block (name)
"Find a named source-code block.
Return the location of the source block identified by source
-NAME, or nil if no such block exists. Set match data according to
-org-babel-named-src-block-regexp."
+NAME, or nil if no such block exists. Set match data according
+to `org-babel-named-src-block-regexp'."
(save-excursion
- (let ((case-fold-search t)
- (regexp (org-babel-named-src-block-regexp-for-name name)))
- (goto-char (point-min))
- (when (or (re-search-forward regexp nil t)
- (re-search-backward regexp nil t))
- (match-beginning 0)))))
+ (goto-char (point-min))
+ (let ((regexp (org-babel-named-src-block-regexp-for-name name)))
+ (or (and (looking-at regexp)
+ (progn (goto-char (match-beginning 1))
+ (line-beginning-position)))
+ (ignore-errors (org-next-block 1 nil regexp))))))
(defun org-babel-src-block-names (&optional file)
"Returns the names of source blocks in FILE or the current buffer."
- (save-excursion
- (when file (find-file file)) (goto-char (point-min))
- (let ((case-fold-search t) names)
- (while (re-search-forward org-babel-src-name-w-name-regexp nil t)
- (setq names (cons (match-string 3) names)))
- names)))
+ (with-current-buffer (if file (find-file-noselect file) (current-buffer))
+ (org-with-point-at 1
+ (let ((regexp "^[ \t]*#\\+begin_src ")
+ (case-fold-search t)
+ (names nil))
+ (while (re-search-forward regexp nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq 'src-block (org-element-type element))
+ (let ((name (org-element-property :name element)))
+ (when name (push name names))))))
+ names))))
;;;###autoload
(defun org-babel-goto-named-result (name)
"Go to a named result."
(interactive
(let ((completion-ignore-case t))
- (list (org-icompleting-read "source-block name: "
- (org-babel-result-names) nil t))))
+ (list (completing-read "Source-block name: "
+ (org-babel-result-names) nil t))))
(let ((point (org-babel-find-named-result name)))
(if point
;; taken from `org-open-at-point'
(progn (goto-char point) (org-show-context))
(message "result `%s' not found in this buffer" name))))
-(defun org-babel-find-named-result (name &optional point)
+(defun org-babel-find-named-result (name)
"Find a named result.
Return the location of the result named NAME in the current
buffer or nil if no such result exists."
(save-excursion
- (let ((case-fold-search t))
- (goto-char (or point (point-min)))
- (catch 'is-a-code-block
- (when (re-search-forward
- (concat org-babel-result-regexp
- "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]")
- nil t)
- (when (and (string= "name" (downcase (match-string 1)))
- (or (beginning-of-line 1)
- (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp)
- (looking-at org-babel-lob-one-liner-regexp)))
- (throw 'is-a-code-block (org-babel-find-named-result name (point))))
- (beginning-of-line 0) (point))))))
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$"
+ org-babel-results-keyword
+ (regexp-quote name))))
+ (catch :found
+ (while (re-search-forward re nil t)
+ (let ((element (org-element-at-point)))
+ (when (or (eq (org-element-type element) 'keyword)
+ (< (point)
+ (org-element-property :post-affiliated element)))
+ (throw :found (line-beginning-position)))))))))
(defun org-babel-result-names (&optional file)
"Returns the names of results in FILE or the current buffer."
@@ -1746,7 +1814,7 @@ buffer or nil if no such result exists."
(when file (find-file file)) (goto-char (point-min))
(let ((case-fold-search t) names)
(while (re-search-forward org-babel-result-w-name-regexp nil t)
- (setq names (cons (match-string 4) names)))
+ (setq names (cons (match-string-no-properties 9) names)))
names)))
;;;###autoload
@@ -1784,26 +1852,31 @@ split. When called from outside of a code block a new code block
is created. In both cases if the region is demarcated and if the
region is not active then the point is demarcated."
(interactive "P")
- (let ((info (org-babel-get-src-block-info 'light))
- (headers (progn (org-babel-where-is-src-block-head)
- (match-string 4)))
- (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
+ (let* ((info (org-babel-get-src-block-info 'light))
+ (start (org-babel-where-is-src-block-head))
+ (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
+ (let (case-fold-search)
+ (string-match-p "#\\+begin_src" block)))))
(if info
(mapc
(lambda (place)
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
- (indent (make-string (nth 5 info) ? )))
+ (indent (make-string (org-get-indentation) ?\s)))
(when (string-match "^[[:space:]]*$"
(buffer-substring (point-at-bol)
(point-at-eol)))
(delete-region (point-at-bol) (point-at-eol)))
(insert (concat
(if (looking-at "^") "" "\n")
- indent "#+end_src\n"
+ indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n")
(if arg stars indent) "\n"
- indent "#+begin_src " lang
+ indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ")
+ lang
(if (> (length headers) 1)
(concat " " headers) headers)
(if (looking-at "[\n\r]")
@@ -1812,7 +1885,7 @@ region is not active then the point is demarcated."
(move-end-of-line 2))
(sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
- (lang (org-icompleting-read
+ (lang (completing-read
"Lang: "
(mapcar #'symbol-name
(delete-dups
@@ -1823,134 +1896,222 @@ 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") "")
- "#+begin_src " lang "\n"
+ (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ")
+ lang "\n"
body
(if (or (= (length body) 0)
- (string-match "[\r\n]$" body)) "" "\n")
- "#+end_src\n"))
+ (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)))))
-(defvar org-babel-lob-one-liner-regexp)
-(defun org-babel-where-is-src-block-result (&optional insert info hash indent)
+(defun org-babel--insert-results-keyword (name hash)
+ "Insert RESULTS keyword with NAME value at point.
+If NAME is nil, results are anonymous. HASH is a string used as
+the results hash, or nil. Leave point before the keyword."
+ (save-excursion (insert "\n")) ;open line to indent.
+ (org-indent-line)
+ (delete-char 1)
+ (insert (concat "#+" org-babel-results-keyword
+ (cond ((not hash) nil)
+ (org-babel-hash-show-time
+ (format "[%s %s]"
+ (format-time-string "<%F %T>")
+ hash))
+ (t (format "[%s]" hash)))
+ ":"
+ (when name (concat " " name))
+ "\n"))
+ ;; Make sure results are going to be followed by at least one blank
+ ;; line so they do not get merged with the next element, e.g.,
+ ;;
+ ;; #+results:
+ ;; : 1
+ ;;
+ ;; : fixed-width area, unrelated to the above.
+ (unless (looking-at "^[ \t]*$") (save-excursion (insert "\n")))
+ (beginning-of-line 0)
+ (when hash (org-babel-hide-hash)))
+
+(defun org-babel--clear-results-maybe (hash)
+ "Clear results when hash doesn't match HASH.
+
+When results hash does not match HASH, remove RESULTS keyword at
+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)
+ (unless (string= (match-string 1) hash)
+ (let* ((e (org-element-at-point))
+ (post (copy-marker (org-element-property :post-affiliated e))))
+ ;; Delete contents.
+ (delete-region post
+ (save-excursion
+ (goto-char (org-element-property :end e))
+ (skip-chars-backward " \t\n")
+ (line-beginning-position 2)))
+ ;; Delete RESULT keyword. However, if RESULTS keyword is
+ ;; orphaned, ignore this part. The deletion above already
+ ;; took care of it.
+ (unless (= (point) post)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (goto-char post)
+ (set-marker post nil)
+ t))))
+
+(defun org-babel-where-is-src-block-result (&optional insert _info hash)
"Find where the current source block results begin.
+
Return the point at the beginning of the result of the current
-source block. Specifically at the beginning of the results line.
-If no result exists for this block then create a results line
-following the source block."
- (save-excursion
- (let* ((case-fold-search t)
- (on-lob-line (save-excursion
- (beginning-of-line 1)
- (looking-at org-babel-lob-one-liner-regexp)))
- (inlinep (when (org-babel-get-inline-src-block-matches)
- (match-end 0)))
- (name (nth 4 (or info (org-babel-get-src-block-info 'light))))
- (head (unless on-lob-line (org-babel-where-is-src-block-head)))
- found beg end)
- (when head (goto-char head))
+source block, specifically at the beginning of the results line.
+
+If no result exists for this block return nil, unless optional
+argument INSERT is non-nil. In this case, create a results line
+following the source block and return the position at its
+beginning. In the case of inline code, remove the results part
+instead.
+
+If optional argument HASH is a string, remove contents related to
+RESULTS keyword if its hash is different. Then update the latter
+to HASH."
+ (let ((context (org-element-context)))
+ (catch :found
(org-with-wide-buffer
- (setq
- found ;; was there a result (before we potentially insert one)
- (or
- inlinep
- (and
- ;; named results:
- ;; - return t if it is found, else return nil
- ;; - if it does not need to be rebuilt, then don't set end
- ;; - if it does need to be rebuilt then do set end
- name (setq beg (org-babel-find-named-result name))
- (prog1 beg
- (when (and hash (not (string= hash (match-string 5))))
- (goto-char beg) (setq end beg) ;; beginning of result
- (forward-line 1)
- (delete-region end (org-babel-result-end)) nil)))
- (and
- ;; unnamed results:
- ;; - return t if it is found, else return nil
- ;; - if it is found, and the hash doesn't match, delete and set end
- (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
- (progn (end-of-line 1)
- (if (eobp) (insert "\n") (forward-char 1))
- (setq end (point))
- (or (and
- (not name)
- (progn ;; unnamed results line already exists
- (catch 'non-comment
- (while (re-search-forward "[^ \f\t\n\r\v]" nil t)
- (beginning-of-line 1)
- (cond
- ((looking-at (concat org-babel-result-regexp "\n"))
- (throw 'non-comment t))
- ((looking-at "^[ \t]*#") (end-of-line 1))
- (t (throw 'non-comment nil))))))
- (let ((this-hash (match-string 5)))
- (prog1 (point)
- ;; must remove and rebuild if hash!=old-hash
- (if (and hash (not (string= hash this-hash)))
- (prog1 nil
- (forward-line 1)
- (delete-region
- end (org-babel-result-end)))
- (setq end nil)))))))))))
- (if (not (and insert end)) found
- (goto-char end)
- (unless beg
- (if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
- (insert (concat
- (when (wholenump indent) (make-string indent ? ))
- "#+" org-babel-results-keyword
- (when hash
- (if org-babel-hash-show-time
- (concat
- "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]")
- (concat "["hash"]")))
- ":"
- (when name (concat " " name)) "\n"))
- (unless beg (insert "\n") (backward-char))
- (beginning-of-line 0)
- (if hash (org-babel-hide-hash))
- (point)))))
-
-(defvar org-block-regexp)
+ (pcase (org-element-type context)
+ ((or `inline-babel-call `inline-src-block)
+ ;; Results for inline objects are located right after them.
+ ;; There is no RESULTS line to insert either.
+ (let ((limit (org-element-property
+ :contents-end (org-element-property :parent context))))
+ (goto-char (org-element-property :end context))
+ (skip-chars-forward " \t\n" limit)
+ (throw :found
+ (and
+ (< (point) limit)
+ (let ((result (org-element-context)))
+ (and (eq (org-element-type result) 'macro)
+ (string= (org-element-property :key result)
+ "results")
+ (if (not insert) (point)
+ (delete-region
+ (point)
+ (progn
+ (goto-char (org-element-property :end result))
+ (skip-chars-backward " \t")
+ (point)))
+ (point))))))))
+ ((or `babel-call `src-block)
+ (let* ((name (org-element-property :name context))
+ (named-results (and name (org-babel-find-named-result name))))
+ (goto-char (or named-results (org-element-property :end context)))
+ (cond
+ ;; Existing results named after the current source.
+ (named-results
+ (when (org-babel--clear-results-maybe hash)
+ (org-babel--insert-results-keyword name hash))
+ (throw :found (point)))
+ ;; Named results expect but none to be found.
+ (name)
+ ;; No possible anonymous results at the very end of
+ ;; buffer or outside CONTEXT parent.
+ ((eq (point)
+ (or (org-element-property
+ :contents-end (org-element-property :parent context))
+ (point-max))))
+ ;; Check if next element is an anonymous result below
+ ;; the current block.
+ ((let* ((next (org-element-at-point))
+ (end (save-excursion
+ (goto-char
+ (org-element-property :post-affiliated next))
+ (line-end-position)))
+ (empty-result-re (concat org-babel-result-regexp "$"))
+ (case-fold-search t))
+ (re-search-forward empty-result-re end t))
+ (beginning-of-line)
+ (when (org-babel--clear-results-maybe hash)
+ (org-babel--insert-results-keyword nil hash))
+ (throw :found (point))))))
+ ;; Ignore other elements.
+ (_ (throw :found nil))))
+ ;; No result found. Insert a RESULTS keyword below element, if
+ ;; appropriate. In this case, ensure there is an empty line
+ ;; after the previous element.
+ (when insert
+ (save-excursion
+ (goto-char (min (org-element-property :end context) (point-max)))
+ (skip-chars-backward " \t\n")
+ (forward-line)
+ (unless (bolp) (insert "\n"))
+ (insert "\n")
+ (org-babel--insert-results-keyword
+ (org-element-property :name context) hash)
+ (point))))))
+
+(defun org-babel-read-element (element)
+ "Read ELEMENT into emacs-lisp.
+Return nil if ELEMENT cannot be read."
+ (org-with-wide-buffer
+ (goto-char (org-element-property :post-affiliated element))
+ (pcase (org-element-type element)
+ (`fixed-width
+ (let ((v (org-trim (org-element-property :value element))))
+ (or (org-babel--string-to-number v) v)))
+ (`table (org-babel-read-table))
+ (`plain-list (org-babel-read-list))
+ (`example-block
+ (let ((v (org-element-property :value element)))
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent element))
+ v
+ (org-remove-indentation v))))
+ (`export-block
+ (org-remove-indentation (org-element-property :value element)))
+ (`paragraph
+ ;; Treat paragraphs containing a single link specially.
+ (skip-chars-forward " \t")
+ (if (and (looking-at org-bracket-link-regexp)
+ (save-excursion
+ (goto-char (match-end 0))
+ (skip-chars-forward " \r\t\n")
+ (<= (org-element-property :end element)
+ (point))))
+ (org-babel-read-link)
+ (buffer-substring-no-properties
+ (org-element-property :contents-begin element)
+ (org-element-property :contents-end element))))
+ ((or `center-block `quote-block `verse-block `special-block)
+ (org-remove-indentation
+ (buffer-substring-no-properties
+ (org-element-property :contents-begin element)
+ (org-element-property :contents-end element))))
+ (_ nil))))
+
(defun org-babel-read-result ()
- "Read the result at `point' into emacs-lisp."
- (let ((case-fold-search t) result-string)
- (cond
- ((org-at-table-p) (org-babel-read-table))
- ((org-at-item-p) (org-babel-read-list))
- ((looking-at org-bracket-link-regexp) (org-babel-read-link))
- ((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
- ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
- (setq result-string
- (org-babel-trim
- (mapconcat (lambda (line)
- (or (and (> (length line) 1)
- (string-match "^[ \t]*: ?\\(.+\\)" line)
- (match-string 1 line))
- ""))
- (split-string
- (buffer-substring
- (point) (org-babel-result-end)) "[\r\n]+")
- "\n")))
- (or (org-babel-number-p result-string) result-string))
- ((looking-at org-babel-result-regexp)
- (save-excursion (forward-line 1) (org-babel-read-result))))))
+ "Read the result at point into emacs-lisp."
+ (and (not (save-excursion
+ (beginning-of-line)
+ (looking-at-p "[ \t]*$")))
+ (org-babel-read-element (org-element-at-point))))
(defun org-babel-read-table ()
- "Read the table at `point' into emacs-lisp."
+ "Read the table at point into emacs-lisp."
(mapcar (lambda (row)
(if (and (symbolp row) (equal row 'hline)) row
(mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row)))
(org-table-to-lisp)))
(defun org-babel-read-list ()
- "Read the list at `point' into emacs-lisp."
+ "Read the list at point into emacs-lisp."
(mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval))
- (mapcar #'cadr (cdr (org-list-parse-list)))))
+ (cdr (org-list-to-lisp))))
(defvar org-link-types-re)
(defun org-babel-read-link ()
- "Read the link at `point' into emacs-lisp.
+ "Read the link at point into emacs-lisp.
If the path of the link is a file path it is expanded using
`expand-file-name'."
(let* ((case-fold-search t)
@@ -1975,225 +2136,344 @@ If the path of the link is a file path it is expanded using
;; scalar result
(funcall echo-res result))))
-(defun org-babel-insert-result
- (result &optional result-params info hash indent lang)
+(defun org-babel-insert-result (result &optional result-params info hash lang)
"Insert RESULT into the current buffer.
-By default RESULT is inserted after the end of the
-current source block. With optional argument RESULT-PARAMS
-controls insertion of results in the org-mode file.
-RESULT-PARAMS can take the following values:
+
+By default RESULT is inserted after the end of the current source
+block. The RESULT of an inline source block usually will be
+wrapped inside a `results' macro and placed on the same line as
+the inline source block. The macro is stripped upon export.
+Multiline and non-scalar RESULTS from inline source blocks are
+not allowed. With optional argument RESULT-PARAMS controls
+insertion of results in the Org mode file. RESULT-PARAMS can
+take the following values:
replace - (default option) insert results after the source block
- replacing any previously inserted results
+ or inline source block replacing any previously
+ inserted results.
-silent -- no results are inserted into the Org-mode buffer but
+silent -- no results are inserted into the Org buffer but
the results are echoed to the minibuffer and are
ingested by Emacs (a potentially time consuming
- process)
+ process).
file ---- the results are interpreted as a file path, and are
- inserted into the buffer using the Org-mode file syntax
+ inserted into the buffer using the Org file syntax.
-list ---- the results are interpreted as an Org-mode list.
+list ---- the results are interpreted as an Org list.
-raw ----- results are added directly to the Org-mode file. This
- is a good option if you code block will output org-mode
+raw ----- results are added directly to the Org file. This is
+ a good option if you code block will output Org
formatted text.
-drawer -- results are added directly to the Org-mode file as with
- \"raw\", but are wrapped in a RESULTS drawer, allowing
- them to later be replaced or removed automatically.
+drawer -- results are added directly to the Org file as with
+ \"raw\", but are wrapped in a RESULTS drawer or results
+ macro, allowing them to later be replaced or removed
+ automatically.
-org ----- results are added inside of a \"#+BEGIN_SRC org\" block.
- They are not comma-escaped when inserted, but Org syntax
- here will be discarded when exporting the file.
+org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC
+ org\" block depending on whether the current source block is
+ inline or not. They are not comma-escaped when inserted,
+ but Org syntax here will be discarded when exporting the
+ file.
-html ---- results are added inside of a #+BEGIN_HTML block. This
- is a good option if you code block will output html
- formatted text.
+html ---- results are added inside of a #+BEGIN_EXPORT HTML block
+ or html export snippet depending on whether the current
+ source block is inline or not. This is a good option
+ if your code block will output html formatted text.
-latex --- results are added inside of a #+BEGIN_LATEX block.
- This is a good option if you code block will output
- latex formatted text.
+latex --- results are added inside of a #+BEGIN_EXPORT LATEX
+ block or latex export snippet depending on whether the
+ current source block is inline or not. This is a good
+ option if your code block will output latex formatted
+ text.
code ---- the results are extracted in the syntax of the source
code of the language being evaluated and are added
- inside of a #+BEGIN_SRC block with the source-code
- language set appropriately. Note this relies on the
- optional LANG argument."
- (if (stringp result)
- (progn
- (setq result (org-no-properties result))
- (when (member "file" result-params)
- (setq result (org-babel-result-to-file
- result (when (assoc :file-desc (nth 2 info))
- (or (cdr (assoc :file-desc (nth 2 info)))
- result))))))
- (unless (listp result) (setq result (format "%S" result))))
+ inside of a source block with the source-code language
+ set appropriately. Also, source block inlining is
+ preserved in this case. Note this relies on the
+ optional LANG argument.
+
+list ---- the results are rendered as a list. This option not
+ allowed for inline src blocks.
+
+table --- the results are rendered as a table. This option not
+ allowed for inline src blocks.
+
+INFO may provide the values of these header arguments (in the
+`header-arguments-alist' see the docstring for
+`org-babel-get-src-block-info'):
+
+:file --- the name of the file to which output should be written.
+
+:wrap --- the effect is similar to `latex' in RESULT-PARAMS but
+ using the argument supplied to specify the export block
+ or snippet type."
+ (cond ((stringp result)
+ (setq result (org-no-properties result))
+ (when (member "file" result-params)
+ (setq result (org-babel-result-to-file
+ result (when (assq :file-desc (nth 2 info))
+ (or (cdr (assq :file-desc (nth 2 info)))
+ result))))))
+ ((listp result))
+ (t (setq result (format "%S" result))))
(if (and result-params (member "silent" result-params))
- (progn
- (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
- result)
- (save-excursion
- (let* ((inlinep
- (save-excursion
- (when (or (org-babel-get-inline-src-block-matches)
- (org-babel-get-lob-one-liner-matches))
- (goto-char (match-end 0))
- (insert (if (listp result) "\n" " "))
- (point))))
- (existing-result (unless inlinep
- (org-babel-where-is-src-block-result
- t info hash indent)))
- (results-switches
- (cdr (assoc :results_switches (nth 2 info))))
- (visible-beg (point-min-marker))
- (visible-end (point-max-marker))
- ;; When results exist outside of the current visible
- ;; region of the buffer, be sure to widen buffer to
- ;; update them.
- (outside-scope-p (and existing-result
+ (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result)))
+ result)
+ (let ((inline (let ((context (org-element-context)))
+ (and (memq (org-element-type context)
+ '(inline-babel-call inline-src-block))
+ context))))
+ (when inline
+ (let ((warning
+ (or (and (member "table" result-params) "`:results table'")
+ (and (listp result) "list result")
+ (and (string-match-p "\n." result) "multiline result")
+ (and (member "list" result-params) "`:results list'"))))
+ (when warning
+ (user-error "Inline error: %s cannot be used" warning))))
+ (save-excursion
+ (let* ((visible-beg (point-min-marker))
+ (visible-end (copy-marker (point-max) t))
+ (inline (let ((context (org-element-context)))
+ (and (memq (org-element-type context)
+ '(inline-babel-call inline-src-block))
+ context)))
+ (existing-result (org-babel-where-is-src-block-result t nil hash))
+ (results-switches (cdr (assq :results_switches (nth 2 info))))
+ ;; When results exist outside of the current visible
+ ;; region of the buffer, be sure to widen buffer to
+ ;; update them.
+ (outside-scope (and existing-result
+ (buffer-narrowed-p)
(or (> visible-beg existing-result)
(<= visible-end existing-result))))
- beg end)
- (when (and (stringp result) ; ensure results end in a newline
- (not inlinep)
- (> (length result) 0)
- (not (or (string-equal (substring result -1) "\n")
- (string-equal (substring result -1) "\r"))))
- (setq result (concat result "\n")))
- (unwind-protect
- (progn
- (when outside-scope-p (widen))
- (if (not existing-result)
- (setq beg (or inlinep (point)))
- (goto-char existing-result)
- (save-excursion
- (re-search-forward "#" nil t)
- (setq indent (- (current-column) 1)))
- (forward-line 1)
+ beg end indent)
+ ;; Ensure non-inline results end in a newline.
+ (when (and (org-string-nw-p result)
+ (not inline)
+ (not (string-equal (substring result -1) "\n")))
+ (setq result (concat result "\n")))
+ (unwind-protect
+ (progn
+ (when outside-scope (widen))
+ (if existing-result (goto-char existing-result)
+ (goto-char (org-element-property :end inline))
+ (skip-chars-backward " \t"))
+ (unless inline
+ (setq indent (org-get-indentation))
+ (forward-line 1))
(setq beg (point))
(cond
+ (inline
+ ;; Make sure new results are separated from the
+ ;; source code by one space.
+ (unless existing-result
+ (insert " ")
+ (setq beg (point))))
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
- ((member "prepend" result-params)))) ; already there
- (setq results-switches
- (if results-switches (concat " " results-switches) ""))
- (let ((wrap (lambda (start finish &optional no-escape)
- (goto-char end) (insert (concat finish "\n"))
- (goto-char beg) (insert (concat start "\n"))
- (unless no-escape
- (org-escape-code-in-region (min (point) end) end))
- (goto-char end) (goto-char (point-at-eol))
- (setq end (point-marker))))
- (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
- ;; insert results based on type
- (cond
- ;; do nothing for an empty result
- ((null result))
- ;; insert a list if preferred
- ((member "list" result-params)
- (insert
- (org-babel-trim
- (org-list-to-generic
- (cons 'unordered
- (mapcar
- (lambda (el) (list nil (if (stringp el) el (format "%S" el))))
- (if (listp result) result (split-string result "\n" t))))
- '(:splicep nil :istart "- " :iend "\n")))
- "\n"))
- ;; assume the result is a table if it's not a string
- ((funcall proper-list-p result)
- (goto-char beg)
- (insert (concat (orgtbl-to-orgtbl
- (if (org-every
- (lambda (el) (or (listp el) (eq el 'hline)))
- result)
- result (list result))
- '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
- (goto-char beg) (when (org-at-table-p) (org-table-align)))
- ((and (listp result) (not (funcall proper-list-p result)))
- (insert (format "%s\n" result)))
- ((member "file" result-params)
- (when inlinep (goto-char inlinep))
- (insert result))
- (t (goto-char beg) (insert result)))
- (when (funcall proper-list-p result) (goto-char (org-table-end)))
- (setq end (point-marker))
- ;; possibly wrap result
- (cond
- ((assoc :wrap (nth 2 info))
- (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
- (funcall wrap (concat "#+BEGIN_" name)
- (concat "#+END_" (car (org-split-string name))))))
- ((member "html" result-params)
- (funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
- ((member "latex" result-params)
- (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
- ((member "org" result-params)
- (goto-char beg) (if (org-at-table-p) (org-cycle))
- (funcall wrap "#+BEGIN_SRC org" "#+END_SRC"))
- ((member "code" result-params)
- (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
- "#+END_SRC"))
- ((member "raw" result-params)
- (goto-char beg) (if (org-at-table-p) (org-cycle)))
- ((or (member "drawer" result-params)
- ;; Stay backward compatible with <7.9.2
- (member "wrap" result-params))
- (goto-char beg) (if (org-at-table-p) (org-cycle))
- (funcall wrap ":RESULTS:" ":END:" 'no-escape))
- ((and (not (funcall proper-list-p result))
- (not (member "file" result-params)))
- (org-babel-examplize-region beg end results-switches)
- (setq end (point)))))
- ;; possibly indent the results to match the #+results line
- (when (and (not inlinep) (numberp indent) indent (> indent 0)
- ;; in this case `table-align' does the work for us
- (not (and (listp result)
- (member "append" result-params))))
- (indent-rigidly beg end indent))
- (if (null result)
- (if (member "value" result-params)
- (message "Code block returned no value.")
- (message "Code block produced no output."))
- (message "Code block evaluation complete.")))
- (when outside-scope-p (narrow-to-region visible-beg visible-end))
- (set-marker visible-beg nil)
- (set-marker visible-end nil))))))
-
-(defun org-babel-remove-result (&optional info)
+ ((member "prepend" result-params))) ; already there
+ (setq results-switches
+ (if results-switches (concat " " results-switches) ""))
+ (let ((wrap
+ (lambda (start finish &optional no-escape no-newlines
+ inline-start inline-finish)
+ (when inline
+ (setq start inline-start)
+ (setq finish inline-finish)
+ (setq no-newlines t))
+ (let ((before-finish (marker-position end)))
+ (goto-char end)
+ (insert (concat finish (unless no-newlines "\n")))
+ (goto-char beg)
+ (insert (concat start (unless no-newlines "\n")))
+ (unless no-escape
+ (org-escape-code-in-region
+ (min (point) before-finish) before-finish))
+ (goto-char end))))
+ (tabulablep
+ (lambda (r)
+ ;; Non-nil when result R can be turned into
+ ;; a table.
+ (and (listp r)
+ (null (cdr (last r)))
+ (cl-every
+ (lambda (e) (or (atom e) (null (cdr (last e)))))
+ result)))))
+ ;; insert results based on type
+ (cond
+ ;; Do nothing for an empty result.
+ ((null result))
+ ;; Insert a list if preferred.
+ ((member "list" result-params)
+ (insert
+ (org-trim
+ (org-list-to-generic
+ (cons 'unordered
+ (mapcar
+ (lambda (e)
+ (list (if (stringp e) e (format "%S" e))))
+ (if (listp result) result
+ (split-string result "\n" t))))
+ '(:splicep nil :istart "- " :iend "\n")))
+ "\n"))
+ ;; Try hard to print RESULT as a table. Give up if
+ ;; it contains an improper list.
+ ((funcall tabulablep result)
+ (goto-char beg)
+ (insert (concat (orgtbl-to-orgtbl
+ (if (cl-every
+ (lambda (e)
+ (or (eq e 'hline) (listp e)))
+ result)
+ result
+ (list result))
+ nil)
+ "\n"))
+ (goto-char beg)
+ (when (org-at-table-p) (org-table-align))
+ (goto-char (org-table-end)))
+ ;; Print verbatim a list that cannot be turned into
+ ;; a table.
+ ((listp result) (insert (format "%s\n" result)))
+ ((member "file" result-params)
+ (when inline
+ (setq result (org-macro-escape-arguments result)))
+ (insert result))
+ ((and inline (not (member "raw" result-params)))
+ (insert (org-macro-escape-arguments
+ (org-babel-chomp result "\n"))))
+ (t (goto-char beg) (insert result)))
+ (setq end (copy-marker (point) t))
+ ;; 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 ":") "@@)}}}")))
+ ((member "html" result-params)
+ (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil
+ "{{{results(@@html:" "@@)}}}"))
+ ((member "latex" result-params)
+ (funcall wrap "#+BEGIN_EXPORT latex" "#+END_EXPORT" nil nil
+ "{{{results(@@latex:" "@@)}}}"))
+ ((member "org" result-params)
+ (goto-char beg) (when (org-at-table-p) (org-cycle))
+ (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil
+ "{{{results(src_org{" "})}}}"))
+ ((member "code" result-params)
+ (let ((lang (or lang "none")))
+ (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches)
+ "#+END_SRC" nil nil
+ (format "{{{results(src_%s[%s]{" lang results-switches)
+ "})}}}")))
+ ((member "raw" result-params)
+ (goto-char beg) (when (org-at-table-p) (org-cycle)))
+ ((or (member "drawer" result-params)
+ ;; Stay backward compatible with <7.9.2
+ (member "wrap" result-params))
+ (goto-char beg) (when (org-at-table-p) (org-cycle))
+ (funcall wrap ":RESULTS:" ":END:" 'no-escape nil
+ "{{{results(" ")}}}"))
+ ((and inline (member "file" result-params))
+ (funcall wrap nil nil nil nil "{{{results(" ")}}}"))
+ ((and (not (funcall tabulablep result))
+ (not (member "file" result-params)))
+ (let ((org-babel-inline-result-wrap
+ ;; Hard code {{{results(...)}}} on top of
+ ;; customization.
+ (format "{{{results(%s)}}}"
+ org-babel-inline-result-wrap)))
+ (org-babel-examplify-region
+ beg end results-switches inline)))))
+ ;; Possibly indent results in par with #+results line.
+ (when (and (not inline) (numberp indent) (> indent 0)
+ ;; In this case `table-align' does the work
+ ;; for us.
+ (not (and (listp result)
+ (member "append" result-params))))
+ (indent-rigidly beg end indent))
+ (if (null result)
+ (if (member "value" result-params)
+ (message "Code block returned no value.")
+ (message "Code block produced no output."))
+ (message "Code block evaluation complete.")))
+ (set-marker end nil)
+ (when outside-scope (narrow-to-region visible-beg visible-end))
+ (set-marker visible-beg nil)
+ (set-marker visible-end nil)))))))
+
+(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)) start)
+ (let ((location (org-babel-where-is-src-block-result nil info)))
(when location
- (setq start (- location 1))
(save-excursion
- (goto-char location) (forward-line 1)
- (delete-region start (org-babel-result-end))))))
+ (goto-char location)
+ (when (looking-at (concat org-babel-result-regexp ".*$"))
+ (delete-region
+ (if keep-keyword (line-beginning-position 2)
+ (save-excursion
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (progn (forward-line) (org-babel-result-end))))))))
+
+(defun org-babel-remove-inline-result (&optional datum)
+ "Remove the result of the current inline-src-block or babel call.
+The result must be wrapped in a `results' macro to be removed.
+Leading white space is trimmed."
+ (interactive)
+ (let* ((el (or datum (org-element-context))))
+ (when (memq (org-element-type el) '(inline-src-block inline-babel-call))
+ (org-with-wide-buffer
+ (goto-char (org-element-property :end el))
+ (skip-chars-backward " \t")
+ (let ((result (save-excursion
+ (skip-chars-forward
+ " \t\n"
+ (org-element-property
+ :contents-end (org-element-property :parent el)))
+ (org-element-context))))
+ (when (and (eq (org-element-type result) 'macro)
+ (string= (org-element-property :key result) "results"))
+ (delete-region ; And leading whitespace.
+ (point)
+ (progn (goto-char (org-element-property :end result))
+ (skip-chars-backward " \t\n")
+ (point)))))))))
+
+(defun org-babel-remove-result-one-or-many (x)
+ "Remove the result of the current source block.
+If called with a prefix argument, remove all result blocks
+in the buffer."
+ (interactive "P")
+ (if x
+ (org-babel-map-src-blocks nil (org-babel-remove-result))
+ (org-babel-remove-result)))
(defun org-babel-result-end ()
"Return the point at the end of the current set of results."
- (save-excursion
- (cond
- ((org-at-table-p) (progn (goto-char (org-table-end)) (point)))
- ((org-at-item-p) (let* ((struct (org-list-struct))
- (prvs (org-list-prevs-alist struct)))
- (org-list-get-list-end (point-at-bol) struct prvs)))
- ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:"))
- (progn (re-search-forward (concat "^" (match-string 1) ":END:"))
- (forward-char 1) (point)))
- (t
- (let ((case-fold-search t))
- (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)"))
- (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
- nil t)
- (forward-char 1))
- (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)")
- (forward-line 1))))
- (point)))))
+ (cond ((looking-at-p "^[ \t]*$") (point)) ;no result
+ ((looking-at-p (format "^[ \t]*%s[ \t]*$" org-bracket-link-regexp))
+ (line-beginning-position 2))
+ (t
+ (let ((element (org-element-at-point)))
+ (if (memq (org-element-type element)
+ ;; Possible results types.
+ '(drawer example-block export-block fixed-width item
+ plain-list src-block table))
+ (save-excursion
+ (goto-char (min (point-max) ;for narrowed buffers
+ (org-element-property :end element)))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ (point))))))
(defun org-babel-result-to-file (result &optional description)
"Convert RESULT into an `org-mode' link with optional DESCRIPTION.
@@ -2210,29 +2490,23 @@ file's directory then expand relative links."
result)
(if description (concat "[" description "]") ""))))
-(defvar org-babel-capitalize-examplize-region-markers nil
- "Make true to capitalize begin/end example markers inserted by code blocks.")
-
-(defun org-babel-examplize-region (beg end &optional results-switches)
+(defun org-babel-examplify-region (beg end &optional results-switches inline)
"Comment out region using the inline `==' or `: ' org example quote."
(interactive "*r")
- (let ((chars-between (lambda (b e)
- (not (string-match "^[\\s]*$" (buffer-substring b e)))))
- (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers
- (upcase str) str))))
- (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg)
- (funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
+ (let ((maybe-cap
+ (lambda (str)
+ (if org-babel-uppercase-example-markers (upcase str) str))))
+ (if inline
(save-excursion
(goto-char beg)
(insert (format org-babel-inline-result-wrap
- (prog1 (buffer-substring beg end)
- (delete-region beg end)))))
+ (delete-and-extract-region beg end))))
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)) ; do nothing for an empty result
((< size org-babel-min-lines-for-block-output)
(goto-char beg)
- (dotimes (n size)
+ (dotimes (_ size)
(beginning-of-line 1) (insert ": ") (forward-line 1)))
(t
(goto-char beg)
@@ -2241,16 +2515,37 @@ file's directory then expand relative links."
(funcall maybe-cap "#+begin_example")
results-switches)
(funcall maybe-cap "#+begin_example\n")))
- (if (markerp end) (goto-char end) (forward-char (- end beg)))
+ (let ((p (point)))
+ (if (markerp end) (goto-char end) (forward-char (- end beg)))
+ (org-escape-code-in-region p (point)))
(insert (funcall maybe-cap "#+end_example\n")))))))))
(defun org-babel-update-block-body (new-body)
"Update the body of the current code block to NEW-BODY."
- (if (not (org-babel-where-is-src-block-head))
- (error "Not in a source block")
- (save-match-data
- (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5))
- (indent-rigidly (match-beginning 5) (match-end 5) 2)))
+ (let ((element (org-element-at-point)))
+ (unless (eq (org-element-type element) 'src-block)
+ (error "Not in a source block"))
+ (goto-char (org-babel-where-is-src-block-head element))
+ (let* ((ind (org-get-indentation))
+ (body-start (line-beginning-position 2))
+ (body (org-element-normalize-string
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent element))
+ new-body
+ (with-temp-buffer
+ (insert (org-remove-indentation new-body))
+ (indent-rigidly
+ (point-min)
+ (point-max)
+ (+ ind org-edit-src-content-indentation))
+ (buffer-string))))))
+ (delete-region body-start
+ (org-with-wide-buffer
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \t\n")
+ (line-beginning-position)))
+ (goto-char body-start)
+ (insert body))))
(defun org-babel-merge-params (&rest plists)
"Combine all parameter association lists in PLISTS.
@@ -2259,133 +2554,103 @@ This takes into account some special considerations for certain
parameters when merging lists."
(let* ((results-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'results org-babel-common-header-args-w-values))))
+ (cdr (assq 'results org-babel-common-header-args-w-values))))
(exports-exclusive-groups
(mapcar (lambda (group) (mapcar #'symbol-name group))
- (cdr (assoc 'exports org-babel-common-header-args-w-values))))
- (variable-index 0)
- (e-merge (lambda (exclusive-groups &rest result-params)
- ;; maintain exclusivity of mutually exclusive parameters
- (let (output)
- (mapc (lambda (new-params)
- (mapc (lambda (new-param)
- (mapc (lambda (exclusive-group)
- (when (member new-param exclusive-group)
- (mapcar (lambda (excluded-param)
- (setq output
- (delete
- excluded-param
- output)))
- exclusive-group)))
- exclusive-groups)
- (setq output (org-uniquify
- (cons new-param output))))
- new-params))
- result-params)
- output)))
- params results exports tangle noweb cache vars shebang comments padline
- clearnames)
-
- (mapc
- (lambda (plist)
- (mapc
- (lambda (pair)
- (case (car pair)
- (:var
- (let ((name (if (listp (cdr pair))
- (cadr pair)
- (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*="
- (cdr pair))
- (intern (match-string 1 (cdr pair)))))))
- (if name
- (setq vars
- (append
- (if (member name (mapcar #'car vars))
- (progn
- (push name clearnames)
- (delq nil
- (mapcar
- (lambda (p)
- (unless (equal (car p) name) p))
- vars)))
- vars)
- (list (cons name pair))))
- ;; if no name is given and we already have named variables
- ;; then assign to named variables in order
- (if (and vars (nth variable-index vars))
- (let ((name (car (nth variable-index vars))))
- (push name clearnames) ; clear out colnames
- ; and rownames
- ; for replace vars
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name name) "=" (cdr pair)))
- (incf variable-index)))
- (error "Variable \"%s\" must be assigned a default value"
- (cdr pair))))))
- (:results
- (setq results (funcall e-merge results-exclusive-groups
- results
- (split-string
- (let ((r (cdr pair)))
- (if (stringp r) r (eval r)))))))
- (:file
- (when (cdr pair)
- (setq results (funcall e-merge results-exclusive-groups
- results '("file")))
- (unless (or (member "both" exports)
- (member "none" exports)
- (member "code" exports))
- (setq exports (funcall e-merge exports-exclusive-groups
- exports '("results"))))
- (setq params (cons pair (assq-delete-all (car pair) params)))))
- (:exports
- (setq exports (funcall e-merge exports-exclusive-groups
- exports (split-string (cdr pair)))))
- (:tangle ;; take the latest -- always overwrite
- (setq tangle (or (list (cdr pair)) tangle)))
- (:noweb
- (setq noweb (funcall e-merge
- '(("yes" "no" "tangle" "no-export"
- "strip-export" "eval"))
- noweb
- (split-string (or (cdr pair) "")))))
- (:cache
- (setq cache (funcall e-merge '(("yes" "no")) cache
- (split-string (or (cdr pair) "")))))
- (:padline
- (setq padline (funcall e-merge '(("yes" "no")) padline
- (split-string (or (cdr pair) "")))))
- (:shebang ;; take the latest -- always overwrite
- (setq shebang (or (list (cdr pair)) shebang)))
- (:comments
- (setq comments (funcall e-merge '(("yes" "no")) comments
- (split-string (or (cdr pair) "")))))
- (t ;; replace: this covers e.g. :session
- (setq params (cons pair (assq-delete-all (car pair) params))))))
- plist))
- plists)
- (setq vars (reverse vars))
- (while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
- ;; clear out col-names and row-names for replaced variables
- (mapc
- (lambda (name)
- (mapc
- (lambda (param)
- (when (assoc param params)
- (setf (cdr (assoc param params))
- (org-remove-if (lambda (pair) (equal (car pair) name))
- (cdr (assoc param params))))
- (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param)
- (null (cdr pair))))
- params))))
- (list :colname-names :rowname-names)))
- clearnames)
- (mapc
- (lambda (hd)
- (let ((key (intern (concat ":" (symbol-name hd))))
- (val (eval hd)))
- (setf params (cons (cons key (mapconcat 'identity val " ")) params))))
- '(results exports tangle noweb padline cache shebang comments))
+ (cdr (assq 'exports org-babel-common-header-args-w-values))))
+ (merge
+ (lambda (exclusive-groups &rest result-params)
+ ;; Maintain exclusivity of mutually exclusive parameters,
+ ;; as defined in EXCLUSIVE-GROUPS while merging lists in
+ ;; RESULT-PARAMS.
+ (let (output)
+ (dolist (new-params result-params (delete-dups output))
+ (dolist (new-param new-params)
+ (dolist (exclusive-group exclusive-groups)
+ (when (member new-param exclusive-group)
+ (setq output (cl-remove-if
+ (lambda (o) (member o exclusive-group))
+ output))))
+ (push new-param output))))))
+ (variable-index 0) ;Handle positional arguments.
+ clearnames
+ params ;Final parameters list.
+ ;; Some keywords accept multiple values. We need to treat
+ ;; them specially.
+ vars results exports)
+ (dolist (plist plists)
+ (dolist (pair plist)
+ (pcase pair
+ (`(:var . ,value)
+ (let ((name (cond
+ ((listp value) (car value))
+ ((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value)
+ (intern (match-string 1 value)))
+ (t nil))))
+ (cond
+ (name
+ (setq vars
+ (append (if (not (assoc name vars)) vars
+ (push name clearnames)
+ (cl-remove-if (lambda (p) (equal name (car p)))
+ vars))
+ (list (cons name pair)))))
+ ((and vars (nth variable-index vars))
+ ;; If no name is given and we already have named
+ ;; variables then assign to named variables in order.
+ (let ((name (car (nth variable-index vars))))
+ ;; Clear out colnames and rownames for replace vars.
+ (push name clearnames)
+ (setf (cddr (nth variable-index vars))
+ (concat (symbol-name name) "=" value))
+ (cl-incf variable-index)))
+ (t (error "Variable \"%s\" must be assigned a default value"
+ (cdr pair))))))
+ (`(:results . ,value)
+ (setq results (funcall merge
+ results-exclusive-groups
+ results
+ (split-string
+ (if (stringp value) value (eval value t))))))
+ (`(,(or :file :file-ext) . ,value)
+ ;; `:file' and `:file-ext' are regular keywords but they
+ ;; imply a "file" `:results' and a "results" `:exports'.
+ (when value
+ (setq results
+ (funcall merge results-exclusive-groups results '("file")))
+ (unless (or (member "both" exports)
+ (member "none" exports)
+ (member "code" exports))
+ (setq exports
+ (funcall merge
+ exports-exclusive-groups exports '("results"))))
+ (push pair params)))
+ (`(:exports . ,value)
+ (setq exports (funcall merge
+ exports-exclusive-groups
+ exports
+ (split-string (or value "")))))
+ ;; Regular keywords: any value overwrites the previous one.
+ (_ (setq params (cons pair (assq-delete-all (car pair) params)))))))
+ ;; Handle `:var' and clear out colnames and rownames for replaced
+ ;; variables.
+ (setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars)
+ params))
+ (dolist (name clearnames)
+ (dolist (param '(:colname-names :rowname-names))
+ (when (assq param params)
+ (setf (cdr (assq param params))
+ (cl-remove-if (lambda (pair) (equal name (car pair)))
+ (cdr (assq param params))))
+ (setq params
+ (cl-remove-if (lambda (pair) (and (equal (car pair) param)
+ (null (cdr pair))))
+ params)))))
+ ;; Handle other special keywords, which accept multiple values.
+ (setq params (nconc (list (cons :results (mapconcat #'identity results " "))
+ (cons :exports (mapconcat #'identity exports " ")))
+ params))
+ ;; Return merged params.
params))
(defvar org-babel-use-quick-and-dirty-noweb-expansion nil
@@ -2397,17 +2662,12 @@ header argument from buffer or subtree wide properties.")
(defun org-babel-noweb-p (params context)
"Check if PARAMS require expansion in CONTEXT.
CONTEXT may be one of :tangle, :export or :eval."
- (let* (intersect
- (intersect (lambda (as bs)
- (when as
- (if (member (car as) bs)
- (car as)
- (funcall intersect (cdr as) bs))))))
- (funcall intersect (case context
- (:tangle '("yes" "tangle" "no-export" "strip-export"))
- (:eval '("yes" "no-export" "strip-export" "eval"))
- (:export '("yes")))
- (split-string (or (cdr (assoc :noweb params)) "")))))
+ (let ((allowed-values (cl-case context
+ (:tangle '("yes" "tangle" "no-export" "strip-export"))
+ (:eval '("yes" "no-export" "strip-export" "eval"))
+ (:export '("yes")))))
+ (cl-some (lambda (v) (member v allowed-values))
+ (split-string (or (cdr (assq :noweb params)) "")))))
(defun org-babel-expand-noweb-references (&optional info parent-buffer)
"Expand Noweb references in the body of the current source code block.
@@ -2445,7 +2705,7 @@ block but are passed literally to the \"example-block\"."
(body (nth 1 info))
(ob-nww-start org-babel-noweb-wrap-start)
(ob-nww-end org-babel-noweb-wrap-end)
- (comment (string= "noweb" (cdr (assoc :comments (nth 2 info)))))
+ (comment (string= "noweb" (cdr (assq :comments (nth 2 info)))))
(rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|"
":noweb-ref[ \t]+" "\\)"))
(new-body "")
@@ -2454,11 +2714,11 @@ block but are passed literally to the \"example-block\"."
(with-temp-buffer
(funcall (intern (concat lang "-mode")))
(comment-region (point) (progn (insert text) (point)))
- (org-babel-trim (buffer-string)))))
+ (org-trim (buffer-string)))))
index source-name evaluate prefix)
(with-temp-buffer
- (org-set-local 'org-babel-noweb-wrap-start ob-nww-start)
- (org-set-local 'org-babel-noweb-wrap-end ob-nww-end)
+ (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))
@@ -2502,7 +2762,7 @@ block but are passed literally to the \"example-block\"."
(while (re-search-forward rx nil t)
(let* ((i (org-babel-get-src-block-info 'light))
(body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ (sep (or (cdr (assq :noweb-sep (nth 2 i)))
"\n"))
(full (if comment
(let ((cs (org-babel-tangle-comment-links i)))
@@ -2513,11 +2773,11 @@ block but are passed literally to the \"example-block\"."
(setq expansion (cons sep (cons full expansion)))))
(org-babel-map-src-blocks nil
(let ((i (org-babel-get-src-block-info 'light)))
- (when (equal (or (cdr (assoc :noweb-ref (nth 2 i)))
+ (when (equal (or (cdr (assq :noweb-ref (nth 2 i)))
(nth 4 i))
source-name)
(let* ((body (org-babel-expand-noweb-references i))
- (sep (or (cdr (assoc :noweb-sep (nth 2 i)))
+ (sep (or (cdr (assq :noweb-sep (nth 2 i)))
"\n"))
(full (if comment
(let ((cs (org-babel-tangle-comment-links i)))
@@ -2530,7 +2790,8 @@ block but are passed literally to the \"example-block\"."
(and expansion
(mapconcat #'identity (nreverse (cdr expansion)) "")))
;; Possibly raise an error if named block doesn't exist.
- (if (member lang org-babel-noweb-error-langs)
+ (if (or org-babel-noweb-error-all-langs
+ (member lang org-babel-noweb-error-langs))
(error "%s" (concat
(org-babel-noweb-wrap source-name)
"could not be resolved (see "
@@ -2540,79 +2801,120 @@ block but are passed literally to the \"example-block\"."
(funcall nb-add (buffer-substring index (point-max))))
new-body))
+(defun org-babel--script-escape-inner (str)
+ (let (in-single in-double backslash out)
+ (mapc
+ (lambda (ch)
+ (setq
+ out
+ (if backslash
+ (progn
+ (setq backslash nil)
+ (cond
+ ((and in-single (eq ch ?'))
+ ;; Escaped single quote inside single quoted string:
+ ;; emit just a single quote, since we've changed the
+ ;; outer quotes to double.
+ (cons ch out))
+ ((eq ch ?\")
+ ;; Escaped double quote
+ (if in-single
+ ;; This should be interpreted as backslash+quote,
+ ;; not an escape. Emit a three backslashes
+ ;; followed by a quote (because one layer of
+ ;; quoting will be stripped by `org-babel-read').
+ (append (list ch ?\\ ?\\ ?\\) out)
+ ;; Otherwise we are in a double-quoted string. Emit
+ ;; a single escaped quote
+ (append (list ch ?\\) out)))
+ ((eq ch ?\\)
+ ;; Escaped backslash: emit a single escaped backslash
+ (append (list ?\\ ?\\) out))
+ ;; Other: emit a quoted backslash followed by whatever
+ ;; the character was (because one layer of quoting will
+ ;; be stripped by `org-babel-read').
+ (t (append (list ch ?\\ ?\\) out))))
+ (cl-case ch
+ (?\[ (if (or in-double in-single)
+ (cons ?\[ out)
+ (cons ?\( out)))
+ (?\] (if (or in-double in-single)
+ (cons ?\] out)
+ (cons ?\) out)))
+ (?\{ (if (or in-double in-single)
+ (cons ?\{ out)
+ (cons ?\( out)))
+ (?\} (if (or in-double in-single)
+ (cons ?\} out)
+ (cons ?\) out)))
+ (?, (if (or in-double in-single)
+ (cons ?, out) (cons ?\s out)))
+ (?\' (if in-double
+ (cons ?\' out)
+ (setq in-single (not in-single)) (cons ?\" out)))
+ (?\" (if in-single
+ (append (list ?\" ?\\) out)
+ (setq in-double (not in-double)) (cons ?\" out)))
+ (?\\ (unless (or in-single in-double)
+ (error "Can't handle backslash outside string in `org-babel-script-escape'"))
+ (setq backslash t)
+ out)
+ (t (cons ch out))))))
+ (string-to-list str))
+ (when (or in-single in-double)
+ (error "Unterminated string in `org-babel-script-escape'"))
+ (apply #'string (reverse out))))
+
(defun org-babel-script-escape (str &optional force)
"Safely convert tables into elisp lists."
+ (unless (stringp str)
+ (error "`org-babel-script-escape' expects a string"))
(let ((escaped
- (if (or force
- (and (stringp str)
- (> (length str) 2)
- (or (and (string-equal "[" (substring str 0 1))
- (string-equal "]" (substring str -1)))
- (and (string-equal "{" (substring str 0 1))
- (string-equal "}" (substring str -1)))
- (and (string-equal "(" (substring str 0 1))
- (string-equal ")" (substring str -1))))))
- (org-babel-read
- (concat
- "'"
- (let (in-single in-double out)
- (mapc
- (lambda (ch)
- (setq
- out
- (case ch
- (91 (if (or in-double in-single) ; [
- (cons 91 out)
- (cons 40 out)))
- (93 (if (or in-double in-single) ; ]
- (cons 93 out)
- (cons 41 out)))
- (123 (if (or in-double in-single) ; {
- (cons 123 out)
- (cons 40 out)))
- (125 (if (or in-double in-single) ; }
- (cons 125 out)
- (cons 41 out)))
- (44 (if (or in-double in-single) ; ,
- (cons 44 out) (cons 32 out)))
- (39 (if in-double ; '
- (cons 39 out)
- (setq in-single (not in-single)) (cons 34 out)))
- (34 (if in-single ; "
- (append (list 34 32) out)
- (setq in-double (not in-double)) (cons 34 out)))
- (t (cons ch out)))))
- (string-to-list str))
- (apply #'string (reverse out)))))
- str)))
+ (cond
+ ((and (> (length str) 2)
+ (or (and (string-equal "[" (substring str 0 1))
+ (string-equal "]" (substring str -1)))
+ (and (string-equal "{" (substring str 0 1))
+ (string-equal "}" (substring str -1)))
+ (and (string-equal "(" (substring str 0 1))
+ (string-equal ")" (substring str -1)))))
+
+ (concat "'" (org-babel--script-escape-inner str)))
+ ((or force
+ (and (> (length str) 2)
+ (or (and (string-equal "'" (substring str 0 1))
+ (string-equal "'" (substring str -1)))
+ ;; We need to pass double-quoted strings
+ ;; through the backslash-twiddling bits, even
+ ;; though we don't need to change their
+ ;; delimiters.
+ (and (string-equal "\"" (substring str 0 1))
+ (string-equal "\"" (substring str -1))))))
+ (org-babel--script-escape-inner str))
+ (t str))))
(condition-case nil (org-babel-read escaped) (error escaped))))
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
-Otherwise if cell looks like lisp (meaning it starts with a
-\"(\", \"\\='\", \"\\=`\" or a \"[\") then read it as lisp,
-otherwise return it unmodified as a string. Optional argument
-NO-LISP-EVAL inhibits lisp evaluation for situations in which is
-it not appropriate."
- (if (and (stringp cell) (not (equal cell "")))
- (or (org-babel-number-p cell)
- (if (and (not inhibit-lisp-eval)
- (or (member (substring cell 0 1) '("(" "'" "`" "["))
- (string= cell "*this*")))
- (eval (read cell))
- (if (string= (substring cell 0 1) "\"")
- (read cell)
- (progn (set-text-properties 0 (length cell) nil cell) cell))))
- cell))
-
-(defun org-babel-number-p (string)
- "If STRING represents a number return its value."
- (if (and (string-match "[0-9]+" string)
- (string-match "^-?[0-9]*\\.?[0-9]*$" string)
- (= (length (substring string (match-beginning 0)
- (match-end 0)))
- (length string)))
- (string-to-number string)))
+Otherwise if CELL looks like lisp (meaning it starts with a
+\"(\", \"\\='\", \"\\=`\" or a \"[\") then read and evaluate it as
+lisp, otherwise return it unmodified as a string. Optional
+argument INHIBIT-LISP-EVAL inhibits lisp evaluation for
+situations in which is it not appropriate."
+ (cond ((not (org-string-nw-p cell)) cell)
+ ((org-babel--string-to-number cell))
+ ((and (not inhibit-lisp-eval)
+ (or (memq (string-to-char cell) '(?\( ?' ?` ?\[))
+ (string= cell "*this*")))
+ (eval (read cell) t))
+ ((eq (string-to-char cell) ?\") (read cell))
+ (t (org-no-properties cell))))
+
+(defun org-babel--string-to-number (string)
+ "If STRING represents a number return its value.
+Otherwise return nil."
+ (and (string-match-p "\\`-?[0-9]*\\.?[0-9]*\\'" string)
+ (string-to-number string)))
(defun org-babel-import-elisp-from-file (file-name &optional separator)
"Read the results located at FILE-NAME into an elisp table.
@@ -2644,49 +2946,15 @@ If the table is trivial, then return it as a scalar."
cell) t))
(defun org-babel-chomp (string &optional regexp)
- "Strip trailing spaces and carriage returns from STRING.
-Default regexp used is \"[ \f\t\n\r\v]\" but can be
-overwritten by specifying a regexp as a second argument."
+ "Strip a trailing space or carriage return from STRING.
+The default regexp used is \"[ \\f\\t\\n\\r\\v]\" but another one
+can be specified as the REGEXP argument."
(let ((regexp (or regexp "[ \f\t\n\r\v]")))
(while (and (> (length string) 0)
(string-match regexp (substring string -1)))
(setq string (substring string 0 -1)))
string))
-(defun org-babel-trim (string &optional regexp)
- "Strip leading and trailing spaces and carriage returns from STRING.
-Like `org-babel-chomp' only it runs on both the front and back
-of the string."
- (org-babel-chomp (org-reverse-string
- (org-babel-chomp (org-reverse-string string) regexp))
- regexp))
-
-(defun org-babel-tramp-handle-call-process-region
- (start end program &optional delete buffer display &rest args)
- "Use Tramp to handle `call-process-region'.
-Fixes a bug in `tramp-handle-call-process-region'."
- (if (file-remote-p default-directory)
- (let ((tmpfile (tramp-compat-make-temp-file "")))
- (write-region start end tmpfile)
- (when delete (delete-region start end))
- (unwind-protect
- ;; (apply 'call-process program tmpfile buffer display args)
- ;; bug in tramp
- (apply 'process-file program tmpfile buffer display args)
- (delete-file tmpfile)))
- ;; org-babel-call-process-region-original is the original emacs
- ;; definition. It is in scope from the let binding in
- ;; org-babel-execute-src-block
- (apply org-babel-call-process-region-original
- start end program delete buffer display args)))
-
-(defalias 'org-babel-local-file-name
- (if (fboundp 'file-local-name)
- 'file-local-name
- (lambda (file)
- "Return the local name component of FILE."
- (or (file-remote-p file 'localname) file))))
-
(defun org-babel-process-file-name (name &optional no-quote-p)
"Prepare NAME to be used in an external process.
If NAME specifies a remote location, the remote portion of the
@@ -2694,7 +2962,7 @@ name is removed, since in that case the process will be executing
remotely. The file name is then processed by `expand-file-name'.
Unless second argument NO-QUOTE-P is non-nil, the file name is
additionally processed by `shell-quote-argument'"
- (let ((f (expand-file-name (org-babel-local-file-name name))))
+ (let ((f (org-babel-local-file-name (expand-file-name name))))
(if no-quote-p f (shell-quote-argument f))))
(defvar org-babel-temporary-directory)
@@ -2708,6 +2976,11 @@ additionally processed by `shell-quote-argument'"
Used by `org-babel-temp-file'. This directory will be removed on
Emacs shutdown."))
+(defcustom org-babel-remote-temporary-directory "/tmp/"
+ "Directory to hold temporary files on remote hosts."
+ :group 'org-babel
+ :type 'string)
+
(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms)
"Call the code to parse raw string results according to RESULT-PARAMS."
(declare (indent 1)
@@ -2720,6 +2993,7 @@ Emacs shutdown."))
(member "html" ,params)
(member "code" ,params)
(member "pp" ,params)
+ (member "file" ,params)
(and (or (member "output" ,params)
(member "raw" ,params)
(member "org" ,params)
@@ -2737,7 +3011,8 @@ of `org-babel-temporary-directory'."
(if (file-remote-p default-directory)
(let ((prefix
(concat (file-remote-p default-directory)
- (expand-file-name prefix temporary-file-directory))))
+ (expand-file-name
+ prefix org-babel-remote-temporary-directory))))
(make-temp-file prefix nil suffix))
(let ((temporary-file-directory
(or (and (boundp 'org-babel-temporary-directory)
@@ -2772,6 +3047,96 @@ of `org-babel-temporary-directory'."
(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory)
+(defun org-babel-one-header-arg-safe-p (pair safe-list)
+ "Determine if the PAIR is a safe babel header arg according to SAFE-LIST.
+
+For the format of SAFE-LIST, see `org-babel-safe-header-args'."
+ (and (consp pair)
+ (keywordp (car pair))
+ (stringp (cdr pair))
+ (or
+ (memq (car pair) safe-list)
+ (let ((entry (assq (car pair) safe-list)))
+ (and entry
+ (consp entry)
+ (cond ((functionp (cdr entry))
+ (funcall (cdr entry) (cdr pair)))
+ ((listp (cdr entry))
+ (member (cdr pair) (cdr entry)))
+ (t nil)))))))
+
+(defun org-babel-generate-file-param (src-name params)
+ "Calculate the filename for source block results.
+
+The directory is calculated from the :output-dir property of the
+source block; if not specified, use the current directory.
+
+If the source block has a #+NAME and the :file parameter does not
+contain any period characters, then the :file parameter is
+treated as an extension, and the output file name is the
+concatenation of the directory (as calculated above), the block
+name, a period, and the parameter value as a file extension.
+Otherwise, the :file parameter is treated as a full file name,
+and the output file name is the directory (as calculated above)
+plus the parameter value."
+ (let* ((file-cons (assq :file params))
+ (file-ext-cons (assq :file-ext params))
+ (file-ext (cdr-safe file-ext-cons))
+ (dir (cdr-safe (assq :output-dir params)))
+ fname)
+ ;; create the output-dir if it does not exist
+ (when dir
+ (make-directory dir t))
+ (if file-cons
+ ;; :file given; add :output-dir if given
+ (when dir
+ (setcdr file-cons (concat (file-name-as-directory dir) (cdr file-cons))))
+ ;; :file not given; compute from name and :file-ext if possible
+ (when (and src-name file-ext)
+ (if dir
+ (setq fname (concat (file-name-as-directory (or dir ""))
+ src-name "." file-ext))
+ (setq fname (concat src-name "." file-ext)))
+ (setq params (cons (cons :file fname) params))))
+ params))
+
+(defun org-babel-graphical-output-file (params)
+ "File where a babel block should send graphical output, per PARAMS.
+Return nil if no graphical output is expected. Raise an error if
+the output file is ill-defined."
+ (let ((file (cdr (assq :file params))))
+ (cond (file (and (member "graphics" (cdr (assq :result-params params)))
+ file))
+ ((assq :file-ext params)
+ (user-error ":file-ext given but no :file generated; did you forget \
+to name a block?"))
+ (t (user-error "No :file header argument given; cannot create \
+graphical result")))))
+
+(defun org-babel-make-language-alias (new old)
+ "Make source blocks of type NEW aliases for those of type OLD.
+
+NEW and OLD should be strings. This function should be called
+after the babel API for OLD-type source blocks is fully defined.
+
+Callers of this function will probably want to add an entry to
+`org-src-lang-modes' as well."
+ (dolist (fn '("execute" "expand-body" "prep-session"
+ "variable-assignments" "load-session"))
+ (let ((sym (intern-soft (concat "org-babel-" fn ":" old))))
+ (when (and sym (fboundp sym))
+ (defalias (intern (concat "org-babel-" fn ":" new)) sym))))
+ ;; Technically we don't need a `dolist' for just one variable, but
+ ;; we keep it for symmetry/ease of future expansion.
+ (dolist (var '("default-header-args"))
+ (let ((sym (intern-soft (concat "org-babel-" var ":" old))))
+ (when (and sym (boundp sym))
+ (defvaralias (intern (concat "org-babel-" var ":" new)) sym)))))
+
+(defun org-babel-strip-quotes (string)
+ "Strip \\\"s from around a string, if applicable."
+ (org-unbracket-string "\"" "\"" string))
+
(provide 'ob-core)
;; Local variables:
diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el
index 70c66d46704..b3982db391d 100644
--- a/lisp/org/ob-css.el
+++ b/lisp/org/ob-css.el
@@ -1,4 +1,4 @@
-;;; ob-css.el --- org-babel functions for css evaluation
+;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,24 +19,24 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Since CSS can't be executed, this file exists solely for tangling
-;; CSS from org-mode files.
+;; CSS from Org files.
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:css '())
-(defun org-babel-execute:css (body params)
+(defun org-babel-execute:css (body _params)
"Execute a block of CSS code.
This function is called by `org-babel-execute-src-block'."
body)
-(defun org-babel-prep-session:css (session params)
+(defun org-babel-prep-session:css (_session _params)
"Return an error if the :session header argument is set.
CSS does not support sessions."
(error "CSS sessions are nonsensical"))
diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el
index 5eb8e2fdb4b..2a7c755676b 100644
--- a/lisp/org/ob-ditaa.el
+++ b/lisp/org/ob-ditaa.el
@@ -1,4 +1,4 @@
-;;; ob-ditaa.el --- org-babel functions for ditaa evaluation
+;;; ob-ditaa.el --- Babel Functions for ditaa -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -81,15 +81,21 @@ Do not leave leading or trailing spaces in this string."
(defun org-babel-execute:ditaa (body params)
"Execute a block of Ditaa code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file (let ((el (cdr (assoc :file params))))
- (or el
- (error
- "ditaa code block requires :file header argument"))))
- (cmdline (cdr (assoc :cmdline params)))
- (java (cdr (assoc :java params)))
+ (let* ((out-file (or (cdr (assq :file params))
+ (error
+ "ditaa code block requires :file header argument")))
+ (cmdline (cdr (assq :cmdline params)))
+ (java (cdr (assq :java params)))
(in-file (org-babel-temp-file "ditaa-"))
- (eps (cdr (assoc :eps params)))
+ (eps (cdr (assq :eps params)))
+ (eps-file (when eps
+ (org-babel-process-file-name (concat in-file ".eps"))))
+ (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
+ (cdr (assq :pdf params))))
+ (concat
+ "epstopdf"
+ " " eps-file
+ " -o=" (org-babel-process-file-name out-file))))
(cmd (concat org-babel-ditaa-java-cmd
" " java " " org-ditaa-jar-option " "
(shell-quote-argument
@@ -97,13 +103,9 @@ This function is called by `org-babel-execute-src-block'."
(if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
" " cmdline
" " (org-babel-process-file-name in-file)
- " " (org-babel-process-file-name out-file)))
- (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf")
- (cdr (assoc :pdf params))))
- (concat
- "epstopdf"
- " " (org-babel-process-file-name (concat in-file ".eps"))
- " -o=" (org-babel-process-file-name out-file)))))
+ " " (if pdf-cmd
+ eps-file
+ (org-babel-process-file-name out-file)))))
(unless (file-exists-p org-ditaa-jar-path)
(error "Could not find ditaa.jar at %s" org-ditaa-jar-path))
(with-temp-file in-file (insert body))
@@ -111,7 +113,7 @@ This function is called by `org-babel-execute-src-block'."
(when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd))
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:ditaa (session params)
+(defun org-babel-prep-session:ditaa (_session _params)
"Return an error because ditaa does not support sessions."
(error "Ditaa does not support sessions"))
diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el
index aa0445b4ca4..8c8e2fbd604 100644
--- a/lisp/org/ob-dot.el
+++ b/lisp/org/ob-dot.el
@@ -1,4 +1,4 @@
-;;; ob-dot.el --- org-babel functions for dot evaluation
+;;; ob-dot.el --- Babel Functions for dot -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,7 +46,7 @@
(defun org-babel-expand-body:dot (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@@ -55,19 +55,20 @@
(replace-regexp-in-string
(concat "$" (regexp-quote name))
(if (stringp value) value (format "%S" value))
- body))))
+ body
+ t
+ t))))
vars)
body))
(defun org-babel-execute:dot (body params)
"Execute a block of Dot code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (cdr (assoc :result-params params)))
- (out-file (cdr (or (assoc :file params)
+ (let* ((out-file (cdr (or (assq :file params)
(error "You need to specify a :file parameter"))))
- (cmdline (or (cdr (assoc :cmdline params))
+ (cmdline (or (cdr (assq :cmdline params))
(format "-T%s" (file-name-extension out-file))))
- (cmd (or (cdr (assoc :cmd params)) "dot"))
+ (cmd (or (cdr (assq :cmd params)) "dot"))
(in-file (org-babel-temp-file "dot-")))
(with-temp-file in-file
(insert (org-babel-expand-body:dot body params)))
@@ -78,7 +79,7 @@ This function is called by `org-babel-execute-src-block'."
" -o " (org-babel-process-file-name out-file)) "")
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:dot (session params)
+(defun org-babel-prep-session:dot (_session _params)
"Return an error because Dot does not support sessions."
(error "Dot does not support sessions"))
diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el
new file mode 100644
index 00000000000..6bb9b81b222
--- /dev/null
+++ b/lisp/org/ob-ebnf.el
@@ -0,0 +1,81 @@
+;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
+
+;; Author: Michael Gauland
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+;; Version: 1.00
+
+;; 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:
+
+;;; 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:
+
+;;; Code:
+(require 'ob)
+(require 'ebnf2ps)
+
+;; optionally declare default header arguments for this language
+(defvar org-babel-default-header-args:ebnf '((:style . nil)))
+
+;; Use ebnf-eps-buffer to produce an encapsulated postscript file.
+;;
+(defun org-babel-execute:ebnf (body params)
+ "Execute a block of Ebnf code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (save-excursion
+ (let* ((dest-file (cdr (assq :file params)))
+ (dest-dir (file-name-directory dest-file))
+ (dest-root (file-name-sans-extension
+ (file-name-nondirectory dest-file)))
+ (style (cdr (assq :style params)))
+ (result nil))
+ (with-temp-buffer
+ (when style (ebnf-push-style style))
+ (let ((comment-format
+ (cond ((string= ebnf-syntax 'yacc) "/*%s*/")
+ ((string= ebnf-syntax 'ebnf) ";%s")
+ ((string= ebnf-syntax 'iso-ebnf) "(*%s*)")
+ (t (setq result
+ (format "EBNF error: format %s not supported."
+ ebnf-syntax))))))
+ (setq ebnf-eps-prefix dest-dir)
+ (insert (format comment-format (format "[%s" dest-root)))
+ (newline)
+ (insert body)
+ (newline)
+ (insert (format comment-format (format "]%s" dest-root)))
+ (ebnf-eps-buffer)
+ (when style (ebnf-pop-style))))
+ 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 d95c475c4ee..4736d895dc5 100644
--- a/lisp/org/ob-emacs-lisp.el
+++ b/lisp/org/ob-emacs-lisp.el
@@ -1,4 +1,4 @@
-;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation
+;;; ob-emacs-lisp.el --- Babel Functions for Emacs-lisp Code -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,53 +28,61 @@
;;; Code:
(require 'ob)
-(defvar org-babel-default-header-args:emacs-lisp
- '((:hlines . "yes") (:colnames . "no"))
- "Default arguments for evaluating an emacs-lisp source block.")
+(defconst org-babel-header-args:emacs-lisp '((lexical . :any))
+ "Emacs-lisp specific header arguments.")
-(declare-function orgtbl-to-generic "org-table"
- (table params &optional backend))
+(defvar org-babel-default-header-args:emacs-lisp '((:lexical . "no"))
+ "Default arguments for evaluating an emacs-lisp source block.
+
+A value of \"yes\" or t causes src blocks to be eval'd using
+lexical scoping. It can also be an alist mapping symbols to
+their value. It is used as the optional LEXICAL argument to
+`eval', which see.")
(defun org-babel-expand-body:emacs-lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
- (print-level nil) (print-length nil)
- (body (if (> (length vars) 0)
- (concat "(let ("
- (mapconcat
- (lambda (var)
- (format "%S" (print `(,(car var) ',(cdr var)))))
- vars "\n ")
- ")\n" body "\n)")
- (concat body "\n"))))
- (if (or (member "code" result-params)
- (member "pp" result-params))
- (concat "(pp " body ")") body)))
+ (let ((vars (org-babel--get-vars params))
+ (print-level nil)
+ (print-length nil))
+ (if (null vars) (concat body "\n")
+ (format "(let (%s)\n%s\n)"
+ (mapconcat
+ (lambda (var)
+ (format "%S" (print `(,(car var) ',(cdr var)))))
+ vars "\n ")
+ body))))
(defun org-babel-execute:emacs-lisp (body params)
"Execute a block of emacs-lisp code with Babel."
(save-window-excursion
- (let ((result
- (eval (read (format (if (member "output"
- (cdr (assoc :result-params params)))
- "(with-output-to-string %s)"
- "(progn %s)")
- (org-babel-expand-body:emacs-lisp
- body params))))))
- (org-babel-result-cond (cdr (assoc :result-params 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))
+ (if (listp lexical)
+ lexical
+ (member lexical '("yes" "t"))))))
+ (org-babel-result-cond result-params
(let ((print-level nil)
(print-length nil))
- (if (or (member "scalar" (cdr (assoc :result-params params)))
- (member "verbatim" (cdr (assoc :result-params params))))
+ (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 (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))))
+ (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))))))))
+
+(org-babel-make-language-alias "elisp" "emacs-lisp")
(provide 'ob-emacs-lisp)
diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el
index 46d21c88e85..4ce91c78537 100644
--- a/lisp/org/ob-eval.el
+++ b/lisp/org/ob-eval.el
@@ -1,4 +1,4 @@
-;;; ob-eval.el --- org-babel functions for external code evaluation
+;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,7 +28,6 @@
;;; Code:
(require 'org-macs)
-(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix))
@@ -57,6 +56,13 @@ STDERR with `org-babel-eval-error-notify'."
(progn
(with-current-buffer err-buff
(org-babel-eval-error-notify exit-code (buffer-string)))
+ (save-excursion
+ (when (get-buffer org-babel-error-buffer-name)
+ (with-current-buffer org-babel-error-buffer-name
+ (unless (derived-mode-p 'compilation-mode)
+ (compilation-mode))
+ ;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable.
+ (setq buffer-read-only nil))))
nil)
(buffer-string)))))
@@ -114,18 +120,18 @@ function in various versions of Emacs.
(delete-file input-file))
(when (and error-file (file-exists-p error-file))
- (if (< 0 (nth 7 (file-attributes error-file)))
- (with-current-buffer (get-buffer-create error-buffer)
- (let ((pos-from-end (- (point-max) (point))))
- (or (bobp)
- (insert "\f\n"))
- ;; Do no formatting while reading error file,
- ;; because that can run a shell command, and we
- ;; don't want that to cause an infinite recursion.
- (format-insert-file error-file nil)
- ;; Put point after the inserted errors.
- (goto-char (- (point-max) pos-from-end)))
- (current-buffer)))
+ (when (< 0 (nth 7 (file-attributes error-file)))
+ (with-current-buffer (get-buffer-create error-buffer)
+ (let ((pos-from-end (- (point-max) (point))))
+ (or (bobp)
+ (insert "\f\n"))
+ ;; Do no formatting while reading error file,
+ ;; because that can run a shell command, and we
+ ;; don't want that to cause an infinite recursion.
+ (format-insert-file error-file nil)
+ ;; Put point after the inserted errors.
+ (goto-char (- (point-max) pos-from-end)))
+ (current-buffer)))
(delete-file error-file))
exit-status))
diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el
index 2677fe59cb2..9606d3e474f 100644
--- a/lisp/org/ob-exp.el
+++ b/lisp/org/ob-exp.el
@@ -1,4 +1,4 @@
-;;; ob-exp.el --- Exportation of org-babel source blocks
+;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,85 +20,52 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ob-core)
-(require 'org-src)
-(eval-when-compile
- (require 'cl))
-
-(defvar org-current-export-file)
-(defvar org-babel-lob-one-liner-regexp)
-(defvar org-babel-ref-split-regexp)
-(defvar org-list-forbidden-blocks)
-
-(declare-function org-babel-lob-get-info "ob-lob" ())
-(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
-(declare-function org-between-regexps-p "org"
- (start-re end-re &optional lim-up lim-down))
-(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-heading-components "org" ())
-(declare-function org-in-block-p "org" (names))
-(declare-function org-in-verbatim-emphasis "org" ())
-(declare-function org-link-search "org" (s &optional type avoid-pos stealth))
-(declare-function org-fill-template "org" (template alist))
-(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
+
+(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
+(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-escape-code-in-string "org-src" (s))
+(declare-function org-export-copy-buffer "ox" ())
+(declare-function org-fill-template "org" (template alist))
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+
+(defvar org-src-preserve-indentation)
-(defcustom org-export-babel-evaluate t
- "Switch controlling code evaluation during export.
+(defcustom org-export-use-babel t
+ "Switch controlling code evaluation and header processing during export.
When set to nil no code will be evaluated as part of the export
-process. When set to `inline-only', only inline code blocks will
-be executed."
+process and no header arguments will be obeyed. Users who wish
+to avoid evaluating code on export should use the header argument
+`:eval never-export'."
:group 'org-babel
:version "24.1"
:type '(choice (const :tag "Never" nil)
- (const :tag "Only inline code" inline-only)
- (const :tag "Always" t)))
-(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
-
-(defun org-babel-exp-get-export-buffer ()
- "Return the current export buffer if possible."
- (cond
- ((bufferp org-current-export-file) org-current-export-file)
- (org-current-export-file (get-file-buffer org-current-export-file))
- ('otherwise
- (error "Requested export buffer when `org-current-export-file' is nil"))))
-
-(defvar org-link-search-inhibit-query)
-
-(defmacro org-babel-exp-in-export-file (lang &rest body)
- (declare (indent 1))
- `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
- (heading (nth 4 (ignore-errors (org-heading-components))))
- (export-buffer (current-buffer))
- (original-buffer (org-babel-exp-get-export-buffer)) results)
- (when original-buffer
- ;; resolve parameters in the original file so that
- ;; headline and file-wide parameters are included, attempt
- ;; to go to the same heading in the original file
- (set-buffer original-buffer)
- (save-restriction
- (when heading
- (condition-case nil
- (let ((org-link-search-inhibit-query t))
- (org-link-search heading))
- (error (when heading
- (goto-char (point-min))
- (re-search-forward (regexp-quote heading) nil t)))))
- (setq results ,@body))
- (set-buffer export-buffer)
- results)))
-(def-edebug-spec org-babel-exp-in-export-file (form body))
-
-(defun org-babel-exp-src-block (&rest headers)
+ (const :tag "Always" t))
+ :safe #'null)
+
+
+(defmacro org-babel-exp--at-source (&rest body)
+ "Evaluate BODY at the source of the Babel block at point.
+Source is located in `org-babel-exp-reference-buffer'. The value
+returned is the value of the last form in BODY. Assume that
+point is at the beginning of the Babel block."
+ (declare (indent 1) (debug body))
+ `(let ((source (get-text-property (point) 'org-reference)))
+ (with-current-buffer org-babel-exp-reference-buffer
+ (org-with-wide-buffer
+ (goto-char source)
+ ,@body))))
+
+(defun org-babel-exp-src-block ()
"Process source block for export.
-Depending on the `export' headers argument, replace the source
+Depending on the \":export\" header argument, replace the source
code block like this:
both ---- display the code and the results
@@ -107,29 +74,36 @@ code ---- the default, display the code inside the block but do
not process
results - just like none only the block is run on export ensuring
- that it's results are present in the org-mode buffer
+ that its results are present in the Org mode buffer
none ---- do not display either code or results upon export
-Assume point is at the beginning of block's starting line."
+Assume point is at block opening line."
(interactive)
- (unless noninteractive (message "org-babel-exp processing..."))
(save-excursion
(let* ((info (org-babel-get-src-block-info 'light))
(lang (nth 0 info))
- (raw-params (nth 2 info)) hash)
+ (raw-params (nth 2 info))
+ hash)
;; bail if we couldn't get any info from the block
+ (unless noninteractive
+ (message "org-babel-exp process %s at position %d..."
+ lang
+ (line-beginning-position)))
(when info
;; if we're actually going to need the parameters
- (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results"))
- (org-babel-exp-in-export-file lang
- (setf (nth 2 info)
- (org-babel-process-params
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- (if (boundp lang-headers) (eval lang-headers) nil)
- (append (org-babel-params-from-properties lang)
- (list raw-params))))))
+ (when (member (cdr (assq :exports (nth 2 info))) '("both" "results"))
+ (let ((lang-headers (intern (concat "org-babel-default-header-args:"
+ lang))))
+ (org-babel-exp--at-source
+ (setf (nth 2 info)
+ (org-babel-process-params
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (and (boundp lang-headers)
+ (symbol-value lang-headers))
+ (append (org-babel-params-from-properties lang)
+ (list raw-params)))))))
(setf hash (org-babel-sha1-hash info)))
(org-babel-exp-do-export info 'block hash)))))
@@ -150,166 +124,178 @@ this template."
:group 'org-babel
:type 'string)
-(defvar org-babel-default-lob-header-args)
(defun org-babel-exp-process-buffer ()
"Execute all Babel blocks in current buffer."
(interactive)
- (save-window-excursion
- (save-excursion
+ (when org-export-use-babel
+ (save-window-excursion
(let ((case-fold-search t)
- (regexp (concat org-babel-inline-src-block-regexp "\\|"
- org-babel-lob-one-liner-regexp "\\|"
- "^[ \t]*#\\+BEGIN_SRC")))
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (let* ((element (save-excursion
- ;; If match is inline, point is at its
- ;; end. Move backward so
- ;; `org-element-context' can get the
- ;; object, not the following one.
- (backward-char)
- (save-match-data (org-element-context))))
- (type (org-element-type element))
- (begin (copy-marker (org-element-property :begin element)))
- (end (copy-marker
- (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (point)))))
- (case type
- (inline-src-block
- (let* ((info (org-babel-parse-inline-src-block-match))
- (params (nth 2 info)))
- (setf (nth 1 info)
- (if (and (cdr (assoc :noweb params))
- (string= "yes" (cdr (assoc :noweb params))))
- (org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
- (nth 1 info)))
- (goto-char begin)
- (let ((replacement (org-babel-exp-do-export info 'inline)))
- (if (equal replacement "")
- ;; Replacement code is empty: remove inline src
- ;; block, including extra white space that
- ;; might have been created when inserting
- ;; results.
- (delete-region begin
- (progn (goto-char end)
- (skip-chars-forward " \t")
- (point)))
- ;; Otherwise: remove inline src block but
- ;; preserve following white spaces. Then insert
- ;; value.
- (delete-region begin end)
- (insert replacement)))))
- ((babel-call inline-babel-call)
- (let* ((lob-info (org-babel-lob-get-info))
- (results
- (org-babel-exp-do-export
- (list "emacs-lisp" "results"
- (apply #'org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
- (append
- (org-babel-params-from-properties)
- (list
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat
- ":var results="
- (mapconcat 'identity
- (butlast lob-info 2)
- " ")))))))
- "" (nth 3 lob-info) (nth 2 lob-info))
- 'lob))
- (rep (org-fill-template
- org-babel-exp-call-line-template
- `(("line" . ,(nth 0 lob-info))))))
- ;; If replacement is empty, completely remove the
- ;; object/element, including any extra white space
- ;; that might have been created when including
- ;; results.
- (if (equal rep "")
- (delete-region
- begin
- (progn (goto-char end)
- (if (not (eq type 'babel-call))
- (progn (skip-chars-forward " \t") (point))
- (skip-chars-forward " \r\t\n")
- (line-beginning-position))))
- ;; Otherwise, preserve following white
- ;; spaces/newlines and then, insert replacement
- ;; string.
- (goto-char begin)
- (delete-region begin end)
- (insert rep))))
- (src-block
- (let* ((match-start (copy-marker (match-beginning 0)))
- (ind (org-get-indentation))
- (headers
- (cons
- (org-element-property :language element)
- (let ((params (org-element-property :parameters
- element)))
- (and params (org-split-string params "[ \t]+"))))))
- ;; Take care of matched block: compute replacement
- ;; string. In particular, a nil REPLACEMENT means
- ;; the block should be left as-is while an empty
- ;; string should remove the block.
- (let ((replacement (progn (goto-char match-start)
- (org-babel-exp-src-block headers))))
- (cond ((not replacement) (goto-char end))
- ((equal replacement "")
- (goto-char end)
- (skip-chars-forward " \r\t\n")
- (beginning-of-line)
- (delete-region begin (point)))
- (t
- (goto-char match-start)
- (delete-region (point)
- (save-excursion (goto-char end)
- (line-end-position)))
- (insert replacement)
- (if (or org-src-preserve-indentation
- (org-element-property :preserve-indent
- element))
- ;; Indent only the code block markers.
- (save-excursion (skip-chars-backward " \r\t\n")
- (indent-line-to ind)
- (goto-char match-start)
- (indent-line-to ind))
- ;; Indent everything.
- (indent-rigidly match-start (point) ind)))))
- (set-marker match-start nil))))
- (set-marker begin nil)
- (set-marker end nil)))))))
-
-(defun org-babel-in-example-or-verbatim ()
- "Return true if point is in example or verbatim code.
-Example and verbatim code include escaped portions of
-an org-mode buffer code that should be treated as normal
-org-mode text."
- (or (save-match-data
- (save-excursion
- (goto-char (point-at-bol))
- (looking-at "[ \t]*:[ \t]")))
- (org-in-verbatim-emphasis)
- (org-in-block-p org-list-forbidden-blocks)
- (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
+ (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")
+ ;; Get a pristine copy of current buffer so Babel
+ ;; references are properly resolved and source block
+ ;; context is preserved.
+ (org-babel-exp-reference-buffer (org-export-copy-buffer)))
+ (unwind-protect
+ (save-excursion
+ ;; First attach to every source block their original
+ ;; position, so that they can be retrieved within
+ ;; `org-babel-exp-reference-buffer', even after heavy
+ ;; modifications on current buffer.
+ ;;
+ ;; False positives are harmless, so we don't check if
+ ;; we're really at some Babel object. Moreover,
+ ;; `line-end-position' ensures that we propertize
+ ;; a noticeable part of the object, without affecting
+ ;; multiple objects on the same line.
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (let ((s (match-beginning 0)))
+ (put-text-property s (line-end-position) 'org-reference s)))
+ ;; Evaluate from top to bottom every Babel block
+ ;; encountered.
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (unless (save-match-data (org-in-commented-heading-p))
+ (let* ((object? (match-end 1))
+ (element (save-match-data
+ (if object? (org-element-context)
+ ;; No deep inspection if we're
+ ;; just looking for an element.
+ (org-element-at-point))))
+ (type
+ (pcase (org-element-type element)
+ ;; Discard block elements if we're looking
+ ;; for inline objects. False results
+ ;; happen when, e.g., "call_" syntax is
+ ;; located within affiliated keywords:
+ ;;
+ ;; #+name: call_src
+ ;; #+begin_src ...
+ ((and (or `babel-call `src-block) (guard object?))
+ nil)
+ (type type)))
+ (begin
+ (copy-marker (org-element-property :begin element)))
+ (end
+ (copy-marker
+ (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (point)))))
+ (pcase type
+ (`inline-src-block
+ (let* ((info
+ (org-babel-get-src-block-info nil element))
+ (params (nth 2 info)))
+ (setf (nth 1 info)
+ (if (and (cdr (assq :noweb params))
+ (string= "yes"
+ (cdr (assq :noweb params))))
+ (org-babel-expand-noweb-references
+ info org-babel-exp-reference-buffer)
+ (nth 1 info)))
+ (goto-char begin)
+ (let ((replacement
+ (org-babel-exp-do-export info 'inline)))
+ (if (equal replacement "")
+ ;; Replacement code is empty: remove
+ ;; inline source block, including extra
+ ;; white space that might have been
+ ;; created when inserting results.
+ (delete-region begin
+ (progn (goto-char end)
+ (skip-chars-forward " \t")
+ (point)))
+ ;; Otherwise: remove inline src block but
+ ;; preserve following white spaces. Then
+ ;; insert value.
+ (delete-region begin end)
+ (insert replacement)))))
+ ((or `babel-call `inline-babel-call)
+ (org-babel-exp-do-export (org-babel-lob-get-info element)
+ 'lob)
+ (let ((rep
+ (org-fill-template
+ org-babel-exp-call-line-template
+ `(("line" .
+ ,(org-element-property :value element))))))
+ ;; If replacement is empty, completely remove
+ ;; the object/element, including any extra
+ ;; white space that might have been created
+ ;; when including results.
+ (if (equal rep "")
+ (delete-region
+ begin
+ (progn (goto-char end)
+ (if (not (eq type 'babel-call))
+ (progn (skip-chars-forward " \t")
+ (point))
+ (skip-chars-forward " \r\t\n")
+ (line-beginning-position))))
+ ;; Otherwise, preserve trailing
+ ;; spaces/newlines and then, insert
+ ;; replacement string.
+ (goto-char begin)
+ (delete-region begin end)
+ (insert rep))))
+ (`src-block
+ (let ((match-start (copy-marker (match-beginning 0)))
+ (ind (org-get-indentation)))
+ ;; Take care of matched block: compute
+ ;; replacement string. In particular, a nil
+ ;; REPLACEMENT means the block is left as-is
+ ;; while an empty string removes the block.
+ (let ((replacement
+ (progn (goto-char match-start)
+ (org-babel-exp-src-block))))
+ (cond ((not replacement) (goto-char end))
+ ((equal replacement "")
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (delete-region begin (point)))
+ (t
+ (goto-char match-start)
+ (delete-region (point)
+ (save-excursion
+ (goto-char end)
+ (line-end-position)))
+ (insert replacement)
+ (if (or org-src-preserve-indentation
+ (org-element-property
+ :preserve-indent element))
+ ;; Indent only code block
+ ;; markers.
+ (save-excursion
+ (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char match-start)
+ (indent-line-to ind))
+ ;; Indent everything.
+ (indent-rigidly
+ match-start (point) ind)))))
+ (set-marker match-start nil))))
+ (set-marker begin nil)
+ (set-marker end nil)))))
+ (kill-buffer org-babel-exp-reference-buffer)
+ (remove-text-properties (point-min) (point-max) '(org-reference)))))))
(defun org-babel-exp-do-export (info type &optional hash)
"Return a string with the exported content of a code block.
The function respects the value of the :exports header argument."
- (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info)))))
- (when (not (and session (equal "none" session)))
- (org-babel-exp-results info type 'silent)))))
- (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info)))))
- (case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
- ('none (funcall silently) (funcall clean) "")
- ('code (funcall silently) (funcall clean) (org-babel-exp-code info))
- ('results (org-babel-exp-results info type nil hash) "")
- ('both (org-babel-exp-results info type nil hash)
- (org-babel-exp-code info)))))
+ (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info)))))
+ (unless (equal "none" session)
+ (org-babel-exp-results info type 'silent)))))
+ (clean (lambda () (if (eq type 'inline)
+ (org-babel-remove-inline-result)
+ (org-babel-remove-result info)))))
+ (pcase (or (cdr (assq :exports (nth 2 info))) "code")
+ ("none" (funcall silently) (funcall clean) "")
+ ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type))
+ ("results" (org-babel-exp-results info type nil hash) "")
+ ("both"
+ (org-babel-exp-results info type nil hash)
+ (org-babel-exp-code info type)))))
(defcustom org-babel-exp-code-template
"#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
@@ -331,18 +317,42 @@ replaced with its value."
:group 'org-babel
:type 'string)
-(defun org-babel-exp-code (info)
+(defcustom org-babel-exp-inline-code-template
+ "src_%lang[%switches%flags]{%body}"
+ "Template used to export the body of inline code blocks.
+This template may be customized to include additional information
+such as the code block name, or the values of particular header
+arguments. The template is filled out using `org-fill-template',
+and the following %keys may be used.
+
+ lang ------ the language of the code block
+ name ------ the name of the code block
+ body ------ the body of the code block
+ switches -- the switches associated to the code block
+ flags ----- the flags passed to the code block
+
+In addition to the keys mentioned above, every header argument
+defined for the code block may be used as a key and will be
+replaced with its value."
+ :group 'org-babel
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "8.3"))
+
+(defun org-babel-exp-code (info type)
"Return the original code block formatted for export."
(setf (nth 1 info)
- (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
+ (if (string= "strip-export" (cdr (assq :noweb (nth 2 info))))
(replace-regexp-in-string
(org-babel-noweb-wrap) "" (nth 1 info))
(if (org-babel-noweb-p (nth 2 info) :export)
(org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
+ info org-babel-exp-reference-buffer)
(nth 1 info))))
(org-fill-template
- org-babel-exp-code-template
+ (if (eq type 'inline)
+ org-babel-exp-inline-code-template
+ org-babel-exp-code-template)
`(("lang" . ,(nth 0 info))
("body" . ,(org-escape-code-in-string (nth 1 info)))
("switches" . ,(let ((f (nth 3 info)))
@@ -357,48 +367,41 @@ replaced with its value."
(defun org-babel-exp-results (info type &optional silent hash)
"Evaluate and return the results of the current code block for export.
-Results are prepared in a manner suitable for export by org-mode.
+Results are prepared in a manner suitable for export by Org mode.
This function is called by `org-babel-exp-do-export'. The code
block will be evaluated. Optional argument SILENT can be used to
inhibit insertion of results into the buffer."
- (when (and (or (eq org-export-babel-evaluate t)
- (and (eq type 'inline)
- (eq org-export-babel-evaluate 'inline-only)))
- (not (and hash (equal hash (org-babel-current-result-hash)))))
+ (unless (and hash (equal hash (org-babel-current-result-hash)))
(let ((lang (nth 0 info))
(body (if (org-babel-noweb-p (nth 2 info) :eval)
(org-babel-expand-noweb-references
- info (org-babel-exp-get-export-buffer))
+ info org-babel-exp-reference-buffer)
(nth 1 info)))
(info (copy-sequence info))
(org-babel-current-src-block-location (point-marker)))
- ;; skip code blocks which we can't evaluate
+ ;; Skip code blocks which we can't evaluate.
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
- (prog1 nil
- (setf (nth 1 info) body)
- (setf (nth 2 info)
- (org-babel-exp-in-export-file lang
- (org-babel-process-params
- (org-babel-merge-params
- (nth 2 info)
- `((:results . ,(if silent "silent" "replace")))))))
- (cond
- ((equal type 'block)
- (org-babel-execute-src-block nil info))
- ((equal type 'inline)
- ;; position the point on the inline source block allowing
- ;; `org-babel-insert-result' to check that the block is
- ;; inline
- (re-search-backward "[ \f\t\n\r\v]" nil t)
- (re-search-forward org-babel-inline-src-block-regexp nil t)
- (re-search-backward "src_" nil t)
+ (setf (nth 1 info) body)
+ (setf (nth 2 info)
+ (org-babel-exp--at-source
+ (org-babel-process-params
+ (org-babel-merge-params
+ (nth 2 info)
+ `((:results . ,(if silent "silent" "replace")))))))
+ (pcase type
+ (`block (org-babel-execute-src-block nil info))
+ (`inline
+ ;; Position the point on the inline source block
+ ;; allowing `org-babel-insert-result' to check that the
+ ;; block is inline.
+ (goto-char (nth 5 info))
(org-babel-execute-src-block nil info))
- ((equal type 'lob)
- (save-excursion
- (re-search-backward org-babel-lob-one-liner-regexp nil t)
- (let (org-confirm-babel-evaluate)
- (org-babel-execute-src-block nil info))))))))))
+ (`lob
+ (save-excursion
+ (goto-char (nth 5 info))
+ (let (org-confirm-babel-evaluate)
+ (org-babel-execute-src-block nil info)))))))))
(provide 'ob-exp)
diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el
new file mode 100644
index 00000000000..bb8d9af4789
--- /dev/null
+++ b/lisp/org/ob-forth.el
@@ -0,0 +1,87 @@
+;;; ob-forth.el --- Babel Functions for Forth -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research, forth
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Requires the gforth forth compiler and `forth-mode' (see below).
+;; https://www.gnu.org/software/gforth/
+
+;;; Requirements:
+
+;; Session evaluation requires the gforth forth compiler as well as
+;; `forth-mode' which is distributed with gforth (in gforth.el).
+
+;;; Code:
+(require 'ob)
+
+(declare-function forth-proc "ext:gforth" ())
+(declare-function org-trim "org" (s &optional keep-lead))
+
+(defvar org-babel-default-header-args:forth '((:session . "yes"))
+ "Default header arguments for forth code blocks.")
+
+(defun org-babel-execute:forth (body params)
+ "Execute a block of Forth code with org-babel.
+This function is called by `org-babel-execute-src-block'"
+ (if (string= "none" (cdr (assq :session params)))
+ (error "Non-session evaluation not supported for Forth code blocks")
+ (let ((all-results (org-babel-forth-session-execute body params)))
+ (if (member "output" (cdr (assq :result-params params)))
+ (mapconcat #'identity all-results "\n")
+ (car (last all-results))))))
+
+(defun org-babel-forth-session-execute (body params)
+ (require 'forth-mode)
+ (let ((proc (forth-proc))
+ (rx " \\(\n:\\|compiled\n\\\|ok\n\\)")
+ (result-start))
+ (with-current-buffer (process-buffer (forth-proc))
+ (mapcar (lambda (line)
+ (setq result-start (progn (goto-char (process-mark proc))
+ (point)))
+ (comint-send-string proc (concat line "\n"))
+ ;; wait for forth to say "ok"
+ (while (not (progn (goto-char result-start)
+ (re-search-forward rx nil t)))
+ (accept-process-output proc 0.01))
+ (let ((case (match-string 1)))
+ (cond
+ ((string= "ok\n" case)
+ ;; Collect intermediate output.
+ (buffer-substring (+ result-start 1 (length line))
+ (match-beginning 0)))
+ ((string= "compiled\n" case))
+ ;; Ignore partial compilation.
+ ((string= "\n:" case)
+ ;; Report errors.
+ (org-babel-eval-error-notify 1
+ (buffer-substring
+ (+ (match-beginning 0) 1) (point-max))) nil))))
+ (split-string (org-trim
+ (org-babel-expand-body:generic body params))
+ "\n"
+ 'omit-nulls)))))
+
+(provide 'ob-forth)
+
+;;; ob-forth.el ends here
diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el
index 6a6112df9bd..50b12fc256a 100644
--- a/lisp/org/ob-fortran.el
+++ b/lisp/org/ob-fortran.el
@@ -1,4 +1,4 @@
-;;; ob-fortran.el --- org-babel functions for fortran
+;;; ob-fortran.el --- Babel Functions for Fortran -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,10 +29,12 @@
;;; Code:
(require 'ob)
(require 'cc-mode)
+(require 'cl-lib)
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
-(declare-function org-every "org" (pred seq))
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -47,43 +49,42 @@
"This function should only be called by `org-babel-execute:fortran'"
(let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90"))
(tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext))
- (cmdline (cdr (assoc :cmdline params)))
- (flags (cdr (assoc :flags params)))
- (full-body (org-babel-expand-body:fortran body params))
- (compile
- (progn
- (with-temp-file tmp-src-file (insert full-body))
- (org-babel-eval
- (format "%s -o %s %s %s"
- org-babel-fortran-compiler
- (org-babel-process-file-name tmp-bin-file)
- (mapconcat 'identity
- (if (listp flags) flags (list flags)) " ")
- (org-babel-process-file-name tmp-src-file)) ""))))
+ (cmdline (cdr (assq :cmdline params)))
+ (flags (cdr (assq :flags params)))
+ (full-body (org-babel-expand-body:fortran body params)))
+ (with-temp-file tmp-src-file (insert full-body))
+ (org-babel-eval
+ (format "%s -o %s %s %s"
+ org-babel-fortran-compiler
+ (org-babel-process-file-name tmp-bin-file)
+ (mapconcat 'identity
+ (if (listp flags) flags (list flags)) " ")
+ (org-babel-process-file-name tmp-src-file)) "")
(let ((results
- (org-babel-trim
- (org-babel-eval
- (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-trim
+ (org-remove-indentation
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))))
(org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results)
(let ((tmp-file (org-babel-temp-file "f-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-expand-body:fortran (body params)
"Expand a block of fortran or fortran code with org-babel according to
-it's header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (main-p (not (string= (cdr (assoc :main params)) "no")))
- (includes (or (cdr (assoc :includes params))
+its header arguments."
+ (let ((vars (org-babel--get-vars params))
+ (main-p (not (string= (cdr (assq :main params)) "no")))
+ (includes (or (cdr (assq :includes params))
(org-babel-read (org-entry-get nil "includes" t))))
(defines (org-babel-read
- (or (cdr (assoc :defines params))
+ (or (cdr (assq :defines params))
(org-babel-read (org-entry-get nil "defines" t))))))
(mapconcat 'identity
(list
@@ -107,17 +108,17 @@ it's header arguments."
(defun org-babel-fortran-ensure-main-wrap (body params)
"Wrap body in a \"program ... end program\" block if none exists."
(if (string-match "^[ \t]*program[ \t]*.*" (capitalize body))
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(if vars (error "Cannot use :vars if `program' statement is present"))
body)
(format "program main\n%s\nend program main\n" body)))
-(defun org-babel-prep-session:fortran (session params)
+(defun org-babel-prep-session:fortran (_session _params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
(error "Fortran is a compiled languages -- no support for sessions"))
-(defun org-babel-load-session:fortran (session body params)
+(defun org-babel-load-session:fortran (_session _body _params)
"This function does nothing as fortran is a compiled language with no
support for sessions"
(error "Fortran is a compiled languages -- no support for sessions"))
@@ -145,7 +146,7 @@ of the same value."
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
;; val is a matrix
- ((and (listp val) (org-every #'listp val))
+ ((and (listp val) (cl-every #'listp val))
(format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n"
var (length val) (length (car val))
(org-babel-fortran-transform-list val)
diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el
index 82b103e52cd..b0743f60475 100644
--- a/lisp/org/ob-gnuplot.el
+++ b/lisp/org/ob-gnuplot.el
@@ -1,4 +1,4 @@
-;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation
+;;; ob-gnuplot.el --- Babel Functions for Gnuplot -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -39,12 +39,10 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
-(declare-function org-time-string-to-time "org" (s &optional buffer pos))
+(declare-function org-time-string-to-time "org" (s))
(declare-function org-combine-plists "org" (&rest plists))
-(declare-function orgtbl-to-generic "org-table"
- (table params &optional backend))
+(declare-function orgtbl-to-generic "org-table" (table params))
(declare-function gnuplot-mode "ext:gnuplot-mode" ())
(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt))
(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ())
@@ -65,7 +63,7 @@
(term . :any))
"Gnuplot specific header args.")
-(defvar org-babel-gnuplot-timestamp-fmt nil)
+(defvar org-babel-gnuplot-timestamp-fmt nil) ; Dynamically scoped.
(defvar *org-babel-gnuplot-missing* nil)
@@ -81,7 +79,7 @@
Dumps all vectors into files and returns an association list
of variable names and the related value to be used in the gnuplot
code."
- (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params))))
+ (let ((*org-babel-gnuplot-missing* (cdr (assq :missing params))))
(mapcar
(lambda (pair)
(cons
@@ -95,38 +93,33 @@ code."
(if tablep val (mapcar 'list val)))
(org-babel-temp-file "gnuplot-") params)
val))))
- (mapcar #'cdr (org-babel-get-header params :var)))))
+ (org-babel--get-vars params))))
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
- (out-file (cdr (assoc :file params)))
- (prologue (cdr (assoc :prologue params)))
- (epilogue (cdr (assoc :epilogue params)))
- (term (or (cdr (assoc :term params))
+ (out-file (cdr (assq :file params)))
+ (prologue (cdr (assq :prologue params)))
+ (epilogue (cdr (assq :epilogue params)))
+ (term (or (cdr (assq :term params))
(when out-file
(let ((ext (file-name-extension out-file)))
(or (cdr (assoc (intern (downcase ext))
*org-babel-gnuplot-terms*))
ext)))))
- (cmdline (cdr (assoc :cmdline params)))
- (title (cdr (assoc :title params)))
- (lines (cdr (assoc :line params)))
- (sets (cdr (assoc :set params)))
- (x-labels (cdr (assoc :xlabels params)))
- (y-labels (cdr (assoc :ylabels params)))
- (timefmt (cdr (assoc :timefmt params)))
- (time-ind (or (cdr (assoc :timeind params))
+ (title (cdr (assq :title params)))
+ (lines (cdr (assq :line params)))
+ (sets (cdr (assq :set params)))
+ (x-labels (cdr (assq :xlabels params)))
+ (y-labels (cdr (assq :ylabels params)))
+ (timefmt (cdr (assq :timefmt params)))
+ (time-ind (or (cdr (assq :timeind params))
(when timefmt 1)))
- (missing (cdr (assoc :missing params)))
- (add-to-body (lambda (text) (setq body (concat text "\n" body))))
- output)
+ (add-to-body (lambda (text) (setq body (concat text "\n" body)))))
;; append header argument settings to body
(when title (funcall add-to-body (format "set title '%s'" title)))
(when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
- (when missing
- (funcall add-to-body (format "set datafile missing '%s'" missing)))
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
@@ -175,9 +168,8 @@ code."
"Execute a block of Gnuplot code.
This function is called by `org-babel-execute-src-block'."
(require 'gnuplot)
- (let ((session (cdr (assoc :session params)))
- (result-type (cdr (assoc :results params)))
- (out-file (cdr (assoc :file params)))
+ (let ((session (cdr (assq :session params)))
+ (result-type (cdr (assq :results params)))
(body (org-babel-expand-body:gnuplot body params))
output)
(save-window-excursion
@@ -195,7 +187,7 @@ This function is called by `org-babel-execute-src-block'."
script-file
(if (member system-type '(cygwin windows-nt ms-dos))
t nil)))))
- (message output))
+ (message "%s" output))
(with-temp-buffer
(insert (concat body "\n"))
(gnuplot-mode)
@@ -210,10 +202,12 @@ This function is called by `org-babel-execute-src-block'."
(var-lines (org-babel-variable-assignments:gnuplot params)))
(message "%S" session)
(org-babel-comint-in-buffer session
- (mapc (lambda (var-line)
- (insert var-line) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)
- (sit-for .1) (goto-char (point-max))) var-lines))
+ (dolist (var-line var-lines)
+ (insert var-line)
+ (comint-send-input nil t)
+ (org-babel-comint-wait-for-output session)
+ (sit-for .1)
+ (goto-char (point-max))))
session))
(defun org-babel-load-session:gnuplot (session body params)
@@ -232,7 +226,7 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-gnuplot-process-vars params)))
(defvar gnuplot-buffer)
-(defun org-babel-gnuplot-initiate-session (&optional session params)
+(defun org-babel-gnuplot-initiate-session (&optional session _params)
"Initiate a gnuplot session.
If there is not a current inferior-process-buffer in SESSION
then create one. Return the initialized session. The current
@@ -268,15 +262,13 @@ then create one. Return the initialized session. The current
"Export TABLE to DATA-FILE in a format readable by gnuplot.
Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(with-temp-file data-file
- (make-local-variable 'org-babel-gnuplot-timestamp-fmt)
- (setq org-babel-gnuplot-timestamp-fmt (or
- (plist-get params :timefmt)
- "%Y-%m-%d-%H:%M:%S"))
- (insert (orgtbl-to-generic
- table
- (org-combine-plists
- '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field)
- params))))
+ (insert (let ((org-babel-gnuplot-timestamp-fmt
+ (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S")))
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field)
+ params)))))
data-file)
(provide 'ob-gnuplot)
diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el
new file mode 100644
index 00000000000..1e602dd0cf1
--- /dev/null
+++ b/lisp/org/ob-groovy.el
@@ -0,0 +1,116 @@
+;;; ob-groovy.el --- Babel Functions for Groovy -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
+
+;; Author: Miro Bezjak
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;; Currently only supports the external execution. No session support yet.
+
+;;; Requirements:
+;; - Groovy language :: http://groovy.codehaus.org
+;; - Groovy major mode :: Can be installed from MELPA or
+;; https://github.com/russel/Emacs-Groovy-Mode
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-tangle-lang-exts) ;; Autoloaded
+(add-to-list 'org-babel-tangle-lang-exts '("groovy" . "groovy"))
+(defvar org-babel-default-header-args:groovy '())
+(defcustom org-babel-groovy-command "groovy"
+ "Name of the command to use for executing Groovy code.
+May be either a command in the path, like groovy
+or an absolute path name, like /usr/local/bin/groovy
+parameters may be used, like groovy -v"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defun org-babel-execute:groovy (body params)
+ "Execute a block of Groovy code with org-babel. This function is
+called by `org-babel-execute-src-block'"
+ (message "executing Groovy source code block")
+ (let* ((processed-params (org-babel-process-params params))
+ (session (org-babel-groovy-initiate-session (nth 0 processed-params)))
+ (result-params (nth 2 processed-params))
+ (result-type (cdr (assq :result-type params)))
+ (full-body (org-babel-expand-body:generic
+ body params))
+ (result (org-babel-groovy-evaluate
+ session full-body result-type result-params)))
+
+ (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))))))
+
+(defvar org-babel-groovy-wrapper-method
+
+ "class Runner extends Script {
+ def out = new PrintWriter(new ByteArrayOutputStream())
+ def run() { %s }
+}
+
+println(new Runner().run())
+")
+
+
+(defun org-babel-groovy-evaluate
+ (session body &optional result-type result-params)
+ "Evaluate BODY in external Groovy process.
+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."
+ (when session (error "Sessions are not (yet) supported for Groovy"))
+ (pcase result-type
+ (`output
+ (let ((src-file (org-babel-temp-file "groovy-")))
+ (progn (with-temp-file src-file (insert body))
+ (org-babel-eval
+ (concat org-babel-groovy-command " " src-file) ""))))
+ (`value
+ (let* ((src-file (org-babel-temp-file "groovy-"))
+ (wrapper (format org-babel-groovy-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ (let ((raw (org-babel-eval
+ (concat org-babel-groovy-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-script-escape raw)))))))
+
+
+(defun org-babel-prep-session:groovy (_session _params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (error "Sessions are not (yet) supported for Groovy"))
+
+(defun org-babel-groovy-initiate-session (&optional _session)
+ "If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session. Sessions are not
+supported in Groovy."
+ nil)
+
+(provide 'ob-groovy)
+
+
+
+;;; ob-groovy.el ends here
diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el
index ce6b8edbeb8..cc78bec33d6 100644
--- a/lisp/org/ob-haskell.el
+++ b/lisp/org/ob-haskell.el
@@ -1,4 +1,4 @@
-;;; ob-haskell.el --- org-babel functions for haskell evaluation
+;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -41,9 +41,9 @@
;;; Code:
(require 'ob)
(require 'comint)
-(eval-when-compile (require 'cl))
(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function haskell-mode "ext:haskell-mode" ())
(declare-function run-haskell "ext:inf-haskell" (&optional arg))
(declare-function inferior-haskell-load-file
@@ -61,42 +61,35 @@
(defun org-babel-execute:haskell (body params)
"Execute a block of Haskell code."
- (let* ((session (cdr (assoc :session params)))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((session (cdr (assq :session params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:haskell params)))
(session (org-babel-haskell-initiate-session session params))
(raw (org-babel-comint-with-output
(session org-babel-haskell-eoe t full-body)
- (insert (org-babel-trim full-body))
+ (insert (org-trim full-body))
(comint-send-input nil t)
(insert org-babel-haskell-eoe)
(comint-send-input nil t)))
(results (mapcar
- #'org-babel-haskell-read-string
+ #'org-babel-strip-quotes
(cdr (member org-babel-haskell-eoe
- (reverse (mapcar #'org-babel-trim raw)))))))
+ (reverse (mapcar #'org-trim raw)))))))
(org-babel-reassemble-table
(let ((result
- (case result-type
- (output (mapconcat #'identity (reverse (cdr results)) "\n"))
- (value (car results)))))
- (org-babel-result-cond (cdr (assoc :result-params params))
- result (org-babel-haskell-table-or-string result)))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colname-names params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rowname-names params))))))
-
-(defun org-babel-haskell-read-string (string)
- "Strip \\\"s from around a haskell string."
- (if (string-match "^\"\\([^\000]+\\)\"$" string)
- (match-string 1 string)
- string))
-
-(defun org-babel-haskell-initiate-session (&optional session params)
+ (pcase result-type
+ (`output (mapconcat #'identity (reverse (cdr results)) "\n"))
+ (`value (car results)))))
+ (org-babel-result-cond (cdr (assq :result-params params))
+ result (org-babel-script-escape result)))
+ (org-babel-pick-name (cdr (assq :colname-names params))
+ (cdr (assq :colname-names params)))
+ (org-babel-pick-name (cdr (assq :rowname-names params))
+ (cdr (assq :rowname-names 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
then create one. Return the initialized session."
@@ -131,13 +124,7 @@ then create one. Return the initialized session."
(format "let %s = %s"
(car pair)
(org-babel-haskell-var-to-haskell (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
-
-(defun org-babel-haskell-table-or-string (results)
- "Convert RESULTS to an Emacs-lisp table or string.
-If RESULTS look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
+ (org-babel--get-vars params)))
(defun org-babel-haskell-var-to-haskell (var)
"Convert an elisp value VAR into a haskell variable.
@@ -157,7 +144,7 @@ specifying a variable of the same value."
When called with a prefix argument the resulting
.lhs file will be exported to a .tex file. This function will
create two new files, base-name.lhs and base-name.tex where
-base-name is the name of the current org-mode file.
+base-name is the name of the current Org file.
Note that all standard Babel literate programming
constructs (header arguments, no-web syntax etc...) are ignored."
@@ -185,12 +172,12 @@ constructs (header arguments, no-web syntax etc...) are ignored."
(save-match-data (setq indentation (length (match-string 1))))
(replace-match (save-match-data
(concat
- "#+begin_latex\n\\begin{code}\n"
+ "#+begin_export latex\n\\begin{code}\n"
(if (or preserve-indentp
(string-match "-i" (match-string 2)))
(match-string 3)
(org-remove-indentation (match-string 3)))
- "\n\\end{code}\n#+end_latex\n"))
+ "\n\\end{code}\n#+end_export\n"))
t t)
(indent-code-rigidly (match-beginning 0) (match-end 0) indentation)))
(save-excursion
diff --git a/lisp/org/ob-hledger.el b/lisp/org/ob-hledger.el
new file mode 100644
index 00000000000..57ab8af4f30
--- /dev/null
+++ b/lisp/org/ob-hledger.el
@@ -0,0 +1,70 @@
+;; ob-hledger.el --- Babel Functions for hledger -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
+
+;; Author: Simon Michael
+;; Keywords: literate programming, reproducible research, plain text accounting
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Babel support for evaluating hledger entries.
+;;
+;; Based on ob-ledger.el.
+;; If the source block is empty, hledger will use a default journal file,
+;; 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.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-default-header-args:hledger
+ '((:results . "output") (:exports . "results") (:cmdline . "bal"))
+ "Default arguments to use when evaluating a hledger source block.")
+
+(defun org-babel-execute:hledger (body params)
+ "Execute a block of hledger entries with org-babel.
+This function is called by `org-babel-execute-src-block'."
+ (message "executing hledger source code block")
+ (letrec ( ;(result-params (split-string (or (cdr (assq :results params)) "")))
+ (cmdline (cdr (assq :cmdline params)))
+ (in-file (org-babel-temp-file "hledger-"))
+ (out-file (org-babel-temp-file "hledger-output-"))
+ (hledgercmd (concat "hledger"
+ (if (> (length body) 0)
+ (concat " -f " (org-babel-process-file-name in-file))
+ "")
+ " " cmdline)))
+ (with-temp-file in-file (insert body))
+;; TODO This is calling for some refactoring:
+;; (concat "hledger" (if ...) " " cmdline)
+;; could be built only once and bound to a symbol.
+ (message "%s" hledgercmd)
+ (with-output-to-string
+ (shell-command (concat hledgercmd " > " (org-babel-process-file-name out-file))))
+ (with-temp-buffer (insert-file-contents out-file) (buffer-string))))
+
+(defun org-babel-prep-session:hledger (_session _params)
+ (error "hledger does not support sessions"))
+
+(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 1d3a42aa38a..35b92ef62f5 100644
--- a/lisp/org/ob-io.el
+++ b/lisp/org/ob-io.el
@@ -1,4 +1,4 @@
-;;; ob-io.el --- org-babel functions for Io evaluation
+;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Currently only supports the external execution. No session support yet.
@@ -33,7 +33,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
(add-to-list 'org-babel-tangle-lang-exts '("io" . "io"))
@@ -47,9 +46,8 @@ called by `org-babel-execute-src-block'"
(message "executing Io source code block")
(let* ((processed-params (org-babel-process-params params))
(session (org-babel-io-initiate-session (nth 0 processed-params)))
- (vars (nth 1 processed-params))
(result-params (nth 2 processed-params))
- (result-type (cdr (assoc :result-type params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params))
(result (org-babel-io-evaluate
@@ -58,17 +56,9 @@ called by `org-babel-execute-src-block'"
(org-babel-reassemble-table
result
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
-
-
-(defun org-babel-io-table-or-string (results)
- "Convert RESULTS into an appropriate elisp value.
-If RESULTS look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
(defvar org-babel-io-wrapper-method
"(
@@ -79,33 +69,33 @@ Emacs-lisp table, otherwise return the results as a string."
(defun org-babel-io-evaluate (session body &optional result-type result-params)
"Evaluate BODY in external Io process.
-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
+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."
(when session (error "Sessions are not (yet) supported for Io"))
- (case result-type
- (output
+ (pcase result-type
+ (`output
(if (member "repl" result-params)
(org-babel-eval org-babel-io-command body)
(let ((src-file (org-babel-temp-file "io-")))
(progn (with-temp-file src-file (insert body))
(org-babel-eval
(concat org-babel-io-command " " src-file) "")))))
- (value (let* ((src-file (org-babel-temp-file "io-"))
- (wrapper (format org-babel-io-wrapper-method body)))
- (with-temp-file src-file (insert wrapper))
- (let ((raw (org-babel-eval
- (concat org-babel-io-command " " src-file) "")))
- (org-babel-result-cond result-params
- raw
- (org-babel-io-table-or-string raw)))))))
+ (`value (let* ((src-file (org-babel-temp-file "io-"))
+ (wrapper (format org-babel-io-wrapper-method body)))
+ (with-temp-file src-file (insert wrapper))
+ (let ((raw (org-babel-eval
+ (concat org-babel-io-command " " src-file) "")))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-script-escape raw)))))))
-(defun org-babel-prep-session:io (session params)
+(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"))
-(defun org-babel-io-initiate-session (&optional session)
+(defun org-babel-io-initiate-session (&optional _session)
"If there is not a current inferior-process-buffer in SESSION
then create. Return the initialized session. Sessions are not
supported in Io."
diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el
index 70a10e0131a..608e2e8858a 100644
--- a/lisp/org/ob-java.el
+++ b/lisp/org/ob-java.el
@@ -1,4 +1,4 @@
-;;; ob-java.el --- org-babel functions for java evaluation
+;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -32,41 +32,51 @@
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))
-(defvar org-babel-java-command "java"
- "Name of the java command.")
-
-(defvar org-babel-java-compiler "javac"
- "Name of the java compiler.")
+(defcustom org-babel-java-command "java"
+ "Name of the java command.
+May be either a command in the path, like java
+or an absolute path name, like /usr/local/bin/java
+parameters may be used, like java -verbose"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
+
+(defcustom org-babel-java-compiler "javac"
+ "Name of the java compiler.
+May be either a command in the path, like javac
+or an absolute path name, like /usr/local/bin/javac
+parameters may be used, like javac -verbose"
+ :group 'org-babel
+ :version "24.3"
+ :type 'string)
(defun org-babel-execute:java (body params)
- (let* ((classname (or (cdr (assoc :classname params))
+ (let* ((classname (or (cdr (assq :classname params))
(error
"Can't compile a java block without a classname")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
- (cmpflag (or (cdr (assoc :cmpflag params)) ""))
- (cmdline (or (cdr (assoc :cmdline params)) ""))
- (full-body (org-babel-expand-body:generic body params))
- (compile
- (progn (with-temp-file src-file (insert full-body))
- (org-babel-eval
- (concat org-babel-java-compiler
- " " cmpflag " " src-file) ""))))
+ (cmpflag (or (cdr (assq :cmpflag params)) ""))
+ (cmdline (or (cdr (assq :cmdline params)) ""))
+ (full-body (org-babel-expand-body:generic body params)))
+ (with-temp-file src-file (insert full-body))
+ (org-babel-eval
+ (concat org-babel-java-compiler " " cmpflag " " src-file) "")
;; created package-name directories if missing
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
(let ((results (org-babel-eval (concat org-babel-java-command
" " cmdline " " classname) "")))
(org-babel-reassemble-table
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
(org-babel-read results)
(let ((tmp-file (org-babel-temp-file "c-")))
(with-temp-file tmp-file (insert results))
(org-babel-import-elisp-from-file tmp-file)))
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(provide 'ob-java)
diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el
index f4f8116dfd7..e344b7a53c5 100644
--- a/lisp/org/ob-js.el
+++ b/lisp/org/ob-js.el
@@ -1,4 +1,4 @@
-;;; ob-js.el --- org-babel functions for Javascript
+;;; ob-js.el --- Babel Functions for Javascript -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -39,7 +39,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function run-mozilla "ext:moz" (arg))
@@ -56,20 +55,20 @@
:type 'string)
(defvar org-babel-js-function-wrapper
- "require('sys').print(require('sys').inspect(function(){%s}()));"
+ "require('sys').print(require('sys').inspect(function(){\n%s\n}()));"
"Javascript code to print value of body.")
(defun org-babel-execute:js (body params)
"Execute a block of Javascript code with org-babel.
This function is called by `org-babel-execute-src-block'"
- (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:js params)))
- (result (if (not (string= (cdr (assoc :session params)) "none"))
+ (result (if (not (string= (cdr (assq :session params)) "none"))
;; session evaluation
(let ((session (org-babel-prep-session:js
- (cdr (assoc :session params)) params)))
+ (cdr (assq :session params)) params)))
(nth 1
(org-babel-comint-with-output
(session (format "%S" org-babel-js-eoe) t body)
@@ -89,7 +88,7 @@ This function is called by `org-babel-execute-src-block'"
(org-babel-eval
(format "%s %s" org-babel-js-cmd
(org-babel-process-file-name script-file)) "")))))
- (org-babel-result-cond (cdr (assoc :result-params params))
+ (org-babel-result-cond (cdr (assq :result-params params))
result (org-babel-js-read result))))
(defun org-babel-js-read (results)
@@ -97,14 +96,17 @@ This function is called by `org-babel-execute-src-block'"
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(org-babel-read
- (if (and (stringp results) (string-match "^\\[.+\\]$" results))
+ (if (and (stringp results)
+ (string-prefix-p "[" results)
+ (string-suffix-p "]" results))
(org-babel-read
(concat "'"
(replace-regexp-in-string
"\\[" "(" (replace-regexp-in-string
"\\]" ")" (replace-regexp-in-string
- ", " " " (replace-regexp-in-string
- "'" "\"" results))))))
+ ",[[:space:]]" " "
+ (replace-regexp-in-string
+ "'" "\"" results))))))
results)))
(defun org-babel-js-var-to-js (var)
@@ -113,7 +115,7 @@ Convert an elisp value into a string of js source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]")
- (format "%S" var)))
+ (replace-regexp-in-string "\n" "\\\\n" (format "%S" var))))
(defun org-babel-prep-session:js (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@@ -133,7 +135,7 @@ specifying a variable of the same value."
(mapcar
(lambda (pair) (format "var %s=%s;"
(car pair) (org-babel-js-var-to-js (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-js-initiate-session (&optional session)
"If there is not a current inferior-process-buffer in SESSION
diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el
index b71fba416f7..170c00636c3 100644
--- a/lisp/org/ob-keys.el
+++ b/lisp/org/ob-keys.el
@@ -1,4 +1,4 @@
-;;; ob-keys.el --- key bindings for org-babel
+;;; ob-keys.el --- Key Bindings for Babel -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,12 +19,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; Add org-babel keybindings to the org-mode keymap for exposing
-;; org-babel functions. These will all share a common prefix. See
+;; Add Org Babel keybindings to the Org mode keymap for exposing
+;; Org Babel functions. These will all share a common prefix. See
;; the value of `org-babel-key-bindings' for a list of interactive
;; functions and their associated keys.
@@ -89,6 +89,7 @@ functions which are assigned key bindings, and see
("h" . org-babel-describe-bindings)
("\C-x" . org-babel-do-key-sequence-in-edit-buffer)
("x" . org-babel-do-key-sequence-in-edit-buffer)
+ ("k" . org-babel-remove-result-one-or-many)
("\C-\M-h" . org-babel-mark-block))
"Alist of key bindings and interactive Babel functions.
This list associates interactive Babel functions
diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el
index d00827645ef..6964fde5ac6 100644
--- a/lisp/org/ob-latex.el
+++ b/lisp/org/ob-latex.el
@@ -1,4 +1,4 @@
-;;; ob-latex.el --- org-babel functions for latex "evaluation"
+;;; ob-latex.el --- Babel Functions for LaTeX -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -32,12 +32,11 @@
;;; Code:
(require 'ob)
-(declare-function org-create-formula-image "org"
- (string tofile options buffer &optional type))
-(declare-function org-splice-latex-header "org"
- (tpl def-pkg pkg snippets-p &optional extra))
-(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-create-formula-image "org" (string tofile options buffer &optional type))
(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
+(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex"))
@@ -51,7 +50,22 @@
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
-(defcustom org-babel-latex-htlatex ""
+(defconst org-babel-header-args:latex
+ '((border . :any)
+ (fit . :any)
+ (imagemagick . ((nil t)))
+ (iminoptions . :any)
+ (imoutoptions . :any)
+ (packages . :any)
+ (pdfheight . :any)
+ (pdfpng . :any)
+ (pdfwidth . :any)
+ (headers . :any)
+ (packages . :any)
+ (buffer . ((yes no))))
+ "LaTeX-specific header arguments.")
+
+(defcustom org-babel-latex-htlatex "htlatex"
"The htlatex command to enable conversion of latex to SVG or HTML."
:group 'org-babel
:type 'string)
@@ -70,37 +84,82 @@
(regexp-quote (format "%S" (car pair)))
(if (stringp (cdr pair))
(cdr pair) (format "%S" (cdr pair)))
- body))) (mapcar #'cdr (org-babel-get-header params :var)))
- (org-babel-trim body))
+ body))) (org-babel--get-vars params))
+ (org-trim body))
(defun org-babel-execute:latex (body params)
"Execute a block of Latex code with Babel.
This function is called by `org-babel-execute-src-block'."
(setq body (org-babel-expand-body:latex body params))
- (if (cdr (assoc :file params))
- (let* ((out-file (cdr (assoc :file params)))
+ (if (cdr (assq :file params))
+ (let* ((out-file (cdr (assq :file params)))
+ (extension (file-name-extension out-file))
(tex-file (org-babel-temp-file "latex-" ".tex"))
- (border (cdr (assoc :border params)))
- (imagemagick (cdr (assoc :imagemagick params)))
- (im-in-options (cdr (assoc :iminoptions params)))
- (im-out-options (cdr (assoc :imoutoptions params)))
- (pdfpng (cdr (assoc :pdfpng params)))
- (fit (or (cdr (assoc :fit params)) border))
- (height (and fit (cdr (assoc :pdfheight params))))
- (width (and fit (cdr (assoc :pdfwidth params))))
- (headers (cdr (assoc :headers params)))
- (in-buffer (not (string= "no" (cdr (assoc :buffer params)))))
+ (border (cdr (assq :border params)))
+ (imagemagick (cdr (assq :imagemagick params)))
+ (im-in-options (cdr (assq :iminoptions params)))
+ (im-out-options (cdr (assq :imoutoptions params)))
+ (fit (or (cdr (assq :fit params)) border))
+ (height (and fit (cdr (assq :pdfheight params))))
+ (width (and fit (cdr (assq :pdfwidth params))))
+ (headers (cdr (assq :headers params)))
+ (in-buffer (not (string= "no" (cdr (assq :buffer params)))))
(org-latex-packages-alist
- (append (cdr (assoc :packages params)) org-latex-packages-alist)))
+ (append (cdr (assq :packages params)) org-latex-packages-alist)))
(cond
- ((and (string-match "\\.png$" out-file) (not imagemagick))
+ ((and (string-suffix-p ".png" out-file) (not imagemagick))
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
- ((string-match "\\.tikz$" out-file)
+ ((string-suffix-p ".tikz" out-file)
(when (file-exists-p out-file) (delete-file out-file))
(with-temp-file out-file
(insert body)))
- ((or (string-match "\\.pdf$" out-file) imagemagick)
+ ((and (or (string= "svg" extension)
+ (string= "html" extension))
+ (executable-find org-babel-latex-htlatex))
+ ;; TODO: this is a very different way of generating the
+ ;; frame latex document than in the pdf case. Ideally, both
+ ;; would be unified. This would prevent bugs creeping in
+ ;; such as the one fixed on Aug 16 2014 whereby :headers was
+ ;; not included in the SVG/HTML case.
+ (with-temp-file tex-file
+ (insert (concat
+ "\\documentclass[preview]{standalone}
+\\def\\pgfsysdriver{pgfsys-tex4ht.def}
+"
+ (mapconcat (lambda (pkg)
+ (concat "\\usepackage" pkg))
+ org-babel-latex-htlatex-packages
+ "\n")
+ (if headers
+ (concat "\n"
+ (if (listp headers)
+ (mapconcat #'identity headers "\n")
+ headers) "\n")
+ "")
+ "\\begin{document}"
+ body
+ "\\end{document}")))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((default-directory (file-name-directory tex-file)))
+ (shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
+ (cond
+ ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
+ (if (string-suffix-p ".svg" out-file)
+ (progn
+ (shell-command "pwd")
+ (shell-command (format "mv %s %s"
+ (concat (file-name-sans-extension tex-file) "-1.svg")
+ out-file)))
+ (error "SVG file produced but HTML file requested")))
+ ((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
+ (if (string-suffix-p ".html" out-file)
+ (shell-command "mv %s %s"
+ (concat (file-name-sans-extension tex-file)
+ ".html")
+ out-file)
+ (error "HTML file produced but SVG file requested")))))
+ ((or (string= "pdf" extension) imagemagick)
(with-temp-file tex-file
(require 'ox-latex)
(insert
@@ -133,54 +192,20 @@ This function is called by `org-babel-execute-src-block'."
(when (file-exists-p out-file) (delete-file out-file))
(let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file)))
(cond
- ((string-match "\\.pdf$" out-file)
+ ((string= "pdf" extension)
(rename-file transient-pdf-file out-file))
(imagemagick
- (convert-pdf
+ (org-babel-latex-convert-pdf
transient-pdf-file out-file im-in-options im-out-options)
(when (file-exists-p transient-pdf-file)
- (delete-file transient-pdf-file))))))
- ((and (or (string-match "\\.svg$" out-file)
- (string-match "\\.html$" out-file))
- (not (string= "" org-babel-latex-htlatex)))
- (with-temp-file tex-file
- (insert (concat
- "\\documentclass[preview]{standalone}
-\\def\\pgfsysdriver{pgfsys-tex4ht.def}
-"
- (mapconcat (lambda (pkg)
- (concat "\\usepackage" pkg))
- org-babel-latex-htlatex-packages
- "\n")
- "\\begin{document}"
- body
- "\\end{document}")))
- (when (file-exists-p out-file) (delete-file out-file))
- (let ((default-directory (file-name-directory tex-file)))
- (shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
- (cond
- ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
- (if (string-match "\\.svg$" out-file)
- (progn
- (shell-command "pwd")
- (shell-command (format "mv %s %s"
- (concat (file-name-sans-extension tex-file) "-1.svg")
- out-file)))
- (error "SVG file produced but HTML file requested.")))
- ((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
- (if (string-match "\\.html$" out-file)
- (shell-command "mv %s %s"
- (concat (file-name-sans-extension tex-file)
- ".html")
- out-file)
- (error "HTML file produced but SVG file requested.")))))
- ((string-match "\\.\\([^\\.]+\\)$" out-file)
- (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
- (match-string 1 out-file))))
+ (delete-file transient-pdf-file)))
+ (t
+ (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
+ extension))))))
nil) ;; signal that output has already been written to file
body))
-(defun convert-pdf (pdffile out-file im-in-options im-out-options)
+(defun org-babel-latex-convert-pdf (pdffile out-file im-in-options im-out-options)
"Generate a file from a pdf file using imagemagick."
(let ((cmd (concat "convert " im-in-options " " pdffile " "
im-out-options " " out-file)))
@@ -192,7 +217,7 @@ This function is called by `org-babel-execute-src-block'."
(require 'ox-latex)
(org-latex-compile file))
-(defun org-babel-prep-session:latex (session params)
+(defun org-babel-prep-session:latex (_session _params)
"Return an error because LaTeX doesn't support sessions."
(error "LaTeX does not support sessions"))
diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el
index 154e75c0e05..4f10ebe08aa 100644
--- a/lisp/org/ob-ledger.el
+++ b/lisp/org/ob-ledger.el
@@ -1,4 +1,4 @@
-;;; ob-ledger.el --- org-babel functions for ledger evaluation
+;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,8 +46,7 @@
"Execute a block of Ledger entries with org-babel. This function is
called by `org-babel-execute-src-block'."
(message "executing Ledger source code block")
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (cmdline (cdr (assoc :cmdline params)))
+ (let ((cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "ledger-"))
(out-file (org-babel-temp-file "ledger-output-")))
(with-temp-file in-file (insert body))
@@ -61,7 +60,7 @@ called by `org-babel-execute-src-block'."
" > " (org-babel-process-file-name out-file))))
(with-temp-buffer (insert-file-contents out-file) (buffer-string))))
-(defun org-babel-prep-session:ledger (session params)
+(defun org-babel-prep-session:ledger (_session _params)
(error "Ledger does not support sessions"))
(provide 'ob-ledger)
diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el
index b37ecd87a7b..0cc85685e91 100644
--- a/lisp/org/ob-lilypond.el
+++ b/lisp/org/ob-lilypond.el
@@ -1,4 +1,4 @@
-;;; ob-lilypond.el --- org-babel functions for lilypond evaluation
+;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,6 +28,8 @@
;;
;; Lilypond documentation can be found at
;; http://lilypond.org/manuals.html
+;;
+;; This depends on epstopdf --- See http://www.ctan.org/pkg/epstopdf.
;;; Code:
(require 'ob)
@@ -60,51 +62,68 @@ org-babel-lilypond-play-midi-post-tangle determines whether to automate the
playing of the resultant midi file. If the value is nil,
the midi file is not automatically played. Default value is t")
-(defvar org-babel-lilypond-OSX-ly-path
- "/Applications/lilypond.app/Contents/Resources/bin/lilypond")
-(defvar org-babel-lilypond-OSX-pdf-path "open")
-(defvar org-babel-lilypond-OSX-midi-path "open")
-
-(defvar org-babel-lilypond-nix-ly-path "/usr/bin/lilypond")
-(defvar org-babel-lilypond-nix-pdf-path "evince")
-(defvar org-babel-lilypond-nix-midi-path "timidity")
-
-(defvar org-babel-lilypond-w32-ly-path "lilypond")
-(defvar org-babel-lilypond-w32-pdf-path "")
-(defvar org-babel-lilypond-w32-midi-path "")
+(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)
+ '("/Applications/lilypond.app/Contents/Resources/bin/lilypond" "open" "open"))
+ ((eq system-type 'windows-nt)
+ '("lilypond" "" ""))
+ (t
+ '("lilypond" "xdg-open" "xdg-open")))
+ "Commands to run lilypond and view or play the results.
+These should be executables that take a filename as an argument.
+On some system it is possible to specify the filename directly
+and the viewer or player will be determined from the file type;
+you can leave the string empty on this case."
+ :group 'org-babel
+ :type '(list
+ (string :tag "Lilypond ")
+ (string :tag "PDF Viewer ")
+ (string :tag "MIDI Player"))
+ :version "24.4"
+ :package-version '(Org . "8.2.7")
+ :set
+ (lambda (_symbol value)
+ (setq
+ org-babel-lilypond-ly-command (nth 0 value)
+ org-babel-lilypond-pdf-command (nth 1 value)
+ org-babel-lilypond-midi-command (nth 2 value))))
(defvar org-babel-lilypond-gen-png nil
- "Image generation (png) can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-PNG to t")
+ "Non-nil means image generation (PNG) is turned on by default.")
(defvar org-babel-lilypond-gen-svg nil
- "Image generation (SVG) can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-SVG to t")
+ "Non-nil means image generation (SVG) is be turned on by default.")
(defvar org-babel-lilypond-gen-html nil
- "HTML generation can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-HTML to t")
+ "Non-nil means HTML generation is turned on by default.")
(defvar org-babel-lilypond-gen-pdf nil
- "PDF generation can be turned on by default by setting
-ORG-BABEL-LILYPOND-GEN-PDF to t")
+ "Non-nil means PDF generation is be turned on by default.")
(defvar org-babel-lilypond-use-eps nil
- "You can force the compiler to use the EPS backend by setting
-ORG-BABEL-LILYPOND-USE-EPS to t")
+ "Non-nil forces the compiler to use the EPS backend.")
(defvar org-babel-lilypond-arrange-mode nil
- "Arrange mode is turned on by setting ORG-BABEL-LILYPOND-ARRANGE-MODE
-to t. In Arrange mode the following settings are altered
-from default...
+ "Non-nil turns Arrange mode on.
+In Arrange mode the following settings are altered from default:
:tangle yes, :noweb yes
:results silent :comments yes.
In addition lilypond block execution causes tangling of all lilypond
-blocks")
+blocks.")
(defun org-babel-expand-body:lilypond (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(mapc
(lambda (pair)
(let ((name (symbol-name (car pair)))
@@ -138,9 +157,8 @@ specific arguments to =org-babel-tangle="
(defun org-babel-lilypond-process-basic (body params)
"Execute a lilypond block in basic mode."
- (let* ((result-params (cdr (assoc :result-params params)))
- (out-file (cdr (assoc :file params)))
- (cmdline (or (cdr (assoc :cmdline params))
+ (let* ((out-file (cdr (assq :file params)))
+ (cmdline (or (cdr (assq :cmdline params))
""))
(in-file (org-babel-temp-file "lilypond-")))
@@ -148,7 +166,7 @@ specific arguments to =org-babel-tangle="
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval
(concat
- (org-babel-lilypond-determine-ly-path)
+ org-babel-lilypond-ly-command
" -dbackend=eps "
"-dno-gs-load-fonts "
"-dinclude-eps-fonts "
@@ -163,7 +181,7 @@ specific arguments to =org-babel-tangle="
cmdline
in-file) "")) nil)
-(defun org-babel-prep-session:lilypond (session params)
+(defun org-babel-prep-session:lilypond (_session _params)
"Return an error because LilyPond exporter does not support sessions."
(error "Sorry, LilyPond does not currently support sessions!"))
@@ -175,29 +193,27 @@ If error in compilation, attempt to mark the error in lilypond org file"
(buffer-file-name) ".lilypond"))
(org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension
(buffer-file-name) ".ly")))
- (if (file-exists-p org-babel-lilypond-tangled-file)
- (progn
- (when (file-exists-p org-babel-lilypond-temp-file)
- (delete-file org-babel-lilypond-temp-file))
- (rename-file org-babel-lilypond-tangled-file
- org-babel-lilypond-temp-file))
- (error "Error: Tangle Failed!") t)
+ (if (not (file-exists-p org-babel-lilypond-tangled-file))
+ (error "Error: Tangle Failed!")
+ (when (file-exists-p org-babel-lilypond-temp-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*")
(erase-buffer)
(org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file)
(goto-char (point-min))
- (if (not (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file))
- (progn
- (other-window -1)
- (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
- (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))
- (error "Error in Compilation!")))) nil)
+ (if (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file)
+ (error "Error in Compilation!")
+ (other-window -1)
+ (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file)
+ (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file)))))
(defun org-babel-lilypond-compile-lilyfile (file-name &optional test)
"Compile lilypond file and check for compile errors
FILE-NAME is full path to lilypond (.ly) file"
(message "Compiling LilyPond...")
- (let ((arg-1 (org-babel-lilypond-determine-ly-path)) ;program
+ (let ((arg-1 org-babel-lilypond-ly-command) ;program
(arg-2 nil) ;infile
(arg-3 "*lilypond*") ;buffer
(arg-4 t) ;display
@@ -223,11 +239,10 @@ FILE-NAME is full path to lilypond file.
If TEST is t just return nil if no error found, and pass
nil as file-name since it is unused in this context"
(let ((is-error (search-forward "error:" nil t)))
- (if (not test)
- (if (not is-error)
- nil
- (org-babel-lilypond-process-compile-error file-name))
- is-error)))
+ (if test
+ is-error
+ (when is-error
+ (org-babel-lilypond-process-compile-error file-name)))))
(defun org-babel-lilypond-process-compile-error (file-name)
"Process the compilation error that has occurred.
@@ -249,32 +264,26 @@ LINE is the erroneous line"
(setq case-fold-search nil)
(if (search-forward line nil t)
(progn
- (show-all)
+ (outline-show-all)
(set-mark (point))
(goto-char (- (point) (length line))))
(goto-char temp))))
(defun org-babel-lilypond-parse-line-num (&optional buffer)
"Extract error line number."
- (when buffer
- (set-buffer buffer))
+ (when buffer (set-buffer buffer))
(let ((start
(and (search-backward ":" nil t)
(search-backward ":" nil t)
(search-backward ":" nil t)
- (search-backward ":" nil t)))
- (num nil))
- (if start
- (progn
- (forward-char)
- (let ((num (buffer-substring
- (+ 1 start)
- (- (search-forward ":" nil t) 1))))
- (setq num (string-to-number num))
- (if (numberp num)
- num
- nil)))
- nil)))
+ (search-backward ":" nil t))))
+ (when start
+ (forward-char)
+ (let ((num (string-to-number
+ (buffer-substring
+ (+ 1 start)
+ (- (search-forward ":" nil t) 1)))))
+ (and (numberp num) num)))))
(defun org-babel-lilypond-parse-error-line (file-name lineNo)
"Extract the erroneous line from the tangled .ly file
@@ -298,13 +307,13 @@ If TEST is non-nil, the shell command is returned and is not run"
(let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf")))
(if (file-exists-p pdf-file)
(let ((cmd-string
- (concat (org-babel-lilypond-determine-pdf-path) " " pdf-file)))
+ (concat org-babel-lilypond-pdf-command " " pdf-file)))
(if test
cmd-string
(start-process
"\"Audition pdf\""
"*lilypond*"
- (org-babel-lilypond-determine-pdf-path)
+ org-babel-lilypond-pdf-command
pdf-file)))
(message "No pdf file generated so can't display!")))))
@@ -316,49 +325,16 @@ If TEST is non-nil, the shell command is returned and is not run"
(let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi")))
(if (file-exists-p midi-file)
(let ((cmd-string
- (concat (org-babel-lilypond-determine-midi-path) " " midi-file)))
+ (concat org-babel-lilypond-midi-command " " midi-file)))
(if test
cmd-string
(start-process
"\"Audition midi\""
"*lilypond*"
- (org-babel-lilypond-determine-midi-path)
+ org-babel-lilypond-midi-command
midi-file)))
(message "No midi file generated so can't play!")))))
-(defun org-babel-lilypond-determine-ly-path (&optional test)
- "Return correct path to ly binary depending on OS
-If TEST is non-nil, it contains a simulation of the OS for test purposes"
- (let ((sys-type
- (or test system-type)))
- (cond ((string= sys-type "darwin")
- org-babel-lilypond-OSX-ly-path)
- ((string= sys-type "windows-nt")
- org-babel-lilypond-w32-ly-path)
- (t org-babel-lilypond-nix-ly-path))))
-
-(defun org-babel-lilypond-determine-pdf-path (&optional test)
- "Return correct path to pdf viewer depending on OS
-If TEST is non-nil, it contains a simulation of the OS for test purposes"
- (let ((sys-type
- (or test system-type)))
- (cond ((string= sys-type "darwin")
- org-babel-lilypond-OSX-pdf-path)
- ((string= sys-type "windows-nt")
- org-babel-lilypond-w32-pdf-path)
- (t org-babel-lilypond-nix-pdf-path))))
-
-(defun org-babel-lilypond-determine-midi-path (&optional test)
- "Return correct path to midi player depending on OS
-If TEST is non-nil, it contains a simulation of the OS for test purposes"
- (let ((sys-type
- (or test test system-type)))
- (cond ((string= sys-type "darwin")
- org-babel-lilypond-OSX-midi-path)
- ((string= sys-type "windows-nt")
- org-babel-lilypond-w32-midi-path)
- (t org-babel-lilypond-nix-midi-path))))
-
(defun org-babel-lilypond-toggle-midi-play ()
"Toggle whether midi will be played following a successful compilation."
(interactive)
diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el
index 2f66549fc3d..d98098e1361 100644
--- a/lisp/org/ob-lisp.el
+++ b/lisp/org/ob-lisp.el
@@ -1,4 +1,4 @@
-;;; ob-lisp.el --- org-babel functions for common lisp evaluation
+;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -21,21 +21,26 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;; support for evaluating common lisp code, relies on slime for all eval
+;;; Support for evaluating Common Lisp code, relies on SLY or SLIME
+;;; for all eval.
;;; Requirements:
-;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.)
-;; See http://common-lisp.net/project/slime/
+;; Requires SLY (Sylvester the Cat's Common Lisp IDE) or SLIME
+;; (Superior Lisp Interaction Mode for Emacs). See:
+;; - https://github.com/capitaomorte/sly
+;; - http://common-lisp.net/project/slime/
;;; Code:
(require 'ob)
+(declare-function sly-eval "ext:sly" (sexp &optional package))
(declare-function slime-eval "ext:slime" (sexp &optional package))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp"))
@@ -43,8 +48,16 @@
(defvar org-babel-default-header-args:lisp '())
(defvar org-babel-header-args:lisp '((package . :any)))
+(defcustom org-babel-lisp-eval-fn #'slime-eval
+ "The function to be called to evaluate code on the Lisp side.
+Valid values include `slime-eval' and `sly-eval'."
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type 'function)
+
(defcustom org-babel-lisp-dir-fmt
- "(let ((*default-pathname-defaults* #P%S)) %%s)"
+ "(let ((*default-pathname-defaults* #P%S\n)) %%s\n)"
"Format string used to wrap code bodies to set the current directory.
For example a value of \"(progn ;; %s\\n %%s)\" would ignore the
current directory string."
@@ -54,49 +67,54 @@ current directory string."
(defun org-babel-expand-body:lisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((vars (org-babel--get-vars params))
+ (result-params (cdr (assq :result-params params)))
(print-level nil) (print-length nil)
- (body (org-babel-trim
- (if (> (length vars) 0)
- (concat "(let ("
- (mapconcat
- (lambda (var)
- (format "(%S (quote %S))" (car var) (cdr var)))
- vars "\n ")
- ")\n" body ")")
- body))))
+ (body (if (null vars) (org-trim body)
+ (concat "(let ("
+ (mapconcat
+ (lambda (var)
+ (format "(%S (quote %S))" (car var) (cdr var)))
+ vars "\n ")
+ ")\n" body ")"))))
(if (or (member "code" result-params)
(member "pp" result-params))
(format "(pprint %s)" body)
body)))
(defun org-babel-execute:lisp (body params)
- "Execute a block of Common Lisp code with Babel."
- (require 'slime)
+ "Execute a block of Common Lisp code with Babel.
+BODY is the contents of the block, as a string. PARAMS is
+a property list containing the parameters of the block."
+ (require (pcase org-babel-lisp-eval-fn
+ (`slime-eval 'slime)
+ (`sly-eval 'sly)))
(org-babel-reassemble-table
(let ((result
- (with-temp-buffer
- (insert (org-babel-expand-body:lisp body params))
- (slime-eval `(swank:eval-and-grab-output
- ,(let ((dir (if (assoc :dir params)
- (cdr (assoc :dir params))
- default-directory)))
- (format
- (if dir (format org-babel-lisp-dir-fmt dir)
- "(progn %s)")
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (cdr (assoc :package params))))))
- (org-babel-result-cond (cdr (assoc :result-params params))
- (car result)
+ (funcall (if (member "output" (cdr (assq :result-params params)))
+ #'car #'cadr)
+ (with-temp-buffer
+ (insert (org-babel-expand-body:lisp body params))
+ (funcall org-babel-lisp-eval-fn
+ `(swank:eval-and-grab-output
+ ,(let ((dir (if (assq :dir params)
+ (cdr (assq :dir params))
+ default-directory)))
+ (format
+ (if dir (format org-babel-lisp-dir-fmt dir)
+ "(progn %s\n)")
+ (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (cdr (assq :package params)))))))
+ (org-babel-result-cond (cdr (assq :result-params params))
+ result
(condition-case nil
- (read (org-babel-lisp-vector-to-list (cadr result)))
- (error (cadr result)))))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params)))))
+ (read (org-babel-lisp-vector-to-list result))
+ (error 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-lisp-vector-to-list (results)
;; TODO: better would be to replace #(...) with [...]
diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el
index ddfac2afeed..13f728f37f6 100644
--- a/lisp/org/ob-lob.el
+++ b/lisp/org/ob-lob.el
@@ -1,4 +1,4 @@
-;;; ob-lob.el --- functions supporting the Library of Babel
+;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,30 +20,30 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'ob-core)
(require 'ob-table)
-(declare-function org-babel-in-example-or-verbatim "ob-exp" nil)
+(declare-function org-babel-ref-split-args "ob-ref" (arg-string))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
(defvar org-babel-library-of-babel nil
"Library of source-code blocks.
-This is an association list. Populate the library by adding
-files to `org-babel-lob-files'.")
-
-(defcustom org-babel-lob-files nil
- "Files used to populate the `org-babel-library-of-babel'.
-To add files to this list use the `org-babel-lob-ingest' command."
- :group 'org-babel
- :version "24.1"
- :type '(repeat file))
+This is an association list. Populate the library by calling
+`org-babel-lob-ingest' on files containing source blocks.")
(defvar org-babel-default-lob-header-args '((:exports . "results"))
- "Default header arguments to use when exporting #+lob/call lines.")
+ "Default header arguments to use when exporting Babel calls.
+By default, a Babel call inherits its arguments from the source
+block being called. Header arguments defined in this variable
+take precedence over these. It is useful for properties that
+should not be inherited from a source block.")
(defun org-babel-lob-ingest (&optional file)
"Add all named source blocks defined in FILE to `org-babel-library-of-babel'."
@@ -53,33 +53,20 @@ To add files to this list use the `org-babel-lob-ingest' command."
(let* ((info (org-babel-get-src-block-info 'light))
(source-name (nth 4 info)))
(when source-name
- (setq source-name (intern source-name)
- org-babel-library-of-babel
- (cons (cons source-name info)
- (assq-delete-all source-name org-babel-library-of-babel))
- lob-ingest-count (1+ lob-ingest-count)))))
+ (setf (nth 1 info)
+ (if (org-babel-noweb-p (nth 2 info) :eval)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info)))
+ (let ((source (intern source-name)))
+ (setq org-babel-library-of-babel
+ (cons (cons source info)
+ (assq-delete-all source org-babel-library-of-babel))))
+ (cl-incf lob-ingest-count))))
(message "%d src block%s added to Library of Babel"
lob-ingest-count (if (> lob-ingest-count 1) "s" ""))
lob-ingest-count))
-(defconst org-babel-block-lob-one-liner-regexp
- (concat
- "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)"
- "(\\([^\n]*?\\))\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?")
- "Regexp to match non-inline calls to predefined source block functions.")
-
-(defconst org-babel-inline-lob-one-liner-regexp
- (concat
- "\\([^\n]*?\\)call_\\([^()\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)"
- "(\\([^\n]*?\\))\\(\\[\\(.*?\\)\\]\\)?")
- "Regexp to match inline calls to predefined source block functions.")
-
-(defconst org-babel-lob-one-liner-regexp
- (concat "\\(" org-babel-block-lob-one-liner-regexp
- "\\|" org-babel-inline-lob-one-liner-regexp "\\)")
- "Regexp to match calls to predefined source block functions.")
-
-;; functions for executing lob one-liners
+;; Functions for executing lob one-liners.
;;;###autoload
(defun org-babel-lob-execute-maybe ()
@@ -88,72 +75,76 @@ Detect if this is context for a Library Of Babel source block and
if so then run the appropriate source block from the Library."
(interactive)
(let ((info (org-babel-lob-get-info)))
- (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim)))
- (progn (org-babel-lob-execute info) t)
- nil)))
+ (when info
+ (org-babel-execute-src-block nil info)
+ t)))
+
+(defun org-babel-lob--src-info (name)
+ "Return internal representation for Babel data named NAME.
+NAME is a string. This function looks into the current document
+for a Babel call or source block. If none is found, it looks
+after NAME in the Library of Babel. Eventually, if that also
+fails, it returns nil."
+ ;; During export, look into the pristine copy of the document being
+ ;; exported instead of the current one, which could miss some data.
+ (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (catch :found
+ (let ((case-fold-search t)
+ (regexp (org-babel-named-data-regexp-for-name name)))
+ (while (re-search-forward regexp nil t)
+ (let ((element (org-element-at-point)))
+ (when (equal name (org-element-property :name element))
+ (throw :found
+ (pcase (org-element-type element)
+ (`src-block (org-babel-get-src-block-info t element))
+ (`babel-call (org-babel-lob-get-info element))
+ ;; Non-executable data found. Since names are
+ ;; supposed to be unique throughout a document,
+ ;; bail out.
+ (_ nil))))))
+ ;; No element named NAME in buffer. Try Library of Babel.
+ (cdr (assoc-string name org-babel-library-of-babel)))))))
;;;###autoload
-(defun org-babel-lob-get-info ()
- "Return a Library of Babel function call as a string."
- (let ((case-fold-search t)
- (nonempty (lambda (a b)
- (let ((it (match-string a)))
- (if (= (length it) 0) (match-string b) it)))))
- (save-excursion
- (beginning-of-line 1)
- (when (looking-at org-babel-lob-one-liner-regexp)
- (append
- (mapcar #'org-no-properties
- (list
- (format "%s%s(%s)%s"
- (funcall nonempty 3 12)
- (if (not (= 0 (length (funcall nonempty 5 14))))
- (concat "[" (funcall nonempty 5 14) "]") "")
- (or (funcall nonempty 7 16) "")
- (or (funcall nonempty 8 19) ""))
- (funcall nonempty 9 18)))
- (list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11)))
- (save-excursion
- (forward-line -1)
- (and (looking-at (concat org-babel-src-name-regexp
- "\\([^\n]*\\)$"))
- (org-no-properties (match-string 1))))))))))
-
-(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
-(defun org-babel-lob-execute (info)
- "Execute the lob call specified by INFO."
- (let* ((mkinfo (lambda (p)
- (list "emacs-lisp" "results" p nil
- (nth 3 info) ;; name
- (nth 2 info))))
- (pre-params (apply #'org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-header-args:emacs-lisp
- (append
- (org-babel-params-from-properties)
- (list
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat
- ":var results="
- (mapconcat #'identity (butlast info 2)
- " "))))))))
- (pre-info (funcall mkinfo pre-params))
- (cache-p (and (cdr (assoc :cache pre-params))
- (string= "yes" (cdr (assoc :cache pre-params)))))
- (new-hash (when cache-p (org-babel-sha1-hash pre-info)))
- (old-hash (when cache-p (org-babel-current-result-hash)))
- (org-babel-current-src-block-location (point-marker)))
- (if (and cache-p (equal new-hash old-hash))
- (save-excursion (goto-char (org-babel-where-is-src-block-result))
- (forward-line 1)
- (message "%S" (org-babel-read-result)))
- (prog1 (let* ((proc-params (org-babel-process-params pre-params))
- org-confirm-babel-evaluate)
- (org-babel-execute-src-block nil (funcall mkinfo proc-params)))
- ;; update the hash
- (when new-hash (org-babel-set-current-result-hash new-hash))))))
+(defun org-babel-lob-get-info (&optional datum)
+ "Return internal representation for Library of Babel function call.
+Consider DATUM, when provided, or element at point. Return nil
+when not on an appropriate location. Otherwise return a list
+compatible with `org-babel-get-src-block-info', which see."
+ (let* ((context (or datum (org-element-context)))
+ (type (org-element-type context)))
+ (when (memq type '(babel-call inline-babel-call))
+ (pcase (org-babel-lob--src-info (org-element-property :call context))
+ (`(,language ,body ,header ,_ ,_ ,_ ,coderef)
+ (let ((begin (org-element-property (if (eq type 'inline-babel-call)
+ :begin
+ :post-affiliated)
+ context)))
+ (list language
+ body
+ (apply #'org-babel-merge-params
+ header
+ org-babel-default-lob-header-args
+ (append
+ (org-with-wide-buffer
+ (goto-char begin)
+ (org-babel-params-from-properties language))
+ (list
+ (org-babel-parse-header-arguments
+ (org-element-property :inside-header context))
+ (let ((args (org-element-property :arguments context)))
+ (and args
+ (mapcar (lambda (ref) (cons :var ref))
+ (org-babel-ref-split-args args))))
+ (org-babel-parse-header-arguments
+ (org-element-property :end-header context)))))
+ nil
+ (org-element-property :name context)
+ begin
+ coderef)))
+ (_ nil)))))
(provide 'ob-lob)
diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el
new file mode 100644
index 00000000000..fc9d9f2f0e2
--- /dev/null
+++ b/lisp/org/ob-lua.el
@@ -0,0 +1,403 @@
+;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014, 2016-2017 Free Software Foundation, Inc.
+
+;; Authors: Dieter Schoen
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;; Requirements:
+;; for session support, lua-mode is needed.
+;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained
+;; from marmalade or melpa.
+;; The source repository is here:
+;; https://github.com/immerrr/lua-mode
+
+;; However, sessions are not yet working.
+
+;; Org-Babel support for evaluating lua source code.
+
+;;; Code:
+(require 'ob)
+(require 'cl-lib)
+
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function lua-shell "ext:lua-mode" (&optional argprompt))
+(declare-function lua-toggle-shells "ext:lua-mode" (arg))
+(declare-function run-lua "ext:lua" (cmd &optional dedicated show))
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("lua" . "lua"))
+
+(defvar org-babel-default-header-args:lua '())
+
+(defcustom org-babel-lua-command "lua"
+ "Name of the command for executing Lua code."
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-lua-mode 'lua-mode
+ "Preferred lua mode for use in running lua interactively.
+This will typically be 'lua-mode."
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'symbol)
+
+(defcustom org-babel-lua-hline-to "None"
+ "Replace hlines in incoming tables with this when translating to lua."
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'string)
+
+(defcustom org-babel-lua-None-to 'hline
+ "Replace 'None' in lua tables with this before returning."
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'symbol)
+
+(defun org-babel-execute:lua (body params)
+ "Execute a block of Lua code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (let* ((session (org-babel-lua-initiate-session
+ (cdr (assq :session params))))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
+ (return-val (when (and (eq result-type 'value) (not session))
+ (cdr (assq :return params))))
+ (preamble (cdr (assq :preamble params)))
+ (full-body
+ (org-babel-expand-body:generic
+ (concat body (if return-val (format "\nreturn %s" return-val) ""))
+ params (org-babel-variable-assignments:lua params)))
+ (result (org-babel-lua-evaluate
+ session full-body result-type result-params preamble)))
+ (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-prep-session:lua (session params)
+ "Prepare SESSION according to the header arguments in PARAMS.
+VARS contains resolved variable references"
+ (let* ((session (org-babel-lua-initiate-session session))
+ (var-lines
+ (org-babel-variable-assignments:lua params)))
+ (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))
+ session))
+
+(defun org-babel-load-session:lua (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:lua session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+;; helper functions
+
+(defun org-babel-variable-assignments:lua (params)
+ "Return a list of Lua statements assigning the block's variables."
+ (mapcar
+ (lambda (pair)
+ (format "%s=%s"
+ (car pair)
+ (org-babel-lua-var-to-lua (cdr pair))))
+ (org-babel--get-vars params)))
+
+(defun org-babel-lua-var-to-lua (var)
+ "Convert an elisp value to a lua variable.
+Convert an elisp value, VAR, into a string of lua source code
+specifying a variable of the same value."
+ (if (listp var)
+ (if (and (= 1 (length var)) (not (listp (car var))))
+ (org-babel-lua-var-to-lua (car var))
+ (if (and
+ (= 2 (length var))
+ (not (listp (car var))))
+ (concat
+ (substring-no-properties (car var))
+ "="
+ (org-babel-lua-var-to-lua (cdr var)))
+ (concat "{" (mapconcat #'org-babel-lua-var-to-lua var ", ") "}")))
+ (if (eq var 'hline)
+ org-babel-lua-hline-to
+ (format
+ (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
+ (if (stringp var) (substring-no-properties var) var)))))
+
+(defun org-babel-lua-table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If the results look like a list or tuple, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (let ((res (org-babel-script-escape results)))
+ (if (listp res)
+ (mapcar (lambda (el) (if (eq el 'None)
+ org-babel-lua-None-to el))
+ res)
+ res)))
+
+(defvar org-babel-lua-buffers '((:default . "*Lua*")))
+
+(defun org-babel-lua-session-buffer (session)
+ "Return the buffer associated with SESSION."
+ (cdr (assoc session org-babel-lua-buffers)))
+
+(defun org-babel-lua-with-earmuffs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ name
+ (format "*%s*" name))))
+
+(defun org-babel-lua-without-earmuffs (session)
+ (let ((name (if (stringp session) session (format "%s" session))))
+ (if (and (string= "*" (substring name 0 1))
+ (string= "*" (substring name (- (length name) 1))))
+ (substring name 1 (- (length name) 1))
+ name)))
+
+(defvar lua-default-interpreter)
+(defvar lua-which-bufname)
+(defvar lua-shell-buffer-name)
+(defun org-babel-lua-initiate-session-by-key (&optional session)
+ "Initiate a lua session.
+If there is not a current inferior-process-buffer in SESSION
+then create. Return the initialized session."
+ ;; (require org-babel-lua-mode)
+ (save-window-excursion
+ (let* ((session (if session (intern session) :default))
+ (lua-buffer (org-babel-lua-session-buffer session))
+ ;; (cmd (if (member system-type '(cygwin windows-nt ms-dos))
+ ;; (concat org-babel-lua-command " -i")
+ ;; org-babel-lua-command))
+ )
+ (cond
+ ((and (eq 'lua-mode org-babel-lua-mode)
+ (fboundp 'lua-start-process)) ; lua-mode.el
+ ;; Make sure that lua-which-bufname is initialized, as otherwise
+ ;; it will be overwritten the first time a Lua buffer is
+ ;; created.
+ ;;(lua-toggle-shells lua-default-interpreter)
+ ;; `lua-shell' creates a buffer whose name is the value of
+ ;; `lua-which-bufname' with '*'s at the beginning and end
+ (let* ((bufname (if (and lua-buffer (buffer-live-p lua-buffer))
+ (replace-regexp-in-string ;; zap surrounding *
+ "^\\*\\([^*]+\\)\\*$" "\\1" (buffer-name lua-buffer))
+ (concat "Lua-" (symbol-name session))))
+ (lua-which-bufname bufname))
+ (lua-start-process)
+ (setq lua-buffer (org-babel-lua-with-earmuffs bufname))))
+ (t
+ (error "No function available for running an inferior Lua")))
+ (setq org-babel-lua-buffers
+ (cons (cons session lua-buffer)
+ (assq-delete-all session org-babel-lua-buffers)))
+ session)))
+
+(defun org-babel-lua-initiate-session (&optional session _params)
+ "Create a session named SESSION according to PARAMS."
+ (unless (string= session "none")
+ (error "Sessions currently not supported, work in progress")
+ (org-babel-lua-session-buffer
+ (org-babel-lua-initiate-session-by-key session))))
+
+(defvar org-babel-lua-eoe-indicator "--eoe"
+ "A string to indicate that evaluation has completed.")
+
+(defvar org-babel-lua-wrapper-method
+ "
+function main()
+%s
+end
+
+fd=io.open(\"%s\", \"w\")
+fd:write( main() )
+fd:close()")
+(defvar org-babel-lua-pp-wrapper-method
+ "
+-- table to string
+function t2s(t, indent)
+ if indent == nil then
+ indent = \"\"
+ end
+ if type(t) == \"table\" then
+ ts = \"\"
+ for k,v in pairs(t) do
+ if type(v) == \"table\" then
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" ..
+ t2s(v, indent .. \" \")
+ else
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" ..
+ t2s(v, indent .. \" \") .. \"\\n\"
+ end
+ end
+ return ts
+ else
+ return tostring(t)
+ end
+end
+
+
+function main()
+%s
+end
+
+fd=io.open(\"%s\", \"w\")
+fd:write(t2s(main()))
+fd:close()")
+
+(defun org-babel-lua-evaluate
+ (session body &optional result-type result-params preamble)
+ "Evaluate BODY as Lua code."
+ (if session
+ (org-babel-lua-evaluate-session
+ session body result-type result-params)
+ (org-babel-lua-evaluate-external-process
+ body result-type result-params preamble)))
+
+(defun org-babel-lua-evaluate-external-process
+ (body &optional result-type result-params preamble)
+ "Evaluate BODY in external lua process.
+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 ((raw
+ (pcase result-type
+ (`output (org-babel-eval org-babel-lua-command
+ (concat (if preamble (concat preamble "\n"))
+ body)))
+ (`value (let ((tmp-file (org-babel-temp-file "lua-")))
+ (org-babel-eval
+ org-babel-lua-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (if (member "pp" result-params)
+ org-babel-lua-pp-wrapper-method
+ org-babel-lua-wrapper-method)
+ (mapconcat
+ (lambda (line) (format "\t%s" line))
+ (split-string
+ (org-remove-indentation
+ (org-trim body))
+ "[\r\n]") "\n")
+ (org-babel-process-file-name tmp-file 'noquote))))
+ (org-babel-eval-read-file tmp-file))))))
+ (org-babel-result-cond result-params
+ raw
+ (org-babel-lua-table-or-string (org-trim raw)))))
+
+(defun org-babel-lua-evaluate-session
+ (session body &optional result-type result-params)
+ "Pass BODY to the Lua 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
+ "-- table to string
+function t2s(t, indent)
+ if indent == nil then
+ indent = \"\"
+ end
+ if type(t) == \"table\" then
+ ts = \"\"
+ for k,v in pairs(t) do
+ if type(v) == \"table\" then
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" ..
+ t2s(v, indent .. \" \")
+ else
+ ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" ..
+ t2s(v, indent .. \" \") .. \"\\n\"
+ end
+ end
+ return ts
+ else
+ return tostring(t)
+ end
+end
+"
+ (concat "fd:write(_))
+fd:close()"
+ (org-babel-process-file-name tmp-file 'noquote)))
+ (list (format "fd=io.open(\"%s\", \"w\")
+fd:write( _ )
+fd:close()"
+ (org-babel-process-file-name tmp-file
+ 'noquote)))))))
+ (input-body (lambda (body)
+ (mapc (lambda (line) (insert line) (funcall send-wait))
+ (split-string body "[\r\n]"))
+ (funcall send-wait)))
+ (results
+ (pcase result-type
+ (`output
+ (mapconcat
+ #'org-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-lua-eoe-indicator t body)
+ (funcall input-body body)
+ (funcall send-wait) (funcall send-wait)
+ (insert org-babel-lua-eoe-indicator)
+ (funcall send-wait))
+ 2) "\n"))
+ (`value
+ (let ((tmp-file (org-babel-temp-file "lua-")))
+ (org-babel-comint-with-output
+ (session org-babel-lua-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-lua-eoe-indicator)
+ (funcall send-wait)))
+ (org-babel-eval-read-file tmp-file))))))
+ (unless (string= (substring org-babel-lua-eoe-indicator 1 -1) results)
+ (org-babel-result-cond result-params
+ results
+ (org-babel-lua-table-or-string results)))))
+
+(defun org-babel-lua-read-string (string)
+ "Strip 's from around Lua string."
+ (org-unbracket-string "'" "'" string))
+
+(provide 'ob-lua)
+
+
+
+;;; ob-lua.el ends here
diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el
index a292800dc17..14190ac1be8 100644
--- a/lisp/org/ob-makefile.el
+++ b/lisp/org/ob-makefile.el
@@ -1,4 +1,4 @@
-;;; ob-makefile.el --- org-babel functions for makefile evaluation
+;;; ob-makefile.el --- Babel Functions for Makefile -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,23 +20,23 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; This file exists solely for tangling a Makefile from org-mode files.
+;; This file exists solely for tangling a Makefile from Org files.
;;; Code:
(require 'ob)
(defvar org-babel-default-header-args:makefile '())
-(defun org-babel-execute:makefile (body params)
+(defun org-babel-execute:makefile (body _params)
"Execute a block of makefile code.
This function is called by `org-babel-execute-src-block'."
body)
-(defun org-babel-prep-session:makefile (session params)
+(defun org-babel-prep-session:makefile (_session _params)
"Return an error if the :session header argument is set. Make
does not support sessions."
(error "Makefile sessions are nonsensical"))
diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el
index 42bbd2b9074..e30ce8dae0f 100644
--- a/lisp/org/ob-matlab.el
+++ b/lisp/org/ob-matlab.el
@@ -1,4 +1,4 @@
-;;; ob-matlab.el --- org-babel support for matlab evaluation
+;;; ob-matlab.el --- Babel support for Matlab -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el
index b567fd484a9..224b3605035 100644
--- a/lisp/org/ob-maxima.el
+++ b/lisp/org/ob-maxima.el
@@ -1,4 +1,4 @@
-;;; ob-maxima.el --- org-babel functions for maxima evaluation
+;;; ob-maxima.el --- Babel Functions for Maxima -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -48,11 +48,15 @@
(defun org-babel-maxima-expand (body params)
"Expand a block of Maxima code according to its header arguments."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params))
+ (epilogue (cdr (assq :epilogue params)))
+ (prologue (cdr (assq :prologue params))))
(mapconcat 'identity
(list
+ ;; Any code from the specified prologue at the start.
+ prologue
;; graphic output
- (let ((graphic-file (org-babel-maxima-graphical-output-file params)))
+ (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params))))
(if graphic-file
(format
"set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);"
@@ -62,6 +66,8 @@
(mapconcat 'org-babel-maxima-var-to-maxima vars "\n")
;; body
body
+ ;; Any code from the specified epilogue at the end.
+ epilogue
"gnuplot_close ()$")
"\n")))
@@ -69,9 +75,9 @@
"Execute a block of Maxima entries with org-babel.
This function is called by `org-babel-execute-src-block'."
(message "executing Maxima source code block")
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (let ((result-params (split-string (or (cdr (assq :results params)) "")))
(result
- (let* ((cmdline (or (cdr (assoc :cmdline params)) ""))
+ (let* ((cmdline (or (cdr (assq :cmdline params)) ""))
(in-file (org-babel-temp-file "maxima-" ".max"))
(cmd (format "%s --very-quiet -r 'batchload(%S)$' %s"
org-babel-maxima-command in-file cmdline)))
@@ -89,7 +95,7 @@ This function is called by `org-babel-execute-src-block'."
(= 0 (length line)))
line))
(split-string raw "[\r\n]"))) "\n")))))
- (if (org-babel-maxima-graphical-output-file params)
+ (if (ignore-errors (org-babel-graphical-output-file params))
nil
(org-babel-result-cond result-params
result
@@ -98,7 +104,7 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-import-elisp-from-file tmp-file))))))
-(defun org-babel-prep-session:maxima (session params)
+(defun org-babel-prep-session:maxima (_session _params)
(error "Maxima does not support sessions"))
(defun org-babel-maxima-var-to-maxima (pair)
@@ -113,11 +119,6 @@ of the same value."
(format "%S: %s$" var
(org-babel-maxima-elisp-to-maxima val))))
-(defun org-babel-maxima-graphical-output-file (params)
- "Name of file to which maxima should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
(defun org-babel-maxima-elisp-to-maxima (val)
"Return a string of maxima code which evaluates to VAL."
(if (listp val)
diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el
index b764475cb2f..784e0a94697 100644
--- a/lisp/org/ob-mscgen.el
+++ b/lisp/org/ob-mscgen.el
@@ -1,4 +1,4 @@
-;;; ob-msc.el --- org-babel functions for mscgen evaluation
+;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -65,15 +65,15 @@
This function is called by `org-babel-execute-src-block'.
Default filetype is png. Modify by setting :filetype parameter to
mscgen supported formats."
- (let* ((out-file (or (cdr (assoc :file params)) "output.png" ))
- (filetype (or (cdr (assoc :filetype params)) "png" )))
- (unless (cdr (assoc :file params))
+ (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"))
(org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body)
nil)) ;; signal that output has already been written to file
-(defun org-babel-prep-session:mscgen (session params)
+(defun org-babel-prep-session:mscgen (_session _params)
"Raise an error because Mscgen doesn't support sessions."
(error "Mscgen does not support sessions"))
diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el
index 31f0d01d7f6..fd0ddf8ab7f 100644
--- a/lisp/org/ob-ocaml.el
+++ b/lisp/org/ob-ocaml.el
@@ -1,4 +1,4 @@
-;;; ob-ocaml.el --- org-babel functions for ocaml evaluation
+;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -37,11 +37,11 @@
;;; Code:
(require 'ob)
(require 'comint)
-(eval-when-compile (require 'cl))
(declare-function tuareg-run-caml "ext:tuareg" ())
(declare-function tuareg-run-ocaml "ext:tuareg" ())
(declare-function tuareg-interactive-send-input "ext:tuareg" ())
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml"))
@@ -60,17 +60,17 @@
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
- (let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (full-body (org-babel-expand-body:generic
+ (let* ((full-body (org-babel-expand-body:generic
body params
(org-babel-variable-assignments:ocaml params)))
(session (org-babel-prep-session:ocaml
- (cdr (assoc :session params)) params))
+ (cdr (assq :session params)) params))
(raw (org-babel-comint-with-output
- (session org-babel-ocaml-eoe-output t full-body)
+ (session org-babel-ocaml-eoe-output nil full-body)
(insert
(concat
- (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator))
+ (org-babel-chomp full-body) ";;\n"
+ org-babel-ocaml-eoe-indicator))
(tuareg-interactive-send-input)))
(clean
(car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
@@ -79,23 +79,31 @@
(progn (setq out nil) line)
(when (string-match re line)
(progn (setq out t) nil))))
- (mapcar #'org-babel-trim (reverse raw))))))))
- (org-babel-reassemble-table
- (let ((raw (org-babel-trim clean))
- (result-params (cdr (assoc :result-params params))))
+ (mapcar #'org-trim (reverse raw)))))))
+ (raw (org-trim clean))
+ (result-params (cdr (assq :result-params params))))
+ (string-match
+ "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$"
+ raw)
+ (let ((output (match-string 1 raw))
+ (type (match-string 3 raw))
+ (value (match-string 5 raw)))
+ (org-babel-reassemble-table
(org-babel-result-cond result-params
- ;; strip type information from output unless verbatim is specified
- (if (and (not (member "verbatim" result-params))
- (string-match "= \\(.+\\)$" raw))
- (match-string 1 raw) raw)
- (org-babel-ocaml-parse-output raw)))
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cond
+ ((member "verbatim" result-params) raw)
+ ((member "output" result-params) output)
+ (t raw))
+ (if (and value type)
+ (org-babel-ocaml-parse-output value type)
+ raw))
+ (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)))))))
(defvar tuareg-interactive-buffer-name)
-(defun org-babel-prep-session:ocaml (session params)
+(defun org-babel-prep-session:ocaml (session _params)
"Prepare SESSION according to the header arguments in PARAMS."
(require 'tuareg)
(let ((tuareg-interactive-buffer-name (if (and (not (string= session "none"))
@@ -113,7 +121,7 @@
(mapcar
(lambda (pair) (format "let %s = %s;;" (car pair)
(org-babel-ocaml-elisp-to-ocaml (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-ocaml-elisp-to-ocaml (val)
"Return a string of ocaml code which evaluates to VAL."
@@ -121,26 +129,29 @@
(concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]")
(format "%S" val)))
-(defun org-babel-ocaml-parse-output (output)
- "Parse OUTPUT.
-OUTPUT is string output from an ocaml process."
- (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
- (cond
- ((string-match (format regexp "string") output)
- (org-babel-read (match-string 1 output)))
- ((or (string-match (format regexp "int") output)
- (string-match (format regexp "float") output))
- (string-to-number (match-string 1 output)))
- ((string-match (format regexp "list") output)
- (org-babel-ocaml-read-list (match-string 1 output)))
- ((string-match (format regexp "array") output)
- (org-babel-ocaml-read-array (match-string 1 output)))
- (t (message "don't recognize type of %s" output) output))))
+(defun org-babel-ocaml-parse-output (value type)
+ "Parse VALUE of type TYPE.
+VALUE and TYPE are string output from an ocaml process."
+ (cond
+ ((string= "string" type)
+ (org-babel-read value))
+ ((or (string= "int" type)
+ (string= "float" type))
+ (string-to-number value))
+ ((string-match "list" type)
+ (org-babel-ocaml-read-list value))
+ ((string-match "array" type)
+ (org-babel-ocaml-read-array value))
+ (t (message "don't recognize type %s" type) value)))
(defun org-babel-ocaml-read-list (results)
"Convert RESULTS into an elisp table or string.
If the results look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
+ ;; XXX: This probably does not behave as expected when a semicolon
+ ;; is in a string in a list. The same comment applies to
+ ;; `org-babel-ocaml-read-array' below (with even more failure
+ ;; modes).
(org-babel-script-escape (replace-regexp-in-string ";" "," results)))
(defun org-babel-ocaml-read-array (results)
diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el
index 4a96cdbf033..0f516062904 100644
--- a/lisp/org/ob-octave.el
+++ b/lisp/org/ob-octave.el
@@ -1,4 +1,4 @@
-;;; ob-octave.el --- org-babel functions for octave and matlab evaluation
+;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,10 +30,10 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function matlab-shell "ext:matlab-mode")
(declare-function matlab-shell-run-region "ext:matlab-mode")
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-default-header-args:matlab '())
(defvar org-babel-default-header-args:octave '())
@@ -74,33 +74,31 @@ end")
(let* ((session
(funcall (intern (format "org-babel-%s-initiate-session"
(if matlabp "matlab" "octave")))
- (cdr (assoc :session params)) params))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
- (out-file (cdr (assoc :file params)))
+ (cdr (assq :session params)) params))
+ (result-type (cdr (assq :result-type params)))
(full-body
(org-babel-expand-body:generic
body params (org-babel-variable-assignments:octave params)))
+ (gfx-file (ignore-errors (org-babel-graphical-output-file params)))
(result (org-babel-octave-evaluate
session
- (if (org-babel-octave-graphical-output-file params)
+ (if gfx-file
(mapconcat 'identity
(list
"set (0, \"defaultfigurevisible\", \"off\");"
full-body
- (format "print -dpng %s" (org-babel-octave-graphical-output-file params)))
+ (format "print -dpng %s" gfx-file))
"\n")
full-body)
result-type matlabp)))
- (if (org-babel-octave-graphical-output-file params)
+ (if gfx-file
nil
(org-babel-reassemble-table
result
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))))
(defun org-babel-prep-session:matlab (session params)
"Prepare SESSION according to PARAMS."
@@ -113,7 +111,7 @@ end")
(format "%s=%s;"
(car pair)
(org-babel-octave-var-to-octave (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defalias 'org-babel-variable-assignments:matlab
'org-babel-variable-assignments:octave)
@@ -147,7 +145,7 @@ If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
(org-babel-octave-initiate-session session params 'matlab))
-(defun org-babel-octave-initiate-session (&optional session params matlabp)
+(defun org-babel-octave-initiate-session (&optional session _params matlabp)
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
@@ -167,8 +165,8 @@ create. Return the initialized session."
(defun org-babel-octave-evaluate
(session body result-type &optional matlabp)
"Pass BODY to the octave process in SESSION.
-If RESULT-TYPE equals 'output then return the outputs of the
-statements in BODY, if RESULT-TYPE equals 'value then return the
+If RESULT-TYPE equals `output' then return the outputs of the
+statements in BODY, if RESULT-TYPE equals `value' then return the
value of the last statement in BODY, as elisp."
(if session
(org-babel-octave-evaluate-session session body result-type matlabp)
@@ -179,9 +177,9 @@ value of the last statement in BODY, as elisp."
(let ((cmd (if matlabp
org-babel-matlab-shell-command
org-babel-octave-shell-command)))
- (case result-type
- (output (org-babel-eval cmd body))
- (value (let ((tmp-file (org-babel-temp-file "octave-")))
+ (pcase result-type
+ (`output (org-babel-eval cmd body))
+ (`value (let ((tmp-file (org-babel-temp-file "octave-")))
(org-babel-eval
cmd
(format org-babel-octave-wrapper-method body
@@ -190,17 +188,17 @@ value of the last statement in BODY, as elisp."
(org-babel-octave-import-elisp-from-file tmp-file))))))
(defun org-babel-octave-evaluate-session
- (session body result-type &optional matlabp)
+ (session body result-type &optional matlabp)
"Evaluate BODY in SESSION."
(let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-")))
(wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-"))
(full-body
- (case result-type
- (output
+ (pcase result-type
+ (`output
(mapconcat
#'org-babel-chomp
(list body org-babel-octave-eoe-indicator) "\n"))
- (value
+ (`value
(if (and matlabp org-babel-matlab-with-emacs-link)
(concat
(format org-babel-matlab-emacs-link-wrapper-method
@@ -233,21 +231,20 @@ value of the last statement in BODY, as elisp."
org-babel-octave-eoe-output)
t full-body)
(insert full-body) (comint-send-input nil t)))) results)
- (case result-type
- (value
+ (pcase result-type
+ (`value
(org-babel-octave-import-elisp-from-file tmp-file))
- (output
- (progn
- (setq results
- (if matlabp
- (cdr (reverse (delq "" (mapcar
- #'org-babel-octave-read-string
- (mapcar #'org-babel-trim raw)))))
- (cdr (member org-babel-octave-eoe-output
- (reverse (mapcar
- #'org-babel-octave-read-string
- (mapcar #'org-babel-trim raw)))))))
- (mapconcat #'identity (reverse results) "\n"))))))
+ (`output
+ (setq results
+ (if matlabp
+ (cdr (reverse (delq "" (mapcar
+ #'org-babel-strip-quotes
+ (mapcar #'org-trim raw)))))
+ (cdr (member org-babel-octave-eoe-output
+ (reverse (mapcar
+ #'org-babel-strip-quotes
+ (mapcar #'org-trim raw)))))))
+ (mapconcat #'identity (reverse results) "\n")))))
(defun org-babel-octave-import-elisp-from-file (file-name)
"Import data from FILE-NAME.
@@ -262,17 +259,6 @@ This removes initial blank and comment lines and then calls
(delete-region beg end)))
(org-babel-import-elisp-from-file temp-file '(16))))
-(defun org-babel-octave-read-string (string)
- "Strip \\\"s from around octave string."
- (if (string-match "^\"\\([^\000]+\\)\"$" string)
- (match-string 1 string)
- string))
-
-(defun org-babel-octave-graphical-output-file (params)
- "Name of file to which maxima should send graphical output."
- (and (member "graphics" (cdr (assq :result-params params)))
- (cdr (assq :file params))))
-
(provide 'ob-octave)
diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el
index 3535891613e..232c2d0117c 100644
--- a/lisp/org/ob-org.el
+++ b/lisp/org/ob-org.el
@@ -1,4 +1,4 @@
-;;; ob-org.el --- org-babel functions for org code block evaluation
+;;; ob-org.el --- Babel Functions for Org Code Blocks -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -41,7 +41,7 @@
"Default header inserted during export of org blocks.")
(defun org-babel-expand-body:org (body params)
- (dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
+ (dolist (var (org-babel--get-vars params))
(setq body (replace-regexp-in-string
(regexp-quote (format "$%s" (car var)))
(format "%s" (cdr var))
@@ -51,7 +51,7 @@
(defun org-babel-execute:org (body params)
"Execute a block of Org code with.
This function is called by `org-babel-execute-src-block'."
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
+ (let ((result-params (split-string (or (cdr (assq :results params)) "")))
(body (org-babel-expand-body:org
(replace-regexp-in-string "^," "" body) params)))
(cond
@@ -61,7 +61,7 @@ This function is called by `org-babel-execute-src-block'."
((member "ascii" result-params) (org-export-string-as body 'ascii t))
(t body))))
-(defun org-babel-prep-session:org (session params)
+(defun org-babel-prep-session:org (_session _params)
"Return an error because org does not support sessions."
(error "Org does not support sessions"))
diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el
index 4e4407d1762..2f462cf4140 100644
--- a/lisp/org/ob-perl.el
+++ b/lisp/org/ob-perl.el
@@ -1,4 +1,4 @@
-;;; ob-perl.el --- org-babel functions for perl evaluation
+;;; ob-perl.el --- Babel Functions for Perl -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,7 +28,6 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl"))
@@ -41,20 +40,20 @@
(defun org-babel-execute:perl (body params)
"Execute a block of Perl code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((session (cdr (assoc :session params)))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((session (cdr (assq :session params)))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:perl params)))
(session (org-babel-perl-initiate-session session)))
(org-babel-reassemble-table
(org-babel-perl-evaluate session full-body result-type result-params)
(org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
+ (cdr (assq :colname-names params)) (cdr (assq :colnames params)))
(org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
+ (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))
-(defun org-babel-prep-session:perl (session params)
+(defun org-babel-prep-session:perl (_session _params)
"Prepare SESSION according to the header arguments in PARAMS."
(error "Sessions are not supported for Perl"))
@@ -63,7 +62,7 @@ This function is called by `org-babel-execute-src-block'."
(mapcar
(lambda (pair)
(org-babel-perl--var-to-perl (cdr pair) (car pair)))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
;; helper functions
@@ -76,7 +75,7 @@ This function is called by `org-babel-execute-src-block'."
The elisp value, VAR, is converted to a string of perl source code
specifying a var of the same value."
(if varn
- (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix)
+ (let ((org-babel-perl--lvl 0) (lvar (listp var)))
(concat "my $" (symbol-name varn) "=" (when lvar "\n")
(org-babel-perl--var-to-perl var)
";\n"))
@@ -92,7 +91,7 @@ specifying a var of the same value."
(defvar org-babel-perl-buffers '(:default . nil))
-(defun org-babel-perl-initiate-session (&optional session params)
+(defun org-babel-perl-initiate-session (&optional _session _params)
"Return nil because sessions are not supported by perl."
nil)
@@ -127,8 +126,8 @@ specifying a var of the same value."
(defun org-babel-perl-evaluate (session ibody &optional result-type result-params)
"Pass BODY to the Perl process in SESSION.
-If RESULT-TYPE equals 'output then return a list of the outputs
-of the statements in BODY, if RESULT-TYPE equals 'value then
+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, as elisp."
(when session (error "Sessions are not supported for Perl"))
(let* ((body (concat org-babel-perl-preface ibody))
@@ -136,13 +135,13 @@ return the value of the last statement in BODY, as elisp."
(tmp-babel-file (org-babel-process-file-name
tmp-file 'noquote)))
(let ((results
- (case result-type
- (output
+ (pcase result-type
+ (`output
(with-temp-file tmp-file
(insert
(org-babel-eval org-babel-perl-command body))
(buffer-string)))
- (value
+ (`value
(org-babel-eval org-babel-perl-command
(format org-babel-perl-wrapper-method
body tmp-babel-file))))))
diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el
index a87c15ea977..a1dbe6de2a6 100644
--- a/lisp/org/ob-picolisp.el
+++ b/lisp/org/ob-picolisp.el
@@ -1,4 +1,4 @@
-;;; ob-picolisp.el --- org-babel functions for picolisp evaluation
+;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -55,7 +55,6 @@
;;; Code:
(require 'ob)
(require 'comint)
-(eval-when-compile (require 'cl))
(declare-function run-picolisp "ext:inferior-picolisp" (cmd))
(defvar org-babel-tangle-lang-exts) ;; Autoloaded
@@ -80,9 +79,9 @@
(defun org-babel-expand-body:picolisp (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))
- (result-params (cdr (assoc :result-params params)))
- (print-level nil) (print-length nil))
+ (let ((vars (org-babel--get-vars params))
+ (print-level nil)
+ (print-length nil))
(if (> (length vars) 0)
(concat "(prog (let ("
(mapconcat
@@ -100,12 +99,11 @@
(message "executing Picolisp source code block")
(let* (
;; Name of the session or "none".
- (session-name (cdr (assoc :session params)))
+ (session-name (cdr (assq :session params)))
;; Set the session if the session variable is non-nil.
(session (org-babel-picolisp-initiate-session session-name))
;; Either OUTPUT or VALUE which should behave as described above.
- (result-type (cdr (assoc :result-type params)))
- (result-params (cdr (assoc :result-params params)))
+ (result-params (cdr (assq :result-params params)))
;; Expand the body with `org-babel-expand-body:picolisp'.
(full-body (org-babel-expand-body:picolisp body params))
;; Wrap body appropriately for the type of evaluation and results.
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index e05565e32ce..8093100edaf 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -1,4 +1,4 @@
-;;; ob-plantuml.el --- org-babel functions for plantuml evaluation
+;;; ob-plantuml.el --- Babel Functions for Plantuml -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -46,35 +46,76 @@
:version "24.1"
:type '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
+contain multiple entries for the key `:var'. `:var' entries in PARAMS
+are expected to be scalar variables."
+ (mapcar
+ (lambda (pair)
+ (format "!define %s %s"
+ (car pair)
+ (replace-regexp-in-string "\"" "" (cdr pair))))
+ (org-babel--get-vars params)))
+
+(defun org-babel-plantuml-make-body (body params)
+ "Return PlantUML input string.
+BODY is the content of the source block and PARAMS is a property list
+of source block parameters. This function relies on the
+`org-babel-expand-body:generic' function to extract `:var' entries
+from PARAMS and on the `org-babel-variable-assignments:plantuml'
+function to convert variables to PlantUML assignments."
+ (concat
+ "@startuml\n"
+ (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:plantuml params))
+ "\n@enduml"))
+
(defun org-babel-execute:plantuml (body params)
"Execute a block of plantuml code with org-babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (out-file (or (cdr (assoc :file params))
+ (let* ((out-file (or (cdr (assq :file params))
(error "PlantUML requires a \":file\" header argument")))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "plantuml-"))
- (java (or (cdr (assoc :java params)) ""))
+ (java (or (cdr (assq :java params)) ""))
+ (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) "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))
- (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml")))
+ (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
-(defun org-babel-prep-session:plantuml (session params)
+(defun org-babel-prep-session:plantuml (_session _params)
"Return an error because plantuml does not support sessions."
(error "Plantuml does not support sessions"))
diff --git a/lisp/org/ob-processing.el b/lisp/org/ob-processing.el
new file mode 100644
index 00000000000..4e09abc98bc
--- /dev/null
+++ b/lisp/org/ob-processing.el
@@ -0,0 +1,195 @@
+;;; ob-processing.el --- Babel functions for processing -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte)
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Babel support for evaluating processing source code.
+;;
+;; This differs from most standard languages in that
+;;
+;; 1) there is no such thing as a "session" in processing
+;;
+;; 2) results can only be exported as html; in this case, the
+;; processing code is embedded via a file into a javascript block
+;; using the processing.js module; the script then draws the
+;; resulting output when the web page is viewed in a browser; note
+;; that the user is responsible for making sure that processing.js
+;; is available on the website
+;;
+;; 3) it is possible to interactively view the sketch of the
+;; Processing code block via Processing 2.0 Emacs mode, using
+;; `org-babel-processing-view-sketch'. You can bind this command
+;; to, e.g., C-c C-v C-k with
+;;
+;; (define-key org-babel-map (kbd "C-k") 'org-babel-processing-view-sketch)
+
+
+;;; Requirements:
+
+;; - processing2-emacs mode :: https://github.com/ptrv/processing2-emacs
+;; - Processing.js module :: http://processingjs.org/
+
+;;; Code:
+(require 'ob)
+(require 'sha1)
+
+(declare-function processing-sketch-run "ext:processing-mode" ())
+
+(defvar org-babel-temporary-directory)
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("processing" . "pde"))
+
+;; Default header tags depend on whether exporting html or not; if not
+;; exporting html, then no results are produced; otherwise results are
+;; HTML.
+(defvar org-babel-default-header-args:processing
+ '((:results . "html") (:exports . "results"))
+ "Default arguments when evaluating a Processing source block.")
+
+(defvar org-babel-processing-processing-js-filename "processing.js"
+ "Filename of the processing.js file.")
+
+(defun org-babel-processing-view-sketch ()
+ "Show the sketch of the Processing block under point in an external viewer."
+ (interactive)
+ (require 'processing-mode)
+ (let ((info (org-babel-get-src-block-info)))
+ (if (string= (nth 0 info) "processing")
+ (let* ((body (nth 1 info))
+ (params (org-babel-process-params (nth 2 info)))
+ (sketch-code
+ (org-babel-expand-body:generic
+ body
+ params
+ (org-babel-variable-assignments:processing params))))
+ ;; Note: sketch filename can not contain a hyphen, since it
+ ;; has to be a valid java class name; for this reason
+ ;; make-temp-file is repeated until no hyphen is in the
+ ;; name; also sketch dir name must be the same as the
+ ;; basename of the sketch file.
+ (let* ((temporary-file-directory org-babel-temporary-directory)
+ (sketch-dir
+ (let (sketch-dir-candidate)
+ (while
+ (progn
+ (setq sketch-dir-candidate
+ (make-temp-file "processing" t))
+ (when (string-match-p
+ "-"
+ (file-name-nondirectory sketch-dir-candidate))
+ (delete-directory sketch-dir-candidate)
+ t)))
+ sketch-dir-candidate))
+ (sketch-filename
+ (concat sketch-dir
+ "/"
+ (file-name-nondirectory sketch-dir)
+ ".pde")))
+ (with-temp-file sketch-filename (insert sketch-code))
+ (find-file sketch-filename)
+ (processing-sketch-run)
+ (kill-buffer)))
+ (message "Not inside a Processing source block."))))
+
+(defun org-babel-execute:processing (body params)
+ "Execute a block of Processing code.
+This function is called by `org-babel-execute-src-block'."
+ (let ((sketch-code
+ (org-babel-expand-body:generic
+ body
+ params
+ (org-babel-variable-assignments:processing params))))
+ ;; Results are HTML.
+ (let ((sketch-canvas-id (concat "ob-" (sha1 sketch-code))))
+ (concat "<script src=\""
+ org-babel-processing-processing-js-filename
+ "\"></script>\n <script type=\"text/processing\""
+ " data-processing-target=\""
+ sketch-canvas-id
+ "\">\n"
+ sketch-code
+ "\n</script> <canvas id=\""
+ sketch-canvas-id
+ "\"></canvas>"))))
+
+(defun org-babel-prep-session:processing (_session _params)
+ "Return an error if the :session header argument is set.
+Processing does not support sessions"
+ (error "Processing does not support sessions"))
+
+(defun org-babel-variable-assignments:processing (params)
+ "Return list of processing statements assigning the block's variables."
+ (mapcar #'org-babel-processing-var-to-processing
+ (org-babel--get-vars params)))
+
+(defun org-babel-processing-var-to-processing (pair)
+ "Convert an elisp value into a Processing variable.
+The elisp value PAIR is converted into Processing code specifying
+a variable of the same value."
+ (let ((var (car pair))
+ (val (let ((v (cdr pair)))
+ (if (symbolp v) (symbol-name v) v))))
+ (cond
+ ((integerp val)
+ (format "int %S=%S;" var val))
+ ((floatp val)
+ (format "float %S=%S;" var val))
+ ((stringp val)
+ (format "String %S=\"%s\";" var val))
+ ((and (listp val) (not (listp (car val))))
+ (let* ((type (org-babel-processing-define-type val))
+ (fmt (if (eq 'String type) "\"%s\"" "%s"))
+ (vect (mapconcat (lambda (e) (format fmt e)) val ", ")))
+ (format "%s[] %S={%s};" type var vect)))
+ ((listp val)
+ (let* ((type (org-babel-processing-define-type val))
+ (fmt (if (eq 'String type) "\"%s\"" "%s"))
+ (array (mapconcat (lambda (row)
+ (concat "{"
+ (mapconcat (lambda (e) (format fmt e))
+ row ", ")
+ "}"))
+ val ",")))
+ (format "%S[][] %S={%s};" type var array))))))
+
+(defun org-babel-processing-define-type (data)
+ "Determine type of DATA.
+
+DATA is a list. Return type as a symbol.
+
+The type is `String' if any element in DATA is a string.
+Otherwise, it is either `float', if some elements are floats, or
+`int'."
+ (letrec ((type 'int)
+ (find-type
+ (lambda (row)
+ (dolist (e row type)
+ (cond ((listp e) (setq type (funcall find-type e)))
+ ((stringp e) (throw 'exit 'String))
+ ((floatp e) (setq type 'float)))))))
+ (catch 'exit (funcall find-type data))))
+
+(provide 'ob-processing)
+
+;;; ob-processing.el ends here
diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el
index dfad47bf9e0..60ec5fa4752 100644
--- a/lisp/org/ob-python.el
+++ b/lisp/org/ob-python.el
@@ -1,4 +1,4 @@
-;;; ob-python.el --- org-babel functions for python evaluation
+;;; ob-python.el --- Babel Functions for Python -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,9 +28,9 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function org-remove-indentation "org" )
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
(declare-function run-python "ext:python" (&optional cmd dedicated show))
@@ -48,9 +48,9 @@
:type 'string)
(defcustom org-babel-python-mode
- (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python)
+ (if (featurep 'python-mode) 'python-mode 'python)
"Preferred python mode for use in running python interactively.
-This will typically be either 'python or 'python-mode."
+This will typically be either `python' or `python-mode'."
:group 'org-babel
:version "24.4"
:package-version '(Org . "8.0")
@@ -73,13 +73,16 @@ This will typically be either 'python or 'python-mode."
(defun org-babel-execute:python (body params)
"Execute a block of Python code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((session (org-babel-python-initiate-session
- (cdr (assoc :session params))))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (let* ((org-babel-python-command
+ (or (cdr (assq :python params))
+ org-babel-python-command))
+ (session (org-babel-python-initiate-session
+ (cdr (assq :session params))))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(return-val (when (and (eq result-type 'value) (not session))
- (cdr (assoc :return params))))
- (preamble (cdr (assoc :preamble params)))
+ (cdr (assq :return params))))
+ (preamble (cdr (assq :preamble params)))
(full-body
(org-babel-expand-body:generic
(concat body (if return-val (format "\nreturn %s" return-val) ""))
@@ -88,10 +91,10 @@ This function is called by `org-babel-execute-src-block'."
session full-body result-type result-params preamble)))
(org-babel-reassemble-table
result
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))
+ (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-prep-session:python (session params)
"Prepare SESSION according to the header arguments in PARAMS.
@@ -123,7 +126,7 @@ VARS contains resolved variable references"
(format "%s=%s"
(car pair)
(org-babel-python-var-to-python (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-python-var-to-python (var)
"Convert an elisp value to a python variable.
@@ -131,7 +134,7 @@ Convert an elisp value, VAR, into a string of python source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]")
- (if (equal var 'hline)
+ (if (eq var 'hline)
org-babel-python-hline-to
(format
(if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S")
@@ -143,7 +146,7 @@ If the results look like a list or tuple, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(let ((res (org-babel-script-escape results)))
(if (listp res)
- (mapcar (lambda (el) (if (equal el 'None)
+ (mapcar (lambda (el) (if (eq el 'None)
org-babel-python-None-to el))
res)
res)))
@@ -214,7 +217,7 @@ then create. Return the initialized session."
(assq-delete-all session org-babel-python-buffers)))
session)))
-(defun org-babel-python-initiate-session (&optional session params)
+(defun org-babel-python-initiate-session (&optional session _params)
"Create a session named SESSION according to PARAMS."
(unless (string= session "none")
(org-babel-python-session-buffer
@@ -222,13 +225,13 @@ then create. Return the initialized session."
(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'"
"A string to indicate that evaluation has completed.")
-(defvar org-babel-python-wrapper-method
+(defconst org-babel-python-wrapper-method
"
def main():
%s
open('%s', 'w').write( str(main()) )")
-(defvar org-babel-python-pp-wrapper-method
+(defconst org-babel-python-pp-wrapper-method
"
import pprint
def main():
@@ -246,42 +249,41 @@ open('%s', 'w').write( pprint.pformat(main()) )")
body result-type result-params preamble)))
(defun org-babel-python-evaluate-external-process
- (body &optional result-type result-params preamble)
+ (body &optional result-type result-params preamble)
"Evaluate BODY in external python process.
-If RESULT-TYPE equals 'output then return standard output as a
-string. If RESULT-TYPE equals 'value then return the value of the
+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 ((raw
- (case result-type
- (output (org-babel-eval org-babel-python-command
- (concat (if preamble (concat preamble "\n"))
- body)))
- (value (let ((tmp-file (org-babel-temp-file "python-")))
- (org-babel-eval
- org-babel-python-command
- (concat
- (if preamble (concat preamble "\n") "")
- (format
- (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-babel-trim body))
- "[\r\n]") "\n")
- (org-babel-process-file-name tmp-file 'noquote))))
- (org-babel-eval-read-file tmp-file))))))
+ (pcase result-type
+ (`output (org-babel-eval org-babel-python-command
+ (concat (if preamble (concat preamble "\n"))
+ body)))
+ (`value (let ((tmp-file (org-babel-temp-file "python-")))
+ (org-babel-eval
+ org-babel-python-command
+ (concat
+ (if preamble (concat preamble "\n") "")
+ (format
+ (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-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-babel-trim raw)))))
+ (org-babel-python-table-or-string (org-trim raw)))))
(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
+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
@@ -302,10 +304,10 @@ last statement in BODY, as elisp."
(split-string body "[\r\n]"))
(funcall send-wait)))
(results
- (case result-type
- (output
+ (pcase result-type
+ (`output
(mapconcat
- #'org-babel-trim
+ #'org-trim
(butlast
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator t body)
@@ -314,7 +316,7 @@ last statement in BODY, as elisp."
(insert org-babel-python-eoe-indicator)
(funcall send-wait))
2) "\n"))
- (value
+ (`value
(let ((tmp-file (org-babel-temp-file "python-")))
(org-babel-comint-with-output
(session org-babel-python-eoe-indicator nil body)
@@ -332,9 +334,10 @@ last statement in BODY, as elisp."
(org-babel-python-table-or-string results)))))
(defun org-babel-python-read-string (string)
- "Strip 's from around Python string."
- (if (string-match "^'\\([^\000]+\\)'$" string)
- (match-string 1 string)
+ "Strip \\='s from around Python string."
+ (if (and (string-prefix-p "'" string)
+ (string-suffix-p "'" string))
+ (substring string 1 -1)
string))
(provide 'ob-python)
diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el
index 1d26403035f..323cdc7ef72 100644
--- a/lisp/org/ob-ref.el
+++ b/lisp/org/ob-ref.el
@@ -1,4 +1,4 @@
-;;; ob-ref.el --- org-babel functions for referencing external data
+;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -50,19 +50,20 @@
;;; Code:
(require 'ob-core)
-(eval-when-compile
- (require 'cl))
-
-(declare-function org-remove-if-not "org" (predicate seq))
-(declare-function org-at-table-p "org" (&optional table-type))
-(declare-function org-count "org" (CL-ITEM CL-SEQ))
-(declare-function org-at-item-p "org-list" ())
-(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
+(require 'cl-lib)
+
+(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-end-of-meta-data "org" (&optional full))
+(declare-function org-find-property "org" (property &optional value))
(declare-function org-id-find-id-file "org-id" (id))
+(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-narrow-to-subtree "org" ())
(declare-function org-show-context "org" (&optional key))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-trim "org" (s &optional keep-lead))
(defvar org-babel-ref-split-regexp
"[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
@@ -90,35 +91,31 @@ the variable."
org-babel-current-src-block-location)))
(org-babel-read ref))))
(if (equal out ref)
- (if (string-match "^\".*\"$" ref)
+ (if (and (string-prefix-p "\"" ref)
+ (string-suffix-p "\"" ref))
(read ref)
(org-babel-ref-resolve ref))
out))))))
(defun org-babel-ref-goto-headline-id (id)
- (goto-char (point-min))
- (let ((rx (regexp-quote id)))
- (or (re-search-forward
- (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t)
- (let* ((file (org-id-find-id-file id))
- (m (when file (org-id-find-id-in-file id file 'marker))))
- (when (and file m)
- (message "file:%S" file)
- (org-pop-to-buffer-same-window (marker-buffer m))
- (goto-char m)
- (move-marker m nil)
- (org-show-context)
- t)))))
+ (or (let ((h (org-find-property "CUSTOM_ID" id)))
+ (when h (goto-char h)))
+ (let* ((file (org-id-find-id-file id))
+ (m (when file (org-id-find-id-in-file id file 'marker))))
+ (when (and file m)
+ (message "file:%S" file)
+ (pop-to-buffer-same-window (marker-buffer m))
+ (goto-char m)
+ (move-marker m nil)
+ (org-show-context)
+ t))))
(defun org-babel-ref-headline-body ()
(save-restriction
(org-narrow-to-subtree)
(buffer-substring
(save-excursion (goto-char (point-min))
- (forward-line 1)
- (when (looking-at "[ \t]*:PROPERTIES:")
- (re-search-forward ":END:" nil)
- (forward-char))
+ (org-end-of-meta-data)
(point))
(point-max))))
@@ -126,89 +123,82 @@ the variable."
(defun org-babel-ref-resolve (ref)
"Resolve the reference REF and return its value."
(save-window-excursion
- (save-excursion
- (let ((case-fold-search t)
- type args new-refere new-header-args new-referent result
- lob-info split-file split-ref index index-row index-col id)
- ;; if ref is indexed grab the indices -- beware nested indices
- (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
- (let ((str (substring ref 0 (match-beginning 0))))
- (= (org-count ?\( str) (org-count ?\) str))))
- (setq index (match-string 1 ref))
- (setq ref (substring ref 0 (match-beginning 0))))
- ;; assign any arguments to pass to source block
- (when (string-match
- "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\(.*\\))$" ref)
- (setq new-refere (match-string 1 ref))
- (setq new-header-args (match-string 3 ref))
- (setq new-referent (match-string 5 ref))
- (when (> (length new-refere) 0)
- (when (> (length new-referent) 0)
- (setq args (mapcar (lambda (ref) (cons :var ref))
- (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)))
- (setq ref new-refere)))
- (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
- (setq split-file (match-string 1 ref))
- (setq split-ref (match-string 2 ref))
- (find-file split-file) (setq ref split-ref))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref))
- (res-rx (org-babel-named-data-regexp-for-name ref)))
- ;; goto ref in the current buffer
- (or
- ;; check for code blocks
- (re-search-forward src-rx nil t)
- ;; check for named data
- (re-search-forward res-rx nil t)
- ;; check for local or global headlines by id
- (setq id (org-babel-ref-goto-headline-id ref))
- ;; check the Library of Babel
- (setq lob-info (cdr (assoc (intern ref)
- org-babel-library-of-babel)))))
- (unless (or lob-info id) (goto-char (match-beginning 0)))
- ;; ;; TODO: allow searching for names in other buffers
- ;; (setq id-loc (org-id-find ref 'marker)
- ;; buffer (marker-buffer id-loc)
- ;; loc (marker-position id-loc))
- ;; (move-marker id-loc nil)
- (error "Reference `%s' not found in this buffer" ref))
- (cond
- (lob-info (setq type 'lob))
- (id (setq type 'id))
- ((and (looking-at org-babel-src-name-regexp)
- (save-excursion
- (forward-line 1)
- (or (looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp))))
- (setq type 'source-block))
- (t (while (not (setq type (org-babel-ref-at-ref-p)))
- (forward-line 1)
- (beginning-of-line)
- (if (or (= (point) (point-min)) (= (point) (point-max)))
- (error "Reference not found")))))
- (let ((params (append args '((:results . "silent")))))
- (setq result
- (case type
- (results-line (org-babel-read-result))
- (table (org-babel-read-table))
- (list (org-babel-read-list))
- (file (org-babel-read-link))
- (source-block (org-babel-execute-src-block
- nil nil (if org-babel-update-intermediate
- nil params)))
- (lob (org-babel-execute-src-block
- nil lob-info params))
- (id (org-babel-ref-headline-body)))))
- (if (symbolp result)
- (format "%S" result)
- (if (and index (listp result))
- (org-babel-ref-index-list index result)
- result)))))))
+ (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer))
+ (save-excursion
+ (let ((case-fold-search t)
+ args new-refere new-header-args new-referent split-file split-ref
+ index)
+ ;; if ref is indexed grab the indices -- beware nested indices
+ (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref)
+ (let ((str (substring ref 0 (match-beginning 0))))
+ (= (cl-count ?\( str) (cl-count ?\) str))))
+ (setq index (match-string 1 ref))
+ (setq ref (substring ref 0 (match-beginning 0))))
+ ;; assign any arguments to pass to source block
+ (when (string-match
+ "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\(.*\\))$" ref)
+ (setq new-refere (match-string 1 ref))
+ (setq new-header-args (match-string 3 ref))
+ (setq new-referent (match-string 5 ref))
+ (when (> (length new-refere) 0)
+ (when (> (length new-referent) 0)
+ (setq args (mapcar (lambda (ref) (cons :var ref))
+ (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)))
+ (setq ref new-refere)))
+ (when (string-match "^\\(.+\\):\\(.+\\)$" ref)
+ (setq split-file (match-string 1 ref))
+ (setq split-ref (match-string 2 ref))
+ (find-file split-file)
+ (setq ref split-ref))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let* ((params (append args '((:results . "silent"))))
+ (regexp (org-babel-named-data-regexp-for-name ref))
+ (result
+ (catch :found
+ ;; Check for code blocks or named data.
+ (while (re-search-forward regexp nil t)
+ ;; Ignore COMMENTed headings and orphaned
+ ;; affiliated keywords.
+ (unless (org-in-commented-heading-p)
+ (let ((e (org-element-at-point)))
+ (when (equal (org-element-property :name e) ref)
+ (goto-char
+ (org-element-property :post-affiliated e))
+ (pcase (org-element-type e)
+ (`babel-call
+ (throw :found
+ (org-babel-execute-src-block
+ nil (org-babel-lob-get-info e) params)))
+ (`src-block
+ (throw :found
+ (org-babel-execute-src-block
+ nil nil
+ (and
+ (not org-babel-update-intermediate)
+ params))))
+ ((and (let v (org-babel-read-element e))
+ (guard v))
+ (throw :found v))
+ (_ (error "Reference not found")))))))
+ ;; Check for local or global headlines by ID.
+ (when (org-babel-ref-goto-headline-id ref)
+ (throw :found (org-babel-ref-headline-body)))
+ ;; Check the Library of Babel.
+ (let ((info (cdr (assq (intern ref)
+ org-babel-library-of-babel))))
+ (when info
+ (throw :found
+ (org-babel-execute-src-block nil info params))))
+ (error "Reference `%s' not found in this buffer" ref))))
+ (cond
+ ((symbolp result) (format "%S" result))
+ ((and index (listp result))
+ (org-babel-ref-index-list index result))
+ (t result)))))))))
(defun org-babel-ref-index-list (index lis)
"Return the subset of LIS indexed by INDEX.
@@ -251,21 +241,9 @@ to \"0:-1\"."
(defun org-babel-ref-split-args (arg-string)
"Split ARG-STRING into top-level arguments of balanced parenthesis."
- (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44)))
+ (mapcar #'org-trim (org-babel-balanced-split arg-string 44)))
-(defvar org-bracket-link-regexp)
-(defun org-babel-ref-at-ref-p ()
- "Return the type of reference located at point.
-Return nil if none of the supported reference types are found.
-Supported reference types are tables and source blocks."
- (cond ((org-at-table-p) 'table)
- ((org-at-item-p) 'list)
- ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block)
- ((looking-at org-bracket-link-regexp) 'file)
- ((looking-at org-babel-result-regexp) 'results-line)))
(provide 'ob-ref)
-
-
;;; ob-ref.el ends here
diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el
index 88a99876964..d9525ea3d4c 100644
--- a/lisp/org/ob-ruby.el
+++ b/lisp/org/ob-ruby.el
@@ -1,4 +1,4 @@
-;;; ob-ruby.el --- org-babel functions for ruby evaluation
+;;; ob-ruby.el --- Babel Functions for Ruby -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -37,11 +37,14 @@
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function run-ruby "ext:inf-ruby" (&optional command name))
(declare-function xmp "ext:rcodetools" (&optional option))
+(defvar inf-ruby-default-implementation)
+(defvar inf-ruby-implementations)
+
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb"))
@@ -68,16 +71,16 @@
"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 (assoc :session params))))
- (result-params (cdr (assoc :result-params params)))
- (result-type (cdr (assoc :result-type params)))
+ (cdr (assq :session params))))
+ (result-params (cdr (assq :result-params params)))
+ (result-type (cdr (assq :result-type params)))
(full-body (org-babel-expand-body:generic
body params (org-babel-variable-assignments:ruby params)))
(result (if (member "xmp" result-params)
(with-temp-buffer
(require 'rcodetools)
(insert full-body)
- (xmp (cdr (assoc :xmp-option params)))
+ (xmp (cdr (assq :xmp-option params)))
(buffer-string))
(org-babel-ruby-evaluate
session full-body result-type result-params))))
@@ -85,10 +88,10 @@ This function is called by `org-babel-execute-src-block'."
(org-babel-result-cond result-params
result
(org-babel-ruby-table-or-string result))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))
+ (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-prep-session:ruby (session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
@@ -121,7 +124,7 @@ This function is called by `org-babel-execute-src-block'."
(format "%s=%s"
(car pair)
(org-babel-ruby-var-to-ruby (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (org-babel--get-vars params)))
(defun org-babel-ruby-var-to-ruby (var)
"Convert VAR into a ruby variable.
@@ -129,7 +132,7 @@ Convert an elisp value into a string of ruby source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
- (if (equal var 'hline)
+ (if (eq var 'hline)
org-babel-ruby-hline-to
(format "%S" var))))
@@ -139,23 +142,27 @@ If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
(let ((res (org-babel-script-escape results)))
(if (listp res)
- (mapcar (lambda (el) (if (equal el 'nil)
- org-babel-ruby-nil-to el))
+ (mapcar (lambda (el) (if (not el)
+ org-babel-ruby-nil-to el))
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 ((session-buffer (save-window-excursion
- (run-ruby nil session) (current-buffer))))
+ (let* ((cmd (cdr (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)
+ (current-buffer)))))
(if (org-babel-comint-buffer-livep session-buffer)
(progn (sit-for .25) session-buffer)
- (sit-for .5)
- (org-babel-ruby-initiate-session session)))))
+ (sit-for .5)
+ (org-babel-ruby-initiate-session session)))))
(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe"
"String to indicate that evaluation has completed.")
@@ -185,46 +192,53 @@ end
")
(defun org-babel-ruby-evaluate
- (buffer body &optional result-type result-params)
+ (buffer body &optional result-type result-params)
"Pass BODY to the Ruby process in BUFFER.
-If RESULT-TYPE equals 'output then return a list of the outputs
-of the statements in BODY, if RESULT-TYPE equals 'value then
+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, as elisp."
(if (not buffer)
;; external process evaluation
- (case result-type
- (output (org-babel-eval org-babel-ruby-command body))
- (value (let ((tmp-file (org-babel-temp-file "ruby-")))
- (org-babel-eval
- org-babel-ruby-command
- (format (if (member "pp" result-params)
- org-babel-ruby-pp-wrapper-method
- org-babel-ruby-wrapper-method)
- body (org-babel-process-file-name tmp-file 'noquote)))
- (let ((raw (org-babel-eval-read-file tmp-file)))
- (if (or (member "code" result-params)
- (member "pp" result-params))
- raw
- (org-babel-ruby-table-or-string raw))))))
+ (pcase result-type
+ (`output (org-babel-eval org-babel-ruby-command body))
+ (`value (let ((tmp-file (org-babel-temp-file "ruby-")))
+ (org-babel-eval
+ org-babel-ruby-command
+ (format (if (member "pp" result-params)
+ org-babel-ruby-pp-wrapper-method
+ org-babel-ruby-wrapper-method)
+ body (org-babel-process-file-name tmp-file 'noquote)))
+ (org-babel-eval-read-file tmp-file))))
;; comint session evaluation
- (case result-type
- (output
- (mapconcat
- #'identity
- (butlast
- (split-string
- (mapconcat
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (buffer org-babel-ruby-eoe-indicator t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line)) (comint-send-input nil t))
- (list body org-babel-ruby-eoe-indicator))
- (comint-send-input nil t)) 2)
- "\n") "[\r\n]")) "\n"))
- (value
+ (pcase result-type
+ (`output
+ (let ((eoe-string (format "puts \"%s\"" org-babel-ruby-eoe-indicator)))
+ ;; Force the session to be ready before the actual session
+ ;; code is run. There is some problem in comint that will
+ ;; sometimes show the prompt after the the input has already
+ ;; been inserted and that throws off the extraction of the
+ ;; result for Babel.
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t eoe-string)
+ (insert eoe-string) (comint-send-input nil t))
+ ;; Now we can start the evaluation.
+ (mapconcat
+ #'identity
+ (butlast
+ (split-string
+ (mapconcat
+ #'org-trim
+ (org-babel-comint-with-output
+ (buffer org-babel-ruby-eoe-indicator t body)
+ (mapc
+ (lambda (line)
+ (insert (org-babel-chomp line)) (comint-send-input nil t))
+ (list "conf.echo=false;_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:NULL"
+ body
+ "conf.prompt_mode=_org_prompt_mode;conf.echo=true"
+ eoe-string)))
+ "\n") "[\r\n]") 4) "\n")))
+ (`value
(let* ((tmp-file (org-babel-temp-file "ruby-"))
(ppp (or (member "code" result-params)
(member "pp" result-params))))
@@ -247,12 +261,6 @@ return the value of the last statement in BODY, as elisp."
(comint-send-input nil t))
(org-babel-eval-read-file tmp-file))))))
-(defun org-babel-ruby-read-string (string)
- "Strip \\\"s from around a ruby string."
- (if (string-match "^\"\\([^\000]+\\)\"$" string)
- (match-string 1 string)
- string))
-
(provide 'ob-ruby)
diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el
index 847c144e80a..769c9011f82 100644
--- a/lisp/org/ob-sass.el
+++ b/lisp/org/ob-sass.el
@@ -1,4 +1,4 @@
-;;; ob-sass.el --- org-babel functions for the sass css generation language
+;;; ob-sass.el --- Babel Functions for the Sass CSS generation language -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -45,10 +45,9 @@
(defun org-babel-execute:sass (body params)
"Execute a block of Sass code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (file (cdr (assoc :file params)))
+ (let* ((file (cdr (assq :file params)))
(out-file (or file (org-babel-temp-file "sass-out-")))
- (cmdline (cdr (assoc :cmdline params)))
+ (cmdline (cdr (assq :cmdline params)))
(in-file (org-babel-temp-file "sass-in-"))
(cmd (concat "sass " (or cmdline "")
" " (org-babel-process-file-name in-file)
@@ -60,7 +59,7 @@ This function is called by `org-babel-execute-src-block'."
nil ;; signal that output has already been written to file
(with-temp-buffer (insert-file-contents out-file) (buffer-string)))))
-(defun org-babel-prep-session:sass (session params)
+(defun org-babel-prep-session:sass (_session _params)
"Raise an error because sass does not support sessions."
(error "Sass does not support sessions"))
diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el
deleted file mode 100644
index 9bddeed6e6f..00000000000
--- a/lisp/org/ob-scala.el
+++ /dev/null
@@ -1,124 +0,0 @@
-;;; ob-scala.el --- org-babel functions for Scala evaluation
-
-;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
-
-;; Author: Andrzej Lichnerowicz
-;; Keywords: literate programming, reproducible research
-;; Homepage: http://orgmode.org
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; Currently only supports the external execution. No session support yet.
-
-;;; Requirements:
-;; - Scala language :: http://www.scala-lang.org/
-;; - Scala major mode :: Can be installed from Scala sources
-;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el
-
-;;; Code:
-(require 'ob)
-(eval-when-compile (require 'cl))
-
-(defvar org-babel-tangle-lang-exts) ;; Autoloaded
-(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala"))
-(defvar org-babel-default-header-args:scala '())
-(defvar org-babel-scala-command "scala"
- "Name of the command to use for executing Scala code.")
-
-(defun org-babel-execute:scala (body params)
- "Execute a block of Scala code with org-babel. This function is
-called by `org-babel-execute-src-block'"
- (message "executing Scala source code block")
- (let* ((processed-params (org-babel-process-params params))
- (session (org-babel-scala-initiate-session (nth 0 processed-params)))
- (vars (nth 1 processed-params))
- (result-params (nth 2 processed-params))
- (result-type (cdr (assoc :result-type params)))
- (full-body (org-babel-expand-body:generic
- body params))
- (result (org-babel-scala-evaluate
- session full-body result-type result-params)))
-
- (org-babel-reassemble-table
- result
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
-
-
-(defun org-babel-scala-table-or-string (results)
- "Convert RESULTS into an appropriate elisp value.
-If RESULTS look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
-
-(defvar org-babel-scala-wrapper-method
-
-"var str_result :String = null;
-
-Console.withOut(new java.io.OutputStream() {def write(b: Int){
-}}) {
- str_result = {
-%s
- }.toString
-}
-
-print(str_result)
-")
-
-
-(defun org-babel-scala-evaluate
- (session body &optional result-type result-params)
- "Evaluate BODY in external Scala process.
-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."
- (when session (error "Sessions are not (yet) supported for Scala"))
- (case result-type
- (output
- (let ((src-file (org-babel-temp-file "scala-")))
- (progn (with-temp-file src-file (insert body))
- (org-babel-eval
- (concat org-babel-scala-command " " src-file) ""))))
- (value
- (let* ((src-file (org-babel-temp-file "scala-"))
- (wrapper (format org-babel-scala-wrapper-method body)))
- (with-temp-file src-file (insert wrapper))
- (let ((raw (org-babel-eval
- (concat org-babel-scala-command " " src-file) "")))
- (org-babel-result-cond result-params
- raw
- (org-babel-scala-table-or-string raw)))))))
-
-
-(defun org-babel-prep-session:scala (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (error "Sessions are not (yet) supported for Scala"))
-
-(defun org-babel-scala-initiate-session (&optional session)
- "If there is not a current inferior-process-buffer in SESSION
-then create. Return the initialized session. Sessions are not
-supported in Scala."
- nil)
-
-(provide 'ob-scala)
-
-
-
-;;; ob-scala.el ends here
diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el
index ae77c7c3edf..f67080adfd3 100644
--- a/lisp/org/ob-scheme.el
+++ b/lisp/org/ob-scheme.el
@@ -1,4 +1,4 @@
-;;; ob-scheme.el --- org-babel functions for Scheme
+;;; ob-scheme.el --- Babel Functions for Scheme -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -32,7 +32,7 @@
;;; Requirements:
;; - a working scheme implementation
-;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
+;; (e.g. guile https://www.gnu.org/software/guile/guile.html)
;;
;; - for session based evaluation geiser is required, which is available from
;; ELPA.
@@ -44,37 +44,51 @@
(defvar geiser-impl--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
+(defvar geiser-debug-jump-to-debug-p) ; Defined in geiser-debug.el
+(defvar geiser-repl-use-other-window) ; Defined in geiser-repl.el
+(defvar geiser-repl-window-allow-split) ; Defined in geiser-repl.el
(declare-function run-geiser "ext:geiser-repl" (impl))
(declare-function geiser-mode "ext:geiser-mode" ())
(declare-function geiser-eval-region "ext:geiser-mode"
(start end &optional and-go raw nomsg))
(declare-function geiser-repl-exit "ext:geiser-repl" (&optional arg))
+(declare-function geiser-eval--retort-output "ext:geiser-eval" (ret))
+(declare-function geiser-eval--retort-result-str "ext:geiser-eval" (ret prefix))
+
+(defcustom org-babel-scheme-null-to 'hline
+ "Replace `null' and empty lists in scheme tables with this before returning."
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :type 'symbol)
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
- (if (> (length vars) 0)
- (concat "(let ("
- (mapconcat
- (lambda (var) (format "%S" (print `(,(car var) ',(cdr var)))))
- vars "\n ")
- ")\n" body ")")
- body)))
-
-
-(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+ (let ((vars (org-babel--get-vars params))
+ (prepends (cdr (assq :prologue params))))
+ (concat (and prepends (concat prepends "\n"))
+ (if (null vars) body
+ (format "(let (%s)\n%s\n)"
+ (mapconcat
+ (lambda (var)
+ (format "%S" (print `(,(car var) ',(cdr var)))))
+ vars
+ "\n ")
+ body)))))
+
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test #'equal)
"Map of scheme sessions to session names.")
(defun org-babel-scheme-cleanse-repl-map ()
"Remove dead buffers from the REPL map."
(maphash
- (lambda (x y)
- (when (not (buffer-name y))
- (remhash x org-babel-scheme-repl-map)))
+ (lambda (x y) (unless (buffer-name y) (remhash x org-babel-scheme-repl-map)))
org-babel-scheme-repl-map))
(defun org-babel-scheme-get-session-buffer (session-name)
@@ -112,12 +126,25 @@ If the session is unnamed (nil), generate a name.
If the session is `none', use nil for the session name, and
org-babel-scheme-execute-with-geiser will use a temporary session."
- (let ((result
- (cond ((not name)
- (concat buffer " " (symbol-name impl) " REPL"))
- ((string= name "none") nil)
- (name))))
- result))
+ (cond ((not name) (concat buffer " " (symbol-name impl) " REPL"))
+ ((string= name "none") nil)
+ (name)))
+
+(defmacro org-babel-scheme-capture-current-message (&rest body)
+ "Capture current message in both interactive and noninteractive mode"
+ `(if noninteractive
+ (let ((original-message (symbol-function 'message))
+ (current-message nil))
+ (unwind-protect
+ (progn
+ (defun message (&rest args)
+ (setq current-message (apply original-message args)))
+ ,@body
+ current-message)
+ (fset 'message original-message)))
+ (progn
+ ,@body
+ (current-message))))
(defun org-babel-scheme-execute-with-geiser (code output impl repl)
"Execute code in specified REPL. If the REPL doesn't exist, create it
@@ -129,36 +156,46 @@ is true; otherwise returns the last value."
(with-temp-buffer
(insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
(newline)
- (insert (if output
- (format "(with-output-to-string (lambda () %s))" code)
- code))
+ (insert code)
(geiser-mode)
- (let ((repl-buffer (save-current-buffer
- (org-babel-scheme-get-repl impl repl))))
- (when (not (eq impl (org-babel-scheme-get-buffer-impl
- (current-buffer))))
- (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
- (org-babel-scheme-get-buffer-impl (current-buffer))
- (symbolp (org-babel-scheme-get-buffer-impl
- (current-buffer)))))
- (setq geiser-repl--repl repl-buffer)
- (setq geiser-impl--implementation nil)
- (geiser-eval-region (point-min) (point-max))
- (setq result
- (if (equal (substring (current-message) 0 3) "=> ")
- (replace-regexp-in-string "^=> " "" (current-message))
- "\"An error occurred.\""))
- (when (not repl)
- (save-current-buffer (set-buffer repl-buffer)
- (geiser-repl-exit))
- (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
- (kill-buffer repl-buffer))
- (setq result (if (or (string= result "#<void>")
- (string= result "#<unspecified>"))
- nil
- (read result)))))
+ (let ((geiser-repl-window-allow-split nil)
+ (geiser-repl-use-other-window nil))
+ (let ((repl-buffer (save-current-buffer
+ (org-babel-scheme-get-repl impl repl))))
+ (when (not (eq impl (org-babel-scheme-get-buffer-impl
+ (current-buffer))))
+ (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+ (org-babel-scheme-get-buffer-impl (current-buffer))
+ (symbolp (org-babel-scheme-get-buffer-impl
+ (current-buffer)))))
+ (setq geiser-repl--repl repl-buffer)
+ (setq geiser-impl--implementation nil)
+ (let ((geiser-debug-jump-to-debug-p nil)
+ (geiser-debug-show-debug-p nil))
+ (let ((ret (geiser-eval-region (point-min) (point-max))))
+ (setq result (if output
+ (geiser-eval--retort-output ret)
+ (geiser-eval--retort-result-str ret "")))))
+ (when (not repl)
+ (save-current-buffer (set-buffer repl-buffer)
+ (geiser-repl-exit))
+ (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+ (kill-buffer repl-buffer)))))
result))
+(defun org-babel-scheme--table-or-string (results)
+ "Convert RESULTS into an appropriate elisp value.
+If the results look like a list or tuple, then convert them into an
+Emacs-lisp table, otherwise return the results as a string."
+ (let ((res (org-babel-script-escape results)))
+ (cond ((listp res)
+ (mapcar (lambda (el)
+ (if (or (null el) (eq el 'null))
+ org-babel-scheme-null-to
+ el))
+ res))
+ (t res))))
+
(defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'"
@@ -167,24 +204,28 @@ This function is called by `org-babel-execute-src-block'"
"^ ?\\*\\([^*]+\\)\\*" "\\1"
(buffer-name source-buffer))))
(save-excursion
- (org-babel-reassemble-table
- (let* ((result-type (cdr (assoc :result-type params)))
- (impl (or (when (cdr (assoc :scheme params))
- (intern (cdr (assoc :scheme params))))
- geiser-default-implementation
- (car geiser-active-implementations)))
- (session (org-babel-scheme-make-session-name
- source-buffer-name (cdr (assoc :session params)) impl))
- (full-body (org-babel-expand-body:scheme body params)))
- (org-babel-scheme-execute-with-geiser
- full-body ; code
- (string= result-type "output") ; output?
- impl ; implementation
- (and (not (string= session "none")) session))) ; session
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params)))))))
+ (let* ((result-type (cdr (assq :result-type params)))
+ (impl (or (when (cdr (assq :scheme params))
+ (intern (cdr (assq :scheme params))))
+ geiser-default-implementation
+ (car geiser-active-implementations)))
+ (session (org-babel-scheme-make-session-name
+ source-buffer-name (cdr (assq :session params)) impl))
+ (full-body (org-babel-expand-body:scheme body params))
+ (result
+ (org-babel-scheme-execute-with-geiser
+ full-body ; code
+ (string= result-type "output") ; output?
+ impl ; implementation
+ (and (not (string= session "none")) session)))) ; session
+ (let ((table
+ (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))))))
+ (org-babel-scheme--table-or-string table))))))
(provide 'ob-scheme)
diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el
index a15f7f7bd86..fbf167e0e41 100644
--- a/lisp/org/ob-screen.el
+++ b/lisp/org/ob-screen.el
@@ -1,4 +1,4 @@
-;;; ob-screen.el --- org-babel support for interactive terminal
+;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -48,18 +48,17 @@ In case you want to use a different screen than one selected by your $PATH")
\"default\" session is used when none is specified."
(message "Sending source code block to interactive terminal session...")
(save-window-excursion
- (let* ((session (cdr (assoc :session params)))
+ (let* ((session (cdr (assq :session params)))
(socket (org-babel-screen-session-socketname session)))
(unless socket (org-babel-prep-session:screen session params))
(org-babel-screen-session-execute-string
session (org-babel-expand-body:generic body params)))))
-(defun org-babel-prep-session:screen (session params)
+(defun org-babel-prep-session:screen (_session params)
"Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (cdr (assoc :session params)))
- (socket (org-babel-screen-session-socketname session))
- (cmd (cdr (assoc :cmd params)))
- (terminal (cdr (assoc :terminal params)))
+ (let* ((session (cdr (assq :session params)))
+ (cmd (cdr (assq :cmd params)))
+ (terminal (cdr (assq :terminal 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
@@ -104,7 +103,7 @@ In case you want to use a different screen than one selected by your $PATH")
sockets)))))
(when match-socket (car (split-string match-socket)))))
-(defun org-babel-screen-session-write-temp-file (session body)
+(defun org-babel-screen-session-write-temp-file (_session body)
"Save BODY in a temp file that is named after SESSION."
(let ((tmpfile (org-babel-temp-file "screen-")))
(with-temp-file tmpfile
@@ -119,11 +118,10 @@ In case you want to use a different screen than one selected by your $PATH")
"Test if the default setup works.
The terminal should shortly flicker."
(interactive)
- (let* ((session "org-babel-testing")
- (random-string (format "%s" (random 99999)))
+ (let* ((random-string (format "%s" (random 99999)))
(tmpfile (org-babel-temp-file "ob-screen-test-"))
(body (concat "echo '" random-string "' > " tmpfile "\nexit\n"))
- process tmp-string)
+ tmp-string)
(org-babel-execute:screen body org-babel-default-header-args:screen)
;; XXX: need to find a better way to do the following
(while (not (file-readable-p tmpfile))
diff --git a/lisp/org/ob-sed.el b/lisp/org/ob-sed.el
new file mode 100644
index 00000000000..7bd0bfb77c6
--- /dev/null
+++ b/lisp/org/ob-sed.el
@@ -0,0 +1,105 @@
+;;; ob-sed.el --- Babel Functions for Sed Scripts -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Bjarte Johansen
+;; Keywords: literate programming, reproducible research
+;; Version: 0.1.0
+
+;; 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:
+
+;; Provides a way to evaluate sed scripts in Org mode.
+
+;;; Usage:
+
+;; Add to your Emacs config:
+
+;; (org-babel-do-load-languages
+;; 'org-babel-load-languages
+;; '((sed . t)))
+
+;; In addition to the normal header arguments, ob-sed also provides
+;; :cmd-line and :in-file. :cmd-line allows one to pass other flags to
+;; the sed command like the "--in-place" flag which makes sed edit the
+;; file pass to it instead of outputting to standard out or to a
+;; different file. :in-file is a header arguments that allows one to
+;; tell Org Babel which file the sed script to act on.
+
+;;; Code:
+(require 'ob)
+
+(defvar org-babel-sed-command "sed"
+ "Name of the sed executable command.")
+
+(defvar org-babel-tangle-lang-exts)
+(add-to-list 'org-babel-tangle-lang-exts '("sed" . "sed"))
+
+(defconst org-babel-header-args:sed
+ '((:cmd-line . :any)
+ (:in-file . :any))
+ "Sed specific header arguments.")
+
+(defvar org-babel-default-header-args:sed '()
+ "Default arguments for evaluating a sed source block.")
+
+(defun org-babel-execute:sed (body params)
+ "Execute a block of sed code with Org Babel.
+BODY is the source inside a sed source block and PARAMS is an
+association list over the source block configurations. This
+function is called by `org-babel-execute-src-block'."
+ (message "executing sed source code block")
+ (let* ((result-params (cdr (assq :result-params params)))
+ (cmd-line (cdr (assq :cmd-line params)))
+ (in-file (cdr (assq :in-file params)))
+ (code-file (let ((file (org-babel-temp-file "sed-")))
+ (with-temp-file file
+ (insert body)) file))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
+ (when stdin
+ (let ((tmp (org-babel-temp-file "sed-stdin-"))
+ (res (org-babel-ref-resolve stdin)))
+ (with-temp-file tmp
+ (insert res))
+ tmp))))
+ (cmd (mapconcat #'identity
+ (remq nil
+ (list org-babel-sed-command
+ (format "--file=\"%s\"" code-file)
+ cmd-line
+ in-file))
+ " ")))
+ (org-babel-reassemble-table
+ (let ((results
+ (cond
+ (stdin (with-temp-buffer
+ (call-process-shell-command cmd stdin (current-buffer))
+ (buffer-string)))
+ (t (org-babel-eval cmd "")))))
+ (when results
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp (org-babel-temp-file "sed-results-")))
+ (with-temp-file tmp (insert results))
+ (org-babel-import-elisp-from-file tmp)))))
+ (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))))))
+
+(provide 'ob-sed)
+;;; ob-sed.el ends here
diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el
deleted file mode 100644
index 47dbab3f6d9..00000000000
--- a/lisp/org/ob-sh.el
+++ /dev/null
@@ -1,217 +0,0 @@
-;;; ob-sh.el --- org-babel functions for shell evaluation
-
-;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
-
-;; Author: Eric Schulte
-;; Keywords: literate programming, reproducible research
-;; Homepage: http://orgmode.org
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Org-Babel support for evaluating shell source code.
-
-;;; Code:
-(require 'ob)
-(require 'shell)
-(eval-when-compile (require 'cl))
-
-(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
-(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
-(declare-function orgtbl-to-generic "org-table"
- (table params &optional backend))
-
-(defvar org-babel-default-header-args:sh '())
-
-(defvar org-babel-sh-command "sh"
- "Command used to invoke a shell.
-This will be passed to `shell-command-on-region'")
-
-(defcustom org-babel-sh-var-quote-fmt
- "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)"
- "Format string used to escape variables when passed to shell scripts."
- :group 'org-babel
- :type 'string)
-
-(defun org-babel-execute:sh (body params)
- "Execute a block of Shell commands with Babel.
-This function is called by `org-babel-execute-src-block'."
- (let* ((session (org-babel-sh-initiate-session
- (cdr (assoc :session params))))
- (stdin (let ((stdin (cdr (assoc :stdin params))))
- (when stdin (org-babel-sh-var-to-string
- (org-babel-ref-resolve stdin)))))
- (full-body (org-babel-expand-body:generic
- body params (org-babel-variable-assignments:sh params))))
- (org-babel-reassemble-table
- (org-babel-sh-evaluate session full-body params stdin)
- (org-babel-pick-name
- (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
- (org-babel-pick-name
- (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))
-
-(defun org-babel-prep-session:sh (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (org-babel-sh-initiate-session session))
- (var-lines (org-babel-variable-assignments:sh params)))
- (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))
- session))
-
-(defun org-babel-load-session:sh (session body params)
- "Load BODY into SESSION."
- (save-window-excursion
- (let ((buffer (org-babel-prep-session:sh session params)))
- (with-current-buffer buffer
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (insert (org-babel-chomp body)))
- buffer)))
-
-;; helper functions
-
-(defun org-babel-variable-assignments:sh (params)
- "Return list of shell statements assigning the block's variables."
- (let ((sep (cdr (assoc :separator params))))
- (mapcar
- (lambda (pair)
- (format "%s=%s"
- (car pair)
- (org-babel-sh-var-to-sh (cdr pair) sep)))
- (mapcar #'cdr (org-babel-get-header params :var)))))
-
-(defun org-babel-sh-var-to-sh (var &optional sep)
- "Convert an elisp value to a shell variable.
-Convert an elisp var into a string of shell commands specifying a
-var of the same value."
- (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep)))
-
-(defun org-babel-sh-var-to-string (var &optional sep)
- "Convert an elisp value to a string."
- (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
- (cond
- ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
- (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
- ((listp var)
- (mapconcat echo-var var "\n"))
- (t (funcall echo-var var)))))
-
-(defun org-babel-sh-table-or-results (results)
- "Convert RESULTS to an appropriate elisp value.
-If the results look like a table, then convert them into an
-Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
-
-(defun org-babel-sh-initiate-session (&optional session params)
- "Initiate a session named SESSION according to PARAMS."
- (when (and session (not (string= session "none")))
- (save-window-excursion
- (or (org-babel-comint-buffer-livep session)
- (progn
- (shell session)
- ;; Needed for Emacs 23 since the marker is initially
- ;; undefined and the filter functions try to use it without
- ;; checking.
- (set-marker comint-last-output-start (point))
- (get-buffer (current-buffer)))))))
-
-(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
- "String to indicate that evaluation has completed.")
-(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
- "String to indicate that evaluation has completed.")
-
-(defun org-babel-sh-evaluate (session body &optional params stdin)
- "Pass BODY to the Shell process in BUFFER.
-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 ((results
- (cond
- (stdin ; external shell script w/STDIN
- (let ((script-file (org-babel-temp-file "sh-script-"))
- (stdin-file (org-babel-temp-file "sh-stdin-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (string= "no" (cdr (assoc :padline params))))))
- (with-temp-file script-file
- (when shebang (insert (concat shebang "\n")))
- (when padline (insert "\n"))
- (insert body))
- (set-file-modes script-file #o755)
- (with-temp-file stdin-file (insert stdin))
- (with-temp-buffer
- (call-process-shell-command
- (if shebang
- script-file
- (format "%s %s" org-babel-sh-command script-file))
- stdin-file
- (current-buffer))
- (buffer-string))))
- (session ; session evaluation
- (mapconcat
- #'org-babel-sh-strip-weird-long-prompt
- (mapcar
- #'org-babel-trim
- (butlast
- (org-babel-comint-with-output
- (session org-babel-sh-eoe-output t body)
- (mapc
- (lambda (line)
- (insert line)
- (comint-send-input nil t)
- (while (save-excursion
- (goto-char comint-last-input-end)
- (not (re-search-forward
- comint-prompt-regexp nil t)))
- (accept-process-output
- (get-buffer-process (current-buffer)))))
- (append
- (split-string (org-babel-trim body) "\n")
- (list org-babel-sh-eoe-indicator))))
- 2)) "\n"))
- ('otherwise ; external shell script
- (if (and (cdr (assoc :shebang params))
- (> (length (cdr (assoc :shebang params))) 0))
- (let ((script-file (org-babel-temp-file "sh-script-"))
- (shebang (cdr (assoc :shebang params)))
- (padline (not (equal "no" (cdr (assoc :padline params))))))
- (with-temp-file script-file
- (when shebang (insert (concat shebang "\n")))
- (when padline (insert "\n"))
- (insert body))
- (set-file-modes script-file #o755)
- (org-babel-eval script-file ""))
- (org-babel-eval org-babel-sh-command (org-babel-trim body)))))))
- (when results
- (let ((result-params (cdr (assoc :result-params params))))
- (org-babel-result-cond result-params
- results
- (let ((tmp-file (org-babel-temp-file "sh-")))
- (with-temp-file tmp-file (insert results))
- (org-babel-import-elisp-from-file tmp-file)))))))
-
-(defun org-babel-sh-strip-weird-long-prompt (string)
- "Remove prompt cruft from a string of shell output."
- (while (string-match "^% +[\r\n$]+ *" string)
- (setq string (substring string (match-end 0))))
- string)
-
-(provide 'ob-sh)
-
-
-
-;;; ob-sh.el ends here
diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el
new file mode 100644
index 00000000000..af64adb8923
--- /dev/null
+++ b/lisp/org/ob-shell.el
@@ -0,0 +1,283 @@
+;;; ob-shell.el --- Babel Functions for Shell Evaluation -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
+
+;; Author: Eric Schulte
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating shell source code.
+
+;;; Code:
+(require 'ob)
+(require 'shell)
+(require 'cl-lib)
+
+(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)
+ t)
+(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer))
+(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer))
+(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)
+ t)
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function orgtbl-to-generic "org-table" (table params))
+
+(defvar org-babel-default-header-args:shell '())
+(defvar org-babel-shell-names)
+
+(defun org-babel-shell-initialize ()
+ "Define execution functions associated to shell names.
+This function has to be called whenever `org-babel-shell-names'
+is modified outside the Customize interface."
+ (interactive)
+ (dolist (name org-babel-shell-names)
+ (eval `(defun ,(intern (concat "org-babel-execute:" name))
+ (body params)
+ ,(format "Execute a block of %s commands with Babel." name)
+ (let ((shell-file-name ,name))
+ (org-babel-execute:shell body params))))
+ (eval `(defalias ',(intern (concat "org-babel-variable-assignments:" name))
+ 'org-babel-variable-assignments:shell
+ ,(format "Return list of %s statements assigning to the block's \
+variables."
+ name)))))
+
+(defcustom org-babel-shell-names
+ '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh")
+ "List of names of shell supported by babel shell code blocks.
+Call `org-babel-shell-initialize' when modifying this variable
+outside the Customize interface."
+ :group 'org-babel
+ :type '(repeat (string :tag "Shell name: "))
+ :set (lambda (symbol value)
+ (set-default symbol value)
+ (org-babel-shell-initialize)))
+
+(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'."
+ (let* ((session (org-babel-sh-initiate-session
+ (cdr (assq :session params))))
+ (stdin (let ((stdin (cdr (assq :stdin params))))
+ (when stdin (org-babel-sh-var-to-string
+ (org-babel-ref-resolve stdin)))))
+ (cmdline (cdr (assq :cmdline params)))
+ (full-body (org-babel-expand-body:generic
+ body params (org-babel-variable-assignments:shell params))))
+ (org-babel-reassemble-table
+ (org-babel-sh-evaluate session full-body params stdin cmdline)
+ (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-prep-session:shell (session params)
+ "Prepare SESSION according to the header arguments specified in PARAMS."
+ (let* ((session (org-babel-sh-initiate-session session))
+ (var-lines (org-babel-variable-assignments:shell params)))
+ (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))
+ session))
+
+(defun org-babel-load-session:shell (session body params)
+ "Load BODY into SESSION."
+ (save-window-excursion
+ (let ((buffer (org-babel-prep-session:shell session params)))
+ (with-current-buffer buffer
+ (goto-char (process-mark (get-buffer-process (current-buffer))))
+ (insert (org-babel-chomp body)))
+ buffer)))
+
+
+;;; Helper functions
+(defun org-babel--variable-assignments:sh-generic
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as a generic variable."
+ (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline)))
+
+(defun org-babel--variable-assignments:bash_array
+ (varname values &optional sep hline)
+ "Returns a list of statements declaring the values as a bash array."
+ (format "unset %s\ndeclare -a %s=( %s )"
+ varname varname
+ (mapconcat
+ (lambda (value) (org-babel-sh-var-to-sh value sep hline))
+ values
+ " ")))
+
+(defun org-babel--variable-assignments:bash_assoc
+ (varname values &optional sep hline)
+ "Returns 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")))
+
+(defun org-babel--variable-assignments:bash (varname values &optional sep hline)
+ "Represents the parameters as useful Bash shell variables."
+ (pcase values
+ (`((,_ ,_ . ,_) . ,_) ;two-dimensional array
+ (org-babel--variable-assignments:bash_assoc varname values sep hline))
+ (`(,_ . ,_) ;simple list
+ (org-babel--variable-assignments:bash_array varname values sep hline))
+ (_ ;scalar value
+ (org-babel--variable-assignments:sh-generic varname values sep hline))))
+
+(defun org-babel-variable-assignments:shell (params)
+ "Return list of shell statements assigning the block's variables."
+ (let ((sep (cdr (assq :separator params)))
+ (hline (when (string= "yes" (cdr (assq :hlines params)))
+ (or (cdr (assq :hline-string params))
+ "hline"))))
+ (mapcar
+ (lambda (pair)
+ (if (string-suffix-p "bash" shell-file-name)
+ (org-babel--variable-assignments:bash
+ (car pair) (cdr pair) sep hline)
+ (org-babel--variable-assignments:sh-generic
+ (car pair) (cdr pair) sep hline)))
+ (org-babel--get-vars params))))
+
+(defun org-babel-sh-var-to-sh (var &optional sep hline)
+ "Convert an elisp value to a shell variable.
+Convert an elisp var into a string of shell commands specifying a
+var of the same value."
+ (concat "'" (replace-regexp-in-string
+ "'" "'\"'\"'"
+ (org-babel-sh-var-to-string var sep hline))
+ "'"))
+
+(defun org-babel-sh-var-to-string (var &optional sep hline)
+ "Convert an elisp value to a string."
+ (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
+ (cond
+ ((and (listp var) (or (listp (car var)) (eq (car var) 'hline)))
+ (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var
+ :hline hline)))
+ ((listp var)
+ (mapconcat echo-var var "\n"))
+ (t (funcall echo-var var)))))
+
+(defun org-babel-sh-initiate-session (&optional session _params)
+ "Initiate a session named SESSION according to PARAMS."
+ (when (and session (not (string= session "none")))
+ (save-window-excursion
+ (or (org-babel-comint-buffer-livep session)
+ (progn
+ (shell session)
+ ;; Needed for Emacs 23 since the marker is initially
+ ;; undefined and the filter functions try to use it without
+ ;; checking.
+ (set-marker comint-last-output-start (point))
+ (get-buffer (current-buffer)))))))
+
+(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'"
+ "String to indicate that evaluation has completed.")
+(defvar org-babel-sh-eoe-output "org_babel_sh_eoe"
+ "String to indicate that evaluation has completed.")
+
+(defun org-babel-sh-evaluate (session body &optional params stdin cmdline)
+ "Pass BODY to the Shell process in BUFFER.
+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 ((results
+ (cond
+ ((or stdin cmdline) ; external shell script w/STDIN
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (stdin-file (org-babel-temp-file "sh-stdin-"))
+ (shebang (cdr (assq :shebang params)))
+ (padline (not (string= "no" (cdr (assq :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (with-temp-file stdin-file (insert (or stdin "")))
+ (with-temp-buffer
+ (call-process-shell-command
+ (concat (if shebang script-file
+ (format "%s %s" shell-file-name script-file))
+ (and cmdline (concat " " cmdline)))
+ stdin-file
+ (current-buffer))
+ (buffer-string))))
+ (session ; session evaluation
+ (mapconcat
+ #'org-babel-sh-strip-weird-long-prompt
+ (mapcar
+ #'org-trim
+ (butlast
+ (org-babel-comint-with-output
+ (session org-babel-sh-eoe-output t body)
+ (mapc
+ (lambda (line)
+ (insert line)
+ (comint-send-input nil t)
+ (while (save-excursion
+ (goto-char comint-last-input-end)
+ (not (re-search-forward
+ comint-prompt-regexp nil t)))
+ (accept-process-output
+ (get-buffer-process (current-buffer)))))
+ (append
+ (split-string (org-trim body) "\n")
+ (list org-babel-sh-eoe-indicator))))
+ 2)) "\n"))
+ ('otherwise ; external shell script
+ (if (and (cdr (assq :shebang params))
+ (> (length (cdr (assq :shebang params))) 0))
+ (let ((script-file (org-babel-temp-file "sh-script-"))
+ (shebang (cdr (assq :shebang params)))
+ (padline (not (equal "no" (cdr (assq :padline params))))))
+ (with-temp-file script-file
+ (when shebang (insert (concat shebang "\n")))
+ (when padline (insert "\n"))
+ (insert body))
+ (set-file-modes script-file #o755)
+ (org-babel-eval script-file ""))
+ (org-babel-eval shell-file-name (org-trim body)))))))
+ (when results
+ (let ((result-params (cdr (assq :result-params params))))
+ (org-babel-result-cond result-params
+ results
+ (let ((tmp-file (org-babel-temp-file "sh-")))
+ (with-temp-file tmp-file (insert results))
+ (org-babel-import-elisp-from-file tmp-file)))))))
+
+(defun org-babel-sh-strip-weird-long-prompt (string)
+ "Remove prompt cruft from a string of shell output."
+ (while (string-match "^% +[\r\n$]+ *" string)
+ (setq string (substring string (match-end 0))))
+ string)
+
+(provide 'ob-shell)
+
+
+
+;;; ob-shell.el ends here
diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el
index d44a48a6382..6a4a3f18de1 100644
--- a/lisp/org/ob-shen.el
+++ b/lisp/org/ob-shen.el
@@ -1,4 +1,4 @@
-;;; ob-shen.el --- org-babel functions for Shen
+;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -43,7 +43,7 @@
(defun org-babel-expand-body:shen (body params)
"Expand BODY according to PARAMS, return the expanded body."
- (let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((vars (org-babel--get-vars params)))
(if (> (length vars) 0)
(concat "(let "
(mapconcat (lambda (var)
@@ -63,14 +63,13 @@
"Execute a block of Shen code with org-babel.
This function is called by `org-babel-execute-src-block'"
(require 'inf-shen)
- (let* ((result-type (cdr (assoc :result-type params)))
- (result-params (cdr (assoc :result-params params)))
+ (let* ((result-params (cdr (assq :result-params params)))
(full-body (org-babel-expand-body:shen body params)))
(let ((results
(with-temp-buffer
(insert full-body)
(call-interactively #'shen-eval-defun))))
- (org-babel-result-cond result-params
+ (org-babel-result-cond result-params
results
(condition-case nil (org-babel-script-escape results)
(error results))))))
diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el
index 17775829cba..1b1d2dc09d3 100644
--- a/lisp/org/ob-sql.el
+++ b/lisp/org/ob-sql.el
@@ -1,4 +1,4 @@
-;;; ob-sql.el --- org-babel functions for sql evaluation
+;;; ob-sql.el --- Babel Functions for SQL -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -36,31 +36,42 @@
;; - engine
;; - cmdline
;; - dbhost
+;; - dbport
;; - dbuser
;; - dbpassword
;; - database
;; - colnames (default, nil, means "yes")
;; - result-params
;; - out-file
+;;
;; The following are used but not really implemented for SQL:
;; - colname-names
;; - rownames
;; - rowname-names
;;
+;; Engines supported:
+;; - mysql
+;; - dbi
+;; - mssql
+;; - sqsh
+;; - postgresql
+;; - oracle
+;; - vertica
+;;
;; TODO:
;;
;; - support for sessions
-;; - support for more engines (currently only supports mysql)
+;; - support for more engines
;; - what's a reasonable way to drop table data into SQL?
;;
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
(declare-function org-table-import "org-table" (file arg))
(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))
(defvar org-babel-default-header-args:sql '())
@@ -68,6 +79,7 @@
'((engine . :any)
(out-file . :any)
(dbhost . :any)
+ (dbport . :any)
(dbuser . :any)
(dbpassword . :any)
(database . :any))
@@ -76,109 +88,217 @@
(defun org-babel-expand-body:sql (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sql-expand-vars
- body (mapcar #'cdr (org-babel-get-header params :var))))
+ body (org-babel--get-vars params)))
-(defun dbstring-mysql (host user password database)
+(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
- (remq nil
+ (delq nil
(list (when host (concat "-h" host))
+ (when port (format "-P%d" port))
(when user (concat "-u" user))
(when password (concat "-p" password))
(when database (concat "-D" database))))))
+(defun org-babel-sql-dbstring-postgresql (host port user database)
+ "Make PostgreSQL command line args for database connection.
+Pass nil to omit that arg."
+ (combine-and-quote-strings
+ (delq nil
+ (list (when host (concat "-h" host))
+ (when port (format "-p%d" port))
+ (when user (concat "-U" user))
+ (when database (concat "-d" database))))))
+
+(defun org-babel-sql-dbstring-oracle (host port user password database)
+ "Make Oracle command line args for database connection."
+ (format "%s/%s@%s:%s/%s" user password host port database))
+
+(defun org-babel-sql-dbstring-mssql (host user password database)
+ "Make sqlcmd command line args for database connection.
+`sqlcmd' is the preferred command line tool to access Microsoft
+SQL Server on Windows and Linux platform."
+ (mapconcat #'identity
+ (delq nil
+ (list (when host (format "-S \"%s\"" host))
+ (when user (format "-U \"%s\"" user))
+ (when password (format "-P \"%s\"" password))
+ (when database (format "-d \"%s\"" database))))
+ " "))
+
+(defun org-babel-sql-dbstring-sqsh (host user password database)
+ "Make sqsh command line args for database connection.
+\"sqsh\" is one method to access Sybase or MS SQL via Linux platform"
+ (mapconcat #'identity
+ (delq nil
+ (list (when host (format "-S \"%s\"" host))
+ (when user (format "-U \"%s\"" user))
+ (when password (format "-P \"%s\"" password))
+ (when database (format "-D \"%s\"" database))))
+ " "))
+
+(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."
+ (mapconcat #'identity
+ (delq nil
+ (list (when host (format "-h %s" host))
+ (when port (format "-p %d" port))
+ (when user (format "-U %s" user))
+ (when password (format "-w %s" (shell-quote-argument password) ))
+ (when database (format "-d %s" database))))
+ " "))
+
+(defun org-babel-sql-convert-standard-filename (file)
+ "Convert FILE to OS standard file name.
+If in Cygwin environment, uses Cygwin specific function to
+convert the file name. In a Windows-NT environment, do nothing.
+Otherwise, use Emacs' standard conversion function."
+ (cond ((fboundp 'cygwin-convert-file-name-to-windows)
+ (format "%S" (cygwin-convert-file-name-to-windows file)))
+ ((string= "windows-nt" system-type) file)
+ (t (format "%S" (convert-standard-filename file)))))
+
(defun org-babel-execute:sql (body params)
"Execute a block of Sql code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let* ((result-params (cdr (assoc :result-params params)))
- (cmdline (cdr (assoc :cmdline params)))
- (dbhost (cdr (assoc :dbhost params)))
- (dbuser (cdr (assoc :dbuser params)))
- (dbpassword (cdr (assoc :dbpassword params)))
- (database (cdr (assoc :database params)))
- (engine (cdr (assoc :engine params)))
- (colnames-p (not (equal "no" (cdr (assoc :colnames params)))))
+ (let* ((result-params (cdr (assq :result-params params)))
+ (cmdline (cdr (assq :cmdline params)))
+ (dbhost (cdr (assq :dbhost params)))
+ (dbport (cdr (assq :dbport params)))
+ (dbuser (cdr (assq :dbuser params)))
+ (dbpassword (cdr (assq :dbpassword params)))
+ (database (cdr (assq :database params)))
+ (engine (cdr (assq :engine params)))
+ (colnames-p (not (equal "no" (cdr (assq :colnames params)))))
(in-file (org-babel-temp-file "sql-in-"))
- (out-file (or (cdr (assoc :out-file params))
+ (out-file (or (cdr (assq :out-file params))
(org-babel-temp-file "sql-out-")))
(header-delim "")
- (command (case (intern engine)
- ('dbi (format "dbish --batch %s < %s | sed '%s' > %s"
+ (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)))
- ('msosql (format "osql %s -s \"\t\" -i %s -o %s"
- (or cmdline "")
- (org-babel-process-file-name in-file)
- (org-babel-process-file-name out-file)))
- ('mysql (format "mysql %s %s %s < %s > %s"
- (dbstring-mysql dbhost dbuser dbpassword database)
+ (`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 "")
+ (or cmdline "")
(org-babel-process-file-name in-file)
(org-babel-process-file-name out-file)))
- ('postgresql (format
- "psql -A -P footer=off -F \"\t\" -f %s -o %s %s"
+ (`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 "")))
- (t (error "No support for the %s SQL engine" engine)))))
+ (`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)))
+ (_ (error "No support for the %s SQL engine" engine)))))
(with-temp-file in-file
(insert
- (case (intern engine)
- ('dbi "/format partbox\n")
- (t ""))
- (org-babel-expand-body:sql body params)))
- (message command)
+ (pcase (intern engine)
+ (`dbi "/format partbox\n")
+ (`oracle "SET PAGESIZE 50000
+SET NEWPAGE 0
+SET TAB OFF
+SET SPACE 0
+SET LINESIZE 9999
+SET ECHO OFF
+SET FEEDBACK OFF
+SET VERIFY OFF
+SET HEADING ON
+SET MARKUP HTML OFF SPOOL OFF
+SET COLSEP '|'
+
+")
+ ((or `mssql `sqsh) "SET NOCOUNT ON
+
+")
+ (`vertica "\\a\n")
+ (_ ""))
+ (org-babel-expand-body:sql body params)
+ ;; "sqsh" requires "go" inserted at EOF.
+ (if (string= engine "sqsh") "\ngo" "")))
(org-babel-eval command "")
(org-babel-result-cond result-params
(with-temp-buffer
- (progn (insert-file-contents-literally out-file) (buffer-string)))
+ (progn (insert-file-contents-literally out-file) (buffer-string)))
(with-temp-buffer
(cond
- ((or (eq (intern engine) 'mysql)
- (eq (intern engine) 'dbi)
- (eq (intern engine) 'postgresql))
- ;; Add header row delimiter after column-names header in first line
- (cond
- (colnames-p
- (with-temp-buffer
- (insert-file-contents out-file)
- (goto-char (point-min))
- (forward-line 1)
- (insert "-\n")
- (setq header-delim "-")
- (write-file out-file)))))
- (t
- ;; Need to figure out the delimiter for the header row
- (with-temp-buffer
- (insert-file-contents out-file)
- (goto-char (point-min))
- (when (re-search-forward "^\\(-+\\)[^-]" nil t)
- (setq header-delim (match-string-no-properties 1)))
- (goto-char (point-max))
- (forward-char -1)
- (while (looking-at "\n")
- (delete-char 1)
- (goto-char (point-max))
- (forward-char -1))
- (write-file out-file))))
- (org-table-import out-file '(16))
+ ((memq (intern engine) '(dbi mysql postgresql sqsh vertica))
+ ;; Add header row delimiter after column-names header in first line
+ (cond
+ (colnames-p
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (forward-line 1)
+ (insert "-\n")
+ (setq header-delim "-")
+ (write-file out-file)))))
+ (t
+ ;; Need to figure out the delimiter for the header row
+ (with-temp-buffer
+ (insert-file-contents out-file)
+ (goto-char (point-min))
+ (when (re-search-forward "^\\(-+\\)[^-]" nil t)
+ (setq header-delim (match-string-no-properties 1)))
+ (goto-char (point-max))
+ (forward-char -1)
+ (while (looking-at "\n")
+ (delete-char 1)
+ (goto-char (point-max))
+ (forward-char -1))
+ (write-file out-file))))
+ (org-table-import out-file (if (string= engine "sqsh") '(4) '(16)))
(org-babel-reassemble-table
(mapcar (lambda (x)
(if (string= (car x) header-delim)
'hline
x))
(org-table-to-lisp))
- (org-babel-pick-name (cdr (assoc :colname-names params))
- (cdr (assoc :colnames params)))
- (org-babel-pick-name (cdr (assoc :rowname-names params))
- (cdr (assoc :rownames params))))))))
+ (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-sql-expand-vars (body vars)
"Expand the variables held in VARS in BODY."
@@ -201,7 +321,7 @@ This function is called by `org-babel-execute-src-block'."
vars)
body)
-(defun org-babel-prep-session:sql (session params)
+(defun org-babel-prep-session:sql (_session _params)
"Raise an error because Sql sessions aren't implemented."
(error "SQL sessions not yet implemented"))
diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el
index 4b165dc4762..38058274a9a 100644
--- a/lisp/org/ob-sqlite.el
+++ b/lisp/org/ob-sqlite.el
@@ -1,4 +1,4 @@
-;;; ob-sqlite.el --- org-babel functions for sqlite database interaction
+;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -53,23 +53,22 @@
(defun org-babel-expand-body:sqlite (body params)
"Expand BODY according to the values of PARAMS."
(org-babel-sqlite-expand-vars
- body (mapcar #'cdr (org-babel-get-header params :var))))
+ body (org-babel--get-vars params)))
(defvar org-babel-sqlite3-command "sqlite3")
(defun org-babel-execute:sqlite (body params)
"Execute a block of Sqlite code with Babel.
This function is called by `org-babel-execute-src-block'."
- (let ((result-params (split-string (or (cdr (assoc :results params)) "")))
- (db (cdr (assoc :db params)))
- (separator (cdr (assoc :separator params)))
- (nullvalue (cdr (assoc :nullvalue params)))
- (headers-p (equal "yes" (cdr (assoc :colnames params))))
+ (let ((result-params (split-string (or (cdr (assq :results params)) "")))
+ (db (cdr (assq :db params)))
+ (separator (cdr (assq :separator params)))
+ (nullvalue (cdr (assq :nullvalue params)))
+ (headers-p (equal "yes" (cdr (assq :colnames params))))
(others (delq nil (mapcar
- (lambda (arg) (car (assoc arg params)))
+ (lambda (arg) (car (assq arg params)))
(list :header :echo :bail :column
- :csv :html :line :list))))
- exit-code)
+ :csv :html :line :list)))))
(unless db (error "ob-sqlite: can't evaluate without a database"))
(with-temp-buffer
(insert
@@ -124,10 +123,7 @@ This function is called by `org-babel-execute-src-block'."
(if (listp val)
(let ((data-file (org-babel-temp-file "sqlite-data-")))
(with-temp-file data-file
- (insert (orgtbl-to-csv
- val '(:fmt (lambda (el) (if (stringp el)
- el
- (format "%S" el)))))))
+ (insert (orgtbl-to-csv val nil)))
data-file)
(if (stringp val) val (format "%S" val))))
body)))
@@ -140,7 +136,7 @@ This function is called by `org-babel-execute-src-block'."
(equal 1 (length (car result))))
(org-babel-read (caar result))
(mapcar (lambda (row)
- (if (equal 'hline row)
+ (if (eq 'hline row)
'hline
(mapcar #'org-babel-string-read row))) result)))
@@ -150,7 +146,7 @@ This function is called by `org-babel-execute-src-block'."
(cons (car table) (cons 'hline (cdr table)))
table))
-(defun org-babel-prep-session:sqlite (session params)
+(defun org-babel-prep-session:sqlite (_session _params)
"Raise an error because support for SQLite sessions isn't implemented.
Prepare SESSION according to the header arguments specified in PARAMS."
(error "SQLite sessions not yet implemented"))
diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el
new file mode 100644
index 00000000000..40fd8d9ccea
--- /dev/null
+++ b/lisp/org/ob-stan.el
@@ -0,0 +1,84 @@
+;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Kyle Meyer
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Org-Babel support for evaluating Stan [1] source code.
+;;
+;; Evaluating a Stan block can produce two different results.
+;;
+;; 1) Dump the source code contents to a file.
+;;
+;; This file can then be used as a variable in other blocks, which
+;; allows interfaces like RStan to use the model.
+;;
+;; 2) Compile the contents to a model file.
+;;
+;; This provides access to the CmdStan interface. To use this, set
+;; `org-babel-stan-cmdstan-directory' and provide a :file argument
+;; that does not end in ".stan".
+;;
+;; For more information and usage examples, visit
+;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html
+;;
+;; [1] http://mc-stan.org/
+
+;;; Code:
+(require 'ob)
+(require 'org-compat)
+
+(defcustom org-babel-stan-cmdstan-directory nil
+ "CmdStan source directory.
+'make' will be called from this directory to compile the Stan
+block. When nil, executing Stan blocks dumps the content to a
+plain text file."
+ :group 'org-babel
+ :type 'string)
+
+(defvar org-babel-default-header-args:stan
+ '((:results . "file")))
+
+(defun org-babel-execute:stan (body params)
+ "Generate Stan file from BODY according to PARAMS.
+A :file header argument must be given. If
+`org-babel-stan-cmdstan-directory' is non-nil and the file name
+does not have a \".stan\" extension, save an intermediate
+\".stan\" file and compile the block to the named file.
+Otherwise, write the Stan code directly to the named file."
+ (let ((file (expand-file-name
+ (or (cdr (assq :file params))
+ (user-error "Set :file argument to execute Stan blocks")))))
+ (if (or (not org-babel-stan-cmdstan-directory)
+ (string-match-p "\\.stan\\'" file))
+ (with-temp-file file (insert body))
+ (with-temp-file (concat file ".stan") (insert body))
+ (let ((default-directory org-babel-stan-cmdstan-directory))
+ (call-process-shell-command (concat "make " file))))
+ nil)) ; Signal that output has been written to file.
+
+(defun org-babel-prep-session:stan (_session _params)
+ "Return an error because Stan does not support sessions."
+ (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 1fa9105ee2b..3169f3d3bef 100644
--- a/lisp/org/ob-table.el
+++ b/lisp/org/ob-table.el
@@ -1,4 +1,4 @@
-;;; ob-table.el --- support for calling org-babel functions from tables
+;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,12 +19,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; Should allow calling functions from org-mode tables using the
-;; function `org-sbe' as so...
+;; Should allow calling functions from Org tables using the function
+;; `org-sbe' as so...
;; #+begin_src emacs-lisp :results silent
;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2)))))
@@ -47,38 +47,50 @@
;; | 7 | |
;; | 8 | |
;; | 9 | |
-;; #+TBLFM: $2='(org-sbe 'fibbd (n $1))
+;; #+TBLFM: $2='(org-sbe "fibbd" (n $1))
+
+;; NOTE: The quotation marks around the function name, 'fibbd' here,
+;; are optional.
;;; Code:
(require 'ob-core)
+(declare-function org-trim "org" (s &optional keep-lead))
+
(defun org-babel-table-truncate-at-newline (string)
"Replace newline character with ellipses.
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))
- (if (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.
-Each element of VARIABLES should be a two
-element list, whose first element is the name of the variable and
-second element is a string of its value. The following call to
-`org-sbe' would be equivalent to the following source code block.
- (org-sbe \\='source-block (n $2) (m 3))
+Each element of VARIABLES should be a list of two elements: the
+first element is the name of the variable and second element is a
+string of its value.
+
+So this `org-sbe' construct
+
+ (org-sbe \"source-block\" (n $2) (m 3))
+
+is the equivalent of the following source code block:
+
+ #+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
+ results
+ #+end_src
-#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent
-results
-#+end_src
+NOTE: The quotation marks around the function name,
+'source-block', are optional.
-NOTE: by default string variable names are interpreted as
+NOTE: By default, string variable names are interpreted as
references to source-code blocks, to force interpretation of a
cell's value as a string, prefix the identifier a \"$\" (e.g.,
\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\").
-NOTE: it is also possible to pass header arguments to the code
+NOTE: It is also possible to pass header arguments to the code
block. In this case a table cell should hold the string value of
the header argument which can then be passed before all variables
as shown in the example below.
@@ -132,7 +144,7 @@ as shown in the example below.
nil (list "emacs-lisp" "results" params)
'((:results . "silent"))))
"")))
- (org-babel-trim (if (stringp result) result (format "%S" result)))))))
+ (org-trim (if (stringp result) result (format "%S" result)))))))
(provide 'ob-table)
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index 437e0a296c1..09d011fc35e 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -1,4 +1,4 @@
-;;; ob-tangle.el --- extract source code from org-mode files
+;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,29 +19,41 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Extract the code from source blocks out into raw source-code files.
;;; Code:
+
+(require 'cl-lib)
(require 'org-src)
-(eval-when-compile
- (require 'cl))
+(require 'org-macs)
-(declare-function org-edit-special "org" (&optional arg))
-(declare-function org-link-escape "org" (text &optional table merge))
-(declare-function org-store-link "org" (arg))
-(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
-(declare-function org-heading-components "org" ())
+(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-at-heading-p "org" (&optional ignored))
+(declare-function org-babel-update-block-body "ob-core" (new-body))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-type "org-element" (element))
(declare-function org-fill-template "org" (template alist))
-(declare-function org-babel-update-block-body "ob-core" (new-body))
-(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-heading-components "org" ())
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-link-escape "org" (text &optional table merge))
+(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
+(declare-function org-remove-indentation "org" (code &optional n))
+(declare-function org-store-link "org" (arg))
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function outline-previous-heading "outline" ())
+(declare-function org-id-find "org-id" (id &optional markerp))
+
+(defvar org-link-types-re)
(defcustom org-babel-tangle-lang-exts
- '(("emacs-lisp" . "el"))
+ '(("emacs-lisp" . "el")
+ ("elisp" . "el"))
"Alist mapping languages to their file extensions.
The key is the language name, the value is the string that should
be inserted as the extension commonly used to identify files
@@ -54,6 +66,11 @@ then the name of the language is used."
(string "Language name")
(string "File Extension"))))
+(defcustom org-babel-tangle-use-relative-file-links t
+ "Use relative path names in links from tangled source back the Org file."
+ :group 'org-babel-tangle
+ :type 'boolean)
+
(defcustom org-babel-post-tangle-hook nil
"Hook run in code files tangled by `org-babel-tangle'."
:group 'org-babel
@@ -78,9 +95,14 @@ The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
-%link --------- Org-mode style link to the code block
+%link --------- Org style link to the code block
%source-name -- name of the code block
+Upon insertion the formatted comment will be commented out, and
+followed by a newline. To inhibit this post-insertion processing
+set the `org-babel-tangle-uncomment-comments' variable to a
+non-nil value.
+
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
@@ -93,20 +115,33 @@ The following format strings can be used to insert special
information into the output using `org-fill-template'.
%start-line --- the line number at the start of the code block
%file --------- the file from which the code block was tangled
-%link --------- Org-mode style link to the code block
+%link --------- Org style link to the code block
%source-name -- name of the code block
+Upon insertion the formatted comment will be commented out, and
+followed by a newline. To inhibit this post-insertion processing
+set the `org-babel-tangle-uncomment-comments' variable to a
+non-nil value.
+
Whether or not comments are inserted during tangling is
controlled by the :comments header argument."
:group 'org-babel
:version "24.1"
:type 'string)
-(defcustom org-babel-process-comment-text #'org-babel-trim
- "Function called to process raw Org-mode text collected to be
+(defcustom org-babel-tangle-uncomment-comments nil
+ "Inhibits automatic commenting and addition of trailing newline
+of tangle comments. Use `org-babel-tangle-comment-format-beg'
+and `org-babel-tangle-comment-format-end' to customize the format
+of tangled comments."
+ :group 'org-babel
+ :type 'boolean)
+
+(defcustom org-babel-process-comment-text 'org-remove-indentation
+ "Function called to process raw Org text collected to be
inserted as comments in tangled source-code files. The function
should take a single string argument and return a string
-result. The default value is `org-babel-trim'."
+result. The default value is `org-remove-indentation'."
:group 'org-babel
:version "24.1"
:type 'function)
@@ -153,12 +188,15 @@ Return a list whose CAR is the tangled file name."
(save-window-excursion
(find-file file)
(setq to-be-removed (current-buffer))
- (org-babel-tangle nil target-file lang))
+ (mapcar #'expand-file-name (org-babel-tangle nil target-file lang)))
(unless visited-p
(kill-buffer to-be-removed)))))
(defun org-babel-tangle-publish (_ filename pub-dir)
"Tangle FILENAME and place the results in PUB-DIR."
+ (unless (file-exists-p pub-dir)
+ (make-directory pub-dir t))
+ (setq pub-dir (file-name-as-directory pub-dir))
(mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename)))
;;;###autoload
@@ -176,12 +214,12 @@ used to limit the exported source code blocks by language."
(run-hooks 'org-babel-pre-tangle-hook)
;; Possibly Restrict the buffer to the current code block
(save-restriction
- (when (equal arg '(4))
- (let ((head (org-babel-where-is-src-block-head)))
+ (save-excursion
+ (when (equal arg '(4))
+ (let ((head (org-babel-where-is-src-block-head)))
(if head
(goto-char head)
(user-error "Point is not in a source code block"))))
- (save-excursion
(let ((block-counter 0)
(org-babel-default-header-args
(if target-file
@@ -190,7 +228,7 @@ used to limit the exported source code blocks by language."
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
- (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
+ (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
@@ -216,7 +254,7 @@ used to limit the exported source code blocks by language."
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
- (buffer-file-name)))
+ (nth 1 spec)))
((string= "no" tangle) nil)
((> (length tangle) 0) tangle)))
(file-name (when base-name
@@ -243,9 +281,13 @@ used to limit the exported source code blocks by language."
;; We avoid append-to-file as it does not work with tramp.
(let ((content (buffer-string)))
(with-temp-buffer
- (if (file-exists-p file-name)
- (insert-file-contents file-name))
+ (when (file-exists-p file-name)
+ (insert-file-contents file-name))
(goto-char (point-max))
+ ;; Handle :padlines unless first line in file
+ (unless (or (string= "no" (cdr (assq :padline (nth 4 spec))))
+ (= (point) (point-min)))
+ (insert "\n"))
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
@@ -253,10 +295,8 @@ used to limit the exported source code blocks by language."
(unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector
- (cons file-name tangle-mode)
- nil
- (lambda (a b) (equal (car a) (car b))))))))
+ (unless (assoc file-name path-collector)
+ (push (cons file-name tangle-mode) path-collector))))))
specs)))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
@@ -284,7 +324,7 @@ used to limit the exported source code blocks by language."
Call this function inside of a source-code file generated by
`org-babel-tangle' to remove all comments inserted automatically
by `org-babel-tangle'. Warning, this comment removes any lines
-containing constructs which resemble org-mode file links or noweb
+containing constructs which resemble Org file links or noweb
references."
(interactive)
(goto-char (point-min))
@@ -303,153 +343,134 @@ code file. This function uses `comment-region' which assumes
that the appropriate major-mode is set. SPEC has the form:
(start-line file link source-name params body comment)"
- (let* ((start-line (nth 0 spec))
- (file (nth 1 spec))
- (link (nth 2 spec))
- (source-name (nth 3 spec))
- (body (nth 5 spec))
- (comment (nth 6 spec))
- (comments (cdr (assoc :comments (nth 4 spec))))
- (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec))))))
- (link-p (or (string= comments "both") (string= comments "link")
- (string= comments "yes") (string= comments "noweb")))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- (let ((le (eval el)))
- (if (stringp le) le (format "%S" le)))))
- '(start-line file link source-name)))
- (insert-comment (lambda (text)
- (when (and comments (not (string= comments "no"))
- (> (length text) 0))
- (when padline (insert "\n"))
- (comment-region (point) (progn (insert text) (point)))
- (end-of-line nil) (insert "\n")))))
+ (pcase-let*
+ ((`(,start ,file ,link ,source ,info ,body ,comment) spec)
+ (comments (cdr (assq :comments info)))
+ (link? (or (string= comments "both") (string= comments "link")
+ (string= comments "yes") (string= comments "noweb")))
+ (link-data `(("start-line" . ,(number-to-string start))
+ ("file" . ,file)
+ ("link" . ,link)
+ ("source-name" . ,source)))
+ (insert-comment (lambda (text)
+ (when (and comments
+ (not (string= comments "no"))
+ (org-string-nw-p text))
+ (if org-babel-tangle-uncomment-comments
+ ;; Plain comments: no processing.
+ (insert text)
+ ;; Ensure comments are made to be
+ ;; comments, and add a trailing newline.
+ ;; Also ignore invisible characters when
+ ;; commenting.
+ (comment-region
+ (point)
+ (progn (insert (org-no-properties text))
+ (point)))
+ (end-of-line)
+ (insert "\n"))))))
(when comment (funcall insert-comment comment))
- (when link-p
- (funcall
- insert-comment
- (org-fill-template org-babel-tangle-comment-format-beg link-data)))
- (when padline (insert "\n"))
- (insert
- (format
- "%s\n"
- (org-unescape-code-in-string
- (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]")))))
- (when link-p
- (funcall
- insert-comment
- (org-fill-template org-babel-tangle-comment-format-end link-data)))))
-
-(defvar org-comment-string) ;; Defined in org.el
+ (when link?
+ (funcall insert-comment
+ (org-fill-template
+ org-babel-tangle-comment-format-beg link-data)))
+ (insert body "\n")
+ (when link?
+ (funcall insert-comment
+ (org-fill-template
+ org-babel-tangle-comment-format-end link-data)))))
+
(defun org-babel-tangle-collect-blocks (&optional language tangle-file)
- "Collect source blocks in the current Org-mode 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."
- (let ((block-counter 1) (current-heading "") blocks by-lang)
+ (let ((counter 0) last-heading-pos blocks)
(org-babel-map-src-blocks (buffer-file-name)
- (lambda (new-heading)
- (if (not (string= new-heading current-heading))
- (progn
- (setq block-counter 1)
- (setq current-heading new-heading))
- (setq block-counter (+ 1 block-counter))))
- (replace-regexp-in-string "[ \t]" "-"
- (condition-case nil
- (or (nth 4 (org-heading-components))
- "(dummy for heading without text)")
- (error (buffer-file-name))))
- (let* ((info (org-babel-get-src-block-info 'light))
- (src-lang (nth 0 info))
- (src-tfile (cdr (assoc :tangle (nth 2 info)))))
- (unless (or (string-match (concat "^" org-comment-string) current-heading)
- (string= (cdr (assoc :tangle (nth 2 info))) "no")
- (and tangle-file (not (equal tangle-file src-tfile))))
- (unless (and language (not (string= language src-lang)))
- ;; Add the spec for this block to blocks under it's language
- (setq by-lang (cdr (assoc src-lang blocks)))
- (setq blocks (delq (assoc src-lang blocks) blocks))
- (setq blocks (cons
- (cons src-lang
- (cons
- (org-babel-tangle-single-block
- block-counter)
- by-lang)) blocks))))))
- ;; Ensure blocks are in the correct order
- (setq blocks
- (mapcar
- (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang))))
- blocks))
- blocks))
-
-(defun org-babel-tangle-single-block
- (block-counter &optional only-this-block)
+ (let ((current-heading-pos
+ (org-with-wide-buffer
+ (org-with-limited-levels (outline-previous-heading)))))
+ (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)
+ (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))))
+ ;; Add the spec for this block to blocks under its
+ ;; language.
+ (let ((by-lang (assoc src-lang blocks))
+ (block (org-babel-tangle-single-block counter)))
+ (if by-lang (setcdr by-lang (cons block (cdr by-lang)))
+ (push (cons src-lang (list block)) blocks)))))))
+ ;; Ensure blocks are in the correct order.
+ (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks)))
+
+(defun org-babel-tangle-single-block (block-counter &optional only-this-block)
"Collect the tangled source for current block.
Return the list of block attributes needed by
-`org-babel-tangle-collect-blocks'.
-When ONLY-THIS-BLOCK is non-nil, return the full association
-list to be used by `org-babel-tangle' directly."
+`org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is
+non-nil, return the full association list to be used by
+`org-babel-tangle' directly."
(let* ((info (org-babel-get-src-block-info))
(start-line
(save-restriction (widen)
(+ 1 (line-number-at-pos (point)))))
- (file (buffer-file-name))
+ (file (buffer-file-name (buffer-base-buffer)))
(src-lang (nth 0 info))
(params (nth 2 info))
(extra (nth 3 info))
(cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra)
(match-string 1 extra))
org-coderef-label-format))
- (link (let ((link (org-no-properties
- (org-store-link nil))))
- (and (string-match org-bracket-link-regexp link)
- (match-string 1 link))))
+ (link (let ((l (org-no-properties (org-store-link nil))))
+ (and (string-match org-bracket-link-regexp l)
+ (match-string 1 l))))
(source-name
- (intern (or (nth 4 info)
- (format "%s:%d"
- (or (ignore-errors (nth 4 (org-heading-components)))
- "No heading")
- block-counter))))
- (expand-cmd
- (intern (concat "org-babel-expand-body:" src-lang)))
+ (or (nth 4 info)
+ (format "%s:%d"
+ (or (ignore-errors (nth 4 (org-heading-components)))
+ "No heading")
+ block-counter)))
+ (expand-cmd (intern (concat "org-babel-expand-body:" src-lang)))
(assignments-cmd
(intern (concat "org-babel-variable-assignments:" src-lang)))
(body
;; Run the tangle-body-hook.
- (let* ((body ;; Expand the body in language specific manner.
- (if (org-babel-noweb-p params :tangle)
- (org-babel-expand-noweb-references info)
- (nth 1 info)))
- (body
- (if (assoc :no-expand params)
- body
- (if (fboundp expand-cmd)
- (funcall expand-cmd body params)
- (org-babel-expand-body:generic
- body params
- (and (fboundp assignments-cmd)
- (funcall assignments-cmd params)))))))
- (with-temp-buffer
- (insert body)
- (when (string-match "-r" extra)
- (goto-char (point-min))
- (while (re-search-forward
- (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
- (replace-match "")))
- (run-hooks 'org-babel-tangle-body-hook)
- (buffer-string))))
+ (let ((body (if (org-babel-noweb-p params :tangle)
+ (org-babel-expand-noweb-references info)
+ (nth 1 info))))
+ (with-temp-buffer
+ (insert
+ ;; Expand body in language specific manner.
+ (cond ((assq :no-expand params) body)
+ ((fboundp expand-cmd) (funcall expand-cmd body params))
+ (t
+ (org-babel-expand-body:generic
+ body params (and (fboundp assignments-cmd)
+ (funcall assignments-cmd params))))))
+ (when (string-match "-r" extra)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (replace-regexp-in-string "%s" ".+" cref-fmt) nil t)
+ (replace-match "")))
+ (run-hooks 'org-babel-tangle-body-hook)
+ (buffer-string))))
(comment
- (when (or (string= "both" (cdr (assoc :comments params)))
- (string= "org" (cdr (assoc :comments params))))
+ (when (or (string= "both" (cdr (assq :comments params)))
+ (string= "org" (cdr (assq :comments params))))
;; From the previous heading or code-block end
(funcall
org-babel-process-comment-text
(buffer-substring
(max (condition-case nil
(save-excursion
- (org-back-to-heading t) ; Sets match data
+ (org-back-to-heading t) ; Sets match data
(match-end 0))
(error (point-min)))
(save-excursion
@@ -459,31 +480,47 @@ list to be used by `org-babel-tangle' directly."
(point-min))))
(point)))))
(result
- (list start-line file link source-name params body comment)))
+ (list start-line
+ (if org-babel-tangle-use-relative-file-links
+ (file-relative-name file)
+ file)
+ (if (and org-babel-tangle-use-relative-file-links
+ (string-match org-link-types-re link)
+ (string= (match-string 0 link) "file"))
+ (concat "file:"
+ (file-relative-name (match-string 1 link)
+ (file-name-directory
+ (cdr (assq :tangle params)))))
+ link)
+ source-name
+ params
+ (if org-src-preserve-indentation
+ (org-trim body t)
+ (org-trim (org-remove-indentation body)))
+ comment)))
(if only-this-block
(list (cons src-lang (list result)))
result)))
-(defun org-babel-tangle-comment-links ( &optional info)
+(defun org-babel-tangle-comment-links (&optional info)
"Return a list of begin and end link comments for the code block at point."
- (let* ((start-line (org-babel-where-is-src-block-head))
- (file (buffer-file-name))
- (link (org-link-escape (progn (call-interactively 'org-store-link)
- (org-no-properties
- (car (pop org-stored-links))))))
- (source-name (nth 4 (or info (org-babel-get-src-block-info 'light))))
- (link-data (mapcar (lambda (el)
- (cons (symbol-name el)
- (let ((le (eval el)))
- (if (stringp le) le (format "%S" le)))))
- '(start-line file link source-name))))
+ (let ((link-data
+ `(("start-line" . ,(number-to-string
+ (org-babel-where-is-src-block-head)))
+ ("file" . ,(buffer-file-name))
+ ("link" . ,(org-link-escape
+ (progn
+ (call-interactively #'org-store-link)
+ (org-no-properties (car (pop org-stored-links))))))
+ ("source-name" .
+ ,(nth 4 (or info (org-babel-get-src-block-info 'light)))))))
(list (org-fill-template org-babel-tangle-comment-format-beg link-data)
(org-fill-template org-babel-tangle-comment-format-end link-data))))
;; de-tangling functions
(defvar org-bracket-link-analytic-regexp)
(defun org-babel-detangle (&optional source-code-file)
- "Propagate changes in source file back original to Org-mode file.
+ "Propagate changes in source file back original to Org file.
This requires that code blocks were tangled with link comments
which enable the original code blocks to be found."
(interactive)
@@ -504,18 +541,17 @@ which enable the original code blocks to be found."
(prog1 counter (message "Detangled %d code blocks" counter)))))
(defun org-babel-tangle-jump-to-org ()
- "Jump from a tangled code file to the related Org-mode file."
+ "Jump from a tangled code file to the related Org mode file."
(interactive)
(let ((mid (point))
- start body-start end done
+ start body-start end
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(not ; ever wider searches until matching block comments
- (and (setq start (point-at-eol))
- (setq body-start (save-excursion
- (forward-line 2) (point-at-bol)))
+ (and (setq start (line-beginning-position))
+ (setq body-start (line-beginning-position 2))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
@@ -524,32 +560,37 @@ which enable the original code blocks to be found."
(re-search-forward
(concat " " (regexp-quote block-name)
" ends here") nil t)
- (setq end (point-at-bol))))))))
+ (setq end (line-beginning-position))))))))
(unless (and start (< start mid) (< mid end))
(error "Not in tangled code"))
- (setq body (org-babel-trim (buffer-substring start end))))
+ (setq body (buffer-substring body-start end)))
(when (string-match "::" path)
(setq path (substring path 0 (match-beginning 0))))
- (find-file path) (setq target-buffer (current-buffer))
- (goto-char start) (org-open-link-from-string link)
+ (find-file (or (car (org-id-find path)) path))
+ (setq target-buffer (current-buffer))
+ ;; Go to the beginning of the relative block in Org file.
+ (org-open-link-from-string link)
(if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
- (org-babel-next-src-block
- (string-to-number (match-string 1 block-name)))
+ (let ((n (string-to-number (match-string 1 block-name))))
+ (if (org-before-first-heading-p) (goto-char (point-min))
+ (org-back-to-heading t))
+ ;; Do not skip the first block if it begins at point min.
+ (cond ((or (org-at-heading-p)
+ (not (eq (org-element-type (org-element-at-point))
+ 'src-block)))
+ (org-babel-next-src-block n))
+ ((= n 1))
+ (t (org-babel-next-src-block (1- n)))))
(org-babel-goto-named-src-block block-name))
- ;; position at the beginning of the code block body
(goto-char (org-babel-where-is-src-block-head))
+ ;; Preserve location of point within the source code in tangled
+ ;; code file.
(forward-line 1)
- ;; Use org-edit-special to isolate the code.
- (org-edit-special)
- ;; Then move forward the correct number of characters in the
- ;; code buffer.
(forward-char (- mid body-start))
- ;; And return to the Org-mode buffer with the point in the right
- ;; place.
- (org-edit-src-exit)
(setq target-char (point)))
(org-src-switch-to-buffer target-buffer t)
- (prog1 body (goto-char target-char))))
+ (goto-char target-char)
+ body))
(provide 'ob-tangle)
diff --git a/lisp/org/ob-vala.el b/lisp/org/ob-vala.el
new file mode 100644
index 00000000000..580e27246d3
--- /dev/null
+++ b/lisp/org/ob-vala.el
@@ -0,0 +1,117 @@
+;;; ob-vala.el --- Babel functions for Vala evaluation -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Christian Garbs <mitch@cgarbs.de>
+;; Keywords: literate programming, reproducible research
+;; Homepage: http://orgmode.org
+
+;;; License:
+
+;; 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:
+
+;; ob-vala.el provides Babel support for the Vala language
+;; (see http://live.gnome.org/Vala for details)
+
+;;; Requirements:
+
+;; - Vala compiler binary (valac)
+;; - Vala development environment (Vala libraries etc.)
+;;
+;; vala-mode.el is nice to have for code formatting, but is not needed
+;; for ob-vala.el
+
+;;; Code:
+
+(require 'ob)
+
+(declare-function org-trim "org" (s &optional keep-lead))
+
+;; File extension.
+(add-to-list 'org-babel-tangle-lang-exts '("vala" . "vala"))
+
+;; Header arguments empty by default.
+(defvar org-babel-default-header-args:vala '())
+
+(defcustom org-babel-vala-compiler "valac"
+ "Command used to compile a C source code file into an executable.
+May be either a command in the path, like \"valac\"
+or an absolute path name, like \"/usr/local/bin/valac\".
+Parameters may be used like this: \"valac -v\""
+ :group 'org-babel
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :type 'string)
+
+;; This is the main function which is called to evaluate a code
+;; block.
+;;
+;; - run Vala compiler and create a binary in a temporary file
+;; - compiler/linker flags can be set via :flags header argument
+;; - if compilation succeeded, run the binary
+;; - commandline parameters to the binary can be set via :cmdline
+;; header argument
+;; - stdout will be parsed as RESULT (control via :result-params
+;; header argument)
+;;
+;; There is no session support because Vala is a compiled language.
+;;
+;; This function is heavily based on ob-C.el
+(defun org-babel-execute:vala (body params)
+ "Execute a block of Vala code with Babel.
+This function is called by `org-babel-execute-src-block'."
+ (message "executing Vala source code block")
+ (let* ((tmp-src-file (org-babel-temp-file
+ "vala-src-"
+ ".vala"))
+ (tmp-bin-file (org-babel-temp-file "vala-bin-" org-babel-exeext))
+ (cmdline (cdr (assq :cmdline params)))
+ (flags (cdr (assq :flags params))))
+ (with-temp-file tmp-src-file (insert body))
+ (org-babel-eval
+ (format "%s %s -o %s %s"
+ org-babel-vala-compiler
+ (mapconcat #'identity
+ (if (listp flags) flags (list flags)) " ")
+ (org-babel-process-file-name tmp-bin-file)
+ (org-babel-process-file-name tmp-src-file)) "")
+ (when (file-executable-p tmp-bin-file)
+ (let ((results
+ (org-trim
+ (org-babel-eval
+ (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))
+ (org-babel-reassemble-table
+ (org-babel-result-cond (cdr (assq :result-params params))
+ (org-babel-read results)
+ (let ((tmp-file (org-babel-temp-file "vala-")))
+ (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-prep-session:vala (_session _params)
+ "Prepare a session.
+This function does nothing as Vala is a compiled language with no
+support for sessions."
+ (error "Vala is a compiled language -- no support for sessions"))
+
+(provide 'ob-vala)
+
+;;; ob-vala.el ends here
diff --git a/lisp/org/ob.el b/lisp/org/ob.el
index b0c3d521c54..c5ce0c03667 100644
--- a/lisp/org/ob.el
+++ b/lisp/org/ob.el
@@ -1,4 +1,4 @@
-;;; ob.el --- working with code blocks in org-mode
+;;; ob.el --- Working with Code Blocks in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'org-macs)
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 409c93abedc..ad811ce3193 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -19,12 +19,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the code for creating and using the Agenda for Org-mode.
+;; This file contains the code for creating and using the Agenda for Org.
;;
;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
;; `org-batch-store-agenda-views' are implemented as macros to provide
@@ -45,10 +45,9 @@
;;; Code:
+(require 'cl-lib)
(require 'org)
(require 'org-macs)
-(eval-when-compile
- (require 'cl))
(declare-function diary-add-to-list "diary-lib"
(date string specifier &optional marker globcolor literal))
@@ -69,6 +68,7 @@
(declare-function calendar-persian-date-string "cal-persia" (&optional date))
(declare-function calendar-check-holidays "holidays" (date))
+(declare-function org-columns-remove-overlays "org-colview" ())
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
(declare-function org-columns-quit "org-colview" ())
@@ -79,16 +79,15 @@
(declare-function org-is-habit-p "org-habit" (&optional pom))
(declare-function org-habit-parse-todo "org-habit" (&optional pom))
(declare-function org-habit-get-priority "org-habit" (habit &optional moment))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
(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))
-(defvar calendar-mode-map) ; defined in calendar.el
-(defvar org-clock-current-task nil) ; defined in org-clock.el
-(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
-(defvar org-habit-show-habits) ; defined in org-habit.el
+(defvar calendar-mode-map)
+(defvar org-clock-current-task)
+(defvar org-current-tag-alist)
+(defvar org-mobile-force-id-on-agenda-items)
+(defvar org-habit-show-habits)
(defvar org-habit-show-habits-only-for-today)
(defvar org-habit-show-all-today)
@@ -96,8 +95,8 @@
(defvar org-agenda-buffer-name "*Org Agenda*")
(defvar org-agenda-overriding-header nil)
(defvar org-agenda-title-append nil)
-(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
-(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
+(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
(defvar original-date) ; dynamically scoped, calendar.el does scope this
(defvar org-agenda-undo-list nil
@@ -135,7 +134,7 @@ addresses the separator between the current and the previous block."
(string)))
(defgroup org-agenda-export nil
- "Options concerning exporting agenda views in Org-mode."
+ "Options concerning exporting agenda views in Org mode."
:tag "Org Agenda Export"
:group 'org-agenda)
@@ -152,7 +151,7 @@ before assigned to the variables. So make sure to quote values you do
*not* want evaluated, for example
(setq org-agenda-exporter-settings
- '((ps-print-color-p 'black-white)))"
+ \\='((ps-print-color-p \\='black-white)))"
:group 'org-agenda-export
:type '(repeat
(list
@@ -237,7 +236,7 @@ you can \"misuse\" it to also add other text to the header."
:type 'boolean)
(defgroup org-agenda-custom-commands nil
- "Options concerning agenda views in Org-mode."
+ "Options concerning agenda views in Org mode."
:tag "Org Agenda Custom Commands"
:group 'org-agenda)
@@ -261,8 +260,8 @@ you can \"misuse\" it to also add other text to the header."
;; Keep custom values for `org-agenda-filter-preset' compatible with
;; the new variable `org-agenda-tag-filter-preset'.
-(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
-(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
+(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
+(defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
"List of types searched for when creating the daily/weekly agenda.
@@ -278,10 +277,7 @@ list are are
:deadline List deadline due on that date. When the date is today,
also list any deadlines past due, or due within
- `org-deadline-warning-days'. `:deadline' must appear before
- `:scheduled' if the setting of
- `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
- any effect.
+ `org-deadline-warning-days'.
:deadline* Same as above, but only include the deadline if it has an
hour specification as [h]h:mm.
@@ -328,12 +324,14 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
(string))
(list :tag "Number of days in agenda"
(const org-agenda-span)
- (choice (const :tag "Day" day)
- (const :tag "Week" week)
- (const :tag "Fortnight" fortnight)
- (const :tag "Month" month)
- (const :tag "Year" year)
- (integer :tag "Custom")))
+ (list
+ (const :format "" quote)
+ (choice (const :tag "Day" day)
+ (const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
+ (const :tag "Month" month)
+ (const :tag "Year" year)
+ (integer :tag "Custom"))))
(list :tag "Fixed starting date"
(const org-agenda-start-day)
(string :value "2007-11-01"))
@@ -360,6 +358,12 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
(const :format "" quote)
(repeat
(string :tag "+tag or -tag"))))
+ (list :tag "Effort filter preset"
+ (const org-agenda-effort-filter-preset)
+ (list
+ (const :format "" quote)
+ (repeat
+ (string :tag "+=10 or -=10 or +<10 or ->10"))))
(list :tag "Regexp filter preset"
(const org-agenda-regexp-filter-preset)
(list
@@ -435,8 +439,9 @@ This will be spliced into the custom type of
(defcustom org-agenda-custom-commands
'(("n" "Agenda and all TODOs" ((agenda "") (alltodo ""))))
"Custom commands for the agenda.
+\\<org-mode-map>
These commands will be offered on the splash screen displayed by the
-agenda dispatcher \\[org-agenda]. Each entry is a list like this:
+agenda dispatcher `\\[org-agenda]'. Each entry is a list like this:
(key desc type match settings files)
@@ -463,8 +468,8 @@ match What to search for:
settings A list of option settings, similar to that in a let form, so like
this: ((opt1 val1) (opt2 val2) ...). The values will be
evaluated at the moment of execution, so quote them when needed.
-files A list of files file to write the produced agenda buffer to
- with the command `org-store-agenda-views'.
+files A list of files to write the produced agenda buffer to with
+ the command `org-store-agenda-views'.
If a file name ends in \".html\", an HTML version of the buffer
is written out. If it ends in \".ps\", a postscript version is
produced. Otherwise, only the plain text is written to the file.
@@ -601,23 +606,17 @@ subtree to see if any of the subtasks have project status.
See also the variable `org-tags-match-list-sublevels' which applies
to projects matched by this search as well.
-After defining this variable, you may use \\[org-agenda-list-stuck-projects]
-or `C-c a #' to produce the list."
+After defining this variable, you may use `org-agenda-list-stuck-projects'
+\(bound to `\\[org-agenda] #') to produce the list."
:group 'org-agenda-custom-commands
:type '(list
(string :tag "Tags/TODO match to identify a project")
- (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
- (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
- (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree")))
-
-(defcustom org-agenda-filter-effort-default-operator "<"
- "The default operator for effort estimate filtering.
-If you select an effort estimate limit without first pressing an operator,
-this one will be used."
- :group 'org-agenda-custom-commands
- :type '(choice (const :tag "less or equal" "<")
- (const :tag "greater or equal"">")
- (const :tag "equal" "=")))
+ (repeat :tag "Projects are *not* stuck if they have an entry with \
+TODO keyword any of" (string))
+ (repeat :tag "Projects are *not* stuck if they have an entry with \
+TAG being any of" (string))
+ (regexp :tag "Projects are *not* stuck if this regexp matches inside \
+the subtree")))
(defgroup org-agenda-skip nil
"Options concerning skipping parts of agenda files."
@@ -769,10 +768,12 @@ to make his option also apply to the tags-todo list."
(defcustom org-agenda-todo-ignore-deadlines nil
"Non-nil means ignore some deadline TODO items when making TODO list.
+
There are different motivations for using different values, please think
carefully when configuring this variable.
-This applies when creating the global todo list.
+This applies when creating the global TODO list.
+
Valid values are:
near Don't show near deadline entries. A deadline is near when it is
@@ -780,8 +781,8 @@ near Don't show near deadline entries. A deadline is near when it is
is that such items will appear in the agenda anyway.
far Don't show TODO entries where a deadline has been defined, but
- the deadline is not near. This is useful if you don't want to
- use the todo list to figure out what to do now.
+ is not going to happen anytime soon. This is useful if you want to use
+ the TODO list to figure out what to do now.
past Don't show entries with a deadline timestamp for today or in the past.
@@ -842,10 +843,9 @@ restricted to unfinished TODO entries only."
(defcustom org-agenda-skip-scheduled-if-done nil
"Non-nil means don't show scheduled items in agenda when they are done.
-This is relevant for the daily/weekly agenda, not for the TODO list. And
-it applies only to the actual date of the scheduling. Warnings about
-an item with a past scheduling dates are always turned off when the item
-is DONE."
+This is relevant for the daily/weekly agenda, not for the TODO list. It
+applies only to the actual date of the scheduling. Warnings about an item
+with a past scheduling dates are always turned off when the item is DONE."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
:type 'boolean)
@@ -894,8 +894,8 @@ several times."
(defcustom org-agenda-skip-deadline-if-done nil
"Non-nil means don't show deadlines when the corresponding item is done.
When nil, the deadline is still shown and should give you a happy feeling.
-This is relevant for the daily/weekly agenda. And it applied only to the
-actually date of the deadline. Warnings about approaching and past-due
+This is relevant for the daily/weekly agenda. It applies only to the
+actual date of the deadline. Warnings about approaching and past-due
deadlines are always turned off when the item is DONE."
:group 'org-agenda-skip
:group 'org-agenda-daily/weekly
@@ -974,18 +974,6 @@ will only be dimmed."
(const :tag "Dim to a gray face" t)
(const :tag "Make invisible" invisible)))
-(defcustom org-timeline-show-empty-dates 3
- "Non-nil means `org-timeline' also shows dates without an entry.
-When nil, only the days which actually have entries are shown.
-When t, all days between the first and the last date are shown.
-When an integer, show also empty dates, but if there is a gap of more than
-N days, just insert a special line indicating the size of the gap."
- :group 'org-agenda-skip
- :type '(choice
- (const :tag "None" nil)
- (const :tag "All" t)
- (integer :tag "at most")))
-
(defgroup org-agenda-startup nil
"Options concerning initial settings in the Agenda in Org Mode."
:tag "Org Agenda Startup"
@@ -1001,8 +989,6 @@ you want to use two-columns display (see `org-agenda-menu-two-columns')."
:version "24.1"
:type 'boolean)
-(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3")
-
(defcustom org-agenda-menu-two-columns nil
"Non-nil means, use two columns to show custom commands in the dispatcher.
If you use this, you probably want to set `org-agenda-menu-show-matcher'
@@ -1011,7 +997,6 @@ to nil."
:version "24.1"
:type 'boolean)
-(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3")
(defcustom org-agenda-finalize-hook nil
"Hook run just before displaying an agenda buffer.
The buffer is still writable when the hook is called.
@@ -1024,8 +1009,8 @@ headlines as the agenda display heavily relies on them."
(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. Does not work on XEmacs.
-Needs to be set before org.el is loaded."
+A longer mouse click will still set point. Needs to be set
+before org.el is loaded."
:group 'org-agenda-startup
:type 'boolean)
@@ -1054,9 +1039,9 @@ current item's tree, in an indirect buffer."
(defcustom org-agenda-entry-text-maxlines 5
"Number of text lines to be added when `E' is pressed in the agenda.
-Note that this variable only used during agenda display. Add add entry text
+Note that this variable only used during agenda display. To add entry text
when exporting the agenda, configure the variable
-`org-agenda-add-entry-ext-maxlines'."
+`org-agenda-add-entry-text-maxlines'."
:group 'org-agenda
:type 'integer)
@@ -1083,7 +1068,7 @@ have been removed when this is called, as will any matches for regular
expressions listed in `org-agenda-entry-text-exclude-regexps'.")
(defvar org-agenda-include-inactive-timestamps nil
- "Non-nil means include inactive time stamps in agenda and timeline.
+ "Non-nil means include inactive time stamps in agenda.
Dynamically scoped.")
(defgroup org-agenda-windows nil
@@ -1097,6 +1082,7 @@ Possible values for this option are:
current-window Show agenda in the current window, keeping all other windows.
other-window Use `switch-to-buffer-other-window' to display agenda.
+only-window Show agenda, deleting all other windows.
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.
@@ -1107,6 +1093,7 @@ See also the variable `org-agenda-restore-windows-after-quit'."
(const current-window)
(const other-frame)
(const other-window)
+ (const only-window)
(const reorganize-frame)))
(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
@@ -1126,16 +1113,6 @@ option will be ignored."
:group 'org-agenda-windows
:type 'boolean)
-(defcustom org-agenda-ndays nil
- "Number of days to include in overview display.
-Should be 1 or 7.
-Obsolete, see `org-agenda-span'."
- :group 'org-agenda-daily/weekly
- :type '(choice (const nil)
- (integer)))
-
-(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
-
(defcustom org-agenda-span 'week
"Number of days to include in overview display.
Can be day, week, month, year, or any number of days.
@@ -1165,17 +1142,17 @@ When nil, only the days which actually have entries are shown."
(defcustom org-agenda-format-date 'org-agenda-format-date-aligned
"Format string for displaying dates in the agenda.
-Used by the daily/weekly agenda and by the timeline. This should be
-a format string understood by `format-time-string', or a function returning
-the formatted date as a string. The function must take a single argument,
-a calendar-style date list like (month day year)."
+Used by the daily/weekly agenda. This should be a format string
+understood by `format-time-string', or a function returning the
+formatted date as a string. The function must take a single
+argument, a calendar-style date list like (month day year)."
:group 'org-agenda-daily/weekly
:type '(choice
(string :tag "Format string")
(function :tag "Function")))
(defun org-agenda-format-date-aligned (date)
- "Format a DATE string for display in the daily/weekly agenda, or timeline.
+ "Format a DATE string for display in the daily/weekly agenda.
This function makes sure that dates are aligned for easy reading."
(require 'cal-iso)
(let* ((dayname (calendar-day-name date))
@@ -1211,7 +1188,7 @@ For example, 9:30am would become 09:30 rather than 9:30."
:type 'boolean)
(defun org-agenda-time-of-day-to-ampm (time)
- "Convert TIME of a string like `13:45' to an AM/PM style time string."
+ "Convert TIME of a string like \"13:45\" to an AM/PM style time string."
(let* ((hour-number (string-to-number (substring time 0 -3)))
(minute (substring time -2))
(ampm "am"))
@@ -1235,8 +1212,7 @@ For example, 9:30am would become 09:30 rather than 9:30."
(defcustom org-agenda-weekend-days '(6 0)
"Which days are weekend?
-These days get the special face `org-agenda-date-weekend' in the agenda
-and timeline buffers."
+These days get the special face `org-agenda-date-weekend' in the agenda."
:group 'org-agenda-daily/weekly
:type '(set :greedy t
(const :tag "Monday" 1)
@@ -1270,34 +1246,74 @@ Custom commands can set this variable in the options section."
:version "24.1"
:type 'boolean)
-(defcustom org-agenda-repeating-timestamp-show-all t
- "Non-nil means show all occurrences of a repeating stamp in the agenda.
-When set to a list of strings, only show occurrences of repeating
-stamps for these TODO keywords. When nil, only one occurrence is
-shown, either today or the nearest into the future."
+(defcustom org-agenda-show-future-repeats t
+ "Non-nil shows repeated entries in the future part of the agenda.
+When set to the symbol `next' only the first future repeat is shown."
+ :group 'org-agenda-daily/weekly
+ :type '(choice
+ (const :tag "Show all repeated entries" t)
+ (const :tag "Show next repeated entry" next)
+ (const :tag "Do not show repeated entries" nil))
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe #'symbolp)
+
+(defcustom org-agenda-prefer-last-repeat nil
+ "Non-nil sets date for repeated entries to their last repeat.
+
+When nil, display SCHEDULED and DEADLINE dates at their base
+date, and in today's agenda, as a reminder. Display plain
+time-stamps, on the other hand, at every repeat date in the past
+in addition to the base date.
+
+When non-nil, show a repeated entry at its latest repeat date,
+possibly being today even if it wasn't marked as done. This
+setting is useful if you do not always mark repeated entries as
+done and, yet, consider that reaching repeat date starts the task
+anew.
+
+When set to a list of strings, prefer last repeats only for
+entries with these TODO keywords."
:group 'org-agenda-daily/weekly
:type '(choice
- (const :tag "Show repeating stamps" t)
- (repeat :tag "Show repeating stamps for these TODO keywords"
- (string :tag "TODO Keyword"))
- (const :tag "Don't show repeating stamps" nil)))
+ (const :tag "Prefer last repeat" t)
+ (const :tag "Prefer base date" nil)
+ (repeat :tag "Prefer last repeat for entries with these TODO keywords"
+ (string :tag "TODO keyword")))
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe (lambda (x) (or (booleanp x) (consp x))))
(defcustom org-scheduled-past-days 10000
"Number of days to continue listing scheduled items not marked DONE.
-When an item is scheduled on a date, it shows up in the agenda on this
-day and will be listed until it is marked done for the number of days
-given here."
+When an item is scheduled on a date, it shows up in the agenda on
+this day and will be listed until it is marked done or for the
+number of days given here."
:group 'org-agenda-daily/weekly
- :type 'integer)
+ :type 'integer
+ :safe 'integerp)
+
+(defcustom org-deadline-past-days 10000
+ "Number of days to warn about missed deadlines.
+When an item has deadline on a date, it shows up in the agenda on
+this day and will appear as a reminder until it is marked DONE or
+for the number of days given here."
+ :group 'org-agenda-daily/weekly
+ :type 'integer
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe 'integerp)
(defcustom org-agenda-log-mode-items '(closed clock)
"List of items that should be shown in agenda log mode.
+\\<org-agenda-mode-map>\
This list may contain the following symbols:
closed Show entries that have been closed on that day.
clock Show entries that have received clocked time on that day.
state Show all logged state changes.
-Note that instead of changing this variable, you can also press `C-u l' in
+Note that instead of changing this variable, you can also press \
+`\\[universal-argument] \\[org-agenda-log-mode]' in
the agenda to display all available LOG items temporarily."
:group 'org-agenda-daily/weekly
:type '(set :greedy t (const closed) (const clock) (const state)))
@@ -1413,7 +1429,7 @@ boolean search."
:version "24.1"
:type 'boolean)
-(org-defvaralias 'org-agenda-search-view-search-words-only
+(defvaralias 'org-agenda-search-view-search-words-only
'org-agenda-search-view-always-boolean)
(defcustom org-agenda-search-view-force-full-words nil
@@ -1429,12 +1445,12 @@ E.g. when this is set to 1, the search view will only
show headlines of level 1. When set to 0, the default
value, don't limit agenda view by outline level."
:group 'org-agenda-search-view
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'integer)
(defgroup org-agenda-time-grid nil
- "Options concerning the time grid in the Org-mode Agenda."
+ "Options concerning the time grid in the Org Agenda."
:tag "Org Agenda Time Grid"
:group 'org-agenda)
@@ -1461,11 +1477,12 @@ the variable `org-agenda-time-grid'."
(defcustom org-agenda-time-grid
'((daily today require-timed)
- "----------------"
- (800 1000 1200 1400 1600 1800 2000))
+ (800 1000 1200 1400 1600 1800 2000)
+ "......"
+ "----------------")
"The settings for time grid for agenda display.
-This is a list of three items. The first item is again a list. It contains
+This is a list of four items. The first item is again a list. It contains
symbols specifying conditions when the grid should be displayed:
daily if the agenda shows a single day
@@ -1474,10 +1491,14 @@ symbols specifying conditions when the grid should be displayed:
require-timed show grid only if at least one item has a time specification
remove-match skip grid times already present in an entry
-The second item is a string which will be placed behind the grid time.
+The second item is a list of integers, indicating the times that
+should have a grid line.
-The third item is a list of integers, indicating the times that should have
-a grid line."
+The third item is a string which will be placed right after the
+times that have a grid line.
+
+The fourth item is a string placed after the grid times. This
+will align with agenda items"
:group 'org-agenda-time-grid
:type
'(list
@@ -1489,8 +1510,9 @@ a grid line."
require-timed)
(const :tag "Skip grid times already present in an entry"
remove-match))
- (string :tag "Grid String")
- (repeat :tag "Grid Times" (integer :tag "Time"))))
+ (repeat :tag "Grid Times" (integer :tag "Time"))
+ (string :tag "Grid String (after agenda times)")
+ (string :tag "Grid String (aligns with agenda items)")))
(defcustom org-agenda-show-current-time-in-grid t
"Non-nil means show the current time in the time grid."
@@ -1506,7 +1528,7 @@ a grid line."
:type 'string)
(defgroup org-agenda-sorting nil
- "Options concerning sorting in the Org-mode Agenda."
+ "Options concerning sorting in the Org Agenda."
:tag "Org Agenda Sorting"
:group 'org-agenda)
@@ -1612,19 +1634,18 @@ When nil, such items are sorted as 0 minutes effort."
:type 'boolean)
(defgroup org-agenda-line-format nil
- "Options concerning the entry prefix in the Org-mode agenda display."
+ "Options concerning the entry prefix in the Org agenda display."
:tag "Org Agenda Line Format"
:group 'org-agenda)
(defcustom org-agenda-prefix-format
'((agenda . " %i %-12:c%?-12t% s")
- (timeline . " % s")
(todo . " %i %-12:c")
(tags . " %i %-12:c")
(search . " %i %-12:c"))
"Format specifications for the prefix of items in the agenda views.
An alist with five entries, each for the different agenda types. The
-keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
+keys of the sublists are `agenda', `todo', `search' and `tags'.
The values are format strings.
This format works similar to a printf format, with the following meaning:
@@ -1677,11 +1698,12 @@ Custom commands can set this variable in the options section."
(string :tag "General format")
(list :greedy t :tag "View dependent"
(cons (const agenda) (string :tag "Format"))
- (cons (const timeline) (string :tag "Format"))
(cons (const todo) (string :tag "Format"))
(cons (const tags) (string :tag "Format"))
(cons (const search) (string :tag "Format"))))
- :group 'org-agenda-line-format)
+ :group 'org-agenda-line-format
+ :version "26.1"
+ :package-version '(Org . "9.1"))
(defvar org-prefix-format-compiled nil
"The compiled prefix format and associated variables.
@@ -1792,17 +1814,18 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour."
(defcustom org-agenda-show-inherited-tags t
"Non-nil means show inherited tags in each agenda line.
-When this option is set to 'always, it take precedences over
+When this option is set to `always', it takes precedence over
`org-agenda-use-tag-inheritance' and inherited tags are shown
in every agenda.
When this option is set to t (the default), inherited tags are
shown when they are available, i.e. when the value of
-`org-agenda-use-tag-inheritance' has been taken into account.
+`org-agenda-use-tag-inheritance' enables tag inheritance for the
+given agenda type.
This can be set to a list of agenda types in which the agenda
-must display the inherited tags. Available types are 'todo,
-'agenda, 'search and 'timeline.
+must display the inherited tags. Available types are `todo',
+`agenda' and `search'.
When set to nil, never show inherited tags in agenda lines."
:group 'org-agenda-line-format
@@ -1814,7 +1837,7 @@ When set to nil, never show inherited tags in agenda lines."
(repeat :tag "Show inherited tags only in selected agenda types"
(symbol :tag "Agenda type"))))
-(defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda)
+(defcustom org-agenda-use-tag-inheritance '(todo search agenda)
"List of agenda view types where to use tag inheritance.
In tags/tags-todo/tags-tree agenda views, tag inheritance is
@@ -1823,16 +1846,17 @@ controlled by `org-use-tag-inheritance'. In other agenda types,
agenda entries. Still, you may want the agenda to be aware of
the inherited tags anyway, e.g. for later tag filtering.
-Allowed value are 'todo, 'search, 'timeline and 'agenda.
+Allowed value are `todo', `search' and `agenda'.
This variable has no effect if `org-agenda-show-inherited-tags'
-is set to 'always. In that case, the agenda is aware of those
+is set to `always'. In that case, the agenda is aware of those
tags.
The default value sets tags in every agenda type. Setting this
option to nil will speed up non-tags agenda view a lot."
:group 'org-agenda
- :version "24.3"
+ :version "26.1"
+ :package-version '(Org . "9.1")
:type '(choice
(const :tag "Use tag inheritance in all agenda types" t)
(repeat :tag "Use tag inheritance in selected agenda types"
@@ -1858,18 +1882,26 @@ When this is the symbol `prefix', only remove tags when
(const :tag "Never" nil)
(const :tag "When prefix format contains %T" prefix)))
-(org-defvaralias 'org-agenda-remove-tags-when-in-prefix
+(defvaralias 'org-agenda-remove-tags-when-in-prefix
'org-agenda-remove-tags)
-(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80)
+(defcustom org-agenda-tags-column 'auto
"Shift tags in agenda items to this column.
-If this number is positive, it specifies the column. If it is negative,
-it means that the tags should be flushright to that column. For example,
--80 works well for a normal 80 character screen."
+If set to `auto', tags will be automatically aligned to the right
+edge of the window.
+
+If set to a positive number, tags will be left-aligned to that
+column. If set to a negative number, tags will be right-aligned
+to that column. For example, -80 works well for a normal 80
+character screen."
:group 'org-agenda-line-format
- :type 'integer)
+ :type '(choice
+ (const :tag "Automatically align to right edge of window" auto)
+ (integer :tag "Specific column" -80))
+ :package-version '(Org . "9.1")
+ :version "26.1")
-(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
+(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
(defcustom org-agenda-fontify-priorities 'cookies
"Non-nil means highlight low and high priorities in agenda.
@@ -1948,6 +1980,14 @@ category, you can use:
:tag "Org Agenda Column View"
:group 'org-agenda)
+(defcustom org-agenda-view-columns-initially nil
+ "When non-nil, switch to columns view right after creating the agenda."
+ :group 'org-agenda-column-view
+ :type 'boolean
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :safe #'booleanp)
+
(defcustom org-agenda-columns-show-summaries t
"Non-nil means show summaries for columns displayed in the agenda view."
:group 'org-agenda-column-view
@@ -1975,7 +2015,8 @@ estimate."
:type 'boolean)
(defcustom org-agenda-auto-exclude-function nil
- "A function called with a tag to decide if it is filtered on `/ RET'.
+ "A function called with a tag to decide if it is filtered on \
+\\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] RET'.
The sole argument to the function, which is called once for each
possible tag, is a string giving the name of the tag. The
function should return either nil if the tag should be included
@@ -1990,13 +2031,13 @@ the lower-case version of all tags."
"Alist of characters and custom functions for bulk actions.
For example, this value makes those two functions available:
- ((?R set-category)
- (?C bulk-cut))
+ \\='((?R set-category)
+ (?C bulk-cut))
With selected entries in an agenda buffer, `B R' will call
the custom function `set-category' on the selected entries.
Note that functions in this alist don't need to be quoted."
- :type 'alist
+ :type '(alist :key-type character :value-type (group function))
:version "24.1"
:group 'org-agenda)
@@ -2006,7 +2047,7 @@ If STRING is non-nil, the text property will be fetched from position 0
in that string. If STRING is nil, it will be fetched from the beginning
of the current line."
(org-with-gensyms (marker)
- `(let ((,marker (get-text-property (if string 0 (point-at-bol))
+ `(let ((,marker (get-text-property (if ,string 0 (point-at-bol))
'org-hd-marker ,string)))
(with-current-buffer (marker-buffer ,marker)
(save-excursion
@@ -2027,7 +2068,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good."
(defvar org-agenda-mode-map (make-sparse-keymap)
"Keymap for `org-agenda-mode'.")
-(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
+(defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
(defvar org-agenda-menu) ; defined later in this file.
(defvar org-agenda-restrict nil) ; defined later in this file.
@@ -2044,6 +2085,8 @@ The buffer is still writable when this hook is called.")
(defvar org-agenda-force-single-file nil)
(defvar org-agenda-bulk-marked-entries nil
"List of markers that refer to marked entries in the agenda.")
+(defvar org-agenda-current-date nil
+ "Active date when building the agenda.")
;;; Multiple agenda buffers support
@@ -2064,13 +2107,13 @@ When nil, `q' will kill the single agenda buffer."
(> (prefix-numeric-value arg) 0)
(not org-agenda-sticky))))
(if (equal new-value org-agenda-sticky)
- (and (org-called-interactively-p 'interactive)
+ (and (called-interactively-p 'interactive)
(message "Sticky agenda was already %s"
(if org-agenda-sticky "enabled" "disabled")))
(setq org-agenda-sticky new-value)
(org-agenda-kill-all-agenda-buffers)
- (and (org-called-interactively-p 'interactive)
- (message "Sticky agenda was %s"
+ (and (called-interactively-p 'interactive)
+ (message "Sticky agenda %s"
(if org-agenda-sticky "enabled" "disabled"))))))
(defvar org-agenda-buffer nil
@@ -2080,6 +2123,8 @@ When nil, `q' will kill the single agenda buffer."
(defvar org-agenda-this-buffer-name nil)
(defvar org-agenda-doing-sticky-redo nil)
(defvar org-agenda-this-buffer-is-sticky nil)
+(defvar org-agenda-last-indirect-buffer nil
+ "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
(defconst org-agenda-local-vars
'(org-agenda-this-buffer-name
@@ -2101,8 +2146,10 @@ When nil, `q' will kill the single agenda buffer."
org-agenda-category-filter
org-agenda-top-headline-filter
org-agenda-regexp-filter
+ org-agenda-effort-filter
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
+ org-agenda-last-indirect-buffer
org-agenda-filtered-by-category
org-agenda-filter-form
org-agenda-cycle-counter
@@ -2110,7 +2157,7 @@ When nil, `q' will kill the single agenda buffer."
"Variables that must be local in agenda buffers to allow multiple buffers.")
(defun org-agenda-mode ()
- "Mode for time-sorted view on action items in Org-mode files.
+ "Mode for time-sorted view on action items in Org files.
The following commands are available:
@@ -2123,42 +2170,41 @@ The following commands are available:
;; while letting `kill-all-local-variables' kill the rest
(let ((save (buffer-local-variables)))
(kill-all-local-variables)
- (mapc 'make-local-variable org-agenda-local-vars)
+ (mapc #'make-local-variable org-agenda-local-vars)
(dolist (elem save)
- (let ((var (car elem))
- (val (cdr elem)))
- (when (and val
- (member var org-agenda-local-vars))
- (set var val)))))
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (pcase elem
+ (`(,var . ,val) ;ignore unbound variables
+ (when (and val (memq var org-agenda-local-vars))
+ (set var val))))))
+ (setq-local org-agenda-this-buffer-is-sticky t))
(org-agenda-sticky
;; Creating a sticky Agenda buffer for the first time
(kill-all-local-variables)
(mapc 'make-local-variable org-agenda-local-vars)
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
+ (setq-local org-agenda-this-buffer-is-sticky t))
(t
;; Creating a non-sticky agenda buffer
(kill-all-local-variables)
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil)))
+ (setq-local org-agenda-this-buffer-is-sticky nil)))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-bulk-marked-entries nil)
(setq major-mode 'org-agenda-mode)
;; Keep global-font-lock-mode from turning on font-lock-mode
- (org-set-local 'font-lock-global-modes (list 'not major-mode))
+ (setq-local font-lock-global-modes (list 'not major-mode))
(setq mode-name "Org-Agenda")
(setq indent-tabs-mode nil)
(use-local-map org-agenda-mode-map)
(easy-menu-add org-agenda-menu)
(if org-startup-truncated (setq truncate-lines t))
- (org-set-local 'line-move-visual nil)
- (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
- (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
+ (setq-local line-move-visual nil)
+ (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
+ (add-hook 'pre-command-hook 'org-unhighlight nil 'local)
;; Make sure properties are removed when copying text
- (org-add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (substring-no-properties (funcall fun start end delete)))
- nil t)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (substring-no-properties (funcall fun start end delete)))
+ nil t)
(unless org-agenda-keep-modes
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode))
@@ -2303,25 +2349,31 @@ The following commands are available:
(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-remove-all)
-(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
(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 [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)
+
(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"
@@ -2329,7 +2381,7 @@ The following commands are available:
("Agenda Files")
"--"
("Agenda Dates"
- ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
+ ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda)]
["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
@@ -2346,7 +2398,7 @@ The following commands are available:
["Fortnight View" org-agenda-fortnight-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'fortnight)
- :keys "v f"]
+ :keys "v t"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'month)
@@ -2375,7 +2427,7 @@ The following commands are available:
"--"
["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log
- :active (org-agenda-check-type nil 'agenda 'timeline)
+ :active (org-agenda-check-type nil 'agenda)
:keys "v l (or just l)"]
["Include archived trees" org-agenda-archives-mode
:style toggle :selected org-agenda-archives-mode :active t
@@ -2387,7 +2439,7 @@ The following commands are available:
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
["Write view to file" org-agenda-write t]
["Rebuild buffer" org-agenda-redo t]
- ["Save all Org-mode Buffers" org-save-all-org-buffers t]
+ ["Save all Org buffers" org-save-all-org-buffers t]
"--"
["Show original entry" org-agenda-show t]
["Go To (other window)" org-agenda-goto t]
@@ -2432,13 +2484,13 @@ The following commands are available:
["Schedule" org-agenda-schedule t]
["Set Deadline" org-agenda-deadline t]
"--"
- ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
- ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
- ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
- ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
- ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
- ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
- ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
+ ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda)]
+ ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
+ ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
+ ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
+ ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
+ ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
+ ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
("Clock and Effort"
["Clock in" org-agenda-clock-in t]
["Clock out" org-agenda-clock-out t]
@@ -2454,12 +2506,12 @@ The following commands are available:
["Decrease Priority" org-agenda-priority-down t]
["Show Priority" org-show-priority t])
("Calendar/Diary"
- ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
- ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
- ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
- ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
- ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
- ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
+ ["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)]
+ ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
+ ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
+ ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
+ ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
"--"
["Create iCalendar File" org-icalendar-combine-agenda-files t])
"--"
@@ -2468,7 +2520,7 @@ The following commands are available:
("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 "C-c a ?"]
+ ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
["Show note / unflag" org-agenda-show-the-flagging-note t]
"--"
["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
@@ -2538,7 +2590,7 @@ For example, if you have a custom agenda command \"p\" and you
want this command to be accessible only from plain text files,
use this:
- \\='((\"p\" ((in-file . \"\\.txt\"))))
+ \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\"))))
Here are the available contexts definitions:
@@ -2556,7 +2608,7 @@ accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
- \\='((\"p\" \"q\" ((in-file . \"\\.txt\"))))
+ \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\"))))
Here it means: in .txt files, use \"p\" as the key for the
agenda command otherwise associated with \"q\". (The command
@@ -2595,8 +2647,7 @@ type."
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of entries")))))
(defcustom org-agenda-max-todos nil
@@ -2614,8 +2665,7 @@ type."
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of TODOs")))))
(defcustom org-agenda-max-tags nil
@@ -2633,8 +2683,7 @@ type."
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of tagged entries")))))
(defcustom org-agenda-max-effort nil
@@ -2652,10 +2701,10 @@ to limit entries to in this type."
(const agenda)
(const todo)
(const tags)
- (const search)
- (const timeline))
+ (const search))
(integer :tag "Max number of minutes")))))
+(defvar org-agenda-keep-restricted-file-list nil)
(defvar org-keys nil)
(defvar org-match nil)
;;;###autoload
@@ -2671,7 +2720,6 @@ T Call `org-todo-list' to display the global todo list, select only
m Call `org-tags-view' to display headlines with tags matching
a condition (the user is prompted for the condition).
M Like `m', but select only TODO entries, no ordinary headlines.
-L Create a timeline for the current buffer.
e Export views to associated files.
s Search entries for keywords.
S Search entries for keywords, only with TODO keywords.
@@ -2688,9 +2736,9 @@ More commands can be added by configuring the variable
`org-agenda-custom-commands'. In particular, specific tags and TODO keyword
searches can be pre-defined in this way.
-If the current buffer is in Org-mode and visiting a file, you can also
+If the current buffer is in Org mode and visiting a file, you can also
first press `<' once to indicate that the agenda should be temporarily
-\(until the next use of \\[org-agenda]) restricted to the current file.
+\(until the next use of `\\[org-agenda]') restricted to the current file.
Pressing `<' twice means to restrict to the current subtree or region
\(if active)."
(interactive "P")
@@ -2722,7 +2770,7 @@ Pressing `<' twice means to restrict to the current subtree or region
entry key type org-match lprops ans)
;; Turn off restriction unless there is an overriding one,
(unless org-agenda-overriding-restriction
- (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list)
+ (unless org-agenda-keep-restricted-file-list
;; There is a request to keep the file list in place
(put 'org-agenda-files 'org-restrict nil))
(setq org-agenda-restrict nil)
@@ -2819,7 +2867,7 @@ Pressing `<' twice means to restrict to the current subtree or region
((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
((equal org-keys "e") (call-interactively 'org-store-agenda-views))
((equal org-keys "?") (org-tags-view nil "+FLAGGED")
- (org-add-hook
+ (add-hook
'post-command-hook
(lambda ()
(unless (current-message)
@@ -2834,12 +2882,6 @@ Pressing `<' twice means to restrict to the current subtree or region
(copy-sequence note))
nil 'face 'org-warning)))))))
t t))
- ((equal org-keys "L")
- (unless (derived-mode-p 'org-mode)
- (user-error "This is not an Org-mode file"))
- (unless restriction
- (put 'org-agenda-files 'org-restrict (list bfn))
- (org-call-with-arg 'org-timeline arg)))
((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
((equal org-keys "!") (customize-variable 'org-stuck-projects))
@@ -2889,15 +2931,15 @@ Agenda views are separated by `org-agenda-block-separator'."
(erase-buffer)
(insert (eval-when-compile
(let ((header
- "Press key for an agenda command: < Buffer, subtree/region restriction
--------------------------------- > Remove restriction
-a Agenda for current week or day e Export agenda views
-t List of all TODO entries T Entries with special TODO kwd
-m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
-s Search for keywords S Like s, but only TODO entries
-L Timeline for current buffer # List stuck projects (!=configure)
-/ Multi-occur C Configure custom agenda commands
-? Find :FLAGGED: entries * Toggle sticky agenda views
+ "Press key for an agenda command:
+-------------------------------- < Buffer, subtree/region restriction
+a Agenda for current week or day > Remove restriction
+t List of all TODO entries e Export agenda views
+m Match a TAGS/PROP/TODO query T Entries with special TODO kwd
+s Search for keywords M Like m, but only TODO entries
+/ Multi-occur S Like s, but only TODO entries
+? Find :FLAGGED: entries C Configure custom agenda commands
+* Toggle sticky agenda views # List stuck projects (!=configure)
")
(start 0))
(while (string-match
@@ -2928,7 +2970,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
type (nth 2 entry)
match (nth 3 entry))
(if (> (length key) 1)
- (pushnew (string-to-char key) prefixes :test #'equal)
+ (cl-pushnew (string-to-char key) prefixes :test #'equal)
(setq line
(format
"%-4s%-14s"
@@ -3034,7 +3076,7 @@ L Timeline for current buffer # List stuck projects (!=configure)
(call-interactively 'org-toggle-sticky-agenda)
(sit-for 2))
((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
- (message "Restriction is only possible in Org-mode buffers")
+ (message "Restriction is only possible in Org buffers")
(ding) (sit-for 1))
((eq c ?1)
(org-agenda-remove-restriction-lock 'noupdate)
@@ -3067,10 +3109,13 @@ L Timeline for current buffer # List stuck projects (!=configure)
"Fit the window to the buffer size."
(and (memq org-agenda-window-setup '(reorganize-frame))
(fboundp 'fit-window-to-buffer)
- (org-fit-window-to-buffer
- nil
- (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
- (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
+ (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
+ (= (car org-agenda-window-frame-fractions) 1.0))
+ (delete-other-windows)
+ (org-fit-window-to-buffer
+ nil
+ (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
+ (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))))
(defvar org-cmd nil)
(defvar org-agenda-overriding-cmd nil)
@@ -3089,9 +3134,9 @@ L Timeline for current buffer # List stuck projects (!=configure)
match ;; The byte compiler incorrectly complains about this. Keep it!
org-cmd type lprops)
(while (setq org-cmd (pop cmds))
- (setq type (car org-cmd)
- match (eval (nth 1 org-cmd))
- lprops (nth 2 org-cmd))
+ (setq type (car org-cmd))
+ (setq match (eval (nth 1 org-cmd)))
+ (setq lprops (nth 2 org-cmd))
(let ((org-agenda-overriding-arguments
(if (eq org-agenda-overriding-cmd org-cmd)
(or org-agenda-overriding-arguments
@@ -3144,7 +3189,7 @@ Parameters are alternating variable names and values that will be bound
before running the agenda command."
(org-eval-in-environment (org-make-parameter-alist parameters)
(let (org-agenda-sticky)
- (if (> (length cmd-key) 2)
+ (if (> (length cmd-key) 1)
(org-tags-view nil cmd-key)
(org-agenda nil cmd-key))))
(set-buffer org-agenda-buffer-name)
@@ -3232,7 +3277,7 @@ This ensures the export commands can easily use it."
(setq tmp (replace-match "" t t tmp)))
(when (and (setq re (plist-get props 'org-todo-regexp))
(setq re (concat "\\`\\.*" re " ?"))
- (string-match re tmp))
+ (let ((case-fold-search nil)) (string-match re tmp)))
(plist-put props 'todo (match-string 1 tmp))
(setq tmp (replace-match "" t t tmp)))
(plist-put props 'txt tmp)))
@@ -3245,9 +3290,7 @@ This ensures the export commands can easily use it."
((not res) "")
((stringp res) res)
(t (prin1-to-string res))))
- (while (string-match "," res)
- (setq res (replace-match ";" t t res)))
- (org-trim res)))
+ (org-trim (replace-regexp-in-string "," ";" res nil t))))
;;;###autoload
(defun org-store-agenda-views (&rest parameters)
@@ -3306,39 +3349,43 @@ This ensures the export commands can easily use it."
(defvar org-agenda-write-buffer-name "Agenda View")
(defun org-agenda-write (file &optional open nosettings agenda-bufname)
"Write the current buffer (an agenda view) as a file.
+
Depending on the extension of the file name, plain text (.txt),
HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
-If the extension is .ics, run icalendar export over all files used
-to construct the agenda and limit the export to entries listed in the
-agenda now.
-If the extension is .org, collect all subtrees corresponding to the
-agenda entries and add them in an .org file.
-With prefix argument OPEN, open the new file immediately.
-If NOSETTINGS is given, do not scope the settings of
-`org-agenda-exporter-settings' into the export commands. This is used when
-the settings have already been scoped and we do not wish to overrule other,
-higher priority settings.
-If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
+If the extension is .ics, translate visible agenda into iCalendar
+format. If the extension is .org, collect all subtrees
+corresponding to the agenda entries and add them in an .org file.
+
+With prefix argument OPEN, open the new file immediately. If
+NOSETTINGS is given, do not scope the settings of
+`org-agenda-exporter-settings' into the export commands. This is
+used when the settings have already been scoped and we do not
+wish to overrule other, higher priority settings. If
+AGENDA-BUFFER-NAME is provided, use this as the buffer name for
+the agenda to write."
(interactive "FWrite agenda to file: \nP")
(if (or (not (file-writable-p file))
(and (file-exists-p file)
- (if (org-called-interactively-p 'any)
+ (if (called-interactively-p 'any)
(not (y-or-n-p (format "Overwrite existing file %s? " file))))))
(user-error "Cannot write agenda to file %s" file))
(org-let (if nosettings nil org-agenda-exporter-settings)
'(save-excursion
(save-window-excursion
- (let ((bs (copy-sequence (buffer-string))) beg content)
+ (let ((bs (copy-sequence (buffer-string)))
+ (extension (file-name-extension file))
+ (default-directory (file-name-directory file))
+ beg content)
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
- (org-agenda-remove-marked-text 'org-filtered)
+ (org-agenda-remove-marked-text 'invisible 'org-filtered)
(run-hooks 'org-agenda-before-write-hook)
(cond
- ((org-bound-and-true-p org-mobile-creating-agendas)
+ ((bound-and-true-p org-mobile-creating-agendas)
(org-mobile-write-agenda-for-mobile file))
- ((string-match "\\.org\\'" file)
+ ((string= "org" extension)
(let (content p m message-log-max)
(goto-char (point-min))
(while (setq p (next-single-property-change (point) 'org-hd-marker nil))
@@ -3357,8 +3404,9 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(write-file file)
(kill-buffer (current-buffer))
(message "Org file written to %s" file)))
- ((string-match "\\.html?\\'" file)
- (require 'htmlize)
+ ((member extension '("html" "htm"))
+ (or (require 'htmlize nil t)
+ (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(set-buffer (htmlize-buffer (current-buffer)))
(when org-agenda-export-html-style
;; replace <style> section with org-agenda-export-html-style
@@ -3369,11 +3417,11 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(write-file file)
(kill-buffer (current-buffer))
(message "HTML written to %s" file))
- ((string-match "\\.ps\\'" file)
+ ((string= "ps" extension)
(require 'ps-print)
(ps-print-buffer-with-faces file)
(message "Postscript written to %s" file))
- ((string-match "\\.pdf\\'" file)
+ ((string= "pdf" extension)
(require 'ps-print)
(ps-print-buffer-with-faces
(concat (file-name-sans-extension file) ".ps"))
@@ -3383,7 +3431,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(expand-file-name file))
(delete-file (concat (file-name-sans-extension file) ".ps"))
(message "PDF written to %s" file))
- ((string-match "\\.ics\\'" file)
+ ((string= "ics" extension)
(require 'ox-icalendar)
(org-icalendar-export-current-agenda (expand-file-name file)))
(t
@@ -3395,7 +3443,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
(kill-buffer (current-buffer))
(message "Plain text written to %s" file))))))))
(set-buffer (or agenda-bufname
- (and (org-called-interactively-p 'any) (buffer-name))
+ (and (called-interactively-p 'any) (buffer-name))
org-agenda-buffer-name)))
(when open (org-open-file file)))
@@ -3416,7 +3464,7 @@ This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
entry text following headings shown in the agenda.
Drawers will be excluded, also the line with scheduling/deadline info."
(when (and (> org-agenda-add-entry-text-maxlines 0)
- (not (org-bound-and-true-p org-mobile-creating-agendas)))
+ (not (bound-and-true-p org-mobile-creating-agendas)))
(let (m txt)
(goto-char (point-min))
(while (not (eobp))
@@ -3441,85 +3489,83 @@ removed from the entry content. Currently only `planning' is allowed here."
(with-current-buffer (marker-buffer marker)
(if (not (derived-mode-p 'org-mode))
(setq txt "")
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (end-of-line 1)
- (setq txt (buffer-substring
- (min (1+ (point)) (point-max))
- (progn (outline-next-heading) (point)))
- drawer-re org-drawer-regexp
- kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
- ".*\n?"))
- (with-temp-buffer
- (insert txt)
- (when org-agenda-add-entry-text-descriptive-links
- (goto-char (point-min))
- (while (org-activate-bracket-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp (point-max) t)
- (set-text-properties (match-beginning 0) (match-end 0)
- nil))
- (goto-char (point-min))
- (while (re-search-forward drawer-re nil t)
- (delete-region
- (match-beginning 0)
- (progn (re-search-forward
- "^[ \t]*:END:.*\n?" nil 'move)
- (point))))
- (unless (member 'planning keep)
- (goto-char (point-min))
- (while (re-search-forward kwd-time-re nil t)
- (replace-match "")))
- (goto-char (point-min))
- (when org-agenda-entry-text-exclude-regexps
- (let ((re-list org-agenda-entry-text-exclude-regexps) re)
- (while (setq re (pop re-list))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (replace-match "")))))
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (if (looking-at "[ \t\n]+\\'") (replace-match ""))
-
- ;; find and remove min common indentation
- (goto-char (point-min))
- (untabify (point-min) (point-max))
- (setq ind (org-get-indentation))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (setq ind (min ind (org-get-indentation))))
- (beginning-of-line 2))
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (move-to-column ind)
- (delete-region (point-at-bol) (point)))
- (beginning-of-line 2))
-
- (run-hooks 'org-agenda-entry-text-cleanup-hook)
-
- (goto-char (point-min))
- (when indent
- (while (and (not (eobp)) (re-search-forward "^" nil t))
- (replace-match indent t t)))
- (goto-char (point-min))
- (while (looking-at "[ \t]*\n") (replace-match ""))
- (goto-char (point-max))
- (when (> (org-current-line)
- n-lines)
- (org-goto-line (1+ n-lines))
- (backward-char 1))
- (setq txt (buffer-substring (point-min) (point)))))))))
+ (org-with-wide-buffer
+ (goto-char marker)
+ (end-of-line 1)
+ (setq txt (buffer-substring
+ (min (1+ (point)) (point-max))
+ (progn (outline-next-heading) (point)))
+ drawer-re org-drawer-regexp
+ kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
+ ".*\n?"))
+ (with-temp-buffer
+ (insert txt)
+ (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 (point-min))
+ (while (re-search-forward org-bracket-link-regexp (point-max) t)
+ (set-text-properties (match-beginning 0) (match-end 0)
+ nil))
+ (goto-char (point-min))
+ (while (re-search-forward drawer-re nil t)
+ (delete-region
+ (match-beginning 0)
+ (progn (re-search-forward
+ "^[ \t]*:END:.*\n?" nil 'move)
+ (point))))
+ (unless (member 'planning keep)
+ (goto-char (point-min))
+ (while (re-search-forward kwd-time-re nil t)
+ (replace-match "")))
+ (goto-char (point-min))
+ (when org-agenda-entry-text-exclude-regexps
+ (let ((re-list org-agenda-entry-text-exclude-regexps) re)
+ (while (setq re (pop re-list))
+ (goto-char (point-min))
+ (while (re-search-forward re nil t)
+ (replace-match "")))))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (if (looking-at "[ \t\n]+\\'") (replace-match ""))
+
+ ;; find and remove min common indentation
+ (goto-char (point-min))
+ (untabify (point-min) (point-max))
+ (setq ind (org-get-indentation))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (setq ind (min ind (org-get-indentation))))
+ (beginning-of-line 2))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (move-to-column ind)
+ (delete-region (point-at-bol) (point)))
+ (beginning-of-line 2))
+
+ (run-hooks 'org-agenda-entry-text-cleanup-hook)
+
+ (goto-char (point-min))
+ (when indent
+ (while (and (not (eobp)) (re-search-forward "^" nil t))
+ (replace-match indent t t)))
+ (goto-char (point-min))
+ (while (looking-at "[ \t]*\n") (replace-match ""))
+ (goto-char (point-max))
+ (when (> (org-current-line)
+ n-lines)
+ (org-goto-line (1+ n-lines))
+ (backward-char 1))
+ (setq txt (buffer-substring (point-min) (point))))))))
txt))
(defun org-check-for-org-mode ()
"Make sure current buffer is in org-mode. Error if not."
(or (derived-mode-p 'org-mode)
- (error "Cannot execute org-mode agenda command on buffer in %s"
+ (error "Cannot execute Org agenda command on buffer in %s"
major-mode)))
;;; Agenda prepare and finalize
@@ -3531,6 +3577,7 @@ removed from the entry content. Currently only `planning' is allowed here."
(defvar org-agenda-tag-filter nil)
(defvar org-agenda-category-filter nil)
(defvar org-agenda-regexp-filter nil)
+(defvar org-agenda-effort-filter nil)
(defvar org-agenda-top-headline-filter nil)
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
@@ -3562,6 +3609,16 @@ the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
+(defvar org-agenda-effort-filter-preset nil
+ "A preset of the effort condition used for secondary agenda filtering.
+This must be a list of strings, each string must be a single regexp
+preceded by \"+\" or \"-\".
+This variable should not be set directly, but agenda custom commands can
+bind it in the options section. The preset filter is a global property of
+the entire agenda view. In a block agenda, it will not work reliably to
+define a filter for one of the individual blocks. You need to set it in
+the global options and expect it to be applied to the entire view.")
+
(defun org-agenda-use-sticky-p ()
"Return non-nil if an agenda buffer named
`org-agenda-buffer-name' exists and should be shown instead of
@@ -3593,30 +3650,37 @@ FILTER-ALIST is an alist of filters we need to apply when
((equal (current-buffer) abuf) nil)
(awin (select-window awin))
((not (setq wconf (current-window-configuration))))
- ((equal org-agenda-window-setup 'current-window)
- (org-pop-to-buffer-same-window abuf))
- ((equal org-agenda-window-setup 'other-window)
+ ((eq org-agenda-window-setup 'current-window)
+ (pop-to-buffer-same-window abuf))
+ ((eq org-agenda-window-setup 'other-window)
(org-switch-to-buffer-other-window abuf))
- ((equal org-agenda-window-setup 'other-frame)
+ ((eq org-agenda-window-setup 'other-frame)
(switch-to-buffer-other-frame abuf))
- ((equal org-agenda-window-setup 'reorganize-frame)
+ ((eq org-agenda-window-setup 'only-window)
+ (delete-other-windows)
+ (pop-to-buffer-same-window abuf))
+ ((eq org-agenda-window-setup 'reorganize-frame)
(delete-other-windows)
(org-switch-to-buffer-other-window abuf)))
- (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist)))
- (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist)))
- (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist)))
+ (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
+ (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
+ (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
+ (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
;; Additional test in case agenda is invoked from within agenda
;; buffer via elisp link.
(unless (equal (current-buffer) abuf)
- (org-pop-to-buffer-same-window abuf))
+ (pop-to-buffer-same-window abuf))
(setq org-agenda-pre-window-conf
- (or org-agenda-pre-window-conf wconf))))
+ (or wconf org-agenda-pre-window-conf))))
(defun org-agenda-prepare (&optional name)
(let ((filter-alist (if org-agenda-persistent-filter
- (list `(tag . ,org-agenda-tag-filter)
- `(re . ,org-agenda-regexp-filter)
- `(car . ,org-agenda-category-filter)))))
+ (with-current-buffer
+ (get-buffer-create org-agenda-buffer-name)
+ (list `(tag . ,org-agenda-tag-filter)
+ `(re . ,org-agenda-regexp-filter)
+ `(effort . ,org-agenda-effort-filter)
+ `(cat . ,org-agenda-category-filter))))))
(if (org-agenda-use-sticky-p)
(progn
(put 'org-agenda-tag-filter :preset-filter nil)
@@ -3629,13 +3693,14 @@ FILTER-ALIST is an alist of filters we need to apply when
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
(setq org-todo-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
(put 'org-agenda-tag-filter :preset-filter
org-agenda-tag-filter-preset)
(put 'org-agenda-category-filter :preset-filter
org-agenda-category-filter-preset)
(put 'org-agenda-regexp-filter :preset-filter
org-agenda-regexp-filter-preset)
+ (put 'org-agenda-effort-filter :preset-filter
+ org-agenda-effort-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
@@ -3649,7 +3714,6 @@ FILTER-ALIST is an alist of filters we need to apply when
"\n"))
(narrow-to-region (point) (point-max)))
(setq org-done-keywords-for-agenda nil)
-
;; Setting any org variables that are in org-agenda-local-vars
;; list need to be done after the prepare call
(org-agenda-prepare-window
@@ -3666,11 +3730,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-uniquify org-todo-keywords-for-agenda))
(setq org-done-keywords-for-agenda
(org-uniquify org-done-keywords-for-agenda))
- (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
(setq org-agenda-last-prefix-arg current-prefix-arg)
(setq org-agenda-this-buffer-name org-agenda-buffer-name)
(and name (not org-agenda-name)
- (org-set-local 'org-agenda-name name)))
+ (setq-local org-agenda-name name)))
(setq buffer-read-only nil))))
(defvar org-agenda-overriding-columns-format) ; From org-colview.el
@@ -3681,11 +3744,7 @@ FILTER-ALIST is an alist of filters we need to apply when
(let ((inhibit-read-only t))
(goto-char (point-min))
(save-excursion
- (while (org-activate-bracket-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
- (save-excursion
- (while (org-activate-plain-links (point-max))
+ (while (org-activate-links (point-max))
(add-text-properties (match-beginning 0) (match-end 0)
'(face org-link))))
(unless (eq org-agenda-remove-tags t)
@@ -3694,8 +3753,8 @@ FILTER-ALIST is an alist of filters we need to apply when
(remove-text-properties (point-min) (point-max) '(face nil)))
(if (and (boundp 'org-agenda-overriding-columns-format)
org-agenda-overriding-columns-format)
- (org-set-local 'org-agenda-overriding-columns-format
- org-agenda-overriding-columns-format))
+ (setq-local org-agenda-overriding-columns-format
+ org-agenda-overriding-columns-format))
(if (and (boundp 'org-agenda-view-columns-initially)
org-agenda-view-columns-initially)
(org-agenda-columns))
@@ -3733,10 +3792,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (get 'org-agenda-tag-filter :preset-filter) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
@@ -3747,13 +3806,18 @@ FILTER-ALIST is an alist of filters we need to apply when
(when (get 'org-agenda-regexp-filter :preset-filter)
(org-agenda-filter-apply
(get 'org-agenda-regexp-filter :preset-filter) 'regexp))
- (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
+ (when org-agenda-effort-filter
+ (org-agenda-filter-apply org-agenda-effort-filter 'effort))
+ (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)))))
(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')
- (when org-clock-current-task
+ (when (bound-and-true-p org-clock-current-task)
(save-restriction
(widen)
(org-agenda-unmark-clocking-task)
@@ -3782,7 +3846,7 @@ FILTER-ALIST is an alist of filters we need to apply when
"Make highest priority lines bold, and lowest italic."
(interactive)
(mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority)
- (delete-overlay o)))
+ (delete-overlay o)))
(overlays-in (point-min) (point-max)))
(save-excursion
(let (b e p ov h l)
@@ -3800,16 +3864,17 @@ FILTER-ALIST is an alist of filters we need to apply when
ov (make-overlay b e))
(overlay-put
ov 'face
- (cons (cond ((org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-priority-faces))))
- ((and (listp org-agenda-fontify-priorities)
- (org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-agenda-fontify-priorities)))))
- ((equal p l) 'italic)
- ((equal p h) 'bold))
- 'org-priority))
+ (let ((special-face
+ (cond ((org-face-from-face-or-color
+ 'priority 'org-priority
+ (cdr (assoc p org-priority-faces))))
+ ((and (listp org-agenda-fontify-priorities)
+ (org-face-from-face-or-color
+ 'priority 'org-priority
+ (cdr (assoc p org-agenda-fontify-priorities)))))
+ ((equal p l) 'italic)
+ ((equal p h) 'bold))))
+ (if special-face (list special-face 'org-priority) 'org-priority)))
(overlay-put ov 'org-type 'org-priority)))))
(defvar org-depend-tag-blocked)
@@ -3819,41 +3884,59 @@ FILTER-ALIST is an alist of filters we need to apply when
When INVISIBLE is non-nil, hide currently blocked TODO instead of
dimming them."
(interactive "P")
- (when (org-called-interactively-p 'interactive)
+ (when (called-interactively-p 'interactive)
(message "Dim or hide blocked tasks..."))
- (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
- (delete-overlay o)))
- (overlays-in (point-min) (point-max)))
+ (dolist (o (overlays-in (point-min) (point-max)))
+ (when (eq (overlay-get o 'org-type) 'org-blocked-todo)
+ (delete-overlay o)))
(save-excursion
- (let ((inhibit-read-only t)
- (org-depend-tag-blocked nil)
- (invis (or (not (null invisible))
- (eq org-agenda-dim-blocked-tasks 'invisible)))
- org-blocked-by-checkboxes
- invis1 b e p ov h l)
+ (let ((inhibit-read-only t))
(goto-char (point-min))
- (while (let ((pos (next-single-property-change (point) 'todo-state)))
- (and pos (goto-char (1+ pos))))
- (setq org-blocked-by-checkboxes nil invis1 invis)
- (let ((marker (org-get-at-bol 'org-hd-marker)))
- (when (and marker
- (with-current-buffer (marker-buffer marker)
- (save-excursion (goto-char marker)
- (org-entry-blocked-p))))
- (if org-blocked-by-checkboxes (setq invis1 nil))
- (setq b (if invis1
- (max (point-min) (1- (point-at-bol)))
- (point-at-bol))
- e (point-at-eol)
- ov (make-overlay b e))
- (if invis1
- (progn (overlay-put ov 'invisible t)
- (overlay-put ov 'intangible t))
- (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
- (overlay-put ov 'org-type 'org-blocked-todo))))))
- (when (org-called-interactively-p 'interactive)
+ (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))
+ (ov (make-overlay (if invisible
+ (line-end-position 0)
+ (line-beginning-position))
+ (line-end-position))))
+ (if invisible
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
+ (overlay-put ov 'org-type 'org-blocked-todo))
+ (forward-line))))
+ (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
+`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
+to t."
+ (when (get-text-property 0 'todo-state entry)
+ (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
+ (org-blocked-by-checkboxes nil)
+ ;; Necessary so that `org-entry-blocked-p' does not change
+ ;; the buffer.
+ (org-depend-tag-blocked nil))
+ (when entry-marker
+ (let ((blocked
+ (with-current-buffer (marker-buffer entry-marker)
+ (save-excursion
+ (goto-char entry-marker)
+ (org-entry-blocked-p)))))
+ (when blocked
+ (let ((really-invisible
+ (and (not org-blocked-by-checkboxes)
+ (eq org-agenda-dim-blocked-tasks 'invisible))))
+ (put-text-property
+ 0 (length entry) 'org-todo-blocked
+ (if really-invisible 'invisible t)
+ entry)))))))
+ entry)
+
(defvar org-agenda-skip-function nil
"Function to be called at each match during agenda construction.
If this function returns nil, the current match should not be skipped.
@@ -3908,9 +3991,9 @@ functions do."
(defun org-agenda-new-marker (&optional pos)
"Return a new agenda marker.
-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)))))
+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."
+ (let ((m (copy-marker (or pos (point)) t)))
(setq org-agenda-last-marker-time (float-time))
(if org-agenda-buffer
(with-current-buffer org-agenda-buffer
@@ -3972,156 +4055,14 @@ This check for agenda markers in all agenda buffers currently active."
(defun org-agenda-get-day-face (date)
"Return the face DATE should be displayed with."
- (or (and (functionp org-agenda-day-face-function)
- (funcall org-agenda-day-face-function date))
- (cond ((org-agenda-todayp date)
- 'org-agenda-date-today)
- ((member (calendar-day-of-week date) org-agenda-weekend-days)
- 'org-agenda-date-weekend)
- (t 'org-agenda-date))))
-
-;;; Agenda timeline
-
-(defvar org-agenda-only-exact-dates nil) ; dynamically scoped
-(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
-
-(defun org-timeline (&optional dotodo)
- "Show a time-sorted view of the entries in the current org file.
-Only entries with a time stamp of today or later will be listed. With
-\\[universal-argument] prefix, all unfinished TODO items will also be shown,
-under the current date.
-If the buffer contains an active region, only check the region for
-dates."
- (interactive "P")
- (let* ((dopast t)
- (org-agenda-show-log-scoped org-agenda-show-log)
- (org-agenda-show-log org-agenda-show-log-scoped)
- (entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
- (current-buffer))))
- (date (calendar-current-date))
- (beg (if (org-region-active-p) (region-beginning) (point-min)))
- (end (if (org-region-active-p) (region-end) (point-max)))
- (day-numbers (org-get-all-dates
- beg end 'no-ranges
- t org-agenda-show-log-scoped ; always include today
- org-timeline-show-empty-dates))
- (org-deadline-warning-days 0)
- (org-agenda-only-exact-dates t)
- (today (org-today))
- (past t)
- args
- s e rtn d emptyp)
- (setq org-agenda-redo-command
- (list 'let
- (list (list 'org-agenda-show-log 'org-agenda-show-log))
- (list 'org-switch-to-buffer-other-window (current-buffer))
- (list 'org-timeline (list 'quote dotodo))))
- (put 'org-agenda-redo-command 'org-lprops nil)
- (if (not dopast)
- ;; Remove past dates from the list of dates.
- (setq day-numbers (delq nil (mapcar (lambda(x)
- (if (>= x today) x nil))
- day-numbers))))
- (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
- (org-compile-prefix-format 'timeline)
- (org-set-sorting-strategy 'timeline)
- (if org-agenda-show-log-scoped (push :closed args))
- (push :timestamp args)
- (push :deadline args)
- (push :scheduled args)
- (push :sexp args)
- (if dotodo (push :todo args))
- (insert "Timeline of file " entry "\n")
- (add-text-properties (point-min) (point)
- (list 'face 'org-agenda-structure))
- (org-agenda-mark-header-line (point-min))
- (while (setq d (pop day-numbers))
- (if (and (listp d) (eq (car d) :omitted))
- (progn
- (setq s (point))
- (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
- (put-text-property s (1- (point)) 'face 'org-agenda-structure))
- (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
- (if (and (>= d today)
- dopast
- past)
- (progn
- (setq past nil)
- (insert (make-string 79 ?-) "\n")))
- (setq date (calendar-gregorian-from-absolute d))
- (setq s (point))
- (setq rtn (and (not emptyp)
- (apply 'org-agenda-get-day-entries entry
- date args)))
- (if (or rtn (equal d today) org-timeline-show-empty-dates)
- (progn
- (insert
- (if (stringp org-agenda-format-date)
- (format-time-string org-agenda-format-date
- (org-time-from-absolute date))
- (funcall org-agenda-format-date date))
- "\n")
- (put-text-property s (1- (point)) 'face
- (org-agenda-get-day-face date))
- (put-text-property s (1- (point)) 'org-date-line t)
- (put-text-property s (1- (point)) 'org-agenda-date-header t)
- (if (equal d today)
- (put-text-property s (1- (point)) 'org-today t))
- (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n"))
- (put-text-property s (1- (point)) 'day d)))))
- (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
- (point-min)))
- (add-text-properties
- (point-min) (point-max)
- `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
- (org-agenda-finalize)
- (setq buffer-read-only t)))
-
-(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
- "Return a list of all relevant day numbers from BEG to END buffer positions.
-If NO-RANGES is non-nil, include only the start and end dates of a range,
-not every single day in the range. If FORCE-TODAY is non-nil, make
-sure that TODAY is included in the list. If INACTIVE is non-nil, also
-inactive time stamps (those in square brackets) are included.
-When EMPTY is non-nil, also include days without any entries."
- (let ((re (concat
- (if pre-re pre-re "")
- (if inactive org-ts-regexp-both org-ts-regexp)))
- dates dates1 date day day1 day2 ts1 ts2 pos)
- (if force-today
- (setq dates (list (org-today))))
- (save-excursion
- (goto-char beg)
- (while (re-search-forward re end t)
- (setq day (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)
- (current-buffer) (match-beginning 0))))
- (or (memq day dates) (push day dates)))
- (unless no-ranges
- (goto-char beg)
- (while (re-search-forward org-tr-regexp end t)
- (setq pos (match-beginning 0))
- (setq ts1 (substring (match-string 1) 0 10)
- ts2 (substring (match-string 2) 0 10)
- day1 (time-to-days (org-time-string-to-time
- ts1 (current-buffer) pos))
- day2 (time-to-days (org-time-string-to-time
- ts2 (current-buffer) pos)))
- (while (< (setq day1 (1+ day1)) day2)
- (or (memq day1 dates) (push day1 dates)))))
- (setq dates (sort dates '<))
- (when empty
- (while (setq day (pop dates))
- (setq day2 (car dates))
- (push day dates1)
- (when (and day2 empty)
- (if (or (eq empty t)
- (and (numberp empty) (<= (- day2 day) empty)))
- (while (< (setq day (1+ day)) day2)
- (push (list day) dates1))
- (push (cons :omitted (- day2 day)) dates1))))
- (setq dates (nreverse dates1)))
- dates)))
+ (cond ((and (functionp org-agenda-day-face-function)
+ (funcall org-agenda-day-face-function date)))
+ ((org-agenda-today-p date) 'org-agenda-date-today)
+ ((memq (calendar-day-of-week date) org-agenda-weekend-days)
+ 'org-agenda-date-weekend)
+ (t 'org-agenda-date)))
+
+(defvar org-agenda-show-log-scoped)
;;; Agenda Daily/Weekly
@@ -4160,13 +4101,14 @@ items if they have an hour specification like [h]h:mm."
(catch 'exit
(setq org-agenda-buffer-name
(or org-agenda-buffer-tmp-name
+ (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
(if 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-buffer-name))
+ "*Org Agenda*"))
(org-agenda-prepare "Day/Week")
(setq start-day (or start-day org-agenda-start-day))
(if (stringp start-day)
@@ -4174,8 +4116,7 @@ items if they have an hour specification like [h]h:mm."
(setq start-day (time-to-days (org-read-date nil t start-day))))
(org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda)
- (let* ((span (org-agenda-ndays-to-span
- (or span org-agenda-ndays org-agenda-span)))
+ (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span)))
(today (org-today))
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
@@ -4205,9 +4146,9 @@ items if they have an hour specification like [h]h:mm."
(setq day-numbers (nreverse day-numbers))
(setq clocktable-start (car day-numbers)
clocktable-end (1+ (or (org-last day-numbers) 0)))
- (org-set-local 'org-starting-day (car day-numbers))
- (org-set-local 'org-arg-loc arg)
- (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
+ (setq-local org-starting-day (car day-numbers))
+ (setq-local org-arg-loc arg)
+ (setq-local org-agenda-current-span (org-agenda-ndays-to-span span))
(unless org-agenda-compact-blocks
(let* ((d1 (car day-numbers))
(d2 (org-last day-numbers))
@@ -4353,10 +4294,10 @@ START-DAY is an absolute time value."
((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
- (calendar-last-day-of-month (car date) (caddr date))))
+ (calendar-last-day-of-month (car date) (cl-caddr date))))
((eq span 'year)
(let ((date (calendar-gregorian-from-absolute start-day)))
- (if (calendar-leap-year-p (caddr date)) 366 365)))))
+ (if (calendar-leap-year-p (cl-caddr date)) 366 365)))))
(defun org-agenda-span-name (span)
"Return a SPAN name."
@@ -4371,7 +4312,7 @@ START-DAY is an absolute time value."
(defvar org-agenda-search-history nil)
(defvar org-search-syntax-table nil
- "Special syntax table for org-mode search.
+ "Special syntax table for Org search.
In this table, we have single quotes not as word constituents, to
that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
@@ -4427,8 +4368,9 @@ as a whole, to include whitespace.
with a colon, this will mean that the (non-regexp) snippets of the
Boolean search must match as full words.
-This command searches the agenda files, and in addition the files listed
-in `org-agenda-text-search-extra-files'."
+This command searches the agenda files, and in addition the files
+listed in `org-agenda-text-search-extra-files' unless a restriction lock
+is active."
(interactive "P")
(if org-agenda-overriding-arguments
(setq todo-only (car org-agenda-overriding-arguments)
@@ -4444,7 +4386,7 @@ in `org-agenda-text-search-extra-files'."
(full-words org-agenda-search-view-force-full-words)
(org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
regexp rtn rtnall files file pos inherited-tags
- marker category category-pos level tags c neg re boolean
+ marker category level tags c neg re boolean
ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
(unless (and (not edit-at)
(stringp string)
@@ -4484,7 +4426,7 @@ in `org-agenda-text-search-extra-files'."
(if (or org-agenda-search-view-always-boolean
(member (string-to-char words) '(?- ?+ ?\{)))
(setq boolean t))
- (setq words (org-split-string words))
+ (setq words (split-string words))
(let (www w)
(while (setq w (pop words))
(while (and (string-match "\\\\\\'" w) words)
@@ -4538,10 +4480,20 @@ in `org-agenda-text-search-extra-files'."
(if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
regexp))))
(setq files (org-agenda-files nil 'ifmode))
- (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
- (pop org-agenda-text-search-extra-files)
- (setq files (org-add-archive-files files)))
- (setq files (append files org-agenda-text-search-extra-files)
+ ;; Add `org-agenda-text-search-extra-files' unless there is some
+ ;; restriction.
+ (unless (get 'org-agenda-files 'org-restrict)
+ (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
+ (pop org-agenda-text-search-extra-files)
+ (setq files (org-add-archive-files files))))
+ ;; Uniquify files. However, let `org-check-agenda-file' handle
+ ;; non-existent ones.
+ (setq files (cl-remove-duplicates
+ (append files org-agenda-text-search-extra-files)
+ :test (lambda (a b)
+ (and (file-exists-p a)
+ (file-exists-p b)
+ (file-equal-p a b))))
rtnall nil)
(while (setq file (pop files))
(setq ee nil)
@@ -4576,7 +4528,7 @@ in `org-agenda-text-search-extra-files'."
(> (org-reduced-level (org-outline-level))
org-agenda-search-view-max-outline-level)
(forward-line -1)
- (outline-back-to-heading t)))
+ (org-back-to-heading t)))
(skip-chars-forward "* ")
(setq beg (point-at-bol)
beg1 (point)
@@ -4596,12 +4548,12 @@ in `org-agenda-text-search-extra-files'."
(point-at-bol)
(if hdl-only (point-at-eol) end)))
(mapc (lambda (wr) (when (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
+ (goto-char (1- end))
+ (throw :skip t)))
regexps-)
(mapc (lambda (wr) (unless (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
+ (goto-char (1- end))
+ (throw :skip t)))
(if todo-only
(cons (concat "^\\*+[ \t]+"
org-not-done-regexp)
@@ -4611,7 +4563,6 @@ in `org-agenda-text-search-extra-files'."
(setq marker (org-agenda-new-marker (point))
category (org-get-category)
level (make-string (org-reduced-level (org-outline-level)) ? )
- category-pos (get-text-property (point) 'org-category-position)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -4630,8 +4581,7 @@ in `org-agenda-text-search-extra-files'."
'org-todo-regexp org-todo-regexp
'level level
'org-complex-heading-regexp org-complex-heading-regexp
- 'priority 1000 'org-category category
- 'org-category-position category-pos
+ 'priority 1000
'type "search")
(push txt ee)
(goto-char (1- end))))))))))
@@ -4648,8 +4598,12 @@ in `org-agenda-text-search-extra-files'."
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
(setq pos (point))
(unless org-agenda-multi
- (insert (substitute-command-keys
- "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n"))
+ (insert (substitute-command-keys "\
+Press `\\[org-agenda-manipulate-query-add]', \
+`\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
+`\\[org-agenda-manipulate-query-add-re]', \
+`\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
+`\\[universal-argument] \\[org-agenda-redo]' to edit\n"))
(add-text-properties pos (1- (point))
(list 'face 'org-agenda-structure))))
(org-agenda-mark-header-line (point-min))
@@ -4686,7 +4640,7 @@ in `org-agenda-text-search-extra-files'."
(defun org-todo-list (&optional arg)
"Show all (not done) TODO entries from all agenda file in a single list.
The prefix arg can be used to select a specific TODO keyword and limit
-the list to these. When using \\[universal-argument], you will be prompted
+the list to these. When using `\\[universal-argument]', you will be prompted
for a keyword. A numeric prefix directly selects the Nth keyword in
`org-todo-keywords-1'."
(interactive "P")
@@ -4704,8 +4658,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
rtn rtnall files file pos)
(when (equal arg '(4))
(setq org-select-this-todo-keyword
- (org-icompleting-read "Keyword (or KWD1|K2D2|...): "
- (mapcar 'list kwds) nil nil)))
+ (completing-read "Keyword (or KWD1|K2D2|...): "
+ (mapcar #'list kwds) nil nil)))
(and (equal 0 arg) (setq org-select-this-todo-keyword nil))
(catch 'exit
(if org-agenda-sticky
@@ -4743,7 +4697,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in
org-select-this-todo-keyword))
(setq pos (point))
(unless org-agenda-multi
- (insert (substitute-command-keys "Available with `N r': (0)[ALL]"))
+ (insert (substitute-command-keys "Available with \
+`N \\[org-agenda-redo]': (0)[ALL]"))
(let ((n 0) s)
(mapc (lambda (x)
(setq s (format "(%d)%s" (setq n (1+ n)) x))
@@ -4779,6 +4734,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(let* ((org-tags-match-list-sublevels
org-tags-match-list-sublevels)
(completion-ignore-case t)
+ (org--matcher-tags-todo-only todo-only)
rtn rtnall files file pos matcher
buffer)
(when (and (stringp match) (not (string-match "\\S-" match)))
@@ -4794,13 +4750,15 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
;; expanding tags within `org-make-tags-matcher'
(org-agenda-prepare (concat "TAGS " match))
(setq matcher (org-make-tags-matcher match)
- match (car matcher) matcher (cdr matcher))
+ match (car matcher)
+ matcher (cdr matcher))
(org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags)
(setq org-agenda-query-string match)
(setq org-agenda-redo-command
- (list 'org-tags-view `(quote ,todo-only)
- (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string))))
+ (list 'org-tags-view
+ `(quote ,org--matcher-tags-todo-only)
+ `(if current-prefix-arg nil ,org-agenda-query-string)))
(setq files (org-agenda-files nil 'ifmode)
rtnall nil)
(while (setq file (pop files))
@@ -4823,7 +4781,9 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(narrow-to-region org-agenda-restrict-begin
org-agenda-restrict-end)
(widen))
- (setq rtn (org-scan-tags 'agenda matcher todo-only))
+ (setq rtn (org-scan-tags 'agenda
+ matcher
+ org--matcher-tags-todo-only))
(setq rtnall (append rtnall rtn))))))))
(if org-agenda-overriding-header
(insert (org-add-props (copy-sequence org-agenda-overriding-header)
@@ -4839,18 +4799,21 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
(setq pos (point))
(unless org-agenda-multi
(insert (substitute-command-keys
- "Press `C-u r' to search again with new search string\n")))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
+ "Press `\\[universal-argument] \\[org-agenda-redo]' \
+to search again with new search string\n")))
+ (add-text-properties pos (1- (point))
+ (list 'face 'org-agenda-structure)))
(org-agenda-mark-header-line (point-min))
(when rtnall
(insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
(goto-char (point-min))
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type tags
- org-last-args (,todo-only ,match)
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
+ (add-text-properties
+ (point-min) (point-max)
+ `(org-agenda-type tags
+ org-last-args (,org--matcher-tags-todo-only ,match)
+ org-redo-cmd ,org-agenda-redo-command
+ org-series-cmd ,org-cmd))
(org-agenda-finalize)
(setq buffer-read-only t))))
@@ -4866,43 +4829,6 @@ used by user-defined selections using `org-agenda-skip-function'.")
This variable should not be set directly, but custom commands can bind it
in the options section.")
-(defun org-agenda-skip-entry-when-regexp-matches ()
- "Check if the current entry contains match for `org-agenda-skip-regexp'.
-If yes, it returns the end position of this entry, causing agenda commands
-to skip the entry but continuing the search in the subtree. This is a
-function that can be put into `org-agenda-skip-function' for the duration
-of a command."
- (let ((end (save-excursion (org-end-of-subtree t)))
- skip)
- (save-excursion
- (setq skip (re-search-forward org-agenda-skip-regexp end t)))
- (and skip end)))
-
-(defun org-agenda-skip-subtree-when-regexp-matches ()
- "Check if the current subtree contains match for `org-agenda-skip-regexp'.
-If yes, it returns the end position of this tree, causing agenda commands
-to skip this subtree. This is a function that can be put into
-`org-agenda-skip-function' for the duration of a command."
- (let ((end (save-excursion (org-end-of-subtree t)))
- skip)
- (save-excursion
- (setq skip (re-search-forward org-agenda-skip-regexp end t)))
- (and skip end)))
-
-(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
- "Check if the current subtree contains match for `org-agenda-skip-regexp'.
-If yes, it returns the end position of the current entry (NOT the tree),
-causing agenda commands to skip the entry but continuing the search in
-the subtree. This is a function that can be put into
-`org-agenda-skip-function' for the duration of a command. An important
-use of this function is for the stuck project list."
- (let ((end (save-excursion (org-end-of-subtree t)))
- (entry-end (save-excursion (outline-next-heading) (1- (point))))
- skip)
- (save-excursion
- (setq skip (re-search-forward org-agenda-skip-regexp end t)))
- (and skip entry-end)))
-
(defun org-agenda-skip-entry-if (&rest conditions)
"Skip entry if any of CONDITIONS is true.
See `org-agenda-skip-if' for details."
@@ -4952,39 +4878,41 @@ keywords. Possible classes are: `todo', `done', `any'.
If any of these conditions is met, this function returns the end point of
the entity, causing the search to continue from there. This is a function
that can be put into `org-agenda-skip-function' for the duration of a command."
- (let (beg end m)
- (org-back-to-heading t)
- (setq beg (point)
- end (if subtree
- (progn (org-end-of-subtree t) (point))
- (progn (outline-next-heading) (1- (point)))))
- (goto-char beg)
+ (org-back-to-heading t)
+ (let* ((beg (point))
+ (end (if subtree (save-excursion (org-end-of-subtree t) (point))
+ (org-entry-end-position)))
+ (planning-end (if subtree end (line-end-position 2)))
+ m)
(and
- (or
- (and (memq 'scheduled conditions)
- (re-search-forward org-scheduled-time-regexp end t))
- (and (memq 'notscheduled conditions)
- (not (re-search-forward org-scheduled-time-regexp end t)))
- (and (memq 'deadline conditions)
- (re-search-forward org-deadline-time-regexp end t))
- (and (memq 'notdeadline conditions)
- (not (re-search-forward org-deadline-time-regexp end t)))
- (and (memq 'timestamp conditions)
- (re-search-forward org-ts-regexp end t))
- (and (memq 'nottimestamp conditions)
- (not (re-search-forward org-ts-regexp end t)))
- (and (setq m (memq 'regexp conditions))
- (stringp (nth 1 m))
- (re-search-forward (nth 1 m) end t))
- (and (setq m (memq 'notregexp conditions))
- (stringp (nth 1 m))
- (not (re-search-forward (nth 1 m) end t)))
- (and (or
- (setq m (memq 'nottodo conditions))
- (setq m (memq 'todo-unblocked conditions))
- (setq m (memq 'nottodo-unblocked conditions))
- (setq m (memq 'todo conditions)))
- (org-agenda-skip-if-todo m end)))
+ (or (and (memq 'scheduled conditions)
+ (re-search-forward org-scheduled-time-regexp planning-end t))
+ (and (memq 'notscheduled conditions)
+ (not
+ (save-excursion
+ (re-search-forward org-scheduled-time-regexp planning-end t))))
+ (and (memq 'deadline conditions)
+ (re-search-forward org-deadline-time-regexp planning-end t))
+ (and (memq 'notdeadline conditions)
+ (not
+ (save-excursion
+ (re-search-forward org-deadline-time-regexp planning-end t))))
+ (and (memq 'timestamp conditions)
+ (re-search-forward org-ts-regexp end t))
+ (and (memq 'nottimestamp conditions)
+ (not (save-excursion (re-search-forward org-ts-regexp end t))))
+ (and (setq m (memq 'regexp conditions))
+ (stringp (nth 1 m))
+ (re-search-forward (nth 1 m) end t))
+ (and (setq m (memq 'notregexp conditions))
+ (stringp (nth 1 m))
+ (not (save-excursion (re-search-forward (nth 1 m) end t))))
+ (and (or
+ (setq m (memq 'nottodo conditions))
+ (setq m (memq 'todo-unblocked conditions))
+ (setq m (memq 'nottodo-unblocked conditions))
+ (setq m (memq 'todo conditions)))
+ (org-agenda-skip-if-todo m end)))
end)))
(defun org-agenda-skip-if-todo (args end)
@@ -4993,43 +4921,36 @@ ARGS is a list with first element either `todo', `nottodo',
`todo-unblocked' or `nottodo-unblocked'. The remainder is either
a list of TODO keywords, or a state symbol `todo' or `done' or
`any'."
- (let ((kw (car args))
- (arg (cadr args))
- todo-wds todo-re)
- (setq todo-wds
- (org-uniquify
- (cond
- ((listp arg) ;; list of keywords
- (if (member "*" arg)
- (mapcar 'substring-no-properties org-todo-keywords-1)
- arg))
- ((symbolp arg) ;; keyword class name
- (cond
- ((eq arg 'todo)
- (org-delete-all org-done-keywords
- (mapcar 'substring-no-properties
- org-todo-keywords-1)))
- ((eq arg 'done) org-done-keywords)
- ((eq arg 'any)
- (mapcar 'substring-no-properties org-todo-keywords-1)))))))
- (setq todo-re
- (concat "^\\*+[ \t]+\\<\\("
- (mapconcat 'identity todo-wds "\\|")
- "\\)\\>"))
- (cond
- ((eq kw 'todo) (re-search-forward todo-re end t))
- ((eq kw 'nottodo) (not (re-search-forward todo-re end t)))
- ((eq kw 'todo-unblocked)
- (catch 'unblocked
- (while (re-search-forward todo-re end t)
- (or (org-entry-blocked-p) (throw 'unblocked t)))
- nil))
- ((eq kw 'nottodo-unblocked)
- (catch 'unblocked
- (while (re-search-forward todo-re end t)
- (or (org-entry-blocked-p) (throw 'unblocked nil)))
- t))
- )))
+ (let ((todo-re
+ (concat "^\\*+[ \t]+"
+ (regexp-opt
+ (pcase args
+ (`(,_ todo)
+ (org-delete-all org-done-keywords
+ (copy-sequence org-todo-keywords-1)))
+ (`(,_ done) org-done-keywords)
+ (`(,_ any) org-todo-keywords-1)
+ (`(,_ ,(pred atom))
+ (error "Invalid TODO class or type: %S" args))
+ (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
+ (`(,_ ,todo-list) todo-list))
+ 'words))))
+ (pcase args
+ (`(todo . ,_)
+ (let (case-fold-search) (re-search-forward todo-re end t)))
+ (`(nottodo . ,_)
+ (not (let (case-fold-search) (re-search-forward todo-re end t))))
+ (`(todo-unblocked . ,_)
+ (catch :unblocked
+ (while (let (case-fold-search) (re-search-forward todo-re end t))
+ (when (org-entry-blocked-p) (throw :unblocked t)))
+ nil))
+ (`(nottodo-unblocked . ,_)
+ (catch :unblocked
+ (while (let (case-fold-search) (re-search-forward todo-re end t))
+ (when (org-entry-blocked-p) (throw :unblocked nil)))
+ t))
+ (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
;;;###autoload
(defun org-agenda-list-stuck-projects (&rest ignore)
@@ -5038,50 +4959,53 @@ Stuck projects are project that have no next actions. For the definitions
of what a project is and how to check if it stuck, customize the variable
`org-stuck-projects'."
(interactive)
- (let* ((org-agenda-skip-function
- 'org-agenda-skip-entry-when-regexp-matches-in-subtree)
- ;; We could have used org-agenda-skip-if here.
- (org-agenda-overriding-header
+ (let* ((org-agenda-overriding-header
(or org-agenda-overriding-header "List of stuck projects: "))
(matcher (nth 0 org-stuck-projects))
(todo (nth 1 org-stuck-projects))
- (todo-wds (if (member "*" todo)
- (progn
- (org-agenda-prepare-buffers (org-agenda-files
- nil 'ifmode))
- (org-delete-all
- org-done-keywords-for-agenda
- (copy-sequence org-todo-keywords-for-agenda)))
- todo))
- (todo-re (concat "^\\*+[ \t]+\\("
- (mapconcat 'identity todo-wds "\\|")
- "\\)\\>"))
(tags (nth 2 org-stuck-projects))
- (tags-re (if (member "*" tags)
- (concat org-outline-regexp-bol
- (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
- (if tags
- (concat org-outline-regexp-bol
- ".*:\\("
- (mapconcat 'identity tags "\\|")
- (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$")))))
- (gen-re (nth 3 org-stuck-projects))
- (re-list
- (delq nil
- (list
- (if todo todo-re)
- (if tags tags-re)
- (and gen-re (stringp gen-re) (string-match "\\S-" gen-re)
- gen-re)))))
- (setq org-agenda-skip-regexp
- (if re-list
- (mapconcat 'identity re-list "\\|")
- (error "No information how to identify unstuck projects")))
+ (gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
+ (todo-wds
+ (if (not (member "*" todo)) todo
+ (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
+ (org-delete-all org-done-keywords-for-agenda
+ (copy-sequence org-todo-keywords-for-agenda))))
+ (todo-re (and todo
+ (format "^\\*+[ \t]+\\(%s\\)\\>"
+ (mapconcat #'identity todo-wds "\\|"))))
+ (tags-re (cond ((null tags) nil)
+ ((member "*" tags)
+ (eval-when-compile
+ (concat org-outline-regexp-bol
+ ".*:[[:alnum:]_@#%]+:[ \t]*$")))
+ (tags (concat org-outline-regexp-bol
+ ".*:\\("
+ (mapconcat #'identity tags "\\|")
+ "\\):[[:alnum:]_@#%:]*[ \t]*$"))
+ (t nil)))
+ (re-list (delq nil (list todo-re tags-re gen-re)))
+ (skip-re
+ (if (null re-list)
+ (error "Missing information to identify unstuck projects")
+ (mapconcat #'identity re-list "\\|")))
+ (org-agenda-skip-function
+ ;; Skip entry if `org-agenda-skip-regexp' matches anywhere
+ ;; in the subtree.
+ `(lambda ()
+ (and (save-excursion
+ (let ((case-fold-search nil))
+ (re-search-forward
+ ,skip-re (save-excursion (org-end-of-subtree t)) t)))
+ (progn (outline-next-heading) (point))))))
(org-tags-view nil matcher)
(setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name
(setq org-agenda-redo-command
- `(org-agenda-list-stuck-projects ,current-prefix-arg)))))
+ `(org-agenda-list-stuck-projects ,current-prefix-arg))
+ (let ((inhibit-read-only t))
+ (add-text-properties
+ (point-min) (point-max)
+ `(org-redo-cmd ,org-agenda-redo-command))))))
;;; Diary integration
@@ -5159,7 +5083,7 @@ date. It also removes lines that contain only whitespace."
(while (re-search-forward "^ +\n" nil t)
(replace-match ""))
(goto-char (point-min))
- (if (re-search-forward "^Org-mode dummy\n?" nil t)
+ (if (re-search-forward "^Org mode dummy\n?" nil t)
(replace-match ""))
(run-hooks 'org-agenda-cleanup-fancy-diary-hook))
@@ -5177,7 +5101,7 @@ date. It also removes lines that contain only whitespace."
(setq string (org-modify-diary-entry-string string))))))
(defun org-modify-diary-entry-string (string)
- "Add text properties to string, allowing org-mode to act on it."
+ "Add text properties to string, allowing Org to act on it."
(org-add-props string nil
'mouse-face 'highlight
'help-echo (if buffer-file-name
@@ -5193,9 +5117,9 @@ Needed to avoid empty dates which mess up holiday display."
;; Catch the error if dealing with the new add-to-diary-alist
(when org-disable-agenda-to-diary
(condition-case nil
- (org-add-to-diary-list original-date "Org-mode dummy" "")
+ (org-add-to-diary-list original-date "Org mode dummy" "")
(error
- (org-add-to-diary-list original-date "Org-mode dummy" "" nil)))))
+ (org-add-to-diary-list original-date "Org mode dummy" "" nil)))))
(defun org-add-to-diary-list (&rest args)
(if (fboundp 'diary-add-to-list)
@@ -5265,67 +5189,77 @@ function from a program - use `org-agenda-get-day-entries' instead."
;;; Agenda entry finders
+(defun org-agenda--timestamp-to-absolute (&rest args)
+ "Call `org-time-string-to-absolute' with ARGS.
+However, throw `:skip' whenever an error is raised."
+ (condition-case e
+ (apply #'org-time-string-to-absolute args)
+ (org-diary-sexp-no-match (throw :skip nil))
+ (error
+ (message "%s; Skipping entry" (error-message-string e))
+ (throw :skip nil))))
+
(defun org-agenda-get-day-entries (file date &rest args)
"Does the work for `org-diary' and `org-agenda'.
FILE is the path to a file to be checked for entries. DATE is date like
the one returned by `calendar-current-date'. ARGS are symbols indicating
which kind of entries should be extracted. For details about these, see
the documentation of `org-diary'."
- (setq args (or args org-agenda-entry-types))
(let* ((org-startup-folded nil)
(org-startup-align-all-tables nil)
- (buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- arg results rtn deadline-results)
+ (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file)
+ (error "No such file %s" file))))
(if (not buffer)
- ;; If file does not exist, make sure an error message ends up in diary
+ ;; If file does not exist, signal it in diary nonetheless.
(list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode)
(error "Agenda file %s is not in `org-mode'" file))
(setq org-agenda-buffer (or org-agenda-buffer buffer))
- (let ((case-fold-search nil))
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- ;; The way we repeatedly append to `results' makes it O(n^2) :-(
- (while (setq arg (pop args))
- (cond
- ((and (eq arg :todo)
- (equal date (calendar-gregorian-from-absolute
- (org-today))))
- (setq rtn (org-agenda-get-todos))
- (setq results (append results rtn)))
- ((eq arg :timestamp)
- (setq rtn (org-agenda-get-blocks))
- (setq results (append results rtn))
- (setq rtn (org-agenda-get-timestamps deadline-results))
- (setq results (append results rtn)))
- ((eq arg :sexp)
- (setq rtn (org-agenda-get-sexps))
- (setq results (append results rtn)))
- ((eq arg :scheduled)
- (setq rtn (org-agenda-get-scheduled deadline-results))
- (setq results (append results rtn)))
- ((eq arg :scheduled*)
- (setq rtn (org-agenda-get-scheduled deadline-results t))
- (setq results (append results rtn)))
- ((eq arg :closed)
- (setq rtn (org-agenda-get-progress))
- (setq results (append results rtn)))
- ((eq arg :deadline)
- (setq rtn (org-agenda-get-deadlines))
- (setq deadline-results (copy-sequence rtn))
- (setq results (append results rtn)))
- ((eq arg :deadline*)
- (setq rtn (org-agenda-get-deadlines t))
- (setq deadline-results (copy-sequence rtn))
- (setq results (append results rtn))))))))
- results))))
+ (setf org-agenda-current-date date)
+ (save-excursion
+ (save-restriction
+ (if (eq buffer org-agenda-restrict)
+ (narrow-to-region org-agenda-restrict-begin
+ org-agenda-restrict-end)
+ (widen))
+ ;; Rationalize ARGS. Also make sure `:deadline' comes
+ ;; first in order to populate DEADLINES before passing it.
+ ;;
+ ;; We use `delq' since `org-uniquify' duplicates ARGS,
+ ;; guarding us from modifying `org-agenda-entry-types'.
+ (setf args (org-uniquify (or args org-agenda-entry-types)))
+ (when (and (memq :scheduled args) (memq :scheduled* args))
+ (setf args (delq :scheduled* args)))
+ (cond
+ ((memq :deadline args)
+ (setf args (cons :deadline
+ (delq :deadline (delq :deadline* args)))))
+ ((memq :deadline* args)
+ (setf args (cons :deadline* (delq :deadline* args)))))
+ ;; Collect list of headlines. Return them flattened.
+ (let ((case-fold-search nil) results deadlines)
+ (dolist (arg args (apply #'nconc (nreverse results)))
+ (pcase arg
+ ((and :todo (guard (org-agenda-today-p date)))
+ (push (org-agenda-get-todos) results))
+ (:timestamp
+ (push (org-agenda-get-blocks) results)
+ (push (org-agenda-get-timestamps deadlines) results))
+ (:sexp
+ (push (org-agenda-get-sexps) results))
+ (:scheduled
+ (push (org-agenda-get-scheduled deadlines) results))
+ (:scheduled*
+ (push (org-agenda-get-scheduled deadlines t) results))
+ (:closed
+ (push (org-agenda-get-progress) results))
+ (:deadline
+ (setf deadlines (org-agenda-get-deadlines))
+ (push deadlines results))
+ (:deadline*
+ (setf deadlines (org-agenda-get-deadlines t))
+ (push deadlines results)))))))))))
(defsubst org-em (x y list)
"Is X or Y a member of LIST?"
@@ -5334,6 +5268,40 @@ the documentation of `org-diary'."
(defvar org-heading-keyword-regexp-format) ; defined in org.el
(defvar org-agenda-sorting-strategy-selected nil)
+(defun org-agenda-entry-get-agenda-timestamp (pom)
+ "Retrieve timestamp information for sorting agenda views.
+Given a point or marker POM, returns a cons cell of the timestamp
+and the timestamp type relevant for the sorting strategy in
+`org-agenda-sorting-strategy-selected'."
+ (let (ts ts-date-type)
+ (save-match-data
+ (cond ((org-em 'scheduled-up 'scheduled-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "SCHEDULED")
+ ts-date-type " scheduled"))
+ ((org-em 'deadline-up 'deadline-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "DEADLINE")
+ ts-date-type " deadline"))
+ ((org-em 'ts-up 'ts-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "TIMESTAMP")
+ ts-date-type " timestamp"))
+ ((org-em 'tsia-up 'tsia-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (org-entry-get pom "TIMESTAMP_IA")
+ ts-date-type " timestamp_ia"))
+ ((org-em 'timestamp-up 'timestamp-down
+ org-agenda-sorting-strategy-selected)
+ (setq ts (or (org-entry-get pom "SCHEDULED")
+ (org-entry-get pom "DEADLINE")
+ (org-entry-get pom "TIMESTAMP")
+ (org-entry-get pom "TIMESTAMP_IA"))
+ ts-date-type ""))
+ (t (setq ts-date-type "")))
+ (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
+ ts-date-type))))
+
(defun org-agenda-get-todos ()
"Return the TODO information for agenda display."
(let* ((props (list 'face nil
@@ -5345,6 +5313,7 @@ the documentation of `org-diary'."
'help-echo
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
+ (case-fold-search nil)
(regexp (format org-heading-keyword-regexp-format
(cond
((and org-select-this-todo-keyword
@@ -5358,7 +5327,8 @@ the documentation of `org-diary'."
"|")
"\\|") "\\)"))
(t org-not-done-regexp))))
- marker priority category category-pos level tags todo-state ts-date ts-date-type
+ marker priority category level tags todo-state
+ ts-date ts-date-type ts-date-pair
ee txt beg end inherited-tags todo-state-end-pos)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5378,36 +5348,10 @@ the documentation of `org-diary'."
(goto-char (match-beginning 2))
(setq marker (org-agenda-new-marker (match-beginning 0))
category (org-get-category)
- ts-date (let (ts)
- (save-match-data
- (cond ((org-em 'scheduled-up 'scheduled-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "SCHEDULED")
- ts-date-type " scheduled"))
- ((org-em 'deadline-up 'deadline-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "DEADLINE")
- ts-date-type " deadline"))
- ((org-em 'ts-up 'ts-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "TIMESTAMP")
- ts-date-type " timestamp"))
- ((org-em 'tsia-up 'tsia-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "TIMESTAMP_IA")
- ts-date-type " timestamp_ia"))
- ((org-em 'timestamp-up 'timestamp-down
- org-agenda-sorting-strategy-selected)
- (setq ts (or (org-entry-get (point) "SCHEDULED")
- (org-entry-get (point) "DEADLINE")
- (org-entry-get (point) "TIMESTAMP")
- (org-entry-get (point) "TIMESTAMP_IA"))
- ts-date-type ""))
- (t (setq ts-date-type "")))
- (when ts (ignore-errors (org-time-string-to-absolute ts)))))
- category-pos (get-text-property (point) 'org-category-position)
- txt (org-trim
- (buffer-substring (match-beginning 2) (match-end 0)))
+ ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
+ ts-date (car ts-date-pair)
+ ts-date-type (cdr ts-date-pair)
+ txt (org-trim (buffer-substring (match-beginning 2) (match-end 0)))
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5421,10 +5365,9 @@ the documentation of `org-diary'."
priority (1+ (org-get-priority txt)))
(org-add-props txt props
'org-marker marker 'org-hd-marker marker
- 'priority priority 'org-category category
+ 'priority priority
'level level
'ts-date ts-date
- 'org-category-position category-pos
'type (concat "todo" ts-date-type) 'todo-state todo-state)
(push txt ee)
(if org-agenda-todo-list-sublevels
@@ -5473,7 +5416,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(cond
((memq org-agenda-todo-ignore-deadlines '(t all)) t)
((eq org-agenda-todo-ignore-deadlines 'far)
- (not (org-deadline-close (match-string 1))))
+ (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))
@@ -5483,7 +5426,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
((numberp org-agenda-todo-ignore-deadlines)
(org-agenda-todo-custom-ignore-p
(match-string 1) org-agenda-todo-ignore-deadlines))
- (t (org-deadline-close (match-string 1)))))
+ (t (org-deadline-close-p (match-string 1)))))
(and org-agenda-todo-ignore-timestamp
(let ((buffer (current-buffer))
(regexp
@@ -5512,24 +5455,27 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(match-string 1) org-agenda-todo-ignore-timestamp))
(t))))))))))
-(defun org-agenda-get-timestamps (&optional deadline-results)
- "Return the date stamp information for agenda display."
+(defun org-agenda-get-timestamps (&optional deadlines)
+ "Return the date stamp information for agenda display.
+Optional argument DEADLINES is a list of deadline items to be
+displayed in agenda view."
(let* ((props (list 'face 'org-agenda-calendar-event
'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'mouse-face 'highlight
'help-echo
- (format "mouse-2 or RET jump to org file %s"
+ (format "mouse-2 or RET jump to Org file %s"
(abbreviate-file-name buffer-file-name))))
- (d1 (calendar-absolute-from-gregorian date))
- mm
+ (current (calendar-absolute-from-gregorian date))
+ (today (org-today))
(deadline-position-alist
- (mapcar (lambda (a) (and (setq mm (get-text-property
- 0 'org-hd-marker a))
- (cons (marker-position mm) a)))
- deadline-results))
- (remove-re org-ts-regexp)
+ (mapcar (lambda (d)
+ (let ((m (get-text-property 0 'org-hd-marker d)))
+ (and m (marker-position m))))
+ deadlines))
+ ;; Match time-stamps set to current date, time-stamps with
+ ;; a repeater, and S-exp time-stamps.
(regexp
(concat
(if org-agenda-include-inactive-timestamps "[[<]" "<")
@@ -5537,97 +5483,120 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(substring
(format-time-string
(car org-time-stamp-formats)
- (apply 'encode-time ; DATE bound by calendar
+ (apply #'encode-time ; DATE bound by calendar
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))
"\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
"\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
- marker hdmarker deadlinep scheduledp clockp closedp inactivep
- donep tmp priority category category-pos level ee txt timestr tags
- b0 b3 e3 head todo-state end-of-match show-all warntime habitp
- inherited-tags ts-date)
+ timestamp-items)
(goto-char (point-min))
- (while (setq end-of-match (re-search-forward regexp nil t))
- (setq b0 (match-beginning 0)
- b3 (match-beginning 3) e3 (match-end 3)
- todo-state (save-match-data (ignore-errors (org-get-todo-state)))
- habitp (and (functionp 'org-is-habit-p) (save-match-data (org-is-habit-p)))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all)))
+ (while (re-search-forward regexp nil t)
+ ;; Skip date ranges, scheduled and deadlines, which are handled
+ ;; specially. Also skip time-stamps before first headline as
+ ;; there would be no entry to add to the agenda. Eventually,
+ ;; ignore clock entries.
(catch :skip
- (and (org-at-date-range-p) (throw :skip nil))
- (org-agenda-skip)
- (if (and (match-end 1)
- (not (= d1 (org-time-string-to-absolute
- (match-string 1) d1 nil show-all
- (current-buffer) b0))))
- (throw :skip nil))
- (if (and e3
- (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
+ (save-match-data
+ (when (or (org-at-date-range-p)
+ (org-at-planning-p)
+ (org-before-first-heading-p)
+ (and org-agenda-include-inactive-timestamps
+ (org-at-clock-log-p)))
(throw :skip nil))
- (setq tmp (buffer-substring (max (point-min)
- (- b0 org-ds-keyword-length))
- b0)
- timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
- inactivep (= (char-after b0) ?\[)
- deadlinep (string-match org-deadline-regexp tmp)
- scheduledp (string-match org-scheduled-regexp tmp)
- closedp (and org-agenda-include-inactive-timestamps
- (string-match org-closed-string tmp))
- clockp (and org-agenda-include-inactive-timestamps
- (or (string-match org-clock-string tmp)
- (string-match "]-+\\'" tmp)))
- warntime (get-text-property (point) 'org-appt-warntime)
- donep (member todo-state org-done-keywords))
- (if (or scheduledp deadlinep closedp clockp
- (and donep org-agenda-skip-timestamp-if-done))
+ (org-agenda-skip))
+ (let* ((pos (match-beginning 0))
+ (repeat (match-string 1))
+ (sexp-entry (match-string 3))
+ (time-stamp (if (or repeat sexp-entry) (match-string 0)
+ (save-excursion
+ (goto-char pos)
+ (looking-at org-ts-regexp-both)
+ (match-string 0))))
+ (todo-state (org-get-todo-state))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (done? (member todo-state org-done-keywords)))
+ ;; Possibly skip done tasks.
+ (when (and done? org-agenda-skip-timestamp-if-done)
(throw :skip t))
- (if (string-match ">" timestr)
- ;; substring should only run to end of time stamp
- (setq timestr (substring timestr 0 (match-end 0))))
- (setq marker (org-agenda-new-marker b0)
- category (org-get-category b0)
- category-pos (get-text-property b0 'org-category-position))
- (save-excursion
- (if (not (re-search-backward org-outline-regexp-bol nil t))
- (throw :skip nil)
- (goto-char (match-beginning 0))
- (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown)
- (assoc (point) deadline-position-alist))
- (throw :skip nil))
- (setq hdmarker (org-agenda-new-marker)
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (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-at nil (not inherited-tags))
- level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
- (setq head (or (match-string 1) ""))
- (setq txt (org-agenda-format-item
- (if inactivep org-agenda-inactive-leader nil)
- head level category tags timestr
- remove-re habitp)))
- (setq priority (org-get-priority txt))
- (org-add-props txt props 'priority priority
- 'org-marker marker 'org-hd-marker hdmarker
- 'org-category category 'date date
- 'level level
- 'ts-date
- (ignore-errors (org-time-string-to-absolute timestr))
- 'org-category-position category-pos
- 'todo-state todo-state
- 'warntime warntime
- 'type "timestamp")
- (push txt ee))
- (if org-agenda-skip-additional-timestamps-same-entry
- (outline-next-heading)
- (goto-char end-of-match))))
- (nreverse ee)))
+ ;; S-exp entry doesn't match current day: skip it.
+ (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
+ (throw :skip nil))
+ (when repeat
+ (let* ((past
+ ;; A repeating time stamp is shown at its base
+ ;; date and every repeated date up to TODAY. If
+ ;; `org-agenda-prefer-last-repeat' is non-nil,
+ ;; however, only the last repeat before today
+ ;; (inclusive) is shown.
+ (org-agenda--timestamp-to-absolute
+ repeat
+ (if (or (> current today)
+ (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ today
+ current)
+ 'past (current-buffer) pos))
+ (future
+ ;; Display every repeated date past TODAY
+ ;; (exclusive) unless
+ ;; `org-agenda-show-future-repeats' is nil. If
+ ;; this variable is set to `next', only display
+ ;; the first repeated date after TODAY
+ ;; (exclusive).
+ (cond
+ ((<= current today) past)
+ ((not org-agenda-show-future-repeats) past)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ repeat base 'future (current-buffer) pos))))))
+ (when (and (/= current past) (/= current future))
+ (throw :skip nil))))
+ (save-excursion
+ (re-search-backward org-outline-regexp-bol nil t)
+ ;; Possibly skip time-stamp when a deadline is set.
+ (when (and org-agenda-skip-timestamp-if-deadline-is-shown
+ (assq (point) deadline-position-alist))
+ (throw :skip nil))
+ (let* ((category (org-get-category pos))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (consp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (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-at nil (not inherited-tags)))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
+ (match-string 1)))
+ (inactive? (= (char-after pos) ?\[))
+ (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
+ (item
+ (org-agenda-format-item
+ (and inactive? org-agenda-inactive-leader)
+ head level category tags time-stamp org-ts-regexp habit?)))
+ (org-add-props item props
+ 'priority (if habit?
+ (org-habit-get-priority (org-habit-parse-todo))
+ (org-get-priority item))
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker)
+ 'date date
+ 'level level
+ 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
+ current)
+ 'todo-state todo-state
+ 'warntime warntime
+ 'type "timestamp")
+ (push item timestamp-items))))
+ (when org-agenda-skip-additional-timestamps-same-entry
+ (outline-next-heading))))
+ (nreverse timestamp-items)))
(defun org-agenda-get-sexps ()
"Return the sexp information for agenda display."
@@ -5638,7 +5607,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(format "mouse-2 or RET jump to org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp "^&?%%(")
- marker category extra category-pos level ee txt tags entry
+ marker category extra level ee txt tags entry
result beg b sexp sexp-entry todo-state warntime inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5657,7 +5626,6 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq marker (org-agenda-new-marker beg)
level (make-string (org-reduced-level (org-outline-level)) ? )
category (org-get-category beg)
- category-pos (get-text-property beg 'org-category-position)
inherited-tags
(or (eq org-agenda-show-inherited-tags 'always)
(and (listp org-agenda-show-inherited-tags)
@@ -5682,38 +5650,33 @@ This function is invoked if `org-agenda-todo-ignore-deadlines',
(setq txt "SEXP entry returned empty string"))
(setq txt (org-agenda-format-item extra txt level category tags 'time))
(org-add-props txt props 'org-marker marker
- 'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos
- 'level level
- 'type "sexp" 'warntime warntime)
+ 'date date 'todo-state todo-state
+ 'level level 'type "sexp" 'warntime warntime)
(push txt ee)))))
(nreverse ee)))
;; Calendar sanity: define some functions that are independent of
;; `calendar-date-style'.
-;; Normally I would like to use ISO format when calling the diary functions,
-;; but to make sure we still have Emacs 22 compatibility we bind
-;; also `european-calendar-style' and use european format
(defun org-anniversary (year month day &optional mark)
"Like `diary-anniversary', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-anniversary day month year mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-anniversary year month day mark))))
(defun org-cyclic (N year month day &optional mark)
"Like `diary-cyclic', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-cyclic N day month year mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-cyclic N year month day mark))))
(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
"Like `diary-block', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-block D1 M1 Y1 D2 M2 Y2 mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
(defun org-date (year month day &optional mark)
"Like `diary-date', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-date day month year mark))))
+ (with-no-warnings
+ (let ((calendar-date-style 'iso))
+ (diary-date year month day mark))))
;; Define the `org-class' function
(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
@@ -5740,26 +5703,6 @@ then those holidays will be skipped."
(delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
entry)))
-(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
- "Like `org-class', but honor `calendar-date-style'.
-The order of the first 2 times 3 arguments depends on the variable
-`calendar-date-style' or, if that is not defined, on `european-calendar-style'.
-So for American calendars, give this as MONTH DAY YEAR, for European as
-DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
-DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
-is any number of ISO weeks in the block period for which the item should
-be skipped.
-
-This function is here only for backward compatibility and it is deprecated,
-please use `org-class' instead."
- (let* ((date1 (org-order-calendar-date-args m1 d1 y1))
- (date2 (org-order-calendar-date-args m2 d2 y2)))
- (org-class
- (nth 2 date1) (car date1) (nth 1 date1)
- (nth 2 date2) (car date2) (nth 1 date2)
- dayname skip-weeks)))
-(make-obsolete 'org-diary-class 'org-class "")
-
(defalias 'org-get-closed 'org-agenda-get-progress)
(defun org-agenda-get-progress ()
"Return the logged TODO entries for agenda display."
@@ -5780,7 +5723,8 @@ please use `org-class' instead."
(list
(if (memq 'closed items) (concat "\\<" org-closed-string))
(if (memq 'clock items) (concat "\\<" org-clock-string))
- (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
+ (if (memq 'state items)
+ (format "- State \"%s\".*?" org-todo-regexp)))))
(parts-re (if parts (mapconcat 'identity parts "\\|")
(error "`org-agenda-log-mode-items' is empty")))
(regexp (concat
@@ -5794,7 +5738,7 @@ please use `org-class' instead."
(list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
1 11))))
(org-agenda-search-headline-for-time nil)
- marker hdmarker priority category category-pos level tags closedp
+ marker hdmarker priority category level tags closedp
statep clockp state ee txt extra timestr rest clocked inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -5806,7 +5750,6 @@ please use `org-class' instead."
clockp (not (or closedp statep))
state (and statep (match-string 2))
category (org-get-category (match-beginning 0))
- category-pos (get-text-property (match-beginning 0) 'org-category-position)
timestr (buffer-substring (match-beginning 0) (point-at-eol)))
(when (string-match "\\]" timestr)
;; substring should only run to end of time stamp
@@ -5858,9 +5801,7 @@ please use `org-class' instead."
(setq priority 100000)
(org-add-props txt props
'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
- 'priority priority 'org-category category
- 'org-category-position category-pos
- 'level level
+ 'priority priority 'level level
'type "closed" 'date date
'undone-face 'org-warning 'done-face 'org-agenda-done)
(push txt ee))
@@ -5871,23 +5812,22 @@ please use `org-class' instead."
"Add overlays, showing issues with clocking.
See also the user option `org-agenda-clock-consistency-checks'."
(interactive)
- (let* ((org-time-clocksum-use-effort-durations nil)
- (pl org-agenda-clock-consistency-checks)
+ (let* ((pl org-agenda-clock-consistency-checks)
(re (concat "^[ \t]*"
org-clock-string
"[ \t]+"
- "\\(\\[.*?\\]\\)" ; group 1 is first stamp
+ "\\(\\[.*?\\]\\)" ; group 1 is first stamp
"\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
(tlstart 0.)
(tlend 0.)
- (maxtime (org-hh:mm-string-to-minutes
+ (maxtime (org-duration-to-minutes
(or (plist-get pl :max-duration) "24:00")))
- (mintime (org-hh:mm-string-to-minutes
+ (mintime (org-duration-to-minutes
(or (plist-get pl :min-duration) 0)))
- (maxgap (org-hh:mm-string-to-minutes
+ (maxgap (org-duration-to-minutes
;; default 30:00 means never complain
(or (plist-get pl :max-gap) "30:00")))
- (gapok (mapcar 'org-hh:mm-string-to-minutes
+ (gapok (mapcar #'org-duration-to-minutes
(plist-get pl :gap-ok-around)))
(def-face (or (plist-get pl :default-face)
'((:background "DarkRed") (:foreground "white"))))
@@ -5913,22 +5853,20 @@ See also the user option `org-agenda-clock-consistency-checks'."
(setq ts (match-string 1)
te (match-string 3)
ts (float-time
- (apply 'encode-time (org-parse-time-string ts)))
+ (apply #'encode-time (org-parse-time-string ts)))
te (float-time
- (apply 'encode-time (org-parse-time-string te)))
+ (apply #'encode-time (org-parse-time-string te)))
dt (- te ts))))
(cond
((> dt (* 60 maxtime))
;; a very long clocking chunk
(setq issue (format "Clocking interval is very long: %s"
- (org-minutes-to-clocksum-string
- (floor (/ (float dt) 60.))))
+ (org-duration-from-minutes (floor (/ dt 60.))))
face (or (plist-get pl :long-face) face)))
((< dt (* 60 mintime))
;; a very short clocking chunk
(setq issue (format "Clocking interval is very short: %s"
- (org-minutes-to-clocksum-string
- (floor (/ (float dt) 60.))))
+ (org-duration-from-minutes (floor (/ dt 60.))))
face (or (plist-get pl :short-face) face)))
((and (> tlend 0) (< ts tlend))
;; Two clock entries are overlapping
@@ -6001,312 +5939,342 @@ specification like [h]h:mm."
(regexp (if with-hour
org-deadline-time-hour-regexp
org-deadline-time-regexp))
- (todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- (dl0 (car org-agenda-deadline-leaders))
- (dl1 (nth 1 org-agenda-deadline-leaders))
- (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
- d2 diff dfrac wdays pos pos1 category category-pos level
- tags suppress-prewarning ee txt head face s todo-state
- show-all upcomingp donep timestr warntime inherited-tags ts-date)
+ (today (org-today))
+ (today? (org-agenda-today-p date)) ; DATE bound by calendar.
+ (current (calendar-absolute-from-gregorian date))
+ deadline-items)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
+ (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
(org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1))
- (setq suppress-prewarning
- (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled
- (let ((item (buffer-substring (point-at-bol)
- (point-at-eol))))
- (save-match-data
- (and (string-match
- org-scheduled-time-regexp item)
- (match-string 1 item)))))))
+ (let* ((s (match-string 1))
+ (pos (1- (match-beginning 1)))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (done? (member todo-state org-done-keywords))
+ (sexp? (string-prefix-p "%%" s))
+ ;; DEADLINE is the deadline date for the entry. It is
+ ;; either the base date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (deadline
(cond
- ((not ds) nil)
- ;; The current item has a scheduled date (in ds), so
- ;; evaluate its prewarning lead time.
- ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
- ;; Use global prewarning-restart lead time.
- org-agenda-skip-deadline-prewarning-if-scheduled)
- ((eq org-agenda-skip-deadline-prewarning-if-scheduled
- 'pre-scheduled)
- ;; Set prewarning to no earlier than scheduled.
- (min (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-deadline-warning-days))
- ;; Set prewarning to deadline.
- (t 0))))
- (setq wdays (if suppress-prewarning
- (let ((org-deadline-warning-days suppress-prewarning))
- (org-get-wdays s))
- (org-get-wdays s))
- dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
- upcomingp (and todayp (> diff 0)))
- ;; When to show a deadline in the calendar:
- ;; If the expiration is within wdays warning time.
- ;; Past-due deadlines are only shown on the current date
- (if (and (or (and (<= diff wdays)
- (and todayp (not org-agenda-only-exact-dates)))
- (= diff 0)))
- (save-excursion
- ;; (setq todo-state (org-get-todo-state))
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
- (or org-agenda-skip-deadline-if-done
- (not (= diff 0))))
- (setq txt nil)
- (setq category (org-get-category)
- warntime (get-text-property (point) 'org-appt-warntime)
- category-pos (get-text-property (point) 'org-category-position))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (setq inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (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-at pos1 (not inherited-tags)))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n")
- (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (cond ((= diff 0) dl0)
- ((> diff 0)
- (if (functionp dl1)
- (funcall dl1 diff date)
- (format dl1 diff)))
- (t
- (if (functionp dl2)
- (funcall dl2 diff date)
- (format dl2 (if (string= dl2 dl1)
- diff (abs diff))))))
- head level category tags
- (if (not (= diff 0)) nil timestr)))))
- (when txt
- (setq face (org-agenda-deadline-face dfrac))
- (org-add-props txt props
- 'org-marker (org-agenda-new-marker pos)
- 'warntime warntime
- 'level level
- 'ts-date d2
- 'org-hd-marker (org-agenda-new-marker pos1)
- 'priority (+ (- diff)
- (org-get-priority txt))
- 'org-category category
- 'org-category-position category-pos
- 'todo-state todo-state
- 'type (if upcomingp "upcoming-deadline" "deadline")
- 'date (if upcomingp date d2)
- 'face (if donep 'org-agenda-done face)
- 'undone-face face 'done-face 'org-agenda-done)
- (push txt ee))))))
- (nreverse ee)))
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to DEADLINE.
+ (repeat
+ (cond
+ (sexp? deadline)
+ ((<= current today) deadline)
+ ((not org-agenda-show-future-repeats) deadline)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- deadline current))
+ (suppress-prewarning
+ (let ((scheduled
+ (and org-agenda-skip-deadline-prewarning-if-scheduled
+ (org-entry-get nil "SCHEDULED"))))
+ (cond
+ ((not scheduled) nil)
+ ;; The current item has a scheduled date, so
+ ;; evaluate its prewarning lead time.
+ ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
+ ;; Use global prewarning-restart lead time.
+ org-agenda-skip-deadline-prewarning-if-scheduled)
+ ((eq org-agenda-skip-deadline-prewarning-if-scheduled
+ 'pre-scheduled)
+ ;; Set pre-warning to no earlier than SCHEDULED.
+ (min (- deadline
+ (org-agenda--timestamp-to-absolute scheduled))
+ org-deadline-warning-days))
+ ;; Set pre-warning to deadline.
+ (t 0))))
+ (wdays (if suppress-prewarning
+ (let ((org-deadline-warning-days suppress-prewarning))
+ (org-get-wdays s))
+ (org-get-wdays s))))
+ (cond
+ ;; Only display deadlines at their base date, at future
+ ;; repeat occurrences or in today agenda.
+ ((= current deadline) nil)
+ ((= current repeat) nil)
+ ((not today?) (throw :skip nil))
+ ;; Upcoming deadline: display within warning period WDAYS.
+ ((> deadline current) (when (> diff wdays) (throw :skip nil)))
+ ;; Overdue deadline: warn about it for
+ ;; `org-deadline-past-days' duration.
+ (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
+ ;; Possibly skip done tasks.
+ (when (and done?
+ (or org-agenda-skip-deadline-if-done
+ (/= deadline current)))
+ (throw :skip nil))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((category (org-get-category))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (buffer-substring (point) (line-end-position)))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (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-at nil (not inherited-tags)))
+ (time
+ (cond
+ ;; No time of day designation if it is only
+ ;; a reminder.
+ ((and (/= current deadline) (/= current repeat)) nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ ;; Insert appropriate suffixes before deadlines.
+ ;; Those only apply to today agenda.
+ (pcase-let ((`(,now ,future ,past)
+ org-agenda-deadline-leaders))
+ (cond
+ ((and today? (< deadline today)) (format past (- diff)))
+ ((and today? (> deadline today)) (format future diff))
+ (t now)))
+ head level category tags time))
+ (face (org-agenda-deadline-face
+ (- 1 (/ (float diff) (max wdays 1)))))
+ (upcoming? (and today? (> deadline today)))
+ (warntime (get-text-property (point) 'org-appt-warntime)))
+ (org-add-props item props
+ 'org-marker (org-agenda-new-marker pos)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
+ 'warntime warntime
+ 'level level
+ 'ts-date deadline
+ 'priority
+ ;; Adjust priority to today reminders about deadlines.
+ ;; Overdue deadlines get the highest priority
+ ;; increase, then imminent deadlines and eventually
+ ;; more distant deadlines.
+ (let ((adjust (if today? (- diff) 0)))
+ (+ adjust (org-get-priority item)))
+ 'todo-state todo-state
+ 'type (if upcoming? "upcoming-deadline" "deadline")
+ 'date (if upcoming? date deadline)
+ 'face (if done? 'org-agenda-done face)
+ 'undone-face face
+ 'done-face 'org-agenda-done)
+ (push item deadline-items))))))
+ (nreverse deadline-items)))
(defun org-agenda-deadline-face (fraction)
"Return the face to displaying a deadline item.
FRACTION is what fraction of the head-warning time has passed."
- (let ((faces org-agenda-deadline-faces) f)
- (catch 'exit
- (while (setq f (pop faces))
- (if (>= fraction (car f)) (throw 'exit (cdr f)))))))
+ (assoc-default fraction org-agenda-deadline-faces #'<=))
-(defun org-agenda-get-scheduled (&optional deadline-results with-hour)
+(defun org-agenda-get-scheduled (&optional deadlines with-hour)
"Return the scheduled information for agenda display.
-When WITH-HOUR is non-nil, only return scheduled items with
-an hour specification like [h]h:mm."
+Optional argument DEADLINES is a list of deadline items to be
+displayed in agenda view. When WITH-HOUR is non-nil, only return
+scheduled items with an hour specification like [h]h:mm."
(let* ((props (list 'org-not-done-regexp org-not-done-regexp
'org-todo-regexp org-todo-regexp
'org-complex-heading-regexp org-complex-heading-regexp
'done-face 'org-agenda-done
'mouse-face 'highlight
'help-echo
- (format "mouse-2 or RET jump to org file %s"
+ (format "mouse-2 or RET jump to Org file %s"
(abbreviate-file-name buffer-file-name))))
(regexp (if with-hour
org-scheduled-time-hour-regexp
org-scheduled-time-regexp))
- (todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- mm
- (deadline-position-alist
- (mapcar (lambda (a) (and (setq mm (get-text-property
- 0 'org-hd-marker a))
- (cons (marker-position mm) a)))
- deadline-results))
- d2 diff pos pos1 category category-pos level tags donep
- ee txt head pastschedp todo-state face timestr s habitp show-all
- did-habit-check-p warntime inherited-tags ts-date suppress-delay
- ddays)
+ (today (org-today))
+ (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
+ (current (calendar-absolute-from-gregorian date))
+ (deadline-pos
+ (mapcar (lambda (d)
+ (let ((m (get-text-property 0 'org-hd-marker d)))
+ (and m (marker-position m))))
+ deadlines))
+ scheduled-items)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(catch :skip
+ (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
(org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1)
- warntime (get-text-property (point) 'org-appt-warntime))
- (setq pastschedp (and todayp (< diff 0)))
- (setq did-habit-check-p nil)
- (setq suppress-delay
- (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
- (let ((item (buffer-substring (point-at-bol) (point-at-eol))))
- (save-match-data
- (and (string-match
- org-deadline-time-regexp item)
- (match-string 1 item)))))))
+ (let* ((s (match-string 1))
+ (pos (1- (match-beginning 1)))
+ (todo-state (save-match-data (org-get-todo-state)))
+ (donep (member todo-state org-done-keywords))
+ (sexp? (string-prefix-p "%%" s))
+ ;; SCHEDULE is the scheduled date for the entry. It is
+ ;; either the bare date or the last repeat, according
+ ;; to `org-agenda-prefer-last-repeat'.
+ (schedule
(cond
- ((not ds) nil)
- ;; The current item has a deadline date (in ds), so
- ;; evaluate its delay time.
- ((integerp org-agenda-skip-scheduled-delay-if-deadline)
- ;; Use global delay time.
- (- org-agenda-skip-scheduled-delay-if-deadline))
- ((eq org-agenda-skip-scheduled-delay-if-deadline
- 'post-deadline)
- ;; Set delay to no later than deadline.
- (min (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-scheduled-delay-days))
- (t 0))))
- (setq ddays (if suppress-delay
- (let ((org-scheduled-delay-days suppress-delay))
- (org-get-wdays s t t))
- (org-get-wdays s t)))
- ;; Use a delay of 0 when there is a repeater and the delay is
- ;; of the form --3d
- (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
- (< (org-time-string-to-absolute s)
- (org-time-string-to-absolute
- s d2 'past nil (current-buffer) pos)))
- (setq ddays 0))
- ;; When to show a scheduled item in the calendar:
- ;; If it is on or past the date.
- (when (or (and (> ddays 0) (= diff (- ddays)))
- (and (zerop ddays) (= diff 0))
- (and (< (+ diff ddays) 0)
- (< (abs diff) org-scheduled-past-days)
- (and todayp (not org-agenda-only-exact-dates)))
- ;; org-is-habit-p uses org-entry-get, which is expansive
- ;; so we go extra mile to only call it once
- (and todayp
- (boundp 'org-habit-show-all-today)
- org-habit-show-all-today
- (setq did-habit-check-p t)
- (setq habitp (and (functionp 'org-is-habit-p)
- (org-is-habit-p)))))
- (save-excursion
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
+ (sexp? (org-agenda--timestamp-to-absolute s current))
+ ((or (eq org-agenda-prefer-last-repeat t)
+ (member todo-state org-agenda-prefer-last-repeat))
+ (org-agenda--timestamp-to-absolute
+ s today 'past (current-buffer) pos))
+ (t (org-agenda--timestamp-to-absolute s))))
+ ;; REPEAT is the future repeat closest from CURRENT,
+ ;; according to `org-agenda-show-future-repeats'. If
+ ;; the latter is nil, or if the time stamp has no
+ ;; repeat part, default to SCHEDULE.
+ (repeat
+ (cond
+ (sexp? schedule)
+ ((<= current today) schedule)
+ ((not org-agenda-show-future-repeats) schedule)
+ (t
+ (let ((base (if (eq org-agenda-show-future-repeats 'next)
+ (1+ today)
+ current)))
+ (org-agenda--timestamp-to-absolute
+ s base 'future (current-buffer) pos)))))
+ (diff (- current schedule))
+ (warntime (get-text-property (point) 'org-appt-warntime))
+ (pastschedp (< schedule today))
+ (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
+ (suppress-delay
+ (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
+ (org-entry-get nil "DEADLINE"))))
+ (cond
+ ((not deadline) nil)
+ ;; The current item has a deadline date, so
+ ;; evaluate its delay time.
+ ((integerp org-agenda-skip-scheduled-delay-if-deadline)
+ ;; Use global delay time.
+ (- org-agenda-skip-scheduled-delay-if-deadline))
+ ((eq org-agenda-skip-scheduled-delay-if-deadline
+ 'post-deadline)
+ ;; Set delay to no later than DEADLINE.
+ (min (- schedule
+ (org-agenda--timestamp-to-absolute deadline))
+ org-scheduled-delay-days))
+ (t 0))))
+ (ddays
+ (cond
+ ;; Nullify delay when a repeater triggered already
+ ;; and the delay is of the form --Xd.
+ ((and (string-match-p "--[0-9]+[hdwmy]" s)
+ (> current schedule))
+ 0)
+ (suppress-delay
+ (let ((org-scheduled-delay-days suppress-delay))
+ (org-get-wdays s t t)))
+ (t (org-get-wdays s t)))))
+ ;; Display scheduled items at base date (SCHEDULE), today if
+ ;; scheduled before the current date, and at any repeat past
+ ;; today. However, skip delayed items and items that have
+ ;; been displayed for more than `org-scheduled-past-days'.
+ (unless (and todayp
+ habitp
+ (bound-and-true-p org-habit-show-all-today))
+ (when (or (and (> ddays 0) (< diff ddays))
+ (> diff org-scheduled-past-days)
+ (> schedule current)
+ (and (/= current schedule)
+ (/= current today)
+ (/= current repeat)))
+ (throw :skip nil)))
+ ;; Possibly skip done tasks.
+ (when (and donep
(or org-agenda-skip-scheduled-if-done
- (not (= diff 0))
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq txt nil)
- (setq habitp (if did-habit-check-p habitp
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq category (org-get-category)
- category-pos (get-text-property (point) 'org-category-position))
- (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
- 'repeated-after-deadline)
- (org-get-deadline-time (point))
- (<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
- (throw :skip nil))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (if habitp
- (if (or (not org-habit-show-habits)
- (and (not todayp)
- (boundp 'org-habit-show-habits-only-for-today)
- org-habit-show-habits-only-for-today))
- (throw :skip nil))
- (if (and
- (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
- (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
- pastschedp))
- (setq mm (assoc pos1 deadline-position-alist)))
- (throw :skip nil)))
- (setq inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (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-at nil (not inherited-tags)))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n") (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (if (= diff 0)
- (car org-agenda-scheduled-leaders)
- (format (nth 1 org-agenda-scheduled-leaders)
- (- 1 diff)))
- head level category tags
- (if (not (= diff 0)) nil timestr)
- nil habitp))))
- (when txt
- (setq face
+ (/= schedule current)))
+ (throw :skip nil))
+ ;; Skip entry if it already appears as a deadline, per
+ ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
+ ;; doesn't apply to habits.
+ (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
+ ((guard
+ (or (not (memq (line-beginning-position 0) deadline-pos))
+ habitp))
+ nil)
+ (`repeated-after-deadline
+ (let ((deadline (time-to-days
+ (org-get-deadline-time (point)))))
+ (and (<= schedule deadline) (> current deadline))))
+ (`not-today pastschedp)
+ (`t t)
+ (_ nil))
+ (throw :skip nil))
+ ;; Skip habits if `org-habit-show-habits' is nil, or if we
+ ;; only show them for today. Also skip done habits.
+ (when (and habitp
+ (or donep
+ (not (bound-and-true-p org-habit-show-habits))
+ (and (not todayp)
+ (bound-and-true-p
+ org-habit-show-habits-only-for-today))))
+ (throw :skip nil))
+ (save-excursion
+ (re-search-backward "^\\*+[ \t]+" nil t)
+ (goto-char (match-end 0))
+ (let* ((category (org-get-category))
+ (inherited-tags
+ (or (eq org-agenda-show-inherited-tags 'always)
+ (and (listp org-agenda-show-inherited-tags)
+ (memq 'agenda org-agenda-show-inherited-tags))
+ (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-at nil (not inherited-tags)))
+ (level (make-string (org-reduced-level (org-outline-level))
+ ?\s))
+ (head (buffer-substring (point) (line-end-position)))
+ (time
(cond
- ((and (not habitp) pastschedp)
- 'org-scheduled-previously)
- (todayp 'org-scheduled-today)
- (t 'org-scheduled))
- habitp (and habitp (org-habit-parse-todo)))
- (org-add-props txt props
+ ;; No time of day designation if it is only
+ ;; a reminder.
+ ((and (/= current schedule) (/= current repeat)) nil)
+ ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
+ (concat (substring s (match-beginning 1)) " "))
+ (t 'time)))
+ (item
+ (org-agenda-format-item
+ (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
+ ;; Show a reminder of a past scheduled today.
+ (if (and todayp pastschedp)
+ (format past diff)
+ first))
+ head level category tags time nil habitp))
+ (face (cond ((and (not habitp) pastschedp)
+ 'org-scheduled-previously)
+ (todayp 'org-scheduled-today)
+ (t 'org-scheduled)))
+ (habitp (and habitp (org-habit-parse-todo))))
+ (org-add-props item props
'undone-face face
'face (if donep 'org-agenda-done face)
'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker pos1)
+ 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
'type (if pastschedp "past-scheduled" "scheduled")
- 'date (if pastschedp d2 date)
- 'ts-date d2
+ 'date (if pastschedp schedule date)
+ 'ts-date schedule
'warntime warntime
'level level
- 'priority (if habitp
- (org-habit-get-priority habitp)
- (+ 94 (- 5 diff) (org-get-priority txt)))
- 'org-category category
- 'category-position category-pos
+ 'priority (if habitp (org-habit-get-priority habitp)
+ (+ 99 diff (org-get-priority item)))
'org-habit-p habitp
'todo-state todo-state)
- (push txt ee))))))
- (nreverse ee)))
+ (push item scheduled-items))))))
+ (nreverse scheduled-items)))
(defun org-agenda-get-blocks ()
"Return the date-range information for agenda display."
@@ -6320,7 +6288,7 @@ an hour specification like [h]h:mm."
(abbreviate-file-name buffer-file-name))))
(regexp org-tr-regexp)
(d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category category-pos
+ marker hdmarker ee txt d1 d2 s1 s2 category
level todo-state tags pos head donep inherited-tags)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
@@ -6331,8 +6299,26 @@ an hour specification like [h]h:mm."
(end-time (match-string 2)))
(setq s1 (match-string 1)
s2 (match-string 2)
- d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
- d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
+ d1 (time-to-days
+ (condition-case err
+ (org-time-string-to-time s1)
+ (error
+ (error
+ "Bad timestamp %S at %d in buffer %S\nError was: %s"
+ s1
+ pos
+ (current-buffer)
+ (error-message-string err)))))
+ d2 (time-to-days
+ (condition-case err
+ (org-time-string-to-time s2)
+ (error
+ (error
+ "Bad timestamp %S at %d in buffer %S\nError was: %s"
+ s2
+ pos
+ (current-buffer)
+ (error-message-string err))))))
(if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
;; Only allow days between the limits, because the normal
;; date stamps will catch the limits.
@@ -6341,9 +6327,8 @@ an hour specification like [h]h:mm."
(setq donep (member todo-state org-done-keywords))
(if (and donep org-agenda-skip-timestamp-if-done)
(throw :skip t))
- (setq marker (org-agenda-new-marker (point)))
- (setq category (org-get-category)
- category-pos (get-text-property (point) 'org-category-position))
+ (setq marker (org-agenda-new-marker (point))
+ category (org-get-category))
(if (not (re-search-backward org-outline-regexp-bol nil t))
(throw :skip nil)
(goto-char (match-beginning 0))
@@ -6358,7 +6343,7 @@ an hour specification like [h]h:mm."
tags (org-get-tags-at nil (not inherited-tags)))
(setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
+ (looking-at "\\*+[ \t]+\\(.*\\)")
(setq head (match-string 1))
(let ((remove-re
(if org-agenda-remove-timeranges-from-blocks
@@ -6385,8 +6370,7 @@ an hour specification like [h]h:mm."
'type "block" 'date date
'level level
'todo-state todo-state
- 'priority (org-get-priority txt) 'org-category category
- 'org-category-position category-pos)
+ 'priority (org-get-priority txt))
(push txt ee))))
(goto-char pos)))
;; Sort the entries by expiration date.
@@ -6413,11 +6397,11 @@ The flag is set if the currently compiled format contains a `%b'.")
(defun org-agenda-get-category-icon (category)
"Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
- (dolist (entry org-agenda-category-icon-alist)
- (when (org-string-match-p (car entry) category)
+ (cl-dolist (entry org-agenda-category-icon-alist)
+ (when (string-match-p (car entry) category)
(if (listp (cadr entry))
- (return (cadr entry))
- (return (apply 'create-image (cdr entry)))))))
+ (cl-return (cadr entry))
+ (cl-return (apply #'create-image (cdr entry)))))))
(defun org-agenda-format-item (extra txt &optional level category tags dotime
remove-re habitp)
@@ -6444,8 +6428,8 @@ Any match of REMOVE-RE will be removed from TXT."
;; buffer
(let* ((bindings (car org-prefix-format-compiled))
(formatter (cadr org-prefix-format-compiled)))
- (loop for (var value) in bindings
- do (set var value))
+ (cl-loop for (var value) in bindings
+ do (set var value))
(save-match-data
;; Diary entries sometimes have extra whitespace at the beginning
(setq txt (org-trim txt))
@@ -6457,9 +6441,6 @@ Any match of REMOVE-RE will be removed from TXT."
org-agenda-hide-tags-regexp))
(let* ((category (or category
- (if (stringp org-category)
- org-category
- (and org-category (symbol-name org-category)))
(if buffer-file-name
(file-name-sans-extension
(file-name-nondirectory buffer-file-name))
@@ -6468,15 +6449,18 @@ Any match of REMOVE-RE will be removed from TXT."
(category-icon (if category-icon
(propertize " " 'display category-icon)
""))
+ (effort (and (not (string= txt ""))
+ (get-text-property 1 'effort txt)))
;; time, tag, effort are needed for the eval of the prefix format
(tag (if tags (nth (1- (length tags)) tags) ""))
- time effort neffort
+ (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
+ time
(ts (if dotime (concat
(if (stringp dotime) dotime "")
(and org-agenda-search-headline-for-time txt))))
(time-of-day (and dotime (org-get-time-of-day ts)))
stamp plain s0 s1 s2 rtn srp l
- duration thecategory breadcrumbs)
+ duration breadcrumbs)
(and (derived-mode-p 'org-mode) buffer-file-name
(add-to-list 'org-agenda-contributing-files buffer-file-name))
(when (and dotime time-of-day)
@@ -6503,21 +6487,21 @@ Any match of REMOVE-RE will be removed from TXT."
(if s1 (setq s1 (org-get-time-of-day s1 'string t)))
(if s2 (setq s2 (org-get-time-of-day s2 'string t)))
- ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
- (let (org-time-clocksum-use-effort-durations)
- (when (and s1 (not s2) org-agenda-default-appointment-duration)
- (setq s2
- (org-minutes-to-clocksum-string
- (+ (org-hh:mm-string-to-minutes s1)
- org-agenda-default-appointment-duration)))))
+ ;; Try to set s2 if s1 and
+ ;; `org-agenda-default-appointment-duration' are set
+ (when (and s1 (not s2) org-agenda-default-appointment-duration)
+ (setq s2
+ (org-duration-from-minutes
+ (+ (org-duration-to-minutes s1 t)
+ org-agenda-default-appointment-duration)
+ nil t)))
;; Compute the duration
(when s2
- (setq duration (- (org-hh:mm-string-to-minutes s2)
- (org-hh:mm-string-to-minutes s1)))))
+ (setq duration (- (org-duration-to-minutes s2)
+ (org-duration-to-minutes s1)))))
- (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- txt)
+ (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
;; Tags are in the string
(if (or (eq org-agenda-remove-tags t)
(and org-agenda-remove-tags
@@ -6527,16 +6511,6 @@ Any match of REMOVE-RE will be removed from TXT."
(concat (make-string (max (- 50 (length txt)) 1) ?\ )
(match-string 2 txt))
t t txt))))
- (when (derived-mode-p 'org-mode)
- (setq effort (ignore-errors (get-text-property 0 'org-effort txt))))
-
- ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as
- ;; current buffer, so move this check outside of above
- (if effort
- (setq neffort (org-duration-string-to-minutes effort)
- effort (setq effort (concat "[" effort "]")))
- ;; prevent erroring out with %e format when there is no effort
- (setq effort ""))
(when remove-re
(while (string-match remove-re txt)
@@ -6558,12 +6532,11 @@ Any match of REMOVE-RE will be removed from TXT."
(s1 (concat
(org-agenda-time-of-day-to-ampm-maybe s1)
(if org-agenda-timegrid-use-ampm
- "........ "
- "......")))
+ (concat time-grid-trailing-characters " ")
+ time-grid-trailing-characters)))
(t ""))
extra (or (and (not habitp) extra) "")
category (if (symbolp category) (symbol-name category) category)
- thecategory (copy-sequence category)
level (or level ""))
(if (string-match org-bracket-link-regexp category)
(progn
@@ -6584,14 +6557,12 @@ Any match of REMOVE-RE will be removed from TXT."
;; And finally add the text properties
(remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
(org-add-props rtn nil
- 'org-category (if thecategory (downcase thecategory) category)
+ 'org-category category
'tags (mapcar 'org-downcase-keep-props tags)
'org-highest-priority org-highest-priority
'org-lowest-priority org-lowest-priority
'time-of-day time-of-day
'duration duration
- 'effort effort
- 'effort-minutes neffort
'breadcrumbs breadcrumbs
'txt txt
'level level
@@ -6605,7 +6576,7 @@ Any match of REMOVE-RE will be removed from TXT."
The modified list may contain inherited tags, and tags matched by
`org-agenda-hide-tags-regexp' will be removed."
(when (or add-inherited hide-re)
- (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt)
+ (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt)
(setq txt (substring txt 0 (match-beginning 0))))
(setq tags
(delq nil
@@ -6655,8 +6626,8 @@ TODAYP is t when the current agenda view is on today."
(let* ((have (delq nil (mapcar
(lambda (x) (get-text-property 1 'time-of-day x))
list)))
- (string (nth 1 org-agenda-time-grid))
- (gridtimes (nth 2 org-agenda-time-grid))
+ (string (nth 3 org-agenda-time-grid))
+ (gridtimes (nth 1 org-agenda-time-grid))
(req (car org-agenda-time-grid))
(remove (member 'remove-match req))
new time)
@@ -6710,12 +6681,12 @@ and stored in the variable `org-prefix-format-compiled'."
c (or (match-string 3 s) "")
opt (match-beginning 1)
start (1+ (match-beginning 0)))
- (if (equal var 'time) (setq org-prefix-has-time t))
- (if (equal var 'tag) (setq org-prefix-has-tag t))
- (if (equal var 'effort) (setq org-prefix-has-effort t))
- (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
+ (if (eq var 'time) (setq org-prefix-has-time t))
+ (if (eq var 'tag) (setq org-prefix-has-tag t))
+ (if (eq var 'effort) (setq org-prefix-has-effort t))
+ (if (eq var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
(setq f (concat "%" (match-string 2 s) "s"))
- (when (equal var 'category)
+ (when (eq var 'category)
(setq org-prefix-category-length
(floor (abs (string-to-number (match-string 2 s)))))
(setq org-prefix-category-max-length
@@ -6727,10 +6698,13 @@ and stored in the variable `org-prefix-format-compiled'."
(setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
(if opt
(setq varform
- `(if (equal "" ,var)
+ `(if (or (equal "" ,var) (equal nil ,var))
""
- (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
- (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
+ (format ,f (concat ,var ,c))))
+ (setq varform
+ `(format ,f (if (or (equal ,var "")
+ (equal ,var nil)) ""
+ (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
(setq s (replace-match "%s" t nil s))
(push varform vars))
(setq vars (nreverse vars))
@@ -6817,7 +6791,7 @@ The optional argument TYPE tells the agenda type."
(t org-agenda-max-tags)))
(max-entries (cond ((listp org-agenda-max-entries)
(cdr (assoc type org-agenda-max-entries)))
- (t org-agenda-max-entries))) l)
+ (t org-agenda-max-entries))))
(when org-agenda-before-sorting-filter-function
(setq list
(delq nil
@@ -6827,13 +6801,17 @@ The optional argument TYPE tells the agenda type."
list (mapcar 'identity (sort list 'org-entries-lessp)))
(when max-effort
(setq list (org-agenda-limit-entries
- list 'effort-minutes max-effort 'identity)))
+ list 'effort-minutes max-effort
+ (lambda (e) (or e (if org-sort-agenda-noeffort-is-high
+ 32767 -1))))))
(when max-todo
(setq list (org-agenda-limit-entries list 'todo-state max-todo)))
(when max-tags
(setq list (org-agenda-limit-entries list 'tags max-tags)))
(when max-entries
(setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
+ (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
+ (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
(mapconcat 'identity list "\n")))
(defun org-agenda-limit-entries (list prop limit &optional fn)
@@ -6845,26 +6823,39 @@ The optional argument TYPE tells the agenda type."
(delq nil
(mapcar
(lambda (e)
- (let ((pval (funcall fun (get-text-property 1 prop e))))
+ (let ((pval (funcall
+ fun (get-text-property (1- (length e))
+ prop e))))
(if pval (setq lim (+ lim pval)))
(cond ((and pval (<= lim (abs limit))) e)
((and include (not pval)) e))))
list)))
list)))
-(defun org-agenda-limit-interactively ()
+(defun org-agenda-limit-interactively (remove)
"In agenda, interactively limit entries to various maximums."
- (interactive)
- (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
- (num (string-to-number (read-from-minibuffer "How many? "))))
- (cond ((equal max ?e)
- (let ((org-agenda-max-entries num)) (org-agenda-redo)))
- ((equal max ?t)
- (let ((org-agenda-max-todos num)) (org-agenda-redo)))
- ((equal max ?T)
- (let ((org-agenda-max-tags num)) (org-agenda-redo)))
- ((equal max ?E)
- (let ((org-agenda-max-effort num)) (org-agenda-redo)))))
+ (interactive "P")
+ (if remove
+ (progn (setq org-agenda-max-entries nil
+ org-agenda-max-todos nil
+ org-agenda-max-tags nil
+ org-agenda-max-effort nil)
+ (org-agenda-redo))
+ (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
+ (msg (cond ((= max ?E) "How many minutes? ")
+ ((= max ?e) "How many entries? ")
+ ((= max ?t) "How many TODO entries? ")
+ ((= max ?T) "How many tagged entries? ")
+ (t (user-error "Wrong input"))))
+ (num (string-to-number (read-from-minibuffer msg))))
+ (cond ((equal max ?e)
+ (let ((org-agenda-max-entries num)) (org-agenda-redo)))
+ ((equal max ?t)
+ (let ((org-agenda-max-todos num)) (org-agenda-redo)))
+ ((equal max ?T)
+ (let ((org-agenda-max-tags num)) (org-agenda-redo)))
+ ((equal max ?E)
+ (let ((org-agenda-max-effort num)) (org-agenda-redo))))))
(org-agenda-fit-window-to-buffer))
(defun org-agenda-highlight-todo (x)
@@ -6903,32 +6894,43 @@ The optional argument TYPE tells the agenda type."
(list 'face (org-get-todo-face (match-string 2 x)))
x)
(when (match-end 1)
- (setq x (concat (substring x 0 (match-end 1))
- (format org-agenda-todo-keyword-format
- (match-string 2 x))
- (org-add-props " " (text-properties-at 0 x))
- (substring x (match-end 3)))))))
+ (setq x
+ (concat
+ (substring x 0 (match-end 1))
+ (format org-agenda-todo-keyword-format
+ (match-string 2 x))
+ ;; Remove `display' property as the icon could leak
+ ;; on the white space.
+ (org-add-props " " (org-plist-delete (text-properties-at 0 x)
+ 'display))
+ (substring x (match-end 3)))))))
x)))
-(defsubst org-cmp-priority (a b)
- "Compare the priorities of string A and B."
- (let ((pa (or (get-text-property 1 'priority a) 0))
- (pb (or (get-text-property 1 'priority b) 0)))
+(defsubst org-cmp-values (a b property)
+ "Compare the numeric value of text PROPERTY for string A and B."
+ (let ((pa (or (get-text-property (1- (length a)) property a) 0))
+ (pb (or (get-text-property (1- (length b)) property b) 0)))
(cond ((> pa pb) +1)
((< pa pb) -1))))
(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))
- (ea (or (get-text-property 1 'effort-minutes a) def))
- (eb (or (get-text-property 1 'effort-minutes b) def)))
+ ;; `effort-minutes' property is not directly accessible from
+ ;; the strings, but is stored as a property in `txt'.
+ (ea (or (get-text-property
+ 0 'effort-minutes (get-text-property 0 'txt a))
+ def))
+ (eb (or (get-text-property
+ 0 'effort-minutes (get-text-property 0 'txt b))
+ def)))
(cond ((> ea eb) +1)
((< ea eb) -1))))
(defsubst org-cmp-category (a b)
"Compare the string values of categories of strings A and B."
- (let ((ca (or (get-text-property 1 'org-category a) ""))
- (cb (or (get-text-property 1 'org-category b) "")))
+ (let ((ca (or (get-text-property (1- (length a)) 'org-category a) ""))
+ (cb (or (get-text-property (1- (length b)) 'org-category b) "")))
(cond ((string-lessp ca cb) -1)
((string-lessp cb ca) +1))))
@@ -6959,7 +6961,8 @@ The optional argument TYPE tells the agenda type."
(let* ((pla (text-property-any 0 (length a) 'org-heading t a))
(plb (text-property-any 0 (length b) 'org-heading t b))
(ta (and pla (substring a pla)))
- (tb (and plb (substring b plb))))
+ (tb (and plb (substring b plb)))
+ (case-fold-search nil))
(when pla
(if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
"\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
@@ -7038,8 +7041,11 @@ their type."
(time-up (and (org-em 'time-up 'time-down ss)
(org-cmp-time a b)))
(time-down (if time-up (- time-up) nil))
+ (stats-up (and (org-em 'stats-up 'stats-down ss)
+ (org-cmp-values a b 'org-stats)))
+ (stats-down (if stats-up (- stats-up) nil))
(priority-up (and (org-em 'priority-up 'priority-down ss)
- (org-cmp-priority a b)))
+ (org-cmp-values a b 'priority)))
(priority-down (if priority-up (- priority-up) nil))
(effort-up (and (org-em 'effort-up 'effort-down ss)
(org-cmp-effort a b)))
@@ -7080,15 +7086,32 @@ their type."
'face 'org-agenda-restriction-lock)
(overlay-put org-agenda-restriction-lock-overlay
'help-echo "Agendas are currently limited to this subtree.")
-(org-detach-overlay org-agenda-restriction-lock-overlay)
+(delete-overlay org-agenda-restriction-lock-overlay)
+
+(defun org-agenda-set-restriction-lock-from-agenda (arg)
+ "Set the restriction lock to the agenda item at point from within the agenda.
+When called with a `\\[universal-argument]' prefix, restrict to
+the file which contains the item.
+Argument ARG is the prefix argument."
+ (interactive "P")
+ (unless (derived-mode-p 'org-agenda-mode)
+ (user-error "Not in an Org agenda buffer"))
+ (let* ((marker (or (org-get-at-bol 'org-marker)
+ (org-agenda-error)))
+ (buffer (marker-buffer marker))
+ (pos (marker-position marker)))
+ (with-current-buffer buffer
+ (goto-char pos)
+ (org-agenda-set-restriction-lock arg))))
;;;###autoload
(defun org-agenda-set-restriction-lock (&optional type)
"Set restriction lock for agenda, to current subtree or file.
-Restriction will be the file if TYPE is `file', or if TYPE is the
-universal prefix `(4)', or if the cursor is before the first headline
+Restriction will be the file if TYPE is `file', or if type is the
+universal prefix \\='(4), or if the cursor is before the first headline
in the file. Otherwise, restriction will be to the current subtree."
(interactive "P")
+ (org-agenda-remove-restriction-lock 'noupdate)
(and (equal type '(4)) (setq type 'file))
(setq type (cond
(type type)
@@ -7125,8 +7148,8 @@ in the file. Otherwise, restriction will be to the current subtree."
(defun org-agenda-remove-restriction-lock (&optional noupdate)
"Remove the agenda restriction lock."
(interactive "P")
- (org-detach-overlay org-agenda-restriction-lock-overlay)
- (org-detach-overlay org-speedbar-restriction-lock-overlay)
+ (delete-overlay org-agenda-restriction-lock-overlay)
+ (delete-overlay org-speedbar-restriction-lock-overlay)
(setq org-agenda-overriding-restriction nil)
(setq org-agenda-restrict nil)
(put 'org-agenda-files 'org-restrict nil)
@@ -7138,7 +7161,9 @@ in the file. Otherwise, restriction will be to the current subtree."
(defun org-agenda-maybe-redo ()
"If there is any window showing the agenda view, update it."
- (let ((w (get-buffer-window org-agenda-buffer-name t))
+ (let ((w (get-buffer-window (or org-agenda-this-buffer-name
+ org-agenda-buffer-name)
+ t))
(w0 (selected-window)))
(when w
(select-window w)
@@ -7154,87 +7179,85 @@ in the file. Otherwise, restriction will be to the current subtree."
(defun org-agenda-check-type (error &rest types)
"Check if agenda buffer is of allowed type.
If ERROR is non-nil, throw an error, otherwise just return nil.
-Allowed types are 'agenda 'timeline 'todo 'tags 'search."
- (if (not org-agenda-type)
- (error "No Org agenda currently displayed")
- (if (memq org-agenda-type types)
- t
- (if error
- (error "Not allowed in %s-type agenda buffers" org-agenda-type)
- nil))))
+Allowed types are `agenda' `todo' `tags' `search'."
+ (cond ((not org-agenda-type)
+ (error "No Org agenda currently displayed"))
+ ((memq org-agenda-type types) t)
+ (error
+ (error "Not allowed in %s-type agenda buffers" org-agenda-type))
+ (t nil)))
(defun org-agenda-Quit ()
- "Exit the agenda and kill buffers loaded by `org-agenda'.
-Also restore the window configuration."
+ "Exit the agenda, killing the agenda buffer.
+Like `org-agenda-quit', but kill the buffer even when
+`org-agenda-sticky' is non-nil."
(interactive)
- (if org-agenda-columns-active
- (org-columns-quit)
- (let ((buf (current-buffer)))
- (if (eq org-agenda-window-setup 'other-frame)
- (progn
- (org-agenda-reset-markers)
- (kill-buffer buf)
- (org-columns-remove-overlays)
- (setq org-agenda-archives-mode nil)
- (delete-frame))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window))
- (org-agenda-reset-markers)
- (kill-buffer buf)
- (org-columns-remove-overlays)
- (setq org-agenda-archives-mode nil)))
- (setq org-agenda-buffer nil)
- ;; Maybe restore the pre-agenda window configuration.
- (and org-agenda-restore-windows-after-quit
- (not (eq org-agenda-window-setup 'other-frame))
- org-agenda-pre-window-conf
- (set-window-configuration org-agenda-pre-window-conf)
- (setq org-agenda-pre-window-conf nil))))
+ (org-agenda--quit))
(defun org-agenda-quit ()
- "Exit the agenda and restore the window configuration.
-When `org-agenda-sticky' is non-nil, only bury the agenda."
+ "Exit the agenda.
+
+When `org-agenda-sticky' is non-nil, bury the agenda buffer
+instead of killing it.
+
+When `org-agenda-restore-windows-after-quit' is non-nil, restore
+the pre-agenda window configuration.
+
+When column view is active, exit column view instead of the
+agenda."
(interactive)
- (if (and (eq org-indirect-buffer-display 'other-window)
- org-last-indirect-buffer)
- (let ((org-last-indirect-window
- (get-buffer-window org-last-indirect-buffer)))
- (if org-last-indirect-window
- (delete-window org-last-indirect-window))))
+ (org-agenda--quit org-agenda-sticky))
+
+(defun org-agenda--quit (&optional bury)
(if org-agenda-columns-active
(org-columns-quit)
- (if org-agenda-sticky
- (let ((buf (current-buffer)))
- (if (eq org-agenda-window-setup 'other-frame)
- (progn
- (delete-frame))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window)))
+ (let ((wconf org-agenda-pre-window-conf)
+ (buf (current-buffer))
+ (org-agenda-last-indirect-window
+ (and (eq org-indirect-buffer-display 'other-window)
+ org-agenda-last-indirect-buffer
+ (get-buffer-window org-agenda-last-indirect-buffer))))
+ (cond
+ ((eq org-agenda-window-setup 'other-frame)
+ (delete-frame))
+ ((and org-agenda-restore-windows-after-quit
+ wconf)
+ ;; Maybe restore the pre-agenda window configuration. Reset
+ ;; `org-agenda-pre-window-conf' before running
+ ;; `set-window-configuration', which loses the current buffer.
+ (setq org-agenda-pre-window-conf nil)
+ (set-window-configuration wconf))
+ (t
+ (when org-agenda-last-indirect-window
+ (delete-window org-agenda-last-indirect-window))
+ (and (not (eq org-agenda-window-setup 'current-window))
+ (not (one-window-p))
+ (delete-window))))
+ (if bury
+ ;; Set the agenda buffer as the current buffer instead of
+ ;; passing it as an argument to `bury-buffer' so that
+ ;; `bury-buffer' removes it from the window.
(with-current-buffer buf
- (bury-buffer)
- ;; Maybe restore the pre-agenda window configuration.
- (and org-agenda-restore-windows-after-quit
- (not (eq org-agenda-window-setup 'other-frame))
- org-agenda-pre-window-conf
- (set-window-configuration org-agenda-pre-window-conf)
- (setq org-agenda-pre-window-conf nil))))
- (org-agenda-Quit))))
+ (bury-buffer))
+ (kill-buffer buf)
+ (setq org-agenda-archives-mode nil
+ org-agenda-buffer nil)))))
(defun org-agenda-exit ()
- "Exit the agenda and restore the window configuration.
-Also kill Org-mode buffers loaded by `org-agenda'. Org-mode
-buffers visited directly by the user will not be touched."
+ "Exit the agenda, killing Org buffers loaded by the agenda.
+Like `org-agenda-Quit', but kill any buffers that were created by
+the agenda. Org buffers visited directly by the user will not be
+touched. Also, exit the agenda even if it is in column view."
(interactive)
+ (when org-agenda-columns-active
+ (org-columns-quit))
(org-release-buffers org-agenda-new-buffers)
(setq org-agenda-new-buffers nil)
(org-agenda-Quit))
(defun org-agenda-kill-all-agenda-buffers ()
"Kill all buffers in `org-agenda-mode'.
-This is used when toggling sticky agendas.
-You can also explicitly invoke it with `C-c a C-k'."
+This is used when toggling sticky agendas."
(interactive)
(let (blist)
(dolist (buf (buffer-list))
@@ -7267,6 +7290,9 @@ in the agenda."
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(re-filter org-agenda-regexp-filter)
(re-preset (get 'org-agenda-regexp-filter :preset-filter))
+ (effort-filter org-agenda-effort-filter)
+ (effort-preset (get 'org-agenda-effort-filter :preset-filter))
+ (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
@@ -7284,6 +7310,7 @@ in the agenda."
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
(put 'org-agenda-regexp-filter :preset-filter nil)
+ (put 'org-agenda-effort-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
@@ -7294,19 +7321,23 @@ in the agenda."
org-agenda-tag-filter tag-filter
org-agenda-category-filter cat-filter
org-agenda-regexp-filter re-filter
+ org-agenda-effort-filter effort-filter
org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
(put 'org-agenda-regexp-filter :preset-filter re-preset)
+ (put 'org-agenda-effort-filter :preset-filter effort-preset)
(let ((tag (or tag-filter tag-preset))
(cat (or cat-filter cat-preset))
- (re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (effort (or effort-filter effort-preset))
+ (re (or re-filter re-preset)))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
+ (when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
(and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
- (and cols (org-called-interactively-p 'any) (org-agenda-columns))
+ (and cols (called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
@@ -7326,32 +7357,36 @@ With a prefix argument, do so in all agenda buffers."
(defvar org-agenda-filtered-by-category nil)
(defun org-agenda-filter-by-category (strip)
- "Keep only those lines in the agenda buffer that have a specific category.
-The category is that of the current line."
+ "Filter lines in the agenda buffer that have a specific category.
+The category is that of the current line.
+Without prefix argument, keep only the lines of that category.
+With a prefix argument, exclude the lines of that category.
+"
(interactive "P")
(if (and org-agenda-filtered-by-category
org-agenda-category-filter)
(org-agenda-filter-show-all-cat)
- (let ((cat (org-no-properties (get-text-property (point) 'org-category))))
+ (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
(cond
((and cat strip)
(org-agenda-filter-apply
(push (concat "-" cat) org-agenda-category-filter) 'category))
- ((and cat)
+ (cat
(org-agenda-filter-apply
(setq org-agenda-category-filter
(list (concat "+" cat))) 'category))
(t (error "No category at point"))))))
(defun org-find-top-headline (&optional pos)
- "Find the topmost parent headline and return it."
+ "Find the topmost parent headline and return it.
+POS when non-nil is the marker or buffer position to start the
+search from."
(save-excursion
- (with-current-buffer (if pos (marker-buffer pos) (current-buffer))
- (if pos (goto-char pos))
- ;; Skip up to the topmost parent
- (while (ignore-errors (outline-up-heading 1) t))
- (ignore-errors
- (nth 4 (org-heading-components))))))
+ (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
+ (when pos (goto-char pos))
+ ;; Skip up to the topmost parent.
+ (while (org-up-heading-safe))
+ (ignore-errors (nth 4 (org-heading-components))))))
(defvar org-agenda-filtered-by-top-headline nil)
(defun org-agenda-filter-by-top-headline (strip)
@@ -7386,6 +7421,49 @@ With two prefix arguments, remove the regexp filters."
(org-agenda-filter-show-all-re)
(message "Regexp filter removed")))
+(defvar org-agenda-effort-filter nil)
+(defun org-agenda-filter-by-effort (strip)
+ "Filter agenda entries by effort.
+With no prefix argument, keep entries matching the effort condition.
+With one prefix argument, filter out entries matching the condition.
+With two prefix arguments, remove the effort filters."
+ (interactive "P")
+ (cond
+ ((member strip '(nil 4))
+ (let* ((efforts (split-string
+ (or (cdr (assoc (concat org-effort-property "_ALL")
+ org-global-properties))
+ "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.
+ (allowed-keys (if (null efforts) nil
+ (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
+ (number-sequence 1 (length efforts)))))
+ (op nil))
+ (while (not (memq op '(?< ?> ?=)))
+ (setq op (read-char-exclusive "Effort operator? (> = or <)")))
+ ;; Select appropriate duration. Ignore non-digit characters.
+ (let ((prompt
+ (apply #'format
+ (concat "Effort %c "
+ (mapconcat (lambda (s) (concat "[%d]" s))
+ efforts
+ " "))
+ op allowed-keys))
+ (eff -1))
+ (while (not (memq eff allowed-keys))
+ (message prompt)
+ (setq eff (- (read-char-exclusive) 48)))
+ (setq org-agenda-effort-filter
+ (list (concat (if strip "-" "+")
+ (char-to-string op)
+ ;; Numbering is 1 2 3 ... 9 0, but we want
+ ;; 0 1 2 ... 8 9.
+ (nth (mod (1- eff) 10) efforts)))))
+ (org-agenda-filter-apply org-agenda-effort-filter 'effort)))
+ (t (org-agenda-filter-show-all-effort)
+ (message "Effort filter removed"))))
+
(defun org-agenda-filter-remove-all ()
"Remove all filters from the current agenda buffer."
(interactive)
@@ -7397,15 +7475,24 @@ With two prefix arguments, remove the regexp filters."
(org-agenda-filter-show-all-re))
(when org-agenda-top-headline-filter
(org-agenda-filter-show-all-top-filter))
+ (when org-agenda-effort-filter
+ (org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
+
The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+
+With a `\\[universal-argument]' prefix, exclude the agenda search.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
+i.e. don't
+filter on all its group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag
+should be used to exclude the search - the interactive user can
+also press `-' or `+' to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7413,54 +7500,35 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
- (efforts (org-split-string
- (or (cdr (assoc (concat org-effort-property "_ALL")
- org-global-properties))
- "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"
- "")))
- (effort-op org-agenda-filter-effort-default-operator)
- (effort-prompt "")
+ org-tag-alist-for-agenda ""))
+ (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q)
+ (string-to-list tag-chars)))
+ (exclude (or exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
- maybe-refresh a n tag)
+ a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
- (setq char (read-char-exclusive)))
- (when (member char '(?< ?> ?= ??))
- ;; An effort operator
- (setq effort-op (char-to-string char))
- (setq alist nil) ; to make sure it will be interpreted as effort.
- (unless (equal char ??)
- (loop for i from 0 to 9 do
- (setq effort-prompt
- (concat
- effort-prompt " ["
- (if (= i 9) "0" (int-to-string (1+ i)))
- "]" (nth i efforts))))
- (message "Effort%s: %s " effort-op effort-prompt)
+ (while (not (memq char valid-char-list))
+ (message
+ "%s by tag [%s ]:tag-char, [TAB]:tag, %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter")
+ tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
(setq char (read-char-exclusive))
- (when (or (< char ?0) (> char ?9))
- (error "Need 1-9,0 to select effort"))))
- (when (equal char ?\t)
+ ;; Excluding or filtering down
+ (cond ((eq char ?-) (setq exclude t))
+ ((eq char ?+) (setq exclude nil)))))
+ (when (eq char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
- (org-set-local 'org-global-tags-completion-table
- (org-global-tags-completion-table)))
+ (setq-local org-global-tags-completion-table
+ (org-global-tags-completion-table)))
(let ((completion-ignore-case t))
- (setq tag (org-icompleting-read
- "Tag: " org-global-tags-completion-table))))
+ (setq tag (completing-read
+ "Tag: " org-global-tags-completion-table nil t))))
(cond
- ((equal char ?\r)
+ ((eq char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-tag-filter nil)
@@ -7469,39 +7537,27 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
- (setq maybe-refresh t))
- ((equal char ?/)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
+ ((eq char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (setq maybe-refresh t))
- ((equal char ?. )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
+ ((eq char ?.)
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)
- (setq maybe-refresh t))
- ((or (equal char ?\ )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
+ ((or (eq char ?\s)
(setq a (rassoc char alist))
- (and (>= char ?0) (<= char ?9)
- (setq n (if (= char ?0) 9 (- char ?0 1))
- tag (concat effort-op (nth n efforts))
- a (cons tag nil)))
- (and (= char ??)
- (setq tag "?eff")
- a (cons tag nil))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)
- (setq maybe-refresh t))
- (t (error "Invalid tag selection character %c" char)))
- (when maybe-refresh
- (org-agenda-redo))))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ (t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
"Get a list of all tags currently represented in the agenda."
@@ -7514,13 +7570,11 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
- "Refine the current filter. See `org-agenda-filter-by-tag'."
- (interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
- "Create the form that tests a line for agenda filter."
+(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)
(cond
;; Tag filter
@@ -7530,28 +7584,11 @@ to switch to narrowing."
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (if (string-match "[<=>?]" x)
- (setq nf01 (org-agenda-filter-effort-form x))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags)))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7573,9 +7610,35 @@ to switch to narrowing."
(if (equal "-" (substring x 0 1))
(setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
(setq f1 (list 'string-match (substring x 1) 'txt)))
- (push f1 f))))
+ (push f1 f)))
+ ;; Effort filter
+ ((eq type 'effort)
+ (setq filter
+ (delete-dups
+ (append (get 'org-agenda-effort-filter :preset-filter)
+ filter)))
+ (dolist (x filter)
+ (push (org-agenda-filter-effort-form x) f))))
(cons 'and (nreverse f))))
+(defun org-agenda-filter-make-matcher-tag-exp (tags op)
+ "Return a form associated to tag-expression TAGS.
+Build a form testing a line for agenda filter for
+tag-expressions. OP is an operator of type CHAR that allows the
+function to set the right switches in the returned form."
+ (let (form)
+ ;; Any of the expressions can match if OP is +, all must match if
+ ;; the operator is -.
+ (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
+ (let* ((tag (substring x 1))
+ (f (cond
+ ((string= "" tag) '(not tags))
+ ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
+ ;; TAG is a regexp.
+ (list 'org-match-any-p (substring tag 1 -1) 'tags))
+ (t (list 'member (downcase tag) 'tags)))))
+ (push (if (eq op ?-) (list 'not f) f) form)))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7587,16 +7650,17 @@ E looks like \"+<2:25\"."
((equal op ??) op)
(t '=)))
(list 'org-agenda-compare-effort (list 'quote op)
- (org-duration-string-to-minutes e))))
+ (org-duration-to-minutes e))))
(defun org-agenda-compare-effort (op value)
"Compare the effort of the current line with VALUE, using OP.
If the line does not have an effort defined, return nil."
- (let ((eff (org-get-at-bol 'effort-minutes)))
- (if (equal op ??)
- (not eff)
- (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
- value))))
+ ;; `effort-minutes' property cannot be extracted directly from
+ ;; 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))
+ value)))
(defun org-agenda-filter-expand-tags (filter &optional no-operator)
"Expand group tags in FILTER for the agenda.
@@ -7616,12 +7680,14 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
- "Set FILTER as the new agenda filter and apply it."
+(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."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if 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))
+ (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
@@ -7633,13 +7699,9 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
- cat (get-text-property (point) 'org-category)
- txt (get-text-property (point) 'txt))
+ (setq tags (org-get-at-bol 'tags)
+ cat (org-get-at-eol 'org-category 1)
+ txt (org-get-at-bol 'txt))
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-hide-line type))
(beginning-of-line 2))
@@ -7692,6 +7754,8 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(org-agenda-remove-filter 'tag))
(defun org-agenda-filter-show-all-re nil
(org-agenda-remove-filter 'regexp))
+(defun org-agenda-filter-show-all-effort nil
+ (org-agenda-remove-filter 'effort))
(defun org-agenda-filter-show-all-cat nil
(org-agenda-remove-filter 'category))
(defun org-agenda-filter-show-all-top-filter nil
@@ -7719,7 +7783,7 @@ Negative selection means regexp must not match for selection of an entry."
(org-agenda-manipulate-query ?\}))
(defun org-agenda-manipulate-query (char)
(cond
- ((memq org-agenda-type '(timeline agenda))
+ ((eq org-agenda-type 'agenda)
(let ((org-agenda-include-inactive-timestamps t))
(org-agenda-redo))
(message "Display now includes inactive timestamps as well"))
@@ -7782,7 +7846,7 @@ Negative selection means regexp must not match for selection of an entry."
(defun org-agenda-goto-today ()
"Go to today."
(interactive)
- (org-agenda-check-type t 'timeline 'agenda)
+ (org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args))
(tdpos (text-property-any (point-min) (point-max) 'org-today t)))
@@ -7790,7 +7854,7 @@ Negative selection means regexp must not match for selection of an entry."
(tdpos (goto-char tdpos))
((eq org-agenda-type 'agenda)
(let* ((sd (org-agenda-compute-starting-span
- (org-today) (or curspan org-agenda-ndays org-agenda-span)))
+ (org-today) (or curspan org-agenda-span)))
(org-agenda-overriding-arguments args))
(setf (nth 1 org-agenda-overriding-arguments) sd)
(org-agenda-redo)
@@ -7803,27 +7867,40 @@ Negative selection means regexp must not match for selection of an entry."
(text-property-any (point-min) (point-max) 'org-today t)
(text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
(and (get-text-property (min (1- (point-max)) (point)) 'org-series)
- (org-agenda-goto-block-beginning))
+ (org-agenda-backward-block))
(point-min))))
-(defun org-agenda-goto-block-beginning ()
- "Go the agenda block beginning."
+(defun org-agenda-backward-block ()
+ "Move backward by one agenda block."
(interactive)
- (if (not (derived-mode-p 'org-agenda-mode))
- (error "Cannot execute this command outside of org-agenda-mode buffers")
- (let (dest)
- (save-excursion
- (unless (looking-at "\\'")
- (forward-char))
- (let* ((prop 'org-agenda-structural-header)
- (p (previous-single-property-change (point) prop))
- (n (next-single-property-change (or (and (looking-at "\\`") 1)
- (1- (point))) prop)))
- (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p))))))
- (if (not dest)
- (error "Cannot find the beginning of the blog")
- (goto-char dest)
- (move-beginning-of-line 1)))))
+ (org-agenda-forward-block 'backward))
+
+(defun org-agenda-forward-block (&optional backward)
+ "Move forward by one agenda block.
+When optional argument BACKWARD is set, go backward"
+ (interactive)
+ (cond ((not (derived-mode-p 'org-agenda-mode))
+ (user-error
+ "Cannot execute this command outside of org-agenda-mode buffers"))
+ ((looking-at (if backward "\\`" "\\'"))
+ (message "Already at the %s block" (if backward "first" "last")))
+ (t (let ((pos (prog1 (point)
+ (ignore-errors (if backward (backward-char 1)
+ (move-end-of-line 1)))))
+ (f (if backward
+ 'previous-single-property-change
+ 'next-single-property-change))
+ moved dest)
+ (while (and (setq dest (funcall
+ f (point) 'org-agenda-structural-header))
+ (not (get-text-property
+ (point) 'org-agenda-structural-header)))
+ (setq moved t)
+ (goto-char dest))
+ (if moved (move-beginning-of-line 1)
+ (goto-char (if backward (point-min) (point-max)))
+ (move-beginning-of-line 1)
+ (message "No %s block" (if backward "previous" "further")))))))
(defun org-agenda-later (arg)
"Go forward in time by the current span.
@@ -7877,71 +7954,77 @@ With prefix ARG, go backward that many times the current span."
(message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
- (let ((a (read-char-exclusive)))
- (case a
- (?\ (call-interactively 'org-agenda-reset-view))
- (?d (call-interactively 'org-agenda-day-view))
- (?w (call-interactively 'org-agenda-week-view))
- (?t (call-interactively 'org-agenda-fortnight-view))
- (?m (call-interactively 'org-agenda-month-view))
- (?y (call-interactively 'org-agenda-year-view))
- (?l (call-interactively 'org-agenda-log-mode))
- (?L (org-agenda-log-mode '(4)))
- (?c (org-agenda-log-mode 'clockcheck))
- ((?F ?f) (call-interactively 'org-agenda-follow-mode))
- (?a (call-interactively 'org-agenda-archives-mode))
- (?A (org-agenda-archives-mode 'files))
- ((?R ?r) (call-interactively 'org-agenda-clockreport-mode))
- ((?E ?e) (call-interactively 'org-agenda-entry-text-mode))
- (?G (call-interactively 'org-agenda-toggle-time-grid))
- (?D (call-interactively 'org-agenda-toggle-diary))
- (?\! (call-interactively 'org-agenda-toggle-deadlines))
- (?\[ (let ((org-agenda-include-inactive-timestamps t))
- (org-agenda-check-type t 'timeline 'agenda)
- (org-agenda-redo))
- (message "Display now includes inactive timestamps as well"))
- (?q (message "Abort"))
- (otherwise (error "Invalid key" )))))
+ (pcase (read-char-exclusive)
+ (?\ (call-interactively 'org-agenda-reset-view))
+ (?d (call-interactively 'org-agenda-day-view))
+ (?w (call-interactively 'org-agenda-week-view))
+ (?t (call-interactively 'org-agenda-fortnight-view))
+ (?m (call-interactively 'org-agenda-month-view))
+ (?y (call-interactively 'org-agenda-year-view))
+ (?l (call-interactively 'org-agenda-log-mode))
+ (?L (org-agenda-log-mode '(4)))
+ (?c (org-agenda-log-mode 'clockcheck))
+ ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
+ (?a (call-interactively 'org-agenda-archives-mode))
+ (?A (org-agenda-archives-mode 'files))
+ ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
+ ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode))
+ (?G (call-interactively 'org-agenda-toggle-time-grid))
+ (?D (call-interactively 'org-agenda-toggle-diary))
+ (?\! (call-interactively 'org-agenda-toggle-deadlines))
+ (?\[ (let ((org-agenda-include-inactive-timestamps t))
+ (org-agenda-check-type t 'agenda)
+ (org-agenda-redo))
+ (message "Display now includes inactive timestamps as well"))
+ (?q (message "Abort"))
+ (key (user-error "Invalid key: %s" key))))
(defun org-agenda-reset-view ()
"Switch to default view for agenda."
(interactive)
- (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span)))
+ (org-agenda-change-time-span org-agenda-span))
+
(defun org-agenda-day-view (&optional day-of-month)
"Switch to daily view for agenda.
With argument DAY-OF-MONTH, switch to that day of the month."
(interactive "P")
(org-agenda-change-time-span 'day day-of-month))
+
(defun org-agenda-week-view (&optional iso-week)
- "Switch to daily view for agenda.
+ "Switch to weekly view for agenda.
With argument ISO-WEEK, switch to the corresponding ISO week.
-If ISO-WEEK has more then 2 digits, only the last two encode the
-week. Any digits before this encode a year. So 200712 means
-week 12 of year 2007. Years in the range 1938-2037 can also be
-written as 2-digit years."
+If ISO-WEEK has more then 2 digits, only the last two encode
+the week. Any digits before this encode a year. So 200712
+means week 12 of year 2007. Years ranging from 70 years ago
+to 30 years in the future can also be written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'week iso-week))
+
(defun org-agenda-fortnight-view (&optional iso-week)
- "Switch to daily view for agenda.
+ "Switch to fortnightly view for agenda.
With argument ISO-WEEK, switch to the corresponding ISO week.
-If ISO-WEEK has more then 2 digits, only the last two encode the
-week. Any digits before this encode a year. So 200712 means
-week 12 of year 2007. Years in the range 1938-2037 can also be
-written as 2-digit years."
+If ISO-WEEK has more then 2 digits, only the last two encode
+the week. Any digits before this encode a year. So 200712
+means week 12 of year 2007. Years ranging from 70 years ago
+to 30 years in the future can also be written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'fortnight iso-week))
+
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
-With argument MONTH, switch to that month."
+With argument MONTH, switch to that month. If MONTH has more
+then 2 digits, only the last two encode the month. Any digits
+before this encode a year. So 200712 means December year 2007.
+Years ranging from 70 years ago to 30 years in the future can
+also be written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'month month))
+
(defun org-agenda-year-view (&optional year)
"Switch to yearly view for agenda.
-With argument YEAR, switch to that year.
-If MONTH has more then 2 digits, only the last two encode the
-month. Any digits before this encode a year. So 200712 means
-December year 2007. Years in the range 1938-2037 can also be
-written as 2-digit years."
+With argument YEAR, switch to that year. Years ranging from 70
+years ago to 30 years in the future can also be written as
+2-digit years."
(interactive "P")
(when year
(setq year (org-small-year-to-year year)))
@@ -7999,7 +8082,7 @@ so that the date SD will be in that range."
(setq y1 (org-small-year-to-year (/ n 100))
n (mod n 100)))
(setq sd
- (calendar-absolute-from-iso
+ (calendar-iso-to-absolute
(list n 1
(or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
((eq span 'month)
@@ -8017,7 +8100,7 @@ so that the date SD will be in that range."
(defun org-agenda-next-date-line (&optional arg)
"Jump to the next line indicating a date in agenda buffer."
(interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(beginning-of-line 1)
;; This does not work if user makes date format that starts with a blank
(if (looking-at "^\\S-") (forward-char 1))
@@ -8030,7 +8113,7 @@ so that the date SD will be in that range."
(defun org-agenda-previous-date-line (&optional arg)
"Jump to the previous line indicating a date in agenda buffer."
(interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(beginning-of-line 1)
(if (not (re-search-backward "^\\S-" nil t arg))
(error "No previous date before this line in this buffer")))
@@ -8045,7 +8128,7 @@ so that the date SD will be in that range."
(defun org-unhighlight ()
"Detach overlay INDEX."
- (org-detach-overlay org-hl))
+ (delete-overlay org-hl))
(defun org-unhighlight-once ()
"Remove the highlight from its position, and this function from the hook."
@@ -8102,11 +8185,14 @@ so that the date SD will be in that range."
(defun org-agenda-log-mode (&optional special)
"Toggle log mode in an agenda buffer.
+
With argument SPECIAL, show all possible log items, not only the ones
configured in `org-agenda-log-mode-items'.
-With a double `C-u' prefix arg, show *only* log items, nothing else."
+
+With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
+log items, nothing else."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(setq org-agenda-show-log
(cond
((equal special '(16)) 'only)
@@ -8118,8 +8204,7 @@ With a double `C-u' prefix arg, show *only* log items, nothing else."
(setq org-agenda-start-with-log-mode org-agenda-show-log)
(org-agenda-set-mode-name)
(org-agenda-redo)
- (message "Log mode is %s"
- (if org-agenda-show-log "on" "off")))
+ (message "Log mode is %s" (if org-agenda-show-log "on" "off")))
(defun org-agenda-archives-mode (&optional with-files)
"Toggle inclusion of items in trees marked with :ARCHIVE:.
@@ -8191,7 +8276,7 @@ When called with a prefix argument, include all archive files as well."
(t ""))
(if (or org-agenda-category-filter
(get 'org-agenda-category-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " <"
(mapconcat
'identity
@@ -8204,7 +8289,7 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Category used in filtering")) "")
(if (or org-agenda-tag-filter
(get 'org-agenda-tag-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " {"
(mapconcat
'identity
@@ -8215,9 +8300,22 @@ When called with a prefix argument, include all archive files as well."
"}")
'face 'org-agenda-filter-tags
'help-echo "Tags used in filtering")) "")
+ (if (or org-agenda-effort-filter
+ (get 'org-agenda-effort-filter :preset-filter))
+ '(:eval (propertize
+ (concat " {"
+ (mapconcat
+ 'identity
+ (append
+ (get 'org-agenda-effort-filter :preset-filter)
+ org-agenda-effort-filter)
+ "")
+ "}")
+ 'face 'org-agenda-filter-effort
+ 'help-echo "Effort conditions used in filtering")) "")
(if (or org-agenda-regexp-filter
(get 'org-agenda-regexp-filter :preset-filter))
- '(:eval (org-propertize
+ '(:eval (propertize
(concat " ["
(mapconcat
'identity
@@ -8236,9 +8334,6 @@ When called with a prefix argument, include all archive files as well."
(if org-agenda-clockreport-mode " Clock" "")))
(force-mode-line-update))
-(define-obsolete-function-alias
- 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3")
-
(defun org-agenda-update-agenda-type ()
"Update the agenda type after each command."
(setq org-agenda-type
@@ -8301,7 +8396,7 @@ When called with a prefix argument, include all archive files as well."
(message "No tags associated with this line"))))
(defun org-agenda-goto (&optional highlight)
- "Go to the Org-mode file which contains the item at point."
+ "Go to the entry at point in the corresponding Org file."
(interactive)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
@@ -8313,12 +8408,11 @@ When called with a prefix argument, include all archive files as well."
(goto-char pos)
(when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil)))) ; show the next heading
- (when (outline-invisible-p)
- (show-entry)) ; display invisible text
- (recenter (/ (window-height) 2))
+ (recenter (/ (window-height) 2))
+ (org-back-to-heading t)
+ (let ((case-fold-search nil))
+ (when (re-search-forward org-complex-heading-regexp nil t)
+ (goto-char (match-beginning 4)))))
(run-hooks 'org-agenda-after-show-hook)
(and highlight (org-highlight (point-at-bol) (point-at-eol)))))
@@ -8405,7 +8499,7 @@ Point is in the buffer where the item originated.")
(org-remove-subtree-entries-from-agenda))
(org-back-to-heading t)
(funcall cmd)))
- (error "Archiving works only in Org-mode files"))))))
+ (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.
@@ -8435,9 +8529,16 @@ If this information is not given, the function uses the tree at point."
(defun org-agenda-refile (&optional goto rfloc no-update)
"Refile the item at point.
-When GOTO is 0 or '(64), clear the refile cache.
-When GOTO is '(16), go to the location of the last refiled item.
+When called with `\\[universal-argument] \\[universal-argument]', \
+go to the location of the last
+refiled item.
+
+When called with `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]' prefix or when GOTO is 0, clear
+the refile cache.
+
RFLOC can be a refile location obtained in a different way.
+
When NO-UPDATE is non-nil, don't redo the agenda buffer."
(interactive "P")
(cond
@@ -8456,13 +8557,11 @@ When NO-UPDATE is non-nil, don't redo the agenda buffer."
(if goto "Goto" "Refile to") buffer
org-refile-allow-creating-parent-nodes))))
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (let ((org-agenda-buffer-name buffer-orig))
- (org-remove-subtree-entries-from-agenda))
- (org-refile goto buffer rfloc)))))
+ (org-with-wide-buffer
+ (goto-char marker)
+ (let ((org-agenda-buffer-name buffer-orig))
+ (org-remove-subtree-entries-from-agenda))
+ (org-refile goto buffer rfloc))))
(unless no-update (org-agenda-redo)))))
(defun org-agenda-open-link (&optional arg)
@@ -8487,13 +8586,11 @@ It also looks at the text of the entry itself."
(setq trg (and (string-match org-bracket-link-regexp l)
(match-string 1 l)))
(if (or (not trg) (string-match org-any-link-re trg))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (when (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point))))
+ (org-with-wide-buffer
+ (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
(switch-to-buffer-other-window buffer)
(widen)
@@ -8513,11 +8610,14 @@ It also looks at the text of the entry itself."
"Get a variable from a referenced buffer and install it here."
(let ((m (org-get-at-bol 'org-marker)))
(when (and m (buffer-live-p (marker-buffer m)))
- (org-set-local var (with-current-buffer (marker-buffer m)
- (symbol-value var))))))
+ (set (make-local-variable var)
+ (with-current-buffer (marker-buffer m)
+ (symbol-value var))))))
(defun org-agenda-switch-to (&optional delete-other-windows)
- "Go to the Org-mode file which contains the item at point."
+ "Go to the Org mode file which contains the item at point.
+When optional argument DELETE-OTHER-WINDOWS is non-nil, the
+displayed Org file fills the frame."
(interactive)
(if (and org-return-follows-link
(not (org-get-at-bol 'org-marker))
@@ -8527,44 +8627,40 @@ It also looks at the text of the entry itself."
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
- (org-pop-to-buffer-same-window buffer)
- (and delete-other-windows (delete-other-windows))
+ (unless buffer (user-error "Trying to switch to non-existent buffer"))
+ (pop-to-buffer-same-window buffer)
+ (when delete-other-windows (delete-other-windows))
(widen)
(goto-char pos)
(when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (when (outline-invisible-p)
- (show-entry)) ; display invisible text
(run-hooks 'org-agenda-after-show-hook)))))
(defun org-agenda-goto-mouse (ev)
- "Go to the Org-mode file which contains the item at the mouse click."
+ "Go to the Org file which contains the item at the mouse click."
(interactive "e")
(mouse-set-point ev)
(org-agenda-goto))
(defun org-agenda-show (&optional full-entry)
- "Display the Org-mode file which contains the item at point.
+ "Display the Org file which contains the item at point.
With prefix argument FULL-ENTRY, make the entire entry visible
if it was hidden in the outline."
(interactive "P")
(let ((win (selected-window)))
- (if full-entry
- (let ((org-show-entry-below t))
- (org-agenda-goto t))
- (org-agenda-goto t))
+ (org-agenda-goto t)
+ (when full-entry (org-show-entry))
(select-window win)))
(defvar org-agenda-show-window nil)
(defun org-agenda-show-and-scroll-up (&optional arg)
- "Display the Org-mode file which contains the item at point.
+ "Display the Org file which contains the item at point.
+
When called repeatedly, scroll the window that is displaying the buffer.
-With a \\[universal-argument] prefix, use `org-show-entry' instead of
-`show-subtree' to display the item, so that drawers and logbooks stay
-folded."
+
+With a `\\[universal-argument]' prefix, use `org-show-entry' instead of \
+`outline-show-subtree'
+to display the item, so that drawers and logbooks stay folded."
(interactive "P")
(let ((win (selected-window)))
(if (and (window-live-p org-agenda-show-window)
@@ -8573,7 +8669,7 @@ folded."
(select-window org-agenda-show-window)
(ignore-errors (scroll-up)))
(org-agenda-goto t)
- (if arg (org-show-entry) (show-subtree))
+ (if arg (org-show-entry) (outline-show-subtree))
(setq org-agenda-show-window (selected-window)))
(select-window win)))
@@ -8587,7 +8683,7 @@ folded."
(select-window win))))
(defun org-agenda-show-1 (&optional more)
- "Display the Org-mode file which contains the item at point.
+ "Display the Org file which contains the item at point.
The prefix arg selects the amount of information to display:
0 hide the subtree
@@ -8605,50 +8701,46 @@ if it was hidden in the outline."
(set-window-start (selected-window) (point-at-bol))
(cond
((= more 0)
- (hide-subtree)
+ (outline-hide-subtree)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'folded))
(message "Remote: FOLDED"))
- ((and (org-called-interactively-p 'any) (= more 1))
+ ((and (called-interactively-p 'any) (= more 1))
(message "Remote: show with default settings"))
((= more 2)
- (show-entry)
- (show-children)
+ (outline-show-entry)
+ (org-show-children)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'children))
(message "Remote: CHILDREN"))
((= more 3)
- (show-subtree)
+ (outline-show-subtree)
(save-excursion
(org-back-to-heading)
(run-hook-with-args 'org-cycle-hook 'subtree))
(message "Remote: SUBTREE"))
((= more 4)
- (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers)))
- (org-drawer-regexp
- (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")))
- (show-subtree)
- (save-excursion
- (org-back-to-heading)
- (org-cycle-hide-drawers 'subtree)))
+ (outline-show-subtree)
+ (save-excursion
+ (org-back-to-heading)
+ (org-cycle-hide-drawers 'subtree '("LOGBOOK")))
(message "Remote: SUBTREE AND LOGBOOK"))
((> more 4)
- (show-subtree)
+ (outline-show-subtree)
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
(defvar org-agenda-cycle-counter nil)
(defun org-agenda-cycle-show (&optional n)
"Show the current entry in another window, with default settings.
-Default settings are taken from `org-show-hierarchy-above' and siblings.
-When use repeatedly in immediate succession, the remote entry will cycle
-through visibility
-children -> subtree -> folded
+Default settings are taken from `org-show-context-detail'. When
+use repeatedly in immediate succession, the remote entry will
+cycle through visibility
+
+ children -> subtree -> folded
When called with a numeric prefix arg, that arg will be passed through to
`org-agenda-show-1'. For the interpretation of that argument, see the
@@ -8666,7 +8758,7 @@ docstring of `org-agenda-show-1'."
(org-agenda-show-1 org-agenda-cycle-counter))
(defun org-agenda-recenter (arg)
- "Display the Org-mode file which contains the item at point and recenter."
+ "Display the Org file which contains the item at point and recenter."
(interactive "P")
(let ((win (selected-window)))
(org-agenda-goto t)
@@ -8674,7 +8766,7 @@ docstring of `org-agenda-show-1'."
(select-window win)))
(defun org-agenda-show-mouse (ev)
- "Display the Org-mode file which contains the item at the mouse click."
+ "Display the Org file which contains the item at the mouse click."
(interactive "e")
(mouse-set-point ev)
(org-agenda-show))
@@ -8685,7 +8777,8 @@ docstring of `org-agenda-show-1'."
(org-agenda-error)))
(defun org-agenda-error ()
- (error "Command not allowed in this line"))
+ "Throw an error when a command is not allowed in the agenda."
+ (user-error "Command not allowed in this line"))
(defun org-agenda-tree-to-indirect-buffer (arg)
"Show the subtree corresponding to the current entry in an indirect buffer.
@@ -8693,8 +8786,10 @@ This calls the command `org-tree-to-indirect-buffer' from the original buffer.
With a numerical prefix ARG, go up to this level and then take that tree.
With a negative numeric ARG, go up by this number of levels.
-With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't
-use the dedicated frame)."
+
+With a `\\[universal-argument]' prefix, make a separate frame for this tree, \
+i.e. don't use
+the dedicated frame."
(interactive "P")
(if current-prefix-arg
(org-agenda-do-tree-to-indirect-buffer arg)
@@ -8712,7 +8807,8 @@ use the dedicated frame)."
(and indirect-window (select-window indirect-window))
(switch-to-buffer org-last-indirect-buffer :norecord)
(fit-window-to-buffer indirect-window)))
- (select-window (get-buffer-window agenda-buffer)))))
+ (select-window (get-buffer-window agenda-buffer))
+ (setq org-agenda-last-indirect-buffer org-last-indirect-buffer))))
(defun org-agenda-do-tree-to-indirect-buffer (arg)
"Same as `org-agenda-tree-to-indirect-buffer' without saving window."
@@ -8741,9 +8837,9 @@ by a remote command from the agenda.")
(org-agenda-todo 'previousset))
(defun org-agenda-todo (&optional arg)
- "Cycle TODO state of line at point, also in Org-mode file.
+ "Cycle TODO state of line at point, also in Org file.
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-mode file."
+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))
@@ -8752,7 +8848,7 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(buffer (marker-buffer marker))
(pos (marker-position marker))
(hdmarker (org-get-at-bol 'org-hd-marker))
- (todayp (org-agenda-todayp (org-get-at-bol 'day)))
+ (todayp (org-agenda-today-p (org-get-at-bol 'day)))
(inhibit-read-only t)
org-agenda-headline-snapshot-before-repeat newhead just-one)
(org-with-remote-undo buffer
@@ -8760,14 +8856,11 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(let ((current-prefix-arg arg))
(call-interactively 'org-todo))
(and (bolp) (forward-char 1))
(setq newhead (org-get-heading))
- (when (and (org-bound-and-true-p
+ (when (and (bound-and-true-p
org-agenda-headline-snapshot-before-repeat)
(not (equal org-agenda-headline-snapshot-before-repeat
newhead))
@@ -8780,11 +8873,12 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(beginning-of-line 1)
(save-window-excursion
(org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
- (when (org-bound-and-true-p org-clock-out-when-done)
+ (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-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."
@@ -8800,9 +8894,6 @@ the same tree node, and the headline of the tree node in the Org-mode file."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(org-add-note))))
(defun org-agenda-change-all-lines (newhead hdmarker
@@ -8819,9 +8910,9 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(line (org-current-line))
(org-agenda-buffer (current-buffer))
(thetags (with-current-buffer (marker-buffer hdmarker)
- (save-excursion (save-restriction (widen)
- (goto-char hdmarker)
- (org-get-tags-at)))))
+ (org-with-wide-buffer
+ (goto-char hdmarker)
+ (org-get-tags-at))))
props m pl undone-face done-face finish new dotime level cat tags)
(save-excursion
(goto-char (point-max))
@@ -8833,7 +8924,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(equal m hdmarker))
(setq props (text-properties-at (point))
dotime (org-get-at-bol 'dotime)
- cat (org-get-at-bol 'org-category)
+ cat (org-get-at-eol 'org-category 1)
level (org-get-at-bol 'level)
tags thetags
new
@@ -8842,20 +8933,25 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
org-prefix-format-compiled))
(extra (org-get-at-bol 'extra)))
(with-current-buffer (marker-buffer hdmarker)
- (save-excursion
- (save-restriction
- (widen)
- (org-agenda-format-item extra newhead level cat tags dotime)))))
+ (org-with-wide-buffer
+ (org-agenda-format-item extra newhead level cat tags dotime))))
pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
undone-face (org-get-at-bol 'undone-face)
done-face (org-get-at-bol 'done-face))
(beginning-of-line 1)
(cond
- ((equal new "")
- (and (looking-at ".*\n?") (replace-match "")))
+ ((equal new "") (delete-region (point) (line-beginning-position 2)))
((looking-at ".*")
- (replace-match new t t)
- (beginning-of-line 1)
+ ;; When replacing the whole line, preserve bulk mark
+ ;; overlay, if any.
+ (let ((mark (catch :overlay
+ (dolist (o (overlays-in (point) (+ 2 (point))))
+ (when (eq (overlay-get o 'type)
+ 'org-marked-entry-overlay)
+ (throw :overlay o))))))
+ (replace-match new t t)
+ (beginning-of-line)
+ (when mark (move-overlay mark (point) (+ 2 (point)))))
(add-text-properties (point-at-bol) (point-at-eol) props)
(when fixface
(add-text-properties
@@ -8873,10 +8969,14 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(defun org-agenda-align-tags (&optional line)
"Align all tags in agenda items to `org-agenda-tags-column'."
- (let ((inhibit-read-only t) l c)
+ (let ((inhibit-read-only t)
+ (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
+ (- (window-text-width))
+ org-agenda-tags-column))
+ l c)
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
- (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(if line (point-at-eol) nil) t)
(add-text-properties
(match-beginning 2) (match-end 2)
@@ -8900,19 +9000,19 @@ If FORCE-TAGS is non nil, the car of it returns the new tags."
(org-font-lock-add-tag-faces (point-max)))))
(defun org-agenda-priority-up ()
- "Increase the priority of line at point, also in Org-mode file."
+ "Increase the priority of line at point, also in Org file."
(interactive)
(org-agenda-priority 'up))
(defun org-agenda-priority-down ()
- "Decrease the priority of line at point, also in Org-mode file."
+ "Decrease the priority of line at point, also in Org file."
(interactive)
(org-agenda-priority 'down))
(defun org-agenda-priority (&optional force-direction)
- "Set the priority of line at point, also in Org-mode file.
+ "Set the priority of line at point, also in Org file.
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-mode file.
+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))
@@ -8933,9 +9033,6 @@ Called with a universal prefix arg, show the priority instead of setting it."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(funcall 'org-priority force-direction)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -8947,7 +9044,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
"Set tags for the current headline."
(interactive)
(org-agenda-check-no-diary)
- (if (and (org-region-active-p) (org-called-interactively-p 'any))
+ (if (and (org-region-active-p) (called-interactively-p 'any))
(call-interactively 'org-change-tag-in-region)
(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
(org-agenda-error)))
@@ -8959,12 +9056,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
+ (org-show-context 'agenda)
(if tag
(org-toggle-tag tag onoff)
(call-interactively 'org-set-tags))
@@ -8987,12 +9079,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
+ (org-show-context 'agenda)
(call-interactively 'org-set-property)))))
(defun org-agenda-set-effort ()
@@ -9009,12 +9096,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
+ (org-show-context 'agenda)
(call-interactively 'org-set-effort)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9035,9 +9117,6 @@ Called with a universal prefix arg, show the priority instead of setting it."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
(call-interactively 'org-toggle-archive-tag)
(end-of-line 1)
(setq newhead (org-get-heading)))
@@ -9079,7 +9158,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(defun org-agenda-date-later (arg &optional what)
"Change the date of this item to ARG day(s) later."
(interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
@@ -9090,8 +9169,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (if (not (org-at-timestamp-p))
- (error "Cannot find time stamp"))
+ (unless (org-at-timestamp-p 'lax) (error "Cannot find time stamp"))
(when (and org-agenda-move-date-from-past-immediately-to-today
(equal arg 1)
(or (not what) (eq what 'day))
@@ -9151,18 +9229,10 @@ Called with a universal prefix arg, show the priority instead of setting it."
(when (equal marker (org-get-at-bol 'org-marker))
(remove-text-properties (point-at-bol) (point-at-eol) '(display))
(org-move-to-column (- (window-width) (length stamp)) t)
- (if (featurep 'xemacs)
- ;; Use `duplicable' property to trigger undo recording
- (let ((ex (make-extent nil nil))
- (gl (make-glyph stamp)))
- (set-glyph-face gl 'secondary-selection)
- (set-extent-properties
- ex (list 'invisible t 'end-glyph gl 'duplicable t))
- (insert-extent ex (1- (point)) (point-at-eol)))
- (add-text-properties
- (1- (point)) (point-at-eol)
- (list 'display (org-add-props stamp nil
- 'face '(secondary-selection default)))))
+ (add-text-properties
+ (1- (point)) (point-at-eol)
+ (list 'display (org-add-props stamp nil
+ 'face '(secondary-selection default))))
(beginning-of-line 1))
(beginning-of-line 0)))))
@@ -9171,7 +9241,7 @@ Called with a universal prefix arg, show the priority instead of setting it."
The prefix ARG is passed to the `org-time-stamp' command and can therefore
be used to request time specification in the time stamp."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(org-agenda-check-no-diary)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
@@ -9181,8 +9251,7 @@ be used to request time specification in the time stamp."
(with-current-buffer buffer
(widen)
(goto-char pos)
- (if (not (org-at-timestamp-p t))
- (error "Cannot find time stamp"))
+ (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)))
@@ -9191,14 +9260,13 @@ be used to request time specification in the time stamp."
"Schedule the item at point.
ARG is passed through to `org-schedule'."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
+ (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))
- (org-insert-labeled-timestamps-at-point nil)
ts)
(set-marker-insertion-type marker t)
(org-with-remote-undo buffer
@@ -9213,13 +9281,12 @@ ARG is passed through to `org-schedule'."
"Schedule the item at point.
ARG is passed through to `org-deadline'."
(interactive "P")
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
+ (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))
- (org-insert-labeled-timestamps-at-point nil)
ts)
(org-with-remote-undo buffer
(with-current-buffer buffer
@@ -9246,7 +9313,6 @@ ARG is passed through to `org-deadline'."
(widen)
(goto-char pos)
(org-show-context 'agenda)
- (org-show-entry)
(org-cycle-hide-drawers 'children)
(org-clock-in arg)
(setq newhead (org-get-heading)))
@@ -9261,14 +9327,12 @@ ARG is passed through to `org-deadline'."
(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)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char org-clock-marker)
- (org-back-to-heading t)
- (move-marker marker (point))
- (org-clock-out)
- (setq newhead (org-get-heading))))))
+ (org-with-wide-buffer
+ (goto-char org-clock-marker)
+ (org-back-to-heading t)
+ (move-marker marker (point))
+ (org-clock-out)
+ (setq newhead (org-get-heading)))))
(org-agenda-change-all-lines newhead marker)
(move-marker marker nil)
(org-move-to-column col)
@@ -9295,7 +9359,7 @@ buffer, display it in another window."
(cond (pos (goto-char pos))
;; If the currently clocked entry is not in the agenda
;; buffer, we visit it in another window:
- (org-clock-current-task
+ ((bound-and-true-p org-clock-current-task)
(org-switch-to-buffer-other-window (org-clock-goto)))
(t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
@@ -9345,11 +9409,13 @@ buffer, display it in another window."
"Where in `org-agenda-diary-file' should new entries be added?
Valid values:
-date-tree in the date tree, as child of the date
-top-level as top-level entries at the end of the file."
+date-tree in the date tree, as first child of the date
+date-tree-last in the date tree, as last child of the date
+top-level as top-level entries at the end of the file."
:group 'org-agenda
:type '(choice
- (const :tag "in a date tree" date-tree)
+ (const :tag "first in a date tree" date-tree)
+ (const :tag "last in a date tree" date-tree-last)
(const :tag "as top level at end of file" top-level)))
(defcustom org-agenda-insert-diary-extract-time nil
@@ -9445,40 +9511,43 @@ Add TEXT as headline, and position the cursor in the second line so that
a timestamp can be added there."
(widen)
(goto-char (point-max))
- (or (bolp) (insert "\n"))
- (insert "* " text "\n")
- (if org-adapt-indentation (org-indent-to-column 2)))
+ (unless (bolp) (insert "\n"))
+ (org-insert-heading nil t t)
+ (insert text)
+ (org-end-of-meta-data)
+ (unless (bolp) (insert "\n"))
+ (when org-adapt-indentation (indent-to-column 2)))
(defun org-agenda-insert-diary-make-new-entry (text)
- "Make a new entry with TEXT as the first child of the current subtree.
-Position the point in the line right after the new heading so
-that a timestamp can be added there."
- (let ((org-show-following-heading t)
- (org-show-siblings t)
- (org-show-hierarchy-above t)
- (org-show-entry-below t)
- col)
+ "Make a new entry with TEXT as a child of the current subtree.
+Position the point in the heading's first body line so that
+a timestamp can be added there."
+ (cond
+ ((eq org-agenda-insert-diary-strategy 'date-tree-last)
+ (end-of-line)
+ (org-insert-heading '(4) t)
+ (org-do-demote))
+ (t
(outline-next-heading)
(org-back-over-empty-lines)
- (or (looking-at "[ \t]*$")
- (progn (insert "\n") (backward-char 1)))
+ (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
(org-insert-heading nil t)
- (org-do-demote)
- (setq col (current-column))
- (insert text "\n")
- (if org-adapt-indentation (org-indent-to-column col))
- (let ((org-show-following-heading t)
- (org-show-siblings t)
- (org-show-hierarchy-above t)
- (org-show-entry-below t))
- (org-show-context))))
+ (org-do-demote)))
+ (let ((col (current-column)))
+ (insert text)
+ (org-end-of-meta-data)
+ ;; Ensure point is left on a blank line, at proper indentation.
+ (unless (bolp) (insert "\n"))
+ (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
+ (when org-adapt-indentation (indent-to-column col)))
+ (org-show-set-visibility 'lineage))
(defun org-agenda-diary-entry ()
"Make a diary entry, like the `i' command from the calendar.
All the standard commands work: block, weekly etc.
When `org-agenda-diary-file' points to a file,
`org-agenda-diary-entry-in-org-file' is called instead to create
-entries in that Org-mode file."
+entries in that Org file."
(interactive)
(if (not (eq org-agenda-diary-file 'diary-file))
(org-agenda-diary-entry-in-org-file)
@@ -9487,13 +9556,13 @@ entries in that Org-mode file."
(message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
(read-char-exclusive)))
(cmd (cdr (assoc char
- '((?d . insert-diary-entry)
- (?w . insert-weekly-diary-entry)
- (?m . insert-monthly-diary-entry)
- (?y . insert-yearly-diary-entry)
- (?a . insert-anniversary-diary-entry)
- (?b . insert-block-diary-entry)
- (?c . insert-cyclic-diary-entry)))))
+ '((?d . diary-insert-entry)
+ (?w . diary-insert-weekly-entry)
+ (?m . diary-insert-monthly-entry)
+ (?y . diary-insert-yearly-entry)
+ (?a . diary-insert-anniversary-entry)
+ (?b . diary-insert-block-entry)
+ (?c . diary-insert-cyclic-entry)))))
(oldf (symbol-function 'calendar-cursor-to-date))
;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
(point (point))
@@ -9521,7 +9590,7 @@ entries in that Org-mode file."
(defun org-agenda-execute-calendar-command (cmd)
"Execute a calendar command from the agenda with date from cursor."
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(require 'diary-lib)
(unless (get-text-property (min (1- (point-max)) (point)) 'day)
(user-error "Don't know which date to use for the calendar command"))
@@ -9549,7 +9618,7 @@ entries in that Org-mode file."
(defun org-agenda-holidays ()
"Display the holidays for the 3 months around the cursor date."
(interactive)
- (org-agenda-execute-calendar-command 'list-calendar-holidays))
+ (org-agenda-execute-calendar-command 'calendar-list-holidays))
(defvar calendar-longitude) ; defined in calendar.el
(defvar calendar-latitude) ; defined in calendar.el
@@ -9571,7 +9640,7 @@ argument, latitude and longitude will be prompted for."
(defun org-agenda-goto-calendar ()
"Open the Emacs calendar with the date at the cursor."
(interactive)
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
(user-error "Don't know which date to open in calendar")))
(date (calendar-gregorian-from-absolute day))
@@ -9583,16 +9652,20 @@ argument, latitude and longitude will be prompted for."
;;;###autoload
(defun org-calendar-goto-agenda ()
- "Compute the Org-mode agenda for the calendar date displayed at the cursor.
+ "Compute the Org agenda for the calendar date displayed at the cursor.
This is a command that has to be installed in `calendar-mode-map'."
(interactive)
- (org-agenda-list nil (calendar-absolute-from-gregorian
- (calendar-cursor-to-date))
- nil))
+ ;; Temporarily disable sticky agenda since user clearly wants to
+ ;; refresh view anyway.
+ (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
+ (org-agenda-sticky nil))
+ (org-agenda-list nil (calendar-absolute-from-gregorian
+ (calendar-cursor-to-date))
+ nil)))
(defun org-agenda-convert-date ()
(interactive)
- (org-agenda-check-type t 'agenda 'timeline)
+ (org-agenda-check-type t 'agenda)
(let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
date s)
(unless day
@@ -9621,6 +9694,7 @@ This is a command that has to be installed in `calendar-mode-map'."
;;; Bulk commands
(defun org-agenda-bulk-marked-p ()
+ "Non-nil when current entry is marked for bulk action."
(eq (get-char-property (point-at-bol) 'type)
'org-marked-entry-overlay))
@@ -9662,9 +9736,12 @@ This is a command that has to be installed in `calendar-mode-map'."
(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)))
- (when (string-match regexp txt-at-point)
- (setq entries-marked (1+ entries-marked))
- (call-interactively 'org-agenda-bulk-mark))))
+ (if (get-char-property (point) 'invisible)
+ (beginning-of-line 2)
+ (when (string-match regexp txt-at-point)
+ (setq entries-marked (1+ entries-marked))
+ (call-interactively 'org-agenda-bulk-mark)))))
+
(if (not entries-marked)
(message "No entry matching this regexp."))))
@@ -9723,7 +9800,6 @@ This will remove the markers and the overlays."
(interactive)
(if (null org-agenda-bulk-marked-entries)
(message "No entry to unmark")
- (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
(setq org-agenda-bulk-marked-entries nil)
(org-agenda-bulk-remove-overlays (point-min) (point-max))))
@@ -9739,164 +9815,191 @@ bulk action."
"Execute an remote-editing action on all marked entries.
The prefix arg is passed through to the command if possible."
(interactive "P")
- ;; Make sure we have markers, and only valid ones
+ ;; Make sure we have markers, and only valid ones.
(unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
- (mapc
- (lambda (m)
- (unless (and (markerp m)
- (marker-buffer m)
- (buffer-live-p (marker-buffer m))
- (marker-position m))
- (user-error "Marker %s for bulk command is invalid" m)))
- org-agenda-bulk-marked-entries)
-
- ;; Prompt for the bulk command
- (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
- (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
- "[S]catter [f]unction "
- (when org-agenda-bulk-custom-functions
- (concat " Custom: ["
- (mapconcat (lambda(f) (char-to-string (car f)))
- org-agenda-bulk-custom-functions "")
- "]"))))
- (catch 'exit
- (let* ((action (read-char-exclusive))
- (org-log-refile (if org-log-refile 'time nil))
- (entries (reverse org-agenda-bulk-marked-entries))
- (org-overriding-default-time
- (if (get-text-property (point) 'org-agenda-date-header)
- (org-get-cursor-date)))
- redo-at-end
- cmd rfloc state e tag pos (cnt 0) (cntskip 0))
- (cond
- ((equal action ?p)
- (let ((org-agenda-persistent-marks
- (not org-agenda-persistent-marks)))
- (org-agenda-bulk-action)
- (throw 'exit nil)))
-
- ((equal action ?$)
- (setq cmd '(org-agenda-archive)))
-
- ((equal action ?A)
- (setq cmd '(org-agenda-archive-to-archive-sibling)))
-
- ((member action '(?r ?w))
- (setq rfloc (org-refile-get-location
- "Refile to"
- (marker-buffer (car entries))
- org-refile-allow-creating-parent-nodes))
- (if (nth 3 rfloc)
- (setcar (nthcdr 3 rfloc)
- (move-marker (make-marker) (nth 3 rfloc)
- (or (get-file-buffer (nth 1 rfloc))
- (find-buffer-visiting (nth 1 rfloc))
- (error "This should not happen")))))
-
- (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
- redo-at-end t))
-
- ((equal action ?t)
- (setq state (org-icompleting-read
+ (dolist (m org-agenda-bulk-marked-entries)
+ (unless (and (markerp m)
+ (marker-buffer m)
+ (buffer-live-p (marker-buffer m))
+ (marker-position m))
+ (user-error "Marker %s for bulk command is invalid" m)))
+
+ ;; Prompt for the bulk command.
+ (message
+ (concat (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")
+ "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
+ "[S]catter [f]unction "
+ (and org-agenda-bulk-custom-functions
+ (format " Custom: [%s]"
+ (mapconcat (lambda (f) (char-to-string (car f)))
+ org-agenda-bulk-custom-functions
+ "")))))
+ (catch 'exit
+ (let* ((org-log-refile (if org-log-refile 'time nil))
+ (entries (reverse org-agenda-bulk-marked-entries))
+ (org-overriding-default-time
+ (and (get-text-property (point) 'org-agenda-date-header)
+ (org-get-cursor-date)))
+ redo-at-end
+ cmd)
+ (pcase (read-char-exclusive)
+ (?p
+ (let ((org-agenda-persistent-marks
+ (not org-agenda-persistent-marks)))
+ (org-agenda-bulk-action)
+ (throw 'exit nil)))
+
+ (?$
+ (setq cmd #'org-agenda-archive))
+
+ (?A
+ (setq cmd #'org-agenda-archive-to-archive-sibling))
+
+ ((or ?r ?w)
+ (let ((refile-location
+ (org-refile-get-location
+ "Refile to"
+ (marker-buffer (car entries))
+ org-refile-allow-creating-parent-nodes)))
+ (when (nth 3 refile-location)
+ (setcar (nthcdr 3 refile-location)
+ (move-marker
+ (make-marker)
+ (nth 3 refile-location)
+ (or (get-file-buffer (nth 1 refile-location))
+ (find-buffer-visiting (nth 1 refile-location))
+ (error "This should not happen")))))
+
+ (setq cmd `(lambda () (org-agenda-refile nil ',refile-location t)))
+ (setq redo-at-end t)))
+
+ (?t
+ (let ((state (completing-read
"Todo state: "
(with-current-buffer (marker-buffer (car entries))
- (mapcar 'list org-todo-keywords-1))))
- (setq cmd `(let ((org-inhibit-blocking t)
- (org-inhibit-logging 'note))
- (org-agenda-todo ,state))))
-
- ((memq action '(?- ?+))
- (setq tag (org-icompleting-read
+ (mapcar #'list org-todo-keywords-1)))))
+ (setq cmd `(lambda ()
+ (let ((org-inhibit-blocking t)
+ (org-inhibit-logging 'note))
+ (org-agenda-todo ,state))))))
+
+ ((and (or ?- ?+) action)
+ (let ((tag (completing-read
(format "Tag to %s: " (if (eq action ?+) "add" "remove"))
(with-current-buffer (marker-buffer (car entries))
(delq nil
- (mapcar (lambda (x)
- (if (stringp (car x)) x)) org-tag-alist)))))
- (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
-
- ((memq action '(?s ?d))
- (let* ((time
- (unless arg
- (org-read-date
- nil nil nil
- (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
- org-overriding-default-time)))
- (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
- (setq cmd `(eval '(,c1 arg ,time)))))
-
- ((equal action ?S)
- (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
- (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
- (let ((days (read-number
- (format "Scatter tasks across how many %sdays: "
- (if arg "week" "")) 7)))
- (setq cmd
- `(let ((distance (1+ (random ,days))))
- (if arg
- (let ((dist distance)
- (day-of-week
- (calendar-day-of-week
- (calendar-gregorian-from-absolute (org-today)))))
- (dotimes (i (1+ dist))
- (while (member day-of-week org-agenda-weekend-days)
- (incf distance)
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))))
- ;; silently fail when try to replan a sexp entry
- (condition-case nil
- (let* ((date (calendar-gregorian-from-absolute
- (+ (org-today) distance)))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
- (nth 2 date))))
- (org-agenda-schedule nil time))
- (error nil)))))))
-
- ((assoc action org-agenda-bulk-custom-functions)
- (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
- redo-at-end t))
-
- ((equal action ?f)
- (setq cmd (list (intern
- (org-icompleting-read "Function: "
- obarray 'fboundp t nil nil)))))
-
- (t (user-error "Invalid bulk action")))
-
- ;; Sort the markers, to make sure that parents are handled before children
- (setq entries (sort entries
- (lambda (a b)
- (cond
- ((equal (marker-buffer a) (marker-buffer b))
- (< (marker-position a) (marker-position b)))
- (t
- (string< (buffer-name (marker-buffer a))
- (buffer-name (marker-buffer b))))))))
-
- ;; Now loop over all markers and apply cmd
- (while (setq e (pop entries))
- (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
- (if (not pos)
- (progn (message "Skipping removed entry at %s" e)
- (setq cntskip (1+ cntskip)))
- (goto-char pos)
- (let (org-loop-over-headlines-in-active-region)
- (eval cmd))
- (setq cnt (1+ cnt))))
+ (mapcar (lambda (x) (and (stringp (car x)) x))
+ org-current-tag-alist))))))
+ (setq cmd
+ `(lambda ()
+ (org-agenda-set-tags ,tag
+ ,(if (eq action ?+) ''on ''off))))))
+
+ (?s
+ (let ((time
+ (and (not arg)
+ (org-read-date nil nil nil "(Re)Schedule to"
+ org-overriding-default-time))))
+ ;; Make sure to not prompt for a note when bulk
+ ;; rescheduling as Org cannot cope with simultaneous notes.
+ ;; Besides, it could be annoying depending on the number of
+ ;; items re-scheduled.
+ (setq cmd
+ `(lambda ()
+ (let ((org-log-reschedule (and org-log-reschedule 'time)))
+ (org-agenda-schedule arg ,time))))))
+ (?d
+ (let ((time
+ (and (not arg)
+ (org-read-date nil nil nil "(Re)Set Deadline to"
+ org-overriding-default-time))))
+ ;; Make sure to not prompt for a note when bulk
+ ;; rescheduling as Org cannot cope with simultaneous
+ ;; notes. Besides, it could be annoying depending on the
+ ;; number of items re-scheduled.
+ (setq cmd
+ `(lambda ()
+ (let ((org-log-redeadline (and org-log-redeadline 'time)))
+ (org-agenda-deadline arg ,time))))))
+
+ (?S
+ (unless (org-agenda-check-type nil 'agenda 'todo)
+ (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type))
+ (let ((days (read-number
+ (format "Scatter tasks across how many %sdays: "
+ (if arg "week" ""))
+ 7)))
+ (setq cmd
+ `(lambda ()
+ (let ((distance (1+ (random ,days))))
+ (when arg
+ (let ((dist distance)
+ (day-of-week
+ (calendar-day-of-week
+ (calendar-gregorian-from-absolute (org-today)))))
+ (dotimes (i (1+ dist))
+ (while (member day-of-week org-agenda-weekend-days)
+ (cl-incf distance)
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))
+ (cl-incf day-of-week)
+ (when (= day-of-week 7)
+ (setq day-of-week 0)))))
+ ;; Silently fail when try to replan a sexp entry.
+ (ignore-errors
+ (let* ((date (calendar-gregorian-from-absolute
+ (+ (org-today) distance)))
+ (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
+ (nth 2 date))))
+ (org-agenda-schedule nil time))))))))
+
+ (?f
+ (setq cmd
+ (intern
+ (completing-read "Function: " obarray #'fboundp t nil nil))))
+
+ (action
+ (pcase (assoc action org-agenda-bulk-custom-functions)
+ (`(,_ ,f) (setq cmd f) (setq redo-at-end t))
+ (_ (user-error "Invalid bulk action: %c" action)))))
+
+ ;; Sort the markers, to make sure that parents are handled
+ ;; before children.
+ (setq entries (sort entries
+ (lambda (a b)
+ (cond
+ ((eq (marker-buffer a) (marker-buffer b))
+ (< (marker-position a) (marker-position b)))
+ (t
+ (string< (buffer-name (marker-buffer a))
+ (buffer-name (marker-buffer b))))))))
+
+ ;; Now loop over all markers and apply CMD.
+ (let ((processed 0)
+ (skipped 0))
+ (dolist (e entries)
+ (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
+ (if (not pos)
+ (progn (message "Skipping removed entry at %s" e)
+ (cl-incf skipped))
+ (goto-char pos)
+ (let (org-loop-over-headlines-in-active-region) (funcall cmd))
+ ;; `post-command-hook' is not run yet. We make sure any
+ ;; pending log note is processed.
+ (when (or (memq 'org-add-log-note (default-value 'post-command-hook))
+ (memq 'org-add-log-note post-command-hook))
+ (org-add-log-note))
+ (cl-incf processed))))
(when redo-at-end (org-agenda-redo))
- (unless org-agenda-persistent-marks
- (org-agenda-bulk-unmark-all))
+ (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
(message "Acted on %d entries%s%s"
- cnt
- (if (= cntskip 0)
+ processed
+ (if (= skipped 0)
""
(format ", skipped %d (disappeared before their turn)"
- cntskip))
- (if (not org-agenda-persistent-marks)
- "" " (kept marked)"))))))
+ skipped))
+ (if (not org-agenda-persistent-marks) "" " (kept marked)"))))))
(defun org-agenda-capture (&optional with-time)
"Call `org-capture' with the date at point.
@@ -9914,12 +10017,14 @@ current HH:MM time."
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
+ (,org-agenda-effort-filter effort)
(,(get 'org-agenda-tag-filter :preset-filter) tag)
(,(get 'org-agenda-category-filter :preset-filter) category)
+ (,(get 'org-agenda-effort-filter :preset-filter) effort)
(,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
(defun org-agenda-drag-line-forward (arg &optional backward)
@@ -9980,7 +10085,9 @@ tag and (if present) the flagging note."
(replace-match "\n" t t))
(goto-char (point-min))
(select-window win)
- (message "Flagging note pushed to kill ring. Press [?] again to remove tag and note"))))
+ (message "%s" (substitute-command-keys "Flagging note pushed to \
+kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \
+tag and note")))))
(defun org-agenda-remove-flag (marker)
"Remove the FLAGGED tag and any flagging note in the entry."
@@ -10003,7 +10110,8 @@ tag and (if present) the flagging note."
;;;###autoload
(defun org-agenda-to-appt (&optional refresh filter &rest args)
"Activate appointments found in `org-agenda-files'.
-With a \\[universal-argument] prefix, refresh the list of
+
+With a `\\[universal-argument]' prefix, refresh the list of \
appointments.
If FILTER is t, interactively prompt the user for a regular
@@ -10019,8 +10127,8 @@ argument: an entry from `org-agenda-get-day-entries'.
FILTER can also be an alist with the car of each cell being
either `headline' or `category'. For example:
- ((headline \"IMPORTANT\")
- (category \"Work\"))
+ \\='((headline \"IMPORTANT\")
+ (category \"Work\"))
will only add headlines containing IMPORTANT or headlines
belonging to the \"Work\" category.
@@ -10037,75 +10145,76 @@ to override `appt-message-warning-time'."
(if refresh (setq appt-time-msg-list nil))
(if (eq filter t)
(setq filter (read-from-minibuffer "Regexp filter: ")))
- (let* ((cnt 0) ; count added events
- (scope (or args '(:deadline* :scheduled* :timestamp)))
- (org-agenda-new-buffers nil)
- (org-deadline-warning-days 0)
- ;; Do not use `org-today' here because appt only takes
- ;; time and without date as argument, so it may pass wrong
- ;; information otherwise
- (today (org-date-to-gregorian
- (time-to-days (current-time))))
- (org-agenda-restrict nil)
- (files (org-agenda-files 'unrestricted)) entries file
- (org-agenda-buffer nil))
+ (let* ((cnt 0) ; count added events
+ (scope (or args '(:deadline* :scheduled* :timestamp)))
+ (org-agenda-new-buffers nil)
+ (org-deadline-warning-days 0)
+ ;; Do not use `org-today' here because appt only takes
+ ;; time and without date as argument, so it may pass wrong
+ ;; information otherwise
+ (today (org-date-to-gregorian
+ (time-to-days (current-time))))
+ (org-agenda-restrict nil)
+ (files (org-agenda-files 'unrestricted)) entries file
+ (org-agenda-buffer nil))
;; Get all entries which may contain an appt
(org-agenda-prepare-buffers files)
(while (setq file (pop files))
(setq entries
- (delq nil
- (append entries
- (apply 'org-agenda-get-day-entries
- file today scope)))))
+ (delq nil
+ (append entries
+ (apply 'org-agenda-get-day-entries
+ file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc
- (lambda(x)
+ (lambda (x)
(let* ((evt (org-trim
- (replace-regexp-in-string
- org-bracket-link-regexp "\\3"
- (or (get-text-property 1 'txt x) ""))))
- (cat (get-text-property 1 'org-category x))
- (tod (get-text-property 1 'time-of-day x))
- (ok (or (null filter)
- (and (stringp filter) (string-match filter evt))
- (and (functionp filter) (funcall filter x))
- (and (listp filter)
- (let ((cat-filter (cadr (assoc 'category filter)))
- (evt-filter (cadr (assoc 'headline filter))))
- (or (and (stringp cat-filter)
- (string-match cat-filter cat))
- (and (stringp evt-filter)
- (string-match evt-filter evt)))))))
- (wrn (get-text-property 1 'warntime x)))
- ;; FIXME: Shall we remove text-properties for the appt text?
- ;; (setq evt (set-text-properties 0 (length evt) nil evt))
- (when (and ok tod)
- (setq tod (concat "00" (number-to-string tod))
- tod (when (string-match
- "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
- (concat (match-string 1 tod) ":"
- (match-string 2 tod))))
- (if (version< emacs-version "23.3")
- (appt-add tod evt)
- (appt-add tod evt wrn))
- (setq cnt (1+ cnt))))) entries)
+ (replace-regexp-in-string
+ org-bracket-link-regexp "\\3"
+ (or (get-text-property 1 'txt x) ""))))
+ (cat (get-text-property (1- (length x)) 'org-category x))
+ (tod (get-text-property 1 'time-of-day x))
+ (ok (or (null filter)
+ (and (stringp filter) (string-match filter evt))
+ (and (functionp filter) (funcall filter x))
+ (and (listp filter)
+ (let ((cat-filter (cadr (assq 'category filter)))
+ (evt-filter (cadr (assq 'headline filter))))
+ (or (and (stringp cat-filter)
+ (string-match cat-filter cat))
+ (and (stringp evt-filter)
+ (string-match evt-filter evt)))))))
+ (wrn (get-text-property 1 'warntime x)))
+ ;; FIXME: Shall we remove text-properties for the appt text?
+ ;; (setq evt (set-text-properties 0 (length evt) nil evt))
+ (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt)))
+ (setq tod (concat "00" (number-to-string tod)))
+ (setq tod (when (string-match
+ "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
+ (concat (match-string 1 tod) ":"
+ (match-string 2 tod))))
+ (when (appt-add tod evt wrn)
+ (setq cnt (1+ cnt))))))
+ entries)
(org-release-buffers org-agenda-new-buffers)
(if (eq cnt 0)
- (message "No event to add")
+ (message "No event to add")
(message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
-(defun org-agenda-todayp (date)
- "Does DATE mean today, when considering `org-extend-today-until'?"
- (let ((today (org-today))
- (date (if (and date (listp date)) (calendar-absolute-from-gregorian date)
- date)))
- (eq date today)))
+(defun org-agenda-today-p (date)
+ "Non nil when DATE means today.
+DATE is either a list of the form (month day year) or a number of
+days as returned by `calendar-absolute-from-gregorian' or
+`org-today'. This function considers `org-extend-today-until'
+when defining today."
+ (eq (org-today)
+ (if (consp date) (calendar-absolute-from-gregorian date) date)))
(defun org-agenda-todo-yesterday (&optional arg)
"Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
(interactive "P")
- (let* ((hour (third (decode-time
- (org-current-time))))
+ (let* ((org-use-effective-time t)
+ (hour (nth 2 (decode-time (org-current-time))))
(org-extend-today-until (1+ hour)))
(org-agenda-todo arg)))
diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el
index 39a6581046a..01514d75652 100644
--- a/lisp/org/org-archive.el
+++ b/lisp/org/org-archive.el
@@ -1,4 +1,4 @@
-;;; org-archive.el --- Archiving for Org-mode
+;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
@@ -29,10 +29,10 @@
;;; Code:
(require 'org)
-(eval-when-compile (require 'cl))
-(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
+(declare-function org-element-type "org-element" (element))
(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction))
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(defcustom org-archive-default-command 'org-archive-subtree
"The default archiving command."
@@ -57,7 +57,7 @@ See `org-archive-to-archive-sibling' for more information."
(defcustom org-archive-mark-done nil
"Non-nil means mark entries as DONE when they are moved to the archive file.
-This can be a string to set the keyword to use. When t, Org-mode will
+This can be a string to set the keyword to use. When non-nil, Org will
use the first keyword in its list that means done."
:group 'org-archive
:type '(choice
@@ -120,9 +120,15 @@ information."
(const :tag "Outline path" olpath)
(const :tag "Local tags" ltags)))
+(defvar org-archive-hook nil
+ "Hook run after successfully archiving a subtree.
+Hook functions are called with point on the subtree in the
+original file. At this stage, the subtree has been added to the
+archive location, but not yet deleted from the original file.")
+
(defun org-get-local-archive-location ()
"Get the archive location applicable at point."
- (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
+ (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$")
prop)
(save-excursion
(save-restriction
@@ -154,21 +160,24 @@ archive file is."
(defun org-all-archive-files ()
"Get a list of all archive files used in the current buffer."
- (let (file files)
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (while (re-search-forward
- "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)"
- nil t)
- (setq file (org-extract-archive-file
- (org-match-string-no-properties 2)))
- (and file (> (length file) 0) (file-exists-p file)
- (pushnew file files :test #'equal)))))
+ (let ((case-fold-search t)
+ files)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)"
+ nil t)
+ (when (save-match-data
+ (if (eq (match-string 1) ":") (org-at-property-p)
+ (eq (org-element-type (org-element-at-point)) 'keyword)))
+ (let ((file (org-extract-archive-file
+ (match-string-no-properties 2))))
+ (when (and (org-string-nw-p file) (file-exists-p file))
+ (push file files))))))
(setq files (nreverse files))
- (setq file (org-extract-archive-file))
- (and file (> (length file) 0) (file-exists-p file)
- (pushnew file files :test #'equal))
+ (let ((file (org-extract-archive-file)))
+ (when (and (org-string-nw-p file) (file-exists-p file))
+ (push file files)))
files))
(defun org-extract-archive-file (&optional location)
@@ -195,15 +204,19 @@ if LOCATION is not given, the value of `org-archive-location' is used."
;;;###autoload
(defun org-archive-subtree (&optional find-done)
"Move the current subtree to the archive.
-The archive can be a certain top-level heading in the current file, or in
-a different file. The tree will be moved to that location, the subtree
-heading be marked DONE, and the current time will be added.
-
-When called with prefix argument FIND-DONE, find whole trees without any
-open TODO items and archive them (after getting confirmation from the user).
-If the cursor is not at a headline when this command is called, try all level
-1 trees. If the cursor is on a headline, only try the direct children of
-this heading."
+The archive can be a certain top-level heading in the current
+file, or in a different file. The tree will be moved to that
+location, the subtree heading be marked DONE, and the current
+time will be added.
+
+When called with a single prefix argument FIND-DONE, find whole
+trees without any open TODO items and archive them (after getting
+confirmation from the user). When called with a double prefix
+argument, find whole trees with timestamps before today and
+archive them (after getting confirmation from the user). If the
+cursor is not at a headline when these commands are called, try
+all level 1 trees. If the cursor is on a headline, only try the
+direct children of this heading."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
@@ -213,46 +226,36 @@ this heading."
`(progn (setq org-map-continue-from (progn (org-back-to-heading) (point)))
(org-archive-subtree ,find-done))
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (if find-done
- (org-archive-all-done)
+ cl (if (org-invisible-p) (org-end-of-subtree nil t))))
+ (cond
+ ((equal find-done '(4)) (org-archive-all-done))
+ ((equal find-done '(16)) (org-archive-all-old))
+ (t
;; Save all relevant TODO keyword-relatex variables
- (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler
- (tr-org-todo-keywords-1 org-todo-keywords-1)
- (tr-org-todo-kwd-alist org-todo-kwd-alist)
- (tr-org-done-keywords org-done-keywords)
- (tr-org-todo-regexp org-todo-regexp)
- (tr-org-todo-line-regexp org-todo-line-regexp)
- (tr-org-odd-levels-only org-odd-levels-only)
- (this-buffer (current-buffer))
- ;; start of variables that will be used for saving context
- ;; The compiler complains about them - keep them anyway!
- (file (abbreviate-file-name
- (or (buffer-file-name (buffer-base-buffer))
- (error "No file associated to buffer"))))
- (olpath (mapconcat 'identity (org-get-outline-path) "/"))
- (time (format-time-string
- (substring (cdr org-time-stamp-formats) 1 -1)))
- category todo priority ltags itags atags
- ;; end of variables that will be used for saving context
- location afile heading buffer level newfile-p infile-p visiting
- datetree-date datetree-subheading-p)
-
- ;; Find the local archive location
- (setq location (org-get-local-archive-location)
- afile (org-extract-archive-file location)
- heading (org-extract-archive-heading location)
- infile-p (equal file (abbreviate-file-name (or afile ""))))
- (unless afile
- (error "Invalid `org-archive-location'"))
-
- (if (> (length afile) 0)
- (setq newfile-p (not (file-exists-p afile))
- visiting (find-buffer-visiting afile)
- buffer (or visiting (find-file-noselect afile)))
- (setq buffer (current-buffer)))
- (unless buffer
- (error "Cannot access file \"%s\"" afile))
+ (let* ((tr-org-todo-keywords-1 org-todo-keywords-1)
+ (tr-org-todo-kwd-alist org-todo-kwd-alist)
+ (tr-org-done-keywords org-done-keywords)
+ (tr-org-todo-regexp org-todo-regexp)
+ (tr-org-todo-line-regexp org-todo-line-regexp)
+ (tr-org-odd-levels-only org-odd-levels-only)
+ (this-buffer (current-buffer))
+ (time (format-time-string
+ (substring (cdr org-time-stamp-formats) 1 -1)))
+ (file (abbreviate-file-name
+ (or (buffer-file-name (buffer-base-buffer))
+ (error "No file associated to buffer"))))
+ (location (org-get-local-archive-location))
+ (afile (or (org-extract-archive-file location)
+ (error "Invalid `org-archive-location'")))
+ (heading (org-extract-archive-heading location))
+ (infile-p (equal file (abbreviate-file-name (or afile ""))))
+ (newfile-p (and (org-string-nw-p afile)
+ (not (file-exists-p afile))))
+ (buffer (cond ((not (org-string-nw-p afile)) this-buffer)
+ ((find-buffer-visiting afile))
+ ((find-file-noselect afile))
+ (t (error "Cannot access file \"%s\"" afile))))
+ level datetree-date datetree-subheading-p)
(when (string-match "\\`datetree/" heading)
;; Replace with ***, to represent the 3 levels of headings the
;; datetree has.
@@ -266,108 +269,123 @@ this heading."
(setq heading nil level 0))
(save-excursion
(org-back-to-heading t)
- ;; Get context information that will be lost by moving the tree
- (setq category (org-get-category nil 'force-refresh)
- todo (and (looking-at org-todo-line-regexp)
- (match-string 2))
- priority (org-get-priority
- (if (match-end 3) (match-string 3) ""))
- ltags (org-get-tags)
- itags (org-delete-all ltags (org-get-tags-at))
- atags (org-get-tags-at))
- (setq ltags (mapconcat 'identity ltags " ")
- itags (mapconcat 'identity itags " "))
- ;; We first only copy, in case something goes wrong
- ;; we need to protect `this-command', to avoid kill-region sets it,
- ;; which would lead to duplication of subtrees
- (let (this-command) (org-copy-subtree 1 nil t))
- (set-buffer buffer)
- ;; Enforce org-mode for the archive buffer
- (if (not (derived-mode-p 'org-mode))
- ;; Force the mode for future visits.
- (let ((org-insert-mode-line-in-empty-file t)
- (org-inhibit-startup t))
- (call-interactively 'org-mode)))
- (when (and newfile-p org-archive-file-header-format)
- (goto-char (point-max))
- (insert (format org-archive-file-header-format
- (buffer-file-name this-buffer))))
- (when datetree-date
- (require 'org-datetree)
- (org-datetree-find-date-create datetree-date)
- (org-narrow-to-subtree))
- ;; Force the TODO keywords of the original buffer
- (let ((org-todo-line-regexp tr-org-todo-line-regexp)
- (org-todo-keywords-1 tr-org-todo-keywords-1)
- (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)))
- (goto-char (point-min))
- (show-all)
- (if (and heading (not (and datetree-date (not datetree-subheading-p))))
- (progn
- (if (re-search-forward
- (concat "^" (regexp-quote heading)
- (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)"))
- nil t)
- (goto-char (match-end 0))
- ;; Heading not found, just insert it at the end
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
- ;; datetrees don't need too much spacing
- (insert (if datetree-date "" "\n") heading "\n")
- (end-of-line 0))
- ;; Make the subtree visible
- (show-subtree)
- (if org-archive-reversed-order
- (progn
- (org-back-to-heading t)
- (outline-next-heading))
- (org-end-of-subtree t))
- (skip-chars-backward " \t\r\n")
- (and (looking-at "[ \t\r\n]*")
- ;; datetree archives don't need so much spacing.
- (replace-match (if datetree-date "\n" "\n\n"))))
- ;; No specific heading, just go to end of file.
- (goto-char (point-max)) (unless datetree-date (insert "\n")))
- ;; Paste
- (org-paste-subtree (org-get-valid-level level (and heading 1)))
- ;; Shall we append inherited tags?
- (and itags
- (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
- infile-p)
- (eq org-archive-subtree-add-inherited-tags t))
- (org-set-tags-to atags))
- ;; Mark the entry as done
- (when (and org-archive-mark-done
- (looking-at org-todo-line-regexp)
- (or (not (match-end 2))
- (not (member (match-string 2) org-done-keywords))))
- (let (org-log-done org-todo-log-states)
- (org-todo
- (car (or (member org-archive-mark-done org-done-keywords)
- org-done-keywords)))))
-
- ;; Add the context info
- (when org-archive-save-context-info
- (let ((l org-archive-save-context-info) e n v)
- (while (setq e (pop l))
- (when (and (setq v (symbol-value e))
- (stringp v) (string-match "\\S-" v))
- (setq n (concat "ARCHIVE_" (upcase (symbol-name e))))
- (org-entry-put (point) n v)))))
-
- (widen)
- ;; Save and kill the buffer, if it is not the same buffer.
- (when (not (eq this-buffer buffer))
- (save-buffer))))
- ;; Here we are back in the original buffer. Everything seems to have
- ;; worked. So now cut the tree and finish up.
+ ;; Get context information that will be lost by moving the
+ ;; tree. See `org-archive-save-context-info'.
+ (let* ((all-tags (org-get-tags-at))
+ (local-tags (org-get-tags))
+ (inherited-tags (org-delete-all local-tags all-tags))
+ (context
+ `((category . ,(org-get-category nil 'force-refresh))
+ (file . ,file)
+ (itags . ,(mapconcat #'identity inherited-tags " "))
+ (ltags . ,(mapconcat #'identity local-tags " "))
+ (olpath . ,(mapconcat #'identity
+ (org-get-outline-path)
+ "/"))
+ (time . ,time)
+ (todo . ,(org-entry-get (point) "TODO")))))
+ ;; We first only copy, in case something goes wrong
+ ;; we need to protect `this-command', to avoid kill-region sets it,
+ ;; which would lead to duplication of subtrees
+ (let (this-command) (org-copy-subtree 1 nil t))
+ (set-buffer buffer)
+ ;; Enforce Org mode for the archive buffer
+ (if (not (derived-mode-p 'org-mode))
+ ;; Force the mode for future visits.
+ (let ((org-insert-mode-line-in-empty-file t)
+ (org-inhibit-startup t))
+ (call-interactively 'org-mode)))
+ (when (and newfile-p org-archive-file-header-format)
+ (goto-char (point-max))
+ (insert (format org-archive-file-header-format
+ (buffer-file-name this-buffer))))
+ (when datetree-date
+ (require 'org-datetree)
+ (org-datetree-find-date-create datetree-date)
+ (org-narrow-to-subtree))
+ ;; Force the TODO keywords of the original buffer
+ (let ((org-todo-line-regexp tr-org-todo-line-regexp)
+ (org-todo-keywords-1 tr-org-todo-keywords-1)
+ (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)))
+ (goto-char (point-min))
+ (outline-show-all)
+ (if (and heading (not (and datetree-date (not datetree-subheading-p))))
+ (progn
+ (if (re-search-forward
+ (concat "^" (regexp-quote heading)
+ "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")
+ nil t)
+ (goto-char (match-end 0))
+ ;; Heading not found, just insert it at the end
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ ;; datetrees don't need too much spacing
+ (insert (if datetree-date "" "\n") heading "\n")
+ (end-of-line 0))
+ ;; Make the subtree visible
+ (outline-show-subtree)
+ (if org-archive-reversed-order
+ (progn
+ (org-back-to-heading t)
+ (outline-next-heading))
+ (org-end-of-subtree t))
+ (skip-chars-backward " \t\r\n")
+ (and (looking-at "[ \t\r\n]*")
+ ;; datetree archives don't need so much spacing.
+ (replace-match (if datetree-date "\n" "\n\n"))))
+ ;; No specific heading, just go to end of file, or to the
+ ;; beginning, depending on `org-archive-reversed-order'.
+ (if org-archive-reversed-order
+ (progn
+ (goto-char (point-min))
+ (unless (org-at-heading-p) (outline-next-heading))
+ (insert "\n") (backward-char 1))
+ (goto-char (point-max))
+ ;; Subtree narrowing can let the buffer end on
+ ;; a headline. `org-paste-subtree' then deletes it.
+ ;; To prevent this, make sure visible part of buffer
+ ;; always terminates on a new line, while limiting
+ ;; number of blank lines in a date tree.
+ (unless (and datetree-date (bolp)) (insert "\n"))))
+ ;; Paste
+ (org-paste-subtree (org-get-valid-level level (and heading 1)))
+ ;; Shall we append inherited tags?
+ (and inherited-tags
+ (or (and (eq org-archive-subtree-add-inherited-tags 'infile)
+ infile-p)
+ (eq org-archive-subtree-add-inherited-tags t))
+ (org-set-tags-to all-tags))
+ ;; Mark the entry as done
+ (when (and org-archive-mark-done
+ (let ((case-fold-search nil))
+ (looking-at org-todo-line-regexp))
+ (or (not (match-end 2))
+ (not (member (match-string 2) org-done-keywords))))
+ (let (org-log-done org-todo-log-states)
+ (org-todo
+ (car (or (member org-archive-mark-done org-done-keywords)
+ org-done-keywords)))))
+
+ ;; Add the context info.
+ (dolist (item org-archive-save-context-info)
+ (let ((value (cdr (assq item context))))
+ (when (org-string-nw-p value)
+ (org-entry-put
+ (point)
+ (concat "ARCHIVE_" (upcase (symbol-name item)))
+ value))))
+ (widen))))
+ ;; Here we are back in the original buffer. Everything seems
+ ;; to have worked. So now run hooks, cut the tree and finish
+ ;; up.
+ (run-hooks 'org-archive-hook)
(let (this-command) (org-cut-subtree))
(when (featurep 'org-inlinetask)
(org-inlinetask-remove-END-maybe))
@@ -375,7 +393,7 @@ this heading."
(message "Subtree archived %s"
(if (eq this-buffer buffer)
(concat "under heading: " heading)
- (concat "in file: " (abbreviate-file-name afile))))))
+ (concat "in file: " (abbreviate-file-name afile)))))))
(org-reveal)
(if (looking-at "^[ \t]*$")
(outline-next-visible-heading 1))))
@@ -383,9 +401,12 @@ this heading."
;;;###autoload
(defun org-archive-to-archive-sibling ()
"Archive the current heading by moving it under the archive sibling.
+
The archive sibling is a sibling of the heading with the heading name
`org-archive-sibling-heading' and an `org-archive-tag' tag. If this
-sibling does not exist, it will be created at the end of the subtree."
+sibling does not exist, it will be created at the end of the subtree.
+
+Archiving time is retained in the ARCHIVE_TIME node property."
(interactive)
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level)
@@ -400,7 +421,7 @@ sibling does not exist, it will be created at the end of the subtree."
(when (org-at-heading-p)
(org-archive-to-archive-sibling)))
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ cl (if (org-invisible-p) (org-end-of-subtree nil t))))
(save-restriction
(widen)
(let (b e pos leader level)
@@ -443,7 +464,7 @@ sibling does not exist, it will be created at the end of the subtree."
(format-time-string
(substring (cdr org-time-stamp-formats) 1 -1)))
(outline-up-heading 1 t)
- (hide-subtree)
+ (outline-hide-subtree)
(org-cycle-show-empty-lines 'folded)
(goto-char pos)))
(org-reveal)
@@ -455,13 +476,51 @@ sibling does not exist, it will be created at the end of the subtree."
If the cursor is not on a headline, try all level 1 trees. If
it is on a headline, try all direct children.
When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
- (let ((re org-not-done-heading-regexp) re1
- (rea (concat ".*:" org-archive-tag ":"))
+ (org-archive-all-matches
+ (lambda (_beg end)
+ (let ((case-fold-search nil))
+ (unless (re-search-forward org-not-done-heading-regexp end t)
+ "no open TODO items")))
+ tag))
+
+(defun org-archive-all-old (&optional tag)
+ "Archive sublevels of the current tree with timestamps prior to today.
+If the cursor is not on a headline, try all level 1 trees. If
+it is on a headline, try all direct children.
+When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
+ (org-archive-all-matches
+ (lambda (_beg end)
+ (let (ts)
+ (and (re-search-forward org-ts-regexp end t)
+ (setq ts (match-string 0))
+ (< (org-time-stamp-to-now ts) 0)
+ (if (not (looking-at
+ (concat "--\\(" org-ts-regexp "\\)")))
+ (concat "old timestamp " ts)
+ (setq ts (concat "old timestamp " ts (match-string 0)))
+ (and (< (org-time-stamp-to-now (match-string 1)) 0)
+ ts)))))
+ tag))
+
+(defun org-archive-all-matches (predicate &optional tag)
+ "Archive sublevels of the current tree that match PREDICATE.
+
+PREDICATE is a function of two arguments, BEG and END, which
+specify the beginning and end of the headline being considered.
+It is called with point positioned at BEG. The headline will be
+archived if PREDICATE returns non-nil. If the return value of
+PREDICATE is a string, it should describe the reason for
+archiving the heading.
+
+If the cursor is not on a headline, try all level 1 trees. If it
+is on a headline, try all direct children. When TAG is non-nil,
+don't move trees, but mark them with the ARCHIVE tag."
+ (let ((rea (concat ".*:" org-archive-tag ":")) re1
(begm (make-marker))
(endm (make-marker))
- (question (if tag "Set ARCHIVE tag (no open TODO items)? "
- "Move subtree to archive (no open TODO items)? "))
- beg end (cntarch 0))
+ (question (if tag "Set ARCHIVE tag? "
+ "Move subtree to archive? "))
+ reason beg end (cntarch 0))
(if (org-at-heading-p)
(progn
(setq re1 (concat "^" (regexp-quote
@@ -481,11 +540,14 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag."
(setq beg (match-beginning 0)
end (save-excursion (org-end-of-subtree t) (point)))
(goto-char beg)
- (if (re-search-forward re end t)
+ (if (not (setq reason (funcall predicate beg end)))
(goto-char end)
(goto-char beg)
(if (and (or (not tag) (not (looking-at rea)))
- (y-or-n-p question))
+ (y-or-n-p
+ (if (stringp reason)
+ (concat question "(" reason ")")
+ question)))
(progn
(if tag
(org-toggle-tag org-archive-tag 'on)
@@ -507,14 +569,14 @@ the children that do not contain any open TODO items."
(org-map-entries
`(org-toggle-archive-tag ,find-done)
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ cl (if (org-invisible-p) (org-end-of-subtree nil t))))
(if find-done
(org-archive-all-done 'tag)
(let (set)
(save-excursion
(org-back-to-heading t)
(setq set (org-toggle-tag org-archive-tag))
- (when set (hide-subtree)))
+ (when set (org-flag-subtree t)))
(and set (beginning-of-line 1))
(message "Subtree %s" (if set "archived" "unarchived"))))))
@@ -528,7 +590,7 @@ the children that do not contain any open TODO items."
(org-map-entries
'org-archive-set-tag
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
+ cl (if (org-invisible-p) (org-end-of-subtree nil t))))
(org-toggle-tag org-archive-tag 'on)))
;;;###autoload
diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el
index 7d25437d9f5..cd6b4136233 100644
--- a/lisp/org/org-attach.el
+++ b/lisp/org/org-attach.el
@@ -1,4 +1,4 @@
-;;; org-attach.el --- Manage file attachments to org-mode tasks
+;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
@@ -18,11 +18,11 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; See the Org-mode manual for information on how to use it.
+;; See the Org manual for information on how to use it.
;;
;; Attachments are managed in a special directory called "data", which
;; lives in the same directory as the org file itself. If this data
@@ -37,14 +37,15 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
-(require 'org-id)
+(require 'cl-lib)
(require 'org)
+(require 'org-id)
(require 'vc-git)
+(declare-function dired-dwim-target-directory "dired-aux")
+
(defgroup org-attach nil
- "Options concerning entry attachments in Org-mode."
+ "Options concerning entry attachments in Org mode."
:tag "Org Attach"
:group 'org)
@@ -55,6 +56,14 @@ where the Org file lives."
:group 'org-attach
:type 'directory)
+(defcustom org-attach-commit t
+ "If non-nil commit attachments with git.
+This is only done if the Org file is in a git repository."
+ :group 'org-attach
+ :type 'boolean
+ :version "26.1"
+ :package-version '(Org . "9.0"))
+
(defcustom org-attach-git-annex-cutoff (* 32 1024)
"If non-nil, files larger than this will be annexed instead of stored."
:group 'org-attach
@@ -120,6 +129,28 @@ lns create a symbol link. Note that this is not supported
(const :tag "Link to origin location" t)
(const :tag "Link to the attach-dir location" attached)))
+(defcustom org-attach-archive-delete nil
+ "Non-nil means attachments are deleted upon archiving a subtree.
+When set to `query', ask the user instead."
+ :group 'org-attach
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "Never delete attachments" nil)
+ (const :tag "Always delete attachments" t)
+ (const :tag "Query the user" query)))
+
+(defcustom org-attach-annex-auto-get 'ask
+ "Confirmation preference for automatically getting annex files.
+If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get."
+ :group 'org-attach
+ :package-version '(Org . "9.0")
+ :version "26.1"
+ :type '(choice
+ (const :tag "confirm with `y-or-n-p'" ask)
+ (const :tag "always get from annex if necessary" t)
+ (const :tag "never get from annex" nil)))
+
;;;###autoload
(defun org-attach ()
"The dispatcher for attachment commands.
@@ -144,6 +175,7 @@ Shows a list of commands and prompts for another key to execute a command."
a Select a file and attach it to the task, using `org-attach-method'.
c/m/l/y Attach a file using copy/move/link/symbolic-link method.
+u Attach a file from URL (downloading it).
n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment
directory, in case you added attachments yourself.
@@ -157,7 +189,7 @@ d Delete one attachment, you will be prompted for a file name.
D Delete all of a task's attachments. A safer way is
to open the directory in dired and delete from there.
-s Set a specific attachment directory for this entry.
+s Set a specific attachment directory for this entry or reset to default.
i Make children of the current entry inherit its attachment directory.")))
(org-fit-window-to-buffer (get-buffer-window "*Org Attach*"))
(message "Select command: [acmlzoOfFdD]")
@@ -173,6 +205,8 @@ i Make children of the current entry inherit its attachment directory.")))
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
((memq c '(?y ?\C-y))
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
+ ((memq c '(?u ?\C-u))
+ (let ((org-attach-method 'url)) (call-interactively 'org-attach-url)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
@@ -197,25 +231,23 @@ using the entry ID will be invoked to access the unique directory for the
current entry.
If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,
the directory and (if necessary) the corresponding ID will be created."
- (let (attach-dir uuid inherit)
+ (let (attach-dir uuid)
(setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT"))
(cond
((setq attach-dir (org-entry-get nil "ATTACH_DIR"))
(org-attach-check-absolute-path attach-dir))
((and org-attach-allow-inheritance
- (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t)))
+ (org-entry-get nil "ATTACH_DIR_INHERIT" t))
(setq attach-dir
- (save-excursion
- (save-restriction
- (widen)
- (if (marker-position org-entry-property-inherited-from)
- (goto-char org-entry-property-inherited-from)
- (org-back-to-heading t))
- (let (org-attach-allow-inheritance)
- (org-attach-dir create-if-not-exists-p)))))
+ (org-with-wide-buffer
+ (if (marker-position org-entry-property-inherited-from)
+ (goto-char org-entry-property-inherited-from)
+ (org-back-to-heading t))
+ (let (org-attach-allow-inheritance)
+ (org-attach-dir create-if-not-exists-p))))
(org-attach-check-absolute-path attach-dir)
(setq org-attach-inherited t))
- (t ; use the ID
+ (t ; use the ID
(org-attach-check-absolute-path nil)
(setq uuid (org-id-get (point) create-if-not-exists-p))
(when (or uuid create-if-not-exists-p)
@@ -243,14 +275,30 @@ Throw an error if we cannot root the directory."
(buffer-file-name (buffer-base-buffer))
(error "Need absolute `org-attach-directory' to attach in buffers without filename")))
-(defun org-attach-set-directory ()
- "Set the ATTACH_DIR property of the current entry.
+(defun org-attach-set-directory (&optional arg)
+ "Set the ATTACH_DIR node property and ask to move files there.
The property defines the directory that is used for attachments
-of the entry."
- (interactive)
- (let ((dir (org-entry-get nil "ATTACH_DIR")))
- (setq dir (read-directory-name "Attachment directory: " dir))
- (org-entry-put nil "ATTACH_DIR" dir)))
+of the entry. When called with `\\[universal-argument]', reset \
+the directory to
+the default ID based one."
+ (interactive "P")
+ (let ((old (org-attach-dir))
+ (new
+ (progn
+ (if arg (org-entry-delete nil "ATTACH_DIR")
+ (let ((dir (read-directory-name
+ "Attachment directory: "
+ (org-entry-get nil
+ "ATTACH_DIR"
+ (and org-attach-allow-inheritance t)))))
+ (org-entry-put nil "ATTACH_DIR" dir)))
+ (org-attach-dir t))))
+ (unless (or (string= old new)
+ (not old))
+ (when (yes-or-no-p "Copy over attachments from old directory? ")
+ (copy-directory old new t nil t))
+ (when (yes-or-no-p (concat "Delete " old))
+ (delete-directory old t)))))
(defun org-attach-set-inherit ()
"Set the ATTACH_DIR_INHERIT property of the current entry.
@@ -261,33 +309,59 @@ the ATTACH_DIR property) their own attachment directory."
(org-entry-put nil "ATTACH_DIR_INHERIT" "t")
(message "Children will inherit attachment directory"))
+(defun org-attach-use-annex ()
+ "Return non-nil if git annex can be used."
+ (let ((git-dir (vc-git-root (expand-file-name org-attach-directory))))
+ (and org-attach-git-annex-cutoff
+ (or (file-exists-p (expand-file-name "annex" git-dir))
+ (file-exists-p (expand-file-name ".git/annex" git-dir))))))
+
+(defun org-attach-annex-get-maybe (path)
+ "Call git annex get PATH (via shell) if using git annex.
+Signals an error if the file content is not available and it was not retrieved."
+ (let ((path-relative (file-relative-name path)))
+ (when (and (org-attach-use-annex)
+ (not
+ (string-equal
+ "found"
+ (shell-command-to-string
+ (format "git annex find --format=found --in=here %s"
+ (shell-quote-argument path-relative))))))
+ (let ((should-get
+ (if (eq org-attach-annex-auto-get 'ask)
+ (y-or-n-p (format "Run git annex get %s? " path-relative))
+ org-attach-annex-auto-get)))
+ (if should-get
+ (progn (message "Running git annex get \"%s\"." path-relative)
+ (call-process "git" nil nil nil "annex" "get" path-relative))
+ (error "File %s stored in git annex but it is not available, and was not retrieved"
+ path))))))
+
(defun org-attach-commit ()
"Commit changes to git if `org-attach-directory' is properly initialized.
This checks for the existence of a \".git\" directory in that directory."
(let* ((dir (expand-file-name org-attach-directory))
(git-dir (vc-git-root dir))
+ (use-annex (org-attach-use-annex))
(changes 0))
(when (and git-dir (executable-find "git"))
(with-temp-buffer
(cd dir)
- (let ((have-annex
- (and org-attach-git-annex-cutoff
- (file-exists-p (expand-file-name "annex" git-dir)))))
- (dolist (new-or-modified
- (split-string
- (shell-command-to-string
- "git ls-files -zmo --exclude-standard") "\0" t))
- (if (and have-annex
- (>= (nth 7 (file-attributes new-or-modified))
- org-attach-git-annex-cutoff))
- (call-process "git" nil nil nil "annex" "add" new-or-modified)
- (call-process "git" nil nil nil "add" new-or-modified))
- (incf changes)))
+ (dolist (new-or-modified
+ (split-string
+ (shell-command-to-string
+ "git ls-files -zmo --exclude-standard") "\0" t))
+ (if (and use-annex
+ (>= (nth 7 (file-attributes new-or-modified))
+ org-attach-git-annex-cutoff))
+ (call-process "git" nil nil nil "annex" "add" new-or-modified)
+ (call-process "git" nil nil nil "add" new-or-modified))
+ (cl-incf changes))
(dolist (deleted
(split-string
(shell-command-to-string "git ls-files -z --deleted") "\0" t))
(call-process "git" nil nil nil "rm" deleted)
- (incf changes))
+ (cl-incf changes))
(when (> changes 0)
(shell-command "git commit -m 'Synchronized attachments'"))))))
@@ -310,33 +384,47 @@ Only do this when `org-attach-store-link-p' is non-nil."
(file-name-nondirectory file))
org-stored-links)))
+(defun org-attach-url (url)
+ (interactive "MURL of the file to attach: \n")
+ (org-attach-attach url))
+
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task.
If VISIT-DIR is non-nil, visit the directory with dired.
-METHOD may be `cp', `mv', `ln', or `lns' default taken from
+METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
`org-attach-method'."
- (interactive "fFile to keep as an attachment: \nP")
+ (interactive
+ (list
+ (read-file-name "File to keep as an attachment:"
+ (or (progn
+ (require 'dired-aux)
+ (dired-dwim-target-directory))
+ default-directory))
+ current-prefix-arg
+ nil))
(setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file)))
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property basename))
(let* ((attach-dir (org-attach-dir t))
- (fname (expand-file-name basename attach-dir)))
+ (fname (expand-file-name basename attach-dir)))
(cond
- ((eq method 'mv) (rename-file file fname))
- ((eq method 'cp) (copy-file file fname))
+ ((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)))
- (org-attach-commit)
+ ((eq method 'lns) (make-symbolic-link file fname))
+ ((eq method 'url) (url-copy-file file fname)))
+ (when org-attach-commit
+ (org-attach-commit))
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
- (org-attach-store-link fname))
- ((eq org-attach-store-link-p t)
- (org-attach-store-link file)))
+ (org-attach-store-link fname))
+ ((eq org-attach-store-link-p t)
+ (org-attach-store-link file)))
(if visit-dir
- (dired attach-dir)
- (message "File \"%s\" is now a task attachment." basename)))))
+ (dired attach-dir)
+ (message "File %S is now a task attachment." basename)))))
(defun org-attach-attach-cp ()
"Attach a file by copying it."
@@ -378,7 +466,7 @@ The attachment is created as an Emacs buffer."
(let* ((attach-dir (org-attach-dir t))
(files (org-attach-file-list attach-dir))
(file (or file
- (org-icompleting-read
+ (completing-read
"Delete attachment: "
(mapcar (lambda (f)
(list (file-name-nondirectory f)))
@@ -387,7 +475,8 @@ The attachment is created as an Emacs buffer."
(unless (file-exists-p file)
(error "No such attachment: %s" file))
(delete-file file)
- (org-attach-commit)))
+ (when org-attach-commit
+ (org-attach-commit))))
(defun org-attach-delete-all (&optional force)
"Delete all attachments from the current task.
@@ -403,31 +492,33 @@ A safer way is to open the directory in dired and delete from there."
(y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))
(shell-command (format "rm -fr %s" attach-dir))
(message "Attachment directory removed")
- (org-attach-commit)
+ (when org-attach-commit
+ (org-attach-commit))
(org-attach-untag))))
(defun org-attach-sync ()
"Synchronize the current tasks with its attachments.
This can be used after files have been added externally."
(interactive)
- (org-attach-commit)
+ (when org-attach-commit
+ (org-attach-commit))
(when (and org-attach-file-list-property (not org-attach-inherited))
(org-entry-delete (point) org-attach-file-list-property))
(let ((attach-dir (org-attach-dir)))
(when attach-dir
(let ((files (org-attach-file-list attach-dir)))
- (and files (org-attach-tag))
+ (org-attach-tag (not files))
(when org-attach-file-list-property
(dolist (file files)
- (unless (string-match "^\\." file)
+ (unless (string-match "^\\.\\.?\\'" file)
(org-entry-add-to-multivalued-property
(point) org-attach-file-list-property file))))))))
(defun org-attach-file-list (dir)
"Return a list of files in the attachment directory.
-This ignores files starting with a \".\", and files ending in \"~\"."
+This ignores files ending in \"~\"."
(delq nil
- (mapcar (lambda (x) (if (string-match "^\\." x) nil x))
+ (mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x))
(directory-files dir nil "[^~]\\'"))))
(defun org-attach-reveal (&optional if-exists)
@@ -454,9 +545,11 @@ If IN-EMACS is non-nil, force opening in Emacs."
(files (org-attach-file-list attach-dir))
(file (if (= (length files) 1)
(car files)
- (org-icompleting-read "Open attachment: "
- (mapcar 'list files) nil t))))
- (org-open-file (expand-file-name file attach-dir) in-emacs)))
+ (completing-read "Open attachment: "
+ (mapcar #'list files) nil t)))
+ (path (expand-file-name file attach-dir)))
+ (org-attach-annex-get-maybe path)
+ (org-open-file path in-emacs)))
(defun org-attach-open-in-emacs ()
"Open attachment, force opening in Emacs.
@@ -475,6 +568,17 @@ Basically, this adds the path to the attachment directory, and a \"file:\"
prefix."
(concat "file:" (org-attach-expand file)))
+(defun org-attach-archive-delete-maybe ()
+ "Maybe delete subtree attachments when archiving.
+This function is called by `org-archive-hook'. The option
+`org-attach-archive-delete' controls its behavior."
+ (when (if (eq org-attach-archive-delete 'query)
+ (yes-or-no-p "Delete all attachments? ")
+ org-attach-archive-delete)
+ (org-attach-delete-all t)))
+
+(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)
+
(provide 'org-attach)
;; Local variables:
diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el
index e41bda47dbf..889271affea 100644
--- a/lisp/org/org-bbdb.el
+++ b/lisp/org/org-bbdb.el
@@ -1,4 +1,4 @@
-;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode
+;;; org-bbdb.el --- Support for links to BBDB entries -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -20,17 +20,17 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file implements links to BBDB database entries from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to BBDB database entries from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;; It also implements an interface (based on Ivar Rummelhoff's
-;; bbdb-anniv.el) for those org-mode users, who do not use the diary
+;; bbdb-anniv.el) for those Org users, who do not use the diary
;; but who do want to include the anniversaries stored in the BBDB
;; into the org-agenda. If you already include the `diary' into the
;; agenda, you might want to prefer to include the anniversaries in
@@ -94,8 +94,7 @@
;;; Code:
(require 'org)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
;; Declare external functions and variables
@@ -106,6 +105,7 @@
(declare-function bbdb-name "ext:bbdb-com" (string elidep))
(declare-function bbdb-completing-read-record "ext:bbdb-com"
(prompt &optional omit-records))
+(declare-function bbdb-record-field "ext:bbdb" (record field))
(declare-function bbdb-record-getprop "ext:bbdb" (record property))
(declare-function bbdb-record-name "ext:bbdb" (record))
(declare-function bbdb-records "ext:bbdb"
@@ -124,7 +124,7 @@
(declare-function calendar-leap-year-p "calendar" (year))
(declare-function diary-ordinal-suffix "diary-lib" (n))
-(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
+(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Customization
@@ -138,6 +138,24 @@
:group 'org-bbdb-anniversaries
:require 'bbdb)
+(defcustom org-bbdb-general-anniversary-description-after 7
+ "When to switch anniversary descriptions to a more general format.
+
+Anniversary descriptions include the point in time, when the
+anniversary appears. This is, in its most general form, just the
+date of the anniversary. Or more specific terms, like \"today\",
+\"tomorrow\" or \"in n days\" are used to describe the time span.
+
+If the anniversary happens in less than that number of days, the
+specific description is used. Otherwise, the general one is
+used."
+ :group 'org-bbdb-anniversaries
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :type 'integer
+ :require 'bbdb
+ :safe #'integerp)
+
(defcustom org-bbdb-anniversary-format-alist
'(("birthday" .
(lambda (name years suffix)
@@ -194,10 +212,12 @@ date year)."
:group 'org-bbdb-anniversaries
:require 'bbdb)
-
;; Install the link type
-(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export)
-(add-hook 'org-store-link-functions 'org-bbdb-store-link)
+(org-link-set-parameters "bbdb"
+ :follow #'org-bbdb-open
+ :export #'org-bbdb-export
+ :complete #'org-bbdb-complete-link
+ :store #'org-bbdb-store-link)
;; Implementation
(defun org-bbdb-store-link ()
@@ -208,7 +228,7 @@ date year)."
(name (bbdb-record-name rec))
(company (if (fboundp 'bbdb-record-getprop)
(bbdb-record-getprop rec 'company)
- (car (bbdb-record-get-field rec 'organization))))
+ (car (bbdb-record-field rec 'organization))))
(link (concat "bbdb:" name)))
(org-store-link-props :type "bbdb" :name name :company company
:link link :description name)
@@ -230,10 +250,9 @@ italicized, in all other cases it is left unchanged."
(defun org-bbdb-open (name)
"Follow a BBDB link to NAME."
(require 'bbdb-com)
- (let ((inhibit-redisplay (not debug-on-error))
- (bbdb-electric-p nil))
+ (let ((inhibit-redisplay (not debug-on-error)))
(if (fboundp 'bbdb-name)
- (org-bbdb-open-old name)
+ (org-bbdb-open-old name)
(org-bbdb-open-new name))))
(defun org-bbdb-open-old (name)
@@ -280,14 +299,11 @@ italicized, in all other cases it is left unchanged."
"Convert YYYY-MM-DD to (month date year).
Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted
it will be considered unknown."
- (multiple-value-bind (a b c) (values-list (org-split-string time-str "-"))
- (if (eq c nil)
- (list (string-to-number a)
- (string-to-number b)
- nil)
- (list (string-to-number b)
- (string-to-number c)
- (string-to-number a)))))
+ (pcase (org-split-string time-str "-")
+ (`(,a ,b nil) (list (string-to-number a) (string-to-number b) nil))
+ (`(,a ,b ,c) (list (string-to-number b)
+ (string-to-number c)
+ (string-to-number a)))))
(defun org-bbdb-anniv-split (str)
"Split multiple entries in the BBDB anniversary field.
@@ -325,9 +341,9 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
(bbdb-split "\n" annivs)))
(while annivs
(setq split (org-bbdb-anniv-split (pop annivs)))
- (multiple-value-bind (m d y)
- (values-list (funcall org-bbdb-extract-date-fun (car split)))
- (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
+ (pcase-let ((`(,m ,d ,y) (funcall org-bbdb-extract-date-fun
+ (car split))))
+ (setq tmp (gethash (list m d) org-bbdb-anniv-hash))
(puthash (list m d) (cons (list y
(bbdb-record-name rec)
(cadr split))
@@ -335,7 +351,7 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'."
org-bbdb-anniv-hash))))))
(setq org-bbdb-updated-p nil))
-(defun org-bbdb-updated (rec)
+(defun org-bbdb-updated (_rec)
"Record the fact that BBDB has been updated.
This is used by Org to re-create the anniversary hash table."
(setq org-bbdb-updated-p t))
@@ -397,6 +413,83 @@ 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:
+;;;
+;;; %%(org-bbdb-anniversaries-future)
+;;;
+;;; or
+;;;
+;;; %%(org-bbdb-anniversaries-future 3)
+;;;
+;;; 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."
+ (let ((abs (calendar-absolute-from-gregorian d)))
+ (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i)))
+ (number-sequence 0 (1- n)))))
+
+(defun org-bbdb-anniversary-description (agenda-date anniv-date)
+ "Return a string used to incorporate into an agenda anniversary entry.
+The calculation of the anniversary description string is based on
+the difference between the anniversary date, given as ANNIV-DATE,
+and the date on which the entry appears in the agenda, given as
+AGENDA-DATE. This makes it possible to have different entries
+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))
+ ((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)))
+ (when (<= n 0)
+ (error "The (optional) argument of `org-bbdb-anniversaries-future' \
+must be positive"))
+ (let (
+ ;; List of relevant dates.
+ (dates (org-bbdb-date-list date n))
+ ;; Function to annotate text of each element of l with the
+ ;; anniversary date d.
+ (annotate-descriptions
+ (lambda (agenda-date d l)
+ (mapcar (lambda (x)
+ ;; The assumption here is that x is a bbdb link
+ ;; of the form [[bbdb:name][description]].
+ ;; This function rather arbitrarily modifies
+ ;; the description by adding the date to it in
+ ;; a fixed format.
+ (let ((desc (org-bbdb-anniversary-description
+ agenda-date d)))
+ (string-match "]]" x)
+ (replace-match desc nil nil x)))
+ l))))
+ ;; Map a function that generates anniversaries for each date
+ ;; over the dates and nconc the results into a single list. When
+ ;; it is no longer necessary to support older versions of Emacs,
+ ;; this can be done with a cl-mapcan; for now, we use the (apply
+ ;; #'nconc ...) method for compatibility.
+ (apply #'nconc
+ (mapcar
+ (lambda (d)
+ (let ((agenda-date date)
+ (date d))
+ ;; Rebind 'date' so that org-bbdb-anniversaries will
+ ;; be fooled into giving us the list for the given
+ ;; date and then annotate the descriptions for that
+ ;; date.
+ (funcall annotate-descriptions agenda-date d (org-bbdb-anniversaries))))
+ dates)))))
+
(defun org-bbdb-complete-link ()
"Read a bbdb link with name completion."
(require 'bbdb-com)
diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el
index f8b376daa18..8876085fd77 100644
--- a/lisp/org/org-bibtex.el
+++ b/lisp/org/org-bibtex.el
@@ -1,4 +1,4 @@
-;;; org-bibtex.el --- Org links to BibTeX entries
+;;; org-bibtex.el --- Org links to BibTeX entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
;;
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
@@ -73,7 +73,7 @@
;; =====================================================================
;;
;; Additionally, the following functions are now available for storing
-;; bibtex entries within Org-mode documents.
+;; bibtex entries within Org documents.
;;
;; - Run `org-bibtex' to export the current file to a .bib.
;;
@@ -92,27 +92,28 @@
;;
;;; History:
;;
-;; The link creation part has been part of Org-mode for a long time.
+;; 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
;; and then implemented by Bastien Guerry.
;;
;; Eric Schulte eventually added the functions for translating between
-;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex
-;; fields of existing Org-mode headlines.
+;; Org headlines and Bibtex entries, and for fleshing out the Bibtex
+;; fields of existing Org headlines.
;;
-;; Org-mode loads this module by default - if this is not what you want,
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
(require 'org)
(require 'bibtex)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org-compat)
+(defvar org-agenda-overriding-header)
+(defvar org-agenda-search-view-always-boolean)
(defvar org-bibtex-description nil) ; dynamically scoped from org.el
(defvar org-id-locations)
@@ -120,7 +121,6 @@
(declare-function bibtex-generate-autokey "bibtex" ())
(declare-function bibtex-parse-entry "bibtex" (&optional content))
(declare-function bibtex-url "bibtex" (&optional pos no-browse))
-(declare-function org-babel-trim "ob-core" (string &optional regexp))
;;; Bibtex data
@@ -237,6 +237,17 @@ a missing title field."
:version "24.1"
:type 'boolean)
+(defcustom org-bibtex-headline-format-function
+ (lambda (entry) (cdr (assq :title entry)))
+ "Function returning the headline text for `org-bibtex-write'.
+It should take a single argument, the bibtex entry (an alist as
+returned by `org-bibtex-read'). The default value simply returns
+the entry title."
+ :group 'org-bibtex
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :type 'function)
+
(defcustom org-bibtex-export-arbitrary-fields nil
"When converting to bibtex allow fields not defined in `org-bibtex-fields'.
This only has effect if `org-bibtex-prefix' is defined, so as to
@@ -264,26 +275,39 @@ IDs must be unique."
(defcustom org-bibtex-tags-are-keywords nil
"Convert the value of the keywords field to tags and vice versa.
-If set to t, comma-separated entries in a bibtex entry's keywords
-field will be converted to org tags. Note: spaces will be escaped
-with underscores, and characters that are not permitted in org
+
+When non-nil, comma-separated entries in a bibtex entry's keywords
+field will be converted to Org tags. Note: spaces will be escaped
+with underscores, and characters that are not permitted in Org
tags will be removed.
-If t, local tags in an org entry will be exported as a
-comma-separated string of keywords when exported to bibtex. Tags
-defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will
-not be exported."
+When non-nil, local tags in an Org entry will be exported as
+a comma-separated string of keywords when exported to bibtex.
+If `org-bibtex-inherit-tags' is non-nil, inherited tags will also
+be exported as keywords. Tags defined in `org-bibtex-tags' or
+`org-bibtex-no-export-tags' will not be exported."
:group 'org-bibtex
:version "24.1"
:type 'boolean)
(defcustom org-bibtex-no-export-tags nil
"List of tag(s) that should not be converted to keywords.
-This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
+This variable is relevant only if `org-bibtex-tags-are-keywords'
+is non-nil."
:group 'org-bibtex
:version "24.1"
:type '(repeat :tag "Tag" (string)))
+(defcustom org-bibtex-inherit-tags nil
+ "Controls whether inherited tags are converted to bibtex keywords.
+It is relevant only if `org-bibtex-tags-are-keywords' is non-nil.
+Tag inheritance itself is controlled by `org-use-tag-inheritance'
+and `org-exclude-tags-from-inheritance'."
+ :group 'org-bibtex
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'boolean)
+
(defcustom org-bibtex-type-property-name "btype"
"Property in which to store bibtex entry type (e.g., article)."
:group 'org-bibtex
@@ -299,7 +323,7 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
(org-entry-get (point) (upcase property))
(org-entry-get (point) (concat org-bibtex-prefix
(upcase property)))))))
- (when it (org-babel-trim it))))
+ (when it (org-trim it))))
(defun org-bibtex-put (property value)
(let ((prop (upcase (if (keywordp property)
@@ -312,27 +336,27 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
(defun org-bibtex-headline ()
"Return a bibtex entry of the given headline as a string."
- (let* ((val (lambda (key lst) (cdr (assoc key lst))))
- (to (lambda (string) (intern (concat ":" string))))
- (from (lambda (key) (substring (symbol-name key) 1)))
- flatten ; silent compiler warning
- (flatten (lambda (&rest lsts)
- (apply #'append (mapcar
- (lambda (e)
- (if (listp e) (apply flatten e) (list e)))
- lsts))))
- (notes (buffer-string))
- (id (org-bibtex-get org-bibtex-key-property))
- (type (org-bibtex-get org-bibtex-type-property-name))
- (tags (when org-bibtex-tags-are-keywords
- (delq nil
- (mapcar
- (lambda (tag)
- (unless (member tag
- (append org-bibtex-tags
- org-bibtex-no-export-tags))
- tag))
- (org-get-local-tags-at))))))
+ (letrec ((val (lambda (key lst) (cdr (assoc key lst))))
+ (to (lambda (string) (intern (concat ":" string))))
+ (from (lambda (key) (substring (symbol-name key) 1)))
+ (flatten (lambda (&rest lsts)
+ (apply #'append (mapcar
+ (lambda (e)
+ (if (listp e) (apply flatten e) (list e)))
+ lsts))))
+ (id (org-bibtex-get org-bibtex-key-property))
+ (type (org-bibtex-get org-bibtex-type-property-name))
+ (tags (when org-bibtex-tags-are-keywords
+ (delq nil
+ (mapcar
+ (lambda (tag)
+ (unless (member tag
+ (append org-bibtex-tags
+ org-bibtex-no-export-tags))
+ tag))
+ (if org-bibtex-inherit-tags
+ (org-get-tags-at)
+ (org-get-local-tags-at)))))))
(when type
(let ((entry (format
"@%s{%s,\n%s\n}\n" type id
@@ -358,7 +382,7 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t."
(mapcar
(lambda (field)
(let ((value (or (org-bibtex-get (funcall from field))
- (and (equal :title field)
+ (and (eq :title field)
(nth 4 (org-heading-components))))))
(when value (cons (funcall from field) value))))
(funcall flatten
@@ -421,13 +445,14 @@ With optional argument OPTIONAL, also prompt for optional fields."
(funcall val :required (funcall val type org-bibtex-types)))
(when optional (funcall val :optional (funcall val type org-bibtex-types)))))
(when (consp field) ; or'd pair of fields e.g., (:editor :author)
- (let ((present (first (remove
+ (let ((present (nth 0 (remove
nil
(mapcar
- (lambda (f) (when (org-bibtex-get (funcall name f)) f))
+ (lambda (f)
+ (when (org-bibtex-get (funcall name f)) f))
field)))))
(setf field (or present (funcall keyword
- (org-icompleting-read
+ (completing-read
"Field: " (mapcar name field)))))))
(let ((name (funcall name field)))
(unless (org-bibtex-get name)
@@ -439,8 +464,9 @@ With optional argument OPTIONAL, also prompt for optional fields."
;;; Bibtex link functions
-(org-add-link-type "bibtex" 'org-bibtex-open)
-(add-hook 'org-store-link-functions 'org-bibtex-store-link)
+(org-link-set-parameters "bibtex"
+ :follow #'org-bibtex-open
+ :store #'org-bibtex-store-link)
(defun org-bibtex-open (path)
"Visit the bibliography entry on PATH."
@@ -533,21 +559,23 @@ With optional argument OPTIONAL, also prompt for optional fields."
(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex)
-;;; Bibtex <-> Org-mode headline translation functions
-(defun org-bibtex (&optional filename)
+;;; Bibtex <-> Org headline translation functions
+(defun org-bibtex (filename)
"Export each headline in the current file to a bibtex entry.
Headlines are exported using `org-bibtex-headline'."
(interactive
(list (read-file-name
"Bibtex file: " nil nil nil
- (file-name-nondirectory
- (concat (file-name-sans-extension (buffer-file-name)) ".bib")))))
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (and file
+ (file-name-nondirectory
+ (concat (file-name-sans-extension file) ".bib")))))))
(let ((error-point
(catch 'bib
(let ((bibtex-entries
(remove nil (org-map-entries
(lambda ()
- (condition-case foo
+ (condition-case nil
(org-bibtex-headline)
(error (throw 'bib (point)))))))))
(with-temp-file filename
@@ -578,7 +606,7 @@ With prefix argument OPTIONAL also prompt for optional fields."
With a prefix arg, query for optional fields as well.
If nonew is t, add data to the headline of the entry at point."
(interactive "P")
- (let* ((type (org-icompleting-read
+ (let* ((type (completing-read
"Type: " (mapcar (lambda (type)
(substring (symbol-name (car type)) 1))
org-bibtex-types)
@@ -597,7 +625,7 @@ If nonew is t, add data to the headline of the entry at point."
(org-bibtex-put org-bibtex-type-property-name
(substring (symbol-name type) 1))
(org-bibtex-fleshout type arg)
- (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags)))
+ (dolist (tag org-bibtex-tags) (org-toggle-tag tag 'on))))
(defun org-bibtex-create-in-current-entry (&optional arg)
"Add bibliographical data to the current entry.
@@ -611,10 +639,10 @@ This uses `bibtex-parse-entry'."
(interactive)
(let ((keyword (lambda (str) (intern (concat ":" (downcase str)))))
(clean-space (lambda (str) (replace-regexp-in-string
- "[[:space:]\n\r]+" " " str)))
+ "[[:space:]\n\r]+" " " str)))
(strip-delim
- (lambda (str) ; strip enclosing "..." and {...}
- (dolist (pair '((34 . 34) (123 . 125) (123 . 125)))
+ (lambda (str) ; strip enclosing "..." and {...}
+ (dolist (pair '((34 . 34) (123 . 125)))
(when (and (> (length str) 1)
(= (aref str 0) (car pair))
(= (aref str (1- (length str))) (cdr pair)))
@@ -622,10 +650,10 @@ This uses `bibtex-parse-entry'."
(push (mapcar
(lambda (pair)
(cons (let ((field (funcall keyword (car pair))))
- (case field
+ (pcase field
(:=type= :type)
(:=key= :key)
- (otherwise field)))
+ (_ field)))
(funcall clean-space (funcall strip-delim (cdr pair)))))
(save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry)))
org-bibtex-entries)))
@@ -633,7 +661,7 @@ This uses `bibtex-parse-entry'."
(defun org-bibtex-read-buffer (buffer)
"Read all bibtex entries in BUFFER and save to `org-bibtex-entries'.
Return the number of saved entries."
- (interactive "bbuffer: ")
+ (interactive "bBuffer: ")
(let ((start-length (length org-bibtex-entries)))
(with-current-buffer buffer
(save-excursion
@@ -643,12 +671,12 @@ Return the number of saved entries."
(org-bibtex-read)
(bibtex-beginning-of-entry))))
(let ((added (- (length org-bibtex-entries) start-length)))
- (message "parsed %d entries" added)
+ (message "Parsed %d entries" added)
added)))
(defun org-bibtex-read-file (file)
"Read FILE with `org-bibtex-read-buffer'."
- (interactive "ffile: ")
+ (interactive "fFile: ")
(org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile)))
(defun org-bibtex-write ()
@@ -661,30 +689,28 @@ Return the number of saved entries."
(val (lambda (field) (cdr (assoc field entry))))
(togtag (lambda (tag) (org-toggle-tag tag 'on))))
(org-insert-heading)
- (insert (funcall val :title))
+ (insert (funcall org-bibtex-headline-format-function entry))
(org-bibtex-put "TITLE" (funcall val :title))
(org-bibtex-put org-bibtex-type-property-name
(downcase (funcall val :type)))
(dolist (pair entry)
- (case (car pair)
+ (pcase (car pair)
(:title nil)
(:type nil)
(:key (org-bibtex-put org-bibtex-key-property (cdr pair)))
(:keywords (if org-bibtex-tags-are-keywords
- (mapc
- (lambda (kw)
- (funcall
- togtag
- (replace-regexp-in-string
- "[^[:alnum:]_@#%]" ""
- (replace-regexp-in-string "[ \t]+" "_" kw))))
- (split-string (cdr pair) ", *"))
+ (dolist (kw (split-string (cdr pair) ", *"))
+ (funcall
+ togtag
+ (replace-regexp-in-string
+ "[^[:alnum:]_@#%]" ""
+ (replace-regexp-in-string "[ \t]+" "_" kw))))
(org-bibtex-put (car pair) (cdr pair))))
- (otherwise (org-bibtex-put (car pair) (cdr pair)))))
+ (_ (org-bibtex-put (car pair) (cdr pair)))))
(mapc togtag org-bibtex-tags)))
(defun org-bibtex-yank ()
- "If kill ring holds a bibtex entry yank it as an Org-mode headline."
+ "If kill ring holds a bibtex entry yank it as an Org headline."
(interactive)
(let (entry)
(with-temp-buffer (yank 1) (setf entry (org-bibtex-read)))
@@ -693,8 +719,8 @@ Return the number of saved entries."
(error "Yanked text does not appear to contain a BibTeX entry"))))
(defun org-bibtex-import-from-file (file)
- "Read bibtex entries from FILE and insert as Org-mode headlines after point."
- (interactive "ffile: ")
+ "Read bibtex entries from FILE and insert as Org headlines after point."
+ (interactive "fFile: ")
(dotimes (_ (org-bibtex-read-file file))
(save-excursion (org-bibtex-write))
(re-search-forward org-property-end-re)
diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el
index b302113f3e8..03210210864 100644
--- a/lisp/org/org-capture.el
+++ b/lisp/org/org-capture.el
@@ -1,4 +1,4 @@
-;;; org-capture.el --- Fast note taking in Org-mode
+;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
@@ -47,23 +47,23 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org)
+(declare-function org-at-encrypted-entry-p "org-crypt" ())
(declare-function org-datetree-find-date-create "org-datetree"
(date &optional keep-restriction))
-(declare-function org-table-get-specials "org-table" ())
-(declare-function org-table-goto-line "org-table" (N))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
-(declare-function org-at-encrypted-entry-p "org-crypt" ())
-(declare-function org-encrypt-entry "org-crypt" ())
(declare-function org-decrypt-entry "org-crypt" ())
+(declare-function org-encrypt-entry "org-crypt" ())
+(declare-function org-table-analyze "org-table" ())
+(declare-function org-table-current-dline "org-table" ())
+(declare-function org-table-goto-line "org-table" (N))
+(defvar org-end-time-was-given)
(defvar org-remember-default-headline)
(defvar org-remember-templates)
(defvar org-table-hlines)
+(defvar org-table-current-begin-pos)
(defvar dired-buffers)
(defvar org-capture-clock-was-started nil
@@ -76,11 +76,50 @@
;; to indicate that the link properties have already been stored
(defvar org-capture-link-is-already-stored nil)
+(defvar org-capture-is-refiling nil
+ "Non-nil when capture process is refiling an entry.")
+
+(defvar org-capture--prompt-history-table (make-hash-table :test #'equal)
+ "Hash table for all history lists per prompt.")
+
+(defvar org-capture--prompt-history nil
+ "History list for prompt placeholders.")
+
(defgroup org-capture nil
"Options concerning capturing new entries."
:tag "Org Capture"
:group 'org)
+(defun org-capture-upgrade-templates (templates)
+ "Update the template list to the new format.
+TEMPLATES is a template list, as in `org-capture-templates'. The
+new format unifies all the date/week tree targets into one that
+also allows for an optional outline path to specify a target."
+ (let ((modified-templates
+ (mapcar
+ (lambda (entry)
+ (pcase entry
+ ;; Match templates with an obsolete "tree" target type. Replace
+ ;; it with common `file+olp-datetree'. Add new properties
+ ;; (i.e., `:time-prompt' and `:tree-type') if needed.
+ (`(,key ,desc ,type (file+datetree . ,path) ,tpl . ,props)
+ `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl ,@props))
+ (`(,key ,desc ,type (file+datetree+prompt . ,path) ,tpl . ,props)
+ `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
+ :time-prompt t ,@props))
+ (`(,key ,desc ,type (file+weektree . ,path) ,tpl . ,props)
+ `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
+ :tree-type week ,@props))
+ (`(,key ,desc ,type (file+weektree+prompt . ,path) ,tpl . ,props)
+ `(,key ,desc ,type (file+olp+datetree ,@path) ,tpl
+ :tree-type week :time-prompt t ,@props))
+ ;; Other templates are left unchanged.
+ (_ entry)))
+ templates)))
+ (unless (equal modified-templates templates)
+ (message "Deprecated date/weektree capture templates changed to `file+olp+datetree'."))
+ modified-templates))
+
(defcustom org-capture-templates nil
"Templates for the creation of new entries.
@@ -103,9 +142,9 @@ description A short string describing the template, will be shown during
selection.
type The type of entry. Valid types are:
- entry an Org-mode node, with a headline. Will be
- filed as the child of the target entry or as
- a top-level entry.
+ entry an Org node, with a headline. Will be filed
+ as the child of the target entry or as a
+ top-level entry.
item a plain list item, will be placed in the
first plain list at the target
location.
@@ -116,37 +155,39 @@ type The type of entry. Valid types are:
plain text to be inserted as it is.
target Specification of where the captured item should be placed.
- In Org-mode files, targets usually define a node. Entries will
+ In Org files, targets usually define a node. Entries will
become children of this node, other types will be added to the
table or list in the body of this node.
Most target specifications contain a file name. If that file
name is the empty string, it defaults to `org-default-notes-file'.
- A file can also be given as a variable, function, or Emacs Lisp
- form.
+ A file can also be given as a variable or as a function called
+ with no argument. When an absolute path is not specified for a
+ target, it is taken as relative to `org-directory'.
Valid values are:
(file \"path/to/file\")
Text will be placed at the beginning or end of that file
- (id \"id of existing org entry\")
+ (id \"id of existing Org entry\")
File as child of this entry, or in the body of the entry
(file+headline \"path/to/file\" \"node headline\")
Fast configuration if the target heading is unique in the file
(file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
- For non-unique headings, the full path is safer
+ For non-unique headings, the full outline path is safer
(file+regexp \"path/to/file\" \"regexp to find location\")
File to the entry matching regexp
- (file+datetree \"path/to/file\")
- Will create a heading in a date tree for today's date
-
- (file+datetree+prompt \"path/to/file\")
- Will create a heading in a date tree, prompts for date
+ (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
+ Will create a heading in a date tree for today's date.
+ If no heading is given, the tree will be on top level.
+ To prompt for date instead of using TODAY, use the
+ :time-prompt property. To create a week-tree, use the
+ :tree-type property.
(file+function \"path/to/file\" function-finding-location)
A function to find the right location in the file
@@ -155,8 +196,8 @@ target Specification of where the captured item should be placed.
File to the entry that is currently being clocked
(function function-finding-location)
- Most general way, write your own function to find both
- file and location
+ 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
@@ -204,6 +245,11 @@ properties are:
When setting both to t, the current clock will run and
the previous one will not be resumed.
+ :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.
+
:unnarrowed Do not narrow the target buffer, simply show the
full buffer. Default is to narrow it so that you
only see the new stuff.
@@ -218,18 +264,25 @@ properties are:
is finalized.
The template defines the text to be inserted. Often this is an
-org-mode entry (so the first line should start with a star) that
+Org mode entry (so the first line should start with a star) that
will be filed as a child of the target headline. It can also be
freely formatted text. Furthermore, the following %-escapes will
-be replaced with content and expanded in this order:
+be replaced with content and expanded:
- %[pathname] Insert the contents of the file given by `pathname'.
+ %[pathname] Insert the contents of the file given by
+ `pathname'. These placeholders are expanded at the very
+ beginning of the process so they can be used to extend the
+ current template.
%(sexp) Evaluate elisp `(sexp)' and replace it with the results.
- For convenience, %:keyword (see below) placeholders within
- the expression will be expanded prior to this.
+ Only placeholders pre-existing within the template, or
+ introduced with %[pathname] are expanded this way. Since this
+ happens after expanding non-interactive %-escapes, those can
+ be used to fill the expression.
%<...> The result of format-time-string on the ... format specification.
- %t Time stamp, date only.
- %T Time stamp with date and time.
+ %t Time stamp, date only. The time stamp is the current time,
+ except when called from agendas with `\\[org-agenda-capture]' or
+ with `org-capture-use-agenda-date' set.
+ %T Time stamp as above, with date and time.
%u, %U Like the above, but inactive time stamps.
%i Initial content, copied from the active region. If %i is
indented, the entire inserted text will be indented as well.
@@ -247,7 +300,8 @@ be replaced with content and expanded in this order:
%^g Prompt for tags, with completion on tags in target file.
%^G Prompt for tags, with completion on all tags in all agenda files.
%^t Like %t, but prompt for date. Similarly %^T, %^u, %^U.
- You may define a prompt like: %^{Please specify birthday}t
+ You may define a prompt like: %^{Please specify birthday}t.
+ The default date is that of %t, see above.
%^C Interactive selection of which kill or clip to use.
%^L Like %^C, but insert as link.
%^{prop}p Prompt the user for a value for property `prop'.
@@ -255,8 +309,8 @@ be replaced with content and expanded in this order:
A default value and a completion table ca be specified like this:
%^{prompt|default|completion2|completion3|...}.
%? After completing the template, position cursor here.
- %\\n Insert the text entered at the nth %^{prompt}, where `n' is
- a number, starting from 1.
+ %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N
+ is a number, starting from 1.
Apart from these general escapes, you can access information specific to
the link type that is created. For example, calling `org-capture' in emails
@@ -274,13 +328,22 @@ gnus | %:from %:fromname %:fromaddress
| %:date %:date-timestamp (as active timestamp)
| %:date-timestamp-inactive (as inactive timestamp)
gnus | %:group, for messages also all email fields
-w3, w3m | %:type %:url
+eww, w3, w3m | %:type %:url
info | %:type %:file %:node
-calendar | %:type %:date"
+calendar | %:type %:date
+
+When you need to insert a literal percent sign in the template,
+you can escape ambiguous cases with a backward slash, e.g., \\%i."
:group 'org-capture
:version "24.1"
+ :set (lambda (s v) (set s (org-capture-upgrade-templates v)))
:type
- '(repeat
+ (let ((file-variants '(choice :tag "Filename "
+ (file :tag "Literal")
+ (function :tag "Function")
+ (variable :tag "Variable")
+ (sexp :tag "Form"))))
+ `(repeat
(choice :value ("" "" entry (file "~/org/notes.org") "")
(list :tag "Multikey description"
(string :tag "Keys ")
@@ -297,39 +360,38 @@ calendar | %:type %:date"
(choice :tag "Target location"
(list :tag "File"
(const :format "" file)
- (file :tag " File"))
+ ,file-variants)
(list :tag "ID"
(const :format "" id)
(string :tag " ID"))
(list :tag "File & Headline"
(const :format "" file+headline)
- (file :tag " File ")
+ ,file-variants
(string :tag " Headline"))
(list :tag "File & Outline path"
(const :format "" file+olp)
- (file :tag " File ")
+ ,file-variants
(repeat :tag "Outline path" :inline t
(string :tag "Headline")))
(list :tag "File & Regexp"
(const :format "" file+regexp)
- (file :tag " File ")
+ ,file-variants
(regexp :tag " Regexp"))
- (list :tag "File & Date tree"
- (const :format "" file+datetree)
- (file :tag " File"))
- (list :tag "File & Date tree, prompt for date"
- (const :format "" file+datetree+prompt)
- (file :tag " File"))
+ (list :tag "File [ & Outline path ] & Date tree"
+ (const :format "" file+olp+datetree)
+ ,file-variants
+ (option (repeat :tag "Outline path" :inline t
+ (string :tag "Headline"))))
(list :tag "File & function"
(const :format "" file+function)
- (file :tag " File ")
+ ,file-variants
(sexp :tag " Function"))
(list :tag "Current clocking task"
(const :format "" clock))
(list :tag "Function"
(const :format "" function)
(sexp :tag " Function")))
- (choice :tag "Template"
+ (choice :tag "Template "
(string)
(list :tag "File"
(const :format "" file)
@@ -348,9 +410,11 @@ calendar | %:type %:date"
((const :format "%v " :clock-in) (const t))
((const :format "%v " :clock-keep) (const t))
((const :format "%v " :clock-resume) (const t))
+ ((const :format "%v " :time-prompt) (const t))
+ ((const :format "%v " :tree-type) (const week))
((const :format "%v " :unnarrowed) (const t))
- ((const :format "%v " :table-line-pos) (const t))
- ((const :format "%v " :kill-buffer) (const t))))))))
+ ((const :format "%v " :table-line-pos) (string))
+ ((const :format "%v " :kill-buffer) (const t)))))))))
(defcustom org-capture-before-finalize-hook nil
"Hook that is run right before a capture process is finalized.
@@ -421,7 +485,7 @@ to avoid conflicts with other active capture processes."
(defvar org-capture-mode-map (make-sparse-keymap)
"Keymap for `org-capture-mode', a minor mode.
-Use this map to set additional keybindings for when Org-mode is used
+Use this map to set additional keybindings for when Org mode is used
for a capture buffer.")
(defvar org-capture-mode-hook nil
@@ -432,10 +496,12 @@ for a capture buffer.")
Turning on this mode runs the normal hook `org-capture-mode-hook'."
nil " Rem" org-capture-mode-map
- (org-set-local
- 'header-line-format
+ (setq-local
+ header-line-format
(substitute-command-keys
- "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")))
+ "\\<org-capture-mode-map>Capture buffer. Finish \
+`\\[org-capture-finalize]', refile `\\[org-capture-refile]', \
+abort `\\[org-capture-kill]'.")))
(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
@@ -460,7 +526,7 @@ For example, if you have a capture template \"c\" and you want
this template to be accessible only from `message-mode' buffers,
use this:
- ((\"c\" ((in-mode . \"message-mode\"))))
+ \\='((\"c\" ((in-mode . \"message-mode\"))))
Here are the available contexts definitions:
@@ -478,7 +544,7 @@ accessible if there is at least one valid check.
You can also bind a key to another agenda custom command
depending on contextual rules.
- ((\"c\" \"d\" ((in-mode . \"message-mode\"))))
+ \\='((\"c\" \"d\" ((in-mode . \"message-mode\"))))
Here it means: in `message-mode buffers', use \"c\" as the
key for the capture template otherwise associated with \"d\".
@@ -504,7 +570,8 @@ to avoid duplicates.)"
(defcustom org-capture-use-agenda-date nil
"Non-nil means use the date at point when capturing from agendas.
-When nil, you can still capture using the date at point with \\[org-agenda-capture]."
+When nil, you can still capture using the date at point with
+`\\[org-agenda-capture]'."
:group 'org-capture
:version "24.3"
:type 'boolean)
@@ -513,20 +580,26 @@ When nil, you can still capture using the date at point with \\[org-agenda-captu
(defun org-capture (&optional goto keys)
"Capture something.
\\<org-capture-mode-map>
-This will let you select a template from `org-capture-templates', and then
-file the newly captured information. The text is immediately inserted
-at the target location, and an indirect buffer is shown where you can
-edit it. Pressing \\[org-capture-finalize] brings you back to the previous state
-of Emacs, so that you can continue your work.
-
-When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture
-anything, just go to the file/headline where the selected template
-stores its notes. With a double prefix argument \
-\\[universal-argument] \\[universal-argument], go to the last note
-stored.
+This will let you select a template from `org-capture-templates', and
+then file the newly captured information. The text is immediately
+inserted at the target location, and an indirect buffer is shown where
+you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the \
+previous
+state of Emacs, so that you can continue your work.
+
+When called interactively with a `\\[universal-argument]' prefix argument \
+GOTO, don't
+capture anything, just go to the file/headline where the selected
+template stores its notes.
+
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \
+the last note stored.
When called with a `C-0' (zero) prefix, insert a template at point.
+When called with a `C-1' (one) prefix, force prompting for a date when
+a datetree entry is made.
+
ELisp programs can set KEYS to a string associated with a template
in `org-capture-templates'. In this case, interactive selection
will be bypassed.
@@ -544,7 +617,6 @@ of the day at point (if any) or the current HH:MM time."
((equal goto '(4)) (org-capture-goto-target))
((equal goto '(16)) (org-capture-goto-last-stored))
(t
- ;; FIXME: Are these needed?
(let* ((orig-buf (current-buffer))
(annotation (if (and (boundp 'org-capture-link-is-already-stored)
org-capture-link-is-already-stored)
@@ -564,7 +636,7 @@ of the day at point (if any) or the current HH:MM time."
((equal entry "C")
(customize-variable 'org-capture-templates))
((equal entry "q")
- (error "Abort"))
+ (user-error "Abort"))
(t
(org-capture-set-plist entry)
(org-capture-get-template)
@@ -596,10 +668,10 @@ of the day at point (if any) or the current HH:MM time."
(org-capture-insert-template-here)
(condition-case error
(org-capture-place-template
- (equal (car (org-capture-get :target)) 'function))
+ (eq (car (org-capture-get :target)) 'function))
((error quit)
(if (and (buffer-base-buffer (current-buffer))
- (string-match "\\`CAPTURE-" (buffer-name)))
+ (string-prefix-p "CAPTURE-" (buffer-name)))
(kill-buffer (current-buffer)))
(set-window-configuration (org-capture-get :return-to-wconf))
(error "Capture template `%s': %s"
@@ -613,7 +685,7 @@ of the day at point (if any) or the current HH:MM time."
(org-capture-put :interrupted-clock
(copy-marker org-clock-marker)))
(org-clock-in)
- (org-set-local 'org-capture-clock-was-started t))
+ (setq-local org-capture-clock-was-started t))
(error
"Could not start the clock in this capture buffer")))
(if (org-capture-get :immediate-finish)
@@ -646,7 +718,7 @@ captured item after finalizing."
(setq stay-with-capture t))
(unless (and org-capture-mode
(buffer-base-buffer (current-buffer)))
- (error "This does not seem to be a capture buffer for Org-mode"))
+ (error "This does not seem to be a capture buffer for Org mode"))
(run-hooks 'org-capture-prepare-finalize-hook)
@@ -682,23 +754,13 @@ captured item after finalizing."
(m2 (org-capture-get :end-marker 'local)))
(if (and m1 m2 (= m1 beg) (= m2 end))
(progn
- (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry))
+ (setq m2 (if (cdr (assq 'heading org-blank-before-new-entry))
m2 (1+ m2))
m2 (if (< (point-max) m2) (point-max) m2))
(setq abort-note 'clean)
(kill-region m1 m2))
(setq abort-note 'dirty)))
- ;; Make sure that the empty lines after are correct
- (when (and (> (point-max) end) ; indeed, the buffer was still narrowed
- (member (org-capture-get :type 'local)
- '(entry item checkitem plain)))
- (save-excursion
- (goto-char end)
- (or (bolp) (newline))
- (org-capture-empty-lines-after
- (or (org-capture-get :empty-lines-after 'local)
- (org-capture-get :empty-lines 'local) 0))))
;; Postprocessing: Update Statistics cookies, do the sorting
(when (derived-mode-p 'org-mode)
(save-excursion
@@ -715,8 +777,7 @@ captured item after finalizing."
;; Store this place as the last one where we stored something
;; Do the marking in the base buffer, so that it makes sense after
;; the indirect buffer has been killed.
- (when org-capture-bookmark
- (org-capture-bookmark-last-stored-position))
+ (org-capture-store-last-position)
;; Run the hook
(run-hooks 'org-capture-before-finalize-hook))
@@ -770,11 +831,12 @@ captured item after finalizing."
;; Special cases
(cond
(abort-note
- (cond
- ((equal abort-note 'clean)
- (message "Capture process aborted and target buffer cleaned up"))
- ((equal abort-note 'dirty)
- (error "Capture process aborted, but target buffer could not be cleaned up correctly"))))
+ (cl-case abort-note
+ (clean
+ (message "Capture process aborted and target buffer cleaned up"))
+ (dirty
+ (error "Capture process aborted, but target buffer could not be \
+cleaned up correctly"))))
(stay-with-capture
(org-capture-goto-last-stored)))
;; Return if we did store something
@@ -786,19 +848,33 @@ Refiling is done from the base buffer, because the indirect buffer is then
already gone. Any prefix argument will be passed to the refile command."
(interactive)
(unless (eq (org-capture-get :type 'local) 'entry)
- (error
- "Refiling from a capture buffer makes only sense for `entry'-type templates"))
- (let ((pos (point))
- (base (buffer-base-buffer (current-buffer)))
- (org-refile-for-capture t))
- (save-window-excursion
- (with-current-buffer (or base (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (call-interactively 'org-refile)))))
- (org-capture-finalize)))
+ (user-error "Refiling from a capture buffer makes only sense \
+for `entry'-type templates"))
+ (let* ((base (or (buffer-base-buffer) (current-buffer)))
+ (pos (make-marker))
+ (org-capture-is-refiling t)
+ (kill-buffer (org-capture-get :kill-buffer 'local))
+ (jump-to-captured (org-capture-get :jump-to-captured 'local)))
+ ;; Since `org-capture-finalize' may alter buffer contents (e.g.,
+ ;; empty lines) around entry, use a marker to refer to the
+ ;; headline to be refiled. Place the marker in the base buffer,
+ ;; as the current indirect one is going to be killed.
+ (set-marker pos (save-excursion (org-back-to-heading t) (point)) base)
+ ;; `org-capture-finalize' calls `org-capture-goto-last-stored' too
+ ;; early. We want to wait for the refiling to be over, so we
+ ;; control when the latter function is called.
+ (org-capture-put :kill-buffer nil :jump-to-captured nil)
+ (unwind-protect
+ (progn
+ (org-capture-finalize)
+ (save-window-excursion
+ (with-current-buffer base
+ (org-with-wide-buffer
+ (goto-char pos)
+ (call-interactively 'org-refile))))
+ (when kill-buffer (kill-buffer base))
+ (when jump-to-captured (org-capture-goto-last-stored)))
+ (set-marker pos nil))))
(defun org-capture-kill ()
"Abort the current capture process."
@@ -813,7 +889,8 @@ already gone. Any prefix argument will be passed to the refile command."
"Go to the location where the last capture note was stored."
(interactive)
(org-goto-marker-or-bmk org-capture-last-stored-marker
- "org-capture-last-stored")
+ (plist-get org-bookmark-names-plist
+ :last-capture))
(message "This is the last note stored by a capture process"))
;;; Supporting functions for handling the process
@@ -823,7 +900,7 @@ already gone. Any prefix argument will be passed to the refile command."
(org-capture-put
:initial-target-region
;; Check if the buffer is currently narrowed
- (when (/= (buffer-size) (- (point-max) (point-min)))
+ (when (org-buffer-narrowed-p)
(cons (point-min) (point-max))))
;; store the current point
(org-capture-put :initial-target-position (point)))
@@ -832,163 +909,174 @@ already gone. Any prefix argument will be passed to the refile command."
(defun org-capture-set-target-location (&optional target)
"Find TARGET buffer and position.
Store them in the capture property list."
- (let ((target-entry-p t) decrypted-hl-pos)
- (setq target (or target (org-capture-get :target)))
+ (let ((target-entry-p t))
(save-excursion
- (cond
- ((eq (car target) 'file)
- (set-buffer (org-capture-target-buffer (nth 1 target)))
- (org-capture-put-target-region-and-position)
- (widen)
- (setq target-entry-p nil))
-
- ((eq (car target) 'id)
- (let ((loc (org-id-find (nth 1 target))))
- (if (not loc)
- (error "Cannot find target ID \"%s\"" (nth 1 target))
- (set-buffer (org-capture-target-buffer (car loc)))
+ (pcase (or target (org-capture-get :target))
+ (`(file ,path)
+ (set-buffer (org-capture-target-buffer path))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (setq target-entry-p nil))
+ (`(id ,id)
+ (pcase (org-id-find id)
+ (`(,path . ,position)
+ (set-buffer (org-capture-target-buffer path))
(widen)
(org-capture-put-target-region-and-position)
- (goto-char (cdr loc)))))
-
- ((eq (car target) 'file+headline)
- (set-buffer (org-capture-target-buffer (nth 1 target)))
- (org-capture-put-target-region-and-position)
- (widen)
- (let ((hd (nth 2 target)))
- (goto-char (point-min))
- (unless (derived-mode-p 'org-mode)
- (error
- "Target buffer \"%s\" for file+headline should be in Org mode"
- (current-buffer)))
- (if (re-search-forward
- (format org-complex-heading-regexp-format (regexp-quote hd))
- nil t)
- (goto-char (point-at-bol))
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
- (insert "* " hd "\n")
- (beginning-of-line 0))))
-
- ((eq (car target) 'file+olp)
- (let ((m (org-find-olp
- (cons (org-capture-expand-file (nth 1 target))
- (cddr target)))))
- (set-buffer (marker-buffer m))
- (org-capture-put-target-region-and-position)
- (widen)
- (goto-char m)))
-
- ((eq (car target) 'file+regexp)
- (set-buffer (org-capture-target-buffer (nth 1 target)))
- (org-capture-put-target-region-and-position)
- (widen)
- (goto-char (point-min))
- (if (re-search-forward (nth 2 target) nil t)
- (progn
- (goto-char (if (org-capture-get :prepend)
- (match-beginning 0) (match-end 0)))
- (org-capture-put :exact-position (point))
- (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
- (error "No match for target regexp in file %s" (nth 1 target))))
-
- ((memq (car target) '(file+datetree file+datetree+prompt))
- (require 'org-datetree)
- (set-buffer (org-capture-target-buffer (nth 1 target)))
- (org-capture-put-target-region-and-position)
- (widen)
- ;; Make a date tree entry, with the current date (or yesterday,
- ;; if we are extending dates for a couple of hours)
- (org-datetree-find-date-create
- (calendar-gregorian-from-absolute
- (cond
- (org-overriding-default-time
- ;; use the overriding default time
- (time-to-days org-overriding-default-time))
-
- ((eq (car target) 'file+datetree+prompt)
- ;; prompt for date
- (let ((prompt-time (org-read-date
- nil t nil "Date for tree entry:"
- (current-time))))
- (org-capture-put
- :default-time
- (cond ((and (or (not (boundp 'org-time-was-given))
- (not org-time-was-given))
- (not (= (time-to-days prompt-time) (org-today))))
- ;; Use 00:00 when no time is given for another date than today?
- (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time)))))
- ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer)
- ;; Replace any time range by its start
- (apply 'encode-time
- (org-read-date-analyze
- (replace-match "\\1 \\2" nil nil org-read-date-final-answer)
- prompt-time (decode-time prompt-time))))
- (t prompt-time)))
- (time-to-days prompt-time)))
- (t
- ;; current date, possibly corrected for late night workers
- (org-today))))))
-
- ((eq (car target) 'file+function)
- (set-buffer (org-capture-target-buffer (nth 1 target)))
- (org-capture-put-target-region-and-position)
- (widen)
- (funcall (nth 2 target))
- (org-capture-put :exact-position (point))
- (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
-
- ((eq (car target) 'function)
- (funcall (nth 1 target))
- (org-capture-put :exact-position (point))
- (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p))))
-
- ((eq (car target) 'clock)
- (if (and (markerp org-clock-hd-marker)
- (marker-buffer org-clock-hd-marker))
- (progn (set-buffer (marker-buffer org-clock-hd-marker))
- (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")))
-
- (t (error "Invalid capture target specification")))
-
- (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p))
- (org-decrypt-entry)
- (setq decrypted-hl-pos
- (save-excursion (and (org-back-to-heading t) (point)))))
-
- (org-capture-put :buffer (current-buffer) :pos (point)
+ (goto-char position))
+ (_ (error "Cannot find target ID \"%s\"" id))))
+ (`(file+headline ,path ,headline)
+ (set-buffer (org-capture-target-buffer path))
+ (unless (derived-mode-p 'org-mode)
+ (error "Target buffer \"%s\" for file+headline not in Org mode"
+ (current-buffer)))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char (point-min))
+ (if (re-search-forward (format org-complex-heading-regexp-format
+ (regexp-quote headline))
+ nil t)
+ (goto-char (line-beginning-position))
+ (goto-char (point-max))
+ (or (bolp) (insert "\n"))
+ (insert "* " headline "\n")
+ (beginning-of-line 0)))
+ (`(file+olp ,path . ,outline-path)
+ (let ((m (org-find-olp (cons (org-capture-expand-file path)
+ outline-path))))
+ (set-buffer (marker-buffer m))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char m)
+ (set-marker m nil)))
+ (`(file+regexp ,path ,regexp)
+ (set-buffer (org-capture-target-buffer path))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char (point-min))
+ (if (not (re-search-forward regexp nil t))
+ (error "No match for target regexp in file %s" path)
+ (goto-char (if (org-capture-get :prepend)
+ (match-beginning 0)
+ (match-end 0)))
+ (org-capture-put :exact-position (point))
+ (setq target-entry-p
+ (and (derived-mode-p 'org-mode) (org-at-heading-p)))))
+ (`(file+olp+datetree ,path . ,outline-path)
+ (let ((m (if outline-path
+ (org-find-olp (cons (org-capture-expand-file path)
+ outline-path))
+ (set-buffer (org-capture-target-buffer path))
+ (point-marker))))
+ (set-buffer (marker-buffer m))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (goto-char m)
+ (set-marker m nil)
+ (require 'org-datetree)
+ (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)
+ (funcall
+ (if (eq (org-capture-get :tree-type) 'week)
+ #'org-datetree-find-iso-week-create
+ #'org-datetree-find-date-create)
+ (calendar-gregorian-from-absolute
+ (cond
+ (org-overriding-default-time
+ ;; Use the overriding default time.
+ (time-to-days org-overriding-default-time))
+ ((or (org-capture-get :time-prompt)
+ (equal current-prefix-arg 1))
+ ;; Prompt for date.
+ (let ((prompt-time (org-read-date
+ nil t nil "Date for tree entry:"
+ (current-time))))
+ (org-capture-put
+ :default-time
+ (cond ((and (or (not (boundp 'org-time-was-given))
+ (not org-time-was-given))
+ (not (= (time-to-days prompt-time) (org-today))))
+ ;; Use 00:00 when no time is given for another
+ ;; date than today?
+ (apply #'encode-time
+ (append '(0 0 0)
+ (cl-cdddr (decode-time prompt-time)))))
+ ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)"
+ org-read-date-final-answer)
+ ;; Replace any time range by its start.
+ (apply #'encode-time
+ (org-read-date-analyze
+ (replace-match "\\1 \\2" nil nil
+ org-read-date-final-answer)
+ prompt-time (decode-time prompt-time))))
+ (t prompt-time)))
+ (time-to-days prompt-time)))
+ (t
+ ;; Current date, possibly corrected for late night
+ ;; workers.
+ (org-today))))
+ ;; the following is the keep-restriction argument for
+ ;; org-datetree-find-date-create
+ (if outline-path 'subtree-at-point))))
+ (`(file+function ,path ,function)
+ (set-buffer (org-capture-target-buffer path))
+ (org-capture-put-target-region-and-position)
+ (widen)
+ (funcall function)
+ (org-capture-put :exact-position (point))
+ (setq target-entry-p
+ (and (derived-mode-p 'org-mode) (org-at-heading-p))))
+ (`(function ,fun)
+ (funcall fun)
+ (org-capture-put :exact-position (point))
+ (setq target-entry-p
+ (and (derived-mode-p 'org-mode) (org-at-heading-p))))
+ (`(clock)
+ (if (and (markerp org-clock-hd-marker)
+ (marker-buffer org-clock-hd-marker))
+ (progn (set-buffer (marker-buffer org-clock-hd-marker))
+ (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")))
+ (target (error "Invalid capture target specification: %S" target)))
+
+ (org-capture-put :buffer (current-buffer)
+ :pos (point)
:target-entry-p target-entry-p
- :decrypted decrypted-hl-pos))))
+ :decrypted
+ (and (featurep 'org-crypt)
+ (org-at-encrypted-entry-p)
+ (save-excursion
+ (org-decrypt-entry)
+ (and (org-back-to-heading t) (point))))))))
(defun org-capture-expand-file (file)
- "Expand functions and symbols for FILE.
+ "Expand functions, symbols and file names for FILE.
When FILE is a function, call it. When it is a form, evaluate
-it. When it is a variable, retrieve the value. Return whatever we get."
- (cond
- ((org-string-nw-p file) file)
- ((functionp file) (funcall file))
- ((and (symbolp file) (boundp file)) (symbol-value file))
- ((and file (consp file)) (eval file))
- (t file)))
+it. When it is a variable, return its value. When it is
+a string, treat it as a file name, possibly expanding it
+according to `org-directory', and return it. If it is the empty
+string, however, return `org-default-notes-file'. In any other
+case, raise an error."
+ (let ((location (cond ((equal file "") org-default-notes-file)
+ ((stringp file) (expand-file-name file org-directory))
+ ((functionp file) (funcall file))
+ ((and (symbolp file) (boundp file)) (symbol-value file))
+ (t nil))))
+ (or (org-string-nw-p location)
+ (error "Invalid file location: %S" location))))
(defun org-capture-target-buffer (file)
- "Get a buffer for FILE."
- (setq file (org-capture-expand-file file))
- (setq file (or (org-string-nw-p file)
- org-default-notes-file
- (error "No notes file specified, and no default available")))
- (or (org-find-base-buffer-visiting file)
- (progn (org-capture-put :new-buffer t)
- (find-file-noselect (expand-file-name file org-directory)))))
-
-(defun org-capture-steal-local-variables (buffer)
- "Install Org-mode local variables of BUFFER."
- (mapc (lambda (v)
- (ignore-errors (org-set-local (car v) (cdr v))))
- (buffer-local-variables buffer)))
+ "Get a buffer for FILE.
+FILE is a generalized file location, as handled by
+`org-capture-expand-file'."
+ (let ((file (org-capture-expand-file file)))
+ (or (org-find-base-buffer-visiting file)
+ (progn (org-capture-put :new-buffer t)
+ (find-file-noselect file)))))
(defun org-capture-place-template (&optional inhibit-wconf-store)
"Insert the template at the target location, and display the buffer.
@@ -1000,65 +1088,52 @@ may have been stored before."
(org-switch-to-buffer-other-window
(org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
(widen)
- (show-all)
+ (outline-show-all)
(goto-char (org-capture-get :pos))
- (org-set-local 'org-capture-target-marker
- (point-marker))
- (org-set-local 'outline-level 'org-outline-level)
- (let* ((template (org-capture-get :template))
- (type (org-capture-get :type)))
- (case type
- ((nil entry) (org-capture-place-entry))
- (table-line (org-capture-place-table-line))
- (plain (org-capture-place-plain-text))
- (item (org-capture-place-item))
- (checkitem (org-capture-place-item))))
+ (setq-local outline-level 'org-outline-level)
+ (pcase (org-capture-get :type)
+ ((or `nil `entry) (org-capture-place-entry))
+ (`table-line (org-capture-place-table-line))
+ (`plain (org-capture-place-plain-text))
+ (`item (org-capture-place-item))
+ (`checkitem (org-capture-place-item)))
(org-capture-mode 1)
- (org-set-local 'org-capture-current-plist org-capture-plist))
+ (setq-local org-capture-current-plist org-capture-plist))
(defun org-capture-place-entry ()
"Place the template as a new Org entry."
- (let* ((txt (org-capture-get :template))
- (reversed (org-capture-get :prepend))
- (target-entry-p (org-capture-get :target-entry-p))
- level beg end file)
-
- (cond
- ((org-capture-get :exact-position)
+ (let ((reversed? (org-capture-get :prepend))
+ (level 1))
+ (when (org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
- ((not target-entry-p)
- ;; Insert as top-level entry, either at beginning or at end of file
- (setq level 1)
- (if reversed
- (progn (goto-char (point-min))
- (or (org-at-heading-p)
- (outline-next-heading)))
- (goto-char (point-max))
- (or (bolp) (insert "\n"))))
- (t
- ;; Insert as a child of the current entry
- (and (looking-at "\\*+")
- (setq level (- (match-end 0) (match-beginning 0))))
- (setq level (org-get-valid-level (or level 1) 1))
- (if reversed
- (progn
- (outline-next-heading)
- (or (bolp) (insert "\n")))
- (org-end-of-subtree t nil)
- (or (bolp) (insert "\n")))))
+ (cond
+ ;; Insert as a child of the current entry.
+ ((org-capture-get :target-entry-p)
+ (setq level (org-get-valid-level
+ (if (org-at-heading-p) (org-outline-level) 1)
+ 1))
+ (if reversed? (outline-next-heading) (org-end-of-subtree t)))
+ ;; Insert as a top-level entry at the beginning of the file.
+ (reversed?
+ (goto-char (point-min))
+ (unless (org-at-heading-p) (outline-next-heading)))
+ ;; Otherwise, insert as a top-level entry at the end of the file.
+ (t (goto-char (point-max))))
+ (unless (bolp) (insert "\n"))
(org-capture-empty-lines-before)
- (setq beg (point))
- (org-capture-verify-tree txt)
- (org-paste-subtree level txt 'for-yank)
- (org-capture-empty-lines-after 1)
- (org-capture-position-for-last-stored beg)
- (outline-next-heading)
- (setq end (point))
- (org-capture-mark-kill-region beg (1- end))
- (org-capture-narrow beg (1- end))
- (if (or (re-search-backward "%\\?" beg t)
- (re-search-forward "%\\?" end t))
- (replace-match ""))))
+ (let ((beg (point))
+ (template (org-capture-get :template)))
+ (org-capture-verify-tree template)
+ (org-paste-subtree level template 'for-yank)
+ (org-capture-empty-lines-after)
+ (org-capture-position-for-last-stored beg)
+ (unless (org-at-heading-p) (outline-next-heading))
+ (let ((end (point)))
+ (org-capture-mark-kill-region beg end)
+ (org-capture-narrow beg end)
+ (when (or (re-search-backward "%\\?" beg t)
+ (re-search-forward "%\\?" end t))
+ (replace-match ""))))))
(defun org-capture-place-item ()
"Place the template as a new plain list item."
@@ -1075,21 +1150,18 @@ may have been stored before."
(t
(setq beg (1+ (point-at-eol))
end (save-excursion (outline-next-heading) (point)))))
+ (setq ind nil)
(if (org-capture-get :prepend)
(progn
(goto-char beg)
- (if (org-list-search-forward (org-item-beginning-re) end t)
- (progn
- (goto-char (match-beginning 0))
- (setq ind (org-get-indentation)))
- (goto-char end)
- (setq ind 0)))
+ (when (org-list-search-forward (org-item-beginning-re) end t)
+ (goto-char (match-beginning 0))
+ (setq ind (org-get-indentation))))
(goto-char end)
- (if (org-list-search-backward (org-item-beginning-re) beg t)
- (progn
- (setq ind (org-get-indentation))
- (org-end-of-item))
- (setq ind 0))))
+ (when (org-list-search-backward (org-item-beginning-re) beg t)
+ (setq ind (org-get-indentation))
+ (org-end-of-item)))
+ (unless ind (goto-char end)))
;; Remove common indentation
(setq txt (org-remove-indentation txt))
;; Make sure this is indeed an item
@@ -1097,23 +1169,28 @@ may have been stored before."
(setq txt (concat "- "
(mapconcat 'identity (split-string txt "\n")
"\n "))))
+ ;; Prepare surrounding empty lines.
+ (unless (bolp) (insert "\n"))
+ (org-capture-empty-lines-before)
+ (setq beg (point))
+ (unless (eolp) (save-excursion (insert "\n")))
+ (unless ind
+ (org-indent-line)
+ (setq ind (org-get-indentation))
+ (delete-region beg (point)))
;; Set the correct indentation, depending on context
(setq ind (make-string ind ?\ ))
(setq txt (concat ind
(mapconcat 'identity (split-string txt "\n")
(concat "\n" ind))
"\n"))
- ;; Insert, with surrounding empty lines
- (org-capture-empty-lines-before)
- (setq beg (point))
+ ;; Insert item.
(insert txt)
- (or (bolp) (insert "\n"))
- (org-capture-empty-lines-after 1)
+ (org-capture-empty-lines-after)
(org-capture-position-for-last-stored beg)
- (forward-char 1)
(setq end (point))
- (org-capture-mark-kill-region beg (1- end))
- (org-capture-narrow beg (1- end))
+ (org-capture-mark-kill-region beg end)
+ (org-capture-narrow beg end)
(if (or (re-search-backward "%\\?" beg t)
(re-search-forward "%\\?" end t))
(replace-match ""))))
@@ -1124,7 +1201,7 @@ may have been stored before."
(let* ((txt (org-capture-get :template))
(target-entry-p (org-capture-get :target-entry-p))
(table-line-pos (org-capture-get :table-line-pos))
- ind beg end)
+ beg end)
(cond
((org-capture-get :exact-position)
(goto-char (org-capture-get :exact-position)))
@@ -1149,21 +1226,24 @@ may have been stored before."
;; Check if the template is good
(if (not (string-match org-table-dataline-regexp txt))
(setq txt "| %?Bad template |\n"))
+ (if (functionp table-line-pos)
+ (setq table-line-pos (funcall table-line-pos))
+ (setq table-line-pos (eval table-line-pos)))
(cond
((and table-line-pos
(string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos))
- ;; we have a complex line specification
(goto-char (point-min))
- (let ((nh (- (match-end 1) (match-beginning 1)))
- (delta (string-to-number (match-string 2 table-line-pos)))
- ll)
+ ;; we have a complex line specification
+ (let ((ll (ignore-errors
+ (save-match-data (org-table-analyze))
+ (aref org-table-hlines
+ (- (match-end 1) (match-beginning 1)))))
+ (delta (string-to-number (match-string 2 table-line-pos))))
;; The user wants a special position in the table
- (org-table-get-specials)
- (setq ll (ignore-errors (aref org-table-hlines nh)))
- (unless ll (error "Invalid table line specification \"%s\""
- table-line-pos))
- (setq ll (+ ll delta (if (< delta 0) 0 -1)))
- (org-goto-line ll)
+ (unless ll
+ (error "Invalid table line specification \"%s\"" table-line-pos))
+ (goto-char org-table-current-begin-pos)
+ (forward-line (+ ll delta (if (< delta 0) 0 -1)))
(org-table-insert-row 'below)
(beginning-of-line 1)
(delete-region (point) (1+ (point-at-eol)))
@@ -1216,7 +1296,7 @@ Of course, if exact position has been required, just put it there."
;; we should place the text into this entry
(if (org-capture-get :prepend)
;; Skip meta data and drawers
- (org-end-of-meta-data-and-drawers)
+ (org-end-of-meta-data t)
;; go to ent of the entry text, before the next headline
(outline-next-heading)))
(t
@@ -1226,7 +1306,7 @@ Of course, if exact position has been required, just put it there."
(org-capture-empty-lines-before)
(setq beg (point))
(insert txt)
- (org-capture-empty-lines-after 1)
+ (org-capture-empty-lines-after)
(org-capture-position-for-last-stored beg)
(setq end (point))
(org-capture-mark-kill-region beg (1- end))
@@ -1237,8 +1317,8 @@ Of course, if exact position has been required, just put it there."
(defun org-capture-mark-kill-region (beg end)
"Mark the region that will have to be killed when aborting capture."
- (let ((m1 (move-marker (make-marker) beg))
- (m2 (move-marker (make-marker) end)))
+ (let ((m1 (copy-marker beg))
+ (m2 (copy-marker end t)))
(org-capture-put :begin-marker m1)
(org-capture-put :end-marker m2)))
@@ -1256,8 +1336,8 @@ Of course, if exact position has been required, just put it there."
(org-table-current-dline))))
(t (error "This should not happen"))))
-(defun org-capture-bookmark-last-stored-position ()
- "Bookmark the last-captured position."
+(defun org-capture-store-last-position ()
+ "Store the last-captured position."
(let* ((where (org-capture-get :position-for-last-stored 'local))
(pos (cond
((markerp where)
@@ -1270,16 +1350,11 @@ Of course, if exact position has been required, just put it there."
(point-at-bol))
(point))))))
(with-current-buffer (buffer-base-buffer (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (let ((bookmark-name (plist-get org-bookmark-names-plist
- :last-capture)))
- (when bookmark-name
- (with-demoted-errors
- (bookmark-set bookmark-name))))
- (move-marker org-capture-last-stored-marker (point)))))))
+ (org-with-point-at pos
+ (when org-capture-bookmark
+ (let ((bookmark (plist-get org-bookmark-names-plist :last-capture)))
+ (when bookmark (with-demoted-errors (bookmark-set bookmark)))))
+ (move-marker org-capture-last-stored-marker (point))))))
(defun org-capture-narrow (beg end)
"Narrow, unless configuration says not to narrow."
@@ -1315,7 +1390,7 @@ Point will remain at the first line after the inserted text."
(let* ((template (org-capture-get :template))
(type (org-capture-get :type))
beg end pp)
- (or (bolp) (newline))
+ (unless (bolp) (insert "\n"))
(setq beg (point))
(cond
((and (eq type 'entry) (derived-mode-p 'org-mode))
@@ -1337,13 +1412,16 @@ Point will remain at the first line after the inserted text."
(org-capture-empty-lines-after)
(goto-char beg)
(org-list-repair)
- (org-end-of-item)
- (setq end (point)))
- (t (insert template)))
+ (org-end-of-item))
+ (t
+ (insert template)
+ (org-capture-empty-lines-after)
+ (skip-chars-forward " \t\n")
+ (unless (eobp) (beginning-of-line))))
(setq end (point))
(goto-char beg)
- (if (re-search-forward "%\\?" end t)
- (replace-match ""))))
+ (when (re-search-forward "%\\?" end t)
+ (replace-match ""))))
(defun org-capture-set-plist (entry)
"Initialize the property list from the template definition."
@@ -1365,13 +1443,11 @@ Point will remain at the first line after the inserted text."
"Go to the target location of a capture template.
The user is queried for the template."
(interactive)
- (let* (org-select-template-temp-major-mode
- (entry (org-capture-select-template template-key)))
- (unless entry
- (error "No capture template selected"))
+ (let ((entry (org-capture-select-template template-key)))
+ (unless entry (error "No capture template selected"))
(org-capture-set-plist entry)
(org-capture-set-target-location)
- (org-pop-to-buffer-same-window (org-capture-get :buffer))
+ (pop-to-buffer-same-window (org-capture-get :buffer))
(goto-char (org-capture-get :pos))))
(defun org-capture-get-indirect-buffer (&optional buffer prefix)
@@ -1381,7 +1457,7 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(let ((n 1) (base (buffer-name buffer)) bname)
(setq bname (concat prefix "-" base))
(while (buffer-live-p (get-buffer bname))
- (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base)))
+ (setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
(error
@@ -1396,6 +1472,7 @@ Use PREFIX as a prefix for the name of the indirect buffer."
(defun org-mks (table title &optional prompt specials)
"Select a member of an alist with multiple keys.
+
TABLE is the alist which should contain entries where the car is a string.
There should be two types of entries.
@@ -1403,7 +1480,7 @@ There should be two types of entries.
This indicates that `a' is a prefix key for multi-letter selection, and
that there are entries following with keys like \"ab\", \"ax\"...
-2. Selectable members must have more than two elements, with the first
+2. Select-able members must have more than two elements, with the first
being the string of keys that lead to selecting it, and the second a
short description string of the item.
@@ -1414,84 +1491,72 @@ When you press a prefix key, the commands (and maybe further prefixes)
under this key will be shown and offered for selection.
TITLE will be placed over the selection in the temporary buffer,
-PROMPT will be used when prompting for a key. SPECIAL is an alist with
-also (\"key\" \"description\") entries. When one of these is selection,
-only the bare key is returned."
- (setq prompt (or prompt "Select: "))
- (let (tbl orig-table dkey ddesc des-keys allowed-keys
- current prefix rtn re pressed buffer (inhibit-quit t))
- (save-window-excursion
- (setq buffer (org-switch-to-buffer-other-window "*Org Select*"))
- (setq orig-table table)
- (catch 'exit
- (while t
- (erase-buffer)
- (insert title "\n\n")
- (setq tbl table
- des-keys nil
- allowed-keys nil
- cursor-type nil)
- (setq prefix (if current (concat current " ") ""))
- (while tbl
- (cond
- ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
- ;; This is a description on this level
- (setq dkey (caar tbl) ddesc (cadar tbl))
- (pop tbl)
- (push dkey des-keys)
- (push dkey allowed-keys)
- (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n")
- ;; Skip keys which are below this prefix
- (setq re (concat "\\`" (regexp-quote dkey)))
- (let (case-fold-search)
- (while (and tbl (string-match re (caar tbl))) (pop tbl))))
- ((= 2 (length (car tbl)))
- ;; Not yet a usable description, skip it
- )
- (t
- ;; usable entry on this level
- (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n")
- (push (caar tbl) allowed-keys)
- (pop tbl))))
- (when specials
- (insert "-------------------------------------------------------------------------------\n")
- (let ((sp specials))
- (while sp
- (insert (format "[%s] %s\n"
- (caar sp) (nth 1 (car sp))))
- (push (caar sp) allowed-keys)
- (pop sp))))
- (push "\C-g" allowed-keys)
- (goto-char (point-min))
- (if (not (pos-visible-in-window-p (point-max)))
- (org-fit-window-to-buffer))
- (message prompt)
- (setq pressed (char-to-string (read-char-exclusive)))
- (while (not (member pressed allowed-keys))
- (message "Invalid key `%s'" pressed) (sit-for 1)
- (message prompt)
- (setq pressed (char-to-string (read-char-exclusive))))
- (when (equal pressed "\C-g")
- (kill-buffer buffer)
- (error "Abort"))
- (when (and (not (assoc pressed table))
- (not (member pressed des-keys))
- (assoc pressed specials))
- (throw 'exit (setq rtn pressed)))
- (unless (member pressed des-keys)
- (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
- orig-table))))
- (setq current (concat current pressed))
- (setq table (mapcar
- (lambda (x)
- (if (and (> (length (car x)) 1)
- (equal (substring (car x) 0 1) pressed))
- (cons (substring (car x) 1) (cdr x))
- nil))
- table))
- (setq table (remove nil table)))))
- (when buffer (kill-buffer buffer))
- rtn))
+PROMPT will be used when prompting for a key. SPECIAL is an
+alist with (\"key\" \"description\") entries. When one of these
+is selected, only the bare key is returned."
+ (save-window-excursion
+ (let ((inhibit-quit t)
+ (buffer (org-switch-to-buffer-other-window "*Org Select*"))
+ (prompt (or prompt "Select: "))
+ current)
+ (unwind-protect
+ (catch 'exit
+ (while t
+ (erase-buffer)
+ (insert title "\n\n")
+ (let ((des-keys nil)
+ (allowed-keys '("\C-g"))
+ (cursor-type nil))
+ ;; Populate allowed keys and descriptions keys
+ ;; available with CURRENT selector.
+ (let ((re (format "\\`%s\\(.\\)\\'"
+ (if current (regexp-quote current) "")))
+ (prefix (if current (concat current " ") "")))
+ (dolist (entry table)
+ (pcase entry
+ ;; Description.
+ (`(,(and key (pred (string-match re))) ,desc)
+ (let ((k (match-string 1 key)))
+ (push k des-keys)
+ (push k allowed-keys)
+ (insert prefix "[" k "]" "..." " " desc "..." "\n")))
+ ;; Usable entry.
+ (`(,(and key (pred (string-match re))) ,desc . ,_)
+ (let ((k (match-string 1 key)))
+ (insert prefix "[" k "]" " " desc "\n")
+ (push k allowed-keys)))
+ (_ nil))))
+ ;; Insert special entries, if any.
+ (when specials
+ (insert "----------------------------------------------------\
+---------------------------\n")
+ (pcase-dolist (`(,key ,description) specials)
+ (insert (format "[%s] %s\n" key description))
+ (push key allowed-keys)))
+ ;; 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))
+ (message prompt)
+ (let ((pressed (char-to-string (read-char-exclusive))))
+ (while (not (member pressed allowed-keys))
+ (message "Invalid key `%s'" pressed) (sit-for 1)
+ (message prompt)
+ (setq pressed (char-to-string (read-char-exclusive))))
+ (setq current (concat current pressed))
+ (cond
+ ((equal pressed "\C-g") (user-error "Abort"))
+ ;; Selection is a prefix: open a new menu.
+ ((member pressed des-keys))
+ ;; Selection matches an association: return it.
+ ((let ((entry (assoc current table)))
+ (and entry (throw 'exit entry))))
+ ;; Selection matches a special entry: return the
+ ;; selection prefix.
+ ((assoc current specials) (throw 'exit current))
+ (t (error "No entry available")))))))
+ (when buffer (kill-buffer buffer))))))
;;; The template code
(defun org-capture-select-template (&optional keys)
@@ -1499,7 +1564,8 @@ only the bare key is returned."
Lisp programs can force the template by setting KEYS to a string."
(let ((org-capture-templates
(or (org-contextualize-keys
- org-capture-templates org-capture-templates-contexts)
+ (org-capture-upgrade-templates org-capture-templates)
+ org-capture-templates-contexts)
'(("t" "Task" entry (file+headline "" "Tasks")
"* TODO %?\n %u\n %a")))))
(if keys
@@ -1511,46 +1577,41 @@ Lisp programs can force the template by setting KEYS to a string."
'(("C" "Customize org-capture-templates")
("q" "Abort"))))))
+(defvar org-capture--clipboards nil
+ "List various clipboards values.")
+
(defun org-capture-fill-template (&optional template initial annotation)
"Fill a template and return the filled template as a string.
The template may still contain \"%?\" for cursor positioning."
- (setq template (or template (org-capture-get :template)))
- (when (stringp initial)
- (setq initial (org-no-properties initial)))
- (let* ((buffer (org-capture-get :buffer))
+ (let* ((template (or template (org-capture-get :template)))
+ (buffer (org-capture-get :buffer))
(file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
- (ct (org-capture-get :default-time))
- (dct (decode-time ct))
- (ct1
- (if (< (nth 2 dct) org-extend-today-until)
- (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
- ct))
- (plist-p (if org-store-link-plist t nil))
- (v-c (and (> (length kill-ring) 0) (current-kill 0)))
+ (time (let* ((c (or (org-capture-get :default-time) (current-time)))
+ (d (decode-time c)))
+ (if (< (nth 2 d) org-extend-today-until)
+ (encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d))
+ c)))
+ (v-t (format-time-string (org-time-stamp-format nil) time))
+ (v-T (format-time-string (org-time-stamp-format t) time))
+ (v-u (format-time-string (org-time-stamp-format nil t) time))
+ (v-U (format-time-string (org-time-stamp-format t t) time))
+ (v-c (and kill-ring (current-kill 0)))
(v-x (or (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)))
- (v-t (format-time-string (car org-time-stamp-formats) ct1))
- (v-T (format-time-string (cdr org-time-stamp-formats) ct1))
- (v-u (concat "[" (substring v-t 1 -1) "]"))
- (v-U (concat "[" (substring v-T 1 -1) "]"))
- ;; `initial' and `annotation' might habe been passed.
- ;; But if the property list has them, we prefer those values
+ ;; `initial' and `annotation' might have been passed. But if
+ ;; the property list has them, we prefer those values.
(v-i (or (plist-get org-store-link-plist :initial)
- initial
+ (and (stringp initial) (org-no-properties initial))
(org-capture-get :initial)
""))
- (v-a (or (plist-get org-store-link-plist :annotation)
- annotation
- (org-capture-get :annotation)
- ""))
- ;; Is the link empty? Then we do not want it...
- (v-a (if (equal v-a "[[]]") "" v-a))
- (clipboards (remove nil (list v-i
- (org-get-x-clipboard 'PRIMARY)
- (org-get-x-clipboard 'CLIPBOARD)
- (org-get-x-clipboard 'SECONDARY)
- v-c)))
+ (v-a
+ (let ((a (or (plist-get org-store-link-plist :annotation)
+ annotation
+ (org-capture-get :annotation)
+ "")))
+ ;; Is the link empty? Then we do not want it...
+ (if (equal a "[[]]") "" a)))
(l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]")
(v-A (if (and v-a (string-match l-re v-a))
(replace-match "[[\\1][%^{Link description}]]" nil nil v-a)
@@ -1560,201 +1621,272 @@ The template may still contain \"%?\" for cursor positioning."
v-a))
(v-n user-full-name)
(v-k (if (marker-buffer org-clock-marker)
- (org-no-properties org-clock-heading)))
+ (org-no-properties org-clock-heading)
+ ""))
(v-K (if (marker-buffer org-clock-marker)
(org-make-link-string
- (buffer-file-name (marker-buffer org-clock-marker))
- org-clock-heading)))
+ (format "%s::*%s"
+ (buffer-file-name (marker-buffer org-clock-marker))
+ v-k)
+ v-k)
+ ""))
(v-f (or (org-capture-get :original-file-nondirectory) ""))
(v-F (or (org-capture-get :original-file) ""))
- v-I
- (org-startup-folded nil)
- (org-inhibit-startup t)
- org-time-was-given org-end-time-was-given x
- prompt completions char time pos default histvar strings)
-
- (setq org-store-link-plist
- (plist-put org-store-link-plist :annotation v-a)
- org-store-link-plist
- (plist-put org-store-link-plist :initial v-i))
- (setq initial v-i)
-
- (unless template (setq template "") (message "No template") (ding)
- (sit-for 1))
+ (org-capture--clipboards
+ (delq nil
+ (list v-i
+ (org-get-x-clipboard 'PRIMARY)
+ (org-get-x-clipboard 'CLIPBOARD)
+ (org-get-x-clipboard 'SECONDARY)
+ v-c))))
+
+ (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a))
+ (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i))
+
+ (unless template
+ (setq template "")
+ (message "no template") (ding)
+ (sit-for 1))
(save-window-excursion
- (delete-other-windows)
- (org-pop-to-buffer-same-window (get-buffer-create "*Capture*"))
+ (org-switch-to-buffer-other-window (get-buffer-create "*Capture*"))
(erase-buffer)
+ (setq buffer-file-name nil)
+ (setq mark-active nil)
(insert template)
(goto-char (point-min))
- (org-capture-steal-local-variables buffer)
- (setq buffer-file-name nil mark-active nil)
- ;; %[] Insert contents of a file.
- (goto-char (point-min))
- (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
- (unless (org-capture-escaped-%)
- (let ((start (match-beginning 0))
- (end (match-end 0))
- (filename (expand-file-name (match-string 1))))
- (goto-char start)
- (delete-region start end)
- (condition-case error
- (insert-file-contents filename)
- (error (insert (format "%%![Could not insert %s: %s]"
- filename error)))))))
- ;; %() embedded elisp
- (org-capture-expand-embedded-elisp)
+ ;; %[] insert contents of a file.
+ (save-excursion
+ (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
+ (let ((filename (expand-file-name (match-string 1)))
+ (beg (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0))))
+ (unless (org-capture-escaped-%)
+ (delete-region beg end)
+ (set-marker beg nil)
+ (set-marker end nil)
+ (condition-case error
+ (insert-file-contents filename)
+ (error
+ (insert (format "%%![couldn not insert %s: %s]"
+ filename
+ error))))))))
- ;; The current time
- (goto-char (point-min))
- (while (re-search-forward "%<\\([^>\n]+\\)>" nil t)
- (replace-match (format-time-string (match-string 1)) t t))
+ ;; Mark %() embedded elisp for later evaluation.
+ (org-capture-expand-embedded-elisp 'mark)
- ;; Simple %-escapes
- (goto-char (point-min))
- (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t)
- (unless (org-capture-escaped-%)
- (when (and initial (equal (match-string 0) "%i"))
- (save-match-data
- (let* ((lead (buffer-substring
- (point-at-bol) (match-beginning 0))))
- (setq v-i (mapconcat 'identity
- (org-split-string initial "\n")
- (concat "\n" lead))))))
- (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "")
- t t)))
-
- ;; From the property list
- (when plist-p
- (goto-char (point-min))
- (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
- (unless (org-capture-escaped-%)
- (and (setq x (or (plist-get org-store-link-plist
- (intern (match-string 1))) ""))
- (replace-match x t t)))))
-
- ;; Turn on org-mode in temp buffer, set local variables
- ;; This is to support completion in interactive prompts
+ ;; Expand non-interactive templates.
+ (let ((regexp "%\\(:[-a-za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlntTuUx]\\)"))
+ (save-excursion
+ (while (re-search-forward regexp nil t)
+ ;; `org-capture-escaped-%' may modify buffer and cripple
+ ;; match-data. Use markers instead. Ditto for other
+ ;; templates.
+ (let ((pos (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0)))
+ (value (match-string 1))
+ (time-string (match-string 2)))
+ (unless (org-capture-escaped-%)
+ (delete-region pos end)
+ (set-marker pos nil)
+ (set-marker end nil)
+ (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p))
+ (replacement
+ (pcase (string-to-char value)
+ (?< (format-time-string time-string time))
+ (?:
+ (or (plist-get org-store-link-plist (intern value))
+ ""))
+ (?i
+ (if inside-sexp? v-i
+ ;; Outside embedded Lisp, repeat leading
+ ;; characters before initial place holder
+ ;; every line.
+ (let ((lead (buffer-substring-no-properties
+ (line-beginning-position) (point))))
+ (replace-regexp-in-string "\n\\(.\\)"
+ (concat lead "\\1")
+ v-i nil nil 1))))
+ (?a v-a)
+ (?A v-A)
+ (?c v-c)
+ (?f v-f)
+ (?F v-F)
+ (?k v-k)
+ (?K v-K)
+ (?l v-l)
+ (?n v-n)
+ (?t v-t)
+ (?T v-T)
+ (?u v-u)
+ (?U v-U)
+ (?x v-x))))
+ (insert
+ (if inside-sexp?
+ ;; Escape sensitive characters.
+ (replace-regexp-in-string "[\\\"]" "\\\\\\&" replacement)
+ replacement))))))))
+
+ ;; Expand %() embedded Elisp. Limit to Sexp originally marked.
+ (org-capture-expand-embedded-elisp)
+
+ ;; Expand interactive templates. This is the last step so that
+ ;; template is mostly expanded when prompting happens. Turn on
+ ;; Org mode and set local variables. This is to support
+ ;; completion in interactive prompts.
(let ((org-inhibit-startup t)) (org-mode))
- ;; Interactive template entries
- (goto-char (point-min))
- (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t)
- (unless (org-capture-escaped-%)
- (setq char (if (match-end 3) (match-string-no-properties 3))
- prompt (if (match-end 2) (match-string-no-properties 2)))
- (goto-char (match-beginning 0))
- (replace-match "")
- (setq completions nil default nil)
- (when prompt
- (setq completions (org-split-string prompt "|")
- prompt (pop completions)
- default (car completions)
- histvar (intern (concat
- "org-capture-template-prompt-history::"
- (or prompt "")))
- completions (mapcar 'list completions)))
- (unless (boundp histvar) (set histvar nil))
- (cond
- ((member char '("G" "g"))
- (let* ((org-last-tags-completion-table
- (org-global-tags-completion-table
- (if (equal char "G")
- (org-agenda-files)
- (and file (list file)))))
- (org-add-colon-after-tag-completion t)
- (ins (org-icompleting-read
- (if prompt (concat prompt ": ") "Tags: ")
- 'org-tags-completion-function nil nil nil
- 'org-tags-history)))
- (setq ins (mapconcat 'identity
- (org-split-string
- ins (org-re "[^[:alnum:]_@#%]+"))
- ":"))
- (when (string-match "\\S-" ins)
- (or (equal (char-before) ?:) (insert ":"))
- (insert ins)
- (or (equal (char-after) ?:) (insert ":"))
- (and (org-at-heading-p)
- (let ((org-ignore-region t))
- (org-set-tags nil 'align))))))
- ((equal char "C")
- (cond ((= (length clipboards) 1) (insert (car clipboards)))
- ((> (length clipboards) 1)
- (insert (read-string "Clipboard/kill value: "
- (car clipboards) '(clipboards . 1)
- (car clipboards))))))
- ((equal char "L")
- (cond ((= (length clipboards) 1)
- (org-insert-link 0 (car clipboards)))
- ((> (length clipboards) 1)
- (org-insert-link 0 (read-string "Clipboard/kill value: "
- (car clipboards)
- '(clipboards . 1)
- (car clipboards))))))
- ((equal char "p")
- (org-set-property (org-no-properties prompt) nil))
- (char
- ;; These are the date/time related ones
- (setq org-time-was-given (equal (upcase char) char))
- (setq time (org-read-date (equal (upcase char) char) t nil
- prompt))
- (if (equal (upcase char) char) (setq org-time-was-given t))
- (org-insert-time-stamp time org-time-was-given
- (member char '("u" "U"))
- nil nil (list org-end-time-was-given)))
- (t
- (let (org-completion-use-ido)
- (push (org-completing-read-no-i
- (concat (if prompt prompt "Enter string")
- (if default (concat " [" default "]"))
- ": ")
- completions nil nil nil histvar default)
- strings)
- (insert (car strings)))))))
- ;; Replace %n escapes with nth %^{...} string
- (setq strings (nreverse strings))
- (goto-char (point-min))
- (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
- (unless (org-capture-escaped-%)
- (replace-match
- (nth (1- (string-to-number (match-string 1))) strings)
- nil t)))
+ (org-clone-local-variables buffer "\\`org-")
+ (let (strings) ; Stores interactive answers.
+ (save-excursion
+ (let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?"))
+ (while (re-search-forward regexp nil t)
+ (let* ((items (and (match-end 1)
+ (save-match-data
+ (split-string (match-string-no-properties 1)
+ "|"))))
+ (key (match-string 2))
+ (beg (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0)))
+ (prompt (nth 0 items))
+ (default (nth 1 items))
+ (completions (nthcdr 2 items)))
+ (unless (org-capture-escaped-%)
+ (delete-region beg end)
+ (set-marker beg nil)
+ (set-marker end nil)
+ (pcase key
+ ((or "G" "g")
+ (let* ((org-last-tags-completion-table
+ (org-global-tags-completion-table
+ (cond ((equal key "G") (org-agenda-files))
+ (file (list file))
+ (t nil))))
+ (org-add-colon-after-tag-completion t)
+ (ins (mapconcat
+ #'identity
+ (org-split-string
+ (completing-read
+ (if prompt (concat prompt ": ") "Tags: ")
+ 'org-tags-completion-function nil nil nil
+ 'org-tags-history)
+ "[^[:alnum:]_@#%]+")
+ ":")))
+ (when (org-string-nw-p ins)
+ (unless (eq (char-before) ?:) (insert ":"))
+ (insert ins)
+ (unless (eq (char-after) ?:) (insert ":"))
+ (and (org-at-heading-p)
+ (let ((org-ignore-region t))
+ (org-set-tags nil 'align))))))
+ ((or "C" "L")
+ (let ((insert-fun (if (equal key "C") #'insert
+ (lambda (s) (org-insert-link 0 s)))))
+ (pcase org-capture--clipboards
+ (`nil nil)
+ (`(,value) (funcall insert-fun value))
+ (`(,first-value . ,_)
+ (funcall insert-fun
+ (read-string "Clipboard/kill value: "
+ first-value
+ 'org-capture--clipboards
+ first-value)))
+ (_ (error "Invalid `org-capture--clipboards' value: %S"
+ org-capture--clipboards)))))
+ ("p" (org-set-property prompt nil))
+ ((or "t" "T" "u" "U")
+ ;; These are the date/time related ones.
+ (let* ((upcase? (equal (upcase key) key))
+ (org-end-time-was-given nil)
+ (time (org-read-date upcase? t nil prompt)))
+ (org-insert-time-stamp
+ time (or org-time-was-given upcase?)
+ (member key '("u" "U"))
+ nil nil (list org-end-time-was-given))))
+ (`nil
+ ;; Load history list for current prompt.
+ (setq org-capture--prompt-history
+ (gethash prompt org-capture--prompt-history-table))
+ (push (org-completing-read
+ (concat (or prompt "Enter string")
+ (and default (format " [%s]" default))
+ ": ")
+ completions
+ nil nil nil 'org-capture--prompt-history default)
+ strings)
+ (insert (car strings))
+ ;; Save updated history list for current prompt.
+ (puthash prompt org-capture--prompt-history
+ org-capture--prompt-history-table))
+ (_
+ (error "Unknown template placeholder: \"%%^%s\""
+ key))))))))
+
+ ;; Replace %n escapes with nth %^{...} string.
+ (setq strings (nreverse strings))
+ (save-excursion
+ (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t)
+ (unless (org-capture-escaped-%)
+ (replace-match
+ (nth (1- (string-to-number (match-string 1))) strings)
+ nil t)))))
+
;; Make sure there are no empty lines before the text, and that
- ;; it ends with a newline character
- (goto-char (point-min))
- (while (looking-at "[ \t]*\n") (replace-match ""))
- (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n"))
- ;; Return the expanded template and kill the temporary buffer
+ ;; it ends with a newline character.
+ (skip-chars-forward " \t\n")
+ (delete-region (point-min) (line-beginning-position))
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (delete-region (point) (point-max))
+ (insert "\n")
+
+ ;; Return the expanded template and kill the capture buffer.
(untabify (point-min) (point-max))
(set-buffer-modified-p nil)
- (prog1 (buffer-string) (kill-buffer (current-buffer))))))
+ (prog1 (buffer-substring-no-properties (point-min) (point-max))
+ (kill-buffer (current-buffer))))))
(defun org-capture-escaped-% ()
- "Check if % was escaped - if yes, unescape it now."
- (if (equal (char-before (match-beginning 0)) ?\\)
- (progn
- (delete-region (1- (match-beginning 0)) (match-beginning 0))
- t)
- nil))
-
-(defun org-capture-expand-embedded-elisp ()
- "Evaluate embedded elisp %(sexp) and replace with the result."
- (goto-char (point-min))
- (while (re-search-forward "%(" nil t)
- (unless (org-capture-escaped-%)
- (goto-char (match-beginning 0))
- (let ((template-start (point)))
- (forward-char 1)
- (let* ((sexp (read (current-buffer)))
- (result (org-eval
- (org-capture--expand-keyword-in-embedded-elisp sexp))))
- (delete-region template-start (point))
- (when result
- (if (stringp result)
- (insert result)
- (error "Capture template sexp `%s' must evaluate to string or nil"
- sexp))))))))
+ "Non-nil if % was escaped.
+If yes, unescape it now. Assume match-data contains the
+placeholder to check."
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (let ((n (abs (skip-chars-backward "\\\\"))))
+ (delete-char (/ (1+ n) 2))
+ (= (% n 2) 1))))
+
+(defun org-capture-expand-embedded-elisp (&optional mark)
+ "Evaluate embedded elisp %(sexp) and replace with the result.
+When optional MARK argument is non-nil, mark Sexp with a text
+property (`org-embedded-elisp') for later evaluation. Only
+marked Sexp are evaluated when this argument is nil."
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "%(" nil t)
+ (cond
+ ((get-text-property (match-beginning 0) 'org-embedded-elisp)
+ (goto-char (match-beginning 0))
+ (let ((template-start (point)))
+ (forward-char 1)
+ (let* ((sexp (read (current-buffer)))
+ (result (org-eval
+ (org-capture--expand-keyword-in-embedded-elisp
+ sexp))))
+ (delete-region template-start (point))
+ (cond
+ ((not result) nil)
+ ((stringp result) (insert result))
+ (t (error
+ "Capture template sexp `%s' must evaluate to string or nil"
+ sexp))))))
+ ((not mark) nil)
+ ;; Only mark valid and non-escaped sexp.
+ ((org-capture-escaped-%) nil)
+ (t
+ (let ((end (with-syntax-table emacs-lisp-mode-syntax-table
+ (ignore-errors (scan-sexps (1- (point)) 1)))))
+ (when end
+ (put-text-property (- (point) 2) end 'org-embedded-elisp t))))))))
(defun org-capture--expand-keyword-in-embedded-elisp (attr)
"Recursively replace capture link keywords in ATTR sexp.
@@ -1771,20 +1903,10 @@ Such keywords are prefixed with \"%:\". See
(t attr)))
(defun org-capture-inside-embedded-elisp-p ()
- "Return non-nil if point is inside of embedded elisp %(sexp)."
- (let (beg end)
- (with-syntax-table emacs-lisp-mode-syntax-table
- (save-excursion
- ;; `looking-at' and `search-backward' below do not match the "%(" if
- ;; point is in its middle
- (when (equal (char-before) ?%)
- (backward-char))
- (save-match-data
- (when (or (looking-at "%(") (search-backward "%(" nil t))
- (setq beg (point))
- (setq end (progn (forward-char) (forward-sexp) (1- (point)))))))
- (when (and beg end)
- (and (<= (point) end) (>= (point) beg))))))
+ "Non-nil if point is inside of embedded elisp %(sexp).
+Assume sexps have been marked with
+`org-capture-expand-embedded-elisp' beforehand."
+ (get-text-property (point) 'org-embedded-elisp))
;;;###autoload
(defun org-capture-import-remember-templates ()
@@ -1829,6 +1951,7 @@ Such keywords are prefixed with \"%:\". See
org-remember-templates))))
+
(provide 'org-capture)
;;; org-capture.el ends here
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 0bba92550f8..0e7eb214958 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -1,4 +1,4 @@
-;;; org-clock.el --- The time clocking code for Org-mode
+;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,45 +19,53 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the time clocking code for Org-mode
+;; This file contains the time clocking code for Org mode
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org)
(declare-function calendar-iso-to-absolute "cal-iso" (date))
(declare-function notifications-notify "notifications" (&rest params))
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
-(declare-function org-refresh-properties "org" (dprop tprop))
-(defvar org-time-stamp-formats)
-(defvar org-ts-what)
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-table-goto-line "org-table" (n))
+
(defvar org-frame-title-format-backup frame-title-format)
+(defvar org-time-stamp-formats)
+
(defgroup org-clock nil
- "Options concerning clocking working time in Org-mode."
+ "Options concerning clocking working time in Org mode."
:tag "Org Clock"
:group 'org-progress)
-(defcustom org-clock-into-drawer org-log-into-drawer
- "Should clocking info be wrapped into a drawer?
-When t, clocking info will always be inserted into a :LOGBOOK: drawer.
-If necessary, the drawer will be created.
-When nil, the drawer will not be created, but used when present.
-When an integer and the number of clocking entries in an item
-reaches or exceeds this number, a drawer will be created.
-When a string, it names the drawer to be used.
-
-The default for this variable is the value of `org-log-into-drawer',
-which see."
+(defcustom org-clock-into-drawer t
+ "Non-nil when clocking info should be wrapped into a drawer.
+
+When non-nil, clocking info will be inserted into the same drawer
+as log notes (see variable `org-log-into-drawer'), if it exists,
+or \"LOGBOOK\" otherwise. If necessary, the drawer will be
+created.
+
+When an integer, the drawer is created only when the number of
+clocking entries in an item reaches or exceeds this value.
+
+When a string, it becomes the name of the drawer, ignoring the
+log notes drawer altogether.
+
+Do not check directly this variable in a Lisp program. Call
+function `org-clock-into-drawer' instead."
:group 'org-todo
:group 'org-clock
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
(const :tag "Only when drawer exists" nil)
@@ -66,26 +74,29 @@ which see."
(string :tag "Into Drawer named...")))
(defun org-clock-into-drawer ()
- "Return the value of `org-clock-into-drawer', but let properties overrule.
+ "Value of `org-clock-into-drawer'. but let properties overrule.
+
If the current entry has or inherits a CLOCK_INTO_DRAWER
-property, it will be used instead of the default value; otherwise
-if the current entry has or inherits a LOG_INTO_DRAWER property,
-it will be used instead of the default value.
-The default is the value of the customizable variable `org-clock-into-drawer',
-which see."
- (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit))
- (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit)))
- (cond
- ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer)
- ((or (equal p "t") (equal q "t")) "LOGBOOK")
- ((not p) q)
- (t p))))
+property, it will be used instead of the default value.
+
+Return value is either a string, an integer, or nil."
+ (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit t)))
+ (cond ((equal p "nil") nil)
+ ((equal p "t") (or (org-log-into-drawer) "LOGBOOK"))
+ ((org-string-nw-p p)
+ (if (string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p))
+ ((org-string-nw-p org-clock-into-drawer))
+ ((integerp org-clock-into-drawer) org-clock-into-drawer)
+ ((not org-clock-into-drawer) nil)
+ ((org-log-into-drawer))
+ (t "LOGBOOK"))))
(defcustom org-clock-out-when-done t
"When non-nil, clock will be stopped when the clocked entry is marked DONE.
+\\<org-mode-map>\
DONE here means any DONE-like state.
A nil value means clock will keep running until stopped explicitly with
-`C-c C-x C-o', or until the clock is started in a different item.
+`\\[org-clock-out]', or until the clock is started in a different item.
Instead of t, this can also be a list of TODO states that should trigger
clocking out."
:group 'org-clock
@@ -223,9 +234,6 @@ file name Play this sound file, fall back to beep"
(const :tag "Standard beep" t)
(file :tag "Play sound file")))
-(define-obsolete-variable-alias 'org-clock-modeline-total
- 'org-clock-mode-line-total "24.3")
-
(defcustom org-clock-mode-line-total 'auto
"Default setting for the time included for the mode line clock.
This can be overruled locally using the CLOCK_MODELINE_TOTAL property.
@@ -244,7 +252,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks"
(const :tag "All task time" all)
(const :tag "Automatically, `all' or since `repeat'" auto)))
-(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
+(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text)
(defcustom org-clock-task-overrun-text nil
"Extra mode line text to indicate that the clock is overrun.
The can be nil to indicate that instead of adding text, the clock time
@@ -268,14 +276,14 @@ string as argument."
(function :tag "Function")))
(defgroup org-clocktable nil
- "Options concerning the clock table in Org-mode."
+ "Options concerning the clock table in Org mode."
:tag "Org Clock Table"
:group 'org-clock)
(defcustom org-clocktable-defaults
(list
:maxlevel 2
- :lang (or (org-bound-and-true-p org-export-default-language) "en")
+ :lang (or (bound-and-true-p org-export-default-language) "en")
:scope 'file
:block nil
:wstart 1
@@ -312,7 +320,9 @@ For more information, see `org-clocktable-write-default'."
'(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at")
("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at")
("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à")
- ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at"))
+ ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")
+ ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT"
+ "Gesamtdauer" "Dateizeit" "Erstellt am"))
"Terms used in clocktable, translated to different languages."
:group 'org-clocktable
:version "24.1"
@@ -371,7 +381,7 @@ play with them."
:type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
- "When clocked in for a task, org-mode can display the current
+ "When clocked in for a task, Org can display the current
task and accumulated time in the mode line and/or frame title.
Allowed values are:
@@ -413,6 +423,26 @@ if you are using Debian."
:package-version '(Org . "8.0")
:type 'string)
+(defcustom org-clock-goto-before-context 2
+ "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+ :group 'org-clock
+ :type 'integer)
+
+(defcustom org-clock-display-default-range 'thisyear
+ "Default range when displaying clocks with `org-clock-display'."
+ :group 'org-clock
+ :type '(choice (const today)
+ (const yesterday)
+ (const thisweek)
+ (const lastweek)
+ (const thismonth)
+ (const lastmonth)
+ (const thisyear)
+ (const lastyear)
+ (const untilnow)
+ (const :tag "Select range interactively" interactive)))
+
(defvar org-clock-in-prepare-hook nil
"Hook run when preparing the clock.
This hook is run before anything happens to the task that
@@ -430,6 +460,43 @@ to add an effort property.")
(defvar org-clock-has-been-used nil
"Has the clock been used during the current Emacs session?")
+(defvar org-clock-stored-history nil
+ "Clock history, populated by `org-clock-load'")
+(defvar org-clock-stored-resume-clock nil
+ "Clock to resume, saved by `org-clock-load'")
+
+(defconst org-clock--oldest-date
+ (let* ((dichotomy
+ (lambda (min max pred)
+ (if (funcall pred min) min
+ (cl-incf min)
+ (while (> (- max min) 1)
+ (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
+ (if (funcall pred mean) (setq max mean) (setq min mean)))))
+ max))
+ (high
+ (funcall dichotomy
+ most-negative-fixnum
+ 0
+ (lambda (m)
+ ;; libc in macOS 10.6 hangs when decoding times
+ ;; around year -2**31. Limit `high' not to go
+ ;; any earlier than that.
+ (unless (and (eq system-type 'darwin)
+ (string-match-p
+ "10\\.6\\.[[:digit:]]"
+ (shell-command-to-string
+ "sw_vers -productVersion"))
+ (<= m -1034058203135))
+ (ignore-errors (decode-time (list m 0)))))))
+ (low
+ (funcall dichotomy
+ most-negative-fixnum
+ 0
+ (lambda (m) (ignore-errors (decode-time (list high m)))))))
+ (list high low))
+ "Internal time for oldest date representable on the system.")
+
;;; The clock for measuring work time.
(defvar org-mode-line-string "")
@@ -465,6 +532,16 @@ of a different task.")
(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto)
(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu)
+(defun org-clock--translate (s language)
+ "Translate string S into using string LANGUAGE.
+Assume S in the English term to translate. Return S as-is if it
+cannot be translated."
+ (or (nth (pcase s
+ ("File" 1) ("L" 2) ("Timestamp" 3) ("Headline" 4) ("Time" 5)
+ ("ALL" 6) ("Total time" 7) ("File time" 8) ("Clock summary at" 9))
+ (assoc-string language org-clock-clocktable-language-setup t))
+ s))
+
(defun org-clock-menu ()
(interactive)
(popup-menu
@@ -500,8 +577,17 @@ of a different task.")
(org-check-and-save-marker org-clock-hd-marker beg end)
(org-check-and-save-marker org-clock-default-task beg end)
(org-check-and-save-marker org-clock-interrupted-task beg end)
- (mapc (lambda (m) (org-check-and-save-marker m beg end))
- org-clock-history))
+ (dolist (m org-clock-history)
+ (org-check-and-save-marker m beg end)))
+
+(defun org-clock-drawer-name ()
+ "Return clock drawer's name for current entry, or nil."
+ (let ((drawer (org-clock-into-drawer)))
+ (cond ((integerp drawer)
+ (let ((log-drawer (org-log-into-drawer)))
+ (if (stringp log-drawer) log-drawer "LOGBOOK")))
+ ((stringp drawer) drawer)
+ (t nil))))
(defun org-clocking-buffer ()
"Return the clocking buffer if we are currently clocking a task or nil."
@@ -515,12 +601,13 @@ of a different task.")
"Hook called in task selection just before prompting the user.")
(defun org-clock-select-task (&optional prompt)
- "Select a task that was recently associated with clocking."
- (interactive)
+ "Select a task that was recently associated with clocking.
+Return marker position of the selected task. Raise an error if
+there is no recent clock to choose from."
(let (och chl sel-list rpl (i 0) s)
;; Remove successive dups from the clock history to consider
- (mapc (lambda (c) (if (not (equal c (car och))) (push c och)))
- org-clock-history)
+ (dolist (c org-clock-history)
+ (unless (equal c (car och)) (push c och)))
(setq och (reverse och) chl (length och))
(if (zerop chl)
(user-error "No recent clock")
@@ -541,17 +628,15 @@ of a different task.")
(setq s (org-clock-insert-selection-line ?c org-clock-marker))
(push s sel-list))
(insert (org-add-props "Recent Tasks\n" nil 'face 'bold))
- (mapc
- (lambda (m)
- (when (marker-buffer m)
- (setq i (1+ i)
- s (org-clock-insert-selection-line
- (if (< i 10)
- (+ i ?0)
- (+ i (- ?A 10))) m))
- (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
- (push s sel-list)))
- och)
+ (dolist (m och)
+ (when (marker-buffer m)
+ (setq i (1+ i)
+ s (org-clock-insert-selection-line
+ (if (< i 10)
+ (+ i ?0)
+ (+ i (- ?A 10))) m))
+ (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s))))
+ (push s sel-list)))
(run-hooks 'org-clock-before-select-task-hook)
(goto-char (point-min))
;; Set min-height relatively to circumvent a possible but in
@@ -559,6 +644,7 @@ of a different task.")
(fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl)))
(message (or prompt "Select task for clocking:"))
(setq cursor-type nil rpl (read-char-exclusive))
+ (kill-buffer)
(cond
((eq rpl ?q) nil)
((eq rpl ?x) nil)
@@ -570,25 +656,22 @@ of a different task.")
And return a cons cell with the selection character integer and the marker
pointing to it."
(when (marker-buffer marker)
- (let (file cat task heading prefix)
+ (let (cat task heading prefix)
(with-current-buffer (org-base-buffer (marker-buffer marker))
- (save-excursion
- (save-restriction
- (widen)
- (ignore-errors
- (goto-char marker)
- (setq file (buffer-file-name (marker-buffer marker))
- cat (org-get-category)
- heading (org-get-heading 'notags)
- prefix (save-excursion
- (org-back-to-heading t)
- (looking-at org-outline-regexp)
- (match-string 0))
- task (substring
- (org-fontify-like-in-org-mode
- (concat prefix heading)
- org-odd-levels-only)
- (length prefix)))))))
+ (org-with-wide-buffer
+ (ignore-errors
+ (goto-char marker)
+ (setq cat (org-get-category)
+ heading (org-get-heading 'notags)
+ prefix (save-excursion
+ (org-back-to-heading t)
+ (looking-at org-outline-regexp)
+ (match-string 0))
+ task (substring
+ (org-fontify-like-in-org-mode
+ (concat prefix heading)
+ org-odd-levels-only)
+ (length prefix))))))
(when (and cat task)
(insert (format "[%c] %-12s %s\n" i cat task))
(cons i marker)))))
@@ -605,22 +688,21 @@ If an effort estimate was defined for the current item, use
If not, show simply the clocked time like 01:50."
(let ((clocked-time (org-clock-get-clocked-time)))
(if org-clock-effort
- (let* ((effort-in-minutes
- (org-duration-string-to-minutes org-clock-effort))
+ (let* ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
(work-done-str
- (org-propertize
- (org-minutes-to-clocksum-string clocked-time)
+ (propertize
+ (org-duration-from-minutes clocked-time)
'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text))
'org-mode-line-clock-overrun 'org-mode-line-clock)))
- (effort-str (org-minutes-to-clocksum-string effort-in-minutes))
- (clockstr (org-propertize
+ (effort-str (org-duration-from-minutes effort-in-minutes))
+ (clockstr (propertize
(concat " [%s/" effort-str
"] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")")
'face 'org-mode-line-clock)))
(format clockstr work-done-str))
- (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time)
- (format " (%s)" org-clock-heading) "]")
- 'face 'org-mode-line-clock))))
+ (propertize (concat " [" (org-duration-from-minutes clocked-time)
+ "]" (format " (%s)" org-clock-heading))
+ 'face 'org-mode-line-clock))))
(defun org-clock-get-last-clock-out-time ()
"Get the last clock-out time for the current subtree."
@@ -635,20 +717,21 @@ If not, show simply the clocked time like 01:50."
(org-clock-notify-once-if-expired)
(setq org-clock-task-overrun nil))
(setq org-mode-line-string
- (org-propertize
+ (propertize
(let ((clock-string (org-clock-get-clock-string))
- (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task"))
+ (help-text "Org mode clock is running.\nmouse-1 shows a \
+menu\nmouse-2 will jump to task"))
(if (and (> org-clock-string-limit 0)
(> (length clock-string) org-clock-string-limit))
- (org-propertize
+ (propertize
(substring clock-string 0 org-clock-string-limit)
'help-echo (concat help-text ": " org-clock-heading))
- (org-propertize clock-string 'help-echo help-text)))
+ (propertize clock-string 'help-echo help-text)))
'local-map org-clock-mode-line-map
- 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight)))
+ 'mouse-face 'mode-line-highlight))
(if (and org-clock-task-overrun org-clock-task-overrun-text)
(setq org-mode-line-string
- (concat (org-propertize
+ (concat (propertize
org-clock-task-overrun-text
'face 'org-mode-line-clock-overrun) org-mode-line-string)))
(force-mode-line-update))
@@ -687,15 +770,15 @@ clocked item, and the value displayed in the mode line."
;; A string. See if it is a delta
(setq sign (string-to-char value))
(if (member sign '(?- ?+))
- (setq current (org-duration-string-to-minutes current)
+ (setq current (org-duration-to-minutes current)
value (substring value 1))
(setq current 0))
- (setq value (org-duration-string-to-minutes value))
+ (setq value (org-duration-to-minutes value))
(if (equal ?- sign)
(setq value (- current value))
(if (equal ?+ sign) (setq value (+ current value)))))
(setq value (max 0 value)
- org-clock-effort (org-minutes-to-clocksum-string value))
+ org-clock-effort (org-duration-from-minutes value))
(org-entry-put org-clock-marker "Effort" org-clock-effort)
(org-clock-update-mode-line)
(message "Effort is now %s" org-clock-effort))
@@ -708,7 +791,7 @@ clocked item, and the value displayed in the mode line."
"Show notification if we spent more time than we estimated before.
Notification is shown only once."
(when (org-clocking-p)
- (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort))
+ (let ((effort-in-minutes (org-duration-to-minutes org-clock-effort))
(clocked-time (org-clock-get-clocked-time)))
(if (setq org-clock-task-overrun
(if (or (null effort-in-minutes) (zerop effort-in-minutes))
@@ -739,7 +822,7 @@ use libnotify if available, or fall back on a message."
org-show-notification-handler notification))
((fboundp 'notifications-notify)
(notifications-notify
- :title "Org-mode message"
+ :title "Org mode message"
:body notification
;; FIXME how to link to the Org icon?
;; :app-icon "~/.emacs.d/icons/mail.png"
@@ -776,11 +859,12 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
"Search through the given file and find all open clocks."
(let ((buf (or (get-file-buffer file)
(find-file-noselect file)))
+ (org-clock-re (concat org-clock-string " \\(\\[.*?\\]\\)$"))
clocks)
(with-current-buffer buf
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t)
+ (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))))
clocks))
@@ -793,12 +877,10 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'."
(defmacro org-with-clock-position (clock &rest forms)
"Evaluate FORMS with CLOCK as the current active clock."
`(with-current-buffer (marker-buffer (car ,clock))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (car ,clock))
- (beginning-of-line)
- ,@forms))))
+ (org-with-wide-buffer
+ (goto-char (car ,clock))
+ (beginning-of-line)
+ ,@forms)))
(def-edebug-spec org-with-clock-position (form body))
(put 'org-with-clock-position 'lisp-indent-function 1)
@@ -812,7 +894,7 @@ This macro also protects the current active clock from being altered."
(org-clock-effort)
(org-clock-marker (car ,clock))
(org-clock-hd-marker (save-excursion
- (outline-back-to-heading t)
+ (org-back-to-heading t)
(point-marker))))
,@forms)))
(def-edebug-spec org-with-clock (form body))
@@ -885,7 +967,7 @@ If necessary, clock-out of the currently active clock."
(defun org-clock-jump-to-current-clock (&optional effective-clock)
(interactive)
- (let ((org-clock-into-drawer (org-clock-into-drawer))
+ (let ((drawer (org-clock-into-drawer))
(clock (or effective-clock (cons org-clock-marker
org-clock-start-time))))
(unless (marker-buffer (car clock))
@@ -893,26 +975,21 @@ If necessary, clock-out of the currently active clock."
(org-with-clock clock (org-clock-goto))
(with-current-buffer (marker-buffer (car clock))
(goto-char (car clock))
- (if org-clock-into-drawer
- (let ((logbook
- (if (stringp org-clock-into-drawer)
- (concat ":" org-clock-into-drawer ":")
- ":LOGBOOK:")))
- (ignore-errors
- (outline-flag-region
- (save-excursion
- (outline-back-to-heading t)
- (search-forward logbook)
- (goto-char (match-beginning 0)))
- (save-excursion
- (outline-back-to-heading t)
- (search-forward logbook)
- (search-forward ":END:")
- (goto-char (match-end 0)))
- nil)))))))
+ (when drawer
+ (org-with-wide-buffer
+ (let ((drawer-re (format "^[ \t]*:%s:[ \t]*$"
+ (regexp-quote (if (stringp drawer) drawer "LOGBOOK"))))
+ (beg (save-excursion (org-back-to-heading t) (point))))
+ (catch 'exit
+ (while (re-search-backward drawer-re beg t)
+ (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))
+ (throw 'exit nil)))))))))))
(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly)
- "Resolve an open org-mode clock.
+ "Resolve an open Org clock.
An open clock was found, with `dangling' possibly being non-nil.
If this function was invoked with a prefix argument, non-dangling
open clocks are ignored. The given clock requires some sort of
@@ -930,7 +1007,7 @@ The format of clock is (CONS MARKER START-TIME), where MARKER
identifies the buffer and position the clock is open at (and
thus, the heading it's under), and START-TIME is when the clock
was started."
- (assert clock)
+ (cl-assert clock)
(let* ((ch
(save-window-excursion
(save-excursion
@@ -947,7 +1024,7 @@ 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.
-g/G Indicate that you “got back” X minutes ago. This is quite
+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.
@@ -963,10 +1040,6 @@ For all these options, using uppercase makes your final state
to be CLOCKED OUT."))))
(org-fit-window-to-buffer (get-buffer-window "*Org Clock*"))
(let (char-pressed)
- (when (featurep 'xemacs)
- (message (concat (funcall prompt-fn clock)
- " [jkKgGsScCiq]? "))
- (setq char-pressed (read-char-exclusive)))
(while (or (null char-pressed)
(and (not (memq char-pressed
'(?k ?K ?g ?G ?s ?S ?C
@@ -1028,7 +1101,7 @@ to be CLOCKED OUT."))))
;;;###autoload
(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid)
- "Resolve all currently open org-mode clocks.
+ "Resolve all currently open Org clocks.
If `only-dangling-p' is non-nil, only ask to resolve dangling
\(i.e., not currently open and valid) clocks."
(interactive "P")
@@ -1091,7 +1164,7 @@ This routine returns a floating point number."
(defvar org-clock-user-idle-seconds)
(defun org-resolve-clocks-if-idle ()
- "Resolve all currently open org-mode clocks.
+ "Resolve all currently open Org clocks.
This is performed after `org-clock-idle-time' minutes, to check
if the user really wants to stay clocked in after being idle for
so long."
@@ -1106,13 +1179,12 @@ so long."
(org-clock-resolve
(cons org-clock-marker
org-clock-start-time)
- (function
- (lambda (clock)
- (format "Clocked in & idle for %.1f mins"
- (/ (float-time
- (time-subtract (current-time)
- org-clock-user-idle-start))
- 60.0))))
+ (lambda (_)
+ (format "Clocked in & idle for %.1f mins"
+ (/ (float-time
+ (time-subtract (current-time)
+ org-clock-user-idle-start))
+ 60.0)))
org-clock-user-idle-start)))))
(defvar org-clock-current-task nil "Task currently clocked in.")
@@ -1122,18 +1194,25 @@ so long."
;;;###autoload
(defun org-clock-in (&optional select start-time)
"Start the clock on the current item.
+
If necessary, clock-out of the currently active clock.
-With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked
-tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task
-and mark it as the default task, a special task that will always be offered
-in the clocking selection, associated with the letter `d'.
-When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \
-clock in by using the last clock-out
-time as the start time \(see `org-clock-continuously' to
-make this the default behavior.)"
+
+With a `\\[universal-argument]' prefix argument SELECT, offer a list of \
+recently clocked
+tasks to clock into.
+
+When SELECT is `\\[universal-argument] \ \\[universal-argument]', \
+clock into the current task and mark it as
+the default task, a special task that will always be offered in the
+clocking selection, associated with the letter `d'.
+
+When SELECT is `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]', clock in by using the last clock-out
+time as the start time. See `org-clock-continuously' to make this
+the default behavior."
(interactive "P")
(setq org-clock-notification-was-shown nil)
- (org-refresh-properties org-effort-property 'org-effort)
+ (org-refresh-effort-properties)
(catch 'abort
(let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness)
(org-clocking-p)))
@@ -1148,7 +1227,7 @@ make this the default behavior.)"
(not org-clock-resolving-clocks))
(setq org-clock-leftover-time nil)
(let ((org-clock-clocking-in t))
- (org-resolve-clocks))) ; check if any clocks are dangling
+ (org-resolve-clocks))) ; check if any clocks are dangling
(when (equal select '(64))
;; Set start-time to `org-clock-out-time'
@@ -1201,116 +1280,116 @@ make this the default behavior.)"
(set-buffer (org-base-buffer (marker-buffer selected-task)))
(setq target-pos (marker-position selected-task))
(move-marker selected-task nil))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char target-pos)
- (org-back-to-heading t)
- (or interrupting (move-marker org-clock-interrupted-task nil))
- (run-hooks 'org-clock-in-prepare-hook)
- (org-clock-history-push)
- (setq org-clock-current-task (nth 4 (org-heading-components)))
- (cond ((functionp org-clock-in-switch-to-state)
- (looking-at org-complex-heading-regexp)
- (let ((newstate (funcall org-clock-in-switch-to-state
- (match-string 2))))
- (if newstate (org-todo newstate))))
- ((and org-clock-in-switch-to-state
- (not (looking-at (concat org-outline-regexp "[ \t]*"
- org-clock-in-switch-to-state
- "\\>"))))
- (org-todo org-clock-in-switch-to-state)))
- (setq org-clock-heading
- (cond ((and org-clock-heading-function
- (functionp org-clock-heading-function))
- (funcall org-clock-heading-function))
- ((nth 4 (org-heading-components))
- (replace-regexp-in-string
- "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
- (match-string-no-properties 4)))
- (t "???")))
- (org-clock-find-position org-clock-in-resume)
- (cond
- ((and org-clock-in-resume
- (looking-at
- (concat "^[ \t]*" org-clock-string
- " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
- (message "Matched %s" (match-string 1))
- (setq ts (concat "[" (match-string 1) "]"))
- (goto-char (match-end 1))
- (setq org-clock-start-time
- (apply 'encode-time
- (org-parse-time-string (match-string 1))))
- (setq org-clock-effort (org-entry-get (point) org-effort-property))
- (setq org-clock-total-time (org-clock-sum-current-item
- (org-clock-get-sum-start))))
- ((eq org-clock-in-resume 'auto-restart)
- ;; called from org-clock-load during startup,
- ;; do not interrupt, but warn!
- (message "Cannot restart clock because task does not contain unfinished clock")
- (ding)
- (sit-for 2)
- (throw 'abort nil))
- (t
- (insert-before-markers "\n")
- (backward-char 1)
- (org-indent-line)
- (when (and (save-excursion
- (end-of-line 0)
- (org-in-item-p)))
- (beginning-of-line 1)
- (org-indent-line-to (- (org-get-indentation) 2)))
- (insert org-clock-string " ")
- (setq org-clock-effort (org-entry-get (point) org-effort-property))
- (setq org-clock-total-time (org-clock-sum-current-item
- (org-clock-get-sum-start)))
- (setq org-clock-start-time
- (or (and org-clock-continuously org-clock-out-time)
- (and leftover
- (y-or-n-p
- (format
- "You stopped another clock %d mins ago; start this one from then? "
- (/ (- (float-time
- (org-current-time org-clock-rounding-minutes t))
- (float-time leftover)) 60)))
- leftover)
- start-time
- (org-current-time org-clock-rounding-minutes t)))
- (setq ts (org-insert-time-stamp org-clock-start-time
- 'with-hm 'inactive))))
- (move-marker org-clock-marker (point) (buffer-base-buffer))
- (move-marker org-clock-hd-marker
- (save-excursion (org-back-to-heading t) (point))
- (buffer-base-buffer))
- (setq org-clock-has-been-used t)
- ;; add to mode line
- (when (or (eq org-clock-clocked-in-display 'mode-line)
- (eq org-clock-clocked-in-display 'both))
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-mode-line-string)))))
- ;; add to frame title
- (when (or (eq org-clock-clocked-in-display 'frame-title)
- (eq org-clock-clocked-in-display 'both))
- (setq frame-title-format org-clock-frame-title-format))
- (org-clock-update-mode-line)
- (when org-clock-mode-line-timer
- (cancel-timer org-clock-mode-line-timer)
- (setq org-clock-mode-line-timer nil))
- (when org-clock-clocked-in-display
- (setq org-clock-mode-line-timer
- (run-with-timer org-clock-update-period
- org-clock-update-period
- 'org-clock-update-mode-line)))
- (when org-clock-idle-timer
- (cancel-timer org-clock-idle-timer)
- (setq org-clock-idle-timer nil))
- (setq org-clock-idle-timer
- (run-with-timer 60 60 'org-resolve-clocks-if-idle))
- (message "Clock starts at %s - %s" ts org--msg-extra)
- (run-hooks 'org-clock-in-hook)))))))
+ (org-with-wide-buffer
+ (goto-char target-pos)
+ (org-back-to-heading t)
+ (or interrupting (move-marker org-clock-interrupted-task nil))
+ (run-hooks 'org-clock-in-prepare-hook)
+ (org-clock-history-push)
+ (setq org-clock-current-task (nth 4 (org-heading-components)))
+ (cond ((functionp org-clock-in-switch-to-state)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ (let ((newstate (funcall org-clock-in-switch-to-state
+ (match-string 2))))
+ (when newstate (org-todo newstate))))
+ ((and org-clock-in-switch-to-state
+ (not (looking-at (concat org-outline-regexp "[ \t]*"
+ org-clock-in-switch-to-state
+ "\\>"))))
+ (org-todo org-clock-in-switch-to-state)))
+ (setq org-clock-heading
+ (cond ((and org-clock-heading-function
+ (functionp org-clock-heading-function))
+ (funcall org-clock-heading-function))
+ ((nth 4 (org-heading-components))
+ (replace-regexp-in-string
+ "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1"
+ (match-string-no-properties 4)))
+ (t "???")))
+ (org-clock-find-position org-clock-in-resume)
+ (cond
+ ((and org-clock-in-resume
+ (looking-at
+ (concat "^[ \t]*" org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ (message "Matched %s" (match-string 1))
+ (setq ts (concat "[" (match-string 1) "]"))
+ (goto-char (match-end 1))
+ (setq org-clock-start-time
+ (apply 'encode-time
+ (org-parse-time-string (match-string 1))))
+ (setq org-clock-effort (org-entry-get (point) org-effort-property))
+ (setq org-clock-total-time (org-clock-sum-current-item
+ (org-clock-get-sum-start))))
+ ((eq org-clock-in-resume 'auto-restart)
+ ;; called from org-clock-load during startup,
+ ;; do not interrupt, but warn!
+ (message "Cannot restart clock because task does not contain unfinished clock")
+ (ding)
+ (sit-for 2)
+ (throw 'abort nil))
+ (t
+ (insert-before-markers "\n")
+ (backward-char 1)
+ (org-indent-line)
+ (when (and (save-excursion
+ (end-of-line 0)
+ (org-in-item-p)))
+ (beginning-of-line 1)
+ (indent-line-to (- (org-get-indentation) 2)))
+ (insert org-clock-string " ")
+ (setq org-clock-effort (org-entry-get (point) org-effort-property))
+ (setq org-clock-total-time (org-clock-sum-current-item
+ (org-clock-get-sum-start)))
+ (setq org-clock-start-time
+ (or (and org-clock-continuously org-clock-out-time)
+ (and leftover
+ (y-or-n-p
+ (format
+ "You stopped another clock %d mins ago; start this one from then? "
+ (/ (- (float-time
+ (org-current-time org-clock-rounding-minutes t))
+ (float-time leftover))
+ 60)))
+ leftover)
+ start-time
+ (org-current-time org-clock-rounding-minutes t)))
+ (setq ts (org-insert-time-stamp org-clock-start-time
+ 'with-hm 'inactive))))
+ (move-marker org-clock-marker (point) (buffer-base-buffer))
+ (move-marker org-clock-hd-marker
+ (save-excursion (org-back-to-heading t) (point))
+ (buffer-base-buffer))
+ (setq org-clock-has-been-used t)
+ ;; add to mode line
+ (when (or (eq org-clock-clocked-in-display 'mode-line)
+ (eq org-clock-clocked-in-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-mode-line-string)))))
+ ;; add to frame title
+ (when (or (eq org-clock-clocked-in-display 'frame-title)
+ (eq org-clock-clocked-in-display 'both))
+ (setq frame-title-format org-clock-frame-title-format))
+ (org-clock-update-mode-line)
+ (when org-clock-mode-line-timer
+ (cancel-timer org-clock-mode-line-timer)
+ (setq org-clock-mode-line-timer nil))
+ (when org-clock-clocked-in-display
+ (setq org-clock-mode-line-timer
+ (run-with-timer org-clock-update-period
+ org-clock-update-period
+ 'org-clock-update-mode-line)))
+ (when org-clock-idle-timer
+ (cancel-timer org-clock-idle-timer)
+ (setq org-clock-idle-timer nil))
+ (setq org-clock-idle-timer
+ (run-with-timer 60 60 'org-resolve-clocks-if-idle))
+ (message "Clock starts at %s - %s" ts org--msg-extra)
+ (run-hooks 'org-clock-in-hook))))))
;;;###autoload
(defun org-clock-in-last (&optional arg)
@@ -1324,8 +1403,7 @@ With three universal prefix arguments, interactively prompt
for a todo state to switch to, overriding the existing value
`org-clock-in-switch-to-state'."
(interactive "P")
- (if (equal arg '(4))
- (org-clock-in (org-clock-select-task))
+ (if (equal arg '(4)) (org-clock-in arg)
(let ((start-time (if (or org-clock-continuously (equal arg '(16)))
(or org-clock-out-time
(org-current-time org-clock-rounding-minutes t))
@@ -1357,11 +1435,13 @@ for a todo state to switch to, overriding the existing value
(defun org-clock-get-sum-start ()
"Return the time from which clock times should be counted.
-This is for the currently running clock as it is displayed
-in the mode line. This function looks at the properties
-LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the
-corresponding variable `org-clock-mode-line-total' and then
-decides which time to use."
+
+This is for the currently running clock as it is displayed in the
+mode line. This function looks at the properties LAST_REPEAT and
+in particular CLOCK_MODELINE_TOTAL and the corresponding variable
+`org-clock-mode-line-total' and then decides which time to use.
+
+The time is always returned as UTC."
(let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL")
(symbol-name org-clock-mode-line-total)))
(lr (org-entry-get nil "LAST_REPEAT")))
@@ -1371,11 +1451,13 @@ decides which time to use."
(current-time))
((equal cmt "today")
(setq org--msg-extra "showing today's task time.")
- (let* ((dt (decode-time)))
- (setq dt (append (list 0 0 0) (nthcdr 3 dt)))
- (if org-extend-today-until
- (setf (nth 2 dt) org-extend-today-until))
- (apply 'encode-time dt)))
+ (let* ((dt (org-decode-time nil t))
+ (hour (nth 2 dt))
+ (day (nth 3 dt)))
+ (if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day)))
+ (setf (nth 2 dt) org-extend-today-until)
+ (setq dt (append (list 0 0) (nthcdr 2 dt) '(t)))
+ (apply #'encode-time dt)))
((or (equal cmt "all")
(and (or (not cmt) (equal cmt "auto"))
(not lr)))
@@ -1385,9 +1467,7 @@ decides which time to use."
(and (or (not cmt) (equal cmt "auto"))
lr))
(setq org--msg-extra "showing task time since last repeat.")
- (if (not lr)
- nil
- (org-time-string-to-time lr)))
+ (and lr (org-time-string-to-time lr)))
(t nil))))
(defun org-clock-find-position (find-unclosed)
@@ -1396,87 +1476,93 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock
line and position cursor in that line."
(org-back-to-heading t)
(catch 'exit
- (let* ((org-clock-into-drawer (org-clock-into-drawer))
- (beg (save-excursion
- (beginning-of-line 2)
- (or (bolp) (newline))
- (point)))
- (end (progn (outline-next-heading) (point)))
- (re (concat "^[ \t]*" org-clock-string))
- (cnt 0)
- (drawer (if (stringp org-clock-into-drawer)
- org-clock-into-drawer "LOGBOOK"))
- first last ind-last)
- (goto-char beg)
- (when (and find-unclosed
- (re-search-forward
- (concat "^[ \t]*" org-clock-string
- " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
- " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")
- end t))
- (beginning-of-line 1)
- (throw 'exit t))
- (when (eobp) (newline) (setq end (max (point) end)))
- (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t)
- ;; we seem to have a CLOCK drawer, so go there.
- (beginning-of-line 2)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))
- (throw 'exit t))
- ;; Lets count the CLOCK lines
- (goto-char beg)
- (while (re-search-forward re end t)
- (setq first (or first (match-beginning 0))
- last (match-beginning 0)
- cnt (1+ cnt)))
- (when (and (integerp org-clock-into-drawer)
- last
- (>= (1+ cnt) org-clock-into-drawer))
- ;; Wrap current entries into a new drawer
- (goto-char last)
- (setq ind-last (org-get-indentation))
- (beginning-of-line 2)
- (if (and (>= (org-get-indentation) ind-last)
- (org-at-item-p))
- (when (and (>= (org-get-indentation) ind-last)
- (org-at-item-p))
- (let ((struct (org-list-struct)))
- (goto-char (org-list-get-bottom-point struct)))))
- (insert ":END:\n")
- (beginning-of-line 0)
- (org-indent-line-to ind-last)
- (goto-char first)
- (insert ":" drawer ":\n")
- (beginning-of-line 0)
- (org-indent-line)
- (org-flag-drawer t)
- (beginning-of-line 2)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))
- (throw 'exit nil))
-
+ (let* ((beg (line-beginning-position))
+ (end (save-excursion (outline-next-heading) (point)))
+ (org-clock-into-drawer (org-clock-into-drawer))
+ (drawer (org-clock-drawer-name)))
+ ;; Look for a running clock if FIND-UNCLOSED in non-nil.
+ (when find-unclosed
+ (let ((open-clock-re
+ (concat "^[ \t]*"
+ org-clock-string
+ " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}"
+ " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$")))
+ (while (re-search-forward open-clock-re end t)
+ (let ((element (org-element-at-point)))
+ (when (and (eq (org-element-type element) 'clock)
+ (eq (org-element-property :status element) 'running))
+ (beginning-of-line)
+ (throw 'exit t))))))
+ ;; Look for an existing clock drawer.
+ (when drawer
+ (goto-char beg)
+ (let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")))
+ (while (re-search-forward drawer-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (let ((cend (org-element-property :contents-end element)))
+ (if (and (not org-log-states-order-reversed) cend)
+ (goto-char cend)
+ (forward-line))
+ (throw 'exit t)))))))
(goto-char beg)
- (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp))
- (not (equal (match-string 1) org-clock-string)))
- ;; Planning info, skip to after it
- (beginning-of-line 2)
- (or (bolp) (newline)))
- (when (or (eq org-clock-into-drawer t)
- (stringp org-clock-into-drawer)
- (and (integerp org-clock-into-drawer)
- (< org-clock-into-drawer 2)))
- (insert ":" drawer ":\n:END:\n")
- (beginning-of-line -1)
- (org-indent-line)
- (org-flag-drawer t)
- (beginning-of-line 2)
- (org-indent-line)
- (beginning-of-line)
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (match-beginning 0))))))))
+ (let ((clock-re (concat "^[ \t]*" org-clock-string))
+ (count 0)
+ positions)
+ ;; Count the CLOCK lines and store their positions.
+ (save-excursion
+ (while (re-search-forward clock-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'clock)
+ (setq positions (cons (line-beginning-position) positions)
+ count (1+ count))))))
+ (cond
+ ((null positions)
+ ;; Skip planning line and property drawer, if any.
+ (org-end-of-meta-data)
+ (unless (bolp) (insert "\n"))
+ ;; Create a new drawer if necessary.
+ (when (and org-clock-into-drawer
+ (or (not (wholenump org-clock-into-drawer))
+ (< org-clock-into-drawer 2)))
+ (let ((beg (point)))
+ (insert ":" drawer ":\n:END:\n")
+ (org-indent-region beg (point))
+ (goto-char beg)
+ (org-flag-drawer t)
+ (forward-line))))
+ ;; When a clock drawer needs to be created because of the
+ ;; number of clock items or simply if it is missing, collect
+ ;; all clocks in the section and wrap them within the drawer.
+ ((if (wholenump org-clock-into-drawer)
+ (>= (1+ count) org-clock-into-drawer)
+ drawer)
+ ;; Skip planning line and property drawer, if any.
+ (org-end-of-meta-data)
+ (let ((beg (point)))
+ (insert
+ (mapconcat
+ (lambda (p)
+ (save-excursion
+ (goto-char p)
+ (org-trim (delete-and-extract-region
+ (save-excursion (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ (line-beginning-position 2)))))
+ positions "\n")
+ "\n:END:\n")
+ (let ((end (point-marker)))
+ (goto-char beg)
+ (save-excursion (insert ":" drawer ":\n"))
+ (org-flag-drawer t)
+ (org-indent-region (point) end)
+ (forward-line)
+ (unless org-log-states-order-reversed
+ (goto-char end)
+ (beginning-of-line -1))
+ (set-marker end nil))))
+ (org-log-states-order-reversed (goto-char (car (last positions))))
+ (t (goto-char (car positions))))))))
;;;###autoload
(defun org-clock-out (&optional switch-to-state fail-quietly at-time)
@@ -1504,7 +1590,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
ts te s h m remove)
(setq org-clock-out-time now)
(save-excursion ; Do not replace this with `with-current-buffer'.
- (org-no-warnings (set-buffer (org-clocking-buffer)))
+ (with-no-warnings (set-buffer (org-clocking-buffer)))
(save-restriction
(widen)
(goto-char org-clock-marker)
@@ -1517,24 +1603,28 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(delete-region (point) (point-at-eol))
(insert "--")
(setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive))
- (setq s (- (float-time (apply 'encode-time (org-parse-time-string te)))
- (float-time (apply 'encode-time (org-parse-time-string ts))))
+ (setq s (- (float-time
+ (apply #'encode-time (org-parse-time-string te)))
+ (float-time
+ (apply #'encode-time (org-parse-time-string ts))))
h (floor (/ s 3600))
s (- s (* 3600 h))
m (floor (/ s 60))
s (- s (* 60 s)))
(insert " => " (format "%2d:%02d" h m))
- (when (setq remove (and org-clock-out-remove-zero-time-clocks
- (= (+ h m) 0)))
- (beginning-of-line 1)
- (delete-region (point) (point-at-eol))
- (and (looking-at "\n") (> (point-max) (1+ (point)))
- (delete-char 1)))
(move-marker org-clock-marker nil)
(move-marker org-clock-hd-marker nil)
- (when org-log-note-clock-out
- (org-add-log-setup 'clock-out nil nil nil nil
- (concat "# Task: " (org-get-heading t) "\n\n")))
+ ;; Possibly remove zero time clocks. However, do not add
+ ;; a note associated to the CLOCK line in this case.
+ (cond ((and org-clock-out-remove-zero-time-clocks
+ (= (+ h m) 0))
+ (setq remove t)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (org-log-note-clock-out
+ (org-add-log-setup
+ 'clock-out nil nil nil
+ (concat "# Task: " (org-get-heading t) "\n\n"))))
(when org-clock-mode-line-timer
(cancel-timer org-clock-mode-line-timer)
(setq org-clock-mode-line-timer nil))
@@ -1547,14 +1637,14 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(when org-clock-out-switch-to-state
(save-excursion
(org-back-to-heading t)
- (let ((org-inhibit-logging t)
- (org-clock-out-when-done nil))
+ (let ((org-clock-out-when-done nil))
(cond
((functionp org-clock-out-switch-to-state)
- (looking-at org-complex-heading-regexp)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
(let ((newstate (funcall org-clock-out-switch-to-state
(match-string 2))))
- (if newstate (org-todo newstate))))
+ (when newstate (org-todo newstate))))
((and org-clock-out-switch-to-state
(not (looking-at (concat org-outline-regexp "[ \t]*"
org-clock-out-switch-to-state
@@ -1562,36 +1652,27 @@ to, overriding the existing value of `org-clock-out-switch-to-state'."
(org-todo org-clock-out-switch-to-state))))))
(force-mode-line-update)
(message (concat "Clock stopped at %s after "
- (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s")
+ (org-duration-from-minutes (+ (* 60 h) m)) "%s")
te (if remove " => LINE REMOVED" ""))
- (let ((h org-clock-out-hook))
- ;; If a closing note needs to be stored in the drawer
- ;; where clocks are stored, let's temporarily disable
- ;; `org-clock-remove-empty-clock-drawer'
- (if (and (equal org-clock-into-drawer org-log-into-drawer)
- (eq org-log-done 'note)
- org-clock-out-when-done)
- (setq h (delq 'org-clock-remove-empty-clock-drawer h)))
- (mapc (lambda (f) (funcall f)) h))
+ (run-hooks 'org-clock-out-hook)
(unless (org-clocking-p)
(setq org-clock-current-task nil)))))))
(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer)
-(defun org-clock-remove-empty-clock-drawer nil
- "Remove empty clock drawer in the current subtree."
- (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER")
- org-log-into-drawer))
- (clock-drawer (if (eq t olid) "LOGBOOK" olid))
- (end (save-excursion (org-end-of-subtree t t))))
- (when clock-drawer
- (save-excursion
- (org-back-to-heading t)
- (while (and (< (point) end)
- (search-forward clock-drawer end t))
- (goto-char (match-beginning 0))
- (org-remove-empty-drawer-at clock-drawer (point))
- (forward-line 1))))))
+(defun org-clock-remove-empty-clock-drawer ()
+ "Remove empty clock drawers in current subtree."
+ (save-excursion
+ (org-back-to-heading t)
+ (org-map-tree
+ (lambda ()
+ (let ((drawer (org-clock-drawer-name))
+ (case-fold-search t))
+ (when drawer
+ (let ((re (format "^[ \t]*:%s:[ \t]*$" (regexp-quote drawer)))
+ (end (save-excursion (outline-next-heading))))
+ (while (re-search-forward re end t)
+ (org-remove-empty-drawer-at (point))))))))))
(defun org-clock-timestamps-up (&optional n)
"Increase CLOCK timestamps at cursor.
@@ -1607,13 +1688,13 @@ Optional argument N tells to change by that many units."
(defun org-clock-timestamps-change (updown &optional n)
"Change CLOCK timestamps synchronously at cursor.
-UPDOWN tells whether to change 'up or 'down.
+UPDOWN tells whether to change `up' or `down'.
Optional argument N tells to change by that many units."
- (setq org-ts-what nil)
- (when (org-at-timestamp-p t)
- (let ((tschange (if (eq updown 'up) 'org-timestamp-up
- 'org-timestamp-down))
- ts1 begts1 ts2 begts2 updatets1 tdiff)
+ (let ((tschange (if (eq updown 'up) 'org-timestamp-up
+ 'org-timestamp-down))
+ (timestamp? (org-at-timestamp-p 'lax))
+ ts1 begts1 ts2 begts2 updatets1 tdiff)
+ (when timestamp?
(save-excursion
(move-beginning-of-line 1)
(re-search-forward org-ts-regexp3 nil t)
@@ -1625,7 +1706,6 @@ Optional argument N tells to change by that many units."
(if (not ts2)
;; fall back on org-timestamp-up if there is only one
(funcall tschange n)
- ;; setq this so that (boundp 'org-ts-what is non-nil)
(funcall tschange n)
(let ((ts (if updatets1 ts2 ts1))
(begts (if updatets1 begts1 begts2)))
@@ -1637,12 +1717,13 @@ Optional argument N tells to change by that many units."
(goto-char begts)
(org-timestamp-change
(round (/ (float-time tdiff)
- (cond ((eq org-ts-what 'minute) 60)
- ((eq org-ts-what 'hour) 3600)
- ((eq org-ts-what 'day) (* 24 3600))
- ((eq org-ts-what 'month) (* 24 3600 31))
- ((eq org-ts-what 'year) (* 24 3600 365.2)))))
- org-ts-what 'updown)))))))
+ (pcase timestamp?
+ (`minute 60)
+ (`hour 3600)
+ (`day (* 24 3600))
+ (`month (* 24 3600 31))
+ (`year (* 24 3600 365.2)))))
+ timestamp? 'updown)))))))
;;;###autoload
(defun org-clock-cancel ()
@@ -1654,13 +1735,13 @@ Optional argument N tells to change by that many units."
(setq frame-title-format org-frame-title-format-backup)
(force-mode-line-update)
(error "No active clock"))
- (save-excursion ; Do not replace this with `with-current-buffer'.
- (org-no-warnings (set-buffer (org-clocking-buffer)))
+ (save-excursion ; Do not replace this with `with-current-buffer'.
+ (with-no-warnings (set-buffer (org-clocking-buffer)))
(goto-char org-clock-marker)
- (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")
- (line-beginning-position))
+ (if (looking-back (concat "^[ \t]*" org-clock-string ".*")
+ (line-beginning-position))
(progn (delete-region (1- (point-at-bol)) (point-at-eol))
- (org-remove-empty-drawer-at "LOGBOOK" (point)))
+ (org-remove-empty-drawer-at (point)))
(message "Clock gone, cancel the timer anyway")
(sit-for 2)))
(move-marker org-clock-marker nil)
@@ -1672,12 +1753,6 @@ Optional argument N tells to change by that many units."
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
-(defcustom org-clock-goto-before-context 2
- "Number of lines of context to display before currently clocked-in entry.
-This applies when using `org-clock-goto'."
- :group 'org-clock
- :type 'integer)
-
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1695,7 +1770,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(setq recent t)
(car org-clock-history))
(t (error "No active or recent clock task")))))
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(if (or (< m (point-min)) (> m (point-max))) (widen))
(goto-char m)
(org-show-entry)
@@ -1707,15 +1782,27 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(message "No running clock, this is the most recently clocked task"))
(run-hooks 'org-clock-goto-hook)))
-(defvar org-clock-file-total-minutes nil
+(defvar-local org-clock-file-total-minutes nil
"Holds the file total time in minutes, after a call to `org-clock-sum'.")
-(make-variable-buffer-local 'org-clock-file-total-minutes)
(defun org-clock-sum-today (&optional headline-filter)
"Sum the times for each subtree for today."
- (interactive)
(let ((range (org-clock-special-range 'today)))
- (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today)))
+ (org-clock-sum (car range) (cadr range)
+ headline-filter :org-clock-minutes-today)))
+
+(defun org-clock-sum-custom (&optional headline-filter range propname)
+ "Sum the times for each subtree for today."
+ (let ((r (or (and (symbolp range) (org-clock-special-range range))
+ (org-clock-special-range
+ (intern (completing-read
+ "Range: "
+ '("today" "yesterday" "thisweek" "lastweek"
+ "thismonth" "lastmonth" "thisyear" "lastyear"
+ "interactive")
+ nil t))))))
+ (org-clock-sum (car r) (cadr r)
+ headline-filter (or propname :org-clock-minutes-custom))))
;;;###autoload
(defun org-clock-sum (&optional tstart tend headline-filter propname)
@@ -1726,21 +1813,21 @@ HEADLINE-FILTER is a zero-arg function that, if specified, is called for
each headline in the time range with point at the headline. Headlines for
which HEADLINE-FILTER returns nil are excluded from the clock summation.
PROPNAME lets you set a custom text property instead of :org-clock-minutes."
- (interactive)
(org-with-silent-modifications
(let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*"
org-clock-string
"[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)"))
(lmax 30)
(ltimes (make-vector lmax 0))
- (t1 0)
(level 0)
- ts te dt
+ (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart))
+ ((consp tstart) (float-time tstart))
+ (t tstart)))
+ (tend (cond ((stringp tend) (org-time-string-to-seconds tend))
+ ((consp tend) (float-time tend))
+ (t tend)))
+ (t1 0)
time)
- (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart)))
- (if (stringp tend) (setq tend (org-time-string-to-seconds tend)))
- (if (consp tstart) (setq tstart (float-time tstart)))
- (if (consp tend) (setq tend (float-time tend)))
(remove-text-properties (point-min) (point-max)
`(,(or propname :org-clock-minutes) t
:org-clock-force-headline-inclusion t))
@@ -1749,32 +1836,33 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(while (re-search-backward re nil t)
(cond
((match-end 2)
- ;; Two time stamps
- (setq ts (match-string 2)
- te (match-string 3)
- ts (float-time
- (apply 'encode-time (org-parse-time-string ts)))
- te (float-time
- (apply 'encode-time (org-parse-time-string te)))
- ts (if tstart (max ts tstart) ts)
- te (if tend (min te tend) te)
- dt (- te ts)
- t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1)))
+ ;; Two time stamps.
+ (let* ((ts (float-time
+ (apply #'encode-time
+ (save-match-data
+ (org-parse-time-string (match-string 2))))))
+ (te (float-time
+ (apply #'encode-time
+ (org-parse-time-string (match-string 3)))))
+ (dt (- (if tend (min te tend) te)
+ (if tstart (max ts tstart) ts))))
+ (when (> dt 0) (cl-incf t1 (floor (/ dt 60))))))
((match-end 4)
- ;; A naked time
+ ;; A naked time.
(setq t1 (+ t1 (string-to-number (match-string 5))
(* 60 (string-to-number (match-string 4))))))
- (t ;; A headline
- ;; Add the currently clocking item time to the total
+ (t ;A headline
+ ;; Add the currently clocking item time to the total.
(when (and org-clock-report-include-clocking-task
- (equal (org-clocking-buffer) (current-buffer))
- (equal (marker-position org-clock-hd-marker) (point))
+ (eq (org-clocking-buffer) (current-buffer))
+ (eq (marker-position org-clock-hd-marker) (point))
tstart
tend
(>= (float-time org-clock-start-time) tstart)
(<= (float-time org-clock-start-time) tend))
(let ((time (floor (- (float-time)
- (float-time org-clock-start-time)) 60)))
+ (float-time org-clock-start-time))
+ 60)))
(setq t1 (+ t1 time))))
(let* ((headline-forced
(get-text-property (point)
@@ -1784,27 +1872,27 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
(save-excursion
(save-match-data (funcall headline-filter))))))
(setq level (- (match-end 1) (match-beginning 1)))
+ (when (>= level lmax)
+ (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax)))
(when (or (> t1 0) (> (aref ltimes level) 0))
(when (or headline-included headline-forced)
(if headline-included
- (loop for l from 0 to level do
- (aset ltimes l (+ (aref ltimes l) t1))))
+ (cl-loop for l from 0 to level do
+ (aset ltimes l (+ (aref ltimes l) t1))))
(setq time (aref ltimes level))
(goto-char (match-beginning 0))
(put-text-property (point) (point-at-eol)
(or propname :org-clock-minutes) time)
- (if headline-filter
- (save-excursion
- (save-match-data
- (while
- (> (funcall outline-level) 1)
- (outline-up-heading 1 t)
- (put-text-property
- (point) (point-at-eol)
- :org-clock-force-headline-inclusion t))))))
+ (when headline-filter
+ (save-excursion
+ (save-match-data
+ (while (org-up-heading-safe)
+ (put-text-property
+ (point) (line-end-position)
+ :org-clock-force-headline-inclusion t))))))
(setq t1 0)
- (loop for l from level to (1- lmax) do
- (aset ltimes l 0)))))))
+ (cl-loop for l from level to (1- lmax) do
+ (aset ltimes l 0)))))))
(setq org-clock-file-total-minutes (aref ltimes 0))))))
(defun org-clock-sum-current-item (&optional tstart)
@@ -1816,74 +1904,99 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes."
org-clock-file-total-minutes)))
;;;###autoload
-(defun org-clock-display (&optional total-only)
+(defun org-clock-display (&optional arg)
"Show subtree times in the entire buffer.
-If TOTAL-ONLY is non-nil, only show the total time for the entire file
-in the echo area.
-Use \\[org-clock-remove-overlays] to remove the subtree times."
- (interactive)
+By default, show the total time for the range defined in
+`org-clock-display-default-range'. With `\\[universal-argument]' \
+prefix, show
+the total time for today instead.
+
+With `\\[universal-argument] \\[universal-argument]' prefix, \
+use a custom range, entered at prompt.
+
+With `\\[universal-argument] \ \\[universal-argument] \
+\\[universal-argument]' prefix, display the total time in the
+echo area.
+
+Use `\\[org-clock-remove-overlays]' to remove the subtree times."
+ (interactive "P")
(org-clock-remove-overlays)
- (let (time h m p)
- (org-clock-sum)
- (unless total-only
+ (let* ((todayp (equal arg '(4)))
+ (customp (member arg '((16) today yesterday
+ thisweek lastweek thismonth
+ lastmonth thisyear lastyear
+ untilnow interactive)))
+ (prop (cond ((not arg) :org-clock-minutes-default)
+ (todayp :org-clock-minutes-today)
+ (customp :org-clock-minutes-custom)
+ (t :org-clock-minutes)))
+ time h m p)
+ (cond ((not arg) (org-clock-sum-custom
+ nil org-clock-display-default-range prop))
+ (todayp (org-clock-sum-today))
+ (customp (org-clock-sum-custom nil arg))
+ (t (org-clock-sum)))
+ (unless (eq arg '(64))
(save-excursion
(goto-char (point-min))
(while (or (and (equal (setq p (point)) (point-min))
- (get-text-property p :org-clock-minutes))
+ (get-text-property p prop))
(setq p (next-single-property-change
- (point) :org-clock-minutes)))
+ (point) prop)))
(goto-char p)
- (when (setq time (get-text-property p :org-clock-minutes))
- (org-clock-put-overlay time (funcall outline-level))))
+ (when (setq time (get-text-property p prop))
+ (org-clock-put-overlay time)))
(setq h (/ org-clock-file-total-minutes 60)
m (- org-clock-file-total-minutes (* 60 h)))
;; Arrange to remove the overlays upon next change.
(when org-remove-highlights-with-change
- (org-add-hook 'before-change-functions 'org-clock-remove-overlays
+ (add-hook 'before-change-functions 'org-clock-remove-overlays
nil 'local))))
- (message (concat "Total file time: "
- (org-minutes-to-clocksum-string org-clock-file-total-minutes)
- " (%d hours and %d minutes)") h m)))
-
-(defvar org-clock-overlays nil)
-(make-variable-buffer-local 'org-clock-overlays)
-
-(defun org-clock-put-overlay (time &optional level)
+ (message (concat (format "Total file time%s: "
+ (cond (todayp " for today")
+ (customp " (custom)")
+ (t "")))
+ (org-duration-from-minutes
+ org-clock-file-total-minutes)
+ " (%d hours and %d minutes)")
+ h m)))
+
+(defvar-local org-clock-overlays nil)
+
+(defun org-clock-put-overlay (time)
"Put an overlays on the current line, displaying TIME.
-If LEVEL is given, prefix time with a corresponding number of stars.
This creates a new overlay and stores it in `org-clock-overlays', so that it
will be easy to remove."
- (let* ((l (if level (org-get-valid-level level 0) 0))
- ov tx)
+ (let (ov tx)
(beginning-of-line)
- (when (looking-at org-complex-heading-regexp)
- (goto-char (match-beginning 4)))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (goto-char (match-beginning 4))))
(setq ov (make-overlay (point) (point-at-eol))
- tx (concat (buffer-substring-no-properties (point) (match-end 4))
- (make-string
- (max 0 (- (- 60 (current-column))
- (- (match-end 4) (match-beginning 4))
- (length (org-get-at-bol 'line-prefix)))) ?.)
- (org-add-props (concat (make-string l ?*) " "
- (org-minutes-to-clocksum-string time)
- (make-string (- 16 l) ?\ ))
- (list 'face 'org-clock-overlay))
+ tx (concat (buffer-substring-no-properties (point) (match-end 4))
+ (org-add-props
+ (make-string
+ (max 0 (- (- 60 (current-column))
+ (- (match-end 4) (match-beginning 4))
+ (length (org-get-at-bol 'line-prefix))))
+ ?\·)
+ '(face shadow))
+ (org-add-props
+ (format " %9s " (org-duration-from-minutes time))
+ '(face org-clock-overlay))
""))
- (if (not (featurep 'xemacs))
- (overlay-put ov 'display tx)
- (overlay-put ov 'invisible t)
- (overlay-put ov 'end-glyph (make-glyph tx)))
+ (overlay-put ov 'display tx)
(push ov org-clock-overlays)))
;;;###autoload
-(defun org-clock-remove-overlays (&optional beg end noremove)
+(defun org-clock-remove-overlays (&optional _beg _end noremove)
"Remove the occur highlights from the buffer.
-BEG and END are ignored. If NOREMOVE is nil, remove this function
-from the `before-change-functions' in the current buffer."
+If NOREMOVE is nil, remove this function from the
+`before-change-functions' in the current buffer."
(interactive)
(unless org-inhibit-highlight-removal
- (mapc 'delete-overlay org-clock-overlays)
+ (mapc #'delete-overlay org-clock-overlays)
(setq org-clock-overlays nil)
(unless noremove
(remove-hook 'before-change-functions
@@ -2020,127 +2133,159 @@ buffer and update it."
(defun org-clock-special-range (key &optional time as-strings wstart mstart)
"Return two times bordering a special time range.
-Key is a symbol specifying the range and can be one of `today', `yesterday',
-`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'.
-By default, a week starts Monday 0:00 and ends Sunday 24:00.
-The range is determined relative to TIME, which defaults to current time.
-The return value is a cons cell with two internal times like the ones
-returned by `current time' or `encode-time'.
-If AS-STRINGS is non-nil, the returned times will be formatted strings.
-If WSTART is non-nil, use this number to specify the starting day of a
-week (monday is 1).
-If MSTART is non-nil, use this number to specify the starting day of a
-month (1 is the first day of the month).
-If you can combine both, the month starting day will have priority."
- (if (integerp key) (setq key (intern (number-to-string key))))
+
+KEY is a symbol specifying the range and can be one of `today',
+`yesterday', `thisweek', `lastweek', `thismonth', `lastmonth',
+`thisyear', `lastyear' or `untilnow'. If set to `interactive',
+user is prompted for range boundaries. It can be a string or an
+integer.
+
+By default, a week starts Monday 0:00 and ends Sunday 24:00. The
+range is determined relative to TIME, which defaults to current
+time.
+
+The return value is a list containing two internal times, one for
+the beginning of the range and one for its end, like the ones
+returned by `current time' or `encode-time' and a string used to
+display information. If AS-STRINGS is non-nil, the returned
+times will be formatted strings.
+
+If WSTART is non-nil, use this number to specify the starting day
+of a week (monday is 1). If MSTART is non-nil, use this number
+to specify the starting day of a month (1 is the first day of the
+month). If you can combine both, the month starting day will
+have priority."
(let* ((tm (decode-time time))
- (s 0) (m (nth 1 tm)) (h (nth 2 tm))
- (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm))
+ (m (nth 1 tm))
+ (h (nth 2 tm))
+ (d (nth 3 tm))
+ (month (nth 4 tm))
+ (y (nth 5 tm))
(dow (nth 6 tm))
- (ws (or wstart 1))
- (ms (or mstart 1))
- (skey (symbol-name key))
+ (skey (format "%s" key))
(shift 0)
- (q (cond ((>= (nth 4 tm) 10) 4)
- ((>= (nth 4 tm) 7) 3)
- ((>= (nth 4 tm) 4) 2)
- ((>= (nth 4 tm) 1) 1)))
- s1 m1 h1 d1 month1 y1 diff ts te fm txt w date
- interval tmp shiftedy shiftedm shiftedq)
+ (q (cond ((>= month 10) 4)
+ ((>= month 7) 3)
+ ((>= month 4) 2)
+ (t 1)))
+ m1 h1 d1 month1 y1 shiftedy shiftedm shiftedq)
(cond
- ((string-match "^[0-9]+$" skey)
- (setq y (string-to-number skey) m 1 d 1 key 'year))
- ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ ((string-match "\\`[0-9]+\\'" skey)
+ (setq y (string-to-number skey) month 1 d 1 key 'year))
+ ((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
- d 1 key 'month))
- ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey)
+ d 1
+ key 'month))
+ ((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey)
(require 'cal-iso)
- (setq y (string-to-number (match-string 1 skey))
- w (string-to-number (match-string 2 skey)))
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (list w 1 y))))
- (setq d (nth 1 date) month (car date) y (nth 2 date)
- dow 1
- key 'week))
- ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey)
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-iso-to-absolute
+ (list (string-to-number (match-string 2 skey))
+ 1
+ (string-to-number (match-string 1 skey)))))))
+ (setq d (nth 1 date)
+ month (car date)
+ y (nth 2 date)
+ dow 1
+ key 'week)))
+ ((string-match "\\`\\([0-9]+\\)-[qQ]\\([1-4]\\)\\'" skey)
(require 'cal-iso)
- (setq y (string-to-number (match-string 1 skey)))
(setq q (string-to-number (match-string 2 skey)))
- (setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date q y))))
- (setq d (nth 1 date) month (car date) y (nth 2 date)
- dow 1
- key 'quarter))
- ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey)
+ (let ((date (calendar-gregorian-from-absolute
+ (calendar-iso-to-absolute
+ (org-quarter-to-date
+ q (string-to-number (match-string 1 skey)))))))
+ (setq d (nth 1 date)
+ month (car date)
+ y (nth 2 date)
+ dow 1
+ key 'quarter)))
+ ((string-match
+ "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)\\'"
+ skey)
(setq y (string-to-number (match-string 1 skey))
month (string-to-number (match-string 2 skey))
d (string-to-number (match-string 3 skey))
key 'day))
- ((string-match "\\([-+][0-9]+\\)$" skey)
+ ((string-match "\\([-+][0-9]+\\)\\'" skey)
(setq shift (string-to-number (match-string 1 skey))
- key (intern (substring skey 0 (match-beginning 1))))
- (if (and (memq key '(quarter thisq)) (> shift 0))
- (error "Looking forward with quarters isn't implemented"))))
-
+ key (intern (substring skey 0 (match-beginning 1))))
+ (when (and (memq key '(quarter thisq)) (> shift 0))
+ (error "Looking forward with quarters isn't implemented"))))
(when (= shift 0)
- (cond ((eq key 'yesterday) (setq key 'today shift -1))
- ((eq key 'lastweek) (setq key 'week shift -1))
- ((eq key 'lastmonth) (setq key 'month shift -1))
- ((eq key 'lastyear) (setq key 'year shift -1))
- ((eq key 'lastq) (setq key 'quarter shift -1))))
- (cond
- ((memq key '(day today))
- (setq d (+ d shift) h 0 m 0 h1 24 m1 0))
- ((memq key '(week thisweek))
- (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))
- m 0 h 0 d (- d diff) d1 (+ 7 d)))
- ((memq key '(month thismonth))
- (setq d (or ms 1) h 0 m 0 d1 (or ms 1)
- month (+ month shift) month1 (1+ month) h1 0 m1 0))
- ((memq key '(quarter thisq))
- ;; Compute if this shift remains in this year. If not, compute
- ;; how many years and quarters we have to shift (via floor*) and
- ;; compute the shifted years, months and quarters.
- (cond
- ((< (+ (- q 1) shift) 0) ; shift not in this year
- (setq interval (* -1 (+ (- q 1) shift)))
- ;; Set tmp to ((years to shift) (quarters to shift)).
- (setq tmp (org-floor* interval 4))
- ;; Due to the use of floor, 0 quarters actually means 4.
- (if (= 0 (nth 1 tmp))
- (setq shiftedy (- y (nth 0 tmp))
- shiftedm 1
- shiftedq 1)
- (setq shiftedy (- y (+ 1 (nth 0 tmp)))
- shiftedm (- 13 (* 3 (nth 1 tmp)))
- shiftedq (- 5 (nth 1 tmp))))
- (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy))
- ((> (+ q shift) 0) ; shift is within this year
- (setq shiftedq (+ q shift))
- (setq shiftedy y)
- (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0))))
- ((memq key '(year thisyear))
- (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
- (t (error "No such time block %s" key)))
- (setq ts (encode-time s m h d month y)
- te (encode-time (or s1 s) (or m1 m) (or h1 h)
- (or d1 d) (or month1 month) (or y1 y)))
- (setq fm (cdr org-time-stamp-formats))
- (cond
- ((memq key '(day today))
- (setq txt (format-time-string "%A, %B %d, %Y" ts)))
- ((memq key '(week thisweek))
- (setq txt (format-time-string "week %G-W%V" ts)))
- ((memq key '(month thismonth))
- (setq txt (format-time-string "%B %Y" ts)))
- ((memq key '(year thisyear))
- (setq txt (format-time-string "the year %Y" ts)))
- ((memq key '(quarter thisq))
- (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy)))))
- (if as-strings
- (list (format-time-string fm ts) (format-time-string fm te) txt)
- (list ts te txt))))
+ (pcase key
+ (`yesterday (setq key 'today shift -1))
+ (`lastweek (setq key 'week shift -1))
+ (`lastmonth (setq key 'month shift -1))
+ (`lastyear (setq key 'year shift -1))
+ (`lastq (setq key 'quarter shift -1))))
+ ;; Prepare start and end times depending on KEY's type.
+ (pcase key
+ ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift)))
+ ((or `week `thisweek)
+ (let* ((ws (or wstart 1))
+ (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws)))))
+ (setq m 0 h 0 d (- d diff) d1 (+ 7 d))))
+ ((or `month `thismonth)
+ (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month)))
+ ((or `quarter `thisq)
+ ;; Compute if this shift remains in this year. If not, compute
+ ;; how many years and quarters we have to shift (via floor*) and
+ ;; compute the shifted years, months and quarters.
+ (cond
+ ((< (+ (- q 1) shift) 0) ; Shift not in this year.
+ (let* ((interval (* -1 (+ (- q 1) shift)))
+ ;; Set tmp to ((years to shift) (quarters to shift)).
+ (tmp (cl-floor interval 4)))
+ ;; Due to the use of floor, 0 quarters actually means 4.
+ (if (= 0 (nth 1 tmp))
+ (setq shiftedy (- y (nth 0 tmp))
+ shiftedm 1
+ shiftedq 1)
+ (setq shiftedy (- y (+ 1 (nth 0 tmp)))
+ shiftedm (- 13 (* 3 (nth 1 tmp)))
+ shiftedq (- 5 (nth 1 tmp)))))
+ (setq m 0 h 0 d 1 month shiftedm month1 (+ 3 shiftedm) y shiftedy))
+ ((> (+ q shift) 0) ; Shift is within this year.
+ (setq shiftedq (+ q shift))
+ (setq shiftedy y)
+ (let ((qshift (* 3 (1- (+ q shift)))))
+ (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift))))))
+ ((or `year `thisyear)
+ (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y)))
+ ((or `interactive `untilnow)) ; Special cases, ignore them.
+ (_ (user-error "No such time block %s" key)))
+ ;; Format start and end times according to AS-STRINGS.
+ (let* ((start (pcase key
+ (`interactive (org-read-date nil t nil "Range start? "))
+ (`untilnow org-clock--oldest-date)
+ (_ (encode-time 0 m h d month y))))
+ (end (pcase key
+ (`interactive (org-read-date nil t nil "Range end? "))
+ (`untilnow (current-time))
+ (_ (encode-time 0
+ (or m1 m)
+ (or h1 h)
+ (or d1 d)
+ (or month1 month)
+ (or y1 y)))))
+ (text
+ (pcase key
+ ((or `day `today) (format-time-string "%A, %B %d, %Y" start))
+ ((or `week `thisweek) (format-time-string "week %G-W%V" start))
+ ((or `month `thismonth) (format-time-string "%B %Y" start))
+ ((or `year `thisyear) (format-time-string "the year %Y" start))
+ ((or `quarter `thisq)
+ (concat (org-count-quarter shiftedq)
+ " quarter of " (number-to-string shiftedy)))
+ (`interactive "(Range interactively set)")
+ (`untilnow "now"))))
+ (if (not as-strings) (list start end text)
+ (let ((f (cdr org-time-stamp-formats)))
+ (list (format-time-string f start)
+ (format-time-string f end)
+ text))))))
(defun org-count-quarter (n)
(cond
@@ -2196,7 +2341,7 @@ the currently selected interval size."
((and wp (string-match "w\\|W" wp) mw (> (length wp) 0))
(require 'cal-iso)
(setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (list (+ mw n) 1 y))))
+ (calendar-iso-to-absolute (list (+ mw n) 1 y))))
(setq ins (format-time-string
"%G-W%V"
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
@@ -2213,7 +2358,7 @@ the currently selected interval size."
y (- y 1))
())
(setq date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y))))
+ (calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y))))
(setq ins (format-time-string
(concat (number-to-string y) "-Q" (number-to-string (+ mw n)))
(encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date)))))
@@ -2238,25 +2383,33 @@ the currently selected interval size."
(setq params (org-combine-plists org-clocktable-defaults params))
(catch 'exit
(let* ((scope (plist-get params :scope))
+ (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))))
+ ((pred functionp) (funcall scope))
+ ((pred consp) scope)
+ (_ (or (buffer-file-name) (current-buffer)))))
(block (plist-get params :block))
(ts (plist-get params :tstart))
(te (plist-get params :tend))
- (link (plist-get params :link))
- (maxlevel (or (plist-get params :maxlevel) 3))
(ws (plist-get params :wstart))
(ms (plist-get params :mstart))
(step (plist-get params :step))
- (timestamp (plist-get params :timestamp))
(formatter (or (plist-get params :formatter)
org-clock-clocktable-formatter
'org-clocktable-write-default))
- cc range-text ipos pos one-file-with-archives
- scope-is-list tbls level)
+ cc)
;; Check if we need to do steps
(when block
;; Get the range text for the header
(setq cc (org-clock-special-range block nil t ws ms)
- ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ ts (car cc)
+ te (nth 1 cc)))
(when step
;; Write many tables, in steps
(unless (or block (and ts te))
@@ -2264,63 +2417,49 @@ the currently selected interval size."
(org-clocktable-steps params)
(throw 'exit nil))
- (setq ipos (point)) ; remember the insertion position
-
- ;; Get the right scope
- (setq pos (point))
- (cond
- ((and scope (listp scope) (symbolp (car scope)))
- (setq scope (eval scope)))
- ((eq scope 'agenda)
- (setq scope (org-agenda-files t)))
- ((eq scope 'agenda-with-archives)
- (setq scope (org-agenda-files t))
- (setq scope (org-add-archive-files scope)))
- ((eq scope 'file-with-archives)
- (setq scope (org-add-archive-files (list (buffer-file-name)))
- one-file-with-archives t)))
- (setq scope-is-list (and scope (listp scope)))
- (if scope-is-list
- ;; we collect from several files
- (let* ((files scope)
- file)
- (org-agenda-prepare-buffers files)
- (while (setq file (pop files))
- (with-current-buffer (find-buffer-visiting file)
- (save-excursion
- (save-restriction
- (push (org-clock-get-table-data file params) tbls))))))
- ;; Just from the current file
- (save-restriction
- ;; get the right range into the restriction
- (org-agenda-prepare-buffers (list (buffer-file-name)))
- (cond
- ((not scope)) ; use the restriction as it is now
- ((eq scope 'file) (widen))
- ((eq scope 'subtree) (org-narrow-to-subtree))
- ((eq scope 'tree)
- (while (org-up-heading-safe))
- (org-narrow-to-subtree))
- ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$"
- (symbol-name scope)))
- (setq level (string-to-number (match-string 1 (symbol-name scope))))
- (catch 'exit
- (while (org-up-heading-safe)
- (looking-at org-outline-regexp)
- (if (<= (org-reduced-level (funcall outline-level)) level)
- (throw 'exit nil))))
- (org-narrow-to-subtree)))
- ;; do the table, with no file name.
- (push (org-clock-get-table-data nil params) tbls)))
-
- ;; OK, at this point we tbls as a list of tables, one per file
- (setq tbls (nreverse tbls))
-
- (setq params (plist-put params :multifile scope-is-list))
- (setq params (plist-put params :one-file-with-archives
- one-file-with-archives))
-
- (funcall formatter ipos tbls params))))
+ (org-agenda-prepare-buffers (if (consp files) files (list files)))
+
+ (let ((origin (point))
+ (tables
+ (if (consp files)
+ (mapcar (lambda (file)
+ (with-current-buffer (find-buffer-visiting file)
+ (save-excursion
+ (save-restriction
+ (org-clock-get-table-data file params)))))
+ files)
+ ;; Get the right restriction for the scope.
+ (save-restriction
+ (cond
+ ((not scope)) ;use the restriction as it is now
+ ((eq scope 'file) (widen))
+ ((eq scope 'subtree) (org-narrow-to-subtree))
+ ((eq scope 'tree)
+ (while (org-up-heading-safe))
+ (org-narrow-to-subtree))
+ ((and (symbolp scope)
+ (string-match "\\`tree\\([0-9]+\\)\\'"
+ (symbol-name scope)))
+ (let ((level (string-to-number
+ (match-string 1 (symbol-name scope)))))
+ (catch 'exit
+ (while (org-up-heading-safe)
+ (looking-at org-outline-regexp)
+ (when (<= (org-reduced-level (funcall outline-level))
+ level)
+ (throw 'exit nil))))
+ (org-narrow-to-subtree))))
+ (list (org-clock-get-table-data nil params)))))
+ (multifile
+ ;; Even though `file-with-archives' can consist of
+ ;; multiple files, we consider this is one extended file
+ ;; instead.
+ (and (consp files) (not (eq scope 'file-with-archives)))))
+
+ (funcall formatter
+ origin
+ tables
+ (org-combine-plists params `(:multifile ,multifile)))))))
(defun org-clocktable-write-default (ipos tables params)
"Write out a clock table at position IPOS in the current buffer.
@@ -2333,237 +2472,224 @@ from the dynamic block definition."
;; someone wants to write their own special formatter, this maybe
;; much easier because there can be a fixed format with a
;; well-defined number of columns...
- (let* ((hlchars '((1 . "*") (2 . "/")))
- (lwords (assoc (or (plist-get params :lang)
- (org-bound-and-true-p org-export-default-language)
- "en")
- org-clock-clocktable-language-setup))
+ (let* ((lang (or (plist-get params :lang) "en"))
(multifile (plist-get params :multifile))
(block (plist-get params :block))
- (ts (plist-get params :tstart))
- (te (plist-get params :tend))
- (header (plist-get params :header))
- (narrow (plist-get params :narrow))
- (ws (or (plist-get params :wstart) 1))
- (ms (or (plist-get params :mstart) 1))
+ (sort (plist-get params :sort))
+ (header (plist-get params :header))
(link (plist-get params :link))
(maxlevel (or (plist-get params :maxlevel) 3))
(emph (plist-get params :emphasize))
- (level-p (plist-get params :level))
- (org-time-clocksum-use-effort-durations
- (plist-get params :effort-durations))
+ (compact? (plist-get params :compact))
+ (narrow (or (plist-get params :narrow) (and compact? '40!)))
+ (level? (and (not compact?) (plist-get params :level)))
(timestamp (plist-get params :timestamp))
(properties (plist-get params :properties))
- (ntcol (max 1 (or (plist-get params :tcolumns) 100)))
- (rm-file-column (plist-get params :one-file-with-archives))
- (indent (plist-get params :indent))
+ (time-columns
+ (if (or compact? (< maxlevel 2)) 1
+ ;; Deepest headline level is a hard limit for the number
+ ;; of time columns.
+ (let ((levels
+ (cl-mapcan
+ (lambda (table)
+ (pcase table
+ (`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries)
+ (mapcar #'car entries))))
+ tables)))
+ (min maxlevel
+ (or (plist-get params :tcolumns) 100)
+ (if (null levels) 1 (apply #'max levels))))))
+ (indent (or compact? (plist-get params :indent)))
+ (formula (plist-get params :formula))
(case-fold-search t)
- range-text total-time tbl level hlc formula pcol
- file-time entries entry headline
- recalc content narrow-cut-p tcol)
-
- ;; Implement abbreviations
- (when (plist-get params :compact)
- (setq level nil indent t narrow (or narrow '40!) ntcol 1))
-
- ;; Some consistency test for parameters
- (unless (integerp ntcol)
- (setq params (plist-put params :tcolumns (setq ntcol 100))))
+ (total-time (apply #'+ (mapcar #'cadr tables)))
+ recalc narrow-cut-p)
(when (and narrow (integerp narrow) link)
- ;; We cannot have both integer narrow and link
- (message
- "Using hard narrowing in clocktable to allow for links")
+ ;; We cannot have both integer narrow and link.
+ (message "Using hard narrowing in clocktable to allow for links")
(setq narrow (intern (format "%d!" narrow))))
- (when narrow
- (cond
- ((integerp narrow))
- ((and (symbolp narrow)
- (string-match "\\`[0-9]+!\\'" (symbol-name narrow)))
- (setq narrow-cut-p t
- narrow (string-to-number (substring (symbol-name narrow)
- 0 -1))))
- (t
- (error "Invalid value %s of :narrow property in clock table"
- narrow))))
-
- (when block
- ;; Get the range text for the header
- (setq range-text (nth 2 (org-clock-special-range block nil t ws ms))))
-
- ;; Compute the total time
- (setq total-time (apply '+ (mapcar 'cadr tables)))
+ (pcase narrow
+ ((or `nil (pred integerp)) nil) ;nothing to do
+ ((and (pred symbolp)
+ (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)))
- ;; Now we need to output this tsuff
+ ;; Now we need to output this table stuff.
(goto-char ipos)
- ;; Insert the text *before* the actual table
+ ;; Insert the text *before* the actual table.
(insert-before-markers
(or header
- ;; Format the standard header
- (concat
- "#+CAPTION: "
- (nth 9 lwords) " ["
- (substring
- (format-time-string (cdr org-time-stamp-formats))
- 1 -1)
- "]"
- (if block (concat ", for " range-text ".") "")
- "\n")))
+ ;; Format the standard header.
+ (format "#+CAPTION: %s %s%s\n"
+ (org-clock--translate "Clock summary at" lang)
+ (format-time-string (org-time-stamp-format t t))
+ (if block
+ (let ((range-text
+ (nth 2 (org-clock-special-range
+ block nil t
+ (plist-get params :wstart)
+ (plist-get params :mstart)))))
+ (format ", for %s." range-text))
+ ""))))
;; Insert the narrowing line
(when (and narrow (integerp narrow) (not narrow-cut-p))
(insert-before-markers
- "|" ; table line starter
- (if multifile "|" "") ; file column, maybe
- (if level-p "|" "") ; level column, maybe
- (if timestamp "|" "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (format "<%d>| |\n" narrow))) ; headline and time columns
+ "|" ;table line starter
+ (if multifile "|" "") ;file column, maybe
+ (if level? "|" "") ;level column, maybe
+ (if timestamp "|" "") ;timestamp column, maybe
+ (if properties ;properties columns, maybe
+ (make-string (length properties) ?|)
+ "")
+ (format "<%d>| |\n" narrow))) ;headline and time columns
;; Insert the table header line
(insert-before-markers
- "|" ; table line starter
- (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe
- (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe
- (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe
- (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe
- (concat (nth 4 lwords) "|"
- (nth 5 lwords) "|\n")) ; headline and time columns
+ "|" ;table line starter
+ (if multifile ;file column, maybe
+ (concat (org-clock--translate "File" lang) "|")
+ "")
+ (if level? ;level column, maybe
+ (concat (org-clock--translate "L" lang) "|")
+ "")
+ (if timestamp ;timestamp column, maybe
+ (concat (org-clock--translate "Timestamp" lang) "|")
+ "")
+ (if properties ;properties columns, maybe
+ (concat (mapconcat #'identity properties "|") "|")
+ "")
+ (concat (org-clock--translate "Headline" lang)"|")
+ (concat (org-clock--translate "Time" lang) "|")
+ (make-string (max 0 (1- time-columns)) ?|) ;other time columns
+ (if (eq formula '%) "%|\n" "\n"))
;; Insert the total time in the table
(insert-before-markers
- "|-\n" ; a hline
- "|" ; table line starter
- (if multifile (concat "| " (nth 6 lwords) " ") "")
- ; file column, maybe
- (if level-p "|" "") ; level column, maybe
- (if timestamp "|" "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ; properties columns, maybe
- (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline
+ "|-\n" ;a hline
+ "|" ;table line starter
+ (if multifile (format "| %s " (org-clock--translate "ALL" lang)) "")
+ ;file column, maybe
+ (if level? "|" "") ;level column, maybe
+ (if timestamp "|" "") ;timestamp column, maybe
+ (make-string (length properties) ?|) ;properties columns, maybe
+ (concat (format org-clock-total-time-cell-format
+ (org-clock--translate "Total time" lang))
+ "| ")
(format org-clock-total-time-cell-format
- (org-minutes-to-clocksum-string (or total-time 0))) ; the time
- "|\n") ; close line
-
- ;; Now iterate over the tables and insert the data
- ;; but only if any time has been collected
+ (org-duration-from-minutes (or total-time 0))) ;time
+ "|"
+ (make-string (max 0 (1- time-columns)) ?|)
+ (cond ((not (eq formula '%)) "")
+ ((or (not total-time) (= total-time 0)) "0.0|")
+ (t "100.0|"))
+ "\n")
+
+ ;; Now iterate over the tables and insert the data but only if any
+ ;; time has been collected.
(when (and total-time (> total-time 0))
-
- (while (setq tbl (pop tables))
- ;; now tbl is the table resulting from one file.
- (setq file-time (nth 1 tbl))
+ (pcase-dolist (`(,file-name ,file-time ,entries) tables)
(when (or (and file-time (> file-time 0))
(not (plist-get params :fileskip0)))
- (insert-before-markers "|-\n") ; a hline because a new file starts
- ;; First the file time, if we have multiple files
+ (insert-before-markers "|-\n") ;hline at new file
+ ;; First the file time, if we have multiple files.
(when multifile
- ;; Summarize the time collected from this file
+ ;; Summarize the time collected from this file.
(insert-before-markers
(format (concat "| %s %s | %s%s"
- (format org-clock-file-time-cell-format (nth 8 lwords))
+ (format org-clock-file-time-cell-format
+ (org-clock--translate "File time" lang))
" | *%s*|\n")
- (file-name-nondirectory (car tbl))
- (if level-p "| " "") ; level column, maybe
- (if timestamp "| " "") ; timestamp column, maybe
- (if properties (make-string (length properties) ?|) "") ;properties columns, maybe
- (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time
+ (file-name-nondirectory file-name)
+ (if level? "| " "") ;level column, maybe
+ (if timestamp "| " "") ;timestamp column, maybe
+ (if properties ;properties columns, maybe
+ (make-string (length properties) ?|)
+ "")
+ (org-duration-from-minutes file-time)))) ;time
;; Get the list of node entries and iterate over it
- (setq entries (nth 2 tbl))
- (while (setq entry (pop entries))
- (setq level (car entry)
- headline (nth 1 entry)
- hlc (if emph (or (cdr (assoc level hlchars)) "") ""))
- (when narrow-cut-p
- (if (and (string-match (concat "\\`" org-bracket-link-regexp
- "\\'")
- headline)
- (match-end 3))
- (setq headline
- (format "[[%s][%s]]"
- (match-string 1 headline)
- (org-shorten-string (match-string 3 headline)
- narrow)))
- (setq headline (org-shorten-string headline narrow))))
- (insert-before-markers
- "|" ; start the table line
- (if multifile "|" "") ; free space for file name column?
- (if level-p (format "%d|" (car entry)) "") ; level, maybe
- (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe
- (if properties
- (concat
- (mapconcat
- (lambda (p) (or (cdr (assoc p (nth 4 entry))) ""))
- properties "|") "|") "") ;properties columns, maybe
- (if indent (org-clocktable-indent-string level) "") ; indentation
- hlc headline hlc "|" ; headline
- (make-string (min (1- ntcol) (or (- level 1))) ?|)
- ; empty fields for higher levels
- hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time
- "|\n" ; close line
- )))))
- ;; When exporting subtrees or regions the region might be
- ;; activated, so let's disable ̀delete-active-region'
- (let ((delete-active-region nil)) (backward-delete-char 1))
- (if (setq formula (plist-get params :formula))
- (cond
- ((eq formula '%)
- ;; compute the column where the % numbers need to go
- (setq pcol (+ 2
- (if multifile 1 0)
- (if level-p 1 0)
- (if timestamp 1 0)
- (min maxlevel (or ntcol 100))))
- ;; compute the column where the total time is
- (setq tcol (+ 2
- (if multifile 1 0)
- (if level-p 1 0)
- (if timestamp 1 0)))
- (insert
- (format
- "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f"
- pcol ; the column where the % numbers should go
- (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time
- tcol ; column of the total time
- tcol (1- pcol) ; range of columns where times can be found
- ))
- (setq recalc t))
- ((stringp formula)
- (insert "\n#+TBLFM: " formula)
- (setq recalc t))
- (t (error "Invalid formula in clocktable")))
- ;; Should we rescue an old formula?
- (when (stringp (setq content (plist-get params :content)))
- (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content)
+ (when (> maxlevel 0)
+ (pcase-dolist (`(,level ,headline ,ts ,time ,props) entries)
+ (when narrow-cut-p
+ (setq headline
+ (if (and (string-match
+ (format "\\`%s\\'" org-bracket-link-regexp)
+ headline)
+ (match-end 3))
+ (format "[[%s][%s]]"
+ (match-string 1 headline)
+ (org-shorten-string (match-string 3 headline)
+ narrow))
+ (org-shorten-string headline narrow))))
+ (cl-flet ((format-field (f) (format (cond ((not emph) "%s |")
+ ((= level 1) "*%s* |")
+ ((= level 2) "/%s/ |")
+ (t "%s |"))
+ f)))
+ (insert-before-markers
+ "|" ;start the table line
+ (if multifile "|" "") ;free space for file name column?
+ (if level? (format "%d|" level) "") ;level, maybe
+ (if timestamp (concat ts "|") "") ;timestamp, maybe
+ (if properties ;properties columns, maybe
+ (concat (mapconcat (lambda (p) (or (cdr (assoc p props)) ""))
+ properties
+ "|")
+ "|")
+ "")
+ (if indent ;indentation
+ (org-clocktable-indent-string level)
+ "")
+ (format-field headline)
+ ;; Empty fields for higher levels.
+ (make-string (max 0 (1- (min time-columns level))) ?|)
+ (format-field (org-duration-from-minutes time))
+ (make-string (max 0 (- time-columns level)) ?|)
+ (if (eq formula '%)
+ (format "%.1f |" (* 100 (/ time (float total-time))))
+ "")
+ "\n")))))))
+ (delete-char -1)
+ (cond
+ ;; Possibly rescue old formula?
+ ((or (not formula) (eq formula '%))
+ (let ((contents (org-string-nw-p (plist-get params :content))))
+ (when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents))
(setq recalc t)
- (insert "\n" (match-string 1 (plist-get params :content)))
+ (insert "\n" (match-string 1 contents))
(beginning-of-line 0))))
- ;; Back to beginning, align the table, recalculate if necessary
+ ;; Insert specified formula line.
+ ((stringp formula)
+ (insert "\n#+TBLFM: " formula)
+ (setq recalc t))
+ (t
+ (user-error "Invalid :formula parameter in clocktable")))
+ ;; Back to beginning, align the table, recalculate if necessary.
(goto-char ipos)
(skip-chars-forward "^|")
(org-table-align)
(when org-hide-emphasis-markers
- ;; we need to align a second time
+ ;; We need to align a second time.
(org-table-align))
- (when recalc
- (if (eq formula '%)
- (save-excursion
- (if (and narrow (not narrow-cut-p)) (beginning-of-line 2))
- (org-table-goto-column pcol nil 'force)
- (insert "%")))
- (org-table-recalculate 'all))
- (when rm-file-column
- ;; The file column is actually not wanted
- (forward-char 1)
- (org-table-delete-column))
+ (when sort
+ (save-excursion
+ (org-table-goto-line 3)
+ (org-table-goto-column (car sort))
+ (org-table-sort-lines nil (cdr sort))))
+ (when recalc (org-table-recalculate 'all))
total-time))
(defun org-clocktable-indent-string (level)
+ "Return indentation string according to LEVEL.
+LEVEL is an integer. Indent by two spaces per level above 1."
(if (= level 1) ""
- (let ((str " "))
- (dotimes (k (1- level) str)
- (setq str (concat "\\emsp" str))))))
+ (concat "\\_" (make-string (* 2 (1- level)) ?\s))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
@@ -2576,29 +2702,31 @@ from the dynamic block definition."
(step (cdr (assoc step0 '((day . 86400) (week . 604800)))))
(stepskip0 (plist-get p1 :stepskip0))
(block (plist-get p1 :block))
- cc range-text step-time tsb)
+ cc step-time tsb)
(when block
(setq cc (org-clock-special-range block nil t ws ms)
- ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ ts (car cc)
+ te (nth 1 cc)))
(cond
((numberp ts)
- ;; If ts is a number, it's an absolute day number from org-agenda.
- (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts)
+ ;; If ts is a number, it's an absolute day number from
+ ;; org-agenda.
+ (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts)))
(setq ts (float-time (encode-time 0 0 0 day month year)))))
(ts
- (setq ts (float-time
- (apply 'encode-time (org-parse-time-string ts))))))
+ (setq ts (float-time (apply #'encode-time (org-parse-time-string ts))))))
(cond
((numberp te)
;; Likewise for te.
- (destructuring-bind (month day year) (calendar-gregorian-from-absolute te)
+ (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te)))
(setq te (float-time (encode-time 0 0 0 day month year)))))
(te
- (setq te (float-time
- (apply 'encode-time (org-parse-time-string te))))))
+ (setq te (float-time (apply #'encode-time (org-parse-time-string te))))))
(setq tsb
(if (eq step0 'week)
- (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws)))
+ (let ((dow (nth 6 (decode-time (seconds-to-time ts)))))
+ (if (< dow ws) ts
+ (- ts (* 86400 (- dow ws)))))
ts))
(setq p1 (plist-put p1 :header ""))
(setq p1 (plist-put p1 :step nil))
@@ -2608,9 +2736,14 @@ from the dynamic block definition."
(setq p1 (plist-put p1 :tstart (format-time-string
(org-time-stamp-format nil t)
(seconds-to-time (max tsb ts)))))
+ (cl-incf tsb (let ((dow (nth 6 (decode-time (seconds-to-time tsb)))))
+ (if (or (eq step0 'day)
+ (= dow ws))
+ step
+ (* 86400 (- ws dow)))))
(setq p1 (plist-put p1 :tend (format-time-string
(org-time-stamp-format nil t)
- (seconds-to-time (min te (setq tsb (+ tsb step)))))))
+ (seconds-to-time (min te tsb)))))
(insert "\n" (if (eq step0 'day) "Daily report: "
"Weekly report starting on: ")
(plist-get p1 :tstart) "\n")
@@ -2635,19 +2768,22 @@ file time (in minutes) as 1st and 2nd elements. The third element
of this list will be a list of headline entries. Each entry has the
following structure:
- (LEVEL HEADLINE TIMESTAMP TIME)
-
-LEVEL: The level of the headline, as an integer. This will be
- the reduced leve, so 1,2,3,... even if only odd levels
- are being used.
-HEADLINE: The text of the headline. Depending on PARAMS, this may
- already be formatted like a link.
-TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
- entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
- in this sequence.
-TIME: The sum of all time spend in this tree, in minutes. This time
- will of cause be restricted to the time block and tags match
- specified in PARAMS."
+ (LEVEL HEADLINE TIMESTAMP TIME PROPERTIES)
+
+LEVEL: The level of the headline, as an integer. This will be
+ the reduced level, so 1,2,3,... even if only odd levels
+ are being used.
+HEADLINE: The text of the headline. Depending on PARAMS, this may
+ already be formatted like a link.
+TIMESTAMP: If PARAMS require it, this will be a time stamp found in the
+ entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive,
+ in this sequence.
+TIME: The sum of all time spend in this tree, in minutes. This time
+ will of cause be restricted to the time block and tags match
+ specified in PARAMS.
+PROPERTIES: The list properties specified in the `:properties' parameter
+ along with their value, as an alist following the pattern
+ (NAME . VALUE)."
(let* ((maxlevel (or (plist-get params :maxlevel) 3))
(timestamp (plist-get params :timestamp))
(ts (plist-get params :tstart))
@@ -2659,14 +2795,14 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(tags (plist-get params :tags))
(properties (plist-get params :properties))
(inherit-property-p (plist-get params :inherit-props))
- todo-only
- (matcher (if tags (cdr (org-make-tags-matcher tags))))
- cc range-text st p time level hdl props tsp tbl)
+ (matcher (and tags (cdr (org-make-tags-matcher tags))))
+ cc st p tbl)
(setq org-clock-file-total-minutes nil)
(when block
(setq cc (org-clock-special-range block nil t ws ms)
- ts (car cc) te (nth 1 cc) range-text (nth 2 cc)))
+ ts (car cc)
+ te (nth 1 cc)))
(when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts)))
(when (integerp te) (setq te (calendar-gregorian-from-absolute te)))
(when (and ts (listp ts))
@@ -2678,12 +2814,12 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(if te (setq te (org-matcher-time te)))
(save-excursion
(org-clock-sum ts te
- (unless (null matcher)
- (lambda ()
- (let* ((tags-list (org-get-tags-at))
- (org-scanner-tags tags-list)
- (org-trust-scanner-tags t))
- (eval matcher)))))
+ (when matcher
+ `(lambda ()
+ (let* ((tags-list (org-get-tags-at))
+ (org-scanner-tags tags-list)
+ (org-trust-scanner-tags t))
+ (funcall ,matcher nil tags-list nil)))))
(goto-char (point-min))
(setq st t)
(while (or (and (bobp) (prog1 st (setq st nil))
@@ -2692,66 +2828,42 @@ TIME: The sum of all time spend in this tree, in minutes. This time
(setq p (next-single-property-change
(point) :org-clock-minutes)))
(goto-char p)
- (when (setq time (get-text-property p :org-clock-minutes))
- (save-excursion
- (beginning-of-line 1)
- (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
- (setq level (org-reduced-level
- (- (match-end 1) (match-beginning 1))))
- (<= level maxlevel))
- (setq hdl (if (not link)
- (match-string 2)
- (org-make-link-string
- (format "file:%s::%s"
- (buffer-file-name)
- (save-match-data
- (match-string 2)))
- (org-make-org-heading-search-string
- (replace-regexp-in-string
- org-bracket-link-regexp
- (lambda (m) (or (match-string 3 m)
- (match-string 1 m)))
- (match-string 2)))))
- tsp (when timestamp
- (setq props (org-entry-properties (point)))
- (or (cdr (assoc "SCHEDULED" props))
- (cdr (assoc "DEADLINE" props))
- (cdr (assoc "TIMESTAMP" props))
- (cdr (assoc "TIMESTAMP_IA" props))))
- props (when properties
- (remove nil
- (mapcar
- (lambda (p)
- (when (org-entry-get (point) p inherit-property-p)
- (cons p (org-entry-get (point) p inherit-property-p))))
- properties))))
- (when (> time 0) (push (list level hdl tsp time props) tbl))))))
- (setq tbl (nreverse tbl))
- (list file org-clock-file-total-minutes tbl))))
-
-(defun org-clock-time% (total &rest strings)
- "Compute a time fraction in percent.
-TOTAL s a time string like 10:21 specifying the total times.
-STRINGS is a list of strings that should be checked for a time.
-The first string that does have a time will be used.
-This function is made for clock tables."
- (let ((re "\\([0-9]+\\):\\([0-9]+\\)")
- tot s)
- (save-match-data
- (catch 'exit
- (if (not (string-match re total))
- (throw 'exit 0.)
- (setq tot (+ (string-to-number (match-string 2 total))
- (* 60 (string-to-number (match-string 1 total)))))
- (if (= tot 0.) (throw 'exit 0.)))
- (while (setq s (pop strings))
- (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (throw 'exit
- (/ (* 100.0 (+ (string-to-number (match-string 2 s))
- (* 60 (string-to-number
- (match-string 1 s)))))
- tot))))
- 0))))
+ (let ((time (get-text-property p :org-clock-minutes)))
+ (when (and time (> time 0) (org-at-heading-p))
+ (let ((level (org-reduced-level (org-current-level))))
+ (when (<= level maxlevel)
+ (let* ((headline (org-get-heading t t t t))
+ (hdl
+ (if (not link) headline
+ (let ((search
+ (org-make-org-heading-search-string headline)))
+ (org-make-link-string
+ (if (not (buffer-file-name)) search
+ (format "file:%s::%s" (buffer-file-name) search))
+ ;; Prune statistics cookies. Replace
+ ;; links with their description, or
+ ;; a plain link if there is none.
+ (org-trim
+ (org-link-display-format
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ headline)))))))
+ (tsp
+ (and timestamp
+ (cl-some (lambda (p) (org-entry-get (point) p))
+ '("SCHEDULED" "DEADLINE" "TIMESTAMP"
+ "TIMESTAMP_IA"))))
+ (props
+ (and properties
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (let ((v (org-entry-get
+ (point) p inherit-property-p)))
+ (and v (cons p v))))
+ properties)))))
+ (push (list level hdl tsp time props) tbl)))))))
+ (list file org-clock-file-total-minutes (nreverse tbl)))))
;; Saving and loading the clock
@@ -2789,9 +2901,9 @@ Otherwise, return nil."
(setq ts (match-string 1)
te (match-string 3))
(setq s (- (float-time
- (apply 'encode-time (org-parse-time-string te)))
+ (apply #'encode-time (org-parse-time-string te)))
(float-time
- (apply 'encode-time (org-parse-time-string ts))))
+ (apply #'encode-time (org-parse-time-string ts))))
neg (< s 0)
s (abs s)
h (floor (/ s 3600))
@@ -2809,86 +2921,67 @@ The details of what will be saved are regulated by the variable
(or org-clock-loaded
org-clock-has-been-used
(not (file-exists-p org-clock-persist-file))))
- (let (b)
- (with-current-buffer (find-file (expand-file-name org-clock-persist-file))
- (progn
- (delete-region (point-min) (point-max))
- ;;Store clock
- (insert (format ";; org-persist.el - %s at %s\n"
- (system-name) (format-time-string
- (cdr org-time-stamp-formats))))
- (if (and (memq org-clock-persist '(t clock))
- (setq b (org-clocking-buffer))
- (setq b (or (buffer-base-buffer b) b))
- (buffer-live-p b)
- (buffer-file-name b)
- (or (not org-clock-persist-query-save)
- (y-or-n-p (concat "Save current clock ("
- org-clock-heading ") "))))
- (insert "(setq resume-clock '(\""
- (buffer-file-name (org-clocking-buffer))
- "\" . " (int-to-string (marker-position org-clock-marker))
- "))\n"))
- ;; Store clocked task history. Tasks are stored reversed to make
- ;; reading simpler
- (when (and (memq org-clock-persist '(t history))
- org-clock-history)
- (insert
- "(setq stored-clock-history '("
- (mapconcat
- (lambda (m)
- (when (and (setq b (marker-buffer m))
- (setq b (or (buffer-base-buffer b) b))
- (buffer-live-p b)
- (buffer-file-name b))
- (concat "(\"" (buffer-file-name b)
- "\" . " (int-to-string (marker-position m))
- ")")))
- (reverse org-clock-history) " ") "))\n"))
- (save-buffer)
- (kill-buffer (current-buffer)))))))
+ (with-temp-file org-clock-persist-file
+ (insert (format ";; %s - %s at %s\n"
+ (file-name-nondirectory org-clock-persist-file)
+ (system-name)
+ (format-time-string (org-time-stamp-format t))))
+ ;; Store clock to be resumed.
+ (when (and (memq org-clock-persist '(t clock))
+ (let ((b (org-base-buffer (org-clocking-buffer))))
+ (and (buffer-live-p b)
+ (buffer-file-name b)
+ (or (not org-clock-persist-query-save)
+ (y-or-n-p (format "Save current clock (%s) "
+ org-clock-heading))))))
+ (insert
+ (format "(setq org-clock-stored-resume-clock '(%S . %d))\n"
+ (buffer-file-name (org-base-buffer (org-clocking-buffer)))
+ (marker-position org-clock-marker))))
+ ;; Store clocked task history. Tasks are stored reversed to
+ ;; make reading simpler.
+ (when (and (memq org-clock-persist '(t history))
+ org-clock-history)
+ (insert
+ (format "(setq org-clock-stored-history '(%s))\n"
+ (mapconcat
+ (lambda (m)
+ (let ((b (org-base-buffer (marker-buffer m))))
+ (when (and (buffer-live-p b)
+ (buffer-file-name b))
+ (format "(%S . %d)"
+ (buffer-file-name b)
+ (marker-position m)))))
+ (reverse org-clock-history)
+ " ")))))))
(defun org-clock-load ()
"Load clock-related data from disk, maybe resuming a stored clock."
(when (and org-clock-persist (not org-clock-loaded))
- (let ((filename (expand-file-name org-clock-persist-file))
- (org-clock-in-resume 'auto-restart)
- resume-clock stored-clock-history)
- (if (not (file-readable-p filename))
- (message "Not restoring clock data; %s not found"
- org-clock-persist-file)
- (message "%s" "Restoring clock data")
- (setq org-clock-loaded t)
- (load-file filename)
- ;; load history
- (when stored-clock-history
- (save-window-excursion
- (mapc (lambda (task)
- (if (file-exists-p (car task))
- (org-clock-history-push (cdr task)
- (find-file (car task)))))
- stored-clock-history)))
- ;; resume clock
- (when (and resume-clock org-clock-persist
- (file-exists-p (car resume-clock))
- (or (not org-clock-persist-query-resume)
- (y-or-n-p
- (concat
- "Resume clock ("
- (with-current-buffer (find-file (car resume-clock))
- (save-excursion
- (goto-char (cdr resume-clock))
- (org-back-to-heading t)
- (and (looking-at org-complex-heading-regexp)
- (match-string 4))))
- ") "))))
- (when (file-exists-p (car resume-clock))
- (with-current-buffer (find-file (car resume-clock))
- (goto-char (cdr resume-clock))
- (let ((org-clock-auto-clock-resolution nil))
- (org-clock-in)
- (if (outline-invisible-p)
- (org-show-context))))))))))
+ (if (not (file-readable-p org-clock-persist-file))
+ (message "Not restoring clock data; %S not found" org-clock-persist-file)
+ (message "Restoring clock data")
+ ;; Load history.
+ (load-file org-clock-persist-file)
+ (setq org-clock-loaded t)
+ (pcase-dolist (`(,(and file (pred file-exists-p)) . ,position)
+ org-clock-stored-history)
+ (org-clock-history-push position (find-file-noselect file)))
+ ;; Resume clock.
+ (pcase org-clock-stored-resume-clock
+ (`(,(and file (pred file-exists-p)) . ,position)
+ (with-current-buffer (find-file-noselect file)
+ (when (or (not org-clock-persist-query-resume)
+ (y-or-n-p (format "Resume clock (%s) "
+ (save-excursion
+ (goto-char position)
+ (org-get-heading t t)))))
+ (goto-char position)
+ (let ((org-clock-in-resume 'auto-restart)
+ (org-clock-auto-clock-resolution nil))
+ (org-clock-in)
+ (when (org-invisible-p) (org-show-context))))))
+ (_ nil)))))
;; Suggested bindings
(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate)
@@ -2897,6 +2990,7 @@ The details of what will be saved are regulated by the variable
;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
+;; coding: utf-8
;; End:
;;; org-clock.el ends here
diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el
index a2046af29ec..649ca52c4f8 100644
--- a/lisp/org/org-colview.el
+++ b/lisp/org/org-colview.el
@@ -1,4 +1,4 @@
-;;; org-colview.el --- Column View in Org-mode
+;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
@@ -28,42 +28,117 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'org)
(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-agenda-do-context-action "org-agenda" ())
(declare-function org-clock-sum-today "org-clock" (&optional headline-filter))
-
-(when (featurep 'xemacs)
- (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory"))
-
+(declare-function org-element-extract-element "org-element" (element))
+(declare-function org-element-interpret-data "org-element" (data))
+(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
+(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-restriction "org-element" (element))
+(declare-function org-element-type "org-element" (element))
+
+(defvar org-agenda-columns-add-appointments-to-effort-sum)
+(defvar org-agenda-columns-compute-summary-properties)
+(defvar org-agenda-columns-show-summaries)
+(defvar org-agenda-view-columns-initially)
+(defvar org-inlinetask-min-level)
+
+
+;;; Configuration
+
+(defcustom org-columns-modify-value-for-display-function nil
+ "Function that modifies values for display in column view.
+For example, it can be used to cut out a certain part from a time stamp.
+The function must take 2 arguments:
+
+column-title The title of the column (*not* the property name)
+value The value that should be modified.
+
+The function should return the value that should be displayed,
+or nil if the normal value should be used."
+ :group 'org-properties
+ :type '(choice (const nil) (function)))
+
+(defcustom org-columns-summary-types nil
+ "Alist between operators and summarize functions.
+
+Each association follows the pattern (LABEL . SUMMARIZE) where
+
+ LABEL is a string used in #+COLUMNS definition describing the
+ summary type. It can contain any character but \"}\". It is
+ case-sensitive.
+
+ SUMMARIZE is a function called with two arguments. The first
+ argument is a non-empty list of values, as non-empty strings.
+ The second one is a format string or nil. It has to return
+ a string summarizing the list of values.
+
+Note that the return value can become one value for an higher
+order summary, so the function is expected to handle its own
+output.
+
+Types defined in this variable take precedence over those defined
+in `org-columns-summary-types-default', which see."
+ :group 'org-properties
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type '(alist :key-type (string :tag " Label")
+ :value-type (function :tag "Summarize")))
+
+
+
;;; Column View
-(defvar org-columns-overlays nil
+(defvar-local org-columns-overlays nil
"Holds the list of current column overlays.")
-(defvar org-columns-current-fmt nil
+(defvar-local org-columns-current-fmt nil
"Local variable, holds the currently active column format.")
-(make-variable-buffer-local 'org-columns-current-fmt)
-(defvar org-columns-current-fmt-compiled nil
+
+(defvar-local org-columns-current-fmt-compiled nil
"Local variable, holds the currently active column format.
This is the compiled version of the format.")
-(make-variable-buffer-local 'org-columns-current-fmt-compiled)
-(defvar org-columns-current-widths nil
- "Loval variable, holds the currently widths of fields.")
-(make-variable-buffer-local 'org-columns-current-widths)
-(defvar org-columns-current-maxwidths nil
- "Loval variable, holds the currently active maximum column widths.")
-(make-variable-buffer-local 'org-columns-current-maxwidths)
-(defvar org-columns-begin-marker (make-marker)
+
+(defvar-local org-columns-current-maxwidths nil
+ "Currently active maximum column widths, as a vector.")
+
+(defvar-local org-columns-begin-marker nil
"Points to the position where last a column creation command was called.")
-(defvar org-columns-top-level-marker (make-marker)
+
+(defvar-local org-columns-top-level-marker nil
"Points to the position where current columns region starts.")
+(defvar org-columns--time 0.0
+ "Number of seconds since the epoch, as a floating point number.")
+
(defvar org-columns-map (make-sparse-keymap)
"The keymap valid in column display.")
+(defconst org-columns-summary-types-default
+ '(("+" . org-columns--summary-sum)
+ ("$" . org-columns--summary-currencies)
+ ("X" . org-columns--summary-checkbox)
+ ("X/" . org-columns--summary-checkbox-count)
+ ("X%" . org-columns--summary-checkbox-percent)
+ ("max" . org-columns--summary-max)
+ ("mean" . org-columns--summary-mean)
+ ("min" . org-columns--summary-min)
+ (":" . org-columns--summary-sum-times)
+ (":max" . org-columns--summary-max-time)
+ (":mean" . org-columns--summary-mean-time)
+ (":min" . org-columns--summary-min-time)
+ ("@max" . org-columns--summary-max-age)
+ ("@mean" . org-columns--summary-mean-age)
+ ("@min" . org-columns--summary-min-age)
+ ("est+" . org-columns--summary-estimate))
+ "Map operators to summarize functions.
+See `org-columns-summary-types' for details.")
+
(defun org-columns-content ()
"Switch to contents view while in columns view."
(interactive)
@@ -146,121 +221,181 @@ This is the compiled version of the format.")
"--"
["Quit" org-columns-quit t]))
-(defun org-columns-new-overlay (beg end &optional string face)
+(defun org-columns--displayed-value (spec value)
+ "Return displayed value for specification SPEC in current entry.
+SPEC is a column format specification as stored in
+`org-columns-current-fmt-compiled'. VALUE is the real value to
+display, as a string."
+ (or (and (functionp org-columns-modify-value-for-display-function)
+ (funcall org-columns-modify-value-for-display-function
+ (nth 1 spec) ;column name
+ value))
+ (pcase spec
+ (`("ITEM" . ,_)
+ (concat (make-string (1- (org-current-level))
+ (if org-hide-leading-stars ?\s ?*))
+ "* "
+ (org-columns-compact-links value)))
+ (`(,_ ,_ ,_ ,_ nil) value)
+ ;; If PRINTF is set, assume we are displaying a number and
+ ;; obey to the format string.
+ (`(,_ ,_ ,_ ,_ ,printf) (format printf (string-to-number value)))
+ (_ (error "Invalid column specification format: %S" spec)))))
+
+(defun org-columns--collect-values (&optional compiled-fmt)
+ "Collect values for columns on the current line.
+
+Return a list of triplets (SPEC VALUE DISPLAYED) suitable for
+`org-columns--display-here'.
+
+This function assumes `org-columns-current-fmt-compiled' is
+initialized is set in the current buffer. However, it is
+possible to override it with optional argument COMPILED-FMT."
+ (let ((summaries (get-text-property (point) 'org-summaries)))
+ (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`(,p . ,_)
+ (let* ((v (or (cdr (assoc spec summaries))
+ (org-entry-get (point) p 'selective t)
+ (and compiled-fmt ;assume `org-agenda-columns'
+ ;; Effort property is not defined. Try
+ ;; to use appointment duration.
+ org-agenda-columns-add-appointments-to-effort-sum
+ (string= p (upcase org-effort-property))
+ (get-text-property (point) 'duration)
+ (propertize (org-duration-from-minutes
+ (get-text-property (point) 'duration))
+ 'face 'org-warning))
+ "")))
+ (list spec v (org-columns--displayed-value spec v))))))
+ (or compiled-fmt org-columns-current-fmt-compiled))))
+
+(defun org-columns--set-widths (cache)
+ "Compute the maximum column widths from the format and CACHE.
+This function sets `org-columns-current-maxwidths' as a vector of
+integers greater than 0."
+ (setq org-columns-current-maxwidths
+ (apply #'vector
+ (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width)
+ (`(,_ ,name . ,_)
+ ;; No width is specified in the columns format.
+ ;; Compute it by checking all possible values for
+ ;; PROPERTY.
+ (let ((width (length name)))
+ (dolist (entry cache width)
+ (let ((value (nth 2 (assoc spec (cdr entry)))))
+ (setq width (max (length value) width))))))))
+ org-columns-current-fmt-compiled))))
+
+(defun org-columns--new-overlay (beg end &optional string face)
"Create a new column overlay and add it to the list."
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face (or face 'secondary-selection))
- (remove-text-properties 0 (length string) '(face nil) string)
(org-overlay-display ov string face)
(push ov org-columns-overlays)
ov))
-(defun org-columns-display-here (&optional props dateline)
- "Overlay the current line with column display."
- (interactive)
- (let* ((fmt org-columns-current-fmt-compiled)
- (beg (point-at-bol))
- (level-face (save-excursion
- (beginning-of-line 1)
- (and (looking-at "\\(\\**\\)\\(\\* \\)")
- (org-get-level-face 2))))
- (ref-face (or level-face
- (and (eq major-mode 'org-agenda-mode)
- (get-text-property (point-at-bol) 'face))
- 'default))
- (color (list :foreground (face-attribute ref-face :foreground)))
- (font (list :height (face-attribute 'default :height)
- :family (face-attribute 'default :family)))
- (face (list color font 'org-column ref-face))
- (face1 (list color font 'org-agenda-column-dateline ref-face))
- (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
- pom property ass width f fc string fm ov column val modval s2 title calc)
- ;; Check if the entry is in another buffer.
- (unless props
- (if (eq major-mode 'org-agenda-mode)
- (setq pom (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))
- props (if pom (org-entry-properties pom) nil))
- (setq props (org-entry-properties nil))))
- ;; Walk the format
- (while (setq column (pop fmt))
- (setq property (car column)
- title (nth 1 column)
- ass (if (equal property "ITEM")
- (cons "ITEM"
- ;; When in a buffer, get the whole line,
- ;; we'll clean it later…
- (if (derived-mode-p 'org-mode)
- (save-match-data
- (org-remove-tabs
- (buffer-substring-no-properties
- (point-at-bol) (point-at-eol))))
- ;; In agenda, just get the `txt' property
- (or (org-get-at-bol 'txt)
- (buffer-substring-no-properties
- (point) (progn (end-of-line) (point))))))
- (assoc property props))
- width (or (cdr (assoc property org-columns-current-maxwidths))
- (nth 2 column)
- (length property))
- f (format "%%-%d.%ds | " width width)
- fm (nth 4 column)
- fc (nth 5 column)
- calc (nth 7 column)
- val (or (cdr ass) "")
- modval (cond ((and org-columns-modify-value-for-display-function
- (functionp
- org-columns-modify-value-for-display-function))
- (funcall org-columns-modify-value-for-display-function
- title val))
- ((equal property "ITEM")
- (org-columns-cleanup-item
- val org-columns-current-fmt-compiled
- (or org-complex-heading-regexp cphr)))
- (fc (org-columns-number-to-string
- (org-columns-string-to-number val fm) fm fc))
- ((and calc (functionp calc)
- (not (string= val ""))
- (not (get-text-property 0 'org-computed val)))
- (org-columns-number-to-string
- (funcall calc (org-columns-string-to-number
- val fm)) fm))))
- (setq s2 (org-columns-add-ellipses (or modval val) width))
- (setq string (format f s2))
- ;; Create the overlay
+(defun org-columns--summarize (operator)
+ "Return summary function associated to string OPERATOR."
+ (if (not operator) nil
+ (cdr (or (assoc operator org-columns-summary-types)
+ (assoc operator org-columns-summary-types-default)
+ (error "Unknown %S operator" operator)))))
+
+(defun org-columns--overlay-text (value fmt width property original)
+ "Return text "
+ (format fmt
+ (let ((v (org-columns-add-ellipses value width)))
+ (pcase property
+ ("PRIORITY"
+ (propertize v 'face (org-get-priority-face original)))
+ ("TAGS"
+ (if (not org-tags-special-faces-re)
+ (propertize v 'face 'org-tag)
+ (replace-regexp-in-string
+ org-tags-special-faces-re
+ (lambda (m) (propertize m 'face (org-get-tag-face m)))
+ v nil nil 1)))
+ ("TODO" (propertize v 'face (org-get-todo-face original)))
+ (_ v)))))
+
+(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'."
+ (save-excursion
+ (beginning-of-line)
+ (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)")
+ (org-get-level-face 2)))
+ (ref-face (or level-face
+ (and (eq major-mode 'org-agenda-mode)
+ (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)))
+ (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
+ ;; to be at least as many characters available on the line as
+ ;; columns to display.
+ (let ((columns (length org-columns-current-fmt-compiled))
+ (chars (- (line-end-position) (line-beginning-position))))
+ (when (> columns chars)
+ (save-excursion
+ (end-of-line)
+ (let ((inhibit-read-only t))
+ (insert (make-string (- columns chars) ?\s))))))
+ ;; Display columns. Create and install the overlay for the
+ ;; current column on the next character.
+ (let ((i 0)
+ (last (1- (length columns))))
+ (dolist (column columns)
+ (pcase column
+ (`(,spec ,original ,value)
+ (let* ((property (car spec))
+ (width (aref org-columns-current-maxwidths i))
+ (fmt (format (if (= i last) "%%-%d.%ds |"
+ "%%-%d.%ds | ")
+ width width))
+ (ov (org-columns--new-overlay
+ (point) (1+ (point))
+ (org-columns--overlay-text
+ value fmt width property original)
+ (if dateline face1 face))))
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'org-columns-key property)
+ (overlay-put ov 'org-columns-value original)
+ (overlay-put ov 'org-columns-value-modified value)
+ (overlay-put ov 'org-columns-format fmt)
+ (overlay-put ov 'line-prefix "")
+ (overlay-put ov 'wrap-prefix "")
+ (forward-char))))
+ (cl-incf i)))
+ ;; Make the rest of the line disappear.
+ (let ((ov (org-columns--new-overlay (point) (line-end-position))))
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'keymap org-columns-map)
+ (overlay-put ov 'line-prefix "")
+ (overlay-put ov 'wrap-prefix ""))
+ (let ((ov (make-overlay (1- (line-end-position))
+ (line-beginning-position 2))))
+ (overlay-put ov 'keymap org-columns-map)
+ (push ov org-columns-overlays))
(org-with-silent-modifications
- (setq ov (org-columns-new-overlay
- beg (setq beg (1+ beg)) string (if dateline face1 face)))
- (overlay-put ov 'keymap org-columns-map)
- (overlay-put ov 'org-columns-key property)
- (overlay-put ov 'org-columns-value (cdr ass))
- (overlay-put ov 'org-columns-value-modified modval)
- (overlay-put ov 'org-columns-pom pom)
- (overlay-put ov 'org-columns-format f)
- (overlay-put ov 'line-prefix "")
- (overlay-put ov 'wrap-prefix ""))
- (if (or (not (char-after beg))
- (equal (char-after beg) ?\n))
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char beg)
- (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later?
- ;; Make the rest of the line disappear.
- (org-unmodified
- (setq ov (org-columns-new-overlay beg (point-at-eol)))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'keymap org-columns-map)
- (overlay-put ov 'intangible t)
- (overlay-put ov 'line-prefix "")
- (overlay-put ov 'wrap-prefix "")
- (push ov org-columns-overlays)
- (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol))))
- (overlay-put ov 'keymap org-columns-map)
- (push ov org-columns-overlays)
- (let ((inhibit-read-only t))
- (put-text-property (max (point-min) (1- (point-at-bol)))
- (min (point-max) (1+ (point-at-eol)))
- 'read-only "Type `e' to edit property")))))
+ (let ((inhibit-read-only t))
+ (put-text-property
+ (line-end-position 0)
+ (line-beginning-position 2)
+ 'read-only
+ (substitute-command-keys
+ "Type \\<org-columns-map>`\\[org-columns-edit-value]' \
+to edit property")))))))
(defun org-columns-add-ellipses (string width)
"Truncate STRING with WIDTH characters, with ellipses."
@@ -285,34 +420,27 @@ for the duration of the command.")
(defvar header-line-format)
(defvar org-columns-previous-hscroll 0)
-(defun org-columns-display-here-title ()
+(defun org-columns--display-here-title ()
"Overlay the newline before the current line with the table title."
(interactive)
- (let ((fmt org-columns-current-fmt-compiled)
- string (title "")
- property width f column str widths)
- (while (setq column (pop fmt))
- (setq property (car column)
- str (or (nth 1 column) property)
- width (or (cdr (assoc property org-columns-current-maxwidths))
- (nth 2 column)
- (length str))
- widths (push width widths)
- f (format "%%-%d.%ds | " width width)
- string (format f str)
- title (concat title string)))
- (setq title (concat
- (org-add-props " " nil 'display '(space :align-to 0))
- ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default))))
- (org-add-props title nil 'face 'org-column-title)))
- (org-set-local 'org-previous-header-line-format header-line-format)
- (org-set-local 'org-columns-current-widths (nreverse widths))
- (setq org-columns-full-header-line-format title)
+ (let ((title "")
+ (i 0))
+ (dolist (column org-columns-current-fmt-compiled)
+ (pcase column
+ (`(,property ,name . ,_)
+ (let* ((width (aref org-columns-current-maxwidths i))
+ (fmt (format "%%-%d.%ds | " width width)))
+ (setq title (concat title (format fmt (or name property)))))))
+ (cl-incf i))
+ (setq-local org-previous-header-line-format header-line-format)
+ (setq org-columns-full-header-line-format
+ (concat
+ (org-add-props " " nil 'display '(space :align-to 0))
+ (org-add-props (substring title 0 -1) nil 'face 'org-column-title)))
(setq org-columns-previous-hscroll -1)
- ; (org-columns-hscoll-title)
- (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local)))
+ (add-hook 'post-command-hook 'org-columns-hscroll-title nil 'local)))
-(defun org-columns-hscoll-title ()
+(defun org-columns-hscroll-title ()
"Set the `header-line-format' so that it scrolls along with the table."
(sit-for .0001) ; need to force a redisplay to update window-hscroll
(when (not (= (window-hscroll) org-columns-previous-hscroll))
@@ -330,46 +458,23 @@ for the duration of the command.")
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
- (when (marker-buffer org-columns-begin-marker)
- (with-current-buffer (marker-buffer org-columns-begin-marker)
- (when (local-variable-p 'org-previous-header-line-format)
- (setq header-line-format org-previous-header-line-format)
- (kill-local-variable 'org-previous-header-line-format)
- (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local))
- (move-marker org-columns-begin-marker nil)
- (move-marker org-columns-top-level-marker nil)
- (org-with-silent-modifications
- (mapc 'delete-overlay org-columns-overlays)
- (setq org-columns-overlays nil)
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max) '(read-only t))))
- (when org-columns-flyspell-was-active
- (flyspell-mode 1))
- (when (local-variable-p 'org-colview-initial-truncate-line-value)
- (setq truncate-lines org-colview-initial-truncate-line-value)))))
-
-(defun org-columns-cleanup-item (item fmt cphr)
- "Remove from ITEM what is a column in the format FMT.
-CPHR is the complex heading regexp to use for parsing ITEM."
- (let (fixitem)
- (if (not cphr)
- item
- (unless (string-match "^\\*+ " item)
- (setq item (concat "* " item) fixitem t))
- (if (string-match cphr item)
- (setq item
- (concat
- (org-add-props (match-string 1 item) nil
- 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item)))
- (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item)))
- " " (save-match-data (org-columns-compact-links (or (match-string 4 item) "")))
- (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item)))))
- (add-text-properties
- 0 (1+ (match-end 1))
- (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1))))))
- item))
- (if fixitem (replace-regexp-in-string "^\\*+ " "" item) item))))
+ (when org-columns-overlays
+ (when (local-variable-p 'org-previous-header-line-format)
+ (setq header-line-format org-previous-header-line-format)
+ (kill-local-variable 'org-previous-header-line-format)
+ (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local))
+ (set-marker org-columns-begin-marker nil)
+ (when (markerp org-columns-top-level-marker)
+ (set-marker org-columns-top-level-marker nil))
+ (org-with-silent-modifications
+ (mapc #'delete-overlay org-columns-overlays)
+ (setq org-columns-overlays nil)
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(read-only t))))
+ (when org-columns-flyspell-was-active
+ (flyspell-mode 1))
+ (when (local-variable-p 'org-colview-initial-truncate-line-value)
+ (setq truncate-lines org-colview-initial-truncate-line-value))))
(defun org-columns-compact-links (s)
"Replace [[link][desc]] with [desc] or [link]."
@@ -394,25 +499,26 @@ CPHR is the complex heading regexp to use for parsing ITEM."
(org-columns-remove-overlays)
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(read-only t))))
- (when (eq major-mode 'org-agenda-mode)
+ (if (not (eq major-mode 'org-agenda-mode))
+ (setq org-columns-current-fmt nil)
(setq org-agenda-columns-active nil)
(message
"Modification not yet reflected in Agenda buffer, use `r' to refresh")))
(defun org-columns-check-computed ()
- "Check if this column value is computed.
-If yes, throw an error indicating that changing it does not make sense."
- (let ((val (get-char-property (point) 'org-columns-value)))
- (when (and (stringp val)
- (get-char-property 0 'org-computed val))
- (error "This value is computed from the entry's children"))))
-
-(defun org-columns-todo (&optional arg)
+ "Throw an error if current column value is computed."
+ (let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
+ (and
+ (nth 3 spec)
+ (assoc spec (get-text-property (line-beginning-position) 'org-summaries))
+ (error "This value is computed from the entry's children"))))
+
+(defun org-columns-todo (&optional _arg)
"Change the TODO state during column view."
(interactive "P")
(org-columns-edit-value "TODO"))
-(defun org-columns-set-tags-or-toggle (&optional arg)
+(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-]\\]\\'"
@@ -430,107 +536,76 @@ Where possible, use the standard interface for changing this line."
(interactive)
(org-columns-check-computed)
(let* ((col (current-column))
+ (bol (line-beginning-position))
+ (eol (line-end-position))
+ (pom (or (get-text-property bol 'org-hd-marker) (point)))
(key (or key (get-char-property (point) 'org-columns-key)))
- (value (get-char-property (point) 'org-columns-value))
- (bol (point-at-bol)) (eol (point-at-eol))
- (pom (or (get-text-property bol 'org-hd-marker)
- (point))) ; keep despite of compiler waring
- (line-overlays
- (delq nil (mapcar (lambda (x)
- (and (eq (overlay-buffer x) (current-buffer))
- (>= (overlay-start x) bol)
- (<= (overlay-start x) eol)
- x))
- org-columns-overlays)))
- (org-columns-time (time-to-number-of-days (current-time)))
- nval eval allowed)
+ (org-columns--time (float-time (current-time)))
+ (action
+ (pcase key
+ ("CLOCKSUM"
+ (error "This special column cannot be edited"))
+ ("ITEM"
+ (lambda () (org-with-point-at pom (org-edit-headline))))
+ ("TODO"
+ (lambda ()
+ (org-with-point-at pom (call-interactively #'org-todo))))
+ ("PRIORITY"
+ (lambda ()
+ (org-with-point-at pom
+ (call-interactively #'org-priority))))
+ ("TAGS"
+ (lambda ()
+ (org-with-point-at pom
+ (let ((org-fast-tag-selection-single-key
+ (if (eq org-fast-tag-selection-single-key 'expert)
+ t
+ org-fast-tag-selection-single-key)))
+ (call-interactively #'org-set-tags)))))
+ ("DEADLINE"
+ (lambda ()
+ (org-with-point-at pom (call-interactively #'org-deadline))))
+ ("SCHEDULED"
+ (lambda ()
+ (org-with-point-at pom (call-interactively #'org-schedule))))
+ ("BEAMER_ENV"
+ (lambda ()
+ (org-with-point-at pom
+ (call-interactively #'org-beamer-select-environment))))
+ (_
+ (let* ((allowed (org-property-get-allowed-values pom key 'table))
+ (value (get-char-property (point) 'org-columns-value))
+ (nval (org-trim
+ (if (null allowed) (read-string "Edit: " value)
+ (completing-read
+ "Value: " allowed nil
+ (not (get-text-property
+ 0 'org-unrestricted (caar allowed))))))))
+ (and (not (equal nval value))
+ (lambda () (org-entry-put pom key nval))))))))
(cond
- ((equal key "CLOCKSUM")
- (error "This special column cannot be edited"))
- ((equal key "ITEM")
- (setq eval '(org-with-point-at pom
- (org-edit-headline))))
- ((equal key "TODO")
- (setq eval '(org-with-point-at
- pom
- (call-interactively 'org-todo))))
- ((equal key "PRIORITY")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-priority))))
- ((equal key "TAGS")
- (setq eval '(org-with-point-at pom
- (let ((org-fast-tag-selection-single-key
- (if (eq org-fast-tag-selection-single-key 'expert)
- t org-fast-tag-selection-single-key)))
- (call-interactively 'org-set-tags)))))
- ((equal key "DEADLINE")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-deadline))))
- ((equal key "SCHEDULED")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-schedule))))
- ((equal key "BEAMER_env")
- (setq eval '(org-with-point-at pom
- (call-interactively 'org-beamer-select-environment))))
+ ((null action))
+ ((eq major-mode 'org-agenda-mode)
+ (org-columns--call action)
+ ;; The following let preserves the current format, and makes
+ ;; sure that in only a single file things need to be updated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
(t
- (setq allowed (org-property-get-allowed-values pom key 'table))
- (if allowed
- (setq nval (org-icompleting-read
- "Value: " allowed nil
- (not (get-text-property 0 'org-unrestricted
- (caar allowed)))))
- (setq nval (read-string "Edit: " value)))
- (setq nval (org-trim nval))
- (when (not (equal nval value))
- (setq eval '(org-entry-put pom key nval)))))
- (when eval
-
- (cond
- ((equal major-mode 'org-agenda-mode)
- (org-columns-eval eval)
- ;; The following let preserves the current format, and makes sure
- ;; that in only a single file things need to be updated.
- (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
- (buffer (marker-buffer pom))
- (org-agenda-contributing-files
- (list (with-current-buffer buffer
- (buffer-file-name (buffer-base-buffer))))))
- (org-agenda-columns)))
- (t
- (let ((inhibit-read-only t))
- (org-with-silent-modifications
- (remove-text-properties
- (max (point-min) (1- bol)) eol '(read-only t)))
- (unwind-protect
- (progn
- (setq org-columns-overlays
- (org-delete-all line-overlays org-columns-overlays))
- (mapc 'delete-overlay line-overlays)
- (org-columns-eval eval))
- (org-columns-display-here)))
- (org-move-to-column col)
- (if (and (derived-mode-p 'org-mode)
- (nth 3 (assoc key org-columns-current-fmt-compiled)))
- (org-columns-update key)))))))
-
-(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda????
- "Edit the current headline, the part without TODO keyword, TAGS."
- (org-back-to-heading)
- (when (looking-at org-todo-line-regexp)
- (let ((pos (point))
- (pre (buffer-substring (match-beginning 0) (match-beginning 3)))
- (txt (match-string 3))
- (post "")
- txt2)
- (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt)
- (setq post (match-string 0 txt)
- txt (substring txt 0 (match-beginning 0))))
- (setq txt2 (read-string "Edit: " txt))
- (when (not (equal txt txt2))
- (goto-char pos)
- (insert pre txt2 post)
- (delete-region (point) (point-at-eol))
- (org-set-tags nil t)))))
+ (let ((inhibit-read-only t))
+ (org-with-silent-modifications
+ (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t)))
+ (org-columns--call action))
+ ;; Some properties can modify headline (e.g., "TODO"), and
+ ;; possible shuffle overlays. Make sure they are still all at
+ ;; the right place on the current line.
+ (let ((org-columns-inhibit-recalculation)) (org-columns-redo))
+ (org-columns-update key)
+ (org-move-to-column col)))))
(defun org-columns-edit-allowed ()
"Edit the list of allowed values for the current property."
@@ -538,30 +613,30 @@ Where possible, use the standard interface for changing this line."
(let* ((pom (or (org-get-at-bol 'org-marker)
(org-get-at-bol 'org-hd-marker)
(point)))
- (key (get-char-property (point) 'org-columns-key))
- (key1 (concat key "_ALL"))
- (allowed (org-entry-get pom key1 t))
- nval)
+ (key (concat (or (get-char-property (point) 'org-columns-key)
+ (user-error "No column to edit at point"))
+ "_ALL"))
+ (allowed (org-entry-get pom key t))
+ (new-value (read-string "Allowed: " allowed)))
;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.????
;; FIXME: Write back to #+PROPERTY setting if that is needed.
- (setq nval (read-string "Allowed: " allowed))
(org-entry-put
(cond ((marker-position org-entry-property-inherited-from)
org-entry-property-inherited-from)
((marker-position org-columns-top-level-marker)
org-columns-top-level-marker)
(t pom))
- key1 nval)))
-
-(defun org-columns-eval (form)
- (let (hidep)
- (save-excursion
- (beginning-of-line 1)
- ;; `next-line' is needed here, because it skips invisible line.
- (condition-case nil (org-no-warnings (next-line 1)) (error nil))
- (setq hidep (org-at-heading-p 1)))
- (eval form)
- (and hidep (hide-entry))))
+ key new-value)))
+
+(defun org-columns--call (fun)
+ "Call function FUN while preserving heading visibility.
+FUN is a function called with no argument."
+ (let ((hide-body (and (/= (line-end-position) (point-max))
+ (save-excursion
+ (move-beginning-of-line 2)
+ (org-at-heading-p t)))))
+ (unwind-protect (funcall fun)
+ (when hide-body (outline-hide-entry)))))
(defun org-columns-previous-allowed-value ()
"Switch to the previous allowed value for this column."
@@ -574,72 +649,57 @@ When PREVIOUS is set, go to the previous value. When NTH is
an integer, select that value."
(interactive)
(org-columns-check-computed)
- (let* ((col (current-column))
+ (let* ((column (current-column))
(key (get-char-property (point) 'org-columns-key))
(value (get-char-property (point) 'org-columns-value))
- (bol (point-at-bol)) (eol (point-at-eol))
- (pom (or (get-text-property bol 'org-hd-marker)
- (point))) ; keep despite of compiler waring
- (line-overlays
- (delq nil (mapcar (lambda (x)
- (and (eq (overlay-buffer x) (current-buffer))
- (>= (overlay-start x) bol)
- (<= (overlay-start x) eol)
- x))
- org-columns-overlays)))
- (allowed (or (org-property-get-allowed-values pom key)
- (and (memq
- (nth 4 (assoc key org-columns-current-fmt-compiled))
- '(checkbox checkbox-n-of-m checkbox-percent))
- '("[ ]" "[X]"))
- (org-colview-construct-allowed-dates value)))
- nval)
- (when (integerp nth)
- (setq nth (1- nth))
- (if (= nth -1) (setq nth 9)))
- (when (equal key "ITEM")
- (error "Cannot edit item headline from here"))
+ (pom (or (get-text-property (line-beginning-position) 'org-hd-marker)
+ (point)))
+ (allowed
+ (let ((all
+ (or (org-property-get-allowed-values pom key)
+ (pcase (nth column org-columns-current-fmt-compiled)
+ (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]")))
+ (org-colview-construct-allowed-dates value))))
+ (if previous (reverse all) all))))
+ (when (equal key "ITEM") (error "Cannot edit item headline from here"))
(unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")))
(error "Allowed values for this property have not been defined"))
- (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
- (setq nval (if previous 'earlier 'later))
- (if previous (setq allowed (reverse allowed)))
+ (let* ((l (length allowed))
+ (new
+ (cond
+ ((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))
+ (if previous 'earlier 'later))
+ ((integerp nth)
+ (when (> (abs nth) l)
+ (user-error "Only %d allowed values for property `%s'" l key))
+ (nth (mod (1- nth) l) allowed))
+ ((member value allowed)
+ (when (= l 1) (error "Only one allowed value for this property"))
+ (or (nth 1 (member value allowed)) (car allowed)))
+ (t (car allowed))))
+ (action (lambda () (org-entry-put pom key new))))
(cond
- (nth
- (setq nval (nth nth allowed))
- (if (not nval)
- (error "There are only %d allowed values for property `%s'"
- (length allowed) key)))
- ((member value allowed)
- (setq nval (or (car (cdr (member value allowed)))
- (car allowed)))
- (if (equal nval value)
- (error "Only one allowed value for this property")))
- (t (setq nval (car allowed)))))
- (cond
- ((equal major-mode 'org-agenda-mode)
- (org-columns-eval '(org-entry-put pom key nval))
- ;; The following let preserves the current format, and makes sure
- ;; that in only a single file things need to be updated.
- (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
- (buffer (marker-buffer pom))
- (org-agenda-contributing-files
- (list (with-current-buffer buffer
- (buffer-file-name (buffer-base-buffer))))))
- (org-agenda-columns)))
- (t
- (let ((inhibit-read-only t))
- (remove-text-properties (1- bol) eol '(read-only t))
- (unwind-protect
- (progn
- (setq org-columns-overlays
- (org-delete-all line-overlays org-columns-overlays))
- (mapc 'delete-overlay line-overlays)
- (org-columns-eval '(org-entry-put pom key nval)))
- (org-columns-display-here)))
- (org-move-to-column col)
- (and (nth 3 (assoc key org-columns-current-fmt-compiled))
- (org-columns-update key))))))
+ ((eq major-mode 'org-agenda-mode)
+ (org-columns--call action)
+ ;; The following let preserves the current format, and makes
+ ;; sure that in only a single file things need to be updated.
+ (let* ((org-agenda-overriding-columns-format org-columns-current-fmt)
+ (buffer (marker-buffer pom))
+ (org-agenda-contributing-files
+ (list (with-current-buffer buffer
+ (buffer-file-name (buffer-base-buffer))))))
+ (org-agenda-columns)))
+ (t
+ (let ((inhibit-read-only t))
+ (remove-text-properties (line-end-position 0) (line-end-position)
+ '(read-only t))
+ (org-columns--call action))
+ ;; Some properties can modify headline (e.g., "TODO"), and
+ ;; possible shuffle overlays. Make sure they are still all at
+ ;; the right place on the current line.
+ (let ((org-columns-inhibit-recalculation)) (org-columns-redo))
+ (org-columns-update key)
+ (org-move-to-column column))))))
(defun org-colview-construct-allowed-dates (s)
"Construct a list of three dates around the date in S.
@@ -662,13 +722,6 @@ around it."
(mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x)))
(list time-before time time-after)))))
-(defun org-verify-version (task)
- (cond
- ((eq task 'columns)
- (if (or (featurep 'xemacs)
- (< emacs-major-version 22))
- (error "Emacs 22 is required for the columns feature")))))
-
(defun org-columns-open-link (&optional arg)
(interactive "P")
(let ((value (get-char-property (point) 'org-columns-value)))
@@ -681,179 +734,169 @@ around it."
fmt))
(defun org-columns-get-format (&optional fmt-string)
+ "Return columns format specifications.
+When optional argument FMT-STRING is non-nil, use it as the
+current specifications. This function also sets
+`org-columns-current-fmt-compiled' and
+`org-columns-current-fmt'."
(interactive)
- (let (fmt-as-property fmt)
- (when (condition-case nil (org-back-to-heading) (error nil))
- (setq fmt-as-property (org-entry-get nil "COLUMNS" t)))
- (setq fmt (or fmt-string fmt-as-property org-columns-default-format))
- (org-set-local 'org-columns-current-fmt fmt)
- (org-columns-compile-format fmt)
- fmt))
+ (let ((format
+ (or fmt-string
+ (org-entry-get nil "COLUMNS" t)
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (catch :found
+ (let ((case-fold-search t))
+ (while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw :found (org-element-property :value element)))))
+ nil)))
+ org-columns-default-format)))
+ (setq org-columns-current-fmt format)
+ (org-columns-compile-format format)
+ format))
(defun org-columns-goto-top-level ()
- (when (condition-case nil (org-back-to-heading) (error nil))
- (org-entry-get nil "COLUMNS" t))
- (if (marker-position org-entry-property-inherited-from)
- (move-marker org-columns-top-level-marker org-entry-property-inherited-from)
- (move-marker org-columns-top-level-marker (point))))
+ "Move to the beginning of the column view area.
+Also sets `org-columns-top-level-marker' to the new position."
+ (unless (markerp org-columns-top-level-marker)
+ (setq org-columns-top-level-marker (make-marker)))
+ (goto-char
+ (move-marker
+ org-columns-top-level-marker
+ (cond ((org-before-first-heading-p) (point-min))
+ ((org-entry-get nil "COLUMNS" t) org-entry-property-inherited-from)
+ (t (org-back-to-heading) (point))))))
;;;###autoload
-(defun org-columns (&optional columns-fmt-string)
- "Turn on column view on an org-mode file.
+(defun org-columns (&optional global columns-fmt-string)
+ "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."
- (interactive)
- (org-verify-version 'columns)
+ (interactive "P")
(org-columns-remove-overlays)
- (move-marker org-columns-begin-marker (point))
- (let ((org-columns-time (time-to-number-of-days (current-time)))
- beg end fmt cache maxwidths)
- (org-columns-goto-top-level)
- (setq fmt (org-columns-get-format columns-fmt-string))
+ (when global (goto-char (point-min)))
+ (if (markerp org-columns-begin-marker)
+ (move-marker org-columns-begin-marker (point))
+ (setq org-columns-begin-marker (point-marker)))
+ (org-columns-goto-top-level)
+ ;; Initialize `org-columns-current-fmt' and
+ ;; `org-columns-current-fmt-compiled'.
+ (let ((org-columns--time (float-time (current-time))))
+ (org-columns-get-format columns-fmt-string)
+ (unless org-columns-inhibit-recalculation (org-columns-compute-all))
(save-excursion
- (goto-char org-columns-top-level-marker)
- (setq beg (point))
- (unless org-columns-inhibit-recalculation
- (org-columns-compute-all))
- (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil))
- (point-max)))
- ;; Get and cache the properties
- (goto-char beg)
- (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (org-clock-sum))))
- (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (org-clock-sum-today))))
- (while (re-search-forward org-outline-regexp-bol end t)
- (if (and org-columns-skip-archived-trees
- (looking-at (concat ".*:" org-archive-tag ":")))
- (org-end-of-subtree t)
- (push (cons (org-current-line) (org-entry-properties)) cache)))
- (when cache
- (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
- (org-set-local 'org-columns-current-maxwidths maxwidths)
- (org-columns-display-here-title)
- (when (org-set-local 'org-columns-flyspell-was-active
- (org-bound-and-true-p flyspell-mode))
- (flyspell-mode 0))
- (unless (local-variable-p 'org-colview-initial-truncate-line-value)
- (org-set-local 'org-colview-initial-truncate-line-value
- truncate-lines))
- (setq truncate-lines t)
- (mapc (lambda (x)
- (org-goto-line (car x))
- (org-columns-display-here (cdr x)))
- cache)))))
-
-(eval-when-compile (defvar org-columns-time))
-
-(defvar org-columns-compile-map
- '(("none" none +)
- (":" add_times +)
- ("+" add_numbers +)
- ("$" currency +)
- ("X" checkbox +)
- ("X/" checkbox-n-of-m +)
- ("X%" checkbox-percent +)
- ("max" max_numbers max)
- ("min" min_numbers min)
- ("mean" mean_numbers
- (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
- (":max" max_times max)
- (":min" min_times min)
- (":mean" mean_times
- (lambda (&rest x) (/ (apply '+ x) (float (length x)))))
- ("@min" min_age min (lambda (x) (- org-columns-time x)))
- ("@max" max_age max (lambda (x) (- org-columns-time x)))
- ("@mean" mean_age
- (lambda (&rest x) (/ (apply '+ x) (float (length x))))
- (lambda (x) (- org-columns-time x)))
- ("est+" estimate org-estimate-combine))
- "Operator <-> format,function,calc map.
-Used to compile/uncompile columns format and completing read in
-interactive function `org-columns-new'.
-
-operator string used in #+COLUMNS definition describing the
- summary type
-format symbol describing summary type selected interactively in
- `org-columns-new' and internally in
- `org-columns-number-to-string' and
- `org-columns-string-to-number'
-function called with a list of values as argument to calculate
- the summary value
-calc function called on every element before summarizing. This is
- optional and should only be specified if needed")
-
-(defun org-columns-new (&optional prop title width op fmt fun &rest rest)
- "Insert a new column, to the left of the current column."
+ (save-restriction
+ (when (and (not global) (org-at-heading-p))
+ (narrow-to-region (point) (org-end-of-subtree t t)))
+ (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled)
+ (org-clock-sum))
+ (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled)
+ (org-clock-sum-today))
+ (let ((cache
+ ;; Collect contents of columns ahead of time so as to
+ ;; compute their maximum width.
+ (org-map-entries
+ (lambda () (cons (point) (org-columns--collect-values)))
+ nil nil (and org-columns-skip-archived-trees 'archive))))
+ (when cache
+ (org-columns--set-widths cache)
+ (org-columns--display-here-title)
+ (when (setq-local org-columns-flyspell-was-active
+ (bound-and-true-p flyspell-mode))
+ (flyspell-mode 0))
+ (unless (local-variable-p 'org-colview-initial-truncate-line-value)
+ (setq-local org-colview-initial-truncate-line-value
+ truncate-lines))
+ (setq truncate-lines t)
+ (dolist (entry cache)
+ (goto-char (car entry))
+ (org-columns--display-here (cdr entry)))))))))
+
+(defun org-columns-new (&optional spec &rest attributes)
+ "Insert a new column, to the left of the current column.
+Interactively fill attributes for new column. When column format
+specification SPEC is provided, edit it instead.
+
+When optional argument attributes can be a list of columns
+specifications attributes to create the new column
+non-interactively. See `org-columns-compile-format' for
+details."
(interactive)
- (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled)))
- cell)
- (setq prop (org-icompleting-read
- "Property: " (mapcar 'list (org-buffer-property-keys t nil t))
- nil nil prop))
- (setq title (read-string (concat "Column title [" prop "]: ") (or title prop)))
- (setq width (read-string "Column width: " (if width (number-to-string width))))
- (if (string-match "\\S-" width)
- (setq width (string-to-number width))
- (setq width nil))
- (setq fmt (org-icompleting-read
- "Summary [none]: "
- (mapcar (lambda (x) (list (symbol-name (cadr x))))
- org-columns-compile-map)
- nil t))
- (setq fmt (intern fmt)
- fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map))))
- (if (eq fmt 'none) (setq fmt nil))
- (if editp
- (progn
- (setcar editp prop)
- (setcdr editp (list title width nil fmt nil fun)))
- (setq cell (nthcdr (1- (current-column))
- org-columns-current-fmt-compiled))
- (setcdr cell (cons (list prop title width nil fmt nil
- (car fun) (cadr fun))
- (cdr cell))))
+ (let ((new (or attributes
+ (let ((prop
+ (completing-read
+ "Property: "
+ (mapcar #'list (org-buffer-property-keys t nil t))
+ nil nil (nth 0 spec))))
+ (list prop
+ (read-string (format "Column title [%s]: " prop)
+ (nth 1 spec))
+ ;; Use `read-string' instead of `read-number'
+ ;; to allow empty width.
+ (let ((w (read-string
+ "Column width: "
+ (and (nth 2 spec)
+ (number-to-string (nth 2 spec))))))
+ (and (org-string-nw-p w) (string-to-number w)))
+ (org-string-nw-p
+ (completing-read
+ "Summary: "
+ (delete-dups
+ (cons '("") ;Allow empty operator.
+ (mapcar (lambda (x) (list (car x)))
+ (append
+ org-columns-summary-types
+ org-columns-summary-types-default))))
+ nil t (nth 3 spec)))
+ (org-string-nw-p
+ (read-string "Format: " (nth 4 spec))))))))
+ (if spec
+ (progn (setcar spec (car new))
+ (setcdr spec (cdr new)))
+ (push new (nthcdr (current-column) org-columns-current-fmt-compiled)))
(org-columns-store-format)
(org-columns-redo)))
(defun org-columns-delete ()
"Delete the column at point from columns view."
(interactive)
- (let* ((n (current-column))
- (title (nth 1 (nth n org-columns-current-fmt-compiled))))
- (when (y-or-n-p
- (format "Are you sure you want to remove column \"%s\"? " title))
+ (let ((spec (nth (current-column) org-columns-current-fmt-compiled)))
+ (when (y-or-n-p (format "Are you sure you want to remove column %S? "
+ (nth 1 spec)))
(setq org-columns-current-fmt-compiled
- (delq (nth n org-columns-current-fmt-compiled)
- org-columns-current-fmt-compiled))
+ (delq spec org-columns-current-fmt-compiled))
(org-columns-store-format)
- (org-columns-redo)
- (if (>= (current-column) (length org-columns-current-fmt-compiled))
- (backward-char 1)))))
+ ;; This may leave a now wrong value in a node property. However
+ ;; updating it may prove counter-intuitive. See comments in
+ ;; `org-columns-move-right' for details.
+ (let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
+ (when (>= (current-column) (length org-columns-current-fmt-compiled))
+ (backward-char)))))
(defun org-columns-edit-attributes ()
"Edit the attributes of the current column."
(interactive)
- (let* ((n (current-column))
- (info (nth n org-columns-current-fmt-compiled)))
- (apply 'org-columns-new info)))
+ (org-columns-new (nth (current-column) org-columns-current-fmt-compiled)))
(defun org-columns-widen (arg)
"Make the column wider by ARG characters."
(interactive "p")
(let* ((n (current-column))
(entry (nth n org-columns-current-fmt-compiled))
- (width (or (nth 2 entry)
- (cdr (assoc (car entry) org-columns-current-maxwidths)))))
+ (width (aref org-columns-current-maxwidths n)))
(setq width (max 1 (+ width arg)))
(setcar (nthcdr 2 entry) width)
(org-columns-store-format)
- (org-columns-redo)))
+ (let ((org-columns-inhibit-recalculation t)) (org-columns-redo))))
(defun org-columns-narrow (arg)
"Make the column narrower by ARG characters."
@@ -872,7 +915,16 @@ calc function called on every element before summarizing. This is
(setcar cell (car (cdr cell)))
(setcdr cell (cons e (cdr (cdr cell))))
(org-columns-store-format)
- (org-columns-redo)
+ ;; Do not compute again properties, since we're just moving
+ ;; columns around. It can put a property value a bit off when
+ ;; switching between an non-computed and a computed value for the
+ ;; same property, e.g. from "%A %A{+}" to "%A{+} %A".
+ ;;
+ ;; In this case, the value needs to be updated since the first
+ ;; column related to a property determines how its value is
+ ;; computed. However, (correctly) updating the value could be
+ ;; surprising, so we leave it as-is nonetheless.
+ (let ((org-columns-inhibit-recalculation t)) (org-columns-redo))
(forward-char 1)))
(defun org-columns-move-left ()
@@ -886,358 +938,427 @@ calc function called on every element before summarizing. This is
(backward-char 1)))
(defun org-columns-store-format ()
- "Store the text version of the current columns format in appropriate place.
-This is either in the COLUMNS property of the node starting the current column
-display, or in the #+COLUMNS line of the current buffer."
- (let (fmt (cnt 0))
- (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))
- (org-set-local 'org-columns-current-fmt fmt)
- (if (marker-position org-columns-top-level-marker)
- (save-excursion
- (goto-char org-columns-top-level-marker)
- (if (and (org-at-heading-p)
- (org-entry-get nil "COLUMNS"))
- (org-entry-put nil "COLUMNS" fmt)
- (goto-char (point-min))
- ;; Overwrite all #+COLUMNS lines....
- (while (re-search-forward "^#\\+COLUMNS:.*" nil t)
- (setq cnt (1+ cnt))
- (replace-match (concat "#+COLUMNS: " fmt) t t))
- (unless (> cnt 0)
+ "Store the text version of the current columns format.
+The format is stored either in the COLUMNS property of the node
+starting the current column display, or in a #+COLUMNS line of
+the current buffer."
+ (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)))
+ (setq-local org-columns-current-fmt fmt)
+ (when org-columns-overlays
+ (org-with-point-at org-columns-top-level-marker
+ (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS"))
+ (org-entry-put nil "COLUMNS" fmt)
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ ;; Try to replace the first COLUMNS keyword available.
+ (catch :found
+ (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (and (eq (org-element-type element) 'keyword)
+ (equal (org-element-property :key element)
+ "COLUMNS"))
+ (replace-match (concat " " fmt) t t nil 1)
+ (throw :found nil))))
+ ;; No COLUMNS keyword in the buffer. Insert one at the
+ ;; beginning, right before the first heading, if any.
(goto-char (point-min))
- (or (org-at-heading-p t) (outline-next-heading))
+ (unless (org-at-heading-p t) (outline-next-heading))
(let ((inhibit-read-only t))
- (insert-before-markers "#+COLUMNS: " fmt "\n")))
- (org-set-local 'org-columns-default-format fmt))))))
-
-(defun org-columns-get-autowidth-alist (s cache)
- "Derive the maximum column widths from the format and the cache."
- (let ((start 0) rtn)
- (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start)
- (push (cons (match-string 1 s) 1) rtn)
- (setq start (match-end 0)))
- (mapc (lambda (x)
- (setcdr x (apply 'max
- (mapcar
- (lambda (y)
- (length (or (cdr (assoc (car x) (cdr y))) " ")))
- cache))))
- rtn)
- rtn))
-
-(defun org-columns-compute-all ()
- "Compute all columns that have operators defined."
- (org-with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(org-summaries t)))
- (let ((columns org-columns-current-fmt-compiled)
- (org-columns-time (time-to-number-of-days (current-time)))
- col)
- (while (setq col (pop columns))
- (when (nth 3 col)
- (save-excursion
- (org-columns-compute (car col)))))))
+ (insert-before-markers "#+COLUMNS: " fmt "\n"))))
+ (setq-local org-columns-default-format fmt))))))
(defun org-columns-update (property)
"Recompute PROPERTY, and update the columns display for it."
(org-columns-compute property)
- (let (fmt val pos)
- (save-excursion
- (mapc (lambda (ov)
- (when (equal (overlay-get ov 'org-columns-key) property)
- (setq pos (overlay-start ov))
- (goto-char pos)
- (when (setq val (cdr (assoc property
- (get-text-property
- (point-at-bol) 'org-summaries))))
- (setq fmt (overlay-get ov 'org-columns-format))
- (overlay-put ov 'org-columns-value val)
- (overlay-put ov 'display (format fmt val)))))
- org-columns-overlays))))
-
-(defvar org-inlinetask-min-level
- (if (featurep 'org-inlinetask) org-inlinetask-min-level 15))
-
-;;;###autoload
-(defun org-columns-compute (property)
- "Sum the values of property PROPERTY hierarchically, for the entire buffer."
- (interactive)
- (let* ((re org-outline-regexp-bol)
- (lmax 30) ; Does anyone use deeper levels???
- (lvals (make-vector lmax nil))
- (lflag (make-vector lmax nil))
- (level 0)
- (ass (assoc property org-columns-current-fmt-compiled))
- (format (nth 4 ass))
- (printf (nth 5 ass))
- (fun (nth 6 ass))
- (calc (or (nth 7 ass) 'identity))
- (beg org-columns-top-level-marker)
- (inminlevel org-inlinetask-min-level)
- (last-level org-inlinetask-min-level)
- val valflag flag end sumpos sum-alist sum str str1 useval)
- (save-excursion
- ;; Find the region to compute
- (goto-char beg)
- (setq end (condition-case nil (org-end-of-subtree t) (error (point-max))))
- (goto-char end)
- ;; Walk the tree from the back and do the computations
- (while (re-search-backward re beg t)
- (setq sumpos (match-beginning 0)
- last-level (if (not (or (zerop level) (eq level inminlevel)))
- level last-level)
- level (org-outline-level)
- val (org-entry-get nil property)
- valflag (and val (string-match "\\S-" val)))
- (cond
- ((< level last-level)
- ;; put the sum of lower levels here as a property
- (setq sum (+ (if (and (/= last-level inminlevel)
- (aref lvals last-level))
- (apply fun (aref lvals last-level)) 0)
- (if (aref lvals inminlevel)
- (apply fun (aref lvals inminlevel)) 0))
- flag (or (aref lflag last-level) ; any valid entries from children?
- (aref lflag inminlevel)) ; or inline tasks?
- str (org-columns-number-to-string sum format printf)
- str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold)
- useval (if flag str1 (if valflag val ""))
- sum-alist (get-text-property sumpos 'org-summaries))
- (if (assoc property sum-alist)
- (setcdr (assoc property sum-alist) useval)
- (push (cons property useval) sum-alist)
- (org-with-silent-modifications
- (add-text-properties sumpos (1+ sumpos)
- (list 'org-summaries sum-alist))))
- (when (and val (not (equal val (if flag str val))))
- (org-entry-put nil property (if flag str val)))
- ;; add current to current level accumulator
- (when (or flag valflag)
- (push (if flag
- sum
- (funcall calc (org-columns-string-to-number
- (if flag str val) format)))
- (aref lvals level))
- (aset lflag level t))
- ;; clear accumulators for deeper levels
- (loop for l from (1+ level) to (1- lmax) do
- (aset lvals l nil)
- (aset lflag l nil)))
- ((>= level last-level)
- ;; add what we have here to the accumulator for this level
- (when valflag
- (push (funcall calc (org-columns-string-to-number val format))
- (aref lvals level))
- (aset lflag level t)))
- (t (error "This should not happen")))))))
+ (org-with-wide-buffer
+ (let ((p (upcase property)))
+ (dolist (ov org-columns-overlays)
+ (let ((key (overlay-get ov 'org-columns-key)))
+ (when (and key (equal key p) (overlay-start ov))
+ (goto-char (overlay-start ov))
+ (let* ((spec (nth (current-column) org-columns-current-fmt-compiled))
+ (value
+ (or (cdr (assoc spec
+ (get-text-property (line-beginning-position)
+ 'org-summaries)))
+ (org-entry-get (point) key))))
+ (when value
+ (let ((displayed (org-columns--displayed-value spec value))
+ (format (overlay-get ov 'org-columns-format))
+ (width
+ (aref org-columns-current-maxwidths (current-column))))
+ (overlay-put ov 'org-columns-value value)
+ (overlay-put ov 'org-columns-value-modified displayed)
+ (overlay-put ov
+ 'display
+ (org-columns--overlay-text
+ displayed format width property value)))))))))))
(defun org-columns-redo ()
"Construct the column display again."
(interactive)
- (message "Recomputing columns...")
- (let ((line (org-current-line))
- (col (current-column)))
- (save-excursion
- (if (marker-position org-columns-begin-marker)
- (goto-char org-columns-begin-marker))
+ (when org-columns-overlays
+ (message "Recomputing columns...")
+ (org-with-point-at org-columns-begin-marker
(org-columns-remove-overlays)
(if (derived-mode-p 'org-mode)
- (call-interactively 'org-columns)
+ ;; Since we already know the columns format, provide it
+ ;; instead of computing again.
+ (call-interactively #'org-columns org-columns-current-fmt)
(org-agenda-redo)
- (call-interactively 'org-agenda-columns)))
- (org-goto-line line)
- (move-to-column col))
- (message "Recomputing columns...done"))
-
-(defun org-columns-not-in-agenda ()
- (if (eq major-mode 'org-agenda-mode)
- (error "This command is only allowed in Org-mode buffers")))
-
-(defun org-string-to-number (s)
- "Convert string to number, and interpret hh:mm:ss."
- (if (not (string-match ":" s))
- (string-to-number s)
- (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
- (while l
- (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
- sum)))
+ (call-interactively #'org-agenda-columns)))
+ (message "Recomputing columns...done")))
-;;;###autoload
-(defun org-columns-number-to-string (n fmt &optional printf)
- "Convert a computed column number to a string value, according to FMT."
- (cond
- ((memq fmt '(estimate)) (org-estimate-print n printf))
- ((not (numberp n)) "")
- ((memq fmt '(add_times max_times min_times mean_times))
- (org-hours-to-clocksum-string n))
- ((eq fmt 'checkbox)
- (cond ((= n (floor n)) "[X]")
- ((> n 1.) "[-]")
- (t "[ ]")))
- ((memq fmt '(checkbox-n-of-m checkbox-percent))
- (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1))))))
- (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent))))
- (printf (format printf n))
- ((eq fmt 'currency)
- (format "%.2f" n))
- ((memq fmt '(min_age max_age mean_age))
- (org-format-time-period n))
- (t (number-to-string n))))
-
-(defun org-nofm-to-completion (n m &optional percent)
- (if (not percent)
- (format "[%d/%d]" n m)
- (format "[%d%%]" (round (* 100.0 n) m))))
-
-
-(defun org-columns-string-to-number (s fmt)
- "Convert a column value to a number that can be used for column computing."
- (if s
- (cond
- ((memq fmt '(min_age max_age mean_age))
- (cond ((string= s "") org-columns-time)
- ((string-match
- "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s"
- s)
- (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s)))
- (string-to-number (match-string 2 s))))
- (string-to-number (match-string 3 s))))
- (string-to-number (match-string 4 s))))
- (t (time-to-number-of-days (apply 'encode-time
- (org-parse-time-string s t))))))
- ((string-match ":" s)
- (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
- (while l
- (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
- sum))
- ((string-match (concat "\\([0-9.]+\\) *\\("
- (regexp-opt (mapcar 'car org-effort-durations))
- "\\)") s)
- (setq s (concat "0:" (org-duration-string-to-minutes s t)))
- (let ((l (nreverse (org-split-string s ":"))) (sum 0.0))
- (while l
- (setq sum (+ (string-to-number (pop l)) (/ sum 60))))
- sum))
- ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent))
- (if (equal s "[X]") 1. 0.000001))
- ((memq fmt '(estimate)) (org-string-to-estimate s))
- (t (string-to-number s)))))
-
-(defun org-columns-uncompile-format (cfmt)
- "Turn the compiled columns format back into a string representation."
- (let ((rtn "") e s prop title op op-match width fmt printf fun calc)
- (while (setq e (pop cfmt))
- (setq prop (car e)
- title (nth 1 e)
- width (nth 2 e)
- op (nth 3 e)
- fmt (nth 4 e)
- printf (nth 5 e)
- fun (nth 6 e)
- calc (nth 7 e))
- (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map))
- (setq op (car op-match)))
- (if (and op printf) (setq op (concat op ";" printf)))
- (if (equal title prop) (setq title nil))
- (setq s (concat "%" (if width (number-to-string width))
- prop
- (if title (concat "(" title ")"))
- (if op (concat "{" op "}"))))
- (setq rtn (concat rtn " " s)))
- (org-trim rtn)))
+(defun org-columns-uncompile-format (compiled)
+ "Turn the compiled columns format back into a string representation.
+COMPILED is an alist, as returned by
+`org-columns-compile-format', which see."
+ (mapconcat
+ (lambda (spec)
+ (pcase spec
+ (`(,prop ,title ,width ,op ,printf)
+ (concat "%"
+ (and width (number-to-string width))
+ prop
+ (and title (not (equal prop title)) (format "(%s)" title))
+ (cond ((not op) nil)
+ (printf (format "{%s;%s}" op printf))
+ (t (format "{%s}" op)))))))
+ compiled " "))
(defun org-columns-compile-format (fmt)
- "Turn a column format string into an alist of specifications.
+ "Turn a column format string FMT into an alist of specifications.
+
The alist has one entry for each column in the format. The elements of
that list are:
-property the property
-title the title field for the columns
-width the column width in characters, can be nil for automatic
-operator the operator if any
-format the output format for computed results, derived from operator
-printf a printf format for computed values
-fun the lisp function to compute summary values, derived from operator
-calc function to get values from base elements"
- (let ((start 0) width prop title op op-match f printf fun calc)
- (setq org-columns-current-fmt-compiled nil)
+property the property name, as an upper-case string
+title the title field for the columns, as a string
+width the column width in characters, can be nil for automatic width
+operator the summary operator, as a string, or nil
+printf a printf format for computed values, as a string, or nil
+
+This function updates `org-columns-current-fmt-compiled'."
+ (setq org-columns-current-fmt-compiled nil)
+ (let ((start 0))
(while (string-match
- (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*")
+ "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\
+\\(?:{\\([^}]+\\)}\\)?\\s-*"
fmt start)
- (setq start (match-end 0)
- width (match-string 1 fmt)
- prop (match-string 2 fmt)
- title (or (match-string 3 fmt) prop)
- op (match-string 4 fmt)
- f nil
- printf nil
- fun '+
- calc nil)
- (if width (setq width (string-to-number width)))
- (when (and op (string-match ";" op))
- (setq printf (substring op (match-end 0))
- op (substring op 0 (match-beginning 0))))
- (when (setq op-match (assoc op org-columns-compile-map))
- (setq f (cadr op-match)
- fun (caddr op-match)
- calc (cadddr op-match)))
- (push (list prop title width op f printf fun calc)
- org-columns-current-fmt-compiled))
+ (setq start (match-end 0))
+ (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt))))
+ (prop (match-string-no-properties 2 fmt))
+ (title (or (match-string-no-properties 3 fmt) prop))
+ (operator (match-string-no-properties 4 fmt)))
+ (push (if (not operator) (list (upcase prop) title width nil nil)
+ (let (printf)
+ (when (string-match ";" operator)
+ (setq printf (substring operator (match-end 0)))
+ (setq operator (substring operator 0 (match-beginning 0))))
+ (list (upcase prop) title width operator printf)))
+ org-columns-current-fmt-compiled)))
(setq org-columns-current-fmt-compiled
(nreverse org-columns-current-fmt-compiled))))
+
+;;;; Column View Summary
+
+(defun org-columns--age-to-minutes (s)
+ "Turn age string S into a number of minutes.
+An age is either computed from a given time-stamp, or indicated
+as a canonical duration, i.e., using units defined in
+`org-duration-canonical-units'."
+ (cond
+ ((string-match-p org-ts-regexp s)
+ (/ (- org-columns--time
+ (float-time (apply #'encode-time (org-parse-time-string s))))
+ 60))
+ ((org-duration-p s) (org-duration-to-minutes s t)) ;skip user units
+ (t (user-error "Invalid age: %S" s))))
+
+(defun org-columns--format-age (minutes)
+ "Format MINUTES float as an age string."
+ (org-duration-from-minutes minutes
+ '(("d" . nil) ("h" . nil) ("min" . nil))
+ t)) ;ignore user's custom units
+
+(defun org-columns--summary-apply-times (fun times)
+ "Apply FUN to time values TIMES.
+Return the result as a duration."
+ (org-duration-from-minutes
+ (apply fun
+ (mapcar (lambda (time)
+ ;; Unlike to `org-duration-to-minutes' standard
+ ;; behavior, we want to consider plain numbers as
+ ;; hours. As a consequence, we treat them
+ ;; differently.
+ (if (string-match-p "\\`[0-9]+\\(?:\\.[0-9]*\\)?\\'" time)
+ (* 60 (string-to-number time))
+ (org-duration-to-minutes time)))
+ times))
+ (org-duration-h:mm-only-p times)))
+
+(defun org-columns--compute-spec (spec &optional update)
+ "Update tree according to SPEC.
+SPEC is a column format specification. When optional argument
+UPDATE is non-nil, summarized values can replace existing ones in
+properties drawers."
+ (let* ((lmax (if (bound-and-true-p org-inlinetask-min-level)
+ org-inlinetask-min-level
+ 29)) ;Hard-code deepest level.
+ (lvals (make-vector (1+ lmax) nil))
+ (level 0)
+ (inminlevel lmax)
+ (last-level lmax)
+ (property (car spec))
+ (printf (nth 4 spec))
+ (summarize (org-columns--summarize (nth 3 spec))))
+ (org-with-wide-buffer
+ ;; Find the region to compute.
+ (goto-char org-columns-top-level-marker)
+ (goto-char (condition-case nil (org-end-of-subtree t) (error (point-max))))
+ ;; Walk the tree from the back and do the computations.
+ (while (re-search-backward
+ org-outline-regexp-bol org-columns-top-level-marker t)
+ (unless (or (= level 0) (eq level inminlevel))
+ (setq last-level level))
+ (setq level (org-reduced-level (org-outline-level)))
+ (let* ((pos (match-beginning 0))
+ (value (org-entry-get nil property))
+ (value-set (org-string-nw-p value)))
+ (cond
+ ((< level last-level)
+ ;; Collect values from lower levels and inline tasks here
+ ;; and summarize them using SUMMARIZE. Store them in text
+ ;; property `org-summaries', in alist whose key is SPEC.
+ (let* ((summary
+ (and summarize
+ (let ((values (append (and (/= last-level inminlevel)
+ (aref lvals last-level))
+ (aref lvals inminlevel))))
+ (and values (funcall summarize values printf))))))
+ ;; Leaf values are not summaries: do not mark them.
+ (when summary
+ (let* ((summaries-alist (get-text-property pos 'org-summaries))
+ (old (assoc spec summaries-alist)))
+ (if old (setcdr old summary)
+ (push (cons spec summary) summaries-alist)
+ (org-with-silent-modifications
+ (add-text-properties
+ pos (1+ pos) (list 'org-summaries summaries-alist)))))
+ ;; When PROPERTY exists in current node, even if empty,
+ ;; but its value doesn't match the one computed, use
+ ;; the latter instead.
+ ;;
+ ;; Ignore leading or trailing white spaces that might
+ ;; have been introduced in summary, since those are not
+ ;; significant in properties value.
+ (let ((new-value (org-trim summary)))
+ (when (and update value (not (equal value new-value)))
+ (org-entry-put (point) property new-value))))
+ ;; Add current to current level accumulator.
+ (when (or summary value-set)
+ (push (or summary value) (aref lvals level)))
+ ;; Clear accumulators for deeper levels.
+ (cl-loop for l from (1+ level) to lmax do (aset lvals l nil))))
+ (value-set (push value (aref lvals level)))
+ (t nil)))))))
+;;;###autoload
+(defun org-columns-compute (property)
+ "Summarize the values of PROPERTY hierarchically.
+Also update existing values for PROPERTY according to the first
+column specification."
+ (interactive)
+ (let ((main-flag t)
+ (upcase-prop (upcase property)))
+ (dolist (spec org-columns-current-fmt-compiled)
+ (pcase spec
+ (`(,(pred (equal upcase-prop)) . ,_)
+ (org-columns--compute-spec spec main-flag)
+ ;; Only the first summary can update the property value.
+ (when main-flag (setq main-flag nil)))))))
+
+(defun org-columns-compute-all ()
+ "Compute all columns that have operators defined."
+ (org-with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (let ((org-columns--time (float-time (current-time)))
+ seen)
+ (dolist (spec org-columns-current-fmt-compiled)
+ (let ((property (car spec)))
+ ;; Property value is updated only the first time a given
+ ;; property is encountered.
+ (org-columns--compute-spec spec (not (member property seen)))
+ (push property seen)))))
+
+(defun org-columns--summary-sum (values printf)
+ "Compute the sum of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s") (apply #'+ (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-currencies (values _)
+ "Compute the sum of VALUES, with two decimals."
+ (format "%.2f" (apply #'+ (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-checkbox (check-boxes _)
+ "Summarize CHECK-BOXES with a check-box."
+ (let ((done (cl-count "[X]" check-boxes :test #'equal))
+ (all (length check-boxes)))
+ (cond ((= done all) "[X]")
+ ((> done 0) "[-]")
+ (t "[ ]"))))
+
+(defun org-columns--summary-checkbox-count (check-boxes _)
+ "Summarize CHECK-BOXES with a check-box cookie."
+ (format "[%d/%d]"
+ (cl-count-if (lambda (b) (or (equal b "[X]")
+ (string-match-p "\\[\\([1-9]\\)/\\1\\]" b)))
+ check-boxes)
+ (length check-boxes)))
+
+(defun org-columns--summary-checkbox-percent (check-boxes _)
+ "Summarize CHECK-BOXES with a check-box percent."
+ (format "[%d%%]"
+ (round (* 100.0 (cl-count-if (lambda (b) (member b '("[X]" "[100%]")))
+ check-boxes))
+ (length check-boxes))))
+
+(defun org-columns--summary-min (values printf)
+ "Compute the minimum of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s")
+ (apply #'min (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-max (values printf)
+ "Compute the maximum of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s")
+ (apply #'max (mapcar #'string-to-number values))))
+
+(defun org-columns--summary-mean (values printf)
+ "Compute the mean of VALUES.
+When PRINTF is non-nil, use it to format the result."
+ (format (or printf "%s")
+ (/ (apply #'+ (mapcar #'string-to-number values))
+ (float (length values)))))
+
+(defun org-columns--summary-sum-times (times _)
+ "Sum TIMES."
+ (org-columns--summary-apply-times #'+ times))
+
+(defun org-columns--summary-min-time (times _)
+ "Compute the minimum time among TIMES."
+ (org-columns--summary-apply-times #'min times))
+
+(defun org-columns--summary-max-time (times _)
+ "Compute the maximum time among TIMES."
+ (org-columns--summary-apply-times #'max times))
+
+(defun org-columns--summary-mean-time (times _)
+ "Compute the mean time among TIMES."
+ (org-columns--summary-apply-times
+ (lambda (&rest values) (/ (apply #'+ values) (float (length values))))
+ times))
+
+(defun org-columns--summary-min-age (ages _)
+ "Compute the minimum time among AGES."
+ (org-columns--format-age
+ (apply #'min (mapcar #'org-columns--age-to-minutes ages))))
+
+(defun org-columns--summary-max-age (ages _)
+ "Compute the maximum time among AGES."
+ (org-columns--format-age
+ (apply #'max (mapcar #'org-columns--age-to-minutes ages))))
+
+(defun org-columns--summary-mean-age (ages _)
+ "Compute the minimum time among AGES."
+ (org-columns--format-age
+ (/ (apply #'+ (mapcar #'org-columns--age-to-minutes ages))
+ (float (length ages)))))
+
+(defun org-columns--summary-estimate (estimates _)
+ "Combine a list of estimates, using mean and variance.
+The mean and variance of the result will be the sum of the means
+and variances (respectively) of the individual estimates."
+ (let ((mean 0)
+ (var 0))
+ (dolist (e estimates)
+ (pcase (mapcar #'string-to-number (split-string e "-"))
+ (`(,low ,high)
+ (let ((m (/ (+ low high) 2.0)))
+ (cl-incf mean m)
+ (cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m)))))
+ (`(,value) (cl-incf mean value))))
+ (let ((sd (sqrt var)))
+ (format "%s-%s"
+ (format "%.0f" (- mean sd))
+ (format "%.0f" (+ mean sd))))))
+
+
+
;;; Dynamic block for Column view
-(defvar org-heading-regexp) ; defined in org.el
-(defvar org-heading-keyword-regexp-format) ; defined in org.el
-(defun org-columns-capture-view (&optional maxlevel skip-empty-rows)
- "Get the column view of the current buffer or subtree.
-The first optional argument MAXLEVEL sets the level limit. A
-second optional argument SKIP-EMPTY-ROWS tells whether to skip
+(defun org-columns--capture-view (maxlevel skip-empty format local)
+ "Get the column view of the current buffer.
+
+MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip
empty rows, an empty row being one where all the column view
-specifiers except ITEM are empty. This function returns a list
-containing the title row and all other rows. Each row is a list
-of fields."
- (save-excursion
- (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled))
- (re-comment (format org-heading-keyword-regexp-format
- org-comment-string))
- (re-archive (concat ".*:" org-archive-tag ":"))
- (n (length title)) row tbl)
- (goto-char (point-min))
- (while (re-search-forward org-heading-regexp nil t)
- (catch 'next
- (when (and (or (null maxlevel)
- (>= maxlevel
- (if org-odd-levels-only
- (/ (1+ (length (match-string 1))) 2)
- (length (match-string 1)))))
- (get-char-property (match-beginning 0) 'org-columns-key))
- (when (save-excursion
- (goto-char (point-at-bol))
- (or (looking-at re-comment)
- (looking-at re-archive)))
- (org-end-of-subtree t)
- (throw 'next t))
- (setq row nil)
- (loop for i from 0 to (1- n) do
- (push
- (org-quote-vert
- (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified)
- (get-char-property (+ (match-beginning 0) i) 'org-columns-value)
- ""))
- row))
- (setq row (nreverse row))
- (unless (and skip-empty-rows
- (eq 1 (length (delete "" (delete-dups (copy-sequence row))))))
- (push row tbl)))))
- (append (list title 'hline) (nreverse tbl)))))
+specifiers but ITEM are empty. FORMAT is a format string for
+columns, or nil. When LOCAL is non-nil, only capture headings in
+current subtree.
+
+This function returns a list containing the title row and all
+other rows. Each row is a list of fields, as strings, or
+`hline'."
+ (org-columns (not local) format)
+ (goto-char org-columns-top-level-marker)
+ (let ((columns (length org-columns-current-fmt-compiled))
+ (has-item (assoc "ITEM" org-columns-current-fmt-compiled))
+ table)
+ (org-map-entries
+ (lambda ()
+ (when (get-char-property (point) 'org-columns-key)
+ (let (row)
+ (dotimes (i columns)
+ (let* ((col (+ (line-beginning-position) i))
+ (p (get-char-property col 'org-columns-key)))
+ (push (org-quote-vert
+ (get-char-property col
+ (if (string= p "ITEM")
+ 'org-columns-value
+ 'org-columns-value-modified)))
+ row)))
+ (unless (and skip-empty
+ (let ((r (delete-dups (remove "" row))))
+ (or (null r) (and has-item (= (length r) 1)))))
+ (push (cons (org-reduced-level (org-current-level)) (nreverse row))
+ table)))))
+ (and maxlevel (format "LEVEL<=%d" maxlevel))
+ (and local 'tree)
+ 'archive 'comment)
+ (org-columns-quit)
+ ;; Add column titles and a horizontal rule in front of the table.
+ (cons (mapcar #'cadr org-columns-current-fmt-compiled)
+ (cons 'hline (nreverse table)))))
+
+(defun org-columns--clean-item (item)
+ "Remove sensitive contents from string ITEM.
+This includes objects that may not be duplicated within
+a document, e.g., a target, or those forbidden in tables, e.g.,
+an inline src-block."
+ (let ((data (org-element-parse-secondary-string
+ item (org-element-restriction 'headline))))
+ (org-element-map data
+ '(footnote-reference inline-babel-call inline-src-block target
+ radio-target statistics-cookie)
+ #'org-element-extract-element)
+ (org-no-properties (org-element-interpret-data data))))
;;;###autoload
(defun org-dblock-write:columnview (params)
"Write the column view table.
PARAMS is a property list of parameters:
-:width enforce same column widths with <N> specifiers.
:id 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
@@ -1247,339 +1368,268 @@ PARAMS is a property list of parameters:
using `org-id-find'.
:hlines When t, insert a hline before each item. When a number, insert
a hline before each level <= that number.
+:indent When non-nil, indent each ITEM field according to its level.
:vlines When t, make each column a colgroup to enforce vertical lines.
:maxlevel When set to a number, don't capture headlines below this level.
:skip-empty-rows
When t, skip rows where all specifiers other than ITEM are empty.
+:width apply widths specified in columns format using <N> specifiers.
:format When non-nil, specify the column view format to use."
- (let ((pos (point-marker))
- (hlines (plist-get params :hlines))
- (vlines (plist-get params :vlines))
- (maxlevel (plist-get params :maxlevel))
- (content-lines (org-split-string (plist-get params :content) "\n"))
- (skip-empty-rows (plist-get params :skip-empty-rows))
- (columns-fmt (plist-get params :format))
- (case-fold-search t)
- tbl id idpos nfields tmp recalc line
- id-as-string view-file view-pos)
- (when (setq id (plist-get params :id))
- (setq id-as-string (cond ((numberp id) (number-to-string id))
- ((symbolp id) (symbol-name id))
- ((stringp id) id)
- (t "")))
- (cond ((not id) nil)
- ((eq id 'global) (setq view-pos (point-min)))
- ((eq id 'local))
- ((string-match "^file:\\(.*\\)" id-as-string)
- (setq view-file (match-string 1 id-as-string)
- view-pos 1)
- (unless (file-exists-p view-file)
- (error "No such file: \"%s\"" id-as-string)))
- ((setq idpos (org-find-entry-with-id id))
- (setq view-pos idpos))
- ((setq idpos (org-id-find id))
- (setq view-file (car idpos))
- (setq view-pos (cdr idpos)))
- (t (error "Cannot find entry with :ID: %s" id))))
- (with-current-buffer (if view-file
- (get-file-buffer view-file)
- (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (or view-pos (point)))
- (org-columns columns-fmt)
- (setq tbl (org-columns-capture-view maxlevel skip-empty-rows))
- (setq nfields (length (car tbl)))
- (org-columns-quit))))
- (goto-char pos)
- (move-marker pos nil)
- (when tbl
- (when (plist-get params :hlines)
- (setq tmp nil)
- (while tbl
- (if (eq (car tbl) 'hline)
- (push (pop tbl) tmp)
- (if (string-match "\\` *\\(\\*+\\)" (caar tbl))
- (if (and (not (eq (car tmp) 'hline))
- (or (eq hlines t)
- (and (numberp hlines)
- (<= (- (match-end 1) (match-beginning 1))
- hlines))))
- (push 'hline tmp)))
- (push (pop tbl) tmp)))
- (setq tbl (nreverse tmp)))
- (when vlines
- (setq tbl (mapcar (lambda (x)
- (if (eq 'hline x) x (cons "" x)))
- tbl))
- (setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
- (when content-lines
- (while (string-match "^#" (car content-lines))
- (insert (pop content-lines) "\n")))
- (setq pos (point))
- (insert (org-listtable-to-string tbl))
+ (let ((table
+ (let ((id (plist-get params :id))
+ view-file view-pos)
+ (pcase id
+ (`global nil)
+ ((or `local `nil) (setq view-pos (point)))
+ ((and (let id-string (format "%s" id))
+ (guard (string-match "^file:\\(.*\\)" id-string)))
+ (setq view-file (match-string-no-properties 1 id-string))
+ (unless (file-exists-p view-file)
+ (user-error "No such file: %S" id-string)))
+ ((and (let idpos (org-find-entry-with-id id)) (guard idpos))
+ (setq view-pos idpos))
+ ((let `(,filename . ,position) (org-id-find id))
+ (setq view-file filename)
+ (setq view-pos position))
+ (_ (user-error "Cannot find entry with :ID: %s" id)))
+ (with-current-buffer (if view-file (get-file-buffer view-file)
+ (current-buffer))
+ (org-with-wide-buffer
+ (when view-pos (goto-char view-pos))
+ (org-columns--capture-view (plist-get params :maxlevel)
+ (plist-get params :skip-empty-rows)
+ (plist-get params :format)
+ view-pos))))))
+ (when table
+ ;; Prune level information from the table. Also normalize
+ ;; headings: remove stars, add indentation entities, if
+ ;; required, and possibly precede some of them with a horizontal
+ ;; rule.
+ (let ((item-index
+ (let ((p (assoc "ITEM" org-columns-current-fmt-compiled)))
+ (and p (cl-position p
+ org-columns-current-fmt-compiled
+ :test #'equal))))
+ (hlines (plist-get params :hlines))
+ (indent (plist-get params :indent))
+ new-table)
+ ;; Copy header and first rule.
+ (push (pop table) new-table)
+ (push (pop table) new-table)
+ (dolist (row table (setq table (nreverse new-table)))
+ (let ((level (car row)))
+ (when (and (not (eq (car new-table) 'hline))
+ (or (eq hlines t)
+ (and (numberp hlines) (<= level hlines))))
+ (push 'hline new-table))
+ (when item-index
+ (let ((item (org-columns--clean-item (nth item-index (cdr row)))))
+ (setf (nth item-index (cdr row))
+ (if (and indent (> level 1))
+ (concat "\\_" (make-string (* 2 (1- level)) ?\s) item)
+ item))))
+ (push (cdr row) new-table))))
(when (plist-get params :width)
- (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
- org-columns-current-widths "|")))
- (while (setq line (pop content-lines))
- (when (string-match "^#" line)
- (insert "\n" line)
- (when (string-match "^[ \t]*#\\+tblfm" line)
- (setq recalc t))))
- (if recalc
- (progn (goto-char pos) (org-table-recalculate 'all))
- (goto-char pos)
+ (setq table
+ (append table
+ (list
+ (mapcar (lambda (spec)
+ (let ((w (nth 2 spec)))
+ (if w (format "<%d>" (max 3 w)) "")))
+ org-columns-current-fmt-compiled)))))
+ (when (plist-get params :vlines)
+ (setq table
+ (let ((size (length org-columns-current-fmt-compiled)))
+ (append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x)))
+ table)
+ (list (cons "/" (make-list size "<>")))))))
+ (let ((content-lines (org-split-string (plist-get params :content) "\n"))
+ recalc)
+ ;; Insert affiliated keywords before the table.
+ (when content-lines
+ (while (string-match-p "\\`[ \t]*#\\+" (car content-lines))
+ (insert (pop content-lines) "\n")))
+ (save-excursion
+ ;; Insert table at point.
+ (insert
+ (mapconcat (lambda (row)
+ (if (eq row 'hline) "|-|"
+ (format "|%s|" (mapconcat #'identity row "|"))))
+ table
+ "\n"))
+ ;; Insert TBLFM lines following table.
+ (let ((case-fold-search t))
+ (dolist (line content-lines)
+ (when (string-match-p "\\`[ \t]*#\\+TBLFM:" line)
+ (insert "\n" line)
+ (unless recalc (setq recalc t))))))
+ (when recalc (org-table-recalculate 'all t))
(org-table-align)))))
-(defun org-listtable-to-string (tbl)
- "Convert a listtable TBL to a string that contains the Org-mode table.
-The table still need to be aligned. The resulting string has no leading
-and tailing newline characters."
- (mapconcat
- (lambda (x)
- (cond
- ((listp x)
- (concat "|" (mapconcat 'identity x "|") "|"))
- ((eq x 'hline) "|-|")
- (t (error "Garbage in listtable: %s" x))))
- tbl "\n"))
-
;;;###autoload
-(defun org-insert-columns-dblock ()
+(defun org-columns-insert-dblock ()
"Create a dynamic block capturing a column view table."
(interactive)
- (let ((defaults '(:name "columnview" :hlines 1))
- (id (org-icompleting-read
+ (let ((id (completing-read
"Capture columns (local, global, entry with :ID: property) [local]: "
(append '(("global") ("local"))
- (mapcar 'list (org-property-values "ID"))))))
- (if (equal id "") (setq id 'local))
- (if (equal id "global") (setq id 'global))
- (setq defaults (append defaults (list :id id)))
- (org-create-dblock defaults)
- (org-update-dblock)))
+ (mapcar #'list (org-property-values "ID"))))))
+ (org-create-dblock
+ (list :name "columnview"
+ :hlines 1
+ :id (cond ((string= id "global") 'global)
+ ((member id '("" "local")) 'local)
+ (id)))))
+ (org-update-dblock))
-;;; Column view in the agenda
-
-(defvar org-agenda-view-columns-initially nil
- "When set, switch to columns view immediately after creating the agenda.")
-(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el
-(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el
-(defvar org-agenda-columns-add-appointments-to-effort-sum); as well
+
+;;; Column view in the agenda
;;;###autoload
(defun org-agenda-columns ()
"Turn on or update column view in the agenda."
(interactive)
- (org-verify-version 'columns)
(org-columns-remove-overlays)
- (move-marker org-columns-begin-marker (point))
- (let ((org-columns-time (time-to-number-of-days (current-time)))
- cache maxwidths m p a d fmt)
- (cond
- ((and (boundp 'org-agenda-overriding-columns-format)
- org-agenda-overriding-columns-format)
- (setq fmt org-agenda-overriding-columns-format))
- ((setq m (org-get-at-bol 'org-hd-marker))
- (setq fmt (or (org-entry-get m "COLUMNS" t)
- (with-current-buffer (marker-buffer m)
- org-columns-default-format))))
- ((and (boundp 'org-columns-current-fmt)
- (local-variable-p 'org-columns-current-fmt)
- org-columns-current-fmt)
- (setq fmt org-columns-current-fmt))
- ((setq m (next-single-property-change (point-min) 'org-hd-marker))
- (setq m (get-text-property m 'org-hd-marker))
- (setq fmt (or (org-entry-get m "COLUMNS" t)
- (with-current-buffer (marker-buffer m)
- org-columns-default-format)))))
- (setq fmt (or fmt org-columns-default-format))
- (org-set-local 'org-columns-current-fmt fmt)
- (org-columns-compile-format fmt)
+ (if (markerp org-columns-begin-marker)
+ (move-marker org-columns-begin-marker (point))
+ (setq org-columns-begin-marker (point-marker)))
+ (let* ((org-columns--time (float-time (current-time)))
+ (fmt
+ (cond
+ ((bound-and-true-p org-agenda-overriding-columns-format))
+ ((let ((m (org-get-at-bol 'org-hd-marker)))
+ (and m
+ (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format)))))
+ ((and (local-variable-p 'org-columns-current-fmt)
+ org-columns-current-fmt))
+ ((let ((m (next-single-property-change (point-min) 'org-hd-marker)))
+ (and m
+ (let ((m (get-text-property m 'org-hd-marker)))
+ (or (org-entry-get m "COLUMNS" t)
+ (with-current-buffer (marker-buffer m)
+ org-columns-default-format))))))
+ (t org-columns-default-format)))
+ (compiled-fmt (org-columns-compile-format fmt)))
+ (setq org-columns-current-fmt fmt)
(when org-agenda-columns-compute-summary-properties
(org-agenda-colview-compute org-columns-current-fmt-compiled))
(save-excursion
- ;; Get and cache the properties
+ ;; Collect properties for each headline in current view.
(goto-char (point-min))
- (while (not (eobp))
- (when (setq m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker)))
- (setq p (org-entry-properties m))
-
- (when (or (not (setq a (assoc org-effort-property p)))
- (not (string-match "\\S-" (or (cdr a) ""))))
- ;; OK, the property is not defined. Use appointment duration?
- (when (and org-agenda-columns-add-appointments-to-effort-sum
- (setq d (get-text-property (point) 'duration)))
- (setq d (org-minutes-to-clocksum-string d))
- (put-text-property 0 (length d) 'face 'org-warning d)
- (push (cons org-effort-property d) p)))
- (push (cons (org-current-line) p) cache))
- (beginning-of-line 2))
- (when cache
- (setq maxwidths (org-columns-get-autowidth-alist fmt cache))
- (org-set-local 'org-columns-current-maxwidths maxwidths)
- (org-columns-display-here-title)
- (when (org-set-local 'org-columns-flyspell-was-active
- (org-bound-and-true-p flyspell-mode))
- (flyspell-mode 0))
- (mapc (lambda (x)
- (org-goto-line (car x))
- (org-columns-display-here (cdr x)))
- cache)
- (when org-agenda-columns-show-summaries
- (org-agenda-colview-summarize cache))))))
+ (let (cache)
+ (while (not (eobp))
+ (let ((m (org-get-at-bol 'org-hd-marker)))
+ (when m
+ (push (cons (line-beginning-position)
+ ;; `org-columns-current-fmt-compiled' is
+ ;; initialized but only set locally to the
+ ;; agenda buffer. Since current buffer is
+ ;; changing, we need to force the original
+ ;; compiled-fmt there.
+ (org-with-point-at m
+ (org-columns--collect-values compiled-fmt)))
+ cache)))
+ (forward-line))
+ (when cache
+ (org-columns--set-widths cache)
+ (org-columns--display-here-title)
+ (when (setq-local org-columns-flyspell-was-active
+ (bound-and-true-p flyspell-mode))
+ (flyspell-mode 0))
+ (dolist (entry cache)
+ (goto-char (car entry))
+ (org-columns--display-here (cdr entry)))
+ (when org-agenda-columns-show-summaries
+ (org-agenda-colview-summarize cache)))))))
(defun org-agenda-colview-summarize (cache)
"Summarize the summarizable columns in column view in the agenda.
This will add overlays to the date lines, to show the summary for each day."
- (let* ((fmt (mapcar (lambda (x)
- (if (string-match "CLOCKSUM.*" (car x))
- (list (match-string 0 (car x))
- (nth 1 x) (nth 2 x) ":" 'add_times
- nil '+ nil)
- x))
- org-columns-current-fmt-compiled))
- line c c1 stype calc sumfunc props lsum entries prop v title)
- (catch 'exit
- (when (delq nil (mapcar 'cadr fmt))
- ;; OK, at least one summation column, it makes sense to try this
- (goto-char (point-max))
+ (let ((fmt (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`(,property ,title ,width . ,_)
+ (if (member property '("CLOCKSUM" "CLOCKSUM_T"))
+ (list property title width ":" nil)
+ spec))))
+ org-columns-current-fmt-compiled)))
+ ;; Ensure there's at least one summation column.
+ (when (cl-some (lambda (spec) (nth 3 spec)) fmt)
+ (goto-char (point-max))
+ (catch :complete
(while t
(when (or (get-text-property (point) 'org-date-line)
(eq (get-text-property (point) 'face)
'org-agenda-structure))
- ;; OK, this is a date line that should be used
- (setq line (org-current-line))
- (setq entries nil c cache cache nil)
- (while (setq c1 (pop c))
- (if (> (car c1) line)
- (push c1 entries)
- (push c1 cache)))
- ;; now ENTRIES are the ones we want to use, CACHE is the rest
- ;; Compute the summaries for the properties we want,
- ;; set nil properties for the rest.
- (when (setq entries (mapcar 'cdr entries))
- (setq props
- (mapcar
- (lambda (f)
- (setq prop (car f)
- title (nth 1 f)
- stype (nth 4 f)
- sumfunc (nth 6 f)
- calc (or (nth 7 f) 'identity))
- (cond
- ((equal prop "ITEM")
- (cons prop (buffer-substring (point-at-bol)
- (point-at-eol))))
- ((not stype) (cons prop ""))
- (t ;; do the summary
- (setq lsum nil)
- (dolist (x entries)
- (setq v (cdr (assoc prop x)))
- (if v
- (push
- (funcall
- (if (not (get-text-property 0 'org-computed v))
- calc
- 'identity)
- (org-columns-string-to-number
- v stype))
- lsum)))
- (setq lsum (remove nil lsum))
- (setq lsum
- (cond ((> (length lsum) 1)
- (org-columns-number-to-string
- (apply sumfunc lsum) stype))
- ((eq (length lsum) 1)
- (org-columns-number-to-string
- (car lsum) stype))
- (t "")))
- (put-text-property 0 (length lsum) 'face 'bold lsum)
- (unless (eq calc 'identity)
- (put-text-property 0 (length lsum) 'org-computed t lsum))
- (cons prop lsum))))
- fmt))
- (org-columns-display-here props 'dateline)
- (org-set-local 'org-agenda-columns-active t)))
- (if (bobp) (throw 'exit t))
- (beginning-of-line 0))))))
+ ;; OK, this is a date line that should be used.
+ (let (entries)
+ (let (rest)
+ (dolist (c cache)
+ (if (> (car c) (point))
+ (push c entries)
+ (push c rest)))
+ (setq cache rest))
+ ;; ENTRIES contains entries below the current one.
+ ;; CACHE is the rest. Compute the summaries for the
+ ;; properties we want, set nil properties for the rest.
+ (when (setq entries (mapcar #'cdr entries))
+ (org-columns--display-here
+ (mapcar
+ (lambda (spec)
+ (pcase spec
+ (`("ITEM" . ,_)
+ ;; Replace ITEM with current date. Preserve
+ ;; properties for fontification.
+ (let ((date (buffer-substring
+ (line-beginning-position)
+ (line-end-position))))
+ (list spec date date)))
+ (`(,_ ,_ ,_ nil ,_) (list spec "" ""))
+ (`(,_ ,_ ,_ ,operator ,printf)
+ (let* ((summarize (org-columns--summarize operator))
+ (values
+ ;; Use real values for summary, not
+ ;; those prepared for display.
+ (delq nil
+ (mapcar
+ (lambda (e) (org-string-nw-p
+ (nth 1 (assoc spec e))))
+ entries)))
+ (final (if values
+ (funcall summarize values printf)
+ "")))
+ (unless (equal final "")
+ (put-text-property 0 (length final)
+ 'face 'bold final))
+ (list spec final final)))))
+ fmt)
+ 'dateline)
+ (setq-local org-agenda-columns-active t))))
+ (if (bobp) (throw :complete t) (forward-line -1)))))))
(defun org-agenda-colview-compute (fmt)
"Compute the relevant columns in the contributing source buffers."
- (let ((files org-agenda-contributing-files)
- (org-columns-begin-marker (make-marker))
- (org-columns-top-level-marker (make-marker))
- f fm a b)
- (while (setq f (pop files))
- (setq b (find-buffer-visiting f))
+ (dolist (file org-agenda-contributing-files)
+ (let ((b (find-buffer-visiting file)))
(with-current-buffer (or (buffer-base-buffer b) b)
- (save-excursion
- (save-restriction
- (widen)
- (org-with-silent-modifications
- (remove-text-properties (point-min) (point-max) '(org-summaries t)))
- (goto-char (point-min))
- (org-columns-get-format-and-top-level)
- (while (setq fm (pop fmt))
- (cond ((equal (car fm) "CLOCKSUM")
- (org-clock-sum))
- ((equal (car fm) "CLOCKSUM_T")
- (org-clock-sum-today))
- ((and (nth 4 fm)
- (setq a (assoc (car fm)
- org-columns-current-fmt-compiled))
- (equal (nth 4 a) (nth 4 fm)))
- (org-columns-compute (car fm)))))))))))
-
-(defun org-format-time-period (interval)
- "Convert time in fractional days to days/hours/minutes/seconds."
- (if (numberp interval)
- (let* ((days (floor interval))
- (frac-hours (* 24 (- interval days)))
- (hours (floor frac-hours))
- (minutes (floor (* 60 (- frac-hours hours))))
- (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes)))))
- (format "%dd %02dh %02dm %02ds" days hours minutes seconds))
- ""))
-
-(defun org-estimate-mean-and-var (v)
- "Return the mean and variance of an estimate."
- (let* ((low (float (car v)))
- (high (float (cadr v)))
- (mean (/ (+ low high) 2.0))
- (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0)))
- (list mean var)))
-
-(defun org-estimate-combine (&rest el)
- "Combine a list of estimates, using mean and variance.
-The mean and variance of the result will be the sum of the means
-and variances (respectively) of the individual estimates."
- (let ((mean 0)
- (var 0))
- (mapc (lambda (e)
- (let ((stats (org-estimate-mean-and-var e)))
- (setq mean (+ mean (car stats)))
- (setq var (+ var (cadr stats)))))
- el)
- (let ((stdev (sqrt var)))
- (list (- mean stdev) (+ mean stdev)))))
-
-(defun org-estimate-print (e &optional fmt)
- "Prepare a string representation of an estimate.
-This formats these numbers as two numbers with a \"-\" between them."
- (if (null fmt) (set 'fmt "%.0f"))
- (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-")))
-
-(defun org-string-to-estimate (s)
- "Convert a string to an estimate.
-The string should be two numbers joined with a \"-\"."
- (if (string-match "\\(.*\\)-\\(.*\\)" s)
- (list (string-to-number (match-string 1 s))
- (string-to-number(match-string 2 s)))
- (list (string-to-number s) (string-to-number s))))
+ (org-with-wide-buffer
+ (org-with-silent-modifications
+ (remove-text-properties (point-min) (point-max) '(org-summaries t)))
+ (goto-char (point-min))
+ (org-columns-get-format-and-top-level)
+ (dolist (spec fmt)
+ (let ((prop (car spec)))
+ (cond
+ ((equal prop "CLOCKSUM") (org-clock-sum))
+ ((equal prop "CLOCKSUM_T") (org-clock-sum-today))
+ ((and (nth 3 spec)
+ (let ((a (assoc prop org-columns-current-fmt-compiled)))
+ (equal (nth 3 a) (nth 3 spec))))
+ (org-columns-compute prop))))))))))
+
(provide 'org-colview)
diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el
index 42e2271c076..c963f06b559 100644
--- a/lisp/org/org-compat.el
+++ b/lisp/org/org-compat.el
@@ -1,4 +1,4 @@
-;;; org-compat.el --- Compatibility code for Org-mode
+;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,198 +19,422 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains code needed for compatibility with XEmacs and older
+;; This file contains code needed for compatibility with older
;; versions of GNU Emacs.
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(require 'cl-lib)
(require 'org-macs)
-;; The following constant is for backward compatibility. We do not use
-;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs)
-;; at compilation time and can therefore optimize code better.
-(defconst org-xemacs-p (featurep 'xemacs))
-(defconst org-format-transports-properties-p
- (let ((x "a"))
- (add-text-properties 0 1 '(test t) x)
- (get-text-property 0 'test (format "%s" x)))
- "Does format transport text properties?")
+(declare-function org-at-table.el-p "org" (&optional table-type))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-type "org-element" (element))
+(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
+(declare-function org-link-set-parameters "org" (type &rest rest))
+(declare-function org-table-end (&optional table-type))
+(declare-function outline-next-heading "outline" ())
+(declare-function table--at-cell-p "table" (position &optional object at-column))
+
+(defvar org-table-any-border-regexp)
+(defvar org-table-dataline-regexp)
+(defvar org-table-tab-recognizes-table.el)
+(defvar org-table1-hline-regexp)
+
+;;; Emacs < 25.1 compatibility
+
+(when (< emacs-major-version 25)
+ (defalias 'outline-hide-entry 'hide-entry)
+ (defalias 'outline-hide-sublevels 'hide-sublevels)
+ (defalias 'outline-hide-subtree 'hide-subtree)
+ (defalias 'outline-show-all 'show-all)
+ (defalias 'outline-show-branches 'show-branches)
+ (defalias 'outline-show-children 'show-children)
+ (defalias 'outline-show-entry 'show-entry)
+ (defalias 'outline-show-subtree 'show-subtree)
+ (defalias 'xref-find-definitions 'find-tag)
+ (defalias 'format-message 'format)
+ (defalias 'gui-get-selection 'x-get-selection))
+
+(defun org-decode-time (&optional time zone)
+ "Backward-compatible function for `decode-time'."
+ (if (< emacs-major-version 25)
+ (decode-time time)
+ (decode-time time zone)))
+
+(unless (fboundp 'directory-name-p)
+ (defun directory-name-p (name)
+ "Return non-nil if NAME ends with a directory separator character."
+ (let ((len (length name))
+ (lastc ?.))
+ (if (> len 0)
+ (setq lastc (aref name (1- len))))
+ (or (= lastc ?/)
+ (and (memq system-type '(windows-nt ms-dos))
+ (= lastc ?\\))))))
+
+(unless (fboundp 'directory-files-recursively)
+ (defun directory-files-recursively (dir regexp &optional include-directories)
+ "Return list of all files under DIR that have file names matching REGEXP.
+This function works recursively. Files are returned in \"depth first\"
+order, and files from each directory are sorted in alphabetical order.
+Each file name appears in the returned list in its absolute form.
+Optional argument INCLUDE-DIRECTORIES non-nil means also include in the
+output directories whose names match REGEXP."
+ (let ((result nil)
+ (files nil)
+ ;; When DIR is "/", remote file names like "/method:" could
+ ;; also be offered. We shall suppress them.
+ (tramp-mode (and tramp-mode (file-remote-p (expand-file-name dir)))))
+ (dolist (file (sort (file-name-all-completions "" dir)
+ 'string<))
+ (unless (member file '("./" "../"))
+ (if (directory-name-p file)
+ (let* ((leaf (substring file 0 (1- (length file))))
+ (full-file (expand-file-name leaf dir)))
+ ;; Don't follow symlinks to other directories.
+ (unless (file-symlink-p full-file)
+ (setq result
+ (nconc result (directory-files-recursively
+ full-file regexp include-directories))))
+ (when (and include-directories
+ (string-match regexp leaf))
+ (setq result (nconc result (list full-file)))))
+ (when (string-match regexp file)
+ (push (expand-file-name file dir) files)))))
+ (nconc result (nreverse files)))))
+
+
+;;; Obsolete aliases (remove them after the next major release).
+
+;;;; XEmacs compatibility, now removed.
+(define-obsolete-function-alias 'org-activate-mark 'activate-mark)
+(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0")
+(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0")
+(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0")
+(define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0")
+(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0")
+(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0")
+(define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0")
+(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0")
+(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0")
+(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0")
+(define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0")
+(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0")
+(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0")
+(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0")
+
+(defmacro org-re (s)
+ "Replace posix classes in regular expression S."
+ (declare (debug (form))
+ (obsolete "you can safely remove it." "Org 9.0"))
+ s)
+
+;;;; Functions from cl-lib that Org used to have its own implementation of.
+(define-obsolete-function-alias 'org-count 'cl-count "Org 9.0")
+(define-obsolete-function-alias 'org-every 'cl-every "Org 9.0")
+(define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0")
+(define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0")
+(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0")
+(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0")
+(define-obsolete-function-alias 'org-some 'cl-some "Org 9.0")
+(define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0")
+
+(defun org-sublist (list start end)
+ "Return a section of LIST, from START to END.
+Counting starts at 1."
+ (cl-subseq list (1- start) end))
+(make-obsolete 'org-sublist
+ "use cl-subseq (note the 0-based counting)."
+ "Org 9.0")
+
+
+;;;; Functions available since Emacs 24.3
+(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0")
+(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0")
+(define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0")
+(define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0")
+(define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0")
+(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0")
+(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0")
+(define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0")
+(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0")
+(define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0")
+
+;;;; Functions and variables from previous releases now obsolete.
+(define-obsolete-function-alias 'org-element-remove-indentation
+ 'org-remove-indentation "Org 9.0")
+(define-obsolete-variable-alias 'org-latex-create-formula-image-program
+ 'org-preview-latex-default-process "Org 9.0")
+(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory
+ 'org-preview-latex-image-directory "Org 9.0")
+(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0")
+(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0")
+(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3")
+(define-obsolete-function-alias 'org-image-file-name-regexp
+ 'image-file-name-regexp "Org 9.0")
+(define-obsolete-function-alias 'org-completing-read-no-i
+ 'completing-read "Org 9.0")
+(define-obsolete-function-alias 'org-icompleting-read
+ 'completing-read "Org 9.0")
+(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0")
+(define-obsolete-function-alias 'org-days-to-time
+ 'org-time-stamp-to-now "Org 8.2")
+(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties
+ 'org-agenda-ignore-properties "Org 9.0")
+(define-obsolete-function-alias 'org-preview-latex-fragment
+ 'org-toggle-latex-fragment "Org 8.3")
+(define-obsolete-function-alias 'org-export-get-genealogy
+ 'org-element-lineage "Org 9.0")
+(define-obsolete-variable-alias 'org-latex-with-hyperref
+ 'org-latex-hyperref-template "Org 9.0")
+(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0")
+(define-obsolete-variable-alias 'org-export-htmlized-org-css-url
+ 'org-org-htmlized-css-url "Org 8.2")
+(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0")
+(define-obsolete-function-alias 'org-agenda-todayp
+ 'org-agenda-today-p "Org 9.0")
+(define-obsolete-function-alias 'org-babel-examplize-region
+ 'org-babel-examplify-region "Org 9.0")
+(define-obsolete-variable-alias 'org-babel-capitalize-example-region-markers
+ 'org-babel-uppercase-example-markers "Org 9.1")
+
+(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0")
+(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
+(define-obsolete-function-alias 'org-insert-columns-dblock
+ 'org-columns-insert-dblock "Org 9.0")
+(define-obsolete-variable-alias 'org-export-babel-evaluate
+ 'org-export-use-babel "Org 9.1")
+(define-obsolete-function-alias 'org-activate-bracket-links
+ 'org-activate-links "Org 9.0")
+(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0")
+(define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0")
+
+(defun org-in-fixed-width-region-p ()
+ "Non-nil if point in a fixed-width region."
+ (save-match-data
+ (eq 'fixed-width (org-element-type (org-element-at-point)))))
+(make-obsolete 'org-in-fixed-width-region-p
+ "use `org-element' library"
+ "Org 9.0")
(defun org-compatible-face (inherits specs)
"Make a compatible face specification.
-If INHERITS is an existing face and if the Emacs version supports it,
-just inherit the face. If INHERITS is set and the Emacs version does
-not support it, copy the face specification from the inheritance face.
-If INHERITS is not given and SPECS is, use SPECS to define the face.
-XEmacs and Emacs 21 do not know about the `min-colors' attribute.
-For them we convert a (min-colors 8) entry to a `tty' entry and move it
-to the top of the list. The `min-colors' attribute will be removed from
-any other entries, and any resulting duplicates will be removed entirely."
- (when (and inherits (facep inherits) (not specs))
- (setq specs (or specs
- (get inherits 'saved-face)
- (get inherits 'face-defface-spec))))
- (cond
- ((and inherits (facep inherits)
- (not (featurep 'xemacs))
- (>= emacs-major-version 22)
- ;; do not inherit outline faces before Emacs 23
- (or (>= emacs-major-version 23)
- (not (string-match "\\`outline-[0-9]+"
- (symbol-name inherits)))))
- (list (list t :inherit inherits)))
- ((or (featurep 'xemacs) (< emacs-major-version 22))
- ;; These do not understand the `min-colors' attribute.
- (let (r e a)
- (while (setq e (pop specs))
- (cond
- ((memq (car e) '(t default)) (push e r))
- ((setq a (member '(min-colors 8) (car e)))
- (nconc r (list (cons (cons '(type tty) (delq (car a) (car e)))
- (cdr e)))))
- ((setq a (assq 'min-colors (car e)))
- (setq e (cons (delq a (car e)) (cdr e)))
- (or (assoc (car e) r) (push e r)))
- (t (or (assoc (car e) r) (push e r)))))
- (nreverse r)))
- (t specs)))
-(put 'org-compatible-face 'lisp-indent-function 1)
+If INHERITS is an existing face and if the Emacs version supports
+it, just inherit the face. If INHERITS is not given and SPECS
+is, use SPECS to define the face."
+ (declare (indent 1))
+ (if (facep inherits)
+ (list (list t :inherit inherits))
+ specs))
+(make-obsolete 'org-compatible-face "you can remove it." "Org 9.0")
+
+(defun org-add-link-type (type &optional follow export)
+ "Add a new TYPE link.
+FOLLOW and EXPORT are two functions.
+
+FOLLOW should take the link path as the single argument and do whatever
+is necessary to follow the link, for example find a file or display
+a mail message.
+
+EXPORT should format the link path for export to one of the export formats.
+It should be a function accepting three arguments:
+
+ path the path of the link, the text after the prefix (like \"http:\")
+ desc the description of the link, if any
+ format the export format, a symbol like `html' or `latex' or `ascii'.
+
+The function may use the FORMAT information to return different values
+depending on the format. The return value will be put literally into
+the exported file. If the return value is nil, this means Org should
+do what it normally does with links which do not have EXPORT defined.
+
+Org mode has a built-in default for exporting links. If you are happy with
+this default, there is no need to define an export function for the link
+type. For a simple example of an export function, see `org-bbdb.el'.
+
+If TYPE already exists, update it with the arguments.
+See `org-link-parameters' for documentation on the other parameters."
+ (org-link-set-parameters type :follow follow :export export)
+ (message "Created %s link." type))
+
+(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0")
+
+(defun org-table-recognize-table.el ()
+ "If there is a table.el table nearby, recognize it and move into it."
+ (when (and org-table-tab-recognizes-table.el (org-at-table.el-p))
+ (beginning-of-line)
+ (unless (or (looking-at org-table-dataline-regexp)
+ (not (looking-at org-table1-hline-regexp)))
+ (forward-line)
+ (when (looking-at org-table-any-border-regexp)
+ (forward-line -2)))
+ (if (re-search-forward "|" (org-table-end t) t)
+ (progn
+ (require 'table)
+ (if (table--at-cell-p (point)) t
+ (message "recognizing table.el table...")
+ (table-recognize-table)
+ (message "recognizing table.el table...done")))
+ (error "This should not happen"))))
+
+;; Not used by Org core since commit 6d1e3082, Feb 2010.
+(make-obsolete 'org-table-recognize-table.el
+ "please notify the org mailing list if you use this function."
+ "Org 9.0")
+
+(defun org-remove-angle-brackets (s)
+ (org-unbracket-string "<" ">" s))
+(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0")
+
+(defun org-remove-double-quotes (s)
+ (org-unbracket-string "\"" "\"" s))
+(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0")
+
+(defcustom org-publish-sitemap-file-entry-format "%t"
+ "Format string for site-map file entry.
+You could use brackets to delimit on what part the link will be.
+
+%t is the title.
+%a is the author.
+%d is the date formatted using `org-publish-sitemap-date-format'."
+ :group 'org-export-publish
+ :type 'string)
+(make-obsolete-variable
+ 'org-publish-sitemap-file-entry-format
+ "set `:sitemap-format-entry' in `org-publish-project-alist' instead."
+ "Org 9.1")
+
+(defvar org-agenda-skip-regexp)
+(defun org-agenda-skip-entry-when-regexp-matches ()
+ "Check if the current entry contains match for `org-agenda-skip-regexp'.
+If yes, it returns the end position of this entry, causing agenda commands
+to skip the entry but continuing the search in the subtree. This is a
+function that can be put into `org-agenda-skip-function' for the duration
+of a command."
+ (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
+ (let ((end (save-excursion (org-end-of-subtree t)))
+ skip)
+ (save-excursion
+ (setq skip (re-search-forward org-agenda-skip-regexp end t)))
+ (and skip end)))
+
+(defun org-agenda-skip-subtree-when-regexp-matches ()
+ "Check if the current subtree contains match for `org-agenda-skip-regexp'.
+If yes, it returns the end position of this tree, causing agenda commands
+to skip this subtree. This is a function that can be put into
+`org-agenda-skip-function' for the duration of a command."
+ (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
+ (let ((end (save-excursion (org-end-of-subtree t)))
+ skip)
+ (save-excursion
+ (setq skip (re-search-forward org-agenda-skip-regexp end t)))
+ (and skip end)))
+
+(defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
+ "Check if the current subtree contains match for `org-agenda-skip-regexp'.
+If yes, it returns the end position of the current entry (NOT the tree),
+causing agenda commands to skip the entry but continuing the search in
+the subtree. This is a function that can be put into
+`org-agenda-skip-function' for the duration of a command. An important
+use of this function is for the stuck project list."
+ (declare (obsolete "use `org-agenda-skip-if' instead." "Org 9.1"))
+ (let ((end (save-excursion (org-end-of-subtree t)))
+ (entry-end (save-excursion (outline-next-heading) (1- (point))))
+ skip)
+ (save-excursion
+ (setq skip (re-search-forward org-agenda-skip-regexp end t)))
+ (and skip entry-end)))
+
+(define-obsolete-function-alias 'org-minutes-to-clocksum-string
+ 'org-duration-from-minutes "Org 9.1")
+
+(define-obsolete-function-alias 'org-hh:mm-string-to-minutes
+ 'org-duration-to-minutes "Org 9.1")
+
+(define-obsolete-function-alias 'org-duration-string-to-minutes
+ 'org-duration-to-minutes "Org 9.1")
+
+(make-obsolete-variable 'org-time-clocksum-format
+ "set `org-duration-format' instead." "Org 9.1")
+
+(make-obsolete-variable 'org-time-clocksum-use-fractional
+ "set `org-duration-format' instead." "Org 9.1")
+
+(make-obsolete-variable 'org-time-clocksum-fractional-format
+ "set `org-duration-format' instead." "Org 9.1")
+
+(make-obsolete-variable 'org-time-clocksum-use-effort-durations
+ "set `org-duration-units' instead." "Org 9.1")
+
+(define-obsolete-function-alias 'org-babel-number-p
+ 'org-babel--string-to-number "Org 9.0")
+
+(define-obsolete-variable-alias 'org-usenet-links-prefer-google
+ 'org-gnus-prefer-web-links "Org 9.1")
+
+(define-obsolete-variable-alias 'org-texinfo-def-table-markup
+ 'org-texinfo-table-default-markup "Org 9.1")
+
+;;; The function was made obsolete by commit 65399674d5 of 2013-02-22.
+;;; This make-obsolete call was added 2016-09-01.
+(make-obsolete 'org-capture-import-remember-templates
+ "use the `org-capture-templates' variable instead."
+ "Org 9.0")
+
+
+;;;; Obsolete link types
+
+(eval-after-load 'org
+ '(progn
+ (org-link-set-parameters "file+emacs") ;since Org 9.0
+ (org-link-set-parameters "file+sys"))) ;since Org 9.0
+
+
+
+;;; Miscellaneous functions
(defun org-version-check (version feature level)
(let* ((v1 (mapcar 'string-to-number (split-string version "[.]")))
- (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
- (rmaj (or (nth 0 v1) 99))
- (rmin (or (nth 1 v1) 99))
- (rbld (or (nth 2 v1) 99))
- (maj (or (nth 0 v2) 0))
- (min (or (nth 1 v2) 0))
- (bld (or (nth 2 v2) 0)))
+ (v2 (mapcar 'string-to-number (split-string emacs-version "[.]")))
+ (rmaj (or (nth 0 v1) 99))
+ (rmin (or (nth 1 v1) 99))
+ (rbld (or (nth 2 v1) 99))
+ (maj (or (nth 0 v2) 0))
+ (min (or (nth 1 v2) 0))
+ (bld (or (nth 2 v2) 0)))
(if (or (< maj rmaj)
- (and (= maj rmaj)
- (< min rmin))
- (and (= maj rmaj)
- (= min rmin)
- (< bld rbld)))
- (if (eq level :predicate)
- ;; just return if we have the version
- nil
- (let ((msg (format "Emacs %s or greater is recommended for %s"
- version feature)))
- (display-warning 'org msg level)
- t))
+ (and (= maj rmaj)
+ (< min rmin))
+ (and (= maj rmaj)
+ (= min rmin)
+ (< bld rbld)))
+ (if (eq level :predicate)
+ ;; just return if we have the version
+ nil
+ (let ((msg (format "Emacs %s or greater is recommended for %s"
+ version feature)))
+ (display-warning 'org msg level)
+ t))
t)))
-
-;;;; Emacs/XEmacs compatibility
-
-(eval-and-compile
- (defun org-defvaralias (new-alias base-variable &optional docstring)
- "Compatibility function for defvaralias.
-Don't do the aliasing when `defvaralias' is not bound."
- (declare (indent 1))
- (when (fboundp 'defvaralias)
- (defvaralias new-alias base-variable docstring)))
-
- (when (and (not (boundp 'user-emacs-directory))
- (boundp 'user-init-directory))
- (org-defvaralias 'user-emacs-directory 'user-init-directory)))
-
-(when (featurep 'xemacs)
- (defadvice custom-handle-keyword
- (around org-custom-handle-keyword
- activate preactivate)
- "Remove custom keywords not recognized to avoid producing an error."
- (cond
- ((eq (ad-get-arg 1) :package-version))
- (t ad-do-it)))
- (defadvice define-obsolete-variable-alias
- (around org-define-obsolete-variable-alias
- (obsolete-name current-name &optional when docstring)
- activate preactivate)
- "Declare arguments defined in later versions of Emacs."
- ad-do-it)
- (defadvice define-obsolete-function-alias
- (around org-define-obsolete-function-alias
- (obsolete-name current-name &optional when docstring)
- activate preactivate)
- "Declare arguments defined in later versions of Emacs."
- ad-do-it)
- (defvar customize-package-emacs-version-alist nil)
- (defvar temporary-file-directory (temp-directory)))
-
-;; Keys
-(defconst org-xemacs-key-equivalents
- '(([mouse-1] . [button1])
- ([mouse-2] . [button2])
- ([mouse-3] . [button3])
- ([C-mouse-4] . [(control mouse-4)])
- ([C-mouse-5] . [(control mouse-5)]))
- "Translation alist for a couple of keys.")
-
-;; Overlay compatibility functions
-(defun org-detach-overlay (ovl)
- (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl)))
-(defun org-overlay-display (ovl text &optional face evap)
- "Make overlay OVL display TEXT with face FACE."
- (if (featurep 'xemacs)
- (let ((gl (make-glyph text)))
- (and face (set-glyph-face gl face))
- (set-extent-property ovl 'invisible t)
- (set-extent-property ovl 'end-glyph gl))
- (overlay-put ovl 'display text)
- (if face (overlay-put ovl 'face face))
- (if evap (overlay-put ovl 'evaporate t))))
-(defun org-overlay-before-string (ovl text &optional face evap)
- "Make overlay OVL display TEXT with face FACE."
- (if (featurep 'xemacs)
- (let ((gl (make-glyph text)))
- (and face (set-glyph-face gl face))
- (set-extent-property ovl 'begin-glyph gl))
- (if face (org-add-props text nil 'face face))
- (overlay-put ovl 'before-string text)
- (if evap (overlay-put ovl 'evaporate t))))
-(defun org-find-overlays (prop &optional pos delete)
- "Find all overlays specifying PROP at POS or point.
-If DELETE is non-nil, delete all those overlays."
- (let ((overlays (overlays-at (or pos (point))))
- ov found)
- (while (setq ov (pop overlays))
- (if (overlay-get ov prop)
- (if delete (delete-overlay ov) (push ov found))))
- found))
-
(defun org-get-x-clipboard (value)
- "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21."
- (cond ((eq window-system 'x)
- (let ((x (org-get-x-clipboard-compat value)))
- (if x (org-no-properties x))))
- ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
- (w32-get-clipboard-data))))
-
-(defsubst org-decompose-region (beg end)
- "Decompose from BEG to END."
- (if (featurep 'xemacs)
- (let ((modified-p (buffer-modified-p))
- (buffer-read-only nil))
- (remove-text-properties beg end '(composition nil))
- (set-buffer-modified-p modified-p))
- (decompose-region beg end)))
-
-;; Miscellaneous functions
-
-(defun org-add-hook (hook function &optional append local)
- "Add-hook, compatible with both Emacsen."
- (if (and local (featurep 'xemacs))
- (add-local-hook hook function append)
- (add-hook hook function append local)))
+ "Get the value of the X or Windows clipboard."
+ (cond ((and (eq window-system 'x)
+ (fboundp 'gui-get-selection)) ;Silence byte-compiler.
+ (org-no-properties
+ (ignore-errors
+ (or (gui-get-selection value 'UTF8_STRING)
+ (gui-get-selection value 'COMPOUND_TEXT)
+ (gui-get-selection value 'STRING)
+ (gui-get-selection value 'TEXT)))))
+ ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data))
+ (w32-get-clipboard-data))))
(defun org-add-props (string plist &rest props)
"Add text properties to entire string, from beginning to end.
@@ -222,153 +446,67 @@ that will be added to PLIST. Returns the string that was modified."
(put 'org-add-props 'lisp-indent-function 2)
(defun org-fit-window-to-buffer (&optional window max-height min-height
- shrink-only)
+ shrink-only)
"Fit WINDOW to the buffer, but only if it is not a side-by-side window.
WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are
passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call
`shrink-window-if-larger-than-buffer' instead, the height limit is
ignored in this case."
(cond ((if (fboundp 'window-full-width-p)
- (not (window-full-width-p window))
- ;; do nothing if another window would suffer
- (> (frame-width) (window-width window))))
- ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
- (fit-window-to-buffer window max-height min-height))
- ((fboundp 'shrink-window-if-larger-than-buffer)
- (shrink-window-if-larger-than-buffer window)))
+ (not (window-full-width-p window))
+ ;; do nothing if another window would suffer
+ (> (frame-width) (window-width window))))
+ ((and (fboundp 'fit-window-to-buffer) (not shrink-only))
+ (fit-window-to-buffer window max-height min-height))
+ ((fboundp 'shrink-window-if-larger-than-buffer)
+ (shrink-window-if-larger-than-buffer window)))
(or window (selected-window)))
-(defun org-number-sequence (from &optional to inc)
- "Call `number-sequence' or emulate it."
- (if (fboundp 'number-sequence)
- (number-sequence from to inc)
- (if (or (not to) (= from to))
- (list from)
- (or inc (setq inc 1))
- (when (zerop inc) (error "The increment can not be zero"))
- (let (seq (n 0) (next from))
- (if (> inc 0)
- (while (<= next to)
- (setq seq (cons next seq)
- n (1+ n)
- next (+ from (* n inc))))
- (while (>= next to)
- (setq seq (cons next seq)
- n (1+ n)
- next (+ from (* n inc)))))
- (nreverse seq)))))
-
;; `set-transient-map' is only in Emacs >= 24.4
(defalias 'org-set-transient-map
(if (fboundp 'set-transient-map)
'set-transient-map
'set-temporary-overlay-map))
-;; Region compatibility
+;;; Region compatibility
(defvar org-ignore-region nil
"Non-nil means temporarily disable the active region.")
(defun org-region-active-p ()
- "Is `transient-mark-mode' on and the region active?
-Works on both Emacs and XEmacs."
- (if org-ignore-region
- nil
- (if (featurep 'xemacs)
- (and zmacs-regions (region-active-p))
- (if (fboundp 'use-region-p)
- (use-region-p)
- (and transient-mark-mode mark-active))))) ; Emacs 22 and before
+ "Non-nil when the region active.
+Unlike to `use-region-p', this function also checks
+`org-ignore-region'."
+ (and (not org-ignore-region) (use-region-p)))
(defun org-cursor-to-region-beginning ()
(when (and (org-region-active-p)
- (> (point) (region-beginning)))
+ (> (point) (region-beginning)))
(exchange-point-and-mark)))
-;; Emacs 22 misses `activate-mark'
-(if (fboundp 'activate-mark)
- (defalias 'org-activate-mark 'activate-mark)
- (defun org-activate-mark ()
- (when (mark t)
- (setq mark-active t)
- (when (and (boundp 'transient-mark-mode)
- (not transient-mark-mode))
- (set (make-local-variable 'transient-mark-mode) 'lambda))
- (when (boundp 'zmacs-regions)
- (setq zmacs-regions t)))))
-
-;; Invisibility compatibility
+;;; Invisibility compatibility
(defun org-remove-from-invisibility-spec (arg)
"Remove elements from `buffer-invisibility-spec'."
(if (fboundp 'remove-from-invisibility-spec)
(remove-from-invisibility-spec arg)
(if (consp buffer-invisibility-spec)
- (setq buffer-invisibility-spec
- (delete arg buffer-invisibility-spec)))))
+ (setq buffer-invisibility-spec
+ (delete arg buffer-invisibility-spec)))))
(defun org-in-invisibility-spec-p (arg)
"Is ARG a member of `buffer-invisibility-spec'?"
(if (consp buffer-invisibility-spec)
(member arg buffer-invisibility-spec)))
-(defmacro org-xemacs-without-invisibility (&rest body)
- "Turn off extents with invisibility while executing BODY."
- `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol)
- 'all-extents-closed-open 'invisible))
- ext-inv-specs)
- (dolist (ext ext-inv)
- (when (extent-property ext 'invisible)
- (add-to-list 'ext-inv-specs (list ext (extent-property
- ext 'invisible)))
- (set-extent-property ext 'invisible nil)))
- ,@body
- (dolist (ext-inv-spec ext-inv-specs)
- (set-extent-property (car ext-inv-spec) 'invisible
- (cadr ext-inv-spec)))))
-(def-edebug-spec org-xemacs-without-invisibility (body))
-
-(defun org-indent-to-column (column &optional minimum buffer)
- "Work around a bug with extents with invisibility in XEmacs."
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility (indent-to-column column minimum buffer))
- (indent-to-column column minimum)))
-
-(defun org-indent-line-to (column)
- "Work around a bug with extents with invisibility in XEmacs."
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility (indent-line-to column))
- (indent-line-to column)))
-
-(defun org-move-to-column (column &optional force buffer)
+(defun org-move-to-column (column &optional force _buffer)
"Move to column COLUMN.
-Pass COLUMN and FORCE to `move-to-column'.
-Pass BUFFER to the XEmacs version of `move-to-column'."
+Pass COLUMN and FORCE to `move-to-column'."
(let ((buffer-invisibility-spec
- (remove '(org-filtered) buffer-invisibility-spec)))
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility
- (move-to-column column force buffer))
- (move-to-column column force))))
-
-(defun org-get-x-clipboard-compat (value)
- "Get the clipboard value on XEmacs or Emacs 21."
- (cond ((featurep 'xemacs)
- (org-no-warnings (get-selection-no-error value)))
- ((fboundp 'x-get-selection)
- (condition-case nil
- (or (x-get-selection value 'UTF8_STRING)
- (x-get-selection value 'COMPOUND_TEXT)
- (x-get-selection value 'STRING)
- (x-get-selection value 'TEXT))
- (error nil)))))
-
-(defun org-propertize (string &rest properties)
- (if (featurep 'xemacs)
- (progn
- (add-text-properties 0 (length string) properties string)
- string)
- (apply 'propertize string properties)))
+ (if (listp buffer-invisibility-spec)
+ (remove '(org-filtered) buffer-invisibility-spec)
+ buffer-invisibility-spec)))
+ (move-to-column column force)))
(defmacro org-find-library-dir (library)
`(file-name-directory (or (locate-library ,library) "")))
@@ -379,45 +517,28 @@ Pass BUFFER to the XEmacs version of `move-to-column'."
(while (string-match "\n" s start)
(setq start (match-end 0) n (1+ n)))
(if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n))
- (setq n (1- n)))
+ (setq n (1- n)))
n))
(defun org-kill-new (string &rest args)
(remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t)
- string)
+ string)
(apply 'kill-new string args))
-(defun org-select-frame-set-input-focus (frame)
- "Select FRAME, raise it, and set input focus, if possible."
- (cond ((featurep 'xemacs)
- (if (fboundp 'select-frame-set-input-focus)
- (select-frame-set-input-focus frame)
- (raise-frame frame)
- (select-frame frame)
- (focus-frame frame)))
- ;; `select-frame-set-input-focus' defined in Emacs 21 will not
- ;; set the input focus.
- ((>= emacs-major-version 22)
- (select-frame-set-input-focus frame))
- (t
- (raise-frame frame)
- (select-frame frame)
- (cond ((memq window-system '(x ns mac))
- (x-focus-frame frame))
- ((eq window-system 'w32)
- (w32-focus-frame frame)))
- (when focus-follows-mouse
- (set-mouse-position frame (1- (frame-width frame)) 0)))))
-
-(define-obsolete-function-alias 'org-float-time 'float-time "26.1")
-
-;; `user-error' is only available from 24.3 on
-(unless (fboundp 'user-error)
- (defalias 'user-error 'error))
-
-;; ‘format-message’ is available only from 25 on
-(unless (fboundp 'format-message)
- (defalias 'format-message 'format))
+;; `font-lock-ensure' is only available from 24.4.50 on
+(defalias 'org-font-lock-ensure
+ (if (fboundp 'font-lock-ensure)
+ #'font-lock-ensure
+ (lambda (&optional _beg _end)
+ (with-no-warnings (font-lock-fontify-buffer)))))
+
+;; `file-local-name' was added in Emacs 26.1.
+(defalias 'org-babel-local-file-name
+ (if (fboundp 'file-local-name)
+ 'file-local-name
+ (lambda (file)
+ "Return the local name component of FILE."
+ (or (file-remote-p file 'localname) file))))
(defmacro org-no-popups (&rest body)
"Suppress popup windows.
@@ -425,131 +546,27 @@ Let-bind some variables to nil around BODY to achieve the desired
effect, which variables to use depends on the Emacs version."
(if (org-version-check "24.2.50" "" :predicate)
`(let (pop-up-frames display-buffer-alist)
- ,@body)
+ ,@body)
`(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
,@body)))
-(if (fboundp 'string-match-p)
- (defalias 'org-string-match-p 'string-match-p)
- (defun org-string-match-p (regexp string &optional start)
- (save-match-data
- (funcall 'string-match regexp string start))))
-
-(if (fboundp 'looking-at-p)
- (defalias 'org-looking-at-p 'looking-at-p)
- (defun org-looking-at-p (&rest args)
- (save-match-data
- (apply 'looking-at args))))
-
-;; XEmacs does not have `looking-back'.
-(if (fboundp 'looking-back)
- (defalias 'org-looking-back 'looking-back)
- (defun org-looking-back (regexp &optional limit greedy)
- "Return non-nil if text before point matches regular expression REGEXP.
-Like `looking-at' except matches before point, and is slower.
-LIMIT if non-nil speeds up the search by specifying a minimum
-starting position, to avoid checking matches that would start
-before LIMIT.
-
-If GREEDY is non-nil, extend the match backwards as far as
-possible, stopping when a single additional previous character
-cannot be part of a match for REGEXP. When the match is
-extended, its starting position is allowed to occur before
-LIMIT."
- (let ((start (point))
- (pos
- (save-excursion
- (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
- (point)))))
- (if (and greedy pos)
- (save-restriction
- (narrow-to-region (point-min) start)
- (while (and (> pos (point-min))
- (save-excursion
- (goto-char pos)
- (backward-char 1)
- (looking-at (concat "\\(?:" regexp "\\)\\'"))))
- (setq pos (1- pos)))
- (save-excursion
- (goto-char pos)
- (looking-at (concat "\\(?:" regexp "\\)\\'")))))
- (not (null pos)))))
-
-(defalias 'org-font-lock-ensure
- (if (fboundp 'font-lock-ensure)
- #'font-lock-ensure
- (lambda (&optional _beg _end) (font-lock-fontify-buffer))))
-
-(defun org-floor* (x &optional y)
- "Return a list of the floor of X and the fractional part of X.
-With two arguments, return floor and remainder of their quotient."
- (let ((q (floor x y)))
- (list q (- x (if y (* y q) q)))))
-
-;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1.
-(defun org-pop-to-buffer-same-window
- (&optional buffer-or-name norecord label)
- "Pop to buffer specified by BUFFER-OR-NAME in the selected window."
- (if (fboundp 'pop-to-buffer-same-window)
- (funcall
- 'pop-to-buffer-same-window buffer-or-name norecord)
- (funcall 'switch-to-buffer buffer-or-name norecord)))
-
-;; RECURSIVE has been introduced with Emacs 23.2.
-;; This is copying and adapted from `tramp-compat-delete-directory'
-(defun org-delete-directory (directory &optional recursive)
- "Compatibility function for `delete-directory'."
- (if (null recursive)
- (delete-directory directory)
- (condition-case nil
- (funcall 'delete-directory directory recursive)
- ;; This Emacs version does not support the RECURSIVE flag. We
- ;; use the implementation from Emacs 23.2.
- (wrong-number-of-arguments
- (setq directory (directory-file-name (expand-file-name directory)))
- (if (not (file-symlink-p directory))
- (mapc (lambda (file)
- (if (eq t (car (file-attributes file)))
- (org-delete-directory file recursive)
- (delete-file file)))
- (directory-files
- directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
- (delete-directory directory)))))
-
;;;###autoload
(defmacro org-check-version ()
"Try very hard to provide sensible version strings."
(let* ((org-dir (org-find-library-dir "org"))
- (org-version.el (concat org-dir "org-version.el"))
- (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
+ (org-version.el (concat org-dir "org-version.el"))
+ (org-fixup.el (concat org-dir "../mk/org-fixup.el")))
(if (require 'org-version org-version.el 'noerror)
- '(progn
- (autoload 'org-release "org-version.el")
- (autoload 'org-git-version "org-version.el"))
+ '(progn
+ (autoload 'org-release "org-version.el")
+ (autoload 'org-git-version "org-version.el"))
(if (require 'org-fixup org-fixup.el 'noerror)
- '(org-fixup)
- ;; provide fallback definitions and complain
- (warn "Could not define org version correctly. Check installation!")
- '(progn
- (defun org-release () "N/A")
- (defun org-git-version () "N/A !!check installation!!"))))))
-
-(defun org-file-equal-p (f1 f2)
- "Return t if files F1 and F2 are the same.
-Implements `file-equal-p' for older emacsen and XEmacs."
- (if (fboundp 'file-equal-p)
- (file-equal-p f1 f2)
- (let (f1-attr f2-attr)
- (and (setq f1-attr (file-attributes (file-truename f1)))
- (setq f2-attr (file-attributes (file-truename f2)))
- (equal f1-attr f2-attr)))))
-
-;; `buffer-narrowed-p' is available for Emacs >=24.3
-(defun org-buffer-narrowed-p ()
- "Compatibility function for `buffer-narrowed-p'."
- (if (fboundp 'buffer-narrowed-p)
- (buffer-narrowed-p)
- (/= (- (point-max) (point-min)) (buffer-size))))
+ '(org-fixup)
+ ;; provide fallback definitions and complain
+ (warn "Could not define org version correctly. Check installation!")
+ '(progn
+ (defun org-release () "N/A")
+ (defun org-git-version () "N/A !!check installation!!"))))))
(defmacro org-with-silent-modifications (&rest body)
(if (fboundp 'with-silent-modifications)
@@ -557,6 +574,27 @@ Implements `file-equal-p' for older emacsen and XEmacs."
`(org-unmodified ,@body)))
(def-edebug-spec org-with-silent-modifications (body))
+;; Functions for Emacs < 24.4 compatibility
+(defun org-define-error (name message)
+ "Define NAME as a new error signal.
+MESSAGE is a string that will be output to the echo area if such
+an error is signaled without being caught by a `condition-case'.
+Implements `define-error' for older emacsen."
+ (if (fboundp 'define-error) (define-error name message)
+ (put name 'error-conditions
+ (copy-sequence (cons name (get 'error 'error-conditions))))))
+
+(unless (fboundp 'string-suffix-p)
+ ;; From Emacs subr.el.
+ (defun string-suffix-p (suffix string &optional ignore-case)
+ "Return non-nil if SUFFIX is a suffix of STRING.
+If IGNORE-CASE is non-nil, the comparison is done without paying
+attention to case differences."
+ (let ((start-pos (- (length string) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ string start-pos nil ignore-case))))))
+
(provide 'org-compat)
;;; org-compat.el ends here
diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el
index 36144e25309..48c3ff0a5f9 100644
--- a/lisp/org/org-crypt.el
+++ b/lisp/org/org-crypt.el
@@ -1,5 +1,4 @@
-;;; org-crypt.el --- Public key encryption for org-mode entries
-
+;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
;; Emacs Lisp Archive Entry
@@ -7,7 +6,7 @@
;; Keywords: org-mode
;; Author: John Wiegley <johnw@gnu.org>
;; Maintainer: Peter Jones <pjones@pmade.com>
-;; Description: Adds public key encryption to org-mode buffers
+;; Description: Adds public key encryption to Org buffers
;; URL: http://www.newartisans.com/software/emacs.html
;; Compatibility: Emacs22
@@ -24,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -104,10 +103,10 @@ t : Disable auto-save-mode for the current buffer
nil : Leave auto-save-mode enabled.
This may cause data to be written to disk unencrypted!
-'ask : Ask user whether or not to disable auto-save-mode
+`ask' : Ask user whether or not to disable auto-save-mode
for the current buffer.
-'encrypt : Leave auto-save-mode enabled for the current buffer,
+`encrypt': Leave auto-save-mode enabled for the current buffer,
but automatically re-encrypt all decrypted entries
*before* auto-saving.
NOTE: This only works for entries which have a tag
@@ -142,7 +141,7 @@ See `org-crypt-disable-auto-save'."
(message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage."))
((eq org-crypt-disable-auto-save 'encrypt)
(message "org-decrypt: Enabling re-encryption on auto-save.")
- (org-add-hook 'auto-save-hook
+ (add-hook 'auto-save-hook
(lambda ()
(message "org-crypt: Re-encrypting all decrypted entries due to auto-save.")
(org-encrypt-entries))
@@ -164,96 +163,96 @@ See `org-crypt-disable-auto-save'."
(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)
- (set (make-local-variable 'epg-context) (epg-make-context nil t t))
+ (setq-local epg-context (epg-make-context nil t t))
(epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))
(defun org-encrypt-entry ()
"Encrypt the content of the current headline."
(interactive)
(require 'epg)
- (save-excursion
- (org-back-to-heading t)
- (set (make-local-variable 'epg-context) (epg-make-context nil t t))
- (let ((start-heading (point)))
- (forward-line)
- (when (not (looking-at "-----BEGIN PGP MESSAGE-----"))
- (let ((folded (outline-invisible-p))
- (crypt-key (org-crypt-key-for-heading))
- (beg (point))
- end encrypted-text)
- (goto-char start-heading)
- (org-end-of-subtree t t)
- (org-back-over-empty-lines)
- (setq end (point)
- encrypted-text
- (org-encrypt-string (buffer-substring beg end) crypt-key))
- (delete-region beg end)
- (insert encrypted-text)
- (when folded
- (goto-char start-heading)
- (hide-subtree))
- nil)))))
+ (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)))
+ (goto-char start-heading)
+ (org-end-of-subtree t t)
+ (org-back-over-empty-lines)
+ (let ((contents (delete-and-extract-region beg (point))))
+ (condition-case err
+ (insert (org-encrypt-string 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)
+ (outline-hide-subtree))
+ nil)))))
(defun org-decrypt-entry ()
"Decrypt the content of the current headline."
(interactive)
(require 'epg)
(unless (org-before-first-heading-p)
- (save-excursion
- (org-back-to-heading t)
- (let ((heading-point (point))
- (heading-was-invisible-p
- (save-excursion
- (outline-end-of-heading)
- (outline-invisible-p))))
- (forward-line)
- (when (looking-at "-----BEGIN PGP MESSAGE-----")
- (org-crypt-check-auto-save)
- (set (make-local-variable '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 allow 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))))))
+ (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))))))
(defun org-encrypt-entries ()
"Encrypt all top-level entries in the current buffer."
(interactive)
- (let (todo-only)
+ (let ((org--matcher-tags-todo-only nil))
(org-scan-tags
'org-encrypt-entry
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
- todo-only)))
+ org--matcher-tags-todo-only)))
(defun org-decrypt-entries ()
"Decrypt all entries in the current buffer."
(interactive)
- (let (todo-only)
+ (let ((org--matcher-tags-todo-only nil))
(org-scan-tags
'org-decrypt-entry
(cdr (org-make-tags-matcher org-crypt-tag-matcher))
- todo-only)))
+ org--matcher-tags-todo-only)))
(defun org-at-encrypted-entry-p ()
"Is the current entry encrypted?"
@@ -267,7 +266,7 @@ See `org-crypt-disable-auto-save'."
"Add a hook to automatically encrypt entries before a file is saved to disk."
(add-hook
'org-mode-hook
- (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t))))
+ (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t))))
(add-hook 'org-reveal-start-hook 'org-decrypt-entry)
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 1ecf6744821..fe6caf209d9 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -1,4 +1,4 @@
-;;; org-ctags.el - Integrate Emacs "tags" facility with org mode.
+;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
@@ -20,26 +20,27 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;; Synopsis
;; ========
;;
-;; Allows org-mode to make use of the Emacs `etags' system. Defines tag
-;; destinations in org-mode files as any text between <<double angled
-;; brackets>>. This allows the tags-generation program `exuberant ctags' to
-;; parse these files and create tag tables that record where these
-;; destinations are found. Plain [[links]] in org mode files which do not have
-;; <<matching destinations>> within the same file will then be interpreted as
-;; links to these 'tagged' destinations, allowing seamless navigation between
-;; multiple org-mode files. Topics can be created in any org mode file and
-;; will always be found by plain links from other files. Other file types
-;; recognized by ctags (source code files, latex files, etc) will also be
-;; available as destinations for plain links, and similarly, org-mode links
-;; will be available as tags from source files. Finally, the function
-;; `org-ctags-find-tag-interactive' lets you choose any known tag, using
-;; autocompletion, and quickly jump to it.
+;; Allows Org mode to make use of the Emacs `etags' system. Defines
+;; tag destinations in Org files as any text between <<double angled
+;; brackets>>. This allows the tags-generation program `exuberant
+;; ctags' to parse these files and create tag tables that record where
+;; these destinations are found. Plain [[links]] in org mode files
+;; which do not have <<matching destinations>> within the same file
+;; will then be interpreted as links to these 'tagged' destinations,
+;; allowing seamless navigation between multiple Org files. Topics
+;; can be created in any org mode file and will always be found by
+;; plain links from other files. Other file types recognized by ctags
+;; (source code files, latex files, etc) will also be available as
+;; destinations for plain links, and similarly, Org links will be
+;; available as tags from source files. Finally, the function
+;; `org-ctags-find-tag-interactive' lets you choose any known tag,
+;; using autocompletion, and quickly jump to it.
;;
;; Installation
;; ============
@@ -110,8 +111,9 @@
;; Keeping the TAGS file up to date
;; ================================
;;
-;; Tags mode has no way of knowing that you have created new tags by typing in
-;; your org-mode buffer. New tags make it into the TAGS file in 3 ways:
+;; Tags mode has no way of knowing that you have created new tags by
+;; typing in your Org buffer. New tags make it into the TAGS file in
+;; 3 ways:
;;
;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file.
;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in
@@ -135,12 +137,8 @@
;;; Code:
-(eval-when-compile (require 'cl))
-
(require 'org)
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
-
(defgroup org-ctags nil
"Options concerning use of ctags within org mode."
:tag "Org-Ctags"
@@ -151,7 +149,7 @@
(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/"
"Regexp expression used by ctags external program.
-The regexp matches tag destinations in org-mode files.
+The regexp matches tag destinations in Org files.
Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/
See the ctags documentation for more information.")
@@ -210,8 +208,8 @@ The following patterns are replaced in the string:
(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile)
(when (and org-ctags-enabled-p tags-file-name)
- (set (make-local-variable 'org-ctags-tag-list)
- (org-ctags-all-tags-in-current-tags-table))))
+ (setq-local org-ctags-tag-list
+ (org-ctags-all-tags-in-current-tags-table))))
(defun org-ctags-enable ()
@@ -273,11 +271,6 @@ Return the list."
(replace-regexp-in-string (regexp-quote search) replace string t t))
-(defun y-or-n-minibuffer (prompt)
- (let ((use-dialog-box nil))
- (y-or-n-p prompt)))
-
-
;;; Internal functions =======================================================
@@ -285,29 +278,28 @@ Return the list."
"Visit or create a file called `NAME.org', and insert a new topic.
The new topic will be titled NAME (or TITLE if supplied)."
(interactive "sFile name: ")
- (let ((filename (substitute-in-file-name (expand-file-name name))))
- (condition-case v
- (progn
- (org-open-file name t)
- (message "Opened file OK")
- (goto-char (point-max))
- (insert (org-ctags-string-search-and-replace
- "%t" (capitalize (or title name))
- org-ctags-new-topic-template))
- (message "Inserted new file text OK")
- (org-mode-restart))
- (error (error "Error %S in org-ctags-open-file" v)))))
+ (condition-case v
+ (progn
+ (org-open-file name t)
+ (message "Opened file OK")
+ (goto-char (point-max))
+ (insert (org-ctags-string-search-and-replace
+ "%t" (capitalize (or title name))
+ org-ctags-new-topic-template))
+ (message "Inserted new file text OK")
+ (org-mode-restart))
+ (error (error "Error %S in org-ctags-open-file" v))))
;;;; Misc interoperability with etags system =================================
-(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag
- activate compile)
+(defadvice xref-find-definitions
+ (before org-ctags-set-org-mark-before-finding-tag activate compile)
"Before trying to find a tag, save our current position on org mark ring."
(save-excursion
- (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
- (org-mark-ring-push))))
+ (when (and (derived-mode-p 'org-mode) org-ctags-enabled-p)
+ (org-mark-ring-push))))
@@ -359,7 +351,7 @@ visit the file and location where the tag is found."
(old-pnt (point-marker))
(old-mark (copy-marker (mark-marker))))
(condition-case nil
- (progn (find-tag name)
+ (progn (xref-find-definitions name)
t)
(error
;; only restore old location if find-tag raises error
@@ -386,7 +378,7 @@ the new file."
(cond
((get-buffer (concat name ".org"))
;; Buffer is already open
- (org-pop-to-buffer-same-window (get-buffer (concat name ".org"))))
+ (pop-to-buffer-same-window (get-buffer (concat name ".org"))))
((file-exists-p filename)
;; File exists but is not open --> open it
(message "Opening existing org file `%S'..."
@@ -421,7 +413,6 @@ the heading a destination for the tag `NAME'."
(insert (org-ctags-string-search-and-replace
"%t" (capitalize name) org-ctags-new-topic-template))
(backward-char 4)
- (org-update-radio-target-regexp)
(end-of-line)
(forward-line 2)
(when narrowp
@@ -464,10 +455,10 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag."
nil))
-(defun org-ctags-fail-silently (name)
+(defun org-ctags-fail-silently (_name)
"This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS.
-Put as the last function in the list if you want to prevent org's default
-behavior of free text search."
+Put as the last function in the list if you want to prevent Org's
+default behavior of free text search."
t)
@@ -484,7 +475,7 @@ end up in one file, called TAGS, located in the directory. This
function may take several seconds to finish if the directory or
its subdirectories contain large numbers of taggable files."
(interactive)
- (assert (buffer-file-name))
+ (cl-assert (buffer-file-name))
(let ((dir-name (or directory-name
(file-name-directory (buffer-file-name))))
(exitcode nil))
@@ -499,8 +490,8 @@ its subdirectories contain large numbers of taggable files."
(expand-file-name (concat dir-name "/*")))))
(cond
((eql 0 exitcode)
- (set (make-local-variable 'org-ctags-tag-list)
- (org-ctags-all-tags-in-current-tags-table)))
+ (setq-local org-ctags-tag-list
+ (org-ctags-all-tags-in-current-tags-table)))
(t
;; This seems to behave differently on Linux, so just ignore
;; error codes for now
@@ -528,7 +519,7 @@ a new topic."
((member tag org-ctags-tag-list)
;; Existing tag
(push tag org-ctags-find-tag-history)
- (find-tag tag))
+ (xref-find-definitions tag))
(t
;; New tag
(run-hook-with-args-until-success
diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el
index 891e64f9095..6d1926bc15e 100644
--- a/lisp/org/org-datetree.el
+++ b/lisp/org/org-datetree.el
@@ -1,4 +1,4 @@
-;;; org-datetree.el --- Create date entries in a tree
+;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
@@ -34,12 +34,14 @@
(defvar org-datetree-base-level 1
"The level at which years should be placed in the date tree.
-This is normally one, but if the buffer has an entry with a DATE_TREE
-property (any value), the date tree will become a subtree under that entry,
-so the base level will be properly adjusted.")
+This is normally one, but if the buffer has an entry with a
+DATE_TREE (or WEEK_TREE for ISO week entries) property (any
+value), the date tree will become a subtree under that entry, so
+the base level will be properly adjusted.")
(defcustom org-datetree-add-timestamp nil
- "When non-nil, add a time stamp when create a datetree entry."
+ "When non-nil, add a time stamp matching date of entry.
+Added time stamp is active unless value is `inactive'."
:group 'org-capture
:version "24.3"
:type '(choice
@@ -48,115 +50,146 @@ so the base level will be properly adjusted.")
(const :tag "Add an active time stamp" active)))
;;;###autoload
-(defun org-datetree-find-date-create (date &optional keep-restriction)
- "Find or create an entry for DATE.
+(defun org-datetree-find-date-create (d &optional keep-restriction)
+ "Find or create an 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."
- (let ((year (nth 2 date))
- (month (car date))
- (day (nth 1 date)))
- (org-set-local 'org-datetree-base-level 1)
- (or keep-restriction (widen))
+tree can be found. If it is the symbol `subtree-at-point', then the tree
+will be built under the headline at point."
+ (setq-local org-datetree-base-level 1)
+ (save-restriction
+ (if (eq keep-restriction 'subtree-at-point)
+ (progn
+ (unless (org-at-heading-p) (error "Not at heading"))
+ (widen)
+ (org-narrow-to-subtree)
+ (setq-local org-datetree-base-level
+ (org-get-valid-level (org-current-level) 1)))
+ (unless keep-restriction (widen))
+ ;; Support the old way of tree placement, using a property
+ (let ((prop (org-find-property "DATE_TREE")))
+ (when prop
+ (goto-char prop)
+ (setq-local org-datetree-base-level
+ (org-get-valid-level (org-current-level) 1))
+ (org-narrow-to-subtree))))
(goto-char (point-min))
- (save-restriction
- (when (re-search-forward "^[ \t]*:DATE_TREE:[ \t]+\\S-" nil t)
- (org-back-to-heading t)
- (org-set-local 'org-datetree-base-level
- (org-get-valid-level (funcall outline-level) 1))
- (org-narrow-to-subtree))
- (goto-char (point-min))
- (org-datetree-find-year-create year)
- (org-datetree-find-month-create year month)
- (org-datetree-find-day-create year month day)
- (goto-char (prog1 (point) (widen))))))
-
-(defun org-datetree-find-year-create (year)
- "Find the YEAR datetree or create it."
- (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)")
- match)
- (goto-char (point-min))
- (while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) year)))
- (cond
- ((not match)
- (goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year))
- ((= (string-to-number (match-string 1)) year)
- (goto-char (point-at-bol)))
- (t
- (beginning-of-line 1)
- (org-datetree-insert-line year)))))
+ (let ((year (calendar-extract-year d))
+ (month (calendar-extract-month d))
+ (day (calendar-extract-day d)))
+ (org-datetree--find-create
+ "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
+\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+ year)
+ (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))))
-(defun org-datetree-find-month-create (year month)
- "Find the datetree for YEAR and MONTH or create it."
- (org-narrow-to-subtree)
- (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year))
- match)
+;;;###autoload
+(defun org-datetree-find-iso-week-create (d &optional keep-restriction)
+ "Find or create an ISO week entry for date D.
+Compared to `org-datetree-find-date-create' this function creates
+entries ordered by week instead of months.
+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."
+ (setq-local org-datetree-base-level 1)
+ (save-restriction
+ (if (eq keep-restriction 'subtree-at-point)
+ (progn
+ (unless (org-at-heading-p) (error "Not at heading"))
+ (widen)
+ (org-narrow-to-subtree)
+ (setq-local org-datetree-base-level
+ (org-get-valid-level (org-current-level) 1)))
+ (unless keep-restriction (widen))
+ ;; Support the old way of tree placement, using a property
+ (let ((prop (org-find-property "WEEK_TREE")))
+ (when prop
+ (goto-char prop)
+ (setq-local org-datetree-base-level
+ (org-get-valid-level (org-current-level) 1))
+ (org-narrow-to-subtree))))
(goto-char (point-min))
- (while (and (setq match (re-search-forward re nil t))
- (goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) month)))
- (cond
- ((not match)
- (goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year month))
- ((= (string-to-number (match-string 1)) month)
- (goto-char (point-at-bol)))
- (t
- (beginning-of-line 1)
- (org-datetree-insert-line year month)))))
-
-(defun org-datetree-find-day-create (year month day)
- "Find the datetree for YEAR, MONTH and DAY or create it."
- (org-narrow-to-subtree)
- (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month))
+ (require 'cal-iso)
+ (let* ((year (calendar-extract-year d))
+ (month (calendar-extract-month d))
+ (day (calendar-extract-day d))
+ (time (encode-time 0 0 0 day month year))
+ (iso-date (calendar-iso-from-absolute
+ (calendar-absolute-from-gregorian d)))
+ (weekyear (nth 2 iso-date))
+ (week (nth 0 iso-date)))
+ ;; ISO 8601 week format is %G-W%V(-%u)
+ (org-datetree--find-create
+ "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
+\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+ weekyear nil nil
+ (format-time-string "%G" time))
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$"
+ weekyear week nil
+ (format-time-string "%G-W%V" time))
+ ;; For the actual day we use the regular date instead of ISO week.
+ (org-datetree--find-create
+ "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+ year month day))))
+
+(defun org-datetree--find-create (regex year &optional month day insert)
+ "Find the datetree matched by REGEX for YEAR, MONTH, or DAY.
+REGEX is passed to `format' with YEAR, MONTH, and DAY as
+arguments. Match group 1 is compared against the specified date
+component. If INSERT is non-nil and there is no match then it is
+inserted into the buffer."
+ (when (or month day)
+ (org-narrow-to-subtree))
+ (let ((re (format regex year month day))
match)
(goto-char (point-min))
(while (and (setq match (re-search-forward re nil t))
(goto-char (match-beginning 1))
- (< (string-to-number (match-string 1)) day)))
+ (< (string-to-number (match-string 1)) (or day month year))))
(cond
((not match)
(goto-char (point-max))
- (or (bolp) (newline))
- (org-datetree-insert-line year month day))
- ((= (string-to-number (match-string 1)) day)
- (goto-char (point-at-bol)))
+ (unless (bolp) (insert "\n"))
+ (org-datetree-insert-line year month day insert))
+ ((= (string-to-number (match-string 1)) (or day month year))
+ (beginning-of-line))
(t
- (beginning-of-line 1)
- (org-datetree-insert-line year month day)))))
-
-(defun org-datetree-insert-line (year &optional month day)
- (let ((pos (point)) ts-type)
- (skip-chars-backward " \t\n")
- (delete-region (point) pos)
- (insert "\n" (make-string org-datetree-base-level ?*) " \n")
- (backward-char 1)
- (if month (org-do-demote))
- (if day (org-do-demote))
+ (beginning-of-line)
+ (org-datetree-insert-line year month day insert)))))
+
+(defun org-datetree-insert-line (year &optional month day text)
+ (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point))
+ (insert "\n" (make-string org-datetree-base-level ?*) " \n")
+ (backward-char)
+ (when month (org-do-demote))
+ (when day (org-do-demote))
+ (if text
+ (insert text)
(insert (format "%d" year))
(when month
- (insert (format "-%02d" month))
- (if day
- (insert (format "-%02d %s"
- day (format-time-string
- "%A" (encode-time 0 0 0 day month year))))
- (insert (format " %s"
- (format-time-string
- "%B" (encode-time 0 0 0 1 month year))))))
- (when (and day (setq ts-type org-datetree-add-timestamp))
+ (insert
+ (if day
+ (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year))
+ (format-time-string "-%m %B" (encode-time 0 0 0 1 month year))))))
+ (when (and day org-datetree-add-timestamp)
+ (save-excursion
(insert "\n")
(org-indent-line)
- (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type))
- (beginning-of-line 1)))
-
-(defun org-datetree-file-entry-under (txt date)
- "Insert a node TXT into the date tree under DATE."
- (org-datetree-find-date-create date)
+ (org-insert-time-stamp
+ (encode-time 0 0 0 day month year)
+ nil
+ (eq org-datetree-add-timestamp 'inactive))))
+ (beginning-of-line))
+
+(defun org-datetree-file-entry-under (txt d)
+ "Insert a node TXT into the date tree under date D."
+ (org-datetree-find-date-create d)
(let ((level (org-get-valid-level (funcall outline-level) 1)))
(org-end-of-subtree t t)
(org-back-over-empty-lines)
@@ -169,44 +202,42 @@ before running this command, even though the command tries to be smart."
(interactive)
(goto-char (point-min))
(let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'"))
- (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))
- dct ts tmp date year month day pos hdl-pos)
+ (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")))
(while (re-search-forward org-ts-regexp nil t)
(catch 'next
- (setq ts (match-string 0))
- (setq tmp (buffer-substring
- (max (point-at-bol) (- (match-beginning 0)
- org-ds-keyword-length))
- (match-beginning 0)))
- (if (or (string-match "-\\'" tmp)
- (string-match dre tmp)
- (string-match sre tmp))
+ (let ((tmp (buffer-substring
+ (max (line-beginning-position)
+ (- (match-beginning 0) org-ds-keyword-length))
+ (match-beginning 0))))
+ (when (or (string-suffix-p "-" tmp)
+ (string-match dre tmp)
+ (string-match sre tmp))
(throw 'next nil))
- (setq dct (decode-time (org-time-string-to-time (match-string 0)))
- date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))
- year (nth 2 date)
- month (car date)
- day (nth 1 date)
- pos (point))
- (org-back-to-heading t)
- (setq hdl-pos (point))
- (unless (org-up-heading-safe)
- ;; No parent, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
- ;; Parent looks wrong, we are not in a date tree
- (goto-char pos)
- (throw 'next nil))
- (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
- ;; At correct date already, do nothing
- (progn (goto-char pos) (throw 'next nil)))
- ;; OK, we need to refile this entry
- (goto-char hdl-pos)
- (org-cut-subtree)
- (save-excursion
- (save-restriction
- (org-datetree-file-entry-under (current-kill 0) date)))))))
+ (let* ((dct (decode-time (org-time-string-to-time (match-string 0))))
+ (date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)))
+ (year (nth 2 date))
+ (month (car date))
+ (day (nth 1 date))
+ (pos (point))
+ (hdl-pos (progn (org-back-to-heading t) (point))))
+ (unless (org-up-heading-safe)
+ ;; No parent, we are not in a date tree.
+ (goto-char pos)
+ (throw 'next nil))
+ (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]")
+ ;; Parent looks wrong, we are not in a date tree.
+ (goto-char pos)
+ (throw 'next nil))
+ (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day))
+ ;; At correct date already, do nothing.
+ (goto-char pos)
+ (throw 'next nil))
+ ;; OK, we need to refile this entry.
+ (goto-char hdl-pos)
+ (org-cut-subtree)
+ (save-excursion
+ (save-restriction
+ (org-datetree-file-entry-under (current-kill 0) date)))))))))
(provide 'org-datetree)
diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el
index c5d01158c9c..3361b0e59ea 100644
--- a/lisp/org/org-docview.el
+++ b/lisp/org/org-docview.el
@@ -1,4 +1,4 @@
-;;; org-docview.el --- support for links to doc-view-mode buffers
+;;; org-docview.el --- Support for links to doc-view-mode buffers -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,13 +19,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;; This file implements links to open files in doc-view-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;; The links take the form
@@ -49,13 +49,15 @@
(declare-function doc-view-goto-page "doc-view" (page))
(declare-function image-mode-window-get "image-mode" (prop &optional winprops))
-(org-add-link-type "docview" 'org-docview-open 'org-docview-export)
-(add-hook 'org-store-link-functions 'org-docview-store-link)
+(org-link-set-parameters "docview"
+ :follow #'org-docview-open
+ :export #'org-docview-export
+ :store #'org-docview-store-link)
(defun org-docview-export (link description format)
"Export a docview link from Org files."
- (let* ((path (when (string-match "\\(.+\\)::.+" link)
- (match-string 1 link)))
+ (let* ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link)
+ link))
(desc (or description link)))
(when (stringp path)
(setq path (org-link-escape (expand-file-name path)))
@@ -66,13 +68,14 @@
(t path)))))
(defun org-docview-open (link)
- (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link)
- (let* ((path (match-string 1 link))
- (page (string-to-number (match-string 2 link))))
- (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1)
- ;; to ensure org-link-frame-setup is respected
- (doc-view-goto-page page)
- )))
+ (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link)
+ (let ((path (match-string 1 link))
+ (page (and (match-beginning 2)
+ (string-to-number (match-string 2 link)))))
+ ;; Let Org mode open the file (in-emacs = 1) to ensure
+ ;; org-link-frame-setup is respected.
+ (org-open-file path 1)
+ (when page (doc-view-goto-page page))))
(defun org-docview-store-link ()
"Store a link to a docview buffer."
@@ -80,8 +83,7 @@
;; This buffer is in doc-view-mode
(let* ((path buffer-file-name)
(page (image-mode-window-get 'page))
- (link (concat "docview:" path "::" (number-to-string page)))
- (description ""))
+ (link (concat "docview:" path "::" (number-to-string page))))
(org-store-link-props
:type "docview"
:link link
diff --git a/lisp/org/org-duration.el b/lisp/org/org-duration.el
new file mode 100644
index 00000000000..096e973d340
--- /dev/null
+++ b/lisp/org/org-duration.el
@@ -0,0 +1,448 @@
+;;; org-duration.el --- Library handling durations -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 library provides tools to manipulate durations. A duration
+;; can have multiple formats:
+;;
+;; - 3:12
+;; - 1:23:45
+;; - 1y 3d 3h 4min
+;; - 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.
+;;
+;; The library provides functions allowing to convert a duration to,
+;; and from, a number of minutes: `org-duration-to-minutes' and
+;; `org-duration-from-minutes'. It also provides two lesser tools:
+;; `org-duration-p', and `org-duration-h:mm-only-p'.
+;;
+;; Users can set the number of minutes per unit, or define new units,
+;; in `org-duration-units'. The library also supports canonical
+;; duration, i.e., a duration that doesn't depend on user's settings,
+;; through optional arguments.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'org-macs)
+(declare-function org-trim "org-trim" (s &optional keep-lead))
+
+
+;;; Public variables
+
+(defconst org-duration-canonical-units
+ `(("min" . 1)
+ ("h" . 60)
+ ("d" . ,(* 60 24)))
+ "Canonical time duration units.
+See `org-duration-units' for details.")
+
+(defcustom org-duration-units
+ `(("min" . 1)
+ ("h" . 60)
+ ("d" . ,(* 60 24))
+ ("w" . ,(* 60 24 7))
+ ("m" . ,(* 60 24 30))
+ ("y" . ,(* 60 24 365.25)))
+ "Conversion factor to minutes for a duration.
+
+Each entry has the form (UNIT . MODIFIER).
+
+In a duration string, a number followed by UNIT is multiplied by
+the specified number of MODIFIER to obtain a duration in minutes.
+
+For example, the following value
+
+ \\=`((\"min\" . 1)
+ (\"h\" . 60)
+ (\"d\" . ,(* 60 8))
+ (\"w\" . ,(* 60 8 5))
+ (\"m\" . ,(* 60 8 5 4))
+ (\"y\" . ,(* 60 8 5 4 10)))
+
+is meaningful if you work an average of 8 hours per day, 5 days
+a week, 4 weeks a month and 10 months a year.
+
+When setting this variable outside the Customize interface, make
+sure to call the following command:
+
+ \\[org-duration-set-regexps]"
+ :group 'org-agenda
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :set (lambda (var val) (set-default var val) (org-duration-set-regexps))
+ :initialize 'custom-initialize-changed
+ :type '(choice
+ (const :tag "H:MM" 'h:mm)
+ (const :tag "H:MM:SS" 'h:mm:ss)
+ (alist :key-type (string :tag "Unit")
+ :value-type (number :tag "Modifier"))))
+
+(defcustom org-duration-format '(("d" . nil) (special . h:mm))
+ "Format definition for a duration.
+
+The value can be set to, respectively, the symbols `h:mm:ss' or
+`h:mm', which means a duration is expressed as, respectively,
+a \"H:MM:SS\" or \"H:MM\" string.
+
+Alternatively, the value can be a list of entries following the
+pattern:
+
+ (UNIT . REQUIRED?)
+
+UNIT is a unit string, as defined in `org-duration-units'. The
+time duration is formatted using only the time components that
+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:
+
+ (special . h:mm)
+ (special . h:mm:ss)
+
+ Units shorter than an hour are ignored. The hours and
+ minutes part of the duration is expressed unconditionally
+ with H:MM, or H:MM:SS, pattern.
+
+ (special . PRECISION)
+
+ A duration is expressed with a single unit, PRECISION being
+ the number of decimal places to show. The unit chosen is the
+ first one required or with a non-zero integer part. If there
+ is no such unit, the smallest one is used.
+
+For example,
+
+ ((\"d\" . nil) (\"h\" . t) (\"min\" . t))
+
+means a duration longer than a day is expressed in days, hours
+and minutes, whereas a duration shorter than a day is always
+expressed in hours and minutes, even when shorter than an hour.
+
+On the other hand, the value
+
+ ((\"d\" . nil) (\"min\" . nil))
+
+means a duration longer than a day is expressed in days and
+minutes, whereas a duration shorter than a day is expressed
+entirely in minutes, even when longer than an hour.
+
+The following format
+
+ ((\"d\" . nil) (special . h:mm))
+
+means that any duration longer than a day is expressed with both
+a \"d\" unit and a \"H:MM\" part, whereas a duration shorter than
+a day is expressed only as a \"H:MM\" string.
+
+Eventually,
+
+ ((\"d\" . nil) (\"h\" . nil) (special . 2))
+
+expresses a duration longer than a day as a decimal number, with
+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)
+ (const :tag "Use H:MM:SS" h:mm:ss)
+ (repeat :tag "Use units"
+ (choice
+ (cons :tag "Use units"
+ (string :tag "Unit")
+ (choice (const :tag "Skip when zero" nil)
+ (const :tag "Always used" t)))
+ (cons :tag "Use a single decimal unit"
+ (const special)
+ (integer :tag "Number of decimals"))
+ (cons :tag "Use both units and H:MM"
+ (const special)
+ (const h:mm))
+ (cons :tag "Use both units and H:MM:SS"
+ (const special)
+ (const h:mm:ss))))))
+
+
+;;; Internal variables and functions
+
+(defconst org-duration--h:mm-re
+ "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'"
+ "Regexp matching a duration expressed with H:MM or H:MM:SS format.
+See `org-duration--h:mm:ss-re' to only match the latter. Hours
+can use any number of digits.")
+
+(defconst org-duration--h:mm:ss-re
+ "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'"
+ "Regexp matching a duration expressed H:MM:SS format.
+See `org-duration--h:mm-re' to also support H:MM format. Hours
+can use any number of digits.")
+
+(defvar org-duration--unit-re nil
+ "Regexp matching a duration with an unit.
+Allowed units are defined in `org-duration-units'. Match group
+1 contains the bare number. Match group 2 contains the unit.")
+
+(defvar org-duration--full-re nil
+ "Regexp matching a duration expressed with units.
+Allowed units are defined in `org-duration-units'.")
+
+(defvar org-duration--mixed-re nil
+ "Regexp matching a duration expressed with units and H:MM or H:MM:SS format.
+Allowed units are defined in `org-duration-units'. Match group
+1 contains units part. Match group 2 contains H:MM or H:MM:SS
+part.")
+
+(defun org-duration--modifier (unit &optional canonical)
+ "Return modifier associated to string UNIT.
+When optional argument CANONICAL is non-nil, refer to
+`org-duration-canonical-units' instead of `org-duration-units'."
+ (or (cdr (assoc unit (if canonical
+ org-duration-canonical-units
+ org-duration-units)))
+ (error "Unknown unit: %S" unit)))
+
+
+;;; Public functions
+
+;;;###autoload
+(defun org-duration-set-regexps ()
+ "Set duration related regexps."
+ (interactive)
+ (setq org-duration--unit-re
+ (concat "\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ \t]*"
+ ;; Since user-defined units in `org-duration-units'
+ ;; can differ from canonical units in
+ ;; `org-duration-canonical-units', include both in
+ ;; regexp.
+ (regexp-opt (mapcar #'car (append org-duration-canonical-units
+ org-duration-units))
+ t)))
+ (setq org-duration--full-re
+ (format "\\`[ \t]*%s\\(?:[ \t]+%s\\)*[ \t]*\\'"
+ org-duration--unit-re
+ org-duration--unit-re))
+ (setq org-duration--mixed-re
+ (format "\\`[ \t]*\\(?1:%s\\(?:[ \t]+%s\\)*\\)[ \t]+\
+\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ \t]*\\'"
+ org-duration--unit-re
+ org-duration--unit-re)))
+
+;;;###autoload
+(defun org-duration-p (s)
+ "Non-nil when string S is a time duration."
+ (and (stringp s)
+ (or (string-match-p org-duration--full-re s)
+ (string-match-p org-duration--mixed-re s)
+ (string-match-p org-duration--h:mm-re s))))
+
+;;;###autoload
+(defun org-duration-to-minutes (duration &optional canonical)
+ "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."
+ (cond
+ ((equal duration "") 0.0)
+ ((numberp duration) (float duration))
+ ((string-match-p org-duration--h:mm-re duration)
+ (pcase-let ((`(,hours ,minutes ,seconds)
+ (mapcar #'string-to-number (split-string duration ":"))))
+ (+ (/ (or seconds 0) 60.0) minutes (* 60 hours))))
+ ((string-match-p org-duration--full-re duration)
+ (let ((minutes 0)
+ (s 0))
+ (while (string-match org-duration--unit-re duration s)
+ (setq s (match-end 0))
+ (let ((value (string-to-number (match-string 1 duration)))
+ (unit (match-string 2 duration)))
+ (cl-incf minutes (* value (org-duration--modifier unit canonical)))))
+ (float minutes)))
+ ((string-match org-duration--mixed-re duration)
+ (let ((units-part (match-string 1 duration))
+ (hms-part (match-string 2 duration)))
+ (+ (org-duration-to-minutes units-part)
+ (org-duration-to-minutes hms-part))))
+ ((string-match-p "\\`[0-9]+\\(\\.[0-9]*\\)?\\'" duration)
+ (float (string-to-number duration)))
+ (t (error "Invalid duration format: %S" duration))))
+
+;;;###autoload
+(defun org-duration-from-minutes (minutes &optional fmt canonical)
+ "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."
+ (pcase (or fmt org-duration-format)
+ (`h:mm
+ (let ((minutes (floor minutes)))
+ (format "%d:%02d" (/ minutes 60) (mod minutes 60))))
+ (`h:mm:ss
+ (let* ((whole-minutes (floor minutes))
+ (seconds (floor (* 60 (- minutes whole-minutes)))))
+ (format "%s:%02d"
+ (org-duration-from-minutes whole-minutes 'h:mm)
+ seconds)))
+ ((pred atom) (error "Invalid duration format specification: %S" fmt))
+ ;; Mixed format. Call recursively the function on both parts.
+ ((and duration-format
+ (let `(special . ,(and mode (or `h:mm:ss `h:mm)))
+ (assq 'special duration-format)))
+ (let* ((truncated-format
+ ;; Remove "special" mode from duration format in order to
+ ;; recurse properly. Also remove units smaller or equal
+ ;; to an hour since H:MM part takes care of it.
+ (cl-remove-if-not
+ (lambda (pair)
+ (pcase pair
+ (`(,(and unit (pred stringp)) . ,_)
+ (> (org-duration--modifier unit canonical) 60))
+ (_ nil)))
+ duration-format))
+ (min-modifier ;smallest modifier above hour
+ (and truncated-format
+ (apply #'min
+ (mapcar (lambda (p)
+ (org-duration--modifier (car p) canonical))
+ truncated-format)))))
+ (if (or (null min-modifier) (< minutes min-modifier))
+ ;; There is not unit above the hour or the smallest unit
+ ;; above the hour is too large for the number of minutes we
+ ;; need to represent. Use H:MM or H:MM:SS syntax.
+ (org-duration-from-minutes minutes mode canonical)
+ ;; 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)))
+ (concat
+ (org-duration-from-minutes units-part truncated-format canonical)
+ " "
+ (org-duration-from-minutes minutes-part mode))))))
+ ;; Units format.
+ (duration-format
+ (let* ((fractional
+ (let ((digits (cdr (assq 'special duration-format))))
+ (and digits
+ (or (wholenump digits)
+ (error "Unknown formatting directive: %S" digits))
+ (format "%%.%df" digits))))
+ (selected-units
+ (sort (cl-remove-if
+ ;; Ignore special format cells.
+ (lambda (pair) (pcase pair (`(special . ,_) t) (_ nil)))
+ duration-format)
+ (lambda (a b)
+ (> (org-duration--modifier (car a) canonical)
+ (org-duration--modifier (car b) canonical))))))
+ (cond
+ ;; Fractional duration: use first unit that is either required
+ ;; or smaller than MINUTES.
+ (fractional
+ (let* ((unit (car
+ (or (cl-find-if
+ (lambda (pair)
+ (pcase pair
+ (`(,u . ,req?)
+ (or req?
+ (<= (org-duration--modifier u canonical)
+ minutes)))))
+ selected-units)
+ ;; Fall back to smallest unit.
+ (org-last selected-units))))
+ (modifier (org-duration--modifier unit canonical)))
+ (concat (format fractional (/ (float minutes) modifier)) unit)))
+ ;; Otherwise build duration string according to available
+ ;; units.
+ ((org-string-nw-p
+ (org-trim
+ (mapconcat
+ (lambda (units)
+ (pcase-let* ((`(,unit . ,required?) units)
+ (modifier (org-duration--modifier unit canonical)))
+ (cond ((<= modifier minutes)
+ (let ((value (if (integerp modifier)
+ (/ (floor minutes) modifier)
+ (floor (/ minutes modifier)))))
+ (cl-decf minutes (* value modifier))
+ (format " %d%s" value unit)))
+ (required? (concat " 0" unit))
+ (t ""))))
+ selected-units
+ ""))))
+ ;; No unit can properly represent MINUTES. Use the smallest
+ ;; one anyway.
+ (t
+ (pcase-let ((`((,unit . ,_)) (last selected-units)))
+ (concat "0" unit))))))))
+
+;;;###autoload
+(defun org-duration-h:mm-only-p (times)
+ "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'."
+ (let (hms-flag)
+ (catch :exit
+ (dolist (time times)
+ (cond ((string-match-p org-duration--full-re time)
+ (throw :exit nil))
+ ((string-match-p org-duration--mixed-re time)
+ (throw :exit nil))
+ (hms-flag nil)
+ ((string-match-p org-duration--h:mm:ss-re time)
+ (setq hms-flag 'h:mm:ss))))
+ (or hms-flag 'h:mm))))
+
+
+;;; Initialization
+
+(org-duration-set-regexps)
+
+(provide 'org-duration)
+;;; org-duration.el ends here
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index e9731c17836..c5f656e09ea 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -1,4 +1,4 @@
-;;; org-element.el --- Parser And Applications for Org syntax
+;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
@@ -18,84 +18,25 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
-;; Org syntax can be divided into three categories: "Greater
-;; elements", "Elements" and "Objects".
+;; See <http://orgmode.org/worg/dev/org-syntax.html> for details about
+;; Org syntax.
;;
-;; Elements are related to the structure of the document. Indeed, all
-;; elements are a cover for the document: each position within belongs
-;; to at least one element.
-;;
-;; An element always starts and ends at the beginning of a line. With
-;; a few exceptions (`clock', `headline', `inlinetask', `item',
-;; `planning', `node-property', `quote-section' `section' and
-;; `table-row' types), it can also accept a fixed set of keywords as
-;; attributes. Those are called "affiliated keywords" to distinguish
-;; them from other keywords, which are full-fledged elements. Almost
-;; all affiliated keywords are referenced in
-;; `org-element-affiliated-keywords'; the others are export attributes
-;; and start with "ATTR_" prefix.
-;;
-;; Element containing other elements (and only elements) are called
-;; greater elements. Concerned types are: `center-block', `drawer',
-;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
-;; `item', `plain-list', `property-drawer', `quote-block', `section'
-;; and `special-block'.
-;;
-;; Other element types are: `babel-call', `clock', `comment',
-;; `comment-block', `diary-sexp', `example-block', `export-block',
-;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
-;; `node-property', `paragraph', `planning', `quote-section',
-;; `src-block', `table', `table-row' and `verse-block'. Among them,
-;; `paragraph' and `verse-block' types can contain Org objects and
-;; plain text.
-;;
-;; Objects are related to document's contents. Some of them are
-;; recursive. Associated types are of the following: `bold', `code',
-;; `entity', `export-snippet', `footnote-reference',
-;; `inline-babel-call', `inline-src-block', `italic',
-;; `latex-fragment', `line-break', `link', `macro', `radio-target',
-;; `statistics-cookie', `strike-through', `subscript', `superscript',
-;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
-;;
-;; Some elements also have special properties whose value can hold
-;; objects themselves (e.g. an item tag or a headline name). Such
-;; values are called "secondary strings". Any object belongs to
-;; either an element or a secondary string.
-;;
-;; Notwithstanding affiliated keywords, each greater element, element
-;; and object has a fixed set of properties attached to it. Among
-;; them, four are shared by all types: `:begin' and `:end', which
-;; refer to the beginning and ending buffer positions of the
-;; considered element or object, `:post-blank', which holds the number
-;; of blank lines, or white spaces, at its end and `:parent' which
-;; refers to the element or object containing it. Greater elements,
-;; elements and objects containing objects will also have
-;; `:contents-begin' and `:contents-end' properties to delimit
-;; contents. Eventually, greater elements and elements accepting
-;; affiliated keywords will have a `:post-affiliated' property,
-;; referring to the buffer position after all such keywords.
-;;
-;; At the lowest level, a `:parent' property is also attached to any
-;; string, as a text property.
-;;
-;; Lisp-wise, an element or an object can be represented as a list.
+;; Lisp-wise, a syntax object can be represented as a list.
;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
-;; TYPE is a symbol describing the Org element or object.
+;; TYPE is a symbol describing the object.
;; PROPERTIES is the property list attached to it. See docstring of
-;; appropriate parsing function to get an exhaustive
-;; list.
-;; CONTENTS is a list of elements, objects or raw strings contained
-;; in the current element or object, when applicable.
+;; appropriate parsing function to get an exhaustive list.
+;; CONTENTS is a list of syntax objects or raw strings contained
+;; in the current object, when applicable.
;;
-;; An Org buffer is a nested list of such elements and objects, whose
-;; type is `org-data' and properties is nil.
+;; For the whole document, TYPE is `org-data' and PROPERTIES is nil.
;;
-;; The first part of this file defines Org syntax, while the second
-;; one provide accessors and setters functions.
+;; The first part of this file defines constants for the Org syntax,
+;; while the second one provide accessors and setters functions.
;;
;; The next part implements a parser and an interpreter for each
;; element and object type in Org syntax.
@@ -111,13 +52,15 @@
;;
;; The library ends by furnishing `org-element-at-point' function, and
;; a way to give information about document structure around point
-;; with `org-element-context'.
+;; with `org-element-context'. A cache mechanism is also provided for
+;; these functions.
;;; Code:
-(eval-when-compile (require 'cl))
(require 'org)
+(require 'avl-tree)
+(require 'cl-lib)
@@ -127,56 +70,116 @@
;; along with the affiliated keywords recognized. Also set up
;; restrictions on recursive objects combinations.
;;
-;; These variables really act as a control center for the parsing
-;; process.
-
-(defconst org-element-paragraph-separate
- (concat "^\\(?:"
- ;; Headlines, inlinetasks.
- org-outline-regexp "\\|"
- ;; Footnote definitions.
- "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
- ;; Diary sexps.
- "%%(" "\\|"
- "[ \t]*\\(?:"
- ;; Empty lines.
- "$" "\\|"
- ;; Tables (any type).
- "\\(?:|\\|\\+-[-+]\\)" "\\|"
- ;; Blocks (any type), Babel calls and keywords. Note: this
- ;; is only an indication and need some thorough check.
- "#\\(?:[+ ]\\|$\\)" "\\|"
- ;; Drawers (any type) and fixed-width areas. This is also
- ;; only an indication.
- ":" "\\|"
- ;; Horizontal rules.
- "-\\{5,\\}[ \t]*$" "\\|"
- ;; LaTeX environments.
- "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|"
- ;; Planning and Clock lines.
- (regexp-opt (list org-scheduled-string
- org-deadline-string
- org-closed-string
- org-clock-string))
- "\\|"
- ;; Lists.
- (let ((term (case org-plain-list-ordered-item-terminator
- (?\) ")") (?. "\\.") (otherwise "[.)]")))
- (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
- (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
- "\\(?:[ \t]\\|$\\)"))
- "\\)\\)")
+;; `org-element-update-syntax' builds proper syntax regexps according
+;; to current setup.
+
+(defvar org-element-paragraph-separate nil
"Regexp to separate paragraphs in an Org buffer.
In the case of lines starting with \"#\" and \":\", this regexp
is not sufficient to know if point is at a paragraph ending. See
`org-element-paragraph-parser' for more information.")
+(defvar org-element--object-regexp nil
+ "Regexp possibly matching the beginning of an object.
+This regexp allows false positives. Dedicated parser (e.g.,
+`org-export-bold-parser') will take care of further filtering.
+Radio links are not matched by this regexp, as they are treated
+specially in `org-element--object-lex'.")
+
+(defun org-element--set-regexps ()
+ "Build variable syntax regexps."
+ (setq org-element-paragraph-separate
+ (concat "^\\(?:"
+ ;; Headlines, inlinetasks.
+ org-outline-regexp "\\|"
+ ;; Footnote definitions.
+ "\\[fn:[-_[:word:]]+\\]" "\\|"
+ ;; Diary sexps.
+ "%%(" "\\|"
+ "[ \t]*\\(?:"
+ ;; Empty lines.
+ "$" "\\|"
+ ;; Tables (any type).
+ "|" "\\|"
+ "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|"
+ ;; Comments, keyword-like or block-like constructs.
+ ;; Blocks and keywords with dual values need to be
+ ;; double-checked.
+ "#\\(?: \\|$\\|\\+\\(?:"
+ "BEGIN_\\S-+" "\\|"
+ "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)"
+ "\\|"
+ ;; Drawers (any type) and fixed-width areas. Drawers
+ ;; need to be double-checked.
+ ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|"
+ ;; Horizontal rules.
+ "-\\{5,\\}[ \t]*$" "\\|"
+ ;; LaTeX environments.
+ "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|"
+ ;; Clock lines.
+ (regexp-quote org-clock-string) "\\|"
+ ;; Lists.
+ (let ((term (pcase org-plain-list-ordered-item-terminator
+ (?\) ")") (?. "\\.") (_ "[.)]")))
+ (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
+ (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
+ "\\(?:[ \t]\\|$\\)"))
+ "\\)\\)")
+ org-element--object-regexp
+ (mapconcat #'identity
+ (let ((link-types (regexp-opt (org-link-types))))
+ (list
+ ;; Sub/superscript.
+ "\\(?:[_^][-{(*+.,[:alnum:]]\\)"
+ ;; Bold, code, italic, strike-through, underline
+ ;; and verbatim.
+ (concat "[*~=+_/]"
+ (format "[^%s]"
+ (nth 2 org-emphasis-regexp-components)))
+ ;; Plain links.
+ (concat "\\<" link-types ":")
+ ;; Objects starting with "[": regular link,
+ ;; footnote reference, statistics cookie,
+ ;; timestamp (inactive).
+ (concat "\\[\\(?:"
+ "fn:" "\\|"
+ "\\[" "\\|"
+ "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|"
+ "[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
+ "\\)")
+ ;; Objects starting with "@": export snippets.
+ "@@"
+ ;; Objects starting with "{": macro.
+ "{{{"
+ ;; Objects starting with "<" : timestamp
+ ;; (active, diary), target, radio target and
+ ;; angular links.
+ (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)")
+ ;; Objects starting with "$": latex fragment.
+ "\\$"
+ ;; Objects starting with "\": line break,
+ ;; entity, latex fragment.
+ "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)"
+ ;; Objects starting with raw text: inline Babel
+ ;; source block, inline Babel call.
+ "\\(?:call\\|src\\)_"))
+ "\\|")))
+
+(org-element--set-regexps)
+
+;;;###autoload
+(defun org-element-update-syntax ()
+ "Update parser internals."
+ (interactive)
+ (org-element--set-regexps)
+ (org-element-cache-reset 'all))
+
(defconst org-element-all-elements
'(babel-call center-block clock comment comment-block diary-sexp drawer
dynamic-block example-block export-block fixed-width
footnote-definition headline horizontal-rule inlinetask item
keyword latex-environment node-property paragraph plain-list
- planning property-drawer quote-block quote-section section
+ planning property-drawer quote-block section
special-block src-block table table-row verse-block)
"Complete list of element types.")
@@ -186,23 +189,6 @@ is not sufficient to know if point is at a paragraph ending. See
special-block table)
"List of recursive element types aka Greater Elements.")
-(defconst org-element-all-successors
- '(link export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break macro plain-link
- radio-target statistics-cookie sub/superscript table-cell target
- text-markup timestamp)
- "Complete list of successors.")
-
-(defconst org-element-object-successor-alist
- '((subscript . sub/superscript) (superscript . sub/superscript)
- (bold . text-markup) (code . text-markup) (italic . text-markup)
- (strike-through . text-markup) (underline . text-markup)
- (verbatim . text-markup) (entity . latex-or-entity)
- (latex-fragment . latex-or-entity))
- "Alist of translations between object type and successor name.
-Sharing the same successor comes handy when, for example, the
-regexp matching one object can also match the other object.")
-
(defconst org-element-all-objects
'(bold code entity export-snippet footnote-reference inline-babel-call
inline-src-block italic line-break latex-fragment link macro
@@ -211,26 +197,13 @@ regexp matching one object can also match the other object.")
"Complete list of object types.")
(defconst org-element-recursive-objects
- '(bold italic link subscript radio-target strike-through superscript
- table-cell underline)
+ '(bold footnote-reference italic link subscript radio-target strike-through
+ superscript table-cell underline)
"List of recursive object types.")
-(defvar org-element-block-name-alist
- '(("CENTER" . org-element-center-block-parser)
- ("COMMENT" . org-element-comment-block-parser)
- ("EXAMPLE" . org-element-example-block-parser)
- ("QUOTE" . org-element-quote-block-parser)
- ("SRC" . org-element-src-block-parser)
- ("VERSE" . org-element-verse-block-parser))
- "Alist between block names and the associated parsing function.
-Names must be uppercase. Any block whose name has no association
-is parsed with `org-element-special-block-parser'.")
-
-(defconst org-element-link-type-is-file
- '("file" "file+emacs" "file+sys" "docview")
- "List of link types equivalent to \"file\".
-Only these types can accept search options and an explicit
-application to open them.")
+(defconst org-element-object-containers
+ (append org-element-recursive-objects '(paragraph table-row verse-block))
+ "List of object or element types that can directly contain objects.")
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
@@ -268,6 +241,13 @@ strings and objects.
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
+(defconst org-element--parsed-properties-alist
+ (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k)))))
+ org-element-parsed-keywords)
+ "Alist of parsed keywords and associated properties.
+This is generated from `org-element-parsed-keywords', which
+see.")
+
(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
"List of affiliated keywords which can have a secondary value.
@@ -280,13 +260,8 @@ associated to a hash value with the following:
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
-(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
- "List of properties associated to the whole document.
-Any keyword in this list will have its value parsed and stored as
-a secondary string.")
-
(defconst org-element--affiliated-re
- (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)"
+ (format "[ \t]*#\\+\\(?:%s\\):[ \t]*"
(concat
;; Dual affiliated keywords.
(format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
@@ -295,9 +270,8 @@ a secondary string.")
;; Regular affiliated keywords.
(format "\\(?1:%s\\)"
(regexp-opt
- (org-remove-if
- #'(lambda (keyword)
- (member keyword org-element-dual-keywords))
+ (cl-remove-if
+ (lambda (k) (member k org-element-dual-keywords))
org-element-affiliated-keywords)))
"\\|"
;; Export attributes.
@@ -311,8 +285,7 @@ match group 2.
Don't modify it, set `org-element-affiliated-keywords' instead.")
(defconst org-element-object-restrictions
- (let* ((standard-set
- (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (let* ((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)
@@ -320,30 +293,33 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(inlinetask ,@standard-set-no-line-break)
(italic ,@standard-set)
(item ,@standard-set-no-line-break)
- (keyword ,@standard-set)
- ;; Ignore all links excepted plain links in a link description.
- ;; Also ignore radio-targets and line breaks.
- (link export-snippet inline-babel-call inline-src-block latex-or-entity
- macro plain-link statistics-cookie sub/superscript text-markup)
+ (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)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
;; prevent it from being properly recognized.
- (radio-target latex-or-entity sub/superscript text-markup)
+ (radio-target bold code entity italic latex-fragment strike-through
+ subscript superscript underline superscript)
(strike-through ,@standard-set)
(subscript ,@standard-set)
(superscript ,@standard-set)
;; Ignore inline babel call and inline src block as formulas are
;; possible. Also ignore line breaks and statistics cookies.
- (table-cell link export-snippet footnote-reference latex-or-entity macro
- radio-target sub/superscript target text-markup timestamp)
+ (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-row table-cell)
(underline ,@standard-set)
(verse-block ,@standard-set)))
"Alist of objects restrictions.
-CAR is an element or object type containing objects and CDR is
-a list of successors that will be called within an element or
-object of such type.
+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
@@ -354,12 +330,56 @@ This alist also applies to secondary string. For example, an
still has an entry since one of its properties (`:title') does.")
(defconst org-element-secondary-value-alist
- '((headline . :title)
- (inlinetask . :title)
- (item . :tag)
- (footnote-reference . :inline-definition))
- "Alist between element types and location of secondary value.")
-
+ '((headline :title)
+ (inlinetask :title)
+ (item :tag))
+ "Alist between element types and locations of secondary values.")
+
+(defconst org-element--pair-round-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\( "()" table)
+ (modify-syntax-entry ?\) ")(" table)
+ (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table)
+ (modify-syntax-entry char " " table)))
+ "Table used internally to pair only round brackets.
+Other brackets are treated as spaces.")
+
+(defconst org-element--pair-square-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\[ "(]" table)
+ (modify-syntax-entry ?\] ")[" table)
+ (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table)
+ (modify-syntax-entry char " " table)))
+ "Table used internally to pair only square brackets.
+Other brackets are treated as spaces.")
+
+(defconst org-element--pair-curly-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\{ "(}" table)
+ (modify-syntax-entry ?\} "){" table)
+ (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table)
+ (modify-syntax-entry char " " table)))
+ "Table used internally to pair only curly brackets.
+Other brackets are treated as spaces.")
+
+(defun org-element--parse-paired-brackets (char)
+ "Parse paired brackets at point.
+CHAR is the opening bracket to consider, as a character. Return
+contents between brackets, as a string, or nil. Also move point
+past the brackets."
+ (when (eq char (char-after))
+ (let ((syntax-table (pcase char
+ (?\{ org-element--pair-curly-table)
+ (?\[ org-element--pair-square-table)
+ (?\( org-element--pair-round-table)
+ (_ nil)))
+ (pos (point)))
+ (when syntax-table
+ (with-syntax-table syntax-table
+ (let ((end (ignore-errors (scan-lists pos 1 0))))
+ (when end
+ (goto-char end)
+ (buffer-substring-no-properties (1+ pos) (1- end)))))))))
;;; Accessors and Setters
@@ -368,10 +388,18 @@ still has an entry since one of its properties (`:title') does.")
;; `org-element-contents' and `org-element-restriction'.
;;
;; Setter functions allow modification of elements by side effect.
-;; There is `org-element-put-property', `org-element-set-contents',
-;; `org-element-set-element' and `org-element-adopt-element'. Note
-;; that `org-element-set-element' and `org-element-adopt-elements' are
-;; higher level functions since also update `:parent' property.
+;; There is `org-element-put-property', `org-element-set-contents'.
+;; These low-level functions are useful to build a parse tree.
+;;
+;; `org-element-adopt-elements', `org-element-set-element',
+;; `org-element-extract-element' and `org-element-insert-before' are
+;; high-level functions useful to modify a parse tree.
+;;
+;; `org-element-secondary-p' is a predicate used to know if a given
+;; object belongs to a secondary string. `org-element-class' tells if
+;; some parsed data is an element or an object, handling pseudo
+;; elements and objects. `org-element-copy' returns an element or
+;; object, stripping its parent property in the process.
(defsubst org-element-type (element)
"Return type of ELEMENT.
@@ -411,29 +439,49 @@ Return modified element."
element))
(defsubst org-element-set-contents (element &rest contents)
- "Set ELEMENT contents to CONTENTS.
-Return modified element."
- (cond ((not element) (list contents))
+ "Set ELEMENT's contents to CONTENTS.
+Return ELEMENT."
+ (cond ((null element) contents)
((not (symbolp (car element))) contents)
- ((cdr element) (setcdr (cdr element) contents))
+ ((cdr element) (setcdr (cdr element) contents) element)
(t (nconc element contents))))
-(defsubst org-element-set-element (old new)
- "Replace element or object OLD with element or object NEW.
-The function takes care of setting `:parent' property for NEW."
- ;; Since OLD is going to be changed into NEW by side-effect, first
- ;; make sure that every element or object within NEW has OLD as
- ;; parent.
- (mapc (lambda (blob) (org-element-put-property blob :parent old))
- (org-element-contents new))
- ;; Transfer contents.
- (apply 'org-element-set-contents old (org-element-contents new))
- ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
- ;; with NEW's.
- (org-element-put-property new :parent (org-element-property :parent old))
- (setcar (cdr old) (nth 1 new))
- ;; Transfer type.
- (setcar old (car new)))
+(defun org-element-secondary-p (object)
+ "Non-nil when OBJECT directly belongs to a secondary string.
+Return value is the property name, as a keyword, or nil."
+ (let* ((parent (org-element-property :parent object))
+ (properties (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))))
+ (catch 'exit
+ (dolist (p properties)
+ (and (memq object (org-element-property p parent))
+ (throw 'exit p))))))
+
+(defsubst org-element-class (datum &optional parent)
+ "Return class for ELEMENT, as a symbol.
+Class is either `element' or `object'. Optional argument PARENT
+is the element or object containing DATUM. It defaults to the
+value of DATUM `:parent' property."
+ (let ((type (org-element-type datum))
+ (parent (or parent (org-element-property :parent datum))))
+ (cond
+ ;; Trivial cases.
+ ((memq type org-element-all-objects) 'object)
+ ((memq type org-element-all-elements) 'element)
+ ;; Special cases.
+ ((eq type 'org-data) 'element)
+ ((eq type 'plain-text) 'object)
+ ((not type) 'object)
+ ;; Pseudo object or elements. Make a guess about its class.
+ ;; Basically a pseudo object is contained within another object,
+ ;; a secondary string or a container element.
+ ((not parent) 'element)
+ (t
+ (let ((parent-type (org-element-type parent)))
+ (cond ((not parent-type) 'object)
+ ((memq parent-type org-element-object-containers) 'object)
+ ((org-element-secondary-p datum) 'object)
+ (t 'element)))))))
(defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element.
@@ -443,18 +491,108 @@ objects, or a strings.
The function takes care of setting `:parent' property for CHILD.
Return parent element."
- ;; Link every child to PARENT. If PARENT is nil, it is a secondary
- ;; string: parent is the list itself.
- (mapc (lambda (child)
- (org-element-put-property child :parent (or parent children)))
- children)
- ;; Add CHILDREN at the end of PARENT contents.
- (when parent
- (apply 'org-element-set-contents
- parent
- (nconc (org-element-contents parent) children)))
- ;; Return modified PARENT element.
- (or parent children))
+ (if (not children) parent
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (dolist (child children)
+ (org-element-put-property child :parent (or parent children)))
+ ;; Add CHILDREN at the end of PARENT contents.
+ (when parent
+ (apply #'org-element-set-contents
+ parent
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children)))
+
+(defun org-element-extract-element (element)
+ "Extract ELEMENT from parse tree.
+Remove element from the parse tree by side-effect, and return it
+with its `:parent' property stripped out."
+ (let ((parent (org-element-property :parent element))
+ (secondary (org-element-secondary-p element)))
+ (if secondary
+ (org-element-put-property
+ parent secondary
+ (delq element (org-element-property secondary parent)))
+ (apply #'org-element-set-contents
+ parent
+ (delq element (org-element-contents parent))))
+ ;; Return ELEMENT with its :parent removed.
+ (org-element-put-property element :parent nil)))
+
+(defun org-element-insert-before (element location)
+ "Insert ELEMENT before LOCATION in parse tree.
+LOCATION is an element, object or string within the parse tree.
+Parse tree is modified by side effect."
+ (let* ((parent (org-element-property :parent location))
+ (property (org-element-secondary-p location))
+ (siblings (if property (org-element-property property parent)
+ (org-element-contents parent)))
+ ;; Special case: LOCATION is the first element of an
+ ;; independent secondary string (e.g. :title property). Add
+ ;; ELEMENT in-place.
+ (specialp (and (not property)
+ (eq siblings parent)
+ (eq (car parent) location))))
+ ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS.
+ (cond (specialp)
+ ((or (null siblings) (eq (car siblings) location))
+ (push element siblings))
+ ((null location) (nconc siblings (list element)))
+ (t
+ (let ((index (cl-position location siblings)))
+ (unless index (error "No location found to insert element"))
+ (push element (cdr (nthcdr (1- index) siblings))))))
+ ;; Store SIBLINGS at appropriate place in parse tree.
+ (cond
+ (specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
+ (property (org-element-put-property parent property siblings))
+ (t (apply #'org-element-set-contents parent siblings)))
+ ;; Set appropriate :parent property.
+ (org-element-put-property element :parent parent)))
+
+(defun org-element-set-element (old new)
+ "Replace element or object OLD with element or object NEW.
+The function takes care of setting `:parent' property for NEW."
+ ;; Ensure OLD and NEW have the same parent.
+ (org-element-put-property new :parent (org-element-property :parent old))
+ (if (or (memq (org-element-type old) '(plain-text nil))
+ (memq (org-element-type new) '(plain-text nil)))
+ ;; We cannot replace OLD with NEW since one of them is not an
+ ;; object or element. We take the long path.
+ (progn (org-element-insert-before new old)
+ (org-element-extract-element old))
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (dolist (blob (org-element-contents new))
+ (org-element-put-property blob :parent old))
+ ;; Transfer contents.
+ (apply #'org-element-set-contents old (org-element-contents new))
+ ;; Overwrite OLD's properties with NEW's.
+ (setcar (cdr old) (nth 1 new))
+ ;; Transfer type.
+ (setcar old (car new))))
+
+(defun org-element-create (type &optional props &rest children)
+ "Create a new element of type TYPE.
+Optional argument PROPS, when non-nil, is a plist defining the
+properties of the element. CHILDREN can be elements, objects or
+strings."
+ (apply #'org-element-adopt-elements (list type props) children))
+
+(defun org-element-copy (datum)
+ "Return a copy of DATUM.
+DATUM is an element, object, string or nil. `:parent' property
+is cleared and contents are removed in the process."
+ (when datum
+ (let ((type (org-element-type datum)))
+ (pcase type
+ (`org-data (list 'org-data nil))
+ (`plain-text (substring-no-properties datum))
+ (`nil (copy-sequence datum))
+ (_
+ (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))))))
@@ -467,7 +605,7 @@ Return parent element."
;; Most of them accepts no argument. Though, exceptions exist. Hence
;; every element containing a secondary string (see
;; `org-element-secondary-value-alist') will accept an optional
-;; argument to toggle parsing of that secondary string. Moreover,
+;; argument to toggle parsing of these secondary strings. Moreover,
;; `item' parser requires current list's structure as its first
;; element.
;;
@@ -503,8 +641,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `center-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -520,7 +658,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -531,15 +668,14 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated))))))))
-(defun org-element-center-block-interpreter (center-block contents)
- "Interpret CENTER-BLOCK element as Org syntax.
+(defun org-element-center-block-interpreter (_ contents)
+ "Interpret a center-block element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
@@ -555,7 +691,7 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `drawer' and CDR is a plist containing
-`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
+`:drawer-name', `:begin', `:end', `:contents-begin',
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
@@ -566,7 +702,7 @@ Assume point is at beginning of drawer."
(save-excursion
(let* ((drawer-end-line (match-beginning 0))
(name (progn (looking-at org-drawer-regexp)
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
;; Empty drawers have no contents.
@@ -574,7 +710,6 @@ Assume point is at beginning of drawer."
(and (< (point) drawer-end-line)
(point))))
(contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char drawer-end-line)
(forward-line)
(point)))
@@ -585,7 +720,6 @@ Assume point is at beginning of drawer."
(list :begin begin
:end end
:drawer-name name
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -611,9 +745,9 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `dynamic-block' and CDR is a plist
-containing `:block-name', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:arguments', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:block-name', `:begin', `:end', `:contents-begin',
+`:contents-end', `:arguments', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
@@ -624,8 +758,8 @@ Assume point is at beginning of dynamic block."
(let ((block-end-line (match-beginning 0)))
(save-excursion
(let* ((name (progn (looking-at org-dblock-start-re)
- (org-match-string-no-properties 1)))
- (arguments (org-match-string-no-properties 3))
+ (match-string-no-properties 1)))
+ (arguments (match-string-no-properties 3))
(begin (car affiliated))
(post-affiliated (point))
;; Empty blocks have no contents.
@@ -633,7 +767,6 @@ Assume point is at beginning of dynamic block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -645,7 +778,6 @@ Assume point is at beginning of dynamic block."
:end end
:block-name name
:arguments arguments
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -658,12 +790,18 @@ CONTENTS is the contents of the element."
(format "#+BEGIN: %s%s\n%s#+END:"
(org-element-property :block-name dynamic-block)
(let ((args (org-element-property :arguments dynamic-block)))
- (and args (concat " " args)))
+ (if args (concat " " args) ""))
contents))
;;;; Footnote Definition
+(defconst org-element--footnote-separator
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^\\([ \t]*\n\\)\\{2,\\}")
+ "Regexp used as a footnote definition separator.")
+
(defun org-element-footnote-definition-parser (limit affiliated)
"Parse a footnote definition.
@@ -679,59 +817,104 @@ a plist containing `:label', `:begin' `:end', `:contents-begin',
Assume point is at the beginning of the footnote definition."
(save-excursion
(let* ((label (progn (looking-at org-footnote-definition-re)
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
- (ending (save-excursion
- (if (progn
- (end-of-line)
- (re-search-forward
- (concat org-outline-regexp-bol "\\|"
- org-footnote-definition-re "\\|"
- "^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
- (match-beginning 0)
- (point))))
- (contents-begin (progn
- (search-forward "]")
- (skip-chars-forward " \r\t\n" ending)
- (cond ((= (point) ending) nil)
- ((= (line-beginning-position) begin) (point))
- (t (line-beginning-position)))))
- (contents-end (and contents-begin ending))
- (end (progn (goto-char ending)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
+ (end
+ (save-excursion
+ (end-of-line)
+ (cond
+ ((not
+ (re-search-forward org-element--footnote-separator limit t))
+ limit)
+ ((eq ?\[ (char-after (match-beginning 0)))
+ ;; At a new footnote definition, make sure we end
+ ;; before any affiliated keyword above.
+ (forward-line -1)
+ (while (and (> (point) post-affiliated)
+ (looking-at-p org-element--affiliated-re))
+ (forward-line -1))
+ (line-beginning-position 2))
+ ((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
+ (t (skip-chars-forward " \r\t\n" limit)
+ (if (= limit (point)) limit (line-beginning-position))))))
+ (contents-begin
+ (progn (search-forward "]")
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ((= (line-beginning-position) post-affiliated) (point))
+ (t (line-beginning-position)))))
+ (contents-end
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
(list 'footnote-definition
(nconc
(list :label label
:begin begin
:end end
:contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines ending end)
+ :contents-end (and contents-begin contents-end)
+ :post-blank (count-lines contents-end end)
:post-affiliated post-affiliated)
(cdr affiliated))))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
CONTENTS is the contents of the footnote-definition."
- (concat (format "[%s]" (org-element-property :label footnote-definition))
+ (concat (format "[fn:%s]" (org-element-property :label footnote-definition))
" "
contents))
;;;; Headline
+(defun org-element--get-node-properties ()
+ "Return node properties associated to headline at point.
+Upcase property names. It avoids confusion between properties
+obtained through property drawer and default properties from the
+parser (e.g. `:end' and :END:). Return value is a plist."
+ (save-excursion
+ (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (forward-line)
+ (let ((end (match-end 0)) properties)
+ (while (< (line-end-position) end)
+ (looking-at org-property-re)
+ (push (match-string-no-properties 3) properties)
+ (push (intern (concat ":" (upcase (match-string 2)))) properties)
+ (forward-line))
+ properties))))
+
+(defun org-element--get-time-properties ()
+ "Return time properties associated to headline at point.
+Return value is a plist."
+ (save-excursion
+ (when (progn (forward-line) (looking-at org-planning-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
+
(defun org-element-headline-parser (limit &optional raw-secondary-p)
"Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
-containing `:raw-value', `:title', `:alt-title', `:begin',
-`:end', `:pre-blank', `:hiddenp', `:contents-begin',
-`:contents-end', `:level', `:priority', `:tags',
-`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
-`:closed', `:quotedp', `:archivedp', `:commentedp',
-`:footnote-section-p' and `:post-blank' keywords.
+containing `:raw-value', `:title', `:begin', `:end',
+`:pre-blank', `:contents-begin' and `:contents-end', `:level',
+`:priority', `:tags', `:todo-keyword',`:todo-type', `:scheduled',
+`:deadline', `:closed', `:archivedp', `:commentedp'
+`:footnote-section-p', `:post-blank' and `:post-affiliated'
+keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -744,80 +927,46 @@ parsed as a secondary string, but as a plain string instead.
Assume point is at beginning of the headline."
(save-excursion
- (let* ((components (org-heading-components))
- (level (nth 1 components))
- (todo (nth 2 components))
+ (let* ((begin (point))
+ (level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t")))
+ (todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0))))
(todo-type
(and todo (if (member todo org-done-keywords) 'done 'todo)))
- (tags (let ((raw-tags (nth 5 components)))
- (and raw-tags (org-split-string raw-tags ":"))))
- (raw-value (or (nth 4 components) ""))
- (quotedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-quote-string)
- raw-value)))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
(commentedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-comment-string)
- raw-value)))
+ (and (let (case-fold-search) (looking-at org-comment-string))
+ (goto-char (match-end 0))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":")))
+ (title-end (point))
+ (raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end)))
(archivedp (member org-archive-tag tags))
(footnote-section-p (and org-footnote-section
(string= org-footnote-section raw-value)))
- ;; Upcase property names. It avoids confusion between
- ;; properties obtained through property drawer and default
- ;; properties from the parser (e.g. `:end' and :END:)
- (standard-props
- (let (plist)
- (mapc
- (lambda (p)
- (setq plist
- (plist-put plist
- (intern (concat ":" (upcase (car p))))
- (cdr p))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props
- ;; Read time properties on the line below the headline.
- (save-excursion
- (when (progn (forward-line)
- (looking-at org-planning-or-clock-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward
- org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t")
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
- (setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
- (setq plist (plist-put plist :deadline time)))
- (t (setq plist (plist-put plist :closed time))))))
- plist))))
- (begin (point))
+ (standard-props (org-element--get-node-properties))
+ (time-props (org-element--get-time-properties))
(end (min (save-excursion (org-end-of-subtree t t)) limit))
- (pos-after-head (progn (forward-line) (point)))
(contents-begin (save-excursion
+ (forward-line)
(skip-chars-forward " \r\t\n" end)
(and (/= (point) end) (line-beginning-position))))
- (hidden (org-invisible-p2))
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))))
- ;; Clean RAW-VALUE from any quote or comment string.
- (when (or quotedp commentedp)
- (let ((case-fold-search nil))
- (setq raw-value
- (replace-regexp-in-string
- (concat
- (regexp-opt (list org-quote-string org-comment-string))
- "\\(?: \\|$\\)")
- ""
- raw-value))))
- ;; Clean TAGS from archive tag, if any.
- (when archivedp (setq tags (delete org-archive-tag tags)))
+ (line-beginning-position 2)))))
(let ((headline
(list 'headline
(nconc
@@ -826,36 +975,37 @@ Assume point is at beginning of the headline."
:end end
:pre-blank
(if (not contents-begin) 0
- (count-lines pos-after-head contents-begin))
- :hiddenp hidden
+ (1- (count-lines begin contents-begin)))
:contents-begin contents-begin
:contents-end contents-end
:level level
- :priority (nth 3 components)
+ :priority priority
:tags tags
:todo-keyword todo
:todo-type todo-type
- :post-blank (count-lines
- (or contents-end pos-after-head)
- end)
+ :post-blank
+ (if contents-end
+ (count-lines contents-end end)
+ (1- (count-lines begin end)))
:footnote-section-p footnote-section-p
:archivedp archivedp
:commentedp commentedp
- :quotedp quotedp)
+ :post-affiliated begin)
time-props
standard-props))))
- (let ((alt-title (org-element-property :ALT_TITLE headline)))
- (when alt-title
- (org-element-put-property
- headline :alt-title
- (if raw-secondary-p alt-title
- (org-element-parse-secondary-string
- alt-title (org-element-restriction 'headline) headline)))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
- (org-element-parse-secondary-string
- raw-value (org-element-restriction 'headline) headline)))))))
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'headline)
+ headline)))))))
(defun org-element-headline-interpreter (headline contents)
"Interpret HEADLINE element as Org syntax.
@@ -865,22 +1015,17 @@ CONTENTS is the contents of the element."
(priority (org-element-property :priority headline))
(title (org-element-interpret-data
(org-element-property :title headline)))
- (tags (let ((tag-list (if (org-element-property :archivedp headline)
- (cons org-archive-tag
- (org-element-property :tags headline))
- (org-element-property :tags headline))))
+ (tags (let ((tag-list (org-element-property :tags headline)))
(and tag-list
(format ":%s:" (mapconcat #'identity tag-list ":")))))
(commentedp (org-element-property :commentedp headline))
- (quotedp (org-element-property :quotedp headline))
(pre-blank (or (org-element-property :pre-blank headline) 0))
(heading
(concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
?*)
(and todo (concat " " todo))
- (and quotedp (concat " " org-quote-string))
(and commentedp (concat " " org-comment-string))
- (and priority (format " [#%s]" (char-to-string priority)))
+ (and priority (format " [#%c]" priority))
" "
(if (and org-footnote-section
(org-element-property :footnote-section-p headline))
@@ -912,10 +1057,11 @@ CONTENTS is the contents of the element."
"Parse an inline task.
Return a list whose CAR is `inlinetask' and CDR is a plist
-containing `:title', `:begin', `:end', `:hiddenp',
+containing `:title', `:begin', `:end', `:pre-blank',
`:contents-begin' and `:contents-end', `:level', `:priority',
`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
+`:scheduled', `:deadline', `:closed', `:post-blank' and
+`:post-affiliated' keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -928,59 +1074,45 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
(let* ((begin (point))
- (components (org-heading-components))
- (todo (nth 2 components))
+ (level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t")))
+ (todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0))))
(todo-type (and todo
(if (member todo org-done-keywords) 'done 'todo)))
- (tags (let ((raw-tags (nth 5 components)))
- (and raw-tags (org-split-string raw-tags ":"))))
- (raw-value (or (nth 4 components) ""))
- ;; Upcase property names. It avoids confusion between
- ;; properties obtained through property drawer and default
- ;; properties from the parser (e.g. `:end' and :END:)
- (standard-props
- (let (plist)
- (mapc
- (lambda (p)
- (setq plist
- (plist-put plist
- (intern (concat ":" (upcase (car p))))
- (cdr p))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props
- ;; Read time properties on the line below the inlinetask
- ;; opening string.
- (save-excursion
- (when (progn (forward-line)
- (looking-at org-planning-or-clock-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward
- org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t")
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
- (setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
- (setq plist (plist-put plist :deadline time)))
- (t (setq plist (plist-put plist :closed time))))))
- plist))))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":")))
+ (title-end (point))
+ (raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end)))
(task-end (save-excursion
(end-of-line)
(and (re-search-forward org-outline-regexp-bol limit t)
- (org-looking-at-p "END[ \t]*$")
+ (looking-at-p "[ \t]*END[ \t]*$")
(line-beginning-position))))
- (contents-begin (progn (forward-line)
- (and task-end (< (point) task-end) (point))))
- (hidden (and contents-begin (org-invisible-p2)))
+ (standard-props (and task-end (org-element--get-node-properties)))
+ (time-props (and task-end (org-element--get-time-properties)))
+ (contents-begin (and task-end
+ (< (point) task-end)
+ (progn
+ (forward-line)
+ (skip-chars-forward " \t\n")
+ (line-beginning-position))))
(contents-end (and contents-begin task-end))
- (before-blank (if (not task-end) (point)
- (goto-char task-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
+ (end (progn (when task-end (goto-char task-end))
+ (forward-line)
+ (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position))))
(inlinetask
(list 'inlinetask
@@ -988,22 +1120,31 @@ Assume point is at beginning of the inline task."
(list :raw-value raw-value
:begin begin
:end end
- :hiddenp hidden
+ :pre-blank
+ (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
:contents-begin contents-begin
:contents-end contents-end
- :level (nth 1 components)
- :priority (nth 3 components)
+ :level level
+ :priority priority
:tags tags
:todo-keyword todo
:todo-type todo-type
- :post-blank (count-lines before-blank end))
+ :post-blank (1- (count-lines (or task-end begin) end))
+ :post-affiliated begin)
time-props
standard-props))))
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
- (org-element-parse-secondary-string
- raw-value
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
(org-element-restriction 'inlinetask)
inlinetask))))))
@@ -1020,8 +1161,7 @@ CONTENTS is the contents of inlinetask."
(format ":%s:" (mapconcat 'identity tag-list ":")))))
(task (concat (make-string level ?*)
(and todo (concat " " todo))
- (and priority
- (format " [#%s]" (char-to-string priority)))
+ (and priority (format " [#%c]" priority))
(and title (concat " " title)))))
(concat task
;; Align tags.
@@ -1048,15 +1188,15 @@ CONTENTS is the contents of inlinetask."
;;;; Item
-(defun org-element-item-parser (limit struct &optional raw-secondary-p)
+(defun org-element-item-parser (_ struct &optional raw-secondary-p)
"Parse an item.
STRUCT is the structure of the plain list.
Return a list whose CAR is `item' and CDR is a plist containing
`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
-`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
-`:post-blank' keywords.
+`:checkbox', `:counter', `:tag', `:structure', `:post-blank' and
+`:post-affiliated' keywords.
When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
any, will not be parsed as a secondary string, but as a plain
@@ -1067,12 +1207,12 @@ Assume point is at the beginning of the item."
(beginning-of-line)
(looking-at org-list-full-item-re)
(let* ((begin (point))
- (bullet (org-match-string-no-properties 1))
- (checkbox (let ((box (org-match-string-no-properties 3)))
+ (bullet (match-string-no-properties 1))
+ (checkbox (let ((box (match-string 3)))
(cond ((equal "[ ]" box) 'off)
((equal "[X]" box) 'on)
((equal "[-]" box) 'trans))))
- (counter (let ((c (org-match-string-no-properties 2)))
+ (counter (let ((c (match-string 2)))
(save-match-data
(cond
((not c) nil)
@@ -1081,9 +1221,8 @@ Assume point is at the beginning of the item."
64))
((string-match "[0-9]+" c)
(string-to-number (match-string 0 c)))))))
- (end (save-excursion (goto-char (org-list-get-item-end begin struct))
- (unless (bolp) (forward-line))
- (point)))
+ (end (progn (goto-char (nth 6 (assq (point) struct)))
+ (if (bolp) (point) (line-beginning-position 2))))
(contents-begin
(progn (goto-char
;; Ignore tags in un-ordered lists: they are just
@@ -1092,40 +1231,37 @@ Assume point is at the beginning of the item."
(save-match-data (string-match "[.)]" bullet)))
(match-beginning 4)
(match-end 0)))
- (skip-chars-forward " \r\t\n" limit)
- ;; If first line isn't empty, contents really start
- ;; at the text after item's meta-data.
- (if (= (point-at-bol) begin) (point) (point-at-bol))))
- (hidden (progn (forward-line)
- (and (not (= (point) end)) (org-invisible-p2))))
- (contents-end (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ;; If first line isn't empty, contents really
+ ;; start at the text after item's meta-data.
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
+ (contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
(item
(list 'item
(list :bullet bullet
:begin begin
:end end
- ;; CONTENTS-BEGIN and CONTENTS-END may be
- ;; mixed up in the case of an empty item
- ;; separated from the next by a blank line.
- ;; Thus ensure the former is always the
- ;; smallest.
- :contents-begin (min contents-begin contents-end)
- :contents-end (max contents-begin contents-end)
+ :contents-begin contents-begin
+ :contents-end contents-end
:checkbox checkbox
:counter counter
- :hiddenp hidden
:structure struct
- :post-blank (count-lines contents-end end)))))
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin))))
(org-element-put-property
item :tag
- (let ((raw-tag (org-list-get-tag begin struct)))
- (and raw-tag
- (if raw-secondary-p raw-tag
- (org-element-parse-secondary-string
- raw-tag (org-element-restriction 'item) item))))))))
+ (let ((raw (org-list-get-tag begin struct)))
+ (when raw
+ (if raw-secondary-p raw
+ (org-element--parse-objects
+ (match-beginning 4) (match-end 4) nil
+ (org-element-restriction 'item)
+ item))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1148,10 +1284,11 @@ CONTENTS is the contents of the element."
(concat
bullet
(and counter (format "[@%d] " counter))
- (case checkbox
- (on "[X] ")
- (off "[ ] ")
- (trans "[-] "))
+ (pcase checkbox
+ (`on "[X] ")
+ (`off "[ ] ")
+ (`trans "[-] ")
+ (_ nil))
(and tag (format "%s :: " tag))
(when contents
(let ((contents (replace-regexp-in-string
@@ -1168,29 +1305,22 @@ CONTENTS is the contents of the element."
(let ((case-fold-search t)
(top-ind limit)
(item-re (org-item-re))
- (drawers-re (concat ":\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
items struct)
(save-excursion
- (catch 'exit
+ (catch :exit
(while t
(cond
;; At limit: end all items.
((>= (point) limit)
- (throw 'exit
- (let ((end (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point))))
- (dolist (item items (sort (nconc items struct)
- 'car-less-than-car))
- (setcar (nthcdr 6 item) end)))))
+ (let ((end (progn (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
+ (dolist (item items) (setcar (nthcdr 6 item) end)))
+ (throw :exit (sort (nconc items struct) #'car-less-than-car)))
;; At list end: end all items.
((looking-at org-list-end-re)
- (throw 'exit (dolist (item items (sort (nconc items struct)
- 'car-less-than-car))
- (setcar (nthcdr 6 item) (point)))))
+ (dolist (item items) (setcar (nthcdr 6 item) (point)))
+ (throw :exit (sort (nconc items struct) #'car-less-than-car)))
;; At a new item: end previous sibling.
((looking-at item-re)
(let ((ind (save-excursion (skip-chars-forward " \t")
@@ -1214,7 +1344,7 @@ CONTENTS is the contents of the element."
;; Ending position, unknown so far.
nil)))
items))
- (forward-line 1))
+ (forward-line))
;; Skip empty lines.
((looking-at "^[ \t]*$") (forward-line))
;; Skip inline tasks and blank lines along the way.
@@ -1222,28 +1352,29 @@ CONTENTS is the contents of the element."
(forward-line)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
- (if (org-looking-at-p "END[ \t]*$") (forward-line)
+ (if (looking-at-p "END[ \t]*$") (forward-line)
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (when (<= ind top-ind)
- (skip-chars-backward " \r\t\n")
- (forward-line))
+ (let ((ind (save-excursion
+ (skip-chars-forward " \t")
+ (current-column)))
+ (end (save-excursion
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
(while (<= ind (nth 1 (car items)))
(let ((item (pop items)))
- (setcar (nthcdr 6 item) (line-beginning-position))
+ (setcar (nthcdr 6 item) end)
(push item struct)
(unless items
- (throw 'exit (sort struct 'car-less-than-car))))))
+ (throw :exit (sort struct #'car-less-than-car))))))
;; Skip blocks (any type) and drawers contents.
(cond
- ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
- (format "^[ \t]*#\\+END%s[ \t]*$"
- (org-match-string-no-properties 1))
+ (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
- ((and (looking-at drawers-re)
+ ((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
(forward-line))))))))
@@ -1264,15 +1395,20 @@ containing `:type', `:begin', `:end', `:contents-begin' and
Assume point is at the beginning of the list."
(save-excursion
(let* ((struct (or structure (org-element--list-struct limit)))
- (prevs (org-list-prevs-alist struct))
- (type (org-list-get-list-type (point) struct prevs))
+ (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ ((nth 5 (assq (point) struct)) 'descriptive)
+ (t 'unordered)))
(contents-begin (point))
(begin (car affiliated))
- (contents-end
- (progn (goto-char (org-list-get-list-end (point) struct prevs))
- (unless (bolp) (forward-line))
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
+ (contents-end (let* ((item (assq contents-begin struct))
+ (ind (nth 1 item))
+ (pos (nth 6 item)))
+ (while (and (setq item (assq pos struct))
+ (= (nth 1 item) ind))
+ (setq pos (nth 6 item)))
+ pos))
+ (end (progn (goto-char contents-end)
+ (skip-chars-forward " \r\t\n" limit)
(if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
(list 'plain-list
@@ -1287,8 +1423,8 @@ Assume point is at the beginning of the list."
:post-affiliated contents-begin)
(cdr affiliated))))))
-(defun org-element-plain-list-interpreter (plain-list contents)
- "Interpret PLAIN-LIST element as Org syntax.
+(defun org-element-plain-list-interpreter (_ contents)
+ "Interpret plain-list element as Org syntax.
CONTENTS is the contents of the element."
(with-temp-buffer
(insert contents)
@@ -1299,52 +1435,36 @@ CONTENTS is the contents of the element."
;;;; Property Drawer
-(defun org-element-property-drawer-parser (limit affiliated)
+(defun org-element-property-drawer-parser (limit)
"Parse a property drawer.
-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 `property-drawer' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+Return a list whose car is `property-drawer' and cdr is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
- (let ((case-fold-search t))
- (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
- ;; Incomplete drawer: parse it as a paragraph.
- (org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((drawer-end-line (match-beginning 0))
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin
- (progn
- (forward-line)
- (and (re-search-forward org-property-re drawer-end-line t)
- (line-beginning-position))))
- (contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'property-drawer
- (nconc
- (list :begin begin
- :end end
- :hiddenp hidden
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
-
-(defun org-element-property-drawer-interpreter (property-drawer contents)
- "Interpret PROPERTY-DRAWER element as Org syntax.
+ (save-excursion
+ (let ((case-fold-search t)
+ (begin (point))
+ (contents-begin (line-beginning-position 2)))
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
+ (let ((contents-end (and (> (match-beginning 0) contents-begin)
+ (match-beginning 0)))
+ (before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'property-drawer
+ (list :begin begin
+ :end end
+ :contents-begin (and contents-end contents-begin)
+ :contents-end contents-end
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin))))))
+
+(defun org-element-property-drawer-interpreter (_ contents)
+ "Interpret property-drawer element as Org syntax.
CONTENTS is the properties within the drawer."
(format ":PROPERTIES:\n%s:END:" contents))
@@ -1360,8 +1480,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `quote-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -1378,7 +1498,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1388,29 +1507,26 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-quote-block-interpreter (quote-block contents)
- "Interpret QUOTE-BLOCK element as Org syntax.
+(defun org-element-quote-block-interpreter (_ contents)
+ "Interpret quote-block element as Org syntax.
CONTENTS is the contents of the element."
(format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
;;;; Section
-(defun org-element-section-parser (limit)
+(defun org-element-section-parser (_)
"Parse a section.
-LIMIT bounds the search.
-
Return a list whose CAR is `section' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `contents-end'
-and `:post-blank' keywords."
+containing `:begin', `:end', `:contents-begin', `contents-end',
+`:post-blank' and `:post-affiliated' keywords."
(save-excursion
;; Beginning of section is the beginning of the first non-blank
;; line after previous headline.
@@ -1418,17 +1534,17 @@ and `:post-blank' keywords."
(end (progn (org-with-limited-levels (outline-next-heading))
(point)))
(pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point))))
+ (line-beginning-position 2))))
(list 'section
(list :begin begin
:end end
:contents-begin begin
:contents-end pos-before-blank
- :post-blank (count-lines pos-before-blank end))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated begin)))))
-(defun org-element-section-interpreter (section contents)
- "Interpret SECTION element as Org syntax.
+(defun org-element-section-interpreter (_ contents)
+ "Interpret section element as Org syntax.
CONTENTS is the contents of the element."
contents)
@@ -1444,14 +1560,13 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `special-block' and CDR is a plist
-containing `:type', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:post-blank' and
-`:post-affiliated' keywords.
+containing `:type', `:begin', `:end', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
(type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (upcase (match-string-no-properties 1)))))
+ (match-string-no-properties 1))))
(if (not (save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
@@ -1467,7 +1582,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1478,7 +1592,6 @@ Assume point is at the beginning of the block."
(list :type type
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1502,9 +1615,6 @@ CONTENTS is the contents of the element."
;; through the following steps: implement a parser and an interpreter,
;; tweak `org-element--current-element' so that it recognizes the new
;; type and add that new type to `org-element-all-elements'.
-;;
-;; As a special case, when the newly defined type is a block type,
-;; `org-element-block-name-alist' has to be modified accordingly.
;;;; Babel Call
@@ -1512,43 +1622,61 @@ CONTENTS is the contents of the element."
(defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call.
-LIMIT bounds the search. AFFILIATED is a list of which CAR is
+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
+keyword and cdr is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `babel-call' and CDR is a plist
-containing `:begin', `:end', `:info', `:post-blank' and
+Return a list whose car is `babel-call' and cdr is a plist
+containing `:call', `:inside-header', `:arguments',
+`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords."
(save-excursion
- (let ((case-fold-search t)
- (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
- (org-babel-lob-get-info)))
- (begin (car affiliated))
- (post-affiliated (point))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
+ (before-blank (line-beginning-position 2))
+ (value (progn (search-forward ":" before-blank t)
+ (skip-chars-forward " \t")
+ (org-trim
+ (buffer-substring-no-properties
+ (point) (line-end-position)))))
+ (call
+ (or (org-string-nw-p
+ (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward "^[]()" before-blank)
+ (point))))))
+ (inside-header (org-element--parse-paired-brackets ?\[))
+ (arguments (org-string-nw-p
+ (org-element--parse-paired-brackets ?\()))
+ (end-header
+ (org-string-nw-p
+ (org-trim
+ (buffer-substring-no-properties (point) (line-end-position)))))
+ (end (progn (forward-line)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'babel-call
(nconc
- (list :begin begin
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
:end end
- :info info
- :post-blank (count-lines pos-before-blank end)
+ :value value
+ :post-blank (count-lines before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-babel-call-interpreter (babel-call contents)
- "Interpret BABEL-CALL element as Org syntax.
-CONTENTS is nil."
- (let* ((babel-info (org-element-property :info babel-call))
- (main (car babel-info))
- (post-options (nth 1 babel-info)))
- (concat "#+CALL: "
- (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
- ;; Remove redundant square brackets.
- (replace-match (match-string 1 main) nil nil main))
- (and post-options (format "[%s]" post-options)))))
+(defun org-element-babel-call-interpreter (babel-call _)
+ "Interpret BABEL-CALL element as Org syntax."
+ (concat "#+CALL: "
+ (org-element-property :call babel-call)
+ (let ((h (org-element-property :inside-header babel-call)))
+ (and h (format "[%s]" h)))
+ (concat "(" (org-element-property :arguments babel-call) ")")
+ (let ((h (org-element-property :end-header babel-call)))
+ (and h (concat " " h)))))
;;;; Clock
@@ -1559,8 +1687,8 @@ CONTENTS is nil."
LIMIT bounds the search.
Return a list whose CAR is `clock' and CDR is a plist containing
-`:status', `:value', `:time', `:begin', `:end' and `:post-blank'
-as keywords."
+`:status', `:value', `:time', `:begin', `:end', `:post-blank' and
+`:post-affiliated' as keywords."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
@@ -1570,7 +1698,7 @@ as keywords."
(duration (and (search-forward " => " (line-end-position) t)
(progn (skip-chars-forward " \t")
(looking-at "\\(\\S-+\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(status (if duration 'closed 'running))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
@@ -1584,11 +1712,11 @@ as keywords."
:duration duration
:begin begin
:end end
- :post-blank post-blank)))))
+ :post-blank post-blank
+ :post-affiliated begin)))))
-(defun org-element-clock-interpreter (clock contents)
- "Interpret CLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-clock-interpreter (clock _)
+ "Interpret CLOCK element as Org syntax."
(concat org-clock-string " "
(org-element-timestamp-interpreter
(org-element-property :value clock) nil)
@@ -1647,7 +1775,7 @@ Assume point is at comment beginning."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-comment-interpreter (comment contents)
+(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
CONTENTS is nil."
(replace-regexp-in-string "^" "# " (org-element-property :value comment)))
@@ -1664,8 +1792,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
@@ -1678,7 +1806,6 @@ Assume point is at comment block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1691,16 +1818,16 @@ Assume point is at comment block beginning."
(list :begin begin
:end end
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-comment-block-interpreter (comment-block contents)
- "Interpret COMMENT-BLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-comment-block-interpreter (comment-block _)
+ "Interpret COMMENT-BLOCK element as Org syntax."
(format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
- (org-remove-indentation (org-element-property :value comment-block))))
+ (org-element-normalize-string
+ (org-remove-indentation
+ (org-element-property :value comment-block)))))
;;;; Diary Sexp
@@ -1720,7 +1847,7 @@ containing `:begin', `:end', `:value', `:post-blank' and
(let ((begin (car affiliated))
(post-affiliated (point))
(value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
@@ -1733,43 +1860,13 @@ containing `:begin', `:end', `:value', `:post-blank' and
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-diary-sexp-interpreter (diary-sexp contents)
- "Interpret DIARY-SEXP as Org syntax.
-CONTENTS is nil."
+(defun org-element-diary-sexp-interpreter (diary-sexp _)
+ "Interpret DIARY-SEXP as Org syntax."
(org-element-property :value diary-sexp))
;;;; Example Block
-(defun org-element--remove-indentation (s &optional n)
- "Remove maximum common indentation in string S and return it.
-When optional argument N is a positive integer, remove exactly
-that much characters from indentation, if possible, or return
-S as-is otherwise. Unlike to `org-remove-indentation', this
-function doesn't call `untabify' on S."
- (catch 'exit
- (with-temp-buffer
- (insert s)
- (goto-char (point-min))
- ;; Find maximum common indentation, if not specified.
- (setq n (or n
- (let ((min-ind (point-max)))
- (save-excursion
- (while (re-search-forward "^[ \t]*\\S-" nil t)
- (let ((ind (1- (current-column))))
- (if (zerop ind) (throw 'exit s)
- (setq min-ind (min min-ind ind))))))
- min-ind)))
- (if (zerop n) s
- ;; Remove exactly N indentation, but give up if not possible.
- (while (not (eobp))
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
- ((< ind n) (throw 'exit s))
- (t (org-indent-line-to (- ind n))))
- (forward-line)))
- (buffer-string)))))
-
(defun org-element-example-block-parser (limit affiliated)
"Parse an example block.
@@ -1780,9 +1877,8 @@ their value.
Return a list whose CAR is `example-block' and CDR is a plist
containing `:begin', `:end', `:number-lines', `:preserve-indent',
-`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
-`:switches', `:value', `:post-blank' and `:post-affiliated'
-keywords."
+`:retain-labels', `:use-labels', `:label-fmt', `:switches',
+`:value', `:post-blank' and `:post-affiliated' keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
@@ -1793,15 +1889,22 @@ keywords."
(let* ((switches
(progn
(looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (org-match-string-no-properties 1)))
- ;; Switches analysis
+ (match-string-no-properties 1)))
+ ;; Switches analysis.
(number-lines
- (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches)))))))
(preserve-indent
- (or org-src-preserve-indentation
- (and switches (string-match "-i\\>" switches))))
+ (and switches (string-match "-i\\>" switches)))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
@@ -1821,14 +1924,10 @@ keywords."
;; Standard block parsing.
(begin (car affiliated))
(post-affiliated (point))
- (block-ind (progn (skip-chars-forward " \t") (current-column)))
- (contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
- (value (org-element--remove-indentation
- (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end))
- (and preserve-indent block-ind)))
+ (contents-begin (line-beginning-position 2))
+ (value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1845,18 +1944,21 @@ keywords."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-example-block-interpreter (example-block contents)
- "Interpret EXAMPLE-BLOCK element as Org syntax.
-CONTENTS is nil."
- (let ((switches (org-element-property :switches example-block)))
+(defun org-element-example-block-interpreter (example-block _)
+ "Interpret EXAMPLE-BLOCK element as Org syntax."
+ (let ((switches (org-element-property :switches example-block))
+ (value (org-element-property :value example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
- (org-escape-code-in-string
- (org-element-property :value example-block))
+ (org-element-normalize-string
+ (org-escape-code-in-string
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent example-block))
+ value
+ (org-remove-indentation value))))
"#+END_EXAMPLE")))
@@ -1871,49 +1973,48 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:type', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at export-block beginning."
- (let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (upcase (org-match-string-no-properties 1)))))
+ (let* ((case-fold-search t))
(if (not (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
+ (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (value (buffer-substring-no-properties contents-begin
- contents-end)))
- (list 'export-block
- (nconc
- (list :begin begin
- :end end
- :type type
- :value value
- :hiddenp hidden
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (save-excursion
+ (let* ((contents-end (match-beginning 0))
+ (backend
+ (progn
+ (looking-at
+ "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$")
+ (match-string-no-properties 1)))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (contents-begin (progn (forward-line) (point)))
+ (pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position))))
+ (value (org-unescape-code-in-string
+ (buffer-substring-no-properties contents-begin
+ contents-end))))
+ (list 'export-block
+ (nconc
+ (list :type (and backend (upcase backend))
+ :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
-(defun org-element-export-block-interpreter (export-block contents)
- "Interpret EXPORT-BLOCK element as Org syntax.
-CONTENTS is nil."
- (let ((type (org-element-property :type export-block)))
- (concat (format "#+BEGIN_%s\n" type)
- (org-element-property :value export-block)
- (format "#+END_%s" type))))
+(defun org-element-export-block-interpreter (export-block _)
+ "Interpret EXPORT-BLOCK element as Org syntax."
+ (format "#+BEGIN_EXPORT %s\n%s#+END_EXPORT"
+ (org-element-property :type export-block)
+ (org-element-property :value export-block)))
;;;; Fixed-width
@@ -1958,9 +2059,8 @@ Assume point is at the beginning of the fixed-width area."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-fixed-width-interpreter (fixed-width contents)
- "Interpret FIXED-WIDTH element as Org syntax.
-CONTENTS is nil."
+(defun org-element-fixed-width-interpreter (fixed-width _)
+ "Interpret FIXED-WIDTH element as Org syntax."
(let ((value (org-element-property :value fixed-width)))
(and value
(replace-regexp-in-string
@@ -1995,9 +2095,8 @@ keywords."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
- "Interpret HORIZONTAL-RULE element as Org syntax.
-CONTENTS is nil."
+(defun org-element-horizontal-rule-interpreter (&rest _)
+ "Interpret HORIZONTAL-RULE element as Org syntax."
"-----")
@@ -2015,10 +2114,13 @@ Return a list whose CAR is `keyword' and CDR is a plist
containing `:key', `:value', `:begin', `:end', `:post-blank' and
`:post-affiliated' keywords."
(save-excursion
- (let ((begin (car affiliated))
+ ;; An orphaned affiliated keyword is considered as a regular
+ ;; keyword. In this case AFFILIATED is nil, so we take care of
+ ;; this corner case.
+ (let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
- (upcase (org-match-string-no-properties 1))))
+ (upcase (match-string-no-properties 1))))
(value (org-trim (buffer-substring-no-properties
(match-end 0) (point-at-eol))))
(pos-before-blank (progn (forward-line) (point)))
@@ -2034,9 +2136,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-keyword-interpreter (keyword contents)
- "Interpret KEYWORD element as Org syntax.
-CONTENTS is nil."
+(defun org-element-keyword-interpreter (keyword _)
+ "Interpret KEYWORD element as Org syntax."
(format "#+%s: %s"
(org-element-property :key keyword)
(org-element-property :value keyword)))
@@ -2044,6 +2145,18 @@ CONTENTS is nil."
;;;; Latex Environment
+(defconst org-element--latex-begin-environment
+ "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}"
+ "Regexp matching the beginning of a LaTeX environment.
+The environment is captured by the first group.
+
+See also `org-element--latex-end-environment'.")
+
+(defconst org-element--latex-end-environment
+ "\\\\end{%s}[ \t]*$"
+ "Format string matching the ending of a LaTeX environment.
+See also `org-element--latex-begin-environment'.")
+
(defun org-element-latex-environment-parser (limit affiliated)
"Parse a LaTeX environment.
@@ -2060,8 +2173,8 @@ Assume point is at the beginning of the latex environment."
(save-excursion
(let ((case-fold-search t)
(code-begin (point)))
- (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (looking-at org-element--latex-begin-environment)
+ (if (not (re-search-forward (format org-element--latex-end-environment
(regexp-quote (match-string 1)))
limit t))
;; Incomplete latex environment: parse it as a paragraph.
@@ -2080,9 +2193,8 @@ Assume point is at the beginning of the latex environment."
:post-affiliated code-begin)
(cdr affiliated))))))))
-(defun org-element-latex-environment-interpreter (latex-environment contents)
- "Interpret LATEX-ENVIRONMENT element as Org syntax.
-CONTENTS is nil."
+(defun org-element-latex-environment-interpreter (latex-environment _)
+ "Interpret LATEX-ENVIRONMENT element as Org syntax."
(org-element-property :value latex-environment))
@@ -2094,12 +2206,13 @@ CONTENTS is nil."
LIMIT bounds the search.
Return a list whose CAR is `node-property' and CDR is a plist
-containing `:key', `:value', `:begin', `:end' and `:post-blank'
-keywords."
+containing `:key', `:value', `:begin', `:end', `:post-blank' and
+`:post-affiliated' keywords."
(looking-at org-property-re)
- (let ((begin (point))
- (key (org-match-string-no-properties 2))
- (value (org-match-string-no-properties 3))
+ (let ((case-fold-search t)
+ (begin (point))
+ (key (match-string-no-properties 2))
+ (value (match-string-no-properties 3))
(end (save-excursion
(end-of-line)
(if (re-search-forward org-property-re limit t)
@@ -2110,11 +2223,11 @@ keywords."
:value value
:begin begin
:end end
- :post-blank 0))))
+ :post-blank 0
+ :post-affiliated begin))))
-(defun org-element-node-property-interpreter (node-property contents)
- "Interpret NODE-PROPERTY element as Org syntax.
-CONTENTS is nil."
+(defun org-element-node-property-interpreter (node-property _)
+ "Interpret NODE-PROPERTY element as Org syntax."
(format org-property-format
(format ":%s:" (org-element-property :key node-property))
(or (org-element-property :value node-property) "")))
@@ -2141,66 +2254,42 @@ Assume point is at the beginning of the paragraph."
(before-blank
(let ((case-fold-search t))
(end-of-line)
- (if (not (re-search-forward
- org-element-paragraph-separate limit 'm))
- limit
- ;; A matching `org-element-paragraph-separate' is not
- ;; necessarily the end of the paragraph. In
- ;; particular, lines starting with # or : as a first
- ;; non-space character are ambiguous. We have to
- ;; check if they are valid Org syntax (e.g., not an
- ;; incomplete keyword).
- (beginning-of-line)
- (while (not
- (or
- ;; There's no ambiguity for other symbols or
- ;; empty lines: stop here.
- (looking-at "[ \t]*\\(?:[^:#]\\|$\\)")
- ;; Stop at valid fixed-width areas.
- (looking-at "[ \t]*:\\(?: \\|$\\)")
- ;; Stop at drawers.
- (and (looking-at org-drawer-regexp)
- (save-excursion
- (re-search-forward
- "^[ \t]*:END:[ \t]*$" limit t)))
- ;; Stop at valid comments.
- (looking-at "[ \t]*#\\(?: \\|$\\)")
- ;; Stop at valid dynamic blocks.
- (and (looking-at org-dblock-start-re)
- (save-excursion
- (re-search-forward
- "^[ \t]*#\\+END:?[ \t]*$" limit t)))
- ;; Stop at valid blocks.
- (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$"
- (regexp-quote
- (org-match-string-no-properties 1)))
- limit t)))
- ;; Stop at valid latex environments.
- (and (looking-at
- "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*\\\\end{%s}[ \t]*$"
- (regexp-quote
- (org-match-string-no-properties 1)))
- limit t)))
- ;; Stop at valid keywords.
- (looking-at "[ \t]*#\\+\\S-+:")
- ;; Skip everything else.
- (not
- (progn
- (end-of-line)
- (re-search-forward org-element-paragraph-separate
- limit 'm)))))
- (beginning-of-line)))
+ ;; A matching `org-element-paragraph-separate' is not
+ ;; necessarily the end of the paragraph. In particular,
+ ;; drawers, blocks or LaTeX environments opening lines
+ ;; must be closed. Moreover keywords with a secondary
+ ;; value must belong to "dual keywords".
+ (while (not
+ (cond
+ ((not (and (re-search-forward
+ org-element-paragraph-separate limit 'move)
+ (progn (beginning-of-line) t))))
+ ((looking-at org-drawer-regexp)
+ (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at org-element--latex-begin-environment)
+ (save-excursion
+ (re-search-forward
+ (format org-element--latex-end-environment
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
+ (member-ignore-case (match-string 1)
+ org-element-dual-keywords))
+ ;; Everything else is unambiguous.
+ (t)))
+ (end-of-line))
(if (= (point) limit) limit
(goto-char (line-beginning-position)))))
- (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
- (forward-line)
- (point)))
+ (contents-end (save-excursion
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (line-beginning-position 2)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
(list 'paragraph
@@ -2213,8 +2302,8 @@ Assume point is at the beginning of the paragraph."
:post-affiliated contents-begin)
(cdr affiliated))))))
-(defun org-element-paragraph-interpreter (paragraph contents)
- "Interpret PARAGRAPH element as Org syntax.
+(defun org-element-paragraph-interpreter (_ contents)
+ "Interpret paragraph element as Org syntax.
CONTENTS is the contents of the element."
contents)
@@ -2227,8 +2316,8 @@ CONTENTS is the contents of the element."
LIMIT bounds the search.
Return a list whose CAR is `planning' and CDR is a plist
-containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
-and `:post-blank' keywords."
+containing `:closed', `:deadline', `:scheduled', `:begin',
+`:end', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
@@ -2254,13 +2343,13 @@ and `:post-blank' keywords."
:scheduled scheduled
:begin begin
:end end
- :post-blank post-blank)))))
+ :post-blank post-blank
+ :post-affiliated begin)))))
-(defun org-element-planning-interpreter (planning contents)
- "Interpret PLANNING element as Org syntax.
-CONTENTS is nil."
+(defun org-element-planning-interpreter (planning _)
+ "Interpret PLANNING element as Org syntax."
(mapconcat
- 'identity
+ #'identity
(delq nil
(list (let ((deadline (org-element-property :deadline planning)))
(when deadline
@@ -2277,37 +2366,6 @@ CONTENTS is nil."
" "))
-;;;; Quote Section
-
-(defun org-element-quote-section-parser (limit)
- "Parse a quote section.
-
-LIMIT bounds the search.
-
-Return a list whose CAR is `quote-section' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
-
-Assume point is at beginning of the section."
- (save-excursion
- (let* ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties begin pos-before-blank)))
- (list 'quote-section
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end))))))
-
-(defun org-element-quote-section-interpreter (quote-section contents)
- "Interpret QUOTE-SECTION element as Org syntax.
-CONTENTS is nil."
- (org-element-property :value quote-section))
-
-
;;;; Src Block
(defun org-element-src-block-parser (limit affiliated)
@@ -2320,9 +2378,9 @@ their value.
Return a list whose CAR is `src-block' and CDR is a plist
containing `:language', `:switches', `:parameters', `:begin',
-`:end', `:hiddenp', `:number-lines', `:retain-labels',
-`:use-labels', `:label-fmt', `:preserve-indent', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+`:end', `:number-lines', `:retain-labels', `:use-labels',
+`:label-fmt', `:preserve-indent', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -2338,23 +2396,30 @@ Assume point is at the beginning of the block."
(language
(progn
(looking-at
- (concat "^[ \t]*#\\+BEGIN_SRC"
- "\\(?: +\\(\\S-+\\)\\)?"
- "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
- "\\(.*\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
+ "^[ \t]*#\\+BEGIN_SRC\
+\\(?: +\\(\\S-+\\)\\)?\
+\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
+\\(.*\\)[ \t]*$")
+ (match-string-no-properties 1)))
;; Get switches.
- (switches (org-match-string-no-properties 2))
+ (switches (match-string-no-properties 2))
;; Get parameters.
- (parameters (org-match-string-no-properties 3))
- ;; Switches analysis
+ (parameters (match-string-no-properties 3))
+ ;; Switches analysis.
(number-lines
- (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (or org-src-preserve-indentation
- (and switches
- (string-match "-i\\>" switches))))
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches)))))))
+ (preserve-indent (and switches
+ (string-match "-i\\>" switches)))
(label-fmt
(and switches
(string-match "-l +\"\\([^\"\n]+\\)\"" switches)
@@ -2371,16 +2436,10 @@ Assume point is at the beginning of the block."
(or (not switches)
(and retain-labels
(not (string-match "-k\\>" switches)))))
- ;; Indentation.
- (block-ind (progn (skip-chars-forward " \t") (current-column)))
- ;; Get visibility status.
- (hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
- (value (org-element--remove-indentation
- (org-unescape-code-in-string
- (buffer-substring-no-properties
- (point) contents-end))
- (and preserve-indent block-ind)))
+ (value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (line-beginning-position 2) contents-end)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2401,32 +2460,33 @@ Assume point is at the beginning of the block."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:value value
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-src-block-interpreter (src-block contents)
- "Interpret SRC-BLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-src-block-interpreter (src-block _)
+ "Interpret SRC-BLOCK element as Org syntax."
(let ((lang (org-element-property :language src-block))
(switches (org-element-property :switches src-block))
(params (org-element-property :parameters src-block))
- (value (let ((val (org-element-property :value src-block)))
- (cond
- ((org-element-property :preserve-indent src-block) val)
- ((zerop org-edit-src-content-indentation) val)
- (t
- (let ((ind (make-string
- org-edit-src-content-indentation 32)))
- (replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
+ (value
+ (let ((val (org-element-property :value src-block)))
+ (cond
+ ((or org-src-preserve-indentation
+ (org-element-property :preserve-indent src-block))
+ val)
+ ((zerop org-edit-src-content-indentation)
+ (org-remove-indentation val))
+ (t
+ (let ((ind (make-string org-edit-src-content-indentation ?\s)))
+ (replace-regexp-in-string
+ "^" ind (org-remove-indentation val))))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
(and params (concat " " params))))
- (org-escape-code-in-string value)
+ (org-element-normalize-string (org-escape-code-in-string value))
"#+END_SRC")))
@@ -2449,15 +2509,17 @@ Assume point is at the beginning of the table."
(save-excursion
(let* ((case-fold-search t)
(table-begin (point))
- (type (if (org-at-table.el-p) 'table.el 'org))
+ (type (if (looking-at "[ \t]*|") 'org 'table.el))
+ (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
+ (if (eq type 'org) "" "+")))
(begin (car affiliated))
(table-end
- (if (re-search-forward org-table-any-border-regexp limit 'm)
+ (if (re-search-forward end-re limit 'move)
(goto-char (match-beginning 0))
(point)))
(tblfm (let (acc)
(while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
- (push (org-match-string-no-properties 1) acc)
+ (push (match-string-no-properties 1) acc)
(forward-line))
acc))
(pos-before-blank (point))
@@ -2496,41 +2558,38 @@ CONTENTS is a string, if table's type is `org', or nil."
;;;; Table Row
-(defun org-element-table-row-parser (limit)
+(defun org-element-table-row-parser (_)
"Parse table row at point.
-LIMIT bounds the search.
-
Return a list whose CAR is `table-row' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:type' and `:post-blank' keywords."
+`:type', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
(let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
(begin (point))
;; A table rule has no contents. In that case, ensure
;; CONTENTS-BEGIN matches CONTENTS-END.
- (contents-begin (and (eq type 'standard)
- (search-forward "|")
- (point)))
+ (contents-begin (and (eq type 'standard) (search-forward "|")))
(contents-end (and (eq type 'standard)
(progn
(end-of-line)
(skip-chars-backward " \t")
(point))))
- (end (progn (forward-line) (point))))
+ (end (line-beginning-position 2)))
(list 'table-row
(list :type type
:begin begin
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank 0)))))
+ :post-blank 0
+ :post-affiliated begin)))))
(defun org-element-table-row-interpreter (table-row contents)
"Interpret TABLE-ROW element as Org syntax.
CONTENTS is the contents of the table row."
(if (eq (org-element-property :type table-row) 'rule) "|-"
- (concat "| " contents)))
+ (concat "|" contents)))
;;;; Verse Block
@@ -2545,7 +2604,7 @@ their value.
Return a list whose CAR is `verse-block' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
@@ -2557,8 +2616,7 @@ Assume point is at beginning of the block."
(save-excursion
(let* ((begin (car affiliated))
(post-affiliated (point))
- (hidden (progn (forward-line) (org-invisible-p2)))
- (contents-begin (point))
+ (contents-begin (progn (forward-line) (point)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2570,13 +2628,12 @@ Assume point is at beginning of the block."
:end end
:contents-begin contents-begin
:contents-end contents-end
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-verse-block-interpreter (verse-block contents)
- "Interpret VERSE-BLOCK element as Org syntax.
+(defun org-element-verse-block-interpreter (_ contents)
+ "Interpret verse-block element as Org syntax.
CONTENTS is verse block contents."
(format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
@@ -2584,373 +2641,289 @@ CONTENTS is verse block contents."
;;; Objects
;;
-;; Unlike to elements, interstices can be found between objects.
-;; That's why, along with the parser, successor functions are provided
-;; for each object. Some objects share the same successor (e.g.,
-;; `code' and `verbatim' objects).
-;;
-;; A successor must accept a single argument bounding the search. It
-;; will return either a cons cell whose CAR is the object's type, as
-;; a symbol, and CDR the position of its next occurrence, or nil.
-;;
-;; Successors follow the naming convention:
-;; org-element-NAME-successor, where NAME is the name of the
-;; successor, as defined in `org-element-all-successors'.
+;; Unlike to elements, raw text can be found between objects. Hence,
+;; `org-element--object-lex' is provided to find the next object in
+;; buffer.
;;
;; Some object types (e.g., `italic') are recursive. Restrictions on
;; object types they can contain will be specified in
;; `org-element-object-restrictions'.
;;
-;; Adding a new type of object is simple. Implement a successor,
-;; a parser, and an interpreter for it, all following the naming
-;; convention. Register type in `org-element-all-objects' and
-;; successor in `org-element-all-successors'. Maybe tweak
-;; restrictions about it, and that's it.
-
+;; Creating a new type of object requires to alter
+;; `org-element--object-regexp' and `org-element--object-lex', add the
+;; new type in `org-element-all-objects', and possibly add
+;; restrictions in `org-element-object-restrictions'.
;;;; Bold
(defun org-element-bold-parser ()
- "Parse bold object at point.
+ "Parse bold object at point, if any.
-Return a list whose CAR is `bold' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a bold object, return a list whose car is `bold' and cdr
+is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first star marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
-
-(defun org-element-bold-interpreter (bold contents)
- "Interpret BOLD object as Org syntax.
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'bold
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
+
+(defun org-element-bold-interpreter (_ contents)
+ "Interpret bold object as Org syntax.
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor ()
- "Search for the next text-markup object.
-
-Return value is a cons cell whose CAR is a symbol among `bold',
-`italic', `underline', `strike-through', `code' and `verbatim'
-and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re nil t)
- (let ((marker (match-string 3)))
- (cons (cond
- ((equal marker "*") 'bold)
- ((equal marker "/") 'italic)
- ((equal marker "_") 'underline)
- ((equal marker "+") 'strike-through)
- ((equal marker "~") 'code)
- ((equal marker "=") 'verbatim)
- (t (error "Unknown marker at %d" (match-beginning 3))))
- (match-beginning 2))))))
-
;;;; Code
(defun org-element-code-parser ()
- "Parse code object at point.
+ "Parse code object at point, if any.
-Return a list whose CAR is `code' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a code object, return a list whose car is `code' and cdr
+is a plist with `:value', `:begin', `:end' and `:post-blank'
+keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
-
-(defun org-element-code-interpreter (code contents)
- "Interpret CODE object as Org syntax.
-CONTENTS is nil."
+ (when (looking-at org-verbatim-re)
+ (let ((begin (match-beginning 2))
+ (value (match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'code
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
+
+(defun org-element-code-interpreter (code _)
+ "Interpret CODE object as Org syntax."
(format "~%s~" (org-element-property :value code)))
;;;; Entity
(defun org-element-entity-parser ()
- "Parse entity at point.
+ "Parse entity at point, if any.
-Return a list whose CAR is `entity' and CDR a plist with
-`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
-`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
-keywords.
+When at an entity, return a list whose car is `entity' and cdr
+a plist with `:begin', `:end', `:latex', `:latex-math-p',
+`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the entity."
- (save-excursion
- (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
- (let* ((value (org-entity-get (match-string 1)))
- (begin (match-beginning 0))
- (bracketsp (string= (match-string 2) "{}"))
- (post-blank (progn (goto-char (match-end 1))
- (when bracketsp (forward-char 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))
-
-(defun org-element-entity-interpreter (entity contents)
- "Interpret ENTITY object as Org syntax.
-CONTENTS is nil."
+ (catch 'no-object
+ (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
+ (save-excursion
+ (let* ((value (or (org-entity-get (match-string 1))
+ (throw 'no-object nil)))
+ (begin (match-beginning 0))
+ (bracketsp (string= (match-string 2) "{}"))
+ (post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))))
+
+(defun org-element-entity-interpreter (entity _)
+ "Interpret ENTITY object as Org syntax."
(concat "\\"
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor ()
- "Search for the next latex-fragment or entity object.
-
-Return value is a cons cell whose CAR is `entity' or
-`latex-fragment' and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (let ((matchers (cdr org-latex-regexps))
- ;; ENTITY-RE matches both LaTeX commands and Org entities.
- (entity-re
- "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
- (when (re-search-forward
- (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
- (goto-char (match-beginning 0))
- (if (looking-at entity-re)
- ;; Determine if it's a real entity or a LaTeX command.
- (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
- (match-beginning 0))
- ;; No entity nor command: point is at a LaTeX fragment.
- ;; Determine its type to get the correct beginning position.
- (cons 'latex-fragment
- (catch 'return
- (dolist (e matchers)
- (when (looking-at (nth 1 e))
- (throw 'return (match-beginning (nth 2 e)))))
- (point))))))))
-
;;;; Export Snippet
(defun org-element-export-snippet-parser ()
"Parse export snippet at point.
-Return a list whose CAR is `export-snippet' and CDR a plist with
-`:begin', `:end', `:back-end', `:value' and `:post-blank' as
-keywords.
+When at an export snippet, return a list whose car is
+`export-snippet' and cdr a plist with `:begin', `:end',
+`:back-end', `:value' and `:post-blank' as keywords. Otherwise,
+return nil.
Assume point is at the beginning of the snippet."
(save-excursion
- (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
- (let* ((begin (match-beginning 0))
- (back-end (org-match-string-no-properties 1))
- (value (buffer-substring-no-properties
- (point)
- (progn (re-search-forward "@@" nil t) (match-beginning 0))))
- (post-blank (skip-chars-forward " \t"))
- (end (point)))
- (list 'export-snippet
- (list :back-end back-end
- :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
-
-(defun org-element-export-snippet-interpreter (export-snippet contents)
- "Interpret EXPORT-SNIPPET object as Org syntax.
-CONTENTS is nil."
+ (let (contents-end)
+ (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):")
+ (setq contents-end
+ (save-match-data (goto-char (match-end 0))
+ (re-search-forward "@@" nil t)
+ (match-beginning 0))))
+ (let* ((begin (match-beginning 0))
+ (back-end (match-string-no-properties 1))
+ (value (buffer-substring-no-properties
+ (match-end 0) contents-end))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'export-snippet
+ (list :back-end back-end
+ :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))))
+
+(defun org-element-export-snippet-interpreter (export-snippet _)
+ "Interpret EXPORT-SNIPPET object as Org syntax."
(format "@@%s:%s@@"
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor ()
- "Search for the next export-snippet object.
-
-Return value is a cons cell whose CAR is `export-snippet' and CDR
-its beginning position."
- (save-excursion
- (let (beg)
- (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
- (setq beg (match-beginning 0))
- (search-forward "@@" nil t))
- (cons 'export-snippet beg)))))
-
;;;; Footnote Reference
(defun org-element-footnote-reference-parser ()
- "Parse footnote reference at point.
-
-Return a list whose CAR is `footnote-reference' and CDR a plist
-with `:label', `:type', `:inline-definition', `:begin', `:end'
-and `:post-blank' as keywords."
- (save-excursion
- (looking-at org-footnote-re)
- (let* ((begin (point))
- (label (or (org-match-string-no-properties 2)
- (org-match-string-no-properties 3)
- (and (match-string 1)
- (concat "fn:" (org-match-string-no-properties 1)))))
- (type (if (or (not label) (match-string 1)) 'inline 'standard))
- (inner-begin (match-end 0))
- (inner-end
- (let ((count 1))
- (forward-char)
- (while (and (> count 0) (re-search-forward "[][]" nil t))
- (if (equal (match-string 0) "[") (incf count) (decf count)))
- (1- (point))))
- (post-blank (progn (goto-char (1+ inner-end))
- (skip-chars-forward " \t")))
- (end (point))
- (footnote-reference
+ "Parse footnote reference at point, if any.
+
+When at a footnote reference, return a list whose car is
+`footnote-reference' and cdr a plist with `:label', `:type',
+`:begin', `:end', `:content-begin', `:contents-end' and
+`:post-blank' as keywords. Otherwise, return nil."
+ (when (looking-at org-footnote-re)
+ (let ((closing (with-syntax-table org-element--pair-square-table
+ (ignore-errors (scan-lists (point) 1 0)))))
+ (when closing
+ (save-excursion
+ (let* ((begin (point))
+ (label (match-string-no-properties 1))
+ (inner-begin (match-end 0))
+ (inner-end (1- closing))
+ (type (if (match-end 2) 'inline 'standard))
+ (post-blank (progn (goto-char closing)
+ (skip-chars-forward " \t")))
+ (end (point)))
(list 'footnote-reference
(list :label label
:type type
:begin begin
:end end
- :post-blank post-blank))))
- (org-element-put-property
- footnote-reference :inline-definition
- (and (eq type 'inline)
- (org-element-parse-secondary-string
- (buffer-substring inner-begin inner-end)
- (org-element-restriction 'footnote-reference)
- footnote-reference))))))
+ :contents-begin (and (eq type 'inline) inner-begin)
+ :contents-end (and (eq type 'inline) inner-end)
+ :post-blank post-blank))))))))
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
-CONTENTS is nil."
- (let ((label (or (org-element-property :label footnote-reference) "fn:"))
- (def
- (let ((inline-def
- (org-element-property :inline-definition footnote-reference)))
- (if (not inline-def) ""
- (concat ":" (org-element-interpret-data inline-def))))))
- (format "[%s]" (concat label def))))
-
-(defun org-element-footnote-reference-successor ()
- "Search for the next footnote-reference object.
-
-Return value is a cons cell whose CAR is `footnote-reference' and
-CDR is beginning position."
- (save-excursion
- (catch 'exit
- (while (re-search-forward org-footnote-re nil t)
- (save-excursion
- (let ((beg (match-beginning 0))
- (count 1))
- (backward-char)
- (while (re-search-forward "[][]" nil t)
- (if (equal (match-string 0) "[") (incf count) (decf count))
- (when (zerop count)
- (throw 'exit (cons 'footnote-reference beg))))))))))
+CONTENTS is its definition, when inline, or nil."
+ (format "[fn:%s%s]"
+ (or (org-element-property :label footnote-reference) "")
+ (if contents (concat ":" contents) "")))
;;;; Inline Babel Call
(defun org-element-inline-babel-call-parser ()
- "Parse inline babel call at point.
+ "Parse inline babel call at point, if any.
-Return a list whose CAR is `inline-babel-call' and CDR a plist
-with `:begin', `:end', `:info' and `:post-blank' as keywords.
+When at an inline babel call, return a list whose car is
+`inline-babel-call' and cdr a plist with `:call',
+`:inside-header', `:arguments', `:end-header', `:begin', `:end',
+`:value' and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the babel call."
(save-excursion
- (unless (bolp) (backward-char))
- (looking-at org-babel-inline-lob-one-liner-regexp)
- (let ((info (save-match-data (org-babel-lob-get-info)))
- (begin (match-end 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-babel-call
- (list :begin begin
- :end end
- :info info
- :post-blank post-blank)))))
-
-(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
- "Interpret INLINE-BABEL-CALL object as Org syntax.
-CONTENTS is nil."
- (let* ((babel-info (org-element-property :info inline-babel-call))
- (main-source (car babel-info))
- (post-options (nth 1 babel-info)))
- (concat "call_"
- (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
- ;; Remove redundant square brackets.
- (replace-match
- (match-string 1 main-source) nil nil main-source)
- main-source)
- (and post-options (format "[%s]" post-options)))))
-
-(defun org-element-inline-babel-call-successor ()
- "Search for the next inline-babel-call object.
-
-Return value is a cons cell whose CAR is `inline-babel-call' and
-CDR is beginning position."
- (save-excursion
- (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t)
- (cons 'inline-babel-call (match-end 1)))))
+ (catch :no-object
+ (when (let ((case-fold-search nil))
+ (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]"))
+ (goto-char (match-end 1))
+ (let* ((begin (match-beginning 0))
+ (call (match-string-no-properties 1))
+ (inside-header
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (arguments (org-string-nw-p
+ (or (org-element--parse-paired-brackets ?\()
+ ;; Parenthesis are mandatory.
+ (throw :no-object nil))))
+ (end-header
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (value (buffer-substring-no-properties begin (point)))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'inline-babel-call
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))))
+
+(defun org-element-inline-babel-call-interpreter (inline-babel-call _)
+ "Interpret INLINE-BABEL-CALL object as Org syntax."
+ (concat "call_"
+ (org-element-property :call inline-babel-call)
+ (let ((h (org-element-property :inside-header inline-babel-call)))
+ (and h (format "[%s]" h)))
+ "(" (org-element-property :arguments inline-babel-call) ")"
+ (let ((h (org-element-property :end-header inline-babel-call)))
+ (and h (format "[%s]" h)))))
;;;; Inline Src Block
(defun org-element-inline-src-block-parser ()
- "Parse inline source block at point.
+ "Parse inline source block at point, if any.
-Return a list whose CAR is `inline-src-block' and CDR a plist
-with `:begin', `:end', `:language', `:value', `:parameters' and
-`:post-blank' as keywords.
+When at an inline source block, return a list whose car is
+`inline-src-block' and cdr a plist with `:begin', `:end',
+`:language', `:value', `:parameters' and `:post-blank' as
+keywords. Otherwise, return nil.
Assume point is at the beginning of the inline src block."
(save-excursion
- (unless (bolp) (backward-char))
- (looking-at org-babel-inline-src-block-regexp)
- (let ((begin (match-beginning 1))
- (language (org-match-string-no-properties 2))
- (parameters (org-match-string-no-properties 4))
- (value (org-match-string-no-properties 5))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-src-block
- (list :language language
- :value value
- :parameters parameters
- :begin begin
- :end end
- :post-blank post-blank)))))
-
-(defun org-element-inline-src-block-interpreter (inline-src-block contents)
- "Interpret INLINE-SRC-BLOCK object as Org syntax.
-CONTENTS is nil."
+ (catch :no-object
+ (when (let ((case-fold-search nil))
+ (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]"))
+ (goto-char (match-end 1))
+ (let ((begin (match-beginning 0))
+ (language (match-string-no-properties 1))
+ (parameters
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (value (or (org-element--parse-paired-brackets ?\{)
+ (throw :no-object nil)))
+ (post-blank (skip-chars-forward " \t")))
+ (list 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end (point)
+ :post-blank post-blank)))))))
+
+(defun org-element-inline-src-block-interpreter (inline-src-block _)
+ "Interpret INLINE-SRC-BLOCK object as Org syntax."
(let ((language (org-element-property :language inline-src-block))
(arguments (org-element-property :parameters inline-src-block))
(body (org-element-property :value inline-src-block)))
@@ -2959,44 +2932,35 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor ()
- "Search for the next inline-babel-call element.
-
-Return value is a cons cell whose CAR is `inline-babel-call' and
-CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-babel-inline-src-block-regexp nil t)
- (cons 'inline-src-block (match-beginning 1)))))
-
;;;; Italic
(defun org-element-italic-parser ()
- "Parse italic object at point.
+ "Parse italic object at point, if any.
-Return a list whose CAR is `italic' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at an italic object, return a list whose car is `italic' and
+cdr is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first slash marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'italic
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
-
-(defun org-element-italic-interpreter (italic contents)
- "Interpret ITALIC object as Org syntax.
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'italic
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
+
+(defun org-element-italic-interpreter (_ contents)
+ "Interpret italic object as Org syntax.
CONTENTS is the contents of the object."
(format "/%s/" contents))
@@ -3004,169 +2968,196 @@ CONTENTS is the contents of the object."
;;;; Latex Fragment
(defun org-element-latex-fragment-parser ()
- "Parse LaTeX fragment at point.
+ "Parse LaTeX fragment at point, if any.
-Return a list whose CAR is `latex-fragment' and CDR a plist with
-`:value', `:begin', `:end', and `:post-blank' as keywords.
+When at a LaTeX fragment, return a list whose car is
+`latex-fragment' and cdr a plist with `:value', `:begin', `:end',
+and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the LaTeX fragment."
- (save-excursion
- (let* ((begin (point))
- (substring-match
- (catch 'exit
- (dolist (e (cdr org-latex-regexps))
- (let ((latex-regexp (nth 1 e)))
- (when (or (looking-at latex-regexp)
- (and (not (bobp))
- (save-excursion
- (backward-char)
- (looking-at latex-regexp))))
- (throw 'exit (nth 2 e)))))
- ;; None found: it's a macro.
- (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
- 0))
- (value (org-match-string-no-properties substring-match))
- (post-blank (progn (goto-char (match-end substring-match))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'latex-fragment
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
-
-(defun org-element-latex-fragment-interpreter (latex-fragment contents)
- "Interpret LATEX-FRAGMENT object as Org syntax.
-CONTENTS is nil."
+ (catch 'no-object
+ (save-excursion
+ (let* ((begin (point))
+ (after-fragment
+ (cond
+ ((not (eq ?$ (char-after)))
+ (pcase (char-after (1+ (point)))
+ (?\( (search-forward "\\)" nil t))
+ (?\[ (search-forward "\\]" nil t))
+ (_
+ ;; Macro.
+ (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\
+\\|\\({[^{}\n]*}\\)\\)*")
+ (match-end 0)))))
+ ((eq ?$ (char-after (1+ (point))))
+ (search-forward "$$" nil t 2))
+ (t
+ (and (not (eq ?$ (char-before)))
+ (not (memq (char-after (1+ (point)))
+ '(?\s ?\t ?\n ?, ?. ?\;)))
+ (search-forward "$" nil t 2)
+ (not (memq (char-before (match-beginning 0))
+ '(?\s ?\t ?\n ?, ?.)))
+ (looking-at-p
+ "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)")
+ (point)))))
+ (post-blank
+ (if (not after-fragment) (throw 'no-object nil)
+ (goto-char after-fragment)
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'latex-fragment
+ (list :value (buffer-substring-no-properties begin after-fragment)
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
+
+(defun org-element-latex-fragment-interpreter (latex-fragment _)
+ "Interpret LATEX-FRAGMENT object as Org syntax."
(org-element-property :value latex-fragment))
;;;; Line Break
(defun org-element-line-break-parser ()
- "Parse line break at point.
+ "Parse line break at point, if any.
-Return a list whose CAR is `line-break', and CDR a plist with
-`:begin', `:end' and `:post-blank' keywords.
+When at a line break, return a list whose car is `line-break',
+and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the beginning of the line break."
- (list 'line-break
- (list :begin (point)
- :end (progn (forward-line) (point))
- :post-blank 0)))
+ (when (and (looking-at-p "\\\\\\\\[ \t]*$")
+ (not (eq (char-before) ?\\)))
+ (list 'line-break
+ (list :begin (point)
+ :end (line-beginning-position 2)
+ :post-blank 0))))
-(defun org-element-line-break-interpreter (line-break contents)
- "Interpret LINE-BREAK object as Org syntax.
-CONTENTS is nil."
+(defun org-element-line-break-interpreter (&rest _)
+ "Interpret LINE-BREAK object as Org syntax."
"\\\\\n")
-(defun org-element-line-break-successor ()
- "Search for the next line-break object.
-
-Return value is a cons cell whose CAR is `line-break' and CDR is
-beginning position."
- (save-excursion
- (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
- (goto-char (match-beginning 1)))))
- ;; A line break can only happen on a non-empty line.
- (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
- (cons 'line-break beg)))))
-
;;;; Link
(defun org-element-link-parser ()
- "Parse link at point.
+ "Parse link at point, if any.
-Return a list whose CAR is `link' and CDR a plist with `:type',
-`:path', `:raw-link', `:application', `:search-option', `:begin',
-`:end', `:contents-begin', `:contents-end' and `:post-blank' as
-keywords.
+When at a link, return a list whose car is `link' and cdr a plist
+with `:type', `:path', `:format', `:raw-link', `:application',
+`:search-option', `:begin', `:end', `:contents-begin',
+`:contents-end' and `:post-blank' as keywords. Otherwise, return
+nil.
Assume point is at the beginning of the link."
- (save-excursion
+ (catch 'no-object
(let ((begin (point))
- end contents-begin contents-end link-end post-blank path type
- raw-link link search-option application)
+ end contents-begin contents-end link-end post-blank path type format
+ raw-link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
- ((and org-target-link-regexp (looking-at org-target-link-regexp))
- (setq type "radio"
- link-end (match-end 0)
- path (org-match-string-no-properties 0)
- contents-begin (match-beginning 0)
- contents-end (match-end 0)))
+ ((and org-target-link-regexp
+ (save-excursion (or (bolp) (backward-char))
+ (looking-at org-target-link-regexp)))
+ (setq type "radio")
+ (setq format 'plain)
+ (setq link-end (match-end 1))
+ (setq path (match-string-no-properties 1))
+ (setq contents-begin (match-beginning 1))
+ (setq contents-end (match-end 1)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
- (setq contents-begin (match-beginning 3)
- contents-end (match-end 3)
- link-end (match-end 0)
- ;; RAW-LINK is the original link. Expand any
- ;; abbreviation in it.
- raw-link (org-translate-link
- (org-link-expand-abbrev
- (org-match-string-no-properties 1))))
- ;; Determine TYPE of link and set PATH accordingly.
+ (setq format 'bracket)
+ (setq contents-begin (match-beginning 3))
+ (setq contents-end (match-end 3))
+ (setq link-end (match-end 0))
+ ;; RAW-LINK is the original link. Expand any
+ ;; abbreviation in it.
+ ;;
+ ;; Also treat any newline character and associated
+ ;; indentation as a single space character. This is not
+ ;; compatible with RFC 3986, which requires to ignore
+ ;; them altogether. However, doing so would require
+ ;; users to encode spaces on the fly when writing links
+ ;; (e.g., insert [[shell:ls%20*.org]] instead of
+ ;; [[shell:ls *.org]], which defeats Org's focus on
+ ;; simplicity.
+ (setq raw-link (org-link-expand-abbrev
+ (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" " "
+ (match-string-no-properties 1))))
+ ;; Determine TYPE of link and set PATH accordingly. According
+ ;; to RFC 3986, remove whitespaces from URI in external links.
+ ;; In internal ones, treat indentation as a single space.
(cond
;; File type.
((or (file-name-absolute-p raw-link)
(string-match "\\`\\.\\.?/" raw-link))
- (setq type "file" path raw-link))
- ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
+ (setq type "file")
+ (setq path raw-link))
+ ;; Explicit type (http, irc, bbdb...).
((string-match org-link-types-re raw-link)
- (setq type (match-string 1 raw-link)
- ;; According to RFC 3986, extra whitespace should be
- ;; ignored when a URI is extracted.
- path (replace-regexp-in-string
- "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0)))))
- ;; Id type: PATH is the id.
- ((string-match "\\`id:\\([-a-f0-9]+\\)" raw-link)
- (setq type "id" path (match-string 1 raw-link)))
+ (setq type (match-string 1 raw-link))
+ (setq path (substring raw-link (match-end 0))))
;; Code-ref type: PATH is the name of the reference.
- ((string-match "\\`(\\(.*\\))\\'" raw-link)
- (setq type "coderef" path (match-string 1 raw-link)))
+ ((and (string-match-p "\\`(" raw-link)
+ (string-match-p ")\\'" raw-link))
+ (setq type "coderef")
+ (setq path (substring raw-link 1 -1)))
;; Custom-id type: PATH is the name of the custom id.
- ((= (aref raw-link 0) ?#)
- (setq type "custom-id" path (substring raw-link 1)))
+ ((= (string-to-char raw-link) ?#)
+ (setq type "custom-id")
+ (setq path (substring raw-link 1)))
;; Fuzzy type: Internal link either matches a target, an
;; headline name or nothing. PATH is the target or
;; headline's name.
- (t (setq type "fuzzy" path raw-link))))
+ (t
+ (setq type "fuzzy")
+ (setq path raw-link))))
;; Type 3: Plain link, e.g., http://orgmode.org
((looking-at org-plain-link-re)
- (setq raw-link (org-match-string-no-properties 0)
- type (org-match-string-no-properties 1)
- link-end (match-end 0)
- path (org-match-string-no-properties 2)))
- ;; Type 4: Angular link, e.g., <http://orgmode.org>
+ (setq format 'plain)
+ (setq raw-link (match-string-no-properties 0))
+ (setq type (match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq path (match-string-no-properties 2)))
+ ;; Type 4: Angular link, e.g., <http://orgmode.org>. Unlike to
+ ;; bracket links, follow RFC 3986 and remove any extra
+ ;; whitespace in URI.
((looking-at org-angle-link-re)
- (setq raw-link (buffer-substring-no-properties
- (match-beginning 1) (match-end 2))
- type (org-match-string-no-properties 1)
- link-end (match-end 0)
- path (org-match-string-no-properties 2))))
+ (setq format 'angle)
+ (setq type (match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq raw-link
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 2)))
+ (setq path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
+ (t (throw 'no-object nil)))
;; In any case, deduce end point after trailing white space from
;; LINK-END variable.
- (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
- end (point))
- ;; Special "file" type link processing.
- (when (member type org-element-link-type-is-file)
- ;; Extract opening application and search option.
- (cond ((string-match "^file\\+\\(.*\\)$" type)
- (setq application (match-string 1 type)))
- ((not (string-match "^file" type))
- (setq application type)))
+ (save-excursion
+ (setq post-blank
+ (progn (goto-char link-end) (skip-chars-forward " \t")))
+ (setq end (point)))
+ ;; 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")
(when (string-match "::\\(.*\\)\\'" path)
- (setq search-option (match-string 1 path)
- path (replace-match "" nil nil path)))
- ;; Normalize URI.
- (when (and (not (org-string-match-p "\\`//" path))
- (file-name-absolute-p path))
- (setq path (concat "//" (expand-file-name path))))
- ;; Make sure TYPE always reports "file".
- (setq type "file"))
+ (setq search-option (match-string 1 path))
+ (setq path (replace-match "" nil nil path)))
+ (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
+ ;; Translate link, if `org-link-translation-function' is set.
+ (let ((trans (and (functionp org-link-translation-function)
+ (funcall org-link-translation-function type path))))
+ (when trans
+ (setq type (car trans))
+ (setq path (cdr trans))))
(list 'link
(list :type type
:path path
+ :format format
:raw-link (or raw-link path)
:application application
:search-option search-option
@@ -3180,197 +3171,167 @@ Assume point is at the beginning of the link."
"Interpret LINK object as Org syntax.
CONTENTS is the contents of the object, or nil."
(let ((type (org-element-property :type link))
- (raw-link (org-element-property :raw-link link)))
- (if (string= type "radio") raw-link
- (format "[[%s]%s]"
- raw-link
- (if contents (format "[%s]" contents) "")))))
-
-(defun org-element-link-successor ()
- "Search for the next link object.
-
-Return value is a cons cell whose CAR is `link' and CDR is
-beginning position."
- (save-excursion
- (let ((link-regexp
- (if (not org-target-link-regexp) org-any-link-re
- (concat org-any-link-re "\\|" org-target-link-regexp))))
- (when (re-search-forward link-regexp nil t)
- (cons 'link (match-beginning 0))))))
-
-(defun org-element-plain-link-successor ()
- "Search for the next plain link object.
-
-Return value is a cons cell whose CAR is `link' and CDR is
-beginning position."
- (and (save-excursion (re-search-forward org-plain-link-re nil t))
- (cons 'link (match-beginning 0))))
+ (path (org-element-property :path link)))
+ (if (string= type "radio") path
+ (let ((fmt (pcase (org-element-property :format link)
+ ;; Links with contents and internal links have to
+ ;; use bracket syntax. Ignore `:format' in these
+ ;; cases. This is also the default syntax when the
+ ;; property is not defined, e.g., when the object
+ ;; was crafted by the user.
+ ((guard contents)
+ (format "[[%%s][%s]]"
+ ;; Since this is going to be used as
+ ;; a format string, escape percent signs
+ ;; in description.
+ (replace-regexp-in-string "%" "%%" contents)))
+ ((or `bracket
+ `nil
+ (guard (member type '("coderef" "custom-id" "fuzzy"))))
+ "[[%s]]")
+ ;; Otherwise, just obey to `:format'.
+ (`angle "<%s>")
+ (`plain "%s")
+ (f (error "Wrong `:format' value: %s" f)))))
+ (format fmt
+ (pcase type
+ ("coderef" (format "(%s)" path))
+ ("custom-id" (concat "#" path))
+ ("file"
+ (let ((app (org-element-property :application link))
+ (opt (org-element-property :search-option link)))
+ (concat type (and app (concat "+" app)) ":"
+ path
+ (and opt (concat "::" opt)))))
+ ("fuzzy" path)
+ (_ (concat type ":" path))))))))
;;;; Macro
(defun org-element-macro-parser ()
- "Parse macro at point.
+ "Parse macro at point, if any.
-Return a list whose CAR is `macro' and CDR a plist with `:key',
-`:args', `:begin', `:end', `:value' and `:post-blank' as
-keywords.
+When at a macro, return a list whose car is `macro' and cdr
+a plist with `:key', `:args', `:begin', `:end', `:value' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the macro."
(save-excursion
- (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
- (let ((begin (point))
- (key (downcase (org-match-string-no-properties 1)))
- (value (org-match-string-no-properties 0))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (args (let ((args (org-match-string-no-properties 3)))
- (when args
- ;; Do not use `org-split-string' since empty
- ;; strings are meaningful here.
- (split-string
- (replace-regexp-in-string
- "\\(\\\\*\\)\\(,\\)"
- (lambda (str)
- (let ((len (length (match-string 1 str))))
- (concat (make-string (/ len 2) ?\\)
- (if (zerop (mod len 2)) "\000" ","))))
- args nil t)
- "\000")))))
- (list 'macro
- (list :key key
- :value value
- :args args
- :begin begin
- :end end
- :post-blank post-blank)))))
-
-(defun org-element-macro-interpreter (macro contents)
- "Interpret MACRO object as Org syntax.
-CONTENTS is nil."
+ (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
+ (let ((begin (point))
+ (key (downcase (match-string-no-properties 1)))
+ (value (match-string-no-properties 0))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (args (let ((args (match-string-no-properties 3)))
+ (and args (org-macro-extract-arguments args)))))
+ (list 'macro
+ (list :key key
+ :value value
+ :args args
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
+
+(defun org-element-macro-interpreter (macro _)
+ "Interpret MACRO object as Org syntax."
(org-element-property :value macro))
-(defun org-element-macro-successor ()
- "Search for the next macro object.
-
-Return value is cons cell whose CAR is `macro' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward
- "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- nil t)
- (cons 'macro (match-beginning 0)))))
-
;;;; Radio-target
(defun org-element-radio-target-parser ()
- "Parse radio target at point.
+ "Parse radio target at point, if any.
-Return a list whose CAR is `radio-target' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end', `:value'
-and `:post-blank' as keywords.
+When at a radio target, return a list whose car is `radio-target'
+and cdr a plist with `:begin', `:end', `:contents-begin',
+`:contents-end', `:value' and `:post-blank' as keywords.
+Otherwise, return nil.
Assume point is at the radio target."
(save-excursion
- (looking-at org-radio-target-regexp)
- (let ((begin (point))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1))
- (value (org-match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'radio-target
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank
- :value value)))))
-
-(defun org-element-radio-target-interpreter (target contents)
- "Interpret TARGET object as Org syntax.
+ (when (looking-at org-radio-target-regexp)
+ (let ((begin (point))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1))
+ (value (match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'radio-target
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank
+ :value value))))))
+
+(defun org-element-radio-target-interpreter (_ contents)
+ "Interpret target object as Org syntax.
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor ()
- "Search for the next radio-target object.
-
-Return value is a cons cell whose CAR is `radio-target' and CDR
-is beginning position."
- (save-excursion
- (when (re-search-forward org-radio-target-regexp nil t)
- (cons 'radio-target (match-beginning 0)))))
-
;;;; Statistics Cookie
(defun org-element-statistics-cookie-parser ()
- "Parse statistics cookie at point.
+ "Parse statistics cookie at point, if any.
-Return a list whose CAR is `statistics-cookie', and CDR a plist
-with `:begin', `:end', `:value' and `:post-blank' keywords.
+When at a statistics cookie, return a list whose car is
+`statistics-cookie', and cdr a plist with `:begin', `:end',
+`:value' and `:post-blank' keywords. Otherwise, return nil.
Assume point is at the beginning of the statistics-cookie."
(save-excursion
- (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
- (let* ((begin (point))
- (value (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'statistics-cookie
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank)))))
-
-(defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
- "Interpret STATISTICS-COOKIE object as Org syntax.
-CONTENTS is nil."
+ (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
+ (let* ((begin (point))
+ (value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'statistics-cookie
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
+
+(defun org-element-statistics-cookie-interpreter (statistics-cookie _)
+ "Interpret STATISTICS-COOKIE object as Org syntax."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor ()
- "Search for the next statistics cookie object.
-
-Return value is a cons cell whose CAR is `statistics-cookie' and
-CDR is beginning position."
- (save-excursion
- (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
- (cons 'statistics-cookie (match-beginning 0)))))
-
;;;; Strike-Through
(defun org-element-strike-through-parser ()
- "Parse strike-through object at point.
+ "Parse strike-through object at point, if any.
-Return a list whose CAR is `strike-through' and CDR is a plist
-with `:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a strike-through object, return a list whose car is
+`strike-through' and cdr is a plist with `:begin', `:end',
+`:contents-begin' and `:contents-end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the first plus sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'strike-through
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
-
-(defun org-element-strike-through-interpreter (strike-through contents)
- "Interpret STRIKE-THROUGH object as Org syntax.
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'strike-through
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
+
+(defun org-element-strike-through-interpreter (_ contents)
+ "Interpret strike-through object as Org syntax.
CONTENTS is the contents of the object."
(format "+%s+" contents))
@@ -3378,32 +3339,32 @@ CONTENTS is the contents of the object."
;;;; Subscript
(defun org-element-subscript-parser ()
- "Parse subscript at point.
+ "Parse subscript at point, if any.
-Return a list whose CAR is `subscript' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:use-brackets-p' and `:post-blank' as keywords.
+When at a subscript object, return a list whose car is
+`subscript' and cdr a plist with `:begin', `:end',
+`:contents-begin', `:contents-end', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the underscore."
(save-excursion
(unless (bolp) (backward-char))
- (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
- t
- (not (looking-at org-match-substring-regexp))))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 5)
- (match-beginning 3)))
- (contents-end (or (match-end 5) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'subscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (match-beginning 4))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'subscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-subscript-interpreter (subscript contents)
"Interpret SUBSCRIPT object as Org syntax.
@@ -3412,46 +3373,36 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor ()
- "Search for the next sub/superscript object.
-
-Return value is a cons cell whose CAR is either `subscript' or
-`superscript' and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp nil t)
- (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
- (match-beginning 2)))))
-
;;;; Superscript
(defun org-element-superscript-parser ()
- "Parse superscript at point.
+ "Parse superscript at point, if any.
-Return a list whose CAR is `superscript' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:use-brackets-p' and `:post-blank' as keywords.
+When at a superscript object, return a list whose car is
+`superscript' and cdr a plist with `:begin', `:end',
+`:contents-begin', `:contents-end', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the caret."
(save-excursion
(unless (bolp) (backward-char))
- (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
- (not (looking-at org-match-substring-regexp))))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 5)
- (match-beginning 3)))
- (contents-end (or (match-end 5) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'superscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (match-beginning 4))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'superscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-superscript-interpreter (superscript contents)
"Interpret SUPERSCRIPT object as Org syntax.
@@ -3465,8 +3416,7 @@ CONTENTS is the contents of the object."
(defun org-element-table-cell-parser ()
"Parse table cell at point.
-
-Return a list whose CAR is `table-cell' and CDR is a plist
+Return a list whose car is `table-cell' and cdr is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
(looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
@@ -3481,299 +3431,275 @@ and `:post-blank' keywords."
:contents-end contents-end
:post-blank 0))))
-(defun org-element-table-cell-interpreter (table-cell contents)
- "Interpret TABLE-CELL element as Org syntax.
+(defun org-element-table-cell-interpreter (_ contents)
+ "Interpret table-cell element as Org syntax.
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor ()
- "Search for the next table-cell object.
-
-Return value is a cons cell whose CAR is `table-cell' and CDR is
-beginning position."
- (when (looking-at "[ \t]*.*?[ \t]*\\(|\\|$\\)") (cons 'table-cell (point))))
-
;;;; Target
(defun org-element-target-parser ()
- "Parse target at point.
+ "Parse target at point, if any.
-Return a list whose CAR is `target' and CDR a plist with
-`:begin', `:end', `:value' and `:post-blank' as keywords.
+When at a target, return a list whose car is `target' and cdr
+a plist with `:begin', `:end', `:value' and `:post-blank' as
+keywords. Otherwise, return nil.
Assume point is at the target."
(save-excursion
- (looking-at org-target-regexp)
- (let ((begin (point))
- (value (org-match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'target
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank)))))
-
-(defun org-element-target-interpreter (target contents)
- "Interpret TARGET object as Org syntax.
-CONTENTS is nil."
+ (when (looking-at org-target-regexp)
+ (let ((begin (point))
+ (value (match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'target
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
+
+(defun org-element-target-interpreter (target _)
+ "Interpret TARGET object as Org syntax."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor ()
- "Search for the next target object.
-
-Return value is a cons cell whose CAR is `target' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward org-target-regexp nil t)
- (cons 'target (match-beginning 0)))))
-
;;;; Timestamp
+(defconst org-element--timestamp-regexp
+ (concat org-ts-regexp-both
+ "\\|"
+ "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
+ "\\|"
+ "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
+ "Regexp matching any timestamp type object.")
+
(defun org-element-timestamp-parser ()
- "Parse time stamp at point.
+ "Parse time stamp at point, if any.
-Return a list whose CAR is `timestamp', and CDR a plist with
-`:type', `:raw-value', `:year-start', `:month-start',
-`:day-start', `:hour-start', `:minute-start', `:year-end',
-`:month-end', `:day-end', `:hour-end', `:minute-end',
-`:repeater-type', `:repeater-value', `:repeater-unit',
-`:warning-type', `:warning-value', `:warning-unit', `:begin',
-`:end' and `:post-blank' keywords.
+When at a time stamp, return a list whose car is `timestamp', and
+cdr a plist with `:type', `:raw-value', `:year-start',
+`:month-start', `:day-start', `:hour-start', `:minute-start',
+`:year-end', `:month-end', `:day-end', `:hour-end',
+`:minute-end', `:repeater-type', `:repeater-value',
+`:repeater-unit', `:warning-type', `:warning-value',
+`:warning-unit', `:begin', `:end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the beginning of the timestamp."
- (save-excursion
- (let* ((begin (point))
- (activep (eq (char-after) ?<))
- (raw-value
- (progn
- (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
- (match-string-no-properties 0)))
- (date-start (match-string-no-properties 1))
- (date-end (match-string 3))
- (diaryp (match-beginning 2))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (time-range
- (and (not diaryp)
- (string-match
- "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
- date-start)
- (cons (string-to-number (match-string 2 date-start))
- (string-to-number (match-string 3 date-start)))))
- (type (cond (diaryp 'diary)
- ((and activep (or date-end time-range)) 'active-range)
- (activep 'active)
- ((or date-end time-range) 'inactive-range)
- (t 'inactive)))
- (repeater-props
- (and (not diaryp)
- (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
- raw-value)
- (list
- :repeater-type
- (let ((type (match-string 1 raw-value)))
- (cond ((equal "++" type) 'catch-up)
- ((equal ".+" type) 'restart)
- (t 'cumulate)))
- :repeater-value (string-to-number (match-string 2 raw-value))
- :repeater-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
- (warning-props
- (and (not diaryp)
- (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
- (list
- :warning-type (if (match-string 1 raw-value) 'first 'all)
- :warning-value (string-to-number (match-string 2 raw-value))
- :warning-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
- year-start month-start day-start hour-start minute-start year-end
- month-end day-end hour-end minute-end)
- ;; Parse date-start.
- (unless diaryp
- (let ((date (org-parse-time-string date-start t)))
- (setq year-start (nth 5 date)
- month-start (nth 4 date)
- day-start (nth 3 date)
- hour-start (nth 2 date)
- minute-start (nth 1 date))))
- ;; Compute date-end. It can be provided directly in time-stamp,
- ;; or extracted from time range. Otherwise, it defaults to the
- ;; same values as date-start.
- (unless diaryp
- (let ((date (and date-end (org-parse-time-string date-end t))))
- (setq year-end (or (nth 5 date) year-start)
- month-end (or (nth 4 date) month-start)
- day-end (or (nth 3 date) day-start)
- hour-end (or (nth 2 date) (car time-range) hour-start)
- minute-end (or (nth 1 date) (cdr time-range) minute-start))))
- (list 'timestamp
- (nconc (list :type type
- :raw-value raw-value
- :year-start year-start
- :month-start month-start
- :day-start day-start
- :hour-start hour-start
- :minute-start minute-start
- :year-end year-end
- :month-end month-end
- :day-end day-end
- :hour-end hour-end
- :minute-end minute-end
- :begin begin
- :end end
- :post-blank post-blank)
- repeater-props
- warning-props)))))
-
-(defun org-element-timestamp-interpreter (timestamp contents)
- "Interpret TIMESTAMP object as Org syntax.
-CONTENTS is nil."
- ;; Use `:raw-value' if specified.
- (or (org-element-property :raw-value timestamp)
- ;; Otherwise, build timestamp string.
- (let* ((repeat-string
- (concat
- (case (org-element-property :repeater-type timestamp)
- (cumulate "+") (catch-up "++") (restart ".+"))
- (let ((val (org-element-property :repeater-value timestamp)))
- (and val (number-to-string val)))
- (case (org-element-property :repeater-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
- (warning-string
- (concat
- (case (org-element-property :warning-type timestamp)
- (first "--")
- (all "-"))
- (let ((val (org-element-property :warning-value timestamp)))
- (and val (number-to-string val)))
- (case (org-element-property :warning-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
- (build-ts-string
- ;; Build an Org timestamp string from TIME. ACTIVEP is
- ;; non-nil when time stamp is active. If WITH-TIME-P is
- ;; non-nil, add a time part. HOUR-END and MINUTE-END
- ;; specify a time range in the timestamp. REPEAT-STRING
- ;; is the repeater string, if any.
- (lambda (time activep &optional with-time-p hour-end minute-end)
- (let ((ts (format-time-string
- (funcall (if with-time-p 'cdr 'car)
- org-time-stamp-formats)
- time)))
- (when (and hour-end minute-end)
- (string-match "[012]?[0-9]:[0-5][0-9]" ts)
- (setq ts
- (replace-match
- (format "\\&-%02d:%02d" hour-end minute-end)
- nil nil ts)))
- (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
- (dolist (s (list repeat-string warning-string))
- (when (org-string-nw-p s)
- (setq ts (concat (substring ts 0 -1)
- " "
- s
- (substring ts -1)))))
- ;; Return value.
- ts)))
- (type (org-element-property :type timestamp)))
- (case type
- ((active inactive)
- (let* ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp))
- (time-range-p (and hour-start hour-end minute-start minute-end
- (or (/= hour-start hour-end)
- (/= minute-start minute-end)))))
- (funcall
- build-ts-string
- (encode-time 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active)
- (and hour-start minute-start)
- (and time-range-p hour-end)
- (and time-range-p minute-end))))
- ((active-range inactive-range)
- (let ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp)))
- (concat
- (funcall
- build-ts-string (encode-time
- 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active-range)
- (and hour-start minute-start))
- "--"
- (funcall build-ts-string
- (encode-time 0
- (or minute-end 0)
- (or hour-end 0)
- (org-element-property :day-end timestamp)
- (org-element-property :month-end timestamp)
- (org-element-property :year-end timestamp))
- (eq type 'active-range)
- (and hour-end minute-end)))))))))
-
-(defun org-element-timestamp-successor ()
- "Search for the next timestamp object.
-
-Return value is a cons cell whose CAR is `timestamp' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward
- (concat org-ts-regexp-both
- "\\|"
- "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
- "\\|"
- "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- nil t)
- (cons 'timestamp (match-beginning 0)))))
+ (when (looking-at-p org-element--timestamp-regexp)
+ (save-excursion
+ (let* ((begin (point))
+ (activep (eq (char-after) ?<))
+ (raw-value
+ (progn
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0)))
+ (date-start (match-string-no-properties 1))
+ (date-end (match-string 3))
+ (diaryp (match-beginning 2))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
+ (type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
+ (warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
+ year-start month-start day-start hour-start minute-start year-end
+ month-end day-end hour-end minute-end)
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start))))
+ (list 'timestamp
+ (nconc (list :type type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ repeater-props
+ warning-props))))))
+
+(defun org-element-timestamp-interpreter (timestamp _)
+ "Interpret TIMESTAMP object as Org syntax."
+ (let* ((repeat-string
+ (concat
+ (pcase (org-element-property :repeater-type timestamp)
+ (`cumulate "+") (`catch-up "++") (`restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (pcase (org-element-property :repeater-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
+ (warning-string
+ (concat
+ (pcase (org-element-property :warning-type timestamp)
+ (`first "--") (`all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (pcase (org-element-property :warning-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
+ (build-ts-string
+ ;; Build an Org timestamp string from TIME. ACTIVEP is
+ ;; non-nil when time stamp is active. If WITH-TIME-P is
+ ;; non-nil, add a time part. HOUR-END and MINUTE-END
+ ;; specify a time range in the timestamp. REPEAT-STRING is
+ ;; the repeater string, if any.
+ (lambda (time activep &optional with-time-p hour-end minute-end)
+ (let ((ts (format-time-string
+ (funcall (if with-time-p #'cdr #'car)
+ org-time-stamp-formats)
+ time)))
+ (when (and hour-end minute-end)
+ (string-match "[012]?[0-9]:[0-5][0-9]" ts)
+ (setq ts
+ (replace-match
+ (format "\\&-%02d:%02d" hour-end minute-end)
+ nil nil ts)))
+ (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (concat (substring ts 0 -1)
+ " "
+ s
+ (substring ts -1)))))
+ ;; Return value.
+ ts)))
+ (type (org-element-property :type timestamp)))
+ (pcase type
+ ((or `active `inactive)
+ (let* ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (time-range-p (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))))
+ (funcall
+ build-ts-string
+ (encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active)
+ (and hour-start minute-start)
+ (and time-range-p hour-end)
+ (and time-range-p minute-end))))
+ ((or `active-range `inactive-range)
+ (let ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp)))
+ (concat
+ (funcall
+ build-ts-string (encode-time
+ 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active-range)
+ (and hour-start minute-start))
+ "--"
+ (funcall build-ts-string
+ (encode-time 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
+ (eq type 'active-range)
+ (and hour-end minute-end)))))
+ (_ (org-element-property :raw-value timestamp)))))
;;;; Underline
(defun org-element-underline-parser ()
- "Parse underline object at point.
+ "Parse underline object at point, if any.
-Return a list whose CAR is `underline' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at an underline object, return a list whose car is
+`underline' and cdr is a plist with `:begin', `:end',
+`:contents-begin' and `:contents-end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the first underscore marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'underline
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
-
-(defun org-element-underline-interpreter (underline contents)
- "Interpret UNDERLINE object as Org syntax.
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'underline
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
+
+(defun org-element-underline-interpreter (_ contents)
+ "Interpret underline object as Org syntax.
CONTENTS is the contents of the object."
(format "_%s_" contents))
@@ -3781,29 +3707,29 @@ CONTENTS is the contents of the object."
;;;; Verbatim
(defun org-element-verbatim-parser ()
- "Parse verbatim object at point.
+ "Parse verbatim object at point, if any.
-Return a list whose CAR is `verbatim' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a verbatim object, return a list whose car is `verbatim'
+and cdr is a plist with `:value', `:begin', `:end' and
+`:post-blank' keywords. Otherwise, return nil.
Assume point is at the first equal sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'verbatim
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
-
-(defun org-element-verbatim-interpreter (verbatim contents)
- "Interpret VERBATIM object as Org syntax.
-CONTENTS is nil."
+ (when (looking-at org-verbatim-re)
+ (let ((begin (match-beginning 2))
+ (value (match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'verbatim
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
+
+(defun org-element-verbatim-interpreter (verbatim _)
+ "Interpret VERBATIM object as Org syntax."
(format "=%s=" (org-element-property :value verbatim)))
@@ -3818,10 +3744,9 @@ CONTENTS is nil."
;; 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', `quote-section', `section' and `table-row'.
+;; `node-property', `section' and `table-row'.
-(defun org-element--current-element
- (limit &optional granularity special structure)
+(defun org-element--current-element (limit &optional granularity mode structure)
"Parse the element starting at point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -3838,12 +3763,12 @@ recursion. Allowed values are `headline', `greater-element',
nil), secondary values will not be parsed, since they only
contain objects.
-Optional argument SPECIAL, when non-nil, can be either
-`first-section', `item', `node-property', `quote-section',
-`section', and `table-row'.
+Optional argument MODE, when non-nil, can be either
+`first-section', `section', `planning', `item', `node-property'
+and `table-row'.
-If STRUCTURE isn't provided but SPECIAL is set to `item', it will
-be computed.
+If STRUCTURE isn't provided but MODE is set to `item', it will be
+computed.
This function assumes point is always at the beginning of the
element it has to parse."
@@ -3855,30 +3780,37 @@ element it has to parse."
(raw-secondary-p (and granularity (not (eq granularity 'object)))))
(cond
;; Item.
- ((eq special 'item)
+ ((eq mode 'item)
(org-element-item-parser limit structure raw-secondary-p))
;; Table Row.
- ((eq special 'table-row) (org-element-table-row-parser limit))
+ ((eq mode 'table-row) (org-element-table-row-parser limit))
;; Node Property.
- ((eq special 'node-property) (org-element-node-property-parser limit))
+ ((eq mode 'node-property) (org-element-node-property-parser limit))
;; Headline.
((org-with-limited-levels (org-at-heading-p))
(org-element-headline-parser limit raw-secondary-p))
;; Sections (must be checked after headline).
- ((eq special 'section) (org-element-section-parser limit))
- ((eq special 'quote-section) (org-element-quote-section-parser limit))
- ((eq special 'first-section)
+ ((eq mode 'section) (org-element-section-parser limit))
+ ((eq mode 'first-section)
(org-element-section-parser
(or (save-excursion (org-with-limited-levels (outline-next-heading)))
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))))
+ (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
;; a footnote definition: next item is always a paragraph.
((not (bolp)) (org-element-paragraph-parser limit (list (point))))
- ;; Planning and Clock.
- ((looking-at org-planning-or-clock-line-re)
- (if (equal (match-string 1) org-clock-string)
- (org-element-clock-parser limit)
- (org-element-planning-parser limit)))
+ ;; Clock.
+ ((looking-at org-clock-line-re) (org-element-clock-parser limit))
;; Inlinetask.
((org-at-heading-p)
(org-element-inlinetask-parser limit raw-secondary-p))
@@ -3891,13 +3823,11 @@ element it has to parse."
(goto-char (car affiliated))
(org-element-keyword-parser limit nil))
;; LaTeX Environment.
- ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ ((looking-at org-element--latex-begin-environment)
(org-element-latex-environment-parser limit affiliated))
;; Drawer and Property Drawer.
((looking-at org-drawer-regexp)
- (if (equal (match-string 1) "PROPERTIES")
- (org-element-property-drawer-parser limit affiliated)
- (org-element-drawer-parser limit affiliated)))
+ (org-element-drawer-parser limit affiliated))
;; Fixed Width
((looking-at "[ \t]*:\\( \\|$\\)")
(org-element-fixed-width-parser limit affiliated))
@@ -3905,27 +3835,35 @@ element it has to parse."
;; Keywords.
((looking-at "[ \t]*#")
(goto-char (match-end 0))
- (cond ((looking-at "\\(?: \\|$\\)")
- (beginning-of-line)
- (org-element-comment-parser limit affiliated))
- ((looking-at "\\+BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (let ((parser (assoc (upcase (match-string 1))
- org-element-block-name-alist)))
- (if parser (funcall (cdr parser) limit affiliated)
- (org-element-special-block-parser limit affiliated))))
- ((looking-at "\\+CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit affiliated))
- ((looking-at "\\+BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit affiliated))
- ((looking-at "\\+\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit affiliated))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit affiliated))))
+ (cond
+ ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit affiliated))
+ ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (funcall (pcase (upcase (match-string 1))
+ ("CENTER" #'org-element-center-block-parser)
+ ("COMMENT" #'org-element-comment-block-parser)
+ ("EXAMPLE" #'org-element-example-block-parser)
+ ("EXPORT" #'org-element-export-block-parser)
+ ("QUOTE" #'org-element-quote-block-parser)
+ ("SRC" #'org-element-src-block-parser)
+ ("VERSE" #'org-element-verse-block-parser)
+ (_ #'org-element-special-block-parser))
+ limit
+ affiliated))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
;; Footnote Definition.
((looking-at org-footnote-definition-re)
(org-element-footnote-definition-parser limit affiliated))
@@ -3936,7 +3874,8 @@ element it has to parse."
((looking-at "%%(")
(org-element-diary-sexp-parser limit affiliated))
;; Table.
- ((org-at-table-p t) (org-element-table-parser limit affiliated))
+ ((looking-at "[ \t]*\\(|\\|\\+\\(-+\\+\\)+[ \t]*$\\)")
+ (org-element-table-parser limit affiliated))
;; List.
((looking-at (org-item-re))
(org-element-plain-list-parser
@@ -3980,7 +3919,7 @@ position of point and CDR is nil."
(save-match-data
(org-trim
(buffer-substring-no-properties
- (match-end 0) (point-at-eol)))))
+ (match-end 0) (line-end-position)))))
;; PARSEDP is non-nil when keyword should have its
;; value parsed.
(parsedp (member kwd org-element-parsed-keywords))
@@ -3989,14 +3928,20 @@ position of point and CDR is nil."
(dualp (member kwd org-element-dual-keywords))
(dual-value
(and dualp
- (let ((sec (org-match-string-no-properties 2)))
+ (let ((sec (match-string-no-properties 2)))
(if (or (not sec) (not parsedp)) sec
- (org-element-parse-secondary-string sec restrict)))))
+ (save-match-data
+ (org-element--parse-objects
+ (match-beginning 2) (match-end 2) nil restrict))))))
;; Attribute a property name to KWD.
(kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
;; Now set final shape for VALUE.
(when parsedp
- (setq value (org-element-parse-secondary-string value restrict)))
+ (setq value
+ (org-element--parse-objects
+ (match-end 0)
+ (progn (end-of-line) (skip-chars-backward " \t") (point))
+ nil restrict)))
(when dualp
(setq value (and (or value dual-value) (cons value dual-value))))
(when (or (member kwd org-element-multiple-keywords)
@@ -4037,7 +3982,7 @@ Optional argument GRANULARITY determines the depth of the
recursion. It can be set to the following symbols:
`headline' Only parse headlines.
-`greater-element' Don't recurse into greater elements excepted
+`greater-element' Don't recurse into greater elements except
headlines and sections. Thus, elements
parsed are the top-level ones.
`element' Parse everything but objects and plain text.
@@ -4046,7 +3991,7 @@ recursion. It can be set to the following symbols:
When VISIBLE-ONLY is non-nil, don't parse contents of hidden
elements.
-An element or an objects is represented as a list with the
+An element or object is represented as a list with the
pattern (TYPE PROPERTIES CONTENTS), where :
TYPE is a symbol describing the element or object. See
@@ -4089,23 +4034,25 @@ looked after.
Optional argument PARENT, when non-nil, is the element or object
containing the secondary string. It is used to set correctly
-`:parent' property within the string."
- (let ((local-variables (buffer-local-variables)))
- (with-temp-buffer
- (dolist (v local-variables)
- (ignore-errors
- (if (symbolp v) (makunbound v)
- (org-set-local (car v) (cdr v)))))
- (insert string)
- (restore-buffer-modified-p nil)
- (let ((secondary (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (when parent
- (dolist (o secondary) (org-element-put-property o :parent parent)))
- secondary))))
+`:parent' property within the string.
+
+If STRING is the empty string or nil, return nil."
+ (cond
+ ((not string) nil)
+ ((equal string "") nil)
+ (t (let ((local-variables (buffer-local-variables)))
+ (with-temp-buffer
+ (dolist (v local-variables)
+ (ignore-errors
+ (if (symbolp v) (makunbound v)
+ (set (make-local-variable (car v)) (cdr v)))))
+ (insert string)
+ (restore-buffer-modified-p nil)
+ (org-element--parse-objects
+ (point-min) (point-max) nil restriction parent))))))
(defun org-element-map
- (data types fun &optional info first-match no-recursion with-affiliated)
+ (data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
DATA is a parse tree, an element, an object, a string, or a list
@@ -4141,7 +4088,7 @@ Assuming TREE is a variable containing an Org buffer parse tree,
the following example will return a flat list of all `src-block'
and `example-block' elements in it:
- (org-element-map tree \\='(example-block src-block) \\='identity)
+ (org-element-map tree \\='(example-block src-block) #\\='identity)
The following snippet will find the first headline with a level
of 1 and a \"phone\" tag, and will return its beginning position:
@@ -4156,7 +4103,7 @@ of 1 and a \"phone\" tag, and will return its beginning position:
The next example will return a flat list of all `plain-list' type
elements in TREE that are not a sub-list themselves:
- (org-element-map tree \\='plain-list \\='identity nil nil \\='plain-list)
+ (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list)
Eventually, this example will return a flat list of all `bold'
type objects containing a `latex-snippet' type object, even
@@ -4164,116 +4111,101 @@ looking into captions:
(org-element-map tree \\='bold
(lambda (b)
- (and (org-element-map b \\='latex-snippet \\='identity nil t) b))
+ (and (org-element-map b \\='latex-snippet #\\='identity nil t) b))
nil nil nil t)"
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
- (unless (listp types) (setq types (list types)))
- (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
- ;; Recursion depth is determined by --CATEGORY.
- (let* ((--category
- (catch 'found
- (let ((category 'greater-elements))
- (mapc (lambda (type)
- (cond ((or (memq type org-element-all-objects)
- (eq type 'plain-text))
- ;; If one object is found, the function
- ;; has to recurse into every object.
- (throw 'found 'objects))
- ((not (memq type org-element-greater-elements))
- ;; If one regular element is found, the
- ;; function has to recurse, at least,
- ;; into every element it encounters.
- (and (not (eq category 'elements))
- (setq category 'elements)))))
- types)
- category)))
- ;; Compute properties for affiliated keywords if necessary.
- (--affiliated-alist
- (and with-affiliated
- (mapcar (lambda (kwd)
- (cons kwd (intern (concat ":" (downcase kwd)))))
- org-element-affiliated-keywords)))
- --acc
- --walk-tree
- (--walk-tree
- (function
- (lambda (--data)
- ;; Recursively walk DATA. INFO, if non-nil, is a plist
- ;; holding contextual information.
- (let ((--type (org-element-type --data)))
- (cond
- ((not --data))
- ;; Ignored element in an export context.
- ((and info (memq --data (plist-get info :ignore-list))))
- ;; List of elements or objects.
- ((not --type) (mapc --walk-tree --data))
- ;; Unconditionally enter parse trees.
- ((eq --type 'org-data)
- (mapc --walk-tree (org-element-contents --data)))
- (t
- ;; Check if TYPE is matching among TYPES. If so,
- ;; apply FUN to --DATA and accumulate return value
- ;; into --ACC (or exit if FIRST-MATCH is non-nil).
- (when (memq --type types)
- (let ((result (funcall fun --data)))
- (cond ((not result))
- (first-match (throw '--map-first-match result))
- (t (push result --acc)))))
- ;; If --DATA has a secondary string that can contain
- ;; objects with their type among TYPES, look into it.
- (when (and (eq --category 'objects) (not (stringp --data)))
- (let ((sec-prop
- (assq --type org-element-secondary-value-alist)))
- (when sec-prop
- (funcall --walk-tree
- (org-element-property (cdr sec-prop) --data)))))
- ;; If --DATA has any affiliated keywords and
- ;; WITH-AFFILIATED is non-nil, look for objects in
- ;; them.
- (when (and with-affiliated
- (eq --category 'objects)
- (memq --type org-element-all-elements))
- (mapc (lambda (kwd-pair)
- (let ((kwd (car kwd-pair))
- (value (org-element-property
- (cdr kwd-pair) --data)))
- ;; Pay attention to the type of value.
- ;; Preserve order for multiple keywords.
- (cond
- ((not value))
- ((and (member kwd org-element-multiple-keywords)
- (member kwd org-element-dual-keywords))
- (mapc (lambda (line)
- (funcall --walk-tree (cdr line))
- (funcall --walk-tree (car line)))
- (reverse value)))
- ((member kwd org-element-multiple-keywords)
- (mapc (lambda (line) (funcall --walk-tree line))
- (reverse value)))
- ((member kwd org-element-dual-keywords)
- (funcall --walk-tree (cdr value))
- (funcall --walk-tree (car value)))
- (t (funcall --walk-tree value)))))
- --affiliated-alist))
- ;; Determine if a recursion into --DATA is possible.
- (cond
- ;; --TYPE is explicitly removed from recursion.
- ((memq --type no-recursion))
- ;; --DATA has no contents.
- ((not (org-element-contents --data)))
- ;; Looking for greater elements but --DATA is simply
- ;; an element or an object.
- ((and (eq --category 'greater-elements)
- (not (memq --type org-element-greater-elements))))
- ;; Looking for elements but --DATA is an object.
- ((and (eq --category 'elements)
- (memq --type org-element-all-objects)))
- ;; In any other case, map contents.
- (t (mapc --walk-tree (org-element-contents --data)))))))))))
- (catch '--map-first-match
- (funcall --walk-tree data)
- ;; Return value in a proper order.
- (nreverse --acc))))
+ (let* ((types (if (listp types) types (list types)))
+ (no-recursion (if (listp no-recursion) no-recursion
+ (list no-recursion)))
+ ;; Recursion depth is determined by --CATEGORY.
+ (--category
+ (catch :--found
+ (let ((category 'greater-elements)
+ (all-objects (cons 'plain-text org-element-all-objects)))
+ (dolist (type types category)
+ (cond ((memq type all-objects)
+ ;; If one object is found, the function has
+ ;; to recurse into every object.
+ (throw :--found 'objects))
+ ((not (memq type org-element-greater-elements))
+ ;; If one regular element is found, the
+ ;; function has to recurse, at least, into
+ ;; every element it encounters.
+ (and (not (eq category 'elements))
+ (setq category 'elements))))))))
+ --acc)
+ (letrec ((--walk-tree
+ (lambda (--data)
+ ;; Recursively walk DATA. INFO, if non-nil, is a plist
+ ;; holding contextual information.
+ (let ((--type (org-element-type --data)))
+ (cond
+ ((not --data))
+ ;; Ignored element in an export context.
+ ((and info (memq --data (plist-get info :ignore-list))))
+ ;; List of elements or objects.
+ ((not --type) (mapc --walk-tree --data))
+ ;; Unconditionally enter parse trees.
+ ((eq --type 'org-data)
+ (mapc --walk-tree (org-element-contents --data)))
+ (t
+ ;; Check if TYPE is matching among TYPES. If so,
+ ;; apply FUN to --DATA and accumulate return value
+ ;; into --ACC (or exit if FIRST-MATCH is non-nil).
+ (when (memq --type types)
+ (let ((result (funcall fun --data)))
+ (cond ((not result))
+ (first-match (throw :--map-first-match result))
+ (t (push result --acc)))))
+ ;; If --DATA has a secondary string that can contain
+ ;; objects with their type among TYPES, look inside.
+ (when (and (eq --category 'objects) (not (stringp --data)))
+ (dolist (p (cdr (assq --type
+ org-element-secondary-value-alist)))
+ (funcall --walk-tree (org-element-property p --data))))
+ ;; If --DATA has any parsed affiliated keywords and
+ ;; WITH-AFFILIATED is non-nil, look for objects in
+ ;; them.
+ (when (and with-affiliated
+ (eq --category 'objects)
+ (eq (org-element-class --data) 'element))
+ (dolist (kwd-pair org-element--parsed-properties-alist)
+ (let ((kwd (car kwd-pair))
+ (value (org-element-property (cdr kwd-pair) --data)))
+ ;; Pay attention to the type of parsed
+ ;; keyword. In particular, preserve order for
+ ;; multiple keywords.
+ (cond
+ ((not value))
+ ((member kwd org-element-dual-keywords)
+ (if (member kwd org-element-multiple-keywords)
+ (dolist (line (reverse value))
+ (funcall --walk-tree (cdr line))
+ (funcall --walk-tree (car line)))
+ (funcall --walk-tree (cdr value))
+ (funcall --walk-tree (car value))))
+ ((member kwd org-element-multiple-keywords)
+ (mapc --walk-tree (reverse value)))
+ (t (funcall --walk-tree value))))))
+ ;; Determine if a recursion into --DATA is possible.
+ (cond
+ ;; --TYPE is explicitly removed from recursion.
+ ((memq --type no-recursion))
+ ;; --DATA has no contents.
+ ((not (org-element-contents --data)))
+ ;; Looking for greater elements but --DATA is
+ ;; simply an element or an object.
+ ((and (eq --category 'greater-elements)
+ (not (memq --type org-element-greater-elements))))
+ ;; Looking for elements but --DATA is an object.
+ ((and (eq --category 'elements)
+ (eq (org-element-class --data) 'object)))
+ ;; In any other case, map contents.
+ (t (mapc --walk-tree (org-element-contents --data))))))))))
+ (catch :--map-first-match
+ (funcall --walk-tree data)
+ ;; Return value in a proper order.
+ (nreverse --acc)))))
(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
@@ -4282,24 +4214,38 @@ looking into captions:
;; level.
;;
;; The second one, `org-element--parse-objects' applies on all objects
-;; of a paragraph or a secondary string. It uses
-;; `org-element--get-next-object-candidates' to optimize the search of
-;; the next object in the buffer.
-;;
-;; More precisely, that function looks for every allowed object type
-;; first. Then, it discards failed searches, keeps further matches,
-;; and searches again types matched behind point, for subsequent
-;; calls. Thus, searching for a given type fails only once, and every
-;; object is searched only once at top level (but sometimes more for
-;; nested types).
+;; of a paragraph or a secondary string. It calls
+;; `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
+ (pcase type
+ (`headline 'section)
+ (`inlinetask 'planning)
+ (`plain-list 'item)
+ (`property-drawer 'node-property)
+ (`section 'planning)
+ (`table 'table-row))
+ (pcase type
+ (`item 'item)
+ (`node-property 'node-property)
+ (`planning 'property-drawer)
+ (`table-row 'table-row))))
(defun org-element--parse-elements
- (beg end special structure granularity visible-only acc)
+ (beg end mode structure granularity visible-only acc)
"Parse elements between BEG and END positions.
-SPECIAL prioritize some elements over the others. It can be set
-to `first-section', `quote-section', `section' `item' or
-`table-row'.
+MODE prioritizes some elements over the others. It can be set to
+`first-section', `section', `planning', `item', `node-property'
+or `table-row'.
When value is `item', STRUCTURE will be used as the current list
structure.
@@ -4320,140 +4266,203 @@ Elements are accumulated into ACC."
;; 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)))
- ;; Main loop start.
- (while (< (point) end)
- ;; Find current element's type and parse it accordingly to
- ;; its category.
- (let* ((element (org-element--current-element
- end granularity special 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.
- (case type
- (headline
- (if (org-element-property :quotedp element) 'quote-section
- 'section))
- (plain-list 'item)
- (property-drawer 'node-property)
- (table 'table-row))
- (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))))
- (org-element-adopt-elements acc element)))
- ;; Return result.
- acc))
-
-(defun org-element--parse-objects (beg end acc restriction)
+ (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))))
+ ;; Return result.
+ (apply #'org-element-set-contents acc (nreverse elements)))))
+
+(defun org-element--object-lex (restriction)
+ "Return next object in current buffer or nil.
+RESTRICTION is a list of object types, as symbols, that should be
+looked after. This function assumes that the buffer is narrowed
+to an appropriate container (e.g., a paragraph)."
+ (if (memq 'table-cell restriction) (org-element-table-cell-parser)
+ (let* ((start (point))
+ (limit
+ ;; Object regexp sometimes needs to have a peek at
+ ;; a character ahead. Therefore, when there is a hard
+ ;; limit, make it one more than the true beginning of the
+ ;; radio target.
+ (save-excursion
+ (cond ((not org-target-link-regexp) nil)
+ ((not (memq 'link restriction)) nil)
+ ((progn
+ (unless (bolp) (forward-char -1))
+ (not (re-search-forward org-target-link-regexp nil t)))
+ nil)
+ ;; Since we moved backward, we do not want to
+ ;; match again an hypothetical 1-character long
+ ;; radio link before us. Realizing that this can
+ ;; only happen if such a radio link starts at
+ ;; beginning of line, we prevent this here.
+ ((and (= start (1+ (line-beginning-position)))
+ (= start (match-end 1)))
+ (and (re-search-forward org-target-link-regexp nil t)
+ (1+ (match-beginning 1))))
+ (t (1+ (match-beginning 1))))))
+ found)
+ (save-excursion
+ (while (and (not found)
+ (re-search-forward org-element--object-regexp limit 'move))
+ (goto-char (match-beginning 0))
+ (let ((result (match-string 0)))
+ (setq found
+ (cond
+ ((string-prefix-p "call_" result t)
+ (and (memq 'inline-babel-call restriction)
+ (org-element-inline-babel-call-parser)))
+ ((string-prefix-p "src_" result t)
+ (and (memq 'inline-src-block restriction)
+ (org-element-inline-src-block-parser)))
+ (t
+ (pcase (char-after)
+ (?^ (and (memq 'superscript restriction)
+ (org-element-superscript-parser)))
+ (?_ (or (and (memq 'subscript restriction)
+ (org-element-subscript-parser))
+ (and (memq 'underline restriction)
+ (org-element-underline-parser))))
+ (?* (and (memq 'bold restriction)
+ (org-element-bold-parser)))
+ (?/ (and (memq 'italic restriction)
+ (org-element-italic-parser)))
+ (?~ (and (memq 'code restriction)
+ (org-element-code-parser)))
+ (?= (and (memq 'verbatim restriction)
+ (org-element-verbatim-parser)))
+ (?+ (and (memq 'strike-through restriction)
+ (org-element-strike-through-parser)))
+ (?@ (and (memq 'export-snippet restriction)
+ (org-element-export-snippet-parser)))
+ (?{ (and (memq 'macro restriction)
+ (org-element-macro-parser)))
+ (?$ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))
+ (?<
+ (if (eq (aref result 1) ?<)
+ (or (and (memq 'radio-target restriction)
+ (org-element-radio-target-parser))
+ (and (memq 'target restriction)
+ (org-element-target-parser)))
+ (or (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'link restriction)
+ (org-element-link-parser)))))
+ (?\\
+ (if (eq (aref result 1) ?\\)
+ (and (memq 'line-break restriction)
+ (org-element-line-break-parser))
+ (or (and (memq 'entity restriction)
+ (org-element-entity-parser))
+ (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)))))
+ ;; This is probably a plain link.
+ (_ (and (memq 'link restriction)
+ (org-element-link-parser)))))))
+ (or (eobp) (forward-char))))
+ (cond (found)
+ (limit (forward-char -1)
+ (org-element-link-parser)) ;radio link
+ (t nil))))))
+
+(defun org-element--parse-objects (beg end acc restriction &optional parent)
"Parse objects between BEG and END and return recursive structure.
-Objects are accumulated in ACC.
+Objects are accumulated in ACC. RESTRICTION is a list of object
+successors which are allowed in the current object.
-RESTRICTION is a list of object successors which are allowed in
-the current object."
- (let ((candidates 'initial))
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
+ACC becomes the parent for all parsed objects. However, if ACC
+is nil (i.e., a secondary string is being parsed) and optional
+argument PARENT is non-nil, use it as the parent for all objects.
+Eventually, if both ACC and PARENT are nil, the common parent is
+the list of objects itself."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (let (next-object contents)
(while (and (not (eobp))
- (setq candidates
- (org-element--get-next-object-candidates
- restriction candidates)))
- (let ((next-object
- (let ((pos (apply 'min (mapcar 'cdr candidates))))
- (save-excursion
- (goto-char pos)
- (funcall (intern (format "org-element-%s-parser"
- (car (rassq pos candidates)))))))))
- ;; 1. Text before any object. Untabify it.
- (let ((obj-beg (org-element-property :begin next-object)))
- (unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
- (let ((obj-end (org-element-property :end next-object))
- (cont-beg (org-element-property :contents-begin next-object)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (org-element--parse-objects
- cont-beg (org-element-property :contents-end next-object)
- next-object (org-element-restriction next-object)))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
+ (setq next-object (org-element--object-lex restriction)))
+ ;; Text before any object.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (let ((text (buffer-substring-no-properties (point) obj-beg)))
+ (push (if acc (org-element-put-property text :parent acc) text)
+ contents))))
+ ;; Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ (when acc (org-element-put-property next-object :parent acc))
+ (push (if cont-beg
+ ;; Fill contents of NEXT-OBJECT if possible.
+ (org-element--parse-objects
+ cont-beg
+ (org-element-property :contents-end next-object)
+ next-object
+ (org-element-restriction next-object))
+ next-object)
+ contents)
+ (goto-char obj-end)))
+ ;; Text after last object.
(unless (eobp)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc))))
-
-(defun org-element--get-next-object-candidates (restriction objects)
- "Return an alist of candidates for the next object.
-
-RESTRICTION is a list of object types, as symbols. Only
-candidates with such types are looked after.
-
-OBJECTS is the previous candidates alist. If it is set to
-`initial', no search has been done before, and all symbols in
-RESTRICTION should be looked after.
-
-Return value is an alist whose CAR is the object type and CDR its
-beginning position."
- (delq
- nil
- (if (eq objects 'initial)
- ;; When searching for the first time, look for every successor
- ;; allowed in RESTRICTION.
- (mapcar
- (lambda (res)
- (funcall (intern (format "org-element-%s-successor" res))))
- restriction)
- ;; Focus on objects returned during last search. Keep those
- ;; still after point. Search again objects before it.
- (mapcar
- (lambda (obj)
- (if (>= (cdr obj) (point)) obj
- (let* ((type (car obj))
- (succ (or (cdr (assq type org-element-object-successor-alist))
- type)))
- (and succ
- (funcall (intern (format "org-element-%s-successor" succ)))))))
- objects))))
+ (let ((text (buffer-substring-no-properties (point) end)))
+ (push (if acc (org-element-put-property text :parent acc) text)
+ contents)))
+ ;; Result. Set appropriate parent.
+ (if acc (apply #'org-element-set-contents acc (nreverse contents))
+ (let* ((contents (nreverse contents))
+ (parent (or parent contents)))
+ (dolist (datum contents contents)
+ (org-element-put-property datum :parent parent))))))))
@@ -4468,71 +4477,74 @@ beginning position."
;; `org-element--interpret-affiliated-keywords'.
;;;###autoload
-(defun org-element-interpret-data (data &optional parent)
+(defun org-element-interpret-data (data)
"Interpret DATA as Org syntax.
-
DATA is a parse tree, an element, an object or a secondary string
-to interpret.
-
-Optional argument PARENT is used for recursive calls. It contains
-the element or object containing data, or nil.
-
-Return Org syntax as a string."
- (let* ((type (org-element-type data))
- (results
- (cond
- ;; Secondary string.
- ((not type)
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj parent))
- data ""))
- ;; Full Org document.
- ((eq type 'org-data)
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj parent))
- (org-element-contents data) ""))
- ;; Plain text: return it.
- ((stringp data) data)
- ;; Element/Object without contents.
- ((not (org-element-contents data))
- (funcall (intern (format "org-element-%s-interpreter" type))
- data nil))
- ;; Element/Object with contents.
- (t
- (let* ((greaterp (memq type org-element-greater-elements))
- (objectp (and (not greaterp)
- (memq type org-element-recursive-objects)))
- (contents
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj data))
- (org-element-contents
- (if (or greaterp objectp) data
- ;; Elements directly containing objects must
- ;; have their indentation normalized first.
- (org-element-normalize-contents
+to interpret. Return Org syntax as a string."
+ (letrec ((fun
+ (lambda (data parent)
+ (let* ((type (org-element-type data))
+ ;; Find interpreter for current object or
+ ;; element. If it doesn't exist (e.g. this is
+ ;; a pseudo object or element), return contents,
+ ;; if any.
+ (interpret
+ (let ((fun (intern
+ (format "org-element-%s-interpreter" type))))
+ (if (fboundp fun) fun (lambda (_ contents) contents))))
+ (results
+ (cond
+ ;; Secondary string.
+ ((not type)
+ (mapconcat (lambda (obj) (funcall fun obj parent))
+ data
+ ""))
+ ;; Full Org document.
+ ((eq type 'org-data)
+ (mapconcat (lambda (obj) (funcall fun obj parent))
+ (org-element-contents data)
+ ""))
+ ;; Plain text: return it.
+ ((stringp data) data)
+ ;; Element or object without contents.
+ ((not (org-element-contents data))
+ (funcall interpret data nil))
+ ;; Element or object with contents.
+ (t
+ (funcall
+ interpret
data
- ;; When normalizing first paragraph of an
- ;; item or a footnote-definition, ignore
- ;; first line's indentation.
- (and (eq type 'paragraph)
- (equal data (car (org-element-contents parent)))
- (memq (org-element-type parent)
- '(footnote-definition item))))))
- "")))
- (funcall (intern (format "org-element-%s-interpreter" type))
- data
- (if greaterp (org-element-normalize-contents contents)
- contents)))))))
- (if (memq type '(org-data plain-text nil)) results
- ;; Build white spaces. If no `:post-blank' property is
- ;; specified, assume its value is 0.
- (let ((post-blank (or (org-element-property :post-blank data) 0)))
- (if (memq type org-element-all-objects)
- (concat results (make-string post-blank 32))
- (concat
- (org-element--interpret-affiliated-keywords data)
- (org-element-normalize-string results)
- (make-string post-blank 10)))))))
+ ;; Recursively interpret contents.
+ (mapconcat
+ (lambda (datum) (funcall fun datum data))
+ (org-element-contents
+ (if (not (memq type '(paragraph verse-block)))
+ data
+ ;; Fix indentation of elements containing
+ ;; objects. We ignore `table-row'
+ ;; elements as they are one line long
+ ;; anyway.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph of
+ ;; an item or a footnote-definition,
+ ;; ignore first line's indentation.
+ (and (eq type 'paragraph)
+ (memq (org-element-type parent)
+ '(footnote-definition item))
+ (eq data
+ (car (org-element-contents parent)))))))
+ ""))))))
+ (if (memq type '(org-data plain-text nil)) results
+ ;; Build white spaces. If no `:post-blank' property
+ ;; is specified, assume its value is 0.
+ (let ((blank (or (org-element-property :post-blank data) 0)))
+ (if (eq (org-element-class data parent) 'object)
+ (concat results (make-string blank ?\s))
+ (concat (org-element--interpret-affiliated-keywords data)
+ (org-element-normalize-string results)
+ (make-string blank ?\n)))))))))
+ (funcall fun data nil)))
(defun org-element--interpret-affiliated-keywords (element)
"Return ELEMENT's affiliated keywords as Org syntax.
@@ -4566,14 +4578,14 @@ If there is no affiliated keyword, return the empty string."
;; List all ELEMENT's properties matching an attribute line or an
;; affiliated keyword, but ignore translated keywords since they
;; cannot belong to the property list.
- (loop for prop in (nth 1 element) by 'cddr
- when (let ((keyword (upcase (substring (symbol-name prop) 1))))
- (or (string-match "^ATTR_" keyword)
- (and
- (member keyword org-element-affiliated-keywords)
- (not (assoc keyword
- org-element-keyword-translation-alist)))))
- collect prop)
+ (cl-loop for prop in (nth 1 element) by 'cddr
+ when (let ((keyword (upcase (substring (symbol-name prop) 1))))
+ (or (string-match "^ATTR_" keyword)
+ (and
+ (member keyword org-element-affiliated-keywords)
+ (not (assoc keyword
+ org-element-keyword-translation-alist)))))
+ collect prop)
"")))
;; Because interpretation of the parse tree must return the same
@@ -4609,67 +4621,1065 @@ If optional argument IGNORE-FIRST is non-nil, ignore first line's
indentation to compute maximal common indentation.
Return the normalized element that is element with global
-indentation removed from its contents. The function assumes that
-indentation is not done with TAB characters."
- (let* ((min-ind most-positive-fixnum)
- find-min-ind ; For byte-compiler.
- (find-min-ind
- ;; Return minimal common indentation within BLOB. This is
- ;; done by walking recursively BLOB and updating MIN-IND
- ;; along the way. FIRST-FLAG is non-nil when the first
- ;; string hasn't been seen yet. It is required as this
- ;; string is the only one whose indentation doesn't happen
- ;; after a newline character.
- (lambda (blob first-flag)
- (dolist (object (org-element-contents blob))
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (string-match "\\` *" object)
- (let ((len (match-end 0)))
- ;; An indentation of zero means no string will be
- ;; modified. Quit the process.
- (if (zerop len) (throw 'zero (setq min-ind 0))
- (setq min-ind (min len min-ind)))))
- (cond
- ((stringp object)
- (dolist (line (cdr (org-split-string object " *\n")))
- (unless (string= line "")
- (setq min-ind (min (org-get-indentation line) min-ind)))))
- ((memq (org-element-type object) org-element-recursive-objects)
- (funcall find-min-ind object first-flag)))))))
- ;; Find minimal indentation in ELEMENT.
- (catch 'zero (funcall find-min-ind element (not ignore-first)))
+indentation removed from its contents."
+ (letrec ((find-min-ind
+ ;; Return minimal common indentation within BLOB. This is
+ ;; done by walking recursively BLOB and updating MIN-IND
+ ;; along the way. FIRST-FLAG is non-nil when the next
+ ;; object is expected to be a string that doesn't start
+ ;; with a newline character. It happens for strings at
+ ;; the beginnings of the contents or right after a line
+ ;; break.
+ (lambda (blob first-flag min-ind)
+ (dolist (datum (org-element-contents blob) min-ind)
+ (when first-flag
+ (setq first-flag nil)
+ (cond
+ ;; Objects cannot start with spaces: in this
+ ;; case, indentation is 0.
+ ((not (stringp datum)) (throw :zero 0))
+ ((not (string-match
+ "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum))
+ (throw :zero 0))
+ ((equal (match-string 2 datum) "\n")
+ (put-text-property
+ (match-beginning 1) (match-end 1) 'org-ind 'empty datum))
+ (t
+ (let ((i (string-width (match-string 1 datum))))
+ (put-text-property
+ (match-beginning 1) (match-end 1) 'org-ind i datum)
+ (setq min-ind (min i min-ind))))))
+ (cond
+ ((stringp datum)
+ (let ((s 0))
+ (while (string-match
+ "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s)
+ (setq s (match-end 1))
+ (cond
+ ((equal (match-string 1 datum) "")
+ (unless (member (match-string 2 datum) '("" "\n"))
+ (throw :zero 0)))
+ ((equal (match-string 2 datum) "\n")
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'org-ind 'empty datum))
+ (t
+ (let ((i (string-width (match-string 1 datum))))
+ (put-text-property (match-beginning 1) (match-end 1)
+ 'org-ind i datum)
+ (setq min-ind (min i min-ind))))))))
+ ((eq (org-element-type datum) 'line-break)
+ (setq first-flag t))
+ ((memq (org-element-type datum) org-element-recursive-objects)
+ (setq min-ind
+ (funcall find-min-ind datum first-flag min-ind)))))))
+ (min-ind
+ (catch :zero
+ (funcall find-min-ind
+ element (not ignore-first) most-positive-fixnum))))
(if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element
;; Build ELEMENT back, replacing each string with the same
;; string minus common indentation.
- (let* (build ; For byte compiler.
- (build
- (function
- (lambda (blob first-flag)
- ;; Return BLOB with all its strings indentation
- ;; shortened from MIN-IND white spaces. FIRST-FLAG
- ;; is non-nil when the first string hasn't been seen
- ;; yet.
- (setcdr (cdr blob)
- (mapcar
- #'(lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (setq object
- (replace-regexp-in-string
- (format "\\` \\{%d\\}" min-ind)
- "" object)))
- (cond
- ((stringp object)
- (replace-regexp-in-string
- (format "\n \\{%d\\}" min-ind) "\n" object))
- ((memq (org-element-type object)
- org-element-recursive-objects)
- (funcall build object first-flag))
- (t object)))
- (org-element-contents blob)))
- blob))))
- (funcall build element (not ignore-first))))))
+ (letrec ((build
+ (lambda (datum)
+ ;; Return DATUM with all its strings indentation
+ ;; shortened from MIN-IND white spaces.
+ (setcdr
+ (cdr datum)
+ (mapcar
+ (lambda (object)
+ (cond
+ ((stringp object)
+ (with-temp-buffer
+ (insert object)
+ (let ((s (point-min)))
+ (while (setq s (text-property-not-all
+ s (point-max) 'org-ind nil))
+ (goto-char s)
+ (let ((i (get-text-property s 'org-ind)))
+ (delete-region s (progn
+ (skip-chars-forward " \t")
+ (point)))
+ (when (integerp i) (indent-to (- i min-ind))))))
+ (buffer-string)))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object))
+ (t object)))
+ (org-element-contents datum)))
+ datum)))
+ (funcall build element)))))
+
+
+
+;;; Cache
+;;
+;; Implement a caching mechanism for `org-element-at-point' and
+;; `org-element-context', which see.
+;;
+;; A single public function is provided: `org-element-cache-reset'.
+;;
+;; Cache is enabled by default, but can be disabled 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 behaviour.
+;;
+;; Internally, parsed elements are stored in an AVL tree,
+;; `org-element--cache'. This tree is updated lazily: whenever
+;; a change happens to the buffer, a synchronization request is
+;; registered in `org-element--cache-sync-requests' (see
+;; `org-element--cache-submit-request'). During idle time, requests
+;; are processed by `org-element--cache-sync'. Synchronization also
+;; happens when an element is required from the cache. In this case,
+;; the process stops as soon as the needed element is up-to-date.
+;;
+;; A synchronization request can only apply on a synchronized part of
+;; the cache. Therefore, the cache is updated at least to the
+;; location where the new request applies. Thus, requests are ordered
+;; from left to right and all elements starting before the first
+;; request are correct. This property is used by functions like
+;; `org-element--cache-find' to retrieve elements in the part of the
+;; cache that can be trusted.
+;;
+;; A request applies to every element, starting from its original
+;; location (or key, see below). When a request is processed, it
+;; moves forward and may collide the next one. In this case, both
+;; requests are merged into a new one that starts from that element.
+;; As a consequence, the whole synchronization complexity does not
+;; depend on the number of pending requests, but on the number of
+;; elements the very first request will be applied on.
+;;
+;; Elements cannot be accessed through their beginning position, which
+;; may or may not be up-to-date. Instead, each element in the tree is
+;; associated to a key, obtained with `org-element--cache-key'. This
+;; mechanism is robust enough to preserve total order among elements
+;; even when the tree is only partially synchronized.
+
+
+(defvar org-element-use-cache nil
+ "Non-nil when Org parser should cache its results.
+
+WARNING: for the time being, using cache sometimes triggers
+freezes. Therefore, it is disabled by default. Activate it if
+you want to help debugging the issue.")
+
+(defvar org-element-cache-sync-idle-time 0.6
+ "Length, in seconds, of idle time before syncing cache.")
+
+(defvar org-element-cache-sync-duration (seconds-to-time 0.04)
+ "Maximum duration, as a time value, for a cache synchronization.
+If the synchronization is not over after this delay, the process
+pauses and resumes after `org-element-cache-sync-break'
+seconds.")
+
+(defvar org-element-cache-sync-break (seconds-to-time 0.3)
+ "Duration, as a time value, of the pause between synchronizations.
+See `org-element-cache-sync-duration' for more information.")
+
+
+;;;; Data Structure
+
+(defvar org-element--cache nil
+ "AVL tree used to cache elements.
+Each node of the tree contains an element. Comparison is done
+with `org-element--cache-compare'. This cache is used in
+`org-element-at-point'.")
+
+(defvar org-element--cache-sync-requests nil
+ "List of pending synchronization requests.
+
+A request is a vector with the following pattern:
+
+ \[NEXT BEG END OFFSET PARENT PHASE]
+
+Processing a synchronization request consists of three phases:
+
+ 0. Delete modified elements,
+ 1. Fill missing area in cache,
+ 2. Shift positions and re-parent elements after the changes.
+
+During phase 0, NEXT is the key of the first element to be
+removed, BEG and END is buffer position delimiting the
+modifications. Elements starting between them (inclusive) are
+removed. So are elements whose parent is removed. PARENT, when
+non-nil, is the parent of the first element to be removed.
+
+During phase 1, NEXT is the key of the next known element in
+cache and BEG its beginning position. Parse buffer between that
+element and the one before it in order to determine the parent of
+the next element. Set PARENT to the element containing NEXT.
+
+During phase 2, NEXT is the key of the next element to shift in
+the parse tree. All elements starting from this one have their
+properties relatives to buffer positions shifted by integer
+OFFSET and, if they belong to element PARENT, are adopted by it.
+
+PHASE specifies the phase number, as an integer.")
+
+(defvar org-element--cache-sync-timer nil
+ "Timer used for cache synchronization.")
+
+(defvar org-element--cache-sync-keys nil
+ "Hash table used to store keys during synchronization.
+See `org-element--cache-key' for more information.")
+
+(defsubst org-element--cache-key (element)
+ "Return a unique key for ELEMENT in cache tree.
+
+Keys are used to keep a total order among elements in the cache.
+Comparison is done with `org-element--cache-key-less-p'.
+
+When no synchronization is taking place, a key is simply the
+beginning position of the element, or that position plus one in
+the case of an first item (respectively row) in
+a list (respectively a table).
+
+During a synchronization, the key is the one the element had when
+the cache was synchronized for the last time. Elements added to
+cache during the synchronization get a new key generated with
+`org-element--cache-generate-key'.
+
+Such keys are stored in `org-element--cache-sync-keys'. The hash
+table is cleared once the synchronization is complete."
+ (or (gethash element org-element--cache-sync-keys)
+ (let* ((begin (org-element-property :begin element))
+ ;; Increase beginning position of items (respectively
+ ;; table rows) by one, so the first item can get
+ ;; a different key from its parent list (respectively
+ ;; table).
+ (key (if (memq (org-element-type element) '(item table-row))
+ (1+ begin)
+ begin)))
+ (if org-element--cache-sync-requests
+ (puthash element key org-element--cache-sync-keys)
+ key))))
+
+(defun org-element--cache-generate-key (lower upper)
+ "Generate a key between LOWER and UPPER.
+
+LOWER and UPPER are integers or lists, possibly empty.
+
+If LOWER and UPPER are equals, return LOWER. Otherwise, return
+a unique key, as an integer or a list of integers, according to
+the following rules:
+
+ - LOWER and UPPER are compared level-wise until values differ.
+
+ - If, at a given level, LOWER and UPPER differ from more than
+ 2, the new key shares all the levels above with LOWER and
+ gets a new level. Its value is the mean between LOWER and
+ UPPER:
+
+ (1 2) + (1 4) --> (1 3)
+
+ - If LOWER has no value to compare with, it is assumed that its
+ value is `most-negative-fixnum'. E.g.,
+
+ (1 1) + (1 1 2)
+
+ is equivalent to
+
+ (1 1 m) + (1 1 2)
+
+ where m is `most-negative-fixnum'. Likewise, if UPPER is
+ short of levels, the current value is `most-positive-fixnum'.
+
+ - If they differ from only one, the new key inherits from
+ current LOWER level and fork it at the next level. E.g.,
+
+ (2 1) + (3 3)
+
+ is equivalent to
+
+ (2 1) + (2 M)
+
+ where M is `most-positive-fixnum'.
+
+ - If the key is only one level long, it is returned as an
+ integer:
+
+ (1 2) + (3 2) --> 2
+
+When they are not equals, the function assumes that LOWER is
+lesser than UPPER, per `org-element--cache-key-less-p'."
+ (if (equal lower upper) lower
+ (let ((lower (if (integerp lower) (list lower) lower))
+ (upper (if (integerp upper) (list upper) upper))
+ skip-upper key)
+ (catch 'exit
+ (while t
+ (let ((min (or (car lower) most-negative-fixnum))
+ (max (cond (skip-upper most-positive-fixnum)
+ ((car upper))
+ (t most-positive-fixnum))))
+ (if (< (1+ min) max)
+ (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
+ (throw 'exit (if key (nreverse (cons mean key)) mean)))
+ (when (and (< min max) (not skip-upper))
+ ;; When at a given level, LOWER and UPPER differ from
+ ;; 1, ignore UPPER altogether. Instead create a key
+ ;; between LOWER and the greatest key with the same
+ ;; prefix as LOWER so far.
+ (setq skip-upper t))
+ (push min key)
+ (setq lower (cdr lower) upper (cdr upper)))))))))
+
+(defsubst org-element--cache-key-less-p (a b)
+ "Non-nil if key A is less than key B.
+A and B are either integers or lists of integers, as returned by
+`org-element--cache-key'."
+ (if (integerp a) (if (integerp b) (< a b) (<= a (car b)))
+ (if (integerp b) (< (car a) b)
+ (catch 'exit
+ (while (and a b)
+ (cond ((car-less-than-car a b) (throw 'exit t))
+ ((car-less-than-car b a) (throw 'exit nil))
+ (t (setq a (cdr a) b (cdr b)))))
+ ;; If A is empty, either keys are equal (B is also empty) and
+ ;; we return nil, or A is lesser than B (B is longer) and we
+ ;; return a non-nil value.
+ ;;
+ ;; If A is not empty, B is necessarily empty and A is greater
+ ;; than B (A is longer). Therefore, return nil.
+ (and (null a) b)))))
+
+(defun org-element--cache-compare (a b)
+ "Non-nil when element A is located before element B."
+ (org-element--cache-key-less-p (org-element--cache-key a)
+ (org-element--cache-key b)))
+
+(defsubst org-element--cache-root ()
+ "Return root value in cache.
+This function assumes `org-element--cache' is a valid AVL tree."
+ (avl-tree--node-left (avl-tree--dummyroot org-element--cache)))
+
+
+;;;; Tools
+
+(defsubst org-element--cache-active-p ()
+ "Non-nil when cache is active in current buffer."
+ (and org-element-use-cache
+ org-element--cache
+ (derived-mode-p 'org-mode)))
+
+(defun org-element--cache-find (pos &optional side)
+ "Find element in cache starting at POS or before.
+
+POS refers to a buffer position.
+
+When optional argument SIDE is non-nil, the function checks for
+elements starting at or past POS instead. If SIDE is `both', the
+function returns a cons cell where car is the first element
+starting at or before POS and cdr the first element starting
+after POS.
+
+The function can only find elements in the synchronized part of
+the cache."
+ (let ((limit (and org-element--cache-sync-requests
+ (aref (car org-element--cache-sync-requests) 0)))
+ (node (org-element--cache-root))
+ lower upper)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((and limit
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key element) limit)))
+ (setq node (avl-tree--node-left node)))
+ ((> begin pos)
+ (setq upper element
+ node (avl-tree--node-left node)))
+ ((< begin pos)
+ (setq lower element
+ node (avl-tree--node-right node)))
+ ;; We found an element in cache starting at POS. If `side'
+ ;; is `both' we also want the next one in order to generate
+ ;; a key in-between.
+ ;;
+ ;; If the element is the first row or item in a table or
+ ;; a plain list, we always return the table or the plain
+ ;; list.
+ ;;
+ ;; In any other case, we return the element found.
+ ((eq side 'both)
+ (setq lower element)
+ (setq node (avl-tree--node-right node)))
+ ((and (memq (org-element-type element) '(item table-row))
+ (let ((parent (org-element-property :parent element)))
+ (and (= (org-element-property :begin element)
+ (org-element-property :contents-begin parent))
+ (setq node nil
+ lower parent
+ upper parent)))))
+ (t
+ (setq node nil
+ lower element
+ upper element)))))
+ (pcase side
+ (`both (cons lower upper))
+ (`nil lower)
+ (_ upper))))
+
+(defun org-element--cache-put (element)
+ "Store ELEMENT in current buffer's cache, if allowed."
+ (when (org-element--cache-active-p)
+ (when org-element--cache-sync-requests
+ ;; During synchronization, first build an appropriate key for
+ ;; the new element so `avl-tree-enter' can insert it at the
+ ;; right spot in the cache.
+ (let ((keys (org-element--cache-find
+ (org-element-property :begin element) 'both)))
+ (puthash element
+ (org-element--cache-generate-key
+ (and (car keys) (org-element--cache-key (car keys)))
+ (cond ((cdr keys) (org-element--cache-key (cdr keys)))
+ (org-element--cache-sync-requests
+ (aref (car org-element--cache-sync-requests) 0))))
+ org-element--cache-sync-keys)))
+ (avl-tree-enter org-element--cache element)))
+
+(defsubst org-element--cache-remove (element)
+ "Remove ELEMENT from cache.
+Assume ELEMENT belongs to cache and that a cache is active."
+ (avl-tree-delete org-element--cache element))
+
+
+;;;; Synchronization
+
+(defsubst org-element--cache-set-timer (buffer)
+ "Set idle timer for cache synchronization in BUFFER."
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (setq org-element--cache-sync-timer
+ (run-with-idle-timer
+ (let ((idle (current-idle-time)))
+ (if idle (time-add idle org-element-cache-sync-break)
+ org-element-cache-sync-idle-time))
+ nil
+ #'org-element--cache-sync
+ buffer)))
+
+(defsubst org-element--cache-interrupt-p (time-limit)
+ "Non-nil when synchronization process should be interrupted.
+TIME-LIMIT is a time value or nil."
+ (and time-limit
+ (or (input-pending-p)
+ (time-less-p time-limit (current-time)))))
+
+(defsubst org-element--cache-shift-positions (element offset &optional props)
+ "Shift ELEMENT properties relative to buffer positions by OFFSET.
+
+Properties containing buffer positions are `:begin', `:end',
+`:contents-begin', `:contents-end' and `:structure'. When
+optional argument PROPS is a list of keywords, only shift
+properties provided in that list.
+
+Properties are modified by side-effect."
+ (let ((properties (nth 1 element)))
+ ;; Shift `:structure' property for the first plain list only: it
+ ;; is the only one that really matters and it prevents from
+ ;; shifting it more than once.
+ (when (and (or (not props) (memq :structure props))
+ (eq (org-element-type element) 'plain-list)
+ (not (eq (org-element-type (plist-get properties :parent))
+ 'item)))
+ (dolist (item (plist-get properties :structure))
+ (cl-incf (car item) offset)
+ (cl-incf (nth 6 item) offset)))
+ (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
+ (let ((value (and (or (not props) (memq key props))
+ (plist-get properties key))))
+ (and value (plist-put properties key (+ offset value)))))))
+
+(defun org-element--cache-sync (buffer &optional threshold future-change)
+ "Synchronize cache with recent modification in BUFFER.
+
+When optional argument THRESHOLD is non-nil, do the
+synchronization for all elements starting before or at threshold,
+then exit. Otherwise, synchronize cache for as long as
+`org-element-cache-sync-duration' or until Emacs leaves idle
+state.
+
+FUTURE-CHANGE, when non-nil, is a buffer position where changes
+not registered yet in the cache are going to happen. It is used
+in `org-element--cache-submit-request', where cache is partially
+updated before current modification are actually submitted."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((inhibit-quit t) request next)
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (catch 'interrupt
+ (while org-element--cache-sync-requests
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ (org-element--cache-process-request
+ request
+ (and next (aref next 0))
+ threshold
+ (and (not threshold)
+ (time-add (current-time)
+ org-element-cache-sync-duration))
+ future-change)
+ ;; Request processed. Merge current and next offsets and
+ ;; transfer ending position.
+ (when next
+ (cl-incf (aref next 3) (aref request 3))
+ (aset next 2 (aref request 2)))
+ (setq org-element--cache-sync-requests
+ (cdr org-element--cache-sync-requests))))
+ ;; If more requests are awaiting, set idle timer accordingly.
+ ;; Otherwise, reset keys.
+ (if org-element--cache-sync-requests
+ (org-element--cache-set-timer buffer)
+ (clrhash org-element--cache-sync-keys))))))
+
+(defun org-element--cache-process-request
+ (request next threshold time-limit future-change)
+ "Process synchronization REQUEST for all entries before NEXT.
+
+REQUEST is a vector, built by `org-element--cache-submit-request'.
+
+NEXT is a cache key, as returned by `org-element--cache-key'.
+
+When non-nil, THRESHOLD is a buffer position. Synchronization
+stops as soon as a shifted element begins after it.
+
+When non-nil, TIME-LIMIT is a time value. Synchronization stops
+after this time or when Emacs exits idle state.
+
+When non-nil, FUTURE-CHANGE is a buffer position where changes
+not registered yet in the cache are going to happen. See
+`org-element--cache-submit-request' for more information.
+
+Throw `interrupt' if the process stops before completing the
+request."
+ (catch 'quit
+ (when (= (aref request 5) 0)
+ ;; Phase 0.
+ ;;
+ ;; Delete all elements starting after BEG, but not after buffer
+ ;; position END or past element with key NEXT. Also delete
+ ;; elements contained within a previously removed element
+ ;; (stored in `last-container').
+ ;;
+ ;; At each iteration, we start again at tree root since
+ ;; a deletion modifies structure of the balanced tree.
+ (catch 'end-phase
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))
+ ;; Find first element in cache with key BEG or after it.
+ (let ((beg (aref request 0))
+ (end (aref request 2))
+ (node (org-element--cache-root))
+ data data-key last-container)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (key (org-element--cache-key element)))
+ (cond
+ ((org-element--cache-key-less-p key beg)
+ (setq node (avl-tree--node-right node)))
+ ((org-element--cache-key-less-p beg key)
+ (setq data element
+ data-key key
+ node (avl-tree--node-left node)))
+ (t (setq data element
+ data-key key
+ node nil)))))
+ (if data
+ (let ((pos (org-element-property :begin data)))
+ (if (if (or (not next)
+ (org-element--cache-key-less-p data-key next))
+ (<= pos end)
+ (and last-container
+ (let ((up data))
+ (while (and up (not (eq up last-container)))
+ (setq up (org-element-property :parent up)))
+ up)))
+ (progn (when (and (not last-container)
+ (> (org-element-property :end data)
+ end))
+ (setq last-container data))
+ (org-element--cache-remove data))
+ (aset request 0 data-key)
+ (aset request 1 pos)
+ (aset request 5 1)
+ (throw 'end-phase nil)))
+ ;; No element starting after modifications left in
+ ;; cache: further processing is futile.
+ (throw 'quit t))))))
+ (when (= (aref request 5) 1)
+ ;; Phase 1.
+ ;;
+ ;; Phase 0 left a hole in the cache. Some elements after it
+ ;; could have parents within. For example, in the following
+ ;; buffer:
+ ;;
+ ;; - item
+ ;;
+ ;;
+ ;; Paragraph1
+ ;;
+ ;; Paragraph2
+ ;;
+ ;; if we remove a blank line between "item" and "Paragraph1",
+ ;; everything down to "Paragraph2" is removed from cache. But
+ ;; the paragraph now belongs to the list, and its `:parent'
+ ;; property no longer is accurate.
+ ;;
+ ;; Therefore we need to parse again elements in the hole, or at
+ ;; least in its last section, so that we can re-parent
+ ;; subsequent elements, during phase 2.
+ ;;
+ ;; Note that we only need to get the parent from the first
+ ;; element in cache after the hole.
+ ;;
+ ;; When next key is lesser or equal to the current one, delegate
+ ;; phase 1 processing to next request in order to preserve key
+ ;; order among requests.
+ (let ((key (aref request 0)))
+ (when (and next (not (org-element--cache-key-less-p key next)))
+ (let ((next-request (nth 1 org-element--cache-sync-requests)))
+ (aset next-request 0 key)
+ (aset next-request 1 (aref request 1))
+ (aset next-request 5 1))
+ (throw 'quit t)))
+ ;; Next element will start at its beginning position plus
+ ;; offset, since it hasn't been shifted yet. Therefore, LIMIT
+ ;; contains the real beginning position of the first element to
+ ;; shift and re-parent.
+ (let ((limit (+ (aref request 1) (aref request 3))))
+ (cond ((and threshold (> limit threshold)) (throw 'interrupt nil))
+ ((and future-change (>= limit future-change))
+ ;; Changes are going to happen around this element and
+ ;; they will trigger another phase 1 request. Skip the
+ ;; current one.
+ (aset request 5 2))
+ (t
+ (let ((parent (org-element--parse-to limit t time-limit)))
+ (aset request 4 parent)
+ (aset request 5 2))))))
+ ;; Phase 2.
+ ;;
+ ;; Shift all elements starting from key START, but before NEXT, by
+ ;; OFFSET, and re-parent them when appropriate.
+ ;;
+ ;; Elements are modified by side-effect so the tree structure
+ ;; remains intact.
+ ;;
+ ;; Once THRESHOLD, if any, is reached, or once there is an input
+ ;; pending, exit. Before leaving, the current synchronization
+ ;; request is updated.
+ (let ((start (aref request 0))
+ (offset (aref request 3))
+ (parent (aref request 4))
+ (node (org-element--cache-root))
+ (stack (list nil))
+ (leftp t)
+ exit-flag)
+ ;; No re-parenting nor shifting planned: request is over.
+ (when (and (not parent) (zerop offset)) (throw 'quit t))
+ (while node
+ (let* ((data (avl-tree--node-data node))
+ (key (org-element--cache-key data)))
+ (if (and leftp (avl-tree--node-left node)
+ (not (org-element--cache-key-less-p key start)))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ (unless (org-element--cache-key-less-p key start)
+ ;; We reached NEXT. Request is complete.
+ (when (equal key next) (throw 'quit t))
+ ;; Handle interruption request. Update current request.
+ (when (or exit-flag (org-element--cache-interrupt-p time-limit))
+ (aset request 0 key)
+ (aset request 4 parent)
+ (throw 'interrupt nil))
+ ;; Shift element.
+ (unless (zerop offset)
+ (org-element--cache-shift-positions data offset))
+ (let ((begin (org-element-property :begin data)))
+ ;; Update PARENT and re-parent DATA, only when
+ ;; necessary. Propagate new structures for lists.
+ (while (and parent
+ (<= (org-element-property :end parent) begin))
+ (setq parent (org-element-property :parent parent)))
+ (cond ((and (not parent) (zerop offset)) (throw 'quit nil))
+ ((and parent
+ (let ((p (org-element-property :parent data)))
+ (or (not p)
+ (< (org-element-property :begin p)
+ (org-element-property :begin parent)))))
+ (org-element-put-property data :parent parent)
+ (let ((s (org-element-property :structure parent)))
+ (when (and s (org-element-property :structure data))
+ (org-element-put-property data :structure s)))))
+ ;; Cache is up-to-date past THRESHOLD. Request
+ ;; interruption.
+ (when (and threshold (> begin threshold)) (setq exit-flag t))))
+ (setq node (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack))))))
+ ;; We reached end of tree: synchronization complete.
+ t)))
+
+(defun org-element--parse-to (pos &optional syncp time-limit)
+ "Parse elements in current section, down to POS.
+
+Start parsing from the closest between the last known element in
+cache or headline above. Return the smallest element containing
+POS.
+
+When optional argument SYNCP is non-nil, return the parent of the
+element containing POS instead. In that case, it is also
+possible to provide TIME-LIMIT, which is a time value specifying
+when the parsing should stop. The function throws `interrupt' if
+the process stopped before finding the expected result."
+ (catch 'exit
+ (org-with-wide-buffer
+ (goto-char pos)
+ (let* ((cached (and (org-element--cache-active-p)
+ (org-element--cache-find pos nil)))
+ (begin (org-element-property :begin cached))
+ element next mode)
+ (cond
+ ;; Nothing in cache before point: start parsing from first
+ ;; element following headline above, or first element in
+ ;; buffer.
+ ((not cached)
+ (when (org-with-limited-levels (outline-previous-heading))
+ (setq mode 'planning)
+ (forward-line))
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line))
+ ;; Cache returned exact match: return it.
+ ((= pos begin)
+ (throw 'exit (if syncp (org-element-property :parent cached) cached)))
+ ;; There's a headline between cached value and POS: cached
+ ;; value is invalid. Start parsing from first element
+ ;; following the headline.
+ ((re-search-backward
+ (org-with-limited-levels org-outline-regexp-bol) begin t)
+ (forward-line)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (setq mode 'planning))
+ ;; Check if CACHED or any of its ancestors contain point.
+ ;;
+ ;; If there is such an element, we inspect it in order to know
+ ;; if we return it or if we need to parse its contents.
+ ;; Otherwise, we just start parsing from current location,
+ ;; which is right after the top-most element containing
+ ;; CACHED.
+ ;;
+ ;; As a special case, if POS is at the end of the buffer, we
+ ;; want to return the innermost element ending there.
+ ;;
+ ;; Also, if we find an ancestor and discover that we need to
+ ;; parse its contents, make sure we don't start from
+ ;; `:contents-begin', as we would otherwise go past CACHED
+ ;; again. Instead, in that situation, we will resume parsing
+ ;; from NEXT, which is located after CACHED or its higher
+ ;; ancestor not containing point.
+ (t
+ (let ((up cached)
+ (pos (if (= (point-max) pos) (1- pos) pos)))
+ (goto-char (or (org-element-property :contents-begin cached) begin))
+ (while (let ((end (org-element-property :end up)))
+ (and (<= end pos)
+ (goto-char end)
+ (setq up (org-element-property :parent up)))))
+ (cond ((not up))
+ ((eobp) (setq element up))
+ (t (setq element up next (point)))))))
+ ;; Parse successively each element until we reach POS.
+ (let ((end (or (org-element-property :end element)
+ (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ (parent element))
+ (while t
+ (when syncp
+ (cond ((= (point) pos) (throw 'exit parent))
+ ((org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))))
+ (unless element
+ (setq element (org-element--current-element
+ end 'element mode
+ (org-element-property :structure parent)))
+ (org-element-put-property element :parent parent)
+ (org-element--cache-put element))
+ (let ((elem-end (org-element-property :end element))
+ (type (org-element-type element)))
+ (cond
+ ;; Skip any element ending before point. Also skip
+ ;; element ending at point (unless it is also the end of
+ ;; buffer) since we're sure that another element begins
+ ;; after it.
+ ((and (<= elem-end pos) (/= (point-max) elem-end))
+ (goto-char elem-end)
+ (setq mode (org-element--next-mode type nil)))
+ ;; A non-greater element contains point: return it.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit element))
+ ;; Otherwise, we have to decide if ELEMENT really
+ ;; contains POS. In that case we start parsing from
+ ;; contents' beginning.
+ ;;
+ ;; If POS is at contents' beginning but it is also at
+ ;; the beginning of the first item in a list or a table.
+ ;; In that case, we need to create an anchor for that
+ ;; list or table, so return it.
+ ;;
+ ;; Also, if POS is at the end of the buffer, no element
+ ;; can start after it, but more than one may end there.
+ ;; Arbitrarily, we choose to return the innermost of
+ ;; such elements.
+ ((let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (when (or syncp
+ (and cbeg cend
+ (or (< cbeg pos)
+ (and (= cbeg pos)
+ (not (memq type '(plain-list table)))))
+ (or (> cend pos)
+ (and (= cend pos) (= (point-max) pos)))))
+ (goto-char (or next cbeg))
+ (setq next nil
+ mode (org-element--next-mode type t)
+ parent element
+ end cend))))
+ ;; Otherwise, return ELEMENT as it is the smallest
+ ;; element containing POS.
+ (t (throw 'exit element))))
+ (setq element nil)))))))
+
+
+;;;; Staging Buffer Changes
+
+(defconst org-element--cache-sensitive-re
+ (concat
+ org-outline-regexp-bol "\\|"
+ "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
+ "^[ \t]*\\(?:"
+ "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
+ "\\\\begin{[A-Za-z0-9*]+}" "\\|"
+ ":\\(?:\\w\\|[-_]\\)+:[ \t]*$"
+ "\\)")
+ "Regexp matching a sensitive line, structure wise.
+A sensitive line is a headline, inlinetask, block, drawer, or
+latex-environment boundary. When such a line is modified,
+structure changes in the document may propagate in the whole
+section, possibly making cache invalid.")
+
+(defvar org-element--cache-change-warning nil
+ "Non-nil when a sensitive line is about to be changed.
+It is a symbol among nil, t and `headline'.")
+
+(defun org-element--cache-before-change (beg end)
+ "Request extension of area going to be modified if needed.
+BEG and END are the beginning and end of the range of changed
+text. See `before-change-functions' for more information."
+ (when (org-element--cache-active-p)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((bottom (save-excursion (goto-char end) (line-end-position))))
+ (setq org-element--cache-change-warning
+ (save-match-data
+ (if (and (org-with-limited-levels (org-at-heading-p))
+ (= (line-end-position) bottom))
+ 'headline
+ (let ((case-fold-search t))
+ (re-search-forward
+ org-element--cache-sensitive-re bottom t)))))))))
+
+(defun org-element--cache-after-change (beg end pre)
+ "Update buffer modifications for current buffer.
+BEG and END are the beginning and end of the range of changed
+text, and the length in bytes of the pre-change text replaced by
+that range. See `after-change-functions' for more information."
+ (when (org-element--cache-active-p)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (save-match-data
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position))))
+ ;; Determine if modified area needs to be extended, according
+ ;; to both previous and current state. We make a special
+ ;; case for headline editing: if a headline is modified but
+ ;; not removed, do not extend.
+ (when (pcase org-element--cache-change-warning
+ (`t t)
+ (`headline
+ (not (and (org-with-limited-levels (org-at-heading-p))
+ (= (line-end-position) bottom))))
+ (_
+ (let ((case-fold-search t))
+ (re-search-forward
+ org-element--cache-sensitive-re bottom t))))
+ ;; Effectively extend modified area.
+ (org-with-limited-levels
+ (setq top (progn (goto-char top)
+ (when (outline-previous-heading) (forward-line))
+ (point)))
+ (setq bottom (progn (goto-char bottom)
+ (if (outline-next-heading) (1- (point))
+ (point))))))
+ ;; Store synchronization request.
+ (let ((offset (- end beg pre)))
+ (org-element--cache-submit-request top (- bottom offset) offset)))))
+ ;; Activate a timer to process the request during idle time.
+ (org-element--cache-set-timer (current-buffer))))
+
+(defun org-element--cache-for-removal (beg end offset)
+ "Return first element to remove from cache.
+
+BEG and END are buffer positions delimiting buffer modifications.
+OFFSET is the size of the changes.
+
+Returned element is usually the first element in cache containing
+any position between BEG and END. As an exception, greater
+elements around the changes that are robust to contents
+modifications are preserved and updated according to the
+changes."
+ (let* ((elements (org-element--cache-find (1- beg) 'both))
+ (before (car elements))
+ (after (cdr elements)))
+ (if (not before) after
+ (let ((up before)
+ (robust-flag t))
+ (while up
+ (if (let ((type (org-element-type up)))
+ (and (or (memq type '(center-block dynamic-block quote-block
+ special-block))
+ ;; Drawers named "PROPERTIES" are probably
+ ;; a properties drawer being edited. Force
+ ;; parsing to check if editing is over.
+ (and (eq type 'drawer)
+ (not (string=
+ (org-element-property :drawer-name up)
+ "PROPERTIES"))))
+ (let ((cbeg (org-element-property :contents-begin up)))
+ (and cbeg
+ (<= cbeg beg)
+ (> (org-element-property :contents-end up) end)))))
+ ;; UP is a robust greater element containing changes.
+ ;; We only need to extend its ending boundaries.
+ (org-element--cache-shift-positions
+ up offset '(:contents-end :end))
+ (setq before up)
+ (when robust-flag (setq robust-flag nil)))
+ (setq up (org-element-property :parent up)))
+ ;; We're at top level element containing ELEMENT: if it's
+ ;; altered by buffer modifications, it is first element in
+ ;; cache to be removed. Otherwise, that first element is the
+ ;; following one.
+ ;;
+ ;; As a special case, do not remove BEFORE if it is a robust
+ ;; container for current changes.
+ (if (or (< (org-element-property :end before) beg) robust-flag) after
+ before)))))
+
+(defun org-element--cache-submit-request (beg end offset)
+ "Submit a new cache synchronization request for current buffer.
+BEG and END are buffer positions delimiting the minimal area
+where cache data should be removed. OFFSET is the size of the
+change, as an integer."
+ (let ((next (car org-element--cache-sync-requests))
+ delete-to delete-from)
+ (if (and next
+ (zerop (aref next 5))
+ (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
+ (<= (setq delete-from (aref next 1)) end))
+ ;; Current changes can be merged with first sync request: we
+ ;; can save a partial cache synchronization.
+ (progn
+ (cl-incf (aref next 3) offset)
+ ;; If last change happened within area to be removed, extend
+ ;; boundaries of robust parents, if any. Otherwise, find
+ ;; first element to remove and update request accordingly.
+ (if (> beg delete-from)
+ (let ((up (aref next 4)))
+ (while up
+ (org-element--cache-shift-positions
+ up offset '(:contents-end :end))
+ (setq up (org-element-property :parent up))))
+ (let ((first (org-element--cache-for-removal beg delete-to offset)))
+ (when first
+ (aset next 0 (org-element--cache-key first))
+ (aset next 1 (org-element-property :begin first))
+ (aset next 4 (org-element-property :parent first))))))
+ ;; Ensure cache is correct up to END. Also make sure that NEXT,
+ ;; if any, is no longer a 0-phase request, thus ensuring that
+ ;; phases are properly ordered. We need to provide OFFSET as
+ ;; optional parameter since current modifications are not known
+ ;; yet to the otherwise correct part of the cache (i.e, before
+ ;; the first request).
+ (when next (org-element--cache-sync (current-buffer) end beg))
+ (let ((first (org-element--cache-for-removal beg end offset)))
+ (if first
+ (push (let ((beg (org-element-property :begin first))
+ (key (org-element--cache-key first)))
+ (cond
+ ;; When changes happen before the first known
+ ;; element, re-parent and shift the rest of the
+ ;; cache.
+ ((> beg end) (vector key beg nil offset nil 1))
+ ;; Otherwise, we find the first non robust
+ ;; element containing END. All elements between
+ ;; FIRST and this one are to be removed.
+ ((let ((first-end (org-element-property :end first)))
+ (and (> first-end end)
+ (vector key beg first-end offset first 0))))
+ (t
+ (let* ((element (org-element--cache-find end))
+ (end (org-element-property :end element))
+ (up element))
+ (while (and (setq up (org-element-property :parent up))
+ (>= (org-element-property :begin up) beg))
+ (setq end (org-element-property :end up)
+ element up))
+ (vector key beg end offset element 0)))))
+ org-element--cache-sync-requests)
+ ;; No element to remove. No need to re-parent either.
+ ;; Simply shift additional elements, if any, by OFFSET.
+ (when org-element--cache-sync-requests
+ (cl-incf (aref (car org-element--cache-sync-requests) 3)
+ offset)))))))
+
+
+;;;; Public Functions
+
+;;;###autoload
+(defun org-element-cache-reset (&optional all)
+ "Reset cache in current buffer.
+When optional argument ALL is non-nil, reset cache in all Org
+buffers."
+ (interactive "P")
+ (dolist (buffer (if all (buffer-list) (list (current-buffer))))
+ (with-current-buffer buffer
+ (when (and org-element-use-cache (derived-mode-p 'org-mode))
+ (setq-local org-element--cache
+ (avl-tree-create #'org-element--cache-compare))
+ (setq-local org-element--cache-sync-keys
+ (make-hash-table :weakness 'key :test #'eq))
+ (setq-local org-element--cache-change-warning nil)
+ (setq-local org-element--cache-sync-requests nil)
+ (setq-local org-element--cache-sync-timer nil)
+ (add-hook 'before-change-functions
+ #'org-element--cache-before-change nil t)
+ (add-hook 'after-change-functions
+ #'org-element--cache-after-change nil t)))))
+
+;;;###autoload
+(defun org-element-cache-refresh (pos)
+ "Refresh cache at position POS."
+ (when (org-element--cache-active-p)
+ (org-element--cache-sync (current-buffer) pos)
+ (org-element--cache-submit-request pos pos 0)
+ (org-element--cache-set-timer (current-buffer))))
@@ -4678,7 +5688,7 @@ indentation is not done with TAB characters."
;; The first move is to implement a way to obtain the smallest element
;; containing point. This is the job of `org-element-at-point'. It
;; basically jumps back to the beginning of section containing point
-;; and moves, element after element, with
+;; and proceed, one element after the other, with
;; `org-element--current-element' until the container is found. Note:
;; When using `org-element-at-point', secondary values are never
;; parsed since the function focuses on elements, not on objects.
@@ -4689,8 +5699,9 @@ indentation is not done with TAB characters."
;; `org-element-nested-p' and `org-element-swap-A-B' may be used
;; internally by navigation and manipulation tools.
+
;;;###autoload
-(defun org-element-at-point (&optional keep-trail)
+(defun org-element-at-point ()
"Determine closest element around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -4701,118 +5712,36 @@ 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.
-As a special case, if point is at the very beginning of a list or
-sub-list, returned element will be that list instead of the first
-item. In the same way, if point is at the beginning of the first
-row of a table, returned element will be the table instead of the
-first row.
-
-If optional argument KEEP-TRAIL is non-nil, the function returns
-a list of elements leading to element at point. The list's CAR
-is always the element at point. The following positions contain
-element's siblings, then parents, siblings of parents, until the
-first element of current section."
+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
+instead of the item. Likewise, if point is at the beginning of
+the first row of a table, returned element will be the table
+instead of the first row.
+
+When point is at the end of the buffer, return the innermost
+element ending there."
(org-with-wide-buffer
- ;; If at a headline, parse it. It is the sole element that
- ;; doesn't require to know about context. Be sure to disallow
- ;; secondary string parsing, though.
- (if (org-with-limited-levels (org-at-heading-p))
- (progn
- (beginning-of-line)
- (if (not keep-trail) (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser (point-max) t))))
- ;; Otherwise move at the beginning of the section containing
- ;; point.
- (catch 'exit
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-before-first-heading-p)
- ;; In empty lines at buffer's beginning, return nil.
- (progn (goto-char (point-min))
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- (throw 'exit nil)))
- (org-back-to-heading)
- (forward-line)
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- ;; In blank lines just after the headline, point still
- ;; belongs to the headline.
- (throw 'exit
- (progn (skip-chars-backward " \r\t\n")
- (beginning-of-line)
- (if (not keep-trail)
- (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser
- (point-max) t))))))))
- (beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (while t
- (setq element
- (org-element--current-element end 'element special-flag struct)
- type (car element))
- (org-element-put-property element :parent parent)
- (when keep-trail (push element trail))
- (cond
- ;; 1. Skip any element ending before point. Also skip
- ;; element ending at point when we're sure that another
- ;; element has started.
- ((let ((elem-end (org-element-property :end element)))
- (when (or (< elem-end origin)
- (and (= elem-end origin) (/= elem-end end)))
- (goto-char elem-end))))
- ;; 2. An element containing point is always the element at
- ;; point.
- ((not (memq type org-element-greater-elements))
- (throw 'exit (if keep-trail trail element)))
- ;; 3. At any other greater element type, if point is
- ;; within contents, move into it.
- (t
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
- ;; Create an anchor for tables and plain lists:
- ;; when point is at the very beginning of these
- ;; elements, ignoring affiliated keywords,
- ;; target them instead of their contents.
- (and (= cbeg origin) (memq type '(plain-list table)))
- ;; When point is at contents end, do not move
- ;; into elements with an explicit ending, but
- ;; return that element instead.
- (and (= cend origin)
- (or (memq type
- '(center-block
- drawer dynamic-block inlinetask
- property-drawer quote-block
- special-block))
- ;; Corner case: if a list ends at the
- ;; end of a buffer without a final new
- ;; line, return last element in last
- ;; item instead.
- (and (memq type '(item plain-list))
- (progn (goto-char cend)
- (or (bolp) (not (eobp))))))))
- (throw 'exit (if keep-trail trail element))
- (setq parent element)
- (case type
- (plain-list
- (setq special-flag 'item
- struct (org-element-property :structure element)))
- (item (setq special-flag nil))
- (property-drawer
- (setq special-flag 'node-property struct nil))
- (table (setq special-flag 'table-row struct nil))
- (otherwise (setq special-flag nil struct nil)))
- (setq end cend)
- (goto-char cbeg)))))))))))
+ (let ((origin (point)))
+ (end-of-line)
+ (skip-chars-backward " \r\t\n")
+ (cond
+ ;; Within blank lines at the beginning of buffer, return nil.
+ ((bobp) nil)
+ ;; Within blank lines right after a headline, return that
+ ;; headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (beginning-of-line)
+ (org-element-headline-parser (point-max) t))
+ ;; Otherwise parse until we find element containing ORIGIN.
+ (t
+ (when (org-element--cache-active-p)
+ (if (not org-element--cache) (org-element-cache-reset)
+ (org-element--cache-sync (current-buffer) origin)))
+ (org-element--parse-to origin))))))
;;;###autoload
(defun org-element-context (&optional element)
- "Return closest element or object around point.
+ "Return smallest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element or object and PROPS a plist of properties
@@ -4823,34 +5752,36 @@ Possible types are defined in `org-element-all-elements' and
object type, but always include `:begin', `:end', `:parent' and
`:post-blank'.
+As a special case, if point is right after an object and not at
+the beginning of any other object, return that object.
+
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation."
(catch 'objects-forbidden
(org-with-wide-buffer
- (let* ((origin (point))
- (element (or element (org-element-at-point)))
- (type (org-element-type element))
- context)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, narrow buffer to the
- ;; containing area. Otherwise, return ELEMENT.
+ (let* ((pos (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ (post (org-element-property :post-affiliated element)))
+ ;; If point is inside an element containing objects or
+ ;; a secondary string, narrow buffer to the container and
+ ;; proceed with parsing. Otherwise, return ELEMENT.
(cond
;; At a parsed affiliated keyword, check if we're inside main
;; or dual value.
- ((let ((post (org-element-property :post-affiliated element)))
- (and post (< origin post)))
+ ((and post (< pos post))
(beginning-of-line)
(let ((case-fold-search t)) (looking-at org-element--affiliated-re))
(cond
((not (member-ignore-case (match-string 1)
org-element-parsed-keywords))
(throw 'objects-forbidden element))
- ((< (match-end 0) origin)
+ ((< (match-end 0) pos)
(narrow-to-region (match-end 0) (line-end-position)))
((and (match-beginning 2)
- (>= origin (match-beginning 2))
- (< origin (match-end 2)))
+ (>= pos (match-beginning 2))
+ (< pos (match-end 2)))
(narrow-to-region (match-beginning 2) (match-end 2)))
(t (throw 'objects-forbidden element)))
;; Also change type to retrieve correct restrictions.
@@ -4858,88 +5789,108 @@ Providing it allows for quicker computation."
;; At an item, objects can only be located within tag, if any.
((eq type 'item)
(let ((tag (org-element-property :tag element)))
- (if (not tag) (throw 'objects-forbidden element)
+ (if (or (not tag) (/= (line-beginning-position) post))
+ (throw 'objects-forbidden element)
(beginning-of-line)
(search-forward tag (line-end-position))
(goto-char (match-beginning 0))
- (if (and (>= origin (point)) (< origin (match-end 0)))
+ (if (and (>= pos (point)) (< pos (match-end 0)))
(narrow-to-region (point) (match-end 0))
(throw 'objects-forbidden element)))))
- ;; At an headline or inlinetask, objects are located within
- ;; their title.
+ ;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
- (goto-char (org-element-property :begin element))
- (skip-chars-forward "*")
- (if (and (> origin (point)) (< origin (line-end-position)))
- (narrow-to-region (point) (line-end-position))
- (throw 'objects-forbidden element)))
+ (let ((case-fold-search nil))
+ (goto-char (org-element-property :begin element))
+ (looking-at org-complex-heading-regexp)
+ (let ((end (match-end 4)))
+ (if (not end) (throw 'objects-forbidden element)
+ (goto-char (match-beginning 4))
+ (when (looking-at org-comment-string)
+ (goto-char (match-end 0)))
+ (if (>= (point) end) (throw 'objects-forbidden element)
+ (narrow-to-region (point) end))))))
;; At a paragraph, a table-row or a verse block, objects are
;; located within their contents.
((memq type '(paragraph table-row verse-block))
(let ((cbeg (org-element-property :contents-begin element))
(cend (org-element-property :contents-end element)))
;; CBEG is nil for table rules.
- (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (if (and cbeg cend (>= pos cbeg)
+ (or (< pos cend) (and (= pos cend) (eobp))))
(narrow-to-region cbeg cend)
(throw 'objects-forbidden element))))
- ;; At a parsed keyword, objects are located within value.
- ((eq type 'keyword)
- (if (not (member (org-element-property :key element)
- org-element-document-properties))
- (throw 'objects-forbidden element)
- (beginning-of-line)
- (search-forward ":")
- (if (and (>= origin (point)) (< origin (line-end-position)))
- (narrow-to-region (point) (line-end-position))
- (throw 'objects-forbidden element))))
- ;; At a planning line, if point is at a timestamp, return it,
- ;; otherwise, return element.
- ((eq type 'planning)
- (dolist (p '(:closed :deadline :scheduled))
- (let ((timestamp (org-element-property p element)))
- (when (and timestamp
- (<= (org-element-property :begin timestamp) origin)
- (> (org-element-property :end timestamp) origin))
- (throw 'objects-forbidden timestamp))))
- (throw 'objects-forbidden element))
(t (throw 'objects-forbidden element)))
(goto-char (point-min))
(let ((restriction (org-element-restriction type))
- (parent element)
- (candidates 'initial))
- (catch 'exit
- (while (setq candidates
- (org-element--get-next-object-candidates
- restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin) (goto-char obj-end))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (< origin cbeg) (>= origin cend))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (narrow-to-region (point) cend)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- candidates 'initial)))))))
- parent))))))
+ (parent element)
+ last)
+ (catch 'exit
+ (while t
+ (let ((next (org-element--object-lex restriction)))
+ (when next (org-element-put-property next :parent parent))
+ ;; Process NEXT, if any, in order to know if we need to
+ ;; skip it, return it or move into it.
+ (if (or (not next) (> (org-element-property :begin next) pos))
+ (throw 'exit (or last parent))
+ (let ((end (org-element-property :end next))
+ (cbeg (org-element-property :contents-begin next))
+ (cend (org-element-property :contents-end next)))
+ (cond
+ ;; Skip objects ending before point. Also skip
+ ;; objects ending at point unless it is also the
+ ;; end of buffer, since we want to return the
+ ;; innermost object.
+ ((and (<= end pos) (/= (point-max) end))
+ (goto-char end)
+ ;; For convenience, when object ends at POS,
+ ;; without any space, store it in LAST, as we
+ ;; will return it if no object starts here.
+ (when (and (= end pos)
+ (not (memq (char-before) '(?\s ?\t))))
+ (setq last next)))
+ ;; If POS is within a container object, move into
+ ;; that object.
+ ((and cbeg cend
+ (>= pos cbeg)
+ (or (< pos cend)
+ ;; At contents' end, if there is no
+ ;; space before point, also move into
+ ;; object, for consistency with
+ ;; convenience feature above.
+ (and (= pos cend)
+ (or (= (point-max) pos)
+ (not (memq (char-before pos)
+ '(?\s ?\t)))))))
+ (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (setq parent next)
+ (setq restriction (org-element-restriction next)))
+ ;; Otherwise, return NEXT.
+ (t (throw 'exit next)))))))))))))
+
+(defun org-element-lineage (blob &optional types with-self)
+ "List all ancestors of a given element or object.
+
+BLOB is an object or element.
+
+When optional argument TYPES is a list of symbols, return the
+first element or object in the lineage whose type belongs to that
+list.
+
+When optional argument WITH-SELF is non-nil, lineage includes
+BLOB itself as the first element, and TYPES, if provided, also
+apply to it.
+
+When BLOB is obtained through `org-element-context' or
+`org-element-at-point', only ancestors from its section can be
+found. There is no such limitation when BLOB belongs to a full
+parse tree."
+ (let ((up (if with-self blob (org-element-property :parent blob)))
+ ancestors)
+ (while (and up (not (memq (org-element-type up) types)))
+ (unless types (push up ancestors))
+ (setq up (org-element-property :parent up)))
+ (if types up (nreverse ancestors))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
@@ -4982,39 +5933,44 @@ end of ELEM-A."
(goto-char (org-element-property :end elem-B))
(skip-chars-backward " \r\t\n")
(point-at-eol)))
- ;; Store overlays responsible for visibility status. We
- ;; also need to store their boundaries as they will be
+ ;; Store inner overlays responsible for visibility status.
+ ;; We also need to store their boundaries as they will be
;; removed from buffer.
(overlays
(cons
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-A end-A))
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-B end-B))))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-A)
+ (<= (overlay-end o) end-A)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-A end-A)))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-B)
+ (<= (overlay-end o) end-B)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-B end-B)))))
;; Get contents.
(body-A (buffer-substring beg-A end-A))
(body-B (delete-and-extract-region beg-B end-B)))
(goto-char beg-B)
(when specialp
(setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
- (org-indent-to-column ind-B))
+ (indent-to-column ind-B))
(insert body-A)
;; Restore ex ELEM-A overlays.
(let ((offset (- beg-B beg-A)))
- (mapc (lambda (ov)
- (move-overlay
- (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
- (car overlays))
+ (dolist (o (car overlays))
+ (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset)))
(goto-char beg-A)
(delete-region beg-A end-A)
(insert body-B)
;; Restore ex ELEM-B overlays.
- (mapc (lambda (ov)
- (move-overlay
- (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
- (cdr overlays)))
+ (dolist (o (cdr overlays))
+ (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
(goto-char (org-element-property :end elem-B)))))
+
(provide 'org-element)
;; Local variables:
diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el
index 3ca2cceea7e..a138764fad1 100644
--- a/lisp/org/org-entities.el
+++ b/lisp/org/org-entities.el
@@ -1,4 +1,4 @@
-;;; org-entities.el --- Support for special entities in Org-mode
+;;; org-entities.el --- Support for Special Entities -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
@@ -30,38 +30,36 @@
(declare-function org-toggle-pretty-entities "org" ())
(declare-function org-table-align "org-table" ())
-(eval-when-compile
- (require 'cl))
-
(defgroup org-entities nil
- "Options concerning entities in Org-mode."
+ "Options concerning entities in Org mode."
:tag "Org Entities"
:group 'org)
-(defcustom org-entities-ascii-explanatory nil
- "Non-nil means replace special entities in ASCII.
-For example, this will replace \"\\nsup\" with \"[not a superset of]\"
-in backends where the corresponding character is not available."
- :group 'org-entities
- :version "24.1"
- :type 'boolean)
+(defun org-entities--user-safe-p (v)
+ "Non-nil if V is a safe value for `org-entities-user'."
+ (pcase v
+ (`nil t)
+ (`(,(and (pred stringp)
+ (pred (string-match-p "\\`[a-zA-Z][a-zA-Z0-9]*\\'")))
+ ,(pred stringp) ,(pred booleanp) ,(pred stringp)
+ ,(pred stringp) ,(pred stringp) ,(pred stringp))
+ t)
+ (_ nil)))
(defcustom org-entities-user nil
- "User-defined entities used in Org-mode to produce special characters.
+ "User-defined entities used in Org to produce special characters.
Each entry in this list is a list of strings. It associates the name
of the entity that can be inserted into an Org file as \\name with the
appropriate replacements for the different export backends. The order
of the fields is the following
-name As a string, without the leading backslash
-LaTeX replacement In ready LaTeX, no further processing will take place
-LaTeX mathp A Boolean, either t or nil. t if this entity needs
- to be in math mode.
+name As a string, without the leading backslash.
+LaTeX replacement In ready LaTeX, no further processing will take place.
+LaTeX mathp Either t or nil. When t this entity needs to be in
+ math mode.
HTML replacement In ready HTML, no further processing will take place.
Usually this will be an &...; entity.
-ASCII replacement Plain ASCII, no extensions. Symbols that cannot be
- represented will be left as they are, but see the.
- variable `org-entities-ascii-explanatory'.
+ASCII replacement Plain ASCII, no extensions.
Latin1 replacement Use the special characters available in latin1.
utf-8 replacement Use the special characters available in utf-8.
@@ -77,439 +75,456 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
(string :tag "HTML ")
(string :tag "ASCII ")
(string :tag "Latin1")
- (string :tag "utf-8 "))))
+ (string :tag "utf-8 ")))
+ :safe #'org-entities--user-safe-p)
(defconst org-entities
- '(
- "* Letters"
- "** Latin"
- ("Agrave" "\\`{A}" nil "&Agrave;" "A" "À" "À")
- ("agrave" "\\`{a}" nil "&agrave;" "a" "à" "à")
- ("Aacute" "\\'{A}" nil "&Aacute;" "A" "Á" "Á")
- ("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
- ("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
- ("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
- ("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
- ("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
- ("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
- ("auml" "\\\"{a}" nil "&auml;" "ae" "ä" "ä")
- ("Aring" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
- ("AA" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
- ("aring" "\\aa{}" nil "&aring;" "a" "å" "å")
- ("AElig" "\\AE{}" nil "&AElig;" "AE" "Æ" "Æ")
- ("aelig" "\\ae{}" nil "&aelig;" "ae" "æ" "æ")
- ("Ccedil" "\\c{C}" nil "&Ccedil;" "C" "Ç" "Ç")
- ("ccedil" "\\c{c}" nil "&ccedil;" "c" "ç" "ç")
- ("Egrave" "\\`{E}" nil "&Egrave;" "E" "È" "È")
- ("egrave" "\\`{e}" nil "&egrave;" "e" "è" "è")
- ("Eacute" "\\'{E}" nil "&Eacute;" "E" "É" "É")
- ("eacute" "\\'{e}" nil "&eacute;" "e" "é" "é")
- ("Ecirc" "\\^{E}" nil "&Ecirc;" "E" "Ê" "Ê")
- ("ecirc" "\\^{e}" nil "&ecirc;" "e" "ê" "ê")
- ("Euml" "\\\"{E}" nil "&Euml;" "E" "Ë" "Ë")
- ("euml" "\\\"{e}" nil "&euml;" "e" "ë" "ë")
- ("Igrave" "\\`{I}" nil "&Igrave;" "I" "Ì" "Ì")
- ("igrave" "\\`{i}" nil "&igrave;" "i" "ì" "ì")
- ("Iacute" "\\'{I}" nil "&Iacute;" "I" "Í" "Í")
- ("iacute" "\\'{i}" nil "&iacute;" "i" "í" "í")
- ("Icirc" "\\^{I}" nil "&Icirc;" "I" "Î" "Î")
- ("icirc" "\\^{i}" nil "&icirc;" "i" "î" "î")
- ("Iuml" "\\\"{I}" nil "&Iuml;" "I" "Ï" "Ï")
- ("iuml" "\\\"{i}" nil "&iuml;" "i" "ï" "ï")
- ("Ntilde" "\\~{N}" nil "&Ntilde;" "N" "Ñ" "Ñ")
- ("ntilde" "\\~{n}" nil "&ntilde;" "n" "ñ" "ñ")
- ("Ograve" "\\`{O}" nil "&Ograve;" "O" "Ò" "Ò")
- ("ograve" "\\`{o}" nil "&ograve;" "o" "ò" "ò")
- ("Oacute" "\\'{O}" nil "&Oacute;" "O" "Ó" "Ó")
- ("oacute" "\\'{o}" nil "&oacute;" "o" "ó" "ó")
- ("Ocirc" "\\^{O}" nil "&Ocirc;" "O" "Ô" "Ô")
- ("ocirc" "\\^{o}" nil "&ocirc;" "o" "ô" "ô")
- ("Otilde" "\\~{O}" nil "&Otilde;" "O" "Õ" "Õ")
- ("otilde" "\\~{o}" nil "&otilde;" "o" "õ" "õ")
- ("Ouml" "\\\"{O}" nil "&Ouml;" "Oe" "Ö" "Ö")
- ("ouml" "\\\"{o}" nil "&ouml;" "oe" "ö" "ö")
- ("Oslash" "\\O" nil "&Oslash;" "O" "Ø" "Ø")
- ("oslash" "\\o{}" nil "&oslash;" "o" "ø" "ø")
- ("OElig" "\\OE{}" nil "&OElig;" "OE" "OE" "Œ")
- ("oelig" "\\oe{}" nil "&oelig;" "oe" "oe" "œ")
- ("Scaron" "\\v{S}" nil "&Scaron;" "S" "S" "Š")
- ("scaron" "\\v{s}" nil "&scaron;" "s" "s" "š")
- ("szlig" "\\ss{}" nil "&szlig;" "ss" "ß" "ß")
- ("Ugrave" "\\`{U}" nil "&Ugrave;" "U" "Ù" "Ù")
- ("ugrave" "\\`{u}" nil "&ugrave;" "u" "ù" "ù")
- ("Uacute" "\\'{U}" nil "&Uacute;" "U" "Ú" "Ú")
- ("uacute" "\\'{u}" nil "&uacute;" "u" "ú" "ú")
- ("Ucirc" "\\^{U}" nil "&Ucirc;" "U" "Û" "Û")
- ("ucirc" "\\^{u}" nil "&ucirc;" "u" "û" "û")
- ("Uuml" "\\\"{U}" nil "&Uuml;" "Ue" "Ü" "Ü")
- ("uuml" "\\\"{u}" nil "&uuml;" "ue" "ü" "ü")
- ("Yacute" "\\'{Y}" nil "&Yacute;" "Y" "Ý" "Ý")
- ("yacute" "\\'{y}" nil "&yacute;" "y" "ý" "ý")
- ("Yuml" "\\\"{Y}" nil "&Yuml;" "Y" "Y" "Ÿ")
- ("yuml" "\\\"{y}" nil "&yuml;" "y" "ÿ" "ÿ")
-
- "** Latin (special face)"
- ("fnof" "\\textit{f}" nil "&fnof;" "f" "f" "ƒ")
- ("real" "\\Re" t "&real;" "R" "R" "ℜ")
- ("image" "\\Im" t "&image;" "I" "I" "ℑ")
- ("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
- ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
- ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
- ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
-
- "** Greek"
- ("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
- ("alpha" "\\alpha" t "&alpha;" "alpha" "alpha" "α")
- ("Beta" "B" nil "&Beta;" "Beta" "Beta" "Β")
- ("beta" "\\beta" t "&beta;" "beta" "beta" "β")
- ("Gamma" "\\Gamma" t "&Gamma;" "Gamma" "Gamma" "Γ")
- ("gamma" "\\gamma" t "&gamma;" "gamma" "gamma" "γ")
- ("Delta" "\\Delta" t "&Delta;" "Delta" "Gamma" "Δ")
- ("delta" "\\delta" t "&delta;" "delta" "delta" "δ")
- ("Epsilon" "E" nil "&Epsilon;" "Epsilon" "Epsilon" "Ε")
- ("epsilon" "\\epsilon" t "&epsilon;" "epsilon" "epsilon" "ε")
- ("varepsilon" "\\varepsilon" t "&epsilon;" "varepsilon" "varepsilon" "ε")
- ("Zeta" "Z" nil "&Zeta;" "Zeta" "Zeta" "Ζ")
- ("zeta" "\\zeta" t "&zeta;" "zeta" "zeta" "ζ")
- ("Eta" "H" nil "&Eta;" "Eta" "Eta" "Η")
- ("eta" "\\eta" t "&eta;" "eta" "eta" "η")
- ("Theta" "\\Theta" t "&Theta;" "Theta" "Theta" "Θ")
- ("theta" "\\theta" t "&theta;" "theta" "theta" "θ")
- ("thetasym" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
- ("vartheta" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
- ("Iota" "I" nil "&Iota;" "Iota" "Iota" "Ι")
- ("iota" "\\iota" t "&iota;" "iota" "iota" "ι")
- ("Kappa" "K" nil "&Kappa;" "Kappa" "Kappa" "Κ")
- ("kappa" "\\kappa" t "&kappa;" "kappa" "kappa" "κ")
- ("Lambda" "\\Lambda" t "&Lambda;" "Lambda" "Lambda" "Λ")
- ("lambda" "\\lambda" t "&lambda;" "lambda" "lambda" "λ")
- ("Mu" "M" nil "&Mu;" "Mu" "Mu" "Μ")
- ("mu" "\\mu" t "&mu;" "mu" "mu" "μ")
- ("nu" "\\nu" t "&nu;" "nu" "nu" "ν")
- ("Nu" "N" nil "&Nu;" "Nu" "Nu" "Ν")
- ("Xi" "\\Xi" t "&Xi;" "Xi" "Xi" "Ξ")
- ("xi" "\\xi" t "&xi;" "xi" "xi" "ξ")
- ("Omicron" "O" nil "&Omicron;" "Omicron" "Omicron" "Ο")
- ("omicron" "\\textit{o}" nil "&omicron;" "omicron" "omicron" "ο")
- ("Pi" "\\Pi" t "&Pi;" "Pi" "Pi" "Π")
- ("pi" "\\pi" t "&pi;" "pi" "pi" "π")
- ("Rho" "P" nil "&Rho;" "Rho" "Rho" "Ρ")
- ("rho" "\\rho" t "&rho;" "rho" "rho" "ρ")
- ("Sigma" "\\Sigma" t "&Sigma;" "Sigma" "Sigma" "Σ")
- ("sigma" "\\sigma" t "&sigma;" "sigma" "sigma" "σ")
- ("sigmaf" "\\varsigma" t "&sigmaf;" "sigmaf" "sigmaf" "ς")
- ("varsigma" "\\varsigma" t "&sigmaf;" "varsigma" "varsigma" "ς")
- ("Tau" "T" nil "&Tau;" "Tau" "Tau" "Τ")
- ("Upsilon" "\\Upsilon" t "&Upsilon;" "Upsilon" "Upsilon" "Υ")
- ("upsih" "\\Upsilon" t "&upsih;" "upsilon" "upsilon" "ϒ")
- ("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
- ("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
- ("phi" "\\phi" t "&phi;" "phi" "phi" "φ")
- ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "ɸ")
- ("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
- ("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
- ("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
- ("Psi" "\\Psi" t "&Psi;" "Psi" "Psi" "Ψ")
- ("psi" "\\psi" t "&psi;" "psi" "psi" "ψ")
- ("tau" "\\tau" t "&tau;" "tau" "tau" "τ")
- ("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
- ("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
- ("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
- ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
- ("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
-
- "** Hebrew"
- ("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
- ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
- ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
- ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
- ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
-
- "** Dead languages"
- ("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
- ("eth" "\\dh{}" nil "&eth;" "dh" "ð" "ð")
- ("THORN" "\\TH{}" nil "&THORN;" "TH" "Þ" "Þ")
- ("thorn" "\\th{}" nil "&thorn;" "th" "þ" "þ")
-
- "* Punctuation"
- "** Dots and Marks"
- ("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
- ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
- ("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
- ("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
- ("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
- ("iquest" "?`" nil "&iquest;" "?" "¿" "¿")
-
- "** Dash-like"
- ("shy" "\\-" nil "&shy;" "" "" "")
- ("ndash" "--" nil "&ndash;" "-" "-" "–")
- ("mdash" "---" nil "&mdash;" "--" "--" "—")
-
- "** Quotations"
- ("quot" "\\textquotedbl{}" nil "&quot;" "\"" "\"" "\"")
- ("acute" "\\textasciiacute{}" nil "&acute;" "'" "´" "´")
- ("ldquo" "\\textquotedblleft{}" nil "&ldquo;" "\"" "\"" "“")
- ("rdquo" "\\textquotedblright{}" nil "&rdquo;" "\"" "\"" "”")
- ("bdquo" "\\quotedblbase{}" nil "&bdquo;" "\"" "\"" "„")
- ("lsquo" "\\textquoteleft{}" nil "&lsquo;" "`" "`" "‘")
- ("rsquo" "\\textquoteright{}" nil "&rsquo;" "'" "'" "’")
- ("sbquo" "\\quotesinglbase{}" nil "&sbquo;" "," "," "‚")
- ("laquo" "\\guillemotleft{}" nil "&laquo;" "<<" "«" "«")
- ("raquo" "\\guillemotright{}" nil "&raquo;" ">>" "»" "»")
- ("lsaquo" "\\guilsinglleft{}" nil "&lsaquo;" "<" "<" "‹")
- ("rsaquo" "\\guilsinglright{}" nil "&rsaquo;" ">" ">" "›")
-
- "* Other"
- "** Misc. (often used)"
- ("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
- ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
- ("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
- ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
- ("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
- ("amp" "\\&" nil "&amp;" "&" "&" "&")
- ("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
- ("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
- ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
- ("slash" "/" nil "/" "/" "/" "/")
- ("plus" "+" nil "+" "+" "+" "+")
- ("under" "\\_" nil "_" "_" "_" "_")
- ("equal" "=" nil "=" "=" "=" "=")
- ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
- ("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
- ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
- ("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
- ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
-
- "** Whitespace"
- ("nbsp" "~" nil "&nbsp;" " " " " " ")
- ("ensp" "\\hspace*{.5em}" nil "&ensp;" " " " " " ")
- ("emsp" "\\hspace*{1em}" nil "&emsp;" " " " " " ")
- ("thinsp" "\\hspace*{.2em}" nil "&thinsp;" " " " " " ")
-
- "** Currency"
- ("curren" "\\textcurrency{}" nil "&curren;" "curr." "¤" "¤")
- ("cent" "\\textcent{}" nil "&cent;" "cent" "¢" "¢")
- ("pound" "\\pounds{}" nil "&pound;" "pound" "£" "£")
- ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
- ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
- ("EUR" "\\EUR{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURdig" "\\EURdig{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURhv" "\\EURhv{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURcr" "\\EURcr{}" nil "&euro;" "EUR" "EUR" "€")
- ("EURtm" "\\EURtm{}" nil "&euro;" "EUR" "EUR" "€")
-
- "** Property Marks"
- ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")
- ("reg" "\\textregistered{}" nil "&reg;" "(r)" "®" "®")
- ("trade" "\\texttrademark{}" nil "&trade;" "TM" "TM" "™")
-
- "** Science et al."
- ("minus" "\\minus" t "&minus;" "-" "-" "−")
- ("pm" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
- ("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
- ("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
- ("frasl" "/" nil "&frasl;" "/" "/" "⁄")
- ("colon" "\\colon" t ":" ":" ":" ":")
- ("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
- ("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
- ("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
- ("frac34" "\\textthreequarters{}" nil "&frac34;" "3/4" "¾" "¾")
- ("permil" "\\textperthousand{}" nil "&permil;" "per thousand" "per thousand" "‰")
- ("sup1" "\\textonesuperior{}" nil "&sup1;" "^1" "¹" "¹")
- ("sup2" "\\texttwosuperior{}" nil "&sup2;" "^2" "²" "²")
- ("sup3" "\\textthreesuperior{}" nil "&sup3;" "^3" "³" "³")
- ("radic" "\\sqrt{\\,}" t "&radic;" "[square root]" "[square root]" "√")
- ("sum" "\\sum" t "&sum;" "[sum]" "[sum]" "∑")
- ("prod" "\\prod" t "&prod;" "[product]" "[n-ary product]" "∏")
- ("micro" "\\textmu{}" nil "&micro;" "micro" "µ" "µ")
- ("macr" "\\textasciimacron{}" nil "&macr;" "[macron]" "¯" "¯")
- ("deg" "\\textdegree{}" nil "&deg;" "degree" "°" "°")
- ("prime" "\\prime" t "&prime;" "'" "'" "′")
- ("Prime" "\\prime{}\\prime" t "&Prime;" "''" "''" "″")
- ("infin" "\\propto" t "&infin;" "[infinity]" "[infinity]" "∞")
- ("infty" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
- ("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
- ("propto" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
- ("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
- ("neg" "\\neg{}" t "&not;" "[angled dash]" "¬" "¬")
- ("land" "\\land" t "&and;" "[logical and]" "[logical and]" "∧")
- ("wedge" "\\wedge" t "&and;" "[logical and]" "[logical and]" "∧")
- ("lor" "\\lor" t "&or;" "[logical or]" "[logical or]" "∨")
- ("vee" "\\vee" t "&or;" "[logical or]" "[logical or]" "∨")
- ("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
- ("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
- ("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
- ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
- ("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
- ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
- ("sim" "\\sim" t "&sim;" "~" "~" "∼")
- ("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
- ("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
- ("asymp" "\\asymp" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
- ("approx" "\\approx" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
- ("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
- ("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
- ("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
-
- ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
- ("le" "\\le" t "&le;" "<=" "<=" "≤")
- ("leq" "\\le" t "&le;" "<=" "<=" "≤")
- ("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
- ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
- ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
- ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
- ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
- ("Ll" "\\lll" t "&Ll;" "<<<" "<<<" "⋘")
- ("lll" "\\lll" t "&Ll;" "<<<" "<<<" "⋘")
- ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
- ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
- ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
- ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
- ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
- ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
- ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
- ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
- ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
- ("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
- ("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
- ("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
- ("supset" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
- ("nsub" "\\not\\subset" t "&nsub;" "[not a subset of]" "[not a subset of" "⊄")
- ("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
- ("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
- ("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
- ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
- ("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
- ("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
- ("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]" "∅")
- ("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
- ("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
- ("in" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
- ("notin" "\\notin" t "&notin;" "[not an element of]" "[not an element of]" "∉")
- ("ni" "\\ni" t "&ni;" "[contains as member]" "[contains as member]" "∋")
- ("nabla" "\\nabla" t "&nabla;" "[nabla]" "[nabla]" "∇")
- ("ang" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
- ("angle" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
- ("perp" "\\perp" t "&perp;" "[up tack]" "[up tack]" "⊥")
- ("sdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
- ("cdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
- ("lceil" "\\lceil" t "&lceil;" "[left ceiling]" "[left ceiling]" "⌈")
- ("rceil" "\\rceil" t "&rceil;" "[right ceiling]" "[right ceiling]" "⌉")
- ("lfloor" "\\lfloor" t "&lfloor;" "[left floor]" "[left floor]" "⌊")
- ("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
- ("lang" "\\langle" t "&lang;" "<" "<" "⟨")
- ("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
- ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
- ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
-
- "** Arrows"
- ("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
- ("leftarrow" "\\leftarrow" t "&larr;" "<-" "<-" "←")
- ("gets" "\\gets" t "&larr;" "<-" "<-" "←")
- ("lArr" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
- ("Leftarrow" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
- ("uarr" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
- ("uparrow" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
- ("uArr" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
- ("Uparrow" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
- ("rarr" "\\rightarrow" t "&rarr;" "->" "->" "→")
- ("to" "\\to" t "&rarr;" "->" "->" "→")
- ("rightarrow" "\\rightarrow" t "&rarr;" "->" "->" "→")
- ("rArr" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
- ("Rightarrow" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
- ("darr" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
- ("downarrow" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
- ("dArr" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
- ("Downarrow" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
- ("harr" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
- ("leftrightarrow" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
- ("hArr" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
- ("Leftrightarrow" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
- ("crarr" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
- ("hookleftarrow" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
-
- "** Function names"
- ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos")
- ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin")
- ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan")
- ("arg" "\\arg" t "arg" "arg" "arg" "arg")
- ("cos" "\\cos" t "cos" "cos" "cos" "cos")
- ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh")
- ("cot" "\\cot" t "cot" "cot" "cot" "cot")
- ("coth" "\\coth" t "coth" "coth" "coth" "coth")
- ("csc" "\\csc" t "csc" "csc" "csc" "csc")
- ("deg" "\\deg" t "&deg;" "deg" "deg" "deg")
- ("det" "\\det" t "det" "det" "det" "det")
- ("dim" "\\dim" t "dim" "dim" "dim" "dim")
- ("exp" "\\exp" t "exp" "exp" "exp" "exp")
- ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd")
- ("hom" "\\hom" t "hom" "hom" "hom" "hom")
- ("inf" "\\inf" t "inf" "inf" "inf" "inf")
- ("ker" "\\ker" t "ker" "ker" "ker" "ker")
- ("lg" "\\lg" t "lg" "lg" "lg" "lg")
- ("lim" "\\lim" t "lim" "lim" "lim" "lim")
- ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf")
- ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup")
- ("ln" "\\ln" t "ln" "ln" "ln" "ln")
- ("log" "\\log" t "log" "log" "log" "log")
- ("max" "\\max" t "max" "max" "max" "max")
- ("min" "\\min" t "min" "min" "min" "min")
- ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr")
- ("sec" "\\sec" t "sec" "sec" "sec" "sec")
- ("sin" "\\sin" t "sin" "sin" "sin" "sin")
- ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh")
- ("sup" "\\sup" t "&sup;" "sup" "sup" "sup")
- ("tan" "\\tan" t "tan" "tan" "tan" "tan")
- ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh")
-
- "** Signs & Symbols"
- ("bull" "\\textbullet{}" nil "&bull;" "*" "*" "•")
- ("bullet" "\\textbullet{}" nil "&bull;" "*" "*" "•")
- ("star" "\\star" t "*" "*" "*" "⋆")
- ("lowast" "\\ast" t "&lowast;" "*" "*" "∗")
- ("ast" "\\ast" t "&lowast;" "*" "*" "*")
- ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
- ("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
- ("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
- ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
- ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
-
- "** Miscellaneous (seldom used)"
- ("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
- ("ordf" "\\textordfeminine{}" nil "&ordf;" "_a_" "ª" "ª")
- ("ordm" "\\textordmasculine{}" nil "&ordm;" "_o_" "º" "º")
- ("cedil" "\\c{}" nil "&cedil;" "[cedilla]" "¸" "¸")
- ("oline" "\\overline{~}" t "&oline;" "[overline]" "¯" "‾")
- ("uml" "\\textasciidieresis{}" nil "&uml;" "[diaeresis]" "¨" "¨")
- ("zwnj" "\\/{}" nil "&zwnj;" "" "" "‌")
- ("zwj" "" nil "&zwj;" "" "" "‍")
- ("lrm" "" nil "&lrm;" "" "" "‎")
- ("rlm" "" nil "&rlm;" "" "" "‏")
-
- "** Smilies"
- ("smile" "\\smile" t "&smile;" ":-)" ":-)" "⌣")
- ("frown" "\\frown" t "&frown;" ":-(" ":-(" "⌢")
- ("smiley" "\\smiley{}" nil "&#9786;" ":-)" ":-)" "☺")
- ("blacksmile" "\\blacksmiley{}" nil "&#9787;" ":-)" ":-)" "☻")
- ("sad" "\\frownie{}" nil "&#9785;" ":-(" ":-(" "☹")
-
- "** Suits"
- ("clubs" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
- ("clubsuit" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
- ("spades" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
- ("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
- ("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
- ("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
- ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
- ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
- ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
- ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
- ("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫")
- )
- "Default entities used in Org-mode to produce special characters.
+ (append
+ '("* Letters"
+ "** Latin"
+ ("Agrave" "\\`{A}" nil "&Agrave;" "A" "À" "À")
+ ("agrave" "\\`{a}" nil "&agrave;" "a" "à" "à")
+ ("Aacute" "\\'{A}" nil "&Aacute;" "A" "Á" "Á")
+ ("aacute" "\\'{a}" nil "&aacute;" "a" "á" "á")
+ ("Acirc" "\\^{A}" nil "&Acirc;" "A" "Â" "Â")
+ ("acirc" "\\^{a}" nil "&acirc;" "a" "â" "â")
+ ("Amacr" "\\bar{A}" nil "&Amacr;" "A" "Ã" "Ã")
+ ("amacr" "\\bar{a}" nil "&amacr;" "a" "ã" "ã")
+ ("Atilde" "\\~{A}" nil "&Atilde;" "A" "Ã" "Ã")
+ ("atilde" "\\~{a}" nil "&atilde;" "a" "ã" "ã")
+ ("Auml" "\\\"{A}" nil "&Auml;" "Ae" "Ä" "Ä")
+ ("auml" "\\\"{a}" nil "&auml;" "ae" "ä" "ä")
+ ("Aring" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
+ ("AA" "\\AA{}" nil "&Aring;" "A" "Å" "Å")
+ ("aring" "\\aa{}" nil "&aring;" "a" "å" "å")
+ ("AElig" "\\AE{}" nil "&AElig;" "AE" "Æ" "Æ")
+ ("aelig" "\\ae{}" nil "&aelig;" "ae" "æ" "æ")
+ ("Ccedil" "\\c{C}" nil "&Ccedil;" "C" "Ç" "Ç")
+ ("ccedil" "\\c{c}" nil "&ccedil;" "c" "ç" "ç")
+ ("Egrave" "\\`{E}" nil "&Egrave;" "E" "È" "È")
+ ("egrave" "\\`{e}" nil "&egrave;" "e" "è" "è")
+ ("Eacute" "\\'{E}" nil "&Eacute;" "E" "É" "É")
+ ("eacute" "\\'{e}" nil "&eacute;" "e" "é" "é")
+ ("Ecirc" "\\^{E}" nil "&Ecirc;" "E" "Ê" "Ê")
+ ("ecirc" "\\^{e}" nil "&ecirc;" "e" "ê" "ê")
+ ("Euml" "\\\"{E}" nil "&Euml;" "E" "Ë" "Ë")
+ ("euml" "\\\"{e}" nil "&euml;" "e" "ë" "ë")
+ ("Igrave" "\\`{I}" nil "&Igrave;" "I" "Ì" "Ì")
+ ("igrave" "\\`{i}" nil "&igrave;" "i" "ì" "ì")
+ ("Iacute" "\\'{I}" nil "&Iacute;" "I" "Í" "Í")
+ ("iacute" "\\'{i}" nil "&iacute;" "i" "í" "í")
+ ("Icirc" "\\^{I}" nil "&Icirc;" "I" "Î" "Î")
+ ("icirc" "\\^{i}" nil "&icirc;" "i" "î" "î")
+ ("Iuml" "\\\"{I}" nil "&Iuml;" "I" "Ï" "Ï")
+ ("iuml" "\\\"{i}" nil "&iuml;" "i" "ï" "ï")
+ ("Ntilde" "\\~{N}" nil "&Ntilde;" "N" "Ñ" "Ñ")
+ ("ntilde" "\\~{n}" nil "&ntilde;" "n" "ñ" "ñ")
+ ("Ograve" "\\`{O}" nil "&Ograve;" "O" "Ò" "Ò")
+ ("ograve" "\\`{o}" nil "&ograve;" "o" "ò" "ò")
+ ("Oacute" "\\'{O}" nil "&Oacute;" "O" "Ó" "Ó")
+ ("oacute" "\\'{o}" nil "&oacute;" "o" "ó" "ó")
+ ("Ocirc" "\\^{O}" nil "&Ocirc;" "O" "Ô" "Ô")
+ ("ocirc" "\\^{o}" nil "&ocirc;" "o" "ô" "ô")
+ ("Otilde" "\\~{O}" nil "&Otilde;" "O" "Õ" "Õ")
+ ("otilde" "\\~{o}" nil "&otilde;" "o" "õ" "õ")
+ ("Ouml" "\\\"{O}" nil "&Ouml;" "Oe" "Ö" "Ö")
+ ("ouml" "\\\"{o}" nil "&ouml;" "oe" "ö" "ö")
+ ("Oslash" "\\O" nil "&Oslash;" "O" "Ø" "Ø")
+ ("oslash" "\\o{}" nil "&oslash;" "o" "ø" "ø")
+ ("OElig" "\\OE{}" nil "&OElig;" "OE" "OE" "Œ")
+ ("oelig" "\\oe{}" nil "&oelig;" "oe" "oe" "œ")
+ ("Scaron" "\\v{S}" nil "&Scaron;" "S" "S" "Š")
+ ("scaron" "\\v{s}" nil "&scaron;" "s" "s" "š")
+ ("szlig" "\\ss{}" nil "&szlig;" "ss" "ß" "ß")
+ ("Ugrave" "\\`{U}" nil "&Ugrave;" "U" "Ù" "Ù")
+ ("ugrave" "\\`{u}" nil "&ugrave;" "u" "ù" "ù")
+ ("Uacute" "\\'{U}" nil "&Uacute;" "U" "Ú" "Ú")
+ ("uacute" "\\'{u}" nil "&uacute;" "u" "ú" "ú")
+ ("Ucirc" "\\^{U}" nil "&Ucirc;" "U" "Û" "Û")
+ ("ucirc" "\\^{u}" nil "&ucirc;" "u" "û" "û")
+ ("Uuml" "\\\"{U}" nil "&Uuml;" "Ue" "Ü" "Ü")
+ ("uuml" "\\\"{u}" nil "&uuml;" "ue" "ü" "ü")
+ ("Yacute" "\\'{Y}" nil "&Yacute;" "Y" "Ý" "Ý")
+ ("yacute" "\\'{y}" nil "&yacute;" "y" "ý" "ý")
+ ("Yuml" "\\\"{Y}" nil "&Yuml;" "Y" "Y" "Ÿ")
+ ("yuml" "\\\"{y}" nil "&yuml;" "y" "ÿ" "ÿ")
+
+ "** Latin (special face)"
+ ("fnof" "\\textit{f}" nil "&fnof;" "f" "f" "ƒ")
+ ("real" "\\Re" t "&real;" "R" "R" "ℜ")
+ ("image" "\\Im" t "&image;" "I" "I" "ℑ")
+ ("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
+ ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
+ ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
+ ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
+
+ "** Greek"
+ ("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
+ ("alpha" "\\alpha" t "&alpha;" "alpha" "alpha" "α")
+ ("Beta" "B" nil "&Beta;" "Beta" "Beta" "Β")
+ ("beta" "\\beta" t "&beta;" "beta" "beta" "β")
+ ("Gamma" "\\Gamma" t "&Gamma;" "Gamma" "Gamma" "Γ")
+ ("gamma" "\\gamma" t "&gamma;" "gamma" "gamma" "γ")
+ ("Delta" "\\Delta" t "&Delta;" "Delta" "Delta" "Δ")
+ ("delta" "\\delta" t "&delta;" "delta" "delta" "δ")
+ ("Epsilon" "E" nil "&Epsilon;" "Epsilon" "Epsilon" "Ε")
+ ("epsilon" "\\epsilon" t "&epsilon;" "epsilon" "epsilon" "ε")
+ ("varepsilon" "\\varepsilon" t "&epsilon;" "varepsilon" "varepsilon" "ε")
+ ("Zeta" "Z" nil "&Zeta;" "Zeta" "Zeta" "Ζ")
+ ("zeta" "\\zeta" t "&zeta;" "zeta" "zeta" "ζ")
+ ("Eta" "H" nil "&Eta;" "Eta" "Eta" "Η")
+ ("eta" "\\eta" t "&eta;" "eta" "eta" "η")
+ ("Theta" "\\Theta" t "&Theta;" "Theta" "Theta" "Θ")
+ ("theta" "\\theta" t "&theta;" "theta" "theta" "θ")
+ ("thetasym" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
+ ("vartheta" "\\vartheta" t "&thetasym;" "theta" "theta" "ϑ")
+ ("Iota" "I" nil "&Iota;" "Iota" "Iota" "Ι")
+ ("iota" "\\iota" t "&iota;" "iota" "iota" "ι")
+ ("Kappa" "K" nil "&Kappa;" "Kappa" "Kappa" "Κ")
+ ("kappa" "\\kappa" t "&kappa;" "kappa" "kappa" "κ")
+ ("Lambda" "\\Lambda" t "&Lambda;" "Lambda" "Lambda" "Λ")
+ ("lambda" "\\lambda" t "&lambda;" "lambda" "lambda" "λ")
+ ("Mu" "M" nil "&Mu;" "Mu" "Mu" "Μ")
+ ("mu" "\\mu" t "&mu;" "mu" "mu" "μ")
+ ("nu" "\\nu" t "&nu;" "nu" "nu" "ν")
+ ("Nu" "N" nil "&Nu;" "Nu" "Nu" "Ν")
+ ("Xi" "\\Xi" t "&Xi;" "Xi" "Xi" "Ξ")
+ ("xi" "\\xi" t "&xi;" "xi" "xi" "ξ")
+ ("Omicron" "O" nil "&Omicron;" "Omicron" "Omicron" "Ο")
+ ("omicron" "\\textit{o}" nil "&omicron;" "omicron" "omicron" "ο")
+ ("Pi" "\\Pi" t "&Pi;" "Pi" "Pi" "Π")
+ ("pi" "\\pi" t "&pi;" "pi" "pi" "π")
+ ("Rho" "P" nil "&Rho;" "Rho" "Rho" "Ρ")
+ ("rho" "\\rho" t "&rho;" "rho" "rho" "ρ")
+ ("Sigma" "\\Sigma" t "&Sigma;" "Sigma" "Sigma" "Σ")
+ ("sigma" "\\sigma" t "&sigma;" "sigma" "sigma" "σ")
+ ("sigmaf" "\\varsigma" t "&sigmaf;" "sigmaf" "sigmaf" "ς")
+ ("varsigma" "\\varsigma" t "&sigmaf;" "varsigma" "varsigma" "ς")
+ ("Tau" "T" nil "&Tau;" "Tau" "Tau" "Τ")
+ ("Upsilon" "\\Upsilon" t "&Upsilon;" "Upsilon" "Upsilon" "Υ")
+ ("upsih" "\\Upsilon" t "&upsih;" "upsilon" "upsilon" "ϒ")
+ ("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
+ ("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
+ ("phi" "\\phi" t "&phi;" "phi" "phi" "ɸ")
+ ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "φ")
+ ("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
+ ("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
+ ("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
+ ("Psi" "\\Psi" t "&Psi;" "Psi" "Psi" "Ψ")
+ ("psi" "\\psi" t "&psi;" "psi" "psi" "ψ")
+ ("tau" "\\tau" t "&tau;" "tau" "tau" "τ")
+ ("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
+ ("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
+ ("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
+
+ "** Hebrew"
+ ("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
+ ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
+ ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
+ ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
+ ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
+
+ "** Dead languages"
+ ("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
+ ("eth" "\\dh{}" nil "&eth;" "dh" "ð" "ð")
+ ("THORN" "\\TH{}" nil "&THORN;" "TH" "Þ" "Þ")
+ ("thorn" "\\th{}" nil "&thorn;" "th" "þ" "þ")
+
+ "* Punctuation"
+ "** Dots and Marks"
+ ("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
+ ("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
+ ("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
+ ("iquest" "?`" nil "&iquest;" "?" "¿" "¿")
+
+ "** Dash-like"
+ ("shy" "\\-" nil "&shy;" "" "" "")
+ ("ndash" "--" nil "&ndash;" "-" "-" "–")
+ ("mdash" "---" nil "&mdash;" "--" "--" "—")
+
+ "** Quotations"
+ ("quot" "\\textquotedbl{}" nil "&quot;" "\"" "\"" "\"")
+ ("acute" "\\textasciiacute{}" nil "&acute;" "'" "´" "´")
+ ("ldquo" "\\textquotedblleft{}" nil "&ldquo;" "\"" "\"" "“")
+ ("rdquo" "\\textquotedblright{}" nil "&rdquo;" "\"" "\"" "”")
+ ("bdquo" "\\quotedblbase{}" nil "&bdquo;" "\"" "\"" "„")
+ ("lsquo" "\\textquoteleft{}" nil "&lsquo;" "`" "`" "‘")
+ ("rsquo" "\\textquoteright{}" nil "&rsquo;" "'" "'" "’")
+ ("sbquo" "\\quotesinglbase{}" nil "&sbquo;" "," "," "‚")
+ ("laquo" "\\guillemotleft{}" nil "&laquo;" "<<" "«" "«")
+ ("raquo" "\\guillemotright{}" nil "&raquo;" ">>" "»" "»")
+ ("lsaquo" "\\guilsinglleft{}" nil "&lsaquo;" "<" "<" "‹")
+ ("rsaquo" "\\guilsinglright{}" nil "&rsaquo;" ">" ">" "›")
+
+ "* Other"
+ "** Misc. (often used)"
+ ("circ" "\\^{}" nil "&circ;" "^" "^" "∘")
+ ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
+ ("vbar" "|" nil "|" "|" "|" "|")
+ ("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
+ ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
+ ("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
+ ("amp" "\\&" nil "&amp;" "&" "&" "&")
+ ("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
+ ("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
+ ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
+ ("slash" "/" nil "/" "/" "/" "/")
+ ("plus" "+" nil "+" "+" "+" "+")
+ ("under" "\\_" nil "_" "_" "_" "_")
+ ("equal" "=" nil "=" "=" "=" "=")
+ ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
+ ("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+ ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+
+ "** Whitespace"
+ ("nbsp" "~" nil "&nbsp;" " " "\x00A0" "\x00A0")
+ ("ensp" "\\hspace*{.5em}" nil "&ensp;" " " " " " ")
+ ("emsp" "\\hspace*{1em}" nil "&emsp;" " " " " " ")
+ ("thinsp" "\\hspace*{.2em}" nil "&thinsp;" " " " " " ")
+
+ "** Currency"
+ ("curren" "\\textcurrency{}" nil "&curren;" "curr." "¤" "¤")
+ ("cent" "\\textcent{}" nil "&cent;" "cent" "¢" "¢")
+ ("pound" "\\pounds{}" nil "&pound;" "pound" "£" "£")
+ ("yen" "\\textyen{}" nil "&yen;" "yen" "¥" "¥")
+ ("euro" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
+ ("EUR" "\\texteuro{}" nil "&euro;" "EUR" "EUR" "€")
+ ("dollar" "\\$" nil "$" "$" "$" "$")
+ ("USD" "\\$" nil "$" "$" "$" "$")
+
+ "** Property Marks"
+ ("copy" "\\textcopyright{}" nil "&copy;" "(c)" "©" "©")
+ ("reg" "\\textregistered{}" nil "&reg;" "(r)" "®" "®")
+ ("trade" "\\texttrademark{}" nil "&trade;" "TM" "TM" "™")
+
+ "** Science et al."
+ ("minus" "\\minus" t "&minus;" "-" "-" "−")
+ ("pm" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
+ ("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
+ ("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
+ ("frasl" "/" nil "&frasl;" "/" "/" "⁄")
+ ("colon" "\\colon" t ":" ":" ":" ":")
+ ("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
+ ("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
+ ("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
+ ("frac34" "\\textthreequarters{}" nil "&frac34;" "3/4" "¾" "¾")
+ ("permil" "\\textperthousand{}" nil "&permil;" "per thousand" "per thousand" "‰")
+ ("sup1" "\\textonesuperior{}" nil "&sup1;" "^1" "¹" "¹")
+ ("sup2" "\\texttwosuperior{}" nil "&sup2;" "^2" "²" "²")
+ ("sup3" "\\textthreesuperior{}" nil "&sup3;" "^3" "³" "³")
+ ("radic" "\\sqrt{\\,}" t "&radic;" "[square root]" "[square root]" "√")
+ ("sum" "\\sum" t "&sum;" "[sum]" "[sum]" "∑")
+ ("prod" "\\prod" t "&prod;" "[product]" "[n-ary product]" "∏")
+ ("micro" "\\textmu{}" nil "&micro;" "micro" "µ" "µ")
+ ("macr" "\\textasciimacron{}" nil "&macr;" "[macron]" "¯" "¯")
+ ("deg" "\\textdegree{}" nil "&deg;" "degree" "°" "°")
+ ("prime" "\\prime" t "&prime;" "'" "'" "′")
+ ("Prime" "\\prime{}\\prime" t "&Prime;" "''" "''" "″")
+ ("infin" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
+ ("infty" "\\infty" t "&infin;" "[infinity]" "[infinity]" "∞")
+ ("prop" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("propto" "\\propto" t "&prop;" "[proportional to]" "[proportional to]" "∝")
+ ("not" "\\textlnot{}" nil "&not;" "[angled dash]" "¬" "¬")
+ ("neg" "\\neg{}" t "&not;" "[angled dash]" "¬" "¬")
+ ("land" "\\land" t "&and;" "[logical and]" "[logical and]" "∧")
+ ("wedge" "\\wedge" t "&and;" "[logical and]" "[logical and]" "∧")
+ ("lor" "\\lor" t "&or;" "[logical or]" "[logical or]" "∨")
+ ("vee" "\\vee" t "&or;" "[logical or]" "[logical or]" "∨")
+ ("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
+ ("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
+ ("smile" "\\smile" t "&smile;" "[cup product]" "[cup product]" "⌣")
+ ("frown" "\\frown" t "&frown;" "[Cap product]" "[cap product]" "⌢")
+ ("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
+ ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
+ ("sim" "\\sim" t "&sim;" "~" "~" "∼")
+ ("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
+ ("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
+ ("asymp" "\\asymp" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
+ ("approx" "\\approx" t "&asymp;" "[almost equal to]" "[almost equal to]" "≈")
+ ("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
+ ("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
+ ("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
+
+ ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
+ ("le" "\\le" t "&le;" "<=" "<=" "≤")
+ ("leq" "\\le" t "&le;" "<=" "<=" "≤")
+ ("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
+ ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
+ ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
+ ("Ll" "\\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("lll" "\\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
+ ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
+ ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
+ ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
+ ("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
+ ("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
+ ("supset" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
+ ("nsub" "\\not\\subset" t "&nsub;" "[not a subset of]" "[not a subset of" "⊄")
+ ("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
+ ("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
+ ("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
+ ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
+ ("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
+ ("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("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]" "∅")
+ ("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
+ ("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
+ ("in" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
+ ("notin" "\\notin" t "&notin;" "[not an element of]" "[not an element of]" "∉")
+ ("ni" "\\ni" t "&ni;" "[contains as member]" "[contains as member]" "∋")
+ ("nabla" "\\nabla" t "&nabla;" "[nabla]" "[nabla]" "∇")
+ ("ang" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
+ ("angle" "\\angle" t "&ang;" "[angle]" "[angle]" "∠")
+ ("perp" "\\perp" t "&perp;" "[up tack]" "[up tack]" "⊥")
+ ("parallel" "\\parallel" t "&parallel;" "||" "||" "∥")
+ ("sdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
+ ("cdot" "\\cdot" t "&sdot;" "[dot]" "[dot]" "⋅")
+ ("lceil" "\\lceil" t "&lceil;" "[left ceiling]" "[left ceiling]" "⌈")
+ ("rceil" "\\rceil" t "&rceil;" "[right ceiling]" "[right ceiling]" "⌉")
+ ("lfloor" "\\lfloor" t "&lfloor;" "[left floor]" "[left floor]" "⌊")
+ ("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
+ ("lang" "\\langle" t "&lang;" "<" "<" "⟨")
+ ("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("langle" "\\langle" t "&lang;" "<" "<" "⟨")
+ ("rangle" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
+ ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
+
+ "** Arrows"
+ ("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
+ ("leftarrow" "\\leftarrow" t "&larr;" "<-" "<-" "←")
+ ("gets" "\\gets" t "&larr;" "<-" "<-" "←")
+ ("lArr" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
+ ("Leftarrow" "\\Leftarrow" t "&lArr;" "<=" "<=" "⇐")
+ ("uarr" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
+ ("uparrow" "\\uparrow" t "&uarr;" "[uparrow]" "[uparrow]" "↑")
+ ("uArr" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
+ ("Uparrow" "\\Uparrow" t "&uArr;" "[dbluparrow]" "[dbluparrow]" "⇑")
+ ("rarr" "\\rightarrow" t "&rarr;" "->" "->" "→")
+ ("to" "\\to" t "&rarr;" "->" "->" "→")
+ ("rightarrow" "\\rightarrow" t "&rarr;" "->" "->" "→")
+ ("rArr" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
+ ("Rightarrow" "\\Rightarrow" t "&rArr;" "=>" "=>" "⇒")
+ ("darr" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
+ ("downarrow" "\\downarrow" t "&darr;" "[downarrow]" "[downarrow]" "↓")
+ ("dArr" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
+ ("Downarrow" "\\Downarrow" t "&dArr;" "[dbldownarrow]" "[dbldownarrow]" "⇓")
+ ("harr" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
+ ("leftrightarrow" "\\leftrightarrow" t "&harr;" "<->" "<->" "↔")
+ ("hArr" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
+ ("Leftrightarrow" "\\Leftrightarrow" t "&hArr;" "<=>" "<=>" "⇔")
+ ("crarr" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
+ ("hookleftarrow" "\\hookleftarrow" t "&crarr;" "<-'" "<-'" "↵")
+
+ "** Function names"
+ ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos")
+ ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin")
+ ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan")
+ ("arg" "\\arg" t "arg" "arg" "arg" "arg")
+ ("cos" "\\cos" t "cos" "cos" "cos" "cos")
+ ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh")
+ ("cot" "\\cot" t "cot" "cot" "cot" "cot")
+ ("coth" "\\coth" t "coth" "coth" "coth" "coth")
+ ("csc" "\\csc" t "csc" "csc" "csc" "csc")
+ ("deg" "\\deg" t "&deg;" "deg" "deg" "deg")
+ ("det" "\\det" t "det" "det" "det" "det")
+ ("dim" "\\dim" t "dim" "dim" "dim" "dim")
+ ("exp" "\\exp" t "exp" "exp" "exp" "exp")
+ ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd")
+ ("hom" "\\hom" t "hom" "hom" "hom" "hom")
+ ("inf" "\\inf" t "inf" "inf" "inf" "inf")
+ ("ker" "\\ker" t "ker" "ker" "ker" "ker")
+ ("lg" "\\lg" t "lg" "lg" "lg" "lg")
+ ("lim" "\\lim" t "lim" "lim" "lim" "lim")
+ ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf")
+ ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup")
+ ("ln" "\\ln" t "ln" "ln" "ln" "ln")
+ ("log" "\\log" t "log" "log" "log" "log")
+ ("max" "\\max" t "max" "max" "max" "max")
+ ("min" "\\min" t "min" "min" "min" "min")
+ ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr")
+ ("sec" "\\sec" t "sec" "sec" "sec" "sec")
+ ("sin" "\\sin" t "sin" "sin" "sin" "sin")
+ ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh")
+ ("sup" "\\sup" t "&sup;" "sup" "sup" "sup")
+ ("tan" "\\tan" t "tan" "tan" "tan" "tan")
+ ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh")
+
+ "** Signs & Symbols"
+ ("bull" "\\textbullet{}" nil "&bull;" "*" "*" "•")
+ ("bullet" "\\textbullet{}" nil "&bull;" "*" "*" "•")
+ ("star" "\\star" t "*" "*" "*" "⋆")
+ ("lowast" "\\ast" t "&lowast;" "*" "*" "∗")
+ ("ast" "\\ast" t "&lowast;" "*" "*" "*")
+ ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
+ ("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
+ ("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
+ ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
+ ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
+
+ "** Miscellaneous (seldom used)"
+ ("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
+ ("ordf" "\\textordfeminine{}" nil "&ordf;" "_a_" "ª" "ª")
+ ("ordm" "\\textordmasculine{}" nil "&ordm;" "_o_" "º" "º")
+ ("cedil" "\\c{}" nil "&cedil;" "[cedilla]" "¸" "¸")
+ ("oline" "\\overline{~}" t "&oline;" "[overline]" "¯" "‾")
+ ("uml" "\\textasciidieresis{}" nil "&uml;" "[diaeresis]" "¨" "¨")
+ ("zwnj" "\\/{}" nil "&zwnj;" "" "" "‌")
+ ("zwj" "" nil "&zwj;" "" "" "‍")
+ ("lrm" "" nil "&lrm;" "" "" "‎")
+ ("rlm" "" nil "&rlm;" "" "" "‏")
+
+ "** Smilies"
+ ("smiley" "\\ddot\\smile" t "&#9786;" ":-)" ":-)" "☺")
+ ("blacksmile" "\\ddot\\smile" t "&#9787;" ":-)" ":-)" "☻")
+ ("sad" "\\ddot\\frown" t "&#9785;" ":-(" ":-(" "☹")
+ ("frowny" "\\ddot\\frown" t "&#9785;" ":-(" ":-(" "☹")
+
+ "** Suits"
+ ("clubs" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
+ ("clubsuit" "\\clubsuit" t "&clubs;" "[clubs]" "[clubs]" "♣")
+ ("spades" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
+ ("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
+ ("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
+ ("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
+ ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫"))
+ ;; Add "\_ "-entity family for spaces.
+ (let (space-entities html-spaces (entity "_"))
+ (dolist (n (number-sequence 1 20) (nreverse space-entities))
+ (let ((spaces (make-string n ?\s)))
+ (push (list (setq entity (concat entity " "))
+ (format "\\hspace*{%sem}" (* n .5))
+ nil
+ (setq html-spaces (concat "&ensp;" html-spaces))
+ spaces
+ spaces
+ (make-string n ?\x2002))
+ space-entities)))))
+ "Default entities used in Org mode to produce special characters.
For details see `org-entities-user'.")
(defsubst org-entity-get (name)
@@ -518,52 +533,27 @@ This first checks the user list, then the built-in list."
(or (assoc name org-entities-user)
(assoc name org-entities)))
-(defun org-entity-get-representation (name kind)
- "Get the correct representation of entity NAME for export type KIND.
-Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
- (let* ((e (org-entity-get name))
- (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4)
- (latin1 . 5) (utf8 . 6)))))
- (r (and e n (nth n e))))
- (if (and e r
- (not org-entities-ascii-explanatory)
- (memq kind '(ascii latin1 utf8))
- (= (string-to-char r) ?\[))
- (concat "\\" name)
- r)))
-
-(defsubst org-entity-latex-math-p (name)
- "Does entity NAME require math mode in LaTeX?"
- (nth 2 (org-entity-get name)))
-
;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org
(defun org-entities-create-table ()
"Create an Org mode table with all entities."
(interactive)
- (let ((pos (point)) e latex mathp html latin utf8 name ascii)
+ (let ((pos (point)))
(insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n")
- (mapc (lambda (e) (when (listp e)
- (setq name (car e)
- latex (nth 1 e)
- mathp (nth 2 e)
- html (nth 3 e)
- ascii (nth 4 e)
- latin (nth 5 e)
- utf8 (nth 6 e))
- (if (equal ascii "|") (setq ascii "\\vert"))
- (if (equal latin "|") (setq latin "\\vert"))
- (if (equal utf8 "|") (setq utf8 "\\vert"))
- (if (equal ascii "=>") (setq ascii "= >"))
- (if (equal latin "=>") (setq latin "= >"))
- (insert "|" name
- "|" (format "=%s=" latex)
- "|" (format (if mathp "$%s$" "$\\mbox{%s}$")
- latex)
- "|" (format "=%s=" html) "|" html
- "|" ascii "|" latin "|" utf8
- "|\n")))
- org-entities)
+ (dolist (e org-entities)
+ (pcase e
+ (`(,name ,latex ,mathp ,html ,ascii ,latin ,utf8)
+ (if (equal ascii "|") (setq ascii "\\vert"))
+ (if (equal latin "|") (setq latin "\\vert"))
+ (if (equal utf8 "|") (setq utf8 "\\vert"))
+ (if (equal ascii "=>") (setq ascii "= >"))
+ (if (equal latin "=>") (setq latin "= >"))
+ (insert "|" name
+ "|" (format "=%s=" latex)
+ "|" (format (if mathp "$%s$" "$\\mbox{%s}$") latex)
+ "|" (format "=%s=" html) "|" html
+ "|" ascii "|" latin "|" utf8
+ "|\n"))))
(goto-char pos)
(org-table-align)))
@@ -572,31 +562,27 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
"Create a Help buffer with all available entities."
(interactive)
(with-output-to-temp-buffer "*Org Entity Help*"
- (princ "Org-mode entities\n=================\n\n")
+ (princ "Org mode entities\n=================\n\n")
(let ((ll (append '("* User-defined additions (variable org-entities-user)")
org-entities-user
org-entities))
- e latex mathp html latin utf8 name ascii
(lastwasstring t)
(head (concat
"\n"
" Symbol Org entity LaTeX code HTML code\n"
" -----------------------------------------------------------\n")))
- (while ll
- (setq e (pop ll))
- (if (stringp e)
- (progn
- (princ e)
- (princ "\n")
- (setq lastwasstring t))
- (if lastwasstring (princ head))
- (setq lastwasstring nil)
- (setq name (car e)
- latex (nth 1 e)
- html (nth 3 e)
- utf8 (nth 6 e))
- (princ (format " %-8s \\%-16s %-22s %-13s\n"
- utf8 name latex html))))))
+ (dolist (e ll)
+ (pcase e
+ (`(,name ,latex ,_ ,html ,_ ,_ ,utf8)
+ (when lastwasstring
+ (princ head)
+ (setq lastwasstring nil))
+ (princ (format " %-8s \\%-16s %-22s %-13s\n"
+ utf8 name latex html)))
+ ((pred stringp)
+ (princ e)
+ (princ "\n")
+ (setq lastwasstring t))))))
(with-current-buffer "*Org Entity Help*"
(org-mode)
(when org-pretty-entities
@@ -604,12 +590,6 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'."
(select-window (get-buffer-window "*Org Entity Help*")))
-(defun replace-amp ()
- "Postprocess HTML file to unescape the ampersand."
- (interactive)
- (while (re-search-forward "<td>&amp;\\([^<;]+;\\)" nil t)
- (replace-match (concat "<td>&" (match-string 1)) t t)))
-
(provide 'org-entities)
;; Local variables:
diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el
index 9eddd3fcf4e..b0e9631e6f5 100644
--- a/lisp/org/org-eshell.el
+++ b/lisp/org/org-eshell.el
@@ -1,4 +1,4 @@
-;;; org-eshell.el - Support for links to working directories in eshell
+;;; org-eshell.el - Support for Links to Working Directories in Eshell -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -27,8 +27,9 @@
(require 'eshell)
(require 'esh-mode)
-(org-add-link-type "eshell" 'org-eshell-open)
-(add-hook 'org-store-link-functions 'org-eshell-store-link)
+(org-link-set-parameters "eshell"
+ :follow #'org-eshell-open
+ :store #'org-eshell-store-link)
(defun org-eshell-open (link)
"Switch to am eshell buffer and execute a command line.
@@ -43,7 +44,7 @@
(eshell-buffer-name (car buffer-and-command))
(command (cadr buffer-and-command)))
(if (get-buffer eshell-buffer-name)
- (org-pop-to-buffer-same-window eshell-buffer-name)
+ (pop-to-buffer-same-window eshell-buffer-name)
(eshell))
(goto-char (point-max))
(eshell-kill-input)
diff --git a/lisp/org/org-eww.el b/lisp/org/org-eww.el
new file mode 100644
index 00000000000..372b543f512
--- /dev/null
+++ b/lisp/org/org-eww.el
@@ -0,0 +1,175 @@
+;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
+
+;; Author: Marco Wahl <marcowahlsoft>a<gmailcom>
+;; Keywords: link, eww
+;; Homepage: http://orgmode.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; When this module is active `org-store-link' (often on key C-c l) in
+;; a eww buffer stores a link to the current url of the eww buffer.
+
+;; In an eww buffer function `org-eww-copy-for-org-mode' kills either
+;; a region or the whole buffer if no region is set and transforms the
+;; text on the fly so that it can be pasted into an Org buffer with
+;; hot links.
+
+;; C-c C-x C-w (and also C-c C-x M-w) trigger
+;; `org-eww-copy-for-org-mode'.
+
+;; Hint: A lot of code of this module comes from module org-w3m which
+;; has been written by Andy Steward based on the idea of Richard
+;; Riley. Thanks!
+
+;; Potential: Since the code for w3m and eww is so similar one could
+;; try to refactor.
+
+
+;;; Code:
+(require 'org)
+(require 'cl-lib)
+
+(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)
+(defun org-eww-store-link ()
+ "Store a link to the url of a Eww buffer."
+ (when (eq major-mode 'eww-mode)
+ (org-store-link-props
+ :type "eww"
+ :link (if (< emacs-major-version 25)
+ eww-current-url
+ (eww-current-url))
+ :url (url-view-url t)
+ :description (if (< emacs-major-version 25)
+ (or eww-current-title eww-current-url)
+ (or (plist-get eww-data :title)
+ (eww-current-url))))))
+
+
+;; Some auxiliary functions concerning links in eww buffers
+(defun org-eww-goto-next-url-property-change ()
+ "Move to the start of next link if exists.
+Otherwise point is not moved. Return point."
+ (goto-char
+ (or (next-single-property-change (point) 'shr-url)
+ (point))))
+
+(defun org-eww-has-further-url-property-change-p ()
+ "Non-nil if there is a next url property change."
+ (save-excursion
+ (not (eq (point) (org-eww-goto-next-url-property-change)))))
+
+(defun org-eww-url-below-point ()
+ "Return the url below point if there is an url; otherwise, return nil."
+ (get-text-property (point) 'shr-url))
+
+
+(defun org-eww-copy-for-org-mode ()
+ "Copy current buffer content or active region with `org-mode' style links.
+This will encode `link-title' and `link-location' with
+`org-make-link-string', and insert the transformed test into the kill ring,
+so that it can be yanked into an Org mode buffer with links working correctly.
+
+Further lines starting with a star get quoted with a comma to keep
+the structure of the Org file."
+ (interactive)
+ (let* ((regionp (org-region-active-p))
+ (transform-start (point-min))
+ (transform-end (point-max))
+ return-content
+ link-location link-title
+ temp-position out-bound)
+ (when regionp
+ (setq transform-start (region-beginning))
+ (setq transform-end (region-end))
+ ;; Deactivate mark if current mark is activate.
+ (when (fboundp 'deactivate-mark) (deactivate-mark)))
+ (message "Transforming links...")
+ (save-excursion
+ (goto-char transform-start)
+ (while (and (not out-bound) ; still inside region to copy
+ (org-eww-has-further-url-property-change-p)) ; there is a next link
+ ;; Store current point before jump next anchor.
+ (setq temp-position (point))
+ ;; Move to next anchor when current point is not at anchor.
+ (or (org-eww-url-below-point)
+ (org-eww-goto-next-url-property-change))
+ (cl-assert
+ (org-eww-url-below-point) t
+ "program logic error: point must have an url below but it hasn't")
+ (if (<= (point) transform-end) ; if point is inside transform bound
+ (progn
+ ;; Get content between two links.
+ (when (< temp-position (point))
+ (setq return-content (concat return-content
+ (buffer-substring
+ temp-position (point)))))
+ ;; Get link location at current point.
+ (setq link-location (org-eww-url-below-point))
+ ;; Get link title at current point.
+ (setq link-title
+ (buffer-substring
+ (point)
+ (org-eww-goto-next-url-property-change)))
+ ;; concat `org-mode' style url to `return-content'.
+ (setq return-content
+ (concat return-content
+ (if (stringp link-location)
+ ;; hint: link-location is different for form-elements.
+ (org-make-link-string link-location link-title)
+ link-title))))
+ (goto-char temp-position) ; reset point before jump next anchor
+ (setq out-bound t) ; for break out `while' loop
+ ))
+ ;; Add the rest until end of the region to be copied.
+ (when (< (point) transform-end)
+ (setq return-content
+ (concat return-content
+ (buffer-substring (point) transform-end))))
+ ;; Quote lines starting with *.
+ (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content))
+ (message "Transforming links...done, use C-y to insert text into Org mode file"))))
+
+
+;; Additional keys for eww-mode
+
+(defun org-eww-extend-eww-keymap ()
+ (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode)
+ (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode))
+
+(when (and (boundp 'eww-mode-map)
+ (keymapp eww-mode-map)) ; eww is already up.
+ (org-eww-extend-eww-keymap))
+
+(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap)
+
+
+(provide 'org-eww)
+
+;;; org-eww.el ends here
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index c340aca73a5..eab9f3e313f 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -1,4 +1,4 @@
-;;; org-faces.el --- Face definitions for Org-mode.
+;;; org-faces.el --- Face definitions -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
@@ -28,32 +28,12 @@
;;; Code:
-(require 'org-macs)
-(require 'org-compat)
-
-(defun org-copy-face (old-face new-face docstring &rest attributes)
- (unless (facep new-face)
- (if (fboundp 'set-face-attribute)
- (progn
- (make-face new-face)
- (set-face-attribute new-face nil :inherit old-face)
- (apply 'set-face-attribute new-face nil attributes)
- (set-face-doc-string new-face docstring))
- (copy-face old-face new-face)
- (if (fboundp 'set-face-doc-string)
- (set-face-doc-string new-face docstring)))))
-(put 'org-copy-face 'lisp-indent-function 2)
-
-(when (featurep 'xemacs)
- (put 'mode-line 'face-alias 'modeline))
-
(defgroup org-faces nil
- "Faces in Org-mode."
+ "Faces in Org mode."
:tag "Org Faces"
:group 'org-appearance)
-(defface org-default
- (org-compatible-face 'default nil)
+(defface org-default '((t :inherit default))
"Face used for default text."
:group 'org-faces)
@@ -65,99 +45,49 @@ The foreground color of this face should be equal to the background
color of the frame."
:group 'org-faces)
-(defface org-level-1 ;; originally copied from font-lock-function-name-face
- (org-compatible-face 'outline-1
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :bold t))
- (t (:bold t))))
+(defface org-level-1 '((t :inherit outline-1))
"Face used for level 1 headlines."
:group 'org-faces)
-(defface org-level-2 ;; originally copied from font-lock-variable-name-face
- (org-compatible-face 'outline-2
- '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8) (background light)) (:foreground "yellow"))
- (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t))
- (t (:bold t))))
+(defface org-level-2 '((t :inherit outline-2))
"Face used for level 2 headlines."
:group 'org-faces)
-(defface org-level-3 ;; originally copied from font-lock-keyword-face
- (org-compatible-face 'outline-3
- '((((class color) (min-colors 88) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1"))
- (((class color) (min-colors 16) (background light)) (:foreground "Purple"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Cyan"))
- (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t))
- (t (:bold t))))
+(defface org-level-3 '((t :inherit outline-3))
"Face used for level 3 headlines."
:group 'org-faces)
-(defface org-level-4 ;; originally copied from font-lock-comment-face
- (org-compatible-face 'outline-4
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 16) (background light)) (:foreground "red"))
- (((class color) (min-colors 16) (background dark)) (:foreground "red1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+(defface org-level-4 '((t :inherit outline-4))
"Face used for level 4 headlines."
:group 'org-faces)
-(defface org-level-5 ;; originally copied from font-lock-type-face
- (org-compatible-face 'outline-5
- '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))))
+(defface org-level-5 '((t :inherit outline-5))
"Face used for level 5 headlines."
:group 'org-faces)
-(defface org-level-6 ;; originally copied from font-lock-constant-face
- (org-compatible-face 'outline-6
- '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine"))
- (((class color) (min-colors 8)) (:foreground "magenta"))))
+(defface org-level-6 '((t :inherit outline-6))
"Face used for level 6 headlines."
:group 'org-faces)
-(defface org-level-7 ;; originally copied from font-lock-builtin-face
- (org-compatible-face 'outline-7
- '((((class color) (min-colors 16) (background light)) (:foreground "Orchid"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue"))
- (((class color) (min-colors 8)) (:foreground "blue"))))
+(defface org-level-7 '((t :inherit outline-7))
"Face used for level 7 headlines."
:group 'org-faces)
-(defface org-level-8 ;; originally copied from font-lock-string-face
- (org-compatible-face 'outline-8
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 8)) (:foreground "green"))))
+(defface org-level-8 '((t :inherit outline-8))
"Face used for level 8 headlines."
:group 'org-faces)
-(defface org-special-keyword ;; originally copied from font-lock-string-face
- (org-compatible-face 'font-lock-keyword-face
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t))))
+(defface org-special-keyword '((t :inherit font-lock-keyword-face))
"Face used for special keywords."
:group 'org-faces)
-(defface org-drawer ;; originally copied from font-lock-function-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :bold t))
- (t (:bold t))))
+(defface org-drawer ;Copied from `font-lock-function-name-face'
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t)))
"Face used for drawers."
:group 'org-faces)
@@ -166,18 +96,17 @@ color of the frame."
:group 'org-faces)
(defface org-column
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light))
- (:background "grey90" :weight normal :slant normal :strike-through nil
- :underline nil))
- (((class color) (min-colors 16) (background dark))
- (:background "grey30" :weight normal :slant normal :strike-through nil
- :underline nil))
- (((class color) (min-colors 8))
- (:background "cyan" :foreground "black"
- :weight normal :slant normal :strike-through nil
- :underline nil))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 16) (background light))
+ (:background "grey90" :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (((class color) (min-colors 16) (background dark))
+ (:background "grey30" :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black"
+ :weight normal :slant normal :strike-through nil
+ :underline nil))
+ (t (:inverse-video t)))
"Face for column display of entry properties.
This is actually only part of the face definition for the text in column view.
The following faces apply, with this priority.
@@ -198,59 +127,33 @@ character (this might for example be the a TODO keyword) might still
shine through in some properties. So when your column view looks
funny, with \"random\" colors, weight, strike-through, try to explicitly
set the properties in the `org-column' face. For example, set
-:underline to nil, or the :slant to `normal'.
-
-Under XEmacs, the rules are simpler, because the XEmacs version of
-column view defines special faces for each outline level. See the file
-`org-colview-xemacs.el' in Org's contrib/ directory for details."
+:underline to nil, or the :slant to `normal'."
:group 'org-faces)
(defface org-column-title
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light))
- (:background "grey90" :underline t :weight bold))
- (((class color) (min-colors 16) (background dark))
- (:background "grey30" :underline t :weight bold))
- (((class color) (min-colors 8))
- (:background "cyan" :foreground "black" :underline t :weight bold))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 16) (background light))
+ (:background "grey90" :underline t :weight bold))
+ (((class color) (min-colors 16) (background dark))
+ (:background "grey30" :underline t :weight bold))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black" :underline t :weight bold))
+ (t (:inverse-video t)))
"Face for column display of entry properties."
:group 'org-faces)
-(defface org-agenda-column-dateline
- (org-compatible-face 'org-column
- '((t nil)))
+(defface org-agenda-column-dateline '((t :inherit org-column))
"Face used in agenda column view for datelines with summaries."
:group 'org-faces)
-(defface org-warning
- (org-compatible-face 'font-lock-warning-face
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+(defface org-warning '((t :inherit font-lock-warning-face))
"Face for deadlines and TODO keywords."
:group 'org-faces)
-(defface org-archived ; similar to shadow
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
+(defface org-archived '((t :inherit shadow))
"Face for headline with the ARCHIVE tag."
:group 'org-faces)
-(defface org-link
- (org-compatible-face 'link
- '((((class color) (background light)) (:foreground "Purple" :underline t))
- (((class color) (background dark)) (:foreground "Cyan" :underline t))
- (t (:underline t))))
+(defface org-link '((t :inherit link))
"Face for links."
:group 'org-faces)
@@ -283,12 +186,11 @@ column view defines special faces for each outline level. See the file
:group 'org-faces)
(defface org-date-selected
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t))
+ (t (:inverse-video t)))
"Face for highlighting the calendar day when using `org-read-date'.
Using a bold face here might cause discrepancies while displaying the
calendar."
@@ -301,43 +203,38 @@ calendar."
"Face for diary-like sexp date specifications."
:group 'org-faces)
-(defface org-tag
- '((t (:bold t)))
+(defface org-tag '((t (:bold t)))
"Default face for tags.
Note that the variable `org-tag-faces' can be used to overrule this face for
specific tags."
:group 'org-faces)
-(defface org-list-dt
- '((t (:bold t)))
+(defface org-list-dt '((t (:bold t)))
"Default face for definition terms in lists."
:group 'org-faces)
-(defface org-todo ; font-lock-warning-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
- (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
- (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:inverse-video t :bold t))))
+(defface org-todo ;Copied from `font-lock-warning-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t))
+ (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:inverse-video t :bold t)))
"Face for TODO keywords."
:group 'org-faces)
-(defface org-done ;; originally copied from font-lock-type-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold t))))
+(defface org-done ;Copied from `font-lock-type-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t)))
"Face used for todo keywords that indicate DONE items."
:group 'org-faces)
-(defface org-agenda-done ;; originally copied from font-lock-type-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
- (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold nil))))
+(defface org-agenda-done ;Copied from `font-lock-type-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold nil)))
"Face used in agenda, to indicate lines switched to DONE.
This face is used to de-emphasize items that where brightly colored in the
agenda because they were things to do, or overdue. The DONE state itself
@@ -346,11 +243,10 @@ is of course immediately visible, but for example a passed deadline is
of the frame, for example."
:group 'org-faces)
-(defface org-headline-done ;; originally copied from font-lock-string-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (((class color) (min-colors 8) (background light)) (:bold nil))))
+(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"))
+ (((class color) (min-colors 8) (background light)) (:bold nil)))
"Face used to indicate that a headline is DONE.
This face is only used if `org-fontify-done-headline' is set. If applies
to the part of the headline after the DONE keyword."
@@ -388,18 +284,14 @@ determines if it is a foreground or a background color."
(string :tag "Color")
(sexp :tag "Face")))))
-(defface org-priority ;; originally copied from font-lock-string-face
- (org-compatible-face 'font-lock-keyword-face
- '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon"))
- (t (:italic t))))
+(defface org-priority '((t :inherit font-lock-keyword-face))
"Face used for priority cookies."
:group 'org-faces)
(defcustom org-priority-faces nil
"Faces for specific Priorities.
This is a list of cons cells, with priority character in the car
-and faces in the cdr. The face can be a symbol, a color as
+and faces in the cdr. The face can be a symbol, a color
as a string, or a property list of attributes, like
(:foreground \"blue\" :weight bold :underline t).
If it is a color string, the variable `org-faces-easy-properties'
@@ -421,18 +313,17 @@ determines if it is a foreground or a background color."
(setq org-tags-special-faces-re
(concat ":\\(" (mapconcat 'car value "\\|") "\\):"))))
-(defface org-checkbox
- (org-compatible-face 'bold
- '((t (:bold t))))
+(defface org-checkbox '((t :inherit bold))
"Face for checkboxes."
:group 'org-faces)
+(defface org-checkbox-statistics-todo '((t (:inherit org-todo)))
+ "Face used for unfinished checkbox statistics."
+ :group 'org-faces)
-(org-copy-face 'org-todo 'org-checkbox-statistics-todo
- "Face used for unfinished checkbox statistics.")
-
-(org-copy-face 'org-done 'org-checkbox-statistics-done
- "Face used for finished checkbox statistics.")
+(defface org-checkbox-statistics-done '((t (:inherit org-done)))
+ "Face used for finished checkbox statistics."
+ :group 'org-faces)
(defcustom org-tag-faces nil
"Faces for specific tags.
@@ -454,44 +345,32 @@ changes."
(string :tag "Foreground color")
(sexp :tag "Face")))))
-(defface org-table ;; originally copied from font-lock-function-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8) (background light)) (:foreground "blue"))
- (((class color) (min-colors 8) (background dark)))))
+(defface org-table ;Copied from `font-lock-function-name-face'
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8) (background light)) (:foreground "blue"))
+ (((class color) (min-colors 8) (background dark))))
"Face used for tables."
:group 'org-faces)
(defface org-formula
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red"))
- (((class color) (min-colors 8) (background dark)) (:foreground "red"))
- (t (:bold t :italic t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red"))
+ (t (:bold t :italic t)))
"Face for formulas."
:group 'org-faces)
-(defface org-code
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
+(defface org-code '((t :inherit shadow))
"Face for fixed-width text like code snippets."
:group 'org-faces
:version "22.1")
-(defface org-meta-line
- (org-compatible-face 'font-lock-comment-face nil)
- "Face for meta lines startin with \"#+\"."
+(defface org-meta-line '((t :inherit font-lock-comment-face))
+ "Face for meta lines starting with \"#+\"."
:group 'org-faces
:version "22.1")
@@ -510,60 +389,37 @@ changes."
follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword."
:group 'org-faces)
-(defface org-document-info-keyword
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
+(defface org-document-info-keyword '((t :inherit shadow))
"Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords."
:group 'org-faces)
-(defface org-block
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50"))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70"))
- (((class color) (min-colors 8) (background light))
- (:foreground "green"))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow"))))
- "Face text in #+begin ... #+end blocks."
+(defface org-block '((t :inherit shadow))
+ "Face text in #+begin ... #+end blocks.
+For source-blocks `org-src-block-faces' takes precedence.
+See also `org-fontify-quote-and-verse-blocks'."
:group 'org-faces
- :version "22.1")
+ :version "26.1")
-(defface org-block-background '((t ()))
- "Face used for the source block background.")
-
-(org-copy-face 'org-meta-line 'org-block-begin-line
- "Face used for the line delimiting the begin of source blocks.")
-
-(org-copy-face 'org-meta-line 'org-block-end-line
- "Face used for the line delimiting the end of source blocks.")
-
-(defface org-verbatim
- (org-compatible-face 'shadow
- '((((class color grayscale) (min-colors 88) (background light))
- (:foreground "grey50" :underline t))
- (((class color grayscale) (min-colors 88) (background dark))
- (:foreground "grey70" :underline t))
- (((class color) (min-colors 8) (background light))
- (:foreground "green" :underline t))
- (((class color) (min-colors 8) (background dark))
- (:foreground "yellow" :underline t))))
- "Face for fixed-with text like code snippets."
+(defface org-block-begin-line '((t (:inherit org-meta-line)))
+ "Face used for the line delimiting the begin of source blocks."
+ :group 'org-faces)
+
+(defface org-block-end-line '((t (:inherit org-block-begin-line)))
+ "Face used for the line delimiting the end of source blocks."
+ :group 'org-faces)
+
+(defface org-verbatim '((t (:inherit shadow)))
+ "Face for fixed-with text like code snippets"
:group 'org-faces
:version "22.1")
-(org-copy-face 'org-block 'org-quote
- "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.")
-(org-copy-face 'org-block 'org-verse
- "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.")
+(defface org-quote '((t (:inherit org-block)))
+ "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks."
+ :group 'org-faces)
+
+(defface org-verse '((t (:inherit org-block)))
+ "Face for #+BEGIN_VERSE ... #+END_VERSE blocks."
+ :group 'org-faces)
(defcustom org-fontify-quote-and-verse-blocks nil
"Non-nil means, add a special face to #+begin_quote and #+begin_verse block.
@@ -573,64 +429,64 @@ content of these blocks will still be treated as Org syntax."
:version "24.1"
:type 'boolean)
-(defface org-clock-overlay ;; copied from secondary-selection
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light))
- (:background "yellow1"))
- (((class color) (min-colors 88) (background dark))
- (:background "SkyBlue4"))
- (((class color) (min-colors 16) (background light))
- (:background "yellow"))
- (((class color) (min-colors 16) (background dark))
- (:background "SkyBlue4"))
- (((class color) (min-colors 8))
- (:background "cyan" :foreground "black"))
- (t (:inverse-video t))))
+(defface org-clock-overlay ;Copied from `secondary-selection'
+ '((((class color) (min-colors 88) (background light))
+ (:background "LightGray" :foreground "black"))
+ (((class color) (min-colors 88) (background dark))
+ (:background "SkyBlue4" :foreground "white"))
+ (((class color) (min-colors 16) (background light))
+ (:background "gray" :foreground "black"))
+ (((class color) (min-colors 16) (background dark))
+ (:background "SkyBlue4" :foreground "white"))
+ (((class color) (min-colors 8))
+ (:background "cyan" :foreground "black"))
+ (t (:inverse-video t)))
"Basic face for displaying the secondary selection."
:group 'org-faces)
-(defface org-agenda-structure ;; originally copied from font-lock-function-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
- (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
- (((class color) (min-colors 8)) (:foreground "blue" :bold t))
- (t (:bold t))))
+(defface org-agenda-structure ;Copied from `font-lock-function-name-face'
+ '((((class color) (min-colors 88) (background light)) (:foreground "Blue1"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 16) (background light)) (:foreground "Blue"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue"))
+ (((class color) (min-colors 8)) (:foreground "blue" :bold t))
+ (t (:bold t)))
"Face used in agenda for captions and dates."
:group 'org-faces)
-(org-copy-face 'org-agenda-structure 'org-agenda-date
- "Face used in agenda for normal days.")
+(defface org-agenda-date '((t (:inherit org-agenda-structure)))
+ "Face used in agenda for normal days."
+ :group 'org-faces)
-(org-copy-face 'org-agenda-date 'org-agenda-date-today
+(defface org-agenda-date-today
+ '((t (:inherit org-agenda-date :weight bold :italic t)))
"Face used in agenda for today."
- :weight 'bold :italic 't)
+ :group 'org-faces)
-(org-copy-face 'secondary-selection 'org-agenda-clocking
- "Face marking the current clock item in the agenda.")
+(defface org-agenda-clocking '((t (:inherit secondary-selection)))
+ "Face marking the current clock item in the agenda."
+ :group 'org-faces)
-(org-copy-face 'org-agenda-date 'org-agenda-date-weekend
+(defface org-agenda-date-weekend '((t (:inherit org-agenda-date :weight bold)))
"Face used in agenda for weekend days.
-See the variable `org-agenda-weekend-days' for a definition of which days
-belong to the weekend."
- :weight 'bold)
+
+See the variable `org-agenda-weekend-days' for a definition of
+which days belong to the weekend."
+ :group 'org-faces)
(defface org-scheduled
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
- (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold t :italic t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t :italic t)))
"Face for items scheduled for a certain day."
:group 'org-faces)
(defface org-scheduled-today
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
- (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
- (((class color) (min-colors 8)) (:foreground "green"))
- (t (:bold t :italic t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen"))
+ (((class color) (min-colors 8)) (:foreground "green"))
+ (t (:bold t :italic t)))
"Face for items scheduled for a certain day."
:group 'org-faces)
@@ -641,22 +497,20 @@ belong to the weekend."
:group 'org-faces)
(defface org-scheduled-previously
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red"))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t)))
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
(defface org-upcoming-deadline
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
- (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
- (((class color) (min-colors 8) (background light)) (:foreground "red"))
- (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
- (t (:bold t))))
+ '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick"))
+ (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1"))
+ (((class color) (min-colors 8) (background light)) (:foreground "red"))
+ (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t))
+ (t (:bold t)))
"Face for items scheduled previously, and not yet done."
:group 'org-faces)
@@ -666,7 +520,7 @@ belong to the weekend."
(0.0 . default))
"Faces for showing deadlines in the agenda.
This is a list of cons cells. The cdr of each cell is a face to be used,
-and it can also just be like (:foreground \"yellow\").
+and it can also just be like \\='(:foreground \"yellow\").
Each car is a fraction of the head-warning time that must have passed for
this the face in the cdr to be used for display. The numbers must be
given in descending order. The head-warning time is normally taken
@@ -686,65 +540,61 @@ month and 365.24 days for a year)."
(sexp :tag "Face"))))
(defface org-agenda-restriction-lock
- (org-compatible-face nil
- '((((class color) (min-colors 88) (background light)) (:background "#eeeeee"))
- (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C"))
- (((class color) (min-colors 16) (background light)) (:background "#eeeeee"))
- (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C"))
- (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
- (t (:inverse-video t))))
+ '((((class color) (min-colors 88) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C"))
+ (((class color) (min-colors 16) (background light)) (:background "#eeeeee"))
+ (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C"))
+ (((class color) (min-colors 8)) (:background "cyan" :foreground "black"))
+ (t (:inverse-video t)))
"Face for showing the agenda restriction lock."
:group 'org-faces)
-(defface org-agenda-filter-tags
- (org-compatible-face 'mode-line nil)
+(defface org-agenda-filter-tags '((t :inherit mode-line))
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
-(defface org-agenda-filter-regexp
- (org-compatible-face 'mode-line nil)
+(defface org-agenda-filter-regexp '((t :inherit mode-line))
"Face for regexp(s) in the mode-line when filtering the agenda."
:group 'org-faces)
-(defface org-agenda-filter-category
- (org-compatible-face 'mode-line nil)
- "Face for categories(s) in the mode-line when filtering the agenda."
+(defface org-agenda-filter-category '((t :inherit mode-line))
+ "Face for categories in the mode-line when filtering the agenda."
:group 'org-faces)
-(defface org-time-grid ;; originally copied from font-lock-variable-name-face
- (org-compatible-face nil
- '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
- (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
- (((class color) (min-colors 8)) (:foreground "yellow" :weight light))))
+(defface org-agenda-filter-effort '((t :inherit mode-line))
+ "Face for effort in the mode-line when filtering the agenda."
+ :group 'org-faces)
+
+(defface org-time-grid ;Copied from `font-lock-variable-name-face'
+ '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))
+ (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod"))
+ (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))
"Face used for time grids."
:group 'org-faces)
-(org-copy-face 'org-time-grid 'org-agenda-current-time
- "Face used to show the current time in the time grid.")
+(defface org-agenda-current-time '((t (:inherit org-time-grid)))
+ "Face used to show the current time in the time grid."
+ :group 'org-faces)
-(defface org-agenda-diary
- (org-compatible-face 'default nil)
+(defface org-agenda-diary '((t :inherit default))
"Face used for agenda entries that come from the Emacs diary."
:group 'org-faces)
-(defface org-agenda-calendar-event
- (org-compatible-face 'default nil)
+(defface org-agenda-calendar-event '((t :inherit default))
"Face used to show events and appointments in the agenda."
:group 'org-faces)
-(defface org-agenda-calendar-sexp
- (org-compatible-face 'default nil)
+(defface org-agenda-calendar-sexp '((t :inherit default))
"Face used to show events computed from a S-expression."
:group 'org-faces)
(defconst org-level-faces
'(org-level-1 org-level-2 org-level-3 org-level-4
- org-level-5 org-level-6 org-level-7 org-level-8
- ))
+ org-level-5 org-level-6 org-level-7 org-level-8))
(defcustom org-n-level-faces (length org-level-faces)
"The number of different faces to be used for headlines.
-Org-mode defines 8 different headline faces, so this can be at most 8.
+Org mode defines 8 different headline faces, so this can be at most 8.
If it is less than 8, the level-1 face gets re-used for level N+1 etc."
:type 'integer
:group 'org-faces)
@@ -777,25 +627,26 @@ level org-n-level-faces"
:version "24.4"
:package-version '(Org . "8.0"))
-(defface org-macro
- (org-compatible-face 'org-latex-and-related nil)
+(defface org-macro '((t :inherit org-latex-and-related))
"Face for macros."
:group 'org-faces
:version "24.4"
:package-version '(Org . "8.0"))
-(defface org-tag-group
- (org-compatible-face 'org-tag nil)
+(defface org-tag-group '((t :inherit org-tag))
"Face for group tags."
:group 'org-faces
:version "24.4"
:package-version '(Org . "8.0"))
-(org-copy-face 'mode-line 'org-mode-line-clock
- "Face used for clock display in mode line.")
-(org-copy-face 'mode-line 'org-mode-line-clock-overrun
+(defface org-mode-line-clock '((t (:inherit mode-line)))
+ "Face used for clock display in mode line."
+ :group 'org-faces)
+
+(defface org-mode-line-clock-overrun
+ '((t (:inherit mode-line :background "red")))
"Face used for clock display for overrun tasks in mode line."
- :background "red")
+ :group 'org-faces)
(provide 'org-faces)
diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el
index cfb4b4f7e33..cd2e95f7ad2 100644
--- a/lisp/org/org-feed.el
+++ b/lisp/org/org-feed.el
@@ -1,4 +1,4 @@
-;;; org-feed.el --- Add RSS feed items to Org files
+;;; org-feed.el --- Add RSS feed items to Org files -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;;
@@ -19,16 +19,16 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
-;; This module allows entries to be created and changed in an Org-mode
-;; file triggered by items in an RSS feed. The basic functionality is
-;; geared toward simply adding new items found in a feed as outline nodes
-;; to an Org file. Using hooks, arbitrary actions can be triggered for
-;; new or changed items.
+;; This module allows entries to be created and changed in an Org mode
+;; file triggered by items in an RSS feed. The basic functionality
+;; is geared toward simply adding new items found in a feed as
+;; outline nodes to an Org file. Using hooks, arbitrary actions can
+;; be triggered for new or changed items.
;;
;; Selecting feeds and target locations
;; ------------------------------------
@@ -77,10 +77,8 @@
;; org-feed.el needs to keep track of which feed items have been handled
;; before, so that they will not be handled again. For this, org-feed.el
;; stores information in a special drawer, FEEDSTATUS, under the heading
-;; that received the input of the feed. You should add FEEDSTATUS
-;; to your list of drawers in the files that receive feed input:
+;; that received the input of the feed.
;;
-;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS
;;
;; Acknowledgments
;; ---------------
@@ -102,8 +100,8 @@
(declare-function xml-substitute-special "xml" (string))
(declare-function org-capture-escaped-% "org-capture" ())
+(declare-function org-capture-expand-embedded-elisp "org-capture" (&optional mark))
(declare-function org-capture-inside-embedded-elisp-p "org-capture" ())
-(declare-function org-capture-expand-embedded-elisp "org-capture" ())
(defgroup org-feed nil
"Options concerning RSS feeds as inputs for Org files."
@@ -117,7 +115,9 @@ to create inbox items in Org. Each entry is a list with the following items:
name a custom name for this feed
URL the Feed URL
-file the target Org file where entries should be listed
+file the target Org file where entries should be listed, when
+ nil the target becomes the current buffer (may be an
+ indirect buffer) each time the feed update is invoked
headline the headline under which entries should be listed
Additional arguments can be given using keyword-value pairs. Many of these
@@ -216,10 +216,7 @@ Here are the keyword-value pair allows in `org-feed-alist'.
(defcustom org-feed-drawer "FEEDSTATUS"
"The name of the drawer for feed status information.
Each feed may also specify its own drawer name using the `:drawer'
-parameter in `org-feed-alist'.
-Note that in order to make these drawers behave like drawers, they must
-be added to the variable `org-drawers' or configured with a #+DRAWERS
-line."
+parameter in `org-feed-alist'."
:group 'org-feed
:type '(string :tag "Drawer Name"))
@@ -300,7 +297,8 @@ it can be a list structured like an entry in `org-feed-alist'."
(catch 'exit
(let ((name (car feed))
(url (nth 1 feed))
- (file (nth 2 feed))
+ (file (or (nth 2 feed) (buffer-file-name (or (buffer-base-buffer)
+ (current-buffer)))))
(headline (nth 3 feed))
(filter (nth 1 (memq :filter feed)))
(formatter (nth 1 (memq :formatter feed)))
@@ -315,7 +313,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(parse-entry (or (nth 1 (memq :parse-entry feed))
'org-feed-parse-rss-entry))
feed-buffer inbox-pos new-formatted
- entries old-status status new changed guid-alist e guid olds)
+ entries old-status status new changed guid-alist guid olds)
(setq feed-buffer (org-feed-get-feed url))
(unless (and feed-buffer (bufferp (get-buffer feed-buffer)))
(error "Cannot get feed %s" name))
@@ -407,8 +405,8 @@ it can be a list structured like an entry in `org-feed-alist'."
;; Normalize the visibility of the inbox tree
(goto-char inbox-pos)
- (hide-subtree)
- (show-children)
+ (outline-hide-subtree)
+ (org-show-children)
(org-cycle-hide-drawers 'children)
;; Hooks and messages
@@ -442,7 +440,7 @@ it can be a list structured like an entry in `org-feed-alist'."
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
(unless feed
(error "No such feed in `org-feed-alist"))
- (org-pop-to-buffer-same-window
+ (pop-to-buffer-same-window
(org-feed-update feed 'retrieve-only))
(goto-char (point-min)))
@@ -477,8 +475,7 @@ This will find DRAWER and extract the alist."
"Write the feed STATUS to DRAWER in entry at POS."
(save-excursion
(goto-char pos)
- (let ((end (save-excursion (org-end-of-subtree t t)))
- guid)
+ (let ((end (save-excursion (org-end-of-subtree t t))))
(if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n")
end t)
(progn
@@ -514,66 +511,77 @@ ENTRY is a property list. This function adds a `:formatted-for-org' property
and returns the full property list.
If that property is already present, nothing changes."
(require 'org-capture)
- (if formatter
- (funcall formatter entry)
- (let (dlines time escape name tmp
- v-h v-t v-T v-u v-U v-a)
- (setq dlines (org-split-string (or (plist-get entry :description) "???")
- "\n")
- v-h (or (plist-get entry :title) (car dlines) "???")
- time (or (if (plist-get entry :pubDate)
- (org-read-date t t (plist-get entry :pubDate)))
- (current-time))
- v-t (format-time-string (org-time-stamp-format nil nil) time)
- v-T (format-time-string (org-time-stamp-format t nil) time)
- v-u (format-time-string (org-time-stamp-format nil t) time)
- v-U (format-time-string (org-time-stamp-format t t) time)
- v-a (if (setq tmp (or (and (plist-get entry :guid-permalink)
- (plist-get entry :guid))
- (plist-get entry :link)))
- (concat "[[" tmp "]]\n")
- ""))
+ (if formatter (funcall formatter entry)
+ (let* ((dlines
+ (org-split-string (or (plist-get entry :description) "???")
+ "\n"))
+ (time (or (if (plist-get entry :pubDate)
+ (org-read-date t t (plist-get entry :pubDate)))
+ (current-time)))
+ (v-h (or (plist-get entry :title) (car dlines) "???"))
+ (v-t (format-time-string (org-time-stamp-format nil nil) time))
+ (v-T (format-time-string (org-time-stamp-format t nil) time))
+ (v-u (format-time-string (org-time-stamp-format nil t) time))
+ (v-U (format-time-string (org-time-stamp-format t t) time))
+ (v-a (let ((tmp (or (and (plist-get entry :guid-permalink)
+ (plist-get entry :guid))
+ (plist-get entry :link))))
+ (if tmp (format "[[%s]]\n" tmp ) ""))))
(with-temp-buffer
- (insert template)
-
- ;; Simple %-escapes
- ;; before embedded elisp to support simple %-escapes as
- ;; arguments for embedded elisp
- (goto-char (point-min))
- (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
- (unless (org-capture-escaped-%)
- (setq name (match-string 1)
- escape (org-capture-inside-embedded-elisp-p))
- (cond
- ((member name '("h" "t" "T" "u" "U" "a"))
- (setq tmp (symbol-value (intern (concat "v-" name)))))
- ((setq tmp (plist-get entry (intern (concat ":" name))))
- (save-excursion
- (save-match-data
- (beginning-of-line 1)
- (when (looking-at
- (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
- (setq tmp (org-feed-make-indented-block
- tmp (org-get-indentation))))))))
- (when tmp
- ;; escape string delimiters `"' when inside %() embedded lisp
- (when escape
- (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp)))
- (replace-match tmp t t))))
-
- ;; %() embedded elisp
- (org-capture-expand-embedded-elisp)
-
- (decode-coding-string
- (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
+ (insert template)
+ (goto-char (point-min))
+
+ ;; Mark %() embedded elisp for later evaluation.
+ (org-capture-expand-embedded-elisp 'mark)
+
+ ;; Simple %-escapes. `org-capture-escaped-%' may modify
+ ;; buffer and cripple match-data. Use markers instead.
+ (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
+ (let ((key (match-string 1))
+ (beg (copy-marker (match-beginning 0)))
+ (end (copy-marker (match-end 0))))
+ (unless (org-capture-escaped-%)
+ (delete-region beg end)
+ (set-marker beg nil)
+ (set-marker end nil)
+ (let ((replacement
+ (pcase key
+ ("h" v-h)
+ ("t" v-t)
+ ("T" v-T)
+ ("u" v-u)
+ ("U" v-U)
+ ("a" v-a)
+ (name
+ (let ((v (plist-get entry (intern (concat ":" name)))))
+ (save-excursion
+ (save-match-data
+ (beginning-of-line)
+ (if (looking-at
+ (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
+ (org-feed-make-indented-block
+ v (org-get-indentation))
+ v))))))))
+ (when replacement
+ (insert
+ ;; Escape string delimiters within embedded lisp.
+ (if (org-capture-inside-embedded-elisp-p)
+ (replace-regexp-in-string "\"" "\\\\\"" replacement)
+ replacement)))))))
+
+ ;; %() embedded elisp
+ (org-capture-expand-embedded-elisp)
+
+ (decode-coding-string
+ (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
(defun org-feed-make-indented-block (s n)
"Add indentation of N spaces to a multiline string S."
(if (not (string-match "\n" s))
s
(mapconcat 'identity
- (org-split-string s "\n")
- (concat "\n" (make-string n ?\ )))))
+ (org-split-string s "\n")
+ (concat "\n" (make-string n ?\ )))))
(defun org-feed-skip-http-headers (buffer)
"Remove HTTP headers from BUFFER, and return it.
@@ -605,6 +613,7 @@ Assumes headers are indeed present!"
"Parse BUFFER for RSS feed entries.
Returns a list of entries, with each entry a property list,
containing the properties `:guid' and `:item-full-text'."
+ (require 'xml)
(let ((case-fold-search t)
entries beg end item guid entry)
(with-current-buffer buffer
@@ -615,8 +624,8 @@ containing the properties `:guid' and `:item-full-text'."
end (and (re-search-forward "</item>" nil t)
(match-beginning 0)))
(setq item (buffer-substring beg end)
- guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item)
- (org-match-string-no-properties 1 item)))
+ guid (if (string-match "<guid\\>.*?>\\([^\000]*?\\)</guid>" item)
+ (xml-substitute-special (match-string-no-properties 1 item))))
(setq entry (list :guid guid :item-full-text item))
(push entry entries)
(widen)
diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el
index 553f1240425..e039ab78509 100644
--- a/lisp/org/org-footnote.el
+++ b/lisp/org/org-footnote.el
@@ -1,4 +1,4 @@
-;;; org-footnote.el --- Footnote support in Org and elsewhere
+;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;;
@@ -19,77 +19,73 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the code dealing with footnotes in Org-mode.
-;; The code can also be used in arbitrary text modes to provide
-;; footnotes. Compared to Steven L Baur's footnote.el it provides
-;; better support for resuming editing. It is less configurable than
-;; Steve's code, though.
+;; This file contains the code dealing with footnotes in Org mode.
;;; Code:
-(eval-when-compile
- (require 'cl))
+;;;; Declarations
+
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
-(declare-function message-point-in-header-p "message" ())
+(declare-function org-at-comment-p "org" ())
+(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-back-over-empty-lines "org" ())
-(declare-function org-back-to-heading "org" (&optional invisible-ok))
-(declare-function org-combine-plists "org" (&rest plists))
+(declare-function org-edit-footnote-reference "org-src" ())
+(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))
+(declare-function org-element-lineage "org-element" (blob &optional types with-self))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading))
(declare-function org-fill-paragraph "org" (&optional justify))
-(declare-function org-icompleting-read "org" (&rest args))
-(declare-function org-id-uuid "org-id" ())
(declare-function org-in-block-p "org" (names))
-(declare-function org-in-commented-line "org" ())
-(declare-function org-in-indented-comment-line "org" ())
(declare-function org-in-regexp "org" (re &optional nlines visually))
(declare-function org-in-verbatim-emphasis "org" ())
(declare-function org-inside-LaTeX-fragment-p "org" ())
(declare-function org-inside-latex-macro-p "org" ())
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function org-show-context "org" (&optional key))
-(declare-function org-trim "org" (s))
-(declare-function org-skip-whitespace "org" ())
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function outline-next-heading "outline")
-(declare-function org-skip-whitespace "org" ())
-(defvar org-outline-regexp-bol) ; defined in org.el
-(defvar org-odd-levels-only) ; defined in org.el
+(defvar electric-indent-mode)
+(defvar org-blank-before-new-entry) ; defined in org.el
(defvar org-bracket-link-regexp) ; defined in org.el
-(defvar message-cite-prefix-regexp) ; defined in message.el
-(defvar message-signature-separator) ; defined in message.el
+(defvar org-complex-heading-regexp) ; defined in org.el
+(defvar org-odd-levels-only) ; defined in org.el
+(defvar org-outline-regexp) ; defined in org.el
+(defvar org-outline-regexp-bol) ; defined in org.el
+
+
+;;;; Constants
(defconst org-footnote-re
- ;; Only [1]-like footnotes are closed in this regexp, as footnotes
- ;; from other types might contain square brackets (i.e. links) in
- ;; their definition.
- ;;
- ;; `org-re' is used for regexp compatibility with XEmacs.
- (concat "\\[\\(?:"
- ;; Match inline footnotes.
- (org-re "fn:\\([-_[:word:]]+\\)?:\\|")
- ;; Match other footnotes.
- "\\(?:\\([0-9]+\\)\\]\\)\\|"
- (org-re "\\(fn:[-_[:word:]]+\\)")
- "\\)")
- "Regular expression for matching footnotes.")
-
-(defconst org-footnote-definition-re
- (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]")
- "Regular expression matching the definition of a footnote.")
-
-(defconst org-footnote-forbidden-blocks
- '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src")
+ "\\[fn:\\(?:\\(?1:[-_[:word:]]+\\)?\\(:\\)\\|\\(?1:[-_[:word:]]+\\)\\]\\)"
+ "Regular expression for matching footnotes.
+Match group 1 contains footnote's label. It is nil for anonymous
+footnotes. Match group 2 is non-nil only when footnote is
+inline, i.e., it contains its own definition.")
+
+(defconst org-footnote-definition-re "^\\[fn:\\([-_[:word:]]+\\)\\]"
+ "Regular expression matching the definition of a footnote.
+Match group 1 contains definition's label.")
+
+(defconst org-footnote-forbidden-blocks '("comment" "example" "export" "src")
"Names of blocks where footnotes are not allowed.")
+
+;;;; Customization
+
(defgroup org-footnote nil
- "Footnotes in Org-mode."
+ "Footnotes in Org mode."
:tag "Org Footnote"
:group 'org)
@@ -106,25 +102,21 @@ the notes. However, by hand you may place definitions
*anywhere*.
If this is a string, during export, all subtrees starting with
-this heading will be ignored."
- :group 'org-footnote
- :type '(choice
- (string :tag "Collect footnotes under heading")
- (const :tag "Define footnotes locally" nil)))
+this heading will be ignored.
-(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:"
- "Tag marking the beginning of footnote section.
-The Org footnote engine can be used in arbitrary text files as well
-as in Org-mode. Outside Org mode, new footnotes are always placed at
-the end of the file. When you normalize the notes, any line containing
-only this tag will be removed, a new one will be inserted at the end
-of the file, followed by the collected and normalized footnotes.
+If you don't use the customize interface to change this variable,
+you will need to run the following command after the change:
-If you don't want any tag in such buffers, set this variable to nil."
+ `\\[universal-argument] \\[org-element-cache-reset]'"
:group 'org-footnote
+ :initialize 'custom-initialize-default
+ :set (lambda (var val)
+ (set var val)
+ (when (fboundp 'org-element-cache-reset)
+ (org-element-cache-reset 'all)))
:type '(choice
- (string :tag "Collect footnotes under tag")
- (const :tag "Don't use a tag" nil)))
+ (string :tag "Collect footnotes under heading")
+ (const :tag "Define footnotes locally" nil)))
(defcustom org-footnote-define-inline nil
"Non-nil means define footnotes inline, at reference location.
@@ -143,15 +135,13 @@ t Create unique labels of the form [fn:1], [fn:2], etc.
confirm Like t, but let the user edit the created value.
The label can be removed from the minibuffer to create
an anonymous footnote.
-random Automatically generate a unique, random label.
-plain Automatically create plain number labels like [1]."
+random Automatically generate a unique, random label."
:group 'org-footnote
:type '(choice
(const :tag "Prompt for label" nil)
(const :tag "Create automatic [fn:N]" t)
(const :tag "Offer automatic [fn:N] for editing" confirm)
- (const :tag "Create a random label" random)
- (const :tag "Create automatic [N]" plain)))
+ (const :tag "Create a random label" random)))
(defcustom org-footnote-auto-adjust nil
"Non-nil means automatically adjust footnotes after insert/delete.
@@ -179,23 +169,19 @@ extracted will be filled again."
:group 'org-footnote
:type 'boolean)
+
+;;;; Predicates
+
(defun org-footnote-in-valid-context-p ()
"Is point in a context where footnotes are allowed?"
(save-match-data
- (not (or (org-in-commented-line)
- (org-in-indented-comment-line)
+ (not (or (org-at-comment-p)
(org-inside-LaTeX-fragment-p)
;; Avoid literal example.
(org-in-verbatim-emphasis)
(save-excursion
(beginning-of-line)
(looking-at "[ \t]*:[ \t]+"))
- ;; Avoid cited text and headers in message-mode.
- (and (derived-mode-p 'message-mode)
- (or (save-excursion
- (beginning-of-line)
- (looking-at message-cite-prefix-regexp))
- (message-point-in-header-p)))
;; Avoid forbidden blocks.
(org-in-block-p org-footnote-forbidden-blocks)))))
@@ -208,13 +194,9 @@ positions, and the definition, when inlined."
(or (looking-at org-footnote-re)
(org-in-regexp org-footnote-re)
(save-excursion (re-search-backward org-footnote-re nil t)))
- (/= (match-beginning 0) (point-at-bol)))
+ (/= (match-beginning 0) (line-beginning-position)))
(let* ((beg (match-beginning 0))
- (label (or (org-match-string-no-properties 2)
- (org-match-string-no-properties 3)
- ;; Anonymous footnotes don't have labels
- (and (match-string 1)
- (concat "fn:" (org-match-string-no-properties 1)))))
+ (label (match-string-no-properties 1))
;; Inline footnotes don't end at (match-end 0) as
;; `org-footnote-re' stops just after the second colon.
;; Find the real ending with `scan-sexps', so Org doesn't
@@ -222,7 +204,8 @@ positions, and the definition, when inlined."
(end (ignore-errors (scan-sexps beg 1))))
;; Point is really at a reference if it's located before true
;; ending of the footnote.
- (when (and end (< (point) end)
+ (when (and end
+ (< (point) end)
;; Verify match isn't a part of a link.
(not (save-excursion
(goto-char beg)
@@ -234,16 +217,17 @@ positions, and the definition, when inlined."
(not (org-inside-latex-macro-p)))
(list label beg end
;; Definition: ensure this is an inline footnote first.
- (and (or (not label) (match-string 1))
- (org-trim (buffer-substring-no-properties
- (match-end 0) (1- end)))))))))
+ (and (match-end 2)
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (1- end)))))))))
(defun org-footnote-at-definition-p ()
"Is point within a footnote definition?
This matches only pure definitions like [1] or [fn:name] at the
beginning of a line. It does not match references like
-[fn:name:definition], where the footnote text is included and
+\[fn:name:definition], where the footnote text is included and
defined locally.
The return value will be nil if not at a footnote definition, and
@@ -259,26 +243,224 @@ otherwise."
(concat org-outline-regexp-bol
"\\|^\\([ \t]*\n\\)\\{2,\\}") nil t))))
(when (re-search-backward org-footnote-definition-re lim t)
- (let ((label (org-match-string-no-properties 1))
+ (let ((label (match-string-no-properties 1))
(beg (match-beginning 0))
(beg-def (match-end 0))
- ;; In message-mode, do not search after signature.
- (end (let ((bound (and (derived-mode-p 'message-mode)
- (save-excursion
- (goto-char (point-max))
- (re-search-backward
- message-signature-separator nil t)))))
- (if (progn
- (end-of-line)
- (re-search-forward
- (concat org-outline-regexp-bol "\\|"
- org-footnote-definition-re "\\|"
- "^\\([ \t]*\n\\)\\{2,\\}") bound 'move))
- (match-beginning 0)
- (point)))))
+ (end (if (progn
+ (end-of-line)
+ (re-search-forward
+ (concat org-outline-regexp-bol "\\|"
+ org-footnote-definition-re "\\|"
+ "^\\([ \t]*\n\\)\\{2,\\}") nil 'move))
+ (match-beginning 0)
+ (point))))
(list label beg end
(org-trim (buffer-substring-no-properties beg-def end)))))))))
+
+;;;; Internal functions
+
+(defun org-footnote--allow-reference-p ()
+ "Non-nil when a footnote reference can be inserted at point."
+ ;; XXX: This is similar to `org-footnote-in-valid-context-p' but
+ ;; more accurate and usually faster, except in some corner cases.
+ ;; It may replace it after doing proper benchmarks as it would be
+ ;; used in fontification.
+ (unless (bolp)
+ (let* ((context (org-element-context))
+ (type (org-element-type context)))
+ (cond
+ ;; No footnote reference in attributes.
+ ((let ((post (org-element-property :post-affiliated context)))
+ (and post (< (point) post)))
+ nil)
+ ;; Paragraphs and blank lines at top of document are fine.
+ ((memq type '(nil paragraph)))
+ ;; So are contents of verse blocks.
+ ((eq type 'verse-block)
+ (and (>= (point) (org-element-property :contents-begin context))
+ (< (point) (org-element-property :contents-end context))))
+ ;; In an headline or inlinetask, point must be either on the
+ ;; heading itself or on the blank lines below.
+ ((memq type '(headline inlinetask))
+ (or (not (org-at-heading-p))
+ (and (save-excursion
+ (beginning-of-line)
+ (and (let ((case-fold-search t))
+ (not (looking-at-p "\\*+ END[ \t]*$")))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
+ (match-beginning 4)
+ (>= (point) (match-beginning 4))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5))))))
+ ;; White spaces after an object or blank lines after an element
+ ;; are OK.
+ ((>= (point)
+ (save-excursion (goto-char (org-element-property :end context))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class context) 'object) (point)
+ (1+ (line-beginning-position 2))))))
+ ;; Other elements are invalid.
+ ((eq (org-element-class context) 'element) nil)
+ ;; Just before object is fine.
+ ((= (point) (org-element-property :begin context)))
+ ;; Within recursive object too, but not in a link.
+ ((eq type 'link) nil)
+ ((let ((cbeg (org-element-property :contents-begin context))
+ (cend (org-element-property :contents-end context)))
+ (and cbeg (>= (point) cbeg) (<= (point) cend))))))))
+
+(defun org-footnote--clear-footnote-section ()
+ "Remove all footnote sections in buffer and create a new one.
+New section is created at the end of the buffer, before any file
+local variable definition. Leave point within the new section."
+ (when org-footnote-section
+ (goto-char (point-min))
+ (let ((regexp
+ (format "^\\*+ +%s[ \t]*$"
+ (regexp-quote org-footnote-section))))
+ (while (re-search-forward regexp nil t)
+ (delete-region
+ (match-beginning 0)
+ (progn (org-end-of-subtree t t)
+ (if (not (eobp)) (point)
+ (org-footnote--goto-local-insertion-point)
+ (skip-chars-forward " \t\n")
+ (if (eobp) (point) (line-beginning-position)))))))
+ (goto-char (point-max))
+ (org-footnote--goto-local-insertion-point)
+ (when (and (cdr (assq 'heading org-blank-before-new-entry))
+ (zerop (save-excursion (org-back-over-empty-lines))))
+ (insert "\n"))
+ (insert "* " org-footnote-section "\n")))
+
+(defun org-footnote--set-label (label)
+ "Set label of footnote at point to string LABEL.
+Assume point is at the beginning of the reference or definition
+to rename."
+ (forward-char 4)
+ (cond ((eq (char-after) ?:) (insert label))
+ ((looking-at "\\([-_[:word:]]+\\)") (replace-match label nil nil nil 1))
+ (t nil)))
+
+(defun org-footnote--collect-references (&optional anonymous)
+ "Collect all labeled footnote references in current buffer.
+
+Return an alist where associations follow the pattern
+
+ (LABEL MARKER TOP-LEVEL SIZE)
+
+with
+
+ LABEL the label of the of the definition,
+ MARKER a marker pointing to its beginning,
+ TOP-LEVEL a boolean, nil when the footnote is contained within
+ another one,
+ SIZE the length of the inline definition, in characters,
+ or nil for non-inline references.
+
+When optional ANONYMOUS is non-nil, also collect anonymous
+references. In such cases, LABEL is nil.
+
+References are sorted according to a deep-reading order."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((regexp (if anonymous org-footnote-re "\\[fn:[-_[:word:]]+[]:]"))
+ references nested)
+ (save-excursion
+ (while (re-search-forward regexp nil t)
+ ;; Ignore definitions.
+ (unless (and (eq (char-before) ?\])
+ (= (line-beginning-position) (match-beginning 0)))
+ ;; Ensure point is within the reference before parsing it.
+ (backward-char)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'footnote-reference)
+ (let* ((label (org-element-property :label object))
+ (begin (org-element-property :begin object))
+ (size
+ (and (eq (org-element-property :type object) 'inline)
+ (- (org-element-property :contents-end object)
+ (org-element-property :contents-begin object)))))
+ (let ((d (org-element-lineage object '(footnote-definition))))
+ (push (list label (copy-marker begin) (not d) size)
+ references)
+ (when d
+ ;; Nested references are stored in alist NESTED.
+ ;; Associations there follow the pattern
+ ;;
+ ;; (DEFINITION-LABEL . REFERENCES)
+ (let* ((def-label (org-element-property :label d))
+ (labels (assoc def-label nested)))
+ (if labels (push label (cdr labels))
+ (push (list def-label label) nested)))))))))))
+ ;; Sort the list of references. Nested footnotes have priority
+ ;; over top-level ones.
+ (letrec ((ordered nil)
+ (add-reference
+ (lambda (ref allow-nested)
+ (when (or allow-nested (nth 2 ref))
+ (push ref ordered)
+ (dolist (r (mapcar (lambda (l) (assoc l references))
+ (reverse
+ (cdr (assoc (nth 0 ref) nested)))))
+ (funcall add-reference r t))))))
+ (dolist (r (reverse references) (nreverse ordered))
+ (funcall add-reference r nil))))))
+
+(defun org-footnote--collect-definitions (&optional delete)
+ "Collect all footnote definitions in current buffer.
+
+Return an alist where associations follow the pattern
+
+ (LABEL . DEFINITION)
+
+with LABEL and DEFINITION being, respectively, the label and the
+definition of the footnote, as strings.
+
+When optional argument DELETE is non-nil, delete the definition
+while collecting them."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (definitions seen)
+ (while (re-search-forward org-footnote-definition-re nil t)
+ (backward-char)
+ (let ((element (org-element-at-point)))
+ (let ((label (org-element-property :label element)))
+ (when (and (eq (org-element-type element) 'footnote-definition)
+ (not (member label seen)))
+ (push label seen)
+ (let* ((beg (progn
+ (goto-char (org-element-property :begin element))
+ (skip-chars-backward " \r\t\n")
+ (if (bobp) (point) (line-beginning-position 2))))
+ (end (progn
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ (def (org-trim (buffer-substring-no-properties beg end))))
+ (push (cons label def) definitions)
+ (when delete (delete-region beg end)))))))
+ definitions)))
+
+(defun org-footnote--goto-local-insertion-point ()
+ "Find insertion point for footnote, just before next outline heading.
+Assume insertion point is within currently accessible part of the buffer."
+ (org-with-limited-levels (outline-next-heading))
+ ;; Skip file local variables. See `modify-file-local-variable'.
+ (when (eobp)
+ (let ((case-fold-search t))
+ (re-search-backward "^[ \t]*# +Local Variables:"
+ (max (- (point-max) 3000) (point-min))
+ t)))
+ (skip-chars-backward " \t\n")
+ (forward-line)
+ (unless (bolp) (insert "\n")))
+
+
+;;;; Navigation
+
(defun org-footnote-get-next-reference (&optional label backward limit)
"Return complete reference of the next footnote.
@@ -289,7 +471,7 @@ the buffer position bounding the search.
Return value is a list like those provided by `org-footnote-at-reference-p'.
If no footnote is found, return nil."
(save-excursion
- (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re)))
+ (let* ((label-fmt (if label (format "\\[fn:%s[]:]" label) org-footnote-re)))
(catch 'exit
(while t
(unless (funcall (if backward #'re-search-backward #'re-search-forward)
@@ -313,59 +495,54 @@ If no footnote is found, return nil."
(unless (re-search-forward org-footnote-re limit t)
(goto-char origin)
(throw 'exit nil))
- ;; Beware: with [1]-like footnotes point will be just after
+ ;; Beware: with non-inline footnotes point will be just after
;; the closing square bracket.
(backward-char)
(cond
((setq ref (org-footnote-at-reference-p))
(throw 'exit ref))
- ;; Definition: also grab the last square bracket, only
- ;; matched in `org-footnote-re' for [1]-like footnotes.
+ ;; Definition: also grab the last square bracket, matched in
+ ;; `org-footnote-re' for non-inline footnotes.
((save-match-data (org-footnote-at-definition-p))
(let ((end (match-end 0)))
(throw 'exit
(list nil (match-beginning 0)
- (if (eq (char-before end) 93) end (1+ end)))))))))))
+ (if (eq (char-before end) ?\]) end (1+ end)))))))))))
-(defun org-footnote-get-definition (label)
- "Return label, boundaries and definition of the footnote LABEL."
- (let* ((label (regexp-quote (org-footnote-normalize-label label)))
- (re (format "^\\[%s\\]\\|.\\[%s:" label label))
- pos)
- (save-excursion
- (save-restriction
- (when (or (re-search-forward re nil t)
- (and (goto-char (point-min))
- (re-search-forward re nil t))
- (and (progn (widen) t)
- (goto-char (point-min))
- (re-search-forward re nil t)))
- (let ((refp (org-footnote-at-reference-p)))
- (cond
- ((and (nth 3 refp) refp))
- ((org-footnote-at-definition-p)))))))))
-
-(defun org-footnote-goto-definition (label)
+(defun org-footnote-goto-definition (label &optional location)
"Move point to the definition of the footnote LABEL.
-Return a non-nil value when a definition has been found."
+
+LOCATION, when non-nil specifies the buffer position of the
+definition.
+
+Throw an error if there is no definition or if it cannot be
+reached from current narrowed part of buffer. Return a non-nil
+value if point was successfully moved."
(interactive "sLabel: ")
- (org-mark-ring-push)
- (let ((def (org-footnote-get-definition label)))
- (if (not def)
- (error "Cannot find definition of footnote %s" label)
- (goto-char (nth 1 def))
- (looking-at (format "\\[%s\\]\\|\\[%s:" label label))
- (goto-char (match-end 0))
- (org-show-context 'link-search)
- (when (derived-mode-p 'org-mode)
- (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))
- t)))
+ (let* ((label (org-footnote-normalize-label label))
+ (def-start (or location (nth 1 (org-footnote-get-definition label)))))
+ (cond
+ ((not def-start)
+ (user-error "Cannot find definition of footnote %s" label))
+ ((or (> def-start (point-max)) (< def-start (point-min)))
+ (user-error "Definition is outside narrowed part of buffer")))
+ (org-mark-ring-push)
+ (goto-char def-start)
+ (looking-at (format "\\[fn:%s[]:] ?" (regexp-quote label)))
+ (goto-char (match-end 0))
+ (org-show-context 'link-search)
+ (when (derived-mode-p 'org-mode)
+ (message "%s" (substitute-command-keys
+ "Edit definition and go back with \
+`\\[org-mark-ring-goto]' or, if unique, with `\\[org-ctrl-c-ctrl-c]'.")))
+ t))
(defun org-footnote-goto-previous-reference (label)
"Find the first closest (to point) reference of footnote with label LABEL."
(interactive "sLabel: ")
(org-mark-ring-push)
- (let* ((label (org-footnote-normalize-label label)) ref)
+ (let ((label (org-footnote-normalize-label label))
+ ref)
(save-excursion
(setq ref (or (org-footnote-get-next-reference label t)
(org-footnote-get-next-reference label)
@@ -379,62 +556,74 @@ Return a non-nil value when a definition has been found."
(goto-char (nth 1 ref))
(org-show-context 'link-search))))
+
+;;;; Getters
+
(defun org-footnote-normalize-label (label)
- "Return LABEL as an appropriate string."
- (cond
- ((numberp label) (number-to-string label))
- ((equal "" label) nil)
- ((not (string-match "^[0-9]+$\\|^fn:" label))
- (concat "fn:" label))
- (t label)))
-
-(defun org-footnote-all-labels (&optional with-defs)
- "Return list with all defined foot labels used in the buffer.
-
-If WITH-DEFS is non-nil, also associate the definition to each
-label. The function will then return an alist whose key is label
-and value definition."
- (let* (rtn
- (push-to-rtn
- (function
- ;; Depending on WITH-DEFS, store label or (label . def) of
- ;; footnote reference/definition given as argument in RTN.
- (lambda (el)
- (let ((lbl (car el)))
- (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn))))))
- (save-excursion
- (save-restriction
- (widen)
- ;; Find all labels found in definitions.
- (goto-char (point-min))
- (let (def)
- (while (re-search-forward org-footnote-definition-re nil t)
- (when (setq def (org-footnote-at-definition-p))
- (funcall push-to-rtn def))))
- ;; Find all labels found in references.
- (goto-char (point-min))
- (let (ref)
- (while (setq ref (org-footnote-get-next-reference))
- (goto-char (nth 2 ref))
- (and (car ref) ; ignore anonymous footnotes
- (not (funcall (if with-defs #'assoc #'member) (car ref) rtn))
- (funcall push-to-rtn ref))))))
- rtn))
+ "Return LABEL without \"fn:\" prefix.
+If LABEL is the empty string or constituted of white spaces only,
+return nil instead."
+ (pcase (org-trim label)
+ ("" nil)
+ ((pred (string-prefix-p "fn:")) (substring label 3))
+ (_ label)))
+
+(defun org-footnote-get-definition (label)
+ "Return label, boundaries and definition of the footnote LABEL."
+ (let* ((label (regexp-quote (org-footnote-normalize-label label)))
+ (re (format "^\\[fn:%s\\]\\|.\\[fn:%s:" label label)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (catch 'found
+ (while (re-search-forward re nil t)
+ (let* ((datum (progn (backward-char) (org-element-context)))
+ (type (org-element-type datum)))
+ (when (memq type '(footnote-definition footnote-reference))
+ (throw 'found
+ (list
+ label
+ (org-element-property :begin datum)
+ (org-element-property :end datum)
+ (let ((cbeg (org-element-property :contents-begin datum)))
+ (if (not cbeg) ""
+ (replace-regexp-in-string
+ "[ \t\n]*\\'"
+ ""
+ (buffer-substring-no-properties
+ cbeg
+ (org-element-property :contents-end datum))))))))))
+ nil))))
+
+(defun org-footnote-all-labels ()
+ "List all defined footnote labels used throughout the buffer.
+This function ignores narrowing, if any."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (all)
+ (while (re-search-forward org-footnote-re nil t)
+ (backward-char)
+ (let ((context (org-element-context)))
+ (when (memq (org-element-type context)
+ '(footnote-definition footnote-reference))
+ (let ((label (org-element-property :label context)))
+ (when label (cl-pushnew label all :test #'equal))))))
+ all)))
(defun org-footnote-unique-label (&optional current)
"Return a new unique footnote label.
-The function returns the first \"fn:N\" or \"N\" label that is
-currently not used.
+The function returns the first numeric label currently unused.
Optional argument CURRENT is the list of labels active in the
buffer."
- (unless current (setq current (org-footnote-all-labels)))
- (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d"))
- (cnt 1))
- (while (member (format fmt cnt) current)
- (incf cnt))
- (format fmt cnt)))
+ (let ((current (or current (org-footnote-all-labels))))
+ (let ((count 1))
+ (while (member (number-to-string count) current)
+ (cl-incf count))
+ (number-to-string count))))
+
+
+;;;; Adding, Deleting Footnotes
(defun org-footnote-new ()
"Insert a new footnote.
@@ -442,343 +631,66 @@ This command prompts for a label. If this is a label referencing an
existing label, only insert the label. If the footnote label is empty
or new, let the user edit the definition of the footnote."
(interactive)
- (unless (org-footnote-in-valid-context-p)
- (error "Cannot insert a footnote here"))
- (let* ((lbls (and (not (equal org-footnote-auto-label 'random))
- (org-footnote-all-labels)))
- (propose (and (not (equal org-footnote-auto-label 'random))
- (org-footnote-unique-label lbls)))
+ (unless (org-footnote--allow-reference-p)
+ (user-error "Cannot insert a footnote here"))
+ (let* ((all (org-footnote-all-labels))
(label
- (org-footnote-normalize-label
- (cond
- ((member org-footnote-auto-label '(t plain))
- propose)
- ((equal org-footnote-auto-label 'random)
- (require 'org-id)
- (substring (org-id-uuid) 0 8))
- (t
- (org-icompleting-read
- "Label (leave empty for anonymous): "
- (mapcar 'list lbls) nil nil
- (if (eq org-footnote-auto-label 'confirm) propose nil)))))))
- (cond
- ((bolp) (error "Cannot create a footnote reference at left margin"))
- ((not label)
- (insert "[fn:: ]")
- (backward-char 1))
- ((member label lbls)
- (insert "[" label "]")
- (message "New reference to existing note"))
- (org-footnote-define-inline
- (insert "[" label ": ]")
- (backward-char 1)
- (org-footnote-auto-adjust-maybe))
- (t
- (insert "[" label "]")
- (org-footnote-create-definition label)
- (org-footnote-auto-adjust-maybe)))))
-
-(defvar org-blank-before-new-entry) ; silence byte-compiler
+ (if (eq org-footnote-auto-label 'random)
+ (format "%x" (random most-positive-fixnum))
+ (org-footnote-normalize-label
+ (let ((propose (org-footnote-unique-label all)))
+ (if (eq org-footnote-auto-label t) propose
+ (completing-read
+ "Label (leave empty for anonymous): "
+ (mapcar #'list all) nil nil
+ (and (eq org-footnote-auto-label 'confirm) propose))))))))
+ (cond ((not label)
+ (insert "[fn::]")
+ (backward-char 1))
+ ((member label all)
+ (insert "[fn:" label "]")
+ (message "New reference to existing note"))
+ (org-footnote-define-inline
+ (insert "[fn:" label ":]")
+ (backward-char 1)
+ (org-footnote-auto-adjust-maybe))
+ (t
+ (insert "[fn:" label "]")
+ (let ((p (org-footnote-create-definition label)))
+ ;; `org-footnote-goto-definition' needs to be called
+ ;; after `org-footnote-auto-adjust-maybe'. Otherwise
+ ;; both label and location of the definition are lost.
+ ;; On the contrary, it needs to be called before
+ ;; `org-edit-footnote-reference' so that the remote
+ ;; editing buffer can display the correct label.
+ (if (ignore-errors (org-footnote-goto-definition label p))
+ (org-footnote-auto-adjust-maybe)
+ ;; Definition was created outside current scope: edit
+ ;; it remotely.
+ (org-footnote-auto-adjust-maybe)
+ (org-edit-footnote-reference)))))))
+
(defun org-footnote-create-definition (label)
- "Start the definition of a footnote with label LABEL."
- (interactive "sLabel: ")
+ "Start the definition of a footnote with label LABEL.
+Return buffer position at the beginning of the definition. This
+function doesn't move point."
(let ((label (org-footnote-normalize-label label))
- electric-indent-mode) ;; Prevent wrong indentation
- (cond
- ;; In an Org file.
- ((derived-mode-p 'org-mode)
- ;; If `org-footnote-section' is defined, find it, or create it
- ;; at the end of the buffer.
- (when org-footnote-section
- (goto-char (point-min))
- (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$")))
- (unless (or (re-search-forward re nil t)
- (and (progn (widen) t)
- (re-search-forward re nil t)))
- (goto-char (point-max))
- (skip-chars-backward " \t\r\n")
- (unless (bolp) (newline))
- ;; Insert new section. Separate it from the previous one
- ;; with a blank line, unless `org-blank-before-new-entry'
- ;; explicitly says no.
- (when (and (cdr (assq 'heading org-blank-before-new-entry))
- (zerop (save-excursion (org-back-over-empty-lines))))
- (insert "\n"))
- (insert "* " org-footnote-section "\n"))))
- ;; Move to the end of this entry (which may be
- ;; `org-footnote-section' or the current one).
- (org-footnote-goto-local-insertion-point)
- (org-show-context 'link-search))
- (t
- ;; In a non-Org file. Search for footnote tag, or create it if
- ;; specified (at the end of buffer, or before signature if in
- ;; Message mode). Set point after any definition already there.
- (let ((tag (and org-footnote-tag-for-non-org-mode-files
- (concat "^" (regexp-quote
- org-footnote-tag-for-non-org-mode-files)
- "[ \t]*$")))
- (max (if (and (derived-mode-p 'message-mode)
- (goto-char (point-max))
- (re-search-backward
- message-signature-separator nil t))
- (progn
- ;; Ensure one blank line separates last
- ;; footnote from signature.
- (beginning-of-line)
- (open-line 2)
- (point-marker))
- (point-max-marker))))
- (set-marker-insertion-type max t)
- (goto-char max)
- ;; Check if the footnote tag is defined but missing. In this
- ;; case, insert it, before any footnote or one blank line
- ;; after any previous text.
- (when (and tag (not (re-search-backward tag nil t)))
- (skip-chars-backward " \t\r\n")
- (while (re-search-backward org-footnote-definition-re nil t))
- (unless (bolp) (newline 2))
- (insert org-footnote-tag-for-non-org-mode-files "\n\n"))
- ;; Remove superfluous white space and clear marker.
- (goto-char max)
- (skip-chars-backward " \t\r\n")
- (delete-region (point) max)
- (unless (bolp) (newline))
- (set-marker max nil))))
- ;; Insert footnote label.
- (when (zerop (org-back-over-empty-lines)) (newline))
- (insert "[" label "] \n")
- (backward-char)
- ;; Only notify user about next possible action when in an Org
- ;; buffer, as the bindings may have different meanings otherwise.
- (when (derived-mode-p 'org-mode)
- (message
- "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'."))))
-
-;;;###autoload
-(defun org-footnote-action (&optional special)
- "Do the right thing for footnotes.
-
-When at a footnote reference, jump to the definition.
-
-When at a definition, jump to the references if they exist, offer
-to create them otherwise.
-
-When neither at definition or reference, create a new footnote,
-interactively.
-
-With prefix arg SPECIAL, offer additional commands in a menu."
- (interactive "P")
- (let (tmp c)
- (cond
- (special
- (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete")
- (setq c (read-char-exclusive))
- (cond
- ((eq c ?s) (org-footnote-normalize 'sort))
- ((eq c ?r) (org-footnote-renumber-fn:N))
- ((eq c ?S)
- (org-footnote-renumber-fn:N)
- (org-footnote-normalize 'sort))
- ((eq c ?n) (org-footnote-normalize))
- ((eq c ?d) (org-footnote-delete))
- (t (error "No such footnote command %c" c))))
- ((setq tmp (org-footnote-at-reference-p))
- (cond
- ;; Anonymous footnote: move point at the beginning of its
- ;; definition.
- ((not (car tmp))
- (goto-char (nth 1 tmp))
- (forward-char 5))
- ;; A definition exists: move to it.
- ((ignore-errors (org-footnote-goto-definition (car tmp))))
- ;; No definition exists: offer to create it.
- ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp)))
- (org-footnote-create-definition (car tmp)))))
- ((setq tmp (org-footnote-at-definition-p))
- (org-footnote-goto-previous-reference (car tmp)))
- (t (org-footnote-new)))))
-
-;;;###autoload
-(defun org-footnote-normalize (&optional sort-only)
- "Collect the footnotes in various formats and normalize them.
-
-This finds the different sorts of footnotes allowed in Org, and
-normalizes them to the usual [N] format.
-
-When SORT-ONLY is set, only sort the footnote definitions into the
-referenced sequence."
- ;; This is based on Paul's function, but rewritten.
- ;;
- ;; Re-create `org-with-limited-levels', but not limited to Org
- ;; buffers.
- (let* ((limit-level
- (and (boundp 'org-inlinetask-min-level)
- org-inlinetask-min-level
- (1- org-inlinetask-min-level)))
- (nstars (and limit-level
- (if org-odd-levels-only (1- (* limit-level 2))
- limit-level)))
- (org-outline-regexp
- (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))
- (count 0)
- ins-point ref ref-table)
- (save-excursion
- ;; 1. Find every footnote reference, extract the definition, and
- ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also
- ;; normalize references.
- (goto-char (point-min))
- (while (setq ref (org-footnote-get-next-reference))
- (let* ((lbl (car ref))
- (pos (nth 1 ref))
- ;; When footnote isn't anonymous, check if it's label
- ;; (REF) is already stored in REF-TABLE. In that case,
- ;; extract number used to identify it (MARKER). If
- ;; footnote is unknown, increment the global counter
- ;; (COUNT) to create an unused identifier.
- (a (and lbl (assoc lbl ref-table)))
- (marker (or (nth 1 a) (incf count)))
- ;; Is the reference inline or pointing to an inline
- ;; footnote?
- (inlinep (or (stringp (nth 3 ref)) (nth 3 a))))
- ;; Replace footnote reference with [MARKER]. Maybe fill
- ;; paragraph once done. If SORT-ONLY is non-nil, only move
- ;; to the end of reference found to avoid matching it twice.
- (if sort-only (goto-char (nth 2 ref))
- (delete-region (nth 1 ref) (nth 2 ref))
- (goto-char (nth 1 ref))
- (insert (format "[%d]" marker))
- (and inlinep
- org-footnote-fill-after-inline-note-extraction
- (org-fill-paragraph)))
- ;; Add label (REF), identifier (MARKER), definition (DEF)
- ;; type (INLINEP) and position (POS) to REF-TABLE if data
- ;; was unknown.
- (unless a
- (let ((def (or (nth 3 ref) ; Inline definition.
- (nth 3 (org-footnote-get-definition lbl)))))
- (push (list lbl marker def
- ;; Reference beginning position is a marker
- ;; to preserve it during further buffer
- ;; modifications.
- inlinep (copy-marker pos)) ref-table)))))
- ;; 2. Find and remove the footnote section, if any. Also
- ;; determine where footnotes shall be inserted (INS-POINT).
- (cond
- ((and org-footnote-section (derived-mode-p 'org-mode))
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^\\*[ \t]+" (regexp-quote org-footnote-section)
- "[ \t]*$") nil t)
- (delete-region (match-beginning 0) (org-end-of-subtree t t)))
- ;; A new footnote section is inserted by default at the end of
- ;; the buffer.
- (goto-char (point-max))
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (unless (bolp) (newline)))
- ;; No footnote section set: Footnotes will be added at the end
- ;; of the section containing their first reference.
- ((derived-mode-p 'org-mode))
- (t
- ;; Remove any left-over tag in the buffer, if one is set up.
- (when org-footnote-tag-for-non-org-mode-files
- (let ((tag (concat "^" (regexp-quote
- org-footnote-tag-for-non-org-mode-files)
- "[ \t]*$")))
- (goto-char (point-min))
- (while (re-search-forward tag nil t)
- (replace-match "")
- (delete-region (point) (progn (forward-line) (point))))))
- ;; In Message mode, ensure footnotes are inserted before the
- ;; signature.
- (if (and (derived-mode-p 'message-mode)
- (goto-char (point-max))
- (re-search-backward message-signature-separator nil t))
- (beginning-of-line)
- (goto-char (point-max)))))
- (setq ins-point (point-marker))
- ;; 3. Clean-up REF-TABLE.
- (setq ref-table
- (delq nil
- (mapcar
- (lambda (x)
- (cond
- ;; When only sorting, ignore inline footnotes.
- ;; Also clear position marker.
- ((and sort-only (nth 3 x))
- (set-marker (nth 4 x) nil) nil)
- ;; No definition available: provide one.
- ((not (nth 2 x))
- (append
- (list (car x) (nth 1 x)
- (format "DEFINITION NOT FOUND: %s" (car x)))
- (nthcdr 3 x)))
- (t x)))
- ref-table)))
- (setq ref-table (nreverse ref-table))
- ;; 4. Remove left-over definitions in the buffer.
- (mapc (lambda (x)
- (unless (nth 3 x) (org-footnote-delete-definitions (car x))))
- ref-table)
- ;; 5. Insert the footnotes again in the buffer, at the
- ;; appropriate spot.
- (goto-char ins-point)
- (cond
- ;; No footnote: exit.
- ((not ref-table))
- ;; Cases when footnotes should be inserted in one place.
- ((or (not (derived-mode-p 'org-mode)) org-footnote-section)
- ;; Insert again the section title, if any. Ensure that title,
- ;; or the subsequent footnotes, will be separated by a blank
- ;; lines from the rest of the document. In an Org buffer,
- ;; separate section with a blank line, unless explicitly
- ;; stated in `org-blank-before-new-entry'.
- (if (not (derived-mode-p 'org-mode))
- (progn (skip-chars-backward " \t\n\r")
- (delete-region (point) ins-point)
- (unless (bolp) (newline))
- (when org-footnote-tag-for-non-org-mode-files
- (insert "\n" org-footnote-tag-for-non-org-mode-files "\n")))
- (when (and (cdr (assq 'heading org-blank-before-new-entry))
- (zerop (save-excursion (org-back-over-empty-lines))))
- (insert "\n"))
- (insert "* " org-footnote-section "\n"))
- (set-marker ins-point nil)
- ;; Insert the footnotes, separated by a blank line.
- (insert
- (mapconcat
- (lambda (x)
- ;; Clean markers.
- (set-marker (nth 4 x) nil)
- (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x)))
- ref-table "\n"))
- (unless (eobp) (insert "\n\n")))
- ;; Each footnote definition has to be inserted at the end of
- ;; the section where its first reference belongs.
- (t
- (mapc
- (lambda (x)
- (let ((pos (nth 4 x)))
- (goto-char pos)
- ;; Clean marker.
- (set-marker pos nil))
- (org-footnote-goto-local-insertion-point)
- (insert (format "\n[%s] %s\n"
- (if sort-only (car x) (nth 1 x))
- (nth 2 x))))
- ref-table))))))
-
-(defun org-footnote-goto-local-insertion-point ()
- "Find insertion point for footnote, just before next outline heading."
- (org-with-limited-levels (outline-next-heading))
- (or (bolp) (newline))
- (beginning-of-line 0)
- (while (and (not (bobp)) (= (char-after) ?#))
- (beginning-of-line 0))
- (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2))
- (end-of-line 1)
- (skip-chars-backward "\n\r\t ")
- (forward-line))
+ electric-indent-mode) ; Prevent wrong indentation.
+ (org-with-wide-buffer
+ (cond
+ ((not org-footnote-section) (org-footnote--goto-local-insertion-point))
+ ((save-excursion
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$")
+ nil t))
+ (goto-char (match-end 0))
+ (forward-line)
+ (unless (bolp) (insert "\n")))
+ (t (org-footnote--clear-footnote-section)))
+ (when (zerop (org-back-over-empty-lines)) (insert "\n"))
+ (insert "[fn:" label "] \n")
+ (line-beginning-position 0))))
(defun org-footnote-delete-references (label)
"Delete every reference to footnote LABEL.
@@ -789,7 +701,7 @@ Return the number of footnotes removed."
(while (setq ref (org-footnote-get-next-reference label))
(goto-char (nth 1 ref))
(delete-region (nth 1 ref) (nth 2 ref))
- (incf nref))
+ (cl-incf nref))
nref)))
(defun org-footnote-delete-definitions (label)
@@ -797,17 +709,21 @@ Return the number of footnotes removed."
Return the number of footnotes removed."
(save-excursion
(goto-char (point-min))
- (let ((def-re (concat "^\\[" (regexp-quote label) "\\]"))
+ (let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label)))
(ndef 0))
(while (re-search-forward def-re nil t)
- (let ((full-def (org-footnote-at-definition-p)))
- (when full-def
- ;; Remove the footnote, and all blank lines before it.
- (goto-char (nth 1 full-def))
- (skip-chars-backward " \r\t\n")
- (unless (bolp) (forward-line))
- (delete-region (point) (nth 2 full-def))
- (incf ndef))))
+ (pcase (org-footnote-at-definition-p)
+ (`(,_ ,start ,end ,_)
+ ;; Remove the footnote, and all blank lines before it.
+ (delete-region (progn
+ (goto-char start)
+ (skip-chars-backward " \r\t\n")
+ (if (bobp) (point) (line-beginning-position 2)))
+ (progn
+ (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (if (bobp) (point) (line-beginning-position 2))))
+ (cl-incf ndef))))
ndef)))
(defun org-footnote-delete (&optional label)
@@ -843,24 +759,165 @@ If LABEL is non-nil, delete that footnote instead."
(message "%d definition(s) of and %d reference(s) of footnote %s removed"
ndef nref label))))
+
+;;;; Sorting, Renumbering, Normalizing
+
(defun org-footnote-renumber-fn:N ()
- "Renumber the simple footnotes like fn:17 into a sequence in the document."
+ "Order numbered footnotes into a sequence in the document."
(interactive)
- (let (map (n 0))
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t)
- (save-excursion
- (goto-char (match-beginning 0))
- ;; Ensure match is a footnote reference or definition.
- (when (save-match-data (if (bolp)
- (org-footnote-at-definition-p)
- (org-footnote-at-reference-p)))
- (let ((new-val (or (cdr (assoc (match-string 1) map))
- (number-to-string (incf n)))))
- (unless (assoc (match-string 1) map)
- (push (cons (match-string 1) new-val) map))
- (replace-match new-val nil nil nil 1))))))))
+ (let ((references (org-footnote--collect-references)))
+ (unwind-protect
+ (let* ((c 0)
+ (references (cl-remove-if-not
+ (lambda (r) (string-match-p "\\`[0-9]+\\'" (car r)))
+ references))
+ (alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c))))
+ (delete-dups (mapcar #'car references)))))
+ (org-with-wide-buffer
+ ;; Re-number references.
+ (dolist (ref references)
+ (goto-char (nth 1 ref))
+ (org-footnote--set-label (cdr (assoc (nth 0 ref) alist))))
+ ;; Re-number definitions.
+ (goto-char (point-min))
+ (while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t)
+ (replace-match (or (cdr (assoc (match-string 1) alist))
+ ;; Un-referenced definitions get
+ ;; higher numbers.
+ (number-to-string (cl-incf c)))
+ nil nil nil 1))))
+ (dolist (r references) (set-marker (nth 1 r) nil)))))
+
+(defun org-footnote-sort ()
+ "Rearrange footnote definitions in the current buffer.
+Sort footnote definitions so they match order of footnote
+references. Also relocate definitions at the end of their
+relative section or within a single footnote section, according
+to `org-footnote-section'. Inline definitions are ignored."
+ (let ((references (org-footnote--collect-references)))
+ (unwind-protect
+ (let ((definitions (org-footnote--collect-definitions 'delete)))
+ (org-with-wide-buffer
+ (org-footnote--clear-footnote-section)
+ ;; Insert footnote definitions at the appropriate location,
+ ;; separated by a blank line. Each definition is inserted
+ ;; only once throughout the buffer.
+ (let (inserted)
+ (dolist (cell references)
+ (let ((label (car cell))
+ (nested (not (nth 2 cell)))
+ (inline (nth 3 cell)))
+ (unless (or (member label inserted) inline)
+ (push label inserted)
+ (unless (or org-footnote-section nested)
+ ;; If `org-footnote-section' is non-nil, or
+ ;; reference is nested, point is already at the
+ ;; correct position. Otherwise, move at the
+ ;; appropriate location within the section
+ ;; containing the reference.
+ (goto-char (nth 1 cell))
+ (org-footnote--goto-local-insertion-point))
+ (insert "\n"
+ (or (cdr (assoc label definitions))
+ (format "[fn:%s] DEFINITION NOT FOUND." label))
+ "\n"))))
+ ;; Insert un-referenced footnote definitions at the end.
+ (let ((unreferenced
+ (cl-remove-if (lambda (d) (member (car d) inserted))
+ definitions)))
+ (dolist (d unreferenced) (insert "\n" (cdr d) "\n"))))))
+ ;; Clear dangling markers in the buffer.
+ (dolist (r references) (set-marker (nth 1 r) nil)))))
+
+(defun org-footnote-normalize ()
+ "Turn every footnote in buffer into a numbered one."
+ (interactive)
+ (let ((references (org-footnote--collect-references 'anonymous)))
+ (unwind-protect
+ (let ((n 0)
+ (translations nil)
+ (definitions nil))
+ (org-with-wide-buffer
+ ;; Update label for reference. We need to do this before
+ ;; clearing definitions in order to rename nested footnotes
+ ;; before they are deleted.
+ (dolist (cell references)
+ (let* ((label (car cell))
+ (anonymous (not label))
+ (new
+ (cond
+ ;; In order to differentiate anonymous
+ ;; references from regular ones, set their
+ ;; labels to integers, not strings.
+ (anonymous (setcar cell (cl-incf n)))
+ ((cdr (assoc label translations)))
+ (t (let ((l (number-to-string (cl-incf n))))
+ (push (cons label l) translations)
+ l)))))
+ (goto-char (nth 1 cell)) ; Move to reference's start.
+ (org-footnote--set-label
+ (if anonymous (number-to-string new) new))
+ (let ((size (nth 3 cell)))
+ ;; Transform inline footnotes into regular references
+ ;; and retain their definition for later insertion as
+ ;; a regular footnote definition.
+ (when size
+ (let ((def (concat
+ (format "[fn:%s] " new)
+ (org-trim
+ (substring
+ (delete-and-extract-region
+ (point) (+ (point) size 1))
+ 1)))))
+ (push (cons (if anonymous new label) def) definitions)
+ (when org-footnote-fill-after-inline-note-extraction
+ (org-fill-paragraph)))))))
+ ;; Collect definitions. Update labels according to ALIST.
+ (let ((definitions
+ (nconc definitions
+ (org-footnote--collect-definitions 'delete)))
+ (inserted))
+ (org-footnote--clear-footnote-section)
+ (dolist (cell references)
+ (let* ((label (car cell))
+ (anonymous (integerp label))
+ (pos (nth 1 cell)))
+ ;; Move to appropriate location, if required. When
+ ;; there is a footnote section or reference is
+ ;; nested, point is already at the expected location.
+ (unless (or org-footnote-section (not (nth 2 cell)))
+ (goto-char pos)
+ (org-footnote--goto-local-insertion-point))
+ ;; Insert new definition once label is updated.
+ (unless (member label inserted)
+ (push label inserted)
+ (let ((stored (cdr (assoc label definitions)))
+ ;; Anonymous footnotes' label is already
+ ;; up-to-date.
+ (new (if anonymous label
+ (cdr (assoc label translations)))))
+ (insert "\n"
+ (cond
+ ((not stored)
+ (format "[fn:%s] DEFINITION NOT FOUND." new))
+ (anonymous stored)
+ (t
+ (replace-regexp-in-string
+ "\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1)))
+ "\n")))))
+ ;; Insert un-referenced footnote definitions at the end.
+ (let ((unreferenced
+ (cl-remove-if (lambda (d) (member (car d) inserted))
+ definitions)))
+ (dolist (d unreferenced)
+ (insert "\n"
+ (replace-regexp-in-string
+ org-footnote-definition-re
+ (format "[fn:%d]" (cl-incf n))
+ (cdr d))
+ "\n"))))))
+ ;; Clear dangling markers.
+ (dolist (r references) (set-marker (nth 1 r) nil)))))
(defun org-footnote-auto-adjust-maybe ()
"Renumber and/or sort footnotes according to user settings."
@@ -868,14 +925,77 @@ If LABEL is non-nil, delete that footnote instead."
(org-footnote-renumber-fn:N))
(when (memq org-footnote-auto-adjust '(t sort))
(let ((label (car (org-footnote-at-definition-p))))
- (org-footnote-normalize 'sort)
+ (org-footnote-sort)
(when label
(goto-char (point-min))
- (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]")
+ (and (re-search-forward (format "^\\[fn:%s\\]" (regexp-quote label))
nil t)
(progn (insert " ")
(just-one-space)))))))
+
+;;;; End-user interface
+
+;;;###autoload
+(defun org-footnote-action (&optional special)
+ "Do the right thing for footnotes.
+
+When at a footnote reference, jump to the definition.
+
+When at a definition, jump to the references if they exist, offer
+to create them otherwise.
+
+When neither at definition or reference, create a new footnote,
+interactively if possible.
+
+With prefix arg SPECIAL, or when no footnote can be created,
+offer additional commands in a menu."
+ (interactive "P")
+ (let* ((context (and (not special) (org-element-context)))
+ (type (org-element-type context)))
+ (cond
+ ;; On white space after element, insert a new footnote.
+ ((and context
+ (> (point)
+ (save-excursion
+ (goto-char (org-element-property :end context))
+ (skip-chars-backward " \t")
+ (point))))
+ (org-footnote-new))
+ ((eq type 'footnote-reference)
+ (let ((label (org-element-property :label context)))
+ (cond
+ ;; Anonymous footnote: move point at the beginning of its
+ ;; definition.
+ ((not label)
+ (goto-char (org-element-property :contents-begin context)))
+ ;; Check if a definition exists: then move to it.
+ ((let ((p (nth 1 (org-footnote-get-definition label))))
+ (when p (org-footnote-goto-definition label p))))
+ ;; No definition exists: offer to create it.
+ ((yes-or-no-p (format "No definition for %s. Create one? " label))
+ (let ((p (org-footnote-create-definition label)))
+ (or (ignore-errors (org-footnote-goto-definition label p))
+ ;; Since definition was created outside current scope,
+ ;; edit it remotely.
+ (org-edit-footnote-reference)))))))
+ ((eq type 'footnote-definition)
+ (org-footnote-goto-previous-reference
+ (org-element-property :label context)))
+ ((or special (not (org-footnote--allow-reference-p)))
+ (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | [n]ormalize | \
+\[d]elete")
+ (pcase (read-char-exclusive)
+ (?s (org-footnote-sort))
+ (?r (org-footnote-renumber-fn:N))
+ (?S (org-footnote-renumber-fn:N)
+ (org-footnote-sort))
+ (?n (org-footnote-normalize))
+ (?d (org-footnote-delete))
+ (char (error "No such footnote command %c" char))))
+ (t (org-footnote-new)))))
+
+
(provide 'org-footnote)
;; Local variables:
diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el
index 1d287a740b5..26bb8899d3b 100644
--- a/lisp/org/org-gnus.el
+++ b/lisp/org/org-gnus.el
@@ -1,4 +1,4 @@
-;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode
+;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -20,50 +20,53 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file implements links to Gnus groups and messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to Gnus groups and messages from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
-(require 'org)
+(require 'gnus-sum)
(require 'gnus-util)
-(eval-when-compile (require 'gnus-sum))
+(require 'nnheader)
+(require 'nnir)
+(require 'org)
+
+
+;;; Declare external functions and variables
-;; Declare external functions and variables
+(declare-function gnus-activate-group "gnus-start" (group &optional scan dont-check method dont-sub-check))
+(declare-function gnus-find-method-for-group "gnus" (group &optional info))
+(declare-function gnus-group-group-name "gnus-group")
+(declare-function gnus-group-jump-to-group "gnus-group" (group &optional prompt))
+(declare-function gnus-group-read-group "gnus-group" (&optional all no-article group select-articles))
(declare-function message-fetch-field "message" (header &optional not-all))
-(declare-function message-narrow-to-head-1 "message" nil)
-;; The following line suppresses a compiler warning stemming from gnus-sum.el
-(declare-function gnus-summary-last-subject "gnus-sum" nil)
-;; Customization variables
+(declare-function message-generate-headers "message" (headers))
+(declare-function message-narrow-to-headers "message")
+(declare-function message-tokenize-header "message" (header &optional separator))
+(declare-function message-unquote-tokens "message" (elems))
+(declare-function nnvirtual-map-article "nnvirtual" (article))
-(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links)
+(defvar gnus-newsgroup-name)
+(defvar gnus-summary-buffer)
+(defvar gnus-other-frame-object)
+
+
+;;; Customization variables
(defcustom org-gnus-prefer-web-links nil
"If non-nil, `org-store-link' creates web links to Google groups or Gmane.
-When nil, Gnus will be used for such links.
-Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+\\<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."
:group 'org-link-store
:type 'boolean)
-(defcustom org-gnus-nnimap-query-article-no-from-file nil
- "If non-nil, `org-gnus-follow-link' will try to translate
-Message-Ids to article numbers by querying the .overview file.
-Normally, this translation is done by querying the IMAP server,
-which is usually very fast. Unfortunately, some (maybe badly
-configured) IMAP servers don't support this operation quickly.
-So if following a link to a Gnus article takes ages, try setting
-this variable to t."
- :group 'org-link-store
- :version "24.1"
- :type 'boolean)
-
(defcustom org-gnus-no-server nil
"Should Gnus be started using `gnus-no-server'?"
:group 'org-gnus
@@ -71,29 +74,14 @@ this variable to t."
:package-version '(Org . "8.0")
:type 'boolean)
-;; Install the link type
-(org-add-link-type "gnus" 'org-gnus-open)
-(add-hook 'org-store-link-functions 'org-gnus-store-link)
-
-;; Implementation
+
+;;; Install the link type
-;; FIXME: nnimap-group-overview-filename was removed from Gnus in
-;; September 2010. Perhaps remove this function?
-(defun org-gnus-nnimap-cached-article-number (group server message-id)
- "Return cached article number (uid) of message in GROUP on SERVER.
-MESSAGE-ID is the message-id header field that identifies the
-message. If the uid is not cached, return nil."
- (with-temp-buffer
- (let ((nov (nnimap-group-overview-filename group server)))
- (when (file-exists-p nov)
- (mm-insert-file-contents nov)
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (catch 'found
- (while (search-forward message-id nil t)
- (let ((hdr (split-string (thing-at-point 'line) "\t")))
- (if (string= (nth 4 hdr) message-id)
- (throw 'found (nth 0 hdr))))))))))
+(org-link-set-parameters "gnus"
+ :follow #'org-gnus-open
+ :store #'org-gnus-store-link)
+
+;;; Implementation
(defun org-gnus-group-link (group)
"Create a link to the Gnus group GROUP.
@@ -104,7 +92,7 @@ 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."
(let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group)))
- (if (and (string-match "^nntp" group) ;; Only for nntp groups
+ (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)
@@ -136,91 +124,77 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-store-link ()
"Store a link to a Gnus folder or message."
- (cond
- ((eq major-mode 'gnus-group-mode)
- (let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus
- (gnus-group-group-name)) ; version
- ((fboundp 'gnus-group-name)
- (gnus-group-name))
- (t "???")))
- desc link)
- (when group
- (org-store-link-props :type "gnus" :group group)
- (setq desc (org-gnus-group-link group)
- link desc)
- (org-add-link-props :link link :description desc)
- link)))
-
- ((memq major-mode '(gnus-summary-mode gnus-article-mode))
- (let* ((group gnus-newsgroup-name)
- (header (with-current-buffer gnus-summary-buffer
- (gnus-summary-article-header)))
- (from (mail-header-from header))
- (message-id (org-remove-angle-brackets (mail-header-id header)))
- (date (org-trim (mail-header-date header)))
- (date-ts (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t)
- (date-to-time date)))))
- (date-ts-ia (and date
- (ignore-errors
- (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date)))))
- (subject (copy-sequence (mail-header-subject header)))
- (to (cdr (assq 'To (mail-header-extra header))))
- newsgroups x-no-archive desc link)
- ;; Remove text properties of subject string to avoid Emacs bug
- ;; #3506
- (set-text-properties 0 (length subject) nil subject)
-
- ;; Fetching an article is an expensive operation; newsgroup and
- ;; x-no-archive are only needed for web links.
- (when (org-xor current-prefix-arg org-gnus-prefer-web-links)
- ;; Make sure the original article buffer is up-to-date
- (save-window-excursion (gnus-summary-select-article))
- (setq to (or to (gnus-fetch-original-field "To"))
- newsgroups (gnus-fetch-original-field "Newsgroups")
- x-no-archive (gnus-fetch-original-field "x-no-archive")))
- (org-store-link-props :type "gnus" :from from :subject subject
- :message-id message-id :group group :to to)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
- (setq desc (org-email-link-description)
- link (org-gnus-article-link
- group newsgroups message-id x-no-archive))
- (org-add-link-props :link link :description desc)
- link))
- ((eq major-mode 'message-mode)
- (setq org-store-link-plist nil) ; reset
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (and (not (message-fetch-field "Message-ID"))
- (message-generate-headers '(Message-ID)))
- (goto-char (point-min))
- (re-search-forward "^Message-ID: *.*$" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil)
- (let ((gcc (car (last
- (message-unquote-tokens
- (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,")))))
- (id (org-remove-angle-brackets (mail-fetch-field "Message-ID")))
- (to (mail-fetch-field "To"))
- (from (mail-fetch-field "From"))
- (subject (mail-fetch-field "Subject"))
- desc link
- newsgroup xarchive) ; those are always nil for gcc
- (and (not gcc)
- (error "Can not create link: No Gcc header found"))
- (org-store-link-props :type "gnus" :from from :subject subject
- :message-id id :group gcc :to to)
- (setq desc (org-email-link-description)
- link (org-gnus-article-link
- gcc newsgroup id xarchive))
- (org-add-link-props :link link :description desc)
- link))))))
+ (pcase major-mode
+ (`gnus-group-mode
+ (let ((group (gnus-group-group-name)))
+ (when group
+ (org-store-link-props :type "gnus" :group group)
+ (let ((description (org-gnus-group-link group)))
+ (org-add-link-props :link description :description description)
+ description))))
+ ((or `gnus-summary-mode `gnus-article-mode)
+ (let* ((group
+ (pcase (gnus-find-method-for-group gnus-newsgroup-name)
+ (`(nnvirtual . ,_)
+ (save-excursion
+ (car (nnvirtual-map-article (gnus-summary-article-number)))))
+ (`(nnir . ,_)
+ (save-excursion
+ (nnir-article-group (gnus-summary-article-number))))
+ (_ gnus-newsgroup-name)))
+ (header (with-current-buffer gnus-summary-buffer
+ (gnus-summary-article-header)))
+ (from (mail-header-from header))
+ (message-id (org-unbracket-string "<" ">" (mail-header-id header)))
+ (date (org-trim (mail-header-date header)))
+ ;; Remove text properties of subject string to avoid Emacs
+ ;; bug #3506.
+ (subject (org-no-properties
+ (copy-sequence (mail-header-subject header))))
+ (to (cdr (assq 'To (mail-header-extra header))))
+ newsgroups x-no-archive)
+ ;; Fetching an article is an expensive operation; newsgroup and
+ ;; x-no-archive are only needed for web links.
+ (when (org-xor current-prefix-arg org-gnus-prefer-web-links)
+ ;; Make sure the original article buffer is up-to-date.
+ (save-window-excursion (gnus-summary-select-article))
+ (setq to (or to (gnus-fetch-original-field "To")))
+ (setq newsgroups (gnus-fetch-original-field "Newsgroups"))
+ (setq x-no-archive (gnus-fetch-original-field "x-no-archive")))
+ (org-store-link-props :type "gnus" :from from :date date :subject subject
+ :message-id message-id :group group :to to)
+ (let ((link (org-gnus-article-link
+ group newsgroups message-id x-no-archive))
+ (description (org-email-link-description)))
+ (org-add-link-props :link link :description description)
+ link)))
+ (`message-mode
+ (setq org-store-link-plist nil) ;reset
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (unless (message-fetch-field "Message-ID")
+ (message-generate-headers '(Message-ID)))
+ (goto-char (point-min))
+ (re-search-forward "^Message-ID:" nil t)
+ (put-text-property (line-beginning-position) (line-end-position)
+ 'message-deletable nil)
+ (let ((gcc (org-last (message-unquote-tokens
+ (message-tokenize-header
+ (mail-fetch-field "gcc" nil t) " ,"))))
+ (id (org-unbracket-string "<" ">"
+ (mail-fetch-field "Message-ID")))
+ (to (mail-fetch-field "To"))
+ (from (mail-fetch-field "From"))
+ (subject (mail-fetch-field "Subject"))
+ newsgroup xarchive) ;those are always nil for gcc
+ (unless gcc (error "Can not create link: No Gcc header found"))
+ (org-store-link-props :type "gnus" :from from :subject subject
+ :message-id id :group gcc :to to)
+ (let ((link (org-gnus-article-link gcc newsgroup id xarchive))
+ (description (org-email-link-description)))
+ (org-add-link-props :link link :description description)
+ link)))))))
(defun org-gnus-open-nntp (path)
"Follow the nntp: link specified by PATH."
@@ -234,66 +208,51 @@ If `org-store-link' was called with a prefix arg the meaning of
(defun org-gnus-open (path)
"Follow the Gnus message or folder link specified by PATH."
- (let (group article)
- (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path))
- (error "Error in Gnus link"))
- (setq group (match-string 1 path)
- article (match-string 3 path))
- (when group
- (setq group (org-no-properties group)))
- (when article
- (setq article (org-no-properties article)))
+ (unless (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)
+ (error "Error in Gnus link %S" path))
+ (let ((group (match-string-no-properties 1 path))
+ (article (match-string-no-properties 3 path)))
(org-gnus-follow-link group article)))
(defun org-gnus-follow-link (&optional group article)
"Follow a Gnus link to GROUP and ARTICLE."
(require 'gnus)
(funcall (cdr (assq 'gnus org-link-frame-setup)))
- (if gnus-other-frame-object (select-frame gnus-other-frame-object))
- (when group
- (setq group (org-no-properties group)))
- (when article
- (setq article (org-no-properties article)))
- (cond ((and group article)
- (gnus-activate-group group)
- (condition-case nil
- (let* ((method (gnus-find-method-for-group group))
- (backend (car method))
- (server (cadr method)))
- (cond
- ((eq backend 'nndoc)
- (if (gnus-group-read-group t nil group)
+ (when gnus-other-frame-object (select-frame gnus-other-frame-object))
+ (let ((group (org-no-properties group))
+ (article (org-no-properties article)))
+ (cond
+ ((and group article)
+ (gnus-activate-group group)
+ (condition-case nil
+ (let ((msg "Couldn't follow Gnus link. Summary couldn't be opened."))
+ (pcase (gnus-find-method-for-group group)
+ (`(nndoc . ,_)
+ (if (gnus-group-read-group t nil group)
+ (gnus-summary-goto-article article nil t)
+ (message msg)))
+ (_
+ (let ((articles 1)
+ group-opened)
+ (while (and (not group-opened)
+ ;; Stop on integer overflows.
+ (> articles 0))
+ (setq group-opened (gnus-group-read-group articles t group))
+ (setq articles (if (< articles 16)
+ (1+ articles)
+ (* articles 2))))
+ (if group-opened
(gnus-summary-goto-article article nil t)
- (message "Couldn't follow gnus link. %s"
- "The summary couldn't be opened.")))
- (t
- (let ((articles 1)
- group-opened)
- (when (and (eq backend 'nnimap)
- org-gnus-nnimap-query-article-no-from-file)
- (setq article
- (or (org-gnus-nnimap-cached-article-number
- (nth 1 (split-string group ":"))
- server (concat "<" article ">")) article)))
- (while (and (not group-opened)
- ;; stop on integer overflows
- (> articles 0))
- (setq group-opened (gnus-group-read-group
- articles t group)
- articles (if (< articles 16)
- (1+ articles)
- (* articles 2))))
- (if group-opened
- (gnus-summary-goto-article article nil t)
- (message "Couldn't follow gnus link. %s"
- "The summary couldn't be opened."))))))
- (quit (message "Couldn't follow gnus link. %s"
- "The linked group is empty."))))
- (group (gnus-group-jump-to-group group))))
+ (message msg))))))
+ (quit
+ (message "Couldn't follow Gnus link. The linked group is empty."))))
+ (group (gnus-group-jump-to-group group)))))
(defun org-gnus-no-new-news ()
"Like `\\[gnus]' but doesn't check for new news."
- (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus))))
+ (cond ((gnus-alive-p) nil)
+ (org-gnus-no-server (gnus-no-server))
+ (t (gnus))))
(provide 'org-gnus)
diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el
index bbbf845d148..89b75e6f680 100644
--- a/lisp/org/org-habit.el
+++ b/lisp/org/org-habit.el
@@ -1,4 +1,4 @@
-;;; org-habit.el --- The habit tracking code for Org-mode
+;;; org-habit.el --- The habit tracking code for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -19,23 +19,21 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the habit tracking code for Org-mode
+;; This file contains the habit tracking code for Org mode
;;; Code:
+(require 'cl-lib)
(require 'org)
(require 'org-agenda)
-(eval-when-compile
- (require 'cl))
-
(defgroup org-habit nil
- "Options concerning habit tracking in Org-mode."
+ "Options concerning habit tracking in Org mode."
:tag "Org Habit"
:group 'org-progress)
@@ -165,16 +163,17 @@ Returns a list with the following elements:
2: Optional deadline (nil if not present)
3: If deadline, the repeater for the deadline, otherwise nil
4: A list of all the past dates this todo was mark closed
+ 5: Repeater type as a string
This list represents a \"habit\" for the rest of this module."
(save-excursion
(if pom (goto-char pom))
- (assert (org-is-habit-p (point)))
+ (cl-assert (org-is-habit-p (point)))
(let* ((scheduled (org-get-scheduled-time (point)))
- (scheduled-repeat (org-get-repeat org-scheduled-string))
+ (scheduled-repeat (org-get-repeat (org-entry-get (point) "SCHEDULED")))
(end (org-entry-end-position))
(habit-entry (org-no-properties (nth 4 (org-heading-components))))
- closed-dates deadline dr-days sr-days)
+ closed-dates deadline dr-days sr-days sr-type)
(if scheduled
(setq scheduled (time-to-days scheduled))
(error "Habit %s has no scheduled date" habit-entry))
@@ -182,7 +181,9 @@ This list represents a \"habit\" for the rest of this module."
(error
"Habit `%s' has no scheduled repeat period or has an incorrect one"
habit-entry))
- (setq sr-days (org-habit-duration-to-days scheduled-repeat))
+ (setq sr-days (org-habit-duration-to-days scheduled-repeat)
+ sr-type (progn (string-match "[\\.+]?\\+" scheduled-repeat)
+ (match-string-no-properties 0 scheduled-repeat)))
(unless (> sr-days 0)
(error "Habit %s scheduled repeat period is less than 1d" habit-entry))
(when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat)
@@ -197,17 +198,33 @@ This list represents a \"habit\" for the rest of this module."
(reversed org-log-states-order-reversed)
(search (if reversed 're-search-forward 're-search-backward))
(limit (if reversed end (point)))
- (count 0))
+ (count 0)
+ (re (format
+ "^[ \t]*-[ \t]+\\(?:State \"%s\".*%s%s\\)"
+ (regexp-opt org-done-keywords)
+ org-ts-regexp-inactive
+ (let ((value (cdr (assq 'done org-log-note-headings))))
+ (if (not value) ""
+ (concat "\\|"
+ (org-replace-escapes
+ (regexp-quote value)
+ `(("%d" . ,org-ts-regexp-inactive)
+ ("%D" . ,org-ts-regexp)
+ ("%s" . "\"\\S-+\"")
+ ("%S" . "\"\\S-+\"")
+ ("%t" . ,org-ts-regexp-inactive)
+ ("%T" . ,org-ts-regexp)
+ ("%u" . ".*?")
+ ("%U" . ".*?")))))))))
(unless reversed (goto-char end))
- (while (and (< count maxdays)
- (funcall search (format "- State \"%s\".*\\[\\([^]]+\\)\\]"
- (regexp-opt org-done-keywords))
- limit t))
+ (while (and (< count maxdays) (funcall search re limit t))
(push (time-to-days
- (org-time-string-to-time (match-string-no-properties 1)))
+ (org-time-string-to-time
+ (or (match-string-no-properties 1)
+ (match-string-no-properties 2))))
closed-dates)
(setq count (1+ count))))
- (list scheduled sr-days deadline dr-days closed-dates))))
+ (list scheduled sr-days deadline dr-days closed-dates sr-type))))
(defsubst org-habit-scheduled (habit)
(nth 0 habit))
@@ -225,6 +242,8 @@ This list represents a \"habit\" for the rest of this module."
(org-habit-scheduled-repeat habit)))
(defsubst org-habit-done-dates (habit)
(nth 4 habit))
+(defsubst org-habit-repeat-type (habit)
+ (nth 5 habit))
(defsubst org-habit-get-priority (habit &optional moment)
"Determine the relative priority of a habit.
@@ -265,7 +284,6 @@ Habits are assigned colors on the following basis:
schedule's repeat period."
(let* ((scheduled (or scheduled-days (org-habit-scheduled habit)))
(s-repeat (org-habit-scheduled-repeat habit))
- (scheduled-end (+ scheduled (1- s-repeat)))
(d-repeat (org-habit-deadline-repeat habit))
(deadline (if scheduled-days
(+ scheduled-days (- d-repeat s-repeat))
@@ -289,13 +307,14 @@ Habits are assigned colors on the following basis:
CURRENT gives the current time between STARTING and ENDING, for
the purpose of drawing the graph. It need not be the actual
current time."
- (let* ((done-dates (sort (org-habit-done-dates habit) '<))
+ (let* ((all-done-dates (sort (org-habit-done-dates habit) #'<))
+ (done-dates all-done-dates)
(scheduled (org-habit-scheduled habit))
(s-repeat (org-habit-scheduled-repeat habit))
(start (time-to-days starting))
(now (time-to-days current))
(end (time-to-days ending))
- (graph (make-string (1+ (- end start)) ?\ ))
+ (graph (make-string (1+ (- end start)) ?\s))
(index 0)
last-done-date)
(while (and done-dates (< (car done-dates) start))
@@ -304,18 +323,55 @@ current time."
(while (< start end)
(let* ((in-the-past-p (< start now))
(todayp (= start now))
- (donep (and done-dates
- (= start (car done-dates))))
- (faces (if (and in-the-past-p
- (not last-done-date)
- (not (< scheduled now)))
- '(org-habit-clear-face . org-habit-clear-future-face)
- (org-habit-get-faces
- habit start (and in-the-past-p
- (if last-done-date
- (+ last-done-date s-repeat)
- scheduled))
- donep)))
+ (donep (and done-dates (= start (car done-dates))))
+ (faces
+ (if (and in-the-past-p
+ (not last-done-date)
+ (not (< scheduled now)))
+ '(org-habit-clear-face . org-habit-clear-future-face)
+ (org-habit-get-faces
+ habit start
+ (and in-the-past-p
+ last-done-date
+ ;; Compute scheduled time for habit at the time
+ ;; START was current.
+ (let ((type (org-habit-repeat-type habit)))
+ (cond
+ ;; At the last done date, use current
+ ;; scheduling in all cases.
+ ((null done-dates) scheduled)
+ ((equal type ".+") (+ last-done-date s-repeat))
+ ((equal type "+")
+ ;; Since LAST-DONE-DATE, each done mark
+ ;; shifted scheduled date by S-REPEAT.
+ (- scheduled (* (length done-dates) s-repeat)))
+ (t
+ ;; Compute the scheduled time after the
+ ;; first repeat. This is the closest time
+ ;; past FIRST-DONE which can reach SCHEDULED
+ ;; by a number of S-REPEAT hops.
+ ;;
+ ;; Then, play TODO state change history from
+ ;; the beginning in order to find current
+ ;; scheduled time.
+ (let* ((first-done (car all-done-dates))
+ (s (let ((shift (mod (- scheduled first-done)
+ s-repeat)))
+ (+ (if (= shift 0) s-repeat shift)
+ first-done))))
+ (if (= first-done last-done-date) s
+ (catch :exit
+ (dolist (done (cdr all-done-dates) s)
+ ;; Each repeat shifts S by any
+ ;; number of S-REPEAT hops it takes
+ ;; to get past DONE, with a minimum
+ ;; of one hop.
+ (cl-incf s (* (1+ (/ (max (- done s) 0)
+ s-repeat))
+ s-repeat))
+ (when (= done last-done-date)
+ (throw :exit s))))))))))
+ donep)))
markedp face)
(if donep
(let ((done-time (time-add
@@ -348,7 +404,7 @@ current time."
(defun org-habit-insert-consistency-graphs (&optional line)
"Insert consistency graph for any habitual tasks."
- (let ((inhibit-read-only t) l c
+ (let ((inhibit-read-only t)
(buffer-invisibility-spec '(org-link))
(moment (time-subtract (current-time)
(list 0 (* 3600 org-extend-today-until) 0))))
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index 54fc733578d..09b873c49d4 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -1,4 +1,4 @@
-;;; org-id.el --- Global identifiers for Org-mode entries
+;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
;;
@@ -19,12 +19,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file implements globally unique identifiers for Org-mode entries.
+;; This file implements globally unique identifiers for Org entries.
;; Identifiers are stored in the entry as an :ID: property. Functions
;; are provided that create and retrieve such identifiers, and that find
;; entries based on the identifier.
@@ -73,20 +73,17 @@
(require 'org)
(declare-function message-make-fqdn "message" ())
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
;;; Customization
(defgroup org-id nil
- "Options concerning global entry identifiers in Org-mode."
+ "Options concerning global entry identifiers in Org mode."
:tag "Org ID"
:group 'org)
-(define-obsolete-variable-alias
- 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3")
(defcustom org-id-link-to-org-use-id nil
"Non-nil means storing a link to an Org file will use entry IDs.
+\\<org-mode-map>\
The variable can have the following values:
@@ -101,7 +98,7 @@ create-if-interactive
call `org-capture' that automatically and preemptively creates a
link. If you do want to get an ID link in a capture template to
an entry not having an ID, create it first by explicitly creating
- a link to it, using `C-c C-l' first.
+ a link to it, using `\\[org-store-link]' first.
create-if-interactive-and-no-custom-id
Like create-if-interactive, but do not create an ID if there is
@@ -203,7 +200,7 @@ This variable is only relevant when `org-id-track-globally' is set."
When Org reparses files to remake the list of files and IDs it is tracking,
it will normally scan the agenda files, the archives related to agenda files,
any files that are listed as ID containing in the current register, and
-any Org-mode files currently visited by Emacs.
+any Org file currently visited by Emacs.
You can list additional files here.
This variable is only relevant when `org-id-track-globally' is set."
:group 'org-id
@@ -277,7 +274,7 @@ If necessary, the ID is created."
(move-marker pom nil))))
;;;###autoload
-(defun org-id-get-with-outline-drilling (&optional targets)
+(defun org-id-get-with-outline-drilling ()
"Use an outline-cycling interface to retrieve the ID of an entry.
This only finds entries in the current buffer, using `org-get-location'.
It returns the ID of the entry. If necessary, the ID is created."
@@ -294,7 +291,7 @@ Move the cursor to that entry in that buffer."
(let ((m (org-id-find id 'marker)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
(move-marker m nil)
(org-show-context)))
@@ -447,8 +444,7 @@ and time is the usual three-integer representation of time."
Store the relation between files and corresponding IDs.
This will scan all agenda files, all associated archives, and all
files currently mentioned in `org-id-locations'.
-When FILES is given, scan these files instead.
-When CHECK is given, prepare detailed information about duplicate IDs."
+When FILES is given, scan these files instead."
(interactive)
(if (not org-id-track-globally)
(error "Please turn on `org-id-track-globally' if you want to track IDs")
@@ -466,7 +462,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(if (symbolp org-id-extra-files)
(symbol-value org-id-extra-files)
org-id-extra-files)
- ;; Files associated with live org-mode buffers
+ ;; Files associated with live Org buffers
(delq nil
(mapcar (lambda (b)
(with-current-buffer b
@@ -494,7 +490,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
nil t)
- (setq id (org-match-string-no-properties 1))
+ (setq id (match-string-no-properties 1))
(if (member id found)
(progn
(message "Duplicate ID \"%s\", also in file %s"
@@ -543,8 +539,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(with-temp-buffer
(condition-case nil
(progn
- (insert-file-contents-literally org-id-locations-file)
- (goto-char (point-min))
+ (insert-file-contents org-id-locations-file)
(setq org-id-locations (read (current-buffer))))
(error
(message "Could not read org-id-values from %s. Setting it to nil."
@@ -678,7 +673,7 @@ optional argument MARKERP, return the position as a new marker."
(move-marker m nil)
(org-show-context)))
-(org-add-link-type "id" 'org-id-open)
+(org-link-set-parameters "id" :follow #'org-id-open)
(provide 'org-id)
diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el
index baaff2ff7c8..b34586e09ec 100644
--- a/lisp/org/org-indent.el
+++ b/lisp/org/org-indent.el
@@ -1,4 +1,5 @@
-;;; org-indent.el --- Dynamic indentation for Org-mode
+;;; org-indent.el --- Dynamic indentation for Org -*- lexical-binding: t; -*-
+
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -18,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -39,8 +40,7 @@
(require 'org-compat)
(require 'org)
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(declare-function org-inlinetask-get-task-level "org-inlinetask" ())
(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
@@ -52,20 +52,6 @@
:tag "Org Indent"
:group 'org)
-(defconst org-indent-max 40
- "Maximum indentation in characters.")
-(defconst org-indent-max-levels 20
- "Maximum added level through virtual indentation, in characters.
-
-It is computed by multiplying `org-indent-indentation-per-level'
-minus one by actual level of the headline minus one.")
-
-(defvar org-indent-strings nil
- "Vector with all indentation strings.
-It will be set in `org-indent-initialize'.")
-(defvar org-indent-stars nil
- "Vector with all indentation star strings.
-It will be set in `org-indent-initialize'.")
(defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning))
"First star of inline tasks, with correct face.")
(defvar org-indent-agent-timer nil
@@ -82,7 +68,7 @@ Delay used when the buffer to initialize is current.")
Delay used when the buffer to initialize isn't current.")
(defvar org-indent-agent-resume-delay '(0 0 100000)
"Minimal time for other idle processes before switching back to agent.")
-(defvar org-indent-initial-marker nil
+(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
@@ -92,15 +78,12 @@ This is used locally in each buffer being initialized.")
It is modified by `org-indent-notify-modified-headline'.")
-(defcustom org-indent-boundary-char ?\ ; comment to protect space char
+(defcustom org-indent-boundary-char ?\s
"The end of the virtual indentation strings, a single-character string.
The default is just a space, but if you wish, you can use \"|\" or so.
This can be useful on a terminal window - under a windowing system,
-it may be prettier to customize the org-indent face."
+it may be prettier to customize the `org-indent' face."
:group 'org-indent
- :set (lambda (var val)
- (set var val)
- (and org-indent-strings (org-indent-initialize)))
:type 'character)
(defcustom org-indent-mode-turns-off-org-adapt-indentation t
@@ -121,29 +104,56 @@ turn on `org-hide-leading-stars'."
:group 'org-indent
:type 'integer)
-(defface org-indent
- (org-compatible-face nil nil)
+(defface org-indent '((t (:inherit org-hide)))
"Face for outline indentation.
The default is to make it look like whitespace. But you may find it
useful to make it ever so slightly different."
:group 'org-faces)
-(defun org-indent-initialize ()
- "Initialize the indentation strings."
- (setq org-indent-strings (make-vector (1+ org-indent-max) nil))
- (setq org-indent-stars (make-vector (1+ org-indent-max) nil))
- (aset org-indent-strings 0 nil)
- (aset org-indent-stars 0 nil)
- (loop for i from 1 to org-indent-max do
- (aset org-indent-strings i
- (org-add-props
- (concat (make-string (1- i) ?\ )
- (char-to-string org-indent-boundary-char))
- nil 'face 'org-indent)))
- (loop for i from 1 to org-indent-max-levels do
- (aset org-indent-stars i
- (org-add-props (make-string i ?*)
- nil 'face 'org-hide))))
+(defvar org-indent--text-line-prefixes nil
+ "Vector containing line prefixes strings for regular text.")
+
+(defvar org-indent--heading-line-prefixes nil
+ "Vector containing line prefix strings for headlines.")
+
+(defvar org-indent--inlinetask-line-prefixes nil
+ "Vector containing line prefix strings for inline tasks.")
+
+(defconst org-indent--deepest-level 50
+ "Maximum theoretical headline depth.")
+
+(defun org-indent--compute-prefixes ()
+ "Compute prefix strings for regular text and headlines."
+ (setq org-indent--heading-line-prefixes
+ (make-vector org-indent--deepest-level nil))
+ (setq org-indent--inlinetask-line-prefixes
+ (make-vector org-indent--deepest-level nil))
+ (setq org-indent--text-line-prefixes
+ (make-vector org-indent--deepest-level nil))
+ (dotimes (n org-indent--deepest-level)
+ (let ((indentation (if (<= n 1) 0
+ (* (1- org-indent-indentation-per-level)
+ (1- n)))))
+ ;; Headlines line prefixes.
+ (let ((heading-prefix (make-string indentation ?*)))
+ (aset org-indent--heading-line-prefixes
+ n
+ (org-add-props heading-prefix nil 'face 'org-indent))
+ ;; Inline tasks line prefixes
+ (aset org-indent--inlinetask-line-prefixes
+ n
+ (cond ((<= n 1) "")
+ ((bound-and-true-p org-inlinetask-show-first-star)
+ (concat org-indent-inlinetask-first-star
+ (substring heading-prefix 1)))
+ (t (org-add-props heading-prefix nil 'face 'org-indent)))))
+ ;; Text line prefixes.
+ (aset org-indent--text-line-prefixes
+ n
+ (concat (org-add-props (make-string (+ n indentation) ?\s)
+ nil 'face 'org-indent)
+ (and (> n 0)
+ (char-to-string org-indent-boundary-char)))))))
(defsubst org-indent-remove-properties (beg end)
"Remove indentations between BEG and END."
@@ -162,34 +172,25 @@ buffer, which can take a few seconds on large buffers, is done
during idle time."
nil " Ind" nil
(cond
- ((and org-indent-mode (featurep 'xemacs))
- (message "org-indent-mode does not work in XEmacs - refusing to turn it on")
- (setq org-indent-mode nil))
- ((and org-indent-mode
- (not (org-version-check "23.1.50" "Org Indent mode" :predicate)))
- (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!")
- (ding)
- (sit-for 1)
- (setq org-indent-mode nil))
(org-indent-mode
;; mode was turned on.
- (org-set-local 'indent-tabs-mode nil)
- (or org-indent-strings (org-indent-initialize))
- (org-set-local 'org-indent-initial-marker (copy-marker 1))
+ (setq-local indent-tabs-mode nil)
+ (setq-local org-indent--initial-marker (copy-marker 1))
(when org-indent-mode-turns-off-org-adapt-indentation
- (org-set-local 'org-adapt-indentation nil))
+ (setq-local org-adapt-indentation nil))
(when org-indent-mode-turns-on-hiding-stars
- (org-set-local 'org-hide-leading-stars-before-indent-mode
- org-hide-leading-stars)
- (org-set-local 'org-hide-leading-stars t))
- (org-add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (org-indent-remove-properties-from-string
- (funcall fun start end delete)))
- nil t)
- (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
- (org-add-hook 'before-change-functions
- 'org-indent-notify-modified-headline nil 'local)
+ (setq-local org-hide-leading-stars-before-indent-mode
+ org-hide-leading-stars)
+ (setq-local org-hide-leading-stars t))
+ (org-indent--compute-prefixes)
+ (add-hook 'filter-buffer-substring-functions
+ (lambda (fun start end delete)
+ (org-indent-remove-properties-from-string
+ (funcall fun start end delete)))
+ nil t)
+ (add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local)
+ (add-hook 'before-change-functions
+ 'org-indent-notify-modified-headline nil 'local)
(and font-lock-mode (org-restart-font-lock))
(org-indent-remove-properties (point-min) (point-max))
;; Submit current buffer to initialize agent. If it's the first
@@ -205,11 +206,11 @@ during idle time."
(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 (markerp org-indent--initial-marker)
+ (set-marker org-indent--initial-marker nil))
(when (boundp 'org-hide-leading-stars-before-indent-mode)
- (org-set-local 'org-hide-leading-stars
- org-hide-leading-stars-before-indent-mode))
+ (setq-local org-hide-leading-stars
+ org-hide-leading-stars-before-indent-mode))
(remove-hook 'filter-buffer-substring-functions
(lambda (fun start end delete)
(org-indent-remove-properties-from-string
@@ -245,7 +246,7 @@ When no more buffer is being watched, the agent suppress itself."
(when org-indent-agent-resume-timer
(cancel-timer org-indent-agent-resume-timer))
(setq org-indent-agentized-buffers
- (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers))
+ (cl-remove-if-not #'buffer-live-p org-indent-agentized-buffers))
(cond
;; Job done: kill agent.
((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer))
@@ -269,46 +270,44 @@ a time value."
(let ((interruptp
;; Always nil unless interrupted.
(catch 'interrupt
- (and org-indent-initial-marker
- (marker-position org-indent-initial-marker)
- (org-indent-add-properties org-indent-initial-marker
+ (and org-indent--initial-marker
+ (marker-position org-indent--initial-marker)
+ (equal (marker-buffer org-indent--initial-marker)
+ buffer)
+ (org-indent-add-properties org-indent--initial-marker
(point-max)
delay)
nil))))
- (move-marker org-indent-initial-marker interruptp)
+ (move-marker org-indent--initial-marker interruptp)
;; Job is complete: un-agentize buffer.
(unless interruptp
(setq org-indent-agentized-buffers
(delq buffer org-indent-agentized-buffers))))))))
-(defsubst org-indent-set-line-properties (l w h)
+(defun org-indent-set-line-properties (level indentation &optional heading)
"Set prefix properties on current line an move to next one.
-Prefix properties `line-prefix' and `wrap-prefix' in current line
-are set to, respectively, length L and W.
-
-If H is non-nil, `line-prefix' will be starred. If H is
-`inline', the first star will have `org-warning' face.
-
-Assume point is at beginning of line."
- (let ((line (cond
- ((eq 'inline h)
- (let ((stars (aref org-indent-stars
- (min l org-indent-max-levels))))
- (and stars
- (if (org-bound-and-true-p org-inlinetask-show-first-star)
- (concat org-indent-inlinetask-first-star
- (substring stars 1))
- stars))))
- (h (aref org-indent-stars
- (min l org-indent-max-levels)))
- (t (aref org-indent-strings
- (min l org-indent-max)))))
- (wrap (aref org-indent-strings (min w org-indent-max))))
+LEVEL is the current level of heading. INDENTATION is the
+expected indentation when wrapping line.
+
+When optional argument HEADING is non-nil, assume line is at
+a heading. Moreover, if is is `inlinetask', the first star will
+have `org-warning' face."
+ (let* ((line (aref (pcase heading
+ (`nil org-indent--text-line-prefixes)
+ (`inlinetask org-indent--inlinetask-line-prefixes)
+ (_ org-indent--heading-line-prefixes))
+ level))
+ (wrap
+ (org-add-props
+ (concat line
+ (if heading (concat (make-string level ?*) " ")
+ (make-string indentation ?\s)))
+ nil 'face 'org-indent)))
;; Add properties down to the next line to indent empty lines.
- (add-text-properties (point) (min (1+ (point-at-eol)) (point-max))
+ (add-text-properties (line-beginning-position) (line-beginning-position 2)
`(line-prefix ,line wrap-prefix ,wrap)))
- (forward-line 1))
+ (forward-line))
(defun org-indent-add-properties (beg end &optional delay)
"Add indentation properties between BEG and END.
@@ -322,26 +321,14 @@ stopped."
(org-with-wide-buffer
(goto-char beg)
(beginning-of-line)
- ;; 1. Initialize prefix at BEG. This is done by storing two
- ;; variables: INLINE-PF and PF, representing respectively
- ;; length of current `line-prefix' when line is inside an
- ;; inline task or not.
+ ;; Initialize prefix at BEG, according to current entry's level.
(let* ((case-fold-search t)
(limited-re (org-get-limited-outline-regexp))
- (added-ind-per-lvl (abs (1- org-indent-indentation-per-level)))
- (pf (save-excursion
- (and (ignore-errors (let ((outline-regexp limited-re))
- (org-back-to-heading t)))
- (+ (* org-indent-indentation-per-level
- (- (match-end 0) (match-beginning 0) 2)) 2))))
- (pf-inline (and (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)
- (+ (* org-indent-indentation-per-level
- (1- (org-inlinetask-get-task-level))) 2)))
+ (level (or (org-current-level) 0))
(time-limit (and delay (time-add (current-time) delay))))
- ;; 2. For each line, set `line-prefix' and `wrap-prefix'
- ;; properties depending on the type of line (headline,
- ;; inline task, item or other).
+ ;; For each line, set `line-prefix' and `wrap-prefix'
+ ;; properties depending on the type of line (headline, inline
+ ;; task, item or other).
(org-with-silent-modifications
(while (and (<= (point) end) (not (eobp)))
(cond
@@ -354,38 +341,23 @@ stopped."
((and delay (time-less-p time-limit (current-time)))
(setq org-indent-agent-resume-timer
(run-with-idle-timer
- (time-add (current-idle-time)
- org-indent-agent-resume-delay)
+ (time-add (current-idle-time) org-indent-agent-resume-delay)
nil #'org-indent-initialize-agent))
(throw 'interrupt (point)))
;; Headline or inline task.
((looking-at org-outline-regexp)
(let* ((nstars (- (match-end 0) (match-beginning 0) 1))
- (line (* added-ind-per-lvl (1- nstars)))
- (wrap (+ line (1+ nstars))))
- (cond
- ;; Headline: new value for PF.
- ((looking-at limited-re)
- (org-indent-set-line-properties line wrap t)
- (setq pf wrap))
- ;; End of inline task: PF-INLINE is now nil.
- ((looking-at "\\*+ end[ \t]*$")
- (org-indent-set-line-properties line wrap 'inline)
- (setq pf-inline nil))
- ;; Start of inline task. Determine if it contains
- ;; text, or if it is only one line long. Set
- ;; PF-INLINE accordingly.
- (t (org-indent-set-line-properties line wrap 'inline)
- (setq pf-inline (and (org-inlinetask-in-task-p) wrap))))))
+ (type (or (looking-at-p limited-re) 'inlinetask)))
+ (org-indent-set-line-properties nstars 0 type)
+ ;; At an headline, define new value for LEVEL.
+ (unless (eq type 'inlinetask) (setq level nstars))))
;; List item: `wrap-prefix' is set where body starts.
((org-at-item-p)
- (let* ((line (or pf-inline pf 0))
- (wrap (+ (org-list-item-body-column (point)) line)))
- (org-indent-set-line-properties line wrap nil)))
- ;; Normal line: use PF-INLINE, PF or nil as prefixes.
- (t (let* ((line (or pf-inline pf 0))
- (wrap (+ line (org-get-indentation))))
- (org-indent-set-line-properties line wrap nil))))))))))
+ (org-indent-set-line-properties
+ level (org-list-item-body-column (point))))
+ ;; Regular line.
+ (t
+ (org-indent-set-line-properties level (org-get-indentation))))))))))
(defun org-indent-notify-modified-headline (beg end)
"Set `org-indent-modified-headline-flag' depending on context.
@@ -398,13 +370,14 @@ Flag will be non-nil if command is going to modify or delete an
headline."
(when org-indent-mode
(setq org-indent-modified-headline-flag
- (save-excursion
- (goto-char beg)
- (save-match-data
- (or (and (org-at-heading-p) (< beg (match-end 0)))
- (re-search-forward org-outline-regexp-bol end t)))))))
-
-(defun org-indent-refresh-maybe (beg end dummy)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (save-match-data
+ (or (and (org-at-heading-p) (< beg (match-end 0)))
+ (re-search-forward
+ (org-with-limited-levels org-outline-regexp-bol) end t)))))))
+
+(defun org-indent-refresh-maybe (beg end _)
"Refresh indentation properties in an adequate portion of buffer.
BEG and END are the positions of the beginning and end of the
range of inserted text. DUMMY is an unused argument.
@@ -414,19 +387,21 @@ This function is meant to be called by `after-change-functions'."
(save-match-data
;; If a headline was modified or inserted, set properties until
;; next headline.
- (if (or org-indent-modified-headline-flag
- (save-excursion
- (goto-char beg)
- (beginning-of-line)
- (re-search-forward org-outline-regexp-bol end t)))
- (let ((end (save-excursion
- (goto-char end)
- (org-with-limited-levels (outline-next-heading))
- (point))))
- (setq org-indent-modified-headline-flag nil)
- (org-indent-add-properties beg end))
- ;; Otherwise, only set properties on modified area.
- (org-indent-add-properties beg end)))))
+ (org-with-wide-buffer
+ (if (or org-indent-modified-headline-flag
+ (save-excursion
+ (goto-char beg)
+ (beginning-of-line)
+ (re-search-forward
+ (org-with-limited-levels org-outline-regexp-bol) end t)))
+ (let ((end (save-excursion
+ (goto-char end)
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ (setq org-indent-modified-headline-flag nil)
+ (org-indent-add-properties beg end))
+ ;; Otherwise, only set properties on modified area.
+ (org-indent-add-properties beg end))))))
(provide 'org-indent)
diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el
index c8f6f06de06..7f859f9040d 100644
--- a/lisp/org/org-info.el
+++ b/lisp/org/org-info.el
@@ -1,4 +1,4 @@
-;;; org-info.el --- Support for links to Info nodes from within Org-Mode
+;;; org-info.el --- Support for Links to Info Nodes -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,13 +19,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file implements links to Info nodes from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to Info nodes from within Org mode.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
@@ -40,19 +40,20 @@
(defvar Info-current-node)
;; Install the link type
-(org-add-link-type "info" 'org-info-open)
-(add-hook 'org-store-link-functions 'org-info-store-link)
+(org-link-set-parameters "info"
+ :follow #'org-info-open
+ :export #'org-info-export
+ :store #'org-info-store-link)
;; Implementation
(defun org-info-store-link ()
"Store a link to an Info file and node."
(when (eq major-mode 'Info-mode)
- (let (link desc)
- (setq link (concat "info:"
- (file-name-nondirectory Info-current-file)
- "#" Info-current-node))
- (setq desc (concat (file-name-nondirectory Info-current-file)
- "#" Info-current-node))
+ (let ((link (concat "info:"
+ (file-name-nondirectory Info-current-file)
+ "#" Info-current-node))
+ (desc (concat (file-name-nondirectory Info-current-file)
+ "#" Info-current-node)))
(org-store-link-props :type "info" :file Info-current-file
:node Info-current-node
:link link :desc desc)
@@ -67,12 +68,80 @@
"Follow an Info file and node link specified by NAME."
(if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name)
(string-match "\\(.*\\)" name))
- (progn
+ (let ((filename (match-string 1 name))
+ (nodename-or-index (or (match-string 2 name) "Top")))
(require 'info)
- (if (match-string 2 name) ; If there isn't a node, choose "Top"
- (Info-find-node (match-string 1 name) (match-string 2 name))
- (Info-find-node (match-string 1 name) "Top")))
- (message "Could not open: %s" name)))
+ ;; If nodename-or-index is invalid node name, then look it up
+ ;; in the index.
+ (condition-case nil
+ (Info-find-node filename nodename-or-index)
+ (user-error (Info-find-node filename "Top")
+ (condition-case nil
+ (Info-index nodename-or-index)
+ (user-error "Could not find '%s' node or index entry"
+ nodename-or-index)))))
+ (user-error "Could not open: %s" name)))
+
+(defconst org-info-emacs-documents
+ '("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x"
+ "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp"
+ "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww"
+ "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el"
+ "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs"
+ "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve"
+ "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper"
+ "widget" "wisent" "woman")
+ "List of emacs documents available.
+Taken from <https://www.gnu.org/software/emacs/manual/html_mono/.>")
+
+(defconst org-info-other-documents
+ '(("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html")
+ ("make" . "https://www.gnu.org/software/make/manual/make.html"))
+ "Alist of documents generated from Texinfo source.
+When converting info links to HTML, links to any one of these manuals are
+converted to use these URL.")
+
+(defun org-info-map-html-url (filename)
+ "Return URL or HTML file associated to Info FILENAME.
+If FILENAME refers to an official GNU document, return a URL pointing to
+the official page for that document, e.g., use \"gnu.org\" for all Emacs
+related documents. Otherwise, append \".html\" extension to FILENAME.
+See `org-info-emacs-documents' and `org-info-other-documents' for details."
+ (cond ((member filename org-info-emacs-documents)
+ (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html"
+ filename))
+ ((cdr (assoc filename org-info-other-documents)))
+ (t (concat filename ".html"))))
+
+(defun org-info--expand-node-name (node)
+ "Expand Info NODE to HTML cross reference."
+ ;; See (info "(texinfo) HTML Xref Node Name Expansion") for the
+ ;; expansion rule.
+ (let ((node (replace-regexp-in-string
+ "\\([ \t\n\r]+\\)\\|\\([^a-zA-Z0-9]\\)"
+ (lambda (m)
+ (if (match-end 1) "-" (format "_%04x" (string-to-char m))))
+ (org-trim node))))
+ (cond ((string= node "") "")
+ ((string-match-p "\\`[0-9]" node) (concat "g_t" node))
+ (t node))))
+
+(defun org-info-export (path desc format)
+ "Export an info link.
+See `org-link-parameters' for details about PATH, DESC and FORMAT."
+ (let* ((parts (split-string path "[#:]:?"))
+ (manual (car parts))
+ (node (or (nth 1 parts) "Top")))
+ (pcase format
+ (`html
+ (format "<a href=\"%s#%s\">%s</a>"
+ (org-info-map-html-url manual)
+ (org-info--expand-node-name node)
+ (or desc path)))
+ (`texinfo
+ (let ((title (or desc "")))
+ (format "@ref{%s,%s,,%s,}" node title manual)))
+ (_ nil))))
(provide 'org-info)
diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el
index bf4ab205a4c..4a8e43db03b 100644
--- a/lisp/org/org-inlinetask.el
+++ b/lisp/org/org-inlinetask.el
@@ -1,4 +1,4 @@
-;;; org-inlinetask.el --- Tasks independent of outline hierarchy
+;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;;
@@ -20,13 +20,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
-;; This module implements inline tasks in Org-mode. Inline tasks are
+;; This module implements inline tasks in Org mode. Inline tasks are
;; tasks that have all the properties of normal outline nodes,
;; including the ability to store meta data like scheduling dates,
;; TODO state, tags and properties. However, these nodes are treated
@@ -108,14 +108,13 @@ When nil, the first star is not shown."
(defvar org-odd-levels-only)
(defvar org-keyword-time-regexp)
-(defvar org-drawer-regexp)
(defvar org-complex-heading-regexp)
(defvar org-property-end-re)
(defcustom org-inlinetask-default-state nil
"Non-nil means make inline tasks have a TODO keyword initially.
This should be the state `org-inlinetask-insert-task' should use by
-default, or nil of no state should be assigned."
+default, or nil if no state should be assigned."
:group 'org-inlinetask
:version "24.1"
:type '(choice
@@ -168,9 +167,9 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(stars-re (org-inlinetask-outline-regexp))
(task-beg-re (concat stars-re "\\(?:.*\\)"))
(task-end-re (concat stars-re "END[ \t]*$")))
- (or (org-looking-at-p task-beg-re)
+ (or (looking-at-p task-beg-re)
(and (re-search-forward "^\\*+[ \t]+" nil t)
- (progn (beginning-of-line) (org-looking-at-p task-end-re)))))))
+ (progn (beginning-of-line) (looking-at-p task-end-re)))))))
(defun org-inlinetask-goto-beginning ()
"Go to the beginning of the inline task at point."
@@ -178,7 +177,7 @@ The number of levels is controlled by `org-inlinetask-min-level'."
(let ((case-fold-search t)
(inlinetask-re (org-inlinetask-outline-regexp)))
(re-search-backward inlinetask-re nil t)
- (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$"))
+ (when (looking-at-p (concat inlinetask-re "END[ \t]*$"))
(re-search-backward inlinetask-re nil t))))
(defun org-inlinetask-goto-end ()
@@ -190,17 +189,16 @@ Return point."
(inlinetask-re (org-inlinetask-outline-regexp))
(task-end-re (concat inlinetask-re "END[ \t]*$")))
(cond
- ((looking-at task-end-re) (forward-line))
+ ((looking-at task-end-re))
((looking-at inlinetask-re)
(forward-line)
(cond
- ((looking-at task-end-re) (forward-line))
+ ((looking-at task-end-re))
((looking-at inlinetask-re))
((org-inlinetask-in-task-p)
- (re-search-forward inlinetask-re nil t)
- (forward-line))))
- (t (re-search-forward inlinetask-re nil t)
- (forward-line)))
+ (re-search-forward inlinetask-re nil t))))
+ (t (re-search-forward inlinetask-re nil t)))
+ (end-of-line)
(point))))
(defun org-inlinetask-get-task-level ()
@@ -273,8 +271,7 @@ If the task has an end part, also demote it."
(defvar org-indent-indentation-per-level) ; defined in org-indent.el
-(defface org-inlinetask
- (org-compatible-face 'shadow '((t (:bold t))))
+(defface org-inlinetask '((t :inherit shadow))
"Face for inlinetask headlines."
:group 'org-faces)
@@ -288,7 +285,7 @@ If the task has an end part, also demote it."
",\\}\\)\\(\\*\\* .*\\)"))
;; Virtual indentation will add the warning face on the first
;; star. Thus, in that case, only hide it.
- (start-face (if (and (org-bound-and-true-p org-indent-mode)
+ (start-face (if (and (bound-and-true-p org-indent-mode)
(> org-indent-indentation-per-level 1))
'org-hide
'org-warning)))
@@ -315,19 +312,36 @@ If the task has an end part, also demote it."
;; Nothing to show/hide.
((= end start))
;; Inlinetask was folded: expand it.
- ((get-char-property (1+ start) 'invisible)
+ ((eq (get-char-property (1+ start) 'invisible) 'outline)
(outline-flag-region start end nil)
(org-cycle-hide-drawers 'children))
(t (outline-flag-region start end t)))))
+(defun org-inlinetask-hide-tasks (state)
+ "Hide inline tasks in buffer when STATE is `contents' or `children'.
+This function is meant to be used in `org-cycle-hook'."
+ (pcase state
+ (`contents
+ (let ((regexp (org-inlinetask-outline-regexp)))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (org-inlinetask-toggle-visibility)
+ (org-inlinetask-goto-end)))))
+ (`children
+ (save-excursion
+ (while (and (outline-next-heading) (org-inlinetask-at-task-p))
+ (org-inlinetask-toggle-visibility)
+ (org-inlinetask-goto-end))))))
+
(defun org-inlinetask-remove-END-maybe ()
"Remove an END line when present."
(when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$"
org-inlinetask-min-level))
(replace-match "")))
-(eval-after-load "org"
- '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify))
+(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)
+(add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks)
(provide 'org-inlinetask)
diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el
index 1243587beb8..3617ae92422 100644
--- a/lisp/org/org-irc.el
+++ b/lisp/org/org-irc.el
@@ -1,4 +1,4 @@
-;;; org-irc.el --- Store links to IRC sessions
+;;; org-irc.el --- Store Links to IRC Sessions -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
;;
@@ -18,12 +18,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;; This file implements links to an IRC session from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to an IRC session from within Org mode.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;
;; Please customize the variable `org-modules' to select
@@ -50,20 +50,20 @@
(require 'org)
-;; Declare the function form ERC that we use.
+(declare-function erc-buffer-filter "erc" (predicate &optional proc))
+(declare-function erc-channel-p "erc" (channel))
+(declare-function erc-cmd-JOIN "erc" (channel &optional key))
(declare-function erc-current-logfile "erc-log" (&optional buffer))
-(declare-function erc-prompt "erc" ())
(declare-function erc-default-target "erc" ())
-(declare-function erc-channel-p "erc" (channel))
-(declare-function erc-buffer-filter "erc" (predicate &optional proc))
-(declare-function erc-server-buffer "erc" ())
(declare-function erc-get-server-nickname-list "erc" ())
-(declare-function erc-cmd-JOIN "erc" (channel &optional key))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
+(declare-function erc-logging-enabled "erc-log" (&optional buffer))
+(declare-function erc-prompt "erc" ())
+(declare-function erc-save-buffer-in-logs "erc-log" (&optional buffer))
+(declare-function erc-server-buffer "erc" ())
(defvar org-irc-client 'erc
"The IRC client to act on.")
+
(defvar org-irc-link-to-logs nil
"Non-nil will store a link to the logs, nil will store an irc: style link.")
@@ -73,9 +73,7 @@
;; Generic functions/config (extend these for other clients)
-(add-to-list 'org-store-link-functions 'org-irc-store-link)
-
-(org-add-link-type "irc" 'org-irc-visit nil)
+(org-link-set-parameters "irc" :follow #'org-irc-visit :store #'org-irc-store-link)
(defun org-irc-visit (link)
"Parse LINK and dispatch to the correct function based on the client found."
@@ -114,11 +112,9 @@ chars that the value AFTER with `...'"
(cons "[ \t]*$" "")
(cons (concat "^\\(.\\{" after
"\\}\\).*") "\\1..."))))
- (mapc (lambda (x)
- (when (string-match (car x) string)
- (setq string (replace-match (cdr x) nil nil string))))
- replace-map)
- string))
+ (dolist (x replace-map string)
+ (when (string-match (car x) string)
+ (setq string (replace-match (cdr x) nil nil string))))))
;; ERC specific functions
@@ -211,7 +207,8 @@ default."
(require 'erc)
(require 'erc-log)
(let* ((server (car (car link)))
- (port (or (string-to-number (cadr (pop link))) erc-default-port))
+ (port (let ((p (cadr (pop link))))
+ (if p (string-to-number p) erc-default-port)))
(server-buffer)
(buffer-list
(erc-buffer-filter
@@ -233,7 +230,7 @@ default."
(throw 'found x))))))
(if chan-buf
(progn
- (org-pop-to-buffer-same-window chan-buf)
+ (pop-to-buffer-same-window chan-buf)
;; if we got a nick, and they're in the chan,
;; then start a chat with them
(let ((nick (pop link)))
@@ -244,9 +241,9 @@ default."
(insert (concat nick ": ")))
(error "%s not found in %s" nick chan-name)))))
(progn
- (org-pop-to-buffer-same-window server-buffer)
+ (pop-to-buffer-same-window server-buffer)
(erc-cmd-JOIN chan-name))))
- (org-pop-to-buffer-same-window server-buffer)))
+ (pop-to-buffer-same-window server-buffer)))
;; no server match, make new connection
(erc-select :server server :port port))))
diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el
new file mode 100644
index 00000000000..8372ae0fb85
--- /dev/null
+++ b/lisp/org/org-lint.el
@@ -0,0 +1,1242 @@
+;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
+;; Keywords: outlines, hypermedia, calendar, wp
+
+;; 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 library implements linting for Org syntax. The sole public
+;; function is `org-lint', which see.
+
+;; Internally, the library defines a new structure:
+;; `org-lint-checker', with the following slots:
+
+;; - NAME: Unique check identifier, as a non-nil symbol that doesn't
+;; start with an hyphen.
+;;
+;; The check is done calling the function `org-lint-NAME' with one
+;; mandatory argument, the parse tree describing the current Org
+;; buffer. Such function calls are wrapped within
+;; a `save-excursion' and point is always at `point-min'. Its
+;; return value has to be an alist (POSITION MESSAGE) when
+;; POSITION refer to the buffer position of the error, as an
+;; integer, and MESSAGE is a string describing the error.
+
+;; - DESCRIPTION: Summary about the check, as a string.
+
+;; - CATEGORIES: Categories relative to the check, as a list of
+;; symbol. They are used for filtering when calling `org-lint'.
+;; Checkers not explicitly associated to a category are collected
+;; in the `default' one.
+
+;; - TRUST: The trust level one can have in the check. It is either
+;; `low' or `high', depending on the heuristics implemented and
+;; the nature of the check. This has an indicative value only and
+;; is displayed along reports.
+
+;; All checks have to be listed in `org-lint--checkers'.
+
+;; Results are displayed in a special "*Org Lint*" buffer with
+;; a dedicated major mode, derived from `tabulated-list-mode'.
+;;
+;; In addition to the usual key-bindings inherited from it, "C-j" and
+;; "TAB" display problematic line reported under point whereas "RET"
+;; jumps to it. Also, "h" hides all reports similar to the current
+;; one. Additionally, "i" removes them from subsequent reports.
+
+;; Checks currently implemented are:
+
+;; - duplicate CUSTOM_ID properties
+;; - duplicate NAME values
+;; - duplicate targets
+;; - duplicate footnote definitions
+;; - orphaned affiliated keywords
+;; - obsolete affiliated keywords
+;; - missing language in src blocks
+;; - missing back-end in export blocks
+;; - invalid Babel call blocks
+;; - NAME values with a colon
+;; - deprecated export block syntax
+;; - deprecated Babel header properties
+;; - wrong header arguments in src blocks
+;; - misuse of CATEGORY keyword
+;; - "coderef" links with unknown destination
+;; - "custom-id" links with unknown destination
+;; - "fuzzy" links with unknown destination
+;; - "id" links with unknown destination
+;; - links to non-existent local files
+;; - SETUPFILE keywords with non-existent file parameter
+;; - INCLUDE keywords with wrong link parameter
+;; - obsolete markup in INCLUDE keyword
+;; - unknown items in OPTIONS keyword
+;; - spurious macro arguments or invalid macro templates
+;; - special properties in properties drawer
+;; - obsolete syntax for PROPERTIES drawers
+;; - Invalid EFFORT property value
+;; - missing definition for footnote references
+;; - missing reference for footnote definitions
+;; - non-footnote definitions in footnote section
+;; - probable invalid keywords
+;; - invalid blocks
+;; - misplaced planning info line
+;; - incomplete drawers
+;; - indented diary-sexps
+;; - obsolete QUOTE section
+;; - obsolete "file+application" link
+;; - blank headlines with tags
+
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'org-element)
+(require 'org-macro)
+(require 'ox)
+(require 'ob)
+
+
+;;; Checkers
+
+(cl-defstruct (org-lint-checker (:copier nil))
+ (name 'missing-checker-name)
+ (description "")
+ (categories '(default))
+ (trust 'high)) ; `low' or `high'
+
+(defun org-lint-missing-checker-name (_)
+ (error
+ "`A checker has no `:name' property. Please verify `org-lint--checkers'"))
+
+(defconst org-lint--checkers
+ (list
+ (make-org-lint-checker
+ :name 'duplicate-custom-id
+ :description "Report duplicates CUSTOM_ID properties"
+ :categories '(link))
+ (make-org-lint-checker
+ :name 'duplicate-name
+ :description "Report duplicate NAME values"
+ :categories '(babel link))
+ (make-org-lint-checker
+ :name 'duplicate-target
+ :description "Report duplicate targets"
+ :categories '(link))
+ (make-org-lint-checker
+ :name 'duplicate-footnote-definition
+ :description "Report duplicate footnote definitions"
+ :categories '(footnote))
+ (make-org-lint-checker
+ :name 'orphaned-affiliated-keywords
+ :description "Report orphaned affiliated keywords"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'obsolete-affiliated-keywords
+ :description "Report obsolete affiliated keywords"
+ :categories '(obsolete))
+ (make-org-lint-checker
+ :name 'deprecated-export-blocks
+ :description "Report deprecated export block syntax"
+ :categories '(obsolete export)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'deprecated-header-syntax
+ :description "Report deprecated Babel header syntax"
+ :categories '(obsolete babel)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'missing-language-in-src-block
+ :description "Report missing language in src blocks"
+ :categories '(babel))
+ (make-org-lint-checker
+ :name 'missing-backend-in-export-block
+ :description "Report missing back-end in export blocks"
+ :categories '(export))
+ (make-org-lint-checker
+ :name 'invalid-babel-call-block
+ :description "Report invalid Babel call blocks"
+ :categories '(babel))
+ (make-org-lint-checker
+ :name 'colon-in-name
+ :description "Report NAME values with a colon"
+ :categories '(babel))
+ (make-org-lint-checker
+ :name 'wrong-header-argument
+ :description "Report wrong babel headers"
+ :categories '(babel))
+ (make-org-lint-checker
+ :name 'wrong-header-value
+ :description "Report invalid value in babel headers"
+ :categories '(babel)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'deprecated-category-setup
+ :description "Report misuse of CATEGORY keyword"
+ :categories '(obsolete))
+ (make-org-lint-checker
+ :name 'invalid-coderef-link
+ :description "Report \"coderef\" links with unknown destination"
+ :categories '(link))
+ (make-org-lint-checker
+ :name 'invalid-custom-id-link
+ :description "Report \"custom-id\" links with unknown destination"
+ :categories '(link))
+ (make-org-lint-checker
+ :name 'invalid-fuzzy-link
+ :description "Report \"fuzzy\" links with unknown destination"
+ :categories '(link))
+ (make-org-lint-checker
+ :name 'invalid-id-link
+ :description "Report \"id\" links with unknown destination"
+ :categories '(link))
+ (make-org-lint-checker
+ :name 'link-to-local-file
+ :description "Report links to non-existent local files"
+ :categories '(link)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'non-existent-setupfile-parameter
+ :description "Report SETUPFILE keywords with non-existent file parameter"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'wrong-include-link-parameter
+ :description "Report INCLUDE keywords with misleading link parameter"
+ :categories '(export)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'obsolete-include-markup
+ :description "Report obsolete markup in INCLUDE keyword"
+ :categories '(obsolete export)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'unknown-options-item
+ :description "Report unknown items in OPTIONS keyword"
+ :categories '(export)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'invalid-macro-argument-and-template
+ :description "Report spurious macro arguments or invalid macro templates"
+ :categories '(export)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'special-property-in-properties-drawer
+ :description "Report special properties in properties drawers"
+ :categories '(properties))
+ (make-org-lint-checker
+ :name 'obsolete-properties-drawer
+ :description "Report obsolete syntax for properties drawers"
+ :categories '(obsolete properties))
+ (make-org-lint-checker
+ :name 'invalid-effort-property
+ :description "Report invalid duration in EFFORT property"
+ :categories '(properties))
+ (make-org-lint-checker
+ :name 'undefined-footnote-reference
+ :description "Report missing definition for footnote references"
+ :categories '(footnote))
+ (make-org-lint-checker
+ :name 'unreferenced-footnote-definition
+ :description "Report missing reference for footnote definitions"
+ :categories '(footnote))
+ (make-org-lint-checker
+ :name 'extraneous-element-in-footnote-section
+ :description "Report non-footnote definitions in footnote section"
+ :categories '(footnote))
+ (make-org-lint-checker
+ :name 'invalid-keyword-syntax
+ :description "Report probable invalid keywords"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'invalid-block
+ :description "Report invalid blocks"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'misplaced-planning-info
+ :description "Report misplaced planning info line"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'incomplete-drawer
+ :description "Report probable incomplete drawers"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'indented-diary-sexp
+ :description "Report probable indented diary-sexps"
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'quote-section
+ :description "Report obsolete QUOTE section"
+ :categories '(obsolete)
+ :trust 'low)
+ (make-org-lint-checker
+ :name 'file-application
+ :description "Report obsolete \"file+application\" link"
+ :categories '(link obsolete))
+ (make-org-lint-checker
+ :name 'empty-headline-with-tags
+ :description "Report ambiguous empty headlines with tags"
+ :categories '(headline)
+ :trust 'low))
+ "List of all available checkers.")
+
+(defun org-lint--collect-duplicates
+ (ast type extract-key extract-position build-message)
+ "Helper function to collect duplicates in parse tree AST.
+
+EXTRACT-KEY is a function extracting key. It is called with
+a single argument: the element or object. Comparison is done
+with `equal'.
+
+EXTRACT-POSITION is a function returning position for the report.
+It is called with two arguments, the object or element, and the
+key.
+
+BUILD-MESSAGE is a function creating the report message. It is
+called with one argument, the key used for comparison."
+ (let* (keys
+ originals
+ reports
+ (make-report
+ (lambda (position value)
+ (push (list position (funcall build-message value)) reports))))
+ (org-element-map ast type
+ (lambda (datum)
+ (let ((key (funcall extract-key datum)))
+ (cond
+ ((not key))
+ ((assoc key keys) (cl-pushnew (assoc key keys) originals)
+ (funcall make-report (funcall extract-position datum key) key))
+ (t (push (cons key (funcall extract-position datum key)) keys))))))
+ (dolist (e originals reports) (funcall make-report (cdr e) (car e)))))
+
+(defun org-lint-duplicate-custom-id (ast)
+ (org-lint--collect-duplicates
+ ast
+ 'node-property
+ (lambda (property)
+ (and (eq (compare-strings "CUSTOM_ID" nil nil
+ (org-element-property :key property) nil nil
+ t)
+ t)
+ (org-element-property :value property)))
+ (lambda (property _) (org-element-property :begin property))
+ (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
+
+(defun org-lint-duplicate-name (ast)
+ (org-lint--collect-duplicates
+ ast
+ org-element-all-elements
+ (lambda (datum) (org-element-property :name datum))
+ (lambda (datum name)
+ (goto-char (org-element-property :begin datum))
+ (re-search-forward
+ (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name)))
+ (match-beginning 0))
+ (lambda (key) (format "Duplicate NAME \"%s\"" key))))
+
+(defun org-lint-duplicate-target (ast)
+ (org-lint--collect-duplicates
+ ast
+ 'target
+ (lambda (target) (split-string (org-element-property :value target)))
+ (lambda (target _) (org-element-property :begin target))
+ (lambda (key)
+ (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
+
+(defun org-lint-duplicate-footnote-definition (ast)
+ (org-lint--collect-duplicates
+ ast
+ 'footnote-definition
+ (lambda (definition) (org-element-property :label definition))
+ (lambda (definition _) (org-element-property :post-affiliated definition))
+ (lambda (key) (format "Duplicate footnote definition \"%s\"" key))))
+
+(defun org-lint-orphaned-affiliated-keywords (ast)
+ ;; Ignore orphan RESULTS keywords, which could be generated from
+ ;; a source block returning no value.
+ (let ((keywords (cl-set-difference org-element-affiliated-keywords
+ '("RESULT" "RESULTS")
+ :test #'equal)))
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (let ((key (org-element-property :key k)))
+ (and (or (let ((case-fold-search t))
+ (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
+ (member key keywords))
+ (list (org-element-property :post-affiliated k)
+ (format "Orphaned affiliated keyword: \"%s\"" key))))))))
+
+(defun org-lint-obsolete-affiliated-keywords (_)
+ (let ((regexp (format "^[ \t]*#\\+%s:"
+ (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
+ "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
+ t)))
+ reports)
+ (while (re-search-forward regexp nil t)
+ (let ((key (upcase (match-string-no-properties 1))))
+ (when (< (point)
+ (org-element-property :post-affiliated (org-element-at-point)))
+ (push
+ (list (line-beginning-position)
+ (format
+ "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead"
+ key
+ (pcase key
+ ("HEADERS" "HEADER")
+ ("RESULT" "RESULTS")
+ (_ "NAME"))))
+ reports))))
+ reports))
+
+(defun org-lint-deprecated-export-blocks (ast)
+ (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
+ "ODT" "ORG" "TEXINFO")))
+ (org-element-map ast 'special-block
+ (lambda (b)
+ (let ((type (org-element-property :type b)))
+ (when (member-ignore-case type deprecated)
+ (list
+ (org-element-property :post-affiliated b)
+ (format
+ "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
+instead"
+ type))))))))
+
+(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))
+ (deprecated-re
+ (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
+ (org-element-map ast '(keyword node-property)
+ (lambda (datum)
+ (let ((key (org-element-property :key datum)))
+ (pcase (org-element-type datum)
+ (`keyword
+ (let ((value (org-element-property :value datum)))
+ (and (string= key "PROPERTY")
+ (string-match deprecated-re value)
+ (list (org-element-property :begin datum)
+ (format "Deprecated syntax for \"%s\". \
+Use header-args instead"
+ (match-string-no-properties 1 value))))))
+ (`node-property
+ (and (member-ignore-case key deprecated-babel-properties)
+ (list
+ (org-element-property :begin datum)
+ (format "Deprecated syntax for \"%s\". \
+Use :header-args: instead"
+ key))))))))))
+
+(defun org-lint-missing-language-in-src-block (ast)
+ (org-element-map ast 'src-block
+ (lambda (b)
+ (unless (org-element-property :language b)
+ (list (org-element-property :post-affiliated b)
+ "Missing language in source block")))))
+
+(defun org-lint-missing-backend-in-export-block (ast)
+ (org-element-map ast 'export-block
+ (lambda (b)
+ (unless (org-element-property :type b)
+ (list (org-element-property :post-affiliated b)
+ "Missing back-end in export block")))))
+
+(defun org-lint-invalid-babel-call-block (ast)
+ (org-element-map ast 'babel-call
+ (lambda (b)
+ (cond
+ ((not (org-element-property :call b))
+ (list (org-element-property :post-affiliated b)
+ "Invalid syntax in babel call block"))
+ ((let ((h (org-element-property :end-header b)))
+ (and h (string-match-p "\\`\\[.*\\]\\'" h)))
+ (list
+ (org-element-property :post-affiliated b)
+ "Babel call's end header must not be wrapped within brackets"))))))
+
+(defun org-lint-deprecated-category-setup (ast)
+ (org-element-map ast 'keyword
+ (let (category-flag)
+ (lambda (k)
+ (cond
+ ((not (string= (org-element-property :key k) "CATEGORY")) nil)
+ (category-flag
+ (list (org-element-property :post-affiliated k)
+ "Spurious CATEGORY keyword. Set :CATEGORY: property instead"))
+ (t (setf category-flag t) nil))))))
+
+(defun org-lint-invalid-coderef-link (ast)
+ (let ((info (list :parse-tree ast)))
+ (org-element-map ast 'link
+ (lambda (link)
+ (let ((ref (org-element-property :path link)))
+ (and (equal (org-element-property :type link) "coderef")
+ (not (ignore-errors (org-export-resolve-coderef ref info)))
+ (list (org-element-property :begin link)
+ (format "Unknown coderef \"%s\"" ref))))))))
+
+(defun org-lint-invalid-custom-id-link (ast)
+ (let ((info (list :parse-tree ast)))
+ (org-element-map ast 'link
+ (lambda (link)
+ (and (equal (org-element-property :type link) "custom-id")
+ (not (ignore-errors (org-export-resolve-id-link link info)))
+ (list (org-element-property :begin link)
+ (format "Unknown custom ID \"%s\""
+ (org-element-property :path link))))))))
+
+(defun org-lint-invalid-fuzzy-link (ast)
+ (let ((info (list :parse-tree ast)))
+ (org-element-map ast 'link
+ (lambda (link)
+ (and (equal (org-element-property :type link) "fuzzy")
+ (not (ignore-errors (org-export-resolve-fuzzy-link link info)))
+ (list (org-element-property :begin link)
+ (format "Unknown fuzzy location \"%s\""
+ (let ((path (org-element-property :path link)))
+ (if (string-prefix-p "*" path)
+ (substring path 1)
+ path)))))))))
+
+(defun org-lint-invalid-id-link (ast)
+ (org-element-map ast 'link
+ (lambda (link)
+ (let ((id (org-element-property :path link)))
+ (and (equal (org-element-property :type link) "id")
+ (not (org-id-find id))
+ (list (org-element-property :begin link)
+ (format "Unknown ID \"%s\"" id)))))))
+
+(defun org-lint-special-property-in-properties-drawer (ast)
+ (org-element-map ast 'node-property
+ (lambda (p)
+ (let ((key (org-element-property :key p)))
+ (and (member-ignore-case key org-special-properties)
+ (list (org-element-property :begin p)
+ (format
+ "Special property \"%s\" found in a properties drawer"
+ key)))))))
+
+(defun org-lint-obsolete-properties-drawer (ast)
+ (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"))))))))
+
+(defun org-lint-invalid-effort-property (ast)
+ (org-element-map ast 'node-property
+ (lambda (p)
+ (when (equal "EFFORT" (org-element-property :key p))
+ (let ((value (org-element-property :value p)))
+ (and (org-string-nw-p value)
+ (not (org-duration-p value))
+ (list (org-element-property :begin p)
+ (format "Invalid effort duration format: %S" value))))))))
+
+(defun org-lint-link-to-local-file (ast)
+ (org-element-map ast 'link
+ (lambda (l)
+ (when (equal (org-element-property :type l) "file")
+ (let ((file (org-link-unescape (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))))))))
+
+(defun org-lint-non-existent-setupfile-parameter (ast)
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (equal (org-element-property :key k) "SETUPFILE")
+ (let ((file (org-unbracket-string
+ "\"" "\""
+ (org-element-property :value k))))
+ (and (not (file-remote-p file))
+ (not (file-exists-p file))
+ (list (org-element-property :begin k)
+ (format "Non-existent setup file \"%s\"" file))))))))
+
+(defun org-lint-wrong-include-link-parameter (ast)
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (equal (org-element-property :key k) "INCLUDE")
+ (let* ((value (org-element-property :value k))
+ (path
+ (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
+ (save-match-data
+ (org-unbracket-string "\"" "\"" (match-string 1 value))))))
+ (if (not path)
+ (list (org-element-property :post-affiliated k)
+ "Missing location argument in INCLUDE keyword")
+ (let* ((file (org-string-nw-p
+ (if (string-match "::\\(.*\\)\\'" path)
+ (substring path 0 (match-beginning 0))
+ path)))
+ (search (and (not (equal file path))
+ (org-string-nw-p (match-string 1 path)))))
+ (if (and file
+ (not (file-remote-p file))
+ (not (file-exists-p file)))
+ (list (org-element-property :post-affiliated k)
+ "Non-existent file argument in INCLUDE keyword")
+ (let* ((visiting (if file (find-buffer-visiting file)
+ (current-buffer)))
+ (buffer (or visiting (find-file-noselect file))))
+ (unwind-protect
+ (with-current-buffer buffer
+ (when (and search
+ (not
+ (ignore-errors
+ (let ((org-link-search-inhibit-query t))
+ (org-link-search search nil t)))))
+ (list (org-element-property :post-affiliated k)
+ (format
+ "Invalid search part \"%s\" in INCLUDE keyword"
+ search))))
+ (unless visiting (kill-buffer buffer))))))))))))
+
+(defun org-lint-obsolete-include-markup (ast)
+ (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
+ (regexp-opt
+ '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
+ "ODT" "ORG" "TEXINFO")
+ t))))
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (equal (org-element-property :key k) "INCLUDE")
+ (let ((case-fold-search t)
+ (value (org-element-property :value k)))
+ (when (string-match regexp value)
+ (let ((markup (match-string-no-properties 1 value)))
+ (list (org-element-property :post-affiliated k)
+ (format "Obsolete markup \"%s\" in INCLUDE keyword. \
+Use \"export %s\" instead"
+ markup
+ markup))))))))))
+
+(defun org-lint-unknown-options-item (ast)
+ (let ((allowed (delq nil
+ (append
+ (mapcar (lambda (o) (nth 2 o)) org-export-options-alist)
+ (cl-mapcan
+ (lambda (b)
+ (mapcar (lambda (o) (nth 2 o))
+ (org-export-backend-options b)))
+ org-export-registered-backends))))
+ reports)
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (string= (org-element-property :key k) "OPTIONS")
+ (let ((value (org-element-property :value k))
+ (start 0))
+ (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*"
+ value
+ start)
+ (setf start (match-end 0))
+ (let ((item (match-string 1 value)))
+ (unless (member item allowed)
+ (push (list (org-element-property :post-affiliated k)
+ (format "Unknown OPTIONS item \"%s\"" item))
+ reports))))))))
+ reports))
+
+(defun org-lint-invalid-macro-argument-and-template (ast)
+ (let ((extract-placeholders
+ (lambda (template)
+ (let ((start 0)
+ args)
+ (while (string-match "\\$\\([1-9][0-9]*\\)" template start)
+ (setf start (match-end 0))
+ (push (string-to-number (match-string 1 template)) args))
+ (sort (org-uniquify args) #'<))))
+ reports)
+ ;; Check arguments for macro templates.
+ (org-element-map ast 'keyword
+ (lambda (k)
+ (when (string= (org-element-property :key k) "MACRO")
+ (let* ((value (org-element-property :value k))
+ (name (and (string-match "^\\S-+" value)
+ (match-string 0 value)))
+ (template (and name
+ (org-trim (substring value (match-end 0))))))
+ (cond
+ ((not name)
+ (push (list (org-element-property :post-affiliated k)
+ "Missing name in MACRO keyword")
+ reports))
+ ((not (org-string-nw-p template))
+ (push (list (org-element-property :post-affiliated k)
+ "Missing template in macro \"%s\"" name)
+ reports))
+ (t
+ (unless (let ((args (funcall extract-placeholders template)))
+ (equal (number-sequence 1 (or (org-last args) 0)) args))
+ (push (list (org-element-property :post-affiliated k)
+ (format "Unused placeholders in macro \"%s\""
+ name))
+ reports))))))))
+ ;; Check arguments for macros.
+ (org-macro-initialize-templates)
+ (let ((templates (append
+ (mapcar (lambda (m) (cons m "$1"))
+ '("author" "date" "email" "title" "results"))
+ org-macro-templates)))
+ (org-element-map ast 'macro
+ (lambda (macro)
+ (let* ((name (org-element-property :key macro))
+ (template (cdr (assoc-string name templates t))))
+ (if (not template)
+ (push (list (org-element-property :begin macro)
+ (format "Undefined macro \"%s\"" name))
+ reports)
+ (let ((arg-numbers (funcall extract-placeholders template)))
+ (when arg-numbers
+ (let ((spurious-args
+ (nthcdr (apply #'max arg-numbers)
+ (org-element-property :args macro))))
+ (when spurious-args
+ (push
+ (list (org-element-property :begin macro)
+ (format "Unused argument%s in macro \"%s\": %s"
+ (if (> (length spurious-args) 1) "s" "")
+ name
+ (mapconcat (lambda (a) (format "\"%s\"" a))
+ spurious-args
+ ", ")))
+ reports))))))))))
+ reports))
+
+(defun org-lint-undefined-footnote-reference (ast)
+ (let ((definitions (org-element-map ast 'footnote-definition
+ (lambda (f) (org-element-property :label f)))))
+ (org-element-map ast 'footnote-reference
+ (lambda (f)
+ (let ((label (org-element-property :label f)))
+ (and (eq 'standard (org-element-property :type f))
+ (not (member label definitions))
+ (list (org-element-property :begin f)
+ (format "Missing definition for footnote [%s]"
+ label))))))))
+
+(defun org-lint-unreferenced-footnote-definition (ast)
+ (let ((references (org-element-map ast 'footnote-reference
+ (lambda (f) (org-element-property :label f)))))
+ (org-element-map ast 'footnote-definition
+ (lambda (f)
+ (let ((label (org-element-property :label f)))
+ (and label
+ (not (member label references))
+ (list (org-element-property :post-affiliated f)
+ (format "No reference for footnote definition [%s]"
+ label))))))))
+
+(defun org-lint-colon-in-name (ast)
+ (org-element-map ast org-element-all-elements
+ (lambda (e)
+ (let ((name (org-element-property :name e)))
+ (and name
+ (string-match-p ":" name)
+ (list (progn
+ (goto-char (org-element-property :begin e))
+ (re-search-forward
+ (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name)))
+ (match-beginning 0))
+ (format
+ "Name \"%s\" contains a colon; Babel cannot use it as input"
+ name)))))))
+
+(defun org-lint-misplaced-planning-info (_)
+ (let ((case-fold-search t)
+ reports)
+ (while (re-search-forward org-planning-line-re nil t)
+ (unless (memq (org-element-type (org-element-at-point))
+ '(comment-block example-block export-block planning
+ src-block verse-block))
+ (push (list (line-beginning-position) "Misplaced planning info line")
+ reports)))
+ reports))
+
+(defun org-lint-incomplete-drawer (_)
+ (let (reports)
+ (while (re-search-forward org-drawer-regexp nil t)
+ (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)
+ ((or `comment-block `example-block `export-block `src-block
+ `verse-block)
+ nil)
+ (_
+ (push (list (line-beginning-position)
+ (format "Possible incomplete drawer \"%s\"" name))
+ reports)))))
+ reports))
+
+(defun org-lint-indented-diary-sexp (_)
+ (let (reports)
+ (while (re-search-forward "^[ \t]+%%(" nil t)
+ (unless (memq (org-element-type (org-element-at-point))
+ '(comment-block diary-sexp example-block export-block
+ src-block verse-block))
+ (push (list (line-beginning-position) "Possible indented diary-sexp")
+ reports)))
+ reports))
+
+(defun org-lint-invalid-block (_)
+ (let ((case-fold-search t)
+ (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
+ reports)
+ (while (re-search-forward regexp nil t)
+ (let ((name (org-trim (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position)))))
+ (cond
+ ((and (string-prefix-p "END" (match-string 1) t)
+ (not (eolp)))
+ (push (list (line-beginning-position)
+ (format "Invalid block closing line \"%s\"" name))
+ reports))
+ ((not (memq (org-element-type (org-element-at-point))
+ '(center-block comment-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block)))
+ (push (list (line-beginning-position)
+ (format "Possible incomplete block \"%s\""
+ name))
+ reports)))))
+ reports))
+
+(defun org-lint-invalid-keyword-syntax (_)
+ (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
+ (exception-re
+ (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
+ (regexp-opt org-element-dual-keywords)))
+ reports)
+ (while (re-search-forward regexp nil t)
+ (let ((name (match-string-no-properties 1)))
+ (unless (or (string-prefix-p "BEGIN" name t)
+ (string-prefix-p "END" name t)
+ (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at exception-re))))
+ (push (list (match-beginning 0)
+ (format "Possible missing colon in keyword \"%s\"" name))
+ reports))))
+ reports))
+
+(defun org-lint-extraneous-element-in-footnote-section (ast)
+ (org-element-map ast 'headline
+ (lambda (h)
+ (and (org-element-property :footnote-section-p h)
+ (org-element-map (org-element-contents h)
+ (cl-remove-if
+ (lambda (e)
+ (memq e '(comment comment-block footnote-definition
+ property-drawer section)))
+ org-element-all-elements)
+ (lambda (e)
+ (not (and (eq (org-element-type e) 'headline)
+ (org-element-property :commentedp e))))
+ nil t '(footnote-definition property-drawer))
+ (list (org-element-property :begin h)
+ "Extraneous elements in footnote section are not exported")))))
+
+(defun org-lint-quote-section (ast)
+ (org-element-map ast '(headline inlinetask)
+ (lambda (h)
+ (let ((title (org-element-property :raw-value h)))
+ (and (or (string-prefix-p "QUOTE " title)
+ (string-prefix-p (concat org-comment-string " QUOTE ") title))
+ (list (org-element-property :begin h)
+ "Deprecated QUOTE section"))))))
+
+(defun org-lint-file-application (ast)
+ (org-element-map ast 'link
+ (lambda (l)
+ (let ((app (org-element-property :application l)))
+ (and app
+ (list (org-element-property :begin l)
+ (format "Deprecated \"file+%s\" link type" app)))))))
+
+(defun org-lint-wrong-header-argument (ast)
+ (let* ((reports)
+ (verify
+ (lambda (datum language headers)
+ (let ((allowed
+ ;; If LANGUAGE is specified, restrict allowed
+ ;; headers to both LANGUAGE-specific and default
+ ;; ones. Otherwise, accept headers from any loaded
+ ;; language.
+ (append
+ org-babel-header-arg-names
+ (cl-mapcan
+ (lambda (l)
+ (let ((v (intern (format "org-babel-header-args:%s" l))))
+ (and (boundp v) (mapcar #'car (symbol-value v)))))
+ (if language (list language)
+ (mapcar #'car org-babel-load-languages))))))
+ (dolist (header headers)
+ (let ((h (symbol-name (car header)))
+ (p (or (org-element-property :post-affiliated datum)
+ (org-element-property :begin datum))))
+ (cond
+ ((not (string-prefix-p ":" h))
+ (push
+ (list p
+ (format "Missing colon in header argument \"%s\"" h))
+ reports))
+ ((assoc-string (substring h 1) allowed))
+ (t (push (list p (format "Unknown header argument \"%s\"" h))
+ reports)))))))))
+ (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword
+ node-property src-block)
+ (lambda (datum)
+ (pcase (org-element-type datum)
+ ((or `babel-call `inline-babel-call)
+ (funcall verify
+ datum
+ nil
+ (cl-mapcan #'org-babel-parse-header-arguments
+ (list
+ (org-element-property :inside-header datum)
+ (org-element-property :end-header datum)))))
+ (`inline-src-block
+ (funcall verify
+ datum
+ (org-element-property :language datum)
+ (org-babel-parse-header-arguments
+ (org-element-property :parameters datum))))
+ (`keyword
+ (when (string= (org-element-property :key datum) "PROPERTY")
+ (let ((value (org-element-property :value datum)))
+ (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *"
+ value)
+ (funcall verify
+ datum
+ (match-string 1 value)
+ (org-babel-parse-header-arguments
+ (substring value (match-end 0))))))))
+ (`node-property
+ (let ((key (org-element-property :key datum)))
+ (when (let ((case-fold-search t))
+ (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?"
+ key))
+ (funcall verify
+ datum
+ (match-string 1 key)
+ (org-babel-parse-header-arguments
+ (org-element-property :value datum))))))
+ (`src-block
+ (funcall verify
+ datum
+ (org-element-property :language datum)
+ (cl-mapcan #'org-babel-parse-header-arguments
+ (cons (org-element-property :parameters datum)
+ (org-element-property :header datum))))))))
+ reports))
+
+(defun org-lint-wrong-header-value (ast)
+ (let (reports)
+ (org-element-map ast
+ '(babel-call inline-babel-call inline-src-block src-block)
+ (lambda (datum)
+ (let* ((type (org-element-type datum))
+ (language (org-element-property :language datum))
+ (allowed-header-values
+ (append (and language
+ (let ((v (intern (concat "org-babel-header-args:"
+ language))))
+ (and (boundp v) (symbol-value v))))
+ org-babel-common-header-args-w-values))
+ (datum-header-values
+ (org-babel-parse-header-arguments
+ (org-trim
+ (pcase type
+ (`src-block
+ (mapconcat
+ #'identity
+ (cons (org-element-property :parameters datum)
+ (org-element-property :header datum))
+ " "))
+ (`inline-src-block
+ (or (org-element-property :parameters datum) ""))
+ (_
+ (concat
+ (org-element-property :inside-header datum)
+ " "
+ (org-element-property :end-header datum))))))))
+ (dolist (header datum-header-values)
+ (let ((allowed-values
+ (cdr (assoc-string (substring (symbol-name (car header)) 1)
+ allowed-header-values))))
+ (unless (memq allowed-values '(:any nil))
+ (let ((values (cdr header))
+ groups-alist)
+ (dolist (v (if (stringp values) (split-string values)
+ (list values)))
+ (let ((valid-value nil))
+ (catch 'exit
+ (dolist (group allowed-values)
+ (cond
+ ((not (funcall
+ (if (stringp v) #'assoc-string #'assoc)
+ v group))
+ (when (memq :any group)
+ (setf valid-value t)
+ (push (cons group v) groups-alist)))
+ ((assq group groups-alist)
+ (push
+ (list
+ (or (org-element-property :post-affiliated datum)
+ (org-element-property :begin datum))
+ (format
+ "Forbidden combination in header \"%s\": %s, %s"
+ (car header)
+ (cdr (assq group groups-alist))
+ v))
+ reports)
+ (throw 'exit nil))
+ (t (push (cons group v) groups-alist)
+ (setf valid-value t))))
+ (unless valid-value
+ (push
+ (list
+ (or (org-element-property :post-affiliated datum)
+ (org-element-property :begin datum))
+ (format "Unknown value \"%s\" for header \"%s\""
+ v
+ (car header)))
+ reports))))))))))))
+ reports))
+
+(defun org-lint-empty-headline-with-tags (ast)
+ (org-element-map ast '(headline inlinetask)
+ (lambda (h)
+ (let ((title (org-element-property :raw-value h)))
+ (and (string-match-p "\\`:[[:alnum:]_@#%:]+:\\'" title)
+ (list (org-element-property :begin h)
+ (format "Headline containing only tags is ambiguous: %S"
+ title)))))))
+
+
+;;; Reports UI
+
+(defvar org-lint--report-mode-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map tabulated-list-mode-map)
+ (define-key map (kbd "RET") 'org-lint--jump-to-source)
+ (define-key map (kbd "TAB") 'org-lint--show-source)
+ (define-key map (kbd "C-j") 'org-lint--show-source)
+ (define-key map (kbd "h") 'org-lint--hide-checker)
+ (define-key map (kbd "i") 'org-lint--ignore-checker)
+ map)
+ "Local keymap for `org-lint--report-mode' buffers.")
+
+(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
+ "Major mode used to display reports emitted during linting.
+\\{org-lint--report-mode-map}"
+ (setf tabulated-list-format
+ `[("Line" 6
+ (lambda (a b)
+ (< (string-to-number (aref (cadr a) 0))
+ (string-to-number (aref (cadr b) 0))))
+ :right-align t)
+ ("Trust" 5 t)
+ ("Warning" 0 t)])
+ (tabulated-list-init-header))
+
+(defun org-lint--generate-reports (buffer checkers)
+ "Generate linting report for BUFFER.
+
+CHECKERS is the list of checkers used.
+
+Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
+for `tabulated-list-printer'."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (let ((ast (org-element-parse-buffer))
+ (id 0)
+ (last-line 1)
+ (last-pos 1))
+ ;; Insert unique ID for each report. Replace buffer positions
+ ;; with line numbers.
+ (mapcar
+ (lambda (report)
+ (list
+ (cl-incf id)
+ (apply #'vector
+ (cons
+ (progn
+ (goto-char (car report))
+ (beginning-of-line)
+ (prog1 (number-to-string
+ (cl-incf last-line
+ (count-lines last-pos (point))))
+ (setf last-pos (point))))
+ (cdr report)))))
+ ;; Insert trust level in generated reports. Also sort them
+ ;; by buffer position in order to optimize lines computation.
+ (sort (cl-mapcan
+ (lambda (c)
+ (let ((trust (symbol-name (org-lint-checker-trust c))))
+ (mapcar
+ (lambda (report)
+ (list (car report) trust (nth 1 report) c))
+ (save-excursion
+ (funcall
+ (intern (format "org-lint-%s"
+ (org-lint-checker-name c)))
+ ast)))))
+ checkers)
+ #'car-less-than-car))))))
+
+(defvar-local org-lint--source-buffer nil
+ "Source buffer associated to current report buffer.")
+
+(defvar-local org-lint--local-checkers nil
+ "List of checkers used to build current report.")
+
+(defun org-lint--refresh-reports ()
+ (setq tabulated-list-entries
+ (org-lint--generate-reports org-lint--source-buffer
+ org-lint--local-checkers))
+ (tabulated-list-print))
+
+(defun org-lint--current-line ()
+ "Return current report line, as a number."
+ (string-to-number (aref (tabulated-list-get-entry) 0)))
+
+(defun org-lint--current-checker (&optional entry)
+ "Return current report checker.
+When optional argument ENTRY is non-nil, use this entry instead
+of current one."
+ (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
+
+(defun org-lint--display-reports (source checkers)
+ "Display linting reports for buffer SOURCE.
+CHECKERS is the list of checkers used."
+ (let ((buffer (get-buffer-create "*Org Lint*")))
+ (with-current-buffer buffer
+ (org-lint--report-mode)
+ (setf org-lint--source-buffer source)
+ (setf org-lint--local-checkers checkers)
+ (org-lint--refresh-reports)
+ (tabulated-list-print)
+ (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
+ (pop-to-buffer buffer)))
+
+(defun org-lint--jump-to-source ()
+ "Move to source line that generated the report at point."
+ (interactive)
+ (let ((l (org-lint--current-line)))
+ (switch-to-buffer-other-window org-lint--source-buffer)
+ (org-goto-line l)
+ (org-show-set-visibility 'local)
+ (recenter)))
+
+(defun org-lint--show-source ()
+ "Show source line that generated the report at point."
+ (interactive)
+ (let ((buffer (current-buffer)))
+ (org-lint--jump-to-source)
+ (switch-to-buffer-other-window buffer)))
+
+(defun org-lint--hide-checker ()
+ "Hide all reports from checker that generated the report at point."
+ (interactive)
+ (let ((c (org-lint--current-checker)))
+ (setf tabulated-list-entries
+ (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
+ tabulated-list-entries))
+ (tabulated-list-print)))
+
+(defun org-lint--ignore-checker ()
+ "Ignore all reports from checker that generated the report at point.
+Checker will also be ignored in all subsequent reports."
+ (interactive)
+ (setf org-lint--local-checkers
+ (remove (org-lint--current-checker) org-lint--local-checkers))
+ (org-lint--hide-checker))
+
+
+;;; Public function
+
+;;;###autoload
+(defun org-lint (&optional arg)
+ "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."
+ (interactive "P")
+ (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
+ (when (called-interactively-p 'any)
+ (message "Org linting process starting..."))
+ (let ((checkers
+ (pcase arg
+ (`nil org-lint--checkers)
+ (`(4)
+ (let ((category
+ (completing-read
+ "Checker category: "
+ (mapcar #'org-lint-checker-categories org-lint--checkers)
+ nil t)))
+ (cl-remove-if-not
+ (lambda (c)
+ (assoc-string (org-lint-checker-categories c) category))
+ org-lint--checkers)))
+ (`(16)
+ (list
+ (let ((name (completing-read
+ "Checker name: "
+ (mapcar #'org-lint-checker-name org-lint--checkers)
+ nil t)))
+ (catch 'exit
+ (dolist (c org-lint--checkers)
+ (when (string= (org-lint-checker-name c) name)
+ (throw 'exit c)))))))
+ ((pred consp)
+ (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
+ org-lint--checkers))
+ (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
+ (if (not (called-interactively-p 'any))
+ (org-lint--generate-reports (current-buffer) checkers)
+ (org-lint--display-reports (current-buffer) checkers)
+ (message "Org linting process completed"))))
+
+
+(provide 'org-lint)
+;;; org-lint.el ends here
diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el
index a24c496d726..5b292d0ca46 100644
--- a/lisp/org/org-list.el
+++ b/lisp/org/org-list.el
@@ -1,4 +1,4 @@
-;;; org-list.el --- Plain lists for Org-mode
+;;; org-list.el --- Plain lists for Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
;;
@@ -20,12 +20,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the code dealing with plain lists in Org-mode.
+;; This file contains the code dealing with plain lists in Org mode.
;; The core concept behind lists is their structure. A structure is
;; a snapshot of the list, in the shape of a data tree (see
@@ -76,8 +76,7 @@
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
@@ -88,59 +87,84 @@
(defvar org-closed-string)
(defvar org-deadline-string)
(defvar org-description-max-indent)
-(defvar org-drawers)
+(defvar org-done-keywords)
+(defvar org-drawer-regexp)
+(defvar org-element-all-objects)
+(defvar org-inhibit-startup)
(defvar org-odd-levels-only)
+(defvar org-outline-regexp-bol)
(defvar org-scheduled-string)
+(defvar org-todo-line-regexp)
(defvar org-ts-regexp)
(defvar org-ts-regexp-both)
-(declare-function outline-invisible-p "outline" (&optional pos))
-(declare-function outline-flag-region "outline" (from to flag))
-(declare-function outline-next-heading "outline" ())
-(declare-function outline-previous-heading "outline" ())
-
-(declare-function org-at-heading-p "org" (&optional ignored))
-(declare-function org-before-first-heading-p "org" ())
+(declare-function org-at-heading-p "org" (&optional invisible-ok))
(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-before-first-heading-p "org" ())
(declare-function org-combine-plists "org" (&rest plists))
-(declare-function org-count "org" (cl-item cl-seq))
(declare-function org-current-level "org" ())
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-interpret-data "org-element" (data))
+(declare-function
+ org-element-lineage "org-element" (blob &optional types with-self))
+(declare-function org-element-macro-interpreter "org-element" (macro ##))
+(declare-function
+ org-element-map "org-element"
+ (data types fun &optional info first-match no-recursion with-affiliated))
+(declare-function org-element-normalize-string "org-element" (s))
+(declare-function org-element-parse-buffer "org-element"
+ (&optional granularity visible-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element"
+ (element property value))
+(declare-function org-element-set-element "org-element" (old new))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-update-syntax "org-element" ())
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
+(declare-function org-export-create-backend "ox" (&rest rest) t)
+(declare-function org-export-data-with-backend "ox" (data backend info))
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export-get-environment "ox"
+ (&optional backend subtreep ext-plist))
+(declare-function org-export-get-next-element "ox"
+ (blob info &optional n))
+(declare-function org-export-with-backend "ox"
+ (backend data &optional contents info))
(declare-function org-fix-tags-on-the-fly "org" ())
(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-get-todo-state "org" ())
(declare-function org-in-block-p "org" (names))
(declare-function org-in-regexp "org" (re &optional nlines visually))
+(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-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-level-increment "org" ())
(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-at-heading-p "org" (&optional invisible-ok))
-(declare-function org-previous-line-empty-p "org" (&optional next))
-(declare-function org-remove-if "org" (predicate seq))
+(declare-function org-outline-level "org" ())
+(declare-function org-previous-line-empty-p "org" ())
(declare-function org-reduced-level "org" (L))
+(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-show-subtree "org" ())
(declare-function org-sort-remove-invisible "org" (S))
(declare-function org-time-string-to-seconds "org" (s))
(declare-function org-timer-hms-to-secs "org-timer" (hms))
(declare-function org-timer-item "org-timer" (&optional arg))
-(declare-function org-trim "org" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
(declare-function org-uniquify "org" (list))
-
-(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-inlinetask-outline-regexp "org-inlinetask" ())
-
-(declare-function org-export-string-as "ox"
- (string backend &optional body-only ext-plist))
-
+(declare-function org-invisible-p "org" (&optional pos))
+(declare-function outline-flag-region "outline" (from to flag))
+(declare-function outline-next-heading "outline" ())
+(declare-function outline-previous-heading "outline" ())
;;; Configuration variables
(defgroup org-plain-lists nil
- "Options concerning plain lists in Org-mode."
+ "Options concerning plain lists in Org mode."
:tag "Org Plain lists"
:group 'org-structure)
@@ -211,14 +235,20 @@ into
(defcustom org-plain-list-ordered-item-terminator t
"The character that makes a line with leading number an ordered list item.
-Valid values are ?. and ?\). To get both terminators, use t."
+Valid values are ?. and ?\). To get both terminators, use t.
+
+This variable needs to be set before org.el is loaded. If you
+need to make a change while Emacs is running, use the customize
+interface or run the following code after updating it:
+
+ `\\[org-element-update-syntax]'"
:group 'org-plain-lists
:type '(choice (const :tag "dot like in \"2.\"" ?.)
(const :tag "paren like in \"2)\"" ?\))
- (const :tag "both" t)))
+ (const :tag "both" t))
+ :set (lambda (var val) (set var val)
+ (when (featurep 'org-element) (org-element-update-syntax))))
-(define-obsolete-variable-alias 'org-alphabetical-lists
- 'org-list-allow-alphabetical "24.4") ; Since 8.0
(defcustom org-list-allow-alphabetical nil
"Non-nil means single character alphabetical bullets are allowed.
@@ -230,13 +260,12 @@ This variable needs to be set before org.el is loaded. If you
need to make a change while Emacs is running, use the customize
interface or run the following code after updating it:
- (when (featurep \\='org-element) (load \"org-element\" t t))"
+ `\\[org-element-update-syntax]'"
:group 'org-plain-lists
:version "24.1"
:type 'boolean
- :set (lambda (var val)
- (when (featurep 'org-element) (load "org-element" t t))
- (set var val)))
+ :set (lambda (var val) (set var val)
+ (when (featurep 'org-element) (org-element-update-syntax))))
(defcustom org-list-two-spaces-after-bullet-regexp nil
"A regular expression matching bullets that should have 2 spaces after them.
@@ -250,23 +279,22 @@ spaces instead of one after the bullet in each item of the list."
(const :tag "never" nil)
(regexp)))
-(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists
- 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0
-(defcustom org-list-empty-line-terminates-plain-lists nil
- "Non-nil means an empty line ends all plain list levels.
-Otherwise, two of them will be necessary."
- :group 'org-plain-lists
- :type 'boolean)
-
(defcustom org-list-automatic-rules '((checkbox . t)
(indent . t))
"Non-nil means apply set of rules when acting on lists.
+\\<org-mode-map>
By default, automatic actions are taken when using
- \\[org-meta-return], \\[org-metaright], \\[org-metaleft],
- \\[org-shiftmetaright], \\[org-shiftmetaleft],
- \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
- \\[org-insert-todo-heading]. You can disable individually these
- rules by setting them to nil. Valid rules are:
+ `\\[org-meta-return]',
+ `\\[org-metaright]',
+ `\\[org-metaleft]',
+ `\\[org-shiftmetaright]',
+ `\\[org-shiftmetaleft]',
+ `\\[org-ctrl-c-minus]',
+ `\\[org-toggle-checkbox]',
+ `\\[org-insert-todo-heading]'.
+
+You can disable individually these rules by setting them to nil.
+Valid rules are:
checkbox when non-nil, checkbox statistics is updated each time
you either insert a new checkbox or toggle a checkbox.
@@ -286,13 +314,15 @@ indent when non-nil, indenting or outdenting list top-item
(defcustom org-list-use-circular-motion nil
"Non-nil means commands implying motion in lists should be cyclic.
-
+\\<org-mode-map>
In that case, the item following the last item is the first one,
and the item preceding the first item is the last one.
-This affects the behavior of \\[org-move-item-up],
- \\[org-move-item-down], \\[org-next-item] and
- \\[org-previous-item]."
+This affects the behavior of
+ `\\[org-move-item-up]',
+ `\\[org-move-item-down]',
+ `\\[org-next-item]',
+ `\\[org-previous-item]'."
:group 'org-plain-lists
:version "24.1"
:type 'boolean)
@@ -304,8 +334,6 @@ This hook runs even if checkbox rule in
implement alternative ways of collecting statistics
information.")
-(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics
- 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0
(defcustom org-checkbox-hierarchical-statistics t
"Non-nil means checkbox statistics counts only the state of direct children.
When nil, all boxes below the cookie are counted.
@@ -314,8 +342,6 @@ with the word \"recursive\" in the value."
:group 'org-plain-lists
:type 'boolean)
-(org-defvaralias 'org-description-max-indent
- 'org-list-description-max-indent) ;; Since 8.0
(defcustom org-list-description-max-indent 20
"Maximum indentation for the second line of a description list.
When the indentation would be larger than this, it will become
@@ -358,8 +384,7 @@ list, obtained by prompting the user."
(list (symbol :tag "Major mode")
(string :tag "Format"))))
-(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer"
- "html" "latex" "odt")
+(defvar org-list-forbidden-blocks '("example" "verse" "src" "export")
"Names of blocks where lists are not allowed.
Names must be in lower case.")
@@ -374,10 +399,8 @@ specifically, type `block' is determined by the variable
;;; Predicates and regexps
-(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n"
- "^[ \t]*\n[ \t]*\n")
- "Regex corresponding to the end of a list.
-It depends on `org-list-empty-line-terminates-plain-lists'.")
+(defconst org-list-end-re "^[ \t]*\n[ \t]*\n"
+ "Regex matching the end of a plain list.")
(defconst org-list-full-item-re
(concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
@@ -430,9 +453,6 @@ group 4: description tag")
(let* ((case-fold-search t)
(context (org-list-context))
(lim-up (car context))
- (drawers-re (concat "^[ \t]*:\\("
- (mapconcat #'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(item-re (org-item-re))
@@ -476,7 +496,7 @@ group 4: description tag")
((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((and (looking-at "^[ \t]*:END:")
- (re-search-backward drawers-re lim-up t))
+ (re-search-backward org-drawer-regexp lim-up t))
(beginning-of-line))
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning)
@@ -547,11 +567,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'."
(lim-down (or (save-excursion (outline-next-heading)) (point-max))))
;; Is point inside a drawer?
(let ((end-re "^[ \t]*:END:")
- ;; Can't use org-drawers-regexp as this function might
- ;; be called in buffers not in Org mode.
- (beg-re (concat "^[ \t]*:\\("
- (mapconcat #'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")))
+ (beg-re org-drawer-regexp))
(when (save-excursion
(and (not (looking-at beg-re))
(not (looking-at end-re))
@@ -635,9 +651,6 @@ Assume point is at an item."
(lim-down (nth 1 context))
(text-min-ind 10000)
(item-re (org-item-re))
- (drawers-re (concat "^[ \t]*:\\("
- (mapconcat #'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask)
(org-inlinetask-outline-regexp)))
(beg-cell (cons (point) (org-get-indentation)))
@@ -654,7 +667,7 @@ Assume point is at an item."
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
- (and (save-match-data (string-match "[-+*]" bullet))
+ (and (string-match-p "[-+*]" bullet)
(match-string-no-properties 4)))))))
(end-before-blank
(function
@@ -700,7 +713,7 @@ Assume point is at an item."
((and (looking-at "^[ \t]*#\\+end_")
(re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
((and (looking-at "^[ \t]*:END:")
- (re-search-backward drawers-re lim-up t))
+ (re-search-backward org-drawer-regexp lim-up t))
(beginning-of-line))
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning)
@@ -766,7 +779,7 @@ Assume point is at an item."
(cond
((and (looking-at "^[ \t]*#\\+begin_")
(re-search-forward "^[ \t]*#\\+end_" lim-down t)))
- ((and (looking-at drawers-re)
+ ((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:" lim-down t))))
(forward-line 1))))))
(setq struct (append itm-lst (cdr (nreverse itm-lst-2)))
@@ -1021,7 +1034,7 @@ Possible types are `descriptive', `ordered' and `unordered'. The
type is determined by the first item of the list."
(let ((first (org-list-get-list-begin item struct prevs)))
(cond
- ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
+ ((string-match-p "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
((org-list-get-tag first struct) 'descriptive)
(t 'unordered))))
@@ -1043,7 +1056,7 @@ that value."
(let ((seq 0) (pos item) counter)
(while (and (not (setq counter (org-list-get-counter pos struct)))
(setq pos (org-list-get-prev-item pos struct prevs)))
- (incf seq))
+ (cl-incf seq))
(if (not counter) (1+ seq)
(cond
((string-match "[A-Za-z]" counter)
@@ -1137,13 +1150,20 @@ This function modifies STRUCT."
;; Store overlays responsible for visibility status. We
;; also need to store their boundaries as they will be
;; removed from buffer.
- (overlays (cons
- (mapcar (lambda (ov)
- (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-A end-A))
- (mapcar (lambda (ov)
- (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-B end-B)))))
+ (overlays
+ (cons
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-A)
+ (<= (overlay-end o) end-A)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-A end-A)))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-B)
+ (<= (overlay-end o) end-B)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-B end-B))))))
;; 1. Move effectively items in buffer.
(goto-char beg-A)
(delete-region beg-A end-B-no-blank)
@@ -1154,42 +1174,39 @@ This function modifies STRUCT."
;; as empty spaces are not moved there. In others words,
;; item BEG-A will end with whitespaces that were at the end
;; of BEG-B and the same applies to BEG-B.
- (mapc (lambda (e)
- (let ((pos (car e)))
- (cond
- ((< pos beg-A))
- ((memq pos sub-A)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
- (setcar (nthcdr 6 e)
- (+ end-e (- end-B-no-blank end-A-no-blank)))
- (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
- ((memq pos sub-B)
- (let ((end-e (nth 6 e)))
- (setcar e (- (+ pos beg-A) beg-B))
- (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
- (when (= end-e end-B)
- (setcar (nthcdr 6 e)
- (+ beg-A size-B (- end-A end-A-no-blank))))))
- ((< pos beg-B)
- (let ((end-e (nth 6 e)))
- (setcar e (+ pos (- size-B size-A)))
- (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
- struct)
- (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))
+ (dolist (e struct)
+ (let ((pos (car e)))
+ (cond
+ ((< pos beg-A))
+ ((memq pos sub-A)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
+ (setcar (nthcdr 6 e)
+ (+ end-e (- end-B-no-blank end-A-no-blank)))
+ (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
+ ((memq pos sub-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (- (+ pos beg-A) beg-B))
+ (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
+ (when (= end-e end-B)
+ (setcar (nthcdr 6 e)
+ (+ beg-A size-B (- end-A end-A-no-blank))))))
+ ((< pos beg-B)
+ (let ((end-e (nth 6 e)))
+ (setcar e (+ pos (- size-B size-A)))
+ (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
+ (setq struct (sort struct #'car-less-than-car))
;; Restore visibility status, by moving overlays to their new
;; position.
- (mapc (lambda (ov)
- (move-overlay
- (car ov)
- (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
- (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
- (car overlays))
- (mapc (lambda (ov)
- (move-overlay (car ov)
- (+ (nth 1 ov) (- beg-A beg-B))
- (+ (nth 2 ov) (- beg-A beg-B))))
- (cdr overlays))
+ (dolist (ov (car overlays))
+ (move-overlay
+ (car ov)
+ (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A))
+ (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A))))
+ (dolist (ov (cdr overlays))
+ (move-overlay (car ov)
+ (+ (nth 1 ov) (- beg-A beg-B))
+ (+ (nth 2 ov) (- beg-A beg-B))))
;; Return structure.
struct)))
@@ -1219,7 +1236,7 @@ some heuristics to guess the result."
(point))))))))
(cond
;; Trivial cases where there should be none.
- ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0)
+ ((not insert-blank-p) 0)
;; When `org-blank-before-new-entry' says so, it is 1.
((eq insert-blank-p t) 1)
;; `plain-list-item' is 'auto. Count blank lines separating
@@ -1272,12 +1289,16 @@ This function modifies STRUCT."
(beforep
(progn
(looking-at org-list-full-item-re)
- ;; Do not count tag in a non-descriptive list.
- (<= pos (if (and (match-beginning 4)
- (save-match-data
- (string-match "[.)]" (match-string 1))))
- (match-beginning 4)
- (match-end 0)))))
+ (<= 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))
@@ -1317,7 +1338,7 @@ This function modifies STRUCT."
(size-offset (- item-size (length text-cut))))
;; 4. Insert effectively item into buffer.
(goto-char item)
- (org-indent-to-column ind)
+ (indent-to-column ind)
(insert body item-sep)
;; 5. Add new item to STRUCT.
(mapc (lambda (e)
@@ -1459,7 +1480,7 @@ This function returns, destructively, the new list structure."
(save-excursion
(goto-char (org-list-get-last-item item struct prevs))
(point-at-eol)))
- ((string-match "\\`[0-9]+\\'" dest)
+ ((string-match-p "\\`[0-9]+\\'" dest)
(let* ((all (org-list-get-all-items item struct prevs))
(len (length all))
(index (mod (string-to-number dest) len)))
@@ -1473,8 +1494,10 @@ This function returns, destructively, the new list structure."
(point-at-eol)))))
(t dest)))
(org-M-RET-may-split-line nil)
- ;; Store visibility.
- (visibility (overlays-in item item-end)))
+ ;; Store inner overlays (to preserve visibility).
+ (overlays (cl-remove-if (lambda (o) (or (< (overlay-start o) item)
+ (> (overlay-end o) item)))
+ (overlays-in item item-end))))
(cond
((eq dest 'delete) (org-list-delete-item item struct))
((eq dest 'kill)
@@ -1509,13 +1532,12 @@ This function returns, destructively, the new list structure."
new-end
(+ end shift)))))))
moved-items))
- (lambda (e1 e2) (< (car e1) (car e2))))))
- ;; 2. Restore visibility.
- (mapc (lambda (ov)
- (move-overlay ov
- (+ (overlay-start ov) (- (point) item))
- (+ (overlay-end ov) (- (point) item))))
- visibility)
+ #'car-less-than-car)))
+ ;; 2. Restore inner overlays.
+ (dolist (o overlays)
+ (move-overlay o
+ (+ (overlay-start o) (- (point) item))
+ (+ (overlay-end o) (- (point) item))))
;; 3. Eventually delete extra copy of the item and clean marker.
(prog1 (org-list-delete-item (marker-position item) struct)
(move-marker item nil)))
@@ -1632,7 +1654,7 @@ as returned by `org-list-prevs-alist'."
(while item
(let ((count (org-list-get-counter item struct)))
;; Virtually determine current bullet
- (if (and count (string-match "[a-zA-Z]" count))
+ (if (and count (string-match-p "[a-zA-Z]" count))
;; Counters are not case-sensitive.
(setq ascii (string-to-char (upcase count)))
(setq ascii (1+ ascii)))
@@ -1861,10 +1883,9 @@ Initial position of cursor is restored after the changes."
(item-re (org-item-re))
(shift-body-ind
(function
- ;; Shift the indentation between END and BEG by DELTA. If
- ;; MAX-IND is non-nil, ensure that no line will be indented
- ;; more than that number. Start from the line before END.
- (lambda (end beg delta max-ind)
+ ;; Shift the indentation between END and BEG by DELTA.
+ ;; Start from the line before END.
+ (lambda (end beg delta)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
@@ -1876,10 +1897,8 @@ Initial position of cursor is restored after the changes."
((and inlinetask-re (looking-at inlinetask-re))
(org-inlinetask-goto-beginning))
;; Shift only non-empty lines.
- ((org-looking-at-p "^[ \t]*\\S-")
- (let ((i (org-get-indentation)))
- (org-indent-line-to
- (if max-ind (min (+ i delta) max-ind) (+ i delta))))))
+ ((looking-at-p "^[ \t]*\\S-")
+ (indent-line-to (+ (org-get-indentation) delta))))
(forward-line -1)))))
(modify-item
(function
@@ -1934,37 +1953,53 @@ Initial position of cursor is restored after the changes."
;; 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 '>)))
+ (let ((item-up (assoc-default end-pos acc-end #'>)))
(push (cons end-pos item-up) end-list)))
(push (cons end-pos pos) acc-end)))
;; 2. Slice the items into parts that should be shifted by the
;; same amount of indentation. Each slice follow the pattern
- ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in
- ;; reverse order.
+ ;; (END BEG DELTA). Slices are returned in reverse order.
(setq all-ends (sort (append (mapcar #'car itm-shift)
(org-uniquify (mapcar #'car end-list)))
- '<))
+ #'<)
+ acc-end (nreverse acc-end))
(while (cdr all-ends)
(let* ((up (pop all-ends))
(down (car all-ends))
(itemp (assq up struct))
- (item (if itemp up (cdr (assq up end-list))))
- (ind (cdr (assq item itm-shift)))
- ;; If we're not at an item, there's a child of the item
- ;; point belongs to above. Make sure this slice isn't
- ;; moved within that child by specifying a maximum
- ;; indentation.
- (max-ind (and (not itemp)
- (+ (org-list-get-ind item struct)
- (length (org-list-get-bullet item struct))
- org-list-indent-offset))))
- (push (list down up ind max-ind) sliced-struct)))
+ (delta
+ (if itemp (cdr (assq up itm-shift))
+ ;; If we're not at an item, there's a child of the
+ ;; item point belongs to above. Make sure the less
+ ;; indented line in this slice has the same column
+ ;; as that child.
+ (let* ((child (cdr (assq up acc-end)))
+ (ind (org-list-get-ind child struct))
+ (min-ind most-positive-fixnum))
+ (save-excursion
+ (goto-char up)
+ (while (< (point) down)
+ ;; Ignore empty lines. Also ignore blocks and
+ ;; drawers contents.
+ (unless (looking-at-p "[ \t]*$")
+ (setq min-ind (min (org-get-indentation) min-ind))
+ (cond
+ ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ (re-search-forward
+ (format "^[ \t]*#\\+END%s[ \t]*$"
+ (match-string 1))
+ down t)))
+ ((and (looking-at org-drawer-regexp)
+ (re-search-forward "^[ \t]*:END:[ \t]*$"
+ down t)))))
+ (forward-line)))
+ (- ind min-ind)))))
+ (push (list down up delta) sliced-struct)))
;; 3. Shift each slice in buffer, provided delta isn't 0, from
;; end to beginning. Take a special action when beginning is
;; at item bullet.
(dolist (e sliced-struct)
- (unless (and (zerop (nth 2 e)) (not (nth 3 e)))
- (apply shift-body-ind e))
+ (unless (zerop (nth 2 e)) (apply shift-body-ind e))
(let* ((beg (nth 1 e))
(cell (assq beg struct)))
(unless (or (not cell) (equal cell (assq beg old-struct)))
@@ -2060,16 +2095,27 @@ Possible values are: `folded', `children' or `subtree'. See
(defun org-list-item-body-column (item)
"Return column at which body of ITEM should start."
- (let (bpos bcol tpos tcol)
- (save-excursion
- (goto-char item)
- (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)")
- (setq bpos (match-beginning 1) tpos (match-end 0)
- bcol (progn (goto-char bpos) (current-column))
- tcol (progn (goto-char tpos) (current-column)))
- (when (> tcol (+ bcol org-description-max-indent))
- (setq tcol (+ bcol 5))))
- tcol))
+ (save-excursion
+ (goto-char item)
+ (if (save-excursion
+ (end-of-line)
+ (re-search-backward
+ "[ \t]::\\([ \t]\\|$\\)" (line-beginning-position) t))
+ ;; Descriptive list item. Body starts after item's tag, if
+ ;; possible.
+ (let ((start (1+ (- (match-beginning 1) (line-beginning-position))))
+ (ind (org-get-indentation)))
+ (if (> start (+ ind org-list-description-max-indent))
+ (+ ind 5)
+ start))
+ ;; Regular item. Body starts after bullet.
+ (looking-at "[ \t]*\\(\\S-+\\)")
+ (+ (progn (goto-char (match-end 1)) (current-column))
+ (if (and org-list-two-spaces-after-bullet-regexp
+ (string-match-p org-list-two-spaces-after-bullet-regexp
+ (match-string 1)))
+ 2
+ 1)))))
@@ -2204,13 +2250,14 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet.
Return t when things worked, nil when we are not in an item, or
item is invisible."
+ (interactive "P")
(let ((itemp (org-in-item-p))
(pos (point)))
;; If cursor isn't is a list or if list is invisible, return nil.
(unless (or (not itemp)
(save-excursion
(goto-char itemp)
- (outline-invisible-p)))
+ (org-invisible-p)))
(if (save-excursion
(goto-char itemp)
(org-at-item-timer-p))
@@ -2325,9 +2372,6 @@ in subtree, ignoring drawers."
block-item
lim-up
lim-down
- (drawer-re (concat "^[ \t]*:\\("
- (mapconcat #'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$"))
(keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string
"\\|" org-deadline-string
"\\|" org-closed-string
@@ -2349,7 +2393,8 @@ in subtree, ignoring drawers."
;; time-stamps (scheduled, etc.).
(let ((limit (save-excursion (outline-next-heading) (point))))
(forward-line 1)
- (while (or (looking-at drawer-re) (looking-at keyword-re))
+ (while (or (looking-at org-drawer-regexp)
+ (looking-at keyword-re))
(if (looking-at keyword-re)
(forward-line 1)
(re-search-forward "^[ \t]*:END:" limit nil)))
@@ -2388,7 +2433,7 @@ in subtree, ignoring drawers."
(parents (org-list-parents-alist struct))
(prevs (org-list-prevs-alist struct))
(bottom (copy-marker (org-list-get-bottom-point struct)))
- (items-to-toggle (org-remove-if
+ (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
@@ -2439,130 +2484,129 @@ in subtree, ignoring drawers."
(defun org-update-checkbox-count (&optional all)
"Update the checkbox statistics in the current section.
+
This will find all statistic cookies like [57%] and [6/12] and
update them with the current numbers.
With optional prefix argument ALL, do this for the whole buffer."
(interactive "P")
- (save-excursion
- (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
+ (org-with-wide-buffer
+ (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+ (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
(recursivep
(or (not org-checkbox-hierarchical-statistics)
(string-match "\\<recursive\\>"
(or (org-entry-get nil "COOKIE_DATA") ""))))
- (bounds (if all
- (cons (point-min) (point-max))
- (cons (or (ignore-errors (org-back-to-heading t) (point))
- (point-min))
- (save-excursion (outline-next-heading) (point)))))
+ (within-inlinetask (and (not all)
+ (featurep 'org-inlinetask)
+ (org-inlinetask-in-task-p)))
+ (end (cond (all (point-max))
+ (within-inlinetask
+ (save-excursion (outline-next-heading) (point)))
+ (t (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point)))))
(count-boxes
- (function
- ;; Return number of checked boxes and boxes of all types
- ;; in all structures in STRUCTS. If RECURSIVEP is
- ;; non-nil, also count boxes in sub-lists. If ITEM is
- ;; nil, count across the whole structure, else count only
- ;; across subtree whose ancestor is ITEM.
- (lambda (item structs recursivep)
- (let ((c-on 0) (c-all 0))
- (mapc
- (lambda (s)
- (let* ((pre (org-list-prevs-alist s))
- (par (org-list-parents-alist s))
- (items
- (cond
- ((and recursivep item) (org-list-get-subtree item s))
- (recursivep (mapcar #'car s))
- (item (org-list-get-children item s par))
- (t (org-list-get-all-items
- (org-list-get-top-point s) s pre))))
- (cookies (delq nil (mapcar
- (lambda (e)
- (org-list-get-checkbox e s))
- items))))
- (setq c-all (+ (length cookies) c-all)
- c-on (+ (org-count "[X]" cookies) c-on))))
- structs)
- (cons c-on c-all)))))
- (backup-end 1)
- cookies-list structs-bak)
- (goto-char (car bounds))
- ;; 1. Build an alist for each cookie found within BOUNDS. The
- ;; key will be position at beginning of cookie and values
- ;; ending position, format of cookie, and a cell whose car is
- ;; number of checked boxes to report, and cdr total number of
- ;; boxes.
- (while (re-search-forward cookie-re (cdr bounds) t)
- (catch 'skip
- (save-excursion
- (push
- (list
- (match-beginning 1) ; cookie start
- (match-end 1) ; cookie end
- (match-string 2) ; percent?
- (cond ; boxes count
- ;; Cookie is at an heading, but specifically for todo,
- ;; not for checkboxes: skip it.
- ((and (org-at-heading-p)
- (string-match "\\<todo\\>"
- (downcase
- (or (org-entry-get nil "COOKIE_DATA") ""))))
- (throw 'skip nil))
- ;; Cookie is at an heading, but all lists before next
- ;; heading already have been read. Use data collected
- ;; in STRUCTS-BAK. This should only happen when
- ;; heading has more than one cookie on it.
- ((and (org-at-heading-p)
- (<= (save-excursion (outline-next-heading) (point))
- backup-end))
- (funcall count-boxes nil structs-bak recursivep))
- ;; Cookie is at a fresh heading. Grab structure of
- ;; every list containing a checkbox between point and
- ;; next headline, and save them in STRUCTS-BAK.
- ((org-at-heading-p)
- (setq backup-end (save-excursion
- (outline-next-heading) (point))
- structs-bak nil)
- (while (org-list-search-forward box-re backup-end 'move)
- (let* ((struct (org-list-struct))
- (bottom (org-list-get-bottom-point struct)))
- (push struct structs-bak)
- (goto-char bottom)))
- (funcall count-boxes nil structs-bak recursivep))
- ;; Cookie is at an item, and we already have list
- ;; structure stored in STRUCTS-BAK.
- ((and (org-at-item-p)
- (< (point-at-bol) backup-end)
- ;; Only lists in no special context are stored.
- (not (nth 2 (org-list-context))))
- (funcall count-boxes (point-at-bol) structs-bak recursivep))
- ;; Cookie is at an item, but we need to compute list
- ;; structure.
- ((org-at-item-p)
- (let ((struct (org-list-struct)))
- (setq backup-end (org-list-get-bottom-point struct)
- structs-bak (list struct)))
- (funcall count-boxes (point-at-bol) structs-bak recursivep))
- ;; Else, cookie found is at a wrong place. Skip it.
- (t (throw 'skip nil))))
- cookies-list))))
- ;; 2. Apply alist to buffer, in reverse order so positions stay
- ;; unchanged after cookie modifications.
- (mapc (lambda (cookie)
- (let* ((beg (car cookie))
- (end (nth 1 cookie))
- (percentp (nth 2 cookie))
- (checked (car (nth 3 cookie)))
- (total (cdr (nth 3 cookie)))
- (new (if percentp
- (format "[%d%%]" (floor (* 100.0 checked)
- (max 1 total)))
- (format "[%d/%d]" checked total))))
- (goto-char beg)
- (insert new)
- (delete-region (point) (+ (point) (- end beg)))
- (when org-auto-align-tags (org-fix-tags-on-the-fly))))
+ (lambda (item structs recursivep)
+ ;; Return number of checked boxes and boxes of all types
+ ;; in all structures in STRUCTS. If RECURSIVEP is
+ ;; non-nil, also count boxes in sub-lists. If ITEM is
+ ;; nil, count across the whole structure, else count only
+ ;; across subtree whose ancestor is ITEM.
+ (let ((c-on 0) (c-all 0))
+ (dolist (s structs (list c-on c-all))
+ (let* ((pre (org-list-prevs-alist s))
+ (par (org-list-parents-alist s))
+ (items
+ (cond
+ ((and recursivep item) (org-list-get-subtree item s))
+ (recursivep (mapcar #'car s))
+ (item (org-list-get-children item s par))
+ (t (org-list-get-all-items
+ (org-list-get-top-point s) s pre))))
+ (cookies (delq nil (mapcar
+ (lambda (e)
+ (org-list-get-checkbox e s))
+ items))))
+ (cl-incf c-all (length cookies))
+ (cl-incf c-on (cl-count "[X]" cookies :test #'equal)))))))
+ cookies-list cache)
+ ;; Move to start.
+ (cond (all (goto-char (point-min)))
+ (within-inlinetask (org-back-to-heading t))
+ (t (org-with-limited-levels (outline-previous-heading))))
+ ;; Build an alist for each cookie found. The key is the position
+ ;; at beginning of cookie and values ending position, format of
+ ;; cookie, number of checked boxes to report and total number of
+ ;; boxes.
+ (while (re-search-forward cookie-re end t)
+ (let ((context (save-excursion (backward-char)
+ (save-match-data (org-element-context)))))
+ (when (eq (org-element-type context) 'statistics-cookie)
+ (push
+ (append
+ (list (match-beginning 1) (match-end 1) (match-end 2))
+ (let* ((container
+ (org-element-lineage
+ context
+ '(drawer center-block dynamic-block inlinetask item
+ quote-block special-block verse-block)))
+ (beg (if container
+ (org-element-property :contents-begin container)
+ (save-excursion
+ (org-with-limited-levels
+ (outline-previous-heading))
+ (point)))))
+ (or (cdr (assq beg cache))
+ (save-excursion
+ (goto-char beg)
+ (let ((end
+ (if container
+ (org-element-property :contents-end container)
+ (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ structs)
+ (while (re-search-forward box-re end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'item)
+ (push (org-element-property :structure element)
+ structs)
+ ;; Skip whole list since we have its
+ ;; structure anyway.
+ (while (setq element (org-element-lineage
+ element '(plain-list)))
+ (goto-char
+ (min (org-element-property :end element)
+ end))))))
+ ;; Cache count for cookies applying to the same
+ ;; area. Then return it.
+ (let ((count
+ (funcall count-boxes
+ (and (eq (org-element-type container)
+ 'item)
+ (org-element-property
+ :begin container))
+ structs
+ recursivep)))
+ (push (cons beg count) cache)
+ count))))))
cookies-list))))
+ ;; Apply alist to buffer.
+ (dolist (cookie cookies-list)
+ (let* ((beg (car cookie))
+ (end (nth 1 cookie))
+ (percent (nth 2 cookie))
+ (checked (nth 3 cookie))
+ (total (nth 4 cookie)))
+ (goto-char beg)
+ (insert
+ (if percent (format "[%d%%]" (floor (* 100.0 checked)
+ (max 1 total)))
+ (format "[%d/%d]" checked total)))
+ (delete-region (point) (+ (point) (- end beg)))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))))))
(defun org-get-checkbox-statistics-face ()
"Select the face for checkbox statistics.
@@ -2664,7 +2708,7 @@ Return t if successful."
;; of the subtree mustn't have a child.
(let ((last-item (caar
(reverse
- (org-remove-if
+ (cl-remove-if
(lambda (e) (>= (car e) end))
struct)))))
(org-list-has-child-p last-item struct))))
@@ -2781,7 +2825,7 @@ Return t at each successful move."
((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))
- (org-indent-to-column (car org-tab-ind-state))
+ (indent-to-column (car org-tab-ind-state))
(insert (cdr org-tab-ind-state) " ")
;; Break cycle
(setq this-command 'identity)))
@@ -2794,7 +2838,8 @@ Return t at each successful move."
(t (user-error "Cannot move item"))))
t))))
-(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
+(defun org-sort-list
+ (&optional with-case sorting-type getkey-func compare-func interactive?)
"Sort list items.
The cursor may be at any item of the list that should be sorted.
Sublists are not sorted. Checkboxes, if any, are ignored.
@@ -2820,13 +2865,15 @@ Capital letters will reverse the sort order.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
a function to be called with point at the beginning of the
-record. It must return either a string or a number that should
-serve as the sorting key for that record. It will then use
-COMPARE-FUNC to compare entries.
+record. It must return a value that is compatible with COMPARE-FUNC,
+the function used to compare entries.
Sorting is done against the visible part of the headlines, it
-ignores hidden links."
- (interactive "P")
+ignores hidden links.
+
+A non-nil value for INTERACTIVE? is used to signal that this
+function is being called interactively."
+ (interactive (list current-prefix-arg nil nil nil t))
(let* ((case-func (if with-case 'identity 'downcase))
(struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
@@ -2838,23 +2885,31 @@ ignores hidden links."
(message
"Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:")
(read-char-exclusive))))
+ (dcst (downcase sorting-type))
(getkey-func
- (or getkey-func
- (and (= (downcase sorting-type) ?f)
- (intern (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil))))))
+ (and (= dcst ?f)
+ (or getkey-func
+ (and interactive?
+ (org-read-function "Function for extracting keys: "))
+ (error "Missing key extractor"))))
+ (sort-func
+ (cond
+ ((= dcst ?a) #'string<)
+ ((= dcst ?f)
+ (or compare-func
+ (and interactive?
+ (org-read-function
+ (concat "Function for comparing keys "
+ "(empty for default `sort-subr' predicate): ")
+ 'allow-empty))))
+ ((= dcst ?t) #'<)
+ ((= dcst ?x) #'string<))))
(message "Sorting items...")
(save-restriction
(narrow-to-region start end)
(goto-char (point-min))
- (let* ((dcst (downcase sorting-type))
- (case-fold-search nil)
+ (let* ((case-fold-search nil)
(now (current-time))
- (sort-func (cond
- ((= dcst ?a) 'string<)
- ((= dcst ?f) compare-func)
- ((= dcst ?t) '<)
- ((= dcst ?x) 'string<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
(or (eobp) (beginning-of-line))))
@@ -2908,128 +2963,249 @@ ignores hidden links."
(run-hooks 'org-after-sorting-entries-or-items-hook)
(message "Sorting items...done")))))
+(defun org-toggle-item (arg)
+ "Convert headings or normal lines to items, items to normal lines.
+If there is no active region, only the current line is considered.
+
+If the first non blank line in the region is a headline, convert
+all headlines to items, shifting text accordingly.
+
+If it is an item, convert all items to normal lines.
+
+If it is normal text, change region into a list of items.
+With a prefix argument ARG, change the region in a single item."
+ (interactive "P")
+ (let ((shift-text
+ (lambda (ind end)
+ ;; Shift text in current section to IND, from point to END.
+ ;; The function leaves point to END line.
+ (let ((min-i 1000) (end (copy-marker end)))
+ ;; First determine the minimum indentation (MIN-I) of
+ ;; the text.
+ (save-excursion
+ (catch 'exit
+ (while (< (point) end)
+ (let ((i (org-get-indentation)))
+ (cond
+ ;; Skip blank lines and inline tasks.
+ ((looking-at "^[ \t]*$"))
+ ((looking-at org-outline-regexp-bol))
+ ;; We can't find less than 0 indentation.
+ ((zerop i) (throw 'exit (setq min-i 0)))
+ ((< i min-i) (setq min-i i))))
+ (forward-line))))
+ ;; Then indent each line so that a line indented to
+ ;; MIN-I becomes indented to IND. Ignore blank lines
+ ;; and inline tasks in the process.
+ (let ((delta (- ind min-i)))
+ (while (< (point) end)
+ (unless (or (looking-at "^[ \t]*$")
+ (looking-at org-outline-regexp-bol))
+ (indent-line-to (+ (org-get-indentation) delta)))
+ (forward-line))))))
+ (skip-blanks
+ (lambda (pos)
+ ;; Return beginning of first non-blank line, starting from
+ ;; line at POS.
+ (save-excursion
+ (goto-char pos)
+ (skip-chars-forward " \r\t\n")
+ (point-at-bol))))
+ beg end)
+ ;; Determine boundaries of changes.
+ (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))
+ end (copy-marker (point-at-eol))))
+ ;; Depending on the starting line, choose an action on the text
+ ;; between BEG and END.
+ (org-with-limited-levels
+ (save-excursion
+ (goto-char beg)
+ (cond
+ ;; Case 1. Start at an item: de-itemize. Note that it only
+ ;; happens when a region is active: `org-ctrl-c-minus'
+ ;; would call `org-cycle-list-bullet' otherwise.
+ ((org-at-item-p)
+ (while (< (point) end)
+ (when (org-at-item-p)
+ (skip-chars-forward " \t")
+ (delete-region (point) (match-end 0)))
+ (forward-line)))
+ ;; Case 2. Start at an heading: convert to items.
+ ((org-at-heading-p)
+ (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ ;; Indentation of the first heading. It should be
+ ;; relative to the indentation of its parent, if any.
+ (start-ind (save-excursion
+ (cond
+ ((not org-adapt-indentation) 0)
+ ((not (outline-previous-heading)) 0)
+ (t (length (match-string 0))))))
+ ;; Level of first heading. Further headings will be
+ ;; compared to it to determine hierarchy in the list.
+ (ref-level (org-reduced-level (org-outline-level))))
+ (while (< (point) end)
+ (let* ((level (org-reduced-level (org-outline-level)))
+ (delta (max 0 (- level ref-level)))
+ (todo-state (org-get-todo-state)))
+ ;; If current headline is less indented than the first
+ ;; one, set it as reference, in order to preserve
+ ;; subtrees.
+ (when (< level ref-level) (setq ref-level level))
+ ;; Remove stars and TODO keyword.
+ (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
+ (delete-region (point) (or (match-beginning 3)
+ (line-end-position)))
+ (insert bul)
+ (indent-line-to (+ start-ind (* delta bul-len)))
+ ;; Turn TODO keyword into a check box.
+ (when todo-state
+ (let* ((struct (org-list-struct))
+ (old (copy-tree struct)))
+ (org-list-set-checkbox
+ (line-beginning-position)
+ struct
+ (if (member todo-state org-done-keywords)
+ "[X]"
+ "[ ]"))
+ (org-list-write-struct struct
+ (org-list-parents-alist struct)
+ old)))
+ ;; Ensure all text down to END (or SECTION-END) belongs
+ ;; to the newly created item.
+ (let ((section-end (save-excursion
+ (or (outline-next-heading) (point)))))
+ (forward-line)
+ (funcall shift-text
+ (+ start-ind (* (1+ delta) bul-len))
+ (min end section-end)))))))
+ ;; Case 3. Normal line with ARG: make the first line of region
+ ;; an item, and shift indentation of others lines to
+ ;; set them as item's body.
+ (arg (let* ((bul (org-list-bullet-string "-"))
+ (bul-len (length bul))
+ (ref-ind (org-get-indentation)))
+ (skip-chars-forward " \t")
+ (insert bul)
+ (forward-line)
+ (while (< (point) end)
+ ;; Ensure that lines less indented than first one
+ ;; still get included in item body.
+ (funcall shift-text
+ (+ ref-ind bul-len)
+ (min end (save-excursion (or (outline-next-heading)
+ (point)))))
+ (forward-line))))
+ ;; Case 4. Normal line without ARG: turn each non-item line
+ ;; into an item.
+ (t
+ (while (< (point) end)
+ (unless (or (org-at-heading-p) (org-at-item-p))
+ (when (looking-at "\\([ \t]*\\)\\(\\S-\\)")
+ (replace-match
+ (concat "\\1" (org-list-bullet-string "-") "\\2"))))
+ (forward-line))))))))
;;; Send and receive lists
-(defun org-list-parse-list (&optional delete)
+(defun org-list-to-lisp (&optional delete)
"Parse the list at point and maybe DELETE it.
Return a list whose car is a symbol of list type, among
`ordered', `unordered' and `descriptive'. Then, each item is
-a list whose car is counter, and cdr are strings and other
-sub-lists. Inside strings, check-boxes are replaced by
-\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\".
+a list of strings and other sub-lists.
For example, the following list:
-1. first item
- + sub-item one
- + [X] sub-item two
- more text in first item
-2. [@3] last item
+ 1. first item
+ + sub-item one
+ + [X] sub-item two
+ more text in first item
+ 2. [@3] last item
-will be parsed as:
+is parsed as
(ordered
- (nil \"first item\"
- (unordered
- (nil \"sub-item one\")
- (nil \"[CBON] sub-item two\"))
- \"more text in first item\")
- (3 \"last item\"))
-
-Point is left at list end."
- (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'.
- (let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct))
- (parents (org-list-parents-alist struct))
- (top (org-list-get-top-point struct))
- (bottom (org-list-get-bottom-point struct))
- out
- (get-text
- (function
- ;; Return text between BEG and END, trimmed, with
- ;; checkboxes replaced.
- (lambda (beg end)
- (let ((text (org-trim (buffer-substring beg end))))
- (if (string-match "\\`\\[\\([-X ]\\)\\]" text)
- (replace-match
- (let ((box (match-string 1 text)))
- (cond
- ((equal box " ") "CBOFF")
- ((equal box "-") "CBTRANS")
- (t "CBON")))
- t nil text 1)
- text)))))
- (parse-sublist
- (function
- ;; Return a list whose car is list type and cdr a list of
- ;; items' body.
- (lambda (e)
- (cons (org-list-get-list-type (car e) struct prevs)
- (mapcar parse-item e)))))
- (parse-item
- (function
- ;; Return a list containing counter of item, if any, text
- ;; and any sublist inside it.
- (lambda (e)
- (let ((start (save-excursion
- (goto-char e)
- (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*")
- (match-end 0)))
- ;; Get counter number. For alphabetic counter, get
- ;; its position in the alphabet.
- (counter (let ((c (org-list-get-counter e struct)))
- (cond
- ((not c) nil)
- ((string-match "[A-Za-z]" c)
- (- (string-to-char (upcase (match-string 0 c)))
- 64))
- ((string-match "[0-9]+" c)
- (string-to-number (match-string 0 c))))))
- (childp (org-list-has-child-p e struct))
- (end (org-list-get-item-end e struct)))
- ;; If item has a child, store text between bullet and
- ;; next child, then recursively parse all sublists. At
- ;; the end of each sublist, check for the presence of
- ;; text belonging to the original item.
- (if childp
- (let* ((children (org-list-get-children e struct parents))
- (body (list (funcall get-text start childp))))
- (while children
- (let* ((first (car children))
- (sub (org-list-get-all-items first struct prevs))
- (last-c (car (last sub)))
- (last-end (org-list-get-item-end last-c struct)))
- (push (funcall parse-sublist sub) body)
- ;; Remove children from the list just parsed.
- (setq children (cdr (member last-c children)))
- ;; There is a chunk of text belonging to the
- ;; item if last child doesn't end where next
- ;; child starts or where item ends.
- (unless (= (or (car children) end) last-end)
- (push (funcall get-text
- last-end (or (car children) end))
- body))))
- (cons counter (nreverse body)))
- (list counter (funcall get-text start end))))))))
+ (\"first item\"
+ (unordered
+ (\"sub-item one\")
+ (\"[X] sub-item two\"))
+ \"more text in first item\")
+ (\"[@3] last item\"))
+
+Point is left at list's end."
+ (letrec ((struct (org-list-struct))
+ (prevs (org-list-prevs-alist struct))
+ (parents (org-list-parents-alist struct))
+ (top (org-list-get-top-point struct))
+ (bottom (org-list-get-bottom-point struct))
+ (trim
+ (lambda (text)
+ ;; Remove indentation and final newline from TEXT.
+ (org-remove-indentation
+ (if (string-match-p "\n\\'" text)
+ (substring text 0 -1)
+ text))))
+ (parse-sublist
+ (lambda (e)
+ ;; Return a list whose car is list type and cdr a list
+ ;; of items' body.
+ (cons (org-list-get-list-type (car e) struct prevs)
+ (mapcar parse-item e))))
+ (parse-item
+ (lambda (e)
+ ;; Return a list containing counter of item, if any,
+ ;; text and any sublist inside it.
+ (let* ((end (org-list-get-item-end e struct))
+ (children (org-list-get-children e struct parents))
+ (body
+ (save-excursion
+ (goto-char e)
+ (looking-at "[ \t]*\\S-+[ \t]*")
+ (list
+ (funcall
+ trim
+ (concat
+ (make-string (string-width (match-string 0)) ?\s)
+ (buffer-substring-no-properties
+ (match-end 0) (or (car children) end))))))))
+ (while children
+ (let* ((child (car children))
+ (sub (org-list-get-all-items child struct prevs))
+ (last-in-sub (car (last sub))))
+ (push (funcall parse-sublist sub) body)
+ ;; Remove whole sub-list from children.
+ (setq children (cdr (memq last-in-sub children)))
+ ;; There is a chunk of text belonging to the item
+ ;; if last child doesn't end where next child
+ ;; starts or where item ends.
+ (let ((sub-end (org-list-get-item-end last-in-sub struct))
+ (next (or (car children) end)))
+ (when (/= sub-end next)
+ (push (funcall
+ trim
+ (buffer-substring-no-properties sub-end next))
+ body)))))
+ (nreverse body)))))
;; Store output, take care of cursor position and deletion of
;; list, then return output.
- (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs)))
- (goto-char top)
- (when delete
- (delete-region top bottom)
- (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
- (replace-match "")))
- out))
+ (prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs))
+ (goto-char top)
+ (when delete
+ (delete-region top bottom)
+ (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
+ (replace-match ""))))))
(defun org-list-make-subtree ()
"Convert the plain list at point into a subtree."
(interactive)
(if (not (ignore-errors (goto-char (org-in-item-p))))
(error "Not in a list")
- (let ((list (save-excursion (org-list-parse-list t))))
+ (let ((list (save-excursion (org-list-to-lisp t))))
(insert (org-list-to-subtree list)))))
(defun org-list-insert-radio-list ()
@@ -3055,11 +3231,13 @@ for this list."
(catch 'exit
(unless (org-at-item-p) (error "Not at a list item"))
(save-excursion
- (re-search-backward "#\\+ORGLST" nil t)
- (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)")
- (if maybe (throw 'exit nil)
- (error "Don't know how to transform this list"))))
- (let* ((name (match-string 1))
+ (let ((case-fold-search t))
+ (re-search-backward "^[ \t]*#\\+ORGLST:" nil t)
+ (unless (looking-at
+ "[ \t]*#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\([^ \t\n]+\\)")
+ (if maybe (throw 'exit nil)
+ (error "Don't know how to transform this list")))))
+ (let* ((name (regexp-quote (match-string 1)))
(transform (intern (match-string 2)))
(bottom-point
(save-excursion
@@ -3071,220 +3249,371 @@ for this list."
(re-search-backward "#\\+ORGLST" nil t)
(re-search-forward (org-item-beginning-re) bottom-point t)
(match-beginning 0)))
- (plain-list (buffer-substring-no-properties top-point bottom-point))
- beg)
+ (plain-list (save-excursion
+ (goto-char top-point)
+ (org-list-to-lisp))))
(unless (fboundp transform)
(error "No such transformation function %s" transform))
(let ((txt (funcall transform plain-list)))
- ;; Find the insertion place
+ ;; Find the insertion(s) place(s).
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward
- (concat "BEGIN RECEIVE ORGLST +"
- name
- "\\([ \t]\\|$\\)")
- nil t)
- (error "Don't know where to insert translated list"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (setq beg (point))
- (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
- (error "Cannot find end of insertion region"))
- (delete-region beg (point-at-bol))
- (goto-char beg)
- (insert txt "\n")))
- (message "List converted and installed at receiver location"))))
-
-(defsubst org-list-item-trim-br (item)
- "Trim line breaks in a list ITEM."
- (setq item (replace-regexp-in-string "\n +" " " item)))
+ (let ((receiver-count 0)
+ (begin-re (format "BEGIN +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)"
+ name))
+ (end-re (format "END +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)"
+ name)))
+ (while (re-search-forward begin-re nil t)
+ (cl-incf receiver-count)
+ (let ((beg (line-beginning-position 2)))
+ (unless (re-search-forward end-re nil t)
+ (user-error "Cannot find end of receiver location at %d" beg))
+ (beginning-of-line)
+ (delete-region beg (point))
+ (insert txt "\n")))
+ (cond
+ ((> receiver-count 1)
+ (message "List converted and installed at receiver locations"))
+ ((= receiver-count 1)
+ (message "List converted and installed at receiver location"))
+ (t (user-error "No valid receiver location found")))))))))
(defun org-list-to-generic (list params)
- "Convert a LIST parsed through `org-list-parse-list' to other formats.
-Valid parameters PARAMS are:
-
-:ustart String to start an unordered list
-:uend String to end an unordered list
-
-:ostart String to start an ordered list
-:oend String to end an ordered list
-
-:dstart String to start a descriptive list
-:dend String to end a descriptive list
-:dtstart String to start a descriptive term
-:dtend String to end a descriptive term
-:ddstart String to start a description
-:ddend String to end a description
-
-:splice When set to t, return only list body lines, don't wrap
- them into :[u/o]start and :[u/o]end. Default is nil.
-
-:istart String to start a list item.
-:icount String to start an item with a counter.
-:iend String to end a list item
-:isep String to separate items
-:lsep String to separate sublists
-:csep String to separate text from a sub-list
-
-:cboff String to insert for an unchecked check-box
-:cbon String to insert for a checked check-box
-:cbtrans String to insert for a check-box in transitional state
-
-:nobr Non-nil means remove line breaks in lists items.
-
-Alternatively, each parameter can also be a form returning
-a string. These sexp can use keywords `counter' and `depth',
-representing respectively counter associated to the current
-item, and depth of the current sub-list, starting at 0.
-Obviously, `counter' is only available for parameters applying to
-items."
- (interactive)
- (let* ((p params)
- (splicep (plist-get p :splice))
- (ostart (plist-get p :ostart))
- (oend (plist-get p :oend))
- (ustart (plist-get p :ustart))
- (uend (plist-get p :uend))
- (dstart (plist-get p :dstart))
- (dend (plist-get p :dend))
- (dtstart (plist-get p :dtstart))
- (dtend (plist-get p :dtend))
- (ddstart (plist-get p :ddstart))
- (ddend (plist-get p :ddend))
- (istart (plist-get p :istart))
- (icount (plist-get p :icount))
- (iend (plist-get p :iend))
- (isep (plist-get p :isep))
- (lsep (plist-get p :lsep))
- (csep (plist-get p :csep))
- (cbon (plist-get p :cbon))
- (cboff (plist-get p :cboff))
- (cbtrans (plist-get p :cbtrans))
- (nobr (plist-get p :nobr))
- export-sublist ; for byte-compiler
- (export-item
- (function
- ;; Export an item ITEM of type TYPE, at DEPTH. First
- ;; string in item is treated in a special way as it can
- ;; bring extra information that needs to be processed.
- (lambda (item type depth)
- (let* ((counter (pop item))
- (fmt (concat
- (cond
- ((eq type 'descriptive)
- ;; Stick DTSTART to ISTART by
- ;; left-trimming the latter.
- (concat (let ((s (eval istart)))
- (or (and (string-match "[ \t\n\r]+\\'" s)
- (replace-match "" t t s))
- istart))
- "%s" (eval ddend)))
- ((and counter (eq type 'ordered))
- (concat (eval icount) "%s"))
- (t (concat (eval istart) "%s")))
- (eval iend)))
- (first (car item)))
- ;; Replace checkbox if any is found.
- (cond
- ((string-match "\\[CBON\\]" first)
- (setq first (replace-match cbon t t first)))
- ((string-match "\\[CBOFF\\]" first)
- (setq first (replace-match cboff t t first)))
- ((string-match "\\[CBTRANS\\]" first)
- (setq first (replace-match cbtrans t t first))))
- ;; Replace line breaks if required
- (when nobr (setq first (org-list-item-trim-br first)))
- ;; Insert descriptive term if TYPE is `descriptive'.
- (when (eq type 'descriptive)
- (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first))
- (term (if complete
- (save-match-data
- (org-trim (match-string 1 first)))
- "???"))
- (desc (if complete
- (org-trim (substring first (match-end 0)))
- first)))
- (setq first (concat (eval dtstart) term (eval dtend)
- (eval ddstart) desc))))
- (setcar item first)
- (format fmt
- (mapconcat (lambda (e)
- (if (stringp e) e
- (funcall export-sublist e (1+ depth))))
- item (or (eval csep) "")))))))
- (export-sublist
- (function
- ;; Export sublist SUB at DEPTH.
- (lambda (sub depth)
- (let* ((type (car sub))
- (items (cdr sub))
- (fmt (concat (cond
- (splicep "%s")
- ((eq type 'ordered)
- (concat (eval ostart) "%s" (eval oend)))
- ((eq type 'descriptive)
- (concat (eval dstart) "%s" (eval dend)))
- (t (concat (eval ustart) "%s" (eval uend))))
- (eval lsep))))
- (format fmt (mapconcat (lambda (e)
- (funcall export-item e type depth))
- items (or (eval isep) ""))))))))
- (concat (funcall export-sublist list 0) "\n")))
-
-(defun org-list-to-latex (list &optional _params)
+ "Convert a LIST parsed through `org-list-to-lisp' to a custom format.
+
+LIST is a list as returned by `org-list-to-lisp', which see.
+PARAMS is a property list of parameters used to tweak the output
+format.
+
+Valid parameters are:
+
+:backend, :raw
+
+ Export back-end used as a basis to transcode elements of the
+ list, when no specific parameter applies to it. It is also
+ used to translate its contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, only export the contents of the top most plain
+ list, effectively ignoring its opening and closing lines.
+
+:ustart, :uend
+
+ Strings to start and end an unordered list. They can also be
+ set to a function returning a string or nil, which will be
+ called with the depth of the list, counting from 1.
+
+:ostart, :oend
+
+ Strings to start and end an ordered list. They can also be set
+ to a function returning a string or nil, which will be called
+ with the depth of the list, counting from 1.
+
+:dstart, :dend
+
+ Strings to start and end a descriptive list. They can also be
+ set to a function returning a string or nil, which will be
+ called with the depth of the list, counting from 1.
+
+:dtstart, :dtend, :ddstart, :ddend
+
+ Strings to start and end a descriptive term.
+
+:istart, :iend
+
+ Strings to start or end a list item, and to start a list item
+ with a counter. They can also be set to a function returning
+ a string or nil, which will be called with two arguments: the
+ type of list and the depth of the item, counting from 1.
+
+:icount
+
+ Strings to start a list item with a counter. It can also be
+ set to a function returning a string or nil, which will be
+ called with three arguments: the type of list, the depth of the
+ item, counting from 1, and the counter. Its value, when
+ non-nil, has precedence over `:istart'.
+
+:isep
+
+ String used to separate items. It can also be set to
+ a function returning a string or nil, which will be called with
+ two arguments: the type of list and the depth of the item,
+ counting from 1. It always start on a new line.
+
+:ifmt
+
+ Function to be applied to the contents of every item. It is
+ called with two arguments: the type of list and the contents.
+
+:cbon, :cboff, :cbtrans
+
+ String to insert, respectively, an un-checked check-box,
+ a checked check-box and a check-box in transitional state."
+ (require 'ox)
+ (let* ((backend (plist-get params :backend))
+ (custom-backend
+ (org-export-create-backend
+ :parent (or backend 'org)
+ :transcoders
+ `((plain-list . ,(org-list--to-generic-plain-list params))
+ (item . ,(org-list--to-generic-item params))
+ (macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
+ data info)
+ ;; Write LIST back into Org syntax and parse it.
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (letrec ((insert-list
+ (lambda (l)
+ (dolist (i (cdr l))
+ (funcall insert-item i (car l)))))
+ (insert-item
+ (lambda (i type)
+ (let ((start (point)))
+ (insert (if (eq type 'ordered) "1. " "- "))
+ (dolist (e i)
+ (if (consp e) (funcall insert-list e)
+ (insert e)
+ (insert "\n")))
+ (beginning-of-line)
+ (save-excursion
+ (let ((ind (if (eq type 'ordered) 3 2)))
+ (while (> (point) start)
+ (unless (looking-at-p "[ \t]*$")
+ (indent-to ind))
+ (forward-line -1))))))))
+ (funcall insert-list list))
+ (setf data
+ (org-element-map (org-element-parse-buffer) 'plain-list
+ #'identity nil t))
+ (setf info (org-export-get-environment backend nil params)))
+ (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
+ (user-error "Unknown :backend value"))
+ (unless backend (require 'ox-org))
+ ;; When`:raw' property has a non-nil value, turn all objects back
+ ;; into Org syntax.
+ (when (and backend (plist-get params :raw))
+ (org-element-map data org-element-all-objects
+ (lambda (object)
+ (org-element-set-element
+ object (org-element-interpret-data object)))))
+ ;; We use a low-level mechanism to export DATA so as to skip all
+ ;; usual pre-processing and post-processing, i.e., hooks, filters,
+ ;; Babel code evaluation, include keywords and macro expansion,
+ ;; and filters.
+ (let ((output (org-export-data-with-backend data custom-backend info)))
+ ;; Remove final newline.
+ (if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
+
+(defun org-list--depth (element)
+ "Return the level of ELEMENT within current plain list.
+ELEMENT is either an item or a plain list."
+ (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list))
+ (org-element-lineage element nil t)))
+
+(defun org-list--trailing-newlines (string)
+ "Return the number of trailing newlines in STRING."
+ (with-temp-buffer
+ (insert string)
+ (skip-chars-backward " \t\n")
+ (count-lines (line-beginning-position 2) (point-max))))
+
+(defun org-list--generic-eval (value &rest args)
+ "Evaluate VALUE according to its type.
+VALUE is either nil, a string or a function. In the latter case,
+it is called with arguments ARGS."
+ (cond ((null value) nil)
+ ((stringp value) value)
+ ((functionp value) (apply value args))
+ (t (error "Wrong value: %s" value))))
+
+(defun org-list--to-generic-plain-list (params)
+ "Return a transcoder for `plain-list' elements.
+PARAMS is a plist used to tweak the behavior of the transcoder."
+ (let ((ustart (plist-get params :ustart))
+ (uend (plist-get params :uend))
+ (ostart (plist-get params :ostart))
+ (oend (plist-get params :oend))
+ (dstart (plist-get params :dstart))
+ (dend (plist-get params :dend))
+ (splice (plist-get params :splice))
+ (backend (plist-get params :backend)))
+ (lambda (plain-list contents info)
+ (let* ((type (org-element-property :type plain-list))
+ (depth (org-list--depth plain-list))
+ (start (and (not splice)
+ (org-list--generic-eval
+ (pcase type
+ (`ordered ostart)
+ (`unordered ustart)
+ (_ dstart))
+ depth)))
+ (end (and (not splice)
+ (org-list--generic-eval
+ (pcase type
+ (`ordered oend)
+ (`unordered uend)
+ (_ dend))
+ depth))))
+ ;; Make sure trailing newlines in END appear in the output by
+ ;; setting `:post-blank' property to their number.
+ (when end
+ (org-element-put-property
+ plain-list :post-blank (org-list--trailing-newlines end)))
+ ;; Build output.
+ (concat (and start (concat start "\n"))
+ (if (or start end splice (not backend))
+ contents
+ (org-export-with-backend backend plain-list contents info))
+ end)))))
+
+(defun org-list--to-generic-item (params)
+ "Return a transcoder for `item' elements.
+PARAMS is a plist used to tweak the behavior of the transcoder."
+ (let ((backend (plist-get params :backend))
+ (istart (plist-get params :istart))
+ (iend (plist-get params :iend))
+ (isep (plist-get params :isep))
+ (icount (plist-get params :icount))
+ (ifmt (plist-get params :ifmt))
+ (cboff (plist-get params :cboff))
+ (cbon (plist-get params :cbon))
+ (cbtrans (plist-get params :cbtrans))
+ (dtstart (plist-get params :dtstart))
+ (dtend (plist-get params :dtend))
+ (ddstart (plist-get params :ddstart))
+ (ddend (plist-get params :ddend)))
+ (lambda (item contents info)
+ (let* ((type
+ (org-element-property :type (org-element-property :parent item)))
+ (tag (org-element-property :tag item))
+ (depth (org-list--depth item))
+ (separator (and (org-export-get-next-element item info)
+ (org-list--generic-eval isep type depth)))
+ (closing (pcase (org-list--generic-eval iend type depth)
+ ((or `nil "") "\n")
+ ((and (guard separator) s)
+ (if (equal (substring s -1) "\n") s (concat s "\n")))
+ (s s))))
+ ;; When a closing line or a separator is provided, make sure
+ ;; its trailing newlines are taken into account when building
+ ;; output. This is done by setting `:post-blank' property to
+ ;; the number of such lines in the last line to be added.
+ (let ((last-string (or separator closing)))
+ (when last-string
+ (org-element-put-property
+ item
+ :post-blank
+ (max (1- (org-list--trailing-newlines last-string)) 0))))
+ ;; Build output.
+ (concat
+ (let ((c (org-element-property :counter item)))
+ (if (and c icount) (org-list--generic-eval icount type depth c)
+ (org-list--generic-eval istart type depth)))
+ (let ((body
+ (if (or istart iend icount ifmt cbon cboff cbtrans (not backend)
+ (and (eq type 'descriptive)
+ (or dtstart dtend ddstart ddend)))
+ (concat
+ (pcase (org-element-property :checkbox item)
+ (`on cbon)
+ (`off cboff)
+ (`trans cbtrans))
+ (and tag
+ (concat dtstart
+ (if backend
+ (org-export-data-with-backend
+ tag backend info)
+ (org-element-interpret-data tag))
+ dtend))
+ (and tag ddstart)
+ (let ((contents
+ (if (= (length contents) 0) ""
+ (substring contents 0 -1))))
+ (if ifmt (org-list--generic-eval ifmt type contents)
+ contents))
+ (and tag ddend))
+ (org-export-with-backend backend item contents info))))
+ ;; Remove final newline.
+ (if (equal body "") ""
+ (substring (org-element-normalize-string body) 0 -1)))
+ closing
+ separator)))))
+
+(defun org-list-to-latex (list &optional params)
"Convert LIST into a LaTeX list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+PARAMS is a property list with overruling parameters for
+`org-list-to-generic'. Return converted list as a string."
(require 'ox-latex)
- (org-export-string-as list 'latex t))
+ (org-list-to-generic list (org-combine-plists '(:backend latex) params)))
-(defun org-list-to-html (list)
+(defun org-list-to-html (list &optional params)
"Convert LIST into a HTML list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+PARAMS is a property list with overruling parameters for
+`org-list-to-generic'. Return converted list as a string."
(require 'ox-html)
- (org-export-string-as list 'html t))
+ (org-list-to-generic list (org-combine-plists '(:backend html) params)))
-(defun org-list-to-texinfo (list &optional _params)
+(defun org-list-to-texinfo (list &optional params)
"Convert LIST into a Texinfo list.
-LIST is as string representing the list to transform, as Org
-syntax. Return converted list as a string."
+LIST is a parsed plain list, as returned by `org-list-to-lisp'.
+PARAMS is a property list with overruling parameters for
+`org-list-to-generic'. Return converted list as a string."
(require 'ox-texinfo)
- (org-export-string-as list 'texinfo t))
+ (org-list-to-generic list (org-combine-plists '(:backend texinfo) params)))
-(defun org-list-to-subtree (list &optional params)
- "Convert LIST into an Org subtree.
+(defun org-list-to-org (list &optional params)
+ "Convert LIST into an Org plain list.
LIST is as returned by `org-list-parse-list'. PARAMS is a property list
with overruling parameters for `org-list-to-generic'."
- (defvar get-stars) (defvar org--blankp)
- (let* ((rule (cdr (assq 'heading org-blank-before-new-entry)))
+ (let* ((make-item
+ (lambda (type _depth &optional c)
+ (concat (if (eq type 'ordered) "1. " "- ")
+ (and c (format "[@%d] " c)))))
+ (defaults
+ (list :istart make-item
+ :icount make-item
+ :ifmt (lambda (_type contents)
+ (replace-regexp-in-string "\n" "\n " contents))
+ :dtend " :: "
+ :cbon "[X] "
+ :cboff "[ ] "
+ :cbtrans "[-] ")))
+ (org-list-to-generic list (org-combine-plists defaults params))))
+
+(defun org-list-to-subtree (list &optional params)
+ "Convert LIST into an Org subtree.
+LIST is as returned by `org-list-to-lisp'. PARAMS is a property
+list with overruling parameters for `org-list-to-generic'."
+ (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry))
+ (`t t)
+ (`auto (save-excursion
+ (org-with-limited-levels (outline-previous-heading))
+ (org-previous-line-empty-p)))))
(level (org-reduced-level (or (org-current-level) 0)))
- (org--blankp (or (eq rule t)
- (and (eq rule 'auto)
- (save-excursion
- (outline-previous-heading)
- (org-previous-line-empty-p)))))
- (get-stars ;FIXME: Can't rename without renaming it in org.el as well!
- (function
- ;; Return the string for the heading, depending on depth D
- ;; of current sub-list.
- (lambda (d)
- (let ((oddeven-level (+ level d 1)))
- (concat (make-string (if org-odd-levels-only
- (1- (* 2 oddeven-level))
- oddeven-level)
- ?*)
- " "))))))
+ (make-stars
+ (lambda (_type depth &optional _count)
+ ;; Return the string for the heading, depending on DEPTH
+ ;; of current sub-list.
+ (let ((oddeven-level (+ level depth)))
+ (concat (make-string (if org-odd-levels-only
+ (1- (* 2 oddeven-level))
+ oddeven-level)
+ ?*)
+ " ")))))
(org-list-to-generic
list
(org-combine-plists
- '(:splice t
- :dtstart " " :dtend " "
- :istart (funcall get-stars depth)
- :icount (funcall get-stars depth)
- :isep (if org--blankp "\n\n" "\n")
- :csep (if org--blankp "\n\n" "\n")
- :cbon "DONE" :cboff "TODO" :cbtrans "TODO")
+ (list :splice t
+ :istart make-stars
+ :icount make-stars
+ :dtstart " " :dtend " "
+ :isep (if blank "\n\n" "\n")
+ :cbon "DONE " :cboff "TODO " :cbtrans "TODO ")
params))))
(provide 'org-list)
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index f4919d1385e..1d2823ea0f9 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -1,4 +1,4 @@
-;;; org-macro.el --- Macro Replacement Code for Org Mode
+;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,28 +30,43 @@
;; `org-macro-initialize-templates', which recursively calls
;; `org-macro--collect-macros' in order to read setup files.
+;; Argument in macros are separated with commas. Proper escaping rules
+;; are implemented in `org-macro-escape-arguments' and arguments can
+;; be extracted from a string with `org-macro-extract-arguments'.
+
;; Along with macros defined through #+MACRO: keyword, default
;; templates include the following hard-coded macros:
-;; {{{time(format-string)}}}, {{{property(node-property)}}},
-;; {{{input-file}}} and {{{modification-time(format-string)}}}.
+;; {{{time(format-string)}}},
+;; {{{property(node-property)}}},
+;; {{{input-file}}},
+;; {{{modification-time(format-string)}}},
+;; {{{n(counter,action}}}.
;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
;; {{{email}}} and {{{title}}} macros.
;;; Code:
+(require 'cl-lib)
(require 'org-macs)
+(require 'org-compat)
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
+(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-macro-parser "org-element" ())
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
-(declare-function org-remove-double-quotes "org" (s))
+(declare-function org-file-contents "org" (file &optional noerror nocache))
+(declare-function org-file-url-p "org" (file))
+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-mode "org" ())
-(declare-function org-file-contents "org" (file &optional noerror))
+(declare-function org-trim "org" (s &optional keep-lead))
+(declare-function vc-backend "vc-hooks" (f))
+(declare-function vc-call "vc-hooks" (fun file &rest args) t)
+(declare-function vc-exec-after "vc-dispatcher" (code))
;;; Variables
-(defvar org-macro-templates nil
+(defvar-local org-macro-templates nil
"Alist containing all macro templates in current buffer.
Associations are in the shape of (NAME . TEMPLATE) where NAME
stands for macro's name and template for its replacement value,
@@ -59,48 +74,53 @@ both as strings. This is an internal variable. Do not set it
directly, use instead:
#+MACRO: name template")
-(make-variable-buffer-local 'org-macro-templates)
-
;;; Functions
(defun org-macro--collect-macros ()
"Collect macro definitions in current buffer and setup files.
Return an alist containing all macro templates found."
- (let* (collect-macros ; For byte-compiler.
- (collect-macros
- (lambda (files templates)
- ;; Return an alist of macro templates. FILES is a list of
- ;; setup files names read so far, used to avoid circular
- ;; dependencies. TEMPLATES is the alist collected so far.
- (let ((case-fold-search t))
- (org-with-wide-buffer
- (goto-char (point-min))
- (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 (org-element-property :key element) "MACRO")
- ;; Install macro in TEMPLATES.
- (when (string-match
- "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
- (let* ((name (match-string 1 val))
- (template (or (match-string 2 val) ""))
- (old-cell (assoc name templates)))
- (if old-cell (setcdr old-cell template)
- (push (cons name template) templates))))
- ;; Enter setup file.
- (let ((file (expand-file-name
- (org-remove-double-quotes val))))
- (unless (member file files)
- (with-temp-buffer
- (org-mode)
- (insert (org-file-contents file 'noerror))
- (setq templates
- (funcall collect-macros (cons file files)
- templates)))))))))))
- templates))))
+ (letrec ((collect-macros
+ (lambda (files templates)
+ ;; Return an alist of macro templates. FILES is a list
+ ;; of setup files names read so far, used to avoid
+ ;; circular dependencies. TEMPLATES is the alist
+ ;; collected so far.
+ (let ((case-fold-search t))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (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 (org-element-property :key element) "MACRO")
+ ;; Install macro in TEMPLATES.
+ (when (string-match
+ "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
+ (let* ((name (match-string 1 val))
+ (template (or (match-string 2 val) ""))
+ (old-cell (assoc name templates)))
+ (if old-cell (setcdr old-cell template)
+ (push (cons name template) templates))))
+ ;; Enter setup file.
+ (let* ((uri (org-unbracket-string "\"" "\"" (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)))
+ (org-mode)
+ (insert (org-file-contents uri 'noerror))
+ (setq templates
+ (funcall collect-macros (cons uri files)
+ templates)))))))))))
+ templates))))
(funcall collect-macros nil nil)))
(defun org-macro-initialize-templates ()
@@ -116,18 +136,34 @@ function installs the following ones: \"property\",
(let ((old-template (assoc (car cell) templates)))
(if old-template (setcdr old-template (cdr cell))
(push cell templates))))))
- ;; Install hard-coded macros.
- (mapc (lambda (cell) (funcall update-templates cell))
- (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))")
+ ;; Install "property", "time" macros.
+ (mapc update-templates
+ (list (cons "property"
+ "(eval (save-excursion
+ (let ((l \"$2\"))
+ (when (org-string-nw-p l)
+ (condition-case _
+ (let ((org-link-search-must-match-exact-headline t))
+ (org-link-search l nil t))
+ (error
+ (error \"Macro property failed: cannot find location %s\"
+ l)))))
+ (org-entry-get nil \"$1\" 'selective)))")
(cons "time" "(eval (format-time-string \"$1\"))")))
+ ;; Install "input-file", "modification-time" macros.
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(when (and visited-file (file-exists-p visited-file))
- (mapc (lambda (cell) (funcall update-templates cell))
+ (mapc update-templates
(list (cons "input-file" (file-name-nondirectory visited-file))
(cons "modification-time"
- (format "(eval (format-time-string \"$1\" '%s))"
+ (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))"
+ (prin1-to-string visited-file)
(prin1-to-string
(nth 5 (file-attributes visited-file)))))))))
+ ;; Initialize and install "n" macro.
+ (org-macro--counter-initialize)
+ (funcall update-templates
+ (cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))"))
(setq org-macro-templates templates)))
(defun org-macro-expand (macro templates)
@@ -154,38 +190,165 @@ default value. Return nil if no template was found."
;; Return string.
(format "%s" (or value ""))))))
-(defun org-macro-replace-all (templates)
+(defun org-macro-replace-all (templates &optional finalize keywords)
"Replace all macros in current buffer by their expansion.
+
TEMPLATES is an alist of templates used for expansion. See
-`org-macro-templates' for a buffer-local default value."
- (save-excursion
- (goto-char (point-min))
- (let (record)
- (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
- (let ((object (org-element-context)))
- (when (eq (org-element-type object) 'macro)
- (let* ((value (org-macro-expand object templates))
- (begin (org-element-property :begin object))
- (signature (list begin
- object
- (org-element-property :args object))))
- ;; Avoid circular dependencies by checking if the same
- ;; macro with the same arguments is expanded at the same
- ;; position twice.
- (if (member signature record)
- (error "Circular macro expansion: %s"
- (org-element-property :key object))
- (when value
- (push signature record)
- (delete-region
- begin
- ;; Preserve white spaces after the macro.
- (progn (goto-char (org-element-property :end object))
- (skip-chars-backward " \t")
- (point)))
- ;; Leave point before replacement in case of recursive
- ;; expansions.
- (save-excursion (insert value)))))))))))
+`org-macro-templates' for a buffer-local default value.
+
+If optional arg FINALIZE is non-nil, raise an error if a macro is
+found in the buffer with no definition in TEMPLATES.
+
+Optional argument KEYWORDS, when non-nil is a list of keywords,
+as strings, where macro expansion is allowed."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((properties-regexp (format "\\`EXPORT_%s\\+?\\'"
+ (regexp-opt keywords)))
+ record)
+ (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
+ (unless (save-match-data (org-in-commented-heading-p))
+ (let* ((datum (save-match-data (org-element-context)))
+ (type (org-element-type datum))
+ (macro
+ (cond
+ ((eq type 'macro) datum)
+ ;; In parsed keywords and associated node
+ ;; properties, force macro recognition.
+ ((or (and (eq type 'keyword)
+ (member (org-element-property :key datum) keywords))
+ (and (eq type 'node-property)
+ (string-match-p properties-regexp
+ (org-element-property :key datum))))
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (org-element-macro-parser))))))
+ (when macro
+ (let* ((value (org-macro-expand macro templates))
+ (begin (org-element-property :begin macro))
+ (signature (list begin
+ macro
+ (org-element-property :args macro))))
+ ;; Avoid circular dependencies by checking if the same
+ ;; macro with the same arguments is expanded at the
+ ;; same position twice.
+ (cond ((member signature record)
+ (error "Circular macro expansion: %s"
+ (org-element-property :key macro)))
+ (value
+ (push signature record)
+ (delete-region
+ begin
+ ;; Preserve white spaces after the macro.
+ (progn (goto-char (org-element-property :end macro))
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Leave point before replacement in case of
+ ;; recursive expansions.
+ (save-excursion (insert value)))
+ (finalize
+ (error "Undefined Org macro: %s; aborting"
+ (org-element-property :key macro))))))))))))
+
+(defun org-macro-escape-arguments (&rest args)
+ "Build macro's arguments string from ARGS.
+ARGS are strings. Return value is a string with arguments
+properly escaped and separated with commas. This is the opposite
+of `org-macro-extract-arguments'."
+ (let ((s ""))
+ (dolist (arg (reverse args) (substring s 1))
+ (setq s
+ (concat
+ ","
+ (replace-regexp-in-string
+ "\\(\\\\*\\),"
+ (lambda (m)
+ (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\)
+ ","))
+ ;; If a non-terminal argument ends on backslashes, make
+ ;; sure to also escape them as they will be followed by
+ ;; a comma.
+ (concat arg (and (not (equal s ""))
+ (string-match "\\\\+\\'" arg)
+ (match-string 0 arg)))
+ nil t)
+ s)))))
+
+(defun org-macro-extract-arguments (s)
+ "Extract macro arguments from string S.
+S is a string containing comma separated values properly escaped.
+Return a list of arguments, as strings. This is the opposite of
+`org-macro-escape-arguments'."
+ ;; Do not use `org-split-string' since empty strings are
+ ;; meaningful here.
+ (split-string
+ (replace-regexp-in-string
+ "\\(\\\\*\\),"
+ (lambda (str)
+ (let ((len (length (match-string 1 str))))
+ (concat (make-string (/ len 2) ?\\)
+ (if (zerop (mod len 2)) "\000" ","))))
+ s nil t)
+ "\000"))
+
+
+;;; Helper functions and variables for internal macros
+
+(defun org-macro--vc-modified-time (file)
+ (save-window-excursion
+ (when (vc-backend file)
+ (let ((buf (get-buffer-create " *org-vc*"))
+ (case-fold-search t)
+ date)
+ (unwind-protect
+ (progn
+ (vc-call print-log file buf nil nil 1)
+ (with-current-buffer buf
+ (vc-exec-after
+ (lambda ()
+ (goto-char (point-min))
+ (when (re-search-forward "Date:?[ \t]*" nil t)
+ (let ((time (parse-time-string
+ (buffer-substring
+ (point) (line-end-position)))))
+ (when (cl-some #'identity time)
+ (setq date (apply #'encode-time time))))))))
+ (let ((proc (get-buffer-process buf)))
+ (while (and proc (accept-process-output proc .5 nil t)))))
+ (kill-buffer buf))
+ date))))
+
+(defvar org-macro--counter-table nil
+ "Hash table containing counter value per name.")
+
+(defun org-macro--counter-initialize ()
+ "Initialize `org-macro--counter-table'."
+ (setq org-macro--counter-table (make-hash-table :test #'equal)))
+
+(defun org-macro--counter-increment (name &optional action)
+ "Increment counter NAME.
+NAME is a string identifying the counter.
+
+When non-nil, optional argument ACTION is a string.
+
+If the string is \"-\", keep the NAME counter at its current
+value, i.e. do not increment.
+
+If the string represents an integer, set the counter to this number.
+
+Any other non-empty string resets the counter to 1."
+ (let ((name-trimmed (org-trim name))
+ (action-trimmed (when (org-string-nw-p action)
+ (org-trim action))))
+ (puthash name-trimmed
+ (cond ((not (org-string-nw-p action-trimmed))
+ (1+ (gethash name-trimmed org-macro--counter-table 0)))
+ ((string= "-" action-trimmed)
+ (gethash name-trimmed org-macro--counter-table 1))
+ ((string-match-p "\\`[0-9]+\\'" action-trimmed)
+ (string-to-number action-trimmed))
+ (t 1))
+ org-macro--counter-table)))
(provide 'org-macro)
diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el
index 64e28cee04c..ff6d8c41d4b 100644
--- a/lisp/org/org-macs.el
+++ b/lisp/org/org-macs.el
@@ -1,4 +1,4 @@
-;;; org-macs.el --- Top-level definitions for Org-mode
+;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,35 +19,18 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;; This file contains macro definitions, defsubst definitions, other
-;; stuff needed for compilation and top-level forms in Org-mode, as well
-;; lots of small functions that are not org-mode specific but simply
-;; generally useful stuff.
+;; stuff needed for compilation and top-level forms in Org mode, as
+;; well lots of small functions that are not Org mode specific but
+;; simply generally useful stuff.
;;; Code:
-(eval-and-compile
- (unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional _arglist _fileonly)
- `(autoload ',fn ,file)))
-
- (if (>= emacs-major-version 23)
- (defsubst org-char-to-string(c)
- "Defsubst to decode UTF-8 character values in emacs 23 and beyond."
- (char-to-string c))
- (defsubst org-char-to-string (c)
- "Defsubst to decode UTF-8 character values in emacs 22."
- (string (decode-char 'ucs c)))))
-
-(declare-function org-add-props "org-compat" (string plist &rest props))
-(declare-function org-string-match-p "org-compat"
- (regexp string &optional start))
-
(defmacro org-with-gensyms (symbols &rest body)
(declare (debug (sexp body)) (indent 1))
`(let ,(mapcar (lambda (s)
@@ -55,52 +38,101 @@
symbols)
,@body))
-(defmacro org-called-interactively-p (&optional kind)
- (declare (debug (&optional ("quote" symbolp)))) ;Why not just t?
- (if (featurep 'xemacs)
- `(interactive-p)
- (if (or (> emacs-major-version 23)
- (and (>= emacs-major-version 23)
- (>= emacs-minor-version 2)))
- ;; defined with no argument in <=23.1
- `(with-no-warnings (called-interactively-p ,kind))
- `(interactive-p))))
-
-(defmacro org-bound-and-true-p (var)
- "Return the value of symbol VAR if it is bound, else nil."
- (declare (debug (symbolp)))
- `(and (boundp (quote ,var)) ,var))
-
(defun org-string-nw-p (s)
- "Is S a string with a non-white character?"
+ "Return S if S is a string containing a non-blank character.
+Otherwise, return nil."
(and (stringp s)
- (org-string-match-p "\\S-" s)
+ (string-match-p "[^ \r\t\n]" s)
s))
+(defun org-split-string (string &optional separators)
+ "Splits STRING into substrings at SEPARATORS.
+
+SEPARATORS is a regular expression. When nil, it defaults to
+\"[ \f\t\n\r\v]+\".
+
+Unlike `split-string', matching SEPARATORS at the beginning and
+end of string are ignored."
+ (let ((separators (or separators "[ \f\t\n\r\v]+")))
+ (when (string-match (concat "\\`" separators) string)
+ (setq string (replace-match "" nil nil string)))
+ (when (string-match (concat separators "\\'") string)
+ (setq string (replace-match "" nil nil string)))
+ (split-string string separators)))
+
+(defun org-string-display (string)
+ "Return STRING as it is displayed in the current buffer.
+This function takes into consideration `invisible' and `display'
+text properties."
+ (let* ((build-from-parts
+ (lambda (s property filter)
+ ;; Build a new string out of string S. On every group of
+ ;; contiguous characters with the same PROPERTY value,
+ ;; call FILTER on the properties list at the beginning of
+ ;; the group. If it returns a string, replace the
+ ;; characters in the group with it. Otherwise, preserve
+ ;; those characters.
+ (let ((len (length s))
+ (new "")
+ (i 0)
+ (cursor 0))
+ (while (setq i (text-property-not-all i len property nil s))
+ (let ((end (next-single-property-change i property s len))
+ (value (funcall filter (text-properties-at i s))))
+ (when value
+ (setq new (concat new (substring s cursor i) value))
+ (setq cursor end))
+ (setq i end)))
+ (concat new (substring s cursor)))))
+ (prune-invisible
+ (lambda (s)
+ (funcall build-from-parts s 'invisible
+ (lambda (props)
+ ;; If `invisible' property in PROPS means text
+ ;; is to be invisible, return the empty string.
+ ;; Otherwise return nil so that the part is
+ ;; skipped.
+ (and (or (eq t buffer-invisibility-spec)
+ (assoc-string (plist-get props 'invisible)
+ buffer-invisibility-spec))
+ "")))))
+ (replace-display
+ (lambda (s)
+ (funcall build-from-parts s 'display
+ (lambda (props)
+ ;; If there is any string specification in
+ ;; `display' property return it. Also attach
+ ;; other text properties on the part to that
+ ;; string (face...).
+ (let* ((display (plist-get props 'display))
+ (value (if (stringp display) display
+ (cl-some #'stringp display))))
+ (when value
+ (apply #'propertize
+ ;; Displayed string could contain
+ ;; invisible parts, but no nested
+ ;; display.
+ (funcall prune-invisible value)
+ 'display
+ (and (not (stringp display))
+ (cl-remove-if #'stringp display))
+ props))))))))
+ ;; `display' property overrides `invisible' one. So we first
+ ;; replace characters with `display' property. Then we remove
+ ;; invisible characters.
+ (funcall prune-invisible (funcall replace-display string))))
+
+(defun org-string-width (string)
+ "Return width of STRING when displayed in the current buffer.
+Unlike `string-width', this function takes into consideration
+`invisible' and `display' text properties."
+ (string-width (org-string-display string)))
+
(defun org-not-nil (v)
"If V not nil, and also not the string \"nil\", then return V.
Otherwise return nil."
(and v (not (equal v "nil")) v))
-(defun org-substitute-posix-classes (re)
- "Substitute posix classes in regular expression RE."
- (let ((ss re))
- (save-match-data
- (while (string-match "\\[:alnum:\\]" ss)
- (setq ss (replace-match "a-zA-Z0-9" t t ss)))
- (while (string-match "\\[:word:\\]" ss)
- (setq ss (replace-match "a-zA-Z0-9" t t ss)))
- (while (string-match "\\[:alpha:\\]" ss)
- (setq ss (replace-match "a-zA-Z" t t ss)))
- (while (string-match "\\[:punct:\\]" ss)
- (setq ss (replace-match "\001-@[-`{-~" t t ss)))
- ss)))
-
-(defmacro org-re (s)
- "Replace posix classes in regular expression."
- (declare (debug (form)))
- (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s))
-
(defmacro org-preserve-lc (&rest body)
(declare (debug (body)))
(org-with-gensyms (line col)
@@ -136,19 +168,6 @@ Otherwise return nil."
(partial-completion-mode 1))
,@body))
-;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22
-(defmacro org-maybe-intangible (props)
- "Add (intangible t) to PROPS if Emacs version is earlier than Emacs 22.
-In Emacs 21, invisible text is not avoided by the command loop, so the
-intangible property is needed to make sure point skips this text.
-In Emacs 22, this is not necessary. The intangible text property has
-led to problems with flyspell. These problems are fixed in flyspell.el,
-but we still avoid setting the property in Emacs 22 and later.
-We use a macro so that the test can happen at compilation time."
- (if (< emacs-major-version 22)
- `(append '(intangible t) ,props)
- props))
-
(defmacro org-with-point-at (pom &rest body)
"Move to buffer and point of point-or-marker POM for the duration of BODY."
(declare (debug (form body)) (indent 1))
@@ -160,10 +179,6 @@ We use a macro so that the test can happen at compilation time."
(goto-char (or ,mpom (point)))
,@body)))))
-(defmacro org-no-warnings (&rest body)
- (declare (debug (body)))
- (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body))
-
(defmacro org-with-remote-undo (buffer &rest body)
"Execute BODY while recording undo information in two buffers."
(declare (debug (form body)) (indent 1))
@@ -199,22 +214,12 @@ We use a macro so that the test can happen at compilation time."
org-emphasis t)
"Properties to remove when a string without properties is wanted.")
-(defsubst org-match-string-no-properties (num &optional string)
- (if (featurep 'xemacs)
- (let ((s (match-string num string)))
- (and s (remove-text-properties 0 (length s) org-rm-props s))
- s)
- (match-string-no-properties num string)))
-
(defsubst org-no-properties (s &optional restricted)
"Remove all text properties from string S.
When RESTRICTED is non-nil, only remove the properties listed
in `org-rm-props'."
- (if (fboundp 'set-text-properties)
- (set-text-properties 0 (length s) nil s)
- (if restricted
- (remove-text-properties 0 (length s) org-rm-props s)
- (set-text-properties 0 (length s) nil s)))
+ (if restricted (remove-text-properties 0 (length s) org-rm-props s)
+ (set-text-properties 0 (length s) nil s))
s)
(defsubst org-get-alist-option (option key)
@@ -236,16 +241,6 @@ program is needed for, so that the error message can be more informative."
(error "Can't find `%s'%s" cmd
(if use (format " (%s)" use) "")))))
-(defsubst org-inhibit-invisibility ()
- "Modified `buffer-invisibility-spec' for Emacs 21.
-Some ops with invisible text do not work correctly on Emacs 21. For these
-we turn off invisibility temporarily. Use this in a `let' form."
- (if (< emacs-major-version 22) nil buffer-invisibility-spec))
-
-(defsubst org-set-local (var value)
- "Make VAR local in current buffer and set it to VALUE."
- (set (make-local-variable var) value))
-
(defsubst org-last (list)
"Return the last element of LIST."
(car (last list)))
@@ -282,11 +277,11 @@ we turn off invisibility temporarily. Use this in a `let' form."
(<= (match-beginning n) pos)
(>= (match-end n) pos)))
-(defun org-match-line (re)
- "Looking-at at the beginning of the current line."
+(defun org-match-line (regexp)
+ "Match REGEXP at the beginning of the current line."
(save-excursion
- (goto-char (point-at-bol))
- (looking-at re)))
+ (beginning-of-line)
+ (looking-at regexp)))
(defun org-plist-delete (plist property)
"Delete PROPERTY from PLIST.
@@ -298,13 +293,6 @@ This is in contrast to merely setting it to 0."
(setq plist (cddr plist)))
p))
-(defun org-replace-match-keep-properties (newtext &optional fixedcase
- literal string)
- "Like `replace-match', but add the text properties found original text."
- (setq newtext (org-add-props newtext (text-properties-at
- (match-beginning 0) string)))
- (replace-match newtext fixedcase literal string))
-
(defmacro org-save-outline-visibility (use-markers &rest body)
"Save and restore outline visibility around BODY.
If USE-MARKERS is non-nil, use markers for the positions.
@@ -313,19 +301,15 @@ but it also means that the buffer should stay alive
during the operation, because otherwise all these markers will
point nowhere."
(declare (debug (form body)) (indent 1))
- (org-with-gensyms (data rtn)
- `(let ((,data (org-outline-overlay-data ,use-markers))
- ,rtn)
+ (org-with-gensyms (data)
+ `(let ((,data (org-outline-overlay-data ,use-markers)))
(unwind-protect
- (progn
- (setq ,rtn (progn ,@body))
+ (prog1 (progn ,@body)
(org-set-outline-overlay-data ,data))
(when ,use-markers
- (mapc (lambda (c)
- (and (markerp (car c)) (move-marker (car c) nil))
- (and (markerp (cdr c)) (move-marker (cdr c) nil)))
- ,data)))
- ,rtn)))
+ (dolist (c ,data)
+ (when (markerp (car c)) (move-marker (car c) nil))
+ (when (markerp (cdr c)) (move-marker (cdr c) nil))))))))
(defmacro org-with-wide-buffer (&rest body)
"Execute body while temporarily widening the buffer."
@@ -355,17 +339,16 @@ point nowhere."
(defun org-get-limited-outline-regexp ()
"Return outline-regexp with limited number of levels.
The number of levels is controlled by `org-inlinetask-min-level'"
- (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask)))
- org-outline-regexp
- (let* ((limit-level (1- org-inlinetask-min-level))
- (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level)))
- (format "\\*\\{1,%d\\} " nstars))))
-
-(defun org-format-seconds (string seconds)
- "Compatibility function replacing format-seconds."
- (if (fboundp 'format-seconds)
- (format-seconds string seconds)
- (format-time-string string (seconds-to-time seconds))))
+ (cond ((not (derived-mode-p 'org-mode))
+ outline-regexp)
+ ((not (featurep 'org-inlinetask))
+ org-outline-regexp)
+ (t
+ (let* ((limit-level (1- org-inlinetask-min-level))
+ (nstars (if org-odd-levels-only
+ (1- (* limit-level 2))
+ limit-level)))
+ (format "\\*\\{1,%d\\} " nstars)))))
(defmacro org-eval-in-environment (environment form)
(declare (debug (form form)) (indent 1))
@@ -382,10 +365,64 @@ the value in cdr."
;;;###autoload
(defmacro org-load-noerror-mustsuffix (file)
- "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it."
- (if (featurep 'xemacs)
- `(load ,file 'noerror)
- `(load ,file 'noerror nil nil 'mustsuffix)))
+ "Load FILE with optional arguments NOERROR and MUSTSUFFIX."
+ `(load ,file 'noerror nil nil 'mustsuffix))
+
+(defun org-unbracket-string (pre post string)
+ "Remove PRE/POST from the beginning/end of STRING.
+Both PRE and POST must be pre-/suffixes of STRING, or neither is
+removed."
+ (if (and (string-prefix-p pre string)
+ (string-suffix-p post string))
+ (substring string (length pre) (- (length post)))
+ string))
+
+(defun org-read-function (prompt &optional allow-empty?)
+ "Prompt for a function.
+If ALLOW-EMPTY? is non-nil, return nil rather than raising an
+error when the user input is empty."
+ (let ((func (completing-read prompt obarray #'fboundp t)))
+ (cond ((not (string= func ""))
+ (intern func))
+ (allow-empty? nil)
+ (t (user-error "Empty input is not valid")))))
+
+(defconst org-unique-local-variables
+ '(org-element--cache
+ org-element--cache-objects
+ org-element--cache-sync-keys
+ org-element--cache-sync-requests
+ org-element--cache-sync-timer)
+ "List of local variables that cannot be transferred to another buffer.")
+
+(defun org-get-local-variables ()
+ "Return a list of all local variables in an Org mode buffer."
+ (delq nil
+ (mapcar
+ (lambda (x)
+ (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x))))
+ (name (car binding)))
+ (and (not (get name 'org-state))
+ (not (memq name org-unique-local-variables))
+ (string-match-p
+ "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\
+auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
+ (symbol-name name))
+ binding)))
+ (with-temp-buffer
+ (org-mode)
+ (buffer-local-variables)))))
+
+(defun org-clone-local-variables (from-buffer &optional regexp)
+ "Clone local variables from FROM-BUFFER.
+Optional argument REGEXP selects variables to clone."
+ (dolist (pair (buffer-local-variables from-buffer))
+ (pcase pair
+ (`(,name . ,value) ;ignore unbound variables
+ (when (and (not (memq name org-unique-local-variables))
+ (or (null regexp) (string-match-p regexp (symbol-name name))))
+ (ignore-errors (set (make-local-variable name) value)))))))
+
(provide 'org-macs)
diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el
index d1067cd57e9..f06fea7777d 100644
--- a/lisp/org/org-mhe.el
+++ b/lisp/org/org-mhe.el
@@ -1,4 +1,4 @@
-;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode
+;;; org-mhe.el --- Support for Links to MH-E Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,13 +19,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file implements links to MH-E messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
+;; This file implements links to MH-E messages from within Org.
+;; Org mode loads this module by default - if this is not what you want,
;; configure the variable `org-modules'.
;;; Code:
@@ -74,34 +74,25 @@ supported by MH-E."
(defvar mh-search-regexp-builder)
;; Install the link type
-(org-add-link-type "mhe" 'org-mhe-open)
-(add-hook 'org-store-link-functions 'org-mhe-store-link)
+(org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link)
;; Implementation
(defun org-mhe-store-link ()
"Store a link to an MH-E folder or message."
- (when (or (equal major-mode 'mh-folder-mode)
- (equal major-mode 'mh-show-mode))
+ (when (or (eq major-mode 'mh-folder-mode)
+ (eq major-mode 'mh-show-mode))
(save-window-excursion
(let* ((from (org-mhe-get-header "From:"))
(to (org-mhe-get-header "To:"))
(message-id (org-mhe-get-header "Message-Id:"))
(subject (org-mhe-get-header "Subject:"))
(date (org-mhe-get-header "Date:"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t) (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
link desc)
- (org-store-link-props :type "mh" :from from :to to
+ (org-store-link-props :type "mh" :from from :to to :date date
:subject subject :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
(setq desc (org-email-link-description))
(setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#"
- (org-remove-angle-brackets message-id)))
+ (org-unbracket-string "<" ">" message-id)))
(org-add-link-props :link link :description desc)
link))))
@@ -120,7 +111,7 @@ supported by MH-E."
So if you use sequences, it will now work."
(save-excursion
(let* ((folder
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
mh-current-folder
;; Refer to the show buffer
mh-show-folder-buffer))
@@ -132,7 +123,7 @@ So if you use sequences, it will now work."
;; mh-index-data is always nil in a show buffer.
(if (and (boundp 'mh-index-folder)
(string= mh-index-folder (substring folder 0 end-index)))
- (if (equal major-mode 'mh-show-mode)
+ (if (eq major-mode 'mh-show-mode)
(save-window-excursion
(let (pop-up-frames)
(when (buffer-live-p (get-buffer folder))
@@ -158,7 +149,7 @@ So if you use sequences, it will now work."
"Return the name of the current message folder.
Be careful if you use sequences."
(save-excursion
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
mh-current-folder
;; Refer to the show buffer
mh-show-folder-buffer)))
@@ -167,7 +158,7 @@ Be careful if you use sequences."
"Return the number of the current message.
Be careful if you use sequences."
(save-excursion
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
(mh-get-msg-num nil)
;; Refer to the show buffer
(mh-show-buffer-message-number))))
@@ -182,12 +173,12 @@ you have a better idea of how to do this then please let us know."
(header-field))
(with-current-buffer buffer
(mh-display-msg num folder)
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
(mh-header-display)
(mh-show-header-display))
(set-buffer buffer)
(setq header-field (mh-get-header-field header))
- (if (equal major-mode 'mh-folder-mode)
+ (if (eq major-mode 'mh-folder-mode)
(mh-show)
(mh-show-show))
(org-trim header-field))))
@@ -206,13 +197,13 @@ folders."
(if (not article)
(mh-visit-folder (mh-normalize-folder-name folder))
(mh-search-choose)
- (if (equal mh-searcher 'pick)
+ (if (eq mh-searcher 'pick)
(progn
(setq article (org-add-angle-brackets article))
(mh-search folder (list "--message-id" article))
(when (and org-mhe-search-all-folders
(not (org-mhe-get-message-real-folder)))
- (kill-current-buffer)
+ (kill-buffer)
(mh-search "+" (list "--message-id" article))))
(if mh-search-regexp-builder
(mh-search "+" (funcall mh-search-regexp-builder
@@ -220,7 +211,7 @@ folders."
(mh-search "+" article)))
(if (org-mhe-get-message-real-folder)
(mh-show-msg 1)
- (kill-current-buffer)
+ (kill-buffer)
(error "Message not found"))))
(provide 'org-mhe)
diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el
index 34e6af10d81..a548930c0f9 100644
--- a/lisp/org/org-mobile.el
+++ b/lisp/org/org-mobile.el
@@ -1,4 +1,4 @@
-;;; org-mobile.el --- Code for asymmetric sync with a mobile device
+;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2017 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
@@ -18,27 +18,26 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;
-;; This file contains the code to interact with Richard Moreland's iPhone
-;; application MobileOrg, as well as with the Android version by Matthew Jones.
-;; This code is documented in Appendix B of the Org-mode manual. The code is
-;; not specific for the iPhone and Android - any external
-;; viewer/flagging/editing application that uses the same conventions could
-;; be used.
+;; This file contains the code to interact with Richard Moreland's
+;; iPhone application MobileOrg, as well as with the Android version
+;; by Matthew Jones. This code is documented in Appendix B of the Org
+;; manual. The code is not specific for the iPhone and Android - any
+;; external viewer/flagging/editing application that uses the same
+;; conventions could be used.
(require 'org)
(require 'org-agenda)
-;;; Code:
+(require 'cl-lib)
-(eval-when-compile (require 'cl))
+(defvar org-agenda-keep-restricted-file-list)
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
+;;; Code:
(defgroup org-mobile nil
"Options concerning support for a viewer/editor on a mobile device."
@@ -192,27 +191,6 @@ the editing types for which the mobile version should always dominate."
(const heading)
(const body))))
-(defcustom org-mobile-action-alist
- '(("edit" . (org-mobile-edit data old new)))
- "Alist with flags and actions for mobile sync.
-When flagging an entry, MobileOrg will create entries that look like
-
- * F(action:data) [[id:entry-id][entry title]]
-
-This alist defines that the ACTION in the parentheses of F() should mean,
-i.e. what action should be taken. The :data part in the parenthesis is
-optional. If present, the string after the colon will be passed to the
-action form as the `data' variable.
-The car of each elements of the alist is an actions string. The cdr is
-an Emacs Lisp form that will be evaluated with the cursor on the headline
-of that entry.
-
-For now, it is not recommended to change this variable."
- :group 'org-mobile
- :type '(repeat
- (cons (string :tag "Action flag")
- (sexp :tag "Action form"))))
-
(defcustom org-mobile-checksum-binary (or (executable-find "shasum")
(executable-find "sha1sum")
(executable-find "md5sum")
@@ -249,6 +227,23 @@ by the mobile device, this hook should be used to copy the emptied
capture file `mobileorg.org' back to the WebDAV directory, for example
using `rsync' or `scp'.")
+(defconst org-mobile-action-alist '(("edit" . org-mobile-edit))
+ "Alist with flags and actions for mobile sync.
+When flagging an entry, MobileOrg will create entries that look like
+
+ * F(action:data) [[id:entry-id][entry title]]
+
+This alist defines that the ACTION in the parentheses of F()
+should mean, i.e. what action should be taken. The :data part in
+the parenthesis is optional. If present, the string after the
+colon will be passed to the action function as the first argument
+variable.
+
+The car of each elements of the alist is an actions string. The
+cdr is a function that is called with the cursor on the headline
+of that entry. It should accept three arguments, the :data part,
+the old and new values for the entry.")
+
(defvar org-mobile-last-flagged-files nil
"List of files containing entries flagged in the latest pull.")
@@ -313,40 +308,29 @@ Also exclude files matching `org-mobile-files-exclude-regexp'."
This will create the index file, copy all agenda files there, and also
create all custom agenda views, for upload to the mobile phone."
(interactive)
- (let ((a-buffer (get-buffer org-agenda-buffer-name)))
- (let ((org-agenda-curbuf-name org-agenda-buffer-name)
- (org-agenda-buffer-name "*SUMO*")
- (org-agenda-tag-filter org-agenda-tag-filter)
- (org-agenda-redo-command org-agenda-redo-command))
- (save-excursion
- (save-restriction
- (save-window-excursion
- (run-hooks 'org-mobile-pre-push-hook)
- (org-mobile-check-setup)
- (org-mobile-prepare-file-lists)
- (message "Creating agendas...")
- (let ((inhibit-redisplay t)
- (org-agenda-files (mapcar 'car org-mobile-files-alist)))
- (org-mobile-create-sumo-agenda))
- (message "Creating agendas...done")
- (org-save-all-org-buffers) ; to save any IDs created by this process
- (message "Copying files...")
- (org-mobile-copy-agenda-files)
- (message "Writing index file...")
- (org-mobile-create-index-file)
- (message "Writing checksums...")
- (org-mobile-write-checksums)
- (run-hooks 'org-mobile-post-push-hook))))
- (setq org-agenda-buffer-name org-agenda-curbuf-name
- org-agenda-this-buffer-name org-agenda-curbuf-name))
- (redraw-display)
- (when (buffer-live-p a-buffer)
- (if (not (get-buffer-window a-buffer))
- (kill-buffer a-buffer)
- (let ((cw (selected-window)))
- (select-window (get-buffer-window a-buffer))
- (org-agenda-redo)
- (select-window cw)))))
+ (let ((org-agenda-buffer-name "*SUMO*")
+ (org-agenda-tag-filter org-agenda-tag-filter)
+ (org-agenda-redo-command org-agenda-redo-command))
+ (save-excursion
+ (save-restriction
+ (save-window-excursion
+ (run-hooks 'org-mobile-pre-push-hook)
+ (org-mobile-check-setup)
+ (org-mobile-prepare-file-lists)
+ (message "Creating agendas...")
+ (let ((inhibit-redisplay t)
+ (org-agenda-files (mapcar 'car org-mobile-files-alist)))
+ (org-mobile-create-sumo-agenda))
+ (message "Creating agendas...done")
+ (org-save-all-org-buffers) ; to save any IDs created by this process
+ (message "Copying files...")
+ (org-mobile-copy-agenda-files)
+ (message "Writing index file...")
+ (org-mobile-create-index-file)
+ (message "Writing checksums...")
+ (org-mobile-write-checksums)
+ (run-hooks 'org-mobile-post-push-hook)))))
+ (org-agenda-maybe-redo)
(message "Files for mobile viewer staged"))
(defvar org-mobile-before-process-capture-hook nil
@@ -422,10 +406,10 @@ agenda view showing the flagged items."
(let ((files-alist (sort (copy-sequence org-mobile-files-alist)
(lambda (a b) (string< (cdr a) (cdr b)))))
(def-todo (default-value 'org-todo-keywords))
- (def-tags (default-value 'org-tag-alist))
+ (def-tags org-tag-alist)
(target-file (expand-file-name org-mobile-index-file
org-mobile-directory))
- file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds)
+ todo-kwds done-kwds tags)
(when (stringp (car def-todo))
(setq def-todo (list (cons 'sequence def-todo))))
(org-agenda-prepare-buffers (mapcar 'car files-alist))
@@ -433,52 +417,36 @@ agenda view showing the flagged items."
(setq todo-kwds (org-delete-all
done-kwds
(org-uniquify org-todo-keywords-for-agenda)))
- (setq drawers (org-uniquify org-drawers-for-agenda))
(setq tags (mapcar 'car (org-global-tags-completion-table
(mapcar 'car files-alist))))
- (with-temp-file
- (if org-mobile-use-encryption
- org-mobile-encryption-tempfile
- target-file)
- (while (setq entry (pop def-todo))
- (insert "#+READONLY\n")
- (setq kwds (mapcar (lambda (x) (if (string-match "(" x)
- (substring x 0 (match-beginning 0))
- x))
- (cdr entry)))
- (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n")
- (setq dwds (member "|" kwds)
- twds (org-delete-all dwds kwds)
- todo-kwds (org-delete-all twds todo-kwds)
- done-kwds (org-delete-all dwds done-kwds)))
+ (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile
+ target-file)
+ (insert "#+READONLY\n")
+ (dolist (entry def-todo)
+ (let ((kwds (mapcar (lambda (x)
+ (if (string-match "(" x)
+ (substring x 0 (match-beginning 0))
+ x))
+ (cdr entry))))
+ (insert "#+TODO: " (mapconcat #'identity kwds " ") "\n")
+ (let* ((dwds (or (member "|" kwds) (last kwds)))
+ (twds (org-delete-all dwds kwds)))
+ (setq todo-kwds (org-delete-all twds todo-kwds))
+ (setq done-kwds (org-delete-all dwds done-kwds)))))
(when (or todo-kwds done-kwds)
(insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | "
(mapconcat 'identity done-kwds " ") "\n"))
- (setq def-tags (mapcar
- (lambda (x)
- (cond ((null x) nil)
- ((stringp x) x)
- ((eq (car x) :startgroup) "{")
- ((eq (car x) :endgroup) "}")
- ((eq (car x) :grouptags) nil)
- ((eq (car x) :newline) nil)
- ((listp x) (car x))))
- def-tags))
- (setq def-tags (delq nil def-tags))
+ (setq def-tags (split-string (org-tag-alist-to-string def-tags t)))
(setq tags (org-delete-all def-tags tags))
(setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b)))))
(setq tags (append def-tags tags nil))
(insert "#+TAGS: " (mapconcat 'identity tags " ") "\n")
- (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n")
(insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n")
(when (file-exists-p (expand-file-name
org-mobile-directory "agendas.org"))
(insert "* [[file:agendas.org][Agenda Views]]\n"))
- (while (setq entry (pop files-alist))
- (setq file (car entry)
- link-name (cdr entry))
- (insert (format "* [[file:%s][%s]]\n"
- link-name link-name)))
+ (pcase-dolist (`(,_ . ,link-name) files-alist)
+ (insert (format "* [[file:%s][%s]]\n" link-name link-name)))
(push (cons org-mobile-index-file (md5 (buffer-string)))
org-mobile-checksum-files))
(when org-mobile-use-encryption
@@ -499,9 +467,10 @@ agenda view showing the flagged items."
(make-directory target-dir 'parents))
(if org-mobile-use-encryption
(org-mobile-encrypt-and-move file target-path)
- (copy-file file target-path 'ok-if-exists))
+ (copy-file file target-path 'ok-if-already-exists))
(setq check (shell-command-to-string
- (concat org-mobile-checksum-binary " "
+ (concat (shell-quote-argument org-mobile-checksum-binary)
+ " "
(shell-quote-argument (expand-file-name file)))))
(when (string-match "[a-fA-F0-9]\\{30,40\\}" check)
(push (cons link-name (match-string 0 check))
@@ -663,7 +632,7 @@ The table of checksums is written to the file mobile-checksums."
m 10 " " 'planning)
"\n")
(when (setq id
- (if (org-bound-and-true-p
+ (if (bound-and-true-p
org-mobile-force-id-on-agenda-items)
(org-id-get m 'create)
(or (org-entry-get m "ID")
@@ -679,7 +648,7 @@ The table of checksums is written to the file mobile-checksums."
(org-with-point-at pom
(concat "olp:"
(org-mobile-escape-olp (file-name-nondirectory buffer-file-name))
- "/"
+ ":"
(mapconcat 'org-mobile-escape-olp
(org-get-outline-path)
"/")
@@ -718,13 +687,13 @@ encryption program does not understand them."
(let ((encfile (concat infile "_enc")))
(org-mobile-encrypt-file infile encfile)
(when outfile
- (copy-file encfile outfile 'ok-if-exists)
+ (copy-file encfile outfile 'ok-if-already-exists)
(delete-file encfile))))
(defun org-mobile-encrypt-file (infile outfile)
"Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
(shell-command
- (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s"
+ (format "openssl enc -md md5 -aes-256-cbc -salt -pass %s -in %s -out %s"
(shell-quote-argument (concat "pass:"
(org-mobile-encryption-password)))
(shell-quote-argument (expand-file-name infile))
@@ -733,7 +702,7 @@ encryption program does not understand them."
(defun org-mobile-decrypt-file (infile outfile)
"Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'."
(shell-command
- (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s"
+ (format "openssl enc -md md5 -d -aes-256-cbc -salt -pass %s -in %s -out %s"
(shell-quote-argument (concat "pass:"
(org-mobile-encryption-password)))
(shell-quote-argument (expand-file-name infile))
@@ -823,14 +792,14 @@ If BEG and END are given, only do this in that region."
(cnt-flag 0)
(cnt-error 0)
buf-list
- id-pos org-mobile-error)
+ org-mobile-error)
;; Count the new captures
(goto-char beg)
(while (re-search-forward "^\\* \\(.*\\)" end t)
(and (>= (- (match-end 1) (match-beginning 1)) 2)
(not (equal (downcase (substring (match-string 1) 0 2)) "f("))
- (incf cnt-new)))
+ (cl-incf cnt-new)))
;; Find and apply the edits
(goto-char beg)
@@ -842,19 +811,21 @@ If BEG and END are given, only do this in that region."
(id-pos (condition-case msg
(org-mobile-locate-entry (match-string 4))
(error (nth 1 msg))))
- (bos (point-at-bol))
+ (bos (line-beginning-position))
(eos (save-excursion (org-end-of-subtree t t)))
(cmd (if (equal action "")
- '(progn
- (incf cnt-flag)
- (org-toggle-tag "FLAGGED" 'on)
- (and note
- (org-entry-put nil "THEFLAGGINGNOTE" note)))
- (incf cnt-edit)
+ (let ((note (buffer-substring-no-properties
+ (line-beginning-position 2) eos)))
+ (lambda (_data _old _new)
+ (cl-incf cnt-flag)
+ (org-toggle-tag "FLAGGED" 'on)
+ (org-entry-put
+ nil "THEFLAGGINGNOTE"
+ (replace-regexp-in-string "\n" "\\\\n" note))))
+ (cl-incf cnt-edit)
(cdr (assoc action org-mobile-action-alist))))
- (note (and (equal action "")
- (buffer-substring (1+ (point-at-eol)) eos)))
- (org-inhibit-logging 'note) ;; Do not take notes interactively
+ ;; Do not take notes interactively.
+ (org-inhibit-logging 'note)
old new)
(goto-char bos)
@@ -867,11 +838,11 @@ If BEG and END are given, only do this in that region."
(if (stringp id-pos)
(insert id-pos " ")
(insert "BAD REFERENCE "))
- (incf cnt-error)
+ (cl-incf cnt-error)
(throw 'next t))
(unless cmd
(insert "BAD FLAG ")
- (incf cnt-error)
+ (cl-incf cnt-error)
(throw 'next t))
(move-marker bos-marker (point))
(if (re-search-forward "^** Old value[ \t]*$" eos t)
@@ -884,34 +855,28 @@ If BEG and END are given, only do this in that region."
(progn (outline-next-heading)
(if (eobp) (org-back-over-empty-lines))
(point)))))
- (setq old (and old (if (string-match "\\S-" old) old nil)))
- (setq new (and new (if (string-match "\\S-" new) new nil)))
- (if (and note (> (length note) 0))
- ;; Make Note into a single line, to fit into a property
- (setq note (mapconcat 'identity
- (org-split-string (org-trim note) "\n")
- "\\n")))
+ (setq old (org-string-nw-p old))
+ (setq new (org-string-nw-p new))
(unless (equal data "body")
- (setq new (and new (org-trim new))
- old (and old (org-trim old))))
+ (setq new (and new (org-trim new)))
+ (setq old (and old (org-trim old))))
(goto-char (+ 2 bos-marker))
;; Remember this place so that we can return
(move-marker marker (point))
(setq org-mobile-error nil)
- (save-excursion
- (condition-case msg
- (org-with-point-at id-pos
- (progn
- (eval cmd)
- (unless (member data (list "delete" "archive" "archive-sibling" "addheading"))
- (if (member "FLAGGED" (org-get-tags))
- (add-to-list 'org-mobile-last-flagged-files
- (buffer-file-name (current-buffer)))))))
- (error (setq org-mobile-error msg))))
+ (condition-case msg
+ (org-with-point-at id-pos
+ (funcall cmd data old new)
+ (unless (member data '("delete" "archive" "archive-sibling"
+ "addheading"))
+ (when (member "FLAGGED" (org-get-tags))
+ (add-to-list 'org-mobile-last-flagged-files
+ (buffer-file-name)))))
+ (error (setq org-mobile-error msg)))
(when org-mobile-error
- (org-pop-to-buffer-same-window (marker-buffer marker))
+ (pop-to-buffer-same-window (marker-buffer marker))
(goto-char marker)
- (incf cnt-error)
+ (cl-incf cnt-error)
(insert (if (stringp (nth 1 org-mobile-error))
(nth 1 org-mobile-error)
"EXECUTION FAILED")
@@ -924,8 +889,8 @@ If BEG and END are given, only do this in that region."
(save-buffer)
(move-marker marker nil)
(move-marker end nil)
- (message "%d new, %d edits, %d flags, %d errors" cnt-new
- cnt-edit cnt-flag cnt-error)
+ (message "%d new, %d edits, %d flags, %d errors"
+ cnt-new cnt-edit cnt-flag cnt-error)
(sit-for 1)))
(defun org-mobile-timestamp-buffer (buf)
@@ -1020,7 +985,7 @@ be returned that indicates what went wrong."
((equal new "DONEARCHIVE")
(org-todo 'done)
(org-archive-subtree-default))
- ((equal new current) t) ; nothing needs to be done
+ ((equal new current) t) ; nothing needs to be done
((or (equal current old)
(eq org-mobile-force-mobile-change t)
(memq 'todo org-mobile-force-mobile-change))
@@ -1042,33 +1007,35 @@ be returned that indicates what went wrong."
(or old "") (or current "")))))
((eq what 'priority)
- (when (looking-at org-complex-heading-regexp)
- (setq current (and (match-end 3) (substring (match-string 3) 2 3)))
- (cond
- ((equal current new) t) ; no action required
- ((or (equal current old)
- (eq org-mobile-force-mobile-change t)
- (memq 'tags org-mobile-force-mobile-change))
- (org-priority (and new (string-to-char new))))
- (t (error "Priority was expected to be %s, but is %s"
- old current)))))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (let ((current (and (match-end 3) (substring (match-string 3) 2 3))))
+ (cond
+ ((equal current new) t) ;no action required
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'tags org-mobile-force-mobile-change))
+ (org-priority (and new (string-to-char new))))
+ (t (error "Priority was expected to be %s, but is %s"
+ old current)))))))
((eq what 'heading)
- (when (looking-at org-complex-heading-regexp)
- (setq current (match-string 4))
- (cond
- ((equal current new) t) ; no action required
- ((or (equal current old)
- (eq org-mobile-force-mobile-change t)
- (memq 'heading org-mobile-force-mobile-change))
- (goto-char (match-beginning 4))
- (insert new)
- (delete-region (point) (+ (point) (length current)))
- (org-set-tags nil 'align))
- (t (error "Heading changed in MobileOrg and on the computer")))))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (let ((current (match-string 4)))
+ (cond
+ ((equal current new) t) ;no action required
+ ((or (equal current old)
+ (eq org-mobile-force-mobile-change t)
+ (memq 'heading org-mobile-force-mobile-change))
+ (goto-char (match-beginning 4))
+ (insert new)
+ (delete-region (point) (+ (point) (length current)))
+ (org-set-tags nil 'align))
+ (t (error "Heading changed in MobileOrg and on the computer")))))))
((eq what 'addheading)
- (if (org-at-heading-p) ; if false we are in top-level of file
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
;; Workaround a `org-insert-heading-respect-content' bug
;; which prevents correct insertion when point is invisible
@@ -1083,7 +1050,7 @@ be returned that indicates what went wrong."
((eq what 'refile)
(org-copy-subtree)
(org-with-point-at (org-mobile-locate-entry new)
- (if (org-at-heading-p) ; if false we are in top-level of file
+ (if (org-at-heading-p) ; if false we are in top-level of file
(progn
(setq level (org-get-valid-level (funcall outline-level) 1))
(org-end-of-subtree t t)
diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el
index 7eef5c6b8ba..7c982423228 100644
--- a/lisp/org/org-mouse.el
+++ b/lisp/org/org-mouse.el
@@ -1,4 +1,4 @@
-;;; org-mouse.el --- Better mouse support for org-mode
+;;; org-mouse.el --- Better mouse support for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -26,8 +26,8 @@
;;
;; http://orgmode.org
;;
-;; Org-mouse implements the following features:
-;; * following links with the left mouse button (in Emacs 22)
+;; Org mouse implements the following features:
+;; * following links with the left mouse button
;; * subtree expansion/collapse (org-cycle) with the left mouse button
;; * several context menus on the right mouse button:
;; + general text
@@ -66,12 +66,12 @@
;; History:
;;
-;; Since version 5.10: Changes are listed in the general org-mode docs.
+;; Since version 5.10: Changes are listed in the general Org docs.
;;
-;; Version 5.09;; + Version number synchronization with Org-mode.
+;; Version 5.09;; + Version number synchronization with Org mode.
;;
;; Version 0.25
-;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch)
+;; + made compatible with Org 4.70 (thanks to Carsten for the patch)
;;
;; Version 0.24
;; + minor changes to the table menu
@@ -81,7 +81,7 @@
;; + context menu support for org-agenda-undo & org-sort-entries
;;
;; Version 0.22
-;; + handles undo support for the agenda buffer (requires org-mode >=4.58)
+;; + handles undo support for the agenda buffer (requires Org >=4.58)
;;
;; Version 0.21
;; + selected text activates its context menu
@@ -105,7 +105,7 @@
;; + added support for checkboxes
;;
;; Version 0.15
-;; + org-mode now works with the Agenda buffer as well
+;; + Org now works with the Agenda buffer as well
;;
;; Version 0.14
;; + added a menu option that converts plain list items to outline items
@@ -125,7 +125,7 @@
;;
;; Version 0.10
;; + added a menu option to remove highlights
-;; + compatible with org-mode 4.21 now
+;; + compatible with Org 4.21 now
;;
;; Version 0.08:
;; + trees can be moved/promoted/demoted by dragging with the right
@@ -136,8 +136,8 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'org)
+(require 'cl-lib)
(defvar org-agenda-allow-remote-undo)
(defvar org-agenda-undo-list)
@@ -149,6 +149,8 @@
(declare-function org-agenda-earlier "org-agenda" (arg))
(declare-function org-agenda-later "org-agenda" (arg))
+(defvar org-mouse-main-buffer nil
+ "Active buffer for mouse operations.")
(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) "
"Regular expression that matches a plain list.")
(defvar org-mouse-direct t
@@ -191,15 +193,14 @@ Changing this variable requires a restart of Emacs to get activated."
(interactive)
(end-of-line)
(skip-chars-backward "\t ")
- (when (org-looking-back ":[A-Za-z]+:" (line-beginning-position))
+ (when (looking-back ":[A-Za-z]+:" (line-beginning-position))
(skip-chars-backward ":A-Za-z")
(skip-chars-backward "\t ")))
-(defvar org-mouse-context-menu-function nil
+(defvar-local org-mouse-context-menu-function nil
"Function to create the context menu.
The value of this variable is the function invoked by
`org-mouse-context-menu' as the context menu.")
-(make-variable-buffer-local 'org-mouse-context-menu-function)
(defun org-mouse-show-context-menu (event prefix)
"Invoke the context menu.
@@ -215,13 +216,12 @@ this function is called. Otherwise, the current major mode menu is used."
(when (not (org-mouse-mark-active))
(goto-char (posn-point (event-start event)))
(when (not (eolp)) (save-excursion (run-hooks 'post-command-hook)))
- (let ((redisplay-dont-pause t))
- (sit-for 0)))
+ (sit-for 0))
(if (functionp org-mouse-context-menu-function)
(funcall org-mouse-context-menu-function event)
(if (fboundp 'mouse-menu-major-mode-map)
(popup-menu (mouse-menu-major-mode-map) event prefix)
- (org-no-warnings ; don't warn about fallback, obsolete since 23.1
+ (with-no-warnings ; don't warn about fallback, obsolete since 23.1
(mouse-major-mode-menu event prefix)))))
(setq this-command 'mouse-save-then-kill)
(mouse-save-then-kill event)))
@@ -258,7 +258,7 @@ If the point is at the :beginning (`org-mouse-line-position') of the line,
insert the new heading before the current line. Otherwise, insert it
after the current heading."
(interactive)
- (case (org-mouse-line-position)
+ (cl-case (org-mouse-line-position)
(:beginning (beginning-of-line)
(org-insert-heading))
(t (org-mouse-next-heading)
@@ -314,10 +314,10 @@ nor a function, elements of KEYWORDS are used directly."
(just-one-space))
(defvar org-mouse-rest)
-(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase
- literal string subexp)
+(defun org-mouse-replace-match-and-surround
+ (_newtext &optional _fixedcase _literal _string subexp)
"The same as `replace-match', but surrounds the replacement with spaces."
- (apply 'replace-match org-mouse-rest)
+ (apply #'replace-match org-mouse-rest)
(save-excursion
(goto-char (match-beginning (or subexp 0)))
(just-one-space)
@@ -391,8 +391,8 @@ DEFAULT is returned if no priority is given in the headline."
(defun org-mouse-delete-timestamp ()
"Deletes the current timestamp as well as the preceding keyword.
SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
- (when (or (org-at-date-range-p) (org-at-timestamp-p))
- (replace-match "") ; delete the timestamp
+ (when (or (org-at-date-range-p) (org-at-timestamp-p 'lax))
+ (replace-match "") ;delete the timestamp
(skip-chars-backward " :A-Z")
(when (looking-at " *[A-Z][A-Z]+:")
(replace-match ""))))
@@ -407,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(> (match-end 0) point))))))
(defun org-mouse-priority-list ()
- (loop for priority from ?A to org-lowest-priority
- collect (char-to-string priority)))
+ (cl-loop for priority from ?A to org-lowest-priority
+ collect (char-to-string priority)))
(defun org-mouse-todo-menu (state)
"Create the menu with TODO keywords."
@@ -460,33 +460,33 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(insert " [ ] "))))
(defun org-mouse-agenda-type (type)
- (case type
- ('tags "Tags: ")
- ('todo "TODO: ")
- ('tags-tree "Tags tree: ")
- ('todo-tree "TODO tree: ")
- ('occur-tree "Occur tree: ")
- (t "Agenda command ???")))
+ (pcase type
+ (`tags "Tags: ")
+ (`todo "TODO: ")
+ (`tags-tree "Tags tree: ")
+ (`todo-tree "TODO tree: ")
+ (`occur-tree "Occur tree: ")
+ (_ "Agenda command ???")))
(defun org-mouse-list-options-menu (alloptions &optional function)
(let ((options (save-match-data
(split-string (match-string-no-properties 1)))))
(print options)
- (loop for name in alloptions
- collect
- (vector name
- `(progn
- (replace-match
- (mapconcat 'identity
- (sort (if (member ',name ',options)
- (delete ',name ',options)
- (cons ',name ',options))
- 'string-lessp)
- " ")
- nil nil nil 1)
- (when (functionp ',function) (funcall ',function)))
- :style 'toggle
- :selected (and (member name options) t)))))
+ (cl-loop for name in alloptions
+ collect
+ (vector name
+ `(progn
+ (replace-match
+ (mapconcat 'identity
+ (sort (if (member ',name ',options)
+ (delete ',name ',options)
+ (cons ',name ',options))
+ 'string-lessp)
+ " ")
+ nil nil nil 1)
+ (when (functionp ',function) (funcall ',function)))
+ :style 'toggle
+ :selected (and (member name options) t)))))
(defun org-mouse-clip-text (text maxlength)
(if (> (length text) maxlength)
@@ -498,7 +498,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
`("Main Menu"
["Show Overview" org-mouse-show-overview t]
["Show Headlines" org-mouse-show-headlines t]
- ["Show All" show-all t]
+ ["Show All" outline-show-all t]
["Remove Highlights" org-remove-occur-highlights
:visible org-occur-highlights]
"--"
@@ -516,7 +516,6 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
["Check Phrase ..." org-occur]
"--"
["Display Agenda" org-agenda-list t]
- ["Display Timeline" org-timeline t]
["Display TODO List" org-todo-list t]
("Display Tags"
,@(org-mouse-keyword-menu
@@ -556,12 +555,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:"
(let ((contextdata (assq context contextlist)))
(when contextdata
(save-excursion
- (goto-char (second contextdata))
- (re-search-forward ".*" (third contextdata))))))
+ (goto-char (nth 1 contextdata))
+ (re-search-forward ".*" (nth 2 contextdata))))))
(defun org-mouse-for-each-item (funct)
- ;; Functions called by `org-apply-on-list' need an argument
- (let ((wrap-fun (lambda (c) (funcall funct))))
+ ;; Functions called by `org-apply-on-list' need an argument.
+ (let ((wrap-fun (lambda (_) (funcall funct))))
(when (ignore-errors (goto-char (org-in-item-p)))
(save-excursion (org-apply-on-list wrap-fun nil)))))
@@ -572,14 +571,14 @@ This means, between the beginning of line and the point."
(skip-chars-backward " \t*") (bolp)))
(defun org-mouse-insert-item (text)
- (case (org-mouse-line-position)
- (:beginning ; insert before
+ (cl-case (org-mouse-line-position)
+ (:beginning ; insert before
(beginning-of-line)
(looking-at "[ \t]*")
(open-line 1)
- (org-indent-to-column (- (match-end 0) (match-beginning 0)))
+ (indent-to-column (- (match-end 0) (match-beginning 0)))
(insert "+ "))
- (:middle ; insert after
+ (:middle ; insert after
(end-of-line)
(newline t)
(indent-relative)
@@ -587,7 +586,7 @@ This means, between the beginning of line and the point."
(:end ; insert text here
(skip-chars-backward " \t")
(kill-region (point) (point-at-eol))
- (unless (org-looking-back org-mouse-punctuation)
+ (unless (looking-back org-mouse-punctuation (line-beginning-position))
(insert (concat org-mouse-punctuation " ")))))
(insert text)
(beginning-of-line))
@@ -638,14 +637,15 @@ This means, between the beginning of line and the point."
(progn (save-excursion (goto-char (region-beginning)) (insert "[["))
(save-excursion (goto-char (region-end)) (insert "]]")))]
["Insert Link Here" (org-mouse-yank-link ',event)]))))
- ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)"))
+ ((save-excursion (beginning-of-line) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)"))
(popup-menu
`(nil
,@(org-mouse-list-options-menu (mapcar 'car org-startup-options)
'org-mode-restart))))
((or (eolp)
(and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$")
- (org-looking-back " \\|\t" (- (point) 2))))
+ (looking-back " \\|\t" (- (point) 2)
+ (line-beginning-position))))
(org-mouse-popup-global-menu))
((funcall get-context :checkbox)
(popup-menu
@@ -714,7 +714,7 @@ This means, between the beginning of line and the point."
(org-tags-sparse-tree nil ,(match-string 1))]
"--"
,@(org-mouse-tag-menu))))
- ((org-at-timestamp-p)
+ ((org-at-timestamp-p 'lax)
(popup-menu
'(nil
["Show Day" org-open-at-point t]
@@ -737,13 +737,13 @@ This means, between the beginning of line and the point."
["- 1 Month" (org-timestamp-change -1 'month)])))
((funcall get-context :table-special)
(let ((mdata (match-data)))
- (incf (car mdata) 2)
+ (cl-incf (car mdata) 2)
(store-match-data mdata))
(message "match: %S" (match-string 0))
(popup-menu `(nil ,@(org-mouse-keyword-replace-menu
'(" " "!" "^" "_" "$" "#" "*" "'") 0
(lambda (mark)
- (case (string-to-char mark)
+ (cl-case (string-to-char mark)
(? "( ) Nothing Special")
(?! "(!) Column Names")
(?^ "(^) Field Names Above")
@@ -914,7 +914,7 @@ This means, between the beginning of line and the point."
((org-footnote-at-reference-p) nil)
(t ad-do-it))))))
-(defun org-mouse-move-tree-start (event)
+(defun org-mouse-move-tree-start (_event)
(interactive "e")
(message "Same line: promote/demote, (***):move before, (text): make a child"))
@@ -993,7 +993,7 @@ This means, between the beginning of line and the point."
(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'.
(defun org-mouse-do-remotely (command)
- ; (org-agenda-check-no-diary)
+ ;; (org-agenda-check-no-diary)
(when (get-text-property (point) 'org-marker)
(let* ((anticol (- (point-at-eol) (point)))
(marker (get-text-property (point) 'org-marker))
@@ -1031,7 +1031,7 @@ This means, between the beginning of line and the point."
(org-agenda-change-all-lines newhead hdmarker 'fixface))))
t))))
-(defun org-mouse-agenda-context-menu (&optional event)
+(defun org-mouse-agenda-context-menu (&optional _event)
(or (org-mouse-do-remotely 'org-mouse-context-menu)
(popup-menu
'("Agenda"
@@ -1043,21 +1043,21 @@ This means, between the beginning of line and the point."
org-agenda-undo-list)]
["Rebuild Buffer" org-agenda-redo t]
["New Diary Entry"
- org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t]
+ org-agenda-diary-entry (org-agenda-check-type nil 'agenda) t]
"--"
["Goto Today" org-agenda-goto-today
- (org-agenda-check-type nil 'agenda 'timeline) t]
+ (org-agenda-check-type nil 'agenda) t]
["Display Calendar" org-agenda-goto-calendar
- (org-agenda-check-type nil 'agenda 'timeline) t]
+ (org-agenda-check-type nil 'agenda) t]
("Calendar Commands"
["Phases of the Moon" org-agenda-phases-of-moon
- (org-agenda-check-type nil 'agenda 'timeline)]
+ (org-agenda-check-type nil 'agenda)]
["Sunrise/Sunset" org-agenda-sunrise-sunset
- (org-agenda-check-type nil 'agenda 'timeline)]
+ (org-agenda-check-type nil 'agenda)]
["Holidays" org-agenda-holidays
- (org-agenda-check-type nil 'agenda 'timeline)]
+ (org-agenda-check-type nil 'agenda)]
["Convert" org-agenda-convert-date
- (org-agenda-check-type nil 'agenda 'timeline)]
+ (org-agenda-check-type nil 'agenda)]
"--"
["Create iCalendar file" org-icalendar-combine-agenda-files t])
"--"
@@ -1070,7 +1070,7 @@ This means, between the beginning of line and the point."
"--"
["Show Logbook entries" org-agenda-log-mode
:style toggle :selected org-agenda-show-log
- :active (org-agenda-check-type nil 'agenda 'timeline)]
+ :active (org-agenda-check-type nil 'agenda)]
["Include Diary" org-agenda-toggle-diary
:style toggle :selected org-agenda-include-diary
:active (org-agenda-check-type nil 'agenda)]
@@ -1093,17 +1093,17 @@ This means, between the beginning of line and the point."
; (setq org-agenda-mode-hook nil)
(defvar org-agenda-mode-map)
(add-hook 'org-agenda-mode-hook
- #'(lambda ()
- (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
- (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
- (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
- (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
- (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
- (org-defkey org-agenda-mode-map [drag-mouse-3]
- #'(lambda (event) (interactive "e")
- (case (org-mouse-get-gesture event)
- (:left (org-agenda-earlier 1))
- (:right (org-agenda-later 1)))))))
+ (lambda ()
+ (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu)
+ (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu)
+ (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start)
+ (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier)
+ (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later)
+ (org-defkey org-agenda-mode-map [drag-mouse-3]
+ (lambda (event) (interactive "e")
+ (cl-case (org-mouse-get-gesture event)
+ (:left (org-agenda-earlier 1))
+ (:right (org-agenda-later 1)))))))
(provide 'org-mouse)
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el
index 034c20e3077..3c2561d1fa6 100644
--- a/lisp/org/org-pcomplete.el
+++ b/lisp/org/org-pcomplete.el
@@ -1,4 +1,4 @@
-;;; org-pcomplete.el --- In-buffer completion code
+;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
;;
@@ -20,28 +20,24 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:
;;;; Require other packages
-(eval-when-compile
- (require 'cl))
-
(require 'org-macs)
(require 'org-compat)
(require 'pcomplete)
-(declare-function org-split-string "org" (string &optional separators))
-(declare-function org-make-org-heading-search-string "org"
- (&optional string))
+(declare-function org-make-org-heading-search-string "org" (&optional string))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
- (&optional include-specials include-defaults include-columns))
-(declare-function org-entry-properties "org" (&optional pom which specific))
+ (&optional specials defaults columns ignore-malformed))
+(declare-function org-entry-properties "org" (&optional pom which))
+(declare-function org-tag-alist-to-string "org" (alist &optional skip-key))
;;;; Customization variables
@@ -52,12 +48,13 @@
(defvar org-drawer-regexp)
(defvar org-property-re)
+(defvar org-current-tag-alist)
(defun org-thing-at-point ()
"Examine the thing at point and let the caller know what it is.
The return value is a string naming the thing at point."
(let ((beg1 (save-excursion
- (skip-chars-backward (org-re "[:alnum:]-_@"))
+ (skip-chars-backward "[:alnum:]-_@")
(point)))
(beg (save-excursion
(skip-chars-backward "a-zA-Z0-9-_:$")
@@ -93,8 +90,10 @@ The return value is a string naming the thing at point."
(skip-chars-backward "[ \t\n]")
;; org-drawer-regexp matches a whole line but while
;; looking-back, we just ignore trailing whitespaces
- (or (org-looking-back (substring org-drawer-regexp 0 -1))
- (org-looking-back org-property-re))))
+ (or (looking-back (substring org-drawer-regexp 0 -1)
+ (line-beginning-position))
+ (looking-back org-property-re
+ (line-beginning-position)))))
(cons "prop" nil))
((and (equal (char-before beg1) ?:)
(not (equal (char-after (point-at-bol)) ?*)))
@@ -140,7 +139,6 @@ When completing for #+STARTUP, for example, this function returns
pcomplete-default-completion-function))))
(defvar org-options-keywords) ; From org.el
-(defvar org-element-block-name-alist) ; From org-element.el
(defvar org-element-affiliated-keywords) ; From org-element.el
(declare-function org-get-export-keywords "org" ())
(defun pcomplete/org-mode/file-option ()
@@ -153,16 +151,19 @@ When completing for #+STARTUP, for example, this function returns
(mapcar (lambda (keyword) (concat keyword ": "))
org-element-affiliated-keywords)
(let (block-names)
- (dolist (block-info org-element-block-name-alist block-names)
- (let ((name (car block-info)))
- (push (format "END_%s" name) block-names)
- (push (concat "BEGIN_"
- name
- ;; Since language is compulsory in
- ;; source blocks, add a space.
- (and (equal name "SRC") " "))
- block-names)
- (push (format "ATTR_%s: " name) block-names))))
+ (dolist (name
+ '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC"
+ "VERSE")
+ block-names)
+ (push (format "END_%s" name) block-names)
+ (push (concat "BEGIN_"
+ name
+ ;; Since language is compulsory in
+ ;; export blocks source blocks, add
+ ;; a space.
+ (and (member name '("EXPORT" "SRC")) " "))
+ block-names)
+ (push (format "ATTR_%s: " name) block-names)))
(mapcar (lambda (keyword) (concat keyword ": "))
(org-get-export-keywords))))
(substring pcomplete-stub 2)))
@@ -233,20 +234,10 @@ When completing for #+STARTUP, for example, this function returns
(setq opts (delete "showstars" opts)))))
opts))))
-(defvar org-tag-alist)
(defun pcomplete/org-mode/file-option/tags ()
"Complete arguments for the #+TAGS file option."
(pcomplete-here
- (list
- (mapconcat (lambda (x)
- (cond
- ((eq :startgroup (car x)) "{")
- ((eq :endgroup (car x)) "}")
- ((eq :grouptags (car x)) ":")
- ((eq :newline (car x)) "\\n")
- ((cdr x) (format "%s(%c)" (car x) (cdr x)))
- (t (car x))))
- org-tag-alist " "))))
+ (list (org-tag-alist-to-string org-current-tag-alist))))
(defun pcomplete/org-mode/file-option/title ()
"Complete arguments for the #+TITLE file option."
@@ -271,8 +262,8 @@ When completing for #+STARTUP, for example, this function returns
"|:" "tags:" "tasks:" "<:" "todo:")
;; OPTION items from registered back-ends.
(let (items)
- (dolist (backend (org-bound-and-true-p
- org-export--registered-backends))
+ (dolist (backend (bound-and-true-p
+ org-export-registered-backends))
(dolist (option (org-export-backend-options backend))
(let ((item (nth 2 option)))
(when item (push (concat item ":") items)))))
@@ -283,7 +274,7 @@ When completing for #+STARTUP, for example, this function returns
(while (pcomplete-here
(pcomplete-uniqify-list
(mapcar (lambda (item) (format "%s:" (car item)))
- (org-bound-and-true-p org-html-infojs-opts-table))))))
+ (bound-and-true-p org-html-infojs-opts-table))))))
(defun pcomplete/org-mode/file-option/bind ()
"Complete arguments for the #+BIND file option, which are variable names."
@@ -324,26 +315,24 @@ This needs more work, to handle headings with lots of spaces in them."
(save-excursion
(goto-char (point-min))
(let (tbl)
- (while (re-search-forward org-todo-line-regexp nil t)
- (push (org-make-org-heading-search-string
- (match-string-no-properties 3))
- tbl))
+ (let ((case-fold-search nil))
+ (while (re-search-forward org-todo-line-regexp nil t)
+ (push (org-make-org-heading-search-string
+ (match-string-no-properties 3))
+ tbl)))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
-(defvar org-tag-alist)
(defun pcomplete/org-mode/tag ()
"Complete a tag name. Omit tags already set."
(while (pcomplete-here
- (mapcar (lambda (x)
- (concat x ":"))
+ (mapcar (lambda (x) (concat x ":"))
(let ((lst (pcomplete-uniqify-list
- (or (remove
+ (or (remq
nil
- (mapcar (lambda (x)
- (and (stringp (car x)) (car x)))
- org-tag-alist))
- (mapcar 'car (org-get-buffer-tags))))))
+ (mapcar (lambda (x) (org-string-nw-p (car x)))
+ org-current-tag-alist))
+ (mapcar #'car (org-get-buffer-tags))))))
(dolist (tag (org-get-tags))
(setq lst (delete tag lst)))
lst))
@@ -357,31 +346,12 @@ This needs more work, to handle headings with lots of spaces in them."
(concat x ": "))
(let ((lst (pcomplete-uniqify-list
(copy-sequence
- (org-buffer-property-keys nil t t)))))
+ (org-buffer-property-keys nil t t t)))))
(dolist (prop (org-entry-properties))
(setq lst (delete (car prop) lst)))
lst))
(substring pcomplete-stub 1)))
-(defvar org-drawers)
-
-(defun pcomplete/org-mode/drawer ()
- "Complete a drawer name."
- (let ((spc (save-excursion
- (move-beginning-of-line 1)
- (looking-at "^\\([ \t]*\\):")
- (match-string 1)))
- (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers)))
- (pcomplete-here cpllist
- (substring pcomplete-stub 1)
- (unless (or (not (delq
- nil
- (mapcar (lambda(x)
- (string-match (substring pcomplete-stub 1) x))
- cpllist)))
- (looking-at "[ \t]*\n.*:END:"))
- (save-excursion (insert "\n" spc ":END:"))))))
-
(defun pcomplete/org-mode/block-option/src ()
"Complete the arguments of a begin_src block.
Complete a language in the first field, the header arguments and switches."
diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el
index 5ccfbb1e662..a8028324bfd 100644
--- a/lisp/org/org-plot.el
+++ b/lisp/org/org-plot.el
@@ -1,4 +1,4 @@
-;;; org-plot.el --- Support for plotting from Org-mode
+;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
;;
@@ -19,20 +19,20 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Borrows ideas and a couple of lines of code from org-exp.el.
-;; Thanks to the org-mode mailing list for testing and implementation
-;; and feature suggestions
+;; Thanks to the Org mailing list for testing and implementation and
+;; feature suggestions
;;; Code:
+
+(require 'cl-lib)
(require 'org)
(require 'org-table)
-(eval-when-compile
- (require 'cl))
(declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
(declare-function gnuplot-mode "ext:gnuplot" ())
@@ -49,41 +49,39 @@
(defun org-plot/add-options-to-plist (p options)
"Parse an OPTIONS line and set values in the property list P.
Returns the resulting property list."
- (let (o)
- (when options
- (let ((op '(("type" . :plot-type)
- ("script" . :script)
- ("line" . :line)
- ("set" . :set)
- ("title" . :title)
- ("ind" . :ind)
- ("deps" . :deps)
- ("with" . :with)
- ("file" . :file)
- ("labels" . :labels)
- ("map" . :map)
- ("timeind" . :timeind)
- ("timefmt" . :timefmt)))
- (multiples '("set" "line"))
- (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
- (start 0)
- o)
- (while (setq o (pop op))
- (if (member (car o) multiples) ;; keys with multiple values
- (while (string-match
- (concat (regexp-quote (car o)) regexp)
- options start)
- (setq start (match-end 0))
- (setq p (plist-put p (cdr o)
- (cons (car (read-from-string
- (match-string 1 options)))
- (plist-get p (cdr o)))))
- p)
- (if (string-match (concat (regexp-quote (car o)) regexp)
- options)
- (setq p (plist-put p (cdr o)
- (car (read-from-string
- (match-string 1 options)))))))))))
+ (when options
+ (let ((op '(("type" . :plot-type)
+ ("script" . :script)
+ ("line" . :line)
+ ("set" . :set)
+ ("title" . :title)
+ ("ind" . :ind)
+ ("deps" . :deps)
+ ("with" . :with)
+ ("file" . :file)
+ ("labels" . :labels)
+ ("map" . :map)
+ ("timeind" . :timeind)
+ ("timefmt" . :timefmt)))
+ (multiples '("set" "line"))
+ (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
+ (start 0))
+ (dolist (o op)
+ (if (member (car o) multiples) ;; keys with multiple values
+ (while (string-match
+ (concat (regexp-quote (car o)) regexp)
+ options start)
+ (setq start (match-end 0))
+ (setq p (plist-put p (cdr o)
+ (cons (car (read-from-string
+ (match-string 1 options)))
+ (plist-get p (cdr o)))))
+ p)
+ (if (string-match (concat (regexp-quote (car o)) regexp)
+ options)
+ (setq p (plist-put p (cdr o)
+ (car (read-from-string
+ (match-string 1 options))))))))))
p)
(defun org-plot/goto-nearest-table ()
@@ -119,10 +117,9 @@ will be added. Returns the resulting property list."
Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
(with-temp-file
data-file
- (make-local-variable 'org-plot-timestamp-fmt)
- (setq org-plot-timestamp-fmt (or
- (plist-get params :timefmt)
- "%Y-%m-%d-%H:%M:%S"))
+ (setq-local org-plot-timestamp-fmt (or
+ (plist-get params :timefmt)
+ "%Y-%m-%d-%H:%M:%S"))
(insert (orgtbl-to-generic
table
(org-combine-plists
@@ -140,7 +137,7 @@ and dependant variables."
(deps (if (plist-member params :deps)
(mapcar (lambda (val) (- val 1)) (plist-get params :deps))
(let (collector)
- (dotimes (col (length (first table)))
+ (dotimes (col (length (nth 0 table)))
(setf collector (cons col collector)))
collector)))
(counter 0)
@@ -158,7 +155,7 @@ and dependant variables."
table)))
;; write table to gnuplot grid datafile format
(with-temp-file data-file
- (let ((num-rows (length table)) (num-cols (length (first table)))
+ (let ((num-rows (length table)) (num-cols (length (nth 0 table)))
(gnuplot-row (lambda (col row value)
(setf col (+ 1 col)) (setf row (+ 1 row))
(format "%f %f %f\n%f %f %f\n"
@@ -187,9 +184,7 @@ NUM-COLS controls the number of columns plotted in a 2-d plot.
Optional argument PREFACE returns only option parameters in a
manner suitable for prepending to a user-specified script."
(let* ((type (plist-get params :plot-type))
- (with (if (equal type 'grid)
- 'pm3d
- (plist-get params :with)))
+ (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
(sets (plist-get params :set))
(lines (plist-get params :line))
(map (plist-get params :map))
@@ -204,68 +199,72 @@ manner suitable for prepending to a user-specified script."
(x-labels (plist-get params :xlabels))
(y-labels (plist-get params :ylabels))
(plot-str "'%s' using %s%d%s with %s title '%s'")
- (plot-cmd (case type
- ('2d "plot")
- ('3d "splot")
- ('grid "splot")))
+ (plot-cmd (pcase type
+ (`2d "plot")
+ (`3d "splot")
+ (`grid "splot")))
(script "reset")
- ; ats = add-to-script
- (ats (lambda (line) (setf script (format "%s\n%s" script line))))
+ ;; ats = add-to-script
+ (ats (lambda (line) (setf script (concat script "\n" line))))
plot-lines)
- (when file ;; output file
+ (when file ; output file
(funcall ats (format "set term %s" (file-name-extension file)))
(funcall ats (format "set output '%s'" file)))
- (case type ;; type
- ('2d ())
- ('3d (if map (funcall ats "set map")))
- ('grid (if map (funcall ats "set pm3d map")
- (funcall ats "set pm3d"))))
- (when title (funcall ats (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line
- (when sets ;; set
- (mapc (lambda (el) (funcall ats (format "set %s" el))) sets))
- (when x-labels ;; x labels (xtics)
+ (pcase type ; type
+ (`2d ())
+ (`3d (when map (funcall ats "set map")))
+ (`grid (funcall ats (if map "set pm3d map" "set pm3d"))))
+ (when title (funcall ats (format "set title '%s'" title))) ; title
+ (mapc ats lines) ; line
+ (dolist (el sets) (funcall ats (format "set %s" el))) ; set
+ ;; Unless specified otherwise, values are TAB separated.
+ (unless (string-match-p "^set datafile separator" script)
+ (funcall ats "set datafile separator \"\\t\""))
+ (when x-labels ; x labels (xtics)
(funcall ats
(format "set xtics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
x-labels ", "))))
- (when y-labels ;; y labels (ytics)
+ (when y-labels ; y labels (ytics)
(funcall ats
(format "set ytics (%s)"
(mapconcat (lambda (pair)
(format "\"%s\" %d" (cdr pair) (car pair)))
y-labels ", "))))
- (when time-ind ;; timestamp index
+ (when time-ind ; timestamp index
(funcall ats "set xdata time")
(funcall ats (concat "set timefmt \""
- (or timefmt ;; timefmt passed to gnuplot
+ (or timefmt ; timefmt passed to gnuplot
"%Y-%m-%d-%H:%M:%S") "\"")))
(unless preface
- (case type ;; plot command
- ('2d (dotimes (col num-cols)
- (unless (and (equal type '2d)
- (or (and ind (equal (+ 1 col) ind))
- (and deps (not (member (+ 1 col) deps)))))
+ (pcase type ; plot command
+ (`2d (dotimes (col num-cols)
+ (unless (and (eq type '2d)
+ (or (and ind (equal (1+ col) ind))
+ (and deps (not (member (1+ col) deps)))))
(setf plot-lines
(cons
(format plot-str data-file
(or (and ind (> ind 0)
- (not text-ind)
- (format "%d:" ind)) "")
- (+ 1 col)
+ (not text-ind)
+ (format "%d:" ind)) "")
+ (1+ col)
(if text-ind (format ":xticlabel(%d)" ind) "")
with
- (or (nth col col-labels) (format "%d" (+ 1 col))))
+ (or (nth col col-labels)
+ (format "%d" (1+ col))))
plot-lines)))))
- ('3d
+ (`3d
(setq plot-lines (list (format "'%s' matrix with %s title ''"
data-file with))))
- ('grid
+ (`grid
(setq plot-lines (list (format "'%s' with %s title ''"
data-file with)))))
(funcall ats
- (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n "))))
+ (concat plot-cmd " " (mapconcat #'identity
+ (reverse plot-lines)
+ ",\\\n "))))
script))
;;-----------------------------------------------------------------------------
@@ -279,59 +278,59 @@ line directly before or after the table."
(require 'gnuplot)
(save-window-excursion
(delete-other-windows)
- (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running
+ (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
(with-current-buffer "*gnuplot*"
- (goto-char (point-max))
- (gnuplot-delchar-or-maybe-eof nil)))
+ (goto-char (point-max))))
(org-plot/goto-nearest-table)
- ;; set default options
- (mapc
- (lambda (pair)
- (unless (plist-member params (car pair))
- (setf params (plist-put params (car pair) (cdr pair)))))
- org-plot/gnuplot-default-options)
+ ;; Set default options.
+ (dolist (pair org-plot/gnuplot-default-options)
+ (unless (plist-member params (car pair))
+ (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 (first table) 'hline) (second table)
- (first table)))))
- (while (equal 'hline (first table)) (setf table (cdr table)))
- (when (equal (second table) 'hline)
- (setf params (plist-put params :labels (first table))) ;; headers to labels
- (setf table (delq 'hline (cdr table)))) ;; clean non-data from table
- ;; collect options
+ (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
+ (nth 0 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
+ (setf table (delq 'hline (cdr table)))) ; clean non-data from table
+ ;; Collect options.
(save-excursion (while (and (equal 0 (forward-line -1))
(looking-at "[[:space:]]*#\\+"))
(setf params (org-plot/collect-options params))))
- ;; dump table to datafile (very different for grid)
- (case (plist-get params :plot-type)
- ('2d (org-plot/gnuplot-to-data table data-file params))
- ('3d (org-plot/gnuplot-to-data table data-file params))
- ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data
+ ;; Dump table to datafile (very different for grid).
+ (pcase (plist-get params :plot-type)
+ (`2d (org-plot/gnuplot-to-data table data-file params))
+ (`3d (org-plot/gnuplot-to-data table data-file params))
+ (`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 (- (plist-get params :ind) 1)))
- (when (and (>= ind 0) (equal '2d (plist-get params :plot-type)))
+ ;; 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)
+ (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
+ ;; 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))
+ (mapcar (lambda (row) (nth ind row)) table))))
+ 0))
(plist-put params :textind t)))))
- ;; write script
+ ;; Write script.
(with-temp-buffer
- (if (plist-get params :script) ;; user script
+ (if (plist-get params :script) ; user script
(progn (insert
(org-plot/gnuplot-script data-file num-cols params t))
(insert "\n")
@@ -339,14 +338,12 @@ line directly before or after the table."
(goto-char (point-min))
(while (re-search-forward "$datafile" nil t)
(replace-match data-file nil nil)))
- (insert
- (org-plot/gnuplot-script data-file num-cols params)))
- ;; graph table
+ (insert (org-plot/gnuplot-script data-file num-cols params)))
+ ;; Graph table.
(gnuplot-mode)
(gnuplot-send-buffer-to-gnuplot))
- ;; cleanup
- (bury-buffer (get-buffer "*gnuplot*"))
- (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file))))))
+ ;; Cleanup.
+ (bury-buffer (get-buffer "*gnuplot*")))))
(provide 'org-plot)
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 4bd83bea486..d92bfc6a158 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -1,4 +1,4 @@
-;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions.
+;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
;;
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
@@ -49,7 +49,7 @@
;; 4.) Try this from the command line (adjust the URL as needed):
;;
;; $ emacsclient \
-;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title
+;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title
;;
;; 5.) Optionally add custom sub-protocols and handlers:
;;
@@ -60,7 +60,7 @@
;;
;; A "sub-protocol" will be found in URLs like this:
;;
-;; org-protocol://sub-protocol://data
+;; org-protocol://sub-protocol?key=val&key2=val2
;;
;; If it works, you can now setup other applications for using this feature.
;;
@@ -81,12 +81,12 @@
;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps
;; URLs to local filenames defined in `org-protocol-project-alist'.
;;
-;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and
+;; * `org-protocol-store-link' stores an Org link (if Org is present) and
;; pushes the browsers URL to the `kill-ring' for yanking. This handler is
;; triggered through the sub-protocol \"store-link\".
;;
;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If
-;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the
+;; Org is loaded, Emacs will pop-up a capture buffer and fill the
;; template with the data provided. I.e. the browser's URL is inserted as an
;; Org-link of which the page title will be the description part. If text
;; was select in the browser, that text will be the body of the entry.
@@ -94,20 +94,20 @@
;; You may use the same bookmark URL for all those standard handlers and just
;; adjust the sub-protocol used:
;;
-;; location.href='org-protocol://sub-protocol://'+
-;; encodeURIComponent(location.href)+'/'+
-;; encodeURIComponent(document.title)+'/'+
+;; location.href='org-protocol://sub-protocol?url='+
+;; encodeURIComponent(location.href)+'&title='+
+;; encodeURIComponent(document.title)+'&body='+
;; encodeURIComponent(window.getSelection())
;;
;; The handler for the sub-protocol \"capture\" detects an optional template
;; char that, if present, triggers the use of a special template.
;; Example:
;;
-;; location.href='org-protocol://sub-protocol://x/'+ ...
+;; location.href='org-protocol://capture?template=x'+ ...
;;
-;; use template ?x.
+;; uses template ?x.
;;
-;; Note, that using double slashes is optional from org-protocol.el's point of
+;; Note that using double slashes is optional from org-protocol.el's point of
;; view because emacsclient squashes the slashes to one.
;;
;;
@@ -116,25 +116,12 @@
;;; Code:
(require 'org)
-(eval-when-compile
- (require 'cl))
(declare-function org-publish-get-project-from-filename "ox-publish"
(filename &optional up))
(declare-function server-edit "server" (&optional arg))
-(define-obsolete-function-alias
- 'org-protocol-unhex-compound 'org-link-unescape-compound
- "2011-02-17")
-
-(define-obsolete-function-alias
- 'org-protocol-unhex-string 'org-link-unescape
- "2011-02-17")
-
-(define-obsolete-function-alias
- 'org-protocol-unhex-single-byte-sequence
- 'org-link-unescape-single-byte-sequence
- "2011-02-17")
+(defvar org-capture-link-is-already-stored)
(defgroup org-protocol nil
"Intercept calls from emacsclient to trigger custom actions.
@@ -207,7 +194,14 @@ Example:
:working-suffix \".org\"
:base-url \"http://localhost/org/\"
:working-directory \"/home/user/org/\"
- :rewrites ((\"org/?$\" . \"index.php\")))))
+ :rewrites ((\"org/?$\" . \"index.php\")))
+ (\"Hugo based blog\"
+ :base-url \"https://www.site.com/\"
+ :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
@@ -225,27 +219,36 @@ Each element of this list must be of the form:
(module-name :protocol protocol :function func :kill-client nil)
-protocol - protocol to detect in a filename without trailing colon and slashes.
- See rfc1738 section 2.1 for more on this.
- If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol'
- will search filenames for \"org-protocol:/my-protocol:/\"
- and trigger your action for every match. `org-protocol' is defined in
- `org-protocol-the-protocol'. Double and triple slashes are compressed
- to one by emacsclient.
-
-function - function that handles requests with protocol and takes exactly one
- argument: the filename with all protocols stripped. If the function
- returns nil, emacsclient and -server do nothing. Any non-nil return
- value is considered a valid filename and thus passed to the server.
-
- `org-protocol.el provides some support for handling those filenames,
- if you stay with the conventions used for the standard handlers in
- `org-protocol-protocol-alist-default'. See `org-protocol-split-data'.
+protocol - protocol to detect in a filename without trailing
+ colon and slashes. See rfc1738 section 2.1 for more
+ on this. If you define a protocol \"my-protocol\",
+ `org-protocol-check-filename-for-protocol' will search
+ filenames for \"org-protocol:/my-protocol\" and
+ trigger your action for every match. `org-protocol'
+ is defined in `org-protocol-the-protocol'. Double and
+ triple slashes are compressed to one by emacsclient.
+
+function - function that handles requests with protocol and takes
+ one argument. If a new-style link (key=val&key2=val2)
+ is given, the argument will be a property list with
+ the values from the link. If an old-style link is
+ given (val1/val2), the argument will be the filename
+ with all protocols stripped.
+
+ If the function returns nil, emacsclient and -server
+ do nothing. Any non-nil return value is considered a
+ valid filename and thus passed to the server.
+
+ `org-protocol.el' provides some support for handling
+ old-style filenames, if you follow the conventions
+ used for the standard handlers in
+ `org-protocol-protocol-alist-default'. See
+ `org-protocol-parse-parameters'.
kill-client - If t, kill the client immediately, once the sub-protocol is
detected. This is necessary for actions that can be interrupted by
- `C-g' to avoid dangling emacsclients. Note, that all other command
- line arguments but the this one will be discarded, greedy handlers
+ `C-g' to avoid dangling emacsclients. Note that all other command
+ line arguments but the this one will be discarded. Greedy handlers
still receive the whole list of arguments though.
Here is an example:
@@ -269,7 +272,7 @@ string with two characters."
(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
- This should be a single regexp string."
+This should be a single regexp string."
:group 'org-protocol
:version "24.4"
:package-version '(Org . "8.0")
@@ -278,21 +281,20 @@ string with two characters."
;;; Helper functions:
(defun org-protocol-sanitize-uri (uri)
- "emacsclient compresses double and triple slashes.
-Slashes are sanitized to double slashes here."
+ "Sanitize slashes to double-slashes in URI.
+Emacsclient compresses double and triple slashes."
(when (string-match "^\\([a-z]+\\):/" uri)
(let* ((splitparts (split-string uri "/+")))
(setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/")))))
uri)
(defun org-protocol-split-data (data &optional unhexify separator)
- "Split what an org-protocol handler function gets as only argument.
-DATA is that one argument. DATA is split at each occurrence of
-SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is
-nil, assume \"/+\". The results of that splitting are returned
-as a list. If UNHEXIFY is non-nil, hex-decode each split part.
-If UNHEXIFY is a function, use that function to decode each split
-part."
+ "Split the DATA argument for an org-protocol handler function.
+If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY
+is a function, use that function to decode each split part. The
+string is split at each occurrence of SEPARATOR (regexp). If no
+SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The
+results of that splitting are returned as a list."
(let* ((sep (or separator "/+\\|\\?"))
(split-parts (split-string data sep)))
(if unhexify
@@ -302,23 +304,25 @@ part."
split-parts)))
(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement)
- "Greedy handlers might receive a list like this from emacsclient:
- ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
-where \"/dir/\" is the absolute path to emacsclients working directory. This
+ "Transform PARAM-LIST into a flat list for greedy handlers.
+
+Greedy handlers might receive a list like this from emacsclient:
+\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
+where \"/dir/\" is the absolute path to emacsclient's working directory. This
function transforms it into a flat list using `org-protocol-flatten' and
transforms the elements of that list as follows:
-If strip-path is non-nil, remove the \"/dir/\" prefix from all members of
+If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of
param-list.
-If replacement is string, replace the \"/dir/\" prefix with it.
+If REPLACEMENT is string, replace the \"/dir/\" prefix with it.
The first parameter, the one that contains the protocols, is always changed.
Everything up to the end of the protocols is stripped.
Note, that this function will always behave as if
`org-protocol-reverse-list-of-files' was set to t and the returned list will
-reflect that. I.e. emacsclients first parameter will be the first one in the
+reflect that. emacsclient's first parameter will be the first one in the
returned list."
(let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files
param-list
@@ -345,50 +349,106 @@ returned list."
ret)
l)))
-(defun org-protocol-flatten (l)
- "Greedy handlers might receive a list like this from emacsclient:
- ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
+(defun org-protocol-flatten (list)
+ "Transform LIST into a flat list.
+
+Greedy handlers might receive a list like this from emacsclient:
+\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\"))
where \"/dir/\" is the absolute path to emacsclients working directory.
This function transforms it into a flat list."
- (if (null l) ()
- (if (listp l)
- (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l)))
- (list l))))
-
+ (if (null list) ()
+ (if (listp list)
+ (append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list)))
+ (list list))))
+
+(defun org-protocol-parse-parameters (info &optional new-style default-order)
+ "Return a property list of parameters from INFO.
+If NEW-STYLE is non-nil, treat INFO as a query string (ex:
+url=URL&title=TITLE). If old-style links are used (ex:
+org-protocol://store-link/url/title), assign them to attributes
+following DEFAULT-ORDER.
+
+If no DEFAULT-ORDER is specified, return the list of values.
+
+If INFO is already a property list, return it unchanged."
+ (if (listp info)
+ info
+ (if new-style
+ (let ((data (org-protocol-convert-query-to-plist info))
+ result)
+ (while data
+ (setq result
+ (append
+ result
+ (list
+ (pop data)
+ (org-link-unescape (pop data))))))
+ result)
+ (let ((data (org-protocol-split-data info t org-protocol-data-separator)))
+ (if default-order
+ (org-protocol-assign-parameters data default-order)
+ data)))))
+
+(defun org-protocol-assign-parameters (data default-order)
+ "Return a property list of parameters from DATA.
+Key names are taken from DEFAULT-ORDER, which should be a list of
+symbols. If DEFAULT-ORDER is shorter than the number of values
+specified, the rest of the values are treated as :key value pairs."
+ (let (result)
+ (while default-order
+ (setq result
+ (append result
+ (list (pop default-order)
+ (pop data)))))
+ (while data
+ (setq result
+ (append result
+ (list (intern (concat ":" (pop data)))
+ (pop data)))))
+ result))
;;; Standard protocol handlers:
(defun org-protocol-store-link (fname)
- "Process an org-protocol://store-link:// style url.
+ "Process an org-protocol://store-link style url.
Additionally store a browser URL as an org link. Also pushes the
link's URL to the `kill-ring'.
+Parameters: url, title (optional), body (optional)
+
+Old-style links such as org-protocol://store-link://URL/TITLE are
+also recognized.
+
The location for a browser's bookmark has to look like this:
- javascript:location.href=\\='org-protocol://store-link://\\='+ \\
- encodeURIComponent(location.href)
- encodeURIComponent(document.title)+\\='/\\='+ \\
+ javascript:location.href = \\
+ \\='org-protocol://store-link?url=\\=' + \\
+ encodeURIComponent(location.href) + \\='&title=\\=' + \\
+ encodeURIComponent(document.title);
-Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page
-could contain slashes and the location definitely will.
+Don't use `escape()'! Use `encodeURIComponent()' instead. The
+title of the page could contain slashes and the location
+definitely will.
The sub-protocol used to reach this function is set in
-`org-protocol-protocol-alist'."
- (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator))
- (uri (org-protocol-sanitize-uri (car splitparts)))
- (title (cadr splitparts))
- orglink)
- (if (boundp 'org-stored-links)
- (setq org-stored-links (cons (list uri title) org-stored-links)))
+`org-protocol-protocol-alist'.
+
+FNAME should be a property list. If not, an old-style link of the
+form URL/TITLE can also be used."
+ (let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title)))
+ (uri (org-protocol-sanitize-uri (plist-get splitparts :url)))
+ (title (plist-get splitparts :title)))
+ (when (boundp 'org-stored-links)
+ (push (list uri title) org-stored-links))
(kill-new uri)
(message "`%s' to insert new org-link, `%s' to insert `%s'"
- (substitute-command-keys"\\[org-insert-link]")
- (substitute-command-keys"\\[yank]")
+ (substitute-command-keys "`\\[org-insert-link]'")
+ (substitute-command-keys "`\\[yank]'")
uri))
nil)
(defun org-protocol-capture (info)
- "Process an org-protocol://capture:// style url.
+ "Process an org-protocol://capture style url with INFO.
The sub-protocol used to reach this function is set in
`org-protocol-protocol-alist'.
@@ -396,16 +456,16 @@ The sub-protocol used to reach this function is set in
This function detects an URL, title and optional text, separated
by `/'. The location for a browser's bookmark looks like this:
- javascript:location.href=\\='org-protocol://capture://\\='+ \\
- encodeURIComponent(location.href)+\\='/\\=' \\
- encodeURIComponent(document.title)+\\='/\\='+ \\
+ javascript:location.href = \\='org-protocol://capture?url=\\='+ \\
+ encodeURIComponent(location.href) + \\='&title=\\=' \\
+ encodeURIComponent(document.title) + \\='&body=\\=' + \\
encodeURIComponent(window.getSelection())
By default, it uses the character `org-protocol-default-template-key',
which should be associated with a template in `org-capture-templates'.
-But you may prepend the encoded URL with a character and a slash like so:
+You may specify the template with a template= query parameter, like this:
- javascript:location.href=\\='org-protocol://capture://b/\\='+ ...
+ javascript:location.href = \\='org-protocol://capture?template=b\\='+ ...
Now template ?b will be used."
(if (and (boundp 'org-stored-links)
@@ -414,7 +474,7 @@ Now template ?b will be used."
nil)
(defun org-protocol-convert-query-to-plist (query)
- "Convert query string that is part of url to property list."
+ "Convert QUERY key=value pairs in the URL to a property list."
(if query
(apply 'append (mapcar (lambda (x)
(let ((c (split-string x "=")))
@@ -422,45 +482,54 @@ Now template ?b will be used."
(split-string query "&")))))
(defun org-protocol-do-capture (info)
- "Support `org-capture'."
- (let* ((parts (org-protocol-split-data info t org-protocol-data-separator))
- (template (or (and (>= 2 (length (car parts))) (pop parts))
+ "Perform the actual capture based on INFO."
+ (let* ((temp-parts (org-protocol-parse-parameters info))
+ (parts
+ (cond
+ ((and (listp info) (symbolp (car info))) info)
+ ((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long
+ (org-protocol-assign-parameters temp-parts '(:template :url :title :body)))
+ (t
+ (org-protocol-assign-parameters temp-parts '(:url :title :body)))))
+ (template (or (plist-get parts :template)
org-protocol-default-template-key))
- (url (org-protocol-sanitize-uri (car parts)))
- (type (if (string-match "^\\([a-z]+\\):" url)
- (match-string 1 url)))
- (title (or (cadr parts) ""))
- (region (or (caddr parts) ""))
- (orglink (org-make-link-string
- url (if (string-match "[^[:space:]]" title) title url)))
- (query (or (org-protocol-convert-query-to-plist (cadddr parts)) ""))
+ (url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url))))
+ (type (and url (if (string-match "^\\([a-z]+\\):" url)
+ (match-string 1 url))))
+ (title (or (plist-get parts :title) ""))
+ (region (or (plist-get parts :body) ""))
+ (orglink (if url
+ (org-make-link-string
+ url (if (string-match "[^[:space:]]" title) title url))
+ title))
(org-capture-link-is-already-stored t)) ;; avoid call to org-store-link
(setq org-stored-links
(cons (list url title) org-stored-links))
- (kill-new orglink)
(org-store-link-props :type type
:link url
:description title
:annotation orglink
:initial region
- :query query)
+ :query parts)
(raise-frame)
(funcall 'org-capture nil template)))
(defun org-protocol-open-source (fname)
- "Process an org-protocol://open-source:// style url.
+ "Process an org-protocol://open-source?url= style URL with FNAME.
Change a filename by mapping URLs to local filenames as set
in `org-protocol-project-alist'.
The location for a browser's bookmark should look like this:
- javascript:location.href=\\='org-protocol://open-source://\\='+ \\
+ javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\
encodeURIComponent(location.href)"
;; As we enter this function for a match on our protocol, the return value
;; defaults to nil.
(let ((result nil)
- (f (org-link-unescape fname)))
+ (f (org-protocol-sanitize-uri
+ (plist-get (org-protocol-parse-parameters fname nil '(:url))
+ :url))))
(catch 'result
(dolist (prolist org-protocol-project-alist)
(let* ((base-url (plist-get (cdr prolist) :base-url))
@@ -490,13 +559,16 @@ The location for a browser's bookmark should look like this:
(let ((rewrites (plist-get (cdr prolist) :rewrites)))
(when rewrites
(message "Rewrites found: %S" rewrites)
- (mapc
- (lambda (rewrite)
- "Try to match a rewritten URL and map it to a real file."
- ;; Compare redirects without suffix:
- (if (string-match (car rewrite) f2)
- (throw 'result (concat wdir (cdr rewrite)))))
- rewrites))))
+ (dolist (rewrite rewrites)
+ ;; Try to match a rewritten URL and map it to
+ ;; a real file. Compare redirects without
+ ;; suffix.
+ (when (string-match (car rewrite) f1)
+ (let ((replacement
+ (concat (directory-file-name
+ (replace-match "" nil nil f1 1))
+ (cdr rewrite))))
+ (throw 'result (concat wdir replacement))))))))
;; -- end of redirects --
(if (file-readable-p the-file)
@@ -509,44 +581,63 @@ The location for a browser's bookmark should look like this:
;;; Core functions:
-(defun org-protocol-check-filename-for-protocol (fname restoffiles client)
- "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname.
+(defun org-protocol-check-filename-for-protocol (fname restoffiles _client)
+ "Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME.
Sub-protocols are registered in `org-protocol-protocol-alist' and
-`org-protocol-protocol-alist-default'.
-This is, how the matching is done:
+`org-protocol-protocol-alist-default'. This is how the matching is done:
- (string-match \"protocol:/+sub-protocol:/+\" ...)
+ (string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...)
protocol and sub-protocol are regexp-quoted.
-If a matching protocol is found, the protocol is stripped from fname and the
-result is passed to the protocols function as the only parameter. If the
-function returns nil, the filename is removed from the list of filenames
-passed from emacsclient to the server.
-If the function returns a non nil value, that value is passed to the server
-as filename."
+Old-style links such as \"protocol://sub-protocol://param1/param2\" are
+also recognized.
+
+If a matching protocol is found, the protocol is stripped from
+fname and the result is passed to the protocol function as the
+first parameter. The second parameter will be non-nil if FNAME
+uses key=val&key2=val2-type arguments, or nil if FNAME uses
+val/val2-type arguments. If the function returns nil, the
+filename is removed from the list of filenames passed from
+emacsclient to the server. If the function returns a non-nil
+value, that value is passed to the server as filename.
+
+If the handler function is greedy, RESTOFFILES will also be passed to it.
+
+CLIENT is ignored."
(let ((sub-protocols (append org-protocol-protocol-alist
org-protocol-protocol-alist-default)))
(catch 'fname
- (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+")))
+ (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol)
+ ":/+")))
(when (string-match the-protocol fname)
(dolist (prolist sub-protocols)
- (let ((proto (concat the-protocol
- (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+")))
+ (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))))
+ (result (if greedy restoffiles (cadr split)))
+ (new-style (string= (match-string 1 fname) "?")))
(when (plist-get (cdr prolist) :kill-client)
(message "Greedy org-protocol handler. Killing client.")
(server-edit))
(when (fboundp func)
(unless greedy
- (throw 'fname (funcall func result)))
- (funcall func result)
+ (throw 'fname
+ (if new-style
+ (funcall func (org-protocol-parse-parameters
+ result new-style))
+ (warn "Please update your Org Protocol handler \
+to deal with new-style links.")
+ (funcall func result))))
+ ;; Greedy protocol handlers are responsible for
+ ;; parsing their own filenames.
+ (funcall func result)
(throw 'fname t))))))))
- ;; (message "fname: %s" fname)
fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server activate)
@@ -572,16 +663,18 @@ as filename."
;;; Org specific functions:
(defun org-protocol-create-for-org ()
- "Create a org-protocol project for the current file's Org-mode project.
+ "Create a Org protocol project for the current file's project.
The visited file needs to be part of a publishing project in
`org-publish-project-alist' for this to work. The function
delegates most of the work to `org-protocol-create'."
(interactive)
- (require 'org-publish)
+ (require 'ox-publish)
(let ((all (or (org-publish-get-project-from-filename buffer-file-name))))
(if all (org-protocol-create (cdr all))
- (message "Not in an org-project. Did mean %s?"
- (substitute-command-keys"\\[org-protocol-create]")))))
+ (message "%s"
+ (substitute-command-keys
+ "Not in an Org project. \
+Did you mean `\\[org-protocol-create]'?")))))
(defun org-protocol-create (&optional project-plist)
"Create a new org-protocol project interactively.
@@ -600,19 +693,18 @@ the cdr of an element in `org-publish-project-alist', reuse
(working-suffix (if (plist-get project-plist :base-extension)
(concat "." (plist-get project-plist :base-extension))
".org"))
- (worglet-buffer nil)
(insert-default-directory t)
(minibuffer-allow-text-properties nil))
(setq base-url (read-string "Base URL of published content: " base-url nil base-url t))
- (if (not (string-match "\\/$" base-url))
- (setq base-url (concat base-url "/")))
+ (or (string-suffix-p "/" base-url)
+ (setq base-url (concat base-url "/")))
(setq working-dir
(expand-file-name
(read-directory-name "Local working directory: " working-dir working-dir t)))
- (if (not (string-match "\\/$" working-dir))
- (setq working-dir (concat working-dir "/")))
+ (or (string-suffix-p "/" working-dir)
+ (setq working-dir (concat working-dir "/")))
(setq strip-suffix
(read-string
diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el
index 80bfce920c5..332c669a4fa 100644
--- a/lisp/org/org-rmail.el
+++ b/lisp/org/org-rmail.el
@@ -1,4 +1,4 @@
-;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode
+;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,14 +19,14 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file implements links to Rmail messages from within Org-mode.
-;; Org-mode loads this module by default - if this is not what you want,
-;; configure the variable `org-modules'.
+;; This file implements links to Rmail messages from within Org mode.
+;; Org mode loads this module by default - if this is not what you
+;; want, configure the variable `org-modules'.
;;; Code:
@@ -36,13 +36,14 @@
(declare-function rmail-show-message "rmail" (&optional n no-summary))
(declare-function rmail-what-message "rmail" (&optional pos))
(declare-function rmail-toggle-header "rmail" (&optional arg))
+(declare-function rmail "rmail" (&optional file-name-arg))
(declare-function rmail-widen "rmail" ())
(defvar rmail-current-message) ; From rmail.el
(defvar rmail-header-style) ; From rmail.el
+(defvar rmail-file-name) ; From rmail.el
;; Install the link type
-(org-add-link-type "rmail" 'org-rmail-open)
-(add-hook 'org-store-link-functions 'org-rmail-store-link)
+(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link)
;; Implementation
(defun org-rmail-store-link ()
@@ -63,20 +64,11 @@
(to (mail-fetch-field "to"))
(subject (mail-fetch-field "subject"))
(date (mail-fetch-field "date"))
- (date-ts (and date (format-time-string
- (org-time-stamp-format t)
- (date-to-time date))))
- (date-ts-ia (and date (format-time-string
- (org-time-stamp-format t t)
- (date-to-time date))))
desc link)
(org-store-link-props
- :type "rmail" :from from :to to
+ :type "rmail" :from from :to to :date date
:subject subject :message-id message-id)
- (when date
- (org-add-link-props :date date :date-timestamp date-ts
- :date-timestamp-inactive date-ts-ia))
- (setq message-id (org-remove-angle-brackets message-id))
+ (setq message-id (org-unbracket-string "<" ">" message-id))
(setq desc (org-email-link-description))
(setq link (concat "rmail:" folder "#" message-id))
(org-add-link-props :link link :description desc)
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index 4eb8a531b85..4191d9aadcf 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -1,4 +1,4 @@
-;;; org-src.el --- Source code examples in Org
+;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
;;
@@ -21,48 +21,38 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the code dealing with source code examples in Org-mode.
+;; This file contains the code dealing with source code examples in
+;; Org mode.
;;; Code:
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
(require 'ob-keys)
(require 'ob-comint)
-(eval-when-compile
- (require 'cl))
+(declare-function org-base-buffer "org" (buffer))
(declare-function org-do-remove-indentation "org" (&optional n))
-(declare-function org-at-table.el-p "org" ())
-(declare-function org-in-src-block-p "org" (&optional inside))
-(declare-function org-in-block-p "org" (names))
+(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))
+(declare-function org-element-lineage "org-element"
+ (blob &optional types with-self))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-footnote-goto-definition "org-footnote"
+ (label &optional location))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
-(declare-function org-base-buffer "org" (buffer))
+(declare-function org-trim "org" (s &optional keep-lead))
-(defcustom org-edit-src-region-extra nil
- "Additional regexps to identify regions for editing with `org-edit-src-code'.
-For examples see the function `org-edit-src-find-region-and-lang'.
-The regular expression identifying the begin marker should end with a newline,
-and the regexp marking the end line should start with a newline, to make sure
-there are kept outside the narrowed region."
- :group 'org-edit-structure
- :type '(repeat
- (list
- (regexp :tag "begin regexp")
- (regexp :tag "end regexp")
- (choice :tag "language"
- (string :tag "specify")
- (integer :tag "from match group")
- (const :tag "from `lang' element")
- (const :tag "from `style' element")))))
+(defvar org-inhibit-startup)
(defcustom org-edit-src-turn-on-auto-save nil
"Non-nil means turn `auto-save-mode' on when editing a source block.
@@ -117,28 +107,29 @@ These are the regions where each line starts with a colon."
(defcustom org-src-preserve-indentation nil
"If non-nil preserve leading whitespace characters on export.
+\\<org-mode-map>
If non-nil leading whitespace characters in source code blocks
are preserved on export, and when switching between the org
-buffer and the language mode edit buffer. If this variable is nil
-then, after editing with \\[org-edit-src-code], the
-minimum (across-lines) number of leading whitespace characters
-are removed from all lines, and the code block is uniformly
-indented according to the value of `org-edit-src-content-indentation'."
+buffer and the language mode edit buffer.
+
+When this variable is nil, after editing with `\\[org-edit-src-code]',
+the minimum (across-lines) number of leading whitespace characters
+are removed from all lines, and the code block is uniformly indented
+according to the value of `org-edit-src-content-indentation'."
:group 'org-edit-structure
:type 'boolean)
(defcustom org-edit-src-content-indentation 2
"Indentation for the content of a source code block.
+
This should be the number of spaces added to the indentation of the #+begin
line in order to compute the indentation of the block content after
-editing it with \\[org-edit-src-code]. Has no effect if
-`org-src-preserve-indentation' is non-nil."
+editing it with `\\[org-edit-src-code]'.
+
+It has no effect if `org-src-preserve-indentation' is non-nil."
:group 'org-edit-structure
:type 'integer)
-(defvar org-src-strip-leading-and-trailing-blank-lines nil
- "If non-nil, blank lines are removed when exiting the code edit buffer.")
-
(defcustom org-edit-src-persistent-message t
"Non-nil means show persistent exit help message while editing src examples.
The message is shown in the header-line, which will be created in the
@@ -146,6 +137,17 @@ first line of the window showing the editing buffer."
:group 'org-edit-structure
:type 'boolean)
+(defcustom org-src-ask-before-returning-to-edit-buffer t
+ "Non-nil means ask before switching to an existing edit buffer.
+If nil, when `org-edit-src-code' is used on a block that already
+has an active edit buffer, it will switch to that edit buffer
+immediately; otherwise it will ask whether you want to return to
+the existing edit buffer."
+ :group 'org-edit-structure
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defcustom org-src-window-setup 'reorganize-frame
"How the source code edit buffer should be displayed.
Possible values for this option are:
@@ -167,10 +169,10 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
(defvar org-src-mode-hook nil
"Hook run after Org switched a source code snippet to its Emacs mode.
-This hook will run
-
-- when editing a source code snippet with `\\[org-src-mode-map]'.
-- When formatting a source code snippet for export with htmlize.
+\\<org-mode-map>
+This hook will run:
+- when editing a source code snippet with `\\[org-edit-special]'
+- when formatting a source code snippet for export with htmlize.
You may want to use this hook for example to turn off `outline-minor-mode'
or similar things which you want to have when editing a source code file,
@@ -180,7 +182,7 @@ but which mess up the display of a snippet in Org exported files.")
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++)
- ("screen" . shell-script))
+ ("screen" . shell-script) ("shell" . sh) ("bash" . sh))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
be inserted as the name of the major mode. For many languages this is
@@ -194,451 +196,383 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(string "Language name")
(symbol "Major mode"))))
-;;; Editing source examples
-
-(defvar org-src-mode-map (make-sparse-keymap))
-(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
-(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort)
-(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
+(defcustom org-src-block-faces nil
+ "Alist of faces to be used for source-block.
+Each element is a cell of the format
-(defvar org-edit-src-force-single-line nil)
-(defvar org-edit-src-from-org-mode nil)
-(defvar org-edit-src-allow-write-back-p t)
-(defvar org-edit-src-picture nil)
-(defvar org-edit-src-beg-marker nil)
-(defvar org-edit-src-end-marker nil)
-(defvar org-edit-src-overlay nil)
-(defvar org-edit-src-block-indentation nil)
-(defvar org-edit-src-saved-temp-window-config nil)
+ (\"language\" FACE)
-(defcustom org-src-ask-before-returning-to-edit-buffer t
- "If nil, when org-edit-src code is used on a block that already
-has an active edit buffer, it will switch to that edit buffer
-immediately; otherwise it will ask whether you want to return to
-the existing edit buffer."
- :group 'org-edit-structure
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
+Where FACE is either a defined face or an anonymous face.
-(defvar org-src-babel-info nil)
-
-(define-minor-mode org-src-mode
- "Minor mode for language major mode buffers generated by org.
-This minor mode is turned on in two situations:
-- when editing a source code snippet with `\\[org-src-mode-map]'.
-- When formatting a source code snippet for export with htmlize.
-There is a mode hook, and keybindings for `org-edit-src-exit' and
-`org-edit-src-save'")
+For instance, the following value would color the background of
+emacs-lisp source blocks and python source blocks in purple and
+green, respectability.
-(defvar org-edit-src-code-timer nil)
-(defvar org-inhibit-startup)
+ \\='((\"emacs-lisp\" (:background \"#EEE2FF\"))
+ (\"python\" (:background \"#e5ffb8\")))"
+ :group 'org-edit-structure
+ :type '(repeat (list (string :tag "language")
+ (choice
+ (face :tag "Face")
+ (sexp :tag "Anonymous face"))))
+ :version "26.1"
+ :package-version '(Org . "9.0"))
-(defun org-edit-src-code (&optional context code edit-buffer-name)
- "Edit the source CODE block at point.
-The code is copied to a separate buffer and the appropriate mode
-is turned on. When done, exit with \\[org-edit-src-exit]. This will
-remove the original code in the Org buffer, and replace it with the
-edited version. An optional argument CONTEXT is used by \\[org-edit-src-save]
-when calling this function. See `org-src-window-setup' to configure
-the display of windows containing the Org buffer and the code buffer."
- (interactive)
- (if (not (or (org-in-block-p '("src" "example" "latex" "html"))
- (org-at-table.el-p)))
- (user-error "Not in a source code or example block")
- (unless (eq context 'save)
- (setq org-edit-src-saved-temp-window-config (current-window-configuration)))
- (let* ((mark (and (org-region-active-p) (mark)))
- (case-fold-search t)
- (info
- ;; If the src region consists in no lines, we insert a blank
- ;; line.
- (let* ((temp (org-edit-src-find-region-and-lang))
- (beg (nth 0 temp))
- (end (nth 1 temp)))
- (if (>= end beg) temp
- (goto-char beg)
- (insert "\n")
- (org-edit-src-find-region-and-lang))))
- (full-info (org-babel-get-src-block-info 'light))
- (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
- (beg (make-marker))
- ;; Move marker with inserted text for case when src block is
- ;; just one empty line, i.e. beg == end.
- (end (copy-marker (make-marker) t))
- (allow-write-back-p (null code))
- block-nindent total-nindent ovl lang lang-f single buffer msg
- begline markline markcol line col transmitted-variables)
- (setq beg (move-marker beg (nth 0 info))
- end (move-marker end (nth 1 info))
- msg (if allow-write-back-p
- "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort"
- "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
- code (or code (buffer-substring-no-properties beg end))
- lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
- (nth 2 info))
- lang (if (symbolp lang) (symbol-name lang) lang)
- single (nth 3 info)
- block-nindent (nth 5 info)
- lang-f (intern (concat lang "-mode"))
- begline (save-excursion (goto-char beg) (org-current-line))
- transmitted-variables
- `((org-edit-src-content-indentation
- ,org-edit-src-content-indentation)
- (org-edit-src-force-single-line ,single)
- (org-edit-src-from-org-mode ,org-mode-p)
- (org-edit-src-allow-write-back-p ,allow-write-back-p)
- (org-src-preserve-indentation ,org-src-preserve-indentation)
- (org-src-babel-info ,(org-babel-get-src-block-info 'light))
- (org-coderef-label-format
- ,(or (nth 4 info) org-coderef-label-format))
- (org-edit-src-beg-marker ,beg)
- (org-edit-src-end-marker ,end)
- (org-edit-src-block-indentation ,block-nindent)))
- (if (and mark (>= mark beg) (<= mark (1+ end)))
- (save-excursion (goto-char (min mark end))
- (setq markline (org-current-line)
- markcol (current-column))))
- (if (equal lang-f 'table.el-mode)
- (setq lang-f (lambda ()
- (text-mode)
- (if (org-bound-and-true-p flyspell-mode)
- (flyspell-mode -1))
- (table-recognize)
- (org-set-local 'org-edit-src-content-indentation 0))))
- (unless (functionp lang-f)
- (error "No such language mode: %s" lang-f))
- (save-excursion
- (if (> (point) end) (goto-char end))
- (setq line (org-current-line)
- col (current-column)))
- (if (and (setq buffer (org-edit-src-find-buffer beg end))
- (or (eq context 'save)
- (if org-src-ask-before-returning-to-edit-buffer
- (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t)))
- (org-src-switch-to-buffer buffer 'return)
- (when buffer
- (with-current-buffer buffer
- (if (boundp 'org-edit-src-overlay)
- (delete-overlay org-edit-src-overlay)))
- (kill-buffer buffer))
- (setq buffer (generate-new-buffer
- (or edit-buffer-name
- (org-src-construct-edit-buffer-name (buffer-name) lang))))
- (setq ovl (make-overlay beg end))
- (overlay-put ovl 'edit-buffer buffer)
- (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
- (overlay-put ovl 'face 'secondary-selection)
- (overlay-put ovl
- 'keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-edit-src-continue)
- map))
- (overlay-put ovl :read-only "Leave me alone")
- (setq transmitted-variables
- (append transmitted-variables `((org-edit-src-overlay ,ovl))))
- (org-src-switch-to-buffer buffer 'edit)
- (if (eq single 'macro-definition)
- (setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
- (insert code)
- (remove-text-properties (point-min) (point-max)
- '(display nil invisible nil intangible nil))
- (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables))
- (setq total-nindent (or (org-do-remove-indentation) 0)))
- (let ((org-inhibit-startup t))
- (condition-case e
- (funcall lang-f)
- (error
- (message "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
- (dolist (pair transmitted-variables)
- (org-set-local (car pair) (cadr pair)))
- ;; Remove protecting commas from visible part of buffer.
- (org-unescape-code-in-region (point-min) (point-max))
- (when markline
- (org-goto-line (1+ (- markline begline)))
- (org-move-to-column
- (if org-src-preserve-indentation markcol
- (max 0 (- markcol total-nindent))))
- (push-mark (point) 'no-message t)
- (setq deactivate-mark nil))
- (org-goto-line (1+ (- line begline)))
- (org-move-to-column
- (if org-src-preserve-indentation col (max 0 (- col total-nindent))))
- (org-src-mode)
- (set-buffer-modified-p nil)
- (setq buffer-file-name nil)
- (when org-edit-src-turn-on-auto-save
- (setq buffer-auto-save-file-name
- (concat (make-temp-name "org-src-")
- (format-time-string "-%Y-%d-%m") ".txt")))
- (and org-edit-src-persistent-message
- (org-set-local 'header-line-format msg))
- (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
- (when (fboundp edit-prep-func)
- (funcall edit-prep-func full-info)))
- (or org-edit-src-code-timer
- (zerop org-edit-src-auto-save-idle-delay)
- (setq org-edit-src-code-timer
- (run-with-idle-timer
- org-edit-src-auto-save-idle-delay t
- (lambda ()
- (cond
- ((org-string-match-p "\\`\\*Org Src" (buffer-name))
- (when (buffer-modified-p) (org-edit-src-save)))
- ((not (org-some (lambda (b)
- (org-string-match-p "\\`\\*Org Src"
- (buffer-name b)))
- (buffer-list)))
- (cancel-timer org-edit-src-code-timer)
- (setq org-edit-src-code-timer nil))))))))
- t)))
+(defcustom org-src-tab-acts-natively nil
+ "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"
+ :group 'org-babel)
-(defun org-edit-src-continue (e)
- "Continue editing source blocks." ;; Fixme: be more accurate
- (interactive "e")
- (mouse-set-point e)
- (let ((buf (get-char-property (point) 'edit-buffer)))
- (if buf (org-src-switch-to-buffer buf 'continue)
- (error "Something is wrong here"))))
-(defun org-src-switch-to-buffer (buffer context)
- (case org-src-window-setup
- ('current-window
- (org-pop-to-buffer-same-window buffer))
- ('other-window
- (switch-to-buffer-other-window buffer))
- ('other-frame
- (case context
- ('exit
- (let ((frame (selected-frame)))
- (switch-to-buffer-other-frame buffer)
- (delete-frame frame)))
- ('save
- (kill-buffer (current-buffer))
- (org-pop-to-buffer-same-window buffer))
- (t
- (switch-to-buffer-other-frame buffer))))
- ('reorganize-frame
- (if (eq context 'edit) (delete-other-windows))
- (org-switch-to-buffer-other-window buffer)
- (if (eq context 'exit) (delete-other-windows)))
- ('switch-invisibly
- (set-buffer buffer))
- (t
- (message "Invalid value %s for org-src-window-setup"
- (symbol-name org-src-window-setup))
- (org-pop-to-buffer-same-window buffer))))
-
-(defun org-src-construct-edit-buffer-name (org-buffer-name lang)
+
+;;; Internal functions and variables
+
+(defvar org-src--allow-write-back t)
+(defvar org-src--auto-save-timer nil)
+(defvar org-src--babel-info nil)
+(defvar org-src--beg-marker nil)
+(defvar org-src--block-indentation nil)
+(defvar org-src--end-marker nil)
+(defvar org-src--from-org-mode nil)
+(defvar org-src--overlay nil)
+(defvar org-src--preserve-indentation nil)
+(defvar org-src--remote nil)
+(defvar org-src--saved-temp-window-config nil)
+(defvar org-src--source-type nil
+ "Type of element being edited, as a symbol.")
+(defvar org-src--tab-width nil
+ "Contains `tab-width' value from Org source buffer.
+However, if `indent-tabs-mode' is nil in that buffer, its value
+is 0.")
+
+(defun org-src--construct-edit-buffer-name (org-buffer-name lang)
"Construct the buffer name for a source editing buffer."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
-(defun org-src-edit-buffer-p (&optional buffer)
- "Test whether BUFFER (or the current buffer if BUFFER is nil)
-is a source block editing buffer."
- (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
- (and (buffer-name buffer)
- (string-match "\\`*Org Src " (buffer-name buffer))
- (local-variable-p 'org-edit-src-beg-marker buffer)
- (local-variable-p 'org-edit-src-end-marker buffer))))
-
-(defun org-edit-src-find-buffer (beg end)
- "Find a source editing buffer that is already editing the region BEG to END."
+(defun org-src--edit-buffer (beg end)
+ "Return buffer editing area between BEG and END.
+Return nil if there is no such buffer."
(catch 'exit
- (mapc
- (lambda (b)
- (with-current-buffer b
- (if (and (string-match "\\`*Org Src " (buffer-name))
- (local-variable-p 'org-edit-src-beg-marker (current-buffer))
- (local-variable-p 'org-edit-src-end-marker (current-buffer))
- (equal beg org-edit-src-beg-marker)
- (equal end org-edit-src-end-marker))
- (throw 'exit (current-buffer)))))
- (buffer-list))
- nil))
+ (dolist (b (buffer-list))
+ (with-current-buffer b
+ (and (org-src-edit-buffer-p)
+ (= beg org-src--beg-marker)
+ (eq (marker-buffer beg) (marker-buffer org-src--beg-marker))
+ (= end org-src--end-marker)
+ (eq (marker-buffer end) (marker-buffer org-src--end-marker))
+ (throw 'exit b))))))
+
+(defun org-src--source-buffer ()
+ "Return source buffer edited by current buffer."
+ (unless (org-src-edit-buffer-p) (error "Not in a source buffer"))
+ (or (marker-buffer org-src--beg-marker)
+ (error "No source buffer available for current editing session")))
+
+(defun org-src--get-lang-mode (lang)
+ "Return major mode that should be used for LANG.
+LANG is a string, and the returned major mode is a symbol."
+ (intern
+ (concat
+ (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
+ (if (symbolp l) (symbol-name l) l))
+ "-mode")))
-(defun org-edit-fixed-width-region ()
- "Edit the fixed-width ascii drawing at point.
-This must be a region where each line starts with a colon followed by
-a space character.
-An new buffer is created and the fixed-width region is copied into it,
-and the buffer is switched into `artist-mode' for editing. When done,
-exit with \\[org-edit-src-exit]. The edited text will then replace
-the fragment in the Org-mode buffer."
- (interactive)
- (let ((line (org-current-line))
- (col (current-column))
- (case-fold-search t)
- (msg "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")
- (org-mode-p (derived-mode-p 'org-mode))
- (beg (make-marker))
- (end (make-marker))
- block-nindent ovl beg1 end1 code begline buffer)
- (beginning-of-line 1)
- (if (looking-at "[ \t]*[^:\n \t]")
- nil
- (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
- (setq beg1 (point) end1 beg1)
- (save-excursion
- (if (re-search-backward "^[ \t]*[^: \t]" nil 'move)
- (setq beg1 (point-at-bol 2))
- (setq beg1 (point))))
- (save-excursion
- (if (re-search-forward "^[ \t]*[^: \t]" nil 'move)
- (setq end1 (1- (match-beginning 0)))
- (setq end1 (point))))
- (org-goto-line line))
- (setq beg (move-marker beg beg1)
- end (move-marker end end1)
- code (buffer-substring-no-properties beg end)
- begline (save-excursion (goto-char beg) (org-current-line)))
- (if (and (setq buffer (org-edit-src-find-buffer beg end))
- (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))
- (org-pop-to-buffer-same-window buffer)
- (when buffer
- (with-current-buffer buffer
- (if (boundp 'org-edit-src-overlay)
- (delete-overlay org-edit-src-overlay)))
- (kill-buffer buffer))
- (setq buffer (generate-new-buffer
- (org-src-construct-edit-buffer-name
- (buffer-name) "Fixed Width")))
- (setq ovl (make-overlay beg end))
- (overlay-put ovl 'face 'secondary-selection)
- (overlay-put ovl 'edit-buffer buffer)
- (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
- (overlay-put ovl 'face 'secondary-selection)
- (overlay-put ovl
- 'keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-edit-src-continue)
- map))
- (overlay-put ovl :read-only "Leave me alone")
- (org-pop-to-buffer-same-window buffer)
- (insert code)
+(defun org-src--coordinates (pos beg end)
+ "Return coordinates of POS relatively to BEG and END.
+POS, BEG and END are buffer positions. Return value is either
+a cons cell (LINE . COLUMN) or symbol `end'. See also
+`org-src--goto-coordinates'."
+ (if (>= pos end) 'end
+ (org-with-wide-buffer
+ (goto-char (max beg pos))
+ (cons (count-lines beg (line-beginning-position))
+ ;; Column is relative to the end of line to avoid problems of
+ ;; comma escaping or colons appended in front of the line.
+ (- (current-column)
+ (progn (end-of-line) (current-column)))))))
+
+(defun org-src--goto-coordinates (coord beg end)
+ "Move to coordinates COORD relatively to BEG and END.
+COORD are coordinates, as returned by `org-src--coordinates',
+which see. BEG and END are buffer positions."
+ (goto-char
+ (if (eq coord 'end) (max (1- end) beg)
+ ;; If BEG happens to be located outside of the narrowed part of
+ ;; the buffer, widen it first.
+ (org-with-wide-buffer
+ (goto-char beg)
+ (forward-line (car coord))
+ (end-of-line)
+ (org-move-to-column (max (+ (current-column) (cdr coord)) 0))
+ (point)))))
+
+(defun org-src--contents-area (datum)
+ "Return contents boundaries of DATUM.
+DATUM is an element or object. Return a list (BEG END CONTENTS)
+where BEG and END are buffer positions and CONTENTS is a string."
+ (let ((type (org-element-type datum)))
+ (org-with-wide-buffer
+ (cond
+ ((eq type 'footnote-definition)
+ (let* ((beg (progn
+ (goto-char (org-element-property :post-affiliated datum))
+ (search-forward "]")))
+ (end (or (org-element-property :contents-end datum) beg)))
+ (list beg end (buffer-substring-no-properties beg end))))
+ ((eq type 'inline-src-block)
+ (let ((beg (progn (goto-char (org-element-property :begin datum))
+ (search-forward "{" (line-end-position) t)))
+ (end (progn (goto-char (org-element-property :end datum))
+ (search-backward "}" (line-beginning-position) t))))
+ (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)))
+ (list beg end (buffer-substring-no-properties beg end))))
+ ((memq type '(example-block export-block src-block))
+ (list (progn (goto-char (org-element-property :post-affiliated datum))
+ (line-beginning-position 2))
+ (progn (goto-char (org-element-property :end datum))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 1))
+ (org-element-property :value datum)))
+ ((memq type '(fixed-width latex-environment table))
+ (let ((beg (org-element-property :post-affiliated datum))
+ (end (progn (goto-char (org-element-property :end datum))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
+ (list beg
+ end
+ (if (eq type 'fixed-width) (org-element-property :value datum)
+ (buffer-substring-no-properties beg end)))))
+ (t (error "Unsupported element or object: %s" type))))))
+
+(defun org-src--make-source-overlay (beg end edit-buffer)
+ "Create overlay between BEG and END positions and return it.
+EDIT-BUFFER is the buffer currently editing area between BEG and
+END."
+ (let ((overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'secondary-selection)
+ (overlay-put overlay 'edit-buffer edit-buffer)
+ (overlay-put overlay 'help-echo
+ "Click with mouse-1 to switch to buffer editing this segment")
+ (overlay-put overlay 'face 'secondary-selection)
+ (overlay-put overlay 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-edit-src-continue)
+ map))
+ (let ((read-only
+ (list
+ (lambda (&rest _)
+ (user-error
+ "Cannot modify an area being edited in a dedicated buffer")))))
+ (overlay-put overlay 'modification-hooks read-only)
+ (overlay-put overlay 'insert-in-front-hooks read-only)
+ (overlay-put overlay 'insert-behind-hooks read-only))
+ overlay))
+
+(defun org-src--remove-overlay ()
+ "Remove overlay from current source buffer."
+ (when (overlayp org-src--overlay) (delete-overlay org-src--overlay)))
+
+(defun org-src--on-datum-p (datum)
+ "Non-nil when point is on DATUM.
+DATUM is an element or an object. Consider blank lines or white
+spaces after it as being outside."
+ (and (>= (point) (org-element-property :begin datum))
+ (<= (point)
+ (org-with-wide-buffer
+ (goto-char (org-element-property :end datum))
+ (skip-chars-backward " \r\t\n")
+ (if (eq (org-element-class datum) 'element)
+ (line-end-position)
+ (point))))))
+
+(defun org-src--contents-for-write-back ()
+ "Return buffer contents in a format appropriate for write back.
+Assume point is in the corresponding edit buffer."
+ (let ((indentation-offset
+ (if org-src--preserve-indentation 0
+ (+ (or org-src--block-indentation 0)
+ (if (memq org-src--source-type '(example-block src-block))
+ org-edit-src-content-indentation
+ 0))))
+ (use-tabs? (and (> org-src--tab-width 0) t))
+ (source-tab-width org-src--tab-width)
+ (contents (org-with-wide-buffer (buffer-string)))
+ (write-back org-src--allow-write-back))
+ (with-temp-buffer
+ ;; Reproduce indentation parameters from source buffer.
+ (setq-local indent-tabs-mode use-tabs?)
+ (when (> source-tab-width 0) (setq-local tab-width source-tab-width))
+ ;; Apply WRITE-BACK function on edit buffer contents.
+ (insert (org-no-properties contents))
+ (goto-char (point-min))
+ (when (functionp write-back) (save-excursion (funcall write-back)))
+ ;; Add INDENTATION-OFFSET to every non-empty line in buffer,
+ ;; unless indentation is meant to be preserved.
+ (when (> indentation-offset 0)
+ (while (not (eobp))
+ (skip-chars-forward " \t")
+ (unless (eolp) ;ignore blank lines
+ (let ((i (current-column)))
+ (delete-region (line-beginning-position) (point))
+ (indent-to (+ i indentation-offset))))
+ (forward-line)))
+ (buffer-string))))
+
+(defun org-src--edit-element
+ (datum name &optional initialize write-back contents remote)
+ "Edit DATUM contents in a dedicated buffer NAME.
+
+INITIALIZE is a function to call upon creating the buffer.
+
+When WRITE-BACK is non-nil, assume contents will replace original
+region. Moreover, if it is a function, apply it in the edit
+buffer, from point min, before returning the contents.
+
+When CONTENTS is non-nil, display them in the edit buffer.
+Otherwise, show DATUM contents as specified by
+`org-src--contents-area'.
+
+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."
+ (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))
+ (old-edit-buffer (org-src--edit-buffer beg end))
+ (contents (or contents (nth 2 area))))
+ (if (and old-edit-buffer
+ (or (not org-src-ask-before-returning-to-edit-buffer)
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")))
+ ;; Move to existing buffer.
+ (org-src-switch-to-buffer old-edit-buffer 'return)
+ ;; Discard old edit buffer.
+ (when old-edit-buffer
+ (with-current-buffer old-edit-buffer (org-src--remove-overlay))
+ (kill-buffer old-edit-buffer))
+ (let* ((org-mode-p (derived-mode-p 'org-mode))
+ (source-tab-width (if indent-tabs-mode tab-width 0))
+ (type (org-element-type datum))
+ (ind (org-with-wide-buffer
+ (goto-char (org-element-property :begin datum))
+ (org-get-indentation)))
+ (preserve-ind
+ (and (memq type '(example-block src-block))
+ (or (org-element-property :preserve-indent datum)
+ org-src-preserve-indentation)))
+ ;; Store relative positions of mark (if any) and point
+ ;; within the edited area.
+ (point-coordinates (and (not remote)
+ (org-src--coordinates (point) beg end)))
+ (mark-coordinates (and (not remote)
+ (org-region-active-p)
+ (let ((m (mark)))
+ (and (>= m beg) (>= end m)
+ (org-src--coordinates m beg end)))))
+ ;; Generate a new edit buffer.
+ (buffer (generate-new-buffer name))
+ ;; Add an overlay on top of source.
+ (overlay (org-src--make-source-overlay beg end buffer)))
+ ;; Switch to edit buffer.
+ (org-src-switch-to-buffer buffer 'edit)
+ ;; Insert contents.
+ (insert contents)
(remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil))
- (setq block-nindent (or (org-do-remove-indentation) 0))
- (cond
- ((eq org-edit-fixed-width-region-mode 'artist-mode)
- (fundamental-mode)
- (artist-mode 1))
- (t (funcall org-edit-fixed-width-region-mode)))
- (set (make-local-variable 'org-edit-src-force-single-line) nil)
- (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
- (set (make-local-variable 'org-edit-src-picture) t)
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*: ?" nil t)
- (replace-match ""))
- (org-goto-line (1+ (- line begline)))
- (org-move-to-column (max 0 (- col block-nindent 2)))
- (org-set-local 'org-edit-src-beg-marker beg)
- (org-set-local 'org-edit-src-end-marker end)
- (org-set-local 'org-edit-src-overlay ovl)
- (org-set-local 'org-edit-src-block-indentation block-nindent)
- (org-set-local 'org-edit-src-content-indentation 0)
- (org-set-local 'org-src-preserve-indentation nil)
- (org-src-mode)
+ (unless preserve-ind (org-do-remove-indentation))
(set-buffer-modified-p nil)
- (and org-edit-src-persistent-message
- (org-set-local 'header-line-format msg)))
- (message "%s" msg)
- t)))
+ (setq buffer-file-name nil)
+ ;; Initialize buffer.
+ (when (functionp initialize)
+ (let ((org-inhibit-startup t))
+ (condition-case e
+ (funcall initialize)
+ (error (message "Initialization fails with: %S"
+ (error-message-string e))))))
+ ;; Transmit buffer-local variables for exit function. It must
+ ;; be done after initializing major mode, as this operation
+ ;; may reset them otherwise.
+ (setq-local org-src--tab-width source-tab-width)
+ (setq-local org-src--from-org-mode org-mode-p)
+ (setq-local org-src--beg-marker beg)
+ (setq-local org-src--end-marker end)
+ (setq-local org-src--remote remote)
+ (setq-local org-src--source-type type)
+ (setq-local org-src--block-indentation ind)
+ (setq-local org-src--preserve-indentation preserve-ind)
+ (setq-local org-src--overlay overlay)
+ (setq-local org-src--allow-write-back write-back)
+ ;; Start minor mode.
+ (org-src-mode)
+ ;; Move mark and point in edit buffer to the corresponding
+ ;; location.
+ (if remote
+ (progn
+ ;; Put point at first non read-only character after
+ ;; leading blank.
+ (goto-char
+ (or (text-property-any (point-min) (point-max) 'read-only nil)
+ (point-max)))
+ (skip-chars-forward " \r\t\n"))
+ ;; Set mark and point.
+ (when mark-coordinates
+ (org-src--goto-coordinates mark-coordinates (point-min) (point-max))
+ (push-mark (point) 'no-message t)
+ (setq deactivate-mark nil))
+ (org-src--goto-coordinates
+ point-coordinates (point-min) (point-max)))))))
+
+
+
+;;; Fontification of source blocks
-(defun org-edit-src-find-region-and-lang ()
- "Find the region and language for a local edit.
-Return a list with beginning and end of the region, a string representing
-the language, a switch telling if the content should be in a single line."
- (let ((re-list
- (append
- org-edit-src-region-extra
- '(
- ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
- ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
- ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
- ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
- ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
- ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
- ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
- ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2)
- ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental")
- ("^[ \t]*#\\+html:" "\n" "html" single-line)
- ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html")
- ("^[ \t]*#\\+latex:" "\n" "latex" single-line)
- ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex")
- ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line)
- ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental")
- ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)"
- "\n" "fundamental" macro-definition)
- )))
- (pos (point))
- re1 re2 single beg end lang lfmt match-re1 ind entry)
- (catch 'exit
- (while (setq entry (pop re-list))
- (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
- single (nth 3 entry))
- (save-excursion
- (if (or (looking-at re1)
- (re-search-backward re1 nil t))
- (progn
- (setq match-re1 (match-string 0))
- (setq beg (match-end 0)
- lang (org-edit-src-get-lang lang)
- lfmt (org-edit-src-get-label-format match-re1)
- ind (org-edit-src-get-indentation (match-beginning 0)))
- (if (and (re-search-forward re2 nil t)
- (>= (match-end 0) pos))
- (throw 'exit (list beg (match-beginning 0)
- lang single lfmt ind))))
- (if (or (looking-at re2)
- (re-search-forward re2 nil t))
- (progn
- (setq end (match-beginning 0))
- (if (and (re-search-backward re1 nil t)
- (<= (match-beginning 0) pos))
- (progn
- (setq lfmt (org-edit-src-get-label-format
- (match-string 0))
- ind (org-edit-src-get-indentation
- (match-beginning 0)))
- (throw 'exit
- (list (match-end 0) end
- (org-edit-src-get-lang lang)
- single lfmt ind)))))))))
- (when (org-at-table.el-p)
- (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
- (setq beg (1+ (point-at-eol)))
- (goto-char beg)
- (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
- (progn (goto-char (point-max)) (newline)))
- (setq end (1- (point-at-bol)))
- (throw 'exit (list beg end 'table.el nil nil 0))))))
-
-(defun org-edit-src-get-lang (lang)
- "Extract the src language."
- (let ((m (match-string 0)))
- (cond
- ((stringp lang) lang)
- ((integerp lang) (match-string lang))
- ((and (eq lang 'lang)
- (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
- (match-string 1 m))
- ((and (eq lang 'style)
- (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
- (match-string 1 m))
- (t "fundamental"))))
-
-(defun org-edit-src-get-label-format (s)
- "Extract the label format."
- (save-match-data
- (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
- (match-string 1 s))))
-
-(defun org-edit-src-get-indentation (pos)
- "Count leading whitespace characters on line."
- (save-match-data
- (goto-char pos)
- (org-get-indentation)))
+(defun org-src-font-lock-fontify-block (lang start end)
+ "Fontify code block.
+This function is called by emacs automatic fontification, as long
+as `org-src-fontify-natively' is non-nil."
+ (let ((lang-mode (org-src--get-lang-mode lang)))
+ (when (fboundp lang-mode)
+ (let ((string (buffer-substring-no-properties start end))
+ (modified (buffer-modified-p))
+ (org-buffer (current-buffer)))
+ (remove-text-properties start end '(face nil))
+ (with-current-buffer
+ (get-buffer-create
+ (format " *org-src-fontification:%s*" lang-mode))
+ (let ((inhibit-modification-hooks nil))
+ (erase-buffer)
+ ;; Add string and a final space to ensure property change.
+ (insert string " "))
+ (unless (eq major-mode lang-mode) (funcall lang-mode))
+ (org-font-lock-ensure)
+ (let ((pos (point-min)) next)
+ (while (setq next (next-property-change pos))
+ ;; Handle additional properties from font-lock, so as to
+ ;; preserve, e.g., composition.
+ (dolist (prop (cons 'face font-lock-extra-managed-props))
+ (let ((new-prop (get-text-property pos prop)))
+ (put-text-property
+ (+ start (1- pos)) (1- (+ start next)) prop new-prop
+ org-buffer)))
+ (setq pos next))))
+ ;; Add Org faces.
+ (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
+ (when (or (facep src-face) (listp src-face))
+ (font-lock-append-text-property start end 'face src-face))
+ (font-lock-append-text-property start end 'face 'org-block))
+ (add-text-properties
+ start end
+ '(font-lock-fontified t fontified t font-lock-multiline t))
+ (set-buffer-modified-p modified)))))
+
+
+;;; Escape contents
(defun org-escape-code-in-region (beg end)
"Escape lines between BEG and END.
@@ -646,15 +580,16 @@ Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
\",#+\" by appending a comma to it."
(interactive "r")
(save-excursion
- (goto-char beg)
- (while (re-search-forward "^[ \t]*,?\\(\\*\\|#\\+\\)" end t)
- (replace-match ",\\1" nil nil nil 1))))
+ (goto-char end)
+ (while (re-search-backward "^[ \t]*\\(,*\\(?:\\*\\|#\\+\\)\\)" beg t)
+ (save-excursion (replace-match ",\\1" nil nil nil 1)))))
(defun org-escape-code-in-string (s)
"Escape lines in string S.
Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
\",#+\" by appending a comma to it."
- (replace-regexp-in-string "^[ \t]*,?\\(\\*\\|#\\+\\)" ",\\1" s nil nil 1))
+ (replace-regexp-in-string "^[ \t]*\\(,*\\(?:\\*\\|#\\+\\)\\)" ",\\1"
+ s nil nil 1))
(defun org-unescape-code-in-region (beg end)
"Un-escape lines between BEG and END.
@@ -662,180 +597,93 @@ Un-escaping happens by removing the first comma on lines starting
with \",*\", \",#+\", \",,*\" and \",,#+\"."
(interactive "r")
(save-excursion
- (goto-char beg)
- (while (re-search-forward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" end t)
- (replace-match "" nil nil nil 1))))
+ (goto-char end)
+ (while (re-search-backward "^[ \t]*,*\\(,\\)\\(?:\\*\\|#\\+\\)" beg t)
+ (save-excursion (replace-match "" nil nil nil 1)))))
(defun org-unescape-code-in-string (s)
"Un-escape lines in string S.
Un-escaping happens by removing the first comma on lines starting
with \",*\", \",#+\", \",,*\" and \",,#+\"."
(replace-regexp-in-string
- "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1))
+ "^[ \t]*,*\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1))
-(defun org-edit-src-exit (&optional context)
- "Exit special edit and protect problematic lines."
- (interactive)
- (unless (org-bound-and-true-p org-edit-src-from-org-mode)
- (error "This is not a sub-editing buffer, something is wrong"))
- (widen)
- (let* ((fixed-width-p (string-match "Fixed Width" (buffer-name)))
- (beg org-edit-src-beg-marker)
- (end org-edit-src-end-marker)
- (ovl org-edit-src-overlay)
- (bufstr (buffer-string))
- (buffer (current-buffer))
- (single (org-bound-and-true-p org-edit-src-force-single-line))
- (macro (eq single 'macro-definition))
- (total-nindent (+ (or org-edit-src-block-indentation 0)
- org-edit-src-content-indentation))
- (preserve-indentation org-src-preserve-indentation)
- (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p))
- (delta 0) code line col indent)
- (when allow-write-back-p
- (unless preserve-indentation (untabify (point-min) (point-max)))
- (if org-src-strip-leading-and-trailing-blank-lines
- (save-excursion
- (goto-char (point-min))
- (if (looking-at "[ \t\n]*\n") (replace-match ""))
- (unless macro
- (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
- (setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
- 1
- (org-current-line))
- col (current-column))
- (when allow-write-back-p
- (when single
- (goto-char (point-min))
- (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
- (goto-char (point-min))
- (let ((cnt 0))
- (while (re-search-forward "\n" nil t)
- (setq cnt (1+ cnt))
- (replace-match (if macro "\\n" " ") t t))
- (when (and macro (> cnt 0))
- (goto-char (point-max)) (insert "\\n")))
- (goto-char (point-min))
- (if (looking-at "\\s-*") (replace-match " ")))
- (when (and (org-bound-and-true-p org-edit-src-from-org-mode)
- (not fixed-width-p))
- (org-escape-code-in-region (point-min) (point-max))
- (setq delta (+ delta
- (save-excursion
- (org-goto-line line)
- (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1
- 0)))))
- (when (org-bound-and-true-p org-edit-src-picture)
- (setq preserve-indentation nil)
- (untabify (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "^" nil t)
- (replace-match ": ")))
- (unless (or single preserve-indentation (= total-nindent 0))
- (setq indent (make-string total-nindent ?\ ))
- (goto-char (point-min))
- (while (re-search-forward "\\(^\\).+" nil t)
- (replace-match indent nil nil nil 1)))
- (if (org-bound-and-true-p org-edit-src-picture)
- (setq total-nindent (+ total-nindent 2)))
- (setq code (buffer-string))
- (when (eq context 'save)
- (erase-buffer)
- (insert bufstr))
- (set-buffer-modified-p nil))
- (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
- (if (eq context 'save) (save-buffer)
- (with-current-buffer buffer
- (set-buffer-modified-p nil))
- (kill-buffer buffer))
- (goto-char beg)
- (when allow-write-back-p
- (undo-boundary)
- (delete-region beg (max beg end))
- (unless (string-match "\\`[ \t]*\\'" code)
- (insert code))
- ;; Make sure the overlay stays in place
- (when (eq context 'save) (move-overlay ovl beg (point)))
- (goto-char beg)
- (if single (just-one-space)))
- (if (memq t (mapcar (lambda (overlay)
- (eq (overlay-get overlay 'invisible)
- 'org-hide-block))
- (overlays-at (point))))
- ;; Block is hidden; put point at start of block
- (beginning-of-line 0)
- ;; Block is visible, put point where it was in the code buffer
- (when allow-write-back-p
- (org-goto-line (1- (+ (org-current-line) line)))
- (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))))
- (unless (eq context 'save)
- (move-marker beg nil)
- (move-marker end nil)))
- (unless (eq context 'save)
- (when org-edit-src-saved-temp-window-config
- (set-window-configuration org-edit-src-saved-temp-window-config)
- (setq org-edit-src-saved-temp-window-config nil))))
-
-(defun org-edit-src-abort ()
- "Abort editing of the src code and return to the Org buffer."
- (interactive)
- (let (org-edit-src-allow-write-back-p)
- (org-edit-src-exit 'exit)))
-
-(defmacro org-src-in-org-buffer (&rest body)
- `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
- (save-window-excursion
- (org-edit-src-exit 'save)
- ,@body
- (setq msg (current-message))
- (if (eq org-src-window-setup 'other-frame)
- (let ((org-src-window-setup 'current-window))
- (org-edit-src-code 'save))
- (org-edit-src-code 'save)))
- (setq buffer-undo-list ul)
- (push-mark m 'nomessage)
- (goto-char (min p (point-max)))
- (message (or msg ""))))
-(def-edebug-spec org-src-in-org-buffer (body))
-(defun org-edit-src-save ()
- "Save parent buffer with current state source-code buffer."
- (interactive)
- (if (string-match "Fixed Width" (buffer-name))
- (user-error "%s" "Use C-c ' to save and exit, C-c C-k to abort editing")
- (org-src-in-org-buffer (save-buffer))))
+
+;;; Org src minor mode
-(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang))
+(defvar org-src-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c'" 'org-edit-src-exit)
+ (define-key map "\C-c\C-k" 'org-edit-src-abort)
+ (define-key map "\C-x\C-s" 'org-edit-src-save)
+ map))
-(defun org-src-tangle (arg)
- "Tangle the parent buffer."
- (interactive)
- (org-src-in-org-buffer (org-babel-tangle arg)))
+(define-minor-mode org-src-mode
+ "Minor mode for language major mode buffers generated by Org.
+\\<org-mode-map>
+This minor mode is turned on in two situations:
+ - when editing a source code snippet with `\\[org-edit-special]'
+ - when formatting a source code snippet for export with htmlize.
+
+\\{org-src-mode-map}
+
+See also `org-src-mode-hook'."
+ nil " OrgSrc" nil
+ (when org-edit-src-persistent-message
+ (setq-local
+ header-line-format
+ (substitute-command-keys
+ (if org-src--allow-write-back
+ "Edit, then exit with `\\[org-edit-src-exit]' or abort with \
+`\\[org-edit-src-abort]'"
+ "Exit with `\\[org-edit-src-exit]' or abort with \
+`\\[org-edit-src-abort]'"))))
+ ;; Possibly activate various auto-save features (for the edit buffer
+ ;; or the source buffer).
+ (when org-edit-src-turn-on-auto-save
+ (setq buffer-auto-save-file-name
+ (concat (make-temp-name "org-src-")
+ (format-time-string "-%Y-%d-%m")
+ ".txt")))
+ (unless (or org-src--auto-save-timer (zerop org-edit-src-auto-save-idle-delay))
+ (setq org-src--auto-save-timer
+ (run-with-idle-timer
+ org-edit-src-auto-save-idle-delay t
+ (lambda ()
+ (save-excursion
+ (let (edit-flag)
+ (dolist (b (buffer-list))
+ (with-current-buffer b
+ (when (org-src-edit-buffer-p)
+ (unless edit-flag (setq edit-flag t))
+ (when (buffer-modified-p) (org-edit-src-save)))))
+ (unless edit-flag
+ (cancel-timer org-src--auto-save-timer)
+ (setq org-src--auto-save-timer nil)))))))))
(defun org-src-mode-configure-edit-buffer ()
- (when (org-bound-and-true-p org-edit-src-from-org-mode)
- (org-add-hook 'kill-buffer-hook
- #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
- (if (org-bound-and-true-p org-edit-src-allow-write-back-p)
+ (when (bound-and-true-p org-src--from-org-mode)
+ (add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local)
+ (if (bound-and-true-p org-src--allow-write-back)
(progn
(setq buffer-offer-save t)
(setq buffer-file-name
- (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker))
+ (concat (buffer-file-name (marker-buffer org-src--beg-marker))
"[" (buffer-name) "]"))
- (if (featurep 'xemacs)
- (progn
- (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4
- (setq write-contents-hooks '(org-edit-src-save)))
- (setq write-contents-functions '(org-edit-src-save))))
+ (setq-local write-contents-functions '(org-edit-src-save)))
(setq buffer-read-only t))))
-(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)
+(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
+
+;;; Babel related functions
+
(defun org-src-associate-babel-session (info)
"Associate edit buffer with comint session."
(interactive)
- (let ((session (cdr (assoc :session (nth 2 info)))))
+ (let ((session (cdr (assq :session (nth 2 info)))))
(and session (not (string= session "none"))
(org-babel-comint-buffer-livep session)
(let ((f (intern (format "org-babel-%s-associate-session"
@@ -843,18 +691,22 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(and (fboundp f) (funcall f session))))))
(defun org-src-babel-configure-edit-buffer ()
- (when org-src-babel-info
- (org-src-associate-babel-session org-src-babel-info)))
+ (when org-src--babel-info
+ (org-src-associate-babel-session org-src--babel-info)))
+
+(add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer)
+
+
+;;; Public API
-(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer)
(defmacro org-src-do-at-code-block (&rest body)
- "Execute a command from an edit buffer in the Org-mode buffer."
- `(let ((beg-marker org-edit-src-beg-marker))
- (if beg-marker
- (with-current-buffer (marker-buffer beg-marker)
- (goto-char (marker-position beg-marker))
- ,@body))))
-(def-edebug-spec org-src-do-at-code-block (body))
+ "Execute BODY from an edit buffer in the Org mode buffer."
+ (declare (debug (body)))
+ `(let ((beg-marker org-src--beg-marker))
+ (when beg-marker
+ (with-current-buffer (marker-buffer beg-marker)
+ (goto-char beg-marker)
+ ,@body))))
(defun org-src-do-key-sequence-at-code-block (&optional key)
"Execute key sequence at code block in the source Org buffer.
@@ -878,85 +730,403 @@ Org-babel commands."
(if (equal key (kbd "C-g")) (keyboard-quit)
(org-edit-src-save)
(org-src-do-at-code-block
- (call-interactively
- (lookup-key org-babel-map key)))))
+ (call-interactively (lookup-key org-babel-map key)))))
-(defcustom org-src-tab-acts-natively nil
- "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"
- :group 'org-babel)
+(defun org-src-edit-buffer-p (&optional buffer)
+ "Non-nil when current buffer is a source editing buffer.
+If BUFFER is non-nil, test it instead."
+ (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
+ (and (buffer-live-p buffer)
+ (local-variable-p 'org-src--beg-marker buffer)
+ (local-variable-p 'org-src--end-marker buffer))))
+
+(defun org-src-switch-to-buffer (buffer context)
+ (pcase org-src-window-setup
+ (`current-window (pop-to-buffer-same-window buffer))
+ (`other-window
+ (switch-to-buffer-other-window buffer))
+ (`other-frame
+ (pcase context
+ (`exit
+ (let ((frame (selected-frame)))
+ (switch-to-buffer-other-frame buffer)
+ (delete-frame frame)))
+ (`save
+ (kill-buffer (current-buffer))
+ (pop-to-buffer-same-window buffer))
+ (_ (switch-to-buffer-other-frame buffer))))
+ (`reorganize-frame
+ (when (eq context 'edit) (delete-other-windows))
+ (org-switch-to-buffer-other-window buffer)
+ (when (eq context 'exit) (delete-other-windows)))
+ (`switch-invisibly (set-buffer buffer))
+ (_
+ (message "Invalid value %s for `org-src-window-setup'"
+ org-src-window-setup)
+ (pop-to-buffer-same-window buffer))))
+
+(defun org-src-coderef-format (&optional element)
+ "Return format string for block at point.
+
+When optional argument ELEMENT is provided, use that block.
+Otherwise, assume point is either at a source block, at an
+example block.
+
+If point is in an edit buffer, retrieve format string associated
+to the remote source block."
+ (cond
+ ((and element (org-element-property :label-fmt element)))
+ ((org-src-edit-buffer-p) (org-src-do-at-code-block (org-src-coderef-format)))
+ ((org-element-property :label-fmt (org-element-at-point)))
+ (t org-coderef-label-format)))
+
+(defun org-src-coderef-regexp (fmt &optional label)
+ "Return regexp matching a coderef format string FMT.
+
+When optional argument LABEL is non-nil, match coderef for that
+label only.
+
+Match group 1 contains the full coderef string with surrounding
+white spaces. Match group 2 contains the same string without any
+surrounding space. Match group 3 contains the label.
+
+A coderef format regexp can only match at the end of a line."
+ (format "\\([ \t]*\\(%s\\)[ \t]*\\)$"
+ (replace-regexp-in-string
+ "%s"
+ (if label (regexp-quote label) "\\([-a-zA-Z0-9_][-a-zA-Z0-9_ ]*\\)")
+ (regexp-quote fmt)
+ nil t)))
+
+(defun org-edit-footnote-reference ()
+ "Edit definition of footnote reference at point."
+ (interactive)
+ (let* ((context (org-element-context))
+ (label (org-element-property :label context)))
+ (unless (and (eq (org-element-type context) 'footnote-reference)
+ (org-src--on-datum-p context))
+ (user-error "Not on a footnote reference"))
+ (unless label (user-error "Cannot edit remotely anonymous footnotes"))
+ (let* ((definition (org-with-wide-buffer
+ (org-footnote-goto-definition label)
+ (backward-char)
+ (org-element-context)))
+ (inline? (eq 'footnote-reference (org-element-type definition)))
+ (contents
+ (org-with-wide-buffer
+ (buffer-substring-no-properties
+ (or (org-element-property :post-affiliated definition)
+ (org-element-property :begin definition))
+ (cond
+ (inline? (1+ (org-element-property :contents-end definition)))
+ ((org-element-property :contents-end definition))
+ (t (goto-char (org-element-property :post-affiliated definition))
+ (line-end-position)))))))
+ (add-text-properties
+ 0
+ (progn (string-match (if inline? "\\`\\[fn:.*?:" "\\`.*?\\]") contents)
+ (match-end 0))
+ '(read-only "Cannot edit footnote label" front-sticky t rear-nonsticky t)
+ contents)
+ (when inline?
+ (let ((l (length contents)))
+ (add-text-properties
+ (1- l) l
+ '(read-only "Cannot edit past footnote reference"
+ front-sticky nil rear-nonsticky nil)
+ contents)))
+ (org-src--edit-element
+ definition
+ (format "*Edit footnote [%s]*" label)
+ (let ((source (current-buffer)))
+ (lambda ()
+ (org-mode)
+ (org-clone-local-variables source)))
+ (lambda ()
+ (if (not inline?) (delete-region (point) (search-forward "]"))
+ (delete-region (point) (search-forward ":" nil t 2))
+ (delete-region (1- (point-max)) (point-max))
+ (when (re-search-forward "\n[ \t]*\n" nil t)
+ (user-error "Inline definitions cannot contain blank lines"))
+ ;; If footnote reference belongs to a table, make sure to
+ ;; 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 "")))))
+ contents
+ 'remote))
+ ;; Report success.
+ t))
+
+(defun org-edit-table.el ()
+ "Edit \"table.el\" table at point.
+\\<org-src-mode-map>
+A new buffer is created and the table is copied into it. Then
+the table is recognized with `table-recognize'. When done
+editing, exit with `\\[org-edit-src-exit]'. The edited text will \
+then replace
+the area in the Org mode buffer.
+
+Throw an error when not at such a table."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'table)
+ (eq (org-element-property :type element) 'table.el)
+ (org-src--on-datum-p element))
+ (user-error "Not in a table.el table"))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) "Table")
+ #'text-mode t)
+ (when (bound-and-true-p flyspell-mode) (flyspell-mode -1))
+ (table-recognize)
+ t))
+
+(defun org-edit-latex-environment ()
+ "Edit LaTeX environment at point.
+\\<org-src-mode-map>
+The LaTeX environment is copied into a new buffer. Major mode is
+set to the one associated to \"latex\" in `org-src-lang-modes',
+or to `latex-mode' if there is none.
+
+When done, exit with `\\[org-edit-src-exit]'. The edited text \
+will then replace
+the LaTeX environment in the Org mode buffer."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'latex-environment)
+ (org-src--on-datum-p element))
+ (user-error "Not in a LaTeX environment"))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment")
+ (org-src--get-lang-mode "latex")
+ t)
+ t))
+
+(defun org-edit-export-block ()
+ "Edit export block at point.
+\\<org-src-mode-map>
+A new buffer is created and the block is copied into it, and the
+buffer is switched into an appropriate major mode. See also
+`org-src-lang-modes'.
+
+When done, exit with `\\[org-edit-src-exit]'. The edited text \
+will then replace
+the area in the Org mode buffer.
+
+Throw an error when not at an export block."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'export-block)
+ (org-src--on-datum-p element))
+ (user-error "Not in an export block"))
+ (let* ((type (downcase (or (org-element-property :type element)
+ ;; Missing export-block type. Fallback
+ ;; to default mode.
+ "fundamental")))
+ (mode (org-src--get-lang-mode type)))
+ (unless (functionp mode) (error "No such language mode: %s" mode))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) type)
+ mode
+ (lambda () (org-escape-code-in-region (point-min) (point-max)))))
+ t))
+
+(defun org-edit-src-code (&optional code edit-buffer-name)
+ "Edit the source or example block at point.
+\\<org-src-mode-map>
+The code is copied to a separate buffer and the appropriate mode
+is turned on. When done, exit with `\\[org-edit-src-exit]'. This \
+will remove the
+original code in the Org buffer, and replace it with the edited
+version. See `org-src-window-setup' to configure the display of
+windows containing the Org buffer and the code buffer.
-(defun org-src-native-tab-command-maybe ()
- "Perform language-specific TAB action.
-Alter code block according to what TAB does in the language major mode."
- (and org-src-tab-acts-natively
- (org-in-src-block-p)
- (not (equal this-command 'org-shifttab))
- (let ((org-src-strip-leading-and-trailing-blank-lines nil))
- (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
+When optional argument CODE is a string, edit it in a dedicated
+buffer instead.
-(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)
+When optional argument EDIT-BUFFER-NAME is non-nil, use it as the
+name of the sub-editing buffer."
+ (interactive)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (unless (and (memq type '(example-block src-block))
+ (org-src--on-datum-p element))
+ (user-error "Not in a source or example block"))
+ (let* ((lang
+ (if (eq type 'src-block) (org-element-property :language element)
+ "example"))
+ (lang-f (and (eq type 'src-block) (org-src--get-lang-mode lang)))
+ (babel-info (and (eq type 'src-block)
+ (org-babel-get-src-block-info 'light)))
+ deactivate-mark)
+ (when (and (eq type 'src-block) (not (functionp lang-f)))
+ (error "No such language mode: %s" lang-f))
+ (org-src--edit-element
+ element
+ (or edit-buffer-name
+ (org-src--construct-edit-buffer-name (buffer-name) lang))
+ lang-f
+ (and (null code)
+ (lambda () (org-escape-code-in-region (point-min) (point-max))))
+ (and code (org-unescape-code-in-string code)))
+ ;; Finalize buffer.
+ (setq-local org-coderef-label-format
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format))
+ (when (eq type 'src-block)
+ (setq-local org-src--babel-info babel-info)
+ (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
+ (when (fboundp edit-prep-func)
+ (funcall edit-prep-func babel-info))))
+ t)))
-(defun org-src-font-lock-fontify-block (lang start end)
- "Fontify code block.
-This function is called by emacs automatic fontification, as long
-as `org-src-fontify-natively' is non-nil. For manual
-fontification of code blocks see `org-src-fontify-block' and
-`org-src-fontify-buffer'"
- (let ((lang-mode (org-src-get-lang-mode lang)))
- (if (fboundp lang-mode)
- (let ((string (buffer-substring-no-properties start end))
- (modified (buffer-modified-p))
- (org-buffer (current-buffer)) pos next)
- (remove-text-properties start end '(face nil))
- (with-current-buffer
- (get-buffer-create
- (concat " org-src-fontification:" (symbol-name lang-mode)))
- ;; Make sure that modification hooks are not inhibited in
- ;; the org-src-fontification buffer in case we're called
- ;; from `jit-lock-function' (Bug#25132).
- (let ((inhibit-modification-hooks nil))
- (delete-region (point-min) (point-max))
- (insert string " ")) ;; so there's a final property change
- (unless (eq major-mode lang-mode) (funcall lang-mode))
- (org-font-lock-ensure)
- (setq pos (point-min))
- (while (setq next (next-single-property-change pos 'face))
- (put-text-property
- (+ start (1- pos)) (1- (+ start next)) 'face
- (get-text-property pos 'face) org-buffer)
- (setq pos next)))
- (add-text-properties
- start end
- '(font-lock-fontified t fontified t font-lock-multiline t))
- (set-buffer-modified-p modified)))))
+(defun org-edit-inline-src-code ()
+ "Edit inline source code at point."
+ (interactive)
+ (let ((context (org-element-context)))
+ (unless (and (eq (org-element-type context) 'inline-src-block)
+ (org-src--on-datum-p context))
+ (user-error "Not on inline source code"))
+ (let* ((lang (org-element-property :language context))
+ (lang-f (org-src--get-lang-mode lang))
+ (babel-info (org-babel-get-src-block-info 'light))
+ deactivate-mark)
+ (unless (functionp lang-f) (error "No such language mode: %s" lang-f))
+ (org-src--edit-element
+ context
+ (org-src--construct-edit-buffer-name (buffer-name) lang)
+ lang-f
+ (lambda ()
+ ;; Inline src blocks are limited to one line.
+ (while (re-search-forward "\n[ \t]*" nil t) (replace-match " "))
+ ;; Trim contents.
+ (goto-char (point-min))
+ (skip-chars-forward " \t")
+ (delete-region (point-min) (point))
+ (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (delete-region (point) (point-max))))
+ ;; Finalize buffer.
+ (setq-local org-src--babel-info babel-info)
+ (setq-local org-src--preserve-indentation t)
+ (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
+ (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info)))
+ ;; Return success.
+ t)))
-(defvar org-src-fontify-natively)
+(defun org-edit-fixed-width-region ()
+ "Edit the fixed-width ASCII drawing at point.
+\\<org-src-mode-map>
+This must be a region where each line starts with a colon
+followed by a space or a newline character.
+
+A new buffer is created and the fixed-width region is copied into
+it, and the buffer is switched into the major mode defined in
+`org-edit-fixed-width-region-mode', which see.
+
+When done, exit with `\\[org-edit-src-exit]'. The edited text \
+will then replace
+the area in the Org mode buffer."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (unless (and (eq (org-element-type element) 'fixed-width)
+ (org-src--on-datum-p element))
+ (user-error "Not in a fixed-width area"))
+ (org-src--edit-element
+ element
+ (org-src--construct-edit-buffer-name (buffer-name) "Fixed Width")
+ org-edit-fixed-width-region-mode
+ (lambda () (while (not (eobp)) (insert ": ") (forward-line))))
+ ;; Return success.
+ t))
-(defun org-src-fontify-block ()
- "Fontify code block at point."
+(defun org-edit-src-abort ()
+ "Abort editing of the src code and return to the Org buffer."
(interactive)
- (save-excursion
- (let ((org-src-fontify-natively t)
- (info (org-edit-src-find-region-and-lang)))
- (font-lock-fontify-region (nth 0 info) (nth 1 info)))))
+ (let (org-src--allow-write-back) (org-edit-src-exit)))
-(defun org-src-fontify-buffer ()
- "Fontify all code blocks in the current buffer."
+(defun org-edit-src-continue (e)
+ "Unconditionally return to buffer editing area under point.
+Throw an error if there is no such buffer."
+ (interactive "e")
+ (mouse-set-point e)
+ (let ((buf (get-char-property (point) 'edit-buffer)))
+ (if buf (org-src-switch-to-buffer buf 'continue)
+ (user-error "No sub-editing buffer for area at point"))))
+
+(defun org-edit-src-save ()
+ "Save parent buffer with current state source-code buffer."
(interactive)
- (org-babel-map-src-blocks nil
- (org-src-fontify-block)))
+ (unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer"))
+ (set-buffer-modified-p nil)
+ (let ((edited-code (org-src--contents-for-write-back))
+ (beg org-src--beg-marker)
+ (end org-src--end-marker)
+ (overlay org-src--overlay))
+ (with-current-buffer (org-src--source-buffer)
+ (undo-boundary)
+ (goto-char beg)
+ ;; Temporarily disable read-only features of OVERLAY in order to
+ ;; insert new contents.
+ (delete-overlay overlay)
+ (delete-region beg end)
+ (let ((expecting-bol (bolp)))
+ (insert edited-code)
+ (when (and expecting-bol (not (bolp))) (insert "\n")))
+ (save-buffer)
+ (move-overlay overlay beg (point))))
+ ;; `write-contents-functions' requires the function to return
+ ;; a non-nil value so that other functions are not called.
+ t)
+
+(defun org-edit-src-exit ()
+ "Kill current sub-editing buffer and return to source buffer."
+ (interactive)
+ (unless (org-src-edit-buffer-p) (error "Not in a sub-editing buffer"))
+ (let* ((beg org-src--beg-marker)
+ (end org-src--end-marker)
+ (write-back org-src--allow-write-back)
+ (remote org-src--remote)
+ (coordinates (and (not remote)
+ (org-src--coordinates (point) 1 (point-max))))
+ (code (and write-back (org-src--contents-for-write-back))))
+ (set-buffer-modified-p nil)
+ ;; Switch to source buffer. Kill sub-editing buffer.
+ (let ((edit-buffer (current-buffer))
+ (source-buffer (marker-buffer beg)))
+ (unless source-buffer (error "Source buffer disappeared. Aborting"))
+ (org-src-switch-to-buffer source-buffer 'exit)
+ (kill-buffer edit-buffer))
+ ;; Insert modified code. Ensure it ends with a newline character.
+ (org-with-wide-buffer
+ (when (and write-back (not (equal (buffer-substring beg end) code)))
+ (undo-boundary)
+ (goto-char beg)
+ (delete-region beg end)
+ (let ((expecting-bol (bolp)))
+ (insert code)
+ (when (and expecting-bol (not (bolp))) (insert "\n")))))
+ ;; If we are to return to source buffer, put point at an
+ ;; appropriate location. In particular, if block is hidden, move
+ ;; to the beginning of the block opening line.
+ (unless remote
+ (goto-char beg)
+ (cond
+ ;; Block is hidden; move at start of block.
+ ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block))
+ (overlays-at (point)))
+ (beginning-of-line 0))
+ (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)
+ (when org-src--saved-temp-window-config
+ (set-window-configuration org-src--saved-temp-window-config)
+ (setq org-src--saved-temp-window-config nil))))
-(defun org-src-get-lang-mode (lang)
- "Return major mode that should be used for LANG.
-LANG is a string, and the returned major mode is a symbol."
- (intern
- (concat
- (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang)))
- (if (symbolp l) (symbol-name l) l))
- "-mode")))
(provide 'org-src)
diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el
index 0c813d03a17..6ebd6da9d0a 100644
--- a/lisp/org/org-table.el
+++ b/lisp/org/org-table.el
@@ -1,4 +1,4 @@
-;;; org-table.el --- The table editor for Org-mode
+;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -19,32 +19,59 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the table editor and spreadsheet for Org-mode.
+;; This file contains the table editor and spreadsheet for Org mode.
;; Watch out: Here we are talking about two different kind of tables.
-;; Most of the code is for the tables created with the Org-mode table editor.
+;; Most of the code is for the tables created with the Org mode table editor.
;; Sometimes, we talk about tables created and edited with the table.el
;; Emacs package. We call the former org-type tables, and the latter
;; table.el-type tables.
;;; Code:
-(eval-when-compile
- (require 'cl))
+(require 'cl-lib)
(require 'org)
-(declare-function org-export-string-as "ox"
- (string backend &optional body-only ext-plist))
-(declare-function aa2u "ext:ascii-art-to-unicode" ())
-(defvar orgtbl-mode) ; defined below
-(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
+(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))
+(declare-function org-element-interpret-data "org-element" (data))
+(declare-function org-element-lineage "org-element"
+ (blob &optional types with-self))
+(declare-function org-element-map "org-element"
+ (data types fun
+ &optional info first-match no-recursion with-affiliated))
+(declare-function org-element-parse-buffer "org-element"
+ (&optional granularity visible-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-type "org-element" (element))
+
+(declare-function org-export-create-backend "ox" (&rest rest) t)
+(declare-function org-export-data-with-backend "ox" (data backend info))
+(declare-function org-export-filter-apply-functions "ox"
+ (filters value info))
+(declare-function org-export-first-sibling-p "ox" (blob info))
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export-get-environment "ox"
+ (&optional backend subtreep ext-plist))
+(declare-function org-export-install-filters "ox" (info))
+(declare-function org-export-table-has-special-column-p "ox" (table))
+(declare-function org-export-table-row-is-special-p "ox" (table-row info))
+
+(declare-function calc-eval "calc" (str &optional separator &rest args))
+
(defvar constants-unit-system)
+(defvar org-element-use-cache)
+(defvar org-export-filters-alist)
(defvar org-table-follow-field-mode)
+(defvar orgtbl-mode) ; defined below
+(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
+(defvar sort-fold-case)
(defvar orgtbl-after-send-table-hook nil
"Hook for functions attaching to `C-c C-c', if the table is sent.
@@ -52,19 +79,19 @@ This can be used to add additional functionality after the table is sent
to the receiver position, otherwise, if table is not sent, the functions
are not run.")
-(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ")
+(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ")
-(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
+(defcustom orgtbl-optimized t
"Non-nil means use the optimized table editor version for `orgtbl-mode'.
+
In the optimized version, the table editor takes over all simple keys that
normally just insert a character. In tables, the characters are inserted
in a way to minimize disturbing the table structure (i.e. in overwrite mode
for empty fields). Outside tables, the correct binding of the keys is
restored.
-The default for this option is t if the optimized version is also used in
-Org-mode. See the variable `org-enable-table-editor' for details. Changing
-this variable requires a restart of Emacs to become effective."
+Changing this variable requires a restart of Emacs to become
+effective."
:group 'org-table
:type 'boolean)
@@ -118,7 +145,7 @@ table, obtained by prompting the user."
(string :tag "Format"))))
(defgroup org-table-settings nil
- "Settings for tables in Org-mode."
+ "Settings for tables in Org mode."
:tag "Org Table Settings"
:group 'org-table)
@@ -167,13 +194,13 @@ alignment to the right border applies."
:type 'number)
(defgroup org-table-editing nil
- "Behavior of tables during editing in Org-mode."
+ "Behavior of tables during editing in Org mode."
:tag "Org Table Editing"
:group 'org-table)
(defcustom org-table-automatic-realign t
"Non-nil means automatically re-align table when pressing TAB or RETURN.
-When nil, aligning is only done with \\[org-table-align], or after column
+When nil, aligning is only done with `\\[org-table-align]', or after column
removal/insertion."
:group 'org-table-editing
:type 'boolean)
@@ -181,8 +208,7 @@ removal/insertion."
(defcustom org-table-auto-blank-field t
"Non-nil means automatically blank table field when starting to type into it.
This only happens when typing immediately after a field motion
-command (TAB, S-TAB or RET).
-Only relevant when `org-enable-table-editor' is equal to `optimized'."
+command (TAB, S-TAB or RET)."
:group 'org-table-editing
:type 'boolean)
@@ -219,12 +245,12 @@ this line."
:type 'boolean)
(defgroup org-table-calculation nil
- "Options concerning tables in Org-mode."
+ "Options concerning tables in Org mode."
:tag "Org Table Calculation"
:group 'org-table)
(defcustom org-table-use-standard-references 'from
- "Should org-mode work with table references like B3 instead of @3$2?
+ "Non-nil means using table references like B3 instead of @3$2.
Possible values are:
nil never use them
from accept as input, do not present for editing
@@ -236,9 +262,15 @@ t accept as input and present for editing"
(const :tag "Convert user input, don't offer during editing" from)))
(defcustom org-table-copy-increment t
- "Non-nil means increment when copying current field with \\[org-table-copy-down]."
+ "Non-nil means increment when copying current field with \
+`\\[org-table-copy-down]'."
:group 'org-table-calculation
- :type 'boolean)
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "Use the difference between the current and the above fields" t)
+ (integer :tag "Use a number" 1)
+ (const :tag "Don't increment the value when copying a field" nil)))
(defcustom org-calc-default-modes
'(calc-internal-prec 12
@@ -251,23 +283,35 @@ t accept as input and present for editing"
)
"List with Calc mode settings for use in `calc-eval' for table formulas.
The list must contain alternating symbols (Calc modes variables and values).
-Don't remove any of the default settings, just change the values. Org-mode
+Don't remove any of the default settings, just change the values. Org mode
relies on the variables to be present in the list."
:group 'org-table-calculation
:type 'plist)
(defcustom org-table-duration-custom-format 'hours
"Format for the output of calc computations like $1+$2;t.
-The default value is 'hours, and will output the results as a
-number of hours. Other allowed values are 'seconds, 'minutes and
-'days, and the output will be a fraction of seconds, minutes or
-days."
+The default value is `hours', and will output the results as a
+number of hours. Other allowed values are `seconds', `minutes' and
+`days', and the output will be a fraction of seconds, minutes or
+days. `hh:mm' selects to use hours and minutes, ignoring seconds.
+The `U' flag in a table formula will select this specific format for
+a single formula."
:group 'org-table-calculation
:version "24.1"
:type '(choice (symbol :tag "Seconds" 'seconds)
(symbol :tag "Minutes" 'minutes)
(symbol :tag "Hours " 'hours)
- (symbol :tag "Days " 'days)))
+ (symbol :tag "Days " 'days)
+ (symbol :tag "HH:MM " 'hh:mm)))
+
+(defcustom org-table-duration-hour-zero-padding t
+ "Non-nil means hours in table duration computations should be zero-padded.
+So this is about 08:32:34 versus 8:33:34."
+ :group 'org-table-calculation
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-table-formula-field-format "%s"
"Format for fields which contain the result of a formula.
@@ -285,7 +329,7 @@ which should be evaluated as described in the manual and in the documentation
string of the command `org-table-eval-formula'. This feature requires the
Emacs calc package.
When this variable is nil, formula calculation is only available through
-the command \\[org-table-eval-formula]."
+the command `\\[org-table-eval-formula]'."
:group 'org-table-calculation
:type 'boolean)
@@ -317,15 +361,12 @@ Constants can also be defined on a per-file basis using a line like
(defcustom org-table-allow-automatic-line-recalculation t
"Non-nil means lines marked with |#| or |*| will be recomputed automatically.
-Automatically means when TAB or RET or C-c C-c are pressed in the line."
+\\<org-mode-map>\
+Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \
+are pressed in the line."
:group 'org-table-calculation
:type 'boolean)
-(defcustom org-table-error-on-row-ref-crossing-hline t
- "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'."
- :group 'org-table
- :type 'boolean)
-
(defcustom org-table-relative-ref-may-cross-hline t
"Non-nil means relative formula references may cross hlines.
Here are the allowed values:
@@ -345,8 +386,20 @@ portability of tables."
(const :tag "Stick to hline" nil)
(const :tag "Error on attempt to cross" error)))
+(defcustom org-table-formula-create-columns nil
+ "Non-nil means that evaluation of a field formula can add new
+columns if an out-of-bounds field is being set."
+ :group 'org-table-calculation
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "Setting an out-of-bounds field generates an error (default)" nil)
+ (const :tag "Setting an out-of-bounds field silently adds columns as needed" t)
+ (const :tag "Setting an out-of-bounds field adds columns as needed, but issues a warning message" warn)
+ (const :tag "When setting an out-of-bounds field, the user is prompted" prompt)))
+
(defgroup org-table-import-export nil
- "Options concerning table import and export in Org-mode."
+ "Options concerning table import and export in Org mode."
:tag "Org Table Import Export"
:group 'org-table)
@@ -359,38 +412,73 @@ available parameters."
:group 'org-table-import-export
:type 'string)
+(defcustom org-table-convert-region-max-lines 999
+ "Max lines that `org-table-convert-region' will attempt to process.
+
+The function can be slow on larger regions; this safety feature
+prevents it from hanging emacs."
+ :group 'org-table-import-export
+ :type 'integer
+ :version "26.1"
+ :package-version '(Org . "8.3"))
+
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
- "Detects a table line marked for automatic recalculation.")
+ "Regexp matching a line marked for automatic recalculation.")
+
(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
- "Detects a table line marked for automatic recalculation.")
+ "Regexp matching a line marked for recalculation.")
+
(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
- "Detects a table line marked for automatic recalculation.")
+ "Regexp matching a line marked for calculation.")
+
(defconst org-table-border-regexp "^[ \t]*[^| \t]"
- "Searching from within a table (any type) this finds the first line outside the table.")
+ "Regexp matching any line outside an Org table.")
+
(defvar org-table-last-highlighted-reference nil)
+
(defvar org-table-formula-history nil)
(defvar org-table-column-names nil
- "Alist with column names, derived from the `!' line.")
+ "Alist with column names, derived from the `!' line.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-column-name-regexp nil
- "Regular expression matching the current column names.")
+ "Regular expression matching the current column names.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-local-parameters nil
- "Alist with parameter names, derived from the `$' line.")
+ "Alist with parameter names, derived from the `$' line.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-named-field-locations nil
- "Alist with locations of named fields.")
+ "Alist with locations of named fields.
+Associations follow the pattern (NAME LINE COLUMN) where
+ NAME is the name of the field as a string,
+ LINE is the number of lines from the beginning of the table,
+ COLUMN is the column of the field, as an integer.
+This variable is initialized with `org-table-analyze'.")
(defvar org-table-current-line-types nil
- "Table row types, non-nil only for the duration of a command.")
-(defvar org-table-current-begin-line nil
- "Table begin line, non-nil only for the duration of a command.")
+ "Table row types in current table.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-current-begin-pos nil
- "Table begin position, non-nil only for the duration of a command.")
+ "Current table begin position, as a marker.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-current-ncol nil
- "Number of columns in table, non-nil only for the duration of a command.")
+ "Number of columns in current table.
+This variable is initialized with `org-table-analyze'.")
+
(defvar org-table-dlines nil
- "Vector of data line line numbers in the current table.")
+ "Vector of data line line numbers in the current table.
+Line numbers are counted from the beginning of the table. This
+variable is initialized with `org-table-analyze'.")
+
(defvar org-table-hlines nil
- "Vector of hline line numbers in the current table.")
+ "Vector of hline line numbers in the current table.
+Line numbers are counted from the beginning of the table. This
+variable is initialized with `org-table-analyze'.")
(defconst org-table-range-regexp
"@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
@@ -404,85 +492,33 @@ available parameters."
"\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
"Match a range for reference display.")
-(defun org-table-colgroup-line-p (line)
- "Is this a table line colgroup information?"
- (save-match-data
- (and (string-match "[<>]\\|&[lg]t;" line)
- (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'"
- line)
- (not (delq
- nil
- (mapcar
- (lambda (s)
- (not (member s '("" "<" ">" "<>" "&lt;" "&gt;" "&lt;&gt;"))))
- (org-split-string (match-string 1 line) "[ \t]*|[ \t]*")))))))
-
-(defun org-table-cookie-line-p (line)
- "Is this a table line with only alignment/width cookies?"
- (save-match-data
- (and (string-match "[<>]\\|&[lg]t;" line)
- (or (string-match
- "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line)
- (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line))
- (not (delq nil (mapcar
- (lambda (s)
- (not (or (equal s "")
- (string-match
- "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s)
- (string-match
- "\\`&lt;\\([lrc]?[0-9]+\\|[lrc]\\)&gt;\\'"
- s))))
- (org-split-string (match-string 1 line)
- "[ \t]*|[ \t]*")))))))
-
-(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
-(defun org-table-clean-before-export (lines &optional maybe-quoted)
- "Check if the table has a marking column.
-If yes remove the column and the special lines."
- (let ((special (if maybe-quoted
- "^[ \t]*| *\\\\?[#!$*_^/ ] *|"
- "^[ \t]*| *[#!$*_^/ ] *|"))
- (ignore (if maybe-quoted
- "^[ \t]*| *\\\\?[!$_^/] *|"
- "^[ \t]*| *[!$_^/] *|")))
- (setq org-table-clean-did-remove-column
- (not (memq nil
- (mapcar
- (lambda (line)
- (or (string-match org-table-hline-regexp line)
- (string-match special line)))
- lines))))
- (delq nil
- (mapcar
- (lambda (line)
- (cond
- ((or (org-table-colgroup-line-p line) ;; colgroup info
- (org-table-cookie-line-p line) ;; formatting cookies
- (and org-table-clean-did-remove-column
- (string-match ignore line))) ;; non-exportable data
- nil)
- ((and org-table-clean-did-remove-column
- (or (string-match "^\\([ \t]*\\)|-+\\+" line)
- (string-match "^\\([ \t]*\\)|[^|]*|" line)))
- ;; remove the first column
- (replace-match "\\1|" t nil line))
- (t line)))
- lines))))
-
(defconst org-table-translate-regexp
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
"Match a reference that needs translation, for reference display.")
+(defmacro org-table-save-field (&rest body)
+ "Save current field; execute BODY; restore field.
+Field is restored even in case of abnormal exit."
+ (declare (debug (body)))
+ (org-with-gensyms (line column)
+ `(let ((,line (copy-marker (line-beginning-position)))
+ (,column (org-table-current-column)))
+ (unwind-protect
+ (progn ,@body)
+ (goto-char ,line)
+ (org-table-goto-column ,column)
+ (set-marker ,line nil)))))
+
;;;###autoload
(defun org-table-create-with-table.el ()
"Use the table.el package to insert a new table.
-If there is already a table at point, convert between Org-mode tables
+If there is already a table at point, convert between Org tables
and table.el tables."
(interactive)
(require 'table)
(cond
((org-at-table.el-p)
- (if (y-or-n-p "Convert table to Org-mode table? ")
+ (if (y-or-n-p "Convert table to Org table? ")
(org-table-convert)))
((org-at-table-p)
(when (y-or-n-p "Convert table to table.el table? ")
@@ -526,7 +562,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
(beginning-of-line 1)
(newline))
;; (mapcar (lambda (x) (insert line)) (make-list rows t))
- (dotimes (i rows) (insert line))
+ (dotimes (_ rows) (insert line))
(goto-char pos)
(if (> rows 1)
;; Insert a hline after the first row.
@@ -539,15 +575,18 @@ SIZE is a string Columns x Rows like for example \"3x2\"."
;;;###autoload
(defun org-table-convert-region (beg0 end0 &optional separator)
"Convert region to a table.
+
The region goes from BEG0 to END0, but these borders will be moved
slightly, to make sure a beginning of line in the first line is included.
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
-integer When a number, use that many spaces as field 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
nil When nil, 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
@@ -557,45 +596,52 @@ nil When nil, the command tries to be smart and figure out the
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
re)
- (goto-char beg)
- (beginning-of-line 1)
- (setq beg (point-marker))
- (goto-char end)
- (if (bolp) (backward-char 1) (end-of-line 1))
- (setq end (point-marker))
- ;; Get the right field separator
- (unless separator
+ (if (> (count-lines beg end) org-table-convert-region-max-lines)
+ (user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting"
+ org-table-convert-region-max-lines)
+ (if (equal separator '(64))
+ (setq separator (read-regexp "Regexp for field separator")))
+ (goto-char beg)
+ (beginning-of-line 1)
+ (setq beg (point-marker))
+ (goto-char end)
+ (if (bolp) (backward-char 1) (end-of-line 1))
+ (setq end (point-marker))
+ ;; Get the right field separator
+ (unless separator
+ (goto-char beg)
+ (setq separator
+ (cond
+ ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
+ ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
+ (t 1))))
(goto-char beg)
- (setq separator
+ (if (equal separator '(4))
+ (while (< (point) end)
+ ;; parse the csv stuff
(cond
- ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
- ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
- (t 1))))
- (goto-char beg)
- (if (equal separator '(4))
- (while (< (point) end)
- ;; parse the csv stuff
- (cond
- ((looking-at "^") (insert "| "))
- ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
- ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
- (replace-match "\\1")
- (if (looking-at "\"") (insert "\"")))
- ((looking-at "[^,\n]+") (goto-char (match-end 0)))
- ((looking-at "[ \t]*,") (replace-match " | "))
- (t (beginning-of-line 2))))
- (setq re (cond
- ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
- ((equal separator '(16)) "^\\|\t")
- ((integerp separator)
- (if (< separator 1)
- (user-error "Number of spaces in separator must be >= 1")
- (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
- (t (error "This should not happen"))))
- (while (re-search-forward re end t)
- (replace-match "| " t t)))
- (goto-char beg)
- (org-table-align)))
+ ((looking-at "^") (insert "| "))
+ ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
+ ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
+ (replace-match "\\1")
+ (if (looking-at "\"") (insert "\"")))
+ ((looking-at "[^,\n]+") (goto-char (match-end 0)))
+ ((looking-at "[ \t]*,") (replace-match " | "))
+ (t (beginning-of-line 2))))
+ (setq re (cond
+ ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
+ ((equal separator '(16)) "^\\|\t")
+ ((integerp separator)
+ (if (< separator 1)
+ (user-error "Number of spaces in separator must be >= 1")
+ (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
+ ((stringp separator)
+ (format "^ *\\|%s" separator))
+ (t (error "This should not happen"))))
+ (while (re-search-forward re end t)
+ (replace-match "| " t t)))
+ (goto-char beg)
+ (org-table-align))))
;;;###autoload
(defun org-table-import (file arg)
@@ -611,8 +657,6 @@ are found, lines will be split on whitespace into fields."
(org-table-convert-region beg (+ (point) (- (point-max) pm)) arg)))
-(defvar org-table-last-alignment)
-(defvar org-table-last-column-widths)
;;;###autoload
(defun org-table-export (&optional file format)
"Export table to a file, with configurable format.
@@ -630,77 +674,61 @@ extension of the given file name, and finally on the variable
`org-table-export-default-format'."
(interactive)
(unless (org-at-table-p) (user-error "No table at point"))
- (org-table-align) ;; make sure we have everything we need
- (let* ((beg (org-table-begin))
- (end (org-table-end))
- (txt (buffer-substring-no-properties beg end))
- (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t)))
- (formats '("orgtbl-to-tsv" "orgtbl-to-csv"
- "orgtbl-to-latex" "orgtbl-to-html"
- "orgtbl-to-generic" "orgtbl-to-texinfo"
- "orgtbl-to-orgtbl"))
- (format (or format
- (org-entry-get beg "TABLE_EXPORT_FORMAT" t)))
- buf deffmt-readable fileext)
+ (org-table-align) ; Make sure we have everything we need.
+ (let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t))))
(unless file
(setq file (read-file-name "Export table to: "))
(unless (or (not (file-exists-p file))
(y-or-n-p (format "Overwrite file %s? " file)))
(user-error "File not written")))
- (if (file-directory-p file)
- (user-error "This is a directory path, not a file"))
- (if (and (buffer-file-name)
- (equal (file-truename file)
- (file-truename (buffer-file-name))))
- (user-error "Please specify a file name that is different from current"))
- (setq fileext (concat (file-name-extension file) "$"))
- (unless format
- (setq deffmt-readable
- (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats)))
- org-table-export-default-format))
- (while (string-match "\t" deffmt-readable)
- (setq deffmt-readable (replace-match "\\t" t t deffmt-readable)))
- (while (string-match "\n" deffmt-readable)
- (setq deffmt-readable (replace-match "\\n" t t deffmt-readable)))
- (setq format (org-completing-read "Format: " formats nil nil deffmt-readable)))
- (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
- (let* ((transform (intern (match-string 1 format)))
- (params (if (match-end 2)
- (read (concat "(" (match-string 2 format) ")"))))
- (skip (plist-get params :skip))
- (skipcols (plist-get params :skipcols))
- (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*")))
- (lines (org-table-clean-before-export lines))
- (i0 (if org-table-clean-did-remove-column 2 1))
- (table (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-remove-by-index
- (org-split-string (org-trim x) "\\s-*|\\s-*")
- skipcols i0)))
- lines))
- (fun (if (= i0 2) 'cdr 'identity))
- (org-table-last-alignment
- (org-remove-by-index (funcall fun org-table-last-alignment)
- skipcols i0))
- (org-table-last-column-widths
- (org-remove-by-index (funcall fun org-table-last-column-widths)
- skipcols i0)))
-
- (unless (fboundp transform)
- (user-error "No such transformation function %s" transform))
- (setq txt (funcall transform table params))
-
- (with-current-buffer (find-file-noselect file)
- (setq buf (current-buffer))
- (erase-buffer)
- (fundamental-mode)
- (insert txt "\n")
- (save-buffer))
- (kill-buffer buf)
- (message "Export done."))
- (user-error "TABLE_EXPORT_FORMAT invalid"))))
+ (when (file-directory-p file)
+ (user-error "This is a directory path, not a file"))
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (file-equal-p
+ (file-truename file)
+ (file-truename (buffer-file-name (buffer-base-buffer)))))
+ (user-error "Please specify a file name that is different from current"))
+ (let ((fileext (concat (file-name-extension file) "$"))
+ (format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t))))
+ (unless format
+ (let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex"
+ "orgtbl-to-html" "orgtbl-to-generic"
+ "orgtbl-to-texinfo" "orgtbl-to-orgtbl"
+ "orgtbl-to-unicode"))
+ (deffmt-readable
+ (replace-regexp-in-string
+ "\t" "\\t"
+ (replace-regexp-in-string
+ "\n" "\\n"
+ (or (car (delq nil
+ (mapcar
+ (lambda (f)
+ (and (string-match-p fileext f) f))
+ formats)))
+ org-table-export-default-format)
+ t t) t t)))
+ (setq format
+ (org-completing-read
+ "Format: " formats nil nil deffmt-readable))))
+ (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
+ (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)))))
+ (unless (fboundp transform)
+ (user-error "No such transformation function %s" transform))
+ (let (buf)
+ (with-current-buffer (find-file-noselect file)
+ (setq buf (current-buffer))
+ (erase-buffer)
+ (fundamental-mode)
+ (insert (funcall transform table params) "\n")
+ (save-buffer))
+ (kill-buffer buf))
+ (message "Export done."))
+ (user-error "TABLE_EXPORT_FORMAT invalid")))))
(defvar org-table-aligned-begin-marker (make-marker)
"Marker at the beginning of the table last aligned.
@@ -714,13 +742,11 @@ This is being used to correctly align a single field after TAB or RET.")
(defvar org-table-last-column-widths nil
"List of max width of fields in each column.
This is being used to correctly align a single field after TAB or RET.")
-(defvar org-table-formula-debug nil
+(defvar-local org-table-formula-debug nil
"Non-nil means debug table formulas.
When nil, simply write \"#ERROR\" in corrupted fields.")
-(make-variable-buffer-local 'org-table-formula-debug)
-(defvar org-table-overlay-coordinates nil
+(defvar-local org-table-overlay-coordinates nil
"Overlay coordinates after each align of a table.")
-(make-variable-buffer-local 'org-table-overlay-coordinates)
(defvar org-last-recalc-line nil)
(defvar org-table-do-narrow t) ; for dynamic scoping
@@ -731,216 +757,198 @@ When nil, simply write \"#ERROR\" in corrupted fields.")
(defun org-table-align ()
"Align the table at point by aligning all vertical bars."
(interactive)
- (let* (
- ;; Limits of table
- (beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos (org-table-current-column))
- (winstart (window-start))
- (winstartline (org-current-line (min winstart (1- (point-max)))))
- lines (new "") lengths l typenums ty fields maxfields i
- column
- (indent "") cnt frac
- rfmt hfmt
- (spaces '(1 . 1))
- (sp1 (car spaces))
- (sp2 (cdr spaces))
- (rfmt1 (concat
- (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|"))
- (hfmt1 (concat
- (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+"))
- emptystrings links dates emph raise narrow
- falign falign1 fmax f1 len c e space)
- (untabify beg end)
- (remove-text-properties beg end '(org-cwidth t org-dwidth t display t))
- ;; Check if we have links or dates
- (goto-char beg)
- (setq links (re-search-forward org-bracket-link-regexp end t))
- (goto-char beg)
- (setq emph (and org-hide-emphasis-markers
- (re-search-forward org-emph-re end t)))
- (goto-char beg)
- (setq raise (and org-use-sub-superscripts
- (re-search-forward org-match-substring-regexp end t)))
- (goto-char beg)
- (setq dates (and org-display-custom-times
- (re-search-forward org-ts-regexp-both end t)))
- ;; Make sure the link properties are right
- (when links (goto-char beg) (while (org-activate-bracket-links end)))
- ;; Make sure the date properties are right
- (when dates (goto-char beg) (while (org-activate-dates end)))
- (when emph (goto-char beg) (while (org-do-emphasis-faces end)))
- (when raise (goto-char beg) (while (org-raise-scripts end)))
-
- ;; Check if we are narrowing any columns
- (goto-char beg)
- (setq narrow (and org-table-do-narrow
- org-format-transports-properties-p
- (re-search-forward "<[lrc]?[0-9]+>" end t)))
- (goto-char beg)
- (setq falign (re-search-forward "<[lrc][0-9]*>" end t))
- (goto-char beg)
- ;; Get the rows
- (setq lines (org-split-string
- (buffer-substring beg end) "\n"))
- ;; Store the indentation of the first line
- (if (string-match "^ *" (car lines))
- (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ )))
- ;; Mark the hlines by setting the corresponding element to nil
- ;; At the same time, we remove trailing space.
- (setq lines (mapcar (lambda (l)
- (if (string-match "^ *|-" l)
- nil
- (if (string-match "[ \t]+$" l)
- (substring l 0 (match-beginning 0))
- l)))
- lines))
- ;; Get the data fields by splitting the lines.
- (setq fields (mapcar
- (lambda (l)
- (org-split-string l " *| *"))
- (delq nil (copy-sequence lines))))
- ;; How many fields in the longest line?
- (condition-case nil
- (setq maxfields (apply 'max (mapcar 'length fields)))
- (error
- (kill-region beg end)
- (org-table-create org-table-default-size)
- (user-error "Empty table - created default table")))
- ;; A list of empty strings to fill any short rows on output
- (setq emptystrings (make-list maxfields ""))
- ;; Check for special formatting.
- (setq i -1)
- (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns
- (setq column (mapcar (lambda (x) (or (nth i x) "")) fields))
- ;; Check if there is an explicit width specified
- (setq fmax nil)
- (when (or narrow falign)
- (setq c column fmax nil falign1 nil)
- (while c
- (setq e (pop c))
- (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e))
- (if (match-end 1) (setq falign1 (match-string 1 e)))
- (if (and org-table-do-narrow (match-end 2))
- (setq fmax (string-to-number (match-string 2 e)) c nil))))
- ;; Find fields that are wider than fmax, and shorten them
- (when fmax
- (loop for xx in column do
- (when (and (stringp xx)
- (> (org-string-width xx) fmax))
- (org-add-props xx nil
- 'help-echo
- (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx))))
- (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax)))
- (unless (> f1 1)
- (user-error "Cannot narrow field starting with wide link \"%s\""
- (match-string 0 xx)))
- (add-text-properties f1 (length xx) (list 'org-cwidth t) xx)
- (add-text-properties (- f1 2) f1
- (list 'display org-narrow-column-arrow)
- xx)))))
- ;; Get the maximum width for each column
- (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column))
- lengths)
- ;; Get the fraction of numbers, to decide about alignment of the column
- (if falign1
- (push (equal (downcase falign1) "r") typenums)
- (setq cnt 0 frac 0.0)
- (loop for x in column do
- (if (equal x "")
- nil
- (setq frac ( / (+ (* frac cnt)
- (if (string-match org-table-number-regexp x) 1 0))
- (setq cnt (1+ cnt))))))
- (push (>= frac org-table-number-fraction) typenums)))
- (setq lengths (nreverse lengths) typenums (nreverse typenums))
-
- ;; Store the alignment of this table, for later editing of single fields
- (setq org-table-last-alignment typenums
- org-table-last-column-widths lengths)
-
- ;; With invisible characters, `format' does not get the field width right
- ;; So we need to make these fields wide by hand.
- (when (or links emph raise)
- (loop for i from 0 upto (1- maxfields) do
- (setq len (nth i lengths))
- (loop for j from 0 upto (1- (length fields)) do
- (setq c (nthcdr i (car (nthcdr j fields))))
- (if (and (stringp (car c))
- (or (text-property-any 0 (length (car c))
- 'invisible 'org-link (car c))
- (text-property-any 0 (length (car c))
- 'org-dwidth t (car c)))
- (< (org-string-width (car c)) len))
- (progn
- (setq space (make-string (- len (org-string-width (car c))) ?\ ))
- (setcar c (if (nth i typenums)
- (concat space (car c))
- (concat (car c) space))))))))
-
- ;; Compute the formats needed for output of the table
- (setq rfmt (concat indent "|") hfmt (concat indent "|"))
- (while (setq l (pop lengths))
- (setq ty (if (pop typenums) "" "-")) ; number types flushright
- (setq rfmt (concat rfmt (format rfmt1 ty l))
- hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))
- (setq rfmt (concat rfmt "\n")
- hfmt (concat (substring hfmt 0 -1) "|\n"))
-
- (setq new (mapconcat
- (lambda (l)
- (if l (apply 'format rfmt
- (append (pop fields) emptystrings))
- hfmt))
- lines ""))
- (move-marker org-table-aligned-begin-marker (point))
- (insert new)
- ;; Replace the old one
- (delete-region (point) end)
- (move-marker end nil)
- (move-marker org-table-aligned-end-marker (point))
- (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
- (goto-char org-table-aligned-begin-marker)
- (while (org-hide-wide-columns org-table-aligned-end-marker)))
- ;; Try to move to the old location
- (org-goto-line winstartline)
- (setq winstart (point-at-bol))
- (org-goto-line linepos)
- (when (eq (window-buffer (selected-window)) (current-buffer))
- (set-window-start (selected-window) winstart 'noforce))
- (org-table-goto-column colpos)
- (and org-table-overlay-coordinates (org-table-overlay-coordinates))
- (setq org-table-may-need-update nil)
- ))
+ (let* ((beg (org-table-begin))
+ (end (copy-marker (org-table-end))))
+ (org-table-save-field
+ ;; Make sure invisible characters in the table are at the right
+ ;; place since column widths take them into account.
+ (font-lock-fontify-region beg end)
+ (move-marker org-table-aligned-begin-marker beg)
+ (move-marker org-table-aligned-end-marker end)
+ (goto-char beg)
+ (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
+ ;; Table's rows. Separators are replaced by nil. Trailing
+ ;; spaces are also removed.
+ (lines (mapcar (lambda (l)
+ (and (not (string-match-p "\\`[ \t]*|-" l))
+ (let ((l (org-trim l)))
+ (remove-text-properties
+ 0 (length l) '(display t org-cwidth t) l)
+ l)))
+ (org-split-string (buffer-substring beg end) "\n")))
+ ;; Get the data fields by splitting the lines.
+ (fields (mapcar (lambda (l) (org-split-string l " *| *"))
+ (remq nil lines)))
+ ;; Compute number of fields in the longest line. If the
+ ;; table contains no field, create a default table.
+ (maxfields (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")))
+ ;; A list of empty strings to fill any short rows on output.
+ (emptycells (make-list maxfields ""))
+ lengths typenums)
+ ;; Check for special formatting.
+ (dotimes (i maxfields)
+ (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
+ fmax falign)
+ ;; Look for an explicit width or alignment.
+ (when (save-excursion
+ (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
+ (and org-table-do-narrow
+ (re-search-forward
+ "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
+ (catch :exit
+ (dolist (cell column)
+ (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
+ (when (match-end 1) (setq falign (match-string 1 cell)))
+ (when (and org-table-do-narrow (match-end 2))
+ (setq fmax (string-to-number (match-string 2 cell))))
+ (when (or falign fmax) (throw :exit nil)))))
+ ;; Find fields that are wider than FMAX, and shorten them.
+ (when fmax
+ (dolist (x column)
+ (when (> (string-width x) fmax)
+ (org-add-props x nil
+ 'help-echo
+ (concat
+ "Clipped table field, use `\\[org-table-edit-field]' to \
+edit. Full value is:\n"
+ (substring-no-properties x)))
+ (let ((l (length x))
+ (f1 (min fmax
+ (or (string-match org-bracket-link-regexp x)
+ fmax)))
+ (f2 1))
+ (unless (> f1 1)
+ (user-error
+ "Cannot narrow field starting with wide link \"%s\""
+ (match-string 0 x)))
+ (if (= (org-string-width x) l) (setq f2 f1)
+ (setq f2 1)
+ (while (< (org-string-width (substring x 0 f2)) f1)
+ (cl-incf f2)))
+ (add-text-properties f2 l (list 'org-cwidth t) x)
+ (add-text-properties
+ (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
+ (- f2 2))
+ f2
+ (list 'display org-narrow-column-arrow)
+ x))))))
+ ;; Get the maximum width for each column
+ (push (or fmax (apply #'max 1 (mapcar #'org-string-width column)))
+ lengths)
+ ;; Get the fraction of numbers among non-empty cells to
+ ;; decide about alignment of the column.
+ (if falign (push (equal (downcase falign) "r") typenums)
+ (let ((cnt 0)
+ (frac 0.0))
+ (dolist (x column)
+ (unless (equal x "")
+ (setq frac
+ (/ (+ (* frac cnt)
+ (if (string-match-p org-table-number-regexp x)
+ 1
+ 0))
+ (cl-incf cnt)))))
+ (push (>= frac org-table-number-fraction) typenums)))))
+ (setq lengths (nreverse lengths))
+ (setq typenums (nreverse typenums))
+ ;; Store alignment of this table, for later editing of single
+ ;; fields.
+ (setq org-table-last-alignment typenums)
+ (setq org-table-last-column-widths lengths)
+ ;; With invisible characters, `format' does not get the field
+ ;; width right So we need to make these fields wide by hand.
+ ;; Invisible characters may be introduced by fontified links,
+ ;; emphasis, macros or sub/superscripts.
+ (when (or (text-property-any beg end 'invisible 'org-link)
+ (text-property-any beg end 'invisible t))
+ (dotimes (i maxfields)
+ (let ((len (nth i lengths)))
+ (dotimes (j (length fields))
+ (let* ((c (nthcdr i (nth j fields)))
+ (cell (car c)))
+ (when (and
+ (stringp cell)
+ (let ((l (length cell)))
+ (or (text-property-any 0 l 'invisible 'org-link cell)
+ (text-property-any beg end 'invisible t)))
+ (< (org-string-width cell) len))
+ (let ((s (make-string (- len (org-string-width cell)) ?\s)))
+ (setcar c (if (nth i typenums) (concat s cell)
+ (concat cell s))))))))))
+
+ ;; Compute the formats needed for output of the table.
+ (let ((hfmt (concat indent "|"))
+ (rfmt (concat indent "|"))
+ (rfmt1 " %%%s%ds |")
+ (hfmt1 "-%s-+"))
+ (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
+ (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
+ (setq rfmt (concat rfmt (format rfmt1 ty l)))
+ (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
+ ;; Replace modified lines only. Check not only contents, but
+ ;; also columns' width.
+ (dolist (l lines)
+ (let ((line
+ (if l (apply #'format rfmt (append (pop fields) emptycells))
+ hfmt))
+ (previous (buffer-substring (point) (line-end-position))))
+ (if (and (equal previous line)
+ (let ((a 0)
+ (b 0))
+ (while (and (progn
+ (setq a (next-single-property-change
+ a 'org-cwidth previous))
+ (setq b (next-single-property-change
+ b 'org-cwidth line)))
+ (eq a b)))
+ (eq a b)))
+ (forward-line)
+ (insert line "\n")
+ (delete-region (point) (line-beginning-position 2))))))
+ (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
+ (goto-char org-table-aligned-begin-marker)
+ (while (org-hide-wide-columns org-table-aligned-end-marker)))
+ (set-marker end nil)
+ (when org-table-overlay-coordinates (org-table-overlay-coordinates))
+ (setq org-table-may-need-update nil)))))
;;;###autoload
(defun org-table-begin (&optional table-type)
"Find the beginning of the table and return its position.
-With argument TABLE-TYPE, go to the beginning of a table.el-type table."
- (save-excursion
- (if (not (re-search-backward
- (if table-type org-table-any-border-regexp
- org-table-border-regexp)
- nil t))
- (progn (goto-char (point-min)) (point))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (point))))
+With a non-nil optional argument TABLE-TYPE, return the beginning
+of a table.el-type table. This function assumes point is on
+a table."
+ (cond (table-type
+ (org-element-property :post-affiliated (org-element-at-point)))
+ ((save-excursion
+ (and (re-search-backward org-table-border-regexp nil t)
+ (line-beginning-position 2))))
+ (t (point-min))))
;;;###autoload
(defun org-table-end (&optional table-type)
"Find the end of the table and return its position.
-With argument TABLE-TYPE, go to the end of a table.el-type table."
+With a non-nil optional argument TABLE-TYPE, return the end of
+a table.el-type table. This function assumes point is on
+a table."
(save-excursion
- (if (not (re-search-forward
- (if table-type org-table-any-border-regexp
- org-table-border-regexp)
- nil t))
- (goto-char (point-max))
- (goto-char (match-beginning 0)))
- (point-marker)))
+ (cond (table-type
+ (goto-char (org-element-property :end (org-element-at-point)))
+ (skip-chars-backward " \t\n")
+ (line-beginning-position 2))
+ ((re-search-forward org-table-border-regexp nil t)
+ (match-beginning 0))
+ ;; When the line right after the table is the last line in
+ ;; the buffer with trailing spaces but no final newline
+ ;; character, be sure to catch the correct ending at its
+ ;; beginning. In any other case, ending is expected to be
+ ;; at point max.
+ (t (goto-char (point-max))
+ (skip-chars-backward " \t")
+ (if (bolp) (point) (line-end-position))))))
;;;###autoload
(defun org-table-justify-field-maybe (&optional new)
@@ -950,38 +958,40 @@ Optional argument NEW may specify text to replace the current field content."
((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
((org-at-table-hline-p))
((and (not new)
- (or (not (equal (marker-buffer org-table-aligned-begin-marker)
- (current-buffer)))
+ (or (not (eq (marker-buffer org-table-aligned-begin-marker)
+ (current-buffer)))
(< (point) org-table-aligned-begin-marker)
(>= (point) org-table-aligned-end-marker)))
- ;; This is not the same table, force a full re-align
+ ;; This is not the same table, force a full re-align.
(setq org-table-may-need-update t))
- (t ;; realign the current field, based on previous full realign
- (let* ((pos (point)) s
- (col (org-table-current-column))
- (num (if (> col 0) (nth (1- col) org-table-last-alignment)))
- l f n o e)
+ (t
+ ;; Realign the current field, based on previous full realign.
+ (let ((pos (point))
+ (col (org-table-current-column)))
(when (> col 0)
- (skip-chars-backward "^|\n")
- (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")
- (progn
- (setq s (match-string 1)
- o (match-string 0)
- l (max 1 (- (match-end 0) (match-beginning 0) 3))
- e (not (= (match-beginning 2) (match-end 2))))
- (setq f (format (if num " %%%ds %s" " %%-%ds %s")
- l (if e "|" (setq org-table-may-need-update t) ""))
- n (format f s))
- (if new
- (if (<= (length new) l) ;; FIXME: length -> str-width?
- (setq n (format f new))
- (setq n (concat new "|") org-table-may-need-update t)))
- (if (equal (string-to-char n) ?-) (setq n (concat " " n)))
- (or (equal n o)
- (let (org-table-may-need-update)
- (replace-match n t t))))
- (setq org-table-may-need-update t))
- (goto-char pos))))))
+ (skip-chars-backward "^|")
+ (if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)"))
+ (setq org-table-may-need-update t)
+ (let* ((numbers? (nth (1- col) org-table-last-alignment))
+ (cell (match-string 0))
+ (field (match-string 1))
+ (len (max 1 (- (org-string-width cell) 3)))
+ (properly-closed? (/= (match-beginning 2) (match-end 2)))
+ (fmt (format (if numbers? " %%%ds %s" " %%-%ds %s")
+ len
+ (if properly-closed? "|"
+ (setq org-table-may-need-update t)
+ "")))
+ (new-cell
+ (cond ((not new) (format fmt field))
+ ((<= (org-string-width new) len) (format fmt new))
+ (t
+ (setq org-table-may-need-update t)
+ (format " %s |" new)))))
+ (unless (equal new-cell cell)
+ (let (org-table-may-need-update)
+ (replace-match new-cell t t)))
+ (goto-char pos))))))))
;;;###autoload
(defun org-table-next-field ()
@@ -1020,25 +1030,29 @@ Before doing so, re-align the table if necessary."
(interactive)
(org-table-justify-field-maybe)
(org-table-maybe-recalculate-line)
- (if (and org-table-automatic-realign
- org-table-may-need-update)
- (org-table-align))
- (if (org-at-table-hline-p)
- (end-of-line 1))
- (condition-case nil
- (progn
- (re-search-backward "|" (org-table-begin))
- (re-search-backward "|" (org-table-begin)))
- (error (user-error "Cannot move to previous table field")))
- (while (looking-at "|\\(-\\|[ \t]*$\\)")
- (re-search-backward "|" (org-table-begin)))
- (if (looking-at "| ?")
- (goto-char (match-end 0))))
+ (when (and org-table-automatic-realign
+ org-table-may-need-update)
+ (org-table-align))
+ (when (org-at-table-hline-p)
+ (end-of-line))
+ (let ((start (org-table-begin))
+ (origin (point)))
+ (condition-case nil
+ (progn
+ (search-backward "|" start nil 2)
+ (while (looking-at-p "|\\(?:-\\|[ \t]*$\\)")
+ (search-backward "|" start)))
+ (error
+ (goto-char origin)
+ (user-error "Cannot move to previous table field"))))
+ (when (looking-at "| ?")
+ (goto-char (match-end 0))))
(defun org-table-beginning-of-field (&optional n)
- "Move to the end of the current table field.
-If already at or after the end, move to the end of the next table field.
-With numeric argument N, move N-1 fields forward first."
+ "Move to the beginning of the current table field.
+If already at or before the beginning, move to the beginning of the
+previous field.
+With numeric argument N, move N-1 fields backward first."
(interactive "p")
(let ((pos (point)))
(while (> n 1)
@@ -1051,10 +1065,9 @@ With numeric argument N, move N-1 fields forward first."
(if (>= (point) pos) (org-table-beginning-of-field 2))))
(defun org-table-end-of-field (&optional n)
- "Move to the beginning of the current table field.
-If already at or before the beginning, move to the beginning of the
-previous field.
-With numeric argument N, move N-1 fields backward first."
+ "Move to the end of the current table field.
+If already at or after the end, move to the end of the next table field.
+With numeric argument N, move N-1 fields forward first."
(interactive "p")
(let ((pos (point)))
(while (> n 1)
@@ -1074,88 +1087,115 @@ Before doing so, re-align the table if necessary."
(interactive)
(org-table-maybe-eval-formula)
(org-table-maybe-recalculate-line)
- (if (or (looking-at "[ \t]*$")
- (save-excursion (skip-chars-backward " \t") (bolp)))
- (newline)
- (if (and org-table-automatic-realign
- org-table-may-need-update)
- (org-table-align))
- (let ((col (org-table-current-column)))
- (beginning-of-line 2)
- (if (or (not (org-at-table-p))
+ (if (and org-table-automatic-realign
+ org-table-may-need-update)
+ (org-table-align))
+ (let ((col (org-table-current-column)))
+ (beginning-of-line 2)
+ (when (or (not (org-at-table-p))
(org-at-table-hline-p))
- (progn
- (beginning-of-line 0)
- (org-table-insert-row 'below)))
- (org-table-goto-column col)
- (skip-chars-backward "^|\n\r")
- (if (looking-at " ") (forward-char 1)))))
+ (beginning-of-line 0)
+ (org-table-insert-row 'below))
+ (org-table-goto-column col)
+ (skip-chars-backward "^|\n\r")
+ (when (looking-at " ") (forward-char))))
;;;###autoload
(defun org-table-copy-down (n)
- "Copy a field down in the current column.
-If the field at the cursor is empty, copy into it the content of
-the nearest non-empty field above. With argument N, use the Nth
-non-empty field. If the current field is not empty, it is copied
-down to the next row, and the cursor is moved with it.
-Therefore, repeating this command causes the column to be filled
-row-by-row.
+ "Copy the value of the current field one row below.
+
+If the field at the cursor is empty, copy the content of the
+nearest non-empty field above. With argument N, use the Nth
+non-empty field.
+
+If the current field is not empty, it is copied down to the next
+row, and the cursor is moved with it. Therefore, repeating this
+command causes the column to be filled row-by-row.
+
If the variable `org-table-copy-increment' is non-nil and the
field is an integer or a timestamp, it will be incremented while
-copying. In the case of a timestamp, increment by one day."
+copying. By default, increment by the difference between the
+value in the current field and the one in the field above. To
+increment using a fixed integer, set `org-table-copy-increment'
+to a number. In the case of a timestamp, increment by days."
(interactive "p")
(let* ((colpos (org-table-current-column))
(col (current-column))
(field (save-excursion (org-table-get-field)))
+ (field-up (or (save-excursion
+ (org-table-get (1- (org-table-current-line))
+ (org-table-current-column))) ""))
(non-empty (string-match "[^ \t]" field))
+ (non-empty-up (string-match "[^ \t]" field-up))
(beg (org-table-begin))
(orig-n n)
- txt)
+ txt txt-up inc)
(org-table-check-inside-data-field)
- (if non-empty
- (progn
- (setq txt (org-trim field))
- (org-table-next-row)
- (org-table-blank-field))
- (save-excursion
- (setq txt
- (catch 'exit
- (while (progn (beginning-of-line 1)
- (re-search-backward org-table-dataline-regexp
- beg t))
- (org-table-goto-column colpos t)
- (if (and (looking-at
- "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
- (<= (setq n (1- n)) 0))
- (throw 'exit (match-string 1))))))))
- (if txt
- (progn
- (if (and org-table-copy-increment
- (not (equal orig-n 0))
- (string-match "^[0-9]+$" txt)
- (< (string-to-number txt) 100000000))
- (setq txt (format "%d" (+ (string-to-number txt) 1))))
- (insert txt)
- (org-move-to-column col)
- (if (and org-table-copy-increment (org-at-timestamp-p t))
- (org-timestamp-up-day)
- (org-table-maybe-recalculate-line))
- (org-table-align)
- (org-move-to-column col))
- (user-error "No non-empty field found"))))
+ (if (not non-empty)
+ (save-excursion
+ (setq txt
+ (catch 'exit
+ (while (progn (beginning-of-line 1)
+ (re-search-backward org-table-dataline-regexp
+ beg t))
+ (org-table-goto-column colpos t)
+ (if (and (looking-at
+ "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
+ (<= (setq n (1- n)) 0))
+ (throw 'exit (match-string 1))))))
+ (setq field-up
+ (catch 'exit
+ (while (progn (beginning-of-line 1)
+ (re-search-backward org-table-dataline-regexp
+ beg t))
+ (org-table-goto-column colpos t)
+ (if (and (looking-at
+ "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
+ (<= (setq n (1- n)) 0))
+ (throw 'exit (match-string 1))))))
+ (setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
+ ;; Above field was not empty, go down to the next row
+ (setq txt (org-trim field))
+ (org-table-next-row)
+ (org-table-blank-field))
+ (if non-empty-up (setq txt-up (org-trim field-up)))
+ (setq inc (cond
+ ((numberp org-table-copy-increment) org-table-copy-increment)
+ (txt-up (cond ((and (string-match org-ts-regexp3 txt-up)
+ (string-match org-ts-regexp3 txt))
+ (- (org-time-string-to-absolute txt)
+ (org-time-string-to-absolute txt-up)))
+ ((string-match org-ts-regexp3 txt) 1)
+ ((string-match "\\([-+]\\)?[0-9]+\\(?:\.[0-9]+\\)?" txt-up)
+ (- (string-to-number txt)
+ (string-to-number (match-string 0 txt-up))))
+ (t 1)))
+ (t 1)))
+ (if (not txt)
+ (user-error "No non-empty field found")
+ (if (and org-table-copy-increment
+ (not (equal orig-n 0))
+ (string-match-p "^[-+^/*0-9eE.]+$" txt)
+ (< (string-to-number txt) 100000000))
+ (setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
+ (insert txt)
+ (org-move-to-column col)
+ (if (and org-table-copy-increment (org-at-timestamp-p 'lax))
+ (org-timestamp-up-day inc)
+ (org-table-maybe-recalculate-line))
+ (org-table-align)
+ (org-move-to-column col))))
(defun org-table-check-inside-data-field (&optional noerror)
"Is point inside a table data field?
I.e. not on a hline or before the first or after the last column?
This actually throws an error, so it aborts the current command."
- (if (or (not (org-at-table-p))
- (= (org-table-current-column) 0)
- (org-at-table-hline-p)
- (looking-at "[ \t]*$"))
- (if noerror
- nil
- (user-error "Not in table data field"))
- t))
+ (cond ((and (org-at-table-p)
+ (not (save-excursion (skip-chars-backward " \t") (bolp)))
+ (not (org-at-table-hline-p))
+ (not (looking-at "[ \t]*$"))))
+ (noerror nil)
+ (t (user-error "Not in table data field"))))
(defvar org-table-clip nil
"Clipboard for table regions.")
@@ -1166,7 +1206,7 @@ If LINE is larger than the number of data lines in the table, the function
returns nil. However, if COLUMN is too large, we will simply return an
empty string.
If LINE is nil, use the current line.
-If column is nil, use the current column."
+If COLUMN is nil, use the current column."
(setq column (or column (org-table-current-column)))
(save-excursion
(and (or (not line) (org-table-goto-line line))
@@ -1206,7 +1246,7 @@ Return t when the line exists, nil if it does not exist."
"Blank the current table field or active region."
(interactive)
(org-table-check-inside-data-field)
- (if (and (org-called-interactively-p 'any) (org-region-active-p))
+ (if (and (called-interactively-p 'any) (org-region-active-p))
(let (org-table-clip)
(org-table-cut-region (region-beginning) (region-end)))
(skip-chars-backward "^|")
@@ -1221,52 +1261,53 @@ Return t when the line exists, nil if it does not exist."
(defun org-table-get-field (&optional n replace)
"Return the value of the field in column N of current row.
-N defaults to current field.
-If REPLACE is a string, replace field with this value. The return value
-is always the old value."
- (and n (org-table-goto-column n))
+N defaults to current column. If REPLACE is a string, replace
+field with this value. The return value is always the old
+value."
+ (when n (org-table-goto-column n))
(skip-chars-backward "^|\n")
- (backward-char 1)
- (if (looking-at "|[^|\r\n]*")
- (let* ((pos (match-beginning 0))
- (val (buffer-substring (1+ pos) (match-end 0))))
- (if replace
- (replace-match (concat "|" (if (equal replace "") " " replace))
- t t))
- (goto-char (min (point-at-eol) (+ 2 pos)))
- val)
- (forward-char 1) ""))
+ (if (or (bolp) (looking-at-p "[ \t]*$"))
+ ;; Before first column or after last one.
+ ""
+ (looking-at "[^|\r\n]*")
+ (let* ((pos (match-beginning 0))
+ (val (buffer-substring pos (match-end 0))))
+ (when replace
+ (replace-match (if (equal replace "") " " replace) t t))
+ (goto-char (min (line-end-position) (1+ pos)))
+ val)))
;;;###autoload
-(defun org-table-field-info (arg)
+(defun org-table-field-info (_arg)
"Show info about the current field, and highlight any reference at point."
(interactive "P")
(unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-get-specials)
+ (org-table-analyze)
(save-excursion
(let* ((pos (point))
(col (org-table-current-column))
(cname (car (rassoc (int-to-string col) org-table-column-names)))
- (name (car (rassoc (list (org-current-line) col)
+ (name (car (rassoc (list (count-lines org-table-current-begin-pos
+ (line-beginning-position))
+ col)
org-table-named-field-locations)))
(eql (org-table-expand-lhs-ranges
(mapcar
(lambda (e)
- (cons (org-table-formula-handle-first/last-rc
- (car e)) (cdr e)))
+ (cons (org-table-formula-handle-first/last-rc (car e))
+ (cdr e)))
(org-table-get-stored-formulas))))
(dline (org-table-current-dline))
(ref (format "@%d$%d" dline col))
(ref1 (org-table-convert-refs-to-an ref))
+ ;; Prioritize field formulas over column formulas.
(fequation (or (assoc name eql) (assoc ref eql)))
- (cequation (assoc (int-to-string col) eql))
+ (cequation (assoc (format "$%d" col) eql))
(eqn (or fequation cequation)))
- (if (and eqn (get-text-property 0 :orig-eqn (car eqn)))
- (setq eqn (get-text-property 0 :orig-eqn (car eqn))))
+ (let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn)))))
+ (when p (setq eqn p)))
(goto-char pos)
- (condition-case nil
- (org-table-show-reference 'local)
- (error nil))
+ (ignore-errors (org-table-show-reference 'local))
(message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
dline col
(if cname (concat " or $" cname) "")
@@ -1277,39 +1318,33 @@ is always the old value."
(concat ", formula: "
(org-table-formula-to-user
(concat
- (if (string-match "^[$@]"(car eqn)) "" "$")
+ (if (or (string-prefix-p "$" (car eqn))
+ (string-prefix-p "@" (car eqn)))
+ ""
+ "$")
(car eqn) "=" (cdr eqn))))
"")))))
(defun org-table-current-column ()
"Find out which column we are in."
(interactive)
- (if (org-called-interactively-p 'any) (org-table-check-inside-data-field))
(save-excursion
- (let ((cnt 0) (pos (point)))
- (beginning-of-line 1)
- (while (search-forward "|" pos t)
- (setq cnt (1+ cnt)))
- (when (org-called-interactively-p 'interactive)
- (message "In table column %d" cnt))
- cnt)))
+ (let ((column 0) (pos (point)))
+ (beginning-of-line)
+ (while (search-forward "|" pos t) (cl-incf column))
+ column)))
-;;;###autoload
(defun org-table-current-dline ()
"Find out what table data line we are in.
Only data lines count for this."
- (interactive)
- (when (org-called-interactively-p 'any)
- (org-table-check-inside-data-field))
(save-excursion
- (let ((cnt 0) (pos (point)))
+ (let ((c 0)
+ (pos (line-beginning-position)))
(goto-char (org-table-begin))
(while (<= (point) pos)
- (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt)))
- (beginning-of-line 2))
- (when (org-called-interactively-p 'any)
- (message "This is table line %d" cnt))
- cnt)))
+ (when (looking-at org-table-dataline-regexp) (cl-incf c))
+ (forward-line))
+ c)))
;;;###autoload
(defun org-table-goto-column (n &optional on-delim force)
@@ -1338,25 +1373,19 @@ However, when FORCE is non-nil, create new columns if necessary."
(defun org-table-insert-column ()
"Insert a new column into the table."
(interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(let* ((col (max 1 (org-table-current-column)))
(beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos col))
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col t)
- (insert "| "))
- (beginning-of-line 2))
- (move-marker end nil)
- (org-goto-line linepos)
- (org-table-goto-column colpos)
+ (end (copy-marker (org-table-end))))
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ (org-table-goto-column col t)
+ (insert "| "))
+ (forward-line)))
+ (set-marker end nil)
(org-table-align)
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
@@ -1384,58 +1413,55 @@ However, when FORCE is non-nil, create new columns if necessary."
(defun org-table-line-to-dline (line &optional above)
"Turn a buffer line number into a data line number.
+
If there is no data line in this line, return nil.
-If there is no matching dline (most likely te reference was a hline), the
-first dline below it is used. When ABOVE is non-nil, the one above is used."
- (catch 'exit
- (let ((ll (length org-table-dlines))
- i)
- (if above
- (progn
- (setq i (1- ll))
- (while (> i 0)
- (if (<= (aref org-table-dlines i) line)
- (throw 'exit i))
- (setq i (1- i))))
- (setq i 1)
- (while (< i ll)
- (if (>= (aref org-table-dlines i) line)
- (throw 'exit i))
- (setq i (1+ i)))))
- nil))
+
+If there is no matching dline (most likely the reference was
+a hline), the first dline below it is used. When ABOVE is
+non-nil, the one above is used."
+ (let ((min 1)
+ (max (1- (length org-table-dlines))))
+ (cond ((or (> (aref org-table-dlines min) line)
+ (< (aref org-table-dlines max) line))
+ nil)
+ ((= (aref org-table-dlines max) line) max)
+ (t (catch 'exit
+ (while (> (- max min) 1)
+ (let* ((mean (/ (+ max min) 2))
+ (v (aref org-table-dlines mean)))
+ (cond ((= v line) (throw 'exit mean))
+ ((> v line) (setq max mean))
+ (t (setq min mean)))))
+ (if above min max))))))
;;;###autoload
(defun org-table-delete-column ()
"Delete a column from the table."
(interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
- (let* ((col (org-table-current-column))
- (beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos col))
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col t)
- (and (looking-at "|[^|\n]+|")
- (replace-match "|")))
- (beginning-of-line 2))
- (move-marker end nil)
- (org-goto-line linepos)
- (org-table-goto-column colpos)
+ (let ((col (org-table-current-column))
+ (beg (org-table-begin))
+ (end (copy-marker (org-table-end))))
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (if (org-at-table-hline-p)
+ nil
+ (org-table-goto-column col t)
+ (and (looking-at "|[^|\n]+|")
+ (replace-match "|")))
+ (forward-line)))
+ (set-marker end nil)
+ (org-table-goto-column (max 1 (1- col)))
(org-table-align)
(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))))
+ (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))))
;;;###autoload
(defun org-table-move-column-right ()
@@ -1452,31 +1478,29 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(defun org-table-move-column (&optional left)
"Move the current column to the right. With arg LEFT, move to the left."
(interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
+ (unless (org-at-table-p) (user-error "Not at a table"))
(org-table-find-dataline)
(org-table-check-inside-data-field)
(let* ((col (org-table-current-column))
(col1 (if left (1- col) col))
+ (colpos (if left (1- col) (1+ col)))
(beg (org-table-begin))
- (end (org-table-end))
- ;; Current cursor position
- (linepos (org-current-line))
- (colpos (if left (1- col) (1+ col))))
- (if (and left (= col 1))
- (user-error "Cannot move column further left"))
- (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
- (user-error "Cannot move column further right"))
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col1 t)
- (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
- (replace-match "|\\2|\\1|")))
- (beginning-of-line 2))
- (move-marker end nil)
- (org-goto-line linepos)
+ (end (copy-marker (org-table-end))))
+ (when (and left (= col 1))
+ (user-error "Cannot move column further left"))
+ (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
+ (user-error "Cannot move column further right"))
+ (org-table-save-field
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ (org-table-goto-column col1 t)
+ (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
+ (transpose-regions
+ (match-beginning 1) (match-end 1)
+ (match-beginning 2) (match-end 2))))
+ (forward-line)))
+ (set-marker end nil)
(org-table-goto-column colpos)
(org-table-align)
(when (or (not org-table-fix-formulas-confirm)
@@ -1510,47 +1534,52 @@ first dline below it is used. When ABOVE is non-nil, the one above is used."
(dline1 (org-table-current-dline))
(dline2 (+ dline1 (if up -1 1)))
(tonew (if up 0 2))
- txt hline2p)
+ hline2p)
+ (when (and up (= (point-min) (line-beginning-position)))
+ (user-error "Cannot move row further"))
(beginning-of-line tonew)
- (unless (org-at-table-p)
+ (when (or (and (not up) (eobp)) (not (org-at-table-p)))
(goto-char pos)
(user-error "Cannot move row further"))
(setq hline2p (looking-at org-table-hline-regexp))
(goto-char pos)
- (beginning-of-line 1)
- (setq pos (point))
- (setq txt (buffer-substring (point) (1+ (point-at-eol))))
- (delete-region (point) (1+ (point-at-eol)))
- (beginning-of-line tonew)
- (insert txt)
- (beginning-of-line 0)
- (org-move-to-column col)
- (unless (or hline1p hline2p
- (not (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm
- "Fix formulas? "))))
- (org-table-fix-formulas
- "@" (list (cons (number-to-string dline1) (number-to-string dline2))
- (cons (number-to-string dline2) (number-to-string dline1)))))))
+ (let ((row (delete-and-extract-region (line-beginning-position)
+ (line-beginning-position 2))))
+ (beginning-of-line tonew)
+ (unless (bolp) (insert "\n")) ;at eob without a newline
+ (insert row)
+ (unless (bolp) (insert "\n")) ;missing final newline in ROW
+ (beginning-of-line 0)
+ (org-move-to-column col)
+ (unless (or hline1p hline2p
+ (not (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm
+ "Fix formulas? "))))
+ (org-table-fix-formulas
+ "@" (list
+ (cons (number-to-string dline1) (number-to-string dline2))
+ (cons (number-to-string dline2) (number-to-string dline1))))))))
;;;###autoload
(defun org-table-insert-row (&optional arg)
"Insert a new row above the current line into the table.
With prefix ARG, insert below the current line."
(interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
- (let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
+ (unless (org-at-table-p) (user-error "Not at a table"))
+ (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
(new (org-table-clean-line line)))
;; Fix the first field if necessary
(if (string-match "^[ \t]*| *[#$] *|" line)
(setq new (replace-match (match-string 0 line) t t new)))
(beginning-of-line (if arg 2 1))
+ ;; Buffer may not end of a newline character, so ensure
+ ;; (beginning-of-line 2) moves point to a new line.
+ (unless (bolp) (insert "\n"))
(let (org-table-may-need-update) (insert-before-markers new "\n"))
(beginning-of-line 0)
- (re-search-forward "| ?" (point-at-eol) t)
- (and (or org-table-may-need-update org-table-overlay-coordinates)
- (org-table-align))
+ (re-search-forward "| ?" (line-end-position) t)
+ (when (or org-table-may-need-update org-table-overlay-coordinates)
+ (org-table-align))
(when (or (not org-table-fix-formulas-confirm)
(funcall org-table-fix-formulas-confirm "Fix formulas? "))
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
@@ -1563,7 +1592,7 @@ With prefix ABOVE, insert above the current line."
(if (not (org-at-table-p))
(user-error "Not at a table"))
(when (eobp) (insert "\n") (backward-char 1))
- (if (not (string-match "|[ \t]*$" (org-current-line-string)))
+ (if (not (string-match-p "|[ \t]*$" (org-current-line-string)))
(org-table-align))
(let ((line (org-table-clean-line
(buffer-substring (point-at-bol) (point-at-eol))))
@@ -1613,17 +1642,20 @@ In particular, this does handle wide and invisible characters."
(if (not (org-at-table-p))
(user-error "Not at a table"))
(let ((col (current-column))
- (dline (org-table-current-dline)))
+ (dline (and (not (org-match-line org-table-hline-regexp))
+ (org-table-current-dline))))
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
(if (not (org-at-table-p)) (beginning-of-line 0))
(org-move-to-column col)
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
+ (when (and dline
+ (or (not org-table-fix-formulas-confirm)
+ (funcall org-table-fix-formulas-confirm "Fix formulas? ")))
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
dline -1 dline))))
;;;###autoload
-(defun org-table-sort-lines (with-case &optional sorting-type)
+(defun org-table-sort-lines
+ (&optional with-case sorting-type getkey-func compare-func interactive?)
"Sort table lines according to the column at point.
The position of point indicates the column to be used for
@@ -1636,76 +1668,113 @@ should be in the last line to be included into the sorting.
The command then prompts for the sorting type which can be
alphabetically, numerically, or by time (as given in a time stamp
-in the field). Sorting in reverse order is also possible.
+in the field, or as a HH:MM value). Sorting in reverse order is
+also possible.
With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
If SORTING-TYPE is specified when this function is called from a Lisp
program, no prompting will take place. SORTING-TYPE must be a character,
-any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting
-should be done in reverse order."
- (interactive "P")
- (let* ((thisline (org-current-line))
- (thiscol (org-table-current-column))
- (otc org-table-overlay-coordinates)
- beg end bcol ecol tend tbeg column lns pos)
- (when (equal thiscol 0)
- (if (org-called-interactively-p 'any)
- (setq thiscol
- (string-to-number
- (read-string "Use column N for sorting: ")))
- (setq thiscol 1))
- (org-table-goto-column thiscol))
- (org-table-check-inside-data-field)
- (if (org-region-active-p)
- (progn
- (setq beg (region-beginning) end (region-end))
- (goto-char beg)
- (setq column (org-table-current-column)
- beg (point-at-bol))
- (goto-char end)
- (setq end (point-at-bol 2)))
- (setq column (org-table-current-column)
- pos (point)
- tbeg (org-table-begin)
- tend (org-table-end))
- (if (re-search-backward org-table-hline-regexp tbeg t)
- (setq beg (point-at-bol 2))
- (goto-char tbeg)
- (setq beg (point-at-bol 1)))
- (goto-char pos)
- (if (re-search-forward org-table-hline-regexp tend t)
- (setq end (point-at-bol 1))
- (goto-char tend)
- (setq end (point-at-bol))))
- (setq beg (move-marker (make-marker) beg)
- end (move-marker (make-marker) end))
- (untabify beg end)
- (goto-char beg)
- (org-table-goto-column column)
- (skip-chars-backward "^|")
- (setq bcol (current-column))
- (org-table-goto-column (1+ column))
- (skip-chars-backward "^|")
- (setq ecol (1- (current-column)))
- (org-table-goto-column column)
- (setq lns (mapcar (lambda(x) (cons
- (org-sort-remove-invisible
- (nth (1- column)
- (org-split-string x "[ \t]*|[ \t]*")))
- x))
- (org-split-string (buffer-substring beg end) "\n")))
- (setq lns (org-do-sort lns "Table" with-case sorting-type))
- (when org-table-overlay-coordinates
- (org-table-toggle-coordinate-overlays))
- (delete-region beg end)
- (move-marker beg nil)
- (move-marker end nil)
- (insert (mapconcat 'cdr lns "\n") "\n")
- (org-goto-line thisline)
- (org-table-goto-column thiscol)
- (when otc (org-table-toggle-coordinate-overlays))
- (message "%d lines sorted, based on column %d" (length lns) column)))
+any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
+sorting should be done in reverse order.
+
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
+a function to be called to extract the key. It must return a value
+that is compatible with COMPARE-FUNC, the function used to compare
+entries.
+
+A non-nil value for INTERACTIVE? is used to signal that this
+function is being called interactively."
+ (interactive (list current-prefix-arg nil nil nil t))
+ (when (org-region-active-p) (goto-char (region-beginning)))
+ ;; Point must be either within a field or before a data line.
+ (save-excursion
+ (skip-chars-backward " \t")
+ (when (bolp) (search-forward "|" (line-end-position) t))
+ (org-table-check-inside-data-field))
+ ;; Set appropriate case sensitivity and column used for sorting.
+ (let ((column (let ((c (org-table-current-column)))
+ (cond ((> c 0) c)
+ (interactive?
+ (read-number "Use column N for sorting: "))
+ (t 1))))
+ (sorting-type
+ (or sorting-type
+ (read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \
+\[t]ime, [f]unc. A/N/T/F means reversed: "))))
+ (save-restriction
+ ;; Narrow buffer to appropriate sorting area.
+ (if (org-region-active-p)
+ (progn (goto-char (region-beginning))
+ (narrow-to-region
+ (point)
+ (save-excursion (goto-char (region-end))
+ (line-beginning-position 2))))
+ (let ((start (org-table-begin))
+ (end (org-table-end)))
+ (narrow-to-region
+ (save-excursion
+ (if (re-search-backward org-table-hline-regexp start t)
+ (line-beginning-position 2)
+ start))
+ (if (save-excursion (re-search-forward org-table-hline-regexp end t))
+ (match-beginning 0)
+ end))))
+ ;; Determine arguments for `sort-subr'. Also record original
+ ;; position. `org-table-save-field' cannot help here since
+ ;; sorting is too much destructive.
+ (let* ((sort-fold-case (not with-case))
+ (coordinates
+ (cons (count-lines (point-min) (line-beginning-position))
+ (current-column)))
+ (extract-key-from-field
+ ;; Function to be called on the contents of the field
+ ;; used for sorting in the current row.
+ (cl-case sorting-type
+ ((?n ?N) #'string-to-number)
+ ((?a ?A) #'org-sort-remove-invisible)
+ ((?t ?T)
+ (lambda (f)
+ (cond ((string-match org-ts-regexp-both f)
+ (float-time
+ (org-time-string-to-time (match-string 0 f))))
+ ((org-duration-p f) (org-duration-to-minutes f))
+ ((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f)
+ (org-duration-to-minutes (match-string 0 f)))
+ (t 0))))
+ ((?f ?F)
+ (or getkey-func
+ (and interactive?
+ (org-read-function "Function for extracting keys: "))
+ (error "Missing key extractor to sort rows")))
+ (t (user-error "Invalid sorting type `%c'" sorting-type))))
+ (predicate
+ (cl-case sorting-type
+ ((?n ?N ?t ?T) #'<)
+ ((?a ?A) #'string<)
+ ((?f ?F)
+ (or compare-func
+ (and interactive?
+ (org-read-function
+ (concat "Function for comparing keys "
+ "(empty for default `sort-subr' predicate): ")
+ 'allow-empty)))))))
+ (goto-char (point-min))
+ (sort-subr (memq sorting-type '(?A ?N ?T ?F))
+ (lambda ()
+ (forward-line)
+ (while (and (not (eobp))
+ (not (looking-at org-table-dataline-regexp)))
+ (forward-line)))
+ #'end-of-line
+ (lambda ()
+ (funcall extract-key-from-field
+ (org-trim (org-table-get-field column))))
+ nil
+ predicate)
+ ;; Move back to initial field.
+ (forward-line (car coordinates))
+ (move-to-column (cdr coordinates))))))
;;;###autoload
(defun org-table-cut-region (beg end)
@@ -1725,34 +1794,31 @@ with `org-table-paste-rectangle'."
(if (org-region-active-p) (region-beginning) (point))
(if (org-region-active-p) (region-end) (point))
current-prefix-arg))
- (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2
- region cols
- (rpl (if cut " " nil)))
- (goto-char beg)
- (org-table-check-inside-data-field)
- (setq l01 (org-current-line)
- c01 (org-table-current-column))
- (goto-char end)
+ (goto-char (min beg end))
+ (org-table-check-inside-data-field)
+ (let ((beg (line-beginning-position))
+ (c01 (org-table-current-column))
+ region)
+ (goto-char (max beg end))
(org-table-check-inside-data-field)
- (setq l02 (org-current-line)
- c02 (org-table-current-column))
- (setq l1 (min l01 l02) l2 (max l01 l02)
- c1 (min c01 c02) c2 (max c01 c02))
- (catch 'exit
- (while t
- (catch 'nextline
- (if (> l1 l2) (throw 'exit t))
- (org-goto-line l1)
- (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1))))
- (setq cols nil ic1 c1 ic2 c2)
- (while (< ic1 (1+ ic2))
- (push (org-table-get-field ic1 rpl) cols)
- (setq ic1 (1+ ic1)))
- (push (nreverse cols) region)
- (setq l1 (1+ l1)))))
- (setq org-table-clip (nreverse region))
- (if cut (org-table-align))
- org-table-clip))
+ (let* ((end (copy-marker (line-end-position)))
+ (c02 (org-table-current-column))
+ (column-start (min c01 c02))
+ (column-end (max c01 c02))
+ (column-number (1+ (- column-end column-start)))
+ (rpl (and cut " ")))
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (org-at-table-hline-p)
+ ;; Collect every cell between COLUMN-START and COLUMN-END.
+ (let (cols)
+ (dotimes (c column-number)
+ (push (org-table-get-field (+ c column-start) rpl) cols))
+ (push (nreverse cols) region)))
+ (forward-line))
+ (set-marker end nil))
+ (when cut (org-table-align))
+ (setq org-table-clip (nreverse region))))
;;;###autoload
(defun org-table-paste-rectangle ()
@@ -1762,45 +1828,42 @@ will be overwritten. If the rectangle does not fit into the present table,
the table is enlarged as needed. The process ignores horizontal separator
lines."
(interactive)
- (unless (and org-table-clip (listp org-table-clip))
+ (unless (consp org-table-clip)
(user-error "First cut/copy a region to paste!"))
(org-table-check-inside-data-field)
- (let* ((clip org-table-clip)
- (line (org-current-line))
- (col (org-table-current-column))
- (org-enable-table-editor t)
- (org-table-automatic-realign nil)
- c cols field)
- (while (setq cols (pop clip))
- (while (org-at-table-hline-p) (beginning-of-line 2))
- (if (not (org-at-table-p))
- (progn (end-of-line 0) (org-table-next-field)))
- (setq c col)
- (while (setq field (pop cols))
- (org-table-goto-column c nil 'force)
- (org-table-get-field nil field)
- (setq c (1+ c)))
- (beginning-of-line 2))
- (org-goto-line line)
- (org-table-goto-column col)
+ (let* ((column (org-table-current-column))
+ (org-table-automatic-realign nil))
+ (org-table-save-field
+ (dolist (row org-table-clip)
+ (while (org-at-table-hline-p) (forward-line))
+ ;; If we left the table, create a new row.
+ (when (and (bolp) (not (looking-at "[ \t]*|")))
+ (end-of-line 0)
+ (org-table-next-field))
+ (let ((c column))
+ (dolist (field row)
+ (org-table-goto-column c nil 'force)
+ (org-table-get-field nil field)
+ (cl-incf c)))
+ (forward-line)))
(org-table-align)))
;;;###autoload
(defun org-table-convert ()
"Convert from `org-mode' table to table.el and back.
-Obviously, this only works within limits. When an Org-mode table is
-converted to table.el, all horizontal separator lines get lost, because
-table.el uses these as cell boundaries and has no notion of horizontal lines.
-A table.el table can be converted to an Org-mode table only if it does not
-do row or column spanning. Multiline cells will become multiple cells.
-Beware, Org-mode does not test if the table can be successfully converted - it
-blindly applies a recipe that works for simple tables."
+Obviously, this only works within limits. When an Org table is converted
+to table.el, all horizontal separator lines get lost, because table.el uses
+these as cell boundaries and has no notion of horizontal lines. A table.el
+table can be converted to an Org table only if it does not do row or column
+spanning. Multiline cells will become multiple cells. Beware, Org mode
+does not test if the table can be successfully converted - it blindly
+applies a recipe that works for simple tables."
(interactive)
(require 'table)
(if (org-at-table.el-p)
- ;; convert to Org-mode table
- (let ((beg (move-marker (make-marker) (org-table-begin t)))
- (end (move-marker (make-marker) (org-table-end t))))
+ ;; convert to Org table
+ (let ((beg (copy-marker (org-table-begin t)))
+ (end (copy-marker (org-table-end t))))
(table-unrecognize-region beg end)
(goto-char beg)
(while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t)
@@ -1808,8 +1871,8 @@ blindly applies a recipe that works for simple tables."
(goto-char beg))
(if (org-at-table-p)
;; convert to table.el table
- (let ((beg (move-marker (make-marker) (org-table-begin)))
- (end (move-marker (make-marker) (org-table-end))))
+ (let ((beg (copy-marker (org-table-begin)))
+ (end (copy-marker (org-table-end))))
;; first, get rid of all horizontal lines
(goto-char beg)
(while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
@@ -1832,7 +1895,7 @@ blindly applies a recipe that works for simple tables."
(goto-char beg)))))
(defun org-table-transpose-table-at-point ()
- "Transpose orgmode table at point and eliminate hlines.
+ "Transpose Org table at point and eliminate hlines.
So a table like
| 1 | 2 | 4 | 5 |
@@ -1847,22 +1910,31 @@ will be transposed as
| 4 | c | g |
| 5 | d | h |
-Note that horizontal lines disappeared."
+Note that horizontal lines disappear."
(interactive)
(let* ((table (delete 'hline (org-table-to-lisp)))
- (contents (mapcar (lambda (p)
+ (dline_old (org-table-current-line))
+ (col_old (org-table-current-column))
+ (contents (mapcar (lambda (_)
(let ((tp table))
(mapcar
- (lambda (rown)
+ (lambda (_)
(prog1
(pop (car tp))
(setq tp (cdr tp))))
table)))
(car table))))
- (delete-region (org-table-begin) (org-table-end))
- (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
- contents ""))
- (org-table-align)))
+ (goto-char (org-table-begin))
+ (re-search-forward "|")
+ (backward-char)
+ (delete-region (point) (org-table-end))
+ (insert (mapconcat
+ (lambda(x)
+ (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
+ contents ""))
+ (org-table-goto-line col_old)
+ (org-table-goto-column dline_old))
+ (org-table-align))
;;;###autoload
(defun org-table-wrap-region (arg)
@@ -1873,7 +1945,8 @@ lines, in order to keep the table compact.
If there is an active region, and both point and mark are in the same column,
the text in the column is wrapped to minimum width for the given number of
lines. Generally, this makes the table more compact. A prefix ARG may be
-used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]'
+used to change the number of desired lines. For example, \
+`C-2 \\[org-table-wrap-region]'
formats the selected text to two lines. If the region was longer than two
lines, the remaining lines remain empty. A negative prefix argument reduces
the current number of lines by that amount. The wrapped text is pasted back
@@ -1890,48 +1963,43 @@ blank, and the content is appended to the field above."
(interactive "P")
(org-table-check-inside-data-field)
(if (org-region-active-p)
- ;; There is a region: fill as a paragraph
- (let* ((beg (region-beginning))
- (cline (save-excursion (goto-char beg) (org-current-line)))
- (ccol (save-excursion (goto-char beg) (org-table-current-column)))
- nlines)
+ ;; There is a region: fill as a paragraph.
+ (let ((start (region-beginning)))
(org-table-cut-region (region-beginning) (region-end))
- (if (> (length (car org-table-clip)) 1)
- (user-error "Region must be limited to single column"))
- (setq nlines (if arg
- (if (< arg 1)
- (+ (length org-table-clip) arg)
- arg)
- (length org-table-clip)))
- (setq org-table-clip
- (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ")
- nil nlines)))
- (org-goto-line cline)
- (org-table-goto-column ccol)
+ (when (> (length (car org-table-clip)) 1)
+ (user-error "Region must be limited to single column"))
+ (let ((nlines (cond ((not arg) (length org-table-clip))
+ ((< arg 1) (+ (length org-table-clip) arg))
+ (t arg))))
+ (setq org-table-clip
+ (mapcar #'list
+ (org-wrap (mapconcat #'car org-table-clip " ")
+ nil
+ nlines))))
+ (goto-char start)
(org-table-paste-rectangle))
- ;; No region, split the current field at point
+ ;; No region, split the current field at point.
(unless (org-get-alist-option org-M-RET-may-split-line 'table)
(skip-chars-forward "^\r\n|"))
- (if arg
- ;; combine with field above
- (let ((s (org-table-blank-field))
- (col (org-table-current-column)))
- (beginning-of-line 0)
- (while (org-at-table-hline-p) (beginning-of-line 0))
- (org-table-goto-column col)
- (skip-chars-forward "^|")
- (skip-chars-backward " ")
- (insert " " (org-trim s))
- (org-table-align))
- ;; split field
- (if (looking-at "\\([^|]+\\)+|")
- (let ((s (match-string 1)))
- (replace-match " |")
- (goto-char (match-beginning 0))
- (org-table-next-row)
- (insert (org-trim s) " ")
- (org-table-align))
- (org-table-next-row)))))
+ (cond
+ (arg ; Combine with field above.
+ (let ((s (org-table-blank-field))
+ (col (org-table-current-column)))
+ (forward-line -1)
+ (while (org-at-table-hline-p) (forward-line -1))
+ (org-table-goto-column col)
+ (skip-chars-forward "^|")
+ (skip-chars-backward " ")
+ (insert " " (org-trim s))
+ (org-table-align)))
+ ((looking-at "\\([^|]+\\)+|") ; Split field.
+ (let ((s (match-string 1)))
+ (replace-match " |")
+ (goto-char (match-beginning 0))
+ (org-table-next-row)
+ (insert (org-trim s) " ")
+ (org-table-align)))
+ (t (org-table-next-row)))))
(defvar org-field-marker nil)
@@ -1939,9 +2007,14 @@ blank, and the content is appended to the field above."
(defun org-table-edit-field (arg)
"Edit table field in a different window.
This is mainly useful for fields that contain hidden parts.
-When called with a \\[universal-argument] prefix, just make the full field visible so that
-it can be edited in place."
+
+When called with a `\\[universal-argument]' prefix, just make the full field
+visible so that it can be edited in place.
+
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
+toggle `org-table-follow-field-mode'."
(interactive "P")
+ (unless (org-at-table-p) (user-error "Not at a table"))
(cond
((equal arg '(16))
(org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
@@ -1980,9 +2053,9 @@ it can be edited in place."
'(invisible t org-cwidth t display t
intangible t))
(goto-char p)
- (org-set-local 'org-finish-function 'org-table-finish-edit-field)
- (org-set-local 'org-window-configuration cw)
- (org-set-local 'org-field-marker pos)
+ (setq-local org-finish-function 'org-table-finish-edit-field)
+ (setq-local org-window-configuration cw)
+ (setq-local org-field-marker pos)
(message "Edit and finish with C-c C-c")))))
(defun org-table-finish-edit-field ()
@@ -2015,8 +2088,8 @@ current field. The mode exits automatically when the cursor leaves the
table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
nil " TblFollow" nil
(if org-table-follow-field-mode
- (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor
- 'append 'local)
+ (add-hook 'post-command-hook 'org-table-follow-fields-with-editor
+ 'append 'local)
(remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
(let* ((buf (get-buffer "*Org Table Edit Field*"))
(win (and buf (get-buffer-window buf))))
@@ -2091,11 +2164,10 @@ If NLAST is a number, only the NLAST fields will actually be summed."
s diff)
(format "%.0f:%02.0f:%02.0f" h m s))))
(kill-new sres)
- (if (org-called-interactively-p 'interactive)
- (message "%s"
- (substitute-command-keys
- (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)"
- (length numbers) sres))))
+ (when (called-interactively-p 'interactive)
+ (message "%s" (substitute-command-keys
+ (format "Sum of %d items: %-20s \
+\(\\[yank] will insert result into buffer)" (length numbers) sres))))
sres))))
(defun org-table-get-number-for-summing (s)
@@ -2120,57 +2192,58 @@ If NLAST is a number, only the NLAST fields will actually be summed."
(defun org-table-current-field-formula (&optional key noerror)
"Return the formula active for the current field.
-Assumes that specials are in place.
-If KEY is given, return the key to this formula.
-Otherwise return the formula preceded with \"=\" or \":=\"."
- (let* ((name (car (rassoc (list (org-current-line)
- (org-table-current-column))
- org-table-named-field-locations)))
- (col (org-table-current-column))
- (scol (int-to-string col))
- (ref (format "@%d$%d" (org-table-current-dline) col))
- (stored-list (org-table-get-stored-formulas noerror))
- (ass (or (assoc name stored-list)
- (assoc ref stored-list)
- (assoc scol stored-list))))
- (if key
- (car ass)
- (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=")
- (cdr ass))))))
+
+Assumes that table is already analyzed. If KEY is given, return
+the key to this formula. Otherwise return the formula preceded
+with \"=\" or \":=\"."
+ (let* ((line (count-lines org-table-current-begin-pos
+ (line-beginning-position)))
+ (row (org-table-line-to-dline line)))
+ (cond
+ (row
+ (let* ((col (org-table-current-column))
+ (name (car (rassoc (list line col)
+ org-table-named-field-locations)))
+ (scol (format "$%d" col))
+ (ref (format "@%d$%d" (org-table-current-dline) col))
+ (stored-list (org-table-get-stored-formulas noerror))
+ (ass (or (assoc name stored-list)
+ (assoc ref stored-list)
+ (assoc scol stored-list))))
+ (cond (key (car ass))
+ (ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=")
+ (cdr ass))))))
+ (noerror nil)
+ (t (error "No formula active for the current field")))))
(defun org-table-get-formula (&optional equation named)
"Read a formula from the minibuffer, offer stored formula as default.
When NAMED is non-nil, look for a named equation."
(let* ((stored-list (org-table-get-stored-formulas))
- (name (car (rassoc (list (org-current-line)
+ (name (car (rassoc (list (count-lines org-table-current-begin-pos
+ (line-beginning-position))
(org-table-current-column))
org-table-named-field-locations)))
- (ref (format "@%d$%d" (org-table-current-dline)
+ (ref (format "@%d$%d"
+ (org-table-current-dline)
(org-table-current-column)))
- (refass (assoc ref stored-list))
- (nameass (assoc name stored-list))
- (scol (if named
- (if (and name (not (string-match "^LR[0-9]+$" name)))
- name
- ref)
- (int-to-string (org-table-current-column))))
- (dummy (and (or nameass refass) (not named)
- (not (y-or-n-p "Replace existing field formula with column formula? " ))
- (message "Formula not replaced")))
+ (scol (cond
+ ((not named) (format "$%d" (org-table-current-column)))
+ ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name)
+ (t ref)))
(name (or name ref))
(org-table-may-need-update nil)
(stored (cdr (assoc scol stored-list)))
(eq (cond
- ((and stored equation (string-match "^ *=? *$" equation))
+ ((and stored equation (string-match-p "^ *=? *$" equation))
stored)
((stringp equation)
equation)
(t (org-table-formula-from-user
(read-string
(org-table-formula-to-user
- (format "%s formula %s%s="
+ (format "%s formula %s="
(if named "Field" "Column")
- (if (member (string-to-char scol) '(?$ ?@)) "" "$")
scol))
(if stored (org-table-formula-to-user stored) "")
'org-table-formula-history
@@ -2194,25 +2267,27 @@ When NAMED is non-nil, look for a named equation."
(org-table-store-formulas stored-list))
eq))
-(defun org-table-store-formulas (alist)
- "Store the list of formulas below the current table."
- (setq alist (sort alist 'org-table-formula-less-p))
- (let ((case-fold-search t))
- (save-excursion
- (goto-char (org-table-end))
- (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)")
+(defun org-table-store-formulas (alist &optional location)
+ "Store the list of formulas below the current table.
+If optional argument LOCATION is a buffer position, insert it at
+LOCATION instead."
+ (save-excursion
+ (if location
+ (progn (goto-char location) (beginning-of-line))
+ (goto-char (org-table-end)))
+ (let ((case-fold-search t))
+ (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)")
(progn
- ;; don't overwrite TBLFM, we might use text properties to store stuff
+ ;; Don't overwrite TBLFM, we might use text properties to
+ ;; store stuff.
(goto-char (match-beginning 3))
(delete-region (match-beginning 3) (match-end 0)))
(org-indent-line)
(insert (or (match-string 2) "#+TBLFM:")))
(insert " "
- (mapconcat (lambda (x)
- (concat
- (if (equal (string-to-char (car x)) ?@) "" "$")
- (car x) "=" (cdr x)))
- alist "::")
+ (mapconcat (lambda (x) (concat (car x) "=" (cdr x)))
+ (sort alist #'org-table-formula-less-p)
+ "::")
"\n"))))
(defsubst org-table-formula-make-cmp-string (a)
@@ -2241,33 +2316,47 @@ When NAMED is non-nil, look for a named equation."
(and as bs (string< as bs))))
;;;###autoload
-(defun org-table-get-stored-formulas (&optional noerror)
- "Return an alist with the stored formulas directly after current table."
- (interactive) ;; FIXME interactive?
- (let ((case-fold-search t) scol eq eq-alist strings string seen)
- (save-excursion
- (goto-char (org-table-end))
- (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)")
- (setq strings (org-split-string (org-match-string-no-properties 2)
- " *:: *"))
- (while (setq string (pop strings))
- (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string)
- (setq scol (if (match-end 2)
- (match-string 2 string)
- (match-string 1 string))
- scol (if (member (string-to-char scol) '(?< ?>))
- (concat "$" scol) scol)
- eq (match-string 3 string)
- eq-alist (cons (cons scol eq) eq-alist))
- (if (member scol seen)
- (if noerror
- (progn
- (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol)
- (ding)
- (sit-for 2))
- (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol))
- (push scol seen))))))
- (nreverse eq-alist)))
+(defun org-table-get-stored-formulas (&optional noerror location)
+ "Return an alist with the stored formulas directly after current table.
+By default, only return active formulas, i.e., formulas located
+on the first line after the table. However, if optional argument
+LOCATION is a buffer position, consider the formulas there."
+ (save-excursion
+ (if location
+ (progn (goto-char location) (beginning-of-line))
+ (goto-char (org-table-end)))
+ (let ((case-fold-search t))
+ (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
+ (let ((strings (org-split-string (match-string-no-properties 2)
+ " *:: *"))
+ eq-alist seen)
+ (dolist (string strings (nreverse eq-alist))
+ (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|\\$\\([_a-zA-Z0-9]+\\|\
+[<>]+\\)\\) *= *\\(.*[^ \t]\\)"
+ string)
+ (let ((lhs
+ (let ((m (match-string 1 string)))
+ (cond
+ ((not (match-end 2)) m)
+ ;; Is it a column reference?
+ ((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m)
+ ;; Since named columns are not possible in
+ ;; LHS, assume this is a named field.
+ (t (match-string 2 string)))))
+ (rhs (match-string 3 string)))
+ (push (cons lhs rhs) eq-alist)
+ (cond
+ ((not (member lhs seen)) (push lhs seen))
+ (noerror
+ (message
+ "Double definition `%s=' in TBLFM line, please fix by hand"
+ lhs)
+ (ding)
+ (sit-for 2))
+ (t
+ (user-error
+ "Double definition `%s=' in TBLFM line, please fix by hand"
+ lhs)))))))))))
(defun org-table-fix-formulas (key replace &optional limit delta remove)
"Modify the equations after the table structure has been edited.
@@ -2305,83 +2394,6 @@ For all numbers larger than LIMIT, shift them by DELTA."
(message msg))))))
(forward-line))))
-(defun org-table-get-specials ()
- "Get the column names and local parameters for this table."
- (save-excursion
- (let ((beg (org-table-begin)) (end (org-table-end))
- names name fields fields1 field cnt
- c v l line col types dlines hlines last-dline)
- (setq org-table-column-names nil
- org-table-local-parameters nil
- org-table-named-field-locations nil
- org-table-current-begin-line nil
- org-table-current-begin-pos nil
- org-table-current-line-types nil
- org-table-current-ncol 0)
- (goto-char beg)
- (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
- (setq names (org-split-string (match-string 1) " *| *")
- cnt 1)
- (while (setq name (pop names))
- (setq cnt (1+ cnt))
- (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name)
- (push (cons name (int-to-string cnt)) org-table-column-names))))
- (setq org-table-column-names (nreverse org-table-column-names))
- (setq org-table-column-name-regexp
- (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>"))
- (goto-char beg)
- (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
- (setq fields (org-split-string (match-string 1) " *| *"))
- (while (setq field (pop fields))
- (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
- (push (cons (match-string 1 field) (match-string 2 field))
- org-table-local-parameters))))
- (goto-char beg)
- (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
- (setq c (match-string 1)
- fields (org-split-string (match-string 2) " *| *"))
- (save-excursion
- (beginning-of-line (if (equal c "_") 2 0))
- (setq line (org-current-line) col 1)
- (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
- (setq fields1 (org-split-string (match-string 1) " *| *"))))
- (while (and fields1 (setq field (pop fields)))
- (setq v (pop fields1) col (1+ col))
- (when (and (stringp field) (stringp v)
- (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field))
- (push (cons field v) org-table-local-parameters)
- (push (list field line col) org-table-named-field-locations))))
- ;; Analyze the line types.
- (goto-char beg)
- (setq org-table-current-begin-line (org-current-line)
- org-table-current-begin-pos (point)
- l org-table-current-begin-line)
- (while (looking-at "[ \t]*|\\(-\\)?")
- (push (if (match-end 1) 'hline 'dline) types)
- (if (match-end 1) (push l hlines) (push l dlines))
- (beginning-of-line 2)
- (setq l (1+ l)))
- (push 'hline types) ;; add an imaginary extra hline to the end
- (setq org-table-current-line-types (apply 'vector (nreverse types))
- last-dline (car dlines)
- org-table-dlines (apply 'vector (cons nil (nreverse dlines)))
- org-table-hlines (apply 'vector (cons nil (nreverse hlines))))
- (org-goto-line last-dline)
- (let* ((l last-dline)
- (fields (org-split-string
- (buffer-substring (point-at-bol) (point-at-eol))
- "[ \t]*|[ \t]*"))
- (nfields (length fields))
- al al2)
- (setq org-table-current-ncol nfields)
- (loop for i from 1 to nfields do
- (push (list (format "LR%d" i) l i) al)
- (push (cons (format "LR%d" i) (nth (1- 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))))))
-
;;;###autoload
(defun org-table-maybe-eval-formula ()
"Check if the current field starts with \"=\" or \":=\".
@@ -2394,11 +2406,8 @@ If yes, store the formula and apply it."
(when (string-match "^:?=\\(.*[^=]\\)$" field)
(setq named (equal (string-to-char field) ?:)
eq (match-string 1 field))
- (if (or (fboundp 'calc-eval)
- (equal (substring eq 0 (min 2 (length eq))) "'("))
- (org-table-eval-formula (if named '(4) nil)
- (org-table-formula-from-user eq))
- (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))))))
+ (org-table-eval-formula (and named '(4))
+ (org-table-formula-from-user eq))))))
(defvar org-recalc-commands nil
"List of commands triggering the recalculation of a line.
@@ -2424,56 +2433,199 @@ After each change, a message will be displayed indicating the meaning
of the new mark."
(interactive)
(unless (org-at-table-p) (user-error "Not at a table"))
- (let* ((marks (append (mapcar 'car org-recalc-marks) '(" ")))
- (beg (org-table-begin))
- (end (org-table-end))
- (l (org-current-line))
- (l1 (if (org-region-active-p) (org-current-line (region-beginning))))
- (l2 (if (org-region-active-p) (org-current-line (region-end))))
- (have-col
- (save-excursion
- (goto-char beg)
- (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t))))
+ (let* ((region (org-region-active-p))
+ (l1 (and region
+ (save-excursion (goto-char (region-beginning))
+ (copy-marker (line-beginning-position)))))
+ (l2 (and region
+ (save-excursion (goto-char (region-end))
+ (copy-marker (line-beginning-position)))))
+ (l (copy-marker (line-beginning-position)))
(col (org-table-current-column))
- (forcenew (car (assoc newchar org-recalc-marks)))
- epos new)
- (when l1
- (message "Change region to what mark? Type # * ! $ or SPC: ")
- (setq newchar (char-to-string (read-char-exclusive))
- forcenew (car (assoc newchar org-recalc-marks))))
- (if (and newchar (not forcenew))
- (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'"
- newchar))
- (if l1 (org-goto-line l1))
+ (newchar (if region
+ (char-to-string
+ (read-char-exclusive
+ "Change region to what mark? Type # * ! $ or SPC: "))
+ newchar))
+ (no-special-column
+ (save-excursion
+ (goto-char (org-table-begin))
+ (re-search-forward
+ "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" (org-table-end) t))))
+ (when (and newchar (not (assoc newchar org-recalc-marks)))
+ (user-error "Invalid character `%s' in `org-table-rotate-recalc-marks'"
+ newchar))
+ (when l1 (goto-char l1))
(save-excursion
- (beginning-of-line 1)
+ (beginning-of-line)
(unless (looking-at org-table-dataline-regexp)
(user-error "Not at a table data line")))
- (unless have-col
+ (when no-special-column
(org-table-goto-column 1)
- (org-table-insert-column)
- (org-table-goto-column (1+ col)))
- (setq epos (point-at-eol))
+ (org-table-insert-column))
+ (let ((previous-line-end (line-end-position))
+ (newchar
+ (save-excursion
+ (beginning-of-line)
+ (cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#")
+ (newchar)
+ (t (cadr (member (match-string 1)
+ (append (mapcar #'car org-recalc-marks)
+ '(" ")))))))))
+ ;; Rotate mark in first row.
+ (org-table-get-field 1 (format " %s " newchar))
+ ;; Rotate marks in additional rows if a region is active.
+ (when region
+ (save-excursion
+ (forward-line)
+ (while (<= (point) l2)
+ (when (looking-at org-table-dataline-regexp)
+ (org-table-get-field 1 (format " %s " newchar)))
+ (forward-line))))
+ ;; Only align if rotation actually changed lines' length.
+ (when (/= previous-line-end (line-end-position)) (org-table-align)))
+ (goto-char l)
+ (org-table-goto-column (if no-special-column (1+ col) col))
+ (when l1 (set-marker l1 nil))
+ (when l2 (set-marker l2 nil))
+ (set-marker l nil)
+ (when (called-interactively-p 'interactive)
+ (message "%s" (cdr (assoc newchar org-recalc-marks))))))
+
+;;;###autoload
+(defun org-table-analyze ()
+ "Analyze table at point and store results.
+
+This function sets up the following dynamically scoped variables:
+
+ `org-table-column-name-regexp',
+ `org-table-column-names',
+ `org-table-current-begin-pos',
+ `org-table-current-line-types',
+ `org-table-current-ncol',
+ `org-table-dlines',
+ `org-table-hlines',
+ `org-table-local-parameters',
+ `org-table-named-field-locations'."
+ (let ((beg (org-table-begin))
+ (end (org-table-end)))
(save-excursion
- (beginning-of-line 1)
- (org-table-get-field
- 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")
- (concat " "
- (setq new (or forcenew
- (cadr (member (match-string 1) marks))))
- " ")
- " # ")))
- (if (and l1 l2)
- (progn
- (org-goto-line l1)
- (while (progn (beginning-of-line 2) (not (= (org-current-line) l2)))
- (and (looking-at org-table-dataline-regexp)
- (org-table-get-field 1 (concat " " new " "))))
- (org-goto-line l1)))
- (if (not (= epos (point-at-eol))) (org-table-align))
- (org-goto-line l)
- (and (org-called-interactively-p 'interactive)
- (message "%s" (cdr (assoc new org-recalc-marks))))))
+ (goto-char beg)
+ ;; Extract column names.
+ (setq org-table-column-names nil)
+ (when (save-excursion
+ (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t))
+ (let ((c 1))
+ (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)))))
+ (setq org-table-column-names (nreverse org-table-column-names))
+ (setq org-table-column-name-regexp
+ (format "\\$\\(%s\\)\\>"
+ (regexp-opt (mapcar #'car org-table-column-names) t)))
+ ;; Extract local parameters.
+ (setq org-table-local-parameters nil)
+ (save-excursion
+ (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
+ (dolist (field (org-split-string (match-string 1) " *| *"))
+ (when (string-match
+ "\\`\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
+ (push (cons (match-string 1 field) (match-string 2 field))
+ org-table-local-parameters)))))
+ ;; Update named fields locations. We minimize `count-lines'
+ ;; processing by storing last known number of lines in LAST.
+ (setq org-table-named-field-locations nil)
+ (save-excursion
+ (let ((last (cons (point) 0)))
+ (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
+ (let ((c (match-string 1))
+ (fields (org-split-string (match-string 2) " *| *")))
+ (save-excursion
+ (forward-line (if (equal c "_") 1 -1))
+ (let ((fields1
+ (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
+ (org-split-string (match-string 1) " *| *")))
+ (line (cl-incf (cdr last) (count-lines (car last) (point))))
+ (col 1))
+ (setcar last (point)) ; Update last known position.
+ (while (and fields fields1)
+ (let ((field (pop fields))
+ (v (pop fields1)))
+ (cl-incf col)
+ (when (and (stringp field)
+ (stringp v)
+ (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'"
+ field))
+ (push (cons field v) org-table-local-parameters)
+ (push (list field line col)
+ org-table-named-field-locations))))))))))
+ ;; Re-use existing markers when possible.
+ (if (markerp org-table-current-begin-pos)
+ (move-marker org-table-current-begin-pos (point))
+ (setq org-table-current-begin-pos (point-marker)))
+ ;; Analyze the line types.
+ (let ((l 0) hlines dlines types)
+ (while (looking-at "[ \t]*|\\(-\\)?")
+ (push (if (match-end 1) 'hline 'dline) types)
+ (if (match-end 1) (push l hlines) (push l dlines))
+ (forward-line)
+ (cl-incf l))
+ (push 'hline types) ; Add an imaginary extra hline to the end.
+ (setq org-table-current-line-types (apply #'vector (nreverse types)))
+ (setq org-table-dlines (apply #'vector (cons nil (nreverse dlines))))
+ (setq org-table-hlines (apply #'vector (cons nil (nreverse hlines)))))
+ ;; 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))))))
+
+(defun org-table-goto-field (ref &optional create-column-p)
+ "Move point to a specific field in the current table.
+
+REF is either the name of a field its absolute reference, as
+a string. No column is created unless CREATE-COLUMN-P is
+non-nil. If it is a function, it is called with the column
+number as its argument as is used as a predicate to know if the
+column can be created.
+
+This function assumes the table is already analyzed (i.e., using
+`org-table-analyze')."
+ (let* ((coordinates
+ (cond
+ ((cdr (assoc ref org-table-named-field-locations)))
+ ((string-match "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" ref)
+ (list (condition-case nil
+ (aref org-table-dlines
+ (string-to-number (match-string 1 ref)))
+ (error (user-error "Invalid row number in %s" ref)))
+ (string-to-number (match-string 2 ref))))
+ (t (user-error "Unknown field: %s" ref))))
+ (line (car coordinates))
+ (column (nth 1 coordinates))
+ (create-new-column (if (functionp create-column-p)
+ (funcall create-column-p column)
+ create-column-p)))
+ (when coordinates
+ (goto-char org-table-current-begin-pos)
+ (forward-line line)
+ (org-table-goto-column column nil create-new-column))))
;;;###autoload
(defun org-table-maybe-recalculate-line ()
@@ -2481,7 +2633,7 @@ of the new mark."
(interactive)
(and org-table-allow-automatic-line-recalculation
(not (and (memq last-command org-recalc-commands)
- (equal org-last-recalc-line (org-current-line))))
+ (eq org-last-recalc-line (line-beginning-position))))
(save-excursion (beginning-of-line 1)
(looking-at org-table-auto-recalculate-regexp))
(org-table-recalculate) t))
@@ -2505,20 +2657,18 @@ of the new mark."
suppress-store suppress-analysis)
"Replace the table field value at the cursor by the result of a calculation.
-This function makes use of Dave Gillespie's Calc package, in my view the
-most exciting program ever written for GNU Emacs. So you need to have Calc
-installed in order to use this function.
-
In a table, this command replaces the value in the current field with the
result of a formula. It also installs the formula as the \"current\" column
formula, by storing it in a special line below the table. When called
-with a `C-u' prefix, the current field must be a named field, and the
-formula is installed as valid in only this specific field.
+with a `\\[universal-argument]' prefix the formula is installed as a \
+field formula.
-When called with two `C-u' prefixes, insert the active equation
-for the field back into the current field, so that it can be
-edited there. This is useful in order to use \\[org-table-show-reference]
-to check the referenced fields.
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
+insert the active equation for the field
+back into the current field, so that it can be edited there. This is \
+useful
+in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to \
+check the referenced fields.
When called, the command first prompts for a formula, which is read in
the minibuffer. Previously entered formulas are available through the
@@ -2527,23 +2677,31 @@ These stored formulas are adapted correctly when moving, inserting, or
deleting columns with the corresponding commands.
The formula can be any algebraic expression understood by the Calc package.
-For details, see the Org-mode manual.
+For details, see the Org mode manual.
This function can also be called from Lisp programs and offers
additional arguments: EQUATION can be the formula to apply. If this
-argument is given, the user will not be prompted. SUPPRESS-ALIGN is
-used to speed-up recursive calls by by-passing unnecessary aligns.
+argument is given, the user will not be prompted.
+
+SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing
+unnecessary aligns.
+
SUPPRESS-CONST suppresses the interpretation of constants in the
-formula, assuming that this has been done already outside the function.
-SUPPRESS-STORE means the formula should not be stored, either because
-it is already stored, or because it is a modified equation that should
-not overwrite the stored one."
+formula, assuming that this has been done already outside the
+function.
+
+SUPPRESS-STORE means the formula should not be stored, either
+because it is already stored, or because it is a modified
+equation that should not overwrite the stored one.
+
+SUPPRESS-ANALYSIS prevents analyzing the table and checking
+location of point."
(interactive "P")
- (org-table-check-inside-data-field)
- (or suppress-analysis (org-table-get-specials))
+ (unless suppress-analysis
+ (org-table-check-inside-data-field)
+ (org-table-analyze))
(if (equal arg '(16))
(let ((eq (org-table-current-field-formula)))
- (or eq (user-error "No equation active for current field"))
(org-table-get-field nil eq)
(org-table-align)
(setq org-table-may-need-update t))
@@ -2557,7 +2715,7 @@ not overwrite the stored one."
(org-table-get-formula equation (equal arg '(4)))))
(n0 (org-table-current-column))
(org-tbl-calc-modes (copy-sequence org-calc-default-modes))
- (numbers nil) ; was a variable, now fixed default
+ (numbers nil) ; was a variable, now fixed default
(keep-empty nil)
n form form0 formrpl formrg bw fmt x ev orig c lispp literal
duration duration-output-format)
@@ -2580,15 +2738,14 @@ not overwrite the stored one."
(?s . sci) (?e . eng))))
n))))
(setq fmt (replace-match "" t t fmt)))
- (if (string-match "T" fmt)
- (setq duration t numbers t
- duration-output-format nil
- fmt (replace-match "" t t fmt)))
- (if (string-match "t" fmt)
- (setq duration t
- duration-output-format org-table-duration-custom-format
- numbers t
- fmt (replace-match "" t t fmt)))
+ (if (string-match "[tTU]" fmt)
+ (let ((ff (match-string 0 fmt)))
+ (setq duration t numbers t
+ duration-output-format
+ (cond ((equal ff "T") nil)
+ ((equal ff "t") org-table-duration-custom-format)
+ ((equal ff "U") 'hh:mm))
+ fmt (replace-match "" t t fmt))))
(if (string-match "N" fmt)
(setq numbers t
fmt (replace-match "" t t fmt)))
@@ -2603,12 +2760,15 @@ not overwrite the stored one."
(setq fmt (replace-match "" t t fmt)))
(unless (string-match "\\S-" fmt)
(setq fmt nil))))
- (if (and (not suppress-const) org-table-formula-use-constants)
- (setq formula (org-table-formula-substitute-names formula)))
+ (when (and (not suppress-const) org-table-formula-use-constants)
+ (setq formula (org-table-formula-substitute-names formula)))
(setq orig (or (get-text-property 1 :orig-formula formula) "?"))
+ (setq formula (org-table-formula-handle-first/last-rc formula))
(while (> ndown 0)
(setq fields (org-split-string
- (buffer-substring-no-properties (point-at-bol) (point-at-eol))
+ (org-trim
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position)))
" *| *"))
;; replace fields with duration values if relevant
(if duration
@@ -2641,9 +2801,10 @@ not overwrite the stored one."
t t form)))
;; Check for old vertical references
- (setq form (org-table-rewrite-old-row-references form))
+ (org-table--error-on-old-row-references form)
;; Insert remote references
- (while (string-match "\\<remote([ \t]*\\([-_a-zA-Z0-9]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
+ (setq form (org-table-remote-reference-indirection form))
+ (while (string-match "\\<remote([ \t]*\\([^,)]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
(setq form
(replace-match
(save-match-data
@@ -2660,8 +2821,10 @@ not overwrite the stored one."
;; Insert complex ranges
(while (and (string-match org-table-range-regexp form)
(> (length (match-string 0 form)) 1))
- (setq formrg (save-match-data
- (org-table-get-range (match-string 0 form) nil n0)))
+ (setq formrg
+ (save-match-data
+ (org-table-get-range
+ (match-string 0 form) org-table-current-begin-pos n0)))
(setq formrpl
(save-match-data
(org-table-make-reference
@@ -2676,15 +2839,20 @@ not overwrite the stored one."
(string-match (regexp-quote form) formrpl)))
(setq form (replace-match formrpl t t form))
(user-error "Spreadsheet error: invalid reference \"%s\"" form)))
- ;; Insert simple ranges
- (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form)
+ ;; Insert simple ranges, i.e. included in the current row.
+ (while (string-match
+ "\\$\\(\\([-+]\\)?[0-9]+\\)\\.\\.\\$\\(\\([-+]\\)?[0-9]+\\)"
+ form)
(setq form
(replace-match
(save-match-data
(org-table-make-reference
- (org-sublist
- fields (string-to-number (match-string 1 form))
- (string-to-number (match-string 2 form)))
+ (cl-subseq fields
+ (+ (if (match-end 2) n0 0)
+ (string-to-number (match-string 1 form))
+ -1)
+ (+ (if (match-end 4) n0 0)
+ (string-to-number (match-string 3 form))))
keep-empty numbers lispp))
t t form)))
(setq form0 form)
@@ -2692,14 +2860,16 @@ not overwrite the stored one."
(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
(setq n (+ (string-to-number (match-string 1 form))
(if (match-end 2) n0 0))
- x (nth (1- (if (= n 0) n0 (max n 1))) fields))
- (unless x (user-error "Invalid field specifier \"%s\""
- (match-string 0 form)))
- (setq form (replace-match
- (save-match-data
- (org-table-make-reference
- x keep-empty numbers lispp))
- t t form)))
+ x (nth (1- (if (= n 0) n0 (max n 1))) fields)
+ formrpl (save-match-data
+ (org-table-make-reference
+ x keep-empty numbers lispp)))
+ (when (or (not x)
+ (save-match-data
+ (string-match (regexp-quote formula) formrpl)))
+ (user-error "Invalid field specifier \"%s\""
+ (match-string 0 form)))
+ (setq form (replace-match formrpl t t form)))
(if lispp
(setq ev (condition-case nil
@@ -2709,20 +2879,23 @@ not overwrite the stored one."
ev (if duration (org-table-time-seconds-to-string
(string-to-number ev)
duration-output-format) ev))
- (or (fboundp 'calc-eval)
- (user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))
- ;; Use <...> time-stamps so that Calc can handle them
- (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form)
- (setq form (replace-match "<\\1>" nil nil form)))
- ;; I18n-ize local time-stamps by setting (system-time-locale "C")
- (when (string-match org-ts-regexp2 form)
- (let* ((ts (match-string 0 form))
- (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts))))
- (system-time-locale "C")
- (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
- (cdr org-time-stamp-formats))
- (car org-time-stamp-formats))))
- (setq form (replace-match (format-time-string tf tsp) t t form))))
+
+ ;; Use <...> time-stamps so that Calc can handle them.
+ (setq form
+ (replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form))
+ ;; Internationalize local time-stamps by setting locale to
+ ;; "C".
+ (setq form
+ (replace-regexp-in-string
+ org-ts-regexp
+ (lambda (ts)
+ (let ((system-time-locale "C"))
+ (format-time-string
+ (org-time-stamp-format
+ (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
+ (apply #'encode-time
+ (save-match-data (org-parse-time-string ts))))))
+ form t t))
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
form
@@ -2742,7 +2915,7 @@ Orig: %s
$xyz-> %s
@r$c-> %s
$1-> %s\n" orig formula form0 form))
- (if (listp ev)
+ (if (consp ev)
(princ (format " %s^\nError: %s"
(make-string (car ev) ?\-) (nth 1 ev)))
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
@@ -2750,17 +2923,24 @@ $1-> %s\n" orig formula form0 form))
(if fmt (format fmt (string-to-number ev)) ev)))))
(setq bw (get-buffer-window "*Substitution History*"))
(org-fit-window-to-buffer bw)
- (unless (and (org-called-interactively-p 'any) (not ndown))
+ (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 (listp ev) (setq fmt nil ev "#ERROR"))
+ (when (consp ev) (setq fmt nil ev "#ERROR"))
(org-table-justify-field-maybe
(format org-table-formula-field-format
- (if fmt (format fmt (string-to-number ev)) ev)))
+ (cond
+ ((not (stringp ev)) ev)
+ (fmt (format fmt (string-to-number ev)))
+ ;; Replace any active time stamp in the result with
+ ;; an inactive one. Dates in tables are likely
+ ;; piece of regular data, not meant to appear in the
+ ;; agenda.
+ (t (replace-regexp-in-string org-ts-regexp "[\\1]" ev)))))
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
(call-interactively 'org-return)
(setq ndown 0)))
@@ -2776,146 +2956,152 @@ $1-> %s\n" orig formula form0 form))
(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
"Get a calc vector from a column, according to descriptor DESC.
+
Optional arguments TBEG and COL can give the beginning of the table and
the current column, to avoid unnecessary parsing.
HIGHLIGHT means just highlight the range.
When CORNERS-ONLY is set, only return the corners of the range as
-a list (line1 column1 line2 column2) where line1 and line2 are line numbers
-in the buffer and column1 and column2 are table column numbers."
- (if (not (equal (string-to-char desc) ?@))
- (setq desc (concat "@" desc)))
- (save-excursion
- (or tbeg (setq tbeg (org-table-begin)))
- (or col (setq col (org-table-current-column)))
- (let ((thisline (org-current-line))
- beg end c1 c2 r1 r2 rangep tmp)
- (unless (string-match org-table-range-regexp desc)
- (user-error "Invalid table range specifier `%s'" desc))
- (setq rangep (match-end 3)
- r1 (and (match-end 1) (match-string 1 desc))
- r2 (and (match-end 4) (match-string 4 desc))
- c1 (and (match-end 2) (substring (match-string 2 desc) 1))
- c2 (and (match-end 5) (substring (match-string 5 desc) 1)))
-
- (and c1 (setq c1 (+ (string-to-number c1)
- (if (memq (string-to-char c1) '(?- ?+)) col 0))))
- (and c2 (setq c2 (+ (string-to-number c2)
- (if (memq (string-to-char c2) '(?- ?+)) col 0))))
- (if (equal r1 "") (setq r1 nil))
- (if (equal r2 "") (setq r2 nil))
- (if r1 (setq r1 (org-table-get-descriptor-line r1)))
- (if r2 (setq r2 (org-table-get-descriptor-line r2)))
- ; (setq r2 (or r2 r1) c2 (or c2 c1))
- (if (not r1) (setq r1 thisline))
- (if (not r2) (setq r2 thisline))
- (if (or (not c1) (= 0 c1)) (setq c1 col))
- (if (or (not c2) (= 0 c2)) (setq c2 col))
- (if (and (not corners-only)
- (or (not rangep) (and (= r1 r2) (= c1 c2))))
- ;; just one field
- (progn
- (org-goto-line r1)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 2))
- (prog1 (org-trim (org-table-get-field c1))
- (if highlight (org-table-highlight-rectangle (point) (point)))))
- ;; A range, return a vector
- ;; First sort the numbers to get a regular rectangle
- (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
- (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
- (if corners-only
- ;; Only return the corners of the range
- (list r1 c1 r2 c2)
- ;; Copy the range values into a list
- (org-goto-line r1)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 2))
- (org-table-goto-column c1)
- (setq beg (point))
- (org-goto-line r2)
- (while (not (looking-at org-table-dataline-regexp))
- (beginning-of-line 0))
- (org-table-goto-column c2)
- (setq end (point))
- (if highlight
- (org-table-highlight-rectangle
- beg (progn (skip-chars-forward "^|\n") (point))))
- ;; return string representation of calc vector
- (mapcar 'org-trim
- (apply 'append (org-table-copy-region beg end))))))))
-
-(defun org-table-get-descriptor-line (desc &optional cline bline table)
- "Analyze descriptor DESC and retrieve the corresponding line number.
-The cursor is currently in line CLINE, the table begins in line BLINE,
-and TABLE is a vector with line types."
- (if (string-match "^[0-9]+$" desc)
+a list (line1 column1 line2 column2) where line1 and line2 are
+line numbers relative to beginning of table, or TBEG, and column1
+and column2 are table column numbers."
+ (let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc)
+ (replace-regexp-in-string "\\$" "@0$" desc)
+ desc))
+ (col (or col (org-table-current-column)))
+ (tbeg (or tbeg (org-table-begin)))
+ (thisline (count-lines tbeg (line-beginning-position))))
+ (unless (string-match org-table-range-regexp desc)
+ (user-error "Invalid table range specifier `%s'" desc))
+ (let ((rangep (match-end 3))
+ (r1 (let ((r (and (match-end 1) (match-string 1 desc))))
+ (or (save-match-data
+ (and (org-string-nw-p r)
+ (org-table--descriptor-line r thisline)))
+ thisline)))
+ (r2 (let ((r (and (match-end 4) (match-string 4 desc))))
+ (or (save-match-data
+ (and (org-string-nw-p r)
+ (org-table--descriptor-line r thisline)))
+ thisline)))
+ (c1 (let ((c (and (match-end 2) (substring (match-string 2 desc) 1))))
+ (if (or (not c) (= (string-to-number c) 0)) col
+ (+ (string-to-number c)
+ (if (memq (string-to-char c) '(?- ?+)) col 0)))))
+ (c2 (let ((c (and (match-end 5) (substring (match-string 5 desc) 1))))
+ (if (or (not c) (= (string-to-number c) 0)) col
+ (+ (string-to-number c)
+ (if (memq (string-to-char c) '(?- ?+)) col 0))))))
+ (save-excursion
+ (if (and (not corners-only)
+ (or (not rangep) (and (= r1 r2) (= c1 c2))))
+ ;; Just one field.
+ (progn
+ (forward-line (- r1 thisline))
+ (while (not (looking-at org-table-dataline-regexp))
+ (forward-line))
+ (prog1 (org-trim (org-table-get-field c1))
+ (when highlight (org-table-highlight-rectangle))))
+ ;; A range, return a vector. First sort the numbers to get
+ ;; a regular rectangle.
+ (let ((first-row (min r1 r2))
+ (last-row (max r1 r2))
+ (first-column (min c1 c2))
+ (last-column (max c1 c2)))
+ (if corners-only (list first-row first-column last-row last-column)
+ ;; Copy the range values into a list.
+ (forward-line (- first-row thisline))
+ (while (not (looking-at org-table-dataline-regexp))
+ (forward-line)
+ (cl-incf first-row))
+ (org-table-goto-column first-column)
+ (let ((beg (point)))
+ (forward-line (- last-row first-row))
+ (while (not (looking-at org-table-dataline-regexp))
+ (forward-line -1))
+ (org-table-goto-column last-column)
+ (let ((end (point)))
+ (when highlight
+ (org-table-highlight-rectangle
+ beg (progn (skip-chars-forward "^|\n") (point))))
+ ;; Return string representation of calc vector.
+ (mapcar #'org-trim
+ (apply #'append
+ (org-table-copy-region beg end))))))))))))
+
+(defun org-table--descriptor-line (desc cline)
+ "Return relative line number corresponding to descriptor DESC.
+The cursor is currently in relative line number CLINE."
+ (if (string-match "\\`[0-9]+\\'" desc)
(aref org-table-dlines (string-to-number desc))
- (setq cline (or cline (org-current-line))
- bline (or bline org-table-current-begin-line)
- table (or table org-table-current-line-types))
- (if (or
- (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc))
- ;; 1 2 3 4 5 6
- (and (not (match-end 3)) (not (match-end 6)))
- (and (match-end 3) (match-end 6) (not (match-end 5))))
- (user-error "Invalid row descriptor `%s'" desc))
- (let* ((hdir (and (match-end 2) (match-string 2 desc)))
- (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil))
- (odir (and (match-end 5) (match-string 5 desc)))
- (on (if (match-end 6) (string-to-number (match-string 6 desc))))
- (i (- cline bline))
+ (when (or (not (string-match
+ "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?"
+ ;; 1 2 3 4 5 6
+ desc))
+ (and (not (match-end 3)) (not (match-end 6)))
+ (and (match-end 3) (match-end 6) (not (match-end 5))))
+ (user-error "Invalid row descriptor `%s'" desc))
+ (let* ((hn (and (match-end 3) (- (match-end 3) (match-beginning 3))))
+ (hdir (match-string 2 desc))
+ (odir (match-string 5 desc))
+ (on (and (match-end 6) (string-to-number (match-string 6 desc))))
(rel (and (match-end 6)
(or (and (match-end 1) (not (match-end 3)))
(match-end 5)))))
- (if (and hn (not hdir))
- (progn
- (setq i 0 hdir "+")
- (if (eq (aref table 0) 'hline) (setq hn (1- hn)))))
- (if (and (not hn) on (not odir))
- (user-error "Should never happen");;(aref org-table-dlines on)
- (if (and hn (> hn 0))
- (setq i (org-table-find-row-type table i 'hline (equal hdir "-")
- nil hn cline desc)))
- (if on
- (setq i (org-table-find-row-type table i 'dline (equal odir "-")
- rel on cline desc)))
- (+ bline i)))))
-
-(defun org-table-find-row-type (table i type backwards relative n cline desc)
- "FIXME: Needs more documentation."
- (let ((l (length table)))
- (while (> n 0)
- (while (and (setq i (+ i (if backwards -1 1)))
- (>= i 0) (< i l)
- (not (eq (aref table i) type))
- (if (and relative (eq (aref table i) 'hline))
- (cond
- ((eq org-table-relative-ref-may-cross-hline t) t)
- ((eq org-table-relative-ref-may-cross-hline 'error)
- (user-error "Row descriptor %s used in line %d crosses hline" desc cline))
- (t (setq i (- i (if backwards -1 1))
- n 1)
- nil))
- t)))
- (setq n (1- n)))
- (if (or (< i 0) (>= i l))
- (user-error "Row descriptor %s used in line %d leads outside table"
- desc cline)
- i)))
-
-(defun org-table-rewrite-old-row-references (s)
- (if (string-match "&[-+0-9I]" s)
- (user-error "Formula contains old &row reference, please rewrite using @-syntax")
- s))
+ (when (and hn (not hdir))
+ (setq cline 0)
+ (setq hdir "+")
+ (when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn)))
+ (when (and (not hn) on (not odir)) (user-error "Should never happen"))
+ (when hn
+ (setq cline
+ (org-table--row-type 'hline hn cline (equal hdir "-") nil desc)))
+ (when on
+ (setq cline
+ (org-table--row-type 'dline on cline (equal odir "-") rel desc)))
+ cline)))
+
+(defun org-table--row-type (type n i backwards relative desc)
+ "Return relative line of Nth row with type TYPE.
+Search starts from relative line I. When BACKWARDS in non-nil,
+look before I. When RELATIVE is non-nil, the reference is
+relative. DESC is the original descriptor that started the
+search, as a string."
+ (let ((l (length org-table-current-line-types)))
+ (catch :exit
+ (dotimes (_ n)
+ (while (and (cl-incf i (if backwards -1 1))
+ (>= i 0)
+ (< i l)
+ (not (eq (aref org-table-current-line-types i) type))
+ ;; We are going to cross a hline. Check if this is
+ ;; an authorized move.
+ (cond
+ ((not relative))
+ ((not (eq (aref org-table-current-line-types i) 'hline)))
+ ((eq org-table-relative-ref-may-cross-hline t))
+ ((eq org-table-relative-ref-may-cross-hline 'error)
+ (user-error "Row descriptor %s crosses hline" desc))
+ (t (cl-decf i (if backwards -1 1)) ; Step back.
+ (throw :exit nil)))))))
+ (cond ((or (< i 0) (>= i l))
+ (user-error "Row descriptor %s leads outside table" desc))
+ ;; The last hline doesn't exist. Instead, point to last row
+ ;; in table.
+ ((= i (1- l)) (1- i))
+ (t i))))
+
+(defun org-table--error-on-old-row-references (s)
+ (when (string-match "&[-+0-9I]" s)
+ (user-error "Formula contains old &row reference, please rewrite using @-syntax")))
(defun org-table-make-reference (elements keep-empty numbers lispp)
"Convert list ELEMENTS to something appropriate to insert into formula.
KEEP-EMPTY indicated to keep empty fields, default is to skip them.
NUMBERS indicates that everything should be converted to numbers.
LISPP non-nil means to return something appropriate for a Lisp
-list, 'literal is for the format specifier L."
+list, `literal' is for the format specifier L."
;; Calc nan (not a number) is used for the conversion of the empty
;; field to a reference for several reasons: (i) It is accepted in a
;; Calc formula (e. g. "" or "()" would result in a Calc error).
@@ -2961,162 +3147,185 @@ list, 'literal is for the format specifier L."
elements
",") "]"))))
-;;;###autoload
-(defun org-table-set-constants ()
- "Set `org-table-formula-constants-local' in the current buffer."
- (let (cst consts const-str)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t)
- (setq const-str (substring-no-properties (match-string 1)))
- (setq consts (append consts (org-split-string const-str "[ \t]+")))
- (when consts
- (let (e)
- (while (setq e (pop consts))
- (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e)
- (if (assoc-string (match-string 1 e) cst)
- (setq cst (delete (assoc-string (match-string 1 e) cst) cst)))
- (push (cons (match-string 1 e) (match-string 2 e)) cst)))
- (setq org-table-formula-constants-local cst)))))))
+(defun org-table-message-once-per-second (t1 &rest args)
+ "If there has been more than one second since T1, display message.
+ARGS are passed as arguments to the `message' function. Returns
+current time if a message is printed, otherwise returns T1. If
+T1 is nil, always messages."
+ (let ((curtime (current-time)))
+ (if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1))))
+ (progn (apply 'message args)
+ curtime)
+ t1)))
;;;###autoload
(defun org-table-recalculate (&optional all noalign)
"Recalculate the current table line by applying all stored formulas.
+
With prefix arg ALL, do this for all lines in the table.
-With the prefix argument ALL is `(16)' \
-\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if
-it is the symbol `iterate', recompute the table until it no longer changes.
+
+When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \
+if ALL is the symbol `iterate',
+recompute the table until it no longer changes.
+
If NOALIGN is not nil, do not re-align the table after the computations
are done. This is typically used internally to save time, if it is
known that the table will be realigned a little later anyway."
(interactive "P")
- (or (memq this-command org-recalc-commands)
- (setq org-recalc-commands (cons this-command org-recalc-commands)))
+ (unless (memq this-command org-recalc-commands)
+ (push this-command org-recalc-commands))
(unless (org-at-table-p) (user-error "Not at a table"))
(if (or (eq all 'iterate) (equal all '(16)))
(org-table-iterate)
- (org-table-get-specials)
+ (org-table-analyze)
(let* ((eqlist (sort (org-table-get-stored-formulas)
(lambda (a b) (string< (car a) (car b)))))
- (eqlist1 (copy-sequence eqlist))
(inhibit-redisplay (not debug-on-error))
(line-re org-table-dataline-regexp)
- (thisline (org-current-line))
- (thiscol (org-table-current-column))
- seen-fields lhs1
- beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
- ;; Insert constants in all formulas
- (setq eqlist
- (mapcar (lambda (x)
- (when (string-match "\\`$[<>]" (car x))
- (setq lhs1 (car x))
- (setq x (cons (substring
- (org-table-formula-handle-first/last-rc
- (car x)) 1)
- (cdr x)))
- (if (assoc (car x) eqlist1)
- (user-error "\"%s=\" formula tries to overwrite existing formula for column %s"
- lhs1 (car x))))
- (cons
- (org-table-formula-handle-first/last-rc (car x))
- (org-table-formula-substitute-names
- (org-table-formula-handle-first/last-rc (cdr x)))))
- eqlist))
- ;; Split the equation list
- (while (setq eq (pop eqlist))
- (if (<= (string-to-char (car eq)) ?9)
- (push eq eqlnum)
- (push eq eqlname)))
- (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
- ;; Expand ranges in lhs of formulas
- (setq eqlname (org-table-expand-lhs-ranges eqlname))
-
- ;; Get the correct line range to process
- (if all
- (progn
- (setq end (move-marker (make-marker) (1+ (org-table-end))))
- (goto-char (setq beg (org-table-begin)))
- (if (re-search-forward org-table-calculate-mark-regexp end t)
- ;; This is a table with marked lines, compute selected lines
- (setq line-re org-table-recalculate-regexp)
- ;; Move forward to the first non-header line
- (if (and (re-search-forward org-table-dataline-regexp end t)
- (re-search-forward org-table-hline-regexp end t)
- (re-search-forward org-table-dataline-regexp end t))
- (setq beg (match-beginning 0))
- nil))) ;; just leave beg where it is
- (setq beg (point-at-bol)
- end (move-marker (make-marker) (1+ (point-at-eol)))))
- (goto-char beg)
- (and all (message "Re-applying formulas to full table..."))
-
- ;; First find the named fields, and mark them untouchable.
- ;; Also check if several field/range formulas try to set the same field.
- (remove-text-properties beg end '(org-untouchable t))
- (while (setq eq (pop eqlname))
- (setq name (car eq)
- a (assoc name org-table-named-field-locations))
- (setq name1 name)
- (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
- (nth 2 a))))
- (when (member name1 seen-fields)
- (user-error "Several field/range formulas try to set %s" name1))
- (push name1 seen-fields)
-
- (and (not a)
- (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
- (setq a (list name
- (condition-case nil
- (aref org-table-dlines
- (string-to-number (match-string 1 name)))
- (error (user-error "Invalid row number in %s"
- name)))
- (string-to-number (match-string 2 name)))))
- (when (and a (or all (equal (nth 1 a) thisline)))
- (message "Re-applying formula to field: %s" name)
- (org-goto-line (nth 1 a))
- (org-table-goto-column (nth 2 a))
- (push (append a (list (cdr eq))) eqlname1)
- (org-table-put-field-property :org-untouchable t)))
- (setq eqlname1 (nreverse eqlname1))
-
- ;; Now evaluate the column formulas, but skip fields covered by
- ;; field formulas
- (goto-char beg)
- (while (re-search-forward line-re end t)
- (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1))
- ;; Unprotected line, recalculate
- (and all (message "Re-applying formulas to full table...(line %d)"
- (setq cnt (1+ cnt))))
- (setq org-last-recalc-line (org-current-line))
- (setq eql eqlnum)
- (while (setq entry (pop eql))
- (org-goto-line org-last-recalc-line)
- (org-table-goto-column (string-to-number (car entry)) nil 'force)
- (unless (get-text-property (point) :org-untouchable)
- (org-table-eval-formula nil (cdr entry)
- 'noalign 'nocst 'nostore 'noanalysis)))))
-
- ;; Now evaluate the field formulas
- (while (setq eq (pop eqlname1))
- (message "Re-applying formula to field: %s" (car eq))
- (org-goto-line (nth 1 eq))
- (org-table-goto-column (nth 2 eq))
- (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst
- 'nostore 'noanalysis))
-
- (org-goto-line thisline)
- (org-table-goto-column thiscol)
- (remove-text-properties (point-min) (point-max) '(org-untouchable t))
- (or noalign (and org-table-may-need-update (org-table-align))
- (and all (message "Re-applying formulas to %d lines...done" cnt)))
-
- ;; back to initial position
- (message "Re-applying formulas...done")
- (org-goto-line thisline)
- (org-table-goto-column thiscol)
- (or noalign (and org-table-may-need-update (org-table-align))
- (and all (message "Re-applying formulas...done"))))))
+ (log-first-time (current-time))
+ (log-last-time log-first-time)
+ (cnt 0)
+ beg end eqlcol eqlfield)
+ ;; Insert constants in all formulas.
+ (when eqlist
+ (org-table-save-field
+ ;; Expand equations, then split the equation list between
+ ;; column formulas and field formulas.
+ (dolist (eq eqlist)
+ (let* ((rhs (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc (cdr eq))))
+ (old-lhs (car eq))
+ (lhs
+ (org-table-formula-handle-first/last-rc
+ (cond
+ ((string-match "\\`@-?I+" old-lhs)
+ (user-error "Can't assign to hline relative reference"))
+ ((string-match "\\`$[<>]" old-lhs)
+ (let ((new (org-table-formula-handle-first/last-rc
+ old-lhs)))
+ (when (assoc new eqlist)
+ (user-error "\"%s=\" formula tries to overwrite \
+existing formula for column %s"
+ old-lhs
+ new))
+ new))
+ (t old-lhs)))))
+ (if (string-match-p "\\`\\$[0-9]+\\'" lhs)
+ (push (cons lhs rhs) eqlcol)
+ (push (cons lhs rhs) eqlfield))))
+ (setq eqlcol (nreverse eqlcol))
+ ;; Expand ranges in lhs of formulas
+ (setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))
+ ;; Get the correct line range to process.
+ (if all
+ (progn
+ (setq end (copy-marker (org-table-end)))
+ (goto-char (setq beg org-table-current-begin-pos))
+ (cond
+ ((re-search-forward org-table-calculate-mark-regexp end t)
+ ;; This is a table with marked lines, compute selected
+ ;; lines.
+ (setq line-re org-table-recalculate-regexp))
+ ;; Move forward to the first non-header line.
+ ((and (re-search-forward org-table-dataline-regexp end t)
+ (re-search-forward org-table-hline-regexp end t)
+ (re-search-forward org-table-dataline-regexp end t))
+ (setq beg (match-beginning 0)))
+ ;; Just leave BEG at the start of the table.
+ (t nil)))
+ (setq beg (line-beginning-position)
+ end (copy-marker (line-beginning-position 2))))
+ (goto-char beg)
+ ;; Mark named fields untouchable. Also check if several
+ ;; field/range formulas try to set the same field.
+ (remove-text-properties beg end '(:org-untouchable t))
+ (let ((current-line (count-lines org-table-current-begin-pos
+ (line-beginning-position)))
+ seen-fields)
+ (dolist (eq eqlfield)
+ (let* ((name (car eq))
+ (location (assoc name org-table-named-field-locations))
+ (eq-line (or (nth 1 location)
+ (and (string-match "\\`@\\([0-9]+\\)" name)
+ (aref org-table-dlines
+ (string-to-number
+ (match-string 1 name))))))
+ (reference
+ (if location
+ ;; Turn field coordinates associated to NAME
+ ;; into an absolute reference.
+ (format "@%d$%d"
+ (org-table-line-to-dline eq-line)
+ (nth 2 location))
+ name)))
+ (when (member reference seen-fields)
+ (user-error "Several field/range formulas try to set %s"
+ reference))
+ (push reference seen-fields)
+ (when (or all (eq eq-line current-line))
+ (org-table-goto-field name)
+ (org-table-put-field-property :org-untouchable t)))))
+ ;; Evaluate the column formulas, but skip fields covered by
+ ;; field formulas.
+ (goto-char beg)
+ (while (re-search-forward line-re end t)
+ (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
+ ;; Unprotected line, recalculate.
+ (cl-incf cnt)
+ (when all
+ (setq log-last-time
+ (org-table-message-once-per-second
+ log-last-time
+ "Re-applying formulas to full table...(line %d)" cnt)))
+ (if (markerp org-last-recalc-line)
+ (move-marker org-last-recalc-line (line-beginning-position))
+ (setq org-last-recalc-line
+ (copy-marker (line-beginning-position))))
+ (dolist (entry eqlcol)
+ (goto-char org-last-recalc-line)
+ (org-table-goto-column
+ (string-to-number (substring (car entry) 1)) nil 'force)
+ (unless (get-text-property (point) :org-untouchable)
+ (org-table-eval-formula
+ nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
+ ;; Evaluate the field formulas.
+ (dolist (eq eqlfield)
+ (let ((reference (car eq))
+ (formula (cdr eq)))
+ (setq log-last-time
+ (org-table-message-once-per-second
+ (and all log-last-time)
+ "Re-applying formula to field: %s" (car eq)))
+ (org-table-goto-field
+ reference
+ ;; Possibly create a new column, as long as
+ ;; `org-table-formula-create-columns' allows it.
+ (let ((column-count (progn (end-of-line)
+ (1- (org-table-current-column)))))
+ (lambda (column)
+ (when (> column 1000)
+ (user-error "Formula column target too large"))
+ (and (> column column-count)
+ (or (eq org-table-formula-create-columns t)
+ (and (eq org-table-formula-create-columns 'warn)
+ (progn
+ (org-display-warning
+ "Out-of-bounds formula added columns")
+ t))
+ (and (eq org-table-formula-create-columns 'prompt)
+ (yes-or-no-p
+ "Out-of-bounds formula. Add columns? ")))))))
+ (org-table-eval-formula nil formula t t t t))))
+ ;; Clean up markers and internal text property.
+ (remove-text-properties (point-min) (point-max) '(org-untouchable t))
+ (set-marker end nil)
+ (unless noalign
+ (when org-table-may-need-update (org-table-align))
+ (when all
+ (org-table-message-once-per-second
+ log-first-time "Re-applying formulas to %d lines... done" cnt)))
+ (org-table-message-once-per-second
+ (and all log-first-time) "Re-applying formulas... done")))))
;;;###autoload
(defun org-table-iterate (&optional arg)
@@ -3145,10 +3354,15 @@ with the prefix ARG."
(defun org-table-recalculate-buffer-tables ()
"Recalculate all tables in the current buffer."
(interactive)
- (save-excursion
- (save-restriction
- (widen)
- (org-table-map-tables (lambda () (org-table-recalculate t)) t))))
+ (org-with-wide-buffer
+ (org-table-map-tables
+ (lambda ()
+ ;; Reason for separate `org-table-align': When repeating
+ ;; (org-table-recalculate t) `org-table-may-need-update' gets in
+ ;; the way.
+ (org-table-recalculate t t)
+ (org-table-align))
+ t)))
;;;###autoload
(defun org-table-iterate-buffer-tables ()
@@ -3158,85 +3372,90 @@ with the prefix ARG."
(i imax)
(checksum (md5 (buffer-string)))
c1)
- (save-excursion
- (save-restriction
- (widen)
- (catch 'exit
- (while (> i 0)
- (setq i (1- i))
- (org-table-map-tables (lambda () (org-table-recalculate t)) t)
- (if (equal checksum (setq c1 (md5 (buffer-string))))
- (progn
- (message "Convergence after %d iterations" (- imax i))
- (throw 'exit t))
- (setq checksum c1)))
- (user-error "No convergence after %d iterations" imax))))))
+ (org-with-wide-buffer
+ (catch 'exit
+ (while (> i 0)
+ (setq i (1- i))
+ (org-table-map-tables (lambda () (org-table-recalculate t t)) t)
+ (if (equal checksum (setq c1 (md5 (buffer-string))))
+ (progn
+ (org-table-map-tables #'org-table-align t)
+ (message "Convergence after %d iterations" (- imax i))
+ (throw 'exit t))
+ (setq checksum c1)))
+ (org-table-map-tables #'org-table-align t)
+ (user-error "No convergence after %d iterations" imax)))))
(defun org-table-calc-current-TBLFM (&optional arg)
"Apply the #+TBLFM in the line at point to the table."
(interactive "P")
(unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line"))
(let ((formula (buffer-substring
- (point-at-bol)
- (point-at-eol)))
- s e)
+ (line-beginning-position)
+ (line-end-position))))
(save-excursion
;; Insert a temporary formula at right after the table
(goto-char (org-table-TBLFM-begin))
- (setq s (point-marker))
- (insert (concat formula "\n"))
- (setq e (point-marker))
- ;; Recalculate the table
- (beginning-of-line 0) ; move to the inserted line
- (skip-chars-backward " \r\n\t")
- (if (org-at-table-p)
+ (let ((s (point-marker)))
+ (insert formula "\n")
+ (let ((e (point-marker)))
+ ;; Recalculate the table.
+ (beginning-of-line 0) ; move to the inserted line
+ (skip-chars-backward " \r\n\t")
(unwind-protect
- (org-call-with-arg 'org-table-recalculate (or arg t))
- ;; delete the formula inserted temporarily
- (delete-region s e))))))
+ (org-call-with-arg #'org-table-recalculate (or arg t))
+ ;; Delete the formula inserted temporarily.
+ (delete-region s e)
+ (set-marker s nil)
+ (set-marker e nil)))))))
(defun org-table-TBLFM-begin ()
"Find the beginning of the TBLFM lines and return its position.
Return nil when the beginning of TBLFM line was not found."
(save-excursion
(when (progn (forward-line 1)
- (re-search-backward
- org-table-TBLFM-begin-regexp
- nil t))
- (point-at-bol 2))))
+ (re-search-backward org-table-TBLFM-begin-regexp nil t))
+ (line-beginning-position 2))))
(defun org-table-expand-lhs-ranges (equations)
"Expand list of formulas.
-If some of the RHS in the formulas are ranges or a row reference, expand
-them to individual field equations for each field."
- (let (e res lhs rhs range r1 r2 c1 c2)
- (while (setq e (pop equations))
- (setq lhs (car e) rhs (cdr e))
- (cond
- ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs)
- ;; This just refers to one fixed field
- (push e res))
- ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs)
- ;; This just refers to one fixed named field
- (push e res))
- ((string-match "^@[0-9]+$" lhs)
- (loop for ic from 1 to org-table-current-ncol do
- (push (cons (format "%s$%d" lhs ic) rhs) res)
- (put-text-property 0 (length (caar res))
- :orig-eqn e (caar res))))
- (t
- (setq range (org-table-get-range lhs org-table-current-begin-pos
- 1 nil 'corners))
- (setq r1 (nth 0 range) c1 (nth 1 range)
- r2 (nth 2 range) c2 (nth 3 range))
- (setq r1 (org-table-line-to-dline r1))
- (setq r2 (org-table-line-to-dline r2 'above))
- (loop for ir from r1 to r2 do
- (loop for ic from c1 to c2 do
- (push (cons (format "@%d$%d" ir ic) rhs) res)
- (put-text-property 0 (length (caar res))
- :orig-eqn e (caar res)))))))
- (nreverse res)))
+If some of the RHS in the formulas are ranges or a row reference,
+expand them to individual field equations for each field. This
+function assumes the table is already analyzed (i.e., using
+`org-table-analyze')."
+ (let (res)
+ (dolist (e equations (nreverse res))
+ (let ((lhs (car e))
+ (rhs (cdr e)))
+ (cond
+ ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
+ ;; This just refers to one fixed field.
+ (push e res))
+ ((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
+ ;; This just refers to one fixed named field.
+ (push e res))
+ ((string-match-p "\\`\\$[0-9]+\\'" lhs)
+ ;; Column formulas are treated specially and are not
+ ;; expanded.
+ (push e res))
+ ((string-match "\\`@[0-9]+\\'" lhs)
+ (dotimes (ic org-table-current-ncol)
+ (push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e)
+ rhs)
+ res)))
+ (t
+ (let* ((range (org-table-get-range
+ lhs org-table-current-begin-pos 1 nil 'corners))
+ (r1 (org-table-line-to-dline (nth 0 range)))
+ (c1 (nth 1 range))
+ (r2 (org-table-line-to-dline (nth 2 range) 'above))
+ (c2 (nth 3 range)))
+ (cl-loop for ir from r1 to r2 do
+ (cl-loop for ic from c1 to c2 do
+ (push (cons (propertize
+ (format "@%d$%d" ir ic) :orig-eqn e)
+ rhs)
+ res))))))))))
(defun org-table-formula-handle-first/last-rc (s)
"Replace @<, @>, $<, $> with first/last row/column of the table.
@@ -3262,32 +3481,40 @@ borders of the table using the @< @> $< $> makers."
(- nmax len -1)))
(if (or (< n 1) (> n nmax))
(user-error "Reference \"%s\" in expression \"%s\" points outside table"
- (match-string 0 s) s))
+ (match-string 0 s) s))
(setq start (match-beginning 0))
(setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
s)
(defun org-table-formula-substitute-names (f)
"Replace $const with values in string F."
- (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
- ;; First, check for column names
- (while (setq start (string-match org-table-column-name-regexp f start))
- (setq start (1+ start))
- (setq a (assoc (match-string 1 f) org-table-column-names))
- (setq f (replace-match (concat "$" (cdr a)) t t f)))
- ;; Parameters and constants
- (setq start 0)
- (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" f start))
- (if (match-end 2)
- (setq start (match-end 2))
- (setq start (1+ start))
- (if (setq a (save-match-data
- (org-table-get-constant (match-string 1 f))))
- (setq f (replace-match
- (concat (if pp "(") a (if pp ")")) t t f)))))
- (if org-table-formula-debug
- (put-text-property 0 (length f) :orig-formula f1 f))
- f))
+ (let ((start 0)
+ (pp (/= (string-to-char f) ?'))
+ (duration (string-match-p ";.*[Tt].*\\'" f))
+ (new (replace-regexp-in-string ; Check for column names.
+ org-table-column-name-regexp
+ (lambda (m)
+ (concat "$" (cdr (assoc (match-string 1 m)
+ org-table-column-names))))
+ f t t)))
+ ;; Parameters and constants.
+ (while (setq start
+ (string-match
+ "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)"
+ new start))
+ (if (match-end 2) (setq start (match-end 2))
+ (cl-incf start)
+ ;; When a duration is expected, convert value on the fly.
+ (let ((value
+ (save-match-data
+ (let ((v (org-table-get-constant (match-string 1 new))))
+ (if (and (org-string-nw-p v) duration)
+ (org-table-time-string-to-seconds v)
+ v)))))
+ (when value
+ (setq new (replace-match
+ (concat (and pp "(") value (and pp ")")) t t new))))))
+ (if org-table-formula-debug (propertize new :orig-formula f) new)))
(defun org-table-get-constant (const)
"Find the value for a parameter or constant in a formula.
@@ -3353,66 +3580,75 @@ Parameters get priority."
:style toggle :selected org-table-buffer-is-an]))
(defvar org-pos)
+(defvar org-table--fedit-source nil
+ "Position of the TBLFM line being edited.")
;;;###autoload
(defun org-table-edit-formulas ()
"Edit the formulas of the current table in a separate buffer."
(interactive)
- (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM")))
- (beginning-of-line 0))
- (unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-get-specials)
- (let ((key (org-table-current-field-formula 'key 'noerror))
- (eql (sort (org-table-get-stored-formulas 'noerror)
- 'org-table-formula-less-p))
- (pos (point-marker))
- (startline 1)
- (wc (current-window-configuration))
- (sel-win (selected-window))
- (titles '((column . "# Column Formulas\n")
- (field . "# Field and Range Formulas\n")
- (named . "# Named Field Formulas\n")))
- entry s type title)
- (org-switch-to-buffer-other-window "*Edit Formulas*")
- (erase-buffer)
- ;; Keep global-font-lock-mode from turning on font-lock-mode
- (let ((font-lock-global-modes '(not fundamental-mode)))
- (fundamental-mode))
- (org-set-local 'font-lock-global-modes (list 'not major-mode))
- (org-set-local 'org-pos pos)
- (org-set-local 'org-window-configuration wc)
- (org-set-local 'org-selected-window sel-win)
- (use-local-map org-table-fedit-map)
- (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t)
- (easy-menu-add org-table-fedit-menu)
- (setq startline (org-current-line))
- (while (setq entry (pop eql))
- (setq type (cond
- ((string-match "\\`$[<>]" (car entry)) 'column)
- ((equal (string-to-char (car entry)) ?@) 'field)
- ((string-match "^[0-9]" (car entry)) 'column)
- (t 'named)))
- (when (setq title (assq type titles))
- (or (bobp) (insert "\n"))
- (insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
- (setq titles (remove title titles)))
- (if (equal key (car entry)) (setq startline (org-current-line)))
- (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$")
- (car entry) " = " (cdr entry) "\n"))
- (remove-text-properties 0 (length s) '(face nil) s)
- (insert s))
- (if (eq org-table-use-standard-references t)
+ (let ((at-tblfm (org-at-TBLFM-p)))
+ (unless (or at-tblfm (org-at-table-p))
+ (user-error "Not at a table"))
+ (save-excursion
+ ;; Move point within the table before analyzing it.
+ (when at-tblfm (re-search-backward "^[ \t]*|"))
+ (org-table-analyze))
+ (let ((key (org-table-current-field-formula 'key 'noerror))
+ (eql (sort (org-table-get-stored-formulas t (and at-tblfm (point)))
+ #'org-table-formula-less-p))
+ (pos (point-marker))
+ (source (copy-marker (line-beginning-position)))
+ (startline 1)
+ (wc (current-window-configuration))
+ (sel-win (selected-window))
+ (titles '((column . "# Column Formulas\n")
+ (field . "# Field and Range Formulas\n")
+ (named . "# Named Field Formulas\n"))))
+ (org-switch-to-buffer-other-window "*Edit Formulas*")
+ (erase-buffer)
+ ;; Keep global-font-lock-mode from turning on font-lock-mode
+ (let ((font-lock-global-modes '(not fundamental-mode)))
+ (fundamental-mode))
+ (setq-local font-lock-global-modes (list 'not major-mode))
+ (setq-local org-pos pos)
+ (setq-local org-table--fedit-source source)
+ (setq-local org-window-configuration wc)
+ (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
+ ((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry))
+ 'column)
+ ((equal (string-to-char (car entry)) ?@) 'field)
+ (t 'named)))
+ (title (assq type titles)))
+ (when title
+ (unless (bobp) (insert "\n"))
+ (insert
+ (org-add-props (cdr title) nil 'face font-lock-comment-face))
+ (setq titles (remove title titles)))
+ (when (equal key (car entry)) (setq startline (org-current-line)))
+ (let ((s (concat
+ (if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$")
+ (car entry) " = " (cdr entry) "\n")))
+ (remove-text-properties 0 (length s) '(face nil) s)
+ (insert s))))
+ (when (eq org-table-use-standard-references t)
(org-table-fedit-toggle-ref-type))
- (org-goto-line startline)
- (message "%s" "Edit formulas, finish with C-c C-c or C-c '. See menu for more commands.")))
+ (org-goto-line startline)
+ (message "%s" (substitute-command-keys "\\<org-mode-map>\
+Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \
+See menu for more commands.")))))
(defun org-table-fedit-post-command ()
(when (not (memq this-command '(lisp-complete-symbol)))
(let ((win (selected-window)))
(save-excursion
- (condition-case nil
- (org-table-show-reference)
- (error nil))
+ (ignore-errors (org-table-show-reference))
(select-window win)))))
(defun org-table-formula-to-user (s)
@@ -3537,23 +3773,34 @@ minutes or seconds."
(format "%.1f" (/ (float secs0) 60)))
((eq output-format 'seconds)
(format "%d" secs0))
- (t (org-format-seconds "%.2h:%.2m:%.2s" secs0)))))
+ ((eq output-format 'hh:mm)
+ ;; Ignore seconds
+ (substring (format-seconds
+ (if org-table-duration-hour-zero-padding
+ "%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
+ secs0)
+ 0 -3))
+ (t (format-seconds
+ (if org-table-duration-hour-zero-padding
+ "%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
+ secs0)))))
(if (< secs 0) (concat "-" res) res)))
(defun org-table-fedit-convert-buffer (function)
"Convert all references in this buffer, using FUNCTION."
- (let ((line (org-current-line)))
+ (let ((origin (copy-marker (line-beginning-position))))
(goto-char (point-min))
(while (not (eobp))
- (insert (funcall function (buffer-substring (point) (point-at-eol))))
- (delete-region (point) (point-at-eol))
- (or (eobp) (forward-char 1)))
- (org-goto-line line)))
+ (insert (funcall function (buffer-substring (point) (line-end-position))))
+ (delete-region (point) (line-end-position))
+ (forward-line))
+ (goto-char origin)
+ (set-marker origin nil)))
(defun org-table-fedit-toggle-ref-type ()
"Convert all references in the buffer from B3 to @3$2 and back."
(interactive)
- (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an))
+ (setq-local org-table-buffer-is-an (not org-table-buffer-is-an))
(org-table-fedit-convert-buffer
(if org-table-buffer-is-an
'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
@@ -3579,16 +3826,16 @@ minutes or seconds."
(defun org-table-fedit-shift-reference (dir)
(cond
- ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&")
+ ((org-in-regexp "\\(\\<[a-zA-Z]\\)&")
(if (memq dir '(left right))
(org-rematch-and-replace 1 (eq dir 'left))
(user-error "Cannot shift reference in this direction")))
- ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
+ ((org-in-regexp "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
;; A B3-like reference
(if (memq dir '(up down))
(org-rematch-and-replace 2 (eq dir 'up))
(org-rematch-and-replace 1 (eq dir 'left))))
- ((org-at-regexp-p
+ ((org-in-regexp
"\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?")
;; An internal reference
(if (memq dir '(up down))
@@ -3649,32 +3896,31 @@ a translation reference."
With prefix ARG, apply the new formulas to the table."
(interactive "P")
(org-table-remove-rectangle-highlight)
- (if org-table-use-standard-references
- (progn
- (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
- (setq org-table-buffer-is-an nil)))
- (let ((pos org-pos) (sel-win org-selected-window) eql var form)
+ (when org-table-use-standard-references
+ (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
+ (setq org-table-buffer-is-an nil))
+ (let ((pos org-pos)
+ (sel-win org-selected-window)
+ (source org-table--fedit-source)
+ eql)
(goto-char (point-min))
(while (re-search-forward
"^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
nil t)
- (setq var (if (match-end 2) (match-string 2) (match-string 1))
- form (match-string 3))
- (setq form (org-trim form))
- (when (not (equal form ""))
- (while (string-match "[ \t]*\n[ \t]*" form)
- (setq form (replace-match " " t t form)))
- (when (assoc var eql)
- (user-error "Double formulas for %s" var))
- (push (cons var form) eql)))
- (setq org-pos nil)
+ (let ((var (match-string 1))
+ (form (org-trim (match-string 3))))
+ (unless (equal form "")
+ (while (string-match "[ \t]*\n[ \t]*" form)
+ (setq form (replace-match " " t t form)))
+ (when (assoc var eql)
+ (user-error "Double formulas for %s" var))
+ (push (cons var form) eql))))
(set-window-configuration org-window-configuration)
(select-window sel-win)
- (goto-char pos)
- (unless (org-at-table-p)
- (user-error "Lost table position - cannot install formulas"))
+ (goto-char source)
(org-table-store-formulas eql)
- (move-marker pos nil)
+ (set-marker pos nil)
+ (set-marker source nil)
(kill-buffer "*Edit Formulas*")
(if arg
(org-table-recalculate 'all)
@@ -3733,9 +3979,11 @@ With prefix ARG, apply the new formulas to the table."
(defvar org-show-positions nil)
(defun org-table-show-reference (&optional local)
- "Show the location/value of the $ expression at point."
+ "Show the location/value of the $ expression at point.
+When LOCAL is non-nil, show references for the table at point."
(interactive)
(org-table-remove-rectangle-highlight)
+ (when local (org-table-analyze))
(catch 'exit
(let ((pos (if local (point) org-pos))
(face2 'highlight)
@@ -3743,41 +3991,41 @@ With prefix ARG, apply the new formulas to the table."
(win (selected-window))
(org-show-positions nil)
var name e what match dest)
- (if local (org-table-get-specials))
(setq what (cond
- ((org-at-regexp-p "^@[0-9]+[ \t=]")
+ ((org-in-regexp "^@[0-9]+[ \t=]")
(setq match (concat (substring (match-string 0) 0 -1)
"$1.."
(substring (match-string 0) 0 -1)
"$100"))
'range)
- ((or (org-at-regexp-p org-table-range-regexp2)
- (org-at-regexp-p org-table-translate-regexp)
- (org-at-regexp-p org-table-range-regexp))
+ ((or (org-in-regexp org-table-range-regexp2)
+ (org-in-regexp org-table-translate-regexp)
+ (org-in-regexp org-table-range-regexp))
(setq match
(save-match-data
(org-table-convert-refs-to-rc (match-string 0))))
'range)
- ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
- ((org-at-regexp-p "\\$[0-9]+") 'column)
+ ((org-in-regexp "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
+ ((org-in-regexp "\\$[0-9]+") 'column)
((not local) nil)
(t (user-error "No reference at point")))
match (and what (or match (match-string 0))))
(when (and match (not (equal (match-beginning 0) (point-at-bol))))
(org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
'secondary-selection))
- (org-add-hook 'before-change-functions
- 'org-table-remove-rectangle-highlight)
- (if (eq what 'name) (setq var (substring match 1)))
+ (add-hook 'before-change-functions
+ #'org-table-remove-rectangle-highlight)
+ (when (eq what 'name) (setq var (substring match 1)))
(when (eq what 'range)
- (or (equal (string-to-char match) ?@) (setq match (concat "@" match)))
+ (unless (eq (string-to-char match) ?@) (setq match (concat "@" match)))
(setq match (org-table-formula-substitute-names match)))
(unless local
(save-excursion
- (end-of-line 1)
+ (end-of-line)
(re-search-backward "^\\S-" nil t)
- (beginning-of-line 1)
- (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=")
+ (beginning-of-line)
+ (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\
+\\([0-9]+\\|&\\)\\) *=")
(setq dest
(save-match-data
(org-table-convert-refs-to-rc (match-string 1))))
@@ -3790,60 +4038,52 @@ With prefix ARG, apply the new formulas to the table."
(marker-buffer pos)))))
(goto-char pos)
(org-table-force-dataline)
- (when dest
- (setq name (substring dest 1))
- (cond
- ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest)
- (setq e (assoc name org-table-named-field-locations))
- (org-goto-line (nth 1 e))
- (org-table-goto-column (nth 2 e)))
- ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest)
- (let ((l (string-to-number (match-string 1 dest)))
- (c (string-to-number (match-string 2 dest))))
- (org-goto-line (aref org-table-dlines l))
- (org-table-goto-column c)))
- (t (org-table-goto-column (string-to-number name))))
- (move-marker pos (point))
- (org-table-highlight-rectangle nil nil face2))
- (cond
- ((equal dest match))
- ((not match))
- ((eq what 'range)
- (condition-case nil
- (save-excursion
- (org-table-get-range match nil nil 'highlight))
- (error nil)))
- ((setq e (assoc var org-table-named-field-locations))
- (org-goto-line (nth 1 e))
- (org-table-goto-column (nth 2 e))
- (org-table-highlight-rectangle (point) (point))
- (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
- ((setq e (assoc var org-table-column-names))
- (org-table-goto-column (string-to-number (cdr e)))
- (org-table-highlight-rectangle (point) (point))
- (goto-char (org-table-begin))
- (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
- (org-table-end) t)
- (progn
- (goto-char (match-beginning 1))
- (org-table-highlight-rectangle)
- (message "Named column (column %s)" (cdr e)))
- (user-error "Column name not found")))
- ((eq what 'column)
- ;; column number
- (org-table-goto-column (string-to-number (substring match 1)))
- (org-table-highlight-rectangle (point) (point))
- (message "Column %s" (substring match 1)))
- ((setq e (assoc var org-table-local-parameters))
- (goto-char (org-table-begin))
- (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
- (progn
- (goto-char (match-beginning 1))
- (org-table-highlight-rectangle)
- (message "Local parameter."))
- (user-error "Parameter not found")))
- (t
+ (let ((table-start
+ (if local org-table-current-begin-pos (org-table-begin))))
+ (when dest
+ (setq name (substring dest 1))
+ (cond
+ ((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest)
+ (org-table-goto-field dest))
+ ((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'"
+ dest)
+ (org-table-goto-field dest))
+ (t (org-table-goto-column (string-to-number name))))
+ (move-marker pos (point))
+ (org-table-highlight-rectangle nil nil face2))
(cond
+ ((equal dest match))
+ ((not match))
+ ((eq what 'range)
+ (ignore-errors (org-table-get-range match table-start nil 'highlight)))
+ ((setq e (assoc var org-table-named-field-locations))
+ (org-table-goto-field var)
+ (org-table-highlight-rectangle)
+ (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
+ ((setq e (assoc var org-table-column-names))
+ (org-table-goto-column (string-to-number (cdr e)))
+ (org-table-highlight-rectangle)
+ (goto-char table-start)
+ (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
+ (org-table-end) t)
+ (progn
+ (goto-char (match-beginning 1))
+ (org-table-highlight-rectangle)
+ (message "Named column (column %s)" (cdr e)))
+ (user-error "Column name not found")))
+ ((eq what 'column)
+ ;; Column number.
+ (org-table-goto-column (string-to-number (substring match 1)))
+ (org-table-highlight-rectangle)
+ (message "Column %s" (substring match 1)))
+ ((setq e (assoc var org-table-local-parameters))
+ (goto-char table-start)
+ (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
+ (progn
+ (goto-char (match-beginning 1))
+ (org-table-highlight-rectangle)
+ (message "Local parameter."))
+ (user-error "Parameter not found")))
((not var) (user-error "No reference at point"))
((setq e (assoc var org-table-formula-constants-local))
(message "Local Constant: $%s=%s in #+CONSTANTS line."
@@ -3854,19 +4094,19 @@ With prefix ARG, apply the new formulas to the table."
((setq e (and (fboundp 'constants-get) (constants-get var)))
(message "Constant: $%s=%s, from `constants.el'%s."
var e (format " (%s units)" constants-unit-system)))
- (t (user-error "Undefined name $%s" var)))))
- (goto-char pos)
- (when (and org-show-positions
- (not (memq this-command '(org-table-fedit-scroll
- org-table-fedit-scroll-down))))
- (push pos org-show-positions)
- (push org-table-current-begin-pos org-show-positions)
- (let ((min (apply 'min org-show-positions))
- (max (apply 'max org-show-positions)))
- (set-window-start (selected-window) min)
- (goto-char max)
- (or (pos-visible-in-window-p max)
- (set-window-start (selected-window) max))))
+ (t (user-error "Undefined name $%s" var)))
+ (goto-char pos)
+ (when (and org-show-positions
+ (not (memq this-command '(org-table-fedit-scroll
+ org-table-fedit-scroll-down))))
+ (push pos org-show-positions)
+ (push table-start org-show-positions)
+ (let ((min (apply 'min org-show-positions))
+ (max (apply 'max org-show-positions)))
+ (set-window-start (selected-window) min)
+ (goto-char max)
+ (or (pos-visible-in-window-p max)
+ (set-window-start (selected-window) max)))))
(select-window win))))
(defun org-table-force-dataline ()
@@ -3926,43 +4166,49 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
(push ov org-table-rectangle-overlays)))
(defun org-table-highlight-rectangle (&optional beg end face)
- "Highlight rectangular region in a table."
- (setq beg (or beg (point)) end (or end (point)))
- (let ((b (min beg end))
- (e (max beg end))
- l1 c1 l2 c2 tmp)
- (and (boundp 'org-show-positions)
- (setq org-show-positions (cons b (cons e org-show-positions))))
- (goto-char (min beg end))
- (setq l1 (org-current-line)
- c1 (org-table-current-column))
- (goto-char (max beg end))
- (setq l2 (org-current-line)
- c2 (org-table-current-column))
- (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp))
- (org-goto-line l1)
- (beginning-of-line 1)
- (loop for line from l1 to l2 do
- (when (looking-at org-table-dataline-regexp)
- (org-table-goto-column c1)
- (skip-chars-backward "^|\n") (setq beg (point))
- (org-table-goto-column c2)
- (skip-chars-forward "^|\n") (setq end (point))
- (org-table-add-rectangle-overlay beg end face))
- (beginning-of-line 2))
- (goto-char b))
- (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight))
-
-(defun org-table-remove-rectangle-highlight (&rest ignore)
+ "Highlight rectangular region in a table.
+When buffer positions BEG and END are provided, use them to
+delimit the region to highlight. Otherwise, refer to point. Use
+FACE, when non-nil, for the highlight."
+ (let* ((beg (or beg (point)))
+ (end (or end (point)))
+ (b (min beg end))
+ (e (max beg end))
+ (start-coordinates
+ (save-excursion
+ (goto-char b)
+ (cons (line-beginning-position) (org-table-current-column))))
+ (end-coordinates
+ (save-excursion
+ (goto-char e)
+ (cons (line-beginning-position) (org-table-current-column)))))
+ (when (boundp 'org-show-positions)
+ (setq org-show-positions (cons b (cons e org-show-positions))))
+ (goto-char (car start-coordinates))
+ (let ((column-start (min (cdr start-coordinates) (cdr end-coordinates)))
+ (column-end (max (cdr start-coordinates) (cdr end-coordinates)))
+ (last-row (car end-coordinates)))
+ (while (<= (point) last-row)
+ (when (looking-at org-table-dataline-regexp)
+ (org-table-goto-column column-start)
+ (skip-chars-backward "^|\n")
+ (let ((p (point)))
+ (org-table-goto-column column-end)
+ (skip-chars-forward "^|\n")
+ (org-table-add-rectangle-overlay p (point) face)))
+ (forward-line)))
+ (goto-char (car start-coordinates)))
+ (add-hook 'before-change-functions #'org-table-remove-rectangle-highlight))
+
+(defun org-table-remove-rectangle-highlight (&rest _ignore)
"Remove the rectangle overlays."
(unless org-inhibit-highlight-removal
(remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
(mapc 'delete-overlay org-table-rectangle-overlays)
(setq org-table-rectangle-overlays nil)))
-(defvar org-table-coordinate-overlays nil
+(defvar-local org-table-coordinate-overlays nil
"Collects the coordinate grid overlays, so that they can be removed.")
-(make-variable-buffer-local 'org-table-coordinate-overlays)
(defun org-table-overlay-coordinates ()
"Add overlays to the table at point, to show row/column coordinates."
@@ -4017,19 +4263,20 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
;;; The orgtbl minor mode
;; Define a minor mode which can be used in other modes in order to
-;; integrate the org-mode table editor.
-
-;; This is really a hack, because the org-mode table editor uses several
-;; keys which normally belong to the major mode, for example the TAB and
-;; RET keys. Here is how it works: The minor mode defines all the keys
-;; necessary to operate the table editor, but wraps the commands into a
-;; function which tests if the cursor is currently inside a table. If that
-;; is the case, the table editor command is executed. However, when any of
-;; those keys is used outside a table, the function uses `key-binding' to
-;; look up if the key has an associated command in another currently active
-;; keymap (minor modes, major mode, global), and executes that command.
-;; There might be problems if any of the keys used by the table editor is
-;; otherwise used as a prefix key.
+;; integrate the Org table editor.
+
+;; This is really a hack, because the Org table editor uses several
+;; keys which normally belong to the major mode, for example the TAB
+;; and RET keys. Here is how it works: The minor mode defines all the
+;; keys necessary to operate the table editor, but wraps the commands
+;; into a function which tests if the cursor is currently inside
+;; a table. If that is the case, the table editor command is
+;; executed. However, when any of those keys is used outside a table,
+;; the function uses `key-binding' to look up if the key has an
+;; associated command in another currently active keymap (minor modes,
+;; major mode, global), and executes that command. There might be
+;; problems if any of the keys used by the table editor is otherwise
+;; used as a prefix key.
;; Another challenge is that the key binding for TAB can be tab or \C-i,
;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
@@ -4079,16 +4326,16 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line."
;; FIXME: maybe it should use emulation-mode-map-alists?
(and c (setq minor-mode-map-alist
(cons c (delq c minor-mode-map-alist)))))
- (org-set-local (quote org-table-may-need-update) t)
- (org-add-hook 'before-change-functions 'org-before-change-function
- nil 'local)
- (org-set-local 'org-old-auto-fill-inhibit-regexp
- auto-fill-inhibit-regexp)
- (org-set-local 'auto-fill-inhibit-regexp
- (if auto-fill-inhibit-regexp
- (concat orgtbl-line-start-regexp "\\|"
- auto-fill-inhibit-regexp)
- orgtbl-line-start-regexp))
+ (setq-local org-table-may-need-update t)
+ (add-hook 'before-change-functions 'org-before-change-function
+ nil 'local)
+ (setq-local org-old-auto-fill-inhibit-regexp
+ auto-fill-inhibit-regexp)
+ (setq-local auto-fill-inhibit-regexp
+ (if auto-fill-inhibit-regexp
+ (concat orgtbl-line-start-regexp "\\|"
+ auto-fill-inhibit-regexp)
+ orgtbl-line-start-regexp))
(add-to-invisibility-spec '(org-cwidth))
(when (fboundp 'font-lock-add-keywords)
(font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
@@ -4188,27 +4435,26 @@ to execute outside of tables."
cmd (orgtbl-make-binding fun nfunc key))
(org-defkey orgtbl-mode-map key cmd))
- ;; Special treatment needed for TAB and RET
+ ;; Special treatment needed for TAB, RET and DEL
(org-defkey orgtbl-mode-map [(return)]
(orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
(org-defkey orgtbl-mode-map "\C-m"
(orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
-
(org-defkey orgtbl-mode-map [(tab)]
(orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
(org-defkey orgtbl-mode-map "\C-i"
(orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
-
(org-defkey orgtbl-mode-map [(shift tab)]
(orgtbl-make-binding 'org-table-previous-field 104
[(shift tab)] [(tab)] "\C-i"))
+ (org-defkey orgtbl-mode-map [backspace]
+ (orgtbl-make-binding 'org-delete-backward-char 109
+ [backspace] (kbd "DEL")))
-
- (unless (featurep 'xemacs)
- (org-defkey orgtbl-mode-map [S-iso-lefttab]
- (orgtbl-make-binding 'org-table-previous-field 107
- [S-iso-lefttab] [backtab] [(shift tab)]
- [(tab)] "\C-i")))
+ (org-defkey orgtbl-mode-map [S-iso-lefttab]
+ (orgtbl-make-binding 'org-table-previous-field 107
+ [S-iso-lefttab] [backtab] [(shift tab)]
+ [(tab)] "\C-i"))
(org-defkey orgtbl-mode-map [backtab]
(orgtbl-make-binding 'org-table-previous-field 108
@@ -4290,7 +4536,10 @@ to execute outside of tables."
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"])))
t))
(defun orgtbl-ctrl-c-ctrl-c (arg)
@@ -4316,7 +4565,6 @@ With prefix arg, also recompute table."
(when (orgtbl-send-table 'maybe)
(run-hooks 'orgtbl-after-send-table-hook)))
((eq action 'recalc)
- (org-table-set-constants)
(save-excursion
(beginning-of-line 1)
(skip-chars-backward " \r\n\t")
@@ -4325,7 +4573,7 @@ With prefix arg, also recompute table."
(t (let (orgtbl-mode)
(call-interactively (key-binding "\C-c\C-c")))))))
-(defun orgtbl-create-or-convert-from-region (arg)
+(defun orgtbl-create-or-convert-from-region (_arg)
"Create table or convert region to table, if no conflicting binding.
This installs the table binding `C-c |', but only if there is no
conflicting binding to this key outside orgtbl-mode."
@@ -4369,11 +4617,9 @@ overwritten, and the table is not marked as requiring realignment."
(org-table-blank-field))
t)
(eq N 1)
- (looking-at "[^|\n]* +|"))
+ (looking-at "[^|\n]* \\( \\)|"))
(let (org-table-may-need-update)
- (goto-char (1- (match-end 0)))
- (org-delete-backward-char 1)
- (goto-char (match-beginning 0))
+ (delete-region (match-beginning 1) (match-end 1))
(self-insert-command N))
(setq org-table-may-need-update t)
(let* (orgtbl-mode
@@ -4398,6 +4644,7 @@ overwritten, and the table is not marked as requiring realignment."
(setq org-self-insert-command-undo-counter
(1+ org-self-insert-command-undo-counter))))))))
+;;;###autoload
(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
"Regular expression matching exponentials as produced by calc.")
@@ -4418,23 +4665,24 @@ a radio table."
(beginning-of-line 0)))
rtn)))
-(defun orgtbl-send-replace-tbl (name txt)
- "Find and replace table NAME with TXT."
+(defun orgtbl-send-replace-tbl (name text)
+ "Find and replace table NAME with TEXT."
(save-excursion
(goto-char (point-min))
- (unless (re-search-forward
- (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
- (user-error "Don't know where to insert translated table"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (save-excursion
- (let ((beg (point)))
- (unless (re-search-forward
- (concat "END +RECEIVE +ORGTBL +" name) nil t)
- (user-error "Cannot find end of insertion region"))
- (beginning-of-line 1)
- (delete-region beg (point))))
- (insert txt "\n")))
+ (let* ((location-flag nil)
+ (name (regexp-quote name))
+ (begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))
+ (end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)))
+ (while (re-search-forward begin-re nil t)
+ (unless location-flag (setq location-flag t))
+ (let ((beg (line-beginning-position 2)))
+ (unless (re-search-forward end-re nil t)
+ (user-error "Cannot find end of receiver location at %d" beg))
+ (beginning-of-line)
+ (delete-region beg (point))
+ (insert text "\n")))
+ (unless location-flag
+ (user-error "No valid receiver location found in the buffer")))))
;;;###autoload
(defun org-table-to-lisp (&optional txt)
@@ -4442,76 +4690,43 @@ a radio table."
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 txt
- (unless (org-at-table-p)
- (user-error "No table at point")))
- (let* ((txt (or txt
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end))))
- (lines (org-split-string txt "[ \t]*\n[ \t]*")))
-
- (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- lines)))
+ (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]*"))))
(defun orgtbl-send-table (&optional maybe)
- "Send a transformed version of this table to the receiver position.
-With argument MAYBE, fail quietly if no transformation is defined for
-this table."
+ "Send a transformed version of table at point to the receiver position.
+With argument MAYBE, fail quietly if no transformation is defined
+for this table."
(interactive)
(catch 'exit
(unless (org-at-table-p) (user-error "Not at a table"))
;; when non-interactive, we assume align has just happened.
- (when (org-called-interactively-p 'any) (org-table-align))
+ (when (called-interactively-p 'any) (org-table-align))
(let ((dests (orgtbl-gather-send-defs))
- (txt (buffer-substring-no-properties (org-table-begin)
- (org-table-end)))
+ (table (org-table-to-lisp
+ (buffer-substring-no-properties (org-table-begin)
+ (org-table-end))))
(ntbl 0))
- (unless dests (if maybe (throw 'exit nil)
- (user-error "Don't know how to transform this table")))
+ (unless dests
+ (if maybe (throw 'exit nil)
+ (user-error "Don't know how to transform this table")))
(dolist (dest dests)
- (let* ((name (plist-get dest :name))
- (transform (plist-get dest :transform))
- (params (plist-get dest :params))
- (skip (plist-get params :skip))
- (skipcols (plist-get params :skipcols))
- (no-escape (plist-get params :no-escape))
- beg
- (lines (org-table-clean-before-export
- (nthcdr (or skip 0)
- (org-split-string txt "[ \t]*\n[ \t]*"))))
- (i0 (if org-table-clean-did-remove-column 2 1))
- (lines (if no-escape lines
- (mapcar (lambda(l) (replace-regexp-in-string
- "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines)))
- (table (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-remove-by-index
- (org-split-string (org-trim x) "\\s-*|\\s-*")
- skipcols i0)))
- lines))
- (fun (if (= i0 2) 'cdr 'identity))
- (org-table-last-alignment
- (org-remove-by-index (funcall fun org-table-last-alignment)
- skipcols i0))
- (org-table-last-column-widths
- (org-remove-by-index (funcall fun org-table-last-column-widths)
- skipcols i0))
- (txt (if (fboundp transform)
- (funcall transform table params)
- (user-error "No such transformation function %s" transform))))
- (orgtbl-send-replace-tbl name txt))
- (setq ntbl (1+ ntbl)))
+ (let ((name (plist-get dest :name))
+ (transform (plist-get dest :transform))
+ (params (plist-get dest :params)))
+ (unless (fboundp transform)
+ (user-error "No such transformation function %s" transform))
+ (orgtbl-send-replace-tbl name (funcall transform table params)))
+ (cl-incf ntbl))
(message "Table converted and installed at %d receiver location%s"
ntbl (if (> ntbl 1) "s" ""))
- (if (> ntbl 0)
- ntbl
- nil))))
+ (and (> ntbl 0) ntbl))))
(defun org-remove-by-index (list indices &optional i0)
"Remove the elements in LIST with indices in INDICES.
@@ -4561,356 +4776,524 @@ First element has index 0, or I0 if given."
(insert txt)
(goto-char pos)))
-;; Dynamically bound input and output for table formatting.
-(defvar *orgtbl-table* nil
- "Carries the current table through formatting routines.")
-(defvar *orgtbl-rtn* nil
- "Formatting routines push the output lines here.")
-;; Formatting parameters for the current table section.
-(defvar *orgtbl-hline* nil "Text used for horizontal lines.")
-(defvar *orgtbl-sep* nil "Text used as a column separator.")
-(defvar *orgtbl-default-fmt* nil "Default format for each entry.")
-(defvar *orgtbl-fmt* nil "Format for each entry.")
-(defvar *orgtbl-efmt* nil "Format for numbers.")
-(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.")
-(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.")
-(defvar *orgtbl-lstart* nil "Text starting a row.")
-(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.")
-(defvar *orgtbl-lend* nil "Text ending a row.")
-(defvar *orgtbl-llend* nil "Specializes lend for the last row.")
-
-(defsubst orgtbl-get-fmt (fmt i)
- "Retrieve the format from FMT corresponding to the Ith column."
- (if (and (not (functionp fmt)) (consp fmt))
- (plist-get fmt i)
- fmt))
-
-(defsubst orgtbl-apply-fmt (fmt &rest args)
- "Apply format FMT to arguments ARGS.
-When FMT is nil, return the first argument from ARGS."
- (cond ((functionp fmt) (apply fmt args))
- (fmt (apply 'format fmt args))
- (args (car args))
- (t args)))
-
-(defsubst orgtbl-eval-str (str)
- "If STR is a function, evaluate it with no arguments."
- (if (functionp str)
- (funcall str)
- str))
-
-(defun orgtbl-format-line (line)
- "Format LINE as a table row."
- (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*))
- (let* ((i 0)
- (line
- (mapcar
- (lambda (f)
- (setq i (1+ i))
- (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i))
- (f (if (and efmt (string-match orgtbl-exp-regexp f))
- (orgtbl-apply-fmt efmt (match-string 1 f)
- (match-string 2 f))
- f)))
- (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i)
- *orgtbl-default-fmt*)
- f)))
- line)))
- (push (if *orgtbl-lfmt*
- (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line)
- (concat (orgtbl-eval-str *orgtbl-lstart*)
- (mapconcat 'identity line *orgtbl-sep*)
- (orgtbl-eval-str *orgtbl-lend*)))
- *orgtbl-rtn*))))
-
-(defun orgtbl-format-section (section-stopper)
- "Format lines until the first occurrence of SECTION-STOPPER."
- (let (prevline)
- (progn
- (while (not (eq (car *orgtbl-table*) section-stopper))
- (if prevline (orgtbl-format-line prevline))
- (setq prevline (pop *orgtbl-table*)))
- (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*)
- (*orgtbl-lend* *orgtbl-llend*)
- (*orgtbl-lfmt* *orgtbl-llfmt*))
- (orgtbl-format-line prevline))))))
-
;;;###autoload
-(defun orgtbl-to-generic (table params &optional backend)
+(defun orgtbl-to-generic (table params)
"Convert the orgtbl-mode TABLE to some other format.
+
This generic routine can be used for many standard cases.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-A third optional argument BACKEND can be used to convert the content of
-the cells using a specific export back-end.
-For the generic converter, some parameters are obligatory: you need to
-specify either :lfmt, or all of (:lstart :lend :sep).
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that
+line. PARAMS is a property list of parameters that can
+influence the conversion.
Valid parameters are:
-:splice When set to t, return only table body lines, don't wrap
- them into :tstart and :tend. Default is nil. When :splice
- is non-nil, this also means that the exporter should not look
- for and interpret header and footer sections.
+:backend, :raw
+
+ Export back-end used as a basis to transcode elements of the
+ table, when no specific parameter applies to it. It is also
+ used to translate cells contents. You can prevent this by
+ setting :raw property to a non-nil value.
+
+:splice
+
+ When non-nil, only convert rows, not the table itself. This is
+ equivalent to setting to the empty string both :tstart
+ and :tend, which see.
-:hline String to be inserted on horizontal separation lines.
- May be nil to ignore hlines.
+:skip
-:sep Separator between two fields
-:remove-nil-lines Do not include lines that evaluate to nil.
+ When set to an integer N, skip the first N lines of the table.
+ Horizontal separation lines do count for this parameter!
+
+:skipcols
+
+ List of columns that should be skipped. If the table has
+ a column with calculation marks, that column is automatically
+ discarded beforehand.
+
+:hline
+
+ String to be inserted on horizontal separation lines. May be
+ nil to ignore these lines altogether.
+
+:sep
+
+ Separator between two fields, as a string.
Each in the following group may be either a string or a function
of no arguments returning a string:
-:tstart String to start the table. Ignored when :splice is t.
-:tend String to end the table. Ignored when :splice is t.
-:lstart String to start a new table line.
-:llstart String to start the last table line, defaults to :lstart.
-:lend String to end a table line
-:llend String to end the last table line, defaults to :lend.
-
-Each in the following group may be a string, a function of one
-argument (the field or line) returning a string, or a plist
-mapping columns to either of the above:
-
-:lfmt Format for entire line, with enough %s to capture all fields.
- If this is present, :lstart, :lend, and :sep are ignored.
-:llfmt Format for the entire last line, defaults to :lfmt.
-:fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in dollars, you could use :fmt \"$%s$\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
-:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt
- Same as above, specific for the header lines in the table.
- All lines before the first hline are treated as header.
- If any of these is not present, the data line value is used.
+:tstart, :tend
+
+ Strings to start and end the table. Ignored when :splice is t.
+
+:lstart, :lend
+
+ Strings to start and end a new table line.
+
+:llstart, :llend
+
+ Strings to start and end the last table line. Default,
+ respectively, to :lstart and :lend.
+
+Each in the following group may be a string or a function of one
+argument (either the cells in the current row, as a list of
+strings, or the current cell) returning a string:
+
+:lfmt
+
+ Format string for an entire row, with enough %s to capture all
+ fields. When non-nil, :lstart, :lend, and :sep are ignored.
+
+:llfmt
+
+ Format for the entire last line, defaults to :lfmt.
+
+:fmt
+
+ A format to be used to wrap the field, should contain %s for
+ the original field value. For example, to wrap everything in
+ dollars, you could use :fmt \"$%s$\". This may also be
+ a property list with column numbers and format strings, or
+ functions, e.g.,
+
+ (:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
+
+:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
+
+ Same as above, specific for the header lines in the table.
+ All lines before the first hline are treated as header. If
+ any of these is not present, the data line value is used.
This may be either a string or a function of two arguments:
-:efmt Use this format to print numbers with exponentials.
- The format should have %s twice for inserting mantissa
- and exponent, for example \"%s\\\\times10^{%s}\". This
- may also be a property list with column numbers and
- formats. :fmt will still be applied after :efmt.
-
-In addition to this, the parameters :skip and :skipcols are always handled
-directly by `orgtbl-send-table'. See manual."
- (let* ((splicep (plist-get params :splice))
- (hline (plist-get params :hline))
- (skipheadrule (plist-get params :skipheadrule))
- (remove-nil-linesp (plist-get params :remove-nil-lines))
- (remove-newlines (plist-get params :remove-newlines))
- (*orgtbl-hline* hline)
- (*orgtbl-table* table)
- (*orgtbl-sep* (plist-get params :sep))
- (*orgtbl-efmt* (plist-get params :efmt))
- (*orgtbl-lstart* (plist-get params :lstart))
- (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*))
- (*orgtbl-lend* (plist-get params :lend))
- (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*))
- (*orgtbl-lfmt* (plist-get params :lfmt))
- (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*))
- (*orgtbl-fmt* (plist-get params :fmt))
- *orgtbl-rtn*)
- ;; Convert cells content to backend BACKEND
- (when backend
- (setq *orgtbl-table*
- (mapcar
- (lambda(r)
- (if (listp r)
- (mapcar
- (lambda (c)
- (org-trim (org-export-string-as c backend t '(:with-tables t))))
- r)
- r))
- *orgtbl-table*)))
- ;; Put header
- (unless splicep
- (when (plist-member params :tstart)
- (let ((tstart (orgtbl-eval-str (plist-get params :tstart))))
- (if tstart (push tstart *orgtbl-rtn*)))))
- ;; If we have a heading, format it and handle the trailing hline.
- (if (and (not splicep)
- (or (consp (car *orgtbl-table*))
- (consp (nth 1 *orgtbl-table*)))
- (memq 'hline (cdr *orgtbl-table*)))
- (progn
- (when (eq 'hline (car *orgtbl-table*))
- ;; There is a hline before the first data line
- (and hline (push hline *orgtbl-rtn*))
- (pop *orgtbl-table*))
- (let* ((*orgtbl-lstart* (or (plist-get params :hlstart)
- *orgtbl-lstart*))
- (*orgtbl-llstart* (or (plist-get params :hllstart)
- *orgtbl-llstart*))
- (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*))
- (*orgtbl-llend* (or (plist-get params :hllend)
- (plist-get params :hlend) *orgtbl-llend*))
- (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*))
- (*orgtbl-llfmt* (or (plist-get params :hllfmt)
- (plist-get params :hlfmt) *orgtbl-llfmt*))
- (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*))
- (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*)))
- (orgtbl-format-section 'hline))
- (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*))
- (pop *orgtbl-table*)))
- ;; Now format the main section.
- (orgtbl-format-section nil)
- (unless splicep
- (when (plist-member params :tend)
- (let ((tend (orgtbl-eval-str (plist-get params :tend))))
- (if tend (push tend *orgtbl-rtn*)))))
- (mapconcat (if remove-newlines
- (lambda (tend)
- (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend))
- 'identity)
- (nreverse (if remove-nil-linesp
- (remq nil *orgtbl-rtn*)
- *orgtbl-rtn*)) "\n")))
+:efmt
+
+ Use this format to print numbers with exponential. The format
+ should have %s twice for inserting mantissa and exponent, for
+ example \"%s\\\\times10^{%s}\". This may also be a property
+ list with column numbers and format strings or functions.
+ :fmt will still be applied after :efmt."
+ ;; Make sure `org-export-create-backend' is available.
+ (require 'ox)
+ (let* ((backend (plist-get params :backend))
+ (custom-backend
+ ;; Build a custom back-end according to PARAMS. Before
+ ;; defining a translator, check if there is anything to do.
+ ;; When there isn't, let BACKEND handle the element.
+ (org-export-create-backend
+ :parent (or backend 'org)
+ :transcoders
+ `((table . ,(org-table--to-generic-table params))
+ (table-row . ,(org-table--to-generic-row params))
+ (table-cell . ,(org-table--to-generic-cell params))
+ ;; Macros are not going to be expanded. However, no
+ ;; regular back-end has a transcoder for them. We
+ ;; provide one so they are not ignored, but displayed
+ ;; as-is instead.
+ (macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
+ data info)
+ ;; Store TABLE as Org syntax in DATA. Tolerate non-string cells.
+ ;; Initialize communication channel in INFO.
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)) (org-mode))
+ (let ((standard-output (current-buffer))
+ (org-element-use-cache nil))
+ (dolist (e table)
+ (cond ((eq e 'hline) (princ "|--\n"))
+ ((consp e)
+ (princ "| ") (dolist (c e) (princ c) (princ " |"))
+ (princ "\n")))))
+ ;; Add back-end specific filters, but not user-defined ones. In
+ ;; particular, make sure to call parse-tree filters on the
+ ;; table.
+ (setq info
+ (let ((org-export-filters-alist nil))
+ (org-export-install-filters
+ (org-combine-plists
+ (org-export-get-environment backend nil params)
+ `(:back-end ,(org-export-get-backend backend))))))
+ (setq data
+ (org-export-filter-apply-functions
+ (plist-get info :filter-parse-tree)
+ (org-element-map (org-element-parse-buffer) 'table
+ #'identity nil t)
+ info)))
+ (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
+ (user-error "Unknown :backend value"))
+ (when (or (not backend) (plist-get info :raw)) (require 'ox-org))
+ ;; Handle :skip parameter.
+ (let ((skip (plist-get info :skip)))
+ (when skip
+ (unless (wholenump skip) (user-error "Wrong :skip value"))
+ (let ((n 0))
+ (org-element-map data 'table-row
+ (lambda (row)
+ (if (>= n skip) t
+ (org-element-extract-element row)
+ (cl-incf n)
+ nil))
+ nil t))))
+ ;; Handle :skipcols parameter.
+ (let ((skipcols (plist-get info :skipcols)))
+ (when skipcols
+ (unless (consp skipcols) (user-error "Wrong :skipcols value"))
+ (org-element-map data 'table
+ (lambda (table)
+ (let ((specialp (org-export-table-has-special-column-p table)))
+ (dolist (row (org-element-contents table))
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((c 1))
+ (dolist (cell (nthcdr (if specialp 1 0)
+ (org-element-contents row)))
+ (when (memq c skipcols)
+ (org-element-extract-element cell))
+ (cl-incf c))))))))))
+ ;; Since we are going to export using a low-level mechanism,
+ ;; ignore special column and special rows manually.
+ (let ((special? (org-export-table-has-special-column-p data))
+ ignore)
+ (org-element-map data (if special? '(table-cell table-row) 'table-row)
+ (lambda (datum)
+ (when (if (eq (org-element-type datum) 'table-row)
+ (org-export-table-row-is-special-p datum nil)
+ (org-export-first-sibling-p datum nil))
+ (push datum ignore))))
+ (setq info (plist-put info :ignore-list ignore)))
+ ;; We use a low-level mechanism to export DATA so as to skip all
+ ;; usual pre-processing and post-processing, i.e., hooks, Babel
+ ;; code evaluation, include keywords and macro expansion. Only
+ ;; back-end specific filters are retained.
+ (let ((output (org-export-data-with-backend data custom-backend info)))
+ ;; Remove final newline.
+ (if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
+
+(defun org-table--generic-apply (value name &optional with-cons &rest args)
+ (cond ((null value) nil)
+ ((functionp value) `(funcall ',value ,@args))
+ ((stringp value)
+ (cond ((consp (car args)) `(apply #'format ,value ,@args))
+ (args `(format ,value ,@args))
+ (t value)))
+ ((and with-cons (consp value))
+ `(let ((val (cadr (memq column ',value))))
+ (cond ((null val) contents)
+ ((stringp val) (format val ,@args))
+ ((functionp val) (funcall val ,@args))
+ (t (user-error "Wrong %s value" ,name)))))
+ (t (user-error "Wrong %s value" name))))
+
+(defun org-table--to-generic-table (params)
+ "Return custom table transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let ((backend (plist-get params :backend))
+ (splice (plist-get params :splice))
+ (tstart (plist-get params :tstart))
+ (tend (plist-get params :tend)))
+ `(lambda (table contents info)
+ (concat
+ ,(and tstart (not splice)
+ `(concat ,(org-table--generic-apply tstart ":tstart") "\n"))
+ ,(if (or (not backend) tstart tend splice) 'contents
+ `(org-export-with-backend ',backend table contents info))
+ ,(org-table--generic-apply (and (not splice) tend) ":tend")))))
+
+(defun org-table--to-generic-row (params)
+ "Return custom table row transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let* ((backend (plist-get params :backend))
+ (lstart (plist-get params :lstart))
+ (llstart (plist-get params :llstart))
+ (hlstart (plist-get params :hlstart))
+ (hllstart (plist-get params :hllstart))
+ (lend (plist-get params :lend))
+ (llend (plist-get params :llend))
+ (hlend (plist-get params :hlend))
+ (hllend (plist-get params :hllend))
+ (lfmt (plist-get params :lfmt))
+ (llfmt (plist-get params :llfmt))
+ (hlfmt (plist-get params :hlfmt))
+ (hllfmt (plist-get params :hllfmt)))
+ `(lambda (row contents info)
+ (if (eq (org-element-property :type row) 'rule)
+ ,(cond
+ ((plist-member params :hline)
+ (org-table--generic-apply (plist-get params :hline) ":hline"))
+ (backend `(org-export-with-backend ',backend row nil info)))
+ (let ((headerp ,(and (or hlfmt hlstart hlend)
+ '(org-export-table-row-in-header-p row info)))
+ (last-header-p
+ ,(and (or hllfmt hllstart hllend)
+ '(org-export-table-row-ends-header-p row info)))
+ (lastp (not (org-export-get-next-element row info))))
+ (when contents
+ ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
+ ;; `:hllfmt' to CONTENTS. Otherwise, fallback on
+ ;; `:lstart', `:lend' and their relatives.
+ ,(let ((cells
+ '(org-element-map row 'table-cell
+ (lambda (cell)
+ ;; Export all cells, without separators.
+ ;;
+ ;; Use `org-export-data-with-backend'
+ ;; instead of `org-export-data' to eschew
+ ;; cached values, which
+ ;; ignore :orgtbl-ignore-sep parameter.
+ (org-export-data-with-backend
+ cell
+ (plist-get info :back-end)
+ (org-combine-plists info '(:orgtbl-ignore-sep t))))
+ info)))
+ `(cond
+ ,(and hllfmt
+ `(last-header-p ,(org-table--generic-apply
+ hllfmt ":hllfmt" nil cells)))
+ ,(and hlfmt
+ `(headerp ,(org-table--generic-apply
+ hlfmt ":hlfmt" nil cells)))
+ ,(and llfmt
+ `(lastp ,(org-table--generic-apply
+ llfmt ":llfmt" nil cells)))
+ (t
+ ,(if lfmt (org-table--generic-apply lfmt ":lfmt" nil cells)
+ `(concat
+ (cond
+ ,(and
+ (or hllstart hllend)
+ `(last-header-p
+ (concat
+ ,(org-table--generic-apply hllstart ":hllstart")
+ contents
+ ,(org-table--generic-apply hllend ":hllend"))))
+ ,(and
+ (or hlstart hlend)
+ `(headerp
+ (concat
+ ,(org-table--generic-apply hlstart ":hlstart")
+ contents
+ ,(org-table--generic-apply hlend ":hlend"))))
+ ,(and
+ (or llstart llend)
+ `(lastp
+ (concat
+ ,(org-table--generic-apply llstart ":llstart")
+ contents
+ ,(org-table--generic-apply llend ":llend"))))
+ (t
+ ,(cond
+ ((or lstart lend)
+ `(concat
+ ,(org-table--generic-apply lstart ":lstart")
+ contents
+ ,(org-table--generic-apply lend ":lend")))
+ (backend
+ `(org-export-with-backend
+ ',backend row contents info))
+ (t 'contents)))))))))))))))
+
+(defun org-table--to-generic-cell (params)
+ "Return custom table cell transcoder according to PARAMS.
+PARAMS is a plist. See `orgtbl-to-generic' for more
+information."
+ (let* ((backend (plist-get params :backend))
+ (efmt (plist-get params :efmt))
+ (fmt (plist-get params :fmt))
+ (hfmt (plist-get params :hfmt))
+ (sep (plist-get params :sep))
+ (hsep (plist-get params :hsep)))
+ `(lambda (cell contents info)
+ ;; Make sure that contents are exported as Org data when :raw
+ ;; parameter is non-nil.
+ ,(when (and backend (plist-get params :raw))
+ `(setq contents
+ ;; Since we don't know what are the pseudo object
+ ;; types defined in backend, we cannot pass them to
+ ;; `org-element-interpret-data'. As a consequence,
+ ;; they will be treated as pseudo elements, and will
+ ;; have newlines appended instead of spaces.
+ ;; Therefore, we must make sure :post-blank value is
+ ;; really turned into spaces.
+ (replace-regexp-in-string
+ "\n" " "
+ (org-trim
+ (org-element-interpret-data
+ (org-element-contents cell))))))
+
+ (let ((headerp ,(and (or hfmt hsep)
+ '(org-export-table-row-in-header-p
+ (org-export-get-parent-element cell) info)))
+ (column
+ ;; Call costly `org-export-table-cell-address' only if
+ ;; absolutely necessary, i.e., if one
+ ;; of :fmt :efmt :hfmt has a "plist type" value.
+ ,(and (cl-some (lambda (v) (integerp (car-safe v)))
+ (list efmt hfmt fmt))
+ '(1+ (cdr (org-export-table-cell-address cell info))))))
+ (when contents
+ ;; Check if we can apply `:efmt' on CONTENTS.
+ ,(when efmt
+ `(when (string-match orgtbl-exp-regexp contents)
+ (let ((mantissa (match-string 1 contents))
+ (exponent (match-string 2 contents)))
+ (setq contents ,(org-table--generic-apply
+ efmt ":efmt" t 'mantissa 'exponent)))))
+ ;; Check if we can apply FMT (or HFMT) on CONTENTS.
+ (cond
+ ,(and hfmt `(headerp (setq contents ,(org-table--generic-apply
+ hfmt ":hfmt" t 'contents))))
+ ,(and fmt `(t (setq contents ,(org-table--generic-apply
+ fmt ":fmt" t 'contents))))))
+ ;; If a separator is provided, use it instead of BACKEND's.
+ ;; Separators are ignored when LFMT (or equivalent) is
+ ;; provided.
+ ,(cond
+ ((or hsep sep)
+ `(if (or ,(and (not sep) '(not headerp))
+ (plist-get info :orgtbl-ignore-sep)
+ (not (org-export-get-next-element cell info)))
+ ,(if (not backend) 'contents
+ `(org-export-with-backend ',backend cell contents info))
+ (concat contents
+ ,(if (and sep hsep) `(if headerp ,hsep ,sep)
+ (or hsep sep)))))
+ (backend `(org-export-with-backend ',backend cell contents info))
+ (t 'contents))))))
;;;###autoload
(defun orgtbl-to-tsv (table params)
"Convert the orgtbl-mode table to TAB separated material."
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
+
;;;###autoload
(defun orgtbl-to-csv (table params)
"Convert the orgtbl-mode table to CSV material.
This does take care of the proper quoting of fields with comma or quotes."
- (orgtbl-to-generic table (org-combine-plists
- '(:sep "," :fmt org-quote-csv-field)
- params)))
+ (orgtbl-to-generic table
+ (org-combine-plists '(:sep "," :fmt org-quote-csv-field)
+ params)))
;;;###autoload
(defun orgtbl-to-latex (table params)
"Convert the orgtbl-mode TABLE to LaTeX.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-LaTeX are:
-
-:splice When set to t, return only table body lines, don't wrap
- them into a tabular environment. Default is nil.
-
-:fmt A format to be used to wrap the field, should contain %s for the
- original field value. For example, to wrap everything in dollars,
- use :fmt \"$%s$\". This may also be a property list with column
- numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\")
- The format may also be a function that formats its one argument.
-
-:efmt Format for transforming numbers with exponentials. The format
- should have %s twice for inserting mantissa and exponent, for
- example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\".
- This may also be a property list with column numbers and formats.
- The format may also be a function that formats its two arguments.
-
-:llend If you find too much space below the last line of a table,
- pass a value of \"\" for :llend to suppress the final \\\\.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* ((alignment (mapconcat (lambda (x) (if x "r" "l"))
- org-table-last-alignment ""))
- (params2
- (list
- :tstart (concat "\\begin{tabular}{" alignment "}")
- :tend "\\end{tabular}"
- :lstart "" :lend " \\\\" :sep " & "
- :efmt "%s\\,(%s)" :hline "\\hline")))
- (require 'ox-latex)
- (orgtbl-to-generic table (org-combine-plists params2 params) 'latex)))
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following ones:
+
+:booktabs
+
+ When non-nil, use formal \"booktabs\" style.
+
+:environment
+
+ Specify environment to use, as a string. If you use
+ \"longtable\", you may also want to specify :language property,
+ as a string, to get proper continuation strings."
+ (require 'ox-latex)
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ ;; Provide sane default values.
+ (list :backend 'latex
+ :latex-default-table-mode 'table
+ :latex-tables-centered nil
+ :latex-tables-booktabs (plist-get params :booktabs)
+ :latex-table-scientific-notation nil
+ :latex-default-table-environment
+ (or (plist-get params :environment) "tabular"))
+ params)))
;;;###autoload
(defun orgtbl-to-html (table params)
"Convert the orgtbl-mode TABLE to HTML.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Currently this function recognizes the following parameters:
-:splice When set to t, return only table body lines, don't wrap
- them into a <table> environment. Default is nil.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following one:
+
+:attributes
-The general parameters :skip and :skipcols have already been applied when
-this function is called. The function does *not* use `orgtbl-to-generic',
-so you cannot specify parameters for it."
+ Attributes and values, as a plist, which will be used in
+ <table> tag."
(require 'ox-html)
- (let ((output (org-export-string-as
- (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t))))
- (if (not (plist-get params :splice)) output
- (org-trim
- (replace-regexp-in-string
- "\\`<table .*>\n" ""
- (replace-regexp-in-string "</table>\n*\\'" "" output))))))
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ ;; Provide sane default values.
+ (list :backend 'html
+ :html-table-data-tags '("<td%s>" . "</td>")
+ :html-table-use-header-tags-for-first-column nil
+ :html-table-align-individual-fields t
+ :html-table-row-tags '("<tr>" . "</tr>")
+ :html-table-attributes
+ (if (plist-member params :attributes)
+ (plist-get params :attributes)
+ '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups"
+ :frame "hsides")))
+ params)))
;;;###autoload
(defun orgtbl-to-texinfo (table params)
- "Convert the orgtbl-mode TABLE to TeXInfo.
-TABLE is a list, each entry either the symbol `hline' for a horizontal
-separator line, or a list of fields for that line.
-PARAMS is a property list of parameters that can influence the conversion.
-Supports all parameters from `orgtbl-to-generic'. Most important for
-TeXInfo are:
-
-:splice nil/t When set to t, return only table body lines, don't wrap
- them into a multitable environment. Default is nil.
-
-:fmt fmt A format to be used to wrap the field, should contain
- %s for the original field value. For example, to wrap
- everything in @kbd{}, you could use :fmt \"@kbd{%s}\".
- This may also be a property list with column numbers and
- formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\").
- Each format also may be a function that formats its one
- argument.
-
-:cf \"f1 f2..\" The column fractions for the table. By default these
- are computed automatically from the width of the columns
- under org-mode.
-
-The general parameters :skip and :skipcols have already been applied when
-this function is called."
- (let* ((total (float (apply '+ org-table-last-column-widths)))
- (colfrac (or (plist-get params :cf)
- (mapconcat
- (lambda (x) (format "%.3f" (/ (float x) total)))
- org-table-last-column-widths " ")))
- (params2
- (list
- :tstart (concat "@multitable @columnfractions " colfrac)
- :tend "@end multitable"
- :lstart "@item " :lend "" :sep " @tab "
- :hlstart "@headitem ")))
- (require 'ox-texinfo)
- (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo)))
+ "Convert the orgtbl-mode TABLE to Texinfo.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following one:
+
+:columns
+
+ Column widths, as a string. When providing column fractions,
+ \"@columnfractions\" command can be omitted."
+ (require 'ox-texinfo)
+ (let ((output
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ (list :backend 'texinfo
+ :texinfo-tables-verbatim nil
+ :texinfo-table-scientific-notation nil)
+ params)))
+ (columns (let ((w (plist-get params :columns)))
+ (cond ((not w) nil)
+ ((string-match-p "{\\|@columnfractions " w) w)
+ (t (concat "@columnfractions " w))))))
+ (if (not columns) output
+ (replace-regexp-in-string
+ "@multitable \\(.*\\)" columns output t nil 1))))
;;;###autoload
(defun orgtbl-to-orgtbl (table params)
"Convert the orgtbl-mode TABLE into another orgtbl-mode table.
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported.
+
Useful when slicing one table into many. The :hline, :sep,
-:lstart, and :lend provide orgtbl framing. The default nil :tstart
-and :tend suppress strings without splicing; they can be set to
-provide ORGTBL directives for the generated table."
- (let* ((params2
- (list
- :remove-newlines t
- :tstart nil :tend nil
- :hline "|---"
- :sep " | "
- :lstart "| "
- :lend " |"))
- (params (org-combine-plists params2 params)))
- (with-temp-buffer
- (insert (orgtbl-to-generic table params))
- (goto-char (point-min))
- (while (re-search-forward org-table-hline-regexp nil t)
- (org-table-align))
- (buffer-substring 1 (buffer-size)))))
+:lstart, and :lend provide orgtbl framing. :tstart and :tend can
+be set to provide ORGTBL directives for the generated table."
+ (require 'ox-org)
+ (orgtbl-to-generic table (org-combine-plists params (list :backend 'org))))
(defun orgtbl-to-table.el (table params)
- "Convert the orgtbl-mode TABLE into a table.el table."
+ "Convert the orgtbl-mode TABLE into a table.el table.
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported."
(with-temp-buffer
(insert (orgtbl-to-orgtbl table params))
(org-table-align)
@@ -4920,19 +5303,137 @@ provide ORGTBL directives for the generated table."
(defun orgtbl-to-unicode (table params)
"Convert the orgtbl-mode TABLE into a table with unicode characters.
-You need the ascii-art-to-unicode.el package for this. You can download
-it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
- (with-temp-buffer
- (insert (orgtbl-to-table.el table params))
- (goto-char (point-min))
- (if (or (featurep 'ascii-art-to-unicode)
- (require 'ascii-art-to-unicode nil t))
- (aa2u)
- (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links))
- (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el"
- "Link to ascii-art-to-unicode.el") org-stored-links))
- (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)"))
- (buffer-string)))
+
+TABLE is a list, each entry either the symbol `hline' for
+a horizontal separator line, or a list of fields for that line.
+PARAMS is a property list of parameters that can influence the
+conversion. All parameters from `orgtbl-to-generic' are
+supported. It is also possible to use the following ones:
+
+:ascii-art
+
+ When non-nil, use \"ascii-art-to-unicode\" package to translate
+ the table. You can download it here:
+ http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
+
+:narrow
+
+ When non-nil, narrow columns width than provided width cookie,
+ using \"=>\" as an ellipsis, just like in an Org mode buffer."
+ (require 'ox-ascii)
+ (orgtbl-to-generic
+ table
+ (org-combine-plists
+ (list :backend 'ascii
+ :ascii-charset 'utf-8
+ :ascii-table-widen-columns (not (plist-get params :narrow))
+ :ascii-table-use-ascii-art (plist-get params :ascii-art))
+ params)))
+
+;; Put the cursor in a column containing numerical values
+;; of an Org table,
+;; type C-c " a
+;; A new column is added with a bar plot.
+;; When the table is refreshed (C-u C-c *),
+;; the plot is updated to reflect the new values.
+
+(defun orgtbl-ascii-draw (value min max &optional width characters)
+ "Draw an ascii bar in a table.
+VALUE is the value to plot, it determines the width of the bar to draw.
+MIN is the value that will be displayed as empty (zero width bar).
+MAX is the value that will draw a bar filling all the WIDTH.
+WIDTH is the span in characters from MIN to MAX.
+CHARACTERS is a string that will compose the bar, with shades of grey
+from pure white to pure black. It defaults to a 10 characters string
+of regular ascii characters."
+ (let* ((width (ceiling (or width 12)))
+ (characters (or characters " .:;c!lhVHW"))
+ (len (1- (length characters)))
+ (value (float (if (numberp value)
+ value (string-to-number value))))
+ (relative (/ (- value min) (- max min)))
+ (steps (round (* relative width len))))
+ (cond ((< steps 0) "too small")
+ ((> steps (* width len)) "too large")
+ (t (let* ((int-division (/ steps len))
+ (remainder (- steps (* int-division len))))
+ (concat (make-string int-division (elt characters len))
+ (string (elt characters remainder))))))))
+
+;;;###autoload
+(defun orgtbl-ascii-plot (&optional ask)
+ "Draw an ASCII bar plot in a column.
+
+With cursor in a column containing numerical values, this function
+will draw a plot in a new column.
+
+ASK, if given, is a numeric prefix to override the default 12
+characters width of the plot. ASK may also be the `\\[universal-argument]' \
+prefix,
+which will prompt for the width."
+ (interactive "P")
+ (let ((col (org-table-current-column))
+ (min 1e999) ; 1e999 will be converted to infinity
+ (max -1e999) ; which is the desired result
+ (table (org-table-to-lisp))
+ (length
+ (cond ((consp ask)
+ (read-number "Length of column " 12))
+ ((numberp ask) ask)
+ (t 12))))
+ ;; Skip any hline a the top of table.
+ (while (eq (car table) 'hline) (setq table (cdr table)))
+ ;; Skip table header if any.
+ (dolist (x (or (cdr (memq 'hline table)) table))
+ (when (consp x)
+ (setq x (nth (1- col) x))
+ (when (string-match
+ "^[-+]?\\([0-9]*[.]\\)?[0-9]*\\([eE][+-]?[0-9]+\\)?$"
+ x)
+ (setq x (string-to-number x))
+ (when (> min x) (setq min x))
+ (when (< max x) (setq max x)))))
+ (org-table-insert-column)
+ (org-table-move-column-right)
+ (org-table-store-formulas
+ (cons
+ (cons
+ (concat "$" (number-to-string (1+ col)))
+ (format "'(%s $%s %s %s %s)"
+ "orgtbl-ascii-draw" col min max length))
+ (org-table-get-stored-formulas)))
+ (org-table-recalculate t)))
+
+;; Example of extension: unicode characters
+;; Here are two examples of different styles.
+
+;; Unicode block characters are used to give a smooth effect.
+;; See http://en.wikipedia.org/wiki/Block_Elements
+;; Use one of those drawing functions
+;; - orgtbl-ascii-draw (the default ascii)
+;; - orgtbl-uc-draw-grid (unicode with a grid effect)
+;; - orgtbl-uc-draw-cont (smooth unicode)
+
+;; This is best viewed with the "DejaVu Sans Mono" font
+;; (use M-x set-default-font).
+
+(defun orgtbl-uc-draw-grid (value min max &optional width)
+ "Draw a bar in a table using block unicode characters.
+It is a variant of orgtbl-ascii-draw with Unicode block
+characters, for a smooth display. Bars appear as grids (to the
+extent the font allows)."
+ ;; http://en.wikipedia.org/wiki/Block_Elements
+ ;; best viewed with the "DejaVu Sans Mono" font.
+ (orgtbl-ascii-draw value min max width
+ " \u258F\u258E\u258D\u258C\u258B\u258A\u2589"))
+
+(defun orgtbl-uc-draw-cont (value min max &optional width)
+ "Draw a bar in a table using block unicode characters.
+It is a variant of orgtbl-ascii-draw with Unicode block
+characters, for a smooth display. Bars are solid (to the extent
+the font allows)."
+ (orgtbl-ascii-draw value min max width
+ " \u258F\u258E\u258D\u258C\u258B\u258A\u2589\u2588"))
(defun org-table-get-remote-range (name-or-id form)
"Get a field value or a list of values in a range from table at ID.
@@ -4949,57 +5450,74 @@ The return value is either a single string for a single field, or a
list of the fields in the rectangle."
(save-match-data
(let ((case-fold-search t) (id-loc nil)
- ;; Protect a bunch of variables from being overwritten
- ;; by the context of the remote table
+ ;; Protect a bunch of variables from being overwritten by
+ ;; the context of the remote table.
org-table-column-names org-table-column-name-regexp
org-table-local-parameters org-table-named-field-locations
- org-table-current-line-types org-table-current-begin-line
+ org-table-current-line-types
org-table-current-begin-pos org-table-dlines
org-table-current-ncol
org-table-hlines org-table-last-alignment
org-table-last-column-widths org-table-last-alignment
- org-table-last-column-widths tbeg
+ org-table-last-column-widths
buffer loc)
(setq form (org-table-convert-refs-to-rc form))
- (save-excursion
- (save-restriction
- (widen)
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
- (regexp-quote name-or-id) "[ \t]*$")
- nil t)
- (setq buffer (current-buffer) loc (match-beginning 0))
- (setq id-loc (org-id-find name-or-id 'marker))
- (unless (and id-loc (markerp id-loc))
- (user-error "Can't find remote table \"%s\"" name-or-id))
- (setq buffer (marker-buffer id-loc)
- loc (marker-position id-loc))
- (move-marker id-loc nil)))
- (with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char loc)
- (forward-char 1)
- (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t)
- (not (match-beginning 1)))
- (user-error "Cannot find a table at NAME or ID %s" name-or-id))
- (setq tbeg (point-at-bol))
- (org-table-get-specials)
- (setq form (org-table-formula-substitute-names
- (org-table-formula-handle-first/last-rc form)))
- (if (and (string-match org-table-range-regexp form)
- (> (length (match-string 0 form)) 1))
- (save-match-data
- (org-table-get-range (match-string 0 form) tbeg 1))
- form)))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
+ (regexp-quote name-or-id) "[ \t]*$")
+ nil t)
+ (setq buffer (current-buffer) loc (match-beginning 0))
+ (setq id-loc (org-id-find name-or-id 'marker))
+ (unless (and id-loc (markerp id-loc))
+ (user-error "Can't find remote table \"%s\"" name-or-id))
+ (setq buffer (marker-buffer id-loc)
+ loc (marker-position id-loc))
+ (move-marker id-loc nil))
+ (with-current-buffer buffer
+ (org-with-wide-buffer
+ (goto-char loc)
+ (forward-char 1)
+ (unless (and (re-search-forward "^\\(\\*+ \\)\\|^[ \t]*|" nil t)
+ (not (match-beginning 1)))
+ (user-error "Cannot find a table at NAME or ID %s" name-or-id))
+ (org-table-analyze)
+ (setq form (org-table-formula-substitute-names
+ (org-table-formula-handle-first/last-rc form)))
+ (if (and (string-match org-table-range-regexp form)
+ (> (length (match-string 0 form)) 1))
+ (org-table-get-range
+ (match-string 0 form) org-table-current-begin-pos 1)
+ form)))))))
+
+(defun org-table-remote-reference-indirection (form)
+ "Return formula with table remote references substituted by indirection.
+For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\".
+This indirection works only with the format @ROW$COLUMN. The
+format \"B3\" is not supported because it can not be
+distinguished from a plain table name or ID."
+ (let ((regexp
+ ;; Same as in `org-table-eval-formula'.
+ (concat "\\<remote([ \t]*\\("
+ ;; Allow "$1", "@<", "$-1", "@<<$1" etc.
+ "[@$][^ \t,]+"
+ "\\)[ \t]*,[ \t]*\\([^\n)]+\\))")))
+ (replace-regexp-in-string
+ regexp
+ (lambda (m)
+ (save-match-data
+ (let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m))))
+ (org-table-get-range
+ (if (string-match-p "\\`\\$[0-9]+\\'" eq)
+ (concat "@0" eq)
+ eq)))))
+ form t t 1)))
(defmacro org-define-lookup-function (mode)
(let ((mode-str (symbol-name mode))
- (first-p (equal mode 'first))
- (all-p (equal mode 'all)))
+ (first-p (eq mode 'first))
+ (all-p (eq mode 'all)))
(let ((plural-str (if all-p "s" "")))
`(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate)
,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST.
@@ -5012,16 +5530,13 @@ This function is generated by a call to the macro `org-define-lookup-function'."
(sl s-list)
(rl (or r-list s-list))
(ret nil))))
- (if first-p (add-to-list 'lvars '(match-p nil)))
- lvars)
+ (if first-p (cons '(match-p nil) lvars) lvars))
(while ,(if first-p '(and (not match-p) sl) 'sl)
- (progn
- (if (funcall p val (car sl))
- (progn
- ,(if first-p '(setq match-p t))
- (let ((rval (car rl)))
- (setq ret ,(if all-p '(append ret (list rval)) 'rval)))))
- (setq sl (cdr sl) rl (cdr rl))))
+ (when (funcall p val (car sl))
+ ,(when first-p '(setq match-p t))
+ (let ((rval (car rl)))
+ (setq ret ,(if all-p '(append ret (list rval)) 'rval))))
+ (setq sl (cdr sl) rl (cdr rl)))
ret)))))
(org-define-lookup-function first)
diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el
index 95737479010..5acf526f183 100644
--- a/lisp/org/org-timer.el
+++ b/lisp/org/org-timer.el
@@ -1,4 +1,4 @@
-;;; org-timer.el --- The relative timer code for Org-mode
+;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
@@ -19,18 +19,25 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
-;; This file contains the relative timer code for Org-mode
+;; This file implements two types of timers for Org buffers:
+;;
+;; - A relative timer that counts up (from 0 or a specified offset)
+;; - A countdown timer that counts down from a specified time
+;;
+;; The relative and countdown timers differ in their entry points.
+;; Use `org-timer' or `org-timer-start' to start the relative timer,
+;; and `org-timer-set-timer' to start the countdown timer.
;;; Code:
-(require 'org)
+(require 'cl-lib)
+(require 'org-clock)
-(declare-function org-notify "org-clock" (notification &optional play-sound))
(declare-function org-agenda-error "org-agenda" ())
(defvar org-timer-start-time nil
@@ -39,27 +46,37 @@
(defvar org-timer-pause-time nil
"Time when the timer was paused.")
+(defvar org-timer-countdown-timer nil
+ "Current countdown timer.
+This is a timer object if there is an active countdown timer,
+`paused' if there is a paused countdown timer, and nil
+otherwise.")
+
+(defvar org-timer-countdown-timer-title nil
+ "Title for notification displayed when a countdown finishes.")
+
(defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)"
"Regular expression used to match timer stamps.")
(defcustom org-timer-format "%s "
"The format to insert the time of the timer.
This format must contain one instance of \"%s\" which will be replaced by
-the value of the relative timer."
+the value of the timer."
:group 'org-time
:type 'string)
-(defcustom org-timer-default-timer 0
- "The default timer when a timer is set.
+(defcustom org-timer-default-timer "0"
+ "The default timer when a timer is set, in minutes or hh:mm:ss format.
When 0, the user is prompted for a value."
:group 'org-time
- :version "24.1"
- :type 'number)
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'string)
(defcustom org-timer-display 'mode-line
- "When a timer is running, org-mode can display it in the mode
-line and/or frame title.
-Allowed values are:
+ "Define where running timer is displayed, if at all.
+When a timer is running, Org can display it in the mode line
+and/or frame title. Allowed values are:
both displays in both mode line and frame title
mode-line displays only in mode line (default)
@@ -76,13 +93,13 @@ nil current timer is not displayed"
"Hook run after relative timer is started.")
(defvar org-timer-stop-hook nil
- "Hook run before relative timer is stopped.")
+ "Hook run before relative or countdown timer is stopped.")
(defvar org-timer-pause-hook nil
- "Hook run before relative timer is paused.")
+ "Hook run before relative or countdown timer is paused.")
(defvar org-timer-continue-hook nil
- "Hook run after relative timer is continued.")
+ "Hook run after relative or countdown timer is continued.")
(defvar org-timer-set-hook nil
"Hook run after countdown timer is set.")
@@ -90,9 +107,6 @@ nil current timer is not displayed"
(defvar org-timer-done-hook nil
"Hook run after countdown timer reaches zero.")
-(defvar org-timer-cancel-hook nil
- "Hook run before countdown timer is canceled.")
-
;;;###autoload
(defun org-timer-start (&optional offset)
"Set the starting time for the relative timer to now.
@@ -105,8 +119,12 @@ region will be shifted by a specific amount. You will be prompted for
the amount, with the default to make the first timer string in
the region 0:00:00."
(interactive "P")
- (if (equal offset '(16))
- (call-interactively 'org-timer-change-times-in-region)
+ (cond
+ ((equal offset '(16))
+ (call-interactively 'org-timer-change-times-in-region))
+ (org-timer-countdown-timer
+ (user-error "Countdown timer is running. Cancel first"))
+ (t
(let (delta def s)
(if (not offset)
(setq org-timer-start-time (current-time))
@@ -123,67 +141,90 @@ the region 0:00:00."
(setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
(setq org-timer-start-time
(seconds-to-time
- (- (float-time) delta))))
+ ;; Pass `current-time' result to `float-time' (instead
+ ;; of calling without arguments) so that only
+ ;; `current-time' has to be overridden in tests.
+ (- (float-time (current-time)) delta))))
+ (setq org-timer-pause-time nil)
(org-timer-set-mode-line 'on)
(message "Timer start time set to %s, current value is %s"
(format-time-string "%T" org-timer-start-time)
(org-timer-secs-to-hms (or delta 0)))
- (run-hooks 'org-timer-start-hook))))
+ (run-hooks 'org-timer-start-hook)))))
(defun org-timer-pause-or-continue (&optional stop)
- "Pause or continue the relative timer.
+ "Pause or continue the relative or countdown timer.
With prefix arg STOP, stop it entirely."
(interactive "P")
(cond
(stop (org-timer-stop))
((not org-timer-start-time) (error "No timer is running"))
(org-timer-pause-time
- ;; timer is paused, continue
- (setq org-timer-start-time
- (seconds-to-time
- (-
- (float-time)
- (- (float-time org-timer-pause-time)
- (float-time org-timer-start-time))))
- org-timer-pause-time nil)
- (org-timer-set-mode-line 'on)
- (run-hooks 'org-timer-continue-hook)
- (message "Timer continues at %s" (org-timer-value-string)))
+ (let ((start-secs (float-time org-timer-start-time))
+ (pause-secs (float-time org-timer-pause-time)))
+ (if org-timer-countdown-timer
+ (let ((new-secs (- start-secs pause-secs)))
+ (setq org-timer-countdown-timer
+ (org-timer--run-countdown-timer
+ new-secs org-timer-countdown-timer-title))
+ (setq org-timer-start-time
+ (time-add (current-time) (seconds-to-time new-secs))))
+ (setq org-timer-start-time
+ ;; Pass `current-time' result to `float-time' (instead
+ ;; of calling without arguments) so that only
+ ;; `current-time' has to be overridden in tests.
+ (seconds-to-time (- (float-time (current-time))
+ (- pause-secs start-secs)))))
+ (setq org-timer-pause-time nil)
+ (org-timer-set-mode-line 'on)
+ (run-hooks 'org-timer-continue-hook)
+ (message "Timer continues at %s" (org-timer-value-string))))
(t
;; pause timer
+ (when org-timer-countdown-timer
+ (cancel-timer org-timer-countdown-timer)
+ (setq org-timer-countdown-timer 'paused))
(run-hooks 'org-timer-pause-hook)
(setq org-timer-pause-time (current-time))
- (org-timer-set-mode-line 'pause)
+ (org-timer-set-mode-line 'paused)
(message "Timer paused at %s" (org-timer-value-string)))))
-(defvar org-timer-current-timer nil)
(defun org-timer-stop ()
- "Stop the relative timer."
+ "Stop the relative or countdown timer."
(interactive)
+ (unless org-timer-start-time
+ (user-error "No timer running"))
+ (when (timerp org-timer-countdown-timer)
+ (cancel-timer org-timer-countdown-timer))
(run-hooks 'org-timer-stop-hook)
(setq org-timer-start-time nil
org-timer-pause-time nil
- org-timer-current-timer nil)
+ org-timer-countdown-timer nil)
(org-timer-set-mode-line 'off)
(message "Timer stopped"))
;;;###autoload
-(defun org-timer (&optional restart no-insert-p)
+(defun org-timer (&optional restart no-insert)
"Insert a H:MM:SS string from the timer into the buffer.
-The first time this command is used, the timer is started. When used with
-a \\[universal-argument] prefix, force restarting the timer.
-When used with a double prefix argument \\[universal-argument], change all the timer string
-in the region by a fixed amount. This can be used to recalibrate a timer
-that was not started at the correct moment.
+The first time this command is used, the timer is started.
+
+When used with a `\\[universal-argument]' prefix, force restarting the timer.
+
+When used with a `\\[universal-argument] \\[universal-argument]' \
+prefix, change all the timer strings
+in the region by a fixed amount. This can be used to re-calibrate
+a timer that was not started at the correct moment.
-If NO-INSERT-P is non-nil, return the string instead of inserting
+If NO-INSERT is non-nil, return the string instead of inserting
it in the buffer."
(interactive "P")
- (when (or (equal restart '(4)) (not org-timer-start-time))
- (org-timer-start))
- (if no-insert-p
- (org-timer-value-string)
- (insert (org-timer-value-string))))
+ (if (equal restart '(16))
+ (org-timer-start restart)
+ (when (or (equal restart '(4)) (not org-timer-start-time))
+ (org-timer-start))
+ (if no-insert
+ (org-timer-value-string)
+ (insert (org-timer-value-string)))))
(defun org-timer-value-string ()
"Set the timer string."
@@ -191,12 +232,14 @@ it in the buffer."
(org-timer-secs-to-hms
(abs (floor (org-timer-seconds))))))
-(defvar org-timer-timer-is-countdown nil)
(defun org-timer-seconds ()
- (if org-timer-timer-is-countdown
+ ;; Pass `current-time' result to `float-time' (instead of calling
+ ;; without arguments) so that only `current-time' has to be
+ ;; overridden in tests.
+ (if org-timer-countdown-timer
(- (float-time org-timer-start-time)
- (float-time))
- (- (float-time org-timer-pause-time)
+ (float-time (or org-timer-pause-time (current-time))))
+ (- (float-time (or org-timer-pause-time (current-time)))
(float-time org-timer-start-time))))
;;;###autoload
@@ -290,8 +333,8 @@ If the integer is negative, the string will start with \"-\"."
(defvar org-timer-mode-line-string nil)
(defun org-timer-set-mode-line (value)
- "Set the mode-line display of the relative timer.
-VALUE can be `on', `off', or `pause'."
+ "Set the mode-line display for relative or countdown timer.
+VALUE can be `on', `off', or `paused'."
(when (or (eq org-timer-display 'mode-line)
(eq org-timer-display 'both))
(or global-mode-string (setq global-mode-string '("")))
@@ -303,43 +346,43 @@ VALUE can be `on', `off', or `pause'."
(or (memq 'org-timer-mode-line-string frame-title-format)
(setq frame-title-format
(append frame-title-format '(org-timer-mode-line-string)))))
- (cond
- ((equal value 'off)
- (when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer)
- (setq org-timer-mode-line-timer nil))
- (when (or (eq org-timer-display 'mode-line)
- (eq org-timer-display 'both))
- (setq global-mode-string
- (delq 'org-timer-mode-line-string global-mode-string)))
- (when (or (eq org-timer-display 'frame-title)
- (eq org-timer-display 'both))
- (setq frame-title-format
- (delq 'org-timer-mode-line-string frame-title-format)))
- (force-mode-line-update))
- ((equal value 'pause)
- (when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer)
- (setq org-timer-mode-line-timer nil)))
- ((equal value 'on)
- (when (or (eq org-timer-display 'mode-line)
- (eq org-timer-display 'both))
- (or global-mode-string (setq global-mode-string '("")))
- (or (memq 'org-timer-mode-line-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(org-timer-mode-line-string)))))
- (when (or (eq org-timer-display 'frame-title)
- (eq org-timer-display 'both))
- (or (memq 'org-timer-mode-line-string frame-title-format)
- (setq frame-title-format
- (append frame-title-format '(org-timer-mode-line-string)))))
- (org-timer-update-mode-line)
- (when org-timer-mode-line-timer
- (cancel-timer org-timer-mode-line-timer)
- (setq org-timer-mode-line-timer nil))
- (when org-timer-display
- (setq org-timer-mode-line-timer
- (run-with-timer 1 1 'org-timer-update-mode-line))))))
+ (cl-case value
+ (off
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (setq global-mode-string
+ (delq 'org-timer-mode-line-string global-mode-string)))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (setq frame-title-format
+ (delq 'org-timer-mode-line-string frame-title-format)))
+ (force-mode-line-update))
+ (paused
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil)))
+ (on
+ (when (or (eq org-timer-display 'mode-line)
+ (eq org-timer-display 'both))
+ (or global-mode-string (setq global-mode-string '("")))
+ (or (memq 'org-timer-mode-line-string global-mode-string)
+ (setq global-mode-string
+ (append global-mode-string '(org-timer-mode-line-string)))))
+ (when (or (eq org-timer-display 'frame-title)
+ (eq org-timer-display 'both))
+ (or (memq 'org-timer-mode-line-string frame-title-format)
+ (setq frame-title-format
+ (append frame-title-format '(org-timer-mode-line-string)))))
+ (org-timer-update-mode-line)
+ (when org-timer-mode-line-timer
+ (cancel-timer org-timer-mode-line-timer)
+ (setq org-timer-mode-line-timer nil))
+ (when org-timer-display
+ (setq org-timer-mode-line-timer
+ (run-with-timer 1 1 'org-timer-update-mode-line))))))
(defun org-timer-update-mode-line ()
"Update the timer time in the mode line."
@@ -349,102 +392,113 @@ VALUE can be `on', `off', or `pause'."
(concat " <" (substring (org-timer-value-string) 0 -1) ">"))
(force-mode-line-update)))
-(defun org-timer-cancel-timer ()
- "Cancel the current timer."
- (interactive)
- (when (eval org-timer-current-timer)
- (run-hooks 'org-timer-cancel-hook)
- (cancel-timer org-timer-current-timer)
- (setq org-timer-current-timer nil)
- (setq org-timer-timer-is-countdown nil)
- (org-timer-set-mode-line 'off))
- (message "Last timer canceled"))
-
(defun org-timer-show-remaining-time ()
"Display the remaining time before the timer ends."
(interactive)
(require 'time)
- (if (not org-timer-current-timer)
+ (if (not org-timer-countdown-timer)
(message "No timer set")
(let* ((rtime (decode-time
- (time-subtract (timer--time org-timer-current-timer)
+ (time-subtract (timer--time org-timer-countdown-timer)
(current-time))))
(rsecs (nth 0 rtime))
(rmins (nth 1 rtime)))
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
-(defvar org-clock-sound)
-
;;;###autoload
(defun org-timer-set-timer (&optional opt)
- "Prompt for a duration and set a timer.
+ "Prompt for a duration in minutes or hh:mm:ss and set a timer.
-If `org-timer-default-timer' is not zero, suggest this value as
+If `org-timer-default-timer' is not \"0\", suggest this value as
the default duration for the timer. If a timer is already set,
prompt the user if she wants to replace it.
Called with a numeric prefix argument, use this numeric value as
-the duration of the timer.
+the duration of the timer in minutes.
Called with a `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration.
With two `C-u' prefix arguments, use `org-timer-default-timer'
without prompting the user for a duration and automatically
-replace any running timer."
+replace any running timer.
+
+By default, the timer duration will be set to the number of
+minutes in the Effort property, if any. You can ignore this by
+using three `C-u' prefix arguments."
(interactive "P")
- (let ((minutes (or (and (numberp opt) (number-to-string opt))
- (and (listp opt) (not (null opt))
- (number-to-string org-timer-default-timer))
- (read-from-minibuffer
- "How many minutes left? "
- (if (not (eq org-timer-default-timer 0))
- (number-to-string org-timer-default-timer))))))
+ (when (and org-timer-start-time
+ (not org-timer-countdown-timer))
+ (user-error "Relative timer is running. Stop first"))
+ (let* ((default-timer
+ ;; `org-timer-default-timer' used to be a number, don't choke:
+ (if (numberp org-timer-default-timer)
+ (number-to-string org-timer-default-timer)
+ org-timer-default-timer))
+ (effort-minutes (ignore-errors (floor (org-get-at-eol 'effort-minutes 1))))
+ (minutes (or (and (numberp opt) (number-to-string opt))
+ (and (not (equal opt '(64)))
+ effort-minutes
+ (number-to-string effort-minutes))
+ (and (consp opt) default-timer)
+ (and (stringp opt) opt)
+ (read-from-minibuffer
+ "How much time left? (minutes or h:mm:ss) "
+ (and (not (string-equal default-timer "0")) default-timer)))))
+ (when (string-match "\\`[0-9]+\\'" minutes)
+ (setq minutes (concat minutes ":00")))
(if (not (string-match "[0-9]+" minutes))
(org-timer-show-remaining-time)
- (let* ((mins (string-to-number (match-string 0 minutes)))
- (secs (* mins 60))
- (hl (cond
- ((string-match "Org Agenda" (buffer-name))
- (let* ((marker (or (get-text-property (point) 'org-marker)
- (org-agenda-error)))
- (hdmarker (or (get-text-property (point) 'org-hd-marker)
- marker))
- (pos (marker-position marker)))
- (with-current-buffer (marker-buffer marker)
- (widen)
- (goto-char pos)
- (org-show-entry)
- (or (ignore-errors (org-get-heading))
- (concat "File:" (file-name-nondirectory (buffer-file-name)))))))
- ((derived-mode-p 'org-mode)
- (or (ignore-errors (org-get-heading))
- (concat "File:" (file-name-nondirectory (buffer-file-name)))))
- (t (error "Not in an Org buffer"))))
- timer-set)
- (if (or (and org-timer-current-timer
- (or (equal opt '(16))
- (y-or-n-p "Replace current timer? ")))
- (not org-timer-current-timer))
- (progn
- (require 'org-clock)
- (when org-timer-current-timer
- (cancel-timer org-timer-current-timer))
- (setq org-timer-current-timer
- (run-with-timer
- secs nil `(lambda ()
- (setq org-timer-current-timer nil)
- (org-notify ,(format "%s: time out" hl) ,org-clock-sound)
- (setq org-timer-timer-is-countdown nil)
- (org-timer-set-mode-line 'off)
- (run-hooks 'org-timer-done-hook))))
- (run-hooks 'org-timer-set-hook)
- (setq org-timer-timer-is-countdown t
- org-timer-start-time
- (time-add (current-time) (seconds-to-time (* mins 60))))
- (org-timer-set-mode-line 'on))
- (message "No timer set"))))))
+ (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes))))
+ (if (and org-timer-countdown-timer
+ (not (or (equal opt '(16))
+ (y-or-n-p "Replace current timer? "))))
+ (message "No timer set")
+ (when (timerp org-timer-countdown-timer)
+ (cancel-timer org-timer-countdown-timer))
+ (setq org-timer-countdown-timer-title
+ (org-timer--get-timer-title))
+ (setq org-timer-countdown-timer
+ (org-timer--run-countdown-timer
+ secs org-timer-countdown-timer-title))
+ (run-hooks 'org-timer-set-hook)
+ (setq org-timer-start-time
+ (time-add (current-time) (seconds-to-time secs)))
+ (setq org-timer-pause-time nil)
+ (org-timer-set-mode-line 'on))))))
+
+(defun org-timer--run-countdown-timer (secs title)
+ "Start countdown timer that will last SECS.
+TITLE will be appended to the notification message displayed when
+time is up."
+ (let ((msg (format "%s: time out" title)))
+ (run-with-timer
+ secs nil `(lambda ()
+ (setq org-timer-countdown-timer nil
+ org-timer-start-time nil)
+ (org-notify ,msg ,org-clock-sound)
+ (org-timer-set-mode-line 'off)
+ (run-hooks 'org-timer-done-hook)))))
+
+(defun org-timer--get-timer-title ()
+ "Construct timer title from heading or file name of Org buffer."
+ (cond
+ ((derived-mode-p 'org-agenda-mode)
+ (let* ((marker (or (get-text-property (point) 'org-marker)
+ (org-agenda-error)))
+ (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)))))))
+ ((derived-mode-p 'org-mode)
+ (or (ignore-errors (org-get-heading))
+ (buffer-name (buffer-base-buffer))))
+ (t (error "Not in an Org buffer"))))
(provide 'org-timer)
diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el
index aae65cc6d37..749cbe063e8 100644
--- a/lisp/org/org-version.el
+++ b/lisp/org/org-version.el
@@ -3,15 +3,15 @@
;;; Code:
;;;###autoload
(defun org-release ()
- "The release version of org-mode.
- Inserted by installing org-mode or when a release is made."
- (let ((org-release "8.2.10"))
+ "The release version of Org.
+Inserted by installing Org mode or when a release is made."
+ (let ((org-release "9.1.4"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
- Inserted by installing org-mode or when a release is made."
- (let ((org-git-version "release_8.2.10"))
+Inserted by installing Org or when a release is made."
+ (let ((org-git-version "release_9.1.4-44-gfe7310"))
org-git-version))
(provide 'org-version)
diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el
index 8360bd07fe4..f396814dacc 100644
--- a/lisp/org/org-w3m.el
+++ b/lisp/org/org-w3m.el
@@ -1,4 +1,4 @@
-;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode
+;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*-
;; Copyright (C) 2008-2017 Free Software Foundation, Inc.
@@ -19,15 +19,15 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;; This file implements copying HTML content from a w3m buffer and
-;; transforming the text on the fly so that it can be pasted into
-;; an org-mode buffer with hot links. It will also work for regions
-;; in gnus buffers that have been washed with w3m.
+;; transforming the text on the fly so that it can be pasted into an
+;; Org buffer with hot links. It will also work for regions in gnus
+;; buffers that have been washed with w3m.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@@ -35,7 +35,7 @@
;; Richard Riley <rileyrgdev at googlemail dot com>
;;
-;; The idea of transforming the HTML content with org-mode style is
+;; The idea of transforming the HTML content with Org syntax is
;; proposed by Richard, I'm just coding it.
;;
@@ -46,7 +46,7 @@
(defvar w3m-current-url)
(defvar w3m-current-title)
-(add-hook 'org-store-link-functions 'org-w3m-store-link)
+(org-link-set-parameters "w3m" :store #'org-w3m-store-link)
(defun org-w3m-store-link ()
"Store a link to a w3m buffer."
(when (eq major-mode 'w3m-mode)
@@ -60,7 +60,7 @@
"Copy current buffer content or active region with `org-mode' style links.
This will encode `link-title' and `link-location' with
`org-make-link-string', and insert the transformed test into the kill ring,
-so that it can be yanked into an Org-mode buffer with links working correctly."
+so that it can be yanked into an Org buffer with links working correctly."
(interactive)
(let* ((regionp (org-region-active-p))
(transform-start (point-min))
@@ -107,7 +107,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly."
(concat return-content
(buffer-substring (point) transform-end))))
(org-kill-new return-content)
- (message "Transforming links...done, use C-y to insert text into Org-mode file")
+ (message "Transforming links...done, use C-y to insert text into Org file")
(message "Copy with link transformation complete."))))
(defun org-w3m-get-anchor-start ()
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 02a7a0c09af..07727f68c40 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -1,4 +1,4 @@
-;;; org.el --- Outline-based notes management and organizer
+;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*-
;; Carstens outline-mode for keeping track of everything.
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -21,27 +21,28 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;;; Commentary:
;;
-;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing
+;; Org is a mode for keeping notes, maintaining ToDo lists, and doing
;; project planning with a fast and effective plain-text system.
;;
-;; Org-mode develops organizational tasks around NOTES files that contain
-;; information about projects as plain text. Org-mode is implemented on
-;; top of outline-mode, which makes it possible to keep the content of
-;; large files well structured. Visibility cycling and structure editing
-;; help to work with the tree. Tables are easily created with a built-in
-;; table editor. Org-mode supports ToDo items, deadlines, time stamps,
-;; and scheduling. It dynamically compiles entries into an agenda that
-;; utilizes and smoothly integrates much of the Emacs calendar and diary.
-;; Plain text URL-like links connect to websites, emails, Usenet
-;; messages, BBDB entries, and any files related to the projects. For
-;; printing and sharing of notes, an Org-mode file can be exported as a
-;; structured ASCII file, as HTML, or (todo and agenda items only) as an
-;; iCalendar file. It can also serve as a publishing tool for a set of
-;; linked webpages.
+;; Org mode develops organizational tasks around NOTES files that
+;; contain information about projects as plain text. Org mode is
+;; implemented on top of outline-mode, which makes it possible to keep
+;; the content of large files well structured. Visibility cycling and
+;; structure editing help to work with the tree. Tables are easily
+;; created with a built-in table editor. Org mode supports ToDo
+;; items, deadlines, time stamps, and scheduling. It dynamically
+;; compiles entries into an agenda that utilizes and smoothly
+;; integrates much of the Emacs calendar and diary. Plain text
+;; URL-like links connect to websites, emails, Usenet messages, BBDB
+;; entries, and any files related to the projects. For printing and
+;; sharing of notes, an Org file can be exported as a structured ASCII
+;; file, as HTML, or (todo and agenda items only) as an iCalendar
+;; file. It can also serve as a publishing tool for a set of linked
+;; webpages.
;;
;; Installation and Activation
;; ---------------------------
@@ -51,11 +52,11 @@
;;
;; Documentation
;; -------------
-;; The documentation of Org-mode can be found in the TeXInfo file. The
+;; The documentation of Org mode can be found in the TeXInfo file. The
;; distribution also contains a PDF version of it. At the homepage of
-;; Org-mode, you can read the same text online as HTML. There is also an
+;; Org mode, you can read the same text online as HTML. There is also an
;; excellent reference card made by Philip Rooke. This card can be found
-;; in the etc/ directory of Emacs 22.
+;; in the doc/ directory.
;;
;; A list of recent changes can be found at
;; http://orgmode.org/Changes.html
@@ -63,21 +64,29 @@
;;; Code:
(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param
-(defvar org-table-formula-constants-local nil
+(defvar-local org-table-formula-constants-local nil
"Local version of `org-table-formula-constants'.")
-(make-variable-buffer-local 'org-table-formula-constants-local)
;;;; Require other packages
-(eval-when-compile
- (require 'cl)
- (require 'gnus-sum))
+(require 'cl-lib)
+
+(eval-when-compile (require 'gnus-sum))
(require 'calendar)
(require 'find-func)
(require 'format-spec)
-(load "org-loaddefs.el" t t t)
+(or (eq this-command 'eval-buffer)
+ (condition-case nil
+ (load (concat (file-name-directory load-file-name)
+ "org-loaddefs.el")
+ nil t t t)
+ (error
+ (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.")
+ (sit-for 3)
+ (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory")
+ (sit-for 3))))
(require 'org-macs)
(require 'org-compat)
@@ -101,75 +110,96 @@ sure that we are at the beginning of the line.")
"Matches a headline, putting stars and text into groups.
Stars are put in group 1 and the trimmed body in group 2.")
-;; Emacs 22 calendar compatibility: Make sure the new variables are available
-(unless (boundp 'calendar-view-holidays-initially-flag)
- (org-defvaralias 'calendar-view-holidays-initially-flag
- 'view-calendar-holidays-initially))
-(unless (boundp 'calendar-view-diary-initially-flag)
- (org-defvaralias 'calendar-view-diary-initially-flag
- 'view-diary-entries-initially))
-(unless (boundp 'diary-fancy-buffer)
- (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))
-
+(declare-function calendar-check-holidays "holidays" (date))
+(declare-function cdlatex-environment "ext:cdlatex" (environment item))
+(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag))
(declare-function org-add-archive-files "org-archive" (files))
-
-(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
-(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
-(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
-(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom))
+(declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour))
+(declare-function org-agenda-redo "org-agenda" (&optional all))
+(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-get-last-clock-out-time "org-clock" ())
-(declare-function org-clock-timestamps-up "org-clock" (&optional n))
-(declare-function org-clock-timestamps-down "org-clock" (&optional n))
+(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
+(declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname))
(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
+(declare-function org-clock-timestamps-down "org-clock" (&optional n))
+(declare-function org-clock-timestamps-up "org-clock" (&optional n))
(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 orgtbl-mode "org-table" (&optional arg))
-(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
-(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t)
-(declare-function org-table-edit-field "org-table" (arg))
-(declare-function org-table-justify-field-maybe "org-table" (&optional new))
-(declare-function org-table-set-constants "org-table" ())
-(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
-(declare-function org-id-get-create "org-id" (&optional force))
+(declare-function
+ org-duration-from-minutes "org-duration" (minutes &optional fmt 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))
+(declare-function org-element-contents "org-element" (element))
+(declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-copy "org-element" (datum))
+(declare-function org-element-interpret-data "org-element" (data))
+(declare-function org-element-lineage "org-element" (blob &optional types with-self))
+(declare-function org-element-link-parser "org-element" ())
+(declare-function org-element-nested-p "org-element" (elem-a elem-b))
+(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only))
+(declare-function org-element-property "org-element" (property element))
+(declare-function org-element-put-property "org-element" (element property value))
+(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
+(declare-function org-element-type "org-element" (element))
+(declare-function org-element-update-syntax "org-element" ())
(declare-function org-id-find-id-file "org-id" (id))
-(declare-function org-tags-view "org-agenda" (&optional todo-only match))
-(declare-function org-agenda-list "org-agenda"
- (&optional arg start-day span with-hour))
-(declare-function org-agenda-redo "org-agenda" (&optional all))
+(declare-function org-id-get-create "org-id" (&optional force))
+(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
+(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
+(declare-function org-plot/gnuplot "org-plot" (&optional params))
(declare-function org-table-align "org-table" ())
(declare-function org-table-begin "org-table" (&optional table-type))
+(declare-function org-table-beginning-of-field "org-table" (&optional n))
(declare-function org-table-blank-field "org-table" ())
+(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg))
+(declare-function org-table-copy-region "org-table" (beg end &optional cut))
+(declare-function org-table-cut-region "org-table" (beg end))
+(declare-function org-table-edit-field "org-table" (arg))
(declare-function org-table-end "org-table" (&optional table-type))
+(declare-function org-table-end-of-field "org-table" (&optional n))
(declare-function org-table-insert-row "org-table" (&optional arg))
-(declare-function org-table-paste-rectangle "org-table" ())
+(declare-function org-table-justify-field-maybe "org-table" (&optional new))
(declare-function org-table-maybe-eval-formula "org-table" ())
(declare-function org-table-maybe-recalculate-line "org-table" ())
+(declare-function org-table-next-row "org-table" ())
+(declare-function org-table-paste-rectangle "org-table" ())
+(declare-function org-table-recalculate "org-table" (&optional all noalign))
+(declare-function
+ org-table-sort-lines "org-table"
+ (&optional with-case sorting-type getkey-func compare-func interactive?))
+(declare-function org-table-wrap-region "org-table" (arg))
+(declare-function org-tags-view "org-agenda" (&optional todo-only match))
+(declare-function orgtbl-ascii-plot "org-table" (&optional ask))
+(declare-function orgtbl-mode "org-table" (&optional arg))
+(declare-function org-export-get-backend "ox" (name))
+(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
+(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?))
-(declare-function org-element--parse-objects "org-element"
- (beg end acc restriction))
-(declare-function org-element-at-point "org-element" (&optional keep-trail))
-(declare-function org-element-contents "org-element" (element))
-(declare-function org-element-context "org-element" (&optional element))
-(declare-function org-element-interpret-data "org-element"
- (data &optional parent))
-(declare-function org-element-map "org-element"
- (data types fun &optional
- info first-match no-recursion with-affiliated))
-(declare-function org-element-nested-p "org-element" (elem-a elem-b))
-(declare-function org-element-parse-buffer "org-element"
- (&optional granularity visible-only))
-(declare-function org-element-property "org-element" (property element))
-(declare-function org-element-put-property "org-element"
- (element property value))
-(declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
-(declare-function org-element--parse-objects "org-element"
- (beg end acc restriction))
-(declare-function org-element-parse-buffer "org-element"
- (&optional granularity visible-only))
-(declare-function org-element-restriction "org-element" (element))
-(declare-function org-element-type "org-element" (element))
+(defvar ffap-url-regexp)
+(defvar org-element-paragraph-separate)
+
+(defsubst org-uniquify (list)
+ "Non-destructively remove duplicate elements from LIST."
+ (let ((res (copy-sequence list))) (delete-dups res)))
+
+(defsubst org-get-at-bol (property)
+ "Get text property PROPERTY at the beginning of line."
+ (get-text-property (point-at-bol) property))
+
+(defsubst org-trim (s &optional keep-lead)
+ "Remove whitespace at the beginning and the end of string S.
+When optional argument KEEP-LEAD is non-nil, removing blank lines
+at the beginning of the string does not affect leading indentation."
+ (replace-regexp-in-string
+ (if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") ""
+ (replace-regexp-in-string "[ \t\n\r]+\\'" "" s)))
;; load languages based on value of `org-babel-load-languages'
(defvar org-babel-load-languages)
@@ -178,28 +208,24 @@ Stars are put in group 1 and the trimmed body in group 2.")
(defun org-babel-do-load-languages (sym value)
"Load the languages defined in `org-babel-load-languages'."
(set-default sym value)
- (mapc (lambda (pair)
- (let ((active (cdr pair)) (lang (symbol-name (car pair))))
- (if active
- (progn
- (require (intern (concat "ob-" lang))))
- (progn
- (funcall 'fmakunbound
- (intern (concat "org-babel-execute:" lang)))
- (funcall 'fmakunbound
- (intern (concat "org-babel-expand-body:" lang)))))))
- org-babel-load-languages))
+ (dolist (pair org-babel-load-languages)
+ (let ((active (cdr pair)) (lang (symbol-name (car pair))))
+ (if active
+ (require (intern (concat "ob-" lang)))
+ (funcall 'fmakunbound
+ (intern (concat "org-babel-execute:" lang)))
+ (funcall 'fmakunbound
+ (intern (concat "org-babel-expand-body:" lang)))))))
(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
;;;###autoload
(defun org-babel-load-file (file &optional compile)
- "Load Emacs Lisp source code blocks in the Org-mode FILE.
+ "Load Emacs Lisp source code blocks in the Org FILE.
This function exports the source code using `org-babel-tangle'
and then loads the resulting file using `load-file'. With prefix
arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp
file to byte-code before it is loaded."
(interactive "fFile to load: \nP")
- (require 'ob-core)
(let* ((age (lambda (file)
(float-time
(time-subtract (current-time)
@@ -207,11 +233,13 @@ file to byte-code before it is loaded."
(file-attributes file)))))))
(base-name (file-name-sans-extension file))
(exported-file (concat base-name ".el")))
- ;; tangle if the org-mode file is newer than the elisp file
+ ;; tangle if the Org file is newer than the elisp file
(unless (and (file-exists-p exported-file)
(> (funcall age file) (funcall age exported-file)))
+ ;; Tangle-file traversal returns reversed list of tangled files
+ ;; and we want to evaluate the first target.
(setq exported-file
- (car (org-babel-tangle-file file exported-file "emacs-lisp"))))
+ (car (last (org-babel-tangle-file file exported-file "emacs-lisp")))))
(message "%s %s"
(if compile
(progn (byte-compile-file exported-file 'load)
@@ -220,7 +248,7 @@ file to byte-code before it is loaded."
exported-file)))
(defcustom org-babel-load-languages '((emacs-lisp . t))
- "Languages which can be evaluated in Org-mode buffers.
+ "Languages which can be evaluated in Org buffers.
This list can be used to load support for any of the languages
below, note that each language will depend on a different set of
system executables and/or Emacs modes. When a language is
@@ -245,11 +273,15 @@ requirements) is loaded."
(const :tag "CSS" css)
(const :tag "Ditaa" ditaa)
(const :tag "Dot" dot)
+ (const :tag "Ebnf2ps" ebnf2ps)
(const :tag "Emacs Lisp" emacs-lisp)
+ (const :tag "Forth" forth)
(const :tag "Fortran" fortran)
(const :tag "Gnuplot" gnuplot)
(const :tag "Haskell" haskell)
+ (const :tag "hledger" hledger)
(const :tag "IO" io)
+ (const :tag "J" J)
(const :tag "Java" java)
(const :tag "Javascript" js)
(const :tag "LaTeX" latex)
@@ -272,10 +304,12 @@ requirements) is loaded."
(const :tag "Scala" scala)
(const :tag "Scheme" scheme)
(const :tag "Screen" screen)
- (const :tag "Shell Script" sh)
+ (const :tag "Shell Script" shell)
(const :tag "Shen" shen)
(const :tag "Sql" sql)
- (const :tag "Sqlite" sqlite))
+ (const :tag "Sqlite" sqlite)
+ (const :tag "Stan" stan)
+ (const :tag "Vala" vala))
:value-type (boolean :tag "Activate" :value t)))
;;;; Customization variables
@@ -293,41 +327,319 @@ identifier."
;;;###autoload
(defun org-version (&optional here full message)
- "Show the org-mode version in the echo area.
-With prefix argument HERE, insert it at point.
-When FULL is non-nil, use a verbose version string.
-When MESSAGE is non-nil, display a message with the version."
- (interactive "P")
- (let* ((org-dir (ignore-errors (org-find-library-dir "org")))
- (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
- (load-suffixes (list ".el"))
- (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs")))
- (org-trash (or
- (and (fboundp 'org-release) (fboundp 'org-git-version))
- (org-load-noerror-mustsuffix (concat org-dir "org-version"))))
- (load-suffixes save-load-suffixes)
- (org-version (org-release))
- (git-version (org-git-version))
- (version (format "Org-mode version %s (%s @ %s)"
- org-version
- git-version
- (if org-install-dir
- (if (string= org-dir org-install-dir)
- org-install-dir
- (concat "mixed installation! " org-install-dir " and " org-dir))
- "org-loaddefs.el can not be found!")))
- (version1 (if full version org-version)))
- (if (org-called-interactively-p 'interactive)
- (if here
- (insert version)
- (message version))
- (if message (message version1))
+ "Show the Org version.
+Interactively, or when MESSAGE is non-nil, show it in echo area.
+With prefix argument, or when HERE is non-nil, insert it at point.
+In non-interactive uses, a reduced version string is output unless
+FULL is given."
+ (interactive (list current-prefix-arg t (not current-prefix-arg)))
+ (let ((org-dir (ignore-errors (org-find-library-dir "org")))
+ (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes))
+ (load-suffixes (list ".el"))
+ (org-install-dir
+ (ignore-errors (org-find-library-dir "org-loaddefs"))))
+ (unless (and (fboundp 'org-release) (fboundp 'org-git-version))
+ (org-load-noerror-mustsuffix (concat org-dir "org-version")))
+ (let* ((load-suffixes save-load-suffixes)
+ (release (org-release))
+ (git-version (org-git-version))
+ (version (format "Org mode version %s (%s @ %s)"
+ release
+ git-version
+ (if org-install-dir
+ (if (string= org-dir org-install-dir)
+ org-install-dir
+ (concat "mixed installation! "
+ org-install-dir
+ " and "
+ org-dir))
+ "org-loaddefs.el can not be found!")))
+ (version1 (if full version release)))
+ (when here (insert version1))
+ (when message (message "%s" version1))
version1)))
(defconst org-version (org-version))
-;;; Compatibility constants
+
+;;; Syntax Constants
+
+;;;; Block
+(defconst org-block-regexp
+ "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
+ "Regular expression for hiding blocks.")
+
+(defconst org-dblock-start-re
+ "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
+ "Matches the start line of a dynamic block, with parameters.")
+
+(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
+ "Matches the end of a dynamic block.")
+
+;;;; Clock and Planning
+
+(defconst org-clock-string "CLOCK:"
+ "String used as prefix for timestamps clocking work hours on an item.")
+
+(defvar org-closed-string "CLOSED:"
+ "String used as the prefix for timestamps logging closing a TODO entry.")
+
+(defvar org-deadline-string "DEADLINE:"
+ "String to mark deadline entries.
+\\<org-mode-map>
+A deadline is this string, followed by a time stamp. It must be
+a word, terminated by a colon. You can insert a schedule keyword
+and a timestamp with `\\[org-deadline]'.")
+
+(defvar org-scheduled-string "SCHEDULED:"
+ "String to mark scheduled TODO entries.
+\\<org-mode-map>
+A schedule is this string, followed by a time stamp. It must be
+a word, terminated by a colon. You can insert a schedule keyword
+and a timestamp with `\\[org-schedule]'.")
+
+(defconst org-ds-keyword-length
+ (+ 2
+ (apply #'max
+ (mapcar #'length
+ (list org-deadline-string org-scheduled-string
+ org-clock-string org-closed-string))))
+ "Maximum length of the DEADLINE and SCHEDULED keywords.")
+
+(defconst org-planning-line-re
+ (concat "^[ \t]*"
+ (regexp-opt
+ (list org-closed-string org-deadline-string org-scheduled-string)
+ t))
+ "Matches a line with planning info.
+Matched keyword is in group 1.")
+
+(defconst org-clock-line-re
+ (concat "^[ \t]*" org-clock-string)
+ "Matches a line with clock info.")
+
+(defconst org-deadline-regexp (concat "\\<" org-deadline-string)
+ "Matches the DEADLINE keyword.")
+
+(defconst org-deadline-time-regexp
+ (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
+ "Matches the DEADLINE keyword together with a time stamp.")
+
+(defconst org-deadline-time-hour-regexp
+ (concat "\\<" org-deadline-string
+ " *<\\([^>]+[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
+ (concat "\\<\\(" org-deadline-string "\\).*")
+ "Matches the DEADLINE keyword and the rest of the line.")
+
+(defconst org-scheduled-regexp (concat "\\<" org-scheduled-string)
+ "Matches the SCHEDULED keyword.")
+
+(defconst org-scheduled-time-regexp
+ (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
+ "Matches the SCHEDULED keyword together with a time stamp.")
+
+(defconst org-scheduled-time-hour-regexp
+ (concat "\\<" org-scheduled-string
+ " *<\\([^>]+[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
+ (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
+ "Matches the CLOSED keyword together with a time stamp.")
+
+(defconst org-keyword-time-regexp
+ (concat "\\<"
+ (regexp-opt
+ (list org-scheduled-string org-deadline-string org-closed-string
+ org-clock-string)
+ t)
+ " *[[<]\\([^]>]+\\)[]>]")
+ "Matches any of the 4 keywords, together with the time stamp.")
+
+(defconst org-keyword-time-not-clock-regexp
+ (concat
+ "\\<"
+ (regexp-opt
+ (list org-scheduled-string org-deadline-string org-closed-string) t)
+ " *[[<]\\([^]>]+\\)[]>]")
+ "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
+ org-clock-string org-closed-string))
+ "List of time keywords.")
+
+;;;; Drawer
+
+(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$"
+ "Matches first or last line of a hidden block.
+Group 1 contains drawer's name or \"END\".")
+
+(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
+ "Regular expression matching the first line of a property drawer.")
+
+(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
+ "Regular expression matching the last line of a property drawer.")
+
+(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
+ "Regular expression matching the first line of a clock drawer.")
+
+(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
+ "Regular expression matching the last line of a clock drawer.")
+
+(defconst org-property-drawer-re
+ (concat "^[ \t]*:PROPERTIES:[ \t]*\n"
+ "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?"
+ "[ \t]*:END:[ \t]*$")
+ "Matches an entire property drawer.")
+
+(defconst org-clock-drawer-re
+ (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\("
+ org-clock-drawer-end-re "\\)\n?")
+ "Matches an entire clock drawer.")
+
+;;;; Headline
+
+(defconst org-heading-keyword-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching a headline with some keyword.
+This regexp will match the headline of any node which has the
+exact keyword that is put into the format. The keyword isn't in
+any group by default, but the stars and the body are.")
+
+(defconst org-heading-keyword-maybe-regexp-format
+ "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
+ "Printf format for a regexp matching a headline, possibly with some keyword.
+This regexp can match any headline with the specified keyword, or
+without a keyword. The keyword isn't in any group by default,
+but the stars and the body are.")
+
+(defconst org-archive-tag "ARCHIVE"
+ "The tag that marks a subtree as archived.
+An archived subtree does not open during visibility cycling, and does
+not contribute to the agenda listings.")
+
+(eval-and-compile
+ (defconst org-comment-string "COMMENT"
+ "Entries starting with this keyword will never be exported.
+\\<org-mode-map>
+An entry can be toggled between COMMENT and normal with
+`\\[org-toggle-comment]'."))
+
+
+;;;; LaTeX Environments and Fragments
+
+(defconst org-latex-regexps
+ '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
+ ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil)
+ ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
+ ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
+ ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil)
+ ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
+ ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
+ ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
+ "Regular expressions for matching embedded LaTeX.")
+
+;;;; Node Property
+
+(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.")
+
+;;;; Table
+
+(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
+ "Detect an org-type or table-type table.")
+
+(defconst org-table-line-regexp "^[ \t]*|"
+ "Detect an org-type table line.")
+
+(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
+ "Detect an org-type table line.")
+
+(defconst org-table-hline-regexp "^[ \t]*|-"
+ "Detect an org-type table hline.")
+
+(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
+ "Detect a table-type table hline.")
+
+(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
+ "Detect the first line outside a table when searching from within it.
+This works for both table types.")
+
+(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
+ "Detect a #+TBLFM line.")
+
+;;;; 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.")
+
+
;;; The custom variables
(defgroup org nil
@@ -337,7 +649,7 @@ When MESSAGE is non-nil, display a message with the version."
:group 'calendar)
(defcustom org-mode-hook nil
- "Mode hook for Org-mode, run after the mode was turned on."
+ "Mode hook for Org mode, run after the mode was turned on."
:group 'org
:type 'hook)
@@ -359,17 +671,17 @@ When MESSAGE is non-nil, display a message with the version."
(defun org-load-modules-maybe (&optional force)
"Load all extensions listed in `org-modules'."
(when (or force (not org-modules-loaded))
- (mapc (lambda (ext)
- (condition-case nil (require ext)
- (error (message "Problems while trying to load feature `%s'" ext))))
- org-modules)
+ (dolist (ext org-modules)
+ (condition-case nil (require ext)
+ (error (message "Problems while trying to load feature `%s'" ext))))
(setq org-modules-loaded t)))
(defun org-set-modules (var value)
"Set VAR to VALUE and call `org-load-modules-maybe' with the force flag."
(set var value)
(when (featurep 'org)
- (org-load-modules-maybe 'force)))
+ (org-load-modules-maybe 'force)
+ (org-element-cache-reset 'all)))
(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail)
"Modules that should always be loaded together with org.el.
@@ -397,6 +709,7 @@ For export specific modules, see also `org-export-backends'."
(const :tag " crypt: Encryption of subtrees" org-crypt)
(const :tag " ctags: Access to Emacs tags with links" org-ctags)
(const :tag " docview: Links to doc-view buffers" org-docview)
+ (const :tag " eww: Store link to url of eww" org-eww)
(const :tag " gnus: Links to GNUS folders/messages" org-gnus)
(const :tag " habit: Track your consistency with habits" org-habit)
(const :tag " id: Global IDs for identifying entries" org-id)
@@ -407,52 +720,49 @@ For export specific modules, see also `org-export-backends'."
(const :tag " mouse: Additional mouse support" org-mouse)
(const :tag " protocol: Intercept calls from emacsclient" org-protocol)
(const :tag " rmail: Links to RMAIL folders/messages" org-rmail)
- (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m)
+ (const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m)
(const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file)
- (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark)
- (const :tag "C bullets: Add overlays to headlines stars" org-bullets)
+ (const :tag "C bookmark: Org links to bookmarks" org-bookmark)
(const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist)
(const :tag "C choose: Use TODO keywords to mark decisions states" org-choose)
(const :tag "C collector: Collect properties into tables" org-collector)
- (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
- (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill)
- (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol)
+ (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend)
+ (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill)
+ (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol)
(const :tag "C eshell Support for links to working directories in eshell" org-eshell)
(const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light)
(const :tag "C eval: Include command output as text" org-eval)
- (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry)
+ (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry)
(const :tag "C favtable: Lookup table of favorite references and links" org-favtable)
(const :tag "C git-link: Provide org links to specific file version" org-git-link)
(const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query)
- (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice)
- (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira)
+ (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice)
(const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
(const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
(const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link)
- (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
- (const :tag "C man: Support for links to manpages in Org-mode" org-man)
+ (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix)
+ (const :tag "C man: Support for links to manpages in Org mode" org-man)
(const :tag "C mew: Links to Mew folders/messages" org-mew)
(const :tag "C mtags: Support for muse-like tags" org-mtags)
(const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch)
(const :tag "C panel: Simple routines for us with bad memory" org-panel)
- (const :tag "C registry: A registry for Org-mode links" org-registry)
- (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen)
+ (const :tag "C registry: A registry for Org links" org-registry)
+ (const :tag "C screen: Visit screen sessions through Org links" org-screen)
(const :tag "C secretary: Team management with org-mode" org-secretary)
- (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert)
- (const :tag "C toc: Table of contents for Org-mode buffer" org-toc)
- (const :tag "C track: Keep up with Org-mode development" org-track)
+ (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert)
+ (const :tag "C toc: Table of contents for Org buffer" org-toc)
+ (const :tag "C track: Keep up with Org mode development" org-track)
(const :tag "C velocity Something like Notational Velocity for Org" org-velocity)
(const :tag "C vm: Links to VM folders/messages" org-vm)
(const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes)
(const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
-(defvar org-export--registered-backends) ; From ox.el.
+(defvar org-export-registered-backends) ; From ox.el.
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
(declare-function org-export-backend-name "ox" (backend) t)
-(declare-function org-export-backend-options "ox" (cl-x) t)
-(defcustom org-export-backends '(ascii html icalendar latex)
+(defcustom org-export-backends '(ascii html icalendar latex odt)
"List of export back-ends that should be always available.
If a description starts with <C>, the file is not part of Emacs
@@ -469,8 +779,8 @@ interface or run the following code, where VAL stands for the new
value of the variable, after updating it:
(progn
- (setq org-export--registered-backends
- (org-remove-if-not
+ (setq org-export-registered-backends
+ (cl-remove-if-not
(lambda (backend)
(let ((name (org-export-backend-name backend)))
(or (memq name val)
@@ -478,9 +788,9 @@ value of the variable, after updating it:
(dolist (b val)
(and (org-export-derived-backend-p b name)
(throw \\='parentp t)))))))
- org-export--registered-backends))
- (let ((new-list (mapcar \\='org-export-backend-name
- org-export--registered-backends)))
+ org-export-registered-backends))
+ (let ((new-list (mapcar #\\='org-export-backend-name
+ org-export-registered-backends)))
(dolist (backend val)
(cond
((not (load (format \"ox-%s\" backend) t t))
@@ -493,16 +803,16 @@ Adding a back-end to this list will also pull the back-end it
depends on, if any."
:group 'org
:group 'org-export
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "9.0")
:initialize 'custom-initialize-set
:set (lambda (var val)
(if (not (featurep 'ox)) (set-default var val)
;; Any back-end not required anymore (not present in VAL and not
;; a parent of any back-end in the new value) is removed from the
;; list of registered back-ends.
- (setq org-export--registered-backends
- (org-remove-if-not
+ (setq org-export-registered-backends
+ (cl-remove-if-not
(lambda (backend)
(let ((name (org-export-backend-name backend)))
(or (memq name val)
@@ -510,11 +820,11 @@ depends on, if any."
(dolist (b val)
(and (org-export-derived-backend-p b name)
(throw 'parentp t)))))))
- org-export--registered-backends))
+ org-export-registered-backends))
;; Now build NEW-LIST of both new back-ends and required
;; parents.
- (let ((new-list (mapcar 'org-export-backend-name
- org-export--registered-backends)))
+ (let ((new-list (mapcar #'org-export-backend-name
+ org-export-registered-backends)))
(dolist (backend val)
(cond
((not (load (format "ox-%s" backend) t t))
@@ -544,19 +854,18 @@ depends on, if any."
(const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler)))
(eval-after-load 'ox
- '(mapc
- (lambda (backend)
- (condition-case nil (require (intern (format "ox-%s" backend)))
- (error (message "Problems while trying to load export back-end `%s'"
- backend))))
- org-export-backends))
+ '(dolist (backend org-export-backends)
+ (condition-case nil (require (intern (format "ox-%s" backend)))
+ (error (message "Problems while trying to load export back-end `%s'"
+ backend)))))
(defcustom org-support-shift-select nil
"Non-nil means make shift-cursor commands select text when possible.
+\\<org-mode-map>\
In Emacs 23, when `shift-select-mode' is on, shifted cursor keys
start selecting a region, or enlarge regions started in this way.
-In Org-mode, in special contexts, these same keys are used for
+In Org mode, in special contexts, these same keys are used for
other purposes, important enough to compete with shift selection.
Org tries to balance these needs by supporting `shift-select-mode'
outside these special contexts, under control of this variable.
@@ -571,7 +880,7 @@ cursor keys will then execute Org commands in the following contexts:
Outside these contexts, the commands will throw an error.
When this variable is t and the cursor is not in a special
-context, Org-mode will support shift-selection for making and
+context, Org mode will support shift-selection for making and
enlarging regions. To make this more effective, the bullet
cycling will no longer happen anywhere in an item line, but only
if the cursor is exactly on the bullet.
@@ -579,16 +888,16 @@ 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: `C-c C-t'
-and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t'
-can be used to switch TODO sets, `C-c -' to cycle item bullet
-types, and properties can be edited by hand or in column view.
+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]' \
+can be used to switch TODO sets,
+`\\[org-ctrl-c-minus]' to cycle item bullet types,
+and properties can be edited by hand or in column view.
However, when the cursor is on a timestamp, shift-cursor commands
-will still edit the time stamp - this is just too good to give up.
-
-XEmacs user should have this variable set to nil, because
-`shift-select-mode' is in Emacs 23 or later only."
+will still edit the time stamp - this is just too good to give up."
:group 'org
:type '(choice
(const :tag "Never" nil)
@@ -622,12 +931,13 @@ already archived entries."
:group 'org-archive)
(defgroup org-startup nil
- "Options concerning startup of Org-mode."
+ "Options concerning startup of Org mode."
:tag "Org Startup"
:group 'org)
(defcustom org-startup-folded t
- "Non-nil means entering Org-mode will switch to OVERVIEW.
+ "Non-nil means entering Org mode will switch to OVERVIEW.
+
This can also be configured on a per-file basis by adding one of
the following lines anywhere in the buffer:
@@ -636,9 +946,9 @@ the following lines anywhere in the buffer:
#+STARTUP: content
#+STARTUP: showeverything
-By default, this option is ignored when Org opens agenda files
-for the first time. If you want the agenda to honor the startup
-option, set `org-agenda-inhibit-startup' to nil."
+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
:type '(choice
(const :tag "nofold: show all" nil)
@@ -647,9 +957,18 @@ option, set `org-agenda-inhibit-startup' to nil."
(const :tag "show everything, even drawers" showeverything)))
(defcustom org-startup-truncated t
- "Non-nil means entering Org-mode will set `truncate-lines'.
+ "Non-nil means entering Org mode will set `truncate-lines'.
This is useful since some lines containing links can be very long and
-uninteresting. Also tables look terrible when wrapped."
+uninteresting. Also tables look terrible when wrapped.
+
+The variable `org-startup-truncated' allows to configure
+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
+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
:type 'boolean)
@@ -742,26 +1061,26 @@ the following lines anywhere in the buffer:
:type 'boolean)
(defcustom org-insert-mode-line-in-empty-file nil
- "Non-nil means insert the first line setting Org-mode in empty files.
+ "Non-nil means insert the first line setting Org mode in empty files.
When the function `org-mode' is called interactively in an empty file, this
-normally means that the file name does not automatically trigger Org-mode.
-To ensure that the file will always be in Org-mode in the future, a
-line enforcing Org-mode will be inserted into the buffer, if this option
+normally means that the file name does not automatically trigger Org mode.
+To ensure that the file will always be in Org mode in the future, a
+line enforcing Org mode will be inserted into the buffer, if this option
has been set."
:group 'org-startup
:type 'boolean)
(defcustom org-replace-disputed-keys nil
"Non-nil means use alternative key bindings for some keys.
-Org-mode uses S-<cursor> keys for changing timestamps and priorities.
+Org mode uses S-<cursor> keys for changing timestamps and priorities.
These keys are also used by other packages like shift-selection-mode'
\(built into Emacs 23), `CUA-mode' or `windmove.el'.
-If you want to use Org-mode together with one of these other modes,
-or more generally if you would like to move some Org-mode commands to
+If you want to use Org mode together with one of these other modes,
+or more generally if you would like to move some Org mode commands to
other keys, set this variable and configure the keys with the variable
`org-disputed-keys'.
-This option is only relevant at load-time of Org-mode, and must be set
+This option is only relevant at load-time of Org mode, and must be set
*before* org.el is loaded. Changing it requires a restart of Emacs to
become effective."
:group 'org-startup
@@ -769,18 +1088,13 @@ become effective."
(defcustom org-use-extra-keys nil
"Non-nil means use extra key sequence definitions for certain commands.
-This happens automatically if you run XEmacs or if `window-system'
-is nil. This variable lets you do the same manually. You must
-set it before loading org.
-
-Example: on Carbon Emacs 22 running graphically, with an external
-keyboard on a Powerbook, the default way of setting M-left might
-not work for either Alt or ESC. Setting this variable will make
-it work for ESC."
+This happens automatically if `window-system' is nil. This
+variable lets you do the same manually. You must set it before
+loading Org."
:group 'org-startup
:type 'boolean)
-(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
+(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys)
(defcustom org-disputed-keys
'(([(shift up)] . [(meta p)])
@@ -789,90 +1103,52 @@ it work for ESC."
([(shift right)] . [(meta +)])
([(control shift right)] . [(meta shift +)])
([(control shift left)] . [(meta shift -)]))
- "Keys for which Org-mode and other modes compete.
+ "Keys for which Org mode and other modes compete.
This is an alist, cars are the default keys, second element specifies
the alternative to use when `org-replace-disputed-keys' is t.
Keys can be specified in any syntax supported by `define-key'.
-The value of this option takes effect only at Org-mode's startup,
+The value of this option takes effect only at Org mode startup,
therefore you'll have to restart Emacs to apply it after changing."
:group 'org-startup
:type 'alist)
(defun org-key (key)
"Select key according to `org-replace-disputed-keys' and `org-disputed-keys'.
-Or return the original if not disputed.
-Also apply the translations defined in `org-xemacs-key-equivalents'."
+Or return the original if not disputed."
(when org-replace-disputed-keys
(let* ((nkey (key-description key))
- (x (org-find-if (lambda (x)
- (equal (key-description (car x)) nkey))
- org-disputed-keys)))
+ (x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey))
+ org-disputed-keys)))
(setq key (if x (cdr x) key))))
- (when (featurep 'xemacs)
- (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key)))
key)
-(defun org-find-if (predicate seq)
- (catch 'exit
- (while seq
- (if (funcall predicate (car seq))
- (throw 'exit (car seq))
- (pop seq)))))
-
(defun org-defkey (keymap key def)
"Define a key, possibly translated, as returned by `org-key'."
(define-key keymap (org-key key) def))
(defcustom org-ellipsis nil
- "The ellipsis to use in the Org-mode outline.
-When nil, just use the standard three dots.
-When a string, use that string instead.
-When a face, use the standard 3 dots, but with the specified face.
-The change affects only Org-mode (which will then use its own display table).
+ "The ellipsis to use in the Org mode outline.
+
+When nil, just use the standard three dots. When a non-empty string,
+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."
:group 'org-startup
:type '(choice (const :tag "Default" nil)
- (face :tag "Face" :value org-warning)
- (string :tag "String" :value "...#")))
+ (string :tag "String" :value "...#"))
+ :safe (lambda (v) (and (string-or-null-p v) (not (equal "" v)))))
(defvar org-display-table nil
- "The display table for org-mode, in case `org-ellipsis' is non-nil.")
+ "The display table for Org mode, in case `org-ellipsis' is non-nil.")
(defgroup org-keywords nil
- "Keywords in Org-mode."
+ "Keywords in Org mode."
:tag "Org Keywords"
:group 'org)
-(defcustom org-deadline-string "DEADLINE:"
- "String to mark deadline entries.
-A deadline is this string, followed by a time stamp. Should be a word,
-terminated by a colon. You can insert a schedule keyword and
-a timestamp with \\[org-deadline].
-Changes become only effective after restarting Emacs."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-scheduled-string "SCHEDULED:"
- "String to mark scheduled TODO entries.
-A schedule is this string, followed by a time stamp. Should be a word,
-terminated by a colon. You can insert a schedule keyword and
-a timestamp with \\[org-schedule].
-Changes become only effective after restarting Emacs."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-closed-string "CLOSED:"
- "String used as the prefix for timestamps logging closing a TODO entry."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-clock-string "CLOCK:"
- "String used as prefix for timestamps clocking work hours on an item."
- :group 'org-keywords
- :type 'string)
-
(defcustom org-closed-keep-when-no-todo nil
"Remove CLOSED: time-stamp when switching back to a non-todo state?"
:group 'org-todo
@@ -881,37 +1157,8 @@ Changes become only effective after restarting Emacs."
:package-version '(Org . "8.0")
:type 'boolean)
-(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\("
- org-scheduled-string "\\|"
- org-deadline-string "\\|"
- org-closed-string "\\|"
- org-clock-string "\\)")
- "Matches a line with planning or clock info.")
-
-(defcustom org-comment-string "COMMENT"
- "Entries starting with this keyword will never be exported.
-An entry can be toggled between COMMENT and normal with
-\\[org-toggle-comment].
-Changes become only effective after restarting Emacs."
- :group 'org-keywords
- :type 'string)
-
-(defcustom org-quote-string "QUOTE"
- "Entries starting with this keyword will be exported in fixed-width font.
-Quoting applies only to the text in the entry following the headline, and does
-not extend beyond the next headline, even if that is lower level.
-An entry can be toggled between QUOTE and normal with
-\\[org-toggle-fixed-width-section]."
- :group 'org-keywords
- :type 'string)
-
-(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.")
-
(defgroup org-structure nil
- "Options concerning the general structure of Org-mode files."
+ "Options concerning the general structure of Org files."
:tag "Org Structure"
:group 'org)
@@ -920,92 +1167,88 @@ After a match, group 1 contains the repeat expression.")
:tag "Org Reveal Location"
:group 'org-structure)
-(defconst org-context-choice
- '(choice
- (const :tag "Always" t)
- (const :tag "Never" nil)
- (repeat :greedy t :tag "Individual contexts"
- (cons
- (choice :tag "Context"
- (const agenda)
- (const org-goto)
- (const occur-tree)
- (const tags-tree)
- (const link-search)
- (const mark-goto)
- (const bookmark-jump)
- (const isearch)
- (const default))
- (boolean))))
- "Contexts for the reveal options.")
-
-(defcustom org-show-hierarchy-above '((default . t))
- "Non-nil means show full hierarchy when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the hierarchy of headings
-above the exposed location is shown.
-Turning this off for example for sparse trees makes them very compact.
-Instead of t, this can also be an alist specifying this option for different
-contexts. Valid contexts are
+(defcustom org-show-context-detail '((agenda . local)
+ (bookmark-jump . lineage)
+ (isearch . lineage)
+ (default . ancestors))
+ "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
+around point. How much is shown depends on the initial action,
+or context. Valid contexts are
+
agenda when exposing an entry from the agenda
- org-goto when using the command `org-goto' on key C-c C-j
- occur-tree when using the command `org-occur' on key C-c /
+ org-goto when using the command `org-goto' (`\\[org-goto]')
+ occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /')
tags-tree when constructing a sparse tree based on tags matches
link-search when exposing search matches associated with a link
mark-goto when exposing the jump goal of a mark
bookmark-jump when exposing a bookmark location
isearch when exiting from an incremental search
- default default for all contexts not set explicitly"
- :group 'org-reveal-location
- :type org-context-choice)
-
-(defcustom org-show-following-heading '((default . nil))
- "Non-nil means show following heading when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the heading following the
-match is shown.
-Turning this off for example for sparse trees makes them very compact,
-but makes it harder to edit the location of the match. In such a case,
-use the command \\[org-reveal] to show more context.
-Instead of t, this can also be an alist specifying this option for different
-contexts. See `org-show-hierarchy-above' for valid contexts."
- :group 'org-reveal-location
- :type org-context-choice)
-
-(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t))
- "Non-nil means show all sibling heading when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the sibling of the current entry
-heading are all made visible. If `org-show-hierarchy-above' is t,
-the same happens on each level of the hierarchy above the current entry.
-
-By default this is on for the isearch context, off for all other contexts.
-Turning this off for example for sparse trees makes them very compact,
-but makes it harder to edit the location of the match. In such a case,
-use the command \\[org-reveal] to show more context.
-Instead of t, this can also be an alist specifying this option for different
-contexts. See `org-show-hierarchy-above' for valid contexts."
- :group 'org-reveal-location
- :type org-context-choice
- :version "24.4"
- :package-version '(Org . "8.0"))
+ default default for all contexts not set explicitly
+
+Allowed visibility spans are
+
+ minimal show current headline; if point is not on headline,
+ also show entry
+
+ local show current headline, entry and next headline
+
+ ancestors show current headline and its direct ancestors; if
+ point is not on headline, also show entry
+
+ lineage show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and first child
+
+ tree show current headline, its direct ancestors and all
+ their children; if point is not on headline, also show
+ entry and all children
+
+ canonical show current headline, its direct ancestors along with
+ their entries and children; if point is not located on
+ the headline, also show current entry and all children
-(defcustom org-show-entry-below '((default . nil))
- "Non-nil means show the entry below a headline when revealing a location.
-Org-mode often shows locations in an org-mode file which might have
-been invisible before. When this is set, the text below the headline that is
-exposed is also shown.
+As special cases, a nil or t value means show all contexts in
+`minimal' or `canonical' view, respectively.
-By default this is off for all contexts.
-Instead of t, this can also be an alist specifying this option for different
-contexts. See `org-show-hierarchy-above' for valid contexts."
+Some views can make displayed information very compact, but also
+make it harder to edit the location of the match. In such
+a case, use the command `org-reveal' (`\\[org-reveal]') to show
+more context."
:group 'org-reveal-location
- :type org-context-choice)
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type '(choice
+ (const :tag "Canonical" t)
+ (const :tag "Minimal" nil)
+ (repeat :greedy t :tag "Individual contexts"
+ (cons
+ (choice :tag "Context"
+ (const agenda)
+ (const org-goto)
+ (const occur-tree)
+ (const tags-tree)
+ (const link-search)
+ (const mark-goto)
+ (const bookmark-jump)
+ (const isearch)
+ (const default))
+ (choice :tag "Detail level"
+ (const minimal)
+ (const local)
+ (const ancestors)
+ (const lineage)
+ (const tree)
+ (const canonical))))))
(defcustom org-indirect-buffer-display 'other-window
"How should indirect tree buffers be displayed?
+
This applies to indirect buffers created with the commands
-\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer].
+`org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'.
+
Valid values are:
current-window Display in the current window
other-window Just display in another window.
@@ -1024,7 +1267,13 @@ new-frame Make a new frame each time. Note that in this case
(defcustom org-use-speed-commands nil
"Non-nil means activate single letter commands at beginning of a headline.
This may also be a function to test for appropriate locations where speed
-commands should be active."
+commands should be active.
+
+For example, to activate speed commands when the point is on any
+star at the beginning of the headline, you can do this:
+
+ (setq org-use-speed-commands
+ (lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))"
:group 'org-structure
:type '(choice
(const :tag "Never" nil)
@@ -1036,7 +1285,7 @@ commands should be active."
This list will be checked before `org-speed-commands-default'
when the variable `org-use-speed-commands' is non-nil
and when the cursor is at the beginning of a headline.
-The car if each entry is a string with a single letter, which must
+The car of each entry is a string with a single letter, which must
be assigned to `self-insert-command' in the global map.
The cdr is either a command to be called interactively, a function
to be called, or a form to be evaluated.
@@ -1054,10 +1303,10 @@ commands in the Help buffer using the `?' speed command."
(sexp))))))
(defcustom org-bookmark-names-plist
- '(:last-capture "org-capture-last-stored"
- :last-refile "org-refile-last-stored"
- :last-capture-marker "org-capture-last-stored-marker")
- "Names for bookmarks automatically set by some Org commands.
+ '(:last-capture "org-capture-last-stored"
+ :last-refile "org-refile-last-stored"
+ :last-capture-marker "org-capture-last-stored-marker")
+ "Names for bookmarks automatically set by some Org commands.
This can provide strings as names for a number of bookmarks Org sets
automatically. The following keys are currently implemented:
:last-capture
@@ -1065,11 +1314,11 @@ automatically. The following keys are currently implemented:
:last-refile
When a key does not show up in the property list, the corresponding bookmark
is not set."
- :group 'org-structure
- :type 'plist)
+ :group 'org-structure
+ :type 'plist)
(defgroup org-cycle nil
- "Options concerning visibility cycling in Org-mode."
+ "Options concerning visibility cycling in Org mode."
:tag "Org Cycle"
:group 'org-structure)
@@ -1093,25 +1342,8 @@ than its value."
(const :tag "No limit" nil)
(integer :tag "Maximum level")))
-(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS")
- "Names of drawers. Drawers are not opened by cycling on the headline above.
-Drawers only open with a TAB on the drawer line itself. A drawer looks like
-this:
- :DRAWERNAME:
- .....
- :END:
-The drawer \"PROPERTIES\" is special for capturing properties through
-the property API.
-
-Drawers can be defined on the per-file basis with a line like:
-
-#+DRAWERS: HIDDEN STATE PROPERTIES"
- :group 'org-structure
- :group 'org-cycle
- :type '(repeat (string :tag "Drawer Name")))
-
(defcustom org-hide-block-startup nil
- "Non-nil means entering Org-mode will fold all blocks.
+ "Non-nil means entering Org mode will fold all blocks.
This can also be set in on a per-file basis with
#+STARTUP: hideblocks
@@ -1122,12 +1354,17 @@ This can also be set in on a per-file basis with
(defcustom org-cycle-global-at-bob nil
"Cycle globally if cursor is at beginning of buffer and not at a headline.
-This makes it possible to do global cycling without having to use S-TAB or
-\\[universal-argument] TAB. For this special case to work, the first line
-of the buffer must not be a headline -- it may be empty or some other text.
+
+This makes it possible to do global cycling without having to use `S-TAB'
+or `\\[universal-argument] TAB'. For this special case to work, the first \
+line of the buffer
+must not be a headline -- it may be empty or some other text.
+
When used in this way, `org-cycle-hook' is disabled temporarily to make
-sure the cursor stays at the beginning of the buffer. When this option is
-nil, don't do anything special at the beginning of the buffer."
+sure the cursor stays at the beginning of the buffer.
+
+When this option is nil, don't do anything special at the beginning of
+the buffer."
:group 'org-cycle
:type 'boolean)
@@ -1166,7 +1403,7 @@ visibility is cycled."
"Number of empty lines needed to keep an empty line between collapsed trees.
If you leave an empty line between the end of a subtree and the following
headline, this empty line is hidden when the subtree is folded.
-Org-mode will leave (exactly) one empty line visible if the number of
+Org mode will leave (exactly) one empty line visible if the number of
empty lines is equal or larger to the number given in this variable.
So the default 2 means at least 2 empty lines after the end of a subtree
are needed to produce free space between a collapsed subtree and the
@@ -1192,7 +1429,6 @@ the values `folded', `children', or `subtree'."
(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees
org-cycle-hide-drawers
- org-cycle-hide-inline-tasks
org-cycle-show-empty-lines
org-optimize-window-after-visibility-change)
"Hook that is run after `org-cycle' has changed the buffer visibility.
@@ -1202,10 +1438,12 @@ 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)
+ :type 'hook
+ :version "26.1"
+ :package-version '(Org . "8.3"))
(defgroup org-edit-structure nil
- "Options concerning structure editing in Org-mode."
+ "Options concerning structure editing in Org mode."
:tag "Org Edit Structure"
:group 'org-structure)
@@ -1229,23 +1467,25 @@ lines to the buffer:
"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:
+indenting text in each node to align with the headline (after the
+stars). The following issues are influenced by this variable:
-- When this is set and the *entire* text in an entry is indented, the
- indentation is increased by one space in a demotion command, and
- decreased by one in a promotion command. If any line in the entry
- body starts with text at column 0, indentation is not changed at all.
+- The indentation is increased by one space in a demotion
+ command, and decreased by one in a promotion command. However,
+ in the latter case, if shifting some line in the entry body
+ would alter document structure (e.g., insert a new headline),
+ indentation is not changed at all.
-- Property drawers and planning information is inserted indented when
- this variable s set. When nil, they will not be indented.
+- Property drawers and planning information is inserted indented
+ when this variable is set. When nil, they will not be indented.
-- TAB indents a line relative to context. The lines below a headline
- will be indented when this variable is set.
+- TAB indents a line relative to current level. The lines below
+ a headline will be indented when this variable is set.
-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."
+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)
@@ -1286,7 +1526,7 @@ This may also be a cons cell where the behavior for `C-a' and
(const :tag "off" nil)
(const :tag "on: before tags first" t)
(const :tag "reversed: after tags first" reversed)))))
-(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
+(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e)
(defcustom org-special-ctrl-k nil
"Non-nil means `C-k' will behave specially in headlines.
@@ -1386,9 +1626,11 @@ default the value to be used for all contexts not explicitly
(defcustom org-insert-heading-respect-content nil
"Non-nil means insert new headings after the current subtree.
+\\<org-mode-map>
When nil, the new heading is created directly after the current line.
-The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn
-this variable on for the duration of the command."
+The commands `\\[org-insert-heading-respect-content]' and \
+`\\[org-insert-todo-heading-respect-content]' turn this variable on
+for the duration of the command."
:group 'org-structure
:type 'boolean)
@@ -1398,11 +1640,7 @@ this variable on for the duration of the command."
The value is an alist, with `heading' and `plain-list-item' as CAR,
and a boolean flag as CDR. The cdr may also be the symbol `auto', in
which case Org will look at the surrounding headings/items and try to
-make an intelligent decision whether to insert a blank line or not.
-
-For plain lists, if `org-list-empty-line-terminates-plain-lists' is set,
-the setting here is ignored and no empty line is inserted to avoid breaking
-the list structure."
+make an intelligent decision whether to insert a blank line or not."
:group 'org-edit-structure
:type '(list
(cons (const heading)
@@ -1422,8 +1660,7 @@ the list structure."
(defcustom org-enable-fixed-width-editor t
"Non-nil means lines starting with \":\" are treated as fixed-width.
This currently only means they are never auto-wrapped.
-When nil, such lines will be treated like ordinary lines.
-See also the QUOTE keyword."
+When nil, such lines will be treated like ordinary lines."
:group 'org-edit-structure
:type 'boolean)
@@ -1441,7 +1678,7 @@ When nil, you can use these keybindings to navigate the buffer:
:type 'boolean)
(defgroup org-sparse-trees nil
- "Options concerning sparse trees in Org-mode."
+ "Options concerning sparse trees in Org mode."
:tag "Org Sparse Trees"
:group 'org-structure)
@@ -1454,14 +1691,26 @@ changed by an edit command."
(defcustom org-remove-highlights-with-change t
"Non-nil means any change to the buffer will remove temporary highlights.
+\\<org-mode-map>\
Such highlights are created by `org-occur' and `org-clock-display'.
-When nil, `C-c C-c' needs to be used to get rid of the highlights.
-The highlights created by `org-preview-latex-fragment' always need
-`C-c C-c' to be removed."
+When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \
+to get rid of the highlights.
+The highlights created by `org-toggle-latex-fragment' always need
+`\\[org-toggle-latex-fragment]' to be removed."
:group 'org-sparse-trees
:group 'org-time
:type 'boolean)
+(defcustom org-occur-case-fold-search t
+ "Non-nil means `org-occur' should be case-insensitive.
+If set to `smart' the search will be case-insensitive only if it
+doesn't specify any upper case character."
+ :group 'org-sparse-trees
+ :version "26.1"
+ :type '(choice
+ (const :tag "Case-sensitive" nil)
+ (const :tag "Case-insensitive" t)
+ (const :tag "Case-insensitive for lower case searches only" 'smart)))
(defcustom org-occur-hook '(org-first-headline-recenter)
"Hook that is run after `org-occur' has constructed a sparse tree.
@@ -1471,54 +1720,22 @@ as possible."
:type 'hook)
(defgroup org-imenu-and-speedbar nil
- "Options concerning imenu and speedbar in Org-mode."
+ "Options concerning imenu and speedbar in Org mode."
:tag "Org Imenu and Speedbar"
:group 'org-structure)
(defcustom org-imenu-depth 2
- "The maximum level for Imenu access to Org-mode headlines.
+ "The maximum level for Imenu access to Org headlines.
This also applied for speedbar access."
:group 'org-imenu-and-speedbar
:type 'integer)
(defgroup org-table nil
- "Options concerning tables in Org-mode."
+ "Options concerning tables in Org mode."
:tag "Org Table"
:group 'org)
-(defcustom org-enable-table-editor 'optimized
- "Non-nil means lines starting with \"|\" are handled by the table editor.
-When nil, such lines will be treated like ordinary lines.
-
-When equal to the symbol `optimized', the table editor will be optimized to
-do the following:
-- Automatic overwrite mode in front of whitespace in table fields.
- This makes the structure of the table stay in tact as long as the edited
- field does not exceed the column width.
-- Minimize the number of realigns. Normally, the table is aligned each time
- TAB or RET are pressed to move to another field. With optimization this
- happens only if changes to a field might have changed the column width.
-Optimization requires replacing the functions `self-insert-command',
-`delete-char', and `backward-delete-char' in Org-mode buffers, with a
-slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is
-very good at guessing when a re-align will be necessary, but you can always
-force one with \\[org-ctrl-c-ctrl-c].
-
-If you would like to use the optimized version in Org-mode, but the
-un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'.
-
-This variable can be used to turn on and off the table editor during a session,
-but in order to toggle optimization, a restart is required.
-
-See also the variable `org-table-auto-blank-field'."
- :group 'org-table
- :type '(choice
- (const :tag "off" nil)
- (const :tag "on" t)
- (const :tag "on, optimized" optimized)))
-
-(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs)
- (version<= emacs-version "24.1"))
+(defcustom org-self-insert-cluster-for-undo nil
"Non-nil means cluster self-insert commands for undo when possible.
If this is set, then, like in the Emacs command loop, 20 consecutive
characters will be undone together.
@@ -1534,24 +1751,96 @@ calls `table-recognize-table'."
:type 'boolean)
(defgroup org-link nil
- "Options concerning links in Org-mode."
+ "Options concerning links in Org mode."
:tag "Org Link"
:group 'org)
-(defvar org-link-abbrev-alist-local nil
+(defvar-local org-link-abbrev-alist-local nil
"Buffer-local version of `org-link-abbrev-alist', which see.
The value of this is taken from the #+LINK lines.")
-(make-variable-buffer-local 'org-link-abbrev-alist-local)
+
+(defcustom org-link-parameters
+ '(("doi" :follow org--open-doi-link)
+ ("elisp" :follow org--open-elisp-link)
+ ("file" :complete org-file-complete-link)
+ ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path))))
+ ("help" :follow org--open-help-link)
+ ("http" :follow (lambda (path) (browse-url (concat "http:" path))))
+ ("https" :follow (lambda (path) (browse-url (concat "https:" path))))
+ ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path))))
+ ("news" :follow (lambda (path) (browse-url (concat "news:" path))))
+ ("shell" :follow org--open-shell-link))
+ "An 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 p-list of link properties.
+
+:follow - A function that takes the link path as an argument.
+
+:export - A function that takes the link path, description and
+export-backend as arguments.
+
+:store - A function responsible for storing the link. See the
+function `org-store-link-functions'.
+
+:complete - A function that inserts a link with completion. The
+function takes one optional prefix arg.
+
+: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'.
+
+:mouse-face - The mouse-face. The default is `highlight'.
+
+:display - `full' will not fold the link in descriptive
+display. Default is `org-link'.
+
+:help-echo - A string or function that takes (window object position)
+as arguments and returns a string.
+
+:keymap - A keymap that is active on the link. The default is
+`org-mouse-map'.
+
+:htmlize-link - A function for the htmlize-link. Defaults
+to (list :uri \"type:path\")
+
+: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."
+ :group 'org-link
+ :type '(alist :tag "Link display parameters"
+ :value-type plist)
+ :version "26.1"
+ :package-version '(Org . "9.1"))
+
+(defun org-link-get-parameter (type key)
+ "Get TYPE link property for KEY.
+TYPE is a string and KEY is a plist keyword."
+ (plist-get
+ (cdr (assoc type org-link-parameters))
+ key))
+
+(defun org-link-set-parameters (type &rest parameters)
+ "Set link TYPE properties to PARAMETERS.
+ PARAMETERS should be :key val pairs."
+ (let ((data (assoc type org-link-parameters)))
+ (if data (setcdr data (org-combine-plists (cdr data) parameters))
+ (push (cons type parameters) org-link-parameters)
+ (org-make-link-regexps)
+ (org-element-update-syntax))))
+
+(defun org-link-types ()
+ "Return a list of known link types."
+ (mapcar #'car org-link-parameters))
(defcustom org-link-abbrev-alist nil
"Alist of link abbreviations.
The car of each element is a string, to be replaced at the start of a link.
The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated
-links in Org-mode buffers can have an optional tag after a double colon, e.g.
+links in Org buffers can have an optional tag after a double colon, e.g.,
[[linkkey:tag][description]]
-The `linkkey' must be a word word, starting with a letter, followed
+The `linkkey' must be a single word, starting with a letter, followed
by letters, numbers, `-' or `_'.
If REPLACE is a string, the tag will simply be appended to create the link.
@@ -1603,11 +1892,18 @@ adaptive Use relative path for files in the current directory and sub-
(const noabbrev)
(const adaptive)))
-(defcustom org-activate-links '(bracket angle plain radio tag date footnote)
- "Types of links that should be activated in Org-mode files.
-This is a list of symbols, each leading to the activation of a certain link
-type. In principle, it does not hurt to turn on most link types - there may
-be a small gain when turning off unused link types. The types are:
+(defvaralias 'org-activate-links 'org-highlight-links)
+(defcustom org-highlight-links '(bracket angle plain radio tag date footnote)
+ "Types of links that should be highlighted in Org files.
+
+This is a list of symbols, each one of them leading to the
+highlighting of a certain link type.
+
+You can still open links that are not highlighted.
+
+In principle, it does not hurt to turn on highlighting for all
+link types. There may be a small gain when turning off unused
+link types. The types are:
bracket The recommended [[link][description]] or [[link]] links with hiding.
angle Links in angular brackets that may contain whitespace like
@@ -1618,8 +1914,10 @@ tag Tag settings in a headline (link to tag search).
date Time stamps (link to calendar).
footnote Footnote labels.
-Changing this variable requires a restart of Emacs to become effective."
+If you set this variable during an Emacs session, use `org-mode-restart'
+in the Org buffer so that the change takes effect."
:group 'org-link
+ :group 'org-appearance
:type '(set :greedy t
(const :tag "Double bracket links" bracket)
(const :tag "Angular bracket links" angle)
@@ -1631,15 +1929,15 @@ Changing this variable requires a restart of Emacs to become effective."
(defcustom org-make-link-description-function nil
"Function to use for generating link descriptions from links.
-When nil, the link location will be used. This function must take
-two parameters: the first one is the link, the second one is the
-description generated by `org-insert-link'. The function should
-return the description to use."
+This function must take two parameters: the first one is the
+link, the second one is the description generated by
+`org-insert-link'. The function should return the description to
+use."
:group 'org-link
:type '(choice (const nil) (function)))
(defgroup org-link-store nil
- "Options concerning storing links in Org-mode."
+ "Options concerning storing links in Org mode."
:tag "Org Store Link"
:group 'org-link)
@@ -1684,32 +1982,36 @@ It should match if the message is from the user him/herself."
(defcustom org-context-in-file-links t
"Non-nil means file links from `org-store-link' contain context.
-A search string will be added to the file name with :: as separator and
-used to find the context when the link is activated by the command
+\\<org-mode-map>
+A search string will be added to the file name with :: as separator
+and used to find the context when the link is activated by the command
`org-open-at-point'. When this option is t, the entire active region
will be placed in the search string of the file link. If set to a
positive integer, only the first n lines of context will be stored.
-Using a prefix arg to the command \\[org-store-link] (`org-store-link')
+Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \
+\\[org-store-link]')
negates this setting for the duration of the command."
:group 'org-link-store
:type '(choice boolean integer))
(defcustom org-keep-stored-link-after-insertion nil
"Non-nil means keep link in list for entire session.
-
+\\<org-mode-map>
The command `org-store-link' adds a link pointing to the current
location to an internal list. These links accumulate during a session.
The command `org-insert-link' can be used to insert links into any
-Org-mode file (offering completion for all stored links). When this
-option is nil, every link which has been inserted once using \\[org-insert-link]
-will be removed from the list, to make completing the unused links
-more efficient."
+Org file (offering completion for all stored links).
+
+When this option is nil, every link which has been inserted once using
+`\\[org-insert-link]' will be removed from the list, to make completing the \
+unused
+links more efficient."
:group 'org-link-store
:type 'boolean)
(defgroup org-link-follow nil
- "Options concerning following links in Org-mode."
+ "Options concerning following links in Org mode."
:tag "Org Follow Link"
:group 'org-link)
@@ -1749,10 +2051,10 @@ In tables, the special behavior of RET has precedence."
(defcustom org-mouse-1-follows-link
(if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t)
"Non-nil means mouse-1 on a link will follow the link.
-A longer mouse click will still set point. Does not work on XEmacs.
-Needs to be set before org.el is loaded."
+A longer mouse click will still set point. Needs to be set
+before org.el is loaded."
:group 'org-link-follow
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type '(choice
(const :tag "A double click follows the link" double)
@@ -1766,16 +2068,22 @@ Changing this requires a restart of Emacs to work correctly."
:type 'integer)
(defcustom org-link-search-must-match-exact-headline 'query-to-create
- "Non-nil means internal links in Org files must exactly match a headline.
-When nil, the link search tries to match a phrase with all words
-in the search text."
+ "Non-nil means internal fuzzy links can only match headlines.
+
+When nil, the a fuzzy link may point to a target or a named
+construct in the document. When set to the special value
+`query-to-create', offer to create a new headline when none
+matched.
+
+Spaces and statistics cookies are ignored during heading searches."
:group 'org-link-follow
:version "24.1"
:type '(choice
(const :tag "Use fuzzy text search" nil)
(const :tag "Match only exact headline" t)
(const :tag "Match exact headline or query to create it"
- query-to-create)))
+ query-to-create))
+ :safe #'symbolp)
(defcustom org-link-frame-setup
'((vm . vm-visit-folder-other-frame)
@@ -1836,7 +2144,7 @@ another window."
"Non-nil means use indirect buffer to display infile links.
Activating internal links (from one location in a file to another location
in the same file) normally just jumps to the location. When the link is
-activated with a \\[universal-argument] prefix (or with mouse-3), the link \
+activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \
is displayed in
another window. When this option is set, the other window actually displays
an indirect buffer clone of the current buffer, to avoid any visibility
@@ -1860,26 +2168,13 @@ window on that directory."
:group 'org-link-follow
:type 'boolean)
-(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s")
- "Function and arguments to call for following mailto links.
-This is a list with the first element being a Lisp function, and the
-remaining elements being arguments to the function. In string arguments,
-%a will be replaced by the address, and %s will be replaced by the subject
-if one was given like in <mailto:arthur@galaxy.org::this subject>."
- :group 'org-link-follow
- :type '(choice
- (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s"))
- (const :tag "compose-mail" (compose-mail "%a" "%s"))
- (const :tag "message-mail" (message-mail "%a" "%s"))
- (cons :tag "other" (function) (repeat :tag "argument" sexp))))
-
(defcustom org-confirm-shell-link-function 'yes-or-no-p
"Non-nil means ask for confirmation before executing shell links.
Shell links can be dangerous: just think about a link
[[shell:rm -rf ~/*][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\",
+This link would show up in your Org document as \"Google Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
@@ -1891,7 +2186,7 @@ single keystroke rather than having to type \"yes\"."
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defcustom org-confirm-shell-link-not-regexp ""
"A regexp to skip confirmation for shell links."
@@ -1905,7 +2200,7 @@ Elisp links can be dangerous: just think about a link
[[elisp:(shell-command \"rm -rf ~/*\")][Google Search]]
-This link would show up in your Org-mode document as \"Google Search\",
+This link would show up in your Org document as \"Google Search\",
but really it would remove your entire home directory.
Therefore we advise against setting this variable to nil.
Just change it to `y-or-n-p' if you want to confirm with a
@@ -1917,7 +2212,7 @@ single keystroke rather than having to type \"yes\"."
(const :tag "no confirmation (dangerous)" nil)))
(put 'org-confirm-shell-link-function
'safe-local-variable
- #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
+ (lambda (x) (member x '(yes-or-no-p y-or-n-p))))
(defcustom org-confirm-elisp-link-not-regexp ""
"A regexp to skip confirmation for Elisp links."
@@ -1934,30 +2229,23 @@ See `org-file-apps'.")
(defconst org-file-apps-defaults-macosx
'((remote . emacs)
- (t . "open %s")
(system . "open %s")
("ps.gz" . "gv %s")
("eps.gz" . "gv %s")
("dvi" . "xdvi %s")
- ("fig" . "xfig %s"))
+ ("fig" . "xfig %s")
+ (t . "open %s"))
"Default file applications on a macOS system.
The system \"open\" is known as a default, but we use X11 applications
for some files for which the OS does not have a good default.
See `org-file-apps'.")
(defconst org-file-apps-defaults-windowsnt
- (list
- '(remote . emacs)
- (cons t
- (list (if (featurep 'xemacs)
- 'mswindows-shell-execute
- 'w32-shell-execute)
- "open" 'file))
- (cons 'system
- (list (if (featurep 'xemacs)
- 'mswindows-shell-execute
- 'w32-shell-execute)
- "open" 'file)))
+ (list '(remote . emacs)
+ (cons 'system (lambda (file _path)
+ (with-no-warnings (w32-shell-execute "open" file))))
+ (cons t (lambda (file _path)
+ (with-no-warnings (w32-shell-execute "open" file)))))
"Default file applications on a Windows NT system.
The system \"open\" is used for most files.
See `org-file-apps'.")
@@ -1968,11 +2256,15 @@ See `org-file-apps'.")
("\\.x?html?\\'" . default)
("\\.pdf\\'" . default))
"External applications for opening `file:path' items in a document.
-Org-mode uses system defaults for different file types, but
+\\<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. Possible values for the
-file identifier are
+files and the cdr the corresponding command.
+
+Possible values for the file identifier are:
+
\"string\" A string as a file identifier can be interpreted in different
ways, depending on its contents:
@@ -1985,8 +2277,8 @@ file identifier are
filename matches the regexp. If you want to
use groups here, use shy groups.
- Example: (\"\\.x?html\\\\='\" . \"firefox %s\")
- (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\")
+ Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\")
+ (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\")
to open *.html and *.xhtml with firefox.
- Regular expression which contains (non-shy) groups:
@@ -1998,10 +2290,11 @@ file identifier are
that does not use any of the group matches, this case is
handled identically to the second one (i.e. match against
file name only).
- In a custom lisp form, you can access the group matches with
+ In a custom function, you can access the group matches with
(match-string n link).
- Example: (\"\\.pdf::\\(\\d+\\)\\\\='\" . \"evince -p %1 %s\")
+ Example: (\"\\\\.pdf::\\\\(\\\\d+\\\\)\\\\\\='\" . \
+\"evince -p %1 %s\")
to open [[file:document.pdf::5]] with evince at page 5.
`directory' Matches a directory
@@ -2013,28 +2306,32 @@ file identifier are
command `emacs' will open most files in Emacs. Beware that this
will also open html files inside Emacs, unless you add
(\"html\" . default) to the list as well.
- t Default for files not matched by any of the other options.
`system' The system command to open files, like `open' on Windows
and macOS, and mailcap under GNU/Linux. This is the command
- that will be selected if you call `C-c C-o' with a double
- \\[universal-argument] \\[universal-argument] prefix.
+ that will be selected if you call `org-open-at-point' with a
+ double prefix argument (`\\[universal-argument] \
+\\[universal-argument] \\[org-open-at-point]').
+ t Default for files not matched by any of the other options.
Possible values for the command are:
+
`emacs' The file will be visited by the current Emacs process.
`default' Use the default application for this file type, which is the
association for t in the list, most likely in the system-specific
- part.
- This can be used to overrule an unwanted setting in the
+ part. This can be used to overrule an unwanted setting in the
system-specific variable.
`system' Use the system command for opening files, like \"open\".
This command is specified by the entry whose car is `system'.
Most likely, the system-specific version of this variable
does define this command, but you can overrule/replace it
here.
+`mailcap' Use command specified in the mailcaps.
string A command to be executed by a shell; %s will be replaced
by the path to the file.
- sexp A Lisp form which will be evaluated. The file path will
- be available in the Lisp variable `file'.
+ function A Lisp function, which will be called with two arguments:
+ the file path and the original link string, without the
+ \"file:\" prefix.
+
For more examples, see the system specific constants
`org-file-apps-defaults-macosx'
`org-file-apps-defaults-windowsnt'
@@ -2054,7 +2351,7 @@ For more examples, see the system specific constants
(const :tag "Use default" default)
(const :tag "Use the system command" system)
(string :tag "Command")
- (sexp :tag "Lisp form")))))
+ (function :tag "Function")))))
(defcustom org-doi-server-url "http://dx.doi.org/"
"The URL of the DOI server."
@@ -2063,22 +2360,22 @@ For more examples, see the system specific constants
:group 'org-link-follow)
(defgroup org-refile nil
- "Options concerning refiling entries in Org-mode."
+ "Options concerning refiling entries in Org mode."
:tag "Org Refile"
:group 'org)
(defcustom org-directory "~/org"
- "Directory with org files.
+ "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 only used in the
+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 a capture note is filed away in an interactive way (when exiting the
- note buffer with `C-1 C-c C-c'. The user is prompted for an org file,
- with `org-directory' as the default path."
+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)
@@ -2089,9 +2386,7 @@ 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 '(choice
- (const :tag "Default from remember-data-file" nil)
- file))
+ :type 'file)
(defcustom org-goto-interface 'outline
"The default interface to be used for `org-goto'.
@@ -2154,7 +2449,7 @@ will temporarily be changed to `time'."
(const :tag "Record timestamp with note." note)))
(defcustom org-refile-targets nil
- "Targets for refiling entries with \\[org-refile].
+ "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
@@ -2218,12 +2513,15 @@ of the subtree."
(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 C-c C-w' or, if you
-find that easier, `C-u C-u C-u C-c C-w'."
+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)
@@ -2236,23 +2534,26 @@ 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 `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 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-mode uses the refile interface to select an outline path
-\(see variable `org-refile-use-outline-path'), the completion of
-the path can be done is a single go, or if 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."
+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)
@@ -2285,12 +2586,12 @@ converted to a headline before refiling."
:type 'boolean)
(defgroup org-todo nil
- "Options concerning TODO items in Org-mode."
+ "Options concerning TODO items in Org mode."
:tag "Org TODO"
:group 'org)
(defgroup org-progress nil
- "Options concerning Progress logging in Org-mode."
+ "Options concerning Progress logging in Org mode."
:tag "Org Progress"
:group 'org-time)
@@ -2308,12 +2609,12 @@ Each sequence starts with a symbol, either `sequence' or `type',
indicating if the keywords should be interpreted as a sequence of
action steps, or as different types of TODO items. The first
keywords are states requiring action - these states will select a headline
-for inclusion into the global TODO list Org-mode produces. If one of
-the \"keywords\" is the vertical bar, \"|\", the remaining keywords
+for inclusion into the global TODO list Org produces. If one of the
+\"keywords\" is the vertical bar, \"|\", the remaining keywords
signify that no further action is necessary. If \"|\" is not found,
the last keyword is treated as the only DONE state of the sequence.
-The command \\[org-todo] cycles an entry through these states, and one
+The command `\\[org-todo]' cycles an entry through these states, and one
additional state where no keyword is present. For details about this
cycling, see the manual.
@@ -2356,44 +2657,37 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
(lambda (widget)
(widget-put widget
:args (mapcar
- #'(lambda (x)
- (widget-convert
- (cons 'const x)))
+ (lambda (x)
+ (widget-convert
+ (cons 'const x)))
org-todo-interpretation-widgets))
widget))
(repeat
(string :tag "Keyword"))))))
-(defvar org-todo-keywords-1 nil
+(defvar-local org-todo-keywords-1 nil
"All TODO and DONE keywords active in a buffer.")
-(make-variable-buffer-local 'org-todo-keywords-1)
(defvar org-todo-keywords-for-agenda nil)
(defvar org-done-keywords-for-agenda nil)
-(defvar org-drawers-for-agenda nil)
(defvar org-todo-keyword-alist-for-agenda nil)
(defvar org-tag-alist-for-agenda nil
"Alist of all tags from all agenda files.")
(defvar org-tag-groups-alist-for-agenda nil
"Alist of all groups tags from all current agenda files.")
-(defvar org-tag-groups-alist nil)
-(make-variable-buffer-local 'org-tag-groups-alist)
+(defvar-local org-tag-groups-alist nil)
(defvar org-agenda-contributing-files nil)
-(defvar org-not-done-keywords nil)
-(make-variable-buffer-local 'org-not-done-keywords)
-(defvar org-done-keywords nil)
-(make-variable-buffer-local 'org-done-keywords)
-(defvar org-todo-heads nil)
-(make-variable-buffer-local 'org-todo-heads)
-(defvar org-todo-sets nil)
-(make-variable-buffer-local 'org-todo-sets)
-(defvar org-todo-log-states nil)
-(make-variable-buffer-local 'org-todo-log-states)
-(defvar org-todo-kwd-alist nil)
-(make-variable-buffer-local 'org-todo-kwd-alist)
-(defvar org-todo-key-alist nil)
-(make-variable-buffer-local 'org-todo-key-alist)
-(defvar org-todo-key-trigger nil)
-(make-variable-buffer-local 'org-todo-key-trigger)
+(defvar-local org-current-tag-alist nil
+ "Alist of all tag groups in current buffer.
+This variable takes into consideration `org-tag-alist',
+`org-tag-persistent-alist' and TAGS keywords in the buffer.")
+(defvar-local org-not-done-keywords nil)
+(defvar-local org-done-keywords nil)
+(defvar-local org-todo-heads nil)
+(defvar-local org-todo-sets nil)
+(defvar-local org-todo-log-states nil)
+(defvar-local org-todo-kwd-alist nil)
+(defvar-local org-todo-key-alist nil)
+(defvar-local org-todo-key-trigger nil)
(defcustom org-todo-interpretation 'sequence
"Controls how TODO keywords are interpreted.
@@ -2407,7 +2701,8 @@ more information."
(const type)))
(defcustom org-use-fast-todo-selection t
- "Non-nil means use the fast todo selection scheme with C-c C-t.
+ "\\<org-mode-map>\
+Non-nil means use the fast todo selection scheme with `\\[org-todo]'.
This variable describes if and under what circumstances the cycling
mechanism for TODO keywords will be replaced by a single-key, direct
selection scheme.
@@ -2415,8 +2710,9 @@ selection scheme.
When nil, fast selection is never used.
When the symbol `prefix', it will be used when `org-todo' is called
-with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and
-`C-u t' in an agenda buffer.
+with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \
+in an Org buffer, and
+`\\[universal-argument] t' in an agenda buffer.
When t, fast selection is used by default. In this case, the prefix
argument forces cycling instead.
@@ -2436,6 +2732,9 @@ ALL-HEADLINES means update todo statistics by including headlines
with no TODO keyword as well, counting them as not done.
A list of TODO keywords means the same, but skip keywords that are
not in this list.
+When set to a list of two lists, the first list contains keywords
+to consider as TODO keywords, the second list contains keywords
+to consider as DONE keywords.
When this is set, todo statistics is updated in the parent of the
current entry each time a todo state is changed."
@@ -2445,6 +2744,9 @@ current entry each time a todo state is changed."
(const :tag "Yes, including all entries" all-headlines)
(repeat :tag "Yes, for TODOs in this list"
(string :tag "TODO keyword"))
+ (list :tag "Yes, for TODOs and DONEs in these lists"
+ (repeat (string :tag "TODO keyword"))
+ (repeat (string :tag "DONE keyword")))
(other :tag "No TODO statistics" nil)))
(defcustom org-hierarchical-todo-statistics t
@@ -2529,7 +2831,7 @@ to change is while Emacs is running is through the customize interface."
(defcustom org-treat-insert-todo-heading-as-state-change nil
"Non-nil means inserting a TODO heading is treated as state change.
-So when the command \\[org-insert-todo-heading] is used, state change
+So when the command `\\[org-insert-todo-heading]' is used, state change
logging will apply if appropriate. When nil, the new TODO item will
be inserted directly, and no logging will take place."
:group 'org-todo
@@ -2667,20 +2969,23 @@ When nil, only the date will be recorded."
(refile . "Refiled on %t")
(clock-out . ""))
"Headings for notes added to entries.
-The value is an alist, with the car being a symbol indicating the note
-context, and the cdr is the heading to be used. The heading may also be the
-empty string.
-%t in the heading will be replaced by a time stamp.
-%T will be an active time stamp instead the default inactive one
-%d will be replaced by a short-format time stamp.
-%D will be replaced by an active short-format time stamp.
-%s will be replaced by the new TODO state, in double quotes.
-%S will be replaced by the old TODO state, in double quotes.
-%u will be replaced by the user name.
-%U will be replaced by the full user name.
-
-In fact, it is not a good idea to change the `state' entry, because
-agenda log mode depends on the format of these entries."
+
+The value is an alist, with the car being a symbol indicating the
+note context, and the cdr is the heading to be used. The heading
+may also be the empty string. The following placeholders can be
+used:
+
+ %t a time stamp.
+ %T an active time stamp instead the default inactive one
+ %d a short-format time stamp.
+ %D an active short-format time stamp.
+ %s the new TODO state or time stamp (inactive), in double quotes.
+ %S the old TODO state or time stamp (inactive), in double quotes.
+ %u the user name.
+ %U full user name.
+
+In fact, it is not a good idea to change the `state' entry,
+because Agenda Log mode depends on the format of these entries."
:group 'org-todo
:group 'org-progress
:type '(list :greedy t
@@ -2719,7 +3024,10 @@ If this variable is set, `org-log-state-notes-insert-after-drawers'
will be ignored.
You can set the property LOG_INTO_DRAWER to overrule this setting for
-a subtree."
+a subtree.
+
+Do not check directly this variable in a Lisp program. Call
+function `org-log-into-drawer' instead."
:group 'org-todo
:group 'org-progress
:type '(choice
@@ -2727,18 +3035,20 @@ a subtree."
(const :tag "LOGBOOK" t)
(string :tag "Other")))
-(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
+(defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer)
(defun org-log-into-drawer ()
- "Return the value of `org-log-into-drawer', but let properties overrule.
-If the current entry has or inherits a LOG_INTO_DRAWER property, it will be
-used instead of the default value."
+ "Name of the log drawer, as a string, or nil.
+This is the value of `org-log-into-drawer'. However, if the
+current entry has or inherits a LOG_INTO_DRAWER property, it will
+be used instead of the default value."
(let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t)))
- (cond
- ((not p) org-log-into-drawer)
- ((equal p "nil") nil)
- ((equal p "t") "LOGBOOK")
- (t p))))
+ (cond ((equal p "nil") nil)
+ ((equal p "t") "LOGBOOK")
+ ((stringp p) p)
+ (p "LOGBOOK")
+ ((stringp org-log-into-drawer) org-log-into-drawer)
+ (org-log-into-drawer "LOGBOOK"))))
(defcustom org-log-state-notes-insert-after-drawers nil
"Non-nil means insert state change notes after any drawers in entry.
@@ -2804,7 +3114,7 @@ property to one or more of these keywords."
(defgroup org-priorities nil
- "Priorities in Org-mode."
+ "Priorities in Org mode."
:tag "Org Priorities"
:group 'org-todo)
@@ -2862,24 +3172,13 @@ as an argument and return the numeric priority."
(function)))
(defgroup org-time nil
- "Options concerning time stamps and deadlines in Org-mode."
+ "Options concerning time stamps and deadlines in Org mode."
:tag "Org Time"
:group 'org)
-(defcustom org-insert-labeled-timestamps-at-point nil
- "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point.
-When nil, these labeled time stamps are forces into the second line of an
-entry, just after the headline. When scheduling from the global TODO list,
-the time stamp will always be forced into the second line."
- :group 'org-time
- :type 'boolean)
-
-(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.
-It is not recommended to change this constant.")
-
(defcustom org-time-stamp-rounding-minutes '(0 5)
"Number of minutes to round time stamps to.
+\\<org-mode-map>\
These are two values, the first applies when first creating a time stamp.
The second applies when changing it with the commands `S-up' and `S-down'.
When changing the time stamp, this means that it will change in steps
@@ -2889,14 +3188,15 @@ When a setting is 0 or 1, insert the time unmodified. Useful rounding
numbers should be factors of 60, so for example 5, 10, 15.
When this is larger than 1, you can still force an exact time stamp by using
-a double prefix argument to a time stamp command like `C-c .' or `C-c !',
+a double prefix argument to a time stamp command like \
+`\\[org-time-stamp]' or `\\[org-time-stamp-inactive],
and by using a prefix arg to `S-up/down' to specify the exact number
of minutes to shift."
:group 'org-time
- :get #'(lambda (var) ; Make sure both elements are there
- (if (integerp (default-value var))
- (list (default-value var) 5)
- (default-value var)))
+ :get (lambda (var) ; Make sure both elements are there
+ (if (integerp (default-value var))
+ (list (default-value var) 5)
+ (default-value var)))
:type '(list
(integer :tag "when inserting times")
(integer :tag "when modifying times")))
@@ -2935,135 +3235,6 @@ commands, if custom time display is turned on at the time of export."
(concat "[" (substring f 1 -1) "]")
f)))
-(defcustom org-time-clocksum-format
- '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t)
- "The format string used when creating CLOCKSUM lines.
-This is also used when Org mode generates a time duration.
-
-The value can be a single format string containing two
-%-sequences, which will be filled with the number of hours and
-minutes in that order.
-
-Alternatively, the value can be a plist associating any of the
-keys :years, :months, :weeks, :days, :hours or :minutes with
-format strings. The time duration is formatted using only the
-time components that are needed and concatenating the results.
-If a time unit in absent, it falls back to the next smallest
-unit.
-
-The keys :require-years, :require-months, :require-days,
-:require-weeks, :require-hours, :require-minutes are also
-meaningful. A non-nil value for these keys indicates that the
-corresponding time component should always be included, even if
-its value is 0.
-
-
-For example,
-
- (:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\"
- :require-minutes t)
-
-means durations longer than a day will be expressed in days,
-hours and minutes, and durations less than a day will always be
-expressed in hours and minutes (even for durations less than an
-hour).
-
-The value
-
- (:days \"%dd\" :minutes \"%dm\")
-
-means durations longer than a day will be expressed in days and
-minutes, and durations less than a day will be expressed entirely
-in minutes (even for durations longer than an hour)."
- :group 'org-time
- :group 'org-clock
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice (string :tag "Format string")
- (set :tag "Plist"
- (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show years" :require-years)
- (const t))
- (group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show months" :require-months)
- (const t))
- (group :inline t (const :tag "Weeks" :weeks)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show weeks" :require-weeks)
- (const t))
- (group :inline t (const :tag "Days" :days)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show days" :require-days)
- (const t))
- (group :inline t (const :tag "Hours" :hours)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show hours" :require-hours)
- (const t))
- (group :inline t (const :tag "Minutes" :minutes)
- (string :tag "Format string"))
- (group :inline t
- (const :tag "Always show minutes" :require-minutes)
- (const t)))))
-
-(defcustom org-time-clocksum-use-fractional nil
- "When non-nil, \\[org-clock-display] uses fractional times.
-See `org-time-clocksum-format' for more on time clock formats."
- :group 'org-time
- :group 'org-clock
- :version "24.3"
- :type 'boolean)
-
-(defcustom org-time-clocksum-use-effort-durations nil
- "When non-nil, \\[org-clock-display] uses effort durations.
-E.g. by default, one day is considered to be a 8 hours effort,
-so a task that has been clocked for 16 hours will be displayed
-as during 2 days in the clock display or in the clocktable.
-
-See `org-effort-durations' on how to set effort durations
-and `org-time-clocksum-format' for more on time clock formats."
- :group 'org-time
- :group 'org-clock
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
-
-(defcustom org-time-clocksum-fractional-format "%.2f"
- "The format string used when creating CLOCKSUM lines,
-or when Org mode generates a time duration, if
-`org-time-clocksum-use-fractional' is enabled.
-
-The value can be a single format string containing one
-%-sequence, which will be filled with the number of hours as
-a float.
-
-Alternatively, the value can be a plist associating any of the
-keys :years, :months, :weeks, :days, :hours or :minutes with
-a format string. The time duration is formatted using the
-largest time unit which gives a non-zero integer part. If all
-specified formats have zero integer part, the smallest time unit
-is used."
- :group 'org-time
- :type '(choice (string :tag "Format string")
- (set (group :inline t (const :tag "Years" :years)
- (string :tag "Format string"))
- (group :inline t (const :tag "Months" :months)
- (string :tag "Format string"))
- (group :inline t (const :tag "Weeks" :weeks)
- (string :tag "Format string"))
- (group :inline t (const :tag "Days" :days)
- (string :tag "Format string"))
- (group :inline t (const :tag "Hours" :hours)
- (string :tag "Format string"))
- (group :inline t (const :tag "Minutes" :minutes)
- (string :tag "Format string")))))
-
(defcustom org-deadline-warning-days 14
"Number of days before expiration during which a deadline becomes active.
This variable governs the display in sparse trees and in the agenda.
@@ -3097,8 +3268,8 @@ This affects the following situations:
For example, if it is April and you enter \"feb 2\", this will be read
as Feb 2, *next* year. \"May 5\", however, will be this year.
2. The user gives a day, but no month.
- For example, if today is the 15th, and you enter \"3\", Org-mode will
- read this as the third of *next* month. However, if you enter \"17\",
+ For example, if today is the 15th, and you enter \"3\", Org will read
+ this as the third of *next* month. However, if you enter \"17\",
it will be considered as *this* month.
If you set this variable to the symbol `time', then also the following
@@ -3177,22 +3348,9 @@ minibuffer will also be active, and you can simply enter the date as well.
When nil, only the minibuffer will be available."
:group 'org-time
:type 'boolean)
-(org-defvaralias 'org-popup-calendar-for-date-prompt
+(defvaralias 'org-popup-calendar-for-date-prompt
'org-read-date-popup-calendar)
-(make-obsolete-variable
- 'org-read-date-minibuffer-setup-hook
- "Set `org-read-date-minibuffer-local-map' instead." "24.4")
-(defcustom org-read-date-minibuffer-setup-hook nil
- "Hook to be used to set up keys for the date/time interface.
-Add key definitions to `minibuffer-local-map', which will be a
-temporary copy.
-
-WARNING: This option is obsolete, you should use
-`org-read-date-minibuffer-local-map' to set up keys."
- :group 'org-time
- :type 'hook)
-
(defcustom org-extend-today-until 0
"The hour when your day really ends. Must be an integer.
This has influence for the following applications:
@@ -3240,52 +3398,80 @@ moved to the new date."
:type 'boolean)
(defgroup org-tags nil
- "Options concerning tags in Org-mode."
+ "Options concerning tags in Org mode."
:tag "Org Tags"
:group 'org)
(defcustom org-tag-alist nil
- "List of tags allowed in Org-mode files.
-When this list is nil, Org-mode will base TAG input on what is already in the
-buffer.
-The value of this variable is an alist, the car of each entry must be a
-keyword as a string, the cdr may be a character that is used to select
-that tag through the fast-tag-selection interface.
-See the manual for details."
+ "Default tags available in Org files.
+
+The value of this variable is an alist. Associations either:
+
+ (TAG)
+ (TAG . SELECT)
+ (SPECIAL)
+
+where TAG is a tag as a string, SELECT is character, used to
+select that tag through the fast tag selection interface, and
+SPECIAL is one of the following keywords: `:startgroup',
+`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
+`:newline'. These keywords are used to define a hierarchy of
+tags. See manual for details.
+
+When this variable is nil, Org mode bases tag input on what is
+already in the buffer. The value can be overridden locally by
+using a TAGS keyword, e.g.,
+
+ #+TAGS: tag1 tag2
+
+See also `org-tag-persistent-alist' to sidestep this behavior."
:group 'org-tags
:type '(repeat
(choice
- (cons (string :tag "Tag name")
- (character :tag "Access char"))
- (list :tag "Start radio group"
- (const :startgroup)
- (option (string :tag "Group description")))
- (list :tag "Group tags delimiter"
- (const :grouptags))
- (list :tag "End radio group"
- (const :endgroup)
- (option (string :tag "Group description")))
+ (cons :tag "Tag with key"
+ (string :tag "Tag name")
+ (character :tag "Access char"))
+ (list :tag "Tag" (string :tag "Tag name"))
+ (const :tag "Start radio group" (:startgroup))
+ (const :tag "Start tag group, non distinct" (:startgrouptag))
+ (const :tag "Group tags delimiter" (:grouptags))
+ (const :tag "End radio group" (:endgroup))
+ (const :tag "End tag group, non distinct" (:endgrouptag))
(const :tag "New line" (:newline)))))
(defcustom org-tag-persistent-alist nil
- "List of tags that will always appear in all Org-mode files.
-This is in addition to any in buffer settings or customizations
-of `org-tag-alist'.
-When this list is nil, Org-mode will base TAG input on `org-tag-alist'.
-The value of this variable is an alist, the car of each entry must be a
-keyword as a string, the cdr may be a character that is used to select
-that tag through the fast-tag-selection interface.
-See the manual for details.
-To disable these tags on a per-file basis, insert anywhere in the file:
- #+STARTUP: noptag"
+ "Tags always available in Org files.
+
+The value of this variable is an alist. Associations either:
+
+ (TAG)
+ (TAG . SELECT)
+ (SPECIAL)
+
+where TAG is a tag as a string, SELECT is a character, used to
+select that tag through the fast tag selection interface, and
+SPECIAL is one of the following keywords: `:startgroup',
+`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or
+`:newline'. These keywords are used to define a hierarchy of
+tags. See manual for details.
+
+Unlike to `org-tag-alist', tags defined in this variable do not
+depend on a local TAGS keyword. Instead, to disable these tags
+on a per-file basis, insert anywhere in the file:
+
+ #+STARTUP: noptag"
:group 'org-tags
:type '(repeat
(choice
- (cons (string :tag "Tag name")
- (character :tag "Access char"))
+ (cons :tag "Tag with key"
+ (string :tag "Tag name")
+ (character :tag "Access char"))
+ (list :tag "Tag" (string :tag "Tag name"))
(const :tag "Start radio group" (:startgroup))
+ (const :tag "Start tag group, non distinct" (:startgrouptag))
(const :tag "Group tags delimiter" (:grouptags))
(const :tag "End radio group" (:endgroup))
+ (const :tag "End tag group, non distinct" (:endgrouptag))
(const :tag "New line" (:newline)))))
(defcustom org-complete-tags-always-offer-all-agenda-tags nil
@@ -3296,9 +3482,7 @@ tags in that file can be created dynamically (there are none).
(add-hook \\='org-capture-mode-hook
(lambda ()
- (set (make-local-variable
- \\='org-complete-tags-always-offer-all-agenda-tags)
- t)))"
+ (setq-local org-complete-tags-always-offer-all-agenda-tags t)))"
:group 'org-tags
:version "24.1"
:type 'boolean)
@@ -3340,7 +3524,7 @@ displaying the tags menu is not even shown, until you press C-c again."
"Non-nil means fast tags selection interface will also offer TODO states.
This is an undocumented feature, you should not rely on it.")
-(defcustom org-tags-column (if (featurep 'xemacs) -76 -77)
+(defcustom org-tags-column -77
"The column to which tags should be indented in a headline.
If this number is positive, it specifies the column. If it is negative,
it means that the tags should be flushright to that column. For example,
@@ -3437,7 +3621,7 @@ is better to limit inheritance to certain tags using the variables
"Hook that is run after the tags in a line have changed.")
(defgroup org-properties nil
- "Options concerning properties in Org-mode."
+ "Options concerning properties in Org mode."
:tag "Org Properties"
:group 'org)
@@ -3465,7 +3649,7 @@ and the clock summary:
((\"Remaining\" (lambda(value)
(let ((clocksum (org-clock-sum-current-item))
- (effort (org-duration-string-to-minutes
+ (effort (org-duration-to-minutes
(org-entry-get (point) \"Effort\"))))
(org-minutes-to-clocksum-string (- effort clocksum))))))"
:group 'org-properties
@@ -3504,14 +3688,14 @@ in this variable)."
(regexp :tag "Properties matched by regexp")))
(defun org-property-inherit-p (property)
- "Check if PROPERTY is one that should be inherited."
+ "Return a non-nil value if PROPERTY should be inherited."
(cond
((eq org-use-property-inheritance t) t)
((not org-use-property-inheritance) nil)
((stringp org-use-property-inheritance)
(string-match org-use-property-inheritance property))
((listp org-use-property-inheritance)
- (member property org-use-property-inheritance))
+ (member-ignore-case property org-use-property-inheritance))
(t (error "Invalid setting of `org-use-property-inheritance'"))))
(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS"
@@ -3532,26 +3716,6 @@ ellipses string, only part of the ellipses string will be shown."
:group 'org-properties
:type 'string)
-(defcustom org-columns-modify-value-for-display-function nil
- "Function that modifies values for display in column view.
-For example, it can be used to cut out a certain part from a time stamp.
-The function must take 2 arguments:
-
-column-title The title of the column (*not* the property name)
-value The value that should be modified.
-
-The function should return the value that should be displayed,
-or nil if the normal value should be used."
- :group 'org-properties
- :type '(choice (const nil) (function)))
-
-(defcustom 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."
- :group 'org-properties
- :group 'org-progress
- :type '(string :tag "Property"))
-
(defconst org-global-properties-fixed
'(("VISIBILITY_ALL" . "folded children content all")
("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto"))
@@ -3582,18 +3746,17 @@ You can set buffer-local values for the same purpose in the variable
(cons (string :tag "Property")
(string :tag "Value"))))
-(defvar org-file-properties nil
+(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.")
-(make-variable-buffer-local 'org-file-properties)
(defgroup org-agenda nil
- "Options concerning agenda views in Org-mode."
+ "Options concerning agenda views in Org mode."
:tag "Org Agenda"
:group 'org)
-(defvar org-category nil
+(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
@@ -3605,22 +3768,22 @@ or contain a special line
If the file does not specify a category, then file's base name
is used instead.")
-(make-variable-buffer-local 'org-category)
-(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x))))
+(put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x))))
(defcustom org-agenda-files nil
"The files to be used for agenda display.
-Entries may be added to this list with \\[org-agenda-file-to-front] and removed with
-\\[org-remove-file]. You can also use customize to edit the list.
-If an entry is a directory, all files in that directory that are matched by
-`org-agenda-file-regexp' will be part of the file list.
+If an entry is a directory, all files in that directory that are matched
+by `org-agenda-file-regexp' will be part of the file list.
If the value of the variable is not a list but a single file name, then
-the list of agenda files is actually stored and maintained in that file, one
-agenda file per line. In this file paths can be given relative to
+the list of agenda files is actually stored and maintained in that file,
+one agenda file per line. In this file paths can be given relative to
`org-directory'. Tilde expansion and environment variable substitution
-are also made."
+are also made.
+
+Entries may be added to this list with `\\[org-agenda-file-to-front]'
+and removed with `\\[org-remove-file]'."
:group 'org-agenda
:type '(choice
(repeat :tag "List of files and directories" file)
@@ -3637,7 +3800,8 @@ regular expression will be included."
(defcustom org-agenda-text-search-extra-files nil
"List of extra files to be searched by text search commands.
These files will be searched in addition to the agenda files by the
-commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'.
+commands `org-search-view' (`\\[org-agenda] s') \
+and `org-occur-in-agenda-files'.
Note that these files will only be searched for text search commands,
not for the other agenda views like todo lists, tag searches or the weekly
agenda. This variable is intended to list notes and possibly archive files
@@ -3650,7 +3814,7 @@ scope."
(const :tag "Agenda Archives" agenda-archives)
(repeat :inline t (file))))
-(org-defvaralias 'org-agenda-multi-occur-extra-files
+(defvaralias 'org-agenda-multi-occur-extra-files
'org-agenda-text-search-extra-files)
(defcustom org-agenda-skip-unavailable-files nil
@@ -3670,7 +3834,7 @@ forth between agenda and calendar."
(defcustom org-calendar-insert-diary-entry-key [?i]
"The key to be installed in `calendar-mode-map' for adding diary entries.
This option is irrelevant until `org-agenda-diary-file' has been configured
-to point to an Org-mode file. When that is the case, the command
+to point to an Org file. When that is the case, the command
`org-agenda-diary-entry' will be bound to the key given here, by default
`i'. In the calendar, `i' normally adds entries to `diary-file'. So
if you want to continue doing this, you need to change this to a different
@@ -3700,7 +3864,7 @@ points to a file, `org-agenda-diary-entry' will be used instead."
'org-agenda-diary-entry))))))
(defgroup org-latex nil
- "Options for embedding LaTeX code into Org-mode."
+ "Options for embedding LaTeX code into Org mode."
:tag "Org LaTeX"
:group 'org)
@@ -3755,39 +3919,131 @@ Replace format-specifiers in the command as noted below and use
`shell-command' to convert LaTeX to MathML.
%j: Executable file in fully expanded form as specified by
`org-latex-to-mathml-jar-file'.
-%I: Input LaTeX file in fully expanded form
-%o: Output MathML file
+%I: Input LaTeX file in fully expanded form.
+%i: The latex fragment to be converted.
+%o: Output MathML file.
+
This command is used by `org-create-math-formula'.
-When using MathToWeb as the converter, set this to
-\"java -jar %j -unicode -force -df %o %I\"."
+When using MathToWeb as the converter, set this option to
+\"java -jar %j -unicode -force -df %o %I\".
+
+When using LaTeXML set this option to
+\"latexmlmath \"%i\" --presentationmathml=%o\"."
:group 'org-latex
:version "24.1"
:type '(choice
(const :tag "None" nil)
(string :tag "\nShell command")))
-(defcustom org-latex-create-formula-image-program 'dvipng
- "Program to convert LaTeX fragments with.
-
-dvipng Process the LaTeX fragments to dvi file, then convert
- dvi files to png files using dvipng.
- This will also include processing of non-math environments.
-imagemagick Convert the LaTeX fragments to pdf files and use imagemagick
- to convert pdf files to png files"
+(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
+`org-preview-latex-process-alist', which see."
:group 'org-latex
- :version "24.1"
- :type '(choice
- (const :tag "dvipng" dvipng)
- (const :tag "imagemagick" imagemagick)))
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type 'symbol)
+
+(defcustom org-preview-latex-process-alist
+ '((dvipng
+ :programs ("latex" "dvipng")
+ :description "dvi > png"
+ :message "you need to install the programs: latex and dvipng."
+ :image-input-type "dvi"
+ :image-output-type "png"
+ :image-size-adjust (1.0 . 1.0)
+ :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
+ :image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %O %f"))
+ (dvisvgm
+ :programs ("latex" "dvisvgm")
+ :description "dvi > svg"
+ :message "you need to install the programs: latex and dvisvgm."
+ :use-xcolor t
+ :image-input-type "dvi"
+ :image-output-type "svg"
+ :image-size-adjust (1.7 . 1.5)
+ :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f")
+ :image-converter ("dvisvgm %f -n -b min -c %S -o %O"))
+ (imagemagick
+ :programs ("latex" "convert")
+ :description "pdf > png"
+ :message "you need to install the programs: latex and imagemagick."
+ :use-xcolor t
+ :image-input-type "pdf"
+ :image-output-type "png"
+ :image-size-adjust (1.0 . 1.0)
+ :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f")
+ :image-converter
+ ("convert -density %D -trim -antialias %f -quality 100 %O")))
+ "Definitions of external processes for LaTeX previewing.
+Org mode can use some external commands to generate TeX snippet's images for
+previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells
+`org-create-formula-image' how to call them.
+
+The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol.
+PROPERTIES accepts the following attributes:
+
+ :programs list of strings, required programs.
+ :description string, describe the process.
+ :message string, message it when required programs cannot be found.
+ :image-input-type string, input file type of image converter (e.g., \"dvi\").
+ :image-output-type string, output file type of image converter (e.g., \"png\").
+ :use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to
+ deal with background and foreground color of image.
+ Otherwise, dvipng style background and foreground color
+ format are generated. You may then refer to them in
+ command options with \"%F\" and \"%B\".
+ :image-size-adjust cons of numbers, the car element is used to adjust LaTeX
+ image size showed in buffer and the cdr element is for
+ HTML file. This option is only useful for process
+ developers, users should use variable
+ `org-format-latex-options' instead.
+ :post-clean list of strings, files matched are to be cleaned up once
+ the image is generated. When nil, the files with \".dvi\",
+ \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\",
+ \".png\", \".jpg\", \".jpeg\" or \".out\" extension will
+ be cleaned up.
+ :latex-header list of strings, the LaTeX header of the snippet file.
+ When nil, the fallback value is used instead, which is
+ controlled by `org-format-latex-header',
+ `org-latex-default-packages-alist' and
+ `org-latex-packages-alist', which see.
+ :latex-compiler list of LaTeX commands, as strings. Each of them is given
+ to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are
+ replaced with values defined below.
+ :image-converter list of image converter commands strings. Each of them is
+ given to the shell and supports any of the following
+ place-holders defined below.
+
+Place-holders used by `:image-converter' and `:latex-compiler':
+
+ %f input file name
+ %b base name of input file
+ %o base directory of input file
+ %O absolute output file name
+
+Place-holders only used by `:image-converter':
+
+ %F foreground of image
+ %B background of image
+ %D dpi, which is used to adjust image size by some processing commands.
+ %S the image size scale ratio, which is used to adjust image size by some
+ processing commands."
+ :group 'org-latex
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type '(alist :tag "LaTeX to image backends"
+ :value-type (plist)))
-(defcustom org-latex-preview-ltxpng-directory "ltxpng/"
+(defcustom org-preview-latex-image-directory "ltximg/"
"Path to store latex preview images.
A relative path here creates many directories relative to the
processed org files paths. An absolute path puts all preview
images at the same place."
:group 'org-latex
- :version "24.3"
+ :version "26.1"
+ :package-version '(Org . "9.0")
:type 'string)
(defun org-format-latex-mathml-available-p ()
@@ -3805,8 +4061,8 @@ images at the same place."
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
-[PACKAGES]
-[DEFAULT-PACKAGES]
+\[PACKAGES]
+\[DEFAULT-PACKAGES]
\\pagestyle{empty} % do not remove
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
@@ -3847,22 +4103,19 @@ header, or they will be appended."
(default-value var)))
(defcustom org-latex-default-packages-alist
- '(("AUTO" "inputenc" t)
- ("T1" "fontenc" t)
- ("" "fixltx2e" nil)
+ '(("AUTO" "inputenc" t ("pdflatex"))
+ ("T1" "fontenc" t ("pdflatex"))
("" "graphicx" t)
+ ("" "grffile" t)
("" "longtable" nil)
- ("" "float" nil)
("" "wrapfig" nil)
("" "rotating" nil)
("normalem" "ulem" t)
("" "amsmath" t)
("" "textcomp" t)
- ("" "marvosym" t)
- ("" "wasysym" t)
("" "amssymb" t)
- ("" "hyperref" nil)
- "\\tolerance=1000")
+ ("" "capt-of" nil)
+ ("" "hyperref" nil))
"Alist of default packages to be inserted in the header.
Change this only if one of the packages here causes an
@@ -3872,16 +4125,17 @@ The packages in this list are needed by one part or another of
Org mode to function properly:
- inputenc, fontenc: for basic font and character selection
-- fixltx2e: Important patches of LaTeX itself
- graphicx: for including images
+- grffile: allow periods and spaces in graphics file names
- longtable: For multipage tables
-- float, wrapfig: for figure placement
+- wrapfig: for figure placement
- rotating: for sideways figures and tables
- ulem: for underline and strike-through
- amsmath: for subscript and superscript and math environments
-- textcomp, marvosymb, wasysym, amssymb: for various symbols used
+- textcomp, amssymb: for various symbols used
for interpreting the entities in `org-entities'. You can skip
some of these packages if you don't use any of their symbols.
+- capt-of: for captions outside of floats
- hyperref: for cross references
Therefore you should not modify this variable unless you know
@@ -3890,20 +4144,24 @@ you might be loading some other package that conflicts with one
of the default packages. Each element is either a cell or
a string.
-A cell is of the format:
+A cell is of the format
- ( \"options\" \"package\" SNIPPET-FLAG).
+ (\"options\" \"package\" SNIPPET-FLAG COMPILERS)
If SNIPPET-FLAG is non-nil, the package also needs to be included
when compiling LaTeX snippets into images for inclusion into
-non-LaTeX output.
+non-LaTeX output. COMPILERS is a list of compilers that should
+include the package, see `org-latex-compiler'. If the document
+compiler is not in the list, and the list is non-nil, the package
+will not be inserted in the final document.
A string will be inserted as-is in the header of the document."
:group 'org-latex
:group 'org-export-latex
:set 'org-set-packages-alist
:get 'org-get-packages-alist
- :version "24.1"
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(repeat
(choice
(list :tag "options/package pair"
@@ -3947,7 +4205,7 @@ Make sure that you only list packages here which:
(string :tag "A line of LaTeX"))))
(defgroup org-appearance nil
- "Settings for Org-mode appearance."
+ "Settings for Org mode appearance."
:tag "Org Appearance"
:group 'org)
@@ -4038,6 +4296,11 @@ following symbols:
:group 'org-appearance
:type 'boolean)
+(defcustom org-hide-macro-markers nil
+ "Non-nil mean font-lock should hide the brackets marking macro calls."
+ :group 'org-appearance
+ :type 'boolean)
+
(defcustom org-pretty-entities nil
"Non-nil means show entities as UTF8 characters.
When nil, the \\name form remains in the buffer."
@@ -4061,8 +4324,10 @@ After a match, the match groups contain these elements:
3 The leading marker like * or /, indicating the type of highlighting
4 The text between the emphasis markers, not including the markers
5 The character after the match, empty at the end of a line")
+
(defvar org-verbatim-re nil
"Regular expression for matching verbatim text.")
+
(defvar org-emphasis-regexp-components) ; defined just below
(defvar org-emphasis-alist) ; defined just below
(defun org-set-emph-re (var val)
@@ -4071,60 +4336,23 @@ After a match, the match groups contain these elements:
(when (and (boundp 'org-emphasis-alist)
(boundp 'org-emphasis-regexp-components)
org-emphasis-alist org-emphasis-regexp-components)
- (let* ((e org-emphasis-regexp-components)
- (pre (car e))
- (post (nth 1 e))
- (border (nth 2 e))
- (body (nth 3 e))
- (nl (nth 4 e))
- (body1 (concat body "*?"))
- (markers (mapconcat 'car org-emphasis-alist ""))
- (vmarkers (mapconcat
- (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) ""))
- org-emphasis-alist "")))
- ;; make sure special characters appear at the right position in the class
- (if (string-match "\\^" markers)
- (setq markers (concat (replace-match "" t t markers) "^")))
- (if (string-match "-" markers)
- (setq markers (concat (replace-match "" t t markers) "-")))
- (if (string-match "\\^" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "^")))
- (if (string-match "-" vmarkers)
- (setq vmarkers (concat (replace-match "" t t vmarkers) "-")))
- (if (> nl 0)
- (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0,"
- (int-to-string nl) "\\}")))
- ;; Make the regexp
- (setq org-emph-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" markers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)"))
- (setq org-verbatim-re
- (concat "\\([" pre "]\\|^\\)"
- "\\("
- "\\([" vmarkers "]\\)"
- "\\("
- "[^" border "]\\|"
- "[^" border "]"
- body1
- "[^" border "]"
- "\\)"
- "\\3\\)"
- "\\([" post "]\\|$\\)")))))
+ (pcase-let*
+ ((`(,pre ,post ,border ,body ,nl) org-emphasis-regexp-components)
+ (body (if (<= nl 0) body
+ (format "%s*?\\(?:\n%s*?\\)\\{0,%d\\}" body body nl)))
+ (template
+ (format (concat "\\([%s]\\|^\\)" ;before markers
+ "\\(\\([%%s]\\)\\([^%s]\\|[^%s]%s[^%s]\\)\\3\\)"
+ "\\([%s]\\|$\\)") ;after markers
+ pre border border body border post)))
+ (setq org-emph-re (format template "*/_+"))
+ (setq org-verbatim-re (format template "=~")))))
;; 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
(defvar org-emphasis-regexp-components
- '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1)
+ '("- \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1)
"Components used to build the regular expression for emphasis.
This is a list with five entries. Terminology: In an emphasis string
like \" *strong word* \", we call the initial space PREMATCH, the final
@@ -4142,17 +4370,17 @@ newline The maximum number of newlines allowed in an emphasis exp.
You need to reload Org or to restart Emacs after customizing this.")
(defcustom org-emphasis-alist
- `(("*" bold)
+ '(("*" bold)
("/" italic)
("_" underline)
("=" org-verbatim verbatim)
("~" org-code verbatim)
- ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t))))
+ ("+" (:strike-through t)))
"Alist of characters and faces to emphasize text.
Text starting and ending with a special character will be emphasized,
for example *bold*, _underlined_ and /italic/. This variable sets the
marker characters and the face to be used by font-lock for highlighting
-in Org-mode Emacs buffers.
+in Org buffers.
You need to reload Org or to restart Emacs after customizing this."
:group 'org-appearance
@@ -4167,122 +4395,68 @@ You need to reload Org or to restart Emacs after customizing this."
(plist :tag "Face property list"))
(option (const verbatim)))))
-(defvar org-protecting-blocks
- '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R")
+(defvar org-protecting-blocks '("src" "example" "export")
"Blocks that contain text that is quoted, i.e. not processed as Org syntax.
This is needed for font-lock setup.")
-;;; Miscellaneous options
-
-(defgroup org-completion nil
- "Completion in Org-mode."
- :tag "Org Completion"
- :group 'org)
-
-(defcustom org-completion-use-ido nil
- "Non-nil means use ido completion wherever possible.
-Note that `ido-mode' must be active for this variable to be relevant.
-If you decide to turn this variable on, you might well want to turn off
-`org-outline-path-complete-in-steps'.
-See also `org-completion-use-iswitchb'."
- :group 'org-completion
- :type 'boolean)
-
-(defcustom org-completion-use-iswitchb nil
- "Non-nil means use iswitchb completion wherever possible.
-Note that `iswitchb-mode' must be active for this variable to be relevant.
-If you decide to turn this variable on, you might well want to turn off
-`org-outline-path-complete-in-steps'.
-Note that this variable has only an effect if `org-completion-use-ido' is nil."
- :group 'org-completion
- :type 'boolean)
-
-(defcustom org-completion-fallback-command 'hippie-expand
- "The expansion command called by \\[pcomplete] in normal context.
-Normal means, no org-mode-specific context."
- :group 'org-completion
- :type 'function)
-
;;; Functions and variables from their packages
;; Declared here to avoid compiler warnings
-
-;; XEmacs only
-(defvar outline-mode-menu-heading)
-(defvar outline-mode-menu-show)
-(defvar outline-mode-menu-hide)
-(defvar zmacs-regions) ; XEmacs regions
-
-;; Emacs only
(defvar mark-active)
;; Various packages
-(declare-function calendar-iso-to-absolute "cal-iso" (date))
-(declare-function calendar-forward-day "cal-move" (arg))
-(declare-function calendar-goto-date "cal-move" (date))
-(declare-function calendar-goto-today "cal-move" ())
-(declare-function calendar-iso-from-absolute "cal-iso" (date))
-(defvar calc-embedded-close-formula)
-(defvar calc-embedded-open-formula)
-(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function calc-eval "calc" (str &optional separator &rest args))
+(declare-function calendar-forward-day "cal-move" (arg))
+(declare-function calendar-goto-date "cal-move" (date))
+(declare-function calendar-goto-today "cal-move" ())
+(declare-function calendar-iso-from-absolute "cal-iso" (date))
+(declare-function calendar-iso-to-absolute "cal-iso" (date))
(declare-function cdlatex-compute-tables "ext:cdlatex" ())
-(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep))
-(defvar font-lock-unfontify-region-function)
-(declare-function iswitchb-read-buffer "iswitchb"
- (prompt &optional
- default require-match _predicate start matches-set))
-(defvar iswitchb-temp-buflist)
-(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
-(defvar org-agenda-tags-todo-honor-ignore-options)
-(declare-function org-agenda-skip "org-agenda" ())
-(declare-function
- org-agenda-format-item "org-agenda"
- (extra txt &optional level category tags dotime remove-re habitp))
-(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
-(declare-function org-agenda-change-all-lines "org-agenda"
+(declare-function cdlatex-tab "ext:cdlatex" ())
+(declare-function dired-get-filename
+ "dired"
+ (&optional localp no-error-if-not-filep))
+(declare-function iswitchb-read-buffer
+ "iswitchb"
+ (prompt &optional
+ default require-match _predicate start matches-set))
+(declare-function org-agenda-change-all-lines
+ "org-agenda"
(newhead hdmarker &optional fixface just-this))
-(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
+(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
+ "org-agenda"
+ (&optional end))
+(declare-function org-agenda-copy-local-variable "org-agenda" (var))
+(declare-function org-agenda-format-item
+ "org-agenda"
+ (extra txt &optional level category tags dotime
+ remove-re habitp))
(declare-function org-agenda-maybe-redo "org-agenda" ())
-(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda"
+(declare-function org-agenda-new-marker "org-agenda" (&optional pos))
+(declare-function org-agenda-save-markers-for-cut-and-paste
+ "org-agenda"
(beg end))
-(declare-function org-agenda-copy-local-variable "org-agenda" (var))
-(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- "org-agenda" (&optional end))
-(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
-(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type))
+(declare-function org-agenda-skip "org-agenda" ())
+(declare-function org-attach-reveal "org-attach" (&optional if-exists))
+(declare-function org-gnus-follow-link "org-gnus" (&optional group article))
+(declare-function org-indent-mode "org-indent" (&optional arg))
(declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
(declare-function org-inlinetask-goto-end "org-inlinetask" ())
-(declare-function org-indent-mode "org-indent" (&optional arg))
-(declare-function parse-time-string "parse-time" (string))
-(declare-function org-attach-reveal "org-attach" (&optional if-exists))
+(declare-function org-inlinetask-in-task-p "org-inlinetask" ())
+(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ())
(declare-function orgtbl-send-table "org-table" (&optional maybe))
-(defvar remember-data-file)
-(defvar texmathp-why)
+(declare-function parse-time-string "parse-time" (string))
(declare-function speedbar-line-directory "speedbar" (&optional depth))
-(declare-function table--at-cell-p "table" (position &optional object at-column))
-
-(defvar org-latex-regexps)
-
-;;; Autoload and prepare some org modules
-
-;; Some table stuff that needs to be defined here, because it is used
-;; by the functions setting up org-mode or checking for table context.
-(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)"
- "Detect an org-type or table-type table.")
-(defconst org-table-line-regexp "^[ \t]*|"
- "Detect an org-type table line.")
-(defconst org-table-dataline-regexp "^[ \t]*|[^-]"
- "Detect an org-type table line.")
-(defconst org-table-hline-regexp "^[ \t]*|-"
- "Detect an org-type table hline.")
-(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]"
- "Detect a table-type table hline.")
-(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
- "Detect the first line outside a table when searching from within it.
-This works for both table types.")
-
-(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
- "Detect a #+TBLFM line.")
+(defvar align-mode-rules-list)
+(defvar calc-embedded-close-formula)
+(defvar calc-embedded-open-formula)
+(defvar calc-embedded-open-mode)
+(defvar font-lock-unfontify-region-function)
+(defvar iswitchb-temp-buflist)
+(defvar org-agenda-tags-todo-honor-ignore-options)
+(defvar remember-data-file)
+(defvar texmathp-why)
;;;###autoload
(defun turn-on-orgtbl ()
@@ -4291,75 +4465,42 @@ This works for both table types.")
(orgtbl-mode 1))
(defun org-at-table-p (&optional table-type)
- "Return t if the cursor is inside an org-type table.
+ "Non-nil if the cursor is inside an Org table.
If TABLE-TYPE is non-nil, also check for table.el-type tables."
- (if org-enable-table-editor
- (save-excursion
- (beginning-of-line 1)
- (looking-at (if table-type org-table-any-line-regexp
- org-table-line-regexp)))
- nil))
-(defsubst org-table-p () (org-at-table-p))
+ (and (org-match-line (if table-type "[ \t]*[|+]" "[ \t]*|"))
+ (or (not (derived-mode-p 'org-mode))
+ (let ((e (org-element-lineage (org-element-at-point) '(table) t)))
+ (and e (or table-type
+ (eq 'org (org-element-property :type e))))))))
(defun org-at-table.el-p ()
- "Return t if and only if we are at a table.el table."
- (and (org-at-table-p 'any)
- (save-excursion
- (goto-char (org-table-begin 'any))
- (looking-at org-table1-hline-regexp))))
-
-(defun org-table-recognize-table.el ()
- "If there is a table.el table nearby, recognize it and move into it."
- (if org-table-tab-recognizes-table.el
- (if (org-at-table.el-p)
- (progn
- (beginning-of-line 1)
- (if (looking-at org-table-dataline-regexp)
- nil
- (if (looking-at org-table1-hline-regexp)
- (progn
- (beginning-of-line 2)
- (if (looking-at org-table-any-border-regexp)
- (beginning-of-line -1)))))
- (if (re-search-forward "|" (org-table-end t) t)
- (progn
- (require 'table)
- (if (table--at-cell-p (point))
- t
- (message "recognizing table.el table...")
- (table-recognize-table)
- (message "recognizing table.el table...done")))
- (error "This should not happen"))
- t)
- nil)
- nil))
+ "Non-nil when point is at a table.el table."
+ (and (org-match-line "[ \t]*[|+]")
+ (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'table)
+ (eq (org-element-property :type element) 'table.el)))))
(defun org-at-table-hline-p ()
- "Return t if the cursor is inside a hline in a table."
- (if org-enable-table-editor
- (save-excursion
- (beginning-of-line 1)
- (looking-at org-table-hline-regexp))
- nil))
+ "Non-nil when point is inside a hline in a table.
+Assume point is already in a table."
+ (org-match-line org-table-hline-regexp))
(defun org-table-map-tables (function &optional quietly)
"Apply FUNCTION to the start of all tables in the buffer."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward org-table-any-line-regexp nil t)
- (unless quietly
- (message "Mapping tables: %d%%"
- (floor (* 100.0 (point)) (buffer-size))))
- (beginning-of-line 1)
- (when (and (looking-at org-table-line-regexp)
- ;; Exclude tables in src/example/verbatim/clocktable blocks
- (not (org-in-block-p '("src" "example" "verbatim" "clocktable"))))
- (save-excursion (funcall function))
- (or (looking-at org-table-line-regexp)
- (forward-char 1)))
- (re-search-forward org-table-any-border-regexp nil 1))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward org-table-any-line-regexp nil t)
+ (unless quietly
+ (message "Mapping tables: %d%%"
+ (floor (* 100.0 (point)) (buffer-size))))
+ (beginning-of-line 1)
+ (when (and (looking-at org-table-line-regexp)
+ ;; Exclude tables in src/example/verbatim/clocktable blocks
+ (not (org-in-block-p '("src" "example" "verbatim" "clocktable"))))
+ (save-excursion (funcall function))
+ (or (looking-at org-table-line-regexp)
+ (forward-char 1)))
+ (re-search-forward org-table-any-border-regexp nil 1)))
(unless quietly (message "Mapping tables: done")))
(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end))
@@ -4368,12 +4509,12 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(&optional also-non-dangling-p prompt last-valid))
(defun org-at-TBLFM-p (&optional pos)
- "Return t when point (or POS) is in #+TBLFM line."
+ "Non-nil when point (or POS) is in #+TBLFM line."
(save-excursion
- (let ((pos pos)))
(goto-char (or pos (point)))
- (beginning-of-line 1)
- (looking-at org-TBLFM-regexp)))
+ (beginning-of-line)
+ (and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp))
+ (eq (org-element-type (org-element-at-point)) 'table))))
(defvar org-clock-start-time)
(defvar org-clock-marker (make-marker)
@@ -4410,7 +4551,7 @@ If yes, offer to stop it and to save the buffer with the changes."
(add-hook 'kill-emacs-hook 'org-clock-save))
(defgroup org-archive nil
- "Options concerning archiving in Org-mode."
+ "Options concerning archiving in Org mode."
:tag "Org Archive"
:group 'org-structure)
@@ -4425,7 +4566,7 @@ When the filename is omitted, archiving happens in the same file.
%s in the filename will be replaced by the current file
name (without the directory part). Archiving to a different file
is useful to keep archived entries from contributing to the
-Org-mode Agenda.
+Org Agenda.
The archived entries will be filed as subtrees of the specified
headline. When the headline is omitted, the subtrees are simply
@@ -4473,16 +4614,6 @@ the hierarchy, it will be used."
:group 'org-archive
:type 'string)
-(defcustom org-archive-tag "ARCHIVE"
- "The tag that marks a subtree as archived.
-An archived subtree does not open during visibility cycling, and does
-not contribute to the agenda listings.
-After changing this, font-lock must be restarted in the relevant buffers to
-get the proper fontification."
- :group 'org-archive
- :group 'org-keywords
- :type 'string)
-
(defcustom org-agenda-skip-archived-trees t
"Non-nil means the agenda will skip any items located in archived trees.
An archived tree is a tree marked with the tag ARCHIVE. The use of this
@@ -4515,28 +4646,31 @@ collapsed state."
:group 'org-sparse-trees
:type 'boolean)
-(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline
+(defcustom org-sparse-tree-default-date-type nil
"The default date type when building a sparse tree.
When this is nil, a date is a scheduled or a deadline timestamp.
Otherwise, these types are allowed:
all: all timestamps
active: only active timestamps (<...>)
- inactive: only inactive timestamps (<...)
+ inactive: only inactive timestamps ([...])
scheduled: only scheduled timestamps
deadline: only deadline timestamps"
- :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline)
+ :type '(choice (const :tag "Scheduled or deadline" nil)
(const :tag "All timestamps" all)
(const :tag "Only active timestamps" active)
(const :tag "Only inactive timestamps" inactive)
(const :tag "Only scheduled timestamps" scheduled)
(const :tag "Only deadline timestamps" deadline)
(const :tag "Only closed timestamps" closed))
- :version "24.3"
+ :version "26.1"
+ :package-version '(Org . "8.3")
:group 'org-sparse-trees)
(defun org-cycle-hide-archived-subtrees (state)
- "Re-hide all archived subtrees after a visibility state change."
+ "Re-hide all archived subtrees after a visibility state change.
+STATE should be one of the symbols listed in the docstring of
+`org-cycle-hook'."
(when (and (not org-cycle-open-archived-trees)
(not (memq state '(overview folded))))
(save-excursion
@@ -4545,9 +4679,10 @@ Otherwise, these types are allowed:
(end (if globalp (point-max) (org-end-of-subtree t))))
(org-hide-archived-subtrees beg end)
(goto-char beg)
- (if (looking-at (concat ".*:" org-archive-tag ":"))
- (message "%s" (substitute-command-keys
- "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway.")))))))
+ (when (looking-at-p (concat ".*:" org-archive-tag ":"))
+ (message "%s" (substitute-command-keys
+ "Subtree is archived and stays closed. Use \
+`\\[org-force-cycle-archived]' to cycle it anyway.")))))))
(defun org-force-cycle-archived ()
"Cycle subtree even if it is archived."
@@ -4558,13 +4693,16 @@ Otherwise, these types are allowed:
(defun org-hide-archived-subtrees (beg end)
"Re-hide all archived subtrees after a visibility state change."
- (save-excursion
- (let* ((re (concat ":" org-archive-tag ":")))
- (goto-char beg)
- (while (re-search-forward re end t)
- (when (org-at-heading-p)
- (org-flag-subtree t)
- (org-end-of-subtree t))))))
+ (org-with-wide-buffer
+ (let ((case-fold-search nil)
+ (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":")))
+ (goto-char beg)
+ ;; Include headline point is currently on.
+ (beginning-of-line)
+ (while (and (< (point) end) (re-search-forward re end t))
+ (when (member org-archive-tag (org-get-tags))
+ (org-flag-subtree t)
+ (org-end-of-subtree t))))))
(declare-function outline-end-of-heading "outline" ())
(declare-function outline-flag-region "outline" (from to flag))
@@ -4580,7 +4718,6 @@ Otherwise, these types are allowed:
;; Declare Column View Code
-(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf))
(declare-function org-columns-get-format-and-top-level "org-colview" ())
(declare-function org-columns-compute "org-colview" (property))
@@ -4593,79 +4730,47 @@ Otherwise, these types are allowed:
;;; Variables for pre-computed regular expressions, all buffer local
-(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$"
- "Matches first line of a hidden block.")
-(make-variable-buffer-local 'org-drawer-regexp)
-(defvar org-todo-regexp nil
- "Matches any of the TODO state keywords.")
-(make-variable-buffer-local 'org-todo-regexp)
-(defvar org-not-done-regexp nil
- "Matches any of the TODO state keywords except the last one.")
-(make-variable-buffer-local 'org-not-done-regexp)
-(defvar org-not-done-heading-regexp nil
- "Matches a TODO headline that is not done.")
-(make-variable-buffer-local 'org-not-done-regexp)
-(defvar org-todo-line-regexp nil
- "Matches a headline and puts TODO state into group 2 if present.")
-(make-variable-buffer-local 'org-todo-line-regexp)
-(defvar org-complex-heading-regexp nil
+(defvar-local org-todo-regexp nil
+ "Matches any of the TODO state keywords.
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching against this regexp.")
+
+(defvar-local org-not-done-regexp nil
+ "Matches any of the TODO state keywords except the last one.
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching against this regexp.")
+
+(defvar-local org-not-done-heading-regexp nil
+ "Matches a TODO headline that is not done.
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching against this regexp.")
+
+(defvar-local org-todo-line-regexp nil
+ "Matches a headline and puts TODO state into group 2 if present.
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching against this regexp.")
+
+(defvar-local org-complex-heading-regexp nil
"Matches a headline and puts everything into groups:
-group 1: the stars
-group 2: The todo keyword, maybe
+
+group 1: Stars
+group 2: The TODO keyword, maybe
group 3: Priority cookie
group 4: True headline
-group 5: Tags")
-(make-variable-buffer-local 'org-complex-heading-regexp)
-(defvar org-complex-heading-regexp-format nil
+group 5: Tags
+
+Since TODO keywords are case-sensitive, `case-fold-search' is
+expected to be bound to nil when matching against this regexp.")
+
+(defvar-local org-complex-heading-regexp-format nil
"Printf format to make regexp to match an exact headline.
This regexp will match the headline of any node which has the
exact headline text that is put into the format, but may have any
TODO state, priority and tags.")
-(make-variable-buffer-local 'org-complex-heading-regexp-format)
-(defvar org-todo-line-tags-regexp nil
+
+(defvar-local org-todo-line-tags-regexp nil
"Matches a headline and puts TODO state into group 2 if present.
Also put tags into group 4 if tags are present.")
-(make-variable-buffer-local 'org-todo-line-tags-regexp)
-(defvar org-ds-keyword-length 12
- "Maximum length of the DEADLINE and SCHEDULED keywords.")
-(make-variable-buffer-local 'org-ds-keyword-length)
-(defvar org-deadline-regexp nil
- "Matches the DEADLINE keyword.")
-(make-variable-buffer-local 'org-deadline-regexp)
-(defvar org-deadline-time-regexp nil
- "Matches the DEADLINE keyword together with a time stamp.")
-(make-variable-buffer-local 'org-deadline-time-regexp)
-(defvar org-deadline-time-hour-regexp nil
- "Matches the DEADLINE keyword together with a time-and-hour stamp.")
-(make-variable-buffer-local 'org-deadline-time-hour-regexp)
-(defvar org-deadline-line-regexp nil
- "Matches the DEADLINE keyword and the rest of the line.")
-(make-variable-buffer-local 'org-deadline-line-regexp)
-(defvar org-scheduled-regexp nil
- "Matches the SCHEDULED keyword.")
-(make-variable-buffer-local 'org-scheduled-regexp)
-(defvar org-scheduled-time-regexp nil
- "Matches the SCHEDULED keyword together with a time stamp.")
-(make-variable-buffer-local 'org-scheduled-time-regexp)
-(defvar org-scheduled-time-hour-regexp nil
- "Matches the SCHEDULED keyword together with a time-and-hour stamp.")
-(make-variable-buffer-local 'org-scheduled-time-hour-regexp)
-(defvar org-closed-time-regexp nil
- "Matches the CLOSED keyword together with a time stamp.")
-(make-variable-buffer-local 'org-closed-time-regexp)
-
-(defvar org-keyword-time-regexp nil
- "Matches any of the 4 keywords, together with the time stamp.")
-(make-variable-buffer-local 'org-keyword-time-regexp)
-(defvar org-keyword-time-not-clock-regexp nil
- "Matches any of the 3 keywords, together with the time stamp.")
-(make-variable-buffer-local 'org-keyword-time-not-clock-regexp)
-(defvar org-maybe-keyword-time-regexp nil
- "Matches a timestamp, possibly preceded by a keyword.")
-(make-variable-buffer-local 'org-maybe-keyword-time-regexp)
-(defvar org-all-time-keywords nil
- "List of time keywords.")
-(make-variable-buffer-local 'org-all-time-keywords)
(defconst org-plain-time-of-day-regexp
(concat
@@ -4771,32 +4876,6 @@ 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
means to push this value onto the list in the variable.")
-(defun org-update-property-plist (key val props)
- "Update PROPS with KEY and VAL."
- (let* ((appending (string= "+" (substring key (- (length key) 1))))
- (key (if appending (substring key 0 (- (length key) 1)) key))
- (remainder (org-remove-if (lambda (p) (string= (car p) key)) props))
- (previous (cdr (assoc key props))))
- (if appending
- (cons (cons key (if previous (concat previous " " val) val)) remainder)
- (cons (cons key val) remainder))))
-
-(defconst org-block-regexp
- "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$"
- "Regular expression for hiding blocks.")
-(defconst org-heading-keyword-regexp-format
- "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching a headline with some keyword.
-This regexp will match the headline of any node which has the
-exact keyword that is put into the format. The keyword isn't in
-any group by default, but the stars and the body are.")
-(defconst org-heading-keyword-maybe-regexp-format
- "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$"
- "Printf format for a regexp matching a headline, possibly with some keyword.
-This regexp can match any headline with the specified keyword, or
-without a keyword. The keyword isn't in any group by default,
-but the stars and the body are.")
-
(defcustom org-group-tags t
"When non-nil (the default), use group tags.
This can be turned on/off through `org-toggle-tags-groups'."
@@ -4820,386 +4899,425 @@ Support for group tags is controlled by the option
(message "Groups tags support has been turned %s"
(if org-group-tags "on" "off")))
-(defun org-set-regexps-and-options-for-tags ()
- "Precompute variables used for tags."
- (when (derived-mode-p 'org-mode)
- (org-set-local 'org-file-tags nil)
- (let ((re (org-make-options-regexp '("FILETAGS" "TAGS")))
- (splitre "[ \t]+")
- (start 0)
- tags ftags key value)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (setq key (upcase (org-match-string-no-properties 1))
- value (org-match-string-no-properties 2))
- (if (stringp value) (setq value (org-trim value)))
- (cond
- ((equal key "TAGS")
- (setq tags (append tags (if tags '("\\n") nil)
- (org-split-string value splitre))))
- ((equal key "FILETAGS")
- (when (string-match "\\S-" value)
- (setq ftags
- (append
- ftags
- (apply 'append
- (mapcar (lambda (x) (org-split-string x ":"))
- (org-split-string value)))))))))))
- ;; Process the file tags.
- (and ftags (org-set-local 'org-file-tags
- (mapcar 'org-add-prop-inherited ftags)))
- (org-set-local 'org-tag-groups-alist nil)
- ;; Process the tags.
- (when (and (not tags) org-tag-alist)
- (setq tags
- (mapcar
- (lambda (tg) (cond ((eq (car tg) :startgroup) "{")
- ((eq (car tg) :endgroup) "}")
- ((eq (car tg) :grouptags) ":")
- ((eq (car tg) :newline) "\n")
- (t (concat (car tg)
- (if (characterp (cdr tg))
- (format "(%s)" (char-to-string (cdr tg))) "")))))
- org-tag-alist)))
- (let (tgs g)
- (dolist (e tags)
- (cond
- ((equal e "{")
- (progn (push '(:startgroup) tgs)
- (when (equal (nth 1 tags) ":")
- (push (list (replace-regexp-in-string
- "(.+)$" "" (nth 0 tags)))
- org-tag-groups-alist)
- (setq g 0))))
- ((equal e ":") (push '(:grouptags) tgs))
- ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil)))
- ((equal e "\\n") (push '(:newline) tgs))
- ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
- (push (cons (match-string 1 e)
- (string-to-char (match-string 2 e)))
- tgs)
- (if (and g (> g 0))
- (setcar org-tag-groups-alist
- (append (car org-tag-groups-alist)
- (list (match-string 1 e)))))
- (if g (setq g (1+ g))))
- (t (push (list e) tgs)
- (if (and g (> g 0))
- (setcar org-tag-groups-alist
- (append (car org-tag-groups-alist) (list e))))
- (if g (setq g (1+ g))))))
- (org-set-local 'org-tag-alist nil)
- (dolist (e tgs)
- (or (and (stringp (car e))
- (assoc (car e) org-tag-alist))
- (push e org-tag-alist)))
- ;; Return a list with tag variables
- (list org-file-tags org-tag-alist org-tag-groups-alist)))))
-
-(defvar org-ota nil)
-(defun org-set-regexps-and-options ()
- "Precompute regular expressions used in the current buffer."
+(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)
- (org-set-local 'org-todo-kwd-alist nil)
- (org-set-local 'org-todo-key-alist nil)
- (org-set-local 'org-todo-key-trigger nil)
- (org-set-local 'org-todo-keywords-1 nil)
- (org-set-local 'org-done-keywords nil)
- (org-set-local 'org-todo-heads nil)
- (org-set-local 'org-todo-sets nil)
- (org-set-local 'org-todo-log-states nil)
- (org-set-local 'org-file-properties nil)
- (let ((re (org-make-options-regexp
- '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE"
- "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS"
- "SETUPFILE" "OPTIONS")
- "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
- (splitre "[ \t]+")
- (scripts org-use-sub-superscripts)
- kwds kws0 kwsa key log value cat arch const links hw dws
- tail sep kws1 prio props drawers ext-setup-or-nil setup-contents
- (start 0))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while
- (or (and
- ext-setup-or-nil
- (not org-ota)
- (let (ret)
- (with-temp-buffer
- (insert ext-setup-or-nil)
- (let ((major-mode 'org-mode) org-ota)
- (setq ret (save-match-data
- (org-set-regexps-and-options-for-tags)))))
- ;; Append setupfile tags to existing tags
- (setq org-ota t)
- (setq org-file-tags
- (delq nil (append org-file-tags (nth 0 ret)))
- org-tag-alist
- (delq nil (append org-tag-alist (nth 1 ret)))
- org-tag-groups-alist
- (delq nil (append org-tag-groups-alist (nth 2 ret))))))
- (and ext-setup-or-nil
- (string-match re ext-setup-or-nil start)
- (setq start (match-end 0)))
- (and (setq ext-setup-or-nil nil start 0)
- (re-search-forward re nil t)))
- (setq key (upcase (match-string 1 ext-setup-or-nil))
- value (org-match-string-no-properties 2 ext-setup-or-nil))
- (if (stringp value) (setq value (org-trim value)))
- (cond
- ((equal key "CATEGORY")
- (setq cat value))
- ((member key '("SEQ_TODO" "TODO"))
- (push (cons 'sequence (org-split-string value splitre)) kwds))
- ((equal key "TYP_TODO")
- (push (cons 'type (org-split-string value splitre)) kwds))
- ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key)
- ;; general TODO-like setup
- (push (cons (intern (downcase (match-string 1 key)))
- (org-split-string value splitre))
- kwds))
- ((equal key "COLUMNS")
- (org-set-local 'org-columns-default-format value))
- ((equal key "LINK")
- (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value)
- (push (cons (match-string 1 value)
- (org-trim (match-string 2 value)))
- links)))
- ((equal key "PRIORITIES")
- (setq prio (org-split-string value " +")))
- ((equal key "PROPERTY")
- (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
- (setq props (org-update-property-plist (match-string 1 value)
- (match-string 2 value)
- props))))
- ((equal key "DRAWERS")
- (setq drawers (delete-dups (append org-drawers (org-split-string value splitre)))))
- ((equal key "CONSTANTS")
- (org-table-set-constants))
- ((equal key "STARTUP")
- (let ((opts (org-split-string value splitre))
- var val)
- (dolist (l opts)
- (when (setq l (assoc l org-startup-options))
- (setq var (nth 1 l) val (nth 2 l))
- (if (not (nth 3 l))
- (set (make-local-variable var) val)
- (if (not (listp (symbol-value var)))
- (set (make-local-variable var) nil))
- (set (make-local-variable var) (symbol-value var))
- (add-to-list var val))))))
- ((equal key "ARCHIVE")
- (setq arch value)
- (remove-text-properties 0 (length arch)
- '(face t fontified t) arch))
- ((equal key "OPTIONS")
- (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value)
- (setq scripts (read (match-string 2 value)))))
- ((and (equal key "SETUPFILE")
- ;; Prevent checking in Gnus messages
- (not buffer-read-only))
- (setq setup-contents (org-file-contents
- (expand-file-name
- (org-remove-double-quotes value))
- 'noerror))
- (if (not ext-setup-or-nil)
- (setq ext-setup-or-nil setup-contents start 0)
- (setq ext-setup-or-nil
- (concat (substring ext-setup-or-nil 0 start)
- "\n" setup-contents "\n"
- (substring ext-setup-or-nil start)))))))
- ;; search for property blocks
- (goto-char (point-min))
- (while (re-search-forward org-block-regexp nil t)
- (when (equal "PROPERTY" (upcase (match-string 1)))
- (setq value (replace-regexp-in-string
- "[\n\r]" " " (match-string 4)))
- (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value)
- (setq props (org-update-property-plist (match-string 1 value)
- (match-string 2 value)
- props)))))))
- (org-set-local 'org-use-sub-superscripts scripts)
- (when cat
- (org-set-local 'org-category (intern cat))
- (push (cons "CATEGORY" cat) props))
- (when prio
- (if (< (length prio) 3) (setq prio '("A" "C" "B")))
- (setq prio (mapcar 'string-to-char prio))
- (org-set-local 'org-highest-priority (nth 0 prio))
- (org-set-local 'org-lowest-priority (nth 1 prio))
- (org-set-local 'org-default-priority (nth 2 prio)))
- (and props (org-set-local 'org-file-properties (nreverse props)))
- (and drawers (org-set-local 'org-drawers drawers))
- (and arch (org-set-local 'org-archive-location arch))
- (and links (setq org-link-abbrev-alist-local (nreverse links)))
- ;; Process the TODO keywords
- (unless kwds
- ;; Use the global values as if they had been given locally.
- (setq kwds (default-value 'org-todo-keywords))
- (if (stringp (car kwds))
- (setq kwds (list (cons org-todo-interpretation
- (default-value 'org-todo-keywords)))))
- (setq kwds (reverse kwds)))
- (setq kwds (nreverse kwds))
- (let (inter kw)
- (dolist (kws kwds)
- (let ((kws (or
- (run-hook-with-args-until-success
- 'org-todo-setup-filter-hook kws)
- kws)))
- (setq inter (pop kws) sep (member "|" kws)
- kws0 (delete "|" (copy-sequence kws))
- kwsa nil
- kws1 (mapcar
- (lambda (x)
- ;; 1 2
- (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x)
- (progn
- (setq kw (match-string 1 x)
- key (and (match-end 2) (match-string 2 x))
- log (org-extract-log-state-settings x))
- (push (cons kw (and key (string-to-char key))) kwsa)
- (and log (push log org-todo-log-states))
- kw)
- (error "Invalid TODO keyword %s" x)))
- kws0)
- kwsa (if kwsa (append '((:startgroup))
- (nreverse kwsa)
- '((:endgroup))))
- hw (car kws1)
- dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1))
- tail (list inter hw (car dws) (org-last dws))))
- (add-to-list 'org-todo-heads hw 'append)
- (push kws1 org-todo-sets)
- (setq org-done-keywords (append org-done-keywords dws nil))
- (setq org-todo-key-alist (append org-todo-key-alist kwsa))
- (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1)
- (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil)))
+ (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")))))))
+ ;; Startup options. Get this early since it does change
+ ;; behavior for other options (e.g., tags).
+ (let ((startup (cdr (assq '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)))))))
+ (setq-local org-file-tags
+ (mapcar #'org-add-prop-inherited
+ (cdr (assq 'filetags alist))))
+ (setq org-current-tag-alist
+ (append org-tag-persistent-alist
+ (let ((tags (cdr (assq 'tags alist))))
+ (if tags (org-tag-string-to-alist tags)
+ 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)))
+ ;; Archive location.
+ (let ((archive (cdr (assq '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
+ (org--update-property-plist
+ "CATEGORY" cat org-file-properties))))
+ ;; Columns.
+ (let ((column (cdr (assq 'columns alist))))
+ (when column (setq-local org-columns-default-format column)))
+ ;; Constants.
+ (setq org-table-formula-constants-local (cdr (assq 'constants alist)))
+ ;; Link abbreviations.
+ (let ((links (cdr (assq '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))))
+ ;; Scripts.
+ (let ((scripts (assq 'scripts alist)))
+ (when scripts
+ (setq-local org-use-sub-superscripts (cdr scripts))))
+ ;; TODO keywords.
+ (setq-local org-todo-kwd-alist nil)
+ (setq-local org-todo-key-alist nil)
+ (setq-local org-todo-key-trigger nil)
+ (setq-local org-todo-keywords-1 nil)
+ (setq-local org-done-keywords nil)
+ (setq-local org-todo-heads nil)
+ (setq-local org-todo-sets nil)
+ (setq-local org-todo-log-states nil)
+ (let ((todo-sequences
+ (or (nreverse (cdr (assq 'todo alist)))
+ (let ((d (default-value 'org-todo-keywords)))
+ (if (not (stringp (car d))) d
+ ;; XXX: Backward compatibility code.
+ (list (cons org-todo-interpretation d)))))))
+ (dolist (sequence todo-sequences)
+ (let* ((sequence (or (run-hook-with-args-until-success
+ 'org-todo-setup-filter-hook sequence)
+ sequence))
+ (sequence-type (car sequence))
+ (keywords (cdr sequence))
+ (sep (member "|" keywords))
+ names alist)
+ (dolist (k (remove "|" keywords))
+ (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$"
+ k)
+ (error "Invalid TODO keyword %s" k))
+ (let ((name (match-string 1 k))
+ (key (match-string 2 k))
+ (log (org-extract-log-state-settings k)))
+ (push name names)
+ (push (cons name (and key (string-to-char key))) alist)
+ (when log (push log org-todo-log-states))))
+ (let* ((names (nreverse names))
+ (done (if sep (org-remove-keyword-keys (cdr sep))
+ (last names)))
+ (head (car names))
+ (tail (list sequence-type head (car done) (org-last done))))
+ (add-to-list 'org-todo-heads head 'append)
+ (push names org-todo-sets)
+ (setq org-done-keywords (append org-done-keywords done nil))
+ (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil))
+ (setq org-todo-key-alist
+ (append org-todo-key-alist
+ (and alist
+ (append '((:startgroup))
+ (nreverse alist)
+ '((:endgroup))))))
+ (dolist (k names) (push (cons k tail) org-todo-kwd-alist))))))
(setq org-todo-sets (nreverse org-todo-sets)
org-todo-kwd-alist (nreverse org-todo-kwd-alist)
- org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist))
- org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)))
- ;; Compute the regular expressions and other local variables.
- ;; Using `org-outline-regexp-bol' would complicate them much,
- ;; because of the fixed white space at the end of that string.
- (if (not org-done-keywords)
- (setq org-done-keywords (and org-todo-keywords-1
- (list (org-last org-todo-keywords-1)))))
- (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string)
- (length org-scheduled-string)
- (length org-clock-string)
- (length org-closed-string)))
- org-drawer-regexp
- (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")
- org-not-done-keywords
- (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1))
- org-todo-regexp
- (concat "\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- "\\)")
- org-not-done-regexp
- (concat "\\("
- (mapconcat 'regexp-quote org-not-done-keywords "\\|")
- "\\)")
- org-not-done-heading-regexp
- (format org-heading-keyword-regexp-format org-not-done-regexp)
- org-todo-line-regexp
- (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
- org-complex-heading-regexp
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +\\(.*?\\)\\)??"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?")
- "[ \t]*$")
- org-complex-heading-regexp-format
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(\\[#.\\]\\)\\)?"
- "\\(?: +"
- ;; Stats cookies can be stuck to body.
- "\\(?:\\[[0-9%%/]+\\] *\\)*"
- "\\(%s\\)"
- "\\(?: *\\[[0-9%%/]+\\]\\)*"
- "\\)"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
- "[ \t]*$")
- org-todo-line-tags-regexp
- (concat "^\\(\\*+\\)"
- "\\(?: +" org-todo-regexp "\\)?"
- "\\(?: +\\(.*?\\)\\)??"
- (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?")
- "[ \t]*$")
- org-deadline-regexp (concat "\\<" org-deadline-string)
- org-deadline-time-regexp
- (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")
- org-deadline-time-hour-regexp
- (concat "\\<" org-deadline-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
- org-deadline-line-regexp
- (concat "\\<\\(" org-deadline-string "\\).*")
- org-scheduled-regexp
- (concat "\\<" org-scheduled-string)
- org-scheduled-time-regexp
- (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")
- org-scheduled-time-hour-regexp
- (concat "\\<" org-scheduled-string
- " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>")
- org-closed-time-regexp
- (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]")
- org-keyword-time-regexp
- (concat "\\<\\(" org-scheduled-string
- "\\|" org-deadline-string
- "\\|" org-closed-string
- "\\|" org-clock-string "\\)"
- " *[[<]\\([^]>]+\\)[]>]")
- org-keyword-time-not-clock-regexp
- (concat "\\<\\(" org-scheduled-string
- "\\|" org-deadline-string
- "\\|" org-closed-string
- "\\)"
- " *[[<]\\([^]>]+\\)[]>]")
- org-maybe-keyword-time-regexp
- (concat "\\(\\<\\(" org-scheduled-string
- "\\|" org-deadline-string
- "\\|" org-closed-string
- "\\|" org-clock-string "\\)\\)?"
- " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)")
- org-all-time-keywords
- (mapcar (lambda (w) (substring w 0 -1))
- (list org-scheduled-string org-deadline-string
- org-clock-string org-closed-string)))
- (setq org-ota nil)
- (org-compute-latex-and-related-regexp))))
-
-(defun org-file-contents (file &optional noerror)
- "Return the contents of FILE, as a string."
- (if (or (not file) (not (file-readable-p file)))
- (if (not noerror)
- (error "Cannot read file \"%s\"" file)
- (message "Cannot read file \"%s\"" file)
- "")
- (with-temp-buffer
- (insert-file-contents file)
- (buffer-string))))
+ org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist))
+ org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))
+ ;; Compute the regular expressions and other local variables.
+ ;; Using `org-outline-regexp-bol' would complicate them much,
+ ;; because of the fixed white space at the end of that string.
+ (unless org-done-keywords
+ (setq org-done-keywords
+ (and org-todo-keywords-1 (last org-todo-keywords-1))))
+ (setq org-not-done-keywords
+ (org-delete-all org-done-keywords
+ (copy-sequence org-todo-keywords-1))
+ org-todo-regexp (regexp-opt org-todo-keywords-1 t)
+ org-not-done-regexp (regexp-opt org-not-done-keywords t)
+ org-not-done-heading-regexp
+ (format org-heading-keyword-regexp-format org-not-done-regexp)
+ org-todo-line-regexp
+ (format org-heading-keyword-maybe-regexp-format org-todo-regexp)
+ org-complex-heading-regexp
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?"
+ "[ \t]*$")
+ org-complex-heading-regexp-format
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(\\[#.\\]\\)\\)?"
+ "\\(?: +"
+ ;; Stats cookies can be stuck to body.
+ "\\(?:\\[[0-9%%/]+\\] *\\)*"
+ "\\(%s\\)"
+ "\\(?: *\\[[0-9%%/]+\\]\\)*"
+ "\\)"
+ "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
+ "[ \t]*$")
+ org-todo-line-tags-regexp
+ (concat "^\\(\\*+\\)"
+ "\\(?: +" org-todo-regexp "\\)?"
+ "\\(?: +\\(.*?\\)\\)??"
+ "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?"
+ "[ \t]*$"))
+ (org-compute-latex-and-related-regexp)))))
+
+(defun org--setup-collect-keywords (regexp &optional files alist)
+ "Return setup keywords values 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.
+
+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-unbracket-string "\"" "\"" 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.
+ (let ((major-mode 'org-mode))
+ (org--setup-collect-keywords
+ regexp (cons f files) alist)))))))))))))))
+ alist)
+
+(defun org-tag-string-to-alist (s)
+ "Return tag alist associated to string S.
+S is a value for TAGS keyword or produced with
+`org-tag-alist-to-string'. Return value is an alist suitable for
+`org-tag-alist' or `org-tag-persistent-alist'."
+ (let ((lines (mapcar #'split-string (split-string s "\n" t)))
+ (tag-re (concat "\\`\\([[:alnum:]_@#%]+"
+ "\\|{.+?}\\)" ; regular expression
+ "\\(?:(\\(.\\))\\)?\\'"))
+ alist group-flag)
+ (dolist (tokens lines (cdr (nreverse alist)))
+ (push '(:newline) alist)
+ (while tokens
+ (let ((token (pop tokens)))
+ (pcase token
+ ("{"
+ (push '(:startgroup) alist)
+ (when (equal (nth 1 tokens) ":") (setq group-flag t)))
+ ("}"
+ (push '(:endgroup) alist)
+ (setq group-flag nil))
+ ("["
+ (push '(:startgrouptag) alist)
+ (when (equal (nth 1 tokens) ":") (setq group-flag t)))
+ ("]"
+ (push '(:endgrouptag) alist)
+ (setq group-flag nil))
+ (":"
+ (push '(:grouptags) alist))
+ ((guard (string-match tag-re token))
+ (let ((tag (match-string 1 token))
+ (key (and (match-beginning 2)
+ (string-to-char (match-string 2 token)))))
+ ;; Push all tags in groups, no matter if they already
+ ;; appear somewhere else in the list.
+ (when (or group-flag (not (assoc tag alist)))
+ (push (cons tag key) alist))))))))))
+
+(defun org-tag-alist-to-string (alist &optional skip-key)
+ "Return tag string associated to ALIST.
+
+ALIST is an alist, as defined in `org-tag-alist' or
+`org-tag-persistent-alist', or produced with
+`org-tag-string-to-alist'.
+
+Return value is a string suitable as a value for \"TAGS\"
+keyword.
+
+When optional argument SKIP-KEY is non-nil, skip selection keys
+next to tags."
+ (mapconcat (lambda (token)
+ (pcase token
+ (`(:startgroup) "{")
+ (`(:endgroup) "}")
+ (`(:startgrouptag) "[")
+ (`(:endgrouptag) "]")
+ (`(:grouptags) ":")
+ (`(:newline) "\\n")
+ ((and
+ (guard (not skip-key))
+ `(,(and tag (pred stringp)) . ,(and key (pred characterp))))
+ (format "%s(%c)" tag key))
+ (`(,(and tag (pred stringp)) . ,_) tag)
+ (_ (user-error "Invalid tag token: %S" token))))
+ alist
+ " "))
+
+(defun org-tag-alist-to-groups (alist)
+ "Return group alist from tag ALIST.
+ALIST is an alist, as defined in `org-tag-alist' or
+`org-tag-persistent-alist', or produced with
+`org-tag-string-to-alist'. Return value is an alist following
+the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as
+a string, summarizing TAGS, as a list of strings."
+ (let (groups group-status current-group)
+ (dolist (token alist (nreverse groups))
+ (pcase token
+ (`(,(or :startgroup :startgrouptag)) (setq group-status t))
+ (`(,(or :endgroup :endgrouptag))
+ (when (eq group-status 'append)
+ (push (nreverse current-group) groups))
+ (setq group-status nil))
+ (`(:grouptags) (setq group-status 'append))
+ ((and `(,tag . ,_) (guard group-status))
+ (if (eq group-status 'append) (push tag current-group)
+ (setq current-group (list tag))))
+ (_ nil)))))
+
+(defvar org--file-cache (make-hash-table :test #'equal)
+ "Hash table to store contents of files referenced via a URL.
+This is the cache of file URLs read using `org-file-contents'.")
+
+(defun org-reset-file-cache ()
+ "Reset the cache of files downloaded by `org-file-contents'."
+ (clrhash org--file-cache))
+
+(defun org-file-url-p (file)
+ "Non-nil if FILE is a URL."
+ (require 'ffap)
+ (string-match-p ffap-url-regexp file))
+
+(defun org-file-contents (file &optional noerror nocache)
+ "Return the contents of FILE, as a string.
+
+FILE can be a file name or URL.
+
+If FILE is a URL, download the contents. If the URL contents are
+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.
+
+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."
+ (let* ((is-url (org-file-url-p file))
+ (cache (and is-url
+ (not nocache)
+ (gethash file org--file-cache))))
+ (cond
+ (cache)
+ (is-url
+ (with-current-buffer (url-retrieve-synchronously file)
+ (goto-char (point-min))
+ ;; Move point to after the url-retrieve header.
+ (search-forward "\n\n" nil :move)
+ ;; Search for the success code only in the url-retrieve header.
+ (if (save-excursion
+ (re-search-backward "HTTP.*\\s-+200\\s-OK" nil :noerror))
+ ;; Update the cache `org--file-cache' and return contents.
+ (puthash file
+ (buffer-substring-no-properties (point) (point-max))
+ org--file-cache)
+ (funcall (if noerror #'message #'user-error)
+ "Unable to fetch file from %S"
+ file))))
+ (t
+ (with-temp-buffer
+ (condition-case nil
+ (progn
+ (insert-file-contents file)
+ (buffer-string))
+ (file-error
+ (funcall (if noerror #'message #'user-error)
+ "Unable to read file %S"
+ file))))))))
(defun org-extract-log-state-settings (x)
"Extract the log state setting from a TODO keyword string.
This will extract info from a string like \"WAIT(w@/!)\"."
- (let (kw key log1 log2)
- (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
- (setq kw (match-string 1 x)
- key (and (match-end 2) (match-string 2 x))
- log1 (and (match-end 3) (match-string 3 x))
- log2 (and (match-end 4) (match-string 4 x)))
+ (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x)
+ (let ((kw (match-string 1 x))
+ (log1 (and (match-end 3) (match-string 3 x)))
+ (log2 (and (match-end 4) (match-string 4 x))))
(and (or log1 log2)
(list kw
(and log1 (if (equal log1 "!") 'time 'note))
@@ -5216,8 +5334,8 @@ This will extract info from a string like \"WAIT(w@/!)\"."
(defun org-assign-fast-keys (alist)
"Assign fast keys to a keyword-key alist.
Respect keys that are already there."
- (let (new (alt ?0))
- (dolist (e alist)
+ (let (new e (alt ?0))
+ (while (setq e (pop alist))
(if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
(cdr e)) ;; Key already assigned.
(push e new)
@@ -5229,7 +5347,7 @@ Respect keys that are already there."
(pop clist))
(unless clist
(while (rassoc alt used)
- (incf alt)))
+ (cl-incf alt)))
(push (cons (car e) (or (car clist) alt)) new))))
(nreverse new)))
@@ -5242,13 +5360,7 @@ Respect keys that are already there."
(defvar org-finish-function nil
"Function to be called when `C-c C-c' is used.
This is for getting out of special buffers like capture.")
-
-
-;; FIXME: Occasionally check by commenting these, to make sure
-;; no other functions uses these, forgetting to let-bind them.
-(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
(defvar org-last-state)
-(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
;; Defined somewhere in this file, but used before definition.
(defvar org-entities) ;; defined in org-entities.el
@@ -5256,7 +5368,7 @@ This is for getting out of special buffers like capture.")
(defvar org-org-menu)
(defvar org-tbl-menu)
-;;;; Define the Org-mode
+;;;; Define the Org mode
;; We use a before-change function to check if a table might need
;; an update.
@@ -5264,7 +5376,7 @@ This is for getting out of special buffers like capture.")
"Indicates that a table might need an update.
This variable is set by `org-before-change-function'.
`org-table-align' sets it back to nil.")
-(defun org-before-change-function (beg end)
+(defun org-before-change-function (_beg _end)
"Every change indicates that a table might need an update."
(setq org-table-may-need-update t))
(defvar org-mode-map)
@@ -5278,13 +5390,12 @@ This variable is set by `org-before-change-function'.
(defvar buffer-face-mode-face)
(require 'outline)
-(if (and (not (keymapp outline-mode-map)) (featurep 'allout))
- (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22"))
-(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it
;; Other stuff we need.
(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
@@ -5305,15 +5416,15 @@ This variable is set by `org-before-change-function'.
"Outline-based notes management and organizer, alias
\"Carsten's outline-mode for keeping track of everything.\"
-Org-mode develops organizational tasks around a NOTES file which
-contains information about projects as plain text. Org-mode is
-implemented on top of outline-mode, which is ideal to keep the content
+Org mode develops organizational tasks around a NOTES file which
+contains information about projects as plain text. Org mode is
+implemented on top of Outline mode, which is ideal to keep the content
of large files well structured. It supports ToDo items, deadlines and
time stamps, which magically appear in the diary listing of the Emacs
calendar. Tables are easily created with a built-in table editor.
Plain text URL-like links connect to websites, emails (VM), Usenet
messages (Gnus), BBDB entries, and any files related to the project.
-For printing and sharing of notes, an Org-mode file (or a part of it)
+For printing and sharing of notes, an Org file (or a part of it)
can be exported as a structured ASCII or HTML file.
The following commands are available:
@@ -5323,86 +5434,68 @@ The following commands are available:
;; Get rid of Outline menus, they are not needed
;; Need to do this here because define-derived-mode sets up
;; the keymap so late. Still, it is a waste to call this each time
- ;; we switch another buffer into org-mode.
- (if (featurep 'xemacs)
- (when (boundp 'outline-mode-menu-heading)
- ;; Assume this is Greg's port, it uses easymenu
- (easy-menu-remove outline-mode-menu-heading)
- (easy-menu-remove outline-mode-menu-show)
- (easy-menu-remove outline-mode-menu-hide))
- (define-key org-mode-map [menu-bar headings] 'undefined)
- (define-key org-mode-map [menu-bar hide] 'undefined)
- (define-key org-mode-map [menu-bar show] 'undefined))
+ ;; we switch another buffer into Org mode.
+ (define-key org-mode-map [menu-bar headings] 'undefined)
+ (define-key org-mode-map [menu-bar hide] 'undefined)
+ (define-key org-mode-map [menu-bar show] 'undefined)
(org-load-modules-maybe)
- (when (featurep 'xemacs)
- (easy-menu-add org-org-menu)
- (easy-menu-add org-tbl-menu))
(org-install-agenda-files-menu)
- (if org-descriptive-links (add-to-invisibility-spec '(org-link)))
+ (when org-descriptive-links (add-to-invisibility-spec '(org-link)))
(add-to-invisibility-spec '(org-cwidth))
(add-to-invisibility-spec '(org-hide-block . t))
- (when (featurep 'xemacs)
- (org-set-local 'line-move-ignore-invisible t))
- (org-set-local 'outline-regexp org-outline-regexp)
- (org-set-local 'outline-level 'org-outline-level)
+ (setq-local outline-regexp org-outline-regexp)
+ (setq-local outline-level 'org-outline-level)
(setq bidi-paragraph-direction 'left-to-right)
- (when (and org-ellipsis
- (fboundp 'set-display-table-slot) (boundp 'buffer-display-table)
- (fboundp 'make-glyph-code))
+ (when (and (stringp org-ellipsis) (not (equal "" org-ellipsis)))
(unless org-display-table
(setq org-display-table (make-display-table)))
(set-display-table-slot
org-display-table 4
- (vconcat (mapcar
- (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis))
- org-ellipsis)))
- (if (stringp org-ellipsis) org-ellipsis "..."))))
+ (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis))
+ org-ellipsis)))
(setq buffer-display-table org-display-table))
- (org-set-regexps-and-options-for-tags)
(org-set-regexps-and-options)
(org-set-font-lock-defaults)
(when (and org-tag-faces (not org-tags-special-faces-re))
;; tag faces set outside customize.... force initialization.
(org-set-tag-faces 'org-tag-faces org-tag-faces))
;; Calc embedded
- (org-set-local 'calc-embedded-open-mode "# ")
+ (setq-local calc-embedded-open-mode "# ")
;; Modify a few syntax entries
(modify-syntax-entry ?@ "w")
(modify-syntax-entry ?\" "\"")
(modify-syntax-entry ?\\ "_")
(modify-syntax-entry ?~ "_")
- (if org-startup-truncated (setq truncate-lines t))
- (when org-startup-indented (require 'org-indent) (org-indent-mode 1))
- (org-set-local 'font-lock-unfontify-region-function
- 'org-unfontify-region)
+ (setq-local font-lock-unfontify-region-function 'org-unfontify-region)
;; Activate before-change-function
- (org-set-local 'org-table-may-need-update t)
- (org-add-hook 'before-change-functions 'org-before-change-function nil
- 'local)
+ (setq-local org-table-may-need-update t)
+ (add-hook 'before-change-functions 'org-before-change-function nil 'local)
;; Check for running clock before killing a buffer
- (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
+ (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local)
;; Initialize macros templates.
(org-macro-initialize-templates)
;; Initialize radio targets.
(org-update-radio-target-regexp)
;; Indentation.
- (org-set-local 'indent-line-function 'org-indent-line)
- (org-set-local 'indent-region-function 'org-indent-region)
+ (setq-local indent-line-function 'org-indent-line)
+ (setq-local indent-region-function 'org-indent-region)
;; Filling and auto-filling.
(org-setup-filling)
;; Comments.
(org-setup-comments-handling)
+ ;; Initialize cache.
+ (org-element-cache-reset)
;; Beginning/end of defun
- (org-set-local 'beginning-of-defun-function 'org-backward-element)
- (org-set-local 'end-of-defun-function
- (lambda ()
- (if (not (org-at-heading-p))
- (org-forward-element)
- (org-forward-element)
- (forward-char -1))))
+ (setq-local beginning-of-defun-function 'org-backward-element)
+ (setq-local end-of-defun-function
+ (lambda ()
+ (if (not (org-at-heading-p))
+ (org-forward-element)
+ (org-forward-element)
+ (forward-char -1))))
;; Next error for sparse trees
- (org-set-local 'next-error-function 'org-occur-next-match)
+ (setq-local next-error-function 'org-occur-next-match)
;; Make sure dependence stuff works reliably, even for users who set it
;; too late :-(
(if org-enforce-todo-dependencies
@@ -5417,78 +5510,68 @@ The following commands are available:
'org-block-todo-from-checkboxes))
;; Align options lines
- (org-set-local
- 'align-mode-rules-list
+ (setq-local
+ align-mode-rules-list
'((org-in-buffer-settings
- (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
+ (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+")
(modes . '(org-mode)))))
;; Imenu
- (org-set-local 'imenu-create-index-function
- 'org-imenu-get-tree)
+ (setq-local imenu-create-index-function 'org-imenu-get-tree)
;; Make isearch reveal context
- (if (or (featurep 'xemacs)
- (not (boundp 'outline-isearch-open-invisible-function)))
- ;; Emacs 21 and XEmacs make use of the hook
- (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local)
- ;; Emacs 22 deals with this through a special variable
- (org-set-local 'outline-isearch-open-invisible-function
- (lambda (&rest ignore) (org-show-context 'isearch))))
+ (setq-local outline-isearch-open-invisible-function
+ (lambda (&rest _) (org-show-context 'isearch)))
;; Setup the pcomplete hooks
- (set (make-local-variable 'pcomplete-command-completion-function)
- 'org-pcomplete-initial)
- (set (make-local-variable 'pcomplete-command-name-function)
- 'org-command-at-point)
- (set (make-local-variable 'pcomplete-default-completion-function)
- 'ignore)
- (set (make-local-variable 'pcomplete-parse-arguments-function)
- 'org-parse-arguments)
- (set (make-local-variable 'pcomplete-termination-string) "")
- (when (>= emacs-major-version 23)
- (set (make-local-variable 'buffer-face-mode-face) 'org-default))
-
- ;; If empty file that did not turn on org-mode automatically, make it to.
- (if (and org-insert-mode-line-in-empty-file
- (org-called-interactively-p 'any)
- (= (point-min) (point-max)))
- (insert "# -*- mode: org -*-\n\n"))
+ (setq-local pcomplete-command-completion-function 'org-pcomplete-initial)
+ (setq-local pcomplete-command-name-function 'org-command-at-point)
+ (setq-local pcomplete-default-completion-function 'ignore)
+ (setq-local pcomplete-parse-arguments-function 'org-parse-arguments)
+ (setq-local pcomplete-termination-string "")
+ (setq-local buffer-face-mode-face 'org-default)
+
+ ;; If empty file that did not turn on Org mode automatically, make
+ ;; it to.
+ (when (and org-insert-mode-line-in-empty-file
+ (called-interactively-p 'any)
+ (= (point-min) (point-max)))
+ (insert "# -*- mode: org -*-\n\n"))
(unless org-inhibit-startup
(org-unmodified
- (and org-startup-with-beamer-mode (org-beamer-mode))
+ (when org-startup-with-beamer-mode (org-beamer-mode))
(when org-startup-align-all-tables
- (org-table-map-tables 'org-table-align 'quietly))
- (when org-startup-with-inline-images
- (org-display-inline-images))
- (when org-startup-with-latex-preview
- (org-preview-latex-fragment))
- (unless org-inhibit-startup-visibility-stuff
- (org-set-startup-visibility))))
- ;; Try to set org-hide correctly
+ (org-table-map-tables #'org-table-align t))
+ (when org-startup-with-inline-images (org-display-inline-images))
+ (when org-startup-with-latex-preview (org-toggle-latex-fragment '(16)))
+ (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility))
+ (when org-startup-truncated (setq truncate-lines t))
+ (when org-startup-indented (require 'org-indent) (org-indent-mode 1))
+ (org-refresh-effort-properties)))
+ ;; Try to set `org-hide' face correctly.
(let ((foreground (org-find-invisible-foreground)))
- (if foreground
- (set-face-foreground 'org-hide foreground))))
+ (when foreground
+ (set-face-foreground 'org-hide foreground))))
;; Update `customize-package-emacs-version-alist'
(add-to-list 'customize-package-emacs-version-alist
- '(Org ("6.21b" . "23.1") ("6.33x" . "23.2")
- ("7.8.11" . "24.1") ("7.9.4" . "24.3")
- ("8.2.6" . "24.4")))
+ '(Org ("8.0" . "24.4")
+ ("8.1" . "24.4")
+ ("8.2" . "24.4")
+ ("8.2.7" . "24.4")
+ ("8.3" . "26.1")
+ ("9.0" . "26.1")
+ ("9.1" . "26.1")))
(defvar org-mode-transpose-word-syntax-table
- (let ((st (make-syntax-table)))
- (mapc (lambda(c) (modify-syntax-entry
- (string-to-char (car c)) "w p" st))
- org-emphasis-alist)
- st))
+ (let ((st (make-syntax-table text-mode-syntax-table)))
+ (dolist (c org-emphasis-alist st)
+ (modify-syntax-entry (string-to-char (car c)) "w p" st))))
(when (fboundp 'abbrev-table-put)
(abbrev-table-put org-mode-abbrev-table
:parents (list text-mode-abbrev-table)))
-(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
-
(defun org-find-invisible-foreground ()
(let ((candidates (remove
"unspecified-bg"
@@ -5498,7 +5581,7 @@ The following commands are available:
(mapcar
(lambda (alist)
(when (boundp alist)
- (cdr (assoc 'background-color (symbol-value alist)))))
+ (cdr (assq 'background-color (symbol-value alist)))))
'(default-frame-alist initial-frame-alist window-system-default-frame-alist))
(list (face-foreground 'org-hide))))))
(car (remove nil candidates))))
@@ -5541,8 +5624,6 @@ the rounding returns a past time."
(require 'font-lock)
(defconst org-non-link-chars "]\t\n\r<>")
-(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news"
- "shell" "elisp" "doi" "message"))
(defvar org-link-types-re nil
"Matches a link that has a url-like prefix like \"http:\"")
(defvar org-link-re-with-space nil
@@ -5591,27 +5672,26 @@ stacked delimiters is N. Escaping delimiters is not possible."
next (concat "\\(?:" nothing left next right "\\)+" nothing)))
(concat left "\\(" re "\\)" right)))
-(defvar org-match-substring-regexp
+(defconst org-match-substring-regexp
(concat
"\\(\\S-\\)\\([_^]\\)\\("
- "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
+ "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
"\\|"
- "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
+ "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)"
"\\|"
- "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)")
+ "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)")
"The regular expression matching a sub- or superscript.")
-(defvar org-match-substring-with-braces-regexp
+(defconst org-match-substring-with-braces-regexp
(concat
- "\\(\\S-\\)\\([_^]\\)\\("
- "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)"
- "\\)")
+ "\\(\\S-\\)\\([_^]\\)"
+ "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)")
"The regular expression matching a sub- or superscript, forcing braces.")
(defun org-make-link-regexps ()
"Update the link regular expressions.
-This should be called after the variable `org-link-types' has changed."
- (let ((types-re (regexp-opt org-link-types t)))
+This should be called after the variable `org-link-parameters' has changed."
+ (let ((types-re (regexp-opt (org-link-types) t)))
(setq org-link-types-re
(concat "\\`" types-re ":")
org-link-re-with-space
@@ -5629,14 +5709,12 @@ This should be called after the variable `org-link-types' has changed."
"\\([^" org-non-link-chars " ]"
"[^\t\n\r]*\\)")
org-angle-link-re
- (concat "<" types-re ":"
- "\\([^" org-non-link-chars " ]"
- "[^" org-non-link-chars "]*"
- "\\)>")
+ (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>"
+ types-re)
org-plain-link-re
(concat
"\\<" types-re ":"
- (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)"))
+ "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")
;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)")
org-bracket-link-regexp
"\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]"
@@ -5651,7 +5729,7 @@ This should be called after the variable `org-link-types' has changed."
org-bracket-link-analytic-regexp++
(concat
"\\[\\["
- "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?"
+ "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?"
"\\([^]]+\\)"
"\\]"
"\\(\\[" "\\([^]]+\\)" "\\]\\)?"
@@ -5663,67 +5741,53 @@ This should be called after the variable `org-link-types' has changed."
(org-make-link-regexps)
-(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-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.")
-
(defvar org-emph-face nil)
(defun org-do-emphasis-faces (limit)
- "Run through the buffer and add overlays to emphasized strings."
- (let (rtn a)
- (while (and (not rtn) (re-search-forward org-emph-re limit t))
- (let* ((border (char-after (match-beginning 3)))
- (bre (regexp-quote (char-to-string border))))
- (if (and (not (= border (char-after (match-beginning 4))))
- (not (save-match-data
- (string-match (concat bre ".*" bre)
- (replace-regexp-in-string
- "\n" " "
- (substring (match-string 2) 1 -1))))))
- (progn
- (setq rtn t)
- (setq a (assoc (match-string 3) org-emphasis-alist))
- (font-lock-prepend-text-property (match-beginning 2) (match-end 2)
- 'face
- (nth 1 a))
- (and (nth 2 a)
- (org-remove-flyspell-overlays-in
- (match-beginning 0) (match-end 0)))
+ "Run through the buffer and emphasize strings."
+ (let ((quick-re (format "\\([%s]\\|^\\)\\([~=*/_+]\\)"
+ (car org-emphasis-regexp-components))))
+ (catch :exit
+ (while (re-search-forward quick-re limit t)
+ (let* ((marker (match-string 2))
+ (verbatim? (member marker '("~" "="))))
+ (when (save-excursion
+ (goto-char (match-beginning 0))
+ (and
+ ;; Do not match table hlines.
+ (not (and (equal marker "+")
+ (org-match-line
+ "[ \t]*\\(|[-+]+|?\\|\\+[-+]+\\+\\)[ \t]*$")))
+ ;; Do not match headline stars. Do not consider
+ ;; stars of a headline as closing marker for bold
+ ;; markup either.
+ (not (and (equal marker "*")
+ (save-excursion
+ (forward-char)
+ (skip-chars-backward "*")
+ (looking-at-p org-outline-regexp-bol))))
+ ;; Match full emphasis markup regexp.
+ (looking-at (if verbatim? org-verbatim-re org-emph-re))
+ ;; Do not span over paragraph boundaries.
+ (not (string-match-p org-element-paragraph-separate
+ (match-string 2)))
+ ;; 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)))
+ (font-lock-prepend-text-property
+ (match-beginning 2) (match-end 2) 'face face)
+ (when verbatim?
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0) (match-end 0)))
(add-text-properties (match-beginning 2) (match-end 2)
'(font-lock-multiline t org-emphasis t))
(when org-hide-emphasis-markers
(add-text-properties (match-end 4) (match-beginning 5)
'(invisible org-link))
(add-text-properties (match-beginning 3) (match-end 3)
- '(invisible org-link))))))
- (goto-char (1+ (match-beginning 0))))
- rtn))
+ '(invisible org-link)))
+ (throw :exit t))))))))
(defun org-emphasize (&optional char)
"Insert or change an emphasis, i.e. a font like bold or italic.
@@ -5736,19 +5800,20 @@ If CHAR is not given (for example in an interactive call) it will be
prompted for."
(interactive)
(let ((erc org-emphasis-regexp-components)
- (prompt "")
- (string "") beg end move c s)
+ (string "") beg end move s)
(if (org-region-active-p)
- (setq beg (region-beginning) end (region-end)
+ (setq beg (region-beginning)
+ end (region-end)
string (buffer-substring beg end))
(setq move t))
(unless char
(message "Emphasis marker or tag: [%s]"
- (mapconcat (lambda(e) (car e)) org-emphasis-alist ""))
+ (mapconcat #'car org-emphasis-alist ""))
(setq char (read-char-exclusive)))
- (if (equal char ?\ )
- (setq s "" move nil)
+ (if (equal char ?\s)
+ (setq s ""
+ move nil)
(unless (assoc (char-to-string char) org-emphasis-alist)
(user-error "No such emphasis marker: \"%c\"" char))
(setq s (char-to-string char)))
@@ -5757,7 +5822,7 @@ prompted for."
(assoc (substring string 0 1) org-emphasis-alist))
(setq string (substring string 1 -1)))
(setq string (concat s string s))
- (if beg (delete-region beg end))
+ (when beg (delete-region beg end))
(unless (or (bolp)
(string-match (concat "[" (nth 0 erc) "\n]")
(char-to-string (char-before (point)))))
@@ -5775,37 +5840,86 @@ prompted for."
(defsubst org-rear-nonsticky-at (pos)
(add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props)))
-(defun org-activate-plain-links (limit)
- "Run through the buffer and add overlays to links."
- (let (f hl)
- (when (and (re-search-forward (concat org-plain-link-re) limit t)
- (not (org-in-src-block-p)))
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (setq f (get-text-property (match-beginning 0) 'face))
- (setq hl (org-match-string-no-properties 0))
- (if (or (eq f 'org-tag)
- (and (listp f) (memq 'org-tag f)))
- nil
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'face 'org-link
- 'htmlize-link `(:uri ,hl)
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 0)))
- t)))
+(defun org-activate-links (limit)
+ "Add link properties to links.
+This includes angle, plain, and bracket links."
+ (catch :exit
+ (while (re-search-forward org-any-link-re limit t)
+ (let* ((start (match-beginning 0))
+ (end (match-end 0))
+ (style (cond ((eq ?< (char-after start)) 'angle)
+ ((eq ?\[ (char-after (1+ start))) 'bracket)
+ (t 'plain))))
+ (when (and (memq style org-highlight-links)
+ ;; Do not confuse plain links with tags.
+ (not (and (eq style 'plain)
+ (let ((face (get-text-property
+ (max (1- start) (point-min)) 'face)))
+ (if (consp face) (memq 'org-tag face)
+ (eq 'org-tag face))))))
+ (let* ((link-object (save-excursion
+ (goto-char start)
+ (save-match-data (org-element-link-parser))))
+ (link (org-element-property :raw-link link-object))
+ (type (org-element-property :type link-object))
+ (path (org-element-property :path link-object))
+ (properties ;for link's visible part
+ (list
+ 'face (pcase (org-link-get-parameter type :face)
+ ((and (pred functionp) face) (funcall face path))
+ ((and (pred facep) face) face)
+ ((and (pred consp) face) face) ;anonymous
+ (_ 'org-link))
+ 'mouse-face (or (org-link-get-parameter type :mouse-face)
+ 'highlight)
+ 'keymap (or (org-link-get-parameter type :keymap)
+ org-mouse-map)
+ 'help-echo (pcase (org-link-get-parameter type :help-echo)
+ ((and (pred stringp) echo) echo)
+ ((and (pred functionp) echo) echo)
+ (_ (concat "LINK: " link)))
+ 'htmlize-link (pcase (org-link-get-parameter type
+ :htmlize-link)
+ ((and (pred functionp) f) (funcall f))
+ (_ `(:uri ,link)))
+ 'font-lock-multiline t)))
+ (org-remove-flyspell-overlays-in start end)
+ (org-rear-nonsticky-at end)
+ (if (not (eq 'bracket style))
+ (add-text-properties start end properties)
+ ;; Handle invisible parts in bracket links.
+ (remove-text-properties start end '(invisible nil))
+ (let ((hidden
+ (append `(invisible
+ ,(or (org-link-get-parameter type :display)
+ 'org-link))
+ properties))
+ (visible-start (or (match-beginning 4) (match-beginning 2)))
+ (visible-end (or (match-end 4) (match-end 2))))
+ (add-text-properties start visible-start hidden)
+ (add-text-properties visible-start visible-end properties)
+ (add-text-properties visible-end end hidden)
+ (org-rear-nonsticky-at visible-start)
+ (org-rear-nonsticky-at visible-end)))
+ (let ((f (org-link-get-parameter type :activate-func)))
+ (when (functionp f)
+ (funcall f start end path (eq style 'bracket))))
+ (throw :exit t))))) ;signal success
+ nil))
(defun org-activate-code (limit)
- (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
- (progn
- (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))
- t)))
+ (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t)
+ (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))
+ t))
-(defcustom org-src-fontify-natively nil
- "When non-nil, fontify code in code blocks."
+(defcustom org-src-fontify-natively t
+ "When non-nil, fontify code in code blocks.
+See also the `org-block' face."
:type 'boolean
- :version "24.1"
+ :version "26.1"
+ :package-version '(Org . "8.3")
:group 'org-appearance
:group 'org-babel)
@@ -5820,221 +5934,249 @@ by a #."
(defun org-fontify-meta-lines-and-blocks (limit)
(condition-case nil
(org-fontify-meta-lines-and-blocks-1 limit)
- (error (message "org-mode fontification error"))))
+ (error (message "org-mode fontification error in %S at %d"
+ (current-buffer)
+ (line-number-at-pos)))))
(defun org-fontify-meta-lines-and-blocks-1 (limit)
"Fontify #+ lines and blocks."
(let ((case-fold-search t))
- (if (re-search-forward
- "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
- limit t)
- (let ((beg (match-beginning 0))
- (block-start (match-end 0))
- (block-end nil)
- (lang (match-string 7))
- (beg1 (line-beginning-position 2))
- (dc1 (downcase (match-string 2)))
- (dc3 (downcase (match-string 3)))
- end end1 quoting block-type ovl)
- (cond
- ((member dc1 '("+html:" "+ascii:" "+latex:"))
- ;; a single line of backend-specific content
- (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))
- (add-text-properties (match-beginning 1) (match-end 3)
- '(font-lock-fontified t face org-meta-line))
- (add-text-properties (match-beginning 6) (+ (match-end 6) 1)
- '(font-lock-fontified t face org-block))
- ; for backend-specific code
- t)
- ((and (match-end 4) (equal dc3 "+begin"))
- ;; Truly a block
- (setq block-type (downcase (match-string 5))
- 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
- (setq end (min (point-max) (match-end 0))
- end1 (min (point-max) (1- (match-beginning 0))))
- (setq block-end (match-beginning 0))
- (when quoting
- (remove-text-properties beg end
- '(display t invisible t intangible t)))
- (add-text-properties
- beg end
- '(font-lock-fontified t font-lock-multiline t))
- (add-text-properties beg beg1 '(face org-meta-line))
- (add-text-properties end1 (min (point-max) (1+ end))
- '(face org-meta-line)) ; for end_src
- (cond
- ((and lang (not (string= lang "")) org-src-fontify-natively)
- (org-src-font-lock-fontify-block lang block-start block-end)
- ;; remove old background overlays
- (mapc (lambda (ov)
- (if (eq (overlay-get ov 'face) 'org-block-background)
- (delete-overlay ov)))
- (overlays-at (/ (+ beg1 block-end) 2)))
- ;; add a background overlay
- (setq ovl (make-overlay beg1 block-end))
- (overlay-put ovl 'face 'org-block-background)
- (overlay-put ovl 'evaporate t)) ;; make it go away when empty
- (quoting
- (add-text-properties beg1 (min (point-max) (1+ end1))
- '(face org-block))) ; end of source block
- ((not org-fontify-quote-and-verse-blocks))
- ((string= block-type "quote")
- (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote)))
- ((string= block-type "verse")
- (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse))))
- (add-text-properties beg beg1 '(face org-block-begin-line))
- (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
- '(face org-block-end-line))
- t))
- ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
- (add-text-properties
- beg (match-end 3)
- (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
- '(font-lock-fontified t invisible t)
- '(font-lock-fontified t face org-document-info-keyword)))
- (add-text-properties
- (match-beginning 6) (min (point-max) (1+ (match-end 6)))
- (if (string-equal dc1 "+title:")
- '(font-lock-fontified t face org-document-title)
- '(font-lock-fontified t face org-document-info))))
- ((or (equal dc1 "+results")
- (member dc1 '("+begin:" "+end:" "+caption:" "+label:"
- "+orgtbl:" "+tblfm:" "+tblname:" "+results:"
- "+call:" "+header:" "+headers:" "+name:"))
- (and (match-end 4) (equal dc3 "+attr")))
- (add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
- t)
- ((member dc3 '(" " ""))
- (add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face font-lock-comment-face)))
- ((not (member (char-after beg) '(?\ ?\t)))
- ;; just any other in-buffer setting, but not indented
+ (when (re-search-forward
+ "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
+ limit t)
+ (let ((beg (match-beginning 0))
+ (block-start (match-end 0))
+ (block-end nil)
+ (lang (match-string 7))
+ (beg1 (line-beginning-position 2))
+ (dc1 (downcase (match-string 2)))
+ (dc3 (downcase (match-string 3)))
+ end end1 quoting block-type)
+ (cond
+ ((and (match-end 4) (equal dc3 "+begin"))
+ ;; Truly a block
+ (setq block-type (downcase (match-string 5))
+ 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
+ (setq end (min (point-max) (match-end 0))
+ end1 (min (point-max) (1- (match-beginning 0))))
+ (setq block-end (match-beginning 0))
+ (when quoting
+ (org-remove-flyspell-overlays-in beg1 end1)
+ (remove-text-properties beg end
+ '(display t invisible t intangible t)))
(add-text-properties
- beg (match-end 0)
- '(font-lock-fontified t face org-meta-line))
- t)
- (t nil))))))
-
-(defun org-activate-angle-links (limit)
- "Run through the buffer and add overlays to links."
- (if (and (re-search-forward org-angle-link-re limit t)
- (not (org-in-src-block-p)))
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 0))
- t)))
+ beg end '(font-lock-fontified t font-lock-multiline t))
+ (add-text-properties beg beg1 '(face org-meta-line))
+ (org-remove-flyspell-overlays-in beg beg1)
+ (add-text-properties ; For end_src
+ end1 (min (point-max) (1+ end)) '(face org-meta-line))
+ (org-remove-flyspell-overlays-in end1 end)
+ (cond
+ ((and lang (not (string= lang "")) org-src-fontify-natively)
+ (org-src-font-lock-fontify-block lang block-start block-end)
+ (add-text-properties beg1 block-end '(src-block t)))
+ (quoting
+ (add-text-properties beg1 (min (point-max) (1+ end1))
+ (list 'face
+ (list :inherit
+ (let ((face-name
+ (intern (format "org-block-%s" lang))))
+ (append (and (facep face-name) (list face-name))
+ '(org-block))))))) ; end of source block
+ ((not org-fontify-quote-and-verse-blocks))
+ ((string= block-type "quote")
+ (add-face-text-property
+ beg1 (min (point-max) (1+ end1)) 'org-quote t))
+ ((string= block-type "verse")
+ (add-face-text-property
+ beg1 (min (point-max) (1+ end1)) 'org-verse t)))
+ (add-text-properties beg beg1 '(face org-block-begin-line))
+ (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1))
+ '(face org-block-end-line))
+ t))
+ ((member dc1 '("+title:" "+author:" "+email:" "+date:"))
+ (org-remove-flyspell-overlays-in
+ (match-beginning 0)
+ (if (equal "+title:" dc1) (match-end 2) (match-end 0)))
+ (add-text-properties
+ beg (match-end 3)
+ (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
+ '(font-lock-fontified t invisible t)
+ '(font-lock-fontified t face org-document-info-keyword)))
+ (add-text-properties
+ (match-beginning 6) (min (point-max) (1+ (match-end 6)))
+ (if (string-equal dc1 "+title:")
+ '(font-lock-fontified t face org-document-title)
+ '(font-lock-fontified t face org-document-info))))
+ ((string-prefix-p "+caption" dc1)
+ (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.
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \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 '(" " ""))
+ (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
+ (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))
+ (add-text-properties beg (match-end 0)
+ '(font-lock-fontified t face org-meta-line))
+ t))))))
+
+(defun org-fontify-drawers (limit)
+ "Fontify drawers."
+ (when (re-search-forward org-drawer-regexp limit t)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ '(font-lock-fontified t face org-special-keyword))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ t))
+
+(defun org-fontify-macros (limit)
+ "Fontify macros."
+ (when (re-search-forward "\\({{{\\).+?\\(}}}\\)" limit t)
+ (add-text-properties
+ (match-beginning 0) (match-end 0)
+ '(font-lock-fontified t face org-macro))
+ (when org-hide-macro-markers
+ (add-text-properties (match-end 2) (match-beginning 2)
+ '(invisible t))
+ (add-text-properties (match-beginning 1) (match-end 1)
+ '(invisible t)))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ t))
(defun org-activate-footnote-links (limit)
- "Run through the buffer and add overlays to footnotes."
+ "Add text properties for footnotes."
(let ((fn (org-footnote-next-reference-or-definition limit)))
(when fn
- (let ((beg (nth 1 fn)) (end (nth 2 fn)))
- (org-remove-flyspell-overlays-in beg end)
+ (let* ((beg (nth 1 fn))
+ (end (nth 2 fn))
+ (label (car fn))
+ (referencep (/= (line-beginning-position) beg)))
+ (when (and referencep (nth 3 fn))
+ (save-excursion
+ (goto-char beg)
+ (search-forward (or label "fn:"))
+ (org-remove-flyspell-overlays-in beg (match-end 0))))
(add-text-properties beg end
(list 'mouse-face 'highlight
'keymap org-mouse-map
'help-echo
- (if (= (point-at-bol) beg)
- "Footnote definition"
- "Footnote reference")
+ (if referencep "Footnote reference"
+ "Footnote definition")
'font-lock-fontified t
'font-lock-multiline t
'face 'org-footnote))))))
-(defun org-activate-bracket-links (limit)
- "Run through the buffer and add overlays to bracketed links."
- (if (and (re-search-forward org-bracket-link-regexp limit t)
- (not (org-in-src-block-p)))
- (let* ((hl (org-match-string-no-properties 1))
- (help (concat "LINK: " (save-match-data (org-link-unescape hl))))
- (ip (org-maybe-intangible
- (list 'invisible 'org-link
- 'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help
- 'htmlize-link `(:uri ,hl))))
- (vp (list 'keymap org-mouse-map 'mouse-face 'highlight
- 'font-lock-multiline t 'help-echo help
- 'htmlize-link `(:uri ,hl))))
- ;; We need to remove the invisible property here. Table narrowing
- ;; may have made some of this invisible.
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (remove-text-properties (match-beginning 0) (match-end 0)
- '(invisible nil))
- (if (match-end 3)
- (progn
- (add-text-properties (match-beginning 0) (match-beginning 3) ip)
- (org-rear-nonsticky-at (match-beginning 3))
- (add-text-properties (match-beginning 3) (match-end 3) vp)
- (org-rear-nonsticky-at (match-end 3))
- (add-text-properties (match-end 3) (match-end 0) ip)
- (org-rear-nonsticky-at (match-end 0)))
- (add-text-properties (match-beginning 0) (match-beginning 1) ip)
- (org-rear-nonsticky-at (match-beginning 1))
- (add-text-properties (match-beginning 1) (match-end 1) vp)
- (org-rear-nonsticky-at (match-end 1))
- (add-text-properties (match-end 1) (match-end 0) ip)
- (org-rear-nonsticky-at (match-end 0)))
- t)))
-
(defun org-activate-dates (limit)
- "Run through the buffer and add overlays to dates."
- (if (and (re-search-forward org-tsr-regexp-both limit t)
- (not (equal (char-before (match-beginning 0)) 91)))
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 0))
- (when org-display-custom-times
- (if (match-end 3)
- (org-display-custom-time (match-beginning 3) (match-end 3)))
- (org-display-custom-time (match-beginning 1) (match-end 1)))
- t)))
-
-(defvar org-target-link-regexp nil
+ "Add text properties for dates."
+ (when (and (re-search-forward org-tsr-regexp-both limit t)
+ (not (equal (char-before (match-beginning 0)) 91)))
+ (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
+ (add-text-properties (match-beginning 0) (match-end 0)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 0))
+ (when org-display-custom-times
+ ;; If it's a date range, activate custom time for second date.
+ (when (match-end 3)
+ (org-display-custom-time (match-beginning 3) (match-end 3)))
+ (org-display-custom-time (match-beginning 1) (match-end 1)))
+ t))
+
+(defvar-local org-target-link-regexp nil
"Regular expression matching radio targets in plain text.")
-(make-variable-buffer-local 'org-target-link-regexp)
-(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>"
+
+(defconst org-target-regexp (let ((border "[^<>\n\r \t]"))
+ (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>"
+ border border border))
"Regular expression matching a link target.")
-(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>"
+
+(defconst org-radio-target-regexp (format "<%s>" org-target-regexp)
"Regular expression matching a radio target.")
-(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target.
+
+(defconst org-any-target-regexp
+ (format "%s\\|%s" org-radio-target-regexp org-target-regexp)
"Regular expression matching any target.")
(defun org-activate-target-links (limit)
- "Run through the buffer and add overlays to target matches."
+ "Add text properties for target matches."
(when org-target-link-regexp
(let ((case-fold-search t))
- (if (re-search-forward org-target-link-regexp limit t)
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))
- (add-text-properties (match-beginning 0) (match-end 0)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map
- 'help-echo "Radio target link"
- 'org-linked-text t))
- (org-rear-nonsticky-at (match-end 0))
- t)))))
+ (when (re-search-forward org-target-link-regexp limit t)
+ (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
+ (add-text-properties (match-beginning 1) (match-end 1)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map
+ 'help-echo "Radio target link"
+ 'org-linked-text t))
+ (org-rear-nonsticky-at (match-end 1))
+ t))))
(defun org-update-radio-target-regexp ()
- "Find all radio targets in this file and update the regular expression."
+ "Find all radio targets in this file and update the regular expression.
+Also refresh fontification if needed."
(interactive)
- (when (memq 'radio org-activate-links)
+ (let ((old-regexp org-target-link-regexp)
+ (before-re "\\(?:^\\|[^[:alnum:]]\\)\\(")
+ (after-re "\\)\\(?:$\\|[^[:alnum:]]\\)")
+ (targets
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (rtn)
+ (while (re-search-forward org-radio-target-regexp nil t)
+ ;; Make sure point is really within the object.
+ (backward-char)
+ (let ((obj (org-element-context)))
+ (when (eq (org-element-type obj) 'radio-target)
+ (cl-pushnew (org-element-property :value obj) rtn
+ :test #'equal))))
+ rtn))))
(setq org-target-link-regexp
- (org-make-target-link-regexp (org-all-targets 'radio)))
- (org-restart-font-lock)))
+ (and targets
+ (concat before-re
+ (mapconcat
+ (lambda (x)
+ (replace-regexp-in-string
+ " +" "\\s-+" (regexp-quote x) t t))
+ targets
+ "\\|")
+ after-re)))
+ (unless (equal old-regexp org-target-link-regexp)
+ ;; Clean-up cache.
+ (let ((regexp (cond ((not old-regexp) org-target-link-regexp)
+ ((not org-target-link-regexp) old-regexp)
+ (t
+ (concat before-re
+ (mapconcat
+ (lambda (re)
+ (substring re (length before-re)
+ (- (length after-re))))
+ (list old-regexp org-target-link-regexp)
+ "\\|")
+ after-re)))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (org-element-cache-refresh (match-beginning 1)))))
+ ;; Re fontify buffer.
+ (when (memq 'radio org-highlight-links)
+ (org-restart-font-lock)))))
(defun org-hide-wide-columns (limit)
(let (s e)
@@ -6042,20 +6184,18 @@ by a #."
'org-cwidth t))
(when s
(setq e (next-single-property-change s 'org-cwidth))
- (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth)))
+ (add-text-properties s e '(invisible org-cwidth))
(goto-char e)
t)))
(defvar org-latex-and-related-regexp nil
"Regular expression for highlighting LaTeX, entities and sub/superscript.")
-(defvar org-match-substring-regexp)
-(defvar org-match-substring-with-braces-regexp)
(defun org-compute-latex-and-related-regexp ()
"Compute regular expression for LaTeX, entities and sub/superscript.
Result depends on variable `org-highlight-latex-and-related'."
- (org-set-local
- 'org-latex-and-related-regexp
+ (setq-local
+ org-latex-and-related-regexp
(let* ((re-sub
(cond ((not (memq 'script org-highlight-latex-and-related)) nil)
((eq org-use-sub-superscripts '{})
@@ -6081,9 +6221,13 @@ done, nil otherwise."
(when (org-string-nw-p org-latex-and-related-regexp)
(catch 'found
(while (re-search-forward org-latex-and-related-regexp limit t)
- (unless (memq (car-safe (get-text-property (1+ (match-beginning 0))
- 'face))
- '(org-code org-verbatim underline))
+ (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
@@ -6102,63 +6246,32 @@ done, nil otherwise."
(font-lock-mode -1)
(font-lock-mode 1)))
-(defun org-all-targets (&optional radio)
- "Return a list of all targets in this file.
-When optional argument RADIO is non-nil, only find radio
-targets."
- (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- ;; Make sure point is really within the object.
- (backward-char)
- (let ((obj (org-element-context)))
- (when (memq (org-element-type obj) '(radio-target target))
- (add-to-list 'rtn (downcase (org-element-property :value obj))))))
- rtn)))
-
-(defun org-make-target-link-regexp (targets)
- "Make regular expression matching all strings in TARGETS.
-The regular expression finds the targets also if there is a line break
-between words."
- (and targets
- (concat
- "\\_<\\("
- (mapconcat
- (lambda (x)
- (setq x (regexp-quote x))
- (while (string-match " +" x)
- (setq x (replace-match "\\s-+" t t x)))
- x)
- targets
- "\\|")
- "\\)\\_>")))
-
(defun org-activate-tags (limit)
- (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t)
- (progn
- (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
- (add-text-properties (match-beginning 1) (match-end 1)
- (list 'mouse-face 'highlight
- 'keymap org-mouse-map))
- (org-rear-nonsticky-at (match-end 1))
- t)))
+ (when (re-search-forward
+ "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t)
+ (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1))
+ (add-text-properties (match-beginning 1) (match-end 1)
+ (list 'mouse-face 'highlight
+ 'keymap org-mouse-map))
+ (org-rear-nonsticky-at (match-end 1))
+ t))
(defun org-outline-level ()
"Compute the outline level of the heading at point.
-If this is called at a normal headline, the level is the number of stars.
-Use `org-reduced-level' to remove the effect of `org-odd-levels'."
- (save-excursion
- (if (not (condition-case nil
- (org-back-to-heading t)
- (error nil)))
- 0
- (looking-at org-outline-regexp)
- (1- (- (match-end 0) (match-beginning 0))))))
+
+If this is called at a normal headline, the level is the number
+of stars. Use `org-reduced-level' to remove the effect of
+`org-odd-levels'. Unlike to `org-current-level', this function
+takes into consideration inlinetasks."
+ (org-with-wide-buffer
+ (end-of-line)
+ (if (re-search-backward org-outline-regexp-bol nil t)
+ (1- (- (match-end 0) (match-beginning 0)))
+ 0)))
(defvar org-font-lock-keywords nil)
-(defsubst org-re-property (property &optional literal allow-null)
+(defsubst org-re-property (property &optional literal allow-null value)
"Return a regexp matching a PROPERTY line.
When optional argument LITERAL is non-nil, do not quote PROPERTY.
@@ -6166,17 +6279,25 @@ This is useful when PROPERTY is a regexp. When ALLOW-NULL is
non-nil, match properties even without a value.
Match group 3 is set to the value when it exists. If there is no
-value and ALLOW-NULL is non-nil, it is set to the empty string."
+value and ALLOW-NULL is non-nil, it is set to the empty string.
+
+With optional argument VALUE, match only property lines with
+that value; in this case, ALLOW-NULL is ignored. VALUE is quoted
+unless LITERAL is non-nil."
(concat
"^\\(?4:[ \t]*\\)"
(format "\\(?1::\\(?2:%s\\):\\)"
(if literal property (regexp-quote property)))
- (if allow-null
- "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$"
- "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$")))
+ (cond (value
+ (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$"
+ (if literal value (regexp-quote value))))
+ (allow-null
+ "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$")
+ (t
+ "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))))
(defconst org-property-re
- (org-re-property ".*?" 'literal t)
+ (org-re-property "\\S-+" 'literal t)
"Regular expression matching a property line.
There are four matching groups:
1: :PROPKEY: including the leading and trailing colon,
@@ -6188,6 +6309,8 @@ There are four matching groups:
(defvar org-font-lock-hook nil
"Functions to be called for special font lock stuff.")
+(defvar org-font-lock-extra-keywords nil) ;Dynamically scoped.
+
(defvar org-font-lock-set-keywords-hook nil
"Functions that can manipulate `org-font-lock-extra-keywords'.
This is called after `org-font-lock-extra-keywords' is defined, but before
@@ -6201,7 +6324,7 @@ needs to be inserted at a specific position in the font-lock sequence.")
(defun org-set-font-lock-defaults ()
"Set font lock defaults for the current buffer."
(let* ((em org-fontify-emphasized-text)
- (lk org-activate-links)
+ (lk org-highlight-links)
(org-font-lock-extra-keywords
(list
;; Call the hook
@@ -6222,26 +6345,23 @@ needs to be inserted at a specific position in the font-lock sequence.")
'("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t))
'("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t))
;; Drawers
- (list org-drawer-regexp '(0 'org-special-keyword t))
- (list "^[ \t]*:END:" '(0 'org-special-keyword t))
+ '(org-fontify-drawers)
;; Properties
(list org-property-re
'(1 'org-special-keyword t)
'(3 'org-property-value t))
- ;; Links
- (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
- (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t)))
- (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t)))
- (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t)))
- (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t)))
- (if (memq 'date lk) '(org-activate-dates (0 'org-date t)))
- (if (memq 'footnote lk) '(org-activate-footnote-links))
+ ;; Link related fontification.
+ '(org-activate-links)
+ (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend)))
+ (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t)))
+ (when (memq 'date lk) '(org-activate-dates (0 'org-date t)))
+ (when (memq 'footnote lk) '(org-activate-footnote-links))
;; Targets.
(list org-any-target-regexp '(0 'org-target t))
;; Diary sexps.
'("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t))
;; Macro
- '("{{{.+}}}" (0 'org-macro t))
+ '(org-fontify-macros)
'(org-hide-wide-columns (0 nil append))
;; TODO keyword
(list (format org-heading-keyword-regexp-format
@@ -6261,27 +6381,24 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Tags
'(org-font-lock-add-tag-faces)
;; Tags groups
- (if (and org-group-tags org-tag-groups-alist)
- (list (concat org-outline-regexp-bol ".+\\(:"
- (regexp-opt (mapcar 'car org-tag-groups-alist))
- ":\\).*$")
- '(1 'org-tag-group prepend)))
+ (when (and org-group-tags org-tag-groups-alist)
+ (list (concat org-outline-regexp-bol ".+\\(:"
+ (regexp-opt (mapcar 'car org-tag-groups-alist))
+ ":\\).*$")
+ '(1 'org-tag-group prepend)))
;; Special keywords
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-closed-string) '(0 'org-special-keyword t))
(list (concat "\\<" org-clock-string) '(0 'org-special-keyword t))
;; Emphasis
- (if em
- (if (featurep 'xemacs)
- '(org-do-emphasis-faces (0 nil append))
- '(org-do-emphasis-faces)))
+ (when em '(org-do-emphasis-faces))
;; Checkboxes
'("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)"
1 'org-checkbox prepend)
- (if (cdr (assq 'checkbox org-list-automatic-rules))
- '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
- (0 (org-get-checkbox-statistics-face) t)))
+ (when (cdr (assq 'checkbox org-list-automatic-rules))
+ '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]"
+ (0 (org-get-checkbox-statistics-face) t)))
;; Description list items
'("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)"
1 'org-list-dt prepend)
@@ -6297,83 +6414,92 @@ needs to be inserted at a specific position in the font-lock sequence.")
;; Code
'(org-activate-code (1 'org-code t))
;; COMMENT
- (list (format org-heading-keyword-regexp-format
- (concat "\\("
- org-comment-string "\\|" org-quote-string
- "\\)"))
- '(2 'org-special-keyword t))
+ (list (format
+ "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)"
+ org-todo-regexp
+ org-comment-string)
+ '(9 'org-special-keyword t))
;; Blocks and meta lines
'(org-fontify-meta-lines-and-blocks))))
(setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords))
(run-hooks 'org-font-lock-set-keywords-hook)
;; Now set the full font-lock-keywords
- (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords)
- (org-set-local 'font-lock-defaults
- '(org-font-lock-keywords t nil nil backward-paragraph))
- (kill-local-variable 'font-lock-keywords) nil))
+ (setq-local org-font-lock-keywords org-font-lock-extra-keywords)
+ (setq-local font-lock-defaults
+ '(org-font-lock-keywords t nil nil backward-paragraph))
+ (kill-local-variable 'font-lock-keywords)
+ nil))
(defun org-toggle-pretty-entities ()
"Toggle the composition display of entities as UTF8 characters."
(interactive)
- (org-set-local 'org-pretty-entities (not org-pretty-entities))
+ (setq-local org-pretty-entities (not org-pretty-entities))
(org-restart-font-lock)
(if org-pretty-entities
(message "Entities are now displayed as UTF8 characters")
(save-restriction
(widen)
- (org-decompose-region (point-min) (point-max))
+ (decompose-region (point-min) (point-max))
(message "Entities are now displayed as plain text"))))
-(defvar org-custom-properties-overlays nil
+(defvar-local org-custom-properties-overlays nil
"List of overlays used for custom properties.")
-(make-variable-buffer-local 'org-custom-properties-overlays)
(defun org-toggle-custom-properties-visibility ()
"Display or hide properties in `org-custom-properties'."
(interactive)
(if org-custom-properties-overlays
- (progn (mapc 'delete-overlay org-custom-properties-overlays)
+ (progn (mapc #'delete-overlay org-custom-properties-overlays)
(setq org-custom-properties-overlays nil))
- (unless (not org-custom-properties)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward org-property-re nil t)
- (mapc (lambda(p)
- (when (equal p (substring (match-string 1) 1 -1))
- (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
- (overlay-put o 'invisible t)
- (overlay-put o 'org-custom-property t)
- (push o org-custom-properties-overlays))))
- org-custom-properties)))))))
+ (when org-custom-properties
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t)))
+ (while (re-search-forward regexp nil t)
+ (let ((end (cdr (save-match-data (org-get-property-block)))))
+ (when (and end (< (point) end))
+ ;; Hide first custom property in current drawer.
+ (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
+ (overlay-put o 'invisible t)
+ (overlay-put o 'org-custom-property t)
+ (push o org-custom-properties-overlays))
+ ;; Hide additional custom properties in the same drawer.
+ (while (re-search-forward regexp end t)
+ (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0)))))
+ (overlay-put o 'invisible t)
+ (overlay-put o 'org-custom-property t)
+ (push o org-custom-properties-overlays)))))
+ ;; Each entry is limited to a single property drawer.
+ (outline-next-heading)))))))
(defun org-fontify-entities (limit)
"Find an entity to fontify."
(let (ee)
(when org-pretty-entities
(catch 'match
+ ;; "\_ "-family is left out on purpose. Only the first one,
+ ;; i.e., "\_ ", could be fontified anyway, and it would be
+ ;; confusing when adding a second white space character.
(while (re-search-forward
"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)"
limit t)
- (if (and (not (org-in-indented-comment-line))
- (setq ee (org-entity-get (match-string 1)))
- (= (length (nth 6 ee)) 1))
- (let*
- ((end (if (equal (match-string 2) "{}")
+ (when (and (not (org-at-comment-p))
+ (setq ee (org-entity-get (match-string 1)))
+ (= (length (nth 6 ee)) 1))
+ (let* ((end (if (equal (match-string 2) "{}")
(match-end 2)
(match-end 1))))
- (add-text-properties
- (match-beginning 0) end
- (list 'font-lock-fontified t))
- (compose-region (match-beginning 0) end
- (nth 6 ee) nil)
- (backward-char 1)
- (throw 'match t))))
+ (add-text-properties
+ (match-beginning 0) end
+ (list 'font-lock-fontified t))
+ (compose-region (match-beginning 0) end
+ (nth 6 ee) nil)
+ (backward-char 1)
+ (throw 'match t))))
nil))))
(defun org-fontify-like-in-org-mode (s &optional odd-levels)
- "Fontify string S like in Org-mode."
+ "Fontify string S like in Org mode."
(with-temp-buffer
(insert s)
(let ((org-odd-levels-only odd-levels))
@@ -6387,33 +6513,55 @@ needs to be inserted at a specific position in the font-lock sequence.")
(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))
- (if org-odd-levels-only (setq org-l (1+ (/ org-l 2))))
+ (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 (if org-level-color-stars-only nil 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.
+When FACE-OR-COLOR is not a string, just return it."
+ (if (stringp face-or-color)
+ (list :inherit inherit
+ (cdr (assoc context org-faces-easy-properties))
+ face-or-color)
+ face-or-color))
(defun org-get-todo-face (kwd)
"Get the right face for a TODO keyword KWD.
If KWD is a number, get the corresponding match group."
- (if (numberp kwd) (setq kwd (match-string kwd)))
+ (when (numberp kwd) (setq kwd (match-string kwd)))
(or (org-face-from-face-or-color
'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces)))
(and (member kwd org-done-keywords) 'org-done)
'org-todo))
-(defun org-face-from-face-or-color (context inherit face-or-color)
- "Create a face list that inherits INHERIT, but sets the foreground color.
-When FACE-OR-COLOR is not a string, just return it."
- (if (stringp face-or-color)
- (list :inherit inherit
- (cdr (assoc context org-faces-easy-properties))
- face-or-color)
- face-or-color))
+(defun org-get-priority-face (priority)
+ "Get the right face for PRIORITY.
+PRIORITY is a character."
+ (or (org-face-from-face-or-color
+ 'priority 'org-priority (cdr (assq priority org-priority-faces)))
+ 'org-priority))
+
+(defun org-get-tag-face (tag)
+ "Get the right face for TAG.
+If TAG is a number, get the corresponding match group."
+ (let ((tag (if (wholenump tag) (match-string tag) tag)))
+ (or (org-face-from-face-or-color
+ 'tag 'org-tag (cdr (assoc tag org-tag-faces)))
+ 'org-tag)))
+
+(defun org-font-lock-add-priority-faces (limit)
+ "Add the special priority faces."
+ (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t)
+ (add-text-properties
+ (match-beginning 1) (match-end 1)
+ (list 'face (org-get-priority-face (string-to-char (match-string 2)))
+ 'font-lock-fontified t))))
(defun org-font-lock-add-tag-faces (limit)
"Add the special tag faces."
@@ -6424,39 +6572,18 @@ When FACE-OR-COLOR is not a string, just return it."
'font-lock-fontified t))
(backward-char 1))))
-(defun org-font-lock-add-priority-faces (limit)
- "Add the special priority faces."
- (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t)
- (when (save-match-data (org-at-heading-p))
- (add-text-properties
- (match-beginning 0) (match-end 0)
- (list 'face (or (org-face-from-face-or-color
- 'priority 'org-priority
- (cdr (assoc (char-after (match-beginning 1))
- org-priority-faces)))
- 'org-priority)
- 'font-lock-fontified t)))))
-
-(defun org-get-tag-face (kwd)
- "Get the right face for a TODO keyword KWD.
-If KWD is a number, get the corresponding match group."
- (if (numberp kwd) (setq kwd (match-string kwd)))
- (or (org-face-from-face-or-color
- 'tag 'org-tag (cdr (assoc kwd org-tag-faces)))
- 'org-tag))
-
-(defun org-unfontify-region (beg end &optional maybe_loudly)
+(defun org-unfontify-region (beg end &optional _maybe_loudly)
"Remove fontification and activation overlays from links."
(font-lock-default-unfontify-region beg end)
(let* ((buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
deactivate-mark buffer-file-name buffer-file-truename)
- (org-decompose-region beg end)
+ (decompose-region beg end)
(remove-text-properties beg end
'(mouse-face t keymap t org-linked-text t
invisible t intangible t
- org-no-flyspell t org-emphasis t))
+ org-emphasis t))
(org-remove-font-lock-display-properties beg end)))
(defconst org-script-display '(((raise -0.3) (height 0.7))
@@ -6473,59 +6600,52 @@ and subscripts."
(while (< beg end)
(setq next (next-single-property-change beg 'display nil end)
prop (get-text-property beg 'display))
- (if (member prop org-script-display)
- (put-text-property beg next 'display nil))
+ (when (member prop org-script-display)
+ (put-text-property beg next 'display nil))
(setq beg next))))
(defun org-raise-scripts (limit)
"Add raise properties to sub/superscripts."
- (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts)
- (if (re-search-forward
- (if (eq org-use-sub-superscripts t)
- org-match-substring-regexp
- org-match-substring-with-braces-regexp)
- limit t)
- (let* ((pos (point)) table-p comment-p
- (mpos (match-beginning 3))
- (emph-p (get-text-property mpos 'org-emphasis))
- (link-p (get-text-property mpos 'mouse-face))
- (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
- (goto-char (point-at-bol))
- (setq table-p (org-looking-at-p org-table-dataline-regexp)
- comment-p (org-looking-at-p "^[ \t]*#[ +]"))
- (goto-char pos)
- ;; Handle a_b^c
- (if (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
- (if (or comment-p emph-p link-p keyw-p)
- t
- (put-text-property (match-beginning 3) (match-end 0)
- 'display
- (if (equal (char-after (match-beginning 2)) ?^)
- (nth (if table-p 3 1) org-script-display)
- (nth (if table-p 2 0) org-script-display)))
- (add-text-properties (match-beginning 2) (match-end 2)
- (list 'invisible t
- 'org-dwidth t 'org-dwidth-n 1))
- (if (and (eq (char-after (match-beginning 3)) ?{)
- (eq (char-before (match-end 3)) ?}))
- (progn
- (add-text-properties
- (match-beginning 3) (1+ (match-beginning 3))
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))
- (add-text-properties
- (1- (match-end 3)) (match-end 3)
- (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))
- t)))))
+ (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts
+ (re-search-forward
+ (if (eq org-use-sub-superscripts t)
+ org-match-substring-regexp
+ org-match-substring-with-braces-regexp)
+ limit t))
+ (let* ((pos (point)) table-p comment-p
+ (mpos (match-beginning 3))
+ (emph-p (get-text-property mpos 'org-emphasis))
+ (link-p (get-text-property mpos 'mouse-face))
+ (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
+ (goto-char (point-at-bol))
+ (setq table-p (looking-at-p org-table-dataline-regexp)
+ comment-p (looking-at-p "^[ \t]*#[ +]"))
+ (goto-char pos)
+ ;; Handle a_b^c
+ (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
+ (unless (or comment-p emph-p link-p keyw-p)
+ (put-text-property (match-beginning 3) (match-end 0)
+ 'display
+ (if (equal (char-after (match-beginning 2)) ?^)
+ (nth (if table-p 3 1) org-script-display)
+ (nth (if table-p 2 0) org-script-display)))
+ (add-text-properties (match-beginning 2) (match-end 2)
+ (list 'invisible t))
+ (when (and (eq (char-after (match-beginning 3)) ?{)
+ (eq (char-before (match-end 3)) ?}))
+ (add-text-properties (match-beginning 3) (1+ (match-beginning 3))
+ (list 'invisible t))
+ (add-text-properties (1- (match-end 3)) (match-end 3)
+ (list 'invisible t))))
+ t)))
;;;; Visibility cycling, including org-goto and indirect buffer
;;; Cycling
-(defvar org-cycle-global-status nil)
-(make-variable-buffer-local 'org-cycle-global-status)
+(defvar-local org-cycle-global-status nil)
(put 'org-cycle-global-status 'org-state t)
-(defvar org-cycle-subtree-status nil)
-(make-variable-buffer-local 'org-cycle-subtree-status)
+(defvar-local org-cycle-subtree-status nil)
(put 'org-cycle-subtree-status 'org-state t)
(defvar org-inlinetask-min-level)
@@ -6537,52 +6657,58 @@ and subscripts."
;;;###autoload
(defun org-cycle (&optional arg)
- "TAB-action and visibility cycling for Org-mode.
+ "TAB-action and visibility cycling for Org mode.
-This is the command invoked in Org-mode by the TAB key. Its main purpose
-is outline visibility cycling, but it also invokes other actions
+This is the command invoked in Org mode by the `TAB' key. Its main
+purpose is outline visibility cycling, but it also invokes other actions
in special contexts.
-- When this function is called with a prefix argument, rotate the entire
- buffer through 3 states (global cycling)
+When this function is called with a `\\[universal-argument]' prefix, rotate \
+the entire
+buffer through 3 states (global cycling)
1. OVERVIEW: Show only top-level headlines.
2. CONTENTS: Show all headlines of all levels, but no body text.
3. SHOW ALL: Show everything.
- When called with two `C-u C-u' prefixes, switch to the startup visibility,
- determined by the variable `org-startup-folded', and by any VISIBILITY
- properties in the buffer.
- When called with three `C-u C-u C-u' prefixed, show the entire buffer,
- including any drawers.
-- When inside a table, re-align the table and move to the next field.
+With a `\\[universal-argument] \\[universal-argument]' prefix argument, \
+switch to the startup visibility,
+determined by the variable `org-startup-folded', and by any VISIBILITY
+properties in the buffer.
+
+With a `\\[universal-argument] \\[universal-argument] \
+\\[universal-argument]' prefix argument, show the entire buffer, including
+any drawers.
-- When point is at the beginning of a headline, rotate the subtree started
- by this line through 3 different states (local cycling)
+When inside a table, re-align the table and move to the next field.
+
+When point is at the beginning of a headline, rotate the subtree started
+by this line through 3 different states (local cycling)
1. FOLDED: Only the main headline is shown.
2. CHILDREN: The main headline and the direct children are shown.
From this state, you can move to one of the children
and zoom in further.
3. SUBTREE: Show the entire subtree, including body text.
- If there is no subtree, switch directly from CHILDREN to FOLDED.
-
-- When point is at the beginning of an empty headline and the variable
- `org-cycle-level-after-item/entry-creation' is set, cycle the level
- of the headline by demoting and promoting it to likely levels. This
- speeds up creation document structure by pressing TAB once or several
- times right after creating a new headline.
-
-- When there is a numeric prefix, go up to a heading with level ARG, do
- a `show-subtree' and return to the previous cursor position. If ARG
- is negative, go up that many levels.
-
-- 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.
-
-- 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
- (C-u TAB, same as S-TAB) also when called without prefix arg.
- But only if also the variable `org-cycle-global-at-bob' is t."
+If there is no subtree, switch directly from CHILDREN to FOLDED.
+
+When point is at the beginning of an empty headline and the variable
+`org-cycle-level-after-item/entry-creation' is set, cycle the level
+of the headline by demoting and promoting it to likely levels. This
+speeds up creation document structure by pressing `TAB' once or several
+times right after creating a new headline.
+
+When there is a numeric prefix, go up to a heading with level ARG, do
+a `show-subtree' and return to the previous cursor position. If ARG
+is negative, go up that many levels.
+
+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."
(interactive "P")
(org-load-modules-maybe)
(unless (or (run-hook-with-args-until-success 'org-tab-first-hook)
@@ -6611,10 +6737,6 @@ in special contexts.
org-cycle-hook))
(pos (point)))
- (if (or bob-special (equal arg '(4)))
- ;; special case: use global cycling
- (setq arg t))
-
(cond
((equal arg '(16))
@@ -6623,32 +6745,36 @@ in special contexts.
(org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
((equal arg '(64))
- (show-all)
+ (outline-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" "Use C-c ' to edit table.el tables")
+ (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))
+ ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook))
;; Global cycling: delegate to `org-cycle-internal-global'.
- ((eq arg t) (org-cycle-internal-global))
+ (bob-special (org-cycle-internal-global))
;; Drawers: delegate to `org-flag-drawer'.
- ((and org-drawers org-drawer-regexp
- (save-excursion
- (beginning-of-line 1)
- (looking-at org-drawer-regexp)))
- (org-flag-drawer ; toggle block visibility
+ ((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.
@@ -6667,7 +6793,7 @@ in special contexts.
;; At an item/headline: delegate to `org-cycle-internal-local'.
((and (or (and org-cycle-include-plain-lists (org-at-item-p))
- (save-excursion (beginning-of-line 1)
+ (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))
@@ -6722,7 +6848,7 @@ in special contexts.
(eq org-cycle-global-status 'contents))
;; We just showed the table of contents - now show everything
(run-hook-with-args 'org-pre-cycle-hook 'all)
- (show-all)
+ (outline-show-all)
(unless ga (org-unlogged-message "SHOW ALL"))
(setq org-cycle-global-status 'all)
(run-hook-with-args 'org-cycle-hook 'all))
@@ -6738,6 +6864,11 @@ in special contexts.
(defvar org-called-with-limited-levels nil
"Non-nil when `org-with-limited-levels' is currently active.")
+(defun org-invisible-p (&optional pos)
+ "Non-nil if the character after POS is invisible.
+If POS is nil, use `point' instead."
+ (get-char-property (or pos (point)) 'invisible))
+
(defun org-cycle-internal-local ()
"Do the local cycling action."
(let ((goal-column 0) eoh eol eos has-children children-skipped struct)
@@ -6765,15 +6896,10 @@ in special contexts.
(org-list-search-forward (org-item-beginning-re) eos t)))))
;; Determine end invisible part of buffer (EOL)
(beginning-of-line 2)
- ;; XEmacs doesn't have `next-single-char-property-change'
- (if (featurep 'xemacs)
- (while (and (not (eobp)) ;; this is like `next-line'
- (get-char-property (1- (point)) 'invisible))
- (beginning-of-line 2))
- (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))))
+ (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)))
(setq eol (point)))
;; Find out what to do next and set `this-command'
(cond
@@ -6786,7 +6912,7 @@ in special contexts.
(save-excursion
(goto-char eos)
(outline-next-heading)
- (if (outline-invisible-p) (org-flag-heading nil))))
+ (when (org-invisible-p) (org-flag-heading nil))))
((and (or (>= eol eos)
(not (string-match "\\S-" (buffer-substring eol eos))))
(or has-children
@@ -6798,7 +6924,7 @@ in special contexts.
(if (org-at-item-p)
(org-list-set-item-visibility (point-at-bol) struct 'children)
(org-show-entry)
- (org-with-limited-levels (show-children))
+ (org-with-limited-levels (org-show-children))
;; FIXME: This slows down the func way too much.
;; How keep drawers hidden in subtree anyway?
;; (when (memq 'org-cycle-hide-drawers org-cycle-hook)
@@ -6813,14 +6939,14 @@ in special contexts.
(let* ((struct (org-list-struct))
(prevs (org-list-prevs-alist struct))
(end (org-list-get-bottom-point struct)))
- (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
- (org-list-get-all-items (point) struct prevs))
+ (dolist (e (org-list-get-all-items (point) struct prevs))
+ (org-list-set-item-visibility e struct 'folded))
(goto-char (if (< end eos) end eos)))))))
(org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
- (if (outline-invisible-p) (org-flag-heading nil)))
+ (when (org-invisible-p) (org-flag-heading nil)))
(setq org-cycle-subtree-status 'children)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'children)))
@@ -6849,15 +6975,15 @@ in special contexts.
;;;###autoload
(defun org-global-cycle (&optional arg)
"Cycle the global visibility. For details see `org-cycle'.
-With \\[universal-argument] prefix arg, switch to startup visibility.
+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)
- (show-all)
- (hide-sublevels arg)
+ (outline-show-all)
+ (outline-hide-sublevels arg)
(setq org-cycle-global-status 'contents))
((equal arg '(4))
(org-set-startup-visibility)
@@ -6874,9 +7000,9 @@ With a numeric prefix, show all headlines up to that level."
(org-content))
((or (eq org-startup-folded 'showeverything)
(eq org-startup-folded nil))
- (show-all)))
+ (outline-show-all)))
(unless (eq org-startup-folded 'showeverything)
- (if org-hide-block-startup (org-hide-block-all))
+ (when org-hide-block-startup (org-hide-block-all))
(org-set-visibility-according-to-property 'no-cleanup)
(org-cycle-hide-archived-subtrees 'all)
(org-cycle-hide-drawers 'all)
@@ -6885,34 +7011,32 @@ With a numeric prefix, show all headlines up to that level."
(defun org-set-visibility-according-to-property (&optional no-cleanup)
"Switch subtree visibilities according to :VISIBILITY: property."
(interactive)
- (let (org-show-entry-below state)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)"
- nil t)
- (setq state (match-string 1))
- (save-excursion
- (org-back-to-heading t)
- (hide-subtree)
- (org-reveal)
- (cond
- ((equal state '("fold" "folded"))
- (hide-subtree))
- ((equal state "children")
- (org-show-hidden-entry)
- (show-children))
- ((equal state "content")
- (save-excursion
- (save-restriction
- (org-narrow-to-subtree)
- (org-content))))
- ((member state '("all" "showall"))
- (show-subtree)))))
- (unless no-cleanup
- (org-cycle-hide-archived-subtrees 'all)
- (org-cycle-hide-drawers 'all)
- (org-cycle-show-empty-lines 'all)))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t)
+ (if (not (org-at-property-p)) (outline-next-heading)
+ (let ((state (match-string 3)))
+ (save-excursion
+ (org-back-to-heading t)
+ (outline-hide-subtree)
+ (org-reveal)
+ (cond
+ ((equal state "folded")
+ (outline-hide-subtree))
+ ((equal state "children")
+ (org-show-hidden-entry)
+ (org-show-children))
+ ((equal state "content")
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (org-content))))
+ ((member state '("all" "showall"))
+ (outline-show-subtree)))))))
+ (unless no-cleanup
+ (org-cycle-hide-archived-subtrees 'all)
+ (org-cycle-hide-drawers 'all)
+ (org-cycle-show-empty-lines 'all))))
;; This function uses outline-regexp instead of the more fundamental
;; org-outline-regexp so that org-cycle-global works outside of Org
@@ -6928,11 +7052,10 @@ results."
(let ((level
(save-excursion
(goto-char (point-min))
- (if (re-search-forward (concat "^" outline-regexp) nil t)
- (progn
- (goto-char (match-beginning 0))
- (funcall outline-level))))))
- (and level (hide-sublevels level)))))
+ (when (re-search-forward (concat "^" outline-regexp) nil t)
+ (goto-char (match-beginning 0))
+ (funcall outline-level)))))
+ (and level (outline-hide-sublevels level)))))
(defun org-content (&optional arg)
"Show all headlines in the buffer, like a table of contents.
@@ -6950,9 +7073,9 @@ With numerical argument N, show content up to level N."
t)
(looking-at org-outline-regexp))
(if (integerp arg)
- (show-children (1- arg))
- (show-branches))
- (if (bobp) (throw 'exit nil))))))
+ (org-show-children (1- arg))
+ (outline-show-branches))
+ (when (bobp) (throw 'exit nil))))))
(defun org-optimize-window-after-visibility-change (state)
"Adjust the window after a change in outline visibility.
@@ -6967,13 +7090,11 @@ This function is the default value of the hook `org-cycle-hook'."
(defun org-remove-empty-overlays-at (pos)
"Remove outline overlays that do not contain non-white stuff."
- (mapc
- (lambda (o)
- (and (eq 'outline (overlay-get o 'invisible))
- (not (string-match "\\S-" (buffer-substring (overlay-start o)
- (overlay-end o))))
- (delete-overlay o)))
- (overlays-at pos)))
+ (dolist (o (overlays-at pos))
+ (and (eq 'outline (overlay-get o 'invisible))
+ (not (string-match "\\S-" (buffer-substring (overlay-start o)
+ (overlay-end o))))
+ (delete-overlay o))))
(defun org-clean-visibility-after-subtree-move ()
"Fix visibility issues after moving a subtree."
@@ -6991,7 +7112,7 @@ This function is the default value of the hook `org-cycle-hook'."
(point-at-eol)
(point))))
(level (looking-at "\\*+"))
- (re (if level (concat "^" (regexp-quote (match-string 0)) " "))))
+ (re (when level (concat "^" (regexp-quote (match-string 0)) " "))))
(save-excursion
(save-restriction
(narrow-to-region beg end)
@@ -6999,10 +7120,10 @@ This function is the default value of the hook `org-cycle-hook'."
;; Properly fold already folded siblings
(goto-char (point-min))
(while (re-search-forward re nil t)
- (if (and (not (outline-invisible-p))
- (save-excursion
- (goto-char (point-at-eol)) (outline-invisible-p)))
- (hide-entry))))
+ (when (and (not (org-invisible-p))
+ (save-excursion
+ (goto-char (point-at-eol)) (org-invisible-p)))
+ (outline-hide-entry))))
(org-cycle-show-empty-lines 'overview)
(org-cycle-hide-drawers 'overview)))))
@@ -7012,7 +7133,7 @@ The region to be covered depends on STATE when called through
`org-cycle-hook'. Lisp program can use t for STATE to get the
entire buffer covered. Note that an empty line is only shown if there
are at least `org-cycle-separator-lines' empty lines before the headline."
- (when (not (= org-cycle-separator-lines 0))
+ (when (/= org-cycle-separator-lines 0)
(save-excursion
(let* ((n (abs org-cycle-separator-lines))
(re (cond
@@ -7021,38 +7142,34 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(t (let ((ns (number-to-string (- n 2))))
(concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}"
"[ \t]*\\(\n[ \t]*\n\\*+\\) ")))))
- beg end b e)
+ beg end)
(cond
((memq state '(overview contents t))
(setq beg (point-min) end (point-max)))
((memq state '(children folded))
- (setq beg (point) end (progn (org-end-of-subtree t t)
- (beginning-of-line 2)
- (point)))))
+ (setq beg (point)
+ end (progn (org-end-of-subtree t t)
+ (line-beginning-position 2)))))
(when beg
(goto-char beg)
(while (re-search-forward re end t)
(unless (get-char-property (match-end 1) 'invisible)
- (setq e (match-end 1))
- (if (< org-cycle-separator-lines 0)
- (setq b (save-excursion
- (goto-char (match-beginning 0))
- (org-back-over-empty-lines)
- (if (save-excursion
- (goto-char (max (point-min) (1- (point))))
- (org-at-heading-p))
- (1- (point))
- (point))))
- (setq b (match-beginning 1)))
- (outline-flag-region b e nil)))))))
+ (let ((e (match-end 1))
+ (b (if (>= org-cycle-separator-lines 0)
+ (match-beginning 1)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (skip-chars-backward " \t\n")
+ (line-end-position)))))
+ (outline-flag-region b e nil))))))))
;; Never hide empty lines at the end of the file.
(save-excursion
(goto-char (point-max))
(outline-previous-heading)
(outline-end-of-heading)
- (if (and (looking-at "[ \t\n]+")
- (= (match-end 0) (point-max)))
- (outline-flag-region (point) (match-end 0) nil))))
+ (when (and (looking-at "[ \t\n]+")
+ (= (match-end 0) (point-max)))
+ (outline-flag-region (point) (match-end 0) nil))))
(defun org-show-empty-lines-in-parent ()
"Move to the parent and re-show empty lines before visible headlines."
@@ -7061,68 +7178,72 @@ are at least `org-cycle-separator-lines' empty lines before the headline."
(org-cycle-show-empty-lines context))))
(defun org-files-list ()
- "Return `org-agenda-files' list, plus all open org-mode files.
+ "Return `org-agenda-files' list, plus all open Org files.
This is useful for operations that need to scan all of a user's
open and agenda-wise Org files."
(let ((files (mapcar 'expand-file-name (org-agenda-files))))
(dolist (buf (buffer-list))
(with-current-buffer buf
- (if (and (derived-mode-p 'org-mode) (buffer-file-name))
- (let ((file (expand-file-name (buffer-file-name))))
- (unless (member file files)
- (push file files))))))
+ (when (and (derived-mode-p 'org-mode) (buffer-file-name))
+ (cl-pushnew (expand-file-name (buffer-file-name)) files))))
files))
(defsubst org-entry-beginning-position ()
"Return the beginning position of the current entry."
- (save-excursion (outline-back-to-heading t) (point)))
+ (save-excursion (org-back-to-heading t) (point)))
(defsubst org-entry-end-position ()
"Return the end position of the current entry."
(save-excursion (outline-next-heading) (point)))
-(defun org-cycle-hide-drawers (state)
- "Re-hide all drawers after a visibility state change."
+(defun org-cycle-hide-drawers (state &optional exceptions)
+ "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."
(when (and (derived-mode-p 'org-mode)
(not (memq state '(overview folded contents))))
(save-excursion
- (let* ((globalp (memq state '(contents all)))
+ (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)))))
(goto-char beg)
- (while (re-search-forward org-drawer-regexp end t)
- (org-flag-drawer t))))))
-
-(defun org-cycle-hide-inline-tasks (state)
- "Re-hide inline tasks when switching to `contents' or `children'
-visibility state."
- (case state
- (contents
- (when (org-bound-and-true-p org-inlinetask-min-level)
- (hide-sublevels (1- org-inlinetask-min-level))))
- (children
- (when (featurep 'org-inlinetask)
- (save-excursion
- (while (and (outline-next-heading)
- (org-inlinetask-at-task-p))
- (org-inlinetask-toggle-visibility)
- (org-inlinetask-goto-end)))))))
-
-(defun org-flag-drawer (flag)
- "When FLAG is non-nil, hide the drawer we are within.
-Otherwise make it visible."
- (save-excursion
- (beginning-of-line 1)
- (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:")
- (let ((b (match-end 0)))
- (if (re-search-forward
- "^[ \t]*:END:"
- (save-excursion (outline-next-heading) (point)) t)
- (outline-flag-region b (point-at-eol) flag)
- (user-error ":END: line missing at position %s" b))))))
+ (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)
+ "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."
+ (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)))
+ (save-excursion
+ (outline-flag-region
+ (progn (goto-char post) (line-end-position))
+ (progn (goto-char (org-element-property :end drawer))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position))
+ flag))
+ ;; When the drawer is hidden away, make sure point lies in
+ ;; a visible part of the buffer.
+ (when (and flag (> (line-beginning-position) post))
+ (goto-char post))))))
(defun org-subtree-end-visible-p ()
"Is the end of the current subtree visible?"
@@ -7131,9 +7252,11 @@ Otherwise make it visible."
(defun org-first-headline-recenter ()
"Move cursor to the first headline and recenter the headline."
- (goto-char (point-min))
- (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (set-window-start (selected-window) (point-at-bol))))
+ (let ((window (get-buffer-window)))
+ (when window
+ (goto-char (point-min))
+ (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
+ (set-window-start window (line-beginning-position))))))
;;; Saving and restoring visibility
@@ -7144,38 +7267,30 @@ The return value is a list of cons cells, with start and stop
positions for each overlay.
If USE-MARKERS is set, return the positions as markers."
(let (beg end)
- (save-excursion
- (save-restriction
- (widen)
- (delq nil
- (mapcar (lambda (o)
- (when (eq (overlay-get o 'invisible) 'outline)
- (setq beg (overlay-start o)
- end (overlay-end o))
- (and beg end (> end beg)
- (if use-markers
- (cons (move-marker (make-marker) beg)
- (move-marker (make-marker) end))
- (cons beg end)))))
- (overlays-in (point-min) (point-max))))))))
+ (org-with-wide-buffer
+ (delq nil
+ (mapcar (lambda (o)
+ (when (eq (overlay-get o 'invisible) 'outline)
+ (setq beg (overlay-start o)
+ end (overlay-end o))
+ (and beg end (> end beg)
+ (if use-markers
+ (cons (copy-marker beg)
+ (copy-marker end t))
+ (cons beg end)))))
+ (overlays-in (point-min) (point-max)))))))
(defun org-set-outline-overlay-data (data)
"Create visibility overlays for all positions in DATA.
DATA should have been made by `org-outline-overlay-data'."
- (let (o)
- (save-excursion
- (save-restriction
- (widen)
- (show-all)
- (mapc (lambda (c)
- (outline-flag-region (car c) (cdr c) t))
- data)))))
+ (org-with-wide-buffer
+ (outline-show-all)
+ (dolist (c data) (outline-flag-region (car c) (cdr c) t))))
;;; Folding of blocks
-(defvar org-hide-block-overlays nil
+(defvar-local org-hide-block-overlays nil
"Overlays hiding blocks.")
-(make-variable-buffer-local 'org-hide-block-overlays)
(defun org-block-map (function &optional start end)
"Call FUNCTION at the head of all source blocks in the current buffer.
@@ -7192,74 +7307,85 @@ Optional arguments START and END can be used to limit the range."
(defun org-hide-block-toggle-all ()
"Toggle the visibility of all blocks in the current buffer."
- (org-block-map #'org-hide-block-toggle))
+ (org-block-map 'org-hide-block-toggle))
(defun org-hide-block-all ()
"Fold all blocks in the current buffer."
(interactive)
(org-show-block-all)
- (org-block-map #'org-hide-block-toggle-maybe))
+ (org-block-map 'org-hide-block-toggle-maybe))
(defun org-show-block-all ()
"Unfold all blocks in the current buffer."
(interactive)
- (mapc 'delete-overlay org-hide-block-overlays)
+ (mapc #'delete-overlay org-hide-block-overlays)
(setq org-hide-block-overlays nil))
(defun org-hide-block-toggle-maybe ()
- "Toggle visibility of block at point."
+ "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)
- (let ((case-fold-search t))
- (if (save-excursion
- (beginning-of-line 1)
- (looking-at org-block-regexp))
- (progn (org-hide-block-toggle)
- t) ;; to signal that we took action
- nil))) ;; to signal that we did not
+ (ignore-errors (org-hide-block-toggle)))
(defun org-hide-block-toggle (&optional force)
- "Toggle the visibility of the current block."
+ "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."
(interactive)
- (save-excursion
- (beginning-of-line)
- (if (re-search-forward org-block-regexp nil t)
- (let ((start (- (match-beginning 4) 1)) ;; beginning of body
- (end (match-end 0)) ;; end of entire body
- ov)
- (if (memq t (mapcar (lambda (overlay)
- (eq (overlay-get overlay 'invisible)
- 'org-hide-block))
- (overlays-at start)))
- (if (or (not force) (eq force 'off))
- (mapc (lambda (ov)
- (when (member ov org-hide-block-overlays)
- (setq org-hide-block-overlays
- (delq ov org-hide-block-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-hide-block)
- (delete-overlay ov)))
- (overlays-at start)))
- (setq ov (make-overlay start end))
- (overlay-put ov 'invisible 'org-hide-block)
- ;; make the block accessible to isearch
- (overlay-put
- ov 'isearch-open-invisible
- (lambda (ov)
- (when (member ov org-hide-block-overlays)
- (setq org-hide-block-overlays
- (delq ov org-hide-block-overlays)))
- (when (eq (overlay-get ov 'invisible)
- 'org-hide-block)
- (delete-overlay ov))))
- (push ov org-hide-block-overlays)))
- (user-error "Not looking at a source block"))))
-
-;; org-tab-after-check-for-cycling-hook
-(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe)
+ (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* ((start (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (line-end-position)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))
+ (overlays (overlays-at start)))
+ (cond
+ ;; Do nothing when not before or at the block opening line or
+ ;; at the block closing line.
+ ((let ((eol (line-end-position))) (and (> eol start) (/= eol end))) nil)
+ ((and (not (eq force 'off))
+ (not (memq t (mapcar
+ (lambda (o)
+ (eq (overlay-get o 'invisible) 'org-hide-block))
+ overlays))))
+ (let ((ov (make-overlay start end)))
+ (overlay-put ov 'invisible 'org-hide-block)
+ ;; Make the block accessible to `isearch'.
+ (overlay-put
+ ov 'isearch-open-invisible
+ (lambda (ov)
+ (when (memq ov org-hide-block-overlays)
+ (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
+ (when (eq (overlay-get ov 'invisible) 'org-hide-block)
+ (delete-overlay ov))))
+ (push ov org-hide-block-overlays)
+ ;; When the block is hidden away, make sure point is left in
+ ;; a visible part of the buffer.
+ (when (> (line-beginning-position) start)
+ (goto-char start)
+ (beginning-of-line))
+ ;; Signal successful toggling.
+ t))
+ ((or (not force) (eq force 'off))
+ (dolist (ov overlays t)
+ (when (memq ov org-hide-block-overlays)
+ (setq org-hide-block-overlays (delq ov org-hide-block-overlays)))
+ (when (eq (overlay-get ov 'invisible) 'org-hide-block)
+ (delete-overlay ov))))))))
+
;; Remove overlays when changing major mode
(add-hook 'org-mode-hook
- (lambda () (org-add-hook 'change-major-mode-hook
- 'org-show-block-all 'append 'local)))
+ (lambda () (add-hook 'change-major-mode-hook
+ 'org-show-block-all 'append 'local)))
;;; Org-goto
@@ -7305,7 +7431,7 @@ Optional arguments START and END can be used to limit the range."
(defconst org-goto-help
"Browse buffer copy, to find location or copy text.%s
RET=jump to location C-g=quit and return to previous location
-[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
+\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur")
(defvar org-goto-start-pos) ; dynamically scoped parameter
@@ -7343,23 +7469,23 @@ With a prefix argument, use the alternative interface: e.g., if
(selected-point
(if (eq interface 'outline)
(car (org-get-location (current-buffer) org-goto-help))
- (let ((pa (org-refile-get-location "Goto" nil nil t)))
+ (let ((pa (org-refile-get-location "Goto")))
(org-refile-check-position pa)
(nth 3 pa)))))
(if selected-point
(progn
(org-mark-ring-push org-goto-start-pos)
(goto-char selected-point)
- (if (or (outline-invisible-p) (org-invisible-p2))
- (org-show-context 'org-goto)))
+ (when (or (org-invisible-p) (org-invisible-p2))
+ (org-show-context 'org-goto)))
(message "Quit"))))
(defvar org-goto-selected-point nil) ; dynamically scoped parameter
(defvar org-goto-exit-command nil) ; dynamically scoped parameter
(defvar org-goto-local-auto-isearch-map) ; defined below
-(defun org-get-location (buf help)
- "Let the user select a location in the Org-mode buffer BUF.
+(defun org-get-location (_buf help)
+ "Let the user select a location in current buffer.
This function uses a recursive edit. It returns the selected position
or nil."
(org-no-popups
@@ -7372,7 +7498,7 @@ or nil."
(save-window-excursion
(delete-other-windows)
(and (get-buffer "*org-goto*") (kill-buffer "*org-goto*"))
- (org-pop-to-buffer-same-window
+ (pop-to-buffer-same-window
(condition-case nil
(make-indirect-buffer (current-buffer) "*org-goto*")
(error (make-indirect-buffer (current-buffer) "*org-goto*"))))
@@ -7390,11 +7516,9 @@ or nil."
(setq buffer-read-only t)
(if (and (boundp 'org-goto-start-pos)
(integer-or-marker-p org-goto-start-pos))
- (let ((org-show-hierarchy-above t)
- (org-show-siblings t)
- (org-show-following-heading t))
- (goto-char org-goto-start-pos)
- (and (outline-invisible-p) (org-show-context)))
+ (progn (goto-char org-goto-start-pos)
+ (when (org-invisible-p)
+ (org-show-set-visibility 'lineage)))
(goto-char (point-min)))
(let (org-special-ctrl-a/e) (org-beginning-of-line))
(message "Select location and press RET")
@@ -7405,8 +7529,14 @@ or nil."
(defvar org-goto-local-auto-isearch-map (make-sparse-keymap))
(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map)
-(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
-(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)
+;; `isearch-other-control-char' was removed in Emacs 24.4.
+(if (fboundp 'isearch-other-control-char)
+ (progn
+ (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char)
+ (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char))
+ (define-key org-goto-local-auto-isearch-map "\C-i" nil)
+ (define-key org-goto-local-auto-isearch-map "\C-m" nil)
+ (define-key org-goto-local-auto-isearch-map [return] nil))
(defun org-goto-local-search-headings (string bound noerror)
"Search and make sure that any matches are in headlines."
@@ -7414,9 +7544,12 @@ or nil."
(while (if isearch-forward
(search-forward string bound noerror)
(search-backward string bound noerror))
- (when (let ((context (mapcar 'car (save-match-data (org-context)))))
- (and (member :headline context)
- (not (member :tags context))))
+ (when (save-match-data
+ (and (save-excursion
+ (beginning-of-line)
+ (looking-at org-complex-heading-regexp))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5)))))
(throw 'return (point))))))
(defun org-goto-local-auto-isearch ()
@@ -7428,11 +7561,11 @@ or nil."
(isearch-mode t)
(isearch-process-search-char (string-to-char keys)))))
-(defun org-goto-ret (&optional arg)
+(defun org-goto-ret (&optional _arg)
"Finish `org-goto' by going to the new location."
(interactive "P")
- (setq org-goto-selected-point (point)
- org-goto-exit-command 'return)
+ (setq org-goto-selected-point (point))
+ (setq org-goto-exit-command 'return)
(throw 'exit nil))
(defun org-goto-left ()
@@ -7471,17 +7604,18 @@ or nil."
(defun org-tree-to-indirect-buffer (&optional arg)
"Create indirect buffer and narrow it to current subtree.
+
With a numerical prefix ARG, go up to this level and then take that tree.
If ARG is negative, go up that many levels.
If `org-indirect-buffer-display' is not `new-frame', the command removes the
indirect buffer previously made with this command, to avoid proliferation of
indirect buffers. However, when you call the command with a \
-\\[universal-argument] prefix, or
-when `org-indirect-buffer-display' is `new-frame', the last buffer
-is kept so that you can work with several indirect buffers at the same time.
-If `org-indirect-buffer-display' is `dedicated-frame', the \
-\\[universal-argument] prefix also
+`\\[universal-argument]' prefix, or
+when `org-indirect-buffer-display' is `new-frame', the last buffer is kept
+so that you can work with several indirect buffers at the same time. If
+`org-indirect-buffer-display' is `dedicated-frame', the \
+`\\[universal-argument]' prefix also
requests that a new frame be made for the new buffer, so that the dedicated
frame is not changed."
(interactive "P")
@@ -7493,26 +7627,26 @@ frame is not changed."
(org-back-to-heading t)
(when (numberp arg)
(setq level (org-outline-level))
- (if (< arg 0) (setq arg (+ level arg)))
+ (when (< arg 0) (setq arg (+ level arg)))
(while (> (setq level (org-outline-level)) arg)
(org-up-heading-safe)))
(setq beg (point)
- heading (org-get-heading))
+ heading (org-get-heading 'no-tags))
(org-end-of-subtree t t)
- (if (org-at-heading-p) (backward-char 1))
+ (when (org-at-heading-p) (backward-char 1))
(setq end (point)))
- (if (and (buffer-live-p org-last-indirect-buffer)
- (not (eq org-indirect-buffer-display 'new-frame))
- (not arg))
- (kill-buffer org-last-indirect-buffer))
- (setq ibuf (org-get-indirect-buffer cbuf)
+ (when (and (buffer-live-p org-last-indirect-buffer)
+ (not (eq org-indirect-buffer-display 'new-frame))
+ (not arg))
+ (kill-buffer org-last-indirect-buffer))
+ (setq ibuf (org-get-indirect-buffer cbuf heading)
org-last-indirect-buffer ibuf)
(cond
((or (eq org-indirect-buffer-display 'new-frame)
(and arg (eq org-indirect-buffer-display 'dedicated-frame)))
(select-frame (make-frame))
(delete-other-windows)
- (org-pop-to-buffer-same-window ibuf)
+ (pop-to-buffer-same-window ibuf)
(org-set-frame-title heading))
((eq org-indirect-buffer-display 'dedicated-frame)
(raise-frame
@@ -7521,26 +7655,28 @@ frame is not changed."
org-indirect-dedicated-frame)
(setq org-indirect-dedicated-frame (make-frame)))))
(delete-other-windows)
- (org-pop-to-buffer-same-window ibuf)
+ (pop-to-buffer-same-window ibuf)
(org-set-frame-title (concat "Indirect: " heading)))
((eq org-indirect-buffer-display 'current-window)
- (org-pop-to-buffer-same-window ibuf))
+ (pop-to-buffer-same-window ibuf))
((eq org-indirect-buffer-display 'other-window)
(pop-to-buffer ibuf))
(t (error "Invalid value")))
- (if (featurep 'xemacs)
- (save-excursion (org-mode) (turn-on-font-lock)))
(narrow-to-region beg end)
- (show-all)
+ (outline-show-all)
(goto-char pos)
(run-hook-with-args 'org-cycle-hook 'all)
(and (window-live-p cwin) (select-window cwin))))
-(defun org-get-indirect-buffer (&optional buffer)
+(defun org-get-indirect-buffer (&optional buffer heading)
(setq buffer (or buffer (current-buffer)))
(let ((n 1) (base (buffer-name buffer)) bname)
(while (buffer-live-p
- (get-buffer (setq bname (concat base "-" (number-to-string n)))))
+ (get-buffer
+ (setq bname
+ (concat base "-"
+ (if heading (concat heading "-" (number-to-string n))
+ (number-to-string n))))))
(setq n (1+ n)))
(condition-case nil
(make-indirect-buffer buffer bname 'clone)
@@ -7548,224 +7684,189 @@ frame is not changed."
(defun org-set-frame-title (title)
"Set the title of the current frame to the string TITLE."
- ;; FIXME: how to name a single frame in XEmacs???
- (unless (featurep 'xemacs)
- (modify-frame-parameters (selected-frame) (list (cons 'name title)))))
+ (modify-frame-parameters (selected-frame) (list (cons 'name title))))
;;;; Structure editing
;;; Inserting headlines
-(defun org-previous-line-empty-p (&optional next)
- "Is the previous line a blank line?
-When NEXT is non-nil, check the next line instead."
+(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 (if next 2 0)) t)
+ (or (beginning-of-line n) t)
(save-match-data
(looking-at "[ \t]*$")))))
-(defun org-insert-heading (&optional arg invisible-ok)
+(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
+headline instead of current one."
+ (pcase (assq 'heading org-blank-before-new-entry)
+ (`(heading . auto)
+ (save-excursion
+ (org-with-limited-levels
+ (unless (and (org-before-first-heading-p)
+ (not (outline-next-heading)))
+ (org-back-to-heading t)
+ (when parent (org-up-heading-safe))
+ (cond ((not (bobp))
+ (org-previous-line-empty-p))
+ ((outline-next-heading)
+ (org-previous-line-empty-p))
+ ;; Ignore trailing spaces on last buffer line.
+ ((progn (skip-chars-backward " \t") (bolp))
+ (org-previous-line-empty-p))
+ (t nil))))))
+ (`(heading . ,value) value)
+ (_ nil)))
+
+(defun org-insert-heading (&optional arg invisible-ok top)
"Insert a new heading or an item with the same depth at point.
-If point is at the beginning of a heading or a list item, insert
-a new heading or a new item above the current one. If point is
-at the beginning of a normal line, turn the line into a heading.
+If point is at the beginning of a heading, insert a new heading
+or a new headline above the current one. When at the beginning
+of a regular line of text, turn it into a heading.
-If point is in the middle of a headline or a list item, split the
-headline or the item and create a new headline/item with the text
-in the current line after point \(see `org-M-RET-may-split-line'
-on how to modify this behavior).
+If point is in the middle of a line, split it and create a new
+headline with the text in the current line after point (see
+`org-M-RET-may-split-line' on how to modify this behavior). As
+a special case, on a headline, splitting can only happen on the
+title itself. E.g., this excludes breaking stars or tags.
-With one universal prefix argument, set the user option
-`org-insert-heading-respect-content' to t for the duration of
-the command. This modifies the behavior described above in this
-ways: on list items and at the beginning of normal lines, force
-the insertion of a heading after the current subtree.
+With a `\\[universal-argument]' prefix, set \
+`org-insert-heading-respect-content' to
+a non-nil value for the duration of the command. This forces the
+insertion of a heading after the current subtree, independently
+on the location of point.
-With two universal prefix arguments, insert the heading at the
-end of the grandparent subtree. For example, if point is within
-a 2nd-level heading, then it will insert a 2nd-level heading at
-the end of the 1st-level parent heading.
+With a `\\[universal-argument] \\[universal-argument]' prefix, \
+insert the heading at the end of the tree
+above the current heading. For example, if point is within a
+2nd-level heading, then it will insert a 2nd-level heading at
+the end of the 1st-level parent subtree.
When INVISIBLE-OK is set, stop at invisible headlines when going
back. This is important for non-interactive uses of the
-command."
- (interactive "P")
- (if (org-called-interactively-p 'any) (org-reveal))
- (let ((itemp (org-in-item-p))
- (may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
- (respect-content (or org-insert-heading-respect-content
- (equal arg '(4))))
- (initial-content "")
- (adjust-empty-lines t))
+command.
+When optional argument TOP is non-nil, insert a level 1 heading,
+unconditionally."
+ (interactive "P")
+ (let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
+ (level (org-current-level))
+ (stars (make-string (if (and level (not top)) level 1) ?*)))
(cond
-
- ((or (= (buffer-size) 0)
- (and (not (save-excursion
- (and (ignore-errors (org-back-to-heading invisible-ok))
- (org-at-heading-p))))
- (or arg (not itemp))))
- ;; At beginning of buffer or so high up that only a heading
- ;; makes sense.
- (cond ((and (bolp) (not respect-content)) (insert "* "))
- ((not respect-content)
- (unless may-split (end-of-line))
- (insert "\n* "))
- ((re-search-forward org-outline-regexp-bol nil t)
- (beginning-of-line)
- (insert "* \n")
- (backward-char))
- (t (goto-char (point-max))
- (insert "\n* ")))
- (run-hooks 'org-insert-heading-hook))
-
- ((and itemp (not (member arg '((4) (16)))))
- ;; Insert an item
- (org-insert-item))
-
+ ((or org-insert-heading-respect-content
+ (member arg '((4) (16)))
+ (and (not invisible-ok)
+ (invisible-p (max (1- (point)) (point-min)))))
+ ;; Position point at the location of insertion.
+ (if (not level) ;before first headline
+ (org-with-limited-levels (outline-next-heading))
+ ;; Make sure we end up on a visible headline if INVISIBLE-OK
+ ;; is nil.
+ (org-with-limited-levels (org-back-to-heading invisible-ok))
+ (cond ((equal arg '(16))
+ (org-up-heading-safe)
+ (org-end-of-subtree t t))
+ (t
+ (org-end-of-subtree t t))))
+ (unless (bolp) (insert "\n")) ;ensure final newline
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0)))
+ (insert stars " \n")
+ (forward-char -1))
+ ;; At a headline...
+ ((org-at-heading-p)
+ (cond ((bolp)
+ (when blank? (save-excursion (insert "\n")))
+ (save-excursion (insert stars " \n"))
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0)))
+ (end-of-line))
+ ((and (org-get-alist-option org-M-RET-may-split-line 'headline)
+ (org-match-line org-complex-heading-regexp)
+ (org-pos-in-match-range (point) 4))
+ ;; Grab the text that should moved to the new headline.
+ ;; Preserve tags.
+ (let ((split (delete-and-extract-region (point) (match-end 4))))
+ (if (looking-at "[ \t]*$") (replace-match "")
+ (org-set-tags nil t))
+ (end-of-line)
+ (when blank? (insert "\n"))
+ (insert "\n" stars " ")
+ (when (org-string-nw-p split) (insert split))
+ (when (eobp) (save-excursion (insert "\n")))))
+ (t
+ (end-of-line)
+ (when blank? (insert "\n"))
+ (insert "\n" stars " ")
+ (when (eobp) (save-excursion (insert "\n"))))))
+ ;; On regular text, turn line into a headline or split, if
+ ;; appropriate.
+ ((bolp)
+ (insert stars " ")
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0))))
(t
- ;; Maybe move at the end of the subtree
- (when (equal arg '(16))
- (org-up-heading-safe)
- (org-end-of-subtree t))
- ;; Insert a heading
- (save-restriction
- (widen)
- (let* ((level nil)
- (on-heading (org-at-heading-p))
- (empty-line-p (if on-heading
- (org-previous-line-empty-p)
- ;; We will decide later
- nil))
- ;; Get a level string to fall back on
- (fix-level
- (if (org-before-first-heading-p) "*"
- (save-excursion
- (org-back-to-heading t)
- (if (org-previous-line-empty-p) (setq empty-line-p t))
- (looking-at org-outline-regexp)
- (make-string (1- (length (match-string 0))) ?*))))
- (stars
- (save-excursion
- (condition-case nil
- (progn
- (org-back-to-heading invisible-ok)
- (when (and (not on-heading)
- (featurep 'org-inlinetask)
- (integerp org-inlinetask-min-level)
- (>= (length (match-string 0))
- org-inlinetask-min-level))
- ;; Find a heading level before the inline task
- (while (and (setq level (org-up-heading-safe))
- (>= level org-inlinetask-min-level)))
- (if (org-at-heading-p)
- (org-back-to-heading invisible-ok)
- (error "This should not happen")))
- (unless (and (save-excursion
- (save-match-data
- (org-backward-heading-same-level
- 1 invisible-ok))
- (= (point) (match-beginning 0)))
- (not (org-previous-line-empty-p t)))
- (setq empty-line-p (or empty-line-p
- (org-previous-line-empty-p))))
- (match-string 0))
- (error (or fix-level "* ")))))
- (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a))
- pos hide-previous previous-pos)
-
- ;; If we insert after content, move there and clean up whitespace
- (when (and respect-content
- (not (org-looking-at-p org-outline-regexp-bol)))
- (if (not (org-before-first-heading-p))
- (org-end-of-subtree nil t)
- (re-search-forward org-outline-regexp-bol)
- (beginning-of-line 0))
- (skip-chars-backward " \r\n")
- (and (not (looking-back "^\\*+" (line-beginning-position)))
- (looking-at "[ \t]+") (replace-match ""))
- (unless (eobp) (forward-char 1))
- (when (looking-at "^\\*")
- (unless (bobp) (backward-char 1))
- (insert "\n")))
-
- ;; If we are splitting, grab the text that should be moved to the new headline
- (when may-split
- (if (org-on-heading-p)
- ;; This is a heading, we split intelligently (keeping tags)
- (let ((pos (point)))
- (goto-char (point-at-bol))
- (unless (looking-at org-complex-heading-regexp)
- (error "This should not happen"))
- (when (and (match-beginning 4)
- (> pos (match-beginning 4))
- (< pos (match-end 4)))
- (setq initial-content (buffer-substring pos (match-end 4)))
- (goto-char pos)
- (delete-region (point) (match-end 4))
- (if (looking-at "[ \t]*$")
- (replace-match "")
- (insert (make-string (length initial-content) ?\ )))
- (setq initial-content (org-trim initial-content)))
- (goto-char pos))
- ;; a normal line
- (setq initial-content
- (org-trim (buffer-substring (point) (point-at-eol))))
- (delete-region (point) (point-at-eol))))
-
- ;; If we are at the beginning of the line, insert before it. Else after
- (cond
- ((and (bolp) (looking-at "[ \t]*$")))
- ((and (bolp) (not (looking-at "[ \t]*$")))
- (open-line 1))
- (t
- (goto-char (point-at-eol))
- (insert "\n")))
-
- ;; Insert the new heading
- (insert stars)
- (just-one-space)
- (insert initial-content)
- (when adjust-empty-lines
- (if (or (not blank)
- (and blank (not (org-previous-line-empty-p))))
- (org-N-empty-lines-before-current (if blank 1 0))))
- (run-hooks 'org-insert-heading-hook)))))))
-
-(defun org-N-empty-lines-before-current (N)
+ (unless (org-get-alist-option org-M-RET-may-split-line 'headline)
+ (end-of-line))
+ (insert "\n" stars " ")
+ (unless (and blank? (org-previous-line-empty-p))
+ (org-N-empty-lines-before-current (if blank? 1 0))))))
+ (run-hooks 'org-insert-heading-hook))
+
+(defun org-N-empty-lines-before-current (n)
"Make the number of empty lines before current exactly N.
So this will delete or add empty lines."
- (save-excursion
+ (let ((column (current-column)))
(beginning-of-line)
- (let ((p (point)))
- (skip-chars-backward " \r\t\n")
- (unless (bolp) (forward-line))
- (delete-region (point) p))
- (when (> N 0) (insert (make-string N ?\n)))))
-
-(defun org-get-heading (&optional no-tags no-todo)
+ (unless (bobp)
+ (let ((start (save-excursion
+ (skip-chars-backward " \r\t\n")
+ (line-end-position))))
+ (delete-region start (line-end-position 0))))
+ (insert (make-string n ?\n))
+ (move-to-column column)))
+
+(defun org-get-heading (&optional no-tags no-todo no-priority no-comment)
"Return the heading of the current entry, without the stars.
When NO-TAGS is non-nil, don't include tags.
-When NO-TODO is non-nil, don't include TODO keywords."
+When NO-TODO is non-nil, don't include TODO keywords.
+When NO-PRIORITY is non-nil, don't include priority cookie.
+When NO-COMMENT is non-nil, don't include COMMENT string."
(save-excursion
(org-back-to-heading t)
- (cond
- ((and no-tags no-todo)
+ (let ((case-fold-search nil))
(looking-at org-complex-heading-regexp)
- (match-string 4))
- (no-tags
- (looking-at (concat org-outline-regexp
- "\\(.*?\\)"
- "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$"))
- (match-string 1))
- (no-todo
- (looking-at org-todo-line-regexp)
- (match-string 3))
- (t (looking-at org-heading-regexp)
- (match-string 2)))))
+ (let ((todo (and (not no-todo) (match-string 2)))
+ (priority (and (not no-priority) (match-string 3)))
+ (headline (pcase (match-string 4)
+ (`nil "")
+ ((and (guard no-comment) h)
+ (replace-regexp-in-string
+ (eval-when-compile
+ (format "\\`%s[ \t]+" org-comment-string))
+ "" h))
+ (h h)))
+ (tags (and (not no-tags) (match-string 5))))
+ (mapconcat #'identity
+ (delq nil (list todo priority headline tags))
+ " ")))))
(defvar orgstruct-mode) ; defined below
@@ -7780,24 +7881,24 @@ This is a list with the following elements:
- the tags string, or nil."
(save-excursion
(org-back-to-heading t)
- (if (let (case-fold-search)
- (looking-at
- (if orgstruct-mode
- org-heading-regexp
- org-complex-heading-regexp)))
- (if orgstruct-mode
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- nil
- nil
- (match-string 2)
- nil)
- (list (length (match-string 1))
- (org-reduced-level (length (match-string 1)))
- (org-match-string-no-properties 2)
- (and (match-end 3) (aref (match-string 3) 2))
- (org-match-string-no-properties 4)
- (org-match-string-no-properties 5))))))
+ (when (let (case-fold-search)
+ (looking-at
+ (if orgstruct-mode
+ org-heading-regexp
+ org-complex-heading-regexp)))
+ (if orgstruct-mode
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ nil
+ nil
+ (match-string 2)
+ nil)
+ (list (length (match-string 1))
+ (org-reduced-level (length (match-string 1)))
+ (match-string-no-properties 2)
+ (and (match-end 3) (aref (match-string 3) 2))
+ (match-string-no-properties 4)
+ (match-string-no-properties 5))))))
(defun org-get-entry ()
"Get the entry text, after heading, entire subtree."
@@ -7805,6 +7906,24 @@ This is a list with the following elements:
(org-back-to-heading t)
(buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
+(defun org-edit-headline (&optional heading)
+ "Edit the current headline.
+Set it to HEADING when provided."
+ (interactive)
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (let* ((old (match-string-no-properties 4))
+ (new (save-match-data
+ (org-trim (or heading (read-string "Edit: " old))))))
+ (unless (equal old new)
+ (if old (replace-match new t t nil 4)
+ (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
+ (insert " " new))
+ (org-set-tags nil t)
+ (when (looking-at "[ \t]*$") (replace-match ""))))))))
+
(defun org-insert-heading-after-current ()
"Insert a new heading with same level as current, after current subtree."
(interactive)
@@ -7825,29 +7944,32 @@ This is a list with the following elements:
(defun org-insert-todo-heading (arg &optional force-heading)
"Insert a new heading with the same level and TODO state as current heading.
-If the heading has no TODO state, or if the state is DONE, use the first
-state (TODO by default). Also with one prefix arg, force first state. With
-two prefix args, force inserting at the end of the parent subtree."
+
+If the heading has no TODO state, or if the state is DONE, use
+the first state (TODO by default). Also with one prefix arg,
+force first state. With two prefix args, force inserting at the
+end of the parent subtree.
+
+When called at a plain list item, insert a new item with an
+unchecked check box."
(interactive "P")
(when (or force-heading (not (org-insert-item 'checkbox)))
(org-insert-heading (or (and (equal arg '(16)) '(16))
force-heading))
(save-excursion
- (org-back-to-heading)
- (outline-previous-heading)
- (looking-at org-todo-line-regexp))
- (let*
- ((new-mark-x
- (if (or (equal arg '(4))
- (not (match-beginning 2))
- (member (match-string 2) org-done-keywords))
- (car org-todo-keywords-1)
- (match-string 2)))
- (new-mark
- (or
- (run-hook-with-args-until-success
- 'org-todo-get-default-hook new-mark-x nil)
- new-mark-x)))
+ (org-forward-heading-same-level -1)
+ (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)))
+ (let* ((new-mark-x
+ (if (or (equal arg '(4))
+ (not (match-beginning 2))
+ (member (match-string 2) org-done-keywords))
+ (car org-todo-keywords-1)
+ (match-string 2)))
+ (new-mark
+ (or
+ (run-hook-with-args-until-success
+ 'org-todo-get-default-hook new-mark-x nil)
+ new-mark-x)))
(beginning-of-line 1)
(and (looking-at org-outline-regexp) (goto-char (match-end 0))
(if org-treat-insert-todo-heading-as-state-change
@@ -7895,18 +8017,17 @@ See also `org-promote'."
(org-fix-position-after-promote))
(defun org-demote-subtree ()
- "Demote the entire subtree. See `org-demote'.
-See also `org-promote'."
+ "Demote the entire subtree.
+See `org-demote' and `org-promote'."
(interactive)
(save-excursion
(org-with-limited-levels (org-map-tree 'org-demote)))
(org-fix-position-after-promote))
-
(defun org-do-promote ()
"Promote the current heading higher up the tree.
-If the region is active in `transient-mark-mode', promote all headings
-in the region."
+If the region is active in `transient-mark-mode', promote all
+headings in the region."
(interactive)
(save-excursion
(if (org-region-active-p)
@@ -7916,8 +8037,8 @@ in the region."
(defun org-do-demote ()
"Demote the current heading lower down the tree.
-If the region is active in `transient-mark-mode', demote all headings
-in the region."
+If the region is active in `transient-mark-mode', demote all
+headings in the region."
(interactive)
(save-excursion
(if (org-region-active-p)
@@ -7926,23 +8047,24 @@ in the region."
(org-fix-position-after-promote))
(defun org-fix-position-after-promote ()
- "Make sure that after pro/demotion cursor position is right."
+ "Fix cursor position and indentation after demoting/promoting."
(let ((pos (point)))
(when (save-excursion
- (beginning-of-line 1)
- (looking-at org-todo-line-regexp)
- (or (equal pos (match-end 1)) (equal pos (match-end 2))))
+ (beginning-of-line)
+ (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
+ (or (eq pos (match-end 1)) (eq pos (match-end 2))))
(cond ((eobp) (insert " "))
((eolp) (insert " "))
- ((equal (char-after) ?\ ) (forward-char 1))))))
+ ((equal (char-after) ?\s) (forward-char 1))))))
(defun org-current-level ()
"Return the level of the current entry, or nil if before the first headline.
-The level is the number of stars at the beginning of the headline."
- (save-excursion
- (org-with-limited-levels
- (if (ignore-errors (org-back-to-heading t))
- (funcall outline-level)))))
+The level is the number of stars at the beginning of the
+headline. Use `org-reduced-level' to remove the effect of
+`org-odd-levels'. Unlike to `org-outline-level', this function
+ignores inlinetasks."
+ (let ((level (org-with-limited-levels (org-outline-level))))
+ (and (> level 0) level)))
(defun org-get-previous-line-level ()
"Return the outline depth of the last headline before the current line.
@@ -7968,60 +8090,50 @@ time to headlines when structure editing, based on the value of
(if org-odd-levels-only 2 1))
(defun org-get-valid-level (level &optional change)
- "Rectify a level change under the influence of `org-odd-levels-only'
-LEVEL is a current level, CHANGE is by how much the level should be
-modified. Even if CHANGE is nil, LEVEL may be returned modified because
-even level numbers will become the next higher odd number."
+ "Rectify a level change under the influence of `org-odd-levels-only'.
+LEVEL is a current level, CHANGE is by how much the level should
+be modified. Even if CHANGE is nil, LEVEL may be returned
+modified because even level numbers will become the next higher
+odd number. Returns values greater than 0."
(if org-odd-levels-only
(cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2))))
- ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2))))
+ ((> change 0) (1+ (* 2 (/ (+ (1- level) (* 2 change)) 2))))
((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2))))))
(max 1 (+ level (or change 0)))))
-(if (boundp 'define-obsolete-function-alias)
- (if (or (featurep 'xemacs) (< emacs-major-version 23))
- (define-obsolete-function-alias 'org-get-legal-level
- 'org-get-valid-level)
- (define-obsolete-function-alias 'org-get-legal-level
- 'org-get-valid-level "23.1")))
-
(defun org-promote ()
- "Promote the current heading higher up the tree.
-If the region is active in `transient-mark-mode', promote all headings
-in the region."
- (org-back-to-heading t)
- (let* ((level (save-match-data (funcall outline-level)))
- (after-change-functions (remove 'flyspell-after-change-function
- after-change-functions))
- (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
- (diff (abs (- level (length up-head) -1))))
- (cond ((and (= level 1) org-called-with-limited-levels
- org-allow-promoting-top-level-subtree)
- (replace-match "# " nil t))
- ((= level 1)
- (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
- (t (replace-match up-head nil t)))
- ;; Fixup tag positioning
- (unless (= level 1)
- (and org-auto-align-tags (org-set-tags nil 'ignore-column))
- (if org-adapt-indentation (org-fixup-indentation (- diff))))
- (run-hooks 'org-after-promote-entry-hook)))
+ "Promote the current heading higher up the tree."
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let* ((after-change-functions (remq 'flyspell-after-change-function
+ after-change-functions))
+ (level (save-match-data (funcall outline-level)))
+ (up-head (concat (make-string (org-get-valid-level level -1) ?*) " "))
+ (diff (abs (- level (length up-head) -1))))
+ (cond
+ ((and (= level 1) org-allow-promoting-top-level-subtree)
+ (replace-match "# " nil t))
+ ((= level 1)
+ (user-error "Cannot promote to level 0. UNDO to recover if necessary"))
+ (t (replace-match up-head nil t)))
+ (unless (= level 1)
+ (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+ (when org-adapt-indentation (org-fixup-indentation (- diff))))
+ (run-hooks 'org-after-promote-entry-hook))))
(defun org-demote ()
- "Demote the current heading lower down the tree.
-If the region is active in `transient-mark-mode', demote all headings
-in the region."
- (org-back-to-heading t)
- (let* ((level (save-match-data (funcall outline-level)))
- (after-change-functions (remove 'flyspell-after-change-function
- after-change-functions))
- (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
- (diff (abs (- level (length down-head) -1))))
- (replace-match down-head nil t)
- ;; Fixup tag positioning
- (and org-auto-align-tags (org-set-tags nil 'ignore-column))
- (if org-adapt-indentation (org-fixup-indentation diff))
- (run-hooks 'org-after-demote-entry-hook)))
+ "Demote the current heading lower down the tree."
+ (org-with-wide-buffer
+ (org-back-to-heading t)
+ (let* ((after-change-functions (remq 'flyspell-after-change-function
+ after-change-functions))
+ (level (save-match-data (funcall outline-level)))
+ (down-head (concat (make-string (org-get-valid-level level 1) ?*) " "))
+ (diff (abs (- level (length down-head) -1))))
+ (replace-match down-head nil t)
+ (when org-auto-align-tags (org-set-tags nil 'ignore-column))
+ (when org-adapt-indentation (org-fixup-indentation diff))
+ (run-hooks 'org-after-demote-entry-hook))))
(defun org-cycle-level ()
"Cycle the level of an empty headline through possible states.
@@ -8036,32 +8148,32 @@ After top level, it switches back to sibling level."
(cond
;; If first headline in file, promote to top-level.
((= prev-level 0)
- (loop repeat (/ (- cur-level 1) (org-level-increment))
- do (org-do-promote)))
+ (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
+ do (org-do-promote)))
;; If same level as prev, demote one.
((= prev-level cur-level)
(org-do-demote))
;; If parent is top-level, promote to top level if not already.
((= prev-level 1)
- (loop repeat (/ (- cur-level 1) (org-level-increment))
- do (org-do-promote)))
+ (cl-loop repeat (/ (- cur-level 1) (org-level-increment))
+ do (org-do-promote)))
;; If top-level, return to prev-level.
((= cur-level 1)
- (loop repeat (/ (- prev-level 1) (org-level-increment))
- do (org-do-demote)))
+ (cl-loop repeat (/ (- prev-level 1) (org-level-increment))
+ do (org-do-demote)))
;; If less than prev-level, promote one.
((< cur-level prev-level)
(org-do-promote))
;; If deeper than prev-level, promote until higher than
;; prev-level.
((> cur-level prev-level)
- (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
- do (org-do-promote))))
+ (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment)))
+ do (org-do-promote))))
t))))
(defun org-map-tree (fun)
"Call FUN for every heading underneath the current one."
- (org-back-to-heading)
+ (org-back-to-heading t)
(let ((level (funcall outline-level)))
(save-excursion
(funcall fun)
@@ -8077,39 +8189,123 @@ After top level, it switches back to sibling level."
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
- (if (and (re-search-forward org-outline-regexp-bol nil t)
- (< (point) end))
- (funcall fun))
+ (when (and (re-search-forward org-outline-regexp-bol nil t)
+ (< (point) end))
+ (funcall fun))
(while (and (progn
(outline-next-heading)
(< (point) end))
(not (eobp)))
(funcall fun)))))
-(defvar org-property-end-re) ; silence byte-compiler
(defun org-fixup-indentation (diff)
"Change the indentation in the current entry by DIFF.
-However, if any line in the current entry has no indentation, or if it
-would end up with no indentation after the change, nothing at all is done."
- (save-excursion
- (let ((end (save-excursion (outline-next-heading)
- (point-marker)))
- (prohibit (if (> diff 0)
- "^\\S-"
- (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-")))
- col)
- (unless (save-excursion (end-of-line 1)
- (re-search-forward prohibit end t))
- (while (and (< (point) end)
- (re-search-forward "^[ \t]+" end t))
- (goto-char (match-end 0))
- (setq col (current-column))
- (if (< diff 0) (replace-match ""))
- (org-indent-to-column (+ diff col))))
- (move-marker end nil))))
+
+DIFF is an integer. Indentation is done according to the
+following rules:
+
+ - Planning information and property drawers are always indented
+ according to the new level of the headline;
+
+ - Footnote definitions and their contents are ignored;
+
+ - Inlinetasks' boundaries are not shifted;
+
+ - Empty lines are ignored;
+
+ - Other lines' indentation are shifted by DIFF columns, unless
+ it would introduce a structural change in the document, in
+ which case no shifting is done at all.
+
+Assume point is at a heading or an inlinetask beginning."
+ (org-with-wide-buffer
+ (narrow-to-region (line-beginning-position)
+ (save-excursion
+ (if (org-with-limited-levels (org-at-heading-p))
+ (org-with-limited-levels (outline-next-heading))
+ (org-inlinetask-goto-end))
+ (point)))
+ (forward-line)
+ ;; Indent properly planning info and property drawer.
+ (when (looking-at-p org-planning-line-re)
+ (org-indent-line)
+ (forward-line))
+ (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))))
+ (catch 'no-shift
+ (when (zerop diff) (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.
+ (let ((case-fold-search t))
+ (when (< diff 0)
+ (let ((diff (- diff))
+ (forbidden-re (concat org-outline-regexp
+ "\\|"
+ (substring org-footnote-definition-re 1))))
+ (save-excursion
+ (while (not (eobp))
+ (cond
+ ((looking-at-p "[ \t]*$") (forward-line))
+ ((and (looking-at-p org-footnote-definition-re)
+ (let ((e (org-element-at-point)))
+ (and (eq (org-element-type e) 'footnote-definition)
+ (goto-char (org-element-property :end e))))))
+ ((looking-at-p org-outline-regexp) (forward-line))
+ ;; Give up if shifting would move before column 0 or
+ ;; if it would introduce a headline or a footnote
+ ;; definition.
+ (t
+ (skip-chars-forward " \t")
+ (let ((ind (current-column)))
+ (when (or (< ind diff)
+ (and (= ind diff) (looking-at-p forbidden-re)))
+ (throw 'no-shift nil)))
+ ;; Ignore contents of example blocks and source
+ ;; blocks if their indentation is meant to be
+ ;; preserved. Jump to block's closing line.
+ (beginning-of-line)
+ (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
+ (let ((e (org-element-at-point)))
+ (and (memq (org-element-type e)
+ '(example-block src-block))
+ (or org-src-preserve-indentation
+ (org-element-property :preserve-indent e))
+ (goto-char (org-element-property :end e))
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ t))))
+ (forward-line))))))))
+ ;; Shift lines but footnote definitions, inlinetasks boundaries
+ ;; by DIFF. Also skip contents of source or example blocks
+ ;; when indentation is meant to be preserved.
+ (while (not (eobp))
+ (cond
+ ((and (looking-at-p org-footnote-definition-re)
+ (let ((e (org-element-at-point)))
+ (and (eq (org-element-type e) 'footnote-definition)
+ (goto-char (org-element-property :end e))))))
+ ((looking-at-p org-outline-regexp) (forward-line))
+ ((looking-at-p "[ \t]*$") (forward-line))
+ (t
+ (indent-line-to (+ (org-get-indentation) diff))
+ (beginning-of-line)
+ (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)")
+ (let ((e (org-element-at-point)))
+ (and (memq (org-element-type e)
+ '(example-block src-block))
+ (or org-src-preserve-indentation
+ (org-element-property :preserve-indent e))
+ (goto-char (org-element-property :end e))
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ t))))
+ (forward-line)))))))))
(defun org-convert-to-odd-levels ()
- "Convert an org-mode file with all levels allowed to one with odd levels.
+ "Convert an Org file with all levels allowed to one with odd levels.
This will leave level 1 alone, convert level 2 to level 3, level 3 to
level 5 etc."
(interactive)
@@ -8125,7 +8321,7 @@ level 5 etc."
(end-of-line 1))))))
(defun org-convert-to-oddeven-levels ()
- "Convert an org-mode file with only odd levels to one with odd/even levels.
+ "Convert an Org file with only odd levels to one with odd/even levels.
This promotes level 3 to level 2, level 5 to level 3 etc. If the
file contains a section with an even level, conversion would
destroy the structure of the file. An error is signaled in this
@@ -8134,7 +8330,7 @@ case."
(goto-char (point-min))
;; First check if there are no even levels
(when (re-search-forward "^\\(\\*\\*\\)+ " nil t)
- (org-show-context t)
+ (org-show-set-visibility 'canonical)
(error "Not all levels are odd in this file. Conversion not possible"))
(when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ")
(let ((outline-regexp org-outline-regexp)
@@ -8177,7 +8373,7 @@ case."
(setq beg (point)))
(save-match-data
(save-excursion (outline-end-of-heading)
- (setq folded (outline-invisible-p)))
+ (setq folded (org-invisible-p)))
(progn (org-end-of-subtree nil t)
(unless (eobp) (backward-char))))
(outline-next-heading)
@@ -8196,12 +8392,12 @@ case."
(progn (goto-char beg0)
(user-error "Cannot move past superior level or buffer limit")))
(setq cnt (1- cnt)))
- (if (> arg 0)
- ;; Moving forward - still need to move over subtree
- (progn (org-end-of-subtree t t)
- (save-excursion
- (org-back-over-empty-lines)
- (or (bolp) (newline)))))
+ (when (> arg 0)
+ ;; Moving forward - still need to move over subtree
+ (org-end-of-subtree t t)
+ (save-excursion
+ (org-back-over-empty-lines)
+ (or (bolp) (newline))))
(setq ne-ins (org-back-over-empty-lines))
(move-marker ins-point (point))
(setq txt (buffer-substring beg end))
@@ -8230,9 +8426,9 @@ case."
(insert (make-string (- ne-ins ne-beg) ?\n)))
(move-marker ins-point nil)
(if folded
- (hide-subtree)
+ (outline-hide-subtree)
(org-show-entry)
- (show-children)
+ (org-show-children)
(org-cycle-hide-drawers 'children))
(org-clean-visibility-after-subtree-move)
;; move back to the initial column we were at
@@ -8264,7 +8460,7 @@ of some markers in the region, even if CUT is non-nil. This is
useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(interactive "p")
(let (beg end folded (beg0 (point)))
- (if (org-called-interactively-p 'any)
+ (if (called-interactively-p 'any)
(org-back-to-heading nil) ; take what looks like a subtree
(org-back-to-heading t)) ; take what is really there
(setq beg (point))
@@ -8273,11 +8469,14 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(if nosubtrees
(outline-next-heading)
(save-excursion (outline-end-of-heading)
- (setq folded (outline-invisible-p)))
- (condition-case nil
- (org-forward-heading-same-level (1- n) t)
- (error nil))
+ (setq folded (org-invisible-p)))
+ (ignore-errors (org-forward-heading-same-level (1- n) t))
(org-end-of-subtree t t)))
+ ;; Include the end of an inlinetask
+ (when (and (featurep 'org-inlinetask)
+ (looking-at-p (concat (org-inlinetask-outline-regexp)
+ "END[ \t]*$")))
+ (end-of-line))
(setq end (point))
(goto-char beg0)
(when (> end beg)
@@ -8290,7 +8489,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut."
(if cut "Cut" "Copied")
(length org-subtree-clip)))))
-(defun org-paste-subtree (&optional level tree for-yank)
+(defun org-paste-subtree (&optional level tree for-yank remove)
"Paste the clipboard as a subtree, with modification of headline level.
The entire subtree is promoted or demoted in order to match a new headline
level.
@@ -8313,15 +8512,17 @@ If optional TREE is given, use this text instead of the kill ring.
When FOR-YANK is set, this is called by `org-yank'. In this case, do not
move back over whitespace before inserting, and move point to the end of
-the inserted text when done."
+the inserted text when done.
+
+When REMOVE is non-nil, remove the subtree from the clipboard."
(interactive "P")
(setq tree (or tree (and kill-ring (current-kill 0))))
(unless (org-kill-is-subtree-p tree)
(user-error "%s"
- (substitute-command-keys
- "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
+ (substitute-command-keys
+ "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway")))
(org-with-limited-levels
- (let* ((visp (not (outline-invisible-p)))
+ (let* ((visp (not (org-invisible-p)))
(txt tree)
(^re_ "\\(\\*+\\)[ \t]*")
(old-level (if (string-match org-outline-regexp-bol txt)
@@ -8364,22 +8565,22 @@ the inserted text when done."
(org-odd-levels-only nil)
beg end newend)
;; Remove the forced level indicator
- (if force-level
- (delete-region (point-at-bol) (point)))
+ (when force-level
+ (delete-region (point-at-bol) (point)))
;; Paste
(beginning-of-line (if (bolp) 1 2))
(setq beg (point))
(and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
(insert-before-markers txt)
- (unless (string-match "\n\\'" txt) (insert "\n"))
+ (unless (string-suffix-p "\n" txt) (insert "\n"))
(setq newend (point))
(org-reinstall-markers-in-region beg)
(setq end (point))
(goto-char beg)
(skip-chars-forward " \t\n\r")
(setq beg (point))
- (if (and (outline-invisible-p) visp)
- (save-excursion (outline-show-heading)))
+ (when (and (org-invisible-p) visp)
+ (save-excursion (outline-show-heading)))
;; Shift if necessary
(unless (= shift 0)
(save-restriction
@@ -8389,15 +8590,16 @@ the inserted text when done."
(setq shift (+ delta shift)))
(goto-char (point-min))
(setq newend (point-max))))
- (when (or (org-called-interactively-p 'interactive) for-yank)
+ (when (or (called-interactively-p 'interactive) for-yank)
(message "Clipboard pasted as level %d subtree" new-level))
- (if (and (not for-yank) ; in this case, org-yank will decide about folding
- kill-ring
- (eq org-subtree-clip (current-kill 0))
- org-subtree-clip-folded)
- ;; The tree was folded before it was killed/copied
- (hide-subtree))
- (and for-yank (goto-char newend)))))
+ (when (and (not for-yank) ; in this case, org-yank will decide about folding
+ kill-ring
+ (eq org-subtree-clip (current-kill 0))
+ org-subtree-clip-folded)
+ ;; The tree was folded before it was killed/copied
+ (outline-hide-subtree))
+ (and for-yank (goto-char newend))
+ (and remove (setq kill-ring (cdr kill-ring))))))
(defun org-kill-is-subtree-p (&optional txt)
"Check if the current kill is an outline subtree, or a set of trees.
@@ -8447,15 +8649,14 @@ called immediately, to move the markers with the entries."
"Check if MARKER is between BEG and END.
If yes, remember the marker and the distance to BEG."
(when (and (marker-buffer marker)
- (equal (marker-buffer marker) (current-buffer)))
- (if (and (>= marker beg) (< marker end))
- (push (cons marker (- marker beg)) org-markers-to-move))))
+ (equal (marker-buffer marker) (current-buffer))
+ (>= marker beg) (< marker end))
+ (push (cons marker (- marker beg)) org-markers-to-move)))
(defun org-reinstall-markers-in-region (beg)
"Move all remembered markers to their position relative to BEG."
- (mapc (lambda (x)
- (move-marker (car x) (+ beg (cdr x))))
- org-markers-to-move)
+ (dolist (x org-markers-to-move)
+ (move-marker (car x) (+ beg (cdr x))))
(setq org-markers-to-move nil))
(defun org-narrow-to-subtree ()
@@ -8467,7 +8668,7 @@ If yes, remember the marker and the distance to BEG."
(narrow-to-region
(progn (org-back-to-heading t) (point))
(progn (org-end-of-subtree t t)
- (if (and (org-at-heading-p) (not (eobp))) (backward-char 1))
+ (when (and (org-at-heading-p) (not (eobp))) (backward-char 1))
(point)))))))
(defun org-narrow-to-block ()
@@ -8480,10 +8681,6 @@ If yes, remember the marker and the distance to BEG."
(narrow-to-region (car blockp) (cdr blockp))
(user-error "Not in a block"))))
-(eval-when-compile
- (defvar org-property-drawer-re))
-
-(defvar org-property-start-re) ;; defined below
(defun org-clone-subtree-with-time-shift (n &optional shift)
"Clone the task (subtree) at point N times.
The clones will be inserted as siblings.
@@ -8500,6 +8697,9 @@ stamps in the subtree shifted for each clone produced. If SHIFT
is nil or the empty string, time stamps will be left alone. The
ID property of the original subtree is removed.
+In each clone, all the CLOCK entries will be removed. This
+prevents Org from considering that the clocked times overlap.
+
If the original subtree did contain time stamps with a repeater,
the following will happen:
- the repeater will be removed in each clone
@@ -8510,107 +8710,109 @@ the following will happen:
- the start days in the repeater in the original entry will be shifted
to past the last clone.
In this way you can spell out a number of instances of a repeating task,
-and still retain the repeater to cover future instances of the task."
+and still retain the repeater to cover future instances of the task.
+
+As described above, N+1 clones are produced when the original
+subtree has a repeater. Setting N to 0, then, can be used to
+remove the repeater from a subtree and create a shifted clone
+with the original repeater."
(interactive "nNumber of clones to produce: ")
- (let ((shift
- (or shift
- (if (and (not (equal current-prefix-arg '(4)))
- (save-excursion
- (re-search-forward org-ts-regexp-both
- (save-excursion
- (org-end-of-subtree t)
- (point)) t)))
- (read-from-minibuffer
- "Date shift per clone (e.g. +1w, empty to copy unchanged): ")
- ""))) ;; No time shift
- (n-no-remove -1)
- (drawer-re org-drawer-regexp)
- beg end template task idprop
- shift-n shift-what doshift nmin nmax)
- (if (not (and (integerp n) (> n 0)))
- (error "Invalid number of replications %s" n))
- (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift)))
- (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'"
- shift)))
- (error "Invalid shift specification %s" shift))
- (when doshift
- (setq shift-n (string-to-number (match-string 1 shift))
- shift-what (cdr (assoc (match-string 2 shift)
- '(("d" . day) ("w" . week)
- ("m" . month) ("y" . year))))))
- (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day))
- (setq nmin 1 nmax n)
- (org-back-to-heading t)
- (setq beg (point))
- (setq idprop (org-entry-get nil "ID"))
- (org-end-of-subtree t t)
- (or (bolp) (insert "\n"))
- (setq end (point))
- (setq template (buffer-substring beg end))
- (when (and doshift
- (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template))
- (delete-region beg end)
- (setq end beg)
- (setq nmin 0 nmax (1+ nmax) n-no-remove nmax))
- (goto-char end)
- (loop for n from nmin to nmax do
- ;; prepare clone
- (with-temp-buffer
- (insert template)
- (org-mode)
- (goto-char (point-min))
- (org-show-subtree)
- (and idprop (if org-clone-delete-id
- (org-entry-delete nil "ID")
- (org-id-get-create t)))
- (unless (= n 0)
- (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t)
- (kill-whole-line))
- (goto-char (point-min))
- (while (re-search-forward drawer-re nil t)
- (mapc (lambda (d)
- (org-remove-empty-drawer-at d (point)))
- org-drawers)))
- (goto-char (point-min))
- (when doshift
- (while (re-search-forward org-ts-regexp-both nil t)
- (org-timestamp-change (* n shift-n) shift-what))
- (unless (= n n-no-remove)
- (goto-char (point-min))
- (while (re-search-forward org-ts-regexp nil t)
- (save-excursion
- (goto-char (match-beginning 0))
- (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
- (delete-region (match-beginning 1) (match-end 1)))))))
- (setq task (buffer-string)))
- (insert task))
+ (unless (wholenump n) (user-error "Invalid number of replications %s" n))
+ (when (org-before-first-heading-p) (user-error "No subtree to clone"))
+ (let* ((beg (save-excursion (org-back-to-heading t) (point)))
+ (end-of-tree (save-excursion (org-end-of-subtree t t) (point)))
+ (shift
+ (or shift
+ (if (and (not (equal current-prefix-arg '(4)))
+ (save-excursion
+ (goto-char beg)
+ (re-search-forward org-ts-regexp-both end-of-tree t)))
+ (read-from-minibuffer
+ "Date shift per clone (e.g. +1w, empty to copy unchanged): ")
+ ""))) ;No time shift
+ (doshift
+ (and (org-string-nw-p shift)
+ (or (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'"
+ shift)
+ (user-error "Invalid shift specification %s" shift)))))
+ (goto-char end-of-tree)
+ (unless (bolp) (insert "\n"))
+ (let* ((end (point))
+ (template (buffer-substring beg end))
+ (shift-n (and doshift (string-to-number (match-string 1 shift))))
+ (shift-what (pcase (and doshift (match-string 2 shift))
+ (`nil nil)
+ ("d" 'day)
+ ("w" (setq shift-n (* 7 shift-n)) 'day)
+ ("m" 'month)
+ ("y" 'year)
+ (_ (error "Unsupported time unit"))))
+ (nmin 1)
+ (nmax n)
+ (n-no-remove -1)
+ (idprop (org-entry-get nil "ID")))
+ (when (and doshift
+ (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>"
+ template))
+ (delete-region beg end)
+ (setq end beg)
+ (setq nmin 0)
+ (setq nmax (1+ nmax))
+ (setq n-no-remove nmax))
+ (goto-char end)
+ (cl-loop for n from nmin to nmax do
+ (insert
+ ;; Prepare clone.
+ (with-temp-buffer
+ (insert template)
+ (org-mode)
+ (goto-char (point-min))
+ (org-show-subtree)
+ (and idprop (if org-clone-delete-id
+ (org-entry-delete nil "ID")
+ (org-id-get-create t)))
+ (unless (= n 0)
+ (while (re-search-forward org-clock-line-re nil t)
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (goto-char (point-min))
+ (while (re-search-forward org-drawer-regexp nil t)
+ (org-remove-empty-drawer-at (point))))
+ (goto-char (point-min))
+ (when doshift
+ (while (re-search-forward org-ts-regexp-both nil t)
+ (org-timestamp-change (* n shift-n) shift-what))
+ (unless (= n n-no-remove)
+ (goto-char (point-min))
+ (while (re-search-forward org-ts-regexp nil t)
+ (save-excursion
+ (goto-char (match-beginning 0))
+ (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)")
+ (delete-region (match-beginning 1) (match-end 1)))))))
+ (buffer-string)))))
(goto-char beg)))
;;; Outline Sorting
-(defun org-sort (with-case)
+(defun org-sort (&optional with-case)
"Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'.
Optional argument WITH-CASE means sort case-sensitively."
(interactive "P")
- (cond
- ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case))
- ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case))
- (t
- (org-call-with-arg 'org-sort-entries with-case))))
+ (org-call-with-arg
+ (cond ((org-at-table-p) #'org-table-sort-lines)
+ ((org-at-item-p) #'org-sort-list)
+ (t #'org-sort-entries))
+ with-case))
(defun org-sort-remove-invisible (s)
- "Remove invisible links from string S."
+ "Remove invisible part of links and emphasis markers from string S."
(remove-text-properties 0 (length s) org-rm-props s)
- (while (string-match org-bracket-link-regexp s)
- (setq s (replace-match (if (match-end 2)
- (match-string 3 s)
- (match-string 1 s))
- t t s)))
- (let ((st (format " %s " s)))
- (while (string-match org-emph-re st)
- (setq st (replace-match (format " %s " (match-string 4 st)) t t st)))
- (setq s (substring st 1 -1)))
- s)
+ (replace-regexp-in-string
+ org-verbatim-re (lambda (m) (format "%s " (match-string 4 m)))
+ (replace-regexp-in-string
+ org-emph-re (lambda (m) (format " %s " (match-string 4 m)))
+ (org-link-display-format s)
+ t t) t t))
(defvar org-priority-regexp) ; defined later in the file
@@ -8621,7 +8823,8 @@ hook gets called. When a region or a plain list is sorted, the cursor
will be in the first entry of the sorted region/list.")
(defun org-sort-entries
- (&optional with-case sorting-type getkey-func compare-func property)
+ (&optional with-case sorting-type getkey-func compare-func property
+ interactive?)
"Sort entries on a certain level of an outline tree.
If there is an active region, the entries in the region are sorted.
Else, if the cursor is before the first entry, sort the top-level items.
@@ -8632,42 +8835,41 @@ a time stamp, by a property, by priority order, or by a custom function.
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 ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F). Here is the
-precise meaning of each character:
+\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is
+the precise meaning of each character:
-n Numerically, by converting the beginning of the entry/item to a number.
a Alphabetically, ignoring the TODO keyword and the priority, if any.
-o By order of TODO keywords.
-t By date/time, either the first active time stamp in the entry, or, if
- none exist, by the first inactive one.
-s By the scheduled date/time.
-d By deadline date/time.
c By creation time, which is assumed to be the first inactive time stamp
at the beginning of a line.
+d By deadline date/time.
+k By clocking time.
+n Numerically, by converting the beginning of the entry/item to a number.
+o By order of TODO keywords.
p By priority according to the cookie.
r By the value of a property.
+s By scheduled date/time.
+t By date/time, either the first active time stamp in the entry, or, if
+ none exist, by the first inactive one.
Capital letters will reverse the sort order.
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be
-called with point at the beginning of the record. It must return either
-a string or a number that should serve as the sorting key for that record.
+called with point at the beginning of the record. It must return a
+value that is compatible with COMPARE-FUNC, the function used to
+compare entries.
Comparing entries ignores case by default. However, with an optional argument
WITH-CASE, the sorting considers case as well.
Sorting is done against the visible part of the headlines, it ignores hidden
-links."
- (interactive "P")
+links.
+
+When sorting is done, call `org-after-sorting-entries-or-items-hook'.
+
+A non-nil value for INTERACTIVE? is used to signal that this
+function is being called interactively."
+ (interactive (list current-prefix-arg nil nil nil nil t))
(let ((case-func (if with-case 'identity 'downcase))
- (cmstr
- ;; The clock marker is lost when using `sort-subr', let's
- ;; store the clocking string.
- (when (equal (marker-buffer org-clock-marker) (current-buffer))
- (save-excursion
- (goto-char org-clock-marker)
- (buffer-substring-no-properties (line-beginning-position)
- (point)))))
start beg end stars re re2
txt what tmp)
;; Find beginning and end of region to sort
@@ -8677,10 +8879,10 @@ links."
(setq end (region-end)
what "region")
(goto-char (region-beginning))
- (if (not (org-at-heading-p)) (outline-next-heading))
+ (unless (org-at-heading-p) (outline-next-heading))
(setq start (point)))
((or (org-at-heading-p)
- (condition-case nil (progn (org-back-to-heading) t) (error nil)))
+ (ignore-errors (progn (org-back-to-heading) t)))
;; we will sort the children of the current headline
(org-back-to-heading)
(setq start (point)
@@ -8691,7 +8893,7 @@ links."
(point))
what "children")
(goto-char start)
- (show-subtree)
+ (outline-show-subtree)
(outline-next-heading))
(t
;; we will sort the top-level entries in this file
@@ -8707,7 +8909,7 @@ links."
(setq end (point-max))
(setq what "top-level")
(goto-char start)
- (show-all)))
+ (outline-show-all)))
(setq beg (point))
(when (>= beg end) (goto-char start) (user-error "Nothing to sort"))
@@ -8717,39 +8919,52 @@ links."
re (concat "^" (regexp-quote stars) " +")
re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]")
txt (buffer-substring beg end))
- (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n")))
- (if (and (not (equal stars "*")) (string-match re2 txt))
- (user-error "Region to sort contains a level above the first entry"))
+ (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n")))
+ (when (and (not (equal stars "*")) (string-match re2 txt))
+ (user-error "Region to sort contains a level above the first entry"))
(unless sorting-type
(message
"Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc
- [t]ime [s]cheduled [d]eadline [c]reated
- A/N/P/R/O/F/T/S/D/C means reversed:"
+ [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing
+ A/N/P/R/O/F/T/S/D/C/K means reversed:"
what)
- (setq sorting-type (read-char-exclusive))
-
- (unless getkey-func
- (and (= (downcase sorting-type) ?f)
- (setq getkey-func
- (org-icompleting-read "Sort using function: "
- obarray 'fboundp t nil nil))
- (setq getkey-func (intern getkey-func))))
-
- (and (= (downcase sorting-type) ?r)
- (not property)
- (setq property
- (org-icompleting-read "Property: "
- (mapcar 'list (org-buffer-property-keys t))
- nil t))))
-
+ (setq sorting-type (read-char-exclusive)))
+
+ (unless getkey-func
+ (and (= (downcase sorting-type) ?f)
+ (setq getkey-func
+ (or (and interactive?
+ (org-read-function
+ "Function for extracting keys: "))
+ (error "Missing key extractor")))))
+
+ (and (= (downcase sorting-type) ?r)
+ (not property)
+ (setq property
+ (completing-read "Property: "
+ (mapcar #'list (org-buffer-property-keys t))
+ nil t)))
+
+ (when (member sorting-type '(?k ?K)) (org-clock-sum))
(message "Sorting entries...")
(save-restriction
(narrow-to-region start end)
- (let ((dcst (downcase sorting-type))
+ (let ((restore-clock?
+ ;; The clock marker is lost when using `sort-subr'; mark
+ ;; the clock with temporary `:org-clock-marker-backup'
+ ;; text property.
+ (when (and (eq (org-clock-is-active) (current-buffer))
+ (<= start (marker-position org-clock-marker))
+ (>= end (marker-position org-clock-marker)))
+ (org-with-silent-modifications
+ (put-text-property (1- org-clock-marker) org-clock-marker
+ :org-clock-marker-backup t))
+ t))
+ (dcst (downcase sorting-type))
(case-fold-search nil)
- (now (current-time)))
+ (now (current-time)))
(sort-subr
(/= dcst sorting-type)
;; This function moves to the beginning character of the "record" to
@@ -8777,6 +8992,8 @@ links."
(if (looking-at org-complex-heading-regexp)
(funcall case-func (org-sort-remove-invisible (match-string 4)))
nil))
+ ((= dcst ?k)
+ (or (get-text-property (point) :org-clock-minutes) 0))
((= dcst ?t)
(let ((end (save-excursion (outline-next-heading) (point))))
(if (or (re-search-forward org-ts-regexp end t)
@@ -8807,85 +9024,50 @@ links."
((= dcst ?r)
(or (org-entry-get nil property) ""))
((= dcst ?o)
- (if (looking-at org-complex-heading-regexp)
- (- 9999 (length (member (match-string 2)
- org-todo-keywords-1)))))
+ (when (looking-at org-complex-heading-regexp)
+ (let* ((m (match-string 2))
+ (s (if (member m org-done-keywords) '- '+)))
+ (- 99 (funcall s (length (member m org-todo-keywords-1)))))))
((= dcst ?f)
(if getkey-func
(progn
(setq tmp (funcall getkey-func))
- (if (stringp tmp) (setq tmp (funcall case-func tmp)))
+ (when (stringp tmp) (setq tmp (funcall case-func tmp)))
tmp)
(error "Invalid key function `%s'" getkey-func)))
(t (error "Invalid sorting type `%c'" sorting-type))))
nil
(cond
((= dcst ?a) 'string<)
- ((= dcst ?f) compare-func)
- ((member dcst '(?p ?t ?s ?d ?c)) '<)))))
+ ((= dcst ?f)
+ (or compare-func
+ (and interactive?
+ (org-read-function
+ (concat "Function for comparing keys "
+ "(empty for default `sort-subr' predicate): ")
+ 'allow-empty))))
+ ((member dcst '(?p ?t ?s ?d ?c ?k)) '<)))
+ (when restore-clock?
+ (move-marker org-clock-marker
+ (1+ (next-single-property-change
+ start :org-clock-marker-backup)))
+ (remove-text-properties (1- org-clock-marker) org-clock-marker
+ '(:org-clock-marker-backup t)))))
(run-hooks 'org-after-sorting-entries-or-items-hook)
- ;; Reset the clock marker if needed
- (when cmstr
- (save-excursion
- (goto-char start)
- (search-forward cmstr nil t)
- (move-marker org-clock-marker (point))))
(message "Sorting entries...done")))
-(defun org-do-sort (table what &optional with-case sorting-type)
- "Sort TABLE of WHAT according to SORTING-TYPE.
-The user will be prompted for the SORTING-TYPE if the call to this
-function does not specify it. WHAT is only for the prompt, to indicate
-what is being sorted. The sorting key will be extracted from
-the car of the elements of the table.
-If WITH-CASE is non-nil, the sorting will be case-sensitive."
- (unless sorting-type
- (message
- "Sort %s: [a]lphabetic, [n]umeric, [t]ime. A/N/T means reversed:"
- what)
- (setq sorting-type (read-char-exclusive)))
- (let ((dcst (downcase sorting-type))
- extractfun comparefun)
- ;; Define the appropriate functions
- (cond
- ((= dcst ?n)
- (setq extractfun 'string-to-number
- comparefun (if (= dcst sorting-type) '< '>)))
- ((= dcst ?a)
- (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x))
- (lambda(x) (downcase (org-sort-remove-invisible x))))
- comparefun (if (= dcst sorting-type)
- 'string<
- (lambda (a b) (and (not (string< a b))
- (not (string= a b)))))))
- ((= dcst ?t)
- (setq extractfun
- (lambda (x)
- (if (or (string-match org-ts-regexp x)
- (string-match org-ts-regexp-both x))
- (float-time
- (org-time-string-to-time (match-string 0 x)))
- 0))
- comparefun (if (= dcst sorting-type) '< '>)))
- (t (error "Invalid sorting type `%c'" sorting-type)))
-
- (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x)))
- table)
- (lambda (a b) (funcall comparefun (car a) (car b))))))
-
-
;;; The orgstruct minor mode
;; Define a minor mode which can be used in other modes in order to
-;; integrate the org-mode structure editing commands.
+;; integrate the Org mode structure editing commands.
-;; This is really a hack, because the org-mode structure commands use
+;; This is really a hack, because the Org mode structure commands use
;; keys which normally belong to the major mode. Here is how it
;; works: The minor mode defines all the keys necessary to operate the
;; structure commands, but wraps the commands into a function which
;; tests if the cursor is currently at a headline or a plain list
;; item. If that is the case, the structure command is used,
-;; temporarily setting many Org-mode variables like regular
+;; temporarily setting many Org mode variables like regular
;; expressions for filling etc. However, when any of those keys is
;; used at a different location, function uses `key-binding' to look
;; up if the key has an associated command in another currently active
@@ -8897,7 +9079,7 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive."
"Regexp that matches the custom prefix of Org headlines in
orgstruct(++)-mode."
:group 'org
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'regexp)
;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp)
@@ -8917,10 +9099,10 @@ orgstruct(++)-mode."
;;;###autoload
(define-minor-mode orgstruct-mode
"Toggle the minor mode `orgstruct-mode'.
-This mode is for using Org-mode structure commands in other
-modes. The following keys behave as if Org-mode were active, if
+This mode is for using Org mode structure commands in other
+modes. The following keys behave as if Org mode were active, if
the cursor is on a headline, or on a plain list item (both as
-defined by Org-mode)."
+defined by Org mode)."
nil " OrgStruct" (make-sparse-keymap)
(funcall (if orgstruct-mode
'add-to-invisibility-spec
@@ -8937,40 +9119,38 @@ defined by Org-mode)."
"Unconditionally turn on `orgstruct-mode'."
(orgstruct-mode 1))
-(defvar org-fb-vars nil)
-(make-variable-buffer-local 'org-fb-vars)
+(defvar-local orgstruct-is-++ nil
+ "Is `orgstruct-mode' in ++ version in the current-buffer?")
+(defvar-local org-fb-vars nil)
(defun orgstruct++-mode (&optional arg)
"Toggle `orgstruct-mode', the enhanced version of it.
In addition to setting orgstruct-mode, this also exports all
-indentation and autofilling variables from org-mode into the
+indentation and autofilling variables from Org mode into the
buffer. It will also recognize item context in multiline items."
(interactive "P")
(setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))))
(if (< arg 1)
(progn (orgstruct-mode -1)
- (mapc (lambda(v)
- (org-set-local (car v)
- (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v))))
- org-fb-vars))
+ (dolist (v org-fb-vars)
+ (set (make-local-variable (car v))
+ (if (eq (car-safe (cadr v)) 'quote)
+ (cl-cadadr v)
+ (nth 1 v)))))
(orgstruct-mode 1)
(setq org-fb-vars nil)
(unless org-local-vars
(setq org-local-vars (org-get-local-variables)))
(let (var val)
- (mapc
- (lambda (x)
- (when (string-match
- "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)"
- (symbol-name (car x)))
- (setq var (car x) val (nth 1 x))
- (push (list var `(quote ,(eval var))) org-fb-vars)
- (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val))))
- org-local-vars)
- (org-set-local 'orgstruct-is-++ t))))
-
-(defvar orgstruct-is-++ nil
- "Is `orgstruct-mode' in ++ version in the current-buffer?")
-(make-variable-buffer-local 'orgstruct-is-++)
+ (dolist (x org-local-vars)
+ (when (string-match
+ "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\
+\\|fill-prefix\\|indent-\\)"
+ (symbol-name (car x)))
+ (setq var (car x) val (nth 1 x))
+ (push (list var `(quote ,(eval var))) org-fb-vars)
+ (set (make-local-variable var)
+ (if (eq (car-safe val) 'quote) (nth 1 val) val))))
+ (setq-local orgstruct-is-++ t))))
;;;###autoload
(defun turn-on-orgstruct++ ()
@@ -8999,6 +9179,7 @@ buffer. It will also recognize item context in multiline items."
org-ctrl-c-minus
org-ctrl-c-star
org-cycle
+ org-force-cycle-archived
org-forward-heading-same-level
org-insert-heading
org-insert-heading-respect-content
@@ -9018,6 +9199,7 @@ buffer. It will also recognize item context in multiline items."
org-shifttab
org-shifttab
org-shiftup
+ org-show-children
org-show-subtree
org-sort
org-up-element
@@ -9025,8 +9207,7 @@ buffer. It will also recognize item context in multiline items."
outline-next-visible-heading
outline-previous-visible-heading
outline-promote
- outline-up-heading
- show-children))
+ outline-up-heading))
(let ((f (or (car-safe cell) cell))
(disable-when-heading-prefix (cdr-safe cell)))
(when (fboundp f)
@@ -9045,15 +9226,15 @@ buffer. It will also recognize item context in multiline items."
(regexp-quote (cdr rep))
(car rep)
(key-description binding)))))
- (pushnew binding new-bindings :test 'equal)))
+ (cl-pushnew binding new-bindings :test 'equal)))
(dolist (binding new-bindings)
(let ((key (lookup-key orgstruct-mode-map binding)))
(when (or (not key) (numberp key))
- (condition-case nil
- (org-defkey orgstruct-mode-map
- binding
- (orgstruct-make-binding f binding disable-when-heading-prefix))
- (error nil)))))))))
+ (ignore-errors
+ (org-defkey orgstruct-mode-map
+ binding
+ (orgstruct-make-binding
+ f binding disable-when-heading-prefix))))))))))
(run-hooks 'orgstruct-setup-hook))
(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
@@ -9152,9 +9333,9 @@ definitions."
;; normalize contexts
(mapcar
(lambda(c) (cond ((listp (cadr c))
- (list (car c) (car c) (cadr c)))
+ (list (car c) (car c) (nth 1 c)))
((string= "" (cadr c))
- (list (car c) (car c) (caddr c)))
+ (list (car c) (car c) (nth 2 c)))
(t c)))
contexts))
(a alist) r s)
@@ -9168,7 +9349,7 @@ definitions."
(setq vrules (org-contextualize-validate-key
(car c) contexts)))
(mapc (lambda (vr)
- (when (not (equal (car vr) (cadr vr)))
+ (unless (equal (car vr) (cadr vr))
(setq repl vr)))
vrules)
(if (not repl) (push c r)
@@ -9185,39 +9366,37 @@ definitions."
(delete-dups
(mapcar (lambda (x)
(let ((tpl (car x)))
- (when (not (delq
- nil
- (mapcar (lambda (y)
- (equal y tpl))
- s)))
+ (unless (delq
+ nil
+ (mapcar (lambda (y)
+ (equal y tpl))
+ s))
x)))
(reverse r))))))
(defun org-contextualize-validate-key (key contexts)
"Check CONTEXTS for agenda or capture KEY."
- (let (rr res)
+ (let (res)
(dolist (r contexts)
- (mapc
- (lambda (rr)
- (when
- (and (equal key (car r))
- (if (functionp rr) (funcall rr)
- (or (and (eq (car rr) 'in-file)
- (buffer-file-name)
- (string-match (cdr rr) (buffer-file-name)))
- (and (eq (car rr) 'in-mode)
- (string-match (cdr rr) (symbol-name major-mode)))
- (and (eq (car rr) 'in-buffer)
- (string-match (cdr rr) (buffer-name)))
- (when (and (eq (car rr) 'not-in-file)
- (buffer-file-name))
- (not (string-match (cdr rr) (buffer-file-name))))
- (when (eq (car rr) 'not-in-mode)
- (not (string-match (cdr rr) (symbol-name major-mode))))
- (when (eq (car rr) 'not-in-buffer)
- (not (string-match (cdr rr) (buffer-name)))))))
- (push r res)))
- (car (last r))))
+ (dolist (rr (car (last r)))
+ (when
+ (and (equal key (car r))
+ (if (functionp rr) (funcall rr)
+ (or (and (eq (car rr) 'in-file)
+ (buffer-file-name)
+ (string-match (cdr rr) (buffer-file-name)))
+ (and (eq (car rr) 'in-mode)
+ (string-match (cdr rr) (symbol-name major-mode)))
+ (and (eq (car rr) 'in-buffer)
+ (string-match (cdr rr) (buffer-name)))
+ (when (and (eq (car rr) 'not-in-file)
+ (buffer-file-name))
+ (not (string-match (cdr rr) (buffer-file-name))))
+ (when (eq (car rr) 'not-in-mode)
+ (not (string-match (cdr rr) (symbol-name major-mode))))
+ (when (eq (car rr) 'not-in-buffer)
+ (not (string-match (cdr rr) (buffer-name)))))))
+ (push r res))))
(delete-dups (delq nil res))))
(defun org-context-p (&rest contexts)
@@ -9235,45 +9414,11 @@ Possible values in the list of contexts are `table', `headline', and `item'."
(org-in-item-p)))
(goto-char pos))))
-(defun org-get-local-variables ()
- "Return a list of all local variables in an Org mode buffer."
- (let (varlist)
- (with-current-buffer (get-buffer-create "*Org tmp*")
- (erase-buffer)
- (org-mode)
- (setq varlist (buffer-local-variables)))
- (kill-buffer "*Org tmp*")
- (delq nil
- (mapcar
- (lambda (x)
- (setq x
- (if (symbolp x)
- (list x)
- (list (car x) (cdr x))))
- (if (and (not (get (car x) 'org-state))
- (string-match
- "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)"
- (symbol-name (car x))))
- x nil))
- varlist))))
-
-(defun org-clone-local-variables (from-buffer &optional regexp)
- "Clone local variables from FROM-BUFFER.
-Optional argument REGEXP selects variables to clone."
- (mapc
- (lambda (pair)
- (and (symbolp (car pair))
- (or (null regexp)
- (string-match regexp (symbol-name (car pair))))
- (set (make-local-variable (car pair))
- (cdr pair))))
- (buffer-local-variables from-buffer)))
-
;;;###autoload
(defun org-run-like-in-org-mode (cmd)
- "Run a command, pretending that the current buffer is in Org-mode.
+ "Run a command, pretending that the current buffer is in Org mode.
This will temporarily bind local variables that are typically bound in
-Org-mode to the values they have in Org-mode, and then interactively
+Org mode to the values they have in Org mode, and then interactively
call CMD."
(org-load-modules-maybe)
(unless org-local-vars
@@ -9287,67 +9432,119 @@ call CMD."
(eval `(let ,binds
(call-interactively (quote ,cmd))))))
-;;;; Archiving
-
(defun org-get-category (&optional pos force-refresh)
"Get the category applying to position POS."
(save-match-data
- (if force-refresh (org-refresh-category-properties))
+ (when force-refresh (org-refresh-category-properties))
(let ((pos (or pos (point))))
(or (get-text-property pos 'org-category)
(progn (org-refresh-category-properties)
(get-text-property pos 'org-category))))))
-(defun org-refresh-category-properties ()
- "Refresh category text properties in the buffer."
- (let ((case-fold-search t)
- (inhibit-read-only t)
- (def-cat (cond
- ((null org-category)
- (if buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- "???"))
- ((symbolp org-category) (symbol-name org-category))
- (t org-category)))
- beg end cat pos optionp)
- (org-with-silent-modifications
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (put-text-property (point) (point-max) 'org-category def-cat)
- (while (re-search-forward
- "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t)
- (setq pos (match-end 0)
- optionp (equal (char-after (match-beginning 0)) ?#)
- cat (org-trim (match-string 2)))
- (if optionp
- (setq beg (point-at-bol) end (point-max))
- (org-back-to-heading t)
- (setq beg (point) end (org-end-of-subtree t t)))
- (put-text-property beg end 'org-category cat)
- (put-text-property beg end 'org-category-position beg)
- (goto-char pos)))))))
+;;; Refresh properties
(defun org-refresh-properties (dprop tprop)
"Refresh buffer text properties.
-DPROP is the drawer property and TPROP is the corresponding text
-property to set."
- (let ((case-fold-search t)
- (inhibit-read-only t) p)
+DPROP is the drawer property and TPROP is either the
+corresponding text property to set, or an alist with each element
+being a text property (as a symbol) and a function to apply to
+the value of the drawer property."
+ (let* ((case-fold-search t)
+ (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))))
(org-with-silent-modifications
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t)
- (setq p (org-match-string-no-properties 1))
- (save-excursion
- (org-back-to-heading t)
- (put-text-property
- (point-at-bol) (or (outline-next-heading) (point-max)) tprop p))))))))
+ (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.
+ (while (re-search-forward property-re nil t)
+ (when (org-at-property-p)
+ (org-refresh-property tprop (org-entry-get (point) dprop) inherit?))
+ (outline-next-heading))))))
+
+(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))))))))
+(defun org-refresh-category-properties ()
+ "Refresh category text properties in the buffer."
+ (let ((case-fold-search t)
+ (inhibit-read-only t)
+ (default-category
+ (cond ((null org-category)
+ (if buffer-file-name
+ (file-name-sans-extension
+ (file-name-nondirectory buffer-file-name))
+ "???"))
+ ((symbolp org-category) (symbol-name org-category))
+ (t org-category))))
+ (org-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.
+ (put-text-property
+ (point-min) (point-max)
+ 'org-category
+ (catch 'buffer-category
+ (goto-char (point-max))
+ (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'keyword)
+ (throw 'buffer-category
+ (org-element-property :value element)))))
+ default-category))
+ ;; Set sub-tree specific categories.
+ (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))
+ 'org-category
+ value)))))))))
+
+(defun org-refresh-stats-properties ()
+ "Refresh stats text properties in the buffer."
+ (org-with-silent-modifications
+ (org-with-point-at 1
+ (let ((regexp (concat org-outline-regexp-bol
+ ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]")))
+ (while (re-search-forward regexp nil t)
+ (let* ((numerator (string-to-number (match-string 1)))
+ (denominator (and (match-end 2)
+ (string-to-number (match-string 2))))
+ (stats (cond ((not denominator) numerator) ;percent
+ ((= denominator 0) 0)
+ (t (/ (* numerator 100) denominator)))))
+ (put-text-property (point) (progn (org-end-of-subtree t t) (point))
+ 'org-stats stats)))))))
+
+(defun org-refresh-effort-properties ()
+ "Refresh effort properties"
+ (org-refresh-properties
+ org-effort-property
+ '((effort . identity)
+ (effort-minutes . org-duration-to-minutes))))
;;;; Link Stuff
@@ -9387,78 +9584,54 @@ property to set."
(defvar org-store-link-plist nil
"Plist with info about the most recently link created with `org-store-link'.")
-(defvar org-link-protocols nil
- "Link protocols added to Org-mode using `org-add-link-type'.")
+(defun org-store-link-functions ()
+ "Return a list of functions that are called to create and store a link.
+The functions defined in the :store property of
+`org-link-parameters'.
-(defvar org-store-link-functions nil
- "List of functions that are called to create and store a link.
Each function will be called in turn until one returns a non-nil
-value. Each function should check if it is responsible for creating
-this link (for example by looking at the major mode).
-If not, it must exit and return nil.
-If yes, it should return a non-nil value after a calling
-`org-store-link-props' with a list of properties and values.
-Special properties are:
+value. Each function should check if it is responsible for
+creating this link (for example by looking at the major mode).
+If not, it must exit and return nil. If yes, it should return
+a non-nil value after calling `org-store-link-props' with a list
+of properties and values. Special properties are:
:type The link prefix, like \"http\". This must be given.
:link The link, like \"http://www.astro.uva.nl/~dominik\".
This is obligatory as well.
:description Optional default description for the second pair
- of brackets in an Org-mode link. The user can still change
- this when inserting this link into an Org-mode buffer.
+ of brackets in an Org mode link. The user can still change
+ this when inserting this link into an Org mode buffer.
In addition to these, any additional properties can be specified
-and then used in capture templates.")
-
-(defun org-add-link-type (type &optional follow export)
- "Add TYPE to the list of `org-link-types'.
-Re-compute all regular expressions depending on `org-link-types'
-
-FOLLOW and EXPORT are two functions.
-
-FOLLOW should take the link path as the single argument and do whatever
-is necessary to follow the link, for example find a file or display
-a mail message.
-
-EXPORT should format the link path for export to one of the export formats.
-It should be a function accepting three arguments:
-
- path the path of the link, the text after the prefix (like \"http:\")
- desc the description of the link, if any, or a description added by
- org-export-normalize-links if there is none
- format the export format, a symbol like `html' or `latex' or `ascii'..
-
-The function may use the FORMAT information to return different values
-depending on the format. The return value will be put literally into
-the exported file. If the return value is nil, this means Org should
-do what it normally does with links which do not have EXPORT defined.
-
-Org-mode has a built-in default for exporting links. If you are happy with
-this default, there is no need to define an export function for the link
-type. For a simple example of an export function, see `org-bbdb.el'."
- (add-to-list 'org-link-types type t)
- (org-make-link-regexps)
- (if (assoc type org-link-protocols)
- (setcdr (assoc type org-link-protocols) (list follow export))
- (push (list type follow export) org-link-protocols)))
+and then used in capture templates."
+ (cl-loop for link in org-link-parameters
+ with store-func
+ do (setq store-func (org-link-get-parameter (car link) :store))
+ if store-func
+ collect store-func))
(defvar org-agenda-buffer-name) ; Defined in org-agenda.el
(defvar org-id-link-to-org-use-id) ; Defined in org-id.el
;;;###autoload
(defun org-store-link (arg)
- "\\<org-mode-map>Store an org-link to the current location.
+ "Store an org-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].
+into an Org buffer with `org-insert-link' (`\\[org-insert-link]').
-For some link types, a prefix arg is interpreted.
-For links to Usenet articles, arg negates `org-gnus-prefer-web-links'.
-For file links, arg negates `org-context-in-file-links'.
+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 double prefix arg force skipping storing functions that are not
-part of Org's core.
+A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \
+skipping storing functions that are not
+part of Org core.
-A triple prefix arg force storing a link for each line in the
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix ARG forces storing a link for each line in the
active region."
(interactive "P")
(org-load-modules-maybe)
@@ -9473,111 +9646,120 @@ active region."
(call-interactively 'org-store-link))
(move-beginning-of-line 2)
(set-mark (point)))))
- (org-with-limited-levels
- (setq org-store-link-plist nil)
- (let (link cpltxt desc description search
- txt custom-id agenda-link sfuns sfunsn)
- (cond
-
- ;; Store a link using an external link type
- ((and (not (equal arg '(16)))
- (setq sfuns
- (delq
- nil (mapcar (lambda (f)
- (let (fs) (if (funcall f) (push f fs))))
- org-store-link-functions))
- sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns))
- (or (and (cdr sfuns)
- (funcall (intern
- (completing-read
- "Which function for creating the link? "
- sfunsn nil t (car sfunsn)))))
- (funcall (caar sfuns)))
- (setq link (plist-get org-store-link-plist :link)
- desc (or (plist-get org-store-link-plist
- :description)
- link))))
-
- ;; Store a link from a source code buffer
- ((org-src-edit-buffer-p)
- (let (label gc)
- (while (or (not label)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (re-search-forward
- (regexp-quote (format org-coderef-label-format label))
- nil t))))
- (when label (message "Label exists already") (sit-for 2))
- (setq label (read-string "Code line label: " label)))
- (end-of-line 1)
- (setq link (format org-coderef-label-format label))
- (setq gc (- 79 (length link)))
- (if (< (current-column) gc) (org-move-to-column gc t) (insert " "))
- (insert link)
- (setq link (concat "(" label ")") desc nil)))
-
- ;; We are in the agenda, link to referenced location
- ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name))
- (let ((m (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-marker))))
- (when m
- (org-with-point-at m
- (setq agenda-link
- (if (org-called-interactively-p 'any)
- (call-interactively 'org-store-link)
- (org-store-link nil)))))))
-
- ((eq major-mode 'calendar-mode)
- (let ((cd (calendar-cursor-to-date)))
- (setq link
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time
- (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
- nil nil nil))))
- (org-store-link-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))))
- (org-store-link-props :type "help"))
-
- ((eq major-mode 'w3-mode)
- (setq cpltxt (if (and (buffer-name)
- (not (string-match "Untitled" (buffer-name))))
- (buffer-name)
- (url-view-url t))
- link (url-view-url t))
- (org-store-link-props :type "w3" :url (url-view-url t)))
-
- ((eq major-mode 'image-mode)
- (setq cpltxt (concat "file:"
- (abbreviate-file-name buffer-file-name))
- link cpltxt)
- (org-store-link-props :type "image" :file buffer-file-name))
-
- ;; In dired, store a link to the file of the current line
- ((eq major-mode 'dired-mode)
- (let ((file (dired-get-filename nil t)))
- (setq file (if file
- (abbreviate-file-name
- (expand-file-name (dired-get-filename nil t)))
- ;; otherwise, no file so use current directory.
- default-directory))
- (setq cpltxt (concat "file:" file)
- link cpltxt)))
-
- ((setq search (run-hook-with-args-until-success
- 'org-create-file-search-functions))
- (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
- "::" search))
- (setq cpltxt (or description link)))
-
- ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (setq org-store-link-plist nil)
+ (let (link cpltxt desc description search txt 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
+ ;; location, ask which one to use.
+ ((and (not (equal arg '(16)))
+ (let ((results-alist nil))
+ (dolist (f (org-store-link-functions))
+ (when (funcall f)
+ ;; XXX: return value is not link's plist, so we
+ ;; store the new value before it is modified. It
+ ;; would be cleaner to ask store link functions to
+ ;; return the plist instead.
+ (push (cons f (copy-sequence org-store-link-plist))
+ results-alist)))
+ (pcase results-alist
+ (`nil nil)
+ (`((,_ . ,_)) t) ;single choice: nothing to do
+ (`((,name . ,_) . ,_)
+ ;; Reinstate link plist associated to the chosen
+ ;; function.
+ (apply #'org-store-link-props
+ (cdr (assoc-string
+ (completing-read
+ "Which function for creating the link? "
+ (mapcar #'car results-alist) nil t name)
+ results-alist)))
+ t))))
+ (setq link (plist-get org-store-link-plist :link))
+ (setq desc (or (plist-get org-store-link-plist :description)
+ link)))
+
+ ;; Store a link from a source code buffer.
+ ((org-src-edit-buffer-p)
+ (let ((coderef-format (org-src-coderef-format)))
+ (cond ((save-excursion
+ (beginning-of-line)
+ (looking-at (org-src-coderef-regexp coderef-format)))
+ (setq link (format "(%s)" (match-string-no-properties 3))))
+ ((called-interactively-p 'any)
+ (let ((label (read-string "Code line label: ")))
+ (end-of-line)
+ (setq link (format coderef-format label))
+ (let ((gc (- 79 (length link))))
+ (if (< (current-column) gc)
+ (org-move-to-column gc t)
+ (insert " ")))
+ (insert link)
+ (setq link (concat "(" label ")"))
+ (setq desc nil)))
+ (t (setq link nil)))))
+
+ ;; We are in the agenda, link to referenced location
+ ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name))
+ (let ((m (or (get-text-property (point) 'org-hd-marker)
+ (get-text-property (point) 'org-marker))))
+ (when m
+ (org-with-point-at m
+ (setq agenda-link
+ (if (called-interactively-p 'any)
+ (call-interactively 'org-store-link)
+ (org-store-link nil)))))))
+
+ ((eq major-mode 'calendar-mode)
+ (let ((cd (calendar-cursor-to-date)))
+ (setq link
+ (format-time-string
+ (car org-time-stamp-formats)
+ (apply 'encode-time
+ (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd)
+ nil nil nil))))
+ (org-store-link-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))))
+ (org-store-link-props :type "help"))
+
+ ((eq major-mode 'w3-mode)
+ (setq cpltxt (if (and (buffer-name)
+ (not (string-match "Untitled" (buffer-name))))
+ (buffer-name)
+ (url-view-url t))
+ link (url-view-url t))
+ (org-store-link-props :type "w3" :url (url-view-url t)))
+
+ ((eq major-mode 'image-mode)
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name buffer-file-name))
+ link cpltxt)
+ (org-store-link-props :type "image" :file buffer-file-name))
+
+ ;; In dired, store a link to the file of the current line
+ ((derived-mode-p 'dired-mode)
+ (let ((file (dired-get-filename nil t)))
+ (setq file (if file
+ (abbreviate-file-name
+ (expand-file-name (dired-get-filename nil t)))
+ ;; otherwise, no file so use current directory.
+ default-directory))
+ (setq cpltxt (concat "file:" file)
+ link cpltxt)))
+
+ ((setq search (run-hook-with-args-until-success
+ 'org-create-file-search-functions))
+ (setq link (concat "file:" (abbreviate-file-name buffer-file-name)
+ "::" search))
+ (setq cpltxt (or description link)))
+
+ ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+ (org-with-limited-levels
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
(cond
;; Store a link using the target at point
@@ -9590,7 +9772,7 @@ active region."
link cpltxt))
((and (featurep 'org-id)
(or (eq org-id-link-to-org-use-id t)
- (and (org-called-interactively-p 'any)
+ (and (called-interactively-p 'any)
(or (eq org-id-link-to-org-use-id 'create-if-interactive)
(and (eq org-id-link-to-org-use-id
'create-if-interactive-and-no-custom-id)
@@ -9613,15 +9795,13 @@ active region."
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
;; Add a context search string
- (when (org-xor org-context-in-file-links arg)
- (let* ((ee (org-element-at-point))
- (et (org-element-type ee))
- (ev (plist-get (cadr ee) :value))
- (ek (plist-get (cadr ee) :key))
- (eok (and (stringp ek) (string-match "name" ek))))
+ (when (org-xor org-context-in-file-links
+ (equal arg '(4)))
+ (let* ((element (org-element-at-point))
+ (name (org-element-property :name element)))
(setq txt (cond
((org-at-heading-p) nil)
- ((and (eq et 'keyword) eok) ev)
+ (name)
((org-region-active-p)
(buffer-substring (region-beginning) (region-end)))))
(when (or (null txt) (string-match "\\S-" txt))
@@ -9630,74 +9810,82 @@ active region."
(condition-case nil
(org-make-org-heading-search-string txt)
(error "")))
- desc (or (and (eq et 'keyword) eok ev)
+ desc (or name
(nth 4 (ignore-errors (org-heading-components)))
"NONE")))))
- (if (string-match "::\\'" cpltxt)
- (setq cpltxt (substring cpltxt 0 -2)))
- (setq link cpltxt))))
-
- ((buffer-file-name (buffer-base-buffer))
- ;; Just link to this file here.
- (setq cpltxt (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))))
- ;; Add a context string.
- (when (org-xor org-context-in-file-links arg)
- (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-make-org-heading-search-string txt))
- desc "NONE")))
- (setq link cpltxt))
-
- ((org-called-interactively-p 'interactive)
- (user-error "No method for storing a link from this buffer"))
-
- (t (setq link nil)))
-
- ;; We're done setting link and desc, clean up
- (if (consp link) (setq cpltxt (car link) link (cdr link)))
- (setq link (or link cpltxt)
- desc (or desc cpltxt))
- (cond ((equal desc "NONE") (setq desc nil))
- ((and desc (string-match org-bracket-link-analytic-regexp desc))
- (let ((d0 (match-string 3 desc))
- (p0 (match-string 5 desc)))
- (setq desc
- (replace-regexp-in-string
- org-bracket-link-regexp
- (concat (or p0 d0)
- (if (equal (length (match-string 0 desc))
- (length desc)) "*" "")) desc)))))
-
- ;; Return the link
- (if (not (and (or (org-called-interactively-p 'any)
- executing-kbd-macro)
- link))
- (or agenda-link (and link (org-make-link-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))
- (car org-stored-links))))))
+ (when (string-match "::\\'" cpltxt)
+ (setq cpltxt (substring cpltxt 0 -2)))
+ (setq link cpltxt)))))
+
+ ((buffer-file-name (buffer-base-buffer))
+ ;; Just link to this file here.
+ (setq cpltxt (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ ;; Add a context string.
+ (when (org-xor org-context-in-file-links
+ (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-make-org-heading-search-string txt))
+ desc "NONE")))
+ (setq link cpltxt))
+
+ ((called-interactively-p 'interactive)
+ (user-error "No method for storing a link from this buffer"))
+
+ (t (setq link nil)))
+
+ ;; We're done setting link and desc, clean up
+ (when (consp link) (setq cpltxt (car link) link (cdr link)))
+ (setq link (or link cpltxt)
+ desc (or desc cpltxt))
+ (cond ((not desc))
+ ((equal desc "NONE") (setq desc nil))
+ (t (setq desc
+ (replace-regexp-in-string
+ org-bracket-link-analytic-regexp
+ (lambda (m) (or (match-string 5 m) (match-string 3 m)))
+ desc))))
+ ;; Return the link
+ (if (not (and (or (called-interactively-p 'any)
+ executing-kbd-macro)
+ link))
+ (or agenda-link (and link (org-make-link-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))
+ (car org-stored-links)))))
(defun org-store-link-props (&rest plist)
- "Store link properties, extract names and addresses."
- (let (x adr)
- (when (setq x (plist-get plist :from))
- (setq adr (mail-extract-address-components x))
- (setq plist (plist-put plist :fromname (car adr)))
- (setq plist (plist-put plist :fromaddress (nth 1 adr))))
- (when (setq x (plist-get plist :to))
- (setq adr (mail-extract-address-components x))
- (setq plist (plist-put plist :toname (car adr)))
- (setq plist (plist-put plist :toaddress (nth 1 adr)))))
+ "Store link properties.
+The properties are pre-processed by extracting names, addresses
+and dates."
+ (let ((x (plist-get plist :from)))
+ (when x
+ (let ((adr (mail-extract-address-components x)))
+ (setq plist (plist-put plist :fromname (car adr)))
+ (setq plist (plist-put plist :fromaddress (nth 1 adr))))))
+ (let ((x (plist-get plist :to)))
+ (when x
+ (let ((adr (mail-extract-address-components x)))
+ (setq plist (plist-put plist :toname (car adr)))
+ (setq plist (plist-put plist :toaddress (nth 1 adr))))))
+ (let ((x (ignore-errors (date-to-time (plist-get plist :date)))))
+ (when x
+ (setq plist (plist-put plist :date-timestamp
+ (format-time-string
+ (org-time-stamp-format t) x)))
+ (setq plist (plist-put plist :date-timestamp-inactive
+ (format-time-string
+ (org-time-stamp-format t t) x)))))
(let ((from (plist-get plist :from))
(to (plist-get plist :to)))
(when (and from to org-from-is-user-regexp)
@@ -9750,7 +9938,7 @@ according to FMT (default from `org-email-link-description-format')."
(org-back-to-heading t)
(org-element-property :raw-value (org-element-at-point))))))
(lines org-context-in-file-links))
- (or string (setq s (concat "*" s))) ; Add * for headlines
+ (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")))
@@ -9759,49 +9947,38 @@ according to FMT (default from `org-email-link-description-format')."
'identity
(reverse (nthcdr (- (length slines) lines)
(reverse slines))) "\n")))))
- (mapconcat 'identity (org-split-string s "[ \t]+") " ")))
+ (mapconcat #'identity (split-string s) " ")))
(defun org-make-link-string (link &optional description)
"Make a link with brackets, consisting of LINK and DESCRIPTION."
- (unless (string-match "\\S-" link)
- (error "Empty link"))
- (when (and description
- (stringp description)
- (not (string-match "\\S-" description)))
- (setq description nil))
- (when (stringp description)
- ;; Remove brackets from the description, they are fatal.
- (while (string-match "\\[" description)
- (setq description (replace-match "{" t t description)))
- (while (string-match "\\]" description)
- (setq description (replace-match "}" t t description))))
- (when (equal link description)
- ;; No description needed, it is identical
- (setq description nil))
- (when (and (not description)
- (not (string-match (org-image-file-name-regexp) link))
- (not (equal link (org-link-escape link))))
- (setq description (org-extract-attributes link)))
- (setq link
- (cond ((string-match (org-image-file-name-regexp) link) link)
- ((string-match org-link-types-re link)
- (concat (match-string 1 link)
- (org-link-escape (substring link (match-end 1)))))
- (t (org-link-escape link))))
- (concat "[[" link "]"
- (if description (concat "[" description "]") "")
- "]"))
+ (unless (org-string-nw-p link) (error "Empty link"))
+ (let ((uri (cond ((string-match org-link-types-re link)
+ (concat (match-string 1 link)
+ (org-link-escape (substring link (match-end 1)))))
+ ;; For readability, url-encode internal links only
+ ;; when absolutely needed (i.e, when they contain
+ ;; square brackets). File links however, are
+ ;; encoded since, e.g., spaces are significant.
+ ((or (file-name-absolute-p link)
+ (string-match-p "\\`\\.\\.?/\\|[][]" link))
+ (org-link-escape link))
+ (t link)))
+ (description
+ (and (org-string-nw-p description)
+ ;; Remove brackets from description, as they are fatal.
+ (replace-regexp-in-string
+ "[][]" (lambda (m) (if (equal "[" m) "{" "}"))
+ (org-trim description)))))
+ (format "[[%s]%s]"
+ uri
+ (if description (format "[%s]" description) ""))))
(defconst org-link-escape-chars
- '(?\ ?\[ ?\] ?\; ?\= ?\+)
- "List of characters that should be escaped in link.
+ ;;%20 %5B %5D %25
+ '(?\s ?\[ ?\] ?%)
+ "List of characters that should be escaped in a link when stored to Org.
This is the list that is used for internal purposes.")
-(defconst org-link-escape-chars-browser
- '(?\ ?\")
- "List of escapes for characters that are problematic in links.
-This is the list that is used before handing over to the browser.")
-
(defun org-link-escape (text &optional table merge)
"Return percent escaped representation of TEXT.
TEXT is a string with the text to escape.
@@ -9809,35 +9986,29 @@ Optional argument TABLE is a list with characters that should be
escaped. When nil, `org-link-escape-chars' is used.
If optional argument MERGE is set, merge TABLE into
`org-link-escape-chars'."
- (cond
- ((and table merge)
- (mapc (lambda (defchr)
- (unless (member defchr table)
- (setq table (cons defchr table)))) org-link-escape-chars))
- ((null table)
- (setq table org-link-escape-chars)))
- (mapconcat
- (lambda (char)
- (if (or (member char table)
- (and (or (< char 32) (= char 37) (> char 126))
- org-url-hexify-p))
- (mapconcat (lambda (sequence-element)
- (format "%%%.2X" sequence-element))
- (or (encode-coding-char char 'utf-8)
- (error "Unable to percent escape character: %s"
- (char-to-string char))) "")
- (char-to-string char))) text ""))
+ (let ((characters-to-encode
+ (cond ((null table) org-link-escape-chars)
+ (merge (append org-link-escape-chars table))
+ (t table))))
+ (mapconcat
+ (lambda (c)
+ (if (or (memq c characters-to-encode)
+ (and org-url-hexify-p (or (< c 32) (> c 126))))
+ (mapconcat (lambda (e) (format "%%%.2X" e))
+ (or (encode-coding-char c 'utf-8)
+ (error "Unable to percent escape character: %c" c))
+ "")
+ (char-to-string c)))
+ text "")))
(defun org-link-unescape (str)
- "Unhex hexified Unicode strings as returned from the JavaScript function
-encodeURIComponent. E.g. `%C3%B6' is the german o-Umlaut."
- (unless (and (null str) (string= "" str))
- (let ((pos 0) (case-fold-search t) unhexed)
- (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos))
- (setq unhexed (org-link-unescape-compound (match-string 0 str)))
- (setq str (replace-match unhexed t t str))
- (setq pos (+ pos (length unhexed))))))
- str)
+ "Unhex hexified Unicode parts in string STR.
+E.g. `%C3%B6' becomes the german o-Umlaut. This is the
+reciprocal of `org-link-escape', which see."
+ (if (org-string-nw-p str)
+ (replace-regexp-in-string
+ "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t)
+ str))
(defun org-link-unescape-compound (hex)
"Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut.
@@ -9860,18 +10031,17 @@ Note: this function also decodes single byte encodings like
((>= val 192) (cons 2 192))
(t (cons 0 0)))
(cons 6 128))))
- (if (>= val 192) (setq eat (car shift-xor)))
+ (when (>= val 192) (setq eat (car shift-xor)))
(setq val (logxor val (cdr shift-xor)))
(setq sum (+ (lsh sum (car shift-xor)) val))
- (if (> eat 0) (setq eat (- eat 1)))
+ (when (> eat 0) (setq eat (- eat 1)))
(cond
((= 0 eat) ;multi byte
- (setq ret (concat ret (org-char-to-string sum)))
+ (setq ret (concat ret (char-to-string sum)))
(setq sum 0))
((not bytes) ; single byte(s)
- (setq ret (org-link-unescape-single-byte-sequence hex))))
- )) ;; end (while bytes
- ret )))
+ (setq ret (org-link-unescape-single-byte-sequence hex))))))
+ ret)))
(defun org-link-unescape-single-byte-sequence (hex)
"Unhexify hex-encoded single byte character sequences."
@@ -9901,28 +10071,47 @@ Note: this function also decodes single byte encodings like
(defun org-link-prettify (link)
"Return a human-readable representation of LINK.
-The car of LINK must be a raw link the cdr of LINK must be either
-a link description or nil."
+The car of LINK must be a raw link.
+The cdr of LINK must be either a link description or nil."
(let ((desc (or (cadr link) "<no description>")))
(concat (format "%-45s" (substring desc 0 (min (length desc) 40)))
"<" (car link) ">")))
;;;###autoload
(defun org-insert-link-global ()
- "Insert a link like Org-mode does.
-This command can be called in any mode to insert a link in Org-mode syntax."
+ "Insert a link like Org mode does.
+This command can be called in any mode to insert a link in Org syntax."
(interactive)
(org-load-modules-maybe)
(org-run-like-in-org-mode 'org-insert-link))
-(defun org-insert-all-links (&optional keep)
- "Insert all links in `org-stored-links'."
+(defun org-insert-all-links (arg &optional pre post)
+ "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."
(interactive "P")
- (let ((links (copy-sequence org-stored-links)) l)
- (while (setq l (if keep (pop links) (pop org-stored-links)))
- (insert "- ")
- (org-insert-link nil (car l) (or (cadr l) "<no description>"))
- (insert "\n"))))
+ (let ((org-keep-stored-link-after-insertion (equal arg '(4)))
+ (links (copy-sequence org-stored-links))
+ (pr (or pre "- "))
+ (po (or post "\n"))
+ (cnt 1) l)
+ (if (null org-stored-links)
+ (message "No link to insert")
+ (while (and (or (listp arg) (>= arg cnt))
+ (setq l (if (listp arg)
+ (pop links)
+ (pop org-stored-links))))
+ (setq cnt (1+ cnt))
+ (insert pr)
+ (org-insert-link nil (car l) (or (cadr l) "<no description>"))
+ (insert po)))))
+
+(defun org-insert-last-stored-link (arg)
+ "Insert the last link stored in `org-stored-links'."
+ (interactive "p")
+ (org-insert-all-links arg "" "\n"))
(defun org-link-fontify-links-to-this-file ()
"Fontify links to the current file in `org-stored-links'."
@@ -9946,73 +10135,72 @@ This command can be called in any mode to insert a link in Org-mode syntax."
(put-text-property 0 (length l) 'face 'font-lock-comment-face l))
(delq nil (append a b)))))
-(defvar org-link-links-in-this-file nil)
+(defvar org--links-history nil)
(defun org-insert-link (&optional complete-file link-location default-description)
"Insert a link. At the prompt, enter the link.
-Completion can be used to insert any of the link protocol prefixes like
-http or ftp in use.
+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.
+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.
+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
+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 two \\[universal-argument] prefixes, enforce an absolute path even if the file is in
+With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \
+absolute path even if the file is in
the current directory or below.
-With three \\[universal-argument] prefixes, negate the meaning of
-`org-keep-stored-link-after-insertion'.
+A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix negates `org-keep-stored-link-after-insertion'.
-If `org-make-link-description-function' is non-nil, this function will be
-called with the link target, and the result will be the default
-link description.
-
-If the LINK-LOCATION parameter is non-nil, this value will be
-used as the link location instead of reading one interactively.
+If the LINK-LOCATION parameter is non-nil, this value will be used as
+the link location instead of reading one interactively.
If the DEFAULT-DESCRIPTION parameter is non-nil, this value will
-be used as the default description."
+be used as the default description. Otherwise, if
+`org-make-link-description-function' is non-nil, this function
+will be called with the link target, and the result will be the
+default link description."
(interactive "P")
(let* ((wcf (current-window-configuration))
(origbuf (current-buffer))
- (region (if (org-region-active-p)
- (buffer-substring (region-beginning) (region-end))))
+ (region (when (org-region-active-p)
+ (buffer-substring (region-beginning) (region-end))))
(remove (and region (list (region-beginning) (region-end))))
(desc region)
- tmphist ; byte-compile incorrectly complains about this
(link link-location)
(abbrevs org-link-abbrev-alist-local)
- entry file all-prefixes auto-desc)
+ entry all-prefixes auto-desc)
(cond
- (link-location) ; specified by arg, just use it.
+ (link-location) ; specified by arg, just use it.
((org-in-regexp org-bracket-link-regexp 1)
;; We do have a link at point, and we are going to edit it.
(setq remove (list (match-beginning 0) (match-end 0)))
- (setq desc (if (match-end 3) (org-match-string-no-properties 3)))
+ (setq desc (when (match-end 3) (match-string-no-properties 3)))
(setq link (read-string "Link: "
(org-link-unescape
- (org-match-string-no-properties 1)))))
+ (match-string-no-properties 1)))))
((or (org-in-regexp org-angle-link-re)
(org-in-regexp org-plain-link-re))
;; Convert to bracket link
(setq remove (list (match-beginning 0) (match-end 0))
link (read-string "Link: "
- (org-remove-angle-brackets (match-string 0)))))
+ (org-unbracket-string "<" ">" (match-string 0)))))
((member complete-file '((4) (16)))
;; Completing read for file names.
(setq link (org-file-complete-link complete-file)))
@@ -10035,149 +10223,137 @@ Use TAB to complete link prefixes, then RET for type-specific completion support
(unless (pos-visible-in-window-p (point-max))
(org-fit-window-to-buffer))
(and (window-live-p cw) (select-window cw)))
- ;; Fake a link history, containing the stored links.
- (setq tmphist (append (mapcar 'car org-stored-links)
- org-insert-link-history))
(setq all-prefixes (append (mapcar 'car abbrevs)
(mapcar 'car org-link-abbrev-alist)
- org-link-types))
+ (org-link-types)))
(unwind-protect
- (progn
+ ;; Fake a link history, containing the stored links.
+ (let ((org--links-history
+ (append (mapcar #'car org-stored-links)
+ org-insert-link-history)))
(setq link
(org-completing-read
"Link: "
(append
- (mapcar (lambda (x) (concat x ":"))
- all-prefixes)
- (mapcar 'car org-stored-links))
+ (mapcar (lambda (x) (concat x ":")) all-prefixes)
+ (mapcar #'car org-stored-links))
nil nil nil
- 'tmphist
+ 'org--links-history
(caar org-stored-links)))
- (if (not (string-match "\\S-" link))
- (user-error "No link selected"))
- (mapc (lambda(l)
- (when (equal link (cadr l)) (setq link (car l) auto-desc t)))
- org-stored-links)
- (if (or (member link all-prefixes)
- (and (equal ":" (substring link -1))
- (member (substring link 0 -1) all-prefixes)
- (setq link (substring link 0 -1))))
- (setq link (with-current-buffer origbuf
- (org-link-try-special-completion link)))))
+ (unless (org-string-nw-p link) (user-error "No link selected"))
+ (dolist (l org-stored-links)
+ (when (equal link (cadr l))
+ (setq link (car l))
+ (setq auto-desc t)))
+ (when (or (member link all-prefixes)
+ (and (equal ":" (substring link -1))
+ (member (substring link 0 -1) all-prefixes)
+ (setq link (substring link 0 -1))))
+ (setq link (with-current-buffer origbuf
+ (org-link-try-special-completion link)))))
(set-window-configuration wcf)
(kill-buffer "*Org Links*"))
(setq entry (assoc link org-stored-links))
(or entry (push link org-insert-link-history))
(setq desc (or desc (nth 1 entry)))))
- (if (funcall (if (equal complete-file '(64)) 'not 'identity)
- (not org-keep-stored-link-after-insertion))
- (setq org-stored-links (delq (assoc link org-stored-links)
- org-stored-links)))
+ (when (funcall (if (equal complete-file '(64)) 'not 'identity)
+ (not org-keep-stored-link-after-insertion))
+ (setq org-stored-links (delq (assoc link org-stored-links)
+ org-stored-links)))
- (if (and (string-match org-plain-link-re link)
- (not (string-match org-ts-regexp link)))
- ;; URL-like link, normalize the use of angular brackets.
- (setq link (org-remove-angle-brackets link)))
+ (when (and (string-match org-plain-link-re link)
+ (not (string-match org-ts-regexp link)))
+ ;; URL-like link, normalize the use of angular brackets.
+ (setq link (org-unbracket-string "<" ">" link)))
;; 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
- (string-match "^file:\\(.+?\\)::\\(.+\\)" link))
- (let* ((path (match-string 1 link))
- (case-fold-search nil)
- (search (match-string 2 link)))
+ (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
- (if (equal (file-truename buffer-file-name) (file-truename path))
- ;; We are linking to this same file, with a search option
- (setq link search)))))
+ (when (equal (file-truename buffer-file-name) (file-truename path))
+ ;; We are linking to this same file, with a search option
+ (setq link search)))))
;; Check if we can/should use a relative path. If yes, simplify the link
- (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link)
- (let* ((type (match-string 1 link))
- (path (match-string 2 link))
- (origpath path)
- (case-fold-search nil))
- (cond
- ((or (eq org-link-file-path-type 'absolute)
- (equal complete-file '(16)))
- (setq path (abbreviate-file-name (expand-file-name path))))
- ((eq org-link-file-path-type 'noabbrev)
- (setq path (expand-file-name path)))
- ((eq org-link-file-path-type 'relative)
- (setq path (file-relative-name path)))
- (t
- (save-match-data
- (if (string-match (concat "^" (regexp-quote
- (expand-file-name
- (file-name-as-directory
- default-directory))))
- (expand-file-name path))
- ;; We are linking a file with relative path name.
- (setq path (substring (expand-file-name path)
- (match-end 0)))
- (setq path (abbreviate-file-name (expand-file-name path)))))))
- (setq link (concat type path))
- (if (equal desc origpath)
- (setq desc path))))
-
- (if org-make-link-description-function
- (setq desc
- (or (condition-case nil
- (funcall org-make-link-description-function link desc)
- (error (progn (message "Can't get link description from `%s'"
- (symbol-name org-make-link-description-function))
- (sit-for 2) nil)))
- (read-string "Description: " default-description)))
- (if default-description (setq desc default-description)
- (setq desc (or (and auto-desc desc)
- (read-string "Description: " desc)))))
+ (let ((case-fold-search nil))
+ (when (string-match "\\`\\(file\\|docview\\):" link)
+ (let* ((type (match-string-no-properties 0 link))
+ (path (substring-no-properties link (match-end 0)))
+ (origpath path))
+ (cond
+ ((or (eq org-link-file-path-type 'absolute)
+ (equal complete-file '(16)))
+ (setq path (abbreviate-file-name (expand-file-name path))))
+ ((eq org-link-file-path-type 'noabbrev)
+ (setq path (expand-file-name path)))
+ ((eq org-link-file-path-type 'relative)
+ (setq path (file-relative-name path)))
+ (t
+ (save-match-data
+ (if (string-match (concat "^" (regexp-quote
+ (expand-file-name
+ (file-name-as-directory
+ default-directory))))
+ (expand-file-name path))
+ ;; We are linking a file with relative path name.
+ (setq path (substring (expand-file-name path)
+ (match-end 0)))
+ (setq path (abbreviate-file-name (expand-file-name path)))))))
+ (setq link (concat type path))
+ (when (equal desc origpath)
+ (setq desc path)))))
+
+ (unless auto-desc
+ (let ((initial-input
+ (cond
+ (default-description)
+ ((not org-make-link-description-function) desc)
+ (t (condition-case nil
+ (funcall org-make-link-description-function link desc)
+ (error
+ (message "Can't get link description from `%s'"
+ (symbol-name org-make-link-description-function))
+ (sit-for 2)
+ nil))))))
+ (setq desc (read-string "Description: " initial-input))))
(unless (string-match "\\S-" desc) (setq desc nil))
- (if remove (apply 'delete-region remove))
- (insert (org-make-link-string link desc))))
+ (when remove (apply 'delete-region remove))
+ (insert (org-make-link-string link desc))
+ ;; Redisplay so as the new link has proper invisible characters.
+ (sit-for 0)))
(defun org-link-try-special-completion (type)
"If there is completion support for link type TYPE, offer it."
- (let ((fun (intern (concat "org-" type "-complete-link"))))
+ (let ((fun (org-link-get-parameter type :complete)))
(if (functionp fun)
(funcall fun)
(read-string "Link (no completion support): " (concat type ":")))))
(defun org-file-complete-link (&optional arg)
"Create a file link using completion."
- (let (file link)
- (setq file (org-iread-file-name "File: "))
- (let ((pwd (file-name-as-directory (expand-file-name ".")))
- (pwd1 (file-name-as-directory (abbreviate-file-name
- (expand-file-name ".")))))
- (cond
- ((equal arg '(16))
- (setq link (concat
- "file:"
- (abbreviate-file-name (expand-file-name file)))))
- ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
- (setq link (concat "file:" (match-string 1 file))))
- ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)")
- (expand-file-name file))
- (setq link (concat
- "file:" (match-string 1 (expand-file-name file)))))
- (t (setq link (concat "file:" file)))))
- link))
-
-(defun org-iread-file-name (&rest args)
- "Read-file-name using `ido-mode' speedup if available.
-ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'.
-See `read-file-name' for a description of parameters."
- (org-without-partial-completion
- (if (and org-completion-use-ido
- (fboundp 'ido-read-file-name)
- (boundp 'ido-mode) ido-mode
- (listp (second args)))
- (let ((ido-enter-matching-directory nil))
- (apply 'ido-read-file-name args))
- (apply 'read-file-name args))))
+ (let ((file (read-file-name "File: "))
+ (pwd (file-name-as-directory (expand-file-name ".")))
+ (pwd1 (file-name-as-directory (abbreviate-file-name
+ (expand-file-name ".")))))
+ (cond ((equal arg '(16))
+ (concat "file:"
+ (abbreviate-file-name (expand-file-name file))))
+ ((string-match
+ (concat "^" (regexp-quote pwd1) "\\(.+\\)") file)
+ (concat "file:" (match-string 1 file)))
+ ((string-match
+ (concat "^" (regexp-quote pwd) "\\(.+\\)")
+ (expand-file-name file))
+ (concat "file:"
+ (match-string 1 (expand-file-name file))))
+ (t (concat "file:" file)))))
(defun org-completing-read (&rest args)
"Completing-read with SPACE being a normal character."
@@ -10186,58 +10362,9 @@ See `read-file-name' for a description of parameters."
(copy-keymap minibuffer-local-completion-map)))
(org-defkey minibuffer-local-completion-map " " 'self-insert-command)
(org-defkey minibuffer-local-completion-map "?" 'self-insert-command)
- (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive)
- (apply 'org-icompleting-read args)))
-
-(defun org-completing-read-no-i (&rest args)
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (apply 'org-completing-read args)))
-
-(defun org-iswitchb-completing-read (prompt choices &rest args)
- "Use iswitch as a completing-read replacement to choose from choices.
-PROMPT is a string to prompt with. CHOICES is a list of strings to choose
-from."
- (let* ((iswitchb-use-virtual-buffers nil)
- (iswitchb-make-buflist-hook
- (lambda ()
- (setq iswitchb-temp-buflist choices))))
- (iswitchb-read-buffer prompt)))
-
-(defun org-icompleting-read (&rest args)
- "Completing-read using `ido-mode' or `iswitchb' speedups if available."
- (org-without-partial-completion
- (if (and org-completion-use-ido
- (fboundp 'ido-completing-read)
- (boundp 'ido-mode) ido-mode
- (listp (second args)))
- (let ((ido-enter-matching-directory nil))
- (apply 'ido-completing-read (concat (car args))
- (if (consp (car (nth 1 args)))
- (mapcar 'car (nth 1 args))
- (nth 1 args))
- (cddr args)))
- (if (and org-completion-use-iswitchb
- (boundp 'iswitchb-mode) iswitchb-mode
- (listp (second args)))
- (apply 'org-iswitchb-completing-read (concat (car args))
- (if (consp (car (nth 1 args)))
- (mapcar 'car (nth 1 args))
- (nth 1 args))
- (cddr args))
- (apply 'completing-read args)))))
-
-(defun org-extract-attributes (s)
- "Extract the attributes cookie from a string and set as text property."
- (let (a attr (start 0) key value)
- (save-match-data
- (when (string-match "{{\\([^}]+\\)}}$" s)
- (setq a (match-string 1 s) s (substring s 0 (match-beginning 0)))
- (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start)
- (setq key (match-string 1 a) value (match-string 2 a)
- start (match-end 0)
- attr (plist-put attr (intern key) value))))
- (org-add-props s nil 'org-attr attr))
- s))
+ (org-defkey minibuffer-local-completion-map (kbd "C-c !")
+ 'org-time-stamp-inactive)
+ (apply #'completing-read args)))
;;; Opening/following a link
@@ -10257,8 +10384,8 @@ handle this as a special case.
When the function does handle the link, it must return a non-nil value.
If it decides that it is not responsible for this link, it must return
-nil to indicate that that Org-mode can continue with other options
-like exact and fuzzy text search.")
+nil to indicate that that Org can continue with other options like
+exact and fuzzy text search.")
(defun org-next-link (&optional search-backward)
"Move forward to the next link.
@@ -10270,7 +10397,7 @@ If the link is in hidden text, expose it."
(setq org-link-search-failed nil)
(let* ((pos (point))
(ct (org-context))
- (a (assoc :link ct))
+ (a (assq :link ct))
(srch-fun (if search-backward 're-search-backward 're-search-forward)))
(cond (a (goto-char (nth (if search-backward 1 2) a)))
((looking-at org-any-link-re)
@@ -10279,7 +10406,7 @@ If the link is in hidden text, expose it."
(if (funcall srch-fun org-any-link-re nil t)
(progn
(goto-char (match-beginning 0))
- (if (outline-invisible-p) (org-show-context)))
+ (when (org-invisible-p) (org-show-context)))
(goto-char pos)
(setq org-link-search-failed t)
(message "No further link found"))))
@@ -10292,14 +10419,9 @@ If the link is in hidden text, expose it."
(defun org-translate-link (s)
"Translate a link string if a translation function has been defined."
- (if (and org-link-translation-function
- (fboundp org-link-translation-function)
- (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s))
- (progn
- (setq s (funcall org-link-translation-function
- (match-string 1 s) (match-string 2 s)))
- (concat (car s) ":" (cdr s)))
- s))
+ (with-temp-buffer
+ (insert (org-trim s))
+ (org-trim (org-element-interpret-data (org-element-context)))))
(defun org-translate-link-from-planner (type path)
"Translate a link from Emacs Planner syntax so that Org can follow it.
@@ -10319,7 +10441,7 @@ This is still an experimental function, your mileage may vary."
;; A typical message link. Planner has the id after the final slash,
;; we separate it with a hash mark
(setq path (concat (match-string 1 path) "#"
- (org-remove-angle-brackets (match-string 2 path))))))
+ (org-unbracket-string "<" ">" (match-string 2 path))))))
(cons type path))
(defun org-find-file-at-mouse (ev)
@@ -10333,28 +10455,32 @@ This is still an experimental function, your mileage may vary."
See the docstring of `org-open-file' for details."
(interactive "e")
(mouse-set-point ev)
- (if (eq major-mode 'org-agenda-mode)
- (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
+ (when (eq major-mode 'org-agenda-mode)
+ (org-agenda-copy-local-variable 'org-link-abbrev-alist-local))
(org-open-at-point))
(defvar org-window-config-before-follow-link nil
"The window configuration before following a link.
This is saved in case the need arises to restore it.")
-(defvar org-open-link-marker (make-marker)
- "Marker pointing to the location where `org-open-at-point' was called.")
-
;;;###autoload
(defun org-open-at-point-global ()
- "Follow a link like Org-mode does.
-This command can be called in any mode to follow a link that has
-Org-mode syntax."
+ "Follow a link or time-stamp like Org mode does.
+This command can be called in any mode to follow an external link
+or a time-stamp that has Org mode syntax. Its behavior is
+undefined when called on internal links (e.g., fuzzy links).
+Raise an error when there is nothing to follow. "
(interactive)
- (org-run-like-in-org-mode 'org-open-at-point))
+ (cond ((org-in-regexp org-any-link-re)
+ (org-open-link-from-string (match-string-no-properties 0)))
+ ((or (org-in-regexp org-ts-regexp-both nil t)
+ (org-in-regexp org-tsr-regexp-both nil t))
+ (org-follow-timestamp-link))
+ (t (user-error "No link found"))))
;;;###autoload
(defun org-open-link-from-string (s &optional arg reference-buffer)
- "Open a link in the string S, as if it was in Org-mode."
+ "Open a link in the string S, as if it was in Org mode."
(interactive "sLink: \nP")
(let ((reference-buffer (or reference-buffer (current-buffer))))
(with-temp-buffer
@@ -10375,267 +10501,227 @@ Functions in this hook must return t if they identify and follow
a link at point. If they don't find anything interesting at point,
they must return nil.")
-(defvar org-link-search-inhibit-query nil) ;; dynamically scoped
-(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el
+(defvar org-link-search-inhibit-query nil)
+(defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el
+(defun org--open-doi-link (path)
+ "Open a \"doi\" type link.
+PATH is a the path to search for, as a string."
+ (browse-url (url-encode-url (concat org-doi-server-url path))))
+
+(defun org--open-elisp-link (path)
+ "Open a \"elisp\" type link.
+PATH is the sexp to evaluate, as a string."
+ (let ((cmd path))
+ (if (or (and (org-string-nw-p
+ org-confirm-elisp-link-not-regexp)
+ (string-match-p org-confirm-elisp-link-not-regexp cmd))
+ (not org-confirm-elisp-link-function)
+ (funcall org-confirm-elisp-link-function
+ (format "Execute \"%s\" as elisp? "
+ (org-add-props cmd nil 'face 'org-warning))))
+ (message "%s => %s" cmd
+ (if (eq (string-to-char cmd) ?\()
+ (eval (read cmd))
+ (call-interactively (read cmd))))
+ (user-error "Abort"))))
+
+(defun org--open-help-link (path)
+ "Open a \"help\" type link.
+PATH is a symbol name, as a string."
+ (pcase (intern path)
+ ((and (pred fboundp) variable) (describe-function variable))
+ ((and (pred boundp) function) (describe-variable function))
+ (name (user-error "Unknown function or variable: %s" name))))
+
+(defun org--open-shell-link (path)
+ "Open a \"shell\" type link.
+PATH is the command to execute, as a string."
+ (let ((buf (generate-new-buffer "*Org Shell Output*"))
+ (cmd path))
+ (if (or (and (org-string-nw-p
+ org-confirm-shell-link-not-regexp)
+ (string-match
+ org-confirm-shell-link-not-regexp cmd))
+ (not org-confirm-shell-link-function)
+ (funcall org-confirm-shell-link-function
+ (format "Execute \"%s\" in shell? "
+ (org-add-props cmd nil
+ 'face 'org-warning))))
+ (progn
+ (message "Executing %s" cmd)
+ (shell-command cmd buf)
+ (when (featurep 'midnight)
+ (setq clean-buffer-list-kill-buffer-names
+ (cons (buffer-name buf)
+ clean-buffer-list-kill-buffer-names))))
+ (user-error "Abort"))))
+
(defun org-open-at-point (&optional arg reference-buffer)
- "Open link at or after point.
-If there is no link at point, this function will search forward up to
-the end of the current line.
-Normally, files will be opened by an appropriate application. If the
-optional prefix argument ARG is non-nil, Emacs will visit the file.
-With a double prefix argument, try to open outside of Emacs, in the
-application the system uses for this file type."
- (interactive "P")
- ;; if in a code block, then open the block's results
- (unless (call-interactively #'org-babel-open-src-block-result)
- (org-load-modules-maybe)
- (move-marker org-open-link-marker (point))
- (setq org-window-config-before-follow-link (current-window-configuration))
- (org-remove-occur-highlights nil nil t)
- (cond
- ((and (org-at-heading-p)
- (not (org-at-timestamp-p t))
- (not (org-in-regexp
- (concat org-plain-link-re "\\|"
- org-bracket-link-regexp "\\|"
- org-angle-link-re "\\|"
- "[ \t]:[^ \t\n]+:[ \t]*$")))
- (not (get-text-property (point) 'org-linked-text)))
- (or (let* ((lkall (org-offer-links-in-entry (current-buffer) (point) arg))
- (lk0 (car lkall))
- (lk (if (stringp lk0) (list lk0) lk0))
- (lkend (cdr lkall)))
- (mapcar (lambda(l)
- (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point))
- lk))
- (progn (require 'org-attach) (org-attach-reveal 'if-exists))))
- ((run-hook-with-args-until-success 'org-open-at-point-functions))
- ((and (org-at-timestamp-p t)
- (not (org-in-regexp org-bracket-link-regexp)))
- (org-follow-timestamp-link))
- ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p))
- (not (org-in-regexp org-any-link-re)))
- (org-footnote-action))
- (t
- (let (type path link line search (pos (point)))
- (catch 'match
- (save-excursion
- (or (org-in-regexp org-plain-link-re)
- (skip-chars-forward "^]\n\r"))
- (when (org-in-regexp org-bracket-link-regexp 1)
- (setq link (org-extract-attributes
- (org-link-unescape (org-match-string-no-properties 1))))
- (while (string-match " *\n *" link)
- (setq link (replace-match " " t t link)))
- (setq link (org-link-expand-abbrev link))
- (cond
- ((or (file-name-absolute-p link)
- (string-match "^\\.\\.?/" link))
- (setq type "file" path link))
- ((string-match org-link-re-with-space3 link)
- (setq type (match-string 1 link) path (match-string 2 link)))
- ((string-match "^help:+\\(.+\\)" link)
- (setq type "help" path (match-string 1 link)))
- (t (setq type "thisfile" path link)))
- (throw 'match t)))
-
- (when (get-text-property (point) 'org-linked-text)
- (setq type "thisfile"
- pos (if (get-text-property (1+ (point)) 'org-linked-text)
- (1+ (point)) (point))
- path (buffer-substring
- (or (previous-single-property-change pos 'org-linked-text)
- (point-min))
- (or (next-single-property-change pos 'org-linked-text)
- (point-max)))
- ;; Ensure we will search for a <<<radio>>> link, not
- ;; a simple reference like <<ref>>
- path (concat "<" path))
- (throw 'match t))
+ "Open link, timestamp, footnote or tags at point.
- (save-excursion
- (when (or (org-in-regexp org-angle-link-re)
- (let ((match (org-in-regexp org-plain-link-re)))
- ;; Check a plain link is not within a bracket link
- (and match
- (save-excursion
- (save-match-data
- (progn
- (goto-char (car match))
- (not (org-in-regexp org-bracket-link-regexp)))))))
- (let ((line_ending (save-excursion (end-of-line) (point))))
- ;; We are in a line before a plain or bracket link
- (or (re-search-forward org-plain-link-re line_ending t)
- (re-search-forward org-bracket-link-regexp line_ending t))))
- (setq type (match-string 1)
- path (org-link-unescape (match-string 2)))
- (throw 'match t)))
- (save-excursion
- (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$"))
- (setq type "tags"
- path (match-string 1))
- (while (string-match ":" path)
- (setq path (replace-match "+" t t path)))
- (throw 'match t)))
- (when (org-in-regexp "<\\([^><\n]+\\)>")
- (setq type "tree-match"
- path (match-string 1))
- (throw 'match t)))
- (unless path
- (user-error "No link found"))
+When point is on a link, follow it. Normally, files will be
+opened by an appropriate application. If the optional prefix
+argument ARG is non-nil, Emacs will visit the file. With
+a double prefix argument, try to open outside of Emacs, in the
+application the system uses for this file type.
- ;; switch back to reference buffer
- ;; needed when if called in a temporary buffer through
- ;; org-open-link-from-string
- (with-current-buffer (or reference-buffer (current-buffer))
+When point is on a timestamp, open the agenda at the day
+specified.
- ;; Remove any trailing spaces in path
- (if (string-match " +\\'" path)
- (setq path (replace-match "" t t path)))
- (if (and org-link-translation-function
- (fboundp org-link-translation-function))
- ;; Check if we need to translate the link
- (let ((tmp (funcall org-link-translation-function type path)))
- (setq type (car tmp) path (cdr tmp))))
+When point is a footnote definition, move to the first reference
+found. If it is on a reference, move to the associated
+definition.
- (cond
+When point is on a headline, display a list of every link in the
+entry, so it is possible to pick one, or all, of them. If point
+is on a tag, call `org-tags-view' instead.
- ((assoc type org-link-protocols)
- (funcall (nth 1 (assoc type org-link-protocols)) path))
-
- ((equal type "help")
- (let ((f-or-v (intern path)))
- (cond ((fboundp f-or-v)
- (describe-function f-or-v))
- ((boundp f-or-v)
- (describe-variable f-or-v))
- (t (error "Not a known function or variable")))))
-
- ((equal type "mailto")
- (let ((cmd (car org-link-mailto-program))
- (args (cdr org-link-mailto-program)) args1
- (address path) (subject "") a)
- (if (string-match "\\(.*\\)::\\(.*\\)" path)
- (setq address (match-string 1 path)
- subject (org-link-escape (match-string 2 path))))
- (while args
- (cond
- ((not (stringp (car args))) (push (pop args) args1))
- (t (setq a (pop args))
- (if (string-match "%a" a)
- (setq a (replace-match address t t a)))
- (if (string-match "%s" a)
- (setq a (replace-match subject t t a)))
- (push a args1))))
- (apply cmd (nreverse args1))))
-
- ((member type '("http" "https" "ftp" "news"))
- (browse-url
- (concat type ":"
- (if (org-string-match-p
- (concat "[[:nonascii:]"
- org-link-escape-chars-browser "]")
- path)
- (org-link-escape path org-link-escape-chars-browser)
- path))))
-
- ((string= type "doi")
- (browse-url
- (concat org-doi-server-url
- (if (org-string-match-p
- (concat "[[:nonascii:]"
- org-link-escape-chars-browser "]")
- path)
- (org-link-escape path org-link-escape-chars-browser)
- path))))
-
- ((member type '("message"))
- (browse-url (concat type ":" path)))
-
- ((string= type "tags")
- (org-tags-view arg path))
-
- ((string= type "tree-match")
- (org-occur (concat "\\[" (regexp-quote path) "\\]")))
-
- ((string= type "file")
- (if (string-match "::\\([0-9]+\\)\\'" path)
- (setq line (string-to-number (match-string 1 path))
- path (substring path 0 (match-beginning 0)))
- (if (string-match "::\\(.+\\)\\'" path)
- (setq search (match-string 1 path)
- path (substring path 0 (match-beginning 0)))))
- (if (string-match "[*?{]" (file-name-nondirectory path))
- (dired path)
- (org-open-file path arg line search)))
-
- ((string= type "shell")
- (let ((buf (generate-new-buffer "*Org Shell Output"))
- (cmd path))
- (if (or (and (not (string= org-confirm-shell-link-not-regexp ""))
- (string-match org-confirm-shell-link-not-regexp cmd))
- (not org-confirm-shell-link-function)
- (funcall org-confirm-shell-link-function
- (format "Execute \"%s\" in shell? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (progn
- (message "Executing %s" cmd)
- (shell-command cmd buf)
- (if (featurep 'midnight)
- (setq clean-buffer-list-kill-buffer-names
- (cons buf clean-buffer-list-kill-buffer-names))))
- (error "Abort"))))
-
- ((string= type "elisp")
- (let ((cmd path))
- (if (or (and (not (string= org-confirm-elisp-link-not-regexp ""))
- (string-match org-confirm-elisp-link-not-regexp cmd))
- (not org-confirm-elisp-link-function)
- (funcall org-confirm-elisp-link-function
- (format "Execute \"%s\" as elisp? "
- (org-add-props cmd nil
- 'face 'org-warning))))
- (message "%s => %s" cmd
- (if (equal (string-to-char cmd) ?\()
- (eval (read cmd))
- (call-interactively (read cmd))))
- (error "Abort"))))
-
- ((and (string= type "thisfile")
- (or (run-hook-with-args-until-success
- 'org-open-link-functions path)
- (and link
- (string-match "^id:" link)
- (or (featurep 'org-id) (require 'org-id))
- (progn
- (funcall (nth 1 (assoc "id" org-link-protocols))
- (substring path 3))
- t)))))
-
- ((string= type "thisfile")
- (if arg
- (switch-to-buffer-other-window
- (org-get-buffer-for-internal-link (current-buffer)))
- (org-mark-ring-push))
- (let ((cmd `(org-link-search
- ,path
- ,(cond ((equal arg '(4)) ''occur)
- ((equal arg '(16)) ''org-occur))
- ,pos)))
- (condition-case nil (let ((org-link-search-inhibit-query t))
- (eval cmd))
- (error (progn (widen) (eval cmd))))))
-
- (t (browse-url-at-point)))))))
- (move-marker org-open-link-marker nil)
- (run-hook-with-args 'org-follow-link-hook)))
+When optional argument REFERENCE-BUFFER is non-nil, it should
+specify a buffer from where the link search should happen. This
+is used internally by `org-open-link-from-string'.
-(defsubst org-uniquify (list)
- "Non-destructively remove duplicate elements from LIST."
- (let ((res (copy-sequence list))) (delete-dups res)))
+On top of syntactically correct links, this function will also
+try to open links and time-stamps in comments, example
+blocks... i.e., whenever point is on something looking like
+a timestamp or a link."
+ (interactive "P")
+ ;; On a code block, open block's results.
+ (unless (call-interactively 'org-babel-open-src-block-result)
+ (org-load-modules-maybe)
+ (setq org-window-config-before-follow-link (current-window-configuration))
+ (org-remove-occur-highlights nil nil t)
+ (unless (run-hook-with-args-until-success 'org-open-at-point-functions)
+ (let* ((context
+ ;; Only consider supported types, even if they are not
+ ;; the closest one.
+ (org-element-lineage
+ (org-element-context)
+ '(clock footnote-definition footnote-reference headline
+ inlinetask link timestamp)
+ t))
+ (type (org-element-type context))
+ (value (org-element-property :value context)))
+ (cond
+ ;; On a headline or an inlinetask, but not on a timestamp,
+ ;; 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 (substring (match-string 5) 0 -1))
+ ;; Not on tags.
+ (pcase (org-offer-links-in-entry (current-buffer) (point) arg)
+ (`(nil . ,_)
+ (require 'org-attach)
+ (org-attach-reveal 'if-exists))
+ (`(,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))))))
+ ;; On a footnote reference or at definition's label.
+ ((or (eq type 'footnote-reference)
+ (and (eq type 'footnote-definition)
+ (save-excursion
+ ;; Do not validate action when point is on the
+ ;; spaces right after the footnote label, in
+ ;; order to be on par with behaviour on links.
+ (skip-chars-forward " \t")
+ (let ((begin
+ (org-element-property :contents-begin context)))
+ (if begin (< (point) begin)
+ (= (org-element-property :post-affiliated context)
+ (line-beginning-position)))))))
+ (org-footnote-action))
+ ;; No valid context. Ignore catch-all types like `headline'.
+ ;; If point is on something looking like a link or
+ ;; a time-stamp, try opening it. It may be useful in
+ ;; comments, example blocks...
+ ((memq type '(footnote-definition headline inlinetask nil))
+ (call-interactively #'org-open-at-point-global))
+ ;; On a clock line, make sure point is on the timestamp
+ ;; before opening it.
+ ((and (eq type 'clock)
+ value
+ (>= (point) (org-element-property :begin value))
+ (<= (point) (org-element-property :end value)))
+ (org-follow-timestamp-link))
+ ;; Do nothing on white spaces after an object.
+ ((>= (point)
+ (save-excursion
+ (goto-char (org-element-property :end context))
+ (skip-chars-backward " \t")
+ (point)))
+ (user-error "No link found"))
+ ((eq type 'timestamp) (org-follow-timestamp-link))
+ ((eq type 'link)
+ (let ((type (org-element-property :type context))
+ (path (org-link-unescape (org-element-property :path context))))
+ ;; Switch back to REFERENCE-BUFFER needed when called in
+ ;; a temporary buffer through `org-open-link-from-string'.
+ (with-current-buffer (or reference-buffer (current-buffer))
+ (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 context))
+ (app (org-element-property :application context))
+ (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
+ (org-link-unescape 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-get-buffer-for-internal-link (current-buffer))))
+ (let ((destination
+ (org-with-wide-buffer
+ (if (equal type "radio")
+ (org-search-radio-target
+ (org-element-property :path context))
+ (org-link-search
+ (if (member type '("custom-id" "coderef"))
+ (org-element-property :raw-link context)
+ path)
+ ;; Prevent fuzzy links from matching
+ ;; themselves.
+ (and (equal type "fuzzy")
+ (+ 2 (org-element-property :begin context)))))
+ (point))))
+ (unless (and (<= (point-min) destination)
+ (>= (point-max) destination))
+ (widen))
+ (goto-char destination))))
+ (t (browse-url-at-point))))))
+ (t (user-error "No link found")))))
+ (run-hook-with-args 'org-follow-link-hook)))
(defun org-offer-links-in-entry (buffer marker &optional nth zero)
"Offer links in the current entry and return the selected link.
@@ -10644,65 +10730,57 @@ If NTH is an integer, return the NTH link found.
If ZERO is a string, check also this string for a link, and if
there is one, return it."
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|"
- "\\(" org-angle-link-re "\\)\\|"
- "\\(" org-plain-link-re "\\)"))
- (cnt ?0)
- (in-emacs (if (integerp nth) nil nth))
- have-zero end links link c)
- (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
- (push (match-string 0 zero) links)
- (setq cnt (1- cnt) have-zero t))
- (save-excursion
- (org-back-to-heading t)
- (setq end (save-excursion (outline-next-heading) (point)))
- (while (re-search-forward re end t)
- (push (match-string 0) links))
- (setq links (org-uniquify (reverse links))))
- (cond
- ((null links)
- (message "No links"))
- ((equal (length links) 1)
- (setq link (car links)))
- ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
- (setq link (nth (if have-zero nth (1- nth)) links)))
- (t ; we have to select a link
- (save-excursion
- (save-window-excursion
- (delete-other-windows)
- (with-output-to-temp-buffer "*Select Link*"
- (mapc (lambda (l)
- (if (not (string-match org-bracket-link-regexp l))
- (princ (format "[%c] %s\n" (incf cnt)
- (org-remove-angle-brackets l)))
- (if (match-end 3)
- (princ (format "[%c] %s (%s)\n" (incf cnt)
- (match-string 3 l) (match-string 1 l)))
- (princ (format "[%c] %s\n" (incf cnt)
- (match-string 1 l))))))
- links))
- (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
- (message "Select link to open, RET to open all:")
- (setq c (read-char-exclusive))
- (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
- (when (equal c ?q) (error "Abort"))
- (if (equal c ?\C-m)
- (setq link links)
- (setq nth (- c ?0))
- (if have-zero (setq nth (1+ nth)))
- (unless (and (integerp nth) (>= (length links) nth))
- (user-error "Invalid link selection"))
- (setq link (nth (1- nth) links)))))
- (cons link end))))))
-
-;; Add special file links that specify the way of opening
-
-(org-add-link-type "file+sys" 'org-open-file-with-system)
-(org-add-link-type "file+emacs" 'org-open-file-with-emacs)
+ (org-with-wide-buffer
+ (goto-char marker)
+ (let ((cnt ?0)
+ have-zero end links link c)
+ (when (and (stringp zero) (string-match org-bracket-link-regexp zero))
+ (push (match-string 0 zero) links)
+ (setq cnt (1- cnt) have-zero t))
+ (save-excursion
+ (org-back-to-heading t)
+ (setq end (save-excursion (outline-next-heading) (point)))
+ (while (re-search-forward org-any-link-re end t)
+ (push (match-string 0) links))
+ (setq links (org-uniquify (reverse links))))
+ (cond
+ ((null links)
+ (message "No links"))
+ ((equal (length links) 1)
+ (setq link (car links)))
+ ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth)))
+ (setq link (nth (if have-zero nth (1- nth)) links)))
+ (t ; we have to select a link
+ (save-excursion
+ (save-window-excursion
+ (delete-other-windows)
+ (with-output-to-temp-buffer "*Select Link*"
+ (dolist (l links)
+ (cond
+ ((not (string-match org-bracket-link-regexp l))
+ (princ (format "[%c] %s\n" (cl-incf cnt)
+ (org-unbracket-string "<" ">" l))))
+ ((match-end 3)
+ (princ (format "[%c] %s (%s)\n" (cl-incf cnt)
+ (match-string 3 l) (match-string 1 l))))
+ (t (princ (format "[%c] %s\n" (cl-incf cnt)
+ (match-string 1 l)))))))
+ (org-fit-window-to-buffer (get-buffer-window "*Select Link*"))
+ (message "Select link to open, RET to open all:")
+ (setq c (read-char-exclusive))
+ (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*"))))
+ (when (equal c ?q) (user-error "Abort"))
+ (if (equal c ?\C-m)
+ (setq link links)
+ (setq nth (- c ?0))
+ (when have-zero (setq nth (1+ nth)))
+ (unless (and (integerp nth) (>= (length links) nth))
+ (user-error "Invalid link selection"))
+ (setq link (nth (1- nth) links)))))
+ (cons link end)))))
+
+;; TODO: These functions are deprecated since `org-open-at-point'
+;; hard-codes behaviour for "file+emacs" and "file+sys" types.
(defun org-open-file-with-system (path)
"Open file at PATH using the system way of opening it."
(org-open-file path 'system))
@@ -10732,8 +10810,8 @@ which see.
A function in this hook may also use `setq' to set the variable
`description' to provide a suggestion for the descriptive text to
-be used for this link when it gets inserted into an Org-mode
-buffer with \\[org-insert-link].")
+be used for this link when it gets inserted into an Org buffer
+with \\[org-insert-link].")
(defvar org-execute-file-search-functions nil
"List of functions to execute a file search triggered by a link.
@@ -10757,179 +10835,202 @@ the window configuration before `org-open-at-point' was called using:
(set-window-configuration org-window-config-before-follow-link)")
-(defun org-link-search (s &optional type avoid-pos stealth)
- "Search for a link search option.
-If S is surrounded by forward slashes, it is interpreted as a
-regular expression. In org-mode files, this will create an `org-occur'
-sparse tree. In ordinary files, `occur' will be used to list matches.
-If the current buffer is in `dired-mode', grep will be used to search
-in all files. If AVOID-POS is given, ignore matches near that position.
+(defun org-search-radio-target (target)
+ "Search a radio target matching TARGET in current buffer.
+White spaces are not significant."
+ (let ((re (format "<<<%s>>>"
+ (mapconcat #'regexp-quote
+ (split-string target)
+ "[ \t]+\\(?:\n[ \t]*\\)?")))
+ (origin (point)))
+ (goto-char (point-min))
+ (catch :radio-match
+ (while (re-search-forward re nil t)
+ (backward-char)
+ (let ((object (org-element-context)))
+ (when (eq (org-element-type object) 'radio-target)
+ (goto-char (org-element-property :begin object))
+ (org-show-context 'link-search)
+ (throw :radio-match nil))))
+ (goto-char origin)
+ (user-error "No match for radio target: %s" target))))
+
+(defun org-link-search (s &optional avoid-pos stealth)
+ "Search for a search string S.
+
+If S starts with \"#\", it triggers a custom ID search.
+
+If S is enclosed within parenthesis, it initiates a coderef
+search.
+
+If S is surrounded by forward slashes, it is interpreted as
+a regular expression. In Org mode files, this will create an
+`org-occur' sparse tree. In ordinary files, `occur' will be used
+to list matches. If the current buffer is in `dired-mode', grep
+will be used to search in all files.
+
+When AVOID-POS is given, ignore matches near that position.
When optional argument STEALTH is non-nil, do not modify
-visibility around point, thus ignoring
-`org-show-hierarchy-above', `org-show-following-heading' and
-`org-show-siblings' variables."
- (let ((case-fold-search t)
- (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " "))
- (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x)))
- (append '(("") (" ") ("\t") ("\n"))
- org-emphasis-alist)
- "\\|") "\\)"))
- (pos (point))
- (pre nil) (post nil)
- words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall)
+visibility around point, thus ignoring `org-show-context-detail'
+variable.
+
+Search is case-insensitive and ignores white spaces. Return type
+of matched result, which is either `dedicated' or `fuzzy'."
+ (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s))
+ (let* ((case-fold-search t)
+ (origin (point))
+ (normalized (replace-regexp-in-string "\n[ \t]*" " " s))
+ (starred (eq (string-to-char normalized) ?*))
+ (words (split-string (if starred (substring s 1) s)))
+ (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)"))
+ (s-single-re (mapconcat #'regexp-quote words "[ \t]+"))
+ type)
(cond
- ;; First check if there are any special search functions
+ ;; Check if there are any special search functions.
((run-hook-with-args-until-success 'org-execute-file-search-functions s))
- ;; Now try the builtin stuff
- ((and (equal (string-to-char s0) ?#)
- (> (length s0) 1)
- (save-excursion
- (goto-char (point-min))
- (and
- (re-search-forward
- (concat "^[ \t]*:CUSTOM_ID:[ \t]+"
- (regexp-quote (substring s0 1)) "[ \t]*$") nil t)
- (setq type 'dedicated
- pos (match-beginning 0))))
- ;; There is an exact target for this
- (goto-char pos)
- (org-back-to-heading t)))
- ((save-excursion
+ ((eq (string-to-char s) ?#)
+ ;; Look for a custom ID S if S starts with "#".
+ (let* ((id (substring normalized 1))
+ (match (org-find-property "CUSTOM_ID" id)))
+ (if match (progn (goto-char match) (setf type 'dedicated))
+ (error "No match for custom ID: %s" id))))
+ ((string-match "\\`(\\(.*\\))\\'" normalized)
+ ;; Look for coderef targets if S is enclosed within parenthesis.
+ (let ((coderef (match-string-no-properties 1 normalized))
+ (re (substring s-single-re 1 -1)))
(goto-char (point-min))
- (and
- (re-search-forward
- (concat "<<" (regexp-quote s0) ">>") nil t)
- (setq type 'dedicated
- pos (match-beginning 0))))
- ;; There is an exact target for this
- (goto-char pos))
- ((save-excursion
- (goto-char (point-min))
- (and
- (re-search-forward
- (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t)
- (setq type 'dedicated pos (match-beginning 0))))
- ;; Found an element with a matching #+name affiliated keyword.
- (goto-char pos))
- ((and (string-match "^(\\(.*\\))$" s0)
- (save-excursion
+ (catch :coderef-match
+ (while (re-search-forward re nil t)
+ (let ((element (org-element-at-point)))
+ (when (and (memq (org-element-type element)
+ '(example-block src-block))
+ ;; Build proper regexp according to current
+ ;; block's label format.
+ (let ((label-fmt
+ (regexp-quote
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format))))
+ (save-excursion
+ (beginning-of-line)
+ (looking-at (format ".*?\\(%s\\)[ \t]*$"
+ (format label-fmt coderef))))))
+ (setq type 'dedicated)
+ (goto-char (match-beginning 1))
+ (throw :coderef-match nil))))
+ (goto-char origin)
+ (error "No match for coderef: %s" coderef))))
+ ((string-match "\\`/\\(.*\\)/\\'" normalized)
+ ;; Look for a regular expression.
+ (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur)
+ (match-string 1 s)))
+ ;; From here, we handle fuzzy links.
+ ;;
+ ;; Look for targets, only if not in a headline search.
+ ((and (not starred)
+ (let ((target (format "<<%s>>" s-multi-re)))
+ (catch :target-match
+ (goto-char (point-min))
+ (while (re-search-forward target nil t)
+ (backward-char)
+ (let ((context (org-element-context)))
+ (when (eq (org-element-type context) 'target)
+ (setq type 'dedicated)
+ (goto-char (org-element-property :begin context))
+ (throw :target-match t))))
+ nil))))
+ ;; Look for elements named after S, only if not in a headline
+ ;; search.
+ ((and (not starred)
+ (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re)))
+ (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)))
+ (setq type 'dedicated)
+ (beginning-of-line)
+ (throw :name-match t))))
+ nil))))
+ ;; Regular text search. Prefer headlines in Org mode buffers.
+ ;; Ignore COMMENT keyword, TODO keywords, priority cookies,
+ ;; statistics cookies and tags.
+ ((and (derived-mode-p 'org-mode)
+ (let ((title-re
+ (format "%s.*\\(?:%s[ \t]\\)?.*%s"
+ org-outline-regexp-bol
+ org-comment-string
+ (mapconcat #'regexp-quote words ".+")))
+ (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]")
+ (comment-re (eval-when-compile
+ (format "\\`%s[ \t]+" org-comment-string))))
(goto-char (point-min))
- (and
- (re-search-forward
- (concat "[^[]" (regexp-quote
- (format org-coderef-label-format
- (match-string 1 s0))))
- nil t)
- (setq type 'dedicated
- pos (1+ (match-beginning 0))))))
- ;; There is a coderef target for this
- (goto-char pos))
- ((string-match "^/\\(.*\\)/$" s)
- ;; A regular expression
- (cond
- ((derived-mode-p 'org-mode)
- (org-occur (match-string 1 s)))
- (t (org-do-occur (match-string 1 s)))))
- ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline)
- (and (equal (string-to-char s) ?*) (setq s (substring s 1)))
- (goto-char (point-min))
- (cond
- ((let (case-fold-search)
- (re-search-forward (format org-complex-heading-regexp-format
- (regexp-quote s))
- nil t))
- ;; OK, found a match
- (setq type 'dedicated)
- (goto-char (match-beginning 0)))
- ((and (not org-link-search-inhibit-query)
- (eq org-link-search-must-match-exact-headline 'query-to-create)
- (y-or-n-p "No match - create this as a new heading? "))
- (goto-char (point-max))
- (or (bolp) (newline))
- (insert "* " s "\n")
- (beginning-of-line 0))
- (t
- (goto-char pos)
- (error "No match"))))
- (t
- ;; A normal search string
- (when (equal (string-to-char s) ?*)
- ;; Anchor on headlines, post may include tags.
- (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*"
- post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$")
- s (substring s 1)))
- (remove-text-properties
- 0 (length s)
- '(face nil mouse-face nil keymap nil fontified nil) s)
- ;; Make a series of regular expressions to find a match
- (setq words (org-split-string s "[ \n\r\t]+")
-
- re0 (concat "\\(<<" (regexp-quote s0) ">>\\)")
- re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+")
- "\\)" markers)
- re2a_ (concat "\\(" (mapconcat 'downcase words
- "[ \t\r\n]+") "\\)[ \t\r\n]")
- re2a (concat "[ \t\r\n]" re2a_)
- re4_ (concat "\\(" (mapconcat 'downcase words
- "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]")
- re4 (concat "[^a-zA-Z_]" re4_)
-
- re1 (concat pre re2 post)
- re3 (concat pre (if pre re4_ re4) post)
- re5 (concat pre ".*" re4)
- re2 (concat pre re2)
- re2a (concat pre (if pre re2a_ re2a))
- re4 (concat pre (if pre re4_ re4))
- reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2
- "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\("
- re5 "\\)"))
- (cond
- ((eq type 'org-occur) (org-occur reall))
- ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup))
- (t (goto-char (point-min))
- (setq type 'fuzzy)
- (if (or (and (org-search-not-self 1 re0 nil t)
- (setq type 'dedicated))
- (org-search-not-self 1 re1 nil t)
- (org-search-not-self 1 re2 nil t)
- (org-search-not-self 1 re2a nil t)
- (org-search-not-self 1 re3 nil t)
- (org-search-not-self 1 re4 nil t)
- (org-search-not-self 1 re5 nil t))
- (goto-char (match-beginning 1))
- (goto-char pos)
- (error "No match"))))))
- (and (derived-mode-p 'org-mode)
- (not stealth)
- (org-show-context 'link-search))
+ (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)))))
+ (throw :found t)))
+ nil)))
+ (beginning-of-line)
+ (setq type 'dedicated))
+ ;; Offer to create non-existent headline depending on
+ ;; `org-link-search-must-match-exact-headline'.
+ ((and (derived-mode-p 'org-mode)
+ (not org-link-search-inhibit-query)
+ (eq org-link-search-must-match-exact-headline 'query-to-create)
+ (yes-or-no-p "No match - create this as a new heading? "))
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (org-insert-heading nil t t)
+ (insert s "\n")
+ (beginning-of-line 0))
+ ;; Only headlines are looked after. No need to process
+ ;; further: throw an error.
+ ((and (derived-mode-p 'org-mode)
+ (or starred org-link-search-must-match-exact-headline))
+ (goto-char origin)
+ (error "No match for fuzzy expression: %s" normalized))
+ ;; Regular text search.
+ ((catch :fuzzy-match
+ (goto-char (point-min))
+ (while (re-search-forward s-multi-re nil t)
+ ;; Skip match if it contains AVOID-POS or it is included in
+ ;; a link with a description but outside the description.
+ (unless (or (and avoid-pos
+ (<= (match-beginning 0) avoid-pos)
+ (> (match-end 0) avoid-pos))
+ (and (save-match-data
+ (org-in-regexp org-bracket-link-regexp))
+ (match-beginning 3)
+ (or (> (match-beginning 3) (point))
+ (<= (match-end 3) (point)))
+ (org-element-lineage
+ (save-match-data (org-element-context))
+ '(link) t)))
+ (goto-char (match-beginning 0))
+ (setq type 'fuzzy)
+ (throw :fuzzy-match t)))
+ nil))
+ ;; All failed. Throw an error.
+ (t (goto-char origin)
+ (error "No match for fuzzy expression: %s" normalized)))
+ ;; Disclose surroundings of match, if appropriate.
+ (when (and (derived-mode-p 'org-mode) (not stealth))
+ (org-show-context 'link-search))
type))
-(defun org-search-not-self (group &rest args)
- "Execute `re-search-forward', but only accept matches that do not
-enclose the position of `org-open-link-marker'."
- (let ((m org-open-link-marker))
- (catch 'exit
- (while (apply #'re-search-forward args)
- (unless (get-text-property (match-end group) 'intangible) ; Emacs 21
- (goto-char (match-end group))
- (if (and (or (not (eq (marker-buffer m) (current-buffer)))
- (> (match-beginning 0) (marker-position m))
- (< (match-end 0) (marker-position m)))
- (save-match-data
- (or (not (org-in-regexp
- org-bracket-link-analytic-regexp 1))
- (not (match-end 4)) ; no description
- (and (<= (match-beginning 4) (point))
- (>= (match-end 4) (point))))))
- (throw 'exit (point))))))))
-
(defun org-get-buffer-for-internal-link (buffer)
"Return a buffer to be used for displaying the link target of internal links."
(cond
((not org-display-internal-link-with-indirect-buffer)
buffer)
- ((string-match "(Clone)$" (buffer-name buffer))
+ ((string-suffix-p "(Clone)" (buffer-name buffer))
(message "Buffer is already a clone, not making another one")
;; we also do not modify visibility in this case
buffer)
@@ -10953,8 +11054,8 @@ to read."
(goto-char (point-min))
(when (re-search-forward "match[a-z]+" nil t)
(setq beg (match-end 0))
- (if (re-search-forward "^[ \t]*[0-9]+" nil t)
- (setq end (1- (match-beginning 0)))))
+ (when (re-search-forward "^[ \t]*[0-9]+" nil t)
+ (setq end (1- (match-beginning 0)))))
(and beg end (let ((inhibit-read-only t)) (delete-region beg end)))
(goto-char (point-min))
(select-window cwin))))
@@ -10962,13 +11063,13 @@ to read."
;;; The mark ring for links jumps
(defvar org-mark-ring nil
- "Mark ring for positions before jumps in Org-mode.")
+ "Mark ring for positions before jumps in Org mode.")
(defvar org-mark-ring-last-goto nil
"Last position in the mark ring used to go back.")
;; Fill and close the ring
(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded
-(loop for i from 1 to org-mark-ring-length do
- (push (make-marker) org-mark-ring))
+(dotimes (_ org-mark-ring-length)
+ (push (make-marker) org-mark-ring))
(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring)
org-mark-ring)
@@ -10982,15 +11083,15 @@ to read."
(or buffer (current-buffer)))
(message "%s"
(substitute-command-keys
- "Position saved to mark ring, go back with \\[org-mark-ring-goto].")))
+ "Position saved to mark ring, go back with \
+`\\[org-mark-ring-goto]'.")))
(defun org-mark-ring-goto (&optional n)
"Jump to the previous position in the mark ring.
With prefix arg N, jump back that many stored positions. When
called several times in succession, walk through the entire ring.
-Org-mode commands jumping to a different position in the current file,
-or to another Org-mode file, automatically push the old position
-onto the ring."
+Org mode commands jumping to a different position in the current file,
+or to another Org file, automatically push the old position onto the ring."
(interactive "p")
(let (p m)
(if (eq last-command this-command)
@@ -10998,25 +11099,19 @@ onto the ring."
(setq p org-mark-ring))
(setq org-mark-ring-last-goto p)
(setq m (car p))
- (org-pop-to-buffer-same-window (marker-buffer m))
+ (pop-to-buffer-same-window (marker-buffer m))
(goto-char m)
- (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
+ (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto))))
-(defun org-remove-angle-brackets (s)
- (if (equal (substring s 0 1) "<") (setq s (substring s 1)))
- (if (equal (substring s -1) ">") (setq s (substring s 0 -1)))
- s)
(defun org-add-angle-brackets (s)
- (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s)))
- (if (equal (substring s -1) ">") nil (setq s (concat s ">")))
- s)
-(defun org-remove-double-quotes (s)
- (if (equal (substring s 0 1) "\"") (setq s (substring s 1)))
- (if (equal (substring s -1) "\"") (setq s (substring s 0 -1)))
+ (unless (equal (substring s 0 1) "<") (setq s (concat "<" s)))
+ (unless (equal (substring s -1) ">") (setq s (concat s ">")))
s)
;;; Following specific links
+(defvar org-agenda-buffer-tmp-name)
+(defvar org-agenda-start-on-weekday)
(defun org-follow-timestamp-link ()
"Open an agenda view for the time-stamp date/range at point."
(cond
@@ -11030,7 +11125,7 @@ onto the ring."
(format "*Org Agenda(a:%s)"
(concat (substring t1 0 10) "--" (substring t2 0 10)))))
(org-agenda-list nil tt1 (1+ (- tt2 tt1))))))
- ((org-at-timestamp-p t)
+ ((org-at-timestamp-p 'lax)
(let ((org-agenda-buffer-tmp-name
(format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10))))
(org-agenda-list nil (time-to-days (org-time-string-to-time
@@ -11071,43 +11166,47 @@ If the file does not exist, an error is thrown."
buffer-file-name
(substitute-in-file-name (expand-file-name path))))
(file-apps (append org-file-apps (org-default-apps)))
- (apps (org-remove-if
+ (apps (cl-remove-if
'org-file-apps-entry-match-against-dlink-p file-apps))
- (apps-dlink (org-remove-if-not
+ (apps-dlink (cl-remove-if-not
'org-file-apps-entry-match-against-dlink-p file-apps))
(remp (and (assq 'remote apps) (org-file-remote-p file)))
- (dirp (if remp nil (file-directory-p file)))
+ (dirp (unless remp (file-directory-p file)))
(file (if (and dirp org-open-directory-means-index-dot-org)
(concat (file-name-as-directory file) "index.org")
file))
(a-m-a-p (assq 'auto-mode apps))
(dfile (downcase file))
- ;; reconstruct the original file: link from the PATH, LINE and SEARCH args
- (link (cond ((and (eq line nil)
- (eq search nil))
- file)
- (line
- (concat file "::" (number-to-string line)))
- (search
- (concat file "::" search))))
+ ;; Reconstruct the original link from the PATH, LINE and
+ ;; SEARCH args.
+ (link (cond (line (concat file "::" (number-to-string line)))
+ (search (concat file "::" search))
+ (t file)))
(dlink (downcase link))
- (old-buffer (current-buffer))
- (old-pos (point))
- (old-mode major-mode)
- ext cmd link-match-data)
- (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile)
- (setq ext (match-string 1 dfile))
- (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile)
- (setq ext (match-string 1 dfile))))
+ (ext
+ (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile)
+ (match-string 1 dfile)))
+ (save-position-maybe
+ (let ((old-buffer (current-buffer))
+ (old-pos (point))
+ (old-mode major-mode))
+ (lambda ()
+ (and (derived-mode-p 'org-mode)
+ (eq old-mode 'org-mode)
+ (or (not (eq old-buffer (current-buffer)))
+ (not (eq old-pos (point))))
+ (org-mark-ring-push old-pos old-buffer)))))
+ cmd link-match-data)
(cond
((member in-emacs '((16) system))
- (setq cmd (cdr (assoc 'system apps))))
+ (setq cmd (cdr (assq 'system apps))))
(in-emacs (setq cmd 'emacs))
(t
- (setq cmd (or (and remp (cdr (assoc 'remote apps)))
- (and dirp (cdr (assoc 'directory apps)))
- ; first, try matching against apps-dlink
- ; if we get a match here, store the match data for later
+ (setq cmd (or (and remp (cdr (assq 'remote apps)))
+ (and dirp (cdr (assq 'directory apps)))
+ ;; First, try matching against apps-dlink if we
+ ;; get a match here, store the match data for
+ ;; later.
(let ((match (assoc-default dlink apps-dlink
'string-match)))
(if match
@@ -11120,9 +11219,9 @@ If the file does not exist, an error is thrown."
(assoc-default dfile (org-apps-regexp-alist apps a-m-a-p)
'string-match)
(cdr (assoc ext apps))
- (cdr (assoc t apps))))))
+ (cdr (assq t apps))))))
(when (eq cmd 'system)
- (setq cmd (cdr (assoc 'system apps))))
+ (setq cmd (cdr (assq 'system apps))))
(when (eq cmd 'default)
(setq cmd (cdr (assoc t apps))))
(when (eq cmd 'mailcap)
@@ -11133,21 +11232,20 @@ If the file does not exist, an error is thrown."
(if (stringp command)
(setq cmd command)
(setq cmd 'emacs))))
- (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
- (not (file-exists-p file))
- (not org-open-non-existing-files))
- (user-error "No such file: %s" file))
+ (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files
+ (not (file-exists-p file))
+ (not org-open-non-existing-files))
+ (user-error "No such file: %s" file))
(cond
((and (stringp cmd) (not (string-match "^\\s-*$" cmd)))
;; Remove quotes around the file name - we'll use shell-quote-argument.
(while (string-match "['\"]%s['\"]" cmd)
(setq cmd (replace-match "%s" t t cmd)))
- (while (string-match "%s" cmd)
- (setq cmd (replace-match
- (save-match-data
- (shell-quote-argument
- (convert-standard-filename file)))
- t t cmd)))
+ (setq cmd (replace-regexp-in-string
+ "%s"
+ (shell-quote-argument (convert-standard-filename file))
+ cmd
+ nil t))
;; Replace "%1", "%2" etc. in command with group matches from regex
(save-match-data
@@ -11169,18 +11267,34 @@ If the file does not exist, an error is thrown."
(eq cmd 'emacs))
(funcall (cdr (assq 'file org-link-frame-setup)) file)
(widen)
- (if line (org-goto-line line)
- (if search (org-link-search search))))
+ (cond (line (org-goto-line line)
+ (when (derived-mode-p 'org-mode) (org-reveal)))
+ (search (condition-case err
+ (org-link-search search)
+ ;; Save position before error-ing out so user
+ ;; can easily move back to the original buffer.
+ (error (funcall save-position-maybe)
+ (error (nth 1 err)))))))
+ ((functionp cmd)
+ (save-match-data
+ (set-match-data link-match-data)
+ (condition-case nil
+ (funcall cmd file link)
+ ;; FIXME: Remove this check when most default installations
+ ;; of Emacs have at least Org 9.0.
+ ((debug wrong-number-of-arguments wrong-type-argument
+ invalid-function)
+ (user-error "Please see Org News for version 9.0 about \
+`org-file-apps'--Lisp error: %S" cmd)))))
((consp cmd)
- (let ((file (convert-standard-filename file)))
- (save-match-data
- (set-match-data link-match-data)
- (eval cmd))))
+ ;; FIXME: Remove this check when most default installations of
+ ;; Emacs have at least Org 9.0. Heads-up instead of silently
+ ;; fall back to `org-link-frame-setup' for an old usage of
+ ;; `org-file-apps' with sexp instead of a function for `cmd'.
+ (user-error "Please see Org News for version 9.0 about \
+`org-file-apps'--Error: Deprecated usage of %S" cmd))
(t (funcall (cdr (assq 'file org-link-frame-setup)) file)))
- (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode)
- (or (not (equal old-buffer (current-buffer)))
- (not (equal old-pos (point))))
- (org-mark-ring-push old-pos old-buffer))))
+ (funcall save-position-maybe)))
(defun org-file-apps-entry-match-against-dlink-p (entry)
"This function returns non-nil if `entry' uses a regular
@@ -11220,16 +11334,15 @@ be opened in Emacs."
(append
(delq nil
(mapcar (lambda (x)
- (if (not (stringp (car x)))
- nil
+ (unless (not (stringp (car x)))
(if (string-match "\\W" (car x))
x
(cons (concat "\\." (car x) "\\'") (cdr x)))))
list))
- (if add-auto-mode
- (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
+ (when add-auto-mode
+ (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist))))
-(defvar ange-ftp-name-format) ; to silence the XEmacs compiler.
+(defvar ange-ftp-name-format)
(defun org-file-remote-p (file)
"Test whether FILE specifies a location on a remote system.
Return non-nil if the location is indeed remote.
@@ -11262,8 +11375,8 @@ on the system \"/user@host:\"."
((not (listp org-reverse-note-order)) nil)
(t (catch 'exit
(dolist (entry org-reverse-note-order)
- (if (string-match (car entry) buffer-file-name)
- (throw 'exit (cdr entry))))))))
+ (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'.")
@@ -11288,7 +11401,7 @@ on the system \"/user@host:\"."
(defun org-refile-cache-clear ()
"Clear the refile cache and disable all the markers."
- (mapc (lambda (m) (move-marker m nil)) org-refile-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"))
@@ -11323,17 +11436,23 @@ on the system \"/user@host:\"."
org-refile-cache))))
(and set (org-refile-cache-check-set set) set)))))
-(defun org-refile-get-targets (&optional default-buffer excluded-entries)
+(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 txt re files desc descre fast-path-p level pos0)
+ 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))
- (setq fast-path-p nil)
(cond
((null files) (setq files (list (current-buffer))))
((eq files 'org-agenda-files)
@@ -11342,7 +11461,7 @@ on the system \"/user@host:\"."
(setq files (funcall files)))
((and (symbolp files) (boundp files))
(setq files (symbol-value files))))
- (if (stringp files) (setq files (list files)))
+ (when (stringp files) (setq files (list files)))
(cond
((eq (car desc) :tag)
(setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
@@ -11357,7 +11476,6 @@ on the system \"/user@host:\"."
(cdr desc)))
"\\}[ \t]")))
((eq (car desc) :maxlevel)
- (setq fast-path-p t)
(setq descre (concat "^\\*\\{1," (number-to-string
(if org-odd-levels-only
(1- (* 2 (cdr desc)))
@@ -11365,99 +11483,119 @@ on the system \"/user@host:\"."
"\\}[ \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))
+ (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
- (if (bufferp f) (setq f (buffer-file-name
- (buffer-base-buffer f))))
+ (when (bufferp f)
+ (setq f (buffer-file-name (buffer-base-buffer f))))
(setq f (and f (expand-file-name f)))
- (if (eq org-refile-use-outline-path 'file)
- (push (list (file-name-nondirectory f) f nil nil) tgs))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward descre nil t)
- (goto-char (setq pos0 (point-at-bol)))
- (catch 'next
- (when org-refile-target-verify-function
- (save-match-data
- (or (funcall org-refile-target-verify-function)
- (throw 'next t))))
- (when (and (looking-at org-complex-heading-regexp)
- (not (member (match-string 4) excluded-entries))
- (match-string 4))
- (setq level (org-reduced-level
- (- (match-end 1) (match-beginning 1)))
- txt (org-link-display-format (match-string 4))
- txt (replace-regexp-in-string "\\( *[[0-9]+/?[0-9]*%?]\\)+$" "" txt)
- re (format org-complex-heading-regexp-format
- (regexp-quote (match-string 4))))
- (when org-refile-use-outline-path
- (setq txt (mapconcat
- 'org-protect-slash
- (append
- (if (eq org-refile-use-outline-path
- 'file)
- (list (file-name-nondirectory
- (buffer-file-name
- (buffer-base-buffer))))
- (if (eq org-refile-use-outline-path
- 'full-file-path)
- (list (buffer-file-name
- (buffer-base-buffer)))))
- (org-get-outline-path fast-path-p
- level txt)
- (list txt))
- "/")))
- (push (list txt f re (org-refile-marker (point)))
- tgs)))
- (when (= (point) pos0)
- ;; verification function has not moved point
- (goto-char (point-at-eol))))))))
+ (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")
- (nreverse targets)))
-
-(defun org-protect-slash (s)
- (while (string-match "/" s)
- (setq s (replace-match "\\" t t s)))
- s)
-
-(defvar org-olpa (make-vector 20 nil))
-
-(defun org-get-outline-path (&optional fastp level heading)
- "Return the outline path to the current entry, as a list.
-
-The parameters FASTP, LEVEL, and HEADING are for use by a scanner
-routine which makes outline path derivations for an entire file,
-avoiding backtracing. Refile target collection makes use of that."
- (if fastp
- (progn
- (if (> level 19)
- (error "Outline path failure, more than 19 levels"))
- (loop for i from level upto 19 do
- (aset org-olpa i nil))
- (prog1
- (delq nil (append org-olpa nil))
- (aset org-olpa level heading)))
- (let (rtn case-fold-search)
- (save-excursion
- (save-restriction
- (widen)
- (while (org-up-heading-safe)
- (when (looking-at org-complex-heading-regexp)
- (push (org-trim
- (replace-regexp-in-string
- ;; Remove statistical/checkboxes cookies
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-match-string-no-properties 4)))
- rtn)))
- rtn)))))
+ (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.
@@ -11467,38 +11605,28 @@ such as the file name.
SEPARATOR is inserted between the different parts of the path,
the default is \"/\"."
(setq width (or width 79))
- (if prefix (setq width (- width (length prefix))))
- (if (not path)
- (or prefix "")
- (let* ((nsteps (length path))
- (total-width (+ nsteps (apply '+ (mapcar 'length path))))
- (maxwidth (if (<= total-width width)
- 10000 ;; everything fits
- ;; we need to shorten the level headings
- (/ (- width nsteps) nsteps)))
- (org-odd-levels-only nil)
- (n 0)
- (total (1+ (length prefix))))
- (setq maxwidth (max maxwidth 10))
- (concat prefix
- (if prefix (or separator "/"))
- (mapconcat
- (lambda (h)
- (setq n (1+ n))
- (if (and (= n nsteps) (< maxwidth 10000))
- (setq maxwidth (- total-width total)))
- (if (< (length h) maxwidth)
- (progn (setq total (+ total (length h) 1)) h)
- (setq h (substring h 0 (- maxwidth 2))
- total (+ total maxwidth 1))
- (if (string-match "[ \t]+\\'" h)
- (setq h (substring h 0 (match-beginning 0))))
- (setq h (concat h "..")))
- (org-add-props h nil 'face
- (nth (% (1- n) org-n-level-faces)
- org-level-faces))
- h)
- path (or separator "/"))))))
+ (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.
@@ -11513,10 +11641,10 @@ If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
(bfn (buffer-file-name (buffer-base-buffer)))
(path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
res)
- (if current (setq path (append path
- (save-excursion
- (org-back-to-heading t)
- (if (looking-at org-complex-heading-regexp)
+ (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
@@ -11546,25 +11674,27 @@ the *old* location.")
(let ((org-refile-keep t))
(funcall 'org-refile nil nil nil "Copy")))
-(defun org-refile (&optional goto default-buffer rfloc msg)
+(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.
+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 moved.
-However, the region must fulfill the requirement that the first heading
-is the first one sets the top-level of the moved text - at most siblings
-below it are allowed.
+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 prefix arg GOTO, the command will only visit the target location
+With a `\\[universal-argument]' ARG, the command will only visit the target \
+location
and not actually move anything.
-With a double prefix arg \\[universal-argument] \\[universal-argument], \
-go to the location where the last refiling operation has put the subtree.
+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.
@@ -11578,26 +11708,23 @@ 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' and `org-completion-use-ido'.
+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
+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 goto '(0 (64)))
+ (if (member arg '(0 (64)))
(org-refile-cache-clear)
(let* ((actionmsg (cond (msg msg)
- ((equal goto 3) "Refile (and keep)")
+ ((equal arg 3) "Refile (and keep)")
(t "Refile")))
- (cbuf (current-buffer))
(regionp (org-region-active-p))
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
- (filename (buffer-file-name (buffer-base-buffer cbuf)))
- (org-refile-keep (if (equal goto 3) t org-refile-keep))
- pos it nbuf file re level reversed)
+ (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)
@@ -11610,10 +11737,10 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(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 goto '(16))
+ (if (equal arg '(16))
(org-refile-goto-last-stored)
(when (or
- (and (equal goto 2)
+ (and (equal arg 2)
org-clock-hd-marker (marker-buffer org-clock-hd-marker)
(prog1
(setq it (list (or org-clock-heading "running clock")
@@ -11621,44 +11748,47 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(marker-buffer org-clock-hd-marker))
""
(marker-position org-clock-hd-marker)))
- (setq goto nil)))
- (setq it (or rfloc
- (let (heading-text)
- (save-excursion
- (unless (and goto (listp goto))
- (org-back-to-heading t)
- (setq heading-text
- (nth 4 (org-heading-components))))
-
- (org-refile-get-location
- (cond ((and goto (listp goto)) "Goto")
- (regionp (concat actionmsg " region to"))
- (t (concat actionmsg " subtree \""
- heading-text "\" to")))
- default-buffer
- (and (not (equal '(4) goto))
- org-refile-allow-creating-parent-nodes)
- goto))))))
+ (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-bracket-link-regexp
+ "\\3"
+ (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)
- re (nth 2 it)
pos (nth 3 it))
- (if (and (not goto)
- 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"))
-
+ (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 goto (not (equal goto 3)))
+ (if (and arg (not (equal arg 3)))
(progn
- (org-pop-to-buffer-same-window nbuf)
- (goto-char pos)
+ (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
@@ -11668,50 +11798,47 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(with-current-buffer (setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
(setq reversed (org-notes-order-reversed-p))
- (save-excursion
- (save-restriction
- (widen)
- (if pos
- (progn
- (goto-char pos)
- (looking-at org-outline-regexp)
- (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)))))
- (if (not (bolp)) (newline))
- (org-paste-subtree level)
- (when org-log-refile
- (org-add-log-setup 'refile nil nil 'findpos org-log-refile)
- (unless (eq org-log-refile 'note)
- (save-excursion (org-add-log-note))))
- (and org-auto-align-tags
- (let ((org-loop-over-headlines-in-active-region nil))
- (org-set-tags nil t)))
- (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 (org-bound-and-true-p org-refile-for-capture)
- (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)))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
- (run-hooks 'org-after-refile-insert-hook))))
+ (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)
+ (when org-log-refile
+ (org-add-log-setup 'refile nil nil org-log-refile)
+ (unless (eq org-log-refile 'note)
+ (save-excursion (org-add-log-note))))
+ (and org-auto-align-tags
+ (let ((org-loop-over-headlines-in-active-region nil))
+ (org-set-tags nil t)))
+ (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)))
@@ -11726,7 +11853,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(defun org-refile-goto-last-stored ()
"Go to the location where the last refile was stored."
(interactive)
- (bookmark-jump "org-refile-last-stored")
+ (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)
@@ -11740,35 +11867,22 @@ Also check `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
- no-exclude)
+(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.
-When NO-EXCLUDE is set, do not exclude headlines in the current subtree,
-this is used for the GOTO interface."
+`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)
- excluded-entries)
- (when (and (derived-mode-p 'org-mode)
- (not org-refile-use-cache)
- (not no-exclude))
- (org-map-tree
- (lambda()
- (setq excluded-entries
- (append excluded-entries (list (org-get-heading t t)))))))
- (setq org-refile-target-table
- (org-refile-get-targets default-buffer excluded-entries)))
+ (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))
- (partial-completion-mode nil)
(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
- 'org-icompleting-read))
+ #'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)))
@@ -11803,8 +11917,8 @@ this is used for the GOTO interface."
(cons (car pa) (if (assoc (car org-refile-history) tbl)
org-refile-history
(cdr org-refile-history))))
- (if (equal (car org-refile-history) (nth 1 org-refile-history))
- (pop org-refile-history)))
+ (when (equal (car org-refile-history) (nth 1 org-refile-history))
+ (pop org-refile-history)))
pa)
(if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ)
(progn
@@ -11827,20 +11941,18 @@ this is used for the GOTO interface."
(pos (nth 3 refile-pointer))
buffer)
(if (and (not (markerp pos)) (not file))
- (user-error "Please save the buffer to a file before refiling")
+ (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
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (beginning-of-line 1)
- (unless (org-looking-at-p re)
- (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))))
+ (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."
@@ -11851,53 +11963,43 @@ this is used for the GOTO interface."
level)
(with-current-buffer (or (find-buffer-visiting file)
(find-file-noselect file))
- (save-excursion
- (save-restriction
- (widen)
- (if pos
- (goto-char pos)
- (goto-char (point-max))
- (if (not (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)))))))
+ (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)
- (org-completion-use-ido nil) ; does not work with ido.
- (org-completion-use-iswitchb nil)) ; or iswitchb
- (apply
- 'org-icompleting-read prompt
- (lambda (string predicate &optional flag)
- (let (rtn r f (l (length string)))
- (cond
- ((eq flag nil)
- ;; try completion
- (try-completion string thetable))
- ((eq flag t)
- ;; all-completions
- (setq rtn (all-completions string thetable predicate))
- (mapcar
- (lambda (x)
- (setq r (substring x l))
- (if (string-match " ([^)]*)$" x)
- (setq f (match-string 0 x))
- (setq f ""))
- (if (string-match "/" r)
- (concat string (substring r 0 (match-end 0)) f)
- x))
- rtn))
- ((eq flag 'lambda)
- ;; exact match?
- (assoc string thetable)))))
- args)))
+ (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
@@ -11910,19 +12012,12 @@ If not found, stay at current position and return nil."
(setq pos (and (re-search-forward
(concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t)
(match-beginning 0))))
- (if pos (goto-char pos))
+ (when pos (goto-char pos))
pos))
-(defconst org-dblock-start-re
- "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?"
- "Matches the start line of a dynamic block, with parameters.")
-
-(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)"
- "Matches the end of a dynamic block.")
-
(defun org-create-dblock (plist)
"Create a dynamic block section, with parameters taken from PLIST.
-PLIST must contain a :name entry which is used as name of the block."
+PLIST must contain a :name entry which is used as the name of the block."
(when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol)))
(end-of-line 1)
(newline))
@@ -12042,13 +12137,14 @@ This function can be used in a hook."
;;;; Completion
+(declare-function org-export-backend-options "ox" (cl-x) t)
(defun org-get-export-keywords ()
"Return a list of all currently understood export keywords.
Export keywords include options, block names, attributes and
keywords relative to each registered export back-end."
(let (keywords)
(dolist (backend
- (org-bound-and-true-p org-export--registered-backends)
+ (bound-and-true-p org-export-registered-backends)
(delq nil keywords))
;; Back-end name (for keywords, like #+LATEX:)
(push (upcase (symbol-name (org-export-backend-name backend))) keywords)
@@ -12064,27 +12160,25 @@ keywords relative to each registered export back-end."
"TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:"))
(defcustom org-structure-template-alist
- '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "<src lang=\"?\">\n\n</src>")
- ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "<example>\n?\n</example>")
- ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "<quote>\n?\n</quote>")
- ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "<verse>\n?\n</verse>")
- ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "<verbatim>\n?\n</verbatim>")
- ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "<center>\n?\n</center>")
- ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX"
- "<literal style=\"latex\">\n?\n</literal>")
- ("L" "#+LaTeX: " "<literal style=\"latex\">?</literal>")
- ("h" "#+BEGIN_HTML\n?\n#+END_HTML"
- "<literal style=\"html\">\n?\n</literal>")
- ("H" "#+HTML: " "<literal style=\"html\">?</literal>")
- ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "")
- ("A" "#+ASCII: " "")
- ("i" "#+INDEX: ?" "#+INDEX: ?")
- ("I" "#+INCLUDE: %file ?"
- "<include file=%file markup=\"?\">"))
+ '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC")
+ ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE")
+ ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE")
+ ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE")
+ ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM")
+ ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER")
+ ("C" "#+BEGIN_COMMENT\n?\n#+END_COMMENT")
+ ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT")
+ ("L" "#+LaTeX: ")
+ ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT")
+ ("H" "#+HTML: ")
+ ("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT")
+ ("A" "#+ASCII: ")
+ ("i" "#+INDEX: ?")
+ ("I" "#+INCLUDE: %file ?"))
"Structure completion elements.
This is a list of abbreviation keys and values. The value gets inserted
if you type `<' followed by the key and then press the completion key,
-usually `M-TAB'. %file will be replaced by a file name after prompting
+usually `TAB'. %file will be replaced by a file name after prompting
for the file using completion. The cursor will be placed at the position
of the `?' in the template.
There are two templates for each key, the first uses the original Org syntax,
@@ -12095,8 +12189,9 @@ variable `org-mtags-prefer-muse-templates'."
:type '(repeat
(list
(string :tag "Key")
- (string :tag "Template")
- (string :tag "Muse Template"))))
+ (string :tag "Template")))
+ :version "26.1"
+ :package-version '(Org . "8.3"))
(defun org-try-structure-completion ()
"Try to complete a structure template before point.
@@ -12113,29 +12208,28 @@ expands them."
(defun org-complete-expand-structure-template (start cell)
"Expand a structure template."
- (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates))
- (rpl (nth (if musep 2 1) cell))
- (ind ""))
+ (let ((rpl (nth 1 cell))
+ (ind ""))
(delete-region start (point))
- (when (string-match "\\`#\\+" rpl)
+ (when (string-match "\\`[ \t]*#\\+" rpl)
(cond
((bolp))
((not (string-match "\\S-" (buffer-substring (point-at-bol) (point))))
(setq ind (buffer-substring (point-at-bol) (point))))
(t (newline))))
(setq start (point))
- (if (string-match "%file" rpl)
- (setq rpl (replace-match
- (concat
- "\""
- (save-match-data
- (abbreviate-file-name (read-file-name "Include file: ")))
- "\"")
- t t rpl)))
+ (when (string-match "%file" rpl)
+ (setq rpl (replace-match
+ (concat
+ "\""
+ (save-match-data
+ (abbreviate-file-name (read-file-name "Include file: ")))
+ "\"")
+ t t rpl)))
(setq rpl (mapconcat 'identity (split-string rpl "\n")
(concat "\n" ind)))
(insert rpl)
- (if (re-search-backward "\\?" start t) (delete-char 1))))
+ (when (re-search-backward "\\?" start t) (delete-char 1))))
;;;; TODO, DEADLINE, Comments
@@ -12144,17 +12238,18 @@ expands them."
(interactive)
(save-excursion
(org-back-to-heading)
- (let (case-fold-search)
- (cond
- ((looking-at (format org-heading-keyword-regexp-format
- org-comment-string))
- (goto-char (match-end 1))
- (looking-at (concat " +" org-comment-string))
- (replace-match "" t t)
- (when (eolp) (insert " ")))
- ((looking-at org-outline-regexp)
- (goto-char (match-end 0))
- (insert org-comment-string " "))))))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ (goto-char (or (match-end 3) (match-end 2) (match-end 1)))
+ (skip-chars-forward " \t")
+ (unless (memq (char-before) '(?\s ?\t)) (insert " "))
+ (if (org-in-commented-heading-p t)
+ (delete-region (point)
+ (progn (search-forward " " (line-end-position) 'move)
+ (skip-chars-forward " \t")
+ (point)))
+ (insert org-comment-string)
+ (unless (eolp) (insert " ")))))
(defvar org-last-todo-state-is-todo nil
"This is non-nil when the last TODO state change led to a TODO state.
@@ -12193,43 +12288,65 @@ nil or a string to be used for the todo mark." )
(interactive "P")
(if (eq major-mode 'org-agenda-mode)
(apply 'org-agenda-todo-yesterday arg)
- (let* ((hour (third (decode-time
- (org-current-time))))
+ (let* ((org-use-effective-time t)
+ (hour (nth 2 (decode-time (org-current-time))))
(org-extend-today-until (1+ hour)))
(org-todo arg))))
(defvar org-block-entry-blocking ""
"First entry preventing the TODO state change.")
+(defun org-cancel-repeater ()
+ "Cancel a repeater by setting its numeric value to zero."
+ (interactive)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((bound1 (point))
+ (bound0 (save-excursion (outline-next-heading) (point))))
+ (when (and (re-search-forward
+ (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
+ org-deadline-time-regexp "\\)\\|\\("
+ org-ts-regexp "\\)")
+ bound0 t)
+ (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]"
+ bound1 t))
+ (replace-match "0" t nil nil 1)))))
+
+(defvar org-state)
+(defvar org-blocked-by-checkboxes)
(defun org-todo (&optional arg)
"Change the TODO state of an item.
+
The state of an item is given by a keyword at the start of the heading,
like
*** TODO Write paper
*** DONE Call mom
The different keywords are specified in the variable `org-todo-keywords'.
-By default the available states are \"TODO\" and \"DONE\".
-So for this example: when the item starts with TODO, it is changed to DONE.
+By default the available states are \"TODO\" and \"DONE\". So, for this
+example: when the item starts with TODO, it is changed to DONE.
When it starts with DONE, the DONE is removed. And when neither TODO nor
DONE are present, add TODO at the beginning of the heading.
-With \\[universal-argument] prefix arg, use completion to determine the new \
+With `\\[universal-argument]' prefix ARG, use completion to determine the new \
state.
-With numeric prefix arg, switch to that state.
-With a double \\[universal-argument] prefix, switch to the next set of TODO \
+With numeric prefix ARG, switch to that state.
+With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \
+next set of TODO \
keywords (nextset).
-With a triple \\[universal-argument] prefix, circumvent any state blocking.
+With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix, circumvent any state blocking.
With a numeric prefix arg of 0, inhibit note taking for the change.
-
-For calling through lisp, arg is also interpreted in the following way:
-`none' -> empty state
-\"\" (empty string) -> switch to empty state
-`done' -> switch to DONE
-`nextset' -> switch to the next set of keywords
-`previousset' -> switch to the previous set of keywords
-\"WAITING\" -> switch to the specified keyword, but only if it
- really is a member of `org-todo-keywords'."
+With a numeric prefix arg of -1, cancel repeater to allow marking as DONE.
+
+When called through ELisp, arg is also interpreted in the following way:
+`none' -> empty state
+\"\" -> switch to empty state
+`done' -> switch to DONE
+`nextset' -> switch to the next set of keywords
+`previousset' -> switch to the previous set of keywords
+\"WAITING\" -> switch to the specified keyword, but only if it
+ really is a member of `org-todo-keywords'."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
@@ -12238,8 +12355,9 @@ For calling through lisp, arg is also interpreted in the following way:
(org-map-entries
`(org-todo ,arg)
org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (if (equal arg '(16)) (setq arg 'nextset))
+ 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)
commentp
case-fold-search)
@@ -12252,10 +12370,10 @@ For calling through lisp, arg is also interpreted in the following way:
(save-excursion
(catch 'exit
(org-back-to-heading t)
- (when (looking-at (concat "^\\*+ " org-comment-string))
+ (when (org-in-commented-heading-p t)
(org-toggle-comment)
(setq commentp t))
- (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
+ (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0))))
(or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)"))
(looking-at "\\(?: *\\|[ \t]*$\\)"))
(let* ((match-data (match-data))
@@ -12285,31 +12403,30 @@ For calling through lisp, arg is also interpreted in the following way:
(and (not arg) org-use-fast-todo-selection
(not (eq org-use-fast-todo-selection
'prefix)))))
- ;; Use fast selection
+ ;; Use fast selection.
(org-fast-todo-selection))
((and (equal arg '(4))
(or (not org-use-fast-todo-selection)
(not org-todo-key-trigger)))
- ;; Read a state with completion
- (org-icompleting-read
- "State: " (mapcar 'list org-todo-keywords-1)
+ ;; Read a state with completion.
+ (completing-read
+ "State: " (mapcar #'list org-todo-keywords-1)
nil t))
((eq arg 'right)
(if this
(if tail (car tail) nil)
(car org-todo-keywords-1)))
((eq arg 'left)
- (if (equal member org-todo-keywords-1)
- nil
+ (unless (equal member org-todo-keywords-1)
(if this
(nth (- (length org-todo-keywords-1)
(length tail) 2)
org-todo-keywords-1)
(org-last org-todo-keywords-1))))
((and (eq org-use-fast-todo-selection t) (equal arg '(4))
- (setq arg nil))) ; hack to fall back to cycling
+ (setq arg nil))) ;hack to fall back to cycling
(arg
- ;; user or caller requests a specific state
+ ;; User or caller requests a specific state.
(cond
((equal arg "") nil)
((eq arg 'none) nil)
@@ -12327,8 +12444,8 @@ For calling through lisp, arg is also interpreted in the following way:
((nth (1- (prefix-numeric-value arg))
org-todo-keywords-1))))
((null member) (or head (car org-todo-keywords-1)))
- ((equal this final-done-word) nil) ;; -> make empty
- ((null tail) nil) ;; -> first entry
+ ((equal this final-done-word) nil) ;-> make empty
+ ((null tail) nil) ;-> first entry
((memq interpret '(type priority))
(if (eq this-command last-command)
(car tail)
@@ -12346,24 +12463,30 @@ For calling through lisp, arg is also interpreted in the following way:
:position startpos))
dolog now-done-p)
(when org-blocker-hook
- (setq org-last-todo-state-is-todo
- (not (member this org-done-keywords)))
- (unless (save-excursion
- (save-match-data
- (org-with-wide-buffer
- (run-hook-with-args-until-failure
- 'org-blocker-hook change-plist))))
- (if (org-called-interactively-p 'interactive)
- (user-error "TODO state change from %s to %s blocked (by \"%s\")"
- this org-state org-block-entry-blocking)
- ;; fail silently
- (message "TODO state change from %s to %s blocked (by \"%s\")"
- this org-state org-block-entry-blocking)
- (throw 'exit nil))))
+ (let (org-blocked-by-checkboxes block-reason)
+ (setq org-last-todo-state-is-todo
+ (not (member this org-done-keywords)))
+ (unless (save-excursion
+ (save-match-data
+ (org-with-wide-buffer
+ (run-hook-with-args-until-failure
+ 'org-blocker-hook change-plist))))
+ (setq block-reason (if org-blocked-by-checkboxes
+ "contained checkboxes"
+ (format "\"%s\"" org-block-entry-blocking)))
+ (if (called-interactively-p 'interactive)
+ (user-error "TODO state change from %s to %s blocked (by %s)"
+ this org-state block-reason)
+ ;; Fail silently.
+ (message "TODO state change from %s to %s blocked (by %s)"
+ this org-state block-reason)
+ (throw 'exit nil)))))
(store-match-data match-data)
(replace-match next t t)
- (unless (pos-visible-in-window-p hl-pos)
- (message "TODO state changed to %s" (org-trim next)))
+ (cond ((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))))
(unless head
(setq head (org-get-todo-sequence-head org-state)
ass (assoc head org-todo-kwd-alist)
@@ -12384,11 +12507,11 @@ For calling through lisp, arg is also interpreted in the following way:
(when (and (or org-todo-log-states org-log-done)
(not (eq org-inhibit-logging t))
(not (memq arg '(nextset previousset))))
- ;; we need to look at recording a time and note
+ ;; We need to look at recording a time and note.
(setq dolog (or (nth 1 (assoc org-state org-todo-log-states))
(nth 2 (assoc this org-todo-log-states))))
- (if (and (eq dolog 'note) (eq org-inhibit-logging 'note))
- (setq dolog 'time))
+ (when (and (eq dolog 'note) (eq org-inhibit-logging 'note))
+ (setq dolog 'time))
(when (or (and (not org-state) (not org-closed-keep-when-no-todo))
(and org-state
(member org-state org-not-done-keywords)
@@ -12397,21 +12520,21 @@ For calling through lisp, arg is also interpreted in the following way:
;; If there was a CLOSED time stamp, get rid of it.
(org-add-planning-info nil nil 'closed))
(when (and now-done-p org-log-done)
- ;; It is now done, and it was not done before
+ ;; It is now done, and it was not done before.
(org-add-planning-info 'closed (org-current-effective-time))
- (if (and (not dolog) (eq 'note org-log-done))
- (org-add-log-setup 'done org-state this 'findpos 'note)))
+ (when (and (not dolog) (eq 'note org-log-done))
+ (org-add-log-setup 'done org-state this 'note)))
(when (and org-state dolog)
- ;; This is a non-nil state, and we need to log it
- (org-add-log-setup 'state org-state this 'findpos dolog)))
- ;; Fixup tag positioning
+ ;; This is a non-nil state, and we need to log it.
+ (org-add-log-setup 'state org-state this dolog)))
+ ;; Fixup tag positioning.
(org-todo-trigger-tag-changes org-state)
(and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t))
(when org-provide-todo-statistics
(org-update-parent-todo-statistics))
(run-hooks 'org-after-todo-state-change-hook)
- (if (and arg (not (member org-state org-done-keywords)))
- (setq head (org-get-todo-sequence-head org-state)))
+ (when (and arg (not (member org-state org-done-keywords)))
+ (setq head (org-get-todo-sequence-head org-state)))
(put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head)
;; Do we need to trigger a repeat?
(when now-done-p
@@ -12421,15 +12544,14 @@ For calling through lisp, arg is also interpreted in the following way:
(setq org-agenda-headline-snapshot-before-repeat
(org-get-heading))))
(org-auto-repeat-maybe org-state))
- ;; Fixup cursor location if close to the keyword
- (if (and (outline-on-heading-p)
- (not (bolp))
- (save-excursion (beginning-of-line 1)
- (looking-at org-todo-line-regexp))
- (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
- (progn
- (goto-char (or (match-end 2) (match-end 1)))
- (and (looking-at " ") (just-one-space))))
+ ;; Fixup cursor location if close to the keyword.
+ (when (and (outline-on-heading-p)
+ (not (bolp))
+ (save-excursion (beginning-of-line 1)
+ (looking-at org-todo-line-regexp))
+ (< (point) (+ 2 (or (match-end 2) (match-end 1)))))
+ (goto-char (or (match-end 2) (match-end 1)))
+ (and (looking-at " ") (just-one-space)))
(when org-trigger-hook
(save-excursion
(run-hook-with-args 'org-trigger-hook change-plist)))
@@ -12471,10 +12593,10 @@ changes. Such blocking occurs when:
(> child-level this-level))
;; this todo has children, check whether they are all
;; completed
- (if (and (not (org-entry-is-done-p))
- (org-entry-is-todo-p))
- (progn (setq org-block-entry-blocking (org-get-heading))
- (throw 'dont-block nil)))
+ (when (and (not (org-entry-is-done-p))
+ (org-entry-is-todo-p))
+ (setq org-block-entry-blocking (org-get-heading))
+ (throw 'dont-block nil))
(outline-next-heading)
(setq child-level (funcall outline-level))))))
;; Otherwise, if the task's parent has the :ORDERED: property, and
@@ -12482,8 +12604,9 @@ changes. Such blocking occurs when:
(save-excursion
(org-back-to-heading t)
(let* ((pos (point))
- (parent-pos (and (org-up-heading-safe) (point))))
- (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (parent-pos (and (org-up-heading-safe) (point)))
+ (case-fold-search nil))
+ (unless parent-pos (throw 'dont-block t)) ; no parent
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
(re-search-forward org-not-done-heading-regexp pos t))
@@ -12492,11 +12615,11 @@ changes. Such blocking occurs when:
;; Search further up the hierarchy, to see if an ancestor is blocked
(while t
(goto-char parent-pos)
- (if (not (looking-at org-not-done-heading-regexp))
- (throw 'dont-block t)) ; do not block, parent is not a TODO
+ (unless (looking-at org-not-done-heading-regexp)
+ (throw 'dont-block t)) ; do not block, parent is not a TODO
(setq pos (point))
(setq parent-pos (and (org-up-heading-safe) (point)))
- (if (not parent-pos) (throw 'dont-block t)) ; no parent
+ (unless parent-pos (throw 'dont-block t)) ; no parent
(when (and (org-not-nil (org-entry-get (point) "ORDERED"))
(forward-line 1)
(re-search-forward org-not-done-heading-regexp pos t)
@@ -12533,14 +12656,13 @@ See variable `org-track-ordered-property-with-tag'."
(org-back-to-heading)
(if (org-entry-get nil "ORDERED")
(progn
- (org-delete-property "ORDERED" "PROPERTIES")
+ (org-delete-property "ORDERED")
(and tag (org-toggle-tag tag 'off))
(message "Subtasks can be completed in arbitrary order"))
(org-entry-put nil "ORDERED" "t")
(and tag (org-toggle-tag tag 'on))
(message "Subtasks must be completed in sequence")))))
-(defvar org-blocked-by-checkboxes) ; dynamically scoped
(defun org-block-todo-from-checkboxes (change-plist)
"Block turning an entry into a TODO, using checkboxes.
This checks whether the current task should be blocked from state
@@ -12564,32 +12686,32 @@ changes because there are unchecked boxes in this entry."
(outline-next-heading)
(setq end (point))
(goto-char beg)
- (if (org-list-search-forward
- (concat (org-item-beginning-re)
- "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
- "\\[[- ]\\]")
- end t)
- (progn
- (if (boundp 'org-blocked-by-checkboxes)
- (setq org-blocked-by-checkboxes t))
- (throw 'dont-block nil)))))
+ (when (org-list-search-forward
+ (concat (org-item-beginning-re)
+ "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
+ "\\[[- ]\\]")
+ end t)
+ (when (boundp 'org-blocked-by-checkboxes)
+ (setq org-blocked-by-checkboxes t))
+ (throw 'dont-block nil))))
t))) ; do not block
(defun org-entry-blocked-p ()
- "Is the current entry blocked?"
- (org-with-silent-modifications
- (if (org-entry-get nil "NOBLOCKING")
- nil ;; Never block this entry
- (not (run-hook-with-args-until-failure
- 'org-blocker-hook
- (list :type 'todo-state-change
- :position (point)
- :from 'todo
- :to 'done))))))
+ "Non-nil if entry at point is blocked."
+ (and (not (org-entry-get nil "NOBLOCKING"))
+ (member (org-entry-get nil "TODO") org-not-done-keywords)
+ (not (run-hook-with-args-until-failure
+ 'org-blocker-hook
+ (list :type 'todo-state-change
+ :position (point)
+ :from 'todo
+ :to 'done)))))
(defun org-update-statistics-cookies (all)
"Update the statistics cookie, either from TODO or from checkboxes.
-This should be called with the cursor in a line with a statistics cookie."
+This should be called with the cursor in a line with a statistics
+cookie. When called with a \\[universal-argument] prefix, update
+all statistics cookies in the buffer."
(interactive "P")
(if all
(progn
@@ -12605,7 +12727,7 @@ This should be called with the cursor in a line with a statistics cookie."
(setq l1 (org-outline-level))
(setq end (save-excursion
(outline-next-heading)
- (if (org-at-heading-p) (setq l2 (org-outline-level)))
+ (when (org-at-heading-p) (setq l2 (org-outline-level)))
(point)))
(if (and (save-excursion
(re-search-forward
@@ -12642,7 +12764,7 @@ statistics everywhere."
(box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
level ltoggle l1 new ndel
(cnt-all 0) (cnt-done 0) is-percent kwd
- checkbox-beg ov ovs ove cookie-present)
+ checkbox-beg cookie-present)
(catch 'exit
(save-excursion
(beginning-of-line 1)
@@ -12677,14 +12799,31 @@ statistics everywhere."
(setq kwd (and (or recursive (= l1 ltoggle))
(match-string 2)))
(if (or (eq org-provide-todo-statistics 'all-headlines)
+ (and (eq org-provide-todo-statistics t)
+ (or (member kwd org-done-keywords)))
(and (listp org-provide-todo-statistics)
+ (stringp (car org-provide-todo-statistics))
(or (member kwd org-provide-todo-statistics)
- (member kwd org-done-keywords))))
+ (member kwd org-done-keywords)))
+ (and (listp org-provide-todo-statistics)
+ (listp (car org-provide-todo-statistics))
+ (or (member kwd (car org-provide-todo-statistics))
+ (and (member kwd org-done-keywords)
+ (member kwd (cadr org-provide-todo-statistics))))))
(setq cnt-all (1+ cnt-all))
- (if (eq org-provide-todo-statistics t)
- (and kwd (setq cnt-all (1+ cnt-all)))))
- (and (member kwd org-done-keywords)
- (setq cnt-done (1+ cnt-done)))
+ (and (eq org-provide-todo-statistics t)
+ kwd
+ (setq cnt-all (1+ cnt-all))))
+ (when (or (and (member org-provide-todo-statistics '(t all-headlines))
+ (member kwd org-done-keywords))
+ (and (listp org-provide-todo-statistics)
+ (listp (car org-provide-todo-statistics))
+ (member kwd org-done-keywords)
+ (member kwd (cadr org-provide-todo-statistics)))
+ (and (listp org-provide-todo-statistics)
+ (stringp (car org-provide-todo-statistics))
+ (member kwd org-done-keywords)))
+ (setq cnt-done (1+ cnt-done)))
(outline-next-heading)))
(setq new
(if is-percent
@@ -12692,15 +12831,10 @@ statistics everywhere."
(max 1 cnt-all)))
(format "[%d/%d]" cnt-done cnt-all))
ndel (- (match-end 0) checkbox-beg))
- ;; handle overlays when updating cookie from column view
- (when (setq ov (car (overlays-at checkbox-beg)))
- (setq ovs (overlay-start ov) ove (overlay-end ov))
- (delete-overlay ov))
(goto-char checkbox-beg)
(insert new)
(delete-region (point) (+ (point) ndel))
- (when org-auto-align-tags (org-fix-tags-on-the-fly))
- (when ov (move-overlay ov ovs ove)))
+ (when org-auto-align-tags (org-fix-tags-on-the-fly)))
(when cookie-present
(run-hook-with-args 'org-after-todo-statistics-hook
cnt-done (- cnt-all cnt-done))))))
@@ -12736,9 +12870,9 @@ This hook runs even if there is no statistics cookie present, in which case
(when (and (stringp state) (> (length state) 0))
(setq changes (append changes (cdr (assoc state l)))))
(when (member state org-not-done-keywords)
- (setq changes (append changes (cdr (assoc 'todo l)))))
+ (setq changes (append changes (cdr (assq 'todo l)))))
(when (member state org-done-keywords)
- (setq changes (append changes (cdr (assoc 'done l)))))
+ (setq changes (append changes (cdr (assq 'done l)))))
(dolist (c changes)
(org-toggle-tag (car c) (if (cdr c) 'on 'off)))))
@@ -12748,8 +12882,8 @@ This hook runs even if there is no statistics cookie present, in which case
(setq org-log-done nil
org-log-repeat nil
org-todo-log-states nil)
- (dolist (w (org-split-string value))
- (let* (a)
+ (dolist (w (split-string value))
+ (let (a)
(cond
((setq a (assoc w org-startup-options))
(and (member (nth 1 a) '(org-log-done org-log-repeat))
@@ -12786,7 +12920,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(expert nil)
(fwidth (+ maxlen 3 1 3))
(ncol (/ (- (window-width) 4) fwidth))
- tg cnt c tbl
+ tg cnt e c tbl
groups ingroup)
(save-excursion
(save-window-excursion
@@ -12794,13 +12928,13 @@ Returns the new TODO keyword, or nil if no state change should occur."
(set-buffer (get-buffer-create " *Org todo*"))
(org-switch-to-buffer-other-window (get-buffer-create " *Org todo*")))
(erase-buffer)
- (org-set-local 'org-done-keywords done-keywords)
+ (setq-local org-done-keywords done-keywords)
(setq tbl fulltable cnt 0)
- (dolist (e tbl)
+ (while (setq e (pop tbl))
(cond
((equal e '(:startgroup))
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (= cnt 0)
(setq cnt 0)
(insert "\n"))
(insert "{ "))
@@ -12808,7 +12942,7 @@ Returns the new TODO keyword, or nil if no state change should occur."
(setq ingroup nil cnt 0)
(insert "}\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (= cnt 0)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
@@ -12817,19 +12951,19 @@ Returns the new TODO keyword, or nil if no state change should occur."
(setq tbl (cdr tbl)))))
(t
(setq tg (car e) c (cdr e))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(org-get-todo-face tg)))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (and (= cnt 0) (not ingroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(when (= (setq cnt (1+ cnt)) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when ingroup (insert " "))
(setq cnt 0)))))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(message "[a-z..]:Set [SPC]:clear")
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
(cond
@@ -12851,12 +12985,19 @@ Returns the new TODO keyword, or nil if no state change should occur."
"Return the TODO keyword of the current subtree."
(save-excursion
(org-back-to-heading t)
- (and (looking-at org-todo-line-regexp)
+ (and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
(match-end 2)
(match-string 2))))
(defun org-at-date-range-p (&optional inactive-ok)
- "Is the cursor inside a date range?"
+ "Non-nil if point is inside a date range.
+
+When optional argument INACTIVE-OK is non-nil, also consider
+inactive time ranges.
+
+When this function returns a non-nil value, match data is set
+according to `org-tr-regexp-both' or `org-tr-regexp', depending
+on INACTIVE-OK."
(interactive)
(save-excursion
(catch 'exit
@@ -12873,29 +13014,41 @@ Returns the new TODO keyword, or nil if no state change should occur."
(throw 'exit t)))
nil)))
-(defun org-get-repeat (&optional tagline)
- "Check if there is a deadline/schedule with repeater in this entry."
+(defun org-get-repeat (&optional timestamp)
+ "Check if there is a time-stamp with repeater in this entry.
+
+Return the repeater, as a string, or nil. Also return nil when
+this function is called before first heading.
+
+When optional argument TIMESTAMP is a string, extract the
+repeater from there instead."
(save-match-data
- (save-excursion
- (org-back-to-heading t)
- (and (re-search-forward (if tagline
- (concat tagline "\\s-*" org-repeat-re)
- org-repeat-re)
- (org-entry-end-position) t)
- (match-string-no-properties 1)))))
+ (cond (timestamp
+ (and (string-match org-repeat-re timestamp)
+ (match-string-no-properties 1 timestamp)))
+ ((org-before-first-heading-p) nil)
+ (t
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((end (org-entry-end-position)))
+ (catch :repeat
+ (while (re-search-forward org-repeat-re end t)
+ (when (save-match-data (org-at-timestamp-p 'agenda))
+ (throw :repeat (match-string-no-properties 1)))))))))))
(defvar org-last-changed-timestamp)
(defvar org-last-inserted-timestamp)
(defvar org-log-post-message)
(defvar org-log-note-purpose)
-(defvar org-log-note-how)
+(defvar org-log-note-how nil)
(defvar org-log-note-extra)
(defun org-auto-repeat-maybe (done-word)
- "Check if the current headline contains a repeated deadline/schedule.
+ "Check if the current headline contains a repeated time-stamp.
+
If yes, set TODO state back to what it was and change the base date
of repeating deadline/scheduled time stamps to new date.
+
This function is run automatically after each state change to a DONE state."
- ;; last-state is dynamically scoped into this function
(let* ((repeat (org-get-repeat))
(aa (assoc org-last-state org-todo-kwd-alist))
(interpret (nth 1 aa))
@@ -12904,80 +13057,122 @@ This function is run automatically after each state change to a DONE state."
(msg "Entry repeats: ")
(org-log-done nil)
(org-todo-log-states nil)
- re type n what ts time to-state)
- (when repeat
- (if (eq org-log-repeat t) (setq org-log-repeat 'state))
- (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE")
- org-todo-repeat-to-state))
- (unless (and to-state (member to-state org-todo-keywords-1))
- (setq to-state (if (eq interpret 'type) org-last-state head)))
- (org-todo to-state)
- (when (or org-log-repeat (org-entry-get nil "CLOCK"))
- (org-entry-put nil "LAST_REPEAT" (format-time-string
- (org-time-stamp-format t t))))
- (when org-log-repeat
- (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
- (memq 'org-add-log-note post-command-hook))
- ;; OK, we are already setup for some record
- (if (eq org-log-repeat 'note)
- ;; make sure we take a note, not only a time stamp
- (setq org-log-note-how 'note))
- ;; Set up for taking a record
- (org-add-log-setup 'state (or done-word (car org-done-keywords))
- org-last-state
- 'findpos org-log-repeat)))
- (org-back-to-heading t)
- (org-add-planning-info nil nil 'closed)
- (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\("
- org-deadline-time-regexp "\\)\\|\\("
- org-ts-regexp "\\)"))
- (while (re-search-forward
- re (save-excursion (outline-next-heading) (point)) t)
- (setq type (if (match-end 1) org-scheduled-string
- (if (match-end 3) org-deadline-string "Plain:"))
- ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0))))
- (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)
- (setq n (string-to-number (match-string 2 ts))
- what (match-string 3 ts))
- (if (equal what "w") (setq n (* n 7) what "d"))
- (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)))
- (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n))
- ;; Preparation, see if we need to modify the start date for the change
- (when (match-end 1)
- (setq time (save-match-data (org-time-string-to-time ts)))
- (cond
- ((equal (match-string 1 ts) ".")
- ;; Shift starting date to today
- (org-timestamp-change
- (- (org-today) (time-to-days time))
- 'day))
- ((equal (match-string 1 ts) "+")
- (let ((nshiftmax 10) (nshift 0))
- (while (or (= nshift 0)
- (<= (time-to-days time)
- (time-to-days (current-time))))
- (when (= (incf nshift) nshiftmax)
- (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift))
- (error "Abort")))
- (org-timestamp-change n (cdr (assoc what whata)))
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (setq time (save-match-data (org-time-string-to-time ts)))))
- (org-timestamp-change (- n) (cdr (assoc what whata)))
- ;; rematch, so that we have everything in place for the real shift
- (org-at-timestamp-p t)
- (setq ts (match-string 1))
- (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts))))
- (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t))
- (setq msg (concat msg type " " org-last-changed-timestamp " "))))
- (setq org-log-post-message msg)
- (message "%s" msg))))
+ (end (copy-marker (org-entry-end-position))))
+ (unwind-protect
+ (when (and repeat (not (zerop (string-to-number (substring repeat 1)))))
+ (when (eq org-log-repeat t) (setq org-log-repeat 'state))
+ (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective)
+ org-todo-repeat-to-state)))
+ (org-todo (cond
+ ((and to-state (member to-state org-todo-keywords-1))
+ to-state)
+ ((eq interpret 'type) org-last-state)
+ (head)
+ (t 'none))))
+ (org-back-to-heading t)
+ (org-add-planning-info nil nil 'closed)
+ ;; When `org-log-repeat' is non-nil or entry contains
+ ;; a clock, set LAST_REPEAT property.
+ (when (or org-log-repeat
+ (catch :clock
+ (save-excursion
+ (while (re-search-forward org-clock-line-re end t)
+ (when (org-at-clock-log-p) (throw :clock t))))))
+ (org-entry-put nil "LAST_REPEAT" (format-time-string
+ (org-time-stamp-format t t)
+ (current-time))))
+ (when org-log-repeat
+ (if (or (memq 'org-add-log-note (default-value 'post-command-hook))
+ (memq 'org-add-log-note post-command-hook))
+ ;; We are already setup for some record.
+ (when (eq org-log-repeat 'note)
+ ;; Make sure we take a note, not only a time stamp.
+ (setq org-log-note-how 'note))
+ ;; Set up for taking a record.
+ (org-add-log-setup 'state
+ (or done-word (car org-done-keywords))
+ org-last-state
+ org-log-repeat)))
+ (let ((planning-re (regexp-opt
+ (list org-scheduled-string org-deadline-string))))
+ (while (re-search-forward org-ts-regexp end t)
+ (let* ((ts (match-string 0))
+ (planning? (org-at-planning-p))
+ (type (if (not planning?) "Plain:"
+ (save-excursion
+ (re-search-backward
+ planning-re (line-beginning-position) t)
+ (match-string 0)))))
+ (cond
+ ;; Ignore fake time-stamps (e.g., within comments).
+ ((not (org-at-timestamp-p 'agenda)))
+ ;; Time-stamps without a repeater are usually
+ ;; skipped. However, a SCHEDULED time-stamp without
+ ;; one is removed, as they are no longer relevant.
+ ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
+ ts))
+ (when (equal type org-scheduled-string)
+ (org-remove-timestamp-with-keyword type)))
+ (t
+ (let ((n (string-to-number (match-string 2 ts)))
+ (what (match-string 3 ts)))
+ (when (equal what "w") (setq n (* n 7) what "d"))
+ (when (and (equal what "h")
+ (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}"
+ ts)))
+ (user-error
+ "Cannot repeat in Repeat in %d hour(s) because no hour \
+has been set"
+ n))
+ ;; Preparation, see if we need to modify the start
+ ;; date for the change.
+ (when (match-end 1)
+ (let ((time (save-match-data
+ (org-time-string-to-time ts))))
+ (cond
+ ((equal (match-string 1 ts) ".")
+ ;; Shift starting date to today
+ (org-timestamp-change
+ (- (org-today) (time-to-days time))
+ 'day))
+ ((equal (match-string 1 ts) "+")
+ (let ((nshiftmax 10)
+ (nshift 0))
+ (while (or (= nshift 0)
+ (not (time-less-p (current-time) time)))
+ (when (= (cl-incf nshift) nshiftmax)
+ (or (y-or-n-p
+ (format "%d repeater intervals were not \
+enough to shift date past today. Continue? "
+ nshift))
+ (user-error "Abort")))
+ (org-timestamp-change n (cdr (assoc what whata)))
+ (org-in-regexp org-ts-regexp3)
+ (setq ts (match-string 1))
+ (setq time
+ (save-match-data
+ (org-time-string-to-time ts)))))
+ (org-timestamp-change (- n) (cdr (assoc what whata)))
+ ;; Rematch, so that we have everything in place
+ ;; for the real shift.
+ (org-in-regexp org-ts-regexp3)
+ (setq ts (match-string 1))
+ (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)"
+ ts)))))
+ (save-excursion
+ (org-timestamp-change n (cdr (assoc what whata)) nil t))
+ (setq msg
+ (concat
+ msg type " " org-last-changed-timestamp " "))))))))
+ (setq org-log-post-message msg)
+ (message "%s" msg))
+ (set-marker end nil))))
(defun org-show-todo-tree (arg)
"Make a compact tree which shows all headlines marked with TODO.
The tree will show the lines where the regexp matches, and all higher
headlines above the match.
-With a \\[universal-argument] prefix, prompt for a regexp to match.
+With a `\\[universal-argument]' prefix, prompt for a regexp to match.
With a numeric prefix N, construct a sparse tree for the Nth element
of `org-todo-keywords-1'."
(interactive "P")
@@ -12985,8 +13180,9 @@ of `org-todo-keywords-1'."
(kwd-re
(cond ((null arg) org-not-done-regexp)
((equal arg '(4))
- (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): "
- (mapcar 'list org-todo-keywords-1))))
+ (let ((kwd
+ (completing-read "Keyword (or KWD1|KWD2|...): "
+ (mapcar #'list org-todo-keywords-1))))
(concat "\\("
(mapconcat 'identity (org-split-string kwd "|") "\\|")
"\\)\\>")))
@@ -12997,6 +13193,83 @@ of `org-todo-keywords-1'."
(message "%d TODO entries found"
(org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
+(defun org--deadline-or-schedule (arg type time)
+ "Insert DEADLINE or SCHEDULE information in current entry.
+TYPE is either `deadline' or `scheduled'. See `org-deadline' or
+`org-schedule' for information about ARG and TIME arguments."
+ (let* ((deadline? (eq type 'deadline))
+ (keyword (if deadline? org-deadline-string org-scheduled-string))
+ (log (if deadline? org-log-redeadline org-log-reschedule))
+ (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED")))
+ (old-date-time (and old-date (org-time-string-to-time old-date)))
+ ;; Save repeater cookie from either TIME or current scheduled
+ ;; time stamp. We are going to insert it back at the end of
+ ;; the process.
+ (repeater (or (and (org-string-nw-p time)
+ ;; We use `org-repeat-re' because we need
+ ;; to tell the difference between a real
+ ;; repeater and a time delta, e.g. "+2d".
+ (string-match org-repeat-re time)
+ (match-string 1 time))
+ (and (org-string-nw-p old-date)
+ (string-match "\\([.+-]+[0-9]+[hdwmy]\
+\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)"
+ old-date)
+ (match-string 1 old-date)))))
+ (pcase arg
+ (`(4)
+ (when (and old-date log)
+ (org-add-log-setup (if deadline? 'deldeadline 'delschedule)
+ nil old-date log))
+ (org-remove-timestamp-with-keyword keyword)
+ (message (if deadline? "Item no longer has a deadline."
+ "Item is no longer scheduled.")))
+ (`(16)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((regexp (if deadline? org-deadline-time-regexp
+ org-scheduled-time-regexp)))
+ (if (not (re-search-forward regexp (line-end-position 2) t))
+ (user-error (if deadline? "No deadline information to update"
+ "No scheduled information to update"))
+ (let* ((rpl0 (match-string 1))
+ (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))
+ (msg (if deadline? "Warn starting from" "Delay until")))
+ (replace-match
+ (concat keyword
+ " <" rpl
+ (format " -%dd"
+ (abs (- (time-to-days
+ (save-match-data
+ (org-read-date
+ nil t nil msg old-date-time)))
+ (time-to-days old-date-time))))
+ ">") t t))))))
+ (_
+ (org-add-planning-info type time 'closed)
+ (when (and old-date
+ log
+ (not (equal old-date org-last-inserted-timestamp)))
+ (org-add-log-setup (if deadline? 'redeadline 'reschedule)
+ org-last-inserted-timestamp
+ old-date
+ log))
+ (when repeater
+ (save-excursion
+ (org-back-to-heading t)
+ (when (re-search-forward
+ (concat keyword " " org-last-inserted-timestamp)
+ (line-end-position 2)
+ t)
+ (goto-char (1- (match-end 0)))
+ (insert " " repeater)
+ (setq org-last-inserted-timestamp
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater
+ (substring org-last-inserted-timestamp -1))))))
+ (message (if deadline? "Deadline on %s" "Scheduled to %s")
+ org-last-inserted-timestamp)))))
+
(defun org-deadline (arg &optional time)
"Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
With one universal prefix argument, remove any deadline from the item.
@@ -13005,67 +13278,14 @@ With argument TIME, set the deadline at the corresponding date. TIME
can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level 'region))
- org-loop-over-headlines-in-active-region)
- (org-map-entries
- `(org-deadline ',arg ,time)
- org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (let* ((old-date (org-entry-get nil "DEADLINE"))
- (old-date-time (if old-date (org-time-string-to-time old-date)))
- (repeater (and old-date
- (string-match
- "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
- old-date)
- (match-string 1 old-date))))
- (cond
- ((equal arg '(4))
- (when (and old-date org-log-redeadline)
- (org-add-log-setup 'deldeadline nil old-date 'findpos
- org-log-redeadline))
- (org-remove-timestamp-with-keyword org-deadline-string)
- (message "Item no longer has a deadline."))
- ((equal arg '(16))
- (save-excursion
- (org-back-to-heading t)
- (if (re-search-forward
- org-deadline-time-regexp
- (save-excursion (outline-next-heading) (point)) t)
- (let* ((rpl0 (match-string 1))
- (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)))
- (replace-match
- (concat org-deadline-string
- " <" rpl
- (format " -%dd"
- (abs
- (- (time-to-days
- (save-match-data
- (org-read-date nil t nil "Warn starting from" old-date-time)))
- (time-to-days old-date-time))))
- ">") t t))
- (user-error "No deadline information to update"))))
- (t
- (org-add-planning-info 'deadline time 'closed)
- (when (and old-date org-log-redeadline
- (not (equal old-date
- (substring org-last-inserted-timestamp 1 -1))))
- (org-add-log-setup 'redeadline nil old-date 'findpos
- org-log-redeadline))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward (concat org-deadline-string " "
- org-last-inserted-timestamp)
- (save-excursion
- (outline-next-heading) (point)) t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message "Deadline on %s" org-last-inserted-timestamp))))))
+ (org-map-entries
+ (lambda () (org--deadline-or-schedule arg 'deadline time))
+ nil
+ (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level
+ 'region)
+ (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
+ (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.
@@ -13075,68 +13295,14 @@ With argument TIME, scheduled at the corresponding date. TIME can
either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
- (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level 'region))
- org-loop-over-headlines-in-active-region)
- (org-map-entries
- `(org-schedule ',arg ,time)
- org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (let* ((old-date (org-entry-get nil "SCHEDULED"))
- (old-date-time (if old-date (org-time-string-to-time old-date)))
- (repeater (and old-date
- (string-match
- "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
- old-date)
- (match-string 1 old-date))))
- (cond
- ((equal arg '(4))
- (progn
- (when (and old-date org-log-reschedule)
- (org-add-log-setup 'delschedule nil old-date 'findpos
- org-log-reschedule))
- (org-remove-timestamp-with-keyword org-scheduled-string)
- (message "Item is no longer scheduled.")))
- ((equal arg '(16))
- (save-excursion
- (org-back-to-heading t)
- (if (re-search-forward
- org-scheduled-time-regexp
- (save-excursion (outline-next-heading) (point)) t)
- (let* ((rpl0 (match-string 1))
- (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)))
- (replace-match
- (concat org-scheduled-string
- " <" rpl
- (format " -%dd"
- (abs
- (- (time-to-days
- (save-match-data
- (org-read-date nil t nil "Delay until" old-date-time)))
- (time-to-days old-date-time))))
- ">") t t))
- (user-error "No scheduled information to update"))))
- (t
- (org-add-planning-info 'scheduled time 'closed)
- (when (and old-date org-log-reschedule
- (not (equal old-date
- (substring org-last-inserted-timestamp 1 -1))))
- (org-add-log-setup 'reschedule nil old-date 'findpos
- org-log-reschedule))
- (when repeater
- (save-excursion
- (org-back-to-heading t)
- (when (re-search-forward (concat org-scheduled-string " "
- org-last-inserted-timestamp)
- (save-excursion
- (outline-next-heading) (point)) t)
- (goto-char (1- (match-end 0)))
- (insert " " repeater)
- (setq org-last-inserted-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater
- (substring org-last-inserted-timestamp -1))))))
- (message "Scheduled to %s" org-last-inserted-timestamp))))))
+ (org-map-entries
+ (lambda () (org--deadline-or-schedule arg 'scheduled time))
+ nil
+ (if (eq org-loop-over-headlines-in-active-region 'start-level)
+ 'region-start-level
+ 'region)
+ (lambda () (when (org-invisible-p) (org-end-of-subtree nil t))))
+ (org--deadline-or-schedule arg 'scheduled time)))
(defun org-get-scheduled-time (pom &optional inherit)
"Get the scheduled time as a time tuple, of a format suitable
@@ -13167,24 +13333,36 @@ nil."
(if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point)))
(equal (char-before) ?\ ))
(backward-delete-char 1)
- (if (string-match "^[ \t]*$" (buffer-substring
- (point-at-bol) (point-at-eol)))
- (delete-region (point-at-bol)
- (min (point-max) (1+ (point-at-eol))))))))))
+ (when (string-match "^[ \t]*$" (buffer-substring
+ (point-at-bol) (point-at-eol)))
+ (delete-region (point-at-bol)
+ (min (point-max) (1+ (point-at-eol))))))))))
(defvar org-time-was-given) ; dynamically scoped parameter
(defvar org-end-time-was-given) ; dynamically scoped parameter
-(defun org-add-planning-info (what &optional time &rest remove)
- "Insert new timestamp with keyword in the line directly after the headline.
-WHAT indicates what kind of time stamp to add. TIME indicates the time to use.
-If non 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."
- (interactive)
- (let (org-time-was-given org-end-time-was-given ts
- end default-time default-input)
+(defun org-at-planning-p ()
+ "Non-nil when point is on a planning info line."
+ ;; This is as accurate and faster than `org-element-at-point' since
+ ;; planning info location is fixed in the section.
+ (org-with-wide-buffer
+ (beginning-of-line)
+ (and (looking-at-p org-planning-line-re)
+ (eq (point)
+ (ignore-errors
+ (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))
+ (org-back-to-heading t)
+ (org-with-limited-levels (org-back-to-heading t)))
+ (line-beginning-position 2))))))
+(defun org-add-planning-info (what &optional time &rest remove)
+ "Insert new timestamp with keyword in the planning line.
+WHAT indicates what kind of time stamp to add. It is a symbol
+among `closed', `deadline', `scheduled' and nil. TIME indicates
+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)
@@ -13193,108 +13371,98 @@ be removed."
;; Try to get a default date/time from existing timestamp
(save-excursion
(org-back-to-heading t)
- (setq end (save-excursion (outline-next-heading) (point)))
- (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
- (apply 'encode-time (org-parse-time-string ts))
- default-input (and ts (org-get-compact-tod ts))))))
+ (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 (apply 'encode-time (org-parse-time-string 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
+ ;; 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 nil
default-time default-input)))))
- (when (and org-insert-labeled-timestamps-at-point
- (member what '(scheduled deadline)))
- (insert
- (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ")
- (org-insert-time-stamp time org-time-was-given
- nil nil nil (list org-end-time-was-given))
- (setq what nil))
- (save-excursion
- (save-restriction
- (let (col list elt ts buffer-invisibility-spec)
- (org-back-to-heading t)
- (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"))
- (goto-char (match-end 1))
- (setq col (current-column))
- (goto-char (match-end 0))
- (if (eobp) (insert "\n") (forward-char 1))
- (when (and (not what)
- (not (looking-at
- (concat "[ \t]*"
- org-keyword-time-not-clock-regexp))))
- ;; Nothing to add, nothing to remove...... :-)
- (throw 'exit nil))
- (if (and (not (looking-at org-outline-regexp))
- (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp
- "[^\r\n]*"))
- (not (equal (match-string 1) org-clock-string)))
- (narrow-to-region (match-beginning 0) (match-end 0))
- (insert-before-markers "\n")
- (backward-char 1)
- (narrow-to-region (point) (point))
- (and org-adapt-indentation (org-indent-to-column col)))
- ;; Check if we have to remove something.
- (setq list (cons what remove))
- (while list
- (setq elt (pop list))
- (when (or (and (eq elt 'scheduled)
- (re-search-forward org-scheduled-time-regexp nil t))
- (and (eq elt 'deadline)
- (re-search-forward org-deadline-time-regexp nil t))
- (and (eq elt 'closed)
- (re-search-forward org-closed-time-regexp nil t)))
- (replace-match "")
- (if (looking-at "--+<[^>]+>") (replace-match ""))))
- (and (looking-at "[ \t]+") (replace-match ""))
- (and org-adapt-indentation (bolp) (org-indent-to-column col))
- (when what
- (insert
- (if (not (or (bolp) (eq (char-before) ?\ ))) " " "")
- (cond ((eq what 'scheduled) org-scheduled-string)
- ((eq what 'deadline) org-deadline-string)
- ((eq what 'closed) org-closed-string))
- " ")
- (setq 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)))
- (insert
- (if (not (or (bolp) (eq (char-before) ?\ )
- (memq (char-after) '(32 10))
- (eobp))) " " ""))
- (end-of-line 1))
- (goto-char (point-min))
- (widen)
- (if (and (looking-at "[ \t]*\n")
- (equal (char-before) ?\n))
- (delete-region (1- (point)) (point-at-eol)))
- ts))))))
-
-(defvar org-log-note-marker (make-marker))
+ (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))))))
+
+(defvar org-log-note-marker (make-marker)
+ "Marker pointing at the entry where the note is to be inserted.")
(defvar org-log-note-purpose nil)
(defvar org-log-note-state nil)
(defvar org-log-note-previous-state nil)
-(defvar org-log-note-how nil)
(defvar org-log-note-extra nil)
(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 tha timestamps in state change
-log")
+`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.
@@ -13304,90 +13472,97 @@ The auto-repeater uses this.")
"Add a note to the current entry.
This is done in the same way as adding a state change note."
(interactive)
- (org-add-log-setup 'note nil nil 'findpos nil))
+ (org-add-log-setup 'note))
-(defvar org-property-end-re)
-(defun org-add-log-setup (&optional purpose state prev-state
- findpos how extra)
+(defun org-log-beginning (&optional create)
+ "Return expected start of log notes in current entry.
+When optional argument CREATE is non-nil, the function creates
+a drawer to store notes, if necessary. Returned position ignores
+narrowing."
+ (org-with-wide-buffer
+ (let ((drawer (org-log-into-drawer)))
+ (cond
+ (drawer
+ (org-end-of-meta-data)
+ (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))
+ (end (if (org-at-heading-p) (point)
+ (save-excursion (outline-next-heading) (point))))
+ (case-fold-search t))
+ (catch 'exit
+ ;; Try to find existing drawer.
+ (while (re-search-forward regexp end t)
+ (let ((element (org-element-at-point)))
+ (when (eq (org-element-type element) 'drawer)
+ (let ((cend (org-element-property :contents-end element)))
+ (when (and (not org-log-states-order-reversed) cend)
+ (goto-char cend)))
+ (throw 'exit nil))))
+ ;; No drawer found. Create one, if permitted.
+ (when create
+ (unless (bolp) (insert "\n"))
+ (let ((beg (point)))
+ (insert ":" drawer ":\n:END:\n")
+ (org-indent-region beg (point)))
+ (end-of-line -1)))))
+ (t
+ (org-end-of-meta-data org-log-state-notes-insert-after-drawers)
+ (skip-chars-forward " \t\n")
+ (beginning-of-line)
+ (unless org-log-states-order-reversed
+ (org-skip-over-state-notes)
+ (skip-chars-backward " \t\n")
+ (forward-line)))))
+ (if (bolp) (point) (line-beginning-position 2))))
+
+(defun org-add-log-setup (&optional purpose state prev-state how extra)
"Set up the post command hook to take a note.
If this is about to TODO state change, the new state is expected in STATE.
-When FINDPOS is non-nil, find the correct position for the note in
-the current entry. If not, assume that it can be inserted at point.
HOW is an indicator what kind of note should be created.
EXTRA is additional text that will be inserted into the notes buffer."
- (let* ((org-log-into-drawer (org-log-into-drawer))
- (drawer (cond ((stringp org-log-into-drawer)
- org-log-into-drawer)
- (org-log-into-drawer "LOGBOOK"))))
- (save-restriction
- (save-excursion
- (when findpos
- (org-back-to-heading t)
- (narrow-to-region (point) (save-excursion
- (outline-next-heading) (point)))
- (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*"
- "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp
- "[^\r\n]*\\)?"))
- (goto-char (match-end 0))
- (cond
- (drawer
- (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$")
- nil t)
- (progn
- (goto-char (match-end 0))
- (or org-log-states-order-reversed
- (and (re-search-forward org-property-end-re nil t)
- (goto-char (1- (match-beginning 0))))))
- (insert "\n:" drawer ":\n:END:")
- (beginning-of-line 0)
- (org-indent-line)
- (beginning-of-line 2)
- (org-indent-line)
- (end-of-line 0)))
- ((and org-log-state-notes-insert-after-drawers
- (save-excursion
- (forward-line) (looking-at org-drawer-regexp)))
- (forward-line)
- (while (looking-at org-drawer-regexp)
- (goto-char (match-end 0))
- (re-search-forward org-property-end-re (point-max) t)
- (forward-line))
- (forward-line -1)))
- (unless org-log-states-order-reversed
- (and (= (char-after) ?\n) (forward-char 1))
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n\r")))
- (move-marker org-log-note-marker (point))
- (setq org-log-note-purpose purpose
- org-log-note-state state
- org-log-note-previous-state prev-state
- org-log-note-how how
- org-log-note-extra extra
- org-log-note-effective-time (org-current-effective-time))
- (add-hook 'post-command-hook 'org-add-log-note 'append)))))
+ (move-marker org-log-note-marker (point))
+ (setq org-log-note-purpose purpose
+ org-log-note-state state
+ org-log-note-previous-state prev-state
+ org-log-note-how how
+ org-log-note-extra extra
+ org-log-note-effective-time (org-current-effective-time))
+ (add-hook 'post-command-hook 'org-add-log-note 'append))
(defun org-skip-over-state-notes ()
"Skip past the list of State notes in an entry."
- (if (looking-at "\n[ \t]*- State") (forward-char 1))
(when (ignore-errors (goto-char (org-in-item-p)))
(let* ((struct (org-list-struct))
- (prevs (org-list-prevs-alist struct)))
- (while (looking-at "[ \t]*- State")
+ (prevs (org-list-prevs-alist struct))
+ (regexp
+ (concat "[ \t]*- +"
+ (replace-regexp-in-string
+ " +" " +"
+ (org-replace-escapes
+ (regexp-quote (cdr (assq 'state org-log-note-headings)))
+ `(("%d" . ,org-ts-regexp-inactive)
+ ("%D" . ,org-ts-regexp)
+ ("%s" . "\"\\S-+\"")
+ ("%S" . "\"\\S-+\"")
+ ("%t" . ,org-ts-regexp-inactive)
+ ("%T" . ,org-ts-regexp)
+ ("%u" . ".*?")
+ ("%U" . ".*?")))))))
+ (while (looking-at-p regexp)
(goto-char (or (org-list-get-next-item (point) struct prevs)
(org-list-get-item-end (point) struct)))))))
-(defun org-add-log-note (&optional purpose)
- "Pop up a window for taking a note, and add this note later at point."
+(defun org-add-log-note (&optional _purpose)
+ "Pop up a window for taking a note, and add this note later."
(remove-hook 'post-command-hook 'org-add-log-note)
(setq org-log-note-window-configuration (current-window-configuration))
(delete-other-windows)
(move-marker org-log-note-return-to (point))
- (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker))
+ (pop-to-buffer-same-window (marker-buffer org-log-note-marker))
(goto-char org-log-note-marker)
(org-switch-to-buffer-other-window "*Org Note*")
(erase-buffer)
(if (memq org-log-note-how '(time state))
- (let (current-prefix-arg) (org-store-log-note))
+ (org-store-log-note)
(let ((org-inhibit-startup t)) (org-mode))
(insert (format "# Insert note for %s.
# Finish with C-c C-c, or cancel with C-c C-k.\n\n"
@@ -13411,23 +13586,23 @@ EXTRA is additional text that will be inserted into the notes buffer."
((eq org-log-note-purpose 'note)
"this entry")
(t (error "This should not happen")))))
- (if org-log-note-extra (insert org-log-note-extra))
- (org-set-local 'org-finish-function 'org-store-log-note)
+ (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)))
(defvar org-note-abort nil) ; dynamically scoped
(defun org-store-log-note ()
"Finish taking a log note, and insert it to where it belongs."
- (let ((txt (buffer-string)))
- (kill-buffer (current-buffer))
- (let ((note (cdr (assq org-log-note-purpose org-log-note-headings)))
- lines ind bul)
+ (let ((txt (prog1 (buffer-string)
+ (kill-buffer)))
+ (note (cdr (assq org-log-note-purpose org-log-note-headings)))
+ lines)
(while (string-match "\\`# .*\n[ \t\n]*" txt)
(setq txt (replace-match "" t t txt)))
- (if (string-match "\\s-+\\'" txt)
- (setq txt (replace-match "" t t txt)))
- (setq lines (org-split-string txt "\n"))
- (when (and note (string-match "\\S-" note))
+ (when (string-match "\\s-+\\'" txt)
+ (setq txt (replace-match "" t t txt)))
+ (setq lines (and (not (equal "" txt)) (org-split-string txt "\n")))
+ (when (org-string-nw-p note)
(setq note
(org-replace-escapes
note
@@ -13445,74 +13620,83 @@ EXTRA is additional text that will be inserted into the notes buffer."
(cons "%D" (format-time-string
(org-time-stamp-format nil nil)
org-log-note-effective-time))
- (cons "%s" (if org-log-note-state
- (concat "\"" org-log-note-state "\"")
- ""))
- (cons "%S" (if org-log-note-previous-state
- (concat "\"" org-log-note-previous-state "\"")
- "\"\"")))))
- (if lines (setq note (concat note " \\\\")))
+ (cons "%s" (cond
+ ((not org-log-note-state) "")
+ ((string-match-p org-ts-regexp
+ org-log-note-state)
+ (format "\"[%s]\""
+ (substring org-log-note-state 1 -1)))
+ (t (format "\"%s\"" org-log-note-state))))
+ (cons "%S"
+ (cond
+ ((not org-log-note-previous-state) "")
+ ((string-match-p org-ts-regexp
+ org-log-note-previous-state)
+ (format "\"[%s]\""
+ (substring
+ org-log-note-previous-state 1 -1)))
+ (t (format "\"%s\""
+ org-log-note-previous-state)))))))
+ (when lines (setq note (concat note " \\\\")))
(push note lines))
- (when (or current-prefix-arg org-note-abort)
- (when org-log-into-drawer
- (org-remove-empty-drawer-at
- (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK")
- org-log-note-marker))
- (setq lines nil))
- (when lines
+ (when (and lines (not org-note-abort))
(with-current-buffer (marker-buffer org-log-note-marker)
- (save-excursion
- (goto-char org-log-note-marker)
- (move-marker org-log-note-marker nil)
- (end-of-line 1)
- (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
- (setq ind (save-excursion
- (if (ignore-errors (goto-char (org-in-item-p)))
- (let ((struct (org-list-struct)))
- (org-list-get-ind
- (org-list-get-top-point struct) struct))
- (skip-chars-backward " \r\t\n")
- (cond
- ((and (org-at-heading-p)
- org-adapt-indentation)
- (1+ (org-current-level)))
- ((org-at-heading-p) 0)
- (t (org-get-indentation))))))
- (setq bul (org-list-bullet-string "-"))
- (org-indent-line-to ind)
- (insert bul (pop lines))
- (let ((ind-body (+ (length bul) ind)))
- (while lines
- (insert "\n")
- (org-indent-line-to ind-body)
- (insert (pop lines))))
- (message "Note stored")
- (org-back-to-heading t)
- (org-cycle-hide-drawers 'children))
+ (org-with-wide-buffer
+ ;; Find location for the new note.
+ (goto-char org-log-note-marker)
+ (set-marker org-log-note-marker nil)
+ ;; Note associated to a clock is to be located right after
+ ;; the clock. Do not move point.
+ (unless (eq org-log-note-purpose 'clock-out)
+ (goto-char (org-log-beginning t)))
+ ;; Make sure point is at the beginning of an empty line.
+ (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n")))
+ ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n"))))
+ ;; In an existing list, add a new item at the top level.
+ ;; Otherwise, indent line like a regular one.
+ (let ((itemp (org-in-item-p)))
+ (if itemp
+ (indent-line-to
+ (let ((struct (save-excursion
+ (goto-char itemp) (org-list-struct))))
+ (org-list-get-ind (org-list-get-top-point struct) struct)))
+ (org-indent-line)))
+ (insert (org-list-bullet-string "-") (pop lines))
+ (let ((ind (org-list-item-body-column (line-beginning-position))))
+ (dolist (line lines)
+ (insert "\n")
+ (indent-line-to ind)
+ (insert line)))
+ (message "Note stored")
+ (org-back-to-heading t)
+ (org-cycle-hide-drawers 'children))
;; Fix `buffer-undo-list' when `org-store-log-note' is called
;; from within `org-add-log-note' because `buffer-undo-list'
;; is then modified outside of `org-with-remote-undo'.
(when (eq this-command 'org-agenda-todo)
- (setcdr buffer-undo-list (cddr buffer-undo-list)))))))
- ;; Don't add undo information when called from `org-agenda-todo'
+ (setcdr buffer-undo-list (cddr buffer-undo-list))))))
+ ;; Don't add undo information when called from `org-agenda-todo'.
(let ((buffer-undo-list (eq this-command 'org-agenda-todo)))
(set-window-configuration org-log-note-window-configuration)
(with-current-buffer (marker-buffer org-log-note-return-to)
(goto-char org-log-note-return-to))
(move-marker org-log-note-return-to nil)
- (and org-log-post-message (message "%s" org-log-post-message))))
+ (when org-log-post-message (message "%s" org-log-post-message))))
-(defun org-remove-empty-drawer-at (drawer pos)
- "Remove an empty drawer DRAWER at position POS.
+(defun org-remove-empty-drawer-at (pos)
+ "Remove an empty drawer at position POS.
POS may also be a marker."
(with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char pos)
- (if (org-in-regexp
- (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2)
- (replace-match ""))))))
+ (org-with-wide-buffer
+ (goto-char pos)
+ (let ((drawer (org-element-at-point)))
+ (when (and (memq (org-element-type drawer) '(drawer property-drawer))
+ (not (org-element-property :contents-begin drawer)))
+ (delete-region (org-element-property :begin drawer)
+ (progn (goto-char (org-element-property :end drawer))
+ (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))))))
(defvar org-ts-type nil)
(defun org-sparse-tree (&optional arg type)
@@ -13533,47 +13717,45 @@ D Show deadlines and scheduled items between a date range."
(interactive "P")
(setq type (or type org-sparse-tree-default-date-type))
(setq org-ts-type type)
- (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty
- [d]eadlines [b]efore-date [a]fter-date [D]ates range
- [c]ycle through date types: %s"
- (case type
+ (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty
+ \[d]eadlines [b]efore-date [a]fter-date [D]ates range
+ \[c]ycle through date types: %s"
+ (cl-case type
(all "all timestamps")
(scheduled "only scheduled")
(deadline "only deadline")
(active "only active timestamps")
(inactive "only inactive timestamps")
- (scheduled-or-deadline "scheduled/deadline")
(closed "with a closed time-stamp")
(otherwise "scheduled/deadline")))
(let ((answer (read-char-exclusive)))
- (case answer
+ (cl-case answer
(?c
(org-sparse-tree
arg
- (cadr (memq type '(scheduled-or-deadline all scheduled deadline active
- inactive closed)))))
- (?d (call-interactively #'org-check-deadlines))
- (?b (call-interactively #'org-check-before-date))
- (?a (call-interactively #'org-check-after-date))
- (?D (call-interactively #'org-check-dates-range))
- (?t (call-interactively #'org-show-todo-tree))
+ (cadr
+ (memq type '(nil all scheduled deadline active inactive closed)))))
+ (?d (call-interactively 'org-check-deadlines))
+ (?b (call-interactively 'org-check-before-date))
+ (?a (call-interactively 'org-check-after-date))
+ (?D (call-interactively 'org-check-dates-range))
+ (?t (call-interactively 'org-show-todo-tree))
(?T (org-show-todo-tree '(4)))
- (?m (call-interactively #'org-match-sparse-tree))
+ (?m (call-interactively 'org-match-sparse-tree))
((?p ?P)
- (let* ((kwd (org-icompleting-read
+ (let* ((kwd (completing-read
"Property: " (mapcar #'list (org-buffer-property-keys))))
- (value (org-icompleting-read
+ (value (completing-read
"Value: " (mapcar #'list (org-property-values kwd)))))
(unless (string-match "\\`{.*}\\'" value)
(setq value (concat "\"" value "\"")))
(org-match-sparse-tree arg (concat kwd "=" value))))
- ((?r ?R ?/) (call-interactively #'org-occur))
+ ((?r ?R ?/) (call-interactively 'org-occur))
(otherwise (user-error "No such sparse tree command \"%c\"" answer)))))
-(defvar org-occur-highlights nil
+(defvar-local org-occur-highlights nil
"List of overlays used for occur matches.")
-(make-variable-buffer-local 'org-occur-highlights)
-(defvar org-occur-parameters nil
+(defvar-local org-occur-parameters nil
"Parameters of the active org-occur calls.
This is a list, each call to org-occur pushes as cons cell,
containing the regular expression and the callback, onto the list.
@@ -13583,18 +13765,21 @@ will only contain one set of parameters. When the highlights are
removed (for example with `C-c C-c', or with the next edit (depending
on `org-remove-highlights-with-change'), this variable is emptied
as well.")
-(make-variable-buffer-local 'org-occur-parameters)
(defun org-occur (regexp &optional keep-previous callback)
"Make a compact tree which shows all matches of REGEXP.
-The tree will show the lines where the regexp matches, and all higher
-headlines above the match. It will also show the heading after the match,
-to make sure editing the matching entry is easy.
-If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous
-call to `org-occur' will be kept, to allow stacking of calls to this
-command.
-If CALLBACK is non-nil, it is a function which is called to confirm
-that the match should indeed be shown."
+
+The tree will show the lines where the regexp matches, and any other context
+defined in `org-show-context-detail', which see.
+
+When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing
+done by a previous call to `org-occur' will be kept, to allow stacking of
+calls to this command.
+
+Optional argument CALLBACK can be a function of no argument. In this case,
+it is called with point at the end of the match, match data being set
+accordingly. Current match is shown only if the return value is non-nil.
+The function must neither move point nor alter narrowing."
(interactive "sRegexp: \nP")
(when (equal regexp "")
(user-error "Regexp cannot be empty"))
@@ -13604,32 +13789,35 @@ that the match should indeed be shown."
(let ((cnt 0))
(save-excursion
(goto-char (point-min))
- (if (or (not keep-previous) ; do not want to keep
- (not org-occur-highlights)) ; no previous matches
- ;; hide everything
- (org-overview))
- (while (re-search-forward regexp nil t)
- (when (or (not callback)
- (save-match-data (funcall callback)))
- (setq cnt (1+ cnt))
- (when org-highlight-sparse-tree-matches
- (org-highlight-new-match (match-beginning 0) (match-end 0)))
- (org-show-context 'occur-tree))))
+ (when (or (not keep-previous) ; do not want to keep
+ (not org-occur-highlights)) ; no previous matches
+ ;; hide everything
+ (org-overview))
+ (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart)
+ (isearch-no-upper-case-p regexp t)
+ org-occur-case-fold-search)))
+ (while (re-search-forward regexp nil t)
+ (when (or (not callback)
+ (save-match-data (funcall callback)))
+ (setq cnt (1+ cnt))
+ (when org-highlight-sparse-tree-matches
+ (org-highlight-new-match (match-beginning 0) (match-end 0)))
+ (org-show-context 'occur-tree)))))
(when org-remove-highlights-with-change
- (org-add-hook 'before-change-functions 'org-remove-occur-highlights
- nil 'local))
+ (add-hook 'before-change-functions 'org-remove-occur-highlights
+ nil 'local))
(unless org-sparse-tree-open-archived-trees
(org-hide-archived-subtrees (point-min) (point-max)))
(run-hooks 'org-occur-hook)
- (if (org-called-interactively-p 'interactive)
- (message "%d match(es) for regexp %s" cnt regexp))
+ (when (called-interactively-p 'interactive)
+ (message "%d match(es) for regexp %s" cnt regexp))
cnt))
-(defun org-occur-next-match (&optional n reset)
+(defun org-occur-next-match (&optional n _reset)
"Function for `next-error-function' to find sparse tree matches.
N is the number of matches to move, when negative move backwards.
-RESET is entirely ignored - this function always goes back to the
-starting point when no match is found."
+This function always goes back to the starting point when no
+match is found."
(let* ((limit (if (< n 0) (point-min) (point-max)))
(search-func (if (< n 0)
'previous-single-char-property-change
@@ -13641,7 +13829,7 @@ starting point when no match is found."
(while (setq p1 (funcall search-func (point) 'org-type))
(when (equal p1 limit)
(goto-char pos)
- (error "No more matches"))
+ (user-error "No more matches"))
(when (equal (get-char-property p1 'org-type) 'org-occur)
(setq n (1- n))
(when (= n 0)
@@ -13649,65 +13837,75 @@ starting point when no match is found."
(throw 'exit (point))))
(goto-char p1))
(goto-char p1)
- (error "No more matches"))))
+ (user-error "No more matches"))))
(defun org-show-context (&optional key)
"Make sure point and context are visible.
-How much context is shown depends upon the variables
-`org-show-hierarchy-above', `org-show-following-heading',
-`org-show-entry-below' and `org-show-siblings'."
- (let ((heading-p (org-at-heading-p t))
- (hierarchy-p (org-get-alist-option org-show-hierarchy-above key))
- (following-p (org-get-alist-option org-show-following-heading key))
- (entry-p (org-get-alist-option org-show-entry-below key))
- (siblings-p (org-get-alist-option org-show-siblings key)))
- ;; Show heading or entry text
- (if (and heading-p (not entry-p))
- (org-flag-heading nil) ; only show the heading
- (and (or entry-p (outline-invisible-p) (org-invisible-p2))
- (org-show-hidden-entry))) ; show entire entry
- (when following-p
- ;; Show next sibling, or heading below text
- (save-excursion
- (and (if heading-p (org-goto-sibling) (outline-next-heading))
- (org-flag-heading nil))))
- (when siblings-p (org-show-siblings))
- (when hierarchy-p
- ;; show all higher headings, possibly with siblings
- (save-excursion
- (while (and (condition-case nil
- (progn (org-up-heading-all 1) t)
- (error nil))
- (not (bobp)))
- (org-flag-heading nil)
- (when siblings-p (org-show-siblings)))))))
+Optional argument KEY, when non-nil, is a symbol. See
+`org-show-context-detail' for allowed values and how much is to
+be shown."
+ (org-show-set-visibility
+ (cond ((symbolp org-show-context-detail) org-show-context-detail)
+ ((cdr (assq key org-show-context-detail)))
+ (t (cdr (assq 'default org-show-context-detail))))))
+
+(defun org-show-set-visibility (detail)
+ "Set visibility around point according to DETAIL.
+DETAIL is either nil, `minimal', `local', `ancestors', `lineage',
+`tree', `canonical' or t. See `org-show-context-detail' for more
+information."
+ ;; Show current heading and possibly its entry, following headline
+ ;; or all children.
+ (if (and (org-at-heading-p) (not (eq detail 'local)))
+ (org-flag-heading nil)
+ (org-show-entry)
+ ;; 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 outline))
+ (delete-overlay o)))
+ (unless (org-before-first-heading-p)
+ (org-with-limited-levels
+ (cl-case detail
+ ((tree canonical t) (org-show-children))
+ ((nil minimal ancestors))
+ (t (save-excursion
+ (outline-next-heading)
+ (org-flag-heading nil)))))))
+ ;; Show all siblings.
+ (when (eq detail 'lineage) (org-show-siblings))
+ ;; Show ancestors, possibly with their children.
+ (when (memq detail '(ancestors lineage tree canonical t))
+ (save-excursion
+ (while (org-up-heading-safe)
+ (org-flag-heading nil)
+ (when (memq detail '(canonical t)) (org-show-entry))
+ (when (memq detail '(tree canonical t)) (org-show-children))))))
(defvar org-reveal-start-hook nil
"Hook run before revealing a location.")
(defun org-reveal (&optional siblings)
"Show current entry, hierarchy above it, and the following headline.
-This can be used to show a consistent set of context around locations
-exposed with `org-show-hierarchy-above' or `org-show-following-heading'
-not t for the search context.
+
+This can be used to show a consistent set of context around
+locations exposed with `org-show-context'.
With optional argument SIBLINGS, on each level of the hierarchy all
siblings are shown. This repairs the tree structure to what it would
look like when opened with hierarchical calls to `org-cycle'.
-With double optional argument \\[universal-argument] \\[universal-argument], \
-go to the parent and show the
-entire tree."
+
+With a \\[universal-argument] \\[universal-argument] prefix, \
+go to the parent and show the entire tree."
(interactive "P")
(run-hooks 'org-reveal-start-hook)
- (let ((org-show-hierarchy-above t)
- (org-show-following-heading t)
- (org-show-siblings (if siblings t org-show-siblings)))
- (org-show-context nil))
- (when (equal siblings '(16))
- (save-excursion
- (when (org-up-heading-safe)
- (org-show-subtree)
- (run-hook-with-args 'org-cycle-hook 'subtree)))))
+ (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical))
+ ((equal siblings '(16))
+ (save-excursion
+ (when (org-up-heading-safe)
+ (org-show-subtree)
+ (run-hook-with-args 'org-cycle-hook 'subtree))))
+ (t (org-show-set-visibility 'lineage))))
(defun org-highlight-new-match (beg end)
"Highlight from BEG to END and mark the highlight is an occur headline."
@@ -13716,13 +13914,13 @@ entire tree."
(overlay-put ov 'org-type 'org-occur)
(push ov org-occur-highlights)))
-(defun org-remove-occur-highlights (&optional beg end noremove)
+(defun org-remove-occur-highlights (&optional _beg _end noremove)
"Remove the occur highlights from the buffer.
BEG and END are ignored. If NOREMOVE is nil, remove this function
from the `before-change-functions' in the current buffer."
(interactive)
(unless org-inhibit-highlight-removal
- (mapc 'delete-overlay org-occur-highlights)
+ (mapc #'delete-overlay org-occur-highlights)
(setq org-occur-highlights nil)
(setq org-occur-parameters nil)
(unless noremove
@@ -13746,89 +13944,88 @@ from the `before-change-functions' in the current buffer."
(interactive)
(org-priority 'down))
-(defun org-priority (&optional action show)
+(defun org-priority (&optional action _show)
"Change the priority of an item.
ACTION can be `set', `up', `down', or a character."
(interactive "P")
(if (equal action '(4))
(org-show-priority)
- (unless org-enable-priority-commands
- (user-error "Priority commands are disabled"))
- (setq action (or action 'set))
- (let (current new news have remove)
- (save-excursion
- (org-back-to-heading t)
- (if (looking-at org-priority-regexp)
+ (unless org-enable-priority-commands
+ (user-error "Priority commands are disabled"))
+ (setq action (or action 'set))
+ (let (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))
- (cond
- ((eq action 'remove)
- (setq remove t new ?\ ))
- ((or (eq action 'set)
- (if (featurep 'xemacs) (characterp action) (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))))
- (if (and (= (upcase org-highest-priority) org-highest-priority)
- (= (upcase org-lowest-priority) org-lowest-priority))
+ (cond
+ ((eq action 'remove)
+ (setq remove t new ?\ ))
+ ((or (eq action 'set)
+ (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 (upcase new)))
- (cond ((equal new ?\ ) (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))))
- ((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
- ;; default
- (if org-priority-start-cycle-with-default
- org-default-priority
- (1- org-default-priority))))))
- ((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
- ;; default
- (if org-priority-start-cycle-with-default
- org-default-priority
- (1+ org-default-priority))))))
- (t (user-error "Invalid action")))
- (if (or (< (upcase new) org-highest-priority)
- (> (upcase new) org-lowest-priority))
+ (cond ((equal new ?\ ) (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))))
+ ((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
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1- org-default-priority))))))
+ ((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
+ ;; default
+ (if org-priority-start-cycle-with-default
+ org-default-priority
+ (1+ org-default-priority))))))
+ (t (user-error "Invalid action")))
+ (when (or (< (upcase new) org-highest-priority)
+ (> (upcase new) org-lowest-priority))
(if (and (memq action '(up down))
(not have) (not (eq last-command this-command)))
- ;; `new' is from default priority
+ ;; `new' is from default priority
(error
"The default can not be set, see `org-default-priority' why")
- ;; normal cycling: `new' is beyond highest/lowest priority
- ;; and is wrapped around to the empty priority
+ ;; normal cycling: `new' is beyond highest/lowest priority
+ ;; and is wrapped around to the empty priority
(setq remove t)))
- (setq news (format "%c" new))
- (if have
+ (setq news (format "%c" new))
+ (if have
+ (if remove
+ (replace-match "" t t nil 1)
+ (replace-match news t t nil 2))
(if remove
- (replace-match "" t t nil 1)
- (replace-match news t t nil 2))
- (if remove
- (user-error "No priority cookie found in line")
- (let ((case-fold-search nil))
- (looking-at org-todo-line-regexp))
- (if (match-end 2)
- (progn
- (goto-char (match-end 2))
- (insert " [#" news "]"))
- (goto-char (match-beginning 3))
- (insert "[#" news "] "))))
- (org-preserve-lc (org-set-tags nil 'align)))
- (if remove
- (message "Priority removed")
- (message "Priority of current item set to %s" news)))))
+ (user-error "No priority cookie found in line")
+ (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
+ (if (match-end 2)
+ (progn
+ (goto-char (match-end 2))
+ (insert " [#" news "]"))
+ (goto-char (match-beginning 3))
+ (insert "[#" news "] "))))
+ (org-set-tags nil 'align))
+ (if remove
+ (message "Priority removed")
+ (message "Priority of current item set to %s" news)))))
(defun org-show-priority ()
"Show the priority of the current item.
@@ -13863,6 +14060,7 @@ Can be set by the action argument to `org-scan-tags' and `org-map-entries'.")
(defvar org-scanner-tags nil
"The current tag list while the tags scanner is running.")
+
(defvar org-trust-scanner-tags nil
"Should `org-get-tags-at' use the tags for the scanner.
This is for internal dynamical scoping only.
@@ -13874,6 +14072,8 @@ obtain a list of properties. Building the tags list for each entry in such
a file becomes an N^2 operation - but with this variable set, it scales
as N.")
+(defvar org--matcher-tags-todo-only nil)
+
(defun org-scan-tags (action matcher todo-only &optional start-level)
"Scan headline tags with inheritance and produce output ACTION.
@@ -13882,11 +14082,14 @@ or `agenda' to produce an entry list for an agenda view. It can also be
a Lisp form or a function that should be called at each matched headline, in
this case the return value is a list of all return values from these calls.
-MATCHER is a Lisp form to be evaluated, testing if a given set of tags
-qualifies a headline for inclusion. When TODO-ONLY is non-nil,
-only lines with a not-done TODO keyword are included in the output.
-This should be the same variable that was scoped into
-and set by `org-make-tags-matcher' when it constructed MATCHER.
+MATCHER is a function accepting three arguments, returning
+a non-nil value whenever a given set of tags qualifies a headline
+for inclusion. See `org-make-tags-matcher' for more information.
+As a special case, it can also be set to t (respectively nil) in
+order to match all (respectively none) headline.
+
+When TODO-ONLY is non-nil, only lines with a TODO keyword are
+included in the output.
START-LEVEL can be a string with asterisks, reducing the scope to
headlines matching this string."
@@ -13897,8 +14100,8 @@ headlines matching this string."
(concat "\\*\\{" (number-to-string start-level) "\\} ")
org-outline-regexp)
" *\\(\\<\\("
- (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
- (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))
+ (mapconcat #'regexp-quote org-todo-keywords-1 "\\|")
+ "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))
(props (list 'face 'default
'done-face 'org-agenda-done
'undone-face 'default
@@ -13915,8 +14118,9 @@ headlines matching this string."
lspos tags tags-list
(tags-alist (list (cons 0 org-file-tags)))
(llast 0) rtn rtn1 level category i txt
- todo marker entry priority)
- (when (not (or (member action '(agenda sparse-tree)) (functionp action)))
+ todo marker entry priority
+ ts-date ts-date-type ts-date-pair)
+ (unless (or (member action '(agenda sparse-tree)) (functionp action))
(setq action (list 'lambda nil action)))
(save-excursion
(goto-char (point-min))
@@ -13927,11 +14131,17 @@ headlines matching this string."
(re-search-forward re nil t))
(setq org-map-continue-from nil)
(catch :skip
- (setq todo (if (match-end 1) (org-match-string-no-properties 2))
- tags (if (match-end 4) (org-match-string-no-properties 4)))
+ (setq todo
+ ;; TODO: is the 1-2 difference a bug?
+ (when (match-end 1) (match-string-no-properties 2))
+ tags (when (match-end 4) (match-string-no-properties 4)))
(goto-char (setq lspos (match-beginning 0)))
(setq level (org-reduced-level (org-outline-level))
category (org-get-category))
+ (when (eq action 'agenda)
+ (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
+ ts-date (car ts-date-pair)
+ ts-date-type (cdr ts-date-pair)))
(setq i llast llast level)
;; remove tag lists from same and sublevels
(while (>= i level)
@@ -13958,25 +14168,27 @@ headlines matching this string."
(when (and tags org-use-tag-inheritance
(or (not (eq t org-use-tag-inheritance))
org-tags-exclude-from-inheritance))
- ;; selective inheritance, remove uninherited ones
+ ;; Selective inheritance, remove uninherited ones.
(setcdr (car tags-alist)
(org-remove-uninherited-tags (cdar tags-alist))))
(when (and
;; eval matcher only when the todo condition is OK
- (and (or (not todo-only) (member todo org-not-done-keywords))
- (let ((case-fold-search t) (org-trust-scanner-tags t))
- (eval matcher)))
-
- ;; Call the skipper, but return t if it does not skip,
- ;; so that the `and' form continues evaluating
+ (and (or (not todo-only) (member todo org-todo-keywords-1))
+ (if (functionp matcher)
+ (let ((case-fold-search t) (org-trust-scanner-tags t))
+ (funcall matcher todo tags-list level))
+ matcher))
+
+ ;; Call the skipper, but return t if it does not
+ ;; skip, so that the `and' form continues evaluating.
(progn
(unless (eq action 'sparse-tree) (org-agenda-skip))
t)
;; Check if timestamps are deselecting this entry
(or (not todo-only)
- (and (member todo org-not-done-keywords)
+ (and (member todo org-todo-keywords-1)
(or (not org-agenda-tags-todo-honor-ignore-options)
(not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))))))
@@ -13995,7 +14207,8 @@ headlines matching this string."
(if (eq org-tags-match-list-sublevels 'indented)
(make-string (1- level) ?.) "")
(org-get-heading))
- level category
+ (make-string level ?\s)
+ category
tags-list)
priority (org-get-priority txt))
(goto-char lspos)
@@ -14003,7 +14216,9 @@ headlines matching this string."
(org-add-props txt props
'org-marker marker 'org-hd-marker marker 'org-category category
'todo-state todo
- 'priority priority 'type "tagsmatch")
+ 'ts-date ts-date
+ 'priority priority
+ 'type (concat "tagsmatch" ts-date-type))
(push txt rtn))
((functionp action)
(setq org-map-continue-from nil)
@@ -14048,13 +14263,19 @@ headlines matching this string."
(defun org-match-sparse-tree (&optional todo-only match)
"Create a sparse tree according to tags string MATCH.
-MATCH can contain positive and negative selection of tags, like
-\"+WORK+URGENT-WITHBOSS\".
-If optional argument TODO-ONLY is non-nil, only select lines that are
-also TODO lines."
+
+MATCH is a string with match syntax. It can contain a selection
+of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and
+TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of
+those. See the manual for details.
+
+If optional argument TODO-ONLY is non-nil, only select lines that
+are also TODO tasks."
(interactive "P")
(org-agenda-prepare-buffers (list (current-buffer)))
- (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only))
+ (let ((org--matcher-tags-todo-only todo-only))
+ (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match))
+ org--matcher-tags-todo-only)))
(defalias 'org-tags-sparse-tree 'org-match-sparse-tree)
@@ -14062,15 +14283,17 @@ also TODO lines."
(defun org-cached-entry-get (pom property)
(if (or (eq t org-use-property-inheritance)
(and (stringp org-use-property-inheritance)
- (string-match org-use-property-inheritance property))
+ (let ((case-fold-search t))
+ (string-match-p org-use-property-inheritance property)))
(and (listp org-use-property-inheritance)
- (member property org-use-property-inheritance)))
- ;; Caching is not possible, check it directly
+ (member-ignore-case property org-use-property-inheritance)))
+ ;; Caching is not possible, check it directly.
(org-entry-get pom property 'inherit)
- ;; Get all properties, so that we can do complicated checks easily
- (cdr (assoc property (or org-cached-props
- (setq org-cached-props
- (org-entry-properties pom)))))))
+ ;; Get all properties, so we can do complicated checks easily.
+ (cdr (assoc-string property
+ (or org-cached-props
+ (setq org-cached-props (org-entry-properties pom)))
+ t))))
(defun org-global-tags-completion-table (&optional files)
"Return the list of all tags in all agenda buffer/files.
@@ -14079,186 +14302,173 @@ instead of the agenda files."
(save-excursion
(org-uniquify
(delq nil
- (apply 'append
+ (apply #'append
(mapcar
(lambda (file)
(set-buffer (find-file-noselect file))
- (append (org-get-buffer-tags)
- (mapcar (lambda (x) (if (stringp (car-safe x))
- (list (car-safe x)) nil))
- org-tag-alist)))
- (if (and files (car files))
- files
+ (mapcar (lambda (x)
+ (and (stringp (car-safe x))
+ (list (car-safe x))))
+ (or org-current-tag-alist (org-get-buffer-tags))))
+ (if (car-safe files) files
(org-agenda-files))))))))
(defun org-make-tags-matcher (match)
"Create the TAGS/TODO matcher form for the selection string MATCH.
-The variable `todo-only' is scoped dynamically into this function.
-It will be set to t if the matcher restricts matching to TODO entries,
-otherwise will not be touched.
-
-Returns a cons of the selection string MATCH and the constructed
-lisp form implementing the matcher. The matcher is to be evaluated
-at an Org entry, with point on the headline, and returns t if the
-entry matches the selection string MATCH. The returned lisp form
-references two variables with information about the entry, which
-must be bound around the form's evaluation: todo, the TODO keyword
-at the entry (or nil of none); and tags-list, the list of all tags
-at the entry including inherited ones. Additionally, the category
-of the entry (if any) must be specified as the text property
-'org-category on the headline.
-
-See also `org-scan-tags'.
-"
- (declare (special todo-only))
- (unless (boundp 'todo-only)
- (error "`org-make-tags-matcher' expects todo-only to be scoped in"))
+Returns a cons of the selection string MATCH and a function
+implementing the matcher.
+
+The matcher is to be called at an Org entry, with point on the
+headline, and returns non-nil if the entry matches the selection
+string MATCH. It must be called with three arguments: the TODO
+keyword at the entry (or nil if none), the list of all tags at
+the entry including inherited ones and the reduced level of the
+headline. Additionally, the category of the entry, if any, must
+be specified as the text property `org-category' on the headline.
+
+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.
+
+See also `org-scan-tags'."
(unless match
;; Get a new match request, with completion against the global
- ;; tags table and the local tags in current buffer
+ ;; tags table and the local tags in current buffer.
(let ((org-last-tags-completion-table
(org-uniquify
(delq nil (append (org-get-buffer-tags)
(org-global-tags-completion-table))))))
- (setq match (org-completing-read-no-i
- "Match: " 'org-tags-completion-function nil nil nil
- 'org-tags-history))))
+ (setq match
+ (completing-read
+ "Match: "
+ 'org-tags-completion-function nil nil nil 'org-tags-history))))
- ;; Parse the string and create a lisp form
(let ((match0 match)
- (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)"))
- minus tag mm
- tagsmatch todomatch tagsmatcher todomatcher kwd matcher
- orterms orlist re-p str-p level-p level-op time-p
- prop-p pn pv po gv rest (start 0) (ss 0))
- ;; Expand group tags
+ (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")
+ (start 0)
+ tagsmatch todomatch tagsmatcher todomatcher)
+
+ ;; Expand group tags.
(setq match (org-tags-expand match))
;; Check if there is a TODO part of this match, which would be the
- ;; part after a "/". TO make sure that this slash is not part of
- ;; a property value to be matched against, we also check that there
- ;; is no " after that slash.
- ;; First, find the last slash
- (while (string-match "/+" match ss)
- (setq start (match-beginning 0) ss (match-end 0)))
+ ;; part after a "/". To make sure that this slash is not part of
+ ;; a property value to be matched against, we also check that
+ ;; there is no / after that slash. First, find the last slash.
+ (let ((s 0))
+ (while (string-match "/+" match s)
+ (setq start (match-beginning 0))
+ (setq s (match-end 0))))
(if (and (string-match "/+" match start)
- (not (save-match-data (string-match "\"" match start))))
- ;; match contains also a todo-matching request
+ (not (string-match-p "\"" match start)))
+ ;; Match contains also a TODO-matching request.
(progn
- (setq tagsmatch (substring match 0 (match-beginning 0))
- todomatch (substring match (match-end 0)))
- (if (string-match "^!" todomatch)
- (setq todo-only t todomatch (substring todomatch 1)))
- (if (string-match "^\\s-*$" todomatch)
- (setq todomatch nil)))
- ;; only matching tags
- (setq tagsmatch match todomatch nil))
-
- ;; Make the tags matcher
- (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch)))
- (setq tagsmatcher t)
- (setq orterms (org-split-string tagsmatch "|") orlist nil)
- (dolist (term orterms)
- (while (and (equal (substring term -1) "\\") orterms)
- (setq term (concat term "|" (pop orterms)))) ; repair bad split
- (while (string-match re term)
- (setq rest (substring term (match-end 0))
- minus (and (match-end 1)
- (equal (match-string 1 term) "-"))
- tag (save-match-data (replace-regexp-in-string
- "\\\\-" "-"
- (match-string 2 term)))
- re-p (equal (string-to-char tag) ?{)
- level-p (match-end 4)
- prop-p (match-end 5)
- mm (cond
- (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list))
- (level-p
- (setq level-op (org-op-to-function (match-string 3 term)))
- `(,level-op level ,(string-to-number
- (match-string 4 term))))
- (prop-p
- (setq pn (match-string 5 term)
- po (match-string 6 term)
- pv (match-string 7 term)
- re-p (equal (string-to-char pv) ?{)
- str-p (equal (string-to-char pv) ?\")
- time-p (save-match-data
- (string-match "^\"[[<].*[]>]\"$" pv))
- pv (if (or re-p str-p) (substring pv 1 -1) pv))
- (if time-p (setq pv (org-matcher-time pv)))
- (setq po (org-op-to-function po (if time-p 'time str-p)))
- (cond
- ((equal pn "CATEGORY")
- (setq gv '(get-text-property (point) 'org-category)))
- ((equal pn "TODO")
- (setq gv 'todo))
- (t
- (setq gv `(org-cached-entry-get nil ,pn))))
- (if re-p
- (if (eq po 'org<>)
- `(not (string-match ,pv (or ,gv "")))
- `(string-match ,pv (or ,gv "")))
- (if str-p
- `(,po (or ,gv "") ,pv)
- `(,po (string-to-number (or ,gv ""))
- ,(string-to-number pv) ))))
- (t `(member ,tag tags-list)))
- mm (if minus (list 'not mm) mm)
- term rest)
- (push mm tagsmatcher))
- (push (if (> (length tagsmatcher) 1)
- (cons 'and tagsmatcher)
- (car tagsmatcher))
- orlist)
- (setq tagsmatcher nil))
- (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist)))
- (setq tagsmatcher
- (list 'progn '(setq org-cached-props nil) tagsmatcher)))
- ;; Make the todo matcher
- (if (or (not todomatch) (not (string-match "\\S-" todomatch)))
- (setq todomatcher t)
- (setq orterms (org-split-string todomatch "|") orlist nil)
- (dolist (term orterms)
- (while (string-match re term)
- (setq minus (and (match-end 1)
- (equal (match-string 1 term) "-"))
- kwd (match-string 2 term)
- re-p (equal (string-to-char kwd) ?{)
- term (substring term (match-end 0))
- mm (if re-p
- `(string-match ,(substring kwd 1 -1) todo)
- (list 'equal 'todo kwd))
- mm (if minus (list 'not mm) mm))
- (push mm todomatcher))
- (push (if (> (length todomatcher) 1)
- (cons 'and todomatcher)
- (car todomatcher))
- orlist)
- (setq todomatcher nil))
- (setq todomatcher (if (> (length orlist) 1)
- (cons 'or orlist) (car orlist))))
-
- ;; Return the string and lisp forms of the matcher
- (setq matcher (if todomatcher
- (list 'and tagsmatcher todomatcher)
- tagsmatcher))
- (when todo-only
- (setq matcher (list 'and '(member todo org-not-done-keywords)
- matcher)))
- (cons match0 matcher)))
-
-(defun org-tags-expand (match &optional single-as-list downcased)
+ (setq tagsmatch (substring match 0 (match-beginning 0)))
+ (setq todomatch (substring match (match-end 0)))
+ (when (string-prefix-p "!" todomatch)
+ (setq org--matcher-tags-todo-only t)
+ (setq todomatch (substring todomatch 1)))
+ (when (string-match "\\`\\s-*\\'" todomatch)
+ (setq todomatch nil)))
+ ;; Only matching tags.
+ (setq tagsmatch match)
+ (setq todomatch nil))
+
+ ;; Make the tags matcher.
+ (when (org-string-nw-p tagsmatch)
+ (let ((orlist nil)
+ (orterms (org-split-string tagsmatch "|"))
+ term)
+ (while (setq term (pop orterms))
+ (while (and (equal (substring term -1) "\\") orterms)
+ (setq term (concat term "|" (pop orterms)))) ;repair bad split.
+ (while (string-match re term)
+ (let* ((rest (substring term (match-end 0)))
+ (minus (and (match-end 1)
+ (equal (match-string 1 term) "-")))
+ (tag (save-match-data
+ (replace-regexp-in-string
+ "\\\\-" "-" (match-string 2 term))))
+ (regexp (eq (string-to-char tag) ?{))
+ (levelp (match-end 4))
+ (propp (match-end 5))
+ (mm
+ (cond
+ (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list))
+ (levelp
+ `(,(org-op-to-function (match-string 3 term))
+ level
+ ,(string-to-number (match-string 4 term))))
+ (propp
+ (let* ((gv (pcase (upcase (match-string 5 term))
+ ("CATEGORY"
+ '(get-text-property (point) 'org-category))
+ ("TODO" 'todo)
+ (p `(org-cached-entry-get nil ,p))))
+ (pv (match-string 7 term))
+ (regexp (eq (string-to-char pv) ?{))
+ (strp (eq (string-to-char pv) ?\"))
+ (timep (string-match-p "^\"[[<].*[]>]\"$" pv))
+ (po (org-op-to-function (match-string 6 term)
+ (if timep 'time strp))))
+ (setq pv (if (or regexp strp) (substring pv 1 -1) pv))
+ (when timep (setq pv (org-matcher-time pv)))
+ (cond ((and regexp (eq po 'org<>))
+ `(not (string-match ,pv (or ,gv ""))))
+ (regexp `(string-match ,pv (or ,gv "")))
+ (strp `(,po (or ,gv "") ,pv))
+ (t
+ `(,po
+ (string-to-number (or ,gv ""))
+ ,(string-to-number pv))))))
+ (t `(member ,tag tags-list)))))
+ (push (if minus `(not ,mm) mm) tagsmatcher)
+ (setq term rest)))
+ (push `(and ,@tagsmatcher) orlist)
+ (setq tagsmatcher nil))
+ (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist)))))
+
+ ;; Make the TODO matcher.
+ (when (org-string-nw-p todomatch)
+ (let ((orlist nil))
+ (dolist (term (org-split-string todomatch "|"))
+ (while (string-match re term)
+ (let* ((minus (and (match-end 1)
+ (equal (match-string 1 term) "-")))
+ (kwd (match-string 2 term))
+ (regexp (eq (string-to-char kwd) ?{))
+ (mm (if regexp `(string-match ,(substring kwd 1 -1) todo)
+ `(equal todo ,kwd))))
+ (push (if minus `(not ,mm) mm) todomatcher))
+ (setq term (substring term (match-end 0))))
+ (push (if (> (length todomatcher) 1)
+ (cons 'and todomatcher)
+ (car todomatcher))
+ orlist)
+ (setq todomatcher nil))
+ (setq todomatcher (cons 'or orlist))))
+
+ ;; Return the string and function of the matcher. If no
+ ;; tags-specific or todo-specific matcher exists, match
+ ;; everything.
+ (let ((matcher (if (and tagsmatcher todomatcher)
+ `(and ,tagsmatcher ,todomatcher)
+ (or tagsmatcher todomatcher t))))
+ (when org--matcher-tags-todo-only
+ (setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
+ (cons match0 `(lambda (todo tags-list level) ,matcher)))))
+
+(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
"Expand group tags in MATCH.
This replaces every group tag in MATCH with a regexp tag search.
For example, a group tag \"Work\" defined as { Work : Lab Conf }
will be replaced like this:
- Work => {\\(?:Work\\|Lab\\|Conf\\)}
- +Work => +{\\(?:Work\\|Lab\\|Conf\\)}
- -Work => -{\\(?:Work\\|Lab\\|Conf\\)}
+ Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
Replacing by a regexp preserves the structure of the match.
E.g., this expansion
@@ -14268,6 +14478,12 @@ E.g., this expansion
will match anything tagged with \"Lab\" and \"Home\", or tagged
with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
+A group tag in MATCH can contain regular expressions of its own.
+For example, a group tag \"Proj\" defined as { Proj : {P@.+} }
+will be replaced like this:
+
+ Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
+
When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
assumed to be a single group tag, and the function will return
the list of tags in this group.
@@ -14276,34 +14492,113 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
- ;; @ and _ are allowed as word-components in tags
+ (taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist))
+ (taggroups (if downcased
+ (mapcar (lambda (tg) (mapcar #'downcase tg))
+ taggroups)
+ taggroups))
+ (taggroups-keys (mapcar #'car taggroups))
+ (return-match (if downcased (downcase match) match))
+ (count 0)
+ (work-already-expanded tags-already-expanded)
+ regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
+ ;; @ and _ are allowed as word-components in tags.
(modify-syntax-entry ?@ "w" stable)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression.
+ (while (string-match "{.+?}" return-match)
+ (cl-incf count)
+ (push (match-string 0 return-match) regexps-in-match)
+ (setq return-match (replace-match (format "<%d>" count) t nil return-match)))
+ (while (and taggroups-keys
(with-syntax-table stable
(string-match
(concat "\\(?1:[+-]?\\)\\(?2:\\<"
- (regexp-opt tml) "\\>\\)")
- rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (regexp-opt taggroups-keys) "\\>\\)")
+ return-match)))
+ (let* ((dir (match-string 1 return-match))
+ (tag (match-string 2 return-match))
(tag (if downcased (downcase tag) tag)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (unless (or (get-text-property 0 'grouptag (match-string 2 return-match))
+ (member tag work-already-expanded))
+ (setq tags-in-group (assoc tag taggroups))
+ (push tag work-already-expanded)
+ ;; Recursively expand each tag in the group, if the tag hasn't
+ ;; already been expanded. Restore the match-data after all recursive calls.
+ (save-match-data
+ (let (tags-expanded)
+ (dolist (x (cdr tags-in-group))
+ (if (and (member x taggroups-keys)
+ (not (member x work-already-expanded)))
+ (setq tags-expanded
+ (delete-dups
+ (append
+ (org-tags-expand x t downcased
+ work-already-expanded)
+ tags-expanded)))
+ (setq tags-expanded
+ (append (list x) tags-expanded)))
+ (setq work-already-expanded
+ (delete-dups
+ (append tags-expanded
+ work-already-expanded))))
+ (setq tags-in-group
+ (delete-dups (cons (car tags-in-group)
+ tags-expanded)))))
+ ;; Filter tag-regexps from tags.
+ (setq regexp-in-group-escaped
+ (delq nil (mapcar (lambda (x)
+ (if (stringp x)
+ (and (equal "{" (substring x 0 1))
+ (equal "}" (substring x -1))
+ x)
+ x))
+ tags-in-group))
+ regexp-in-group
+ (mapcar (lambda (x)
+ (substring x 1 -1))
+ regexp-in-group-escaped)
+ tags-in-group
+ (delq nil (mapcar (lambda (x)
+ (if (stringp x)
+ (and (not (equal "{" (substring x 0 1)))
+ (not (equal "}" (substring x -1)))
+ x)
+ x))
+ tags-in-group)))
+ ;; If single-as-list, do no more in the while-loop.
+ (if (not single-as-list)
+ (progn
+ (when regexp-in-group
+ (setq regexp-in-group
+ (concat "\\|"
+ (mapconcat 'identity regexp-in-group
+ "\\|"))))
+ (setq tags-in-group
+ (concat dir
+ "{\\<"
+ (regexp-opt tags-in-group)
+ "\\>"
+ regexp-in-group
+ "}"))
+ (when (stringp tags-in-group)
+ (org-add-props tags-in-group '(grouptag t)))
+ (setq return-match
+ (replace-match tags-in-group t t return-match)))
+ (setq tags-in-group
+ (append regexp-in-group-escaped tags-in-group))))
+ (setq taggroups-keys (delete tag taggroups-keys))))
+ ;; Add the regular expressions back into the match-expression again.
+ (while regexps-in-match
+ (setq return-match (replace-regexp-in-string (format "<%d>" count)
+ (pop regexps-in-match)
+ return-match t t))
+ (cl-decf count))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
- (if single-as-list (list (if downcased (downcase match) match))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
+ (if single-as-list
+ (list (if downcased (downcase match) match))
match)))
(defun org-op-to-function (op &optional stringp)
@@ -14337,7 +14632,7 @@ it as a time string and apply `float-time' to it. If S is nil, just return 0."
((numberp s) s)
((stringp s)
(condition-case nil
- (float-time (apply 'encode-time (org-parse-time-string s)))
+ (float-time (apply #'encode-time (org-parse-time-string s)))
(error 0.)))
(t 0.)))
@@ -14371,7 +14666,7 @@ epoch to the beginning of today (00:00)."
(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param
(defvar org-tags-overlay (make-overlay 1 1))
-(org-detach-overlay org-tags-overlay)
+(delete-overlay org-tags-overlay)
(defun org-get-local-tags-at (&optional pos)
"Get a list of tags defined in the current headline."
@@ -14405,10 +14700,9 @@ ignore inherited ones."
(org-back-to-heading t)
(while (not (equal lastpos (point)))
(setq lastpos (point))
- (when (looking-at
- (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
+ (when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
(setq ltags (org-split-string
- (org-match-string-no-properties 1) ":"))
+ (match-string-no-properties 1) ":"))
(when parent
(setq ltags (mapcar 'org-add-prop-inherited ltags)))
(setq tags (append
@@ -14417,7 +14711,7 @@ ignore inherited ones."
ltags)
tags)))
(or org-use-tag-inheritance (throw 'done t))
- (if local (throw 'done t))
+ (when local (throw 'done t))
(or (org-up-heading-safe) (error nil))
(setq parent t)))
(error nil)))))
@@ -14436,58 +14730,51 @@ ignore inherited ones."
(defun org-toggle-tag (tag &optional onoff)
"Toggle the tag TAG for the current line.
If ONOFF is `on' or `off', don't toggle but set to this state."
- (let (res current)
- (save-excursion
- (org-back-to-heading t)
- (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$")
- (point-at-eol) t)
- (progn
- (setq current (match-string 1))
- (replace-match ""))
- (setq current ""))
- (setq current (nreverse (org-split-string current ":")))
- (cond
- ((eq onoff 'on)
- (setq res t)
- (or (member tag current) (push tag current)))
- ((eq onoff 'off)
- (or (not (member tag current)) (setq current (delete tag current))))
- (t (if (member tag current)
- (setq current (delete tag current))
- (setq res t)
- (push tag current))))
- (end-of-line 1)
+ (save-excursion
+ (org-back-to-heading t)
+ (let ((current
+ (when (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$"
+ (line-end-position) t)
+ (let ((tags (match-string 1)))
+ ;; Clear current tags.
+ (replace-match "")
+ ;; Reverse the tags list so any new tag is appended to
+ ;; the current list of tags.
+ (nreverse (org-split-string tags ":")))))
+ res)
+ (pcase onoff
+ (`off (setq current (delete tag current)))
+ ((or `on (guard (not (member tag current))))
+ (setq res t)
+ (cl-pushnew tag current :test #'equal))
+ (_ (setq current (delete tag current))))
+ (end-of-line)
(if current
(progn
- (insert " :" (mapconcat 'identity (nreverse current) ":") ":")
+ (insert " :" (mapconcat #'identity (nreverse current) ":") ":")
(org-set-tags nil t))
(delete-horizontal-space))
- (run-hooks 'org-after-tags-change-hook))
- res))
+ (run-hooks 'org-after-tags-change-hook)
+ res)))
-(defun org-align-tags-here (to-col)
- ;; Assumes that this is a headline
- "Align tags on the current headline to TO-COL."
- (let ((pos (point)) (col (current-column)) ncol tags-l p)
- (beginning-of-line 1)
- (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
- (< pos (match-beginning 2)))
- (progn
- (setq tags-l (- (match-end 2) (match-beginning 2)))
- (goto-char (match-beginning 1))
- (insert " ")
- (delete-region (point) (1+ (match-beginning 2)))
- (setq ncol (max (current-column)
- (1+ col)
- (if (> to-col 0)
- to-col
- (- (abs to-col) tags-l))))
- (setq p (point))
- (insert (make-string (- ncol (current-column)) ?\ ))
- (setq ncol (current-column))
- (when indent-tabs-mode (tabify p (point-at-eol)))
- (org-move-to-column (min ncol col)))
- (goto-char pos))))
+(defun org--align-tags-here (to-col)
+ "Align tags on the current headline to TO-COL.
+Assume point is on a headline."
+ (let ((pos (point)))
+ (beginning-of-line)
+ (if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (>= pos (match-beginning 2)))
+ ;; No tags or point within tags: do not align.
+ (goto-char pos)
+ (goto-char (match-beginning 1))
+ (let ((shift (max (- (if (>= to-col 0) to-col
+ (- (abs to-col) (string-width (match-string 2))))
+ (current-column))
+ 1)))
+ (replace-match (make-string shift ?\s) nil nil nil 1)
+ ;; Preserve initial position, if possible. In any case, stop
+ ;; before tags.
+ (when (< pos (point)) (goto-char pos))))))
(defun org-set-tags-command (&optional arg just-align)
"Call the set-tags command for the current entry."
@@ -14517,7 +14804,8 @@ If DATA is nil or the empty string, any tags will be removed."
(when data
(save-excursion
(org-back-to-heading t)
- (when (looking-at org-complex-heading-regexp)
+ (when (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
(if (match-end 5)
(progn
(goto-char (match-beginning 5))
@@ -14528,11 +14816,11 @@ If DATA is nil or the empty string, any tags will be removed."
(insert " " data)
(org-set-tags nil 'align)))
(beginning-of-line 1)
- (if (looking-at ".*?\\([ \t]+\\)$")
- (delete-region (match-beginning 1) (match-end 1))))))
+ (when (looking-at ".*?\\([ \t]+\\)$")
+ (delete-region (match-beginning 1) (match-end 1))))))
(defun org-align-all-tags ()
- "Align the tags i all headings."
+ "Align the tags in all headings."
(interactive)
(save-excursion
(or (ignore-errors (org-back-to-heading t))
@@ -14549,106 +14837,124 @@ When JUST-ALIGN is non-nil, only align tags."
(interactive "P")
(if (and (org-region-active-p) org-loop-over-headlines-in-active-region)
(let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level)
- 'region-start-level 'region))
- org-loop-over-headlines-in-active-region)
- (org-map-entries
- ;; We don't use ARG and JUST-ALIGN here because these args
- ;; are not useful when looping over headlines.
- `(org-set-tags)
- org-loop-over-headlines-in-active-region
- cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
- (let* ((re org-outline-regexp-bol)
- (current (unless arg (org-get-tags-string)))
- (col (current-column))
- (org-setting-tags t)
- table current-tags inherited-tags ; computed below when needed
- tags p0 c0 c1 rpl di tc level)
+ 'region-start-level
+ 'region))
+ org-loop-over-headlines-in-active-region)
+ (org-map-entries
+ ;; We don't use ARG and JUST-ALIGN here because these args
+ ;; are not useful when looping over headlines.
+ #'org-set-tags
+ org-loop-over-headlines-in-active-region
+ cl
+ '(when (org-invisible-p) (org-end-of-subtree nil t))))
+ (let ((org-setting-tags t))
(if arg
- (save-excursion
- (goto-char (point-min))
- (let ((buffer-invisibility-spec (org-inhibit-invisibility)))
- (while (re-search-forward re nil t)
- (org-set-tags nil t)
- (end-of-line 1)))
- (message "All tags realigned to column %d" org-tags-column))
- (if just-align
- (setq tags current)
- ;; Get a new set of tags from the user
- (save-excursion
- (setq table (append org-tag-persistent-alist
- (or org-tag-alist (org-get-buffer-tags))
- (and
- org-complete-tags-always-offer-all-agenda-tags
- (org-global-tags-completion-table
- (org-agenda-files))))
- org-last-tags-completion-table table
- current-tags (org-split-string current ":")
- inherited-tags (nreverse
- (nthcdr (length current-tags)
- (nreverse (org-get-tags-at))))
- tags
- (if (or (eq t org-use-fast-tag-selection)
- (and org-use-fast-tag-selection
- (delq nil (mapcar 'cdr table))))
- (org-fast-tag-selection
- current-tags inherited-tags table
- (if org-fast-tag-selection-include-todo
- org-todo-key-alist))
- (let ((org-add-colon-after-tag-completion (< 1 (length table))))
- (org-trim
- (org-icompleting-read "Tags: "
- 'org-tags-completion-function
- nil nil current 'org-tags-history))))))
- (while (string-match "[-+&]+" tags)
- ;; No boolean logic, just a list
- (setq tags (replace-match ":" t t tags))))
-
- (setq tags (replace-regexp-in-string "[,]" ":" tags))
-
- (if org-tags-sort-function
- (setq tags (mapconcat 'identity
- (sort (org-split-string
- tags (org-re "[^[:alnum:]_@#%]+"))
- org-tags-sort-function) ":")))
-
- (if (string-match "\\`[\t ]*\\'" tags)
- (setq tags "")
- (unless (string-match ":$" tags) (setq tags (concat tags ":")))
- (unless (string-match "^:" tags) (setq tags (concat ":" tags))))
-
- ;; Insert new tags at the correct column
- (beginning-of-line 1)
- (setq level (or (and (looking-at org-outline-regexp)
- (- (match-end 0) (point) 1))
- 1))
- (cond
- ((and (equal current "") (equal tags "")))
- ((re-search-forward
- (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$")
- (point-at-eol) t)
- (if (equal tags "")
- (setq rpl "")
- (goto-char (match-beginning 0))
- (setq c0 (current-column)
- ;; compute offset for the case of org-indent-mode active
- di (if (org-bound-and-true-p org-indent-mode)
- (* (1- org-indent-indentation-per-level) (1- level))
- 0)
- p0 (if (equal (char-before) ?*) (1+ (point)) (point))
- tc (+ org-tags-column (if (> org-tags-column 0) (- di) di))
- c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags))))
- rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags)))
- (replace-match rpl t t)
- (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point)))
- tags)
- (t (error "Tags alignment failed")))
- (org-move-to-column col)
- (unless just-align
- (run-hooks 'org-after-tags-change-hook))))))
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward org-outline-regexp-bol nil t)
+ (org-set-tags nil t)
+ (end-of-line))
+ (message "All tags realigned to column %d" org-tags-column))
+ (let* ((current (org-get-tags-string))
+ (tags
+ (if just-align current
+ ;; Get a new set of tags from the user.
+ (save-excursion
+ (let* ((seen)
+ (table
+ (setq
+ org-last-tags-completion-table
+ ;; Uniquify tags in alists, yet preserve
+ ;; structure (i.e., keywords).
+ (delq nil
+ (mapcar
+ (lambda (pair)
+ (let ((head (car pair)))
+ (cond ((symbolp head) pair)
+ ((member head seen) nil)
+ (t (push head seen)
+ pair))))
+ (append
+ (or org-current-tag-alist
+ (org-get-buffer-tags))
+ (and
+ org-complete-tags-always-offer-all-agenda-tags
+ (org-global-tags-completion-table
+ (org-agenda-files))))))))
+ (current-tags (org-split-string current ":"))
+ (inherited-tags
+ (nreverse (nthcdr (length current-tags)
+ (nreverse (org-get-tags-at))))))
+ (replace-regexp-in-string
+ "\\([-+&]+\\|,\\)"
+ ":"
+ (if (or (eq t org-use-fast-tag-selection)
+ (and org-use-fast-tag-selection
+ (delq nil (mapcar #'cdr table))))
+ (org-fast-tag-selection
+ current-tags inherited-tags table
+ (and org-fast-tag-selection-include-todo
+ org-todo-key-alist))
+ (let ((org-add-colon-after-tag-completion
+ (< 1 (length table))))
+ (org-trim
+ (completing-read
+ "Tags: "
+ #'org-tags-completion-function
+ nil nil current 'org-tags-history))))))))))
+
+ (when org-tags-sort-function
+ (setq tags
+ (mapconcat
+ #'identity
+ (sort (org-split-string tags "[^[:alnum:]_@#%]+")
+ org-tags-sort-function)
+ ":")))
+
+ (if (or (string= ":" tags)
+ (string= "::" tags))
+ (setq tags ""))
+ (if (not (org-string-nw-p tags)) (setq tags "")
+ (unless (string-suffix-p ":" tags) (setq tags (concat tags ":")))
+ (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags))))
+
+ ;; Insert new tags at the correct column.
+ (unless (equal current tags)
+ (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))
+ ;; Remove current tags, if any.
+ (when (match-end 5) (replace-match "" nil nil nil 5))
+ ;; Insert new tags, if any. Otherwise, remove trailing
+ ;; white spaces.
+ (end-of-line)
+ (if (not (equal tags ""))
+ ;; When text is being inserted on an invisible
+ ;; region boundary, it can be inadvertently sucked
+ ;; into invisibility.
+ (outline-flag-region (point) (progn (insert " " tags) (point)) nil)
+ (skip-chars-backward " \t")
+ (delete-region (point) (line-end-position)))))
+ ;; Align tags, if any. Fix tags column if `org-indent-mode'
+ ;; is on.
+ (unless (equal tags "")
+ (let* ((level (save-excursion
+ (beginning-of-line)
+ (skip-chars-forward "\\*")))
+ (offset (if (bound-and-true-p org-indent-mode)
+ (* (1- org-indent-indentation-per-level)
+ (1- level))
+ 0))
+ (tags-column
+ (+ org-tags-column
+ (if (> org-tags-column 0) (- offset) offset))))
+ (org--align-tags-here tags-column))))
+ (unless just-align (run-hooks 'org-after-tags-change-hook))))))
(defun org-change-tag-in-region (beg end tag off)
"Add or remove TAG for each entry in the region.
-This works in the agenda, and also in an org-mode buffer."
+This works in the agenda, and also in an Org buffer."
(interactive
(list (region-beginning) (region-end)
(let ((org-last-tags-completion-table
@@ -14657,37 +14963,37 @@ This works in the agenda, and also in an org-mode buffer."
(delq nil (append (org-get-buffer-tags)
(org-global-tags-completion-table))))
(org-global-tags-completion-table))))
- (org-icompleting-read
+ (completing-read
"Tag: " 'org-tags-completion-function nil nil nil
'org-tags-history))
(progn
(message "[s]et or [r]emove? ")
(equal (read-char-exclusive) ?r))))
- (if (fboundp 'deactivate-mark) (deactivate-mark))
+ (when (fboundp 'deactivate-mark) (deactivate-mark))
(let ((agendap (equal major-mode 'org-agenda-mode))
l1 l2 m buf pos newhead (cnt 0))
(goto-char end)
(setq l2 (1- (org-current-line)))
(goto-char beg)
(setq l1 (org-current-line))
- (loop for l from l1 to l2 do
- (org-goto-line l)
- (setq m (get-text-property (point) 'org-hd-marker))
- (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
- (and agendap m))
- (setq buf (if agendap (marker-buffer m) (current-buffer))
- pos (if agendap m (point)))
- (with-current-buffer buf
- (save-excursion
- (save-restriction
- (goto-char pos)
- (setq cnt (1+ cnt))
- (org-toggle-tag tag (if off 'off 'on))
- (setq newhead (org-get-heading)))))
- (and agendap (org-agenda-change-all-lines newhead m))))
+ (cl-loop for l from l1 to l2 do
+ (org-goto-line l)
+ (setq m (get-text-property (point) 'org-hd-marker))
+ (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p))
+ (and agendap m))
+ (setq buf (if agendap (marker-buffer m) (current-buffer))
+ pos (if agendap m (point)))
+ (with-current-buffer buf
+ (save-excursion
+ (save-restriction
+ (goto-char pos)
+ (setq cnt (1+ cnt))
+ (org-toggle-tag tag (if off 'off 'on))
+ (setq newhead (org-get-heading)))))
+ (and agendap (org-agenda-change-all-lines newhead m))))
(message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
-(defun org-tags-completion-function (string predicate &optional flag)
+(defun org-tags-completion-function (string _predicate &optional flag)
(let (s1 s2 rtn (ctable org-last-tags-completion-table)
(confirm (lambda (x) (stringp (car x)))))
(if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
@@ -14698,12 +15004,12 @@ This works in the agenda, and also in an org-mode buffer."
((eq flag nil)
;; try completion
(setq rtn (try-completion s2 ctable confirm))
- (if (stringp rtn)
- (setq rtn
- (concat s1 s2 (substring rtn (length s2))
- (if (and org-add-colon-after-tag-completion
- (assoc rtn ctable))
- ":" ""))))
+ (when (stringp rtn)
+ (setq rtn
+ (concat s1 s2 (substring rtn (length s2))
+ (if (and org-add-colon-after-tag-completion
+ (assoc rtn ctable))
+ ":" ""))))
rtn)
((eq flag t)
;; all-completions
@@ -14722,8 +15028,8 @@ Also insert END."
(defun org-fast-tag-show-exit (flag)
(save-excursion
(org-goto-line 3)
- (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
- (replace-match ""))
+ (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t)
+ (replace-match ""))
(when flag
(end-of-line 1)
(org-move-to-column (- (window-width) 19) t)
@@ -14732,11 +15038,8 @@ Also insert END."
(defun org-set-current-tags-overlay (current prefix)
"Add an overlay to CURRENT tag with PREFIX."
(let ((s (concat ":" (mapconcat 'identity current ":") ":")))
- (if (featurep 'xemacs)
- (org-overlay-display org-tags-overlay (concat prefix s)
- 'secondary-selection)
- (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
- (org-overlay-display org-tags-overlay (concat prefix s)))))
+ (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s)
+ (org-overlay-display org-tags-overlay (concat prefix s))))
(defvar org-last-tag-selection-key nil)
(defun org-fast-tag-selection (current inherited table &optional todo-table)
@@ -14759,15 +15062,14 @@ Returns the new tags string, or nil to not change the current settings."
(ncol (/ (- (window-width) 4) fwidth))
(i-face 'org-done)
(c-face 'org-todo)
- tg cnt c char c1 c2 ntable tbl rtn
+ tg cnt e c char c1 c2 ntable tbl rtn
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
- (if (looking-at
- (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
+ (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
(setq ov-start (match-beginning 1)
ov-end (match-end 1)
ov-prefix "")
@@ -14788,32 +15090,41 @@ Returns the new tags string, or nil to not change the current settings."
(set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
(org-switch-to-buffer-other-window " *Org tags*"))
(erase-buffer)
- (org-set-local 'org-done-keywords done-keywords)
+ (setq-local org-done-keywords done-keywords)
(org-fast-tag-insert "Inherited" inherited i-face "\n")
(org-fast-tag-insert "Current" current c-face "\n\n")
(org-fast-tag-show-exit exit-after-next)
(org-set-current-tags-overlay current ov-prefix)
(setq tbl fulltable char ?a cnt 0)
- (dolist (e tbl)
+ (while (setq e (pop tbl))
(cond
- ((equal (car e) :startgroup)
+ ((eq (car e) :startgroup)
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n"))
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((equal (car e) :endgroup)
+ ((eq (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((eq (car e) :startgrouptag)
+ (setq intaggroup t)
+ (unless (zerop cnt)
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((eq (car e) :endgrouptag)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -14827,31 +15138,31 @@ Returns the new tags string, or nil to not change the current settings."
(setq char (1+ char)))
(setq c2 c1))
(setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(cond
((not (assoc tg table))
(org-get-todo-face tg))
((member tg current) c-face)
((member tg inherited) i-face))))
- (if (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
+ (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
+ (when (= (cl-incf cnt) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(setq rtn
(catch 'exit
(while t
- (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s"
+ (message "[a-z..]:toggle [SPC]:clear [RET]:accept [TAB]:edit [!] %sgroups%s"
(if (not groups) "no " "")
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
@@ -14873,53 +15184,51 @@ Returns the new tags string, or nil to not change the current settings."
(org-fit-window-to-buffer)))
((or (= c ?\C-g)
(and (= c ?q) (not (rassoc c ntable))))
- (org-detach-overlay org-tags-overlay)
+ (delete-overlay org-tags-overlay)
(setq quit-flag t))
((= c ?\ )
(setq current nil)
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
- (setq tg (org-icompleting-read
+ (setq tg (completing-read
"Tag: "
(or buffer-tags
(with-current-buffer buf
- (org-get-buffer-tags)))))
+ (setq buffer-tags
+ (org-get-buffer-tags))))))
(quit (setq tg "")))
(when (string-match "\\S-" tg)
- (add-to-list 'buffer-tags (list tg))
+ (cl-pushnew (list tg) buffer-tags :test #'equal)
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c todo-table) tg (car e))
(with-current-buffer buf
(save-excursion (org-todo tg)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c ntable) tg (car e))
(if (member tg current)
(setq current (delete tg current))
- (loop for g in groups do
- (if (member tg g)
- (mapc (lambda (x)
- (setq current (delete x current)))
- g)))
+ (cl-loop for g in groups do
+ (when (member tg g)
+ (dolist (x g) (setq current (delete x current)))))
(push tg current))
- (if exit-after-next (setq exit-after-next 'now))))
+ (when exit-after-next (setq exit-after-next 'now))))
;; Create a sorted list
(setq current
(sort current
(lambda (a b)
(assoc b (cdr (memq (assoc a ntable) ntable))))))
- (if (eq exit-after-next 'now) (throw 'exit t))
+ (when (eq exit-after-next 'now) (throw 'exit t))
(goto-char (point-min))
(beginning-of-line 2)
(delete-region (point) (point-at-eol))
(org-fast-tag-insert "Current" current c-face)
(org-set-current-tags-overlay current ov-prefix)
- (while (re-search-forward
- (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t)
+ (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t)
(setq tg (match-string 1))
(add-text-properties
(match-beginning 1) (match-end 1)
@@ -14929,7 +15238,7 @@ Returns the new tags string, or nil to not change the current settings."
((member tg inherited) i-face)
(t (get-text-property (match-beginning 1) 'face))))))
(goto-char (point-min)))))
- (org-detach-overlay org-tags-overlay)
+ (delete-overlay org-tags-overlay)
(if rtn
(mapconcat 'identity current ":")
nil))))
@@ -14940,8 +15249,8 @@ Returns the new tags string, or nil to not change the current settings."
(user-error "Not on a heading"))
(save-excursion
(beginning-of-line 1)
- (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))
- (org-match-string-no-properties 1)
+ (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (match-string-no-properties 1)
"")))
(defun org-get-tags ()
@@ -14950,19 +15259,20 @@ Returns the new tags string, or nil to not change the current settings."
(defun org-get-buffer-tags ()
"Get a table of all tags used in the buffer, for completion."
- (let (tags)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t)
- (when (equal (char-after (point-at-bol 0)) ?*)
- (mapc (lambda (x) (add-to-list 'tags x))
- (org-split-string (org-match-string-no-properties 1) ":")))))
- (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags)
- (mapcar 'list tags)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((tag-re (concat org-outline-regexp-bol
+ "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$"))
+ tags)
+ (while (re-search-forward tag-re nil t)
+ (dolist (tag (org-split-string (match-string-no-properties 1) ":"))
+ (push tag tags)))
+ (mapcar #'list (append org-file-tags (org-uniquify tags))))))
;;;; The mapping API
+(defvar org-agenda-skip-comment-trees)
+(defvar org-agenda-skip-function)
(defun org-map-entries (func &optional match scope &rest skip)
"Call FUNC at each headline selected by MATCH in SCOPE.
@@ -15032,13 +15342,12 @@ a *different* entry, you cannot use these techniques."
(car (org-delete-all '(comment archive) skip)))
(org-tags-match-list-sublevels t)
(start-level (eq scope 'region-start-level))
- matcher file res
+ matcher res
org-todo-keywords-for-agenda
org-done-keywords-for-agenda
org-todo-keyword-alist-for-agenda
- org-drawers-for-agenda
org-tag-alist-for-agenda
- todo-only)
+ org--matcher-tags-todo-only)
(cond
((eq match t) (setq matcher t))
@@ -15071,7 +15380,9 @@ a *different* entry, you cannot use these techniques."
(progn
(org-agenda-prepare-buffers
(and buffer-file-name (list buffer-file-name)))
- (setq res (org-scan-tags func matcher todo-only start-level)))
+ (setq res
+ (org-scan-tags
+ func matcher org--matcher-tags-todo-only start-level)))
;; Get the right scope
(cond
((and scope (listp scope) (symbolp (car scope)))
@@ -15088,22 +15399,21 @@ a *different* entry, you cannot use these techniques."
(org-agenda-prepare-buffers scope)
(dolist (file scope)
(with-current-buffer (org-find-base-buffer-visiting file)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (setq res (append res (org-scan-tags func matcher todo-only))))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (setq res
+ (append
+ res
+ (org-scan-tags
+ func matcher org--matcher-tags-todo-only)))))))))
res)))
-;;;; Properties
-
-;;; Setting and retrieving properties
+;;; Properties API
(defconst org-special-properties
- '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY"
- "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T")
- "The special properties valid in Org-mode.
-
+ '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE"
+ "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO")
+ "The special properties valid in Org mode.
These are properties that are not defined in the property drawer,
but in some other way.")
@@ -15112,59 +15422,85 @@ but in some other way.")
"LOCATION" "LOGGING" "COLUMNS" "VISIBILITY"
"TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE"
"EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME"
- "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE"
+ "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED"
"ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE"
"CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS")
- "Some properties that are used by Org-mode for various purposes.
+ "Some properties that are used by Org mode for various purposes.
Being in this list makes sure that they are offered for completion.")
-(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
-
-(defconst org-property-end-re "^[ \t]*:END:[ \t]*$"
- "Regular expression matching the last line of a property drawer.")
-
-(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
-
-(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$"
- "Regular expression matching the first line of a property drawer.")
-
-(defconst org-property-drawer-re
- (concat "\\(" org-property-start-re "\\)[^\000]*\\("
- org-property-end-re "\\)\n?")
- "Matches an entire property drawer.")
+(defun org--valid-property-p (property)
+ "Non nil when string PROPERTY is a valid property name."
+ (not
+ (or (equal property "")
+ (string-match-p "\\s-" property))))
+
+(defun org--update-property-plist (key val props)
+ "Associate KEY to VAL in alist PROPS.
+Modifications are made by side-effect. Return new alist."
+ (let* ((appending (string= (substring key -1) "+"))
+ (key (if appending (substring key 0 -1) key))
+ (old (assoc-string key props t)))
+ (if (not old) (cons (cons key val) props)
+ (setcdr old (if appending (concat (cdr old) " " val) val))
+ props)))
+
+(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."
+ (org-with-wide-buffer
+ (when beg (goto-char beg))
+ (unless (org-before-first-heading-p)
+ (let ((beg (cond (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))))))))
-(defconst org-clock-drawer-re
- (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\("
- org-property-end-re "\\)\n?")
- "Matches an entire clock drawer.")
+(defun org-at-property-p ()
+ "Non-nil when point is inside a property drawer.
+See `org-property-re' for match data, if applicable."
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at org-property-re)
+ (let ((property-drawer (save-match-data (org-get-property-block))))
+ (and property-drawer
+ (>= (point) (car property-drawer))
+ (< (point) (cdr property-drawer)))))))
(defun org-property-action ()
"Do an action on properties."
(interactive)
- (let (c)
- (org-at-property-p)
- (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
- (setq c (read-char-exclusive))
- (cond
- ((equal c ?s)
- (call-interactively 'org-set-property))
- ((equal c ?d)
- (call-interactively 'org-delete-property))
- ((equal c ?D)
- (call-interactively 'org-delete-property-globally))
- ((equal c ?c)
- (call-interactively 'org-compute-property-at-point))
- (t (user-error "No such property action %c" c)))))
+ (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute")
+ (let ((c (read-char-exclusive)))
+ (cl-case c
+ (?s (call-interactively #'org-set-property))
+ (?d (call-interactively #'org-delete-property))
+ (?D (call-interactively #'org-delete-property-globally))
+ (?c (call-interactively #'org-compute-property-at-point))
+ (otherwise (user-error "No such property action %c" c)))))
(defun org-inc-effort ()
"Increment the value of the effort property in the current entry."
(interactive)
(org-set-effort nil t))
-(defvar org-clock-effort) ;; Defined in org-clock.el
-(defvar org-clock-current-task) ;; Defined in org-clock.el
+(defvar org-clock-effort) ; Defined in org-clock.el.
+(defvar org-clock-current-task) ; Defined in org-clock.el.
(defun org-set-effort (&optional value increment)
"Set the effort property of the current entry.
With numerical prefix arg, use the nth allowed value, 0 stands for the
@@ -15172,7 +15508,7 @@ With numerical prefix arg, use the nth allowed value, 0 stands for the
When INCREMENT is non-nil, set the property to the next allowed value."
(interactive "P")
- (if (equal value 0) (setq value 10))
+ (when (equal value 0) (setq value 10))
(let* ((completion-ignore-case t)
(prop org-effort-property)
(cur (org-entry-get nil prop))
@@ -15186,7 +15522,7 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(or (car (nth (1- value) allowed))
(car (org-last allowed))))
((and allowed increment)
- (or (caadr (member (list cur) allowed))
+ (or (cl-caadr (member (list cur) allowed))
(user-error "Allowed effort values are not set")))
(allowed
(message "Select 1-9,0, [RET%s]: %s"
@@ -15196,231 +15532,294 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(if (equal rpl ?\r)
cur
(setq rpl (- rpl ?0))
- (if (equal rpl 0) (setq rpl 10))
+ (when (equal rpl 0) (setq rpl 10))
(if (and (> rpl 0) (<= rpl (length allowed)))
(car (nth (1- rpl) allowed))
(org-completing-read "Effort: " allowed nil))))
(t
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (org-completing-read
- (concat "Effort " (if (and cur (string-match "\\S-" cur))
- (concat "[" cur "]") "")
- ": ")
- existing nil nil "" nil cur))))))
+ (org-completing-read
+ (concat "Effort" (and cur (string-match "\\S-" cur)
+ (concat " [" cur "]"))
+ ": ")
+ existing nil nil "" nil cur)))))
(unless (equal (org-entry-get nil prop) val)
(org-entry-put nil prop val))
- (save-excursion
- (org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'org-effort val))
- (when (string= heading org-clock-current-task)
- (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort))
+ (org-refresh-property
+ '((effort . identity)
+ (effort-minutes . org-duration-to-minutes))
+ val)
+ (when (equal heading (bound-and-true-p org-clock-current-task))
+ (setq org-clock-effort (get-text-property (point-at-bol) 'effort))
(org-clock-update-mode-line))
(message "%s is now %s" prop val)))
-(defun org-at-property-p ()
- "Is cursor inside a property drawer?"
- (save-excursion
- (when (equal 'node-property (car (org-element-at-point)))
- (beginning-of-line 1)
- (looking-at org-property-re))))
+(defun org-entry-properties (&optional pom which)
+ "Get all properties of the current entry.
+
+When POM is a buffer position, get all properties from the entry
+there instead.
+
+This includes the TODO keyword, the tags, time strings for
+deadline, scheduled, and clocking, and any additional properties
+defined in the entry.
-(defun org-get-property-block (&optional beg end force)
- "Return the (beg . end) range of the body of the property drawer.
-BEG and END are the beginning and end of the current subtree, or of
-the part before the first headline. If they are not given, they will
-be found. If the drawer does not exist and FORCE is non-nil, create
-the drawer."
- (catch 'exit
- (save-excursion
- (let* ((beg (or beg (and (org-before-first-heading-p) (point-min))
- (progn (org-back-to-heading t) (point))))
- (end (or end (and (not (outline-next-heading)) (point-max))
- (point))))
- (goto-char beg)
- (if (re-search-forward org-property-start-re end t)
- (setq beg (1+ (match-end 0)))
- (if force
- (save-excursion
- (org-insert-property-drawer)
- (setq end (progn (outline-next-heading) (point))))
- (throw 'exit nil))
- (goto-char beg)
- (if (re-search-forward org-property-start-re end t)
- (setq beg (1+ (match-end 0)))))
- (if (re-search-forward org-property-end-re end t)
- (setq end (match-beginning 0))
- (or force (throw 'exit nil))
- (goto-char beg)
- (setq end beg)
- (org-indent-line)
- (insert ":END:\n"))
- (cons beg end)))))
-
-(defun org-entry-properties (&optional pom which specific)
- "Get all properties of the entry at point-or-marker POM.
-This includes the TODO keyword, the tags, time strings for deadline,
-scheduled, and clocking, and any additional properties defined in the
-entry. The return value is an alist, keys may occur multiple times
-if the property key was used several times.
-POM may also be nil, in which case the current entry is used.
If WHICH is nil or `all', get all properties. If WHICH is
-`special' or `standard', only get that subclass. If WHICH
-is a string only get exactly this property. SPECIFIC can be a string, the
-specific property we are interested in. Specifying it can speed
-things up because then unnecessary parsing is avoided."
- (setq which (or which 'all))
- (org-with-wide-buffer
- (org-with-point-at pom
- (let ((clockstr (substring org-clock-string 0 -1))
- (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED"))
- (case-fold-search nil)
- beg end range props sum-props key key1 value string clocksum clocksumt)
- (when (and (derived-mode-p 'org-mode)
- (ignore-errors (org-back-to-heading t)))
- (setq beg (point))
- (setq sum-props (get-text-property (point) 'org-summaries))
- (setq clocksum (get-text-property (point) :org-clock-minutes)
- clocksumt (get-text-property (point) :org-clock-minutes-today))
- (outline-next-heading)
- (setq end (point))
- (when (memq which '(all special))
- ;; Get the special properties, like TODO and tags
- (goto-char beg)
- (when (and (or (not specific) (string= specific "TODO"))
- (looking-at org-todo-line-regexp) (match-end 2))
- (push (cons "TODO" (org-match-string-no-properties 2)) props))
- (when (and (or (not specific) (string= specific "PRIORITY"))
- (looking-at org-priority-regexp))
- (push (cons "PRIORITY" (org-match-string-no-properties 2)) props))
- (when (or (not specific) (string= specific "FILE"))
- (push (cons "FILE" buffer-file-name) props))
- (when (and (or (not specific) (string= specific "TAGS"))
- (setq value (org-get-tags-string))
- (string-match "\\S-" value))
- (push (cons "TAGS" value) props))
- (when (and (or (not specific) (string= specific "ALLTAGS"))
- (setq value (org-get-tags-at)))
- (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":")
- ":"))
- props))
- (when (or (not specific) (string= specific "BLOCKED"))
- (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props))
- (when (or (not specific)
- (member specific
- '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
- "TIMESTAMP" "TIMESTAMP_IA")))
- (catch 'match
- (while (and (re-search-forward org-maybe-keyword-time-regexp end t)
- (not (text-property-any 0 (length (match-string 0))
- 'face 'font-lock-comment-face
- (match-string 0))))
- (setq key (if (match-end 1)
- (substring (org-match-string-no-properties 1)
- 0 -1))
- string (if (equal key clockstr)
- (org-trim
- (buffer-substring-no-properties
- (match-beginning 3) (goto-char
- (point-at-eol))))
- (substring (org-match-string-no-properties 3)
- 1 -1)))
- ;; Get the correct property name from the key. This is
- ;; necessary if the user has configured time keywords.
- (setq key1 (concat key ":"))
- (cond
- ((not key)
- (setq key
- (if (= (char-after (match-beginning 3)) ?\[)
- "TIMESTAMP_IA" "TIMESTAMP")))
- ((equal key1 org-scheduled-string) (setq key "SCHEDULED"))
- ((equal key1 org-deadline-string) (setq key "DEADLINE"))
- ((equal key1 org-closed-string) (setq key "CLOSED"))
- ((equal key1 org-clock-string) (setq key "CLOCK")))
- (if (and specific (equal key specific) (not (equal key "CLOCK")))
- (progn
- (push (cons key string) props)
- ;; no need to search further if match is found
- (throw 'match t))
- (when (or (equal key "CLOCK") (not (assoc key props)))
- (push (cons key string) props)))))))
-
- (when (memq which '(all standard))
- ;; Get the standard properties, like :PROP: ...
- (setq range (org-get-property-block beg end))
- (when range
- (goto-char (car range))
- (while (re-search-forward org-property-re
- (cdr range) t)
- (setq key (org-match-string-no-properties 2)
- value (org-trim (or (org-match-string-no-properties 3) "")))
- (unless (member key excluded)
- (push (cons key (or value "")) props)))))
- (if clocksum
- (push (cons "CLOCKSUM"
- (org-columns-number-to-string (/ (float clocksum) 60.)
- 'add_times))
- props))
- (if clocksumt
- (push (cons "CLOCKSUM_T"
- (org-columns-number-to-string (/ (float clocksumt) 60.)
- 'add_times))
- props))
- (unless (assoc "CATEGORY" props)
- (push (cons "CATEGORY" (org-get-category)) props))
- (append sum-props (nreverse props)))))))
+`special' or `standard', only get that subclass. If WHICH is
+a string, only get that property.
+
+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)))
+ (catch 'exit
+ (let* ((beg (point))
+ (specific (and (stringp which) (upcase which)))
+ (which (cond ((not specific) which)
+ ((member specific org-special-properties) 'special)
+ (t 'standard)))
+ props)
+ ;; Get the special properties, like TODO and TAGS.
+ (when (memq which '(nil all special))
+ (when (or (not specific) (string= specific "CLOCKSUM"))
+ (let ((clocksum (get-text-property (point) :org-clock-minutes)))
+ (when clocksum
+ (push (cons "CLOCKSUM" (org-duration-from-minutes clocksum))
+ props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "CLOCKSUM_T"))
+ (let ((clocksumt (get-text-property (point)
+ :org-clock-minutes-today)))
+ (when clocksumt
+ (push (cons "CLOCKSUM_T"
+ (org-duration-from-minutes clocksumt))
+ props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "ITEM"))
+ (let ((case-fold-search nil))
+ (when (looking-at org-complex-heading-regexp)
+ (push (cons "ITEM"
+ (let ((title (match-string-no-properties 4)))
+ (if (org-string-nw-p title)
+ (org-remove-tabs title)
+ "")))
+ props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "TODO"))
+ (let ((case-fold-search nil))
+ (when (and (looking-at org-todo-line-regexp) (match-end 2))
+ (push (cons "TODO" (match-string-no-properties 2)) props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "PRIORITY"))
+ (push (cons "PRIORITY"
+ (if (looking-at org-priority-regexp)
+ (match-string-no-properties 2)
+ (char-to-string org-default-priority)))
+ props)
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "FILE"))
+ (push (cons "FILE" (buffer-file-name (buffer-base-buffer)))
+ props)
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "TAGS"))
+ (let ((value (org-string-nw-p (org-get-tags-string))))
+ (when value (push (cons "TAGS" value) props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "ALLTAGS"))
+ (let ((value (org-get-tags-at)))
+ (when value
+ (push (cons "ALLTAGS"
+ (format ":%s:" (mapconcat #'identity value ":")))
+ props)))
+ (when specific (throw 'exit props)))
+ (when (or (not specific) (string= specific "BLOCKED"))
+ (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)
+ (when specific (throw 'exit props)))
+ (when (or (not specific)
+ (member specific '("CLOSED" "DEADLINE" "SCHEDULED")))
+ (forward-line)
+ (when (looking-at-p org-planning-line-re)
+ (end-of-line)
+ (let ((bol (line-beginning-position))
+ ;; Backward compatibility: time keywords used to
+ ;; be configurable (before 8.3). Make sure we
+ ;; get the correct keyword.
+ (key-assoc `(("CLOSED" . ,org-closed-string)
+ ("DEADLINE" . ,org-deadline-string)
+ ("SCHEDULED" . ,org-scheduled-string))))
+ (dolist (pair (if specific (list (assoc specific key-assoc))
+ key-assoc))
+ (save-excursion
+ (when (search-backward (cdr pair) bol t)
+ (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (and (looking-at org-ts-regexp-both)
+ (push (cons (car pair)
+ (match-string-no-properties 0))
+ props)))))))
+ (when specific (throw 'exit props)))
+ (when (or (not specific)
+ (member specific '("TIMESTAMP" "TIMESTAMP_IA")))
+ (let ((find-ts
+ (lambda (end ts)
+ ;; Fix next time-stamp before END. TS is the
+ ;; list of time-stamps found so far.
+ (let ((ts ts)
+ (regexp (cond
+ ((string= specific "TIMESTAMP")
+ org-ts-regexp)
+ ((string= specific "TIMESTAMP_IA")
+ org-ts-regexp-inactive)
+ ((assoc "TIMESTAMP_IA" ts)
+ org-ts-regexp)
+ ((assoc "TIMESTAMP" ts)
+ org-ts-regexp-inactive)
+ (t org-ts-regexp-both))))
+ (catch 'next
+ (while (re-search-forward regexp end t)
+ (backward-char)
+ (let ((object (org-element-context)))
+ ;; Accept to match timestamps in node
+ ;; properties, too.
+ (when (memq (org-element-type object)
+ '(node-property timestamp))
+ (let ((type
+ (org-element-property :type object)))
+ (cond
+ ((and (memq type '(active active-range))
+ (not (equal specific "TIMESTAMP_IA")))
+ (unless (assoc "TIMESTAMP" ts)
+ (push (cons "TIMESTAMP"
+ (org-element-property
+ :raw-value object))
+ ts)
+ (when specific (throw 'exit ts))))
+ ((and (memq type '(inactive inactive-range))
+ (not (string= specific "TIMESTAMP")))
+ (unless (assoc "TIMESTAMP_IA" ts)
+ (push (cons "TIMESTAMP_IA"
+ (org-element-property
+ :raw-value object))
+ ts)
+ (when specific (throw 'exit ts))))))
+ ;; Both timestamp types are found,
+ ;; move to next part.
+ (when (= (length ts) 2) (throw 'next ts)))))
+ ts)))))
+ (goto-char beg)
+ ;; First look for timestamps within headline.
+ (let ((ts (funcall find-ts (line-end-position) nil)))
+ (if (= (length ts) 2) (setq props (nconc ts props))
+ ;; Then find timestamps in the section, skipping
+ ;; planning line.
+ (let ((end (save-excursion (outline-next-heading))))
+ (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line))
+ (setq props (nconc (funcall find-ts end ts) props))))))))
+ ;; Get the standard properties, like :PROP:.
+ (when (memq which '(nil all standard))
+ ;; If we are looking after a specific property, delegate
+ ;; to `org-entry-get', which is faster. However, make an
+ ;; exception for "CATEGORY", since it can be also set
+ ;; through keywords (i.e. #+CATEGORY).
+ (if (and specific (not (equal specific "CATEGORY")))
+ (let ((value (org-entry-get beg specific nil t)))
+ (throw 'exit (and value (list (cons specific value)))))
+ (let ((range (org-get-property-block beg)))
+ (when range
+ (let ((end (cdr range)) seen-base)
+ (goto-char (car range))
+ ;; Unlike to `org--update-property-plist', we
+ ;; handle the case where base values is found
+ ;; after its extension. We also forbid standard
+ ;; properties to be named as special properties.
+ (while (re-search-forward org-property-re end t)
+ (let* ((key (upcase (match-string-no-properties 2)))
+ (extendp (string-match-p "\\+\\'" key))
+ (key-base (if extendp (substring key 0 -1) key))
+ (value (match-string-no-properties 3)))
+ (cond
+ ((member-ignore-case key-base org-special-properties))
+ (extendp
+ (setq props
+ (org--update-property-plist key value props)))
+ ((member key seen-base))
+ (t (push key seen-base)
+ (let ((p (assoc-string key props t)))
+ (if p (setcdr p (concat value " " (cdr p)))
+ (push (cons key value) props))))))))))))
+ (unless (assoc "CATEGORY" props)
+ (push (cons "CATEGORY" (org-get-category beg)) props)
+ (when (string= specific "CATEGORY") (throw 'exit props)))
+ ;; Return value.
+ props)))))
+
+(defun org--property-local-values (property literal-nil)
+ "Return value for PROPERTY in current entry.
+Value is a list whose car is the base value for PROPERTY and cdr
+a list of accumulated values. Return nil if neither is found in
+the entry. Also return nil when PROPERTY is set to \"nil\",
+unless LITERAL-NIL is non-nil."
+ (let ((range (org-get-property-block)))
+ (when range
+ (goto-char (car range))
+ (let* ((case-fold-search t)
+ (end (cdr range))
+ (value
+ ;; Base value.
+ (save-excursion
+ (let ((v (and (re-search-forward
+ (org-re-property property nil t) end t)
+ (match-string-no-properties 3))))
+ (list (if literal-nil v (org-not-nil v)))))))
+ ;; Find additional values.
+ (let* ((property+ (org-re-property (concat property "+") nil t)))
+ (while (re-search-forward property+ end t)
+ (push (match-string-no-properties 3) value)))
+ ;; 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.
+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."
+ (let ((global
+ (cdr (or (assoc-string property org-file-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))))
(defun org-entry-get (pom property &optional inherit literal-nil)
"Get value of PROPERTY for entry or content at point-or-marker POM.
-If INHERIT is non-nil and the entry does not have the property,
-then also check higher levels of the hierarchy.
-If INHERIT is the symbol `selective', use inheritance only if the setting
-in `org-use-property-inheritance' selects PROPERTY for inheritance.
-If the property is present but empty, the return value is the empty string.
-If the property is not present at all, nil is returned.
-
-Return the value as a string.
-If LITERAL-NIL is set, return the string value \"nil\" as a string,
-do not interpret it as the list atom nil. This is used for inheritance
-when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
+If INHERIT is non-nil and the entry does not have the property,
+then also check higher levels of the hierarchy. If INHERIT is
+the symbol `selective', use inheritance only if the setting in
+`org-use-property-inheritance' selects PROPERTY for inheritance.
+
+If the property is present but empty, the return value is the
+empty string. If the property is not present at all, nil is
+returned. In any other case, return the value as a string.
+Search is case-insensitive.
+
+If LITERAL-NIL is set, return the string value \"nil\" as
+a string, do not interpret it as the list atom nil. This is used
+for inheritance when a \"nil\" value can supersede a non-nil
+value higher up the hierarchy."
(org-with-point-at pom
- (if (and inherit (if (eq inherit 'selective)
- (org-property-inherit-p property)
- t))
- (org-entry-get-with-inheritance property literal-nil)
- (if (member property org-special-properties)
- ;; We need a special property. Use `org-entry-properties'
- ;; to retrieve it, but specify the wanted property
- (cdr (assoc property (org-entry-properties nil 'special property)))
- (org-with-wide-buffer
- (let ((range (org-get-property-block)))
- (when (and range (not (eq (car range) (cdr range)))
- (save-excursion
- (goto-char (car range))
- (re-search-forward
- (concat (org-re-property property) "\\|"
- (org-re-property (concat property "+")))
- (cdr range) t)))
- (let* ((props
- (list (or (assoc property org-file-properties)
- (assoc property org-global-properties)
- (assoc property org-global-properties-fixed))))
- (ap (lambda (key)
- (when (re-search-forward
- (org-re-property key) (cdr range) t)
- (setq props
- (org-update-property-plist
- key
- (if (match-end 3)
- (org-match-string-no-properties 3) "")
- props)))))
- val)
- (goto-char (car range))
- (funcall ap property)
- (goto-char (car range))
- (while (funcall ap (concat property "+")))
- (setq val (cdr (assoc property props)))
- (when val (if literal-nil val (org-not-nil val)))))))))))
+ (cond
+ ((member-ignore-case property (cons "CATEGORY" org-special-properties))
+ ;; We need a special property. Use `org-entry-properties' to
+ ;; retrieve it, but specify the wanted property.
+ (cdr (assoc-string property (org-entry-properties nil property))))
+ ((and inherit
+ (or (not (eq inherit 'selective)) (org-property-inherit-p property)))
+ (org-entry-get-with-inheritance property literal-nil))
+ (t
+ (let* ((local (org--property-local-values property literal-nil))
+ (value (and local (mapconcat #'identity (delq nil local) " "))))
+ (if literal-nil value (org-not-nil value)))))))
(defun org-property-or-variable-value (var &optional inherit)
"Check if there is a property fixing the value of VAR.
@@ -15430,70 +15829,67 @@ If yes, return this value. If not, return the current value of the variable."
(read prop)
(symbol-value var))))
-(defun org-entry-delete (pom property &optional delete-empty-drawer)
- "Delete the property PROPERTY from entry at point-or-marker POM.
-When optional argument DELETE-EMPTY-DRAWER is a string, it defines
-an empty drawer to delete."
+(defun org-entry-delete (pom property)
+ "Delete PROPERTY from entry at point-or-marker POM.
+Accumulated properties, i.e. PROPERTY+, are also removed. Return
+non-nil when a property was removed."
(org-with-point-at pom
- (if (member property org-special-properties)
- nil ; cannot delete these properties.
- (let ((range (org-get-property-block)))
- (if (and range
- (goto-char (car range))
- (re-search-forward
- (org-re-property property nil t)
- (cdr range) t))
- (progn
- (delete-region (match-beginning 0) (1+ (point-at-eol)))
- (and delete-empty-drawer
- (org-remove-empty-drawer-at
- delete-empty-drawer (car range)))
- t)
- nil)))))
+ (pcase (org-get-property-block)
+ (`(,begin . ,origin)
+ (let* ((end (copy-marker origin))
+ (re (org-re-property
+ (concat (regexp-quote property) "\\+?") t t)))
+ (goto-char begin)
+ (while (re-search-forward re end t)
+ (delete-region (match-beginning 0) (line-beginning-position 2)))
+ ;; If drawer is empty, remove it altogether.
+ (when (= begin end)
+ (delete-region (line-beginning-position 0)
+ (line-beginning-position 2)))
+ ;; Return non-nil if some property was removed.
+ (prog1 (/= end origin) (set-marker end nil))))
+ (_ nil))))
;; Multi-values properties are properties that contain multiple values
;; These values are assumed to be single words, separated by whitespace.
(defun org-entry-add-to-multivalued-property (pom property value)
"Add VALUE to the words in the PROPERTY in entry at point-or-marker POM."
(let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
+ (values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(unless (member value values)
(setq values (append values (list value)))
- (org-entry-put pom property
- (mapconcat 'identity values " ")))))
+ (org-entry-put pom property (mapconcat #'identity values " ")))))
(defun org-entry-remove-from-multivalued-property (pom property value)
"Remove VALUE from words in the PROPERTY in entry at point-or-marker POM."
(let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
+ (values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(when (member value values)
(setq values (delete value values))
- (org-entry-put pom property
- (mapconcat 'identity values " ")))))
+ (org-entry-put pom property (mapconcat #'identity values " ")))))
(defun org-entry-member-in-multivalued-property (pom property value)
"Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?"
(let* ((old (org-entry-get pom property))
- (values (and old (org-split-string old "[ \t]"))))
+ (values (and old (split-string old))))
(setq value (org-entry-protect-space value))
(member value values)))
(defun org-entry-get-multivalued-property (pom property)
"Return a list of values in a multivalued property."
(let* ((value (org-entry-get pom property))
- (values (and value (org-split-string value "[ \t]"))))
- (mapcar 'org-entry-restore-space values)))
+ (values (and value (split-string value))))
+ (mapcar #'org-entry-restore-space values)))
(defun org-entry-put-multivalued-property (pom property &rest values)
"Set multivalued PROPERTY at point-or-marker POM to VALUES.
VALUES should be a list of strings. Spaces will be protected."
- (org-entry-put pom property
- (mapconcat 'org-entry-protect-space values " "))
+ (org-entry-put pom property (mapconcat #'org-entry-protect-space values " "))
(let* ((value (org-entry-get pom property))
- (values (and value (org-split-string value "[ \t]"))))
- (mapcar 'org-entry-restore-space values)))
+ (values (and value (split-string value))))
+ (mapcar #'org-entry-restore-space values)))
(defun org-entry-protect-space (s)
"Protect spaces and newline in string S."
@@ -15526,24 +15922,29 @@ If the value found is \"nil\", return nil to show that the property
should be considered as undefined (this is the meaning of nil here).
However, if LITERAL-NIL is set, return the string value \"nil\" instead."
(move-marker org-entry-property-inherited-from nil)
- (let (tmp)
- (save-excursion
- (save-restriction
- (widen)
- (catch 'ex
- (while t
- (when (setq tmp (org-entry-get nil property nil literal-nil))
- (or (ignore-errors (org-back-to-heading t))
- (goto-char (point-min)))
- (move-marker org-entry-property-inherited-from (point))
- (throw 'ex tmp))
- (or (ignore-errors (org-up-heading-safe))
- (throw 'ex nil))))))
- (setq tmp (or tmp
- (cdr (assoc property org-file-properties))
- (cdr (assoc property org-global-properties))
- (cdr (assoc property org-global-properties-fixed))))
- (if literal-nil tmp (org-not-nil tmp))))
+ (org-with-wide-buffer
+ (let (value)
+ (catch 'exit
+ (while t
+ (let ((v (org--property-local-values property literal-nil)))
+ (when v
+ (setq value
+ (concat (mapconcat #'identity (delq nil v) " ")
+ (and value " ")
+ value)))
+ (cond
+ ((car v)
+ (org-back-to-heading t)
+ (move-marker org-entry-property-inherited-from (point))
+ (throw 'exit nil))
+ ((org-up-heading-safe))
+ (t
+ (let ((global (org--property-global-value property literal-nil)))
+ (cond ((not global))
+ (value (setq value (concat global " " value)))
+ (t (setq value global))))
+ (throw 'exit nil))))))
+ (if literal-nil value (org-not-nil value)))))
(defvar org-property-changed-functions nil
"Hook called when the value of a property has changed.
@@ -15552,177 +15953,190 @@ and the new value.")
(defun org-entry-put (pom property value)
"Set PROPERTY to VALUE for entry at point-or-marker POM.
-If the value is nil, it is converted to the empty string.
-If it is not a string, an error is raised."
+
+If the value is nil, it is converted to the empty string. If it
+is not a string, an error is raised. Also raise an error on
+invalid property names.
+
+PROPERTY can be any regular property (see
+`org-special-properties'). It can also be \"TODO\",
+\"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\".
+
+For the last two properties, VALUE may have any of the special
+values \"earlier\" and \"later\". The function then increases or
+decreases scheduled or deadline date by one day."
(cond ((null value) (setq value ""))
- ((not (stringp value))
- (error "Properties values should be strings.")))
+ ((not (stringp value)) (error "Properties values should be strings"))
+ ((not (org--valid-property-p property))
+ (user-error "Invalid property name: \"%s\"" property)))
(org-with-point-at pom
- (org-back-to-heading t)
- (let ((beg (point)) (end (save-excursion (outline-next-heading) (point)))
- range)
+ (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)))
+ (let ((beg (point)))
(cond
((equal property "TODO")
- (when (and (string-match "\\S-" value)
- (not (member value org-todo-keywords-1)))
- (user-error "\"%s\" is not a valid TODO state" value))
- (if (or (not value)
- (not (string-match "\\S-" value)))
- (setq value 'none))
+ (cond ((not (org-string-nw-p value)) (setq value 'none))
+ ((not (member value org-todo-keywords-1))
+ (user-error "\"%s\" is not a valid TODO state" value)))
(org-todo value)
(org-set-tags nil 'align))
((equal property "PRIORITY")
- (org-priority (if (and value (string-match "\\S-" value))
- (string-to-char value) ?\ ))
+ (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s))
(org-set-tags nil 'align))
- ((equal property "CLOCKSUM")
- (if (not (re-search-forward
- (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t))
- (error "Cannot find a clock log")
- (goto-char (- (match-end 1) 2))
- (cond
- ((eq value 'earlier) (org-timestamp-down))
- ((eq value 'later) (org-timestamp-up)))
- (org-clock-sum-current-item)))
((equal property "SCHEDULED")
- (if (re-search-forward org-scheduled-time-regexp end t)
- (cond
- ((eq value 'earlier) (org-timestamp-change -1 'day))
- ((eq value 'later) (org-timestamp-change 1 'day))
- (t (call-interactively 'org-schedule)))
- (call-interactively 'org-schedule)))
+ (forward-line)
+ (if (and (looking-at-p org-planning-line-re)
+ (re-search-forward
+ org-scheduled-time-regexp (line-end-position) t))
+ (cond ((string= value "earlier") (org-timestamp-change -1 'day))
+ ((string= value "later") (org-timestamp-change 1 'day))
+ ((string= value "") (org-schedule '(4)))
+ (t (org-schedule nil value)))
+ (if (member value '("earlier" "later" ""))
+ (call-interactively #'org-schedule)
+ (org-schedule nil value))))
((equal property "DEADLINE")
- (if (re-search-forward org-deadline-time-regexp end t)
- (cond
- ((eq value 'earlier) (org-timestamp-change -1 'day))
- ((eq value 'later) (org-timestamp-change 1 'day))
- (t (call-interactively 'org-deadline)))
- (call-interactively 'org-deadline)))
+ (forward-line)
+ (if (and (looking-at-p org-planning-line-re)
+ (re-search-forward
+ org-deadline-time-regexp (line-end-position) t))
+ (cond ((string= value "earlier") (org-timestamp-change -1 'day))
+ ((string= value "later") (org-timestamp-change 1 'day))
+ ((string= value "") (org-deadline '(4)))
+ (t (org-deadline nil value)))
+ (if (member value '("earlier" "later" ""))
+ (call-interactively #'org-deadline)
+ (org-deadline nil value))))
((member property org-special-properties)
- (error "The %s property can not yet be set with `org-entry-put'"
- property))
- (t ; a non-special property
- (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21
- (setq range (org-get-property-block beg end 'force))
+ (error "The %s property cannot be set with `org-entry-put'" property))
+ (t
+ (let* ((range (org-get-property-block beg 'force))
+ (end (cdr range))
+ (case-fold-search t))
(goto-char (car range))
- (if (re-search-forward
- (org-re-property property nil t) (cdr range) t)
- (progn
- (delete-region (match-beginning 0) (match-end 0))
- (goto-char (match-beginning 0)))
- (goto-char (cdr range))
+ (if (re-search-forward (org-re-property property nil t) end t)
+ (progn (delete-region (match-beginning 0) (match-end 0))
+ (goto-char (match-beginning 0)))
+ (goto-char end)
(insert "\n")
- (backward-char 1)
- (org-indent-line))
+ (backward-char))
(insert ":" property ":")
- (and value (insert " " value))
+ (when value (insert " " value))
(org-indent-line)))))
(run-hook-with-args 'org-property-changed-functions property value)))
-(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns)
+(defun org-buffer-property-keys
+ (&optional specials defaults columns ignore-malformed)
"Get all property keys in the current buffer.
-With INCLUDE-SPECIALS, also list the special properties that reflect things
-like tags and TODO state.
-With INCLUDE-DEFAULTS, also include properties that has special meaning
-internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING
-and others.
-With INCLUDE-COLUMNS, also include property names given in COLUMN
-formats in the current buffer."
- (let (rtn range cfmt s p)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward org-property-start-re nil t)
- (setq range (org-get-property-block))
- (goto-char (car range))
- (while (re-search-forward org-property-re
- (cdr range) t)
- (add-to-list 'rtn (org-match-string-no-properties 2)))
- (outline-next-heading))))
- (when include-specials
- (setq rtn (append org-special-properties rtn)))
+When SPECIALS is non-nil, also list the special properties that
+reflect things like tags and TODO state.
- (when include-defaults
- (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties)
- (add-to-list 'rtn org-effort-property))
+When DEFAULTS is non-nil, also include properties that has
+special meaning internally: ARCHIVE, CATEGORY, SUMMARY,
+DESCRIPTION, LOCATION, and LOGGING and others.
- (when include-columns
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (re-search-forward
- "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)"
- nil t)
- (setq cfmt (match-string 2) s 0)
- (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)")
- cfmt s)
- (setq s (match-end 0)
- p (match-string 1 cfmt))
- (unless (or (equal p "ITEM")
- (member p org-special-properties))
- (add-to-list 'rtn (match-string 1 cfmt))))))))
-
- (sort rtn (lambda (a b) (string< (upcase a) (upcase b))))))
+When COLUMNS in non-nil, also include property names given in
+COLUMN formats in the current buffer.
+
+When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be
+automatically performed, such drawers will be silently ignored."
+ (let ((case-fold-search t)
+ (props (append
+ (and specials org-special-properties)
+ (and defaults (cons org-effort-property org-default-properties))
+ nil)))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (while (re-search-forward org-property-start-re nil t)
+ (let ((range (org-get-property-block)))
+ (catch 'skip
+ (unless range
+ (when (and (not ignore-malformed)
+ (not (org-before-first-heading-p))
+ (y-or-n-p (format "Malformed drawer at %d, repair?"
+ (line-beginning-position))))
+ (org-get-property-block nil t))
+ (throw 'skip nil))
+ (goto-char (car range))
+ (let ((begin (car range))
+ (end (cdr range)))
+ ;; Make sure that found property block is not located
+ ;; before current point, as it would generate an infloop.
+ ;; It can happen, for example, in the following
+ ;; situation:
+ ;;
+ ;; * Headline
+ ;; :PROPERTIES:
+ ;; ...
+ ;; :END:
+ ;; *************** Inlinetask
+ ;; #+BEGIN_EXAMPLE
+ ;; :PROPERTIES:
+ ;; #+END_EXAMPLE
+ ;;
+ (if (< begin (point)) (throw 'skip nil) (goto-char begin))
+ (while (< (point) end)
+ (let ((p (progn (looking-at org-property-re)
+ (match-string-no-properties 2))))
+ ;; Only add true property name, not extension symbol.
+ (push (if (not (string-match-p "\\+\\'" p)) p
+ (substring p 0 -1))
+ props))
+ (forward-line))))
+ (outline-next-heading)))
+ (when columns
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t)
+ (let ((element (org-element-at-point)))
+ (when (memq (org-element-type element) '(keyword node-property))
+ (let ((value (org-element-property :value element))
+ (start 0))
+ (while (string-match "%[0-9]*\\([[:alnum:]_-]+\\)\\(([^)]+)\\)?\
+\\(?:{[^}]+}\\)?"
+ value start)
+ (setq start (match-end 0))
+ (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))))))
(defun org-property-values (key)
- "Return a list of all values of property KEY in the current buffer."
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((re (org-re-property key))
- values)
- (while (re-search-forward re nil t)
- (add-to-list 'values (org-trim (match-string 3))))
- (delete "" values)))))
+ "List all non-nil values of property KEY in current buffer."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (re (org-re-property key))
+ values)
+ (while (re-search-forward re nil t)
+ (push (org-entry-get (point) key) values))
+ (delete-dups values))))
(defun org-insert-property-drawer ()
"Insert a property drawer into the current entry."
- (org-back-to-heading t)
- (looking-at org-outline-regexp)
- (let ((indent (if org-adapt-indentation
- (- (match-end 0) (match-beginning 0))
- 0))
- (beg (point))
- (re (concat "^[ \t]*" org-keyword-time-regexp))
- end hiddenp)
- (outline-next-heading)
- (setq end (point))
- (goto-char beg)
- (while (re-search-forward re end t))
- (setq hiddenp (outline-invisible-p))
- (end-of-line 1)
- (and (equal (char-after) ?\n) (forward-char 1))
- (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)")
- (if (member (match-string 1) '("CLOCK:" ":END:"))
- ;; just skip this line
- (beginning-of-line 2)
- ;; Drawer start, find the end
- (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t)
- (beginning-of-line 1)))
- (org-skip-over-state-notes)
- (skip-chars-backward " \t\n\r")
- (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n)))
- (forward-char 1))
- (goto-char (point-at-eol))
- (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
- (beginning-of-line 0)
- (org-indent-to-column indent)
- (beginning-of-line 2)
- (org-indent-to-column indent)
- (beginning-of-line 0)
- (if hiddenp
- (save-excursion
- (org-back-to-heading t)
- (hide-entry))
- (org-flag-drawer t))))
+ (org-with-wide-buffer
+ (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))
+ (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)))
+ (inhibit-read-only t))
+ (insert "\n:PROPERTIES:\n:END:")
+ (when (eobp) (insert "\n"))
+ (org-indent-region begin (point))))))
(defun org-insert-drawer (&optional arg drawer)
"Insert a drawer at point.
+When optional argument ARG is non-nil, insert a property drawer.
+
Optional argument DRAWER, when non-nil, is a string representing
drawer's name. Otherwise, the user is prompted for a name.
@@ -15731,23 +16145,14 @@ instead.
Point is left between drawer's boundaries."
(interactive "P")
- (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer
- "LOGBOOK"))
- ;; SYSTEM-DRAWERS is a list of drawer names that are used
- ;; internally by Org. They are meant to be inserted
- ;; automatically.
- (system-drawers `("CLOCK" ,logbook "PROPERTIES"))
- ;; Remove system drawers from list. Note: For some reason,
- ;; `org-completing-read' ignores the predicate while
- ;; `completing-read' handles it fine.
- (drawer (if arg "PROPERTIES"
- (or drawer
- (completing-read
- "Drawer: " org-drawers
- (lambda (d) (not (member d system-drawers))))))))
+ (let* ((drawer (if arg "PROPERTIES"
+ (or drawer (read-from-minibuffer "Drawer: ")))))
(cond
;; With C-u, fall back on `org-insert-property-drawer'
(arg (org-insert-property-drawer))
+ ;; Check validity of suggested drawer's name.
+ ((not (string-match-p org-drawer-regexp (format ":%s:" drawer)))
+ (user-error "Invalid drawer name"))
;; With an active region, insert a drawer at point.
((not (org-region-active-p))
(progn
@@ -15813,38 +16218,25 @@ This is computed according to `org-property-set-functions-alist'."
(funcall set-function prompt allowed nil
(not (get-text-property 0 'org-unrestricted
(caar allowed))))
- (let (org-completion-use-ido org-completion-use-iswitchb)
- (funcall set-function prompt
- (mapcar 'list (org-property-values property))
- nil nil "" nil cur)))))
+ (funcall set-function prompt
+ (mapcar 'list (org-property-values property))
+ nil nil "" nil cur))))
(org-trim val)))
(defvar org-last-set-property nil)
(defvar org-last-set-property-value nil)
(defun org-read-property-name ()
"Read a property name."
- (let* ((completion-ignore-case t)
- (keys (org-buffer-property-keys nil t t))
- (default-prop (or (save-excursion
- (save-match-data
- (beginning-of-line)
- (and (looking-at "^\\s-*:\\([^:\n]+\\):")
- (null (string= (match-string 1) "END"))
- (match-string 1))))
- org-last-set-property))
- (property (org-icompleting-read
- (concat "Property"
- (if default-prop (concat " [" default-prop "]") "")
- ": ")
- (mapcar 'list keys)
- nil nil nil nil
- default-prop)))
- (if (member property keys)
- property
- (or (cdr (assoc (downcase property)
- (mapcar (lambda (x) (cons (downcase x) x))
- keys)))
- property))))
+ (let ((completion-ignore-case t)
+ (default-prop (or (and (org-at-property-p)
+ (match-string-no-properties 2))
+ org-last-set-property)))
+ (org-completing-read
+ (concat "Property"
+ (if default-prop (concat " [" default-prop "]") "")
+ ": ")
+ (mapcar #'list (org-buffer-property-keys nil t t))
+ nil nil nil nil default-prop)))
(defun org-set-property-and-value (use-last)
"Allow to set [PROPERTY]: [value] direction from prompt.
@@ -15865,26 +16257,52 @@ When use-default, don't even ask, just use the last
(defun org-set-property (property value)
"In the current entry, set PROPERTY to VALUE.
+
When called interactively, this will prompt for a property name, offering
completion on existing and default properties. And then it will prompt
for a value, offering completion either on allowed values (via an inherited
xxx_ALL property) or on existing values in other instances of this property
-in the current file."
+in the current file.
+
+Throw an error when trying to set a property with an invalid name."
(interactive (list nil nil))
- (let* ((property (or property (org-read-property-name)))
- (value (or value (org-read-property-value property)))
- (fn (cdr (assoc property org-properties-postprocess-alist))))
- (setq org-last-set-property property)
- (setq org-last-set-property-value (concat property ": " value))
- ;; Possibly postprocess the inserted value:
- (when fn (setq value (funcall fn value)))
- (unless (equal (org-entry-get nil property) value)
- (org-entry-put nil property value))))
-
-(defun org-delete-property (property &optional delete-empty-drawer)
- "In the current entry, delete PROPERTY.
-When optional argument DELETE-EMPTY-DRAWER is a string, it defines
-an empty drawer to delete."
+ (let ((property (or property (org-read-property-name))))
+ ;; `org-entry-put' also makes the following check, but this one
+ ;; avoids polluting `org-last-set-property' and
+ ;; `org-last-set-property-value' needlessly.
+ (unless (org--valid-property-p property)
+ (user-error "Invalid property name: \"%s\"" property))
+ (let ((value (or value (org-read-property-value property)))
+ (fn (cdr (assoc-string property org-properties-postprocess-alist t))))
+ (setq org-last-set-property property)
+ (setq org-last-set-property-value (concat property ": " value))
+ ;; Possibly postprocess the inserted value:
+ (when fn (setq value (funcall fn value)))
+ (unless (equal (org-entry-get nil property) value)
+ (org-entry-put nil property value)))))
+
+(defun org-find-property (property &optional value)
+ "Find first entry in buffer that sets PROPERTY.
+
+When optional argument VALUE is non-nil, only consider an entry
+if it contains PROPERTY set to this value. If PROPERTY should be
+explicitly set to nil, use string \"nil\" for VALUE.
+
+Return position where the entry begins, or nil if there is no
+such entry. If narrowing is in effect, only search the visible
+part of the buffer."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (re (org-re-property property nil (not value) value)))
+ (catch 'exit
+ (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)))))))))
+
+(defun org-delete-property (property)
+ "In the current entry, delete PROPERTY."
(interactive
(let* ((completion-ignore-case t)
(cat (org-entry-get (point) "CATEGORY"))
@@ -15892,33 +16310,30 @@ an empty drawer to delete."
(props (if cat props0
(delete `("CATEGORY" . ,(org-get-category)) props0)))
(prop (if (< 1 (length props))
- (org-icompleting-read "Property: " props nil t)
+ (completing-read "Property: " props nil t)
(caar props))))
(list prop)))
(if (not property)
(message "No property to delete in this entry")
- (org-entry-delete nil property delete-empty-drawer)
+ (org-entry-delete nil property)
(message "Property \"%s\" deleted" property)))
(defun org-delete-property-globally (property)
- "Remove PROPERTY globally, from all entries."
+ "Remove PROPERTY globally, from all entries.
+This function ignores narrowing, if any."
(interactive
(let* ((completion-ignore-case t)
- (prop (org-icompleting-read
+ (prop (completing-read
"Globally remove property: "
- (mapcar 'list (org-buffer-property-keys)))))
+ (mapcar #'list (org-buffer-property-keys)))))
(list prop)))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let ((cnt 0))
- (while (re-search-forward
- (org-re-property property)
- nil t)
- (setq cnt (1+ cnt))
- (delete-region (match-beginning 0) (1+ (point-at-eol))))
- (message "Property \"%s\" removed from %d entries" property cnt)))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let ((count 0)
+ (re (org-re-property (concat (regexp-quote property) "\\+?") t t)))
+ (while (re-search-forward re nil t)
+ (when (org-entry-delete (point) property) (cl-incf count)))
+ (message "Property \"%s\" removed from %d entries" property count))))
(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el
@@ -15929,9 +16344,9 @@ then applies it to the property in the column format's scope."
(interactive)
(unless (org-at-property-p)
(user-error "Not at a property"))
- (let ((prop (org-match-string-no-properties 2)))
+ (let ((prop (match-string-no-properties 2)))
(org-columns-get-format-and-top-level)
- (unless (nth 3 (assoc prop org-columns-current-fmt-compiled))
+ (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t))
(user-error "No operator defined for property %s" prop))
(org-columns-compute prop)))
@@ -15958,6 +16373,7 @@ completion."
(while (>= n org-highest-priority)
(push (char-to-string n) vals)
(setq n (1- n)))))
+ ((equal property "CATEGORY"))
((member property org-special-properties))
((setq vals (run-hook-with-args-until-success
'org-property-allowed-value-functions property)))
@@ -15976,7 +16392,7 @@ completion."
(org-add-props (car vals) '(org-unrestricted t)))
(if table (mapcar 'list vals) vals)))
-(defun org-property-previous-allowed-value (&optional previous)
+(defun org-property-previous-allowed-value (&optional _previous)
"Switch to the next allowed value for this property."
(interactive)
(org-property-next-allowed-value t))
@@ -15996,21 +16412,22 @@ completion."
nval)
(unless allowed
(user-error "Allowed values for this property have not been defined"))
- (if previous (setq allowed (reverse allowed)))
- (if (member value allowed)
- (setq nval (car (cdr (member value allowed)))))
+ (when previous (setq allowed (reverse allowed)))
+ (when (member value allowed)
+ (setq nval (car (cdr (member value allowed)))))
(setq nval (or nval (car allowed)))
- (if (equal nval value)
- (user-error "Only one allowed value for this property"))
+ (when (equal nval value)
+ (user-error "Only one allowed value for this property"))
(org-at-property-p)
(replace-match (concat " :" key ": " nval) t t)
(org-indent-line)
(beginning-of-line 1)
(skip-chars-forward " \t")
(when (equal prop org-effort-property)
- (save-excursion
- (org-back-to-heading t)
- (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval))
+ (org-refresh-property
+ '((effort . identity)
+ (effort-minutes . org-duration-to-minutes))
+ nval)
(when (string= org-clock-current-task heading)
(setq org-clock-effort nval)
(org-clock-update-mode-line)))
@@ -16035,31 +16452,30 @@ only headings."
(level 1)
(lmin 1)
(lmax 1)
- limit re end found pos heading cnt flevel)
+ end found flevel)
(unless buffer (error "File not found :%s" file))
(with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (setq limit (point-max))
- (goto-char (point-min))
- (dolist (heading path)
- (setq re (format org-complex-heading-regexp-format
- (regexp-quote heading)))
- (setq cnt 0 pos (point))
- (while (re-search-forward re end t)
- (setq level (- (match-end 1) (match-beginning 1)))
- (if (and (>= level lmin) (<= level lmax))
- (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
- (when (= cnt 0) (error "Heading not found on level %d: %s"
- lmax heading))
- (when (> cnt 1) (error "Heading not unique on level %d: %s"
- lmax heading))
- (goto-char found)
- (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
- (setq end (save-excursion (org-end-of-subtree t t))))
- (when (org-at-heading-p)
- (point-marker)))))))
+ (unless (derived-mode-p 'org-mode)
+ (error "Buffer %s needs to be in Org mode" buffer))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (dolist (heading path)
+ (let ((re (format org-complex-heading-regexp-format
+ (regexp-quote heading)))
+ (cnt 0))
+ (while (re-search-forward re end t)
+ (setq level (- (match-end 1) (match-beginning 1)))
+ (when (and (>= level lmin) (<= level lmax))
+ (setq found (match-beginning 0) flevel level cnt (1+ cnt))))
+ (when (= cnt 0)
+ (error "Heading not found on level %d: %s" lmax heading))
+ (when (> cnt 1)
+ (error "Heading not unique on level %d: %s" lmax heading))
+ (goto-char found)
+ (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0)))
+ (setq end (save-excursion (org-end-of-subtree t t)))))
+ (when (org-at-heading-p)
+ (point-marker))))))
(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only)
"Find node HEADING in BUFFER.
@@ -16069,24 +16485,22 @@ If POS-ONLY is set, return just the position instead of a marker.
The heading text must match exact, but it may have a TODO keyword,
a priority cookie and tags in the standard locations."
(with-current-buffer (or buffer (current-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (let (case-fold-search)
- (if (re-search-forward
- (format org-complex-heading-regexp-format
- (regexp-quote heading)) nil t)
- (if pos-only
- (match-beginning 0)
- (move-marker (make-marker) (match-beginning 0)))))))))
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let (case-fold-search)
+ (when (re-search-forward
+ (format org-complex-heading-regexp-format
+ (regexp-quote heading)) nil t)
+ (if pos-only
+ (match-beginning 0)
+ (move-marker (make-marker) (match-beginning 0))))))))
(defun org-find-exact-heading-in-directory (heading &optional dir)
"Find Org node headline HEADING in all .org files in directory DIR.
When the target headline is found, return a marker to this location."
(let ((files (directory-files (or dir default-directory)
- nil "\\`[^.#].*\\.org\\'"))
- file visiting m buffer)
+ t "\\`[^.#].*\\.org\\'"))
+ visiting m buffer)
(catch 'found
(dolist (file files)
(message "trying %s" file)
@@ -16105,40 +16519,29 @@ Return the position where this entry starts, or nil if there is no such entry."
(interactive "sID: ")
(let ((id (cond
((stringp ident) ident)
- ((symbol-name ident) (symbol-name ident))
+ ((symbolp ident) (symbol-name ident))
((numberp ident) (number-to-string ident))
- (t (error "IDENT %s must be a string, symbol or number" ident))))
- (case-fold-search nil))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$")
- nil t)
- (org-back-to-heading t)
- (point))))))
+ (t (error "IDENT %s must be a string, symbol or number" ident)))))
+ (org-with-wide-buffer (org-find-property "ID" id))))
;;;; Timestamps
(defvar org-last-changed-timestamp nil)
(defvar org-last-inserted-timestamp nil
"The last time stamp inserted with `org-insert-time-stamp'.")
-(defvar org-ts-what) ; dynamically scoped parameter
(defun org-time-stamp (arg &optional inactive)
"Prompt for a date/time and insert a time stamp.
+
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 be included.
+the date and the time. Otherwise, only the date is included.
-All parts of a date not specified by the user is filled in from
-the current date/time. So if you just press return without
-typing anything, the time stamp will represent the current
-date/time.
+All parts of a date not specified by the user are filled in from
+the timestamp at point, if any, or the current date/time
+otherwise.
-If there is already a timestamp at the cursor, it will be
-modified.
+If there is already a timestamp at the cursor, it is replaced.
With two universal prefix arguments, insert an active timestamp
with the current time without prompting the user.
@@ -16146,57 +16549,56 @@ with the current time without prompting the user.
When called from lisp, the timestamp is inactive if INACTIVE is
non-nil."
(interactive "P")
- (let* ((ts nil)
- (default-time
- ;; Default time is either today, or, when entering a range,
- ;; the range start.
- (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0)))
- (save-excursion
- (re-search-backward
- (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses
- (- (point) 20) t)))
- (apply 'encode-time (org-parse-time-string (match-string 1)))
- (current-time)))
- (default-input (and ts (org-get-compact-tod ts)))
- (repeater (save-excursion
- (save-match-data
- (beginning-of-line)
- (when (re-search-forward
- "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
- (save-excursion (progn (end-of-line) (point))) t)
- (match-string 0)))))
- org-time-was-given org-end-time-was-given time)
+ (let* ((ts (cond
+ ((org-at-date-range-p t)
+ (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2)))
+ ((org-at-timestamp-p 'lax) (match-string 0))))
+ ;; Default time is either the timestamp at point or today.
+ ;; When entering a range, only the range start is considered.
+ (default-time (if (not ts) (current-time)
+ (apply #'encode-time (org-parse-time-string ts))))
+ (default-input (and ts (org-get-compact-tod ts)))
+ (repeater (and ts
+ (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts)
+ (match-string 0 ts)))
+ org-time-was-given
+ org-end-time-was-given
+ (time
+ (and (if (equal arg '(16)) (current-time)
+ ;; Preserve `this-command' and `last-command'.
+ (let ((this-command this-command)
+ (last-command last-command))
+ (org-read-date
+ arg 'totime nil nil default-time default-input
+ inactive))))))
(cond
- ((and (org-at-timestamp-p t)
- (memq last-command '(org-time-stamp org-time-stamp-inactive))
- (memq this-command '(org-time-stamp org-time-stamp-inactive)))
+ ((and ts
+ (memq last-command '(org-time-stamp org-time-stamp-inactive))
+ (memq this-command '(org-time-stamp org-time-stamp-inactive)))
(insert "--")
- (setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil
- default-time default-input inactive)))
(org-insert-time-stamp time (or org-time-was-given arg) inactive))
- ((org-at-timestamp-p t)
- (setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil default-time default-input inactive)))
- (when (org-at-timestamp-p t) ; just to get the match data
- ; (setq inactive (eq (char-after (match-beginning 0)) ?\[))
- (replace-match "")
+ (ts
+ ;; Make sure we're on a timestamp. When in the middle of a date
+ ;; range, move arbitrarily to range end.
+ (unless (org-at-timestamp-p 'lax)
+ (skip-chars-forward "-")
+ (org-at-timestamp-p 'lax))
+ (replace-match "")
+ (setq org-last-changed-timestamp
+ (org-insert-time-stamp
+ time (or org-time-was-given arg)
+ inactive nil nil (list org-end-time-was-given)))
+ (when repeater
+ (backward-char)
+ (insert " " repeater)
(setq org-last-changed-timestamp
- (org-insert-time-stamp
- time (or org-time-was-given arg)
- inactive nil nil (list org-end-time-was-given)))
- (when repeater (goto-char (1- (point))) (insert " " repeater)
- (setq org-last-changed-timestamp
- (concat (substring org-last-inserted-timestamp 0 -1)
- " " repeater ">"))))
+ (concat (substring org-last-inserted-timestamp 0 -1)
+ " " repeater ">")))
(message "Timestamp updated"))
- ((equal arg '(16))
- (org-insert-time-stamp (current-time) t inactive))
- (t
- (setq time (let ((this-command this-command))
- (org-read-date arg 'totime nil nil default-time default-input inactive)))
- (org-insert-time-stamp time (or org-time-was-given arg) inactive
- nil nil (list org-end-time-was-given))))))
+ ((equal arg '(16)) (org-insert-time-stamp time t inactive))
+ (t (org-insert-time-stamp
+ time (or org-time-was-given arg) inactive nil nil
+ (list org-end-time-was-given))))))
;; FIXME: can we use this for something else, like computing time differences?
(defun org-get-compact-tod (s)
@@ -16211,7 +16613,7 @@ non-nil."
(if (not t2)
t1
(setq dh (- h2 h1) dm (- m2 m1))
- (if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
+ (when (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
(concat t1 "+" (number-to-string dh)
(and (/= 0 dm) (format ":%02d" dm)))))))
@@ -16226,7 +16628,7 @@ So these are more for recording a certain time/date."
(defvar org-date-ovl (make-overlay 1 1))
(overlay-put org-date-ovl 'face 'org-date-selected)
-(org-detach-overlay org-date-ovl)
+(delete-overlay org-date-ovl)
(defvar org-ans1) ; dynamically scoped parameter
(defvar org-ans2) ; dynamically scoped parameter
@@ -16243,13 +16645,14 @@ So these are more for recording a certain time/date."
(defvar org-read-date-inactive)
(defvar org-read-date-minibuffer-local-map
- (let* ((org-replace-disputed-keys nil)
- (map (make-sparse-keymap)))
+ (let* ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(org-defkey map (kbd ".")
(lambda () (interactive)
;; Are we at the beginning of the prompt?
- (if (looking-back "^[^:]+: ")
+ (if (looking-back "^[^:]+: "
+ (let ((inhibit-field-text-motion t))
+ (line-beginning-position)))
(org-eval-in-calendar '(calendar-goto-today))
(insert "."))))
(org-defkey map (kbd "C-.")
@@ -16316,7 +16719,8 @@ So these are more for recording a certain time/date."
(defvar org-defdecode)
(defvar org-with-time)
-(defun org-read-date (&optional org-with-time to-time from-string prompt
+(defvar calendar-setup) ; Dynamically scoped.
+(defun org-read-date (&optional with-time to-time from-string prompt
default-time default-input inactive)
"Read a date, possibly a time, and make things smooth for the user.
The prompt will suggest to enter an ISO date, but you can also enter anything
@@ -16360,8 +16764,8 @@ If you don't like the calendar, turn it off with
With optional argument TO-TIME, the date will immediately be converted
to an internal time.
-With an optional argument ORG-WITH-TIME, the prompt will suggest to
-also insert a time. Note that when ORG-WITH-TIME is not set, you can
+With an optional argument WITH-TIME, the prompt will suggest to
+also insert a time. Note that when WITH-TIME is not set, you can
still enter a time, and this function will inform the calling routine
about this change. The calling routine may then choose to change the
format used to insert the time stamp into the buffer to include the time.
@@ -16370,75 +16774,90 @@ the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is
the time/date that is used for everything that is not specified by the
user."
(require 'parse-time)
- (let* ((org-time-stamp-rounding-minutes
- (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes))
+ (let* ((org-with-time with-time)
+ (org-time-stamp-rounding-minutes
+ (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))
- (dummy (progn
- (when (< (nth 2 org-defdecode) org-extend-today-until)
- (setcar (nthcdr 2 org-defdecode) -1)
- (setcar (nthcdr 1 org-defdecode) 59)
- (setq org-def (apply 'encode-time org-defdecode)
- org-defdecode (decode-time org-def)))))
- (mouse-autoselect-window nil) ; Don't let the mouse jump
- (calendar-frame-setup nil)
- (calendar-setup nil)
+ (cur-frame (selected-frame))
+ (mouse-autoselect-window nil) ; Don't let the mouse jump
+ (calendar-setup
+ (and (eq calendar-setup 'calendar-only) 'calendar-only))
(calendar-move-hook nil)
(calendar-view-diary-initially-flag nil)
(calendar-view-holidays-initially-flag nil)
- (timestr (format-time-string
- (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def))
- (prompt (concat (if prompt (concat prompt " ") "")
- (format "Date+time [%s]: " timestr)))
- ans (org-ans0 "") org-ans1 org-ans2 final)
-
- (cond
- (from-string (setq ans from-string))
- (org-read-date-popup-calendar
- (save-excursion
- (save-window-excursion
- (calendar)
- (org-eval-in-calendar '(setq cursor-type nil) t)
- (unwind-protect
- (progn
- (calendar-forward-day (- (time-to-days org-def)
- (calendar-absolute-from-gregorian
- (calendar-current-date))))
- (org-eval-in-calendar nil t)
- (let* ((old-map (current-local-map))
- (map (copy-keymap calendar-mode-map))
- (minibuffer-local-map
- (copy-keymap org-read-date-minibuffer-local-map)))
- (org-defkey map (kbd "RET") 'org-calendar-select)
- (org-defkey map [mouse-1] 'org-calendar-select-mouse)
- (org-defkey map [mouse-2] 'org-calendar-select-mouse)
- (unwind-protect
- (progn
- (use-local-map map)
- (setq org-read-date-inactive inactive)
- (add-hook 'post-command-hook 'org-read-date-display)
- (setq org-ans0 (read-string prompt default-input
- 'org-read-date-history nil))
- ;; org-ans0: from prompt
- ;; org-ans1: from mouse click
- ;; org-ans2: from calendar motion
- (setq ans (concat org-ans0 " " (or org-ans1 org-ans2))))
- (remove-hook 'post-command-hook 'org-read-date-display)
- (use-local-map old-map)
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil)))))
- (bury-buffer "*Calendar*")))))
-
- (t ; Naked prompt only
- (unwind-protect
- (setq ans (read-string prompt default-input
- 'org-read-date-history timestr))
- (when org-read-date-overlay
- (delete-overlay org-read-date-overlay)
- (setq org-read-date-overlay nil)))))
+ ans (org-ans0 "") org-ans1 org-ans2 final cal-frame)
+ ;; Rationalize `org-def' and `org-defdecode', if required.
+ (when (< (nth 2 org-defdecode) org-extend-today-until)
+ (setf (nth 2 org-defdecode) -1)
+ (setf (nth 1 org-defdecode) 59)
+ (setq org-def (apply #'encode-time org-defdecode))
+ (setq org-defdecode (decode-time org-def)))
+ (let* ((timestr (format-time-string
+ (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d")
+ org-def))
+ (prompt (concat (if prompt (concat prompt " ") "")
+ (format "Date+time [%s]: " timestr))))
+ (cond
+ (from-string (setq ans from-string))
+ (org-read-date-popup-calendar
+ (save-excursion
+ (save-window-excursion
+ (calendar)
+ (when (eq calendar-setup 'calendar-only)
+ (setq cal-frame
+ (window-frame (get-buffer-window "*Calendar*" 'visible)))
+ (select-frame cal-frame))
+ (org-eval-in-calendar '(setq cursor-type nil) t)
+ (unwind-protect
+ (progn
+ (calendar-forward-day (- (time-to-days org-def)
+ (calendar-absolute-from-gregorian
+ (calendar-current-date))))
+ (org-eval-in-calendar nil t)
+ (let* ((old-map (current-local-map))
+ (map (copy-keymap calendar-mode-map))
+ (minibuffer-local-map
+ (copy-keymap org-read-date-minibuffer-local-map)))
+ (org-defkey map (kbd "RET") 'org-calendar-select)
+ (org-defkey map [mouse-1] 'org-calendar-select-mouse)
+ (org-defkey map [mouse-2] 'org-calendar-select-mouse)
+ (unwind-protect
+ (progn
+ (use-local-map map)
+ (setq org-read-date-inactive inactive)
+ (add-hook 'post-command-hook 'org-read-date-display)
+ (setq org-ans0
+ (read-string prompt
+ default-input
+ 'org-read-date-history
+ nil))
+ ;; org-ans0: from prompt
+ ;; org-ans1: from mouse click
+ ;; org-ans2: from calendar motion
+ (setq ans
+ (concat org-ans0 " " (or org-ans1 org-ans2))))
+ (remove-hook 'post-command-hook 'org-read-date-display)
+ (use-local-map old-map)
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil)))))
+ (bury-buffer "*Calendar*")
+ (when cal-frame
+ (delete-frame cal-frame)
+ (select-frame-set-input-focus cur-frame))))))
+
+ (t ; Naked prompt only
+ (unwind-protect
+ (setq ans (read-string prompt default-input
+ 'org-read-date-history timestr))
+ (when org-read-date-overlay
+ (delete-overlay org-read-date-overlay)
+ (setq org-read-date-overlay nil))))))
(setq final (org-read-date-analyze ans org-def org-defdecode))
@@ -16499,13 +16918,18 @@ user."
(make-overlay (1- (point-at-eol)) (point-at-eol)))
(org-overlay-display org-read-date-overlay txt 'secondary-selection)))))
-(defun org-read-date-analyze (ans org-def org-defdecode)
+(defun org-read-date-analyze (ans def defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
- (let ((nowdecode (decode-time))
+ ;; Pass `current-time' result to `decode-time' (instead of calling
+ ;; without arguments) so that only `current-time' has to be
+ ;; overridden in tests.
+ (let ((org-def def)
+ (org-defdecode defdecode)
+ (nowdecode (decode-time (current-time)))
delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
- iso-year iso-weekday iso-week iso-year iso-date futurep kill-year)
+ iso-year iso-weekday iso-week iso-date futurep kill-year)
(setq org-read-date-analyze-futurep nil
org-read-date-analyze-forced-year nil)
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
@@ -16521,11 +16945,11 @@ user."
;; info and postpone interpreting it until the rest of the parsing
;; is done.
(when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
- (setq iso-year (if (match-end 1)
- (org-small-year-to-year
- (string-to-number (match-string 1 ans))))
- iso-weekday (if (match-end 3)
- (string-to-number (match-string 3 ans)))
+ (setq iso-year (when (match-end 1)
+ (org-small-year-to-year
+ (string-to-number (match-string 1 ans))))
+ iso-weekday (when (match-end 3)
+ (string-to-number (match-string 3 ans)))
iso-week (string-to-number (match-string 2 ans)))
(setq ans (replace-match "" t t ans)))
@@ -16538,7 +16962,7 @@ user."
(string-to-number (format-time-string "%Y"))))
month (string-to-number (match-string 3 ans))
day (string-to-number (match-string 4 ans)))
- (if (< year 100) (setq year (+ 2000 year)))
+ (setq year (org-small-year-to-year year))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
@@ -16562,26 +16986,26 @@ user."
(string-to-number (format-time-string "%Y"))))
month (string-to-number (match-string 1 ans))
day (string-to-number (match-string 2 ans)))
- (if (< year 100) (setq year (+ 2000 year)))
+ (setq year (org-small-year-to-year year))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
;; Help matching am/pm times, because `parse-time-string' does not do that.
;; If there is a time with am/pm, and *no* time without it, we convert
;; so that matching will be successful.
- (loop for i from 1 to 2 do ; twice, for end time as well
- (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
- (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
- (setq hour (string-to-number (match-string 1 ans))
- minute (if (match-end 3)
- (string-to-number (match-string 3 ans))
- 0)
- pm (equal ?p
- (string-to-char (downcase (match-string 4 ans)))))
- (if (and (= hour 12) (not pm))
- (setq hour 0)
- (if (and pm (< hour 12)) (setq hour (+ 12 hour))))
- (setq ans (replace-match (format "%02d:%02d" hour minute)
- t t ans))))
+ (cl-loop for i from 1 to 2 do ; twice, for end time as well
+ (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
+ (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
+ (setq hour (string-to-number (match-string 1 ans))
+ minute (if (match-end 3)
+ (string-to-number (match-string 3 ans))
+ 0)
+ pm (equal ?p
+ (string-to-char (downcase (match-string 4 ans)))))
+ (if (and (= hour 12) (not pm))
+ (setq hour 0)
+ (when (and pm (< hour 12)) (setq hour (+ 12 hour))))
+ (setq ans (replace-match (format "%02d:%02d" hour minute)
+ t t ans))))
;; Check if a time range is given as a duration
(when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
@@ -16590,7 +17014,7 @@ user."
minute (string-to-number (match-string 2 ans))
m2 (+ minute (if (match-end 5) (string-to-number
(match-string 5 ans))0)))
- (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
+ (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
(setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
t t ans)))
@@ -16605,16 +17029,35 @@ user."
(setq tl (parse-time-string ans)
day (or (nth 3 tl) (nth 3 org-defdecode))
- month (or (nth 4 tl)
- (if (and org-read-date-prefer-future
- (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode)))
- (prog1 (1+ (nth 4 nowdecode)) (setq futurep t))
- (nth 4 org-defdecode)))
- year (or (and (not kill-year) (nth 5 tl))
- (if (and org-read-date-prefer-future
- (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode)))
- (prog1 (1+ (nth 5 nowdecode)) (setq futurep t))
- (nth 5 org-defdecode)))
+ month
+ (cond ((nth 4 tl))
+ ((not org-read-date-prefer-future) (nth 4 org-defdecode))
+ ;; Day was specified. Make sure DAY+MONTH
+ ;; combination happens in the future.
+ ((nth 3 tl)
+ (setq futurep t)
+ (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode))
+ (nth 4 nowdecode)))
+ (t (nth 4 org-defdecode)))
+ year
+ (cond ((and (not kill-year) (nth 5 tl)))
+ ((not org-read-date-prefer-future) (nth 5 org-defdecode))
+ ;; Month was guessed in the future and is at least
+ ;; equal to NOWDECODE's. Fix year accordingly.
+ (futurep
+ (if (or (> month (nth 4 nowdecode))
+ (>= day (nth 3 nowdecode)))
+ (nth 5 nowdecode)
+ (1+ (nth 5 nowdecode))))
+ ;; Month was specified. Make sure MONTH+YEAR
+ ;; combination happens in the future.
+ ((nth 4 tl)
+ (setq futurep t)
+ (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode))
+ ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode)))
+ ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode)))
+ (t (nth 5 nowdecode))))
+ (t (nth 5 org-defdecode)))
hour (or (nth 2 tl) (nth 2 org-defdecode))
minute (or (nth 1 tl) (nth 1 org-defdecode))
second (or (nth 0 tl) 0)
@@ -16643,7 +17086,7 @@ user."
day (or iso-weekday wday 1)
wday nil ; to make sure that the trigger below does not match
iso-date (calendar-gregorian-from-absolute
- (calendar-absolute-from-iso
+ (calendar-iso-to-absolute
(list iso-week day year))))
; FIXME: Should we also push ISO weeks into the future?
; (when (and org-read-date-prefer-future
@@ -16652,7 +17095,7 @@ user."
; (time-to-days (current-time))))
; (setq year (1+ year)
; iso-date (calendar-gregorian-from-absolute
- ; (calendar-absolute-from-iso
+ ; (calendar-iso-to-absolute
; (list iso-week day year)))))
(setq month (car iso-date)
year (nth 2 iso-date)
@@ -16660,7 +17103,10 @@ user."
(deltan
(setq futurep nil)
(unless deltadef
- (let ((now (decode-time)))
+ ;; Pass `current-time' result to `decode-time' (instead of
+ ;; calling without arguments) so that only `current-time' has
+ ;; to be overridden in tests.
+ (let ((now (decode-time (current-time))))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
(cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
((equal deltaw "w") (setq day (+ day (* 7 deltan))))
@@ -16672,17 +17118,17 @@ user."
(setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year))))
(unless (equal wday wday1)
(setq day (+ day (% (- wday wday1 -7) 7))))))
- (if (and (boundp 'org-time-was-given)
- (nth 2 tl))
- (setq org-time-was-given t))
- (if (< year 100) (setq year (+ 2000 year)))
+ (when (and (boundp 'org-time-was-given)
+ (nth 2 tl))
+ (setq org-time-was-given t))
+ (when (< year 100) (setq year (+ 2000 year)))
;; Check of the date is representable
(if org-read-date-force-compatible-dates
(progn
- (if (< year 1970)
- (setq year 1970 org-read-date-analyze-forced-year t))
- (if (> year 2037)
- (setq year 2037 org-read-date-analyze-forced-year t)))
+ (when (< year 1970)
+ (setq year 1970 org-read-date-analyze-forced-year t))
+ (when (> year 2037)
+ (setq year 2037 org-read-date-analyze-forced-year t)))
(condition-case nil
(ignore (encode-time second minute hour day month year))
(error
@@ -16722,12 +17168,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
(if wday1
(progn
(setq delta (mod (+ 7 (- wday1 wday)) 7))
- (if (= delta 0) (setq delta 7))
- (if (= dir ?-)
- (progn
- (setq delta (- delta 7))
- (if (= delta 0) (setq delta -7))))
- (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
+ (when (= delta 0) (setq delta 7))
+ (when (= dir ?-)
+ (setq delta (- delta 7))
+ (when (= delta 0) (setq delta -7)))
+ (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7)))))
(list delta "d" rel))
(list (* n (if (= dir ?-) -1 1)) what rel)))))
@@ -16736,23 +17181,14 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to
The internal representation needed by the calendar is (month day year).
This is a wrapper to handle the brain-dead convention in calendar that
user function argument order change dependent on argument order."
- (if (boundp 'calendar-date-style)
- (cond
- ((eq calendar-date-style 'american)
- (list arg1 arg2 arg3))
- ((eq calendar-date-style 'european)
- (list arg2 arg1 arg3))
- ((eq calendar-date-style 'iso)
- (list arg2 arg3 arg1)))
- (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1
- (if (org-bound-and-true-p european-calendar-style)
- (list arg2 arg1 arg3)
- (list arg1 arg2 arg3)))))
+ (pcase calendar-date-style
+ (`american (list arg1 arg2 arg3))
+ (`european (list arg2 arg1 arg3))
+ (`iso (list arg2 arg3 arg1))))
(defun org-eval-in-calendar (form &optional keepdate)
"Eval FORM in the calendar window and return to current window.
-When KEEPDATE is non-nil, update `org-ans2' from the cursor date,
-otherwise stick to the current value of `org-ans2'."
+Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date."
(let ((sf (selected-frame))
(sw (selected-window)))
(select-window (get-buffer-window "*Calendar*" t))
@@ -16763,7 +17199,7 @@ otherwise stick to the current value of `org-ans2'."
(setq org-ans2 (format-time-string "%Y-%m-%d" time))))
(move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer))
(select-window sw)
- (org-select-frame-set-input-focus sf)))
+ (select-frame-set-input-focus sf)))
(defun org-calendar-select ()
"Return to `org-read-date' with the date currently selected.
@@ -16773,10 +17209,11 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(let* ((date (calendar-cursor-to-date))
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
- (if (active-minibuffer-window) (exit-minibuffer))))
+ (when (active-minibuffer-window) (exit-minibuffer))))
(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra)
"Insert a date stamp for the date given by the internal TIME.
+See `format-time-string' for the format of TIME.
WITH-HM means use the stamp format that includes the time of the day.
INACTIVE means use square brackets instead of angular ones, so that the
stamp will not contribute to the agenda.
@@ -16785,7 +17222,7 @@ stamp.
The command returns the inserted time stamp."
(let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats))
stamp)
- (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
+ (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]")))
(insert-before-markers (or pre ""))
(when (listp extra)
(setq extra (car extra))
@@ -16808,14 +17245,12 @@ The command returns the inserted time stamp."
(unless org-display-custom-times
(let ((p (point-min)) (bmp (buffer-modified-p)))
(while (setq p (next-single-property-change p 'display))
- (if (and (get-text-property p 'display)
- (eq (get-text-property p 'face) 'org-date))
- (remove-text-properties
- p (setq p (next-single-property-change p 'display))
- '(display t))))
+ (when (and (get-text-property p 'display)
+ (eq (get-text-property p 'face) 'org-date))
+ (remove-text-properties
+ p (setq p (next-single-property-change p 'display))
+ '(display t))))
(set-buffer-modified-p bmp)))
- (if (featurep 'xemacs)
- (remove-text-properties (point-min) (point-max) '(end-glyph t)))
(org-restart-font-lock)
(setq org-table-may-need-update t)
(if org-display-custom-times
@@ -16825,56 +17260,20 @@ The command returns the inserted time stamp."
(defun org-display-custom-time (beg end)
"Overlay modified time stamp format over timestamp between BEG and END."
(let* ((ts (buffer-substring beg end))
- t1 w1 with-hm tf time str w2 (off 0))
+ t1 with-hm tf time str (off 0))
(save-match-data
(setq t1 (org-parse-time-string ts t))
- (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
- (setq off (- (match-end 0) (match-beginning 0)))))
+ (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts)
+ (setq off (- (match-end 0) (match-beginning 0)))))
(setq end (- end off))
- (setq w1 (- end beg)
- with-hm (and (nth 1 t1) (nth 2 t1))
+ (setq with-hm (and (nth 1 t1) (nth 2 t1))
tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats)
time (org-fix-decoded-time t1)
str (org-add-props
(format-time-string
(substring tf 1 -1) (apply 'encode-time time))
- nil 'mouse-face 'highlight)
- w2 (length str))
- (if (not (= w2 w1))
- (add-text-properties (1+ beg) (+ 2 beg)
- (list 'org-dwidth t 'org-dwidth-n (- w1 w2))))
- (if (featurep 'xemacs)
- (progn
- (put-text-property beg end 'invisible t)
- (put-text-property beg end 'end-glyph (make-glyph str)))
- (put-text-property beg end 'display str))))
-
-(defun org-translate-time (string)
- "Translate all timestamps in STRING to custom format.
-But do this only if the variable `org-display-custom-times' is set."
- (when org-display-custom-times
- (save-match-data
- (let* ((start 0)
- (re org-ts-regexp-both)
- t1 with-hm inactive tf time str beg end)
- (while (setq start (string-match re string start))
- (setq beg (match-beginning 0)
- end (match-end 0)
- t1 (save-match-data
- (org-parse-time-string (substring string beg end) t))
- with-hm (and (nth 1 t1) (nth 2 t1))
- inactive (equal (substring string beg (1+ beg)) "[")
- tf (funcall (if with-hm 'cdr 'car)
- org-time-stamp-custom-formats)
- time (org-fix-decoded-time t1)
- str (format-time-string
- (concat
- (if inactive "[" "<") (substring tf 1 -1)
- (if inactive "]" ">"))
- (apply 'encode-time time))
- string (replace-match str t t string)
- start (+ start (length str)))))))
- string)
+ nil 'mouse-face 'highlight))
+ (put-text-property beg end 'display str)))
(defun org-fix-decoded-time (time)
"Set 0 instead of nil for the first 6 elements of time.
@@ -16882,19 +17281,17 @@ Don't touch the rest."
(let ((n 0))
(mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time)))
-(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4")
-
(defun org-time-stamp-to-now (timestamp-string &optional seconds)
"Difference between TIMESTAMP-STRING and now in days.
If SECONDS is non-nil, return the difference in seconds."
- (let ((fdiff (if seconds 'float-time 'time-to-days)))
+ (let ((fdiff (if seconds #'float-time #'time-to-days)))
(- (funcall fdiff (org-time-string-to-time timestamp-string))
(funcall fdiff (current-time)))))
-(defun org-deadline-close (timestamp-string &optional ndays)
+(defun org-deadline-close-p (timestamp-string &optional ndays)
"Is the time in TIMESTAMP-STRING close to the current date?"
(setq ndays (or ndays (org-get-wdays timestamp-string)))
- (and (< (org-time-stamp-to-now timestamp-string) ndays)
+ (and (<= (org-time-stamp-to-now timestamp-string) ndays)
(not (org-entry-is-done-p))))
(defun org-get-wdays (ts &optional delay zero-delay)
@@ -16930,14 +17327,15 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer."
(let* ((date (calendar-cursor-to-date))
(time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date))))
(setq org-ans1 (format-time-string "%Y-%m-%d" time)))
- (if (active-minibuffer-window) (exit-minibuffer))))
+ (when (active-minibuffer-window) (exit-minibuffer))))
(defun org-check-deadlines (ndays)
"Check if there are any deadlines due or past due.
A deadline is considered due if it happens within `org-deadline-warning-days'
days from today's date. If the deadline appears in an entry marked DONE,
-it is not shown. The prefix arg NDAYS can be used to test that many
-days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown."
+it is not shown. A numeric prefix argument NDAYS can be used to test that
+many days. If the prefix is a raw `\\[universal-argument]', all deadlines \
+are shown."
(interactive "P")
(let* ((org-warn-days
(cond
@@ -16947,8 +17345,7 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s
(case-fold-search nil)
(regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
(callback
- (lambda () (org-deadline-close (match-string 1) org-warn-days))))
-
+ (lambda () (org-deadline-close-p (match-string 1) org-warn-days))))
(message "%d deadlines past-due or due within %d days"
(org-occur regexp nil callback)
org-warn-days)))
@@ -16966,39 +17363,61 @@ Allowed values for TYPE are:
When TYPE is nil, fall back on returning a regexp that matches
both scheduled and deadline timestamps."
- (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9>\r\n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)")
- ((eq type 'active) org-ts-regexp)
- ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]")
- ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>"))
- ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>"))
- ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]"))
- ((eq type 'scheduled-or-deadline)
- (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>"))))
-
-(defun org-check-before-date (date)
- "Check if there are deadlines or scheduled entries before DATE."
+ (cl-case type
+ (all org-ts-regexp-both)
+ (active org-ts-regexp)
+ (inactive org-ts-regexp-inactive)
+ (scheduled org-scheduled-time-regexp)
+ (deadline org-deadline-time-regexp)
+ (closed org-closed-time-regexp)
+ (otherwise
+ (concat "\\<"
+ (regexp-opt (list org-deadline-string org-scheduled-string))
+ " *<\\([^>]+\\)>"))))
+
+(defun org-check-before-date (d)
+ "Check if there are deadlines or scheduled entries before date D."
(interactive (list (org-read-date)))
- (let ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (callback
- (lambda () (time-less-p
- (org-time-string-to-time (match-string 1))
- (org-time-string-to-time date)))))
+ (let* ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (ts-type org-ts-type)
+ (callback
+ (lambda ()
+ (let ((match (match-string 1)))
+ (and (if (memq ts-type '(active inactive all))
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)
+ (org-at-planning-p))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time d)))))))
(message "%d entries before %s"
- (org-occur regexp nil callback) date)))
+ (org-occur regexp nil callback)
+ d)))
-(defun org-check-after-date (date)
- "Check if there are deadlines or scheduled entries after DATE."
+(defun org-check-after-date (d)
+ "Check if there are deadlines or scheduled entries after date D."
(interactive (list (org-read-date)))
- (let ((case-fold-search nil)
- (regexp (org-re-timestamp org-ts-type))
- (callback
- (lambda () (not
- (time-less-p
- (org-time-string-to-time (match-string 1))
- (org-time-string-to-time date))))))
+ (let* ((case-fold-search nil)
+ (regexp (org-re-timestamp org-ts-type))
+ (ts-type org-ts-type)
+ (callback
+ (lambda ()
+ (let ((match (match-string 1)))
+ (and (if (memq ts-type '(active inactive all))
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)
+ (org-at-planning-p))
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time d))))))))
(message "%d entries after %s"
- (org-occur regexp nil callback) date)))
+ (org-occur regexp nil callback)
+ d)))
(defun org-check-dates-range (start-date end-date)
"Check for deadlines/scheduled entries between START-DATE and END-DATE."
@@ -17007,15 +17426,22 @@ both scheduled and deadline timestamps."
(let ((case-fold-search nil)
(regexp (org-re-timestamp org-ts-type))
(callback
- (lambda ()
- (let ((match (match-string 1)))
- (and
- (not (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time start-date)))
- (time-less-p
- (org-time-string-to-time match)
- (org-time-string-to-time end-date)))))))
+ (let ((type org-ts-type))
+ (lambda ()
+ (let ((match (match-string 1)))
+ (and
+ (if (memq type '(active inactive all))
+ (eq (org-element-type (save-excursion
+ (backward-char)
+ (org-element-context)))
+ 'timestamp)
+ (org-at-planning-p))
+ (not (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time start-date)))
+ (time-less-p
+ (org-time-string-to-time match)
+ (org-time-string-to-time end-date))))))))
(message "%d entries between %s and %s"
(org-occur regexp nil callback) start-date end-date)))
@@ -17034,8 +17460,8 @@ days in order to avoid rounding problems."
(unless (org-at-date-range-p t)
(goto-char (point-at-bol))
(re-search-forward org-tr-regexp-both (point-at-eol) t))
- (if (not (org-at-date-range-p t))
- (user-error "Not at a time-stamp range, and none found in current line")))
+ (unless (org-at-date-range-p t)
+ (user-error "Not at a time-stamp range, and none found in current line")))
(let* ((ts1 (match-string 1))
(ts2 (match-string 2))
(havetime (or (> (length ts1) 15) (> (length ts2) 15)))
@@ -17073,65 +17499,75 @@ days in order to avoid rounding problems."
(setq align t)
(and (looking-at " *|") (goto-char (match-end 0))))
(goto-char match-end))
- (if (looking-at
- "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
- (replace-match ""))
- (if negative (insert " -"))
+ (when (looking-at
+ "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]")
+ (replace-match ""))
+ (when negative (insert " -"))
(if (> y 0) (insert " " (format (if havetime fy fy1) y d h m))
(if (> d 0) (insert " " (format (if havetime fd fd1) d h m))
(insert " " (format fh h m))))
- (if align (org-table-align))
+ (when align (org-table-align))
(message "Time difference inserted")))))
(defun org-make-tdiff-string (y d h m)
(let ((fmt "")
(l nil))
- (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")
- l (push y l)))
- (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")
- l (push d l)))
- (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")
- l (push h l)))
- (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")
- l (push m l)))
+ (when (> y 0)
+ (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " "))
+ (push y l))
+ (when (> d 0)
+ (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " "))
+ (push d l))
+ (when (> h 0)
+ (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " "))
+ (push h l))
+ (when (> m 0)
+ (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " "))
+ (push m l))
(apply 'format fmt (nreverse l))))
-(defun org-time-string-to-time (s &optional buffer pos)
- "Convert a timestamp string into internal time."
- (condition-case errdata
- (apply 'encode-time (org-parse-time-string s))
- (error (error "Bad timestamp `%s'%s\nError was: %s"
- s (if (not (and buffer pos))
- ""
- (format-message " at %d in buffer `%s'" pos buffer))
- (cdr errdata)))))
+(defun org-time-string-to-time (s)
+ "Convert timestamp string S into internal time."
+ (apply #'encode-time (org-parse-time-string s)))
(defun org-time-string-to-seconds (s)
- "Convert a timestamp string to a number of seconds."
+ "Convert a timestamp string S into a number of seconds."
(float-time (org-time-string-to-time s)))
-(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos)
- "Convert a time stamp to an absolute day number.
-If there is a specifier for a cyclic time stamp, get the closest
-date to DAYNR.
-PREFER and SHOW-ALL are passed through to `org-closest-date'.
-The variable `date' is bound by the calendar when this is called."
+(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp")
+
+(defun org-time-string-to-absolute (s &optional daynr prefer buffer pos)
+ "Convert time stamp S to an absolute day number.
+
+If DAYNR in non-nil, and there is a specifier for a cyclic time
+stamp, get the closest date to DAYNR. If PREFER is
+`past' (respectively `future') return a date past (respectively
+after) or equal to DAYNR.
+
+POS is the location of time stamp S, as a buffer position in
+BUFFER.
+
+Diary sexp timestamps are matched against DAYNR, when non-nil.
+If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is
+signaled."
(cond
- ((and daynr (string-match "\\`%%\\((.*)\\)" s))
- (if (org-diary-sexp-entry (match-string 1 s) "" date)
+ ((string-match "\\`%%\\((.*)\\)" s)
+ ;; Sexp timestamp: try to match DAYNR, if available, since we're
+ ;; only able to match individual dates. If it fails, raise an
+ ;; error.
+ (if (and daynr
+ (org-diary-sexp-entry
+ (match-string 1 s) "" (calendar-gregorian-from-absolute daynr)))
daynr
- (+ daynr 1000)))
- ((and daynr (string-match "\\+[0-9]+[hdwmy]" s))
- (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr
- (time-to-days (current-time))) (match-string 0 s)
- prefer show-all))
+ (signal 'org-diary-sexp-no-match (list s))))
+ (daynr (org-closest-date s daynr prefer))
(t (time-to-days
(condition-case errdata
- (apply 'encode-time (org-parse-time-string s))
+ (apply #'encode-time (org-parse-time-string s))
(error (error "Bad timestamp `%s'%s\nError was: %s"
- s (if (not (and buffer pos))
- ""
- (format-message " at %d in buffer `%s'" pos buffer))
+ s
+ (if (not (and buffer pos)) ""
+ (format-message " at %d in buffer `%s'" pos buffer))
(cdr errdata))))))))
(defun org-days-to-iso-week (days)
@@ -17141,43 +17577,46 @@ The variable `date' is bound by the calendar when this is called."
(defun org-small-year-to-year (year)
"Convert 2-digit years into 4-digit years.
-38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037.
-The year 2000 cannot be abbreviated. Any year larger than 99
-is returned unchanged."
- (if (< year 38)
- (setq year (+ 2000 year))
- (if (< year 100)
- (setq year (+ 1900 year))))
- year)
+YEAR is expanded into one of the 30 next years, if possible, or
+into a past one. Any year larger than 99 is returned unchanged."
+ (if (>= year 100) year
+ (let* ((current (string-to-number (format-time-string "%Y" (current-time))))
+ (century (/ current 100))
+ (offset (- year (% current 100))))
+ (cond ((> offset 30) (+ (* (1- century) 100) year))
+ ((> offset -70) (+ (* century 100) year))
+ (t (+ (* (1+ century) 100) year))))))
(defun org-time-from-absolute (d)
"Return the time corresponding to date D.
D may be an absolute day number, or a calendar-type list (month day year)."
- (if (numberp d) (setq d (calendar-gregorian-from-absolute d)))
+ (when (numberp d) (setq d (calendar-gregorian-from-absolute d)))
(encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d)))
+(defvar org-agenda-current-date)
(defun org-calendar-holiday ()
- "List of holidays, for Diary display in Org-mode."
+ "List of holidays, for Diary display in Org mode."
(require 'holidays)
- (let ((hl (funcall
- (if (fboundp 'calendar-check-holidays)
- 'calendar-check-holidays 'check-calendar-holidays) date)))
- (if hl (mapconcat 'identity hl "; "))))
+ (let ((hl (calendar-check-holidays org-agenda-current-date)))
+ (and hl (mapconcat #'identity hl "; "))))
-(defun org-diary-sexp-entry (sexp entry date)
- "Process a SEXP diary ENTRY for DATE."
+(defun org-diary-sexp-entry (sexp entry d)
+ "Process a SEXP diary ENTRY for date D."
(require 'diary-lib)
- (let ((result (if calendar-debug-sexp
- (let ((stack-trace-on-error t))
- (eval (car (read-from-string sexp))))
- (condition-case nil
- (eval (car (read-from-string sexp)))
- (error
- (beep)
- (message "Bad sexp at line %d in %s: %s"
- (org-current-line)
- (buffer-file-name) sexp)
- (sleep-for 2))))))
+ ;; `org-anniversary' and alike expect ENTRY and DATE to be bound
+ ;; dynamically.
+ (let* ((sexp `(let ((entry ,entry)
+ (date ',d))
+ ,(car (read-from-string sexp))))
+ (result (if calendar-debug-sexp (eval sexp)
+ (condition-case nil
+ (eval sexp)
+ (error
+ (beep)
+ (message "Bad sexp at line %d in %s: %s"
+ (org-current-line)
+ (buffer-file-name) sexp)
+ (sleep-for 2))))))
(cond ((stringp result) (split-string result "; "))
((and (consp result)
(not (consp (cdr result)))
@@ -17189,9 +17628,7 @@ D may be an absolute day number, or a calendar-type list (month day year)."
(defun org-diary-to-ical-string (frombuf)
"Get iCalendar entries from diary entries in buffer FROMBUF.
This uses the icalendar.el library."
- (let* ((tmpdir (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
+ (let* ((tmpdir temporary-file-directory)
(tmpfile (make-temp-name
(expand-file-name "orgics" tmpdir)))
buf rtn b e)
@@ -17200,125 +17637,142 @@ This uses the icalendar.el library."
(setq buf (find-buffer-visiting tmpfile))
(set-buffer buf)
(goto-char (point-min))
- (if (re-search-forward "^BEGIN:VEVENT" nil t)
- (setq b (match-beginning 0)))
+ (when (re-search-forward "^BEGIN:VEVENT" nil t)
+ (setq b (match-beginning 0)))
(goto-char (point-max))
- (if (re-search-backward "^END:VEVENT" nil t)
- (setq e (match-end 0)))
+ (when (re-search-backward "^END:VEVENT" nil t)
+ (setq e (match-end 0)))
(setq rtn (if (and b e) (concat (buffer-substring b e) "\n") "")))
(kill-buffer buf)
(delete-file tmpfile)
rtn))
-(defun org-closest-date (start current change prefer show-all)
- "Find the date closest to CURRENT that is consistent with START and CHANGE.
-When PREFER is `past', return a date that is either CURRENT or past.
-When PREFER is `future', return a date that is either CURRENT or future.
-When SHOW-ALL is nil, only return the current occurrence of a time stamp."
- ;; Make the proper lists from the dates
- (catch 'exit
- (let ((a1 '(("h" . hour)
- ("d" . day)
- ("w" . week)
- ("m" . month)
- ("y" . year)))
- (shour (nth 2 (org-parse-time-string start)))
- dn dw sday cday n1 n2 n0
- d m y y1 y2 date1 date2 nmonths nm ny m2)
-
- (setq start (org-date-to-gregorian start)
- current (org-date-to-gregorian
- (if show-all
- current
- (time-to-days (current-time))))
- sday (calendar-absolute-from-gregorian start)
- cday (calendar-absolute-from-gregorian current))
-
- (if (<= cday sday) (throw 'exit sday))
-
- (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change)
- (setq dn (string-to-number (match-string 1 change))
- dw (cdr (assoc (match-string 2 change) a1)))
- (user-error "Invalid change specifier: %s" change))
- (if (eq dw 'week) (setq dw 'day dn (* 7 dn)))
- (cond
- ((eq dw 'hour)
- (let ((missing-hours
- (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until)
- dn)))
- (setq n1 (if (zerop missing-hours) cday
- (- cday (1+ (floor (/ missing-hours 24)))))
- n2 (+ cday (floor (/ (- dn missing-hours) 24))))))
- ((eq dw 'day)
- (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn))))
- n2 (+ n1 dn)))
- ((eq dw 'year)
- (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current))
- (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1))
- (setq date1 (list m d y1)
- n1 (calendar-absolute-from-gregorian date1)
- date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn)))
- n2 (calendar-absolute-from-gregorian date2)))
- ((eq dw 'month)
- ;; approx number of month between the two dates
- (setq nmonths (floor (/ (- cday sday) 30.436875)))
- ;; How often does dn fit in there?
- (setq d (nth 1 start) m (car start) y (nth 2 start)
- nm (* dn (max 0 (1- (floor (/ nmonths dn)))))
- m (+ m nm)
- ny (floor (/ m 12))
- y (+ y ny)
- m (- m (* ny 12)))
- (while (> m 12) (setq m (- m 12) y (1+ y)))
- (setq n1 (calendar-absolute-from-gregorian (list m d y)))
- (setq m2 (+ m dn) y2 y)
- (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
- (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))
- (while (<= n2 cday)
- (setq n1 n2 m m2 y y2)
- (setq m2 (+ m dn) y2 y)
- (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12)))
- (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))))))
- ;; Make sure n1 is the earlier date
- (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2))
- (if show-all
- (cond
- ((eq prefer 'past) (if (= cday n2) n2 n1))
- ((eq prefer 'future) (if (= cday n1) n1 n2))
- (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))
- (cond
- ((eq prefer 'past) (if (= cday n2) n2 n1))
- ((eq prefer 'future) (if (= cday n1) n1 n2))
- (t (if (= cday n1) n1 n2)))))))
-
-(defun org-date-to-gregorian (date)
- "Turn any specification of DATE into a Gregorian date for the calendar."
- (cond ((integerp date) (calendar-gregorian-from-absolute date))
- ((and (listp date) (= (length date) 3)) date)
- ((stringp date)
- (setq date (org-parse-time-string date))
- (list (nth 4 date) (nth 3 date) (nth 5 date)))
- ((listp date)
- (list (nth 4 date) (nth 3 date) (nth 5 date)))))
+(defun org-closest-date (start current prefer)
+ "Return closest date to CURRENT starting from START.
+
+CURRENT and START are both time stamps.
+
+When PREFER is `past', return a date that is either CURRENT or
+past. When PREFER is `future', return a date that is either
+CURRENT or future.
+
+Only time stamps with a repeater are modified. Any other time
+stamp stay unchanged. In any case, return value is an absolute
+day number."
+ (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start))
+ ;; No repeater. Do not shift time stamp.
+ (time-to-days (apply #'encode-time (org-parse-time-string start)))
+ (let ((value (string-to-number (match-string 1 start)))
+ (type (match-string 2 start)))
+ (if (= 0 value)
+ ;; Repeater with a 0-value is considered as void.
+ (time-to-days (apply #'encode-time (org-parse-time-string start)))
+ (let* ((base (org-date-to-gregorian start))
+ (target (org-date-to-gregorian current))
+ (sday (calendar-absolute-from-gregorian base))
+ (cday (calendar-absolute-from-gregorian target))
+ n1 n2)
+ ;; If START is already past CURRENT, just return START.
+ (if (<= cday sday) sday
+ ;; Compute closest date before (N1) and closest date past
+ ;; (N2) CURRENT.
+ (pcase type
+ ("h"
+ (let ((missing-hours
+ (mod (+ (- (* 24 (- cday sday))
+ (nth 2 (org-parse-time-string start)))
+ org-extend-today-until)
+ value)))
+ (setf n1 (if (= missing-hours 0) cday
+ (- cday (1+ (/ missing-hours 24)))))
+ (setf n2 (+ cday (/ (- value missing-hours) 24)))))
+ ((or "d" "w")
+ (let ((value (if (equal type "w") (* 7 value) value)))
+ (setf n1 (+ sday (* value (/ (- cday sday) value))))
+ (setf n2 (+ n1 value))))
+ ("m"
+ (let* ((add-months
+ (lambda (d n)
+ ;; Add N months to gregorian date D, i.e.,
+ ;; a list (MONTH DAY YEAR). Return a valid
+ ;; gregorian date.
+ (let ((m (+ (nth 0 d) n)))
+ (list (mod m 12)
+ (nth 1 d)
+ (+ (/ m 12) (nth 2 d))))))
+ (months ; Complete months to TARGET.
+ (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base)))
+ (- (nth 0 target) (nth 0 base))
+ ;; If START's day is greater than
+ ;; TARGET's, remove incomplete month.
+ (if (> (nth 1 target) (nth 1 base)) 0 -1))
+ value)
+ value))
+ (before (funcall add-months base months)))
+ (setf n1 (calendar-absolute-from-gregorian before))
+ (setf n2
+ (calendar-absolute-from-gregorian
+ (funcall add-months before value)))))
+ (_
+ (let* ((d (nth 1 base))
+ (m (nth 0 base))
+ (y (nth 2 base))
+ (years ; Complete years to TARGET.
+ (* (/ (- (nth 2 target)
+ y
+ ;; If START's month and day are
+ ;; greater than TARGET's, remove
+ ;; incomplete year.
+ (if (or (> (nth 0 target) m)
+ (and (= (nth 0 target) m)
+ (> (nth 1 target) d)))
+ 0
+ 1))
+ value)
+ value))
+ (before (list m d (+ y years))))
+ (setf n1 (calendar-absolute-from-gregorian before))
+ (setf n2 (calendar-absolute-from-gregorian
+ (list m d (+ (nth 2 before) value)))))))
+ ;; Handle PREFER parameter, if any.
+ (cond
+ ((eq prefer 'past) (if (= cday n2) n2 n1))
+ ((eq prefer 'future) (if (= cday n1) n1 n2))
+ (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1)))))))))
+
+(defun org-date-to-gregorian (d)
+ "Turn any specification of date D into a Gregorian date for the calendar."
+ (cond ((integerp d) (calendar-gregorian-from-absolute d))
+ ((and (listp d) (= (length d) 3)) d)
+ ((stringp d)
+ (let ((d (org-parse-time-string d)))
+ (list (nth 4 d) (nth 3 d) (nth 5 d))))
+ ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d)))))
(defun org-parse-time-string (s &optional nodefault)
- "Parse the standard Org-mode time string.
+ "Parse the standard Org time string.
+
This should be a lot faster than the normal `parse-time-string'.
-If time is not given, defaults to 0:00. However, with optional NODEFAULT,
-hour and minute fields will be nil if not given."
+
+If time is not given, defaults to 0:00. However, with optional
+NODEFAULT, hour and minute fields will be nil if not given."
(cond ((string-match org-ts-regexp0 s)
(list 0
- (if (or (match-beginning 8) (not nodefault))
- (string-to-number (or (match-string 8 s) "0")))
- (if (or (match-beginning 7) (not nodefault))
- (string-to-number (or (match-string 7 s) "0")))
+ (when (or (match-beginning 8) (not nodefault))
+ (string-to-number (or (match-string 8 s) "0")))
+ (when (or (match-beginning 7) (not nodefault))
+ (string-to-number (or (match-string 7 s) "0")))
(string-to-number (match-string 4 s))
(string-to-number (match-string 3 s))
(string-to-number (match-string 2 s))
nil nil nil))
((string-match "^<[^>]+>$" s)
+ ;; FIXME: `decode-time' needs to be called with ZONE as its
+ ;; second argument. However, this requires at least Emacs
+ ;; 25.1. We can do it when we switch to this version as our
+ ;; minimal requirement.
(decode-time (seconds-to-time (org-matcher-time s))))
- (t (error "Not a standard Org-mode time string: %s" s))))
+ (t (error "Not a standard Org time string: %s" s))))
(defun org-timestamp-up (&optional arg)
"Increase the date item at the cursor by one.
@@ -17340,7 +17794,7 @@ With prefix ARG, change by that many units."
"Increase the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
- (if (and (not (org-at-timestamp-p t))
+ (if (and (not (org-at-timestamp-p 'lax))
(org-at-heading-p))
(org-todo 'up)
(org-timestamp-change (prefix-numeric-value arg) 'day 'updown)))
@@ -17349,47 +17803,89 @@ With prefix ARG, change that many days."
"Decrease the date in the time stamp by one day.
With prefix ARG, change that many days."
(interactive "p")
- (if (and (not (org-at-timestamp-p t))
+ (if (and (not (org-at-timestamp-p 'lax))
(org-at-heading-p))
(org-todo 'down)
(org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown))
-(defun org-at-timestamp-p (&optional inactive-ok)
- "Determine if the cursor is in or at a timestamp."
- (interactive)
- (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2))
+(defun org-at-timestamp-p (&optional extended)
+ "Non-nil if point is inside a timestamp.
+
+By default, the function only consider syntactically valid active
+timestamps. However, the caller may have a broader definition
+for timestamps. As a consequence, optional argument EXTENDED can
+be set to the following values
+
+ `inactive'
+
+ Include also syntactically valid inactive timestamps.
+
+ `agenda'
+
+ Include timestamps allowed in Agenda, i.e., those in
+ properties drawers, planning lines and clock lines.
+
+ `lax'
+
+ Ignore context. The function matches any part of the
+ document looking like a timestamp. This includes comments,
+ example blocks...
+
+For backward-compatibility with Org 9.0, every other non-nil
+value is equivalent to `inactive'.
+
+When at a timestamp, return the position of the point as a symbol
+among `bracket', `after', `year', `month', `hour', `minute',
+`day' or a number of character from the last know part of the
+time stamp.
+
+When matching, the match groups are the following:
+ group 1: year
+ group 2: month
+ group 3: day number
+ group 4: day name
+ group 5: hours, if any
+ group 6: minutes, if any"
+ (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2))
(pos (point))
- (ans (or (looking-at tsr)
- (save-excursion
- (skip-chars-backward "^[<\n\r\t")
- (if (> (point) (point-min)) (backward-char 1))
- (and (looking-at tsr)
- (> (- (match-end 0) pos) -1))))))
- (and ans
- (boundp 'org-ts-what)
- (setq org-ts-what
- (cond
- ((= pos (match-beginning 0)) 'bracket)
- ;; Point is considered to be "on the bracket" whether
- ;; it's really on it or right after it.
- ((= pos (1- (match-end 0))) 'bracket)
- ((= pos (match-end 0)) 'after)
- ((org-pos-in-match-range pos 2) 'year)
- ((org-pos-in-match-range pos 3) 'month)
- ((org-pos-in-match-range pos 7) 'hour)
- ((org-pos-in-match-range pos 8) 'minute)
- ((or (org-pos-in-match-range pos 4)
- (org-pos-in-match-range pos 5)) 'day)
- ((and (> pos (or (match-end 8) (match-end 5)))
- (< pos (match-end 0)))
- (- pos (or (match-end 8) (match-end 5))))
- (t 'day))))
- ans))
+ (match?
+ (let ((boundaries (org-in-regexp regexp)))
+ (save-match-data
+ (cond ((null boundaries) nil)
+ ((eq extended 'lax) t)
+ (t
+ (or (and (eq extended 'agenda)
+ (or (org-at-planning-p)
+ (org-at-property-p)
+ (and (bound-and-true-p
+ org-agenda-include-inactive-timestamps)
+ (org-at-clock-log-p))))
+ (eq 'timestamp
+ (save-excursion
+ (when (= pos (cdr boundaries)) (forward-char -1))
+ (org-element-type (org-element-context)))))))))))
+ (cond
+ ((not match?) nil)
+ ((= pos (match-beginning 0)) 'bracket)
+ ;; Distinguish location right before the closing bracket from
+ ;; right after it.
+ ((= pos (1- (match-end 0))) 'bracket)
+ ((= pos (match-end 0)) 'after)
+ ((org-pos-in-match-range pos 2) 'year)
+ ((org-pos-in-match-range pos 3) 'month)
+ ((org-pos-in-match-range pos 7) 'hour)
+ ((org-pos-in-match-range pos 8) 'minute)
+ ((or (org-pos-in-match-range pos 4)
+ (org-pos-in-match-range pos 5)) 'day)
+ ((and (> pos (or (match-end 8) (match-end 5)))
+ (< pos (match-end 0)))
+ (- pos (or (match-end 8) (match-end 5))))
+ (t 'day))))
(defun org-toggle-timestamp-type ()
"Toggle the type (<active> or [inactive]) of a time stamp."
(interactive)
- (when (org-at-timestamp-p t)
+ (when (org-at-timestamp-p 'lax)
(let ((beg (match-beginning 0)) (end (match-end 0))
(map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]"))))
(save-excursion
@@ -17400,11 +17896,10 @@ With prefix ARG, change that many days."
(message "Timestamp is now %sactive"
(if (equal (char-after beg) ?<) "" "in")))))
-(defun org-at-clock-log-p nil
- "Is the cursor on the clock log line?"
- (save-excursion
- (move-beginning-of-line 1)
- (looking-at "^[ \t]*CLOCK:")))
+(defun org-at-clock-log-p ()
+ "Non-nil if point is on a clock log line."
+ (and (org-match-line org-clock-line-re)
+ (eq (org-element-type (save-match-data (org-element-at-point))) 'clock)))
(defvar org-clock-history) ; defined in org-clock.el
(defvar org-clock-adjust-closest nil) ; defined in org-clock.el
@@ -17414,26 +17909,26 @@ The date will be changed by N times WHAT. WHAT can be `day', `month',
`year', `minute', `second'. If WHAT is not given, the cursor position
in the timestamp determines what will be changed.
When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
- (let ((origin (point)) origin-cat
+ (let ((origin (point))
+ (timestamp? (org-at-timestamp-p 'lax))
+ origin-cat
with-hm inactive
(dm (max (nth 1 org-time-stamp-rounding-minutes) 1))
- org-ts-what
extra rem
ts time time0 fixnext clrgx)
- (if (not (org-at-timestamp-p t))
- (user-error "Not at a timestamp"))
- (if (and (not what) (eq org-ts-what 'bracket))
+ (unless timestamp? (user-error "Not at a timestamp"))
+ (if (and (not what) (eq timestamp? 'bracket))
(org-toggle-timestamp-type)
;; Point isn't on brackets. Remember the part of the time-stamp
;; the point was in. Indeed, size of time-stamps may change,
;; but point must be kept in the same category nonetheless.
- (setq origin-cat org-ts-what)
- (if (and (not what) (not (eq org-ts-what 'day))
- org-display-custom-times
- (get-text-property (point) 'display)
- (not (get-text-property (1- (point)) 'display)))
- (setq org-ts-what 'day))
- (setq org-ts-what (or what org-ts-what)
+ (setq origin-cat timestamp?)
+ (when (and (not what) (not (eq timestamp? 'day))
+ org-display-custom-times
+ (get-text-property (point) 'display)
+ (not (get-text-property (1- (point)) 'display)))
+ (setq timestamp? 'day))
+ (setq timestamp? (or what timestamp?)
inactive (= (char-after (match-beginning 0)) ?\[)
ts (match-string 0))
(replace-match "")
@@ -17441,44 +17936,46 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
"\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]"
ts)
(setq extra (match-string 1 ts))
- (if suppress-tmp-delay
- (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
- (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
- (setq with-hm t))
+ (when suppress-tmp-delay
+ (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra))))
+ (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts)
+ (setq with-hm t))
(setq time0 (org-parse-time-string ts))
(when (and updown
- (eq org-ts-what 'minute)
+ (eq timestamp? 'minute)
(not current-prefix-arg))
;; This looks like s-up and s-down. Change by one rounding step.
(setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0))))
- (when (not (= 0 (setq rem (% (nth 1 time0) dm))))
+ (unless (= 0 (setq rem (% (nth 1 time0) dm)))
(setcar (cdr time0) (+ (nth 1 time0)
(if (> n 0) (- rem) (- dm rem))))))
(setq time
- (encode-time (or (car time0) 0)
- (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0))
- (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0))
- (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0))
- (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0))
- (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0))))
- (when (and (member org-ts-what '(hour minute))
+ (apply #'encode-time
+ (or (car time0) 0)
+ (+ (if (eq timestamp? 'minute) n 0) (nth 1 time0))
+ (+ (if (eq timestamp? 'hour) n 0) (nth 2 time0))
+ (+ (if (eq timestamp? 'day) n 0) (nth 3 time0))
+ (+ (if (eq timestamp? 'month) n 0) (nth 4 time0))
+ (+ (if (eq timestamp? 'year) n 0) (nth 5 time0))
+ (nthcdr 6 time0)))
+ (when (and (memq timestamp? '(hour minute))
extra
(string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra))
(setq extra (org-modify-ts-extra
extra
- (if (eq org-ts-what 'hour) 2 5)
+ (if (eq timestamp? 'hour) 2 5)
n dm)))
- (when (integerp org-ts-what)
- (setq extra (org-modify-ts-extra extra org-ts-what n dm)))
- (if (eq what 'calendar)
- (let ((cal-date (org-get-date-from-calendar)))
- (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
- (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
- (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
- (setcar time0 (or (car time0) 0))
- (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
- (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
- (setq time (apply 'encode-time time0))))
+ (when (integerp timestamp?)
+ (setq extra (org-modify-ts-extra extra timestamp? n dm)))
+ (when (eq what 'calendar)
+ (let ((cal-date (org-get-date-from-calendar)))
+ (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month
+ (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day
+ (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year
+ (setcar time0 (or (car time0) 0))
+ (setcar (nthcdr 1 time0) (or (nth 1 time0) 0))
+ (setcar (nthcdr 2 time0) (or (nth 2 time0) 0))
+ (setq time (apply 'encode-time time0))))
;; Insert the new time-stamp, and ensure point stays in the same
;; category as before (i.e. not after the last position in that
;; category).
@@ -17489,17 +17986,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(goto-char pos))
(save-match-data
(looking-at org-ts-regexp3)
- (goto-char (cond
- ;; `day' category ends before `hour' if any, or at
- ;; the end of the day name.
- ((eq origin-cat 'day)
- (min (or (match-beginning 7) (1- (match-end 5))) origin))
- ((eq origin-cat 'hour) (min (match-end 7) origin))
- ((eq origin-cat 'minute) (min (1- (match-end 8)) origin))
- ((integerp origin-cat) (min (1- (match-end 0)) origin))
- ;; `year' and `month' have both fixed size: point
- ;; couldn't have moved into another part.
- (t origin))))
+ (goto-char
+ (pcase origin-cat
+ ;; `day' category ends before `hour' if any, or at the end
+ ;; of the day name.
+ (`day (min (or (match-beginning 7) (1- (match-end 5))) origin))
+ (`hour (min (match-end 7) origin))
+ (`minute (min (1- (match-end 8)) origin))
+ ((pred integerp) (min (1- (match-end 0)) origin))
+ ;; Point was right after the time-stamp. However, the
+ ;; time-stamp length might have changed, so refer to
+ ;; (match-end 0) instead.
+ (`after (match-end 0))
+ ;; `year' and `month' have both fixed size: point couldn't
+ ;; have moved into another part.
+ (_ origin))))
;; Update clock if on a CLOCK line.
(org-clock-update-time-maybe)
;; Maybe adjust the closest clock in `org-clock-history'
@@ -17508,11 +18009,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(< 1 (length (delq nil (mapcar 'marker-position
org-clock-history))))))
(message "No clock to adjust")
- (cond ((save-excursion ; fix previous clock?
+ (cond ((save-excursion ; fix previous clock?
(re-search-backward org-ts-regexp0 nil t)
- (org-looking-back (concat org-clock-string " \\[")))
+ (looking-back (concat org-clock-string " \\[")
+ (line-beginning-position)))
(setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$")))
- ((save-excursion ; fix next clock?
+ ((save-excursion ; fix next clock?
(re-search-backward org-ts-regexp0 nil t)
(looking-at (concat org-ts-regexp0 "\\] =>")))
(setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0))))
@@ -17521,8 +18023,8 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(let* ((p (save-excursion (org-back-to-heading t)))
(cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history))
(clfixnth
- (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100))))
- (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history))))
+ (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100))))
+ (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history))))
(if (not clfixpos)
(message "No clock to adjust")
(save-excursion
@@ -17531,15 +18033,15 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(when (re-search-forward clrgx nil t)
(goto-char (match-beginning 1))
(let (org-clock-adjust-closest)
- (org-timestamp-change n org-ts-what updown))
+ (org-timestamp-change n timestamp? updown))
(message "Clock adjusted in %s for heading: %s"
(file-name-nondirectory (buffer-file-name))
(org-get-heading t t)))))))))
;; Try to recenter the calendar window, if any.
- (if (and org-calendar-follow-timestamp-change
- (get-buffer-window "*Calendar*" t)
- (memq org-ts-what '(day month year)))
- (org-recenter-calendar (time-to-days time))))))
+ (when (and org-calendar-follow-timestamp-change
+ (get-buffer-window "*Calendar*" t)
+ (memq timestamp? '(day month year)))
+ (org-recenter-calendar (time-to-days time))))))
(defun org-modify-ts-extra (s pos n dm)
"Change the different parts of the lead-time and repeat fields in timestamp."
@@ -17553,13 +18055,13 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
h (string-to-number (match-string 2 s)))
(if (org-pos-in-match-range pos 2)
(setq h (+ h n))
- (setq n (* dm (org-no-warnings (signum n))))
- (when (not (= 0 (setq rem (% m dm))))
+ (setq n (* dm (with-no-warnings (signum n))))
+ (unless (= 0 (setq rem (% m dm)))
(setq m (+ m (if (> n 0) (- rem) (- dm rem)))))
(setq m (+ m n)))
- (if (< m 0) (setq m (+ m 60) h (1- h)))
- (if (> m 59) (setq m (- m 60) h (1+ h)))
- (setq h (min 24 (max 0 h)))
+ (when (< m 0) (setq m (+ m 60) h (1- h)))
+ (when (> m 59) (setq m (- m 60) h (1+ h)))
+ (setq h (mod h 24))
(setq ng 1 new (format "-%02d:%02d" h m)))
((org-pos-in-match-range pos 6)
(setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx))))
@@ -17578,35 +18080,32 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
(substring s (match-end ng))))))
s))
-(defun org-recenter-calendar (date)
- "If the calendar is visible, recenter it to DATE."
+(defun org-recenter-calendar (d)
+ "If the calendar is visible, recenter it to date D."
(let ((cwin (get-buffer-window "*Calendar*" t)))
(when cwin
(let ((calendar-move-hook nil))
(with-selected-window cwin
- (calendar-goto-date (if (listp date) date
- (calendar-gregorian-from-absolute date))))))))
+ (calendar-goto-date
+ (if (listp d) d (calendar-gregorian-from-absolute d))))))))
(defun org-goto-calendar (&optional arg)
"Go to the Emacs calendar at the current date.
If there is a time stamp in the current line, go to that date.
A prefix ARG can be used to force the current date."
(interactive "P")
- (let ((tsr org-ts-regexp) diff
- (calendar-move-hook nil)
+ (let ((calendar-move-hook nil)
(calendar-view-holidays-initially-flag nil)
- (calendar-view-diary-initially-flag nil))
- (if (or (org-at-timestamp-p)
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat ".*" tsr))))
- (let ((d1 (time-to-days (current-time)))
- (d2 (time-to-days
- (org-time-string-to-time (match-string 1)))))
- (setq diff (- d2 d1))))
+ (calendar-view-diary-initially-flag nil)
+ diff)
+ (when (or (org-at-timestamp-p 'lax)
+ (org-match-line (concat ".*" org-ts-regexp)))
+ (let ((d1 (time-to-days (current-time)))
+ (d2 (time-to-days (org-time-string-to-time (match-string 1)))))
+ (setq diff (- d2 d1))))
(calendar)
(calendar-goto-today)
- (if (and diff (not arg)) (calendar-forward-day diff))))
+ (when (and diff (not arg)) (calendar-forward-day diff))))
(defun org-get-date-from-calendar ()
"Return a list (month day year) of date at point in calendar."
@@ -17618,14 +18117,15 @@ A prefix ARG can be used to force the current date."
"Insert time stamp corresponding to cursor date in *Calendar* buffer.
If there is already a time stamp at the cursor position, update it."
(interactive)
- (if (org-at-timestamp-p t)
+ (if (org-at-timestamp-p 'lax)
(org-timestamp-change 0 'calendar)
(let ((cal-date (org-get-date-from-calendar)))
(org-insert-time-stamp
(encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date))))))
(defcustom org-effort-durations
- `(("h" . 60)
+ `(("min" . 1)
+ ("h" . 60)
("d" . ,(* 60 8))
("w" . ,(* 60 8 5))
("m" . ,(* 60 8 5 4))
@@ -17641,121 +18141,11 @@ minutes.
For example, if the value of this variable is ((\"hours\" . 60)), then an
effort string \"2hours\" is equivalent to 120 minutes."
:group 'org-agenda
- :version "24.1"
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Modifier")
:value-type (number :tag "Minutes")))
-(defun org-minutes-to-clocksum-string (m)
- "Format number of minutes as a clocksum string.
-The format is determined by `org-time-clocksum-format',
-`org-time-clocksum-use-fractional' and
-`org-time-clocksum-fractional-format' and
-`org-time-clocksum-use-effort-durations'."
- (let ((clocksum "")
- (m (round m)) ; Don't allow fractions of minutes
- h d w mo y fmt n)
- (setq h (if org-time-clocksum-use-effort-durations
- (cdr (assoc "h" org-effort-durations)) 60)
- d (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "d" org-effort-durations)) h) 24)
- w (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7)
- mo (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30)
- y (if org-time-clocksum-use-effort-durations
- (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365))
- ;; fractional format
- (if org-time-clocksum-use-fractional
- (cond
- ;; single format string
- ((stringp org-time-clocksum-fractional-format)
- (format org-time-clocksum-fractional-format (/ m (float h))))
- ;; choice of fractional formats for different time units
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years))
- (> (/ (truncate m) (* y d h)) 0))
- (format fmt (/ m (* y d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months))
- (> (/ (truncate m) (* mo d h)) 0))
- (format fmt (/ m (* mo d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
- (> (/ (truncate m) (* w d h)) 0))
- (format fmt (/ m (* w d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days))
- (> (/ (truncate m) (* d h)) 0))
- (format fmt (/ m (* d (float h)))))
- ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours))
- (> (/ (truncate m) h) 0))
- (format fmt (/ m (float h))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes))
- (format fmt m))
- ;; fall back to smallest time unit with a format
- ((setq fmt (plist-get org-time-clocksum-fractional-format :hours))
- (format fmt (/ m (float h))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :days))
- (format fmt (/ m (* d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks))
- (format fmt (/ m (* w d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :months))
- (format fmt (/ m (* mo d (float h)))))
- ((setq fmt (plist-get org-time-clocksum-fractional-format :years))
- (format fmt (/ m (* y d (float h))))))
- ;; standard (non-fractional) format, with single format string
- (if (stringp org-time-clocksum-format)
- (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n)))
- ;; separate formats components
- (and (setq fmt (plist-get org-time-clocksum-format :years))
- (or (> (setq n (/ (truncate m) (* y d h))) 0)
- (plist-get org-time-clocksum-format :require-years))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n y d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :months))
- (or (> (setq n (/ (truncate m) (* mo d h))) 0)
- (plist-get org-time-clocksum-format :require-months))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n mo d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :weeks))
- (or (> (setq n (/ (truncate m) (* w d h))) 0)
- (plist-get org-time-clocksum-format :require-weeks))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n w d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :days))
- (or (> (setq n (/ (truncate m) (* d h))) 0)
- (plist-get org-time-clocksum-format :require-days))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n d h))))
- (and (setq fmt (plist-get org-time-clocksum-format :hours))
- (or (> (setq n (/ (truncate m) h)) 0)
- (plist-get org-time-clocksum-format :require-hours))
- (setq clocksum (concat clocksum (format fmt n))
- m (- m (* n h))))
- (and (setq fmt (plist-get org-time-clocksum-format :minutes))
- (or (> m 0) (plist-get org-time-clocksum-format :require-minutes))
- (setq clocksum (concat clocksum (format fmt m))))
- ;; return formatted time duration
- clocksum))))
-
-(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string)
-(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string
- "Org mode version 8.0")
-
-(defun org-hours-to-clocksum-string (n)
- (org-minutes-to-clocksum-string (* n 60)))
-
-(defun org-hh:mm-string-to-minutes (s)
- "Convert a string H:MM to a number of minutes.
-If the string is just a number, interpret it as minutes.
-In fact, the first hh:mm or number in the string will be taken,
-there can be extra stuff in the string.
-If no number is found, the return value is 0."
- (cond
- ((integerp s) s)
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s)
- (+ (* (string-to-number (match-string 1 s)) 60)
- (string-to-number (match-string 2 s))))
- ((string-match "\\([0-9]+\\)" s)
- (string-to-number (match-string 1 s)))
- (t 0)))
-
(defcustom org-image-actual-width t
"Should we use the actual width of images when inlining them?
@@ -17793,53 +18183,35 @@ tables are not re-aligned, etc."
:version "24.3"
:group 'org-agenda)
-(defcustom org-agenda-ignore-drawer-properties nil
+(defcustom org-agenda-ignore-properties nil
"Avoid updating text properties when building the agenda.
-Properties are used to prepare buffers for effort estimates, appointments,
-and subtree-local categories.
-If you don't use these in the agenda, you can add them to this list and
-agenda building will be a bit faster.
+Properties are used to prepare buffers for effort estimates,
+appointments, statistics and subtree-local categories.
+If you don't use these in the agenda, you can add them to this
+list and agenda building will be a bit faster.
The value is a list, with zero or more of the symbols `effort', `appt',
-or `category'."
+`stats' or `category'."
:type '(set :greedy t
(const effort)
(const appt)
+ (const stats)
(const category))
- :version "24.3"
+ :version "26.1"
+ :package-version '(Org . "8.3")
:group 'org-agenda)
-(defun org-duration-string-to-minutes (s &optional output-to-string)
- "Convert a duration string S to minutes.
-
-A bare number is interpreted as minutes, modifiers can be set by
-customizing `org-effort-durations' (which see).
-
-Entries containing a colon are interpreted as H:MM by
-`org-hh:mm-string-to-minutes'."
- (let ((result 0)
- (re (concat "\\([0-9.]+\\) *\\("
- (regexp-opt (mapcar 'car org-effort-durations))
- "\\)")))
- (while (string-match re s)
- (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations))
- (string-to-number (match-string 1 s))))
- (setq s (replace-match "" nil t s)))
- (setq result (floor result))
- (incf result (org-hh:mm-string-to-minutes s))
- (if output-to-string (number-to-string result) result)))
-
;;;; Files
(defun org-save-all-org-buffers ()
- "Save all Org-mode buffers without user confirmation."
+ "Save all Org buffers without user confirmation."
(interactive)
- (message "Saving all Org-mode buffers...")
+ (message "Saving all Org buffers...")
(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
(when (featurep 'org-id) (org-id-locations-save))
- (message "Saving all Org-mode buffers... done"))
+ (message "Saving all Org buffers... done"))
(defun org-revert-all-org-buffers ()
- "Revert all Org-mode buffers.
+ "Revert all Org buffers.
Prompt for confirmation when there are unsaved changes.
Be sure you know what you are doing before letting this function
overwrite your changes.
@@ -17856,13 +18228,11 @@ changes from another. I believe the procedure must be like this:
(user-error "Abort"))
(save-excursion
(save-window-excursion
- (mapc
- (lambda (b)
- (when (and (with-current-buffer b (derived-mode-p 'org-mode))
- (with-current-buffer b buffer-file-name))
- (org-pop-to-buffer-same-window b)
- (revert-buffer t 'no-confirm)))
- (buffer-list))
+ (dolist (b (buffer-list))
+ (when (and (with-current-buffer b (derived-mode-p 'org-mode))
+ (with-current-buffer b buffer-file-name))
+ (pop-to-buffer-same-window b)
+ (revert-buffer t 'no-confirm)))
(when (and (featurep 'org-id) org-id-track-globally)
(org-id-locations-load)))))
@@ -17871,29 +18241,19 @@ changes from another. I believe the procedure must be like this:
;;;###autoload
(defun org-switchb (&optional arg)
"Switch between Org buffers.
-With one prefix argument, restrict available buffers to files.
-With two prefix arguments, restrict available buffers to agenda files.
-Defaults to `iswitchb' for buffer name completion.
-Set `org-completion-use-ido' to make it use ido instead."
+With `\\[universal-argument]' prefix, restrict available buffers to files.
+
+With `\\[universal-argument] \\[universal-argument]' \
+prefix, restrict available buffers to agenda files."
(interactive "P")
- (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files))
- ((equal arg '(16)) (org-buffer-list 'agenda))
- (t (org-buffer-list))))
- (org-completion-use-iswitchb org-completion-use-iswitchb)
- (org-completion-use-ido org-completion-use-ido))
- (unless (or org-completion-use-ido org-completion-use-iswitchb)
- (setq org-completion-use-iswitchb t))
- (org-pop-to-buffer-same-window
- (org-icompleting-read "Org buffer: "
- (mapcar 'list (mapcar 'buffer-name blist))
- nil t))))
-
-;;; Define some older names previously used for this functionality
-;;;###autoload
-(defalias 'org-ido-switchb 'org-switchb)
-;;;###autoload
-(defalias 'org-iswitchb 'org-switchb)
+ (let ((blist (org-buffer-list
+ (cond ((equal arg '(4)) 'files)
+ ((equal arg '(16)) 'agenda)))))
+ (pop-to-buffer-same-window
+ (completing-read "Org buffer: "
+ (mapcar #'list (mapcar #'buffer-name blist))
+ nil t))))
(defun org-buffer-list (&optional predicate exclude-tmp)
"Return a list of Org buffers.
@@ -17968,8 +18328,10 @@ used by the agenda files. If ARCHIVE is `ifmode', do this only if
"Return non-nil, if FILE is an agenda file.
If FILE is omitted, use the file associated with the current
buffer."
- (member (or file (buffer-file-name))
- (org-agenda-files t)))
+ (let ((fname (or file (buffer-file-name))))
+ (and fname
+ (member (file-truename fname)
+ (mapcar #'file-truename (org-agenda-files t))))))
(defun org-edit-agenda-file-list ()
"Edit the list of agenda files.
@@ -17981,15 +18343,15 @@ the buffer and restores the previous window configuration."
(if (stringp org-agenda-files)
(let ((cw (current-window-configuration)))
(find-file org-agenda-files)
- (org-set-local 'org-window-configuration cw)
- (org-add-hook 'after-save-hook
- (lambda ()
- (set-window-configuration
- (prog1 org-window-configuration
- (kill-buffer (current-buffer))))
- (org-install-agenda-files-menu)
- (message "New agenda file list installed"))
- nil 'local)
+ (setq-local org-window-configuration cw)
+ (add-hook 'after-save-hook
+ (lambda ()
+ (set-window-configuration
+ (prog1 org-window-configuration
+ (kill-buffer (current-buffer))))
+ (org-install-agenda-files-menu)
+ (message "New agenda file list installed"))
+ nil 'local)
(message "%s" (substitute-command-keys
"Edit list and finish with \\[save-buffer]")))
(customize-variable 'org-agenda-files)))
@@ -18039,19 +18401,16 @@ un-expanded file names."
If the current buffer visits an agenda file, find the next one in the list.
If the current buffer does not, find the first agenda file."
(interactive)
- (let* ((fs (org-agenda-files t))
- (files (append fs (list (car fs))))
- (tcf (if buffer-file-name (file-truename buffer-file-name)))
+ (let* ((fs (or (org-agenda-files t)
+ (user-error "No agenda files")))
+ (files (copy-sequence fs))
+ (tcf (and buffer-file-name (file-truename buffer-file-name)))
file)
- (unless files (user-error "No agenda files"))
- (catch 'exit
- (dolist (file files)
- (if (equal (file-truename file) tcf)
- (when (car files)
- (find-file (car files))
- (throw 'exit t))))
- (find-file (car fs)))
- (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer)))))
+ (when tcf
+ (while (and (setq file (pop files))
+ (not (equal (file-truename file) tcf)))))
+ (find-file (car (or files fs)))
+ (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer)))))
(defun org-agenda-file-to-front (&optional to-end)
"Move/add the current file to the top of the agenda file list.
@@ -18069,7 +18428,7 @@ end of the list."
x had)
(setq x (assoc ctf file-alist) had x)
- (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
+ (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name))))
(if to-end
(setq file-alist (append (delq x file-alist) (list x)))
(setq file-alist (cons x (delq x file-alist))))
@@ -18090,15 +18449,15 @@ Optional argument FILE means use this file instead of the current."
(afile (abbreviate-file-name file))
(files (delq nil (mapcar
(lambda (x)
- (if (equal true-file
- (file-truename x))
- nil x))
+ (unless (equal true-file
+ (file-truename x))
+ x))
(org-agenda-files t)))))
(if (not (= (length files) (length (org-agenda-files t))))
(progn
(org-store-new-agenda-file-list files)
(org-install-agenda-files-menu)
- (message "Removed file: %s" afile))
+ (message "Removed from Org Agenda list: %s" afile))
(message "File was not in list: %s (not removed)" afile))))
(defun org-file-menu-entry (file)
@@ -18106,7 +18465,7 @@ Optional argument FILE means use this file instead of the current."
(defun org-check-agenda-file (file)
"Make sure FILE exists. If not, ask user what to do."
- (when (not (file-exists-p file))
+ (unless (file-exists-p file)
(message "Non-existent agenda file %s. [R]emove from list or [A]bort?"
(abbreviate-file-name file))
(let ((r (downcase (read-char-exclusive))))
@@ -18114,17 +18473,18 @@ Optional argument FILE means use this file instead of the current."
((equal r ?r)
(org-remove-file file)
(throw 'nextfile t))
- (t (error "Abort"))))))
+ (t (user-error "Abort"))))))
(defun org-get-agenda-file-buffer (file)
- "Get a buffer visiting FILE. If the buffer needs to be created, add
-it to the list of buffers which might be released later."
+ "Get an agenda buffer visiting FILE.
+If the buffer needs to be created, add it to the list of buffers
+which might be released later."
(let ((buf (org-find-base-buffer-visiting file)))
(if buf
buf ; just return it
;; Make a new buffer and remember it
(setq buf (find-file-noselect file))
- (if buf (push buf org-agenda-new-buffers))
+ (when buf (push buf org-agenda-new-buffers))
buf)))
(defun org-release-buffers (blist)
@@ -18149,7 +18509,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(inhibit-read-only t)
(org-inhibit-startup org-agenda-inhibit-startup)
(rea (concat ":" org-archive-tag ":"))
- file re pos)
+ re pos)
(setq org-tag-alist-for-agenda nil
org-tag-groups-alist-for-agenda nil)
(save-excursion
@@ -18161,20 +18521,15 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(org-check-agenda-file file)
(set-buffer (org-get-agenda-file-buffer file)))
(widen)
- (org-set-regexps-and-options-for-tags)
+ (org-set-regexps-and-options 'tags-only)
(setq pos (point))
- (goto-char (point-min))
- (let ((case-fold-search t))
- (when (search-forward "#+setupfile" nil t)
- ;; Don't set all regexps and options systematically as
- ;; this is only run for setting agenda tags from setup
- ;; file
- (org-set-regexps-and-options)))
- (or (memq 'category org-agenda-ignore-drawer-properties)
+ (or (memq 'category org-agenda-ignore-properties)
(org-refresh-category-properties))
- (or (memq 'effort org-agenda-ignore-drawer-properties)
- (org-refresh-properties org-effort-property 'org-effort))
- (or (memq 'appt org-agenda-ignore-drawer-properties)
+ (or (memq 'stats org-agenda-ignore-properties)
+ (org-refresh-stats-properties))
+ (or (memq 'effort org-agenda-ignore-properties)
+ (org-refresh-effort-properties))
+ (or (memq 'appt org-agenda-ignore-properties)
(org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
(setq org-todo-keywords-for-agenda
(append org-todo-keywords-for-agenda org-todo-keywords-1))
@@ -18182,31 +18537,32 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(append org-done-keywords-for-agenda org-done-keywords))
(setq org-todo-keyword-alist-for-agenda
(append org-todo-keyword-alist-for-agenda org-todo-key-alist))
- (setq org-drawers-for-agenda
- (append org-drawers-for-agenda org-drawers))
(setq org-tag-alist-for-agenda
(org-uniquify
(append org-tag-alist-for-agenda
- org-tag-alist
- org-tag-persistent-alist)))
- (if org-group-tags
- (setq org-tag-groups-alist-for-agenda
- (org-uniquify-alist
- (append org-tag-groups-alist-for-agenda org-tag-groups-alist))))
+ org-current-tag-alist)))
+ ;; Merge current file's tag groups into global
+ ;; `org-tag-groups-alist-for-agenda'.
+ (when org-group-tags
+ (dolist (alist org-tag-groups-alist)
+ (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda)))
+ (if old
+ (setcdr old (org-uniquify (append (cdr old) (cdr alist))))
+ (push alist org-tag-groups-alist-for-agenda)))))
(org-with-silent-modifications
(save-excursion
(remove-text-properties (point-min) (point-max) pall)
(when org-agenda-skip-archived-trees
(goto-char (point-min))
(while (re-search-forward rea nil t)
- (if (org-at-heading-p t)
- (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
+ (when (org-at-heading-p t)
+ (add-text-properties (point-at-bol) (org-end-of-subtree t) pa))))
(goto-char (point-min))
- (setq re (format org-heading-keyword-regexp-format
- org-comment-string))
+ (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string))
(while (re-search-forward re nil t)
- (add-text-properties
- (match-beginning 0) (org-end-of-subtree t) pc))))
+ (when (save-match-data (org-in-commented-heading-p t))
+ (add-text-properties
+ (match-beginning 0) (org-end-of-subtree t) pc)))))
(goto-char pos)))))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
@@ -18223,7 +18579,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret)
(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol)
(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify)
-(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment)
+(org-defkey org-cdlatex-mode-map "\C-c{" 'org-cdlatex-environment-indent)
(defvar org-cdlatex-texmathp-advice-is-done nil
"Flag remembering if we have applied the advice to texmathp already.")
@@ -18231,7 +18587,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
(define-minor-mode org-cdlatex-mode
"Toggle the minor `org-cdlatex-mode'.
This mode supports entering LaTeX environment and math in LaTeX fragments
-in Org-mode.
+in Org mode.
\\{org-cdlatex-mode-map}"
nil " OCDL" nil
(when org-cdlatex-mode
@@ -18241,11 +18597,11 @@ in Org-mode.
(unless org-cdlatex-texmathp-advice-is-done
(setq org-cdlatex-texmathp-advice-is-done t)
(defadvice texmathp (around org-math-always-on activate)
- "Always return t in org-mode buffers.
+ "Always return t in Org buffers.
This is because we want to insert math symbols without dollars even outside
-the LaTeX math segments. If Orgmode thinks that point is actually inside
-an embedded LaTeX fragment, let texmathp do its job.
-\\[org-cdlatex-mode-map]"
+the LaTeX math segments. If Org mode thinks that point is actually inside
+an embedded LaTeX fragment, let `texmathp' do its job.
+`\\[org-cdlatex-mode-map]'"
(interactive)
(let (p)
(cond
@@ -18257,8 +18613,8 @@ an embedded LaTeX fragment, let texmathp do its job.
(let ((p (org-inside-LaTeX-fragment-p)))
(if (and p (member (car p) (plist-get org-format-latex-options :matchers)))
(setq ad-return-value t
- texmathp-why '("Org-mode embedded math" . 0))
- (if p ad-do-it)))))))))
+ texmathp-why '("Org mode embedded math" . 0))
+ (when p ad-do-it)))))))))
(defun turn-on-org-cdlatex ()
"Unconditionally turn on `org-cdlatex-mode'."
@@ -18283,7 +18639,7 @@ It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is
(cdlatex-tab) t)
((org-inside-LaTeX-fragment-p) (cdlatex-tab) t))))
-(defun org-cdlatex-underscore-caret (&optional arg)
+(defun org-cdlatex-underscore-caret (&optional _arg)
"Execute `cdlatex-sub-superscript' in LaTeX fragments.
Revert to the normal definition outside of these fragments."
(interactive "P")
@@ -18292,7 +18648,7 @@ Revert to the normal definition outside of these fragments."
(let (org-cdlatex-mode)
(call-interactively (key-binding (vector last-input-event))))))
-(defun org-cdlatex-math-modify (&optional arg)
+(defun org-cdlatex-math-modify (&optional _arg)
"Execute `cdlatex-math-modify' in LaTeX fragments.
Revert to the normal definition outside of these fragments."
(interactive "P")
@@ -18301,21 +18657,66 @@ Revert to the normal definition outside of these fragments."
(let (org-cdlatex-mode)
(call-interactively (key-binding (vector last-input-event))))))
+(defun org-cdlatex-environment-indent (&optional environment item)
+ "Execute `cdlatex-environment' and indent the inserted environment.
+
+ENVIRONMENT and ITEM are passed to `cdlatex-environment'.
+
+The inserted environment is indented to current indentation
+unless point is at the beginning of the line, in which the
+environment remains unintended."
+ (interactive)
+ ;; cdlatex-environment always return nil. Therefore, capture output
+ ;; first and determine if an environment was selected.
+ (let* ((beg (point-marker))
+ (end (copy-marker (point) t))
+ (inserted (progn
+ (ignore-errors (cdlatex-environment environment item))
+ (< beg end)))
+ ;; Figure out how many lines to move forward after the
+ ;; environment has been inserted.
+ (lines (when inserted
+ (save-excursion
+ (- (cl-loop while (< beg (point))
+ with x = 0
+ do (forward-line -1)
+ (cl-incf x)
+ finally return x)
+ (if (progn (goto-char beg)
+ (and (progn (skip-chars-forward " \t") (eolp))
+ (progn (skip-chars-backward " \t") (bolp))))
+ 1 0)))))
+ (env (org-trim (delete-and-extract-region beg end))))
+ (when inserted
+ ;; Get indentation of next line unless at column 0.
+ (let ((ind (if (bolp) 0
+ (save-excursion
+ (org-return-indent)
+ (prog1 (org-get-indentation)
+ (when (progn (skip-chars-forward " \t") (eolp))
+ (delete-region beg (point)))))))
+ (bol (progn (skip-chars-backward " \t") (bolp))))
+ ;; Insert a newline before environment unless at column zero
+ ;; to "escape" the current line. Insert a newline if
+ ;; something is one the same line as \end{ENVIRONMENT}.
+ (insert
+ (concat (unless bol "\n") env
+ (when (and (skip-chars-forward " \t") (not (eolp))) "\n")))
+ (unless (zerop ind)
+ (save-excursion
+ (goto-char beg)
+ (while (< (point) end)
+ (unless (eolp) (indent-line-to ind))
+ (forward-line))))
+ (goto-char beg)
+ (forward-line lines)
+ (indent-line-to ind)))
+ (set-marker beg nil)
+ (set-marker end nil)))
;;;; LaTeX fragments
-(defvar org-latex-regexps
- '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t)
- ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil)
- ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p
- ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil)
- ("\\(" "\\\\([^\000]*?\\\\)" 0 nil)
- ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil)
- ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil))
- "Regular expressions for matching embedded LaTeX.")
-
(defun org-inside-LaTeX-fragment-p ()
"Test if point is inside a LaTeX fragment.
I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing
@@ -18335,9 +18736,7 @@ looks only before point, not after."
(catch 'exit
(let ((pos (point))
(dodollar (member "$" (plist-get org-format-latex-options :matchers)))
- (lim (progn
- (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t)
- (point)))
+ (lim (save-excursion (org-backward-paragraph) (point)))
dd-on str (start 0) m re)
(goto-char pos)
(when dodollar
@@ -18358,7 +18757,7 @@ looks only before point, not after."
(while (re-search-backward "\\$\\$" lim t)
(setq dd-on (not dd-on)))
(goto-char pos)
- (if dd-on (cons "$$" m))))))
+ (when dd-on (cons "$$" m))))))
(defun org-inside-latex-macro-p ()
"Is point inside a LaTeX macro or its arguments?"
@@ -18366,179 +18765,226 @@ looks only before point, not after."
(org-in-regexp
"\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")))
-(defvar org-latex-fragment-image-overlays nil
- "List of overlays carrying the images of latex fragments.")
-(make-variable-buffer-local 'org-latex-fragment-image-overlays)
+(defun org--format-latex-make-overlay (beg end image &optional imagetype)
+ "Build an overlay between BEG and END using IMAGE file.
+Argument IMAGETYPE is the extension of the displayed image,
+as a string. It defaults to \"png\"."
+ (let ((ov (make-overlay beg end))
+ (imagetype (or (intern imagetype) 'png)))
+ (overlay-put ov 'org-overlay-type 'org-latex-overlay)
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov
+ 'modification-hooks
+ (list (lambda (o _flag _beg _end &optional _l)
+ (delete-overlay o))))
+ (overlay-put ov
+ 'display
+ (list 'image :type imagetype :file image :ascent 'center))))
+
+(defun org--list-latex-overlays (&optional beg end)
+ "List all Org LaTeX overlays in current buffer.
+Limit to overlays between BEG and END when those are provided."
+ (cl-remove-if-not
+ (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay))
+ (overlays-in (or beg (point-min)) (or end (point-max)))))
+
+(defun org-remove-latex-fragment-image-overlays (&optional beg end)
+ "Remove all overlays with LaTeX fragment images in current buffer.
+When optional arguments BEG and END are non-nil, remove all
+overlays between them instead. Return a non-nil value when some
+overlays were removed, nil otherwise."
+ (let ((overlays (org--list-latex-overlays beg end)))
+ (mapc #'delete-overlay overlays)
+ overlays))
+
+(defun org-toggle-latex-fragment (&optional arg)
+ "Preview the LaTeX fragment at point, or all locally or globally.
-(defun org-remove-latex-fragment-image-overlays ()
- "Remove all overlays with LaTeX fragment images in current buffer."
- (mapc 'delete-overlay org-latex-fragment-image-overlays)
- (setq org-latex-fragment-image-overlays nil))
+If the cursor is on a LaTeX fragment, create the image and overlay
+it over the source code, if there is none. Remove it otherwise.
+If there is no fragment at point, display all fragments in the
+current section.
-(defun org-preview-latex-fragment (&optional subtree)
- "Preview the LaTeX fragment at point, or all locally or globally.
-If the cursor is in a LaTeX fragment, create the image and overlay
-it over the source code. If there is no fragment at point, display
-all fragments in the current text, from one headline to the next. With
-prefix SUBTREE, display all fragments in the current subtree. With a
-double prefix arg \\[universal-argument] \\[universal-argument], or when \
-the cursor is before the first headline,
-display all fragments in the buffer.
-The images can be removed again with \\[org-ctrl-c-ctrl-c]."
+With prefix ARG, preview or clear image for all fragments in the
+current subtree or in the whole buffer when used before the first
+headline. With a prefix ARG `\\[universal-argument] \
+\\[universal-argument]' preview or clear images
+for all fragments in the buffer."
(interactive "P")
- (unless buffer-file-name
- (user-error "Can't preview LaTeX fragment in a non-file buffer"))
(when (display-graphic-p)
- (org-remove-latex-fragment-image-overlays)
- (save-excursion
- (save-restriction
- (let (beg end at msg)
+ (catch 'exit
+ (save-excursion
+ (let (beg end msg)
(cond
- ((or (equal subtree '(16))
- (not (save-excursion
- (re-search-backward org-outline-regexp-bol nil t))))
- (setq beg (point-min) end (point-max)
- msg "Creating images for buffer...%s"))
- ((equal subtree '(4))
- (org-back-to-heading)
- (setq beg (point) end (org-end-of-subtree t)
- msg "Creating images for subtree...%s"))
+ ((or (equal arg '(16))
+ (and (equal arg '(4))
+ (org-with-limited-levels (org-before-first-heading-p))))
+ (if (org-remove-latex-fragment-image-overlays)
+ (progn (message "LaTeX fragments images removed from buffer")
+ (throw 'exit nil))
+ (setq msg "Creating images for buffer...")))
+ ((equal arg '(4))
+ (org-with-limited-levels (org-back-to-heading t))
+ (setq beg (point))
+ (setq end (progn (org-end-of-subtree t) (point)))
+ (if (org-remove-latex-fragment-image-overlays beg end)
+ (progn
+ (message "LaTeX fragment images removed from subtree")
+ (throw 'exit nil))
+ (setq msg "Creating images for subtree...")))
+ ((let ((datum (org-element-context)))
+ (when (memq (org-element-type datum)
+ '(latex-environment latex-fragment))
+ (setq beg (org-element-property :begin datum))
+ (setq end (org-element-property :end datum))
+ (if (org-remove-latex-fragment-image-overlays beg end)
+ (progn (message "LaTeX fragment image removed")
+ (throw 'exit nil))
+ (setq msg "Creating image...")))))
(t
- (if (setq at (org-inside-LaTeX-fragment-p))
- (goto-char (max (point-min) (- (cdr at) 2)))
- (org-back-to-heading))
- (setq beg (point) end (progn (outline-next-heading) (point))
- msg (if at "Creating image...%s"
- "Creating images for entry...%s"))))
- (message msg "")
- (narrow-to-region beg end)
- (goto-char beg)
- (org-format-latex
- (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
- (file-name-nondirectory
- buffer-file-name)))
- default-directory 'overlays msg at 'forbuffer
- org-latex-create-formula-image-program)
- (message msg "done. Use `C-c C-c' to remove images."))))))
-
-(defun org-format-latex (prefix &optional dir overlays msg at
- forbuffer processing-type)
- "Replace LaTeX fragments with links to an image, and produce images.
+ (org-with-limited-levels
+ (setq beg (if (org-at-heading-p) (line-beginning-position)
+ (outline-previous-heading)
+ (point)))
+ (setq end (progn (outline-next-heading) (point)))
+ (if (org-remove-latex-fragment-image-overlays beg end)
+ (progn
+ (message "LaTeX fragment images removed from section")
+ (throw 'exit nil))
+ (setq msg "Creating images for section...")))))
+ (let ((file (buffer-file-name (buffer-base-buffer))))
+ (org-format-latex
+ (concat org-preview-latex-image-directory "org-ltximg")
+ beg end
+ ;; 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
+ default-directory)
+ 'overlays msg 'forbuffer org-preview-latex-default-process))
+ (message (concat msg "done")))))))
+
+(defun org-format-latex
+ (prefix &optional beg end dir overlays msg forbuffer processing-type)
+ "Replace LaTeX fragments with links to an image.
+
+The function takes care of creating the replacement image.
+
+Only consider fragments between BEG and END when those are
+provided.
+
+When optional argument OVERLAYS is non-nil, display the image on
+top of the fragment instead of replacing it.
+
+PROCESSING-TYPE is the conversion method to use, as a symbol.
+
Some of the options can be changed using the variable
-`org-format-latex-options'."
- (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
- (let* ((prefixnodir (file-name-nondirectory prefix))
- (absprefix (expand-file-name prefix dir))
- (todir (file-name-directory absprefix))
- (opt org-format-latex-options)
- (optnew org-format-latex-options)
- (matchers (plist-get opt :matchers))
- (re-list org-latex-regexps)
- (cnt 0) txt hash link beg end re checkdir
- string
- m n block-type block linkfile movefile ov)
- ;; Check the different regular expressions
- (dolist (e re-list)
- (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e)
- block (if block-type "\n\n" ""))
- (when (member m matchers)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (when (and (or (not at) (equal (cdr at) (match-beginning n)))
- (or (not overlays)
- (not (eq (get-char-property (match-beginning n)
- 'org-overlay-type)
- 'org-latex-overlay))))
- (cond
- ((eq processing-type 'verbatim))
- ((eq processing-type 'mathjax)
- ;; Prepare for MathJax processing.
- (setq string (match-string n))
- (when (member m '("$" "$1"))
- (save-excursion
- (delete-region (match-beginning n) (match-end n))
- (goto-char (match-beginning n))
- (insert (concat "\\(" (substring string 1 -1) "\\)")))))
- ((or (eq processing-type 'dvipng)
- (eq processing-type 'imagemagick))
- ;; Process to an image.
- (setq txt (match-string n)
- beg (match-beginning n) end (match-end n)
- cnt (1+ cnt))
- (let ((face (face-at-point))
- (fg (plist-get opt :foreground))
- (bg (plist-get opt :background))
- ;; Ensure full list is printed.
- print-length print-level)
- (when forbuffer
- ;; Get the colors from the face at point.
+`org-format-latex-options', which see."
+ (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache))
+ (unless (eq processing-type 'verbatim)
+ (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}")
+ (cnt 0)
+ checkdir-flag)
+ (goto-char (or beg (point-min)))
+ ;; Optimize overlay creation: (info "(elisp) Managing Overlays").
+ (when (and overlays (memq processing-type '(dvipng imagemagick)))
+ (overlay-recenter (or end (point-max))))
+ (while (re-search-forward math-regexp end t)
+ (unless (and overlays
+ (eq (get-char-property (point) 'org-overlay-type)
+ 'org-latex-overlay))
+ (let* ((context (org-element-context))
+ (type (org-element-type context)))
+ (when (memq type '(latex-environment latex-fragment))
+ (let ((block-type (eq type 'latex-environment))
+ (value (org-element-property :value context))
+ (beg (org-element-property :begin context))
+ (end (save-excursion
+ (goto-char (org-element-property :end context))
+ (skip-chars-backward " \r\t\n")
+ (point))))
+ (cond
+ ((eq processing-type 'mathjax)
+ ;; Prepare for MathJax processing.
+ (if (not (string-match "\\`\\$\\$?" value))
+ (goto-char end)
+ (delete-region beg end)
+ (if (string= (match-string 0 value) "$$")
+ (insert "\\[" (substring value 2 -2) "\\]")
+ (insert "\\(" (substring value 1 -1) "\\)"))))
+ ((assq processing-type org-preview-latex-process-alist)
+ ;; Process to an image.
+ (cl-incf cnt)
(goto-char beg)
- (when (eq fg 'auto)
- (setq fg (face-attribute face :foreground nil 'default)))
- (when (eq bg 'auto)
- (setq bg (face-attribute face :background nil 'default)))
- (setq optnew (copy-sequence opt))
- (plist-put optnew :foreground fg)
- (plist-put optnew :background bg))
- (setq hash (sha1 (prin1-to-string
- (list org-format-latex-header
- org-latex-default-packages-alist
- org-latex-packages-alist
- org-format-latex-options
- forbuffer txt fg bg)))
- linkfile (format "%s_%s.png" prefix hash)
- movefile (format "%s_%s.png" absprefix hash)))
- (setq link (concat block "[[file:" linkfile "]]" block))
- (if msg (message msg cnt))
- (goto-char beg)
- (unless checkdir ; Ensure the directory exists.
- (setq checkdir t)
- (or (file-directory-p todir) (make-directory todir t)))
- (unless (file-exists-p movefile)
- (org-create-formula-image
- txt movefile optnew forbuffer processing-type))
- (if overlays
- (progn
- (mapc (lambda (o)
- (if (eq (overlay-get o 'org-overlay-type)
- 'org-latex-overlay)
- (delete-overlay o)))
- (overlays-in beg end))
- (setq ov (make-overlay beg end))
- (overlay-put ov 'org-overlay-type 'org-latex-overlay)
- (if (featurep 'xemacs)
+ (let* ((processing-info
+ (cdr (assq processing-type org-preview-latex-process-alist)))
+ (face (face-at-point))
+ ;; Get the colors from the face at point.
+ (fg
+ (let ((color (plist-get org-format-latex-options
+ :foreground)))
+ (if (and forbuffer (eq color 'auto))
+ (face-attribute face :foreground nil 'default)
+ color)))
+ (bg
+ (let ((color (plist-get org-format-latex-options
+ :background)))
+ (if (and forbuffer (eq color 'auto))
+ (face-attribute face :background nil 'default)
+ color)))
+ (hash (sha1 (prin1-to-string
+ (list org-format-latex-header
+ org-latex-default-packages-alist
+ org-latex-packages-alist
+ org-format-latex-options
+ forbuffer value fg bg))))
+ (imagetype (or (plist-get processing-info :image-output-type) "png"))
+ (absprefix (expand-file-name prefix dir))
+ (linkfile (format "%s_%s.%s" prefix hash imagetype))
+ (movefile (format "%s_%s.%s" absprefix hash imagetype))
+ (sep (and block-type "\n\n"))
+ (link (concat sep "[[file:" linkfile "]]" sep))
+ (options
+ (org-combine-plists
+ org-format-latex-options
+ `(:foreground ,fg :background ,bg))))
+ (when msg (message msg cnt))
+ (unless checkdir-flag ; Ensure the directory exists.
+ (setq checkdir-flag t)
+ (let ((todir (file-name-directory absprefix)))
+ (unless (file-directory-p todir)
+ (make-directory todir t))))
+ (unless (file-exists-p movefile)
+ (org-create-formula-image
+ value movefile options forbuffer processing-type))
+ (if overlays
(progn
- (overlay-put ov 'invisible t)
- (overlay-put
- ov 'end-glyph
- (make-glyph (vector 'png :file movefile))))
- (overlay-put
- ov 'display
- (list 'image :type 'png :file movefile :ascent 'center)))
- (push ov org-latex-fragment-image-overlays)
- (goto-char end))
- (delete-region beg end)
- (insert (org-add-props link
- (list 'org-latex-src
- (replace-regexp-in-string
- "\"" "" txt)
- 'org-latex-src-embed-type
- (if block-type 'paragraph 'character))))))
- ((eq processing-type 'mathml)
- ;; Process to MathML
- (unless (save-match-data (org-format-latex-mathml-available-p))
- (user-error "LaTeX to MathML converter not configured"))
- (setq txt (match-string n)
- beg (match-beginning n) end (match-end n)
- cnt (1+ cnt))
- (if msg (message msg cnt))
- (goto-char beg)
- (delete-region beg end)
- (insert (org-format-latex-as-mathml
- txt block-type prefix dir)))
- (t
- (error "Unknown conversion type %s for LaTeX fragments"
- processing-type)))))))))
+ (dolist (o (overlays-in beg end))
+ (when (eq (overlay-get o 'org-overlay-type)
+ 'org-latex-overlay)
+ (delete-overlay o)))
+ (org--format-latex-make-overlay beg end movefile imagetype)
+ (goto-char end))
+ (delete-region beg end)
+ (insert
+ (org-add-props link
+ (list 'org-latex-src
+ (replace-regexp-in-string "\"" "" value)
+ 'org-latex-src-embed-type
+ (if block-type 'paragraph 'character)))))))
+ ((eq processing-type 'mathml)
+ ;; Process to MathML.
+ (unless (org-format-latex-mathml-available-p)
+ (user-error "LaTeX to MathML converter not configured"))
+ (cl-incf cnt)
+ (when msg (message msg cnt))
+ (goto-char beg)
+ (delete-region beg end)
+ (insert (org-format-latex-as-mathml
+ value block-type prefix dir)))
+ (t
+ (error "Unknown conversion process %s for LaTeX fragments"
+ processing-type)))))))))))
(defun org-create-math-formula (latex-frag &optional mathml-file)
"Convert LATEX-FRAG to MathML and store it in MATHML-FILE.
@@ -18553,20 +18999,25 @@ inspection."
(buffer-substring-no-properties
(region-beginning) (region-end)))))
(read-string "LaTeX Fragment: " frag nil frag))))
- (unless latex-frag (error "Invalid LaTeX fragment"))
- (let* ((tmp-in-file (file-relative-name
- (make-temp-name (expand-file-name "ltxmathml-in"))))
- (ignore (write-region latex-frag nil tmp-in-file))
+ (unless latex-frag (user-error "Invalid LaTeX fragment"))
+ (let* ((tmp-in-file
+ (let ((file (file-relative-name
+ (make-temp-name (expand-file-name "ltxmathml-in")))))
+ (write-region latex-frag nil file)
+ file))
(tmp-out-file (file-relative-name
(make-temp-name (expand-file-name "ltxmathml-out"))))
(cmd (format-spec
org-latex-to-mathml-convert-command
- `((?j . ,(shell-quote-argument
- (expand-file-name org-latex-to-mathml-jar-file)))
+ `((?j . ,(and org-latex-to-mathml-jar-file
+ (shell-quote-argument
+ (expand-file-name
+ org-latex-to-mathml-jar-file))))
(?I . ,(shell-quote-argument tmp-in-file))
+ (?i . ,latex-frag)
(?o . ,(shell-quote-argument tmp-out-file)))))
mathml shell-command-output)
- (when (org-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(unless (org-format-latex-mathml-available-p)
(user-error "LaTeX to MathML converter not configured")))
(message "Running %s" cmd)
@@ -18576,11 +19027,10 @@ inspection."
(with-current-buffer (find-file-noselect tmp-out-file t)
(goto-char (point-min))
(when (re-search-forward
- (concat
- (regexp-quote
- "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">")
- "\\(.\\|\n\\)*"
- (regexp-quote "</math>")) nil t)
+ (format "<math[^>]*?%s[^>]*?>\\(.\\|\n\\)*</math>"
+ (regexp-quote
+ "xmlns=\"http://www.w3.org/1998/Math/MathML\""))
+ nil t)
(prog1 (match-string 0) (kill-buffer))))))
(cond
(mathml
@@ -18588,7 +19038,7 @@ inspection."
(concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml))
(when mathml-file
(write-region mathml nil mathml-file))
- (when (org-called-interactively-p 'any)
+ (when (called-interactively-p 'any)
(message mathml)))
((message "LaTeX to MathML conversion failed")
(message shell-command-output)))
@@ -18627,186 +19077,117 @@ inspection."
;; Failed conversion. Return the LaTeX fragment verbatim
latex-frag)))
-(defun org-create-formula-image (string tofile options buffer &optional type)
- "Create an image from LaTeX source using dvipng or convert.
-This function calls either `org-create-formula-image-with-dvipng'
-or `org-create-formula-image-with-imagemagick' depending on the
-value of `org-latex-create-formula-image-program' or on the value
-of the optional TYPE variable.
-
-Note: ultimately these two function should be combined as they
-share a good deal of logic."
- (org-check-external-command
- "latex" "needed to convert LaTeX fragments to images")
- (funcall
- (case (or type org-latex-create-formula-image-program)
- ('dvipng
- (org-check-external-command
- "dvipng" "needed to convert LaTeX fragments to images")
- #'org-create-formula-image-with-dvipng)
- ('imagemagick
- (org-check-external-command
- "convert" "you need to install imagemagick")
- #'org-create-formula-image-with-imagemagick)
- (t (error
- "Invalid value of `org-latex-create-formula-image-program'")))
- string tofile options buffer))
-
-(declare-function org-export-get-backend "ox" (name))
-(declare-function org-export--get-global-options "ox" (&optional backend))
-(declare-function org-export--get-inbuffer-options "ox" (&optional backend))
-(declare-function org-latex-guess-inputenc "ox-latex" (header))
-(declare-function org-latex-guess-babel-language "ox-latex" (header info))
-(defun org-create-formula--latex-header ()
- "Return LaTeX header appropriate for previewing a LaTeX snippet."
- (let ((info (org-combine-plists (org-export--get-global-options
- (org-export-get-backend 'latex))
- (org-export--get-inbuffer-options
- (org-export-get-backend 'latex)))))
- (org-latex-guess-babel-language
- (org-latex-guess-inputenc
- (org-splice-latex-header
- org-format-latex-header
- org-latex-default-packages-alist
- org-latex-packages-alist t
- (plist-get info :latex-header)))
- info)))
-
-;; This function borrows from Ganesh Swami's latex2png.el
-(defun org-create-formula-image-with-dvipng (string tofile options buffer)
- "This calls dvipng."
- (require 'ox-latex)
- (let* ((tmpdir (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
+(defun org--get-display-dpi ()
+ "Get the DPI of the display.
+The function assumes that the display has the same pixel width in
+the horizontal and vertical directions."
+ (if (display-graphic-p)
+ (round (/ (display-pixel-height)
+ (/ (display-mm-height) 25.4)))
+ (error "Attempt to calculate the dpi of a non-graphic display")))
+
+(defun org-create-formula-image
+ (string tofile options buffer &optional processing-type)
+ "Create an image from LaTeX source using external processes.
+
+The LaTeX STRING is saved to a temporary LaTeX file, then
+converted to an image file by process PROCESSING-TYPE defined in
+`org-preview-latex-process-alist'. A nil value defaults to
+`org-preview-latex-default-process'.
+
+The generated image file is eventually moved to TOFILE.
+
+The OPTIONS argument controls the size, foreground color and
+background color of the generated image.
+
+When BUFFER non-nil, this function is used for LaTeX previewing.
+Otherwise, it is used to deal with LaTeX snippets showed in
+a HTML file."
+ (let* ((processing-type (or processing-type
+ org-preview-latex-default-process))
+ (processing-info
+ (cdr (assq processing-type org-preview-latex-process-alist)))
+ (programs (plist-get processing-info :programs))
+ (error-message (or (plist-get processing-info :message) ""))
+ (use-xcolor (plist-get processing-info :use-xcolor))
+ (image-input-type (plist-get processing-info :image-input-type))
+ (image-output-type (plist-get processing-info :image-output-type))
+ (post-clean (or (plist-get processing-info :post-clean)
+ '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log"
+ ".svg" ".png" ".jpg" ".jpeg" ".out")))
+ (latex-header
+ (or (plist-get processing-info :latex-header)
+ (org-latex-make-preamble
+ (org-export-get-environment (org-export-get-backend 'latex))
+ org-format-latex-header
+ 'snippet)))
+ (latex-compiler (plist-get processing-info :latex-compiler))
+ (image-converter (plist-get processing-info :image-converter))
+ (tmpdir temporary-file-directory)
(texfilebase (make-temp-name
(expand-file-name "orgtex" tmpdir)))
(texfile (concat texfilebase ".tex"))
- (dvifile (concat texfilebase ".dvi"))
- (pngfile (concat texfilebase ".png"))
- (fnh (if (featurep 'xemacs)
- (font-height (face-font 'default))
- (face-attribute 'default :height nil)))
- (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ (image-size-adjust (or (plist-get processing-info :image-size-adjust)
+ '(1.0 . 1.0)))
+ (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust))
+ (or (plist-get options (if buffer :scale :html-scale)) 1.0)))
+ (dpi (* scale (if buffer (org--get-display-dpi) 140.0)))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"Black"))
(bg (or (plist-get options (if buffer :background :html-background))
- "Transparent")))
- (if (eq fg 'default) (setq fg (org-dvipng-color :foreground))
- (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg))))
- (if (eq bg 'default) (setq bg (org-dvipng-color :background))
- (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg))))
- (let ((latex-header (org-create-formula--latex-header)))
+ "Transparent"))
+ (log-buf (get-buffer-create "*Org Preview LaTeX Output*"))
+ (resize-mini-windows nil)) ;Fix Emacs flicker when creating image.
+ (dolist (program programs)
+ (org-check-external-command program error-message))
+ (if use-xcolor
+ (progn (if (eq fg 'default)
+ (setq fg (org-latex-color :foreground))
+ (setq fg (org-latex-color-format fg)))
+ (if (eq bg 'default)
+ (setq bg (org-latex-color :background))
+ (setq bg (org-latex-color-format
+ (if (string= bg "Transparent") "white" bg))))
+ (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"
+ "\n{\\color{fg}\n"
+ string
+ "\n}\n"
+ "\n\\end{document}\n")))
+ (if (eq fg 'default)
+ (setq fg (org-dvipng-color :foreground))
+ (unless (string= fg "Transparent")
+ (setq fg (org-dvipng-color-format fg))))
+ (if (eq bg 'default)
+ (setq bg (org-dvipng-color :background))
+ (unless (string= bg "Transparent")
+ (setq bg (org-dvipng-color-format bg))))
(with-temp-file texfile
(insert latex-header)
(insert "\n\\begin{document}\n" string "\n\\end{document}\n")))
- (let ((dir default-directory))
- (condition-case nil
- (progn
- (cd tmpdir)
- (call-process "latex" nil nil nil texfile))
- (error nil))
- (cd dir))
- (if (not (file-exists-p dvifile))
- (progn (message "Failed to create dvi file from %s" texfile) nil)
- (condition-case nil
- (if (featurep 'xemacs)
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-T" "tight"
- "-o" pngfile
- dvifile)
- (call-process "dvipng" nil nil nil
- "-fg" fg "-bg" bg
- "-D" dpi
- ;;"-x" scale "-y" scale
- "-T" "tight"
- "-o" pngfile
- dvifile))
- (error nil))
- (if (not (file-exists-p pngfile))
- (if org-format-latex-signal-error
- (error "Failed to create png file from %s" texfile)
- (message "Failed to create png file from %s" texfile)
- nil)
- ;; Use the requested file name and clean up
- (copy-file pngfile tofile 'replace)
- (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do
- (if (file-exists-p (concat texfilebase e))
- (delete-file (concat texfilebase e))))
- pngfile))))
-
-(declare-function org-latex-compile "ox-latex" (texfile &optional snippet))
-(defun org-create-formula-image-with-imagemagick (string tofile options buffer)
- "This calls convert, which is included into imagemagick."
- (require 'ox-latex)
- (let* ((tmpdir (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
- (texfilebase (make-temp-name
- (expand-file-name "orgtex" tmpdir)))
- (texfile (concat texfilebase ".tex"))
- (pdffile (concat texfilebase ".pdf"))
- (pngfile (concat texfilebase ".png"))
- (fnh (if (featurep 'xemacs)
- (font-height (face-font 'default))
- (face-attribute 'default :height nil)))
- (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (floor (if buffer fnh 120.)))))
- (fg (or (plist-get options (if buffer :foreground :html-foreground))
- "black"))
- (bg (or (plist-get options (if buffer :background :html-background))
- "white")))
- (if (eq fg 'default) (setq fg (org-latex-color :foreground))
- (setq fg (org-latex-color-format fg)))
- (if (eq bg 'default) (setq bg (org-latex-color :background))
- (setq bg (org-latex-color-format
- (if (string= bg "Transparent") "white" bg))))
- (let ((latex-header (org-create-formula--latex-header)))
- (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"
- "\n{\\color{fg}\n"
- string
- "\n}\n"
- "\n\\end{document}\n")))
- (org-latex-compile texfile t)
- (if (not (file-exists-p pdffile))
- (progn (message "Failed to create pdf file from %s" texfile) nil)
- (condition-case nil
- (if (featurep 'xemacs)
- (call-process "convert" nil nil nil
- "-density" "96"
- "-trim"
- "-antialias"
- pdffile
- "-quality" "100"
- ;; "-sharpen" "0x1.0"
- pngfile)
- (call-process "convert" nil nil nil
- "-density" dpi
- "-trim"
- "-antialias"
- pdffile
- "-quality" "100"
- ;; "-sharpen" "0x1.0"
- pngfile))
- (error nil))
- (if (not (file-exists-p pngfile))
- (if org-format-latex-signal-error
- (error "Failed to create png file from %s" texfile)
- (message "Failed to create png file from %s" texfile)
- nil)
- ;; Use the requested file name and clean up
- (copy-file pngfile tofile 'replace)
- (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do
- (if (file-exists-p (concat texfilebase e))
- (delete-file (concat texfilebase e))))
- pngfile))))
+
+ (let* ((err-msg (format "Please adjust `%s' part of \
+`org-preview-latex-process-alist'."
+ processing-type))
+ (image-input-file
+ (org-compile-file
+ texfile latex-compiler image-input-type err-msg log-buf))
+ (image-output-file
+ (org-compile-file
+ image-input-file image-converter image-output-type err-msg log-buf
+ `((?F . ,(shell-quote-argument fg))
+ (?B . ,(shell-quote-argument bg))
+ (?D . ,(shell-quote-argument (format "%s" dpi)))
+ (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0))))))))
+ (copy-file image-output-file tofile 'replace)
+ (dolist (e post-clean)
+ (when (file-exists-p (concat texfilebase e))
+ (delete-file (concat texfilebase e))))
+ image-output-file)))
(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra)
"Fill a LaTeX header template TPL.
@@ -18830,22 +19211,22 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
(setq rpl (if (or (match-end 1) (not def-pkg))
"" (org-latex-packages-to-string def-pkg snippets-p t))
tpl (replace-match rpl t t tpl))
- (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
+ (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p))))
(if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl)
(setq rpl (if (or (match-end 1) (not pkg))
"" (org-latex-packages-to-string pkg snippets-p t))
tpl (replace-match rpl t t tpl))
- (if pkg (setq end
- (concat end "\n"
- (org-latex-packages-to-string pkg snippets-p)))))
+ (when pkg (setq end
+ (concat end "\n"
+ (org-latex-packages-to-string pkg snippets-p)))))
(if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl)
(setq rpl (if (or (match-end 1) (not extra))
"" (concat extra "\n"))
tpl (replace-match rpl t t tpl))
- (if (and extra (string-match "\\S-" extra))
- (setq end (concat end "\n" extra))))
+ (when (and extra (string-match "\\S-" extra))
+ (setq end (concat end "\n" extra))))
(if (string-match "\\S-" end)
(concat tpl "\n" end)
@@ -18869,35 +19250,21 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
(defun org-dvipng-color (attr)
"Return a RGB color specification for dvipng."
- (apply 'format "rgb %s %s %s"
- (mapcar 'org-normalize-color
- (if (featurep 'xemacs)
- (color-rgb-components
- (face-property 'default
- (cond ((eq attr :foreground) 'foreground)
- ((eq attr :background) 'background))))
- (color-values (face-attribute 'default attr nil))))))
+ (org-dvipng-color-format (face-attribute 'default attr nil)))
(defun org-dvipng-color-format (color-name)
"Convert COLOR-NAME to a RGB color value for dvipng."
- (apply 'format "rgb %s %s %s"
+ (apply #'format "rgb %s %s %s"
(mapcar 'org-normalize-color
- (color-values color-name))))
+ (color-values color-name))))
(defun org-latex-color (attr)
"Return a RGB color for the LaTeX color package."
- (apply 'format "%s,%s,%s"
- (mapcar 'org-normalize-color
- (if (featurep 'xemacs)
- (color-rgb-components
- (face-property 'default
- (cond ((eq attr :foreground) 'foreground)
- ((eq attr :background) 'background))))
- (color-values (face-attribute 'default attr nil))))))
+ (org-latex-color-format (face-attribute 'default attr nil)))
(defun org-latex-color-format (color-name)
"Convert COLOR-NAME to a RGB color value."
- (apply 'format "%s,%s,%s"
+ (apply #'format "%s,%s,%s"
(mapcar 'org-normalize-color
(color-values color-name))))
@@ -18909,8 +19276,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML."
;; Image display
-(defvar org-inline-image-overlays nil)
-(make-variable-buffer-local 'org-inline-image-overlays)
+(defvar-local org-inline-image-overlays nil)
(defun org-toggle-inline-images (&optional include-linked)
"Toggle the display of inline images.
@@ -18919,13 +19285,14 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(if org-inline-image-overlays
(progn
(org-remove-inline-images)
- (message "Inline image display turned off"))
+ (when (called-interactively-p 'interactive)
+ (message "Inline image display turned off")))
(org-display-inline-images include-linked)
- (if (and (org-called-interactively-p)
- org-inline-image-overlays)
- (message "%d images displayed inline"
- (length org-inline-image-overlays))
- (message "No images to display inline"))))
+ (when (called-interactively-p 'interactive)
+ (message (if org-inline-image-overlays
+ (format "%d images displayed inline"
+ (length org-inline-image-overlays))
+ "No images to display inline")))))
(defun org-redisplay-inline-images ()
"Refresh the display of inline images."
@@ -18937,68 +19304,115 @@ INCLUDE-LINKED is passed to `org-display-inline-images'."
(defun org-display-inline-images (&optional include-linked refresh beg end)
"Display inline images.
-Normally only links without a description part are inlined, because this
-is how it will work for export. When INCLUDE-LINKED is set, also links
-with a description part will be inlined. This can be nice for a quick
-look at those images, but it does not reflect what exported files will look
-like.
-When REFRESH is set, refresh existing images between BEG and END.
-This will create new image displays only if necessary.
-BEG and END default to the buffer boundaries."
+
+An inline image is a link which follows either of these
+conventions:
+
+ 1. Its path is a file with an extension matching return value
+ from `image-file-name-regexp' and it has no contents.
+
+ 2. Its description consists in a single link of the previous
+ type.
+
+When optional argument INCLUDE-LINKED is non-nil, also links with
+a text description part will be inlined. This can be nice for
+a quick look at those images, but it does not reflect what
+exported files will look like.
+
+When optional argument REFRESH is non-nil, refresh existing
+images between BEG and END. This will create new image displays
+only if necessary. BEG and END default to the buffer
+boundaries."
(interactive "P")
(when (display-graphic-p)
(unless refresh
(org-remove-inline-images)
- (if (fboundp 'clear-image-cache) (clear-image-cache)))
- (save-excursion
- (save-restriction
- (widen)
- (setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char beg)
- (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (org-image-file-name-regexp) 0 -2)
- "\\)\\]" (if include-linked "" "\\]")))
- (case-fold-search t)
- old file ov img type attrwidth width)
- (while (re-search-forward re end t)
- (setq old (get-char-property-and-overlay (match-beginning 1)
- 'org-image-overlay)
- file (expand-file-name
- (concat (or (match-string 3) "") (match-string 4))))
- (when (image-type-available-p 'imagemagick)
- (setq attrwidth (if (or (listp org-image-actual-width)
- (null org-image-actual-width))
- (save-excursion
- (save-match-data
- (when (re-search-backward
- "#\\+attr.*:width[ \t]+\\([^ ]+\\)"
- (save-excursion
- (re-search-backward "^[ \t]*$\\|\\`" nil t)) t)
- (string-to-number (match-string 1))))))
- width (cond ((eq org-image-actual-width t) nil)
- ((null org-image-actual-width) attrwidth)
- ((numberp org-image-actual-width)
- org-image-actual-width)
- ((listp org-image-actual-width)
- (or attrwidth (car org-image-actual-width))))
- type (if width 'imagemagick)))
- (when (file-exists-p file)
- (if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
- (setq img (save-match-data (create-image file type nil :width width)))
- (when img
- (setq ov (make-overlay (match-beginning 0) (match-end 0)))
- (overlay-put ov 'display img)
- (overlay-put ov 'face 'default)
- (overlay-put ov 'org-image-overlay t)
- (overlay-put ov 'modification-hooks
- (list 'org-display-inline-remove-overlay))
- (push ov org-inline-image-overlays))))))))))
-
-(define-obsolete-function-alias
- 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3")
-
-(defun org-display-inline-remove-overlay (ov after beg end &optional len)
+ (when (fboundp 'clear-image-cache) (clear-image-cache)))
+ (org-with-wide-buffer
+ (goto-char (or beg (point-min)))
+ (let* ((case-fold-search t)
+ (file-extension-re (image-file-name-regexp))
+ (link-abbrevs (mapcar #'car
+ (append org-link-abbrev-alist-local
+ org-link-abbrev-alist)))
+ ;; Check absolute, relative file names and explicit
+ ;; "file:" links. Also check link abbreviations since
+ ;; some might expand to "file" links.
+ (file-types-re (format "[][]\\[\\(?:file\\|[./~]%s\\)"
+ (if (not link-abbrevs) ""
+ (format "\\|\\(?:%s:\\)"
+ (regexp-opt link-abbrevs))))))
+ (while (re-search-forward file-types-re end t)
+ (let ((link (save-match-data (org-element-context))))
+ ;; Check if we're at an inline image, i.e., an image file
+ ;; link without a description (unless INCLUDE-LINKED is
+ ;; non-nil).
+ (when (and (equal "file" (org-element-property :type link))
+ (or include-linked
+ (null (org-element-contents link)))
+ (string-match-p file-extension-re
+ (org-element-property :path link)))
+ (let ((file (expand-file-name
+ (org-link-unescape
+ (org-element-property :path link)))))
+ (when (file-exists-p file)
+ (let ((width
+ ;; Apply `org-image-actual-width' specifications.
+ (cond
+ ((not (image-type-available-p 'imagemagick)) nil)
+ ((eq org-image-actual-width t) nil)
+ ((listp org-image-actual-width)
+ (or
+ ;; First try to find a width among
+ ;; attributes associated to the paragraph
+ ;; containing link.
+ (let ((paragraph
+ (let ((e link))
+ (while (and (setq e (org-element-property
+ :parent e))
+ (not (eq (org-element-type e)
+ 'paragraph))))
+ e)))
+ (when paragraph
+ (save-excursion
+ (goto-char (org-element-property :begin paragraph))
+ (when
+ (re-search-forward
+ "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)"
+ (org-element-property
+ :post-affiliated paragraph)
+ t)
+ (string-to-number (match-string 1))))))
+ ;; Otherwise, fall-back to provided number.
+ (car org-image-actual-width)))
+ ((numberp org-image-actual-width)
+ org-image-actual-width)))
+ (old (get-char-property-and-overlay
+ (org-element-property :begin link)
+ 'org-image-overlay)))
+ (if (and (car-safe old) refresh)
+ (image-refresh (overlay-get (cdr old) 'display))
+ (let ((image (create-image file
+ (and width 'imagemagick)
+ nil
+ :width width)))
+ (when image
+ (let ((ov (make-overlay
+ (org-element-property :begin link)
+ (progn
+ (goto-char
+ (org-element-property :end link))
+ (skip-chars-backward " \t")
+ (point)))))
+ (overlay-put ov 'display image)
+ (overlay-put ov 'face 'default)
+ (overlay-put ov 'org-image-overlay t)
+ (overlay-put
+ ov 'modification-hooks
+ (list 'org-display-inline-remove-overlay))
+ (push ov org-inline-image-overlays)))))))))))))))
+
+(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
(let ((inhibit-modification-hooks t))
(when (and ov after)
@@ -19008,52 +19422,62 @@ BEG and END default to the buffer boundaries."
(defun org-remove-inline-images ()
"Remove inline display of images."
(interactive)
- (mapc 'delete-overlay org-inline-image-overlays)
+ (mapc #'delete-overlay org-inline-image-overlays)
(setq org-inline-image-overlays nil))
;;;; Key bindings
+(defun org-remap (map &rest commands)
+ "In MAP, remap the functions given in COMMANDS.
+COMMANDS is a list of alternating OLDDEF NEWDEF command names."
+ (let (new old)
+ (while commands
+ (setq old (pop commands) new (pop commands))
+ (org-defkey map (vector 'remap old) new))))
+
;; Outline functions from `outline-mode-prefix-map'
;; that can be remapped in Org:
(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree)
-(define-key org-mode-map [remap show-subtree] 'org-show-subtree)
+(define-key org-mode-map [remap outline-show-subtree] 'org-show-subtree)
(define-key org-mode-map [remap outline-forward-same-level]
'org-forward-heading-same-level)
(define-key org-mode-map [remap outline-backward-same-level]
'org-backward-heading-same-level)
-(define-key org-mode-map [remap show-branches]
+(define-key org-mode-map [remap outline-show-branches]
'org-kill-note-or-show-branches)
(define-key org-mode-map [remap outline-promote] 'org-promote-subtree)
(define-key org-mode-map [remap outline-demote] 'org-demote-subtree)
(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret)
+(define-key org-mode-map [remap outline-next-visible-heading]
+ 'org-next-visible-heading)
+(define-key org-mode-map [remap outline-previous-visible-heading]
+ 'org-previous-visible-heading)
+(define-key org-mode-map [remap show-children] 'org-show-children)
;; Outline functions from `outline-mode-prefix-map' that can not
;; be remapped in Org:
-;;
+
;; - the column "key binding" shows whether the Outline function is still
;; available in Org mode on the same key that it has been bound to in
;; Outline mode:
;; - "overridden": key used for a different functionality in Org mode
;; - else: key still bound to the same Outline function in Org mode
-;;
-;; | Outline function | key binding | Org replacement |
-;; |------------------------------------+-------------+-----------------------|
-;; | `outline-next-visible-heading' | `C-c C-n' | still same function |
-;; | `outline-previous-visible-heading' | `C-c C-p' | still same function |
-;; | `outline-up-heading' | `C-c C-u' | still same function |
-;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
-;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
-;; | `show-entry' | overridden | no replacement |
-;; | `show-children' | `C-c C-i' | visibility cycling |
-;; | `show-branches' | `C-c C-k' | still same function |
-;; | `show-subtree' | overridden | visibility cycling |
-;; | `show-all' | overridden | no replacement |
-;; | `hide-subtree' | overridden | visibility cycling |
-;; | `hide-body' | overridden | no replacement |
-;; | `hide-entry' | overridden | visibility cycling |
-;; | `hide-leaves' | overridden | no replacement |
-;; | `hide-sublevels' | overridden | no replacement |
-;; | `hide-other' | overridden | no replacement |
+
+;; | Outline function | key binding | Org replacement |
+;; |------------------------------------+-------------+--------------------------|
+;; | `outline-up-heading' | `C-c C-u' | still same function |
+;; | `outline-move-subtree-up' | overridden | better: org-shiftup |
+;; | `outline-move-subtree-down' | overridden | better: org-shiftdown |
+;; | `show-entry' | overridden | no replacement |
+;; | `show-branches' | `C-c C-k' | still same function |
+;; | `show-subtree' | overridden | visibility cycling |
+;; | `show-all' | overridden | no replacement |
+;; | `hide-subtree' | overridden | visibility cycling |
+;; | `hide-body' | overridden | no replacement |
+;; | `hide-entry' | overridden | visibility cycling |
+;; | `hide-leaves' | overridden | no replacement |
+;; | `hide-sublevels' | overridden | no replacement |
+;; | `hide-other' | overridden | no replacement |
;; Make `C-c C-x' a prefix key
(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap))
@@ -19063,15 +19487,15 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map [(tab)] 'org-cycle)
(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived)
(org-defkey org-mode-map "\M-\t" #'pcomplete)
+
;; The following line is necessary under Suse GNU/Linux
-(unless (featurep 'xemacs)
- (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab))
+(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)
(org-defkey org-mode-map [(shift tab)] 'org-shifttab)
(define-key org-mode-map [backtab] 'org-shifttab)
(org-defkey org-mode-map [(shift return)] 'org-table-copy-down)
(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading)
-(org-defkey org-mode-map [(meta return)] 'org-meta-return)
+(org-defkey org-mode-map (kbd "M-RET") #'org-meta-return)
;; Cursor keys with modifiers
(org-defkey org-mode-map [(meta left)] 'org-metaleft)
@@ -19079,6 +19503,8 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map [(meta up)] 'org-metaup)
(org-defkey org-mode-map [(meta down)] 'org-metadown)
+(org-defkey org-mode-map [(control meta shift right)] 'org-increase-number-at-point)
+(org-defkey org-mode-map [(control meta shift left)] 'org-decrease-number-at-point)
(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft)
(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright)
(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup)
@@ -19096,17 +19522,14 @@ BEG and END default to the buffer boundaries."
;; Babel keys
(define-key org-mode-map org-babel-key-prefix org-babel-map)
-(mapc (lambda (pair)
- (define-key org-babel-map (car pair) (cdr pair)))
- org-babel-key-bindings)
+(dolist (pair org-babel-key-bindings)
+ (define-key org-babel-map (car pair) (cdr pair)))
;;; Extra keys for tty access.
;; We only set them when really needed because otherwise the
;; menus don't show the simple keys
-(when (or org-use-extra-keys
- (featurep 'xemacs) ;; because XEmacs supports multi-device stuff
- (not window-system))
+(when (or org-use-extra-keys (not window-system))
(org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down)
(org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading)
(org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return)
@@ -19137,8 +19560,13 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown))
;; All the other keys
+(org-remap org-mode-map
+ 'self-insert-command 'org-self-insert-command
+ 'delete-char 'org-delete-char
+ 'delete-backward-char 'org-delete-backward-char)
+(org-defkey org-mode-map "|" 'org-force-self-insert)
-(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up.
+(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up.
(org-defkey org-mode-map "\C-c\C-r" 'org-reveal)
(if (boundp 'narrow-map)
(org-defkey narrow-map "s" 'org-narrow-to-subtree)
@@ -19177,7 +19605,6 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved
(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res.
(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret)
-(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading)
(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift)
(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible)
(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content)
@@ -19185,6 +19612,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link)
(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link)
(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link)
+(org-defkey org-mode-map "\C-c\M-l" 'org-insert-last-stored-link)
(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links)
(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point)
(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push)
@@ -19209,8 +19637,10 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
(org-defkey org-mode-map [remap open-line] 'org-open-line)
+(org-defkey org-mode-map [remap comment-dwim] 'org-comment-dwim)
(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
+(org-defkey org-mode-map "\M-^" 'org-delete-indentation)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-j" 'org-return-indent)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
@@ -19219,6 +19649,8 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula)
(org-defkey org-mode-map "\C-c'" 'org-edit-special)
(org-defkey org-mode-map "\C-c`" 'org-table-edit-field)
+(org-defkey org-mode-map "\C-c\"a" 'orgtbl-ascii-plot)
+(org-defkey org-mode-map "\C-c\"g" 'org-plot/gnuplot)
(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region)
(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks)
(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el)
@@ -19226,7 +19658,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays)
(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger)
(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch)
-(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section)
+(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width)
(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize)
(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action)
(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
@@ -19250,7 +19682,7 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display)
(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report)
(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update)
-(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment)
+(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-toggle-latex-fragment)
(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images)
(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images)
(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities)
@@ -19260,9 +19692,8 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort)
(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort)
(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property)
-(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock)
+(org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock)
(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer)
-(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer)
(org-defkey org-mode-map "\C-c\C-x." 'org-timer)
(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item)
@@ -19280,15 +19711,11 @@ BEG and END default to the buffer boundaries."
(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation)
-(when (featurep 'xemacs)
- (org-defkey org-mode-map 'button3 'popup-mode-menu))
-
-
(defconst org-speed-commands-default
'(
("Outline Navigation")
- ("n" . (org-speed-move-safe 'outline-next-visible-heading))
- ("p" . (org-speed-move-safe 'outline-previous-visible-heading))
+ ("n" . (org-speed-move-safe 'org-next-visible-heading))
+ ("p" . (org-speed-move-safe 'org-previous-visible-heading))
("f" . (org-speed-move-safe 'org-forward-heading-same-level))
("b" . (org-speed-move-safe 'org-backward-heading-same-level))
("F" . org-next-block)
@@ -19303,8 +19730,8 @@ BEG and END default to the buffer boundaries."
("s" . org-narrow-to-subtree)
("=" . org-columns)
("Outline Structure Editing")
- ("U" . org-shiftmetaup)
- ("D" . org-shiftmetadown)
+ ("U" . org-metaup)
+ ("D" . org-metadown)
("r" . org-metaright)
("l" . org-metaleft)
("R" . org-shiftmetaright)
@@ -19364,10 +19791,10 @@ BEG and END default to the buffer boundaries."
(user-error "Speed commands are not activated, customize `org-use-speed-commands'")
(with-output-to-temp-buffer "*Help*"
(princ "User-defined Speed commands\n===========================\n")
- (mapc 'org-print-speed-command org-speed-commands-user)
+ (mapc #'org-print-speed-command org-speed-commands-user)
(princ "\n")
(princ "Built-in Speed commands\n=======================\n")
- (mapc 'org-print-speed-command org-speed-commands-default))
+ (mapc #'org-print-speed-command org-speed-commands-default))
(with-current-buffer "*Help*"
(setq truncate-lines t))))
@@ -19386,9 +19813,6 @@ If not, return to the original position and throw an error."
(defvar org-table-auto-blank-field) ; defined in org-table.el
(defvar org-speed-command nil)
-(define-obsolete-function-alias
- 'org-speed-command-default-hook 'org-speed-command-activate "24.3")
-
(defun org-speed-command-activate (keys)
"Hook for activating single-letter speed commands.
`org-speed-commands-default' specifies a minimal command set.
@@ -19399,16 +19823,13 @@ Use `org-speed-commands-user' for further customization."
(cdr (assoc keys (append org-speed-commands-user
org-speed-commands-default)))))
-(define-obsolete-function-alias
- 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3")
-
(defun org-babel-speed-command-activate (keys)
"Hook for activating single-letter code block commands."
(when (and (bolp) (looking-at org-babel-src-block-regexp))
(cdr (assoc keys org-babel-key-bindings))))
(defcustom org-speed-command-hook
- '(org-speed-command-default-hook org-babel-speed-command-hook)
+ '(org-speed-command-activate org-babel-speed-command-activate)
"Hook for activating speed commands at strategic locations.
Hook functions are called in sequence until a valid handler is
found.
@@ -19434,9 +19855,11 @@ overwritten, and the table is not marked as requiring realignment."
(org-check-before-invisible-edit 'insert)
(cond
((and org-use-speed-commands
- (setq org-speed-command
- (run-hook-with-args-until-success
- 'org-speed-command-hook (this-command-keys))))
+ (let ((kv (this-command-keys-vector)))
+ (setq org-speed-command
+ (run-hook-with-args-until-success
+ 'org-speed-command-hook
+ (make-string 1 (aref kv (1- (length kv))))))))
(cond
((commandp org-speed-command)
(setq this-command org-speed-command)
@@ -19448,94 +19871,116 @@ overwritten, and the table is not marked as requiring realignment."
(t (let (org-use-speed-commands)
(call-interactively 'org-self-insert-command)))))
((and
- (org-table-p)
+ (org-at-table-p)
+ (eq N 1)
+ (not (org-region-active-p))
(progn
- ;; check if we blank the field, and if that triggers align
+ ;; Check if we blank the field, and if that triggers align.
(and (featurep 'org-table) org-table-auto-blank-field
- (member last-command
- '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand))
- (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |"))
- ;; got extra space, this field does not determine column width
+ (memq last-command
+ '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c))
+ (if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |"))
+ ;; Got extra space, this field does not determine
+ ;; column width.
(let (org-table-may-need-update) (org-table-blank-field))
- ;; no extra space, this field may determine column width
+ ;; No extra space, this field may determine column
+ ;; width.
(org-table-blank-field)))
t)
- (eq N 1)
- (looking-at "[^|\n]* |"))
- (let (org-table-may-need-update)
- (goto-char (1- (match-end 0)))
- (backward-delete-char 1)
- (goto-char (match-beginning 0))
- (self-insert-command N)))
+ (looking-at "[^|\n]* \\( \\)|"))
+ ;; There is room for insertion without re-aligning the table.
+ (delete-region (match-beginning 1) (match-end 1))
+ (self-insert-command N))
(t
(setq org-table-may-need-update t)
(self-insert-command N)
(org-fix-tags-on-the-fly)
- (if org-self-insert-cluster-for-undo
- (if (not (eq last-command 'org-self-insert-command))
+ (when org-self-insert-cluster-for-undo
+ (if (not (eq last-command 'org-self-insert-command))
+ (setq org-self-insert-command-undo-counter 1)
+ (if (>= org-self-insert-command-undo-counter 20)
(setq org-self-insert-command-undo-counter 1)
- (if (>= org-self-insert-command-undo-counter 20)
- (setq org-self-insert-command-undo-counter 1)
- (and (> org-self-insert-command-undo-counter 0)
- buffer-undo-list (listp buffer-undo-list)
- (not (cadr buffer-undo-list)) ; remove nil entry
- (setcdr buffer-undo-list (cddr buffer-undo-list)))
- (setq org-self-insert-command-undo-counter
- (1+ org-self-insert-command-undo-counter))))))))
+ (and (> org-self-insert-command-undo-counter 0)
+ buffer-undo-list (listp buffer-undo-list)
+ (not (cadr buffer-undo-list)) ; remove nil entry
+ (setcdr buffer-undo-list (cddr buffer-undo-list)))
+ (setq org-self-insert-command-undo-counter
+ (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.
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
- (if (and org-catch-invisible-edits
- (or (not (boundp 'visible-mode)) (not visible-mode))
- (or (get-char-property (point) 'invisible)
- (get-char-property (max (point-min) (1- (point))) 'invisible)))
- ;; OK, we need to take a closer look
- (let* ((invisible-at-point (get-char-property (point) 'invisible))
- (invisible-before-point (if (bobp) nil (get-char-property
- (1- (point)) 'invisible)))
- (border-and-ok-direction
- (or
- ;; Check if we are acting predictably before invisible text
- (and invisible-at-point (not invisible-before-point)
- (memq kind '(insert delete-backward)))
- ;; Check if we are acting predictably after invisible text
- ;; This works not well, and I have turned it off. It seems
- ;; better to always show and stop after invisible text.
- ;; (and (not invisible-at-point) invisible-before-point
- ;; (memq kind '(insert delete)))
- )))
- (when (or (memq invisible-at-point '(outline org-hide-block t))
- (memq invisible-before-point '(outline org-hide-block t)))
- (if (eq org-catch-invisible-edits 'error)
- (user-error "Editing in invisible areas is prohibited, make them visible first"))
- (if (and org-custom-properties-overlays
- (y-or-n-p "Display invisible properties in this buffer? "))
- (org-toggle-custom-properties-visibility)
- ;; Make the area visible
- (save-excursion
- (if invisible-before-point
- (goto-char (previous-single-char-property-change
- (point) 'invisible)))
- (show-subtree))
- (cond
- ((eq org-catch-invisible-edits 'show)
- ;; That's it, we do the edit after showing
- (message
- "Unfolding invisible region around point before editing")
- (sit-for 1))
- ((and (eq org-catch-invisible-edits 'smart)
- border-and-ok-direction)
- (message "Unfolding invisible region around point before editing"))
- (t
- ;; Don't do the edit, make the user repeat it in full visibility
- (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
+ (when (and org-catch-invisible-edits
+ (or (not (boundp 'visible-mode)) (not visible-mode))
+ (or (get-char-property (point) 'invisible)
+ (get-char-property (max (point-min) (1- (point))) 'invisible)))
+ ;; OK, we need to take a closer look. Do not consider
+ ;; invisibility obtained through text properties (e.g., link
+ ;; fontification), as it cannot be toggled.
+ (let* ((invisible-at-point
+ (pcase (get-char-property-and-overlay (point) 'invisible)
+ (`(,_ . ,(and (pred overlayp) o)) o)))
+ ;; Assume that point cannot land in the middle of an
+ ;; overlay, or between two overlays.
+ (invisible-before-point
+ (and (not invisible-at-point)
+ (not (bobp))
+ (pcase (get-char-property-and-overlay (1- (point)) 'invisible)
+ (`(,_ . ,(and (pred overlayp) o)) o))))
+ (border-and-ok-direction
+ (or
+ ;; Check if we are acting predictably before invisible
+ ;; text.
+ (and invisible-at-point
+ (memq kind '(insert delete-backward)))
+ ;; Check if we are acting predictably after invisible text
+ ;; This works not well, and I have turned it off. It seems
+ ;; better to always show and stop after invisible text.
+ ;; (and (not invisible-at-point) invisible-before-point
+ ;; (memq kind '(insert delete)))
+ )))
+ (when (or invisible-at-point invisible-before-point)
+ (when (eq org-catch-invisible-edits 'error)
+ (user-error "Editing in invisible areas is prohibited, make them visible first"))
+ (if (and org-custom-properties-overlays
+ (y-or-n-p "Display invisible properties in this buffer? "))
+ (org-toggle-custom-properties-visibility)
+ ;; Make the area visible
+ (save-excursion
+ (when invisible-before-point
+ (goto-char
+ (previous-single-char-property-change (point) 'invisible)))
+ ;; Remove whatever overlay is currently making yet-to-be
+ ;; edited text invisible. Also remove nested invisibility
+ ;; related overlays.
+ (delete-overlay (or invisible-at-point invisible-before-point))
+ (let ((origin (if invisible-at-point (point) (1- (point)))))
+ (while (pcase (get-char-property-and-overlay origin 'invisible)
+ (`(,_ . ,(and (pred overlayp) o))
+ (delete-overlay o)
+ t)))))
+ (cond
+ ((eq org-catch-invisible-edits 'show)
+ ;; That's it, we do the edit after showing
+ (message
+ "Unfolding invisible region around point before editing")
+ (sit-for 1))
+ ((and (eq org-catch-invisible-edits 'smart)
+ border-and-ok-direction)
+ (message "Unfolding invisible region around point before editing"))
+ (t
+ ;; Don't do the edit, make the user repeat it in full visibility
+ (user-error "Edit in invisible region aborted, repeat to confirm with text visible"))))))))
(defun org-fix-tags-on-the-fly ()
- (when (and (equal (char-after (point-at-bol)) ?*)
+ "Align tags in headline at point.
+Unlike to `org-set-tags', it ignores region and sorting."
+ (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit
(org-at-heading-p))
- (org-align-tags-here org-tags-column)))
+ (let ((org-ignore-region t)
+ (org-tags-sort-function nil))
+ (org-set-tags nil t))))
(defun org-delete-backward-char (N)
"Like `delete-backward-char', insert whitespace at field end in tables.
@@ -19546,22 +19991,22 @@ because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
(org-check-before-invisible-edit 'delete-backward)
- (if (and (org-table-p)
+ (if (and (org-at-table-p)
(eq N 1)
+ (not (org-region-active-p))
(string-match "|" (buffer-substring (point-at-bol) (point)))
(looking-at ".*?|"))
(let ((pos (point))
(noalign (looking-at "[^|\n\r]* |"))
(c org-table-may-need-update))
(backward-delete-char N)
- (if (not overwrite-mode)
- (progn
- (skip-chars-forward "^|")
- (insert " ")
- (goto-char (1- pos))))
+ (unless overwrite-mode
+ (skip-chars-forward "^|")
+ (insert " ")
+ (goto-char (1- pos)))
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
- (if noalign (setq org-table-may-need-update c)))
+ (when noalign (setq org-table-may-need-update c)))
(backward-delete-char N)
(org-fix-tags-on-the-fly))))
@@ -19574,7 +20019,7 @@ because, in this case the deletion might narrow the column."
(interactive "p")
(save-match-data
(org-check-before-invisible-edit 'delete)
- (if (and (org-table-p)
+ (if (and (org-at-table-p)
(not (bolp))
(not (= (char-after) ?|))
(eq N 1))
@@ -19587,12 +20032,12 @@ because, in this case the deletion might narrow the column."
(goto-char pos)
;; noalign: if there were two spaces at the end, this field
;; does not determine the width of the column.
- (if noalign (setq org-table-may-need-update c)))
+ (when noalign (setq org-table-may-need-update c)))
(delete-char N))
(delete-char N)
(org-fix-tags-on-the-fly))))
-;; Make `delete-selection-mode' work with org-mode and orgtbl-mode
+;; Make `delete-selection-mode' work with Org mode and Orgtbl mode
(put 'org-self-insert-command 'delete-selection
(lambda ()
(not (run-hook-with-args-until-success
@@ -19611,20 +20056,10 @@ because, in this case the deletion might narrow the column."
(put 'org-delete-char 'flyspell-delayed t)
(put 'org-delete-backward-char 'flyspell-delayed t)
-;; Make pabbrev-mode expand after org-mode commands
+;; Make pabbrev-mode expand after Org mode commands
(put 'org-self-insert-command 'pabbrev-expand-after-command t)
(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t)
-(defun org-remap (map &rest commands)
- "In MAP, remap the functions given in COMMANDS.
-COMMANDS is a list of alternating OLDDEF NEWDEF command names."
- (let (new old)
- (while commands
- (setq old (pop commands) new (pop commands))
- (if (fboundp 'command-remapping)
- (org-defkey map (vector 'remap old) new)
- (substitute-key-definition old new map global-map)))))
-
(defun org-transpose-words ()
"Transpose words for Org.
This uses the `org-mode-transpose-word-syntax-table' syntax
@@ -19635,15 +20070,6 @@ word constituents."
(call-interactively 'transpose-words)))
(org-remap org-mode-map 'transpose-words 'org-transpose-words)
-(when (eq org-enable-table-editor 'optimized)
- ;; If the user wants maximum table support, we need to hijack
- ;; some standard editing functions
- (org-remap org-mode-map
- 'self-insert-command 'org-self-insert-command
- 'delete-char 'org-delete-char
- 'delete-backward-char 'org-delete-backward-char)
- (org-defkey org-mode-map "|" 'org-force-self-insert))
-
(defvar org-ctrl-c-ctrl-c-hook nil
"Hook for functions attaching themselves to `C-c C-c'.
@@ -19765,7 +20191,7 @@ See `org-ctrl-c-ctrl-c-hook' for more information.")
(defun org-shiftselect-error ()
"Throw an error because Shift-Cursor command was applied in wrong context."
(if (and (boundp 'shift-select-mode) shift-select-mode)
- (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'")
+ (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'")
(user-error "This command works only in special context like headlines or timestamps")))
(defun org-call-for-shift-select (cmd)
@@ -19820,32 +20246,30 @@ individual commands for more information."
(call-interactively 'org-indent-item-tree))
(t (org-modifier-cursor-error))))
-(defun org-shiftmetaup (&optional arg)
- "Move subtree up or kill table row.
-Calls `org-move-subtree-up' or `org-table-kill-row' or
-`org-move-item-up' or `org-timestamp-up', depending on context.
-See the individual commands for more information."
+(defun org-shiftmetaup (&optional _arg)
+ "Drag the line at point up.
+In a table, kill the current row.
+On a clock timestamp, update the value of the timestamp like `S-<up>'
+but also adjust the previous clocked item in the clock history.
+Everywhere else, drag the line at point up."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetaup-hook))
((org-at-table-p) (call-interactively 'org-table-kill-row))
- ((org-at-heading-p) (call-interactively 'org-move-subtree-up))
- ((org-at-item-p) (call-interactively 'org-move-item-up))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-up)))
(t (call-interactively 'org-drag-line-backward))))
-(defun org-shiftmetadown (&optional arg)
- "Move subtree down or insert table row.
-Calls `org-move-subtree-down' or `org-table-insert-row' or
-`org-move-item-down' or `org-timestamp-up', depending on context.
-See the individual commands for more information."
+(defun org-shiftmetadown (&optional _arg)
+ "Drag the line at point down.
+In a table, insert an empty row at the current line.
+On a clock timestamp, update the value of the timestamp like `S-<down>'
+but also adjust the previous clocked item in the clock history.
+Everywhere else, drag the line at point down."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-shiftmetadown-hook))
((org-at-table-p) (call-interactively 'org-table-insert-row))
- ((org-at-heading-p) (call-interactively 'org-move-subtree-down))
- ((org-at-item-p) (call-interactively 'org-move-item-down))
((org-at-clock-log-p) (let ((org-clock-adjust-closest t))
(call-interactively 'org-timestamp-down)))
(t (call-interactively 'org-drag-line-forward))))
@@ -19854,11 +20278,16 @@ See the individual commands for more information."
(user-error
"Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>"))
-(defun org-metaleft (&optional arg)
- "Promote heading or move table column to left.
-Calls `org-do-promote' or `org-table-move-column', depending on context.
-With no specific context, calls the Emacs default `backward-word'.
-See the individual commands for more information."
+(defun org-metaleft (&optional _arg)
+ "Promote heading, list item at point or move table column left.
+
+Calls `org-do-promote', `org-outdent-item' or `org-table-move-column',
+depending on context. With no specific context, calls the Emacs
+default `backward-word'. See the individual commands for more
+information.
+
+This function runs the hook `org-metaleft-hook' as a first step,
+and returns at first non-nil value."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaleft-hook))
@@ -19883,11 +20312,18 @@ See the individual commands for more information."
(call-interactively 'org-outdent-item))
(t (call-interactively 'backward-word))))
-(defun org-metaright (&optional arg)
- "Demote a subtree, a list item or move table column to right.
+(defun org-metaright (&optional _arg)
+ "Demote heading, list item at point or move table column right.
+
In front of a drawer or a block keyword, indent it correctly.
+
+Calls `org-do-demote', `org-indent-item', `org-table-move-column',
+`org-indent-drawer' or `org-indent-block' depending on context.
With no specific context, calls the Emacs default `forward-word'.
-See the individual commands for more information."
+See the individual commands for more information.
+
+This function runs the hook `org-metaright-hook' as a first step,
+and returns at first non-nil value."
(interactive "P")
(cond
((run-hook-with-args-until-success 'org-metaright-hook))
@@ -19937,11 +20373,11 @@ this function returns t, nil otherwise."
(goto-char (point-at-eol))
(setq end (max end (point)))
(while (re-search-forward re end t)
- (if (get-char-property (match-beginning 0) 'invisible)
- (throw 'exit t))))
+ (when (get-char-property (match-beginning 0) 'invisible)
+ (throw 'exit t))))
nil))))
-(defun org-metaup (&optional arg)
+(defun org-metaup (&optional _arg)
"Move subtree up or move table row up.
Calls `org-move-subtree-up' or `org-table-move-row' or
`org-move-item-up', depending on context. See the individual commands
@@ -19963,7 +20399,7 @@ for more information."
((org-at-item-p) (call-interactively 'org-move-item-up))
(t (org-drag-element-backward))))
-(defun org-metadown (&optional arg)
+(defun org-metadown (&optional _arg)
"Move subtree down or move table row down.
Calls `org-move-subtree-down' or `org-table-move-row' or
`org-move-item-down', depending on context. See the individual
@@ -19994,7 +20430,7 @@ depending on context. See the individual commands for more information."
((run-hook-with-args-until-success 'org-shiftup-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'previous-line))
- ((org-at-timestamp-p t)
+ ((org-at-timestamp-p 'lax)
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-down 'org-timestamp-up)))
((and (not (eq org-support-shift-select 'always))
@@ -20018,7 +20454,7 @@ depending on context. See the individual commands for more information."
((run-hook-with-args-until-success 'org-shiftdown-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'next-line))
- ((org-at-timestamp-p t)
+ ((org-at-timestamp-p 'lax)
(call-interactively (if org-edit-timestamp-down-means-later
'org-timestamp-up 'org-timestamp-down)))
((and (not (eq org-support-shift-select 'always))
@@ -20047,7 +20483,7 @@ Depending on context, this does one of the following:
((run-hook-with-args-until-success 'org-shiftright-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'forward-char))
- ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day))
+ ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-up-day))
((and (not (eq org-support-shift-select 'always))
(org-at-heading-p))
(let ((org-inhibit-logging
@@ -20083,7 +20519,7 @@ Depending on context, this does one of the following:
((run-hook-with-args-until-success 'org-shiftleft-hook))
((and org-support-shift-select (org-region-active-p))
(org-call-for-shift-select 'backward-char))
- ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day))
+ ((org-at-timestamp-p 'lax) (call-interactively 'org-timestamp-down-day))
((and (not (eq org-support-shift-select 'always))
(org-at-heading-p))
(let ((org-inhibit-logging
@@ -20135,7 +20571,7 @@ Depending on context, this does one of the following:
"Change timestamps synchronously up in CLOCK log lines.
Optional argument N tells to change by that many units."
(interactive "P")
- (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
+ (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
(let (org-support-shift-select)
(org-clock-timestamps-up n))
(user-error "Not at a clock log")))
@@ -20144,11 +20580,37 @@ Optional argument N tells to change by that many units."
"Change timestamps synchronously down in CLOCK log lines.
Optional argument N tells to change by that many units."
(interactive "P")
- (if (and (org-at-clock-log-p) (org-at-timestamp-p t))
+ (if (and (org-at-clock-log-p) (org-at-timestamp-p 'lax))
(let (org-support-shift-select)
(org-clock-timestamps-down n))
(user-error "Not at a clock log")))
+(defun org-increase-number-at-point (&optional inc)
+ "Increment the number at point.
+With an optional prefix numeric argument INC, increment using
+this numeric value."
+ (interactive "p")
+ (if (not (number-at-point))
+ (user-error "Not on a number")
+ (unless inc (setq inc 1))
+ (let ((pos (point))
+ (beg (skip-chars-backward "-+^/*0-9eE."))
+ (end (skip-chars-forward "-+^/*0-9eE^.")) nap)
+ (setq nap (buffer-substring-no-properties
+ (+ pos beg) (+ pos beg end)))
+ (delete-region (+ pos beg) (+ pos beg end))
+ (insert (calc-eval (concat (number-to-string inc) "+" nap))))
+ (when (org-at-table-p)
+ (org-table-align)
+ (org-table-end-of-field 1))))
+
+(defun org-decrease-number-at-point (&optional inc)
+ "Decrement the number at point.
+With an optional prefix numeric argument INC, decrement using
+this numeric value."
+ (interactive "p")
+ (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."
(interactive)
@@ -20170,32 +20632,30 @@ Optional argument N tells to change by that many units."
(defun org-copy-visible (beg end)
"Copy the visible parts of the region."
(interactive "r")
- (let (snippets s)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (setq s (goto-char (point-min)))
- (while (not (= (point) (point-max)))
- (goto-char (org-find-invisible))
- (push (buffer-substring s (point)) snippets)
- (setq s (goto-char (org-find-visible))))))
- (kill-new (apply 'concat (nreverse snippets)))))
+ (let ((result ""))
+ (while (/= beg end)
+ (when (get-char-property beg 'invisible)
+ (setq beg (next-single-char-property-change beg 'invisible nil end)))
+ (let ((next (next-single-char-property-change beg 'invisible nil end)))
+ (setq result (concat result (buffer-substring beg next)))
+ (setq beg next)))
+ (kill-new result)))
(defun org-copy-special ()
"Copy region in table or copy current subtree.
-Calls `org-table-copy' or `org-copy-subtree', depending on context.
-See the individual commands for more information."
+Calls `org-table-copy-region' or `org-copy-subtree', depending on
+context. See the individual commands for more information."
(interactive)
(call-interactively
- (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree)))
+ (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree)))
(defun org-cut-special ()
"Cut region in table or cut current subtree.
-Calls `org-table-copy' or `org-cut-subtree', depending on context.
-See the individual commands for more information."
+Calls `org-table-cut-region' or `org-cut-subtree', depending on
+context. See the individual commands for more information."
(interactive)
(call-interactively
- (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree)))
+ (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree)))
(defun org-paste-special (arg)
"Paste rectangular region into table, or past subtree relative to level.
@@ -20206,57 +20666,69 @@ See the individual commands for more information."
(org-table-paste-rectangle)
(org-paste-subtree arg)))
-(defsubst org-in-fixed-width-region-p ()
- "Is point in a fixed-width region?"
- (save-match-data
- (eq 'fixed-width (org-element-type (org-element-at-point)))))
-
(defun org-edit-special (&optional arg)
"Call a special editor for the element at point.
When at a table, call the formula editor with `org-table-edit-formulas'.
When in a source code block, call `org-edit-src-code'.
When in a fixed-width region, call `org-edit-fixed-width-region'.
+When in an export block, call `org-edit-export-block'.
+When in a LaTeX environment, call `org-edit-latex-environment'.
When at an #+INCLUDE keyword, visit the included file.
+When at a footnote reference, call `org-edit-footnote-reference'
On a link, call `ffap' to visit the link at point.
Otherwise, return a user error."
(interactive "P")
(let ((element (org-element-at-point)))
- (assert (not buffer-read-only) nil
- "Buffer is read-only: %s" (buffer-name))
- (case (org-element-type element)
- (src-block
+ (barf-if-buffer-read-only)
+ (pcase (org-element-type element)
+ (`src-block
(if (not arg) (org-edit-src-code)
- (let* ((info (org-babel-get-src-block-info))
- (lang (nth 0 info))
- (params (nth 2 info))
- (session (cdr (assq :session params))))
- (if (not session) (org-edit-src-code)
- ;; At a src-block with a session and function called with
- ;; an ARG: switch to the buffer related to the inferior
- ;; process.
- (switch-to-buffer
+ (let* ((info (org-babel-get-src-block-info))
+ (lang (nth 0 info))
+ (params (nth 2 info))
+ (session (cdr (assq :session params))))
+ (if (not session) (org-edit-src-code)
+ ;; At a src-block with a session and function called with
+ ;; an ARG: switch to the buffer related to the inferior
+ ;; process.
+ (switch-to-buffer
(funcall (intern (concat "org-babel-prep-session:" lang))
session params))))))
- (keyword
+ (`keyword
(if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE"))
- (find-file
- (org-remove-double-quotes
- (car (org-split-string (org-element-property :value element)))))
+ (org-open-link-from-string
+ (format "[[%s]]"
+ (expand-file-name
+ (let ((value (org-element-property :value element)))
+ (cond ((org-file-url-p value)
+ (user-error "The file is specified as a URL, cannot be edited"))
+ ((not (org-string-nw-p value))
+ (user-error "No file to edit"))
+ ((string-match "\\`\"\\(.*?\\)\"" value)
+ (match-string 1 value))
+ ((string-match "\\`[^ \t\"]\\S-*" value)
+ (match-string 0 value))
+ (t (user-error "No valid file specified")))))))
(user-error "No special environment to edit here")))
- (table
+ (`table
(if (eq (org-element-property :type element) 'table.el)
- (org-edit-src-code)
+ (org-edit-table.el)
(call-interactively 'org-table-edit-formulas)))
;; Only Org tables contain `table-row' type elements.
- (table-row (call-interactively 'org-table-edit-formulas))
- ((example-block export-block) (org-edit-src-code))
- (fixed-width (org-edit-fixed-width-region))
- (otherwise
- ;; No notable element at point. Though, we may be at a link,
- ;; which is an object. Thus, scan deeper.
- (if (eq (org-element-type (org-element-context element)) 'link)
- (call-interactively 'ffap)
- (user-error "No special environment to edit here"))))))
+ (`table-row (call-interactively 'org-table-edit-formulas))
+ (`example-block (org-edit-src-code))
+ (`export-block (org-edit-export-block))
+ (`fixed-width (org-edit-fixed-width-region))
+ (`latex-environment (org-edit-latex-environment))
+ (_
+ ;; No notable element at point. Though, we may be at a link or
+ ;; a footnote reference, which are objects. Thus, scan deeper.
+ (let ((context (org-element-context element)))
+ (pcase (org-element-type context)
+ (`footnote-reference (org-edit-footnote-reference))
+ (`inline-src-block (org-edit-inline-src-code))
+ (`link (call-interactively #'ffap))
+ (_ (user-error "No special environment to edit here"))))))))
(defvar org-table-coordinate-overlays) ; defined in org-table.el
(defun org-ctrl-c-ctrl-c (&optional arg)
@@ -20305,240 +20777,319 @@ This command does many different things, depending on context:
inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'."
(interactive "P")
(cond
- ((or (and (boundp 'org-clock-overlays) org-clock-overlays)
- org-occur-highlights
- org-latex-fragment-image-overlays)
- (and (boundp 'org-clock-overlays) (org-clock-remove-overlays))
+ ((or (bound-and-true-p org-clock-overlays) org-occur-highlights)
+ (when (boundp 'org-clock-overlays) (org-clock-remove-overlays))
(org-remove-occur-highlights)
- (org-remove-latex-fragment-image-overlays)
(message "Temporary highlights/overlays removed from current buffer"))
- ((and (local-variable-p 'org-finish-function (current-buffer))
+ ((and (local-variable-p 'org-finish-function)
(fboundp org-finish-function))
(funcall org-finish-function))
+ ((org-babel-hash-at-point))
((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook))
(t
- (let* ((context (org-element-context)) (type (org-element-type context)))
- ;; Test if point is within a blank line.
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))
- (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
- (user-error "C-c C-c can do nothing useful at this location"))
- (case type
- ;; When at a link, act according to the parent instead.
- (link (setq context (org-element-property :parent context))
- (setq type (org-element-type context)))
- ;; Unsupported object types: refer to the first supported
- ;; element or object containing it.
- ((bold code entity export-snippet inline-babel-call inline-src-block
- italic latex-fragment line-break macro strike-through subscript
- superscript underline verbatim)
- (while (and (setq context (org-element-property :parent context))
- (not (memq (setq type (org-element-type context))
- '(radio-target paragraph verse-block
- table-cell)))))))
- ;; For convenience: at the first line of a paragraph on the
- ;; same line as an item, apply function on that item instead.
- (when (eq type 'paragraph)
- (let ((parent (org-element-property :parent context)))
- (when (and (eq (org-element-type parent) 'item)
- (= (point-at-bol) (org-element-property :begin parent)))
- (setq context parent type 'item))))
- ;; Act according to type of element or object at point.
- (case type
- (clock (org-clock-update-time-maybe))
- (dynamic-block
- (save-excursion
- (goto-char (org-element-property :post-affiliated context))
- (org-update-dblock)))
- (footnote-definition
+ (let* ((context
+ (org-element-lineage
+ (org-element-context)
+ ;; Limit to supported contexts.
+ '(babel-call clock dynamic-block footnote-definition
+ footnote-reference inline-babel-call inline-src-block
+ inlinetask item keyword node-property paragraph
+ plain-list planning property-drawer radio-target
+ src-block statistics-cookie table table-cell table-row
+ timestamp)
+ t))
+ (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.
+ (when (eq type 'paragraph)
+ (let ((parent (org-element-property :parent context)))
+ (when (and (eq (org-element-type parent) 'item)
+ (= (line-beginning-position)
+ (org-element-property :begin parent)))
+ (setq context parent)
+ (setq type 'item))))
+ ;; Act according to type of element or object at point.
+ ;;
+ ;; Do nothing on a blank line, except if it is contained in
+ ;; a src block. Hence, we first check if point is in such
+ ;; a block and then if it is at a blank line.
+ (pcase type
+ ((or `inline-src-block `src-block)
+ (unless org-babel-no-eval-on-ctrl-c-ctrl-c
+ (org-babel-eval-wipe-error-buffer)
+ (org-babel-execute-src-block
+ current-prefix-arg (org-babel-get-src-block-info nil context))))
+ ((guard (org-match-line "[ \t]*$"))
+ (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
+ (user-error
+ (substitute-command-keys
+ "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))
+ ((or `babel-call `inline-babel-call)
+ (let ((info (org-babel-lob-get-info context)))
+ (when info (org-babel-execute-src-block nil info))))
+ (`clock (org-clock-update-time-maybe))
+ (`dynamic-block
+ (save-excursion
(goto-char (org-element-property :post-affiliated context))
- (call-interactively 'org-footnote-action))
- (footnote-reference (call-interactively 'org-footnote-action))
- ((headline inlinetask)
- (save-excursion (goto-char (org-element-property :begin context))
- (call-interactively 'org-set-tags)))
- (item
- ;; At an item: a double C-u set checkbox to "[-]"
- ;; unconditionally, whereas a single one 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))))))
- (keyword
- (let ((org-inhibit-startup-visibility-stuff t)
- (org-startup-align-all-tables nil))
- (when (boundp 'org-table-coordinate-overlays)
- (mapc 'delete-overlay org-table-coordinate-overlays)
- (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))
- (beginm (move-marker (make-marker) begin))
- (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
- (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box))
- (org-list-get-all-items
- begin struct (org-list-prevs-alist struct))))
- ((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)))
- (org-list-write-struct
- struct (org-list-parents-alist struct) old-struct)
- (org-update-checkbox-count-maybe)
- (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
- ((property-drawer node-property)
- (call-interactively 'org-property-action))
- ((radio-target target)
- (call-interactively 'org-update-radio-target-regexp))
- (statistics-cookie
- (call-interactively 'org-update-statistics-cookies))
- ((table table-cell table-row)
- ;; At a table, recalculate every field and align it. Also
- ;; send the table if necessary. If the table has
- ;; a `table.el' type, just give up. At a table row or
- ;; cell, maybe recalculate line but always align table.
- (if (eq (org-element-property :type context) 'table.el)
- (message "%s" "Use C-c ' to edit table.el tables")
- (let ((org-enable-table-editor t))
- (if (or (eq type 'table)
- ;; Check if point is at a TBLFM line.
- (and (eq type 'table-row)
- (= (point) (org-element-property :end context))))
- (save-excursion
- (if (org-at-TBLFM-p)
- (progn (require 'org-table)
- (org-table-calc-current-TBLFM))
- (goto-char (org-element-property :contents-begin context))
- (org-call-with-arg 'org-table-recalculate (or arg t))
- (orgtbl-send-table 'maybe)))
- (org-table-maybe-eval-formula)
- (cond (arg (call-interactively 'org-table-recalculate))
- ((org-table-maybe-recalculate-line))
- (t (org-table-align)))))))
- (timestamp (org-timestamp-change 0 'day))
- (otherwise
- (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)
- (user-error
- "C-c C-c can do nothing useful at this location")))))))))
+ (org-update-dblock)))
+ (`footnote-definition
+ (goto-char (org-element-property :post-affiliated context))
+ (call-interactively 'org-footnote-action))
+ (`footnote-reference (call-interactively #'org-footnote-action))
+ ((or `headline `inlinetask)
+ (save-excursion (goto-char (org-element-property :begin context))
+ (call-interactively #'org-set-tags)))
+ (`item
+ ;; At an item: `C-u C-u' sets checkbox to "[-]"
+ ;; 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))))))
+ (`keyword
+ (let ((org-inhibit-startup-visibility-stuff t)
+ (org-startup-align-all-tables nil))
+ (when (boundp 'org-table-coordinate-overlays)
+ (mapc #'delete-overlay org-table-coordinate-overlays)
+ (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))
+ (beginm (move-marker (make-marker) begin))
+ (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)))
+ (org-list-write-struct
+ struct (org-list-parents-alist struct) old-struct)
+ (org-update-checkbox-count-maybe)
+ (save-excursion (goto-char beginm) (org-list-send-list 'maybe))))
+ ((or `property-drawer `node-property)
+ (call-interactively #'org-property-action))
+ (`radio-target
+ (call-interactively #'org-update-radio-target-regexp))
+ (`statistics-cookie
+ (call-interactively #'org-update-statistics-cookies))
+ ((or `table `table-cell `table-row)
+ ;; At a table, recalculate every field and align it. Also
+ ;; send the table if necessary. If the table has
+ ;; a `table.el' type, just give up. At a table row or cell,
+ ;; maybe recalculate line but always align table.
+ (if (eq (org-element-property :type context) 'table.el)
+ (message "%s" (substitute-command-keys "\\<org-mode-map>\
+Use `\\[org-edit-special]' to edit table.el tables"))
+ (if (or (eq type 'table)
+ ;; Check if point is at a TBLFM line.
+ (and (eq type 'table-row)
+ (= (point) (org-element-property :end context))))
+ (save-excursion
+ (if (org-at-TBLFM-p)
+ (progn (require 'org-table)
+ (org-table-calc-current-TBLFM))
+ (goto-char (org-element-property :contents-begin context))
+ (org-call-with-arg 'org-table-recalculate (or arg t))
+ (orgtbl-send-table 'maybe)))
+ (org-table-maybe-eval-formula)
+ (cond (arg (call-interactively #'org-table-recalculate))
+ ((org-table-maybe-recalculate-line))
+ (t (org-table-align))))))
+ ((or `timestamp (and `planning (guard (org-at-timestamp-p 'lax))))
+ (org-timestamp-change 0 'day))
+ ((and `nil (guard (org-at-heading-p)))
+ ;; When point is on an unsupported object type, we can miss
+ ;; the fact that it also is at a heading. Handle it here.
+ (call-interactively #'org-set-tags))
+ ((guard
+ (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook)))
+ (_
+ (user-error
+ (substitute-command-keys
+ "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here"))))))))
(defun org-mode-restart ()
(interactive)
- (let ((indent-status (org-bound-and-true-p org-indent-mode)))
+ (let ((indent-status (bound-and-true-p org-indent-mode)))
(funcall major-mode)
(hack-local-variables)
- (when (and indent-status (not (org-bound-and-true-p org-indent-mode)))
- (org-indent-mode -1)))
+ (when (and indent-status (not (bound-and-true-p org-indent-mode)))
+ (org-indent-mode -1))
+ (org-reset-file-cache))
(message "%s restarted" major-mode))
(defun org-kill-note-or-show-branches ()
- "If this is a Note buffer, abort storing the note. Else call `show-branches'."
+ "Abort storing current note, or call `outline-show-branches'."
(interactive)
(if (not org-finish-function)
(progn
- (hide-subtree)
- (call-interactively 'show-branches))
+ (outline-hide-subtree)
+ (call-interactively 'outline-show-branches))
(let ((org-note-abort t))
(funcall org-finish-function))))
+(defun org-delete-indentation (&optional arg)
+ "Join current line to previous and fix whitespace at join.
+
+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."
+ (interactive "*P")
+ (if (save-excursion
+ (beginning-of-line (if arg 1 0))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)))
+ ;; At headline.
+ (let ((tags-column (when (match-beginning 5)
+ (save-excursion (goto-char (match-beginning 5))
+ (current-column))))
+ (string (concat " " (progn (when arg (forward-line 1))
+ (org-trim (delete-and-extract-region
+ (line-beginning-position)
+ (line-end-position)))))))
+ (unless (bobp) (delete-region (point) (1- (point))))
+ (goto-char (or (match-end 4)
+ (match-beginning 5)
+ (match-end 0)))
+ (skip-chars-backward " \t")
+ (save-excursion (insert string))
+ ;; Adjust alignment of tags.
+ (cond
+ ((not tags-column)) ;no tags
+ (org-auto-align-tags (org-set-tags nil t))
+ (t (org--align-tags-here tags-column)))) ;preserve tags column
+ (delete-indentation arg)))
+
(defun org-open-line (n)
"Insert a new row in tables, call `open-line' elsewhere.
-If `org-special-ctrl-o' is nil, just call `open-line' everywhere."
+If `org-special-ctrl-o' is nil, just call `open-line' everywhere.
+As a special case, when a document starts with a table, allow to
+call `open-line' on the very first character."
(interactive "*p")
- (cond
- ((not org-special-ctrl-o)
- (open-line n))
- ((org-at-table-p)
- (org-table-insert-row))
- (t
- (open-line n))))
+ (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p))
+ (org-table-insert-row)
+ (open-line n)))
(defun org-return (&optional indent)
"Goto next table row or insert a newline.
+
Calls `org-table-next-row' or `newline', depending on context.
-See the individual commands for more information."
+
+When optional INDENT argument is non-nil, call
+`newline-and-indent' instead of `newline'.
+
+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)
- (let (org-ts-what)
+ (let ((context (if org-return-follows-link (org-element-context)
+ (org-element-at-point))))
(cond
- ((or (bobp) (org-in-src-block-p))
- (if indent (newline-and-indent) (newline)))
- ((org-at-table-p)
- (org-table-justify-field-maybe)
- (call-interactively 'org-table-next-row))
- ;; when `newline-and-indent' is called within a list, make sure
- ;; text moved stays inside the item.
- ((and (org-in-item-p) indent)
- (if (and (org-at-item-p) (>= (point) (match-end 0)))
- (progn
- (save-match-data (newline))
- (org-indent-line-to (length (match-string 0))))
- (let ((ind (org-get-indentation)))
- (newline)
- (if (org-looking-back org-list-end-re)
- (org-indent-line)
- (org-indent-line-to ind)))))
- ((and org-return-follows-link
- (org-at-timestamp-p t)
- (not (eq org-ts-what 'after)))
- (org-follow-timestamp-link))
+ ;; In a table, call `org-table-next-row'. However, before first
+ ;; column or after last one, split the table.
+ ((or (and (eq (org-element-type context) 'table)
+ (>= (point) (org-element-property :contents-begin context))
+ (< (point) (org-element-property :contents-end context)))
+ (org-element-lineage context '(table-row table-cell) t))
+ (if (or (looking-at-p "[ \t]*$")
+ (save-excursion (skip-chars-backward " \t") (bolp)))
+ (insert "\n")
+ (org-table-justify-field-maybe)
+ (call-interactively #'org-table-next-row)))
+ ;; On a link or a timestamp, call `org-open-at-point' if
+ ;; `org-return-follows-link' allows it. Tolerate fuzzy
+ ;; locations, e.g., in a comment, as `org-open-at-point'.
((and org-return-follows-link
- (let ((tprop (get-text-property (point) 'face)))
- (or (eq tprop 'org-link)
- (and (listp tprop) (memq 'org-link tprop)))))
- (call-interactively 'org-open-at-point))
- ((and (org-at-heading-p)
- (looking-at
- (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")))
- (org-show-entry)
- (end-of-line 1)
- (newline))
+ (or (org-in-regexp org-ts-regexp-both nil t)
+ (org-in-regexp org-tsr-regexp-both nil t)
+ (org-in-regexp org-any-link-re nil t)))
+ (call-interactively #'org-open-at-point))
+ ;; Insert newline in heading, but preserve tags.
+ ((and (not (bolp))
+ (save-excursion (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
+ ;; At headline. Split line. However, if point is on keyword,
+ ;; priority cookie or tags, do not break any of them: add
+ ;; a newline after the headline instead.
+ (let ((tags-column (and (match-beginning 5)
+ (save-excursion (goto-char (match-beginning 5))
+ (current-column))))
+ (string
+ (when (and (match-end 4) (org-point-in-group (point) 4))
+ (delete-and-extract-region (point) (match-end 4)))))
+ ;; Adjust tag alignment.
+ (cond
+ ((not (and tags-column string)))
+ (org-auto-align-tags (org-set-tags nil t))
+ (t (org--align-tags-here tags-column))) ;preserve tags column
+ (end-of-line)
+ (org-show-entry)
+ (if indent (newline-and-indent) (newline))
+ (when string (save-excursion (insert (org-trim string))))))
+ ;; In a list, make sure indenting keeps trailing text within.
+ ((and indent
+ (not (eolp))
+ (org-element-lineage context '(item)))
+ (let ((trailing-data
+ (delete-and-extract-region (point) (line-end-position))))
+ (newline-and-indent)
+ (save-excursion (insert trailing-data))))
(t (if indent (newline-and-indent) (newline))))))
(defun org-return-indent ()
@@ -20576,141 +21127,11 @@ Calls `org-table-insert-hline', `org-toggle-item', or
(t
(call-interactively 'org-toggle-item))))
-(defun org-toggle-item (arg)
- "Convert headings or normal lines to items, items to normal lines.
-If there is no active region, only the current line is considered.
-
-If the first non blank line in the region is a headline, convert
-all headlines to items, shifting text accordingly.
-
-If it is an item, convert all items to normal lines.
-
-If it is normal text, change region into a list of items.
-With a prefix argument ARG, change the region in a single item."
- (interactive "P")
- (let ((shift-text
- (function
- ;; Shift text in current section to IND, from point to END.
- ;; The function leaves point to END line.
- (lambda (ind end)
- (let ((min-i 1000) (end (copy-marker end)))
- ;; First determine the minimum indentation (MIN-I) of
- ;; the text.
- (save-excursion
- (catch 'exit
- (while (< (point) end)
- (let ((i (org-get-indentation)))
- (cond
- ;; Skip blank lines and inline tasks.
- ((looking-at "^[ \t]*$"))
- ((looking-at org-outline-regexp-bol))
- ;; We can't find less than 0 indentation.
- ((zerop i) (throw 'exit (setq min-i 0)))
- ((< i min-i) (setq min-i i))))
- (forward-line))))
- ;; Then indent each line so that a line indented to
- ;; MIN-I becomes indented to IND. Ignore blank lines
- ;; and inline tasks in the process.
- (let ((delta (- ind min-i)))
- (while (< (point) end)
- (unless (or (looking-at "^[ \t]*$")
- (looking-at org-outline-regexp-bol))
- (org-indent-line-to (+ (org-get-indentation) delta)))
- (forward-line)))))))
- (skip-blanks
- (function
- ;; Return beginning of first non-blank line, starting from
- ;; line at POS.
- (lambda (pos)
- (save-excursion
- (goto-char pos)
- (skip-chars-forward " \r\t\n")
- (point-at-bol)))))
- beg end)
- ;; Determine boundaries of changes.
- (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))
- end (copy-marker (point-at-eol))))
- ;; Depending on the starting line, choose an action on the text
- ;; between BEG and END.
- (org-with-limited-levels
- (save-excursion
- (goto-char beg)
- (cond
- ;; Case 1. Start at an item: de-itemize. Note that it only
- ;; happens when a region is active: `org-ctrl-c-minus'
- ;; would call `org-cycle-list-bullet' otherwise.
- ((org-at-item-p)
- (while (< (point) end)
- (when (org-at-item-p)
- (skip-chars-forward " \t")
- (delete-region (point) (match-end 0)))
- (forward-line)))
- ;; Case 2. Start at an heading: convert to items.
- ((org-at-heading-p)
- (let* ((bul (org-list-bullet-string "-"))
- (bul-len (length bul))
- ;; Indentation of the first heading. It should be
- ;; relative to the indentation of its parent, if any.
- (start-ind (save-excursion
- (cond
- ((not org-adapt-indentation) 0)
- ((not (outline-previous-heading)) 0)
- (t (length (match-string 0))))))
- ;; Level of first heading. Further headings will be
- ;; compared to it to determine hierarchy in the list.
- (ref-level (org-reduced-level (org-outline-level))))
- (while (< (point) end)
- (let* ((level (org-reduced-level (org-outline-level)))
- (delta (max 0 (- level ref-level))))
- ;; If current headline is less indented than the first
- ;; one, set it as reference, in order to preserve
- ;; subtrees.
- (when (< level ref-level) (setq ref-level level))
- (replace-match bul t t)
- (org-indent-line-to (+ start-ind (* delta bul-len)))
- ;; Ensure all text down to END (or SECTION-END) belongs
- ;; to the newly created item.
- (let ((section-end (save-excursion
- (or (outline-next-heading) (point)))))
- (forward-line)
- (funcall shift-text
- (+ start-ind (* (1+ delta) bul-len))
- (min end section-end)))))))
- ;; Case 3. Normal line with ARG: make the first line of region
- ;; an item, and shift indentation of others lines to
- ;; set them as item's body.
- (arg (let* ((bul (org-list-bullet-string "-"))
- (bul-len (length bul))
- (ref-ind (org-get-indentation)))
- (skip-chars-forward " \t")
- (insert bul)
- (forward-line)
- (while (< (point) end)
- ;; Ensure that lines less indented than first one
- ;; still get included in item body.
- (funcall shift-text
- (+ ref-ind bul-len)
- (min end (save-excursion (or (outline-next-heading)
- (point)))))
- (forward-line))))
- ;; Case 4. Normal line without ARG: turn each non-item line
- ;; into an item.
- (t
- (while (< (point) end)
- (unless (or (org-at-heading-p) (org-at-item-p))
- (if (looking-at "\\([ \t]*\\)\\(\\S-\\)")
- (replace-match
- (concat "\\1" (org-list-bullet-string "-") "\\2"))))
- (forward-line))))))))
-
(defun org-toggle-heading (&optional nstars)
"Convert headings to normal text, or items or text to headings.
If there is no active region, only convert the current line.
-With a \\[universal-argument] prefix, convert the whole list at
+With a `\\[universal-argument]' prefix, convert the whole list at
point into heading.
In a region:
@@ -20746,7 +21167,7 @@ number of stars to add."
;; do not consider the last line to be in the region.
(when (and current-prefix-arg (org-at-item-p))
- (if (listp current-prefix-arg) (setq current-prefix-arg 1))
+ (when (listp current-prefix-arg) (setq current-prefix-arg 1))
(org-mark-element))
(if (org-region-active-p)
@@ -20771,31 +21192,17 @@ number of stars to add."
;; Case 2. Started at an item: change items into headlines.
;; One star will be added by `org-list-to-subtree'.
((org-at-item-p)
- (let* ((stars (make-string
- ;; subtract the star that will be added again by
- ;; `org-list-to-subtree'
- (if (numberp nstars) (1- nstars)
- (or (org-current-level) 0))
- ?*))
- (add-stars
- (cond (nstars "") ; stars from prefix only
- ((equal stars "") "") ; before first heading
- (org-odd-levels-only "*") ; inside heading, odd
- (t "")))) ; inside heading, oddeven
- (while (< (point) end)
- (when (org-at-item-p)
- ;; Pay attention to cases when region ends before list.
- (let* ((struct (org-list-struct))
- (list-end (min (org-list-get-bottom-point struct) (1+ end))))
- (save-restriction
- (narrow-to-region (point) list-end)
- (insert
- (org-list-to-subtree
- (org-list-parse-list t)
- `(:istart (concat ',stars ',add-stars (funcall get-stars depth))
- :icount (concat ',stars ',add-stars (funcall get-stars depth)))))))
- (setq toggled t))
- (forward-line))))
+ (while (< (point) end)
+ (when (org-at-item-p)
+ ;; Pay attention to cases when region ends before list.
+ (let* ((struct (org-list-struct))
+ (list-end
+ (min (org-list-get-bottom-point struct) (1+ end))))
+ (save-restriction
+ (narrow-to-region (point) list-end)
+ (insert (org-list-to-subtree (org-list-to-lisp t)) "\n")))
+ (setq toggled t))
+ (forward-line)))
;; Case 3. Started at normal text: make every line an heading,
;; skipping headlines and items.
(t (let* ((stars
@@ -20807,7 +21214,7 @@ number of stars to add."
(org-odd-levels-only "**") ; inside heading, odd
(t "*"))) ; inside heading, oddeven
(rpl (concat stars add-stars " "))
- (lend (if (listp nstars) (save-excursion (end-of-line) (point)))))
+ (lend (when (listp nstars) (save-excursion (end-of-line) (point)))))
(while (< (point) (if (equal nstars '(4)) lend end))
(when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p)))
(looking-at "\\([ \t]*\\)\\(\\S-\\)"))
@@ -20815,24 +21222,18 @@ number of stars to add."
(forward-line)))))))
(unless toggled (message "Cannot toggle heading from here"))))
-(defun org-meta-return (&optional _arg)
+(defun org-meta-return (&optional arg)
"Insert a new heading or wrap a region in a table.
-Calls `org-insert-heading' or `org-table-wrap-region', depending
-on context. See the individual commands for more information."
- (interactive)
+Calls `org-insert-heading', `org-insert-item' or
+`org-table-wrap-region', depending on context. When called with
+an argument, unconditionally call `org-insert-heading'."
+ (interactive "P")
(org-check-before-invisible-edit 'insert)
(or (run-hook-with-args-until-success 'org-metareturn-hook)
- (let* ((element (org-element-at-point))
- (type (org-element-type element)))
- (when (eq type 'table-row)
- (setq element (org-element-property :parent element))
- (setq type 'table))
- (if (and (eq type 'table)
- (eq (org-element-property :type element) 'org)
- (>= (point) (org-element-property :contents-begin element))
- (< (point) (org-element-property :contents-end element)))
- (call-interactively 'org-table-wrap-region)
- (call-interactively 'org-insert-heading)))))
+ (call-interactively (cond (arg #'org-insert-heading)
+ ((org-at-table-p) #'org-table-wrap-region)
+ ((org-in-item-p) #'org-insert-item)
+ (t #'org-insert-heading)))))
;;; Menu entries
@@ -20841,7 +21242,7 @@ on context. See the individual commands for more information."
(and (not (org-before-first-heading-p))
(not (org-at-table-p))))
-;; Define the Org-mode menus
+;; 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)]
@@ -20888,19 +21289,22 @@ on context. See the individual commands for more information."
["Which Column?" org-table-current-column (org-at-table-p)])
["Debug Formulas"
org-table-toggle-formula-debugger
- :style toggle :selected (org-bound-and-true-p org-table-formula-debug)]
+ :style toggle :selected (bound-and-true-p org-table-formula-debug)]
["Show Col/Row Numbers"
org-table-toggle-coordinate-overlays
:style toggle
- :selected (org-bound-and-true-p org-table-overlay-coordinates)]
+ :selected (bound-and-true-p org-table-overlay-coordinates)]
"--"
- ["Create" org-table-create (and (not (org-at-table-p))
- org-enable-table-editor)]
+ ["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]))
+ ["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"
@@ -20909,7 +21313,7 @@ on context. See the individual commands for more information."
["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))]
["Sparse Tree..." org-sparse-tree t]
["Reveal Context" org-reveal t]
- ["Show All" show-all t]
+ ["Show All" outline-show-all t]
"--"
["Subtree to indirect buffer" org-tree-to-indirect-buffer t])
"--"
@@ -20925,8 +21329,8 @@ on context. See the individual commands for more information."
("Edit Structure"
["Refile Subtree" org-refile (org-in-subtree-not-table-p)]
"--"
- ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)]
- ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)]
+ ["Move Subtree Up" org-metaup (org-at-heading-p)]
+ ["Move Subtree Down" org-metadown (org-at-heading-p)]
"--"
["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)]
["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)]
@@ -20987,7 +21391,7 @@ on context. See the individual commands for more information."
["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]
["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))])
["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"]
- ["Global TODO list" org-todo-list :active t :keys "C-c a t"]
+ ["Global TODO list" org-todo-list :active t :keys "\\[org-agenda] t"]
"--"
["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies)
:selected org-enforce-todo-dependencies :style toggle :active t]
@@ -21012,15 +21416,15 @@ on context. See the individual commands for more information."
"--"
["Set property" org-set-property (not (org-before-first-heading-p))]
["Column view of properties" org-columns t]
- ["Insert Column View DBlock" org-insert-columns-dblock t])
+ ["Insert Column View DBlock" org-columns-insert-dblock t])
("Dates and Scheduling"
["Timestamp" org-time-stamp (not (org-before-first-heading-p))]
["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))]
("Change Date"
- ["1 Day Later" org-shiftright (org-at-timestamp-p)]
- ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)]
- ["1 ... Later" org-shiftup (org-at-timestamp-p)]
- ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)])
+ ["1 Day Later" org-shiftright (org-at-timestamp-p 'lax)]
+ ["1 Day Earlier" org-shiftleft (org-at-timestamp-p 'lax)]
+ ["1 ... Later" org-shiftup (org-at-timestamp-p 'lax)]
+ ["1 ... Earlier" org-shiftdown (org-at-timestamp-p 'lax)])
["Compute Time Range" org-evaluate-time-range t]
["Schedule Item" org-schedule (not (org-before-first-heading-p))]
["Deadline" org-deadline (not (org-before-first-heading-p))]
@@ -21062,25 +21466,22 @@ on context. See the individual commands for more information."
("Special views current file"
["TODO Tree" org-show-todo-tree t]
["Check Deadlines" org-check-deadlines t]
- ["Timeline" org-timeline t]
["Tags/Property tree" org-match-sparse-tree t])
"--"
["Export/Publish..." org-export-dispatch t]
("LaTeX"
- ["Org CDLaTeX mode" org-cdlatex-mode :style toggle
- :selected org-cdlatex-mode]
+ ["Org CDLaTeX mode" org-cdlatex-mode :active (require 'cdlatex nil t)
+ :style toggle :selected org-cdlatex-mode]
["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)]
["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)]
["Modify math symbol" org-cdlatex-math-modify
(org-inside-LaTeX-fragment-p)]
- ["Insert citation" org-reftex-citation t]
- "--"
- ["Template for BEAMER" (org-beamer-insert-options-template) t])
+ ["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 "C-c a ?"]
+ ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "\\[org-agenda] ?"]
"--"
["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
"--"
@@ -21101,20 +21502,20 @@ on context. See the individual commands for more information."
))
(defun org-info (&optional node)
- "Read documentation for Org-mode in the info system.
+ "Read documentation for Org in the info system.
With optional NODE, go directly to that node."
(interactive)
(info (format "(org)%s" (or node ""))))
;;;###autoload
(defun org-submit-bug-report ()
- "Submit a bug report on Org-mode via mail.
+ "Submit a bug report on Org via mail.
Don't hesitate to report any problems or inaccurate documentation.
If you don't have setup sending mail from (X)Emacs, please copy the
output buffer into your mail program, as it gives us important
-information about your Org-mode version and configuration."
+information about your Org version and configuration."
(interactive)
(require 'reporter)
(defvar reporter-prompt-for-summary-p)
@@ -21126,12 +21527,12 @@ information about your Org-mode version and configuration."
(org-version nil 'full)
(let (list)
(save-window-excursion
- (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
+ (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*"))
(delete-other-windows)
(erase-buffer)
- (insert "You are about to submit a bug report to the Org-mode mailing list.
+ (insert "You are about to submit a bug report to the Org mailing list.
-We would like to add your full Org-mode and Outline configuration to the
+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.
@@ -21141,7 +21542,7 @@ 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-mode configuration ")
+ (when (yes-or-no-p "Include your Org configuration ")
(mapatoms
(lambda (v)
(and (boundp v)
@@ -21160,11 +21561,11 @@ what in fact did happen. You don't know how to make a good report? See
http://orgmode.org/manual/Feedback.html#Feedback
-Your bug report will be posted to the Org-mode mailing list.
+Your bug report will be posted to the Org mailing list.
------------------------------------------------------------------------")
(save-excursion
- (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
- (replace-match "\\1Bug: \\3 [\\2]")))))
+ (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t)
+ (replace-match "\\1Bug: \\3 [\\2]")))))
(defun org-install-agenda-files-menu ()
@@ -21172,7 +21573,7 @@ Your bug report will be posted to the Org-mode mailing list.
(save-excursion
(while bl
(set-buffer (pop bl))
- (if (derived-mode-p 'org-mode) (setq bl nil)))
+ (when (derived-mode-p 'org-mode) (setq bl nil)))
(when (derived-mode-p 'org-mode)
(easy-menu-change
'("Org") "File List for Agenda"
@@ -21184,13 +21585,15 @@ Your bug report will be posted to the Org-mode mailing list.
["Cycle through agenda files" org-cycle-agenda-files t]
["Occur in all agenda files" org-occur-in-agenda-files t]
"--")
- (mapcar 'org-file-menu-entry (org-agenda-files t))))))))
+ (mapcar 'org-file-menu-entry
+ ;; Prevent initialization from failing.
+ (ignore-errors (org-agenda-files t)))))))))
;;;; Documentation
(defun org-require-autoloaded-modules ()
(interactive)
- (mapc 'require
+ (mapc #'require
'(org-agenda org-archive org-attach org-clock org-colview org-id
org-table org-timer)))
@@ -21203,13 +21606,8 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(let* ((org-dir (org-find-library-dir "org"))
(contrib-dir (or (org-find-library-dir "org-contribdir") org-dir))
(feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?")
- (remove-re (mapconcat 'identity
- (mapcar (lambda (f) (concat "^" f "$"))
- (list (if (featurep 'xemacs)
- "org-colview"
- "org-colview-xemacs")
- "org" "org-loaddefs" "org-version"))
- "\\|"))
+ (remove-re (format "\\`%s\\'"
+ (regexp-opt '("org" "org-loaddefs" "org-version"))))
(feats (delete-dups
(mapcar 'file-name-sans-extension
(mapcar 'file-name-nondirectory
@@ -21241,9 +21639,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
't)
f))
lfeat)))
- (if load-uncore
- (message "The following feature%s found in load-path, please check if that's correct:\n%s"
- (if (> (length load-uncore) 1) "s were" " was") load-uncore))
+ (when load-uncore
+ (message "The following feature%s found in load-path, please check if that's correct:\n%s"
+ (if (> (length load-uncore) 1) "s were" " was") load-uncore))
(if load-misses
(message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s"
(if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full))
@@ -21258,7 +21656,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(customize-browse 'org))
(defun org-create-customize-menu ()
- "Create a full customization menu for Org-mode, insert it into the menu."
+ "Create a full customization menu for Org mode, insert it into the menu."
(interactive)
(org-load-modules-maybe)
(org-require-autoloaded-modules)
@@ -21281,9 +21679,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
;;; Generally useful functions
-(defun org-get-at-bol (property)
- "Get text property PROPERTY at beginning of line."
- (get-text-property (point-at-bol) property))
+(defun org-get-at-eol (property n)
+ "Get text property PROPERTY at the end of line less N characters."
+ (get-text-property (- (point-at-eol) n) property))
(defun org-find-text-property-in-string (prop s)
"Return the first non-nil value of property PROP in string S."
@@ -21291,19 +21689,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(get-text-property (or (next-single-property-change 0 prop s) 0)
prop s)))
-(defun org-display-warning (message) ;; Copied from Emacs-Muse
+(defun org-display-warning (message)
"Display the given MESSAGE as a warning."
- (if (fboundp 'display-warning)
- (display-warning 'org message
- (if (featurep 'xemacs) 'warning :warning))
- (let ((buf (get-buffer-create "*Org warnings*")))
- (with-current-buffer buf
- (goto-char (point-max))
- (insert "Warning (Org): " message)
- (unless (bolp)
- (newline)))
- (display-buffer buf)
- (sit-for 0))))
+ (display-warning 'org message :warning))
(defun org-eval (form)
"Eval FORM and return result."
@@ -21322,32 +21710,41 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(>= (match-end 0) pos)
start))))
-(defun org-in-commented-line ()
- "Is point in a line starting with `#'?"
- (equal (char-after (point-at-bol)) ?#))
-
-(defun org-in-indented-comment-line ()
- "Is point in a line starting with `#' after some white space?"
- (save-excursion
- (save-match-data
- (goto-char (point-at-bol))
- (looking-at "[ \t]*#"))))
-
(defun org-in-verbatim-emphasis ()
(save-match-data
- (and (org-in-regexp org-emph-re 2)
+ (and (org-in-regexp org-verbatim-re 2)
(>= (point) (match-beginning 3))
- (<= (point) (match-end 4))
- (member (match-string 3) '("=" "~")))))
+ (<= (point) (match-end 4)))))
+
+(defun org-overlay-display (ovl text &optional face evap)
+ "Make overlay OVL display TEXT with face FACE."
+ (overlay-put ovl 'display text)
+ (if face (overlay-put ovl 'face face))
+ (if evap (overlay-put ovl 'evaporate t)))
+
+(defun org-overlay-before-string (ovl text &optional face evap)
+ "Make overlay OVL display TEXT with face FACE."
+ (if face (org-add-props text nil 'face face))
+ (overlay-put ovl 'before-string text)
+ (if evap (overlay-put ovl 'evaporate t)))
+
+(defun org-find-overlays (prop &optional pos delete)
+ "Find all overlays specifying PROP at POS or point.
+If DELETE is non-nil, delete all those overlays."
+ (let (found)
+ (dolist (ov (overlays-at (or pos (point))) found)
+ (cond ((not (overlay-get ov prop)))
+ (delete (delete-overlay ov))
+ (t (push ov found))))))
(defun org-goto-marker-or-bmk (marker &optional bookmark)
"Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK."
(if (and marker (marker-buffer marker)
(buffer-live-p (marker-buffer marker)))
(progn
- (org-pop-to-buffer-same-window (marker-buffer marker))
- (if (or (> marker (point-max)) (< marker (point-min)))
- (widen))
+ (pop-to-buffer-same-window (marker-buffer marker))
+ (when (or (> marker (point-max)) (< marker (point-min)))
+ (widen))
(goto-char marker)
(org-show-context 'org-goto))
(if bookmark
@@ -21365,32 +21762,8 @@ With prefix arg UNCOMPILED, load the uncompiled versions."
(interactive "p")
(self-insert-command N))
-(defun org-string-width (s)
- "Compute width of string, ignoring invisible characters.
-This ignores character with invisibility property `org-link', and also
-characters with property `org-cwidth', because these will become invisible
-upon the next fontification round."
- (let (b l)
- (when (or (eq t buffer-invisibility-spec)
- (assq 'org-link buffer-invisibility-spec))
- (while (setq b (text-property-any 0 (length s)
- 'invisible 'org-link s))
- (setq s (concat (substring s 0 b)
- (substring s (or (next-single-property-change
- b 'invisible s)
- (length s)))))))
- (while (setq b (text-property-any 0 (length s) 'org-cwidth t s))
- (setq s (concat (substring s 0 b)
- (substring s (or (next-single-property-change
- b 'org-cwidth s)
- (length s))))))
- (setq l (string-width s) b -1)
- (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s))
- (setq l (- l (get-text-property b 'org-dwidth-n s))))
- l))
-
(defun org-shorten-string (s maxlength)
- "Shorten string S so tht it is no longer than MAXLENGTH characters.
+ "Shorten string S so that it is no longer than MAXLENGTH characters.
If the string is shorter or has length MAXLENGTH, just return the
original string. If it is longer, the functions finds a space in the
string, breaks this string off at that locations and adds three dots
@@ -21410,8 +21783,8 @@ if necessary."
"Get the indentation of the current line, interpreting tabs.
When LINE is given, assume it represents a line and compute its indentation."
(if line
- (if (string-match "^ *" (org-remove-tabs line))
- (match-end 0))
+ (when (string-match "^ *" (org-remove-tabs line))
+ (match-end 0))
(save-excursion
(beginning-of-line 1)
(skip-chars-forward " \t")
@@ -21448,35 +21821,45 @@ leave it alone. If it is larger than ind, set it to the target."
(let* ((l (org-remove-tabs line))
(i (org-get-indentation l))
(i1 (car ind)) (i2 (cdr ind)))
- (if (>= i i2) (setq l (substring line i2)))
+ (when (>= i i2) (setq l (substring line i2)))
(if (> i1 0)
(concat (make-string i1 ?\ ) l)
l)))
(defun org-remove-indentation (code &optional n)
- "Remove the maximum common indentation from the lines in CODE.
-N may optionally be the number of spaces to remove."
+ "Remove maximum common indentation in string CODE and return it.
+N may optionally be the number of columns to remove. Return CODE
+as-is if removal failed."
(with-temp-buffer
(insert code)
- (org-do-remove-indentation n)
- (buffer-string)))
+ (if (org-do-remove-indentation n) (buffer-string) code)))
(defun org-do-remove-indentation (&optional n)
- "Remove the maximum common indentation from the buffer."
- (untabify (point-min) (point-max))
- (let ((min 10000) re)
- (if n
- (setq min n)
- (goto-char (point-min))
- (while (re-search-forward "^ *[^ \n]" nil t)
- (setq min (min min (1- (- (match-end 0) (match-beginning 0)))))))
- (unless (or (= min 0) (= min 10000))
- (setq re (format "^ \\{%d\\}" min))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (replace-match "")
- (end-of-line 1))
- min)))
+ "Remove the maximum common indentation from the buffer.
+When optional argument N is a positive integer, remove exactly
+that much characters from indentation, if possible. Return nil
+if it fails."
+ (catch :exit
+ (goto-char (point-min))
+ ;; Find maximum common indentation, if not specified.
+ (let ((n (or n
+ (let ((min-ind (point-max)))
+ (save-excursion
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
+ (let ((ind (1- (current-column))))
+ (if (zerop ind) (throw :exit nil)
+ (setq min-ind (min min-ind ind))))))
+ min-ind))))
+ (if (zerop n) (throw :exit nil)
+ ;; Remove exactly N indentation, but give up if not possible.
+ (while (not (eobp))
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
+ ((< ind n) (throw :exit nil))
+ (t (indent-line-to (- ind n))))
+ (forward-line)))
+ ;; Signal success.
+ t))))
(defun org-fill-template (template alist)
"Find each %key of ALIST in TEMPLATE and replace it."
@@ -21496,12 +21879,6 @@ N may optionally be the number of spaces to remove."
(or (buffer-base-buffer buffer)
buffer)))
-(defun org-trim (s)
- "Remove whitespace at beginning and end of string."
- (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s)))
- (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s)))
- s)
-
(defun org-wrap (string &optional width lines)
"Wrap string to either a number of lines, or a width in characters.
If WIDTH is non-nil, the string is wrapped to that width, however many lines
@@ -21510,7 +21887,7 @@ wrapped to the length of that word.
IF WIDTH is nil and LINES is non-nil, the string is forced into at most that
many lines, whatever width that takes.
The return value is a list of lines, without newlines at the end."
- (let* ((words (org-split-string string "[ \t\n]+"))
+ (let* ((words (split-string string))
(maxword (apply 'max (mapcar 'org-string-width words)))
w ll)
(cond (width
@@ -21537,34 +21914,6 @@ The return value is a list of lines, without newlines at the end."
(setq lines (push line lines)))
(nreverse lines)))
-(defun org-split-string (string &optional separators)
- "Splits STRING into substrings at SEPARATORS.
-No empty strings are returned if there are matches at the beginning
-and end of string."
- (let ((rexp (or separators "[ \f\t\n\r\v]+"))
- (start 0)
- notfirst
- (list nil))
- (while (and (string-match rexp string
- (if (and notfirst
- (= start (match-beginning 0))
- (< start (length string)))
- (1+ start) start))
- (< (match-beginning 0) (length string)))
- (setq notfirst t)
- (or (eq (match-beginning 0) 0)
- (and (eq (match-beginning 0) (match-end 0))
- (eq (match-beginning 0) start))
- (setq list
- (cons (substring string start (match-beginning 0))
- list)))
- (setq start (match-end 0)))
- (or (eq start (length string))
- (setq list
- (cons (substring string start)
- list)))
- (nreverse list)))
-
(defun org-quote-vert (s)
"Replace \"|\" with \"\\vert\"."
(while (string-match "|" s)
@@ -21579,10 +21928,8 @@ and end of string."
"Whether point is in a code source block.
When INSIDE is non-nil, don't consider we are within a src block
when point is at #+BEGIN_SRC or #+END_SRC."
- (let ((case-fold-search t) ov)
- (or (and (setq ov (overlays-at (point)))
- (memq 'org-block-background
- (overlay-properties (car ov))))
+ (let ((case-fold-search t))
+ (or (and (eq (get-char-property (point) 'src-block) t))
(and (not inside)
(save-match-data
(save-excursion
@@ -21604,13 +21951,13 @@ contexts are:
:item on the first line of a plain list item
:item-bullet on the bullet/number of a plain list item
:checkbox on the checkbox in a plain list item
-:table in an org-mode table
+:table in an Org table
:table-special on a special filed in a table
:table-table in a table.el table
:clocktable in a clocktable
:src-block in a source block
:link on a hyperlink
-:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE.
+:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT.
:target on a <<target>>
:radio-target on a <<<radio-target>>>
:latex-fragment on a LaTeX fragment
@@ -21635,8 +21982,8 @@ and :keyword."
(push (org-point-in-group p 4 :tags) clist))
(goto-char p)
(skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1))
- (if (looking-at "\\[#[A-Z0-9]\\]")
- (push (org-point-in-group p 0 :priority) clist)))
+ (when (looking-at "\\[#[A-Z0-9]\\]")
+ (push (org-point-in-group p 0 :priority) clist)))
((org-at-item-p)
(push (org-point-in-group p 2 :item-bullet) clist)
@@ -21648,10 +21995,10 @@ and :keyword."
((org-at-table-p)
(push (list :table (org-table-begin) (org-table-end)) clist)
- (if (memq 'org-formula faces)
- (push (list :table-special
- (previous-single-property-change p 'face)
- (next-single-property-change p 'face)) clist)))
+ (when (memq 'org-formula faces)
+ (push (list :table-special
+ (previous-single-property-change p 'face)
+ (next-single-property-change p 'face)) clist)))
((org-at-table-p 'any)
(push (list :table-table) clist)))
(goto-char p)
@@ -21660,16 +22007,16 @@ and :keyword."
;; New the "medium" contexts: clocktables, source blocks
(cond ((org-in-clocktable-p)
(push (list :clocktable
- (and (or (looking-at "#\\+BEGIN: clocktable")
- (search-backward "#+BEGIN: clocktable" nil t))
- (match-beginning 0))
- (and (re-search-forward "#\\+END:?" nil t)
+ (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)")
+ (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t))
+ (match-beginning 1))
+ (and (re-search-forward "[ \t]*#\\+END:?" nil t)
(match-end 0))) clist))
((org-in-src-block-p)
(push (list :src-block
- (and (or (looking-at "#\\+BEGIN_SRC")
- (search-backward "#+BEGIN_SRC" nil t))
- (match-beginning 0))
+ (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))))
(goto-char p)
@@ -21689,14 +22036,14 @@ and :keyword."
((org-at-target-p)
(push (org-point-in-group p 0 :target) clist)
(goto-char (1- (match-beginning 0)))
- (if (looking-at org-radio-target-regexp)
- (push (org-point-in-group p 0 :radio-target) clist))
+ (when (looking-at org-radio-target-regexp)
+ (push (org-point-in-group p 0 :radio-target) clist))
(goto-char p))
- ((setq o (car (delq nil
- (mapcar
- (lambda (x)
- (if (memq x org-latex-fragment-image-overlays) x))
- (overlays-at (point))))))
+ ((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)
(push (list :latex-preview
@@ -21708,35 +22055,27 @@ and :keyword."
(setq clist (nreverse (delq nil clist)))
clist))
-;; FIXME: Compare with at-regexp-p Do we need both?
-(defun org-in-regexp (re &optional nlines visually)
- "Check if point is inside a match of regexp.
-Normally only the current line is checked, but you can include NLINES extra
-lines both before and after point into the search.
-If VISUALLY is set, require that the cursor is not after the match but
-really on, so that the block visually is on the match."
- (catch 'exit
+(defun org-in-regexp (regexp &optional nlines visually)
+ "Check if point is inside a match of REGEXP.
+
+Normally only the current line is checked, but you can include
+NLINES extra lines around point into the search. If VISUALLY is
+set, require that the cursor is not after the match but really
+on, so that the block visually is on the match.
+
+Return nil or a cons cell (BEG . END) where BEG and END are,
+respectively, the positions at the beginning and the end of the
+match."
+ (catch :exit
(let ((pos (point))
- (eol (point-at-eol (+ 1 (or nlines 0))))
- (inc (if visually 1 0)))
+ (eol (line-end-position (if nlines (1+ nlines) 1))))
(save-excursion
(beginning-of-line (- 1 (or nlines 0)))
- (while (re-search-forward re eol t)
- (if (and (<= (match-beginning 0) pos)
- (>= (+ inc (match-end 0)) pos))
- (throw 'exit (cons (match-beginning 0) (match-end 0)))))))))
-
-(defun org-at-regexp-p (regexp)
- "Is point inside a match of REGEXP in the current line?"
- (catch 'exit
- (save-excursion
- (let ((pos (point)) (end (point-at-eol)))
- (beginning-of-line 1)
- (while (re-search-forward regexp end t)
- (if (and (<= (match-beginning 0) pos)
- (>= (match-end 0) pos))
- (throw 'exit t)))
- nil))))
+ (while (and (re-search-forward regexp eol t)
+ (<= (match-beginning 0) pos))
+ (let ((end (match-end 0)))
+ (when (or (> end pos) (and (= end pos) (not visually)))
+ (throw :exit (cons (match-beginning 0) (match-end 0))))))))))
(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down)
"Non-nil when point is between matches of START-RE and END-RE.
@@ -21757,7 +22096,7 @@ position before START-RE (resp. after END-RE)."
(save-excursion
;; Point is on a block when on START-RE or if START-RE can be
;; found before it...
- (and (or (org-at-regexp-p start-re)
+ (and (or (org-in-regexp start-re)
(re-search-backward start-re limit-up t))
(setq beg (match-beginning 0))
;; ... and END-RE after it...
@@ -21783,27 +22122,15 @@ block from point."
(let ((case-fold-search t)
(lim-up (save-excursion (outline-previous-heading)))
(lim-down (save-excursion (outline-next-heading))))
- (mapc (lambda (name)
- (let ((n (regexp-quote name)))
- (when (org-between-regexps-p
- (concat "^[ \t]*#\\+begin_" n)
- (concat "^[ \t]*#\\+end_" n)
- lim-up lim-down)
- (throw 'exit n))))
- names))
+ (dolist (name names)
+ (let ((n (regexp-quote name)))
+ (when (org-between-regexps-p
+ (concat "^[ \t]*#\\+begin_" n)
+ (concat "^[ \t]*#\\+end_" n)
+ lim-up lim-down)
+ (throw 'exit n)))))
nil)))
-(defun org-in-drawer-p ()
- "Is point within a drawer?"
- (save-match-data
- (let ((case-fold-search t)
- (lim-up (save-excursion (outline-previous-heading)))
- (lim-down (save-excursion (outline-next-heading))))
- (org-between-regexps-p
- (concat "^[ \t]*:" (regexp-opt org-drawers) ":")
- "^[ \t]*:end:.*$"
- lim-up lim-down))))
-
(defun org-occur-in-agenda-files (regexp &optional _nlines)
"Call `multi-occur' with buffers for all agenda files."
(interactive "sOrg-files matching: ")
@@ -21815,40 +22142,21 @@ block from point."
(setq files (org-add-archive-files files)))
(dolist (f extra)
(unless (member (file-truename f) tnames)
- (unless (member f files) (setq files (append files (list f))))
- (setq tnames (append tnames (list (file-truename f))))))
+ (unless (member f files) (setq files (append files (list f))))
+ (setq tnames (append tnames (list (file-truename f))))))
(multi-occur
(mapcar (lambda (x)
(with-current-buffer
- ;; FIXME: Why not just (find-file-noselect x)?
- ;; Is it to avoid the "revert buffer" prompt?
+ ;; FIXME: Why not just (find-file-noselect x)?
+ ;; Is it to avoid the "revert buffer" prompt?
(or (get-file-buffer x) (find-file-noselect x))
(widen)
(current-buffer)))
files)
regexp)))
-(if (boundp 'occur-mode-find-occurrence-hook)
- ;; Emacs 23
- (add-hook 'occur-mode-find-occurrence-hook
- (lambda ()
- (when (derived-mode-p 'org-mode)
- (org-reveal))))
- ;; Emacs 22
- (defadvice occur-mode-goto-occurrence
- (after org-occur-reveal activate)
- (and (derived-mode-p 'org-mode) (org-reveal)))
- (defadvice occur-mode-goto-occurrence-other-window
- (after org-occur-reveal activate)
- (and (derived-mode-p 'org-mode) (org-reveal)))
- (defadvice occur-mode-display-occurrence
- (after org-occur-reveal activate)
- (when (derived-mode-p 'org-mode)
- (let ((pos (occur-mode-find-occurrence)))
- (with-current-buffer (marker-buffer pos)
- (save-excursion
- (goto-char pos)
- (org-reveal)))))))
+(add-hook 'occur-mode-find-occurrence-hook
+ (lambda () (when (derived-mode-p 'org-mode) (org-reveal))))
(defun org-occur-link-in-agenda-files ()
"Create a link and search for it in the agendas.
@@ -21878,81 +22186,27 @@ merge (a 1) and (a 3) into (a 1 3).
The function returns the new ALIST."
(let (rtn)
- (mapc
- (lambda (e)
- (let (n)
- (if (not (assoc (car e) rtn))
- (push e rtn)
- (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
- (setq rtn (assq-delete-all (car e) rtn))
- (push n rtn))))
- alist)
- rtn))
+ (dolist (e alist rtn)
+ (let (n)
+ (if (not (assoc (car e) rtn))
+ (push e rtn)
+ (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
+ (setq rtn (assq-delete-all (car e) rtn))
+ (push n rtn))))))
(defun org-delete-all (elts list)
- "Remove all elements in ELTS from LIST."
+ "Remove all elements in ELTS from LIST.
+Comparison is done with `equal'. It is a destructive operation
+that may remove elements by altering the list structure."
(while elts
(setq list (delete (pop elts) list)))
list)
-(defun org-count (cl-item cl-seq)
- "Count the number of occurrences of ITEM in SEQ.
-Taken from `count' in cl-seq.el with all keyword arguments removed."
- (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x)
- (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
- (while (< cl-start cl-end)
- (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start)))
- (if (equal cl-item cl-x) (setq cl-count (1+ cl-count)))
- (setq cl-start (1+ cl-start)))
- cl-count))
-
-(defun org-remove-if (predicate seq)
- "Remove everything from SEQ that fulfills PREDICATE."
- (let (res e)
- (while seq
- (setq e (pop seq))
- (if (not (funcall predicate e)) (push e res)))
- (nreverse res)))
-
-(defun org-remove-if-not (predicate seq)
- "Remove everything from SEQ that does not fulfill PREDICATE."
- (let (res e)
- (while seq
- (setq e (pop seq))
- (if (funcall predicate e) (push e res)))
- (nreverse res)))
-
-(defun org-reduce (cl-func cl-seq &rest cl-keys)
- "Reduce two-argument FUNCTION across SEQ.
-Taken from `reduce' in cl-seq.el with all keyword arguments but
-\":initial-value\" removed."
- (let ((cl-accum (cond ((memq :initial-value cl-keys)
- (cadr (memq :initial-value cl-keys)))
- (cl-seq (pop cl-seq))
- (t (funcall cl-func)))))
- (while cl-seq
- (setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
- cl-accum))
-
-(defun org-every (pred seq)
- "Return true if PREDICATE is true of every element of SEQ.
-Adapted from `every' in cl.el."
- (catch 'org-every
- (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq)
- t))
-
-(defun org-some (pred seq)
- "Return true if PREDICATE is true of any element of SEQ.
-Adapted from `some' in cl.el."
- (catch 'org-some
- (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq)
- nil))
-
(defun org-back-over-empty-lines ()
"Move backwards over whitespace, to the beginning of the first empty line.
Returns the number of empty lines passed."
(let ((pos (point)))
- (if (cdr (assoc 'heading org-blank-before-new-entry))
+ (if (cdr (assq 'heading org-blank-before-new-entry))
(skip-chars-backward " \t\n\r")
(unless (eobp)
(forward-line -1)))
@@ -22005,7 +22259,7 @@ so values can contain further %-escapes if they are define later in TABLE."
(let ((tbl (copy-alist table))
(case-fold-search nil)
(pchg 0)
- e re rpl)
+ re rpl)
(dolist (e tbl)
(setq re (concat "%-?[0-9.]*" (substring (car e) 1)))
(when (and (cdr e) (string-match re (cdr e)))
@@ -22023,16 +22277,6 @@ so values can contain further %-escapes if they are define later in TABLE."
(setq string (replace-match sref t t string)))))
string))
-(defun org-sublist (list start end)
- "Return a section of LIST, from START to END.
-Counting starts at 1."
- (let (rtn (c start))
- (setq list (nthcdr (1- start) list))
- (while (and list (<= c end))
- (push (pop list) rtn)
- (setq c (1+ c)))
- (nreverse rtn)))
-
(defun org-find-base-buffer-visiting (file)
"Like `find-buffer-visiting' but always return the base buffer and
not an indirect buffer."
@@ -22042,26 +22286,12 @@ not an indirect buffer."
(or (buffer-base-buffer buf) buf)
nil)))
-(defun org-image-file-name-regexp (&optional extensions)
- "Return regexp matching the file names of images.
-If EXTENSIONS is given, only match these."
- (if (and (not extensions) (fboundp 'image-file-name-regexp))
- (image-file-name-regexp)
- (let ((image-file-name-extensions
- (or extensions
- '("png" "jpeg" "jpg" "gif" "tiff" "tif"
- "xbm" "xpm" "pbm" "pgm" "ppm"))))
- (concat "\\."
- (regexp-opt (nconc (mapcar 'upcase
- image-file-name-extensions)
- image-file-name-extensions)
- t)
- "\\'"))))
-
-(defun org-file-image-p (file &optional extensions)
+;;; TODO: Only called once, from ox-odt which should probably use
+;;; org-export-inline-image-p or something.
+(defun org-file-image-p (file)
"Return non-nil if FILE is an image."
(save-match-data
- (string-match (org-image-file-name-regexp extensions) file)))
+ (string-match (image-file-name-regexp) file)))
(defun org-get-cursor-date (&optional with-time)
"Return the date at cursor in as a time.
@@ -22085,10 +22315,10 @@ the agenda) or the current time of the day."
(nth 1 date) (nth 0 date) (nth 2 date))))
((eq major-mode 'org-agenda-mode)
(setq day (get-text-property (point) 'day))
- (if day
- (setq date (calendar-gregorian-from-absolute day)
- defd (encode-time 0 (or mod 0) (or hod 0)
- (nth 1 date) (nth 0 date) (nth 2 date))))))
+ (when day
+ (setq date (calendar-gregorian-from-absolute day)
+ defd (encode-time 0 (or mod 0) (or hod 0)
+ (nth 1 date) (nth 0 date) (nth 2 date))))))
(or defd (current-time))))
(defun org-mark-subtree (&optional up)
@@ -22101,177 +22331,441 @@ hierarchy of headlines by UP levels before marking the subtree."
(cond ((org-at-heading-p) (beginning-of-line))
((org-before-first-heading-p) (user-error "Not in a subtree"))
(t (outline-previous-visible-heading 1))))
- (when up (while (and (> up 0) (org-up-heading-safe)) (decf up)))
- (if (org-called-interactively-p 'any)
+ (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up)))
+ (if (called-interactively-p 'any)
(call-interactively 'org-mark-element)
(org-mark-element)))
+(defun org-file-newer-than-p (file time)
+ "Non-nil if FILE is newer than TIME.
+FILE is a filename, as a string, TIME is a list of integers, as
+returned by, e.g., `current-time'."
+ (and (file-exists-p file)
+ ;; Only compare times up to whole seconds as some file-systems
+ ;; (e.g. HFS+) do not retain any finer granularity. As
+ ;; a consequence, make sure we return non-nil when the two
+ ;; times are equal.
+ (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2)
+ (cl-subseq time 0 2)))))
+
+(defun org-compile-file (source process ext &optional err-msg log-buf spec)
+ "Compile a SOURCE file using PROCESS.
+
+PROCESS is either a function or a list of shell commands, as
+strings. EXT is a file extension, without the leading dot, as
+a string. It is used to check if the process actually succeeded.
+
+PROCESS must create a file with the same base name and directory
+as SOURCE, but ending with EXT. The function then returns its
+filename. Otherwise, it raises an error. The error message can
+then be refined by providing string ERR-MSG, which is appended to
+the standard message.
+
+If PROCESS is a function, it is called with a single argument:
+the SOURCE file.
+
+If it is a list of commands, each of them is called using
+`shell-command'. By default, in each command, %b, %f, %F, %o and
+%O are replaced with, respectively, SOURCE base name, name, full
+name, directory and absolute output file name. It is possible,
+however, to use more place-holders by specifying them in optional
+argument SPEC, as an alist following the pattern
+
+ (CHARACTER . REPLACEMENT-STRING).
+
+When PROCESS is a list of commands, optional argument LOG-BUF can
+be set to a buffer or a buffer name. `shell-command' then uses
+it for output."
+ (let* ((base-name (file-name-base source))
+ (full-name (file-truename source))
+ (out-dir (or (file-name-directory source) "./"))
+ (output (expand-file-name (concat base-name "." ext) out-dir))
+ (time (current-time))
+ (err-msg (if (stringp err-msg) (concat ". " err-msg) "")))
+ (save-window-excursion
+ (pcase process
+ ((pred functionp) (funcall process (shell-quote-argument source)))
+ ((pred consp)
+ (let ((log-buf (and log-buf (get-buffer-create log-buf)))
+ (spec (append spec
+ `((?b . ,(shell-quote-argument base-name))
+ (?f . ,(shell-quote-argument source))
+ (?F . ,(shell-quote-argument full-name))
+ (?o . ,(shell-quote-argument out-dir))
+ (?O . ,(shell-quote-argument output))))))
+ (dolist (command process)
+ (shell-command (format-spec command spec) log-buf))
+ (when log-buf (with-current-buffer log-buf (compilation-mode)))))
+ (_ (error "No valid command to process %S%s" source err-msg))))
+ ;; Check for process failure. Output file is expected to be
+ ;; located in the same directory as SOURCE.
+ (unless (org-file-newer-than-p output time)
+ (error (format "File %S wasn't produced%s" output err-msg)))
+ output))
;;; Indentation
+(defvar org-element-greater-elements)
+(defun org--get-expected-indentation (element contentsp)
+ "Expected indentation column for current line, according to ELEMENT.
+ELEMENT is an element containing point. CONTENTSP is non-nil
+when indentation is to be computed according to contents of
+ELEMENT."
+ (let ((type (org-element-type element))
+ (start (org-element-property :begin element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (org-with-wide-buffer
+ (cond
+ (contentsp
+ (cl-case type
+ ((diary-sexp footnote-definition) 0)
+ ((headline inlinetask nil)
+ (if (not org-adapt-indentation) 0
+ (let ((level (org-current-level)))
+ (if level (1+ level) 0))))
+ ((item plain-list) (org-list-item-body-column post-affiliated))
+ (t
+ (goto-char start)
+ (org-get-indentation))))
+ ((memq type '(headline inlinetask nil))
+ (if (org-match-line "[ \t]*$")
+ (org--get-expected-indentation element t)
+ 0))
+ ((memq type '(diary-sexp footnote-definition)) 0)
+ ;; First paragraph of a footnote definition or an item.
+ ;; Indent like parent.
+ ((< (line-beginning-position) start)
+ (org--get-expected-indentation
+ (org-element-property :parent element) t))
+ ;; At first line: indent according to previous sibling, if any,
+ ;; ignoring footnote definitions and inline tasks, or parent's
+ ;; contents.
+ ((= (line-beginning-position) start)
+ (catch 'exit
+ (while t
+ (if (= (point-min) start) (throw 'exit 0)
+ (goto-char (1- start))
+ (let* ((previous (org-element-at-point))
+ (parent previous))
+ (while (and parent (<= (org-element-property :end parent) start))
+ (setq previous parent
+ parent (org-element-property :parent parent)))
+ (cond
+ ((not previous) (throw 'exit 0))
+ ((> (org-element-property :end previous) start)
+ (throw 'exit (org--get-expected-indentation previous t)))
+ ((memq (org-element-type previous)
+ '(footnote-definition inlinetask))
+ (setq start (org-element-property :begin previous)))
+ (t (goto-char (org-element-property :begin previous))
+ (throw 'exit
+ (if (bolp) (org-get-indentation)
+ ;; At first paragraph in an item or
+ ;; a footnote definition.
+ (org--get-expected-indentation
+ (org-element-property :parent previous) t))))))))))
+ ;; Otherwise, move to the first non-blank line above.
+ (t
+ (beginning-of-line)
+ (let ((pos (point)))
+ (skip-chars-backward " \r\t\n")
+ (cond
+ ;; Two blank lines end a footnote definition or a plain
+ ;; list. When we indent an empty line after them, the
+ ;; containing list or footnote definition is over, so it
+ ;; qualifies as a previous sibling. Therefore, we indent
+ ;; like its first line.
+ ((and (memq type '(footnote-definition plain-list))
+ (> (count-lines (point) pos) 2))
+ (goto-char start)
+ (org-get-indentation))
+ ;; Line above is the first one of a paragraph at the
+ ;; beginning of an item or a footnote definition. Indent
+ ;; like parent.
+ ((< (line-beginning-position) start)
+ (org--get-expected-indentation
+ (org-element-property :parent element) t))
+ ;; Line above is the beginning of an element, i.e., point
+ ;; was originally on the blank lines between element's start
+ ;; and contents.
+ ((= (line-beginning-position) post-affiliated)
+ (org--get-expected-indentation element t))
+ ;; POS is after contents in a greater element. Indent like
+ ;; the beginning of the element.
+ ((and (memq type org-element-greater-elements)
+ (let ((cend (org-element-property :contents-end element)))
+ (and cend (<= cend pos))))
+ ;; As a special case, if point is at the end of a footnote
+ ;; definition or an item, indent like the very last element
+ ;; within. If that last element is an item, indent like
+ ;; its contents.
+ (if (memq type '(footnote-definition item plain-list))
+ (let ((last (org-element-at-point)))
+ (goto-char pos)
+ (org--get-expected-indentation
+ last (eq (org-element-type last) 'item)))
+ (goto-char start)
+ (org-get-indentation)))
+ ;; In any other case, indent like the current line.
+ (t (org-get-indentation)))))))))
+
+(defun org--align-node-property ()
+ "Align node property at point.
+Alignment is done according to `org-property-format', which see."
+ (when (save-excursion
+ (beginning-of-line)
+ (looking-at org-property-re))
+ (replace-match
+ (concat (match-string 4)
+ (org-trim
+ (format org-property-format (match-string 1) (match-string 3))))
+ t t)))
+
(defun org-indent-line ()
- "Indent line depending on context."
+ "Indent line depending on context.
+
+Indentation is done according to the following rules:
+
+ - Footnote definitions, diary sexps, headlines and inline tasks
+ have to start at column 0.
+
+ - On the very first line of an element, consider, in order, the
+ next rules until one matches:
+
+ 1. If there's a sibling element before, ignoring footnote
+ definitions and inline tasks, indent like its first line.
+
+ 2. If element has a parent, indent like its contents. More
+ precisely, if parent is an item, indent after the
+ description part, if any, or the bullet (see
+ `org-list-description-max-indent'). Else, indent like
+ parent's first line.
+
+ 3. Otherwise, indent relatively to current level, if
+ `org-adapt-indentation' is non-nil, or to left margin.
+
+ - On a blank line at the end of an element, indent according to
+ the type of the element. More precisely
+
+ 1. If element is a plain list, an item, or a footnote
+ definition, indent like the very last element within.
+
+ 2. If element is a paragraph, indent like its last non blank
+ line.
+
+ 3. Otherwise, indent like its very first line.
+
+ - In the code part of a source block, use language major mode
+ to indent current line if `org-src-tab-acts-natively' is
+ non-nil. If it is nil, do nothing.
+
+ - Otherwise, indent like the first non-blank line above.
+
+The function doesn't indent an item as it could break the whole
+list structure. Instead, use \\<org-mode-map>`\\[org-shiftmetaleft]' or \
+`\\[org-shiftmetaright]'.
+
+Also align node properties according to `org-property-format'."
(interactive)
- (let* ((pos (point))
- (itemp (org-at-item-p))
- (case-fold-search t)
- (org-drawer-regexp (or org-drawer-regexp "\000"))
- (inline-task-p (and (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)))
- (inline-re (and inline-task-p
- (org-inlinetask-outline-regexp)))
- column)
- (if (and orgstruct-is-++ (eq pos (point)))
- (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars))))
- (indent-according-to-mode))
- (beginning-of-line 1)
- (cond
- ;; Headings
- ((looking-at org-outline-regexp) (setq column 0))
- ;; Footnote definition
- ((looking-at org-footnote-definition-re) (setq column 0))
- ;; Literal examples
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (setq column (org-get-indentation))) ; do nothing
- ;; Lists
- ((ignore-errors (goto-char (org-in-item-p)))
- (setq column (if itemp
- (org-get-indentation)
- (org-list-item-body-column (point))))
- (goto-char pos))
- ;; Drawers
- ((and (looking-at "[ \t]*:END:")
- (save-excursion (re-search-backward org-drawer-regexp nil t)))
- (save-excursion
- (goto-char (1- (match-beginning 1)))
- (setq column (current-column))))
- ;; Special blocks
- ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)")
- (save-excursion
- (re-search-backward
- (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t)))
- (setq column (org-get-indentation (match-string 0))))
- ((and (not (looking-at "[ \t]*#\\+begin_"))
- (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_"))
- (save-excursion
- (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t))
- (setq column
- (cond ((equal (downcase (match-string 1)) "src")
- ;; src blocks: let `org-edit-src-exit' handle them
- (org-get-indentation))
- ((equal (downcase (match-string 1)) "example")
- (max (org-get-indentation)
- (org-get-indentation (match-string 0))))
- (t
- (org-get-indentation (match-string 0))))))
- ;; This line has nothing special, look at the previous relevant
- ;; line to compute indentation
- (t
- (beginning-of-line 0)
- (while (and (not (bobp))
- (not (looking-at org-table-line-regexp))
- (not (looking-at org-drawer-regexp))
- ;; When point started in an inline task, do not move
- ;; above task starting line.
- (not (and inline-task-p (looking-at inline-re)))
- ;; Skip drawers, blocks, empty lines, verbatim,
- ;; comments, tables, footnotes definitions, lists,
- ;; inline tasks.
- (or (and (looking-at "[ \t]*:END:")
- (re-search-backward org-drawer-regexp nil t))
- (and (looking-at "[ \t]*#\\+end_")
- (re-search-backward "[ \t]*#\\+begin_"nil t))
- (looking-at "[ \t]*[\n:#|]")
- (looking-at org-footnote-definition-re)
- (and (not inline-task-p)
- (featurep 'org-inlinetask)
- (org-inlinetask-in-task-p)
- (or (org-inlinetask-goto-beginning) t))))
- (beginning-of-line 0))
- (cond
- ;; There was a list item above.
- ((ignore-errors (goto-char (org-in-item-p)))
- (goto-char (org-list-get-top-point (org-list-struct)))
- (setq column (org-get-indentation)))
- ;; There was an heading above.
- ((looking-at "\\*+[ \t]+")
- (if (not org-adapt-indentation)
- (setq column 0)
- (goto-char (match-end 0))
- (setq column (current-column))))
- ;; A drawer had started and is unfinished
- ((looking-at org-drawer-regexp)
- (goto-char (1- (match-beginning 1)))
- (setq column (current-column)))
- ;; Else, nothing noticeable found: get indentation and go on.
- (t (setq column (org-get-indentation))))))
- ;; Now apply indentation and move cursor accordingly
- (goto-char pos)
- (if (<= (current-column) (current-indentation))
- (org-indent-line-to column)
- (save-excursion (org-indent-line-to column)))
- ;; Special polishing for properties, see `org-property-format'
- (setq column (current-column))
- (beginning-of-line 1)
- (if (looking-at org-property-re)
- (replace-match (concat (match-string 4)
- (format org-property-format
- (match-string 1) (match-string 3)))
- t t))
- (org-move-to-column column))))
+ (cond
+ (orgstruct-is-++
+ (let ((indent-line-function
+ (cl-cadadr (assq 'indent-line-function org-fb-vars))))
+ (indent-according-to-mode)))
+ ((org-at-heading-p) 'noindent)
+ (t
+ (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)
+ ((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)
+ ((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-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))
+ (t
+ (let ((column (org--get-expected-indentation element nil)))
+ ;; Preserve current column.
+ (if (<= (current-column) (current-indentation))
+ (indent-line-to column)
+ (save-excursion (indent-line-to column))))
+ ;; Align node property. Also preserve current column.
+ (when (eq type 'node-property)
+ (let ((column (current-column)))
+ (org--align-node-property)
+ (org-move-to-column column)))))))))
+
+(defun org-indent-region (start end)
+ "Indent each non-blank line in the region.
+Called from a program, START and END specify the region to
+indent. The function will not indent contents of example blocks,
+verse blocks and export blocks as leading white spaces are
+assumed to be significant there."
+ (interactive "r")
+ (save-excursion
+ (goto-char start)
+ (skip-chars-forward " \r\t\n")
+ (unless (eobp) (beginning-of-line))
+ (let ((indent-to
+ (lambda (ind pos)
+ ;; Set IND as indentation for all lines between point and
+ ;; POS. Blank lines are ignored. Leave point after POS
+ ;; once done.
+ (let ((limit (copy-marker pos)))
+ (while (< (point) limit)
+ (unless (looking-at-p "[ \t]*$") (indent-line-to ind))
+ (forward-line))
+ (set-marker limit nil))))
+ (end (copy-marker end)))
+ (while (< (point) end)
+ (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element))
+ (element-end (copy-marker (org-element-property :end element)))
+ (ind (org--get-expected-indentation element nil)))
+ (cond
+ ;; Element indented as a single block. Example blocks
+ ;; preserving indentation are a special case since the
+ ;; "contents" must not be indented whereas the block
+ ;; boundaries can.
+ ((or (memq type '(export-block latex-environment))
+ (and (eq type 'example-block)
+ (not
+ (or org-src-preserve-indentation
+ (org-element-property :preserve-indent element)))))
+ (let ((offset (- ind (org-get-indentation))))
+ (unless (zerop offset)
+ (indent-rigidly (org-element-property :begin element)
+ (org-element-property :end element)
+ offset)))
+ (goto-char element-end))
+ ;; Elements indented line wise. Be sure to exclude
+ ;; example blocks (preserving indentation) and source
+ ;; blocks from this category as they are treated
+ ;; specially later.
+ ((or (memq type '(paragraph table table-row))
+ (not (or (org-element-property :contents-begin element)
+ (memq type '(example-block src-block)))))
+ (when (eq type 'node-property)
+ (org--align-node-property)
+ (beginning-of-line))
+ (funcall indent-to ind (min element-end end)))
+ ;; Elements consisting of three parts: before the
+ ;; contents, the contents, and after the contents. The
+ ;; contents are treated specially, according to the
+ ;; element type, or not indented at all. Other parts are
+ ;; indented as a single block.
+ (t
+ (let* ((post (copy-marker
+ (org-element-property :post-affiliated element)))
+ (cbeg
+ (copy-marker
+ (cond
+ ((not (org-element-property :contents-begin element))
+ ;; Fake contents for source blocks.
+ (org-with-wide-buffer
+ (goto-char post)
+ (line-beginning-position 2)))
+ ((memq type '(footnote-definition item plain-list))
+ ;; Contents in these elements could start on
+ ;; the same line as the beginning of the
+ ;; element. Make sure we start indenting
+ ;; from the second line.
+ (org-with-wide-buffer
+ (goto-char post)
+ (end-of-line)
+ (skip-chars-forward " \r\t\n")
+ (if (eobp) (point) (line-beginning-position))))
+ (t (org-element-property :contents-begin element)))))
+ (cend (copy-marker
+ (or (org-element-property :contents-end element)
+ ;; Fake contents for source blocks.
+ (org-with-wide-buffer
+ (goto-char element-end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position)))
+ t)))
+ ;; Do not change items indentation individually as it
+ ;; might break the list as a whole. On the other
+ ;; hand, when at a plain list, indent it as a whole.
+ (cond ((eq type 'plain-list)
+ (let ((offset (- ind (org-get-indentation))))
+ (unless (zerop offset)
+ (indent-rigidly (org-element-property :begin element)
+ (org-element-property :end element)
+ offset))
+ (goto-char cbeg)))
+ ((eq type 'item) (goto-char cbeg))
+ (t (funcall indent-to ind (min cbeg end))))
+ (when (< (point) end)
+ (cl-case type
+ ((example-block verse-block))
+ (src-block
+ ;; In a source block, indent source code
+ ;; according to language major mode, but only if
+ ;; `org-src-tab-acts-natively' is non-nil.
+ (when (and (< (point) end) org-src-tab-acts-natively)
+ (ignore-errors
+ (org-babel-do-in-edit-buffer
+ (indent-region (point-min) (point-max))))))
+ (t (org-indent-region (point) (min cend end))))
+ (goto-char (min cend end))
+ (when (< (point) end)
+ (funcall indent-to ind (min element-end end))))
+ (set-marker post nil)
+ (set-marker cbeg nil)
+ (set-marker cend nil))))
+ (set-marker element-end nil))))
+ (set-marker end nil))))
(defun org-indent-drawer ()
"Indent the drawer at point."
(interactive)
- (let ((p (point))
- (e (and (save-excursion (re-search-forward ":END:" nil t))
- (match-end 0)))
- (folded
- (save-excursion
- (end-of-line)
- (when (overlays-at (point))
- (member 'invisible (overlay-properties
- (car (overlays-at (point)))))))))
- (when folded (org-cycle))
- (indent-for-tab-command)
- (while (and (move-beginning-of-line 2) (< (point) e))
- (indent-for-tab-command))
- (goto-char p)
- (when folded (org-cycle)))
+ (unless (save-excursion
+ (beginning-of-line)
+ (looking-at-p org-drawer-regexp))
+ (user-error "Not at a drawer"))
+ (let ((element (org-element-at-point)))
+ (unless (memq (org-element-type element) '(drawer property-drawer))
+ (user-error "Not at a drawer"))
+ (org-with-wide-buffer
+ (org-indent-region (org-element-property :begin element)
+ (org-element-property :end element))))
(message "Drawer at point indented"))
(defun org-indent-block ()
"Indent the block at point."
(interactive)
- (let ((p (point))
- (case-fold-search t)
- (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t))
- (match-end 0)))
- (folded
- (save-excursion
- (end-of-line)
- (when (overlays-at (point))
- (member 'invisible (overlay-properties
- (car (overlays-at (point)))))))))
- (when folded (org-cycle))
- (indent-for-tab-command)
- (while (and (move-beginning-of-line 2) (< (point) e))
- (indent-for-tab-command))
- (goto-char p)
- (when folded (org-cycle)))
+ (unless (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search t))
+ (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_")))
+ (user-error "Not at a block"))
+ (let ((element (org-element-at-point)))
+ (unless (memq (org-element-type element)
+ '(comment-block center-block dynamic-block example-block
+ export-block quote-block special-block
+ src-block verse-block))
+ (user-error "Not at a block"))
+ (org-with-wide-buffer
+ (org-indent-region (org-element-property :begin element)
+ (org-element-property :end element))))
(message "Block at point indented"))
-(defun org-indent-region (start end)
- "Indent region."
- (interactive "r")
- (save-excursion
- (let ((line-end (org-current-line end)))
- (goto-char start)
- (while (< (org-current-line) line-end)
- (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe))
- (t (call-interactively 'org-indent-line)))
- (move-beginning-of-line 2)))))
-
;;; Filling
@@ -22289,25 +22783,25 @@ hierarchy of headlines by UP levels before marking the subtree."
;; `org-setup-filling' installs filling and auto-filling related
;; variables during `org-mode' initialization.
-(defvar org-element-paragraph-separate) ; org-element.el
(defun org-setup-filling ()
(require 'org-element)
;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate)
- (org-set-local
- 'fill-nobreak-predicate
+ (setq-local
+ fill-nobreak-predicate
(org-uniquify
(append fill-nobreak-predicate
'(org-fill-line-break-nobreak-p
+ org-fill-n-macro-as-item-nobreak-p
org-fill-paragraph-with-timestamp-nobreak-p)))))
(let ((paragraph-ending (substring org-element-paragraph-separate 1)))
- (org-set-local 'paragraph-start paragraph-ending)
- (org-set-local 'paragraph-separate paragraph-ending))
- (org-set-local 'fill-paragraph-function 'org-fill-paragraph)
- (org-set-local 'auto-fill-inhibit-regexp nil)
- (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
- (org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
- (org-set-local 'comment-line-break-function 'org-comment-line-break-function))
+ (setq-local paragraph-start paragraph-ending)
+ (setq-local paragraph-separate paragraph-ending))
+ (setq-local fill-paragraph-function 'org-fill-paragraph)
+ (setq-local auto-fill-inhibit-regexp nil)
+ (setq-local adaptive-fill-function 'org-adaptive-fill-function)
+ (setq-local normal-auto-fill-function 'org-auto-fill-function)
+ (setq-local comment-line-break-function 'org-comment-line-break-function))
(defun org-fill-line-break-nobreak-p ()
"Non-nil when a new line at point would create an Org line break."
@@ -22318,9 +22812,15 @@ hierarchy of headlines by UP levels before marking the subtree."
(defun org-fill-paragraph-with-timestamp-nobreak-p ()
"Non-nil when a new line at point would split a timestamp."
- (and (org-at-timestamp-p t)
+ (and (org-at-timestamp-p 'lax)
(not (looking-at org-ts-regexp-both))))
+(defun org-fill-n-macro-as-item-nobreak-p ()
+ "Non-nil when a new line at point would create a new list."
+ ;; During export, a "n" macro followed by a dot or a closing
+ ;; parenthesis can end up being parsed as a new list item.
+ (looking-at-p "[ \t]*{{{n\\(?:([^\n)]*)\\)?}}}[.)]\\(?:$\\| \\)"))
+
(declare-function message-in-body-p "message" ())
(defvar orgtbl-line-start-regexp) ; From org-table.el
(defun org-adaptive-fill-function ()
@@ -22332,73 +22832,69 @@ matches in paragraphs or comments, use it."
(when (derived-mode-p 'message-mode)
(save-excursion
(beginning-of-line)
- (cond ((or (not (message-in-body-p))
- (looking-at orgtbl-line-start-regexp))
- (throw 'exit nil))
+ (cond ((not (message-in-body-p)) (throw 'exit nil))
+ ((looking-at-p org-table-line-regexp) (throw 'exit nil))
((looking-at message-cite-prefix-regexp)
(throw 'exit (match-string-no-properties 0)))
((looking-at org-outline-regexp)
- (throw 'exit (make-string (length (match-string 0)) ? ))))))
+ (throw 'exit (make-string (length (match-string 0)) ?\s))))))
(org-with-wide-buffer
- (let* ((p (line-beginning-position))
- (element (save-excursion
- (beginning-of-line)
- (or (ignore-errors (org-element-at-point))
- (user-error "An element cannot be parsed line %d"
- (line-number-at-pos (point))))))
- (type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element)))
- (unless (and post-affiliated (< p post-affiliated))
- (case type
- (comment
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*")
- (concat (match-string 0) "# ")))
- (footnote-definition "")
- ((item plain-list)
- (make-string (org-list-item-body-column
- (or post-affiliated
- (org-element-property :begin element)))
- ? ))
- (paragraph
- ;; Fill prefix is usually the same as the current line,
- ;; unless the paragraph is at the beginning of an item.
- (let ((parent (org-element-property :parent element)))
+ (unless (org-at-heading-p)
+ (let* ((p (line-beginning-position))
+ (element (save-excursion
+ (beginning-of-line)
+ (org-element-at-point)))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (unless (< p post-affiliated)
+ (cl-case type
+ (comment
(save-excursion
(beginning-of-line)
- (cond ((eq (org-element-type parent) 'item)
- (make-string (org-list-item-body-column
- (org-element-property :begin parent))
- ? ))
- ((and adaptive-fill-regexp
- ;; Locally disable
- ;; `adaptive-fill-function' to let
- ;; `fill-context-prefix' handle
- ;; `adaptive-fill-regexp' variable.
- (let (adaptive-fill-function)
- (fill-context-prefix
- post-affiliated
- (org-element-property :end element)))))
- ((looking-at "[ \t]+") (match-string 0))
- (t "")))))
- (comment-block
- ;; Only fill contents if P is within block boundaries.
- (let* ((cbeg (save-excursion (goto-char post-affiliated)
- (forward-line)
- (point)))
- (cend (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (when (and (>= p cbeg) (< p cend))
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
- (match-string 0)
- ""))))))))))
+ (looking-at "[ \t]*")
+ (concat (match-string 0) "# ")))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column post-affiliated) ?\s))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; unless the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
+ (save-excursion
+ (beginning-of-line)
+ (cond ((eq (org-element-type parent) 'item)
+ (make-string (org-list-item-body-column
+ (org-element-property :begin parent))
+ ?\s))
+ ((and adaptive-fill-regexp
+ ;; Locally disable
+ ;; `adaptive-fill-function' to let
+ ;; `fill-context-prefix' handle
+ ;; `adaptive-fill-regexp' variable.
+ (let (adaptive-fill-function)
+ (fill-context-prefix
+ post-affiliated
+ (org-element-property :end element)))))
+ ((looking-at "[ \t]+") (match-string 0))
+ (t "")))))
+ (comment-block
+ ;; Only fill contents if P is within block boundaries.
+ (let* ((cbeg (save-excursion (goto-char post-affiliated)
+ (forward-line)
+ (point)))
+ (cend (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (when (and (>= p cbeg) (< p cend))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0)
+ "")))))))))))
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
-(defun org-fill-paragraph (&optional justify)
+
+(defun org-fill-element (&optional justify)
"Fill element at point, when applicable.
This function only applies to comment blocks, comments, example
@@ -22413,133 +22909,160 @@ width for filling.
For convenience, when point is at a plain list, an item or
a footnote definition, try to fill the first paragraph within."
- (interactive)
- (if (and (derived-mode-p 'message-mode)
- (or (not (message-in-body-p))
- (save-excursion (move-beginning-of-line 1)
- (looking-at message-cite-prefix-regexp))))
- ;; First ensure filling is correct in message-mode.
- (let ((fill-paragraph-function
- (cadadr (assoc 'fill-paragraph-function org-fb-vars)))
- (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars)))
- (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars)))
- (paragraph-separate
- (cadadr (assoc 'paragraph-separate org-fb-vars))))
- (fill-paragraph nil))
- (with-syntax-table org-mode-transpose-word-syntax-table
- ;; Move to end of line in order to get the first paragraph
- ;; within a plain list or a footnote definition.
- (let ((element (save-excursion
- (end-of-line)
- (or (ignore-errors (org-element-at-point))
- (user-error "An element cannot be parsed line %d"
- (line-number-at-pos (point)))))))
- ;; First check if point is in a blank line at the beginning of
- ;; the buffer. In that case, ignore filling.
- (case (org-element-type element)
- ;; Use major mode filling function is src blocks.
- (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
- ;; Align Org tables, leave table.el tables as-is.
- (table-row (org-table-align) t)
- (table
- (when (eq (org-element-property :type element) 'org)
+ (with-syntax-table org-mode-transpose-word-syntax-table
+ ;; Move to end of line in order to get the first paragraph within
+ ;; a plain list or a footnote definition.
+ (let ((element (save-excursion (end-of-line) (org-element-at-point))))
+ ;; First check if point is in a blank line at the beginning of
+ ;; the buffer. In that case, ignore filling.
+ (cl-case (org-element-type element)
+ ;; Use major mode filling function is src blocks.
+ (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q")))
+ ;; Align Org tables, leave table.el tables as-is.
+ (table-row (org-table-align) t)
+ (table
+ (when (eq (org-element-property :type element) 'org)
+ (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (org-table-align)))
+ t)
+ (paragraph
+ ;; Paragraphs may contain `line-break' type objects.
+ (let ((beg (max (point-min)
+ (org-element-property :contents-begin element)))
+ (end (min (point-max)
+ (org-element-property :contents-end element))))
+ ;; Do nothing if point is at an affiliated keyword.
+ (if (< (line-end-position) beg) t
+ (when (derived-mode-p 'message-mode)
+ ;; In `message-mode', do not fill following citation
+ ;; in current paragraph nor text before message body.
+ (let ((body-start (save-excursion (message-goto-body))))
+ (when body-start (setq beg (max body-start beg))))
+ (when (save-excursion
+ (re-search-forward
+ (concat "^" message-cite-prefix-regexp) end t))
+ (setq end (match-beginning 0))))
+ ;; Fill paragraph, taking line breaks into account.
(save-excursion
- (goto-char (org-element-property :post-affiliated element))
- (org-table-align)))
- t)
- (paragraph
- ;; Paragraphs may contain `line-break' type objects.
- (let ((beg (max (point-min)
- (org-element-property :contents-begin element)))
- (end (min (point-max)
- (org-element-property :contents-end element))))
- ;; Do nothing if point is at an affiliated keyword.
- (if (< (line-end-position) beg) t
- (when (derived-mode-p 'message-mode)
- ;; In `message-mode', do not fill following citation
- ;; in current paragraph nor text before message body.
- (let ((body-start (save-excursion (message-goto-body))))
- (when body-start (setq beg (max body-start beg))))
- (when (save-excursion
- (re-search-forward
- (concat "^" message-cite-prefix-regexp) end t))
- (setq end (match-beginning 0))))
- ;; Fill paragraph, taking line breaks into account.
- ;; For that, slice the paragraph using line breaks as
- ;; separators, and fill the parts in reverse order to
- ;; avoid messing with markers.
- (save-excursion
- (goto-char end)
- (mapc
- (lambda (pos)
- (fill-region-as-paragraph pos (point) justify)
- (goto-char pos))
- ;; Find the list of ending positions for line breaks
- ;; in the current paragraph. Add paragraph
- ;; beginning to include first slice.
- (nreverse
- (cons beg
- (org-element-map
- (org-element--parse-objects
- beg end nil (org-element-restriction 'paragraph))
- 'line-break
- (lambda (lb) (org-element-property :end lb)))))))
- t)))
- ;; Contents of `comment-block' type elements should be
- ;; filled as plain text, but only if point is within block
- ;; markers.
- (comment-block
- (let* ((case-fold-search t)
- (beg (save-excursion
- (goto-char (org-element-property :begin element))
- (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
- (forward-line)
- (point)))
- (end (save-excursion
- (goto-char (org-element-property :end element))
- (re-search-backward "^[ \t]*#\\+end_comment" nil t)
- (line-beginning-position))))
- (if (or (< (point) beg) (> (point) end)) t
- (fill-region-as-paragraph
- (save-excursion (end-of-line)
- (re-search-backward "^[ \t]*$" beg 'move)
- (line-beginning-position))
- (save-excursion (beginning-of-line)
- (re-search-forward "^[ \t]*$" end 'move)
- (line-beginning-position))
- justify))))
- ;; Fill comments.
- (comment
- (let ((begin (org-element-property :post-affiliated element))
- (end (org-element-property :end element)))
- (when (and (>= (point) begin) (<= (point) end))
- (let ((begin (save-excursion
- (end-of-line)
- (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
- (progn (forward-line) (point))
- begin)))
- (end (save-excursion
+ (goto-char beg)
+ (let ((cuts (list beg)))
+ (while (re-search-forward "\\\\\\\\[ \t]*\n" end t)
+ (when (eq 'line-break
+ (org-element-type
+ (save-excursion (backward-char)
+ (org-element-context))))
+ (push (point) cuts)))
+ (dolist (c (delq end cuts))
+ (fill-region-as-paragraph c end justify)
+ (setq end c))))
+ t)))
+ ;; Contents of `comment-block' type elements should be
+ ;; filled as plain text, but only if point is within block
+ ;; markers.
+ (comment-block
+ (let* ((case-fold-search t)
+ (beg (save-excursion
+ (goto-char (org-element-property :begin element))
+ (re-search-forward "^[ \t]*#\\+begin_comment" nil t)
+ (forward-line)
+ (point)))
+ (end (save-excursion
+ (goto-char (org-element-property :end element))
+ (re-search-backward "^[ \t]*#\\+end_comment" nil t)
+ (line-beginning-position))))
+ (if (or (< (point) beg) (> (point) end)) t
+ (fill-region-as-paragraph
+ (save-excursion (end-of-line)
+ (re-search-backward "^[ \t]*$" beg 'move)
+ (line-beginning-position))
+ (save-excursion (beginning-of-line)
+ (re-search-forward "^[ \t]*$" end 'move)
+ (line-beginning-position))
+ justify))))
+ ;; Fill comments.
+ (comment
+ (let ((begin (org-element-property :post-affiliated element))
+ (end (org-element-property :end element)))
+ (when (and (>= (point) begin) (<= (point) end))
+ (let ((begin (save-excursion
(end-of-line)
- (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
- (1- (line-beginning-position))
- (skip-chars-backward " \r\t\n")
- (line-end-position)))))
- ;; Do not fill comments when at a blank line.
- (when (> end begin)
- (let ((fill-prefix
- (save-excursion
- (beginning-of-line)
- (looking-at "[ \t]*#")
- (let ((comment-prefix (match-string 0)))
- (goto-char (match-end 0))
- (if (looking-at adaptive-fill-regexp)
- (concat comment-prefix (match-string 0))
- (concat comment-prefix " "))))))
- (save-excursion
- (fill-region-as-paragraph begin end justify))))))
- t))
- ;; Ignore every other element.
- (otherwise t))))))
+ (if (re-search-backward "^[ \t]*#[ \t]*$" begin t)
+ (progn (forward-line) (point))
+ begin)))
+ (end (save-excursion
+ (end-of-line)
+ (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move)
+ (1- (line-beginning-position))
+ (skip-chars-backward " \r\t\n")
+ (line-end-position)))))
+ ;; Do not fill comments when at a blank line.
+ (when (> end begin)
+ (let ((fill-prefix
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*#")
+ (let ((comment-prefix (match-string 0)))
+ (goto-char (match-end 0))
+ (if (looking-at adaptive-fill-regexp)
+ (concat comment-prefix (match-string 0))
+ (concat comment-prefix " "))))))
+ (save-excursion
+ (fill-region-as-paragraph begin end justify))))))
+ t))
+ ;; Ignore every other element.
+ (otherwise t)))))
+
+(defun org-fill-paragraph (&optional justify region)
+ "Fill element at point, when applicable.
+
+This function only applies to comment blocks, comments, example
+blocks and paragraphs. Also, as a special case, re-align table
+when point is at one.
+
+For convenience, when point is at a plain list, an item or
+a footnote definition, try to fill the first paragraph within.
+
+If JUSTIFY is non-nil (interactively, with prefix argument),
+justify as well. If `sentence-end-double-space' is non-nil, then
+period followed by one space does not end a sentence, so don't
+break a line there. The variable `fill-column' controls the
+width for filling.
+
+The REGION argument is non-nil if called interactively; in that
+case, if Transient Mark mode is enabled and the mark is active,
+fill each of the elements in the active region, instead of just
+filling the current element."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (list (if current-prefix-arg 'full) t)))
+ (cond
+ ((and (derived-mode-p 'message-mode)
+ (or (not (message-in-body-p))
+ (save-excursion (move-beginning-of-line 1)
+ (looking-at message-cite-prefix-regexp))))
+ ;; First ensure filling is correct in message-mode.
+ (let ((fill-paragraph-function
+ (cl-cadadr (assq 'fill-paragraph-function org-fb-vars)))
+ (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars)))
+ (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars)))
+ (paragraph-separate
+ (cl-cadadr (assq 'paragraph-separate org-fb-vars))))
+ (fill-paragraph nil)))
+ ((and region transient-mark-mode mark-active
+ (not (eq (region-beginning) (region-end))))
+ (let ((origin (point-marker))
+ (start (region-beginning)))
+ (unwind-protect
+ (progn
+ (goto-char (region-end))
+ (while (> (point) start)
+ (org-backward-paragraph)
+ (org-fill-element justify)))
+ (goto-char origin)
+ (set-marker origin nil))))
+ (t (org-fill-element justify))))
+(org-remap org-mode-map 'fill-paragraph 'org-fill-paragraph)
(defun org-auto-fill-function ()
"Auto-fill function."
@@ -22564,11 +23087,135 @@ non-nil."
(insert-before-markers-and-inherit fill-prefix))
+;;; Fixed Width Areas
+
+(defun org-toggle-fixed-width ()
+ "Toggle fixed-width markup.
+
+Add or remove fixed-width markup on current line, whenever it
+makes sense. Return an error otherwise.
+
+If a region is active and if it contains only fixed-width areas
+or blank lines, remove all fixed-width markup in it. If the
+region contains anything else, convert all non-fixed-width lines
+to fixed-width ones.
+
+Blank lines at the end of the region are ignored unless the
+region only contains such lines."
+ (interactive)
+ (if (not (org-region-active-p))
+ ;; No region:
+ ;;
+ ;; Remove fixed width marker only in a fixed-with element.
+ ;;
+ ;; Add fixed width maker in paragraphs, in blank lines after
+ ;; elements or at the beginning of a headline or an inlinetask,
+ ;; and before any one-line elements (e.g., a clock).
+ (progn
+ (beginning-of-line)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (cond
+ ((and (eq type 'fixed-width)
+ (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)"))
+ (replace-match
+ "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1)))
+ ((and (memq type '(babel-call clock comment diary-sexp headline
+ horizontal-rule keyword paragraph
+ planning))
+ (<= (org-element-property :post-affiliated element) (point)))
+ (skip-chars-forward " \t")
+ (insert ": "))
+ ((and (looking-at-p "[ \t]*$")
+ (or (eq type 'inlinetask)
+ (save-excursion
+ (skip-chars-forward " \r\t\n")
+ (<= (org-element-property :end element) (point)))))
+ (delete-region (point) (line-end-position))
+ (org-indent-line)
+ (insert ": "))
+ (t (user-error "Cannot insert a fixed-width line here")))))
+ ;; Region active.
+ (let* ((begin (save-excursion
+ (goto-char (region-beginning))
+ (line-beginning-position)))
+ (end (copy-marker
+ (save-excursion
+ (goto-char (region-end))
+ (unless (eolp) (beginning-of-line))
+ (if (save-excursion (re-search-backward "\\S-" begin t))
+ (progn (skip-chars-backward " \r\t\n") (point))
+ (point)))))
+ (all-fixed-width-p
+ (catch 'not-all-p
+ (save-excursion
+ (goto-char begin)
+ (skip-chars-forward " \r\t\n")
+ (when (eobp) (throw 'not-all-p nil))
+ (while (< (point) end)
+ (let ((element (org-element-at-point)))
+ (if (eq (org-element-type element) 'fixed-width)
+ (goto-char (org-element-property :end element))
+ (throw 'not-all-p nil))))
+ t))))
+ (if all-fixed-width-p
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")
+ (replace-match
+ "" nil nil nil
+ (if (= (line-end-position) (match-end 0)) 0 1)))
+ (forward-line)))
+ (let ((min-ind (point-max)))
+ ;; Find minimum indentation across all lines.
+ (save-excursion
+ (goto-char begin)
+ (if (not (save-excursion (re-search-forward "\\S-" end t)))
+ (setq min-ind 0)
+ (catch 'zerop
+ (while (< (point) end)
+ (unless (looking-at-p "[ \t]*$")
+ (let ((ind (org-get-indentation)))
+ (setq min-ind (min min-ind ind))
+ (when (zerop ind) (throw 'zerop t))))
+ (forward-line)))))
+ ;; Loop over all lines and add fixed-width markup everywhere
+ ;; but in fixed-width lines.
+ (save-excursion
+ (goto-char begin)
+ (while (< (point) end)
+ (cond
+ ((org-at-heading-p)
+ (insert ": ")
+ (forward-line)
+ (while (and (< (point) end) (looking-at-p "[ \t]*$"))
+ (insert ":")
+ (forward-line)))
+ ((looking-at-p "[ \t]*:\\( \\|$\\)")
+ (let* ((element (org-element-at-point))
+ (element-end (org-element-property :end element)))
+ (if (eq (org-element-type element) 'fixed-width)
+ (progn (goto-char element-end)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (let ((limit (min end element-end)))
+ (while (< (point) limit)
+ (org-move-to-column min-ind t)
+ (insert ": ")
+ (forward-line))))))
+ (t
+ (org-move-to-column min-ind t)
+ (insert ": ")
+ (forward-line)))))))
+ (set-marker end nil))))
+
+
;;; Comments
;; Org comments syntax is quite complex. It requires the entire line
;; to be just a comment. Also, even with the right syntax at the
-;; beginning of line, some some elements (i.e. verse-block or
+;; beginning of line, some elements (e.g., verse-block or
;; example-block) don't accept comments. Usual Emacs comment commands
;; cannot cope with those requirements. Therefore, Org replaces them.
@@ -22584,87 +23231,139 @@ non-nil."
(defun org-setup-comments-handling ()
(interactive)
- (org-set-local 'comment-use-syntax nil)
- (org-set-local 'comment-start "# ")
- (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)")
- (org-set-local 'comment-insert-comment-function 'org-insert-comment)
- (org-set-local 'comment-region-function 'org-comment-or-uncomment-region)
- (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region))
+ (setq-local comment-use-syntax nil)
+ (setq-local comment-start "# ")
+ (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)")
+ (setq-local comment-insert-comment-function 'org-insert-comment)
+ (setq-local comment-region-function 'org-comment-or-uncomment-region)
+ (setq-local uncomment-region-function 'org-comment-or-uncomment-region))
(defun org-insert-comment ()
"Insert an empty comment above current line.
-If the line is empty, insert comment at its beginning."
- (beginning-of-line)
- (if (looking-at "\\s-*$") (replace-match "") (open-line 1))
- (org-indent-line)
- (insert "# "))
+If the line is empty, insert comment at its beginning. When
+point is within a source block, comment according to the related
+major mode."
+ (if (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'src-block)
+ (< (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (line-end-position))
+ (point))
+ (> (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))
+ (point))))
+ (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
+ (beginning-of-line)
+ (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol))
+ (open-line 1))
+ (org-indent-line)
+ (insert "# ")))
(defvar comment-empty-lines) ; From newcomment.el.
(defun org-comment-or-uncomment-region (beg end &rest _)
"Comment or uncomment each non-blank line in the region.
Uncomment each non-blank line between BEG and END if it only
-contains commented lines. Otherwise, comment them."
- (save-restriction
- ;; Restrict region
- (narrow-to-region (save-excursion (goto-char beg)
- (skip-chars-forward " \r\t\n" end)
- (line-beginning-position))
- (save-excursion (goto-char end)
- (skip-chars-backward " \r\t\n" beg)
- (line-end-position)))
- (let ((uncommentp
- ;; UNCOMMENTP is non-nil when every non blank line between
- ;; BEG and END is a comment.
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp))
- (let ((element (org-element-at-point)))
- (and (eq (org-element-type element) 'comment)
- (goto-char (min (point-max)
- (org-element-property
- :end element)))))))
- (eobp))))
- (if uncommentp
- ;; Only blank lines and comments in region: uncomment it.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
- (replace-match "" nil nil nil 1))
- (forward-line)))
- ;; Comment each line in region.
- (let ((min-indent (point-max)))
- ;; First find the minimum indentation across all lines.
- (save-excursion
- (goto-char (point-min))
- (while (and (not (eobp)) (not (zerop min-indent)))
- (unless (looking-at "[ \t]*$")
- (setq min-indent (min min-indent (current-indentation))))
- (forward-line)))
- ;; Then loop over all lines.
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
- ;; Don't get fooled by invisible text (e.g. link path)
- ;; when moving to column MIN-INDENT.
- (let ((buffer-invisibility-spec nil))
- (org-move-to-column min-indent t))
- (insert comment-start))
- (forward-line))))))))
+contains commented lines. Otherwise, comment them. If region is
+strictly within a source block, use appropriate comment syntax."
+ (if (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'src-block)
+ (< (save-excursion
+ (goto-char (org-element-property :post-affiliated element))
+ (line-end-position))
+ beg)
+ (>= (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))
+ end)))
+ ;; Translate region boundaries for the Org buffer to the source
+ ;; buffer.
+ (let ((offset (- end beg)))
+ (save-excursion
+ (goto-char beg)
+ (org-babel-do-in-edit-buffer
+ (comment-or-uncomment-region (point) (+ offset (point))))))
+ (save-restriction
+ ;; Restrict region
+ (narrow-to-region (save-excursion (goto-char beg)
+ (skip-chars-forward " \r\t\n" end)
+ (line-beginning-position))
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n" beg)
+ (line-end-position)))
+ (let ((uncommentp
+ ;; UNCOMMENTP is non-nil when every non blank line between
+ ;; BEG and END is a comment.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (let ((element (org-element-at-point)))
+ (and (eq (org-element-type element) 'comment)
+ (goto-char (min (point-max)
+ (org-element-property
+ :end element)))))))
+ (eobp))))
+ (if uncommentp
+ ;; Only blank lines and comments in region: uncomment it.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)")
+ (replace-match "" nil nil nil 1))
+ (forward-line)))
+ ;; Comment each line in region.
+ (let ((min-indent (point-max)))
+ ;; First find the minimum indentation across all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (and (not (eobp)) (not (zerop min-indent)))
+ (unless (looking-at "[ \t]*$")
+ (setq min-indent (min min-indent (current-indentation))))
+ (forward-line)))
+ ;; Then loop over all lines.
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (unless (and (not comment-empty-lines) (looking-at "[ \t]*$"))
+ ;; Don't get fooled by invisible text (e.g. link path)
+ ;; when moving to column MIN-INDENT.
+ (let ((buffer-invisibility-spec nil))
+ (org-move-to-column min-indent t))
+ (insert comment-start))
+ (forward-line)))))))))
+
+(defun org-comment-dwim (_arg)
+ "Call `comment-dwim' within a source edit buffer if needed."
+ (interactive "*P")
+ (if (org-in-src-block-p)
+ (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim))
+ (call-interactively 'comment-dwim)))
-;;; Planning
+;;; Timestamps API
;; This section contains tools to operate on timestamp objects, as
;; returned by, e.g. `org-element-context'.
+(defun org-timestamp--to-internal-time (timestamp &optional end)
+ "Encode TIMESTAMP object into Emacs internal time.
+Use end of date range or time range when END is non-nil."
+ (apply #'encode-time
+ (cons 0
+ (mapcar
+ (lambda (prop) (or (org-element-property prop timestamp) 0))
+ (if end '(:minute-end :hour-end :day-end :month-end :year-end)
+ '(:minute-start :hour-start :day-start :month-start
+ :year-start))))))
+
(defun org-timestamp-has-time-p (timestamp)
"Non-nil when TIMESTAMP has a time specified."
(org-element-property :hour-start timestamp))
-(defun org-timestamp-format (timestamp format &optional end zone)
- "Format a TIMESTAMP element into a string.
+(defun org-timestamp-format (timestamp format &optional end utc)
+ "Format a TIMESTAMP object into a string.
FORMAT is a format specifier to be passed to
`format-time-string'.
@@ -22672,33 +23371,22 @@ FORMAT is a format specifier to be passed to
When optional argument END is non-nil, use end of date-range or
time-range, if possible.
-The optional ZONE is omitted or nil for Emacs local time, t for
-Universal Time, `wall' for system wall clock time, or a string as
-in the TZ environment variable. It can also be a list (as from
-`current-time-zone') or an integer (as from `decode-time')
-applied without consideration for daylight saving time."
+When optional argument UTC is non-nil, time will be expressed as
+Universal Time."
(format-time-string
- format
- (apply 'encode-time
- (cons 0
- (mapcar
- (lambda (prop) (or (org-element-property prop timestamp) 0))
- (if end '(:minute-end :hour-end :day-end :month-end :year-end)
- '(:minute-start :hour-start :day-start :month-start
- :year-start)))))
- zone))
+ format (org-timestamp--to-internal-time timestamp end)
+ (and utc t)))
(defun org-timestamp-split-range (timestamp &optional end)
- "Extract a timestamp object from a date or time range.
+ "Extract a TIMESTAMP object from a date or time range.
-TIMESTAMP is a timestamp object. END, when non-nil, means extract
-the end of the range. Otherwise, extract its start.
+END, when non-nil, means extract the end of the range.
+Otherwise, extract its start.
-Return a new timestamp object sharing the same parent as
-TIMESTAMP."
+Return a new timestamp object."
(let ((type (org-element-property :type timestamp)))
(if (memq type '(active inactive diary)) timestamp
- (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp)))))
+ (let ((split-ts (org-element-copy timestamp)))
;; Set new type.
(org-element-put-property
split-ts :type (if (eq type 'active-range) 'active 'inactive))
@@ -22712,91 +23400,43 @@ TIMESTAMP."
(dolist (p-cell p-alist)
(org-element-put-property
split-ts
- (funcall (if end 'car 'cdr) p-cell)
+ (funcall (if end #'car #'cdr) p-cell)
(org-element-property
- (funcall (if end 'cdr 'car) p-cell) split-ts)))
+ (funcall (if end #'cdr #'car) p-cell) split-ts)))
;; Eventually refresh `:raw-value'.
(org-element-put-property split-ts :raw-value nil)
(org-element-put-property
split-ts :raw-value (org-element-interpret-data split-ts)))))))
(defun org-timestamp-translate (timestamp &optional boundary)
- "Apply `org-translate-time' on a TIMESTAMP object.
+ "Translate TIMESTAMP object to custom format.
+
+Format string is defined in `org-time-stamp-custom-formats',
+which see.
+
When optional argument BOUNDARY is non-nil, it is either the
symbol `start' or `end'. In this case, only translate the
starting or ending part of TIMESTAMP if it is a date or time
-range. Otherwise, translate both parts."
- (if (and (not boundary)
- (memq (org-element-property :type timestamp)
- '(active-range inactive-range)))
- (concat
- (org-translate-time
- (org-element-property :raw-value
- (org-timestamp-split-range timestamp)))
- "--"
- (org-translate-time
- (org-element-property :raw-value
- (org-timestamp-split-range timestamp t))))
- (org-translate-time
- (org-element-property
- :raw-value
- (if (not boundary) timestamp
- (org-timestamp-split-range timestamp (eq boundary 'end)))))))
+range. Otherwise, translate both parts.
+Return timestamp as-is if `org-display-custom-times' is nil or if
+it has a `diary' type."
+ (let ((type (org-element-property :type timestamp)))
+ (if (or (not org-display-custom-times) (eq type 'diary))
+ (org-element-interpret-data timestamp)
+ (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car)
+ org-time-stamp-custom-formats)))
+ (if (and (not boundary) (memq type '(active-range inactive-range)))
+ (concat (org-timestamp-format timestamp fmt)
+ "--"
+ (org-timestamp-format timestamp fmt t))
+ (org-timestamp-format timestamp fmt (eq boundary 'end)))))))
-;;; Other stuff.
-(defun org-toggle-fixed-width-section (arg)
- "Toggle the fixed-width export.
-If there is no active region, the QUOTE keyword at the current headline is
-inserted or removed. When present, it causes the text between this headline
-and the next to be exported as fixed-width text, and unmodified.
-If there is an active region, this command adds or removes a colon as the
-first character of this line. If the first character of a line is a colon,
-this line is also exported in fixed-width font."
- (interactive "P")
- (let* ((cc 0)
- (regionp (org-region-active-p))
- (beg (if regionp (region-beginning) (point)))
- (end (if regionp (region-end)))
- (nlines (or arg (if (and beg end) (count-lines beg end) 1)))
- (case-fold-search nil)
- (re "[ \t]*\\(:\\(?: \\|$\\)\\)")
- off)
- (if regionp
- (save-excursion
- (goto-char beg)
- (setq cc (current-column))
- (beginning-of-line 1)
- (setq off (looking-at re))
- (while (> nlines 0)
- (setq nlines (1- nlines))
- (beginning-of-line 1)
- (cond
- (arg
- (org-move-to-column cc t)
- (insert ": \n")
- (forward-line -1))
- ((and off (looking-at re))
- (replace-match "" t t nil 1))
- ((not off) (org-move-to-column cc t) (insert ": ")))
- (forward-line 1)))
- (save-excursion
- (org-back-to-heading)
- (cond
- ((looking-at (format org-heading-keyword-regexp-format
- org-quote-string))
- (goto-char (match-end 1))
- (looking-at (concat " +" org-quote-string))
- (replace-match "" t t)
- (when (eolp) (insert " ")))
- ((looking-at org-outline-regexp)
- (goto-char (match-end 0))
- (insert org-quote-string " ")))))))
+;;; Other stuff.
(defvar reftex-docstruct-symbol)
-(defvar reftex-cite-format)
(defvar org--rds)
(defun org-reftex-citation ()
@@ -22814,131 +23454,137 @@ Export of such citations to both LaTeX and HTML is handled by the contributed
package ox-bibtex by Taru Karttunen."
(interactive)
(let ((reftex-docstruct-symbol 'org--rds)
- (reftex-cite-format "\\cite{%l}")
org--rds bib)
- (save-excursion
- (save-restriction
- (widen)
- (let ((case-fold-search t)
- (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)"))
- (if (not (save-excursion
- (or (re-search-forward re nil t)
- (re-search-backward re nil t))))
- (error "No bibliography defined in file")
- (setq bib (concat (match-string 1) ".bib")
- org--rds (list (list 'bib bib)))))))
+ (org-with-wide-buffer
+ (let ((case-fold-search t)
+ (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)"))
+ (if (not (save-excursion
+ (or (re-search-forward re nil t)
+ (re-search-backward re nil t))))
+ (user-error "No bibliography defined in file")
+ (setq bib (concat (match-string 1) ".bib")
+ org--rds (list (list 'bib bib))))))
(call-interactively 'reftex-citation)))
;;;; Functions extending outline functionality
-(defun org-beginning-of-line (&optional arg)
- "Go to the beginning of the current line. If that is invisible, continue
-to a visible line beginning. This makes the function of C-a more intuitive.
-If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the
-first attempt, and only move to after the tags when the cursor is already
-beyond the end of the headline."
- (interactive "P")
- (let ((pos (point))
- (special (if (consp org-special-ctrl-a/e)
- (car org-special-ctrl-a/e)
- org-special-ctrl-a/e))
- deactivate-mark refpos)
- (if (org-bound-and-true-p visual-line-mode)
- (beginning-of-visual-line 1)
- (beginning-of-line 1))
- (if (and arg (fboundp 'move-beginning-of-line))
- (call-interactively 'move-beginning-of-line)
- (if (bobp)
- nil
- (backward-char 1)
- (if (org-truely-invisible-p)
- (while (and (not (bobp)) (org-truely-invisible-p))
- (backward-char 1)
- (beginning-of-line 1))
- (forward-char 1))))
- (when special
- (cond
- ((and (looking-at org-complex-heading-regexp)
- (= (char-after (match-end 1)) ?\ ))
- (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
- (point-at-eol)))
- (goto-char
- (if (eq special t)
- (cond ((> pos refpos) refpos)
- ((= pos (point)) refpos)
- (t (point)))
- (cond ((> pos (point)) (point))
- ((not (eq last-command this-command)) (point))
- (t refpos)))))
- ((org-at-item-p)
- ;; Being at an item and not looking at an the item means point
- ;; was previously moved to beginning of a visual line, which
- ;; doesn't contain the item. Therefore, do nothing special,
- ;; just stay here.
- (when (looking-at org-list-full-item-re)
- ;; Set special position at first white space character after
- ;; bullet, and check-box, if any.
- (let ((after-bullet
- (let ((box (match-end 3)))
- (if (not box) (match-end 1)
- (let ((after (char-after box)))
- (if (and after (= after ? )) (1+ box) box))))))
- ;; Special case: Move point to special position when
- ;; currently after it or at beginning of line.
- (if (eq special t)
- (when (or (> pos after-bullet) (= (point) pos))
- (goto-char after-bullet))
- ;; Reversed case: Move point to special position when
- ;; point was already at beginning of line and command is
- ;; repeated.
- (when (and (= (point) pos) (eq last-command this-command))
- (goto-char after-bullet))))))))
- (org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t))))
- (setq disable-point-adjustment
- (or (not (invisible-p (point)))
- (not (invisible-p (max (point-min) (1- (point))))))))
-
-(defun org-end-of-line (&optional arg)
- "Go to the end of the line.
+(defun org-beginning-of-line (&optional n)
+ "Go to the beginning of the current visible line.
+
If this is a headline, and `org-special-ctrl-a/e' is set, ignore
tags on the first attempt, and only move to after the tags when
-the cursor is already beyond the end of the headline."
- (interactive "P")
- (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e)
- org-special-ctrl-a/e))
- (move-fun (cond ((org-bound-and-true-p visual-line-mode)
- 'end-of-visual-line)
- ((fboundp 'move-end-of-line) 'move-end-of-line)
- (t 'end-of-line)))
+the cursor is already beyond the end of the headline.
+
+With argument N not nil or 1, move forward N - 1 lines first."
+ (interactive "^p")
+ (let ((origin (point))
+ (special (pcase org-special-ctrl-a/e
+ (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e)))
deactivate-mark)
- (if (or (not special) arg) (call-interactively move-fun)
- (let* ((element (save-excursion (beginning-of-line)
- (org-element-at-point)))
- (type (org-element-type element)))
- (cond
- ((memq type '(headline inlinetask))
- (let ((pos (point)))
- (beginning-of-line 1)
- (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$"))
- (if (eq special t)
- (if (or (< pos (match-beginning 1)) (= pos (match-end 0)))
- (goto-char (match-beginning 1))
- (goto-char (match-end 0)))
- (if (or (< pos (match-end 0))
- (not (eq this-command last-command)))
- (goto-char (match-end 0))
- (goto-char (match-beginning 1))))
- (call-interactively move-fun))))
- ((org-element-property :hiddenp element)
- ;; If element is hidden, `move-end-of-line' would put point
- ;; after it. Use `end-of-line' to stay on current line.
- (call-interactively 'end-of-line))
- (t (call-interactively move-fun)))))
- (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))
- (setq disable-point-adjustment
- (or (not (invisible-p (point)))
- (not (invisible-p (max (point-min) (1- (point))))))))
+ ;; First move to a visible line.
+ (if (bound-and-true-p visual-line-mode)
+ (beginning-of-visual-line n)
+ (move-beginning-of-line n)
+ ;; `move-beginning-of-line' may leave point after invisible
+ ;; characters if line starts with such of these (e.g., with
+ ;; a link at column 0). Really move to the beginning of the
+ ;; current visible line.
+ (beginning-of-line))
+ (cond
+ ;; No special behavior. Point is already at the beginning of
+ ;; a line, logical or visual.
+ ((not special))
+ ;; `beginning-of-visual-line' left point before logical beginning
+ ;; of line: point is at the beginning of a visual line. Bail
+ ;; out.
+ ((and (bound-and-true-p visual-line-mode) (not (bolp))))
+ ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp))
+ ;; At a headline, special position is before the title, but
+ ;; after any TODO keyword or priority cookie.
+ (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1)))
+ (line-end-position)))
+ (bol (point)))
+ (if (eq special 'reversed)
+ (when (and (= origin bol) (eq last-command this-command))
+ (goto-char refpos))
+ (when (or (> origin refpos) (= origin bol))
+ (goto-char refpos)))))
+ ((and (looking-at org-list-full-item-re)
+ (memq (org-element-type (save-match-data (org-element-at-point)))
+ '(item plain-list)))
+ ;; Set special position at first white space character after
+ ;; bullet, and check-box, if any.
+ (let ((after-bullet
+ (let ((box (match-end 3)))
+ (cond ((not box) (match-end 1))
+ ((eq (char-after box) ?\s) (1+ box))
+ (t box)))))
+ (if (eq special 'reversed)
+ (when (and (= (point) origin) (eq last-command this-command))
+ (goto-char after-bullet))
+ (when (or (> origin after-bullet) (= (point) origin))
+ (goto-char after-bullet)))))
+ ;; No special context. Point is already at beginning of line.
+ (t nil))))
+
+(defun org-end-of-line (&optional n)
+ "Go to the end of the line, but before ellipsis, if any.
+
+If this is a headline, and `org-special-ctrl-a/e' is set, ignore
+tags on the first attempt, and only move to after the tags when
+the cursor is already beyond the end of the headline.
+
+With argument N not nil or 1, move forward N - 1 lines first."
+ (interactive "^p")
+ (let ((origin (point))
+ (special (pcase org-special-ctrl-a/e
+ (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e)))
+ deactivate-mark)
+ ;; First move to a visible line.
+ (if (bound-and-true-p visual-line-mode)
+ (beginning-of-visual-line n)
+ (move-beginning-of-line n))
+ (cond
+ ;; At a headline, with tags.
+ ((and special
+ (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)))
+ (match-end 5))
+ (let ((tags (save-excursion
+ (goto-char (match-beginning 5))
+ (skip-chars-backward " \t")
+ (point)))
+ (visual-end (and (bound-and-true-p visual-line-mode)
+ (save-excursion
+ (end-of-visual-line)
+ (point)))))
+ ;; If `end-of-visual-line' brings us before end of line or
+ ;; even tags, i.e., the headline spans over multiple visual
+ ;; lines, move there.
+ (cond ((and visual-end
+ (< visual-end tags)
+ (<= origin visual-end))
+ (goto-char visual-end))
+ ((eq special 'reversed)
+ (if (and (= origin (line-end-position))
+ (eq this-command last-command))
+ (goto-char tags)
+ (end-of-line)))
+ (t
+ (if (or (< origin tags) (= origin (line-end-position)))
+ (goto-char tags)
+ (end-of-line))))))
+ ((bound-and-true-p visual-line-mode)
+ (let ((bol (line-beginning-position)))
+ (end-of-visual-line)
+ ;; If `end-of-visual-line' gets us past the ellipsis at the
+ ;; end of a line, backtrack and use `end-of-line' instead.
+ (when (/= bol (line-beginning-position))
+ (goto-char bol)
+ (end-of-line))))
+ (t (end-of-line)))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
@@ -22948,18 +23594,50 @@ the cursor is already beyond the end of the headline."
This will call `backward-sentence' or `org-table-beginning-of-field',
depending on context."
(interactive)
- (cond
- ((org-at-table-p) (call-interactively 'org-table-beginning-of-field))
- (t (call-interactively 'backward-sentence))))
+ (let* ((element (org-element-at-point))
+ (contents-begin (org-element-property :contents-begin element))
+ (table (org-element-lineage element '(table) t)))
+ (if (and table
+ (> (point) contents-begin)
+ (<= (point) (org-element-property :contents-end table)))
+ (call-interactively #'org-table-beginning-of-field)
+ (save-restriction
+ (when (and contents-begin
+ (< (point-min) contents-begin)
+ (> (point) contents-begin))
+ (narrow-to-region contents-begin
+ (org-element-property :contents-end element)))
+ (call-interactively #'backward-sentence)))))
(defun org-forward-sentence (&optional _arg)
"Go to end of sentence, or end of table field.
This will call `forward-sentence' or `org-table-end-of-field',
depending on context."
(interactive)
- (cond
- ((org-at-table-p) (call-interactively 'org-table-end-of-field))
- (t (call-interactively 'forward-sentence))))
+ (if (and (org-at-heading-p)
+ (save-restriction (skip-chars-forward " \t") (not (eolp))))
+ (save-restriction
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (call-interactively #'forward-sentence))
+ (let* ((element (org-element-at-point))
+ (contents-end (org-element-property :contents-end element))
+ (table (org-element-lineage element '(table) t)))
+ (if (and table
+ (>= (point) (org-element-property :contents-begin table))
+ (< (point) contents-end))
+ (call-interactively #'org-table-end-of-field)
+ (save-restriction
+ (when (and contents-end
+ (> (point-max) contents-end)
+ ;; Skip blank lines between elements.
+ (< (org-element-property :end element)
+ (save-excursion (goto-char contents-end)
+ (skip-chars-forward " \r\t\n"))))
+ (narrow-to-region (org-element-property :contents-begin element)
+ contents-end))
+ ;; End of heading is considered as the end of a sentence.
+ (let ((sentence-end (concat (sentence-end) "\\|^\\*+ .*$")))
+ (call-interactively #'forward-sentence)))))))
(define-key org-mode-map "\M-a" 'org-backward-sentence)
(define-key org-mode-map "\M-e" 'org-forward-sentence)
@@ -22971,14 +23649,14 @@ depending on context."
((or (not org-special-ctrl-k)
(bolp)
(not (org-at-heading-p)))
- (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
- org-ctrl-k-protect-subtree)
- (if (or (eq org-ctrl-k-protect-subtree 'error)
- (not (y-or-n-p "Kill hidden subtree along with headline? ")))
- (user-error "C-k aborted as it would kill a hidden subtree")))
+ (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible)
+ org-ctrl-k-protect-subtree
+ (or (eq org-ctrl-k-protect-subtree 'error)
+ (not (y-or-n-p "Kill hidden subtree along with headline? "))))
+ (user-error "C-k aborted as it would kill a hidden subtree"))
(call-interactively
- (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
- ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))
+ (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line)))
+ ((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")
(kill-region (point) (match-beginning 1))
(org-set-tags nil t))
(t (kill-region (point) (point-at-eol)))))
@@ -22991,24 +23669,25 @@ This command will look at the current kill and check if is a single
subtree, or a series of subtrees[1]. If it passes the test, and if the
cursor is at the beginning of a line or after the stars of a currently
empty headline, then the yank is handled specially. How exactly depends
-on the value of the following variables, both set by default.
+on the value of the following variables.
-org-yank-folded-subtrees
- When set, the subtree(s) will be folded after insertion, but only
- if doing so would now swallow text after the yanked text.
+`org-yank-folded-subtrees'
+ By default, this variable is non-nil, which results in
+ subtree(s) being folded after insertion, except if doing so
+ would swallow text after the yanked text.
-org-yank-adjusted-subtrees
- When set, the subtree will be promoted or demoted in order to
- fit into the local outline tree structure, which means that the level
- will be adjusted so that it becomes the smaller one of the two
- *visible* surrounding headings.
+`org-yank-adjusted-subtrees'
+ When non-nil (the default value is nil), the subtree will be
+ promoted or demoted in order to fit into the local outline tree
+ structure, which means that the level will be adjusted so that it
+ becomes the smaller one of the two *visible* surrounding headings.
Any prefix to this command will cause `yank' to be called directly with
-no special treatment. In particular, a simple \\[universal-argument] prefix \
+no special treatment. In particular, a simple `\\[universal-argument]' prefix \
will just
plainly yank the text as it is.
-[1] The test checks if the first non-white line is a heading
+\[1] The test checks if the first non-white line is a heading
and if there are no other headings with fewer stars."
(interactive "P")
(org-yank-generic 'yank arg))
@@ -23051,7 +23730,7 @@ interactive command with similar behavior."
(or (looking-at org-outline-regexp)
(re-search-forward org-outline-regexp-bol end t))
(while (and (< (point) end) (looking-at org-outline-regexp))
- (hide-subtree)
+ (outline-hide-subtree)
(org-cycle-show-empty-lines 'folded)
(condition-case nil
(outline-forward-same-level 1)
@@ -23082,11 +23761,9 @@ interactive command with similar behavior."
(setq level (org-outline-level)))
(goto-char end)
(skip-chars-forward " \t\r\n\v\f")
- (if (or (eobp)
- (and (bolp) (looking-at org-outline-regexp)
- (<= (org-outline-level) level)))
- nil ; Nothing would be swallowed
- t))))) ; something would swallow
+ (not (or (eobp)
+ (and (bolp) (looking-at-p org-outline-regexp)
+ (<= (org-outline-level) level))))))))
(define-key org-mode-map "\C-y" 'org-yank)
@@ -23094,17 +23771,18 @@ interactive command with similar behavior."
"Check if point is at a character currently not visible.
This version does not only check the character property, but also
`visible-mode'."
- ;; Early versions of noutline don't have `outline-invisible-p'.
- (if (org-bound-and-true-p visible-mode)
- nil
- (outline-invisible-p)))
+ (unless (bound-and-true-p visible-mode)
+ (org-invisible-p)))
(defun org-invisible-p2 ()
- "Check if point is at a character currently not visible."
+ "Check if point is at a character currently not visible.
+
+If the point is at EOL (and not at the beginning of a buffer too),
+move it back by one char before doing this check."
(save-excursion
- (if (and (eolp) (not (bobp))) (backward-char 1))
- ;; Early versions of noutline don't have `outline-invisible-p'.
- (outline-invisible-p)))
+ (when (and (eolp) (not (bobp)))
+ (backward-char 1))
+ (org-invisible-p)))
(defun org-back-to-heading (&optional invisible-ok)
"Call `outline-back-to-heading', but provide a better error message."
@@ -23121,14 +23799,28 @@ This version does not only check the character property, but also
(defun org-at-heading-p (&optional ignored)
(outline-on-heading-p t))
-;; Compatibility alias with Org versions < 7.8.03
-(defalias 'org-on-heading-p 'org-at-heading-p)
+
+(defun org-in-commented-heading-p (&optional no-inheritance)
+ "Non-nil if point is under a commented 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 ((headline (nth 4 (org-heading-components))))
+ (and headline
+ (let ((case-fold-search nil))
+ (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)")
+ headline)))))
+ (no-inheritance nil)
+ (t
+ (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p))))))
(defun org-at-comment-p nil
- "Is cursor in a line starting with a # character?"
+ "Is cursor in a commented line?"
(save-excursion
- (beginning-of-line)
- (looking-at "^#")))
+ (save-match-data
+ (beginning-of-line)
+ (looking-at "^[ \t]*# "))))
(defun org-at-drawer-p nil
"Is cursor at a drawer keyword?"
@@ -23146,13 +23838,13 @@ This version does not only check the character property, but also
"If point is at the end of an empty headline, return t, else nil.
If the heading only contains a TODO keyword, it is still still considered
empty."
- (and (looking-at "[ \t]*$")
- (when org-todo-line-regexp
+ (let ((case-fold-search nil))
+ (and (looking-at "[ \t]*$")
+ org-todo-line-regexp
(save-excursion
- (beginning-of-line 1)
- (let ((case-fold-search nil))
- (looking-at org-todo-line-regexp)
- (string= (match-string 3) ""))))))
+ (beginning-of-line)
+ (looking-at org-todo-line-regexp)
+ (string= (match-string 3) "")))))
(defun org-at-heading-or-item-p ()
(or (org-at-heading-p) (org-at-item-p)))
@@ -23167,9 +23859,7 @@ empty."
"Move to the heading line of which the present line is a subheading.
This function considers both visible and invisible heading lines.
With argument, move up ARG levels."
- (if (fboundp 'outline-up-heading-all)
- (outline-up-heading-all arg) ; emacs 21 version of outline.el
- (outline-up-heading arg t))) ; emacs 22 version of outline.el
+ (outline-up-heading arg t))
(defun org-up-heading-safe ()
"Move to the heading line of which the present line is a subheading.
@@ -23179,14 +23869,11 @@ headline found, or nil if no higher level is found.
Also, this function will be a lot faster than `outline-up-heading',
because it relies on stars being the outline starters. This can really
make a significant difference in outlines with very many siblings."
- (let (start-level re)
- (org-back-to-heading t)
- (setq start-level (funcall outline-level))
- (if (equal start-level 1)
- nil
- (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} "))
- (if (re-search-backward re nil t)
- (funcall outline-level)))))
+ (when (ignore-errors (org-back-to-heading t))
+ (let ((level-up (1- (funcall outline-level))))
+ (and (> level-up 0)
+ (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t)
+ (funcall outline-level)))))
(defun org-first-sibling-p ()
"Is this heading the first child of its parents?"
@@ -23211,7 +23898,7 @@ move point."
(pos (point))
(re org-outline-regexp-bol)
level l)
- (when (condition-case nil (org-back-to-heading t) (error nil))
+ (when (ignore-errors (org-back-to-heading t))
(setq level (funcall outline-level))
(catch 'exit
(or previous (forward-char 1))
@@ -23235,7 +23922,7 @@ move point."
Return t when a child was found. Otherwise don't move point and
return nil."
(let (level (pos (point)) (re org-outline-regexp-bol))
- (when (condition-case nil (org-back-to-heading t) (error nil))
+ (when (ignore-errors (org-back-to-heading t))
(setq level (outline-level))
(forward-char 1)
(if (and (re-search-forward re nil t) (> (outline-level) level))
@@ -23271,8 +23958,7 @@ This is like outline-next-sibling, but invisible headings are ok."
(outline-next-heading)
(while (and (not (eobp)) (> (funcall outline-level) level))
(outline-next-heading))
- (if (or (eobp) (< (funcall outline-level) level))
- nil
+ (unless (or (eobp) (< (funcall outline-level) level))
(point))))
(defun org-get-last-sibling ()
@@ -23285,8 +23971,7 @@ If there is no such heading, return nil."
(while (and (> (funcall outline-level) level)
(not (bobp)))
(outline-previous-heading))
- (if (< (funcall outline-level) level)
- nil
+ (unless (< (funcall outline-level) level)
(point)))))
(defun org-end-of-subtree (&optional invisible-ok to-heading)
@@ -23302,7 +23987,7 @@ If there is no such heading, return nil."
(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-mode
+ ;; 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.
@@ -23315,33 +24000,36 @@ If there is no such heading, return nil."
(setq first nil)
(outline-next-heading)))
(unless to-heading
- (if (memq (preceding-char) '(?\n ?\^M))
- (progn
- ;; Go to end of line before heading
- (forward-char -1)
- (if (memq (preceding-char) '(?\n ?\^M))
- ;; leave blank line before heading
- (forward-char -1))))))
+ (when (memq (preceding-char) '(?\n ?\^M))
+ ;; Go to end of line before heading
+ (forward-char -1)
+ (when (memq (preceding-char) '(?\n ?\^M))
+ ;; leave blank line before heading
+ (forward-char -1)))))
(point))
-(defun org-end-of-meta-data-and-drawers ()
- "Jump to the first text after meta data and drawers in the current entry.
-This will move over empty lines, lines with planning time stamps,
-clocking lines, and drawers."
+(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."
(org-back-to-heading t)
- (let ((end (save-excursion (outline-next-heading) (point)))
- (re (concat "\\(" org-drawer-regexp "\\)"
- "\\|" "[ \t]*" org-keyword-time-regexp)))
- (forward-line 1)
- (while (re-search-forward re end t)
- (if (not (match-end 1))
- ;; empty or planning line
- (forward-line 1)
- ;; a drawer, find the end
- (re-search-forward "^[ \t]*:END:" end 'move)
- (forward-line 1)))
- (and (re-search-forward "[^\n]" nil t) (backward-char 1))
- (point)))
+ (forward-line)
+ (when (looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (goto-char (match-end 0))
+ (forward-line))
+ (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))))))))
(defun org-forward-heading-same-level (arg &optional invisible-ok)
"Move forward to the ARG'th subheading at same level as this one.
@@ -23349,32 +24037,27 @@ Stop at the first and last subheadings of a superior heading.
Normally this only looks at visible headings, but when INVISIBLE-OK is
non-nil it will also look at invisible ones."
(interactive "p")
- (if (not (ignore-errors (org-back-to-heading invisible-ok)))
- (if (and arg (< arg 0))
- (goto-char (point-min))
- (outline-next-heading))
- (org-at-heading-p)
- (let ((level (- (match-end 0) (match-beginning 0) 1))
- (f (if (and arg (< arg 0))
- 're-search-backward
- 're-search-forward))
- (count (if arg (abs arg) 1))
- (result (point)))
- (while (and (prog1 (> count 0)
- (forward-char (if (and arg (< arg 0)) -1 1)))
- (funcall f org-outline-regexp-bol nil 'move))
- (let ((l (- (match-end 0) (match-beginning 0) 1)))
- (cond ((< l level) (setq count 0))
- ((and (= l level)
- (or invisible-ok
- (progn
- (goto-char (line-beginning-position))
- (not (outline-invisible-p)))))
- (setq count (1- count))
- (when (eq l level)
- (setq result (point)))))))
- (goto-char result))
- (beginning-of-line 1)))
+ (let ((backward? (and arg (< arg 0))))
+ (if (org-before-first-heading-p)
+ (if backward? (goto-char (point-min)) (outline-next-heading))
+ (org-back-to-heading invisible-ok)
+ (unless backward? (end-of-line)) ;do not match current headline
+ (let ((level (- (match-end 0) (match-beginning 0) 1))
+ (f (if backward? #'re-search-backward #'re-search-forward))
+ (count (if arg (abs arg) 1))
+ (result (point)))
+ (while (and (> count 0)
+ (funcall f org-outline-regexp-bol nil 'move))
+ (let ((l (- (match-end 0) (match-beginning 0) 1)))
+ (cond ((< l level) (setq count 0))
+ ((and (= l level)
+ (or invisible-ok
+ (not (org-invisible-p
+ (line-beginning-position)))))
+ (cl-decf count)
+ (when (= l level) (setq result (point)))))))
+ (goto-char result))
+ (beginning-of-line))))
(defun org-backward-heading-same-level (arg &optional invisible-ok)
"Move backward to the ARG'th subheading at same level as this one.
@@ -23382,20 +24065,64 @@ Stop at the first and last subheadings of a superior heading."
(interactive "p")
(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'."
+ (interactive "p")
+ (org-with-limited-levels
+ (outline-next-visible-heading arg)))
+
+(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'."
+ (interactive "p")
+ (org-with-limited-levels
+ (outline-previous-visible-heading arg)))
+
(defun org-next-block (arg &optional backward block-regexp)
"Jump to the next block.
-With a prefix argument ARG, jump forward ARG many source blocks.
+
+With a prefix argument ARG, jump forward ARG many blocks.
+
When BACKWARD is non-nil, jump to the previous block.
-When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
+
+When BLOCK-REGEXP is non-nil, use this regexp to find blocks.
+Match data is set according to this regexp when the function
+returns.
+
+Return point at beginning of the opening line of found block.
+Throw an error if no block is found."
(interactive "p")
- (let ((re (or block-regexp org-block-regexp))
- (re-search-fn (or (and backward 're-search-backward)
- 're-search-forward)))
- (if (looking-at re) (forward-char 1))
- (condition-case nil
- (funcall re-search-fn re nil nil arg)
- (error (error "No %s code blocks" (if backward "previous" "further" ))))
- (goto-char (match-beginning 0)) (org-show-context)))
+ (let ((re (or block-regexp "^[ \t]*#\\+BEGIN"))
+ (case-fold-search t)
+ (search-fn (if backward #'re-search-backward #'re-search-forward))
+ (count (or arg 1))
+ (origin (point))
+ last-element)
+ (if backward (beginning-of-line) (end-of-line))
+ (while (and (> count 0) (funcall search-fn re nil t))
+ (let ((element (save-excursion
+ (goto-char (match-beginning 0))
+ (save-match-data (org-element-at-point)))))
+ (when (and (memq (org-element-type element)
+ '(center-block comment-block dynamic-block
+ example-block export-block quote-block
+ special-block src-block verse-block))
+ (<= (match-beginning 0)
+ (org-element-property :post-affiliated element)))
+ (setq last-element element)
+ (cl-decf count))))
+ (if (= count 0)
+ (prog1 (goto-char (org-element-property :post-affiliated last-element))
+ (save-match-data (org-show-context)))
+ (goto-char origin)
+ (user-error "No %s code blocks" (if backward "previous" "further")))))
(defun org-previous-block (arg &optional block-regexp)
"Jump to the previous block.
@@ -23418,74 +24145,74 @@ item, etc. It also provides some special moves for convenience:
- On a table or a property drawer, jump after it.
- On a verse or source block, stop after blank lines."
(interactive)
- (when (eobp) (user-error "Cannot move further down"))
- (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.
- ((and post-affiliated (< (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.
- ((outline-invisible-p (line-end-position))
- (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.
- (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)))))
+ (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.
@@ -23498,57 +24225,62 @@ convenience:
- On an affiliated keyword, jump to the first one.
- On a table or a property drawer, move to its beginning.
- - On a verse or source block, stop before blank lines."
+ - On comment, example, export, src and verse blocks, stop
+ before blank lines."
(interactive)
- (when (bobp) (user-error "Cannot move further up"))
- (let* ((deactivate-mark nil)
- (element (org-element-at-point))
- (type (org-element-type element))
- (contents-begin (org-element-property :contents-begin element))
- (contents-end (org-element-property :contents-end element))
- (post-affiliated (org-element-property :post-affiliated element))
- (begin (org-element-property :begin element)))
- (cond
- ((not element) (goto-char (point-min)))
- ((= (point) begin)
- (backward-char)
- (org-backward-paragraph))
- ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin))
- ((memq type '(node-property table-row))
- (goto-char (org-element-property
- :post-affiliated (org-element-property :parent element))))
- ((memq type '(property-drawer table)) (goto-char begin))
- ((memq type '(src-block verse-block))
- (when (eq type 'src-block)
- (setq contents-begin
- (save-excursion (goto-char begin) (forward-line) (point))))
- (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))))))
- ((not contents-begin) (goto-char (or post-affiliated begin)))
- ((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.
- ((>= (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 (outline-invisible-p (point)) (beginning-of-visual-line))))
+ (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)))))
(defun org-forward-element ()
"Move forward by one element.
@@ -23587,18 +24319,21 @@ Move to the previous element at the same level, when possible."
(progn (goto-char origin)
(user-error "Cannot move further up"))))))
(t
- (let* ((trail (org-element-at-point 'keep-trail))
- (elem (car trail))
- (prev-elem (nth 1 trail))
+ (let* ((elem (org-element-at-point))
(beg (org-element-property :begin elem)))
(cond
;; Move to beginning of current element if point isn't
;; there already.
((null beg) (message "No element at point"))
((/= (point) beg) (goto-char beg))
- (prev-elem (goto-char (org-element-property :begin prev-elem)))
- ((org-before-first-heading-p) (goto-char (point-min)))
- (t (org-back-to-heading)))))))
+ (t (goto-char beg)
+ (skip-chars-backward " \r\t\n")
+ (unless (bobp)
+ (let ((prev (org-element-at-point)))
+ (goto-char (org-element-property :begin prev))
+ (while (and (setq prev (org-element-property :parent prev))
+ (<= (org-element-property :end prev) beg))
+ (goto-char (org-element-property :begin prev)))))))))))
(defun org-up-element ()
"Move to upper element."
@@ -23612,7 +24347,6 @@ Move to the previous element at the same level, when possible."
(user-error "No surrounding element")
(org-with-limited-levels (org-back-to-heading)))))))
-(defvar org-element-greater-elements)
(defun org-down-element ()
"Move to inner element."
(interactive)
@@ -23623,7 +24357,7 @@ Move to the previous element at the same level, when possible."
(forward-char))
((memq (org-element-type element) org-element-greater-elements)
;; If contents are hidden, first disclose them.
- (when (org-element-property :hiddenp element) (org-cycle))
+ (when (org-invisible-p (line-end-position)) (org-cycle))
(goto-char (or (org-element-property :contents-begin element)
(user-error "No content for this element"))))
(t (user-error "No inner element")))))
@@ -23631,24 +24365,41 @@ Move to the previous element at the same level, when possible."
(defun org-drag-element-backward ()
"Move backward element at point."
(interactive)
- (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
- (let* ((trail (org-element-at-point 'keep-trail))
- (elem (car trail))
- (prev-elem (nth 1 trail)))
- ;; Error out if no previous element or previous element is
- ;; a parent of the current one.
- (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
- (user-error "Cannot drag element backward")
- (let ((pos (point)))
- (org-element-swap-A-B prev-elem elem)
- (goto-char (+ (org-element-property :begin prev-elem)
- (- pos (org-element-property :begin elem)))))))))
+ (let ((elem (or (org-element-at-point)
+ (user-error "No element at point"))))
+ (if (eq (org-element-type elem) 'headline)
+ ;; Preserve point when moving a whole tree, even if point was
+ ;; on blank lines below the headline.
+ (let ((offset (skip-chars-backward " \t\n")))
+ (unwind-protect (org-move-subtree-up)
+ (forward-char (- offset))))
+ (let ((prev-elem
+ (save-excursion
+ (goto-char (org-element-property :begin elem))
+ (skip-chars-backward " \r\t\n")
+ (unless (bobp)
+ (let* ((beg (org-element-property :begin elem))
+ (prev (org-element-at-point))
+ (up prev))
+ (while (and (setq up (org-element-property :parent up))
+ (<= (org-element-property :end up) beg))
+ (setq prev up))
+ prev)))))
+ ;; Error out if no previous element or previous element is
+ ;; a parent of the current one.
+ (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
+ (user-error "Cannot drag element backward")
+ (let ((pos (point)))
+ (org-element-swap-A-B prev-elem elem)
+ (goto-char (+ (org-element-property :begin prev-elem)
+ (- pos (org-element-property :begin elem))))))))))
(defun org-drag-element-forward ()
"Move forward element at point."
(interactive)
(let* ((pos (point))
- (elem (org-element-at-point)))
+ (elem (or (org-element-at-point)
+ (user-error "No element at point"))))
(when (= (point-max) (org-element-property :end elem))
(user-error "Cannot drag element forward"))
(goto-char (org-element-property :end elem))
@@ -23681,7 +24432,7 @@ Move to the previous element at the same level, when possible."
(defun org-drag-line-forward (arg)
"Drag the line at point ARG lines forward."
(interactive "p")
- (dotimes (n (abs arg))
+ (dotimes (_ (abs arg))
(let ((c (current-column)))
(if (< 0 arg)
(progn
@@ -23705,7 +24456,7 @@ mode) if the mark is active, it marks the next element after the
ones already marked."
(interactive)
(let (deactivate-mark)
- (if (and (org-called-interactively-p 'any)
+ (if (and (called-interactively-p 'any)
(or (and (eq last-command this-command) (mark t))
(and transient-mark-mode mark-active)))
(set-mark
@@ -23751,13 +24502,10 @@ modified."
(interactive)
(unless (eq major-mode 'org-mode)
(user-error "Cannot un-indent a buffer not in Org mode"))
- (let* ((parse-tree (org-element-parse-buffer 'greater-element))
- unindent-tree ; For byte-compiler.
- (unindent-tree
- (function
- (lambda (contents)
- (mapc
- (lambda (element)
+ (letrec ((parse-tree (org-element-parse-buffer 'greater-element))
+ (unindent-tree
+ (lambda (contents)
+ (dolist (element (reverse contents))
(if (memq (org-element-type element) '(headline section))
(funcall unindent-tree (org-element-contents element))
(save-excursion
@@ -23765,10 +24513,49 @@ modified."
(narrow-to-region
(org-element-property :begin element)
(org-element-property :end element))
- (org-do-remove-indentation)))))
- (reverse contents))))))
+ (org-do-remove-indentation))))))))
(funcall unindent-tree (org-element-contents parse-tree))))
+(defun org-show-children (&optional level)
+ "Show all direct subheadings of this heading.
+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")
+ ;; If `orgstruct-mode' is active, use the slower version.
+ (if orgstruct-mode (call-interactively #'outline-show-children)
+ (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.
+ (outline-flag-region (line-end-position 0) (line-end-position) 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))
+ (outline-flag-region
+ (line-end-position 0) (line-end-position) nil))))))
+
(defun org-show-subtree ()
"Show everything after this heading at deeper levels."
(interactive)
@@ -23783,58 +24570,33 @@ modified."
Show the heading too, if it is currently invisible."
(interactive)
(save-excursion
- (condition-case nil
- (progn
- (org-back-to-heading t)
- (outline-flag-region
- (max (point-min) (1- (point)))
- (save-excursion
- (if (re-search-forward
- (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
- (match-beginning 1)
- (point-max)))
- nil)
- (org-cycle-hide-drawers 'children))
- (error nil))))
+ (ignore-errors
+ (org-back-to-heading t)
+ (outline-flag-region
+ (max (point-min) (1- (point)))
+ (save-excursion
+ (if (re-search-forward
+ (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t)
+ (match-beginning 1)
+ (point-max)))
+ nil)
+ (org-cycle-hide-drawers 'children))))
(defun org-make-options-regexp (kwds &optional extra)
- "Make a regular expression for keyword lines."
- (concat
- "^#\\+\\("
- (mapconcat 'regexp-quote kwds "\\|")
- (if extra (concat "\\|" extra))
- "\\):[ \t]*\\(.*\\)"))
-
-;; Make isearch reveal the necessary context
-(defun org-isearch-end ()
- "Reveal context after isearch exits."
- (when isearch-success ; only if search was successful
- (if (featurep 'xemacs)
- ;; Under XEmacs, the hook is run in the correct place,
- ;; we directly show the context.
- (org-show-context 'isearch)
- ;; In Emacs the hook runs *before* restoring the overlays.
- ;; So we have to use a one-time post-command-hook to do this.
- ;; (Emacs 22 has a special variable, see function `org-mode')
- (unless (and (boundp 'isearch-mode-end-hook-quit)
- isearch-mode-end-hook-quit)
- ;; Only when the isearch was not quitted.
- (org-add-hook 'post-command-hook 'org-isearch-post-command
- 'append 'local)))))
-
-(defun org-isearch-post-command ()
- "Remove self from hook, and show context."
- (remove-hook 'post-command-hook 'org-isearch-post-command 'local)
- (org-show-context 'isearch))
-
+ "Make a regular expression for keyword lines.
+KWDS is a list of keywords, as strings. Optional argument EXTRA,
+when non-nil, is a regexp matching keywords names."
+ (concat "^[ \t]*#\\+\\("
+ (regexp-opt kwds)
+ (and extra (concat (and kwds "\\|") extra))
+ "\\):[ \t]*\\(.*\\)"))
;;;; Integration with and fixes for other packages
;;; Imenu support
-(defvar org-imenu-markers nil
+(defvar-local org-imenu-markers nil
"All markers currently used by Imenu.")
-(make-variable-buffer-local 'org-imenu-markers)
(defun org-imenu-new-marker (&optional pos)
"Return a new marker for use by Imenu, and remember the marker."
@@ -23845,50 +24607,48 @@ Show the heading too, if it is currently invisible."
(defun org-imenu-get-tree ()
"Produce the index for Imenu."
- (mapc (lambda (x) (move-marker x nil)) org-imenu-markers)
+ (dolist (x org-imenu-markers) (move-marker x nil))
(setq org-imenu-markers nil)
- (let* ((n org-imenu-depth)
+ (let* ((case-fold-search nil)
+ (n org-imenu-depth)
(re (concat "^" (org-get-limited-outline-regexp)))
(subs (make-vector (1+ n) nil))
(last-level 0)
m level head0 head)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-max))
- (while (re-search-backward re nil t)
- (setq level (org-reduced-level (funcall outline-level)))
- (when (and (<= level n)
- (looking-at org-complex-heading-regexp)
- (setq head0 (org-match-string-no-properties 4)))
- (setq head (org-link-display-format head0)
- m (org-imenu-new-marker))
- (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
- (if (>= level last-level)
- (push (cons head m) (aref subs level))
- (push (cons head (aref subs (1+ level))) (aref subs level))
- (loop for i from (1+ level) to n do (aset subs i nil)))
- (setq last-level level)))))
+ (org-with-wide-buffer
+ (goto-char (point-max))
+ (while (re-search-backward re nil t)
+ (setq level (org-reduced-level (funcall outline-level)))
+ (when (and (<= level n)
+ (looking-at org-complex-heading-regexp)
+ (setq head0 (match-string-no-properties 4)))
+ (setq head (org-link-display-format head0)
+ m (org-imenu-new-marker))
+ (org-add-props head nil 'org-imenu-marker m 'org-imenu t)
+ (if (>= level last-level)
+ (push (cons head m) (aref subs level))
+ (push (cons head (aref subs (1+ level))) (aref subs level))
+ (cl-loop for i from (1+ level) to n do (aset subs i nil)))
+ (setq last-level level))))
(aref subs 1)))
(eval-after-load "imenu"
'(progn
(add-hook 'imenu-after-jump-hook
(lambda ()
- (if (derived-mode-p 'org-mode)
- (org-show-context 'org-goto))))))
+ (when (derived-mode-p 'org-mode)
+ (org-show-context 'org-goto))))))
-(defun org-link-display-format (link)
- "Replace a link with its the description.
+(defun org-link-display-format (s)
+ "Replace links in string S with their description.
If there is no description, use the link target."
(save-match-data
- (if (string-match org-bracket-link-analytic-regexp link)
- (replace-match (if (match-end 5)
- (match-string 5 link)
- (concat (match-string 1 link)
- (match-string 3 link)))
- nil t link)
- link)))
+ (replace-regexp-in-string
+ org-bracket-link-analytic-regexp
+ (lambda (m)
+ (if (match-end 5) (match-string 5 m)
+ (concat (match-string 1 m) (match-string 3 m))))
+ s nil t)))
(defun org-toggle-link-display ()
"Toggle the literal or descriptive display of links."
@@ -23909,11 +24669,11 @@ If there is no description, use the link target."
'face 'org-agenda-restriction-lock)
(overlay-put org-speedbar-restriction-lock-overlay
'help-echo "Agendas are currently limited to this item.")
-(org-detach-overlay org-speedbar-restriction-lock-overlay)
+(delete-overlay org-speedbar-restriction-lock-overlay)
(defun org-speedbar-set-agenda-restriction ()
"Restrict future agenda commands to the location at point in speedbar.
-To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
+To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'."
(interactive)
(require 'org-agenda)
(let (p m tp np dir txt)
@@ -23937,9 +24697,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(let ((default-directory dir))
(expand-file-name txt)))
(unless (derived-mode-p 'org-mode)
- (user-error "Cannot restrict to non-Org-mode file"))
+ (user-error "Cannot restrict to non-Org mode file"))
(org-agenda-set-restriction-lock 'file)))
- (t (user-error "Don't know how to restrict Org-mode's agenda")))
+ (t (user-error "Don't know how to restrict Org mode agenda")))
(move-overlay org-speedbar-restriction-lock-overlay
(point-at-bol) (point-at-eol))
(setq current-prefix-arg nil)
@@ -23959,34 +24719,98 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
;;; Fixes and Hacks for problems with other packages
-;; Make flyspell not check words in links, to not mess up our keymap
-(defvar org-element-affiliated-keywords) ; From org-element.el
-(defvar org-element-block-name-alist) ; From org-element.el
+(defun org--flyspell-object-check-p (element)
+ "Non-nil when Flyspell can check object at point.
+ELEMENT is the element at point."
+ (let ((object (save-excursion
+ (when (looking-at-p "\\>") (backward-char))
+ (org-element-context element))))
+ (cl-case (org-element-type object)
+ ;; Prevent checks in links due to keybinding conflict with
+ ;; Flyspell.
+ ((code entity export-snippet inline-babel-call
+ inline-src-block line-break latex-fragment link macro
+ statistics-cookie target timestamp verbatim)
+ nil)
+ (footnote-reference
+ ;; Only in inline footnotes, within the definition.
+ (and (eq (org-element-property :type object) 'inline)
+ (< (save-excursion
+ (goto-char (org-element-property :begin object))
+ (search-forward ":" nil t 2))
+ (point))))
+ (otherwise t))))
+
(defun org-mode-flyspell-verify ()
- "Don't let flyspell put overlays at active buttons, or on
- {todo,all-time,additional-option-like}-keywords."
- (require 'org-element) ; For `org-element-affiliated-keywords'
- (let ((pos (max (1- (point)) (point-min)))
- (word (thing-at-point 'word)))
- (and (not (get-text-property pos 'keymap))
- (not (get-text-property pos 'org-no-flyspell))
- (not (member word org-todo-keywords-1))
- (not (member word org-all-time-keywords))
- (not (member word org-options-keywords))
- (not (member word (mapcar 'car org-startup-options)))
- (not (member-ignore-case word org-element-affiliated-keywords))
- (not (member-ignore-case word (org-get-export-keywords)))
- (not (member-ignore-case
- word (mapcar 'car org-element-block-name-alist)))
- (not (member-ignore-case word '("BEGIN" "END" "ATTR")))
- (not (org-in-src-block-p)))))
+ "Function used for `flyspell-generic-check-word-predicate'."
+ (if (org-at-heading-p)
+ ;; At a headline or an inlinetask, check title only. This is
+ ;; faster than relying on `org-element-at-point'.
+ (and (save-excursion (beginning-of-line)
+ (and (let ((case-fold-search t))
+ (not (looking-at-p "\\*+ END[ \t]*$")))
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp))))
+ (match-beginning 4)
+ (>= (point) (match-beginning 4))
+ (or (not (match-beginning 5))
+ (< (point) (match-beginning 5))))
+ (let* ((element (org-element-at-point))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (cond
+ ;; Ignore checks in all affiliated keywords but captions.
+ ((< (point) post-affiliated)
+ (and (save-excursion
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:")))
+ (> (point) (match-end 0))
+ (org--flyspell-object-check-p element)))
+ ;; Ignore checks in LOGBOOK (or equivalent) drawer.
+ ((let ((log (org-log-into-drawer)))
+ (and log
+ (let ((drawer (org-element-lineage element '(drawer))))
+ (and drawer
+ (eq (compare-strings
+ log nil nil
+ (org-element-property :drawer-name drawer) nil nil t)
+ t)))))
+ nil)
+ (t
+ (cl-case (org-element-type element)
+ ((comment quote-section) t)
+ (comment-block
+ ;; Allow checks between block markers, not on them.
+ (and (> (line-beginning-position) post-affiliated)
+ (save-excursion
+ (end-of-line)
+ (skip-chars-forward " \r\t\n")
+ (< (point) (org-element-property :end element)))))
+ ;; Arbitrary list of keywords where checks are meaningful.
+ ;; Make sure point is on the value part of the element.
+ (keyword
+ (and (member (org-element-property :key element)
+ '("DESCRIPTION" "TITLE"))
+ (save-excursion
+ (search-backward ":" (line-beginning-position) t))))
+ ;; Check is globally allowed in paragraphs verse blocks and
+ ;; table rows (after affiliated keywords) but some objects
+ ;; must not be affected.
+ ((paragraph table-row verse-block)
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (and cbeg (>= (point) cbeg) (< (point) cend)
+ (org--flyspell-object-check-p element))))))))))
+(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
- (and (org-bound-and-true-p flyspell-mode)
+ (and (bound-and-true-p flyspell-mode)
(fboundp 'flyspell-delete-region-overlays)
- (flyspell-delete-region-overlays beg end))
- (add-text-properties beg end '(org-no-flyspell t)))
+ (flyspell-delete-region-overlays beg end)))
+
+(defvar flyspell-delayed-commands)
+(eval-after-load "flyspell"
+ '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command))
;; Make `bookmark-jump' shows the jump location if it was hidden.
(eval-after-load "bookmark"
@@ -24008,17 +24832,38 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(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."
- (if (derived-mode-p 'org-mode)
- (org-show-context))))
+ (when (derived-mode-p 'org-mode)
+ (org-show-context))))
(defun org-bookmark-jump-unhide ()
"Unhide the current position, to show the bookmark location."
(and (derived-mode-p 'org-mode)
- (or (outline-invisible-p)
+ (or (org-invisible-p)
(save-excursion (goto-char (max (point-min) (1- (point))))
- (outline-invisible-p)))
+ (org-invisible-p)))
(org-show-context 'bookmark-jump)))
+(defun org-mark-jump-unhide ()
+ "Make the point visible with `org-show-context' after jumping to the mark."
+ (when (and (derived-mode-p 'org-mode)
+ (org-invisible-p))
+ (org-show-context 'mark-goto)))
+
+(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"
+ '(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"
+ '(defadvice pop-global-mark (after org-make-visible activate)
+ "Make the point visible with `org-show-context'."
+ (org-mark-jump-unhide)))
+
;; Make session.el ignore our circular variable
(defvar session-globals-exclude)
(eval-after-load "session"
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
index 6ba70d700b2..e83eb197a82 100644
--- a/lisp/org/ox-ascii.el
+++ b/lisp/org/ox-ascii.el
@@ -1,4 +1,4 @@
-;;; ox-ascii.el --- ASCII Back-End for Org Export Engine
+;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -27,9 +27,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'ox)
(require 'ox-publish)
+(require 'cl-lib)
(declare-function aa2u "ext:ascii-art-to-unicode" ())
@@ -49,8 +49,6 @@
(center-block . org-ascii-center-block)
(clock . org-ascii-clock)
(code . org-ascii-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-ascii-drawer)
(dynamic-block . org-ascii-dynamic-block)
(entity . org-ascii-entity)
@@ -71,12 +69,13 @@
(latex-fragment . org-ascii-latex-fragment)
(line-break . org-ascii-line-break)
(link . org-ascii-link)
+ (node-property . org-ascii-node-property)
(paragraph . org-ascii-paragraph)
(plain-list . org-ascii-plain-list)
(plain-text . org-ascii-plain-text)
(planning . org-ascii-planning)
+ (property-drawer . org-ascii-property-drawer)
(quote-block . org-ascii-quote-block)
- (quote-section . org-ascii-quote-section)
(radio-target . org-ascii-radio-target)
(section . org-ascii-section)
(special-block . org-ascii-special-block)
@@ -94,7 +93,6 @@
(underline . org-ascii-underline)
(verbatim . org-ascii-verbatim)
(verse-block . org-ascii-verse-block))
- :export-block "ASCII"
:menu-entry
'(?t "Export to Plain Text"
((?A "As ASCII buffer"
@@ -119,7 +117,30 @@
(:filter-parse-tree org-ascii-filter-paragraph-spacing
org-ascii-filter-comment-spacing)
(:filter-section . org-ascii-filter-headline-blank-lines))
- :options-alist '((:ascii-charset nil nil org-ascii-charset)))
+ :options-alist
+ '((:subtitle "SUBTITLE" nil nil parse)
+ (:ascii-bullets nil nil org-ascii-bullets)
+ (:ascii-caption-above nil nil org-ascii-caption-above)
+ (:ascii-charset nil nil org-ascii-charset)
+ (:ascii-global-margin nil nil org-ascii-global-margin)
+ (:ascii-format-drawer-function nil nil org-ascii-format-drawer-function)
+ (:ascii-format-inlinetask-function
+ nil nil org-ascii-format-inlinetask-function)
+ (:ascii-headline-spacing nil nil org-ascii-headline-spacing)
+ (:ascii-indented-line-width nil nil org-ascii-indented-line-width)
+ (:ascii-inlinetask-width nil nil org-ascii-inlinetask-width)
+ (:ascii-inner-margin nil nil org-ascii-inner-margin)
+ (:ascii-links-to-notes nil nil org-ascii-links-to-notes)
+ (:ascii-list-margin nil nil org-ascii-list-margin)
+ (:ascii-paragraph-spacing nil nil org-ascii-paragraph-spacing)
+ (:ascii-quote-margin nil nil org-ascii-quote-margin)
+ (:ascii-table-keep-all-vertical-lines
+ nil nil org-ascii-table-keep-all-vertical-lines)
+ (:ascii-table-use-ascii-art nil nil org-ascii-table-use-ascii-art)
+ (:ascii-table-widen-columns nil nil org-ascii-table-widen-columns)
+ (:ascii-text-width nil nil org-ascii-text-width)
+ (:ascii-underline nil nil org-ascii-underline)
+ (:ascii-verbatim-format nil nil org-ascii-verbatim-format)))
@@ -156,12 +177,22 @@ Inner margin is applied between each headline."
(defcustom org-ascii-quote-margin 6
"Width of margin used for quoting text, in characters.
-This margin is applied on both sides of the text."
+This margin is applied on both sides of the text. It is also
+applied on the left side of contents in descriptive lists."
:group 'org-export-ascii
:version "24.4"
:package-version '(Org . "8.0")
:type 'integer)
+(defcustom org-ascii-list-margin 0
+ "Width of margin used for plain lists, in characters.
+This margin applies to top level list only, not to its
+sub-lists."
+ :group 'org-export-ascii
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'integer)
+
(defcustom org-ascii-inlinetask-width 30
"Width of inline tasks, in number of characters.
This number ignores any margin."
@@ -311,13 +342,10 @@ Org mode, i.e. with \"=>\" as ellipsis."
:type 'boolean)
(defcustom org-ascii-table-use-ascii-art nil
- "Non-nil means table.el tables are turned into ascii-art.
-
+ "Non-nil means \"table.el\" tables are turned into ASCII art.
It only makes sense when export charset is `utf-8'. It is nil by
-default since it requires ascii-art-to-unicode.el package. You
-can download it here:
-
- http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el."
+default since it requires \"ascii-art-to-unicode.el\" package,
+available through, e.g., GNU ELPA."
:group 'org-export-ascii
:version "24.4"
:package-version '(Org . "8.0")
@@ -339,7 +367,7 @@ Otherwise, place it right after it."
:type 'string)
(defcustom org-ascii-format-drawer-function
- (lambda (name contents width) contents)
+ (lambda (_name contents _width) contents)
"Function called to format a drawer in ASCII.
The function must accept three parameters:
@@ -374,7 +402,7 @@ The function must accept nine parameters:
The function should return either the string to be exported or
nil to ignore the inline task."
:group 'org-export-ascii
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'function)
@@ -384,14 +412,18 @@ nil to ignore the inline task."
;; Internal functions fall into three categories.
-;; The first one is about text formatting. The core function is
-;; `org-ascii--current-text-width', which determines the current
-;; text width allowed to a given element. In other words, it helps
-;; keeping each line width within maximum text width defined in
-;; `org-ascii-text-width'. Once this information is known,
-;; `org-ascii--fill-string', `org-ascii--justify-string',
-;; `org-ascii--box-string' and `org-ascii--indent-string' can
-;; operate on a given output string.
+;; The first one is about text formatting. The core functions are
+;; `org-ascii--current-text-width' and
+;; `org-ascii--current-justification', which determine, respectively,
+;; the current text width allowed to a given element and its expected
+;; justification. Once this information is known,
+;; `org-ascii--fill-string', `org-ascii--justify-lines',
+;; `org-ascii--justify-element' `org-ascii--box-string' and
+;; `org-ascii--indent-string' can operate on a given output string.
+;; In particular, justification happens at the regular (i.e.,
+;; non-greater) element level, which means that when the exporting
+;; process reaches a container (e.g., a center block) content are
+;; already justified.
;; The second category contains functions handling elements listings,
;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc'
@@ -420,7 +452,8 @@ a communication channel.
Optional argument JUSTIFY can specify any type of justification
among `left', `center', `right' or `full'. A nil value is
equivalent to `left'. For a justification that doesn't also fill
-string, see `org-ascii--justify-string'.
+string, see `org-ascii--justify-lines' and
+`org-ascii--justify-block'.
Return nil if S isn't a string."
(when (stringp s)
@@ -435,8 +468,8 @@ Return nil if S isn't a string."
(fill-region (point-min) (point-max) justify))
(buffer-string)))))
-(defun org-ascii--justify-string (s text-width how)
- "Justify string S.
+(defun org-ascii--justify-lines (s text-width how)
+ "Justify all lines in string S.
TEXT-WIDTH is an integer specifying maximum length of a line.
HOW determines the type of justification: it can be `left',
`right', `full' or `center'."
@@ -452,6 +485,48 @@ HOW determines the type of justification: it can be `left',
(forward-line)))
(buffer-string)))
+(defun org-ascii--justify-element (contents element info)
+ "Justify CONTENTS of ELEMENT.
+INFO is a plist used as a communication channel. Justification
+is done according to the type of element. More accurately,
+paragraphs are filled and other elements are justified as blocks,
+that is according to the widest non blank line in CONTENTS."
+ (if (not (org-string-nw-p contents)) contents
+ (let ((text-width (org-ascii--current-text-width element info))
+ (how (org-ascii--current-justification element)))
+ (cond
+ ((eq (org-element-type element) 'paragraph)
+ ;; Paragraphs are treated specially as they need to be filled.
+ (org-ascii--fill-string contents text-width info how))
+ ((eq how 'left) contents)
+ (t (with-temp-buffer
+ (insert contents)
+ (goto-char (point-min))
+ (catch 'exit
+ (let ((max-width 0))
+ ;; Compute maximum width. Bail out if it is greater
+ ;; than page width, since no justification is
+ ;; possible.
+ (save-excursion
+ (while (not (eobp))
+ (unless (looking-at-p "[ \t]*$")
+ (end-of-line)
+ (let ((column (current-column)))
+ (cond
+ ((>= column text-width) (throw 'exit contents))
+ ((> column max-width) (setq max-width column)))))
+ (forward-line)))
+ ;; Justify every line according to TEXT-WIDTH and
+ ;; MAX-WIDTH.
+ (let ((offset (/ (- text-width max-width)
+ (if (eq how 'right) 1 2))))
+ (if (zerop offset) (throw 'exit contents)
+ (while (not (eobp))
+ (unless (looking-at-p "[ \t]*$")
+ (indent-to-column offset))
+ (forward-line)))))
+ (buffer-string))))))))
+
(defun org-ascii--indent-string (s width)
"Indent string S by WIDTH white spaces.
Empty lines are not indented."
@@ -472,71 +547,89 @@ INFO is a plist used as a communication channel."
(defun org-ascii--current-text-width (element info)
"Return maximum text width for ELEMENT's contents.
INFO is a plist used as a communication channel."
- (case (org-element-type element)
+ (pcase (org-element-type element)
;; Elements with an absolute width: `headline' and `inlinetask'.
- (inlinetask org-ascii-inlinetask-width)
- (headline
- (- org-ascii-text-width
- (let ((low-level-rank (org-export-low-level-p element info)))
- (if low-level-rank (* low-level-rank 2) org-ascii-global-margin))))
+ (`inlinetask (plist-get info :ascii-inlinetask-width))
+ (`headline
+ (- (plist-get info :ascii-text-width)
+ (let ((low-level-rank (org-export-low-level-p element info)))
+ (if low-level-rank (* low-level-rank 2)
+ (plist-get info :ascii-global-margin)))))
;; Elements with a relative width: store maximum text width in
;; TOTAL-WIDTH.
- (otherwise
- (let* ((genealogy (cons element (org-export-get-genealogy element)))
- ;; Total width is determined by the presence, or not, of an
- ;; inline task among ELEMENT parents.
- (total-width
- (if (loop for parent in genealogy
- thereis (eq (org-element-type parent) 'inlinetask))
- org-ascii-inlinetask-width
- ;; No inlinetask: Remove global margin from text width.
- (- org-ascii-text-width
- org-ascii-global-margin
- (let ((parent (org-export-get-parent-headline element)))
- ;; Inner margin doesn't apply to text before first
- ;; headline.
- (if (not parent) 0
- (let ((low-level-rank
- (org-export-low-level-p parent info)))
- ;; Inner margin doesn't apply to contents of
- ;; low level headlines, since they've got their
- ;; own indentation mechanism.
- (if low-level-rank (* low-level-rank 2)
- org-ascii-inner-margin))))))))
+ (_
+ (let* ((genealogy (org-element-lineage element nil t))
+ ;; Total width is determined by the presence, or not, of an
+ ;; inline task among ELEMENT parents.
+ (total-width
+ (if (cl-some (lambda (parent)
+ (eq (org-element-type parent) 'inlinetask))
+ genealogy)
+ (plist-get info :ascii-inlinetask-width)
+ ;; No inlinetask: Remove global margin from text width.
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin)
+ (let ((parent (org-export-get-parent-headline element)))
+ ;; Inner margin doesn't apply to text before first
+ ;; headline.
+ (if (not parent) 0
+ (let ((low-level-rank
+ (org-export-low-level-p parent info)))
+ ;; Inner margin doesn't apply to contents of
+ ;; low level headlines, since they've got their
+ ;; own indentation mechanism.
+ (if low-level-rank (* low-level-rank 2)
+ (plist-get info :ascii-inner-margin)))))))))
(- total-width
- ;; Each `quote-block', `quote-section' and `verse-block' above
- ;; narrows text width by twice the standard margin size.
- (+ (* (loop for parent in genealogy
- when (memq (org-element-type parent)
- '(quote-block quote-section verse-block))
- count parent)
- 2 org-ascii-quote-margin)
- ;; Text width within a plain-list is restricted by
- ;; indentation of current item. If that's the case,
- ;; compute it with the help of `:structure' property from
- ;; parent item, if any.
- (let ((parent-item
- (if (eq (org-element-type element) 'item) element
- (loop for parent in genealogy
- when (eq (org-element-type parent) 'item)
- return parent))))
- (if (not parent-item) 0
- ;; Compute indentation offset of the current item,
- ;; that is the sum of the difference between its
- ;; indentation and the indentation of the top item in
- ;; the list and current item bullet's length. Also
- ;; remove checkbox length, and tag length (for
- ;; description lists) or bullet length.
- (let ((struct (org-element-property :structure parent-item))
- (beg-item (org-element-property :begin parent-item)))
- (+ (- (org-list-get-ind beg-item struct)
- (org-list-get-ind
- (org-list-get-top-point struct) struct))
- (string-width (or (org-ascii--checkbox parent-item info)
- ""))
- (string-width
- (or (org-list-get-tag beg-item struct)
- (org-list-get-bullet beg-item struct)))))))))))))
+ ;; Each `quote-block' and `verse-block' above narrows text
+ ;; width by twice the standard margin size.
+ (+ (* (cl-count-if (lambda (parent)
+ (memq (org-element-type parent)
+ '(quote-block verse-block)))
+ genealogy)
+ 2
+ (plist-get info :ascii-quote-margin))
+ ;; Apply list margin once per "top-level" plain-list
+ ;; containing current line
+ (* (cl-count-if
+ (lambda (e)
+ (and (eq (org-element-type e) 'plain-list)
+ (not (eq (org-element-type (org-export-get-parent e))
+ 'item))))
+ genealogy)
+ (plist-get info :ascii-list-margin))
+ ;; Compute indentation offset due to current list. It is
+ ;; `org-ascii-quote-margin' per descriptive item in the
+ ;; genealogy, bullet's length otherwise.
+ (let ((indentation 0))
+ (dolist (e genealogy)
+ (cond
+ ((not (eq 'item (org-element-type e))))
+ ((eq (org-element-property :type (org-export-get-parent e))
+ 'descriptive)
+ (cl-incf indentation org-ascii-quote-margin))
+ (t
+ (cl-incf indentation
+ (+ (string-width
+ (or (org-ascii--checkbox e info) ""))
+ (string-width
+ (org-element-property :bullet e)))))))
+ indentation)))))))
+
+(defun org-ascii--current-justification (element)
+ "Return expected justification for ELEMENT's contents.
+Return value is a symbol among `left', `center', `right' and
+`full'."
+ (let (justification)
+ (while (and (not justification)
+ (setq element (org-element-property :parent element)))
+ (pcase (org-element-type element)
+ (`center-block (setq justification 'center))
+ (`special-block
+ (let ((name (org-element-property :type element)))
+ (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right))
+ ((string= name "JUSTIFYLEFT") (setq justification 'left)))))))
+ (or justification 'left)))
(defun org-ascii--build-title
(element info text-width &optional underline notags toc)
@@ -601,14 +694,14 @@ possible. It doesn't apply to `inlinetask' elements."
(let ((under-char
(nth (1- (org-export-get-relative-level element info))
(cdr (assq (plist-get info :ascii-charset)
- org-ascii-underline)))))
+ (plist-get info :ascii-underline))))))
(and under-char
(concat "\n"
(make-string (/ (string-width first-part)
(char-width under-char))
under-char))))))))
-(defun org-ascii--has-caption-p (element info)
+(defun org-ascii--has-caption-p (element _info)
"Non-nil when ELEMENT has a caption affiliated keyword.
INFO is a plist used as a communication channel. This function
is meant to be used as a predicate for `org-export-get-ordinal'."
@@ -630,9 +723,9 @@ caption keyword."
(org-export-get-ordinal
element info nil 'org-ascii--has-caption-p))
(title-fmt (org-ascii--translate
- (case (org-element-type element)
- (table "Table %d:")
- (src-block "Listing %d:"))
+ (pcase (org-element-type element)
+ (`table "Table %d:")
+ (`src-block "Listing %d:"))
info)))
(org-ascii--fill-string
(concat (format title-fmt reference)
@@ -640,7 +733,7 @@ caption keyword."
(org-export-data caption info))
(org-ascii--current-text-width element info) info)))))
-(defun org-ascii--build-toc (info &optional n keyword)
+(defun org-ascii--build-toc (info &optional n keyword local)
"Return a table of contents.
INFO is a plist used as a communication channel.
@@ -649,28 +742,34 @@ Optional argument N, when non-nil, is an integer specifying the
depth of the table.
Optional argument KEYWORD specifies the TOC keyword, if any, from
-which the table of contents generation has been initiated."
- (let ((title (org-ascii--translate "Table of Contents" info)))
- (concat
- title "\n"
- (make-string (string-width title)
- (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
- "\n\n"
- (let ((text-width
- (if keyword (org-ascii--current-text-width keyword info)
- (- org-ascii-text-width org-ascii-global-margin))))
- (mapconcat
- (lambda (headline)
- (let* ((level (org-export-get-relative-level headline info))
- (indent (* (1- level) 3)))
- (concat
- (unless (zerop indent) (concat (make-string (1- indent) ?.) " "))
- (org-ascii--build-title
- headline info (- text-width indent) nil
- (or (not (plist-get info :with-tags))
- (eq (plist-get info :with-tags) 'not-in-toc))
- 'toc))))
- (org-export-collect-headlines info n) "\n")))))
+which the table of contents generation has been initiated.
+
+When optional argument LOCAL is non-nil, build a table of
+contents according to the current headline."
+ (concat
+ (unless local
+ (let ((title (org-ascii--translate "Table of Contents" info)))
+ (concat title "\n"
+ (make-string
+ (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))
+ "\n\n")))
+ (let ((text-width
+ (if keyword (org-ascii--current-text-width keyword info)
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin)))))
+ (mapconcat
+ (lambda (headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (indent (* (1- level) 3)))
+ (concat
+ (unless (zerop indent) (concat (make-string (1- indent) ?.) " "))
+ (org-ascii--build-title
+ headline info (- text-width indent) nil
+ (or (not (plist-get info :with-tags))
+ (eq (plist-get info :with-tags) 'not-in-toc))
+ 'toc))))
+ (org-export-collect-headlines info n (and local keyword)) "\n"))))
(defun org-ascii--list-listings (keyword info)
"Return a list of listings.
@@ -685,7 +784,8 @@ generation. INFO is a plist used as a communication channel."
"\n\n"
(let ((text-width
(if keyword (org-ascii--current-text-width keyword info)
- (- org-ascii-text-width org-ascii-global-margin)))
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin))))
;; Use a counter instead of retrieving ordinal of each
;; src-block.
(count 0))
@@ -696,7 +796,7 @@ generation. INFO is a plist used as a communication channel."
;; filling (like contents of a description list item).
(let* ((initial-text
(format (org-ascii--translate "Listing %d:" info)
- (incf count)))
+ (cl-incf count)))
(initial-width (string-width initial-text)))
(concat
initial-text " "
@@ -724,7 +824,8 @@ generation. INFO is a plist used as a communication channel."
"\n\n"
(let ((text-width
(if keyword (org-ascii--current-text-width keyword info)
- (- org-ascii-text-width org-ascii-global-margin)))
+ (- (plist-get info :ascii-text-width)
+ (plist-get info :ascii-global-margin))))
;; Use a counter instead of retrieving ordinal of each
;; src-block.
(count 0))
@@ -735,7 +836,7 @@ generation. INFO is a plist used as a communication channel."
;; filling (like contents of a description list item).
(let* ((initial-text
(format (org-ascii--translate "Table %d:" info)
- (incf count)))
+ (cl-incf count)))
(initial-width (string-width initial-text)))
(concat
initial-text " "
@@ -756,69 +857,106 @@ ELEMENT is either a headline element or a section element. INFO
is a plist used as a communication channel."
(let* (seen
(unique-link-p
- (function
- ;; Return LINK if it wasn't referenced so far, or nil.
- ;; Update SEEN links along the way.
- (lambda (link)
- (let ((footprint
- ;; Normalize description in footprints.
- (cons (org-element-property :raw-link link)
- (let ((contents (org-element-contents link)))
- (and contents
- (replace-regexp-in-string
- "[ \r\t\n]+" " "
- (org-trim
- (org-element-interpret-data contents))))))))
- ;; Ignore LINK if it hasn't been translated already.
- ;; It can happen if it is located in an affiliated
- ;; keyword that was ignored.
- (when (and (org-string-nw-p
- (gethash link (plist-get info :exported-data)))
- (not (member footprint seen)))
- (push footprint seen) link)))))
- ;; If at a section, find parent headline, if any, in order to
- ;; count links that might be in the title.
- (headline
- (if (eq (org-element-type element) 'headline) element
- (or (org-export-get-parent-headline element) element))))
- ;; Get all links in HEADLINE.
- (org-element-map headline 'link
- (lambda (l) (funcall unique-link-p l)) info nil nil t)))
+ ;; Return LINK if it wasn't referenced so far, or nil.
+ ;; Update SEEN links along the way.
+ (lambda (link)
+ (let ((footprint
+ ;; Normalize description in footprints.
+ (cons (org-element-property :raw-link link)
+ (let ((contents (org-element-contents link)))
+ (and contents
+ (replace-regexp-in-string
+ "[ \r\t\n]+" " "
+ (org-trim
+ (org-element-interpret-data contents))))))))
+ ;; Ignore LINK if it hasn't been translated already. It
+ ;; can happen if it is located in an affiliated keyword
+ ;; that was ignored.
+ (when (and (org-string-nw-p
+ (gethash link (plist-get info :exported-data)))
+ (not (member footprint seen)))
+ (push footprint seen) link)))))
+ (org-element-map (if (eq (org-element-type element) 'section)
+ element
+ ;; In a headline, only retrieve links in title
+ ;; and relative section, not in children.
+ (list (org-element-property :title element)
+ (car (org-element-contents element))))
+ 'link unique-link-p info nil 'headline t)))
+
+(defun org-ascii--describe-datum (datum info)
+ "Describe DATUM object or element.
+If DATUM is a string, consider it to be a file name, per
+`org-export-resolve-id-link'. INFO is the communication channel,
+as a plist."
+ (pcase (org-element-type datum)
+ (`plain-text (format "See file %s" datum)) ;External file
+ (`headline
+ (format (org-ascii--translate "See section %s" info)
+ (if (org-export-numbered-headline-p datum info)
+ (mapconcat #'number-to-string
+ (org-export-get-headline-number datum info)
+ ".")
+ (org-export-data (org-element-property :title datum) info))))
+ (_
+ (let ((number (org-export-get-ordinal
+ datum info nil #'org-ascii--has-caption-p))
+ ;; If destination is a target, make sure we can name the
+ ;; container it refers to.
+ (enumerable
+ (org-element-lineage datum
+ '(headline paragraph src-block table) t)))
+ (pcase (org-element-type enumerable)
+ (`headline
+ (format (org-ascii--translate "See section %s" info)
+ (if (org-export-numbered-headline-p enumerable info)
+ (mapconcat #'number-to-string number ".")
+ (org-export-data
+ (org-element-property :title enumerable) info))))
+ ((guard (not number))
+ (org-ascii--translate "Unknown reference" info))
+ (`paragraph
+ (format (org-ascii--translate "See figure %s" info) number))
+ (`src-block
+ (format (org-ascii--translate "See listing %s" info) number))
+ (`table
+ (format (org-ascii--translate "See table %s" info) number))
+ (_ (org-ascii--translate "Unknown reference" info)))))))
(defun org-ascii--describe-links (links width info)
"Return a string describing a list of links.
-
LINKS is a list of link type objects, as returned by
`org-ascii--unique-links'. WIDTH is the text width allowed for
the output string. INFO is a plist used as a communication
channel."
(mapconcat
(lambda (link)
- (let ((type (org-element-property :type link))
- (anchor (let ((desc (org-element-contents link)))
- (if desc (org-export-data desc info)
- (org-element-property :raw-link link)))))
+ (let* ((type (org-element-property :type link))
+ (description (org-element-contents link))
+ (anchor (org-export-data
+ (or description (org-element-property :raw-link link))
+ info)))
(cond
- ;; Coderefs, radio links and fuzzy links are ignored.
- ((member type '("coderef" "radio" "fuzzy")) nil)
- ;; Id and custom-id links: Headlines refer to their numbering.
- ((member type '("custom-id" "id"))
- (let ((dest (org-export-resolve-id-link link info)))
- (concat
- (org-ascii--fill-string
- (format
- "[%s] %s"
- anchor
- (if (not dest) (org-ascii--translate "Unknown reference" info)
- (format
- (org-ascii--translate "See section %s" info)
- (mapconcat 'number-to-string
- (org-export-get-headline-number dest info) "."))))
- width info) "\n\n")))
+ ((member type '("coderef" "radio")) nil)
+ ((member type '("custom-id" "fuzzy" "id"))
+ ;; Only links with a description need an entry. Other are
+ ;; already handled in `org-ascii-link'.
+ (when description
+ (let ((dest (if (equal type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (concat
+ (org-ascii--fill-string
+ (format "[%s] %s" anchor (org-ascii--describe-datum dest info))
+ width info)
+ "\n\n"))))
;; Do not add a link that cannot be resolved and doesn't have
;; any description: destination is already visible in the
;; paragraph.
((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)
(t
(concat
(org-ascii--fill-string
@@ -831,10 +969,10 @@ channel."
"Return checkbox string for ITEM or nil.
INFO is a plist used as a communication channel."
(let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)))
- (case (org-element-property :checkbox item)
- (on (if utf8p "☑ " "[X] "))
- (off (if utf8p "☐ " "[ ] "))
- (trans (if utf8p "☒ " "[-] ")))))
+ (pcase (org-element-property :checkbox item)
+ (`on (if utf8p "☑ " "[X] "))
+ (`off (if utf8p "☐ " "[ ] "))
+ (`trans (if utf8p "☒ " "[-] ")))))
@@ -843,11 +981,15 @@ INFO is a plist used as a communication channel."
(defun org-ascii-template--document-title (info)
"Return document title, as a string.
INFO is a plist used as a communication channel."
- (let* ((text-width org-ascii-text-width)
+ (let* ((text-width (plist-get info :ascii-text-width))
;; Links in the title will not be resolved later, so we make
;; sure their path is located right after them.
- (org-ascii-links-to-notes nil)
- (title (org-export-data (plist-get info :title) info))
+ (info (org-combine-plists info '(:ascii-links-to-notes nil)))
+ (with-title (plist-get info :with-title))
+ (title (org-export-data
+ (when with-title (plist-get info :title)) info))
+ (subtitle (org-export-data
+ (when with-title (plist-get info :subtitle)) info))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -878,7 +1020,7 @@ INFO is a plist used as a communication channel."
date "\n\n\n"))
((org-string-nw-p date)
(concat
- (org-ascii--justify-string date text-width 'right)
+ (org-ascii--justify-lines date text-width 'right)
"\n\n\n"))
((and (org-string-nw-p author) (org-string-nw-p email))
(concat author "\n" email "\n\n\n"))
@@ -890,8 +1032,14 @@ INFO is a plist used as a communication channel."
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
;; Format TITLE. It may be filled if it is too wide,
;; that is wider than the two thirds of the total width.
- (title-len (min (length title) (/ (* 2 text-width) 3)))
+ (title-len (min (apply #'max
+ (mapcar #'length
+ (org-split-string
+ (concat title "\n" subtitle) "\n")))
+ (/ (* 2 text-width) 3)))
(formatted-title (org-ascii--fill-string title title-len info))
+ (formatted-subtitle (when (org-string-nw-p subtitle)
+ (org-ascii--fill-string subtitle title-len info)))
(line
(make-string
(min (+ (max title-len
@@ -899,17 +1047,16 @@ INFO is a plist used as a communication channel."
(string-width (or email "")))
2)
text-width) (if utf8p ?━ ?_))))
- (org-ascii--justify-string
+ (org-ascii--justify-lines
(concat line "\n"
(unless utf8p "\n")
(upcase formatted-title)
+ (and formatted-subtitle (concat "\n" formatted-subtitle))
(cond
((and (org-string-nw-p author) (org-string-nw-p email))
- (concat (if utf8p "\n\n\n" "\n\n") author "\n" email))
- ((org-string-nw-p author)
- (concat (if utf8p "\n\n\n" "\n\n") author))
- ((org-string-nw-p email)
- (concat (if utf8p "\n\n\n" "\n\n") email)))
+ (concat "\n\n" author "\n" email))
+ ((org-string-nw-p author) (concat "\n\n" author))
+ ((org-string-nw-p email) (concat "\n\n" email)))
"\n" line
(when (org-string-nw-p date) (concat "\n\n\n" date))
"\n\n\n") text-width 'center)))))
@@ -919,81 +1066,83 @@ INFO is a plist used as a communication channel."
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(org-element-normalize-string
- (org-ascii--indent-string
- (concat
- ;; 1. Document's body.
- contents
- ;; 2. Footnote definitions.
- (let ((definitions (org-export-collect-footnote-definitions
- (plist-get info :parse-tree) info))
- ;; Insert full links right inside the footnote definition
- ;; as they have no chance to be inserted later.
- (org-ascii-links-to-notes nil))
- (when definitions
- (concat
- "\n\n\n"
- (let ((title (org-ascii--translate "Footnotes" info)))
- (concat
- title "\n"
- (make-string
- (string-width title)
- (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
- "\n\n"
- (let ((text-width (- org-ascii-text-width org-ascii-global-margin)))
- (mapconcat
- (lambda (ref)
- (let ((id (format "[%s] " (car ref))))
- ;; Distinguish between inline definitions and
- ;; full-fledged definitions.
- (org-trim
- (let ((def (nth 2 ref)))
- (if (eq (org-element-type def) 'org-data)
- ;; Full-fledged definition: footnote ID is
- ;; inserted inside the first parsed paragraph
- ;; (FIRST), if any, to be sure filling will
- ;; take it into consideration.
- (let ((first (car (org-element-contents def))))
- (if (not (eq (org-element-type first) 'paragraph))
- (concat id "\n" (org-export-data def info))
- (push id (nthcdr 2 first))
- (org-export-data def info)))
- ;; Fill paragraph once footnote ID is inserted
- ;; in order to have a correct length for first
- ;; line.
- (org-ascii--fill-string
- (concat id (org-export-data def info))
- text-width info))))))
- definitions "\n\n"))))))
- org-ascii-global-margin)))
+ (let ((global-margin (plist-get info :ascii-global-margin)))
+ (org-ascii--indent-string
+ (concat
+ ;; 1. Document's body.
+ contents
+ ;; 2. Footnote definitions.
+ (let ((definitions (org-export-collect-footnote-definitions info))
+ ;; Insert full links right inside the footnote definition
+ ;; as they have no chance to be inserted later.
+ (info (org-combine-plists info '(:ascii-links-to-notes nil))))
+ (when definitions
+ (concat
+ "\n\n\n"
+ (let ((title (org-ascii--translate "Footnotes" info)))
+ (concat
+ title "\n"
+ (make-string
+ (string-width title)
+ (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_))))
+ "\n\n"
+ (let ((text-width (- (plist-get info :ascii-text-width)
+ global-margin)))
+ (mapconcat
+ (lambda (ref)
+ (let ((id (format "[%s] " (car ref))))
+ ;; Distinguish between inline definitions and
+ ;; full-fledged definitions.
+ (org-trim
+ (let ((def (nth 2 ref)))
+ (if (org-element-map def org-element-all-elements
+ #'identity info 'first-match)
+ ;; Full-fledged definition: footnote ID is
+ ;; inserted inside the first parsed
+ ;; paragraph (FIRST), if any, to be sure
+ ;; filling will take it into consideration.
+ (let ((first (car (org-element-contents def))))
+ (if (not (eq (org-element-type first) 'paragraph))
+ (concat id "\n" (org-export-data def info))
+ (push id (nthcdr 2 first))
+ (org-export-data def info)))
+ ;; Fill paragraph once footnote ID is inserted
+ ;; in order to have a correct length for first
+ ;; line.
+ (org-ascii--fill-string
+ (concat id (org-export-data def info))
+ text-width info))))))
+ definitions "\n\n"))))))
+ global-margin))))
(defun org-ascii-template (contents info)
"Return complete document string after ASCII conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (concat
- ;; 1. Build title block.
- (org-ascii--indent-string
- (concat (org-ascii-template--document-title info)
- ;; 2. Table of contents.
- (let ((depth (plist-get info :with-toc)))
- (when depth
- (concat
- (org-ascii--build-toc info (and (wholenump depth) depth))
- "\n\n\n"))))
- org-ascii-global-margin)
- ;; 3. Document's body.
- contents
- ;; 4. Creator. Ignore `comment' value as there are no comments in
- ;; ASCII. Justify it to the bottom right.
- (org-ascii--indent-string
- (let ((creator-info (plist-get info :with-creator))
- (text-width (- org-ascii-text-width org-ascii-global-margin)))
- (unless (or (not creator-info) (eq creator-info 'comment))
- (concat
- "\n\n\n"
- (org-ascii--fill-string
- (plist-get info :creator) text-width info 'right))))
- org-ascii-global-margin)))
+ (let ((global-margin (plist-get info :ascii-global-margin)))
+ (concat
+ ;; Build title block.
+ (org-ascii--indent-string
+ (concat (org-ascii-template--document-title info)
+ ;; 2. Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat
+ (org-ascii--build-toc info (and (wholenump depth) depth))
+ "\n\n\n"))))
+ global-margin)
+ ;; Document's body.
+ contents
+ ;; Creator. Justify it to the bottom right.
+ (and (plist-get info :with-creator)
+ (org-ascii--indent-string
+ (let ((text-width
+ (- (plist-get info :ascii-text-width) global-margin)))
+ (concat
+ "\n\n\n"
+ (org-ascii--fill-string
+ (plist-get info :creator) text-width info 'right)))
+ global-margin)))))
(defun org-ascii--translate (s info)
"Translate string S according to specified language and charset.
@@ -1007,7 +1156,7 @@ INFO is a plist used as a communication channel."
;;;; Bold
-(defun org-ascii-bold (bold contents info)
+(defun org-ascii-bold (_bold contents _info)
"Transcode BOLD from Org to ASCII.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -1016,39 +1165,41 @@ contextual information."
;;;; Center Block
-(defun org-ascii-center-block (center-block contents info)
+(defun org-ascii-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (org-ascii--justify-string
- contents (org-ascii--current-text-width center-block info) 'center))
+ ;; Center has already been taken care of at a lower level, so
+ ;; there's nothing left to do.
+ contents)
;;;; Clock
-(defun org-ascii-clock (clock contents info)
+(defun org-ascii-clock (clock _contents info)
"Transcode a CLOCK object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (concat org-clock-string " "
- (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
- (let ((time (org-element-property :duration clock)))
- (and time
- (concat " => "
- (apply 'format
- "%2s:%02s"
- (org-split-string time ":")))))))
+ (org-ascii--justify-element
+ (concat org-clock-string " "
+ (org-timestamp-translate (org-element-property :value clock))
+ (let ((time (org-element-property :duration clock)))
+ (and time
+ (concat " => "
+ (apply 'format
+ "%2s:%02s"
+ (org-split-string time ":"))))))
+ clock info))
;;;; Code
-(defun org-ascii-code (code contents info)
+(defun org-ascii-code (code _contents info)
"Return a CODE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format org-ascii-verbatim-format (org-element-property :value code)))
+ (format (plist-get info :ascii-verbatim-format)
+ (org-element-property :value code)))
;;;; Drawer
@@ -1059,12 +1210,13 @@ CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((name (org-element-property :drawer-name drawer))
(width (org-ascii--current-text-width drawer info)))
- (funcall org-ascii-format-drawer-function name contents width)))
+ (funcall (plist-get info :ascii-format-drawer-function)
+ name contents width)))
;;;; Dynamic Block
-(defun org-ascii-dynamic-block (dynamic-block contents info)
+(defun org-ascii-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1073,7 +1225,7 @@ holding contextual information."
;;;; Entity
-(defun org-ascii-entity (entity contents info)
+(defun org-ascii-entity (entity _contents info)
"Transcode an ENTITY object from Org to ASCII.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -1084,16 +1236,18 @@ contextual information."
;;;; Example Block
-(defun org-ascii-example-block (example-block contents info)
+(defun org-ascii-example-block (example-block _contents info)
"Transcode a EXAMPLE-BLOCK element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
- (org-ascii--box-string
- (org-export-format-code-default example-block info) info))
+ (org-ascii--justify-element
+ (org-ascii--box-string
+ (org-export-format-code-default example-block info) info)
+ example-block info))
;;;; Export Snippet
-(defun org-ascii-export-snippet (export-snippet contents info)
+(defun org-ascii-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'ascii)
@@ -1102,21 +1256,24 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Block
-(defun org-ascii-export-block (export-block contents info)
+(defun org-ascii-export-block (export-block _contents info)
"Transcode a EXPORT-BLOCK element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "ASCII")
- (org-remove-indentation (org-element-property :value export-block))))
+ (org-ascii--justify-element
+ (org-element-property :value export-block) export-block info)))
;;;; Fixed Width
-(defun org-ascii-fixed-width (fixed-width contents info)
+(defun org-ascii-fixed-width (fixed-width _contents info)
"Transcode a FIXED-WIDTH element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
- (org-ascii--box-string
- (org-remove-indentation
- (org-element-property :value fixed-width)) info))
+ (org-ascii--justify-element
+ (org-ascii--box-string
+ (org-remove-indentation
+ (org-element-property :value fixed-width)) info)
+ fixed-width info))
;;;; Footnote Definition
@@ -1127,7 +1284,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-ascii-footnote-reference (footnote-reference contents info)
+(defun org-ascii-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "[%s]" (org-export-get-footnote-number footnote-reference info)))
@@ -1142,57 +1299,62 @@ holding contextual information."
;; Don't export footnote section, which will be handled at the end
;; of the template.
(unless (org-element-property :footnote-section-p headline)
- (let* ((low-level-rank (org-export-low-level-p headline info))
+ (let* ((low-level (org-export-low-level-p headline info))
(width (org-ascii--current-text-width headline info))
+ ;; Export title early so that any link in it can be
+ ;; exported and seen in `org-ascii--unique-links'.
+ (title (org-ascii--build-title headline info width (not low-level)))
;; Blank lines between headline and its contents.
;; `org-ascii-headline-spacing', when set, overwrites
;; original buffer's spacing.
(pre-blanks
- (make-string
- (if org-ascii-headline-spacing (car org-ascii-headline-spacing)
- (org-element-property :pre-blank headline)) ?\n))
- ;; Even if HEADLINE has no section, there might be some
- ;; links in its title that we shouldn't forget to describe.
- (links
- (unless (or (eq (caar (org-element-contents headline)) 'section))
- (let ((title (org-element-property :title headline)))
- (when (consp title)
- (org-ascii--describe-links
- (org-ascii--unique-links title info) width info))))))
+ (make-string (or (car (plist-get info :ascii-headline-spacing))
+ (org-element-property :pre-blank headline)
+ 0)
+ ?\n))
+ (links (and (plist-get info :ascii-links-to-notes)
+ (org-ascii--describe-links
+ (org-ascii--unique-links headline info) width info)))
+ ;; Re-build contents, inserting section links at the right
+ ;; place. The cost is low since build results are cached.
+ (body
+ (if (not (org-string-nw-p links)) contents
+ (let* ((contents (org-element-contents headline))
+ (section (let ((first (car contents)))
+ (and (eq (org-element-type first) 'section)
+ first))))
+ (concat (and section
+ (concat (org-element-normalize-string
+ (org-export-data section info))
+ "\n\n"))
+ links
+ (mapconcat (lambda (e) (org-export-data e info))
+ (if section (cdr contents) contents)
+ ""))))))
;; Deep subtree: export it as a list item.
- (if low-level-rank
- (concat
- ;; Bullet.
- (let ((bullets (cdr (assq (plist-get info :ascii-charset)
- org-ascii-bullets))))
- (char-to-string
- (nth (mod (1- low-level-rank) (length bullets)) bullets)))
- " "
- ;; Title.
- (org-ascii--build-title headline info width) "\n"
- ;; Contents, indented by length of bullet.
- pre-blanks
- (org-ascii--indent-string
- (concat contents
- (when (org-string-nw-p links) (concat "\n\n" links)))
- 2))
+ (if low-level
+ (let* ((bullets (cdr (assq (plist-get info :ascii-charset)
+ (plist-get info :ascii-bullets))))
+ (bullet
+ (format "%c "
+ (nth (mod (1- low-level) (length bullets)) bullets))))
+ (concat bullet title "\n" pre-blanks
+ ;; Contents, indented by length of bullet.
+ (org-ascii--indent-string body (length bullet))))
;; Else: Standard headline.
- (concat
- (org-ascii--build-title headline info width 'underline)
- "\n" pre-blanks
- (concat (when (org-string-nw-p links) links) contents))))))
+ (concat title "\n" pre-blanks body)))))
;;;; Horizontal Rule
-(defun org-ascii-horizontal-rule (horizontal-rule contents info)
+(defun org-ascii-horizontal-rule (horizontal-rule _contents info)
"Transcode an HORIZONTAL-RULE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((text-width (org-ascii--current-text-width horizontal-rule info))
(spec-width
(org-export-read-attribute :attr_ascii horizontal-rule :width)))
- (org-ascii--justify-string
+ (org-ascii--justify-lines
(make-string (if (and spec-width (string-match "^[0-9]+$" spec-width))
(string-to-number spec-width)
text-width)
@@ -1202,23 +1364,23 @@ information."
;;;; Inline Src Block
-(defun org-ascii-inline-src-block (inline-src-block contents info)
+(defun org-ascii-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (format org-ascii-verbatim-format
+ (format (plist-get info :ascii-verbatim-format)
(org-element-property :value inline-src-block)))
;;;; Inlinetask
(defun org-ascii-format-inlinetask-default
- (todo type priority name tags contents width inlinetask info)
+ (_todo _type _priority _name _tags contents width inlinetask info)
"Format an inline task element for ASCII export.
See `org-ascii-format-inlinetask-function' for a description
of the parameters."
(let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))
- (width (or width org-ascii-inlinetask-width)))
+ (width (or width (plist-get info :ascii-inlinetask-width))))
(org-ascii--indent-string
(concat
;; Top line, with an additional blank line if not in UTF-8.
@@ -1236,9 +1398,9 @@ of the parameters."
;; Bottom line.
(make-string width (if utf8p ?━ ?_)))
;; Flush the inlinetask to the right.
- (- org-ascii-text-width org-ascii-global-margin
+ (- (plist-get info :ascii-text-width) (plist-get info :ascii-global-margin)
(if (not (org-export-get-parent-headline inlinetask)) 0
- org-ascii-inner-margin)
+ (plist-get info :ascii-inner-margin))
(org-ascii--current-text-width inlinetask info)))))
(defun org-ascii-inlinetask (inlinetask contents info)
@@ -1246,7 +1408,7 @@ of the parameters."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let ((width (org-ascii--current-text-width inlinetask info)))
- (funcall org-ascii-format-inlinetask-function
+ (funcall (plist-get info :ascii-format-inlinetask-function)
;; todo.
(and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property
@@ -1268,7 +1430,7 @@ holding contextual information."
;;;; Italic
-(defun org-ascii-italic (italic contents info)
+(defun org-ascii-italic (_italic contents _info)
"Transcode italic from Org to ASCII.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -1287,82 +1449,99 @@ contextual information."
(bullet
;; First parent of ITEM is always the plain-list. Get
;; `:type' property from it.
- (org-list-bullet-string
- (case list-type
- (descriptive
- (concat checkbox
- (org-export-data (org-element-property :tag item) info)
- ": "))
- (ordered
- ;; Return correct number for ITEM, paying attention to
- ;; counters.
- (let* ((struct (org-element-property :structure item))
- (bul (org-element-property :bullet item))
- (num (number-to-string
- (car (last (org-list-get-item-number
- (org-element-property :begin item)
- struct
- (org-list-prevs-alist struct)
- (org-list-parents-alist struct)))))))
- (replace-regexp-in-string "[0-9]+" num bul)))
- (t (let ((bul (org-element-property :bullet item)))
- ;; Change bullets into more visible form if UTF-8 is active.
- (if (not utf8p) bul
+ (pcase list-type
+ (`descriptive
+ (concat checkbox
+ (org-export-data (org-element-property :tag item)
+ info)))
+ (`ordered
+ ;; Return correct number for ITEM, paying attention to
+ ;; counters.
+ (let* ((struct (org-element-property :structure item))
+ (bul (org-list-bullet-string
+ (org-element-property :bullet item)))
+ (num (number-to-string
+ (car (last (org-list-get-item-number
+ (org-element-property :begin item)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct)))))))
+ (replace-regexp-in-string "[0-9]+" num bul)))
+ (_ (let ((bul (org-list-bullet-string
+ (org-element-property :bullet item))))
+ ;; Change bullets into more visible form if UTF-8 is active.
+ (if (not utf8p) bul
+ (replace-regexp-in-string
+ "-" "•"
(replace-regexp-in-string
- "-" "•"
- (replace-regexp-in-string
- "+" "⁃"
- (replace-regexp-in-string "*" "‣" bul))))))))))
+ "+" "⁃"
+ (replace-regexp-in-string "*" "‣" bul))))))))
+ (indentation (if (eq list-type 'descriptive) org-ascii-quote-margin
+ (string-width bullet))))
(concat
bullet
- (unless (eq list-type 'descriptive) checkbox)
+ checkbox
;; Contents: Pay attention to indentation. Note: check-boxes are
;; already taken care of at the paragraph level so they don't
;; interfere with indentation.
- (let ((contents (org-ascii--indent-string contents (string-width bullet))))
- (if (eq (org-element-type (car (org-element-contents item))) 'paragraph)
+ (let ((contents (org-ascii--indent-string contents indentation)))
+ ;; Determine if contents should follow the bullet or start
+ ;; a new line. Do the former when the first contributing
+ ;; element to contents is a paragraph. In descriptive lists
+ ;; however, contents always start a new line.
+ (if (and (not (eq list-type 'descriptive))
+ (org-string-nw-p contents)
+ (eq 'paragraph
+ (org-element-type
+ (cl-some (lambda (e)
+ (and (org-string-nw-p (org-export-data e info))
+ e))
+ (org-element-contents item)))))
(org-trim contents)
(concat "\n" contents))))))
;;;; Keyword
-(defun org-ascii-keyword (keyword contents info)
+(defun org-ascii-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
(cond
- ((string= key "ASCII") value)
+ ((string= key "ASCII") (org-ascii--justify-element value keyword info))
((string= key "TOC")
- (let ((value (downcase value)))
- (cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (org-ascii--build-toc
- info (and (wholenump depth) depth) keyword)))
- ((string= "tables" value)
- (org-ascii--list-tables keyword info))
- ((string= "listings" value)
- (org-ascii--list-listings keyword info))))))))
+ (org-ascii--justify-element
+ (let ((case-fold-search t))
+ (cond
+ ((string-match-p "\\<headlines\\>" value)
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (localp (string-match-p "\\<local\\>" value)))
+ (org-ascii--build-toc info depth keyword localp)))
+ ((string-match-p "\\<tables\\>" value)
+ (org-ascii--list-tables keyword info))
+ ((string-match-p "\\<listings\\>" value)
+ (org-ascii--list-listings keyword info))))
+ keyword info)))))
;;;; Latex Environment
-(defun org-ascii-latex-environment (latex-environment contents info)
+(defun org-ascii-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
(when (plist-get info :with-latex)
- (org-remove-indentation (org-element-property :value latex-environment))))
+ (org-ascii--justify-element
+ (org-remove-indentation (org-element-property :value latex-environment))
+ latex-environment info)))
;;;; Latex Fragment
-(defun org-ascii-latex-fragment (latex-fragment contents info)
+(defun org-ascii-latex-fragment (latex-fragment _contents info)
"Transcode a LATEX-FRAGMENT object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1372,7 +1551,7 @@ information."
;;;; Line Break
-(defun org-ascii-line-break (line-break contents info)
+(defun org-ascii-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual
information." hard-newline)
@@ -1385,9 +1564,9 @@ CONTENTS is nil. INFO is a plist holding contextual
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information."
- (let ((raw-link (org-element-property :raw-link link))
- (type (org-element-property :type link)))
+ (let ((type (org-element-property :type link)))
(cond
+ ((org-export-custom-protocol-maybe link desc 'ascii))
((string= type "coderef")
(let ((ref (org-element-property :path link)))
(format (org-export-get-coderef-format ref desc)
@@ -1395,23 +1574,51 @@ INFO is a plist holding contextual information."
;; Do not apply a special syntax on radio links. Though, use
;; transcoded target's contents as output.
((string= type "radio") desc)
- ;; Do not apply a special syntax on fuzzy links pointing to
- ;; targets.
- ((string= type "fuzzy")
- (let ((destination (org-export-resolve-fuzzy-link link info)))
- (if (org-string-nw-p desc) desc
- (when destination
- (let ((number
- (org-export-get-ordinal
- destination info nil 'org-ascii--has-caption-p)))
- (when number
- (if (atom number) (number-to-string number)
- (mapconcat 'number-to-string number "."))))))))
+ ((member type '("custom-id" "fuzzy" "id"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (pcase (org-element-type destination)
+ ((guard desc)
+ (if (plist-get info :ascii-links-to-notes)
+ (format "[%s]" desc)
+ (concat desc
+ (format " (%s)"
+ (org-ascii--describe-datum destination info)))))
+ ;; External file.
+ (`plain-text destination)
+ (`headline
+ (if (org-export-numbered-headline-p destination info)
+ (mapconcat #'number-to-string
+ (org-export-get-headline-number destination info)
+ ".")
+ (org-export-data (org-element-property :title destination) info)))
+ ;; Handle enumerable elements and targets within them.
+ ((and (let number (org-export-get-ordinal
+ destination info nil #'org-ascii--has-caption-p))
+ (guard number))
+ (if (atom number) (number-to-string number)
+ (mapconcat #'number-to-string number ".")))
+ ;; Don't know what to do. Signal it.
+ (_ "???"))))
(t
- (if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
- (concat
- (format "[%s]" desc)
- (unless org-ascii-links-to-notes (format " (%s)" raw-link))))))))
+ (let ((raw-link (org-element-property :raw-link link)))
+ (if (not (org-string-nw-p desc)) (format "[%s]" raw-link)
+ (concat (format "[%s]" desc)
+ (and (not (plist-get info :ascii-links-to-notes))
+ (format " (%s)" raw-link)))))))))
+
+
+;;;; Node Properties
+
+(defun org-ascii-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element from Org to ASCII.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
;;;; Paragraph
@@ -1420,16 +1627,17 @@ INFO is a plist holding contextual information."
"Transcode a PARAGRAPH element from Org to ASCII.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- (org-ascii--fill-string
- (if (not (wholenump org-ascii-indented-line-width)) contents
- (concat
- ;; Do not indent first paragraph in a section.
- (unless (and (not (org-export-get-previous-element paragraph info))
- (eq (org-element-type (org-export-get-parent paragraph))
- 'section))
- (make-string org-ascii-indented-line-width ?\s))
- (replace-regexp-in-string "\\`[ \t]+" "" contents)))
- (org-ascii--current-text-width paragraph info) info))
+ (org-ascii--justify-element
+ (let ((indented-line-width (plist-get info :ascii-indented-line-width)))
+ (if (not (wholenump indented-line-width)) contents
+ (concat
+ ;; Do not indent first paragraph in a section.
+ (unless (and (not (org-export-get-previous-element paragraph info))
+ (eq (org-element-type (org-export-get-parent paragraph))
+ 'section))
+ (make-string indented-line-width ?\s))
+ (replace-regexp-in-string "\\`[ \t]+" "" contents))))
+ paragraph info))
;;;; Plain List
@@ -1438,7 +1646,11 @@ the plist used as a communication channel."
"Transcode a PLAIN-LIST element from Org to ASCII.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
- contents)
+ (let ((margin (plist-get info :ascii-list-margin)))
+ (if (or (< margin 1)
+ (eq (org-element-type (org-export-get-parent plain-list)) 'item))
+ contents
+ (org-ascii--indent-string contents margin))))
;;;; Plain Text
@@ -1462,62 +1674,52 @@ INFO is a plist used as a communication channel."
;;;; Planning
-(defun org-ascii-planning (planning contents info)
+(defun org-ascii-planning (planning _contents info)
"Transcode a PLANNING element from Org to ASCII.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (mapconcat
- 'identity
- (delq nil
- (list (let ((closed (org-element-property :closed planning)))
- (when closed
- (concat org-closed-string " "
- (org-translate-time
- (org-element-property :raw-value closed)))))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline
- (concat org-deadline-string " "
- (org-translate-time
- (org-element-property :raw-value deadline)))))
- (let ((scheduled (org-element-property :scheduled planning)))
- (when scheduled
- (concat org-scheduled-string " "
- (org-translate-time
- (org-element-property :raw-value scheduled)))))))
- " "))
+ (org-ascii--justify-element
+ (mapconcat
+ #'identity
+ (delq nil
+ (list (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat org-closed-string " "
+ (org-timestamp-translate closed))))
+ (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-timestamp-translate deadline))))
+ (let ((scheduled (org-element-property :scheduled planning)))
+ (when scheduled
+ (concat org-scheduled-string " "
+ (org-timestamp-translate scheduled))))))
+ " ")
+ planning info))
+
+
+;;;; Property Drawer
+
+(defun org-ascii-property-drawer (property-drawer contents info)
+ "Transcode a PROPERTY-DRAWER element from Org to ASCII.
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (org-ascii--justify-element contents property-drawer info)))
;;;; Quote Block
-(defun org-ascii-quote-block (quote-block contents info)
+(defun org-ascii-quote-block (_quote-block contents info)
"Transcode a QUOTE-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (org-ascii--indent-string contents org-ascii-quote-margin))
-
-
-;;;; Quote Section
-
-(defun org-ascii-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to ASCII.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((width (org-ascii--current-text-width quote-section info))
- (value
- (org-export-data
- (org-remove-indentation (org-element-property :value quote-section))
- info)))
- (org-ascii--indent-string
- value
- (+ org-ascii-quote-margin
- ;; Don't apply inner margin if parent headline is low level.
- (let ((headline (org-export-get-parent-headline quote-section)))
- (if (org-export-low-level-p headline info) 0
- org-ascii-inner-margin))))))
+ (org-ascii--indent-string contents (plist-get info :ascii-quote-margin)))
;;;; Radio Target
-(defun org-ascii-radio-target (radio-target contents info)
+(defun org-ascii-radio-target (_radio-target contents _info)
"Transcode a RADIO-TARGET object from Org to ASCII.
CONTENTS is the contents of the target. INFO is a plist holding
contextual information."
@@ -1530,50 +1732,56 @@ contextual information."
"Transcode a SECTION element from Org to ASCII.
CONTENTS is the contents of the section. INFO is a plist holding
contextual information."
- (org-ascii--indent-string
- (concat
- contents
- (when org-ascii-links-to-notes
- ;; Add list of links at the end of SECTION.
- (let ((links (org-ascii--describe-links
- (org-ascii--unique-links section info)
- (org-ascii--current-text-width section info) info)))
- ;; Separate list of links and section contents.
- (when (org-string-nw-p links) (concat "\n\n" links)))))
- ;; Do not apply inner margin if parent headline is low level.
- (let ((headline (org-export-get-parent-headline section)))
- (if (or (not headline) (org-export-low-level-p headline info)) 0
- org-ascii-inner-margin))))
+ (let ((links
+ (and (plist-get info :ascii-links-to-notes)
+ ;; Take care of links in first section of the document.
+ (not (org-element-lineage section '(headline)))
+ (org-ascii--describe-links
+ (org-ascii--unique-links section info)
+ (org-ascii--current-text-width section info)
+ info))))
+ (org-ascii--indent-string
+ (if (not (org-string-nw-p links)) contents
+ (concat (org-element-normalize-string contents) "\n\n" links))
+ ;; Do not apply inner margin if parent headline is low level.
+ (let ((headline (org-export-get-parent-headline section)))
+ (if (or (not headline) (org-export-low-level-p headline info)) 0
+ (plist-get info :ascii-inner-margin))))))
;;;; Special Block
-(defun org-ascii-special-block (special-block contents info)
+(defun org-ascii-special-block (_special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
+ ;; "JUSTIFYLEFT" and "JUSTIFYRIGHT" have already been taken care of
+ ;; at a lower level. There is no other special block type to
+ ;; handle.
contents)
;;;; Src Block
-(defun org-ascii-src-block (src-block contents info)
+(defun org-ascii-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to ASCII.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let ((caption (org-ascii--build-caption src-block info))
+ (caption-above-p (plist-get info :ascii-caption-above))
(code (org-export-format-code-default src-block info)))
(if (equal code "") ""
- (concat
- (when (and caption org-ascii-caption-above) (concat caption "\n"))
- (org-ascii--box-string code info)
- (when (and caption (not org-ascii-caption-above))
- (concat "\n" caption))))))
+ (org-ascii--justify-element
+ (concat
+ (and caption caption-above-p (concat caption "\n"))
+ (org-ascii--box-string code info)
+ (and caption (not caption-above-p) (concat "\n" caption)))
+ src-block info))))
;;;; Statistics Cookie
-(defun org-ascii-statistics-cookie (statistics-cookie contents info)
+(defun org-ascii-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
@@ -1581,7 +1789,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Subscript
-(defun org-ascii-subscript (subscript contents info)
+(defun org-ascii-subscript (subscript contents _info)
"Transcode a SUBSCRIPT object from Org to ASCII.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1592,7 +1800,7 @@ contextual information."
;;;; Superscript
-(defun org-ascii-superscript (superscript contents info)
+(defun org-ascii-superscript (superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to ASCII.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1603,7 +1811,7 @@ contextual information."
;;;; Strike-through
-(defun org-ascii-strike-through (strike-through contents info)
+(defun org-ascii-strike-through (_strike-through contents _info)
"Transcode STRIKE-THROUGH from Org to ASCII.
CONTENTS is text with strike-through markup. INFO is a plist
holding contextual information."
@@ -1616,26 +1824,29 @@ holding contextual information."
"Transcode a TABLE element from Org to ASCII.
CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
- (let ((caption (org-ascii--build-caption table info)))
- (concat
- ;; Possibly add a caption string above.
- (when (and caption org-ascii-caption-above) (concat caption "\n"))
- ;; Insert table. Note: "table.el" tables are left unmodified.
- (cond ((eq (org-element-property :type table) 'org) contents)
- ((and org-ascii-table-use-ascii-art
- (eq (plist-get info :ascii-charset) 'utf-8)
- (require 'ascii-art-to-unicode nil t))
- (with-temp-buffer
- (insert (org-remove-indentation
- (org-element-property :value table)))
- (goto-char (point-min))
- (aa2u)
- (goto-char (point-max))
- (skip-chars-backward " \r\t\n")
- (buffer-substring (point-min) (point))))
- (t (org-remove-indentation (org-element-property :value table))))
- ;; Possible add a caption string below.
- (and (not org-ascii-caption-above) caption))))
+ (let ((caption (org-ascii--build-caption table info))
+ (caption-above-p (plist-get info :ascii-caption-above)))
+ (org-ascii--justify-element
+ (concat
+ ;; Possibly add a caption string above.
+ (and caption caption-above-p (concat caption "\n"))
+ ;; Insert table. Note: "table.el" tables are left unmodified.
+ (cond ((eq (org-element-property :type table) 'org) contents)
+ ((and (plist-get info :ascii-table-use-ascii-art)
+ (eq (plist-get info :ascii-charset) 'utf-8)
+ (require 'ascii-art-to-unicode nil t))
+ (with-temp-buffer
+ (insert (org-remove-indentation
+ (org-element-property :value table)))
+ (goto-char (point-min))
+ (aa2u)
+ (goto-char (point-max))
+ (skip-chars-backward " \r\t\n")
+ (buffer-substring (point-min) (point))))
+ (t (org-remove-indentation (org-element-property :value table))))
+ ;; Possible add a caption string below.
+ (and (not caption-above-p) caption))
+ table info)))
;;;; Table Cell
@@ -1661,12 +1872,13 @@ are ignored."
(plist-put info :ascii-table-cell-width-cache
(make-hash-table :test 'equal)))
:ascii-table-cell-width-cache)))
- (key (cons table col)))
+ (key (cons table col))
+ (widenp (plist-get info :ascii-table-widen-columns)))
(or (gethash key cache)
(puthash
key
(let ((cookie-width (org-export-table-cell-width table-cell info)))
- (or (and (not org-ascii-table-widen-columns) cookie-width)
+ (or (and (not widenp) cookie-width)
(let ((contents-width
(let ((max-width 0))
(org-element-map table 'table-row
@@ -1681,8 +1893,7 @@ are ignored."
info)
max-width)))
(cond ((not cookie-width) contents-width)
- (org-ascii-table-widen-columns
- (max cookie-width contents-width))
+ (widenp (max cookie-width contents-width))
(t cookie-width)))))
cache))))
@@ -1696,14 +1907,14 @@ a communication channel."
;; each cell in the column.
(let ((width (org-ascii--table-cell-width table-cell info)))
;; When contents are too large, truncate them.
- (unless (or org-ascii-table-widen-columns
+ (unless (or (plist-get info :ascii-table-widen-columns)
(<= (string-width (or contents "")) width))
(setq contents (concat (substring contents 0 (- width 2)) "=>")))
;; Align contents correctly within the cell.
(let* ((indent-tabs-mode nil)
(data
(when contents
- (org-ascii--justify-string
+ (org-ascii--justify-lines
contents width
(org-export-table-cell-alignment table-cell info)))))
(setq contents
@@ -1770,7 +1981,7 @@ a communication channel."
;;;; Timestamp
-(defun org-ascii-timestamp (timestamp contents info)
+(defun org-ascii-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-ascii-plain-text (org-timestamp-translate timestamp) info))
@@ -1778,7 +1989,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Underline
-(defun org-ascii-underline (underline contents info)
+(defun org-ascii-underline (_underline contents _info)
"Transcode UNDERLINE from Org to ASCII.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -1787,10 +1998,10 @@ holding contextual information."
;;;; Verbatim
-(defun org-ascii-verbatim (verbatim contents info)
+(defun org-ascii-verbatim (verbatim _contents info)
"Return a VERBATIM object from Org to ASCII.
CONTENTS is nil. INFO is a plist holding contextual information."
- (format org-ascii-verbatim-format
+ (format (plist-get info :ascii-verbatim-format)
(org-element-property :value verbatim)))
@@ -1800,48 +2011,48 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a VERSE-BLOCK element from Org to ASCII.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
- (let ((verse-width (org-ascii--current-text-width verse-block info)))
- (org-ascii--indent-string
- (org-ascii--justify-string contents verse-width 'left)
- org-ascii-quote-margin)))
+ (org-ascii--indent-string
+ (org-ascii--justify-element contents verse-block info)
+ (plist-get info :ascii-quote-margin)))
;;; Filters
-(defun org-ascii-filter-headline-blank-lines (headline back-end info)
+(defun org-ascii-filter-headline-blank-lines (headline _backend info)
"Filter controlling number of blank lines after a headline.
-HEADLINE is a string representing a transcoded headline.
-BACK-END is symbol specifying back-end used for export. INFO is
-plist containing the communication channel.
+HEADLINE is a string representing a transcoded headline. BACKEND
+is symbol specifying back-end used for export. INFO is plist
+containing the communication channel.
This function only applies to `ascii' back-end. See
`org-ascii-headline-spacing' for information."
- (if (not org-ascii-headline-spacing) headline
- (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n)))
- (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))
+ (let ((headline-spacing (plist-get info :ascii-headline-spacing)))
+ (if (not headline-spacing) headline
+ (let ((blanks (make-string (1+ (cdr headline-spacing)) ?\n)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))))
-(defun org-ascii-filter-paragraph-spacing (tree back-end info)
+(defun org-ascii-filter-paragraph-spacing (tree _backend info)
"Filter controlling number of blank lines between paragraphs.
-TREE is the parse tree. BACK-END is the symbol specifying
+TREE is the parse tree. BACKEND is the symbol specifying
back-end used for export. INFO is a plist used as
a communication channel.
See `org-ascii-paragraph-spacing' for information."
- (when (wholenump org-ascii-paragraph-spacing)
- (org-element-map tree 'paragraph
- (lambda (p)
- (when (eq (org-element-type (org-export-get-next-element p info))
- 'paragraph)
- (org-element-put-property
- p :post-blank org-ascii-paragraph-spacing)))))
+ (let ((paragraph-spacing (plist-get info :ascii-paragraph-spacing)))
+ (when (wholenump paragraph-spacing)
+ (org-element-map tree 'paragraph
+ (lambda (p)
+ (when (eq (org-element-type (org-export-get-next-element p info))
+ 'paragraph)
+ (org-element-put-property p :post-blank paragraph-spacing))))))
tree)
-(defun org-ascii-filter-comment-spacing (tree backend info)
+(defun org-ascii-filter-comment-spacing (tree _backend info)
"Filter removing blank lines between comments.
-TREE is the parse tree. BACK-END is the symbol specifying
+TREE is the parse tree. BACKEND is the symbol specifying
back-end used for export. INFO is a plist used as
a communication channel."
(org-element-map tree '(comment comment-block)
diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el
index a8d48b67189..5750d6dab03 100644
--- a/lisp/org/ox-beamer.el
+++ b/lisp/org/ox-beamer.el
@@ -1,4 +1,4 @@
-;;; ox-beamer.el --- Beamer Back-End for Org Export Engine
+;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -29,7 +29,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox-latex)
;; Install a default set-up for Beamer export.
@@ -105,7 +105,9 @@ key Selection key for `org-beamer-select-environment'
open The opening template for the environment, with the following escapes
%a the action/overlay specification
%A the default action/overlay specification
- %o the options argument of the template
+ %R the raw BEAMER_act value
+ %o the options argument, with square brackets
+ %O the raw BEAMER_opt value
%h the headline text
%r the raw headline text (i.e. without any processing)
%H if there is headline text, that raw text in {} braces
@@ -133,6 +135,15 @@ You might want to put e.g. \"allowframebreaks=0.9\" here."
:type '(string :tag "Outline frame options"))
+(defcustom org-beamer-subtitle-format "\\subtitle{%s}"
+ "Format string used for transcoded subtitle.
+The format string should have at most one \"%s\"-expression,
+which is replaced with the subtitle."
+ :group 'org-export-beamer
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(string :tag "Format string"))
+
;;; Internal Variables
@@ -191,19 +202,14 @@ TYPE is a symbol among the following:
`defaction' Return ARGUMENT within both square and angular brackets.
`option' Return ARGUMENT within square brackets."
(if (not (string-match "\\S-" argument)) ""
- (case type
- (action (if (string-match "\\`<.*>\\'" argument) argument
- (format "<%s>" argument)))
- (defaction (cond
- ((string-match "\\`\\[<.*>\\]\\'" argument) argument)
- ((string-match "\\`<.*>\\'" argument)
- (format "[%s]" argument))
- ((string-match "\\`\\[\\(.*\\)\\]\\'" argument)
- (format "[<%s>]" (match-string 1 argument)))
- (t (format "[<%s>]" argument))))
- (option (if (string-match "\\`\\[.*\\]\\'" argument) argument
- (format "[%s]" argument)))
- (otherwise argument))))
+ (cl-case type
+ (action (format "<%s>" (org-unbracket-string "<" ">" argument)))
+ (defaction
+ (format "[<%s>]"
+ (org-unbracket-string "<" ">" (org-unbracket-string "[" "]" argument))))
+ (option (format "[%s]" (org-unbracket-string "[" "]" argument)))
+ (otherwise (error "Invalid `type' argument to `org-beamer--normalize-argument': %s"
+ type)))))
(defun org-beamer--element-has-overlay-p (element)
"Non-nil when ELEMENT has an overlay specified.
@@ -213,14 +219,14 @@ Return overlay specification, as a string, or nil."
(let ((first-object (car (org-element-contents element))))
(when (eq (org-element-type first-object) 'export-snippet)
(let ((value (org-element-property :value first-object)))
- (and (string-match "\\`<.*>\\'" value) value)))))
+ (and (string-prefix-p "<" value) (string-suffix-p ">" value)
+ value)))))
;;; Define Back-End
(org-export-define-derived-backend 'beamer 'latex
- :export-block "BEAMER"
:menu-entry
'(?l 1
((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex)
@@ -231,15 +237,20 @@ Return overlay specification, as a string, or nil."
(if a (org-beamer-export-to-pdf t s v b)
(org-open-file (org-beamer-export-to-pdf nil s v b)))))))
:options-alist
- '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme)
+ '((:headline-levels nil "H" org-beamer-frame-level)
+ (:latex-class "LATEX_CLASS" nil "beamer" t)
+ (:beamer-subtitle-format nil nil org-beamer-subtitle-format)
+ (:beamer-column-view-format "COLUMNS" nil org-beamer-column-view-format)
+ (:beamer-theme "BEAMER_THEME" nil org-beamer-theme)
(:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t)
(:beamer-font-theme "BEAMER_FONT_THEME" nil nil t)
(:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t)
(:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t)
- (:beamer-header-extra "BEAMER_HEADER" nil nil newline)
- ;; Modify existing properties.
- (:headline-levels nil "H" org-beamer-frame-level)
- (:latex-class "LATEX_CLASS" nil "beamer" t))
+ (:beamer-header "BEAMER_HEADER" nil nil newline)
+ (:beamer-environments-extra nil nil org-beamer-environments-extra)
+ (:beamer-frame-default-options nil nil org-beamer-frame-default-options)
+ (:beamer-outline-frame-options nil nil org-beamer-outline-frame-options)
+ (:beamer-outline-frame-title nil nil org-beamer-outline-frame-title))
:translate-alist '((bold . org-beamer-bold)
(export-block . org-beamer-export-block)
(export-snippet . org-beamer-export-snippet)
@@ -249,7 +260,6 @@ Return overlay specification, as a string, or nil."
(link . org-beamer-link)
(plain-list . org-beamer-plain-list)
(radio-target . org-beamer-radio-target)
- (target . org-beamer-target)
(template . org-beamer-template)))
@@ -258,7 +268,7 @@ Return overlay specification, as a string, or nil."
;;;; Bold
-(defun org-beamer-bold (bold contents info)
+(defun org-beamer-bold (bold contents _info)
"Transcode BLOCK object into Beamer code.
CONTENTS is the text being bold. INFO is a plist used as
a communication channel."
@@ -269,7 +279,7 @@ a communication channel."
;;;; Export Block
-(defun org-beamer-export-block (export-block contents info)
+(defun org-beamer-export-block (export-block _contents _info)
"Transcode an EXPORT-BLOCK element into Beamer code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -279,7 +289,7 @@ channel."
;;;; Export Snippet
-(defun org-beamer-export-snippet (export-snippet contents info)
+(defun org-beamer-export-snippet (export-snippet _contents info)
"Transcode an EXPORT-SNIPPET object into Beamer code.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -315,16 +325,21 @@ channel."
INFO is a plist used as a communication channel.
The value is either the label specified in \"BEAMER_opt\"
-property, or a fallback value built from headline's number. This
-function assumes HEADLINE will be treated as a frame."
- (let ((opt (org-element-property :BEAMER_OPT headline)))
- (if (and (org-string-nw-p opt)
- (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt))
- (match-string 1 opt)
- (format "sec-%s"
- (mapconcat 'number-to-string
- (org-export-get-headline-number headline info)
- "-")))))
+property, the custom ID, if there is one and
+`:latex-prefer-user-labels' property has a non nil value, or
+a unique internal label. This function assumes HEADLINE will be
+treated as a frame."
+ (cond
+ ((let ((opt (org-element-property :BEAMER_OPT headline)))
+ (and (stringp opt)
+ (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)
+ (let ((label (match-string 1 opt)))
+ (if (string-match-p "\\`{.*}\\'" label)
+ (substring label 1 -1)
+ label)))))
+ ((and (plist-get info :latex-prefer-user-labels)
+ (org-element-property :CUSTOM_ID headline)))
+ (t (format "sec:%s" (org-export-get-reference headline info)))))
(defun org-beamer--frame-level (headline info)
"Return frame level in subtree containing HEADLINE.
@@ -333,12 +348,10 @@ INFO is a plist used as a communication channel."
;; 1. Look for "frame" environment in parents, starting from the
;; farthest.
(catch 'exit
- (mapc (lambda (parent)
- (let ((env (org-element-property :BEAMER_ENV parent)))
- (when (and env (member-ignore-case env '("frame" "fullframe")))
- (throw 'exit (org-export-get-relative-level parent info)))))
- (nreverse (org-export-get-genealogy headline)))
- nil)
+ (dolist (parent (nreverse (org-element-lineage headline)))
+ (let ((env (org-element-property :BEAMER_ENV parent)))
+ (when (and env (member-ignore-case env '("frame" "fullframe")))
+ (throw 'exit (org-export-get-relative-level parent info))))))
;; 2. Look for "frame" environment in HEADLINE.
(let ((env (org-element-property :BEAMER_ENV headline)))
(and env (member-ignore-case env '("frame" "fullframe"))
@@ -410,24 +423,35 @@ used as a communication channel."
;; Options, if any.
(let* ((beamer-opt (org-element-property :BEAMER_OPT headline))
(options
- ;; Collect options from default value and headline's
- ;; properties. Also add a label for links.
- (append
- (org-split-string org-beamer-frame-default-options ",")
- (and beamer-opt
- (org-split-string
- ;; Remove square brackets if user provided
- ;; them.
- (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
- (match-string 1 beamer-opt))
- ","))
- ;; Provide an automatic label for the frame
- ;; unless the user specified one.
- (unless (and beamer-opt
- (string-match "\\(^\\|,\\)label=" beamer-opt))
- (list
- (format "label=%s"
- (org-beamer--get-label headline info)))))))
+ ;; Collect nonempty options from default value and
+ ;; headline's properties. Also add a label for
+ ;; links.
+ (cl-remove-if-not 'org-string-nw-p
+ (append
+ (org-split-string
+ (plist-get info :beamer-frame-default-options) ",")
+ (and beamer-opt
+ (org-split-string
+ ;; Remove square brackets if user provided
+ ;; them.
+ (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt)
+ (match-string 1 beamer-opt))
+ ","))
+ ;; Provide an automatic label for the frame
+ ;; unless the user specified one. Also refrain
+ ;; from labeling `allowframebreaks' frames; this
+ ;; is not allowed by beamer.
+ (unless (and beamer-opt
+ (or (string-match "\\(^\\|,\\)label=" beamer-opt)
+ (string-match "allowframebreaks" beamer-opt)))
+ (list
+ (let ((label (org-beamer--get-label headline info)))
+ ;; Labels containing colons need to be
+ ;; wrapped within braces.
+ (format (if (string-match-p ":" label)
+ "label={%s}"
+ "label=%s")
+ label))))))))
;; Change options list into a string.
(org-beamer--normalize-argument
(mapconcat
@@ -475,14 +499,15 @@ used as a communication channel."
(env-format
(cond ((member environment '("column" "columns")) nil)
((assoc environment
- (append org-beamer-environments-extra
+ (append (plist-get info :beamer-environments-extra)
org-beamer-environments-default)))
(t (user-error "Wrong block type at a headline named \"%s\""
raw-title))))
(title (org-export-data (org-element-property :title headline) info))
- (options (let ((options (org-element-property :BEAMER_OPT headline)))
- (if (not options) ""
- (org-beamer--normalize-argument options 'option))))
+ (raw-options (org-element-property :BEAMER_OPT headline))
+ (options (if raw-options
+ (org-beamer--normalize-argument raw-options 'option)
+ ""))
;; Start a "columns" environment when explicitly requested or
;; when there is no previous headline or the previous
;; headline do not have a BEAMER_column property.
@@ -521,7 +546,7 @@ used as a communication channel."
;; One can specify placement for column only when
;; HEADLINE stands for a column on its own.
(if (equal environment "column") options "")
- (format "%s\\textwidth" column-width)))
+ (format "%s\\columnwidth" column-width)))
;; Block's opening string.
(when (nth 2 env-format)
(concat
@@ -534,15 +559,19 @@ used as a communication channel."
;; overlay specification and the default one is nil.
(let ((action (org-element-property :BEAMER_ACT headline)))
(cond
- ((not action) (list (cons "a" "") (cons "A" "")))
- ((string-match "\\`\\[.*\\]\\'" action)
+ ((not action) (list (cons "a" "") (cons "A" "") (cons "R" "")))
+ ((and (string-prefix-p "[" action)
+ (string-suffix-p "]" action))
(list
(cons "A" (org-beamer--normalize-argument action 'defaction))
- (cons "a" "")))
+ (cons "a" "")
+ (cons "R" action)))
(t
(list (cons "a" (org-beamer--normalize-argument action 'action))
- (cons "A" "")))))
+ (cons "A" "")
+ (cons "R" action)))))
(list (cons "o" options)
+ (cons "O" (or raw-options ""))
(cons "h" title)
(cons "r" raw-title)
(cons "H" (if (equal raw-title "") ""
@@ -578,28 +607,27 @@ as a communication channel."
(when overlay
(org-beamer--normalize-argument
overlay
- (if (string-match "^\\[.*\\]$" overlay) 'defaction
+ (if (string-match "\\`\\[.*\\]\\'" overlay) 'defaction
'action))))
;; Options.
(let ((options (org-element-property :BEAMER_OPT headline)))
(when options
(org-beamer--normalize-argument options 'option)))
;; Resolve reference provided by "BEAMER_ref"
- ;; property. This is done by building a minimal fake
- ;; link and calling the appropriate resolve function,
- ;; depending on the reference syntax.
- (let* ((type
- (progn
- (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref)
- (cond
- ((or (not (match-string 1 ref))
- (equal (match-string 1 ref) "*")) 'fuzzy)
- ((equal (match-string 1 ref) "id:") 'id)
- (t 'custom-id))))
- (link (list 'link (list :path (match-string 2 ref))))
- (target (if (eq type 'fuzzy)
- (org-export-resolve-fuzzy-link link info)
- (org-export-resolve-id-link link info))))
+ ;; property. This is done by building a minimal
+ ;; fake link and calling the appropriate resolve
+ ;; function, depending on the reference syntax.
+ (let ((target
+ (if (string-match "\\`\\(id:\\|#\\)" ref)
+ (org-export-resolve-id-link
+ `(link (:path ,(substring ref (match-end 0))))
+ info)
+ (org-export-resolve-fuzzy-link
+ `(link (:path
+ ;; Look for headlines only.
+ ,(if (eq (string-to-char ref) ?*) ref
+ (concat "*" ref))))
+ info))))
;; Now use user-defined label provided in TARGET
;; headline, or fallback to standard one.
(format "{%s}" (org-beamer--get-label target info)))))))
@@ -640,15 +668,27 @@ as a communication channel."
"Transcode an ITEM element into Beamer code.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let ((action (let ((first-element (car (org-element-contents item))))
- (and (eq (org-element-type first-element) 'paragraph)
- (org-beamer--element-has-overlay-p first-element))))
- (output (org-export-with-backend 'latex item contents info)))
- (if (or (not action) (not (string-match "\\\\item" output))) output
- ;; If the item starts with a paragraph and that paragraph starts
- ;; with an export snippet specifying an overlay, insert it after
- ;; \item command.
- (replace-match (concat "\\\\item" action) nil nil output))))
+ (org-export-with-backend
+ ;; Delegate item export to `latex'. However, we use `beamer'
+ ;; transcoders for objects in the description tag.
+ (org-export-create-backend
+ :parent 'beamer
+ :transcoders
+ (list
+ (cons
+ 'item
+ (lambda (item _c _i)
+ (let ((action
+ (let ((first (car (org-element-contents item))))
+ (and (eq (org-element-type first) 'paragraph)
+ (org-beamer--element-has-overlay-p first))))
+ (output (org-latex-item item contents info)))
+ (if (not (and action (string-match "\\\\item" output))) output
+ ;; If the item starts with a paragraph and that paragraph
+ ;; starts with an export snippet specifying an overlay,
+ ;; append it to the \item command.
+ (replace-match (concat "\\\\item" action) nil nil output)))))))
+ item contents info))
;;;; Keyword
@@ -681,46 +721,16 @@ 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."
- (let ((type (org-element-property :type link))
- (path (org-element-property :path link)))
- ;; Use \hyperlink command for all internal links.
- (cond
- ((equal type "radio")
- (let ((destination (org-export-resolve-radio-link link info)))
- (if (not destination) contents
- (format "\\hyperlink%s{%s}{%s}"
- (or (org-beamer--element-has-overlay-p link) "")
- (org-export-solidify-link-text
- (org-element-property :value destination))
- contents))))
- ((and (member type '("custom-id" "fuzzy" "id"))
- (let ((destination (if (string= type "fuzzy")
- (org-export-resolve-fuzzy-link link info)
- (org-export-resolve-id-link link info))))
- (case (org-element-type destination)
- (headline
- (let ((label
- (format "sec-%s"
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number
- destination info)
- "-"))))
- (if (and (plist-get info :section-numbers) (not contents))
- (format "\\ref{%s}" label)
- (format "\\hyperlink%s{%s}{%s}"
- (or (org-beamer--element-has-overlay-p link) "")
- label
- contents))))
- (target
- (let ((path (org-export-solidify-link-text path)))
- (if (not contents) (format "\\ref{%s}" path)
- (format "\\hyperlink%s{%s}{%s}"
- (or (org-beamer--element-has-overlay-p link) "")
- path
- contents))))))))
- ;; Otherwise, use `latex' back-end.
- (t (org-export-with-backend 'latex link contents info)))))
+ (or (org-export-custom-protocol-maybe link contents 'beamer)
+ ;; 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)))
+ (if (string-match "\\`\\\\hyperref\\[\\(.*?\\)\\]" latex-link)
+ (replace-match
+ (format "\\\\hyperlink%s{\\1}"
+ (or (org-beamer--element-has-overlay-p link) ""))
+ nil nil latex-link)
+ latex-link))))
;;;; Plain List
@@ -755,7 +765,8 @@ contextual information."
'option)
;; Eventually insert contents and close environment.
contents
- latex-type))))
+ latex-type)
+ info)))
;;;; Radio Target
@@ -766,21 +777,10 @@ TEXT is the text of the target. INFO is a plist holding
contextual information."
(format "\\hypertarget%s{%s}{%s}"
(or (org-beamer--element-has-overlay-p radio-target) "")
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
+ (org-export-get-reference radio-target info)
text))
-;;;; Target
-
-(defun org-beamer-target (target contents info)
- "Transcode a TARGET object into Beamer code.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- (format "\\hypertarget{%s}{}"
- (org-export-solidify-link-text (org-element-property :value target))))
-
-
;;;; Template
;;
;; Template used is similar to the one used in `latex' back-end,
@@ -790,37 +790,17 @@ information."
"Return complete document string after Beamer conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (let ((title (org-export-data (plist-get info :title) info)))
+ (let ((title (org-export-data (plist-get info :title) info))
+ (subtitle (org-export-data (plist-get info :subtitle) info)))
(concat
- ;; 1. Time-stamp.
+ ;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
- ;; 2. Document class and packages.
- (let* ((class (plist-get info :latex-class))
- (class-options (plist-get info :latex-class-options))
- (header (nth 1 (assoc class org-latex-classes)))
- (document-class-string
- (and (stringp header)
- (if (not class-options) header
- (replace-regexp-in-string
- "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
- class-options header t nil 1)))))
- (if (not document-class-string)
- (user-error "Unknown LaTeX class `%s'" class)
- (org-latex-guess-babel-language
- (org-latex-guess-inputenc
- (org-element-normalize-string
- (org-splice-latex-header
- document-class-string
- org-latex-default-packages-alist
- org-latex-packages-alist nil
- (concat (org-element-normalize-string
- (plist-get info :latex-header))
- (org-element-normalize-string
- (plist-get info :latex-header-extra))
- (plist-get info :beamer-header-extra)))))
- info)))
- ;; 3. Insert themes.
+ ;; LaTeX compiler
+ (org-latex--insert-compiler info)
+ ;; Document class and packages.
+ (org-latex-make-preamble info)
+ ;; Insert themes.
(let ((format-theme
(function
(lambda (prop command)
@@ -840,11 +820,11 @@ holding export options."
(:beamer-inner-theme "\\useinnertheme")
(:beamer-outer-theme "\\useoutertheme"))
""))
- ;; 4. Possibly limit depth for headline numbering.
+ ;; Possibly limit depth for headline numbering.
(let ((sec-num (plist-get info :section-numbers)))
(when (integerp sec-num)
(format "\\setcounter{secnumdepth}{%d}\n" sec-num)))
- ;; 5. Author.
+ ;; Author.
(let ((author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -852,52 +832,52 @@ holding export options."
(org-export-data (plist-get info :email) info))))
(cond ((and author email (not (string= "" email)))
(format "\\author{%s\\thanks{%s}}\n" author email))
- (author (format "\\author{%s}\n" author))
- (t "\\author{}\n")))
- ;; 6. Date.
+ ((or author email) (format "\\author{%s}\n" (or author email)))))
+ ;; Date.
(let ((date (and (plist-get info :with-date) (org-export-get-date info))))
(format "\\date{%s}\n" (org-export-data date info)))
- ;; 7. Title
+ ;; Title
(format "\\title{%s}\n" title)
- ;; 8. Hyperref options.
- (when (plist-get info :latex-hyperref-p)
- (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
- (or (plist-get info :keywords) "")
- (or (plist-get info :description) "")
- (if (not (plist-get info :with-creator)) ""
- (plist-get info :creator))))
- ;; 9. Document start.
+ (when (org-string-nw-p subtitle)
+ (concat (format (plist-get info :beamer-subtitle-format) subtitle) "\n"))
+ ;; Beamer-header
+ (let ((beamer-header (plist-get info :beamer-header)))
+ (when beamer-header
+ (format "%s\n" (plist-get info :beamer-header))))
+ ;; 9. Hyperref options.
+ (let ((template (plist-get info :latex-hyperref-template)))
+ (and (stringp template)
+ (format-spec template (org-latex--format-spec info))))
+ ;; Document start.
"\\begin{document}\n\n"
- ;; 10. Title command.
+ ;; Title command.
(org-element-normalize-string
- (cond ((string= "" title) nil)
+ (cond ((not (plist-get info :with-title)) nil)
+ ((string= "" title) nil)
((not (stringp org-latex-title-command)) nil)
((string-match "\\(?:[^%]\\|^\\)%s"
org-latex-title-command)
(format org-latex-title-command title))
(t org-latex-title-command)))
- ;; 11. Table of contents.
+ ;; Table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth
(concat
(format "\\begin{frame}%s{%s}\n"
(org-beamer--normalize-argument
- org-beamer-outline-frame-options 'option)
- org-beamer-outline-frame-title)
+ (plist-get info :beamer-outline-frame-options) 'option)
+ (plist-get info :beamer-outline-frame-title))
(when (wholenump depth)
(format "\\setcounter{tocdepth}{%d}\n" depth))
"\\tableofcontents\n"
"\\end{frame}\n\n")))
- ;; 12. Document's body.
+ ;; Document's body.
contents
- ;; 13. Creator.
- (let ((creator-info (plist-get info :with-creator)))
- (cond
- ((not creator-info) "")
- ((eq creator-info 'comment)
- (format "%% %s\n" (plist-get info :creator)))
- (t (concat (plist-get info :creator) "\n"))))
- ;; 14. Document end.
+ ;; Creator.
+ (if (plist-get info :with-creator)
+ (concat (plist-get info :creator) "\n")
+ "")
+ ;; Document end.
"\\end{document}")))
@@ -933,7 +913,7 @@ value."
(save-excursion
(org-back-to-heading t)
;; Filter out Beamer-related tags and install environment tag.
- (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x))
+ (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x))
(org-get-tags)))
(env-tag (and (org-string-nw-p value) (concat "B_" value))))
(org-set-tags-to (if env-tag (cons env-tag tags) tags))
@@ -955,9 +935,9 @@ value."
org-beamer-environments-default)))
((and (equal property "BEAMER_col")
(not (org-entry-get nil (concat property "_ALL") 'inherit)))
- ;; If no allowed values for BEAMER_col have been defined,
- ;; supply some
- (org-split-string org-beamer-column-widths " "))))
+ ;; If no allowed values for BEAMER_col have been defined, supply
+ ;; some.
+ (split-string org-beamer-column-widths " "))))
(add-hook 'org-property-allowed-value-functions
'org-beamer-allowed-property-values)
@@ -1085,7 +1065,7 @@ aid, but the tag does not have any semantic meaning."
(let* ((envs (append org-beamer-environments-special
org-beamer-environments-extra
org-beamer-environments-default))
- (org-tag-alist
+ (org-current-tag-alist
(append '((:startgroup))
(mapcar (lambda (e) (cons (concat "B_" (car e))
(string-to-char (nth 1 e))))
@@ -1121,30 +1101,6 @@ aid, but the tag does not have any semantic meaning."
(t (org-entry-delete nil "BEAMER_env"))))))
;;;###autoload
-(defun org-beamer-insert-options-template (&optional kind)
- "Insert a settings template, to make sure users do this right."
- (interactive (progn
- (message "Current [s]ubtree or [g]lobal?")
- (if (eq (read-char-exclusive) ?g) (list 'global)
- (list 'subtree))))
- (if (eq kind 'subtree)
- (progn
- (org-back-to-heading t)
- (org-reveal)
- (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer")
- (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]")
- (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf")
- (when org-beamer-column-view-format
- (org-entry-put nil "COLUMNS" org-beamer-column-view-format))
- (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths))
- (insert "#+LaTeX_CLASS: beamer\n")
- (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n")
- (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n"))
- (when org-beamer-column-view-format
- (insert "#+COLUMNS: " org-beamer-column-view-format "\n"))
- (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n")))
-
-;;;###autoload
(defun org-beamer-publish-to-latex (plist filename pub-dir)
"Publish an Org file to a Beamer presentation (LaTeX).
@@ -1168,9 +1124,13 @@ Return output file name."
;; working directory and then moved to publishing directory.
(org-publish-attachment
plist
- (org-latex-compile
- (org-publish-org-to
- 'beamer filename ".tex" plist (file-name-directory filename)))
+ ;; Default directory could be anywhere when this function is
+ ;; called. We ensure it is set to source file directory during
+ ;; compilation so as to not break links to external documents.
+ (let ((default-directory (file-name-directory filename)))
+ (org-latex-compile
+ (org-publish-org-to
+ 'beamer filename ".tex" plist (file-name-directory filename))))
pub-dir))
diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el
index 86ca3a6bb28..bf08de10af7 100644
--- a/lisp/org/ox-html.el
+++ b/lisp/org/ox-html.el
@@ -1,4 +1,4 @@
-;;; ox-html.el --- HTML Back-End for Org Export Engine
+;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,20 +30,24 @@
;;; Dependencies
+(require 'cl-lib)
+(require 'format-spec)
(require 'ox)
(require 'ox-publish)
-(require 'format-spec)
-(eval-when-compile (require 'cl) (require 'table nil 'noerror))
+(require 'table)
;;; Function Declarations
(declare-function org-id-find-id-file "org-id" (id))
(declare-function htmlize-region "ext:htmlize" (beg end))
-(declare-function org-pop-to-buffer-same-window
- "org-compat" (&optional buffer-or-name norecord label))
(declare-function mm-url-decode-entities "mm-url" ())
+(defvar htmlize-css-name-prefix)
+(defvar htmlize-output-type)
+(defvar htmlize-output-type)
+(defvar htmlize-css-name-prefix)
+
;;; Define Back-End
(org-export-define-backend 'html
@@ -72,13 +76,13 @@
(latex-fragment . org-html-latex-fragment)
(line-break . org-html-line-break)
(link . org-html-link)
+ (node-property . org-html-node-property)
(paragraph . org-html-paragraph)
(plain-list . org-html-plain-list)
(plain-text . org-html-plain-text)
(planning . org-html-planning)
(property-drawer . org-html-property-drawer)
(quote-block . org-html-quote-block)
- (quote-section . org-html-quote-section)
(radio-target . org-html-radio-target)
(section . org-html-section)
(special-block . org-html-special-block)
@@ -96,8 +100,8 @@
(underline . org-html-underline)
(verbatim . org-html-verbatim)
(verse-block . org-html-verse-block))
- :export-block "HTML"
:filters-alist '((:filter-options . org-html-infojs-install-script)
+ (:filter-parse-tree . org-html-image-link-filter)
(:filter-final-output . org-html-final-function))
:menu-entry
'(?h "Export to HTML"
@@ -108,10 +112,10 @@
(if a (org-html-export-to-html t s v b)
(org-open-file (org-html-export-to-html nil s v b)))))))
:options-alist
- '((:html-extension nil nil org-html-extension)
- (:html-link-org-as-html nil nil org-html-link-org-files-as-html)
- (:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
+ '((:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
(:html-container "HTML_CONTAINER" nil org-html-container-element)
+ (:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
(:html-html5-fancy nil "html5-fancy" org-html-html5-fancy)
(:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url)
(:html-link-home "HTML_LINK_HOME" nil org-html-link-home)
@@ -121,12 +125,56 @@
(:html-preamble nil "html-preamble" org-html-preamble)
(:html-head "HTML_HEAD" nil org-html-head newline)
(:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline)
- (:html-head-include-default-style nil "html-style" org-html-head-include-default-style)
+ (:subtitle "SUBTITLE" nil nil parse)
+ (:html-head-include-default-style
+ nil "html-style" org-html-head-include-default-style)
(:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts)
+ (:html-allow-name-attribute-in-anchors
+ nil nil org-html-allow-name-attribute-in-anchors)
+ (:html-divs nil nil org-html-divs)
+ (:html-checkbox-type nil nil org-html-checkbox-type)
+ (:html-extension nil nil org-html-extension)
+ (:html-footnote-format nil nil org-html-footnote-format)
+ (:html-footnote-separator nil nil org-html-footnote-separator)
+ (:html-footnotes-section nil nil org-html-footnotes-section)
+ (:html-format-drawer-function nil nil org-html-format-drawer-function)
+ (:html-format-headline-function nil nil org-html-format-headline-function)
+ (:html-format-inlinetask-function
+ nil nil org-html-format-inlinetask-function)
+ (:html-home/up-format nil nil org-html-home/up-format)
+ (:html-indent nil nil org-html-indent)
+ (:html-infojs-options nil nil org-html-infojs-options)
+ (:html-infojs-template nil nil org-html-infojs-template)
+ (:html-inline-image-rules nil nil org-html-inline-image-rules)
+ (:html-link-org-files-as-html nil nil org-html-link-org-files-as-html)
+ (:html-mathjax-options nil nil org-html-mathjax-options)
+ (:html-mathjax-template nil nil org-html-mathjax-template)
+ (: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-table-align-individual-fields
+ nil nil org-html-table-align-individual-fields)
+ (:html-table-caption-above nil nil org-html-table-caption-above)
+ (:html-table-data-tags nil nil org-html-table-data-tags)
+ (:html-table-header-tags nil nil org-html-table-header-tags)
+ (:html-table-use-header-tags-for-first-column
+ nil nil org-html-table-use-header-tags-for-first-column)
+ (:html-tag-class-prefix nil nil org-html-tag-class-prefix)
+ (:html-text-markup-alist nil nil org-html-text-markup-alist)
+ (:html-todo-kwd-class-prefix nil nil org-html-todo-kwd-class-prefix)
+ (:html-toplevel-hlevel nil nil org-html-toplevel-hlevel)
+ (:html-use-infojs nil nil org-html-use-infojs)
+ (:html-validation-link nil nil org-html-validation-link)
+ (:html-viewport nil nil org-html-viewport)
+ (:html-inline-images nil nil org-html-inline-images)
(:html-table-attributes nil nil org-html-table-default-attributes)
- (:html-table-row-tags nil nil org-html-table-row-tags)
+ (:html-table-row-open-tag nil nil org-html-table-row-open-tag)
+ (:html-table-row-close-tag nil nil org-html-table-row-close-tag)
(:html-xml-declaration nil nil org-html-xml-declaration)
- (:html-inline-images nil nil org-html-inline-images)
+ (:html-klipsify-src nil nil org-html-klipsify-src)
+ (:html-klipse-css nil nil org-html-klipse-css)
+ (:html-klipse-js nil nil org-html-klipse-js)
+ (:html-klipse-selection-script nil nil org-html-klipse-selection-script)
(:infojs-opt "INFOJS_OPT" nil nil)
;; Redefine regular options.
(:creator "CREATOR" nil org-html-creator-string)
@@ -186,7 +234,7 @@ property on the headline itself.")
@licstart The following is the entire license notice for the
JavaScript code in this tag.
-Copyright (C) 2012-2013 Free Software Foundation, Inc.
+Copyright (C) 2012-2017 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
@@ -232,16 +280,22 @@ for the JavaScript code in this tag.
(defconst org-html-style-default
"<style type=\"text/css\">
<!--/*--><![CDATA[/*><!--*/
- .title { text-align: center; }
+ .title { text-align: center;
+ margin-bottom: .2em; }
+ .subtitle { text-align: center;
+ font-size: medium;
+ font-weight: bold;
+ margin-top:0; }
.todo { font-family: monospace; color: red; }
- .done { color: green; }
+ .done { font-family: monospace; color: green; }
+ .priority { font-family: monospace; color: orange; }
.tag { background-color: #eee; font-family: monospace;
padding: 2px; font-size: 80%; font-weight: normal; }
.timestamp { color: #bebebe; }
.timestamp-kwd { color: #5f9ea0; }
- .right { margin-left: auto; margin-right: 0px; text-align: right; }
- .left { margin-left: 0px; margin-right: auto; text-align: left; }
- .center { margin-left: auto; margin-right: auto; text-align: center; }
+ .org-right { margin-left: auto; margin-right: 0px; text-align: right; }
+ .org-left { margin-left: 0px; margin-right: auto; text-align: left; }
+ .org-center { margin-left: auto; margin-right: auto; text-align: center; }
.underline { text-decoration: underline; }
#postamble p, #preamble p { font-size: 90%; margin: .2em; }
p.verse { margin-left: 3%; }
@@ -268,27 +322,111 @@ for the JavaScript code in this tag.
border: 1px solid black;
}
pre.src:hover:before { display: inline;}
- pre.src-sh:before { content: 'sh'; }
- pre.src-bash:before { content: 'sh'; }
+ /* Languages per Org manual */
+ pre.src-asymptote:before { content: 'Asymptote'; }
+ pre.src-awk:before { content: 'Awk'; }
+ pre.src-C:before { content: 'C'; }
+ /* pre.src-C++ doesn't work in CSS */
+ pre.src-clojure:before { content: 'Clojure'; }
+ pre.src-css:before { content: 'CSS'; }
+ pre.src-D:before { content: 'D'; }
+ pre.src-ditaa:before { content: 'ditaa'; }
+ pre.src-dot:before { content: 'Graphviz'; }
+ pre.src-calc:before { content: 'Emacs Calc'; }
pre.src-emacs-lisp:before { content: 'Emacs Lisp'; }
- pre.src-R:before { content: 'R'; }
- pre.src-perl:before { content: 'Perl'; }
- pre.src-java:before { content: 'Java'; }
- pre.src-sql:before { content: 'SQL'; }
+ pre.src-fortran:before { content: 'Fortran'; }
+ pre.src-gnuplot:before { content: 'gnuplot'; }
+ pre.src-haskell:before { content: 'Haskell'; }
+ pre.src-hledger:before { content: 'hledger'; }
+ pre.src-java:before { content: 'Java'; }
+ pre.src-js:before { content: 'Javascript'; }
+ pre.src-latex:before { content: 'LaTeX'; }
+ pre.src-ledger:before { content: 'Ledger'; }
+ pre.src-lisp:before { content: 'Lisp'; }
+ pre.src-lilypond:before { content: 'Lilypond'; }
+ pre.src-lua:before { content: 'Lua'; }
+ pre.src-matlab:before { content: 'MATLAB'; }
+ pre.src-mscgen:before { content: 'Mscgen'; }
+ pre.src-ocaml:before { content: 'Objective Caml'; }
+ pre.src-octave:before { content: 'Octave'; }
+ pre.src-org:before { content: 'Org mode'; }
+ pre.src-oz:before { content: 'OZ'; }
+ pre.src-plantuml:before { content: 'Plantuml'; }
+ pre.src-processing:before { content: 'Processing.js'; }
+ pre.src-python:before { content: 'Python'; }
+ pre.src-R:before { content: 'R'; }
+ pre.src-ruby:before { content: 'Ruby'; }
+ pre.src-sass:before { content: 'Sass'; }
+ pre.src-scheme:before { content: 'Scheme'; }
+ pre.src-screen:before { content: 'Gnu Screen'; }
+ pre.src-sed:before { content: 'Sed'; }
+ pre.src-sh:before { content: 'shell'; }
+ pre.src-sql:before { content: 'SQL'; }
+ pre.src-sqlite:before { content: 'SQLite'; }
+ /* additional languages in org.el's org-babel-load-languages alist */
+ pre.src-forth:before { content: 'Forth'; }
+ pre.src-io:before { content: 'IO'; }
+ pre.src-J:before { content: 'J'; }
+ pre.src-makefile:before { content: 'Makefile'; }
+ pre.src-maxima:before { content: 'Maxima'; }
+ pre.src-perl:before { content: 'Perl'; }
+ pre.src-picolisp:before { content: 'Pico Lisp'; }
+ pre.src-scala:before { content: 'Scala'; }
+ pre.src-shell:before { content: 'Shell Script'; }
+ pre.src-ebnf2ps:before { content: 'ebfn2ps'; }
+ /* additional language identifiers per \"defun org-babel-execute\"
+ in ob-*.el */
+ pre.src-cpp:before { content: 'C++'; }
+ pre.src-abc:before { content: 'ABC'; }
+ pre.src-coq:before { content: 'Coq'; }
+ pre.src-groovy:before { content: 'Groovy'; }
+ /* additional language identifiers from org-babel-shell-names in
+ ob-shell.el: ob-shell is the only babel language using a lambda to put
+ the execution function name together. */
+ pre.src-bash:before { content: 'bash'; }
+ pre.src-csh:before { content: 'csh'; }
+ pre.src-ash:before { content: 'ash'; }
+ pre.src-dash:before { content: 'dash'; }
+ pre.src-ksh:before { content: 'ksh'; }
+ pre.src-mksh:before { content: 'mksh'; }
+ pre.src-posh:before { content: 'posh'; }
+ /* Additional Emacs modes also supported by the LaTeX listings package */
+ pre.src-ada:before { content: 'Ada'; }
+ pre.src-asm:before { content: 'Assembler'; }
+ pre.src-caml:before { content: 'Caml'; }
+ pre.src-delphi:before { content: 'Delphi'; }
+ pre.src-html:before { content: 'HTML'; }
+ pre.src-idl:before { content: 'IDL'; }
+ pre.src-mercury:before { content: 'Mercury'; }
+ pre.src-metapost:before { content: 'MetaPost'; }
+ pre.src-modula-2:before { content: 'Modula-2'; }
+ pre.src-pascal:before { content: 'Pascal'; }
+ pre.src-ps:before { content: 'PostScript'; }
+ pre.src-prolog:before { content: 'Prolog'; }
+ pre.src-simula:before { content: 'Simula'; }
+ pre.src-tcl:before { content: 'tcl'; }
+ pre.src-tex:before { content: 'TeX'; }
+ pre.src-plain-tex:before { content: 'Plain TeX'; }
+ pre.src-verilog:before { content: 'Verilog'; }
+ pre.src-vhdl:before { content: 'VHDL'; }
+ pre.src-xml:before { content: 'XML'; }
+ pre.src-nxml:before { content: 'XML'; }
+ /* add a generic configuration mode; LaTeX export needs an additional
+ (add-to-list 'org-latex-listings-langs '(conf \" \")) in .emacs */
+ pre.src-conf:before { content: 'Configuration File'; }
table { border-collapse:collapse; }
caption.t-above { caption-side: top; }
caption.t-bottom { caption-side: bottom; }
td, th { vertical-align:top; }
- th.right { text-align: center; }
- th.left { text-align: center; }
- th.center { text-align: center; }
- td.right { text-align: right; }
- td.left { text-align: left; }
- td.center { text-align: center; }
+ th.org-right { text-align: center; }
+ th.org-left { text-align: center; }
+ th.org-center { text-align: center; }
+ td.org-right { text-align: right; }
+ td.org-left { text-align: left; }
+ td.org-center { text-align: center; }
dt { font-weight: bold; }
- .footpara:nth-child(2) { display: inline; }
- .footpara { display: block; }
+ .footpara { display: inline; }
.footdef { margin-bottom: 1em; }
.figure { padding: 1em; }
.figure p { text-align: center; }
@@ -308,6 +446,7 @@ for the JavaScript code in this tag.
{ font-size: 10px; font-weight: bold; white-space: nowrap; }
.org-info-js_search-highlight
{ background-color: #ffff00; color: #000000; font-weight: bold; }
+ .org-svg { width: 90%; }
/*]]>*/-->
</style>"
"The default style specification for exported HTML files.
@@ -385,7 +524,7 @@ means to use the maximum value consistent with other options."
* @licstart The following is the entire license notice for the
* JavaScript code in %SCRIPT_PATH.
*
- * Copyright (C) 2012-2013 Free Software Foundation, Inc.
+ * Copyright (C) 2012-2017 Free Software Foundation, Inc.
*
*
* The JavaScript code in this tag is free software: you can
@@ -414,7 +553,7 @@ means to use the maximum value consistent with other options."
@licstart The following is the entire license notice for the
JavaScript code in this tag.
-Copyright (C) 2012-2013 Free Software Foundation, Inc.
+Copyright (C) 2012-2017 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
@@ -447,23 +586,24 @@ Option settings will replace the %MANAGER-OPTIONS cookie."
:package-version '(Org . "8.0")
:type 'string)
-(defun org-html-infojs-install-script (exp-plist backend)
+(defun org-html-infojs-install-script (exp-plist _backend)
"Install script in export options when appropriate.
EXP-PLIST is a plist containing export options. BACKEND is the
export back-end currently used."
(unless (or (memq 'body-only (plist-get exp-plist :export-options))
- (not org-html-use-infojs)
- (and (eq org-html-use-infojs 'when-configured)
- (or (not (plist-get exp-plist :infojs-opt))
- (string= "" (plist-get exp-plist :infojs-opt))
- (string-match "\\<view:nil\\>"
- (plist-get exp-plist :infojs-opt)))))
- (let* ((template org-html-infojs-template)
+ (not (plist-get exp-plist :html-use-infojs))
+ (and (eq (plist-get exp-plist :html-use-infojs) 'when-configured)
+ (let ((opt (plist-get exp-plist :infojs-opt)))
+ (or (not opt)
+ (string= "" opt)
+ (string-match "\\<view:nil\\>" opt)))))
+ (let* ((template (plist-get exp-plist :html-infojs-template))
(ptoc (plist-get exp-plist :with-toc))
(hlevels (plist-get exp-plist :headline-levels))
(sdepth hlevels)
(tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels))
(options (plist-get exp-plist :infojs-opt))
+ (infojs-opt (plist-get exp-plist :html-infojs-options))
(table org-html-infojs-opts-table)
style)
(dolist (entry table)
@@ -472,7 +612,7 @@ export back-end currently used."
;; Compute default values for script option OPT from
;; `org-html-infojs-options' variable.
(default
- (let ((default (cdr (assq opt org-html-infojs-options))))
+ (let ((default (cdr (assq opt infojs-opt))))
(if (and (symbolp default) (not (memq default '(t nil))))
(plist-get exp-plist default)
default)))
@@ -483,21 +623,21 @@ export back-end currently used."
options))
(match-string 1 options)
default)))
- (case opt
- (path (setq template
- (replace-regexp-in-string
- "%SCRIPT_PATH" val template t t)))
- (sdepth (when (integerp (read val))
- (setq sdepth (min (read val) sdepth))))
- (tdepth (when (integerp (read val))
- (setq tdepth (min (read val) tdepth))))
- (otherwise (setq val
- (cond
- ((or (eq val t) (equal val "t")) "1")
- ((or (eq val nil) (equal val "nil")) "0")
- ((stringp val) val)
- (t (format "%s" val))))
- (push (cons var val) style)))))
+ (pcase opt
+ (`path (setq template
+ (replace-regexp-in-string
+ "%SCRIPT_PATH" val template t t)))
+ (`sdepth (when (integerp (read val))
+ (setq sdepth (min (read val) sdepth))))
+ (`tdepth (when (integerp (read val))
+ (setq tdepth (min (read val) tdepth))))
+ (_ (setq val
+ (cond
+ ((or (eq val t) (equal val "t")) "1")
+ ((or (eq val nil) (equal val "nil")) "0")
+ ((stringp val) val)
+ (t (format "%s" val))))
+ (push (cons var val) style)))))
;; Now we set the depth of the *generated* TOC to SDEPTH,
;; because the toc will actually determine the splitting. How
;; much of the toc will actually be displayed is governed by the
@@ -509,9 +649,9 @@ export back-end currently used."
(push (cons "TOC_DEPTH" tdepth) style)
;; Build style string.
(setq style (mapconcat
- (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
- (car x)
- (cdr x)))
+ (lambda (x)
+ (format "org_html_manager.set(\"%s\", \"%s\");"
+ (car x) (cdr x)))
style "\n"))
(when (and style (> (length style) 0))
(and (string-match "%MANAGER_OPTIONS" template)
@@ -561,17 +701,9 @@ Warning: non-nil may break indentation of source code blocks."
:package-version '(Org . "8.0")
:type 'boolean)
-(defcustom org-html-use-unicode-chars nil
- "Non-nil means to use unicode characters instead of HTML entities."
- :group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
-
;;;; Drawers
-(defcustom org-html-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-html-format-drawer-function (lambda (_name contents) contents)
"Function called to format a drawer in HTML code.
The function must accept two parameters:
@@ -628,28 +760,30 @@ document title."
:group 'org-export-html
:type 'integer)
-(defcustom org-html-format-headline-function 'ignore
+(defcustom org-html-format-headline-function
+ 'org-html-format-headline-default-function
"Function to format headline text.
-This function will be called with 5 arguments:
+This function will be called with six arguments:
TODO the todo keyword (string or nil).
TODO-TYPE the type of todo (symbol: `todo', `done', nil)
PRIORITY the priority of the headline (integer or nil)
TEXT the main headline text (string).
TAGS the tags (string or nil).
+INFO the export options (plist).
The function result will be used in the section format string."
:group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type 'function)
;;;; HTML-specific
-(defcustom org-html-allow-name-attribute-in-anchors t
+(defcustom org-html-allow-name-attribute-in-anchors nil
"When nil, do not set \"name\" attribute in anchors.
-By default, anchors are formatted with both \"id\" and \"name\"
-attributes, when appropriate."
+By default, when appropriate, anchors are formatted with \"id\"
+but without \"name\" attribute."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
@@ -657,21 +791,23 @@ attributes, when appropriate."
;;;; Inlinetasks
-(defcustom org-html-format-inlinetask-function 'ignore
+(defcustom org-html-format-inlinetask-function
+ 'org-html-format-inlinetask-default-function
"Function called to format an inlinetask in HTML code.
-The function must accept six parameters:
+The function must accept seven parameters:
TODO the todo keyword, as a string
TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
PRIORITY the inlinetask priority, as a string
NAME the inlinetask name, as a string.
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
+ INFO the export options, as a plist
The function should return the string to be exported."
:group 'org-export-html
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type 'function)
;;;; LaTeX
@@ -685,24 +821,20 @@ fragments.
This option can also be set with the +OPTIONS line,
e.g. \"tex:mathjax\". Allowed values are:
-nil Ignore math snippets.
-`verbatim' Keep everything in verbatim
-`dvipng' Process the LaTeX fragments to images. This will also
- include processing of non-math environments.
-`imagemagick' Convert the LaTeX fragments to pdf files and use
- imagemagick to convert pdf files to png files.
-`mathjax' Do MathJax preprocessing and arrange for MathJax.js to
- be loaded.
-t Synonym for `mathjax'."
+ nil Ignore math snippets.
+ `verbatim' Keep everything in verbatim
+ `mathjax', t Do MathJax preprocessing and arrange for MathJax.js to
+ be loaded.
+ SYMBOL Any symbol defined in `org-preview-latex-process-alist',
+ e.g., `dvipng'."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
:type '(choice
(const :tag "Do not process math in any way" nil)
- (const :tag "Use dvipng to make images" dvipng)
- (const :tag "Use imagemagick to make images" imagemagick)
+ (const :tag "Leave math verbatim" verbatim)
(const :tag "Use MathJax to display math" mathjax)
- (const :tag "Leave math verbatim" verbatim)))
+ (symbol :tag "Convert to image to display math" :value dvipng)))
;;;; Links :: Generic
@@ -710,11 +842,11 @@ t Synonym for `mathjax'."
"Non-nil means make file links to `file.org' point to `file.html'.
When `org-mode' is exporting an `org-mode' file to HTML, links to
non-html files are directly put into a href tag in HTML.
-However, links to other Org-mode files (recognized by the
-extension `.org') should become links to the corresponding html
+However, links to other Org files (recognized by the extension
+\".org\") should become links to the corresponding HTML
file, assuming that the linked `org-mode' file will also be
converted to HTML.
-When nil, the links still point to the plain `.org' file."
+When nil, the links still point to the plain \".org\" file."
:group 'org-export-html
:type 'boolean)
@@ -745,22 +877,20 @@ link's path."
;;;; Plain Text
-(defcustom org-html-protect-char-alist
+(defvar org-html-protect-char-alist
'(("&" . "&amp;")
("<" . "&lt;")
(">" . "&gt;"))
- "Alist of characters to be converted by `org-html-protect'."
- :group 'org-export-html
- :type '(repeat (cons (string :tag "Character")
- (string :tag "HTML equivalent"))))
+ "Alist of characters to be converted by `org-html-encode-plain-text'.")
;;;; Src Block
(defcustom org-html-htmlize-output-type 'inline-css
"Output type to be used by htmlize when formatting code snippets.
-Choices are `css', to export the CSS selectors only, or `inline-css', to
-export the CSS attribute values inline in the HTML. We use as default
-`inline-css', in order to make the resulting HTML self-containing.
+Choices are `css' to export the CSS selectors only,`inline-css'
+to export the CSS attribute values inline in the HTML or `nil' to
+export plain text. We use as default `inline-css', in order to
+make the resulting HTML self-containing.
However, this will fail when using Emacs in batch mode for export, because
then no rich font definitions are in place. It will also not be good if
@@ -771,9 +901,9 @@ a style file to define the look of these classes.
To get a start for your css file, start Emacs session and make sure that
all the faces you are interested in are defined, for example by loading files
in all modes you want. Then, use the command
-\\[org-html-htmlize-generate-css] to extract class definitions."
+`\\[org-html-htmlize-generate-css]' to extract class definitions."
:group 'org-export-html
- :type '(choice (const css) (const inline-css)))
+ :type '(choice (const css) (const inline-css) (const nil)))
(defcustom org-html-htmlize-font-prefix "org-"
"The prefix for CSS class names for htmlize font specifications."
@@ -796,7 +926,7 @@ When exporting to HTML5, these values will be disregarded."
:value-type (string :tag "Value")))
(defcustom org-html-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
- "The opening tag for table header fields.
+ "The opening and ending tags for table header fields.
This is customizable so that alignment options can be specified.
The first %s will be filled with the scope of the field, either row or col.
The second %s will be replaced by a style entry to align the field.
@@ -806,7 +936,7 @@ See also the variable `org-html-table-align-individual-fields'."
:type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
(defcustom org-html-table-data-tags '("<td%s>" . "</td>")
- "The opening tag for table data fields.
+ "The opening and ending tags for table data fields.
This is customizable so that alignment options can be specified.
The first %s will be filled with the scope of the field, either row or col.
The second %s will be replaced by a style entry to align the field.
@@ -814,43 +944,50 @@ See also the variable `org-html-table-align-individual-fields'."
:group 'org-export-html
:type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
-(defcustom org-html-table-row-tags '("<tr>" . "</tr>")
- "The opening and ending tags for table rows.
+(defcustom org-html-table-row-open-tag "<tr>"
+ "The opening tag for table rows.
This is customizable so that alignment options can be specified.
-Instead of strings, these can be Lisp forms that will be
+Instead of strings, these can be a Lisp function that will be
evaluated for each row in order to construct the table row tags.
-During evaluation, these variables will be dynamically bound so that
-you can reuse them:
+The function will be called with these arguments:
- `row-number': row number (0 is the first row)
- `rowgroup-number': group number of current row
- `start-rowgroup-p': non-nil means the row starts a group
- `end-rowgroup-p': non-nil means the row ends a group
- `top-row-p': non-nil means this is the top row
- `bottom-row-p': non-nil means this is the bottom row
+ `number': row number (0 is the first row)
+ `group-number': group number of current row
+ `start-group?': non-nil means the row starts a group
+ `end-group?': non-nil means the row ends a group
+ `top?': non-nil means this is the top row
+ `bottom?': non-nil means this is the bottom row
For example:
-\(setq org-html-table-row-tags
- (cons \\='(cond (top-row-p \"<tr class=\\\"tr-top\\\">\")
- (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\")
- (t (if (= (mod row-number 2) 1)
- \"<tr class=\\\"tr-odd\\\">\"
- \"<tr class=\\\"tr-even\\\">\")))
- \"</tr>\"))
+ (setq org-html-table-row-open-tag
+ (lambda (number group-number start-group? end-group-p top? bottom?)
+ (cond (top? \"<tr class=\\\"tr-top\\\">\")
+ (bottom? \"<tr class=\\\"tr-bottom\\\">\")
+ (t (if (= (mod number 2) 1)
+ \"<tr class=\\\"tr-odd\\\">\"
+ \"<tr class=\\\"tr-even\\\">\")))))
will use the \"tr-top\" and \"tr-bottom\" classes for the top row
and the bottom row, and otherwise alternate between \"tr-odd\" and
\"tr-even\" for odd and even rows."
:group 'org-export-html
- :type '(cons
- (choice :tag "Opening tag"
- (string :tag "Specify")
- (sexp))
- (choice :tag "Closing tag"
- (string :tag "Specify")
- (sexp))))
+ :type '(choice :tag "Opening tag"
+ (string :tag "Specify")
+ (function)))
+
+(defcustom org-html-table-row-close-tag "</tr>"
+ "The closing tag for table rows.
+This is customizable so that alignment options can be specified.
+Instead of strings, this can be a Lisp function that will be
+evaluated for each row in order to construct the table row tags.
+
+See documentation of `org-html-table-row-open-tag'."
+ :group 'org-export-html
+ :type '(choice :tag "Closing tag"
+ (string :tag "Specify")
+ (function)))
(defcustom org-html-table-align-individual-fields t
"Non-nil means attach style attributes for alignment to each table field.
@@ -921,7 +1058,10 @@ publishing, with :html-doctype."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
- :type 'string)
+ :type (append
+ '(choice)
+ (mapcar (lambda (x) `(const ,(car x))) org-html-doctype-alist)
+ '((string :tag "Custom doctype" ))))
(defcustom org-html-html5-fancy nil
"Non-nil means using new HTML5 elements.
@@ -954,7 +1094,7 @@ org-info.js for your website."
(content "div" "content")
(postamble "div" "postamble"))
"Alist of the three section elements for HTML export.
-The car of each entry is one of 'preamble, 'content or 'postamble.
+The car of each entry is one of `preamble', `content' or `postamble'.
The cdrs of each entry are the ELEMENT_TYPE and ID for each
section of the exported document.
@@ -973,6 +1113,41 @@ org-info.js for your website."
(list :tag "Postamble" (const :format "" postamble)
(string :tag " id") (string :tag "element"))))
+(defconst org-html-checkbox-types
+ '((unicode .
+ ((on . "&#x2611;") (off . "&#x2610;") (trans . "&#x2610;")))
+ (ascii .
+ ((on . "<code>[X]</code>")
+ (off . "<code>[&#xa0;]</code>")
+ (trans . "<code>[-]</code>")))
+ (html .
+ ((on . "<input type='checkbox' checked='checked' />")
+ (off . "<input type='checkbox' />")
+ (trans . "<input type='checkbox' />"))))
+ "Alist of checkbox types.
+The cdr of each entry is an alist list three checkbox types for
+HTML export: `on', `off' and `trans'.
+
+The choices are:
+ `unicode' Unicode characters (HTML entities)
+ `ascii' ASCII characters
+ `html' HTML checkboxes
+
+Note that only the ascii characters implement tri-state
+checkboxes. The other two use the `off' checkbox for `trans'.")
+
+(defcustom org-html-checkbox-type 'ascii
+ "The type of checkboxes to use for HTML export.
+See `org-html-checkbox-types' for for the values used for each
+option."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type '(choice
+ (const :tag "ASCII characters" ascii)
+ (const :tag "Unicode characters" unicode)
+ (const :tag "HTML checkboxes" html)))
+
(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M"
"Format used for timestamps in preamble, postamble and metadata.
See `format-time-string' for more information on its components."
@@ -984,82 +1159,107 @@ See `format-time-string' for more information on its components."
;;;; Template :: Mathjax
(defcustom org-html-mathjax-options
- '((path "http://orgmode.org/mathjax/MathJax.js")
+ '((path "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS_HTML" )
(scale "100")
(align "center")
- (indent "2em")
- (mathml nil))
+ (font "TeX")
+ (linebreaks "false")
+ (autonumber "AMS")
+ (indent "0em")
+ (multlinewidth "85%")
+ (tagindent ".8em")
+ (tagside "right"))
"Options for MathJax setup.
-path The path where to find MathJax
-scale Scaling for the HTML-CSS backend, usually between 100 and 133
-align How to align display math: left, center, or right
-indent If align is not center, how far from the left/right side?
-mathml Should a MathML player be used if available?
- This is faster and reduces bandwidth use, but currently
- sometimes has lower spacing quality. Therefore, the default is
- nil. When browsers get better, this switch can be flipped.
+Alist of the following elements. All values are strings.
+
+path The path to MathJax.
+scale Scaling with HTML-CSS, MathML and SVG output engines.
+align How to align display math: left, center, or right.
+font The font to use with HTML-CSS and SVG output. As of MathJax 2.5
+ the following values are understood: \"TeX\", \"STIX-Web\",
+ \"Asana-Math\", \"Neo-Euler\", \"Gyre-Pagella\",
+ \"Gyre-Termes\", and \"Latin-Modern\".
+linebreaks Let MathJax perform automatic linebreaks. Valid values
+ are \"true\" and \"false\".
+indent If align is not center, how far from the left/right side?
+ Valid values are \"left\" and \"right\"
+multlinewidth The width of the multline environment.
+autonumber How to number equations. Valid values are \"None\",
+ \"all\" and \"AMS Math\".
+tagindent The amount tags are indented.
+tagside Which side to show tags/labels on. Valid values are
+ \"left\" and \"right\"
You can also customize this for each buffer, using something like
-#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
+#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler
+
+For further information about MathJax options, see the MathJax documentation:
+
+ http://docs.mathjax.org/"
:group 'org-export-html
+ :package-version '(Org . "8.3")
:type '(list :greedy t
- (list :tag "path (the path from where to load MathJax.js)"
- (const :format " " path) (string))
- (list :tag "scale (scaling for the displayed math)"
- (const :format " " scale) (string))
- (list :tag "align (alignment of displayed equations)"
- (const :format " " align) (string))
- (list :tag "indent (indentation with left or right alignment)"
- (const :format " " indent) (string))
- (list :tag "mathml (should MathML display be used is possible)"
- (const :format " " mathml) (boolean))))
+ (list :tag "path (the path from where to load MathJax.js)"
+ (const :format " " path) (string))
+ (list :tag "scale (scaling for the displayed math)"
+ (const :format " " scale) (string))
+ (list :tag "align (alignment of displayed equations)"
+ (const :format " " align) (string))
+ (list :tag "font (used to display math)"
+ (const :format " " font)
+ (choice (const "TeX")
+ (const "STIX-Web")
+ (const "Asana-Math")
+ (const "Neo-Euler")
+ (const "Gyre-Pagella")
+ (const "Gyre-Termes")
+ (const "Latin-Modern")))
+ (list :tag "linebreaks (automatic line-breaking)"
+ (const :format " " linebreaks)
+ (choice (const "true")
+ (const "false")))
+ (list :tag "autonumber (when should equations be numbered)"
+ (const :format " " autonumber)
+ (choice (const "AMS")
+ (const "None")
+ (const "All")))
+ (list :tag "indent (indentation with left or right alignment)"
+ (const :format " " indent) (string))
+ (list :tag "multlinewidth (width to use for the multline environment)"
+ (const :format " " multlinewidth) (string))
+ (list :tag "tagindent (the indentation of tags from left or right)"
+ (const :format " " tagindent) (string))
+ (list :tag "tagside (location of tags)"
+ (const :format " " tagside)
+ (choice (const "left")
+ (const "right")))))
(defcustom org-html-mathjax-template
- "<script type=\"text/javascript\" src=\"%PATH\"></script>
-<script type=\"text/javascript\">
-<!--/*--><![CDATA[/*><!--*/
+ "<script type=\"text/x-mathjax-config\">
MathJax.Hub.Config({
- // Only one of the two following lines, depending on user settings
- // First allows browser-native MathML display, second forces HTML/CSS
- :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
- :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
- extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
- \"TeX/noUndefined.js\"],
- tex2jax: {
- inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
- displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
- skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
- ignoreClass: \"tex2jax_ignore\",
- processEscapes: false,
- processEnvironments: true,
- preview: \"TeX\"
- },
- showProcessingMessages: true,
displayAlign: \"%ALIGN\",
displayIndent: \"%INDENT\",
- \"HTML-CSS\": {
- scale: %SCALE,
- availableFonts: [\"STIX\",\"TeX\"],
- preferredFont: \"TeX\",
- webFont: \"TeX\",
- imageFont: \"TeX\",
- showMathMenu: true,
- },
- MMLorHTML: {
- prefer: {
- MSIE: \"MML\",
- Firefox: \"MML\",
- Opera: \"HTML\",
- other: \"HTML\"
+ \"HTML-CSS\": { scale: %SCALE,
+ linebreaks: { automatic: \"%LINEBREAKS\" },
+ webFont: \"%FONT\"
+ },
+ SVG: {scale: %SCALE,
+ linebreaks: { automatic: \"%LINEBREAKS\" },
+ font: \"%FONT\"},
+ NativeMML: {scale: %SCALE},
+ TeX: { equationNumbers: {autoNumber: \"%AUTONUMBER\"},
+ MultLineWidth: \"%MULTLINEWIDTH\",
+ TagSide: \"%TAGSIDE\",
+ TagIndent: \"%TAGINDENT\"
}
- }
- });
-/*]]>*///-->
-</script>"
- "The MathJax setup for XHTML files."
+});
+</script>
+<script type=\"text/javascript\"
+ src=\"%PATH\"></script>"
+ "The MathJax template. See also `org-html-mathjax-options'."
:group 'org-export-html
:type 'string)
@@ -1068,7 +1268,7 @@ You can also customize this for each buffer, using something like
(defcustom org-html-postamble 'auto
"Non-nil means insert a postamble in HTML export.
-When set to 'auto, check against the
+When set to `auto', check against the
`org-export-with-author/email/creator/date' variables to set the
content of the postamble. When set to a string, use this string
as the postamble. When t, insert a string as defined by the
@@ -1101,6 +1301,7 @@ The second element of each list is a format string to format the
postamble itself. This format string can contain these elements:
%t stands for the title.
+ %s stands for the subtitle.
%a stands for the author's name.
%e stands for the author's email.
%d stands for the date.
@@ -1123,7 +1324,7 @@ like that: \"%%\"."
:type 'string)
(defcustom org-html-creator-string
- (format "<a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> %s (<a href=\"http://orgmode.org\">Org</a> mode %s)"
+ (format "<a href=\"https://www.gnu.org/software/emacs/\">Emacs</a> %s (<a href=\"http://orgmode.org\">Org</a> mode %s)"
emacs-version
(if (fboundp 'org-version) (org-version) "unknown version"))
"Information about the creator of the HTML document.
@@ -1165,6 +1366,7 @@ The second element of each list is a format string to format the
preamble itself. This format string can contain these elements:
%t stands for the title.
+ %s stands for the subtitle.
%a stands for the author's name.
%e stands for the author's email.
%d stands for the date.
@@ -1216,8 +1418,6 @@ ignored."
;;;; Template :: Scripts
-(define-obsolete-variable-alias
- 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4")
(defcustom org-html-head-include-scripts t
"Non-nil means include the JavaScript snippets in exported HTML files.
The actual script is defined in `org-html-scripts' and should
@@ -1229,8 +1429,6 @@ not be modified."
;;;; Template :: Styles
-(define-obsolete-variable-alias
- 'org-html-style-include-default 'org-html-head-include-default-style "24.4")
(defcustom org-html-head-include-default-style t
"Non-nil means include the default style in exported HTML files.
The actual style is defined in `org-html-style-default' and
@@ -1243,7 +1441,6 @@ style information."
;;;###autoload
(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
-(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4")
(defcustom org-html-head ""
"Org-wide head definitions for exported HTML files.
@@ -1293,6 +1490,88 @@ or for publication projects using the :html-head-extra property."
;;;###autoload
(put 'org-html-head-extra 'safe-local-variable 'stringp)
+;;;; Template :: Viewport
+
+(defcustom org-html-viewport '((width "device-width")
+ (initial-scale "1")
+ (minimum-scale "")
+ (maximum-scale "")
+ (user-scalable ""))
+ "Viewport options for mobile-optimized sites.
+
+The following values are recognized
+
+width Size of the viewport.
+initial-scale Zoom level when the page is first loaded.
+minimum-scale Minimum allowed zoom level.
+maximum-scale Maximum allowed zoom level.
+user-scalable Whether zoom can be changed.
+
+The viewport meta tag is inserted if this variable is non-nil.
+
+See the following site for a reference:
+https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag"
+ :group 'org-export-html
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice (const :tag "Disable" nil)
+ (list :tag "Enable"
+ (list :tag "Width of viewport"
+ (const :format " " width)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "Initial scale"
+ (const :format " " initial-scale)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "Minimum scale/zoom"
+ (const :format " " minimum-scale)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "Maximum scale/zoom"
+ (const :format " " maximum-scale)
+ (choice (const :tag "unset" "")
+ (string)))
+ (list :tag "User scalable/zoomable"
+ (const :format " " user-scalable)
+ (choice (const :tag "unset" "")
+ (const "true")
+ (const "false"))))))
+
+;; Handle source code blocks with Klipse
+
+(defcustom org-html-klipsify-src nil
+ "When non-nil, source code blocks are editable in exported presentation."
+ :group 'org-export-html
+ :package-version '(Org . "9.1")
+ :type 'boolean)
+
+(defcustom org-html-klipse-css
+ "https://storage.googleapis.com/app.klipse.tech/css/codemirror.css"
+ "Location of the codemirror CSS file for use with klipse."
+ :group 'org-export-html
+ :package-version '(Org . "9.1")
+ :type 'string)
+
+(defcustom org-html-klipse-js
+ "https://storage.googleapis.com/app.klipse.tech/plugin_prod/js/klipse_plugin.min.js"
+ "Location of the klipse javascript file."
+ :group 'org-export-html
+ :type 'string)
+
+(defcustom org-html-klipse-selection-script
+ "window.klipse_settings = {selector_eval_html: '.src-html',
+ selector_eval_js: '.src-js',
+ selector_eval_python_client: '.src-python',
+ selector_eval_scheme: '.src-scheme',
+ selector: '.src-clojure',
+ selector_eval_ruby: '.src-ruby'};"
+ "Javascript snippet to activate klipse."
+ :group 'org-export-html
+ :package-version '(Org . "9.1")
+ :type 'string)
+
+
;;;; Todos
(defcustom org-html-todo-kwd-class-prefix ""
@@ -1304,7 +1583,7 @@ CSS classes, then this prefix can be very useful."
:group 'org-export-html
:type 'string)
-
+
;;; Internal Functions
(defun org-html-xhtml-p (info)
@@ -1315,22 +1594,33 @@ CSS classes, then this prefix can be very useful."
(let ((dt (downcase (plist-get info :html-doctype))))
(member dt '("html5" "xhtml5" "<!doctype html>"))))
+(defun org-html--html5-fancy-p (info)
+ "Non-nil when exporting to HTML5 with fancy elements.
+INFO is the current state of the export process, as a plist."
+ (and (plist-get info :html-html5-fancy)
+ (org-html-html5-p info)))
+
(defun org-html-close-tag (tag attr info)
- (concat "<" tag " " attr
+ "Return close-tag for string TAG.
+ATTR specifies additional attributes. INFO is a property list
+containing current export state."
+ (concat "<" tag
+ (org-string-nw-p (concat " " attr))
(if (org-html-xhtml-p info) " />" ">")))
(defun org-html-doctype (info)
- "Return correct html doctype tag from `org-html-doctype-alist',
-or the literal value of :html-doctype from INFO if :html-doctype
-is not found in the alist.
-INFO is a plist used as a communication channel."
+ "Return correct HTML doctype tag.
+INFO is a plist used as a communication channel. Doctype tag is
+extracted from `org-html-doctype-alist', or the literal value
+of :html-doctype from INFO if :html-doctype is not found in the
+alist."
(let ((dt (plist-get info :html-doctype)))
(or (cdr (assoc dt org-html-doctype-alist)) dt)))
(defun org-html--make-attribute-string (attributes)
"Return a list of attributes, as a string.
-ATTRIBUTES is a plist where values are either strings or nil. An
-attributes with a nil value will be omitted from the result."
+ATTRIBUTES is a plist where values are either strings or nil. An
+attribute with a nil value will be omitted from the result."
(let (output)
(dolist (item attributes (mapconcat 'identity (nreverse output) " "))
(cond ((null item) (pop output))
@@ -1345,15 +1635,13 @@ attributes with a nil value will be omitted from the result."
INFO is a plist used as a communication channel. When optional
arguments CAPTION and LABEL are given, use them for caption and
\"id\" attribute."
- (let ((html5-fancy (and (org-html-html5-p info)
- (plist-get info :html-html5-fancy))))
- (format (if html5-fancy "\n<figure%s>%s%s\n</figure>"
- "\n<div%s class=\"figure\">%s%s\n</div>")
+ (let ((html5-fancy (org-html--html5-fancy-p info)))
+ (format (if html5-fancy "\n<figure%s>\n%s%s\n</figure>"
+ "\n<div%s class=\"figure\">\n%s%s\n</div>")
;; ID.
- (if (not (org-string-nw-p label)) ""
- (format " id=\"%s\"" (org-export-solidify-link-text label)))
+ (if (org-string-nw-p label) (format " id=\"%s\"" label) "")
;; Contents.
- (format "\n<p>%s</p>" contents)
+ (if html5-fancy contents (format "<p>%s</p>" contents))
;; Caption.
(if (not (org-string-nw-p caption)) ""
(format (if html5-fancy "\n<figcaption>%s</figcaption>"
@@ -1366,17 +1654,42 @@ SOURCE is a string specifying the location of the image.
ATTRIBUTES is a plist, as returned by
`org-export-read-attribute'. INFO is a plist used as
a communication channel."
- (org-html-close-tag
- "img"
- (org-html--make-attribute-string
- (org-combine-plists
- (list :src source
- :alt (if (string-match-p "^ltxpng/" source)
- (org-html-encode-plain-text
- (org-find-text-property-in-string 'org-latex-src source))
- (file-name-nondirectory source)))
- attributes))
- info))
+ (if (string= "svg" (file-name-extension source))
+ (org-html--svg-image source attributes info)
+ (org-html-close-tag
+ "img"
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (list :src source
+ :alt (if (string-match-p "^ltxpng/" source)
+ (org-html-encode-plain-text
+ (org-find-text-property-in-string 'org-latex-src source))
+ (file-name-nondirectory source)))
+ attributes))
+ info)))
+
+(defun org-html--svg-image (source attributes info)
+ "Return \"object\" embedding svg file SOURCE with given ATTRIBUTES.
+INFO is a plist used as a communication channel.
+
+The special attribute \"fallback\" can be used to specify a
+fallback image file to use if the object embedding is not
+supported. CSS class \"org-svg\" is assigned as the class of the
+object unless a different class is specified with an attribute."
+ (let ((fallback (plist-get attributes :fallback))
+ (attrs (org-html--make-attribute-string
+ (org-combine-plists
+ ;; Remove fallback attribute, which is not meant to
+ ;; appear directly in the attributes string, and
+ ;; provide a default class if none is set.
+ '(:class "org-svg") attributes '(:fallback nil)))))
+ (format "<object type=\"image/svg+xml\" data=\"%s\" %s>\n%s</object>"
+ source
+ attrs
+ (if fallback
+ (org-html-close-tag
+ "img" (format "src=\"%s\" %s" fallback attrs) info)
+ "Sorry, your browser does not support SVG."))))
(defun org-html--textarea-block (element)
"Transcode ELEMENT into a textarea block.
@@ -1388,7 +1701,7 @@ ELEMENT is either a src block or an example block."
(or (plist-get attr :height) (org-count-lines code))
code)))
-(defun org-html--has-caption-p (element &optional info)
+(defun org-html--has-caption-p (element &optional _info)
"Non-nil when ELEMENT has a caption affiliated keyword.
INFO is a plist used as a communication channel. This function
is meant to be used as a predicate for `org-export-get-ordinal' or
@@ -1423,7 +1736,8 @@ If you then set `org-html-htmlize-output-type' to `css', calls
to the function `org-html-htmlize-region-for-paste' will
produce code that uses these same face definitions."
(interactive)
- (require 'htmlize)
+ (or (require 'htmlize nil t)
+ (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(and (get-buffer "*html*") (kill-buffer "*html*"))
(with-temp-buffer
(let ((fl (face-list))
@@ -1435,7 +1749,7 @@ produce code that uses these same face definitions."
(when (and (symbolp f) (or (not i) (not (listp i))))
(insert (org-add-props (copy-sequence "1") nil 'face f))))
(htmlize-region (point-min) (point-max))))
- (org-pop-to-buffer-same-window "*html*")
+ (pop-to-buffer-same-window "*html*")
(goto-char (point-min))
(if (re-search-forward "<style" nil t)
(delete-region (point-min) (match-beginning 0)))
@@ -1447,59 +1761,44 @@ produce code that uses these same face definitions."
(defun org-html--make-string (n string)
"Build a string by concatenating N times STRING."
- (let (out) (dotimes (i n out) (setq out (concat string out)))))
+ (let (out) (dotimes (_ n out) (setq out (concat string out)))))
(defun org-html-fix-class-name (kwd) ; audit callers of this function
"Turn todo keyword KWD into a valid class name.
Replaces invalid characters with \"_\"."
- (save-match-data
- (while (string-match "[^a-zA-Z0-9_]" kwd)
- (setq kwd (replace-match "_" t t kwd))))
- kwd)
-
-(defun org-html-format-footnote-reference (n def refcnt)
- "Format footnote reference N with definition DEF into HTML."
- (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt))))
- (format org-html-footnote-format
- (let* ((id (format "fnr.%s%s" n extra))
- (href (format " href=\"#fn.%s\"" n))
- (attributes (concat " class=\"footref\"" href)))
- (org-html--anchor id n attributes)))))
-
-(defun org-html-format-footnotes-section (section-name definitions)
- "Format footnotes section SECTION-NAME."
- (if (not definitions) ""
- (format org-html-footnotes-section section-name definitions)))
-
-(defun org-html-format-footnote-definition (fn)
- "Format the footnote definition FN."
- (let ((n (car fn)) (def (cdr fn)))
- (format
- "<div class=\"footdef\">%s %s</div>\n"
- (format org-html-footnote-format
- (let* ((id (format "fn.%s" n))
- (href (format " href=\"#fnr.%s\"" n))
- (attributes (concat " class=\"footnum\"" href)))
- (org-html--anchor id n attributes)))
- def)))
+ (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" kwd nil t))
(defun org-html-footnote-section (info)
"Format the footnote section.
INFO is a plist used as a communication channel."
- (let* ((fn-alist (org-export-collect-footnote-definitions
- (plist-get info :parse-tree) info))
+ (let* ((fn-alist (org-export-collect-footnote-definitions info))
(fn-alist
- (loop for (n type raw) in fn-alist collect
- (cons n (if (eq (org-element-type raw) 'org-data)
- (org-trim (org-export-data raw info))
- (format "<p>%s</p>"
- (org-trim (org-export-data raw info))))))))
+ (cl-loop for (n _type raw) in fn-alist collect
+ (cons n (if (eq (org-element-type raw) 'org-data)
+ (org-trim (org-export-data raw info))
+ (format "<div class=\"footpara\">%s</div>"
+ (org-trim (org-export-data raw info))))))))
(when fn-alist
- (org-html-format-footnotes-section
+ (format
+ (plist-get info :html-footnotes-section)
(org-html--translate "Footnotes" info)
(format
"\n%s\n"
- (mapconcat 'org-html-format-footnote-definition fn-alist "\n"))))))
+ (mapconcat
+ (lambda (fn)
+ (let ((n (car fn)) (def (cdr fn)))
+ (format
+ "<div class=\"footdef\">%s %s</div>\n"
+ (format
+ (plist-get info :html-footnote-format)
+ (org-html--anchor
+ (format "fn.%d" n)
+ n
+ (format " class=\"footnum\" href=\"#fnr.%d\"" n)
+ info))
+ def)))
+ fn-alist
+ "\n"))))))
;;; Template
@@ -1507,59 +1806,77 @@ INFO is a plist used as a communication channel."
(defun org-html--build-meta-info (info)
"Return meta tags for exported document.
INFO is a plist used as a communication channel."
- (let ((protect-string
- (lambda (str)
- (replace-regexp-in-string
- "\"" "&quot;" (org-html-encode-plain-text str))))
- (title (org-export-data (plist-get info :title) info))
- (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))))))
- (description (plist-get info :description))
- (keywords (plist-get info :keywords))
- (charset (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get org-html-coding-system
- 'mime-charset))
- "iso-8859-1")))
+ (let* ((protect-string
+ (lambda (str)
+ (replace-regexp-in-string
+ "\"" "&quot;" (org-html-encode-plain-text str))))
+ (title (org-export-data (plist-get info :title) info))
+ ;; Set title to an invisible character instead of leaving it
+ ;; empty, which is invalid.
+ (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))))))
+ (description (plist-get info :description))
+ (keywords (plist-get info :keywords))
+ (charset (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system
+ 'mime-charset))
+ "iso-8859-1")))
(concat
- (format "<title>%s</title>\n" title)
(when (plist-get info :time-stamp-file)
(format-time-string
- (concat "<!-- " org-html-metadata-timestamp-format " -->\n")))
+ (concat "<!-- "
+ (plist-get info :html-metadata-timestamp-format)
+ " -->\n")))
(format
(if (org-html-html5-p info)
- (org-html-close-tag "meta" " charset=\"%s\"" info)
+ (org-html-close-tag "meta" "charset=\"%s\"" info)
(org-html-close-tag
- "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
+ "meta" "http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
info))
charset) "\n"
- (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info)
+ (let ((viewport-options
+ (cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell)))
+ (plist-get info :html-viewport))))
+ (and viewport-options
+ (concat
+ (org-html-close-tag
+ "meta"
+ (format "name=\"viewport\" content=\"%s\""
+ (mapconcat
+ (lambda (elm) (format "%s=%s" (car elm) (cadr elm)))
+ viewport-options ", "))
+ info)
+ "\n")))
+ (format "<title>%s</title>\n" title)
+ (org-html-close-tag "meta" "name=\"generator\" content=\"Org mode\"" info)
"\n"
(and (org-string-nw-p author)
(concat
(org-html-close-tag "meta"
- (format " name=\"author\" content=\"%s\""
+ (format "name=\"author\" content=\"%s\""
(funcall protect-string author))
info)
"\n"))
(and (org-string-nw-p description)
(concat
(org-html-close-tag "meta"
- (format " name=\"description\" content=\"%s\"\n"
+ (format "name=\"description\" content=\"%s\"\n"
(funcall protect-string description))
info)
"\n"))
(and (org-string-nw-p keywords)
(concat
(org-html-close-tag "meta"
- (format " name=\"keywords\" content=\"%s\""
+ (format "name=\"keywords\" content=\"%s\""
(funcall protect-string keywords))
info)
"\n")))))
@@ -1576,7 +1893,7 @@ INFO is a plist used as a communication channel."
(when (and (plist-get info :html-htmlized-css-url)
(eq org-html-htmlize-output-type 'css))
(org-html-close-tag "link"
- (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
+ (format "rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
(plist-get info :html-htmlized-css-url))
info))
(when (plist-get info :html-head-include-scripts) org-html-scripts))))
@@ -1586,56 +1903,44 @@ INFO is a plist used as a communication channel."
INFO is a plist used as a communication channel."
(when (and (memq (plist-get info :with-latex) '(mathjax t))
(org-element-map (plist-get info :parse-tree)
- '(latex-fragment latex-environment) 'identity info t))
- (let ((template org-html-mathjax-template)
- (options org-html-mathjax-options)
- (in-buffer (or (plist-get info :html-mathjax) ""))
- name val (yes " ") (no "// ") x)
- (mapc
- (lambda (e)
- (setq name (car e) val (nth 1 e))
- (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
- (setq val (car (read-from-string
- (substring in-buffer (match-end 0))))))
- (if (not (stringp val)) (setq val (format "%s" val)))
- (if (string-match (concat "%" (upcase (symbol-name name))) template)
- (setq template (replace-match val t t template))))
- options)
- (setq val (nth 1 (assq 'mathml options)))
- (if (string-match (concat "\\<mathml:") in-buffer)
- (setq val (car (read-from-string
- (substring in-buffer (match-end 0))))))
- ;; Exchange prefixes depending on mathml setting.
- (if (not val) (setq x yes yes no no x))
- ;; Replace cookies to turn on or off the config/jax lines.
- (if (string-match ":MMLYES:" template)
- (setq template (replace-match yes t t template)))
- (if (string-match ":MMLNO:" template)
- (setq template (replace-match no t t template)))
- ;; Return the modified template.
- (org-element-normalize-string template))))
+ '(latex-fragment latex-environment) #'identity info t nil t))
+ (let ((template (plist-get info :html-mathjax-template))
+ (options (plist-get info :html-mathjax-options))
+ (in-buffer (or (plist-get info :html-mathjax) "")))
+ (dolist (e options (org-element-normalize-string template))
+ (let ((name (car e))
+ (val (nth 1 e)))
+ (when (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
+ (setq val
+ (car (read-from-string (substring in-buffer (match-end 0))))))
+ (unless (stringp val) (setq val (format "%s" val)))
+ (while (string-match (concat "%" (upcase (symbol-name name)))
+ template)
+ (setq template (replace-match val t t template))))))))
(defun org-html-format-spec (info)
- "Return format specification for elements that can be
-used in the preamble or postamble."
- `((?t . ,(org-export-data (plist-get info :title) info))
- (?d . ,(org-export-data (org-export-get-date info) info))
- (?T . ,(format-time-string org-html-metadata-timestamp-format))
- (?a . ,(org-export-data (plist-get info :author) info))
- (?e . ,(mapconcat
- (lambda (e)
- (format "<a href=\"mailto:%s\">%s</a>" e e))
- (split-string (plist-get info :email) ",+ *")
- ", "))
- (?c . ,(plist-get info :creator))
- (?C . ,(let ((file (plist-get info :input-file)))
- (format-time-string org-html-metadata-timestamp-format
- (if file (nth 5 (file-attributes file))))))
- (?v . ,(or org-html-validation-link ""))))
+ "Return format specification for preamble and postamble.
+INFO is a plist used as a communication channel."
+ (let ((timestamp-format (plist-get info :html-metadata-timestamp-format)))
+ `((?t . ,(org-export-data (plist-get info :title) info))
+ (?s . ,(org-export-data (plist-get info :subtitle) info))
+ (?d . ,(org-export-data (org-export-get-date info timestamp-format)
+ info))
+ (?T . ,(format-time-string timestamp-format))
+ (?a . ,(org-export-data (plist-get info :author) info))
+ (?e . ,(mapconcat
+ (lambda (e) (format "<a href=\"mailto:%s\">%s</a>" e e))
+ (split-string (plist-get info :email) ",+ *")
+ ", "))
+ (?c . ,(plist-get info :creator))
+ (?C . ,(let ((file (plist-get info :input-file)))
+ (format-time-string timestamp-format
+ (and file (nth 5 (file-attributes file))))))
+ (?v . ,(or (plist-get info :html-validation-link) "")))))
(defun org-html--build-pre/postamble (type info)
"Return document preamble or postamble as a string, or nil.
-TYPE is either 'preamble or 'postamble, INFO is a plist used as a
+TYPE is either `preamble' or `postamble', INFO is a plist used as a
communication channel."
(let ((section (plist-get info (intern (format ":html-%s" type))))
(spec (org-html-format-spec info)))
@@ -1649,7 +1954,6 @@ communication channel."
(author (cdr (assq ?a spec)))
(email (cdr (assq ?e spec)))
(creator (cdr (assq ?c spec)))
- (timestamp (cdr (assq ?T spec)))
(validation-link (cdr (assq ?v spec))))
(concat
(when (and (plist-get info :with-date)
@@ -1671,30 +1975,34 @@ communication channel."
(format
"<p class=\"date\">%s: %s</p>\n"
(org-html--translate "Created" info)
- (format-time-string org-html-metadata-timestamp-format)))
+ (format-time-string
+ (plist-get info :html-metadata-timestamp-format))))
(when (plist-get info :with-creator)
(format "<p class=\"creator\">%s</p>\n" creator))
(format "<p class=\"validation\">%s</p>\n"
validation-link))))
(t (format-spec
- (or (cadr (assoc
+ (or (cadr (assoc-string
(plist-get info :language)
(eval (intern
- (format "org-html-%s-format" type)))))
+ (format "org-html-%s-format" type)))
+ t))
(cadr
- (assoc
+ (assoc-string
"en"
(eval
- (intern (format "org-html-%s-format" type))))))
+ (intern (format "org-html-%s-format" type)))
+ t)))
spec))))))
- (when (org-string-nw-p section-contents)
- (concat
- (format "<%s id=\"%s\" class=\"%s\">\n"
- (nth 1 (assq type org-html-divs))
- (nth 2 (assq type org-html-divs))
- org-html--pre/postamble-class)
- (org-element-normalize-string section-contents)
- (format "</%s>\n" (nth 1 (assq type org-html-divs)))))))))
+ (let ((div (assq type (plist-get info :html-divs))))
+ (when (org-string-nw-p section-contents)
+ (concat
+ (format "<%s id=\"%s\" class=\"%s\">\n"
+ (nth 1 div)
+ (nth 2 div)
+ org-html--pre/postamble-class)
+ (org-element-normalize-string section-contents)
+ (format "</%s>\n" (nth 1 div)))))))))
(defun org-html-inner-template (contents info)
"Return body of document string after HTML conversion.
@@ -1715,27 +2023,28 @@ CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat
(when (and (not (org-html-html5-p info)) (org-html-xhtml-p info))
- (let ((decl (or (and (stringp org-html-xml-declaration)
- org-html-xml-declaration)
- (cdr (assoc (plist-get info :html-extension)
- org-html-xml-declaration))
- (cdr (assoc "html" org-html-xml-declaration))
-
- "")))
- (when (not (or (eq nil decl) (string= "" decl)))
+ (let* ((xml-declaration (plist-get info :html-xml-declaration))
+ (decl (or (and (stringp xml-declaration) xml-declaration)
+ (cdr (assoc (plist-get info :html-extension)
+ xml-declaration))
+ (cdr (assoc "html" xml-declaration))
+ "")))
+ (when (not (or (not decl) (string= "" decl)))
(format "%s\n"
(format decl
- (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get org-html-coding-system 'mime-charset))
- "iso-8859-1"))))))
+ (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system 'mime-charset))
+ "iso-8859-1"))))))
(org-html-doctype info)
"\n"
(concat "<html"
- (when (org-html-xhtml-p info)
- (format
- " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
- (plist-get info :language) (plist-get info :language)))
+ (cond ((org-html-xhtml-p info)
+ (format
+ " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
+ (plist-get info :language) (plist-get info :language)))
+ ((org-html-html5-p info)
+ (format " lang=\"%s\"" (plist-get info :language))))
">\n")
"<head>\n"
(org-html--build-meta-info info)
@@ -1746,23 +2055,45 @@ holding export options."
(let ((link-up (org-trim (plist-get info :html-link-up)))
(link-home (org-trim (plist-get info :html-link-home))))
(unless (and (string= link-up "") (string= link-home ""))
- (format org-html-home/up-format
+ (format (plist-get info :html-home/up-format)
(or link-up link-home)
(or link-home link-up))))
;; Preamble.
(org-html--build-pre/postamble 'preamble info)
;; Document contents.
- (format "<%s id=\"%s\">\n"
- (nth 1 (assq 'content org-html-divs))
- (nth 2 (assq 'content org-html-divs)))
+ (let ((div (assq 'content (plist-get info :html-divs))))
+ (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div)))
;; Document title.
- (let ((title (plist-get info :title)))
- (format "<h1 class=\"title\">%s</h1>\n" (org-export-data (or title "") info)))
+ (when (plist-get info :with-title)
+ (let ((title (and (plist-get info :with-title)
+ (plist-get info :title)))
+ (subtitle (plist-get info :subtitle))
+ (html5-fancy (org-html--html5-fancy-p info)))
+ (when title
+ (format
+ (if html5-fancy
+ "<header>\n<h1 class=\"title\">%s</h1>\n%s</header>"
+ "<h1 class=\"title\">%s%s</h1>\n")
+ (org-export-data title info)
+ (if subtitle
+ (format
+ (if html5-fancy
+ "<p class=\"subtitle\">%s</p>\n"
+ (concat "\n" (org-html-close-tag "br" nil info) "\n"
+ "<span class=\"subtitle\">%s</span>\n"))
+ (org-export-data subtitle info))
+ "")))))
contents
- (format "</%s>\n"
- (nth 1 (assq 'content org-html-divs)))
+ (format "</%s>\n" (nth 1 (assq 'content (plist-get info :html-divs))))
;; Postamble.
(org-html--build-pre/postamble 'postamble info)
+ ;; Possibly use the Klipse library live code blocks.
+ (if (plist-get info :html-klipsify-src)
+ (concat "<script>" (plist-get info :html-klipse-selection-script)
+ "</script><script src=\""
+ org-html-klipse-js
+ "\"></script><link rel=\"stylesheet\" type=\"text/css\" href=\""
+ org-html-klipse-css "\"/>"))
;; Closing document.
"</body>\n</html>"))
@@ -1773,9 +2104,9 @@ INFO is a plist used as a communication channel."
;;;; Anchor
-(defun org-html--anchor (&optional id desc attributes)
+(defun org-html--anchor (id desc attributes info)
"Format a HTML anchor."
- (let* ((name (and org-html-allow-name-attribute-in-anchors id))
+ (let* ((name (and (plist-get info :html-allow-name-attribute-in-anchors) id))
(attributes (concat (and id (format " id=\"%s\"" id))
(and name (format " name=\"%s\"" name))
attributes)))
@@ -1783,43 +2114,38 @@ INFO is a plist used as a communication channel."
;;;; Todo
-(defun org-html--todo (todo)
+(defun org-html--todo (todo info)
"Format TODO keywords into HTML."
(when todo
(format "<span class=\"%s %s%s\">%s</span>"
(if (member todo org-done-keywords) "done" "todo")
- org-html-todo-kwd-class-prefix (org-html-fix-class-name todo)
+ (or (plist-get info :html-todo-kwd-class-prefix) "")
+ (org-html-fix-class-name todo)
todo)))
+;;;; Priority
+
+(defun org-html--priority (priority _info)
+ "Format a priority into HTML.
+PRIORITY is the character code of the priority or nil. INFO is
+a plist containing export options."
+ (and priority (format "<span class=\"priority\">[%c]</span>" priority)))
+
;;;; Tags
-(defun org-html--tags (tags)
- "Format TAGS into HTML."
+(defun org-html--tags (tags info)
+ "Format TAGS into HTML.
+INFO is a plist containing export options."
(when tags
(format "<span class=\"tag\">%s</span>"
(mapconcat
(lambda (tag)
(format "<span class=\"%s\">%s</span>"
- (concat org-html-tag-class-prefix
+ (concat (plist-get info :html-tag-class-prefix)
(org-html-fix-class-name tag))
tag))
tags "&#xa0;"))))
-;;;; Headline
-
-(defun* org-html-format-headline
- (todo todo-type priority text tags
- &key level section-number headline-label &allow-other-keys)
- "Format a headline in HTML."
- (let ((section-number
- (when section-number
- (format "<span class=\"section-number-%d\">%s</span> "
- level section-number)))
- (todo (org-html--todo todo))
- (tags (org-html--tags tags)))
- (concat section-number todo (and todo " ") text
- (and tags "&#xa0;&#xa0;&#xa0;") tags)))
-
;;;; Src Code
(defun org-html-fontify-code (code lang)
@@ -1828,15 +2154,17 @@ CODE is a string representing the source code to colorize. LANG
is the language used for CODE, as a string, or nil."
(when code
(cond
- ;; Case 1: No lang. Possibly an example block.
- ((not lang)
- ;; Simple transcoding.
- (org-html-encode-plain-text code))
- ;; Case 2: No htmlize or an inferior version of htmlize
- ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste)))
+ ;; No language. Possibly an example block.
+ ((not lang) (org-html-encode-plain-text code))
+ ;; Plain text explicitly set.
+ ((not org-html-htmlize-output-type) (org-html-encode-plain-text code))
+ ;; No htmlize library or an inferior version of htmlize.
+ ((not (and (or (require 'htmlize nil t)
+ (error "Please install htmlize from \
+https://github.com/hniksic/emacs-htmlize"))
+ (fboundp 'htmlize-region-for-paste)))
;; Emit a warning.
(message "Cannot fontify src block (htmlize.el >= 1.34 required)")
- ;; Simple transcoding.
(org-html-encode-plain-text code))
(t
;; Map language
@@ -1845,32 +2173,36 @@ is the language used for CODE, as a string, or nil."
(cond
;; Case 1: Language is not associated with any Emacs mode
((not (functionp lang-mode))
- ;; Simple transcoding.
(org-html-encode-plain-text code))
;; Case 2: Default. Fontify code.
(t
;; htmlize
- (setq code (with-temp-buffer
- ;; Switch to language-specific mode.
- (funcall lang-mode)
- (insert code)
- ;; Fontify buffer.
- (org-font-lock-ensure)
- ;; Remove formatting on newline characters.
- (save-excursion
- (let ((beg (point-min))
- (end (point-max)))
- (goto-char beg)
- (while (progn (end-of-line) (< (point) end))
- (put-text-property (point) (1+ (point)) 'face nil)
- (forward-char 1))))
- (org-src-mode)
- (set-buffer-modified-p nil)
- ;; Htmlize region.
- (org-html-htmlize-region-for-paste
- (point-min) (point-max))))
+ (setq code
+ (let ((output-type org-html-htmlize-output-type)
+ (font-prefix org-html-htmlize-font-prefix))
+ (with-temp-buffer
+ ;; Switch to language-specific mode.
+ (funcall lang-mode)
+ (insert code)
+ ;; Fontify buffer.
+ (org-font-lock-ensure)
+ ;; Remove formatting on newline characters.
+ (save-excursion
+ (let ((beg (point-min))
+ (end (point-max)))
+ (goto-char beg)
+ (while (progn (end-of-line) (< (point) end))
+ (put-text-property (point) (1+ (point)) 'face nil)
+ (forward-char 1))))
+ (org-src-mode)
+ (set-buffer-modified-p nil)
+ ;; Htmlize region.
+ (let ((org-html-htmlize-output-type output-type)
+ (org-html-htmlize-font-prefix font-prefix))
+ (org-html-htmlize-region-for-paste
+ (point-min) (point-max))))))
;; Strip any enclosing <pre></pre> tags.
- (let* ((beg (and (string-match "\\`<pre[^>]*>\n*" code) (match-end 0)))
+ (let* ((beg (and (string-match "\\`<pre[^>]*>\n?" code) (match-end 0)))
(end (and beg (string-match "</pre>\\'" code))))
(if (and beg end) (substring code beg end) code)))))))))
@@ -1883,7 +2215,7 @@ alist between line numbers and references (as returned by
`org-export-unravel-code'), a boolean specifying if labels should
appear in the source code, and the number associated to the first
line of code."
- (let* ((code-lines (org-split-string code "\n"))
+ (let* ((code-lines (split-string code "\n"))
(code-length (length code-lines))
(num-fmt
(and num-start
@@ -1921,38 +2253,39 @@ a plist used as a communication channel."
;; Does the src block contain labels?
(retain-labels (org-element-property :retain-labels element))
;; Does it have line numbers?
- (num-start (case (org-element-property :number-lines element)
- (continued (org-export-get-loc element info))
- (new 0))))
+ (num-start (org-export-get-loc element info)))
(org-html-do-format-code code lang refs retain-labels num-start)))
;;; Tables of Contents
-(defun org-html-toc (depth info)
+(defun org-html-toc (depth info &optional scope)
"Build a table of contents.
-DEPTH is an integer specifying the depth of the table. INFO is a
-plist used as a communication channel. Return the table of
-contents as a string, or nil if it is empty."
+DEPTH is an integer specifying the depth of the table. INFO is
+a plist used as a communication channel. Optional argument SCOPE
+is an element defining the scope of the table. Return the table
+of contents as a string, or nil if it is empty."
(let ((toc-entries
(mapcar (lambda (headline)
(cons (org-html--format-toc-headline headline info)
(org-export-get-relative-level headline info)))
- (org-export-collect-headlines info depth)))
- (outer-tag (if (and (org-html-html5-p info)
- (plist-get info :html-html5-fancy))
- "nav"
- "div")))
+ (org-export-collect-headlines info depth scope))))
(when toc-entries
- (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
- (format "<h%d>%s</h%d>\n"
- org-html-toplevel-hlevel
- (org-html--translate "Table of Contents" info)
- org-html-toplevel-hlevel)
- "<div id=\"text-table-of-contents\">"
- (org-html--toc-text toc-entries)
- "</div>\n"
- (format "</%s>\n" outer-tag)))))
+ (let ((toc (concat "<div id=\"text-table-of-contents\">"
+ (org-html--toc-text toc-entries)
+ "</div>\n")))
+ (if scope toc
+ (let ((outer-tag (if (org-html--html5-fancy-p info)
+ "nav"
+ "div")))
+ (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+ (let ((top-level (plist-get info :html-toplevel-hlevel)))
+ (format "<h%d>%s</h%d>\n"
+ top-level
+ (org-html--translate "Table of Contents" info)
+ top-level))
+ toc
+ (format "</%s>\n" outer-tag))))))))
(defun org-html--toc-text (toc-entries)
"Return innards of a table of contents, as a string.
@@ -1967,8 +2300,7 @@ and value is its relative level, as an integer."
(level (cdr entry)))
(concat
(let* ((cnt (- level prev-level))
- (times (if (> cnt 0) (1- cnt) (- cnt)))
- rtn)
+ (times (if (> cnt 0) (1- cnt) (- cnt))))
(setq prev-level level)
(concat
(org-html--make-string
@@ -1991,35 +2323,21 @@ INFO is a plist used as a communication channel."
(org-element-property :priority headline)))
(text (org-export-data-with-backend
(org-export-get-alt-title headline info)
- ;; Create an anonymous back-end that will ignore any
- ;; footnote-reference, link, radio-target and target
- ;; in table of contents.
- (org-export-create-backend
- :parent 'html
- :transcoders '((footnote-reference . ignore)
- (link . (lambda (object c i) c))
- (radio-target . (lambda (object c i) c))
- (target . ignore)))
+ (org-export-toc-entry-backend 'html)
info))
(tags (and (eq (plist-get info :with-tags) t)
(org-export-get-tags headline info))))
(format "<a href=\"#%s\">%s</a>"
;; Label.
- (org-export-solidify-link-text
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-"
- (mapconcat #'number-to-string headline-number "-"))))
+ (or (org-element-property :CUSTOM_ID headline)
+ (org-export-get-reference headline info))
;; Body.
(concat
(and (not (org-export-low-level-p headline info))
(org-export-numbered-headline-p headline info)
(concat (mapconcat #'number-to-string headline-number ".")
". "))
- (apply (if (not (eq org-html-format-headline-function 'ignore))
- (lambda (todo todo-type priority text tags &rest ignore)
- (funcall org-html-format-headline-function
- todo todo-type priority text tags))
- #'org-html-format-headline)
+ (apply (plist-get info :html-format-headline-function)
todo todo-type priority text tags :section-number nil)))))
(defun org-html-list-of-listings (info)
@@ -2029,17 +2347,19 @@ of listings as a string, or nil if it is empty."
(let ((lol-entries (org-export-collect-listings info)))
(when lol-entries
(concat "<div id=\"list-of-listings\">\n"
- (format "<h%d>%s</h%d>\n"
- org-html-toplevel-hlevel
- (org-html--translate "List of Listings" info)
- org-html-toplevel-hlevel)
+ (let ((top-level (plist-get info :html-toplevel-hlevel)))
+ (format "<h%d>%s</h%d>\n"
+ top-level
+ (org-html--translate "List of Listings" info)
+ top-level))
"<div id=\"text-list-of-listings\">\n<ul>\n"
(let ((count 0)
(initial-fmt (format "<span class=\"listing-number\">%s</span>"
(org-html--translate "Listing %d:" info))))
(mapconcat
(lambda (entry)
- (let ((label (org-element-property :name entry))
+ (let ((label (and (org-element-property :name entry)
+ (org-export-get-reference entry info)))
(title (org-trim
(org-export-data
(or (org-export-get-caption entry t)
@@ -2048,10 +2368,12 @@ of listings as a string, or nil if it is empty."
(concat
"<li>"
(if (not label)
- (concat (format initial-fmt (incf count)) " " title)
+ (concat (format initial-fmt (cl-incf count))
+ " "
+ title)
(format "<a href=\"#%s\">%s %s</a>"
- (org-export-solidify-link-text label)
- (format initial-fmt (incf count))
+ label
+ (format initial-fmt (cl-incf count))
title))
"</li>")))
lol-entries "\n"))
@@ -2064,17 +2386,19 @@ of tables as a string, or nil if it is empty."
(let ((lol-entries (org-export-collect-tables info)))
(when lol-entries
(concat "<div id=\"list-of-tables\">\n"
- (format "<h%d>%s</h%d>\n"
- org-html-toplevel-hlevel
- (org-html--translate "List of Tables" info)
- org-html-toplevel-hlevel)
+ (let ((top-level (plist-get info :html-toplevel-hlevel)))
+ (format "<h%d>%s</h%d>\n"
+ top-level
+ (org-html--translate "List of Tables" info)
+ top-level))
"<div id=\"text-list-of-tables\">\n<ul>\n"
(let ((count 0)
(initial-fmt (format "<span class=\"table-number\">%s</span>"
(org-html--translate "Table %d:" info))))
(mapconcat
(lambda (entry)
- (let ((label (org-element-property :name entry))
+ (let ((label (and (org-element-property :name entry)
+ (org-export-get-reference entry info)))
(title (org-trim
(org-export-data
(or (org-export-get-caption entry t)
@@ -2083,10 +2407,12 @@ of tables as a string, or nil if it is empty."
(concat
"<li>"
(if (not label)
- (concat (format initial-fmt (incf count)) " " title)
+ (concat (format initial-fmt (cl-incf count))
+ " "
+ title)
(format "<a href=\"#%s\">%s %s</a>"
- (org-export-solidify-link-text label)
- (format initial-fmt (incf count))
+ label
+ (format initial-fmt (cl-incf count))
title))
"</li>")))
lol-entries "\n"))
@@ -2097,24 +2423,24 @@ of tables as a string, or nil if it is empty."
;;;; Bold
-(defun org-html-bold (bold contents info)
+(defun org-html-bold (_bold contents info)
"Transcode BOLD from Org to HTML.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
- (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'bold (plist-get info :html-text-markup-alist))) "%s")
contents))
;;;; Center Block
-(defun org-html-center-block (center-block contents info)
+(defun org-html-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (format "<div class=\"center\">\n%s</div>" contents))
+ (format "<div class=\"org-center\">\n%s</div>" contents))
;;;; Clock
-(defun org-html-clock (clock contents info)
+(defun org-html-clock (clock _contents _info)
"Transcode a CLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -2124,19 +2450,17 @@ channel."
</span>
</p>"
org-clock-string
- (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
+ (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " <span class=\"timestamp\">(%s)</span>" time)))))
;;;; Code
-(defun org-html-code (code contents info)
+(defun org-html-code (code _contents info)
"Transcode CODE from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'code (plist-get info :html-text-markup-alist))) "%s")
(org-html-encode-plain-text (org-element-property :value code))))
;;;; Drawer
@@ -2145,17 +2469,13 @@ information."
"Transcode a DRAWER element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (if (functionp org-html-format-drawer-function)
- (funcall org-html-format-drawer-function
- (org-element-property :drawer-name drawer)
- contents)
- ;; If there's no user defined function: simply
- ;; display contents of the drawer.
- contents))
+ (funcall (plist-get info :html-format-drawer-function)
+ (org-element-property :drawer-name drawer)
+ contents))
;;;; Dynamic Block
-(defun org-html-dynamic-block (dynamic-block contents info)
+(defun org-html-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -2163,7 +2483,7 @@ holding contextual information. See `org-export-data'."
;;;; Entity
-(defun org-html-entity (entity contents info)
+(defun org-html-entity (entity _contents _info)
"Transcode an ENTITY object from Org to HTML.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -2171,18 +2491,25 @@ contextual information."
;;;; Example Block
-(defun org-html-example-block (example-block contents info)
+(defun org-html-example-block (example-block _contents info)
"Transcode a EXAMPLE-BLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (if (org-export-read-attribute :attr_html example-block :textarea)
- (org-html--textarea-block example-block)
- (format "<pre class=\"example\">\n%s</pre>"
- (org-html-format-code example-block info))))
+ (let ((attributes (org-export-read-attribute :attr_html example-block)))
+ (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))
+ (a (org-html--make-attribute-string
+ (if (or (not name) (plist-member attributes :id))
+ attributes
+ (plist-put attributes :id name)))))
+ (if (org-string-nw-p a) (concat " " a) ""))
+ (org-html-format-code example-block info)))))
;;;; Export Snippet
-(defun org-html-export-snippet (export-snippet contents info)
+(defun org-html-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -2191,7 +2518,7 @@ information."
;;;; Export Block
-(defun org-html-export-block (export-block contents info)
+(defun org-html-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "HTML")
@@ -2199,7 +2526,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-html-fixed-width (fixed-width contents info)
+(defun org-html-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "<pre class=\"example\">\n%s</pre>"
@@ -2209,135 +2536,117 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-html-footnote-reference (footnote-reference contents info)
+(defun org-html-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(concat
;; Insert separator between two footnotes in a row.
(let ((prev (org-export-get-previous-element footnote-reference info)))
(when (eq (org-element-type prev) 'footnote-reference)
- org-html-footnote-separator))
- (cond
- ((not (org-export-footnote-first-reference-p footnote-reference info))
- (org-html-format-footnote-reference
- (org-export-get-footnote-number footnote-reference info)
- "IGNORED" 100))
- ;; Inline definitions are secondary strings.
- ((eq (org-element-property :type footnote-reference) 'inline)
- (org-html-format-footnote-reference
- (org-export-get-footnote-number footnote-reference info)
- "IGNORED" 1))
- ;; Non-inline footnotes definitions are full Org data.
- (t (org-html-format-footnote-reference
- (org-export-get-footnote-number footnote-reference info)
- "IGNORED" 1)))))
+ (plist-get info :html-footnote-separator)))
+ (let* ((n (org-export-get-footnote-number footnote-reference info))
+ (id (format "fnr.%d%s"
+ n
+ (if (org-export-footnote-first-reference-p
+ footnote-reference info)
+ ""
+ ".100"))))
+ (format
+ (plist-get info :html-footnote-format)
+ (org-html--anchor
+ id n (format " class=\"footref\" href=\"#fn.%d\"" n) info)))))
;;;; Headline
-(defun org-html-format-headline--wrap
- (headline info &optional format-function &rest extra-keys)
- "Transcode a HEADLINE element from Org to HTML.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information."
- (let* ((level (+ (org-export-get-relative-level headline info)
- (1- org-html-toplevel-hlevel)))
- (headline-number (org-export-get-headline-number headline info))
- (section-number (and (not (org-export-low-level-p headline info))
- (org-export-numbered-headline-p headline info)
- (mapconcat 'number-to-string
- headline-number ".")))
- (todo (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- (text (org-export-data (org-element-property :title headline) info))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (headline-label (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-" (mapconcat 'number-to-string
- headline-number "-"))))
- (format-function
- (cond ((functionp format-function) format-function)
- ((not (eq org-html-format-headline-function 'ignore))
- (lambda (todo todo-type priority text tags &rest ignore)
- (funcall org-html-format-headline-function
- todo todo-type priority text tags)))
- (t 'org-html-format-headline))))
- (apply format-function
- todo todo-type priority text tags
- :headline-label headline-label :level level
- :section-number section-number extra-keys)))
-
(defun org-html-headline (headline contents info)
"Transcode a HEADLINE element from Org to HTML.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(unless (org-element-property :footnote-section-p headline)
- (let* ((contents (or contents ""))
- (numberedp (org-export-numbered-headline-p headline info))
- (level (org-export-get-relative-level headline info))
- (text (org-export-data (org-element-property :title headline) info))
- (todo (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- (section-number (mapconcat #'number-to-string
- (org-export-get-headline-number
- headline info) "-"))
- (ids (delq 'nil
- (list (org-element-property :CUSTOM_ID headline)
- (concat "sec-" section-number)
- (org-element-property :ID headline))))
- (preferred-id (car ids))
- (extra-ids (mapconcat
- (lambda (id)
- (org-html--anchor
- (org-export-solidify-link-text
- (if (org-uuidgen-p id) (concat "ID-" id) id))))
- (cdr ids) ""))
- ;; Create the headline text.
- (full-text (org-html-format-headline--wrap headline info)))
+ (let* ((numberedp (org-export-numbered-headline-p headline info))
+ (numbers (org-export-get-headline-number headline info))
+ (level (+ (org-export-get-relative-level headline info)
+ (1- (plist-get info :html-toplevel-hlevel))))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-export-data (org-element-property :title headline) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (full-text (funcall (plist-get info :html-format-headline-function)
+ todo todo-type priority text tags info))
+ (contents (or contents ""))
+ (ids (delq nil
+ (list (org-element-property :CUSTOM_ID headline)
+ (org-export-get-reference headline info)
+ (org-element-property :ID headline))))
+ (preferred-id (car ids))
+ (extra-ids
+ (mapconcat
+ (lambda (id)
+ (org-html--anchor
+ (if (org-uuidgen-p id) (concat "ID-" id) id)
+ nil nil info))
+ (cdr ids) "")))
(if (org-export-low-level-p headline info)
- ;; This is a deep sub-tree: export it as a list item.
- (let* ((type (if numberedp 'ordered 'unordered))
- (itemized-body
- (org-html-format-list-item
- contents type nil info nil
- (concat (org-html--anchor preferred-id) extra-ids
- full-text))))
+ ;; This is a deep sub-tree: export it as a list item.
+ (let* ((html-type (if numberedp "ol" "ul")))
(concat
(and (org-export-first-sibling-p headline info)
- (org-html-begin-plain-list type))
- itemized-body
+ (apply #'format "<%s class=\"org-%s\">\n"
+ (make-list 2 html-type)))
+ (org-html-format-list-item
+ contents (if numberedp 'ordered 'unordered)
+ nil info nil
+ (concat (org-html--anchor preferred-id nil nil info)
+ extra-ids
+ full-text)) "\n"
(and (org-export-last-sibling-p headline info)
- (org-html-end-plain-list type))))
+ (format "</%s>\n" html-type))))
;; Standard headline. Export it as a section.
- (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
- (level1 (+ level (1- org-html-toplevel-hlevel)))
- (first-content (car (org-element-contents headline))))
- (format "<%s id=\"%s\" class=\"%s\">%s%s</%s>\n"
- (org-html--container headline info)
- (format "outline-container-%s"
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-" section-number)))
- (concat (format "outline-%d" level1) (and extra-class " ")
- extra-class)
- (format "\n<h%d id=\"%s\">%s%s</h%d>\n"
- level1 preferred-id extra-ids full-text level1)
- ;; When there is no section, pretend there is an
- ;; empty one to get the correct <div class="outline-
- ;; ...> which is needed by `org-info.js'.
- (if (not (eq (org-element-type first-content) 'section))
- (concat (org-html-section first-content "" info)
- contents)
- contents)
- (org-html--container headline info)))))))
+ (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
+ (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))
+ (concat (format "outline-%d" level)
+ (and extra-class " ")
+ extra-class)
+ (format "\n<h%d id=\"%s\">%s%s</h%d>\n"
+ level
+ preferred-id
+ extra-ids
+ (concat
+ (and numberedp
+ (format
+ "<span class=\"section-number-%d\">%s</span> "
+ level
+ (mapconcat #'number-to-string numbers ".")))
+ full-text)
+ level)
+ ;; When there is no section, pretend there is an
+ ;; empty one to get the correct <div
+ ;; class="outline-...> which is needed by
+ ;; `org-info.js'.
+ (if (eq (org-element-type first-content) 'section) contents
+ (concat (org-html-section first-content "" info) contents))
+ (org-html--container headline info)))))))
+
+(defun org-html-format-headline-default-function
+ (todo _todo-type priority text tags info)
+ "Default format function for a headline.
+See `org-html-format-headline-function' for details."
+ (let ((todo (org-html--todo todo info))
+ (priority (org-html--priority priority info))
+ (tags (org-html--tags tags info)))
+ (concat todo (and todo " ")
+ priority (and priority " ")
+ text
+ (and tags "&#xa0;&#xa0;&#xa0;") tags)))
(defun org-html--container (headline info)
(or (org-element-property :HTML_CONTAINER headline)
@@ -2347,100 +2656,115 @@ holding contextual information."
;;;; Horizontal Rule
-(defun org-html-horizontal-rule (horizontal-rule contents info)
+(defun org-html-horizontal-rule (_horizontal-rule _contents info)
"Transcode an HORIZONTAL-RULE object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-html-close-tag "hr" nil info))
;;;; Inline Src Block
-(defun org-html-inline-src-block (inline-src-block contents info)
+(defun org-html-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((org-lang (org-element-property :language inline-src-block))
- (code (org-element-property :value inline-src-block)))
- (error "Cannot export inline src block")))
+ (let* ((lang (org-element-property :language inline-src-block))
+ (code (org-html-fontify-code
+ (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))))
+ (if (not lbl) "" (format " id=\"%s\"" lbl)))))
+ (format "<code class=\"src src-%s\"%s>%s</code>" lang label code)))
;;;; Inlinetask
-(defun org-html-format-section (text class &optional id)
- "Format a section with TEXT into a HTML div with CLASS and ID."
- (let ((extra (concat (when id (format " id=\"%s\"" id)))))
- (concat (format "<div class=\"%s\"%s>\n" class extra) text "</div>\n")))
-
(defun org-html-inlinetask (inlinetask contents info)
"Transcode an INLINETASK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (cond
- ;; If `org-html-format-inlinetask-function' is not 'ignore, call it
- ;; with appropriate arguments.
- ((not (eq org-html-format-inlinetask-function 'ignore))
- (let ((format-function
- (function*
- (lambda (todo todo-type priority text tags
- &key contents &allow-other-keys)
- (funcall org-html-format-inlinetask-function
- todo todo-type priority text tags contents)))))
- (org-html-format-headline--wrap
- inlinetask info format-function :contents contents)))
- ;; Otherwise, use a default template.
- (t (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
- (org-html-format-headline--wrap inlinetask info)
- (org-html-close-tag "br" nil info)
- contents))))
+ (let* ((todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type inlinetask)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask)))
+ (text (org-export-data (org-element-property :title inlinetask) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info))))
+ (funcall (plist-get info :html-format-inlinetask-function)
+ todo todo-type priority text tags contents info)))
+
+(defun org-html-format-inlinetask-default-function
+ (todo todo-type priority text tags contents info)
+ "Default format function for a inlinetasks.
+See `org-html-format-inlinetask-function' for details."
+ (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
+ (org-html-format-headline-default-function
+ todo todo-type priority text tags info)
+ (org-html-close-tag "br" nil info)
+ contents))
;;;; Italic
-(defun org-html-italic (italic contents info)
+(defun org-html-italic (_italic contents info)
"Transcode ITALIC from Org to HTML.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
- (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents))
+ (format
+ (or (cdr (assq 'italic (plist-get info :html-text-markup-alist))) "%s")
+ contents))
;;;; Item
-(defun org-html-checkbox (checkbox)
- "Format CHECKBOX into HTML."
- (case checkbox (on "<code>[X]</code>")
- (off "<code>[&#xa0;]</code>")
- (trans "<code>[-]</code>")
- (t "")))
+(defun org-html-checkbox (checkbox info)
+ "Format CHECKBOX into HTML.
+INFO is a plist holding contextual information. See
+`org-html-checkbox-type' for customization options."
+ (cdr (assq checkbox
+ (cdr (assq (plist-get info :html-checkbox-type)
+ org-html-checkbox-types)))))
(defun org-html-format-list-item (contents type checkbox info
- &optional term-counter-id
- headline)
+ &optional term-counter-id
+ headline)
"Format a list item into HTML."
- (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))
- (br (org-html-close-tag "br" nil info)))
+ (let ((class (if checkbox
+ (format " class=\"%s\""
+ (symbol-name checkbox)) ""))
+ (checkbox (concat (org-html-checkbox checkbox info)
+ (and checkbox " ")))
+ (br (org-html-close-tag "br" nil info))
+ (extra-newline (if (and (org-string-nw-p contents) headline) "\n" "")))
(concat
- (case type
- (ordered
+ (pcase type
+ (`ordered
(let* ((counter term-counter-id)
(extra (if counter (format " value=\"%s\"" counter) "")))
(concat
- (format "<li%s>" extra)
+ (format "<li%s%s>" class extra)
(when headline (concat headline br)))))
- (unordered
+ (`unordered
(let* ((id term-counter-id)
(extra (if id (format " id=\"%s\"" id) "")))
(concat
- (format "<li%s>" extra)
+ (format "<li%s%s>" class extra)
(when headline (concat headline br)))))
- (descriptive
+ (`descriptive
(let* ((term term-counter-id))
(setq term (or term "(no term)"))
;; Check-boxes in descriptive lists are associated to tag.
- (concat (format "<dt> %s </dt>"
- (concat checkbox term))
+ (concat (format "<dt%s>%s</dt>"
+ class (concat checkbox term))
"<dd>"))))
(unless (eq type 'descriptive) checkbox)
- contents
- (case type
- (ordered "</li>")
- (unordered "</li>")
- (descriptive "</dd>")))))
+ extra-newline
+ (and (org-string-nw-p contents) (org-trim contents))
+ extra-newline
+ (pcase type
+ (`ordered "</li>")
+ (`unordered "</li>")
+ (`descriptive "</dd>")))))
(defun org-html-item (item contents info)
"Transcode an ITEM element from Org to HTML.
@@ -2457,7 +2781,7 @@ contextual information."
;;;; Keyword
-(defun org-html-keyword (keyword contents info)
+(defun org-html-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -2465,13 +2789,13 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(cond
((string= key "HTML") value)
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (org-html-toc depth info)))
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (localp (string-match-p "\\<local\\>" value)))
+ (org-html-toc depth info (and localp keyword))))
((string= "listings" value) (org-html-list-of-listings info))
((string= "tables" value) (org-html-list-of-tables info))))))))
@@ -2479,10 +2803,11 @@ 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 is
-a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil
-and t. See `org-html-with-latex' for more information. INFO is
-a plist containing export properties."
+PROCESSING-TYPE designates the tool used for conversion. It can
+be `mathjax', `verbatim', 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)
(let ((bfn (or (buffer-file-name)
@@ -2497,7 +2822,7 @@ a plist containing export properties."
"\n")
"\n")))))
(setq cache-relpath
- (concat "ltxpng/"
+ (concat (file-name-as-directory org-preview-latex-image-directory)
(file-name-sans-extension
(file-name-nondirectory bfn)))
cache-dir (file-name-directory bfn))
@@ -2507,57 +2832,60 @@ a plist containing export properties."
(setq latex-frag (concat latex-header latex-frag))))
(with-temp-buffer
(insert latex-frag)
- (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..."
- nil nil processing-type)
+ (org-format-latex cache-relpath nil nil cache-dir nil
+ "Creating LaTeX Image..." nil processing-type)
(buffer-string))))
-(defun org-html-latex-environment (latex-environment contents info)
+(defun org-html-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((processing-type (plist-get info :with-latex))
(latex-frag (org-remove-indentation
(org-element-property :value latex-environment)))
(attributes (org-export-read-attribute :attr_html latex-environment)))
- (case processing-type
- ((t mathjax)
- (org-html-format-latex latex-frag 'mathjax info))
- ((dvipng imagemagick)
- (let ((formula-link
- (org-html-format-latex latex-frag processing-type info)))
- (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
- ;; Do not provide a caption or a name to be consistent with
- ;; `mathjax' handling.
- (org-html--wrap-image
- (org-html--format-image
- (match-string 1 formula-link) attributes info) info))))
- (t latex-frag))))
+ (cond
+ ((memq processing-type '(t mathjax))
+ (org-html-format-latex latex-frag 'mathjax 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))
+ ;; Do not provide a caption or a name to be consistent with
+ ;; `mathjax' handling.
+ (org-html--wrap-image
+ (org-html--format-image
+ (match-string 1 formula-link) attributes info) info))))
+ (t latex-frag))))
;;;; Latex Fragment
-(defun org-html-latex-fragment (latex-fragment contents info)
+(defun org-html-latex-fragment (latex-fragment _contents info)
"Transcode a LATEX-FRAGMENT object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((latex-frag (org-element-property :value latex-fragment))
(processing-type (plist-get info :with-latex)))
- (case processing-type
- ((t mathjax)
- (org-html-format-latex latex-frag 'mathjax info))
- ((dvipng imagemagick)
- (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))))
- (t latex-frag))))
+ (cond
+ ((memq processing-type '(t mathjax))
+ (org-html-format-latex latex-frag 'mathjax 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))))
+ (t latex-frag))))
;;;; Line Break
-(defun org-html-line-break (line-break contents info)
+(defun org-html-line-break (_line-break _contents info)
"Transcode a LINE-BREAK object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(concat (org-html-close-tag "br" nil info) "\n"))
;;;; Link
+(defun org-html-image-link-filter (data _backend info)
+ (org-export-insert-image-links data info org-html-inline-image-rules))
+
(defun org-html-inline-image-p (link info)
"Non-nil when LINK is meant to appear as an image.
INFO is a plist used as a communication channel. LINK is an
@@ -2565,19 +2893,20 @@ inline image when it has no description and targets an image
file (see `org-html-inline-image-rules' for more information), or
if its description is a single link targeting an image file."
(if (not (org-element-contents link))
- (org-export-inline-image-p link org-html-inline-image-rules)
+ (org-export-inline-image-p
+ link (plist-get info :html-inline-image-rules))
(not
(let ((link-count 0))
(org-element-map (org-element-contents link)
(cons 'plain-text org-element-all-objects)
(lambda (obj)
- (case (org-element-type obj)
- (plain-text (org-string-nw-p obj))
- (link (if (= link-count 1) t
- (incf link-count)
- (not (org-export-inline-image-p
- obj org-html-inline-image-rules))))
- (otherwise t)))
+ (pcase (org-element-type obj)
+ (`plain-text (org-string-nw-p obj))
+ (`link (if (= link-count 1) t
+ (cl-incf link-count)
+ (not (org-export-inline-image-p
+ obj (plist-get info :html-inline-image-rules)))))
+ (_ t)))
info t)))))
(defvar org-html-standalone-image-predicate)
@@ -2599,9 +2928,9 @@ further. For example, to check for only captioned standalone
images, set it to:
(lambda (paragraph) (org-element-property :caption paragraph))"
- (let ((paragraph (case (org-element-type element)
- (paragraph element)
- (link (org-export-get-parent element)))))
+ (let ((paragraph (pcase (org-element-type element)
+ (`paragraph element)
+ (`link (org-export-get-parent element)))))
(and (eq (org-element-type paragraph) 'paragraph)
(or (not (fboundp 'org-html-standalone-image-predicate))
(funcall org-html-standalone-image-predicate paragraph))
@@ -2609,76 +2938,71 @@ images, set it to:
(let ((link-count 0))
(org-element-map (org-element-contents paragraph)
(cons 'plain-text org-element-all-objects)
- #'(lambda (obj)
- (when (case (org-element-type obj)
- (plain-text (org-string-nw-p obj))
- (link (or (> (incf link-count) 1)
- (not (org-html-inline-image-p obj info))))
- (otherwise t))
- (throw 'exit nil)))
+ (lambda (obj)
+ (when (pcase (org-element-type obj)
+ (`plain-text (org-string-nw-p obj))
+ (`link (or (> (cl-incf link-count) 1)
+ (not (org-html-inline-image-p obj info))))
+ (_ t))
+ (throw 'exit nil)))
info nil 'link)
(= link-count 1))))))
(defun org-html-link (link desc info)
"Transcode a LINK object from Org to HTML.
-
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
- (let* ((home (when (plist-get info :html-link-home)
- (org-trim (plist-get info :html-link-home))))
- (use-abs-url (plist-get info :html-link-use-abs-url))
- (link-org-files-as-html-maybe
- (function
- (lambda (raw-path info)
- "Treat links to `file.org' as links to `file.html', if needed.
- See `org-html-link-org-files-as-html'."
- (cond
- ((and org-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)))
- (t raw-path)))))
+ (let* ((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'.
+ (cond
+ ((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)))
+ (t raw-path))))
(type (org-element-property :type link))
(raw-path (org-element-property :path link))
;; Ensure DESC really exists, or set it to nil.
(desc (org-string-nw-p desc))
(path
(cond
- ((member type '("http" "https" "ftp" "mailto"))
- (org-link-escape
- (org-link-unescape
- (concat type ":" raw-path)) org-link-escape-chars-browser))
+ ((member type '("http" "https" "ftp" "mailto" "news"))
+ (url-encode-url (org-link-unescape (concat type ":" raw-path))))
((string= type "file")
- ;; Treat links to ".org" files as ".html", if needed.
+ ;; During publishing, turn absolute file names belonging
+ ;; to base directory into relative file names. Otherwise,
+ ;; append "file" protocol to absolute file name.
(setq raw-path
- (funcall link-org-files-as-html-maybe raw-path info))
- ;; If file path is absolute, prepend it with protocol
- ;; component - "file:".
- (cond
- ((file-name-absolute-p raw-path)
- (setq raw-path (concat "file:" raw-path)))
- ((and home use-abs-url)
- (setq raw-path (concat (file-name-as-directory home) raw-path))))
+ (org-export-file-uri
+ (org-publish-file-relative-name raw-path info)))
+ ;; Possibly append `:html-link-home' to relative file
+ ;; name.
+ (let ((home (and (plist-get info :html-link-home)
+ (org-trim (plist-get info :html-link-home)))))
+ (when (and home
+ (plist-get info :html-link-use-abs-url)
+ (file-name-absolute-p raw-path))
+ (setq raw-path (concat (file-name-as-directory home) raw-path))))
+ ;; Maybe turn ".org" into ".html".
+ (setq raw-path (funcall link-org-files-as-html-maybe raw-path info))
;; Add search option, if any. A search option can be
- ;; relative to a custom-id or a headline title. Any other
- ;; option is ignored.
+ ;; relative to a custom-id, a headline title, a name or
+ ;; a target.
(let ((option (org-element-property :search-option link)))
(cond ((not option) raw-path)
- ((eq (aref option 0) ?#) (concat raw-path option))
- ;; External fuzzy link: try to resolve it if path
- ;; belongs to current project, if any.
- ((eq (aref option 0) ?*)
- (concat
- raw-path
- (let ((numbers
- (org-publish-resolve-external-fuzzy-link
- (org-element-property :path link) option)))
- (and numbers (concat "#sec-"
- (mapconcat 'number-to-string
- numbers "-"))))))
- (t raw-path))))
+ ;; Since HTML back-end use custom-id value as-is,
+ ;; resolving is them is trivial.
+ ((eq (string-to-char option) ?#) (concat raw-path option))
+ (t
+ (concat raw-path
+ "#"
+ (org-publish-resolve-external-link
+ option
+ (org-element-property :path link)))))))
(t raw-path)))
;; Extract attributes from parent's paragraph. HACK: Only do
;; this for the first link in parent (inner image link for
@@ -2695,12 +3019,14 @@ INFO is a plist holding contextual information. See
(org-export-read-attribute :attr_html parent))))
(attributes
(let ((attr (org-html--make-attribute-string attributes-plist)))
- (if (org-string-nw-p attr) (concat " " attr) "")))
- protocol)
+ (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))
;; Image file.
- ((and org-html-inline-images
- (org-export-inline-image-p link org-html-inline-image-rules))
+ ((and (plist-get info :html-inline-images)
+ (org-export-inline-image-p
+ link (plist-get info :html-inline-image-rules)))
(org-html--format-image path attributes-plist info))
;; Radio target: Transcode target's contents and use them as
;; link's description.
@@ -2708,18 +3034,18 @@ INFO is a plist holding contextual information. See
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
(format "<a href=\"#%s\"%s>%s</a>"
- (org-export-solidify-link-text
- (org-element-property :value destination))
- attributes desc))))
+ (org-export-get-reference destination info)
+ attributes
+ desc))))
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
((member type '("custom-id" "fuzzy" "id"))
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
+ (pcase (org-element-type destination)
;; ID link points to an external file.
- (plain-text
+ (`plain-text
(let ((fragment (concat "ID-" path))
;; Treat links to ".org" files as ".html", if needed.
(path (funcall link-org-files-as-html-maybe
@@ -2727,86 +3053,87 @@ INFO is a plist holding contextual information. See
(format "<a href=\"%s#%s\"%s>%s</a>"
path fragment attributes (or desc destination))))
;; Fuzzy link points nowhere.
- ((nil)
+ (`nil
(format "<i>%s</i>"
(or desc
(org-export-data
(org-element-property :raw-link link) info))))
;; Link points to a headline.
- (headline
- (let ((href
- ;; What href to use?
- (cond
- ;; Case 1: Headline is linked via it's CUSTOM_ID
- ;; property. Use CUSTOM_ID.
- ((string= type "custom-id")
- (org-element-property :CUSTOM_ID destination))
- ;; Case 2: Headline is linked via it's ID property
- ;; or through other means. Use the default href.
- ((member type '("id" "fuzzy"))
- (format "sec-%s"
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- destination info) "-")))
- (t (error "Shouldn't reach here"))))
+ (`headline
+ (let ((href (or (org-element-property :CUSTOM_ID destination)
+ (org-export-get-reference destination info)))
;; What description to use?
(desc
;; Case 1: Headline is numbered and LINK has no
;; description. Display section number.
(if (and (org-export-numbered-headline-p destination info)
(not desc))
- (mapconcat 'number-to-string
+ (mapconcat #'number-to-string
(org-export-get-headline-number
destination info) ".")
;; Case 2: Either the headline is un-numbered or
;; LINK has a custom description. Display LINK's
;; description or headline's title.
- (or desc (org-export-data (org-element-property
- :title destination) info)))))
- (format "<a href=\"#%s\"%s>%s</a>"
- (org-export-solidify-link-text href) attributes desc)))
+ (or desc
+ (org-export-data
+ (org-element-property :title destination) info)))))
+ (format "<a href=\"#%s\"%s>%s</a>" href attributes desc)))
;; Fuzzy link points to a target or an element.
- (t
- (let* ((path (org-export-solidify-link-text path))
- (org-html-standalone-image-predicate 'org-html--has-caption-p)
+ (_
+ (let* ((ref (org-export-get-reference destination info))
+ (org-html-standalone-image-predicate
+ #'org-html--has-caption-p)
(number (cond
(desc nil)
((org-html-standalone-image-p destination info)
(org-export-get-ordinal
(org-element-map destination 'link
- 'identity info t)
+ #'identity info t)
info 'link 'org-html-standalone-image-p))
(t (org-export-get-ordinal
destination info nil 'org-html--has-caption-p))))
(desc (cond (desc)
((not number) "No description for this link")
((numberp number) (number-to-string number))
- (t (mapconcat 'number-to-string number ".")))))
- (format "<a href=\"#%s\"%s>%s</a>" path attributes desc))))))
+ (t (mapconcat #'number-to-string number ".")))))
+ (format "<a href=\"#%s\"%s>%s</a>" ref attributes desc))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
- (let ((fragment (concat "coderef-" path)))
- (format "<a href=\"#%s\"%s%s>%s</a>"
+ (let ((fragment (concat "coderef-" (org-html-encode-plain-text path))))
+ (format "<a href=\"#%s\" %s%s>%s</a>"
fragment
- (org-trim
- (format (concat "class=\"coderef\""
- " onmouseover=\"CodeHighlightOn(this, '%s');\""
- " onmouseout=\"CodeHighlightOff(this, '%s');\"")
- fragment fragment))
+ (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \
+'%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
+ fragment fragment)
attributes
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))))
- ;; Link type is handled by a special function.
- ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
- (funcall protocol (org-link-unescape path) desc 'html))
;; External link with a description part.
- ((and path desc) (format "<a href=\"%s\"%s>%s</a>" path attributes desc))
+ ((and path desc) (format "<a href=\"%s\"%s>%s</a>"
+ (org-html-encode-plain-text path)
+ attributes
+ desc))
;; External link without a description part.
- (path (format "<a href=\"%s\"%s>%s</a>" path attributes path))
+ (path (let ((path (org-html-encode-plain-text path)))
+ (format "<a href=\"%s\"%s>%s</a>"
+ path
+ attributes
+ (org-link-unescape path))))
;; No path, only description. Try to do something useful.
(t (format "<i>%s</i>" desc)))))
+;;;; Node Property
+
+(defun org-html-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element from Org to HTML.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
;;;; Paragraph
(defun org-html-paragraph (paragraph contents info)
@@ -2815,13 +3142,19 @@ CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
(let* ((parent (org-export-get-parent paragraph))
(parent-type (org-element-type parent))
- (style '((footnote-definition " class=\"footpara\"")))
- (extra (or (cadr (assoc parent-type style)) "")))
+ (style '((footnote-definition " class=\"footpara\"")
+ (org-data " class=\"footpara\"")))
+ (attributes (org-html--make-attribute-string
+ (org-export-read-attribute :attr_html paragraph)))
+ (extra (or (cadr (assq parent-type style)) "")))
(cond
- ((and (eq (org-element-type parent) 'item)
- (= (org-element-property :begin paragraph)
- (org-element-property :contents-begin parent)))
- ;; Leading paragraph in a list item have no tags.
+ ((and (eq parent-type 'item)
+ (not (org-export-get-previous-element paragraph info))
+ (let ((followers (org-export-get-next-element paragraph info 2)))
+ (and (not (cdr followers))
+ (memq (org-element-type (car followers)) '(nil plain-list)))))
+ ;; First paragraph in an item has no tag if it is alone or
+ ;; followed, at most, by a sub-list.
contents)
((org-html-standalone-image-p paragraph info)
;; Standalone image.
@@ -2829,73 +3162,63 @@ the plist used as a communication channel."
(let ((raw (org-export-data
(org-export-get-caption paragraph) info))
(org-html-standalone-image-predicate
- 'org-html--has-caption-p))
+ #'org-html--has-caption-p))
(if (not (org-string-nw-p raw)) raw
- (concat
- "<span class=\"figure-number\">"
- (format (org-html--translate "Figure %d:" info)
- (org-export-get-ordinal
- (org-element-map paragraph 'link
- 'identity info t)
- info nil 'org-html-standalone-image-p))
- "</span> " raw))))
- (label (org-element-property :name paragraph)))
+ (concat "<span class=\"figure-number\">"
+ (format (org-html--translate "Figure %d:" info)
+ (org-export-get-ordinal
+ (org-element-map paragraph 'link
+ #'identity info t)
+ info nil #'org-html-standalone-image-p))
+ " </span>"
+ raw))))
+ (label (and (org-element-property :name paragraph)
+ (org-export-get-reference paragraph info))))
(org-html--wrap-image contents info caption label)))
;; Regular paragraph.
- (t (format "<p%s>\n%s</p>" extra contents)))))
+ (t (format "<p%s%s>\n%s</p>"
+ (if (org-string-nw-p attributes)
+ (concat " " attributes) "")
+ extra contents)))))
;;;; Plain List
-;; FIXME Maybe arg1 is not needed because <li value="20"> already sets
-;; the correct value for the item counter
-(defun org-html-begin-plain-list (type &optional arg1)
- "Insert the beginning of the HTML list depending on TYPE.
-When ARG1 is a string, use it as the start parameter for ordered
-lists."
- (case type
- (ordered
- (format "<ol class=\"org-ol\"%s>"
- (if arg1 (format " start=\"%d\"" arg1) "")))
- (unordered "<ul class=\"org-ul\">")
- (descriptive "<dl class=\"org-dl\">")))
-
-(defun org-html-end-plain-list (type)
- "Insert the end of the HTML list depending on TYPE."
- (case type
- (ordered "</ol>")
- (unordered "</ul>")
- (descriptive "</dl>")))
-
-(defun org-html-plain-list (plain-list contents info)
+(defun org-html-plain-list (plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to HTML.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
- (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item
- (type (org-element-property :type plain-list)))
- (format "%s\n%s%s"
- (org-html-begin-plain-list type)
- contents (org-html-end-plain-list type))))
+ (let* ((type (pcase (org-element-property :type plain-list)
+ (`ordered "ol")
+ (`unordered "ul")
+ (`descriptive "dl")
+ (other (error "Unknown HTML list type: %s" other))))
+ (class (format "org-%s" type))
+ (attributes (org-export-read-attribute :attr_html plain-list)))
+ (format "<%s %s>\n%s</%s>"
+ type
+ (org-html--make-attribute-string
+ (plist-put attributes :class
+ (org-trim
+ (mapconcat #'identity
+ (list class (plist-get attributes :class))
+ " "))))
+ contents
+ type)))
;;;; Plain Text
(defun org-html-convert-special-strings (string)
"Convert special characters in STRING to HTML."
- (let ((all org-html-special-string-regexps)
- e a re rpl start)
- (while (setq a (pop all))
- (setq re (car a) rpl (cdr a) start 0)
- (while (string-match re string start)
- (setq string (replace-match rpl t nil string))))
- string))
+ (dolist (a org-html-special-string-regexps string)
+ (let ((re (car a))
+ (rpl (cdr a)))
+ (setq string (replace-regexp-in-string re rpl string t)))))
(defun org-html-encode-plain-text (text)
"Convert plain text characters from TEXT to HTML equivalent.
Possible conversions are set in `org-html-protect-char-alist'."
- (mapc
- (lambda (pair)
- (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
- org-html-protect-char-alist)
- text)
+ (dolist (pair org-html-protect-char-alist text)
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))))
(defun org-html-plain-text (text info)
"Transcode a TEXT string from Org to HTML.
@@ -2923,60 +3246,52 @@ contextual information."
;; Planning
-(defun org-html-planning (planning contents info)
+(defun org-html-planning (planning _contents info)
"Transcode a PLANNING element from Org to HTML.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (let ((span-fmt "<span class=\"timestamp-kwd\">%s</span> <span class=\"timestamp\">%s</span>"))
- (format
- "<p><span class=\"timestamp-wrapper\">%s</span></p>"
- (mapconcat
- 'identity
- (delq nil
- (list
- (let ((closed (org-element-property :closed planning)))
- (when closed
- (format span-fmt org-closed-string
- (org-translate-time
- (org-element-property :raw-value closed)))))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline
- (format span-fmt org-deadline-string
- (org-translate-time
- (org-element-property :raw-value deadline)))))
- (let ((scheduled (org-element-property :scheduled planning)))
- (when scheduled
- (format span-fmt org-scheduled-string
- (org-translate-time
- (org-element-property :raw-value scheduled)))))))
- " "))))
+ (format
+ "<p><span class=\"timestamp-wrapper\">%s</span></p>"
+ (org-trim
+ (mapconcat
+ (lambda (pair)
+ (let ((timestamp (cdr pair)))
+ (when timestamp
+ (let ((string (car pair)))
+ (format "<span class=\"timestamp-kwd\">%s</span> \
+<span class=\"timestamp\">%s</span> "
+ string
+ (org-html-plain-text (org-timestamp-translate timestamp)
+ info))))))
+ `((,org-closed-string . ,(org-element-property :closed planning))
+ (,org-deadline-string . ,(org-element-property :deadline planning))
+ (,org-scheduled-string . ,(org-element-property :scheduled planning)))
+ ""))))
;;;; Property Drawer
-(defun org-html-property-drawer (property-drawer contents info)
+(defun org-html-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to HTML.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- ;; The property drawer isn't exported but we want separating blank
- ;; lines nonetheless.
- "")
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "<pre class=\"example\">\n%s</pre>" contents)))
;;;; 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>\n%s</blockquote>" contents))
-
-;;;; Quote Section
-
-(defun org-html-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to HTML.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format "<pre>\n%s</pre>" value))))
+ (format "<blockquote%s>\n%s</blockquote>"
+ (let* ((name (org-element-property :name quote-block))
+ (attributes (org-export-read-attribute :attr_html quote-block))
+ (a (org-html--make-attribute-string
+ (if (or (not name) (plist-member attributes :id))
+ attributes
+ (plist-put attributes :id name)))))
+ (if (org-string-nw-p a) (concat " " a) ""))
+ contents))
;;;; Section
@@ -2989,16 +3304,19 @@ holding contextual information."
(if (not parent) contents
;; Get div's class and id references.
(let* ((class-num (+ (org-export-get-relative-level parent info)
- (1- org-html-toplevel-hlevel)))
+ (1- (plist-get info :html-toplevel-hlevel))))
(section-number
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number parent info) "-")))
+ (and (org-export-numbered-headline-p parent info)
+ (mapconcat
+ #'number-to-string
+ (org-export-get-headline-number parent info) "-"))))
;; Build return value.
- (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>"
+ (format "<div class=\"outline-text-%d\" id=\"text-%s\">\n%s</div>\n"
class-num
- (or (org-element-property :CUSTOM_ID parent) section-number)
- contents)))))
+ (or (org-element-property :CUSTOM_ID parent)
+ section-number
+ (org-export-get-reference parent info))
+ (or contents ""))))))
;;;; Radio Target
@@ -3006,9 +3324,8 @@ 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 ((id (org-export-solidify-link-text
- (org-element-property :value radio-target))))
- (org-html--anchor id text)))
+ (let ((ref (org-export-get-reference radio-target info)))
+ (org-html--anchor ref text nil info)))
;;;; Special Block
@@ -3016,52 +3333,72 @@ contextual information."
"Transcode a SPECIAL-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let* ((block-type (downcase
- (org-element-property :type special-block)))
- (contents (or contents ""))
- (html5-fancy (and (org-html-html5-p info)
- (plist-get info :html-html5-fancy)
- (member block-type org-html-html5-elements)))
- (attributes (org-export-read-attribute :attr_html special-block)))
+ (let* ((block-type (org-element-property :type special-block))
+ (html5-fancy (and (org-html--html5-fancy-p info)
+ (member block-type org-html-html5-elements)))
+ (attributes (org-export-read-attribute :attr_html special-block)))
(unless html5-fancy
(let ((class (plist-get attributes :class)))
- (setq attributes (plist-put attributes :class
- (if class (concat class " " block-type)
- block-type)))))
- (setq attributes (org-html--make-attribute-string attributes))
- (when (not (equal attributes ""))
- (setq attributes (concat " " attributes)))
- (if html5-fancy
- (format "<%s%s>\n%s</%s>" block-type attributes
- contents block-type)
- (format "<div%s>\n%s\n</div>" attributes contents))))
+ (setq attributes (plist-put attributes :class
+ (if class (concat class " " block-type)
+ block-type)))))
+ (let* ((contents (or contents ""))
+ (name (org-element-property :name special-block))
+ (a (org-html--make-attribute-string
+ (if (or (not name) (plist-member attributes :id))
+ attributes
+ (plist-put attributes :id name))))
+ (str (if (org-string-nw-p a) (concat " " a) "")))
+ (if html5-fancy
+ (format "<%s%s>\n%s</%s>" block-type str contents block-type)
+ (format "<div%s>\n%s\n</div>" str contents)))))
;;;; Src Block
-(defun org-html-src-block (src-block contents info)
+(defun org-html-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(if (org-export-read-attribute :attr_html src-block :textarea)
(org-html--textarea-block src-block)
- (let ((lang (org-element-property :language src-block))
- (caption (org-export-get-caption src-block))
+ (let* ((lang (org-element-property :language src-block))
(code (org-html-format-code src-block info))
- (label (let ((lbl (org-element-property :name src-block)))
- (if (not lbl) ""
- (format " id=\"%s\""
- (org-export-solidify-link-text lbl))))))
+ (label (let ((lbl (and (org-element-property :name src-block)
+ (org-export-get-reference src-block info))))
+ (if lbl (format " id=\"%s\"" lbl) "")))
+ (klipsify (and (plist-get info :html-klipsify-src)
+ (member lang '("javascript" "js"
+ "ruby" "scheme" "clojure" "php" "html")))))
(if (not lang) (format "<pre class=\"example\"%s>\n%s</pre>" label code)
- (format
- "<div class=\"org-src-container\">\n%s%s\n</div>"
- (if (not caption) ""
- (format "<label class=\"org-src-name\">%s</label>"
- (org-export-data caption info)))
- (format "\n<pre class=\"src src-%s\"%s>%s</pre>" lang label code))))))
+ (format "<div class=\"org-src-container\">\n%s%s\n</div>"
+ ;; Build caption.
+ (let ((caption (org-export-get-caption src-block)))
+ (if (not caption) ""
+ (let ((listing-number
+ (format
+ "<span class=\"listing-number\">%s </span>"
+ (format
+ (org-html--translate "Listing %d:" info)
+ (org-export-get-ordinal
+ src-block info nil #'org-html--has-caption-p)))))
+ (format "<label class=\"org-src-name\">%s%s</label>"
+ listing-number
+ (org-trim (org-export-data caption info))))))
+ ;; Contents.
+ (if klipsify
+ (format "<pre><code class=\"src src-%s\"%s%s>%s</code></pre>"
+ lang
+ label
+ (if (string= lang "html")
+ " data-editor-type=\"html\""
+ "")
+ code)
+ (format "<pre class=\"src src-%s\"%s>%s</pre>"
+ lang label code)))))))
;;;; Statistics Cookie
-(defun org-html-statistics-cookie (statistics-cookie contents info)
+(defun org-html-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((cookie-value (org-element-property :value statistics-cookie)))
@@ -3069,16 +3406,18 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Strike-Through
-(defun org-html-strike-through (strike-through contents info)
+(defun org-html-strike-through (_strike-through contents info)
"Transcode STRIKE-THROUGH from Org to HTML.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
- (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s")
- contents))
+ (format
+ (or (cdr (assq 'strike-through (plist-get info :html-text-markup-alist)))
+ "%s")
+ contents))
;;;; Subscript
-(defun org-html-subscript (subscript contents info)
+(defun org-html-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to HTML.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3086,7 +3425,7 @@ contextual information."
;;;; Superscript
-(defun org-html-superscript (superscript contents info)
+(defun org-html-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to HTML.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3101,24 +3440,30 @@ channel."
(let* ((table-row (org-export-get-parent table-cell))
(table (org-export-get-parent-table table-cell))
(cell-attrs
- (if (not org-html-table-align-individual-fields) ""
+ (if (not (plist-get info :html-table-align-individual-fields)) ""
(format (if (and (boundp 'org-html-format-table-no-css)
org-html-format-table-no-css)
- " align=\"%s\"" " class=\"%s\"")
+ " align=\"%s\"" " class=\"org-%s\"")
(org-export-table-cell-alignment table-cell info)))))
(when (or (not contents) (string= "" (org-trim contents)))
(setq contents "&#xa0;"))
(cond
((and (org-export-table-has-header-p table info)
(= 1 (org-export-table-row-group table-row info)))
- (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs)
- contents (cdr org-html-table-header-tags)))
- ((and org-html-table-use-header-tags-for-first-column
+ (let ((header-tags (plist-get info :html-table-header-tags)))
+ (concat "\n" (format (car header-tags) "col" cell-attrs)
+ contents
+ (cdr header-tags))))
+ ((and (plist-get info :html-table-use-header-tags-for-first-column)
(zerop (cdr (org-export-table-cell-address table-cell info))))
- (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs)
- contents (cdr org-html-table-header-tags)))
- (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs)
- contents (cdr org-html-table-data-tags))))))
+ (let ((header-tags (plist-get info :html-table-header-tags)))
+ (concat "\n" (format (car header-tags) "row" cell-attrs)
+ contents
+ (cdr header-tags))))
+ (t (let ((data-tags (plist-get info :html-table-data-tags)))
+ (concat "\n" (format (car data-tags) cell-attrs)
+ contents
+ (cdr data-tags)))))))
;;;; Table Row
@@ -3129,40 +3474,45 @@ communication channel."
;; Rules are ignored since table separators are deduced from
;; borders of the current row.
(when (eq (org-element-property :type table-row) 'standard)
- (let* ((rowgroup-number (org-export-table-row-group table-row info))
- (row-number (org-export-table-row-number table-row info))
- (start-rowgroup-p
+ (let* ((group (org-export-table-row-group table-row info))
+ (number (org-export-table-row-number table-row info))
+ (start-group-p
(org-export-table-row-starts-rowgroup-p table-row info))
- (end-rowgroup-p
+ (end-group-p
(org-export-table-row-ends-rowgroup-p table-row info))
- ;; `top-row-p' and `end-rowgroup-p' are not used directly
- ;; but should be set so that `org-html-table-row-tags' can
- ;; use them (see the docstring of this variable.)
- (top-row-p (and (equal start-rowgroup-p '(top))
- (equal end-rowgroup-p '(below top))))
- (bottom-row-p (and (equal start-rowgroup-p '(above))
- (equal end-rowgroup-p '(bottom above))))
- (rowgroup-tags
+ (topp (and (equal start-group-p '(top))
+ (equal end-group-p '(below top))))
+ (bottomp (and (equal start-group-p '(above))
+ (equal end-group-p '(bottom above))))
+ (row-open-tag
+ (pcase (plist-get info :html-table-row-open-tag)
+ ((and accessor (pred functionp))
+ (funcall accessor
+ number group start-group-p end-group-p topp bottomp))
+ (accessor accessor)))
+ (row-close-tag
+ (pcase (plist-get info :html-table-row-close-tag)
+ ((and accessor (pred functionp))
+ (funcall accessor
+ number group start-group-p end-group-p topp bottomp))
+ (accessor accessor)))
+ (group-tags
(cond
- ;; Case 1: Row belongs to second or subsequent rowgroups.
- ((not (= 1 rowgroup-number))
- '("<tbody>" . "\n</tbody>"))
- ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups.
+ ;; Row belongs to second or subsequent groups.
+ ((not (= 1 group)) '("<tbody>" . "\n</tbody>"))
+ ;; Row is from first group. Table has >=1 groups.
((org-export-table-has-header-p
(org-export-get-parent-table table-row) info)
'("<thead>" . "\n</thead>"))
- ;; Case 2: Row is from first and only row group.
+ ;; Row is from first and only group.
(t '("<tbody>" . "\n</tbody>")))))
- (concat
- ;; Begin a rowgroup?
- (when start-rowgroup-p (car rowgroup-tags))
- ;; Actual table row
- (concat "\n" (eval (car org-html-table-row-tags))
- contents
- "\n"
- (eval (cdr org-html-table-row-tags)))
- ;; End a rowgroup?
- (when end-rowgroup-p (cdr rowgroup-tags))))))
+ (concat (and start-group-p (car group-tags))
+ (concat "\n"
+ row-open-tag
+ contents
+ "\n"
+ row-close-tag)
+ (and end-group-p (cdr group-tags))))))
;;;; Table
@@ -3178,7 +3528,7 @@ INFO is a plist used as a communication channel."
(if (not special-column-p) (org-element-contents table-row)
(cdr (org-element-contents table-row)))))
-(defun org-html-table--table.el-table (table info)
+(defun org-html-table--table.el-table (table _info)
"Format table.el tables into HTML.
INFO is a plist used as a communication channel."
(when (eq (org-element-property :type table) 'table.el)
@@ -3199,134 +3549,123 @@ INFO is a plist used as a communication channel."
"Transcode a TABLE element from Org to HTML.
CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
- (case (org-element-property :type table)
- ;; Case 1: table.el table. Convert it using appropriate tools.
- (table.el (org-html-table--table.el-table table info))
- ;; Case 2: Standard table.
- (t
- (let* ((label (org-element-property :name table))
- (caption (org-export-get-caption table))
- (number (org-export-get-ordinal
- table info nil 'org-html--has-caption-p))
- (attributes
- (org-html--make-attribute-string
- (org-combine-plists
- (and label (list :id (org-export-solidify-link-text label)))
- (and (not (org-html-html5-p info))
- (plist-get info :html-table-attributes))
- (org-export-read-attribute :attr_html table))))
- (alignspec
- (if (and (boundp 'org-html-format-table-no-css)
- org-html-format-table-no-css)
- "align=\"%s\"" "class=\"%s\""))
- (table-column-specs
- (function
- (lambda (table info)
- (mapconcat
- (lambda (table-cell)
- (let ((alignment (org-export-table-cell-alignment
- table-cell info)))
- (concat
- ;; Begin a colgroup?
- (when (org-export-table-cell-starts-colgroup-p
- table-cell info)
- "\n<colgroup>")
- ;; Add a column. Also specify it's alignment.
- (format "\n%s"
- (org-html-close-tag
- "col" (concat " " (format alignspec alignment)) info))
- ;; End a colgroup?
- (when (org-export-table-cell-ends-colgroup-p
- table-cell info)
- "\n</colgroup>"))))
- (org-html-table-first-row-data-cells table info) "\n")))))
- (format "<table%s>\n%s\n%s\n%s</table>"
- (if (equal attributes "") "" (concat " " attributes))
- (if (not caption) ""
- (format (if org-html-table-caption-above
- "<caption class=\"t-above\">%s</caption>"
- "<caption class=\"t-bottom\">%s</caption>")
- (concat
- "<span class=\"table-number\">"
- (format (org-html--translate "Table %d:" info) number)
- "</span> " (org-export-data caption info))))
- (funcall table-column-specs table info)
- contents)))))
+ (if (eq (org-element-property :type table) 'table.el)
+ ;; "table.el" table. Convert it using appropriate tools.
+ (org-html-table--table.el-table table info)
+ ;; Standard table.
+ (let* ((caption (org-export-get-caption table))
+ (number (org-export-get-ordinal
+ table info nil #'org-html--has-caption-p))
+ (attributes
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (and (org-element-property :name table)
+ (list :id (org-export-get-reference table info)))
+ (and (not (org-html-html5-p info))
+ (plist-get info :html-table-attributes))
+ (org-export-read-attribute :attr_html table))))
+ (alignspec
+ (if (bound-and-true-p org-html-format-table-no-css)
+ "align=\"%s\""
+ "class=\"org-%s\""))
+ (table-column-specs
+ (lambda (table info)
+ (mapconcat
+ (lambda (table-cell)
+ (let ((alignment (org-export-table-cell-alignment
+ table-cell info)))
+ (concat
+ ;; Begin a colgroup?
+ (when (org-export-table-cell-starts-colgroup-p
+ table-cell info)
+ "\n<colgroup>")
+ ;; Add a column. Also specify its alignment.
+ (format "\n%s"
+ (org-html-close-tag
+ "col" (concat " " (format alignspec alignment)) info))
+ ;; End a colgroup?
+ (when (org-export-table-cell-ends-colgroup-p
+ table-cell info)
+ "\n</colgroup>"))))
+ (org-html-table-first-row-data-cells table info) "\n"))))
+ (format "<table%s>\n%s\n%s\n%s</table>"
+ (if (equal attributes "") "" (concat " " attributes))
+ (if (not caption) ""
+ (format (if (plist-get info :html-table-caption-above)
+ "<caption class=\"t-above\">%s</caption>"
+ "<caption class=\"t-bottom\">%s</caption>")
+ (concat
+ "<span class=\"table-number\">"
+ (format (org-html--translate "Table %d:" info) number)
+ "</span> " (org-export-data caption info))))
+ (funcall table-column-specs table info)
+ contents))))
;;;; Target
-(defun org-html-target (target contents info)
+(defun org-html-target (target _contents info)
"Transcode a TARGET object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((id (org-export-solidify-link-text
- (org-element-property :value target))))
- (org-html--anchor id)))
+ (let ((ref (org-export-get-reference target info)))
+ (org-html--anchor ref nil nil info)))
;;;; Timestamp
-(defun org-html-timestamp (timestamp contents info)
+(defun org-html-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((value (org-html-plain-text
- (org-timestamp-translate timestamp) info)))
+ (let ((value (org-html-plain-text (org-timestamp-translate timestamp) info)))
(format "<span class=\"timestamp-wrapper\"><span class=\"timestamp\">%s</span></span>"
(replace-regexp-in-string "--" "&#x2013;" value))))
;;;; Underline
-(defun org-html-underline (underline contents info)
+(defun org-html-underline (_underline contents info)
"Transcode UNDERLINE from Org to HTML.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
- (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'underline (plist-get info :html-text-markup-alist)))
+ "%s")
contents))
;;;; Verbatim
-(defun org-html-verbatim (verbatim contents info)
+(defun org-html-verbatim (verbatim _contents info)
"Transcode VERBATIM from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s")
+ (format (or (cdr (assq 'verbatim (plist-get info :html-text-markup-alist))) "%s")
(org-html-encode-plain-text (org-element-property :value verbatim))))
;;;; Verse Block
-(defun org-html-verse-block (verse-block contents info)
+(defun org-html-verse-block (_verse-block contents info)
"Transcode a VERSE-BLOCK element from Org to HTML.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
- ;; Replace each newline character with line break. Also replace
- ;; each blank line with a line break.
- (setq contents (replace-regexp-in-string
- "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info))
- (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n"
- (format "%s\n" (org-html-close-tag "br" nil info)) contents)))
- ;; Replace each white space at beginning of a line with a
- ;; non-breaking space.
- (while (string-match "^[ \t]+" contents)
- (let* ((num-ws (length (match-string 0 contents)))
- (ws (let (out) (dotimes (i num-ws out)
- (setq out (concat out "&#xa0;"))))))
- (setq contents (replace-match ws nil t contents))))
- (format "<p class=\"verse\">\n%s</p>" contents))
+ (format "<p class=\"verse\">\n%s</p>"
+ ;; Replace leading white spaces with non-breaking spaces.
+ (replace-regexp-in-string
+ "^[ \t]+" (lambda (m) (org-html--make-string (length m) "&#xa0;"))
+ ;; Replace each newline character with line break. Also
+ ;; remove any trailing "br" close-tag so as to avoid
+ ;; duplicates.
+ (let* ((br (org-html-close-tag "br" nil info))
+ (re (format "\\(?:%s\\)?[ \t]*\n" (regexp-quote br))))
+ (replace-regexp-in-string re (concat br "\n") contents)))))
;;; Filter Functions
-(defun org-html-final-function (contents backend info)
+(defun org-html-final-function (contents _backend info)
"Filter to indent the HTML and convert HTML entities."
(with-temp-buffer
(insert contents)
(set-auto-mode t)
- (if org-html-indent
+ (if (plist-get info :html-indent)
(indent-region (point-min) (point-max)))
- (when org-html-use-unicode-chars
- (require 'mm-url)
- (mm-url-decode-entities))
(buffer-substring-no-properties (point-min) (point-max))))
@@ -3370,10 +3709,10 @@ is non-nil."
;;;###autoload
(defun org-html-convert-region-to-html ()
- "Assume the current region has org-mode syntax, and convert it to HTML.
+ "Assume the current region has Org syntax, and convert it to HTML.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an HTML buffer and use this
-command to convert it."
+itemized list in Org syntax in an HTML buffer and use this command
+to convert it."
(interactive)
(org-export-replace-region-by 'html))
@@ -3407,7 +3746,9 @@ file-local settings.
Return output file's name."
(interactive)
- (let* ((extension (concat "." org-html-extension))
+ (let* ((extension (concat "." (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
@@ -3424,7 +3765,8 @@ publishing directory.
Return output file name."
(org-publish-org-to 'html filename
(concat "." (or (plist-get plist :html-extension)
- org-html-extension "html"))
+ org-html-extension
+ "html"))
plist pub-dir))
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
index fe6d08a85b5..4783f1158c7 100644
--- a/lisp/org/ox-icalendar.el
+++ b/lisp/org/ox-icalendar.el
@@ -1,4 +1,4 @@
-;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine
+;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -31,7 +31,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox-ascii)
(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
@@ -46,7 +46,7 @@
(defcustom org-icalendar-combined-agenda-file "~/org.ics"
"The file name for the iCalendar file covering all agenda files.
-This file is created with the command \\[org-icalendar-combine-agenda-files].
+This file is created with the command `\\[org-icalendar-combine-agenda-files]'.
The file name should be absolute. It will be overwritten without warning."
:group 'org-export-icalendar
:type 'file)
@@ -77,7 +77,7 @@ for timed events. If non-zero, alarms are created.
(defcustom org-icalendar-exclude-tags nil
"Tags that exclude a tree from export.
This variable allows specifying different exclude tags from other
-back-ends. It can also be set with the ICAL_EXCLUDE_TAGS
+back-ends. It can also be set with the ICALENDAR_EXCLUDE_TAGS
keyword."
:group 'org-export-icalendar
:type '(repeat (string :tag "Tag")))
@@ -85,10 +85,11 @@ keyword."
(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
"Contexts where iCalendar export should use a deadline time stamp.
-This is a list with several symbols in it. Valid symbol are:
+This is a list with possibly several symbols in it. Valid symbols are:
+
`event-if-todo' Deadlines in TODO entries become calendar events.
`event-if-not-todo' Deadlines in non-TODO entries become calendar events.
-`todo-due' Use deadlines in TODO entries as due-dates"
+`todo-due' Use deadlines in TODO entries as due-dates."
:group 'org-export-icalendar
:type '(set :greedy t
(const :tag "Deadlines in non-TODO entries become events"
@@ -101,7 +102,8 @@ This is a list with several symbols in it. Valid symbol are:
(defcustom org-icalendar-use-scheduled '(todo-start)
"Contexts where iCalendar export should use a scheduling time stamp.
-This is a list with several symbols in it. Valid symbol are:
+This is a list with possibly several symbols in it. Valid symbols are:
+
`event-if-todo' Scheduling time stamps in TODO entries become an event.
`event-if-not-todo' Scheduling time stamps in non-TODO entries become an event.
`todo-start' Scheduling time stamps in TODO entries become start date.
@@ -256,11 +258,18 @@ re-read the iCalendar file.")
'((:exclude-tags
"ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split)
(:with-timestamps nil "<" org-icalendar-with-timestamps)
- (:with-vtodo nil nil org-icalendar-include-todo)
- ;; The following property will be non-nil when export has been
- ;; started from org-agenda-mode. In this case, any entry without
- ;; a non-nil "ICALENDAR_MARK" property will be ignored.
- (:icalendar-agenda-view nil nil nil))
+ ;; Other variables.
+ (:icalendar-alarm-time nil nil org-icalendar-alarm-time)
+ (:icalendar-categories nil nil org-icalendar-categories)
+ (:icalendar-date-time-format nil nil org-icalendar-date-time-format)
+ (:icalendar-include-bbdb-anniversaries nil nil org-icalendar-include-bbdb-anniversaries)
+ (:icalendar-include-body nil nil org-icalendar-include-body)
+ (:icalendar-include-sexps nil nil org-icalendar-include-sexps)
+ (:icalendar-include-todo nil nil org-icalendar-include-todo)
+ (:icalendar-store-UID nil nil org-icalendar-store-UID)
+ (:icalendar-timezone nil nil org-icalendar-timezone)
+ (:icalendar-use-deadline nil nil org-icalendar-use-deadline)
+ (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled))
:filters-alist
'((:filter-headline . org-icalendar-clear-blank-lines))
:menu-entry
@@ -275,22 +284,18 @@ re-read the iCalendar file.")
;;; Internal Functions
-(defun org-icalendar-create-uid (file &optional bell h-markers)
+(defun org-icalendar-create-uid (file &optional bell)
"Set ID property on headlines missing it in FILE.
When optional argument BELL is non-nil, inform the user with
-a message if the file was modified. With optional argument
-H-MARKERS non-nil, it is a list of markers for the headlines
-which will be updated."
- (let ((pt (if h-markers (goto-char (car h-markers)) (point-min)))
- modified-flag)
+a message if the file was modified."
+ (let (modified-flag)
(org-map-entries
(lambda ()
(let ((entry (org-element-at-point)))
- (unless (or (< (point) pt) (org-element-property :ID entry))
+ (unless (org-element-property :ID entry)
(org-id-get-create)
(setq modified-flag t)
- (forward-line))
- (when h-markers (setq org-map-continue-from (pop h-markers)))))
+ (forward-line))))
nil nil 'comment)
(when (and bell modified-flag)
(message "ID properties created in file \"%s\"" file)
@@ -318,19 +323,17 @@ A headline is blocked when either
;; Check :ORDERED: node property.
(catch 'blockedp
(let ((current headline))
- (mapc (lambda (parent)
- (cond
- ((not (org-element-property :todo-keyword parent))
- (throw 'blockedp nil))
- ((org-not-nil (org-element-property :ORDERED parent))
- (let ((sibling current))
- (while (setq sibling (org-export-get-previous-element
- sibling info))
- (when (eq (org-element-property :todo-type sibling) 'todo)
- (throw 'blockedp t)))))
- (t (setq current parent))))
- (org-export-get-genealogy headline))
- nil))))
+ (dolist (parent (org-element-lineage headline))
+ (cond
+ ((not (org-element-property :todo-keyword parent))
+ (throw 'blockedp nil))
+ ((org-not-nil (org-element-property :ORDERED parent))
+ (let ((sibling current))
+ (while (setq sibling (org-export-get-previous-element
+ sibling info))
+ (when (eq (org-element-property :todo-type sibling) 'todo)
+ (throw 'blockedp t)))))
+ (t (setq current parent))))))))
(defun org-icalendar-use-UTC-date-time-p ()
"Non-nil when `org-icalendar-date-time-format' requires UTC time."
@@ -338,7 +341,7 @@ A headline is blocked when either
(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 utc)
+(defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz)
"Convert TIMESTAMP to iCalendar format.
TIMESTAMP is a timestamp object. KEYWORD is added in front of
@@ -349,8 +352,11 @@ Also increase the hour by two (if time string contains a time),
or the day by one (if it does not contain a time) when no
explicit ending time is specified.
-When optional argument UTC is non-nil, time will be expressed in
-Universal Time, ignoring `org-icalendar-date-time-format'."
+When optional argument TZ is non-nil, timezone data time will be
+added to the timestamp. It can be the string \"UTC\", to use UTC
+time, or a string in the IANA TZ database
+format (e.g. \"Europe/London\"). In either case, the value of
+`org-icalendar-date-time-format' will be ignored."
(let* ((year-start (org-element-property :year-start timestamp))
(year-end (org-element-property :year-end timestamp))
(month-start (org-element-property :month-start timestamp))
@@ -384,8 +390,9 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
(concat
keyword
(format-time-string
- (cond (utc ":%Y%m%dT%H%M%SZ")
+ (cond ((string-equal tz "UTC") ":%Y%m%dT%H%M%SZ")
((not with-time-p) ";VALUE=DATE:%Y%m%d")
+ ((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S"))
(t (replace-regexp-in-string "%Z"
org-icalendar-timezone
org-icalendar-date-time-format
@@ -393,8 +400,11 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
;; Convert timestamp into internal time in order to use
;; `format-time-string' and fix any mistake (i.e. MI >= 60).
(encode-time 0 mi h d m y)
- (not (not (or utc (and with-time-p
- (org-icalendar-use-UTC-date-time-p)))))))))
+ (and (or (string-equal tz "UTC")
+ (and (null tz)
+ with-time-p
+ (org-icalendar-use-UTC-date-time-p)))
+ t)))))
(defun org-icalendar-dtstamp ()
"Return DTSTAMP property, as a string."
@@ -405,27 +415,25 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
ENTRY is a headline or an inlinetask element. INFO is a plist
used as a communication channel."
(mapconcat
- 'identity
+ #'identity
(org-uniquify
(let (categories)
- (mapc (lambda (type)
- (case type
- (category
- (push (org-export-get-category entry info) categories))
- (todo-state
- (let ((todo (org-element-property :todo-keyword entry)))
- (and todo (push todo categories))))
- (local-tags
- (setq categories
- (append (nreverse (org-export-get-tags entry info))
- categories)))
- (all-tags
- (setq categories
- (append (nreverse (org-export-get-tags entry info nil t))
- categories)))))
- org-icalendar-categories)
- ;; Return list of categories, following specified order.
- (nreverse categories))) ","))
+ (dolist (type org-icalendar-categories (nreverse categories))
+ (cl-case type
+ (category
+ (push (org-export-get-category entry info) categories))
+ (todo-state
+ (let ((todo (org-element-property :todo-keyword entry)))
+ (and todo (push todo categories))))
+ (local-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info))
+ categories)))
+ (all-tags
+ (setq categories
+ (append (nreverse (org-export-get-tags entry info nil t))
+ categories)))))))
+ ","))
(defun org-icalendar-transcode-diary-sexp (sexp uid summary)
"Transcode a diary sexp into iCalendar format.
@@ -457,7 +465,7 @@ or subject for the event."
(mapconcat
(lambda (line)
;; Limit each line to a maximum of 75 characters. If it is
- ;; longer, fold it by using "\n " as a continuation marker.
+ ;; longer, fold it by using "\r\n " as a continuation marker.
(let ((len (length line)))
(if (<= len 75) line
(let ((folded-line (substring line 0 75))
@@ -467,17 +475,17 @@ or subject for the event."
;; line, real contents must be split at 74 chars.
(while (< (setq chunk-end (+ chunk-start 74)) len)
(setq folded-line
- (concat folded-line "\n "
+ (concat folded-line "\r\n "
(substring line chunk-start chunk-end))
chunk-start chunk-end))
- (concat folded-line "\n " (substring line chunk-start))))))
- (org-split-string s "\n") "\n")))
+ (concat folded-line "\r\n " (substring line chunk-start))))))
+ (org-split-string s "\n") "\r\n")))
;;; Filters
-(defun org-icalendar-clear-blank-lines (headline back-end info)
+(defun org-icalendar-clear-blank-lines (headline _back-end _info)
"Remove blank lines in HEADLINE export.
HEADLINE is a string representing a transcoded headline.
BACK-END and INFO are ignored."
@@ -522,99 +530,102 @@ inlinetask within the section."
(cons 'org-data
(cons nil (org-element-contents first))))))))
(concat
- (unless (and (plist-get info :icalendar-agenda-view)
- (not (org-element-property :ICALENDAR-MARK entry)))
- (let ((todo-type (org-element-property :todo-type entry))
- (uid (or (org-element-property :ID entry) (org-id-new)))
- (summary (org-icalendar-cleanup-string
- (or (org-element-property :SUMMARY entry)
- (org-export-data
- (org-element-property :title entry) info))))
- (loc (org-icalendar-cleanup-string
- (org-element-property :LOCATION entry)))
- ;; Build description of the entry from associated
- ;; section (headline) or contents (inlinetask).
- (desc
- (org-icalendar-cleanup-string
- (or (org-element-property :DESCRIPTION entry)
- (let ((contents (org-export-data inside info)))
- (cond
- ((not (org-string-nw-p contents)) nil)
- ((wholenump org-icalendar-include-body)
- (let ((contents (org-trim contents)))
- (substring
- contents 0 (min (length contents)
- org-icalendar-include-body))))
- (org-icalendar-include-body (org-trim contents)))))))
- (cat (org-icalendar-get-categories entry info)))
- (concat
- ;; Events: Delegate to `org-icalendar--vevent' to
- ;; generate "VEVENT" component from scheduled, deadline,
- ;; or any timestamp in the entry.
- (let ((deadline (org-element-property :deadline entry)))
- (and deadline
- (memq (if todo-type 'event-if-todo 'event-if-not-todo)
- org-icalendar-use-deadline)
- (org-icalendar--vevent
- entry deadline (concat "DL-" uid)
- (concat "DL: " summary) loc desc cat)))
- (let ((scheduled (org-element-property :scheduled entry)))
- (and scheduled
- (memq (if todo-type 'event-if-todo 'event-if-not-todo)
- org-icalendar-use-scheduled)
- (org-icalendar--vevent
- entry scheduled (concat "SC-" uid)
- (concat "S: " summary) loc desc cat)))
- ;; When collecting plain timestamps from a headline and
- ;; its title, skip inlinetasks since collection will
- ;; happen once ENTRY is one of them.
+ (let ((todo-type (org-element-property :todo-type entry))
+ (uid (or (org-element-property :ID entry) (org-id-new)))
+ (summary (org-icalendar-cleanup-string
+ (or (org-element-property :SUMMARY entry)
+ (org-export-data
+ (org-element-property :title entry) info))))
+ (loc (org-icalendar-cleanup-string
+ (org-export-get-node-property
+ :LOCATION entry
+ (org-property-inherit-p "LOCATION"))))
+ ;; Build description of the entry from associated section
+ ;; (headline) or contents (inlinetask).
+ (desc
+ (org-icalendar-cleanup-string
+ (or (org-element-property :DESCRIPTION entry)
+ (let ((contents (org-export-data inside info)))
+ (cond
+ ((not (org-string-nw-p contents)) nil)
+ ((wholenump org-icalendar-include-body)
+ (let ((contents (org-trim contents)))
+ (substring
+ contents 0 (min (length contents)
+ org-icalendar-include-body))))
+ (org-icalendar-include-body (org-trim contents)))))))
+ (cat (org-icalendar-get-categories entry info))
+ (tz (org-export-get-node-property
+ :TIMEZONE entry
+ (org-property-inherit-p "TIMEZONE"))))
+ (concat
+ ;; Events: Delegate to `org-icalendar--vevent' to generate
+ ;; "VEVENT" component from scheduled, deadline, or any
+ ;; timestamp in the entry.
+ (let ((deadline (org-element-property :deadline entry)))
+ (and deadline
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-deadline)
+ (org-icalendar--vevent
+ entry deadline (concat "DL-" uid)
+ (concat "DL: " summary) loc desc cat tz)))
+ (let ((scheduled (org-element-property :scheduled entry)))
+ (and scheduled
+ (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+ org-icalendar-use-scheduled)
+ (org-icalendar--vevent
+ entry scheduled (concat "SC-" uid)
+ (concat "S: " summary) loc desc cat tz)))
+ ;; When collecting plain timestamps from a headline and its
+ ;; title, skip inlinetasks since collection will happen once
+ ;; ENTRY is one of them.
+ (let ((counter 0))
+ (mapconcat
+ #'identity
+ (org-element-map (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'timestamp
+ (lambda (ts)
+ (when (let ((type (org-element-property :type ts)))
+ (cl-case (plist-get info :with-timestamps)
+ (active (memq type '(active active-range)))
+ (inactive (memq type '(inactive inactive-range)))
+ ((t) t)))
+ (let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
+ (org-icalendar--vevent
+ entry ts uid summary loc desc cat tz))))
+ info nil (and (eq type 'headline) 'inlinetask))
+ ""))
+ ;; Task: First check if it is appropriate to export it. If
+ ;; so, call `org-icalendar--vtodo' to transcode it into
+ ;; a "VTODO" component.
+ (when (and todo-type
+ (cl-case (plist-get info :icalendar-include-todo)
+ (all t)
+ (unblocked
+ (and (eq type 'headline)
+ (not (org-icalendar-blocked-headline-p
+ entry info))))
+ ((t) (eq todo-type 'todo))))
+ (org-icalendar--vtodo entry uid summary loc desc cat tz))
+ ;; Diary-sexp: Collect every diary-sexp element within ENTRY
+ ;; and its title, and transcode them. If ENTRY is
+ ;; a headline, skip inlinetasks: they will be handled
+ ;; separately.
+ (when org-icalendar-include-sexps
(let ((counter 0))
- (mapconcat
- #'identity
- (org-element-map (cons (org-element-property :title entry)
- (org-element-contents inside))
- 'timestamp
- (lambda (ts)
- (when (let ((type (org-element-property :type ts)))
- (case (plist-get info :with-timestamps)
- (active (memq type '(active active-range)))
- (inactive (memq type '(inactive inactive-range)))
- ((t) t)))
- (let ((uid (format "TS%d-%s" (incf counter) uid)))
- (org-icalendar--vevent
- entry ts uid summary loc desc cat))))
- info nil (and (eq type 'headline) 'inlinetask))
- ""))
- ;; Task: First check if it is appropriate to export it.
- ;; If so, call `org-icalendar--vtodo' to transcode it
- ;; into a "VTODO" component.
- (when (and todo-type
- (case (plist-get info :with-vtodo)
- (all t)
- (unblocked
- (and (eq type 'headline)
- (not (org-icalendar-blocked-headline-p
- entry info))))
- ((t) (eq todo-type 'todo))))
- (org-icalendar--vtodo entry uid summary loc desc cat))
- ;; Diary-sexp: Collect every diary-sexp element within
- ;; ENTRY and its title, and transcode them. If ENTRY is
- ;; a headline, skip inlinetasks: they will be handled
- ;; separately.
- (when org-icalendar-include-sexps
- (let ((counter 0))
- (mapconcat #'identity
- (org-element-map
- (cons (org-element-property :title entry)
- (org-element-contents inside))
- 'diary-sexp
- (lambda (sexp)
- (org-icalendar-transcode-diary-sexp
- (org-element-property :value sexp)
- (format "DS%d-%s" (incf counter) uid)
- summary))
- info nil (and (eq type 'headline) 'inlinetask))
- ""))))))
+ (mapconcat #'identity
+ (org-element-map
+ (cons (org-element-property :title entry)
+ (org-element-contents inside))
+ 'diary-sexp
+ (lambda (sexp)
+ (org-icalendar-transcode-diary-sexp
+ (org-element-property :value sexp)
+ (format "DS%d-%s" (cl-incf counter) uid)
+ summary))
+ info nil (and (eq type 'headline) 'inlinetask))
+ "")))))
;; If ENTRY is a headline, call current function on every
;; inlinetask within it. In agenda export, this is independent
;; from the mark (or lack thereof) on the entry.
@@ -627,7 +638,7 @@ inlinetask within the section."
contents))))
(defun org-icalendar--vevent
- (entry timestamp uid summary location description categories)
+ (entry timestamp uid summary location description categories timezone)
"Create a VEVENT component.
ENTRY is either a headline or an inlinetask element. TIMESTAMP
@@ -636,7 +647,8 @@ is the unique identifier for the event. SUMMARY defines a short
summary or subject for the event. LOCATION defines the intended
venue for the event. DESCRIPTION provides the complete
description of the event. CATEGORIES defines the categories the
-event belongs to.
+event belongs to. TIMEZONE specifies a time zone for this event
+only.
Return VEVENT component as a string."
(org-icalendar-fold-string
@@ -646,12 +658,12 @@ Return VEVENT component as a string."
(concat "BEGIN:VEVENT\n"
(org-icalendar-dtstamp) "\n"
"UID:" uid "\n"
- (org-icalendar-convert-timestamp timestamp "DTSTART") "\n"
- (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n"
+ (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n"
+ (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n"
;; RRULE.
(when (org-element-property :repeater-type timestamp)
(format "RRULE:FREQ=%s;INTERVAL=%d\n"
- (case (org-element-property :repeater-unit timestamp)
+ (cl-case (org-element-property :repeater-unit timestamp)
(hour "HOURLY") (day "DAILY") (week "WEEKLY")
(month "MONTHLY") (year "YEARLY"))
(org-element-property :repeater-value timestamp)))
@@ -665,7 +677,7 @@ Return VEVENT component as a string."
"END:VEVENT"))))
(defun org-icalendar--vtodo
- (entry uid summary location description categories)
+ (entry uid summary location description categories timezone)
"Create a VTODO component.
ENTRY is either a headline or an inlinetask element. UID is the
@@ -673,6 +685,7 @@ unique identifier for the task. SUMMARY defines a short summary
or subject for the task. LOCATION defines the intended venue for
the task. DESCRIPTION provides the complete description of the
task. CATEGORIES defines the categories the task belongs to.
+TIMEZONE specifies a time zone for this TODO only.
Return VTODO component as a string."
(let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled)
@@ -691,11 +704,11 @@ Return VTODO component as a string."
(concat "BEGIN:VTODO\n"
"UID:TODO-" uid "\n"
(org-icalendar-dtstamp) "\n"
- (org-icalendar-convert-timestamp start "DTSTART") "\n"
+ (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n"
(and (memq 'todo-due org-icalendar-use-deadline)
(org-element-property :deadline entry)
(concat (org-icalendar-convert-timestamp
- (org-element-property :deadline entry) "DUE")
+ (org-element-property :deadline entry) "DUE" nil timezone)
"\n"))
"SUMMARY:" summary "\n"
(and (org-string-nw-p location) (format "LOCATION:%s\n" location))
@@ -821,7 +834,8 @@ Return ICS file name."
;; links will not be collected at the end of sections.
(let ((outfile (org-export-output-file-name ".ics" subtreep)))
(org-export-to-file 'icalendar outfile
- async subtreep visible-only body-only '(:ascii-charset utf-8)
+ async subtreep visible-only body-only
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil)
(lambda (file)
(run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
@@ -835,27 +849,23 @@ external process."
;; Asynchronous export is not interactive, so we will not call
;; `org-check-agenda-file'. Instead we remove any non-existent
;; agenda file from the list.
- (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
(org-export-async-start
(lambda (results)
- (mapc (lambda (f) (org-export-add-to-stack f 'icalendar))
- results))
+ (dolist (f results) (org-export-add-to-stack f 'icalendar)))
`(let (output-files)
- (mapc (lambda (file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (push (expand-file-name (org-icalendar-export-to-ics))
- output-files)))
- ',files)
- output-files)))
+ (dolist (file ',files outputfiles)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (push (expand-file-name (org-icalendar-export-to-ics))
+ output-files))))))
(let ((files (org-agenda-files t)))
(org-agenda-prepare-buffers files)
(unwind-protect
- (mapc (lambda (file)
- (catch 'nextfile
- (org-check-agenda-file file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (org-icalendar-export-to-ics))))
- files)
+ (dolist (file files)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (org-icalendar-export-to-ics))))
(org-release-buffers org-agenda-new-buffers)))))
;;;###autoload
@@ -870,110 +880,94 @@ The file is stored under the name chosen in
`org-icalendar-combined-agenda-file'."
(interactive)
(if async
- (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+ (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
(org-export-async-start
- (lambda (dummy)
+ (lambda (_)
(org-export-add-to-stack
(expand-file-name org-icalendar-combined-agenda-file)
'icalendar))
- `(apply 'org-icalendar--combine-files nil ',files)))
- (apply 'org-icalendar--combine-files nil (org-agenda-files t))))
+ `(apply #'org-icalendar--combine-files ',files)))
+ (apply #'org-icalendar--combine-files (org-agenda-files t))))
(defun org-icalendar-export-current-agenda (file)
"Export current agenda view to an iCalendar FILE.
This function assumes major mode for current buffer is
`org-agenda-mode'."
- (let (org-export-babel-evaluate ; Don't evaluate Babel block
- (org-icalendar-combined-agenda-file file)
- (marker-list
- ;; Collect the markers pointing to entries in the current
- ;; agenda buffer.
- (let (markers)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let ((m (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))))
- (and m (push m markers)))
- (beginning-of-line 2)))
- (nreverse markers))))
- (apply 'org-icalendar--combine-files
- ;; Build restriction alist.
- (let (restriction)
- ;; Sort markers in each association within RESTRICTION.
- (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
- (dolist (m marker-list restriction)
- (let* ((pos (marker-position m))
- (file (buffer-file-name
- (org-base-buffer (marker-buffer m))))
- (file-markers (assoc file restriction)))
- ;; Add POS in FILE association if one exists
- ;; or create a new association for FILE.
- (if file-markers (push pos (cdr file-markers))
- (push (list file pos) restriction))))))
- (org-agenda-files nil 'ifmode))))
-
-(defun org-icalendar--combine-files (restriction &rest files)
+ (let* ((org-export-use-babel) ;don't evaluate Babel blocks
+ (contents
+ (org-export-string-as
+ (with-output-to-string
+ (save-excursion
+ (let ((p (point-min))
+ (seen nil)) ;prevent duplicates
+ (while (setq p (next-single-property-change p 'org-hd-marker))
+ (let ((m (get-text-property p 'org-hd-marker)))
+ (when (and m (not (member m seen)))
+ (push m seen)
+ (with-current-buffer (marker-buffer m)
+ (org-with-wide-buffer
+ (goto-char (marker-position m))
+ (princ
+ (org-element-normalize-string
+ (buffer-substring (point)
+ (org-entry-end-position))))))))
+ (forward-line)))))
+ 'icalendar t
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil
+ :icalendar-include-todo all))))
+ (with-temp-file file
+ (insert
+ (org-icalendar--vcalendar
+ org-icalendar-combined-name
+ user-full-name
+ (or (org-string-nw-p org-icalendar-timezone) (cadr (current-time-zone)))
+ org-icalendar-combined-description
+ contents)))
+ (run-hook-with-args 'org-icalendar-after-save-hook file)))
+
+(defun org-icalendar--combine-files (&rest files)
"Combine entries from multiple files into an iCalendar file.
-RESTRICTION, when non-nil, is an alist where key is a file name
-and value a list of buffer positions pointing to entries that
-should appear in the calendar. It only makes sense if the
-function was called from an agenda buffer. FILES is a list of
-files to build the calendar from."
- (org-agenda-prepare-buffers files)
- (unwind-protect
- (progn
- (with-temp-file org-icalendar-combined-agenda-file
- (insert
- (org-icalendar--vcalendar
- ;; Name.
- org-icalendar-combined-name
- ;; Owner.
- user-full-name
- ;; Timezone.
- (or (org-string-nw-p org-icalendar-timezone)
- (cadr (current-time-zone)))
- ;; Description.
- org-icalendar-combined-description
- ;; Contents.
- (concat
- ;; Agenda contents.
- (mapconcat
- (lambda (file)
- (catch 'nextfile
- (org-check-agenda-file file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (let ((marks (cdr (assoc (expand-file-name file)
- restriction))))
+FILES is a list of files to build the calendar from."
+ ;; At the end of the process, all buffers related to FILES are going
+ ;; to be killed. Make sure to only kill the ones opened in the
+ ;; process.
+ (let ((org-agenda-new-buffers nil))
+ (unwind-protect
+ (progn
+ (with-temp-file org-icalendar-combined-agenda-file
+ (insert
+ (org-icalendar--vcalendar
+ ;; Name.
+ org-icalendar-combined-name
+ ;; Owner.
+ user-full-name
+ ;; Timezone.
+ (or (org-string-nw-p org-icalendar-timezone)
+ (cadr (current-time-zone)))
+ ;; Description.
+ org-icalendar-combined-description
+ ;; Contents.
+ (concat
+ ;; Agenda contents.
+ (mapconcat
+ (lambda (file)
+ (catch 'nextfile
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
;; Create ID if necessary.
(when org-icalendar-store-UID
- (org-icalendar-create-uid file t marks))
- (unless (and restriction (not marks))
- ;; Add a hook adding :ICALENDAR_MARK: property
- ;; to each entry appearing in agenda view.
- ;; Use `apply-partially' because the function
- ;; still has to accept one argument.
- (let ((org-export-before-processing-hook
- (cons (apply-partially
- (lambda (m-list dummy)
- (mapc (lambda (m)
- (org-entry-put
- m "ICALENDAR-MARK" "t"))
- m-list))
- (sort marks '>))
- org-export-before-processing-hook)))
- (org-export-as
- 'icalendar nil nil t
- (list :ascii-charset 'utf-8
- :icalendar-agenda-view restriction))))))))
- files "")
- ;; BBDB anniversaries.
- (when (and org-icalendar-include-bbdb-anniversaries
- (require 'org-bbdb nil t))
- (with-output-to-string (org-bbdb-anniv-export-ical)))))))
- (run-hook-with-args 'org-icalendar-after-save-hook
- org-icalendar-combined-agenda-file))
- (org-release-buffers org-agenda-new-buffers)))
+ (org-icalendar-create-uid file t))
+ (org-export-as
+ 'icalendar nil nil t
+ '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
+ files "")
+ ;; BBDB anniversaries.
+ (when (and org-icalendar-include-bbdb-anniversaries
+ (require 'org-bbdb nil t))
+ (with-output-to-string (org-bbdb-anniv-export-ical)))))))
+ (run-hook-with-args 'org-icalendar-after-save-hook
+ org-icalendar-combined-agenda-file))
+ (org-release-buffers org-agenda-new-buffers))))
(provide 'ox-icalendar)
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index 3eee86a3ae7..61b6b8cca92 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -1,4 +1,4 @@
-;;; ox-latex.el --- LaTeX Back-End for Org Export Engine
+;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -26,7 +26,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox)
(require 'ox-publish)
@@ -43,8 +43,6 @@
(center-block . org-latex-center-block)
(clock . org-latex-clock)
(code . org-latex-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-latex-drawer)
(dynamic-block . org-latex-dynamic-block)
(entity . org-latex-entity)
@@ -65,13 +63,13 @@
(latex-fragment . org-latex-latex-fragment)
(line-break . org-latex-line-break)
(link . org-latex-link)
+ (node-property . org-latex-node-property)
(paragraph . org-latex-paragraph)
(plain-list . org-latex-plain-list)
(plain-text . org-latex-plain-text)
(planning . org-latex-planning)
- (property-drawer . (lambda (&rest args) ""))
+ (property-drawer . org-latex-property-drawer)
(quote-block . org-latex-quote-block)
- (quote-section . org-latex-quote-section)
(radio-target . org-latex-radio-target)
(section . org-latex-section)
(special-block . org-latex-special-block)
@@ -88,8 +86,10 @@
(timestamp . org-latex-timestamp)
(underline . org-latex-underline)
(verbatim . org-latex-verbatim)
- (verse-block . org-latex-verse-block))
- :export-block '("LATEX" "TEX")
+ (verse-block . org-latex-verse-block)
+ ;; Pseudo objects and elements.
+ (latex-math-block . org-latex-math-block)
+ (latex-matrices . org-latex-matrices))
:menu-entry
'(?l "Export to LaTeX"
((?L "As LaTeX buffer" org-latex-export-as-latex)
@@ -99,13 +99,58 @@
(lambda (a s v b)
(if a (org-latex-export-to-pdf t s v b)
(org-open-file (org-latex-export-to-pdf nil s v b)))))))
- :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
- (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
- (:latex-header "LATEX_HEADER" nil nil newline)
- (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
- (:latex-hyperref-p nil "texht" org-latex-with-hyperref t)
- ;; Redefine regular options.
- (:date "DATE" nil "\\today" t)))
+ :filters-alist '((:filter-options . org-latex-math-block-options-filter)
+ (:filter-paragraph . org-latex-clean-invalid-line-breaks)
+ (:filter-parse-tree org-latex-math-block-tree-filter
+ org-latex-matrices-tree-filter
+ org-latex-image-link-filter)
+ (:filter-verse-block . org-latex-clean-invalid-line-breaks))
+ :options-alist
+ '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
+ (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
+ (:latex-header "LATEX_HEADER" nil nil newline)
+ (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
+ (:description "DESCRIPTION" nil nil parse)
+ (:keywords "KEYWORDS" nil nil parse)
+ (:subtitle "SUBTITLE" nil nil parse)
+ ;; Other variables.
+ (:latex-active-timestamp-format nil nil org-latex-active-timestamp-format)
+ (:latex-caption-above nil nil org-latex-caption-above)
+ (:latex-classes nil nil org-latex-classes)
+ (:latex-default-figure-position nil nil org-latex-default-figure-position)
+ (:latex-default-table-environment nil nil org-latex-default-table-environment)
+ (:latex-default-table-mode nil nil org-latex-default-table-mode)
+ (:latex-diary-timestamp-format nil nil org-latex-diary-timestamp-format)
+ (:latex-footnote-defined-format nil nil org-latex-footnote-defined-format)
+ (:latex-footnote-separator nil nil org-latex-footnote-separator)
+ (:latex-format-drawer-function nil nil org-latex-format-drawer-function)
+ (:latex-format-headline-function nil nil org-latex-format-headline-function)
+ (:latex-format-inlinetask-function nil nil org-latex-format-inlinetask-function)
+ (:latex-hyperref-template nil nil org-latex-hyperref-template t)
+ (:latex-image-default-height nil nil org-latex-image-default-height)
+ (:latex-image-default-option nil nil org-latex-image-default-option)
+ (:latex-image-default-width nil nil org-latex-image-default-width)
+ (:latex-images-centered nil nil org-latex-images-centered)
+ (:latex-inactive-timestamp-format nil nil org-latex-inactive-timestamp-format)
+ (:latex-inline-image-rules nil nil org-latex-inline-image-rules)
+ (:latex-link-with-unknown-path-format nil nil org-latex-link-with-unknown-path-format)
+ (:latex-listings nil nil org-latex-listings)
+ (:latex-listings-langs nil nil org-latex-listings-langs)
+ (:latex-listings-options nil nil org-latex-listings-options)
+ (:latex-minted-langs nil nil org-latex-minted-langs)
+ (:latex-minted-options nil nil org-latex-minted-options)
+ (:latex-prefer-user-labels nil nil org-latex-prefer-user-labels)
+ (:latex-subtitle-format nil nil org-latex-subtitle-format)
+ (:latex-subtitle-separate nil nil org-latex-subtitle-separate)
+ (:latex-table-scientific-notation nil nil org-latex-table-scientific-notation)
+ (:latex-tables-booktabs nil nil org-latex-tables-booktabs)
+ (:latex-tables-centered nil nil org-latex-tables-centered)
+ (:latex-text-markup-alist nil nil org-latex-text-markup-alist)
+ (:latex-title-command nil nil org-latex-title-command)
+ (:latex-toc-command nil nil org-latex-toc-command)
+ (:latex-compiler "LATEX_COMPILER" nil org-latex-compiler)
+ ;; Redefine regular options.
+ (:date "DATE" nil "\\today" parse)))
@@ -164,11 +209,112 @@
("uk" . "ukrainian"))
"Alist between language code and corresponding Babel option.")
+(defconst org-latex-polyglossia-language-alist
+ '(("am" "amharic")
+ ("ast" "asturian")
+ ("ar" "arabic")
+ ("bo" "tibetan")
+ ("bn" "bengali")
+ ("bg" "bulgarian")
+ ("br" "breton")
+ ("bt-br" "brazilian")
+ ("ca" "catalan")
+ ("cop" "coptic")
+ ("cs" "czech")
+ ("cy" "welsh")
+ ("da" "danish")
+ ("de" "german" "german")
+ ("de-at" "german" "austrian")
+ ("de-de" "german" "german")
+ ("dv" "divehi")
+ ("el" "greek")
+ ("en" "english" "usmax")
+ ("en-au" "english" "australian")
+ ("en-gb" "english" "uk")
+ ("en-nz" "english" "newzealand")
+ ("en-us" "english" "usmax")
+ ("eo" "esperanto")
+ ("es" "spanish")
+ ("et" "estonian")
+ ("eu" "basque")
+ ("fa" "farsi")
+ ("fi" "finnish")
+ ("fr" "french")
+ ("fu" "friulan")
+ ("ga" "irish")
+ ("gd" "scottish")
+ ("gl" "galician")
+ ("he" "hebrew")
+ ("hi" "hindi")
+ ("hr" "croatian")
+ ("hu" "magyar")
+ ("hy" "armenian")
+ ("id" "bahasai")
+ ("ia" "interlingua")
+ ("is" "icelandic")
+ ("it" "italian")
+ ("kn" "kannada")
+ ("la" "latin" "modern")
+ ("la-modern" "latin" "modern")
+ ("la-classic" "latin" "classic")
+ ("la-medieval" "latin" "medieval")
+ ("lo" "lao")
+ ("lt" "lithuanian")
+ ("lv" "latvian")
+ ("mr" "maranthi")
+ ("ml" "malayalam")
+ ("nl" "dutch")
+ ("nb" "norsk")
+ ("nn" "nynorsk")
+ ("nko" "nko")
+ ("no" "norsk")
+ ("oc" "occitan")
+ ("pl" "polish")
+ ("pms" "piedmontese")
+ ("pt" "portuges")
+ ("rm" "romansh")
+ ("ro" "romanian")
+ ("ru" "russian")
+ ("sa" "sanskrit")
+ ("hsb" "usorbian")
+ ("dsb" "lsorbian")
+ ("sk" "slovak")
+ ("sl" "slovenian")
+ ("se" "samin")
+ ("sq" "albanian")
+ ("sr" "serbian")
+ ("sv" "swedish")
+ ("syr" "syriac")
+ ("ta" "tamil")
+ ("te" "telugu")
+ ("th" "thai")
+ ("tk" "turkmen")
+ ("tr" "turkish")
+ ("uk" "ukrainian")
+ ("ur" "urdu")
+ ("vi" "vietnamese"))
+ "Alist between language code and corresponding Polyglossia option")
+
+
+
(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
- ("qbordermatrix" . "\\cr")
- ("kbordermatrix" . "\\\\"))
+ ("qbordermatrix" . "\\cr")
+ ("kbordermatrix" . "\\\\"))
"Alist between matrix macros and their row ending.")
+(defconst org-latex-math-environments-re
+ (format
+ "\\`[ \t]*\\\\begin{%s\\*?}"
+ (regexp-opt
+ '("equation" "eqnarray" "math" "displaymath"
+ "align" "gather" "multline" "flalign" "alignat"
+ "xalignat" "xxalignat"
+ "subequations"
+ ;; breqn
+ "dmath" "dseries" "dgroup" "darray"
+ ;; empheq
+ "empheq")))
+ "Regexp of LaTeX math environments.")
;;; User Configurable Variables
@@ -178,6 +324,79 @@
:tag "Org Export LaTeX"
:group 'org-export)
+;;;; Generic
+
+(defcustom org-latex-caption-above '(table)
+ "When non-nil, place caption string at the beginning of elements.
+Otherwise, place it near the end. When value is a list of
+symbols, put caption above selected elements only. Allowed
+symbols are: `image', `table', `src-block' and `special-block'."
+ :group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "For all elements" t)
+ (const :tag "For no element" nil)
+ (set :tag "For the following elements only" :greedy t
+ (const :tag "Images" image)
+ (const :tag "Tables" table)
+ (const :tag "Source code" src-block)
+ (const :tag "Special blocks" special-block))))
+
+(defcustom org-latex-prefer-user-labels nil
+ "Use user-provided labels instead of internal ones when non-nil.
+
+When this variable is non-nil, Org will use the value of
+CUSTOM_ID property, NAME keyword or Org target as the key for the
+\\label commands generated.
+
+By default, Org generates its own internal labels during LaTeX
+export. This process ensures that the \\label keys are unique
+and valid, but it means the keys are not available in advance of
+the export process.
+
+Setting this variable gives you control over how Org generates
+labels during LaTeX export, so that you may know their keys in
+advance. One reason to do this is that it allows you to refer to
+various elements using a single label both in Org's link syntax
+and in embedded LaTeX code.
+
+For example, when this variable is non-nil, a headline like this:
+
+ ** Some section
+ :PROPERTIES:
+ :CUSTOM_ID: sec:foo
+ :END:
+ This is section [[#sec:foo]].
+ #+BEGIN_EXPORT latex
+ And this is still section \\ref{sec:foo}.
+ #+END_EXPORT
+
+will be exported to LaTeX as:
+
+ \\subsection{Some section}
+ \\label{sec:foo}
+ This is section \\ref{sec:foo}.
+ And this is still section \\ref{sec:foo}.
+
+Note, however, that setting this variable introduces a limitation
+on the possible values for CUSTOM_ID and NAME. When this
+variable is non-nil, Org passes their value to \\label unchanged.
+You are responsible for ensuring that the value is a valid LaTeX
+\\label key, and that no other \\label commands with the same key
+appear elsewhere in your document. (Keys may contain letters,
+numbers, and the following punctuation: '_' '.' '-' ':'.) There
+are no such limitations on CUSTOM_ID and NAME when this variable
+is nil.
+
+For headlines that do not define the CUSTOM_ID property or
+elements without a NAME, Org will continue to use its default
+labeling scheme to generate labels and resolve links into proper
+references."
+ :group 'org-export-latex
+ :type 'boolean
+ :version "26.1"
+ :package-version '(Org . "8.3"))
;;;; Preamble
@@ -264,11 +483,15 @@ AUTO will automatically be replaced with a coding system derived
from `buffer-file-coding-system'. See also the variable
`org-latex-inputenc-alist' for a way to influence this mechanism.
-Likewise, if your header contains \"\\usepackage[AUTO]{babel}\",
-AUTO will be replaced with the language related to the language
-code specified by `org-export-default-language', which see. Note
-that constructions such as \"\\usepackage[french,AUTO,english]{babel}\"
-are permitted.
+Likewise, if your header contains \"\\usepackage[AUTO]{babel}\"
+or \"\\usepackage[AUTO]{polyglossia}\", AUTO will be replaced
+with the language related to the language code specified by
+`org-export-default-language'. Note that constructions such as
+\"\\usepackage[french,AUTO,english]{babel}\" are permitted. For
+Polyglossia the language will be set via the macros
+\"\\setmainlanguage\" and \"\\setotherlanguage\". See also
+`org-latex-guess-babel-language' and
+`org-latex-guess-polyglossia-language'.
The sectioning structure
------------------------
@@ -328,11 +551,42 @@ are written as utf8 files."
(defcustom org-latex-title-command "\\maketitle"
"The command used to insert the title just after \\begin{document}.
-If this string contains the formatting specification \"%s\" then
-it will be used as a formatting string, passing the title as an
-argument."
+
+This format string may contain these elements:
+
+ %a for AUTHOR keyword
+ %t for TITLE keyword
+ %s for SUBTITLE keyword
+ %k for KEYWORDS line
+ %d for DESCRIPTION line
+ %c for CREATOR line
+ %l for Language keyword
+ %L for capitalized language keyword
+ %D for DATE keyword
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+Setting :latex-title-command in publishing projects will take
+precedence over this variable."
:group 'org-export-latex
- :type 'string)
+ :type '(string :tag "Format string"))
+
+(defcustom org-latex-subtitle-format "\\\\\\medskip\n\\large %s"
+ "Format string used for transcoded subtitle.
+The format string should have at most one \"%s\"-expression,
+which is replaced with the subtitle."
+ :group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(string :tag "Format string"))
+
+(defcustom org-latex-subtitle-separate nil
+ "Non-nil means the subtitle is not typeset as part of title."
+ :group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'boolean)
(defcustom org-latex-toc-command "\\tableofcontents\n\n"
"LaTeX command to set the table of contents, list of figures, etc.
@@ -341,10 +595,36 @@ the toc:nil option, not to those generated with #+TOC keyword."
:group 'org-export-latex
:type 'string)
-(defcustom org-latex-with-hyperref t
- "Toggle insertion of \\hypersetup{...} in the preamble."
+(defcustom org-latex-hyperref-template
+ "\\hypersetup{\n pdfauthor={%a},\n pdftitle={%t},\n pdfkeywords={%k},
+ pdfsubject={%d},\n pdfcreator={%c}, \n pdflang={%L}}\n"
+ "Template for hyperref package options.
+
+This format string may contain these elements:
+
+ %a for AUTHOR keyword
+ %t for TITLE keyword
+ %s for SUBTITLE keyword
+ %k for KEYWORDS line
+ %d for DESCRIPTION line
+ %c for CREATOR line
+ %l for Language keyword
+ %L for capitalized language keyword
+ %D for DATE keyword
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+As a special case, a nil value prevents template from being
+inserted.
+
+Setting :latex-hyperref-template in publishing projects will take
+precedence over this variable."
:group 'org-export-latex
- :type 'boolean)
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice (const :tag "No template" nil)
+ (string :tag "Format string")))
;;;; Headline
@@ -352,17 +632,15 @@ the toc:nil option, not to those generated with #+TOC keyword."
'org-latex-format-headline-default-function
"Function for formatting the headline's text.
-This function will be called with 5 arguments:
-TODO the todo keyword (string or nil).
+This function will be called with six arguments:
+TODO the todo keyword (string or nil)
TODO-TYPE the type of todo (symbol: `todo', `done', nil)
PRIORITY the priority of the headline (integer or nil)
-TEXT the main headline text (string).
-TAGS the tags as a list of strings (list of strings or nil).
-
-The function result will be used in the section format string.
+TEXT the main headline text (string)
+TAGS the tags (list of strings or nil)
+INFO the export options (plist)
-Use `org-latex-format-headline-default-function' by default,
-which format headlines like for Org version prior to 8.0."
+The function result will be used in the section format string."
:group 'org-export-latex
:version "24.4"
:package-version '(Org . "8.0")
@@ -376,6 +654,16 @@ which format headlines like for Org version prior to 8.0."
:group 'org-export-latex
:type 'string)
+(defcustom org-latex-footnote-defined-format "\\textsuperscript{\\ref{%s}}"
+ "Format string used to format reference to footnote already defined.
+%s will be replaced by the label of the referred footnote."
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Use plain superscript (default)" "\\textsuperscript{\\ref{%s}}")
+ (const :tag "Use Memoir/KOMA-Script footref" "\\footref{%s}")
+ (string :tag "Other format string"))
+ :version "26.1"
+ :package-version '(Org . "9.0"))
;;;; Timestamps
@@ -397,6 +685,14 @@ which format headlines like for Org version prior to 8.0."
;;;; Links
+(defcustom org-latex-images-centered t
+ "When non-nil, images are centered."
+ :group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type 'boolean
+ :safe #'booleanp)
+
(defcustom org-latex-image-default-option ""
"Default option for images."
:group 'org-export-latex
@@ -422,13 +718,17 @@ environment."
:package-version '(Org . "8.0")
:type 'string)
-(defcustom org-latex-default-figure-position "htb"
- "Default position for latex figures."
+(defcustom org-latex-default-figure-position "htbp"
+ "Default position for LaTeX figures."
:group 'org-export-latex
- :type 'string)
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :safe #'stringp)
(defcustom org-latex-inline-image-rules
- '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'"))
+ `(("file" . ,(regexp-opt
+ '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg"))))
"Rules characterizing image files that can be inlined into LaTeX.
A rule consists in an association whose key is the type of link
@@ -489,12 +789,14 @@ When modifying this variable, it may be useful to change
:type '(choice (const :tag "Table" table)
(const :tag "Matrix" math)
(const :tag "Inline matrix" inline-math)
- (const :tag "Verbatim" verbatim)))
+ (const :tag "Verbatim" verbatim))
+ :safe (lambda (s) (memq s '(table math inline-math verbatim))))
(defcustom org-latex-tables-centered t
"When non-nil, tables are exported in a center environment."
:group 'org-export-latex
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-latex-tables-booktabs nil
"When non-nil, display tables in a formal \"booktabs\" style.
@@ -505,13 +807,8 @@ attributes."
:group 'org-export-latex
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
-
-(defcustom org-latex-table-caption-above t
- "When non-nil, place caption string at the beginning of the table.
-Otherwise, place it near the end."
- :group 'org-export-latex
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-latex-table-scientific-notation "%s\\,(%s)"
"Format string to display numbers in scientific notation.
@@ -526,11 +823,10 @@ When nil, no transformation is made."
(string :tag "Format string")
(const :tag "No formatting" nil)))
-
;;;; Text markup
(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}")
- (code . verb)
+ (code . protectedtexttt)
(italic . "\\emph{%s}")
(strike-through . "\\sout{%s}")
(underline . "\\uline{%s}")
@@ -550,14 +846,15 @@ to typeset and try to protect special characters.
If no association can be found for a given markup, text will be
returned as-is."
:group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type 'alist
:options '(bold code italic strike-through underline verbatim))
;;;; Drawers
-(defcustom org-latex-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-latex-format-drawer-function (lambda (_ contents) contents)
"Function called to format a drawer in LaTeX code.
The function must accept two parameters:
@@ -568,51 +865,31 @@ The function should return the string to be exported.
The default function simply returns the value of CONTENTS."
:group 'org-export-latex
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'function)
;;;; Inlinetasks
-(defcustom org-latex-format-inlinetask-function 'ignore
+(defcustom org-latex-format-inlinetask-function
+ 'org-latex-format-inlinetask-default-function
"Function called to format an inlinetask in LaTeX code.
-The function must accept six parameters:
- TODO the todo keyword, as a string
- TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
- PRIORITY the inlinetask priority, as a string
- NAME the inlinetask name, as a string.
- TAGS the inlinetask tags, as a list of strings.
- CONTENTS the contents of the inlinetask, as a string.
-
-The function should return the string to be exported.
+The function must accept seven parameters:
+ TODO the todo keyword (string or nil)
+ TODO-TYPE the todo type (symbol: `todo', `done', nil)
+ PRIORITY the inlinetask priority (integer or nil)
+ NAME the inlinetask name (string)
+ TAGS the inlinetask tags (list of strings or nil)
+ CONTENTS the contents of the inlinetask (string or nil)
+ INFO the export options (plist)
-For example, the variable could be set to the following function
-in order to mimic default behavior:
-
-\(defun org-latex-format-inlinetask (todo type priority name tags contents)
-\"Format an inline task element for LaTeX export.\"
- (let ((full-title
- (concat
- (when todo
- (format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
- (when priority (format \"\\\\framebox{\\\\#%c} \" priority))
- title
- (when tags
- (format \"\\\\hfill{}\\\\textsc{:%s:}\"
- (mapconcat \\='identity tags \":\")))))
- (format (concat \"\\\\begin{center}\\n\"
- \"\\\\fbox{\\n\"
- \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
- \"%s\\n\\n\"
- \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
- \"%s\"
- \"\\\\end{minipage}}\"
- \"\\\\end{center}\")
- full-title contents))"
+The function should return the string to be exported."
:group 'org-export-latex
- :type 'function)
+ :type 'function
+ :version "26.1"
+ :package-version '(Org . "8.3"))
;; Src blocks
@@ -640,7 +917,7 @@ the minted package to `org-latex-packages-alist', for example
using customize, or with
(require \\='ox-latex)
- (add-to-list \\='org-latex-packages-alist \\='(\"\" \"minted\"))
+ (add-to-list \\='org-latex-packages-alist \\='(\"newfloat\" \"minted\"))
In addition, it is necessary to install pygments
\(http://pygments.org), and to configure the variable
@@ -656,7 +933,8 @@ into previewing problems, please consult
:type '(choice
(const :tag "Use listings" t)
(const :tag "Use minted" minted)
- (const :tag "Export verbatim" nil)))
+ (const :tag "Export verbatim" nil))
+ :safe (lambda (s) (memq s '(t nil minted))))
(defcustom org-latex-listings-langs
'((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
@@ -668,7 +946,9 @@ into previewing problems, please consult
(shell-script "bash")
(gnuplot "Gnuplot")
(ocaml "Caml") (caml "Caml")
- (sql "SQL") (sqlite "sql"))
+ (sql "SQL") (sqlite "sql")
+ (makefile "make")
+ (R "r"))
"Alist mapping languages to their listing language counterpart.
The key is a symbol, the major mode symbol without the \"-mode\".
The value is the string that should be inserted as the language
@@ -676,6 +956,8 @@ parameter for the listings package. If the mode name and the
listings name are the same, the language does not need an entry
in this list - but it does not hurt if it is present."
:group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(repeat
(list
(symbol :tag "Major mode ")
@@ -697,7 +979,13 @@ will typeset the code in a small size font with underlined, bold
black keywords.
Note that the same options will be applied to blocks of all
-languages."
+languages. If you need block-specific options, you may use the
+following syntax:
+
+ #+ATTR_LATEX: :options key1=value1,key2=value2
+ #+BEGIN_SRC <LANG>
+ ...
+ #+END_SRC"
:group 'org-export-latex
:type '(repeat
(list
@@ -744,41 +1032,132 @@ will result in src blocks being exported with
\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>}
as the start of the minted environment. Note that the same
-options will be applied to blocks of all languages."
+options will be applied to blocks of all languages. If you need
+block-specific options, you may use the following syntax:
+
+ #+ATTR_LATEX: :options key1=value1,key2=value2
+ #+BEGIN_SRC <LANG>
+ ...
+ #+END_SRC"
:group 'org-export-latex
:type '(repeat
(list
(string :tag "Minted option name ")
(string :tag "Minted option value"))))
-(defvar org-latex-custom-lang-environments nil
+(defcustom org-latex-custom-lang-environments nil
"Alist mapping languages to language-specific LaTeX environments.
It is used during export of src blocks by the listings and minted
-latex packages. For example,
+latex packages. The environment may be a simple string, composed of
+only letters and numbers. In this case, the string is directly the
+name of the latex environment to use. The environment may also be
+a format string. In this case the format string will be directly
+exported. This format string may contain these elements:
+
+ %s for the formatted source
+ %c for the caption
+ %f for the float attribute
+ %l for an appropriate label
+ %o for the LaTeX attributes
+
+For example,
(setq org-latex-custom-lang-environments
- \\='((python \"pythoncode\")))
+ \\='((python \"pythoncode\")
+ (ocaml \"\\\\begin{listing}
+\\\\begin{minted}[%o]{ocaml}
+%s\\\\end{minted}
+\\\\caption{%c}
+\\\\label{%l}\")))
-would have the effect that if org encounters begin_src python
-during latex export it will output
+would have the effect that if Org encounters a Python source block
+during LaTeX export it will produce
\\begin{pythoncode}
<src block body>
- \\end{pythoncode}")
+ \\end{pythoncode}
+
+and if Org encounters an Ocaml source block during LaTeX export it
+will produce
+
+ \\begin{listing}
+ \\begin{minted}[<attr_latex options>]{ocaml}
+ <src block body>
+ \\end{minted}
+ \\caption{<caption>}
+ \\label{<label>}
+ \\end{listing}"
+ :group 'org-export-latex
+ :type '(repeat
+ (list
+ (symbol :tag "Language name ")
+ (string :tag "Environment name or format string")))
+ :version "26.1"
+ :package-version '(Org . "9.0"))
;;;; Compilation
+(defcustom org-latex-compiler-file-string "%% Intended LaTeX compiler: %s\n"
+ "LaTeX compiler format-string.
+See also `org-latex-compiler'."
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "Comment" "%% Intended LaTeX compiler: %s\n")
+ (const :tag "latex-mode file variable" "%% -*- latex-run-command: %s -*-\n")
+ (const :tag "AUCTeX file variable" "%% -*- LaTeX-command: %s -*-\n")
+ (string :tag "custom format" "%% %s"))
+ :version "26.1"
+ :package-version '(Org . "9.0"))
+
+(defcustom org-latex-compiler "pdflatex"
+ "LaTeX compiler to use.
+
+Must be an element in `org-latex-compilers' or the empty quote.
+Can also be set in buffers via #+LATEX_COMPILER. See also
+`org-latex-compiler-file-string'."
+ :group 'org-export-latex
+ :type '(choice
+ (const :tag "pdfLaTeX" "pdflatex")
+ (const :tag "XeLaTeX" "xelatex")
+ (const :tag "LuaLaTeX" "lualatex")
+ (const :tag "Unset" ""))
+ :version "26.1"
+ :package-version '(Org . "9.0"))
+
+(defconst org-latex-compilers '("pdflatex" "xelatex" "lualatex")
+ "Known LaTeX compilers.
+See also `org-latex-compiler'.")
+
+(defcustom org-latex-bib-compiler "bibtex"
+ "Command to process a LaTeX file's bibliography.
+
+The shorthand %bib in `org-latex-pdf-process' is replaced with
+this value.
+
+A better approach is to use a compiler suit such as `latexmk'."
+ :group 'org-export-latex
+ :type '(choice (const :tag "BibTeX" "bibtex")
+ (const :tag "Biber" "biber")
+ (string :tag "Other process"))
+ :version "26.1"
+ :package-version '(Org . "9.0"))
+
(defcustom org-latex-pdf-process
- '("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f")
+ '("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f")
"Commands to process a LaTeX file to a PDF file.
+
This is a list of strings, each of them will be given to the
shell as a command. %f in the command will be replaced by the
-full file name, %b by the file base name (i.e. without directory
-and extension parts) and %o by the base directory of the file.
+relative file name, %F by the absolute file name, %b by the file
+base name (i.e. without directory and extension parts), %o by the
+base directory of the file, %O by the absolute file name of the
+output file, %latex is the LaTeX compiler (see
+`org-latex-compiler'), and %bib is the BibTeX-like compiler (see
+`org-latex-bib-compiler').
The reason why this is a list is that it usually takes several
runs of `pdflatex', maybe mixed with a call to `bibtex'. Org
@@ -786,18 +1165,8 @@ does not have a clever mechanism to detect which of these
commands have to be run to get to a stable result, and it also
does not do any error checking.
-By default, Org uses 3 runs of `pdflatex' to do the processing.
-If you have texi2dvi on your system and if that does not cause
-the infamous egrep/locale bug:
-
- http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
-
-then `texi2dvi' is the superior choice as it automates the LaTeX
-build process by calling the \"correct\" combinations of
-auxiliary programs. Org does offer `texi2dvi' as one of the
-customize options. Alternatively, `rubber' and `latexmk' also
-provide similar functionality. The latter supports `biber' out
-of the box.
+Consider a smart LaTeX compiler such as `texi2dvi' or `latexmk',
+which calls the \"correct\" combinations of auxiliary programs.
Alternatively, this may be a Lisp function that does the
processing, so you could use this to apply the machinery of
@@ -807,44 +1176,33 @@ file name as its single argument."
:type '(choice
(repeat :tag "Shell command sequence"
(string :tag "Shell command"))
- (const :tag "2 runs of pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "3 runs of pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "pdflatex,bibtex,pdflatex,pdflatex"
- ("pdflatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "pdflatex -interaction nonstopmode -output-directory %o %f"
- "pdflatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "2 runs of xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "3 runs of xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
- (const :tag "xelatex,bibtex,xelatex,xelatex"
- ("xelatex -interaction nonstopmode -output-directory %o %f"
- "bibtex %b"
- "xelatex -interaction nonstopmode -output-directory %o %f"
- "xelatex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "2 runs of latex"
+ ("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "3 runs of latex"
+ ("%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
+ (const :tag "latex,bibtex,latex,latex"
+ ("%latex -interaction nonstopmode -output-directory %o %f"
+ "%bib %b"
+ "%latex -interaction nonstopmode -output-directory %o %f"
+ "%latex -interaction nonstopmode -output-directory %o %f"))
(const :tag "texi2dvi"
- ("texi2dvi -p -b -V %f"))
- (const :tag "rubber"
- ("rubber -d --into %o %f"))
+ ("cd %o; LATEX=\"%latex\" texi2dvi -p -b -V %b.tex"))
(const :tag "latexmk"
- ("latexmk -g -pdf %f"))
+ ("latexmk -g -pdf -pdflatex=\"%latex\" -outdir=%o %f"))
(function)))
(defcustom org-latex-logfiles-extensions
- '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb")
+ '("aux" "bcf" "blg" "fdb_latexmk" "fls" "figlist" "idx" "log" "nav" "out"
+ "ptc" "run.xml" "snm" "toc" "vrb" "xdv")
"The list of file extensions to consider as LaTeX logfiles.
-The logfiles will be remove if `org-latex-remove-logfiles' is
+The logfiles will be removed if `org-latex-remove-logfiles' is
non-nil."
:group 'org-export-latex
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(repeat (string :tag "Extension")))
(defcustom org-latex-remove-logfiles t
@@ -855,19 +1213,20 @@ logfiles to remove, set `org-latex-logfiles-extensions'."
:group 'org-export-latex
:type 'boolean)
-(defcustom org-latex-known-errors
- '(("Reference.*?undefined" . "[undefined reference]")
- ("Citation.*?undefined" . "[undefined citation]")
- ("Undefined control sequence" . "[undefined control sequence]")
- ("^! LaTeX.*?Error" . "[LaTeX error]")
- ("^! Package.*?Error" . "[package error]")
- ("Runaway argument" . "Runaway argument"))
+(defcustom org-latex-known-warnings
+ '(("Reference.*?undefined" . "[undefined reference]")
+ ("Runaway argument" . "[runaway argument]")
+ ("Underfull \\hbox" . "[underfull hbox]")
+ ("Overfull \\hbox" . "[overfull hbox]")
+ ("Citation.*?undefined" . "[undefined citation]")
+ ("Undefined control sequence" . "[undefined control sequence]"))
"Alist of regular expressions and associated messages for the user.
-The regular expressions are used to find possible errors in the
-log of a latex-run."
+The regular expressions are used to find possible warnings in the
+log of a latex-run. These warnings will be reported after
+calling `org-latex-compile'."
:group 'org-export-latex
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(repeat
(cons
(string :tag "Regexp")
@@ -877,6 +1236,54 @@ log of a latex-run."
;;; Internal Functions
+(defun org-latex--caption-above-p (element info)
+ "Non nil when caption is expected to be located above ELEMENT.
+INFO is a plist holding contextual information."
+ (let ((above (plist-get info :latex-caption-above)))
+ (if (symbolp above) above
+ (let ((type (org-element-type element)))
+ (memq (if (eq type 'link) 'image type) above)))))
+
+(defun org-latex--label (datum info &optional force full)
+ "Return an appropriate label for DATUM.
+DATUM is an element or a `target' type object. INFO is the
+current export state, as a plist.
+
+Return nil if element DATUM has no NAME or VALUE affiliated
+keyword or no CUSTOM_ID property, unless FORCE is non-nil. In
+this case always return a unique label.
+
+Eventually, if FULL is non-nil, wrap label within \"\\label{}\"."
+ (let* ((type (org-element-type datum))
+ (user-label
+ (org-element-property
+ (cl-case type
+ ((headline inlinetask) :CUSTOM_ID)
+ (target :value)
+ (otherwise :name))
+ datum))
+ (label
+ (and (or user-label force)
+ (if (and user-label (plist-get info :latex-prefer-user-labels))
+ user-label
+ (concat (cl-case type
+ (headline "sec:")
+ (table "tab:")
+ (latex-environment
+ (and (string-match-p
+ org-latex-math-environments-re
+ (org-element-property :value datum))
+ "eq:"))
+ (paragraph
+ (and (org-element-property :caption datum)
+ "fig:")))
+ (org-export-get-reference datum info))))))
+ (cond ((not full) label)
+ (label (format "\\label{%s}%s"
+ label
+ (if (eq type 'target) "" "\n")))
+ (t ""))))
+
(defun org-latex--caption/label-string (element info)
"Return caption and label LaTeX string for ELEMENT.
@@ -884,25 +1291,43 @@ INFO is a plist holding contextual information. If there's no
caption nor label, return the empty string.
For non-floats, see `org-latex--wrap-label'."
- (let* ((label (org-element-property :name element))
- (label-str (if (not (org-string-nw-p label)) ""
- (format "\\label{%s}"
- (org-export-solidify-link-text label))))
+ (let* ((label (org-latex--label element info nil t))
(main (org-export-get-caption element))
+ (attr (org-export-read-attribute :attr_latex element))
+ (type (org-element-type element))
+ (nonfloat (or (and (plist-member attr :float)
+ (not (plist-get attr :float))
+ main)
+ (and (eq type 'src-block)
+ (not (plist-get attr :float))
+ (null (plist-get info :latex-listings)))))
(short (org-export-get-caption element t))
- (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption)))
+ (caption-from-attr-latex (plist-get attr :caption)))
(cond
((org-string-nw-p caption-from-attr-latex)
(concat caption-from-attr-latex "\n"))
- ((and (not main) (equal label-str "")) "")
- ((not main) (concat label-str "\n"))
+ ((and (not main) (equal label "")) "")
+ ((not main) label)
;; Option caption format with short name.
- (short (format "\\caption[%s]{%s%s}\n"
- (org-export-data short info)
- label-str
- (org-export-data main info)))
- ;; Standard caption format.
- (t (format "\\caption{%s%s}\n" label-str (org-export-data main info))))))
+ (t
+ (format (if nonfloat "\\captionof{%s}%s{%s%s}\n"
+ "\\caption%s%s{%s%s}\n")
+ (let ((type* (if (eq type 'latex-environment)
+ (org-latex--environment-type element)
+ type)))
+ (if nonfloat
+ (cl-case type*
+ (paragraph "figure")
+ (image "figure")
+ (special-block "figure")
+ (src-block (if (plist-get info :latex-listings)
+ "listing"
+ "figure"))
+ (t (symbol-name type*)))
+ ""))
+ (if short (format "[%s]" (org-export-data short info)) "")
+ label
+ (org-export-data main info))))))
(defun org-latex-guess-inputenc (header)
"Set the coding system in inputenc to what the buffer is.
@@ -945,8 +1370,8 @@ Return the new header."
header
(let ((options (save-match-data
(org-split-string (match-string 1 header) ",[ \t]*")))
- (language (cdr (assoc language-code
- org-latex-babel-language-alist))))
+ (language (cdr (assoc-string language-code
+ org-latex-babel-language-alist t))))
;; If LANGUAGE is already loaded, return header without AUTO.
;; Otherwise, replace AUTO with language or append language if
;; AUTO is not present.
@@ -958,13 +1383,90 @@ Return the new header."
", ")
t nil header 1)))))
+(defun org-latex-guess-polyglossia-language (header info)
+ "Set the Polyglossia language according to the LANGUAGE keyword.
+
+HEADER is the LaTeX header string. INFO is the plist used as
+a communication channel.
+
+Insertion of guessed language only happens when the Polyglossia
+package has been explicitly loaded.
+
+The argument to Polyglossia may be \"AUTO\" which is then
+replaced with the language of the document or
+`org-export-default-language'. Note, the language is really set
+using \setdefaultlanguage and not as an option to the package.
+
+Return the new header."
+ (let ((language (plist-get info :language)))
+ ;; If no language is set or Polyglossia is not loaded, return
+ ;; HEADER as-is.
+ (if (or (not (stringp language))
+ (not (string-match
+ "\\\\usepackage\\(?:\\[\\([^]]+?\\)\\]\\){polyglossia}\n"
+ header)))
+ header
+ (let* ((options (org-string-nw-p (match-string 1 header)))
+ (languages (and options
+ ;; Reverse as the last loaded language is
+ ;; the main language.
+ (nreverse
+ (delete-dups
+ (save-match-data
+ (org-split-string
+ (replace-regexp-in-string
+ "AUTO" language options t)
+ ",[ \t]*"))))))
+ (main-language-set
+ (string-match-p "\\\\setmainlanguage{.*?}" header)))
+ (replace-match
+ (concat "\\usepackage{polyglossia}\n"
+ (mapconcat
+ (lambda (l)
+ (let ((l (or (assoc l org-latex-polyglossia-language-alist)
+ l)))
+ (format (if main-language-set "\\setotherlanguage%s{%s}\n"
+ (setq main-language-set t)
+ "\\setmainlanguage%s{%s}\n")
+ (if (and (consp l) (= (length l) 3))
+ (format "[variant=%s]" (nth 2 l))
+ "")
+ (nth 1 l))))
+ languages
+ ""))
+ t t header 0)))))
+
+(defun org-latex--remove-packages (pkg-alist info)
+ "Remove packages based on the current LaTeX compiler.
+
+If the fourth argument of an element is set in pkg-alist, and it
+is not a member of the LaTeX compiler of the document, the packages
+is removed. See also `org-latex-compiler'.
+
+Return modified pkg-alist."
+ (let ((compiler (or (plist-get info :latex-compiler) "")))
+ (if (member-ignore-case compiler org-latex-compilers)
+ (delq nil
+ (mapcar
+ (lambda (pkg)
+ (unless (and
+ (listp pkg)
+ (let ((third (nth 3 pkg)))
+ (and third
+ (not (member-ignore-case
+ compiler
+ (if (listp third) third (list third)))))))
+ pkg))
+ pkg-alist))
+ pkg-alist)))
+
(defun org-latex--find-verb-separator (s)
"Return a character not used in string S.
This is used to choose a separator for constructs like \\verb."
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (loop for c across ll
- when (not (string-match (regexp-quote (char-to-string c)) s))
- return (char-to-string c))))
+ (cl-loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
(defun org-latex--make-option-string (options)
"Return a comma separated string of keywords and values.
@@ -972,135 +1474,203 @@ OPTIONS is an alist where the key is the options keyword as
a string, and the value a list containing the keyword value, or
nil."
(mapconcat (lambda (pair)
- (concat (first pair)
- (when (> (length (second pair)) 0)
- (concat "=" (second pair)))))
+ (pcase-let ((`(,keyword ,value) pair))
+ (concat keyword
+ (and (> (length value) 0)
+ (concat "=" value)))))
options
","))
-(defun org-latex--wrap-label (element output)
+(defun org-latex--wrap-label (element output info)
"Wrap label associated to ELEMENT around OUTPUT, if appropriate.
-This function shouldn't be used for floats. See
+INFO is the current export state, as a plist. This function
+should not be used for floats. See
`org-latex--caption/label-string'."
- (let ((label (org-element-property :name element)))
- (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output
- (concat (format "\\label{%s}\n" (org-export-solidify-link-text label))
- output))))
+ (if (not (and (org-string-nw-p output) (org-element-property :name element)))
+ output
+ (concat (format "\\phantomsection\n\\label{%s}\n"
+ (org-latex--label element info))
+ output)))
+
+(defun org-latex--protect-text (text)
+ "Protect special characters in string TEXT and return it."
+ (replace-regexp-in-string "[\\{}$%&_#~^]" "\\\\\\&" text))
-(defun org-latex--text-markup (text markup)
+(defun org-latex--text-markup (text markup info)
"Format TEXT depending on MARKUP text markup.
-See `org-latex-text-markup-alist' for details."
- (let ((fmt (cdr (assq markup org-latex-text-markup-alist))))
- (cond
- ;; No format string: Return raw text.
- ((not fmt) text)
- ;; Handle the `verb' special case: Find and appropriate separator
- ;; and use "\\verb" command.
- ((eq 'verb fmt)
- (let ((separator (org-latex--find-verb-separator text)))
- (concat "\\verb" separator
- (replace-regexp-in-string "\n" " " text)
- separator)))
- ;; Handle the `protectedtexttt' special case: Protect some
- ;; special chars and use "\texttt{%s}" format string.
- ((eq 'protectedtexttt fmt)
- (let ((start 0)
- (trans '(("\\" . "\\textbackslash{}")
- ("~" . "\\textasciitilde{}")
- ("^" . "\\textasciicircum{}")))
- (rtn "")
- char)
- (while (string-match "[\\{}$%&_#~^]" text)
- (setq char (match-string 0 text))
- (if (> (match-beginning 0) 0)
- (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
- (setq text (substring text (1+ (match-beginning 0))))
- (setq char (or (cdr (assoc char trans)) (concat "\\" char))
- rtn (concat rtn char)))
- (setq text (concat rtn text)
- fmt "\\texttt{%s}")
- (while (string-match "--" text)
- (setq text (replace-match "-{}-" t t text)))
- (format fmt text)))
- ;; Else use format string.
- (t (format fmt text)))))
+INFO is a plist used as a communication channel. See
+`org-latex-text-markup-alist' for details."
+ (let ((fmt (cdr (assq markup (plist-get info :latex-text-markup-alist)))))
+ (cl-case fmt
+ ;; No format string: Return raw text.
+ ((nil) text)
+ ;; Handle the `verb' special case: Find an appropriate separator
+ ;; and use "\\verb" command.
+ (verb
+ (let ((separator (org-latex--find-verb-separator text)))
+ (concat "\\verb"
+ separator
+ (replace-regexp-in-string "\n" " " text)
+ separator)))
+ ;; Handle the `protectedtexttt' special case: Protect some
+ ;; special chars and use "\texttt{%s}" format string.
+ (protectedtexttt
+ (format "\\texttt{%s}"
+ (replace-regexp-in-string
+ "--\\|[\\{}$%&_#~^]"
+ (lambda (m)
+ (cond ((equal m "--") "-{}-")
+ ((equal m "\\") "\\textbackslash{}")
+ ((equal m "~") "\\textasciitilde{}")
+ ((equal m "^") "\\textasciicircum{}")
+ (t (org-latex--protect-text m))))
+ text nil t)))
+ ;; Else use format string.
+ (t (format fmt text)))))
(defun org-latex--delayed-footnotes-definitions (element info)
"Return footnotes definitions in ELEMENT as a string.
INFO is a plist used as a communication channel.
-Footnotes definitions are returned within \"\\footnotetxt{}\"
+Footnotes definitions are returned within \"\\footnotetext{}\"
commands.
This function is used within constructs that don't support
-\"\\footnote{}\" command (i.e. an item's tag). In that case,
+\"\\footnote{}\" command (e.g., an item tag). In that case,
\"\\footnotemark\" is used within the construct and the function
just outside of it."
(mapconcat
(lambda (ref)
- (format
- "\\footnotetext[%s]{%s}"
- (org-export-get-footnote-number ref info)
- (org-trim
- (org-export-data
- (org-export-get-footnote-definition ref info) info))))
+ (let ((def (org-export-get-footnote-definition ref info)))
+ (format "\\footnotetext[%d]{%s%s}"
+ (org-export-get-footnote-number ref info)
+ (org-trim (org-latex--label def info t t))
+ (org-trim (org-export-data def info)))))
;; Find every footnote reference in ELEMENT.
- (let* (all-refs
- search-refs ; For byte-compiler.
- (search-refs
- (function
- (lambda (data)
- ;; Return a list of all footnote references never seen
- ;; before in DATA.
- (org-element-map data 'footnote-reference
- (lambda (ref)
- (when (org-export-footnote-first-reference-p ref info)
- (push ref all-refs)
- (when (eq (org-element-property :type ref) 'standard)
- (funcall search-refs
- (org-export-get-footnote-definition ref info)))))
- info)
- (reverse all-refs)))))
+ (letrec ((all-refs nil)
+ (search-refs
+ (lambda (data)
+ ;; Return a list of all footnote references never seen
+ ;; before in DATA.
+ (org-element-map data 'footnote-reference
+ (lambda (ref)
+ (when (org-export-footnote-first-reference-p ref info)
+ (push ref all-refs)
+ (when (eq (org-element-property :type ref) 'standard)
+ (funcall search-refs
+ (org-export-get-footnote-definition ref info)))))
+ info)
+ (reverse all-refs))))
(funcall search-refs element))
""))
+(defun org-latex--translate (s info)
+ "Translate string S according to specified language.
+INFO is a plist used as a communication channel."
+ (org-export-translate s :latex info))
+
+(defun org-latex--format-spec (info)
+ "Create a format-spec for document meta-data.
+INFO is a plist used as a communication channel."
+ (let ((language (let ((lang (plist-get info :language)))
+ (or (cdr (assoc-string lang org-latex-babel-language-alist t))
+ (nth 1 (assoc-string lang org-latex-polyglossia-language-alist t))
+ lang))))
+ `((?a . ,(org-export-data (plist-get info :author) info))
+ (?t . ,(org-export-data (plist-get info :title) info))
+ (?k . ,(org-export-data (org-latex--wrap-latex-math-block
+ (plist-get info :keywords) info)
+ info))
+ (?d . ,(org-export-data (org-latex--wrap-latex-math-block
+ (plist-get info :description) info)
+ info))
+ (?c . ,(plist-get info :creator))
+ (?l . ,language)
+ (?L . ,(capitalize language))
+ (?D . ,(org-export-get-date info)))))
+
+(defun org-latex--insert-compiler (info)
+ "Insert LaTeX_compiler info into the document.
+INFO is a plist used as a communication channel."
+ (let ((compiler (plist-get info :latex-compiler)))
+ (and (org-string-nw-p org-latex-compiler-file-string)
+ (member (or compiler "") org-latex-compilers)
+ (format org-latex-compiler-file-string compiler))))
+
+
+;;; Filters
+
+(defun org-latex-matrices-tree-filter (tree _backend info)
+ (org-latex--wrap-latex-matrices tree info))
+
+(defun org-latex-math-block-tree-filter (tree _backend info)
+ (org-latex--wrap-latex-math-block tree info))
+
+(defun org-latex-math-block-options-filter (info _backend)
+ (dolist (prop '(:author :date :title) info)
+ (plist-put info prop
+ (org-latex--wrap-latex-math-block (plist-get info prop) info))))
+
+(defun org-latex-clean-invalid-line-breaks (data _backend _info)
+ (replace-regexp-in-string
+ "\\(\\end{[A-Za-z0-9*]+}\\|^\\)[ \t]*\\\\\\\\[ \t]*$" "\\1"
+ data))
;;; Template
+;;;###autoload
+(defun org-latex-make-preamble (info &optional template snippet?)
+ "Return a formatted LaTeX preamble.
+INFO is a plist used as a communication channel. Optional
+argument TEMPLATE, when non-nil, is the header template string,
+as expected by `org-splice-latex-header'. When SNIPPET? is
+non-nil, only includes packages relevant to image generation, as
+specified in `org-latex-default-packages-alist' or
+`org-latex-packages-alist'."
+ (let* ((class (plist-get info :latex-class))
+ (class-template
+ (or template
+ (let* ((class-options (plist-get info :latex-class-options))
+ (header (nth 1 (assoc class (plist-get info :latex-classes)))))
+ (and (stringp header)
+ (if (not class-options) header
+ (replace-regexp-in-string
+ "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
+ class-options header t nil 1))))
+ (user-error "Unknown LaTeX class `%s'" class))))
+ (org-latex-guess-polyglossia-language
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-element-normalize-string
+ (org-splice-latex-header
+ class-template
+ (org-latex--remove-packages org-latex-default-packages-alist info)
+ (org-latex--remove-packages org-latex-packages-alist info)
+ snippet?
+ (mapconcat #'org-element-normalize-string
+ (list (plist-get info :latex-header)
+ (and (not snippet?)
+ (plist-get info :latex-header-extra)))
+ ""))))
+ info)
+ info)))
+
(defun org-latex-template (contents info)
"Return complete document string after LaTeX conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (let ((title (org-export-data (plist-get info :title) info)))
+ (let ((title (org-export-data (plist-get info :title) info))
+ (spec (org-latex--format-spec info)))
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
(format-time-string "%% Created %Y-%m-%d %a %H:%M\n"))
+ ;; LaTeX compiler.
+ (org-latex--insert-compiler info)
;; Document class and packages.
- (let* ((class (plist-get info :latex-class))
- (class-options (plist-get info :latex-class-options))
- (header (nth 1 (assoc class org-latex-classes)))
- (document-class-string
- (and (stringp header)
- (if (not class-options) header
- (replace-regexp-in-string
- "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
- class-options header t nil 1)))))
- (if (not document-class-string)
- (user-error "Unknown LaTeX class `%s'" class)
- (org-latex-guess-babel-language
- (org-latex-guess-inputenc
- (org-element-normalize-string
- (org-splice-latex-header
- document-class-string
- org-latex-default-packages-alist
- org-latex-packages-alist nil
- (concat (org-element-normalize-string
- (plist-get info :latex-header))
- (plist-get info :latex-header-extra)))))
- info)))
+ (org-latex-make-preamble info)
;; Possibly limit depth for headline numbering.
(let ((sec-num (plist-get info :section-numbers)))
(when (integerp sec-num)
@@ -1117,40 +1687,46 @@ holding export options."
;; Date.
(let ((date (and (plist-get info :with-date) (org-export-get-date info))))
(format "\\date{%s}\n" (org-export-data date info)))
- ;; Title
- (format "\\title{%s}\n" title)
+ ;; Title and subtitle.
+ (let* ((subtitle (plist-get info :subtitle))
+ (formatted-subtitle
+ (when subtitle
+ (format (plist-get info :latex-subtitle-format)
+ (org-export-data subtitle info))))
+ (separate (plist-get info :latex-subtitle-separate)))
+ (concat
+ (format "\\title{%s%s}\n" title
+ (if separate "" (or formatted-subtitle "")))
+ (when (and separate subtitle)
+ (concat formatted-subtitle "\n"))))
;; Hyperref options.
- (when (plist-get info :latex-hyperref-p)
- (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n"
- (or (plist-get info :keywords) "")
- (or (plist-get info :description) "")
- (if (not (plist-get info :with-creator)) ""
- (plist-get info :creator))))
+ (let ((template (plist-get info :latex-hyperref-template)))
+ (and (stringp template)
+ (format-spec template spec)))
;; Document start.
"\\begin{document}\n\n"
;; Title command.
- (org-element-normalize-string
- (cond ((string= "" title) nil)
- ((not (stringp org-latex-title-command)) nil)
- ((string-match "\\(?:[^%]\\|^\\)%s"
- org-latex-title-command)
- (format org-latex-title-command title))
- (t org-latex-title-command)))
+ (let* ((title-command (plist-get info :latex-title-command))
+ (command (and (stringp title-command)
+ (format-spec title-command spec))))
+ (org-element-normalize-string
+ (cond ((not (plist-get info :with-title)) nil)
+ ((string= "" title) nil)
+ ((not (stringp command)) nil)
+ ((string-match "\\(?:[^%]\\|^\\)%s" command)
+ (format command title))
+ (t command))))
;; Table of contents.
(let ((depth (plist-get info :with-toc)))
(when depth
(concat (when (wholenump depth)
(format "\\setcounter{tocdepth}{%d}\n" depth))
- org-latex-toc-command)))
+ (plist-get info :latex-toc-command))))
;; Document's body.
contents
;; Creator.
- (let ((creator-info (plist-get info :with-creator)))
- (cond
- ((not creator-info) "")
- ((eq creator-info 'comment)
- (format "%% %s\n" (plist-get info :creator)))
- (t (concat (plist-get info :creator) "\n"))))
+ (and (plist-get info :with-creator)
+ (concat (plist-get info :creator) "\n"))
;; Document end.
"\\end{document}")))
@@ -1160,11 +1736,11 @@ holding export options."
;;;; Bold
-(defun org-latex-bold (bold contents info)
+(defun org-latex-bold (_bold contents info)
"Transcode BOLD from Org to LaTeX.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
- (org-latex--text-markup contents 'bold))
+ (org-latex--text-markup contents 'bold info))
;;;; Center Block
@@ -1174,23 +1750,20 @@ contextual information."
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
(org-latex--wrap-label
- center-block
- (format "\\begin{center}\n%s\\end{center}" contents)))
+ center-block (format "\\begin{center}\n%s\\end{center}" contents) info))
;;;; Clock
-(defun org-latex-clock (clock contents info)
+(defun org-latex-clock (clock _contents info)
"Transcode a CLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
(concat
"\\noindent"
(format "\\textbf{%s} " org-clock-string)
- (format org-latex-inactive-timestamp-format
- (concat (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
+ (format (plist-get info :latex-inactive-timestamp-format)
+ (concat (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " (%s)" time)))))
"\\\\"))
@@ -1198,11 +1771,11 @@ information."
;;;; Code
-(defun org-latex-code (code contents info)
+(defun org-latex-code (code _contents info)
"Transcode a CODE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-latex--text-markup (org-element-property :value code) 'code))
+ (org-latex--text-markup (org-element-property :value code) 'code info))
;;;; Drawer
@@ -1212,9 +1785,9 @@ channel."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((name (org-element-property :drawer-name drawer))
- (output (funcall org-latex-format-drawer-function
+ (output (funcall (plist-get info :latex-format-drawer-function)
name contents)))
- (org-latex--wrap-label drawer output)))
+ (org-latex--wrap-label drawer output info)))
;;;; Dynamic Block
@@ -1223,35 +1796,40 @@ holding contextual information."
"Transcode a DYNAMIC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
- (org-latex--wrap-label dynamic-block contents))
+ (org-latex--wrap-label dynamic-block contents info))
;;;; Entity
-(defun org-latex-entity (entity contents info)
+(defun org-latex-entity (entity _contents _info)
"Transcode an ENTITY object from Org to LaTeX.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
- (let ((ent (org-element-property :latex entity)))
- (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent)))
+ (org-element-property :latex entity))
;;;; Example Block
-(defun org-latex-example-block (example-block contents info)
+(defun org-latex-example-block (example-block _contents info)
"Transcode an EXAMPLE-BLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
(when (org-string-nw-p (org-element-property :value example-block))
- (org-latex--wrap-label
- example-block
- (format "\\begin{verbatim}\n%s\\end{verbatim}"
- (org-export-format-code-default example-block info)))))
+ (let ((environment (or (org-export-read-attribute
+ :attr_latex example-block :environment)
+ "verbatim")))
+ (org-latex--wrap-label
+ example-block
+ (format "\\begin{%s}\n%s\\end{%s}"
+ environment
+ (org-export-format-code-default example-block info)
+ environment)
+ info))))
;;;; Export Block
-(defun org-latex-export-block (export-block contents info)
+(defun org-latex-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (member (org-element-property :type export-block) '("LATEX" "TEX"))
@@ -1260,7 +1838,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Snippet
-(defun org-latex-export-snippet (export-snippet contents info)
+(defun org-latex-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'latex)
@@ -1269,46 +1847,60 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-latex-fixed-width (fixed-width contents info)
+(defun org-latex-fixed-width (fixed-width _contents info)
"Transcode a FIXED-WIDTH element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-latex--wrap-label
fixed-width
(format "\\begin{verbatim}\n%s\\end{verbatim}"
(org-remove-indentation
- (org-element-property :value fixed-width)))))
+ (org-element-property :value fixed-width)))
+ info))
;;;; Footnote Reference
-(defun org-latex-footnote-reference (footnote-reference contents info)
+(defun org-latex-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
- (concat
- ;; Insert separator between two footnotes in a row.
- (let ((prev (org-export-get-previous-element footnote-reference info)))
- (when (eq (org-element-type prev) 'footnote-reference)
- org-latex-footnote-separator))
- (cond
- ;; Use \footnotemark if the footnote has already been defined.
- ((not (org-export-footnote-first-reference-p footnote-reference info))
- (format "\\footnotemark[%s]{}"
- (org-export-get-footnote-number footnote-reference info)))
- ;; Use \footnotemark if reference is within another footnote
- ;; reference, footnote definition or table cell.
- ((loop for parent in (org-export-get-genealogy footnote-reference)
- thereis (memq (org-element-type parent)
- '(footnote-reference footnote-definition table-cell)))
- "\\footnotemark")
- ;; Otherwise, define it with \footnote command.
- (t
- (let ((def (org-export-get-footnote-definition footnote-reference info)))
- (concat
- (format "\\footnote{%s}" (org-trim (org-export-data def info)))
- ;; Retrieve all footnote references within the footnote and
- ;; add their definition after it, since LaTeX doesn't support
- ;; them inside.
- (org-latex--delayed-footnotes-definitions def info)))))))
+ (let ((label (org-element-property :label footnote-reference)))
+ (concat
+ ;; Insert separator between two footnotes in a row.
+ (let ((prev (org-export-get-previous-element footnote-reference info)))
+ (when (eq (org-element-type prev) 'footnote-reference)
+ (plist-get info :latex-footnote-separator)))
+ (cond
+ ;; Use `:latex-footnote-defined-format' if the footnote has
+ ;; already been defined.
+ ((not (org-export-footnote-first-reference-p footnote-reference info))
+ (format (plist-get info :latex-footnote-defined-format)
+ (org-latex--label
+ (org-export-get-footnote-definition footnote-reference info)
+ info t)))
+ ;; Use \footnotemark if reference is within another footnote
+ ;; reference, footnote definition or table cell.
+ ((org-element-lineage footnote-reference
+ '(footnote-reference footnote-definition table-cell))
+ "\\footnotemark")
+ ;; Otherwise, define it with \footnote command.
+ (t
+ (let ((def (org-export-get-footnote-definition footnote-reference info)))
+ (concat
+ (format "\\footnote{%s%s}" (org-trim (org-export-data def info))
+ ;; Only insert a \label if there exist another
+ ;; reference to def.
+ (cond ((not label) "")
+ ((org-element-map (plist-get info :parse-tree) 'footnote-reference
+ (lambda (f)
+ (and (not (eq f footnote-reference))
+ (equal (org-element-property :label f) label)
+ (org-trim (org-latex--label def info t t))))
+ info t))
+ (t "")))
+ ;; Retrieve all footnote references within the footnote and
+ ;; add their definition after it, since LaTeX doesn't support
+ ;; them inside.
+ (org-latex--delayed-footnotes-definitions def info))))))))
;;;; Headline
@@ -1321,7 +1913,7 @@ holding contextual information."
(let* ((class (plist-get info :latex-class))
(level (org-export-get-relative-level headline info))
(numberedp (org-export-numbered-headline-p headline info))
- (class-sectioning (assoc class org-latex-classes))
+ (class-sectioning (assoc class (plist-get info :latex-classes)))
;; Section formatting will set two placeholders: one for
;; the title and the other for the contents.
(section-fmt
@@ -1365,16 +1957,12 @@ holding contextual information."
(org-element-property :priority headline)))
;; Create the headline text along with a no-tag version.
;; The latter is required to remove tags from toc.
- (full-text (funcall org-latex-format-headline-function
- todo todo-type priority text tags))
+ (full-text (funcall (plist-get info :latex-format-headline-function)
+ todo todo-type priority text tags info))
;; Associate \label to the headline for internal links.
- (headline-label
- (format "\\label{sec-%s}\n"
- (mapconcat 'number-to-string
- (org-export-get-headline-number headline info)
- "-")))
+ (headline-label (org-latex--label headline info t t))
(pre-blanks
- (make-string (org-element-property :pre-blank headline) 10)))
+ (make-string (org-element-property :pre-blank headline) ?\n)))
(if (or (not section-fmt) (org-export-low-level-p headline info))
;; This is a deep sub-tree: export it as a list item. Also
;; export as items headlines for which no section format has
@@ -1386,7 +1974,8 @@ holding contextual information."
(format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize)))
;; Itemize headline
"\\item"
- (and full-text (org-string-match-p "\\`[ \t]*\\[" full-text)
+ (and full-text
+ (string-match-p "\\`[ \t]*\\[" full-text)
"\\relax")
" " full-text "\n"
headline-label
@@ -1404,15 +1993,32 @@ holding contextual information."
;; an alternative heading when possible, and when this is not
;; identical to the usual heading.
(let ((opt-title
- (funcall org-latex-format-headline-function
+ (funcall (plist-get info :latex-format-headline-function)
todo todo-type priority
(org-export-data-with-backend
(org-export-get-alt-title headline info)
section-back-end info)
- (and (eq (plist-get info :with-tags) t) tags))))
- (if (and numberedp opt-title
+ (and (eq (plist-get info :with-tags) t) tags)
+ info))
+ ;; Maybe end local TOC (see `org-latex-keyword').
+ (contents
+ (concat
+ contents
+ (let ((case-fold-search t)
+ (section
+ (let ((first (car (org-element-contents headline))))
+ (and (eq (org-element-type first) 'section) first))))
+ (org-element-map section 'keyword
+ (lambda (k)
+ (and (equal (org-element-property :key k) "TOC")
+ (let ((v (org-element-property :value k)))
+ (and (string-match-p "\\<headlines\\>" v)
+ (string-match-p "\\<local\\>" v)
+ (format "\\stopcontents[level-%d]" level)))))
+ info t)))))
+ (if (and opt-title
(not (equal opt-title full-text))
- (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt))
+ (string-match "\\`\\\\\\(.+?\\){" section-fmt))
(format (replace-match "\\1[%s]" nil nil section-fmt 1)
;; Replace square brackets with parenthesis
;; since square brackets are not supported in
@@ -1427,7 +2033,7 @@ holding contextual information."
(concat headline-label pre-blanks contents))))))))
(defun org-latex-format-headline-default-function
- (todo todo-type priority text tags)
+ (todo _todo-type priority text tags _info)
"Default format function for a headline.
See `org-latex-format-headline-function' for details."
(concat
@@ -1435,12 +2041,13 @@ See `org-latex-format-headline-function' for details."
(and priority (format "\\framebox{\\#%c} " priority))
text
(and tags
- (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":")))))
+ (format "\\hfill{}\\textsc{%s}"
+ (mapconcat #'org-latex--protect-text tags ":")))))
;;;; Horizontal Rule
-(defun org-latex-horizontal-rule (horizontal-rule contents info)
+(defun org-latex-horizontal-rule (horizontal-rule _contents info)
"Transcode an HORIZONTAL-RULE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((attr (org-export-read-attribute :attr_latex horizontal-rule))
@@ -1454,47 +2061,47 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"\n")
(org-latex--wrap-label
horizontal-rule
- (format "\\rule{%s}{%s}"
- (or (plist-get attr :width) "\\linewidth")
- (or (plist-get attr :thickness) "0.5pt"))))))
+ (format "\\noindent\\rule{%s}{%s}"
+ (or (plist-get attr :width) "\\textwidth")
+ (or (plist-get attr :thickness) "0.5pt"))
+ info))))
;;;; Inline Src Block
-(defun org-latex-inline-src-block (inline-src-block contents info)
+(defun org-latex-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((code (org-element-property :value inline-src-block))
(separator (org-latex--find-verb-separator code)))
- (cond
- ;; Do not use a special package: transcode it verbatim.
- ((not org-latex-listings)
- (concat "\\verb" separator code separator))
- ;; Use minted package.
- ((eq org-latex-listings 'minted)
- (let* ((org-lang (org-element-property :language inline-src-block))
- (mint-lang (or (cadr (assq (intern org-lang)
- org-latex-minted-langs))
- (downcase org-lang)))
- (options (org-latex--make-option-string
- org-latex-minted-options)))
- (concat (format "\\mint%s{%s}"
- (if (string= options "") "" (format "[%s]" options))
- mint-lang)
- separator code separator)))
- ;; Use listings package.
- (t
- ;; Maybe translate language's name.
- (let* ((org-lang (org-element-property :language inline-src-block))
- (lst-lang (or (cadr (assq (intern org-lang)
- org-latex-listings-langs))
- org-lang))
- (options (org-latex--make-option-string
- (append org-latex-listings-options
- `(("language" ,lst-lang))))))
- (concat (format "\\lstinline[%s]" options)
- separator code separator))))))
+ (cl-case (plist-get info :latex-listings)
+ ;; Do not use a special package: transcode it verbatim.
+ ((nil) (format "\\texttt{%s}" (org-latex--text-markup code 'code info)))
+ ;; Use minted package.
+ (minted
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (mint-lang (or (cadr (assq (intern org-lang)
+ (plist-get info :latex-minted-langs)))
+ (downcase org-lang)))
+ (options (org-latex--make-option-string
+ (plist-get info :latex-minted-options))))
+ (format "\\mintinline%s{%s}{%s}"
+ (if (string= options "") "" (format "[%s]" options))
+ mint-lang
+ code)))
+ ;; Use listings package.
+ (otherwise
+ ;; Maybe translate language's name.
+ (let* ((org-lang (org-element-property :language inline-src-block))
+ (lst-lang (or (cadr (assq (intern org-lang)
+ (plist-get info :latex-listings-langs)))
+ org-lang))
+ (options (org-latex--make-option-string
+ (append (plist-get info :latex-listings-options)
+ `(("language" ,lst-lang))))))
+ (concat (format "\\lstinline[%s]" options)
+ separator code separator))))))
;;;; Inlinetask
@@ -1511,40 +2118,40 @@ holding contextual information."
(tags (and (plist-get info :with-tags)
(org-export-get-tags inlinetask info)))
(priority (and (plist-get info :with-priority)
- (org-element-property :priority inlinetask))))
- ;; If `org-latex-format-inlinetask-function' is provided, call it
- ;; with appropriate arguments.
- (if (not (eq org-latex-format-inlinetask-function 'ignore))
- (funcall org-latex-format-inlinetask-function
- todo todo-type priority title tags contents)
- ;; Otherwise, use a default template.
- (org-latex--wrap-label
- inlinetask
- (let ((full-title
- (concat
- (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
- (when priority (format "\\framebox{\\#%c} " priority))
- title
- (when tags (format "\\hfill{}\\textsc{:%s:}"
- (mapconcat #'identity tags ":"))))))
- (concat "\\begin{center}\n"
- "\\fbox{\n"
- "\\begin{minipage}[c]{.6\\textwidth}\n"
- full-title "\n\n"
- (and (org-string-nw-p contents)
- (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
- "\\end{minipage}\n"
- "}\n"
- "\\end{center}"))))))
+ (org-element-property :priority inlinetask)))
+ (contents (concat (org-latex--label inlinetask info) contents)))
+ (funcall (plist-get info :latex-format-inlinetask-function)
+ todo todo-type priority title tags contents info)))
+
+(defun org-latex-format-inlinetask-default-function
+ (todo _todo-type priority title tags contents _info)
+ "Default format function for a inlinetasks.
+See `org-latex-format-inlinetask-function' for details."
+ (let ((full-title
+ (concat (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo))
+ (when priority (format "\\framebox{\\#%c} " priority))
+ title
+ (when tags
+ (format "\\hfill{}\\textsc{:%s:}"
+ (mapconcat #'org-latex--protect-text tags ":"))))))
+ (concat "\\begin{center}\n"
+ "\\fbox{\n"
+ "\\begin{minipage}[c]{.6\\textwidth}\n"
+ full-title "\n\n"
+ (and (org-string-nw-p contents)
+ (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
+ "\\end{minipage}\n"
+ "}\n"
+ "\\end{center}")))
;;;; Italic
-(defun org-latex-italic (italic contents info)
+(defun org-latex-italic (_italic contents info)
"Transcode ITALIC from Org to LaTeX.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
- (org-latex--text-markup contents 'italic))
+ (org-latex--text-markup contents 'italic info))
;;;; Item
@@ -1565,14 +2172,14 @@ contextual information."
(when (and (eq (org-element-type parent) 'plain-list)
(eq (org-element-property :type parent)
'ordered))
- (incf level)))
+ (cl-incf level)))
level)))
(and count
(< level 5)
(format "\\setcounter{enum%s}{%s}\n"
(nth (1- level) '("i" "ii" "iii" "iv"))
(1- count)))))
- (checkbox (case (org-element-property :checkbox item)
+ (checkbox (cl-case (org-element-property :checkbox item)
(on "$\\boxtimes$ ")
(off "$\\square$ ")
(trans "$\\boxminus$ ")))
@@ -1591,7 +2198,7 @@ contextual information."
;; unless the brackets comes from an initial export
;; snippet (i.e. it is inserted willingly by the user).
((and contents
- (org-string-match-p "\\`[ \t]*\\[" contents)
+ (string-match-p "\\`[ \t]*\\[" contents)
(not (let ((e (car (org-element-contents item))))
(and (eq (org-element-type e) 'paragraph)
(let ((o (car (org-element-contents e))))
@@ -1612,7 +2219,7 @@ contextual information."
;;;; Keyword
-(defun org-latex-keyword (keyword contents info)
+(defun org-latex-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -1621,60 +2228,107 @@ CONTENTS is nil. INFO is a plist holding contextual information."
((string= key "LATEX") value)
((string= key "INDEX") (format "\\index{%s}" value))
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
- (string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (concat
- (when (wholenump depth)
- (format "\\setcounter{tocdepth}{%s}\n" depth))
- "\\tableofcontents")))
- ((string= "tables" value) "\\listoftables")
- ((string= "listings" value)
- (cond
- ((eq org-latex-listings 'minted) "\\listoflistings")
- (org-latex-listings "\\lstlistoflistings")
- ;; At the moment, src blocks with a caption are wrapped
- ;; into a figure environment.
- (t "\\listoffigures")))))))))
+ ((string-match-p "\\<headlines\\>" value)
+ (let* ((localp (string-match-p "\\<local\\>" value))
+ (parent (org-element-lineage keyword '(headline)))
+ (level (if (not (and localp parent)) 0
+ (org-export-get-relative-level parent info)))
+ (depth
+ (and (string-match "\\<[0-9]+\\>" value)
+ (format
+ "\\setcounter{tocdepth}{%d}"
+ (+ (string-to-number (match-string 0 value)) level)))))
+ (if (and localp parent)
+ ;; Start local TOC, assuming package "titletoc" is
+ ;; required.
+ (format "\\startcontents[level-%d]
+\\printcontents[level-%d]{}{0}{%s}"
+ level level (or depth ""))
+ (concat depth (and depth "\n") "\\tableofcontents"))))
+ ((string-match-p "\\<tables\\>" value) "\\listoftables")
+ ((string-match-p "\\<listings\\>" value)
+ (cl-case (plist-get info :latex-listings)
+ ((nil) "\\listoffigures")
+ (minted "\\listoflistings")
+ (otherwise "\\lstlistoflistings")))))))))
;;;; Latex Environment
-(defun org-latex-latex-environment (latex-environment contents info)
+(defun org-latex--environment-type (latex-environment)
+ "Return the TYPE of LATEX-ENVIRONMENT.
+
+The TYPE is determined from the actual latex environment, and
+could be a member of `org-latex-caption-above' or `math'."
+ (let* ((latex-begin-re "\\\\begin{\\([A-Za-z0-9*]+\\)}")
+ (value (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (env (or (and (string-match latex-begin-re value)
+ (match-string 1 value))
+ "")))
+ (cond
+ ((string-match-p org-latex-math-environments-re value) 'math)
+ ((string-match-p
+ (eval-when-compile
+ (regexp-opt '("table" "longtable" "tabular" "tabu" "longtabu")))
+ env)
+ 'table)
+ ((string-match-p "figure" env) 'image)
+ ((string-match-p
+ (eval-when-compile
+ (regexp-opt '("lstlisting" "listing" "verbatim" "minted")))
+ env)
+ 'src-block)
+ (t 'special-block))))
+
+(defun org-latex-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (plist-get info :with-latex)
- (let ((label (org-element-property :name latex-environment))
- (value (org-remove-indentation
- (org-element-property :value latex-environment))))
- (if (not (org-string-nw-p label)) value
+ (let* ((value (org-remove-indentation
+ (org-element-property :value latex-environment)))
+ (type (org-latex--environment-type latex-environment))
+ (caption (if (eq type 'math)
+ (org-latex--label latex-environment info nil t)
+ (org-latex--caption/label-string latex-environment info)))
+ (caption-above-p
+ (memq type (append (plist-get info :latex-caption-above) '(math)))))
+ (if (not (or (org-element-property :name latex-environment)
+ (org-element-property :caption latex-environment)))
+ value
;; Environment is labeled: label must be within the environment
;; (otherwise, a reference pointing to that element will count
- ;; the section instead).
+ ;; the section instead). Also insert caption if `latex-environment'
+ ;; is not a math environment.
(with-temp-buffer
(insert value)
- (goto-char (point-min))
- (forward-line)
- (insert
- (format "\\label{%s}\n" (org-export-solidify-link-text label)))
+ (if caption-above-p
+ (progn
+ (goto-char (point-min))
+ (forward-line))
+ (goto-char (point-max))
+ (forward-line -1))
+ (insert caption)
(buffer-string))))))
-
;;;; Latex Fragment
-(defun org-latex-latex-fragment (latex-fragment contents info)
+(defun org-latex-latex-fragment (latex-fragment _contents _info)
"Transcode a LATEX-FRAGMENT object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
- (when (plist-get info :with-latex)
- (org-element-property :value latex-fragment)))
+ (let ((value (org-element-property :value latex-fragment)))
+ ;; Trim math markers since the fragment is enclosed within
+ ;; a latex-math-block object anyway.
+ (cond ((string-match-p "\\`\\$[^$]" value) (substring value 1 -1))
+ ((string-prefix-p "\\(" value) (substring value 2 -2))
+ (t value))))
;;;; Line Break
-(defun org-latex-line-break (line-break contents info)
+(defun org-latex-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
"\\\\\n")
@@ -1682,6 +2336,9 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Link
+(defun org-latex-image-link-filter (data _backend info)
+ (org-export-insert-image-links data info org-latex-inline-image-rules))
+
(defun org-latex--inline-image (link info)
"Return LaTeX code for an inline image.
LINK is the link pointing to the inline image. INFO is a plist
@@ -1692,36 +2349,43 @@ used as a communication channel."
(expand-file-name raw-path))))
(filetype (file-name-extension path))
(caption (org-latex--caption/label-string parent info))
+ (caption-above-p (org-latex--caption-above-p link info))
;; Retrieve latex attributes from the element around.
(attr (org-export-read-attribute :attr_latex parent))
(float (let ((float (plist-get attr :float)))
- (cond ((and (not float) (plist-member attr :float)) nil)
- ((string= float "wrap") 'wrap)
+ (cond ((string= float "wrap") 'wrap)
+ ((string= float "sideways") 'sideways)
((string= float "multicolumn") 'multicolumn)
+ ((and (plist-member attr :float) (not float)) 'nonfloat)
((or float
(org-element-property :caption parent)
(org-string-nw-p (plist-get attr :caption)))
- 'figure))))
+ 'figure)
+ (t 'nonfloat))))
(placement
(let ((place (plist-get attr :placement)))
- (cond (place (format "%s" place))
- ((eq float 'wrap) "{l}{0.5\\textwidth}")
- ((eq float 'figure)
- (format "[%s]" org-latex-default-figure-position))
- (t ""))))
+ (cond
+ (place (format "%s" place))
+ ((eq float 'wrap) "{l}{0.5\\textwidth}")
+ ((eq float 'figure)
+ (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)))
(comment-include (if (plist-get attr :comment-include) "%" ""))
;; It is possible to specify width and height in the
;; ATTR_LATEX line, and also via default variables.
(width (cond ((plist-get attr :width))
((plist-get attr :height) "")
((eq float 'wrap) "0.48\\textwidth")
- (t org-latex-image-default-width)))
+ (t (plist-get info :latex-image-default-width))))
(height (cond ((plist-get attr :height))
((or (plist-get attr :width)
(memq float '(figure wrap))) "")
- (t org-latex-image-default-height)))
+ (t (plist-get info :latex-image-default-height))))
(options (let ((opt (or (plist-get attr :options)
- org-latex-image-default-option)))
+ (plist-get info :latex-image-default-option))))
(if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt
(match-string 1 opt))))
image-code)
@@ -1750,11 +2414,17 @@ used as a communication channel."
(setq options (concat options ",width=" width)))
(when (org-string-nw-p height)
(setq options (concat options ",height=" height)))
+ (let ((search-option (org-element-property :search-option link)))
+ (when (and search-option
+ (equal filetype "pdf")
+ (string-match-p "\\`[0-9]+\\'" search-option)
+ (not (string-match-p "page=" options)))
+ (setq options (concat options ",page=" search-option))))
(setq image-code
(format "\\includegraphics%s{%s}"
(cond ((not (org-string-nw-p options)) "")
- ((= (aref options 0) ?,)
- (format "[%s]"(substring options 1)))
+ ((string-prefix-p "," options)
+ (format "[%s]" (substring options 1)))
(t (format "[%s]" options)))
path))
(when (equal filetype "svg")
@@ -1767,20 +2437,53 @@ used as a communication channel."
image-code
nil t))))
;; Return proper string, depending on FLOAT.
- (case float
- (wrap (format "\\begin{wrapfigure}%s
-\\centering
+ (pcase float
+ (`wrap (format "\\begin{wrapfigure}%s
+%s%s
+%s%s
+%s\\end{wrapfigure}"
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (`sideways (format "\\begin{sidewaysfigure}
+%s%s
+%s%s
+%s\\end{sidewaysfigure}"
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (`multicolumn (format "\\begin{figure*}%s
%s%s
-%s\\end{wrapfigure}" placement comment-include image-code caption))
- (multicolumn (format "\\begin{figure*}%s
-\\centering
%s%s
-%s\\end{figure*}" placement comment-include image-code caption))
- (figure (format "\\begin{figure}%s
-\\centering
+%s\\end{figure*}"
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ (`figure (format "\\begin{figure}%s
%s%s
-%s\\end{figure}" placement comment-include image-code caption))
- (otherwise image-code))))
+%s%s
+%s\\end{figure}"
+ placement
+ (if caption-above-p caption "")
+ (if center "\\centering" "")
+ comment-include image-code
+ (if caption-above-p "" caption)))
+ ((guard center)
+ (format "\\begin{center}
+%s%s
+%s\\end{center}"
+ (if caption-above-p caption "")
+ image-code
+ (if caption-above-p "" caption)))
+ (_
+ (concat (if caption-above-p caption "")
+ image-code
+ (if caption-above-p caption ""))))))
(defun org-latex-link (link desc info)
"Transcode a LINK object from Org to LaTeX.
@@ -1789,20 +2492,19 @@ 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 (replace-regexp-in-string
- "%" "\\%" (org-element-property :path link) nil t))
+ (raw-path (org-element-property :path link))
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
(imagep (org-export-inline-image-p
- link org-latex-inline-image-rules))
- (path (cond
- ((member type '("http" "https" "ftp" "mailto"))
- (concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ 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)))))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc 'latex))
;; Image file.
(imagep (org-latex--inline-image link info))
;; Radio link: Transcode target's contents and use them as link's
@@ -1811,8 +2513,7 @@ INFO is a plist holding contextual information. See
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
(format "\\hyperref[%s]{%s}"
- (org-export-solidify-link-text
- (org-element-property :value destination))
+ (org-export-get-reference destination info)
desc))))
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
@@ -1820,14 +2521,14 @@ INFO is a plist holding contextual information. See
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
+ (cl-case (org-element-type destination)
;; Id link points to an external file.
(plain-text
(if desc (format "\\href{%s}{%s}" destination desc)
(format "\\url{%s}" destination)))
;; Fuzzy link points nowhere.
- ('nil
- (format org-latex-link-with-unknown-path-format
+ ((nil)
+ (format (plist-get info :latex-link-with-unknown-path-format)
(or desc
(org-export-data
(org-element-property :raw-link link) info))))
@@ -1836,12 +2537,7 @@ INFO is a plist holding contextual information. See
;; number. Otherwise, display description or headline's
;; title.
(headline
- (let ((label
- (format "sec-%s"
- (mapconcat
- 'number-to-string
- (org-export-get-headline-number destination info)
- "-"))))
+ (let ((label (org-latex--label destination info t)))
(if (and (not desc)
(org-export-numbered-headline-p destination info))
(format "\\ref{%s}" label)
@@ -1851,28 +2547,37 @@ INFO is a plist holding contextual information. See
(org-element-property :title destination) info))))))
;; Fuzzy link points to a target. Do as above.
(otherwise
- (let ((path (org-export-solidify-link-text path)))
- (if (not desc) (format "\\ref{%s}" path)
- (format "\\hyperref[%s]{%s}" path desc)))))))
+ (let ((ref (org-latex--label destination info t)))
+ (if (not desc) (format "\\ref{%s}" ref)
+ (format "\\hyperref[%s]{%s}" ref desc)))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
(format (org-export-get-coderef-format path desc)
(org-export-resolve-coderef path info)))
- ;; Link type is handled by a special function.
- ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
- (funcall protocol (org-link-unescape path) desc 'latex))
;; External link with a description part.
((and path desc) (format "\\href{%s}{%s}" path desc))
;; External link without a description part.
(path (format "\\url{%s}" path))
;; No path, only description. Try to do something useful.
- (t (format org-latex-link-with-unknown-path-format desc)))))
+ (t (format (plist-get info :latex-link-with-unknown-path-format) desc)))))
+
+
+;;;; Node Property
+
+(defun org-latex-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element from Org to LaTeX.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
;;;; Paragraph
-(defun org-latex-paragraph (paragraph contents info)
+(defun org-latex-paragraph (_paragraph contents _info)
"Transcode a PARAGRAPH element from Org to LaTeX.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
@@ -1898,7 +2603,8 @@ contextual information."
latex-type
(or (plist-get attr :options) "")
contents
- latex-type))))
+ latex-type)
+ info)))
;;;; Plain Text
@@ -1907,54 +2613,42 @@ contextual information."
"Transcode a TEXT string from Org to LaTeX.
TEXT is the string to transcode. INFO is a plist holding
contextual information."
- (let ((specialp (plist-get info :with-special-strings))
- (output text))
- ;; Protect %, #, &, $, _, { and }.
- (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output)
- (setq output
- (replace-match
- (format "\\%s" (match-string 2 output)) nil t output 2)))
- ;; Protect ^.
- (setq output
- (replace-regexp-in-string
- "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2))
- ;; Protect \. If special strings are used, be careful not to
- ;; protect "\" in "\-" constructs.
- (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\")))
- (setq output
+ (let* ((specialp (plist-get info :with-special-strings))
+ (output
+ ;; Turn LaTeX into \LaTeX{} and TeX into \TeX{}.
+ (let ((case-fold-search nil))
(replace-regexp-in-string
- (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols)
- "$\\backslash$" output nil t 1)))
- ;; Protect ~.
- (setq output
- (replace-regexp-in-string
- "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2))
+ "\\<\\(?:La\\)?TeX\\>" "\\\\\\&{}"
+ ;; Protect ^, ~, %, #, &, $, _, { and }. Also protect \.
+ ;; However, if special strings are used, be careful not
+ ;; to protect "\" in "\-" constructs.
+ (replace-regexp-in-string
+ (concat "[%$#&{}_~^]\\|\\\\" (and specialp "\\([^-]\\|$\\)"))
+ (lambda (m)
+ (cl-case (string-to-char m)
+ (?\\ "$\\\\backslash$\\1")
+ (?~ "\\\\textasciitilde{}")
+ (?^ "\\\\^{}")
+ (t "\\\\\\&")))
+ text)))))
;; Activate smart quotes. Be sure to provide original TEXT string
;; since OUTPUT may have been modified.
(when (plist-get info :with-smart-quotes)
(setq output (org-export-activate-smart-quotes output :latex info text)))
- ;; LaTeX into \LaTeX{} and TeX into \TeX{}.
- (let ((case-fold-search nil)
- (start 0))
- (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start)
- (setq output (replace-match
- (format "\\%s{}" (match-string 1 output)) nil t output)
- start (match-end 0))))
;; Convert special strings.
(when specialp
- (setq output
- (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t)))
+ (setq output (replace-regexp-in-string "\\.\\.\\." "\\\\ldots{}" output)))
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output)))
+ "\\(?:[ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n" output nil t)))
;; Return value.
output))
;;;; Planning
-(defun org-latex-planning (planning contents info)
+(defun org-latex-planning (planning _contents info)
"Transcode a PLANNING element from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1968,27 +2662,165 @@ information."
(when closed
(concat
(format "\\textbf{%s} " org-closed-string)
- (format org-latex-inactive-timestamp-format
- (org-translate-time
- (org-element-property :raw-value closed))))))
+ (format (plist-get info :latex-inactive-timestamp-format)
+ (org-timestamp-translate closed)))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(concat
(format "\\textbf{%s} " org-deadline-string)
- (format org-latex-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value deadline))))))
+ (format (plist-get info :latex-active-timestamp-format)
+ (org-timestamp-translate deadline)))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(concat
(format "\\textbf{%s} " org-scheduled-string)
- (format org-latex-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value scheduled))))))))
+ (format (plist-get info :latex-active-timestamp-format)
+ (org-timestamp-translate scheduled)))))))
" ")
"\\\\"))
+;;;; Property Drawer
+
+(defun org-latex-property-drawer (_property-drawer contents _info)
+ "Transcode a PROPERTY-DRAWER element from Org to LaTeX.
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "\\begin{verbatim}\n%s\\end{verbatim}" contents)))
+
+
+;;;; Pseudo Element: LaTeX Matrices
+
+;; `latex-matrices' elements have the following properties:
+;; `:caption', `:post-blank' and `:markup' (`inline', `equation' or
+;; `math').
+
+(defun org-latex--wrap-latex-matrices (data info)
+ "Merge contiguous tables with the same mode within a pseudo-element.
+DATA is a parse tree or a secondary string. INFO is a plist
+containing export options. Modify DATA by side-effect and return
+it."
+ (org-element-map data 'table
+ (lambda (table)
+ (when (eq (org-element-property :type table) 'org)
+ (let ((mode (or (org-export-read-attribute :attr_latex table :mode)
+ (plist-get info :latex-default-table-mode))))
+ (when (and (member mode '("inline-math" "math"))
+ ;; Do not wrap twice the same table.
+ (not (eq (org-element-type
+ (org-element-property :parent table))
+ 'latex-matrices)))
+ (let* ((caption (and (not (string= mode "inline-math"))
+ (org-element-property :caption table)))
+ (matrices
+ (list 'latex-matrices
+ (list :caption caption
+ :markup
+ (cond ((string= mode "inline-math") 'inline)
+ (caption 'equation)
+ (t 'math)))))
+ (previous table)
+ (next (org-export-get-next-element table info)))
+ (org-element-insert-before matrices table)
+ ;; Swallow all contiguous tables sharing the same mode.
+ (while (and
+ (zerop (or (org-element-property :post-blank previous) 0))
+ (setq next (org-export-get-next-element previous info))
+ (eq (org-element-type next) 'table)
+ (eq (org-element-property :type next) 'org)
+ (string= (or (org-export-read-attribute
+ :attr_latex next :mode)
+ (plist-get info :latex-default-table-mode))
+ mode))
+ (org-element-extract-element previous)
+ (org-element-adopt-elements matrices previous)
+ (setq previous next))
+ ;; Inherit `:post-blank' from the value of the last
+ ;; swallowed table. Set the latter's `:post-blank'
+ ;; value to 0 so as to not duplicate empty lines.
+ (org-element-put-property
+ matrices :post-blank (org-element-property :post-blank previous))
+ (org-element-put-property previous :post-blank 0)
+ (org-element-extract-element previous)
+ (org-element-adopt-elements matrices previous))))))
+ info)
+ data)
+
+(defun org-latex-matrices (matrices contents _info)
+ "Transcode a MATRICES element from Org to LaTeX.
+CONTENTS is a string. INFO is a plist used as a communication
+channel."
+ (format (cl-case (org-element-property :markup matrices)
+ (inline "\\(%s\\)")
+ (equation "\\begin{equation}\n%s\\end{equation}")
+ (t "\\[\n%s\\]"))
+ contents))
+
+
+;;;; Pseudo Object: LaTeX Math Block
+
+;; `latex-math-block' objects have the following property:
+;; `:post-blank'.
+
+(defun org-latex--wrap-latex-math-block (data info)
+ "Merge contiguous math objects in a pseudo-object container.
+DATA is a parse tree or a secondary string. INFO is a plist
+containing export options. Modify DATA by side-effect and return it."
+ (let ((valid-object-p
+ ;; Non-nil when OBJ can be added to the latex math block B.
+ (lambda (obj b)
+ (pcase (org-element-type obj)
+ (`entity (org-element-property :latex-math-p obj))
+ (`latex-fragment
+ (let ((value (org-element-property :value obj)))
+ (or (string-prefix-p "\\(" value)
+ (string-match-p "\\`\\$[^$]" value))))
+ ((and type (or `subscript `superscript))
+ (not (memq type (mapcar #'org-element-type
+ (org-element-contents b)))))))))
+ (org-element-map data '(entity latex-fragment subscript superscript)
+ (lambda (object)
+ ;; Skip objects already wrapped.
+ (when (and (not (eq (org-element-type
+ (org-element-property :parent object))
+ 'latex-math-block))
+ (funcall valid-object-p object nil))
+ (let ((math-block (list 'latex-math-block nil))
+ (next-elements (org-export-get-next-element object info t))
+ (last object))
+ ;; Wrap MATH-BLOCK around OBJECT in DATA.
+ (org-element-insert-before math-block object)
+ (org-element-extract-element object)
+ (org-element-adopt-elements math-block object)
+ (when (zerop (or (org-element-property :post-blank object) 0))
+ ;; MATH-BLOCK swallows consecutive math objects.
+ (catch 'exit
+ (dolist (next next-elements)
+ (unless (funcall valid-object-p next math-block)
+ (throw 'exit nil))
+ (org-element-extract-element next)
+ (org-element-adopt-elements math-block next)
+ ;; Eschew the case: \beta$x$ -> \(\betax\).
+ (unless (memq (org-element-type next)
+ '(subscript superscript))
+ (org-element-put-property last :post-blank 1))
+ (setq last next)
+ (when (> (or (org-element-property :post-blank next) 0) 0)
+ (throw 'exit nil)))))
+ (org-element-put-property
+ math-block :post-blank (org-element-property :post-blank last)))))
+ info nil '(subscript superscript latex-math-block) t)
+ ;; Return updated DATA.
+ data))
+
+(defun org-latex-math-block (_math-block contents _info)
+ "Transcode a MATH-BLOCK object from Org to LaTeX.
+CONTENTS is a string. INFO is a plist used as a communication
+channel."
+ (when (org-string-nw-p contents)
+ (format "\\(%s\\)" (org-trim contents))))
+
;;;; Quote Block
(defun org-latex-quote-block (quote-block contents info)
@@ -1996,18 +2828,7 @@ information."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(org-latex--wrap-label
- quote-block
- (format "\\begin{quote}\n%s\\end{quote}" contents)))
-
-
-;;;; Quote Section
-
-(defun org-latex-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to LaTeX.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value))))
+ quote-block (format "\\begin{quote}\n%s\\end{quote}" contents) info))
;;;; Radio Target
@@ -2016,15 +2837,12 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Transcode a RADIO-TARGET object from Org to LaTeX.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (format "\\label{%s}%s"
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
- text))
+ (format "\\label{%s}%s" (org-export-get-reference radio-target info) text))
;;;; Section
-(defun org-latex-section (section contents info)
+(defun org-latex-section (_section contents _info)
"Transcode a SECTION element from Org to LaTeX.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -2037,85 +2855,110 @@ holding contextual information."
"Transcode a SPECIAL-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block)))
- (opt (org-export-read-attribute :attr_latex special-block :options)))
+ (let ((type (org-element-property :type special-block))
+ (opt (org-export-read-attribute :attr_latex special-block :options))
+ (caption (org-latex--caption/label-string special-block info))
+ (caption-above-p (org-latex--caption-above-p special-block info)))
(concat (format "\\begin{%s}%s\n" type (or opt ""))
- ;; Insert any label or caption within the block
- ;; (otherwise, a reference pointing to that element will
- ;; count the section instead).
- (org-latex--caption/label-string special-block info)
+ (and caption-above-p caption)
contents
+ (and (not caption-above-p) caption)
(format "\\end{%s}" type))))
;;;; Src Block
-(defun org-latex-src-block (src-block contents info)
+(defun org-latex-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(when (org-string-nw-p (org-element-property :value src-block))
(let* ((lang (org-element-property :language src-block))
(caption (org-element-property :caption src-block))
+ (caption-above-p (org-latex--caption-above-p src-block info))
(label (org-element-property :name src-block))
(custom-env (and lang
(cadr (assq (intern lang)
org-latex-custom-lang-environments))))
- (num-start (case (org-element-property :number-lines src-block)
- (continued (org-export-get-loc src-block info))
- (new 0)))
+ (num-start (org-export-get-loc src-block info))
(retain-labels (org-element-property :retain-labels src-block))
(attributes (org-export-read-attribute :attr_latex src-block))
- (float (plist-get attributes :float)))
+ (float (plist-get attributes :float))
+ (listings (plist-get info :latex-listings)))
(cond
;; Case 1. No source fontification.
- ((not org-latex-listings)
+ ((not listings)
(let* ((caption-str (org-latex--caption/label-string src-block info))
(float-env
- (cond ((and (not float) (plist-member attributes :float)) "%s")
- ((string= "multicolumn" float)
- (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}"
- org-latex-default-figure-position
- caption-str))
- ((or caption float)
- (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}"
- caption-str))
+ (cond ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%s%%s\n%s\\end{figure*}"
+ (plist-get info :latex-default-figure-position)
+ (if caption-above-p caption-str "")
+ (if caption-above-p "" caption-str)))
+ (caption (concat
+ (if caption-above-p caption-str "")
+ "%s"
+ (if caption-above-p "" (concat "\n" caption-str))))
(t "%s"))))
(format
float-env
(concat (format "\\begin{verbatim}\n%s\\end{verbatim}"
(org-export-format-code-default src-block info))))))
;; Case 2. Custom environment.
- (custom-env (format "\\begin{%s}\n%s\\end{%s}\n"
- custom-env
- (org-export-format-code-default src-block info)
- custom-env))
+ (custom-env
+ (let ((caption-str (org-latex--caption/label-string src-block info))
+ (formatted-src (org-export-format-code-default src-block info)))
+ (if (string-match-p "\\`[a-zA-Z0-9]+\\'" custom-env)
+ (format "\\begin{%s}\n%s\\end{%s}\n"
+ custom-env
+ (concat (and caption-above-p caption-str)
+ formatted-src
+ (and (not caption-above-p) caption-str))
+ custom-env)
+ (format-spec custom-env
+ `((?s . ,formatted-src)
+ (?c . ,caption)
+ (?f . ,float)
+ (?l . ,(org-latex--label src-block info))
+ (?o . ,(or (plist-get attributes :options) "")))))))
;; Case 3. Use minted package.
- ((eq org-latex-listings 'minted)
+ ((eq listings 'minted)
(let* ((caption-str (org-latex--caption/label-string src-block info))
(float-env
- (cond ((and (not float) (plist-member attributes :float)) "%s")
- ((string= "multicolumn" float)
- (format "\\begin{listing*}\n%%s\n%s\\end{listing*}"
- caption-str))
- ((or caption float)
- (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
- caption-str))
- (t "%s")))
+ (cond
+ ((string= "multicolumn" float)
+ (format "\\begin{listing*}[%s]\n%s%%s\n%s\\end{listing*}"
+ (plist-get info :latex-default-figure-position)
+ (if caption-above-p caption-str "")
+ (if caption-above-p "" caption-str)))
+ (caption
+ (format "\\begin{listing}[%s]\n%s%%s\n%s\\end{listing}"
+ (plist-get info :latex-default-figure-position)
+ (if caption-above-p caption-str "")
+ (if caption-above-p "" caption-str)))
+ ((string= "t" float)
+ (concat (format "\\begin{listing}[%s]\n"
+ (plist-get info :latex-default-figure-position))
+ "%s\n\\end{listing}"))
+ (t "%s")))
+ (options (plist-get info :latex-minted-options))
(body
(format
"\\begin{minted}[%s]{%s}\n%s\\end{minted}"
;; Options.
- (org-latex--make-option-string
- (if (or (not num-start)
- (assoc "linenos" org-latex-minted-options))
- org-latex-minted-options
- (append
- `(("linenos")
- ("firstnumber" ,(number-to-string (1+ num-start))))
- org-latex-minted-options)))
+ (concat
+ (org-latex--make-option-string
+ (if (or (not num-start) (assoc "linenos" options))
+ options
+ (append
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ options)))
+ (let ((local-options (plist-get attributes :options)))
+ (and local-options (concat "," local-options))))
;; Language.
- (or (cadr (assq (intern lang) org-latex-minted-langs))
+ (or (cadr (assq (intern lang)
+ (plist-get info :latex-minted-langs)))
(downcase lang))
;; Source code.
(let* ((code-info (org-export-unravel-code src-block))
@@ -2126,7 +2969,7 @@ contextual information."
"\n")))))
(org-export-format-code
(car code-info)
- (lambda (loc num ref)
+ (lambda (loc _num ref)
(concat
loc
(when ref
@@ -2142,7 +2985,9 @@ contextual information."
;; Case 4. Use listings package.
(t
(let ((lst-lang
- (or (cadr (assq (intern lang) org-latex-listings-langs)) lang))
+ (or (cadr (assq (intern lang)
+ (plist-get info :latex-listings-langs)))
+ lang))
(caption-str
(when caption
(let ((main (org-export-get-caption src-block))
@@ -2151,28 +2996,33 @@ contextual information."
(format "{%s}" (org-export-data main info))
(format "{[%s]%s}"
(org-export-data secondary info)
- (org-export-data main info)))))))
+ (org-export-data main info))))))
+ (lst-opt (plist-get info :latex-listings-options)))
(concat
;; Options.
(format
"\\lstset{%s}\n"
- (org-latex--make-option-string
- (append
- org-latex-listings-options
- (cond
- ((and (not float) (plist-member attributes :float)) nil)
- ((string= "multicolumn" float) '(("float" "*")))
- ((and float (not (assoc "float" org-latex-listings-options)))
- `(("float" ,org-latex-default-figure-position))))
- `(("language" ,lst-lang))
- (if label `(("label" ,label)) '(("label" " ")))
- (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
- (cond ((assoc "numbers" org-latex-listings-options) nil)
- ((not num-start) '(("numbers" "none")))
- ((zerop num-start) '(("numbers" "left")))
- (t `(("numbers" "left")
- ("firstnumber"
- ,(number-to-string (1+ num-start)))))))))
+ (concat
+ (org-latex--make-option-string
+ (append
+ lst-opt
+ (cond
+ ((and (not float) (plist-member attributes :float)) nil)
+ ((string= "multicolumn" float) '(("float" "*")))
+ ((and float (not (assoc "float" lst-opt)))
+ `(("float" ,(plist-get info :latex-default-figure-position)))))
+ `(("language" ,lst-lang))
+ (if label
+ `(("label" ,(org-latex--label src-block info)))
+ '(("label" " ")))
+ (if caption-str `(("caption" ,caption-str)) '(("caption" " ")))
+ `(("captionpos" ,(if caption-above-p "t" "b")))
+ (cond ((assoc "numbers" lst-opt) nil)
+ ((not num-start) '(("numbers" "none")))
+ (t `(("firstnumber" ,(number-to-string (1+ num-start)))
+ ("numbers" "left"))))))
+ (let ((local-options (plist-get attributes :options)))
+ (and local-options (concat "," local-options)))))
;; Source code.
(format
"\\begin{lstlisting}\n%s\\end{lstlisting}"
@@ -2183,21 +3033,21 @@ contextual information."
(org-split-string (car code-info) "\n")))))
(org-export-format-code
(car code-info)
- (lambda (loc num ref)
+ (lambda (loc _num ref)
(concat
loc
(when ref
;; Ensure references are flushed to the right,
;; separated with 6 spaces from the widest line of
;; code
- (concat (make-string (+ (- max-width (length loc)) 6) ? )
+ (concat (make-string (+ (- max-width (length loc)) 6) ?\s)
(format "(%s)" ref)))))
nil (and retain-labels (cdr code-info))))))))))))
;;;; Statistics Cookie
-(defun org-latex-statistics-cookie (statistics-cookie contents info)
+(defun org-latex-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual information."
(replace-regexp-in-string
@@ -2206,11 +3056,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Strike-Through
-(defun org-latex-strike-through (strike-through contents info)
+(defun org-latex-strike-through (_strike-through contents info)
"Transcode STRIKE-THROUGH from Org to LaTeX.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
- (org-latex--text-markup contents 'strike-through))
+ (org-latex--text-markup contents 'strike-through info))
;;;; Subscript
@@ -2219,22 +3069,11 @@ holding contextual information."
"Transcode a subscript or superscript object.
OBJECT is an Org object. INFO is a plist used as a communication
channel."
- (let ((in-script-p
- ;; Non-nil if object is already in a sub/superscript.
- (let ((parent object))
- (catch 'exit
- (while (setq parent (org-export-get-parent parent))
- (let ((type (org-element-type parent)))
- (cond ((memq type '(subscript superscript))
- (throw 'exit t))
- ((memq type org-element-all-elements)
- (throw 'exit nil))))))))
- (type (org-element-type object))
- (output ""))
+ (let ((output ""))
(org-element-map (org-element-contents object)
(cons 'plain-text org-element-all-objects)
(lambda (obj)
- (case (org-element-type obj)
+ (cl-case (org-element-type obj)
((entity latex-fragment)
(let ((data (org-trim (org-export-data obj info))))
(string-match
@@ -2255,33 +3094,14 @@ channel."
(let ((blank (org-element-property :post-blank obj)))
(and blank (> blank 0) "\\ ")))))))
info nil org-element-recursive-objects)
- ;; Result. Do not wrap into math mode if already in a subscript
- ;; or superscript. Do not wrap into curly brackets if OUTPUT is
- ;; a single character. Also merge consecutive subscript and
- ;; superscript into the same math snippet.
- (concat (and (not in-script-p)
- (let ((prev (org-export-get-previous-element object info)))
- (or (not prev)
- (not (eq (org-element-type prev)
- (if (eq type 'subscript) 'superscript
- 'subscript)))
- (let ((blank (org-element-property :post-blank prev)))
- (and blank (> blank 0)))))
- "$")
- (if (eq (org-element-type object) 'subscript) "_" "^")
+ ;; Result. Do not wrap into curly brackets if OUTPUT is a single
+ ;; character.
+ (concat (if (eq (org-element-type object) 'subscript) "_" "^")
(and (> (length output) 1) "{")
output
- (and (> (length output) 1) "}")
- (and (not in-script-p)
- (or (let ((blank (org-element-property :post-blank object)))
- (and blank (> blank 0)))
- (not (eq (org-element-type
- (org-export-get-next-element object info))
- (if (eq type 'subscript) 'superscript
- 'subscript))))
- "$"))))
+ (and (> (length output) 1) "}"))))
-(defun org-latex-subscript (subscript contents info)
+(defun org-latex-subscript (subscript _contents info)
"Transcode a SUBSCRIPT object from Org to LaTeX.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -2290,7 +3110,7 @@ contextual information."
;;;; Superscript
-(defun org-latex-superscript (superscript contents info)
+(defun org-latex-superscript (superscript _contents info)
"Transcode a SUPERSCRIPT object from Org to LaTeX.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -2316,7 +3136,7 @@ contextual information."
;; "table.el" table. Convert it using appropriate tools.
(org-latex--table.el-table table info)
(let ((type (or (org-export-read-attribute :attr_latex table :mode)
- org-latex-default-table-mode)))
+ (plist-get info :latex-default-table-mode))))
(cond
;; Case 1: Verbatim table.
((string= type "verbatim")
@@ -2333,10 +3153,12 @@ contextual information."
;; table, insert their definition just after it.
(org-latex--delayed-footnotes-definitions table info)))))))
-(defun org-latex--align-string (table info)
+(defun org-latex--align-string (table info &optional math?)
"Return an appropriate LaTeX alignment string.
TABLE is the considered table. INFO is a plist used as
-a communication channel."
+a communication channel. When optional argument MATH? is
+non-nil, TABLE is meant to be a matrix, where all cells are
+centered."
(or (org-export-read-attribute :attr_latex table :align)
(let (align)
;; Extract column groups and alignment from first (non-rule)
@@ -2352,10 +3174,11 @@ a communication channel."
;; Check left border for the first cell only.
(when (and (memq 'left borders) (not align))
(push "|" align))
- (push (case (org-export-table-cell-alignment cell info)
- (left "l")
- (right "r")
- (center "c"))
+ (push (if math? "c" ;center cells in matrices
+ (cl-case (org-export-table-cell-alignment cell info)
+ (left "l")
+ (right "r")
+ (center "c")))
align)
(when (memq 'right borders) (push "|" align))))
info)
@@ -2376,14 +3199,15 @@ This function assumes TABLE has `org' as its `:type' property and
(alignment (org-latex--align-string table info))
;; Determine environment for the table: longtable, tabular...
(table-env (or (plist-get attr :environment)
- org-latex-default-table-environment))
+ (plist-get info :latex-default-table-environment)))
;; If table is a float, determine environment: table, table*
;; or sidewaystable.
(float-env (unless (member table-env '("longtable" "longtabu"))
(let ((float (plist-get attr :float)))
(cond
((and (not float) (plist-member attr :float)) nil)
- ((string= float "sidewaystable") "sidewaystable")
+ ((or (string= float "sidewaystable")
+ (string= float "sideways")) "sidewaystable")
((string= float "multicolumn") "table*")
((or float
(org-element-property :caption table)
@@ -2392,23 +3216,26 @@ This function assumes TABLE has `org' as its `:type' property and
;; Extract others display options.
(fontsize (let ((font (plist-get attr :font)))
(and font (concat font "\n"))))
- (width (plist-get attr :width))
+ ;; "tabular" environment doesn't allow to define a width.
+ (width (and (not (equal table-env "tabular")) (plist-get attr :width)))
(spreadp (plist-get attr :spread))
- (placement (or (plist-get attr :placement)
- (format "[%s]" org-latex-default-figure-position)))
+ (placement
+ (or (plist-get attr :placement)
+ (format "[%s]" (plist-get info :latex-default-figure-position))))
(centerp (if (plist-member attr :center) (plist-get attr :center)
- org-latex-tables-centered)))
+ (plist-get info :latex-tables-centered)))
+ (caption-above-p (org-latex--caption-above-p table info)))
;; Prepare the final format string for the table.
(cond
;; Longtable.
((equal "longtable" table-env)
(concat (and fontsize (concat "{" fontsize))
(format "\\begin{longtable}{%s}\n" alignment)
- (and org-latex-table-caption-above
+ (and caption-above-p
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
- (and (not org-latex-table-caption-above)
+ (and (not caption-above-p)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
"\\end{longtable}\n"
@@ -2421,11 +3248,11 @@ This function assumes TABLE has `org' as its `:type' property and
(format " %s %s "
(if spreadp "spread" "to") width) "")
alignment)
- (and org-latex-table-caption-above
+ (and caption-above-p
(org-string-nw-p caption)
(concat caption "\\\\\n"))
contents
- (and (not org-latex-table-caption-above)
+ (and (not caption-above-p)
(org-string-nw-p caption)
(concat caption "\\\\\n"))
"\\end{longtabu}\n"
@@ -2434,9 +3261,15 @@ This function assumes TABLE has `org' as its `:type' property and
(t (concat (cond
(float-env
(concat (format "\\begin{%s}%s\n" float-env placement)
- (if org-latex-table-caption-above caption "")
+ (if caption-above-p caption "")
(when centerp "\\centering\n")
fontsize))
+ ((and (not float-env) caption)
+ (concat
+ (and centerp "\\begin{center}\n" )
+ (if caption-above-p caption "")
+ (cond ((and fontsize centerp) fontsize)
+ (fontsize (concat "{" fontsize)))))
(centerp (concat "\\begin{center}\n" fontsize))
(fontsize (concat "{" fontsize)))
(cond ((equal "tabu" table-env)
@@ -2454,8 +3287,13 @@ This function assumes TABLE has `org' as its `:type' property and
table-env)))
(cond
(float-env
- (concat (if org-latex-table-caption-above "" caption)
+ (concat (if caption-above-p "" (concat "\n" caption))
(format "\n\\end{%s}" float-env)))
+ ((and (not float-env) caption)
+ (concat
+ (if caption-above-p "" (concat "\n" caption))
+ (and centerp "\n\\end{center}")
+ (and fontsize (not centerp) "}")))
(centerp "\n\\end{center}")
(fontsize "}")))))))
@@ -2489,10 +3327,10 @@ property."
(let ((n 0) (pos 0))
(while (and (< (length output) pos)
(setq pos (string-match "^\\\\hline\n?" output pos)))
- (incf n)
+ (cl-incf n)
(unless (= n 2) (setq output (replace-match "" nil nil output))))))
(let ((centerp (if (plist-member attr :center) (plist-get attr :center)
- org-latex-tables-centered)))
+ (plist-get info :latex-tables-centered))))
(if (not centerp) output
(format "\\begin{center}\n%s\n\\end{center}" output))))))
@@ -2503,54 +3341,30 @@ TABLE is the table type element to transcode. INFO is a plist
used as a communication channel.
This function assumes TABLE has `org' as its `:type' property and
-`inline-math' or `math' as its `:mode' attribute.."
- (let* ((caption (org-latex--caption/label-string table info))
- (attr (org-export-read-attribute :attr_latex table))
- (inlinep (equal (plist-get attr :mode) "inline-math"))
+`inline-math' or `math' as its `:mode' attribute."
+ (let* ((attr (org-export-read-attribute :attr_latex table))
(env (or (plist-get attr :environment)
- org-latex-default-table-environment))
+ (plist-get info :latex-default-table-environment)))
(contents
(mapconcat
(lambda (row)
- ;; Ignore horizontal rules.
- (when (eq (org-element-property :type row) 'standard)
+ (if (eq (org-element-property :type row) 'rule) "\\hline"
;; Return each cell unmodified.
(concat
(mapconcat
(lambda (cell)
(substring (org-element-interpret-data cell) 0 -1))
- (org-element-map row 'table-cell 'identity info) "&")
+ (org-element-map row 'table-cell #'identity info) "&")
(or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\")
"\n")))
- (org-element-map table 'table-row 'identity info) ""))
- ;; Variables related to math clusters (contiguous math tables
- ;; of the same type).
- (mode (org-export-read-attribute :attr_latex table :mode))
- (prev (org-export-get-previous-element table info))
- (next (org-export-get-next-element table info))
- (same-mode-p
- (lambda (table)
- ;; Non-nil when TABLE has the same mode as current table.
- (string= (or (org-export-read-attribute :attr_latex table :mode)
- org-latex-default-table-mode)
- mode))))
+ (org-element-map table 'table-row #'identity info) "")))
(concat
- ;; Opening string. If TABLE is in the middle of a table cluster,
- ;; do not insert any.
- (cond ((and prev
- (eq (org-element-type prev) 'table)
- (memq (org-element-property :post-blank prev) '(0 nil))
- (funcall same-mode-p prev))
- nil)
- (inlinep "\\(")
- ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption))
- (t "\\["))
;; Prefix.
- (or (plist-get attr :math-prefix) "")
+ (plist-get attr :math-prefix)
;; Environment. Also treat special cases.
- (cond ((equal env "array")
- (let ((align (org-latex--align-string table info)))
- (format "\\begin{array}{%s}\n%s\\end{array}" align contents)))
+ (cond ((member env '("array" "tabular"))
+ (format "\\begin{%s}{%s}\n%s\\end{%s}"
+ env (org-latex--align-string table info t) contents env))
((assoc env org-latex-table-matrix-macros)
(format "\\%s%s{\n%s}"
env
@@ -2558,28 +3372,7 @@ This function assumes TABLE has `org' as its `:type' property and
contents))
(t (format "\\begin{%s}\n%s\\end{%s}" env contents env)))
;; Suffix.
- (or (plist-get attr :math-suffix) "")
- ;; Closing string. If TABLE is in the middle of a table cluster,
- ;; do not insert any. If it closes such a cluster, be sure to
- ;; close the cluster with a string matching the opening string.
- (cond ((and next
- (eq (org-element-type next) 'table)
- (memq (org-element-property :post-blank table) '(0 nil))
- (funcall same-mode-p next))
- nil)
- (inlinep "\\)")
- ;; Find cluster beginning to know which environment to use.
- ((let ((cluster-beg table) prev)
- (while (and (setq prev (org-export-get-previous-element
- cluster-beg info))
- (memq (org-element-property :post-blank prev)
- '(0 nil))
- (funcall same-mode-p prev))
- (setq cluster-beg prev))
- (and (or (org-element-property :caption cluster-beg)
- (org-element-property :name cluster-beg))
- "\n\\end{equation}")))
- (t "\\]")))))
+ (plist-get attr :math-suffix))))
;;;; Table Cell
@@ -2588,16 +3381,18 @@ This function assumes TABLE has `org' as its `:type' property and
"Transcode a TABLE-CELL element from Org to LaTeX.
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat (if (and contents
- org-latex-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-latex-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents)
- (when (org-export-get-next-element table-cell info) " & ")))
+ (concat
+ (let ((scientific-format (plist-get info :latex-table-scientific-notation)))
+ (if (and contents
+ scientific-format
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific
+ ;; notation.
+ (format scientific-format
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents))
+ (when (org-export-get-next-element table-cell info) " & ")))
;;;; Table Row
@@ -2606,87 +3401,106 @@ a communication channel."
"Transcode a TABLE-ROW element from Org to LaTeX.
CONTENTS is the contents of the row. INFO is a plist used as
a communication channel."
- ;; Rules are ignored since table separators are deduced from
- ;; borders of the current row.
- (when (eq (org-element-property :type table-row) 'standard)
- (let* ((attr (org-export-read-attribute :attr_latex
- (org-export-get-parent table-row)))
- (longtablep (member (or (plist-get attr :environment)
- org-latex-default-table-environment)
- '("longtable" "longtabu")))
- (booktabsp (if (plist-member attr :booktabs)
- (plist-get attr :booktabs)
- org-latex-tables-booktabs))
- ;; TABLE-ROW's borders are extracted from its first cell.
- (borders (org-export-table-cell-borders
- (car (org-element-contents table-row)) info)))
+ (let* ((attr (org-export-read-attribute :attr_latex
+ (org-export-get-parent table-row)))
+ (booktabsp (if (plist-member attr :booktabs) (plist-get attr :booktabs)
+ (plist-get info :latex-tables-booktabs)))
+ (longtablep
+ (member (or (plist-get attr :environment)
+ (plist-get info :latex-default-table-environment))
+ '("longtable" "longtabu"))))
+ (if (eq (org-element-property :type table-row) 'rule)
+ (cond
+ ((not booktabsp) "\\hline")
+ ((not (org-export-get-previous-element table-row info)) "\\toprule")
+ ((not (org-export-get-next-element table-row info)) "\\bottomrule")
+ ((and longtablep
+ (org-export-table-row-ends-header-p
+ (org-export-get-previous-element table-row info) info))
+ "")
+ (t "\\midrule"))
(concat
;; When BOOKTABS are activated enforce top-rule even when no
;; hline was specifically marked.
- (cond ((and booktabsp (memq 'top borders)) "\\toprule\n")
- ((and (memq 'top borders) (memq 'above borders)) "\\hline\n"))
+ (and booktabsp (not (org-export-get-previous-element table-row info))
+ "\\toprule\n")
contents "\\\\\n"
(cond
- ;; Special case for long tables. Define header and footers.
+ ;; Special case for long tables. Define header and footers.
((and longtablep (org-export-table-row-ends-header-p table-row info))
- (format "%s
+ (let ((columns (cdr (org-export-table-dimensions
+ (org-export-get-parent-table table-row) info))))
+ (format "%s
+\\endfirsthead
+\\multicolumn{%d}{l}{%s} \\\\
+%s
+%s \\\\\n
+%s
\\endhead
-%s\\multicolumn{%d}{r}{Continued on next page} \\\\
+%s\\multicolumn{%d}{r}{%s} \\\\
\\endfoot
\\endlastfoot"
- (if booktabsp "\\midrule" "\\hline")
- (if booktabsp "\\midrule" "\\hline")
- ;; Number of columns.
- (cdr (org-export-table-dimensions
- (org-export-get-parent-table table-row) info))))
+ (if booktabsp "\\midrule" "\\hline")
+ columns
+ (org-latex--translate "Continued from previous page" info)
+ (cond
+ ((not (org-export-table-row-starts-header-p table-row info))
+ "")
+ (booktabsp "\\toprule\n")
+ (t "\\hline\n"))
+ contents
+ (if booktabsp "\\midrule" "\\hline")
+ (if booktabsp "\\midrule" "\\hline")
+ columns
+ (org-latex--translate "Continued on next page" info))))
;; When BOOKTABS are activated enforce bottom rule even when
;; no hline was specifically marked.
- ((and booktabsp (memq 'bottom borders)) "\\bottomrule")
- ((and (memq 'bottom borders) (memq 'below borders)) "\\hline")
- ((memq 'below borders) (if booktabsp "\\midrule" "\\hline")))))))
+ ((and booktabsp (not (org-export-get-next-element table-row info)))
+ "\\bottomrule"))))))
;;;; Target
-(defun org-latex-target (target contents info)
+(defun org-latex-target (target _contents info)
"Transcode a TARGET object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\label{%s}"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\label{%s}" (org-latex--label target info)))
;;;; Timestamp
-(defun org-latex-timestamp (timestamp contents info)
+(defun org-latex-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to LaTeX.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((value (org-latex-plain-text
- (org-timestamp-translate timestamp) info)))
- (case (org-element-property :type timestamp)
- ((active active-range) (format org-latex-active-timestamp-format value))
- ((inactive inactive-range)
- (format org-latex-inactive-timestamp-format value))
- (otherwise (format org-latex-diary-timestamp-format value)))))
+ (let ((value (org-latex-plain-text (org-timestamp-translate timestamp) info)))
+ (format
+ (plist-get info
+ (cl-case (org-element-property :type timestamp)
+ ((active active-range) :latex-active-timestamp-format)
+ ((inactive inactive-range) :latex-inactive-timestamp-format)
+ (otherwise :latex-diary-timestamp-format)))
+ value)))
;;;; Underline
-(defun org-latex-underline (underline contents info)
+(defun org-latex-underline (_underline contents info)
"Transcode UNDERLINE from Org to LaTeX.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
- (org-latex--text-markup contents 'underline))
+ (org-latex--text-markup contents 'underline info))
;;;; Verbatim
-(defun org-latex-verbatim (verbatim contents info)
+(defun org-latex-verbatim (verbatim _contents info)
"Transcode a VERBATIM object from Org to LaTeX.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-latex--text-markup (org-element-property :value verbatim) 'verbatim))
+ (org-latex--text-markup
+ (org-element-property :value verbatim) 'verbatim info))
;;;; Verse Block
@@ -2701,16 +3515,15 @@ contextual information."
;; character and change each white space at beginning of a line
;; into a space of 1 em. Also change each blank line with
;; a vertical space of 1 em.
- (progn
- (setq contents (replace-regexp-in-string
- "^ *\\\\\\\\$" "\\\\vspace*{1em}"
- (replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents)))
- (while (string-match "^[ \t]+" contents)
- (let ((new-str (format "\\hspace*{%dem}"
- (length (match-string 0 contents)))))
- (setq contents (replace-match new-str nil t contents))))
- (format "\\begin{verse}\n%s\\end{verse}" contents))))
+ (format "\\begin{verse}\n%s\\end{verse}"
+ (replace-regexp-in-string
+ "^[ \t]+" (lambda (m) (format "\\hspace*{%dem}" (length m)))
+ (replace-regexp-in-string
+ "^[ \t]*\\\\\\\\$" "\\vspace*{1em}"
+ (replace-regexp-in-string
+ "\\([ \t]*\\\\\\\\\\)?[ \t]*\n" "\\\\\n"
+ contents nil t) nil t) nil t))
+ info))
@@ -2753,9 +3566,9 @@ is non-nil."
;;;###autoload
(defun org-latex-convert-region-to-latex ()
- "Assume the current region has org-mode syntax, and convert it to LaTeX.
+ "Assume the current region has Org syntax, and convert it to LaTeX.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an LaTeX buffer and use this
+itemized list in Org syntax in an LaTeX buffer and use this
command to convert it."
(interactive)
(org-export-replace-region-by 'latex))
@@ -2831,86 +3644,78 @@ Return PDF file's name."
"Compile a TeX file.
TEXFILE is the name of the file being compiled. Processing is
-done through the command specified in `org-latex-pdf-process'.
+done through the command specified in `org-latex-pdf-process',
+which see. Output is redirected to \"*Org PDF LaTeX Output*\"
+buffer.
When optional argument SNIPPET is non-nil, TEXFILE is a temporary
file used to preview a LaTeX snippet. In this case, do not
-create a log buffer and do not bother removing log files.
-
-Return PDF file name or an error if it couldn't be produced."
- (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile)))
- (full-name (file-truename texfile))
- (out-dir (file-name-directory texfile))
- ;; Properly set working directory for compilation.
- (default-directory (if (file-name-absolute-p texfile)
- (file-name-directory full-name)
- default-directory))
- errors)
- (unless snippet (message "Processing LaTeX file %s..." texfile))
- (save-window-excursion
- (cond
- ;; A function is provided: Apply it.
- ((functionp org-latex-pdf-process)
- (funcall org-latex-pdf-process (shell-quote-argument texfile)))
- ;; A list is provided: Replace %b, %f and %o with appropriate
- ;; values in each command before applying it. Output is
- ;; redirected to "*Org PDF LaTeX Output*" buffer.
- ((consp org-latex-pdf-process)
- (let ((outbuf (and (not snippet)
- (get-buffer-create "*Org PDF LaTeX Output*"))))
- (mapc
- (lambda (command)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t) t t) t t)
- outbuf))
- org-latex-pdf-process)
- ;; Collect standard errors from output buffer.
- (setq errors (and (not snippet) (org-latex--collect-errors outbuf)))))
- (t (error "No valid command to process to PDF")))
- (let ((pdffile (concat out-dir base-name ".pdf")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (if (not (file-exists-p pdffile))
- (error "PDF file %s wasn't produced%s" pdffile
- (if errors (concat ": " errors) ""))
- ;; Else remove log files, when specified, and signal end of
- ;; process to user, along with any error encountered.
- (when (and (not snippet) org-latex-remove-logfiles)
- (dolist (file (directory-files
- out-dir t
- (concat (regexp-quote base-name)
- "\\(?:\\.[0-9]+\\)?"
- "\\."
- (regexp-opt org-latex-logfiles-extensions))))
- (delete-file file)))
- (message (concat "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
- ;; Return output file name.
- pdffile))))
-
-(defun org-latex--collect-errors (buffer)
- "Collect some kind of errors from \"pdflatex\" command output.
-
-BUFFER is the buffer containing output.
-
-Return collected error types as a string, or nil if there was
-none."
+create a log buffer and do not remove log files.
+
+Return PDF file name or raise an error if it couldn't be
+produced."
+ (unless snippet (message "Processing LaTeX file %s..." texfile))
+ (let* ((compiler
+ (or (with-temp-buffer
+ (save-excursion (insert-file-contents texfile))
+ (and (search-forward-regexp (regexp-opt org-latex-compilers)
+ (line-end-position 2)
+ t)
+ (progn (beginning-of-line) (looking-at-p "%"))
+ (match-string 0)))
+ "pdflatex"))
+ (process (if (functionp org-latex-pdf-process) org-latex-pdf-process
+ ;; Replace "%latex" and "%bibtex" with,
+ ;; respectively, "%L" and "%B" so as to adhere to
+ ;; `format-spec' specifications.
+ (mapcar (lambda (command)
+ (replace-regexp-in-string
+ "%\\(?:bib\\|la\\)tex\\>"
+ (lambda (m) (upcase (substring m 0 2)))
+ command))
+ org-latex-pdf-process)))
+ (spec `((?B . ,(shell-quote-argument org-latex-bib-compiler))
+ (?L . ,(shell-quote-argument compiler))))
+ (log-buf-name "*Org PDF LaTeX Output*")
+ (log-buf (and (not snippet) (get-buffer-create log-buf-name)))
+ (outfile (org-compile-file texfile process "pdf"
+ (format "See %S for details" log-buf-name)
+ log-buf spec)))
+ (unless snippet
+ (when org-latex-remove-logfiles
+ (mapc #'delete-file
+ (directory-files
+ (file-name-directory outfile)
+ t
+ (concat (regexp-quote (file-name-base outfile))
+ "\\(?:\\.[0-9]+\\)?\\."
+ (regexp-opt org-latex-logfiles-extensions))
+ t)))
+ (let ((warnings (org-latex--collect-warnings log-buf)))
+ (message (concat "PDF file produced"
+ (cond
+ ((eq warnings 'error) " with errors.")
+ (warnings (concat " with warnings: " warnings))
+ (t "."))))))
+ ;; Return output file name.
+ outfile))
+
+(defun org-latex--collect-warnings (buffer)
+ "Collect some warnings from \"pdflatex\" command output.
+BUFFER is the buffer containing output. Return collected
+warnings types as a string, `error' if a LaTeX error was
+encountered or nil if there was none."
(with-current-buffer buffer
(save-excursion
(goto-char (point-max))
(when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t)
- (let ((case-fold-search t)
- (errors ""))
- (dolist (latex-error org-latex-known-errors)
- (when (save-excursion (re-search-forward (car latex-error) nil t))
- (setq errors (concat errors " " (cdr latex-error)))))
- (and (org-string-nw-p errors) (org-trim errors)))))))
+ (if (re-search-forward "^!" nil t) 'error
+ (let ((case-fold-search t)
+ (warnings ""))
+ (dolist (warning org-latex-known-warnings)
+ (when (save-excursion (re-search-forward (car warning) nil t))
+ (setq warnings (concat warnings " " (cdr warning)))))
+ (org-string-nw-p (org-trim warnings))))))))
;;;###autoload
(defun org-latex-publish-to-latex (plist filename pub-dir)
@@ -2936,9 +3741,13 @@ Return output file name."
;; in working directory and then moved to publishing directory.
(org-publish-attachment
plist
- (org-latex-compile
- (org-publish-org-to
- 'latex filename ".tex" plist (file-name-directory filename)))
+ ;; Default directory could be anywhere when this function is
+ ;; called. We ensure it is set to source file directory during
+ ;; compilation so as to not break links to external documents.
+ (let ((default-directory (file-name-directory filename)))
+ (org-latex-compile
+ (org-publish-org-to
+ 'latex filename ".tex" plist (file-name-directory filename))))
pub-dir))
diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el
index e5b1479c5f5..6fb3041d587 100644
--- a/lisp/org/ox-man.el
+++ b/lisp/org/ox-man.el
@@ -1,4 +1,4 @@
-;; ox-man.el --- Man Back-End for Org Export Engine
+;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -29,18 +29,17 @@
;;
;; M-: (org-export-to-buffer 'man "*Test Man*") RET
;;
-;; in an org-mode buffer then switch to the buffer to see the Man
-;; export. See ox.el for more details on how this exporter works.
+;; in an Org buffer then switch to the buffer to see the Man export.
+;; See ox.el for more details on how this exporter works.
;;
;; It introduces one new buffer keywords:
;; "MAN_CLASS_OPTIONS".
;;; Code:
+(require 'cl-lib)
(require 'ox)
-(eval-when-compile (require 'cl))
-
(defvar org-export-man-default-packages-alist)
(defvar org-export-man-packages-alist)
(defvar orgtbl-exp-regexp)
@@ -53,10 +52,7 @@
'((babel-call . org-man-babel-call)
(bold . org-man-bold)
(center-block . org-man-center-block)
- (clock . org-man-clock)
(code . org-man-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-man-drawer)
(dynamic-block . org-man-dynamic-block)
(entity . org-man-entity)
@@ -76,13 +72,13 @@
(keyword . org-man-keyword)
(line-break . org-man-line-break)
(link . org-man-link)
+ (node-property . org-man-node-property)
(paragraph . org-man-paragraph)
(plain-list . org-man-plain-list)
(plain-text . org-man-plain-text)
(planning . org-man-planning)
- (property-drawer . (lambda (&rest args) ""))
+ (property-drawer . org-man-property-drawer)
(quote-block . org-man-quote-block)
- (quote-section . org-man-quote-section)
(radio-target . org-man-radio-target)
(section . org-man-section)
(special-block . org-man-special-block)
@@ -100,9 +96,8 @@
(underline . org-man-underline)
(verbatim . org-man-verbatim)
(verse-block . org-man-verse-block))
- :export-block "MAN"
:menu-entry
- '(?m "Export to MAN"
+ '(?M "Export to MAN"
((?m "As MAN file" org-man-export-to-man)
(?p "As PDF file" org-man-export-to-pdf)
(?o "As PDF file and open"
@@ -112,7 +107,13 @@
:options-alist
'((:man-class "MAN_CLASS" nil nil t)
(:man-class-options "MAN_CLASS_OPTIONS" nil nil t)
- (:man-header-extra "MAN_HEADER" nil nil newline)))
+ (:man-header-extra "MAN_HEADER" nil nil newline)
+ ;; Other variables.
+ (:man-tables-centered nil nil org-man-tables-centered)
+ (:man-tables-verbatim nil nil org-man-tables-verbatim)
+ (:man-table-scientific-notation nil nil org-man-table-scientific-notation)
+ (:man-source-highlight nil nil org-man-source-highlight)
+ (:man-source-highlight-langs nil nil org-man-source-highlight-langs)))
@@ -199,21 +200,6 @@ in this list - but it does not hurt if it is present."
(string :tag "Listings language"))))
-
-(defvar org-man-custom-lang-environments nil
- "Alist mapping languages to language-specific Man environments.
-
-It is used during export of src blocks by the listings and
-man packages. For example,
-
- (setq org-man-custom-lang-environments
- \\='((python \"pythoncode\")))
-
-would have the effect that if org encounters begin_src python
-during man export."
-)
-
-
;;; Compilation
(defcustom org-man-pdf-process
@@ -222,11 +208,13 @@ during man export."
"tbl %f | eqn | groff -man | ps2pdf - > %b.pdf")
"Commands to process a Man file to a PDF file.
+
This is a list of strings, each of them will be given to the
shell as a command. %f in the command will be replaced by the
-full file name, %b by the file base name (i.e. without directory
-and extension parts) and %o by the base directory of the file.
-
+relative file name, %F by the absolute file name, %b by the file
+base name (i.e. without directory and extension parts), %o by the
+base directory of the file and %O by the absolute file name of
+the output file.
By default, Org uses 3 runs of to do the processing.
@@ -297,6 +285,10 @@ This function shouldn't be used for floats. See
output
(concat (format "%s\n.br\n" label) output))))
+(defun org-man--protect-text (text)
+ "Protect minus and backslash characters in string TEXT."
+ (replace-regexp-in-string "-" "\\-" text nil t))
+
;;; Template
@@ -305,7 +297,8 @@ This function shouldn't be used for floats. See
"Return complete document string after Man conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
- (let* ((title (org-export-data (plist-get info :title) info))
+ (let* ((title (when (plist-get info :with-title)
+ (org-export-data (plist-get info :title) info)))
(attr (read (format "(%s)"
(mapconcat
#'identity
@@ -338,7 +331,7 @@ holding export options."
;;; Bold
-(defun org-man-bold (bold contents info)
+(defun org-man-bold (_bold contents _info)
"Transcode BOLD from Org to Man.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -347,7 +340,7 @@ contextual information."
;;; Center Block
-(defun org-man-center-block (center-block contents info)
+(defun org-man-center-block (center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to Man.
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
@@ -358,37 +351,17 @@ holding contextual information."
contents)))
-;;; Clock
-
-(defun org-man-clock (clock contents info)
- "Transcode a CLOCK element from Org to Man.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- "" )
-
-
;;; Code
-(defun org-man-code (code contents info)
- "Transcode a CODE object from Org to Man.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (format "\\fC%s\\fP" code))
-
-
-;;; Comment
-;;
-;; Comments are ignored.
-
-
-;;; Comment Block
-;;
-;; Comment Blocks are ignored.
+(defun org-man-code (code _contents _info)
+ "Transcode a CODE object from Org to Man."
+ (format "\\fC%s\\fP"
+ (org-man--protect-text (org-element-property :value code))))
;;; Drawer
-(defun org-man-drawer (drawer contents info)
+(defun org-man-drawer (_drawer contents _info)
"Transcode a DRAWER element from Org to Man.
DRAWER holds the drawer information
CONTENTS holds the contents of the block.
@@ -398,7 +371,7 @@ channel."
;;; Dynamic Block
-(defun org-man-dynamic-block (dynamic-block contents info)
+(defun org-man-dynamic-block (dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to Man.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -407,7 +380,7 @@ holding contextual information. See `org-export-data'."
;;; Entity
-(defun org-man-entity (entity contents info)
+(defun org-man-entity (entity _contents _info)
"Transcode an ENTITY object from Org to Man.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -416,7 +389,7 @@ contextual information."
;;; Example Block
-(defun org-man-example-block (example-block contents info)
+(defun org-man-example-block (example-block _contents info)
"Transcode an EXAMPLE-BLOCK element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -428,7 +401,7 @@ information."
;;; Export Block
-(defun org-man-export-block (export-block contents info)
+(defun org-man-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "MAN")
@@ -437,7 +410,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Export Snippet
-(defun org-man-export-snippet (export-snippet contents info)
+(defun org-man-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'man)
@@ -446,7 +419,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Fixed Width
-(defun org-man-fixed-width (fixed-width contents info)
+(defun org-man-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-man--wrap-label
@@ -472,16 +445,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
(let* ((level (org-export-get-relative-level headline info))
- (numberedp (org-export-numbered-headline-p headline info))
- ;; Section formatting will set two placeholders: one for the
- ;; title and the other for the contents.
- (section-fmt
- (case level
- (1 ".SH \"%s\"\n%s")
- (2 ".SS \"%s\"\n%s")
- (3 ".SS \"%s\"\n%s")
- (t nil)))
- (text (org-export-data (org-element-property :title headline) info)))
+ ;; Section formatting will set two placeholders: one for the
+ ;; title and the other for the contents.
+ (section-fmt
+ (pcase level
+ (1 ".SH \"%s\"\n%s")
+ (2 ".SS \"%s\"\n%s")
+ (3 ".SS \"%s\"\n%s")
+ (_ nil)))
+ (text (org-export-data (org-element-property :title headline) info)))
(cond
;; Case 1: This is a footnote section: ignore it.
@@ -493,20 +465,20 @@ holding contextual information."
((or (not section-fmt) (org-export-low-level-p headline info))
;; Build the real contents of the sub-tree.
(let ((low-level-body
- (concat
- ;; If the headline is the first sibling, start a list.
- (when (org-export-first-sibling-p headline info)
- (format "%s\n" ".RS"))
- ;; Itemize headline
- ".TP\n.ft I\n" text "\n.ft\n"
- contents ".RE")))
- ;; If headline is not the last sibling simply return
- ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
- ;; blank line.
- (if (not (org-export-last-sibling-p headline info)) low-level-body
- (replace-regexp-in-string
- "[ \t\n]*\\'" ""
- low-level-body))))
+ (concat
+ ;; If the headline is the first sibling, start a list.
+ (when (org-export-first-sibling-p headline info)
+ (format "%s\n" ".RS"))
+ ;; Itemize headline
+ ".TP\n.ft I\n" text "\n.ft\n"
+ contents ".RE")))
+ ;; If headline is not the last sibling simply return
+ ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any
+ ;; blank line.
+ (if (not (org-export-last-sibling-p headline info)) low-level-body
+ (replace-regexp-in-string
+ "[ \t\n]*\\'" ""
+ low-level-body))))
;; Case 3. Standard headline. Export it as a section.
(t (format section-fmt text contents )))))
@@ -520,23 +492,22 @@ holding contextual information."
;;; Inline Src Block
-(defun org-man-inline-src-block (inline-src-block contents info)
+(defun org-man-inline-src-block (inline-src-block _contents info)
"Transcode an INLINE-SRC-BLOCK element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((code (org-element-property :value inline-src-block)))
(cond
- (org-man-source-highlight
- (let* ((tmpdir (if (featurep 'xemacs)
- temp-directory
- temporary-file-directory ))
+ ((plist-get info :man-source-highlight)
+ (let* ((tmpdir temporary-file-directory)
(in-file (make-temp-name
(expand-file-name "srchilite" tmpdir)))
(out-file (make-temp-name
(expand-file-name "reshilite" tmpdir)))
(org-lang (org-element-property :language inline-src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-man-source-highlight-langs)))
+ (lst-lang
+ (cadr (assq (intern org-lang)
+ (plist-get info :man-source-highlight-langs))))
(cmd (concat (expand-file-name "source-highlight")
" -s " lst-lang
@@ -564,7 +535,7 @@ contextual information."
;;; Inlinetask
;;; Italic
-(defun org-man-italic (italic contents info)
+(defun org-man-italic (_italic contents _info)
"Transcode ITALIC from Org to Man.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -575,17 +546,15 @@ contextual information."
(defun org-man-item (item contents info)
-
"Transcode an ITEM element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
-
(let* ((bullet (org-element-property :bullet item))
(type (org-element-property :type (org-element-property :parent item)))
- (checkbox (case (org-element-property :checkbox item)
- (on "\\o'\\(sq\\(mu'") ;;
- (off "\\(sq ") ;;
- (trans "\\o'\\(sq\\(mi'" ))) ;;
+ (checkbox (pcase (org-element-property :checkbox item)
+ (`on "\\o'\\(sq\\(mu'")
+ (`off "\\(sq ")
+ (`trans "\\o'\\(sq\\(mi'")))
(tag (let ((tag (org-element-property :tag item)))
;; Check-boxes must belong to the tag.
@@ -593,24 +562,22 @@ contextual information."
(concat checkbox
(org-export-data tag info)))))))
- (if (and (null tag )
- (null checkbox))
- (let* ((bullet (org-trim bullet))
- (marker (cond ((string= "-" bullet) "\\(em")
- ((string= "*" bullet) "\\(bu")
- ((eq type 'ordered)
- (format "%s " (org-trim bullet)))
- (t "\\(dg"))))
- (concat ".IP " marker " 4\n"
- (org-trim (or contents " " ))))
- ; else
+ (if (and (null tag) (null checkbox))
+ (let* ((bullet (org-trim bullet))
+ (marker (cond ((string= "-" bullet) "\\(em")
+ ((string= "*" bullet) "\\(bu")
+ ((eq type 'ordered)
+ (format "%s " (org-trim bullet)))
+ (t "\\(dg"))))
+ (concat ".IP " marker " 4\n"
+ (org-trim (or contents " " ))))
(concat ".TP\n" (or tag (concat " " checkbox)) "\n"
(org-trim (or contents " " ))))))
;;; Keyword
-(defun org-man-keyword (keyword contents info)
+(defun org-man-keyword (keyword _contents _info)
"Transcode a KEYWORD element from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((key (org-element-property :key keyword))
@@ -623,16 +590,16 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Line Break
-(defun org-man-line-break (line-break contents info)
+(defun org-man-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
- ".br\n")
+ "\n.br\n")
;;; 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.
@@ -645,11 +612,11 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ ((string= type "file") (org-export-file-uri raw-path))
+ (t raw-path))))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc 'man))
;; External link with a description part.
((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc))
;; External link without a description part.
@@ -657,10 +624,20 @@ INFO is a plist holding contextual information. See
;; No path, only description. Try to do something useful.
(t (format "\\fI%s\\fP" desc)))))
+;;;; Node Property
+
+(defun org-man-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element from Org to Man.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
;;; Paragraph
-(defun org-man-paragraph (paragraph contents info)
+(defun org-man-paragraph (paragraph contents _info)
"Transcode a PARAGRAPH element from Org to Man.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
@@ -681,7 +658,7 @@ the plist used as a communication channel."
;;; Plain List
-(defun org-man-plain-list (plain-list contents info)
+(defun org-man-plain-list (_plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to Man.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
@@ -716,10 +693,16 @@ contextual information."
;;; Property Drawer
+(defun org-man-property-drawer (_property-drawer contents _info)
+ "Transcode a PROPERTY-DRAWER element from Org to Man.
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format ".RS\n.nf\n%s\n.fi\n.RE" contents)))
;;; Quote Block
-(defun org-man-quote-block (quote-block contents info)
+(defun org-man-quote-block (quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to Man.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -727,28 +710,19 @@ holding contextual information."
quote-block
(format ".RS\n%s\n.RE" contents)))
-;;; Quote Section
-
-(defun org-man-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to Man.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format ".RS\\fI%s\\fP\n.RE\n" value))))
-
;;; Radio Target
-(defun org-man-radio-target (radio-target text info)
+(defun org-man-radio-target (_radio-target text _info)
"Transcode a RADIO-TARGET object from Org to Man.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- text )
+ text)
;;; Section
-(defun org-man-section (section contents info)
+(defun org-man-section (_section contents _info)
"Transcode a SECTION element from Org to Man.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -757,70 +731,49 @@ holding contextual information."
;;; Special Block
-(defun org-man-special-block (special-block contents info)
+(defun org-man-special-block (special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to Man.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block))))
- (org-man--wrap-label
- special-block
- (format "%s\n" contents))))
+ (org-man--wrap-label special-block (format "%s\n" contents)))
;;; Src Block
-(defun org-man-src-block (src-block contents info)
+(defun org-man-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to Man.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((lang (org-element-property :language src-block))
- (code (org-element-property :value src-block))
- (custom-env (and lang
- (cadr (assq (intern lang)
- org-man-custom-lang-environments))))
- (num-start (case (org-element-property :number-lines src-block)
- (continued (org-export-get-loc src-block info))
- (new 0)))
- (retain-labels (org-element-property :retain-labels src-block)))
- (cond
- ;; Case 1. No source fontification.
- ((not org-man-source-highlight)
+ (if (not (plist-get info :man-source-highlight))
(format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n"
- (org-export-format-code-default src-block info)))
- (org-man-source-highlight
- (let* ((tmpdir (if (featurep 'xemacs)
- temp-directory
- temporary-file-directory ))
-
- (in-file (make-temp-name
- (expand-file-name "srchilite" tmpdir)))
- (out-file (make-temp-name
- (expand-file-name "reshilite" tmpdir)))
-
- (org-lang (org-element-property :language src-block))
- (lst-lang (cadr (assq (intern org-lang)
- org-man-source-highlight-langs)))
-
- (cmd (concat "source-highlight"
- " -s " lst-lang
- " -f groff_man "
- " -i " in-file
- " -o " out-file)))
-
- (if lst-lang
- (let ((code-block ""))
- (with-temp-file in-file (insert code))
- (shell-command cmd)
- (setq code-block (org-file-contents out-file))
- (delete-file in-file)
- (delete-file out-file)
- code-block)
- (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))))
+ (org-export-format-code-default src-block info))
+ (let* ((tmpdir temporary-file-directory)
+ (in-file (make-temp-name (expand-file-name "srchilite" tmpdir)))
+ (out-file (make-temp-name (expand-file-name "reshilite" tmpdir)))
+ (code (org-element-property :value src-block))
+ (org-lang (org-element-property :language src-block))
+ (lst-lang
+ (cadr (assq (intern org-lang)
+ (plist-get info :man-source-highlight-langs))))
+ (cmd (concat "source-highlight"
+ " -s " lst-lang
+ " -f groff_man "
+ " -i " in-file
+ " -o " out-file)))
+ (if lst-lang
+ (let ((code-block ""))
+ (with-temp-file in-file (insert code))
+ (shell-command cmd)
+ (setq code-block (org-file-contents out-file))
+ (delete-file in-file)
+ (delete-file out-file)
+ code-block)
+ (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code)))))
;;; Statistics Cookie
-(defun org-man-statistics-cookie (statistics-cookie contents info)
+(defun org-man-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
@@ -828,7 +781,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;; Strike-Through
-(defun org-man-strike-through (strike-through contents info)
+(defun org-man-strike-through (_strike-through contents _info)
"Transcode STRIKE-THROUGH from Org to Man.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -836,7 +789,7 @@ holding contextual information."
;;; Subscript
-(defun org-man-subscript (subscript contents info)
+(defun org-man-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to Man.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -844,7 +797,7 @@ contextual information."
;;; Superscript "^_%s$
-(defun org-man-superscript (superscript contents info)
+(defun org-man-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to Man.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -868,7 +821,7 @@ CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
(cond
;; Case 1: verbatim table.
- ((or org-man-tables-verbatim
+ ((or (plist-get info :man-tables-verbatim)
(let ((attr (read (format "(%s)"
(mapconcat
#'identity
@@ -907,14 +860,14 @@ a communication channel."
(when (and (memq 'left borders) (not alignment))
(push "|" alignment))
(push
- (case (org-export-table-cell-alignment cell info)
- (left (concat "l" width divider))
- (right (concat "r" width divider))
- (center (concat "c" width divider)))
+ (concat (pcase (org-export-table-cell-alignment cell info)
+ (`left "l") (`right "r") (`center "c"))
+ width
+ divider)
alignment)
(when (memq 'right borders) (push "|" alignment))))
info)
- (apply 'concat (reverse alignment))))
+ (apply #'concat (reverse alignment))))
(defun org-man-table--org-table (table contents info)
"Return appropriate Man code for an Org table.
@@ -925,7 +878,6 @@ channel.
This function assumes TABLE has `org' as its `:type' attribute."
(let* ((attr (org-export-read-attribute :attr_man table))
- (label (org-element-property :name table))
(caption (and (not (plist-get attr :disable-caption))
(org-man--caption/label-string table info)))
(divider (if (plist-get attr :divider) "|" " "))
@@ -943,7 +895,8 @@ This function assumes TABLE has `org' as its `:type' attribute."
(let ((placement (plist-get attr :placement)))
(cond ((string= placement 'center) "center")
((string= placement 'left) nil)
- (t (if org-man-tables-centered "center" ""))))
+ ((plist-get info :man-tables-centered) "center")
+ (t "")))
(or (plist-get attr :boxtype) "box"))))
(title-line (plist-get attr :title-line))
@@ -970,14 +923,14 @@ This function assumes TABLE has `org' as its `:type' attribute."
(format "%s.\n"
(let ((final-line ""))
(when title-line
- (dotimes (i (length first-line))
+ (dotimes (_ (length first-line))
(setq final-line (concat final-line "cb" divider))))
(setq final-line (concat final-line "\n"))
(if alignment
(setq final-line (concat final-line alignment))
- (dotimes (i (length first-line))
+ (dotimes (_ (length first-line))
(setq final-line (concat final-line "c" divider))))
final-line ))
@@ -1018,69 +971,59 @@ This function assumes TABLE has `org' as its `:type' attribute."
"Transcode a TABLE-CELL element from Org to Man
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat (if (and contents
- org-man-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-man-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents )
- (when (org-export-get-next-element table-cell info) "\t")))
+ (concat
+ (let ((scientific-format (plist-get info :man-table-scientific-notation)))
+ (if (and contents
+ scientific-format
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific notation.
+ (format scientific-format
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents))
+ (when (org-export-get-next-element table-cell info) "\t")))
;;; Table Row
(defun org-man-table-row (table-row contents info)
- "Transcode a TABLE-ROW element from Org to Man
+ "Transcode a TABLE-ROW element from Org to Man.
CONTENTS is the contents of the row. INFO is a plist used as
a communication channel."
- ;; Rules are ignored since table separators are deduced from
- ;; borders of the current row.
+ ;; Rules are ignored since table separators are deduced from borders
+ ;; of the current row.
(when (eq (org-element-property :type table-row) 'standard)
- (let* ((attr (mapconcat 'identity
- (org-element-property
- :attr_man (org-export-get-parent table-row))
- " "))
- ;; TABLE-ROW's borders are extracted from its first cell.
- (borders
- (org-export-table-cell-borders
- (car (org-element-contents table-row)) info)))
+ (let ((borders
+ ;; TABLE-ROW's borders are extracted from its first cell.
+ (org-export-table-cell-borders
+ (car (org-element-contents table-row)) info)))
(concat
- ;; Mark horizontal lines
- (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
+ (cond ((and (memq 'top borders) (memq 'above borders)) "_\n"))
contents
-
- (cond
- ;; When BOOKTABS are activated enforce bottom rule even when
- ;; no hline was specifically marked.
- ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
- ((memq 'below borders) "\n_"))))))
+ (cond ((and (memq 'bottom borders) (memq 'below borders)) "\n_")
+ ((memq 'below borders) "\n_"))))))
;;; Target
-(defun org-man-target (target contents info)
+(defun org-man-target (target _contents info)
"Transcode a TARGET object from Org to Man.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "\\fI%s\\fP"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "\\fI%s\\fP" (org-export-get-reference target info)))
;;; Timestamp
-(defun org-man-timestamp (timestamp contents info)
+(defun org-man-timestamp (_timestamp _contents _info)
"Transcode a TIMESTAMP object from Org to Man.
- CONTENTS is nil. INFO is a plist holding contextual
- information."
- "" )
+CONTENTS is nil. INFO is a plist holding contextual information."
+ "")
;;; Underline
-(defun org-man-underline (underline contents info)
+(defun org-man-underline (_underline contents _info)
"Transcode UNDERLINE from Org to Man.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -1089,16 +1032,15 @@ holding contextual information."
;;; Verbatim
-(defun org-man-verbatim (verbatim contents info)
- "Transcode a VERBATIM object from Org to Man.
-CONTENTS is nil. INFO is a plist used as a communication
-channel."
- (format ".nf\n%s\n.fi" contents))
+(defun org-man-verbatim (verbatim _contents _info)
+ "Transcode a VERBATIM object from Org to Man."
+ (format "\\fI%s\\fP"
+ (org-man--protect-text (org-element-property :value verbatim))))
;;; Verse Block
-(defun org-man-verse-block (verse-block contents info)
+(defun org-man-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to Man.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
@@ -1182,68 +1124,15 @@ FILE is the name of the file being compiled. Processing is done
through the command specified in `org-man-pdf-process'.
Return PDF file name or an error if it couldn't be produced."
- (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
- (full-name (file-truename file))
- (out-dir (file-name-directory file))
- ;; Properly set working directory for compilation.
- (default-directory (if (file-name-absolute-p file)
- (file-name-directory full-name)
- default-directory))
- errors)
- (message "Processing Groff file %s..." file)
- (save-window-excursion
- (cond
- ;; A function is provided: Apply it.
- ((functionp org-man-pdf-process)
- (funcall org-man-pdf-process (shell-quote-argument file)))
- ;; A list is provided: Replace %b, %f and %o with appropriate
- ;; values in each command before applying it. Output is
- ;; redirected to "*Org PDF Groff Output*" buffer.
- ((consp org-man-pdf-process)
- (let ((outbuf (get-buffer-create "*Org PDF Groff Output*")))
- (mapc
- (lambda (command)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t) t t) t t)
- outbuf))
- org-man-pdf-process)
- ;; Collect standard errors from output buffer.
- (setq errors (org-man-collect-errors outbuf))))
- (t (error "No valid command to process to PDF")))
- (let ((pdffile (concat out-dir base-name ".pdf")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (if (not (file-exists-p pdffile))
- (error "PDF file %s wasn't produced%s" pdffile
- (if errors (concat ": " errors) ""))
- ;; Else remove log files, when specified, and signal end of
- ;; process to user, along with any error encountered.
- (when org-man-remove-logfiles
- (dolist (ext org-man-logfiles-extensions)
- (let ((file (concat out-dir base-name "." ext)))
- (when (file-exists-p file) (delete-file file)))))
- (message (concat "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
- ;; Return output file name.
- pdffile))))
-
-(defun org-man-collect-errors (buffer)
- "Collect some kind of errors from \"groff\" output
-BUFFER is the buffer containing output.
-Return collected error types as a string, or nil if there was
-none."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-max))
- ;; Find final run
- nil )))
-
+ (message "Processing Groff file %s..." file)
+ (let ((output (org-compile-file file org-man-pdf-process "pdf")))
+ (when org-man-remove-logfiles
+ (let ((base (file-name-sans-extension output)))
+ (dolist (ext org-man-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file))))))
+ (message "Process completed.")
+ output))
(provide 'ox-man)
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el
index ab73f29dfa9..12188387355 100644
--- a/lisp/org/ox-md.el
+++ b/lisp/org/ox-md.el
@@ -1,4 +1,4 @@
-;;; ox-md.el --- Markdown Back-End for Org Export Engine
+;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,9 +28,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox-html)
-
+(require 'ox-publish)
;;; User-Configurable Variables
@@ -51,11 +51,29 @@ This variable can be set to either `atx' or `setext'."
(const :tag "Use \"Setext\" style" setext)))
+;;;; Footnotes
+
+(defcustom org-md-footnotes-section "%s%s"
+ "Format string for the footnotes section.
+The first %s placeholder will be replaced with the localized Footnotes section
+heading, the second with the contents of the Footnotes section."
+ :group 'org-export-md
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "9.0"))
+
+(defcustom org-md-footnote-format "<sup>%s</sup>"
+ "Format string for the footnote reference.
+The %s will be replaced by the footnote reference itself."
+ :group 'org-export-md
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "9.0"))
+
;;; Define Back-End
(org-export-define-derived-backend 'md 'html
- :export-block '("MD" "MARKDOWN")
:filters-alist '((:filter-parse-tree . org-md-separate-elements))
:menu-entry
'(?m "Export to Markdown"
@@ -68,62 +86,64 @@ This variable can be set to either `atx' or `setext'."
(org-open-file (org-md-export-to-markdown nil s v)))))))
:translate-alist '((bold . org-md-bold)
(code . org-md-verbatim)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(example-block . org-md-example-block)
+ (export-block . org-md-export-block)
(fixed-width . org-md-example-block)
- (footnote-definition . ignore)
- (footnote-reference . ignore)
(headline . org-md-headline)
(horizontal-rule . org-md-horizontal-rule)
(inline-src-block . org-md-verbatim)
(inner-template . org-md-inner-template)
(italic . org-md-italic)
(item . org-md-item)
+ (keyword . org-md-keyword)
(line-break . org-md-line-break)
(link . org-md-link)
+ (node-property . org-md-node-property)
(paragraph . org-md-paragraph)
(plain-list . org-md-plain-list)
(plain-text . org-md-plain-text)
+ (property-drawer . org-md-property-drawer)
(quote-block . org-md-quote-block)
- (quote-section . org-md-example-block)
(section . org-md-section)
(src-block . org-md-example-block)
(template . org-md-template)
- (verbatim . org-md-verbatim)))
-
+ (verbatim . org-md-verbatim))
+ :options-alist
+ '((:md-footnote-format nil nil org-md-footnote-format)
+ (:md-footnotes-section nil nil org-md-footnotes-section)
+ (:md-headline-style nil nil org-md-headline-style)))
;;; Filters
-(defun org-md-separate-elements (tree backend info)
+(defun org-md-separate-elements (tree _backend info)
"Fix blank lines between elements.
TREE is the parse tree being exported. BACKEND is the export
back-end used. INFO is a plist used as a communication channel.
-Enforce a blank line between elements. There are three
-exceptions to this rule:
+Enforce a blank line between elements. There are two exceptions
+to this rule:
1. Preserve blank lines between sibling items in a plain list,
- 2. Outside of plain lists, preserve blank lines between
- a paragraph and a plain list,
-
- 3. In an item, remove any blank line before the very first
- paragraph and the next sub-list.
+ 2. In an item, remove any blank line before the very first
+ paragraph and the next sub-list when the latter ends the
+ current item.
Assume BACKEND is `md'."
(org-element-map tree (remq 'item org-element-all-elements)
(lambda (e)
- (cond
- ((not (and (eq (org-element-type e) 'paragraph)
- (eq (org-element-type (org-export-get-next-element e info))
- 'plain-list)))
- (org-element-put-property e :post-blank 1))
- ((not (eq (org-element-type (org-element-property :parent e)) 'item)))
- (t (org-element-put-property
- e :post-blank (if (org-export-get-previous-element e info) 1 0))))))
+ (org-element-put-property
+ e :post-blank
+ (if (and (eq (org-element-type e) 'paragraph)
+ (eq (org-element-type (org-element-property :parent e)) 'item)
+ (org-export-first-sibling-p e info)
+ (let ((next (org-export-get-next-element e info)))
+ (and (eq (org-element-type next) 'plain-list)
+ (not (org-export-get-next-element next info)))))
+ 0
+ 1))))
;; Return updated tree.
tree)
@@ -133,7 +153,7 @@ Assume BACKEND is `md'."
;;;; Bold
-(defun org-md-bold (bold contents info)
+(defun org-md-bold (_bold contents _info)
"Transcode BOLD object into Markdown format.
CONTENTS is the text within bold markup. INFO is a plist used as
a communication channel."
@@ -142,22 +162,22 @@ a communication channel."
;;;; Code and Verbatim
-(defun org-md-verbatim (verbatim contents info)
+(defun org-md-verbatim (verbatim _contents _info)
"Transcode VERBATIM object into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
(let ((value (org-element-property :value verbatim)))
(format (cond ((not (string-match "`" value)) "`%s`")
- ((or (string-match "\\``" value)
- (string-match "`\\'" value))
+ ((or (string-prefix-p "`" value)
+ (string-suffix-p "`" value))
"`` %s ``")
(t "``%s``"))
value)))
-;;;; Example Block and Src Block
+;;;; Example Block, Src Block and export Block
-(defun org-md-example-block (example-block contents info)
+(defun org-md-example-block (example-block _contents info)
"Transcode EXAMPLE-BLOCK element into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -166,6 +186,14 @@ channel."
(org-remove-indentation
(org-export-format-code-default example-block info))))
+(defun org-md-export-block (export-block contents info)
+ "Transcode a EXPORT-BLOCK element from Org to Markdown.
+CONTENTS is nil. INFO is a plist holding contextual information."
+ (if (member (org-element-property :type export-block) '("MARKDOWN" "MD"))
+ (org-remove-indentation (org-element-property :value export-block))
+ ;; Also include HTML export blocks.
+ (org-export-with-backend 'html export-block contents info)))
+
;;;; Headline
@@ -189,45 +217,94 @@ a communication channel."
(and (plist-get info :with-priority)
(let ((char (org-element-property :priority headline)))
(and char (format "[#%c] " char)))))
- (anchor
- (when (plist-get info :with-toc)
- (org-html--anchor
- (or (org-element-property :CUSTOM_ID headline)
- (concat "sec-"
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- headline info) "-"))))))
;; Headline text without tags.
- (heading (concat todo priority title)))
+ (heading (concat todo priority title))
+ (style (plist-get info :md-headline-style)))
(cond
;; Cannot create a headline. Fall-back to a list.
((or (org-export-low-level-p headline info)
- (not (memq org-md-headline-style '(atx setext)))
- (and (eq org-md-headline-style 'atx) (> level 6))
- (and (eq org-md-headline-style 'setext) (> level 2)))
+ (not (memq style '(atx setext)))
+ (and (eq style 'atx) (> level 6))
+ (and (eq style 'setext) (> level 2)))
(let ((bullet
(if (not (org-export-numbered-headline-p headline info)) "-"
(concat (number-to-string
(car (last (org-export-get-headline-number
headline info))))
"."))))
- (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags
- "\n\n"
- (and contents
- (replace-regexp-in-string "^" " " contents)))))
- ;; Use "Setext" style.
- ((eq org-md-headline-style 'setext)
- (concat heading tags anchor "\n"
- (make-string (length heading) (if (= level 1) ?= ?-))
- "\n\n"
- contents))
- ;; Use "atx" style.
- (t (concat (make-string level ?#) " " heading tags anchor "\n\n" contents))))))
-
+ (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags "\n\n"
+ (and contents (replace-regexp-in-string "^" " " contents)))))
+ (t
+ (let ((anchor
+ (and (org-md--headline-referred-p headline info)
+ (format "<a id=\"%s\"></a>"
+ (or (org-element-property :CUSTOM_ID headline)
+ (org-export-get-reference headline info))))))
+ (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)
+(defun org-md-horizontal-rule (_horizontal-rule _contents _info)
"Transcode HORIZONTAL-RULE element into Markdown format.
CONTENTS is the horizontal rule contents. INFO is a plist used
as a communication channel."
@@ -236,7 +313,7 @@ as a communication channel."
;;;; Italic
-(defun org-md-italic (italic contents info)
+(defun org-md-italic (_italic contents _info)
"Transcode ITALIC object into Markdown format.
CONTENTS is the text within italic markup. INFO is a plist used
as a communication channel."
@@ -261,19 +338,41 @@ a communication channel."
"."))))
(concat bullet
(make-string (- 4 (length bullet)) ? )
- (case (org-element-property :checkbox item)
- (on "[X] ")
- (trans "[-] ")
- (off "[ ] "))
+ (pcase (org-element-property :checkbox item)
+ (`on "[X] ")
+ (`trans "[-] ")
+ (`off "[ ] "))
(let ((tag (org-element-property :tag item)))
(and tag (format "**%s:** "(org-export-data tag info))))
(and contents
(org-trim (replace-regexp-in-string "^" " " contents))))))
+
+;;;; Keyword
+
+(defun org-md-keyword (keyword contents info)
+ "Transcode a KEYWORD element into Markdown format.
+CONTENTS is nil. INFO is a plist used as a communication
+channel."
+ (pcase (org-element-property :key keyword)
+ ((or "MARKDOWN" "MD") (org-element-property :value keyword))
+ ("TOC"
+ (let ((case-fold-search t)
+ (value (org-element-property :value keyword)))
+ (cond
+ ((string-match-p "\\<headlines\\>" value)
+ (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+ (string-to-number (match-string 0 value))))
+ (local? (string-match-p "\\<local\\>" value)))
+ (org-remove-indentation
+ (org-md--build-toc info depth keyword local?)))))))
+ (_ (org-export-with-backend 'html keyword contents info))))
+
+
;;;; Line Break
-(defun org-md-line-break (line-break contents info)
+(defun org-md-line-break (_line-break _contents _info)
"Transcode LINE-BREAK object into Markdown format.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -287,32 +386,55 @@ channel."
CONTENTS is the link's description. INFO is a plist used as
a communication channel."
(let ((link-org-files-as-md
- (function
- (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))))
+ (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)))
(cond
- ((member type '("custom-id" "id"))
- (let ((destination (org-export-resolve-id-link link info)))
- (if (stringp destination) ; External file.
- (let ((path (funcall link-org-files-as-md destination)))
- (if (not contents) (format "<%s>" path)
- (format "[%s](%s)" contents path)))
- (concat
- (and contents (concat contents " "))
- (format "(%s)"
- (format (org-export-translate "See section %s" :html info)
- (mapconcat 'number-to-string
- (org-export-get-headline-number
- destination info)
- ".")))))))
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link contents 'md))
+ ((member type '("custom-id" "id" "fuzzy"))
+ (let ((destination (if (string= type "fuzzy")
+ (org-export-resolve-fuzzy-link link info)
+ (org-export-resolve-id-link link info))))
+ (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))))
+ (`headline
+ (format
+ "[%s](#%s)"
+ ;; Description.
+ (cond ((org-string-nw-p contents))
+ ((org-export-numbered-headline-p destination info)
+ (mapconcat #'number-to-string
+ (org-export-get-headline-number destination info)
+ "."))
+ (t (org-export-data (org-element-property :title destination)
+ info)))
+ ;; Reference.
+ (or (org-element-property :CUSTOM_ID destination)
+ (org-export-get-reference destination info))))
+ (_
+ (let ((description
+ (or (org-string-nw-p contents)
+ (let ((number (org-export-get-ordinal destination info)))
+ (cond
+ ((not number) nil)
+ ((atom number) (number-to-string number))
+ (t (mapconcat #'number-to-string number ".")))))))
+ (when description
+ (format "[%s](#%s)"
+ 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)))
- (if (not (file-name-absolute-p raw-path)) raw-path
- (expand-file-name raw-path))))
+ (cond ((not (equal "file" type)) (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)))
@@ -324,53 +446,46 @@ a communication channel."
(format (org-export-get-coderef-format ref contents)
(org-export-resolve-coderef ref info))))
((equal type "radio") contents)
- ((equal type "fuzzy")
- (let ((destination (org-export-resolve-fuzzy-link link info)))
- (if (org-string-nw-p contents) contents
- (when destination
- (let ((number (org-export-get-ordinal destination info)))
- (when number
- (if (atom number) (number-to-string number)
- (mapconcat 'number-to-string number "."))))))))
- ;; Link type is handled by a special function.
- ((let ((protocol (nth 2 (assoc type org-link-protocols))))
- (and (functionp protocol)
- (funcall protocol
- (org-link-unescape (org-element-property :path link))
- contents
- 'md))))
(t (let* ((raw-path (org-element-property :path link))
(path
(cond
- ((member type '("http" "https" "ftp"))
+ ((member type '("http" "https" "ftp" "mailto" "irc"))
(concat type ":" raw-path))
((string= type "file")
- (let ((path (funcall link-org-files-as-md raw-path)))
- (if (not (file-name-absolute-p path)) path
- ;; If file path is absolute, prepend it
- ;; with "file:" component.
- (concat "file:" path))))
+ (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)))))))
+;;;; Node Property
+
+(defun org-md-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element into Markdown syntax.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
+
;;;; Paragraph
-(defun org-md-paragraph (paragraph contents info)
+(defun org-md-paragraph (paragraph contents _info)
"Transcode PARAGRAPH element into Markdown format.
CONTENTS is the paragraph contents. INFO is a plist used as
a communication channel."
(let ((first-object (car (org-element-contents paragraph))))
;; If paragraph starts with a #, protect it.
- (if (and (stringp first-object) (string-match "\\`#" first-object))
- (replace-regexp-in-string "\\`#" "\\#" contents nil t)
+ (if (and (stringp first-object) (string-prefix-p "#" first-object))
+ (concat "\\" contents)
contents)))
;;;; Plain List
-(defun org-md-plain-list (plain-list contents info)
+(defun org-md-plain-list (_plain-list contents _info)
"Transcode PLAIN-LIST element into Markdown format.
CONTENTS is the plain-list contents. INFO is a plist used as
a communication channel."
@@ -403,9 +518,19 @@ contextual information."
text)
+;;;; Property Drawer
+
+(defun org-md-property-drawer (_property-drawer contents _info)
+ "Transcode a PROPERTY-DRAWER element into Markdown format.
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (replace-regexp-in-string "^" " " contents)))
+
+
;;;; Quote Block
-(defun org-md-quote-block (quote-block contents info)
+(defun org-md-quote-block (_quote-block contents _info)
"Transcode QUOTE-BLOCK element into Markdown format.
CONTENTS is the quote-block contents. INFO is a plist used as
a communication channel."
@@ -416,7 +541,7 @@ a communication channel."
;;;; Section
-(defun org-md-section (section contents info)
+(defun org-md-section (_section contents _info)
"Transcode SECTION element into Markdown format.
CONTENTS is the section contents. INFO is a plist used as
a communication channel."
@@ -425,15 +550,97 @@ a communication channel."
;;;; Template
+(defun org-md--build-toc (info &optional n keyword local)
+ "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.
+
+Optional argument KEYWORD specifies the TOC keyword, if any, from
+which the table of contents generation has been initiated.
+
+When optional argument LOCAL is non-nil, build a table of
+contents according to the current headline."
+ (concat
+ (unless local
+ (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))
+ (number (format "%d."
+ (org-last
+ (org-export-get-headline-number headline info))))
+ (bullet (concat number (make-string (- 4 (length number)) ?\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)))
+ (let ((tags (org-export-get-tags headline info)))
+ (and tags
+ (format ":%s:"
+ (mapconcat #'identity tags ":")))))))
+ (concat indentation bullet title tags)))
+ (org-export-collect-headlines info n (and local keyword)) "\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
holding export options."
;; Make sure CONTENTS is separated from table of contents and
;; footnotes with at least a blank line.
- (org-trim (org-html-inner-template (concat "\n" contents "\n") info)))
-
-(defun org-md-template (contents info)
+ (concat
+ ;; Table of contents.
+ (let ((depth (plist-get info :with-toc)))
+ (when depth
+ (concat (org-md--build-toc info (and (wholenump depth) depth)) "\n")))
+ ;; Document contents.
+ contents
+ "\n"
+ ;; Footnotes section.
+ (org-md--footnote-section info)))
+
+(defun org-md-template (contents _info)
"Return complete document string after Markdown conversion.
CONTENTS is the transcoded contents string. INFO is a plist used
as a communication channel."
@@ -472,9 +679,9 @@ non-nil."
;;;###autoload
(defun org-md-convert-region-to-md ()
- "Assume the current region has org-mode syntax, and convert it to Markdown.
+ "Assume the current region has Org syntax, and convert it to Markdown.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in a Markdown buffer and use
+itemized list in Org syntax in a Markdown buffer and use
this command to convert it."
(interactive)
(org-export-replace-region-by 'md))
@@ -505,6 +712,16 @@ Return output file's name."
(let ((outfile (org-export-output-file-name ".md" subtreep)))
(org-export-to-file 'md outfile async subtreep visible-only)))
+;;;###autoload
+(defun org-md-publish-to-md (plist filename pub-dir)
+ "Publish an org file to Markdown.
+
+FILENAME is the filename of the Org file to be published. PLIST
+is the property list for the given project. PUB-DIR is the
+publishing directory.
+
+Return output file name."
+ (org-publish-org-to 'md filename ".md" plist pub-dir))
(provide 'ox-md)
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 5430bdaead8..a19bab29c16 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -1,4 +1,4 @@
-;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode
+;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode -*- lexical-binding: t; -*-
;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
@@ -19,18 +19,17 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
-(eval-when-compile
- (require 'cl)
- (require 'table nil 'noerror))
+(require 'cl-lib)
(require 'format-spec)
(require 'ox)
(require 'org-compat)
+(require 'table nil 'noerror)
;;; Define Back-End
@@ -59,13 +58,13 @@
(latex-fragment . org-odt-latex-fragment)
(line-break . org-odt-line-break)
(link . org-odt-link)
+ (node-property . org-odt-node-property)
(paragraph . org-odt-paragraph)
(plain-list . org-odt-plain-list)
(plain-text . org-odt-plain-text)
(planning . org-odt-planning)
(property-drawer . org-odt-property-drawer)
(quote-block . org-odt-quote-block)
- (quote-section . org-odt-quote-section)
(radio-target . org-odt-radio-target)
(section . org-odt-section)
(special-block . org-odt-special-block)
@@ -83,11 +82,11 @@
(underline . org-odt-underline)
(verbatim . org-odt-verbatim)
(verse-block . org-odt-verse-block))
- :export-block "ODT"
:filters-alist '((:filter-parse-tree
. (org-odt--translate-latex-fragments
org-odt--translate-description-lists
- org-odt--translate-list-tables)))
+ org-odt--translate-list-tables
+ org-odt--translate-image-links)))
:menu-entry
'(?o "Export to ODT"
((?o "As ODT file" org-odt-export-to-odt)
@@ -97,29 +96,53 @@
(org-open-file (org-odt-export-to-odt nil s v) 'system))))))
:options-alist
'((:odt-styles-file "ODT_STYLES_FILE" nil nil t)
+ (:description "DESCRIPTION" nil nil newline)
+ (:keywords "KEYWORDS" nil nil space)
+ (:subtitle "SUBTITLE" nil nil parse)
+ ;; Other variables.
+ (:odt-content-template-file nil nil org-odt-content-template-file)
+ (:odt-display-outline-level nil nil org-odt-display-outline-level)
+ (:odt-fontify-srcblocks nil nil org-odt-fontify-srcblocks)
+ (:odt-format-drawer-function nil nil org-odt-format-drawer-function)
+ (:odt-format-headline-function nil nil org-odt-format-headline-function)
+ (:odt-format-inlinetask-function nil nil org-odt-format-inlinetask-function)
+ (: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.
- (:with-latex nil "tex" org-odt-with-latex)))
+ (:with-latex nil "tex" org-odt-with-latex)
+ ;; Retrieve LaTeX header for fragments.
+ (:latex-header "LATEX_HEADER" nil nil newline)))
;;; Dependencies
;;; Hooks
-;;; Function Declarations
+;;; Function and Dynamically Scoped Variables Declarations
-(declare-function org-id-find-id-file "org-id" (id))
(declare-function hfy-face-to-style "htmlfontify" (fn))
(declare-function hfy-face-or-def-to-name "htmlfontify" (fn))
(declare-function archive-zip-extract "arc-mode" (archive name))
(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file))
(declare-function browse-url-file-url "browse-url" (file))
+(defvar nxml-auto-insert-xml-declaration-flag) ; nxml-mode.el
+(defvar archive-zip-extract) ; arc-mode.el
+(defvar hfy-end-span-handler) ; htmlfontify.el
+(defvar hfy-begin-span-handler) ; htmlfontify.el
+(defvar hfy-face-to-css) ; htmlfontify.el
+(defvar hfy-html-quote-map) ; htmlfontify.el
+(defvar hfy-html-quote-regex) ; htmlfontify.el
;;; Internal Variables
(defconst org-odt-lib-dir
- (file-name-directory load-file-name)
+ (file-name-directory (or load-file-name (buffer-file-name)))
"Location of ODT exporter.
Use this to infer values of `org-odt-styles-dir' and
`org-odt-schema-dir'.")
@@ -157,7 +180,7 @@ and `org-odt-data-dir'.")
(eval-when-compile
(and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install
(expand-file-name "./styles/" org-odt-data-dir)))
- (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git
+ (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git
(expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa
(expand-file-name "./org/" data-directory) ; system
)
@@ -167,23 +190,14 @@ heuristically based on the values of `org-odt-lib-dir' and
`org-odt-data-dir'.")
(defconst org-odt-styles-dir
- (let* ((styles-dir
- (catch 'styles-dir
- (message "Debug (ox-odt): Searching for OpenDocument styles files...")
- (mapc (lambda (styles-dir)
- (when styles-dir
- (message "Debug (ox-odt): Trying %s..." styles-dir)
- (when (and (file-readable-p
- (expand-file-name
- "OrgOdtContentTemplate.xml" styles-dir))
- (file-readable-p
- (expand-file-name
- "OrgOdtStyles.xml" styles-dir)))
- (message "Debug (ox-odt): Using styles under %s"
- styles-dir)
- (throw 'styles-dir styles-dir))))
- org-odt-styles-dir-list)
- nil)))
+ (let ((styles-dir
+ (cl-find-if
+ (lambda (dir)
+ (and dir
+ (file-readable-p
+ (expand-file-name "OrgOdtContentTemplate.xml" dir))
+ (file-readable-p (expand-file-name "OrgOdtStyles.xml" dir))))
+ org-odt-styles-dir-list)))
(unless styles-dir
(error "Error (ox-odt): Cannot find factory styles files, aborting"))
styles-dir)
@@ -192,13 +206,12 @@ heuristically based on the values of `org-odt-lib-dir' and
This directory contains the following XML files -
\"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These
XML files are used as the default values of
- `org-odt-styles-file' and
- `org-odt-content-template-file'.
+ `org-odt-styles-file' and `org-odt-content-template-file'.
The default value of this variable varies depending on the
-version of org in use and is initialized from
-`org-odt-styles-dir-list'. Note that the user could be using org
-from one of: org's own private git repository, GNU ELPA tar or
+version of Org in use and is initialized from
+`org-odt-styles-dir-list'. Note that the user could be using Org
+from one of: Org own private git repository, GNU ELPA tar or
standard Emacs.")
(defconst org-odt-bookmark-prefix "OrgXref.")
@@ -263,7 +276,6 @@ except that the foreground and background colors are set
according to the default face identified by the `htmlfontify'.")
(defvar hfy-optimizations)
-(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "25.1")
(defvar org-odt-embedded-formulas-count 0)
(defvar org-odt-embedded-images-count 0)
(defvar org-odt-image-size-probe-method
@@ -369,28 +381,14 @@ visually."
(require 'rng-loc)
(defcustom org-odt-schema-dir
- (let* ((schema-dir
- (catch 'schema-dir
- (message "Debug (ox-odt): Searching for OpenDocument schema files...")
- (mapc
- (lambda (schema-dir)
- (when schema-dir
- (message "Debug (ox-odt): Trying %s..." schema-dir)
- (when (and (file-expand-wildcards
- (expand-file-name "od-manifest-schema*.rnc"
- schema-dir))
- (file-expand-wildcards
- (expand-file-name "od-schema*.rnc"
- schema-dir))
- (file-readable-p
- (expand-file-name "schemas.xml" schema-dir)))
- (message "Debug (ox-odt): Using schema files under %s"
- schema-dir)
- (throw 'schema-dir schema-dir))))
- org-odt-schema-dir-list)
- (message "Debug (ox-odt): No OpenDocument schema files installed")
- nil)))
- schema-dir)
+ (cl-find-if
+ (lambda (dir)
+ (and dir
+ (file-expand-wildcards
+ (expand-file-name "od-manifest-schema*.rnc" dir))
+ (file-expand-wildcards (expand-file-name "od-schema*.rnc" dir))
+ (file-readable-p (expand-file-name "schemas.xml" dir))))
+ org-odt-schema-dir-list)
"Directory that contains OpenDocument schema files.
This directory contains:
@@ -647,8 +645,7 @@ values. See Info node `(emacs) File Variables'."
;;;; Drawers
-(defcustom org-odt-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-odt-format-drawer-function (lambda (_name contents) contents)
"Function called to format a drawer in ODT code.
The function must accept two parameters:
@@ -659,14 +656,15 @@ The function should return the string to be exported.
The default value simply returns the value of CONTENTS."
:group 'org-export-odt
- :version "24.4"
+ :version "26.1"
:package-version '(Org . "8.3")
:type 'function)
;;;; Headline
-(defcustom org-odt-format-headline-function 'ignore
+(defcustom org-odt-format-headline-function
+ 'org-odt-format-headline-default-function
"Function to format headline text.
This function will be called with 5 arguments:
@@ -678,14 +676,15 @@ TAGS the tags string, separated with colons (string or nil).
The function result will be used as headline text."
:group 'org-export-odt
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type 'function)
;;;; Inlinetasks
-(defcustom org-odt-format-inlinetask-function 'ignore
+(defcustom org-odt-format-inlinetask-function
+ 'org-odt-format-inlinetask-default-function
"Function called to format an inlinetask in ODT code.
The function must accept six parameters:
@@ -698,8 +697,8 @@ The function must accept six parameters:
The function should return the string to be exported."
:group 'org-export-odt
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type 'function)
@@ -750,15 +749,15 @@ link's path."
:value-type (regexp :tag "Path")))
(defcustom org-odt-inline-image-rules
- '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'"))
+ '(("file" . "\\.\\(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
to consider, and value is a regexp that will be matched against
link's path."
:group 'org-export-odt
- :version "24.4"
- :package-version '(Org . "8.0")
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(alist :key-type (string :tag "Type")
:value-type (regexp :tag "Path")))
@@ -787,8 +786,8 @@ Use the latter option if you do not want the custom styles to be
based on your current display settings. It is necessary that the
styles.xml already contains needed styles for colorizing to work.
-This variable is effective only if
-`org-odt-fontify-srcblocks' is turned on."
+This variable is effective only if `org-odt-fontify-srcblocks' is
+turned on."
:group 'org-export-odt
:version "24.1"
:type 'boolean)
@@ -825,8 +824,7 @@ TABLE-STYLE-NAME is the style associated with the table through
TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic
TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined
-below) that is included in
-`org-odt-content-template-file'.
+below) that is included in `org-odt-content-template-file'.
TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE +
\"TableCell\"
@@ -977,11 +975,11 @@ See `org-odt--build-date-styles' for implementation details."
(repeater-unit (org-element-property
:repeater-unit timestamp)))
(concat
- (case repeater-type
+ (cl-case repeater-type
(catchup "++") (restart ".+") (cumulate "+"))
(when repeater-value
(number-to-string repeater-value))
- (case repeater-unit
+ (cl-case repeater-unit
(hour "h") (day "d") (week "w") (month "m")
(year "y"))))))
(concat
@@ -1020,29 +1018,28 @@ See `org-odt--build-date-styles' for implementation details."
(defun org-odt--zip-extract (archive members target)
(when (atom members) (setq members (list members)))
- (mapc (lambda (member)
- (require 'arc-mode)
- (let* ((--quote-file-name
- ;; This is shamelessly stolen from `archive-zip-extract'.
- (lambda (name)
- (if (or (not (memq system-type '(windows-nt ms-dos)))
- (and (boundp 'w32-quote-process-args)
- (null w32-quote-process-args)))
- (shell-quote-argument name)
- name)))
- (target (funcall --quote-file-name target))
- (archive (expand-file-name archive))
- (archive-zip-extract
- (list "unzip" "-qq" "-o" "-d" target))
- exit-code command-output)
- (setq command-output
- (with-temp-buffer
- (setq exit-code (archive-zip-extract archive member))
- (buffer-string)))
- (unless (zerop exit-code)
- (message command-output)
- (error "Extraction failed"))))
- members))
+ (require 'arc-mode)
+ (dolist (member members)
+ (let* ((--quote-file-name
+ ;; This is shamelessly stolen from `archive-zip-extract'.
+ (lambda (name)
+ (if (or (not (memq system-type '(windows-nt ms-dos)))
+ (and (boundp 'w32-quote-process-args)
+ (null w32-quote-process-args)))
+ (shell-quote-argument name)
+ name)))
+ (target (funcall --quote-file-name target))
+ (archive (expand-file-name archive))
+ (archive-zip-extract
+ (list "unzip" "-qq" "-o" "-d" target))
+ exit-code command-output)
+ (setq command-output
+ (with-temp-buffer
+ (setq exit-code (archive-zip-extract archive member))
+ (buffer-string)))
+ (unless (zerop exit-code)
+ (message command-output)
+ (error "Extraction failed")))))
;;;; Target
@@ -1069,13 +1066,20 @@ See `org-odt--build-date-styles' for implementation details."
;;;; Table of Contents
-(defun org-odt-begin-toc (index-title depth)
+(defun org-odt--format-toc (title entries depth)
+ "Return a table of contents.
+TITLE is the title of the table, as a string, or nil. ENTRIES is
+the contents of the table, as a string. DEPTH is an integer
+specifying the depth of the table."
(concat
- (format "
- <text:table-of-content text:style-name=\"OrgIndexSection\" text:protected=\"true\" text:name=\"Table of Contents\">
- <text:table-of-content-source text:outline-level=\"%d\">
- <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
-" depth index-title)
+ "
+<text:table-of-content text:style-name=\"OrgIndexSection\" text:protected=\"true\" text:name=\"Table of Contents\">\n"
+ (format " <text:table-of-content-source text:outline-level=\"%d\">" depth)
+ (and title
+ (format "
+ <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template>
+"
+ title))
(let ((levels (number-sequence 1 10)))
(mapconcat
@@ -1087,59 +1091,61 @@ See `org-odt--build-date-styles' for implementation details."
<text:index-entry-chapter/>
<text:index-entry-text/>
<text:index-entry-link-end/>
- </text:table-of-content-entry-template>
-" level level)) levels ""))
-
- (format "
- </text:table-of-content-source>
-
- <text:index-body>
- <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
- <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
- </text:index-title>
- " index-title)))
-
-(defun org-odt-end-toc ()
- (format "
- </text:index-body>
- </text:table-of-content>
-"))
-
-(defun* org-odt-format-toc-headline
- (todo todo-type priority text tags
- &key level section-number headline-label &allow-other-keys)
- (setq text
- (concat
- ;; Section number.
- (when section-number (concat section-number ". "))
- ;; Todo.
- (when todo
- (let ((style (if (member todo org-done-keywords)
- "OrgDone" "OrgTodo")))
- (format "<text:span text:style-name=\"%s\">%s</text:span> "
- style todo)))
- (when priority
- (let* ((style (format "OrgPriority-%s" priority))
- (priority (format "[#%c]" priority)))
- (format "<text:span text:style-name=\"%s\">%s</text:span> "
- style priority)))
- ;; Title.
- text
- ;; Tags.
- (when tags
- (concat
- (format " <text:span text:style-name=\"%s\">[%s]</text:span>"
- "OrgTags"
- (mapconcat
- (lambda (tag)
- (format
- "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgTag" tag)) tags " : "))))))
+ </text:table-of-content-entry-template>\n"
+ level level)) levels ""))
+ "
+ </text:table-of-content-source>
+ <text:index-body>"
+ (and title
+ (format "
+ <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\">
+ <text:p text:style-name=\"Contents_20_Heading\">%s</text:p>
+ </text:index-title>\n"
+ title))
+ entries
+ "
+ </text:index-body>
+</text:table-of-content>"))
+
+(cl-defun org-odt-format-toc-headline
+ (todo _todo-type priority text tags
+ &key _level section-number headline-label &allow-other-keys)
(format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
- headline-label text))
-
-(defun org-odt-toc (depth info)
- (assert (wholenump depth))
+ headline-label
+ (concat
+ ;; Section number.
+ (and section-number (concat section-number ". "))
+ ;; Todo.
+ (when todo
+ (let ((style (if (member todo org-done-keywords)
+ "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%s" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ (format " <text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags"
+ (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : ")))))))
+
+(defun org-odt-toc (depth info &optional scope)
+ "Build a table of contents.
+DEPTH is an integer specifying the depth of the table. INFO is
+a plist containing current export properties. Optional argument
+SCOPE, when non-nil, defines the scope of the table. Return the
+table of contents as a string, or nil."
+ (cl-assert (wholenump depth))
;; When a headline is marked as a radio target, as in the example below:
;;
;; ** <<<Some Heading>>>
@@ -1150,24 +1156,14 @@ See `org-odt--build-date-styles' for implementation details."
;; /TOC/, as otherwise there will be duplicated anchors one in TOC
;; and one in the document body.
;;
- ;; FIXME-1: Currently exported headings are memoized. `org-export.el'
- ;; doesn't provide a way to disable memoization. So this doesn't
- ;; work.
- ;;
- ;; FIXME-2: Are there any other objects that need to be suppressed
- ;; within TOC?
- (let* ((title (org-export-translate "Table of Contents" :utf-8 info))
- (headlines (org-export-collect-headlines
- info (and (wholenump depth) depth)))
- (backend (org-export-create-backend
- :parent (org-export-backend-name
- (plist-get info :back-end))
- :transcoders (mapcar
- (lambda (type) (cons type (lambda (d c i) c)))
- (list 'radio-target)))))
+ ;; Likewise, links, footnote references and regular targets are also
+ ;; suppressed.
+ (let* ((headlines (org-export-collect-headlines info depth scope))
+ (backend (org-export-toc-entry-backend
+ (org-export-backend-name (plist-get info :back-end)))))
(when headlines
- (concat
- (org-odt-begin-toc title depth)
+ (org-odt--format-toc
+ (and (not scope) (org-export-translate "Table of Contents" :utf-8 info))
(mapconcat
(lambda (headline)
(let* ((entry (org-odt-format-headline--wrap
@@ -1177,7 +1173,7 @@ See `org-odt--build-date-styles' for implementation details."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
style entry)))
headlines "\n")
- (org-odt-end-toc)))))
+ depth))))
;;;; Document styles
@@ -1192,7 +1188,7 @@ Use `org-odt-object-counters' to generate an automatic
OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a
new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
. STYLE-NAME)."
- (assert (stringp object-type))
+ (cl-assert (stringp object-type))
(let* ((object (intern object-type))
(seqvar object)
(seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0)))
@@ -1214,7 +1210,7 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(let ((checkbox (org-element-property :checkbox item)))
(if (not checkbox) ""
(format "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgCode" (case checkbox
+ "OrgCode" (cl-case checkbox
(on "[&#x2713;] ") ; CHECK MARK
(off "[ ] ")
(trans "[-] "))))))
@@ -1258,31 +1254,30 @@ new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME
(case-fold-search nil)
(re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|"))
match rpl (start 0) (filler-beg 0) filler-end filler output)
- (mapc
- (lambda (pair)
- (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t)))
- '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns
- ("%C" . "Y") ; replace century with year
- ("%D" . "%m/%d/%y")
- ("%G" . "Y") ; year corresponding to iso week
- ("%I" . "%H") ; hour on a 12-hour clock
- ("%R" . "%H:%M")
- ("%T" . "%H:%M:%S")
- ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon.
- ("%Z" . "") ; time zone name
- ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format
- ("%g" . "%y")
- ("%X" . "%x" ) ; locale's pref. time format
- ("%j" . "") ; day of the year
- ("%l" . "%k") ; like %I blank-padded
- ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000
- ("%n" . "<text:line-break/>")
- ("%r" . "%I:%M:%S %p")
- ("%t" . "<text:tab/>")
- ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6)
- ("%x" . "%Y-%M-%d %a") ; locale's pref. time format
- ("%z" . "") ; time zone in numeric form
- ))
+ (dolist (pair
+ '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns
+ ("%C" . "Y") ; replace century with year
+ ("%D" . "%m/%d/%y")
+ ("%G" . "Y") ; year corresponding to iso week
+ ("%I" . "%H") ; hour on a 12-hour clock
+ ("%R" . "%H:%M")
+ ("%T" . "%H:%M:%S")
+ ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon.
+ ("%Z" . "") ; time zone name
+ ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format
+ ("%g" . "%y")
+ ("%X" . "%x" ) ; locale's pref. time format
+ ("%j" . "") ; day of the year
+ ("%l" . "%k") ; like %I blank-padded
+ ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000
+ ("%n" . "<text:line-break/>")
+ ("%r" . "%I:%M:%S %p")
+ ("%t" . "<text:tab/>")
+ ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6)
+ ("%x" . "%Y-%M-%d %a") ; locale's pref. time format
+ ("%z" . "") ; time zone in numeric form
+ ))
+ (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t)))
(while (string-match re fmt start)
(setq match (match-string 0 fmt))
(setq rpl (assoc-default match fmt-alist))
@@ -1312,11 +1307,11 @@ CONTENTS is the transcoded contents string. RAW-DATA is the
original parsed data. INFO is a plist holding export options."
;; Write meta file.
(let ((title (org-export-data (plist-get info :title) info))
+ (subtitle (org-export-data (plist-get info :subtitle) info))
(author (let ((author (plist-get info :author)))
(if (not author) "" (org-export-data author info))))
- (email (plist-get info :email))
- (keywords (plist-get info :keywords))
- (description (plist-get info :description)))
+ (keywords (or (plist-get info :keywords) ""))
+ (description (or (plist-get info :description) "")))
(write-region
(concat
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
@@ -1345,12 +1340,14 @@ original parsed data. INFO is a plist holding export options."
(format "<meta:creation-date>%s</meta:creation-date>\n"
iso-date)))))
(format "<meta:generator>%s</meta:generator>\n"
- (let ((creator-info (plist-get info :with-creator)))
- (if (or (not creator-info) (eq creator-info 'comment)) ""
- (plist-get info :creator))))
+ (plist-get info :creator))
(format "<meta:keyword>%s</meta:keyword>\n" keywords)
(format "<dc:subject>%s</dc:subject>\n" description)
(format "<dc:title>%s</dc:title>\n" title)
+ (when (org-string-nw-p subtitle)
+ (format
+ "<meta:user-defined meta:name=\"subtitle\">%s</meta:user-defined>\n"
+ subtitle))
"\n"
" </office:meta>\n" "</office:document-meta>")
nil (concat org-odt-zip-dir "meta.xml"))
@@ -1361,11 +1358,12 @@ original parsed data. INFO is a plist holding export options."
;; Copy styles.xml. Also dump htmlfontify styles, if there is any.
;; Write styles file.
(let* ((styles-file (plist-get info :odt-styles-file))
- (styles-file (and styles-file (read (org-trim styles-file))))
+ (styles-file (and (org-string-nw-p styles-file)
+ (read (org-trim styles-file))))
;; Non-availability of styles.xml is not a critical
;; error. For now, throw an error.
(styles-file (or styles-file
- org-odt-styles-file
+ (plist-get info :odt-styles-file)
(expand-file-name "OrgOdtStyles.xml"
org-odt-styles-dir)
(error "org-odt: Missing styles file?"))))
@@ -1374,13 +1372,11 @@ original parsed data. INFO is a plist holding export options."
(let ((archive (nth 0 styles-file))
(members (nth 1 styles-file)))
(org-odt--zip-extract archive members org-odt-zip-dir)
- (mapc
- (lambda (member)
- (when (org-file-image-p member)
- (let* ((image-type (file-name-extension member))
- (media-type (format "image/%s" image-type)))
- (org-odt-create-manifest-file-entry media-type member))))
- members)))
+ (dolist (member members)
+ (when (org-file-image-p member)
+ (let* ((image-type (file-name-extension member))
+ (media-type (format "image/%s" image-type)))
+ (org-odt-create-manifest-file-entry media-type member))))))
((and (stringp styles-file) (file-exists-p styles-file))
(let ((styles-file-type (file-name-extension styles-file)))
(cond
@@ -1390,7 +1386,7 @@ original parsed data. INFO is a plist holding export options."
(org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir)))))
(t
(error "Invalid specification of styles.xml file: %S"
- org-odt-styles-file)))
+ (plist-get info :odt-styles-file))))
;; create a manifest entry for styles.xml
(org-odt-create-manifest-file-entry "text/xml" "styles.xml")
@@ -1423,7 +1419,7 @@ original parsed data. INFO is a plist holding export options."
;; currently the zip command zips up the entire temp directory so
;; that any auto-generated files created under the hood ends up in
;; the resulting odt file.
- (set (make-local-variable 'backup-inhibited) t)
+ (setq-local backup-inhibited t)
;; Outline numbering is retained only upto LEVEL.
;; To disable outline numbering pass a LEVEL of 0.
@@ -1451,7 +1447,7 @@ original parsed data. INFO is a plist holding export options."
'("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M"))))
(with-temp-buffer
(insert-file-contents
- (or org-odt-content-template-file
+ (or (plist-get info :odt-content-template-file)
(expand-file-name "OrgOdtContentTemplate.xml"
org-odt-styles-dir)))
;; Write automatic styles.
@@ -1460,16 +1456,16 @@ original parsed data. INFO is a plist holding export options."
(re-search-forward " </office:automatic-styles>" nil t)
(goto-char (match-beginning 0))
;; - Dump automatic table styles.
- (loop for (style-name props) in
- (plist-get org-odt-automatic-styles 'Table) do
- (when (setq props (or (plist-get props :rel-width) "96"))
- (insert (format org-odt-table-style-format style-name props))))
+ (cl-loop for (style-name props) in
+ (plist-get org-odt-automatic-styles 'Table) do
+ (when (setq props (or (plist-get props :rel-width) "96"))
+ (insert (format org-odt-table-style-format style-name props))))
;; - Dump date-styles.
- (when org-odt-use-date-fields
+ (when (plist-get info :odt-use-date-fields)
(insert (org-odt--build-date-styles (car custom-time-fmts)
- "OrgDate1")
+ "OrgDate1")
(org-odt--build-date-styles (cdr custom-time-fmts)
- "OrgDate2")))
+ "OrgDate2")))
;; Update display level.
;; - Remove existing sequence decls. Also position the cursor.
(goto-char (point-min))
@@ -1484,7 +1480,8 @@ original parsed data. INFO is a plist holding export options."
(lambda (x)
(format
"<text:sequence-decl text:display-outline-level=\"%d\" text:name=\"%s\"/>"
- org-odt-display-outline-level (nth 1 x)))
+ (plist-get info :odt-display-outline-level)
+ (nth 1 x)))
org-odt-category-map-alist "\n")))
;; Position the cursor to document body.
(goto-char (point-min))
@@ -1493,7 +1490,10 @@ original parsed data. INFO is a plist holding export options."
;; Preamble - Title, Author, Date etc.
(insert
- (let* ((title (org-export-data (plist-get info :title) info))
+ (let* ((title (and (plist-get info :with-title)
+ (org-export-data (plist-get info :title) info)))
+ (subtitle (when title
+ (org-export-data (plist-get info :subtitle) info)))
(author (and (plist-get info :with-author)
(let ((auth (plist-get info :author)))
(and auth (org-export-data auth info)))))
@@ -1505,10 +1505,20 @@ original parsed data. INFO is a plist holding export options."
;; Title.
(when (org-string-nw-p title)
(concat
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>\n"
"OrgTitle" (format "\n<text:title>%s</text:title>" title))
;; Separator.
- "\n<text:p text:style-name=\"OrgTitle\"/>"))
+ "\n<text:p text:style-name=\"OrgTitle\"/>\n"
+ ;; Subtitle.
+ (when (org-string-nw-p subtitle)
+ (concat
+ (format "<text:p text:style-name=\"OrgSubtitle\">\n%s\n</text:p>\n"
+ (concat
+ "<text:user-defined style:data-style-name=\"N0\" text:name=\"subtitle\">\n"
+ subtitle
+ "</text:user-defined>\n"))
+ ;; Separator.
+ "<text:p text:style-name=\"OrgSubtitle\"/>\n"))))
(cond
((and author (not email))
;; Author only.
@@ -1537,14 +1547,15 @@ original parsed data. INFO is a plist holding export options."
(timestamp (and (not (cdr date))
(eq (org-element-type (car date)) 'timestamp)
(car date))))
- (concat
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "OrgSubtitle"
- (if (and org-odt-use-date-fields timestamp)
- (org-odt--format-timestamp (car date))
- (org-export-data (plist-get info :date) info)))
- ;; Separator
- "<text:p text:style-name=\"OrgSubtitle\"/>"))))))
+ (when date
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgSubtitle"
+ (if (and (plist-get info :odt-use-date-fields) timestamp)
+ (org-odt--format-timestamp (car date))
+ (org-export-data date info)))
+ ;; Separator
+ "<text:p text:style-name=\"OrgSubtitle\"/>")))))))
;; Table of Contents
(let* ((with-toc (plist-get info :with-toc))
(depth (and with-toc (if (wholenump with-toc)
@@ -1562,7 +1573,7 @@ original parsed data. INFO is a plist holding export options."
;;;; Bold
-(defun org-odt-bold (bold contents info)
+(defun org-odt-bold (_bold contents _info)
"Transcode BOLD from Org to ODT.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
@@ -1572,7 +1583,7 @@ contextual information."
;;;; Center Block
-(defun org-odt-center-block (center-block contents info)
+(defun org-odt-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to ODT.
CONTENTS holds the contents of the center block. INFO is a plist
holding contextual information."
@@ -1599,7 +1610,7 @@ channel."
;;;; Code
-(defun org-odt-code (code contents info)
+(defun org-odt-code (code _contents _info)
"Transcode a CODE object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -1608,16 +1619,6 @@ channel."
(org-element-property :value code))))
-;;;; Comment
-
-;; Comments are ignored.
-
-
-;;;; Comment Block
-
-;; Comment Blocks are ignored.
-
-
;;;; Drawer
(defun org-odt-drawer (drawer contents info)
@@ -1625,14 +1626,14 @@ channel."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((name (org-element-property :drawer-name drawer))
- (output (funcall org-odt-format-drawer-function
+ (output (funcall (plist-get info :odt-format-drawer-function)
name contents)))
output))
;;;; Dynamic Block
-(defun org-odt-dynamic-block (dynamic-block contents info)
+(defun org-odt-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information. See `org-export-data'."
@@ -1641,7 +1642,7 @@ holding contextual information. See `org-export-data'."
;;;; Entity
-(defun org-odt-entity (entity contents info)
+(defun org-odt-entity (entity _contents _info)
"Transcode an ENTITY object from Org to ODT.
CONTENTS are the definition itself. INFO is a plist holding
contextual information."
@@ -1650,7 +1651,7 @@ contextual information."
;;;; Example Block
-(defun org-odt-example-block (example-block contents info)
+(defun org-odt-example-block (example-block _contents info)
"Transcode a EXAMPLE-BLOCK element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-odt-format-code example-block info))
@@ -1658,7 +1659,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Snippet
-(defun org-odt-export-snippet (export-snippet contents info)
+(defun org-odt-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'odt)
@@ -1667,7 +1668,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Export Block
-(defun org-odt-export-block (export-block contents info)
+(defun org-odt-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "ODT")
@@ -1676,10 +1677,10 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-odt-fixed-width (fixed-width contents info)
+(defun org-odt-fixed-width (fixed-width _contents info)
"Transcode a FIXED-WIDTH element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
- (org-odt-do-format-code (org-element-property :value fixed-width)))
+ (org-odt-do-format-code (org-element-property :value fixed-width) info))
;;;; Footnote Definition
@@ -1689,34 +1690,31 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Footnote Reference
-(defun org-odt-footnote-reference (footnote-reference contents info)
+(defun org-odt-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((--format-footnote-definition
- (function
- (lambda (n def)
- (setq n (format "%d" n))
- (let ((id (concat "fn" n))
- (note-class "footnote")
- (par-style "Footnote"))
- (format
- "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>"
- id note-class
- (concat
- (format "<text:note-citation>%s</text:note-citation>" n)
- (format "<text:note-body>%s</text:note-body>" def)))))))
+ (lambda (n def)
+ (setq n (format "%d" n))
+ (let ((id (concat "fn" n))
+ (note-class "footnote"))
+ (format
+ "<text:note text:id=\"%s\" text:note-class=\"%s\">%s</text:note>"
+ id note-class
+ (concat
+ (format "<text:note-citation>%s</text:note-citation>" n)
+ (format "<text:note-body>%s</text:note-body>" def))))))
(--format-footnote-reference
- (function
- (lambda (n)
- (setq n (format "%d" n))
- (let ((note-class "footnote")
- (ref-format "text")
- (ref-name (concat "fn" n)))
- (format
- "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgSuperscript"
- (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>"
- note-class ref-format ref-name n)))))))
+ (lambda (n)
+ (setq n (format "%d" n))
+ (let ((note-class "footnote")
+ (ref-format "text")
+ (ref-name (concat "fn" n)))
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgSuperscript"
+ (format "<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:note-ref>"
+ note-class ref-format ref-name n))))))
(concat
;; Insert separator between two footnotes in a row.
(let ((prev (org-export-get-previous-element footnote-reference info)))
@@ -1724,12 +1722,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgSuperscript" ",")))
;; Transcode footnote reference.
- (let ((n (org-export-get-footnote-number footnote-reference info)))
+ (let ((n (org-export-get-footnote-number footnote-reference info nil t)))
(cond
- ((not (org-export-footnote-first-reference-p footnote-reference info))
+ ((not
+ (org-export-footnote-first-reference-p footnote-reference info nil t))
(funcall --format-footnote-reference n))
- ;; Inline definitions are secondary strings.
- ;; Non-inline footnotes definitions are full Org data.
(t
(let* ((raw (org-export-get-footnote-definition
footnote-reference info))
@@ -1747,41 +1744,19 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"OrgFootnoteCenter"
"OrgFootnoteQuotations")))))
info))))
- (if (eq (org-element-type raw) 'org-data) def
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "Footnote" def)))))
+ ;; Inline definitions are secondary strings. We
+ ;; need to wrap them within a paragraph.
+ (if (eq (org-element-class (car (org-element-contents raw)))
+ 'element)
+ def
+ (format
+ "\n<text:p text:style-name=\"Footnote\">%s</text:p>"
+ def)))))
(funcall --format-footnote-definition n def))))))))
;;;; Headline
-(defun* org-odt-format-headline
- (todo todo-type priority text tags
- &key level section-number headline-label &allow-other-keys)
- (concat
- ;; Todo.
- (when todo
- (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo")))
- (format "<text:span text:style-name=\"%s\">%s</text:span> "
- style todo)))
- (when priority
- (let* ((style (format "OrgPriority-%s" priority))
- (priority (format "[#%c]" priority)))
- (format "<text:span text:style-name=\"%s\">%s</text:span> "
- style priority)))
- ;; Title.
- text
- ;; Tags.
- (when tags
- (concat
- "<text:tab/>"
- (format "<text:span text:style-name=\"%s\">[%s]</text:span>"
- "OrgTags" (mapconcat
- (lambda (tag)
- (format
- "<text:span text:style-name=\"%s\">%s</text:span>"
- "OrgTag" tag)) tags " : "))))))
-
(defun org-odt-format-headline--wrap (headline backend info
&optional format-function
&rest extra-keys)
@@ -1804,20 +1779,19 @@ INFO is a plist holding contextual information."
(org-element-property :title headline) backend info))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
- (headline-label (concat "sec-" (mapconcat 'number-to-string
- headline-number "-")))
- (format-function (cond
- ((functionp format-function) format-function)
- ((not (eq org-odt-format-headline-function 'ignore))
- (function*
- (lambda (todo todo-type priority text tags
- &allow-other-keys)
- (funcall org-odt-format-headline-function
- todo todo-type priority text tags))))
- (t 'org-odt-format-headline))))
+ (headline-label (org-export-get-reference headline info))
+ (format-function
+ (if (functionp format-function) format-function
+ (cl-function
+ (lambda (todo todo-type priority text tags
+ &key _level _section-number _headline-label
+ &allow-other-keys)
+ (funcall (plist-get info :odt-format-headline-function)
+ todo todo-type priority text tags))))))
(apply format-function
- todo todo-type priority text tags
- :headline-label headline-label :level level
+ todo todo-type priority text tags
+ :headline-label headline-label
+ :level level
:section-number section-number extra-keys)))
(defun org-odt-headline (headline contents info)
@@ -1826,26 +1800,16 @@ CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
;; Case 1: This is a footnote section: ignore it.
(unless (org-element-property :footnote-section-p headline)
- (let* ((text (org-export-data (org-element-property :title headline) info))
- ;; Create the headline text.
- (full-text (org-odt-format-headline--wrap headline nil info))
+ (let* ((full-text (org-odt-format-headline--wrap headline nil info))
;; Get level relative to current parsed data.
(level (org-export-get-relative-level headline info))
+ (numbered (org-export-numbered-headline-p headline info))
;; Get canonical label for the headline.
- (id (concat "sec-" (mapconcat 'number-to-string
- (org-export-get-headline-number
- headline info) "-")))
- ;; Get user-specified labels for the headline.
- (extra-ids (list (org-element-property :CUSTOM_ID headline)
- (org-element-property :ID headline)))
+ (id (org-export-get-reference headline info))
;; Extra targets.
(extra-targets
- (mapconcat (lambda (x)
- (when x
- (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x)))
- (org-odt--target
- "" (org-export-solidify-link-text x)))))
- extra-ids ""))
+ (let ((id (org-element-property :ID headline)))
+ (if id (org-odt--target "" (concat "ID-" id)) "")))
;; Title.
(anchored-title (org-odt--target full-text id)))
(cond
@@ -1858,8 +1822,7 @@ holding contextual information."
(and (org-export-first-sibling-p headline info)
(format "\n<text:list text:style-name=\"%s\" %s>"
;; Choose style based on list type.
- (if (org-export-numbered-headline-p headline info)
- "OrgNumberedList" "OrgBulletedList")
+ (if numbered "OrgNumberedList" "OrgBulletedList")
;; If top-level list, re-start numbering. Otherwise,
;; continue numbering.
(format "text:continue-numbering=\"%s\""
@@ -1886,16 +1849,45 @@ holding contextual information."
(t
(concat
(format
- "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\">%s</text:h>"
- (format "Heading_20_%s" level)
+ "\n<text:h text:style-name=\"%s\" text:outline-level=\"%s\" text:is-list-header=\"%s\">%s</text:h>"
+ (format "Heading_20_%s%s"
+ level (if numbered "" "_unnumbered"))
level
+ (if numbered "false" "true")
(concat extra-targets anchored-title))
contents))))))
+(defun org-odt-format-headline-default-function
+ (todo todo-type priority text tags)
+ "Default format function for a headline.
+See `org-odt-format-headline-function' for details."
+ (concat
+ ;; Todo.
+ (when todo
+ (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo")))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> " style todo)))
+ (when priority
+ (let* ((style (format "OrgPriority-%c" priority))
+ (priority (format "[#%c]" priority)))
+ (format "<text:span text:style-name=\"%s\">%s</text:span> "
+ style priority)))
+ ;; Title.
+ text
+ ;; Tags.
+ (when tags
+ (concat
+ "<text:tab/>"
+ (format "<text:span text:style-name=\"%s\">[%s]</text:span>"
+ "OrgTags" (mapconcat
+ (lambda (tag)
+ (format
+ "<text:span text:style-name=\"%s\">%s</text:span>"
+ "OrgTag" tag)) tags " : "))))))
+
;;;; Horizontal Rule
-(defun org-odt-horizontal-rule (horizontal-rule contents info)
+(defun org-odt-horizontal-rule (_horizontal-rule _contents _info)
"Transcode an HORIZONTAL-RULE object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -1913,18 +1905,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"Return a character not used in string S.
This is used to choose a separator for constructs like \\verb."
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (loop for c across ll
- when (not (string-match (regexp-quote (char-to-string c)) s))
- return (char-to-string c))))
+ (cl-loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
-(defun org-odt-inline-src-block (inline-src-block contents info)
+(defun org-odt-inline-src-block (_inline-src-block _contents _info)
"Transcode an INLINE-SRC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((org-lang (org-element-property :language inline-src-block))
- (code (org-element-property :value inline-src-block))
- (separator (org-odt--find-verb-separator code)))
- (error "FIXME")))
+ (error "FIXME"))
;;;; Inlinetask
@@ -1933,33 +1922,37 @@ contextual information."
"Transcode an INLINETASK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (cond
- ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it
- ;; with appropriate arguments.
- ((not (eq org-odt-format-inlinetask-function 'ignore))
- (let ((format-function
- (function*
- (lambda (todo todo-type priority text tags
- &key contents &allow-other-keys)
- (funcall org-odt-format-inlinetask-function
- todo todo-type priority text tags contents)))))
- (org-odt-format-headline--wrap
- inlinetask nil info format-function :contents contents)))
- ;; Otherwise, use a default template.
- (t
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "Text_20_body"
- (org-odt--textbox
- (concat
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "OrgInlineTaskHeading"
- (org-odt-format-headline--wrap inlinetask nil info))
- contents)
- nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))))
+ (let* ((todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword inlinetask)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type inlinetask)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority inlinetask)))
+ (text (org-export-data (org-element-property :title inlinetask) info))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags inlinetask info))))
+ (funcall (plist-get info :odt-format-inlinetask-function)
+ todo todo-type priority text tags contents)))
+
+(defun org-odt-format-inlinetask-default-function
+ (todo todo-type priority name tags contents)
+ "Default format function for a inlinetasks.
+See `org-odt-format-inlinetask-function' for details."
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Text_20_body"
+ (org-odt--textbox
+ (concat
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "OrgInlineTaskHeading"
+ (org-odt-format-headline-default-function
+ todo todo-type priority name tags))
+ contents)
+ nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\"")))
;;;; Italic
-(defun org-odt-italic (italic contents info)
+(defun org-odt-italic (_italic contents _info)
"Transcode ITALIC from Org to ODT.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
@@ -1974,32 +1967,21 @@ contextual information."
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
(let* ((plain-list (org-export-get-parent item))
- (type (org-element-property :type plain-list))
- (counter (org-element-property :counter item))
- (tag (let ((tag (org-element-property :tag item)))
- (and tag
- (concat (org-odt--checkbox item)
- (org-export-data tag info))))))
- (case type
- ((ordered unordered descriptive-1 descriptive-2)
- (format "\n<text:list-item>\n%s\n%s"
- contents
- (let* ((--element-has-a-table-p
- (function
- (lambda (element info)
- (loop for el in (org-element-contents element)
- thereis (eq (org-element-type el) 'table))))))
- (cond
- ((funcall --element-has-a-table-p item info)
- "</text:list-header>")
- (t "</text:list-item>")))))
- (t (error "Unknown list type: %S" type)))))
+ (type (org-element-property :type plain-list)))
+ (unless (memq type '(ordered unordered descriptive-1 descriptive-2))
+ (error "Unknown list type: %S" type))
+ (format "\n<text:list-item>\n%s\n%s"
+ contents
+ (if (org-element-map item 'table #'identity info 'first-match)
+ "</text:list-header>"
+ "</text:list-item>"))))
;;;; Keyword
-(defun org-odt-keyword (keyword contents info)
+(defun org-odt-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to ODT.
-CONTENTS is nil. INFO is a plist holding contextual information."
+CONTENTS is nil. INFO is a plist holding contextual
+information."
(let ((key (org-element-property :key keyword))
(value (org-element-property :value keyword)))
(cond
@@ -2008,14 +1990,15 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; FIXME
(ignore))
((string= key "TOC")
- (let ((value (downcase value)))
+ (let ((case-fold-search t))
(cond
- ((string-match "\\<headlines\\>" value)
- (let ((depth (or (and (string-match "[0-9]+" value)
+ ((string-match-p "\\<headlines\\>" value)
+ (let ((depth (or (and (string-match "\\<[0-9]+\\>" value)
(string-to-number (match-string 0 value)))
- (plist-get info :with-toc))))
- (when (wholenump depth) (org-odt-toc depth info))))
- ((member value '("tables" "figures" "listings"))
+ (plist-get info :headline-levels)))
+ (localp (string-match-p "\\<local\\>" value)))
+ (org-odt-toc depth info (and localp keyword))))
+ ((string-match-p "tables\\|figures\\|listings" value)
;; FIXME
(ignore))))))))
@@ -2031,34 +2014,33 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; (unless (> (length ad-return-value) 0)
;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0)))))
-(defun org-odt-latex-environment (latex-environment contents info)
+(defun org-odt-latex-environment (latex-environment _contents info)
"Transcode a LATEX-ENVIRONMENT element from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(let* ((latex-frag (org-remove-indentation
(org-element-property :value latex-environment))))
- (org-odt-do-format-code latex-frag)))
+ (org-odt-do-format-code latex-frag info)))
;;;; Latex Fragment
;; (when latex-frag ; FIXME
-;; (setq href (org-propertize href :title "LaTeX Fragment"
+;; (setq href (propertize href :title "LaTeX Fragment"
;; :description latex-frag)))
;; handle verbatim
;; provide descriptions
-(defun org-odt-latex-fragment (latex-fragment contents info)
+(defun org-odt-latex-fragment (latex-fragment _contents _info)
"Transcode a LATEX-FRAGMENT object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
- (let* ((latex-frag (org-element-property :value latex-fragment))
- (processing-type (plist-get info :with-latex)))
+ (let ((latex-frag (org-element-property :value latex-fragment)))
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgCode" (org-odt--encode-plain-text latex-frag t))))
;;;; Line Break
-(defun org-odt-line-break (line-break contents info)
+(defun org-odt-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
"<text:line-break/>")
@@ -2069,29 +2051,29 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Links :: Label references
(defun org-odt--enumerate (element info &optional predicate n)
- (when predicate (assert (funcall predicate element info)))
+ (when predicate (cl-assert (funcall predicate element info)))
(let* ((--numbered-parent-headline-at-<=-n
- (function
- (lambda (element n info)
- (loop for x in (org-export-get-genealogy element)
- thereis (and (eq (org-element-type x) 'headline)
- (<= (org-export-get-relative-level x info) n)
- (org-export-numbered-headline-p x info)
- x)))))
+ (lambda (element n info)
+ (cl-loop for x in (org-element-lineage element)
+ thereis (and (eq (org-element-type x) 'headline)
+ (<= (org-export-get-relative-level x info) n)
+ (org-export-numbered-headline-p x info)
+ x))))
(--enumerate
- (function
- (lambda (element scope info &optional predicate)
- (let ((counter 0))
- (org-element-map (or scope (plist-get info :parse-tree))
- (org-element-type element)
- (lambda (el)
- (and (or (not predicate) (funcall predicate el info))
- (incf counter)
- (eq element el)
- counter))
- info 'first-match)))))
+ (lambda (element scope info &optional predicate)
+ (let ((counter 0))
+ (org-element-map (or scope (plist-get info :parse-tree))
+ (org-element-type element)
+ (lambda (el)
+ (and (or (not predicate) (funcall predicate el info))
+ (cl-incf counter)
+ (eq element el)
+ counter))
+ info 'first-match))))
(scope (funcall --numbered-parent-headline-at-<=-n
- element (or n org-odt-display-outline-level) info))
+ element
+ (or n (plist-get info :odt-display-outline-level))
+ info))
(ordinal (funcall --enumerate element scope info predicate))
(tag
(concat
@@ -2116,20 +2098,22 @@ the generated string.
Return value is a string if OP is set to `reference' or a cons
cell like CAPTION . SHORT-CAPTION) where CAPTION and
SHORT-CAPTION are strings."
- (assert (memq (org-element-type element) '(link table src-block paragraph)))
- (let* ((caption-from
- (case (org-element-type element)
+ (cl-assert (memq (org-element-type element) '(link table src-block paragraph)))
+ (let* ((element-or-parent
+ (cl-case (org-element-type element)
(link (org-export-get-parent-element element))
(t element)))
;; Get label and caption.
- (label (org-element-property :name caption-from))
- (caption (org-export-get-caption caption-from))
- (caption (and caption (org-export-data caption info)))
+ (label (and (or (org-element-property :name element)
+ (org-element-property :name element-or-parent))
+ (org-export-get-reference element-or-parent info)))
+ (caption (let ((c (org-export-get-caption element-or-parent)))
+ (and c (org-export-data c info))))
;; FIXME: We don't use short-caption for now
(short-caption nil))
(when (or label caption)
(let* ((default-category
- (case (org-element-type element)
+ (cl-case (org-element-type element)
(table "__Table__")
(src-block "__Listing__")
((link paragraph)
@@ -2145,19 +2129,17 @@ SHORT-CAPTION are strings."
(t (error "Don't know how to format label for element type: %s"
(org-element-type element)))))
seqno)
- (assert default-category)
- (destructuring-bind (counter label-style category predicate)
- (assoc-default default-category org-odt-category-map-alist)
+ (cl-assert default-category)
+ (pcase-let
+ ((`(,counter ,label-style ,category ,predicate)
+ (assoc-default default-category org-odt-category-map-alist)))
;; Compute sequence number of the element.
(setq seqno (org-odt--enumerate element info predicate))
;; Localize category string.
(setq category (org-export-translate category :utf-8 info))
- (case op
+ (cl-case op
;; Case 1: Handle Label definition.
(definition
- ;; Assign an internal label, if user has not provided one
- (setq label (org-export-solidify-link-text
- (or label (format "%s-%s" default-category seqno))))
(cons
(concat
;; Sneak in a bookmark. The bookmark is used when the
@@ -2179,14 +2161,13 @@ SHORT-CAPTION are strings."
short-caption))
;; Case 2: Handle Label reference.
(reference
- (assert label)
- (setq label (org-export-solidify-link-text label))
(let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t)))
(fmt1 (car fmt))
(fmt2 (cadr fmt)))
(format "<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">%s</text:sequence-ref>"
- fmt1 label (format-spec fmt2 `((?e . ,category)
- (?n . ,seqno))))))
+ fmt1
+ label
+ (format-spec fmt2 `((?e . ,category) (?n . ,seqno))))))
(t (error "Unknown %S on label" op))))))))
@@ -2199,7 +2180,7 @@ SHORT-CAPTION are strings."
(target-dir "Images/")
(target-file
(format "%s%04d.%s" target-dir
- (incf org-odt-embedded-images-count) image-type)))
+ (cl-incf org-odt-embedded-images-count) image-type)))
(message "Embedding %s as %s..."
(substring-no-properties path) target-file)
@@ -2211,8 +2192,8 @@ SHORT-CAPTION are strings."
(org-odt-create-manifest-file-entry media-type target-file)
target-file))
-(defun org-odt--image-size (file &optional user-width
- user-height scale dpi embed-as)
+(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)
@@ -2224,7 +2205,7 @@ SHORT-CAPTION are strings."
(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 org-odt-pixels-per-inch))
+ (dpi (or dpi (plist-get info :odt-pixels-per-inch)))
(anchor-type (or embed-as "paragraph"))
(user-width (and (not scale) user-width))
(user-height (and (not scale) user-height))
@@ -2278,7 +2259,7 @@ SHORT-CAPTION are strings."
"Return ODT code for an inline image.
LINK is the link pointing to the inline image. INFO is a plist
used as a communication channel."
- (assert (eq (org-element-type element) 'link))
+ (cl-assert (eq (org-element-type element) 'link))
(let* ((src (let* ((type (org-element-property :type element))
(raw-path (org-element-property :path element)))
(cond ((member type '("http" "https"))
@@ -2293,7 +2274,7 @@ used as a communication channel."
"\n<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>"
(org-odt--copy-image-file src-expanded)))
;; Extract attributes from #+ATTR_ODT line.
- (attr-from (case (org-element-type element)
+ (attr-from (cl-case (org-element-type element)
(link (org-export-get-parent-element element))
(t element)))
;; Convert attributes to a plist.
@@ -2313,7 +2294,7 @@ used as a communication channel."
;; Handle `:width', `:height' and `:scale' properties. Read
;; them as numbers since we need them for computations.
(size (org-odt--image-size
- src-expanded
+ src-expanded info
(let ((width (plist-get attr-plist :width)))
(and width (read width)))
(let ((length (plist-get attr-plist :length)))
@@ -2327,7 +2308,7 @@ used as a communication channel."
(standalone-link-p (org-odt--standalone-link-p element info))
(embed-as (if standalone-link-p "paragraph" "as-char"))
(captions (org-odt-format-label element info 'definition))
- (caption (car captions)) (short-caption (cdr captions))
+ (caption (car captions))
(entity (concat (and caption "Captioned") embed-as "Image"))
;; Check if this link was created by LaTeX-to-PNG converter.
(replaces (org-element-property
@@ -2342,14 +2323,13 @@ used as a communication channel."
;; description. This quite useful for debugging.
(desc (and replaces (org-element-property :value replaces))))
(org-odt--render-image/formula entity href width height
- captions user-frame-params title desc)))
+ captions user-frame-params title desc)))
;;;; Links :: Math formula
(defun org-odt-link--inline-formula (element info)
- (let* ((src (let* ((type (org-element-property :type element))
- (raw-path (org-element-property :path element)))
+ (let* ((src (let ((raw-path (org-element-property :path element)))
(cond
((file-name-absolute-p raw-path)
(expand-file-name raw-path))
@@ -2365,7 +2345,6 @@ used as a communication channel."
(standalone-link-p (org-odt--standalone-link-p element info))
(embed-as (if standalone-link-p 'paragraph 'character))
(captions (org-odt-format-label element info 'definition))
- (caption (car captions)) (short-caption (cdr captions))
;; Check if this link was created by LaTeX-to-MathML
;; converter.
(replaces (org-element-property
@@ -2383,7 +2362,7 @@ used as a communication channel."
(cond
((eq embed-as 'character)
(org-odt--render-image/formula "InlineFormula" href width height
- nil nil title desc))
+ nil nil title desc))
(t
(let* ((equation (org-odt--render-image/formula
"CaptionedDisplayFormula" href width height
@@ -2398,7 +2377,7 @@ used as a communication channel."
(defun org-odt--copy-formula-file (src-file)
"Returns the internal name of the file"
(let* ((target-dir (format "Formula-%04d/"
- (incf org-odt-embedded-formulas-count)))
+ (cl-incf org-odt-embedded-formulas-count)))
(target-file (concat target-dir "content.xml")))
;; Create a directory for holding formula file. Also enter it in
;; to manifest.
@@ -2408,13 +2387,13 @@ used as a communication channel."
;; Copy over the formula file from user directory to zip
;; directory.
(message "Embedding %s as %s..." src-file target-file)
- (let ((case-fold-search nil))
+ (let ((ext (file-name-extension src-file)))
(cond
;; Case 1: Mathml.
- ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file)
+ ((member ext '("mathml" "mml"))
(copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite))
;; Case 2: OpenDocument formula.
- ((string-match "\\.odf\\'" src-file)
+ ((string= ext "odf")
(org-odt--zip-extract src-file "content.xml"
(concat org-odt-zip-dir target-dir)))
(t (error "%s is not a formula file" src-file))))
@@ -2425,8 +2404,8 @@ used as a communication channel."
;;;; Targets
(defun org-odt--render-image/formula (cfg-key href width height &optional
- captions user-frame-params
- &rest title-and-desc)
+ captions user-frame-params
+ &rest title-and-desc)
(let* ((frame-cfg-alist
;; Each element of this alist is of the form (CFG-HANDLE
;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS).
@@ -2488,11 +2467,11 @@ used as a communication channel."
(lambda (default user)
"Merge default and user frame params."
(if (not user) default
- (assert (= (length default) 3))
- (assert (= (length user) 3))
- (loop for u in user
- for d in default
- collect (or u d)))))))
+ (cl-assert (= (length default) 3))
+ (cl-assert (= (length user) 3))
+ (cl-loop for u in user
+ for d in default
+ collect (or u d)))))))
(cond
;; Case 1: Image/Formula has no caption.
;; There is only one frame, one that surrounds the image
@@ -2526,7 +2505,7 @@ used as a communication channel."
caption))
width height outer)))))
-(defun org-odt--enumerable-p (element info)
+(defun org-odt--enumerable-p (element _info)
;; Element should have a caption or label.
(or (org-element-property :caption element)
(org-element-property :name element)))
@@ -2543,8 +2522,8 @@ used as a communication channel."
(org-element-property :name p))))
;; Link should point to an image file.
(lambda (l)
- (assert (eq (org-element-type l) 'link))
- (org-export-inline-image-p l org-odt-inline-image-rules))))
+ (cl-assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-latex-image-p (element info)
(org-odt--standalone-link-p
@@ -2558,8 +2537,8 @@ used as a communication channel."
(org-element-property :name p))))
;; Link should point to an image file.
(lambda (l)
- (assert (eq (org-element-type l) 'link))
- (org-export-inline-image-p l org-odt-inline-image-rules))))
+ (cl-assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l (plist-get info :odt-inline-image-rules)))))
(defun org-odt--enumerable-formula-p (element info)
(org-odt--standalone-link-p
@@ -2570,12 +2549,12 @@ used as a communication channel."
(org-element-property :name p)))
;; Link should point to a MathML or ODF file.
(lambda (l)
- (assert (eq (org-element-type l) 'link))
- (org-export-inline-image-p l org-odt-inline-formula-rules))))
+ (cl-assert (eq (org-element-type l) 'link))
+ (org-export-inline-image-p l (plist-get info :odt-inline-formula-rules)))))
-(defun org-odt--standalone-link-p (element info &optional
- paragraph-predicate
- link-predicate)
+(defun org-odt--standalone-link-p (element _info &optional
+ paragraph-predicate
+ link-predicate)
"Test if ELEMENT is a standalone link for the purpose ODT export.
INFO is a plist holding contextual information.
@@ -2589,7 +2568,7 @@ PARAGRAPH-PREDICATE in addition to having no other content save for
leading and trailing whitespaces.
Return nil, otherwise."
- (let ((p (case (org-element-type element)
+ (let ((p (cl-case (org-element-type element)
(paragraph element)
(link (and (or (not link-predicate)
(funcall link-predicate element))
@@ -2599,23 +2578,24 @@ Return nil, otherwise."
(when (or (not paragraph-predicate)
(funcall paragraph-predicate p))
(let ((contents (org-element-contents p)))
- (loop for x in contents
- with inline-image-count = 0
- always (case (org-element-type x)
- (plain-text
- (not (org-string-nw-p x)))
- (link
- (and (or (not link-predicate)
- (funcall link-predicate x))
- (= (incf inline-image-count) 1)))
- (t nil))))))))
+ (cl-loop for x in contents
+ with inline-image-count = 0
+ always (cl-case (org-element-type x)
+ (plain-text
+ (not (org-string-nw-p x)))
+ (link
+ (and (or (not link-predicate)
+ (funcall link-predicate x))
+ (= (cl-incf inline-image-count) 1)))
+ (t nil))))))))
(defun org-odt-link--infer-description (destination info)
- ;; DESTINATION is a HEADLINE, a "<<target>>" or an element (like
- ;; paragraph, verse-block etc) to which a "#+NAME: label" can be
- ;; attached. Note that labels that are attached to captioned
- ;; entities - inline images, math formulae and tables - get resolved
- ;; as part of `org-odt-format-label' and `org-odt--enumerate'.
+ ;; DESTINATION is a headline or an element (like paragraph,
+ ;; verse-block etc) to which a "#+NAME: label" can be attached.
+
+ ;; Note that labels that are attached to captioned entities - inline
+ ;; images, math formulae and tables - get resolved as part of
+ ;; `org-odt-format-label' and `org-odt--enumerate'.
;; Create a cross-reference to DESTINATION but make best-efforts to
;; create a *meaningful* description. Check item numbers, section
@@ -2623,44 +2603,40 @@ Return nil, otherwise."
;; NOTE: Counterpart of `org-export-get-ordinal'.
;; FIXME: Handle footnote-definition footnote-reference?
- (let* ((genealogy (org-export-get-genealogy destination))
+ (let* ((genealogy (org-element-lineage destination))
(data (reverse genealogy))
- (label (case (org-element-type destination)
- (headline
- (format "sec-%s" (mapconcat 'number-to-string
- (org-export-get-headline-number
- destination info) "-")))
- (target
- (org-element-property :value destination))
- (t (error "FIXME: Resolve %S" destination)))))
+ (label (let ((type (org-element-type destination)))
+ (if (memq type '(headline target))
+ (org-export-get-reference destination info)
+ (error "FIXME: Unable to resolve %S" destination)))))
(or
(let* ( ;; Locate top-level list.
(top-level-list
- (loop for x on data
- when (eq (org-element-type (car x)) 'plain-list)
- return x))
+ (cl-loop for x on data
+ when (eq (org-element-type (car x)) 'plain-list)
+ return x))
;; Get list item nos.
(item-numbers
- (loop for (plain-list item . rest) on top-level-list by #'cddr
- until (not (eq (org-element-type plain-list) 'plain-list))
- collect (when (eq (org-element-property :type
- plain-list)
- 'ordered)
- (1+ (length (org-export-get-previous-element
- item info t))))))
+ (cl-loop for (plain-list item . rest) on top-level-list by #'cddr
+ until (not (eq (org-element-type plain-list) 'plain-list))
+ collect (when (eq (org-element-property :type
+ plain-list)
+ 'ordered)
+ (1+ (length (org-export-get-previous-element
+ item info t))))))
;; Locate top-most listified headline.
(listified-headlines
- (loop for x on data
- when (and (eq (org-element-type (car x)) 'headline)
- (org-export-low-level-p (car x) info))
- return x))
+ (cl-loop for x on data
+ when (and (eq (org-element-type (car x)) 'headline)
+ (org-export-low-level-p (car x) info))
+ return x))
;; Get listified headline numbers.
(listified-headline-nos
- (loop for el in listified-headlines
- when (eq (org-element-type el) 'headline)
- collect (when (org-export-numbered-headline-p el info)
- (1+ (length (org-export-get-previous-element
- el info t)))))))
+ (cl-loop for el in listified-headlines
+ when (eq (org-element-type el) 'headline)
+ collect (when (org-export-numbered-headline-p el info)
+ (1+ (length (org-export-get-previous-element
+ el info t)))))))
;; Combine item numbers from both the listified headlines and
;; regular list items.
@@ -2669,33 +2645,37 @@ Return nil, otherwise."
(let ((item-numbers (append listified-headline-nos item-numbers)))
(when (and item-numbers (not (memq nil item-numbers)))
(format "<text:bookmark-ref text:reference-format=\"number-all-superior\" text:ref-name=\"%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text label)
+ label
(mapconcat (lambda (n) (if (not n) " "
- (concat (number-to-string n) ".")))
+ (concat (number-to-string n) ".")))
item-numbers "")))))
;; Case 2: Locate a regular and numbered headline in the
;; hierarchy. Display its section number.
- (let ((headline (loop for el in (cons destination genealogy)
- when (and (eq (org-element-type el) 'headline)
- (not (org-export-low-level-p el info))
- (org-export-numbered-headline-p el info))
- return el)))
+ (let ((headline
+ (and
+ ;; Test if destination is a numbered headline.
+ (org-export-numbered-headline-p destination info)
+ (cl-loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info))
+ (org-export-numbered-headline-p el info))
+ return el))))
;; We found one.
(when headline
(format "<text:bookmark-ref text:reference-format=\"chapter\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text label)
+ label
(mapconcat 'number-to-string (org-export-get-headline-number
headline info) "."))))
;; Case 4: Locate a regular headline in the hierarchy. Display
;; its title.
- (let ((headline (loop for el in (cons destination genealogy)
- when (and (eq (org-element-type el) 'headline)
- (not (org-export-low-level-p el info)))
- return el)))
+ (let ((headline (cl-loop for el in (cons destination genealogy)
+ when (and (eq (org-element-type el) 'headline)
+ (not (org-export-low-level-p el info)))
+ return el)))
;; We found one.
(when headline
(format "<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text label)
+ label
(let ((title (org-element-property :title headline)))
(org-export-data title info)))))
(error "FIXME?"))))
@@ -2711,24 +2691,23 @@ INFO is a plist holding contextual information. See
;; Ensure DESC really exists, or set it to nil.
(desc (and (not (string= desc "")) desc))
(imagep (org-export-inline-image-p
- link org-odt-inline-image-rules))
+ link (plist-get info :odt-inline-image-rules)))
(path (cond
((member type '("http" "https" "ftp" "mailto"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" 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))
- protocol)
+ (path (replace-regexp-in-string "&" "&amp;" path)))
(cond
+ ;; Link type is handled by a special function.
+ ((org-export-custom-protocol-maybe link desc 'odt))
;; Image file.
- ((and (not desc) (org-export-inline-image-p
- link org-odt-inline-image-rules))
- (org-odt-link--inline-image link info))
+ ((and (not desc) imagep) (org-odt-link--inline-image link info))
;; Formula file.
- ((and (not desc) (org-export-inline-image-p
- link org-odt-inline-formula-rules))
+ ((and (not desc)
+ (org-export-inline-image-p
+ link (plist-get info :odt-inline-formula-rules)))
(org-odt-link--inline-formula link info))
;; Radio target: Transcode target's contents and use them as
;; link's description.
@@ -2737,8 +2716,7 @@ INFO is a plist holding contextual information. See
(if (not destination) desc
(format
"<text:bookmark-ref text:reference-format=\"text\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
- (org-export-solidify-link-text
- (org-element-property :value destination))
+ (org-export-get-reference destination info)
desc))))
;; Links pointing to a headline: Find destination and build
;; appropriate referencing command.
@@ -2746,55 +2724,46 @@ INFO is a plist holding contextual information. See
(let ((destination (if (string= type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
- ;; Case 1: Fuzzy link points nowhere.
- ('nil
- (format "<text:span text:style-name=\"%s\">%s</text:span>"
- "Emphasis"
- (or desc
- (org-export-data (org-element-property :raw-link link)
- info))))
- ;; Case 2: Fuzzy link points to a headline.
+ (cl-case (org-element-type destination)
+ ;; Fuzzy link points to a headline. If there's
+ ;; a description, create a hyperlink. Otherwise, try to
+ ;; provide a meaningful description.
(headline
- ;; If there's a description, create a hyperlink.
- ;; Otherwise, try to provide a meaningful description.
(if (not desc) (org-odt-link--infer-description destination info)
- (let* ((headline-no
- (org-export-get-headline-number destination info))
- (label
- (format "sec-%s"
- (mapconcat 'number-to-string headline-no "-"))))
+ (let ((label
+ (or (and (string= type "custom-id")
+ (org-element-property :CUSTOM_ID destination))
+ (org-export-get-reference destination info))))
(format
"<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
label desc))))
- ;; Case 3: Fuzzy link points to a target.
+ ;; Fuzzy link points to a target. If there's a description,
+ ;; create a hyperlink. Otherwise, try to provide
+ ;; a meaningful description.
(target
- ;; If there's a description, create a hyperlink.
- ;; Otherwise, try to provide a meaningful description.
- (if (not desc) (org-odt-link--infer-description destination info)
- (let ((label (org-element-property :value destination)))
- (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
- (org-export-solidify-link-text label)
- desc))))
- ;; Case 4: Fuzzy link points to some element (e.g., an
- ;; inline image, a math formula or a table).
+ (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-get-reference destination info)
+ (or desc (org-export-get-ordinal destination info))))
+ ;; Fuzzy link points to some element (e.g., an inline image,
+ ;; a math formula or a table).
(otherwise
(let ((label-reference
- (ignore-errors (org-odt-format-label
- destination info 'reference))))
- (cond ((not label-reference)
- (org-odt-link--infer-description destination info))
- ;; LINK has no description. Create
- ;; a cross-reference showing entity's sequence
- ;; number.
- ((not desc) label-reference)
- ;; LINK has description. Insert a hyperlink with
- ;; user-provided description.
- (t
- (let ((label (org-element-property :name destination)))
- (format "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
- (org-export-solidify-link-text label)
- desc)))))))))
+ (ignore-errors
+ (org-odt-format-label destination info 'reference))))
+ (cond
+ ((not label-reference)
+ (org-odt-link--infer-description destination info))
+ ;; LINK has no description. Create
+ ;; a cross-reference showing entity's sequence
+ ;; number.
+ ((not desc) label-reference)
+ ;; LINK has description. Insert a hyperlink with
+ ;; user-provided description.
+ (t
+ (format
+ "<text:a xlink:type=\"simple\" xlink:href=\"#%s\">%s</text:a>"
+ (org-export-get-reference destination info)
+ desc))))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
@@ -2805,9 +2774,6 @@ INFO is a plist holding contextual information. See
(format
"<text:bookmark-ref text:reference-format=\"number\" text:ref-name=\"OrgXref.%s\">%s</text:bookmark-ref>"
href line-no))))
- ;; Link type is handled by a special function.
- ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
- (funcall protocol (org-link-unescape path) desc 'odt))
;; External link with a description part.
((and path desc)
(let ((link-contents (org-element-contents link)))
@@ -2816,7 +2782,8 @@ INFO is a plist holding contextual information. See
(let ((desc-element (car link-contents)))
(and (eq (org-element-type desc-element) 'link)
(org-export-inline-image-p
- desc-element org-odt-inline-image-rules))))
+ desc-element
+ (plist-get info :odt-inline-image-rules)))))
;; Format link as a clickable image.
(format "\n<draw:a xlink:type=\"simple\" xlink:href=\"%s\">\n%s\n</draw:a>"
path desc)
@@ -2832,6 +2799,18 @@ INFO is a plist holding contextual information. See
"Emphasis" desc)))))
+;;;; Node Property
+
+(defun org-odt-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element from Org to ODT.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (org-odt--encode-plain-text
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) "")))))
+
;;;; Paragraph
(defun org-odt--paragraph-style (paragraph)
@@ -2841,7 +2820,7 @@ Style is a symbol among `quoted', `centered' and nil."
(while (and (setq up (org-element-property :parent up))
(not (memq (org-element-type up)
'(center-block quote-block section)))))
- (case (org-element-type up)
+ (cl-case (org-element-type up)
(center-block 'centered)
(quote-block 'quoted))))
@@ -2853,7 +2832,7 @@ a plist used as a communication channel. DEFAULT, CENTER and
QUOTE are, respectively, style to use when paragraph belongs to
no special environment, a center block, or a quote block."
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- (case (org-odt--paragraph-style paragraph)
+ (cl-case (org-odt--paragraph-style paragraph)
(quoted quote)
(centered center)
(otherwise default))
@@ -2879,13 +2858,13 @@ the plist used as a communication channel."
;;;; Plain List
-(defun org-odt-plain-list (plain-list contents info)
+(defun org-odt-plain-list (plain-list contents _info)
"Transcode a PLAIN-LIST element from Org to ODT.
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(format "\n<text:list text:style-name=\"%s\" %s>\n%s</text:list>"
;; Choose style based on list type.
- (case (org-element-property :type plain-list)
+ (cl-case (org-element-property :type plain-list)
(ordered "OrgNumberedList")
(unordered "OrgBulletedList")
(descriptive-1 "OrgDescriptionList")
@@ -2902,22 +2881,15 @@ contextual information."
(defun org-odt--encode-tabs-and-spaces (line)
(replace-regexp-in-string
- "\\([\t]\\|\\([ ]+\\)\\)"
+ "\\(\t\\| \\{2,\\}\\)"
(lambda (s)
- (cond
- ((string= s "\t") "<text:tab/>")
- (t (let ((n (length s)))
- (cond
- ((= n 1) " ")
- ((> n 1) (concat " " (format "<text:s text:c=\"%d\"/>" (1- n))))
- (t ""))))))
+ (if (string= s "\t") "<text:tab/>"
+ (format " <text:s text:c=\"%d\"/>" (1- (length s)))))
line))
(defun org-odt--encode-plain-text (text &optional no-whitespace-filling)
- (mapc
- (lambda (pair)
- (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
- '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (dolist (pair '(("&" . "&amp;") ("<" . "&lt;") (">" . "&gt;")))
+ (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
(if no-whitespace-filling text
(org-odt--encode-tabs-and-spaces text)))
@@ -2934,11 +2906,9 @@ contextual information."
(setq output (org-export-activate-smart-quotes output :utf-8 info text)))
;; Convert special strings.
(when (plist-get info :with-special-strings)
- (mapc
- (lambda (pair)
- (setq output
- (replace-regexp-in-string (car pair) (cdr pair) output t nil)))
- org-odt-special-string-regexps))
+ (dolist (pair org-odt-special-string-regexps)
+ (setq output
+ (replace-regexp-in-string (car pair) (cdr pair) output t nil))))
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
@@ -2978,34 +2948,24 @@ channel."
;;;; Property Drawer
-(defun org-odt-property-drawer (property-drawer contents info)
+(defun org-odt-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to ODT.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- ;; The property drawer isn't exported but we want separating blank
- ;; lines nonetheless.
- "")
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "<text:p text:style-name=\"OrgFixedWidthBlock\">%s</text:p>"
+ contents)))
;;;; Quote Block
-(defun org-odt-quote-block (quote-block contents info)
+(defun org-odt-quote-block (_quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
contents)
-;;;; Quote Section
-
-(defun org-odt-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to ODT.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (org-odt-do-format-code value))))
-
-
;;;; Section
(defun org-odt-format-section (text style &optional name)
@@ -3016,7 +2976,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
text)))
-(defun org-odt-section (section contents info) ; FIXME
+(defun org-odt-section (_section contents _info) ; FIXME
"Transcode a SECTION element from Org to ODT.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
@@ -3028,9 +2988,7 @@ holding contextual information."
"Transcode a RADIO-TARGET object from Org to ODT.
TEXT is the text of the target. INFO is a plist holding
contextual information."
- (org-odt--target
- text (org-export-solidify-link-text
- (org-element-property :value radio-target))))
+ (org-odt--target text (org-export-get-reference radio-target info)))
;;;; Special Block
@@ -3039,7 +2997,7 @@ contextual information."
"Transcode a SPECIAL-BLOCK element from Org to ODT.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (let ((type (downcase (org-element-property :type special-block)))
+ (let ((type (org-element-property :type special-block))
(attributes (org-export-read-attribute :attr_odt special-block)))
(cond
;; Annotation.
@@ -3109,31 +3067,30 @@ and prefix with \"OrgSrc\". For example,
(cons style-name style)))
(defun org-odt-htmlfontify-string (line)
- (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)")
+ (let* ((hfy-html-quote-regex "\\([<\"&> \t]\\)")
(hfy-html-quote-map '(("\"" "&quot;")
("<" "&lt;")
("&" "&amp;")
(">" "&gt;")
(" " "<text:s/>")
- (" " "<text:tab/>")))
+ ("\t" "<text:tab/>")))
(hfy-face-to-css 'org-odt-hfy-face-to-css)
(hfy-optimizations-1 (copy-sequence hfy-optimizations))
- (hfy-optimizations (add-to-list 'hfy-optimizations-1
- 'body-text-only))
+ (hfy-optimizations (cl-pushnew 'body-text-only hfy-optimizations-1))
(hfy-begin-span-handler
- (lambda (style text-block text-id text-begins-block-p)
+ (lambda (style _text-block _text-id _text-begins-block-p)
(insert (format "<text:span text:style-name=\"%s\">" style))))
- (hfy-end-span-handler (lambda nil (insert "</text:span>"))))
- (org-no-warnings (htmlfontify-string line))))
+ (hfy-end-span-handler (lambda () (insert "</text:span>"))))
+ (with-no-warnings (htmlfontify-string line))))
(defun org-odt-do-format-code
- (code &optional lang refs retain-labels num-start)
+ (code info &optional lang refs retain-labels num-start)
(let* ((lang (or (assoc-default lang org-src-lang-modes) lang))
(lang-mode (and lang (intern (format "%s-mode" lang))))
(code-lines (org-split-string code "\n"))
(code-length (length code-lines))
(use-htmlfontify-p (and (functionp lang-mode)
- org-odt-fontify-srcblocks
+ (plist-get info :odt-fontify-srcblocks)
(require 'htmlfontify nil t)
(fboundp 'htmlfontify-string)))
(code (if (not use-htmlfontify-p) code
@@ -3147,19 +3104,20 @@ and prefix with \"OrgSrc\". For example,
(par-style (if use-htmlfontify-p "OrgSrcBlock"
"OrgFixedWidthBlock"))
(i 0))
- (assert (= code-length (length (org-split-string code "\n"))))
+ (cl-assert (= code-length (length (org-split-string code "\n"))))
(setq code
(org-export-format-code
code
(lambda (loc line-num ref)
(setq par-style
- (concat par-style (and (= (incf i) code-length) "LastLine")))
+ (concat par-style (and (= (cl-incf i) code-length)
+ "LastLine")))
(setq loc (concat loc (and ref retain-labels (format " (%s)" ref))))
(setq loc (funcall fontifier loc))
(when ref
(setq loc (org-odt--target loc (concat "coderef-" ref))))
- (assert par-style)
+ (cl-assert par-style)
(setq loc (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
par-style loc))
(if (not line-num) loc
@@ -3185,19 +3143,15 @@ and prefix with \"OrgSrc\". For example,
;; Does the src block contain labels?
(retain-labels (org-element-property :retain-labels element))
;; Does it have line numbers?
- (num-start (case (org-element-property :number-lines element)
- (continued (org-export-get-loc element info))
- (new 0))))
- (org-odt-do-format-code code lang refs retain-labels num-start)))
+ (num-start (org-export-get-loc element info)))
+ (org-odt-do-format-code code info lang refs retain-labels num-start)))
-(defun org-odt-src-block (src-block contents info)
+(defun org-odt-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to ODT.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((lang (org-element-property :language src-block))
- (attributes (org-export-read-attribute :attr_odt src-block))
- (captions (org-odt-format-label src-block info 'definition))
- (caption (car captions)) (short-caption (cdr captions)))
+ (let* ((attributes (org-export-read-attribute :attr_odt src-block))
+ (caption (car (org-odt-format-label src-block info 'definition))))
(concat
(and caption
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -3211,7 +3165,7 @@ contextual information."
;;;; Statistics Cookie
-(defun org-odt-statistics-cookie (statistics-cookie contents info)
+(defun org-odt-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual information."
(let ((cookie-value (org-element-property :value statistics-cookie)))
@@ -3221,7 +3175,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Strike-Through
-(defun org-odt-strike-through (strike-through contents info)
+(defun org-odt-strike-through (_strike-through contents _info)
"Transcode STRIKE-THROUGH from Org to ODT.
CONTENTS is the text with strike-through markup. INFO is a plist
holding contextual information."
@@ -3231,7 +3185,7 @@ holding contextual information."
;;;; Subscript
-(defun org-odt-subscript (subscript contents info)
+(defun org-odt-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to ODT.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3241,7 +3195,7 @@ contextual information."
;;;; Superscript
-(defun org-odt-superscript (superscript contents info)
+(defun org-odt-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to ODT.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -3255,7 +3209,7 @@ contextual information."
(let* ((table (org-export-get-parent-table element))
(table-attributes (org-export-read-attribute :attr_odt table))
(table-style (plist-get table-attributes :style)))
- (assoc table-style org-odt-table-styles)))
+ (assoc table-style (plist-get info :odt-table-styles))))
(defun org-odt-get-table-cell-styles (table-cell info)
"Retrieve styles applicable to a table cell.
@@ -3296,23 +3250,23 @@ styles congruent with the ODF-1.2 specification."
(cell-style-selectors (nth 2 style-spec))
(cell-type
(cond
- ((and (cdr (assoc 'use-first-column-styles cell-style-selectors))
+ ((and (cdr (assq 'use-first-column-styles cell-style-selectors))
(= c 0)) "FirstColumn")
- ((and (cdr (assoc 'use-last-column-styles cell-style-selectors))
+ ((and (cdr (assq 'use-last-column-styles cell-style-selectors))
(= (1+ c) (cdr table-dimensions)))
"LastColumn")
- ((and (cdr (assoc 'use-first-row-styles cell-style-selectors))
+ ((and (cdr (assq 'use-first-row-styles cell-style-selectors))
(= r 0)) "FirstRow")
- ((and (cdr (assoc 'use-last-row-styles cell-style-selectors))
+ ((and (cdr (assq 'use-last-row-styles cell-style-selectors))
(= (1+ r) (car table-dimensions)))
"LastRow")
- ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-rows-styles cell-style-selectors))
(= (% r 2) 1)) "EvenRow")
- ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-rows-styles cell-style-selectors))
(= (% r 2) 0)) "OddRow")
- ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-columns-styles cell-style-selectors))
(= (% c 2) 1)) "EvenColumn")
- ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors))
+ ((and (cdr (assq 'use-banding-columns-styles cell-style-selectors))
(= (% c 2) 0)) "OddColumn")
(t ""))))
(concat template-name cell-type)))))
@@ -3370,17 +3324,16 @@ channel."
(1+ horiz-span))))))
(unless contents (setq contents ""))
(concat
- (assert paragraph-style)
+ (cl-assert paragraph-style)
(format "\n<table:table-cell%s>\n%s\n</table:table-cell>"
cell-attributes
(let ((table-cell-contents (org-element-contents table-cell)))
- (if (memq (org-element-type (car table-cell-contents))
- org-element-all-elements)
+ (if (eq (org-element-class (car table-cell-contents)) 'element)
contents
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
paragraph-style contents))))
(let (s)
- (dotimes (i horiz-span s)
+ (dotimes (_ horiz-span s)
(setq s (concat s "\n<table:covered-table-cell/>"))))
"\n")))
@@ -3431,7 +3384,7 @@ communication channel."
"Transcode a TABLE element from Org to ODT.
CONTENTS is the contents of the table. INFO is a plist holding
contextual information."
- (case (org-element-property :type table)
+ (cl-case (org-element-property :type table)
;; Case 1: table.el doesn't support export to OD format. Strip
;; such tables from export.
(table.el
@@ -3448,20 +3401,19 @@ contextual information."
(attributes (org-export-read-attribute :attr_odt table))
(custom-table-style (nth 1 (org-odt-table-style-spec table info)))
(table-column-specs
- (function
- (lambda (table info)
- (let* ((table-style (or custom-table-style "OrgTable"))
- (column-style (format "%sColumn" table-style)))
- (mapconcat
- (lambda (table-cell)
- (let ((width (1+ (or (org-export-table-cell-width
- table-cell info) 0)))
- (s (format
- "\n<table:table-column table:style-name=\"%s\"/>"
- column-style))
- out)
- (dotimes (i width out) (setq out (concat s out)))))
- (org-odt-table-first-row-data-cells table info) "\n"))))))
+ (lambda (table info)
+ (let* ((table-style (or custom-table-style "OrgTable"))
+ (column-style (format "%sColumn" table-style)))
+ (mapconcat
+ (lambda (table-cell)
+ (let ((width (1+ (or (org-export-table-cell-width
+ table-cell info) 0)))
+ (s (format
+ "\n<table:table-column table:style-name=\"%s\"/>"
+ column-style))
+ out)
+ (dotimes (_ width out) (setq out (concat s out)))))
+ (org-odt-table-first-row-data-cells table info) "\n")))))
(concat
;; caption.
(when caption
@@ -3490,84 +3442,84 @@ contextual information.
Use `org-odt--table' to typeset the table. Handle details
pertaining to indentation here."
(let* ((--element-preceded-by-table-p
- (function
- (lambda (element info)
- (loop for el in (org-export-get-previous-element element info t)
- thereis (eq (org-element-type el) 'table)))))
+ (lambda (element info)
+ (cl-loop for el in (org-export-get-previous-element element info t)
+ thereis (eq (org-element-type el) 'table))))
(--walk-list-genealogy-and-collect-tags
- (function
- (lambda (table info)
- (let* ((genealogy (org-export-get-genealogy table))
- (list-genealogy
- (when (eq (org-element-type (car genealogy)) 'item)
- (loop for el in genealogy
- when (memq (org-element-type el)
- '(item plain-list))
- collect el)))
- (llh-genealogy
- (apply 'nconc
- (loop for el in genealogy
- when (and (eq (org-element-type el) 'headline)
- (org-export-low-level-p el info))
- collect
- (list el
- (assq 'headline
- (org-element-contents
- (org-export-get-parent el)))))))
- parent-list)
- (nconc
- ;; Handle list genealogy.
- (loop for el in list-genealogy collect
- (case (org-element-type el)
- (plain-list
- (setq parent-list el)
- (cons "</text:list>"
- (format "\n<text:list text:style-name=\"%s\" %s>"
- (case (org-element-property :type el)
- (ordered "OrgNumberedList")
- (unordered "OrgBulletedList")
- (descriptive-1 "OrgDescriptionList")
- (descriptive-2 "OrgDescriptionList"))
- "text:continue-numbering=\"true\"")))
- (item
- (cond
- ((not parent-list)
- (if (funcall --element-preceded-by-table-p table info)
- '("</text:list-header>" . "<text:list-header>")
- '("</text:list-item>" . "<text:list-header>")))
- ((funcall --element-preceded-by-table-p
- parent-list info)
- '("</text:list-header>" . "<text:list-header>"))
- (t '("</text:list-item>" . "<text:list-item>"))))))
- ;; Handle low-level headlines.
- (loop for el in llh-genealogy
- with step = 'item collect
- (case step
- (plain-list
- (setq step 'item) ; Flip-flop
- (setq parent-list el)
- (cons "</text:list>"
- (format "\n<text:list text:style-name=\"%s\" %s>"
- (if (org-export-numbered-headline-p
- el info)
- "OrgNumberedList"
- "OrgBulletedList")
- "text:continue-numbering=\"true\"")))
- (item
- (setq step 'plain-list) ; Flip-flop
- (cond
- ((not parent-list)
- (if (funcall --element-preceded-by-table-p table info)
- '("</text:list-header>" . "<text:list-header>")
- '("</text:list-item>" . "<text:list-header>")))
- ((let ((section? (org-export-get-previous-element
- parent-list info)))
- (and section?
- (eq (org-element-type section?) 'section)
- (assq 'table (org-element-contents section?))))
- '("</text:list-header>" . "<text:list-header>"))
- (t
- '("</text:list-item>" . "<text:list-item>")))))))))))
+ (lambda (table info)
+ (let* ((genealogy (org-element-lineage table))
+ (list-genealogy
+ (when (eq (org-element-type (car genealogy)) 'item)
+ (cl-loop for el in genealogy
+ when (memq (org-element-type el)
+ '(item plain-list))
+ collect el)))
+ (llh-genealogy
+ (apply #'nconc
+ (cl-loop
+ for el in genealogy
+ when (and (eq (org-element-type el) 'headline)
+ (org-export-low-level-p el info))
+ collect
+ (list el
+ (assq 'headline
+ (org-element-contents
+ (org-export-get-parent el)))))))
+ parent-list)
+ (nconc
+ ;; Handle list genealogy.
+ (cl-loop
+ for el in list-genealogy collect
+ (cl-case (org-element-type el)
+ (plain-list
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (cl-case (org-element-property :type el)
+ (ordered "OrgNumberedList")
+ (unordered "OrgBulletedList")
+ (descriptive-1 "OrgDescriptionList")
+ (descriptive-2 "OrgDescriptionList"))
+ "text:continue-numbering=\"true\"")))
+ (item
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((funcall --element-preceded-by-table-p
+ parent-list info)
+ '("</text:list-header>" . "<text:list-header>"))
+ (t '("</text:list-item>" . "<text:list-item>"))))))
+ ;; Handle low-level headlines.
+ (cl-loop for el in llh-genealogy
+ with step = 'item collect
+ (cl-case step
+ (plain-list
+ (setq step 'item) ; Flip-flop
+ (setq parent-list el)
+ (cons "</text:list>"
+ (format "\n<text:list text:style-name=\"%s\" %s>"
+ (if (org-export-numbered-headline-p
+ el info)
+ "OrgNumberedList"
+ "OrgBulletedList")
+ "text:continue-numbering=\"true\"")))
+ (item
+ (setq step 'plain-list) ; Flip-flop
+ (cond
+ ((not parent-list)
+ (if (funcall --element-preceded-by-table-p table info)
+ '("</text:list-header>" . "<text:list-header>")
+ '("</text:list-item>" . "<text:list-header>")))
+ ((let ((section? (org-export-get-previous-element
+ parent-list info)))
+ (and section?
+ (eq (org-element-type section?) 'section)
+ (assq 'table (org-element-contents section?))))
+ '("</text:list-header>" . "<text:list-header>"))
+ (t
+ '("</text:list-item>" . "<text:list-item>"))))))))))
(close-open-tags (funcall --walk-list-genealogy-and-collect-tags
table info)))
;; OpenDocument schema does not permit table to occur within a
@@ -3613,7 +3565,7 @@ pertaining to indentation here."
;;
;; - Description lists are simulated as plain lists.
;; - Low-level headlines can be listified.
- ;; - In Org-mode, a table can occur not only as a regular list
+ ;; - In Org mode, a table can occur not only as a regular list
;; item, but also within description lists and low-level
;; headlines.
@@ -3635,26 +3587,24 @@ pertaining to indentation here."
;;;; Target
-(defun org-odt-target (target contents info)
+(defun org-odt-target (target _contents info)
"Transcode a TARGET object from Org to ODT.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (let ((value (org-element-property :value target)))
- (org-odt--target "" (org-export-solidify-link-text value))))
+ (org-odt--target "" (org-export-get-reference target info)))
;;;; Timestamp
-(defun org-odt-timestamp (timestamp contents info)
+(defun org-odt-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (let* ((raw-value (org-element-property :raw-value timestamp))
- (type (org-element-property :type timestamp)))
- (if (not org-odt-use-date-fields)
+ (let ((type (org-element-property :type timestamp)))
+ (if (not (plist-get info :odt-use-date-fields))
(let ((value (org-odt-plain-text
(org-timestamp-translate timestamp) info)))
- (case (org-element-property :type timestamp)
+ (cl-case (org-element-property :type timestamp)
((active active-range)
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgActiveTimestamp" value))
@@ -3662,7 +3612,7 @@ channel."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgInactiveTimestamp" value))
(otherwise value)))
- (case type
+ (cl-case type
(active
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgActiveTimestamp"
@@ -3687,12 +3637,12 @@ channel."
(format "<text:span text:style-name=\"%s\">%s</text:span>"
"OrgDiaryTimestamp"
(org-odt-plain-text (org-timestamp-translate timestamp)
- info)))))))
+ info)))))))
;;;; Underline
-(defun org-odt-underline (underline contents info)
+(defun org-odt-underline (_underline contents _info)
"Transcode UNDERLINE from Org to ODT.
CONTENTS is the text with underline markup. INFO is a plist
holding contextual information."
@@ -3702,7 +3652,7 @@ holding contextual information."
;;;; Verbatim
-(defun org-odt-verbatim (verbatim contents info)
+(defun org-odt-verbatim (verbatim _contents _info)
"Transcode a VERBATIM object from Org to ODT.
CONTENTS is nil. INFO is a plist used as a communication
channel."
@@ -3713,33 +3663,36 @@ channel."
;;;; Verse Block
-(defun org-odt-verse-block (verse-block contents info)
+(defun org-odt-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to ODT.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
- ;; Add line breaks to each line of verse.
- (setq contents (replace-regexp-in-string
- "\\(<text:line-break/>\\)?[ \t]*\n"
- "<text:line-break/>" contents))
- ;; Replace tabs and spaces.
- (setq contents (org-odt--encode-tabs-and-spaces contents))
- ;; Surround it in a verse environment.
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "OrgVerse" contents))
+ (format "\n<text:p text:style-name=\"OrgVerse\">%s</text:p>"
+ (replace-regexp-in-string
+ ;; Replace leading tabs and spaces.
+ "^[ \t]+" #'org-odt--encode-tabs-and-spaces
+ ;; Add line breaks to each line of verse.
+ (replace-regexp-in-string
+ "\\(<text:line-break/>\\)?[ \t]*$" "<text:line-break/>" contents))))
;;; Filters
+;;; Images
+
+(defun org-odt--translate-image-links (data _backend info)
+ (org-export-insert-image-links data info org-odt-inline-image-rules))
+
;;;; LaTeX fragments
-(defun org-odt--translate-latex-fragments (tree backend info)
+(defun org-odt--translate-latex-fragments (tree _backend info)
(let ((processing-type (plist-get info :with-latex))
(count 0))
;; Normalize processing-type to one of dvipng, mathml or verbatim.
;; If the desired converter is not available, force verbatim
;; processing.
- (case processing-type
+ (cl-case processing-type
((t mathml)
(if (and (fboundp 'org-format-latex-mathml-available-p)
(org-format-latex-mathml-available-p))
@@ -3765,70 +3718,74 @@ contextual information."
(when (memq processing-type '(mathml dvipng imagemagick))
(org-element-map tree '(latex-fragment latex-environment)
(lambda (latex-*)
- (incf count)
+ (cl-incf count)
(let* ((latex-frag (org-element-property :value latex-*))
(input-file (plist-get info :input-file))
(cache-dir (file-name-directory input-file))
(cache-subdir (concat
- (case processing-type
+ (cl-case processing-type
((dvipng imagemagick) "ltxpng/")
(mathml "ltxmathml/"))
(file-name-sans-extension
(file-name-nondirectory input-file))))
(display-msg
- (case processing-type
- ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count))
+ (cl-case processing-type
+ ((dvipng imagemagick)
+ (format "Creating LaTeX Image %d..." count))
(mathml (format "Creating MathML snippet %d..." count))))
;; Get an Org-style link to PNG image or the MathML
;; file.
- (org-link
- (let ((link (with-temp-buffer
- (insert latex-frag)
- (org-format-latex cache-subdir cache-dir
- nil display-msg
- nil nil processing-type)
- (buffer-substring-no-properties
- (point-min) (point-max)))))
- (if (not (string-match "file:\\([^]]*\\)" link))
- (prog1 nil (message "LaTeX Conversion failed."))
- link))))
- (when org-link
- ;; Conversion succeeded. Parse above Org-style link to a
- ;; `link' object.
- (let* ((link (car (org-element-map (with-temp-buffer
- (org-mode)
- (insert org-link)
- (org-element-parse-buffer))
- 'link 'identity))))
- ;; Orphan the link.
- (org-element-put-property link :parent nil)
- (let* (
- (replacement
- (case (org-element-type latex-*)
- ;; Case 1: LaTeX environment.
- ;; Mimic a "standalone image or formula" by
- ;; enclosing the `link' in a `paragraph'.
- ;; Copy over original attributes, captions to
- ;; the enclosing paragraph.
- (latex-environment
- (org-element-adopt-elements
- (list 'paragraph
- (list :style "OrgFormula"
- :name (org-element-property :name
- latex-*)
- :caption (org-element-property :caption
- latex-*)))
- link))
- ;; Case 2: LaTeX fragment.
- ;; No special action.
- (latex-fragment link))))
- ;; Note down the object that link replaces.
- (org-element-put-property replacement :replaces
- (list (org-element-type latex-*)
- (list :value latex-frag)))
- ;; Replace now.
- (org-element-set-element latex-* replacement))))))
- info)))
+ (link
+ (with-temp-buffer
+ (insert latex-frag)
+ ;; When converting to a PNG image, make sure to
+ ;; copy all LaTeX header specifications from the
+ ;; Org source.
+ (unless (eq processing-type 'mathml)
+ (let ((h (plist-get info :latex-header)))
+ (when h
+ (insert "\n"
+ (replace-regexp-in-string
+ "^" "#+LATEX_HEADER: " h)))))
+ (org-format-latex cache-subdir nil nil cache-dir
+ nil display-msg nil
+ processing-type)
+ (goto-char (point-min))
+ (skip-chars-forward " \t\n")
+ (org-element-link-parser))))
+ (if (not (eq 'link (org-element-type link)))
+ (message "LaTeX Conversion failed.")
+ ;; Conversion succeeded. Parse above Org-style link to
+ ;; a `link' object.
+ (let ((replacement
+ (cl-case (org-element-type latex-*)
+ ;;LaTeX environment. Mimic a "standalone image
+ ;; or formula" by enclosing the `link' in
+ ;; a `paragraph'. Copy over original
+ ;; attributes, captions to the enclosing
+ ;; paragraph.
+ (latex-environment
+ (org-element-adopt-elements
+ (list 'paragraph
+ (list :style "OrgFormula"
+ :name
+ (org-element-property :name latex-*)
+ :caption
+ (org-element-property :caption latex-*)))
+ link))
+ ;; LaTeX fragment. No special action.
+ (latex-fragment link))))
+ ;; Note down the object that link replaces.
+ (org-element-put-property replacement :replaces
+ (list (org-element-type latex-*)
+ (list :value latex-frag)))
+ ;; Restore blank after initial element or object.
+ (org-element-put-property
+ replacement :post-blank
+ (org-element-property :post-blank latex-*))
+ ;; Replace now.
+ (org-element-set-element latex-* replacement)))))
+ info nil nil t)))
tree)
@@ -3837,7 +3794,7 @@ contextual information."
;; This translator is necessary to handle indented tables in a uniform
;; manner. See comment in `org-odt--table'.
-(defun org-odt--translate-description-lists (tree backend info)
+(defun org-odt--translate-description-lists (tree _backend info)
;; OpenDocument has no notion of a description list. So simulate it
;; using plain lists. Description lists in the exported document
;; are typeset in the same manner as they are in a typical HTML
@@ -3870,7 +3827,7 @@ contextual information."
;;
(org-element-map tree 'plain-list
(lambda (el)
- (when (equal (org-element-property :type el) 'descriptive)
+ (when (eq (org-element-property :type el) 'descriptive)
(org-element-set-element
el
(apply 'org-element-adopt-elements
@@ -3929,11 +3886,11 @@ contextual information."
;; themselves and the list can be arbitrarily deep.
;;
;; Inspired by following thread:
-;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html
+;; https://lists.gnu.org/r/emacs-orgmode/2011-03/msg01101.html
;; Translate lists to tables
-(defun org-odt--translate-list-tables (tree backend info)
+(defun org-odt--translate-list-tables (tree _backend info)
(org-element-map tree 'plain-list
(lambda (l1-list)
(when (org-export-read-attribute :attr_odt l1-list :list-table)
@@ -3994,42 +3951,38 @@ contextual information."
(insert
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n")
- (mapc
- (lambda (file-entry)
- (let* ((version (nth 2 file-entry))
- (extra (if (not version) ""
- (format " manifest:version=\"%s\"" version))))
- (insert
- (format org-odt-manifest-file-entry-tag
- (nth 0 file-entry) (nth 1 file-entry) extra))))
- org-odt-manifest-file-entries)
+ (dolist (file-entry org-odt-manifest-file-entries)
+ (let* ((version (nth 2 file-entry))
+ (extra (if (not version) ""
+ (format " manifest:version=\"%s\"" version))))
+ (insert
+ (format org-odt-manifest-file-entry-tag
+ (nth 0 file-entry) (nth 1 file-entry) extra))))
(insert "\n</manifest:manifest>"))))
(defmacro org-odt--export-wrap (out-file &rest body)
`(let* ((--out-file ,out-file)
(out-file-type (file-name-extension --out-file))
(org-odt-xml-files '("META-INF/manifest.xml" "content.xml"
- "meta.xml" "styles.xml"))
+ "meta.xml" "styles.xml"))
;; Initialize temporary workarea. All files that end up in
;; the exported document get parked/created here.
(org-odt-zip-dir (file-name-as-directory
- (make-temp-file (format "%s-" out-file-type) t)))
+ (make-temp-file (format "%s-" out-file-type) t)))
(org-odt-manifest-file-entries nil)
(--cleanup-xml-buffers
- (function
- (lambda nil
- ;; Kill all XML buffers.
- (mapc (lambda (file)
- (let ((buf (find-buffer-visiting
- (concat org-odt-zip-dir file))))
- (when buf
- (with-current-buffer buf
- (set-buffer-modified-p nil)
- (kill-buffer buf)))))
- org-odt-xml-files)
- ;; Delete temporary directory and also other embedded
- ;; files that get copied there.
- (delete-directory org-odt-zip-dir t)))))
+ (lambda ()
+ ;; Kill all XML buffers.
+ (dolist (file org-odt-xml-files)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ (set-buffer-modified-p nil)
+ (kill-buffer buf)))))
+ ;; Delete temporary directory and also other embedded
+ ;; files that get copied there.
+ (delete-directory org-odt-zip-dir t))))
(condition-case err
(progn
(unless (executable-find "zip")
@@ -4052,16 +4005,15 @@ contextual information."
;; Write out the manifest entries before zipping
(org-odt-write-manifest-file)
;; Save all XML files.
- (mapc (lambda (file)
- (let ((buf (find-buffer-visiting
- (concat org-odt-zip-dir file))))
- (when buf
- (with-current-buffer buf
- ;; Prettify output if needed.
- (when org-odt-prettify-xml
- (indent-region (point-min) (point-max)))
- (save-buffer 0)))))
- org-odt-xml-files)
+ (dolist (file org-odt-xml-files)
+ (let ((buf (find-buffer-visiting
+ (concat org-odt-zip-dir file))))
+ (when buf
+ (with-current-buffer buf
+ ;; Prettify output if needed.
+ (when org-odt-prettify-xml
+ (indent-region (point-min) (point-max)))
+ (save-buffer 0)))))
;; Run zip.
(let* ((target --out-file)
(target-name (file-name-nondirectory target))
@@ -4079,19 +4031,17 @@ contextual information."
;; directory.
(with-current-buffer
(find-file-noselect (concat org-odt-zip-dir "content.xml") t)
- (mapc
- (lambda (cmd)
- (message "Running %s" (mapconcat 'identity cmd " "))
- (setq err-string
- (with-output-to-string
- (setq exitcode
- (apply 'call-process (car cmd)
- nil standard-output nil (cdr cmd)))))
- (or (zerop exitcode)
- (error (concat "Unable to create OpenDocument file."
- " Zip failed with error (%s)")
- err-string)))
- cmds)))
+ (dolist (cmd cmds)
+ (message "Running %s" (mapconcat 'identity cmd " "))
+ (setq err-string
+ (with-output-to-string
+ (setq exitcode
+ (apply 'call-process (car cmd)
+ nil standard-output nil (cdr cmd)))))
+ (or (zerop exitcode)
+ (error (concat "Unable to create OpenDocument file."
+ " Zip failed with error (%s)")
+ err-string)))))
;; Move the zip file from temporary work directory to
;; user-mandated location.
(rename-file (concat org-odt-zip-dir target-name) target)
@@ -4135,9 +4085,9 @@ MathML source to kill ring depending on the value of
(setq frag (and (setq frag (and (region-active-p)
(buffer-substring (region-beginning)
(region-end))))
- (loop for e in org-latex-regexps
- thereis (when (string-match (nth 1 e) frag)
- (match-string (nth 2 e) frag)))))
+ (cl-loop for e in org-latex-regexps
+ thereis (when (string-match (nth 1 e) frag)
+ (match-string (nth 2 e) frag)))))
(read-string "LaTeX Fragment: " frag nil frag))
,(let ((odf-filename (expand-file-name
(concat
@@ -4265,12 +4215,12 @@ Return output file's name."
(when out-fmt-spec
(throw 'done (cons (car e) out-fmt-spec))))))))
-(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg)
+(defun org-odt-do-convert (in-file out-fmt &optional open)
"Workhorse routine for `org-odt-convert'."
(require 'browse-url)
- (let* ((in-file (expand-file-name (or in-file buffer-file-name)))
- (dummy (or (file-readable-p in-file)
- (error "Cannot read %s" in-file)))
+ (let* ((in-file (let ((f (expand-file-name (or in-file buffer-file-name))))
+ (if (file-readable-p f) f
+ (error "Cannot read %s" in-file))))
(in-fmt (file-name-extension in-file))
(out-fmt (or out-fmt (error "Output format unspecified")))
(how (or (org-odt-reachable-p in-fmt out-fmt)
@@ -4300,7 +4250,7 @@ Return output file's name."
(cond
((file-exists-p out-file)
(message "Exported to %s" out-file)
- (when prefix-arg
+ (when open
(message "Opening %s..." out-file)
(org-open-file out-file 'system))
out-file)
@@ -4333,12 +4283,10 @@ form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See
(defun org-odt-reachable-formats (in-fmt)
"Return list of formats to which IN-FMT can be converted.
The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)."
- (let (l)
- (mapc (lambda (e) (add-to-list 'l e))
- (apply 'append (mapcar
- (lambda (e) (mapcar 'car (cdr e)))
- (org-odt-do-reachable-formats in-fmt))))
- l))
+ (copy-sequence
+ (apply #'append (mapcar
+ (lambda (e) (mapcar #'car (cdr e)))
+ (org-odt-do-reachable-formats in-fmt)))))
(defun org-odt-convert-read-params ()
"Return IN-FILE and OUT-FMT params for `org-odt-do-convert'.
@@ -4358,25 +4306,23 @@ This is a helper routine for interactive use."
(list in-file out-fmt)))
;;;###autoload
-(defun org-odt-convert (&optional in-file out-fmt prefix-arg)
+(defun org-odt-convert (&optional in-file out-fmt open)
"Convert IN-FILE to format OUT-FMT using a command line converter.
IN-FILE is the file to be converted. If unspecified, it defaults
to variable `buffer-file-name'. OUT-FMT is the desired output
-format. Use `org-odt-convert-process' as the converter.
-If PREFIX-ARG is non-nil then the newly converted file is opened
-using `org-open-file'."
+format. Use `org-odt-convert-process' as the converter. If OPEN
+is non-nil then the newly converted file is opened using
+`org-open-file'."
(interactive
(append (org-odt-convert-read-params) current-prefix-arg))
- (org-odt-do-convert in-file out-fmt prefix-arg))
+ (org-odt-do-convert in-file out-fmt open))
;;; Library Initializations
-(mapc
- (lambda (desc)
- ;; Let Emacs open all OpenDocument files in archive mode
- (add-to-list 'auto-mode-alist
- (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
- org-odt-file-extensions)
+(dolist (desc org-odt-file-extensions)
+ ;; Let Emacs open all OpenDocument files in archive mode.
+ (add-to-list 'auto-mode-alist
+ (cons (concat "\\." (car desc) "\\'") 'archive-mode)))
(provide 'ox-odt)
diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el
index 312221dc822..7db3a66ee8f 100644
--- a/lisp/org/ox-org.el
+++ b/lisp/org/ox-org.el
@@ -1,4 +1,4 @@
-;;; ox-org.el --- Org Back-End for Org Export Engine
+;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -26,6 +26,7 @@
(require 'ox)
(declare-function htmlize-buffer "ext:htmlize" (&optional buffer))
+(defvar htmlize-output-type)
(defgroup org-export-org nil
"Options for exporting Org mode files to Org."
@@ -34,8 +35,6 @@
:version "24.4"
:package-version '(Org . "8.0"))
-(define-obsolete-variable-alias
- 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4")
(defcustom org-org-htmlized-css-url nil
"URL pointing to the CSS defining colors for htmlized Emacs buffers.
Normally when creating an htmlized version of an Org buffer,
@@ -45,7 +44,7 @@ look bad if different people with different fontification setup
work on the same website. When this variable is non-nil,
creating an htmlized version of an Org buffer using
`org-org-export-as-org' will include a link to this URL if the
-setting of `org-html-htmlize-output-type' is 'css."
+setting of `org-html-htmlize-output-type' is `css'."
:group 'org-export-org
:type '(choice
(const :tag "Don't include external stylesheet link" nil)
@@ -57,13 +56,12 @@ setting of `org-html-htmlize-output-type' is 'css."
(center-block . org-org-identity)
(clock . org-org-identity)
(code . org-org-identity)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(diary-sexp . org-org-identity)
(drawer . org-org-identity)
(dynamic-block . org-org-identity)
(entity . org-org-identity)
(example-block . org-org-identity)
+ (export-block . org-org-export-block)
(fixed-width . org-org-identity)
(footnote-definition . ignore)
(footnote-reference . org-org-identity)
@@ -78,14 +76,14 @@ setting of `org-html-htmlize-output-type' is 'css."
(latex-environment . org-org-identity)
(latex-fragment . org-org-identity)
(line-break . org-org-identity)
- (link . org-org-identity)
+ (link . org-org-link)
(node-property . org-org-identity)
+ (template . org-org-template)
(paragraph . org-org-identity)
(plain-list . org-org-identity)
(planning . org-org-identity)
(property-drawer . org-org-identity)
(quote-block . org-org-identity)
- (quote-section . org-org-identity)
(radio-target . org-org-identity)
(section . org-org-section)
(special-block . org-org-identity)
@@ -109,9 +107,35 @@ setting of `org-html-htmlize-output-type' is 'css."
(?v "As Org file and open"
(lambda (a s v b)
(if a (org-org-export-to-org t s v b)
- (org-open-file (org-org-export-to-org nil s v b))))))))
-
-(defun org-org-identity (blob contents info)
+ (org-open-file (org-org-export-to-org nil s v b)))))))
+ :filters-alist '((:filter-parse-tree . org-org--add-missing-sections)))
+
+(defun org-org--add-missing-sections (tree _backend _info)
+ "Ensure each headline has an associated section.
+
+TREE is the parse tree being exported.
+
+Footnotes relative to the headline are inserted in the section,
+using `org-org-section'. However, this function is not called if
+the headline doesn't contain any section in the first place, so
+we make sure it is always called."
+ (org-element-map tree 'headline
+ (lambda (h)
+ (let ((first-child (car (org-element-contents h)))
+ (new-section (org-element-create 'section)))
+ (pcase (org-element-type first-child)
+ (`section nil)
+ (`nil (org-element-adopt-elements h new-section))
+ (_ (org-element-insert-before new-section first-child))))))
+ tree)
+
+(defun org-org-export-block (export-block _contents _info)
+ "Transcode a EXPORT-BLOCK element from Org to LaTeX.
+CONTENTS and INFO are ignored."
+ (and (equal (org-element-property :type export-block) "ORG")
+ (org-element-property :value export-block)))
+
+(defun org-org-identity (blob contents _info)
"Transcode BLOB element or object back into Org syntax.
CONTENTS is its contents, as a string or nil. INFO is ignored."
(let ((case-fold-search t))
@@ -133,17 +157,54 @@ CONTENTS is its contents, as a string or nil. INFO is ignored."
(org-export-get-relative-level headline info))
(org-element-headline-interpreter headline contents)))
-(defun org-org-keyword (keyword contents info)
+(defun org-org-keyword (keyword _contents _info)
"Transcode KEYWORD element back into Org syntax.
-CONTENTS is nil. INFO is ignored. This function ignores
-keywords targeted at other export back-ends."
- (unless (member (org-element-property :key keyword)
- (mapcar
- (lambda (block-cons)
- (and (eq (cdr block-cons) 'org-element-export-block-parser)
- (car block-cons)))
- org-element-block-name-alist))
- (org-element-keyword-interpreter keyword nil)))
+CONTENTS is nil. INFO is ignored."
+ (let ((key (org-element-property :key keyword)))
+ (unless (member key
+ '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
+ (org-element-keyword-interpreter keyword nil))))
+
+(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)
+ (org-element-link-interpreter link contents)))
+
+(defun org-org-template (contents info)
+ "Return Org document template with document keywords.
+CONTENTS is the transcoded contents string. INFO is a plist used
+as a communication channel."
+ (concat
+ (and (plist-get info :time-stamp-file)
+ (format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
+ (org-element-normalize-string
+ (mapconcat #'identity
+ (org-element-map (plist-get info :parse-tree) 'keyword
+ (lambda (k)
+ (and (string-equal (org-element-property :key k) "OPTIONS")
+ (concat "#+OPTIONS: "
+ (org-element-property :value k)))))
+ "\n"))
+ (and (plist-get info :with-title)
+ (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)))
+ (and (plist-get info :with-date)
+ (let ((date (org-export-data (org-export-get-date info) info)))
+ (and (org-string-nw-p date)
+ (format "#+DATE: %s\n" date))))
+ (and (plist-get info :with-author)
+ (let ((author (org-export-data (plist-get info :author) info)))
+ (and (org-string-nw-p author)
+ (format "#+AUTHOR: %s\n" author))))
+ (and (plist-get info :with-email)
+ (let ((email (org-export-data (plist-get info :email) info)))
+ (and (org-string-nw-p email)
+ (format "#+EMAIL: %s\n" email))))
+ (and (plist-get info :with-creator)
+ (org-string-nw-p (plist-get info :creator))
+ (format "#+CREATOR: %s\n" (plist-get info :creator)))
+ contents))
(defun org-org-section (section contents info)
"Transcode SECTION element back into Org syntax.
@@ -152,28 +213,28 @@ a communication channel."
(concat
(org-element-normalize-string contents)
;; Insert footnote definitions appearing for the first time in this
- ;; section. Indeed, some of them may not be available to narrowing
- ;; so we make sure all of them are included in the result.
- (let ((footnotes-alist
- (org-element-map section 'footnote-reference
+ ;; section, or in the relative headline title. Indeed, some of
+ ;; them may not be available to narrowing so we make sure all of
+ ;; them are included in the result.
+ (let ((footnotes
+ (org-element-map
+ (list (org-export-get-parent-headline section) section)
+ 'footnote-reference
(lambda (fn)
(and (eq (org-element-property :type fn) 'standard)
(org-export-footnote-first-reference-p fn info)
- (cons (org-element-property :label fn)
- (org-export-get-footnote-definition fn info))))
- info)))
- (and footnotes-alist
- (concat "\n"
- (mapconcat
- (lambda (d)
- (org-element-normalize-string
- (concat (format "[%s] "(car d))
- (org-export-data (cdr d) info))))
- footnotes-alist "\n"))))
- (make-string (or (org-element-property :post-blank section) 0) ?\n)))
+ (org-element-normalize-string
+ (format "[fn:%s] %s"
+ (org-element-property :label fn)
+ (org-export-data
+ (org-export-get-footnote-definition fn info)
+ info)))))
+ info nil 'headline t)))
+ (and footnotes (concat "\n" (mapconcat #'identity footnotes "\n"))))))
;;;###autoload
-(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist)
+(defun org-org-export-as-org
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an Org buffer.
If narrowing is active in the current buffer, only export its
@@ -192,6 +253,9 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
+When optional argument BODY-ONLY is non-nil, strip document
+keywords from output.
+
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
@@ -201,10 +265,11 @@ be displayed when `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
(org-export-to-buffer 'org "*Org ORG Export*"
- async subtreep visible-only nil ext-plist (lambda () (org-mode))))
+ async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
;;;###autoload
-(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist)
+(defun org-org-export-to-org
+ (&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to an org file.
If narrowing is active in the current buffer, only export its
@@ -223,6 +288,9 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
+When optional argument BODY-ONLY is non-nil, strip document
+keywords from output.
+
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
@@ -231,7 +299,7 @@ Return output file name."
(interactive)
(let ((outfile (org-export-output-file-name ".org" subtreep)))
(org-export-to-file 'org outfile
- async subtreep visible-only nil ext-plist)))
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-org-publish-to-org (plist filename pub-dir)
@@ -244,7 +312,8 @@ publishing directory.
Return output file name."
(org-publish-org-to 'org filename ".org" plist pub-dir)
(when (plist-get plist :htmlized-source)
- (require 'htmlize)
+ (or (require 'htmlize nil t)
+ (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
(require 'ox-html)
(let* ((org-inhibit-startup t)
(htmlize-output-type 'css)
@@ -255,7 +324,7 @@ Return output file name."
newbuf)
(with-current-buffer work-buffer
(org-font-lock-ensure)
- (show-all)
+ (outline-show-all)
(org-show-block-all)
(setq newbuf (htmlize-buffer)))
(with-current-buffer newbuf
diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el
index 4ebc073990e..c2416dba381 100644
--- a/lisp/org/ox-publish.el
+++ b/lisp/org/ox-publish.el
@@ -1,4 +1,4 @@
-;;; ox-publish.el --- Publish Related Org Mode Files as a Website
+;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*-
;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
;; Author: David O'Toole <dto@gnu.org>
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -38,7 +38,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'format-spec)
(require 'ox)
@@ -46,24 +46,28 @@
;;; Variables
-(defvar org-publish-temp-files nil
- "Temporary list of files to be published.")
-
;; Here, so you find the variable right before it's used the first time:
(defvar org-publish-cache nil
"This will cache timestamps and titles for files in publishing projects.
Blocks could hash sha1 values here.")
+(defvar org-publish-after-publishing-hook nil
+ "Hook run each time a file is published.
+Every function in this hook will be called with two arguments:
+the name of the original file and the name of the file
+produced.")
+
(defgroup org-publish nil
- "Options for publishing a set of Org-mode and related files."
+ "Options for publishing a set of files."
:tag "Org Publishing"
:group 'org)
(defcustom org-publish-project-alist nil
"Association list to control publishing behavior.
-Each element of the alist is a publishing “project”. The CAR of
+\\<org-mode-map>
+Each element of the alist is a publishing project. The car of
each element is a string, uniquely identifying the project. The
-CDR of each element is in one of the following forms:
+cdr of each element is in one of the following forms:
1. A well-formed property list with an even number of elements,
alternating keys and values, specifying parameters for the
@@ -80,7 +84,7 @@ When the CDR of an element of org-publish-project-alist is in
this second form, the elements of the list after `:components'
are taken to be components of the project, which group together
files requiring different publishing options. When you publish
-such a project with \\[org-publish], the components all publish.
+such a project with `\\[org-publish]', the components all publish.
When a property is given a value in `org-publish-project-alist',
its setting overrides the value of the corresponding user
@@ -97,13 +101,17 @@ Most properties are optional, but some should always be set:
Extension (without the dot!) of source files. This can be
a regular expression. If not given, \"org\" will be used as
- default extension.
+ default extension. If it is `any', include all the files,
+ even without extension.
`:publishing-directory'
Directory (possibly remote) where output files will be
published.
+If `:recursive' is non-nil files in sub-directories of
+`:base-directory' are considered.
+
The `:exclude' property may be used to prevent certain files from
being published. Its value may be a string or regexp matching
file names you don't want to be published.
@@ -135,12 +143,16 @@ date.
`:preparation-function'
Function to be called before publishing this project. This
- may also be a list of functions.
+ may also be a list of functions. Preparation functions are
+ called with the project properties list as their sole
+ argument.
`:completion-function'
Function to be called after publishing this project. This
- may also be a list of functions.
+ may also be a list of functions. Completion functions are
+ called with the project properties list as their sole
+ argument.
Some properties control details of the Org publishing process,
and are equivalent to the corresponding user variables listed in
@@ -169,7 +181,9 @@ included. See the back-end documentation for more information.
:with-footnotes `org-export-with-footnotes'
:with-inlinetasks `org-export-with-inlinetasks'
:with-latex `org-export-with-latex'
+ :with-planning `org-export-with-planning'
:with-priority `org-export-with-priority'
+ :with-properties `org-export-with-properties'
:with-smart-quotes `org-export-with-smart-quotes'
:with-special-strings `org-export-with-special-strings'
:with-statistics-cookies' `org-export-with-statistics-cookies'
@@ -179,7 +193,7 @@ included. See the back-end documentation for more information.
:with-tags `org-export-with-tags'
:with-tasks `org-export-with-tasks'
:with-timestamps `org-export-with-timestamps'
- :with-planning `org-export-with-planning'
+ :with-title `org-export-with-title'
:with-todo-keywords `org-export-with-todo-keywords'
The following properties may be used to control publishing of
@@ -192,18 +206,12 @@ a site-map of files or summary page for a given project.
`:sitemap-filename'
- Filename for output of sitemap. Defaults to \"sitemap.org\".
+ Filename for output of site-map. Defaults to \"sitemap.org\".
`:sitemap-title'
Title of site-map page. Defaults to name of file.
- `:sitemap-function'
-
- Plugin function to use for generation of site-map. Defaults
- to `org-publish-org-sitemap', which generates a plain list of
- links to all files in the project.
-
`:sitemap-style'
Can be `list' (site-map is just an itemized list of the
@@ -211,19 +219,42 @@ a site-map of files or summary page for a given project.
structure of the source files is reflected in the site-map).
Defaults to `tree'.
- `:sitemap-sans-extension'
+ `:sitemap-format-entry'
+
+ Plugin function used to format entries in the site-map. It
+ is called with three arguments: the file or directory name
+ relative to base directory, the site map style and the
+ current project. It has to return a string.
- Remove extension from site-map's file-names. Useful to have
- cool URIs (see http://www.w3.org/Provider/Style/URI).
- Defaults to nil.
+ Defaults to `org-publish-sitemap-default-entry', which turns
+ file names into links and use document titles as
+ descriptions. For specific formatting needs, one can use
+ `org-publish-find-date', `org-publish-find-title' and
+ `org-publish-find-property', to retrieve additional
+ information about published documents.
+
+ `:sitemap-function'
+
+ Plugin function to use for generation of site-map. It is
+ called with two arguments: the title of the site-map, as
+ a string, and a representation of the files involved in the
+ project, as returned by `org-list-to-lisp'. The latter can
+ further be transformed using `org-list-to-generic',
+ `org-list-to-subtree' and alike. It has to return a string.
+
+ Defaults to `org-publish-sitemap-default', which generates
+ a plain list of links to all files in the project.
If you create a site-map file, adjust the sorting like this:
`:sitemap-sort-folders'
Where folders should appear in the site-map. Set this to
- `first' (default) or `last' to display folders first or last,
- respectively. Any other value will mix files and folders.
+ `first' or `last' to display folders first or last,
+ respectively. When set to `ignore' (default), folders are
+ ignored altogether. Any other value will mix files and
+ folders. This variable has no effect when site-map style is
+ `tree'.
`:sitemap-sort-files'
@@ -285,17 +316,28 @@ You can overwrite this default per project in your
:group 'org-export-publish
:type 'symbol)
-(defcustom org-publish-sitemap-sort-folders 'first
- "A symbol, denoting if folders are sorted first in sitemaps.
-Possible values are `first', `last', and nil.
+(defcustom org-publish-sitemap-sort-folders 'ignore
+ "A symbol, denoting if folders are sorted first in site-maps.
+
+Possible values are `first', `last', `ignore' and nil.
If `first', folders will be sorted before files.
If `last', folders are sorted to the end after the files.
-Any other value will not mix files and folders.
+If `ignore', folders do not appear in the site-map.
+Any other value will mix files and folders.
You can overwrite this default per project in your
-`org-publish-project-alist', using `:sitemap-sort-folders'."
+`org-publish-project-alist', using `:sitemap-sort-folders'.
+
+This variable is ignored when site-map style is `tree'."
:group 'org-export-publish
- :type 'symbol)
+ :type '(choice
+ (const :tag "Folders before files" first)
+ (const :tag "Folders after files" last)
+ (const :tag "No folder in site-map" ignore)
+ (const :tag "Mix folders and files" nil))
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe #'symbolp)
(defcustom org-publish-sitemap-sort-ignore-case nil
"Non-nil when site-map sorting should ignore case.
@@ -305,25 +347,8 @@ You can overwrite this default per project in your
:group 'org-export-publish
:type 'boolean)
-(defcustom org-publish-sitemap-date-format "%Y-%m-%d"
- "Format for printing a date in the sitemap.
-See `format-time-string' for allowed formatters."
- :group 'org-export-publish
- :type 'string)
-
-(defcustom org-publish-sitemap-file-entry-format "%t"
- "Format string for site-map file entry.
-You could use brackets to delimit on what part the link will be.
-
-%t is the title.
-%a is the author.
-%d is the date formatted using `org-publish-sitemap-date-format'."
- :group 'org-export-publish
- :type 'string)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Timestamp-related functions
(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
@@ -333,7 +358,7 @@ You could use brackets to delimit on what part the link will be.
(concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
(defun org-publish-needed-p
- (filename &optional pub-dir pub-func true-pub-dir base-dir)
+ (filename &optional pub-dir pub-func _true-pub-dir base-dir)
"Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
TRUE-PUB-DIR is where the file will truly end up. Currently we
are not using this - maybe it can eventually be used to check if
@@ -346,11 +371,11 @@ still decide about that independently."
filename pub-dir pub-func base-dir))))
(if rtn (message "Publishing file %s using `%s'" filename pub-func)
(when org-publish-list-skipped-files
- (message "Skipping unmodified file %s" filename)))
+ (message "Skipping unmodified file %s" filename)))
rtn))
(defun org-publish-update-timestamp
- (filename &optional pub-dir pub-func base-dir)
+ (filename &optional pub-dir pub-func _base-dir)
"Update publishing timestamp for file FILENAME.
If there is no timestamp, create one."
(let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
@@ -359,17 +384,33 @@ If there is no timestamp, create one."
(defun org-publish-remove-all-timestamps ()
"Remove all files in the timestamp directory."
- (let ((dir org-publish-timestamp-directory)
- files)
+ (let ((dir org-publish-timestamp-directory))
(when (and (file-exists-p dir) (file-directory-p dir))
- (mapc 'delete-file (directory-files dir 'full "[^.]\\'"))
+ (mapc #'delete-file (directory-files dir 'full "[^.]\\'"))
(org-publish-reset-cache))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Getting project information out of `org-publish-project-alist'
+(defun org-publish-property (property project &optional default)
+ "Return value PROPERTY, as a symbol, in PROJECT.
+DEFAULT is returned when PROPERTY is not actually set in PROJECT
+definition."
+ (let ((properties (cdr project)))
+ (if (plist-member properties property)
+ (plist-get properties property)
+ default)))
+
+(defun org-publish--expand-file-name (file project)
+ "Return full file name for FILE in PROJECT.
+When FILE is a relative file name, it is expanded according to
+project base directory. Always return the true name of the file,
+ignoring symlinks."
+ (file-truename
+ (if (file-name-absolute-p file) file
+ (expand-file-name file (org-publish-property :base-directory project)))))
+
(defun org-publish-expand-projects (projects-alist)
"Expand projects in PROJECTS-ALIST.
This splices all the components into the list."
@@ -377,178 +418,111 @@ This splices all the components into the list."
(while (setq p (pop rest))
(if (setq components (plist-get (cdr p) :components))
(setq rest (append
- (mapcar (lambda (x) (assoc x org-publish-project-alist))
- components)
+ (mapcar
+ (lambda (x)
+ (or (assoc x org-publish-project-alist)
+ (user-error "Unknown component %S in project %S"
+ x (car p))))
+ components)
rest))
(push p rtn)))
(nreverse (delete-dups (delq nil rtn)))))
-(defvar org-publish-sitemap-sort-files)
-(defvar org-publish-sitemap-sort-folders)
-(defvar org-publish-sitemap-ignore-case)
-(defvar org-publish-sitemap-requested)
-(defvar org-publish-sitemap-date-format)
-(defvar org-publish-sitemap-file-entry-format)
-(defun org-publish-compare-directory-files (a b)
- "Predicate for `sort', that sorts folders and files for sitemap."
- (let ((retval t))
- (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
- ;; First we sort files:
- (when org-publish-sitemap-sort-files
- (case org-publish-sitemap-sort-files
- (alphabetically
- (let* ((adir (file-directory-p a))
- (aorg (and (string-match "\\.org$" a) (not adir)))
- (bdir (file-directory-p b))
- (borg (and (string-match "\\.org$" b) (not bdir)))
- (A (if aorg (concat (file-name-directory a)
- (org-publish-find-title a)) a))
- (B (if borg (concat (file-name-directory b)
- (org-publish-find-title b)) b)))
- (setq retval (if org-publish-sitemap-ignore-case
- (not (string-lessp (upcase B) (upcase A)))
- (not (string-lessp B A))))))
- ((anti-chronologically chronologically)
- (let* ((adate (org-publish-find-date a))
- (bdate (org-publish-find-date b))
- (A (+ (lsh (car adate) 16) (cadr adate)))
- (B (+ (lsh (car bdate) 16) (cadr bdate))))
- (setq retval
- (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B)
- (>= A B)))))))
- ;; Directory-wise wins:
- (when org-publish-sitemap-sort-folders
- ;; a is directory, b not:
- (cond
- ((and (file-directory-p a) (not (file-directory-p b)))
- (setq retval (equal org-publish-sitemap-sort-folders 'first)))
- ;; a is not a directory, but b is:
- ((and (not (file-directory-p a)) (file-directory-p b))
- (setq retval (equal org-publish-sitemap-sort-folders 'last))))))
- retval))
-
-(defun org-publish-get-base-files-1
- (base-dir &optional recurse match skip-file skip-dir)
- "Set `org-publish-temp-files' with files from BASE-DIR directory.
-If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is
-non-nil, restrict this list to the files matching the regexp
-MATCH. If SKIP-FILE is non-nil, skip file matching the regexp
-SKIP-FILE. If SKIP-DIR is non-nil, don't check directories
-matching the regexp SKIP-DIR when recursing through BASE-DIR."
- (mapc (lambda (f)
- (let ((fd-p (file-directory-p f))
- (fnd (file-name-nondirectory f)))
- (if (and fd-p recurse
- (not (string-match "^\\.+$" fnd))
- (if skip-dir (not (string-match skip-dir fnd)) t))
- (org-publish-get-base-files-1
- f recurse match skip-file skip-dir)
- (unless (or fd-p ;; this is a directory
- (and skip-file (string-match skip-file fnd))
- (not (file-exists-p (file-truename f)))
- (not (string-match match fnd)))
-
- (pushnew f org-publish-temp-files)))))
- (let ((all-files (if (not recurse) (directory-files base-dir t match)
- ;; If RECURSE is non-nil, we want all files
- ;; matching MATCH and sub-directories.
- (org-remove-if-not
- (lambda (file)
- (or (file-directory-p file)
- (and match (string-match match file))))
- (directory-files base-dir t)))))
- (if (not org-publish-sitemap-requested) all-files
- (sort all-files 'org-publish-compare-directory-files)))))
-
-(defun org-publish-get-base-files (project &optional exclude-regexp)
- "Return a list of all files in PROJECT.
-If EXCLUDE-REGEXP is set, this will be used to filter out
-matching filenames."
- (let* ((project-plist (cdr project))
- (base-dir (file-name-as-directory
- (plist-get project-plist :base-directory)))
- (include-list (plist-get project-plist :include))
- (recurse (plist-get project-plist :recursive))
- (extension (or (plist-get project-plist :base-extension) "org"))
- ;; sitemap-... variables are dynamically scoped for
- ;; org-publish-compare-directory-files:
- (org-publish-sitemap-requested
- (plist-get project-plist :auto-sitemap))
- (sitemap-filename
- (or (plist-get project-plist :sitemap-filename) "sitemap.org"))
- (org-publish-sitemap-sort-folders
- (if (plist-member project-plist :sitemap-sort-folders)
- (plist-get project-plist :sitemap-sort-folders)
- org-publish-sitemap-sort-folders))
- (org-publish-sitemap-sort-files
- (cond ((plist-member project-plist :sitemap-sort-files)
- (plist-get project-plist :sitemap-sort-files))
- ;; For backward compatibility:
- ((plist-member project-plist :sitemap-alphabetically)
- (if (plist-get project-plist :sitemap-alphabetically)
- 'alphabetically nil))
- (t org-publish-sitemap-sort-files)))
- (org-publish-sitemap-ignore-case
- (if (plist-member project-plist :sitemap-ignore-case)
- (plist-get project-plist :sitemap-ignore-case)
- org-publish-sitemap-sort-ignore-case))
- (match (if (eq extension 'any) "^[^\\.]"
- (concat "^[^\\.].*\\.\\(" extension "\\)$"))))
- ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
- ;; value.
- (unless (memq org-publish-sitemap-sort-folders '(first last))
- (setq org-publish-sitemap-sort-folders nil))
-
- (setq org-publish-temp-files nil)
- (if org-publish-sitemap-requested
- (pushnew (expand-file-name (concat base-dir sitemap-filename))
- org-publish-temp-files))
- (org-publish-get-base-files-1 base-dir recurse match
- ;; FIXME distinguish exclude regexp
- ;; for skip-file and skip-dir?
- exclude-regexp exclude-regexp)
- (mapc (lambda (f)
- (pushnew
- (expand-file-name (concat base-dir f))
- org-publish-temp-files))
- include-list)
- org-publish-temp-files))
+(defun org-publish-get-base-files (project)
+ "Return a list of all files in PROJECT."
+ (let* ((base-dir (file-name-as-directory
+ (org-publish-property :base-directory project)))
+ (extension (or (org-publish-property :base-extension project) "org"))
+ (match (if (eq extension 'any) ""
+ (format "^[^\\.].*\\.\\(%s\\)$" extension)))
+ (base-files
+ (cl-remove-if #'file-directory-p
+ (if (org-publish-property :recursive project)
+ (directory-files-recursively base-dir match)
+ (directory-files base-dir t match t)))))
+ (org-uniquify
+ (append
+ ;; Files from BASE-DIR. Apply exclusion filter before adding
+ ;; included files.
+ (let ((exclude-regexp (org-publish-property :exclude project)))
+ (if exclude-regexp
+ (cl-remove-if
+ (lambda (f)
+ ;; Match against relative names, yet BASE-DIR file
+ ;; names are absolute.
+ (string-match exclude-regexp
+ (file-relative-name f base-dir)))
+ base-files)
+ base-files))
+ ;; Sitemap file.
+ (and (org-publish-property :auto-sitemap project)
+ (list (expand-file-name
+ (or (org-publish-property :sitemap-filename project)
+ "sitemap.org")
+ base-dir)))
+ ;; Included files.
+ (mapcar (lambda (f) (expand-file-name f base-dir))
+ (org-publish-property :include project))))))
(defun org-publish-get-project-from-filename (filename &optional up)
- "Return the project that FILENAME belongs to."
- (let* ((filename (expand-file-name filename))
- project-name)
-
- (catch 'p-found
- (dolist (prj org-publish-project-alist)
- (unless (plist-get (cdr prj) :components)
- ;; [[info:org:Selecting%20files]] shows how this is supposed to work:
- (let* ((r (plist-get (cdr prj) :recursive))
- (b (expand-file-name (file-name-as-directory
- (plist-get (cdr prj) :base-directory))))
- (x (or (plist-get (cdr prj) :base-extension) "org"))
- (e (plist-get (cdr prj) :exclude))
- (i (plist-get (cdr prj) :include))
- (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$")))
- (when
- (or (and i
- (member filename
- (mapcar (lambda (file)
- (expand-file-name file b))
- i)))
- (and (not (and e (string-match e filename)))
- (string-match xm filename)))
- (setq project-name (car prj))
- (throw 'p-found project-name))))))
- (when up
- (dolist (prj org-publish-project-alist)
- (if (member project-name (plist-get (cdr prj) :components))
- (setq project-name (car prj)))))
- (assoc project-name org-publish-project-alist)))
+ "Return a project that FILENAME belongs to.
+When UP is non-nil, return a meta-project (i.e., with a :components part)
+publishing FILENAME."
+ (let* ((filename (file-truename filename))
+ (project
+ (cl-some
+ (lambda (p)
+ ;; Ignore meta-projects.
+ (unless (org-publish-property :components p)
+ (let ((base (file-truename
+ (org-publish-property :base-directory p))))
+ (cond
+ ;; Check if FILENAME is explicitly included in one
+ ;; project.
+ ((cl-some (lambda (f) (file-equal-p f filename))
+ (mapcar (lambda (f) (expand-file-name f base))
+ (org-publish-property :include p)))
+ p)
+ ;; Exclude file names matching :exclude property.
+ ((let ((exclude-re (org-publish-property :exclude p)))
+ (and exclude-re
+ (string-match-p exclude-re
+ (file-relative-name filename base))))
+ nil)
+ ;; Check :extension. Handle special `any'
+ ;; extension.
+ ((let ((extension (org-publish-property :base-extension p)))
+ (not (or (eq extension 'any)
+ (string= (or extension "org")
+ (file-name-extension filename)))))
+ nil)
+ ;; Check if FILENAME belong to project's base
+ ;; directory, or some of its sub-directories
+ ;; if :recursive in non-nil.
+ ((org-publish-property :recursive p)
+ (and (file-in-directory-p filename base) p))
+ ((file-equal-p base (file-name-directory filename)) p)
+ (t nil)))))
+ org-publish-project-alist)))
+ (cond
+ ((not project) nil)
+ ((not up) project)
+ ;; When optional argument UP is non-nil, return the top-most
+ ;; meta-project effectively publishing FILENAME.
+ (t
+ (letrec ((find-parent-project
+ (lambda (project)
+ (or (cl-some
+ (lambda (p)
+ (and (member (car project)
+ (org-publish-property :components p))
+ (funcall find-parent-project p)))
+ org-publish-project-alist)
+ project))))
+ (funcall find-parent-project project))))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Tools for publishing functions in back-ends
(defun org-publish-org-to (backend filename extension plist &optional pub-dir)
@@ -567,29 +541,31 @@ Return output file name."
(unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
;; Check if a buffer visiting FILENAME is already open.
(let* ((org-inhibit-startup t)
- (visitingp (find-buffer-visiting filename))
- (work-buffer (or visitingp (find-file-noselect filename))))
- (prog1 (with-current-buffer work-buffer
- (let ((output-file
- (org-export-output-file-name extension nil pub-dir))
- (body-p (plist-get plist :body-only)))
- (org-export-to-file backend output-file
- nil nil nil body-p
- ;; Add `org-publish-collect-numbering' and
- ;; `org-publish-collect-index' to final output
- ;; filters. The latter isn't dependent on
- ;; `:makeindex', since we want to keep it up-to-date
- ;; in cache anyway.
- (org-combine-plists
- plist
- `(:filter-final-output
- ,(cons 'org-publish-collect-numbering
- (cons 'org-publish-collect-index
- (plist-get plist :filter-final-output))))))))
+ (visiting (find-buffer-visiting filename))
+ (work-buffer (or visiting (find-file-noselect filename))))
+ (unwind-protect
+ (with-current-buffer work-buffer
+ (let ((output (org-export-output-file-name extension nil pub-dir)))
+ (org-export-to-file backend output
+ nil nil nil (plist-get plist :body-only)
+ ;; Add `org-publish--store-crossrefs' and
+ ;; `org-publish-collect-index' to final output filters.
+ ;; The latter isn't dependent on `:makeindex', since we
+ ;; want to keep it up-to-date in cache anyway.
+ (org-combine-plists
+ plist
+ `(:crossrefs
+ ,(org-publish-cache-get-file-property
+ ;; Normalize file names in cache.
+ (file-truename filename) :crossrefs nil t)
+ :filter-final-output
+ (org-publish--store-crossrefs
+ org-publish-collect-index
+ ,@(plist-get plist :filter-final-output)))))))
;; Remove opened buffer in the process.
- (unless visitingp (kill-buffer work-buffer)))))
+ (unless visiting (kill-buffer work-buffer)))))
-(defun org-publish-attachment (plist filename pub-dir)
+(defun org-publish-attachment (_plist filename pub-dir)
"Publish a file with no transformation of any kind.
FILENAME is the filename of the Org file to be published. PLIST
@@ -599,268 +575,327 @@ publishing directory.
Return output file name."
(unless (file-directory-p pub-dir)
(make-directory pub-dir t))
- (or (equal (expand-file-name (file-name-directory filename))
- (file-name-as-directory (expand-file-name pub-dir)))
- (copy-file filename
- (expand-file-name (file-name-nondirectory filename) pub-dir)
- t)))
+ (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
+ (unless (file-equal-p (expand-file-name (file-name-directory filename))
+ (file-name-as-directory (expand-file-name pub-dir)))
+ (copy-file filename output t))
+ ;; Return file name.
+ output))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Publishing files, sets of files, and indices
+;;; Publishing files, sets of files
(defun org-publish-file (filename &optional project no-cache)
"Publish file FILENAME from PROJECT.
-If NO-CACHE is not nil, do not initialize org-publish-cache and
-write it to disk. This is needed, since this function is used to
-publish single files, when entire projects are published.
-See `org-publish-projects'."
+If NO-CACHE is not nil, do not initialize `org-publish-cache'.
+This is needed, since this function is used to publish single
+files, when entire projects are published (see
+`org-publish-projects')."
(let* ((project
(or project
- (or (org-publish-get-project-from-filename filename)
- (error "File %s not part of any known project"
- (abbreviate-file-name filename)))))
+ (org-publish-get-project-from-filename filename)
+ (user-error "File %S is not part of any known project"
+ (abbreviate-file-name filename))))
(project-plist (cdr project))
- (ftname (expand-file-name filename))
(publishing-function
- (or (plist-get project-plist :publishing-function)
- (error "No publishing function chosen")))
+ (pcase (org-publish-property :publishing-function project)
+ (`nil (user-error "No publishing function chosen"))
+ ((and f (pred listp)) f)
+ (f (list f))))
(base-dir
(file-name-as-directory
- (expand-file-name
- (or (plist-get project-plist :base-directory)
- (error "Project %s does not have :base-directory defined"
- (car project))))))
- (pub-dir
+ (or (org-publish-property :base-directory project)
+ (user-error "Project %S does not have :base-directory defined"
+ (car project)))))
+ (pub-base-dir
(file-name-as-directory
- (file-truename
- (or (eval (plist-get project-plist :publishing-directory))
- (error "Project %s does not have :publishing-directory defined"
- (car project))))))
- tmp-pub-dir)
+ (or (org-publish-property :publishing-directory project)
+ (user-error
+ "Project %S does not have :publishing-directory defined"
+ (car project)))))
+ (pub-dir
+ (file-name-directory
+ (expand-file-name (file-relative-name filename base-dir)
+ pub-base-dir))))
(unless no-cache (org-publish-initialize-cache (car project)))
- (setq tmp-pub-dir
- (file-name-directory
- (concat pub-dir
- (and (string-match (regexp-quote base-dir) ftname)
- (substring ftname (match-end 0))))))
- (if (listp publishing-function)
- ;; allow chain of publishing functions
- (mapc (lambda (f)
- (when (org-publish-needed-p
- filename pub-dir f tmp-pub-dir base-dir)
- (funcall f project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp filename pub-dir f base-dir)))
- publishing-function)
- (when (org-publish-needed-p
- filename pub-dir publishing-function tmp-pub-dir base-dir)
- (funcall publishing-function project-plist filename tmp-pub-dir)
- (org-publish-update-timestamp
- filename pub-dir publishing-function base-dir)))
- (unless no-cache (org-publish-write-cache-file))))
-
-(defun org-publish--run-functions (functions)
- (cond
- ((null functions) nil)
- ((functionp functions) (funcall functions))
- ((consp functions) (mapc #'funcall functions))
- (t (error "Neither a function nor a list: %S" functions))))
+ ;; Allow chain of publishing functions.
+ (dolist (f publishing-function)
+ (when (org-publish-needed-p filename pub-base-dir f pub-dir base-dir)
+ (let ((output (funcall f project-plist filename pub-dir)))
+ (org-publish-update-timestamp filename pub-base-dir f base-dir)
+ (run-hook-with-args 'org-publish-after-publishing-hook
+ filename
+ output))))
+ ;; Make sure to write cache to file after successfully publishing
+ ;; a file, so as to minimize impact of a publishing failure.
+ (org-publish-write-cache-file)))
(defun org-publish-projects (projects)
"Publish all files belonging to the PROJECTS alist.
If `:auto-sitemap' is set, publish the sitemap too. If
-`:makeindex' is set, also produce a file theindex.org."
- (mapc
- (lambda (project)
- ;; Each project uses its own cache file:
- (org-publish-initialize-cache (car project))
- (let* ((project-plist (cdr project))
- (exclude-regexp (plist-get project-plist :exclude))
- (sitemap-p (plist-get project-plist :auto-sitemap))
- (sitemap-filename (or (plist-get project-plist :sitemap-filename)
- "sitemap.org"))
- (sitemap-function (or (plist-get project-plist :sitemap-function)
- 'org-publish-org-sitemap))
- (org-publish-sitemap-date-format
- (or (plist-get project-plist :sitemap-date-format)
- org-publish-sitemap-date-format))
- (org-publish-sitemap-file-entry-format
- (or (plist-get project-plist :sitemap-file-entry-format)
- org-publish-sitemap-file-entry-format))
- (preparation-function
- (plist-get project-plist :preparation-function))
- (completion-function (plist-get project-plist :completion-function))
- (files (org-publish-get-base-files project exclude-regexp))
- (theindex
+`:makeindex' is set, also produce a file \"theindex.org\"."
+ (dolist (project (org-publish-expand-projects projects))
+ (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))))
+ ;; Each project uses its own cache file.
+ (org-publish-initialize-cache (car project))
+ (when (org-publish-property :auto-sitemap project)
+ (let ((sitemap-filename
+ (or (org-publish-property :sitemap-filename project)
+ "sitemap.org")))
+ (org-publish-sitemap project sitemap-filename)))
+ ;; Publish all files from PROJECT except "theindex.org". Its
+ ;; publishing will be deferred until "theindex.inc" is
+ ;; populated.
+ (let ((theindex
(expand-file-name "theindex.org"
- (plist-get project-plist :base-directory))))
- (org-publish--run-functions preparation-function)
- (if sitemap-p (funcall sitemap-function project sitemap-filename))
- ;; Publish all files from PROJECT excepted "theindex.org". Its
- ;; publishing will be deferred until "theindex.inc" is
- ;; populated.
- (dolist (file files)
- (unless (equal file theindex)
- (org-publish-file file project t)))
- ;; Populate "theindex.inc", if needed, and publish
- ;; "theindex.org".
- (when (plist-get project-plist :makeindex)
- (org-publish-index-generate-theindex
- project (plist-get project-plist :base-directory))
- (org-publish-file theindex project t))
- (org-publish--run-functions completion-function)
- (org-publish-write-cache-file)))
- (org-publish-expand-projects projects)))
-
-(defun org-publish-org-sitemap (project &optional sitemap-filename)
+ (org-publish-property :base-directory project))))
+ (dolist (file (org-publish-get-base-files project))
+ (unless (file-equal-p file theindex)
+ (org-publish-file file project t)))
+ ;; Populate "theindex.inc", if needed, and publish
+ ;; "theindex.org".
+ (when (org-publish-property :makeindex project)
+ (org-publish-index-generate-theindex
+ project (org-publish-property :base-directory project))
+ (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)))))
+ (org-publish-write-cache-file)))
+
+
+;;; Site map generation
+
+(defun org-publish--sitemap-files-to-lisp (files project style format-entry)
+ "Represent FILES as a parsed plain list.
+FILES is the list of files in the site map. PROJECT is the
+current project. STYLE determines is either `list' or `tree'.
+FORMAT-ENTRY is a function called on each file which should
+return a string. Return value is a list as returned by
+`org-list-to-lisp'."
+ (let ((root (expand-file-name
+ (file-name-as-directory
+ (org-publish-property :base-directory project)))))
+ (pcase style
+ (`list
+ (cons 'unordered
+ (mapcar
+ (lambda (f)
+ (list (funcall format-entry
+ (file-relative-name f root)
+ style
+ project)))
+ files)))
+ (`tree
+ (letrec ((files-only (cl-remove-if #'directory-name-p files))
+ (directories (cl-remove-if-not #'directory-name-p files))
+ (subtree-to-list
+ (lambda (dir)
+ (cons 'unordered
+ (nconc
+ ;; Files in DIR.
+ (mapcar
+ (lambda (f)
+ (list (funcall format-entry
+ (file-relative-name f root)
+ style
+ project)))
+ (cl-remove-if-not
+ (lambda (f) (string= dir (file-name-directory f)))
+ files-only))
+ ;; Direct sub-directories.
+ (mapcar
+ (lambda (sub)
+ (list (funcall format-entry
+ (file-relative-name sub root)
+ style
+ project)
+ (funcall subtree-to-list sub)))
+ (cl-remove-if-not
+ (lambda (f)
+ (string=
+ dir
+ ;; Parent directory.
+ (file-name-directory (directory-file-name f))))
+ directories)))))))
+ (funcall subtree-to-list root)))
+ (_ (user-error "Unknown site-map style: `%s'" style)))))
+
+(defun org-publish-sitemap (project &optional sitemap-filename)
"Create a sitemap of pages in set defined by PROJECT.
Optionally set the filename of the sitemap with SITEMAP-FILENAME.
Default for SITEMAP-FILENAME is `sitemap.org'."
- (let* ((project-plist (cdr project))
- (dir (file-name-as-directory
- (plist-get project-plist :base-directory)))
- (localdir (file-name-directory dir))
- (indent-str (make-string 2 ?\ ))
- (exclude-regexp (plist-get project-plist :exclude))
- (files (nreverse
- (org-publish-get-base-files project exclude-regexp)))
- (sitemap-filename (concat dir (or sitemap-filename "sitemap.org")))
- (sitemap-title (or (plist-get project-plist :sitemap-title)
- (concat "Sitemap for project " (car project))))
- (sitemap-style (or (plist-get project-plist :sitemap-style)
- 'tree))
- (sitemap-sans-extension
- (plist-get project-plist :sitemap-sans-extension))
- (visiting (find-buffer-visiting sitemap-filename))
- (ifn (file-name-nondirectory sitemap-filename))
- file sitemap-buffer)
- (with-current-buffer
- (let ((org-inhibit-startup t))
- (setq sitemap-buffer
- (or visiting (find-file sitemap-filename))))
- (erase-buffer)
- (insert (concat "#+TITLE: " sitemap-title "\n\n"))
- (while (setq file (pop files))
- (let ((fn (file-name-nondirectory file))
- (link (file-relative-name file dir))
- (oldlocal localdir))
- (when sitemap-sans-extension
- (setq link (file-name-sans-extension link)))
- ;; sitemap shouldn't list itself
- (unless (equal (file-truename sitemap-filename)
- (file-truename file))
- (if (eq sitemap-style 'list)
- (message "Generating list-style sitemap for %s" sitemap-title)
- (message "Generating tree-style sitemap for %s" sitemap-title)
- (setq localdir (concat (file-name-as-directory dir)
- (file-name-directory link)))
- (unless (string= localdir oldlocal)
- (if (string= localdir dir)
- (setq indent-str (make-string 2 ?\ ))
- (let ((subdirs
- (split-string
- (directory-file-name
- (file-name-directory
- (file-relative-name localdir dir))) "/"))
- (subdir "")
- (old-subdirs (split-string
- (file-relative-name oldlocal dir) "/")))
- (setq indent-str (make-string 2 ?\ ))
- (while (string= (car old-subdirs) (car subdirs))
- (setq indent-str (concat indent-str (make-string 2 ?\ )))
- (pop old-subdirs)
- (pop subdirs))
- (dolist (d subdirs)
- (setq subdir (concat subdir d "/"))
- (insert (concat indent-str " + " d "\n"))
- (setq indent-str (make-string
- (+ (length indent-str) 2) ?\ )))))))
- ;; This is common to 'flat and 'tree
- (let ((entry
- (org-publish-format-file-entry
- org-publish-sitemap-file-entry-format file project-plist))
- (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
- (cond ((string-match-p regexp entry)
- (string-match regexp entry)
- (insert (concat indent-str " + " (match-string 1 entry)
- "[[file:" link "]["
- (match-string 2 entry)
- "]]" (match-string 3 entry) "\n")))
- (t
- (insert (concat indent-str " + [[file:" link "]["
- entry
- "]]\n"))))))))
- (save-buffer))
- (or visiting (kill-buffer sitemap-buffer))))
-
-(defun org-publish-format-file-entry (fmt file project-plist)
- (format-spec
- fmt
- `((?t . ,(org-publish-find-title file t))
- (?d . ,(format-time-string org-publish-sitemap-date-format
- (org-publish-find-date file)))
- (?a . ,(or (plist-get project-plist :author) user-full-name)))))
-
-(defun org-publish-find-title (file &optional reset)
- "Find the title of FILE in project."
- (or
- (and (not reset) (org-publish-cache-get-file-property file :title nil t))
- (let* ((org-inhibit-startup t)
- (visiting (find-buffer-visiting file))
- (buffer (or visiting (find-file-noselect file))))
- (with-current-buffer buffer
- (let ((title
- (let ((property
- (plist-get
- ;; protect local variables in open buffers
- (if visiting
- (org-export-with-buffer-copy (org-export-get-environment))
- (org-export-get-environment))
- :title)))
- (if property
- (org-no-properties (org-element-interpret-data property))
- (file-name-nondirectory (file-name-sans-extension file))))))
- (unless visiting (kill-buffer buffer))
- (org-publish-cache-set-file-property file :title title)
- title)))))
-
-(defun org-publish-find-date (file)
- "Find the date of FILE in project.
+ (let* ((root (expand-file-name
+ (file-name-as-directory
+ (org-publish-property :base-directory project))))
+ (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
+ (title (or (org-publish-property :sitemap-title project)
+ (concat "Sitemap for project " (car project))))
+ (style (or (org-publish-property :sitemap-style project)
+ 'tree))
+ (sitemap-builder (or (org-publish-property :sitemap-function project)
+ #'org-publish-sitemap-default))
+ (format-entry (or (org-publish-property :sitemap-format-entry project)
+ #'org-publish-sitemap-default-entry))
+ (sort-folders
+ (org-publish-property :sitemap-sort-folders project
+ org-publish-sitemap-sort-folders))
+ (sort-files
+ (org-publish-property :sitemap-sort-files project
+ org-publish-sitemap-sort-files))
+ (ignore-case
+ (org-publish-property :sitemap-ignore-case project
+ org-publish-sitemap-sort-ignore-case))
+ (org-file-p (lambda (f) (equal "org" (file-name-extension f))))
+ (sort-predicate
+ (lambda (a b)
+ (let ((retval t))
+ ;; First we sort files:
+ (pcase sort-files
+ (`alphabetically
+ (let ((A (if (funcall org-file-p a)
+ (concat (file-name-directory a)
+ (org-publish-find-title a project))
+ a))
+ (B (if (funcall org-file-p b)
+ (concat (file-name-directory b)
+ (org-publish-find-title b project))
+ b)))
+ (setq retval
+ (if ignore-case
+ (not (string-lessp (upcase B) (upcase A)))
+ (not (string-lessp B A))))))
+ ((or `anti-chronologically `chronologically)
+ (let* ((adate (org-publish-find-date a project))
+ (bdate (org-publish-find-date b project))
+ (A (+ (lsh (car adate) 16) (cadr adate)))
+ (B (+ (lsh (car bdate) 16) (cadr bdate))))
+ (setq retval
+ (if (eq sort-files 'chronologically)
+ (<= A B)
+ (>= A B)))))
+ (`nil nil)
+ (_ (user-error "Invalid sort value %s" sort-files)))
+ ;; Directory-wise wins:
+ (when (memq sort-folders '(first last))
+ ;; a is directory, b not:
+ (cond
+ ((and (file-directory-p a) (not (file-directory-p b)))
+ (setq retval (eq sort-folders 'first)))
+ ;; a is not a directory, but b is:
+ ((and (not (file-directory-p a)) (file-directory-p b))
+ (setq retval (eq sort-folders 'last)))))
+ retval))))
+ (message "Generating sitemap for %s" title)
+ (with-temp-file sitemap-filename
+ (insert
+ (let ((files (remove sitemap-filename
+ (org-publish-get-base-files project))))
+ ;; Add directories, if applicable.
+ (unless (and (eq style 'list) (eq sort-folders 'ignore))
+ (setq files
+ (nconc (remove root (org-uniquify
+ (mapcar #'file-name-directory files)))
+ files)))
+ ;; Eventually sort all entries.
+ (when (or sort-files (not (memq sort-folders 'ignore)))
+ (setq files (sort files sort-predicate)))
+ (funcall sitemap-builder
+ title
+ (org-publish--sitemap-files-to-lisp
+ files project style format-entry)))))))
+
+(defun org-publish-find-property (file property project &optional backend)
+ "Find the PROPERTY of FILE in project.
+
+PROPERTY is a keyword referring to an export option, as defined
+in `org-export-options-alist' or in export back-ends. In the
+latter case, optional argument BACKEND has to be set to the
+back-end where the option is defined, e.g.,
+
+ (org-publish-find-property file :subtitle 'latex)
+
+Return value may be a string or a list, depending on the type of
+PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
+ (let ((file (org-publish--expand-file-name file project)))
+ (when (and (file-readable-p file) (not (directory-name-p file)))
+ (let* ((org-inhibit-startup t)
+ (visiting (find-buffer-visiting file))
+ (buffer (or visiting (find-file-noselect file))))
+ (unwind-protect
+ (plist-get (with-current-buffer buffer
+ (if (not visiting) (org-export-get-environment backend)
+ ;; Protect local variables in open buffers.
+ (org-export-with-buffer-copy
+ (org-export-get-environment backend))))
+ property)
+ (unless visiting (kill-buffer buffer)))))))
+
+(defun org-publish-find-title (file project)
+ "Find the title of FILE in PROJECT."
+ (let ((file (org-publish--expand-file-name file project)))
+ (or (org-publish-cache-get-file-property file :title nil t)
+ (let* ((parsed-title (org-publish-find-property file :title project))
+ (title
+ (if parsed-title
+ ;; Remove property so that the return value is
+ ;; cache-able (i.e., it can be `read' back).
+ (org-no-properties
+ (org-element-interpret-data parsed-title))
+ (file-name-nondirectory (file-name-sans-extension file)))))
+ (org-publish-cache-set-file-property file :title title)
+ title))))
+
+(defun org-publish-find-date (file project)
+ "Find the date of FILE in PROJECT.
This function assumes FILE is either a directory or an Org file.
If FILE is an Org file and provides a DATE keyword use it. In
any other case use the file system's modification time. Return
time in `current-time' format."
- (if (file-directory-p file) (nth 5 (file-attributes file))
- (let* ((org-inhibit-startup t)
- (visiting (find-buffer-visiting file))
- (file-buf (or visiting (find-file-noselect file nil)))
- (date (plist-get
- (with-current-buffer file-buf
- (if visiting
- (org-export-with-buffer-copy (org-export-get-environment))
- (org-export-get-environment)))
- :date)))
- (unless visiting (kill-buffer file-buf))
- ;; DATE is either a timestamp object or a secondary string. If it
- ;; is a timestamp or if the secondary string contains a timestamp,
- ;; convert it to internal format. Otherwise, use FILE
- ;; modification time.
- (cond ((eq (org-element-type date) 'timestamp)
- (org-time-string-to-time (org-element-interpret-data date)))
- ((let ((ts (and (consp date) (assq 'timestamp date))))
- (and ts
- (let ((value (org-element-interpret-data ts)))
- (and (org-string-nw-p value)
- (org-time-string-to-time value))))))
- ((file-exists-p file) (nth 5 (file-attributes file)))
- (t (error "No such file: \"%s\"" file))))))
-
+ (let ((file (org-publish--expand-file-name file project)))
+ (if (file-directory-p file) (nth 5 (file-attributes file))
+ (let ((date (org-publish-find-property file :date project)))
+ ;; DATE is a secondary string. If it contains a time-stamp,
+ ;; convert it to internal format. Otherwise, use FILE
+ ;; modification time.
+ (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
+ (and ts
+ (let ((value (org-element-interpret-data ts)))
+ (and (org-string-nw-p value)
+ (org-time-string-to-time value))))))
+ ((file-exists-p file) (nth 5 (file-attributes file)))
+ (t (error "No such file: \"%s\"" file)))))))
+
+(defun org-publish-sitemap-default-entry (entry style project)
+ "Default format for site map ENTRY, as a string.
+ENTRY is a file name. STYLE is the style of the sitemap.
+PROJECT is the current project."
+ (cond ((not (directory-name-p entry))
+ (format "[[file:%s][%s]]"
+ entry
+ (org-publish-find-title entry project)))
+ ((eq style 'tree)
+ ;; Return only last subdir.
+ (file-name-nondirectory (directory-file-name entry)))
+ (t entry)))
+
+(defun org-publish-sitemap-default (title list)
+ "Default site map, as a string.
+TITLE is the the title of the site map. LIST is an internal
+representation for the files to include, as returned by
+`org-list-to-lisp'. PROJECT is the current project."
+ (concat "#+TITLE: " title "\n\n"
+ (org-list-to-org list)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interactive publishing functions
;;;###autoload
@@ -877,25 +912,28 @@ When optional argument FORCE is non-nil, force publishing all
files in PROJECT. With a non-nil optional argument ASYNC,
publishing will be done asynchronously, in another process."
(interactive
- (list
- (assoc (org-icompleting-read
- "Publish project: "
- org-publish-project-alist nil t)
- org-publish-project-alist)
- current-prefix-arg))
- (let ((project-alist (if (not (stringp project)) (list project)
- ;; If this function is called in batch mode,
- ;; project is still a string here.
- (list (assoc project org-publish-project-alist)))))
- (if async
- (org-export-async-start (lambda (results) nil)
- `(let ((org-publish-use-timestamps-flag
- (if ',force nil ,org-publish-use-timestamps-flag)))
- (org-publish-projects ',project-alist)))
- (save-window-excursion
- (let* ((org-publish-use-timestamps-flag
- (if force nil org-publish-use-timestamps-flag)))
- (org-publish-projects project-alist))))))
+ (list (assoc (completing-read "Publish project: "
+ org-publish-project-alist nil t)
+ org-publish-project-alist)
+ current-prefix-arg))
+ (let ((project (if (not (stringp project)) project
+ ;; If this function is called in batch mode,
+ ;; PROJECT is still a string here.
+ (assoc project org-publish-project-alist))))
+ (cond
+ ((not project))
+ (async
+ (org-export-async-start (lambda (_) nil)
+ `(let ((org-publish-use-timestamps-flag
+ ,(and (not force) org-publish-use-timestamps-flag)))
+ ;; Expand components right now as external process may not
+ ;; be aware of complete `org-publish-project-alist'.
+ (org-publish-projects
+ ',(org-publish-expand-projects (list project))))))
+ (t (save-window-excursion
+ (let ((org-publish-use-timestamps-flag
+ (and (not force) org-publish-use-timestamps-flag)))
+ (org-publish-projects (list project))))))))
;;;###autoload
(defun org-publish-all (&optional force async)
@@ -906,7 +944,7 @@ optional argument ASYNC, publishing will be done asynchronously,
in another process."
(interactive "P")
(if async
- (org-export-async-start (lambda (results) nil)
+ (org-export-async-start (lambda (_) nil)
`(progn
(when ',force (org-publish-remove-all-timestamps))
(let ((org-publish-use-timestamps-flag
@@ -928,7 +966,7 @@ asynchronously, in another process."
(interactive "P")
(let ((file (buffer-file-name (buffer-base-buffer))))
(if async
- (org-export-async-start (lambda (results) nil)
+ (org-export-async-start (lambda (_) nil)
`(let ((org-publish-use-timestamps-flag
(if ',force nil ,org-publish-use-timestamps-flag)))
(org-publish-file ,file)))
@@ -954,7 +992,7 @@ the project."
;;; Index generation
-(defun org-publish-collect-index (output backend info)
+(defun org-publish-collect-index (output _backend info)
"Update index for a file in cache.
OUTPUT is the output from transcoding current file. BACKEND is
@@ -969,7 +1007,7 @@ PARENT is a reference to the headline, if any, containing the
original index keyword. When non-nil, this reference is a cons
cell. Its CAR is a symbol among `id', `custom-id' and `name' and
its CDR is a string."
- (let ((file (plist-get info :input-file)))
+ (let ((file (file-truename (plist-get info :input-file))))
(org-publish-cache-set-file-property
file :index
(delete-dups
@@ -998,8 +1036,7 @@ its CDR is a string."
"Retrieve full index from cache and build \"theindex.org\".
PROJECT is the project the index relates to. DIRECTORY is the
publishing directory."
- (let ((all-files (org-publish-get-base-files
- project (plist-get (cdr project) :exclude)))
+ (let ((all-files (org-publish-get-base-files project))
full-index)
;; Compile full index and sort it alphabetically.
(dolist (file all-files
@@ -1027,10 +1064,11 @@ publishing directory."
;; Compute the first difference between last entry and
;; current one: it tells the level at which new items
;; should be added.
- (let* ((rank (if (equal entry last-entry) (1- (length entry))
- (loop for n from 0 to (length entry)
- unless (equal (nth n entry) (nth n last-entry))
- return n)))
+ (let* ((rank
+ (if (equal entry last-entry) (1- (length entry))
+ (cl-loop for n from 0 to (length entry)
+ unless (equal (nth n entry) (nth n last-entry))
+ return n)))
(len (length (nthcdr rank entry))))
;; For each term after the first difference, create
;; a new sub-list with the term as body. Moreover,
@@ -1038,18 +1076,18 @@ publishing directory."
(dotimes (n len)
(insert
(concat
- (make-string (* (+ rank n) 2) ? ) " - "
+ (make-string (* (+ rank n) 2) ?\s) " - "
(if (not (= (1- len) n)) (nth (+ rank n) entry)
;; Last term: Link it to TARGET, if possible.
(let ((target (nth 2 idx)))
(format
"[[%s][%s]]"
;; Destination.
- (case (car target)
- ('nil (format "file:%s" file))
- (id (format "id:%s" (cdr target)))
- (custom-id (format "file:%s::#%s" file (cdr target)))
- (otherwise (format "file:%s::*%s" file (cdr target))))
+ (pcase (car target)
+ (`nil (format "file:%s" file))
+ (`id (format "id:%s" (cdr target)))
+ (`custom-id (format "file:%s::#%s" file (cdr target)))
+ (_ (format "file:%s::*%s" file (cdr target))))
;; Description.
(car (last entry)))))
"\n"))))
@@ -1068,31 +1106,76 @@ publishing directory."
;; This part implements tools to resolve [[file.org::*Some headline]]
;; links, where "file.org" belongs to the current project.
-(defun org-publish-collect-numbering (output backend info)
+(defun org-publish--store-crossrefs (output _backend info)
+ "Store cross-references for current published file.
+
+OUTPUT is the produced output, as a string. BACKEND is the export
+back-end used, as a symbol. INFO is the final export state, as
+a plist.
+
+This function is meant to be used as a final output filter. See
+`org-publish-org-to'."
(org-publish-cache-set-file-property
- (plist-get info :input-file) :numbering
- (mapcar (lambda (entry)
- (cons (org-split-string
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-element-property :raw-value (car entry))))
- (cdr entry)))
- (plist-get info :headline-numbering)))
+ (file-truename (plist-get info :input-file))
+ :crossrefs
+ ;; Update `:crossrefs' so as to remove unused references and search
+ ;; cells. Actually used references are extracted from
+ ;; `:internal-references', with references as strings removed. See
+ ;; `org-export-get-reference' for details.
+ (cl-remove-if (lambda (pair) (stringp (car pair)))
+ (plist-get info :internal-references)))
;; Return output unchanged.
output)
-(defun org-publish-resolve-external-fuzzy-link (file fuzzy)
- "Return numbering for headline matching FUZZY search in FILE.
-
-Return value is a list of numbers, or nil. This function allows
-the resolution of external fuzzy links like:
-
- [[file.org::*fuzzy][description]]"
- (when org-publish-cache
- (cdr (assoc (org-split-string
- (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy))
- (org-publish-cache-get-file-property
- (expand-file-name file) :numbering nil t)))))
+(defun org-publish-resolve-external-link (search file)
+ "Return reference for element matching string SEARCH in FILE.
+
+Return value is an internal reference, as a string.
+
+This function allows resolving external links with a search
+option, e.g.,
+
+ [[file.org::*heading][description]]
+ [[file.org::#custom-id][description]]
+ [[file.org::fuzzy][description]]
+
+It only makes sense to use this if export back-end builds
+references with `org-export-get-reference'."
+ (if (not org-publish-cache)
+ (progn
+ (message "Reference %S in file %S cannot be resolved without publishing"
+ search
+ file)
+ "MissingReference")
+ (let* ((filename (file-truename file))
+ (crossrefs
+ (org-publish-cache-get-file-property filename :crossrefs nil t))
+ (cells
+ (org-export-string-to-search-cell (org-link-unescape search))))
+ (or
+ ;; Look for reference associated to search cells triggered by
+ ;; LINK. It can match when targeted file has been published
+ ;; already.
+ (let ((known (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells))))
+ (and known (org-export-format-reference known)))
+ ;; Search cell is unknown so far. Generate a new internal
+ ;; reference that will be used when the targeted file will be
+ ;; published.
+ (let ((new (org-export-new-reference crossrefs)))
+ (dolist (cell cells) (push (cons cell new) crossrefs))
+ (org-publish-cache-set-file-property filename :crossrefs crossrefs)
+ (org-export-format-reference new))))))
+
+(defun org-publish-file-relative-name (filename info)
+ "Convert FILENAME to be relative to current project's base directory.
+INFO is the plist containing the current export state. The
+function does not change relative file names."
+ (let ((base (plist-get info :base-directory)))
+ (if (and base
+ (file-name-absolute-p filename)
+ (file-in-directory-p filename base))
+ (file-relative-name filename base)
+ filename)))
@@ -1109,13 +1192,12 @@ If FREE-CACHE, empty the cache."
(error "Cannot find cache-file name in `org-publish-write-cache-file'"))
(with-temp-file cache-file
(let (print-level print-length)
- (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n")
+ (insert "(setq org-publish-cache \
+\(make-hash-table :test 'equal :weakness nil :size 100))\n")
(maphash (lambda (k v)
(insert
- (format (concat "(puthash %S "
- (if (or (listp v) (symbolp v))
- "'" "")
- "%S org-publish-cache)\n") k v)))
+ (format "(puthash %S %s%S org-publish-cache)\n"
+ k (if (or (listp v) (symbolp v)) "'" "") v)))
org-publish-cache)))
(when free-cache (org-publish-reset-cache))))
@@ -1123,7 +1205,8 @@ If FREE-CACHE, empty the cache."
"Initialize the projects cache if not initialized yet and return it."
(unless project-name
- (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'"))
+ (error "Cannot initialize `org-publish-cache' without projects name in \
+`org-publish-initialize-cache'"))
(unless (file-exists-p org-publish-timestamp-directory)
(make-directory org-publish-timestamp-directory t))
@@ -1157,7 +1240,7 @@ If FREE-CACHE, empty the cache."
(setq org-publish-cache nil))
(defun org-publish-cache-file-needs-publishing
- (filename &optional pub-dir pub-func base-dir)
+ (filename &optional pub-dir pub-func _base-dir)
"Check the timestamp of the last publishing of FILENAME.
Return non-nil if the file needs publishing. Also check if
any included files have been more recently published, so that
@@ -1165,33 +1248,42 @@ the file including them will be republished as well."
(unless org-publish-cache
(error
"`org-publish-cache-file-needs-publishing' called, but no cache present"))
- (let* ((case-fold-search t)
- (key (org-publish-timestamp-filename filename pub-dir pub-func))
+ (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
(pstamp (org-publish-cache-get key))
(org-inhibit-startup t)
- (visiting (find-buffer-visiting filename))
- included-files-ctime buf)
-
+ included-files-ctime)
(when (equal (file-name-extension filename) "org")
- (setq buf (find-file (expand-file-name filename)))
- (with-current-buffer buf
- (goto-char (point-min))
- (while (re-search-forward
- "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t)
- (let* ((included-file (expand-file-name (match-string 1)))
- (ctime (org-publish-cache-ctime-of-src included-file)))
- (unless (member ctime included-files-ctime)
- ;; FIXME: The original code insisted on appending this ctime
- ;; to the end of the list, even tho the order seems irrelevant.
- (setq included-files-ctime
- (append included-files-ctime (list ctime)))))))
- (unless visiting (kill-buffer buf)))
- (if (null pstamp) t
- (let ((ctime (org-publish-cache-ctime-of-src filename)))
- (or (< pstamp ctime)
- (when included-files-ctime
- (not (null (delq nil (mapcar (lambda(ct) (< ctime ct))
- included-files-ctime))))))))))
+ (let ((visiting (find-buffer-visiting filename))
+ (buf (find-file-noselect filename))
+ (case-fold-search t))
+ (unwind-protect
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
+ (let* ((element (org-element-at-point))
+ (included-file
+ (and (eq (org-element-type element) 'keyword)
+ (let ((value (org-element-property :value element)))
+ (and value
+ (string-match
+ "\\`\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)"
+ value)
+ (let ((m (match-string 1 value)))
+ (org-unbracket-string
+ "\"" "\""
+ ;; Ignore search suffix.
+ (if (string-match "::.*?\"?\\'" m)
+ (substring m 0 (match-beginning 0))
+ m))))))))
+ (when included-file
+ (push (org-publish-cache-ctime-of-src
+ (expand-file-name included-file))
+ included-files-ctime)))))
+ (unless visiting (kill-buffer buf)))))
+ (or (null pstamp)
+ (let ((ctime (org-publish-cache-ctime-of-src filename)))
+ (or (< pstamp ctime)
+ (cl-some (lambda (ct) (< ctime ct)) included-files-ctime))))))
(defun org-publish-cache-set-file-property
(filename property value &optional project-name)
@@ -1206,35 +1298,32 @@ will be created. Return VALUE."
filename property value nil project-name))))
(defun org-publish-cache-get-file-property
- (filename property &optional default no-create project-name)
+ (filename property &optional default no-create project-name)
"Return the value for a PROPERTY of file FILENAME in publishing cache.
-Use cache file of PROJECT-NAME. Return the value of that PROPERTY
-or DEFAULT, if the value does not yet exist. If the entry will
-be created, unless NO-CREATE is not nil."
- ;; Evtl. load the requested cache file:
- (if project-name (org-publish-initialize-cache project-name))
- (let ((pl (org-publish-cache-get filename)) retval)
- (if pl
- (if (plist-member pl property)
- (setq retval (plist-get pl property))
- (setq retval default))
- ;; no pl yet:
- (unless no-create
- (org-publish-cache-set filename (list property default)))
- (setq retval default))
- retval))
+Use cache file of PROJECT-NAME. Return the value of that PROPERTY,
+or DEFAULT, if the value does not yet exist. Create the entry,
+if necessary, unless NO-CREATE is non-nil."
+ (when project-name (org-publish-initialize-cache project-name))
+ (let ((properties (org-publish-cache-get filename)))
+ (cond ((null properties)
+ (unless no-create
+ (org-publish-cache-set filename (list property default)))
+ default)
+ ((plist-member properties property) (plist-get properties property))
+ (t default))))
(defun org-publish-cache-get (key)
"Return the value stored in `org-publish-cache' for key KEY.
-Returns nil, if no value or nil is found, or the cache does not
-exist."
+Return nil, if no value or nil is found. Raise an error if the
+cache does not exist."
(unless org-publish-cache
(error "`org-publish-cache-get' called, but no cache present"))
(gethash key org-publish-cache))
(defun org-publish-cache-set (key value)
"Store KEY VALUE pair in `org-publish-cache'.
-Returns value on success, else nil."
+Returns value on success, else nil. Raise an error if the cache
+does not exist."
(unless org-publish-cache
(error "`org-publish-cache-set' called, but no cache present"))
(puthash key value org-publish-cache))
diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el
index 31d91ebfb80..60618c1c30e 100644
--- a/lisp/org/ox-texinfo.el
+++ b/lisp/org/ox-texinfo.el
@@ -1,4 +1,4 @@
-;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine
+;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com>
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -25,7 +25,7 @@
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(require 'ox)
(defvar orgtbl-exp-regexp)
@@ -39,8 +39,6 @@
(center-block . org-texinfo-center-block)
(clock . org-texinfo-clock)
(code . org-texinfo-code)
- (comment . (lambda (&rest args) ""))
- (comment-block . (lambda (&rest args) ""))
(drawer . org-texinfo-drawer)
(dynamic-block . org-texinfo-dynamic-block)
(entity . org-texinfo-entity)
@@ -58,18 +56,19 @@
(keyword . org-texinfo-keyword)
(line-break . org-texinfo-line-break)
(link . org-texinfo-link)
+ (node-property . org-texinfo-node-property)
(paragraph . org-texinfo-paragraph)
(plain-list . org-texinfo-plain-list)
(plain-text . org-texinfo-plain-text)
(planning . org-texinfo-planning)
(property-drawer . org-texinfo-property-drawer)
(quote-block . org-texinfo-quote-block)
- (quote-section . org-texinfo-quote-section)
(radio-target . org-texinfo-radio-target)
(section . org-texinfo-section)
(special-block . org-texinfo-special-block)
(src-block . org-texinfo-src-block)
(statistics-cookie . org-texinfo-statistics-cookie)
+ (strike-through . org-texinfo-strike-through)
(subscript . org-texinfo-subscript)
(superscript . org-texinfo-superscript)
(table . org-texinfo-table)
@@ -78,28 +77,47 @@
(target . org-texinfo-target)
(template . org-texinfo-template)
(timestamp . org-texinfo-timestamp)
+ (underline . org-texinfo-underline)
(verbatim . org-texinfo-verbatim)
(verse-block . org-texinfo-verse-block))
- :export-block "TEXINFO"
:filters-alist
- '((:filter-headline . org-texinfo-filter-section-blank-lines)
+ '((:filter-headline . org-texinfo--filter-section-blank-lines)
(:filter-parse-tree . org-texinfo--normalize-headlines)
- (:filter-section . org-texinfo-filter-section-blank-lines))
+ (:filter-section . org-texinfo--filter-section-blank-lines)
+ (:filter-final-output . org-texinfo--untabify))
:menu-entry
'(?i "Export to Texinfo"
((?t "As TEXI file" org-texinfo-export-to-texinfo)
- (?i "As INFO file" org-texinfo-export-to-info)))
+ (?i "As INFO file" org-texinfo-export-to-info)
+ (?o "As INFO file and open"
+ (lambda (a s v b)
+ (if a (org-texinfo-export-to-info t s v b)
+ (org-open-file (org-texinfo-export-to-info nil s v b)))))))
:options-alist
'((:texinfo-filename "TEXINFO_FILENAME" nil nil t)
(:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t)
(:texinfo-header "TEXINFO_HEADER" nil nil newline)
(:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline)
- (:subtitle "SUBTITLE" nil nil newline)
+ (:subtitle "SUBTITLE" nil nil parse)
(:subauthor "SUBAUTHOR" nil nil newline)
(:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t)
(:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t)
(:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t)
- (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t)))
+ (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t)
+ ;; Other variables.
+ (:texinfo-classes nil nil org-texinfo-classes)
+ (:texinfo-format-headline-function nil nil org-texinfo-format-headline-function)
+ (:texinfo-node-description-column nil nil org-texinfo-node-description-column)
+ (:texinfo-active-timestamp-format nil nil org-texinfo-active-timestamp-format)
+ (:texinfo-inactive-timestamp-format nil nil org-texinfo-inactive-timestamp-format)
+ (:texinfo-diary-timestamp-format nil nil org-texinfo-diary-timestamp-format)
+ (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format)
+ (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim)
+ (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation)
+ (:texinfo-table-default-markup nil nil org-texinfo-table-default-markup)
+ (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist)
+ (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function)
+ (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function)))
@@ -129,17 +147,19 @@ If nil it will default to `buffer-file-coding-system'."
(defcustom org-texinfo-classes
'(("info"
"@documentencoding AUTO\n@documentlanguage AUTO"
- ("@chapter %s" . "@unnumbered %s")
- ("@section %s" . "@unnumberedsec %s")
- ("@subsection %s" . "@unnumberedsubsec %s")
- ("@subsubsection %s" . "@unnumberedsubsubsec %s")))
+ ("@chapter %s" "@unnumbered %s" "@appendix %s")
+ ("@section %s" "@unnumberedsec %s" "@appendixsec %s")
+ ("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s")
+ ("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s")))
"Alist of Texinfo classes and associated header and structure.
If #+TEXINFO_CLASS is set in the buffer, use its value and the
-associated information. Here is the structure of each cell:
+associated information. Here is the structure of a class
+definition:
(class-name
header-string
- (numbered-section . unnumbered-section)
+ (numbered-1 unnumbered-1 appendix-1)
+ (numbered-2 unnumbered-2 appendix-2)
...)
@@ -171,29 +191,24 @@ The sectioning structure
The sectioning structure of the class is given by the elements
following the header string. For each sectioning level, a number
of strings is specified. A %s formatter is mandatory in each
-section string and will be replaced by the title of the section.
-
-Instead of a list of sectioning commands, you can also specify
-a function name. That function will be called with two
-parameters, the reduced) level of the headline, and a predicate
-non-nil when the headline should be numbered. It must return
-a format string in which the section title will be added."
+section string and will be replaced by the title of the section."
:group 'org-export-texinfo
- :version "24.4"
- :package-version '(Org . "8.2")
+ :version "26.1"
+ :package-version '(Org . "9.1")
:type '(repeat
(list (string :tag "Texinfo class")
(string :tag "Texinfo header")
(repeat :tag "Levels" :inline t
(choice
- (cons :tag "Heading"
+ (list :tag "Heading"
(string :tag " numbered")
- (string :tag "unnumbered"))
- (function :tag "Hook computing sectioning"))))))
+ (string :tag "unnumbered")
+ (string :tag " appendix")))))))
;;;; Headline
-(defcustom org-texinfo-format-headline-function 'ignore
+(defcustom org-texinfo-format-headline-function
+ 'org-texinfo-format-headline-default-function
"Function to format headline text.
This function will be called with 5 arguments:
@@ -203,23 +218,11 @@ PRIORITY the priority of the headline (integer or nil)
TEXT the main headline text (string).
TAGS the tags as a list of strings (list of strings or nil).
-The function result will be used in the section format string.
-
-As an example, one could set the variable to the following, in
-order to reproduce the default set-up:
-
-\(defun org-texinfo-format-headline (todo todo-type priority text tags)
- \"Default format function for a headline.\"
- (concat (when todo
- (format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo))
- (when priority
- (format \"\\\\framebox{\\\\#%c} \" priority))
- text
- (when tags
- (format \"\\\\hfill{}\\\\textsc{%s}\"
- (mapconcat \\='identity tags \":\"))))"
+The function result will be used in the section format string."
:group 'org-export-texinfo
- :type 'function)
+ :type 'function
+ :version "26.1"
+ :package-version '(Org . "8.3"))
;;;; Node listing (menu)
@@ -263,6 +266,7 @@ be placed after the end of the title."
(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)"
"Format string to display numbers in scientific notation.
+
The format should have \"%s\" twice, for mantissa and exponent
\(i.e. \"%s\\\\times10^{%s}\").
@@ -272,39 +276,48 @@ When nil, no transformation is made."
(string :tag "Format string")
(const :tag "No formatting" nil)))
-(defcustom org-texinfo-def-table-markup "@samp"
- "Default setting for @table environments."
+(defcustom org-texinfo-table-default-markup "@asis"
+ "Default markup for first column in two-column tables.
+
+This should an indicating command, e.g., \"@code\", \"@kbd\" or
+\"@samp\".
+
+It can be overridden locally using the \":indic\" attribute."
:group 'org-export-texinfo
- :type 'string)
+ :type 'string
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :safe #'stringp)
;;;; Text markup
(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}")
(code . code)
(italic . "@emph{%s}")
- (verbatim . verb)
- (comment . "@c %s"))
+ (verbatim . samp))
"Alist of Texinfo expressions to convert text markup.
-The key must be a symbol among `bold', `italic' and `comment'.
-The value is a formatting string to wrap fontified text with.
+The key must be a symbol among `bold', `code', `italic',
+`strike-through', `underscore' and `verbatim'. The value is
+a formatting string to wrap fontified text with.
-Value can also be set to the following symbols: `verb' and
-`code'. For the former, Org will use \"@verb\" to
-create a format string and select a delimiter character that
-isn't in the string. For the latter, Org will use \"@code\"
-to typeset and try to protect special characters.
+Value can also be set to the following symbols: `verb', `samp'
+and `code'. With the first one, Org uses \"@verb\" to create
+a format string and selects a delimiter character that isn't in
+the string. For the other two, Org uses \"@samp\" or \"@code\"
+to typeset and protects special characters.
-If no association can be found for a given markup, text will be
-returned as-is."
+When no association is found for a given markup, text is returned
+as-is."
:group 'org-export-texinfo
+ :version "26.1"
+ :package-version '(Org . "9.1")
:type 'alist
- :options '(bold code italic verbatim comment))
+ :options '(bold code italic strike-through underscore verbatim))
;;;; Drawers
-(defcustom org-texinfo-format-drawer-function
- (lambda (name contents) contents)
+(defcustom org-texinfo-format-drawer-function (lambda (_name contents) contents)
"Function called to format a drawer in Texinfo code.
The function must accept two parameters:
@@ -321,7 +334,8 @@ The default function simply returns the value of CONTENTS."
;;;; Inlinetasks
-(defcustom org-texinfo-format-inlinetask-function 'ignore
+(defcustom org-texinfo-format-inlinetask-function
+ 'org-texinfo-format-inlinetask-default-function
"Function called to format an inlinetask in Texinfo code.
The function must accept six parameters:
@@ -332,38 +346,24 @@ The function must accept six parameters:
TAGS the inlinetask tags, as a list of strings.
CONTENTS the contents of the inlinetask, as a string.
-The function should return the string to be exported.
-
-For example, the variable could be set to the following function
-in order to mimic default behavior:
-
-\(defun org-texinfo-format-inlinetask (todo type priority name tags contents)
-\"Format an inline task element for Texinfo export.\"
- (let ((full-title
- (concat
- (when todo
- (format \"@strong{%s} \" todo))
- (when priority (format \"#%c \" priority))
- title
- (when tags
- (format \":%s:\"
- (mapconcat \\='identity tags \":\")))))
- (format (concat \"@center %s\n\n\"
- \"%s\"
- \"\n\"))
- full-title contents))"
+The function should return the string to be exported."
:group 'org-export-texinfo
:type 'function)
;;;; Compilation
-(defcustom org-texinfo-info-process '("makeinfo %f")
+(defcustom org-texinfo-info-process '("makeinfo --no-split %f")
"Commands to process a Texinfo file to an INFO file.
-This is list of strings, each of them will be given to the shell
-as a command. %f in the command will be replaced by the full
-file name, %b by the file base name (i.e without extension) and
-%o by the base directory of the file."
+
+This is a list of strings, each of them will be given to the
+shell as a command. %f in the command will be replaced by the
+relative file name, %F by the absolute file name, %b by the file
+base name (i.e. without directory and extension parts), %o by the
+base directory of the file and %O by the absolute file name of
+the output file."
:group 'org-export-texinfo
+ :version "26.1"
+ :package-version '(Org . "9.1")
:type '(repeat :tag "Shell command sequence"
(string :tag "Shell command")))
@@ -398,15 +398,23 @@ Specified coding system will be matched against these strings.
If two strings share the same prefix (e.g. \"ISO-8859-1\" and
\"ISO-8859-15\"), the most specific one has to be listed first.")
+(defconst org-texinfo-inline-image-rules
+ (list (cons "file"
+ (regexp-opt '("eps" "pdf" "png" "jpg" "jpeg" "gif" "svg"))))
+ "Rules characterizing image files that can be inlined.")
+
;;; Internal Functions
-(defun org-texinfo-filter-section-blank-lines (headline back-end info)
+(defun org-texinfo--untabify (s _backend _info)
+ "Remove TAB characters in string S."
+ (replace-regexp-in-string "\t" (make-string tab-width ?\s) s))
+
+(defun org-texinfo--filter-section-blank-lines (headline _backend _info)
"Filter controlling number of blank lines after a section."
- (let ((blanks (make-string 2 ?\n)))
- (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))
+ (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" "\n\n" headline))
-(defun org-texinfo--normalize-headlines (tree back-end info)
+(defun org-texinfo--normalize-headlines (tree _backend info)
"Normalize headlines in TREE.
BACK-END is the symbol specifying back-end used for export. INFO
@@ -435,76 +443,128 @@ Return new tree."
"Return a character not used in string S.
This is used to choose a separator for constructs like \\verb."
(let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}"))
- (loop for c across ll
- when (not (string-match (regexp-quote (char-to-string c)) s))
- return (char-to-string c))))
+ (cl-loop for c across ll
+ when (not (string-match (regexp-quote (char-to-string c)) s))
+ return (char-to-string c))))
-(defun org-texinfo--text-markup (text markup)
+(defun org-texinfo--text-markup (text markup _info)
"Format TEXT depending on MARKUP text markup.
-See `org-texinfo-text-markup-alist' for details."
- (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist))))
- (cond
- ;; No format string: Return raw text.
- ((not fmt) text)
- ((eq 'verb fmt)
- (let ((separator (org-texinfo--find-verb-separator text)))
- (concat "@verb{" separator text separator "}")))
- ((eq 'code fmt)
- (let ((start 0)
- (rtn "")
- char)
- (while (string-match "[@{}]" text)
- (setq char (match-string 0 text))
- (if (> (match-beginning 0) 0)
- (setq rtn (concat rtn (substring text 0 (match-beginning 0)))))
- (setq text (substring text (1+ (match-beginning 0))))
- (setq char (concat "@" char)
- rtn (concat rtn char)))
- (setq text (concat rtn text)
- fmt "@code{%s}")
- (format fmt text)))
- ;; Else use format string.
- (t (format fmt text)))))
-
-(defun org-texinfo--get-node (blob info)
- "Return node or anchor associated to BLOB.
-BLOB is an element or object. INFO is a plist used as
+INFO is a plist used as a communication channel. See
+`org-texinfo-text-markup-alist' for details."
+ (pcase (cdr (assq markup org-texinfo-text-markup-alist))
+ (`nil text) ;no markup: return raw text
+ (`code (format "@code{%s}" (org-texinfo--sanitize-content text)))
+ (`samp (format "@samp{%s}" (org-texinfo--sanitize-content text)))
+ (`verb
+ (let ((separator (org-texinfo--find-verb-separator text)))
+ (format "@verb{%s%s%s}" separator text separator)))
+ ;; Else use format string.
+ (fmt (format fmt text))))
+
+(defun org-texinfo--get-node (datum info)
+ "Return node or anchor associated to DATUM.
+DATUM is an element or object. INFO is a plist used as
a communication channel. The function guarantees the node or
anchor name is unique."
(let ((cache (plist-get info :texinfo-node-cache)))
- (or (cdr (assq blob cache))
- (let ((name
- (org-texinfo--sanitize-node
- (case (org-element-type blob)
- (headline
- (org-export-data (org-export-get-alt-title blob info) info))
- ((radio-target target) (org-element-property :value blob))
- (otherwise (or (org-element-property :name blob) ""))))))
- ;; Ensure NAME is unique.
- (while (rassoc name cache) (setq name (concat name "x")))
- (plist-put info :texinfo-node-cache (cons (cons blob name) cache))
+ (or (cdr (assq datum cache))
+ (let* ((salt 0)
+ (basename
+ (org-texinfo--sanitize-node
+ (if (eq (org-element-type datum) 'headline)
+ (org-texinfo--sanitize-title
+ (org-export-get-alt-title datum info) info)
+ (org-export-get-reference datum info))))
+ (name basename))
+ ;; Ensure NAME is unique and not reserved node name "Top".
+ (while (or (equal name "Top") (rassoc name cache))
+ (setq name (concat basename (format " %d" (cl-incf salt)))))
+ (plist-put info :texinfo-node-cache (cons (cons datum name) cache))
name))))
-;;;; Menu sanitizing
-
(defun org-texinfo--sanitize-node (title)
"Bend string TITLE to node line requirements.
Trim string and collapse multiple whitespace characters as they
-are not significant. Also remove the following characters: @
-{ } ( ) : . ,"
- (replace-regexp-in-string
- "[:,.]" ""
+are not significant. Replace leading left parenthesis, when
+followed by a right parenthesis, with a square bracket. Remove
+periods, commas and colons."
+ (org-trim
(replace-regexp-in-string
- "\\`(\\(.*)\\)" "[\\1"
- (org-trim (replace-regexp-in-string "[ \t]\\{2,\\}" " " title)))))
-
-;;;; Content sanitizing
+ "[ \t]+" " "
+ (replace-regexp-in-string
+ "[:,.]" ""
+ (replace-regexp-in-string "\\`(\\(.*?)\\)" "[\\1" title)))))
+
+(defun org-texinfo--sanitize-title (title info)
+ "Make TITLE suitable as a section name.
+TITLE is a string or a secondary string. INFO is the current
+export state, as a plist."
+ (org-export-data-with-backend
+ title
+ (org-export-create-backend
+ :parent 'texinfo
+ :transcoders '((footnote-reference . ignore)
+ (link . (lambda (l c i)
+ (or c
+ (org-export-data
+ (org-element-property :raw-link l)
+ i))))
+ (radio-target . (lambda (_r c _i) c))
+ (target . ignore)))
+ info))
(defun org-texinfo--sanitize-content (text)
"Escape special characters in string TEXT.
Special characters are: @ { }"
(replace-regexp-in-string "[@{}]" "@\\&" text))
+(defun org-texinfo--wrap-float (value info &optional type label caption short)
+ "Wrap string VALUE within a @float command.
+INFO is the current export state, as a plist. TYPE is float
+type, as a string. LABEL is the cross reference label for the
+float, as a string. CAPTION and SHORT are, respectively, the
+caption and shortcaption used for the float, as secondary
+strings (e.g., returned by `org-export-get-caption')."
+ (let* ((backend
+ (org-export-create-backend
+ :parent 'texinfo
+ :transcoders '((link . (lambda (l c i)
+ (or c
+ (org-export-data
+ (org-element-property :raw-link l)
+ i))))
+ (radio-target . (lambda (_r c _i) c))
+ (target . ignore))))
+ (short-backend
+ (org-export-create-backend
+ :parent 'texinfo
+ :transcoders
+ '((footnote-reference . ignore)
+ (inline-src-block . ignore)
+ (link . (lambda (l c i)
+ (or c
+ (org-export-data
+ (org-element-property :raw-link l)
+ i))))
+ (radio-target . (lambda (_r c _i) c))
+ (target . ignore)
+ (verbatim . ignore))))
+ (short-str
+ (if (and short caption)
+ (format "@shortcaption{%s}\n"
+ (org-export-data-with-backend short short-backend info))
+ ""))
+ (caption-str
+ (if (or short caption)
+ (format "@caption{%s}\n"
+ (org-export-data-with-backend
+ (or caption short)
+ (if (equal short-str "") short-backend backend)
+ info))
+ "")))
+ (format "@float %s%s\n%s\n%s%s@end float"
+ type (if label (concat "," label) "") value caption-str short-str)))
+
;;; Template
(defun org-texinfo-template (contents info)
@@ -537,7 +597,7 @@ holding export options."
(name (symbol-name (or org-texinfo-coding-system
buffer-file-coding-system))))
(dolist (system org-texinfo-supported-coding-systems "UTF-8")
- (when (org-string-match-p (regexp-quote system) name)
+ (when (string-match-p (regexp-quote system) name)
(throw 'coding-system system))))))
(language (plist-get info :language))
(case-fold-search nil))
@@ -574,7 +634,7 @@ holding export options."
(let ((dirdesc
(let ((desc (plist-get info :texinfo-dirdesc)))
(cond ((not desc) nil)
- ((org-string-match-p "\\.$" desc) desc)
+ ((string-suffix-p "." desc) desc)
(t (concat desc "."))))))
(if dirdesc (format "%-23s %s" dirtitle dirdesc) dirtitle))
"\n"
@@ -582,11 +642,14 @@ holding export options."
;; Title
"@finalout\n"
"@titlepage\n"
- (format "@title %s\n" (or (plist-get info :texinfo-printed-title) title))
- (let ((subtitle (plist-get info :subtitle)))
- (and subtitle
- (org-element-normalize-string
- (replace-regexp-in-string "^" "@subtitle " subtitle))))
+ (when (plist-get info :with-title)
+ (concat
+ (format "@title %s\n"
+ (or (plist-get info :texinfo-printed-title) title ""))
+ (let ((subtitle (plist-get info :subtitle)))
+ (when subtitle
+ (format "@subtitle %s\n"
+ (org-export-data subtitle info))))))
(when (plist-get info :with-author)
(concat
;; Primary author.
@@ -608,11 +671,17 @@ holding export options."
"@end titlepage\n\n"
;; Table of contents.
(and (plist-get info :with-toc) "@contents\n\n")
- ;; Configure Top Node when not for Tex
+ ;; Configure Top Node when not for TeX. Also include contents
+ ;; from the first section of the document.
"@ifnottex\n"
"@node Top\n"
(format "@top %s\n" title)
- (and copying "@insertcopying\n")
+ (let* ((first-section
+ (org-element-map (plist-get info :parse-tree) 'section
+ #'identity info t '(headline)))
+ (top-contents
+ (org-export-data (org-element-contents first-section) info)))
+ (and (org-string-nw-p top-contents) (concat "\n" top-contents)))
"@end ifnottex\n\n"
;; Menu.
(org-texinfo-make-menu (plist-get info :parse-tree) info 'master)
@@ -620,10 +689,8 @@ holding export options."
;; Document's body.
contents "\n"
;; Creator.
- (case (plist-get info :with-creator)
- ((nil) nil)
- (comment (format "@c %s\n" (plist-get info :creator)))
- (otherwise (concat (plist-get info :creator) "\n")))
+ (and (plist-get info :with-creator)
+ (concat (plist-get info :creator) "\n"))
;; Document end.
"@bye")))
@@ -633,15 +700,15 @@ holding export options."
;;;; Bold
-(defun org-texinfo-bold (bold contents info)
+(defun org-texinfo-bold (_bold contents info)
"Transcode BOLD from Org to Texinfo.
CONTENTS is the text with bold markup. INFO is a plist holding
contextual information."
- (org-texinfo--text-markup contents 'bold))
+ (org-texinfo--text-markup contents 'bold info))
;;;; Center Block
-(defun org-texinfo-center-block (center-block contents info)
+(defun org-texinfo-center-block (_center-block contents _info)
"Transcode a CENTER-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist used
as a communication channel."
@@ -649,28 +716,26 @@ as a communication channel."
;;;; Clock
-(defun org-texinfo-clock (clock contents info)
+(defun org-texinfo-clock (clock _contents info)
"Transcode a CLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
(concat
"@noindent"
(format "@strong{%s} " org-clock-string)
- (format org-texinfo-inactive-timestamp-format
- (concat (org-translate-time
- (org-element-property :raw-value
- (org-element-property :value clock)))
+ (format (plist-get info :texinfo-inactive-timestamp-format)
+ (concat (org-timestamp-translate (org-element-property :value clock))
(let ((time (org-element-property :duration clock)))
(and time (format " (%s)" time)))))
"@*"))
;;;; Code
-(defun org-texinfo-code (code contents info)
+(defun org-texinfo-code (code _contents info)
"Transcode a CODE object from Org to Texinfo.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-texinfo--text-markup (org-element-property :value code) 'code))
+ (org-texinfo--text-markup (org-element-property :value code) 'code info))
;;;; Drawer
@@ -679,13 +744,13 @@ channel."
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
(let* ((name (org-element-property :drawer-name drawer))
- (output (funcall org-texinfo-format-drawer-function
+ (output (funcall (plist-get info :texinfo-format-drawer-function)
name contents)))
output))
;;;; Dynamic Block
-(defun org-texinfo-dynamic-block (dynamic-block contents info)
+(defun org-texinfo-dynamic-block (_dynamic-block contents _info)
"Transcode a DYNAMIC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -693,33 +758,69 @@ holding contextual information."
;;;; Entity
-(defun org-texinfo-entity (entity contents info)
- "Transcode an ENTITY object from Org to Texinfo.
-CONTENTS are the definition itself. INFO is a plist holding
-contextual information."
- (let ((ent (org-element-property :latex entity)))
- (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent)))
+(defun org-texinfo-entity (entity _contents _info)
+ "Transcode an ENTITY object from Org to Texinfo."
+ ;; Since there is not specific Texinfo entry in entities, use
+ ;; Texinfo-specific commands whenever possible, and fallback to
+ ;; UTF-8 otherwise.
+ (pcase (org-element-property :name entity)
+ ("AElig" "@AE{}")
+ ("aelig" "@ae{}")
+ ((or "bull" "bullet") "@bullet{}")
+ ("copy" "@copyright{}")
+ ("deg" "@textdegree{}")
+ ((or "dots" "hellip") "@dots{}")
+ ("equiv" "@equiv{}")
+ ((or "euro" "EUR") "@euro{}")
+ ((or "ge" "geq") "@geq{}")
+ ("laquo" "@guillemetleft{}")
+ ("iexcl" "@exclamdown{}")
+ ("imath" "@dotless{i}")
+ ("iquest" "@questiondown{}")
+ ("jmath" "@dotless{j}")
+ ((or "le" "leq") "@leq{}")
+ ("lsaquo" "@guilsinglleft{}")
+ ("mdash" "---")
+ ("minus" "@minus{}")
+ ("nbsp" "@tie{}")
+ ("ndash" "--")
+ ("OElig" "@OE{}")
+ ("oelig" "@oe{}")
+ ("ordf" "@ordf{}")
+ ("ordm" "@ordm{}")
+ ("pound" "@pound{}")
+ ("raquo" "@guillemetright{}")
+ ((or "rArr" "Rightarrow") "@result{}")
+ ("reg" "@registeredsymbol{}")
+ ((or "rightarrow" "to" "rarr") "@arrow{}")
+ ("rsaquo" "@guilsinglright{}")
+ ("thorn" "@th{}")
+ ("THORN" "@TH{}")
+ ((and (pred (string-prefix-p "_")) name) ;spacing entities
+ (format "@w{%s}" (substring name 1)))
+ (_ (org-element-property :utf-8 entity))))
;;;; Example Block
-(defun org-texinfo-example-block (example-block contents info)
+(defun org-texinfo-example-block (example-block _contents info)
"Transcode an EXAMPLE-BLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "@verbatim\n%s@end verbatim"
- (org-export-format-code-default example-block info)))
+ (format "@example\n%s@end example"
+ (org-texinfo--sanitize-content
+ (org-export-format-code-default example-block info))))
-;;;; Export Block
+;;; Export Block
-(defun org-texinfo-export-block (export-block contents info)
+(defun org-texinfo-export-block (export-block _contents _info)
"Transcode a EXPORT-BLOCK element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (string= (org-element-property :type export-block) "TEXINFO")
(org-remove-indentation (org-element-property :value export-block))))
-;;;; Export Snippet
+;;; Export Snippet
-(defun org-texinfo-export-snippet (export-snippet contents info)
+(defun org-texinfo-export-snippet (export-snippet _contents _info)
"Transcode a EXPORT-SNIPPET object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(when (eq (org-export-snippet-backend export-snippet) 'texinfo)
@@ -727,17 +828,17 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;;;; Fixed Width
-(defun org-texinfo-fixed-width (fixed-width contents info)
+(defun org-texinfo-fixed-width (fixed-width _contents _info)
"Transcode a FIXED-WIDTH element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
- (format "@example\n%s\n@end example"
+ (format "@example\n%s@end example"
(org-remove-indentation
(org-texinfo--sanitize-content
(org-element-property :value fixed-width)))))
;;;; Footnote Reference
-(defun org-texinfo-footnote-reference (footnote contents info)
+(defun org-texinfo-footnote-reference (footnote _contents info)
"Create a footnote reference for FOOTNOTE.
FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a
@@ -748,102 +849,94 @@ plist holding contextual information."
;;;; Headline
+(defun org-texinfo--structuring-command (headline info)
+ "Return Texinfo structuring command string for HEADLINE element.
+Return nil if HEADLINE is to be ignored, `plain-list' if it
+should be exported as a plain-list item. INFO is a plist holding
+contextual information."
+ (cond
+ ((org-element-property :footnote-section-p headline) nil)
+ ((org-not-nil (org-export-get-node-property :COPYING headline t)) nil)
+ ((org-export-low-level-p headline info) 'plain-list)
+ (t
+ (let ((class (plist-get info :texinfo-class)))
+ (pcase (assoc class (plist-get info :texinfo-classes))
+ (`(,_ ,_ . ,sections)
+ (pcase (nth (1- (org-export-get-relative-level headline info))
+ sections)
+ (`(,numbered ,unnumbered ,appendix)
+ (cond
+ ((org-not-nil (org-export-get-node-property :APPENDIX headline t))
+ appendix)
+ ((org-not-nil (org-export-get-node-property :INDEX headline t))
+ unnumbered)
+ ((org-export-numbered-headline-p headline info) numbered)
+ (t unnumbered)))
+ (`nil 'plain-list)
+ (_ (user-error "Invalid Texinfo class specification: %S" class))))
+ (_ (user-error "Invalid Texinfo class specification: %S" class)))))))
+
(defun org-texinfo-headline (headline contents info)
"Transcode a HEADLINE element from Org to Texinfo.
CONTENTS holds the contents of the headline. INFO is a plist
holding contextual information."
- (let* ((class (plist-get info :texinfo-class))
- (level (org-export-get-relative-level headline info))
- (numberedp (org-export-numbered-headline-p headline info))
- (class-sectioning (assoc class org-texinfo-classes))
- ;; Find the index type, if any.
- (index (org-element-property :INDEX headline))
- ;; Create node info, to insert it before section formatting.
- ;; Use custom menu title if present.
- (node (format "@node %s\n" (org-texinfo--get-node headline info)))
- ;; Section formatting will set two placeholders: one for the
- ;; title and the other for the contents.
- (section-fmt
- (if (org-not-nil (org-element-property :APPENDIX headline))
- "@appendix %s\n%s"
- (let ((sec (if (and (symbolp (nth 2 class-sectioning))
- (fboundp (nth 2 class-sectioning)))
- (funcall (nth 2 class-sectioning) level numberedp)
- (nth (1+ level) class-sectioning))))
- (cond
- ;; No section available for that LEVEL.
- ((not sec) nil)
- ;; Section format directly returned by a function.
- ((stringp sec) sec)
- ;; (numbered-section . unnumbered-section)
- ((not (consp (cdr sec)))
- (concat (if (or index (not numberedp)) (cdr sec) (car sec))
- "\n%s"))))))
- (todo
- (and (plist-get info :with-todo-keywords)
- (let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data todo info)))))
- (todo-type (and todo (org-element-property :todo-type headline)))
- (tags (and (plist-get info :with-tags)
- (org-export-get-tags headline info)))
- (priority (and (plist-get info :with-priority)
- (org-element-property :priority headline)))
- (text (org-export-data (org-element-property :title headline) info))
- (full-text (if (not (eq org-texinfo-format-headline-function 'ignore))
- ;; User-defined formatting function.
- (funcall org-texinfo-format-headline-function
- todo todo-type priority text tags)
- ;; Default formatting.
- (concat
- (when todo
- (format "@strong{%s} " todo))
- (when priority (format "@emph{#%s} " priority))
- text
- (when tags
- (format " :%s:"
- (mapconcat 'identity tags ":"))))))
- (contents (if (org-string-nw-p contents) (concat "\n" contents) "")))
- (cond
- ;; Case 1: This is a footnote section: ignore it.
- ((org-element-property :footnote-section-p headline) nil)
- ;; Case 2: This is the `copying' section: ignore it
- ;; This is used elsewhere.
- ((org-not-nil (org-element-property :COPYING headline)) nil)
- ;; Case 3: An index. If it matches one of the known indexes,
- ;; print it as such following the contents, otherwise
- ;; print the contents and leave the index up to the user.
- (index
- (concat node
- (format
- section-fmt
- full-text
- (concat contents
- (and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
- (concat "\n@printindex " index))))))
- ;; Case 4: This is a deep sub-tree: export it as a list item.
- ;; Also export as items headlines for which no section
- ;; format has been found.
- ((or (not section-fmt) (org-export-low-level-p headline info))
- ;; Build the real contents of the sub-tree.
- (concat (and (org-export-first-sibling-p headline info)
- (format "@%s\n" (if numberedp 'enumerate 'itemize)))
- "@item\n" full-text "\n"
- contents
- (if (org-export-last-sibling-p headline info)
- (format "@end %s" (if numberedp 'enumerate 'itemize))
- "\n")))
- ;; Case 5: Standard headline. Export it as a section.
- (t (concat node (format section-fmt full-text contents))))))
+ (let ((section-fmt (org-texinfo--structuring-command headline info)))
+ (when section-fmt
+ (let* ((todo
+ (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword headline)))
+ (and todo (org-export-data todo info)))))
+ (todo-type (and todo (org-element-property :todo-type headline)))
+ (tags (and (plist-get info :with-tags)
+ (org-export-get-tags headline info)))
+ (priority (and (plist-get info :with-priority)
+ (org-element-property :priority headline)))
+ (text (org-texinfo--sanitize-title
+ (org-element-property :title headline) info))
+ (full-text
+ (funcall (plist-get info :texinfo-format-headline-function)
+ todo todo-type priority text tags))
+ (contents
+ (concat "\n"
+ (if (org-string-nw-p contents)
+ (concat "\n" contents)
+ "")
+ (let ((index (org-element-property :INDEX headline)))
+ (and (member index '("cp" "fn" "ky" "pg" "tp" "vr"))
+ (format "\n@printindex %s\n" index))))))
+ (cond
+ ((eq section-fmt 'plain-list)
+ (let ((numbered? (org-export-numbered-headline-p headline info)))
+ (concat (and (org-export-first-sibling-p headline info)
+ (format "@%s\n" (if numbered? 'enumerate 'itemize)))
+ "@item\n" full-text "\n"
+ contents
+ (if (org-export-last-sibling-p headline info)
+ (format "@end %s" (if numbered? 'enumerate 'itemize))
+ "\n"))))
+ (t
+ (concat (format "@node %s\n" (org-texinfo--get-node headline info))
+ (format section-fmt full-text)
+ contents)))))))
+
+(defun org-texinfo-format-headline-default-function
+ (todo _todo-type priority text tags)
+ "Default format function for a headline.
+See `org-texinfo-format-headline-function' for details."
+ (concat (when todo (format "@strong{%s} " todo))
+ (when priority (format "@emph{#%s} " priority))
+ text
+ (when tags (format " :%s:" (mapconcat 'identity tags ":")))))
;;;; Inline Src Block
-(defun org-texinfo-inline-src-block (inline-src-block contents info)
+(defun org-texinfo-inline-src-block (inline-src-block _contents _info)
"Transcode an INLINE-SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let* ((code (org-element-property :value inline-src-block))
- (separator (org-texinfo--find-verb-separator code)))
- (concat "@verb{" separator code separator "}")))
+ (format "@code{%s}"
+ (org-texinfo--sanitize-content
+ (org-element-property :value inline-src-block))))
;;;; Inlinetask
@@ -860,31 +953,27 @@ holding contextual information."
(org-export-get-tags inlinetask info)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority inlinetask))))
- ;; If `org-texinfo-format-inlinetask-function' is provided, call it
- ;; with appropriate arguments.
- (if (not (eq org-texinfo-format-inlinetask-function 'ignore))
- (funcall org-texinfo-format-inlinetask-function
- todo todo-type priority title tags contents)
- ;; Otherwise, use a default template.
- (let ((full-title
- (concat
- (when todo (format "@strong{%s} " todo))
- (when priority (format "#%c " priority))
- title
- (when tags (format ":%s:"
- (mapconcat 'identity tags ":"))))))
- (format (concat "@center %s\n\n"
- "%s"
- "\n")
- full-title contents)))))
+ (funcall (plist-get info :texinfo-format-inlinetask-function)
+ todo todo-type priority title tags contents)))
+
+(defun org-texinfo-format-inlinetask-default-function
+ (todo _todo-type priority title tags contents)
+ "Default format function for a inlinetasks.
+See `org-texinfo-format-inlinetask-function' for details."
+ (let ((full-title
+ (concat (when todo (format "@strong{%s} " todo))
+ (when priority (format "#%c " priority))
+ title
+ (when tags (format ":%s:" (mapconcat #'identity tags ":"))))))
+ (format "@center %s\n\n%s\n" full-title contents)))
;;;; Italic
-(defun org-texinfo-italic (italic contents info)
+(defun org-texinfo-italic (_italic contents info)
"Transcode ITALIC from Org to Texinfo.
CONTENTS is the text with italic markup. INFO is a plist holding
contextual information."
- (org-texinfo--text-markup contents 'italic))
+ (org-texinfo--text-markup contents 'italic info))
;;;; Item
@@ -892,39 +981,76 @@ contextual information."
"Transcode an ITEM element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (format "@item%s\n%s"
- (let ((tag (org-element-property :tag item)))
- (if tag (concat " " (org-export-data tag info)) ""))
- (or contents "")))
+ (let* ((tag (org-element-property :tag item))
+ (split (org-string-nw-p
+ (org-export-read-attribute :attr_texinfo
+ (org-element-property :parent item)
+ :sep)))
+ (items (and tag
+ (let ((tag (org-export-data tag info)))
+ (if split
+ (split-string tag (regexp-quote split) t "[ \t\n]+")
+ (list tag))))))
+ (format "%s\n%s"
+ (pcase items
+ (`nil "@item")
+ (`(,item) (concat "@item " item))
+ (`(,item . ,items)
+ (concat "@item " item "\n"
+ (mapconcat (lambda (i) (concat "@itemx " i))
+ items
+ "\n"))))
+ (or contents ""))))
;;;; Keyword
-(defun org-texinfo-keyword (keyword contents info)
+(defun org-texinfo-keyword (keyword _contents info)
"Transcode a KEYWORD element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((key (org-element-property :key keyword))
- (value (org-element-property :value keyword)))
- (cond
- ((string= key "TEXINFO") value)
- ((string= key "CINDEX") (format "@cindex %s" value))
- ((string= key "FINDEX") (format "@findex %s" value))
- ((string= key "KINDEX") (format "@kindex %s" value))
- ((string= key "PINDEX") (format "@pindex %s" value))
- ((string= key "TINDEX") (format "@tindex %s" value))
- ((string= key "VINDEX") (format "@vindex %s" value)))))
+ (let ((value (org-element-property :value keyword)))
+ (pcase (org-element-property :key keyword)
+ ("TEXINFO" value)
+ ("CINDEX" (format "@cindex %s" value))
+ ("FINDEX" (format "@findex %s" value))
+ ("KINDEX" (format "@kindex %s" value))
+ ("PINDEX" (format "@pindex %s" value))
+ ("TINDEX" (format "@tindex %s" value))
+ ("VINDEX" (format "@vindex %s" value))
+ ("TOC"
+ (cond ((string-match-p "\\<tables\\>" value)
+ (concat "@listoffloats "
+ (org-export-translate "Table" :utf-8 info)))
+ ((string-match-p "\\<listings\\>" value)
+ (concat "@listoffloats "
+ (org-export-translate "Listing" :utf-8 info))))))))
;;;; Line Break
-(defun org-texinfo-line-break (line-break contents info)
+(defun org-texinfo-line-break (_line-break _contents _info)
"Transcode a LINE-BREAK object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
"@*\n")
;;;; Link
+(defun org-texinfo--@ref (datum description info)
+ "Return @ref command for element or object DATUM.
+DESCRIPTION is the printed name of the section, as a string, or
+nil."
+ (let ((node-name (org-texinfo--get-node datum info))
+ ;; Sanitize DESCRIPTION for cross-reference use. In
+ ;; particular, remove colons as they seem to cause pain (even
+ ;; within @asis{...}) to the Texinfo reader.
+ (title (and description
+ (replace-regexp-in-string
+ "[ \t]*:+" ""
+ (replace-regexp-in-string "," "@comma{}" description)))))
+ (if (or (not title) (equal title node-name))
+ (format "@ref{%s}" node-name)
+ (format "@ref{%s, , %s}" node-name title))))
+
(defun org-texinfo-link (link desc info)
"Transcode a LINK object from Org to Texinfo.
-
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
@@ -935,78 +1061,81 @@ INFO is a plist holding contextual information. See
(path (cond
((member type '("http" "https" "ftp"))
(concat type ":" raw-path))
- ((and (string= type "file") (file-name-absolute-p raw-path))
- (concat "file:" raw-path))
- (t raw-path)))
- protocol)
+ ((string= type "file") (org-export-file-uri raw-path))
+ (t raw-path))))
(cond
+ ((org-export-custom-protocol-maybe link desc 'texinfo))
+ ((org-export-inline-image-p link org-texinfo-inline-image-rules)
+ (org-texinfo--inline-image link info))
((equal type "radio")
(let ((destination (org-export-resolve-radio-link link info)))
(if (not destination) desc
- (format "@ref{%s,,%s}"
- (org-texinfo--get-node destination info)
- desc))))
+ (org-texinfo--@ref destination desc info))))
((member type '("custom-id" "id" "fuzzy"))
(let ((destination
(if (equal type "fuzzy")
(org-export-resolve-fuzzy-link link info)
(org-export-resolve-id-link link info))))
- (case (org-element-type destination)
- ((nil)
+ (pcase (org-element-type destination)
+ (`nil
(format org-texinfo-link-with-unknown-path-format
(org-texinfo--sanitize-content path)))
;; Id link points to an external file.
- (plain-text
+ (`plain-text
(if desc (format "@uref{file://%s,%s}" destination desc)
(format "@uref{file://%s}" destination)))
- (headline
- (format "@ref{%s,%s}"
- (org-texinfo--get-node destination info)
- (cond
- (desc)
- ((org-export-numbered-headline-p destination info)
- (org-export-data
- (org-element-property :title destination) info))
- (t
- (mapconcat
- #'number-to-string
- (org-export-get-headline-number destination info) ".")))))
- (otherwise
- (let ((topic
- (or desc
- (if (and (eq (org-element-type destination) 'headline)
- (not (org-export-numbered-headline-p
- destination info)))
- (org-export-data
- (org-element-property :title destination) info))
- (let ((n (org-export-get-ordinal destination info)))
- (cond
- ((not n) nil)
- ((integerp n) n)
- (t (mapconcat #'number-to-string n ".")))))))
- (when topic
- (format "@ref{%s,,%s}"
- (org-texinfo--get-node destination info)
- topic)))))))
- ((equal type "info")
- (let* ((info-path (split-string path "[:#]"))
- (info-manual (car info-path))
- (info-node (or (cadr info-path) "top"))
- (title (or desc "")))
- (format "@ref{%s,%s,,%s,}" info-node title info-manual)))
+ ((or `headline
+ ;; Targets within headlines cannot be turned into
+ ;; @anchor{}, so we refer to the headline parent
+ ;; directly.
+ (and `target
+ (guard (eq 'headline
+ (org-element-type
+ (org-element-property :parent destination))))))
+ (let ((headline (org-element-lineage destination '(headline) t)))
+ (org-texinfo--@ref headline desc info)))
+ (_ (org-texinfo--@ref destination desc info)))))
((string= type "mailto")
(format "@email{%s}"
(concat (org-texinfo--sanitize-content path)
- (and desc (concat "," desc)))))
- ((let ((protocol (nth 2 (assoc type org-link-protocols))))
- (and (functionp protocol)
- (funcall protocol (org-link-unescape path) desc 'texinfo))))
+ (and desc (concat ", " desc)))))
;; External link with a description part.
- ((and path desc) (format "@uref{%s,%s}" path desc))
+ ((and path desc) (format "@uref{%s, %s}" path desc))
;; External link without a description part.
(path (format "@uref{%s}" path))
;; No path, only description. Try to do something useful.
- (t (format org-texinfo-link-with-unknown-path-format desc)))))
+ (t
+ (format (plist-get info :texinfo-link-with-unknown-path-format) desc)))))
+
+(defun org-texinfo--inline-image (link info)
+ "Return Texinfo code for an inline image.
+LINK is the link pointing to the inline image. INFO is the
+current state of the export, as a plist."
+ (let* ((parent (org-export-get-parent-element link))
+ (label (and (org-element-property :name parent)
+ (org-texinfo--get-node parent info)))
+ (caption (org-export-get-caption parent))
+ (shortcaption (org-export-get-caption parent t))
+ (path (org-element-property :path link))
+ (filename
+ (file-name-sans-extension
+ (if (file-name-absolute-p path) (expand-file-name path) path)))
+ (extension (file-name-extension path))
+ (attributes (org-export-read-attribute :attr_texinfo parent))
+ (height (or (plist-get attributes :height) ""))
+ (width (or (plist-get attributes :width) ""))
+ (alt (or (plist-get attributes :alt) ""))
+ (image (format "@image{%s,%s,%s,%s,%s}"
+ filename width height alt extension)))
+ (cond ((or caption shortcaption)
+ (org-texinfo--wrap-float image
+ info
+ (org-export-translate "Figure" :utf-8 info)
+ label
+ caption
+ shortcaption))
+ (label (concat "@anchor{" label "}\n" image))
+ (t image))))
;;;; Menu
@@ -1046,19 +1175,19 @@ is an integer, build the menu recursively, down to this depth."
(cond
((not level)
(org-texinfo--format-entries (org-texinfo--menu-entries scope info) info))
- ((zerop level) nil)
+ ((zerop level) "\n")
(t
- (org-element-normalize-string
- (mapconcat
- (lambda (h)
- (let ((entries (org-texinfo--menu-entries h info)))
- (when entries
- (concat
- (format "%s\n\n%s\n"
- (org-export-data (org-export-get-alt-title h info) info)
- (org-texinfo--format-entries entries info))
- (org-texinfo--build-menu h info (1- level))))))
- (org-texinfo--menu-entries scope info) "")))))
+ (mapconcat
+ (lambda (h)
+ (let ((entries (org-texinfo--menu-entries h info)))
+ (when entries
+ (concat
+ (format "%s\n\n%s\n"
+ (org-export-data (org-export-get-alt-title h info) info)
+ (org-texinfo--format-entries entries info))
+ (org-texinfo--build-menu h info (1- level))))))
+ (org-texinfo--menu-entries scope info)
+ ""))))
(defun org-texinfo--format-entries (entries info)
"Format all direct menu entries in SCOPE, as a string.
@@ -1067,8 +1196,13 @@ a plist containing contextual information."
(org-element-normalize-string
(mapconcat
(lambda (h)
- (let* ((title (org-export-data
- (org-export-get-alt-title h info) info))
+ (let* ((title
+ ;; Colons are used as a separator between title and node
+ ;; name. Remove them.
+ (replace-regexp-in-string
+ "[ \t]+:+" ""
+ (org-texinfo--sanitize-title
+ (org-export-get-alt-title h info) info)))
(node (org-texinfo--get-node h info))
(entry (concat "* " title ":"
(if (string= title node) ":"
@@ -1090,18 +1224,26 @@ holding contextual information."
(cached-entries (gethash scope cache 'no-cache)))
(if (not (eq cached-entries 'no-cache)) cached-entries
(puthash scope
- (org-element-map (org-element-contents scope) 'headline
- (lambda (h)
- (and (not (org-not-nil (org-element-property :COPYING h)))
- (not (org-element-property :footnote-section-p h))
- (not (org-export-low-level-p h info))
- h))
- info nil 'headline)
+ (cl-remove-if
+ (lambda (h)
+ (org-not-nil (org-export-get-node-property :COPYING h t)))
+ (org-export-collect-headlines info 1 scope))
cache))))
+;;;; Node Property
+
+(defun org-texinfo-node-property (node-property _contents _info)
+ "Transcode a NODE-PROPERTY element from Org to Texinfo.
+CONTENTS is nil. INFO is a plist holding contextual
+information."
+ (format "%s:%s"
+ (org-element-property :key node-property)
+ (let ((value (org-element-property :value node-property)))
+ (if value (concat " " value) ""))))
+
;;;; Paragraph
-(defun org-texinfo-paragraph (paragraph contents info)
+(defun org-texinfo-paragraph (_paragraph contents _info)
"Transcode a PARAGRAPH element from Org to Texinfo.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
@@ -1114,7 +1256,10 @@ the plist used as a communication channel."
CONTENTS is the contents of the list. INFO is a plist holding
contextual information."
(let* ((attr (org-export-read-attribute :attr_texinfo plain-list))
- (indic (or (plist-get attr :indic) org-texinfo-def-table-markup))
+ (indic (let ((i (or (plist-get attr :indic)
+ (plist-get info :texinfo-table-default-markup))))
+ ;; Allow indicating commands with missing @ sign.
+ (if (string-prefix-p "@" i) i (concat "@" i))))
(table-type (plist-get attr :table-type))
(type (org-element-property :type plain-list))
(list-type (cond
@@ -1141,16 +1286,14 @@ contextual information."
(setq output
(org-export-activate-smart-quotes output :texinfo info text)))
;; LaTeX into @LaTeX{} and TeX into @TeX{}
- (let ((case-fold-search nil)
- (start 0))
- (while (string-match "\\(\\(?:La\\)?TeX\\)" output start)
- (setq output (replace-match
- (format "@%s{}" (match-string 1 output)) nil t output)
- start (match-end 0))))
+ (let ((case-fold-search nil))
+ (setq output (replace-regexp-in-string "\\(?:La\\)?TeX" "@\\&{}" output)))
;; Convert special strings.
(when (plist-get info :with-special-strings)
- (while (string-match (regexp-quote "...") output)
- (setq output (replace-match "@dots{}" nil t output))))
+ (setq output
+ (replace-regexp-in-string
+ "\\.\\.\\." "@dots{}"
+ (replace-regexp-in-string "\\\\-" "@-" output))))
;; Handle break preservation if required.
(when (plist-get info :preserve-breaks)
(setq output (replace-regexp-in-string
@@ -1160,7 +1303,7 @@ contextual information."
;;;; Planning
-(defun org-texinfo-planning (planning contents info)
+(defun org-texinfo-planning (planning _contents info)
"Transcode a PLANNING element from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
@@ -1174,39 +1317,35 @@ information."
(when closed
(concat
(format "@strong{%s} " org-closed-string)
- (format org-texinfo-inactive-timestamp-format
- (org-translate-time
- (org-element-property :raw-value closed))))))
+ (format (plist-get info :texinfo-inactive-timestamp-format)
+ (org-timestamp-translate closed)))))
(let ((deadline (org-element-property :deadline planning)))
(when deadline
(concat
(format "@strong{%s} " org-deadline-string)
- (format org-texinfo-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value deadline))))))
+ (format (plist-get info :texinfo-active-timestamp-format)
+ (org-timestamp-translate deadline)))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
(concat
(format "@strong{%s} " org-scheduled-string)
- (format org-texinfo-active-timestamp-format
- (org-translate-time
- (org-element-property :raw-value scheduled))))))))
+ (format (plist-get info :texinfo-active-timestamp-format)
+ (org-timestamp-translate scheduled)))))))
" ")
"@*"))
;;;; Property Drawer
-(defun org-texinfo-property-drawer (property-drawer contents info)
+(defun org-texinfo-property-drawer (_property-drawer contents _info)
"Transcode a PROPERTY-DRAWER element from Org to Texinfo.
-CONTENTS is nil. INFO is a plist holding contextual
-information."
- ;; The property drawer isn't exported but we want separating blank
- ;; lines nonetheless.
- "")
+CONTENTS holds the contents of the drawer. INFO is a plist
+holding contextual information."
+ (and (org-string-nw-p contents)
+ (format "@verbatim\n%s@end verbatim" contents)))
;;;; Quote Block
-(defun org-texinfo-quote-block (quote-block contents info)
+(defun org-texinfo-quote-block (quote-block contents _info)
"Transcode a QUOTE-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
@@ -1216,15 +1355,6 @@ holding contextual information."
(format " %s" title)))))
(format "%s\n%s@end quotation" start-quote contents)))
-;;;; Quote Section
-
-(defun org-texinfo-quote-section (quote-section contents info)
- "Transcode a QUOTE-SECTION element from Org to Texinfo.
-CONTENTS is nil. INFO is a plist holding contextual information."
- (let ((value (org-remove-indentation
- (org-element-property :value quote-section))))
- (when value (format "@verbatim\n%s@end verbatim" value))))
-
;;;; Radio Target
(defun org-texinfo-radio-target (radio-target text info)
@@ -1232,8 +1362,7 @@ CONTENTS is nil. INFO is a plist holding contextual information."
TEXT is the text of the target. INFO is a plist holding
contextual information."
(format "@anchor{%s}%s"
- (org-export-solidify-link-text
- (org-element-property :value radio-target))
+ (org-texinfo--get-node radio-target info)
text))
;;;; Section
@@ -1242,40 +1371,67 @@ contextual information."
"Transcode a SECTION element from Org to Texinfo.
CONTENTS holds the contents of the section. INFO is a plist
holding contextual information."
- (concat contents
- (let ((parent (org-export-get-parent-headline section)))
- (and parent (org-texinfo-make-menu parent info)))))
+ (let ((parent (org-export-get-parent-headline section)))
+ (when parent ;ignore very first section
+ (org-trim
+ (concat contents "\n" (org-texinfo-make-menu parent info))))))
;;;; Special Block
-(defun org-texinfo-special-block (special-block contents info)
+(defun org-texinfo-special-block (special-block contents _info)
"Transcode a SPECIAL-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the block. INFO is a plist used
as a communication channel."
- contents)
+ (let ((opt (org-export-read-attribute :attr_texinfo special-block :options))
+ (type (org-element-property :type special-block)))
+ (format "@%s%s\n%s@end %s"
+ type
+ (if opt (concat " " opt) "")
+ (or contents "")
+ type)))
;;;; Src Block
-(defun org-texinfo-src-block (src-block contents info)
+(defun org-texinfo-src-block (src-block _contents info)
"Transcode a SRC-BLOCK element from Org to Texinfo.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- (let ((lispp (org-string-match-p "lisp"
- (org-element-property :language src-block)))
- (code (org-texinfo--sanitize-content
- (org-export-format-code-default src-block info))))
- (format (if lispp "@lisp\n%s@end lisp" "@example\n%s@end example") code)))
+ (let* ((lisp (string-match-p "lisp"
+ (org-element-property :language src-block)))
+ (code (org-texinfo--sanitize-content
+ (org-export-format-code-default src-block info)))
+ (value (format
+ (if lisp "@lisp\n%s@end lisp" "@example\n%s@end example")
+ code))
+ (caption (org-export-get-caption src-block))
+ (shortcaption (org-export-get-caption src-block t)))
+ (if (not (or caption shortcaption)) value
+ (org-texinfo--wrap-float value
+ info
+ (org-export-translate "Listing" :utf-8 info)
+ (org-texinfo--get-node src-block info)
+ caption
+ shortcaption))))
;;;; Statistics Cookie
-(defun org-texinfo-statistics-cookie (statistics-cookie contents info)
+(defun org-texinfo-statistics-cookie (statistics-cookie _contents _info)
"Transcode a STATISTICS-COOKIE object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual information."
(org-element-property :value statistics-cookie))
+
+;;;; Strike-through
+
+(defun org-texinfo-strike-through (_strike-through contents info)
+ "Transcode STRIKE-THROUGH from Org to Texinfo.
+CONTENTS is the text with strike-through markup. INFO is a plist
+holding contextual information."
+ (org-texinfo--text-markup contents 'strike-through info))
+
;;;; Subscript
-(defun org-texinfo-subscript (subscript contents info)
+(defun org-texinfo-subscript (_subscript contents _info)
"Transcode a SUBSCRIPT object from Org to Texinfo.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1283,7 +1439,7 @@ contextual information."
;;;; Superscript
-(defun org-texinfo-superscript (superscript contents info)
+(defun org-texinfo-superscript (_superscript contents _info)
"Transcode a SUPERSCRIPT object from Org to Texinfo.
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
@@ -1302,10 +1458,19 @@ contextual information."
(let* ((col-width (org-export-read-attribute :attr_texinfo table :columns))
(columns
(if col-width (format "@columnfractions %s" col-width)
- (org-texinfo-table-column-widths table info))))
- (format "@multitable %s\n%s@end multitable"
- columns
- contents))))
+ (org-texinfo-table-column-widths table info)))
+ (caption (org-export-get-caption table))
+ (shortcaption (org-export-get-caption table t))
+ (table-str (format "@multitable %s\n%s@end multitable"
+ columns
+ contents)))
+ (if (not (or caption shortcaption)) table-str
+ (org-texinfo--wrap-float table-str
+ info
+ (org-export-translate "Table" :utf-8 info)
+ (org-texinfo--get-node table info)
+ caption
+ shortcaption)))))
(defun org-texinfo-table-column-widths (table info)
"Determine the largest table cell in each column to process alignment.
@@ -1324,7 +1489,7 @@ a communication channel."
(let ((w (- (org-element-property :contents-end cell)
(org-element-property :contents-begin cell))))
(aset widths idx (max w (aref widths idx))))
- (incf idx))
+ (cl-incf idx))
info)))
info)
(format "{%s}" (mapconcat (lambda (w) (make-string w ?a)) widths "} {"))))
@@ -1335,16 +1500,18 @@ a communication channel."
"Transcode a TABLE-CELL element from Org to Texinfo.
CONTENTS is the cell contents. INFO is a plist used as
a communication channel."
- (concat (if (and contents
- org-texinfo-table-scientific-notation
- (string-match orgtbl-exp-regexp contents))
- ;; Use appropriate format string for scientific
- ;; notation.
- (format org-texinfo-table-scientific-notation
- (match-string 1 contents)
- (match-string 2 contents))
- contents)
- (when (org-export-get-next-element table-cell info) "\n@tab ")))
+ (concat
+ (let ((scientific-notation
+ (plist-get info :texinfo-table-scientific-notation)))
+ (if (and contents
+ scientific-notation
+ (string-match orgtbl-exp-regexp contents))
+ ;; Use appropriate format string for scientific notation.
+ (format scientific-notation
+ (match-string 1 contents)
+ (match-string 2 contents))
+ contents))
+ (when (org-export-get-next-element table-cell info) "\n@tab ")))
;;;; Table Row
@@ -1365,39 +1532,47 @@ a communication channel."
;;;; Target
-(defun org-texinfo-target (target contents info)
+(defun org-texinfo-target (target _contents info)
"Transcode a TARGET object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
- (format "@anchor{%s}"
- (org-export-solidify-link-text (org-element-property :value target))))
+ (format "@anchor{%s}" (org-texinfo--get-node target info)))
;;;; Timestamp
-(defun org-texinfo-timestamp (timestamp contents info)
+(defun org-texinfo-timestamp (timestamp _contents info)
"Transcode a TIMESTAMP object from Org to Texinfo.
CONTENTS is nil. INFO is a plist holding contextual
information."
(let ((value (org-texinfo-plain-text
(org-timestamp-translate timestamp) info)))
- (case (org-element-property :type timestamp)
- ((active active-range)
- (format org-texinfo-active-timestamp-format value))
- ((inactive inactive-range)
- (format org-texinfo-inactive-timestamp-format value))
- (t (format org-texinfo-diary-timestamp-format value)))))
+ (pcase (org-element-property :type timestamp)
+ ((or `active `active-range)
+ (format (plist-get info :texinfo-active-timestamp-format) value))
+ ((or `inactive `inactive-range)
+ (format (plist-get info :texinfo-inactive-timestamp-format) value))
+ (_ (format (plist-get info :texinfo-diary-timestamp-format) value)))))
+
+;;;; Underline
+
+(defun org-texinfo-underline (_underline contents info)
+ "Transcode UNDERLINE from Org to Texinfo.
+CONTENTS is the text with underline markup. INFO is a plist
+holding contextual information."
+ (org-texinfo--text-markup contents 'underline info))
;;;; Verbatim
-(defun org-texinfo-verbatim (verbatim contents info)
+(defun org-texinfo-verbatim (verbatim _contents info)
"Transcode a VERBATIM object from Org to Texinfo.
CONTENTS is nil. INFO is a plist used as a communication
channel."
- (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim))
+ (org-texinfo--text-markup
+ (org-element-property :value verbatim) 'verbatim info))
;;;; Verse Block
-(defun org-texinfo-verse-block (verse-block contents info)
+(defun org-texinfo-verse-block (_verse-block contents _info)
"Transcode a VERSE-BLOCK element from Org to Texinfo.
CONTENTS is verse block contents. INFO is a plist holding
contextual information."
@@ -1406,6 +1581,7 @@ contextual information."
;;; Interactive functions
+;;;###autoload
(defun org-texinfo-export-to-texinfo
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to a Texinfo file.
@@ -1436,10 +1612,11 @@ file-local settings.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".texi" subtreep))
- (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-coding-system org-texinfo-coding-system))
(org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist)))
+;;;###autoload
(defun org-texinfo-export-to-info
(&optional async subtreep visible-only body-only ext-plist)
"Export current buffer to Texinfo then process through to INFO.
@@ -1473,7 +1650,7 @@ directory.
Return INFO file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".texi" subtreep))
- (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-coding-system org-texinfo-coding-system))
(org-export-to-file 'texinfo outfile
async subtreep visible-only body-only ext-plist
(lambda (file) (org-texinfo-compile file)))))
@@ -1491,99 +1668,36 @@ Return output file name."
;;;###autoload
(defun org-texinfo-convert-region-to-texinfo ()
- "Assume the current region has org-mode syntax, and convert it to Texinfo.
+ "Assume the current region has Org syntax, and convert it to Texinfo.
This can be used in any buffer. For example, you can write an
-itemized list in org-mode syntax in an Texinfo buffer and use
-this command to convert it."
+itemized list in Org syntax in an Texinfo buffer and use this
+command to convert it."
(interactive)
(org-export-replace-region-by 'texinfo))
(defun org-texinfo-compile (file)
"Compile a texinfo file.
-FILE is the name of the file being compiled. Processing is
-done through the command specified in `org-texinfo-info-process'.
+FILE is the name of the file being compiled. Processing is done
+through the command specified in `org-texinfo-info-process',
+which see. Output is redirected to \"*Org INFO Texinfo Output*\"
+buffer.
Return INFO file name or an error if it couldn't be produced."
- (let* ((base-name (file-name-sans-extension (file-name-nondirectory file)))
- (full-name (file-truename file))
- (out-dir (file-name-directory file))
- ;; Properly set working directory for compilation.
- (default-directory (if (file-name-absolute-p file)
- (file-name-directory full-name)
- default-directory))
- errors)
- (message "Processing Texinfo file %s..." file)
- (save-window-excursion
- ;; Replace %b, %f and %o with appropriate values in each command
- ;; before applying it. Output is redirected to "*Org INFO
- ;; Texinfo Output*" buffer.
- (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*")))
- (dolist (command org-texinfo-info-process)
- (shell-command
- (replace-regexp-in-string
- "%b" (shell-quote-argument base-name)
- (replace-regexp-in-string
- "%f" (shell-quote-argument full-name)
- (replace-regexp-in-string
- "%o" (shell-quote-argument out-dir) command t t) t t) t t)
- outbuf))
- ;; Collect standard errors from output buffer.
- (setq errors (org-texinfo-collect-errors outbuf)))
- (let ((infofile (concat out-dir base-name ".info")))
- ;; Check for process failure. Provide collected errors if
- ;; possible.
- (if (not (file-exists-p infofile))
- (error "INFO file %s wasn't produced%s" infofile
- (if errors (concat ": " errors) ""))
- ;; Else remove log files, when specified, and signal end of
- ;; process to user, along with any error encountered.
- (when org-texinfo-remove-logfiles
- (dolist (ext org-texinfo-logfiles-extensions)
- (let ((file (concat out-dir base-name "." ext)))
- (when (file-exists-p file) (delete-file file)))))
- (message (concat "Process completed"
- (if (not errors) "."
- (concat " with errors: " errors)))))
- ;; Return output file name.
- infofile))))
-
-(defun org-texinfo-collect-errors (buffer)
- "Collect some kind of errors from \"makeinfo\" command output.
-
-BUFFER is the buffer containing output.
-
-Return collected error types as a string, or nil if there was
-none."
- (with-current-buffer buffer
- (save-excursion
- (goto-char (point-min))
- ;; Find final "makeinfo" run.
- (when t
- (let ((case-fold-search t)
- (errors ""))
- (when (save-excursion
- (re-search-forward "perhaps incorrect sectioning?" nil t))
- (setq errors (concat errors " [incorrect sectioning]")))
- (when (save-excursion
- (re-search-forward "missing close brace" nil t))
- (setq errors (concat errors " [syntax error]")))
- (when (save-excursion
- (re-search-forward "Unknown command" nil t))
- (setq errors (concat errors " [undefined @command]")))
- (when (save-excursion
- (re-search-forward "No matching @end" nil t))
- (setq errors (concat errors " [block incomplete]")))
- (when (save-excursion
- (re-search-forward "requires a sectioning" nil t))
- (setq errors (concat errors " [invalid section command]")))
- (when (save-excursion
- (re-search-forward "\\[unexpected\ ]" nil t))
- (setq errors (concat errors " [unexpected error]")))
- (when (save-excursion
- (re-search-forward "misplaced " nil t))
- (setq errors (concat errors " [syntax error]")))
- (and (org-string-nw-p errors) (org-trim errors)))))))
+ (message "Processing Texinfo file %s..." file)
+ (let* ((log-name "*Org INFO Texinfo Output*")
+ (log (get-buffer-create log-name))
+ (output
+ (org-compile-file file org-texinfo-info-process "info"
+ (format "See %S for details" log-name)
+ log)))
+ (when org-texinfo-remove-logfiles
+ (let ((base (file-name-sans-extension output)))
+ (dolist (ext org-texinfo-logfiles-extensions)
+ (let ((file (concat base "." ext)))
+ (when (file-exists-p file) (delete-file file))))))
+ (message "Process completed.")
+ output))
(provide 'ox-texinfo)
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 59b66710dc1..8ea47d8ba6d 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -1,4 +1,4 @@
-;;; ox.el --- Generic Export Engine for Org Mode
+;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -28,12 +28,10 @@
;; Besides that parser, the generic exporter is made of three distinct
;; parts:
;;
-;; - The communication channel consists in a property list, which is
+;; - The communication channel consists of a property list, which is
;; created and updated during the process. Its use is to offer
;; every piece of information, would it be about initial environment
-;; or contextual data, all in a single place. The exhaustive list
-;; of properties is given in "The Communication Channel" section of
-;; this file.
+;; or contextual data, all in a single place.
;;
;; - The transcoder walks the parse tree, ignores or treat as plain
;; text elements and objects according to export options, and
@@ -46,8 +44,9 @@
;; output from back-end transcoders. See "The Filter System"
;; section for more information.
;;
-;; The core function is `org-export-as'. It returns the transcoded
-;; buffer as a string.
+;; The core functions is `org-export-as'. It returns the transcoded
+;; buffer as a string. Its derivatives are `org-export-to-buffer' and
+;; `org-export-to-file'.
;;
;; An export back-end is defined with `org-export-define-backend'.
;; This function can also support specific buffer keywords, OPTION
@@ -64,32 +63,31 @@
;; Tools for common tasks across back-ends are implemented in the
;; following part of the file.
;;
-;; Then, a wrapper macro for asynchronous export,
-;; `org-export-async-start', along with tools to display results. are
-;; given in the penultimate part.
+;; Eventually, a dispatcher (`org-export-dispatch') is provided in the
+;; last one.
;;
-;; Eventually, a dispatcher (`org-export-dispatch') for standard
-;; back-ends is provided in the last one.
+;; See <http://orgmode.org/worg/dev/org-export-reference.html> for
+;; more information.
;;; Code:
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
+(require 'ob-exp)
(require 'org-element)
(require 'org-macro)
-(require 'ob-exp)
+(require 'tabulated-list)
+(declare-function org-src-coderef-format "org-src" (&optional element))
+(declare-function org-src-coderef-regexp "org-src" (fmt &optional label))
(declare-function org-publish "ox-publish" (project &optional force async))
(declare-function org-publish-all "ox-publish" (&optional force async))
-(declare-function
- org-publish-current-file "ox-publish" (&optional force async))
-(declare-function org-publish-current-project "ox-publish"
- (&optional force async))
+(declare-function org-publish-current-file "ox-publish" (&optional force async))
+(declare-function org-publish-current-project "ox-publish" (&optional force async))
(defvar org-publish-project-alist)
(defvar org-table-number-fraction)
(defvar org-table-number-regexp)
-
;;; Internal Variables
;;
@@ -101,22 +99,21 @@
"Maximum nesting depth for headlines, counting from 0.")
(defconst org-export-options-alist
- '((:author "AUTHOR" nil user-full-name t)
- (:creator "CREATOR" nil org-export-creator-string)
- (:date "DATE" nil nil t)
- (:description "DESCRIPTION" nil nil newline)
+ '((:title "TITLE" nil nil parse)
+ (:date "DATE" nil nil parse)
+ (:author "AUTHOR" nil user-full-name parse)
(:email "EMAIL" nil user-mail-address t)
+ (:language "LANGUAGE" nil org-export-default-language t)
+ (:select-tags "SELECT_TAGS" nil org-export-select-tags split)
(:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split)
+ (:creator "CREATOR" nil org-export-creator-string)
(:headline-levels nil "H" org-export-headline-levels)
- (:keywords "KEYWORDS" nil nil space)
- (:language "LANGUAGE" nil org-export-default-language t)
(:preserve-breaks nil "\\n" org-export-preserve-breaks)
(:section-numbers nil "num" org-export-with-section-numbers)
- (:select-tags "SELECT_TAGS" nil org-export-select-tags split)
(:time-stamp-file nil "timestamp" org-export-time-stamp-file)
- (:title "TITLE" nil nil space)
(:with-archived-trees nil "arch" org-export-with-archived-trees)
(:with-author nil "author" org-export-with-author)
+ (:with-broken-links nil "broken-links" org-export-with-broken-links)
(:with-clocks nil "c" org-export-with-clocks)
(:with-creator nil "creator" org-export-with-creator)
(:with-date nil "date" org-export-with-date)
@@ -130,6 +127,7 @@
(:with-latex nil "tex" org-export-with-latex)
(:with-planning nil "p" org-export-with-planning)
(:with-priority nil "pri" org-export-with-priority)
+ (:with-properties nil "prop" org-export-with-properties)
(:with-smart-quotes nil "'" org-export-with-smart-quotes)
(:with-special-strings nil "-" org-export-with-special-strings)
(:with-statistics-cookies nil "stat" org-export-with-statistics-cookies)
@@ -139,10 +137,11 @@
(:with-tags nil "tags" org-export-with-tags)
(:with-tasks nil "tasks" org-export-with-tasks)
(:with-timestamps nil "<" org-export-with-timestamps)
+ (:with-title nil "title" org-export-with-title)
(:with-todo-keywords nil "todo" org-export-with-todo-keywords))
"Alist between export properties and ways to set them.
-The CAR of the alist is the property name, and the CDR is a list
+The key of the alist is the property name, and the value is a list
like (KEYWORD OPTION DEFAULT BEHAVIOR) where:
KEYWORD is a string representing a buffer keyword, or nil. Each
@@ -161,6 +160,9 @@ BEHAVIOR determines how Org should handle multiple keywords for
a newline.
`split' Split values at white spaces, and cons them to the
previous list.
+ `parse' Parse value as a list of strings and Org objects,
+ which can then be transcoded with, e.g.,
+ `org-export-data'. It implies `space' behavior.
Values set through KEYWORD and OPTION have precedence over
DEFAULT.
@@ -176,13 +178,12 @@ way they are handled must be hard-coded into
`org-export--get-inbuffer-options' function.")
(defconst org-export-filters-alist
- '((:filter-bold . org-export-filter-bold-functions)
+ '((:filter-body . org-export-filter-body-functions)
+ (:filter-bold . org-export-filter-bold-functions)
(:filter-babel-call . org-export-filter-babel-call-functions)
(:filter-center-block . org-export-filter-center-block-functions)
(:filter-clock . org-export-filter-clock-functions)
(:filter-code . org-export-filter-code-functions)
- (:filter-comment . org-export-filter-comment-functions)
- (:filter-comment-block . org-export-filter-comment-block-functions)
(:filter-diary-sexp . org-export-filter-diary-sexp-functions)
(:filter-drawer . org-export-filter-drawer-functions)
(:filter-dynamic-block . org-export-filter-dynamic-block-functions)
@@ -215,7 +216,6 @@ way they are handled must be hard-coded into
(:filter-planning . org-export-filter-planning-functions)
(:filter-property-drawer . org-export-filter-property-drawer-functions)
(:filter-quote-block . org-export-filter-quote-block-functions)
- (:filter-quote-section . org-export-filter-quote-section-functions)
(:filter-radio-target . org-export-filter-radio-target-functions)
(:filter-section . org-export-filter-section-functions)
(:filter-special-block . org-export-filter-special-block-functions)
@@ -258,6 +258,16 @@ whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\",
See `org-export-inline-image-p' for more information about
rules.")
+(defconst org-export-ignored-local-variables
+ '(org-font-lock-keywords
+ org-element--cache org-element--cache-objects org-element--cache-sync-keys
+ org-element--cache-sync-requests org-element--cache-sync-timer)
+ "List of variables not copied through upon buffer duplication.
+Export process takes place on a copy of the original buffer.
+When this copy is created, all Org related local variables not in
+this list are copied to the new buffer. Variables with an
+unreadable value are also ignored.")
+
(defvar org-export-async-debug nil
"Non-nil means asynchronous export process should leave data behind.
@@ -277,7 +287,7 @@ containing the back-end used, as a symbol, and either a process
or the time at which it finished. It is used to build the menu
from `org-export-stack'.")
-(defvar org-export--registered-backends nil
+(defvar org-export-registered-backends nil
"List of backends currently available in the exporter.
This variable is set with `org-export-define-backend' and
`org-export-define-derived-backend' functions.")
@@ -303,6 +313,7 @@ there is no export process in progress.
It can be used to teach Babel blocks how to act differently
according to the back-end used.")
+
;;; User-configurable Variables
;;
@@ -336,41 +347,46 @@ e.g. \"arch:nil\"."
:type '(choice
(const :tag "Not at all" nil)
(const :tag "Headline only" headline)
- (const :tag "Entirely" t)))
+ (const :tag "Entirely" t))
+ :safe (lambda (x) (memq x '(t nil headline))))
(defcustom org-export-with-author t
"Non-nil means insert author name into the exported file.
This option can also be set with the OPTIONS keyword,
e.g. \"author:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-clocks nil
"Non-nil means export CLOCK keywords.
This option can also be set with the OPTIONS keyword,
e.g. \"c:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
-(defcustom org-export-with-creator 'comment
+(defcustom org-export-with-creator nil
"Non-nil means the postamble should contain a creator sentence.
-The sentence can be set in `org-export-creator-string' and
-defaults to \"Generated by Org mode XX in Emacs XXX.\".
+The sentence can be set in `org-export-creator-string', which
+see.
-If the value is `comment' insert it as a comment."
+This option can also be set with the OPTIONS keyword, e.g.,
+\"creator:t\"."
:group 'org-export-general
- :type '(choice
- (const :tag "No creator sentence" nil)
- (const :tag "Sentence as a comment" comment)
- (const :tag "Insert the sentence" t)))
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-date t
"Non-nil means insert date in the exported document.
This option can also be set with the OPTIONS keyword,
e.g. \"date:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-date-timestamp-format nil
"Time-stamp format string to use for DATE keyword.
@@ -383,7 +399,8 @@ string."
:group 'org-export-general
:type '(choice
(string :tag "Time-stamp format string")
- (const :tag "No format string" nil)))
+ (const :tag "No format string" nil))
+ :safe (lambda (x) (or (null x) (stringp x))))
(defcustom org-export-creator-string
(format "Emacs %s (Org mode %s)"
@@ -392,16 +409,18 @@ string."
"Information about the creator of the document.
This option can also be set on with the CREATOR keyword."
:group 'org-export-general
- :type '(string :tag "Creator string"))
+ :type '(string :tag "Creator string")
+ :safe #'stringp)
(defcustom org-export-with-drawers '(not "LOGBOOK")
"Non-nil means export contents of standard drawers.
When t, all drawers are exported. This may also be a list of
-drawer names to export. If that list starts with `not', only
-drawers with such names will be ignored.
+drawer names to export, as strings. If that list starts with
+`not', only drawers with such names will be ignored.
-This variable doesn't apply to properties drawers.
+This variable doesn't apply to properties drawers. See
+`org-export-with-properties' instead.
This option can also be set with the OPTIONS keyword,
e.g. \"d:nil\"."
@@ -417,14 +436,16 @@ e.g. \"d:nil\"."
(const :format "" not)
(repeat :tag "Specify names of drawers to ignore during export"
:inline t
- (string :tag "Drawer name")))))
+ (string :tag "Drawer name"))))
+ :safe (lambda (x) (or (booleanp x) (consp x))))
(defcustom org-export-with-email nil
"Non-nil means insert author email into the exported file.
This option can also be set with the OPTIONS keyword,
e.g. \"email:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-emphasize t
"Non-nil means interpret *word*, /word/, _word_ and +word+.
@@ -436,7 +457,8 @@ respectively.
This option can also be set with the OPTIONS keyword,
e.g. \"*:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-exclude-tags '("noexport")
"Tags that exclude a tree from export.
@@ -447,30 +469,26 @@ carry one of the `org-export-select-tags' will be removed.
This option can also be set with the EXCLUDE_TAGS keyword."
:group 'org-export-general
- :type '(repeat (string :tag "Tag")))
+ :type '(repeat (string :tag "Tag"))
+ :safe (lambda (x) (and (listp x) (cl-every #'stringp x))))
(defcustom org-export-with-fixed-width t
- "Non-nil means lines starting with \":\" will be in fixed width font.
-
-This can be used to have pre-formatted text, fragments of code
-etc. For example:
- : ;; Some Lisp examples
- : (while (defc cnt)
- : (ding))
-will be looking just like this in also HTML. See also the QUOTE
-keyword. Not all export backends support this.
-
+ "Non-nil means export lines starting with \":\".
This option can also be set with the OPTIONS keyword,
e.g. \"::nil\"."
:group 'org-export-general
- :type 'boolean)
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-footnotes t
"Non-nil means Org footnotes should be exported.
This option can also be set with the OPTIONS keyword,
e.g. \"f:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-latex t
"Non-nil means process LaTeX environments and fragments.
@@ -487,7 +505,8 @@ t Allow export of math snippets."
:type '(choice
(const :tag "Do not process math in any way" nil)
(const :tag "Interpret math snippets" t)
- (const :tag "Leave math verbatim" verbatim)))
+ (const :tag "Leave math verbatim" verbatim))
+ :safe (lambda (x) (memq x '(t nil verbatim))))
(defcustom org-export-headline-levels 3
"The last level which is still exported as a headline.
@@ -498,7 +517,8 @@ when exported, but back-end behavior may differ.
This option can also be set with the OPTIONS keyword,
e.g. \"H:2\"."
:group 'org-export-general
- :type 'integer)
+ :type 'integer
+ :safe #'integerp)
(defcustom org-export-default-language "en"
"The default language for export and clocktable translations, as a string.
@@ -507,14 +527,16 @@ This may have an association in
`org-export-smart-quotes-alist' and `org-export-dictionary'.
This option can also be set with the LANGUAGE keyword."
:group 'org-export-general
- :type '(string :tag "Language"))
+ :type '(string :tag "Language")
+ :safe #'stringp)
(defcustom org-export-preserve-breaks nil
"Non-nil means preserve all line breaks when exporting.
This option can also be set with the OPTIONS keyword,
e.g. \"\\n:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-entities t
"Non-nil means interpret entities when exporting.
@@ -528,7 +550,8 @@ and the user option `org-entities-user'.
This option can also be set with the OPTIONS keyword,
e.g. \"e:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-inlinetasks t
"Non-nil means inlinetasks should be exported.
@@ -537,7 +560,8 @@ e.g. \"inline:nil\"."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-planning nil
"Non-nil means include planning info in export.
@@ -550,14 +574,35 @@ e.g. \"p:t\"."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-priority nil
"Non-nil means include priority cookies in export.
This option can also be set with the OPTIONS keyword,
e.g. \"pri:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
+
+(defcustom org-export-with-properties nil
+ "Non-nil means export contents of properties drawers.
+
+When t, all properties are exported. This may also be a list of
+properties to export, as strings.
+
+This option can also be set with the OPTIONS keyword,
+e.g. \"prop:t\"."
+ :group 'org-export-general
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type '(choice
+ (const :tag "All properties" t)
+ (const :tag "None" nil)
+ (repeat :tag "Selected properties"
+ (string :tag "Property name")))
+ :safe (lambda (x) (or (booleanp x)
+ (and (listp x) (cl-every #'stringp x)))))
(defcustom org-export-with-section-numbers t
"Non-nil means add section numbers to headlines when exporting.
@@ -568,7 +613,8 @@ headlines whose relative level is higher or equal to n.
This option can also be set with the OPTIONS keyword,
e.g. \"num:t\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-select-tags '("export")
"Tags that select a tree for export.
@@ -580,7 +626,8 @@ tagging it with one of the `org-export-exclude-tags'.
This option can also be set with the SELECT_TAGS keyword."
:group 'org-export-general
- :type '(repeat (string :tag "Tag")))
+ :type '(repeat (string :tag "Tag"))
+ :safe (lambda (x) (and (listp x) (cl-every #'stringp x))))
(defcustom org-export-with-smart-quotes nil
"Non-nil means activate smart quotes during export.
@@ -595,7 +642,8 @@ E.g., you can load Babel for french like this:
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-special-strings t
"Non-nil means interpret \"\\-\", \"--\" and \"---\" for export.
@@ -612,7 +660,8 @@ When this option is turned on, these strings will be exported as:
This option can also be set with the OPTIONS keyword,
e.g. \"-:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-statistics-cookies t
"Non-nil means include statistics cookies in export.
@@ -621,7 +670,8 @@ e.g. \"stat:nil\""
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-sub-superscripts t
"Non-nil means interpret \"_\" and \"^\" for export.
@@ -658,7 +708,8 @@ frequently in plain text."
:type '(choice
(const :tag "Interpret them" t)
(const :tag "Curly brackets only" {})
- (const :tag "Do not interpret them" nil)))
+ (const :tag "Do not interpret them" nil))
+ :safe (lambda (x) (memq x '(t nil {}))))
(defcustom org-export-with-toc t
"Non-nil means create a table of contents in exported files.
@@ -676,20 +727,19 @@ e.g. \"toc:nil\" or \"toc:3\"."
:type '(choice
(const :tag "No Table of Contents" nil)
(const :tag "Full Table of Contents" t)
- (integer :tag "TOC to level")))
+ (integer :tag "TOC to level"))
+ :safe (lambda (x) (or (booleanp x)
+ (integerp x))))
(defcustom org-export-with-tables t
- "If non-nil, lines starting with \"|\" define a table.
-For example:
-
- | Name | Address | Birthday |
- |-------------+----------+-----------|
- | Arthur Dent | England | 29.2.2100 |
-
+ "Non-nil means export tables.
This option can also be set with the OPTIONS keyword,
e.g. \"|:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-tags t
"If nil, do not export tags, just remove them from headlines.
@@ -704,7 +754,8 @@ e.g. \"tags:nil\"."
:type '(choice
(const :tag "Off" nil)
(const :tag "Not in TOC" not-in-toc)
- (const :tag "On" t)))
+ (const :tag "On" t))
+ :safe (lambda (x) (memq x '(t nil not-in-toc))))
(defcustom org-export-with-tasks t
"Non-nil means include TODO items for export.
@@ -725,14 +776,28 @@ e.g. \"tasks:nil\"."
(const :tag "Not-done tasks" todo)
(const :tag "Only done tasks" done)
(repeat :tag "Specific TODO keywords"
- (string :tag "Keyword"))))
+ (string :tag "Keyword")))
+ :safe (lambda (x) (or (memq x '(nil t todo done))
+ (and (listp x)
+ (cl-every #'stringp x)))))
+
+(defcustom org-export-with-title t
+ "Non-nil means print title into the exported file.
+This option can also be set with the OPTIONS keyword,
+e.g. \"title:nil\"."
+ :group 'org-export-general
+ :version "26.1"
+ :package-version '(Org . "8.3")
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-time-stamp-file t
"Non-nil means insert a time stamp into the exported file.
-The time stamp shows when the file was created. This option can
+The time stamp shows when the file was created. This option can
also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"."
:group 'org-export-general
- :type 'boolean)
+ :type 'boolean
+ :safe #'booleanp)
(defcustom org-export-with-timestamps t
"Non nil means allow timestamps in export.
@@ -754,7 +819,8 @@ This option can also be set with the OPTIONS keyword, e.g.
(const :tag "All timestamps" t)
(const :tag "Only active timestamps" active)
(const :tag "Only inactive timestamps" inactive)
- (const :tag "No timestamp" nil)))
+ (const :tag "No timestamp" nil))
+ :safe (lambda (x) (memq x '(t nil active inactive))))
(defcustom org-export-with-todo-keywords t
"Non-nil means include TODO keywords in export.
@@ -772,12 +838,33 @@ is nil. You can also allow them through local buffer variables."
:package-version '(Org . "8.0")
:type 'boolean)
+(defcustom org-export-with-broken-links nil
+ "Non-nil means do not raise an error on broken links.
+
+When this variable is non-nil, broken links are ignored, without
+stopping the export process. If it is set to `mark', broken
+links are marked as such in the output, with a string like
+
+ [BROKEN LINK: path]
+
+where PATH is the un-resolvable reference.
+
+This option can also be set with the OPTIONS keyword, e.g.,
+\"broken-links:mark\"."
+ :group 'org-export-general
+ :version "26.1"
+ :package-version '(Org . "9.0")
+ :type '(choice
+ (const :tag "Ignore broken links" t)
+ (const :tag "Mark broken links in output" mark)
+ (const :tag "Raise an error" nil)))
+
(defcustom org-export-snippet-translation-alist nil
"Alist between export snippets back-ends and exporter back-ends.
This variable allows providing shortcuts for export snippets.
-For example, with a value of \((\"h\" . \"html\")), the
+For example, with a value of \\='((\"h\" . \"html\")), the
HTML back-end will recognize the contents of \"@@h:<b>@@\" as
HTML code while every other back-end will ignore it."
:group 'org-export-general
@@ -785,7 +872,35 @@ HTML code while every other back-end will ignore it."
:package-version '(Org . "8.0")
:type '(repeat
(cons (string :tag "Shortcut")
- (string :tag "Back-end"))))
+ (string :tag "Back-end")))
+ :safe (lambda (x)
+ (and (listp x)
+ (cl-every #'consp x)
+ (cl-every #'stringp (mapcar #'car x))
+ (cl-every #'stringp (mapcar #'cdr x)))))
+
+(defcustom org-export-global-macros nil
+ "Alist between macro names and expansion templates.
+
+This variable defines macro expansion templates available
+globally. Associations follow the pattern
+
+ (NAME . TEMPLATE)
+
+where NAME is a string beginning with a letter and consisting of
+alphanumeric characters only.
+
+TEMPLATE is the string to which the macro is going to be
+expanded. Inside, \"$1\", \"$2\"... are place-holders for
+macro's arguments. Moreover, if the template starts with
+\"(eval\", it will be parsed as an Elisp expression and evaluated
+accordingly."
+ :group 'org-export-general
+ :version "26.1"
+ :package-version '(Org . "9.1")
+ :type '(repeat
+ (cons (string :tag "Name")
+ (string :tag "Template"))))
(defcustom org-export-coding-system nil
"Coding system for the exported file."
@@ -794,11 +909,12 @@ HTML code while every other back-end will ignore it."
:package-version '(Org . "8.0")
:type 'coding-system)
-(defcustom org-export-copy-to-kill-ring 'if-interactive
+(defcustom org-export-copy-to-kill-ring nil
"Non-nil means pushing export output to the kill ring.
This variable is ignored during asynchronous export."
:group 'org-export-general
- :version "24.3"
+ :version "26.1"
+ :package-version '(Org . "8.3")
:type '(choice
(const :tag "Always" t)
(const :tag "When export is done interactively" if-interactive)
@@ -825,21 +941,29 @@ these cases."
(defcustom org-export-in-background nil
"Non-nil means export and publishing commands will run in background.
Results from an asynchronous export are never displayed
-automatically. But you can retrieve them with \\[org-export-stack]."
+automatically. But you can retrieve them with `\\[org-export-stack]'."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
:type 'boolean)
-(defcustom org-export-async-init-file user-init-file
+(defcustom org-export-async-init-file nil
"File used to initialize external export process.
-Value must be an absolute file name. It defaults to user's
-initialization file. Though, a specific configuration makes the
-process faster and the export more portable."
+
+Value must be either nil or an absolute file name. When nil, the
+external process is launched like a regular Emacs session,
+loading user's initialization file and any site specific
+configuration. If a file is provided, it, and only it, is loaded
+at start-up.
+
+Therefore, using a specific configuration makes the process to
+load faster and the export more portable."
:group 'org-export-general
:version "24.4"
:package-version '(Org . "8.0")
- :type '(file :must-match t))
+ :type '(choice
+ (const :tag "Regular startup" nil)
+ (file :tag "Specific start-up file" :must-match t)))
(defcustom org-export-dispatch-use-expert-ui nil
"Non-nil means using a non-intrusive `org-export-dispatch'.
@@ -887,17 +1011,16 @@ mode."
;; Eventually `org-export-barf-if-invalid-backend' returns an error
;; when a given back-end hasn't been registered yet.
-(defstruct (org-export-backend (:constructor org-export-create-backend)
- (:copier nil))
+(cl-defstruct (org-export-backend (:constructor org-export-create-backend)
+ (:copier nil))
name parent transcoders options filters blocks menu)
+;;;###autoload
(defun org-export-get-backend (name)
"Return export back-end named after NAME.
NAME is a symbol. Return nil if no such back-end is found."
- (catch 'found
- (dolist (b org-export--registered-backends)
- (when (eq (org-export-backend-name b) name)
- (throw 'found b)))))
+ (cl-find-if (lambda (b) (and (eq name (org-export-backend-name b))))
+ org-export-registered-backends))
(defun org-export-register-backend (backend)
"Register BACKEND as a known export back-end.
@@ -909,16 +1032,12 @@ BACKEND is a structure with `org-export-backend' type."
(let ((parent (org-export-backend-parent backend)))
(when (and parent (not (org-export-get-backend parent)))
(error "Cannot use unknown \"%s\" back-end as a parent" parent)))
- ;; Register dedicated export blocks in the parser.
- (dolist (name (org-export-backend-blocks backend))
- (add-to-list 'org-element-block-name-alist
- (cons name 'org-element-export-block-parser)))
;; If a back-end with the same name as BACKEND is already
;; registered, replace it with BACKEND. Otherwise, simply add
;; BACKEND to the list of registered back-ends.
(let ((old (org-export-get-backend (org-export-backend-name backend))))
- (if old (setcar (memq old org-export--registered-backends) backend)
- (push backend org-export--registered-backends))))
+ (if old (setcar (memq old org-export-registered-backends) backend)
+ (push backend org-export-registered-backends))))
(defun org-export-barf-if-invalid-backend (backend)
"Signal an error if BACKEND isn't defined."
@@ -969,7 +1088,9 @@ BACKEND is an export back-end, as return by, e.g,,
for the shape of the return value.
Unlike to `org-export-backend-options', this function also
-returns options inherited from parent back-ends, if any."
+returns options inherited from parent back-ends, if any.
+
+Return nil if BACKEND is unknown."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(when backend
(let ((options (org-export-backend-options backend))
@@ -1039,14 +1160,6 @@ back-end.
BODY can start with pre-defined keyword arguments. The following
keywords are understood:
- :export-block
-
- String, or list of strings, representing block names that
- will not be parsed. This is used to specify blocks that will
- contain raw code specific to the back-end. These blocks
- still have to be handled by the relative `export-block' type
- translator.
-
:filters-alist
Alist between filters and function, or list of functions,
@@ -1060,7 +1173,7 @@ keywords are understood:
Menu entry for the export dispatcher. It should be a list
like:
- (KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU)
+ \\='(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU)
where :
@@ -1084,17 +1197,17 @@ keywords are understood:
If it is an alist, associations should follow the
pattern:
- (KEY DESCRIPTION ACTION)
+ \\='(KEY DESCRIPTION ACTION)
where KEY, DESCRIPTION and ACTION are described above.
Valid values include:
- (?m \"My Special Back-end\" my-special-export-function)
+ \\='(?m \"My Special Back-end\" my-special-export-function)
or
- (?l \"Export to LaTeX\"
+ \\='(?l \"Export to LaTeX\"
(?p \"As PDF file\" org-latex-export-to-pdf)
(?o \"As PDF file and open\"
(lambda (a s v b)
@@ -1105,7 +1218,7 @@ keywords are understood:
or the following, which will be added to the previous
sub-menu,
- (?l 1
+ \\='(?l 1
((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex)
(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf)))
@@ -1116,22 +1229,19 @@ keywords are understood:
`org-export-options-alist' for more information about
structure of the values."
(declare (indent 1))
- (let (blocks filters menu-entry options contents)
+ (let (filters menu-entry options)
(while (keywordp (car body))
- (case (pop body)
- (:export-block (let ((names (pop body)))
- (setq blocks (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
- (:filters-alist (setq filters (pop body)))
- (:menu-entry (setq menu-entry (pop body)))
- (:options-alist (setq options (pop body)))
- (t (pop body))))
+ (let ((keyword (pop body)))
+ (pcase keyword
+ (:filters-alist (setq filters (pop body)))
+ (:menu-entry (setq menu-entry (pop body)))
+ (:options-alist (setq options (pop body)))
+ (_ (error "Unknown keyword: %s" keyword)))))
(org-export-register-backend
(org-export-create-backend :name backend
:transcoders transcoders
:options options
:filters filters
- :blocks blocks
:menu menu-entry))))
(defun org-export-define-derived-backend (child parent &rest body)
@@ -1143,14 +1253,6 @@ the parent back-end.
BODY can start with pre-defined keyword arguments. The following
keywords are understood:
- :export-block
-
- String, or list of strings, representing block names that
- will not be parsed. This is used to specify blocks that will
- contain raw code specific to the back-end. These blocks
- still have to be handled by the relative `export-block' type
- translator.
-
:filters-alist
Alist of filters that will overwrite or complete filters
@@ -1187,24 +1289,21 @@ The back-end could then be called with, for example:
(org-export-to-buffer \\='my-latex \"*Test my-latex*\")"
(declare (indent 2))
- (let (blocks filters menu-entry options transcoders contents)
+ (let (filters menu-entry options transcoders)
(while (keywordp (car body))
- (case (pop body)
- (:export-block (let ((names (pop body)))
- (setq blocks (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
- (:filters-alist (setq filters (pop body)))
- (:menu-entry (setq menu-entry (pop body)))
- (:options-alist (setq options (pop body)))
- (:translate-alist (setq transcoders (pop body)))
- (t (pop body))))
+ (let ((keyword (pop body)))
+ (pcase keyword
+ (:filters-alist (setq filters (pop body)))
+ (:menu-entry (setq menu-entry (pop body)))
+ (:options-alist (setq options (pop body)))
+ (:translate-alist (setq transcoders (pop body)))
+ (_ (error "Unknown keyword: %s" keyword)))))
(org-export-register-backend
(org-export-create-backend :name child
:parent parent
:transcoders transcoders
:options options
:filters filters
- :blocks blocks
:menu menu-entry))))
@@ -1223,274 +1322,7 @@ The back-end could then be called with, for example:
;; `org-export-options-alist' variable.
;;
;; 2. Tree properties are extracted directly from the parsed tree,
-;; just before export, by `org-export-collect-tree-properties'.
-;;
-;; Here is the full list of properties available during transcode
-;; process, with their category and their value type.
-;;
-;; + `:author' :: Author's name.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:back-end' :: Current back-end used for transcoding.
-;; - category :: tree
-;; - type :: symbol
-;;
-;; + `:creator' :: String to write as creation information.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:date' :: String to use as date.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:description' :: Description text for the current data.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:email' :: Author's email.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:exclude-tags' :: Tags for exclusion of subtrees from export
-;; process.
-;; - category :: option
-;; - type :: list of strings
-;;
-;; + `:export-options' :: List of export options available for current
-;; process.
-;; - category :: none
-;; - type :: list of symbols, among `subtree', `body-only' and
-;; `visible-only'.
-;;
-;; + `:exported-data' :: Hash table used for memoizing
-;; `org-export-data'.
-;; - category :: tree
-;; - type :: hash table
-;;
-;; + `:filetags' :: List of global tags for buffer. Used by
-;; `org-export-get-tags' to get tags with inheritance.
-;; - category :: option
-;; - type :: list of strings
-;;
-;; + `:footnote-definition-alist' :: Alist between footnote labels and
-;; their definition, as parsed data. Only non-inlined footnotes
-;; are represented in this alist. Also, every definition isn't
-;; guaranteed to be referenced in the parse tree. The purpose of
-;; this property is to preserve definitions from oblivion
-;; (i.e. when the parse tree comes from a part of the original
-;; buffer), it isn't meant for direct use in a back-end. To
-;; retrieve a definition relative to a reference, use
-;; `org-export-get-footnote-definition' instead.
-;; - category :: option
-;; - type :: alist (STRING . LIST)
-;;
-;; + `:headline-levels' :: Maximum level being exported as an
-;; headline. Comparison is done with the relative level of
-;; headlines in the parse tree, not necessarily with their
-;; actual level.
-;; - category :: option
-;; - type :: integer
-;;
-;; + `:headline-offset' :: Difference between relative and real level
-;; of headlines in the parse tree. For example, a value of -1
-;; means a level 2 headline should be considered as level
-;; 1 (cf. `org-export-get-relative-level').
-;; - category :: tree
-;; - type :: integer
-;;
-;; + `:headline-numbering' :: Alist between headlines and their
-;; numbering, as a list of numbers
-;; (cf. `org-export-get-headline-number').
-;; - category :: tree
-;; - type :: alist (INTEGER . LIST)
-;;
-;; + `:id-alist' :: Alist between ID strings and destination file's
-;; path, relative to current directory. It is used by
-;; `org-export-resolve-id-link' to resolve ID links targeting an
-;; external file.
-;; - category :: option
-;; - type :: alist (STRING . STRING)
-;;
-;; + `:ignore-list' :: List of elements and objects that should be
-;; ignored during export.
-;; - category :: tree
-;; - type :: list of elements and objects
-;;
-;; + `:input-buffer' :: Name of input buffer.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:input-file' :: Full path to input file, if any.
-;; - category :: option
-;; - type :: string or nil
-;;
-;; + `:keywords' :: List of keywords attached to data.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:language' :: Default language used for translations.
-;; - category :: option
-;; - type :: string
-;;
-;; + `:output-file' :: Full path to output file, if any.
-;; - category :: option
-;; - type :: string or nil
-;;
-;; + `:parse-tree' :: Whole parse tree, available at any time during
-;; transcoding.
-;; - category :: option
-;; - type :: list (as returned by `org-element-parse-buffer')
-;;
-;; + `:preserve-breaks' :: Non-nil means transcoding should preserve
-;; all line breaks.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:section-numbers' :: Non-nil means transcoding should add
-;; section numbers to headlines.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees
-;; in transcoding. When such a tag is present, subtrees without
-;; it are de facto excluded from the process. See
-;; `use-select-tags'.
-;; - category :: option
-;; - type :: list of strings
-;;
-;; + `:time-stamp-file' :: Non-nil means transcoding should insert
-;; a time stamp in the output.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:translate-alist' :: Alist between element and object types and
-;; transcoding functions relative to the current back-end.
-;; Special keys `inner-template', `template' and `plain-text' are
-;; also possible.
-;; - category :: option
-;; - type :: alist (SYMBOL . FUNCTION)
-;;
-;; + `:with-archived-trees' :: Non-nil when archived subtrees should
-;; also be transcoded. If it is set to the `headline' symbol,
-;; only the archived headline's name is retained.
-;; - category :: option
-;; - type :: symbol (nil, t, `headline')
-;;
-;; + `:with-author' :: Non-nil means author's name should be included
-;; in the output.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-clocks' :: Non-nil means clock keywords should be exported.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-creator' :: Non-nil means a creation sentence should be
-;; inserted at the end of the transcoded string. If the value
-;; is `comment', it should be commented.
-;; - category :: option
-;; - type :: symbol (`comment', nil, t)
-;;
-;; + `:with-date' :: Non-nil means output should contain a date.
-;; - category :: option
-;; - type :. symbol (nil, t)
-;;
-;; + `:with-drawers' :: Non-nil means drawers should be exported. If
-;; its value is a list of names, only drawers with such names
-;; will be transcoded. If that list starts with `not', drawer
-;; with these names will be skipped.
-;; - category :: option
-;; - type :: symbol (nil, t) or list of strings
-;;
-;; + `:with-email' :: Non-nil means output should contain author's
-;; email.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-emphasize' :: Non-nil means emphasized text should be
-;; interpreted.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-fixed-width' :: Non-nil if transcoder should interpret
-;; strings starting with a colon as a fixed-with (verbatim) area.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-footnotes' :: Non-nil if transcoder should interpret
-;; footnotes.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-latex' :: Non-nil means `latex-environment' elements and
-;; `latex-fragment' objects should appear in export output. When
-;; this property is set to `verbatim', they will be left as-is.
-;; - category :: option
-;; - type :: symbol (`verbatim', nil, t)
-;;
-;; + `:with-planning' :: Non-nil means transcoding should include
-;; planning info.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-priority' :: Non-nil means transcoding should include
-;; priority cookies.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in
-;; plain text.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-special-strings' :: Non-nil means transcoding should
-;; interpret special strings in plain text.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-sub-superscript' :: Non-nil means transcoding should
-;; interpret subscript and superscript. With a value of "{}",
-;; only interpret those using curly brackets.
-;; - category :: option
-;; - type :: symbol (nil, {}, t)
-;;
-;; + `:with-tables' :: Non-nil means transcoding should interpret
-;; tables.
-;; - category :: option
-;; - type :: symbol (nil, t)
-;;
-;; + `:with-tags' :: Non-nil means transcoding should keep tags in
-;; headlines. A `not-in-toc' value will remove them from the
-;; table of contents, if any, nonetheless.
-;; - category :: option
-;; - type :: symbol (nil, t, `not-in-toc')
-;;
-;; + `:with-tasks' :: Non-nil means transcoding should include
-;; headlines with a TODO keyword. A `todo' value will only
-;; include headlines with a todo type keyword while a `done'
-;; value will do the contrary. If a list of strings is provided,
-;; only tasks with keywords belonging to that list will be kept.
-;; - category :: option
-;; - type :: symbol (t, todo, done, nil) or list of strings
-;;
-;; + `:with-timestamps' :: Non-nil means transcoding should include
-;; time stamps. Special value `active' (resp. `inactive') ask to
-;; export only active (resp. inactive) timestamps. Otherwise,
-;; completely remove them.
-;; - category :: option
-;; - type :: symbol: (`active', `inactive', t, nil)
-;;
-;; + `:with-toc' :: Non-nil means that a table of contents has to be
-;; added to the output. An integer value limits its depth.
-;; - category :: option
-;; - type :: symbol (nil, t or integer)
-;;
-;; + `:with-todo-keywords' :: Non-nil means transcoding should
-;; include TODO keywords.
-;; - category :: option
-;; - type :: symbol (nil, t)
-
+;; just before export, by `org-export--collect-tree-properties'.
;;;; Environment Options
;;
@@ -1520,6 +1352,7 @@ The back-end could then be called with, for example:
;; along with their value in order to set them as buffer local
;; variables later in the process.
+;;;###autoload
(defun org-export-get-environment (&optional backend subtreep ext-plist)
"Collect export options from the current buffer.
@@ -1535,7 +1368,7 @@ inferior to file-local settings."
;; First install #+BIND variables since these must be set before
;; global options are read.
(dolist (pair (org-export--list-bound-variables))
- (org-set-local (car pair) (nth 1 pair)))
+ (set (make-local-variable (car pair)) (nth 1 pair)))
;; Get and prioritize export options...
(org-combine-plists
;; ... from global variables...
@@ -1545,69 +1378,31 @@ inferior to file-local settings."
;; ... from in-buffer settings...
(org-export--get-inbuffer-options backend)
;; ... and from subtree, when appropriate.
- (and subtreep (org-export--get-subtree-options backend))
- ;; Eventually add misc. properties.
- (list
- :back-end
- backend
- :translate-alist (org-export-get-all-transcoders backend)
- :footnote-definition-alist
- ;; Footnotes definitions must be collected in the original
- ;; buffer, as there's no insurance that they will still be in
- ;; the parse tree, due to possible narrowing.
- (let (alist)
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward org-footnote-definition-re nil t)
- (let ((def (save-match-data (org-element-at-point))))
- (when (eq (org-element-type def) 'footnote-definition)
- (push
- (cons (org-element-property :label def)
- (let ((cbeg (org-element-property :contents-begin def)))
- (when cbeg
- (org-element--parse-elements
- cbeg (org-element-property :contents-end def)
- nil nil nil nil (list 'org-data nil)))))
- alist))))
- alist))
- :id-alist
- ;; Collect id references.
- (let (alist)
- (org-with-wide-buffer
- (goto-char (point-min))
- (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t)
- (let ((link (org-element-context)))
- (when (eq (org-element-type link) 'link)
- (let* ((id (org-element-property :path link))
- (file (org-id-find-id-file id)))
- (when file
- (push (cons id (file-relative-name file)) alist)))))))
- alist))))
+ (and subtreep (org-export--get-subtree-options backend))))
(defun org-export--parse-option-keyword (options &optional backend)
"Parse an OPTIONS line and return values as a plist.
Optional argument BACKEND is an export back-end, as returned by,
e.g., `org-export-create-backend'. It specifies which back-end
specific items to read, if any."
- (let* ((all
- ;; Priority is given to back-end specific options.
- (append (and backend (org-export-get-all-options backend))
- org-export-options-alist))
- plist)
- (dolist (option all)
- (let ((property (car option))
- (item (nth 2 option)))
- (when (and item
- (not (plist-member plist property))
- (string-match (concat "\\(\\`\\|[ \t]\\)"
- (regexp-quote item)
- ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)")
- options))
- (setq plist (plist-put plist
- property
- (car (read-from-string
- (match-string 2 options))))))))
- plist))
+ (let ((line
+ (let ((s 0) alist)
+ (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*" options s)
+ (setq s (match-end 0))
+ (push (cons (match-string 1 options)
+ (read (match-string 2 options)))
+ alist))
+ alist))
+ ;; Priority is given to back-end specific options.
+ (all (append (org-export-get-all-options backend)
+ org-export-options-alist))
+ (plist))
+ (when line
+ (dolist (entry all plist)
+ (let ((item (nth 2 entry)))
+ (when item
+ (let ((v (assoc-string item line t)))
+ (when v (setq plist (plist-put plist (car entry) (cdr v)))))))))))
(defun org-export--get-subtree-options (&optional backend)
"Get export options in subtree at point.
@@ -1615,60 +1410,50 @@ Optional argument BACKEND is an export back-end, as returned by,
e.g., `org-export-create-backend'. It specifies back-end used
for export. Return options as a plist."
;; For each buffer keyword, create a headline property setting the
- ;; same property in communication channel. The name for the property
- ;; is the keyword with "EXPORT_" appended to it.
+ ;; same property in communication channel. The name for the
+ ;; property is the keyword with "EXPORT_" appended to it.
(org-with-wide-buffer
- (let (prop plist)
- ;; Make sure point is at a heading.
- (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t))
- ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's
- ;; title (with no todo keyword, priority cookie or tag) as its
- ;; fallback value.
- (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE")
- (progn (looking-at org-complex-heading-regexp)
- (org-match-string-no-properties 4))))
- (setq plist
- (plist-put
- plist :title
- (org-element-parse-secondary-string
- prop (org-element-restriction 'keyword)))))
- ;; EXPORT_OPTIONS are parsed in a non-standard way.
- (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS"))
- (setq plist
- (nconc plist (org-export--parse-option-keyword prop backend))))
- ;; Handle other keywords. TITLE keyword is excluded as it has
- ;; been handled already.
- (let ((seen '("TITLE")))
- (mapc
- (lambda (option)
- (let ((property (car option))
- (keyword (nth 1 option)))
- (when (and keyword (not (member keyword seen)))
- (let* ((subtree-prop (concat "EXPORT_" keyword))
- ;; Export properties are not case-sensitive.
- (value (let ((case-fold-search t))
- (org-entry-get (point) subtree-prop))))
- (push keyword seen)
- (when (and value (not (plist-member plist property)))
- (setq plist
- (plist-put
- plist
- property
- (cond
- ;; Parse VALUE if required.
- ((member keyword org-element-document-properties)
- (org-element-parse-secondary-string
- value (org-element-restriction 'keyword)))
- ;; If BEHAVIOR is `split' expected value is
- ;; a list of strings, not a string.
- ((eq (nth 4 option) 'split) (org-split-string value))
- (t value)))))))))
- ;; Look for both general keywords and back-end specific
- ;; options, with priority given to the latter.
- (append (and backend (org-export-get-all-options backend))
- org-export-options-alist)))
- ;; Return value.
- plist)))
+ ;; Make sure point is at a heading.
+ (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t))
+ (let ((plist
+ ;; EXPORT_OPTIONS are parsed in a non-standard way. Take
+ ;; care of them right from the start.
+ (let ((o (org-entry-get (point) "EXPORT_OPTIONS" 'selective)))
+ (and o (org-export--parse-option-keyword o backend))))
+ ;; Take care of EXPORT_TITLE. If it isn't defined, use
+ ;; headline's title (with no todo keyword, priority cookie or
+ ;; tag) as its fallback value.
+ (cache (list
+ (cons "TITLE"
+ (or (org-entry-get (point) "EXPORT_TITLE" 'selective)
+ (let ((case-fold-search nil))
+ (looking-at org-complex-heading-regexp)
+ (match-string-no-properties 4))))))
+ ;; Look for both general keywords and back-end specific
+ ;; options, with priority given to the latter.
+ (options (append (org-export-get-all-options backend)
+ org-export-options-alist)))
+ ;; Handle other keywords. Then return PLIST.
+ (dolist (option options plist)
+ (let ((property (car option))
+ (keyword (nth 1 option)))
+ (when keyword
+ (let ((value
+ (or (cdr (assoc keyword cache))
+ (let ((v (org-entry-get (point)
+ (concat "EXPORT_" keyword)
+ 'selective)))
+ (push (cons keyword v) cache) v))))
+ (when value
+ (setq plist
+ (plist-put plist
+ property
+ (cl-case (nth 4 option)
+ (parse
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword)))
+ (split (split-string value))
+ (t value))))))))))))
(defun org-export--get-inbuffer-options (&optional backend)
"Return current buffer export options, as a plist.
@@ -1679,113 +1464,140 @@ which back-end specific options should also be read in the
process.
Assume buffer is in Org mode. Narrowing, if any, is ignored."
- (let* (plist
- get-options ; For byte-compiler.
- (case-fold-search t)
+ (let* ((case-fold-search t)
(options (append
;; Priority is given to back-end specific options.
- (and backend (org-export-get-all-options backend))
+ (org-export-get-all-options backend)
org-export-options-alist))
(regexp (format "^[ \t]*#\\+%s:"
- (regexp-opt (nconc (delq nil (mapcar 'cadr options))
+ (regexp-opt (nconc (delq nil (mapcar #'cadr options))
org-export-special-keywords))))
- (find-properties
- (lambda (keyword)
- ;; Return all properties associated to KEYWORD.
- (let (properties)
- (dolist (option options properties)
- (when (equal (nth 1 option) keyword)
- (pushnew (car option) properties))))))
- (get-options
- (lambda (&optional files plist)
- ;; 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 ((file (expand-file-name
- (org-remove-double-quotes (org-trim val)))))
- ;; Avoid circular dependencies.
- (unless (member file files)
- (with-temp-buffer
- (insert (org-file-contents file 'noerror))
- (let ((org-inhibit-startup t)) (org-mode))
- (setq plist (funcall get-options
- (cons file files) plist))))))
- ((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))
- (let ((behavior (nth 4 (assq property options))))
+ 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-unbracket-string "\"" "\"" (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
- (plist-put
- plist property
- ;; Handle value depending on specified
- ;; BEHAVIOR.
- (case behavior
- (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)
- ,@(org-split-string val)))
- ('t val)
- (otherwise
- (if (not (plist-member plist property)) val
- (plist-get plist property))))))))))))))
- ;; Return final value.
- plist))))
- ;; Read options in the current buffer.
- (setq plist (funcall get-options
- (and buffer-file-name (list buffer-file-name)) nil))
- ;; Parse keywords specified in `org-element-document-properties'
- ;; and return PLIST.
- (dolist (keyword org-element-document-properties plist)
- (dolist (property (funcall find-properties keyword))
- (let ((value (plist-get plist property)))
- (when (stringp value)
- (setq plist
- (plist-put plist property
- (or (org-element-parse-secondary-string
- value (org-element-restriction 'keyword))
- ;; When TITLE keyword sets an empty
- ;; string, make sure it doesn't
- ;; appear as nil in the plist.
- (and (eq property :title) ""))))))))))
+ (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)))))))))))))))))
+ ;; Read options in the current buffer and return value.
+ (funcall get-options (and buffer-file-name (list buffer-file-name)))
+ ;; Parse properties in TO-PARSE. Remove newline characters not
+ ;; involved in line breaks to simulate `space' behavior.
+ ;; Finally return options.
+ (dolist (p to-parse plist)
+ (let ((value (org-element-parse-secondary-string
+ (plist-get plist p)
+ (org-element-restriction 'keyword))))
+ (org-element-map value 'plain-text
+ (lambda (s)
+ (org-element-set-element
+ s (replace-regexp-in-string "\n" " " s))))
+ (setq plist (plist-put plist p value)))))))
+
+(defun org-export--get-export-attributes
+ (&optional backend subtreep visible-only body-only)
+ "Return properties related to export process, as a plist.
+Optional arguments BACKEND, SUBTREEP, VISIBLE-ONLY and BODY-ONLY
+are like the arguments with the same names of function
+`org-export-as'."
+ (list :export-options (delq nil
+ (list (and subtreep 'subtree)
+ (and visible-only 'visible-only)
+ (and body-only 'body-only)))
+ :back-end backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ :exported-data (make-hash-table :test #'eq :size 4001)))
(defun org-export--get-buffer-attributes ()
"Return properties related to buffer attributes, as a plist."
- ;; Store full path of input file name, or nil. For internal use.
- (let ((visited-file (buffer-file-name (buffer-base-buffer))))
- (list :input-file visited-file
- :input-buffer (buffer-name (buffer-base-buffer)))))
+ (list :input-buffer (buffer-name (buffer-base-buffer))
+ :input-file (buffer-file-name (buffer-base-buffer))))
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
@@ -1795,7 +1607,7 @@ which back-end specific export options should also be read in the
process."
(let (plist
;; Priority is given to back-end specific options.
- (all (append (and backend (org-export-get-all-options backend))
+ (all (append (org-export-get-all-options backend)
org-export-options-alist)))
(dolist (cell all plist)
(let ((prop (car cell)))
@@ -1804,13 +1616,9 @@ process."
(plist-put
plist
prop
- ;; Evaluate default value provided. If keyword is
- ;; a member of `org-element-document-properties',
- ;; parse it as a secondary string before storing it.
+ ;; Evaluate default value provided.
(let ((value (eval (nth 3 cell))))
- (if (and (stringp value)
- (member (nth 1 cell)
- org-element-document-properties))
+ (if (eq (nth 4 cell) 'parse)
(org-element-parse-secondary-string
value (org-element-restriction 'keyword))
value)))))))))
@@ -1820,35 +1628,42 @@ 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
- (let* (collect-bind ; For byte-compiler.
- (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 ((file (expand-file-name
- (org-remove-double-quotes val))))
- (unless (member file files)
- (with-temp-buffer
- (let ((org-inhibit-startup t)) (org-mode))
- (insert (org-file-contents file 'noerror))
- (setq alist
- (funcall collect-bind
- (cons file files)
- alist))))))))))
- alist)))))
+ (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-unbracket-string "\"" "\"" 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)))))
@@ -1864,7 +1679,7 @@ BLOB is the element or object considered."
;;
;; Tree properties are information extracted from parse tree. They
;; are initialized at the beginning of the transcoding process by
-;; `org-export-collect-tree-properties'.
+;; `org-export--collect-tree-properties'.
;;
;; Dedicated functions focus on computing the value of specific tree
;; properties during initialization. Thus,
@@ -1875,7 +1690,7 @@ BLOB is the element or object considered."
;; `org-export--collect-headline-numbering' builds an alist between
;; headlines and their numbering.
-(defun org-export-collect-tree-properties (data info)
+(defun org-export--collect-tree-properties (data info)
"Extract tree properties from parse tree.
DATA is the parse tree from which information is retrieved. INFO
@@ -1883,59 +1698,38 @@ is a list holding export options.
Following tree properties are set or updated:
-`:exported-data' Hash table used to memoize results from
- `org-export-data'.
-
-`:footnote-definition-alist' List of footnotes definitions in
- original buffer and current parse tree.
-
`:headline-offset' Offset between true level of headlines and
local level. An offset of -1 means a headline
of level 2 should be considered as a level
1 headline in the context.
-`:headline-numbering' Alist of all headlines as key an the
+`:headline-numbering' Alist of all headlines as key and the
associated numbering as value.
-`:ignore-list' List of elements that should be ignored during
- export.
+`:id-alist' Alist of all ID references as key and associated file
+ as value.
Return updated plist."
- ;; Install the parse tree in the communication channel, in order to
- ;; use `org-export-get-genealogy' and al.
+ ;; Install the parse tree in the communication channel.
(setq info (plist-put info :parse-tree data))
- ;; Get the list of elements and objects to ignore, and put it into
- ;; `:ignore-list'. Do not overwrite any user ignore that might have
- ;; been done during parse tree filtering.
- (setq info
- (plist-put info
- :ignore-list
- (append (org-export--populate-ignore-list data info)
- (plist-get info :ignore-list))))
;; Compute `:headline-offset' in order to be able to use
;; `org-export-get-relative-level'.
(setq info
(plist-put info
:headline-offset
(- 1 (org-export--get-min-level data info))))
- ;; Update footnotes definitions list with definitions in parse tree.
- ;; This is required since buffer expansion might have modified
- ;; boundaries of footnote definitions contained in the parse tree.
- ;; This way, definitions in `footnote-definition-alist' are bound to
- ;; match those in the parse tree.
- (let ((defs (plist-get info :footnote-definition-alist)))
- (org-element-map data 'footnote-definition
- (lambda (fn)
- (push (cons (org-element-property :label fn)
- `(org-data nil ,@(org-element-contents fn)))
- defs)))
- (setq info (plist-put info :footnote-definition-alist defs)))
- ;; Properties order doesn't matter: get the rest of the tree
- ;; properties.
- (nconc
- `(:headline-numbering ,(org-export--collect-headline-numbering data info)
- :exported-data ,(make-hash-table :test 'eq :size 4001))
- info))
+ ;; From now on, properties order doesn't matter: get the rest of the
+ ;; tree properties.
+ (org-combine-plists
+ info
+ (list :headline-numbering (org-export--collect-headline-numbering data info)
+ :id-alist
+ (org-element-map data 'link
+ (lambda (l)
+ (and (string= (org-element-property :type l) "id")
+ (let* ((id (org-element-property :path l))
+ (file (car (org-id-find id))))
+ (and file (cons id (file-relative-name file))))))))))
(defun org-export--get-min-level (data options)
"Return minimum exportable headline's level in DATA.
@@ -1943,20 +1737,18 @@ DATA is parsed tree as returned by `org-element-parse-buffer'.
OPTIONS is a plist holding export options."
(catch 'exit
(let ((min-level 10000))
- (mapc
- (lambda (blob)
- (when (and (eq (org-element-type blob) 'headline)
- (not (org-element-property :footnote-section-p blob))
- (not (memq blob (plist-get options :ignore-list))))
- (setq min-level (min (org-element-property :level blob) min-level)))
- (when (= min-level 1) (throw 'exit 1)))
- (org-element-contents data))
+ (dolist (datum (org-element-contents data))
+ (when (and (eq (org-element-type datum) 'headline)
+ (not (org-element-property :footnote-section-p datum))
+ (not (memq datum (plist-get options :ignore-list))))
+ (setq min-level (min (org-element-property :level datum) min-level))
+ (when (= min-level 1) (throw 'exit 1))))
;; If no headline was found, for the sake of consistency, set
;; minimum level to 1 nonetheless.
(if (= min-level 10000) 1 min-level))))
(defun org-export--collect-headline-numbering (data options)
- "Return numbering of all exportable headlines in a parse tree.
+ "Return numbering of all exportable, numbered headlines in a parse tree.
DATA is the parse tree. OPTIONS is the plist holding export
options.
@@ -1967,93 +1759,75 @@ for a footnotes section."
(let ((numbering (make-vector org-export-max-depth 0)))
(org-element-map data 'headline
(lambda (headline)
- (unless (org-element-property :footnote-section-p headline)
+ (when (and (org-export-numbered-headline-p headline options)
+ (not (org-element-property :footnote-section-p headline)))
(let ((relative-level
(1- (org-export-get-relative-level headline options))))
(cons
headline
- (loop for n across numbering
- for idx from 0 to org-export-max-depth
- when (< idx relative-level) collect n
- when (= idx relative-level) collect (aset numbering idx (1+ n))
- when (> idx relative-level) do (aset numbering idx 0))))))
+ (cl-loop
+ for n across numbering
+ for idx from 0 to org-export-max-depth
+ when (< idx relative-level) collect n
+ when (= idx relative-level) collect (aset numbering idx (1+ n))
+ when (> idx relative-level) do (aset numbering idx 0))))))
options)))
-(defun org-export--populate-ignore-list (data options)
- "Return list of elements and objects to ignore during export.
-DATA is the parse tree to traverse. OPTIONS is the plist holding
-export options."
- (let* (ignore
- walk-data
- ;; First find trees containing a select tag, if any.
- (selected (org-export--selected-trees data options))
- (walk-data
- (lambda (data)
- ;; Collect ignored elements or objects into IGNORE-LIST.
- (let ((type (org-element-type data)))
- (if (org-export--skip-p data options selected) (push data ignore)
- (if (and (eq type 'headline)
- (eq (plist-get options :with-archived-trees) 'headline)
- (org-element-property :archivedp data))
- ;; If headline is archived but tree below has
- ;; to be skipped, add it to ignore list.
- (mapc (lambda (e) (push e ignore))
- (org-element-contents data))
- ;; Move into secondary string, if any.
- (let ((sec-prop
- (cdr (assq type org-element-secondary-value-alist))))
- (when sec-prop
- (mapc walk-data (org-element-property sec-prop data))))
- ;; Move into recursive objects/elements.
- (mapc walk-data (org-element-contents data))))))))
- ;; Main call.
- (funcall walk-data data)
- ;; Return value.
- ignore))
-
(defun org-export--selected-trees (data info)
- "Return list of headlines and inlinetasks with a select tag in their tree.
+ "List headlines and inlinetasks with a select tag in their tree.
DATA is parsed data as returned by `org-element-parse-buffer'.
INFO is a plist holding export options."
- (let* (selected-trees
- walk-data ; For byte-compiler.
- (walk-data
- (function
- (lambda (data genealogy)
- (let ((type (org-element-type data)))
- (cond
- ((memq type '(headline inlinetask))
- (let ((tags (org-element-property :tags data)))
- (if (loop for tag in (plist-get info :select-tags)
- thereis (member tag tags))
- ;; When a select tag is found, mark full
- ;; genealogy and every headline within the tree
- ;; as acceptable.
- (setq selected-trees
- (append
- genealogy
- (org-element-map data '(headline inlinetask)
- 'identity)
- selected-trees))
- ;; If at a headline, continue searching in tree,
- ;; recursively.
- (when (eq type 'headline)
- (mapc (lambda (el)
- (funcall walk-data el (cons data genealogy)))
- (org-element-contents data))))))
- ((or (eq type 'org-data)
- (memq type org-element-greater-elements))
- (mapc (lambda (el) (funcall walk-data el genealogy))
- (org-element-contents data)))))))))
- (funcall walk-data data nil)
- selected-trees))
-
-(defun org-export--skip-p (blob options selected)
- "Non-nil when element or object BLOB should be skipped during export.
+ (let ((select (plist-get info :select-tags)))
+ (if (cl-some (lambda (tag) (member tag select)) (plist-get info :filetags))
+ ;; If FILETAGS contains a select tag, every headline or
+ ;; inlinetask is returned.
+ (org-element-map data '(headline inlinetask) #'identity)
+ (letrec ((selected-trees nil)
+ (walk-data
+ (lambda (data genealogy)
+ (let ((type (org-element-type data)))
+ (cond
+ ((memq type '(headline inlinetask))
+ (let ((tags (org-element-property :tags data)))
+ (if (cl-some (lambda (tag) (member tag select)) tags)
+ ;; When a select tag is found, mark full
+ ;; genealogy and every headline within the
+ ;; tree as acceptable.
+ (setq selected-trees
+ (append
+ genealogy
+ (org-element-map data '(headline inlinetask)
+ #'identity)
+ selected-trees))
+ ;; If at a headline, continue searching in
+ ;; tree, recursively.
+ (when (eq type 'headline)
+ (dolist (el (org-element-contents data))
+ (funcall walk-data el (cons data genealogy)))))))
+ ((or (eq type 'org-data)
+ (memq type org-element-greater-elements))
+ (dolist (el (org-element-contents data))
+ (funcall walk-data el genealogy))))))))
+ (funcall walk-data data nil)
+ selected-trees))))
+
+(defun org-export--skip-p (datum options selected)
+ "Non-nil when element or object DATUM should be skipped during export.
OPTIONS is the plist holding export options. SELECTED, when
non-nil, is a list of headlines or inlinetasks belonging to
a tree with a select tag."
- (case (org-element-type blob)
+ (cl-case (org-element-type datum)
+ ((comment comment-block)
+ ;; Skip all comments and comment blocks. Make to keep maximum
+ ;; number of blank lines around the comment so as to preserve
+ ;; local structure of the document upon interpreting it back into
+ ;; Org syntax.
+ (let* ((previous (org-export-get-previous-element datum options))
+ (before (or (org-element-property :post-blank previous) 0))
+ (after (or (org-element-property :post-blank datum) 0)))
+ (when previous
+ (org-element-put-property previous :post-blank (max before after 1))))
+ t)
(clock (not (plist-get options :with-clocks)))
(drawer
(let ((with-drawers-p (plist-get options :with-drawers)))
@@ -2063,31 +1837,32 @@ a tree with a select tag."
;; every drawer whose name belong to that list.
;; Otherwise, ignore drawers whose name isn't in that
;; list.
- (let ((name (org-element-property :drawer-name blob)))
+ (let ((name (org-element-property :drawer-name datum)))
(if (eq (car with-drawers-p) 'not)
(member-ignore-case name (cdr with-drawers-p))
(not (member-ignore-case name with-drawers-p))))))))
+ (fixed-width (not (plist-get options :with-fixed-width)))
((footnote-definition footnote-reference)
(not (plist-get options :with-footnotes)))
((headline inlinetask)
(let ((with-tasks (plist-get options :with-tasks))
- (todo (org-element-property :todo-keyword blob))
- (todo-type (org-element-property :todo-type blob))
+ (todo (org-element-property :todo-keyword datum))
+ (todo-type (org-element-property :todo-type datum))
(archived (plist-get options :with-archived-trees))
- (tags (org-element-property :tags blob)))
+ (tags (org-export-get-tags datum options nil t)))
(or
- (and (eq (org-element-type blob) 'inlinetask)
+ (and (eq (org-element-type datum) 'inlinetask)
(not (plist-get options :with-inlinetasks)))
;; Ignore subtrees with an exclude tag.
- (loop for k in (plist-get options :exclude-tags)
- thereis (member k tags))
+ (cl-loop for k in (plist-get options :exclude-tags)
+ thereis (member k tags))
;; When a select tag is present in the buffer, ignore any tree
;; without it.
- (and selected (not (memq blob selected)))
+ (and selected (not (memq datum selected)))
;; Ignore commented sub-trees.
- (org-element-property :commentedp blob)
+ (org-element-property :commentedp datum)
;; Ignore archived subtrees if `:with-archived-trees' is nil.
- (and (not archived) (org-element-property :archivedp blob))
+ (and (not archived) (org-element-property :archivedp datum))
;; Ignore tasks, if specified by `:with-tasks' property.
(and todo
(or (not with-tasks)
@@ -2095,18 +1870,26 @@ a tree with a select tag."
(not (eq todo-type with-tasks)))
(and (consp with-tasks) (not (member todo with-tasks))))))))
((latex-environment latex-fragment) (not (plist-get options :with-latex)))
+ (node-property
+ (let ((properties-set (plist-get options :with-properties)))
+ (cond ((null properties-set) t)
+ ((consp properties-set)
+ (not (member-ignore-case (org-element-property :key datum)
+ properties-set))))))
(planning (not (plist-get options :with-planning)))
+ (property-drawer (not (plist-get options :with-properties)))
(statistics-cookie (not (plist-get options :with-statistics-cookies)))
+ (table (not (plist-get options :with-tables)))
(table-cell
(and (org-export-table-has-special-column-p
- (org-export-get-parent-table blob))
- (not (org-export-get-previous-element blob options))))
- (table-row (org-export-table-row-is-special-p blob options))
+ (org-export-get-parent-table datum))
+ (org-export-first-sibling-p datum options)))
+ (table-row (org-export-table-row-is-special-p datum options))
(timestamp
;; `:with-timestamps' only applies to isolated timestamps
;; objects, i.e. timestamp objects in a paragraph containing only
;; timestamps and whitespaces.
- (when (let ((parent (org-export-get-parent-element blob)))
+ (when (let ((parent (org-export-get-parent-element datum)))
(and (memq (org-element-type parent) '(paragraph verse-block))
(not (org-element-map parent
(cons 'plain-text
@@ -2114,12 +1897,12 @@ a tree with a select tag."
(lambda (obj)
(or (not (stringp obj)) (org-string-nw-p obj)))
options t))))
- (case (plist-get options :with-timestamps)
- ('nil t)
+ (cl-case (plist-get options :with-timestamps)
+ ((nil) t)
(active
- (not (memq (org-element-property :type blob) '(active active-range))))
+ (not (memq (org-element-property :type datum) '(active active-range))))
(inactive
- (not (memq (org-element-property :type blob)
+ (not (memq (org-element-property :type datum)
'(inactive inactive-range)))))))))
@@ -2136,14 +1919,6 @@ a tree with a select tag."
;; `org-export-data' or even use a temporary back-end by using
;; `org-export-data-with-backend'.
;;
-;; Internally, three functions handle the filtering of objects and
-;; elements during the export. In particular,
-;; `org-export-ignore-element' marks an element or object so future
-;; parse tree traversals skip it, `org-export--interpret-p' tells which
-;; elements or objects should be seen as real Org syntax and
-;; `org-export-expand' transforms the others back into their original
-;; shape
-;;
;; `org-export-transcoder' is an accessor returning appropriate
;; translator function for a given element or object.
@@ -2152,7 +1927,7 @@ a tree with a select tag."
INFO is a plist containing export directives."
(let ((type (org-element-type blob)))
;; Return contents only for complete parse trees.
- (if (eq type 'org-data) (lambda (blob contents info) contents)
+ (if (eq type 'org-data) (lambda (_datum contents _info) contents)
(let ((transcoder (cdr (assq type (plist-get info :translate-alist)))))
(and (functionp transcoder) transcoder)))))
@@ -2164,101 +1939,103 @@ string. INFO is a plist holding export options.
Return a string."
(or (gethash data (plist-get info :exported-data))
- (let* ((type (org-element-type data))
- (results
- (cond
- ;; Ignored element/object.
- ((memq data (plist-get info :ignore-list)) nil)
- ;; Plain text.
- ((eq type 'plain-text)
- (org-export-filter-apply-functions
- (plist-get info :filter-plain-text)
- (let ((transcoder (org-export-transcoder data info)))
- (if transcoder (funcall transcoder data info) data))
- info))
- ;; Uninterpreted element/object: change it back to Org
- ;; syntax and export again resulting raw string.
- ((not (org-export--interpret-p data info))
- (org-export-data
- (org-export-expand
- data
- (mapconcat (lambda (blob) (org-export-data blob info))
- (org-element-contents data)
- ""))
- info))
- ;; Secondary string.
- ((not type)
- (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
- ;; Element/Object without contents or, as a special
- ;; case, headline with archive tag and archived trees
- ;; restricted to title only.
- ((or (not (org-element-contents data))
- (and (eq type 'headline)
- (eq (plist-get info :with-archived-trees) 'headline)
- (org-element-property :archivedp data)))
- (let ((transcoder (org-export-transcoder data info)))
- (or (and (functionp transcoder)
- (funcall transcoder data nil info))
- ;; Export snippets never return a nil value so
- ;; that white spaces following them are never
- ;; ignored.
- (and (eq type 'export-snippet) ""))))
- ;; Element/Object with contents.
- (t
- (let ((transcoder (org-export-transcoder data info)))
- (when transcoder
- (let* ((greaterp (memq type org-element-greater-elements))
- (objectp
- (and (not greaterp)
- (memq type org-element-recursive-objects)))
- (contents
- (mapconcat
- (lambda (element) (org-export-data element info))
- (org-element-contents
- (if (or greaterp objectp) data
- ;; Elements directly containing
- ;; objects must have their indentation
- ;; normalized first.
- (org-element-normalize-contents
- data
- ;; When normalizing contents of the
- ;; first paragraph in an item or
- ;; a footnote definition, ignore
- ;; first line's indentation: there is
- ;; none and it might be misleading.
- (when (eq type 'paragraph)
- (let ((parent (org-export-get-parent data)))
+ ;; Handle broken links according to
+ ;; `org-export-with-broken-links'.
+ (cl-macrolet
+ ((broken-link-handler
+ (&rest body)
+ `(condition-case err
+ (progn ,@body)
+ (org-link-broken
+ (pcase (plist-get info :with-broken-links)
+ (`nil (user-error "Unable to resolve link: %S" (nth 1 err)))
+ (`mark (org-export-data
+ (format "[BROKEN LINK: %s]" (nth 1 err)) info))
+ (_ nil))))))
+ (let* ((type (org-element-type data))
+ (parent (org-export-get-parent data))
+ (results
+ (cond
+ ;; Ignored element/object.
+ ((memq data (plist-get info :ignore-list)) nil)
+ ;; Plain text.
+ ((eq type 'plain-text)
+ (org-export-filter-apply-functions
+ (plist-get info :filter-plain-text)
+ (let ((transcoder (org-export-transcoder data info)))
+ (if transcoder (funcall transcoder data info) data))
+ info))
+ ;; Secondary string.
+ ((not type)
+ (mapconcat (lambda (obj) (org-export-data obj info)) data ""))
+ ;; Element/Object without contents or, as a special
+ ;; case, headline with archive tag and archived trees
+ ;; restricted to title only.
+ ((or (not (org-element-contents data))
+ (and (eq type 'headline)
+ (eq (plist-get info :with-archived-trees) 'headline)
+ (org-element-property :archivedp data)))
+ (let ((transcoder (org-export-transcoder data info)))
+ (or (and (functionp transcoder)
+ (broken-link-handler
+ (funcall transcoder data nil info)))
+ ;; Export snippets never return a nil value so
+ ;; that white spaces following them are never
+ ;; ignored.
+ (and (eq type 'export-snippet) ""))))
+ ;; Element/Object with contents.
+ (t
+ (let ((transcoder (org-export-transcoder data info)))
+ (when transcoder
+ (let* ((greaterp (memq type org-element-greater-elements))
+ (objectp
+ (and (not greaterp)
+ (memq type org-element-recursive-objects)))
+ (contents
+ (mapconcat
+ (lambda (element) (org-export-data element info))
+ (org-element-contents
+ (if (or greaterp objectp) data
+ ;; Elements directly containing
+ ;; objects must have their indentation
+ ;; normalized first.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing contents of the
+ ;; first paragraph in an item or
+ ;; a footnote definition, ignore
+ ;; first line's indentation: there is
+ ;; none and it might be misleading.
+ (when (eq type 'paragraph)
(and
(eq (car (org-element-contents parent))
data)
(memq (org-element-type parent)
- '(footnote-definition item))))))))
- "")))
- (funcall transcoder data
- (if (not greaterp) contents
- (org-element-normalize-string contents))
- info))))))))
- ;; Final result will be memoized before being returned.
- (puthash
- data
- (cond
- ((not results) "")
- ((memq type '(org-data plain-text nil)) results)
- ;; Append the same white space between elements or objects
- ;; as in the original buffer, and call appropriate filters.
- (t
- (let ((results
- (org-export-filter-apply-functions
- (plist-get info (intern (format ":filter-%s" type)))
- (let ((post-blank (or (org-element-property :post-blank data)
- 0)))
- (if (memq type org-element-all-elements)
- (concat (org-element-normalize-string results)
- (make-string post-blank ?\n))
- (concat results (make-string post-blank ?\s))))
- info)))
- results)))
- (plist-get info :exported-data)))))
+ '(footnote-definition item)))))))
+ "")))
+ (broken-link-handler
+ (funcall transcoder data
+ (if (not greaterp) contents
+ (org-element-normalize-string contents))
+ info)))))))))
+ ;; Final result will be memoized before being returned.
+ (puthash
+ data
+ (cond
+ ((not results) "")
+ ((memq type '(org-data plain-text nil)) results)
+ ;; Append the same white space between elements or objects
+ ;; as in the original buffer, and call appropriate filters.
+ (t
+ (org-export-filter-apply-functions
+ (plist-get info (intern (format ":filter-%s" type)))
+ (let ((blank (or (org-element-property :post-blank data) 0)))
+ (if (eq (org-element-class data parent) 'object)
+ (concat results (make-string blank ?\s))
+ (concat (org-element-normalize-string results)
+ (make-string blank ?\n))))
+ info)))
+ (plist-get info :exported-data))))))
(defun org-export-data-with-backend (data backend info)
"Convert DATA into BACKEND format.
@@ -2270,44 +2047,24 @@ channel.
Unlike to `org-export-with-backend', this function will
recursively convert DATA using BACKEND translation table."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
- (org-export-data
- data
- ;; Set-up a new communication channel with translations defined in
- ;; BACKEND as the translate table and a new hash table for
- ;; memoization.
- (org-combine-plists
- info
- (list :back-end backend
- :translate-alist (org-export-get-all-transcoders backend)
- ;; Size of the hash table is reduced since this function
- ;; will probably be used on small trees.
- :exported-data (make-hash-table :test 'eq :size 401)))))
-
-(defun org-export--interpret-p (blob info)
- "Non-nil if element or object BLOB should be interpreted during export.
-If nil, BLOB will appear as raw Org syntax. Check is done
-according to export options INFO, stored as a plist."
- (case (org-element-type blob)
- ;; ... entities...
- (entity (plist-get info :with-entities))
- ;; ... emphasis...
- ((bold italic strike-through underline)
- (plist-get info :with-emphasize))
- ;; ... fixed-width areas.
- (fixed-width (plist-get info :with-fixed-width))
- ;; ... LaTeX environments and fragments...
- ((latex-environment latex-fragment)
- (let ((with-latex-p (plist-get info :with-latex)))
- (and with-latex-p (not (eq with-latex-p 'verbatim)))))
- ;; ... sub/superscripts...
- ((subscript superscript)
- (let ((sub/super-p (plist-get info :with-sub-superscript)))
- (if (eq sub/super-p '{})
- (org-element-property :use-brackets-p blob)
- sub/super-p)))
- ;; ... tables...
- (table (plist-get info :with-tables))
- (otherwise t)))
+ ;; Set-up a new communication channel with translations defined in
+ ;; BACKEND as the translate table and a new hash table for
+ ;; memoization.
+ (let ((new-info
+ (org-combine-plists
+ info
+ (list :back-end backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ ;; Size of the hash table is reduced since this
+ ;; function will probably be used on small trees.
+ :exported-data (make-hash-table :test 'eq :size 401)))))
+ (prog1 (org-export-data data new-info)
+ ;; Preserve `:internal-references', as those do not depend on
+ ;; the back-end used; we need to make sure that any new
+ ;; reference when the temporary back-end was active gets through
+ ;; the default one.
+ (plist-put info :internal-references
+ (plist-get new-info :internal-references)))))
(defun org-export-expand (blob contents &optional with-affiliated)
"Expand a parsed element or object to its original state.
@@ -2318,18 +2075,12 @@ contents, as a string or nil.
When optional argument WITH-AFFILIATED is non-nil, add affiliated
keywords before output."
(let ((type (org-element-type blob)))
- (concat (and with-affiliated (memq type org-element-all-elements)
+ (concat (and with-affiliated
+ (eq (org-element-class blob) 'element)
(org-element--interpret-affiliated-keywords blob))
(funcall (intern (format "org-element-%s-interpreter" type))
blob contents))))
-(defun org-export-ignore-element (element info)
- "Add ELEMENT to `:ignore-list' in INFO.
-
-Any element in `:ignore-list' will be skipped when using
-`org-element-map'. INFO is modified by side effects."
- (plist-put info :ignore-list (cons element (plist-get info :ignore-list))))
-
;;; The Filter System
@@ -2360,9 +2111,13 @@ Any element in `:ignore-list' will be skipped when using
;; tree. Users can set it through
;; `org-export-filter-parse-tree-functions' variable.
;;
+;; - `:filter-body' applies to the body of the output, before template
+;; translator chimes in. Users can set it through
+;; `org-export-filter-body-functions' variable.
+;;
;; - `:filter-final-output' applies to the final transcoded string.
;; Users can set it with `org-export-filter-final-output-functions'
-;; variable
+;; variable.
;;
;; - `:filter-plain-text' applies to any string not recognized as Org
;; syntax. `org-export-filter-plain-text-functions' allows users to
@@ -2370,7 +2125,7 @@ Any element in `:ignore-list' will be skipped when using
;;
;; - `:filter-TYPE' applies on the string returned after an element or
;; object of type TYPE has been transcoded. A user can modify
-;; `org-export-filter-TYPE-functions'
+;; `org-export-filter-TYPE-functions' to install these filters.
;;
;; All filters sets are applied with
;; `org-export-filter-apply-functions' function. Filters in a set are
@@ -2433,6 +2188,13 @@ contains no Org syntax, the back-end, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
+(defvar org-export-filter-body-functions nil
+ "List of functions applied to transcoded body.
+Each filter is called with three arguments: a string which
+contains no Org syntax, the back-end, as a symbol, and the
+communication channel, as a plist. It must return a string or
+nil.")
+
(defvar org-export-filter-final-output-functions nil
"List of functions applied to the transcoded string.
Each filter is called with three arguments: the full transcoded
@@ -2461,18 +2223,6 @@ Each filter is called with three arguments: the transcoded data,
as a string, the back-end, as a symbol, and the communication
channel, as a plist. It must return a string or nil.")
-(defvar org-export-filter-comment-functions nil
- "List of functions applied to a transcoded comment.
-Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
-channel, as a plist. It must return a string or nil.")
-
-(defvar org-export-filter-comment-block-functions nil
- "List of functions applied to a transcoded comment-block.
-Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
-channel, as a plist. It must return a string or nil.")
-
(defvar org-export-filter-diary-sexp-functions nil
"List of functions applied to a transcoded diary-sexp.
Each filter is called with three arguments: the transcoded data,
@@ -2588,12 +2338,6 @@ data, as a string, the back-end, as a symbol, and the
communication channel, as a plist. It must return a string or
nil.")
-(defvar org-export-filter-quote-section-functions nil
- "List of functions applied to a transcoded quote-section.
-Each filter is called with three arguments: the transcoded data,
-as a string, the back-end, as a symbol, and the communication
-channel, as a plist. It must return a string or nil.")
-
(defvar org-export-filter-section-functions nil
"List of functions applied to a transcoded section.
Each filter is called with three arguments: the transcoded data,
@@ -2774,20 +2518,24 @@ channel, as a plist. It must return a string or nil.")
(defun org-export-filter-apply-functions (filters value info)
"Call every function in FILTERS.
-Functions are called with arguments VALUE, current export
-back-end's name and INFO. A function returning a nil value will
-be skipped. If it returns the empty string, the process ends and
-VALUE is ignored.
+Functions are called with three arguments: a value, the export
+back-end name and the communication channel. First function in
+FILTERS is called with VALUE as its first argument. Second
+function in FILTERS is called with the previous result as its
+value, etc.
+
+Functions returning nil are skipped. Any function returning the
+empty string ends the process, which returns the empty string.
Call is done in a LIFO fashion, to be sure that developer
specified filters, if any, are called first."
- (catch 'exit
+ (catch :exit
(let* ((backend (plist-get info :back-end))
(backend-name (and backend (org-export-backend-name backend))))
(dolist (filter filters value)
(let ((result (funcall filter value backend-name info)))
- (cond ((not result) value)
- ((equal value "") (throw 'exit nil))
+ (cond ((not result))
+ ((equal result "") (throw :exit ""))
(t (setq value result))))))))
(defun org-export-install-filters (info)
@@ -2797,29 +2545,27 @@ Return the updated communication channel."
(let (plist)
;; Install user-defined filters with `org-export-filters-alist'
;; and filters already in INFO (through ext-plist mechanism).
- (mapc (lambda (p)
- (let* ((prop (car p))
- (info-value (plist-get info prop))
- (default-value (symbol-value (cdr p))))
- (setq plist
- (plist-put plist prop
- ;; Filters in INFO will be called
- ;; before those user provided.
- (append (if (listp info-value) info-value
- (list info-value))
- default-value)))))
- org-export-filters-alist)
+ (dolist (p org-export-filters-alist)
+ (let* ((prop (car p))
+ (info-value (plist-get info prop))
+ (default-value (symbol-value (cdr p))))
+ (setq plist
+ (plist-put plist prop
+ ;; Filters in INFO will be called
+ ;; before those user provided.
+ (append (if (listp info-value) info-value
+ (list info-value))
+ default-value)))))
;; Prepend back-end specific filters to that list.
- (mapc (lambda (p)
- ;; Single values get consed, lists are appended.
- (let ((key (car p)) (value (cdr p)))
- (when value
- (setq plist
- (plist-put
- plist key
- (if (atom value) (cons value (plist-get plist key))
- (append value (plist-get plist key))))))))
- (org-export-get-all-filters (plist-get info :back-end)))
+ (dolist (p (org-export-get-all-filters (plist-get info :back-end)))
+ ;; Single values get consed, lists are appended.
+ (let ((key (car p)) (value (cdr p)))
+ (when value
+ (setq plist
+ (plist-put
+ plist key
+ (if (atom value) (cons value (plist-get plist key))
+ (append value (plist-get plist key))))))))
;; Return new communication channel.
(org-combine-plists info plist)))
@@ -2905,7 +2651,7 @@ The function assumes BUFFER's major mode is `org-mode'."
(when (consp entry)
(let ((var (car entry))
(val (cdr entry)))
- (and (not (eq var 'org-font-lock-keywords))
+ (and (not (memq var org-export-ignored-local-variables))
(or (memq var
'(default-directory
buffer-file-name
@@ -2932,21 +2678,301 @@ The function assumes BUFFER's major mode is `org-mode'."
(goto-char ,(point))
;; Overlays with invisible property.
,@(let (ov-set)
- (mapc
- (lambda (ov)
- (let ((invis-prop (overlay-get ov 'invisible)))
- (when invis-prop
- (push `(overlay-put
- (make-overlay ,(overlay-start ov)
- ,(overlay-end ov))
- 'invisible (quote ,invis-prop))
- ov-set))))
- (overlays-in (point-min) (point-max)))
- ov-set)))))
+ (dolist (ov (overlays-in (point-min) (point-max)) ov-set)
+ (let ((invis-prop (overlay-get ov 'invisible)))
+ (when invis-prop
+ (push `(overlay-put
+ (make-overlay ,(overlay-start ov)
+ ,(overlay-end ov))
+ 'invisible (quote ,invis-prop))
+ ov-set)))))))))
+
+(defun org-export--delete-comment-trees ()
+ "Delete commented trees and commented inlinetasks in the buffer.
+Narrowing, if any, is ignored."
+ (org-with-wide-buffer
+ (goto-char (point-min))
+ (let* ((case-fold-search t)
+ (regexp (concat org-outline-regexp-bol ".*" org-comment-string)))
+ (while (re-search-forward regexp nil t)
+ (let ((element (org-element-at-point)))
+ (when (org-element-property :commentedp element)
+ (delete-region (org-element-property :begin element)
+ (org-element-property :end element))))))))
+
+(defun org-export--prune-tree (data info)
+ "Prune non exportable elements from DATA.
+DATA is the parse tree to traverse. INFO is the plist holding
+export info. Also set `:ignore-list' in INFO to a list of
+objects which should be ignored during export, but not removed
+from tree."
+ (letrec ((ignore nil)
+ ;; First find trees containing a select tag, if any.
+ (selected (org-export--selected-trees data info))
+ (walk-data
+ (lambda (data)
+ ;; Prune non-exportable elements and objects from tree.
+ ;; As a special case, special rows and cells from tables
+ ;; are stored in IGNORE, as they still need to be
+ ;; accessed during export.
+ (when data
+ (let ((type (org-element-type data)))
+ (if (org-export--skip-p data info selected)
+ (if (memq type '(table-cell table-row)) (push data ignore)
+ (org-element-extract-element data))
+ (if (and (eq type 'headline)
+ (eq (plist-get info :with-archived-trees)
+ 'headline)
+ (org-element-property :archivedp data))
+ ;; If headline is archived but tree below has
+ ;; to be skipped, remove contents.
+ (org-element-set-contents data)
+ ;; Move into recursive objects/elements.
+ (mapc walk-data (org-element-contents data)))
+ ;; Move into secondary string, if any.
+ (dolist (p (cdr (assq type
+ org-element-secondary-value-alist)))
+ (mapc walk-data (org-element-property p data))))))))
+ (definitions
+ ;; Collect definitions before possibly pruning them so as
+ ;; to avoid parsing them again if they are required.
+ (org-element-map data '(footnote-definition footnote-reference)
+ (lambda (f)
+ (cond
+ ((eq 'footnote-definition (org-element-type f)) f)
+ ((and (eq 'inline (org-element-property :type f))
+ (org-element-property :label f))
+ f)
+ (t nil))))))
+ ;; If a select tag is active, also ignore the section before the
+ ;; first headline, if any.
+ (when selected
+ (let ((first-element (car (org-element-contents data))))
+ (when (eq (org-element-type first-element) 'section)
+ (org-element-extract-element first-element))))
+ ;; Prune tree and communication channel.
+ (funcall walk-data data)
+ (dolist (entry (append
+ ;; Priority is given to back-end specific options.
+ (org-export-get-all-options (plist-get info :back-end))
+ org-export-options-alist))
+ (when (eq (nth 4 entry) 'parse)
+ (funcall walk-data (plist-get info (car entry)))))
+ (let ((missing (org-export--missing-definitions data definitions)))
+ (funcall walk-data missing)
+ (org-export--install-footnote-definitions missing data))
+ ;; Eventually set `:ignore-list'.
+ (plist-put info :ignore-list ignore)))
+
+(defun org-export--missing-definitions (tree definitions)
+ "List footnote definitions missing from TREE.
+Missing definitions are searched within DEFINITIONS, which is
+a list of footnote definitions or in the widened buffer."
+ (let* ((list-labels
+ (lambda (data)
+ ;; List all footnote labels encountered in DATA. Inline
+ ;; footnote references are ignored.
+ (org-element-map data 'footnote-reference
+ (lambda (reference)
+ (and (eq (org-element-property :type reference) 'standard)
+ (org-element-property :label reference))))))
+ defined undefined missing-definitions)
+ ;; Partition DIRECT-REFERENCES between DEFINED and UNDEFINED
+ ;; references.
+ (let ((known-definitions
+ (org-element-map tree '(footnote-reference footnote-definition)
+ (lambda (f)
+ (and (or (eq (org-element-type f) 'footnote-definition)
+ (eq (org-element-property :type f) 'inline))
+ (org-element-property :label f)))))
+ seen)
+ (dolist (l (funcall list-labels tree))
+ (cond ((member l seen))
+ ((member l known-definitions) (push l defined))
+ (t (push l undefined)))))
+ ;; Complete MISSING-DEFINITIONS by finding the definition of every
+ ;; undefined label, first by looking into DEFINITIONS, then by
+ ;; searching the widened buffer. This is a recursive process
+ ;; since definitions found can themselves contain an undefined
+ ;; reference.
+ (while undefined
+ (let* ((label (pop undefined))
+ (definition
+ (cond
+ ((cl-some
+ (lambda (d) (and (equal (org-element-property :label d) label)
+ d))
+ definitions))
+ ((pcase (org-footnote-get-definition label)
+ (`(,_ ,beg . ,_)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (let ((datum (org-element-context)))
+ (if (eq (org-element-type datum) 'footnote-reference)
+ datum
+ ;; Parse definition with contents.
+ (save-restriction
+ (narrow-to-region
+ (org-element-property :begin datum)
+ (org-element-property :end datum))
+ (org-element-map (org-element-parse-buffer)
+ 'footnote-definition #'identity nil t))))))
+ (_ nil)))
+ (t (user-error "Definition not found for footnote %s" label)))))
+ (push label defined)
+ (push definition missing-definitions)
+ ;; Look for footnote references within DEFINITION, since
+ ;; we may need to also find their definition.
+ (dolist (l (funcall list-labels definition))
+ (unless (or (member l defined) ;Known label
+ (member l undefined)) ;Processed later
+ (push l undefined)))))
+ ;; MISSING-DEFINITIONS may contain footnote references with inline
+ ;; definitions. Make sure those are changed into real footnote
+ ;; definitions.
+ (mapcar (lambda (d)
+ (if (eq (org-element-type d) 'footnote-definition) d
+ (let ((label (org-element-property :label d)))
+ (apply #'org-element-create
+ 'footnote-definition `(:label ,label :post-blank 1)
+ (org-element-contents d)))))
+ missing-definitions)))
+
+(defun org-export--install-footnote-definitions (definitions tree)
+ "Install footnote definitions in tree.
+
+DEFINITIONS is the list of footnote definitions to install. TREE
+is the parse tree.
+
+If there is a footnote section in TREE, definitions found are
+appended to it. If `org-footnote-section' is non-nil, a new
+footnote section containing all definitions is inserted in TREE.
+Otherwise, definitions are appended at the end of the section
+containing their first reference."
+ (cond
+ ((null definitions))
+ ;; If there is a footnote section, insert definitions there.
+ ((let ((footnote-section
+ (org-element-map tree 'headline
+ (lambda (h) (and (org-element-property :footnote-section-p h) h))
+ nil t)))
+ (and footnote-section
+ (apply #'org-element-adopt-elements
+ footnote-section
+ (nreverse definitions)))))
+ ;; If there should be a footnote section, create one containing all
+ ;; the definitions at the end of the tree.
+ (org-footnote-section
+ (org-element-adopt-elements
+ tree
+ (org-element-create 'headline
+ (list :footnote-section-p t
+ :level 1
+ :title org-footnote-section
+ :raw-value org-footnote-section)
+ (apply #'org-element-create
+ 'section
+ nil
+ (nreverse definitions)))))
+ ;; Otherwise add each definition at the end of the section where it
+ ;; is first referenced.
+ (t
+ (letrec ((seen nil)
+ (insert-definitions
+ (lambda (data)
+ ;; Insert footnote definitions in the same section as
+ ;; their first reference in DATA.
+ (org-element-map data 'footnote-reference
+ (lambda (reference)
+ (when (eq (org-element-property :type reference) 'standard)
+ (let ((label (org-element-property :label reference)))
+ (unless (member label seen)
+ (push label seen)
+ (let ((definition
+ (cl-some
+ (lambda (d)
+ (and (equal (org-element-property :label d)
+ label)
+ d))
+ definitions)))
+ (org-element-adopt-elements
+ (org-element-lineage reference '(section))
+ definition)
+ ;; Also insert definitions for nested
+ ;; references, if any.
+ (funcall insert-definitions definition))))))))))
+ (funcall insert-definitions tree)))))
+
+(defun org-export--remove-uninterpreted-data (data info)
+ "Change uninterpreted elements back into Org syntax.
+DATA is a parse tree or a secondary string. INFO is a plist
+containing export options. It is modified by side effect and
+returned by the function."
+ (org-element-map data
+ '(entity bold italic latex-environment latex-fragment strike-through
+ subscript superscript underline)
+ (lambda (datum)
+ (let ((new
+ (cl-case (org-element-type datum)
+ ;; ... entities...
+ (entity
+ (and (not (plist-get info :with-entities))
+ (list (concat
+ (org-export-expand datum nil)
+ (make-string
+ (or (org-element-property :post-blank datum) 0)
+ ?\s)))))
+ ;; ... emphasis...
+ ((bold italic strike-through underline)
+ (and (not (plist-get info :with-emphasize))
+ (let ((marker (cl-case (org-element-type datum)
+ (bold "*")
+ (italic "/")
+ (strike-through "+")
+ (underline "_"))))
+ (append
+ (list marker)
+ (org-element-contents datum)
+ (list (concat
+ marker
+ (make-string
+ (or (org-element-property :post-blank datum)
+ 0)
+ ?\s)))))))
+ ;; ... LaTeX environments and fragments...
+ ((latex-environment latex-fragment)
+ (and (eq (plist-get info :with-latex) 'verbatim)
+ (list (org-export-expand datum nil))))
+ ;; ... sub/superscripts...
+ ((subscript superscript)
+ (let ((sub/super-p (plist-get info :with-sub-superscript))
+ (bracketp (org-element-property :use-brackets-p datum)))
+ (and (or (not sub/super-p)
+ (and (eq sub/super-p '{}) (not bracketp)))
+ (append
+ (list (concat
+ (if (eq (org-element-type datum) 'subscript)
+ "_"
+ "^")
+ (and bracketp "{")))
+ (org-element-contents datum)
+ (list (concat
+ (and bracketp "}")
+ (and (org-element-property :post-blank datum)
+ (make-string
+ (org-element-property :post-blank datum)
+ ?\s)))))))))))
+ (when new
+ ;; Splice NEW at DATUM location in parse tree.
+ (dolist (e new (org-element-extract-element datum))
+ (unless (equal e "") (org-element-insert-before e datum))))))
+ info nil nil t)
+ ;; Return modified parse tree.
+ data)
;;;###autoload
(defun org-export-as
- (backend &optional subtreep visible-only body-only ext-plist)
+ (backend &optional subtreep visible-only body-only ext-plist)
"Transcode current Org buffer into BACKEND code.
BACKEND is either an export back-end, as returned by, e.g.,
@@ -2978,75 +3004,76 @@ Return code as a string."
(save-excursion
(save-restriction
;; Narrow buffer to an appropriate region or subtree for
- ;; parsing. If parsing subtree, be sure to remove main headline
- ;; too.
+ ;; parsing. If parsing subtree, be sure to remove main
+ ;; headline, planning data and property drawer.
(cond ((org-region-active-p)
(narrow-to-region (region-beginning) (region-end)))
(subtreep
(org-narrow-to-subtree)
(goto-char (point-min))
- (forward-line)
+ (org-end-of-meta-data)
(narrow-to-region (point) (point-max))))
;; Initialize communication channel with original buffer
;; attributes, unavailable in its copy.
(let* ((org-export-current-backend (org-export-backend-name backend))
(info (org-combine-plists
- (list :export-options
- (delq nil
- (list (and subtreep 'subtree)
- (and visible-only 'visible-only)
- (and body-only 'body-only))))
+ (org-export--get-export-attributes
+ backend subtreep visible-only body-only)
(org-export--get-buffer-attributes)))
+ (parsed-keywords
+ (delq nil
+ (mapcar (lambda (o) (and (eq (nth 4 o) 'parse) (nth 1 o)))
+ (append (org-export-get-all-options backend)
+ org-export-options-alist))))
tree)
;; Update communication channel and get parse tree. Buffer
- ;; isn't parsed directly. Instead, a temporary copy is
- ;; created, where include keywords, macros are expanded and
- ;; code blocks are evaluated.
+ ;; isn't parsed directly. Instead, all buffer modifications
+ ;; and consequent parsing are undertaken in a temporary copy.
(org-export-with-buffer-copy
;; Run first hook with current back-end's name as argument.
(run-hook-with-args 'org-export-before-processing-hook
(org-export-backend-name backend))
+ ;; Include files, delete comments and expand macros.
(org-export-expand-include-keyword)
- ;; Update macro templates since #+INCLUDE keywords might have
- ;; added some new ones.
+ (org-export--delete-comment-trees)
(org-macro-initialize-templates)
- (org-macro-replace-all org-macro-templates)
- (org-export-execute-babel-code)
- ;; Update radio targets since keyword inclusion might have
- ;; added some more.
+ (org-macro-replace-all
+ (append org-macro-templates org-export-global-macros)
+ nil parsed-keywords)
+ ;; Refresh buffer properties and radio targets after
+ ;; potentially invasive previous changes. Likewise, do it
+ ;; again after executing Babel code.
+ (org-set-regexps-and-options)
(org-update-radio-target-regexp)
+ (when org-export-use-babel
+ (org-babel-exp-process-buffer)
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp))
;; Run last hook with current back-end's name as argument.
+ ;; Update buffer properties and radio targets one last time
+ ;; before parsing.
(goto-char (point-min))
(save-excursion
(run-hook-with-args 'org-export-before-parsing-hook
(org-export-backend-name backend)))
- ;; Update communication channel with environment. Also
- ;; install user's and developer's filters.
+ (org-set-regexps-and-options)
+ (org-update-radio-target-regexp)
+ ;; Update communication channel with environment.
(setq info
- (org-export-install-filters
- (org-combine-plists
- info (org-export-get-environment backend subtreep ext-plist))))
- ;; Special case: provide original file name or buffer name as
- ;; default value for :title property.
- (unless (plist-get info :title)
- (plist-put
- info :title
- (let ((file (plist-get info :input-file)))
- (if file (file-name-sans-extension (file-name-nondirectory file))
- (plist-get info :input-buffer)))))
- ;; Expand export-specific set of macros: {{{author}}},
- ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done
- ;; once regular macros have been expanded, since document
- ;; keywords may contain one of them.
- (org-macro-replace-all
- (list (cons "author"
- (org-element-interpret-data (plist-get info :author)))
- (cons "date"
- (org-element-interpret-data (plist-get info :date)))
- ;; EMAIL is not a parsed keyword: store it as-is.
- (cons "email" (or (plist-get info :email) ""))
- (cons "title"
- (org-element-interpret-data (plist-get info :title)))))
+ (org-combine-plists
+ info (org-export-get-environment backend subtreep ext-plist)))
+ ;; De-activate uninterpreted data from parsed keywords.
+ (dolist (entry (append (org-export-get-all-options backend)
+ org-export-options-alist))
+ (pcase entry
+ (`(,p ,_ ,_ ,_ parse)
+ (let ((value (plist-get info p)))
+ (plist-put info
+ p
+ (org-export--remove-uninterpreted-data value info))))
+ (_ nil)))
+ ;; Install user's and developer's filters.
+ (setq info (org-export-install-filters info))
;; Call options filters and update export options. We do not
;; use `org-export-filter-apply-functions' here since the
;; arity of such filters is different.
@@ -3054,24 +3081,54 @@ Return code as a string."
(dolist (filter (plist-get info :filter-options))
(let ((result (funcall filter info backend-name)))
(when result (setq info result)))))
- ;; Parse buffer and call parse-tree filter on it.
+ ;; Expand export-specific set of macros: {{{author}}},
+ ;; {{{date(FORMAT)}}}, {{{email}}} and {{{title}}}. It must
+ ;; be done once regular macros have been expanded, since
+ ;; parsed keywords may contain one of them.
+ (org-macro-replace-all
+ (list
+ (cons "author" (org-element-interpret-data (plist-get info :author)))
+ (cons "date"
+ (let* ((date (plist-get info :date))
+ (value (or (org-element-interpret-data date) "")))
+ (if (and (consp date)
+ (not (cdr date))
+ (eq (org-element-type (car date)) 'timestamp))
+ (format "(eval (if (org-string-nw-p \"$1\") %s %S))"
+ (format "(org-timestamp-format '%S \"$1\")"
+ (org-element-copy (car date)))
+ value)
+ value)))
+ (cons "email" (org-element-interpret-data (plist-get info :email)))
+ (cons "title" (org-element-interpret-data (plist-get info :title)))
+ (cons "results" "$1"))
+ 'finalize
+ parsed-keywords)
+ ;; Parse buffer.
+ (setq tree (org-element-parse-buffer nil visible-only))
+ ;; Prune tree from non-exported elements and transform
+ ;; uninterpreted elements or objects in both parse tree and
+ ;; communication channel.
+ (org-export--prune-tree tree info)
+ (org-export--remove-uninterpreted-data tree info)
+ ;; Call parse tree filters.
(setq tree
(org-export-filter-apply-functions
- (plist-get info :filter-parse-tree)
- (org-element-parse-buffer nil visible-only) info))
+ (plist-get info :filter-parse-tree) tree info))
;; Now tree is complete, compute its properties and add them
;; to communication channel.
- (setq info
- (org-combine-plists
- info (org-export-collect-tree-properties tree info)))
+ (setq info (org-export--collect-tree-properties tree info))
;; Eventually transcode TREE. Wrap the resulting string into
;; a template.
(let* ((body (org-element-normalize-string
(or (org-export-data tree info) "")))
(inner-template (cdr (assq 'inner-template
(plist-get info :translate-alist))))
- (full-body (if (not (functionp inner-template)) body
- (funcall inner-template body info)))
+ (full-body (org-export-filter-apply-functions
+ (plist-get info :filter-body)
+ (if (not (functionp inner-template)) body
+ (funcall inner-template body info))
+ info))
(template (cdr (assq 'template
(plist-get info :translate-alist)))))
;; Remove all text properties since they cannot be
@@ -3111,14 +3168,10 @@ Return code as a string."
BACKEND is either an export back-end, as returned by, e.g.,
`org-export-create-backend', or a symbol referring to
a registered back-end."
- (if (not (org-region-active-p))
- (user-error "No active region to replace")
- (let* ((beg (region-beginning))
- (end (region-end))
- (str (buffer-substring beg end)) rpl)
- (setq rpl (org-export-string-as str backend t))
- (delete-region beg end)
- (insert rpl))))
+ (unless (org-region-active-p) (user-error "No active region to replace"))
+ (insert
+ (org-export-string-as
+ (delete-and-extract-region (region-beginning) (region-end)) backend t)))
;;;###autoload
(defun org-export-insert-default-template (&optional backend subtreep)
@@ -3144,7 +3197,8 @@ locally for the subtree through node properties."
(cons "default"
(mapcar (lambda (b)
(symbol-name (org-export-backend-name b)))
- org-export--registered-backends))))))
+ org-export-registered-backends))
+ nil t))))
options keywords)
;; Populate OPTIONS and KEYWORDS.
(dolist (entry (cond ((eq backend 'default) org-export-options-alist)
@@ -3158,43 +3212,14 @@ locally for the subtree through node properties."
(keyword (unless (assoc keyword keywords)
(let ((value
(if (eq (nth 4 entry) 'split)
- (mapconcat 'identity (eval (nth 3 entry)) " ")
+ (mapconcat #'identity (eval (nth 3 entry)) " ")
(eval (nth 3 entry)))))
(push (cons keyword value) keywords))))
(option (unless (assoc option options)
(push (cons option (eval (nth 3 entry))) options))))))
;; Move to an appropriate location in order to insert options.
(unless subtreep (beginning-of-line))
- ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the
- ;; list of available keywords.
- (when (assoc "TITLE" keywords)
- (let ((title
- (or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
- (and visited-file
- (file-name-sans-extension
- (file-name-nondirectory visited-file))))
- (buffer-name (buffer-base-buffer)))))
- (if (not subtreep) (insert (format "#+TITLE: %s\n" title))
- (org-entry-put node "EXPORT_TITLE" title))))
- (when (assoc "DATE" keywords)
- (let ((date (with-temp-buffer (org-insert-time-stamp (current-time)))))
- (if (not subtreep) (insert "#+DATE: " date "\n")
- (org-entry-put node "EXPORT_DATE" date))))
- (when (assoc "AUTHOR" keywords)
- (let ((author (cdr (assoc "AUTHOR" keywords))))
- (if subtreep (org-entry-put node "EXPORT_AUTHOR" author)
- (insert
- (format "#+AUTHOR:%s\n"
- (if (not (org-string-nw-p author)) ""
- (concat " " author)))))))
- (when (assoc "EMAIL" keywords)
- (let ((email (cdr (assoc "EMAIL" keywords))))
- (if subtreep (org-entry-put node "EXPORT_EMAIL" email)
- (insert
- (format "#+EMAIL:%s\n"
- (if (not (org-string-nw-p email)) ""
- (concat " " email)))))))
- ;; Then (multiple) OPTIONS lines. Never go past fill-column.
+ ;; First (multiple) OPTIONS lines. Never go past fill-column.
(when options
(let ((items
(mapcar
@@ -3210,103 +3235,233 @@ locally for the subtree through node properties."
(< (+ width (length (car items)) 1) fill-column))
(let ((item (pop items)))
(insert " " item)
- (incf width (1+ (length item))))))
+ (cl-incf width (1+ (length item))))))
(insert "\n")))))
- ;; And the rest of keywords.
- (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2)))))
- (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL"))
- (let ((val (cdr key)))
- (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
- (insert
- (format "#+%s:%s\n"
- (car key)
- (if (org-string-nw-p val) (format " %s" val) "")))))))))
-
-(defun org-export-expand-include-keyword (&optional included dir)
+ ;; Then the rest of keywords, in the order specified in either
+ ;; `org-export-options-alist' or respective export back-ends.
+ (dolist (key (nreverse keywords))
+ (let ((val (cond ((equal (car key) "DATE")
+ (or (cdr key)
+ (with-temp-buffer
+ (org-insert-time-stamp (current-time)))))
+ ((equal (car key) "TITLE")
+ (or (let ((visited-file
+ (buffer-file-name (buffer-base-buffer))))
+ (and visited-file
+ (file-name-sans-extension
+ (file-name-nondirectory visited-file))))
+ (buffer-name (buffer-base-buffer))))
+ (t (cdr key)))))
+ (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val)
+ (insert
+ (format "#+%s:%s\n"
+ (car key)
+ (if (org-string-nw-p val) (format " %s" val) ""))))))))
+
+(defun org-export-expand-include-keyword (&optional included dir footnotes)
"Expand every include keyword in buffer.
Optional argument INCLUDED is a list of included file names along
with their line restriction, when appropriate. It is used to
avoid infinite recursion. Optional argument DIR is the current
working directory. It is used to properly resolve relative
-paths."
- (let ((case-fold-search t))
+paths. Optional argument FOOTNOTES is a hash-table used for
+storing and resolving footnotes. It is created automatically."
+ (let ((case-fold-search t)
+ (file-prefix (make-hash-table :test #'equal))
+ (current-prefix 0)
+ (footnotes (or footnotes (make-hash-table :test #'equal)))
+ (include-re "^[ \t]*#\\+INCLUDE:"))
+ ;; If :minlevel is not set the text-property
+ ;; `:org-include-induced-level' will be used to determine the
+ ;; relative level when expanding INCLUDE.
+ ;; Only affects included Org documents.
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
- (let ((element (save-match-data (org-element-at-point))))
- (when (eq (org-element-type element) 'keyword)
- (beginning-of-line)
- ;; Extract arguments from keyword's value.
- (let* ((value (org-element-property :value element))
- (ind (org-get-indentation))
- (file (and (string-match
- "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
- (prog1 (expand-file-name
- (org-remove-double-quotes
- (match-string 1 value))
- dir)
- (setq value (replace-match "" nil nil value)))))
- (lines
- (and (string-match
- ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
- value)
- (prog1 (match-string 1 value)
- (setq value (replace-match "" nil nil value)))))
- (env (cond ((string-match "\\<example\\>" value) 'example)
- ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
- (match-string 1 value))))
- ;; Minimal level of included file defaults to the child
- ;; level of the current headline, if any, or one. It
- ;; only applies is the file is meant to be included as
- ;; an Org one.
- (minlevel
- (and (not env)
- (if (string-match ":minlevel +\\([0-9]+\\)" value)
- (prog1 (string-to-number (match-string 1 value))
- (setq value (replace-match "" nil nil value)))
- (let ((cur (org-current-level)))
- (if cur (1+ (org-reduced-level cur)) 1))))))
- ;; Remove keyword.
- (delete-region (point) (progn (forward-line) (point)))
- (cond
- ((not file) nil)
- ((not (file-readable-p file))
- (error "Cannot include file %s" file))
- ;; Check if files has already been parsed. Look after
- ;; inclusion lines too, as different parts of the same file
- ;; can be included too.
- ((member (list file lines) included)
- (error "Recursive file inclusion: %s" file))
- (t
+ (while (re-search-forward include-re nil t)
+ (put-text-property (line-beginning-position) (line-end-position)
+ :org-include-induced-level
+ (1+ (org-reduced-level (or (org-current-level) 0)))))
+ ;; Expand INCLUDE keywords.
+ (goto-char (point-min))
+ (while (re-search-forward include-re nil t)
+ (unless (org-in-commented-heading-p)
+ (let ((element (save-match-data (org-element-at-point))))
+ (when (eq (org-element-type element) 'keyword)
+ (beginning-of-line)
+ ;; Extract arguments from keyword's value.
+ (let* ((value (org-element-property :value element))
+ (ind (org-get-indentation))
+ location
+ (file
+ (and (string-match
+ "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value)
+ (prog1
+ (save-match-data
+ (let ((matched (match-string 1 value)))
+ (when (string-match "\\(::\\(.*?\\)\\)\"?\\'"
+ matched)
+ (setq location (match-string 2 matched))
+ (setq matched
+ (replace-match "" nil nil matched 1)))
+ (expand-file-name
+ (org-unbracket-string "\"" "\"" matched)
+ dir)))
+ (setq value (replace-match "" nil nil value)))))
+ (only-contents
+ (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?"
+ value)
+ (prog1 (org-not-nil (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))))
+ (lines
+ (and (string-match
+ ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\""
+ value)
+ (prog1 (match-string 1 value)
+ (setq value (replace-match "" nil nil value)))))
+ (env (cond
+ ((string-match "\\<example\\>" value) 'literal)
+ ((string-match "\\<export\\(?: +\\(.*\\)\\)?" value)
+ 'literal)
+ ((string-match "\\<src\\(?: +\\(.*\\)\\)?" value)
+ 'literal)))
+ ;; Minimal level of included file defaults to the
+ ;; child level of the current headline, if any, or
+ ;; one. It only applies is the file is meant to be
+ ;; included as an Org one.
+ (minlevel
+ (and (not env)
+ (if (string-match ":minlevel +\\([0-9]+\\)" value)
+ (prog1 (string-to-number (match-string 1 value))
+ (setq value (replace-match "" nil nil value)))
+ (get-text-property (point)
+ :org-include-induced-level))))
+ (args (and (eq env 'literal) (match-string 1 value)))
+ (block (and (string-match "\\<\\(\\S-+\\)\\>" value)
+ (match-string 1 value))))
+ ;; Remove keyword.
+ (delete-region (point) (line-beginning-position 2))
(cond
- ((eq env 'example)
- (insert
- (let ((ind-str (make-string ind ? ))
- (contents
- (org-escape-code-in-string
- (org-export--prepare-file-contents file lines))))
- (format "%s#+BEGIN_EXAMPLE\n%s%s#+END_EXAMPLE\n"
- ind-str contents ind-str))))
- ((stringp env)
- (insert
- (let ((ind-str (make-string ind ? ))
- (contents
- (org-escape-code-in-string
- (org-export--prepare-file-contents file lines))))
- (format "%s#+BEGIN_SRC %s\n%s%s#+END_SRC\n"
- ind-str env contents ind-str))))
+ ((not file) nil)
+ ((not (file-readable-p file))
+ (error "Cannot include file %s" file))
+ ;; Check if files has already been parsed. Look after
+ ;; inclusion lines too, as different parts of the same
+ ;; file can be included too.
+ ((member (list file lines) included)
+ (error "Recursive file inclusion: %s" file))
(t
- (insert
- (with-temp-buffer
- (let ((org-inhibit-startup t)) (org-mode))
- (insert
- (org-export--prepare-file-contents file lines ind minlevel))
- (org-export-expand-include-keyword
- (cons (list file lines) included)
- (file-name-directory file))
- (buffer-string)))))))))))))
-
-(defun org-export--prepare-file-contents (file &optional lines ind minlevel)
- "Prepare the contents of FILE for inclusion and return them as a string.
+ (cond
+ ((eq env 'literal)
+ (insert
+ (let ((ind-str (make-string ind ?\s))
+ (arg-str (if (stringp args) (format " %s" args) ""))
+ (contents
+ (org-escape-code-in-string
+ (org-export--prepare-file-contents file lines))))
+ (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n"
+ ind-str block arg-str contents ind-str block))))
+ ((stringp block)
+ (insert
+ (let ((ind-str (make-string ind ?\s))
+ (contents
+ (org-export--prepare-file-contents file lines)))
+ (format "%s#+BEGIN_%s\n%s%s#+END_%s\n"
+ ind-str block contents ind-str block))))
+ (t
+ (insert
+ (with-temp-buffer
+ (let ((org-inhibit-startup t)
+ (lines
+ (if location
+ (org-export--inclusion-absolute-lines
+ file location only-contents lines)
+ lines)))
+ (org-mode)
+ (insert
+ (org-export--prepare-file-contents
+ file lines ind minlevel
+ (or
+ (gethash file file-prefix)
+ (puthash file (cl-incf current-prefix) file-prefix))
+ footnotes)))
+ (org-export-expand-include-keyword
+ (cons (list file lines) included)
+ (file-name-directory file)
+ footnotes)
+ (buffer-string)))))
+ ;; Expand footnotes after all files have been
+ ;; included. Footnotes are stored at end of buffer.
+ (unless included
+ (org-with-wide-buffer
+ (goto-char (point-max))
+ (maphash (lambda (k v)
+ (insert (format "\n[fn:%s] %s\n" k v)))
+ footnotes))))))))))))
+
+(defun org-export--inclusion-absolute-lines (file location only-contents lines)
+ "Resolve absolute lines for an included file with file-link.
+
+FILE is string file-name of the file to include. LOCATION is a
+string name within FILE to be included (located via
+`org-link-search'). If ONLY-CONTENTS is non-nil only the
+contents of the named element will be included, as determined
+Org-Element. If LINES is non-nil only those lines are included.
+
+Return a string of lines to be included in the format expected by
+`org-export--prepare-file-contents'."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (unless (eq major-mode 'org-mode)
+ (let ((org-inhibit-startup t)) (org-mode)))
+ (condition-case err
+ ;; Enforce consistent search.
+ (let ((org-link-search-must-match-exact-headline nil))
+ (org-link-search location))
+ (error
+ (error "%s for %s::%s" (error-message-string err) file location)))
+ (let* ((element (org-element-at-point))
+ (contents-begin
+ (and only-contents (org-element-property :contents-begin element))))
+ (narrow-to-region
+ (or contents-begin (org-element-property :begin element))
+ (org-element-property (if contents-begin :contents-end :end) element))
+ (when (and only-contents
+ (memq (org-element-type element) '(headline inlinetask)))
+ ;; Skip planning line and property-drawer.
+ (goto-char (point-min))
+ (when (looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re) (goto-char (match-end 0)))
+ (unless (bolp) (forward-line))
+ (narrow-to-region (point) (point-max))))
+ (when lines
+ (org-skip-whitespace)
+ (beginning-of-line)
+ (let* ((lines (split-string lines "-"))
+ (lbeg (string-to-number (car lines)))
+ (lend (string-to-number (cadr lines)))
+ (beg (if (zerop lbeg) (point-min)
+ (goto-char (point-min))
+ (forward-line (1- lbeg))
+ (point)))
+ (end (if (zerop lend) (point-max)
+ (goto-char beg)
+ (forward-line (1- lend))
+ (point))))
+ (narrow-to-region beg end)))
+ (let ((end (point-max)))
+ (goto-char (point-min))
+ (widen)
+ (let ((start-line (line-number-at-pos)))
+ (format "%d-%d"
+ start-line
+ (save-excursion
+ (+ start-line
+ (let ((counter 0))
+ (while (< (point) end) (cl-incf counter) (forward-line))
+ counter))))))))
+
+(defun org-export--prepare-file-contents
+ (file &optional lines ind minlevel id footnotes)
+ "Prepare contents of FILE for inclusion and return it as a string.
When optional argument LINES is a string specifying a range of
lines, include only those lines.
@@ -3314,12 +3469,20 @@ lines, include only those lines.
Optional argument IND, when non-nil, is an integer specifying the
global indentation of returned contents. Since its purpose is to
allow an included file to stay in the same environment it was
-created \(i.e., a list item), it doesn't apply past the first
+created (e.g., a list item), it doesn't apply past the first
headline encountered.
Optional argument MINLEVEL, when non-nil, is an integer
specifying the level that any top-level headline in the included
-file should have."
+file should have.
+
+Optional argument ID is an integer that will be inserted before
+each footnote definition and reference if FILE is an Org file.
+This is useful to avoid conflicts when more than one Org file
+with footnotes is included in a document.
+
+Optional argument FOOTNOTES is a hash-table to store footnotes in
+the included document."
(with-temp-buffer
(insert-file-contents file)
(when lines
@@ -3348,11 +3511,11 @@ file should have."
(delete-region (point) (point-max))
;; If IND is set, preserve indentation of include keyword until
;; the first headline encountered.
- (when ind
+ (when (and ind (> ind 0))
(unless (eq major-mode 'org-mode)
(let ((org-inhibit-startup t)) (org-mode)))
(goto-char (point-min))
- (let ((ind-str (make-string ind ? )))
+ (let ((ind-str (make-string ind ?\s)))
(while (not (or (eobp) (looking-at org-outline-regexp-bol)))
;; Do not move footnote definitions out of column 0.
(unless (and (looking-at org-footnote-definition-re)
@@ -3370,25 +3533,67 @@ file should have."
(let ((levels (org-map-entries
(lambda () (org-reduced-level (org-current-level))))))
(when levels
- (let ((offset (- minlevel (apply 'min levels))))
+ (let ((offset (- minlevel (apply #'min levels))))
(unless (zerop offset)
(when org-odd-levels-only (setq offset (* offset 2)))
;; Only change stars, don't bother moving whole
;; sections.
(org-map-entries
- (lambda () (if (< offset 0) (delete-char (abs offset))
- (insert (make-string offset ?*)))))))))))
+ (lambda ()
+ (if (< offset 0) (delete-char (abs offset))
+ (insert (make-string offset ?*)))))))))))
+ ;; Append ID to all footnote references and definitions, so they
+ ;; become file specific and cannot collide with footnotes in other
+ ;; included files. Further, collect relevant footnote definitions
+ ;; outside of LINES, in order to reintroduce them later.
+ (when id
+ (let ((marker-min (point-min-marker))
+ (marker-max (point-max-marker))
+ (get-new-label
+ (lambda (label)
+ ;; Generate new label from LABEL by prefixing it with
+ ;; "-ID-".
+ (format "-%d-%s" id label)))
+ (set-new-label
+ (lambda (f old new)
+ ;; Replace OLD label with NEW in footnote F.
+ (save-excursion
+ (goto-char (+ (org-element-property :begin f) 4))
+ (looking-at (regexp-quote old))
+ (replace-match new))))
+ (seen-alist))
+ (goto-char (point-min))
+ (while (re-search-forward org-footnote-re nil t)
+ (let ((footnote (save-excursion
+ (backward-char)
+ (org-element-context))))
+ (when (memq (org-element-type footnote)
+ '(footnote-definition footnote-reference))
+ (let* ((label (org-element-property :label footnote)))
+ ;; Update the footnote-reference at point and collect
+ ;; the new label, which is only used for footnotes
+ ;; outsides LINES.
+ (when label
+ (let ((seen (cdr (assoc label seen-alist))))
+ (if seen (funcall set-new-label footnote label seen)
+ (let ((new (funcall get-new-label label)))
+ (push (cons label new) seen-alist)
+ (org-with-wide-buffer
+ (let* ((def (org-footnote-get-definition label))
+ (beg (nth 1 def)))
+ (when (and def
+ (or (< beg marker-min)
+ (>= beg marker-max)))
+ ;; Store since footnote-definition is
+ ;; outside of LINES.
+ (puthash new
+ (org-element-normalize-string (nth 3 def))
+ footnotes))))
+ (funcall set-new-label footnote label new)))))))))
+ (set-marker marker-min nil)
+ (set-marker marker-max nil)))
(org-element-normalize-string (buffer-string))))
-(defun org-export-execute-babel-code ()
- "Execute every Babel code in the visible part of current buffer."
- ;; Get a pristine copy of current buffer so Babel references can be
- ;; properly resolved.
- (let ((reference (org-export-copy-buffer)))
- (unwind-protect (let ((org-current-export-file reference))
- (org-babel-exp-process-buffer))
- (kill-buffer reference))))
-
(defun org-export--copy-to-kill-ring-p ()
"Return a non-nil value when output should be added to the kill ring.
See also `org-export-copy-to-kill-ring'."
@@ -3483,17 +3688,20 @@ the communication channel used for export, as a plist."
(when (symbolp backend) (setq backend (org-export-get-backend backend)))
(org-export-barf-if-invalid-backend backend)
(let ((type (org-element-type data)))
- (if (memq type '(nil org-data)) (error "No foreign transcoder available")
- (let* ((all-transcoders (org-export-get-all-transcoders backend))
- (transcoder (cdr (assq type all-transcoders))))
- (if (not (functionp transcoder))
- (error "No foreign transcoder available")
- (funcall
- transcoder data contents
- (org-combine-plists
- info (list :back-end backend
- :translate-alist all-transcoders
- :exported-data (make-hash-table :test 'eq :size 401)))))))))
+ (when (memq type '(nil org-data)) (error "No foreign transcoder available"))
+ (let* ((all-transcoders (org-export-get-all-transcoders backend))
+ (transcoder (cdr (assq type all-transcoders))))
+ (unless (functionp transcoder) (error "No foreign transcoder available"))
+ (let ((new-info
+ (org-combine-plists
+ info (list
+ :back-end backend
+ :translate-alist all-transcoders
+ :exported-data (make-hash-table :test #'eq :size 401)))))
+ ;; `:internal-references' are shared across back-ends.
+ (prog1 (funcall transcoder data contents new-info)
+ (plist-put info :internal-references
+ (plist-get new-info :internal-references)))))))
;;;; For Export Snippets
@@ -3529,127 +3737,168 @@ applied."
;; `org-export-get-footnote-number' provide easier access to
;; additional information relative to a footnote reference.
-(defun org-export-collect-footnote-definitions (data info)
+(defun org-export-get-footnote-definition (footnote-reference info)
+ "Return definition of FOOTNOTE-REFERENCE as parsed data.
+INFO is the plist used as a communication channel. If no such
+definition can be found, raise an error."
+ (let ((label (org-element-property :label footnote-reference)))
+ (if (not label) (org-element-contents footnote-reference)
+ (let ((cache (or (plist-get info :footnote-definition-cache)
+ (let ((hash (make-hash-table :test #'equal)))
+ (plist-put info :footnote-definition-cache hash)
+ hash))))
+ (or
+ (gethash label cache)
+ (puthash label
+ (org-element-map (plist-get info :parse-tree)
+ '(footnote-definition footnote-reference)
+ (lambda (f)
+ (cond
+ ;; Skip any footnote with a different label.
+ ;; Also skip any standard footnote reference
+ ;; with the same label since those cannot
+ ;; contain a definition.
+ ((not (equal (org-element-property :label f) label)) nil)
+ ((eq (org-element-property :type f) 'standard) nil)
+ ((org-element-contents f))
+ ;; Even if the contents are empty, we can not
+ ;; return nil since that would eventually raise
+ ;; the error. Instead, return the equivalent
+ ;; empty string.
+ (t "")))
+ info t)
+ cache)
+ (error "Definition not found for footnote %s" label))))))
+
+(defun org-export--footnote-reference-map
+ (function data info &optional body-first)
+ "Apply FUNCTION on every footnote reference in DATA.
+INFO is a plist containing export state. By default, as soon as
+a new footnote reference is encountered, FUNCTION is called onto
+its definition. However, if BODY-FIRST is non-nil, this step is
+delayed until the end of the process."
+ (letrec ((definitions nil)
+ (seen-refs nil)
+ (search-ref
+ (lambda (data delayp)
+ ;; Search footnote references through DATA, filling
+ ;; SEEN-REFS along the way. When DELAYP is non-nil,
+ ;; store footnote definitions so they can be entered
+ ;; later.
+ (org-element-map data 'footnote-reference
+ (lambda (f)
+ (funcall function f)
+ (let ((--label (org-element-property :label f)))
+ (unless (and --label (member --label seen-refs))
+ (when --label (push --label seen-refs))
+ ;; Search for subsequent references in footnote
+ ;; definition so numbering follows reading
+ ;; logic, unless DELAYP in non-nil.
+ (cond
+ (delayp
+ (push (org-export-get-footnote-definition f info)
+ definitions))
+ ;; Do not force entering inline definitions,
+ ;; since `org-element-map' already traverses
+ ;; them at the right time.
+ ((eq (org-element-property :type f) 'inline))
+ (t (funcall search-ref
+ (org-export-get-footnote-definition f info)
+ nil))))))
+ info nil
+ ;; Don't enter footnote definitions since it will
+ ;; happen when their first reference is found.
+ ;; Moreover, if DELAYP is non-nil, make sure we
+ ;; postpone entering definitions of inline references.
+ (if delayp '(footnote-definition footnote-reference)
+ 'footnote-definition)))))
+ (funcall search-ref data body-first)
+ (funcall search-ref (nreverse definitions) nil)))
+
+(defun org-export-collect-footnote-definitions (info &optional data body-first)
"Return an alist between footnote numbers, labels and definitions.
-DATA is the parse tree from which definitions are collected.
-INFO is the plist used as a communication channel.
-
-Definitions are sorted by order of references. They either
-appear as Org data or as a secondary string for inlined
-footnotes. Unreferenced definitions are ignored."
- (let* (num-alist
- collect-fn ; for byte-compiler.
- (collect-fn
- (function
- (lambda (data)
- ;; Collect footnote number, label and definition in DATA.
- (org-element-map data 'footnote-reference
- (lambda (fn)
- (when (org-export-footnote-first-reference-p fn info)
- (let ((def (org-export-get-footnote-definition fn info)))
- (push
- (list (org-export-get-footnote-number fn info)
- (org-element-property :label fn)
- def)
- num-alist)
- ;; Also search in definition for nested footnotes.
- (when (eq (org-element-property :type fn) 'standard)
- (funcall collect-fn def)))))
- ;; Don't enter footnote definitions since it will happen
- ;; when their first reference is found.
- info nil 'footnote-definition)))))
- (funcall collect-fn (plist-get info :parse-tree))
- (reverse num-alist)))
-
-(defun org-export-footnote-first-reference-p (footnote-reference info)
+INFO is the current export state, as a plist.
+
+Definitions are collected throughout the whole parse tree, or
+DATA when non-nil.
+
+Sorting is done by order of references. As soon as a new
+reference is encountered, other references are searched within
+its definition. However, if BODY-FIRST is non-nil, this step is
+delayed after the whole tree is checked. This alters results
+when references are found in footnote definitions.
+
+Definitions either appear as Org data or as a secondary string
+for inlined footnotes. Unreferenced definitions are ignored."
+ (let ((n 0) labels alist)
+ (org-export--footnote-reference-map
+ (lambda (f)
+ ;; Collect footnote number, label and definition.
+ (let ((l (org-element-property :label f)))
+ (unless (and l (member l labels))
+ (cl-incf n)
+ (push (list n l (org-export-get-footnote-definition f info)) alist))
+ (when l (push l labels))))
+ (or data (plist-get info :parse-tree)) info body-first)
+ (nreverse alist)))
+
+(defun org-export-footnote-first-reference-p
+ (footnote-reference info &optional data body-first)
"Non-nil when a footnote reference is the first one for its label.
FOOTNOTE-REFERENCE is the footnote reference being considered.
-INFO is the plist used as a communication channel."
- (let ((label (org-element-property :label footnote-reference)))
- ;; Anonymous footnotes are always a first reference.
- (if (not label) t
- ;; Otherwise, return the first footnote with the same LABEL and
- ;; test if it is equal to FOOTNOTE-REFERENCE.
- (let* (search-refs ; for byte-compiler.
- (search-refs
- (function
- (lambda (data)
- (org-element-map data 'footnote-reference
- (lambda (fn)
- (cond
- ((string= (org-element-property :label fn) label)
- (throw 'exit fn))
- ;; If FN isn't inlined, be sure to traverse its
- ;; definition before resuming search. See
- ;; comments in `org-export-get-footnote-number'
- ;; for more information.
- ((eq (org-element-property :type fn) 'standard)
- (funcall search-refs
- (org-export-get-footnote-definition fn info)))))
- ;; Don't enter footnote definitions since it will
- ;; happen when their first reference is found.
- info 'first-match 'footnote-definition)))))
- (eq (catch 'exit (funcall search-refs (plist-get info :parse-tree)))
- footnote-reference)))))
+INFO is a plist containing current export state.
-(defun org-export-get-footnote-definition (footnote-reference info)
- "Return definition of FOOTNOTE-REFERENCE as parsed data.
-INFO is the plist used as a communication channel. If no such
-definition can be found, return the \"DEFINITION NOT FOUND\"
-string."
- (let ((label (org-element-property :label footnote-reference)))
- (or (org-element-property :inline-definition footnote-reference)
- (cdr (assoc label (plist-get info :footnote-definition-alist)))
- "DEFINITION NOT FOUND.")))
+Search is done throughout the whole parse tree, or DATA when
+non-nil.
-(defun org-export-get-footnote-number (footnote info)
+By default, as soon as a new footnote reference is encountered,
+other references are searched within its definition. However, if
+BODY-FIRST is non-nil, this step is delayed after the whole tree
+is checked. This alters results when references are found in
+footnote definitions."
+ (let ((label (org-element-property :label footnote-reference)))
+ ;; Anonymous footnotes are always a first reference.
+ (or (not label)
+ (catch 'exit
+ (org-export--footnote-reference-map
+ (lambda (f)
+ (let ((l (org-element-property :label f)))
+ (when (and l label (string= label l))
+ (throw 'exit (eq footnote-reference f)))))
+ (or data (plist-get info :parse-tree)) info body-first)))))
+
+(defun org-export-get-footnote-number (footnote info &optional data body-first)
"Return number associated to a footnote.
FOOTNOTE is either a footnote reference or a footnote definition.
-INFO is the plist used as a communication channel."
- (let* ((label (org-element-property :label footnote))
- seen-refs
- search-ref ; For byte-compiler.
- (search-ref
- (function
- (lambda (data)
- ;; Search footnote references through DATA, filling
- ;; SEEN-REFS along the way.
- (org-element-map data 'footnote-reference
- (lambda (fn)
- (let ((fn-lbl (org-element-property :label fn)))
- (cond
- ;; Anonymous footnote match: return number.
- ((and (not fn-lbl) (eq fn footnote))
- (throw 'exit (1+ (length seen-refs))))
- ;; Labels match: return number.
- ((and label (string= label fn-lbl))
- (throw 'exit (1+ (length seen-refs))))
- ;; Anonymous footnote: it's always a new one.
- ;; Also, be sure to return nil from the `cond' so
- ;; `first-match' doesn't get us out of the loop.
- ((not fn-lbl) (push 'inline seen-refs) nil)
- ;; Label not seen so far: add it so SEEN-REFS.
- ;;
- ;; Also search for subsequent references in
- ;; footnote definition so numbering follows
- ;; reading logic. Note that we don't have to care
- ;; about inline definitions, since
- ;; `org-element-map' already traverses them at the
- ;; right time.
- ;;
- ;; Once again, return nil to stay in the loop.
- ((not (member fn-lbl seen-refs))
- (push fn-lbl seen-refs)
- (funcall search-ref
- (org-export-get-footnote-definition fn info))
- nil))))
- ;; Don't enter footnote definitions since it will
- ;; happen when their first reference is found.
- info 'first-match 'footnote-definition)))))
- (catch 'exit (funcall search-ref (plist-get info :parse-tree)))))
+INFO is the plist containing export state.
+
+Number is unique throughout the whole parse tree, or DATA, when
+non-nil.
+
+By default, as soon as a new footnote reference is encountered,
+counting process moves into its definition. However, if
+BODY-FIRST is non-nil, this step is delayed until the end of the
+process, leading to a different order when footnotes are nested."
+ (let ((count 0)
+ (seen)
+ (label (org-element-property :label footnote)))
+ (catch 'exit
+ (org-export--footnote-reference-map
+ (lambda (f)
+ (let ((l (org-element-property :label f)))
+ (cond
+ ;; Anonymous footnote match: return number.
+ ((and (not l) (not label) (eq footnote f)) (throw 'exit (1+ count)))
+ ;; Labels match: return number.
+ ((and label l (string= label l)) (throw 'exit (1+ count)))
+ ;; Otherwise store label and increase counter if label
+ ;; wasn't encountered yet.
+ ((not l) (cl-incf count))
+ ((not (member l seen)) (push l seen) (cl-incf count)))))
+ (or data (plist-get info :parse-tree)) info body-first))))
;;;; For Headlines
@@ -3657,9 +3906,11 @@ INFO is the plist used as a communication channel."
;; `org-export-get-relative-level' is a shortcut to get headline
;; level, relatively to the lower headline level in the parsed tree.
;;
-;; `org-export-get-headline-number' returns the section number of a
+;; `org-export-get-headline-number' returns the section number of an
;; headline, while `org-export-number-to-roman' allows it to be
-;; converted to roman numbers.
+;; converted to roman numbers. With an optional argument,
+;; `org-export-get-headline-number' returns a number to unnumbered
+;; headlines (used for internal id).
;;
;; `org-export-low-level-p', `org-export-first-sibling-p' and
;; `org-export-last-sibling-p' are three useful predicates when it
@@ -3695,16 +3946,18 @@ and the last level being considered as high enough, or nil."
(and (> level limit) (- level limit))))))
(defun org-export-get-headline-number (headline info)
- "Return HEADLINE numbering as a list of numbers.
+ "Return numbered HEADLINE numbering as a list of numbers.
INFO is a plist holding contextual information."
- (cdr (assoc headline (plist-get info :headline-numbering))))
+ (and (org-export-numbered-headline-p headline info)
+ (cdr (assq headline (plist-get info :headline-numbering)))))
(defun org-export-numbered-headline-p (headline info)
"Return a non-nil value if HEADLINE element should be numbered.
INFO is a plist used as a communication channel."
- (let ((sec-num (plist-get info :section-numbers))
- (level (org-export-get-relative-level headline info)))
- (if (wholenump sec-num) (<= level sec-num) sec-num)))
+ (unless (org-not-nil (org-export-get-node-property :UNNUMBERED headline t))
+ (let ((sec-num (plist-get info :section-numbers))
+ (level (org-export-get-relative-level headline info)))
+ (if (wholenump sec-num) (<= level sec-num) sec-num))))
(defun org-export-number-to-roman (n)
"Convert integer N into a roman numeral."
@@ -3728,30 +3981,21 @@ INFO is a plist used as a communication channel."
ELEMENT has either an `headline' or an `inlinetask' type. INFO
is a plist used as a communication channel.
-Select tags (see `org-export-select-tags') and exclude tags (see
-`org-export-exclude-tags') are removed from the list.
-
When non-nil, optional argument TAGS should be a list of strings.
Any tag belonging to this list will also be removed.
When optional argument INHERITED is non-nil, tags can also be
inherited from parent headlines and FILETAGS keywords."
- (org-remove-if
- (lambda (tag) (or (member tag (plist-get info :select-tags))
- (member tag (plist-get info :exclude-tags))
- (member tag tags)))
+ (cl-remove-if
+ (lambda (tag) (member tag tags))
(if (not inherited) (org-element-property :tags element)
;; Build complete list of inherited tags.
(let ((current-tag-list (org-element-property :tags element)))
- (mapc
- (lambda (parent)
- (mapc
- (lambda (tag)
- (when (and (memq (org-element-type parent) '(headline inlinetask))
- (not (member tag current-tag-list)))
- (push tag current-tag-list)))
- (org-element-property :tags parent)))
- (org-export-get-genealogy element))
+ (dolist (parent (org-element-lineage element))
+ (dolist (tag (org-element-property :tags parent))
+ (when (and (memq (org-element-type parent) '(headline inlinetask))
+ (not (member tag current-tag-list)))
+ (push tag current-tag-list))))
;; Add FILETAGS keywords and return results.
(org-uniquify (append (plist-get info :filetags) current-tag-list))))))
@@ -3768,7 +4012,7 @@ Return value is a string or nil."
(let ((headline (if (eq (org-element-type blob) 'headline) blob
(org-export-get-parent-headline blob))))
(if (not inherited) (org-element-property property blob)
- (let ((parent headline) value)
+ (let ((parent headline))
(catch 'found
(while parent
(when (plist-member (nth 1 parent) property)
@@ -3783,19 +4027,7 @@ INFO is a plist used as a communication channel.
CATEGORY is automatically inherited from a parent headline, from
#+CATEGORY: keyword or created out of original file name. If all
fail, the fall-back value is \"???\"."
- (or (let ((headline (if (eq (org-element-type blob) 'headline) blob
- (org-export-get-parent-headline blob))))
- ;; Almost like `org-export-node-property', but we cannot trust
- ;; `plist-member' as every headline has a `:CATEGORY'
- ;; property, would it be nil or equal to "???" (which has the
- ;; same meaning).
- (let ((parent headline) value)
- (catch 'found
- (while parent
- (let ((category (org-element-property :CATEGORY parent)))
- (and category (not (equal "???" category))
- (throw 'found category)))
- (setq parent (org-element-property :parent parent))))))
+ (or (org-export-get-node-property :CATEGORY blob t)
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (kwd)
(when (equal (org-element-property :key kwd) "CATEGORY")
@@ -3805,23 +4037,31 @@ fail, the fall-back value is \"???\"."
(and file (file-name-sans-extension (file-name-nondirectory file))))
"???"))
-(defun org-export-get-alt-title (headline info)
+(defun org-export-get-alt-title (headline _)
"Return alternative title for HEADLINE, as a secondary string.
-INFO is a plist used as a communication channel. If no optional
-title is defined, fall-back to the regular title."
- (or (org-element-property :alt-title headline)
- (org-element-property :title headline)))
-
-(defun org-export-first-sibling-p (headline info)
- "Non-nil when HEADLINE is the first sibling in its sub-tree.
-INFO is a plist used as a communication channel."
- (not (eq (org-element-type (org-export-get-previous-element headline info))
- 'headline)))
-
-(defun org-export-last-sibling-p (headline info)
- "Non-nil when HEADLINE is the last sibling in its sub-tree.
-INFO is a plist used as a communication channel."
- (not (org-export-get-next-element headline info)))
+If no optional title is defined, fall-back to the regular title."
+ (let ((alt (org-element-property :ALT_TITLE headline)))
+ (if alt (org-element-parse-secondary-string
+ alt (org-element-restriction 'headline) headline)
+ (org-element-property :title headline))))
+
+(defun org-export-first-sibling-p (blob info)
+ "Non-nil when BLOB is the first sibling in its parent.
+BLOB is an element or an object. If BLOB is a headline, non-nil
+means it is the first sibling in the sub-tree. INFO is a plist
+used as a communication channel."
+ (memq (org-element-type (org-export-get-previous-element blob info))
+ '(nil section)))
+
+(defun org-export-last-sibling-p (datum info)
+ "Non-nil when DATUM is the last sibling in its parent.
+DATUM is an element or an object. INFO is a plist used as
+a communication channel."
+ (let ((next (org-export-get-next-element datum info)))
+ (or (not next)
+ (and (eq 'headline (org-element-type datum))
+ (> (org-element-property :level datum)
+ (org-element-property :level next))))))
;;;; For Keywords
@@ -3852,8 +4092,8 @@ meant to be translated with `org-export-data' or alike."
;;;; For Links
;;
-;; `org-export-solidify-link-text' turns a string into a safer version
-;; for links, replacing most non-standard characters with hyphens.
+;; `org-export-custom-protocol-maybe' handles custom protocol defined
+;; in `org-link-parameters'.
;;
;; `org-export-get-coderef-format' returns an appropriate format
;; string for coderefs.
@@ -3863,20 +4103,45 @@ meant to be translated with `org-export-data' or alike."
;;
;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links
;; (i.e. links with "fuzzy" as type) within the parsed tree, and
-;; returns an appropriate unique identifier when found, or nil.
+;; returns an appropriate unique identifier.
;;
;; `org-export-resolve-id-link' returns the first headline with
;; specified id or custom-id in parse tree, the path to the external
-;; file with the id or nil when neither was found.
+;; file with the id.
;;
;; `org-export-resolve-coderef' associates a reference to a line
;; number in the element it belongs, or returns the reference itself
;; when the element isn't numbered.
+;;
+;; `org-export-file-uri' expands a filename as stored in :path value
+;; of a "file" link into a file URI.
+;;
+;; Broken links raise a `org-link-broken' error, which is caught by
+;; `org-export-data' for further processing, depending on
+;; `org-export-with-broken-links' value.
-(defun org-export-solidify-link-text (s)
- "Take link text S and make a safe target out of it."
- (save-match-data
- (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-")))
+(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.
+
+DESC is its description, as a string, or nil. BACKEND is the
+back-end used for export, as a symbol.
+
+Return output as a string, or nil if no protocol handles LINK.
+
+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"))
+ (not backend))
+ (let ((protocol (org-link-get-parameter type :export)))
+ (and (functionp protocol)
+ (funcall protocol
+ (org-link-unescape (org-element-property :path link))
+ desc
+ backend))))))
(defun org-export-get-coderef-format (path desc)
"Return format string for code reference link.
@@ -3902,18 +4167,57 @@ the provided rules is non-nil. The default rule is
This only applies to links without a description."
(and (not (org-element-contents link))
- (let ((case-fold-search t)
- (rules (or rules org-export-default-inline-image-rule)))
- (catch 'exit
- (mapc
- (lambda (rule)
- (and (string= (org-element-property :type link) (car rule))
- (string-match (cdr rule)
- (org-element-property :path link))
- (throw 'exit t)))
- rules)
- ;; Return nil if no rule matched.
- nil))))
+ (let ((case-fold-search t))
+ (cl-some (lambda (rule)
+ (and (string= (org-element-property :type link) (car rule))
+ (string-match-p (cdr rule)
+ (org-element-property :path link))))
+ (or rules org-export-default-inline-image-rule)))))
+
+(defun org-export-insert-image-links (data info &optional rules)
+ "Insert image links in DATA.
+
+Org syntax does not support nested links. Nevertheless, some
+export back-ends support images as descriptions of links. Since
+images are really links to image files, we need to make an
+exception about links nesting.
+
+This function recognizes links whose contents are really images
+and turn them into proper nested links. It is meant to be used
+as a parse tree filter in back-ends supporting such constructs.
+
+DATA is a parse tree. INFO is the current state of the export
+process, as a plist.
+
+A description is a valid images if it matches any rule in RULES,
+if non-nil, or `org-export-default-inline-image-rule' otherwise.
+See `org-export-inline-image-p' for more information about the
+structure of RULES.
+
+Return modified DATA."
+ (let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'"
+ org-plain-link-re
+ org-angle-link-re))
+ (case-fold-search t))
+ (org-element-map data 'link
+ (lambda (l)
+ (let ((contents (org-element-interpret-data (org-element-contents l))))
+ (when (and (org-string-nw-p contents)
+ (string-match link-re contents))
+ (let ((type (match-string 1 contents))
+ (path (match-string 2 contents)))
+ (when (cl-some (lambda (rule)
+ (and (string= type (car rule))
+ (string-match-p (cdr rule) path)))
+ (or rules org-export-default-inline-image-rule))
+ ;; Replace contents with image link.
+ (org-element-adopt-elements
+ (org-element-set-contents l nil)
+ (with-temp-buffer
+ (save-excursion (insert contents))
+ (org-element-link-parser))))))))
+ info nil nil t))
+ data)
(defun org-export-resolve-coderef (ref info)
"Resolve a code reference REF.
@@ -3921,33 +4225,90 @@ This only applies to links without a description."
INFO is a plist used as a communication channel.
Return associated line number in source code, or REF itself,
-depending on src-block or example element's switches."
- (org-element-map (plist-get info :parse-tree) '(example-block src-block)
- (lambda (el)
- (with-temp-buffer
- (insert (org-trim (org-element-property :value el)))
- (let* ((label-fmt (regexp-quote
- (or (org-element-property :label-fmt el)
- org-coderef-label-format)))
- (ref-re
- (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$"
- (replace-regexp-in-string "%s" ref label-fmt nil t))))
- ;; Element containing REF is found. Resolve it to either
- ;; a label or a line number, as needed.
- (when (re-search-backward ref-re nil t)
- (cond
- ((org-element-property :use-labels el) ref)
- ((eq (org-element-property :number-lines el) 'continued)
- (+ (org-export-get-loc el info) (line-number-at-pos)))
- (t (line-number-at-pos)))))))
- info 'first-match))
+depending on src-block or example element's switches. Throw an
+error if no block contains REF."
+ (or (org-element-map (plist-get info :parse-tree) '(example-block src-block)
+ (lambda (el)
+ (with-temp-buffer
+ (insert (org-trim (org-element-property :value el)))
+ (let* ((label-fmt (or (org-element-property :label-fmt el)
+ org-coderef-label-format))
+ (ref-re (org-src-coderef-regexp label-fmt ref)))
+ ;; Element containing REF is found. Resolve it to
+ ;; either a label or a line number, as needed.
+ (when (re-search-backward ref-re nil t)
+ (if (org-element-property :use-labels el) ref
+ (+ (or (org-export-get-loc el info) 0)
+ (line-number-at-pos)))))))
+ info 'first-match)
+ (signal 'org-link-broken (list ref))))
+
+(defun org-export-search-cells (datum)
+ "List search cells for element or object DATUM.
+
+A search cell follows the pattern (TYPE . SEARCH) where
+
+ TYPE is a symbol among `headline', `custom-id', `target' and
+ `other'.
+
+ SEARCH is the string a link is expected to match. More
+ accurately, it is
+
+ - headline's title, as a list of strings, if TYPE is
+ `headline'.
+
+ - CUSTOM_ID value, as a string, if TYPE is `custom-id'.
+
+ - target's or radio-target's name as a list of strings if
+ TYPE is `target'.
+
+ - NAME affiliated keyword is TYPE is `other'.
+
+A search cell is the internal representation of a fuzzy link. It
+ignores white spaces and statistics cookies, if applicable."
+ (pcase (org-element-type datum)
+ (`headline
+ (let ((title (split-string
+ (replace-regexp-in-string
+ "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]" ""
+ (org-element-property :raw-value datum)))))
+ (delq nil
+ (list
+ (cons 'headline title)
+ (cons 'other title)
+ (let ((custom-id (org-element-property :custom-id datum)))
+ (and custom-id (cons 'custom-id custom-id)))))))
+ (`target
+ (list (cons 'target (split-string (org-element-property :value datum)))))
+ ((and (let name (org-element-property :name datum))
+ (guard name))
+ (list (cons 'other (split-string name))))
+ (_ nil)))
+
+(defun org-export-string-to-search-cell (s)
+ "Return search cells associated to string S.
+S is either the path of a fuzzy link or a search option, i.e., it
+tries to match either a headline (through custom ID or title),
+a target or a named element."
+ (pcase (string-to-char s)
+ (?* (list (cons 'headline (split-string (substring s 1)))))
+ (?# (list (cons 'custom-id (substring s 1))))
+ ((let search (split-string s))
+ (list (cons 'target search) (cons 'other search)))))
+
+(defun org-export-match-search-cell-p (datum cells)
+ "Non-nil when DATUM matches search cells CELLS.
+DATUM is an element or object. CELLS is a list of search cells,
+as returned by `org-export-search-cells'."
+ (let ((targets (org-export-search-cells datum)))
+ (and targets (cl-some (lambda (cell) (member cell targets)) cells))))
(defun org-export-resolve-fuzzy-link (link info)
"Return LINK destination.
INFO is a plist holding contextual information.
-Return value can be an object, an element, or nil:
+Return value can be an object or an element:
- If LINK path matches a target object (i.e. <<path>>) return it.
@@ -3955,86 +4316,41 @@ Return value can be an object, an element, or nil:
(i.e. #+NAME: path) of an element, return that element.
- If LINK path exactly matches any headline name, return that
- element. If more than one headline share that name, priority
- will be given to the one with the closest common ancestor, if
- any, or the first one in the parse tree otherwise.
+ element.
-- Otherwise, return nil.
+- Otherwise, throw an error.
Assume LINK type is \"fuzzy\". White spaces are not
significant."
- (let* ((raw-path (org-element-property :path link))
- (match-title-p (eq (aref raw-path 0) ?*))
- ;; Split PATH at white spaces so matches are space
- ;; insensitive.
- (path (org-split-string
- (if match-title-p (substring raw-path 1) raw-path)))
- ;; Cache for destinations that are not position dependent.
- (link-cache
- (or (plist-get info :resolve-fuzzy-link-cache)
- (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache
- (make-hash-table :test 'equal)))
- :resolve-fuzzy-link-cache)))
- (cached (gethash path link-cache 'not-found)))
- (cond
- ;; Destination is not position dependent: use cached value.
- ((and (not match-title-p) (not (eq cached 'not-found))) cached)
- ;; First try to find a matching "<<path>>" unless user specified
- ;; he was looking for a headline (path starts with a "*"
- ;; character).
- ((and (not match-title-p)
- (let ((match (org-element-map (plist-get info :parse-tree) 'target
- (lambda (blob)
- (and (equal (org-split-string
- (org-element-property :value blob))
- path)
- blob))
- info 'first-match)))
- (and match (puthash path match link-cache)))))
- ;; Then try to find an element with a matching "#+NAME: path"
- ;; affiliated keyword.
- ((and (not match-title-p)
- (let ((match (org-element-map (plist-get info :parse-tree)
- org-element-all-elements
- (lambda (el)
- (let ((name (org-element-property :name el)))
- (when (and name
- (equal (org-split-string name) path))
- el)))
- info 'first-match)))
- (and match (puthash path match link-cache)))))
- ;; Last case: link either points to a headline or to nothingness.
- ;; Try to find the source, with priority given to headlines with
- ;; the closest common ancestor. If such candidate is found,
- ;; return it, otherwise return nil.
- (t
- (let ((find-headline
- (function
- ;; Return first headline whose `:raw-value' property is
- ;; NAME in parse tree DATA, or nil. Statistics cookies
- ;; are ignored.
- (lambda (name data)
- (org-element-map data 'headline
- (lambda (headline)
- (when (equal (org-split-string
- (replace-regexp-in-string
- "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
- (org-element-property :raw-value headline)))
- name)
- headline))
- info 'first-match)))))
- ;; Search among headlines sharing an ancestor with link, from
- ;; closest to farthest.
- (catch 'exit
- (mapc
- (lambda (parent)
- (let ((foundp (funcall find-headline path parent)))
- (when foundp (throw 'exit foundp))))
- (let ((parent-hl (org-export-get-parent-headline link)))
- (if (not parent-hl) (list (plist-get info :parse-tree))
- (cons parent-hl (org-export-get-genealogy parent-hl)))))
- ;; No destination found: return nil.
- (and (not match-title-p) (puthash path nil link-cache))))))))
+ (let* ((search-cells (org-export-string-to-search-cell
+ (org-link-unescape (org-element-property :path link))))
+ (link-cache (or (plist-get info :resolve-fuzzy-link-cache)
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :resolve-fuzzy-link-cache table)
+ table)))
+ (cached (gethash search-cells link-cache 'not-found)))
+ (if (not (eq cached 'not-found)) cached
+ (let ((matches
+ (org-element-map (plist-get info :parse-tree)
+ (cons 'target org-element-all-elements)
+ (lambda (datum)
+ (and (org-export-match-search-cell-p datum search-cells)
+ datum)))))
+ (unless matches
+ (signal 'org-link-broken (list (org-element-property :path link))))
+ (puthash
+ search-cells
+ ;; There can be multiple matches for un-typed searches, i.e.,
+ ;; for searches not starting with # or *. In this case,
+ ;; prioritize targets and names over headline titles.
+ ;; Matching both a name and a target is not valid, and
+ ;; therefore undefined.
+ (or (cl-some (lambda (datum)
+ (and (not (eq (org-element-type datum) 'headline))
+ datum))
+ matches)
+ (car matches))
+ link-cache)))))
(defun org-export-resolve-id-link (link info)
"Return headline referenced as LINK destination.
@@ -4042,18 +4358,19 @@ significant."
INFO is a plist used as a communication channel.
Return value can be the headline element matched in current parse
-tree, a file name or nil. Assume LINK type is either \"id\" or
-\"custom-id\"."
+tree or a file name. Assume LINK type is either \"id\" or
+\"custom-id\". Throw an error if no match is found."
(let ((id (org-element-property :path link)))
;; First check if id is within the current parse tree.
(or (org-element-map (plist-get info :parse-tree) 'headline
(lambda (headline)
- (when (or (string= (org-element-property :ID headline) id)
- (string= (org-element-property :CUSTOM_ID headline) id))
+ (when (or (equal (org-element-property :ID headline) id)
+ (equal (org-element-property :CUSTOM_ID headline) id))
headline))
info 'first-match)
;; Otherwise, look for external files.
- (cdr (assoc id (plist-get info :id-alist))))))
+ (cdr (assoc id (plist-get info :id-alist)))
+ (signal 'org-link-broken (list id)))))
(defun org-export-resolve-radio-link (link info)
"Return radio-target object referenced as LINK destination.
@@ -4074,12 +4391,93 @@ has type \"radio\"."
radio))
info 'first-match)))
+(defun org-export-file-uri (filename)
+ "Return file URI associated to FILENAME."
+ (cond ((string-prefix-p "//" filename) (concat "file:" filename))
+ ((not (file-name-absolute-p filename)) filename)
+ ((org-file-remote-p filename) (concat "file:/" filename))
+ (t
+ (let ((fullname (expand-file-name filename)))
+ (concat (if (string-prefix-p "/" fullname) "file://" "file:///")
+ fullname)))))
;;;; For References
;;
+;; `org-export-get-reference' associate a unique reference for any
+;; object or element. It uses `org-export-new-reference' and
+;; `org-export-format-reference' to, respectively, generate new
+;; internal references and turn them into a string suitable for
+;; output.
+;;
;; `org-export-get-ordinal' associates a sequence number to any object
;; or element.
+(defun org-export-new-reference (references)
+ "Return a unique reference, among REFERENCES.
+REFERENCES is an alist whose values are in-use references, as
+numbers. Returns a number, which is the internal representation
+of a reference. See also `org-export-format-reference'."
+ ;; Generate random 7 digits hexadecimal numbers. Collisions
+ ;; increase exponentially with the numbers of references. However,
+ ;; the odds for encountering at least one collision with 1000 active
+ ;; references in the same document are roughly 0.2%, so this
+ ;; shouldn't be the bottleneck.
+ (let ((new (random #x10000000)))
+ (while (rassq new references) (setq new (random #x10000000)))
+ new))
+
+(defun org-export-format-reference (reference)
+ "Format REFERENCE into a string.
+REFERENCE is a number representing a reference, as returned by
+`org-export-new-reference', which see."
+ (format "org%07x" reference))
+
+(defun org-export-get-reference (datum info)
+ "Return a unique reference for DATUM, as a string.
+
+DATUM is either an element or an object. INFO is the current
+export state, as a plist.
+
+This function checks `:crossrefs' property in INFO for search
+cells matching DATUM before creating a new reference. Returned
+reference consists of alphanumeric characters only."
+ (let ((cache (plist-get info :internal-references)))
+ (or (car (rassq datum cache))
+ (let* ((crossrefs (plist-get info :crossrefs))
+ (cells (org-export-search-cells datum))
+ ;; Preserve any pre-existing association between
+ ;; a search cell and a reference, i.e., when some
+ ;; previously published document referenced a location
+ ;; within current file (see
+ ;; `org-publish-resolve-external-link').
+ ;;
+ ;; However, there is no guarantee that search cells are
+ ;; unique, e.g., there might be duplicate custom ID or
+ ;; two headings with the same title in the file.
+ ;;
+ ;; As a consequence, before re-using any reference to
+ ;; an element or object, we check that it doesn't refer
+ ;; to a previous element or object.
+ (new (or (cl-some
+ (lambda (cell)
+ (let ((stored (cdr (assoc cell crossrefs))))
+ (when stored
+ (let ((old (org-export-format-reference stored)))
+ (and (not (assoc old cache)) stored)))))
+ cells)
+ (org-export-new-reference cache)))
+ (reference-string (org-export-format-reference new)))
+ ;; Cache contains both data already associated to
+ ;; a reference and in-use internal references, so as to make
+ ;; unique references.
+ (dolist (cell cells) (push (cons cell new) cache))
+ ;; Retain a direct association between reference string and
+ ;; DATUM since (1) not every object or element can be given
+ ;; a search cell (2) it permits quick lookup.
+ (push (cons reference-string datum) cache)
+ (plist-put info :internal-references cache)
+ reference-string))))
+
(defun org-export-get-ordinal (element info &optional types predicate)
"Return ordinal number of an element or object.
@@ -4107,14 +4505,10 @@ objects of the same type."
;; table, item, or headline containing the object.
(when (eq (org-element-type element) 'target)
(setq element
- (loop for parent in (org-export-get-genealogy element)
- when
- (memq
- (org-element-type parent)
- '(footnote-definition footnote-reference headline item
- table))
- return parent)))
- (case (org-element-type element)
+ (org-element-lineage
+ element
+ '(footnote-definition footnote-reference headline item table))))
+ (cl-case (org-element-type element)
;; Special case 1: A headline returns its number as a list.
(headline (org-export-get-headline-number element info))
;; Special case 2: An item returns its number as a list.
@@ -4134,8 +4528,8 @@ objects of the same type."
(lambda (el)
(cond
((eq element el) (1+ counter))
- ((not predicate) (incf counter) nil)
- ((funcall predicate el info) (incf counter) nil)))
+ ((not predicate) (cl-incf counter) nil)
+ ((funcall predicate el info) (cl-incf counter) nil)))
info 'first-match)))))
@@ -4162,32 +4556,34 @@ objects of the same type."
;; code in a format suitable for plain text or verbatim output.
(defun org-export-get-loc (element info)
- "Return accumulated lines of code up to ELEMENT.
-
-INFO is the plist used as a communication channel.
-
-ELEMENT is excluded from count."
- (let ((loc 0))
- (org-element-map (plist-get info :parse-tree)
- `(src-block example-block ,(org-element-type element))
- (lambda (el)
- (cond
- ;; ELEMENT is reached: Quit the loop.
- ((eq el element))
- ;; Only count lines from src-block and example-block elements
- ;; with a "+n" or "-n" switch. A "-n" switch resets counter.
- ((not (memq (org-element-type el) '(src-block example-block))) nil)
- ((let ((linums (org-element-property :number-lines el)))
- (when linums
- ;; Accumulate locs or reset them.
- (let ((lines (org-count-lines
- (org-trim (org-element-property :value el)))))
- (setq loc (if (eq linums 'new) lines (+ loc lines))))))
- ;; Return nil to stay in the loop.
- nil)))
- info 'first-match)
- ;; Return value.
- loc))
+ "Return count of lines of code before ELEMENT.
+
+ELEMENT is an example-block or src-block element. INFO is the
+plist used as a communication channel.
+
+Count includes every line of code in example-block or src-block
+with a \"+n\" or \"-n\" switch before block. Return nil if
+ELEMENT doesn't allow line numbering."
+ (pcase (org-element-property :number-lines element)
+ (`(new . ,n) n)
+ (`(continued . ,n)
+ (let ((loc 0))
+ (org-element-map (plist-get info :parse-tree) '(src-block example-block)
+ (lambda (el)
+ ;; ELEMENT is reached: Quit loop and return locs.
+ (if (eq el element) (+ loc n)
+ ;; Only count lines from src-block and example-block
+ ;; elements with a "+n" or "-n" switch.
+ (let ((linum (org-element-property :number-lines el)))
+ (when linum
+ (let ((lines (org-count-lines
+ (org-element-property :value el))))
+ ;; Accumulate locs or reset them.
+ (pcase linum
+ (`(new . ,n) (setq loc (+ n lines)))
+ (`(continued . ,n) (cl-incf loc (+ n lines)))))))
+ nil)) ;Return nil to stay in the loop.
+ info 'first-match)))))
(defun org-export-unravel-code (element)
"Clean source code and extract references out of it.
@@ -4195,38 +4591,33 @@ ELEMENT is excluded from count."
ELEMENT has either a `src-block' an `example-block' type.
Return a cons cell whose CAR is the source code, cleaned from any
-reference and protective comma and CDR is an alist between
-relative line number (integer) and name of code reference on that
-line (string)."
+reference, protective commas and spurious indentation, and CDR is
+an alist between relative line number (integer) and name of code
+reference on that line (string)."
(let* ((line 0) refs
- ;; Get code and clean it. Remove blank lines at its
- ;; beginning and end.
+ (value (org-element-property :value element))
+ ;; Remove global indentation from code, if necessary. Also
+ ;; remove final newline character, since it doesn't belongs
+ ;; to the code proper.
(code (replace-regexp-in-string
- "\\`\\([ \t]*\n\\)+" ""
- (replace-regexp-in-string
- "\\([ \t]*\n\\)*[ \t]*\\'" "\n"
- (org-element-property :value element))))
- ;; Get format used for references.
- (label-fmt (regexp-quote
- (or (org-element-property :label-fmt element)
- org-coderef-label-format)))
+ "\n\\'" ""
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent element))
+ value
+ (org-remove-indentation value))))
;; Build a regexp matching a loc with a reference.
- (with-ref-re
- (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$"
- (replace-regexp-in-string
- "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t))))
+ (ref-re (org-src-coderef-regexp (org-src-coderef-format element))))
;; Return value.
(cons
;; Code with references removed.
- (org-element-normalize-string
- (mapconcat
- (lambda (loc)
- (incf line)
- (if (not (string-match with-ref-re loc)) loc
- ;; Ref line: remove ref, and signal its position in REFS.
- (push (cons line (match-string 3 loc)) refs)
- (replace-match "" nil nil loc 1)))
- (org-split-string code "\n") "\n"))
+ (mapconcat
+ (lambda (loc)
+ (cl-incf line)
+ (if (not (string-match ref-re loc)) loc
+ ;; Ref line: remove ref, and add its position in REFS.
+ (push (cons line (match-string 3 loc)) refs)
+ (replace-match "" nil nil loc 1)))
+ (split-string code "\n") "\n")
;; Reference alist.
refs)))
@@ -4249,15 +4640,16 @@ number (i.e. ignoring NUM-LINES) and the name of the code
reference on it. If it is nil, FUN's third argument will always
be nil. It can be obtained through the use of
`org-export-unravel-code' function."
- (let ((--locs (org-split-string code "\n"))
+ (let ((--locs (split-string code "\n"))
(--line 0))
- (org-element-normalize-string
+ (concat
(mapconcat
(lambda (--loc)
- (incf --line)
+ (cl-incf --line)
(let ((--ref (cdr (assq --line ref-alist))))
(funcall fun --loc (and num-lines (+ num-lines --line)) --ref)))
- --locs "\n"))))
+ --locs "\n")
+ "\n")))
(defun org-export-format-code-default (element info)
"Return source code from ELEMENT, formatted in a standard way.
@@ -4274,14 +4666,12 @@ code."
;; Extract code and references.
(let* ((code-info (org-export-unravel-code element))
(code (car code-info))
- (code-lines (org-split-string code "\n")))
+ (code-lines (split-string code "\n")))
(if (null code-lines) ""
(let* ((refs (and (org-element-property :retain-labels element)
(cdr code-info)))
;; Handle line numbering.
- (num-start (case (org-element-property :number-lines element)
- (continued (org-export-get-loc element info))
- (new 0)))
+ (num-start (org-export-get-loc element info))
(num-fmt
(and num-start
(format "%%%ds "
@@ -4301,9 +4691,9 @@ code."
number-str
loc
(and ref
- (concat (make-string
- (- (+ 6 max-width)
- (+ (length loc) (length number-str))) ? )
+ (concat (make-string (- (+ 6 max-width)
+ (+ (length loc) (length number-str)))
+ ?\s)
(format "(%s)" ref))))))
num-start refs)))))
@@ -4331,30 +4721,30 @@ code."
;; `org-export-table-cell-ends-colgroup-p',
;; `org-export-table-row-starts-rowgroup-p',
;; `org-export-table-row-ends-rowgroup-p',
-;; `org-export-table-row-starts-header-p' and
-;; `org-export-table-row-ends-header-p' indicate position of current
-;; row or cell within the table.
+;; `org-export-table-row-starts-header-p',
+;; `org-export-table-row-ends-header-p' and
+;; `org-export-table-row-in-header-p' indicate position of current row
+;; or cell within the table.
(defun org-export-table-has-special-column-p (table)
"Non-nil when TABLE has a special column.
All special columns will be ignored during export."
;; The table has a special column when every first cell of every row
;; has an empty value or contains a symbol among "/", "#", "!", "$",
- ;; "*" "_" and "^". Though, do not consider a first row containing
- ;; only empty cells as special.
- (let ((special-column-p 'empty))
+ ;; "*" "_" and "^". Though, do not consider a first column
+ ;; containing only empty cells as special.
+ (let ((special-column? 'empty))
(catch 'exit
- (mapc
- (lambda (row)
- (when (eq (org-element-property :type row) 'standard)
- (let ((value (org-element-contents
- (car (org-element-contents row)))))
- (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
- (setq special-column-p 'special))
- ((not value))
- (t (throw 'exit nil))))))
- (org-element-contents table))
- (eq special-column-p 'special))))
+ (dolist (row (org-element-contents table))
+ (when (eq (org-element-property :type row) 'standard)
+ (let ((value (org-element-contents
+ (car (org-element-contents row)))))
+ (cond ((member value
+ '(("/") ("#") ("!") ("$") ("*") ("_") ("^")))
+ (setq special-column? 'special))
+ ((null value))
+ (t (throw 'exit nil))))))
+ (eq special-column? 'special))))
(defun org-export-table-has-header-p (table info)
"Non-nil when TABLE has a header.
@@ -4362,32 +4752,31 @@ All special columns will be ignored during export."
INFO is a plist used as a communication channel.
A table has a header when it contains at least two row groups."
- (let ((cache (or (plist-get info :table-header-cache)
- (plist-get (setq info
- (plist-put info :table-header-cache
- (make-hash-table :test 'eq)))
- :table-header-cache))))
- (or (gethash table cache)
- (let ((rowgroup 1) row-flag)
- (puthash
- table
- (org-element-map table 'table-row
- (lambda (row)
- (cond
- ((> rowgroup 1) t)
- ((and row-flag (eq (org-element-property :type row) 'rule))
- (incf rowgroup) (setq row-flag nil))
- ((and (not row-flag) (eq (org-element-property :type row)
- 'standard))
- (setq row-flag t) nil)))
- info 'first-match)
- cache)))))
-
-(defun org-export-table-row-is-special-p (table-row info)
+ (let* ((cache (or (plist-get info :table-header-cache)
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :table-header-cache table)
+ table)))
+ (cached (gethash table cache 'no-cache)))
+ (if (not (eq cached 'no-cache)) cached
+ (let ((rowgroup 1) row-flag)
+ (puthash table
+ (org-element-map table 'table-row
+ (lambda (row)
+ (cond
+ ((> rowgroup 1) t)
+ ((and row-flag
+ (eq (org-element-property :type row) 'rule))
+ (cl-incf rowgroup)
+ (setq row-flag nil))
+ ((and (not row-flag)
+ (eq (org-element-property :type row) 'standard))
+ (setq row-flag t)
+ nil)))
+ info 'first-match)
+ cache)))))
+
+(defun org-export-table-row-is-special-p (table-row _)
"Non-nil if TABLE-ROW is considered special.
-
-INFO is a plist used as the communication channel.
-
All special rows will be ignored during export."
(when (eq (org-element-property :type table-row) 'standard)
(let ((first-cell (org-element-contents
@@ -4404,19 +4793,17 @@ All special rows will be ignored during export."
;; ... it contains only alignment cookies and empty cells.
(let ((special-row-p 'empty))
(catch 'exit
- (mapc
- (lambda (cell)
- (let ((value (org-element-contents cell)))
- ;; Since VALUE is a secondary string, the following
- ;; checks avoid expanding it with `org-export-data'.
- (cond ((not value))
- ((and (not (cdr value))
- (stringp (car value))
- (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
- (car value)))
- (setq special-row-p 'cookie))
- (t (throw 'exit nil)))))
- (org-element-contents table-row))
+ (dolist (cell (org-element-contents table-row))
+ (let ((value (org-element-contents cell)))
+ ;; Since VALUE is a secondary string, the following
+ ;; checks avoid expanding it with `org-export-data'.
+ (cond ((not value))
+ ((and (not (cdr value))
+ (stringp (car value))
+ (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'"
+ (car value)))
+ (setq special-row-p 'cookie))
+ (t (throw 'exit nil)))))
(eq special-row-p 'cookie)))))))
(defun org-export-table-row-group (table-row info)
@@ -4427,21 +4814,24 @@ INFO is a plist used as the communication channel.
Return value is the group number, as an integer, or nil for
special rows and rows separators. First group is also table's
header."
- (let ((cache (or (plist-get info :table-row-group-cache)
- (plist-get (setq info
- (plist-put info :table-row-group-cache
- (make-hash-table :test 'eq)))
- :table-row-group-cache))))
- (cond ((gethash table-row cache))
- ((eq (org-element-property :type table-row) 'rule) nil)
- (t (let ((group 0) row-flag)
- (org-element-map (org-export-get-parent table-row) 'table-row
- (lambda (row)
- (if (eq (org-element-property :type row) 'rule)
- (setq row-flag nil)
- (unless row-flag (incf group) (setq row-flag t)))
- (when (eq table-row row) (puthash table-row group cache)))
- info 'first-match))))))
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((cache (or (plist-get info :table-row-group-cache)
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :table-row-group-cache table)
+ table)))
+ (cached (gethash table-row cache 'no-cache)))
+ (if (not (eq cached 'no-cache)) cached
+ ;; First time a row is queried, populate cache with all the
+ ;; rows from the table.
+ (let ((group 0) row-flag)
+ (org-element-map (org-export-get-parent table-row) 'table-row
+ (lambda (row)
+ (if (eq (org-element-property :type row) 'rule)
+ (setq row-flag nil)
+ (unless row-flag (cl-incf group) (setq row-flag t))
+ (puthash row group cache)))
+ info))
+ (gethash table-row cache)))))
(defun org-export-table-cell-width (table-cell info)
"Return TABLE-CELL contents width.
@@ -4456,10 +4846,9 @@ same column as TABLE-CELL, or nil."
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-width-cache)
- (plist-get (setq info
- (plist-put info :table-cell-width-cache
- (make-hash-table :test 'eq)))
- :table-cell-width-cache)))
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :table-cell-width-cache table)
+ table)))
(width-vector (or (gethash table cache)
(puthash table (make-vector columns 'empty) cache)))
(value (aref width-vector column)))
@@ -4500,10 +4889,9 @@ Possible values are `left', `right' and `center'."
(columns (length cells))
(column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-alignment-cache)
- (plist-get (setq info
- (plist-put info :table-cell-alignment-cache
- (make-hash-table :test 'eq)))
- :table-cell-alignment-cache)))
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :table-cell-alignment-cache table)
+ table)))
(align-vector (or (gethash table cache)
(puthash table (make-vector columns nil) cache))))
(or (aref align-vector column)
@@ -4539,14 +4927,14 @@ Possible values are `left', `right' and `center'."
(org-element-contents
(elt (org-element-contents row) column))
info)))
- (incf total-cells)
+ (cl-incf total-cells)
;; Treat an empty cell as a number if it follows
;; a number.
(if (not (or (string-match org-table-number-regexp value)
(and (string= value "") previous-cell-number-p)))
(setq previous-cell-number-p nil)
(setq previous-cell-number-p t)
- (incf number-cells))))))
+ (cl-incf number-cells))))))
;; Return value. Alignment specified by cookies has
;; precedence over alignment deduced from cell's contents.
(aset align-vector
@@ -4579,14 +4967,13 @@ Returned borders ignore special rows."
;; another regular row has to be found above that rule.
(let (rule-flag)
(catch 'exit
- (mapc (lambda (row)
- (cond ((eq (org-element-property :type row) 'rule)
- (setq rule-flag t))
- ((not (org-export-table-row-is-special-p row info))
- (if rule-flag (throw 'exit (push 'above borders))
- (throw 'exit nil)))))
- ;; Look at every row before the current one.
- (cdr (memq row (reverse (org-element-contents table)))))
+ ;; Look at every row before the current one.
+ (dolist (row (cdr (memq row (reverse (org-element-contents table)))))
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'above borders))
+ (throw 'exit nil)))))
;; No rule above, or rule found starts the table (ignoring any
;; special row): TABLE-CELL is at the top of the table.
(when rule-flag (push 'above borders))
@@ -4595,14 +4982,13 @@ Returned borders ignore special rows."
;; non-regular row below is a rule.
(let (rule-flag)
(catch 'exit
- (mapc (lambda (row)
- (cond ((eq (org-element-property :type row) 'rule)
- (setq rule-flag t))
- ((not (org-export-table-row-is-special-p row info))
- (if rule-flag (throw 'exit (push 'below borders))
- (throw 'exit nil)))))
- ;; Look at every row after the current one.
- (cdr (memq row (org-element-contents table))))
+ ;; Look at every row after the current one.
+ (dolist (row (cdr (memq row (org-element-contents table))))
+ (cond ((eq (org-element-property :type row) 'rule)
+ (setq rule-flag t))
+ ((not (org-export-table-row-is-special-p row info))
+ (if rule-flag (throw 'exit (push 'below borders))
+ (throw 'exit nil)))))
;; No rule below, or rule found ends the table (modulo some
;; special row): TABLE-CELL is at the bottom of the table.
(when rule-flag (push 'below borders))
@@ -4614,42 +5000,40 @@ Returned borders ignore special rows."
(catch 'exit
(let ((column (let ((cells (org-element-contents row)))
(- (length cells) (length (memq table-cell cells))))))
- (mapc
- (lambda (row)
- (unless (eq (org-element-property :type row) 'rule)
- (when (equal (org-element-contents
- (car (org-element-contents row)))
- '("/"))
- (let ((column-groups
- (mapcar
- (lambda (cell)
- (let ((value (org-element-contents cell)))
- (when (member value '(("<") ("<>") (">") nil))
- (car value))))
- (org-element-contents row))))
- ;; There's a left border when previous cell, if
- ;; any, ends a group, or current one starts one.
- (when (or (and (not (zerop column))
- (member (elt column-groups (1- column))
- '(">" "<>")))
- (member (elt column-groups column) '("<" "<>")))
- (push 'left borders))
- ;; There's a right border when next cell, if any,
- ;; starts a group, or current one ends one.
- (when (or (and (/= (1+ column) (length column-groups))
- (member (elt column-groups (1+ column))
- '("<" "<>")))
- (member (elt column-groups column) '(">" "<>")))
- (push 'right borders))
- (throw 'exit nil)))))
- ;; Table rows are read in reverse order so last column groups
- ;; row has precedence over any previous one.
- (reverse (org-element-contents table)))))
+ ;; Table rows are read in reverse order so last column groups
+ ;; row has precedence over any previous one.
+ (dolist (row (reverse (org-element-contents table)))
+ (unless (eq (org-element-property :type row) 'rule)
+ (when (equal (org-element-contents
+ (car (org-element-contents row)))
+ '("/"))
+ (let ((column-groups
+ (mapcar
+ (lambda (cell)
+ (let ((value (org-element-contents cell)))
+ (when (member value '(("<") ("<>") (">") nil))
+ (car value))))
+ (org-element-contents row))))
+ ;; There's a left border when previous cell, if
+ ;; any, ends a group, or current one starts one.
+ (when (or (and (not (zerop column))
+ (member (elt column-groups (1- column))
+ '(">" "<>")))
+ (member (elt column-groups column) '("<" "<>")))
+ (push 'left borders))
+ ;; There's a right border when next cell, if any,
+ ;; starts a group, or current one ends one.
+ (when (or (and (/= (1+ column) (length column-groups))
+ (member (elt column-groups (1+ column))
+ '("<" "<>")))
+ (member (elt column-groups column) '(">" "<>")))
+ (push 'right borders))
+ (throw 'exit nil)))))))
;; Return value.
borders))
(defun org-export-table-cell-starts-colgroup-p (table-cell info)
- "Non-nil when TABLE-CELL is at the beginning of a row group.
+ "Non-nil when TABLE-CELL is at the beginning of a column group.
INFO is a plist used as a communication channel."
;; A cell starts a column group either when it is at the beginning
;; of a row (or after the special column, if any) or when it has
@@ -4660,7 +5044,7 @@ INFO is a plist used as a communication channel."
(memq 'left (org-export-table-cell-borders table-cell info))))
(defun org-export-table-cell-ends-colgroup-p (table-cell info)
- "Non-nil when TABLE-CELL is at the end of a row group.
+ "Non-nil when TABLE-CELL is at the end of a column group.
INFO is a plist used as a communication channel."
;; A cell ends a column group either when it is at the end of a row
;; or when it has a right border.
@@ -4670,7 +5054,7 @@ INFO is a plist used as a communication channel."
(memq 'right (org-export-table-cell-borders table-cell info))))
(defun org-export-table-row-starts-rowgroup-p (table-row info)
- "Non-nil when TABLE-ROW is at the beginning of a column group.
+ "Non-nil when TABLE-ROW is at the beginning of a row group.
INFO is a plist used as a communication channel."
(unless (or (eq (org-element-property :type table-row) 'rule)
(org-export-table-row-is-special-p table-row info))
@@ -4679,7 +5063,7 @@ INFO is a plist used as a communication channel."
(or (memq 'top borders) (memq 'above borders)))))
(defun org-export-table-row-ends-rowgroup-p (table-row info)
- "Non-nil when TABLE-ROW is at the end of a column group.
+ "Non-nil when TABLE-ROW is at the end of a row group.
INFO is a plist used as a communication channel."
(unless (or (eq (org-element-property :type table-row) 'rule)
(org-export-table-row-is-special-p table-row info))
@@ -4687,36 +5071,47 @@ INFO is a plist used as a communication channel."
(car (org-element-contents table-row)) info)))
(or (memq 'bottom borders) (memq 'below borders)))))
+(defun org-export-table-row-in-header-p (table-row info)
+ "Non-nil when TABLE-ROW is located within table's header.
+INFO is a plist used as a communication channel. Always return
+nil for special rows and rows separators."
+ (and (org-export-table-has-header-p
+ (org-export-get-parent-table table-row) info)
+ (eql (org-export-table-row-group table-row info) 1)))
+
(defun org-export-table-row-starts-header-p (table-row info)
"Non-nil when TABLE-ROW is the first table header's row.
INFO is a plist used as a communication channel."
- (and (org-export-table-has-header-p
- (org-export-get-parent-table table-row) info)
- (org-export-table-row-starts-rowgroup-p table-row info)
- (= (org-export-table-row-group table-row info) 1)))
+ (and (org-export-table-row-in-header-p table-row info)
+ (org-export-table-row-starts-rowgroup-p table-row info)))
(defun org-export-table-row-ends-header-p (table-row info)
"Non-nil when TABLE-ROW is the last table header's row.
INFO is a plist used as a communication channel."
- (and (org-export-table-has-header-p
- (org-export-get-parent-table table-row) info)
- (org-export-table-row-ends-rowgroup-p table-row info)
- (= (org-export-table-row-group table-row info) 1)))
+ (and (org-export-table-row-in-header-p table-row info)
+ (org-export-table-row-ends-rowgroup-p table-row info)))
(defun org-export-table-row-number (table-row info)
"Return TABLE-ROW number.
INFO is a plist used as a communication channel. Return value is
-zero-based and ignores separators. The function returns nil for
-special columns and separators."
- (when (and (eq (org-element-property :type table-row) 'standard)
- (not (org-export-table-row-is-special-p table-row info)))
- (let ((number 0))
- (org-element-map (org-export-get-parent-table table-row) 'table-row
- (lambda (row)
- (cond ((eq row table-row) number)
- ((eq (org-element-property :type row) 'standard)
- (incf number) nil)))
- info 'first-match))))
+zero-indexed and ignores separators. The function returns nil
+for special rows and separators."
+ (when (eq (org-element-property :type table-row) 'standard)
+ (let* ((cache (or (plist-get info :table-row-number-cache)
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :table-row-number-cache table)
+ table)))
+ (cached (gethash table-row cache 'no-cache)))
+ (if (not (eq cached 'no-cache)) cached
+ ;; First time a row is queried, populate cache with all the
+ ;; rows from the table.
+ (let ((number -1))
+ (org-element-map (org-export-get-parent-table table-row) 'table-row
+ (lambda (row)
+ (when (eq (org-element-property :type row) 'standard)
+ (puthash row (cl-incf number) cache)))
+ info))
+ (gethash table-row cache)))))
(defun org-export-table-dimensions (table info)
"Return TABLE dimensions.
@@ -4731,10 +5126,10 @@ rows (resp. columns)."
(org-element-map table 'table-row
(lambda (row)
(when (eq (org-element-property :type row) 'standard)
- (incf rows)
+ (cl-incf rows)
(unless first-row (setq first-row row)))) info)
;; Set number of columns.
- (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info)
+ (org-element-map first-row 'table-cell (lambda (_) (cl-incf columns)) info)
;; Return value.
(cons rows columns)))
@@ -4754,7 +5149,7 @@ function returns nil for other cells."
(let ((col-count 0))
(org-element-map table-row 'table-cell
(lambda (cell)
- (if (eq cell table-cell) col-count (incf col-count) nil))
+ (if (eq cell table-cell) col-count (cl-incf col-count) nil))
info 'first-match))))))
(defun org-export-get-table-cell-at (address table info)
@@ -4774,16 +5169,16 @@ return nil."
(lambda (row)
(cond ((eq (org-element-property :type row) 'rule) nil)
((= row-count row-pos) row)
- (t (incf row-count) nil)))
+ (t (cl-incf row-count) nil)))
info 'first-match))
'table-cell
(lambda (cell)
(if (= column-count column-pos) cell
- (incf column-count) nil))
+ (cl-incf column-count) nil))
info 'first-match)))
-;;;; For Tables Of Contents
+;;;; For Tables of Contents
;;
;; `org-export-collect-headlines' builds a list of all exportable
;; headline elements, maybe limited to a certain depth. One can then
@@ -4793,8 +5188,11 @@ return nil."
;; Once the generic function `org-export-collect-elements' is defined,
;; `org-export-collect-tables', `org-export-collect-figures' and
;; `org-export-collect-listings' can be derived from it.
+;;
+;; `org-export-toc-entry-backend' builds a special anonymous back-end
+;; useful to export table of contents' entries.
-(defun org-export-collect-headlines (info &optional n)
+(defun org-export-collect-headlines (info &optional n scope)
"Collect headlines in order to build a table of contents.
INFO is a plist used as a communication channel.
@@ -4804,15 +5202,28 @@ the table of contents. Otherwise, it is set to the value of the
last headline level. See `org-export-headline-levels' for more
information.
+Optional argument SCOPE, when non-nil, is an element. If it is
+a headline, only children of SCOPE are collected. Otherwise,
+collect children of the headline containing provided element. If
+there is no such headline, collect all headlines. In any case,
+argument N becomes relative to the level of that headline.
+
Return a list of all exportable headlines as parsed elements.
-Footnote sections, if any, will be ignored."
- (let ((limit (plist-get info :headline-levels)))
- (setq n (if (wholenump n) (min n limit) limit))
- (org-element-map (plist-get info :parse-tree) 'headline
- #'(lambda (headline)
- (unless (org-element-property :footnote-section-p headline)
- (let ((level (org-export-get-relative-level headline info)))
- (and (<= level n) headline))))
+Footnote sections are ignored."
+ (let* ((scope (cond ((not scope) (plist-get info :parse-tree))
+ ((eq (org-element-type scope) 'headline) scope)
+ ((org-export-get-parent-headline scope))
+ (t (plist-get info :parse-tree))))
+ (limit (plist-get info :headline-levels))
+ (n (if (not (wholenump n)) limit
+ (min (if (eq (org-element-type scope) 'org-data) n
+ (+ (org-export-get-relative-level scope info) n))
+ limit))))
+ (org-element-map (org-element-contents scope) 'headline
+ (lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (<= level n) headline))))
info)))
(defun org-export-collect-elements (type info &optional predicate)
@@ -4865,6 +5276,32 @@ INFO is a plist used as a communication channel.
Return a list of src-block elements with a caption."
(org-export-collect-elements 'src-block info))
+(defun org-export-toc-entry-backend (parent &rest transcoders)
+ "Return an export back-end appropriate for table of contents entries.
+
+PARENT is an export back-end the returned back-end should inherit
+from.
+
+By default, the back-end removes footnote references and targets.
+It also changes links and radio targets into regular text.
+TRANSCODERS optional argument, when non-nil, specifies additional
+transcoders. A transcoder follows the pattern (TYPE . FUNCTION)
+where type is an element or object type and FUNCTION the function
+transcoding it."
+ (declare (indent 1))
+ (org-export-create-backend
+ :parent parent
+ :transcoders
+ (append transcoders
+ `((footnote-reference . ,#'ignore)
+ (link . ,(lambda (l c i)
+ (or c
+ (org-export-data
+ (org-element-property :raw-link l)
+ i))))
+ (radio-target . ,(lambda (_r c _) c))
+ (target . ,#'ignore)))))
+
;;;; Smart Quotes
;;
@@ -4874,131 +5311,238 @@ Return a list of src-block elements with a caption."
;;
;; Dictionary for smart quotes is stored in
;; `org-export-smart-quotes-alist'.
-;;
-;; Internally, regexps matching potential smart quotes (checks at
-;; string boundaries are also necessary) are defined in
-;; `org-export-smart-quotes-regexps'.
(defconst org-export-smart-quotes-alist
- '(("da"
+ '(("ar"
+ (primary-opening
+ :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "‹" :html "&lsaquo;" :latex "\\guilsinglleft{}"
+ :texinfo "@guilsinglleft{}")
+ (secondary-closing :utf-8 "›" :html "&rsaquo;" :latex "\\guilsinglright{}"
+ :texinfo "@guilsinglright{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("da"
;; one may use: »...«, "...", ›...‹, or '...'.
;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
;; LaTeX quotes require Babel!
- (opening-double-quote :utf-8 "»" :html "&raquo;" :latex ">>"
- :texinfo "@guillemetright{}")
- (closing-double-quote :utf-8 "«" :html "&laquo;" :latex "<<"
- :texinfo "@guillemetleft{}")
- (opening-single-quote :utf-8 "›" :html "&rsaquo;" :latex "\\frq{}"
- :texinfo "@guilsinglright{}")
- (closing-single-quote :utf-8 "‹" :html "&lsaquo;" :latex "\\flq{}"
- :texinfo "@guilsingleft{}")
+ (primary-opening
+ :utf-8 "»" :html "&raquo;" :latex ">>" :texinfo "@guillemetright{}")
+ (primary-closing
+ :utf-8 "«" :html "&laquo;" :latex "<<" :texinfo "@guillemetleft{}")
+ (secondary-opening
+ :utf-8 "›" :html "&rsaquo;" :latex "\\frq{}" :texinfo "@guilsinglright{}")
+ (secondary-closing
+ :utf-8 "‹" :html "&lsaquo;" :latex "\\flq{}" :texinfo "@guilsingleft{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("de"
- (opening-double-quote :utf-8 "„" :html "&bdquo;" :latex "\"`"
- :texinfo "@quotedblbase{}")
- (closing-double-quote :utf-8 "“" :html "&ldquo;" :latex "\"'"
- :texinfo "@quotedblleft{}")
- (opening-single-quote :utf-8 "‚" :html "&sbquo;" :latex "\\glq{}"
- :texinfo "@quotesinglbase{}")
- (closing-single-quote :utf-8 "‘" :html "&lsquo;" :latex "\\grq{}"
- :texinfo "@quoteleft{}")
+ (primary-opening
+ :utf-8 "„" :html "&bdquo;" :latex "\"`" :texinfo "@quotedblbase{}")
+ (primary-closing
+ :utf-8 "“" :html "&ldquo;" :latex "\"'" :texinfo "@quotedblleft{}")
+ (secondary-opening
+ :utf-8 "‚" :html "&sbquo;" :latex "\\glq{}" :texinfo "@quotesinglbase{}")
+ (secondary-closing
+ :utf-8 "‘" :html "&lsquo;" :latex "\\grq{}" :texinfo "@quoteleft{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("en"
- (opening-double-quote :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
- (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
- (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
- (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (primary-opening :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
+ (primary-closing :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (secondary-opening :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("es"
- (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
- :texinfo "@guillemetleft{}")
- (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
- :texinfo "@guillemetright{}")
- (opening-single-quote :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
- (closing-single-quote :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
+ (primary-opening
+ :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "“" :html "&ldquo;" :latex "``" :texinfo "``")
+ (secondary-closing :utf-8 "”" :html "&rdquo;" :latex "''" :texinfo "''")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("fr"
- (opening-double-quote :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
- :texinfo "@guillemetleft{}@tie{}")
- (closing-double-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
- :texinfo "@tie{}@guillemetright{}")
- (opening-single-quote :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
- :texinfo "@guillemetleft{}@tie{}")
- (closing-single-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
- :texinfo "@tie{}@guillemetright{}")
+ (primary-opening
+ :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
+ :texinfo "@guillemetleft{}@tie{}")
+ (primary-closing
+ :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
+ :texinfo "@tie{}@guillemetright{}")
+ (secondary-opening
+ :utf-8 "« " :html "&laquo;&nbsp;" :latex "\\og "
+ :texinfo "@guillemetleft{}@tie{}")
+ (secondary-closing :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
+ :texinfo "@tie{}@guillemetright{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("is"
+ (primary-opening
+ :utf-8 "„" :html "&bdquo;" :latex "\"`" :texinfo "@quotedblbase{}")
+ (primary-closing
+ :utf-8 "“" :html "&ldquo;" :latex "\"'" :texinfo "@quotedblleft{}")
+ (secondary-opening
+ :utf-8 "‚" :html "&sbquo;" :latex "\\glq{}" :texinfo "@quotesinglbase{}")
+ (secondary-closing
+ :utf-8 "‘" :html "&lsquo;" :latex "\\grq{}" :texinfo "@quoteleft{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("no"
;; https://nn.wikipedia.org/wiki/Sitatteikn
- (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
- :texinfo "@guillemetleft{}")
- (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
- :texinfo "@guillemetright{}")
- (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
- (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (primary-opening
+ :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("nb"
;; https://nn.wikipedia.org/wiki/Sitatteikn
- (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
- :texinfo "@guillemetleft{}")
- (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
- :texinfo "@guillemetright{}")
- (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
- (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (primary-opening
+ :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
("nn"
;; https://nn.wikipedia.org/wiki/Sitatteikn
- (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
- :texinfo "@guillemetleft{}")
- (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
- :texinfo "@guillemetright{}")
- (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
- (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (primary-opening
+ :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (primary-closing
+ :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (secondary-closing :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
(apostrophe :utf-8 "’" :html "&rsquo;"))
- ("sv"
- ;; based on https://sv.wikipedia.org/wiki/Citattecken
- (opening-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
- (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
- (opening-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
- (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "'")
+ ("ru"
+ ;; http://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/
+ (primary-opening :utf-8 "«" :html "&laquo;" :latex "{}<<"
+ :texinfo "@guillemetleft{}")
+ (primary-closing :utf-8 "»" :html "&raquo;" :latex ">>{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening
+ :utf-8 "„" :html "&bdquo;" :latex "\\glqq{}" :texinfo "@quotedblbase{}")
+ (secondary-closing
+ :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
+ (apostrophe :utf-8 "’" :html: "&#39;"))
+ ("sl"
+ ;; Based on https://sl.wikipedia.org/wiki/Narekovaj
+ (primary-opening :utf-8 "«" :html "&laquo;" :latex "{}<<"
+ :texinfo "@guillemetleft{}")
+ (primary-closing :utf-8 "»" :html "&raquo;" :latex ">>{}"
+ :texinfo "@guillemetright{}")
+ (secondary-opening
+ :utf-8 "„" :html "&bdquo;" :latex "\\glqq{}" :texinfo "@quotedblbase{}")
+ (secondary-closing
+ :utf-8 "“" :html "&ldquo;" :latex "\\grqq{}" :texinfo "@quotedblleft{}")
(apostrophe :utf-8 "’" :html "&rsquo;"))
- )
+ ("sv"
+ ;; Based on https://sv.wikipedia.org/wiki/Citattecken
+ (primary-opening :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (primary-closing :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (secondary-opening :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
+ (secondary-closing :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;")))
"Smart quotes translations.
Alist whose CAR is a language string and CDR is an alist with
quote type as key and a plist associating various encodings to
their translation as value.
-A quote type can be any symbol among `opening-double-quote',
-`closing-double-quote', `opening-single-quote',
-`closing-single-quote' and `apostrophe'.
+A quote type can be any symbol among `primary-opening',
+`primary-closing', `secondary-opening', `secondary-closing' and
+`apostrophe'.
Valid encodings include `:utf-8', `:html', `:latex' and
`:texinfo'.
If no translation is found, the quote character is left as-is.")
-(defconst org-export-smart-quotes-regexps
- (list
- ;; Possible opening quote at beginning of string.
- "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\|\\s(\\)"
- ;; Possible closing quote at beginning of string.
- "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)"
- ;; Possible apostrophe at beginning of string.
- "\\`\\('\\)\\S-"
- ;; Opening single and double quotes.
- "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)"
- ;; Closing single and double quotes.
- "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)"
- ;; Apostrophe.
- "\\S-\\('\\)\\S-"
- ;; Possible opening quote at end of string.
- "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'"
- ;; Possible closing quote at end of string.
- "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'"
- ;; Possible apostrophe at end of string.
- "\\S-\\('\\)\\'")
- "List of regexps matching a quote or an apostrophe.
-In every regexp, quote or apostrophe matched is put in group 1.")
+(defun org-export--smart-quote-status (s info)
+ "Return smart quote status at the beginning of string S.
+INFO is the current export state, as a plist."
+ (let* ((parent (org-element-property :parent s))
+ (cache (or (plist-get info :smart-quote-cache)
+ (let ((table (make-hash-table :test #'eq)))
+ (plist-put info :smart-quote-cache table)
+ table)))
+ (value (gethash parent cache 'missing-data)))
+ (if (not (eq value 'missing-data)) (cdr (assq s value))
+ (let (level1-open full-status)
+ (org-element-map
+ (let ((secondary (org-element-secondary-p s)))
+ (if secondary (org-element-property secondary parent)
+ (org-element-contents parent)))
+ 'plain-text
+ (lambda (text)
+ (let ((start 0) current-status)
+ (while (setq start (string-match "['\"]" text start))
+ (push
+ (cond
+ ((equal (match-string 0 text) "\"")
+ (setf level1-open (not level1-open))
+ (if level1-open 'primary-opening 'primary-closing))
+ ;; Not already in a level 1 quote: this is an
+ ;; apostrophe.
+ ((not level1-open) 'apostrophe)
+ ;; Extract previous char and next char. As
+ ;; a special case, they can also be set to `blank',
+ ;; `no-blank' or nil. Then determine if current
+ ;; match is allowed as an opening quote or a closing
+ ;; quote.
+ (t
+ (let* ((previous
+ (if (> start 0) (substring text (1- start) start)
+ (let ((p (org-export-get-previous-element
+ text info)))
+ (cond ((not p) nil)
+ ((stringp p) (substring p -1))
+ ((memq (org-element-property :post-blank p)
+ '(0 nil))
+ 'no-blank)
+ (t 'blank)))))
+ (next
+ (if (< (1+ start) (length text))
+ (substring text (1+ start) (+ start 2))
+ (let ((n (org-export-get-next-element text info)))
+ (cond ((not n) nil)
+ ((stringp n) (substring n 0 1))
+ (t 'no-blank)))))
+ (allow-open
+ (and (if (stringp previous)
+ (string-match "\\s\"\\|\\s-\\|\\s("
+ previous)
+ (memq previous '(blank nil)))
+ (if (stringp next)
+ (string-match "\\w\\|\\s.\\|\\s_" next)
+ (eq next 'no-blank))))
+ (allow-close
+ (and (if (stringp previous)
+ (string-match "\\w\\|\\s.\\|\\s_" previous)
+ (eq previous 'no-blank))
+ (if (stringp next)
+ (string-match "\\s-\\|\\s)\\|\\s.\\|\\s\""
+ next)
+ (memq next '(blank nil))))))
+ (cond
+ ((and allow-open allow-close) (error "Should not happen"))
+ (allow-open 'secondary-opening)
+ (allow-close 'secondary-closing)
+ (t 'apostrophe)))))
+ current-status)
+ (cl-incf start))
+ (when current-status
+ (push (cons text (nreverse current-status)) full-status))))
+ info nil org-element-recursive-objects)
+ (puthash parent full-status cache)
+ (cdr (assq s full-status))))))
(defun org-export-activate-smart-quotes (s encoding info &optional original)
"Replace regular quotes with \"smart\" quotes in string S.
@@ -5013,107 +5557,18 @@ process, a non-nil ORIGINAL optional argument will provide that
original string.
Return the new string."
- (if (equal s "") ""
- (let* ((prev (org-export-get-previous-element (or original s) info))
- ;; Try to be flexible when computing number of blanks
- ;; before object. The previous object may be a string
- ;; introduced by the back-end and not completely parsed.
- (pre-blank (and prev
- (or (org-element-property :post-blank prev)
- ;; A string with missing `:post-blank'
- ;; property.
- (and (stringp prev)
- (string-match " *\\'" prev)
- (length (match-string 0 prev)))
- ;; Fallback value.
- 0)))
- (next (org-export-get-next-element (or original s) info))
- (get-smart-quote
- (lambda (q type)
- ;; Return smart quote associated to a give quote Q, as
- ;; a string. TYPE is a symbol among `open', `close' and
- ;; `apostrophe'.
- (let ((key (case type
- (apostrophe 'apostrophe)
- (open (if (equal "'" q) 'opening-single-quote
- 'opening-double-quote))
- (otherwise (if (equal "'" q) 'closing-single-quote
- 'closing-double-quote)))))
- (or (plist-get
- (cdr (assq key
- (cdr (assoc (plist-get info :language)
- org-export-smart-quotes-alist))))
- encoding)
- q)))))
- (if (or (equal "\"" s) (equal "'" s))
- ;; Only a quote: no regexp can match. We have to check both
- ;; sides and decide what to do.
- (cond ((and (not prev) (not next)) s)
- ((not prev) (funcall get-smart-quote s 'open))
- ((and (not next) (zerop pre-blank))
- (funcall get-smart-quote s 'close))
- ((not next) s)
- ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe))
- (t (funcall get-smart-quote 'open)))
- ;; 1. Replace quote character at the beginning of S.
- (cond
- ;; Apostrophe?
- ((and prev (zerop pre-blank)
- (string-match (nth 2 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'apostrophe)
- nil t s 1)))
- ;; Closing quote?
- ((and prev (zerop pre-blank)
- (string-match (nth 1 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'close)
- nil t s 1)))
- ;; Opening quote?
- ((and (or (not prev) (> pre-blank 0))
- (string-match (nth 0 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'open)
- nil t s 1))))
- ;; 2. Replace quotes in the middle of the string.
- (setq s (replace-regexp-in-string
- ;; Opening quotes.
- (nth 3 org-export-smart-quotes-regexps)
- (lambda (text)
- (funcall get-smart-quote (match-string 1 text) 'open))
- s nil t 1))
- (setq s (replace-regexp-in-string
- ;; Closing quotes.
- (nth 4 org-export-smart-quotes-regexps)
- (lambda (text)
- (funcall get-smart-quote (match-string 1 text) 'close))
- s nil t 1))
- (setq s (replace-regexp-in-string
- ;; Apostrophes.
- (nth 5 org-export-smart-quotes-regexps)
- (lambda (text)
- (funcall get-smart-quote (match-string 1 text) 'apostrophe))
- s nil t 1))
- ;; 3. Replace quote character at the end of S.
- (cond
- ;; Apostrophe?
- ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'apostrophe)
- nil t s 1)))
- ;; Closing quote?
- ((and (not next)
- (string-match (nth 7 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'close)
- nil t s 1)))
- ;; Opening quote?
- ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s))
- (setq s (replace-match
- (funcall get-smart-quote (match-string 1 s) 'open)
- nil t s 1))))
- ;; Return string with smart quotes.
- s))))
+ (let ((quote-status
+ (copy-sequence (org-export--smart-quote-status (or original s) info))))
+ (replace-regexp-in-string
+ "['\"]"
+ (lambda (match)
+ (or (plist-get
+ (cdr (assq (pop quote-status)
+ (cdr (assoc (plist-get info :language)
+ org-export-smart-quotes-alist))))
+ encoding)
+ match))
+ s nil t)))
;;;; Topology
;;
@@ -5125,46 +5580,23 @@ Return the new string."
;; (`org-export-get-parent-table'), previous element or object
;; (`org-export-get-previous-element') and next element or object
;; (`org-export-get-next-element').
-;;
-;; `org-export-get-genealogy' returns the full genealogy of a given
-;; element or object, from closest parent to full parse tree.
;; defsubst org-export-get-parent must be defined before first use
-(defun org-export-get-genealogy (blob)
- "Return full genealogy relative to a given element or object.
-
-BLOB is the element or object being considered.
-
-Ancestors are returned from closest to farthest, the last one
-being the full parse tree."
- (let (genealogy (parent blob))
- (while (setq parent (org-element-property :parent parent))
- (push parent genealogy))
- (nreverse genealogy)))
(defun org-export-get-parent-headline (blob)
"Return BLOB parent headline or nil.
BLOB is the element or object being considered."
- (let ((parent blob))
- (while (and (setq parent (org-element-property :parent parent))
- (not (eq (org-element-type parent) 'headline))))
- parent))
+ (org-element-lineage blob '(headline)))
(defun org-export-get-parent-element (object)
"Return first element containing OBJECT or nil.
OBJECT is the object to consider."
- (let ((parent object))
- (while (and (setq parent (org-element-property :parent parent))
- (memq (org-element-type parent) org-element-all-objects)))
- parent))
+ (org-element-lineage object org-element-all-elements))
(defun org-export-get-parent-table (object)
"Return OBJECT parent table or nil.
OBJECT is either a `table-cell' or `table-element' type object."
- (let ((parent object))
- (while (and (setq parent (org-element-property :parent parent))
- (not (eq (org-element-type parent) 'table))))
- parent))
+ (org-element-lineage object '(table)))
(defun org-export-get-previous-element (blob info &optional n)
"Return previous element or object.
@@ -5177,27 +5609,19 @@ When optional argument N is a positive integer, return a list
containing up to N siblings before BLOB, from farthest to
closest. With any other non-nil value, return a list containing
all of them."
- (let ((siblings
- ;; An object can belong to the contents of its parent or
- ;; to a secondary string. We check the latter option
- ;; first.
- (let ((parent (org-export-get-parent blob)))
- (or (let ((sec-value (org-element-property
- (cdr (assq (org-element-type parent)
- org-element-secondary-value-alist))
- parent)))
- (and (memq blob sec-value) sec-value))
- (org-element-contents parent))))
- prev)
+ (let* ((secondary (org-element-secondary-p blob))
+ (parent (org-export-get-parent blob))
+ (siblings
+ (if secondary (org-element-property secondary parent)
+ (org-element-contents parent)))
+ prev)
(catch 'exit
- (mapc (lambda (obj)
- (cond ((memq obj (plist-get info :ignore-list)))
- ((null n) (throw 'exit obj))
- ((not (wholenump n)) (push obj prev))
- ((zerop n) (throw 'exit prev))
- (t (decf n) (push obj prev))))
- (cdr (memq blob (reverse siblings))))
- prev)))
+ (dolist (obj (cdr (memq blob (reverse siblings))) prev)
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj prev))
+ ((zerop n) (throw 'exit prev))
+ (t (cl-decf n) (push obj prev)))))))
(defun org-export-get-next-element (blob info &optional n)
"Return next element or object.
@@ -5210,26 +5634,20 @@ When optional argument N is a positive integer, return a list
containing up to N siblings after BLOB, from closest to farthest.
With any other non-nil value, return a list containing all of
them."
- (let ((siblings
- ;; An object can belong to the contents of its parent or to
- ;; a secondary string. We check the latter option first.
- (let ((parent (org-export-get-parent blob)))
- (or (let ((sec-value (org-element-property
- (cdr (assq (org-element-type parent)
- org-element-secondary-value-alist))
- parent)))
- (cdr (memq blob sec-value)))
- (cdr (memq blob (org-element-contents parent))))))
- next)
+ (let* ((secondary (org-element-secondary-p blob))
+ (parent (org-export-get-parent blob))
+ (siblings
+ (cdr (memq blob
+ (if secondary (org-element-property secondary parent)
+ (org-element-contents parent)))))
+ next)
(catch 'exit
- (mapc (lambda (obj)
- (cond ((memq obj (plist-get info :ignore-list)))
- ((null n) (throw 'exit obj))
- ((not (wholenump n)) (push obj next))
- ((zerop n) (throw 'exit (nreverse next)))
- (t (decf n) (push obj next))))
- siblings)
- (nreverse next))))
+ (dolist (obj siblings (nreverse next))
+ (cond ((memq obj (plist-get info :ignore-list)))
+ ((null n) (throw 'exit obj))
+ ((not (wholenump n)) (push obj next))
+ ((zerop n) (throw 'exit (nreverse next)))
+ (t (cl-decf n) (push obj next)))))))
;;;; Translation
@@ -5242,191 +5660,352 @@ them."
'(("%e %n: %c"
("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
("Author"
+ ("ar" :default "تأليف")
("ca" :default "Autor")
("cs" :default "Autor")
("da" :default "Forfatter")
("de" :default "Autor")
("eo" :html "A&#365;toro")
("es" :default "Autor")
+ ("et" :default "Autor")
("fi" :html "Tekij&auml;")
("fr" :default "Auteur")
("hu" :default "Szerz&otilde;")
("is" :html "H&ouml;fundur")
("it" :default "Autore")
- ("ja" :html "&#33879;&#32773;" :utf-8 "著者")
+ ("ja" :default "著者" :html "&#33879;&#32773;")
("nl" :default "Auteur")
("no" :default "Forfatter")
("nb" :default "Forfatter")
("nn" :default "Forfattar")
("pl" :default "Autor")
+ ("pt_BR" :default "Autor")
("ru" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
+ ("sl" :default "Avtor")
("sv" :html "F&ouml;rfattare")
("uk" :html "&#1040;&#1074;&#1090;&#1086;&#1088;" :utf-8 "Автор")
("zh-CN" :html "&#20316;&#32773;" :utf-8 "作者")
("zh-TW" :html "&#20316;&#32773;" :utf-8 "作者"))
+ ("Continued from previous page"
+ ("ar" :default "تتمة الصفحة السابقة")
+ ("cs" :default "Pokračování z předchozí strany")
+ ("de" :default "Fortsetzung von vorheriger Seite")
+ ("es" :html "Contin&uacute;a de la p&aacute;gina anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior")
+ ("fr" :default "Suite de la page précédente")
+ ("it" :default "Continua da pagina precedente")
+ ("ja" :default "前ページからの続き")
+ ("nl" :default "Vervolg van vorige pagina")
+ ("pt" :default "Continuação da página anterior")
+ ("ru" :html "(&#1055;&#1088;&#1086;&#1076;&#1086;&#1083;&#1078;&#1077;&#1085;&#1080;&#1077;)"
+ :utf-8 "(Продолжение)")
+ ("sl" :default "Nadaljevanje s prejšnje strani"))
+ ("Continued on next page"
+ ("ar" :default "التتمة في الصفحة التالية")
+ ("cs" :default "Pokračuje na další stránce")
+ ("de" :default "Fortsetzung nächste Seite")
+ ("es" :html "Contin&uacute;a en la siguiente p&aacute;gina" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página")
+ ("fr" :default "Suite page suivante")
+ ("it" :default "Continua alla pagina successiva")
+ ("ja" :default "次ページに続く")
+ ("nl" :default "Vervolg op volgende pagina")
+ ("pt" :default "Continua na página seguinte")
+ ("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")
+ ("sl" :default "Ustvarjeno"))
("Date"
+ ("ar" :default "بتاريخ")
("ca" :default "Data")
("cs" :default "Datum")
("da" :default "Dato")
("de" :default "Datum")
("eo" :default "Dato")
("es" :default "Fecha")
+ ("et" :html "Kuup&#228;ev" :utf-8 "Kuupäev")
("fi" :html "P&auml;iv&auml;m&auml;&auml;r&auml;")
("hu" :html "D&aacute;tum")
("is" :default "Dagsetning")
("it" :default "Data")
- ("ja" :html "&#26085;&#20184;" :utf-8 "日付")
+ ("ja" :default "日付" :html "&#26085;&#20184;")
("nl" :default "Datum")
("no" :default "Dato")
("nb" :default "Dato")
("nn" :default "Dato")
("pl" :default "Data")
+ ("pt_BR" :default "Data")
("ru" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
+ ("sl" :default "Datum")
("sv" :default "Datum")
("uk" :html "&#1044;&#1072;&#1090;&#1072;" :utf-8 "Дата")
("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
("Equation"
+ ("ar" :default "معادلة")
+ ("cs" :default "Rovnice")
("da" :default "Ligning")
("de" :default "Gleichung")
- ("es" :html "Ecuaci&oacute;n" :default "Ecuación")
+ ("es" :ascii "Ecuacion" :html "Ecuaci&oacute;n" :default "Ecuación")
+ ("et" :html "V&#245;rrand" :utf-8 "Võrrand")
("fr" :ascii "Equation" :default "Équation")
+ ("is" :default "Jafna")
+ ("ja" :default "方程式")
("no" :default "Ligning")
("nb" :default "Ligning")
("nn" :default "Likning")
+ ("pt_BR" :html "Equa&ccedil;&atilde;o" :default "Equação" :ascii "Equacao")
+ ("ru" :html "&#1059;&#1088;&#1072;&#1074;&#1085;&#1077;&#1085;&#1080;&#1077;"
+ :utf-8 "Уравнение")
+ ("sl" :default "Enačba")
("sv" :default "Ekvation")
("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
("Figure"
+ ("ar" :default "شكل")
+ ("cs" :default "Obrázek")
("da" :default "Figur")
("de" :default "Abbildung")
("es" :default "Figura")
- ("ja" :html "&#22259;" :utf-8 "図")
+ ("et" :default "Joonis")
+ ("is" :default "Mynd")
+ ("ja" :default "図" :html "&#22259;")
("no" :default "Illustrasjon")
("nb" :default "Illustrasjon")
("nn" :default "Illustrasjon")
+ ("pt_BR" :default "Figura")
+ ("ru" :html "&#1056;&#1080;&#1089;&#1091;&#1085;&#1086;&#1082;" :utf-8 "Рисунок")
("sv" :default "Illustration")
("zh-CN" :html "&#22270;" :utf-8 "图"))
("Figure %d:"
+ ("ar" :default "شكل %d:")
+ ("cs" :default "Obrázek %d:")
("da" :default "Figur %d")
("de" :default "Abbildung %d:")
("es" :default "Figura %d:")
+ ("et" :default "Joonis %d:")
("fr" :default "Figure %d :" :html "Figure&nbsp;%d&nbsp;:")
- ("ja" :html "&#22259;%d: " :utf-8 "図%d: ")
+ ("is" :default "Mynd %d")
+ ("ja" :default "図%d: " :html "&#22259;%d: ")
("no" :default "Illustrasjon %d")
("nb" :default "Illustrasjon %d")
("nn" :default "Illustrasjon %d")
+ ("pt_BR" :default "Figura %d:")
+ ("ru" :html "&#1056;&#1080;&#1089;. %d.:" :utf-8 "Рис. %d.:")
+ ("sl" :default "Slika %d")
("sv" :default "Illustration %d")
("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
("Footnotes"
+ ("ar" :default "الهوامش")
("ca" :html "Peus de p&agrave;gina")
- ("cs" :default "Pozn\xe1mky pod carou")
+ ("cs" :default "Poznámky pod čarou")
("da" :default "Fodnoter")
("de" :html "Fu&szlig;noten" :default "Fußnoten")
("eo" :default "Piednotoj")
- ("es" :html "Nota al pie de p&aacute;gina" :default "Nota al pie de página")
+ ("es" :ascii "Nota al pie de pagina" :html "Nota al pie de p&aacute;gina" :default "Nota al pie de página")
+ ("et" :html "Allm&#228;rkused" :utf-8 "Allmärkused")
("fi" :default "Alaviitteet")
("fr" :default "Notes de bas de page")
("hu" :html "L&aacute;bjegyzet")
("is" :html "Aftanm&aacute;lsgreinar")
("it" :html "Note a pi&egrave; di pagina")
- ("ja" :html "&#33050;&#27880;" :utf-8 "脚注")
+ ("ja" :default "脚注" :html "&#33050;&#27880;")
("nl" :default "Voetnoten")
("no" :default "Fotnoter")
("nb" :default "Fotnoter")
("nn" :default "Fotnotar")
("pl" :default "Przypis")
+ ("pt_BR" :html "Notas de Rodap&eacute;" :default "Notas de Rodapé" :ascii "Notas de Rodape")
("ru" :html "&#1057;&#1085;&#1086;&#1089;&#1082;&#1080;" :utf-8 "Сноски")
+ ("sl" :default "Opombe")
("sv" :default "Fotnoter")
("uk" :html "&#1055;&#1088;&#1080;&#1084;&#1110;&#1090;&#1082;&#1080;"
:utf-8 "Примітки")
("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
("List of Listings"
+ ("ar" :default "قائمة بالبرامج")
+ ("cs" :default "Seznam programů")
("da" :default "Programmer")
("de" :default "Programmauflistungsverzeichnis")
- ("es" :default "Indice de Listados de programas")
+ ("es" :ascii "Indice de Listados de programas" :html "&Iacute;ndice de Listados de programas" :default "Índice de Listados de programas")
+ ("et" :default "Loendite nimekiri")
("fr" :default "Liste des programmes")
+ ("ja" :default "ソースコード目次")
("no" :default "Dataprogrammer")
("nb" :default "Dataprogrammer")
+ ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1088;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1086;&#1082;"
+ :utf-8 "Список распечаток")
+ ("sl" :default "Seznam programskih izpisov")
("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
("List of Tables"
+ ("ar" :default "قائمة بالجداول")
+ ("cs" :default "Seznam tabulek")
("da" :default "Tabeller")
("de" :default "Tabellenverzeichnis")
- ("es" :default "Indice de tablas")
+ ("es" :ascii "Indice de tablas" :html "&Iacute;ndice de tablas" :default "Índice de tablas")
+ ("et" :default "Tabelite nimekiri")
("fr" :default "Liste des tableaux")
+ ("is" :default "Töfluskrá" :html "T&ouml;fluskr&aacute;")
+ ("ja" :default "表目次")
("no" :default "Tabeller")
("nb" :default "Tabeller")
("nn" :default "Tabeller")
+ ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas")
+ ("ru" :html "&#1057;&#1087;&#1080;&#1089;&#1086;&#1082; &#1090;&#1072;&#1073;&#1083;&#1080;&#1094;"
+ :utf-8 "Список таблиц")
+ ("sl" :default "Seznam tabel")
("sv" :default "Tabeller")
("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
+ ("Listing"
+ ("ar" :default "برنامج")
+ ("cs" :default "Program")
+ ("da" :default "Program")
+ ("de" :default "Programmlisting")
+ ("es" :default "Listado de programa")
+ ("et" :default "Loend")
+ ("fr" :default "Programme" :html "Programme")
+ ("ja" :default "ソースコード")
+ ("no" :default "Dataprogram")
+ ("nb" :default "Dataprogram")
+ ("pt_BR" :default "Listagem")
+ ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072;"
+ :utf-8 "Распечатка")
+ ("sl" :default "Izpis programa")
+ ("zh-CN" :html "&#20195;&#30721;" :utf-8 "代码"))
("Listing %d:"
+ ("ar" :default "برنامج %d:")
+ ("cs" :default "Program %d:")
("da" :default "Program %d")
("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d")
+ ("et" :default "Loend %d")
("fr" :default "Programme %d :" :html "Programme&nbsp;%d&nbsp;:")
- ("no" :default "Dataprogram")
- ("nb" :default "Dataprogram")
+ ("ja" :default "ソースコード%d:")
+ ("no" :default "Dataprogram %d")
+ ("nb" :default "Dataprogram %d")
+ ("pt_BR" :default "Listagem %d")
+ ("ru" :html "&#1056;&#1072;&#1089;&#1087;&#1077;&#1095;&#1072;&#1090;&#1082;&#1072; %d.:"
+ :utf-8 "Распечатка %d.:")
+ ("sl" :default "Izpis programa %d")
("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
+ ("References"
+ ("ar" :default "المراجع")
+ ("cs" :default "Reference")
+ ("fr" :ascii "References" :default "Références")
+ ("de" :default "Quellen")
+ ("es" :default "Referencias")
+ ("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")
+ ("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")
+ ("sl" :default "Glej izpis programa %s"))
("See section %s"
+ ("ar" :default "انظر قسم %s")
+ ("cs" :default "Viz sekce %s")
("da" :default "jævnfør afsnit %s")
("de" :default "siehe Abschnitt %s")
- ("es" :default "vea seccion %s")
+ ("es" :ascii "Vea seccion %s" :html "Vea secci&oacute;n %s" :default "Vea sección %s")
+ ("et" :html "Vaata peat&#252;kki %s" :utf-8 "Vaata peatükki %s")
("fr" :default "cf. section %s")
- ("zh-CN" :html "&#21442;&#35265;&#31532;%d&#33410;" :utf-8 "参见第%s节"))
+ ("ja" :default "セクション %s を参照")
+ ("pt_BR" :html "Veja a se&ccedil;&atilde;o %s" :default "Veja a seção %s"
+ :ascii "Veja a secao %s")
+ ("ru" :html "&#1057;&#1084;. &#1088;&#1072;&#1079;&#1076;&#1077;&#1083; %s"
+ :utf-8 "См. раздел %s")
+ ("sl" :default "Glej poglavje %d")
+ ("zh-CN" :html "&#21442;&#35265;&#31532;%s&#33410;" :utf-8 "参见第%s节"))
+ ("See table %s"
+ ("cs" :default "Viz tabulka %s")
+ ("fr" :default "cf. tableau %s"
+ :html "cf.&nbsp;tableau&nbsp;%s" :latex "cf.~tableau~%s")
+ ("sl" :default "Glej tabelo %s"))
("Table"
+ ("ar" :default "جدول")
+ ("cs" :default "Tabulka")
("de" :default "Tabelle")
("es" :default "Tabla")
+ ("et" :default "Tabel")
("fr" :default "Tableau")
- ("ja" :html "&#34920;" :utf-8 "表")
+ ("is" :default "Tafla")
+ ("ja" :default "表" :html "&#34920;")
+ ("pt_BR" :default "Tabela")
+ ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072;"
+ :utf-8 "Таблица")
("zh-CN" :html "&#34920;" :utf-8 "表"))
("Table %d:"
+ ("ar" :default "جدول %d:")
+ ("cs" :default "Tabulka %d:")
("da" :default "Tabel %d")
("de" :default "Tabelle %d")
("es" :default "Tabla %d")
+ ("et" :default "Tabel %d")
("fr" :default "Tableau %d :")
- ("ja" :html "&#34920;%d:" :utf-8 "表%d:")
+ ("is" :default "Tafla %d")
+ ("ja" :default "表%d:" :html "&#34920;%d:")
("no" :default "Tabell %d")
("nb" :default "Tabell %d")
("nn" :default "Tabell %d")
+ ("pt_BR" :default "Tabela %d")
+ ("ru" :html "&#1058;&#1072;&#1073;&#1083;&#1080;&#1094;&#1072; %d.:"
+ :utf-8 "Таблица %d.:")
+ ("sl" :default "Tabela %d")
("sv" :default "Tabell %d")
("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
("Table of Contents"
+ ("ar" :default "قائمة المحتويات")
("ca" :html "&Iacute;ndex")
("cs" :default "Obsah")
("da" :default "Indhold")
("de" :default "Inhaltsverzeichnis")
("eo" :default "Enhavo")
- ("es" :html "&Iacute;ndice")
+ ("es" :ascii "Indice" :html "&Iacute;ndice" :default "Índice")
+ ("et" :default "Sisukord")
("fi" :html "Sis&auml;llysluettelo")
("fr" :ascii "Sommaire" :default "Table des matières")
("hu" :html "Tartalomjegyz&eacute;k")
("is" :default "Efnisyfirlit")
("it" :default "Indice")
- ("ja" :html "&#30446;&#27425;" :utf-8 "目次")
+ ("ja" :default "目次" :html "&#30446;&#27425;")
("nl" :default "Inhoudsopgave")
("no" :default "Innhold")
("nb" :default "Innhold")
("nn" :default "Innhald")
("pl" :html "Spis tre&#x015b;ci")
+ ("pt_BR" :html "&Iacute;ndice" :utf8 "Índice" :ascii "Indice")
("ru" :html "&#1057;&#1086;&#1076;&#1077;&#1088;&#1078;&#1072;&#1085;&#1080;&#1077;"
:utf-8 "Содержание")
+ ("sl" :default "Kazalo")
("sv" :html "Inneh&aring;ll")
("uk" :html "&#1047;&#1084;&#1110;&#1089;&#1090;" :utf-8 "Зміст")
("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
("Unknown reference"
+ ("ar" :default "مرجع غير معرّف")
("da" :default "ukendt reference")
("de" :default "Unbekannter Verweis")
- ("es" :default "referencia desconocida")
+ ("es" :default "Referencia desconocida")
+ ("et" :default "Tundmatu viide")
("fr" :ascii "Destination inconnue" :default "Référence inconnue")
+ ("ja" :default "不明な参照先")
+ ("pt_BR" :default "Referência desconhecida"
+ :ascii "Referencia desconhecida")
+ ("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")
("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
"Dictionary for export engine.
-Alist whose CAR is the string to translate and CDR is an alist
-whose CAR is the language string and CDR is a plist whose
+Alist whose car is the string to translate and cdr is an alist
+whose car is the language string and cdr is a plist whose
properties are possible charsets and values translated terms.
-It is used as a database for `org-export-translate'. Since this
+It is used as a database for `org-export-translate'. Since this
function returns the string as-is if no translation was found,
the variable only needs to record values different from the
entry.")
@@ -5437,9 +6016,9 @@ entry.")
ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1'
and `:utf-8'. INFO is a plist used as a communication channel.
-Translation depends on `:language' property. Return the
-translated string. If no translation is found, try to fall back
-to `:default' encoding. If it fails, return S."
+Translation depends on `:language' property. Return the
+translated string. If no translation is found, try to fall back
+to `:default' encoding. If it fails, return S."
(let* ((lang (plist-get info :language))
(translations (cdr (assoc lang
(cdr (assoc s org-export-dictionary))))))
@@ -5524,12 +6103,17 @@ and `org-export-to-file' for more specialized functions."
(let* ((process-connection-type nil)
(,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
(,process
- (start-process
- "org-export-process" ,proc-buffer
- (expand-file-name invocation-name invocation-directory)
- "-Q" "--batch"
- "-l" org-export-async-init-file
- "-l" ,temp-file)))
+ (apply
+ #'start-process
+ (append
+ (list "org-export-process"
+ ,proc-buffer
+ (expand-file-name invocation-name invocation-directory)
+ "--batch")
+ (if org-export-async-init-file
+ (list "-Q" "-l" org-export-async-init-file)
+ (list "-l" user-init-file))
+ (list "-l" ,temp-file)))))
;; Register running process in stack.
(org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
;; Set-up sentinel in order to catch results.
@@ -5698,45 +6282,43 @@ of subtree at point.
When optional argument PUB-DIR is set, use it as the publishing
directory.
-When optional argument VISIBLE-ONLY is non-nil, don't export
-contents of hidden elements.
-
Return file name as a string."
(let* ((visited-file (buffer-file-name (buffer-base-buffer)))
(base-name
- ;; File name may come from EXPORT_FILE_NAME subtree
- ;; property, assuming point is at beginning of said
- ;; sub-tree.
- (file-name-sans-extension
- (or (and subtreep
- (org-entry-get
- (save-excursion
- (ignore-errors (org-back-to-heading) (point)))
- "EXPORT_FILE_NAME" t))
- ;; File name may be extracted from buffer's associated
- ;; file, if any.
- (and visited-file (file-name-nondirectory visited-file))
- ;; Can't determine file name on our own: Ask user.
- (let ((read-file-name-function
- (and org-completion-use-ido 'ido-read-file-name)))
- (read-file-name
- "Output file: " pub-dir nil nil nil
- (lambda (name)
- (string= (file-name-extension name t) extension)))))))
+ (concat
+ (file-name-sans-extension
+ (or
+ ;; Check EXPORT_FILE_NAME subtree property.
+ (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective))
+ ;; Check #+EXPORT_FILE_NAME keyword.
+ (org-with-point-at (point-min)
+ (catch :found
+ (let ((case-fold-search t))
+ (while (re-search-forward
+ "^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t)
+ (let ((element (org-element-at-point)))
+ (when (eq 'keyword (org-element-type element))
+ (throw :found
+ (org-element-property :value element))))))))
+ ;; Extract from buffer's associated file, if any.
+ (and visited-file (file-name-nondirectory visited-file))
+ ;; Can't determine file name on our own: ask user.
+ (read-file-name
+ "Output file: " pub-dir nil nil nil
+ (lambda (n) (string= extension (file-name-extension n t))))))
+ extension))
(output-file
;; Build file name. Enforce EXTENSION over whatever user
;; may have come up with. PUB-DIR, if defined, always has
;; precedence over any provided path.
(cond
- (pub-dir
- (concat (file-name-as-directory pub-dir)
- (file-name-nondirectory base-name)
- extension))
- ((file-name-absolute-p base-name) (concat base-name extension))
- (t (concat (file-name-as-directory ".") base-name extension)))))
+ (pub-dir (concat (file-name-as-directory pub-dir)
+ (file-name-nondirectory base-name)))
+ ((file-name-absolute-p base-name) base-name)
+ (t base-name))))
;; If writing to OUTPUT-FILE would overwrite original file, append
;; EXTENSION another time to final name.
- (if (and visited-file (org-file-equal-p visited-file output-file))
+ (if (and visited-file (file-equal-p visited-file output-file))
(concat output-file extension)
output-file)))
@@ -5757,68 +6339,21 @@ removed beforehand. Return the new stack."
"Menu for asynchronous export results and running processes."
(interactive)
(let ((buffer (get-buffer-create "*Org Export Stack*")))
- (set-buffer buffer)
- (when (zerop (buffer-size)) (org-export-stack-mode))
- (org-export-stack-refresh)
+ (with-current-buffer buffer
+ (org-export-stack-mode)
+ (tabulated-list-print t))
(pop-to-buffer buffer))
(message "Type \"q\" to quit, \"?\" for help"))
-(defun org-export--stack-source-at-point ()
- "Return source from export results at point in stack."
- (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents))))
- (if (not source) (error "Source unavailable, please refresh buffer")
- (let ((source-name (if (stringp source) source (buffer-name source))))
- (if (save-excursion
- (beginning-of-line)
- (looking-at (concat ".* +" (regexp-quote source-name) "$")))
- source
- ;; SOURCE is not consistent with current line. The stack
- ;; view is outdated.
- (error "Source unavailable; type `g' to update buffer"))))))
-
(defun org-export-stack-clear ()
"Remove all entries from export stack."
(interactive)
(setq org-export-stack-contents nil))
-(defun org-export-stack-refresh (&rest dummy)
- "Refresh the asynchronous export stack.
-DUMMY is ignored. Unavailable sources are removed from the list.
-Return the new stack."
- (let ((inhibit-read-only t))
- (org-preserve-lc
- (erase-buffer)
- (insert (concat
- (let ((counter 0))
- (mapconcat
- (lambda (entry)
- (let ((proc-p (processp (nth 2 entry))))
- (concat
- ;; Back-end.
- (format " %-12s " (or (nth 1 entry) ""))
- ;; Age.
- (let ((data (nth 2 entry)))
- (if proc-p (format " %6s " (process-status data))
- ;; Compute age of the results.
- (org-format-seconds
- "%4h:%.2m "
- (float-time (time-since data)))))
- ;; Source.
- (format " %s"
- (let ((source (car entry)))
- (if (stringp source) source
- (buffer-name source)))))))
- ;; Clear stack from exited processes, dead buffers or
- ;; non-existent files.
- (setq org-export-stack-contents
- (org-remove-if-not
- (lambda (el)
- (if (processp (nth 2 el))
- (buffer-live-p (process-buffer (nth 2 el)))
- (let ((source (car el)))
- (if (bufferp source) (buffer-live-p source)
- (file-exists-p source)))))
- org-export-stack-contents)) "\n")))))))
+(defun org-export-stack-refresh ()
+ "Refresh the export stack."
+ (interactive)
+ (tabulated-list-print t))
(defun org-export-stack-remove (&optional source)
"Remove export results at point from stack.
@@ -5826,7 +6361,7 @@ If optional argument SOURCE is non-nil, remove it instead."
(interactive)
(let ((source (or source (org-export--stack-source-at-point))))
(setq org-export-stack-contents
- (org-remove-if (lambda (el) (equal (car el) source))
+ (cl-remove-if (lambda (el) (equal (car el) source))
org-export-stack-contents))))
(defun org-export-stack-view (&optional in-emacs)
@@ -5842,11 +6377,10 @@ within Emacs."
(defvar org-export-stack-mode-map
(let ((km (make-sparse-keymap)))
+ (set-keymap-parent km tabulated-list-mode-map)
(define-key km " " 'next-line)
- (define-key km "n" 'next-line)
(define-key km "\C-n" 'next-line)
(define-key km [down] 'next-line)
- (define-key km "p" 'previous-line)
(define-key km "\C-p" 'previous-line)
(define-key km "\C-?" 'previous-line)
(define-key km [up] 'previous-line)
@@ -5857,31 +6391,85 @@ within Emacs."
km)
"Keymap for Org Export Stack.")
-(define-derived-mode org-export-stack-mode special-mode "Org-Stack"
+(define-derived-mode org-export-stack-mode tabulated-list-mode "Org-Stack"
"Mode for displaying asynchronous export stack.
-Type \\[org-export-stack] to visualize the asynchronous export
+Type `\\[org-export-stack]' to visualize the asynchronous export
stack.
-In an Org Export Stack buffer, use \\<org-export-stack-mode-map>\\[org-export-stack-view] to view export output
-on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear
+In an Org Export Stack buffer, use \
+\\<org-export-stack-mode-map>`\\[org-export-stack-view]' to view export output
+on current line, `\\[org-export-stack-remove]' to remove it from the stack and \
+`\\[org-export-stack-clear]' to clear
stack completely.
-Removing entries in an Org Export Stack buffer doesn't affect
-files or buffers, only the display.
+Removing entries in a stack buffer does not affect files
+or buffers, only display.
\\{org-export-stack-mode-map}"
- (abbrev-mode 0)
- (auto-fill-mode 0)
- (setq buffer-read-only t
- buffer-undo-list t
- truncate-lines t
- header-line-format
- '(:eval
- (format " %-12s | %6s | %s" "Back-End" "Age" "Source")))
- (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t)
- (set (make-local-variable 'revert-buffer-function)
- 'org-export-stack-refresh))
+ (setq tabulated-list-format
+ (vector (list "#" 4 #'org-export--stack-num-predicate)
+ (list "Back-End" 12 t)
+ (list "Age" 6 nil)
+ (list "Source" 0 nil)))
+ (setq tabulated-list-sort-key (cons "#" nil))
+ (setq tabulated-list-entries #'org-export--stack-generate)
+ (add-hook 'tabulated-list-revert-hook #'org-export--stack-generate nil t)
+ (add-hook 'post-command-hook #'org-export-stack-refresh nil t)
+ (tabulated-list-init-header))
+
+(defun org-export--stack-generate ()
+ "Generate the asynchronous export stack for display.
+Unavailable sources are removed from the list. Return a list
+appropriate for `tabulated-list-print'."
+ ;; Clear stack from exited processes, dead buffers or non-existent
+ ;; files.
+ (setq org-export-stack-contents
+ (cl-remove-if-not
+ (lambda (el)
+ (if (processp (nth 2 el))
+ (buffer-live-p (process-buffer (nth 2 el)))
+ (let ((source (car el)))
+ (if (bufferp source) (buffer-live-p source)
+ (file-exists-p source)))))
+ org-export-stack-contents))
+ ;; Update `tabulated-list-entries'.
+ (let ((counter 0))
+ (mapcar
+ (lambda (entry)
+ (let ((source (car entry)))
+ (list source
+ (vector
+ ;; Counter.
+ (number-to-string (cl-incf counter))
+ ;; Back-End.
+ (if (nth 1 entry) (symbol-name (nth 1 entry)) "")
+ ;; Age.
+ (let ((info (nth 2 entry)))
+ (if (processp info) (symbol-name (process-status info))
+ (format-seconds "%h:%.2m" (float-time (time-since info)))))
+ ;; Source.
+ (if (stringp source) source (buffer-name source))))))
+ org-export-stack-contents)))
+
+(defun org-export--stack-num-predicate (a b)
+ (< (string-to-number (aref (nth 1 a) 0))
+ (string-to-number (aref (nth 1 b) 0))))
+
+(defun org-export--stack-source-at-point ()
+ "Return source from export results at point in stack."
+ (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents))))
+ (if (not source) (error "Source unavailable, please refresh buffer")
+ (let ((source-name (if (stringp source) source (buffer-name source))))
+ (if (save-excursion
+ (beginning-of-line)
+ (looking-at-p (concat ".* +" (regexp-quote source-name) "$")))
+ source
+ ;; SOURCE is not consistent with current line. The stack
+ ;; view is outdated.
+ (error (substitute-command-keys
+ "Source unavailable; type `\\[org-export-stack-refresh]' \
+to refresh buffer")))))))
@@ -5907,10 +6495,12 @@ SPC and DEL (resp. C-n and C-p) keys.
Set variable `org-export-dispatch-use-expert-ui' to switch to one
flavor or the other.
-When ARG is \\[universal-argument], repeat the last export action, with the same set
-of options used back then, on the current buffer.
+When ARG is `\\[universal-argument]', repeat the last export action, with the\
+ same
+set of options used back then, on the current buffer.
-When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack."
+When ARG is `\\[universal-argument] \\[universal-argument]', display the \
+asynchronous export stack."
(interactive "P")
(let* ((input
(cond ((equal arg '(16)) '(stack))
@@ -5935,7 +6525,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
(optns (cdr input)))
(unless (memq 'subtree optns)
(move-marker org-export-dispatch-last-position nil))
- (case action
+ (cl-case action
;; First handle special hard-coded actions.
(template (org-export-insert-default-template nil optns))
(stack (org-export-stack))
@@ -5944,7 +6534,7 @@ When ARG is \\[universal-argument] \\[universal-argument], display the asynchron
(publish-current-project
(org-publish-current-project (memq 'force optns) (memq 'async optns)))
(publish-choose-project
- (org-publish (assoc (org-icompleting-read
+ (org-publish (assoc (completing-read
"Publish project: "
org-publish-project-alist nil t)
org-publish-project-alist)
@@ -5995,19 +6585,19 @@ back to standard interface."
;; on the first key, if any. A nil value means KEY will
;; only be activated at first level.
(if (or (eq access-key t) (eq access-key first-key))
- (org-propertize key 'face 'org-warning)
+ (propertize key 'face 'org-warning)
key)))
(fontify-value
(lambda (value)
;; Fontify VALUE string.
- (org-propertize value 'face 'font-lock-variable-name-face)))
+ (propertize value 'face 'font-lock-variable-name-face)))
;; Prepare menu entries by extracting them from registered
;; back-ends and sorting them by access key and by ordinal,
;; if any.
(entries
(sort (sort (delq nil
- (mapcar 'org-export-backend-menu
- org-export--registered-backends))
+ (mapcar #'org-export-backend-menu
+ org-export-registered-backends))
(lambda (a b)
(let ((key-a (nth 1 a))
(key-b (nth 1 b)))
@@ -6037,8 +6627,8 @@ back to standard interface."
(concat
;; Options are hard-coded.
(format "[%s] Body only: %s [%s] Visible only: %s
-[%s] Export scope: %s [%s] Force publishing: %s
-[%s] Async export: %s\n\n"
+\[%s] Export scope: %s [%s] Force publishing: %s
+\[%s] Async export: %s\n\n"
(funcall fontify-key "C-b" t)
(funcall fontify-value
(if (memq 'body options) "On " "Off"))
@@ -6074,7 +6664,7 @@ back to standard interface."
(concat
(mapconcat
(lambda (sub-entry)
- (incf index)
+ (cl-incf index)
(format
(if (zerop (mod index 2)) " [%s] %-26s"
"[%s] %s\n")
@@ -6145,7 +6735,7 @@ back to standard interface."
standard-prompt allowed-keys entries options first-key expertp))))
(defun org-export--dispatch-action
- (prompt allowed-keys entries options first-key expertp)
+ (prompt allowed-keys entries options first-key expertp)
"Read a character from command input and act accordingly.
PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is
@@ -6163,7 +6753,7 @@ options as CDR."
(while (and (setq key (read-char-exclusive prompt))
(not expertp)
(memq key '(14 16 ?\s ?\d)))
- (case key
+ (cl-case key
(14 (if (not (pos-visible-in-window-p (point-max)))
(ignore-errors (scroll-up 1))
(message "End of buffer")
@@ -6200,8 +6790,8 @@ options as CDR."
;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1).
((memq key '(2 22 19 6 1))
(org-export--dispatch-ui
- (let ((option (case key (2 'body) (22 'visible) (19 'subtree)
- (6 'force) (1 'async))))
+ (let ((option (cl-case key (2 'body) (22 'visible) (19 'subtree)
+ (6 'force) (1 'async))))
(if (memq option options) (remq option options)
(cons option options)))
first-key expertp))
@@ -6213,7 +6803,7 @@ options as CDR."
;; Publishing actions are hard-coded. Send a special
;; signal to `org-export-dispatch'.
((eq first-key ?P)
- (case key
+ (cl-case key
(?f 'publish-current-file)
(?p 'publish-current-project)
(?x 'publish-choose-project)
@@ -6222,10 +6812,9 @@ options as CDR."
;; path. Indeed, derived backends can share the same
;; FIRST-KEY.
(t (catch 'found
- (mapc (lambda (entry)
- (let ((match (assq key (nth 2 entry))))
- (when match (throw 'found (nth 2 match)))))
- (member (assq first-key entries) entries)))))
+ (dolist (entry (member (assq first-key entries) entries))
+ (let ((match (assq key (nth 2 entry))))
+ (when match (throw 'found (nth 2 match))))))))
options))
;; Otherwise, enter sub-menu.
(t (org-export--dispatch-ui options key expertp)))))
diff --git a/lisp/outline.el b/lisp/outline.el
index 9ace6044e0d..fe1df766cb9 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/paren.el b/lisp/paren.el
index a4d9200c42f..190922ac8d1 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -60,7 +60,7 @@ active, you must toggle the mode off and on again for this to take effect."
(defcustom show-paren-priority 1000
"Priority of paren highlighting overlays."
- :type 'integer
+ :type 'integer
:version "21.1")
(defcustom show-paren-ring-bell-on-mismatch nil
@@ -247,13 +247,21 @@ It is the default value of `show-paren-data-function'."
(there-beg (nth 2 data))
(there-end (nth 3 data))
(mismatch (nth 4 data))
+ (highlight-expression
+ (or (eq show-paren-style 'expression)
+ (and there-beg
+ (eq show-paren-style 'mixed)
+ (let ((closest (if (< there-beg here-beg)
+ (1- there-end) (1+ there-beg))))
+ (not (pos-visible-in-window-p closest))))))
(face
- (if mismatch
- (progn
- (if show-paren-ring-bell-on-mismatch
- (beep))
- 'show-paren-mismatch)
- 'show-paren-match)))
+ (cond
+ (mismatch
+ (if show-paren-ring-bell-on-mismatch
+ (beep))
+ 'show-paren-mismatch)
+ (highlight-expression 'show-paren-match-expression)
+ (t 'show-paren-match))))
;;
;; If matching backwards, highlight the closeparen
;; before point as well as its matching open.
@@ -276,11 +284,7 @@ It is the default value of `show-paren-data-function'."
;; If it's an unmatched paren, turn off any such highlighting.
(if (not there-beg)
(delete-overlay show-paren--overlay)
- (if (or (eq show-paren-style 'expression)
- (and (eq show-paren-style 'mixed)
- (let ((closest (if (< there-beg here-beg)
- (1- there-end) (1+ there-beg))))
- (not (pos-visible-in-window-p closest)))))
+ (if highlight-expression
(move-overlay show-paren--overlay
(if (< there-beg here-beg) here-end here-beg)
(if (< there-beg here-beg) there-beg there-end)
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 7be3c6fdb6f..18f30a82ffb 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -66,7 +66,7 @@ Whether passwords are cached at all is controlled by `password-cache'."
:type '(choice (const :tag "Never" nil)
(integer :tag "Seconds")))
-(defvar password-data (make-vector 7 0))
+(defvar password-data (make-hash-table :test #'equal))
(defun password-read-from-cache (key)
"Obtain passphrase for KEY from time-limited passphrase cache.
@@ -74,20 +74,20 @@ Custom variables `password-cache' and `password-cache-expiry'
regulate cache behavior."
(and password-cache
key
- (symbol-value (intern-soft key password-data))))
+ (gethash key password-data)))
;;;###autoload
(defun password-in-cache-p (key)
"Check if KEY is in the cache."
(and password-cache
key
- (intern-soft key password-data)))
+ (gethash key password-data)))
(defun password-read (prompt &optional key)
"Read password, for use with KEY, from user, or from cache if wanted.
KEY indicate the purpose of the password, so the cache can
-separate passwords. The cache is not used if KEY is nil. It is
-typically a string.
+separate passwords. The cache is not used if KEY is nil.
+KEY is typically a string but can be anything (compared via `equal').
The variable `password-cache' control whether the cache is used."
(or (password-read-from-cache key)
(read-passwd prompt)))
@@ -115,29 +115,27 @@ but can be invoked at any time to forcefully remove passwords
from the cache. This may be useful when it has been detected
that a password is invalid, so that `password-read' query the
user again."
- (let ((sym (intern-soft key password-data)))
- (when sym
- (let ((password (symbol-value sym)))
- (when (stringp password)
- (if (fboundp 'clear-string)
- (clear-string password)
- (fillarray password ?_)))
- (unintern key password-data)))))
+ (let ((password (gethash key password-data)))
+ (when (stringp password)
+ (if (fboundp 'clear-string)
+ (clear-string password)
+ (fillarray password ?_)))
+ (remhash key password-data)))
(defun password-cache-add (key password)
"Add password to cache.
The password is removed by a timer after `password-cache-expiry' seconds."
- (when (and password-cache-expiry (null (intern-soft key password-data)))
+ (when (and password-cache-expiry (null (gethash key password-data)))
(run-at-time password-cache-expiry nil
#'password-cache-remove
key))
- (set (intern key password-data) password)
+ (puthash key password password-data)
nil)
(defun password-reset ()
"Clear the password cache."
(interactive)
- (fillarray password-data 0))
+ (clrhash password-data))
(provide 'password-cache)
diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el
index c03be64cf58..6ab962f5f08 100644
--- a/lisp/pcmpl-cvs.el
+++ b/lisp/pcmpl-cvs.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el
index 73a0fe507f9..78cc0018307 100644
--- a/lisp/pcmpl-gnu.el
+++ b/lisp/pcmpl-gnu.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el
index 84fb4b9e118..0e27489c91b 100644
--- a/lisp/pcmpl-linux.el
+++ b/lisp/pcmpl-linux.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el
index ce5f053aa30..c2083c889c2 100644
--- a/lisp/pcmpl-rpm.el
+++ b/lisp/pcmpl-rpm.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el
index 9bcce8b8855..41968bfe888 100644
--- a/lisp/pcmpl-unix.el
+++ b/lisp/pcmpl-unix.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el
index 7aeff54b210..1dde3245d8f 100644
--- a/lisp/pcmpl-x.el
+++ b/lisp/pcmpl-x.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 6e45f3898f7..2d2a8773bfe 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -772,7 +772,7 @@ this is `comint-dynamic-complete-functions'."
(setq c (cdr c)))
(setq pcomplete-stub (substring common-stub 0 len)
pcomplete-autolist t)
- (when (and begin (not pcomplete-show-list))
+ (when (and begin (> len 0) (not pcomplete-show-list))
(delete-region begin (point))
(pcomplete-insert-entry "" pcomplete-stub))
(throw 'pcomplete-completions completions))
diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el
index 18c0bc85073..f64a4392b49 100644
--- a/lisp/pixel-scroll.el
+++ b/lisp/pixel-scroll.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Usage:
;;
@@ -74,10 +74,13 @@
More wait will result in slow and gentle scroll.")
(defvar pixel-resolution-fine-flag nil
- "Set scrolling resolution to a pixel instead of a line.
-After a pixel scroll, typing C-n or C-p scrolls the window to
-make it fully visible, and undoes the effect of the pixel-level
-scroll.")
+ "Set scrolling resolution to pixels instead of a line.
+When it is t, scrolling resolution is number of pixels obtained
+by `frame-char-height' instead of a line. When it is number,
+scrolling resolution is set to number of pixels specified. In
+case you need scrolling resolution of a pixel, set to 1. After a
+pixel scroll, typing \\[next-line] or \\[previous-line] scrolls the window to make it
+fully visible, and undoes the effect of the pixel-level scroll.")
;;;###autoload
(define-minor-mode pixel-scroll-mode
@@ -102,13 +105,16 @@ This is an alternative of `scroll-up'. Scope moves downward."
(interactive)
(or arg (setq arg 1))
(dotimes (ii arg) ; move scope downward
- (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
- (scroll-up 1) ; relay on robust method
- (when (pixel-point-at-top-p) ; prevent too late
- (vertical-motion 1)) ; move point downward
- (pixel-scroll-pixel-up (if pixel-resolution-fine-flag
- 1
- (pixel-line-height)))))) ; move scope downward
+ (let ((amt (if pixel-resolution-fine-flag
+ (if (integerp pixel-resolution-fine-flag)
+ pixel-resolution-fine-flag
+ (frame-char-height))
+ (pixel-line-height))))
+ (while (pixel-point-at-top-p amt) ; prevent too late (multi tries)
+ (vertical-motion 1)) ; move point downward
+ (if (pixel-eob-at-top-p) ; when end-of-the-buffer is close
+ (scroll-up 1) ; relay on robust method
+ (pixel-scroll-pixel-up amt))))) ; move scope downward
(defun pixel-scroll-down (&optional arg)
"Scroll text of selected window down ARG lines.
@@ -116,48 +122,63 @@ This is and alternative of `scroll-down'. Scope moves upward."
(interactive)
(or arg (setq arg 1))
(dotimes (ii arg)
- (if (or (pixel-bob-at-top-p) ; 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
- (while (pixel-point-at-bottom-p) ; prevent too late (multi tries)
- (vertical-motion -1))
- (pixel-scroll-pixel-down (if pixel-resolution-fine-flag
- 1
- (pixel-line-height -1))))))
-
-(defun pixel-bob-at-top-p ()
- "Return non-nil if beginning of buffer is at top of window."
- (equal (window-start) (point-min)))
+ (let ((amt (if pixel-resolution-fine-flag
+ (if (integerp pixel-resolution-fine-flag)
+ 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
+ (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
+ (pixel-scroll-pixel-down amt)))))
+
+(defun pixel-bob-at-top-p (amt)
+ "Return non-nil if window-start is at beginning of the current buffer.
+Window must be vertically scrolled by not more than AMT pixels."
+ (and (equal (window-start) (point-min))
+ (< (window-vscroll nil t) amt)))
(defun pixel-eob-at-top-p ()
"Return non-nil if end of buffer is at top of window."
(<= (count-lines (window-start) (window-end)) 2)) ; count-screen-lines
(defun pixel-posn-y-at-point ()
- "Return y coordinates of point in pixels of current window."
- (let ((hscroll0 (window-hscroll))
- (y (cdr (posn-x-y (posn-at-point)))))
- ;; when point is out of scope by hscroll
- (unless y
- (save-excursion
- (set-window-hscroll nil (current-column))
- (setq y (cdr (posn-x-y (posn-at-point))))
- (set-window-hscroll nil hscroll0)))
- y))
-
-(defun pixel-point-at-top-p ()
- "Return if point is located at top of a window."
- (let* ((y (pixel-posn-y-at-point))
- (top-margin y))
- (< top-margin (pixel-line-height))))
-
-(defun pixel-point-at-bottom-p ()
- "Return if point is located at bottom of a window."
- (let* ((y (pixel-posn-y-at-point))
- (edges (window-inside-pixel-edges))
+ "Return y coordinates of point in pixels of current window.
+This returns nil when horizontally scrolled."
+ (when (equal (window-hscroll) 0)
+ (save-excursion
+ ;; When there's an overlay string on a line, move
+ ;; point by (beginning-of-visual-line).
+ (beginning-of-visual-line)
+ ;; (- (cadr (pos-visible-in-window-p (point) nil t))
+ ;; (line-pixel-height))
+ (cdr (posn-x-y (posn-at-point))))))
+
+(defun pixel-point-at-top-p (amt)
+ "Return if point is located at top of a window on coming scroll of AMT pixels.
+When location of point was not obtained, this returns if point is at top
+of window."
+ (let ((y (pixel-posn-y-at-point))
+ top-margin)
+ (cond
+ (y
+ (setq top-margin y)
+ (< top-margin amt))
+ (t
+ (<= (count-lines (window-start) (point)) 1)))))
+
+(defun pixel-point-at-bottom-p (amt)
+ "Return if point is located at bottom of window on coming scroll of AMT pixels.
+When location of point was not obtained, this returns nil."
+ (let* ((edges (window-inside-pixel-edges))
(height (- (nth 3 edges) (nth 1 edges))) ; (- bottom top)
- (bottom-margin (- height (+ y (line-pixel-height))))) ; bottom margin
- (< bottom-margin (pixel-line-height -1)))) ; coming unseen line
+ (y (pixel-posn-y-at-point))
+ bottom-margin)
+ (when y
+ (setq bottom-margin (- height (+ y (pixel-visual-line-height))))
+ (< bottom-margin amt)))) ; coming unseen line
(defun pixel-scroll-pixel-up (amt)
"Scroll text of selected windows up AMT pixels.
@@ -173,8 +194,12 @@ Scope moves upward."
(while (> amt 0)
(let ((vs (window-vscroll nil t)))
(if (equal vs 0)
- (pixel-scroll-down-and-set-window-vscroll
- (1- (pixel-line-height -1)))
+ (progn
+ ;; On horizontal scrolling, move cursor.
+ (when (> (window-hscroll) 0)
+ (vertical-motion -1))
+ (pixel-scroll-down-and-set-window-vscroll
+ (1- (pixel-line-height -1))))
(set-window-vscroll nil (1- vs) t))
(setq amt (1- amt))
(sit-for pixel-wait))))
@@ -189,11 +214,16 @@ Scope moves downward. This function returns number of pixels
that was scrolled."
(let* ((src (window-vscroll nil t)) ; EXAMPLE (initial) @0 @8 @88
(height (pixel-line-height)) ; 25 25 23
- (line (1+ (/ src height))) ; catch up + one line Ä1 Ä1 Ä4
+ (line (1+ (/ src height))) ; catch up + one line 1 1 4
(dst (* line height)) ; goal @25 @25 @92
(delta (- dst src))) ; pixels to be scrolled 25 17 4
(pixel--whistlestop-pixel-up (1- delta)) ; until one less @24 @24 @91
- (scroll-up line) (sit-for pixel-wait) ; scroll 1 pixel @0 @0 @0
+ (dotimes (ii line)
+ ;; On horizontal scrolling, move cursor.
+ (when (> (window-hscroll) 0)
+ (vertical-motion 1))
+ (scroll-up 1))
+ (sit-for pixel-wait) ; scroll 1 pixel @0 @0 @0
delta))
(defun pixel--whistlestop-pixel-up (n)
@@ -211,9 +241,61 @@ unseen line above the first line, respectively, is provided."
(or pos (setq pos (window-start)))
(when (< pos 0)
(setq pos (pixel-point-at-unseen-line)))
- (save-excursion
- (goto-char pos)
- (line-pixel-height))) ; frame-char-height
+ (let ((vs1 (window-vscroll nil t))
+ height)
+ (set-window-vscroll nil 0 t)
+ (save-excursion
+ (goto-char pos)
+ (setq height (pixel-visual-line-height))) ; line-pixel-height, frame-char-height
+ (set-window-vscroll nil vs1 t)
+ height))
+
+(defun pixel-visual-line-height ()
+ "Return height in pixels of text line where cursor is in the selected window."
+ (let ((pos (pixel-visible-pos-in-window)))
+ (cond
+ ;; When a char of line is shown, obtain height by
+ ;; (line-pixel-height).
+ (pos (save-excursion (goto-char pos) (line-pixel-height)))
+ ;; When no char of line is shown but the line is at the top,
+ ;; obtain height by (line-pixel-height). This is based on
+ ;; expected response from display engine. See following
+ ;; discussion.
+ ;; https://lists.gnu.org/r/emacs-devel/2017-10/msg00621.html
+ ((equal (count-lines (window-start) (point)) 1)
+ (line-pixel-height))
+ ;; No char of line is shown and the line is not at the top,
+ ;; obtain height by (frame-char-height).
+ (t (frame-char-height)))))
+
+(defun pixel-visible-pos-in-window ()
+ "Return position shown on text line where cursor is in the selected window.
+This will look for positions of point and end-of-visual-line,
+then positions from beginning-of-visual-line to
+end-of-visual-line. When no char in a line is shown, this
+returns nil."
+ (let* ((beginning-of-visual-line-pos (save-excursion (beginning-of-visual-line) (point)))
+ (end-of-visual-line-pos (save-excursion (end-of-visual-line) (point)))
+ (pos-list (number-sequence beginning-of-visual-line-pos end-of-visual-line-pos))
+ (edges (window-inside-pixel-edges))
+ (width (- (nth 2 edges) (nth 0 edges)))
+ posn-x
+ visible-pos)
+ ;; Optimize list of position to be surveyed.
+ (push end-of-visual-line-pos pos-list)
+ (push (point) pos-list)
+ (delete-dups pos-list)
+ ;; Find out a char with position X that is more than zero and less
+ ;; than width of screen.
+ (while (and (not visible-pos)
+ pos-list)
+ (setq posn-x (car (pos-visible-in-window-p (car pos-list) nil t)))
+ (if (and posn-x
+ (<= 0 posn-x)
+ (< posn-x width))
+ (setq visible-pos (car pos-list))
+ (setq pos-list (cdr pos-list))))
+ visible-pos))
(defun pixel-point-at-unseen-line ()
"Return the character position of line above the selected window.
diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el
index 312764b2f4a..dad2048ac83 100644
--- a/lisp/play/5x5.el
+++ b/lisp/play/5x5.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index d074a741b69..80bb746133f 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
index d935b02e7f8..e25978cdf5d 100644
--- a/lisp/play/blackbox.el
+++ b/lisp/play/blackbox.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el
index 4c9754a689b..35abbc8bb2a 100644
--- a/lisp/play/bubbles.el
+++ b/lisp/play/bubbles.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
index 88627d694f6..b9605dcf9e0 100644
--- a/lisp/play/cookie1.el
+++ b/lisp/play/cookie1.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
index 61a63bd28dd..f68e78d160a 100644
--- a/lisp/play/decipher.el
+++ b/lisp/play/decipher.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 6bd7f694050..23d78478c53 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
index f90e1d044b5..e1c4d2acd73 100644
--- a/lisp/play/doctor.el
+++ b/lisp/play/doctor.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
index 6acdf36d72c..ed1cd5e730a 100644
--- a/lisp/play/dunnet.el
+++ b/lisp/play/dunnet.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el
index 7b60465788a..0b83b62b292 100644
--- a/lisp/play/fortune.el
+++ b/lisp/play/fortune.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This utility allows you to automatically cut regions to a fortune
diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el
index 0386a89b3a4..6223a01d4fa 100644
--- a/lisp/play/gamegrid.el
+++ b/lisp/play/gamegrid.el
@@ -1,4 +1,4 @@
-;;; gamegrid.el --- library for implementing grid-based games on Emacs
+;;; gamegrid.el --- library for implementing grid-based games on Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1997-1998, 2001-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -86,49 +86,157 @@ directory will be used.")
(defvar gamegrid-mono-x-face nil)
(defvar gamegrid-mono-tty-face nil)
-;; ;;;;;;;;;;;;; constants ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defvar gamegrid-glyph-height-mm 7.0
+ "Desired glyph height in mm.")
-(defconst gamegrid-glyph-height 16)
+;; ;;;;;;;;;;;;; glyph generation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst gamegrid-xpm "\
+(defun gamegrid-calculate-glyph-size ()
+ "Calculate appropriate glyph size in pixels based on display resolution.
+Return a multiple of 8 no less than 16."
+ (if (and (display-pixel-height) (display-mm-height))
+ (let* ((y-pitch (/ (display-pixel-height) (float (display-mm-height))))
+ (pixels (* y-pitch gamegrid-glyph-height-mm))
+ (rounded (* (floor (/ (+ pixels 4) 8)) 8)))
+ (max 16 rounded))
+ 16))
+
+;; Example of glyph in XPM format:
+;;
+;; /* XPM */
+;; static char *noname[] = {
+;; /* width height ncolors chars_per_pixel */
+;; \"16 16 3 1\",
+;; /* colors */
+;; \"+ s col1\",
+;; \". s col2\",
+;; \"- s col3\",
+;; /* pixels */
+;; \"---------------+\",
+;; \"--------------++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"--............++\",
+;; \"-+++++++++++++++\",
+;; \"++++++++++++++++\"
+;; };
+
+(defun gamegrid-xpm ()
+ "Generate the XPM format image used for each square."
+ (let* ((glyph-pixel-count (gamegrid-calculate-glyph-size))
+ (border-pixel-count (/ glyph-pixel-count 8))
+ (center-pixel-count (- glyph-pixel-count (* border-pixel-count 2))))
+ (with-temp-buffer
+ (insert (format "\
/* XPM */
static char *noname[] = {
/* width height ncolors chars_per_pixel */
-\"16 16 3 1\",
+\"%s %s 3 1\",
/* colors */
\"+ s col1\",
\". s col2\",
\"- s col3\",
/* pixels */
-\"---------------+\",
-\"--------------++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"--............++\",
-\"-+++++++++++++++\",
-\"++++++++++++++++\"
-};
-"
- "XPM format image used for each square")
-
-(defvar gamegrid-xbm "\
+" glyph-pixel-count glyph-pixel-count))
+
+ (dotimes (row border-pixel-count)
+ (let ((edge-pixel-count (+ row 1)))
+ (insert "\"")
+ (dotimes (_ (- glyph-pixel-count edge-pixel-count)) (insert "-"))
+ (dotimes (_ edge-pixel-count) (insert "+"))
+ (insert "\",\n")))
+
+ (let ((middle (format "\"%s%s%s\",\n"
+ (make-string border-pixel-count ?-)
+ (make-string center-pixel-count ?.)
+ (make-string border-pixel-count ?+))))
+ (dotimes (_ center-pixel-count) (insert middle)))
+
+ (dotimes (row border-pixel-count)
+ (let ((edge-pixel-count (- border-pixel-count row 1)))
+ (insert "\"")
+ (dotimes (_ edge-pixel-count) (insert "-"))
+ (dotimes (_ (- glyph-pixel-count edge-pixel-count)) (insert "+"))
+ (insert "\"")
+ (if (/= row (1- border-pixel-count))
+ (insert ",\n")
+ (insert "\n};\n"))))
+ (buffer-string))))
+
+;; Example of glyph in XBM format:
+;;
+;; /* gamegrid XBM */
+;; #define gamegrid_width 16
+;; #define gamegrid_height 16
+;; static unsigned char gamegrid_bits[] = {
+;; 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a,
+;; 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a,
+;; 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };
+
+(defun gamegrid-xbm ()
+ "Generate XBM format image used for each square."
+ (let* ((glyph-pixel-count (gamegrid-calculate-glyph-size))
+ (border-pixel-count (1- (/ glyph-pixel-count 4)))
+ (center-pixel-count (- glyph-pixel-count (* 2 border-pixel-count))))
+ (with-temp-buffer
+ (insert (format "\
/* gamegrid XBM */
-#define gamegrid_width 16
-#define gamegrid_height 16
+#define gamegrid_width %s
+#define gamegrid_height %s
static unsigned char gamegrid_bits[] = {
- 0xff, 0xff, 0xff, 0x7f, 0xff, 0x3f, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a,
- 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a, 0x57, 0x15, 0xaf, 0x0a,
- 0x57, 0x15, 0x07, 0x00, 0x03, 0x00, 0x01, 0x00 };"
- "XBM format image used for each square.")
+" glyph-pixel-count glyph-pixel-count))
+ (dotimes (row border-pixel-count)
+ (gamegrid-insert-xbm-bits
+ (concat (make-string (- glyph-pixel-count row) ?1)
+ (make-string row ?0)))
+ (insert ", \n"))
+
+ (let* ((left-border (make-string border-pixel-count ?1))
+ (right-border (make-string border-pixel-count ?0))
+ (even-line (apply 'concat
+ (append (list left-border)
+ (make-list (/ center-pixel-count 2) "10")
+ (list right-border))))
+ (odd-line (apply 'concat
+ (append (list left-border)
+ (make-list (/ center-pixel-count 2) "01")
+ (list right-border)))))
+ (dotimes (row center-pixel-count)
+ (gamegrid-insert-xbm-bits (if (eq (logand row 1) 1) odd-line even-line))
+ (insert ", \n")))
+
+ (dotimes (row border-pixel-count)
+ (let ((edge-pixel-count (- border-pixel-count row)))
+ (gamegrid-insert-xbm-bits
+ (concat (make-string edge-pixel-count ?1)
+ (make-string (- glyph-pixel-count edge-pixel-count) ?0))))
+ (if (/= row (1- border-pixel-count))
+ (insert ", \n")
+ (insert " };\n")))
+ (buffer-string))))
+
+(defun gamegrid-insert-xbm-bits (str)
+ "Convert binary to hex and insert in current buffer.
+STR should be a string composed of 1s and 0s and be a multiple of
+8 in length. Divide it into 8 bit bytes, reverse the order of
+each, convert them to hex and insert them in comma separated C
+format."
+ (let ((byte-count (/ (length str) 8)))
+ (dotimes (i byte-count)
+ (let* ((byte (reverse (substring str (* i 8) (+ (* i 8) 8))))
+ (value (string-to-number byte 2)))
+ (insert (format "0x%02x" value))
+ (unless (= i (1- byte-count))
+ (insert ", "))))))
;; ;;;;;;;;;;;;;;;; miscellaneous functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -228,13 +336,13 @@ static unsigned char gamegrid_bits[] = {
gamegrid-mono-tty-face))))
(defun gamegrid-colorize-glyph (color)
- (find-image `((:type xpm :data ,gamegrid-xpm
+ (find-image `((:type xpm :data ,(gamegrid-xpm)
:ascent center
:color-symbols
(("col1" . ,(gamegrid-color color 0.6))
("col2" . ,(gamegrid-color color 0.8))
("col3" . ,(gamegrid-color color 1.0))))
- (:type xbm :data ,gamegrid-xbm
+ (:type xbm :data ,(gamegrid-xbm)
:ascent center
:foreground ,(gamegrid-color color 1.0)
:background ,(gamegrid-color color 0.5)))))
@@ -376,7 +484,7 @@ static unsigned char gamegrid_bits[] = {
(buffer-read-only nil))
(erase-buffer)
(setq gamegrid-buffer-start (point))
- (dotimes (i height)
+ (dotimes (_ height)
(insert line))
;; Adjust the height of the default face to the height of the
;; images. Unlike XEmacs, Emacs doesn't allow making the default
diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el
index 3954c1dc1fa..944205209cc 100644
--- a/lisp/play/gametree.el
+++ b/lisp/play/gametree.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
index a2d3447dedb..2f5f36e1dbb 100644
--- a/lisp/play/gomoku.el
+++ b/lisp/play/gomoku.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -263,7 +263,7 @@ Other useful commands:\n
"Vector recording the actual score of the free squares.")
-;; The key point point about the algorithm is that, rather than considering
+;; The key point about the algorithm is that, rather than considering
;; the board as just a set of squares, we prefer to see it as a "space" of
;; internested 5-tuples of contiguous squares (called qtuples).
;;
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
index 06b37beb555..0b572d12be6 100644
--- a/lisp/play/handwrite.el
+++ b/lisp/play/handwrite.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/play/life.el b/lisp/play/life.el
index c5907a9875d..a5a3f1ef054 100644
--- a/lisp/play/life.el
+++ b/lisp/play/life.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
index 85d9db086ff..d55e0a4c9f6 100644
--- a/lisp/play/morse.el
+++ b/lisp/play/morse.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
index 815203032ff..5fc4f2d4b11 100644
--- a/lisp/play/mpuz.el
+++ b/lisp/play/mpuz.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/pong.el b/lisp/play/pong.el
index fb826fb65ed..c5af6f15e99 100644
--- a/lisp/play/pong.el
+++ b/lisp/play/pong.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/snake.el b/lisp/play/snake.el
index d5904a48f42..d6a21418ecd 100644
--- a/lisp/play/snake.el
+++ b/lisp/play/snake.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
index 850b80566b8..f1aa046cc10 100644
--- a/lisp/play/solitaire.el
+++ b/lisp/play/solitaire.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
index e6727725d69..fd2e8116c82 100644
--- a/lisp/play/spook.el
+++ b/lisp/play/spook.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el
index d20ac0ab3a2..2b06d8f3ad1 100644
--- a/lisp/play/tetris.el
+++ b/lisp/play/tetris.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index a718d07caca..254b76ca27a 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/plstore.el b/lisp/plstore.el
index b9025433b11..da260096eaf 100644
--- a/lisp/plstore.el
+++ b/lisp/plstore.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary
@@ -212,7 +212,8 @@ symmetric encryption will be used."
(with-current-buffer buffer
(erase-buffer)
(condition-case nil
- (insert-file-contents-literally file)
+ (let ((coding-system-for-read 'raw-text))
+ (insert-file-contents file))
(error))
(setq buffer-file-name (file-truename file))
(set-buffer-modified-p nil)
@@ -520,7 +521,7 @@ If no one is selected, symmetric encryption will be performed. "
t)))
(defun plstore-mode-original ()
- "Show the original form of the this buffer."
+ "Show the original form of this buffer."
(interactive)
(when plstore-encoded
(if (and (buffer-modified-p)
@@ -532,7 +533,7 @@ If no one is selected, symmetric encryption will be performed. "
(setq plstore-encoded nil)))
(defun plstore-mode-decoded ()
- "Show the decoded form of the this buffer."
+ "Show the decoded form of this buffer."
(interactive)
(unless plstore-encoded
(if (and (buffer-modified-p)
diff --git a/lisp/printing.el b/lisp/printing.el
index 9970b85a8ee..acfea5e9887 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -2,8 +2,8 @@
;; Copyright (C) 2000-2001, 2003-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; Version: 6.9.3
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
@@ -12,7 +12,7 @@
"printing.el, v 6.9.3 <2007/12/09 vinicius>
Please send all bug fixes and enhancements to
- bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
")
;; This file is part of GNU Emacs.
@@ -28,7 +28,7 @@ Please send all bug fixes and enhancements to
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -58,7 +58,7 @@ Please send all bug fixes and enhancements to
;; On GNU or Unix system, `printing' depends on gs and gv utilities.
;; On NT system, `printing' depends on gstools (gswin32.exe and gsview32.exe).
;; To obtain ghostscript, ghostview and GSview see the URL
-;; `http://www.gnu.org/software/ghostscript/ghostscript.html'.
+;; `https://www.gnu.org/software/ghostscript/ghostscript.html'.
;;
;; `printing' depends on ps-print package to generate PostScript files, to
;; spool and to despool PostScript buffer. So, `printing' provides an
@@ -958,7 +958,7 @@ Please send all bug fixes and enhancements to
;;
;; * For GNU or Unix system:
;;
-;; gs, gv `http://www.gnu.org/software/ghostscript/ghostscript.html'
+;; gs, gv `https://www.gnu.org/software/ghostscript/ghostscript.html'
;; enscript `http://people.ssh.fi/mtr/genscript/'
;; psnup `http://www.knackered.org/angus/psutils/'
;; mpage `http://www.mesa.nl/pub/mpage/'
@@ -966,7 +966,7 @@ Please send all bug fixes and enhancements to
;; * For Windows system:
;;
;; gswin32, gsview32
-;; `http://www.gnu.org/software/ghostscript/ghostscript.html'
+;; `https://www.gnu.org/software/ghostscript/ghostscript.html'
;; gsprint `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
;; enscript `http://people.ssh.fi/mtr/genscript/'
;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm'
@@ -2249,7 +2249,7 @@ See also `pr-path-alist'.
Useful links:
* GNU gv manual
- `http://www.gnu.org/software/gv/manual/gv.html'
+ `https://www.gnu.org/software/gv/manual/gv.html'
* GSview Help
`http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm'
diff --git a/lisp/proced.el b/lisp/proced.el
index 0736ab09dc9..b4bdbb05f0d 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -602,7 +602,10 @@ Important: the match ends just after the marker.")
(defun proced-header-line ()
"Return header line for Proced buffer."
- (list (propertize " " 'display '(space :align-to 0))
+ (list (propertize " "
+ 'display
+ (list 'space :align-to
+ (line-number-display-width 'columns)))
(if (<= (window-hscroll) (length proced-header-line))
(replace-regexp-in-string ;; preserve text properties
"\\(%\\)" "\\1\\1"
@@ -767,7 +770,7 @@ The time interval for updates is specified via `proced-auto-update-interval'."
(while (not (eobp))
(cond ((looking-at mark-re)
(proced-insert-mark nil))
- ((looking-at " ")
+ ((= (following-char) ?\s)
(proced-insert-mark t))
(t
(forward-line 1)))))))
@@ -1436,7 +1439,7 @@ Replace newline characters by \"^J\" (two characters)."
(hprops
(if (nth 4 grammar)
(let ((descend (if (eq key sort-key) proced-descend (nth 5 grammar))))
- `(proced-key ,key mouse-face highlight
+ `(proced-key ,key mouse-face header-line-highlight
help-echo ,(format proced-header-help-echo
(if descend "-" "+")
(nth 1 grammar)
@@ -1801,7 +1804,7 @@ supported but discouraged. It will be removed in a future version of Emacs."
(let (failures)
;; Why not always use `signal-process'? See
- ;; http://lists.gnu.org/archive/html/emacs-devel/2008-03/msg02955.html
+ ;; https://lists.gnu.org/r/emacs-devel/2008-03/msg02955.html
(if (functionp proced-signal-function)
;; use built-in `signal-process'
(let ((signal (if (stringp signal)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 15ff9b68ab9..0eed79eff0c 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
index ab3ff3aa208..05d8038e87b 100644
--- a/lisp/progmodes/ada-mode.el
+++ b/lisp/progmodes/ada-mode.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This mode is a major mode for editing Ada code. This is a major
diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el
index f1b90875044..b86982a75c8 100644
--- a/lisp/progmodes/ada-prj.el
+++ b/lisp/progmodes/ada-prj.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el
index 2b390688c2b..c8f70b0e4b9 100644
--- a/lisp/progmodes/ada-stmt.el
+++ b/lisp/progmodes/ada-stmt.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file is now automatically loaded from ada-mode.el, and creates a submenu
diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el
index 4e196505b6c..5f79afe01ac 100644
--- a/lisp/progmodes/ada-xref.el
+++ b/lisp/progmodes/ada-xref.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 2d09e431f29..82ae1816270 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -619,7 +619,7 @@ COUNT starts with 1. GEN-SEP is used to separate long variable values."
'((java-mode ("%sTokenTypes.java") ("%s.java"))
(c++-mode ("%sTokenTypes.hpp") ("%s.cpp" "%s.hpp")))
"Language dependent formats which specify generated files.
-Each element in this list looks looks like
+Each element in this list looks like
(MAJOR-MODE (VOCAB-FILE-FORMAT...) (CLASS-FILE-FORMAT...)).
The element whose MAJOR-MODE is equal to `antlr-language' is used to
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
index 2a1dad69877..f6e2d78f3a7 100644
--- a/lisp/progmodes/asm-mode.el
+++ b/lisp/progmodes/asm-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index 6d58faa6a66..6e591c1d657 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index 1dd2e3757ed..102c3186200 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -84,11 +84,11 @@
. 'bat-label-face)
("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
(2 font-lock-variable-name-face))
- ("%\\(\\(\\sw\\|\\s_\\)+\\)%"
+ ("%\\([^%~ \n]+\\)%?"
(1 font-lock-variable-name-face))
- ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable!
+ ("!\\([^!%~ \n]+\\)!?" ; delayed-expansion !variable!
(1 font-lock-variable-name-face))
- ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
+ ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\|_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
(1 font-lock-variable-name-face nil t) ; PATH expansion
(2 font-lock-variable-name-face)) ; iteration variable or positional parameter
("[ =][-/]+\\(\\w+\\)"
diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el
index 210f0356084..7e004ce6a01 100644
--- a/lisp/progmodes/bug-reference.el
+++ b/lisp/progmodes/bug-reference.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -44,7 +44,7 @@
map)
"Keymap used by bug reference buttons.")
-;; E.g., "http://gcc.gnu.org/PR%s"
+;; E.g., "https://gcc.gnu.org/PR%s"
(defvar bug-reference-url-format nil
"Format used to turn a bug number into a URL.
The bug number is supplied as a string, so this should have a single %s.
@@ -73,10 +73,12 @@ so that it is considered safe, see `enable-local-variables'.")
"Regular expression matching bug references.
The second subexpression should match the bug reference (usually a number)."
:type 'string
- :safe 'stringp
:version "24.3" ; previously defconst
:group 'bug-reference)
+;;;###autoload
+(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp)
+
(defun bug-reference-set-overlay-properties ()
"Set properties of bug reference overlays."
(put 'bug-reference 'evaporate t)
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index 0f7e4b598dc..4b326026b80 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -159,7 +159,7 @@ Works with: topmost-intro-cont."
(c-safe-position (or containing-sexp (point)) c-state-cache)
containing-sexp))))
-(defun c-lineup-arglist (langelem)
+(defun c-lineup-arglist (_langelem)
"Line up the current argument line under the first argument.
As a special case, if the indented line is inside a brace block
@@ -265,7 +265,7 @@ Works with: arglist-cont, arglist-cont-nonempty."
(c-forward-syntactic-ws))
(c-lineup-argcont-scan other-match)))))
-(defun c-lineup-arglist-intro-after-paren (langelem)
+(defun c-lineup-arglist-intro-after-paren (_langelem)
"Line up a line to just after the open paren of the surrounding paren
or brace block.
@@ -483,7 +483,7 @@ Works with: func-decl-cont."
(vector (+ (current-column) c-basic-offset)))
c-basic-offset))))
-(defun c-indent-one-line-block (langelem)
+(defun c-indent-one-line-block (_langelem)
"Indent a one line block `c-basic-offset' extra.
E.g.:
@@ -506,7 +506,7 @@ Work with: Almost all syntactic symbols, but most useful on *-open."
c-basic-offset
nil))))
-(defun c-indent-multi-line-block (langelem)
+(defun c-indent-multi-line-block (_langelem)
"Indent a multi line block `c-basic-offset' extra.
E.g.:
@@ -642,7 +642,7 @@ Works with: The `c' syntactic symbol."
(goto-char (c-langelem-pos langelem)))))
(vector (current-column)))))))
-(defun c-lineup-comment (langelem)
+(defun c-lineup-comment (_langelem)
"Line up a comment start according to `c-comment-only-line-offset'.
If the comment is lined up with a comment starter on the previous
line, that alignment is preserved.
@@ -667,7 +667,7 @@ Works with: comment-intro."
-1000)) ;jam it against the left side
))))
-(defun c-lineup-knr-region-comment (langelem)
+(defun c-lineup-knr-region-comment (_langelem)
"Line up a comment in the \"K&R region\" with the declaration.
That is the region between the function or class header and the
beginning of the block. E.g.:
@@ -836,7 +836,7 @@ arglist-cont-nonempty."
(vector col))))))
-(defun c-lineup-string-cont (langelem)
+(defun c-lineup-string-cont (_langelem)
"Line up a continued string under the one it continues.
A continued string in this sense is where a string literal follows
directly after another one. E.g.:
@@ -861,7 +861,7 @@ arglist-cont-nonempty."
(goto-char pos)
(vector (current-column)))))))
-(defun c-lineup-template-args (langelem)
+(defun c-lineup-template-args (_langelem)
"Line up template argument lines under the first argument.
To allow this function to be used in a list expression, nil is
returned if there's no template argument on the first line.
@@ -992,7 +992,7 @@ Works with: objc-method-args-cont."
(+ curcol (- prev-col-column (current-column)))
c-basic-offset)))))
-(defun c-lineup-inexpr-block (langelem)
+(defun c-lineup-inexpr-block (_langelem)
"Line up the block for constructs that use a block inside an expression,
e.g. anonymous classes in Java and lambda functions in Pike. The body
is aligned with the start of the header, e.g. with the \"new\" or
@@ -1020,7 +1020,7 @@ Works with: inlambda, inexpr-statement, inexpr-class."
(goto-char (cdr res))
(vector (current-column))))))
-(defun c-lineup-whitesmith-in-block (langelem)
+(defun c-lineup-whitesmith-in-block (_langelem)
"Line up lines inside a block in Whitesmith style.
It's done in a way that works both when the opening brace hangs and
when it doesn't. E.g.:
@@ -1084,7 +1084,7 @@ arglist-cont."
(vector (+ (current-column) c-basic-offset))))
(vector 0)))))
-(defun c-lineup-cpp-define (langelem)
+(defun c-lineup-cpp-define (_langelem)
"Line up macro continuation lines according to the indentation of
the construct preceding the macro. E.g.:
@@ -1231,9 +1231,9 @@ Works with: Any syntactic symbol which has an anchor position."
(save-excursion
(goto-char (c-langelem-pos langelem))
(vector (current-column))))
-
-(defun c-lineup-dont-change (langelem)
+
+(defun c-lineup-dont-change (_langelem)
"Do not change the indentation of the current line.
Works with: Any syntactic symbol."
@@ -1241,7 +1241,7 @@ Works with: Any syntactic symbol."
(back-to-indentation)
(vector (current-column))))
-(defun c-lineup-respect-col-0 (langelem)
+(defun c-lineup-respect-col-0 (_langelem)
"If the current line starts at column 0, return [0]. Otherwise return nil.
This can be used for comments (in conjunction with, say,
@@ -1254,7 +1254,7 @@ anchored there, but reindent other comments."
nil)))
-(defun c-snug-do-while (syntax pos)
+(defun c-snug-do-while (syntax _pos)
"Dynamically calculate brace hanginess for do-while statements.
Using this function, `while' clauses that end a `do-while' block will
remain on the same line as the brace that closes that block.
@@ -1272,7 +1272,7 @@ ACTION associated with `block-close' syntax."
'(before)
'(before after)))))
-(defun c-snug-1line-defun-close (syntax pos)
+(defun c-snug-1line-defun-close (_syntax pos)
"Determine the brace hanginess for an AWK defun-close.
If the action/function being closed is a one-liner, keep it so. Otherwise put
the closing brace on its own line."
diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el
index 736f1de2094..488b93eb574 100644
--- a/lisp/progmodes/cc-awk.el
+++ b/lisp/progmodes/cc-awk.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -592,7 +592,7 @@
;; starts at a `while' token.
(not (c-get-char-property (c-point 'eol) 'c-awk-NL-prop)))
-(defun c-awk-clear-NL-props (beg end)
+(defun c-awk-clear-NL-props (beg _end)
;; This function is run from before-change-hooks. It clears the
;; c-awk-NL-prop text property from beg to the end of the buffer (The END
;; parameter is ignored). This ensures that the indentation engine will
@@ -847,7 +847,7 @@
;; Just beyond logical line following the region which is about to be changed.
;; Set in c-awk-record-region-clear-NL and used in c-awk-after-change.
-(defun c-awk-record-region-clear-NL (beg end)
+(defun c-awk-record-region-clear-NL (_beg end)
;; This function is called exclusively from the before-change-functions hook.
;; It does two things: Finds the end of the (logical) line on which END lies,
;; and clears c-awk-NL-prop text properties from this point onwards. BEG is
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index e98b3dfa9df..d4bce32f175 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -86,6 +86,7 @@
(defvar cc-bytecomp-environment-set nil)
(defmacro cc-bytecomp-debug-msg (&rest args)
+ (ignore args)
;;`(message ,@args)
)
@@ -252,7 +253,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere"))
(cc-bytecomp-debug-msg
"cc-bytecomp-restore-environment: Done"))))
-(defun cc-bytecomp-load (cc-part)
+(defun cc-bytecomp-load (_cc-part)
;; A dummy function which will immediately be overwritten by the
;; following at load time. This should suppress the byte compiler
;; error that the function is "not known to be defined".
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index c05200b3898..471560e19d4 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -51,6 +51,8 @@
;; Indentation / Display syntax functions
(defvar c-fix-backslashes t)
+(defvar c-syntactic-context)
+
(defun c-indent-line (&optional syntax quiet ignore-point-pos)
"Indent the current line according to the syntactic context,
if `c-syntactic-indentation' is non-nil. Optional SYNTAX is the
@@ -1635,7 +1637,6 @@ defun."
(c-save-buffer-state
(beginning-of-defun-function
end-of-defun-function
- (start (point))
(paren-state (c-parse-state))
(orig-point-min (point-min)) (orig-point-max (point-max))
lim ; Position of { which has been widened to.
@@ -1759,7 +1760,6 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'."
(c-save-buffer-state
(beginning-of-defun-function
end-of-defun-function
- (start (point))
(paren-state (c-parse-state))
(orig-point-min (point-min)) (orig-point-max (point-max))
lim
@@ -1821,7 +1821,6 @@ the open-parenthesis that starts a defun; see `beginning-of-defun'."
"Return the name of the current defun, or NIL if there isn't one.
\"Defun\" here means a function, or other top level construct
with a brace block."
- (interactive)
(c-save-buffer-state
(beginning-of-defun-function end-of-defun-function
where pos name-end case-fold-search)
@@ -1843,19 +1842,33 @@ with a brace block."
(unless (eq where 'at-header)
(c-backward-to-nth-BOF-{ 1 where)
(c-beginning-of-decl-1))
+ (when (looking-at c-typedef-key)
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws))
;; Pick out the defun name, according to the type of defun.
(cond
;; struct, union, enum, or similar:
- ((and (looking-at c-type-prefix-key)
- (progn (c-forward-token-2 2) ; over "struct foo "
- (or (eq (char-after) ?\{)
- (looking-at c-symbol-key)))) ; "struct foo bar ..."
- (save-match-data (c-forward-token-2))
- (when (eq (char-after) ?\{)
- (c-backward-token-2)
- (looking-at c-symbol-key))
- (match-string-no-properties 0))
+ ((save-excursion
+ (and
+ (looking-at c-type-prefix-key)
+ (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))
+ (or (not (or (eq (char-after) ?{)
+ (and c-recognize-knr-p
+ (c-in-knr-argdecl))))
+ (progn (c-backward-syntactic-ws)
+ (not (eq (char-before) ?\)))))))
+ (let ((key-pos (point)))
+ (c-forward-over-token-and-ws) ; over "struct ".
+ (cond
+ ((looking-at c-symbol-key) ; "struct foo { ..."
+ (buffer-substring-no-properties key-pos (match-end 0)))
+ ((eq (char-after) ?{) ; "struct { ... } foo"
+ (when (c-go-list-forward)
+ (c-forward-syntactic-ws)
+ (when (looking-at c-symbol-key) ; a bit bogus - there might
+ ; be several identifiers.
+ (match-string-no-properties 0)))))))
((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs!
;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory
@@ -1892,15 +1905,24 @@ with a brace block."
(t
;; Normal function or initializer.
- (when (c-syntactic-re-search-forward "[{(]" nil t)
- (backward-char)
+ (when
+ (and
+ (consp (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil))
+ (or (eq (char-after) ?{)
+ (and c-recognize-knr-p
+ (c-in-knr-argdecl)))
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\)))
+ (c-go-list-backward))
(c-backward-syntactic-ws)
(when (eq (char-before) ?\=) ; struct foo bar = {0, 0} ;
(c-backward-token-2)
(c-backward-syntactic-ws))
(setq name-end (point))
(c-back-over-compound-identifier)
- (buffer-substring-no-properties (point) name-end)))))))))
+ (and (looking-at c-symbol-start)
+ (buffer-substring-no-properties (point) name-end))))))))))
(defun c-declaration-limits (near)
;; Return a cons of the beginning and end positions of the current
@@ -1915,7 +1937,7 @@ with a brace block."
(save-restriction
(let ((start (point))
(paren-state (c-parse-state))
- lim pos end-pos encl-decl-block where)
+ lim pos end-pos where)
;; Narrow enclosing brace blocks out, as required by the values of
;; `c-defun-tactic', `near', and the position of point.
(when (eq c-defun-tactic 'go-outward)
@@ -2041,6 +2063,23 @@ with a brace block."
(eq (char-after) ?\{)
(cons (point-min) (point-max))))))))
+(defun c-display-defun-name (&optional arg)
+ "Display the name of the current CC mode defun and the position in it.
+With a prefix arg, push the name onto the kill ring too."
+ (interactive "P")
+ (save-restriction
+ (widen)
+ (c-save-buffer-state ((name (c-defun-name))
+ (limits (c-declaration-limits t))
+ (point-bol (c-point 'bol)))
+ (when name
+ (message "%s. Line %s/%s." name
+ (1+ (count-lines (car limits) point-bol))
+ (count-lines (car limits) (cdr limits)))
+ (if arg (kill-new name))
+ (sit-for 3 t)))))
+(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.
If point is not inside any then the closest following one is
@@ -2085,7 +2124,6 @@ function does not require the declaration to contain a brace block."
(defun c-cpp-define-name ()
"Return the name of the current CPP macro, or NIL if we're not in one."
- (interactive)
(let (case-fold-search)
(save-excursion
(and c-opt-cpp-macro-define-start
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index dd8f8afc6a3..bff1c9eb65d 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -44,19 +44,12 @@
(load "cc-bytecomp" nil t)))
(eval-and-compile
- (defvar c--mapcan-status
- (cond ((and (fboundp 'mapcan)
- (subrp (symbol-function 'mapcan)))
- ;; XEmacs
- 'mapcan)
- ((locate-file "cl-lib.elc" load-path)
- ;; Emacs >= 24.3
- 'cl-mapcan)
- (t
- ;; Emacs <= 24.2
- nil))))
-
-(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
+ (defvar c--cl-library
+ (if (locate-library "cl-lib")
+ 'cl-lib
+ 'cl)))
+
+(cc-external-require c--cl-library)
; was (cc-external-require 'cl). ACM 2005/11/29.
; Changed from (eval-when-compile (require 'cl)) back to
; cc-external-require, 2015-08-12.
@@ -182,9 +175,12 @@ This variant works around bugs in `eval-when-compile' in various
;; The motivation for this macro is to avoid the irritating message
;; "function `mapcan' from cl package called at runtime" produced by Emacs.
(cond
- ((eq c--mapcan-status 'mapcan)
+ ((and (fboundp 'mapcan)
+ (subrp (symbol-function 'mapcan)))
+ ;; XEmacs and Emacs >= 26.
`(mapcan ,fun ,liszt))
- ((eq c--mapcan-status 'cl-mapcan)
+ ((eq c--cl-library 'cl-lib)
+ ;; Emacs >= 24.3, < 26.
`(cl-mapcan ,fun ,liszt))
(t
;; Emacs <= 24.2. It would be nice to be able to distinguish between
@@ -193,13 +189,13 @@ This variant works around bugs in `eval-when-compile' in various
(defmacro c--set-difference (liszt1 liszt2 &rest other-args)
;; Macro to smooth out the renaming of `set-difference' in Emacs 24.3.
- (if (eq c--mapcan-status 'cl-mapcan)
+ (if (eq c--cl-library 'cl-lib)
`(cl-set-difference ,liszt1 ,liszt2 ,@other-args)
`(set-difference ,liszt1 ,liszt2 ,@other-args)))
(defmacro c--intersection (liszt1 liszt2 &rest other-args)
;; Macro to smooth out the renaming of `intersection' in Emacs 24.3.
- (if (eq c--mapcan-status 'cl-mapcan)
+ (if (eq c--cl-library 'cl-lib)
`(cl-intersection ,liszt1 ,liszt2 ,@other-args)
`(intersection ,liszt1 ,liszt2 ,@other-args)))
@@ -212,7 +208,7 @@ This variant works around bugs in `eval-when-compile' in various
(defmacro c--delete-duplicates (cl-seq &rest cl-keys)
;; Macro to smooth out the renaming of `delete-duplicates' in Emacs 24.3.
- (if (eq c--mapcan-status 'cl-mapcan)
+ (if (eq c--cl-library 'cl-lib)
`(cl-delete-duplicates ,cl-seq ,@cl-keys)
`(delete-duplicates ,cl-seq ,@cl-keys))))
@@ -371,6 +367,8 @@ to it is returned. This function does not modify the point or the mark."
(t (error "Unknown buffer position requested: %s" position))))
(point))))
+(defvar lookup-syntax-properties) ;XEmacs.
+
(eval-and-compile
;; Constant to decide at compilation time whether to use category
;; properties. Currently (2010-03) they're available only on GNU Emacs.
@@ -419,6 +417,17 @@ to it is returned. This function does not modify the point or the mark."
;; Emacs.
`(setq mark-active ,activate)))
+(defmacro c-set-keymap-parent (map parent)
+ (cond
+ ;; XEmacs
+ ((cc-bytecomp-fboundp 'set-keymap-parents)
+ `(set-keymap-parents ,map ,parent))
+ ;; Emacs
+ ((cc-bytecomp-fboundp 'set-keymap-parent)
+ `(set-keymap-parent ,map ,parent))
+ ;; incompatible
+ (t (error "CC Mode is incompatible with this version of Emacs"))))
+
(defmacro c-delete-and-extract-region (start end)
"Delete the text between START and END and return it."
(if (cc-bytecomp-fboundp 'delete-and-extract-region)
@@ -1175,6 +1184,86 @@ been put there by c-put-char-property. POINT remains unchanged."
nil ,from ,to ,value nil -property-))
;; GNU Emacs
`(c-clear-char-property-with-value-function ,from ,to ,property ,value)))
+
+(defmacro c-search-forward-char-property-with-value-on-char
+ (property value char &optional limit)
+ "Search forward for a text-property PROPERTY having value VALUE on a
+character with value CHAR.
+LIMIT bounds the search. The value comparison is done with `equal'.
+PROPERTY must be a constant.
+
+Leave point just after the character, and set the match data on
+this character, and return point. If the search fails, return
+nil; point is then left undefined."
+ `(let ((char-skip (concat "^" (char-to-string ,char)))
+ (-limit- ,limit)
+ (-value- ,value))
+ (while
+ (and
+ (progn (skip-chars-forward char-skip -limit-)
+ (< (point) -limit-))
+ (not (equal (c-get-char-property (point) ,property) -value-)))
+ (forward-char))
+ (when (< (point) -limit-)
+ (search-forward-regexp ".") ; to set the match-data.
+ (point))))
+
+(defun c-clear-char-property-with-value-on-char-function (from to property
+ value char)
+ "Remove all text-properties PROPERTY with value VALUE on
+characters with value CHAR from the region [FROM, TO), as tested
+by `equal'. These properties are assumed to be over individual
+characters, having been put there by c-put-char-property. POINT
+remains unchanged."
+ (let ((place from)
+ )
+ (while ; loop round occurrences of (PROPERTY VALUE)
+ (progn
+ (while ; loop round changes in PROPERTY till we find VALUE
+ (and
+ (< place to)
+ (not (equal (get-text-property place property) value)))
+ (setq place (c-next-single-property-change place property nil to)))
+ (< place to))
+ (if (eq (char-after place) char)
+ (remove-text-properties place (1+ place) (cons property nil)))
+ ;; Do we have to do anything with stickiness here?
+ (setq place (1+ place)))))
+
+(defmacro c-clear-char-property-with-value-on-char (from to property value char)
+ "Remove all text-properties PROPERTY with value VALUE on
+characters with value CHAR from the region [FROM, TO), as tested
+by `equal'. These properties are assumed to be over individual
+characters, having been put there by c-put-char-property. POINT
+remains unchanged."
+ (if c-use-extents
+ ;; XEmacs
+ `(let ((-property- ,property)
+ (-char- ,char))
+ (map-extents (lambda (ext val)
+ (if (and (equal (extent-property ext -property-) val)
+ (eq (char-after
+ (extent-start-position ext))
+ -char-))
+ (delete-extent ext)))
+ nil ,from ,to ,value nil -property-))
+ ;; Gnu Emacs
+ `(c-clear-char-property-with-value-on-char-function ,from ,to ,property
+ ,value ,char)))
+
+(defmacro c-put-char-properties-on-char (from to property value char)
+ ;; This needs to be a macro because `property' passed to
+ ;; `c-put-char-property' must be a constant.
+ "Put the text property PROPERTY with value VALUE on characters
+with value CHAR in the region [FROM to)."
+ `(let ((skip-string (concat "^" (list ,char)))
+ (-to- ,to))
+ (save-excursion
+ (goto-char ,from)
+ (while (progn (skip-chars-forward skip-string -to-)
+ (< (point) -to-))
+ (c-put-char-property (point) ,property ,value)
+ (forward-char)))))
;; Macros to put overlays (Emacs) or extents (XEmacs) on buffer text.
;; For our purposes, these are characterized by being possible to
@@ -1211,6 +1300,7 @@ been put there by c-put-char-property. POINT remains unchanged."
(def-edebug-spec cc-eval-when-compile (&rest def-form))
(def-edebug-spec c-point t)
(def-edebug-spec c-set-region-active t)
+(def-edebug-spec c-set-keymap-parent t)
(def-edebug-spec c-safe t)
(def-edebug-spec c-save-buffer-state let*)
(def-edebug-spec c-tentative-buffer-changes t)
@@ -1232,6 +1322,8 @@ been put there by c-put-char-property. POINT remains unchanged."
(def-edebug-spec c-put-char-property t)
(def-edebug-spec c-get-char-property t)
(def-edebug-spec c-clear-char-property t)
+(def-edebug-spec c-clear-char-property-with-value-on-char t)
+(def-edebug-spec c-put-char-properties-on-char t)
(def-edebug-spec c-clear-char-properties t)
(def-edebug-spec c-put-overlay t)
(def-edebug-spec c-delete-overlay t)
@@ -1777,8 +1869,6 @@ non-nil, a caret is prepended to invert the set."
(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start)
-(defvar lookup-syntax-properties) ;XEmacs.
-
(defconst c-emacs-features
(let (list)
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index aa84ade083c..ab0204cb961 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -132,7 +132,7 @@
;;
;; 'c-not-decl
;; Put on the brace which introduces a brace list and on the commas
-;; which separate the element within it.
+;; which separate the elements within it.
;;
;; 'c-awk-NL-prop
;; Used in AWK mode to mark the various kinds of newlines. See
@@ -241,14 +241,14 @@
;; Either nil, or the last character of the macro currently represented by
;; `c-macro-cache' which isn't in a comment. */
-(defun c-invalidate-macro-cache (beg end)
+(defun c-invalidate-macro-cache (beg _end)
;; Called from a before-change function. If the change region is before or
;; in the macro characterized by `c-macro-cache' etc., nullify it
;; appropriately. BEG and END are the standard before-change-functions
;; parameters. END isn't used.
(cond
((null c-macro-cache))
- ((< beg (car c-macro-cache))
+ ((<= beg (car c-macro-cache))
(setq c-macro-cache nil
c-macro-cache-start-pos nil
c-macro-cache-syntactic nil
@@ -834,7 +834,7 @@ comment at the start of cc-engine.el for more info."
(c-stmt-delim-chars (if comma-delim
c-stmt-delim-chars-with-comma
c-stmt-delim-chars))
- c-in-literal-cache c-maybe-labelp after-case:-pos saved
+ c-maybe-labelp after-case:-pos saved
;; Current position.
pos
;; Position of last stmt boundary character (e.g. ;).
@@ -1680,6 +1680,7 @@ comment at the start of cc-engine.el for more info."
; (not (eobp)))))))
(defmacro c-debug-sws-msg (&rest args)
+ (ignore args)
;;`(message ,@args)
)
@@ -1719,7 +1720,7 @@ comment at the start of cc-engine.el for more info."
`((c-debug-remove-face beg end 'c-debug-is-sws-face)
(c-debug-remove-face beg end 'c-debug-in-sws-face)))))
-;; The type of literal position `end' is in in a `before-change-functions'
+;; The type of literal position `end' is in a `before-change-functions'
;; function - one of `c', `c++', `pound', or nil (but NOT `string').
(defvar c-sws-lit-type nil)
;; A cons (START . STOP) of the bounds of the comment or CPP construct
@@ -1979,17 +1980,10 @@ comment at the start of cc-engine.el for more info."
(end-of-line))
(setq macro-end (point))
;; Check for an open block comment at the end of the macro.
- (goto-char macro-start)
- (let (s in-block-comment)
- (while
- (progn
- (setq s (parse-partial-sexp (point) macro-end
- nil nil s 'syntax-table))
- (< (point) macro-end))
- (setq in-block-comment
- (and (elt s 4) ; in a comment
- (null (elt s 7))))) ; a block comment
- (if in-block-comment (setq safe-start nil)))
+ (let ((s (parse-partial-sexp macro-start macro-end)))
+ (if (and (elt s 4) ; in a comment
+ (null (elt s 7))) ; a block comment
+ (setq safe-start nil)))
(forward-line 1)
;; Don't cache at eob in case the buffer is narrowed.
(not (eobp)))
@@ -2790,7 +2784,7 @@ comment at the start of cc-engine.el for more info."
(setq pos npos)
(setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
- ;; Add one extra element above HERE so as to to avoid the previous
+ ;; Add one extra element above HERE so as to avoid the previous
;; expensive calculation when the next call is close to the current
;; one. This is especially useful when inside a large macro.
(when npos
@@ -3307,7 +3301,6 @@ comment at the start of cc-engine.el for more info."
paren+1s ; A list of `paren+1's; used to determine a
; good-pos.
bra+1 ; just after L bra-ce.
- bra+1s ; list of OLD values of bra+1.
mstart) ; start of a macro.
(save-excursion
@@ -3345,7 +3338,7 @@ comment at the start of cc-engine.el for more info."
;; Insert the opening brace/bracket/paren position.
(setq c-state-cache (cons (1- pa+1) c-state-cache))
;; Clear admin stuff for the next more nested part of the scan.
- (setq ren+1 pa+1 pa+1 nil bra+1 nil bra+1s nil)
+ (setq ren+1 pa+1 pa+1 nil bra+1 nil)
t) ; Carry on the loop
;; All open p/b/b's at this nesting level, if any, have probably
@@ -3429,7 +3422,7 @@ comment at the start of cc-engine.el for more info."
upper-lim ; ,beyond which `c-state-cache' entries are removed
scan-back-pos
cons-separated
- pair-beg pps-point-state target-depth)
+ pair-beg target-depth)
;; Remove entries beyond HERE. Also remove any entries inside
;; a macro, unless HERE is in the same macro.
@@ -3485,9 +3478,6 @@ comment at the start of cc-engine.el for more info."
target-depth
nil pps-state))
- (if (= (point) pps-point)
- (setq pps-point-state pps-state))
-
(when (eq (car pps-state) target-depth)
(setq pos (point)) ; POS is now just after an R-paren/brace.
(cond
@@ -3732,11 +3722,10 @@ comment at the start of cc-engine.el for more info."
;; brace pair.
(let ((here-bol (c-point 'bol here))
too-high-pa ; recorded {/(/[ next above or just below here, or nil.
- dropped-cons ; was the last removed element a brace pair?
- pa)
+ dropped-cons) ; was the last removed element a brace pair?
;; The easy bit - knock over-the-top bits off `c-state-cache'.
(while (and c-state-cache
- (>= (setq pa (c-state-cache-top-paren)) here))
+ (>= (c-state-cache-top-paren) here))
(setq dropped-cons (consp (car c-state-cache))
too-high-pa (c-state-cache-top-lparen)
c-state-cache (cdr c-state-cache)))
@@ -4308,6 +4297,47 @@ comment at the start of cc-engine.el for more info."
"\\w\\|\\s_\\|\\s\"\\|\\s|"
"\\w\\|\\s_\\|\\s\""))
+(defun c-forward-over-token-and-ws (&optional balanced)
+ "Move forward over a token and any following whitespace
+Return t if we moved, nil otherwise (i.e. we were at EOB, or a
+non-token or BALANCED is non-nil and we can't move). If we
+are at syntactic whitespace, move over this in place of a token.
+
+If BALANCED is non-nil move over any balanced parens we are at, and never move
+out of an enclosing paren.
+
+This function differs from `c-forward-token-2' in that it will move forward
+over the final token in a buffer, up to EOB."
+ (let ((jump-syntax (if balanced
+ c-jump-syntax-balanced
+ c-jump-syntax-unbalanced))
+ (here (point)))
+ (when
+ (condition-case nil
+ (cond
+ ((/= (point)
+ (progn (c-forward-syntactic-ws) (point)))
+ ;; If we're at whitespace, count this as the token.
+ t)
+ ((eobp) nil)
+ ((looking-at jump-syntax)
+ (goto-char (scan-sexps (point) 1))
+ t)
+ ((looking-at c-nonsymbol-token-regexp)
+ (goto-char (match-end 0))
+ t)
+ ((save-restriction
+ (widen)
+ (looking-at c-nonsymbol-token-regexp))
+ nil)
+ (t
+ (forward-char)
+ t))
+ (error (goto-char here)
+ nil))
+ (c-forward-syntactic-ws)
+ t)))
+
(defun c-forward-token-2 (&optional count balanced limit)
"Move forward by tokens.
A token is defined as all symbols and identifiers which aren't
@@ -4337,15 +4367,11 @@ comment at the start of cc-engine.el for more info."
(if (< count 0)
(- (c-backward-token-2 (- count) balanced limit))
- (let ((jump-syntax (if balanced
- c-jump-syntax-balanced
- c-jump-syntax-unbalanced))
- (last (point))
- (prev (point)))
-
- (if (zerop count)
- ;; If count is zero we should jump if in the middle of a token.
- (c-end-of-current-token))
+ (let ((here (point))
+ (last (point)))
+ (when (zerop count)
+ ;; If count is zero we should jump if in the middle of a token.
+ (c-end-of-current-token))
(save-restriction
(if limit (narrow-to-region (point-min) limit))
@@ -4359,43 +4385,15 @@ comment at the start of cc-engine.el for more info."
;; Moved out of bounds. Make sure the returned count isn't zero.
(progn
(if (zerop count) (setq count 1))
- (goto-char last))
-
- ;; Use `condition-case' to avoid having the limit tests
- ;; inside the loop.
- (condition-case nil
- (while (and
- (> count 0)
- (progn
- (setq last (point))
- (cond ((looking-at jump-syntax)
- (goto-char (scan-sexps (point) 1))
- t)
- ((looking-at c-nonsymbol-token-regexp)
- (goto-char (match-end 0))
- t)
- ;; `c-nonsymbol-token-regexp' above should always
- ;; match if there are correct tokens. Try to
- ;; widen to see if the limit was set in the
- ;; middle of one, else fall back to treating
- ;; the offending thing as a one character token.
- ((and limit
- (save-restriction
- (widen)
- (looking-at c-nonsymbol-token-regexp)))
- nil)
- (t
- (forward-char)
- t))))
- (c-forward-syntactic-ws)
- (setq prev last
- count (1- count)))
- (error (goto-char last)))
-
- (when (eobp)
- (goto-char prev)
- (setq count (1+ count)))))
-
+ (goto-char here))
+ (while (and
+ (> count 0)
+ (c-forward-over-token-and-ws balanced)
+ (not (eobp)))
+ (setq last (point)
+ count (1- count)))
+ (if (eobp)
+ (goto-char last))))
count)))
(defun c-backward-token-2 (&optional count balanced limit)
@@ -4809,7 +4807,6 @@ comment at the start of cc-engine.el for more info."
(c-self-bind-state-cache
(let ((start (point))
- state-2
;; A list of syntactically relevant positions in descending
;; order. It's used to avoid scanning repeatedly over
;; potentially large regions with `parse-partial-sexp' to verify
@@ -5028,7 +5025,7 @@ comment at the start of cc-engine.el for more info."
;; Tools for handling comments and string literals.
-(defun c-in-literal (&optional lim detect-cpp)
+(defun c-in-literal (&optional _lim detect-cpp)
"Return the type of literal point is in, if any.
The return value is `c' if in a C-style comment, `c++' if in a C++
style comment, `string' if in a string literal, `pound' if DETECT-CPP
@@ -5036,9 +5033,6 @@ is non-nil and in a preprocessor line, or nil if somewhere else.
Optional LIM is used as the backward limit of the search. If omitted,
or nil, `c-beginning-of-defun' is used.
-The last point calculated is cached if the cache is enabled, i.e. if
-`c-in-literal-cache' is bound to a two element vector.
-
Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
(save-restriction
@@ -5195,16 +5189,25 @@ comment at the start of cc-engine.el for more info."
;; Get a "safe place" approximately TRY-SIZE characters before START.
;; This defsubst doesn't preserve point.
(let* ((pos (max (- start try-size) (point-min)))
- (s (c-state-semi-pp-to-literal pos)))
- (or (car (cddr s)) pos)))
+ (s (c-state-semi-pp-to-literal pos))
+ (cand (or (car (cddr s)) pos)))
+ (if (>= cand (point-min))
+ cand
+ (parse-partial-sexp pos start nil nil (car s) 'syntax-table)
+ (point))))
(defun c-determine-limit (how-far-back &optional start try-size)
- ;; Return a buffer position HOW-FAR-BACK non-literal characters from START
- ;; (default point). This is done by going back further in the buffer then
- ;; searching forward for literals. The position found won't be in a
- ;; literal. We start searching for the sought position TRY-SIZE (default
- ;; twice HOW-FAR-BACK) bytes back from START. This function must be fast.
- ;; :-)
+ ;; Return a buffer position 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.
+ ;;
+ ;; 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)))
(try-size (or try-size (* 2 how-far-back)))
@@ -5260,6 +5263,8 @@ comment at the start of cc-engine.el for more info."
(+ (car elt) (- count how-far-back)))
((eq base (point-min))
(point-min))
+ ((> base (- start try-size)) ; Can only happen if we hit point-min.
+ (car elt))
(t
(c-determine-limit (- how-far-back count) base try-size))))))
@@ -5418,15 +5423,14 @@ comment at the start of cc-engine.el for more info."
(min c-bs-cache-limit pos)))
(defun c-update-brace-stack (stack from to)
- ;; Give a brace-stack which has the value STACK at position FROM, update it
- ;; to it's value at position TO, where TO is after (or equal to) FROM.
+ ;; Given a brace-stack which has the value STACK at position FROM, update it
+ ;; to its value at position TO, where TO is after (or equal to) FROM.
;; Return a cons of either TO (if it is outside a literal) and this new
;; value, or of the next position after TO outside a literal and the new
;; value.
(let (match kwd-sym (prev-match-pos 1)
(s (cdr stack))
- (bound-<> (car stack))
- )
+ (bound-<> (car stack)))
(save-excursion
(cond
((and bound-<> (<= to bound-<>))
@@ -5487,6 +5491,9 @@ comment at the start of cc-engine.el for more info."
(setq s (cdr s))))
((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
(push 0 s))))
+ ;; The failing `c-syntactic-re-search-forward' may have left us in the
+ ;; middle of a token, which might be a significant token. Fix this!
+ (c-beginning-of-current-token)
(cons (point)
(cons bound-<> s)))))
@@ -5662,11 +5669,13 @@ comment at the start of cc-engine.el for more info."
;; Call CFD-FUN for each possible spot for a declaration, cast or
;; label from the point to CFD-LIMIT.
;;
- ;; CFD-FUN is called with point at the start of the spot. It's passed two
+ ;; CFD-FUN is called with point at the start of the spot. It's passed three
;; arguments: The first is the end position of the token preceding the spot,
;; or 0 for the implicit match at bob. The second is a flag that is t when
- ;; the match is inside a macro. Point should be moved forward by at least
- ;; one token.
+ ;; the match is inside a macro. The third is a flag that is t when the
+ ;; match is at "top level", i.e. outside any brace block, or directly inside
+ ;; a class or namespace, etc. Point should be moved forward by at least one
+ ;; token.
;;
;; If CFD-FUN adds `c-decl-end' properties somewhere below the current spot,
;; it should return non-nil to ensure that the next search will find them.
@@ -6053,6 +6062,8 @@ comment at the start of cc-engine.el for more info."
(setq cfd-macro-end 0)
nil)))) ; end of when condition
+ (when (> cfd-macro-end 0)
+ (setq cfd-top-level nil)) ; In a macro is "never" at top level.
(c-debug-put-decl-spot-faces cfd-match-pos (point))
(if (funcall cfd-fun cfd-match-pos (/= cfd-macro-end 0) cfd-top-level)
(setq cfd-prop-match nil))
@@ -6097,7 +6108,8 @@ comment at the start of cc-engine.el for more info."
(defsubst c-clear-found-types ()
;; Clears `c-found-types'.
- (setq c-found-types (make-vector 53 0)))
+ (setq c-found-types
+ (make-hash-table :test #'equal :weakness nil)))
(defun c-add-type (from to)
;; Add the given region as a type in `c-found-types'. If the region
@@ -6111,36 +6123,34 @@ comment at the start of cc-engine.el for more info."
;;
;; This function might do hidden buffer changes.
(let ((type (c-syntactic-content from to c-recognize-<>-arglists)))
- (unless (intern-soft type c-found-types)
- (unintern (substring type 0 -1) c-found-types)
- (intern type c-found-types))))
+ (unless (gethash type c-found-types)
+ (remhash (substring type 0 -1) c-found-types)
+ (puthash type t c-found-types))))
(defun c-unfind-type (name)
;; Remove the "NAME" from c-found-types, if present.
- (unintern name c-found-types))
+ (remhash name c-found-types))
(defsubst c-check-type (from to)
;; Return non-nil if the given region contains a type in
;; `c-found-types'.
;;
;; This function might do hidden buffer changes.
- (intern-soft (c-syntactic-content from to c-recognize-<>-arglists)
- c-found-types))
+ (gethash (c-syntactic-content from to c-recognize-<>-arglists) c-found-types))
(defun c-list-found-types ()
;; Return all the types in `c-found-types' as a sorted list of
;; strings.
(let (type-list)
- (mapatoms (lambda (type)
- (setq type-list (cons (symbol-name type)
- type-list)))
+ (maphash (lambda (type _)
+ (setq type-list (cons type type-list)))
c-found-types)
(sort type-list 'string-lessp)))
;; Shut up the byte compiler.
(defvar c-maybe-stale-found-type)
-(defun c-trim-found-types (beg end old-len)
+(defun c-trim-found-types (beg end _old-len)
;; An after change function which, in conjunction with the info in
;; c-maybe-stale-found-type (set in c-before-change), removes a type
;; from `c-found-types', should this type have become stale. For
@@ -6410,6 +6420,9 @@ comment at the start of cc-engine.el for more info."
(c-clear-<>-pair-props)
(forward-char)))))))
+(defvar c-restricted-<>-arglists) ;FIXME: Move definition here?
+(defvar c-parse-and-markup-<>-arglists) ;FIXME: Move definition here?
+
(defun c-restore-<>-properties (_beg _end _old-len)
;; This function is called as an after-change function. It restores the
;; category/syntax-table properties on template/generic <..> pairs between
@@ -6431,7 +6444,8 @@ comment at the start of cc-engine.el for more info."
(not (eq (c-get-char-property (point) 'c-type)
'c-decl-arg-start)))))))
(or (c-forward-<>-arglist nil)
- (forward-char)))))
+ (c-forward-over-token-and-ws)
+ (goto-char c-new-END)))))
;; Functions to handle C++ raw strings.
@@ -6716,7 +6730,7 @@ comment at the start of cc-engine.el for more info."
(c-put-char-property open-paren 'syntax-table '(1)))
(goto-char bound))))
-(defun c-after-change-re-mark-raw-strings (beg end old-len)
+(defun c-after-change-re-mark-raw-strings (_beg _end _old-len)
;; This function applies `syntax-table' text properties to C++ raw strings
;; beginning in the region (c-new-BEG c-new-END). BEG, END, and OLD-LEN are
;; the standard arguments supplied to any after-change function.
@@ -6937,7 +6951,7 @@ comment at the start of cc-engine.el for more info."
;; recognized are those specified by `c-type-list-kwds',
;; `c-ref-list-kwds', `c-colon-type-list-kwds',
;; `c-paren-nontype-kwds', `c-paren-type-kwds', `c-<>-type-kwds',
- ;; and `c-<>-arglist-kwds'.
+ ;; `c-<>-arglist-kwds', and `c-protection-kwds'.
;;
;; This function records identifier ranges on
;; `c-record-type-identifiers' and `c-record-ref-identifiers' if
@@ -7007,6 +7021,17 @@ comment at the start of cc-engine.el for more info."
(not (looking-at c-symbol-start))
(c-safe (c-forward-sexp) t))
(c-forward-syntactic-ws)
+ (setq safe-pos (point)))
+
+ ((and (c-keyword-member kwd-sym 'c-protection-kwds)
+ (or (null c-post-protection-token)
+ (and (looking-at c-post-protection-token)
+ (save-excursion
+ (goto-char (match-end 0))
+ (not (c-end-of-current-token))))))
+ (if c-post-protection-token
+ (goto-char (match-end 0)))
+ (c-forward-syntactic-ws)
(setq safe-pos (point))))
(when (c-keyword-member kwd-sym 'c-colon-type-list-kwds)
@@ -7064,6 +7089,7 @@ comment at the start of cc-engine.el for more info."
;; This function might do hidden buffer changes.
(let ((start (point))
+ (old-found-types (copy-hash-table c-found-types))
;; If `c-record-type-identifiers' is set then activate
;; recording of any found types that constitute an argument in
;; the arglist.
@@ -7079,6 +7105,7 @@ comment at the start of cc-engine.el for more info."
(nconc c-record-found-types c-record-type-identifiers)))
t)
+ (setq c-found-types old-found-types)
(goto-char start)
nil)))
@@ -7136,7 +7163,7 @@ comment at the start of cc-engine.el for more info."
(let ((c-promote-possible-types t)
(c-record-found-types t))
(c-forward-type))
- (c-forward-token-2))))
+ (c-forward-over-token-and-ws))))
(c-forward-syntactic-ws)
@@ -7398,7 +7425,12 @@ comment at the start of cc-engine.el for more info."
(setq pos (point)
res subres))))
- ((looking-at c-identifier-start)
+ ((and (looking-at c-identifier-start)
+ (or (not (looking-at
+ c-ambiguous-overloadable-or-identifier-prefix-re))
+ (save-excursion
+ (and (eq (c-forward-token-2) 0)
+ (not (eq (char-after) ?\())))))
;; Got a cast operator.
(when (c-forward-type)
(setq pos (point)
@@ -7809,8 +7841,7 @@ comment at the start of cc-engine.el for more info."
;; looking (in C++) like this "FQN::of::base::Class". Move to the start of
;; this construct and return t. If the parsing fails, return nil, leaving
;; point unchanged.
- (let ((here (point))
- end)
+ (let (end)
(if (not (c-on-identifier))
nil
(c-simple-skip-symbol-backward)
@@ -8092,12 +8123,14 @@ comment at the start of cc-engine.el for more info."
;; initializing brace lists.
(let (found)
(while
- (and (progn
+ (and (< (point) limit)
+ (progn
;; In the next loop, we keep searching forward whilst
;; we find ":"s which aren't single colons inside C++
;; "for" statements.
(while
(and
+ (< (point) limit)
(setq found
(c-syntactic-re-search-forward
"[;:,]\\|\\s)\\|\\(=\\|\\s(\\)"
@@ -8119,7 +8152,7 @@ comment at the start of cc-engine.el for more info."
(c-go-up-list-forward))
(setq brackets-after-id t))
(when found (backward-char))
- t))
+ (<= (point) limit)))
(list id-start id-end brackets-after-id (match-beginning 1) decorated)
(goto-char here)
@@ -8241,10 +8274,6 @@ comment at the start of cc-engine.el for more info."
;; If `backup-at-type' is nil then the other variables have
;; undefined values.
backup-at-type backup-type-start backup-id-start
- ;; This stores `kwd-sym' of the symbol before the current one.
- ;; This is needed to distinguish the C++11 version of "auto" from
- ;; the pre C++11 meaning.
- backup-kwd-sym
;; Set if we've found a specifier (apart from "typedef") that makes
;; the defined identifier(s) types.
at-type-decl
@@ -8352,7 +8381,6 @@ comment at the start of cc-engine.el for more info."
(setq backup-at-type at-type
backup-type-start type-start
backup-id-start id-start
- backup-kwd-sym kwd-sym
at-type found-type
type-start start
id-start (point)
@@ -8576,7 +8604,13 @@ comment at the start of cc-engine.el for more info."
(looking-at c-noise-macro-with-parens-name-re))
(c-forward-noise-clause))
- ((looking-at c-type-decl-suffix-key)
+ ((and (looking-at c-type-decl-suffix-key)
+ ;; We avoid recognizing foo(bar) or foo() at top level as a
+ ;; construct here in C, since we want to recognize this as a
+ ;; typeless function declaration.
+ (not (and (c-major-mode-is 'c-mode)
+ (eq context 'top)
+ (eq (char-after) ?\)))))
(if (eq (char-after) ?\))
(when (> paren-depth 0)
(setq paren-depth (1- paren-depth))
@@ -8619,7 +8653,12 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char after-paren-pos)
(c-forward-syntactic-ws)
- (c-forward-type)))))
+ (or (c-forward-type)
+ ;; Recognize a top-level typeless
+ ;; function declaration in C.
+ (and (c-major-mode-is 'c-mode)
+ (eq context 'top)
+ (eq (char-after) ?\))))))))
(setq pos (c-up-list-forward (point)))
(eq (char-before pos) ?\)))
(c-fdoc-shift-type-backward)
@@ -8906,9 +8945,9 @@ comment at the start of cc-engine.el for more info."
;; uncommon (e.g. some placements of "const" in C++) it's not worth
;; the effort to look for them.)
-;;; 2008-04-16: commented out the next form, to allow the function to recognize
-;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon)
-;;; as a(n almost complete) declaration, enabling it to be fontified.
+;;; 2008-04-16: commented out the next form, to allow the function to recognize
+;;; "foo (int bar)" in CC (an implicit type (in class foo) without a semicolon)
+;;; as a(n almost complete) declaration, enabling it to be fontified.
;; CASE 13
;; (unless (or at-decl-end (looking-at "=[^=]"))
;; If this is a declaration it should end here or its initializer(*)
@@ -9036,9 +9075,12 @@ comment at the start of cc-engine.el for more info."
;; (in at least C++) that anything that can be parsed as a declaration
;; is a declaration. Now we're being more defensive and prefer to
;; highlight things like "foo (bar);" as a declaration only if we're
- ;; inside an arglist that contains declarations.
- ;; CASE 19
- (eq context 'decl))))
+ ;; inside an arglist that contains declarations. Update (2017-09): We
+ ;; now recognize a top-level "foo(bar);" as a declaration in C.
+ ;; CASE 19
+ (or (eq context 'decl)
+ (and (c-major-mode-is 'c-mode)
+ (eq context 'top))))))
;; The point is now after the type decl expression.
@@ -9546,6 +9588,7 @@ Note that this function might do hidden buffer changes. See the
comment at the start of cc-engine.el for more info."
;; Note to maintainers: this function consumes a great mass of CPU cycles.
;; Its use should thus be minimized as far as possible.
+ ;; Consider instead using `c-bs-at-toplevel-p'.
(let ((paren-state (c-parse-state)))
(or (not (c-most-enclosing-brace paren-state))
(c-search-uplist-for-classkey paren-state))))
@@ -9575,8 +9618,15 @@ comment at the start of cc-engine.el for more info."
(not (and (c-major-mode-is 'objc-mode)
(c-forward-objc-directive)))
+ ;; Don't confuse #if .... defined(foo) for a function arglist.
+ (not (and (looking-at c-cpp-expr-functions-key)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (c-beginning-of-macro lim)))))
(setq id-start
(car-safe (c-forward-decl-or-cast-1 (c-point 'bosws) 'top nil)))
+ (numberp id-start)
(< id-start beg)
;; There should not be a '=' or ',' between beg and the
@@ -9695,8 +9745,8 @@ comment at the start of cc-engine.el for more info."
;; identifiers?
(progn
(goto-char before-lparen)
- (c-forward-token-2) ; to first token inside parens
(and
+ (c-forward-over-token-and-ws) ; to first token inside parens
(setq id-start (c-on-identifier)) ; Must be at least one.
(catch 'id-list
(while
@@ -9708,7 +9758,7 @@ comment at the start of cc-engine.el for more info."
ids)
(c-forward-syntactic-ws)
(eq (char-after) ?\,))
- (c-forward-token-2)
+ (c-forward-over-token-and-ws)
(unless (setq id-start (c-on-identifier))
(throw 'id-list nil)))
(eq (char-after) ?\)))))
@@ -10040,7 +10090,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 (_containing-sexp 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.
@@ -10181,8 +10231,16 @@ comment at the start of cc-engine.el for more info."
;; Could be more restrictive wrt invalid keywords,
;; but that'd only occur in invalid code so there's
;; no use spending effort on it.
- (let ((end (match-end 0)))
- (unless (c-forward-keyword-clause 0)
+ (let ((end (match-end 0))
+ (kwd-sym (c-keyword-sym (match-string 0))))
+ (unless
+ (and kwd-sym
+ ;; Moving over a protection kwd and the following
+ ;; ":" (in C++ Mode) to the next token could take
+ ;; us all the way up to `kwd-start', leaving us
+ ;; no chance to update `first-specifier-pos'.
+ (not (c-keyword-member kwd-sym 'c-protection-kwds))
+ (c-forward-keyword-clause 0))
(goto-char end)
(c-forward-syntactic-ws)))
@@ -10313,7 +10371,7 @@ comment at the start of cc-engine.el for more info."
;; We're at a "{". Move back to the enum-like keyword that starts this
;; declaration and return t, otherwise don't move and return nil.
(let ((here (point))
- up-sexp-pos before-identifier)
+ before-identifier)
(when c-recognize-post-brace-list-type-p
(c-backward-typed-enum-colon))
(while
@@ -10349,16 +10407,20 @@ comment at the start of cc-engine.el for more info."
(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
- ;; introduces the list, and whose cdr is t if we have parsed a keyword
- ;; matching `c-opt-inexpr-brace-list-key' (e.g. Java's "new"), nil
- ;; otherwise. Otherwise, if point might be inside an enclosing brace list,
- ;; return t. If point is definitely neither at nor in a brace list, return
- ;; nil.
+ ;; introduces the list, and whose cdr is the symbol `in-paren' if the brace
+ ;; is directly enclosed in a parenthesis form (i.e. an arglist), t if we
+ ;; have parsed a keyword matching `c-opt-inexpr-brace-list-key' (e.g. Java's
+ ;; "new"), nil otherwise. Otherwise, if point might be inside an enclosing
+ ;; brace list, return t. If point is definitely neither at nor in a brace
+ ;; list, return nil.
;;
;; CONTAINING-SEXP is the position of the brace/paren/bracket enclosing
;; POINT, or nil if there is no such position, or we do not know it. LIM is
;; a backward search limit.
;;
+ ;; The determination of whether the brace starts a brace list is solely by
+ ;; the context of the brace, not by its contents.
+ ;;
;; Here, "brace list" does not include the body of an enum.
(save-excursion
(let ((start (point))
@@ -10368,17 +10430,20 @@ comment at the start of cc-engine.el for more info."
(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)
+ inexpr-brace-list bufpos macro-start res pos after-type-id-pos
+ in-paren)
(setq res (c-backward-token-2 1 t lim))
;; Checks to do only on the first sexp before the brace.
;; Have we a C++ initialization, without an "="?
(if (and (c-major-mode-is 'c++-mode)
(cond
- ((and (not (eq res 0))
+ ((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 braceassignp 'c++-noassign))
+ (setq braceassignp 'c++-noassign
+ in-paren 'in-paren))
((looking-at c-pre-id-bracelist-key))
((looking-at c-return-key))
((and (looking-at c-symbol-start)
@@ -10387,9 +10452,11 @@ comment at the start of cc-engine.el for more info."
(t nil))
(save-excursion
(cond
- ((not (eq res 0))
+ ((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) ?\()))
+ (eq (char-after) ?\()
+ (setq in-paren 'in-paren)))
((looking-at c-pre-id-bracelist-key))
((looking-at c-return-key))
(t (setq after-type-id-pos (point))
@@ -10428,7 +10495,7 @@ comment at the start of cc-engine.el for more info."
(c-backward-syntactic-ws)
(eq (char-before) ?\()))
;; Single identifier between '(' and '{'. We have a bracelist.
- (cons after-type-id-pos nil))
+ (cons after-type-id-pos 'in-paren))
(t
(goto-char pos)
@@ -10486,14 +10553,14 @@ comment at the start of cc-engine.el for more info."
(braceassignp
;; We've hit the beginning of the aggregate list.
(c-beginning-of-statement-1 containing-sexp)
- (cons (point) inexpr-brace-list))
+ (cons (point) (or in-paren inexpr-brace-list)))
((and after-type-id-pos
(save-excursion
(when (eq (char-after) ?\;)
- (c-forward-token-2 1 t))
+ (c-forward-over-token-and-ws t))
(setq bufpos (point))
(when (looking-at c-opt-<>-sexp-key)
- (c-forward-token-2)
+ (c-forward-over-token-and-ws)
(when (and (eq (char-after) ?<)
(c-get-char-property (point) 'syntax-table))
(c-go-list-forward nil after-type-id-pos)
@@ -10511,7 +10578,7 @@ comment at the start of cc-engine.el for more info."
nil nil))
(and (consp res)
(eq (car res) after-type-id-pos))))))
- (cons bufpos inexpr-brace-list))
+ (cons bufpos (or in-paren inexpr-brace-list)))
((eq (char-after) ?\;)
;; Brace lists can't contain a semicolon, so we're done.
;; (setq containing-sexp nil)
@@ -10535,12 +10602,16 @@ comment at the start of cc-engine.el for more info."
(t t)))) ;; The caller can go up one level.
)))
-(defun c-inside-bracelist-p (containing-sexp paren-state)
+(defun c-inside-bracelist-p (containing-sexp paren-state accept-in-paren)
;; return the buffer position of the beginning of the brace list
;; statement if we're inside a brace list, otherwise return nil.
;; CONTAINING-SEXP is the buffer pos of the innermost containing
;; paren. PAREN-STATE is the remainder of the state of enclosing
- ;; braces
+ ;; braces. ACCEPT-IN-PAREN is non-nil iff we will accept as a brace
+ ;; list a brace directly enclosed in a parenthesis.
+ ;;
+ ;; The "brace list" here is recognized solely by its context, not by
+ ;; its contents.
;;
;; N.B.: This algorithm can potentially get confused by cpp macros
;; placed in inconvenient locations. It's a trade-off we make for
@@ -10555,17 +10626,11 @@ comment at the start of cc-engine.el for more info."
;; this will pick up array/aggregate init lists, even if they are nested.
(save-excursion
(let ((bufpos t)
- lim next-containing)
+ next-containing)
(while (and (eq bufpos t)
containing-sexp)
(when paren-state
- (if (consp (car paren-state))
- (setq lim (cdr (car paren-state))
- paren-state (cdr paren-state))
- (setq lim (car paren-state)))
- (when paren-state
- (setq next-containing (car paren-state)
- paren-state (cdr paren-state))))
+ (setq next-containing (c-pull-open-brace paren-state)))
(goto-char containing-sexp)
(if (c-looking-at-inexpr-block next-containing next-containing)
@@ -10574,16 +10639,18 @@ comment at the start of cc-engine.el for more info."
;; containing sexp, so that c-looking-at-inexpr-block
;; doesn't check for an identifier before it.
(setq bufpos nil)
- (when (or (not (eq (char-after) ?{))
- (eq (setq bufpos (c-looking-at-or-maybe-in-bracelist
- next-containing lim))
- t))
- (setq containing-sexp next-containing
- lim nil
- next-containing nil))))
- (and (consp bufpos) (car bufpos))))))
-
-(defun c-looking-at-special-brace-list (&optional lim)
+ (if (not (eq (char-after) ?{))
+ (setq bufpos nil)
+ (when (eq (setq bufpos (c-looking-at-or-maybe-in-bracelist
+ next-containing next-containing))
+ t)
+ (setq containing-sexp next-containing
+ next-containing nil)))))
+ (and (consp bufpos)
+ (or accept-in-paren (not (eq (cdr bufpos) 'in-paren)))
+ (car bufpos))))))
+
+(defun c-looking-at-special-brace-list (&optional _lim)
;; 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
@@ -10646,7 +10713,7 @@ comment at the start of cc-engine.el for more info."
(cons (list beg) type)))))
(error nil))))
-(defun c-looking-at-bos (&optional lim)
+(defun c-looking-at-bos (&optional _lim)
;; Return non-nil if between two statements or declarations, assuming
;; point is not inside a literal or comment.
;;
@@ -10659,26 +10726,37 @@ comment at the start of cc-engine.el for more info."
(defun c-looking-at-statement-block ()
;; Point is at an opening brace. If this is a statement block (i.e. the
- ;; elements in it are terminated by semicolons) return t. Otherwise, return
- ;; nil.
+ ;; elements in the block are terminated by semicolons, or the block is
+ ;; empty, or the block contains a keyword) return t. Otherwise, return nil.
(let ((here (point)))
(prog1
(if (c-go-list-forward)
(let ((there (point)))
(backward-char)
- (c-syntactic-skip-backward
- "^;," here t)
+ (c-syntactic-skip-backward "^;," here t)
(cond
((eq (char-before) ?\;) t)
((eq (char-before) ?,) nil)
- (t (goto-char here)
- (forward-char)
- (and (c-syntactic-re-search-forward "{" there t t)
- (progn (backward-char)
- (c-looking-at-statement-block))))))
+ (t ; We're at (1+ here).
+ (cond
+ ((progn (c-forward-syntactic-ws)
+ (eq (point) (1- there))))
+ ((c-syntactic-re-search-forward c-keywords-regexp there t))
+ ((c-syntactic-re-search-forward "{" there t t)
+ (backward-char)
+ (c-looking-at-statement-block))
+ (t nil)))))
(forward-char)
- (and (c-syntactic-re-search-forward "[;,]" nil t t)
- (eq (char-before) ?\;)))
+ (cond
+ ((c-syntactic-re-search-forward "[;,]" nil t t)
+ (eq (char-before) ?\;))
+ ((progn (c-forward-syntactic-ws)
+ (eobp)))
+ ((c-syntactic-re-search-forward c-keywords-regexp nil t t))
+ ((c-syntactic-re-search-forward "{" nil t t)
+ (backward-char)
+ (c-looking-at-statement-block))
+ (t nil)))
(goto-char here))))
(defun c-looking-at-inexpr-block (lim containing-sexp &optional check-at-end)
@@ -11208,7 +11286,7 @@ comment at the start of cc-engine.el for more info."
containing-decl-open
containing-decl-start
containing-decl-kwd
- paren-state)
+ _paren-state)
;; 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.
@@ -11424,7 +11502,7 @@ comment at the start of cc-engine.el for more info."
;; following result clauses, and most of this function is a
;; single gigantic cond. :P
literal char-before-ip before-ws-ip char-after-ip macro-start
- in-macro-expr c-syntactic-context placeholder c-in-literal-cache
+ in-macro-expr c-syntactic-context placeholder
step-type tmpsymbol keyword injava-inher special-brace-list tmp-pos
containing-<
;; The following record some positions for the containing
@@ -11448,6 +11526,7 @@ comment at the start of cc-engine.el for more info."
;; The paren state outside `containing-sexp', or at
;; `indent-point' if `containing-sexp' is nil.
(paren-state (c-parse-state))
+ (state-cache (copy-tree paren-state))
;; There's always at most one syntactic element which got
;; an anchor pos. It's stored in syntactic-relpos.
syntactic-relpos
@@ -11610,7 +11689,7 @@ comment at the start of cc-engine.el for more info."
(not (c-at-vsemi-p before-ws-ip))
(not (memq char-after-ip '(?\) ?\] ?,)))
(or (not (eq char-before-ip ?}))
- (c-looking-at-inexpr-block-backward c-state-cache))
+ (c-looking-at-inexpr-block-backward state-cache))
(> (point)
(progn
;; Ought to cache the result from the
@@ -11688,7 +11767,7 @@ comment at the start of cc-engine.el for more info."
(if containing-sexp
(progn
(goto-char containing-sexp)
- (setq lim (c-most-enclosing-brace c-state-cache
+ (setq lim (c-most-enclosing-brace state-cache
containing-sexp))
(c-backward-to-block-anchor lim)
(c-add-stmt-syntax 'case-label nil t lim paren-state))
@@ -11714,7 +11793,7 @@ comment at the start of cc-engine.el for more info."
(containing-sexp
(goto-char containing-sexp)
- (setq lim (c-most-enclosing-brace c-state-cache
+ (setq lim (c-most-enclosing-brace state-cache
containing-sexp))
(save-excursion
(setq tmpsymbol
@@ -11758,7 +11837,7 @@ comment at the start of cc-engine.el for more info."
(goto-char (cdr placeholder))
(back-to-indentation)
(c-add-stmt-syntax tmpsymbol nil t
- (c-most-enclosing-brace c-state-cache (point))
+ (c-most-enclosing-brace state-cache (point))
paren-state)
(unless (eq (point) (cdr placeholder))
(c-add-syntax (car placeholder))))
@@ -11811,7 +11890,7 @@ comment at the start of cc-engine.el for more info."
(cond
((c-backward-over-enum-header)
(setq placeholder (c-point 'boi)))
- ((consp (setq placeholder
+ ((consp (setq placeholder
(c-looking-at-or-maybe-in-bracelist
containing-sexp lim)))
(setq tmpsymbol (and (cdr placeholder) 'topmost-intro-cont))
@@ -12181,11 +12260,11 @@ comment at the start of cc-engine.el for more info."
(and (eq (char-before) ?})
(save-excursion
(let ((start (point)))
- (if (and c-state-cache
- (consp (car c-state-cache))
- (eq (cdar c-state-cache) (point)))
+ (if (and state-cache
+ (consp (car state-cache))
+ (eq (cdar state-cache) (point)))
;; Speed up the backward search a bit.
- (goto-char (caar c-state-cache)))
+ (goto-char (caar state-cache)))
(c-beginning-of-decl-1 containing-sexp) ; Can't use `lim' here.
(setq placeholder (point))
(if (= start (point))
@@ -12342,7 +12421,8 @@ comment at the start of cc-engine.el for more info."
((and (eq char-after-ip ?{)
(progn
(setq placeholder (c-inside-bracelist-p (point)
- paren-state))
+ paren-state
+ nil))
(if placeholder
(setq tmpsymbol '(brace-list-open . inexpr-class))
(setq tmpsymbol '(block-open . inexpr-statement)
@@ -12424,7 +12504,7 @@ comment at the start of cc-engine.el for more info."
(skip-chars-forward " \t"))
(goto-char placeholder))
(c-add-stmt-syntax 'arglist-cont-nonempty (list containing-sexp) t
- (c-most-enclosing-brace c-state-cache (point))
+ (c-most-enclosing-brace state-cache (point))
paren-state))
;; CASE 7G: we are looking at just a normal arglist
@@ -12465,7 +12545,11 @@ comment at the start of cc-engine.el for more info."
(save-excursion
(goto-char containing-sexp)
(c-looking-at-special-brace-list)))
- (c-inside-bracelist-p containing-sexp paren-state))))
+ (c-inside-bracelist-p containing-sexp paren-state t)
+ (save-excursion
+ (goto-char containing-sexp)
+ (and (eq (char-after) ?{)
+ (not (c-looking-at-statement-block)))))))
(cond
;; CASE 9A: In the middle of a special brace list opener.
@@ -12513,7 +12597,7 @@ comment at the start of cc-engine.el for more info."
(= (point) containing-sexp)))
(if (eq (point) (c-point 'boi))
(c-add-syntax 'brace-list-close (point))
- (setq lim (c-most-enclosing-brace c-state-cache (point)))
+ (setq lim (c-most-enclosing-brace state-cache (point)))
(c-beginning-of-statement-1 lim nil nil t)
(c-add-stmt-syntax 'brace-list-close nil t lim paren-state)))
@@ -12539,7 +12623,7 @@ comment at the start of cc-engine.el for more info."
(goto-char containing-sexp))
(if (eq (point) (c-point 'boi))
(c-add-syntax 'brace-list-intro (point))
- (setq lim (c-most-enclosing-brace c-state-cache (point)))
+ (setq lim (c-most-enclosing-brace state-cache (point)))
(c-beginning-of-statement-1 lim)
(c-add-stmt-syntax 'brace-list-intro nil t lim paren-state)))
@@ -12561,7 +12645,7 @@ comment at the start of cc-engine.el for more info."
((and (not (memq char-before-ip '(?\; ?:)))
(not (c-at-vsemi-p before-ws-ip))
(or (not (eq char-before-ip ?}))
- (c-looking-at-inexpr-block-backward c-state-cache))
+ (c-looking-at-inexpr-block-backward state-cache))
(> (point)
(save-excursion
(c-beginning-of-statement-1 containing-sexp)
@@ -12695,7 +12779,7 @@ comment at the start of cc-engine.el for more info."
(skip-chars-forward " \t"))
(goto-char placeholder))
(c-add-stmt-syntax 'template-args-cont (list containing-<) t
- (c-most-enclosing-brace c-state-cache (point))
+ (c-most-enclosing-brace state-cache (point))
paren-state))
;; CASE 17: Statement or defun catchall.
@@ -12769,7 +12853,7 @@ comment at the start of cc-engine.el for more info."
(goto-char (cdr placeholder))
(back-to-indentation)
(c-add-stmt-syntax tmpsymbol nil t
- (c-most-enclosing-brace c-state-cache (point))
+ (c-most-enclosing-brace state-cache (point))
paren-state)
(if (/= (point) (cdr placeholder))
(c-add-syntax (car placeholder))))
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 9bae7d9aa2f..d352e5b08c9 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -292,12 +292,17 @@
nil)))))
res))))
- (defun c-make-font-lock-search-form (regexp highlights)
+ (defun c-make-font-lock-search-form (regexp highlights &optional check-point)
;; Return a lisp form which will fontify every occurrence of REGEXP
;; (a regular expression, NOT a function) between POINT and `limit'
;; with HIGHLIGHTS, a list of highlighters as specified on page
- ;; "Search-based Fontification" in the elisp manual.
- `(while (re-search-forward ,regexp limit t)
+ ;; "Search-based Fontification" in the elisp manual. If CHECK-POINT
+ ;; is non-nil, we will check (< (point) limit) in the main loop.
+ `(while
+ ,(if check-point
+ `(and (< (point) limit)
+ (re-search-forward ,regexp limit t))
+ `(re-search-forward ,regexp limit t))
(unless (progn
(goto-char (match-beginning 0))
(c-skip-comments-and-strings limit))
@@ -476,7 +481,9 @@
,(c-make-font-lock-search-form
regexp highlights)))))
state-stanzas)
- ,(c-make-font-lock-search-form (car normal) (cdr normal))
+ ;; In the next form, check that point hasn't been moved beyond
+ ;; `limit' in any of the above stanzas.
+ ,(c-make-font-lock-search-form (car normal) (cdr normal) t)
nil))))
; (eval-after-load "edebug" ; 2006-07-09: def-edebug-spec is now in subr.el.
@@ -702,6 +709,36 @@ stuff. Used on level 1 and higher."
t)
(c-put-font-lock-face start (1+ start) 'font-lock-warning-face)))))
+(defun c-font-lock-invalid-single-quotes (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 fontifies invalid single quotes with
+ ;; `font-lock-warning-face'. These are the single quotes which
+ ;; o - aren't inside a literal;
+ ;; o - are marked with a syntax-table text property value '(1); and
+ ;; o - are NOT marked with a non-null c-digit-separator property.
+ (let ((limits (c-literal-limits))
+ state beg end)
+ (if limits
+ (goto-char (cdr limits))) ; Even for being in a ' '
+ (while (< (point) limit)
+ (setq beg (point))
+ (setq state (parse-partial-sexp (point) limit nil nil nil 'syntax-table))
+ (setq end (point))
+ (goto-char beg)
+ (while (progn (skip-chars-forward "^'" end)
+ (< (point) end))
+ (if (and (equal (c-get-char-property (point) 'syntax-table) '(1))
+ (not (c-get-char-property (point) 'c-digit-separator)))
+ (c-put-font-lock-face (point) (1+ (point)) font-lock-warning-face))
+ (forward-char))
+ (parse-partial-sexp end limit nil nil state 'syntax-table)))
+ nil)
+
(c-lang-defconst c-basic-matchers-before
"Font lock matchers for basic keywords, labels, references and various
other easily recognizable things that should be fontified before generic
@@ -723,6 +760,9 @@ casts and declarations are fontified. Used on level 2 and higher."
(concat ".\\(" c-string-limit-regexp "\\)")
'((c-font-lock-invalid-string)))
+ ;; Invalid single quotes.
+ c-font-lock-invalid-single-quotes
+
;; Fontify C++ raw strings.
,@(when (c-major-mode-is 'c++-mode)
'(c-font-lock-raw-strings))
@@ -777,7 +817,8 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-backward-syntactic-ws)
(setq id-end (point))
(< (skip-chars-backward
- ,(c-lang-const c-symbol-chars)) 0))
+ ,(c-lang-const c-symbol-chars))
+ 0))
(not (get-text-property (point) 'face)))
(c-put-font-lock-face (point) id-end
c-reference-face-name)
@@ -992,7 +1033,8 @@ casts and declarations are fontified. Used on level 2 and higher."
(goto-char pos)))))
nil)
-(defun c-font-lock-declarators (limit list types not-top)
+(defun c-font-lock-declarators (limit list types not-top
+ &optional template-class)
;; Assuming the point is at the start of a declarator in a declaration,
;; fontify the identifier it declares. (If TYPES is set, it does this via
;; the macro `c-fontify-types-and-refs'.)
@@ -1006,6 +1048,11 @@ casts and declarations are fontified. Used on level 2 and higher."
;; non-nil, we are not at the top-level ("top-level" includes being directly
;; inside a class or namespace, etc.).
;;
+ ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters
+ ;; and was introduced by, e.g. "typename" or "class", such that if there is
+ ;; a default (introduced by "="), it will be fontified as a type.
+ ;; E.g. "<class X = Y>".
+ ;;
;; Nil is always returned. The function leaves point at the delimiter after
;; the last declarator it processes.
;;
@@ -1013,18 +1060,16 @@ casts and declarations are fontified. Used on level 2 and higher."
;;(message "c-font-lock-declarators from %s to %s" (point) limit)
(c-fontify-types-and-refs
- ((pos (point)) next-pos id-start id-end
+ ((pos (point)) next-pos id-start
decl-res
- paren-depth
id-face got-type got-init
c-last-identifier-range
- (separator-prop (if types 'c-decl-type-start 'c-decl-id-start))
- brackets-after-id)
+ (separator-prop (if types 'c-decl-type-start 'c-decl-id-start)))
;; The following `while' fontifies a single declarator id each time round.
;; It loops only when LIST is non-nil.
(while
- (and pos (setq decl-res (c-forward-declarator limit)))
+ (and pos (setq decl-res (c-forward-declarator)))
(setq next-pos (point)
id-start (car decl-res)
id-face (if (and (eq (char-after) ?\()
@@ -1036,7 +1081,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(forward-char)
(c-forward-syntactic-ws)
(looking-at "[*&]")))
- (not (car (cddr decl-res))) ; brackets-after-id
+ (not (car (cddr decl-res)))
(or (not (c-major-mode-is 'c++-mode))
(save-excursion
(let (c-last-identifier-range)
@@ -1053,7 +1098,7 @@ casts and declarations are fontified. Used on level 2 and higher."
(throw 'is-function nil))
((not (eq got-type 'maybe))
(throw 'is-function t)))
- (c-forward-declarator limit t)
+ (c-forward-declarator nil t)
(eq (char-after) ?,))
(forward-char)
(c-forward-syntactic-ws))
@@ -1080,6 +1125,13 @@ casts and declarations are fontified. Used on level 2 and higher."
(goto-char next-pos)
(setq pos nil) ; So as to terminate the enclosing `while' form.
+ (if (and template-class
+ (eq got-init ?=) ; C++ "<class X = Y>"?
+ (c-forward-token-2 1 nil limit) ; Over "="
+ (let ((c-promote-possible-types t))
+ (c-forward-type t))) ; Over "Y"
+ (setq list nil)) ; Shouldn't be needed. We can't have a list, here.
+
(when list
;; Jump past any initializer or function prototype to see if
;; there's a ',' to continue at.
@@ -1150,10 +1202,15 @@ casts and declarations are fontified. Used on level 2 and higher."
(goto-char match-pos)
(backward-char)
(c-backward-token-2)
- (or (looking-at c-block-stmt-2-key)
- (looking-at c-block-stmt-1-2-key)
- (looking-at c-typeof-key))))
- (cons nil t))
+ (cond
+ ((looking-at c-paren-stmt-key)
+ ;; Allow comma separated <> arglists in for statements.
+ (cons nil nil))
+ ((or (looking-at c-block-stmt-2-key)
+ (looking-at c-block-stmt-1-2-key)
+ (looking-at c-typeof-key))
+ (cons nil t))
+ (t nil)))))
;; Near BOB.
((<= match-pos (point-min))
(cons 'arglist t))
@@ -1194,13 +1251,16 @@ casts and declarations are fontified. Used on level 2 and higher."
;; Got a cached hit in some other type of arglist.
(type
(cons 'arglist t))
- (not-front-decl
+ ((and not-front-decl
;; The point is within the range of a previously
;; encountered type decl expression, so the arglist
;; is probably one that contains declarations.
;; However, if `c-recognize-paren-inits' is set it
;; might also be an initializer arglist.
- ;;
+ (or (not c-recognize-paren-inits)
+ (save-excursion
+ (goto-char match-pos)
+ (not (c-back-over-member-initializers)))))
;; The result of this check is cached with a char
;; property on the match token, so that we can look
;; it up again when refontifying single lines in a
@@ -1211,17 +1271,21 @@ casts and declarations are fontified. Used on level 2 and higher."
;; Got an open paren preceded by an arith operator.
((and (eq (char-before match-pos) ?\()
(save-excursion
+ (goto-char match-pos)
(and (zerop (c-backward-token-2 2))
(looking-at c-arithmetic-op-regexp))))
(cons nil nil))
;; In a C++ member initialization list.
((and (eq (char-before match-pos) ?,)
(c-major-mode-is 'c++-mode)
- (save-excursion (c-back-over-member-initializers)))
+ (save-excursion
+ (goto-char match-pos)
+ (c-back-over-member-initializers)))
(c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
(cons 'not-decl nil))
;; At start of a declaration inside a declaration paren.
((save-excursion
+ (goto-char match-pos)
(and (memq (char-before match-pos) '(?\( ?\,))
(c-go-up-list-backward match-pos)
(eq (char-after) ?\()
@@ -1296,8 +1360,12 @@ casts and declarations are fontified. Used on level 2 and higher."
(c-backward-syntactic-ws)
(and (c-simple-skip-symbol-backward)
(looking-at c-paren-stmt-key))))
- t)))
-
+ t))
+ (template-class (and (eq context '<>)
+ (save-excursion
+ (goto-char match-pos)
+ (c-forward-syntactic-ws)
+ (looking-at c-template-typename-key)))))
;; Fix the `c-decl-id-start' or `c-decl-type-start' property
;; before the first declarator if it's a list.
;; `c-font-lock-declarators' handles the rest.
@@ -1309,10 +1377,9 @@ casts and declarations are fontified. Used on level 2 and higher."
(if (cadr decl-or-cast)
'c-decl-type-start
'c-decl-id-start)))))
-
(c-font-lock-declarators
(min limit (point-max)) decl-list
- (cadr decl-or-cast) (not toplev)))
+ (cadr decl-or-cast) (not toplev) template-class))
;; A declaration has been successfully identified, so do all the
;; fontification of types and refs that've been recorded.
@@ -1375,7 +1442,6 @@ casts and declarations are fontified. Used on level 2 and higher."
;; it finds any. That's necessary so that we later will
;; stop inside them to fontify types there.
(c-parse-and-markup-<>-arglists t)
- lbrace ; position of some {.
;; The font-lock package in Emacs is known to clobber
;; `parse-sexp-lookup-properties' (when it exists).
(parse-sexp-lookup-properties
@@ -1607,7 +1673,8 @@ casts and declarations are fontified. Used on level 2 and higher."
;; font-lock-keyword-face. It always returns NIL to inhibit this and
;; prevent a repeat invocation. See elisp/lispref page "Search-based
;; fontification".
- (let ((decl-search-lim (c-determine-limit 1000))
+ (let ((here (point))
+ (decl-search-lim (c-determine-limit 1000))
paren-state encl-pos token-end context decl-or-cast
start-pos top-level c-restricted-<>-arglists
c-recognize-knr-p) ; Strictly speaking, bogus, but it
@@ -1624,26 +1691,27 @@ casts and declarations are fontified. Used on level 2 and higher."
(when (or (bobp)
(memq (char-before) '(?\; ?{ ?})))
(setq token-end (point))
- (c-forward-syntactic-ws)
- ;; We're now putatively at the declaration.
- (setq start-pos (point))
- (setq paren-state (c-parse-state))
- ;; At top level or inside a "{"?
- (if (or (not (setq encl-pos
- (c-most-enclosing-brace paren-state)))
- (eq (char-after encl-pos) ?\{))
- (progn
- (setq top-level (c-at-toplevel-p))
- (let ((got-context (c-get-fontification-context
- token-end nil top-level)))
- (setq context (car got-context)
- c-restricted-<>-arglists (cdr got-context)))
- (setq decl-or-cast
- (c-forward-decl-or-cast-1 token-end context nil))
- (when (consp decl-or-cast)
- (goto-char start-pos)
- (c-font-lock-single-decl limit decl-or-cast token-end
- context top-level)))))))
+ (c-forward-syntactic-ws here)
+ (when (< (point) here)
+ ;; We're now putatively at the declaration.
+ (setq start-pos (point))
+ (setq paren-state (c-parse-state))
+ ;; At top level or inside a "{"?
+ (if (or (not (setq encl-pos
+ (c-most-enclosing-brace paren-state)))
+ (eq (char-after encl-pos) ?\{))
+ (progn
+ (setq top-level (c-at-toplevel-p))
+ (let ((got-context (c-get-fontification-context
+ token-end nil top-level)))
+ (setq context (car got-context)
+ c-restricted-<>-arglists (cdr got-context)))
+ (setq decl-or-cast
+ (c-forward-decl-or-cast-1 token-end context nil))
+ (when (consp decl-or-cast)
+ (goto-char start-pos)
+ (c-font-lock-single-decl limit decl-or-cast token-end
+ context top-level))))))))
nil))
(defun c-font-lock-enclosing-decls (limit)
@@ -1667,18 +1735,16 @@ casts and declarations are fontified. Used on level 2 and higher."
(eq (char-after ps-elt) ?\{))
(goto-char ps-elt)
(c-syntactic-skip-backward "^;{}" decl-search-lim)
- (when (or (bobp)
- (memq (char-before) '(?\; ?})))
- (c-forward-syntactic-ws)
- (setq in-typedef (looking-at c-typedef-key))
- (if in-typedef (c-forward-token-2))
- (when (and c-opt-block-decls-with-vars-key
- (looking-at c-opt-block-decls-with-vars-key))
- (goto-char ps-elt)
- (when (c-safe (c-forward-sexp))
- (c-forward-syntactic-ws)
- (c-font-lock-declarators limit t in-typedef
- (not (c-bs-at-toplevel-p (point)))))))))))
+ (c-forward-syntactic-ws)
+ (setq in-typedef (looking-at c-typedef-key))
+ (if in-typedef (c-forward-over-token-and-ws))
+ (when (and c-opt-block-decls-with-vars-key
+ (looking-at c-opt-block-decls-with-vars-key))
+ (goto-char ps-elt)
+ (when (c-safe (c-forward-sexp))
+ (c-forward-syntactic-ws)
+ (c-font-lock-declarators limit t in-typedef
+ (not (c-bs-at-toplevel-p (point))))))))))
(defun c-font-lock-raw-strings (limit)
;; Fontify C++ raw strings.
@@ -1955,85 +2021,6 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'."
2 font-lock-type-face)
`(,(concat "\\<\\(" re "\\)\\>")
1 'font-lock-type-face)))
-
- ;; Fontify types preceded by `c-type-prefix-kwds' (e.g. "struct").
- ,@(when (c-lang-const c-type-prefix-kwds)
- `((,(byte-compile
- `(lambda (limit)
- (c-fontify-types-and-refs
- ((c-promote-possible-types t)
- ;; The font-lock package in Emacs is known to clobber
- ;; `parse-sexp-lookup-properties' (when it exists).
- (parse-sexp-lookup-properties
- (cc-eval-when-compile
- (boundp 'parse-sexp-lookup-properties))))
- (save-restriction
- ;; Narrow to avoid going past the limit in
- ;; `c-forward-type'.
- (narrow-to-region (point) limit)
- (while (re-search-forward
- ,(concat "\\<\\("
- (c-make-keywords-re nil
- (c-lang-const c-type-prefix-kwds))
- "\\)\\>")
- limit t)
- (unless (c-skip-comments-and-strings limit)
- (c-forward-syntactic-ws)
- ;; Handle prefix declaration specifiers.
- (while
- (or
- (when (or (looking-at c-prefix-spec-kwds-re)
- (and (c-major-mode-is 'java-mode)
- (looking-at "@[A-Za-z0-9]+")))
- (c-forward-keyword-clause 1)
- t)
- (when (and c-opt-cpp-prefix
- (looking-at
- c-noise-macro-with-parens-name-re))
- (c-forward-noise-clause)
- t)))
- ,(if (c-major-mode-is 'c++-mode)
- `(when (and (c-forward-type)
- (eq (char-after) ?=))
- ;; In C++ we additionally check for a "class
- ;; X = Y" construct which is used in
- ;; templates, to fontify Y as a type.
- (forward-char)
- (c-forward-syntactic-ws)
- (c-forward-type))
- `(c-forward-type))
- )))))))))
-
- ;; Fontify symbols after closing braces as declaration
- ;; identifiers under the assumption that they are part of
- ;; declarations like "class Foo { ... } foo;". It's too
- ;; expensive to check this accurately by skipping past the
- ;; brace block, so we use the heuristic that it's such a
- ;; declaration if the first identifier is on the same line as
- ;; the closing brace. `c-font-lock-declarations' will later
- ;; override it if it turns out to be an new declaration, but
- ;; it will be wrong if it's an expression (see the test
- ;; decls-8.cc).
-;; ,@(when (c-lang-const c-opt-block-decls-with-vars-key)
-;; `((,(c-make-font-lock-search-function
-;; (concat "}"
-;; (c-lang-const c-single-line-syntactic-ws)
-;; "\\(" ; 1 + c-single-line-syntactic-ws-depth
-;; (c-lang-const c-type-decl-prefix-key)
-;; "\\|"
-;; (c-lang-const c-symbol-key)
-;; "\\)")
-;; `((c-font-lock-declarators limit t nil) ; That nil says use `font-lock-variable-name-face';
-;; ; t would mean `font-lock-function-name-face'.
-;; (progn
-;; (c-put-char-property (match-beginning 0) 'c-type
-;; 'c-decl-id-start)
-;; ; 'c-decl-type-start)
-;; (goto-char (match-beginning
-;; ,(1+ (c-lang-const
-;; c-single-line-syntactic-ws-depth)))))
-;; (goto-char (match-end 0)))))))
-
;; Fontify the type in C++ "new" expressions.
,@(when (c-major-mode-is 'c++-mode)
;; This pattern is a probably a "(MATCHER . ANCHORED-HIGHLIGHTER)"
@@ -2503,7 +2490,7 @@ need for `c++-font-lock-extra-types'.")
limit
"[-+]"
nil
- (lambda (match-pos inside-macro &optional top-level)
+ (lambda (_match-pos _inside-macro &optional _top-level)
(forward-char)
(c-font-lock-objc-method))))
nil)
diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el
index 153b3a31e56..00d8bf08175 100644
--- a/lisp/progmodes/cc-guess.el
+++ b/lisp/progmodes/cc-guess.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -494,8 +494,7 @@ is called with one argument, the guessed style."
;; If an entry in `c-offsets-alist' holds a guessed value, move it to
;; front in the field. In addition alphabetical sort by entry name is done.
(setq style (copy-tree style))
- (let ((offsets-alist-cell (assq 'c-offsets-alist style))
- (guessed-syntactic-symbols (c-guess-guessed-syntactic-symbols)))
+ (let ((offsets-alist-cell (assq 'c-offsets-alist style)))
(setcdr offsets-alist-cell
(sort (cdr offsets-alist-cell)
(lambda (a b)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index a9d5ac34ad4..227b3e16485 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -115,7 +115,7 @@
;; For Emacs < 22.2.
(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest _))))
(eval-when-compile
(let ((load-path
@@ -130,7 +130,7 @@
;; This file is not always loaded. See note above.
-(cc-external-require (if (eq c--mapcan-status 'cl-mapcan) 'cl-lib 'cl))
+(cc-external-require (if (eq c--cl-library 'cl-lib) 'cl-lib 'cl))
;;; Setup for the `c-lang-defvar' system.
@@ -245,12 +245,12 @@ the evaluated constant value at compile time."
(unless (listp (car-safe ops))
(setq ops (list ops)))
(cond ((eq opgroup-filter t)
- (setq opgroup-filter (lambda (opgroup) t)))
+ (setq opgroup-filter (lambda (_opgroup) t)))
((not (functionp opgroup-filter))
(setq opgroup-filter `(lambda (opgroup)
(memq opgroup ',opgroup-filter)))))
(cond ((eq op-filter t)
- (setq op-filter (lambda (op) t)))
+ (setq op-filter (lambda (_op) t)))
((stringp op-filter)
(setq op-filter `(lambda (op)
(string-match ,op-filter op)))))
@@ -474,18 +474,19 @@ so that all identifiers are recognized as words.")
;; The value here may be a list of functions or a single function.
t nil
c++ '(c-extend-region-for-CPP
-; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed.
c-before-change-check-raw-strings
c-before-change-check-<>-operators
c-depropertize-CPP
- c-before-after-change-digit-quote
c-invalidate-macro-cache
- c-truncate-bs-cache)
+ c-truncate-bs-cache
+ c-parse-quotes-before-change)
(c objc) '(c-extend-region-for-CPP
c-depropertize-CPP
c-invalidate-macro-cache
- c-truncate-bs-cache)
- ;; java 'c-before-change-check-<>-operators
+ c-truncate-bs-cache
+ c-parse-quotes-before-change)
+ java 'c-parse-quotes-before-change
+ ;; 'c-before-change-check-<>-operators
awk 'c-awk-record-region-clear-NL)
(c-lang-defvar c-get-state-before-change-functions
(let ((fs (c-lang-const c-get-state-before-change-functions)))
@@ -515,18 +516,19 @@ parameters \(point-min) and \(point-max).")
t '(c-depropertize-new-text
c-change-expand-fl-region)
(c objc) '(c-depropertize-new-text
+ c-parse-quotes-after-change
c-extend-font-lock-region-for-macros
c-neutralize-syntax-in-and-mark-CPP
c-change-expand-fl-region)
c++ '(c-depropertize-new-text
+ c-parse-quotes-after-change
c-extend-font-lock-region-for-macros
-; c-before-after-change-extend-region-for-lambda-capture ; doesn't seem needed.
- c-before-after-change-digit-quote
c-after-change-re-mark-raw-strings
c-neutralize-syntax-in-and-mark-CPP
c-restore-<>-properties
c-change-expand-fl-region)
java '(c-depropertize-new-text
+ c-parse-quotes-after-change
c-restore-<>-properties
c-change-expand-fl-region)
awk '(c-depropertize-new-text
@@ -609,6 +611,12 @@ EOL terminated statements."
(c c++ objc) t)
(c-lang-defvar c-has-bitfields (c-lang-const c-has-bitfields))
+(c-lang-defconst c-has-quoted-numbers
+ "Whether the language has numbers quoted like 4'294'967'295."
+ t nil
+ c++ t)
+(c-lang-defvar c-has-quoted-numbers (c-lang-const c-has-quoted-numbers))
+
(c-lang-defconst c-modified-constant
"Regexp that matches a “modified” constant literal such as \"L\\='a\\='\",
a “long character”. In particular, this recognizes forms of constant
@@ -944,6 +952,11 @@ expression, or nil if there aren't any in the language."
'("defined"))
pike '("defined" "efun" "constant"))
+(c-lang-defconst c-cpp-expr-functions-key
+ ;; Matches a function in a cpp expression.
+ t (c-make-keywords-re t (c-lang-const c-cpp-expr-functions)))
+(c-lang-defvar c-cpp-expr-functions-key (c-lang-const c-cpp-expr-functions-key))
+
(c-lang-defconst c-assignment-operators
"List of all assignment operators."
t '("=" "*=" "/=" "%=" "+=" "-=" ">>=" "<<=" "&=" "^=" "|=")
@@ -1177,6 +1190,24 @@ This regexp is assumed to not match any non-operator identifier."
(make-obsolete-variable 'c-opt-op-identitier-prefix 'c-opt-op-identifier-prefix
"CC Mode 5.31.4, 2006-04-14")
+(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefixes
+ ;; A list of strings which can be either overloadable operators or
+ ;; identifier prefixes.
+ t (c--intersection
+ (c-filter-ops (c-lang-const c-identifier-ops)
+ '(prefix)
+ t)
+ (c-lang-const c-overloadable-operators)
+ :test 'string-equal))
+
+(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefix-re
+ ;; A regexp matching strings which can be either overloadable operators
+ ;; or identifier prefixes.
+ t (c-make-keywords-re
+ t (c-lang-const c-ambiguous-overloadable-or-identifier-prefixes)))
+(c-lang-defvar c-ambiguous-overloadable-or-identifier-prefix-re
+ (c-lang-const c-ambiguous-overloadable-or-identifier-prefix-re))
+
(c-lang-defconst c-other-op-syntax-tokens
"List of the tokens made up of characters in the punctuation or
parenthesis syntax classes that have uses other than as expression
@@ -1865,6 +1896,17 @@ the type of that expression."
t (c-make-keywords-re t (c-lang-const c-typeof-kwds)))
(c-lang-defvar c-typeof-key (c-lang-const c-typeof-key))
+(c-lang-defconst c-template-typename-kwds
+ "Keywords which, within a template declaration, can introduce a
+declaration with a type as a default value. This is used only in
+C++ Mode, e.g. \"<typename X = Y>\"."
+ t nil
+ c++ '("class" "typename"))
+
+(c-lang-defconst c-template-typename-key
+ t (c-make-keywords-re t (c-lang-const c-template-typename-kwds)))
+(c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key))
+
(c-lang-defconst c-type-prefix-kwds
"Keywords where the following name - if any - is a type name, and
where the keyword together with the symbol works as a type in
@@ -2258,6 +2300,18 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
c++ '("private" "protected" "public")
objc '("@private" "@protected" "@public"))
+(c-lang-defconst c-protection-key
+ ;; A regexp match an element of `c-protection-kwds' cleanly.
+ t (c-make-keywords-re t (c-lang-const c-protection-kwds)))
+(c-lang-defvar c-protection-key (c-lang-const c-protection-key))
+
+(c-lang-defconst c-post-protection-token
+ "The token which (may) follow a protection keyword,
+e.g. the \":\" in C++ Mode's \"public:\". nil if there is no such token."
+ t nil
+ c++ ":")
+(c-lang-defvar c-post-protection-token (c-lang-const c-post-protection-token))
+
(c-lang-defconst c-block-decls-with-vars
"Keywords introducing declarations that can contain a block which
might be followed by variable declarations, e.g. like \"foo\" in
@@ -2844,14 +2898,7 @@ Note that Java specific rules are currently applied to tell this from
left-assoc
right-assoc
right-assoc-sequence)
- t))
-
- (unambiguous-prefix-ops (c--set-difference nonkeyword-prefix-ops
- in-or-postfix-ops
- :test 'string-equal))
- (ambiguous-prefix-ops (c--intersection nonkeyword-prefix-ops
- in-or-postfix-ops
- :test 'string-equal)))
+ t)))
(concat
"\\("
diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el
index 126b419128c..7dae8297fd3 100644
--- a/lisp/progmodes/cc-menus.el
+++ b/lisp/progmodes/cc-menus.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -117,7 +117,7 @@ A sample value might look like: `\\(_P\\|_PROTO\\)'.")
,(concat
"^\\<" ; line MUST start with word char
;; \n added to prevent overflow in regexp matcher.
- ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-02/msg00021.html
+ ;; https://lists.gnu.org/r/emacs-pretest-bug/2007-02/msg00021.html
"[^()\n]*" ; no parentheses before
"[^" c-alnum "_:<>~]" ; match any non-identifier char
"\\([" c-alpha "_][" c-alnum "_:<>~]*\\)" ; match function name
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index a501ebba256..22dea039cd1 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -225,18 +225,7 @@ control). See \"cc-mode.el\" for more info."
(defun c-make-inherited-keymap ()
(let ((map (make-sparse-keymap)))
- ;; Necessary to use `cc-bytecomp-fboundp' below since this
- ;; function is called from top-level forms that are evaluated
- ;; while cc-bytecomp is active when one does M-x eval-buffer.
- (cond
- ;; Emacs
- ((cc-bytecomp-fboundp 'set-keymap-parent)
- (set-keymap-parent map c-mode-base-map))
- ;; XEmacs
- ((fboundp 'set-keymap-parents)
- (set-keymap-parents map c-mode-base-map))
- ;; incompatible
- (t (error "CC Mode is incompatible with this version of Emacs")))
+ (c-set-keymap-parent map c-mode-base-map)
map))
(defun c-define-abbrev-table (name defs &optional doc)
@@ -276,6 +265,8 @@ control). See \"cc-mode.el\" for more info."
nil
(setq c-mode-base-map (make-sparse-keymap))
+ (when (boundp 'prog-mode-map)
+ (c-set-keymap-parent c-mode-base-map prog-mode-map))
;; Separate M-BS from C-M-h. The former should remain
;; backward-kill-word.
@@ -398,7 +389,8 @@ control). See \"cc-mode.el\" for more info."
;;(define-key c-mode-base-map "\C-c\C-v" 'c-version)
;; (define-key c-mode-base-map "\C-c\C-y" 'c-toggle-hungry-state) Commented out by ACM, 2005-11-22.
(define-key c-mode-base-map "\C-c\C-w" 'c-subword-mode)
- (define-key c-mode-base-map "\C-c\C-k" 'c-toggle-comment-style))
+ (define-key c-mode-base-map "\C-c\C-k" 'c-toggle-comment-style)
+ (define-key c-mode-base-map "\C-c\C-z" 'c-display-defun-name))
;; We don't require the outline package, but we configure it a bit anyway.
(cc-bytecomp-defvar outline-level)
@@ -446,27 +438,36 @@ preferably use the `c-mode-menu' language constant directly."
t))))
(defun c-unfind-coalesced-tokens (beg end)
- ;; unless the non-empty region (beg end) is entirely WS and there's at
- ;; least one character of WS just before or after this region, remove
- ;; the tokens which touch the region from `c-found-types' should they
- ;; be present.
- (or (c-partial-ws-p beg end)
- (save-excursion
- (progn
- (goto-char beg)
- (or (eq beg (point-min))
- (c-skip-ws-backward (1- beg))
- (/= (point) beg)
- (= (c-backward-token-2) 1)
- (c-unfind-type (buffer-substring-no-properties
- (point) beg)))
- (goto-char end)
- (or (eq end (point-max))
- (c-skip-ws-forward (1+ end))
- (/= (point) end)
- (progn (forward-char) (c-end-of-current-token) nil)
- (c-unfind-type (buffer-substring-no-properties
- end (point))))))))
+ ;; If removing the region (beg end) would coalesce an identifier ending at
+ ;; beg with an identifier (fragment) beginning at end, or an identifier
+ ;; fragment ending at beg with an identifier beginning at end, remove the
+ ;; pertinent identifier(s) from `c-found-types'.
+ (save-excursion
+ (when (< beg end)
+ (goto-char beg)
+ (when
+ (and (not (bobp))
+ (progn (c-backward-syntactic-ws) (eq (point) beg))
+ (/= (skip-chars-backward c-symbol-chars (1- (point))) 0)
+ (progn (goto-char beg) (c-forward-syntactic-ws) (<= (point) end))
+ (> (point) beg)
+ (goto-char end)
+ (looking-at c-symbol-char-key))
+ (goto-char beg)
+ (c-simple-skip-symbol-backward)
+ (c-unfind-type (buffer-substring-no-properties (point) beg)))
+
+ (goto-char end)
+ (when
+ (and (not (eobp))
+ (progn (c-forward-syntactic-ws) (eq (point) end))
+ (looking-at c-symbol-char-key)
+ (progn (c-backward-syntactic-ws) (>= (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-maybe-stale-found-type records a place near the region being
;; changed where an element of `found-types' might become stale. It
@@ -927,7 +928,7 @@ Note that the style variables are always made local to the buffer."
(c-clear-char-property-with-value
m-beg (point) 'syntax-table '(1)))))
-(defun c-extend-region-for-CPP (beg end)
+(defun c-extend-region-for-CPP (_beg _end)
;; Adjust `c-new-BEG', `c-new-END' respectively to the beginning and end of
;; any preprocessor construct they may be in.
;;
@@ -951,7 +952,7 @@ Note that the style variables are always made local to the buffer."
(when (> (point) c-new-END)
(setq c-new-END (min (point) (c-determine-+ve-limit 500 c-new-END)))))
-(defun c-depropertize-new-text (beg end old-len)
+(defun c-depropertize-new-text (beg end _old-len)
;; Remove from the new text in (BEG END) any and all text properties which
;; might interfere with CC Mode's proper working.
;;
@@ -970,7 +971,7 @@ Note that the style variables are always made local to the buffer."
(c-clear-char-properties beg end 'c-type)
(c-clear-char-properties beg end 'c-awk-NL-prop))))
-(defun c-extend-font-lock-region-for-macros (begg endd old-len)
+(defun c-extend-font-lock-region-for-macros (_begg endd _old-len)
;; Extend the region (c-new-BEG c-new-END) to cover all (possibly changed)
;; preprocessor macros; The return value has no significance.
;;
@@ -1015,7 +1016,7 @@ Note that the style variables are always made local to the buffer."
t)
(t nil)))))))
-(defun c-neutralize-syntax-in-and-mark-CPP (begg endd old-len)
+(defun c-neutralize-syntax-in-and-mark-CPP (_begg _endd _old-len)
;; (i) "Neutralize" every preprocessor line wholly or partially in the
;; changed region. "Restore" lines which were CPP lines before the change
;; and are no longer so.
@@ -1083,101 +1084,234 @@ Note that the style variables are always made local to the buffer."
(forward-line)) ; no infinite loop with, e.g., "#//"
)))))
-(defun c-before-after-change-digit-quote (beg end &optional old-len)
- ;; This function either removes or applies the punctuation value ('(1)) of
- ;; the `syntax-table' text property on single quote marks which are
- ;; separator characters in long integer literals, e.g. "4'294'967'295". It
- ;; applies to both decimal/octal and hex literals. (FIXME (2016-06-10): it
- ;; should also apply to binary literals.)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Parsing of quotes.
+;;
+;; Valid digit separators in numbers will get the syntax-table "punctuation"
+;; property, '(1), and also the text property `c-digit-separator' value t.
+;;
+;; Invalid other quotes (i.e. those not validly bounding a single character,
+;; or escaped character) will get the syntax-table "punctuation" property,
+;; '(1), too.
+;;
+;; Note that, for convenience, these properties are applied even inside
+;; comments and strings.
+
+(defconst c-maybe-quoted-number-head
+ (concat
+ "\\(0\\("
+ "\\([Xx]\\([0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*'?\\)?\\)"
+ "\\|"
+ "\\([Bb]\\([01]\\('[01]\\|[01]\\)*'?\\)?\\)"
+ "\\|"
+ "\\('[0-7]\\|[0-7]\\)*'?"
+ "\\)"
+ "\\|"
+ "[1-9]\\('[0-9]\\|[0-9]\\)*'?"
+ "\\)")
+ "Regexp matching the head of a numeric literal, including with digit separators.")
+
+(defun c-quoted-number-head-before-point ()
+ ;; Return non-nil when the head of a possibly quoted number is found
+ ;; immediately before point. The value returned in this case is the buffer
+ ;; position of the start of the head. That position is also in
+ ;; (match-beginning 0).
+ (when c-has-quoted-numbers
+ (save-excursion
+ (let ((here (point))
+ found)
+ (skip-chars-backward "0-9a-fA-F'")
+ (if (and (memq (char-before) '(?x ?X))
+ (eq (char-before (1- (point))) ?0))
+ (backward-char 2))
+ (while
+ (and
+ (setq found
+ (search-forward-regexp c-maybe-quoted-number-head here t))
+ (< found here)))
+ (and (eq found here) (match-beginning 0))))))
+
+(defconst c-maybe-quoted-number-tail
+ (concat
+ "\\("
+ "\\([xX']?[0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)"
+ "\\|"
+ "\\([bB']?[01]\\('[01]\\|[01]\\)*\\)"
+ "\\|"
+ "\\('?[0-9]\\('[0-9]\\|[0-9]\\)*\\)"
+ "\\)")
+ "Regexp matching the tail of a numeric literal, including with digit separators.
+Note that this is a strict tail, so won't match, e.g. \"0x....\".")
+
+(defun c-quoted-number-tail-after-point ()
+ ;; Return non-nil when a proper tail of a possibly quoted number is found
+ ;; immediately after point. The value returned in this case is the buffer
+ ;; position of the end of the tail. That position is also in (match-end 0).
+ (when c-has-quoted-numbers
+ (and (looking-at c-maybe-quoted-number-tail)
+ (match-end 0))))
+
+(defconst c-maybe-quoted-number
+ (concat
+ "\\(0\\("
+ "\\([Xx][0-9a-fA-F]\\('[0-9a-fA-F]\\|[0-9a-fA-F]\\)*\\)"
+ "\\|"
+ "\\([Bb][01]\\('[01]\\|[01]\\)*\\)"
+ "\\|"
+ "\\('[0-7]\\|[0-7]\\)*"
+ "\\)"
+ "\\|"
+ "[1-9]\\('[0-9]\\|[0-9]\\)*"
+ "\\)")
+ "Regexp matching a numeric literal, including with digit separators.")
+
+(defun c-quoted-number-straddling-point ()
+ ;; Return non-nil if a definitely quoted number starts before point and ends
+ ;; after point. In this case the number is bounded by (match-beginning 0)
+ ;; and (match-end 0).
+ (when c-has-quoted-numbers
+ (save-excursion
+ (let ((here (point))
+ (bound (progn (skip-chars-forward "0-9a-fA-F'") (point))))
+ (goto-char here)
+ (when (< (skip-chars-backward "0-9a-fA-F'") 0)
+ (if (and (memq (char-before) '(?x ?X))
+ (eq (char-before (1- (point))) ?0))
+ (backward-char 2))
+ (while (and (search-forward-regexp c-maybe-quoted-number bound t)
+ (<= (match-end 0) here)))
+ (and (< (match-beginning 0) here)
+ (> (match-end 0) here)
+ (save-match-data
+ (goto-char (match-beginning 0))
+ (save-excursion (search-forward "'" (match-end 0) t)))))))))
+
+(defun c-parse-quotes-before-change (beg end)
+ ;; This function analyzes 's near the region (c-new-BEG c-new-END), amending
+ ;; those two variables as needed to include 's into that region when they
+ ;; might be syntactically relevant to the change in progress.
;;
- ;; In both uses of the function, the `syntax-table' properties are
- ;; removed/applied only on quote marks which appear to be digit separators.
+ ;; Having amended that region, the function removes pertinent text
+ ;; properties (syntax-table properties with value '(1) and c-digit-separator
+ ;; props with value t) from 's in it. This operation is performed even
+ ;; within strings and comments.
;;
- ;; Point is undefined on both entry and exit to this function, and the
- ;; return value has no significance. The function is called solely as a
- ;; before-change function (see `c-get-state-before-change-functions') and as
- ;; an after change function (see `c-before-font-lock-functions', with the
- ;; parameters BEG, END, and (optionally) OLD-LEN being given the standard
- ;; values for before/after-change functions.
- (c-save-buffer-state ((num-begin c-new-BEG) digit-re try-end)
+ ;; This function is called exclusively as a before-change function via the
+ ;; variable `c-get-state-before-change-functions'.
+ (c-save-buffer-state ()
+ (goto-char c-new-BEG)
+ ;; We need to scan for 's from the BO (logical) line.
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (beginning-of-line 0))
+ (while (and (< (point) c-new-BEG)
+ (search-forward "'" c-new-BEG t))
+ (cond
+ ((c-quoted-number-straddling-point)
+ (goto-char (match-end 0))
+ (if (> (match-end 0) c-new-BEG)
+ (setq c-new-BEG (match-beginning 0))))
+ ((c-quoted-number-head-before-point)
+ (if (>= (point) c-new-BEG)
+ (setq c-new-BEG (match-beginning 0))))
+ ((looking-at "\\([^'\\]\\|\\\\.\\)'")
+ (goto-char (match-end 0))
+ (if (> (match-end 0) c-new-BEG)
+ (setq c-new-BEG (1- (match-beginning 0)))))
+ ((or (>= (point) (1- c-new-BEG))
+ (and (eq (point) (- c-new-BEG 2))
+ (eq (char-after) ?\\)))
+ (setq c-new-BEG (1- (point))))
+ (t nil)))
+
+ (goto-char c-new-END)
+ ;; We will scan from the BO (logical) line.
+ (beginning-of-line)
+ (while (eq (char-before (1- (point))) ?\\)
+ (beginning-of-line 0))
+ (while (and (< (point) c-new-END)
+ (search-forward "'" c-new-END t))
+ (cond
+ ((c-quoted-number-straddling-point)
+ (goto-char (match-end 0))
+ (if (> (match-end 0) c-new-END)
+ (setq c-new-END (match-end 0))))
+ ((c-quoted-number-tail-after-point)
+ (goto-char (match-end 0))
+ (if (> (match-end 0) c-new-END)
+ (setq c-new-END (match-end 0))))
+ ((looking-at "\\([^'\\]\\|\\\\.\\)'")
+ (goto-char (match-end 0))
+ (if (> (match-end 0) c-new-END)
+ (setq c-new-END (match-end 0))))
+ (t nil)))
+ ;; Having reached c-new-END, handle any 's after it whose context may be
+ ;; changed by the current buffer change.
(goto-char c-new-END)
- (when (looking-at "\\(x\\)?[0-9a-fA-F']+")
+ (cond
+ ((c-quoted-number-tail-after-point)
(setq c-new-END (match-end 0)))
- (goto-char c-new-BEG)
- (when (looking-at "\\(x?\\)[0-9a-fA-F']")
- (if (re-search-backward "\\(0x\\)?[0-9a-fA-F]*\\=" nil t)
- (setq c-new-BEG (point))))
+ ((looking-at
+ "\\(\\\\.\\|.\\)?\\('\\([^'\\]\\|\\\\.\\)\\)*'")
+ (setq c-new-END (match-end 0))))
- (while
- (re-search-forward "[0-9a-fA-F]'[0-9a-fA-F]" c-new-END t)
- (setq try-end (1- (point)))
- (re-search-backward "[^0-9a-fA-F']" num-begin t)
- (setq digit-re
- (cond
- ((and (not (bobp)) (eq (char-before) ?0) (memq (char-after) '(?x ?X)))
- "[0-9a-fA-F]")
- ((and (eq (char-after (1+ (point))) ?0)
- (memq (char-after (+ 2 (point))) '(?b ?B)))
- "[01]")
- ((memq (char-after (1+ (point))) '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- "[0-9]")
- (t nil)))
- (when digit-re
- (cond ((eq (char-after) ?x) (forward-char))
- ((looking-at ".?0[Bb]") (goto-char (match-end 0)))
- ((looking-at digit-re))
- (t (forward-char)))
- (when (not (c-in-literal))
- (let ((num-end ; End of valid sequence of digits/quotes.
- (save-excursion
- (re-search-forward
- (concat "\\=\\(" digit-re "+'\\)*" digit-re "+") nil t)
- (point))))
- (setq try-end ; End of sequence of digits/quotes
- (save-excursion
- (re-search-forward
- (concat "\\=\\(" digit-re "\\|'\\)+") nil t)
- (point)))
- (while (re-search-forward
- (concat digit-re "\\('\\)" digit-re) num-end t)
- (if old-len ; i.e. are we in an after-change function?
- (c-put-char-property (match-beginning 1) 'syntax-table '(1))
- (c-clear-char-property (match-beginning 1) 'syntax-table))
- (backward-char)))))
- (goto-char try-end)
- (setq num-begin (point)))))
-
-;; The following doesn't seem needed at the moment (2016-08-15).
-;; (defun c-before-after-change-extend-region-for-lambda-capture
-;; (_beg _end &optional _old-len)
-;; ;; In C++ Mode, extend the region (c-new-BEG c-new-END) to cover any lambda
-;; ;; function capture lists we happen to be inside. This function is expected
-;; ;; to be called both as a before-change and after change function.
-;; ;;
-;; ;; Note that these things _might_ be nested, with a capture list looking
-;; ;; like:
-;; ;;
-;; ;; [ ...., &foo = [..](){...}(..), ... ]
-;; ;;
-;; ;; . What a wonderful language is C++. ;-)
-;; (c-save-buffer-state (paren-state pos)
-;; (goto-char c-new-BEG)
-;; (setq paren-state (c-parse-state))
-;; (while (setq pos (c-pull-open-brace paren-state))
-;; (goto-char pos)
-;; (when (c-looking-at-c++-lambda-capture-list)
-;; (setq c-new-BEG (min c-new-BEG pos))
-;; (if (c-go-list-forward)
-;; (setq c-new-END (max c-new-END (point))))))
-
-;; (goto-char c-new-END)
-;; (setq paren-state (c-parse-state))
-;; (while (setq pos (c-pull-open-brace paren-state))
-;; (goto-char pos)
-;; (when (c-looking-at-c++-lambda-capture-list)
-;; (setq c-new-BEG (min c-new-BEG pos))
-;; (if (c-go-list-forward)
-;; (setq c-new-END (max c-new-END (point))))))))
+ ;; Remove the '(1) syntax-table property from any "'"s within (c-new-BEG
+ ;; c-new-END).
+ (goto-char c-new-BEG)
+ (when (c-search-forward-char-property-with-value-on-char
+ 'syntax-table '(1) ?\' c-new-END)
+ (c-invalidate-state-cache (1- (point)))
+ (c-truncate-semi-nonlit-pos-cache (1- (point)))
+ (c-clear-char-property-with-value-on-char
+ (1- (point)) c-new-END
+ 'syntax-table '(1)
+ ?')
+ ;; Remove the c-digit-separator text property from the same "'"s.
+ (when c-has-quoted-numbers
+ (c-clear-char-property-with-value-on-char
+ (1- (point)) c-new-END
+ 'c-digit-separator t
+ ?')))))
+
+(defun c-parse-quotes-after-change (beg end old-len)
+ ;; This function applies syntax-table properties (value '(1)) and
+ ;; c-digit-separator properties as needed to 's within the range (c-new-BEG
+ ;; c-new-END). This operation is performed even within strings and
+ ;; comments.
+ ;;
+ ;; This function is called exclusively as an after-change function via the
+ ;; variable `c-before-font-lock-functions'.
+ (c-save-buffer-state (num-beg num-end)
+ ;; Apply the needed syntax-table and c-digit-separator text properties to
+ ;; quotes.
+ (save-restriction
+ (goto-char c-new-BEG)
+ (while (and (< (point) c-new-END)
+ (search-forward "'" c-new-END 'limit))
+ (cond ((and (eq (char-before (1- (point))) ?\\)
+ ;; Check we've got an odd number of \s, here.
+ (save-excursion
+ (backward-char)
+ (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '.
+ ((c-quoted-number-straddling-point)
+ (setq num-beg (match-beginning 0)
+ num-end (match-end 0))
+ (c-invalidate-state-cache num-beg)
+ (c-truncate-semi-nonlit-pos-cache num-beg)
+ (c-put-char-properties-on-char num-beg num-end
+ 'syntax-table '(1) ?')
+ (c-put-char-properties-on-char num-beg num-end
+ 'c-digit-separator t ?')
+ (goto-char num-end))
+ ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression.
+ (goto-char (match-end 0)))
+ (t
+ (c-invalidate-state-cache (1- (point)))
+ (c-truncate-semi-nonlit-pos-cache (1- (point)))
+ (c-put-char-property (1- (point)) 'syntax-table '(1))))
+ ;; Prevent the next `c-quoted-number-straddling-point' getting
+ ;; confused by already processed single quotes.
+ (narrow-to-region (point) (point-max))))))
(defun c-before-change (beg end)
;; Function to be put on `before-change-functions'. Primarily, this calls
@@ -1393,14 +1527,17 @@ Note that the style variables are always made local to the buffer."
(> (point) bod-lim)
(progn (c-forward-syntactic-ws)
(setq bo-decl (point))
- ;; Are we looking at a keyword such as "template" or
- ;; "typedef" which can decorate a type, or the type itself?
- (when (or (looking-at c-prefix-spec-kwds-re)
- (c-forward-type t))
- ;; We've found another candidate position.
- (setq new-pos (min new-pos bo-decl))
- (goto-char bo-decl))
- t)
+ (or (not (looking-at c-protection-key))
+ (c-forward-keyword-clause 1)))
+ (progn
+ ;; Are we looking at a keyword such as "template" or
+ ;; "typedef" which can decorate a type, or the type itself?
+ (when (or (looking-at c-prefix-spec-kwds-re)
+ (c-forward-type t))
+ ;; We've found another candidate position.
+ (setq new-pos (min new-pos bo-decl))
+ (goto-char bo-decl))
+ t)
;; Try and go out a level to search again.
(progn
(c-backward-syntactic-ws bod-lim)
@@ -1421,6 +1558,26 @@ Note that the style variables are always made local to the buffer."
(setq new-pos capture-opener))
(and (/= new-pos pos) new-pos)))
+(defun c-fl-decl-end (pos)
+ ;; If POS is inside a declarator, return the end of the token that follows
+ ;; the declarator, otherwise return nil.
+ (goto-char pos)
+ (let ((lit-start (c-literal-start))
+ pos1)
+ (if lit-start (goto-char lit-start))
+ (c-backward-syntactic-ws)
+ (when (setq pos1 (c-on-identifier))
+ (goto-char pos1)
+ (let ((lim (save-excursion
+ (and (c-beginning-of-macro)
+ (progn (c-end-of-macro) (point))))))
+ (when (and (c-forward-declarator lim)
+ (or (not (eq (char-after) ?\())
+ (c-go-list-forward nil lim))
+ (eq (c-forward-token-2 1 nil lim) 0))
+ (c-backward-syntactic-ws)
+ (point))))))
+
(defun c-change-expand-fl-region (_beg _end _old-len)
;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock
;; region. This will usually be the smallest sequence of whole lines
@@ -1434,18 +1591,16 @@ Note that the style variables are always made local to the buffer."
(setq c-new-BEG
(or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG))
c-new-END
- (save-excursion
- (goto-char c-new-END)
- (if (bolp)
- (point)
- (c-point 'bonl c-new-END))))))
+ (or (c-fl-decl-end c-new-END)
+ (c-point 'bonl c-new-END)))))
(defun c-context-expand-fl-region (beg end)
;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a
;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is
;; in. NEW-END is beginning of the line after the one END is in.
- (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
- (c-point 'bonl end)))
+ (c-save-buffer-state ()
+ (cons (or (c-fl-decl-start beg) (c-point 'bol beg))
+ (or (c-fl-decl-end end) (c-point 'bonl (1- end))))))
(defun c-before-context-fl-expand-region (beg end)
;; Expand the region (BEG END) as specified by
@@ -1704,7 +1859,7 @@ Key bindings:
;;;###autoload
(defun c-or-c++-mode ()
- "Analyse buffer and enable either C or C++ mode.
+ "Analyze buffer and enable either C or C++ mode.
Some people and projects use .h extension for C++ header files
which is also the one used for C header files. This makes
diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el
index b3848a74f97..1a8d90bacd3 100644
--- a/lisp/progmodes/cc-styles.el
+++ b/lisp/progmodes/cc-styles.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -47,6 +47,7 @@
;; `c-add-style' often contains references to functions defined there.
;; Silence the compiler.
+(cc-bytecomp-defun c-guess-basic-syntax)
(cc-bytecomp-defvar adaptive-fill-first-line-regexp) ; Emacs
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index ccd4fd29940..c4213797636 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -87,7 +87,7 @@ use c-constant-symbol instead."
:value nil
:tag "Symbol"
:format "%t: %v\n%d"
- :match (lambda (widget value) (symbolp value))
+ :match (lambda (_widget value) (symbolp value))
:value-to-internal
(lambda (widget value)
(let ((s (if (symbolp value)
@@ -98,7 +98,7 @@ use c-constant-symbol instead."
(setq s (concat s (make-string (- l (length s)) ?\ ))))
s))
:value-to-external
- (lambda (widget value)
+ (lambda (_widget value)
(if (stringp value)
(intern (progn
(string-match "\\`[^ ]*" value)
@@ -109,14 +109,14 @@ use c-constant-symbol instead."
"An integer or the value nil."
:value nil
:tag "Optional integer"
- :match (lambda (widget value) (or (integerp value) (null value))))
+ :match (lambda (_widget value) (or (integerp value) (null value))))
(define-widget 'c-symbol-list 'sexp
"A single symbol or a list of symbols."
:tag "Symbols separated by spaces"
:validate 'widget-field-validate
:match
- (lambda (widget value)
+ (lambda (_widget value)
(or (symbolp value)
(catch 'ok
(while (listp value)
@@ -125,7 +125,7 @@ use c-constant-symbol instead."
(setq value (cdr value)))
(null value))))
:value-to-internal
- (lambda (widget value)
+ (lambda (_widget value)
(cond ((null value)
"")
((symbolp value)
@@ -138,7 +138,7 @@ use c-constant-symbol instead."
(t
value)))
:value-to-external
- (lambda (widget value)
+ (lambda (_widget value)
(if (stringp value)
(let (list end)
(while (string-match "\\S +" value end)
@@ -167,7 +167,7 @@ use c-constant-symbol instead."
(defmacro defcustom-c-stylevar (name val doc &rest args)
"Define a style variable NAME with VAL and DOC.
More precisely, convert the given `:type FOO', mined out of ARGS,
-to an aggregate `:type (radio STYLE (PREAMBLE FOO))', append some
+to an aggregate `:type (radio STYLE (PREAMBLE FOO))', append
some boilerplate documentation to DOC, arrange for the fallback
value of NAME to be VAL, and call `custom-declare-variable' to
do the rest of the work.
@@ -1227,8 +1227,8 @@ As described below, each cons cell in this list has the form:
When a line is indented, CC Mode first determines the syntactic
context of it by generating a list of symbols called syntactic
-elements. The global variable `c-syntactic-context' is bound to the
-that list. Each element in the list is in turn a list where the first
+elements. The global variable `c-syntactic-context' is bound to that
+list. Each element in the list is in turn a list where the first
element is a syntactic symbol which tells what kind of construct the
indentation point is located within. More elements in the syntactic
element lists are optional. If there is one more and it isn't nil,
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 5bc7b660633..10881cda527 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
index cafd5acb37a..883515e8fc2 100644
--- a/lisp/progmodes/cmacexp.el
+++ b/lisp/progmodes/cmacexp.el
@@ -27,7 +27,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 31ec5a67d03..4cce47e5d8c 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -127,7 +127,21 @@ and a string describing how the process finished.")
(defvar compilation-arguments nil
"Arguments that were given to `compilation-start'.")
-(defvar compilation-num-errors-found)
+(defvar compilation-num-errors-found 0)
+(defvar compilation-num-warnings-found 0)
+(defvar compilation-num-infos-found 0)
+
+(defconst compilation-mode-line-errors
+ '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
+ face compilation-error
+ help-echo "Number of errors so far")
+ " " (:propertize (:eval (int-to-string compilation-num-warnings-found))
+ face compilation-warning
+ help-echo "Number of warnings so far")
+ " " (:propertize (:eval (int-to-string compilation-num-infos-found))
+ face compilation-info
+ help-echo "Number of informational messages so far")
+ "]"))
;; If you make any changes to `compilation-error-regexp-alist-alist',
;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el.
@@ -886,10 +900,20 @@ from a different message."
:group 'compilation
:version "22.1")
+(defun compilation-type (type)
+ (or (and (car type) (match-end (car type)) 1)
+ (and (cdr type) (match-end (cdr type)) 0)
+ 2))
+
(defun compilation-face (type)
- (or (and (car type) (match-end (car type)) compilation-warning-face)
- (and (cdr type) (match-end (cdr type)) compilation-info-face)
- compilation-error-face))
+ (let ((typ (compilation-type type)))
+ (cond
+ ((eq typ 1)
+ compilation-warning-face)
+ ((eq typ 0)
+ compilation-info-face)
+ ((eq typ 2)
+ compilation-error-face))))
;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil)
@@ -1334,6 +1358,14 @@ FMTS is a list of format specs for transforming the file name.
(compilation-parse-errors start end)))
+(defun compilation--note-type (type)
+ "Note that a new message with severity TYPE was seen.
+This updates the appropriate variable used by the mode-line."
+ (cl-case type
+ (0 (cl-incf compilation-num-infos-found))
+ (1 (cl-incf compilation-num-warnings-found))
+ (2 (cl-incf compilation-num-errors-found))))
+
(defun compilation-parse-errors (start end &rest rules)
"Parse errors between START and END.
The errors recognized are the ones specified in RULES which default
@@ -1397,14 +1429,17 @@ to `compilation-error-regexp-alist' if RULES is nil."
file line end-line col end-col (or type 2) fmt))
(when (integerp file)
+ (setq type (if (consp type)
+ (compilation-type type)
+ (or type 2)))
+ (compilation--note-type type)
+
(compilation--put-prop
file 'font-lock-face
- (if (consp type)
- (compilation-face type)
- (symbol-value (aref [compilation-info-face
- compilation-warning-face
- compilation-error-face]
- (or type 2))))))
+ (symbol-value (aref [compilation-info-face
+ compilation-warning-face
+ compilation-error-face]
+ type))))
(compilation--put-prop
line 'font-lock-face compilation-line-face)
@@ -1705,7 +1740,7 @@ Returns the compilation buffer created."
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; Pop up the compilation buffer.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01638.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-11/msg01638.html
(setq outwin (display-buffer outbuf '(nil (allow-no-window . t))))
(with-current-buffer outbuf
(let ((process-environment
@@ -1768,7 +1803,8 @@ Returns the compilation buffer created."
outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process
- '(:propertize ":%s" face compilation-mode-line-run))
+ '((:propertize ":%s" face compilation-mode-line-run)
+ compilation-mode-line-errors))
;; Set the process as killable without query by default.
;; This allows us to start a new compilation without
@@ -1797,7 +1833,8 @@ Returns the compilation buffer created."
(message "Executing `%s'..." command)
;; Fake mode line display as if `start-process' were run.
(setq mode-line-process
- '(:propertize ":run" face compilation-mode-line-run))
+ '((:propertize ":run" face compilation-mode-line-run)
+ compilation-mode-line-errors))
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(save-excursion
@@ -2106,6 +2143,9 @@ Optional argument MINOR indicates this is called from
(make-local-variable 'compilation-messages-start)
(make-local-variable 'compilation-error-screen-columns)
(make-local-variable 'overlay-arrow-position)
+ (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 next-error-overlay-arrow-position nil)
(add-hook 'kill-buffer-hook
@@ -2195,16 +2235,18 @@ commands of Compilation major mode are available. See
(add-text-properties omax (point)
(append '(compilation-handle-exit t) nil))
(setq mode-line-process
- (let ((out-string (format ":%s [%s]" process-status (cdr status)))
- (msg (format "%s %s" mode-name
- (replace-regexp-in-string "\n?$" ""
- (car status)))))
- (message "%s" msg)
- (propertize out-string
- 'help-echo msg
- 'face (if (> exit-status 0)
- 'compilation-mode-line-fail
- 'compilation-mode-line-exit))))
+ (list
+ (let ((out-string (format ":%s [%s]" process-status (cdr status)))
+ (msg (format "%s %s" mode-name
+ (replace-regexp-in-string "\n?$" ""
+ (car status)))))
+ (message "%s" msg)
+ (propertize out-string
+ 'help-echo msg
+ 'face (if (> exit-status 0)
+ 'compilation-mode-line-fail
+ 'compilation-mode-line-exit)))
+ compilation-mode-line-errors))
;; Force mode line redisplay soon.
(force-mode-line-update)
(if (and opoint (< opoint omax))
@@ -2286,7 +2328,7 @@ and runs `compilation-filter-hook'."
(while (,< n 0)
(setq opt pt)
(or (setq pt (,property-change pt 'compilation-message))
- ;; Handle the case where where the first error message is
+ ;; Handle the case where the first error message is
;; at the start of the buffer, and n < 0.
(if (or (eq (get-text-property ,limit 'compilation-message)
(get-text-property opt 'compilation-message))
@@ -2813,7 +2855,7 @@ TRUE-DIRNAME is the `file-truename' of DIRNAME, if given."
;; The gethash used to not use spec-directory, but
;; this leads to errors when files in different
;; directories have the same name:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00463.html
+ ;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00463.html
(or (gethash (cons filename spec-directory) compilation-locs)
(puthash (cons filename spec-directory)
(compilation--make-file-struct
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index c0f1aaf39d4..e6ab8c4ea60 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org
@@ -480,7 +480,7 @@ Font for POD headers."
(defcustom cperl-highlight-variables-indiscriminately nil
"Non-nil means perform additional highlighting on variables.
Currently only changes how scalar variables are highlighted.
-Note that that variable is only read at initialization time for
+Note that the variable is only read at initialization time for
the variable `cperl-font-lock-keywords-2', so changing it after you've
entered CPerl mode the first time will have no effect."
:type 'boolean
@@ -701,24 +701,7 @@ This way enabling/disabling of menu items is more correct."
;;; Short extra-docs.
(defvar cperl-tips 'please-ignore-this-line
- "Get maybe newer version of this package from
- http://ilyaz.org/software/emacs
-Subdirectory `cperl-mode' may contain yet newer development releases and/or
-patches to related files.
-
-For best results apply to an older Emacs the patches from
- ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches
-\(this upgrades syntax-parsing abilities of Emacsen v19.34 and
-v20.2 up to the level of Emacs v20.3 - a must for a good Perl
-mode.) As of beginning of 2003, XEmacs may provide a similar ability.
-
-Get support packages choose-color.el (or font-lock-extra.el before
-19.30), imenu-go.el from the same place. \(Look for other files there
-too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and
-later you should use choose-color.el *instead* of font-lock-extra.el
-\(and you will not get smart highlighting in C :-().
-
-Note that to enable Compile choices in the menu you need to install
+ "Note that to enable Compile choices in the menu you need to install
mode-compile.el.
If your Emacs does not default to `cperl-mode' on Perl files, and you
@@ -1913,7 +1896,9 @@ or as help on variables `cperl-tips', `cperl-problems',
(if cperl-pod-here-scan
(or cperl-syntaxify-by-font-lock
(progn (or cperl-faces-init (cperl-init-faces-weak))
- (cperl-find-pods-heres)))))
+ (cperl-find-pods-heres))))
+ ;; Setup Flymake
+ (add-hook 'flymake-diagnostic-functions 'perl-flymake nil t))
;; Fix for perldb - make default reasonable
(defun cperl-db ()
@@ -2331,7 +2316,7 @@ to nil."
nil t)))) ; Only one
(progn
(forward-word-strictly 1)
- (setq name (file-name-base)
+ (setq name (file-name-base (buffer-file-name))
p (point))
(insert " NAME\n\n" name
" - \n\n=head1 SYNOPSIS\n\n\n\n"
@@ -3734,7 +3719,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
"\\(\\`\n?\\|^\n\\)=" ; POD
"\\|"
;; One extra () before this:
- "<<" ; HERE-DOC
+ "<<~?" ; HERE-DOC
"\\(" ; 1 + 1
;; First variant "BLAH" or just ``.
"[ \t]*" ; Yes, whitespace is allowed!
@@ -4000,7 +3985,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
(setq b (point))
;; We do not search to max, since we may be called from
;; some hook of fontification, and max is random
- (or (and (re-search-forward (concat "^" qtag "$")
+ (or (and (re-search-forward (concat "^[ \t]*" qtag "$")
stop-point 'toend)
;;;(eq (following-char) ?\n) ; XXXX WHY???
)
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index e35a76e38cd..f49c8e934a5 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -568,6 +568,14 @@ You can also use the keyboard accelerators indicated like this: [K]ey."
(set-window-start nil start)
(goto-char pos)))
+(defun cpp-locate-user-emacs-file (file)
+ (locate-user-emacs-file
+ ;; Remove initial '.' from file.
+ (if (eq (aref file 0) ?.)
+ (substring file 1)
+ file)
+ file))
+
(defun cpp-edit-load ()
"Load cpp configuration."
(interactive)
@@ -576,8 +584,8 @@ You can also use the keyboard accelerators indicated like this: [K]ey."
nil)
((file-readable-p cpp-config-file)
(load-file cpp-config-file))
- ((file-readable-p (concat "~/" cpp-config-file))
- (load-file cpp-config-file)))
+ ((file-readable-p (cpp-locate-user-emacs-file cpp-config-file))
+ (load-file (cpp-locate-user-emacs-file cpp-config-file))))
(if (derived-mode-p 'cpp-edit-mode)
(cpp-edit-reset)))
@@ -586,7 +594,10 @@ You can also use the keyboard accelerators indicated like this: [K]ey."
(interactive)
(require 'pp)
(with-current-buffer cpp-edit-buffer
- (let ((buffer (find-file-noselect cpp-config-file)))
+ (let* ((config-file (if (file-writable-p cpp-config-file)
+ cpp-config-file
+ (cpp-locate-user-emacs-file cpp-config-file)))
+ (buffer (find-file-noselect config-file)))
(set-buffer buffer)
(erase-buffer)
(pp (list 'setq 'cpp-known-face
@@ -601,7 +612,7 @@ You can also use the keyboard accelerators indicated like this: [K]ey."
(list 'quote cpp-unknown-writable)) buffer)
(pp (list 'setq 'cpp-edit-list
(list 'quote cpp-edit-list)) buffer)
- (write-file cpp-config-file))))
+ (write-file config-file))))
(defun cpp-edit-home ()
"Switch back to original buffer."
diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el
index 1c6905a38fe..4b28d5a82aa 100644
--- a/lisp/progmodes/cwarn.el
+++ b/lisp/progmodes/cwarn.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index eb0850e4ec2..6681af55858 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el
index a3780eb70f4..937f9881ce9 100644
--- a/lisp/progmodes/ebnf-abn.el
+++ b/lisp/progmodes/ebnf-abn.el
@@ -2,8 +2,8 @@
;; Copyright (C) 2001-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.2
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
index a257d391bf5..9cad4e5f2b6 100644
--- a/lisp/progmodes/ebnf-bnf.el
+++ b/lisp/progmodes/ebnf-bnf.el
@@ -2,8 +2,8 @@
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.10
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el
index 2bea9547a1f..ee9f7b14e9b 100644
--- a/lisp/progmodes/ebnf-dtd.el
+++ b/lisp/progmodes/ebnf-dtd.el
@@ -2,8 +2,8 @@
;; Copyright (C) 2001-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.1
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el
index 84c67df63fa..6d1e761a1a5 100644
--- a/lisp/progmodes/ebnf-ebx.el
+++ b/lisp/progmodes/ebnf-ebx.el
@@ -2,8 +2,8 @@
;; Copyright (C) 2001-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.2
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
index 8847c401508..61a3479a5c3 100644
--- a/lisp/progmodes/ebnf-iso.el
+++ b/lisp/progmodes/ebnf-iso.el
@@ -2,8 +2,8 @@
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.9
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
index 31dfd95e941..f77959e4ca2 100644
--- a/lisp/progmodes/ebnf-otz.el
+++ b/lisp/progmodes/ebnf-otz.el
@@ -2,8 +2,8 @@
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.0
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
index 3aa02a8e0fa..d8916ee4c0d 100644
--- a/lisp/progmodes/ebnf-yac.el
+++ b/lisp/progmodes/ebnf-yac.el
@@ -2,8 +2,8 @@
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Old-Version: 1.4
;; Package: ebnf2ps
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index a8229df4aeb..e40104353ac 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -1,9 +1,9 @@
-;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
+;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -*- lexical-binding:t -*-
;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, ebnf, PostScript
;; Version: 4.4
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(defconst ebnf-version "4.4"
"ebnf2ps.el, v 4.4 <2007/02/12 vinicius>
@@ -30,8 +30,7 @@ Vinicius's last change version. When reporting bugs, please also
report the version of Emacs, if any, that ebnf2ps was running with.
Please send all bug fixes and enhancements to
- Vinicius Jose Latorre <viniciusjl@ig.com.br>.
-")
+ Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.")
;;; Commentary:
@@ -1136,7 +1135,7 @@ Please send all bug fixes and enhancements to
;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale',
;; `ebnf-production-name-p', `ebnf-stop-on-error',
-;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
+;; `ebnf-file-suffix-regexp' and `ebnf-special-show-delimiter' variables.
;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
;; commands.
;; - some docs fix.
@@ -1154,6 +1153,7 @@ Please send all bug fixes and enhancements to
(require 'ps-print)
+(eval-when-compile (require 'cl-lib))
(and (string< ps-print-version "5.2.3")
(error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
@@ -2047,8 +2047,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)."
(defcustom ebnf-default-width 0.6
- "Specify additional border width over default terminal, non-terminal or
-special."
+ "Additional border width over default terminal, non-terminal or special."
:type 'number
:version "20"
:group 'ebnf2ps)
@@ -2252,7 +2251,7 @@ See also `ebnf-print-buffer'."
(defun ebnf-print-buffer (&optional filename)
"Generate and print a PostScript syntactic chart image of the buffer.
-When called with a numeric prefix argument (C-u), prompts the user for
+When called with a numeric prefix argument (\\[universal-argument]), prompts the user for
the name of a file to save the PostScript image in, instead of sending
it to the printer.
@@ -2383,6 +2382,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing
(ebnf-log-header "(ebnf-eps-buffer)")
(ebnf-eps-region (point-min) (point-max)))
+(defvar ebnf-eps-executing)
;;;###autoload
(defun ebnf-eps-region (from to)
@@ -2411,7 +2411,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing
;;;###autoload
-(defalias 'ebnf-despool 'ps-despool)
+(defalias 'ebnf-despool #'ps-despool)
;;;###autoload
@@ -2611,7 +2611,8 @@ See also `ebnf-syntax-buffer'."
(defvar ebnf-stack-style nil
- "Used in functions `ebnf-reset-style', `ebnf-push-style' and
+ "Stack of styles.
+Used in functions `ebnf-reset-style', `ebnf-push-style' and
`ebnf-pop-style'.")
@@ -3999,7 +4000,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
% === end EBNF engine
"
- "EBNF PostScript prologue")
+ "EBNF PostScript prologue.")
(defconst ebnf-eps-prologue
@@ -4276,7 +4277,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
}bind def
"
- "EBNF EPS prologue")
+ "EBNF EPS prologue.")
(defconst ebnf-eps-begin
@@ -4292,14 +4293,14 @@ end
%%EndProlog
"
- "EBNF EPS begin")
+ "EBNF EPS begin.")
(defconst ebnf-eps-end
"#ebnf2ps#end
%%EOF
"
- "EBNF EPS end")
+ "EBNF EPS end.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4329,14 +4330,16 @@ end
;; hacked fom `ps-output-string-prim' (ps-print.el)
(defun ebnf-eps-string (string)
- (let* ((str (string-as-unibyte string))
+ (let* ((str string)
(len (length str))
(index 0)
(new "(") ; insert start-string delimiter
start special)
;; Find and quote special characters as necessary for PS
- ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
- (while (setq start (string-match "[^]-~ -'*-[]" str index))
+ ;; This skips everything except control chars, non-ASCII chars,
+ ;; (, ), \, and DEL.
+ (while (setq start (string-match "[[:cntrl:][:nonascii:]\177()\\]"
+ str index))
(setq special (aref str start)
new (concat new
(substring str index start)
@@ -4536,26 +4539,25 @@ end
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PostScript generation
+(defvar ebnf-tree)
-(defun ebnf-generate-eps (ebnf-tree)
- (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
+(defun ebnf-generate-eps (tree)
+ (let* ((ebnf-tree tree)
+ (ps-color-p (and ebnf-color-p (ps-color-device)))
(ps-print-color-scale (if ps-color-p
(float (car (ps-color-values "white")))
1.0))
(ebnf-total (length ebnf-tree))
(ebnf-nprod 0)
- (old-ps-output (symbol-function 'ps-output))
- (old-ps-output-string (symbol-function 'ps-output-string))
(eps-buffer (get-buffer-create ebnf-eps-buffer-name))
- ebnf-debug-ps error-msg horizontal
+ ebnf-debug-ps horizontal
prod prod-name prod-width prod-height prod-list file-list)
- ;; redefines `ps-output' and `ps-output-string'
- (defalias 'ps-output 'ebnf-eps-output)
- (defalias 'ps-output-string 'ps-output-string-prim)
;; generate EPS file
- (save-excursion
- (condition-case data
- (progn
+ (unwind-protect
+ ;; redefines `ps-output' and `ps-output-string'
+ (cl-letf (((symbol-function 'ps-output) #'ebnf-eps-output)
+ ((symbol-function 'ps-output-string) #'ps-output-string-prim))
+ (save-excursion
(while ebnf-tree
(setq prod (car ebnf-tree)
prod-name (ebnf-node-name prod)
@@ -4573,8 +4575,9 @@ end
(if (setq prod-list (cdr (assoc prod-name
ebnf-eps-production-list)))
;; insert EPS buffer in all buffer associated with production
- (ebnf-eps-production-list prod-list 'file-list horizontal
- prod-width prod-height eps-buffer)
+ (ebnf-eps-production-list
+ prod-list (gv-ref file-list) horizontal
+ prod-width prod-height eps-buffer)
;; write EPS file for production
(ebnf-eps-finish-and-write eps-buffer
(ebnf-eps-filename prod-name)))
@@ -4584,17 +4587,10 @@ end
(setq ebnf-tree (cdr ebnf-tree)))
;; write and kill temporary buffers
(ebnf-eps-write-kill-temp file-list t)
- (setq file-list nil))
- ;; handler
- ((quit error)
- (setq error-msg (error-message-string data)))))
- ;; restore `ps-output' and `ps-output-string'
- (defalias 'ps-output old-ps-output)
- (defalias 'ps-output-string old-ps-output-string)
- ;; kill temporary buffers
- (kill-buffer eps-buffer)
- (ebnf-eps-write-kill-temp file-list nil)
- (and error-msg (error error-msg))
+ (setq file-list nil)))
+ ;; kill temporary buffers
+ (kill-buffer eps-buffer)
+ (ebnf-eps-write-kill-temp file-list nil))
(message " ")))
@@ -4610,10 +4606,10 @@ end
;; insert EPS buffer in all buffer associated with production
-(defun ebnf-eps-production-list (prod-list file-list-sym horizontal
+(defun ebnf-eps-production-list (prod-list file-list-ref horizontal
prod-width prod-height eps-buffer)
(while prod-list
- (add-to-list file-list-sym (car prod-list))
+ (cl-pushnew (car prod-list) (gv-deref file-list-ref) :test #'equal)
(with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*"))
(goto-char (point-max))
(cond
@@ -4647,8 +4643,9 @@ end
(setq prod-list (cdr prod-list))))
-(defun ebnf-generate (ebnf-tree)
- (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
+(defun ebnf-generate (tree)
+ (let* ((ebnf-tree tree)
+ (ps-color-p (and ebnf-color-p (ps-color-device)))
(ps-print-color-scale (if ps-color-p
(float (car (ps-color-values "white")))
1.0))
@@ -4658,14 +4655,13 @@ end
ps-print-begin-page-hook
ps-print-begin-column-hook)
(ps-generate (current-buffer) (point-min) (point-max)
- 'ebnf-generate-postscript)))
+ #'ebnf-generate-postscript)))
-(defvar ebnf-tree nil)
(defvar ebnf-direction "R")
-(defun ebnf-generate-postscript (from to)
+(defun ebnf-generate-postscript (_from _to)
(ebnf-begin-file)
(if ebnf-horizontal-max-height
(ebnf-generate-with-max-height)
@@ -5314,9 +5310,9 @@ killed after process termination."
"\n%%DocumentNeededResources: font "
(or ebnf-fonts-required
(setq ebnf-fonts-required
- (mapconcat 'identity
+ (mapconcat #'identity
(ps-remove-duplicates
- (mapcar 'ebnf-font-name-select
+ (mapcar #'ebnf-font-name-select
(list ebnf-production-font
ebnf-terminal-font
ebnf-non-terminal-font
@@ -5545,7 +5541,7 @@ killed after process termination."
(ebnf-log "(ebnf-dimensions tree)")
(let ((ebnf-total (length tree))
(ebnf-nprod 0))
- (mapc 'ebnf-production-dimension tree))
+ (mapc #'ebnf-production-dimension tree))
tree)
@@ -5925,7 +5921,7 @@ killed after process termination."
))))
-(defun ebnf-justify (node seq seq-width width last-p)
+(defun ebnf-justify (_node seq seq-width width last-p)
(let ((term (car (if last-p (last seq) seq))))
(cond
;; adjust empty term
diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el
index 0b5d7aa11bf..6ea939de661 100644
--- a/lisp/progmodes/ebrowse.el
+++ b/lisp/progmodes/ebrowse.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -3034,7 +3034,7 @@ the first derived class."
:help "Show the base class of this class"
:active t]
["Down" ebrowse-switch-member-buffer-to-derived-class
- :help "Show a derived class class of this class"
+ :help "Show a derived class of this class"
:active t]
["Next Sibling" ebrowse-switch-member-buffer-to-next-sibling-class
:help "Show the next sibling class"
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index b3f452ca5b9..3b24a23b893 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -231,16 +231,21 @@ Blank lines separate paragraphs. Semicolons start comments.
(defvar project-vc-external-roots-function)
(lisp-mode-variables nil nil 'elisp)
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
- (setq-local electric-pair-text-pairs
- (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs))
- (setq-local electric-quote-string t)
+ (unless noninteractive
+ (require 'elec-pair)
+ (defvar electric-pair-text-pairs)
+ (setq-local electric-pair-text-pairs
+ (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs))
+ (setq-local electric-quote-string t))
(setq imenu-case-fold-search nil)
(add-function :before-until (local 'eldoc-documentation-function)
#'elisp-eldoc-documentation-function)
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
(add-hook 'completion-at-point-functions
- #'elisp-completion-at-point nil 'local))
+ #'elisp-completion-at-point nil 'local)
+ (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
+ (add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t))
;; Font-locking support.
@@ -807,7 +812,7 @@ non-nil result supercedes the xrefs produced by
(apply #'nconc
(let (lst)
(dolist (sym (apropos-internal regexp))
- (push (elisp--xref-find-definitions sym) lst))
+ (push (elisp--xref-find-definitions sym) lst))
(nreverse lst))))
(defvar elisp--xref-identifier-completion-table
@@ -894,10 +899,11 @@ Semicolons start comments.
;;; Emacs Lisp Byte-Code mode
(eval-and-compile
- (defconst emacs-list-byte-code-comment-re
+ (defconst emacs-lisp-byte-code-comment-re
(concat "\\(#\\)@\\([0-9]+\\) "
;; Make sure it's a docstring and not a lazy-loaded byte-code.
- "\\(?:[^(]\\|([^\"]\\)")))
+ "\\(?:[^(]\\|([^\"]\\)")
+ "Regular expression matching a dynamic doc string comment."))
(defun elisp--byte-code-comment (end &optional _point)
"Try to syntactically mark the #@NNN ....^_ docstrings in byte-code files."
@@ -906,7 +912,7 @@ Semicolons start comments.
(eq (char-after (nth 8 ppss)) ?#))
(let* ((n (save-excursion
(goto-char (nth 8 ppss))
- (when (looking-at emacs-list-byte-code-comment-re)
+ (when (looking-at emacs-lisp-byte-code-comment-re)
(string-to-number (match-string 2)))))
;; `maxdiff' tries to make sure the loop below terminates.
(maxdiff n))
@@ -932,7 +938,7 @@ Semicolons start comments.
(elisp--byte-code-comment end (point))
(funcall
(syntax-propertize-rules
- (emacs-list-byte-code-comment-re
+ (emacs-lisp-byte-code-comment-re
(1 (prog1 "< b" (elisp--byte-code-comment end (point))))))
start end))
@@ -1106,7 +1112,7 @@ If CHAR is not a character, return nil."
;; interactive call would use it.
;; FIXME: Is it really the right place for this?
(when (eq (car-safe expr) 'interactive)
- (setq expr
+ (setq expr
`(call-interactively
(lambda (&rest args) ,expr args))))
expr)))))
@@ -1171,7 +1177,7 @@ POS specifies the starting position where EXP was found and defaults to point."
(and (not (special-variable-p var))
(save-excursion
(zerop (car (syntax-ppss (match-beginning 0)))))
- (push var vars))))
+ (push var vars))))
`(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp)))))
(defun eval-last-sexp (eval-last-sexp-arg-internal)
@@ -1376,7 +1382,7 @@ or elsewhere, return a 1-line docstring."
(t (help-function-arglist sym)))))
;; Stringify, and store before highlighting, downcasing, etc.
(elisp--last-data-store sym (elisp-function-argstring args)
- 'function))))))
+ 'function))))))
;; Highlight, truncate.
(if argstring
(elisp--highlight-function-argument
@@ -1394,13 +1400,14 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
;; FIXME: This should probably work on the list representation of `args'
;; rather than its string representation.
;; FIXME: This function is much too long, we need to split it up!
- (let ((start nil)
- (end 0)
- (argument-face 'eldoc-highlight-function-argument)
- (args-lst (mapcar (lambda (x)
- (replace-regexp-in-string
- "\\`[(]\\|[)]\\'" "" x))
- (split-string args))))
+ (let* ((start nil)
+ (end 0)
+ (argument-face 'eldoc-highlight-function-argument)
+ (args-lst (mapcar (lambda (x)
+ (replace-regexp-in-string
+ "\\`[(]\\|[)]\\'" "" x))
+ (split-string args)))
+ (args-lst-ak (cdr (member "&key" args-lst))))
;; Find the current argument in the argument string. We need to
;; handle `&rest' and informal `...' properly.
;;
@@ -1412,12 +1419,12 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
;; When `&key' is used finding position based on `index'
;; would be wrong, so find the arg at point and determine
;; position in ARGS based on this current arg.
- (when (string-match "&key" args)
+ (when (and args-lst-ak
+ (>= index (- (length args-lst) (length args-lst-ak))))
(let* (case-fold-search
key-have-value
(sym-name (symbol-name sym))
- (cur-w (current-word))
- (args-lst-ak (cdr (member "&key" args-lst)))
+ (cur-w (current-word t))
(limit (save-excursion
(when (re-search-backward sym-name nil t)
(match-end 0))))
@@ -1425,7 +1432,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
(substring cur-w 1)
(save-excursion
(let (split)
- (when (re-search-backward ":\\([^()\n]*\\)" limit t)
+ (when (re-search-backward ":\\([^ ()\n]*\\)" limit t)
(setq split (split-string (match-string 1) " " t))
(prog1 (car split)
(when (cdr split)
@@ -1437,7 +1444,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
args-lst-ak
(not (member (upcase cur-a) args-lst-ak))
(upcase (car (last args-lst-ak))))))
- (unless (string= cur-w sym-name)
+ (unless (or (null cur-w) (string= cur-w sym-name))
;; The last keyword have already a value
;; i.e :foo a b and cursor is at b.
;; If signature have also `&rest'
@@ -1584,5 +1591,157 @@ ARGLIST is either a string, or a list of strings or symbols."
(replace-match "(" t t str)
str)))
+;;; Flymake support
+
+;; Don't require checkdoc, but forward declare these checkdoc special
+;; variables. Autoloading them on `checkdoc-current-buffer' is too
+;; late, they won't be bound dynamically.
+(defvar checkdoc-create-error-function)
+(defvar checkdoc-autofix-flag)
+(defvar checkdoc-generate-compile-warnings-flag)
+(defvar checkdoc-diagnostic-buffer)
+
+;;;###autoload
+(defun elisp-flymake-checkdoc (report-fn &rest _args)
+ "A Flymake backend for `checkdoc'.
+Calls REPORT-FN directly."
+ (let (collected)
+ (let* ((checkdoc-create-error-function
+ (lambda (text start end &optional unfixable)
+ (push (list text start end unfixable) collected)
+ nil))
+ (checkdoc-autofix-flag nil)
+ (checkdoc-generate-compile-warnings-flag nil)
+ (checkdoc-diagnostic-buffer
+ (generate-new-buffer " *checkdoc-temp*")))
+ (unwind-protect
+ (save-excursion
+ ;; checkdoc-current-buffer can error if there are
+ ;; unbalanced parens, for example, but this shouldn't
+ ;; disable the backend (bug#29176).
+ (ignore-errors
+ (checkdoc-current-buffer t)))
+ (kill-buffer checkdoc-diagnostic-buffer)))
+ (funcall report-fn
+ (cl-loop for (text start end _unfixable) in
+ collected
+ collect
+ (flymake-make-diagnostic
+ (current-buffer)
+ start end :note text)))
+ collected))
+
+(defun elisp-flymake--byte-compile-done (report-fn
+ source-buffer
+ output-buffer)
+ (with-current-buffer
+ source-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (funcall
+ report-fn
+ (cl-loop with data =
+ (with-current-buffer output-buffer
+ (goto-char (point-min))
+ (search-forward ":elisp-flymake-output-start")
+ (read (point-marker)))
+ for (string pos _fill level) in data
+ do (goto-char pos)
+ for beg = (if (< (point) (point-max))
+ (point)
+ (line-beginning-position))
+ for end = (min
+ (line-end-position)
+ (or (cdr
+ (bounds-of-thing-at-point 'sexp))
+ (point-max)))
+ collect (flymake-make-diagnostic
+ (current-buffer)
+ (if (= beg end) (1- beg) beg)
+ end
+ level
+ string)))))))
+
+(defvar-local elisp-flymake--byte-compile-process nil
+ "Buffer-local process started for byte-compiling the buffer.")
+
+;;;###autoload
+(defun elisp-flymake-byte-compile (report-fn &rest _args)
+ "A Flymake backend for elisp byte compilation.
+Spawn an Emacs process that byte-compiles a file representing the
+current buffer state and calls REPORT-FN when done."
+ (when elisp-flymake--byte-compile-process
+ (when (process-live-p elisp-flymake--byte-compile-process)
+ (kill-process elisp-flymake--byte-compile-process)))
+ (let ((temp-file (make-temp-file "elisp-flymake-byte-compile"))
+ (source-buffer (current-buffer)))
+ (save-restriction
+ (widen)
+ (write-region (point-min) (point-max) temp-file nil 'nomessage))
+ (let* ((output-buffer (generate-new-buffer " *elisp-flymake-byte-compile*")))
+ (setq
+ elisp-flymake--byte-compile-process
+ (make-process
+ :name "elisp-flymake-byte-compile"
+ :buffer output-buffer
+ :command (list (expand-file-name invocation-name invocation-directory)
+ "-Q"
+ "--batch"
+ ;; "--eval" "(setq load-prefer-newer t)" ; for testing
+ "-L" default-directory
+ "-f" "elisp-flymake--batch-compile-for-flymake"
+ temp-file)
+ :connection-type 'pipe
+ :sentinel
+ (lambda (proc _event)
+ (when (eq (process-status proc) 'exit)
+ (unwind-protect
+ (cond
+ ((not (eq proc (with-current-buffer source-buffer
+ elisp-flymake--byte-compile-process)))
+ (flymake-log :warning "byte-compile process %s obsolete" proc))
+ ((zerop (process-exit-status proc))
+ (elisp-flymake--byte-compile-done report-fn
+ source-buffer
+ output-buffer))
+ (t
+ (funcall report-fn
+ :panic
+ :explanation
+ (format "byte-compile process %s died" proc))))
+ (ignore-errors (delete-file temp-file))
+ (kill-buffer output-buffer))))))
+ :stderr null-device
+ :noquery t)))
+
+(defun elisp-flymake--batch-compile-for-flymake (&optional file)
+ "Helper for `elisp-flymake-byte-compile'.
+Runs in a batch-mode Emacs. Interactively use variable
+`buffer-file-name' for FILE."
+ (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)))))
+ (collected)
+ (byte-compile-log-warning-function
+ (lambda (string &optional position fill level)
+ (push (list string position fill level)
+ collected)
+ t)))
+ (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)
+ (pp collected)))
+
(provide 'elisp-mode)
;;; elisp-mode.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 8d635cb6d4d..9b21ee67ed1 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -274,12 +274,9 @@ buffer-local and set them to nil."
(run-hook-with-args-until-success 'tags-table-format-functions))
;;;###autoload
-(defun tags-table-mode ()
+(define-derived-mode tags-table-mode special-mode "Tags Table"
"Major mode for tags table file buffers."
- (interactive)
- (setq major-mode 'tags-table-mode ;FIXME: Use define-derived-mode.
- mode-name "Tags Table"
- buffer-undo-list t)
+ (setq buffer-undo-list t)
(initialize-new-tags-table))
;;;###autoload
@@ -439,25 +436,25 @@ Returns non-nil if it is a valid table."
(progn
(set-buffer (get-file-buffer file))
(or verify-tags-table-function (tags-table-mode))
- (if (or (verify-visited-file-modtime (current-buffer))
- ;; Decide whether to revert the file.
- ;; revert-without-query can say to revert
- ;; or the user can say to revert.
- (not (or (let ((tail revert-without-query)
- (found nil))
- (while tail
- (if (string-match (car tail) buffer-file-name)
- (setq found t))
- (setq tail (cdr tail)))
- found)
- tags-revert-without-query
- (yes-or-no-p
- (format "Tags file %s has changed, read new contents? "
- file)))))
- (and verify-tags-table-function
- (funcall verify-tags-table-function))
+ (unless (or (verify-visited-file-modtime (current-buffer))
+ ;; Decide whether to revert the file.
+ ;; revert-without-query can say to revert
+ ;; or the user can say to revert.
+ (not (or (let ((tail revert-without-query)
+ (found nil))
+ (while tail
+ (if (string-match (car tail) buffer-file-name)
+ (setq found t))
+ (setq tail (cdr tail)))
+ found)
+ tags-revert-without-query
+ (yes-or-no-p
+ (format "Tags file %s has changed, read new contents? "
+ file)))))
(revert-buffer t t)
- (tags-table-mode)))
+ (tags-table-mode))
+ (and verify-tags-table-function
+ (funcall verify-tags-table-function)))
(when (file-exists-p file)
(let* ((buf (find-file-noselect file))
(newfile (buffer-file-name buf)))
@@ -470,7 +467,9 @@ Returns non-nil if it is a valid table."
;; Only change buffer now that we're done using potentially
;; buffer-local variables.
(set-buffer buf)
- (tags-table-mode)))))
+ (tags-table-mode)
+ (and verify-tags-table-function
+ (funcall verify-tags-table-function))))))
;; Subroutine of visit-tags-table-buffer. Search the current tags tables
;; for one that has tags for THIS-FILE (or that includes a table that
@@ -599,12 +598,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list."
;; be frobnicated, and CONT will be set non-nil so we don't
;; do it below.
(and buffer-file-name
- (or
- ;; First check only tables already in buffers.
- (tags-table-including buffer-file-name t)
- ;; Since that didn't find any, now do the
- ;; expensive version: reading new files.
- (tags-table-including buffer-file-name nil)))
+ (save-current-buffer
+ (or
+ ;; First check only tables already in buffers.
+ (tags-table-including buffer-file-name t)
+ ;; Since that didn't find any, now do the
+ ;; expensive version: reading new files.
+ (tags-table-including buffer-file-name nil))))
;; Fourth, use the user variable tags-file-name, if it is
;; not already in the current list.
(and tags-file-name
@@ -2059,7 +2059,7 @@ see the doc of that variable if you want to add names to the list."
(define-derived-mode select-tags-table-mode special-mode "Select Tags Table"
"Major mode for choosing a current tags table among those already loaded."
- (setq buffer-read-only t))
+ )
(defun select-tags-table-select (button)
"Select the tags table named on this line."
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
index da148bd39aa..00c898d261c 100644
--- a/lisp/progmodes/executable.el
+++ b/lisp/progmodes/executable.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -83,13 +83,21 @@ When this is `function', only ask when called non-interactively."
:type 'regexp
:group 'executable)
-
(defcustom executable-prefix "#!"
- "Interpreter magic number prefix inserted when there was no magic number."
- :version "24.3" ; "#! " -> "#!"
+ "Interpreter magic number prefix inserted when there was no magic number.
+Use of `executable-prefix-env' is preferable to this option."
+ :version "26.1" ; deprecated
:type 'string
:group 'executable)
+(defcustom executable-prefix-env nil
+ "If non-nil, use \"/usr/bin/env\" in interpreter magic number.
+If this variable is non-nil, the interpreter magic number inserted
+by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\",
+otherwise it will be \"#!/path/to/INTERPRETER\"."
+ :version "26.1"
+ :type 'boolean
+ :group 'executable)
(defcustom executable-chmod 73
"After saving, if the file is not executable, set this mode.
@@ -199,7 +207,7 @@ command to find the next error. The buffer is also in `comint-mode' and
(defun executable-set-magic (interpreter &optional argument
no-query-flag insert-flag)
"Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
+The variables `executable-magicless-file-regexp', `executable-prefix-env',
`executable-insert', `executable-query' and `executable-chmod' control
when and how magic numbers are inserted or replaced and scripts made
executable."
@@ -220,6 +228,14 @@ executable."
(and argument (string< "" argument) " ")
argument))
+ ;; For backward compatibility, allow `executable-prefix-env' to be
+ ;; overridden by custom `executable-prefix'.
+ (if (string-match "#!\\([ \t]*/usr/bin/env[ \t]*\\)?$" executable-prefix)
+ (if executable-prefix-env
+ (setq argument (concat "/usr/bin/env "
+ (file-name-nondirectory argument))))
+ (setq argument (concat (substring executable-prefix 2) argument)))
+
(or buffer-read-only
(if buffer-file-name
(string-match executable-magicless-file-regexp
@@ -241,15 +257,13 @@ executable."
;; Make buffer visible before question.
(switch-to-buffer (current-buffer))
(y-or-n-p (format-message
- "Replace magic number by `%s%s'? "
- executable-prefix argument))))
+ "Replace magic number by `#!%s'? "
+ argument))))
(progn
(replace-match argument t t nil 1)
- (message "Magic number changed to `%s'"
- (concat executable-prefix argument)))))
- (insert executable-prefix argument ?\n)
- (message "Magic number changed to `%s'"
- (concat executable-prefix argument)))))
+ (message "Magic number changed to `#!%s'" argument))))
+ (insert "#!" argument ?\n)
+ (message "Magic number changed to `#!%s'" argument))))
interpreter)
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
index b3661bfe3f1..0cd665ca24b 100644
--- a/lisp/progmodes/f90.el
+++ b/lisp/progmodes/f90.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -133,7 +133,7 @@
;; f90-indent-region (can be called by calling indent-region)
;; f90-indent-subprogram
;; f90-break-line f90-join-lines
-;; f90-fill-region
+;; f90-fill-region f90-fill-paragraph
;; f90-insert-end
;; f90-upcase-keywords f90-upcase-region-keywords
;; f90-downcase-keywords f90-downcase-region-keywords
@@ -784,6 +784,7 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
["Indent Region" f90-indent-region :active mark-active]
["Fill Region" f90-fill-region :active mark-active
:help "Fill long lines in the region"]
+ ["Fill Statement/Comment" fill-paragraph :active t]
"--"
["Break Line at Point" f90-break-line :active t
:help "Break the current line at point"]
@@ -909,6 +910,8 @@ Can be overridden by the value of `font-lock-maximum-decoration'.")
[ \t]*\\(\\(?:\\sw\\|\\s_\\)+\\)"
"Regexp matching the definition of a derived type.")
+;; Maybe this should include "class default", but the constant is no
+;; longer used.
(defconst f90-typeis-re
"\\_<\\(class\\|type\\)[ \t]*is[ \t]*("
"Regexp matching a CLASS/TYPE IS statement.")
@@ -955,10 +958,14 @@ Used in the F90 entry in `hs-special-modes-alist'.")
;; Avoid F2003 "type is" in "select type",
;; and also variables of derived type "type (foo)".
;; "type, foo" must be a block (?).
+ ;; And a partial effort to avoid "class default".
"\\(?:type\\|class\\)[ \t,]\\("
- "[^i(!\n\"& \t]\\|" ; not-i(
+ "[^id(!\n\"& \t]\\|" ; not-id(
"i[^s!\n\"& \t]\\|" ; i not-s
- "is\\(?:\\sw\\|\\s_\\)\\)\\|"
+ "d[^e!\n\"& \t]\\|" ; d not-e
+ "de[^f!\n\"& \t]\\|" ; de not-f
+ "def[^a!\n\"& \t]\\|" ; def not-a
+ "\\(?:is\\|default\\)\\(?:\\sw\\|\\s_\\)\\)\\|"
;; "abstract interface" is F2003; "submodule" is F2008.
"program\\|\\(?:abstract[ \t]*\\)?interface\\|\\(?:sub\\)?module\\|"
;; "enum", but not "enumerator".
@@ -1179,6 +1186,7 @@ with no args, if that value is non-nil."
(set (make-local-variable 'abbrev-all-caps) t)
(set (make-local-variable '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
@@ -1454,7 +1462,7 @@ if all else fails."
(not (or (looking-at "end")
(looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
\\|select[ \t]*\\(case\\|type\\)\\|case\\|where\\|forall\\|\
-\\(?:class\\|type\\)[ \t]*is\\|\
+\\(?:class\\|type\\)[ \t]*is\\|class[ \t]*default\\|\
block\\|critical\\|enum\\|associate\\)\\_>")
(looking-at "\\(program\\|\\(?:sub\\)?module\\|\
\\(?:abstract[ \t]*\\)?interface\\|block[ \t]*data\\)\\_>")
@@ -1880,8 +1888,8 @@ after indenting."
;; FIXME This means f90-calculate-indent gives different answers
;; for comments and preprocessor lines to this function.
;; Better to make f90-calculate-indent return the correct answer?
- (cond ((looking-at "!") (setq indent (f90-comment-indent)))
- ((looking-at "#") (setq indent 0))
+ (cond ((= (following-char) ?!) (setq indent (f90-comment-indent)))
+ ((= (following-char) ?#) (setq indent 0))
(t
(and f90-smart-end (looking-at "end")
(f90-match-end))
@@ -2152,6 +2160,20 @@ Like `join-line', but handles F90 syntax."
(if (featurep 'xemacs)
(zmacs-deactivate-region)
(deactivate-mark))))
+
+(defun f90-fill-paragraph (&optional justify)
+ "In a comment, fill it as a paragraph, else fill the current statement.
+For use as the value of `fill-paragraph-function'.
+Passes optional argument JUSTIFY to `fill-comment-paragraph'.
+Always returns non-nil (to prevent `fill-paragraph' being called)."
+ (interactive "*P")
+ (or (fill-comment-paragraph justify)
+ (save-excursion
+ (f90-next-statement)
+ (let ((end (if (bobp) (point) (1- (point)))))
+ (f90-previous-statement)
+ (f90-fill-region (point) end)))
+ t))
(defconst f90-end-block-optional-name
'("program" "module" "subroutine" "function" "type")
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
new file mode 100644
index 00000000000..e207de5da6c
--- /dev/null
+++ b/lisp/progmodes/flymake-proc.el
@@ -0,0 +1,1208 @@
+;;; flymake-proc.el --- Flymake backend for external tools -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
+
+;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
+;; Maintainer: Leo Liu <sdl.web@gmail.com>
+;; Version: 0.3
+;; Keywords: c languages tools
+
+;; 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:
+;;
+;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.
+;;
+;; This file contains a significant part of the original flymake's
+;; implementation, a buffer-checking mechanism that parses the output
+;; of an external syntax check tool with regular expressions.
+;;
+;; That work has been adapted into a flymake "backend" function,
+;; `flymake-proc-legacy-flymake' suitable for adding to the
+;; `flymake-diagnostic-functions' variable.
+;;
+;;; Bugs/todo:
+
+;; - Only uses "Makefile", not "makefile" or "GNUmakefile"
+;; (from http://bugs.debian.org/337339).
+
+;;; Code:
+
+(require 'cl-lib)
+
+(require 'flymake)
+
+(defcustom flymake-proc-compilation-prevents-syntax-check t
+ "If non-nil, don't start syntax check if compilation is running."
+ :group 'flymake
+ :type 'boolean)
+
+(defcustom flymake-proc-xml-program
+ (if (executable-find "xmlstarlet") "xmlstarlet" "xml")
+ "Program to use for XML validation."
+ :type 'file
+ :group 'flymake
+ :version "24.4")
+
+(defcustom flymake-proc-master-file-dirs '("." "./src" "./UnitTest")
+ "Dirs where to look for master files."
+ :group 'flymake
+ :type '(repeat (string)))
+
+(defcustom flymake-proc-master-file-count-limit 32
+ "Max number of master files to check."
+ :group 'flymake
+ :type 'integer)
+
+(defcustom flymake-proc-ignored-file-name-regexps '()
+ "Files syntax checking is forbidden for.
+Overrides `flymake-proc-allowed-file-name-masks'."
+ :group 'flymake
+ :type '(repeat (regexp))
+ :version "27.1")
+
+(defcustom flymake-proc-allowed-file-name-masks
+ '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'"
+ flymake-proc-simple-make-init
+ nil
+ flymake-proc-real-file-name-considering-includes)
+ ("\\.xml\\'" flymake-proc-xml-init)
+ ("\\.html?\\'" flymake-proc-xml-init)
+ ("\\.cs\\'" flymake-proc-simple-make-init)
+ ;; ("\\.p[ml]\\'" flymake-proc-perl-init)
+ ("\\.php[345]?\\'" flymake-proc-php-init)
+ ("\\.h\\'" flymake-proc-master-make-header-init flymake-proc-master-cleanup)
+ ("\\.java\\'" flymake-proc-simple-make-java-init flymake-proc-simple-java-cleanup)
+ ("[0-9]+\\.tex\\'" flymake-proc-master-tex-init flymake-proc-master-cleanup)
+ ("\\.tex\\'" flymake-proc-simple-tex-init)
+ ("\\.idl\\'" flymake-proc-simple-make-init)
+ ;; ("\\.cpp\\'" 1)
+ ;; ("\\.java\\'" 3)
+ ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'")
+ ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2))
+ ;; ("\\.idl\\'" 1)
+ ;; ("\\.odl\\'" 1)
+ ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'")
+ ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 ))
+ ;; ("\\.tex\\'" 1)
+ )
+ "Files syntax checking is allowed for.
+Variable `flymake-proc-ignored-file-name-regexps' overrides this variable.
+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'."
+ :group 'flymake
+ :type '(alist :key-type (regexp :tag "File regexp")
+ :value-type
+ (list :tag "Handler functions"
+ (function :tag "Init function")
+ (choice :tag "Cleanup function"
+ (const :tag "flymake-proc-simple-cleanup" nil)
+ function)
+ (choice :tag "Name function"
+ (const :tag "flymake-proc-get-real-file-name" nil)
+ function))))
+
+(defvar-local flymake-proc--current-process nil
+ "Currently active Flymake process for a buffer, if any.")
+
+(defvar flymake-proc--report-fn nil
+ "If bound, function used to report back to Flymake's UI.")
+
+(defun flymake-proc-reformat-err-line-patterns-from-compile-el (original-list)
+ "Grab error line patterns from ORIGINAL-LIST in compile.el format.
+Convert it to Flymake internal format."
+ (let* ((converted-list '()))
+ (dolist (item original-list)
+ (setq item (cdr item))
+ (let ((regexp (nth 0 item))
+ (file (nth 1 item))
+ (line (nth 2 item))
+ (col (nth 3 item)))
+ (if (consp file) (setq file (car file)))
+ (if (consp line) (setq line (car line)))
+ (if (consp col) (setq col (car col)))
+
+ (when (not (functionp line))
+ (setq converted-list (cons (list regexp file line col) converted-list)))))
+ converted-list))
+
+(defvar flymake-proc-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text
+ (append
+ '(
+ ;; MS Visual C++ 6.0
+ ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
+ 1 3 nil 4)
+ ;; jikes
+ ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)"
+ 1 3 nil 4)
+ ;; MS midl
+ ("midl[ ]*:[ ]*\\(command line error .*\\)"
+ nil nil nil 1)
+ ;; MS C#
+ ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
+ 1 3 nil 4)
+ ;; perl
+ ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1)
+ ;; PHP
+ ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1)
+ ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1)
+ ;; ant/javac. Note this also matches gcc warnings!
+ (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?:[ \t\n]*\\(.+\\)"
+ 2 4 5 6))
+ ;; compilation-error-regexp-alist)
+ (flymake-proc-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
+ "Patterns for matching error/warning lines. Each pattern has the form
+\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX).
+Use `flymake-proc-reformat-err-line-patterns-from-compile-el' to add patterns
+from compile.el")
+
+(define-obsolete-variable-alias 'flymake-warning-re 'flymake-proc-diagnostic-type-pred "26.1")
+(defvar flymake-proc-diagnostic-type-pred
+ 'flymake-proc-default-guess
+ "Predicate matching against diagnostic text to detect its type.
+Takes a single argument, the diagnostic's text and should return
+a value suitable for indexing
+`flymake-diagnostic-types-alist' (which see). If the returned
+value is nil, a type of `:error' is assumed. For some backward
+compatibility, if a non-nil value is returned that doesn't
+index that alist, a type of `:warning' is assumed.
+
+Instead of a function, it can also be a string, a regular
+expression. A match indicates `:warning' type, otherwise
+`:error'")
+
+(defun flymake-proc-default-guess (text)
+ "Guess if TEXT means a warning, a note or an error."
+ (cond ((string-match "^[wW]arning" text)
+ :warning)
+ ((string-match "^[nN]ote" text)
+ :note)
+ (t
+ :error)))
+
+(defun flymake-proc--get-file-name-mode-and-masks (file-name)
+ "Return the corresponding entry from `flymake-proc-allowed-file-name-masks'.
+If the FILE-NAME matches a regexp from `flymake-proc-ignored-file-name-regexps',
+`flymake-proc-allowed-file-name-masks' is not searched."
+ (unless (stringp file-name)
+ (error "Invalid file-name"))
+ (if (cl-find file-name flymake-proc-ignored-file-name-regexps
+ :test (lambda (fn rex) (string-match rex fn)))
+ (flymake-log 3 "file %s ignored")
+ (let ((fnm flymake-proc-allowed-file-name-masks)
+ (mode-and-masks nil))
+ (while (and (not mode-and-masks) fnm)
+ (if (string-match (car (car fnm)) file-name)
+ (setq mode-and-masks (cdr (car fnm))))
+ (setq fnm (cdr fnm)))
+ (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks))
+ mode-and-masks)))
+
+(defun flymake-proc--get-init-function (file-name)
+ "Return init function to be used for the file."
+ (let* ((init-f (nth 0 (flymake-proc--get-file-name-mode-and-masks file-name))))
+ ;;(flymake-log 0 "calling %s" init-f)
+ ;;(funcall init-f (current-buffer))
+ init-f))
+
+(defun flymake-proc--get-cleanup-function (file-name)
+ "Return cleanup function to be used for the file."
+ (or (nth 1 (flymake-proc--get-file-name-mode-and-masks file-name))
+ 'flymake-proc-simple-cleanup))
+
+(defun flymake-proc--get-real-file-name-function (file-name)
+ (or (nth 2 (flymake-proc--get-file-name-mode-and-masks file-name))
+ 'flymake-proc-get-real-file-name))
+
+(defvar flymake-proc--find-buildfile-cache (make-hash-table :test #'equal))
+
+(defun flymake-proc--get-buildfile-from-cache (dir-name)
+ "Look up DIR-NAME in cache and return its associated value.
+If DIR-NAME is not found, return nil."
+ (gethash dir-name flymake-proc--find-buildfile-cache))
+
+(defun flymake-proc--add-buildfile-to-cache (dir-name buildfile)
+ "Associate DIR-NAME with BUILDFILE in the buildfile cache."
+ (puthash dir-name buildfile flymake-proc--find-buildfile-cache))
+
+(defun flymake-proc--clear-buildfile-cache ()
+ "Clear the buildfile cache."
+ (clrhash flymake-proc--find-buildfile-cache))
+
+(defun flymake-proc--find-buildfile (buildfile-name source-dir-name)
+ "Find buildfile starting from current directory.
+Buildfile includes Makefile, build.xml etc.
+Return its file name if found, or nil if not found."
+ (or (flymake-proc--get-buildfile-from-cache source-dir-name)
+ (let* ((file (locate-dominating-file source-dir-name buildfile-name)))
+ (if file
+ (progn
+ (flymake-log 3 "found buildfile at %s" file)
+ (flymake-proc--add-buildfile-to-cache source-dir-name file)
+ file)
+ (progn
+ (flymake-log 3 "buildfile for %s not found" source-dir-name)
+ nil)))))
+
+(defun flymake-proc--fix-file-name (name)
+ "Replace all occurrences of `\\' with `/'."
+ (when name
+ (setq name (expand-file-name name))
+ (setq name (abbreviate-file-name name))
+ (setq name (directory-file-name name))
+ name))
+
+(defun flymake-proc--same-files (file-name-one file-name-two)
+ "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file.
+Return t if so, nil if not."
+ (equal (flymake-proc--fix-file-name file-name-one)
+ (flymake-proc--fix-file-name file-name-two)))
+
+;; This is bound dynamically to pass a parameter to a sort predicate below
+(defvar flymake-proc--included-file-name)
+
+(defun flymake-proc--find-possible-master-files (file-name master-file-dirs masks)
+ "Find (by name and location) all possible master files.
+Name is specified by FILE-NAME and location is specified by
+MASTER-FILE-DIRS. Master files include .cpp and .c for .h.
+Files are searched for starting from the .h directory and max
+max-level parent dirs. File contents are not checked."
+ (let* ((dirs master-file-dirs)
+ (files nil)
+ (done nil))
+
+ (while (and (not done) dirs)
+ (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name)))
+ (masks masks))
+ (while (and (file-exists-p dir) (not done) masks)
+ (let* ((mask (car masks))
+ (dir-files (directory-files dir t mask)))
+
+ (flymake-log 3 "dir %s, %d file(s) for mask %s"
+ dir (length dir-files) mask)
+ (while (and (not done) dir-files)
+ (when (not (file-directory-p (car dir-files)))
+ (setq files (cons (car dir-files) files))
+ (when (>= (length files) flymake-proc-master-file-count-limit)
+ (flymake-log 3 "master file count limit (%d) reached" flymake-proc-master-file-count-limit)
+ (setq done t)))
+ (setq dir-files (cdr dir-files))))
+ (setq masks (cdr masks))))
+ (setq dirs (cdr dirs)))
+ (when files
+ (let ((flymake-proc--included-file-name (file-name-nondirectory file-name)))
+ (setq files (sort files 'flymake-proc--master-file-compare))))
+ (flymake-log 3 "found %d possible master file(s)" (length files))
+ files))
+
+(defun flymake-proc--master-file-compare (file-one file-two)
+ "Compare two files specified by FILE-ONE and FILE-TWO.
+This function is used in sort to move most possible file names
+to the beginning of the list (File.h -> File.cpp moved to top)."
+ (and (equal (file-name-sans-extension flymake-proc--included-file-name)
+ (file-name-base file-one))
+ (not (equal file-one file-two))))
+
+(defvar flymake-proc-check-file-limit 8192
+ "Maximum number of chars to look at when checking possible master file.
+Nil means search the entire file.")
+
+(defun flymake-proc--check-patch-master-file-buffer
+ (master-file-temp-buffer
+ master-file-name patched-master-file-name
+ source-file-name patched-source-file-name
+ include-dirs regexp)
+ "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME.
+If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME
+instead of SOURCE-FILE-NAME.
+
+For example, foo.cpp is a master file if it includes foo.h.
+
+When a buffer for MASTER-FILE-NAME exists, use it as a source
+instead of reading master file from disk."
+ (let* ((source-file-nondir (file-name-nondirectory source-file-name))
+ (source-file-extension (file-name-extension source-file-nondir))
+ (source-file-nonext (file-name-sans-extension source-file-nondir))
+ (found nil)
+ (inc-name nil)
+ (search-limit flymake-proc-check-file-limit))
+ (setq regexp
+ (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\""
+ ;; Hack for tex files, where \include often excludes .tex.
+ ;; Maybe this is safe generally.
+ (if (and (> (length source-file-extension) 1)
+ (string-equal source-file-extension "tex"))
+ (format "%s\\(?:\\.%s\\)?"
+ (regexp-quote source-file-nonext)
+ (regexp-quote source-file-extension))
+ (regexp-quote source-file-nondir))))
+ (unwind-protect
+ (with-current-buffer master-file-temp-buffer
+ (if (or (not search-limit)
+ (> search-limit (point-max)))
+ (setq search-limit (point-max)))
+ (flymake-log 3 "checking %s against regexp %s"
+ master-file-name regexp)
+ (goto-char (point-min))
+ (while (and (< (point) search-limit)
+ (re-search-forward regexp search-limit t))
+ (let ((match-beg (match-beginning 1))
+ (match-end (match-end 1)))
+
+ (flymake-log 3 "found possible match for %s" source-file-nondir)
+ (setq inc-name (match-string 1))
+ (and (> (length source-file-extension) 1)
+ (string-equal source-file-extension "tex")
+ (not (string-match (format "\\.%s\\'" source-file-extension)
+ inc-name))
+ (setq inc-name (concat inc-name "." source-file-extension)))
+ (when (eq t (compare-strings
+ source-file-nondir nil nil
+ inc-name (- (length inc-name)
+ (length source-file-nondir)) nil))
+ (flymake-log 3 "inc-name=%s" inc-name)
+ (when (flymake-proc--check-include source-file-name inc-name
+ include-dirs)
+ (setq found t)
+ ;; replace-match is not used here as it fails in
+ ;; XEmacs with 'last match not a buffer' error as
+ ;; check-includes calls replace-in-string
+ (flymake-proc--replace-region
+ match-beg match-end
+ (file-name-nondirectory patched-source-file-name))))
+ (forward-line 1)))
+ (when found
+ (flymake-proc--save-buffer-in-file patched-master-file-name)))
+ ;;+(flymake-log 3 "killing buffer %s"
+ ;; (buffer-name master-file-temp-buffer))
+ (kill-buffer master-file-temp-buffer))
+ ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found)
+ (when found
+ (flymake-log 2 "found master file %s" master-file-name))
+ found))
+
+;;; XXX: remove
+(defun flymake-proc--replace-region (beg end rep)
+ "Replace text in BUFFER in region (BEG END) with REP."
+ (save-excursion
+ (goto-char end)
+ ;; Insert before deleting, so as to better preserve markers's positions.
+ (insert rep)
+ (delete-region beg end)))
+
+(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))
+
+(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))))
+ (insert-buffer-substring buffer)
+ (current-buffer)))
+
+(defun flymake-proc--check-include (source-file-name inc-name include-dirs)
+ "Check if SOURCE-FILE-NAME can be found in include path.
+Return t if it can be found via include path using INC-NAME."
+ (if (file-name-absolute-p inc-name)
+ (flymake-proc--same-files source-file-name inc-name)
+ (while (and include-dirs
+ (not (flymake-proc--same-files
+ source-file-name
+ (concat (file-name-directory source-file-name)
+ "/" (car include-dirs)
+ "/" inc-name))))
+ (setq include-dirs (cdr include-dirs)))
+ include-dirs))
+
+(defun flymake-proc--find-buffer-for-file (file-name)
+ "Check if there exists a buffer visiting FILE-NAME.
+Return t if so, nil if not."
+ (let ((buffer-name (get-file-buffer file-name)))
+ (if buffer-name
+ (get-buffer buffer-name))))
+
+(defun flymake-proc--create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp)
+ "Save SOURCE-FILE-NAME with a different name.
+Find master file, patch and save it."
+ (let* ((possible-master-files (flymake-proc--find-possible-master-files source-file-name flymake-proc-master-file-dirs masks))
+ (master-file-count (length possible-master-files))
+ (idx 0)
+ (temp-buffer nil)
+ (master-file-name nil)
+ (patched-master-file-name nil)
+ (found nil))
+
+ (while (and (not found) (< idx master-file-count))
+ (setq master-file-name (nth idx possible-master-files))
+ (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master"))
+ (if (flymake-proc--find-buffer-for-file master-file-name)
+ (setq temp-buffer (flymake-proc--copy-buffer-to-temp-buffer (flymake-proc--find-buffer-for-file master-file-name)))
+ (setq temp-buffer (flymake-proc--read-file-to-temp-buffer master-file-name)))
+ (setq found
+ (flymake-proc--check-patch-master-file-buffer
+ temp-buffer
+ master-file-name
+ patched-master-file-name
+ source-file-name
+ patched-source-file-name
+ (funcall get-incl-dirs-f (file-name-directory master-file-name))
+ include-regexp))
+ (setq idx (1+ idx)))
+ (if found
+ (list master-file-name patched-master-file-name)
+ (progn
+ (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count
+ (file-name-nondirectory source-file-name))
+ nil))))
+
+(defun flymake-proc--save-buffer-in-file (file-name)
+ "Save the entire buffer contents into file FILE-NAME.
+Create parent directories as needed."
+ (make-directory (file-name-directory file-name) 1)
+ (write-region nil nil file-name nil 566)
+ (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name))
+
+(defun flymake-proc--diagnostics-for-pattern (proc pattern)
+ (cl-flet ((guess-type
+ (pred message)
+ (cond ((null message)
+ :error)
+ ((stringp pred)
+ (if (string-match pred message)
+ :warning
+ :error))
+ ((functionp pred)
+ (let ((probe (funcall pred message)))
+ (cond ((assoc-default probe
+ flymake-diagnostic-types-alist)
+ probe)
+ (probe
+ :warning)
+ (t
+ :error)))))))
+ (condition-case-unless-debug err
+ (cl-loop
+ with (regexp file-idx line-idx col-idx message-idx) = pattern
+ while (and
+ (search-forward-regexp regexp nil t)
+ ;; If the preceding search spanned more than one line,
+ ;; move to the start of the line we ended up in. This
+ ;; preserves the usefulness of the patterns in
+ ;; `flymake-proc-err-line-patterns', which were
+ ;; written primarily for flymake's original
+ ;; line-by-line parsing and thus never spanned
+ ;; multiple lines.
+ (if (/= (line-number-at-pos (match-beginning 0))
+ (line-number-at-pos))
+ (goto-char (line-beginning-position))
+ t))
+ for fname = (and file-idx (match-string file-idx))
+ for message = (and message-idx (match-string message-idx))
+ for line-string = (and line-idx (match-string line-idx))
+ for line-number = (or (and line-string
+ (string-to-number line-string))
+ 1)
+ for col-string = (and col-idx (match-string col-idx))
+ for col-number = (and col-string
+ (string-to-number col-string))
+ for full-file = (with-current-buffer (process-buffer proc)
+ (and fname
+ (funcall
+ (flymake-proc--get-real-file-name-function
+ fname)
+ fname)))
+ for buffer = (and full-file
+ (find-buffer-visiting full-file))
+ if (and (eq buffer (process-buffer proc)) message)
+ collect (pcase-let ((`(,beg . ,end)
+ (flymake-diag-region buffer line-number col-number)))
+ (flymake-make-diagnostic
+ buffer beg end
+ (with-current-buffer buffer
+ (guess-type flymake-proc-diagnostic-type-pred message))
+ message))
+ else
+ do (flymake-log 2 "Reference to file %s is out of scope" fname))
+ (error
+ (flymake-log 1 "Error parsing process output for pattern %s: %s"
+ pattern err)
+ nil))))
+
+(defun flymake-proc--process-filter (proc string)
+ "Parse STRING and collect diagnostics info."
+ (flymake-log 3 "received %d byte(s) of output from process %d"
+ (length string) (process-id proc))
+ (let ((output-buffer (process-get proc 'flymake-proc--output-buffer)))
+ (when (and (buffer-live-p (process-buffer proc))
+ output-buffer)
+ (with-current-buffer output-buffer
+ (let ((moving (= (point) (process-mark proc)))
+ (inhibit-read-only t)
+ (unprocessed-mark
+ (or (process-get proc 'flymake-proc--unprocessed-mark)
+ (set-marker (make-marker) (point-min)))))
+ (save-excursion
+ ;; Insert the text, advancing the process marker.
+ (goto-char (process-mark proc))
+ (insert string)
+ (set-marker (process-mark proc) (point)))
+ (if moving (goto-char (process-mark proc)))
+
+ ;; check for new diagnostics
+ ;;
+ (save-excursion
+ (goto-char unprocessed-mark)
+ (dolist (pattern flymake-proc-err-line-patterns)
+ (let ((new (flymake-proc--diagnostics-for-pattern proc pattern)))
+ (process-put
+ proc
+ 'flymake-proc--collected-diagnostics
+ (append new
+ (process-get proc
+ 'flymake-proc--collected-diagnostics)))))
+ (process-put proc 'flymake-proc--unprocessed-mark
+ (point-marker))))))))
+
+(defun flymake-proc--process-sentinel (proc _event)
+ "Sentinel for syntax check buffers."
+ (let (debug
+ (pid (process-id proc))
+ (source-buffer (process-buffer proc)))
+ (unwind-protect
+ (when (buffer-live-p source-buffer)
+ (with-current-buffer source-buffer
+ (cond ((process-get proc 'flymake-proc--obsolete)
+ (flymake-log 3 "proc %s considered obsolete"
+ pid))
+ ((process-get proc 'flymake-proc--interrupted)
+ (flymake-log 3 "proc %s interrupted by user"
+ pid))
+ ((not (process-live-p proc))
+ (let* ((exit-status (process-exit-status proc))
+ (command (process-command proc))
+ (diagnostics (process-get
+ proc
+ 'flymake-proc--collected-diagnostics)))
+ (flymake-log 2 "process %d exited with code %d"
+ pid exit-status)
+ (cond
+ ((equal 0 exit-status)
+ (funcall flymake-proc--report-fn diagnostics
+ :explanation (format "a gift from %s" (process-id proc))
+ ))
+ (diagnostics
+ ;; non-zero exit but some diagnostics is quite
+ ;; normal...
+ (funcall flymake-proc--report-fn diagnostics
+ :explanation (format "a gift from %s" (process-id proc))))
+ ((null diagnostics)
+ ;; ...but no diagnostics is strange, so panic.
+ (setq debug debug-on-error)
+ (flymake-proc--panic
+ :configuration-error
+ (format "Command %s errored, but no diagnostics"
+ command)))))))))
+ (let ((output-buffer (process-get proc 'flymake-proc--output-buffer)))
+ (cond (debug
+ (flymake-log 3 "Output buffer %s kept alive for debugging"
+ output-buffer))
+ (t
+ (when (buffer-live-p source-buffer)
+ (with-current-buffer source-buffer
+ (let ((cleanup-f (flymake-proc--get-cleanup-function
+ (buffer-file-name))))
+ (flymake-log 3 "cleaning up using %s" cleanup-f)
+ (funcall cleanup-f))))
+ (kill-buffer output-buffer)))))))
+
+(defun flymake-proc--panic (problem explanation)
+ "Tell Flymake UI about a fatal PROBLEM with this backend.
+May only be called in a dynamic environment where
+`flymake-proc--report-fn' is bound."
+ (flymake-log 1 "%s: %s" problem explanation)
+ (if (and (boundp 'flymake-proc--report-fn)
+ flymake-proc--report-fn)
+ (funcall flymake-proc--report-fn :panic
+ :explanation (format "%s: %s" problem explanation))
+ (flymake-error "Trouble telling flymake-ui about problem %s(%s)"
+ problem explanation)))
+
+(require 'compile)
+
+(defun flymake-proc-get-project-include-dirs-imp (basedir)
+ "Include dirs for the project current file belongs to."
+ (if (flymake-proc--get-project-include-dirs-from-cache basedir)
+ (progn
+ (flymake-proc--get-project-include-dirs-from-cache basedir))
+ ;;else
+ (let* ((command-line (concat "make -C "
+ (shell-quote-argument basedir)
+ " DUMPVARS=INCLUDE_DIRS dumpvars"))
+ (output (shell-command-to-string command-line))
+ (lines (split-string output "\n" t))
+ (count (length lines))
+ (idx 0)
+ (inc-dirs nil))
+ (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines))))
+ (setq idx (1+ idx)))
+ (when (< idx count)
+ (let* ((inc-lines (split-string (nth idx lines) " *-I" t))
+ (inc-count (length inc-lines)))
+ (while (> inc-count 0)
+ (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines)))
+ (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))
+ (setq inc-count (1- inc-count)))))
+ (flymake-proc--add-project-include-dirs-to-cache basedir inc-dirs)
+ inc-dirs)))
+
+(defvar flymake-proc-get-project-include-dirs-function #'flymake-proc-get-project-include-dirs-imp
+ "Function used to get project include dirs, one parameter: basedir name.")
+
+(defun flymake-proc--get-project-include-dirs (basedir)
+ (funcall flymake-proc-get-project-include-dirs-function basedir))
+
+(defun flymake-proc--get-system-include-dirs ()
+ "System include dirs - from the `INCLUDE' env setting."
+ (let* ((includes (getenv "INCLUDE")))
+ (if includes (split-string includes path-separator t) nil)))
+
+(defvar flymake-proc--project-include-dirs-cache (make-hash-table :test #'equal))
+
+(defun flymake-proc--get-project-include-dirs-from-cache (base-dir)
+ (gethash base-dir flymake-proc--project-include-dirs-cache))
+
+(defun flymake-proc--add-project-include-dirs-to-cache (base-dir include-dirs)
+ (puthash base-dir include-dirs flymake-proc--project-include-dirs-cache))
+
+(defun flymake-proc--clear-project-include-dirs-cache ()
+ (clrhash flymake-proc--project-include-dirs-cache))
+
+(defun flymake-proc-get-include-dirs (base-dir)
+ "Get dirs to use when resolving local file names."
+ (let* ((include-dirs (append '(".") (flymake-proc--get-project-include-dirs base-dir) (flymake-proc--get-system-include-dirs))))
+ include-dirs))
+
+;; (defun flymake-proc--restore-formatting ()
+;; "Remove any formatting made by flymake."
+;; )
+
+;; (defun flymake-proc--get-program-dir (buffer)
+;; "Get dir to start program in."
+;; (unless (bufferp buffer)
+;; (error "Invalid buffer"))
+;; (with-current-buffer buffer
+;; default-directory))
+
+(defun flymake-proc--safe-delete-file (file-name)
+ (when (and file-name (file-exists-p file-name))
+ (delete-file file-name)
+ (flymake-log 2 "deleted file %s" file-name)))
+
+(defun flymake-proc--safe-delete-directory (dir-name)
+ (condition-case-unless-debug nil
+ (progn
+ (delete-directory dir-name)
+ (flymake-log 2 "deleted dir %s" dir-name))
+ (error
+ (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name))))
+
+
+(defun flymake-proc-legacy-flymake (report-fn &rest args)
+ "Flymake backend based on the original Flymake implementation.
+This function is suitable for inclusion in
+`flymake-diagnostic-functions'. For backward compatibility, it
+can also be executed interactively independently of
+`flymake-mode'."
+ ;; Interactively, behave as if flymake had invoked us through its
+ ;; `flymake-diagnostic-functions' with a suitable ID so flymake can
+ ;; clean up consistently
+ (interactive (list
+ (lambda (diags &rest args)
+ (apply (flymake-make-report-fn 'flymake-proc-legacy-flymake)
+ diags
+ (append args '(:force t))))
+ :interactive t))
+ (let ((interactive (plist-get args :interactive))
+ (proc flymake-proc--current-process)
+ (flymake-proc--report-fn report-fn))
+ (when (processp proc)
+ (process-put proc 'flymake-proc--obsolete t)
+ (flymake-log 3 "marking %s obsolete" (process-id proc))
+ (when (process-live-p proc)
+ (when interactive
+ (user-error
+ "There's already a Flymake process running in this buffer")
+ (kill-process proc))))
+ (when
+ ;; This particular situation make us not want to error right
+ ;; away (and disable ourselves), in case the situation changes
+ ;; in the near future.
+ (and (or (not flymake-proc-compilation-prevents-syntax-check)
+ (not (flymake-proc--compilation-is-running))))
+ (let ((init-f
+ (and
+ buffer-file-name
+ ;; Since we write temp files in current dir, there's no point
+ ;; trying if the directory is read-only (bug#8954).
+ (file-writable-p (file-name-directory buffer-file-name))
+ (flymake-proc--get-init-function buffer-file-name))))
+ (unless init-f (error "Can't find a suitable init function"))
+ (flymake-proc--clear-buildfile-cache)
+ (flymake-proc--clear-project-include-dirs-cache)
+
+ (let* ((cleanup-f (flymake-proc--get-cleanup-function buffer-file-name))
+ (cmd-and-args (funcall init-f))
+ (cmd (nth 0 cmd-and-args))
+ (args (nth 1 cmd-and-args))
+ (dir (nth 2 cmd-and-args))
+ (success nil))
+ (unwind-protect
+ (cond
+ ((not cmd-and-args)
+ (flymake-log 1 "init function %s for %s failed, cleaning up"
+ init-f buffer-file-name))
+ (t
+ (setq proc
+ (let ((default-directory (or dir default-directory)))
+ (when dir
+ (flymake-log 3 "starting process on dir %s" dir))
+ (make-process
+ :name "flymake-proc"
+ :buffer (current-buffer)
+ :command (cons cmd args)
+ :noquery t
+ :filter
+ (lambda (proc string)
+ (let ((flymake-proc--report-fn report-fn))
+ (flymake-proc--process-filter proc string)))
+ :sentinel
+ (lambda (proc event)
+ (let ((flymake-proc--report-fn report-fn))
+ (flymake-proc--process-sentinel proc event))))))
+ (process-put proc 'flymake-proc--output-buffer
+ (generate-new-buffer
+ (format " *flymake output for %s*" (current-buffer))))
+ (setq flymake-proc--current-process proc)
+ (flymake-log 2 "started process %d, command=%s, dir=%s"
+ (process-id proc) (process-command proc)
+ default-directory)
+ (setq success t)))
+ (unless success
+ (funcall cleanup-f))))))))
+
+(define-obsolete-function-alias 'flymake-start-syntax-check
+ 'flymake-proc-legacy-flymake "26.1")
+
+(defun flymake-proc-stop-all-syntax-checks (&optional reason)
+ "Kill all syntax check processes."
+ (interactive (list "Interrupted by user"))
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (let (p flymake-proc--current-process)
+ (when (process-live-p p)
+ (kill-process p)
+ (process-put p 'flymake-proc--interrupted reason)
+ (flymake-log 2 "killed process %d" (process-id p)))))))
+
+(defun flymake-proc--compilation-is-running ()
+ (and (boundp 'compilation-in-progress)
+ compilation-in-progress))
+
+(defun flymake-proc-compile ()
+ "Kill all Flymake syntax checks, start compilation."
+ (interactive)
+ (flymake-proc-stop-all-syntax-checks "Stopping for proper compilation")
+ (call-interactively 'compile))
+
+;;;; general init-cleanup and helper routines
+(defun flymake-proc-create-temp-inplace (file-name prefix)
+ (unless (stringp file-name)
+ (error "Invalid file-name"))
+ (or prefix
+ (setq prefix "flymake"))
+ (let* ((ext (file-name-extension file-name))
+ (temp-name (file-truename
+ (concat (file-name-sans-extension file-name)
+ "_" prefix
+ (and ext (concat "." ext))))))
+ (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
+ temp-name))
+
+(defun flymake-proc-create-temp-with-folder-structure (file-name _prefix)
+ (unless (stringp file-name)
+ (error "Invalid file-name"))
+
+ (let* ((dir (file-name-directory file-name))
+ ;; Not sure what this slash-pos is all about, but I guess it's just
+ ;; trying to remove the leading / of absolute file names.
+ (slash-pos (string-match "/" dir))
+ (temp-dir (expand-file-name (substring dir (1+ slash-pos))
+ temporary-file-directory)))
+
+ (file-truename (expand-file-name (file-name-nondirectory file-name)
+ temp-dir))))
+
+(defun flymake-proc--delete-temp-directory (dir-name)
+ "Attempt to delete temp dir created by `flymake-proc-create-temp-with-folder-structure', do not fail on error."
+ (let* ((temp-dir temporary-file-directory)
+ (suffix (substring dir-name (1+ (length temp-dir)))))
+
+ (while (> (length suffix) 0)
+ (setq suffix (directory-file-name suffix))
+ ;;+(flymake-log 0 "suffix=%s" suffix)
+ (flymake-proc--safe-delete-directory
+ (file-truename (expand-file-name suffix temp-dir)))
+ (setq suffix (file-name-directory suffix)))))
+
+(defvar-local flymake-proc--temp-source-file-name nil)
+(defvar-local flymake-proc--master-file-name nil)
+(defvar-local flymake-proc--temp-master-file-name nil)
+(defvar-local flymake-proc--base-dir nil)
+
+(defun flymake-proc-init-create-temp-buffer-copy (create-temp-f)
+ "Make a temporary copy of the current buffer, save its name in buffer data and return the name."
+ (let* ((source-file-name buffer-file-name)
+ (temp-source-file-name (funcall create-temp-f source-file-name "flymake")))
+
+ (flymake-proc--save-buffer-in-file temp-source-file-name)
+ (setq flymake-proc--temp-source-file-name temp-source-file-name)
+ temp-source-file-name))
+
+(defun flymake-proc-simple-cleanup ()
+ "Do cleanup after `flymake-proc-init-create-temp-buffer-copy'.
+Delete temp file."
+ (flymake-proc--safe-delete-file flymake-proc--temp-source-file-name))
+
+(defun flymake-proc-get-real-file-name (file-name-from-err-msg)
+ "Translate file name from error message to \"real\" file name.
+Return full-name. Names are real, not patched."
+ (let* ((real-name nil)
+ (source-file-name buffer-file-name)
+ (master-file-name flymake-proc--master-file-name)
+ (temp-source-file-name flymake-proc--temp-source-file-name)
+ (temp-master-file-name flymake-proc--temp-master-file-name)
+ (base-dirs
+ (list flymake-proc--base-dir
+ (file-name-directory source-file-name)
+ (if master-file-name (file-name-directory master-file-name))))
+ (files (list (list source-file-name source-file-name)
+ (list temp-source-file-name source-file-name)
+ (list master-file-name master-file-name)
+ (list temp-master-file-name master-file-name))))
+
+ (when (equal 0 (length file-name-from-err-msg))
+ (setq file-name-from-err-msg source-file-name))
+
+ (setq real-name (flymake-proc--get-full-patched-file-name file-name-from-err-msg base-dirs files))
+ ;; if real-name is nil, than file name from err msg is none of the files we've patched
+ (if (not real-name)
+ (setq real-name (flymake-proc--get-full-nonpatched-file-name file-name-from-err-msg base-dirs)))
+ (if (not real-name)
+ (setq real-name file-name-from-err-msg))
+ (setq real-name (flymake-proc--fix-file-name real-name))
+ (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name)
+ real-name))
+
+(defun flymake-proc--get-full-patched-file-name (file-name-from-err-msg base-dirs files)
+ (let* ((base-dirs-count (length base-dirs))
+ (file-count (length files))
+ (real-name nil))
+
+ (while (and (not real-name) (> base-dirs-count 0))
+ (setq file-count (length files))
+ (while (and (not real-name) (> file-count 0))
+ (let* ((this-dir (nth (1- base-dirs-count) base-dirs))
+ (this-file (nth 0 (nth (1- file-count) files)))
+ (this-real-name (nth 1 (nth (1- file-count) files))))
+ ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg)
+ (when (and this-dir this-file (flymake-proc--same-files
+ (expand-file-name file-name-from-err-msg this-dir)
+ this-file))
+ (setq real-name this-real-name)))
+ (setq file-count (1- file-count)))
+ (setq base-dirs-count (1- base-dirs-count)))
+ real-name))
+
+(defun flymake-proc--get-full-nonpatched-file-name (file-name-from-err-msg base-dirs)
+ (let* ((real-name nil))
+ (if (file-name-absolute-p file-name-from-err-msg)
+ (setq real-name file-name-from-err-msg)
+ (let* ((base-dirs-count (length base-dirs)))
+ (while (and (not real-name) (> base-dirs-count 0))
+ (let* ((full-name (expand-file-name file-name-from-err-msg
+ (nth (1- base-dirs-count) base-dirs))))
+ (if (file-exists-p full-name)
+ (setq real-name full-name))
+ (setq base-dirs-count (1- base-dirs-count))))))
+ real-name))
+
+(defun flymake-proc--init-find-buildfile-dir (source-file-name buildfile-name)
+ "Find buildfile, store its dir in buffer data and return its dir, if found."
+ (let* ((buildfile-dir
+ (flymake-proc--find-buildfile buildfile-name
+ (file-name-directory source-file-name))))
+ (if buildfile-dir
+ (setq flymake-proc--base-dir buildfile-dir)
+ (flymake-proc--panic
+ "NOMK" (format "No buildfile (%s) found for %s"
+ buildfile-name source-file-name)))))
+
+(defun flymake-proc--init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp)
+ "Find master file (or buffer), create its copy along with a copy of the source file."
+ (let* ((source-file-name buffer-file-name)
+ (temp-source-file-name (flymake-proc-init-create-temp-buffer-copy create-temp-f))
+ (master-and-temp-master (flymake-proc--create-master-file
+ source-file-name temp-source-file-name
+ get-incl-dirs-f create-temp-f
+ master-file-masks include-regexp)))
+
+ (if (not master-and-temp-master)
+ (progn
+ (flymake-proc--panic
+ "NOMASTER"
+ (format-message "cannot find master file for %s"
+ source-file-name))
+ nil)
+ (setq flymake-proc--master-file-name (nth 0 master-and-temp-master))
+ (setq flymake-proc--temp-master-file-name (nth 1 master-and-temp-master)))))
+
+(defun flymake-proc-master-cleanup ()
+ (flymake-proc-simple-cleanup)
+ (flymake-proc--safe-delete-file flymake-proc--temp-master-file-name))
+
+;;;; make-specific init-cleanup routines
+(defun flymake-proc--get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f)
+ "Create a command line for syntax check using GET-CMD-LINE-F."
+ (funcall get-cmd-line-f
+ (if use-relative-source
+ (file-relative-name source-file-name base-dir)
+ source-file-name)
+ (if use-relative-base-dir
+ (file-relative-name base-dir
+ (file-name-directory source-file-name))
+ base-dir)))
+
+(defun flymake-proc-get-make-cmdline (source base-dir)
+ (list "make"
+ (list "-s"
+ "-C"
+ base-dir
+ (concat "CHK_SOURCES=" source)
+ "SYNTAX_CHECK_MODE=1"
+ "check-syntax")))
+
+(defun flymake-proc-get-ant-cmdline (source base-dir)
+ (list "ant"
+ (list "-buildfile"
+ (concat base-dir "/" "build.xml")
+ (concat "-DCHK_SOURCES=" source)
+ "check-syntax")))
+
+(defun flymake-proc-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f)
+ "Create syntax check command line for a directly checked source file.
+Use CREATE-TEMP-F for creating temp copy."
+ (let* ((args nil)
+ (source-file-name buffer-file-name)
+ (buildfile-dir (flymake-proc--init-find-buildfile-dir source-file-name build-file-name)))
+ (if buildfile-dir
+ (let* ((temp-source-file-name (flymake-proc-init-create-temp-buffer-copy create-temp-f)))
+ (setq args (flymake-proc--get-syntax-check-program-args temp-source-file-name buildfile-dir
+ use-relative-base-dir use-relative-source
+ get-cmdline-f))))
+ args))
+
+(defun flymake-proc-simple-make-init ()
+ (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-inplace t t "Makefile" 'flymake-proc-get-make-cmdline))
+
+(defun flymake-proc-master-make-init (get-incl-dirs-f master-file-masks include-regexp)
+ "Create make command line for a source file checked via master file compilation."
+ (let* ((make-args nil)
+ (temp-master-file-name (flymake-proc--init-create-temp-source-and-master-buffer-copy
+ get-incl-dirs-f 'flymake-proc-create-temp-inplace
+ master-file-masks include-regexp)))
+ (when temp-master-file-name
+ (let* ((buildfile-dir (flymake-proc--init-find-buildfile-dir temp-master-file-name "Makefile")))
+ (if buildfile-dir
+ (setq make-args (flymake-proc--get-syntax-check-program-args
+ temp-master-file-name buildfile-dir nil nil 'flymake-proc-get-make-cmdline)))))
+ make-args))
+
+(defun flymake-proc--find-make-buildfile (source-dir)
+ (flymake-proc--find-buildfile "Makefile" source-dir))
+
+;;;; .h/make specific
+(defun flymake-proc-master-make-header-init ()
+ (flymake-proc-master-make-init
+ 'flymake-proc-get-include-dirs
+ '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'")
+ "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\""))
+
+(defun flymake-proc-real-file-name-considering-includes (scraped)
+ (flymake-proc-get-real-file-name
+ (let ((case-fold-search t))
+ (replace-regexp-in-string "^in file included from[ \t*]"
+ ""
+ scraped))))
+
+;;;; .java/make specific
+(defun flymake-proc-simple-make-java-init ()
+ (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-with-folder-structure nil nil "Makefile" 'flymake-proc-get-make-cmdline))
+
+(defun flymake-proc-simple-ant-java-init ()
+ (flymake-proc-simple-make-init-impl 'flymake-proc-create-temp-with-folder-structure nil nil "build.xml" 'flymake-proc-get-ant-cmdline))
+
+(defun flymake-proc-simple-java-cleanup ()
+ "Cleanup after `flymake-proc-simple-make-java-init' -- delete temp file and dirs."
+ (flymake-proc--safe-delete-file flymake-proc--temp-source-file-name)
+ (when flymake-proc--temp-source-file-name
+ (flymake-proc--delete-temp-directory
+ (file-name-directory flymake-proc--temp-source-file-name))))
+
+;;;; perl-specific init-cleanup routines
+(defun flymake-proc-perl-init ()
+ (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy
+ 'flymake-proc-create-temp-inplace))
+ (local-file (file-relative-name
+ temp-file
+ (file-name-directory buffer-file-name))))
+ (list "perl" (list "-wc " local-file))))
+
+;;;; php-specific init-cleanup routines
+(defun flymake-proc-php-init ()
+ (let* ((temp-file (flymake-proc-init-create-temp-buffer-copy
+ 'flymake-proc-create-temp-inplace))
+ (local-file (file-relative-name
+ temp-file
+ (file-name-directory buffer-file-name))))
+ (list "php" (list "-f" local-file "-l"))))
+
+;;;; tex-specific init-cleanup routines
+(defun flymake-proc--get-tex-args (file-name)
+ ;;(list "latex" (list "-c-style-errors" file-name))
+ (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name)))
+
+(defun flymake-proc-simple-tex-init ()
+ (flymake-proc--get-tex-args (flymake-proc-init-create-temp-buffer-copy 'flymake-proc-create-temp-inplace)))
+
+;; Perhaps there should be a buffer-local variable flymake-master-file
+;; that people can set to override this stuff. Could inherit from
+;; the similar AUCTeX variable.
+(defun flymake-proc-master-tex-init ()
+ (let* ((temp-master-file-name (flymake-proc--init-create-temp-source-and-master-buffer-copy
+ 'flymake-proc-get-include-dirs-dot 'flymake-proc-create-temp-inplace
+ '("\\.tex\\'")
+ "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}")))
+ (when temp-master-file-name
+ (flymake-proc--get-tex-args temp-master-file-name))))
+
+(defun flymake-proc--get-include-dirs-dot (_base-dir)
+ '("."))
+
+;;;; xml-specific init-cleanup routines
+(defun flymake-proc-xml-init ()
+ (list flymake-proc-xml-program
+ (list "val" (flymake-proc-init-create-temp-buffer-copy
+ 'flymake-proc-create-temp-inplace))))
+
+
+;;;; Hook onto flymake-ui
+(add-hook 'flymake-diagnostic-functions 'flymake-proc-legacy-flymake)
+
+
+;;;;
+
+(progn
+ (define-obsolete-variable-alias 'flymake-compilation-prevents-syntax-check
+ 'flymake-proc-compilation-prevents-syntax-check "26.1")
+ (define-obsolete-variable-alias 'flymake-xml-program
+ 'flymake-proc-xml-program "26.1")
+ (define-obsolete-variable-alias 'flymake-master-file-dirs
+ 'flymake-proc-master-file-dirs "26.1")
+ (define-obsolete-variable-alias 'flymake-master-file-count-limit
+ 'flymake-proc-master-file-count-limit "26.1"
+ "Max number of master files to check.")
+ (define-obsolete-variable-alias 'flymake-allowed-file-name-masks
+ 'flymake-proc-allowed-file-name-masks "26.1")
+ (define-obsolete-variable-alias 'flymake-check-file-limit
+ 'flymake-proc-check-file-limit "26.1")
+ (define-obsolete-function-alias 'flymake-reformat-err-line-patterns-from-compile-el
+ 'flymake-proc-reformat-err-line-patterns-from-compile-el "26.1")
+ (define-obsolete-variable-alias 'flymake-err-line-patterns
+ 'flymake-proc-err-line-patterns "26.1")
+ (define-obsolete-function-alias 'flymake-parse-line
+ 'flymake-proc-parse-line "26.1")
+ (define-obsolete-function-alias 'flymake-get-include-dirs
+ 'flymake-proc-get-include-dirs "26.1")
+ (define-obsolete-function-alias 'flymake-stop-all-syntax-checks
+ 'flymake-proc-stop-all-syntax-checks "26.1")
+ (define-obsolete-function-alias 'flymake-compile
+ 'flymake-proc-compile "26.1")
+ (define-obsolete-function-alias 'flymake-create-temp-inplace
+ 'flymake-proc-create-temp-inplace "26.1")
+ (define-obsolete-function-alias 'flymake-create-temp-with-folder-structure
+ 'flymake-proc-create-temp-with-folder-structure "26.1")
+ (define-obsolete-function-alias 'flymake-init-create-temp-buffer-copy
+ 'flymake-proc-init-create-temp-buffer-copy "26.1")
+ (define-obsolete-function-alias 'flymake-simple-cleanup
+ 'flymake-proc-simple-cleanup "26.1")
+ (define-obsolete-function-alias 'flymake-get-real-file-name
+ 'flymake-proc-get-real-file-name "26.1")
+ (define-obsolete-function-alias 'flymake-master-cleanup
+ 'flymake-proc-master-cleanup "26.1")
+ (define-obsolete-function-alias 'flymake-get-make-cmdline
+ 'flymake-proc-get-make-cmdline "26.1")
+ (define-obsolete-function-alias 'flymake-get-ant-cmdline
+ 'flymake-proc-get-ant-cmdline "26.1")
+ (define-obsolete-function-alias 'flymake-simple-make-init-impl
+ 'flymake-proc-simple-make-init-impl "26.1")
+ (define-obsolete-function-alias 'flymake-simple-make-init
+ 'flymake-proc-simple-make-init "26.1")
+ (define-obsolete-function-alias 'flymake-master-make-init
+ 'flymake-proc-master-make-init "26.1")
+ (define-obsolete-function-alias 'flymake-find-make-buildfile
+ 'flymake-proc--find-make-buildfile "26.1")
+ (define-obsolete-function-alias 'flymake-master-make-header-init
+ 'flymake-proc-master-make-header-init "26.1")
+ (define-obsolete-function-alias 'flymake-simple-make-java-init
+ 'flymake-proc-simple-make-java-init "26.1")
+ (define-obsolete-function-alias 'flymake-simple-ant-java-init
+ 'flymake-proc-simple-ant-java-init "26.1")
+ (define-obsolete-function-alias 'flymake-simple-java-cleanup
+ 'flymake-proc-simple-java-cleanup "26.1")
+ (define-obsolete-function-alias 'flymake-perl-init
+ 'flymake-proc-perl-init "26.1")
+ (define-obsolete-function-alias 'flymake-php-init
+ 'flymake-proc-php-init "26.1")
+ (define-obsolete-function-alias 'flymake-simple-tex-init
+ 'flymake-proc-simple-tex-init "26.1")
+ (define-obsolete-function-alias 'flymake-master-tex-init
+ 'flymake-proc-master-tex-init "26.1")
+ (define-obsolete-function-alias 'flymake-xml-init
+ 'flymake-proc-xml-init "26.1"))
+
+
+
+(provide 'flymake-proc)
+;;; flymake-proc.el ends here
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index ed34d9aaa52..15a36175970 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1,4 +1,4 @@
-;;; flymake.el --- a universal on-the-fly syntax checker -*- lexical-binding: t; -*-
+;;; flymake.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
@@ -20,22 +20,36 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
-;; Flymake is a minor Emacs mode performing on-the-fly syntax checks
-;; using the external syntax check tool (for C/C++ this is usually the
-;; compiler).
-
-;;; Bugs/todo:
-
-;; - Only uses "Makefile", not "makefile" or "GNUmakefile"
-;; (from http://bugs.debian.org/337339).
-
+;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.
+;;
+;; Flymake collects diagnostic information for multiple sources,
+;; called backends, and visually annotates the relevant portions in
+;; the buffer.
+;;
+;; This file contains the UI for displaying and interacting with the
+;; results produced by these backends, as well as entry points for
+;; backends to hook on to.
+;;
+;; The main entry points are `flymake-mode' and `flymake-start'
+;;
+;; The docstrings of these variables are relevant to understanding how
+;; Flymake works for both the user and the backend programmer:
+;;
+;; * `flymake-diagnostic-functions'
+;; * `flymake-diagnostic-types-alist'
+;;
;;; Code:
-(eval-when-compile (require 'cl-lib))
+(require 'cl-lib)
+(require 'thingatpt) ; end-of-thing
+(require 'warnings) ; warning-numeric-level, display-warning
+(require 'compile) ; for some faces
+;; when-let*, if-let*, hash-table-keys, hash-table-values:
+(eval-when-compile (require 'subr-x))
(defgroup flymake nil
"Universal on-the-fly syntax checker."
@@ -43,7 +57,8 @@
:link '(custom-manual "(flymake) Top")
:group 'tools)
-(defcustom flymake-error-bitmap '(exclamation-mark error)
+(defcustom flymake-error-bitmap '(flymake-double-exclamation-mark
+ compilation-error)
"Bitmap (a symbol) used in the fringe for indicating errors.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
@@ -51,14 +66,13 @@ symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
- :group 'flymake
:version "24.3"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
-(defcustom flymake-warning-bitmap 'question-mark
+(defcustom flymake-warning-bitmap '(exclamation-mark compilation-warning)
"Bitmap (a symbol) used in the fringe for indicating warnings.
The value may also be a list of two elements where the second
element specifies the face for the bitmap. For possible bitmap
@@ -66,1176 +80,763 @@ symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
The option `flymake-fringe-indicator-position' controls how and where
this is used."
- :group 'flymake
:version "24.3"
:type '(choice (symbol :tag "Bitmap")
(list :tag "Bitmap and face"
(symbol :tag "Bitmap")
(face :tag "Face"))))
+(defcustom flymake-note-bitmap '(exclamation-mark compilation-info)
+ "Bitmap (a symbol) used in the fringe for indicating info notes.
+The value may also be a list of two elements where the second
+element specifies the face for the bitmap. For possible bitmap
+symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
+
+The option `flymake-fringe-indicator-position' controls how and where
+this is used."
+ :version "26.1"
+ :type '(choice (symbol :tag "Bitmap")
+ (list :tag "Bitmap and face"
+ (symbol :tag "Bitmap")
+ (face :tag "Face"))))
+
(defcustom flymake-fringe-indicator-position 'left-fringe
- "The position to put flymake fringe indicator.
+ "The position to put Flymake fringe indicator.
The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
See `flymake-error-bitmap' and `flymake-warning-bitmap'."
- :group 'flymake
:version "24.3"
:type '(choice (const left-fringe)
(const right-fringe)
(const :tag "No fringe indicators" nil)))
-(defcustom flymake-compilation-prevents-syntax-check t
- "If non-nil, don't start syntax check if compilation is running."
- :group 'flymake
- :type 'boolean)
-
(defcustom flymake-start-syntax-check-on-newline t
"Start syntax check if newline char was added/removed from the buffer."
- :group 'flymake
:type 'boolean)
(defcustom flymake-no-changes-timeout 0.5
- "Time to wait after last change before starting compilation."
- :group 'flymake
+ "Time to wait after last change before automatically checking buffer.
+If nil, never start checking buffer automatically like this."
:type 'number)
(defcustom flymake-gui-warnings-enabled t
"Enables/disables GUI warnings."
- :group 'flymake
:type 'boolean)
(make-obsolete-variable 'flymake-gui-warnings-enabled
"it no longer has any effect." "26.1")
-(defcustom flymake-start-syntax-check-on-find-file t
- "Start syntax check on find file."
- :group 'flymake
+(defcustom flymake-start-on-flymake-mode t
+ "Start syntax check when `flymake-mode' is enabled.
+Specifically, start it when the buffer is actually displayed."
:type 'boolean)
+(define-obsolete-variable-alias 'flymake-start-syntax-check-on-find-file
+ 'flymake-start-on-flymake-mode "26.1")
+
(defcustom flymake-log-level -1
- "Logging level, only messages with level lower or equal will be logged.
--1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG"
- :group 'flymake
+ "Obsolete and ignored variable."
:type 'integer)
+(make-obsolete-variable 'flymake-log-level
+ "it is superseded by `warning-minimum-log-level.'"
+ "26.1")
-(defcustom flymake-xml-program
- (if (executable-find "xmlstarlet") "xmlstarlet" "xml")
- "Program to use for XML validation."
- :type 'file
- :group 'flymake
- :version "24.4")
-
-(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest")
- "Dirs where to look for master files."
- :group 'flymake
- :type '(repeat (string)))
-
-(defcustom flymake-master-file-count-limit 32
- "Max number of master files to check."
- :group 'flymake
- :type 'integer)
+(defcustom flymake-wrap-around t
+ "If non-nil, moving to errors wraps around buffer boundaries."
+ :type 'boolean)
-(defcustom flymake-allowed-file-name-masks
- '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init)
- ("\\.xml\\'" flymake-xml-init)
- ("\\.html?\\'" flymake-xml-init)
- ("\\.cs\\'" flymake-simple-make-init)
- ("\\.p[ml]\\'" flymake-perl-init)
- ("\\.php[345]?\\'" flymake-php-init)
- ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup)
- ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup)
- ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup)
- ("\\.tex\\'" flymake-simple-tex-init)
- ("\\.idl\\'" flymake-simple-make-init)
- ;; ("\\.cpp\\'" 1)
- ;; ("\\.java\\'" 3)
- ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'")
- ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2))
- ;; ("\\.idl\\'" 1)
- ;; ("\\.odl\\'" 1)
- ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'")
- ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 ))
- ;; ("\\.tex\\'" 1)
- )
- "Files syntax checking is allowed for.
-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-simple-cleanup'.
-NAME is the file name function to use, default `flymake-get-real-file-name'."
- :group 'flymake
- :type '(alist :key-type (regexp :tag "File regexp")
- :value-type
- (list :tag "Handler functions"
- (function :tag "Init function")
- (choice :tag "Cleanup function"
- (const :tag "flymake-simple-cleanup" nil)
- function)
- (choice :tag "Name function"
- (const :tag "flymake-get-real-file-name" nil)
- function))))
-
-(defvar-local flymake-is-running nil
- "If t, flymake syntax check process is running for the current buffer.")
+(when (fboundp 'define-fringe-bitmap)
+ (define-fringe-bitmap 'flymake-double-exclamation-mark
+ (vector #b00000000
+ #b00000000
+ #b00000000
+ #b00000000
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b01100110
+ #b00000000
+ #b01100110
+ #b00000000
+ #b00000000
+ #b00000000)))
(defvar-local flymake-timer nil
"Timer for starting syntax check.")
-(defvar-local flymake-last-change-time nil
- "Time of last buffer change.")
-
(defvar-local flymake-check-start-time nil
"Time at which syntax check was started.")
-(defvar-local flymake-check-was-interrupted nil
- "Non-nil if syntax check was killed by `flymake-compile'.")
-
-(defvar-local flymake-err-info nil
- "Sorted list of line numbers and lists of err info in the form (file, err-text).")
-
-(defvar-local flymake-new-err-info nil
- "Same as `flymake-err-info', effective when a syntax check is in progress.")
-
-(defun flymake-log (level text &rest args)
- "Log a message at level LEVEL.
-If LEVEL is higher than `flymake-log-level', the message is
-ignored. Otherwise, it is printed using `message'.
-TEXT is a format control string, and the remaining arguments ARGS
-are the string substitutions (see the function `format')."
- (if (<= level flymake-log-level)
- (let* ((msg (apply #'format-message text args)))
- (message "%s" msg))))
-
-(defun flymake-ins-after (list pos val)
- "Insert VAL into LIST after position POS.
-POS counts from zero."
- (let ((tmp (copy-sequence list)))
- (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp)))
- tmp))
-
-(defun flymake-set-at (list pos val)
- "Set VAL at position POS in LIST.
-POS counts from zero."
- (let ((tmp (copy-sequence list)))
- (setcar (nthcdr pos tmp) val)
- tmp))
-
-(defvar flymake-processes nil
- "List of currently active flymake processes.")
-
-(defvar-local flymake-output-residual nil)
-
-(defun flymake-get-file-name-mode-and-masks (file-name)
- "Return the corresponding entry from `flymake-allowed-file-name-masks'."
- (unless (stringp file-name)
- (error "Invalid file-name"))
- (let ((fnm flymake-allowed-file-name-masks)
- (mode-and-masks nil))
- (while (and (not mode-and-masks) fnm)
- (if (string-match (car (car fnm)) file-name)
- (setq mode-and-masks (cdr (car fnm))))
- (setq fnm (cdr fnm)))
- (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks))
- mode-and-masks))
-
-(defun flymake-can-syntax-check-file (file-name)
- "Determine whether we can syntax check FILE-NAME.
-Return nil if we cannot, non-nil if we can."
- (if (flymake-get-init-function file-name) t nil))
-
-(defun flymake-get-init-function (file-name)
- "Return init function to be used for the file."
- (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name))))
- ;;(flymake-log 0 "calling %s" init-f)
- ;;(funcall init-f (current-buffer))
- init-f))
-
-(defun flymake-get-cleanup-function (file-name)
- "Return cleanup function to be used for the file."
- (or (nth 1 (flymake-get-file-name-mode-and-masks file-name))
- 'flymake-simple-cleanup))
-
-(defun flymake-get-real-file-name-function (file-name)
- (or (nth 2 (flymake-get-file-name-mode-and-masks file-name))
- 'flymake-get-real-file-name))
-
-(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal))
-
-(defun flymake-get-buildfile-from-cache (dir-name)
- "Look up DIR-NAME in cache and return its associated value.
-If DIR-NAME is not found, return nil."
- (gethash dir-name flymake-find-buildfile-cache))
-
-(defun flymake-add-buildfile-to-cache (dir-name buildfile)
- "Associate DIR-NAME with BUILDFILE in the buildfile cache."
- (puthash dir-name buildfile flymake-find-buildfile-cache))
-
-(defun flymake-clear-buildfile-cache ()
- "Clear the buildfile cache."
- (clrhash flymake-find-buildfile-cache))
-
-(defun flymake-find-buildfile (buildfile-name source-dir-name)
- "Find buildfile starting from current directory.
-Buildfile includes Makefile, build.xml etc.
-Return its file name if found, or nil if not found."
- (or (flymake-get-buildfile-from-cache source-dir-name)
- (let* ((file (locate-dominating-file source-dir-name buildfile-name)))
- (if file
- (progn
- (flymake-log 3 "found buildfile at %s" file)
- (flymake-add-buildfile-to-cache source-dir-name file)
- file)
- (progn
- (flymake-log 3 "buildfile for %s not found" source-dir-name)
- nil)))))
-
-(defun flymake-fix-file-name (name)
- "Replace all occurrences of `\\' with `/'."
- (when name
- (setq name (expand-file-name name))
- (setq name (abbreviate-file-name name))
- (setq name (directory-file-name name))
- name))
-
-(defun flymake-same-files (file-name-one file-name-two)
- "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file.
-Return t if so, nil if not."
- (equal (flymake-fix-file-name file-name-one)
- (flymake-fix-file-name file-name-two)))
-
-;; This is bound dynamically to pass a parameter to a sort predicate below
-(defvar flymake-included-file-name)
-
-(defun flymake-find-possible-master-files (file-name master-file-dirs masks)
- "Find (by name and location) all possible master files.
-
-Name is specified by FILE-NAME and location is specified by
-MASTER-FILE-DIRS. Master files include .cpp and .c for .h.
-Files are searched for starting from the .h directory and max
-max-level parent dirs. File contents are not checked."
- (let* ((dirs master-file-dirs)
- (files nil)
- (done nil))
-
- (while (and (not done) dirs)
- (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name)))
- (masks masks))
- (while (and (file-exists-p dir) (not done) masks)
- (let* ((mask (car masks))
- (dir-files (directory-files dir t mask)))
-
- (flymake-log 3 "dir %s, %d file(s) for mask %s"
- dir (length dir-files) mask)
- (while (and (not done) dir-files)
- (when (not (file-directory-p (car dir-files)))
- (setq files (cons (car dir-files) files))
- (when (>= (length files) flymake-master-file-count-limit)
- (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit)
- (setq done t)))
- (setq dir-files (cdr dir-files))))
- (setq masks (cdr masks))))
- (setq dirs (cdr dirs)))
- (when files
- (let ((flymake-included-file-name (file-name-nondirectory file-name)))
- (setq files (sort files 'flymake-master-file-compare))))
- (flymake-log 3 "found %d possible master file(s)" (length files))
- files))
-
-(defun flymake-master-file-compare (file-one file-two)
- "Compare two files specified by FILE-ONE and FILE-TWO.
-This function is used in sort to move most possible file names
-to the beginning of the list (File.h -> File.cpp moved to top)."
- (and (equal (file-name-sans-extension flymake-included-file-name)
- (file-name-base file-one))
- (not (equal file-one file-two))))
-
-(defvar flymake-check-file-limit 8192
- "Maximum number of chars to look at when checking possible master file.
-Nil means search the entire file.")
-
-(defun flymake-check-patch-master-file-buffer
- (master-file-temp-buffer
- master-file-name patched-master-file-name
- source-file-name patched-source-file-name
- include-dirs regexp)
- "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME.
-If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME
-instead of SOURCE-FILE-NAME.
-
-For example, foo.cpp is a master file if it includes foo.h.
-
-When a buffer for MASTER-FILE-NAME exists, use it as a source
-instead of reading master file from disk."
- (let* ((source-file-nondir (file-name-nondirectory source-file-name))
- (source-file-extension (file-name-extension source-file-nondir))
- (source-file-nonext (file-name-sans-extension source-file-nondir))
- (found nil)
- (inc-name nil)
- (search-limit flymake-check-file-limit))
- (setq regexp
- (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\""
- ;; Hack for tex files, where \include often excludes .tex.
- ;; Maybe this is safe generally.
- (if (and (> (length source-file-extension) 1)
- (string-equal source-file-extension "tex"))
- (format "%s\\(?:\\.%s\\)?"
- (regexp-quote source-file-nonext)
- (regexp-quote source-file-extension))
- (regexp-quote source-file-nondir))))
- (unwind-protect
- (with-current-buffer master-file-temp-buffer
- (if (or (not search-limit)
- (> search-limit (point-max)))
- (setq search-limit (point-max)))
- (flymake-log 3 "checking %s against regexp %s"
- master-file-name regexp)
- (goto-char (point-min))
- (while (and (< (point) search-limit)
- (re-search-forward regexp search-limit t))
- (let ((match-beg (match-beginning 1))
- (match-end (match-end 1)))
-
- (flymake-log 3 "found possible match for %s" source-file-nondir)
- (setq inc-name (match-string 1))
- (and (> (length source-file-extension) 1)
- (string-equal source-file-extension "tex")
- (not (string-match (format "\\.%s\\'" source-file-extension)
- inc-name))
- (setq inc-name (concat inc-name "." source-file-extension)))
- (when (eq t (compare-strings
- source-file-nondir nil nil
- inc-name (- (length inc-name)
- (length source-file-nondir)) nil))
- (flymake-log 3 "inc-name=%s" inc-name)
- (when (flymake-check-include source-file-name inc-name
- include-dirs)
- (setq found t)
- ;; replace-match is not used here as it fails in
- ;; XEmacs with 'last match not a buffer' error as
- ;; check-includes calls replace-in-string
- (flymake-replace-region
- match-beg match-end
- (file-name-nondirectory patched-source-file-name))))
- (forward-line 1)))
- (when found
- (flymake-save-buffer-in-file patched-master-file-name)))
- ;;+(flymake-log 3 "killing buffer %s"
- ;; (buffer-name master-file-temp-buffer))
- (kill-buffer master-file-temp-buffer))
- ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found)
- (when found
- (flymake-log 2 "found master file %s" master-file-name))
- found))
-
-;;; XXX: remove
-(defun flymake-replace-region (beg end rep)
- "Replace text in BUFFER in region (BEG END) with REP."
- (save-excursion
- (goto-char end)
- ;; Insert before deleting, so as to better preserve markers's positions.
- (insert rep)
- (delete-region beg end)))
-
-(defun flymake-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))
-
-(defun flymake-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))))
- (insert-buffer-substring buffer)
- (current-buffer)))
-
-(defun flymake-check-include (source-file-name inc-name include-dirs)
- "Check if SOURCE-FILE-NAME can be found in include path.
-Return t if it can be found via include path using INC-NAME."
- (if (file-name-absolute-p inc-name)
- (flymake-same-files source-file-name inc-name)
- (while (and include-dirs
- (not (flymake-same-files
- source-file-name
- (concat (file-name-directory source-file-name)
- "/" (car include-dirs)
- "/" inc-name))))
- (setq include-dirs (cdr include-dirs)))
- include-dirs))
-
-(defun flymake-find-buffer-for-file (file-name)
- "Check if there exists a buffer visiting FILE-NAME.
-Return t if so, nil if not."
- (let ((buffer-name (get-file-buffer file-name)))
- (if buffer-name
- (get-buffer buffer-name))))
-
-(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp)
- "Save SOURCE-FILE-NAME with a different name.
-Find master file, patch and save it."
- (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks))
- (master-file-count (length possible-master-files))
- (idx 0)
- (temp-buffer nil)
- (master-file-name nil)
- (patched-master-file-name nil)
- (found nil))
-
- (while (and (not found) (< idx master-file-count))
- (setq master-file-name (nth idx possible-master-files))
- (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master"))
- (if (flymake-find-buffer-for-file master-file-name)
- (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name)))
- (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name)))
- (setq found
- (flymake-check-patch-master-file-buffer
- temp-buffer
- master-file-name
- patched-master-file-name
- source-file-name
- patched-source-file-name
- (funcall get-incl-dirs-f (file-name-directory master-file-name))
- include-regexp))
- (setq idx (1+ idx)))
- (if found
- (list master-file-name patched-master-file-name)
- (progn
- (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count
- (file-name-nondirectory source-file-name))
- nil))))
-
-(defun flymake-save-buffer-in-file (file-name)
- "Save the entire buffer contents into file FILE-NAME.
-Create parent directories as needed."
- (make-directory (file-name-directory file-name) 1)
- (write-region nil nil file-name nil 566)
- (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name))
-
-(defun flymake-process-filter (process output)
- "Parse OUTPUT and highlight error lines.
-It's flymake process filter."
- (let ((source-buffer (process-buffer process)))
-
- (flymake-log 3 "received %d byte(s) of output from process %d"
- (length output) (process-id process))
- (when (buffer-live-p source-buffer)
- (with-current-buffer source-buffer
- (flymake-parse-output-and-residual output)))))
-
-(defun flymake-process-sentinel (process _event)
- "Sentinel for syntax check buffers."
- (when (memq (process-status process) '(signal exit))
- (let* ((exit-status (process-exit-status process))
- (command (process-command process))
- (source-buffer (process-buffer process))
- (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer))))
-
- (flymake-log 2 "process %d exited with code %d"
- (process-id process) exit-status)
- (condition-case err
- (progn
- (flymake-log 3 "cleaning up using %s" cleanup-f)
- (when (buffer-live-p source-buffer)
- (with-current-buffer source-buffer
- (funcall cleanup-f)))
-
- (delete-process process)
- (setq flymake-processes (delq process flymake-processes))
-
- (when (buffer-live-p source-buffer)
- (with-current-buffer source-buffer
-
- (flymake-parse-residual)
- (flymake-post-syntax-check exit-status command)
- (setq flymake-is-running nil))))
- (error
- (let ((err-str (format "Error in process sentinel for buffer %s: %s"
- source-buffer (error-message-string err))))
- (flymake-log 0 err-str)
- (with-current-buffer source-buffer
- (setq flymake-is-running nil))))))))
-
-(defun flymake-post-syntax-check (exit-status command)
+(defun flymake--log-1 (level sublog msg &rest args)
+ "Do actual work for `flymake-log'."
+ (let (;; never popup the log buffer
+ (warning-minimum-level :emergency)
+ (warning-type-format
+ (format " [%s %s]"
+ (or sublog 'flymake)
+ (current-buffer))))
+ (display-warning (list 'flymake sublog)
+ (apply #'format-message msg args)
+ (if (numberp level)
+ (or (nth level
+ '(:emergency :error :warning :debug :debug) )
+ :error)
+ level)
+ "*Flymake log*")))
+
+(defun flymake-switch-to-log-buffer ()
+ "Go to the *Flymake log* buffer."
+ (interactive)
+ (switch-to-buffer "*Flymake log*"))
+
+;;;###autoload
+(defmacro flymake-log (level msg &rest args)
+ "Log, at level LEVEL, the message MSG formatted with ARGS.
+LEVEL is passed to `display-warning', which is used to display
+the warning. If this form is included in a byte-compiled file,
+the generated warning contains an indication of the file that
+generated it."
+ (let* ((compile-file (and (boundp 'byte-compile-current-file)
+ (symbol-value 'byte-compile-current-file)))
+ (sublog (if (and
+ compile-file
+ (not load-file-name))
+ (intern
+ (file-name-nondirectory
+ (file-name-sans-extension compile-file))))))
+ `(flymake--log-1 ,level ',sublog ,msg ,@args)))
+
+(defun flymake-error (text &rest args)
+ "Format TEXT with ARGS and signal an error for Flymake."
+ (let ((msg (apply #'format-message text args)))
+ (flymake-log :error msg)
+ (error (concat "[Flymake] " msg))))
+
+(cl-defstruct (flymake--diag
+ (:constructor flymake--diag-make))
+ buffer beg end type text backend)
+
+;;;###autoload
+(defun flymake-make-diagnostic (buffer
+ beg
+ end
+ type
+ text)
+ "Make a Flymake diagnostic for BUFFER's region from BEG to END.
+TYPE is a key to `flymake-diagnostic-types-alist' and TEXT is a
+description of the problem detected in this region."
+ (flymake--diag-make :buffer buffer :beg beg :end end :type type :text text))
+
+;;;###autoload
+(defun flymake-diagnostics (&optional beg end)
+ "Get Flymake diagnostics in region determined by BEG and END.
+
+If neither BEG or END is supplied, use the whole buffer,
+otherwise if BEG is non-nil and END is nil, consider only
+diagnostics at BEG."
+ (mapcar (lambda (ov) (overlay-get ov 'flymake-diagnostic))
+ (flymake--overlays :beg beg :end end)))
+
+(defmacro flymake--diag-accessor (public internal thing)
+ "Make PUBLIC an alias for INTERNAL, add doc using THING."
+ `(defsubst ,public (diag)
+ ,(format "Get Flymake diagnostic DIAG's %s." (symbol-name thing))
+ (,internal diag)))
+
+(flymake--diag-accessor flymake-diagnostic-buffer flymake--diag-buffer buffer)
+(flymake--diag-accessor flymake-diagnostic-text flymake--diag-text text)
+(flymake--diag-accessor flymake-diagnostic-type flymake--diag-type type)
+(flymake--diag-accessor flymake-diagnostic-beg flymake--diag-beg beg)
+(flymake--diag-accessor flymake-diagnostic-end flymake--diag-end end)
+(flymake--diag-accessor flymake-diagnostic-backend flymake--diag-backend backend)
+
+(cl-defun flymake--overlays (&key beg end filter compare key)
+ "Get flymake-related overlays.
+If BEG is non-nil and END is nil, consider only `overlays-at'
+BEG. Otherwise consider `overlays-in' the region comprised by BEG
+and END, defaulting to the whole buffer. Remove all that do not
+verify FILTER, a function, and sort them by COMPARE (using KEY)."
(save-restriction
(widen)
- (setq flymake-err-info flymake-new-err-info)
- (setq flymake-new-err-info nil)
- (setq flymake-err-info
- (flymake-fix-line-numbers
- flymake-err-info 1 (count-lines (point-min) (point-max))))
- (flymake-delete-own-overlays)
- (flymake-highlight-err-lines flymake-err-info)
- (let (err-count warn-count)
- (setq err-count (flymake-get-err-count flymake-err-info "e"))
- (setq warn-count (flymake-get-err-count flymake-err-info "w"))
- (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)"
- (buffer-name) err-count warn-count
- (- (float-time) flymake-check-start-time))
- (setq flymake-check-start-time nil)
-
- (if (and (equal 0 err-count) (equal 0 warn-count))
- (if (equal 0 exit-status)
- (flymake-report-status "" "") ; PASSED
- (if (not flymake-check-was-interrupted)
- (flymake-report-fatal-status "CFGERR"
- (format "Configuration error has occurred while running %s" command))
- (flymake-report-status nil ""))) ; "STOPPED"
- (flymake-report-status (format "%d/%d" err-count warn-count) "")))))
-
-(defun flymake-parse-output-and-residual (output)
- "Split OUTPUT into lines, merge in residual if necessary."
- (let* ((buffer-residual flymake-output-residual)
- (total-output (if buffer-residual (concat buffer-residual output) output))
- (lines-and-residual (flymake-split-output total-output))
- (lines (nth 0 lines-and-residual))
- (new-residual (nth 1 lines-and-residual)))
- (setq flymake-output-residual new-residual)
- (setq flymake-new-err-info
- (flymake-parse-err-lines
- flymake-new-err-info lines))))
-
-(defun flymake-parse-residual ()
- "Parse residual if it's non empty."
- (when flymake-output-residual
- (setq flymake-new-err-info
- (flymake-parse-err-lines
- flymake-new-err-info
- (list flymake-output-residual)))
- (setq flymake-output-residual nil)))
-
-(defun flymake-er-make-er (line-no line-err-info-list)
- (list line-no line-err-info-list))
-
-(defun flymake-er-get-line (err-info)
- (nth 0 err-info))
-
-(defun flymake-er-get-line-err-info-list (err-info)
- (nth 1 err-info))
-
-(cl-defstruct (flymake-ler
- (:constructor nil)
- (:constructor flymake-ler-make-ler (file line type text &optional full-file)))
- file line type text full-file)
-
-(defun flymake-ler-set-file (line-err-info file)
- (flymake-ler-make-ler file
- (flymake-ler-line line-err-info)
- (flymake-ler-type line-err-info)
- (flymake-ler-text line-err-info)
- (flymake-ler-full-file line-err-info)))
-
-(defun flymake-ler-set-full-file (line-err-info full-file)
- (flymake-ler-make-ler (flymake-ler-file line-err-info)
- (flymake-ler-line line-err-info)
- (flymake-ler-type line-err-info)
- (flymake-ler-text line-err-info)
- full-file))
-
-(defun flymake-ler-set-line (line-err-info line)
- (flymake-ler-make-ler (flymake-ler-file line-err-info)
- line
- (flymake-ler-type line-err-info)
- (flymake-ler-text line-err-info)
- (flymake-ler-full-file line-err-info)))
-
-(defun flymake-get-line-err-count (line-err-info-list type)
- "Return number of errors of specified TYPE.
-Value of TYPE is either \"e\" or \"w\"."
- (let* ((idx 0)
- (count (length line-err-info-list))
- (err-count 0))
-
- (while (< idx count)
- (when (equal type (flymake-ler-type (nth idx line-err-info-list)))
- (setq err-count (1+ err-count)))
- (setq idx (1+ idx)))
- err-count))
-
-(defun flymake-get-err-count (err-info-list type)
- "Return number of errors of specified TYPE for ERR-INFO-LIST."
- (let* ((idx 0)
- (count (length err-info-list))
- (err-count 0))
- (while (< idx count)
- (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type)))
- (setq idx (1+ idx)))
- err-count))
-
-(defun flymake-fix-line-numbers (err-info-list min-line max-line)
- "Replace line numbers with fixed value.
-If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE.
-If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE.
-The reason for this fix is because some compilers might report
-line number outside the file being compiled."
- (let* ((count (length err-info-list))
- (err-info nil)
- (line 0))
- (while (> count 0)
- (setq err-info (nth (1- count) err-info-list))
- (setq line (flymake-er-get-line err-info))
- (when (or (< line min-line) (> line max-line))
- (setq line (if (< line min-line) min-line max-line))
- (setq err-info-list (flymake-set-at err-info-list (1- count)
- (flymake-er-make-er line
- (flymake-er-get-line-err-info-list err-info)))))
- (setq count (1- count))))
- err-info-list)
-
-(defun flymake-highlight-err-lines (err-info-list)
- "Highlight error lines in BUFFER using info from ERR-INFO-LIST."
- (save-excursion
- (dolist (err err-info-list)
- (flymake-highlight-line (car err) (nth 1 err)))))
-
-(defun flymake-overlay-p (ov)
- "Determine whether overlay OV was created by flymake."
- (and (overlayp ov) (overlay-get ov 'flymake-overlay)))
-
-(defun flymake-make-overlay (beg end tooltip-text face bitmap)
- "Allocate a flymake overlay in range BEG and END."
- (when (not (flymake-region-has-flymake-overlays beg end))
- (let ((ov (make-overlay beg end nil t))
- (fringe (and flymake-fringe-indicator-position
- (propertize "!" 'display
- (cons flymake-fringe-indicator-position
- (if (listp bitmap)
- bitmap
- (list bitmap)))))))
- (overlay-put ov 'face face)
- (overlay-put ov 'help-echo tooltip-text)
- (overlay-put ov 'flymake-overlay t)
- (overlay-put ov 'priority 100)
- (overlay-put ov 'evaporate t)
- (overlay-put ov 'before-string fringe)
- ;;+(flymake-log 3 "created overlay %s" ov)
- ov)
- (flymake-log 3 "created an overlay at (%d-%d)" beg end)))
-
-(defun flymake-delete-own-overlays ()
- "Delete all flymake overlays in BUFFER."
- (dolist (ol (overlays-in (point-min) (point-max)))
- (when (flymake-overlay-p ol)
- (delete-overlay ol)
- ;;+(flymake-log 3 "deleted overlay %s" ol)
- )))
-
-(defun flymake-region-has-flymake-overlays (beg end)
- "Check if region specified by BEG and END has overlay.
-Return t if it has at least one flymake overlay, nil if no overlay."
- (let ((ov (overlays-in beg end))
- (has-flymake-overlays nil))
- (while (consp ov)
- (when (flymake-overlay-p (car ov))
- (setq has-flymake-overlays t))
- (setq ov (cdr ov)))
- has-flymake-overlays))
-
-(defface flymake-errline
+ (let ((ovs (cl-remove-if-not
+ (lambda (ov)
+ (and (overlay-get ov 'flymake-diagnostic)
+ (or (not filter)
+ (funcall filter ov))))
+ (if (and beg (null end))
+ (overlays-at beg t)
+ (overlays-in (or beg (point-min))
+ (or end (point-max)))))))
+ (if compare
+ (cl-sort ovs compare :key (or key
+ #'identity))
+ ovs))))
+
+(defun flymake-delete-own-overlays (&optional filter)
+ "Delete all Flymake overlays in BUFFER."
+ (mapc #'delete-overlay (flymake--overlays :filter filter)))
+
+(defface flymake-error
'((((supports :underline (:style wave)))
:underline (:style wave :color "Red1"))
(t
:inherit error))
- "Face used for marking error lines."
- :version "24.4"
- :group 'flymake)
+ "Face used for marking error regions."
+ :version "24.4")
-(defface flymake-warnline
+(defface flymake-warning
'((((supports :underline (:style wave)))
- :underline (:style wave :color "DarkOrange"))
+ :underline (:style wave :color "deep sky blue"))
(t
:inherit warning))
- "Face used for marking warning lines."
- :version "24.4"
- :group 'flymake)
-
-(defun flymake-highlight-line (line-no line-err-info-list)
- "Highlight line LINE-NO in current buffer.
-Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
- (goto-char (point-min))
- (forward-line (1- line-no))
- (pcase-let* ((beg (progn (back-to-indentation) (point)))
- (end (progn
- (end-of-line)
- (skip-chars-backward " \t\f\t\n" beg)
- (if (eq (point) beg)
- (line-beginning-position 2)
- (point))))
- (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n"))
- (`(,face ,bitmap)
- (if (> (flymake-get-line-err-count line-err-info-list "e") 0)
- (list 'flymake-errline flymake-error-bitmap)
- (list 'flymake-warnline flymake-warning-bitmap))))
- (flymake-make-overlay beg end tooltip-text face bitmap)))
-
-(defun flymake-parse-err-lines (err-info-list lines)
- "Parse err LINES, store info in ERR-INFO-LIST."
- (let* ((count (length lines))
- (idx 0)
- (line-err-info nil)
- (real-file-name nil)
- (source-file-name buffer-file-name)
- (get-real-file-name-f (flymake-get-real-file-name-function source-file-name)))
-
- (while (< idx count)
- (setq line-err-info (flymake-parse-line (nth idx lines)))
- (when line-err-info
- (setq real-file-name (funcall get-real-file-name-f
- (flymake-ler-file line-err-info)))
- (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name))
-
- (when (flymake-same-files real-file-name source-file-name)
- (setq line-err-info (flymake-ler-set-file line-err-info nil))
- (setq err-info-list (flymake-add-err-info err-info-list line-err-info))))
- (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no"))
- (setq idx (1+ idx)))
- err-info-list))
-
-(defun flymake-split-output (output)
- "Split OUTPUT into lines.
-Return last one as residual if it does not end with newline char.
-Returns ((LINES) RESIDUAL)."
- (when (and output (> (length output) 0))
- (let* ((lines (split-string output "[\n\r]+" t))
- (complete (equal "\n" (char-to-string (aref output (1- (length output))))))
- (residual nil))
- (when (not complete)
- (setq residual (car (last lines)))
- (setq lines (butlast lines)))
- (list lines residual))))
-
-(defun flymake-reformat-err-line-patterns-from-compile-el (original-list)
- "Grab error line patterns from ORIGINAL-LIST in compile.el format.
-Convert it to flymake internal format."
- (let* ((converted-list '()))
- (dolist (item original-list)
- (setq item (cdr item))
- (let ((regexp (nth 0 item))
- (file (nth 1 item))
- (line (nth 2 item))
- (col (nth 3 item)))
- (if (consp file) (setq file (car file)))
- (if (consp line) (setq line (car line)))
- (if (consp col) (setq col (car col)))
-
- (when (not (functionp line))
- (setq converted-list (cons (list regexp file line col) converted-list)))))
- converted-list))
-
-(require 'compile)
-
-(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text
- (append
- '(
- ;; MS Visual C++ 6.0
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
- 1 3 nil 4)
- ;; jikes
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)"
- 1 3 nil 4)
- ;; MS midl
- ("midl[ ]*:[ ]*\\(command line error .*\\)"
- nil nil nil 1)
- ;; MS C#
- ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
- 1 3 nil 4)
- ;; perl
- ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1)
- ;; PHP
- ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1)
- ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1)
- ;; ant/javac. Note this also matches gcc warnings!
- (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)"
- 2 4 nil 5))
- ;; compilation-error-regexp-alist)
- (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
- "Patterns for matching error/warning lines. Each pattern has the form
-\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX).
-Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns
-from compile.el")
-
-(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4")
-(defvar flymake-warning-predicate "^[wW]arning"
- "Predicate matching against error text to detect a warning.
-Takes a single argument, the error's text and should return non-nil
-if it's a warning.
-Instead of a function, it can also be a regular expression.")
-
-(defun flymake-parse-line (line)
- "Parse LINE to see if it is an error or warning.
-Return its components if so, nil otherwise."
- (let ((raw-file-name nil)
- (line-no 0)
- (err-type "e")
- (err-text nil)
- (patterns flymake-err-line-patterns)
- (matched nil))
- (while (and patterns (not matched))
- (when (string-match (car (car patterns)) line)
- (let* ((file-idx (nth 1 (car patterns)))
- (line-idx (nth 2 (car patterns))))
-
- (setq raw-file-name (if file-idx (match-string file-idx line) nil))
- (setq line-no (if line-idx (string-to-number
- (match-string line-idx line)) 0))
- (setq err-text (if (> (length (car patterns)) 4)
- (match-string (nth 4 (car patterns)) line)
- (flymake-patch-err-text
- (substring line (match-end 0)))))
- (if (null err-text)
- (setq err-text "<no error text>")
- (when (cond ((stringp flymake-warning-predicate)
- (string-match flymake-warning-predicate err-text))
- ((functionp flymake-warning-predicate)
- (funcall flymake-warning-predicate err-text)))
- (setq err-type "w")))
- (flymake-log
- 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s"
- file-idx line-idx raw-file-name line-no err-text)
- (setq matched t)))
- (setq patterns (cdr patterns)))
- (if matched
- (flymake-ler-make-ler raw-file-name line-no err-type err-text)
- ())))
-
-(defun flymake-find-err-info (err-info-list line-no)
- "Find (line-err-info-list pos) for specified LINE-NO."
- (if err-info-list
- (let* ((line-err-info-list nil)
- (pos 0)
- (count (length err-info-list)))
-
- (while (and (< pos count) (< (car (nth pos err-info-list)) line-no))
- (setq pos (1+ pos)))
- (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no))
- (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list))))
- (list line-err-info-list pos))
- '(nil 0)))
-
-(defun flymake-line-err-info-is-less-or-equal (line-one line-two)
- (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two))
- (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
- (not (flymake-ler-file line-one)) (flymake-ler-file line-two))
- (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
- (or (and (flymake-ler-file line-one) (flymake-ler-file line-two))
- (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two)))))))
-
-(defun flymake-add-line-err-info (line-err-info-list line-err-info)
- "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO.
-For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'.
-The new element is inserted in the proper position, according to
-the predicate `flymake-line-err-info-is-less-or-equal'.
-The updated value of LINE-ERR-INFO-LIST is returned."
- (if (not line-err-info-list)
- (list line-err-info)
- (let* ((count (length line-err-info-list))
- (idx 0))
- (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info))
- (setq idx (1+ idx)))
- (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list)))
- (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info))))
- line-err-info-list)))
-
-(defun flymake-add-err-info (err-info-list line-err-info)
- "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order.
-Returns the updated value of ERR-INFO-LIST.
-For the format of ERR-INFO-LIST, see `flymake-err-info'.
-For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
- (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info)))
- (info-and-pos (flymake-find-err-info err-info-list line-no))
- (exists (car info-and-pos))
- (pos (nth 1 info-and-pos))
- (line-err-info-list nil)
- (err-info nil))
-
- (if exists
- (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list)))))
- (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info))
-
- (setq err-info (flymake-er-make-er line-no line-err-info-list))
- (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info)))
- ((equal 0 pos) (setq err-info-list (cons err-info err-info-list)))
- (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info))))
- err-info-list))
-
-(defun flymake-get-project-include-dirs-imp (basedir)
- "Include dirs for the project current file belongs to."
- (if (flymake-get-project-include-dirs-from-cache basedir)
- (progn
- (flymake-get-project-include-dirs-from-cache basedir))
- ;;else
- (let* ((command-line (concat "make -C "
- (shell-quote-argument basedir)
- " DUMPVARS=INCLUDE_DIRS dumpvars"))
- (output (shell-command-to-string command-line))
- (lines (split-string output "\n" t))
- (count (length lines))
- (idx 0)
- (inc-dirs nil))
- (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines))))
- (setq idx (1+ idx)))
- (when (< idx count)
- (let* ((inc-lines (split-string (nth idx lines) " *-I" t))
- (inc-count (length inc-lines)))
- (while (> inc-count 0)
- (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines)))
- (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))
- (setq inc-count (1- inc-count)))))
- (flymake-add-project-include-dirs-to-cache basedir inc-dirs)
- inc-dirs)))
-
-(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp
- "Function used to get project include dirs, one parameter: basedir name.")
-
-(defun flymake-get-project-include-dirs (basedir)
- (funcall flymake-get-project-include-dirs-function basedir))
-
-(defun flymake-get-system-include-dirs ()
- "System include dirs - from the `INCLUDE' env setting."
- (let* ((includes (getenv "INCLUDE")))
- (if includes (split-string includes path-separator t) nil)))
-
-(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal))
-
-(defun flymake-get-project-include-dirs-from-cache (base-dir)
- (gethash base-dir flymake-project-include-dirs-cache))
-
-(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs)
- (puthash base-dir include-dirs flymake-project-include-dirs-cache))
-
-(defun flymake-clear-project-include-dirs-cache ()
- (clrhash flymake-project-include-dirs-cache))
-
-(defun flymake-get-include-dirs (base-dir)
- "Get dirs to use when resolving local file names."
- (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs))))
- include-dirs))
-
-;; (defun flymake-restore-formatting ()
-;; "Remove any formatting made by flymake."
-;; )
-
-;; (defun flymake-get-program-dir (buffer)
-;; "Get dir to start program in."
-;; (unless (bufferp buffer)
-;; (error "Invalid buffer"))
-;; (with-current-buffer buffer
-;; default-directory))
-
-(defun flymake-safe-delete-file (file-name)
- (when (and file-name (file-exists-p file-name))
- (delete-file file-name)
- (flymake-log 1 "deleted file %s" file-name)))
-
-(defun flymake-safe-delete-directory (dir-name)
- (condition-case nil
- (progn
- (delete-directory dir-name)
- (flymake-log 1 "deleted dir %s" dir-name))
- (error
- (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name))))
-
-(defun flymake-start-syntax-check ()
- "Start syntax checking for current buffer."
- (interactive)
- (flymake-log 3 "flymake is running: %s" flymake-is-running)
- (when (and (not flymake-is-running)
- (flymake-can-syntax-check-file buffer-file-name))
- (when (or (not flymake-compilation-prevents-syntax-check)
- (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP")
- (flymake-clear-buildfile-cache)
- (flymake-clear-project-include-dirs-cache)
-
- (setq flymake-check-was-interrupted nil)
-
- (let* ((source-file-name buffer-file-name)
- (init-f (flymake-get-init-function source-file-name))
- (cleanup-f (flymake-get-cleanup-function source-file-name))
- (cmd-and-args (funcall init-f))
- (cmd (nth 0 cmd-and-args))
- (args (nth 1 cmd-and-args))
- (dir (nth 2 cmd-and-args)))
- (if (not cmd-and-args)
- (progn
- (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name)
- (funcall cleanup-f))
- (progn
- (setq flymake-last-change-time nil)
- (flymake-start-syntax-check-process cmd args dir)))))))
-
-(defun flymake-start-syntax-check-process (cmd args dir)
- "Start syntax check process."
- (condition-case err
- (let* ((process
- (let ((default-directory (or dir default-directory)))
- (when dir
- (flymake-log 3 "starting process on dir %s" dir))
- (apply 'start-file-process
- "flymake-proc" (current-buffer) cmd args))))
- (set-process-sentinel process 'flymake-process-sentinel)
- (set-process-filter process 'flymake-process-filter)
- (set-process-query-on-exit-flag process nil)
- (push process flymake-processes)
-
- (setq flymake-is-running t)
- (setq flymake-last-change-time nil)
- (setq flymake-check-start-time (float-time))
-
- (flymake-report-status nil "*")
- (flymake-log 2 "started process %d, command=%s, dir=%s"
- (process-id process) (process-command process)
- default-directory)
- process)
- (error
- (let* ((err-str
- (format-message
- "Failed to launch syntax check process `%s' with args %s: %s"
- cmd args (error-message-string err)))
- (source-file-name buffer-file-name)
- (cleanup-f (flymake-get-cleanup-function source-file-name)))
- (flymake-log 0 err-str)
- (funcall cleanup-f)
- (flymake-report-fatal-status "PROCERR" err-str)))))
-
-(defun flymake-kill-process (proc)
- "Kill process PROC."
- (kill-process proc)
- (let* ((buf (process-buffer proc)))
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (setq flymake-check-was-interrupted t))))
- (flymake-log 1 "killed process %d" (process-id proc)))
-
-(defun flymake-stop-all-syntax-checks ()
- "Kill all syntax check processes."
- (interactive)
- (while flymake-processes
- (flymake-kill-process (pop flymake-processes))))
+ "Face used for marking warning regions."
+ :version "24.4")
-(defun flymake-compilation-is-running ()
- (and (boundp 'compilation-in-progress)
- compilation-in-progress))
+(defface flymake-note
+ '((((supports :underline (:style wave)))
+ :underline (:style wave :color "yellow green"))
+ (t
+ :inherit warning))
+ "Face used for marking note regions."
+ :version "26.1")
-(defun flymake-compile ()
- "Kill all flymake syntax checks, start compilation."
- (interactive)
- (flymake-stop-all-syntax-checks)
- (call-interactively 'compile))
-
-(defun flymake-on-timer-event (buffer)
- "Start a syntax check for buffer BUFFER if necessary."
- (when (buffer-live-p buffer)
- (with-current-buffer buffer
- (when (and (not flymake-is-running)
- flymake-last-change-time
- (> (- (float-time) flymake-last-change-time)
- flymake-no-changes-timeout))
-
- (setq flymake-last-change-time nil)
- (flymake-log 3 "starting syntax check as more than 1 second passed since last change")
- (flymake-start-syntax-check)))))
-
-(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line
- 'flymake-popup-current-error-menu "24.4")
-
-(defun flymake-popup-current-error-menu (&optional event)
- "Pop up a menu with errors/warnings for current line."
- (interactive (list last-nonmenu-event))
- (let* ((line-no (line-number-at-pos))
- (errors (or (car (flymake-find-err-info flymake-err-info line-no))
- (user-error "No errors for current line")))
- (menu (mapcar (lambda (x)
- (if (flymake-ler-file x)
- (cons (format "%s - %s(%d)"
- (flymake-ler-text x)
- (flymake-ler-file x)
- (flymake-ler-line x))
- x)
- (list (flymake-ler-text x))))
- errors))
- (event (if (mouse-event-p event)
- event
- (list 'mouse-1 (posn-at-point))))
- (title (format "Line %d: %d error(s), %d warning(s)"
- line-no
- (flymake-get-line-err-count errors "e")
- (flymake-get-line-err-count errors "w")))
- (choice (x-popup-menu event (list title (cons "" menu)))))
- (flymake-log 3 "choice=%s" choice)
- (when choice
- (flymake-goto-file-and-line (flymake-ler-full-file choice)
- (flymake-ler-line choice)))))
-
-(defun flymake-goto-file-and-line (file line)
- "Try to get buffer for FILE and goto line LINE in it."
- (if (not (file-exists-p file))
- (flymake-log 1 "File %s does not exist" file)
- (find-file file)
- (goto-char (point-min))
- (forward-line (1- line))))
-
-;; flymake minor mode declarations
-(defvar-local flymake-mode-line nil)
-(defvar-local flymake-mode-line-e-w nil)
-(defvar-local flymake-mode-line-status nil)
-
-(defun flymake-report-status (e-w &optional status)
- "Show status in mode line."
- (when e-w
- (setq flymake-mode-line-e-w e-w))
- (when status
- (setq flymake-mode-line-status status))
- (let* ((mode-line " Flymake"))
- (when (> (length flymake-mode-line-e-w) 0)
- (setq mode-line (concat mode-line ":" flymake-mode-line-e-w)))
- (setq mode-line (concat mode-line flymake-mode-line-status))
- (setq flymake-mode-line mode-line)
- (force-mode-line-update)))
-
-;; Nothing in flymake uses this at all any more, so this is just for
+(define-obsolete-face-alias 'flymake-warnline 'flymake-warning "26.1")
+(define-obsolete-face-alias 'flymake-errline 'flymake-error "26.1")
+
+;;;###autoload
+(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."
+ (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\t\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)))))))
+ (error (flymake-log :warning "Invalid region line=%s col=%s" line col)
+ nil)))
+
+(defvar flymake-diagnostic-functions nil
+ "Special hook of Flymake backends that check a buffer.
+
+The functions in this hook diagnose problems in a buffer's
+contents and provide information to the Flymake user interface
+about where and how to annotate problems diagnosed in a buffer.
+
+Each backend function must be prepared to accept an arbitrary
+number of arguments:
+
+* the first argument is always REPORT-FN, a callback function
+ detailed below;
+
+* the remaining arguments are keyword-value pairs in the
+ form (:KEY VALUE :KEY2 VALUE2...). Currently, Flymake provides
+ no such arguments, but backend functions must be prepared to
+ accept and possibly ignore any number of them.
+
+Whenever Flymake or the user decides to re-check the buffer,
+backend functions are called as detailed above and are expected
+to initiate this check, but aren't required to complete it before
+exiting: if the computation involved is expensive, especially for
+large buffers, that task can be scheduled for the future using
+asynchronous processes or other asynchronous mechanisms.
+
+In any case, backend functions are expected to return quickly or
+signal an error, in which case the backend is disabled. Flymake
+will not try disabled backends again for any future checks of
+this buffer. Certain commands, like turning `flymake-mode' off
+and on again, reset the list of disabled backends.
+
+If the function returns, Flymake considers the backend to be
+\"running\". If it has not done so already, the backend is
+expected to call the function REPORT-FN with a single argument
+REPORT-ACTION also followed by an optional list of keyword-value
+pairs in the form (:REPORT-KEY VALUE :REPORT-KEY2 VALUE2...).
+
+Currently accepted values for REPORT-ACTION are:
+
+* A (possibly empty) list of diagnostic objects created with
+ `flymake-make-diagnostic', causing Flymake to annotate the
+ buffer with this information.
+
+ A backend may call REPORT-FN repeatedly in this manner, but
+ only until Flymake considers that the most recently requested
+ buffer check is now obsolete because, say, buffer contents have
+ changed in the meantime. The backend is only given notice of
+ this via a renewed call to the backend function. Thus, to
+ prevent making obsolete reports and wasting resources, backend
+ functions should first cancel any ongoing processing from
+ previous calls.
+
+* The symbol `:panic', signaling that the backend has encountered
+ an exceptional situation and should be disabled.
+
+Currently accepted REPORT-KEY arguments are:
+
+* `:explanation' value should give user-readable details of
+ the situation encountered, if any.
+
+* `:force': value should be a boolean suggesting that Flymake
+ consider the report even if it was somehow unexpected.")
+
+(put 'flymake-diagnostic-functions 'safe-local-variable #'null)
+
+(defvar flymake-diagnostic-types-alist
+ `((:error
+ . ((flymake-category . flymake-error)))
+ (:warning
+ . ((flymake-category . flymake-warning)))
+ (:note
+ . ((flymake-category . flymake-note))))
+ "Alist ((KEY . PROPS)*) of properties of Flymake diagnostic types.
+KEY designates a kind of diagnostic can be anything passed as
+`:type' to `flymake-make-diagnostic'.
+
+PROPS is an alist of properties that are applied, in order, to
+the diagnostics of the type designated by KEY. The recognized
+properties are:
+
+* Every property pertaining to overlays, except `category' and
+ `evaporate' (see Info Node `(elisp)Overlay Properties'), used
+ to affect the appearance of Flymake annotations.
+
+* `bitmap', an image displayed in the fringe according to
+ `flymake-fringe-indicator-position'. The value actually
+ follows the syntax of `flymake-error-bitmap' (which see). It
+ is overridden by any `before-string' overlay property.
+
+* `severity', a non-negative integer specifying the diagnostic's
+ severity. The higher, the more serious. If the overlay
+ property `priority' is not specified, `severity' is used to set
+ it and help sort overlapping overlays.
+
+* `flymake-category', a symbol whose property list is considered
+ a default for missing values of any other properties. This is
+ useful to backend authors when creating new diagnostic types
+ that differ from an existing type by only a few properties.")
+
+(put 'flymake-error 'face 'flymake-error)
+(put 'flymake-error 'bitmap 'flymake-error-bitmap)
+(put 'flymake-error 'severity (warning-numeric-level :error))
+(put 'flymake-error 'mode-line-face 'compilation-error)
+
+(put 'flymake-warning 'face 'flymake-warning)
+(put 'flymake-warning 'bitmap 'flymake-warning-bitmap)
+(put 'flymake-warning 'severity (warning-numeric-level :warning))
+(put 'flymake-warning 'mode-line-face 'compilation-warning)
+
+(put 'flymake-note 'face 'flymake-note)
+(put 'flymake-note 'bitmap 'flymake-note-bitmap)
+(put 'flymake-note 'severity (warning-numeric-level :debug))
+(put 'flymake-note 'mode-line-face 'compilation-info)
+
+(defun flymake--lookup-type-property (type prop &optional default)
+ "Look up PROP for TYPE in `flymake-diagnostic-types-alist'.
+If TYPE doesn't declare PROP in either
+`flymake-diagnostic-types-alist' or in the symbol of its
+associated `flymake-category' return DEFAULT."
+ (let ((alist-probe (assoc type flymake-diagnostic-types-alist)))
+ (cond (alist-probe
+ (let* ((alist (cdr alist-probe))
+ (prop-probe (assoc prop alist)))
+ (if prop-probe
+ (cdr prop-probe)
+ (if-let* ((cat (assoc-default 'flymake-category alist))
+ (plist (and (symbolp cat)
+ (symbol-plist cat)))
+ (cat-probe (plist-member plist prop)))
+ (cadr cat-probe)
+ default))))
+ (t
+ default))))
+
+(defun flymake--fringe-overlay-spec (bitmap &optional recursed)
+ (if (and (symbolp bitmap)
+ (boundp bitmap)
+ (not recursed))
+ (flymake--fringe-overlay-spec
+ (symbol-value bitmap) t)
+ (and flymake-fringe-indicator-position
+ bitmap
+ (propertize "!" 'display
+ (cons flymake-fringe-indicator-position
+ (if (listp bitmap)
+ bitmap
+ (list bitmap)))))))
+
+(defun flymake--highlight-line (diagnostic)
+ "Highlight buffer with info in DIAGNOSTIC."
+ (when-let* ((ov (make-overlay
+ (flymake--diag-beg diagnostic)
+ (flymake--diag-end diagnostic))))
+ ;; First set `category' in the overlay, then copy over every other
+ ;; property.
+ ;;
+ (let ((alist (assoc-default (flymake--diag-type diagnostic)
+ flymake-diagnostic-types-alist)))
+ (overlay-put ov 'category (assoc-default 'flymake-category alist))
+ (cl-loop for (k . v) in alist
+ unless (eq k 'category)
+ do (overlay-put ov k v)))
+ ;; Now ensure some essential defaults are set
+ ;;
+ (cl-flet ((default-maybe
+ (prop value)
+ (unless (or (plist-member (overlay-properties ov) prop)
+ (let ((cat (overlay-get ov
+ 'flymake-category)))
+ (and cat
+ (plist-member (symbol-plist cat) prop))))
+ (overlay-put ov prop value))))
+ (default-maybe 'bitmap 'flymake-error-bitmap)
+ (default-maybe 'face 'flymake-error)
+ (default-maybe 'before-string
+ (flymake--fringe-overlay-spec
+ (overlay-get ov 'bitmap)))
+ (default-maybe 'help-echo
+ (lambda (window _ov pos)
+ (with-selected-window window
+ (mapconcat
+ #'flymake--diag-text
+ (flymake-diagnostics pos)
+ "\n"))))
+ (default-maybe 'severity (warning-numeric-level :error))
+ (default-maybe 'priority (+ 100 (overlay-get ov 'severity))))
+ ;; Some properties can't be overridden.
+ ;;
+ (overlay-put ov 'evaporate t)
+ (overlay-put ov 'flymake-diagnostic diagnostic)))
+
+;; Nothing in Flymake uses this at all any more, so this is just for
;; third-party compatibility.
(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
-(defun flymake-report-fatal-status (status warning)
- "Display a warning and switch flymake mode off."
- ;; This first message was always shown by default, and flymake-log
- ;; does nothing by default, hence the use of message.
- ;; Another option is display-warning.
- (if (< flymake-log-level 0)
- (message "Flymake: %s. Flymake will be switched OFF" warning))
- (flymake-mode 0)
- (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s"
- (buffer-name) status warning))
+(defvar-local flymake--backend-state nil
+ "Buffer-local hash table of a Flymake backend's state.
+The keys to this hash table are functions as found in
+`flymake-diagnostic-functions'. The values are structures
+of the type `flymake--backend-state', with these slots:
+
+`running', a symbol to keep track of a backend's replies via its
+REPORT-FN argument. A backend is running if this key is
+present. If nil, Flymake isn't expecting any replies from the
+backend.
+
+`diags', a (possibly empty) list of recent diagnostic objects
+created by the backend with `flymake-make-diagnostic'.
+
+`reported-p', a boolean indicating if the backend has replied
+since it last was contacted.
+
+`disabled', a string with the explanation for a previous
+exceptional situation reported by the backend, nil if the
+backend is operating normally.")
+
+(cl-defstruct (flymake--backend-state
+ (:constructor flymake--make-backend-state))
+ running reported-p disabled diags)
+
+(defmacro flymake--with-backend-state (backend state-var &rest body)
+ "Bind BACKEND's STATE-VAR to its state, run BODY."
+ (declare (indent 2) (debug (sexp sexp &rest form)))
+ (let ((b (make-symbol "b")))
+ `(let* ((,b ,backend)
+ (,state-var
+ (or (gethash ,b flymake--backend-state)
+ (puthash ,b (flymake--make-backend-state)
+ flymake--backend-state))))
+ ,@body)))
+
+(defun flymake-is-running ()
+ "Tell if Flymake has running backends in this buffer"
+ (flymake-running-backends))
+
+(cl-defun flymake--handle-report (backend token report-action
+ &key explanation force
+ &allow-other-keys)
+ "Handle reports from BACKEND identified by TOKEN.
+BACKEND, REPORT-ACTION and EXPLANATION, and FORCE conform to the calling
+convention described in `flymake-diagnostic-functions' (which
+see). Optional FORCE says to handle a report even if TOKEN was
+not expected."
+ (let* ((state (gethash backend flymake--backend-state))
+ (first-report (not (flymake--backend-state-reported-p state))))
+ (setf (flymake--backend-state-reported-p state) t)
+ (let (expected-token
+ new-diags)
+ (cond
+ ((null state)
+ (flymake-error
+ "Unexpected report from unknown backend %s" backend))
+ ((flymake--backend-state-disabled state)
+ (flymake-error
+ "Unexpected report from disabled backend %s" backend))
+ ((progn
+ (setq expected-token (flymake--backend-state-running state))
+ (null expected-token))
+ ;; should never happen
+ (flymake-error "Unexpected report from stopped backend %s" backend))
+ ((not (or (eq expected-token token)
+ force))
+ (flymake-error "Obsolete report from backend %s with explanation %s"
+ backend explanation))
+ ((eq :panic report-action)
+ (flymake--disable-backend backend explanation))
+ ((not (listp report-action))
+ (flymake--disable-backend backend
+ (format "Unknown action %S" report-action))
+ (flymake-error "Expected report, but got unknown key %s" report-action))
+ (t
+ (setq new-diags report-action)
+ (save-restriction
+ (widen)
+ ;; only delete overlays if this is the first report
+ (when first-report
+ (flymake-delete-own-overlays
+ (lambda (ov)
+ (eq backend
+ (flymake--diag-backend
+ (overlay-get ov 'flymake-diagnostic))))))
+ (mapc (lambda (diag)
+ (flymake--highlight-line diag)
+ (setf (flymake--diag-backend diag) backend))
+ new-diags)
+ (setf (flymake--backend-state-diags state)
+ (append new-diags (flymake--backend-state-diags state)))
+ (when flymake-check-start-time
+ (flymake-log :debug "backend %s reported %d diagnostics in %.2f second(s)"
+ backend
+ (length new-diags)
+ (- (float-time) flymake-check-start-time)))
+ (when (and (get-buffer (flymake--diagnostics-buffer-name))
+ (get-buffer-window (flymake--diagnostics-buffer-name))
+ (null (cl-set-difference (flymake-running-backends)
+ (flymake-reporting-backends))))
+ (flymake-show-diagnostics-buffer))))))))
+
+(defun flymake-make-report-fn (backend &optional token)
+ "Make a suitable anonymous report function for BACKEND.
+BACKEND is used to help Flymake distinguish different diagnostic
+sources. If provided, TOKEN helps Flymake distinguish between
+different runs of the same backend."
+ (let ((buffer (current-buffer)))
+ (lambda (&rest args)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (apply #'flymake--handle-report backend token args))))))
+
+(defun flymake--collect (fn &optional message-prefix)
+ "Collect Flymake backends matching FN.
+If MESSAGE-PREFIX, echo a message using that prefix"
+ (unless flymake--backend-state
+ (user-error "Flymake is not initialized"))
+ (let (retval)
+ (maphash (lambda (backend state)
+ (when (funcall fn state) (push backend retval)))
+ flymake--backend-state)
+ (when message-prefix
+ (message "%s%s"
+ message-prefix
+ (mapconcat (lambda (s) (format "%s" s))
+ retval ", ")))
+ retval))
+
+(defun flymake-running-backends ()
+ "Compute running Flymake backends in current buffer."
+ (interactive)
+ (flymake--collect #'flymake--backend-state-running
+ (and (called-interactively-p 'interactive)
+ "Running backends: ")))
+
+(defun flymake-disabled-backends ()
+ "Compute disabled Flymake backends in current buffer."
+ (interactive)
+ (flymake--collect #'flymake--backend-state-disabled
+ (and (called-interactively-p 'interactive)
+ "Disabled backends: ")))
+
+(defun flymake-reporting-backends ()
+ "Compute reporting Flymake backends in current buffer."
+ (interactive)
+ (flymake--collect #'flymake--backend-state-reported-p
+ (and (called-interactively-p 'interactive)
+ "Reporting backends: ")))
+
+(defun flymake--disable-backend (backend &optional explanation)
+ "Disable BACKEND because EXPLANATION.
+If it is running also stop it."
+ (flymake-log :warning "Disabling backend %s because %s" backend explanation)
+ (flymake--with-backend-state backend state
+ (setf (flymake--backend-state-running state) nil
+ (flymake--backend-state-disabled state) explanation
+ (flymake--backend-state-reported-p state) t)))
+
+(defun flymake--run-backend (backend)
+ "Run the backend BACKEND, reenabling if necessary."
+ (flymake-log :debug "Running backend %s" backend)
+ (let ((run-token (cl-gensym "backend-token")))
+ (flymake--with-backend-state backend state
+ (setf (flymake--backend-state-running state) run-token
+ (flymake--backend-state-disabled state) nil
+ (flymake--backend-state-diags state) nil
+ (flymake--backend-state-reported-p state) nil))
+ ;; FIXME: Should use `condition-case-unless-debug' here, but don't
+ ;; for two reasons: (1) that won't let me catch errors from inside
+ ;; `ert-deftest' where `debug-on-error' appears to be always
+ ;; t. (2) In cases where the user is debugging elisp somewhere
+ ;; else, and using flymake, the presence of a frequently
+ ;; misbehaving backend in the global hook (most likely the legacy
+ ;; backend) will trigger an annoying backtrace.
+ ;;
+ (condition-case err
+ (funcall backend
+ (flymake-make-report-fn backend run-token))
+ (error
+ (flymake--disable-backend backend err)))))
+
+(defun flymake-start (&optional deferred force)
+ "Start a syntax check for the current buffer.
+DEFERRED is a list of symbols designating conditions to wait for
+before actually starting the check. If it is nil (the list is
+empty), start it immediately, else defer the check to when those
+conditions are met. Currently recognized conditions are
+`post-command', for waiting until the current command is over,
+`on-display', for waiting until the buffer is actually displayed
+in a window. If DEFERRED is t, wait for all known conditions.
+
+With optional FORCE run even disabled backends.
+
+Interactively, with a prefix arg, FORCE is t."
+ (interactive (list nil current-prefix-arg))
+ (let ((deferred (if (eq t deferred)
+ '(post-command on-display)
+ deferred))
+ (buffer (current-buffer)))
+ (cl-labels
+ ((start-post-command
+ ()
+ (remove-hook 'post-command-hook #'start-post-command
+ nil)
+ ;; The buffer may have disappeared already, e.g. because of
+ ;; code like `(with-temp-buffer (python-mode) ...)'.
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (flymake-start (remove 'post-command deferred) force))))
+ (start-on-display
+ ()
+ (remove-hook 'window-configuration-change-hook #'start-on-display
+ 'local)
+ (flymake-start (remove 'on-display deferred) force)))
+ (cond ((and (memq 'post-command deferred)
+ this-command)
+ (add-hook 'post-command-hook
+ #'start-post-command
+ 'append nil))
+ ((and (memq 'on-display deferred)
+ (not (get-buffer-window (current-buffer))))
+ (add-hook 'window-configuration-change-hook
+ #'start-on-display
+ 'append 'local))
+ (t
+ (setq flymake-check-start-time (float-time))
+ (run-hook-wrapped
+ 'flymake-diagnostic-functions
+ (lambda (backend)
+ (cond
+ ((and (not force)
+ (flymake--with-backend-state backend state
+ (flymake--backend-state-disabled state)))
+ (flymake-log :debug "Backend %s is disabled, not starting"
+ backend))
+ (t
+ (flymake--run-backend backend)))
+ nil)))))))
+
+(defvar flymake-mode-map
+ (let ((map (make-sparse-keymap))) map)
+ "Keymap for `flymake-mode'")
;;;###autoload
-(define-minor-mode flymake-mode nil
- :group 'flymake :lighter flymake-mode-line
+(define-minor-mode flymake-mode
+ "Toggle Flymake mode on or off.
+With a prefix argument ARG, enable Flymake mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+
+Flymake is an Emacs minor mode for on-the-fly syntax checking.
+Flymake collects diagnostic information from multiple sources,
+called backends, and visually annotates the buffer with the
+results.
+
+Flymake performs these checks while the user is editing. The
+customization variables `flymake-start-on-flymake-mode',
+`flymake-no-changes-timeout' and
+`flymake-start-syntax-check-on-newline' determine the exact
+circumstances whereupon Flymake decides to initiate a check of
+the buffer.
+
+The commands `flymake-goto-next-error' and
+`flymake-goto-prev-error' can be used to navigate among Flymake
+diagnostics annotated in the buffer.
+
+The visual appearance of each type of diagnostic can be changed
+in the variable `flymake-diagnostic-types-alist'.
+
+Activation or deactivation of backends used by Flymake in each
+buffer happens via the special hook
+`flymake-diagnostic-functions'.
+
+Some backends may take longer than others to respond or complete,
+and some may decide to disable themselves if they are not
+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
(cond
-
;; Turning the mode ON.
(flymake-mode
- (cond
- ((not buffer-file-name)
- (message "Flymake unable to run without a buffer file name"))
- ((not (flymake-can-syntax-check-file buffer-file-name))
- (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)))
- (t
- (add-hook 'after-change-functions 'flymake-after-change-function nil t)
- (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
- (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
- ;;+(add-hook 'find-file-hook 'flymake-find-file-hook)
-
- (flymake-report-status "" "")
-
- (setq flymake-timer
- (run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
-
- (when (and flymake-start-syntax-check-on-find-file
- ;; Since we write temp files in current dir, there's no point
- ;; trying if the directory is read-only (bug#8954).
- (file-writable-p (file-name-directory buffer-file-name)))
- (with-demoted-errors
- (flymake-start-syntax-check))))))
+ (add-hook 'after-change-functions 'flymake-after-change-function nil t)
+ (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
+ (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
+
+ (setq flymake--backend-state (make-hash-table))
+
+ (when flymake-start-on-flymake-mode (flymake-start t)))
;; Turning the mode OFF.
(t
@@ -1248,402 +849,365 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
(when flymake-timer
(cancel-timer flymake-timer)
- (setq flymake-timer nil))
-
- (setq flymake-is-running nil))))
+ (setq flymake-timer nil)))))
+
+(defun flymake--schedule-timer-maybe ()
+ "(Re)schedule an idle timer for checking the buffer.
+Do it only if `flymake-no-changes-timeout' is non-nil."
+ (when flymake-timer (cancel-timer flymake-timer))
+ (when flymake-no-changes-timeout
+ (setq
+ flymake-timer
+ (run-with-idle-timer
+ (seconds-to-time flymake-no-changes-timeout)
+ nil
+ (lambda (buffer)
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (when (and flymake-mode
+ flymake-no-changes-timeout)
+ (flymake-log
+ :debug "starting syntax check after idle for %s seconds"
+ flymake-no-changes-timeout)
+ (flymake-start t))
+ (setq flymake-timer nil))))
+ (current-buffer)))))
;;;###autoload
(defun flymake-mode-on ()
- "Turn flymake mode on."
- (flymake-mode 1)
- (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name)))
+ "Turn Flymake mode on."
+ (flymake-mode 1))
;;;###autoload
(defun flymake-mode-off ()
- "Turn flymake mode off."
- (flymake-mode 0)
- (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name)))
+ "Turn Flymake mode off."
+ (flymake-mode 0))
+
+(make-obsolete 'flymake-mode-on 'flymake-mode "26.1")
+(make-obsolete 'flymake-mode-off 'flymake-mode "26.1")
(defun flymake-after-change-function (start stop _len)
"Start syntax check for current buffer if it isn't already running."
- ;;+(flymake-log 0 "setting change time to %s" (float-time))
(let((new-text (buffer-substring start stop)))
(when (and flymake-start-syntax-check-on-newline (equal new-text "\n"))
- (flymake-log 3 "starting syntax check as new-line has been seen")
- (flymake-start-syntax-check))
- (setq flymake-last-change-time (float-time))))
+ (flymake-log :debug "starting syntax check as new-line has been seen")
+ (flymake-start t))
+ (flymake--schedule-timer-maybe)))
(defun flymake-after-save-hook ()
- (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved?
- (progn
- (flymake-log 3 "starting syntax check as buffer was saved")
- (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???)
+ (when flymake-mode
+ (flymake-log :debug "starting syntax check as buffer was saved")
+ (flymake-start t)))
(defun flymake-kill-buffer-hook ()
(when flymake-timer
(cancel-timer flymake-timer)
(setq flymake-timer nil)))
-;;;###autoload
(defun flymake-find-file-hook ()
- ;;+(when flymake-start-syntax-check-on-find-file
- ;;+ (flymake-log 3 "starting syntax check on file open")
- ;;+ (flymake-start-syntax-check)
- ;;+)
- (when (and (not (local-variable-p 'flymake-mode (current-buffer)))
- (flymake-can-syntax-check-file buffer-file-name))
+ (unless (or flymake-mode
+ (null flymake-diagnostic-functions))
(flymake-mode)
- (flymake-log 3 "automatically turned ON flymake mode")))
-
-(defun flymake-get-first-err-line-no (err-info-list)
- "Return first line with error."
- (when err-info-list
- (flymake-er-get-line (car err-info-list))))
-
-(defun flymake-get-last-err-line-no (err-info-list)
- "Return last line with error."
- (when err-info-list
- (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list))))
-
-(defun flymake-get-next-err-line-no (err-info-list line-no)
- "Return next line with error."
- (when err-info-list
- (let* ((count (length err-info-list))
- (idx 0))
- (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list))))
- (setq idx (1+ idx)))
- (if (< idx count)
- (flymake-er-get-line (nth idx err-info-list))))))
-
-(defun flymake-get-prev-err-line-no (err-info-list line-no)
- "Return previous line with error."
- (when err-info-list
- (let* ((count (length err-info-list)))
- (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list))))
- (setq count (1- count)))
- (if (> count 0)
- (flymake-er-get-line (nth (1- count) err-info-list))))))
-
-(defun flymake-skip-whitespace ()
- "Move forward until non-whitespace is reached."
- (while (looking-at "[ \t]")
- (forward-char)))
-
-(defun flymake-goto-line (line-no)
- "Go to line LINE-NO, then skip whitespace."
- (goto-char (point-min))
- (forward-line (1- line-no))
- (flymake-skip-whitespace))
-
-(defun flymake-goto-next-error ()
- "Go to next error in err ring."
+ (flymake-log :warning "Turned on in `flymake-find-file-hook'")))
+
+(defun flymake-goto-next-error (&optional n filter interactive)
+ "Go to Nth next Flymake diagnostic that matches FILTER.
+Interactively, always move to the next diagnostic. With a prefix
+arg, skip any diagnostics with a severity less than `:warning'.
+
+If `flymake-wrap-around' is non-nil and no more next diagnostics,
+resumes search from top.
+
+FILTER is a list of diagnostic types found in
+`flymake-diagnostic-types-alist', or nil, if no filter is to be
+applied."
+ ;; TODO: let filter be a number, a severity below which diags are
+ ;; skipped.
+ (interactive (list 1
+ (if current-prefix-arg
+ '(:error :warning))
+ t))
+ (let* ((n (or n 1))
+ (ovs (flymake--overlays :filter
+ (lambda (ov)
+ (let ((diag (overlay-get
+ ov
+ 'flymake-diagnostic)))
+ (and diag
+ (or (not filter)
+ (memq (flymake--diag-type diag)
+ filter)))))
+ :compare (if (cl-plusp n) #'< #'>)
+ :key #'overlay-start))
+ (tail (cl-member-if (lambda (ov)
+ (if (cl-plusp n)
+ (> (overlay-start ov)
+ (point))
+ (< (overlay-start ov)
+ (point))))
+ ovs))
+ (chain (if flymake-wrap-around
+ (if tail
+ (progn (setcdr (last tail) ovs) tail)
+ (and ovs (setcdr (last ovs) ovs)))
+ tail))
+ (target (nth (1- n) chain)))
+ (cond (target
+ (goto-char (overlay-start target))
+ (when interactive
+ (message
+ "%s"
+ (funcall (overlay-get target 'help-echo)
+ (selected-window) target (point)))))
+ (interactive
+ (user-error "No more Flymake errors%s"
+ (if filter
+ (format " of types %s" filter)
+ ""))))))
+
+(defun flymake-goto-prev-error (&optional n filter interactive)
+ "Go to Nth previous Flymake diagnostic that matches FILTER.
+Interactively, always move to the previous diagnostic. With a
+prefix arg, skip any diagnostics with a severity less than
+`:warning'.
+
+If `flymake-wrap-around' is non-nil and no more previous
+diagnostics, resumes search from bottom.
+
+FILTER is a list of diagnostic types found in
+`flymake-diagnostic-types-alist', or nil, if no filter is to be
+applied."
+ (interactive (list 1 (if current-prefix-arg
+ '(:error :warning))
+ t))
+ (flymake-goto-next-error (- (or n 1)) filter interactive))
+
+
+;;; Mode-line and menu
+;;;
+(easy-menu-define flymake-menu flymake-mode-map "Flymake"
+ `("Flymake"
+ [ "Go to next problem" flymake-goto-next-error t ]
+ [ "Go to previous problem" flymake-goto-prev-error t ]
+ [ "Check now" flymake-start t ]
+ [ "List all problems" flymake-show-diagnostics-buffer t ]
+ "--"
+ [ "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)))
+ (define-key map [mode-line mouse-1]
+ 'flymake-switch-to-log-buffer)
+ map))))))
+ ,@(unless (or all-disabled
+ (null known))
+ (cl-loop
+ for (type . severity)
+ in (cl-sort (mapcar (lambda (type)
+ (cons type (flymake--lookup-type-property
+ type
+ 'severity
+ (warning-numeric-level :error))))
+ (cl-union (hash-table-keys diags-by-type)
+ '(:error :warning)))
+ #'>
+ :key #'cdr)
+ for diags = (gethash type diags-by-type)
+ for face = (flymake--lookup-type-property type
+ 'mode-line-face
+ 'compilation-error)
+ when (or diags
+ (>= severity (warning-numeric-level :warning)))
+ 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 "]")))))))
+
+;;; Diagnostics buffer
+
+(defvar-local flymake--diagnostics-buffer-source nil)
+
+(defvar flymake-diagnostics-buffer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "RET") 'flymake-goto-diagnostic)
+ (define-key map (kbd "SPC") 'flymake-show-diagnostic)
+ map))
+
+(defun flymake-show-diagnostic (pos &optional other-window)
+ "Show location of diagnostic at POS."
+ (interactive (list (point) t))
+ (let* ((id (or (tabulated-list-get-id pos)
+ (user-error "Nothing at point")))
+ (diag (plist-get id :diagnostic)))
+ (with-current-buffer (flymake--diag-buffer diag)
+ (with-selected-window
+ (display-buffer (current-buffer) other-window)
+ (goto-char (flymake--diag-beg diag))
+ (pulse-momentary-highlight-region (flymake--diag-beg diag)
+ (flymake--diag-end diag)
+ 'highlight))
+ (current-buffer))))
+
+(defun flymake-goto-diagnostic (pos)
+ "Show location of diagnostic at POS.
+POS can be a buffer position or a button"
+ (interactive "d")
+ (pop-to-buffer
+ (flymake-show-diagnostic (if (button-type pos) (button-start pos) pos))))
+
+(defun flymake--diagnostics-buffer-entries ()
+ (with-current-buffer flymake--diagnostics-buffer-source
+ (cl-loop for diag in
+ (cl-sort (flymake-diagnostics) #'< :key #'flymake-diagnostic-beg)
+ for (line . col) =
+ (save-excursion
+ (goto-char (flymake--diag-beg diag))
+ (cons (line-number-at-pos)
+ (- (point)
+ (line-beginning-position))))
+ for type = (flymake--diag-type diag)
+ collect
+ (list (list :diagnostic diag
+ :line line
+ :severity (flymake--lookup-type-property
+ type
+ 'severity (warning-numeric-level :error)))
+ `[,(format "%s" line)
+ ,(format "%s" col)
+ ,(propertize (format "%s" type)
+ 'face (flymake--lookup-type-property
+ type 'mode-line-face 'flymake-error))
+ (,(format "%s" (flymake--diag-text diag))
+ mouse-face highlight
+ help-echo "mouse-2: visit this diagnostic"
+ face nil
+ action flymake-goto-diagnostic
+ mouse-action flymake-goto-diagnostic)]))))
+
+(define-derived-mode flymake-diagnostics-buffer-mode tabulated-list-mode
+ "Flymake diagnostics"
+ "A mode for listing Flymake diagnostics."
+ (setq tabulated-list-format
+ `[("Line" 5 (lambda (l1 l2)
+ (< (plist-get (car l1) :line)
+ (plist-get (car l2) :line)))
+ :right-align t)
+ ("Col" 3 nil :right-align t)
+ ("Type" 8 (lambda (l1 l2)
+ (< (plist-get (car l1) :severity)
+ (plist-get (car l2) :severity))))
+ ("Message" 0 t)])
+ (setq tabulated-list-entries
+ 'flymake--diagnostics-buffer-entries)
+ (tabulated-list-init-header))
+
+(defun flymake--diagnostics-buffer-name ()
+ (format "*Flymake diagnostics for %s*" (current-buffer)))
+
+(defun flymake-show-diagnostics-buffer ()
+ "Show a list of Flymake diagnostics for current buffer."
(interactive)
- (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos))))
- (when (not line-no)
- (setq line-no (flymake-get-first-err-line-no flymake-err-info))
- (flymake-log 1 "passed end of file"))
- (if line-no
- (flymake-goto-line line-no)
- (flymake-log 1 "no errors in current buffer"))))
-
-(defun flymake-goto-prev-error ()
- "Go to previous error in err ring."
- (interactive)
- (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos))))
- (when (not line-no)
- (setq line-no (flymake-get-last-err-line-no flymake-err-info))
- (flymake-log 1 "passed beginning of file"))
- (if line-no
- (flymake-goto-line line-no)
- (flymake-log 1 "no errors in current buffer"))))
-
-(defun flymake-patch-err-text (string)
- (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string)
- (match-string 1 string)
- string))
-
-;;;; general init-cleanup and helper routines
-(defun flymake-create-temp-inplace (file-name prefix)
- (unless (stringp file-name)
- (error "Invalid file-name"))
- (or prefix
- (setq prefix "flymake"))
- (let* ((ext (file-name-extension file-name))
- (temp-name (file-truename
- (concat (file-name-sans-extension file-name)
- "_" prefix
- (and ext (concat "." ext))))))
- (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
- temp-name))
-
-(defun flymake-create-temp-with-folder-structure (file-name _prefix)
- (unless (stringp file-name)
- (error "Invalid file-name"))
-
- (let* ((dir (file-name-directory file-name))
- ;; Not sure what this slash-pos is all about, but I guess it's just
- ;; trying to remove the leading / of absolute file names.
- (slash-pos (string-match "/" dir))
- (temp-dir (expand-file-name (substring dir (1+ slash-pos))
- temporary-file-directory)))
-
- (file-truename (expand-file-name (file-name-nondirectory file-name)
- temp-dir))))
-
-(defun flymake-delete-temp-directory (dir-name)
- "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error."
- (let* ((temp-dir temporary-file-directory)
- (suffix (substring dir-name (1+ (length temp-dir)))))
-
- (while (> (length suffix) 0)
- (setq suffix (directory-file-name suffix))
- ;;+(flymake-log 0 "suffix=%s" suffix)
- (flymake-safe-delete-directory
- (file-truename (expand-file-name suffix temp-dir)))
- (setq suffix (file-name-directory suffix)))))
-
-(defvar-local flymake-temp-source-file-name nil)
-(defvar-local flymake-master-file-name nil)
-(defvar-local flymake-temp-master-file-name nil)
-(defvar-local flymake-base-dir nil)
-
-(defun flymake-init-create-temp-buffer-copy (create-temp-f)
- "Make a temporary copy of the current buffer, save its name in buffer data and return the name."
- (let* ((source-file-name buffer-file-name)
- (temp-source-file-name (funcall create-temp-f source-file-name "flymake")))
-
- (flymake-save-buffer-in-file temp-source-file-name)
- (setq flymake-temp-source-file-name temp-source-file-name)
- temp-source-file-name))
-
-(defun flymake-simple-cleanup ()
- "Do cleanup after `flymake-init-create-temp-buffer-copy'.
-Delete temp file."
- (flymake-safe-delete-file flymake-temp-source-file-name)
- (setq flymake-last-change-time nil))
-
-(defun flymake-get-real-file-name (file-name-from-err-msg)
- "Translate file name from error message to \"real\" file name.
-Return full-name. Names are real, not patched."
- (let* ((real-name nil)
- (source-file-name buffer-file-name)
- (master-file-name flymake-master-file-name)
- (temp-source-file-name flymake-temp-source-file-name)
- (temp-master-file-name flymake-temp-master-file-name)
- (base-dirs
- (list flymake-base-dir
- (file-name-directory source-file-name)
- (if master-file-name (file-name-directory master-file-name))))
- (files (list (list source-file-name source-file-name)
- (list temp-source-file-name source-file-name)
- (list master-file-name master-file-name)
- (list temp-master-file-name master-file-name))))
-
- (when (equal 0 (length file-name-from-err-msg))
- (setq file-name-from-err-msg source-file-name))
-
- (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files))
- ;; if real-name is nil, than file name from err msg is none of the files we've patched
- (if (not real-name)
- (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs)))
- (if (not real-name)
- (setq real-name file-name-from-err-msg))
- (setq real-name (flymake-fix-file-name real-name))
- (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name)
- real-name))
-
-(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files)
- (let* ((base-dirs-count (length base-dirs))
- (file-count (length files))
- (real-name nil))
-
- (while (and (not real-name) (> base-dirs-count 0))
- (setq file-count (length files))
- (while (and (not real-name) (> file-count 0))
- (let* ((this-dir (nth (1- base-dirs-count) base-dirs))
- (this-file (nth 0 (nth (1- file-count) files)))
- (this-real-name (nth 1 (nth (1- file-count) files))))
- ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg)
- (when (and this-dir this-file (flymake-same-files
- (expand-file-name file-name-from-err-msg this-dir)
- this-file))
- (setq real-name this-real-name)))
- (setq file-count (1- file-count)))
- (setq base-dirs-count (1- base-dirs-count)))
- real-name))
-
-(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs)
- (let* ((real-name nil))
- (if (file-name-absolute-p file-name-from-err-msg)
- (setq real-name file-name-from-err-msg)
- (let* ((base-dirs-count (length base-dirs)))
- (while (and (not real-name) (> base-dirs-count 0))
- (let* ((full-name (expand-file-name file-name-from-err-msg
- (nth (1- base-dirs-count) base-dirs))))
- (if (file-exists-p full-name)
- (setq real-name full-name))
- (setq base-dirs-count (1- base-dirs-count))))))
- real-name))
-
-(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name)
- "Find buildfile, store its dir in buffer data and return its dir, if found."
- (let* ((buildfile-dir
- (flymake-find-buildfile buildfile-name
- (file-name-directory source-file-name))))
- (if buildfile-dir
- (setq flymake-base-dir buildfile-dir)
- (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name)
- (flymake-report-fatal-status
- "NOMK" (format "No buildfile (%s) found for %s"
- buildfile-name source-file-name)))))
-
-(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp)
- "Find master file (or buffer), create its copy along with a copy of the source file."
- (let* ((source-file-name buffer-file-name)
- (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))
- (master-and-temp-master (flymake-create-master-file
- source-file-name temp-source-file-name
- get-incl-dirs-f create-temp-f
- master-file-masks include-regexp)))
-
- (if (not master-and-temp-master)
- (progn
- (flymake-log 1 "cannot find master file for %s" source-file-name)
- (flymake-report-status "!" "") ; NOMASTER
- nil)
- (setq flymake-master-file-name (nth 0 master-and-temp-master))
- (setq flymake-temp-master-file-name (nth 1 master-and-temp-master)))))
-
-(defun flymake-master-cleanup ()
- (flymake-simple-cleanup)
- (flymake-safe-delete-file flymake-temp-master-file-name))
-
-;;;; make-specific init-cleanup routines
-(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f)
- "Create a command line for syntax check using GET-CMD-LINE-F."
- (funcall get-cmd-line-f
- (if use-relative-source
- (file-relative-name source-file-name base-dir)
- source-file-name)
- (if use-relative-base-dir
- (file-relative-name base-dir
- (file-name-directory source-file-name))
- base-dir)))
-
-(defun flymake-get-make-cmdline (source base-dir)
- (list "make"
- (list "-s"
- "-C"
- base-dir
- (concat "CHK_SOURCES=" source)
- "SYNTAX_CHECK_MODE=1"
- "check-syntax")))
-
-(defun flymake-get-ant-cmdline (source base-dir)
- (list "ant"
- (list "-buildfile"
- (concat base-dir "/" "build.xml")
- (concat "-DCHK_SOURCES=" source)
- "check-syntax")))
-
-(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f)
- "Create syntax check command line for a directly checked source file.
-Use CREATE-TEMP-F for creating temp copy."
- (let* ((args nil)
- (source-file-name buffer-file-name)
- (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name)))
- (if buildfile-dir
- (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)))
- (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir
- use-relative-base-dir use-relative-source
- get-cmdline-f))))
- args))
-
-(defun flymake-simple-make-init ()
- (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline))
-
-(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp)
- "Create make command line for a source file checked via master file compilation."
- (let* ((make-args nil)
- (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy
- get-incl-dirs-f 'flymake-create-temp-inplace
- master-file-masks include-regexp)))
- (when temp-master-file-name
- (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile")))
- (if buildfile-dir
- (setq make-args (flymake-get-syntax-check-program-args
- temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline)))))
- make-args))
-
-(defun flymake-find-make-buildfile (source-dir)
- (flymake-find-buildfile "Makefile" source-dir))
-
-;;;; .h/make specific
-(defun flymake-master-make-header-init ()
- (flymake-master-make-init
- 'flymake-get-include-dirs
- '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'")
- "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\""))
-
-;;;; .java/make specific
-(defun flymake-simple-make-java-init ()
- (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline))
-
-(defun flymake-simple-ant-java-init ()
- (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline))
-
-(defun flymake-simple-java-cleanup ()
- "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs."
- (flymake-safe-delete-file flymake-temp-source-file-name)
- (when flymake-temp-source-file-name
- (flymake-delete-temp-directory
- (file-name-directory flymake-temp-source-file-name))))
-
-;;;; perl-specific init-cleanup routines
-(defun flymake-perl-init ()
- (let* ((temp-file (flymake-init-create-temp-buffer-copy
- 'flymake-create-temp-inplace))
- (local-file (file-relative-name
- temp-file
- (file-name-directory buffer-file-name))))
- (list "perl" (list "-wc " local-file))))
-
-;;;; php-specific init-cleanup routines
-(defun flymake-php-init ()
- (let* ((temp-file (flymake-init-create-temp-buffer-copy
- 'flymake-create-temp-inplace))
- (local-file (file-relative-name
- temp-file
- (file-name-directory buffer-file-name))))
- (list "php" (list "-f" local-file "-l"))))
-
-;;;; tex-specific init-cleanup routines
-(defun flymake-get-tex-args (file-name)
- ;;(list "latex" (list "-c-style-errors" file-name))
- (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name)))
-
-(defun flymake-simple-tex-init ()
- (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))
-
-;; Perhaps there should be a buffer-local variable flymake-master-file
-;; that people can set to override this stuff. Could inherit from
-;; the similar AUCTeX variable.
-(defun flymake-master-tex-init ()
- (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy
- 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace
- '("\\.tex\\'")
- "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}")))
- (when temp-master-file-name
- (flymake-get-tex-args temp-master-file-name))))
-
-(defun flymake-get-include-dirs-dot (_base-dir)
- '("."))
-
-;;;; xml-specific init-cleanup routines
-(defun flymake-xml-init ()
- (list flymake-xml-program
- (list "val" (flymake-init-create-temp-buffer-copy
- 'flymake-create-temp-inplace))))
+ (let* ((name (flymake--diagnostics-buffer-name))
+ (source (current-buffer))
+ (target (or (get-buffer name)
+ (with-current-buffer (get-buffer-create name)
+ (flymake-diagnostics-buffer-mode)
+ (setq flymake--diagnostics-buffer-source source)
+ (current-buffer)))))
+ (with-current-buffer target
+ (revert-buffer)
+ (display-buffer (current-buffer)))))
(provide 'flymake)
+
+(require 'flymake-proc)
+
;;; flymake.el ends here
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index b15da92a5c1..b73ee2525fd 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index cc9205c0d8a..58552759b95 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Credits:
@@ -400,14 +400,22 @@ valid signal handlers.")
(const :tag "Unlimited" nil))
:version "22.1")
-(defcustom gdb-non-stop-setting t
- "When in non-stop mode, stopped threads can be examined while
+(defcustom gdb-non-stop-setting (not (eq system-type 'windows-nt))
+ "If non-nil, GDB sessions are expected to support the non-stop mode.
+When in the non-stop mode, stopped threads can be examined while
other threads continue to execute.
+If this is non-nil, GDB will be sent the \"set non-stop 1\" command,
+and if that results in an error, the non-stop setting will be
+turned off automatically.
+
+On MS-Windows, this is off by default, because MS-Windows targets
+don't support the non-stop mode.
+
GDB session needs to be restarted for this setting to take effect."
:type 'boolean
:group 'gdb-non-stop
- :version "23.2")
+ :version "26.1")
;; TODO Some commands can't be called with --all (give a notice about
;; it in setting doc)
@@ -2188,7 +2196,10 @@ a GDB/MI reply message."
(defun gdbmi-bnf-console-stream-output (c-string)
"Handler for the console-stream-output GDB/MI output grammar rule."
- (gdb-console c-string))
+ (gdb-console c-string)
+ ;; We've written to the GUD console, so we should print the prompt
+ ;; after the next result-class or async-class.
+ (setq gdb-first-done-or-error t))
(defun gdbmi-bnf-target-stream-output (_c-string)
"Handler for the target-stream-output GDB/MI output grammar rule."
@@ -2374,7 +2385,7 @@ file names include non-ASCII characters."
;; sequences are not split between chunks of output of the GDB process
;; due to buffering, and arrive together. Finally, if some string
;; included literal \nnn strings (as opposed to non-ASCII characters
-;; converted by by GDB/MI to octal escapes), this decoding will mangle
+;; converted by GDB/MI to octal escapes), this decoding will mangle
;; those strings. When/if GDB acquires the ability to not
;; escape-protect non-ASCII characters in its MI output, this kludge
;; should be removed.
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index f476ac0a566..699ef2eee82 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index b3d8a51ceeb..c2d80223541 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -31,7 +31,6 @@
(require 'compile)
-
(defgroup grep nil
"Run `grep' and display the results."
:group 'tools
@@ -47,8 +46,8 @@ to avoid computing them again.")
(defun grep-apply-setting (symbol value)
"Set SYMBOL to VALUE, and update `grep-host-defaults-alist'.
SYMBOL should be one of `grep-command', `grep-template',
-`grep-use-null-device', `grep-find-command',
-`grep-find-template', `grep-find-use-xargs', or
+`grep-use-null-device', `grep-find-command' `grep-find-template',
+`grep-find-use-xargs', `grep-use-null-filename-separator', or
`grep-highlight-matches'."
(when grep-host-defaults-alist
(let* ((host-id
@@ -160,6 +159,15 @@ Customize or call the function `grep-apply-setting'."
:set 'grep-apply-setting
:group 'grep)
+(defcustom grep-use-null-filename-separator 'auto-detect
+ "If non-nil, use `grep's `--null' option.
+This is done to disambiguate file names in `grep's output."
+ :type '(choice (const :tag "Do Not Use `--null'" nil)
+ (const :tag "Use `--null'" t)
+ (other :tag "Not Set" auto-detect))
+ :set 'grep-apply-setting
+ :group 'grep)
+
;;;###autoload
(defcustom grep-find-command nil
"The default find command for \\[grep-find].
@@ -359,31 +367,42 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
;;;###autoload
(defconst grep-regexp-alist
- '(
- ;; Use a tight regexp to handle weird file names (with colons
- ;; in them) as well as possible. E.g., use [1-9][0-9]* rather
- ;; than [0-9]+ so as to accept ":034:" in file names.
- ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:"
+ `((,(concat "^\\(?:"
+ ;; Parse using NUL characters when `--null' is used.
+ ;; Note that we must still assume no newlines in
+ ;; filenames due to "foo: Is a directory." type
+ ;; messages.
+ "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):"
+ "\\|"
+ ;; Fallback if `--null' is not used, use a tight regexp
+ ;; to handle weird file names (with colons in them) as
+ ;; well as possible. E.g., use [1-9][0-9]* rather than
+ ;; [0-9]+ so as to accept ":034:" in file names.
+ "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:"
+ "\\)")
1 2
;; Calculate column positions (col . end-col) of first grep match on a line
- ((lambda ()
- (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 ()
+ (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 ()
- (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)))))))
+ ,(lambda ()
+ (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'.")
+ "Regexp used to match grep hits.
+See `compilation-error-regexp-alist' for format details.")
(defvar grep-first-column 0 ; bug#10594
"Value to use for `compilation-first-column' in grep buffers.")
@@ -422,7 +441,9 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies
(2 grep-error-face nil t))
;; "filename-linenumber-" format is used for context lines in GNU grep,
;; "filename=linenumber=" for lines with function names in "git grep -p".
- ("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face)))
+ ("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" (0 grep-context-face)
+ (1 (if (eq (char-after (match-beginning 1)) ?\0)
+ `(face nil display ,(match-string 2))))))
"Additional things to highlight in grep output.
This gets tacked on the end of the generated expressions.")
@@ -538,6 +559,8 @@ This function is called from `compilation-filter-hook'."
(grep-use-null-device ,grep-use-null-device)
(grep-find-command ,grep-find-command)
(grep-find-template ,grep-find-template)
+ (grep-use-null-filename-separator
+ ,grep-use-null-filename-separator)
(grep-find-use-xargs ,grep-find-use-xargs)
(grep-highlight-matches ,grep-highlight-matches)))))
(let* ((host-id
@@ -550,7 +573,8 @@ This function is called from `compilation-filter-hook'."
;; computed for every host once.
(dolist (setting '(grep-command grep-template
grep-use-null-device grep-find-command
- grep-find-template grep-find-use-xargs
+ grep-use-null-filename-separator
+ grep-find-template grep-find-use-xargs
grep-highlight-matches))
(set setting
(cadr (or (assq setting host-defaults)
@@ -576,6 +600,21 @@ This function is called from `compilation-filter-hook'."
(concat (regexp-quote hello-file)
":[0-9]+:English")))))))))
+ (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" "^English" ,hello-file)))
+ (if grep-use-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]+:English"))))))))
+
(when (eq grep-highlight-matches 'auto-detect)
(setq grep-highlight-matches
(with-temp-buffer
@@ -591,6 +630,7 @@ This function is called from `compilation-filter-hook'."
grep-template grep-find-template)
(let ((grep-options
(concat (if grep-use-null-device "-n" "-nH")
+ (if grep-use-null-filename-separator " --null")
(if (grep-probe grep-program
`(nil nil nil "-e" "foo" ,null-device)
nil 1)
@@ -863,7 +903,10 @@ substitution string. Note dynamic scoping of variables.")
(read-regexp "Search for" 'grep-tag-default 'grep-regexp-history))
(defun grep-read-files (regexp)
- "Read files arg for interactive grep."
+ "Read a file-name pattern arg for interactive grep.
+The pattern can include shell wildcards. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'."
(let* ((bn (or (buffer-file-name)
(replace-regexp-in-string "<[0-9]+>\\'" "" (buffer-name))))
(fn (and bn
@@ -896,7 +939,7 @@ substitution string. Note dynamic scoping of variables.")
(car (car grep-files-aliases))))
(files (completing-read
(concat "Search for \"" regexp
- "\" in files"
+ "\" in files matching wildcard"
(if default (concat " (default " default ")"))
": ")
'read-file-name-internal
@@ -913,7 +956,9 @@ substitution string. Note dynamic scoping of variables.")
"Run grep, searching for REGEXP in FILES in directory DIR.
The search is limited to file names matching shell pattern FILES.
FILES may use abbreviations defined in `grep-files-aliases', e.g.
-entering `ch' is equivalent to `*.[ch]'.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
With \\[universal-argument] prefix, you can edit the constructed shell command line
before it is executed.
@@ -991,7 +1036,9 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
"Recursively grep for REGEXP in FILES in directory tree rooted at DIR.
The search is limited to file names matching shell pattern FILES.
FILES may use abbreviations defined in `grep-files-aliases', e.g.
-entering `ch' is equivalent to `*.[ch]'.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
With \\[universal-argument] prefix, you can edit the constructed shell command line
before it is executed.
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index e9ca7eade36..7d044b294da 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1830,7 +1830,7 @@ and source-file directory for your debugger."
;;
;; Type M-n to step over the current line and M-s to step into it. That,
;; along with the JDB 'help' command should get you started. The 'quit'
-;; JDB command will get out out of the debugger. There is some truly
+;; JDB command will get out of the debugger. There is some truly
;; pathetic JDB documentation available at:
;;
;; http://java.sun.com/products/jdk/1.1/debugging/
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index b34ea1c4ae1..b1a2a35d55f 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1657,8 +1657,8 @@ first arg will be `hif-etc'."
;; The original version of hideif evaluates the macro early and store the
;; final values for the defined macro into the symbol database (aka
-;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed
-;; tree -> [value]". (The square bracket refers to what's stored in in our
+;; `hide-ifdef-env'). The evaluation process is "strings -> tokens -> parsed
+;; tree -> [value]". (The square bracket refers to what's stored in our
;; `hide-ifdef-env'.)
;;
;; This forbids the evaluation of an argumented macro since the parameters
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 5328526abd9..f3abf373d4e 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
index 92a89fef70b..a164b703f18 100644
--- a/lisp/progmodes/icon.el
+++ b/lisp/progmodes/icon.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el
index d2758ccd62e..a7e49b6ea44 100644
--- a/lisp/progmodes/idlw-complete-structtag.el
+++ b/lisp/progmodes/idlw-complete-structtag.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -148,9 +148,9 @@ an up-to-date completion list."
(not (equal start idlwave-current-tags-completion-pos)))
(idlwave-prepare-structure-tag-completion var))
(setq idlwave-current-tags-completion-pos start)
- (setq idlwave-completion-help-info
+ (setq idlwave-completion-help-info
(list 'idlwave-complete-structure-tag-help))
- (idlwave-complete-in-buffer 'structtag 'structtag
+ (idlwave-complete-in-buffer 'structtag 'structtag
idlwave-current-struct-tags nil
"Select a structure tag" "structure tag")
t) ; we did the completion: return t to skip other completions
@@ -169,7 +169,7 @@ an up-to-date completion list."
(if (derived-mode-p 'idlwave-shell-mode)
;; OK, we are in the shell, do it dynamically
(progn
- (message "preparing shell tags")
+ (message "preparing shell tags")
;; The following call puts the tags into `idlwave-current-struct-tags'
(idlwave-complete-structure-tag-query-shell var)
;; initialize
@@ -191,7 +191,7 @@ an up-to-date completion list."
;; Find possible definitions of the structure.
(while (idlwave-find-structure-definition var nil 'all)
(let ((tags (idlwave-struct-tags)))
- (when tags
+ (when tags
;; initialize
(setq idlwave-sint-structtags nil
idlwave-current-tags-buffer (current-buffer)
diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el
index e82ed06164d..244e2b38436 100644
--- a/lisp/progmodes/idlw-help.el
+++ b/lisp/progmodes/idlw-help.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index e7497e8e4fd..39d24d4f9d9 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el
index 2fda49d91f4..c53e5e5989a 100644
--- a/lisp/progmodes/idlw-toolbar.el
+++ b/lisp/progmodes/idlw-toolbar.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el
index f070000c867..92a42b1cb94 100644
--- a/lisp/progmodes/idlwave.el
+++ b/lisp/progmodes/idlwave.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -5240,7 +5240,7 @@ Can run from `after-save-hook'."
class
(cond ((not (boundp 'idlwave-scanning-lib))
(list 'buffer (buffer-file-name)))
-; ((string= (downcase (file-name-base))
+; ((string= (downcase (file-name-base (buffer-file-name))
; (downcase name))
; (list 'lib))
; (t (cons 'lib (file-name-nondirectory (buffer-file-name))))
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
index 7de3a796ae1..e398c3ed64e 100644
--- a/lisp/progmodes/inf-lisp.el
+++ b/lisp/progmodes/inf-lisp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index bae9e52bf0f..1f86909362e 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary
@@ -475,6 +475,11 @@ This applies to function movement, marking, and so on."
:type 'boolean
:group 'js)
+(defcustom js-indent-align-list-continuation t
+ "Align continuation of non-empty ([{ lines in `js-mode'."
+ :type 'boolean
+ :group 'js)
+
(defcustom js-comment-lineup-func #'c-lineup-C-comments
"Lineup function for `cc-mode-style', for C comments in `js-mode'."
:type 'function
@@ -1829,10 +1834,15 @@ This performs fontification according to `js--class-styles'."
(save-excursion
(back-to-indentation)
(if (js--looking-at-operator-p)
- (or (not (memq (char-after) '(?- ?+)))
- (progn
- (forward-comment (- (point)))
- (not (memq (char-before) '(?, ?\[ ?\()))))
+ (if (eq (char-after) ?/)
+ (prog1
+ (not (nth 3 (syntax-ppss (1+ (point)))))
+ (forward-char -1))
+ (or
+ (not (memq (char-after) '(?- ?+)))
+ (progn
+ (forward-comment (- (point)))
+ (not (memq (char-before) '(?, ?\[ ?\())))))
(and (js--find-newline-backward)
(progn
(skip-chars-backward " \t")
@@ -1967,8 +1977,12 @@ statement spanning multiple lines; otherwise, return nil."
(save-excursion
(back-to-indentation)
(when (not (looking-at js--declaration-keyword-re))
- (when (looking-at js--indent-operator-re)
- (goto-char (match-end 0)))
+ (let ((pt (point)))
+ (when (looking-at js--indent-operator-re)
+ (goto-char (match-end 0)))
+ ;; The "operator" is probably a regexp literal opener.
+ (when (nth 3 (syntax-ppss))
+ (goto-char pt)))
(while (and (not at-opening-bracket)
(not (bobp))
(let ((pos (point)))
@@ -2092,7 +2106,8 @@ indentation is aligned to that column."
(switch-keyword-p (looking-at "default\\_>\\|case\\_>[^:]"))
(continued-expr-p (js--continued-expression-p)))
(goto-char (nth 1 parse-status)) ; go to the opening char
- (if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)")
+ (if (or (not js-indent-align-list-continuation)
+ (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)"))
(progn ; nothing following the opening paren/bracket
(skip-syntax-backward " ")
(when (eq (char-before) ?\)) (backward-list))
@@ -2374,6 +2389,10 @@ i.e., customize JSX element indentation with `sgml-basic-offset',
(fill-paragraph-function #'c-fill-paragraph))
(c-fill-paragraph justify)))
+(defun js-do-auto-fill ()
+ (let ((js--filling-paragraph t))
+ (c-do-auto-fill)))
+
;;; Type database and Imenu
;; We maintain a cache of semantic information, i.e., the classes and
@@ -3857,6 +3876,7 @@ If one hasn't been set, or if it's stale, prompt for a new one."
(setq-local comment-start "// ")
(setq-local comment-end "")
(setq-local fill-paragraph-function #'js-c-fill-paragraph)
+ (setq-local normal-auto-fill-function #'js-do-auto-fill)
;; Parse cache
(add-hook 'before-change-functions #'js--flush-caches t t)
diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el
index 389ddfca6b1..980ef9014c7 100644
--- a/lisp/progmodes/ld-script.el
+++ b/lisp/progmodes/ld-script.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -85,10 +85,12 @@
;; 3.4.5 Other Linker Script Commands
"ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION"
"INHIBIT_COMMON_ALLOCATION" "INSERT" "AFTER" "BEFORE"
- "NOCROSSREFS" "OUTPUT_ARCH" "LD_FEATURE"
- ;; 3.5.2 PROVIDE
+ "NOCROSSREFS" "NOCROSSREFS_TO" "OUTPUT_ARCH" "LD_FEATURE"
+ ;; 3.5.2 HIDDEN
+ "HIDDEN"
+ ;; 3.5.3 PROVIDE
"PROVIDE"
- ;; 3.5.3 PROVIDE_HIDDEN
+ ;; 3.5.4 PROVIDE_HIDDEN
"PROVIDE_HIDDEN"
;; 3.6 SECTIONS Command
"SECTIONS"
@@ -142,6 +144,7 @@
"DEFINED"
"LENGTH" "len" "l"
"LOADADDR"
+ "LOG2CEIL"
"MAX"
"MIN"
"NEXT"
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
index b48654ff41b..ebb66fa05ac 100644
--- a/lisp/progmodes/m4-mode.el
+++ b/lisp/progmodes/m4-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index 5cda7bb219c..4c926f4de95 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el
index 7a3c0fb0357..93119b1e8d0 100644
--- a/lisp/progmodes/mantemp.el
+++ b/lisp/progmodes/mantemp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el
index 33772263884..a47ae28a4af 100644
--- a/lisp/progmodes/meta-mode.el
+++ b/lisp/progmodes/meta-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index f884de1fcca..6d2d64af960 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Major mode for the mix asm language.
@@ -30,7 +30,7 @@
;; For optimal use, also use GNU MDK. Compiling needs mixasm, running
;; and debugging needs mixvm and mixvm.el from GNU MDK. You can get
;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and
-;; `ftp://ftp.gnu.org/pub/gnu/mdk'.
+;; `https://ftp.gnu.org/pub/gnu/mdk'.
;;
;; To use this mode, place the following in your init file:
;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index ac9ba630c4e..dc6bba44f32 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -37,7 +37,7 @@
(defgroup octave nil
"Editing Octave code."
:link '(custom-manual "(octave-mode)Top")
- :link '(url-link "http://www.gnu.org/s/octave")
+ :link '(url-link "https://www.gnu.org/s/octave")
:link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
:group 'languages)
@@ -612,7 +612,7 @@ Key bindings:
(defcustom inferior-octave-prompt
;; For Octave >= 3.8, default is always 'octave', see
- ;; http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
+ ;; https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
"\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ "
"Regexp to match prompts for the inferior Octave process."
:type 'regexp)
@@ -839,7 +839,7 @@ startup file, `~/.emacs-octave'."
(inferior-octave-send-list-and-digest
(list "more off;\n"
(unless (equal inferior-octave-output-string ">> ")
- ;; See http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
+ ;; See https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50
"PS1 ('octave> ');\n")
(when (and inferior-octave-startup-file
(file-exists-p inferior-octave-startup-file))
@@ -867,7 +867,7 @@ startup file, `~/.emacs-octave'."
(defun inferior-octave-completion-at-point ()
"Return the data to complete the Octave symbol at point."
- ;; http://debbugs.gnu.org/14300
+ ;; https://debbugs.gnu.org/14300
(unless (string-match-p "/" (or (comint--match-partial-filename) ""))
(let ((beg (save-excursion
(skip-syntax-backward "w_" (comint-line-beginning-position))
@@ -1497,7 +1497,7 @@ current buffer file unless called with a prefix arg \\[universal-argument]."
(string (buffer-substring-no-properties beg end))
line)
(with-current-buffer inferior-octave-buffer
- ;; http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00095.html
+ ;; 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 ""))
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 6a61564b446..12353c4fafd 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
index a7d0624a74a..5f893b87c2e 100644
--- a/lisp/progmodes/pascal.el
+++ b/lisp/progmodes/pascal.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 3def37a2ea8..f3cb8109133 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -135,7 +135,7 @@
'(;; Functions
(nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1)
;;Variables
- ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
+ ("Variables" "^[ \t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1)
("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1)
("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1))
"Imenu generic expression for Perl mode. See `imenu-generic-expression'.")
@@ -179,8 +179,9 @@
"BEGIN" "END" "return" "exec" "eval") t)
"\\>")
;;
- ;; Fontify local and my keywords as types.
- ("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
+ ;; Fontify declarators and prefixes as types.
+ ("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" . font-lock-type-face) ; declarators
+ ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes
;;
;; Fontify function, variable and file name references.
("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face)
@@ -213,25 +214,6 @@
(regexp-opt perl--syntax-exp-intro-keywords)
"\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*")))
-;; FIXME: handle here-docs and regexps.
-;; <<EOF <<"EOF" <<'EOF' (no space)
-;; see `man perlop'
-;; ?...?
-;; /.../
-;; m [...]
-;; m /.../
-;; q /.../ = '...'
-;; qq /.../ = "..."
-;; qx /.../ = `...`
-;; qr /.../ = precompiled regexp =~=~ m/.../
-;; qw /.../
-;; s /.../.../
-;; s <...> /.../
-;; s '...'...'
-;; tr /.../.../
-;; y /.../.../
-;;
-;; <file*glob>
(defun perl-syntax-propertize-function (start end)
(let ((case-fold-search nil))
(goto-char start)
@@ -324,23 +306,25 @@
((concat
"\\(?:"
;; << "EOF", << 'EOF', or << \EOF
- "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
+ "<<\\(~\\)?[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
;; disambiguate with the left-bitshift operator.
- "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:\\sw+\\)\\)"
+ "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
- (3 (let* ((st (get-text-property (match-beginning 3) 'syntax-table))
- (name (match-string 1)))
- (goto-char (match-end 1))
+ (4 (let* ((st (get-text-property (match-beginning 4) '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))))
;; Leave the property of the newline unchanged.
st
(cons (car (string-to-syntax "< c"))
;; Remember the names of heredocs found on this line.
- (cons (pcase (aref name 0)
- (`?\\ (substring name 1))
- ((or `?\" `?\' `?\`) (substring name 1 -1))
- (_ name))
+ (cons (cons (pcase (aref name 0)
+ (`?\\ (substring name 1))
+ ((or `?\" `?\' `?\`) (substring name 1 -1))
+ (_ name))
+ indented)
(cdr st)))))))
;; We don't call perl-syntax-propertize-special-constructs directly
;; from the << rule, because there might be other elements (between
@@ -383,7 +367,9 @@
(goto-char (nth 8 state)))
(while (and names
(re-search-forward
- (concat "^" (regexp-quote (pop names)) "\n")
+ (pcase-let ((`(,name . ,indented) (pop names)))
+ (concat "^" (if indented "[ \t]*")
+ (regexp-quote name) "\n"))
limit 'move))
(unless names
(put-text-property (1- (point)) (point) 'syntax-table
@@ -595,6 +581,73 @@ create a new comment."
(match-string-no-properties 1))))
+;;; Flymake support
+(defcustom perl-flymake-command '("perl" "-w" "-c")
+ "External tool used to check Perl source code.
+This is a non empty list of strings, the checker tool possibly
+followed by required arguments. Once launched it will receive
+the Perl source to be checked as its standard input."
+ :group 'perl
+ :type '(repeat string))
+
+(defvar-local perl--flymake-proc nil)
+
+;;;###autoload
+(defun perl-flymake (report-fn &rest _args)
+ "Perl backend for Flymake. Launches
+`perl-flymake-command' (which see) and passes to its standard
+input the contents of the current buffer. The output of this
+command is analyzed for error and warning messages."
+ (unless (executable-find (car perl-flymake-command))
+ (error "Cannot find a suitable checker"))
+
+ (when (process-live-p perl--flymake-proc)
+ (kill-process perl--flymake-proc))
+
+ (let ((source (current-buffer)))
+ (save-restriction
+ (widen)
+ (setq
+ perl--flymake-proc
+ (make-process
+ :name "perl-flymake" :noquery t :connection-type 'pipe
+ :buffer (generate-new-buffer " *perl-flymake*")
+ :command perl-flymake-command
+ :sentinel
+ (lambda (proc _event)
+ (when (eq 'exit (process-status proc))
+ (unwind-protect
+ (if (with-current-buffer source (eq proc perl--flymake-proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp
+ "^\\(.+\\) at - line \\([0-9]+\\)"
+ nil t)
+ for msg = (match-string 1)
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number (match-string 2)))
+ for type =
+ (if (string-match
+ "\\(Scalar value\\|Useless use\\|Unquoted string\\)"
+ msg)
+ :warning
+ :error)
+ collect (flymake-make-diagnostic source
+ beg
+ end
+ type
+ msg)
+ into diags
+ finally (funcall report-fn diags)))
+ (flymake-log :debug "Canceling obsolete check %s"
+ proc))
+ (kill-buffer (process-buffer proc)))))))
+ (process-send-region perl--flymake-proc (point-min) (point-max))
+ (process-send-eof perl--flymake-proc))))
+
+
(defvar perl-mode-hook nil
"Normal hook to run when entering Perl mode.")
@@ -679,7 +732,9 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
;; Setup outline-minor-mode.
(setq-local outline-regexp perl-outline-regexp)
(setq-local outline-level 'perl-outline-level)
- (setq-local add-log-current-defun-function #'perl-current-defun-name))
+ (setq-local add-log-current-defun-function #'perl-current-defun-name)
+ ;; Setup Flymake
+ (add-hook 'flymake-diagnostic-functions #'perl-flymake nil t))
;; This is used by indent-for-comment
;; to decide how much to indent a comment in Perl code
@@ -692,7 +747,9 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
(define-obsolete-function-alias 'electric-perl-terminator
'perl-electric-terminator "22.1")
(defun perl-electric-noindent-p (_char)
- (unless (eolp) 'no-indent))
+ ;; To reproduce the old behavior, ;, {, }, and : are made electric, but
+ ;; we only want them to be electric at EOL.
+ (unless (or (bolp) (eolp)) 'no-indent))
(defun perl-electric-terminator (arg)
"Insert character and maybe adjust indentation.
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index 8f66f1c9541..f727e458b2b 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -225,11 +225,11 @@ on the symbol."
(apply #'font-lock-flush prettify-symbols--current-symbol-bounds)
(setq prettify-symbols--current-symbol-bounds nil))
;; Unprettify the current symbol.
- (when-let ((c (get-prop-as-list 'composition))
- (s (get-prop-as-list 'prettify-symbols-start))
- (e (get-prop-as-list 'prettify-symbols-end))
- (s (apply #'min s))
- (e (apply #'max e)))
+ (when-let* ((c (get-prop-as-list 'composition))
+ (s (get-prop-as-list 'prettify-symbols-start))
+ (e (get-prop-as-list 'prettify-symbols-end))
+ (s (apply #'min s))
+ (e (apply #'max e)))
(with-silent-modifications
(setq prettify-symbols--current-symbol-bounds (list s e))
(remove-text-properties s e '(composition))))))
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ed1d564752c..93a945edaa4 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -307,7 +307,11 @@ DIRS must contain directory names."
(defun project-find-regexp (regexp)
"Find all matches for REGEXP in the current project's roots.
With \\[universal-argument] prefix, you can specify the directory
-to search in, and the file name pattern to search for."
+to search in, and the file name pattern to search for. The
+pattern may use abbreviations defined in `grep-files-aliases',
+e.g. entering `ch' is equivalent to `*.[ch]'. As whitespace
+triggers completion when entering a pattern, including it
+requires quoting, e.g. `\\[quoted-insert]<space>'."
(interactive (list (project--read-regexp)))
(let* ((pr (project-current t))
(dirs (if current-prefix-arg
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index c234cca3ff9..13cd6be9f7d 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -26,7 +26,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Original author: Masanobu UMEDA <umerin(at)mse(dot)kyutech(dot)ac(dot)jp>
;; Parts of this file was taken from a modified version of the original
@@ -358,13 +358,15 @@ The version numbers are of the format (Major . Minor)."
(defcustom prolog-indent-width 4
"The indentation width used by the editing buffer."
:group 'prolog-indentation
- :type 'integer)
+ :type 'integer
+ :safe 'integerp)
(defcustom prolog-left-indent-regexp "\\(;\\|\\*?->\\)"
"Regexp for `prolog-electric-if-then-else-flag'."
:version "24.1"
:group 'prolog-indentation
- :type 'regexp)
+ :type 'regexp
+ :safe 'stringp)
(defcustom prolog-paren-indent-p nil
"If non-nil, increase indentation for parenthesis expressions.
@@ -374,14 +376,16 @@ right (if this variable is non-nil) or in the same way as for compound
terms (if this variable is nil, default)."
:version "24.1"
:group 'prolog-indentation
- :type 'boolean)
+ :type 'boolean
+ :safe 'booleanp)
(defcustom prolog-paren-indent 4
"The indentation increase for parenthesis expressions.
Only used in ( If -> Then ; Else) and ( Disj1 ; Disj2 ) style expressions."
:version "24.1"
:group 'prolog-indentation
- :type 'integer)
+ :type 'integer
+ :safe 'integerp)
(defcustom prolog-parse-mode 'beg-of-clause
"The parse mode used (decides from which point parsing is done).
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 7e2b7fdf79f..69ea3a70f56 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -28,7 +28,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 464b931cffc..9e09bfc5941 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -80,7 +80,7 @@
;; Using the "console" subcommand to start IPython in server-client
;; mode is known to fail intermittently due a bug on IPython itself
-;; (see URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27').
+;; (see URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27').
;; There seems to be a race condition in the IPython server (A.K.A
;; kernel) when code is sent while it is still initializing, sometimes
;; causing the shell to get stalled. With that said, if an IPython
@@ -97,7 +97,7 @@
;; Missing or delayed output used to happen due to differences between
;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7.
-;; See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To
+;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To
;; avoid this, the `python-shell-unbuffered' defaults to non-nil and
;; controls whether `python-shell-calculate-process-environment'
;; should set the "PYTHONUNBUFFERED" environment variable on startup:
@@ -273,7 +273,7 @@
(autoload 'help-function-arglist "help-fns")
;;;###autoload
-(add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode))
+(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode))
;;;###autoload
(add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode))
@@ -640,10 +640,14 @@ The type returned can be `comment', `string' or `paren'."
((python-rx string-delimiter)
(0 (ignore (python-syntax-stringify))))))
-(defconst python--prettify-symbols-alist
+(defvar python-prettify-symbols-alist
'(("lambda" . ?λ)
("and" . ?∧)
- ("or" . ?∨)))
+ ("or" . ?∨))
+ "Value for `prettify-symbols-alist' in `python-mode'.")
+
+(define-obsolete-variable-alias 'python--prettify-symbols-alist
+ 'python-prettify-symbols-alist "26.1")
(defsubst python-syntax-count-quotes (quote-char &optional point limit)
"Count number of quotes around point (max is 3).
@@ -1253,7 +1257,11 @@ This function is intended to be added to `post-self-insert-hook.'
If a line renders a paren alone, after adding a char before it,
the line will be re-indented automatically if needed."
(when (and electric-indent-mode
- (eq (char-before) last-command-event))
+ (eq (char-before) last-command-event)
+ (not (python-syntax-context 'string))
+ (save-excursion
+ (beginning-of-line)
+ (not (python-syntax-context 'string (syntax-ppss)))))
(cond
;; Electric indent inside parens
((and
@@ -2109,20 +2117,25 @@ remote host, the returned value is intended for
(defun python-shell-calculate-exec-path ()
"Calculate `exec-path'.
Prepends `python-shell-exec-path' and adds the binary directory
-for virtualenv if `python-shell-virtualenv-root' is set. If
-`default-directory' points to a remote host, the returned value
-appends `python-shell-remote-exec-path' instead of `exec-path'."
+for virtualenv if `python-shell-virtualenv-root' is set - this
+will use the python interpreter from inside the virtualenv when
+starting the shell. If `default-directory' points to a remote host,
+the returned value appends `python-shell-remote-exec-path' instead
+of `exec-path'."
(let ((new-path (copy-sequence
(if (file-remote-p default-directory)
python-shell-remote-exec-path
- exec-path))))
+ exec-path)))
+
+ ;; Windows and POSIX systems use different venv directory structures
+ (virtualenv-bin-dir (if (eq system-type 'windows-nt) "Scripts" "bin")))
(python-shell--add-to-path-with-priority
new-path python-shell-exec-path)
(if (not python-shell-virtualenv-root)
new-path
(python-shell--add-to-path-with-priority
new-path
- (list (expand-file-name "bin" python-shell-virtualenv-root)))
+ (list (expand-file-name virtualenv-bin-dir python-shell-virtualenv-root)))
new-path)))
(defun python-shell-tramp-refresh-remote-path (vec paths)
@@ -2212,6 +2225,11 @@ machine then modifies `tramp-remote-process-environment' and
Do not set this variable directly, instead use
`python-shell-prompt-set-calculated-regexps'.")
+(defvar python-shell--block-prompt nil
+ "Input block prompt for inferior python shell.
+Do not set this variable directly, instead use
+`python-shell-prompt-set-calculated-regexps'.")
+
(defvar python-shell--prompt-calculated-output-regexp nil
"Calculated output prompt regexp for inferior python shell.
Do not set this variable directly, instead use
@@ -2245,7 +2263,11 @@ detection and just returns nil."
;; `condition-case' and displaying the error message to
;; the user in the no-prompts warning.
(ignore-errors
- (let ((code-file (python-shell--save-temp-file code)))
+ (let ((code-file
+ ;; Python 2.x on Windows does not handle
+ ;; carriage returns in unbuffered mode.
+ (let ((inhibit-eol-conversion (getenv "PYTHONUNBUFFERED")))
+ (python-shell--save-temp-file code))))
;; Use `process-file' as it is remote-host friendly.
(process-file
interpreter
@@ -2362,6 +2384,7 @@ and `python-shell-output-prompt-regexp' using the values from
(dolist (prompt (butlast detected-prompts))
(setq prompt (regexp-quote prompt))
(cl-pushnew prompt input-prompts :test #'string=))
+ (setq python-shell--block-prompt (nth 1 detected-prompts))
(cl-pushnew (regexp-quote
(car (last detected-prompts)))
output-prompts :test #'string=))
@@ -2722,6 +2745,7 @@ variable.
(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)
(python-shell-prompt-set-calculated-regexps)
(setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp)
@@ -3289,8 +3313,9 @@ the full statement in the case of imports."
(defcustom python-shell-completion-native-disabled-interpreters
;; PyPy's readline cannot handle some escape sequences yet. Native
;; completion was found to be non-functional for IPython (see
- ;; Bug#25067).
- (list "pypy" "ipython")
+ ;; Bug#25067). Native completion doesn't work on w32 (Bug#28580).
+ (if (eq system-type 'windows-nt) '("")
+ '("pypy" "ipython"))
"List of disabled interpreters.
When a match is found, native completion is disabled."
:version "25.1"
@@ -3431,6 +3456,8 @@ def __PYTHON_EL_native_completion_setup():
instance.rlcomplete = new_completer
if readline.__doc__ and 'libedit' in readline.__doc__:
+ raise Exception('''libedit based readline is known not to work,
+ see etc/PROBLEMS under \"In Inferior Python mode, input is echoed\".''')
readline.parse_and_bind('bind ^I rl_complete')
else:
readline.parse_and_bind('tab: complete')
@@ -3439,7 +3466,9 @@ def __PYTHON_EL_native_completion_setup():
print ('python.el: native completion setup loaded')
except:
- print ('python.el: native completion setup failed')
+ import sys
+ print ('python.el: native completion setup failed, %s: %s'
+ % sys.exc_info()[:2])
__PYTHON_EL_native_completion_setup()" process)
(when (and
@@ -3628,7 +3657,14 @@ using that one instead of current buffer's process."
;; Also, since pdb interaction is single-line
;; based, this is enough.
(string-match-p python-shell-prompt-pdb-regexp prompt))
- #'python-shell-completion-get-completions)
+ (if (or (equal python-shell--block-prompt prompt)
+ (string-match-p
+ python-shell-prompt-block-regexp prompt))
+ ;; The non-native completion mechanism sends
+ ;; newlines to the interpreter, so we can't use
+ ;; it during a multiline statement (Bug#28051).
+ #'ignore
+ #'python-shell-completion-get-completions))
(t #'python-shell-completion-native-get-completions)))))
(list start end
(completion-table-dynamic
@@ -4253,8 +4289,10 @@ See `python-check-command' for the default."
import inspect
try:
str_type = basestring
+ argspec_function = inspect.getargspec
except NameError:
str_type = str
+ argspec_function = inspect.getfullargspec
if isinstance(obj, str_type):
obj = eval(obj, globals())
doc = inspect.getdoc(obj)
@@ -4267,9 +4305,7 @@ See `python-check-command' for the default."
target = obj
objtype = 'def'
if target:
- args = inspect.formatargspec(
- *inspect.getargspec(target)
- )
+ args = inspect.formatargspec(*argspec_function(target))
name = obj.__name__
doc = '{objtype} {name}{args}'.format(
objtype=objtype, name=name, args=args
@@ -5115,6 +5151,138 @@ returned as is."
(ignore-errors (string-match regexp "") t))
+;;; Flymake integration
+
+(defgroup python-flymake nil
+ "Integration between Python and Flymake."
+ :group 'python
+ :link '(custom-group-link :tag "Flymake" flymake)
+ :version "26.1")
+
+(defcustom python-flymake-command '("pyflakes")
+ "The external tool that will be used to perform the syntax check.
+This is a non empty list of strings, the checker tool possibly followed by
+required arguments. Once launched it will receive the Python source to be
+checked as its standard input.
+To use `flake8' you would set this to (\"flake8\" \"-\")."
+ :group 'python-flymake
+ :type '(repeat string))
+
+;; The default regexp accomodates for older pyflakes, which did not
+;; report the column number, and at the same time it's compatible with
+;; flake8 output, although it may be redefined to explicitly match the
+;; TYPE
+(defcustom python-flymake-command-output-pattern
+ (list
+ "^\\(?:<?stdin>?\\):\\(?1:[0-9]+\\):\\(?:\\(?2:[0-9]+\\):\\)? \\(?3:.*\\)$"
+ 1 2 nil 3)
+ "Specify how to parse the output of `python-flymake-command'.
+The value has the form (REGEXP LINE COLUMN TYPE MESSAGE): if
+REGEXP matches, the LINE'th subexpression gives the line number,
+the COLUMN'th subexpression gives the column number on that line,
+the TYPE'th subexpression gives the type of the message and the
+MESSAGE'th gives the message text itself.
+
+If COLUMN or TYPE are nil or that index didn't match, that
+information is not present on the matched line and a default will
+be used."
+ :group 'python-flymake
+ :type '(list regexp
+ (integer :tag "Line's index")
+ (choice
+ (const :tag "No column" nil)
+ (integer :tag "Column's index"))
+ (choice
+ (const :tag "No type" nil)
+ (integer :tag "Type's index"))
+ (integer :tag "Message's index")))
+
+(defcustom python-flymake-msg-alist
+ '(("\\(^redefinition\\|.*unused.*\\|used$\\)" . :warning))
+ "Alist used to associate messages to their types.
+Each element should be a cons-cell (REGEXP . TYPE), where TYPE must be
+one defined in the variable `flymake-diagnostic-types-alist'.
+For example, when using `flake8' a possible configuration could be:
+
+ ((\"\\(^redefinition\\|.*unused.*\\|used$\\)\" . :warning)
+ (\"^E999\" . :error)
+ (\"^[EW][0-9]+\" . :note))
+
+By default messages are considered errors."
+ :group 'python-flymake
+ :type `(alist :key-type (regexp)
+ :value-type (symbol)))
+
+(defvar-local python--flymake-proc nil)
+
+(defun python--flymake-parse-output (source proc report-fn)
+ "Collect diagnostics parsing checker tool's output line by line."
+ (let ((rx (nth 0 python-flymake-command-output-pattern))
+ (lineidx (nth 1 python-flymake-command-output-pattern))
+ (colidx (nth 2 python-flymake-command-output-pattern))
+ (typeidx (nth 3 python-flymake-command-output-pattern))
+ (msgidx (nth 4 python-flymake-command-output-pattern)))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp rx nil t)
+ for msg = (match-string msgidx)
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number
+ (match-string lineidx))
+ (and colidx
+ (match-string colidx)
+ (string-to-number
+ (match-string colidx))))
+ for type = (or (and typeidx
+ (match-string typeidx)
+ (assoc-default
+ (match-string typeidx)
+ python-flymake-msg-alist
+ #'string-match))
+ (assoc-default msg
+ python-flymake-msg-alist
+ #'string-match)
+ :error)
+ collect (flymake-make-diagnostic
+ source beg end type msg)
+ into diags
+ finally (funcall report-fn diags)))))
+
+(defun python-flymake (report-fn &rest _args)
+ "Flymake backend for Python.
+This backend uses `python-flymake-command' (which see) to launch a process
+that is passed the current buffer's content via stdin.
+REPORT-FN is Flymake's callback function."
+ (unless (executable-find (car python-flymake-command))
+ (error "Cannot find a suitable checker"))
+
+ (when (process-live-p python--flymake-proc)
+ (kill-process python--flymake-proc))
+
+ (let ((source (current-buffer)))
+ (save-restriction
+ (widen)
+ (setq python--flymake-proc
+ (make-process
+ :name "python-flymake"
+ :noquery t
+ :connection-type 'pipe
+ :buffer (generate-new-buffer " *python-flymake*")
+ :command python-flymake-command
+ :sentinel
+ (lambda (proc _event)
+ (when (eq 'exit (process-status proc))
+ (unwind-protect
+ (when (with-current-buffer source
+ (eq proc python--flymake-proc))
+ (python--flymake-parse-output source proc report-fn))
+ (kill-buffer (process-buffer proc)))))))
+ (process-send-region python--flymake-proc (point-min) (point-max))
+ (process-send-eof python--flymake-proc))))
+
+
(defun python-electric-pair-string-delimiter ()
(when (and electric-pair-mode
(memq last-command-event '(?\" ?\'))
@@ -5228,7 +5396,9 @@ returned as is."
(make-local-variable 'python-shell-internal-buffer)
(when python-indent-guess-indent-offset
- (python-indent-guess-indent-offset)))
+ (python-indent-guess-indent-offset))
+
+ (add-hook 'flymake-diagnostic-functions #'python-flymake nil t))
(provide 'python)
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 6f431ecd302..dc1b0f8e2da 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -2253,6 +2253,139 @@ See `font-lock-syntax-table'.")
(progn (set-match-data value) t))
(ruby-match-expression-expansion limit)))))
+;;; Flymake support
+(defvar-local ruby--flymake-proc nil)
+
+(defun ruby-flymake-simple (report-fn &rest _args)
+ "`ruby -wc' backend for Flymake."
+ (unless (executable-find "ruby")
+ (error "Cannot find the ruby executable"))
+
+ (ruby-flymake--helper
+ "ruby-flymake"
+ '("ruby" "-w" "-c")
+ (lambda (_proc source)
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp
+ "^\\(?:.*.rb\\|-\\):\\([0-9]+\\): \\(.*\\)$"
+ nil t)
+ for msg = (match-string 2)
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number (match-string 1)))
+ for type = (if (string-match "^warning" msg)
+ :warning
+ :error)
+ collect (flymake-make-diagnostic source
+ beg
+ end
+ type
+ msg)
+ into diags
+ finally (funcall report-fn diags)))))
+
+(defun ruby-flymake--helper (process-name command parser-fn)
+ (when (process-live-p ruby--flymake-proc)
+ (kill-process ruby--flymake-proc))
+
+ (let ((source (current-buffer)))
+ (save-restriction
+ (widen)
+ (setq
+ ruby--flymake-proc
+ (make-process
+ :name process-name :noquery t :connection-type 'pipe
+ :buffer (generate-new-buffer (format " *%s*" process-name))
+ :command command
+ :sentinel
+ (lambda (proc _event)
+ (when (eq 'exit (process-status proc))
+ (unwind-protect
+ (if (with-current-buffer source (eq proc ruby--flymake-proc))
+ (with-current-buffer (process-buffer proc)
+ (funcall parser-fn proc source))
+ (flymake-log :debug "Canceling obsolete check %s"
+ proc))
+ (kill-buffer (process-buffer proc)))))))
+ (process-send-region ruby--flymake-proc (point-min) (point-max))
+ (process-send-eof ruby--flymake-proc))))
+
+(defcustom ruby-flymake-use-rubocop-if-available t
+ "Non-nil to use the Rubocop Flymake backend.
+Only takes effect if Rubocop is installed."
+ :type 'boolean
+ :group 'ruby
+ :safe 'booleanp)
+
+(defcustom ruby-rubocop-config ".rubocop.yml"
+ "Configuration file for `ruby-flymake-rubocop'."
+ :type 'string
+ :group 'ruby
+ :safe 'stringp)
+
+(defun ruby-flymake-rubocop (report-fn &rest _args)
+ "Rubocop backend for Flymake."
+ (unless (executable-find "rubocop")
+ (error "Cannot find the rubocop executable"))
+
+ (let ((command (list "rubocop" "--stdin" buffer-file-name "--format" "emacs"
+ "--cache" "false" ; Work around a bug in old version.
+ "--display-cop-names"))
+ config-dir)
+ (when buffer-file-name
+ (setq config-dir (locate-dominating-file buffer-file-name
+ ruby-rubocop-config))
+ (when config-dir
+ (setq command (append command (list "--config"
+ (expand-file-name ruby-rubocop-config
+ config-dir)))))
+
+ (ruby-flymake--helper
+ "rubocop-flymake"
+ command
+ (lambda (proc source)
+ ;; Finding the executable is no guarantee of
+ ;; rubocop working, especially in the presence
+ ;; of rbenv shims (which cross ruby versions).
+ (when (eq (process-exit-status proc) 127)
+ ;; Not sure what to do in this case. Maybe ideally we'd
+ ;; switch back to ruby-flymake-simple.
+ (flymake-log :warning "Rubocop returned status 127: %s"
+ (buffer-string)))
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp
+ "^\\(?:.*.rb\\|-\\):\\([0-9]+\\):\\([0-9]+\\): \\(.*\\)$"
+ nil t)
+ for msg = (match-string 3)
+ for (beg . end) = (flymake-diag-region
+ source
+ (string-to-number (match-string 1))
+ (string-to-number (match-string 2)))
+ for type = (cond
+ ((string-match "^[EF]: " msg)
+ :error)
+ ((string-match "^W: " msg)
+ :warning)
+ (t :note))
+ collect (flymake-make-diagnostic source
+ beg
+ end
+ type
+ (substring msg 3))
+ into diags
+ finally (funcall report-fn diags)))))))
+
+(defun ruby-flymake-auto (report-fn &rest args)
+ (apply
+ (if (and ruby-flymake-use-rubocop-if-available
+ (executable-find "rubocop"))
+ #'ruby-flymake-rubocop
+ #'ruby-flymake-simple)
+ report-fn
+ args))
+
;;;###autoload
(define-derived-mode ruby-mode prog-mode "Ruby"
"Major mode for editing Ruby code."
@@ -2265,6 +2398,7 @@ See `font-lock-syntax-table'.")
(add-hook 'after-save-hook 'ruby-mode-set-encoding nil 'local)
(add-hook 'electric-indent-functions 'ruby--electric-indent-p nil 'local)
+ (add-hook 'flymake-diagnostic-functions 'ruby-flymake-auto nil 'local)
(setq-local font-lock-defaults '((ruby-font-lock-keywords) nil nil))
(setq-local font-lock-keywords ruby-font-lock-keywords)
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
index 0dcf9b47b84..bb75595cb4d 100644
--- a/lisp/progmodes/scheme.el
+++ b/lisp/progmodes/scheme.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 35b555e6879..2a867bb3655 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -419,44 +419,6 @@ name symbol."
(define-abbrev-table 'sh-mode-abbrev-table ())
-;; I turned off this feature because it doesn't permit typing commands
-;; in the usual way without help.
-;;(defvar sh-abbrevs
-;; '((csh sh-abbrevs shell
-;; "switch" 'sh-case
-;; "getopts" 'sh-while-getopts)
-
-;; (es sh-abbrevs shell
-;; "function" 'sh-function)
-
-;; (ksh88 sh-abbrevs sh
-;; "select" 'sh-select)
-
-;; (rc sh-abbrevs shell
-;; "case" 'sh-case
-;; "function" 'sh-function)
-
-;; (sh sh-abbrevs shell
-;; "case" 'sh-case
-;; "function" 'sh-function
-;; "until" 'sh-until
-;; "getopts" 'sh-while-getopts)
-
-;; ;; The next entry is only used for defining the others
-;; (shell "for" sh-for
-;; "loop" sh-indexed-loop
-;; "if" sh-if
-;; "tmpfile" sh-tmp-file
-;; "while" sh-while)
-
-;; (zsh sh-abbrevs ksh88
-;; "repeat" 'sh-repeat))
-;; "Abbrev-table used in Shell-Script mode. See `sh-feature'.
-;;;Due to the internal workings of abbrev tables, the shell name symbol is
-;;;actually defined as the table for the like of \\[edit-abbrevs].")
-
-
-
(defun sh-mode-syntax-table (table &rest list)
"Copy TABLE and set syntax for successive CHARs according to strings S."
(setq table (copy-syntax-table table))
@@ -631,11 +593,7 @@ sign. See `sh-feature'."
(sexp :format "Evaluate: %v"))))
:group 'sh-script)
-
-(defcustom sh-indentation 4
- "The width for further indentation in Shell-Script mode."
- :type 'integer
- :group 'sh-script)
+(define-obsolete-variable-alias 'sh-indentation 'sh-basic-offset "26.1")
(put 'sh-indentation 'safe-local-variable 'integerp)
(defcustom sh-remember-variable-min 3
@@ -747,9 +705,7 @@ removed when closing the here document."
;; The next entry is only used for defining the others
(shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait")
- (wksh sh-append ksh88
- ;; FIXME: This looks too much like a regexp. --Stef
- "Xt[A-Z][A-Za-z]*")
+ (wksh sh-append ksh88)
(zsh sh-append ksh88
"autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs"
@@ -1178,7 +1134,7 @@ subshells can nest."
(syntax-propertize-rules
(sh-here-doc-open-re
(2 (sh-font-lock-open-heredoc
- (match-beginning 0) (match-string 1) (match-beginning 2))))
+ (1+ (match-beginning 0)) (match-string 1) (match-beginning 2))))
("\\s|" (0 (prog1 nil (sh-syntax-propertize-here-doc end))))
;; A `#' begins a comment when it is unquoted and at the
;; beginning of a word. In the shell, words are separated by
@@ -1657,7 +1613,7 @@ with your script for an edit-interpret-debug cycle."
(setq-local skeleton-pair-alist '((?` _ ?`)))
(setq-local skeleton-pair-filter-function 'sh-quoted-p)
(setq-local skeleton-further-elements
- '((< '(- (min sh-indentation (current-column))))))
+ '((< '(- (min sh-basic-offset (current-column))))))
(setq-local skeleton-filter-function 'sh-feature)
(setq-local skeleton-newline-indent-rigidly t)
(setq-local defun-prompt-regexp
@@ -1683,6 +1639,7 @@ with your script for an edit-interpret-debug cycle."
((string-match "[.]sh\\>" buffer-file-name) "sh")
((string-match "[.]bash\\>" buffer-file-name) "bash")
((string-match "[.]ksh\\>" buffer-file-name) "ksh")
+ ((string-match "[.]mkshrc\\>" buffer-file-name) "mksh")
((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh")
((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh")
((equal (file-name-nondirectory buffer-file-name) ".profile") "sh")
@@ -2051,7 +2008,7 @@ May return nil if the line should not be treated as continued."
(forward-line -1)
(if (sh-smie--looking-back-at-continuation-p)
(current-indentation)
- (+ (current-indentation) sh-indentation))))
+ (+ (current-indentation) sh-basic-offset))))
(t
;; Just make sure a line-continuation is indented deeper.
(save-excursion
@@ -2072,13 +2029,13 @@ May return nil if the line should not be treated as continued."
;; check the line before that one.
(> ci indent))
(t ;Previous line is the beginning of the continued line.
- (setq indent (min (+ ci sh-indentation) max))
+ (setq indent (min (+ ci sh-basic-offset) max))
nil)))))
indent))))))
(defun sh-smie-sh-rules (kind token)
(pcase (cons kind token)
- (`(:elem . basic) sh-indentation)
+ (`(:elem . basic) sh-basic-offset)
(`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt)
(sh-var-value 'sh-indent-for-case-label)))
(`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case"))
@@ -2287,8 +2244,8 @@ Point should be before the newline."
(defun sh-smie-rc-rules (kind token)
(pcase (cons kind token)
- (`(:elem . basic) sh-indentation)
- ;; (`(:after . "case") (or sh-indentation smie-indent-basic))
+ (`(:elem . basic) sh-basic-offset)
+ ;; (`(:after . "case") (or sh-basic-offset smie-indent-basic))
(`(:after . ";")
(if (smie-rule-parent-p "case")
(smie-rule-parent (sh-var-value 'sh-indent-after-case))))
@@ -2511,39 +2468,6 @@ the value thus obtained, and the result is used instead."
-;; I commented this out because nobody calls it -- rms.
-;;(defun sh-abbrevs (ancestor &rest list)
-;; "If it isn't, define the current shell as abbrev table and fill that.
-;;Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev
-;;table or a list of (NAME1 EXPANSION1 ...). In addition it will define abbrevs
-;;according to the remaining arguments NAMEi EXPANSIONi ...
-;;EXPANSION may be either a string or a skeleton command."
-;; (or (if (boundp sh-shell)
-;; (symbol-value sh-shell))
-;; (progn
-;; (if (listp ancestor)
-;; (nconc list ancestor))
-;; (define-abbrev-table sh-shell ())
-;; (if (vectorp ancestor)
-;; (mapatoms (lambda (atom)
-;; (or (eq atom 0)
-;; (define-abbrev (symbol-value sh-shell)
-;; (symbol-name atom)
-;; (symbol-value atom)
-;; (symbol-function atom))))
-;; ancestor))
-;; (while list
-;; (define-abbrev (symbol-value sh-shell)
-;; (car list)
-;; (if (stringp (car (cdr list)))
-;; (car (cdr list))
-;; "")
-;; (if (symbolp (car (cdr list)))
-;; (car (cdr list))))
-;; (setq list (cdr (cdr list)))))
-;; (symbol-value sh-shell)))
-
-
(defun sh-append (ancestor &rest list)
"Return list composed of first argument (a list) physically appended to rest."
(nconc list ancestor))
@@ -2562,7 +2486,7 @@ the value thus obtained, and the result is used instead."
(defun sh-basic-indent-line ()
"Indent a line for Sh mode (shell script mode).
-Indent as far as preceding non-empty line, then by steps of `sh-indentation'.
+Indent as far as preceding non-empty line, then by steps of `sh-basic-offset'.
Lines containing only comments are considered empty."
(interactive)
(let ((previous (save-excursion
@@ -2586,9 +2510,9 @@ Lines containing only comments are considered empty."
(delete-region (point)
(progn (beginning-of-line) (point)))
(if (eolp)
- (max previous (* (1+ (/ current sh-indentation))
- sh-indentation))
- (* (1+ (/ current sh-indentation)) sh-indentation))))))
+ (max previous (* (1+ (/ current sh-basic-offset))
+ sh-basic-offset))
+ (* (1+ (/ current sh-basic-offset)) sh-basic-offset))))))
(if (< (current-column) (current-indentation))
(skip-chars-forward " \t"))))
@@ -3452,7 +3376,7 @@ If INFO is supplied it is used, else it is calculated from current line."
(if msg (message "%s" msg) (message nil))))
(defun sh-show-indent (arg)
- "Show the how the current line would be indented.
+ "Show how the current line would be indented.
This tells you which variable, if any, controls the indentation of
this line.
If optional arg ARG is non-null (called interactively with a prefix),
@@ -3666,6 +3590,10 @@ so that `occur-next' and `occur-prev' will work."
(defun sh-learn-buffer-indent (&optional arg)
"Learn how to indent the buffer the way it currently is.
+If `sh-use-smie' is non-nil, call `smie-config-guess'.
+Otherwise, run the sh-script specific indent learning command, as
+described below.
+
Output in buffer \"*indent*\" shows any lines which have conflicting
values of a variable, and the final value of all variables learned.
When called interactively, pop to this buffer automatically if
@@ -3682,8 +3610,7 @@ to the value of variable `sh-learn-basic-offset'.
Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the
function completes. The function is abnormal because it is called
-with an alist of variables learned. This feature may be changed or
-removed in the future.
+with an alist of variables learned.
This command can often take a long time to run."
(interactive "P")
@@ -3881,7 +3808,6 @@ This command can often take a long time to run."
" has" "s have")
(if (zerop num-diffs)
"." ":"))))))
- ;; Are abnormal hooks considered bad form?
(run-hook-with-args 'sh-learned-buffer-hook learned-var-list)
(and (called-interactively-p 'any)
(or sh-popup-occur-buffer (> num-diffs 0))
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index 505a2ea43c0..6f98d68d047 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 68ca37207ef..db88563a3e7 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -4,9 +4,9 @@
;; Author: Alex Schroeder <alex@gnu.org>
;; Maintainer: Michael Mauger <michael@mauger.com>
-;; Version: 3.5
+;; Version: 3.6
;; Keywords: comm languages processes
-;; URL: http://savannah.gnu.org/projects/emacs/
+;; URL: https://savannah.gnu.org/projects/emacs/
;; This file is part of GNU Emacs.
@@ -21,14 +21,14 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Please send bug reports and bug fixes to the mailing list at
;; help-gnu-emacs@gnu.org. If you want to subscribe to the mailing
;; list, see the web page at
-;; http://lists.gnu.org/mailman/listinfo/help-gnu-emacs for
+;; https://lists.gnu.org/mailman/listinfo/help-gnu-emacs for
;; instructions. I monitor this list actively. If you send an e-mail
;; to Alex Schroeder it usually makes it to me when Alex has a chance
;; to forward them along (Thanks, Alex).
@@ -156,7 +156,7 @@
;; (sql-set-product-feature 'xyz
;; :sqli-options 'my-sql-xyz-options))
-;; (defun my-sql-comint-xyz (product options)
+;; (defun my-sql-comint-xyz (product options &optional buf-name)
;; "Connect ti XyzDB in a comint buffer."
;;
;; ;; Do something with `sql-user', `sql-password',
@@ -172,7 +172,7 @@
;; (if (not (string= "" sql-server))
;; (list "-S" sql-server))
;; options)))
-;; (sql-comint product params)))
+;; (sql-comint product params buf-name)))
;;
;; (sql-set-product-feature 'xyz
;; :sqli-comint-func 'my-sql-comint-xyz)
@@ -220,6 +220,7 @@
;; incorrectly enabled by default
;; Roman Scherer <roman.scherer@nugg.ad> -- Connection documentation
;; Mark Wilkinson <wilkinsonmr@gmail.com> -- file-local variables ignored
+;; Simen Heggestøyl <simenheg@gmail.com> -- Postgres database completion
;;
@@ -317,6 +318,7 @@ file. Since that is a plaintext file, this could be dangerous."
(list :tag "completion"
(const :format "" server)
(const :format "" :completion)
+ (const :format "" :must-match)
(restricted-sexp
:match-alternatives (listp stringp))))
(choice :tag "database"
@@ -332,9 +334,10 @@ file. Since that is a plaintext file, this could be dangerous."
regexp)
(list :tag "completion"
(const :format "" database)
- (const :format "" :completion)
- (restricted-sexp
- :match-alternatives (listp stringp))))
+ (const :format "" :completion)
+ (const :format "" :must-match)
+ (restricted-sexp
+ :match-alternatives (listp stringp))))
(const port)))
;; SQL Product support
@@ -936,7 +939,8 @@ Starts `sql-interactive-mode' after doing some setup."
:version "20.8"
:group 'SQL)
-(defcustom sql-sqlite-login-params '((database :file nil))
+(defcustom sql-sqlite-login-params '((database :file nil
+ :must-match confirm))
"List of login parameters needed to connect to SQLite."
:type 'sql-login-params
:version "26.1"
@@ -1079,7 +1083,8 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
`((user :default ,(user-login-name))
(database :default ,(user-login-name)
:completion ,(completion-table-dynamic
- (lambda (_) (sql-postgres-list-databases))))
+ (lambda (_) (sql-postgres-list-databases)))
+ :must-match confirm)
server)
"List of login parameters needed to connect to Postgres."
:type 'sql-login-params
@@ -1090,9 +1095,10 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list."
"Return a list of available PostgreSQL databases."
(when (executable-find sql-postgres-program)
(let ((res '()))
- (dolist (row (process-lines sql-postgres-program "-ltX"))
- (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row)
- (push (match-string 1 row) res)))
+ (ignore-errors
+ (dolist (row (process-lines sql-postgres-program "-ltX"))
+ (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row)
+ (push (match-string 1 row) res))))
(nreverse res))))
;; Customization for Interbase
@@ -2957,7 +2963,9 @@ value. (The property value is used as the PREDICATE argument to
((plist-member plist :file)
(let ((file-name
(read-file-name prompt
- (file-name-directory last-value) default 'confirm
+ (file-name-directory last-value)
+ default
+ (plist-get plist :must-match)
(file-name-nondirectory last-value)
(when (plist-get plist :file)
`(lambda (f)
@@ -2971,8 +2979,13 @@ value. (The property value is used as the PREDICATE argument to
(expand-file-name file-name))))
((plist-member plist :completion)
- (completing-read prompt-def (plist-get plist :completion) nil t
- last-value history-var default))
+ (completing-read prompt-def
+ (plist-get plist :completion)
+ nil
+ (plist-get plist :must-match)
+ last-value
+ history-var
+ default))
((plist-get plist :number)
(read-number prompt (or default last-value 0)))
@@ -4034,7 +4047,7 @@ Sentinels will always get the two parameters PROCESS and EVENT."
nil t initial 'sql-connection-history default)))
;;;###autoload
-(defun sql-connect (connection &optional new-name)
+(defun sql-connect (connection &optional buf-name)
"Connect to an interactive session using CONNECTION settings.
See `sql-connection-alist' to see how to define connections and
@@ -4046,7 +4059,7 @@ is specified in the connection settings."
;; Prompt for the connection from those defined in the alist
(interactive
(if sql-connection-alist
- (list (sql-read-connection "Connection: " nil '(nil))
+ (list (sql-read-connection "Connection: ")
current-prefix-arg)
(user-error "No SQL Connections defined")))
@@ -4055,16 +4068,16 @@ is specified in the connection settings."
;; Was one selected
(when connection
;; Get connection settings
- (let ((connect-set (assoc-string connection sql-connection-alist t)))
+ (let ((connect-set (cdr (assoc-string connection sql-connection-alist t))))
;; Settings are defined
(if connect-set
;; Set the desired parameters
- (let (param-var login-params set-params rem-params)
+ (let (param-var login-params set-vars rem-vars)
;; Set the parameters and start the interactive session
- (mapc
- (lambda (vv)
- (set-default (car vv) (eval (cadr vv))))
- (cdr connect-set))
+ (dolist (vv connect-set)
+ (let ((var (car vv))
+ (val (cadr vv)))
+ (set-default var (eval val))))
(setq-default sql-connection connection)
;; :sqli-login params variable
@@ -4072,32 +4085,33 @@ is specified in the connection settings."
(sql-get-product-feature sql-product :sqli-login nil t))
;; :sqli-login params value
- (setq login-params
- (sql-get-product-feature sql-product :sqli-login))
+ (setq login-params (symbol-value param-var))
- ;; Params in the connection
- (setq set-params
+ ;; Params set in the connection
+ (setq set-vars
(mapcar
(lambda (v)
- (pcase (car v)
- (`sql-user 'user)
- (`sql-password 'password)
- (`sql-server 'server)
- (`sql-database 'database)
- (`sql-port 'port)
- (s s)))
- (cdr connect-set)))
+ (pcase (car v)
+ (`sql-user 'user)
+ (`sql-password 'password)
+ (`sql-server 'server)
+ (`sql-database 'database)
+ (`sql-port 'port)
+ (s s)))
+ connect-set))
;; the remaining params (w/o the connection params)
- (setq rem-params
+ (setq rem-vars
(sql-for-each-login login-params
- (lambda (token plist)
- (unless (member token set-params)
- (if plist (cons token plist) token)))))
+ (lambda (var vals)
+ (unless (member var set-vars)
+ (if vals (cons var vals) var)))))
;; Start the SQLi session with revised list of login parameters
- (eval `(let ((,param-var ',rem-params))
- (sql-product-interactive ',sql-product ',new-name))))
+ (eval `(let ((,param-var ',rem-vars))
+ (sql-product-interactive
+ ',sql-product
+ ',(or buf-name (format "<%s>" connection))))))
(user-error "SQL Connection <%s> does not exist" connection)
nil)))
@@ -4241,7 +4255,10 @@ the call to \\[sql-product-interactive] with
default-directory)))
(funcall (sql-get-product-feature product :sqli-comint-func)
product
- (sql-get-product-feature product :sqli-options)))
+ (sql-get-product-feature product :sqli-options)
+ (if (and new-name (string-prefix-p "SQL" new-name t))
+ new-name
+ (concat "SQL: " new-name))))
;; Set SQLi mode.
(let ((sql-interactive-product product))
@@ -4249,8 +4266,6 @@ the call to \\[sql-product-interactive] with
;; Set the new buffer name
(setq new-sqli-buffer (current-buffer))
- (when new-name
- (sql-rename-buffer new-name))
(set (make-local-variable 'sql-buffer)
(buffer-name new-sqli-buffer))
@@ -4284,29 +4299,41 @@ the call to \\[sql-product-interactive] with
(current-buffer)))))
(user-error "No default SQL product defined. Set `sql-product'.")))
-(defun sql-comint (product params)
+(defun sql-comint (product params &optional buf-name)
"Set up a comint buffer to run the SQL processor.
PRODUCT is the SQL product. PARAMS is a list of strings which are
-passed as command line arguments."
- (let ((program (sql-get-product-feature product :sqli-program))
- (buf-name "SQL"))
+passed as command line arguments. BUF-NAME is the name of the new
+buffer. If nil, a name is chosen for it."
+
+ (let ((program (sql-get-product-feature product :sqli-program)))
;; Make sure we can find the program. `executable-find' does not
;; work for remote hosts; we suppress the check there.
(unless (or (file-remote-p default-directory)
(executable-find program))
(error "Unable to locate SQL program `%s'" program))
+
;; Make sure buffer name is unique.
- (when (sql-buffer-live-p (format "*%s*" buf-name))
- (setq buf-name (format "SQL-%s" product))
- (when (sql-buffer-live-p (format "*%s*" buf-name))
- (let ((i 1))
- (while (sql-buffer-live-p
- (format "*%s*"
- (setq buf-name (format "SQL-%s%d" product i))))
- (setq i (1+ i))))))
- (set-buffer
- (apply #'make-comint buf-name program nil params))))
+ ;; if not specified, try *SQL* then *SQL-product*, then *SQL-product1*, ...
+ ;; otherwise, use *buf-name*
+ (if buf-name
+ (unless (string-match-p "\\`[*].*[*]\\'" buf-name)
+ (setq buf-name (concat "*" buf-name "*")))
+ (setq buf-name "*SQL*")
+ (when (sql-buffer-live-p buf-name)
+ (setq buf-name (format "*SQL-%s*" product)))
+ (let ((i 1))
+ (while (sql-buffer-live-p buf-name)
+ (setq buf-name (format "*SQL-%s%d*" product i)
+ i (1+ i)))))
+ (set-text-properties 0 (length buf-name) nil buf-name)
+
+ ;; Start the command interpreter in the buffer
+ ;; PROC-NAME is BUF-NAME without enclosing asterisks
+ (let ((proc-name (replace-regexp-in-string "\\`[*]\\(.*\\)[*]\\'" "\\1" buf-name)))
+ (set-buffer
+ (apply #'make-comint-in-buffer
+ proc-name buf-name program nil params)))))
;;;###autoload
(defun sql-oracle (&optional buffer)
@@ -4340,7 +4367,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'oracle buffer))
-(defun sql-comint-oracle (product options)
+(defun sql-comint-oracle (product options &optional buf-name)
"Create comint buffer and connect to Oracle."
;; Produce user/password@database construct. Password without user
;; is meaningless; database without user/password is meaningless,
@@ -4357,7 +4384,7 @@ The default comes from `process-coding-system-alist' and
(if parameter
(setq parameter (append options (list parameter)))
(setq parameter options))
- (sql-comint product parameter)
+ (sql-comint product parameter buf-name)
;; Set process coding system to agree with the interpreter
(setq nlslang (or (getenv "NLS_LANG") "")
coding (dolist (cs
@@ -4454,20 +4481,25 @@ The default comes from `process-coding-system-alist' and
;; Restore the changed settings
(sql-redirect sqlbuf saved-settings))
+(defun sql-oracle--list-object-name (obj-name)
+ (format "CASE WHEN REGEXP_LIKE (%s, q'/^[A-Z0-9_#$]+$/','c') THEN %s ELSE '\"'|| %s ||'\"' END "
+ obj-name obj-name obj-name))
+
(defun sql-oracle-list-all (sqlbuf outbuf enhanced _table-name)
;; Query from USER_OBJECTS or ALL_OBJECTS
(let ((settings (sql-oracle-save-settings sqlbuf))
(simple-sql
(concat
"SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
- ", x.object_name AS SQL_EL_NAME "
+ ", " (sql-oracle--list-object-name "x.object_name") " AS SQL_EL_NAME "
"FROM user_objects x "
"WHERE x.object_type NOT LIKE '%% BODY' "
"ORDER BY 2, 1;"))
(enhanced-sql
(concat
"SELECT INITCAP(x.object_type) AS SQL_EL_TYPE "
- ", x.owner ||'.'|| x.object_name AS SQL_EL_NAME "
+ ", " (sql-oracle--list-object-name "x.owner")
+ " ||'.'|| " (sql-oracle--list-object-name "x.object_name") " AS SQL_EL_NAME "
"FROM all_objects x "
"WHERE x.object_type NOT LIKE '%% BODY' "
"AND x.owner <> 'SYS' "
@@ -4524,9 +4556,15 @@ See the distinct values in ALL_OBJECTS.OBJECT_TYPE for possible values."
(concat
"SELECT CHR(1)||"
(if schema
- (format "owner||'.'||object_name AS o FROM all_objects WHERE owner = %s AND "
- (sql-str-literal (upcase schema)))
- "object_name AS o FROM user_objects WHERE ")
+ (concat "CASE WHEN REGEXP_LIKE (owner, q'/^[A-Z0-9_#$]+$/','c') THEN owner ELSE '\"'|| owner ||'\"' END "
+ "||'.'||"
+ "CASE WHEN REGEXP_LIKE (object_name, q'/^[A-Z0-9_#$]+$/','c') THEN object_name ELSE '\"'|| object_name ||'\"' END "
+ " AS o FROM all_objects "
+ (format "WHERE owner = %s AND "
+ (sql-str-literal (if (string-match "^[\"]\\(.+\\)[\"]$" schema)
+ (match-string 1 schema) (upcase schema)))))
+ (concat "CASE WHEN REGEXP_LIKE (object_name, q'/^[A-Z0-9_#$]+$/','c') THEN object_name ELSE '\"'|| object_name ||'\"' END "
+ " AS o FROM user_objects WHERE "))
"temporary = 'N' AND generated = 'N' AND secondary = 'N' AND "
"object_type IN ("
(mapconcat (function sql-str-literal) sql-oracle-completion-types ",")
@@ -4566,7 +4604,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'sybase buffer))
-(defun sql-comint-sybase (product options)
+(defun sql-comint-sybase (product options &optional buf-name)
"Create comint buffer and connect to Sybase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4581,7 +4619,7 @@ The default comes from `process-coding-system-alist' and
(if (not (string= "" sql-server))
(list "-S" sql-server))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4615,7 +4653,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'informix buffer))
-(defun sql-comint-informix (product options)
+(defun sql-comint-informix (product options &optional buf-name)
"Create comint buffer and connect to Informix."
;; username and password are ignored.
(let ((db (if (string= "" sql-database)
@@ -4623,7 +4661,7 @@ The default comes from `process-coding-system-alist' and
(if (string= "" sql-server)
sql-database
(concat sql-database "@" sql-server)))))
- (sql-comint product (append `(,db "-") options))))
+ (sql-comint product (append `(,db "-") options) buf-name)))
@@ -4661,7 +4699,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'sqlite buffer))
-(defun sql-comint-sqlite (product options)
+(defun sql-comint-sqlite (product options &optional buf-name)
"Create comint buffer and connect to SQLite."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4669,7 +4707,7 @@ The default comes from `process-coding-system-alist' and
(append options
(if (not (string= "" sql-database))
`(,(expand-file-name sql-database))))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
(defun sql-sqlite-completion-object (sqlbuf _schema)
(sql-redirect-value sqlbuf ".tables" "\\sw\\(?:\\sw\\|\\s_\\)*" 0))
@@ -4710,7 +4748,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'mysql buffer))
-(defun sql-comint-mysql (product options)
+(defun sql-comint-mysql (product options &optional buf-name)
"Create comint buffer and connect to MySQL."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4727,7 +4765,7 @@ The default comes from `process-coding-system-alist' and
(list (concat "--host=" sql-server)))
(if (not (string= "" sql-database))
(list sql-database)))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4762,7 +4800,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'solid buffer))
-(defun sql-comint-solid (product options)
+(defun sql-comint-solid (product options &optional buf-name)
"Create comint buffer and connect to Solid."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4775,7 +4813,7 @@ The default comes from `process-coding-system-alist' and
(string= "" sql-password)))
(list sql-user sql-password))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4809,14 +4847,15 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'ingres buffer))
-(defun sql-comint-ingres (product options)
+(defun sql-comint-ingres (product options &optional buf-name)
"Create comint buffer and connect to Ingres."
;; username and password are ignored.
(sql-comint product
- (append (if (string= "" sql-database)
- nil
- (list sql-database))
- options)))
+ (append (if (string= "" sql-database)
+ nil
+ (list sql-database))
+ options)
+ buf-name))
@@ -4852,7 +4891,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'ms buffer))
-(defun sql-comint-ms (product options)
+(defun sql-comint-ms (product options &optional buf-name)
"Create comint buffer and connect to Microsoft SQL Server."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -4875,7 +4914,7 @@ The default comes from `process-coding-system-alist' and
;; If -P is passed to ISQL as the last argument without a
;; password, it's considered null.
`(,@params "-P"))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -4916,7 +4955,7 @@ Try to set `comint-output-filter-functions' like this:
(interactive "P")
(sql-product-interactive 'postgres buffer))
-(defun sql-comint-postgres (product options)
+(defun sql-comint-postgres (product options &optional buf-name)
"Create comint buffer and connect to Postgres."
;; username and password are ignored. Mark Stosberg suggests to add
;; the database at the end. Jason Beegan suggests using --pset and
@@ -4934,7 +4973,7 @@ Try to set `comint-output-filter-functions' like this:
options
(if (not (string= "" sql-database))
(list sql-database)))))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
(defun sql-postgres-completion-object (sqlbuf schema)
(sql-redirect sqlbuf "\\t on")
@@ -5004,7 +5043,7 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'interbase buffer))
-(defun sql-comint-interbase (product options)
+(defun sql-comint-interbase (product options &optional buf-name)
"Create comint buffer and connect to Interbase."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -5017,7 +5056,7 @@ The default comes from `process-coding-system-alist' and
(if (not (string= "" sql-user))
(list "-u" sql-user))
options)))
- (sql-comint product params)))
+ (sql-comint product params buf-name)))
@@ -5056,11 +5095,11 @@ The default comes from `process-coding-system-alist' and
(interactive "P")
(sql-product-interactive 'db2 buffer))
-(defun sql-comint-db2 (product options)
+(defun sql-comint-db2 (product options &optional buf-name)
"Create comint buffer and connect to DB2."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
- (sql-comint product options))
+ (sql-comint product options buf-name))
;;;###autoload
(defun sql-linter (&optional buffer)
@@ -5094,7 +5133,7 @@ buffer.
(interactive "P")
(sql-product-interactive 'linter buffer))
-(defun sql-comint-linter (product options)
+(defun sql-comint-linter (product options &optional buf-name)
"Create comint buffer and connect to Linter."
;; Put all parameters to the program (if defined) in a list and call
;; make-comint.
@@ -5109,7 +5148,7 @@ buffer.
options)))
(cl-letf (((getenv "LINTER_MBX")
(unless (string= "" sql-database) sql-database)))
- (sql-comint product params))))
+ (sql-comint product params buf-name))))
@@ -5132,7 +5171,7 @@ The default value disables the internal pager."
:type 'sql-login-params
:group 'SQL)
-(defun sql-comint-vertica (product options)
+(defun sql-comint-vertica (product options &optional buf-name)
"Create comint buffer and connect to Vertica."
(sql-comint product
(nconc
@@ -5144,7 +5183,8 @@ The default value disables the internal pager."
(list "-w" sql-password))
(and (not (string= "" sql-user))
(list "-U" sql-user))
- options)))
+ options)
+ buf-name))
;;;###autoload
(defun sql-vertica (&optional buffer)
diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el
index ede2f420735..6428b56f9dc 100644
--- a/lisp/progmodes/subword.el
+++ b/lisp/progmodes/subword.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
index 902a5aace08..dbb71efdfb4 100644
--- a/lisp/progmodes/tcl.el
+++ b/lisp/progmodes/tcl.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; BEFORE USE:
;;
@@ -353,8 +353,6 @@ information):
Quotes all \"#\" characters that don't correspond to actual
Tcl comments. (Useful when editing code not originally created
with this mode).
- `tcl-auto-fill-mode'
- Auto-filling of Tcl comments.
Add functions to the hook with `add-hook':
@@ -1413,6 +1411,9 @@ Prefix argument means switch to the Tcl buffer afterwards."
(defun tcl-auto-fill-mode (&optional arg)
"Like `auto-fill-mode', but sets `comment-auto-fill-only-comments'."
+ (declare
+ (obsolete
+ "Use `auto-fill-mode' with `comment-auto-fill-only-comments'." "26.1"))
(interactive "P")
(auto-fill-mode arg)
(if auto-fill-function
diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el
index 066360023d7..05d1a5f5f31 100644
--- a/lisp/progmodes/vera-mode.el
+++ b/lisp/progmodes/vera-mode.el
@@ -32,7 +32,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index 2760c4d276e..e2bd89ec46c 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -4,7 +4,6 @@
;; Author: Michael McNamara <mac@verilog.com>
;; Wilson Snyder <wsnyder@wsnyder.org>
-;; X-URL: http://www.verilog.com
;; X-URL: http://www.veripool.org
;; Created: 3 Jan 1996
;; Keywords: languages
@@ -33,7 +32,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -70,7 +69,7 @@
;; default.
;; You can get step by step help in installing this file by going to
-;; <http://www.verilog.com/emacs_install.html>
+;; <http://www.veripool.com/verilog-mode>
;; The short list of installation instructions are: To set up
;; automatic Verilog mode, put this file in your load path, and put
@@ -123,7 +122,7 @@
;;
;; This variable will always hold the version number of the mode
-(defconst verilog-mode-version "2017-05-08-b240c8f-vpo-GNU"
+(defconst verilog-mode-version "2017-08-07-c085e50-vpo-GNU"
"Version of this Verilog mode.")
(defconst verilog-mode-release-emacs t
"If non-nil, this version of Verilog mode was released with Emacs itself.")
@@ -285,7 +284,7 @@ STRING should be given if the last search was by `string-match' on STRING."
;; This function is lifted directly from emacs's subr.el
;; so that it can be used by xemacs.
;; The idea for this was borrowed from org-mode via this link:
-;; https://lists.gnu.org/archive/html/emacs-orgmode/2009-12/msg00032.html
+;; https://lists.gnu.org/r/emacs-orgmode/2009-12/msg00032.html
(eval-and-compile
(cond
((fboundp 'looking-back)
@@ -345,6 +344,12 @@ wherever possible, since it is slow."
(unless (fboundp 'buffer-chars-modified-tick) ; Emacs 22 added
(defmacro buffer-chars-modified-tick () (buffer-modified-tick)))
(error nil))
+ ;; Added in Emacs 23.1
+ (condition-case nil
+ (unless (fboundp 'ignore-errors)
+ (defmacro ignore-errors (&rest body)
+ (declare (debug t) (indent 0))
+ `(condition-case nil (progn ,@body) (error nil)))))
;; Added in Emacs 24.1
(condition-case nil
(unless (fboundp 'prog-mode)
@@ -961,7 +966,8 @@ Only used in XEmacs; GNU Emacs uses `verilog-error-regexp-emacs-alist'.")
These arguments are used to find files for `verilog-auto', and match
the flags accepted by a standard Verilog-XL simulator.
- -f filename Reads more `verilog-library-flags' from the filename.
+ -f filename Reads absolute `verilog-library-flags' from the filename.
+ -F filename Reads relative `verilog-library-flags' from the filename.
+incdir+dir Adds the directory to `verilog-library-directories'.
-Idir Adds the directory to `verilog-library-directories'.
-y dir Adds the directory to `verilog-library-directories'.
@@ -4034,7 +4040,7 @@ With optional ARG, remove existing end of line comments."
(progn
(if (or (eq 'all verilog-auto-lineup)
(eq 'assignments verilog-auto-lineup))
- (verilog-pretty-expr t "\\(<\\|:\\)?=" ))
+ (verilog-pretty-expr :quiet))
(newline))
(forward-line 1))
;; Indent next line
@@ -5790,11 +5796,9 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(goto-char here) ; or is clocking, starts a new block
(throw 'nesting 'block)))))
- ;; need to consider typedef struct here...
((looking-at "\\<class\\|struct\\|function\\|task\\>")
;; *sigh* These words have an optional prefix:
;; extern {virtual|protected}? function a();
- ;; typedef class foo;
;; and we don't want to confuse this with
;; function a();
;; property
@@ -5804,7 +5808,11 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
(cond
((looking-at verilog-dpi-import-export-re)
(throw 'continue 'foo))
- ((looking-at "\\<pure\\>\\s-+\\<virtual\\>\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+")
+ ((or
+ (looking-at "\\<pure\\>\\s-+\\<virtual\\>\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+")
+ ;; Do not throw 'defun for class typedefs like
+ ;; typedef class foo;
+ (looking-at "\\<typedef\\>\\s-+\\(?:\\<virtual\\>\\s-+\\)?\\<class\\>\\s-+"))
(throw 'nesting 'statement))
((looking-at verilog-beg-block-re-ordered)
(throw 'nesting 'block))
@@ -6660,7 +6668,7 @@ Only look at a few lines to determine indent level."
(let ((val))
(verilog-beg-of-statement-1)
(if (and (< (point) here)
- (verilog-re-search-forward "=[ \\t]*" here 'move)
+ (verilog-re-search-forward "=[ \t]*" here 'move)
;; not at a |=>, #=#, or [=n] operator
(not (string-match "\\[=.\\|#=#\\||=>"
(or (buffer-substring (- (point) 2) (1+ (point)))
@@ -6974,106 +6982,97 @@ Be verbose about progress unless optional QUIET set."
(forward-line 1))
(unless quiet (message "")))))))
-(defun verilog-pretty-expr (&optional quiet _myre)
- "Line up expressions around point, optionally QUIET with regexp _MYRE ignored."
+(defun verilog-pretty-expr (&optional quiet)
+ "Line up expressions around point.
+If QUIET is non-nil, do not print messages showing the progress of line-up."
(interactive)
- (if (not (verilog-in-comment-or-string-p))
- (save-excursion
- (let ( (rexp (concat "^\\s-*" verilog-complete-reg))
- (rexp1 (concat "^\\s-*" verilog-basic-complete-re)))
- (beginning-of-line)
- (if (and (not (looking-at rexp ))
+ (unless (verilog-in-comment-or-string-p)
+ (save-excursion
+ (let ((regexp (concat "^\\s-*" verilog-complete-reg))
+ (regexp1 (concat "^\\s-*" verilog-basic-complete-re)))
+ (beginning-of-line)
+ (when (and (not (looking-at regexp))
(looking-at verilog-assignment-operation-re)
(save-excursion
(goto-char (match-end 2))
(and (not (verilog-in-attribute-p))
(not (verilog-in-parameter-p))
(not (verilog-in-comment-or-string-p)))))
- (let* ((here (point))
- (e) (r)
- (start
- (progn
- (beginning-of-line)
- (setq e (point))
- (verilog-backward-syntactic-ws)
- (beginning-of-line)
- (while (and (not (looking-at rexp1))
- (looking-at verilog-assignment-operation-re)
- (not (bobp))
- )
- (setq e (point))
- (verilog-backward-syntactic-ws)
+ (let* ((start (save-excursion ; BOL of the first line of the assignment block
(beginning-of-line)
- ) ;Ack, need to grok `define
- e))
- (end
- (progn
- (goto-char here)
+ (let ((pt (point)))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)
+ (while (and (not (looking-at regexp1))
+ (looking-at verilog-assignment-operation-re)
+ (not (bobp)))
+ (setq pt (point))
+ (verilog-backward-syntactic-ws)
+ (beginning-of-line)) ; Ack, need to grok `define
+ pt)))
+ (end (save-excursion ; EOL of the last line of the assignment block
(end-of-line)
- (setq e (point)) ;Might be on last line
- (verilog-forward-syntactic-ws)
- (beginning-of-line)
- (while (and
- (not (looking-at rexp1 ))
- (looking-at verilog-assignment-operation-re)
- (progn
- (end-of-line)
- (not (eq e (point)))))
- (setq e (point))
+ (let ((pt (point))) ; Might be on last line
(verilog-forward-syntactic-ws)
(beginning-of-line)
- )
- e))
- (endpos (set-marker (make-marker) end))
- (ind)
- )
- (goto-char start)
- (verilog-do-indent (verilog-calculate-indent))
- (if (and (not quiet)
- (> (- end start) 100))
- (message "Lining up expressions..(please stand by)"))
-
- ;; Set indent to minimum throughout region
- (while (< (point) (marker-position endpos))
- (beginning-of-line)
- (verilog-just-one-space verilog-assignment-operation-re)
- (beginning-of-line)
- (verilog-do-indent (verilog-calculate-indent))
- (end-of-line)
- (verilog-forward-syntactic-ws)
- )
-
- ;; Now find biggest prefix
- (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos))
-
- ;; Now indent each line.
- (goto-char start)
- (while (progn (setq e (marker-position endpos))
- (setq r (- e (point)))
- (> r 0))
- (setq e (point))
- (if (not quiet) (message "%d" r))
- (cond
- ((looking-at verilog-assignment-operation-re)
- (goto-char (match-beginning 2))
- (if (not (or (verilog-in-parenthesis-p) ; leave attributes and comparisons alone
- (verilog-in-coverage-p)))
- (if (eq (char-after) ?=)
- (indent-to (1+ ind)) ; line up the = of the <= with surrounding =
- (indent-to ind)
- ))
- )
- ((verilog-continued-line-1 start)
- (goto-char e)
- (indent-line-to ind))
- (t ; Must be comment or white space
- (goto-char e)
- (verilog-forward-ws&directives)
- (forward-line -1))
- )
- (forward-line 1))
- (unless quiet (message ""))
- ))))))
+ (while (and
+ (not (looking-at regexp1))
+ (looking-at verilog-assignment-operation-re)
+ (progn
+ (end-of-line)
+ (not (eq pt (point)))))
+ (setq pt (point))
+ (verilog-forward-syntactic-ws)
+ (beginning-of-line))
+ pt)))
+ (contains-2-char-operator (string-match "<=" (buffer-substring-no-properties start end)))
+ (endmark (set-marker (make-marker) end)))
+ (goto-char start)
+ (verilog-do-indent (verilog-calculate-indent))
+ (when (and (not quiet)
+ (> (- end start) 100))
+ (message "Lining up expressions.. (please stand by)"))
+
+ ;; Set indent to minimum throughout region
+ ;; Rely on mark rather than on point as the indentation changes can
+ ;; make the older point reference obsolete
+ (while (< (point) (marker-position endmark))
+ (beginning-of-line)
+ (save-excursion
+ (verilog-just-one-space verilog-assignment-operation-re))
+ (verilog-do-indent (verilog-calculate-indent))
+ (end-of-line)
+ (verilog-forward-syntactic-ws))
+
+ (let ((ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start (marker-position endmark))) ; Find the biggest prefix
+ e)
+ ;; Now indent each line.
+ (goto-char start)
+ (while (progn
+ (setq e (marker-position endmark))
+ (> e (point)))
+ (unless quiet
+ (message " verilog-pretty-expr: %d" (- e (point))))
+ (setq e (point))
+ (cond
+ ((looking-at verilog-assignment-operation-re)
+ (goto-char (match-beginning 2))
+ (unless (or (verilog-in-parenthesis-p) ; Leave attributes and comparisons alone
+ (verilog-in-coverage-p))
+ (if (and contains-2-char-operator
+ (eq (char-after) ?=))
+ (indent-to (1+ ind)) ; Line up the = of the <= with surrounding =
+ (indent-to ind))))
+ ((verilog-continued-line-1 start)
+ (goto-char e)
+ (indent-line-to ind))
+ (t ; Must be comment or white space
+ (goto-char e)
+ (verilog-forward-ws&directives)
+ (forward-line -1)))
+ (forward-line 1))
+ (unless quiet
+ (message "")))))))))
(defun verilog-just-one-space (myre)
"Remove extra spaces around regular expression MYRE."
@@ -7180,30 +7179,30 @@ Region is defined by B and EDPOS."
;;(skip-chars-backward " \t")
(1+ (current-column))))))
-(defun verilog-get-lineup-indent-2 (myre b edpos)
- "Return the indent level that will line up several lines within the region."
+(defun verilog-get-lineup-indent-2 (regexp beg end)
+ "Return the indent level that will line up several lines.
+The lineup string is searched using REGEXP within the region between points
+BEG and END."
(save-excursion
- (let ((ind 0) e)
- (goto-char b)
+ (let ((ind 0))
+ (goto-char beg)
;; Get rightmost position
- (while (progn (setq e (marker-position edpos))
- (< (point) e))
- (if (and (verilog-re-search-forward myre e 'move)
- (not (verilog-in-attribute-p))) ; skip attribute exprs
- (progn
- (goto-char (match-beginning 2))
- (verilog-backward-syntactic-ws)
- (if (> (current-column) ind)
- (setq ind (current-column)))
- (goto-char (match-end 0)))
- ))
- (if (> ind 0)
- (1+ ind)
- ;; No lineup-string found
- (goto-char b)
- (end-of-line)
- (skip-chars-backward " \t")
- (1+ (current-column))))))
+ (while (< (point) end)
+ (when (and (verilog-re-search-forward regexp end 'move)
+ (not (verilog-in-attribute-p))) ; skip attribute exprs
+ (goto-char (match-beginning 2))
+ (verilog-backward-syntactic-ws)
+ (if (> (current-column) ind)
+ (setq ind (current-column)))
+ (goto-char (match-end 0))))
+ (setq ind (if (> ind 0)
+ (1+ ind)
+ ;; No lineup-string found
+ (goto-char beg)
+ (end-of-line)
+ (skip-chars-backward " \t")
+ (1+ (current-column))))
+ ind)))
(defun verilog-comment-depth (type val)
"A useful mode debugging aide. TYPE and VAL are comments for insertion."
@@ -9344,7 +9343,7 @@ Returns REGEXP and list of ( (signal_name connection_name)... )."
;; Regexp form??
((looking-at
;; Regexp bug in XEmacs disallows ][ inside [], and wants + last
- "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
+ "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)")
(setq rep (match-string-no-properties 3))
(goto-char (match-end 0))
(setq tpl-wild-list
@@ -9619,8 +9618,9 @@ Some macros and such are also found and included. For dinotrace.el."
;; Argument file parsing
;;
-(defun verilog-getopt (arglist)
- "Parse -f, -v etc arguments in ARGLIST list or string."
+(defun verilog-getopt (arglist &optional default-dir)
+ "Parse -f, -v etc arguments in ARGLIST list or string.
+Use DEFAULT-DIR to anchor paths if non-nil."
(unless (listp arglist) (setq arglist (list arglist)))
(let ((space-args '())
arg next-param)
@@ -9638,6 +9638,8 @@ Some macros and such are also found and included. For dinotrace.el."
space-args (cdr space-args))
(cond
;; Need another arg
+ ((equal arg "-F")
+ (setq next-param arg))
((equal arg "-f")
(setq next-param arg))
((equal arg "-v")
@@ -9661,32 +9663,37 @@ Some macros and such are also found and included. For dinotrace.el."
((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ; +incdir+dir
(string-match "^-I\\(.*\\)" arg)) ; -Idir
(verilog-add-list-unique `verilog-library-directories
- (match-string 1 (substitute-in-file-name arg))))
+ (substitute-in-file-name (match-string 1 arg))))
;; Ignore
((equal "+librescan" arg))
((string-match "^-U\\(.*\\)" arg)) ; -Udefine
;; Second parameters
+ ((equal next-param "-F")
+ (setq next-param nil)
+ (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir)
+ (file-name-directory (verilog-substitute-file-name-path arg default-dir))))
((equal next-param "-f")
(setq next-param nil)
- (verilog-getopt-file (substitute-in-file-name arg)))
+ (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir) nil))
((equal next-param "-v")
(setq next-param nil)
(verilog-add-list-unique `verilog-library-files
- (substitute-in-file-name arg)))
+ (verilog-substitute-file-name-path arg default-dir)))
((equal next-param "-y")
(setq next-param nil)
(verilog-add-list-unique `verilog-library-directories
- (substitute-in-file-name arg)))
+ (verilog-substitute-file-name-path arg default-dir)))
;; Filename
((string-match "^[^-+]" arg)
(verilog-add-list-unique `verilog-library-files
- (substitute-in-file-name arg)))
+ (verilog-substitute-file-name-path arg default-dir)))
;; Default - ignore; no warning
))))
;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir"))
-(defun verilog-getopt-file (filename)
- "Read Verilog options from the specified FILENAME."
+(defun verilog-getopt-file (filename &optional default-dir)
+ "Read Verilog options from the specified FILENAME.
+Use DEFAULT-DIR to anchor paths if non-nil."
(save-excursion
(let ((fns (verilog-library-filenames filename (buffer-file-name)))
(orig-buffer (current-buffer))
@@ -9702,7 +9709,7 @@ Some macros and such are also found and included. For dinotrace.el."
(when (string-match "//" line)
(setq line (substring line 0 (match-beginning 0))))
(with-current-buffer orig-buffer ; Variables are buffer-local, so need right context.
- (verilog-getopt line))))))
+ (verilog-getopt line default-dir))))))
(defun verilog-getopt-flags ()
"Convert `verilog-library-flags' into standard library variables."
@@ -9719,6 +9726,13 @@ Some macros and such are also found and included. For dinotrace.el."
;; Allow user to customize
(verilog-run-hooks 'verilog-getopt-flags-hook))
+(defun verilog-substitute-file-name-path (filename default-dir)
+ "Return FILENAME with environment variables substituted.
+Use DEFAULT-DIR to anchor paths if non-nil."
+ (if default-dir
+ (expand-file-name (substitute-in-file-name filename) default-dir)
+ (substitute-in-file-name filename)))
+
(defun verilog-add-list-unique (varref object)
"Append to VARREF list the given OBJECT,
unless it is already a member of the variable's list."
@@ -9898,42 +9912,44 @@ Or, just the existing dirnames themselves if there are no wildcards."
(interactive)
(unless dirnames
(error "`verilog-library-directories' should include at least `.'"))
- (setq dirnames (reverse dirnames)) ; not nreverse
- (let ((dirlist nil)
- pattern dirfile dirfiles dirname root filename rest basefile)
- (while dirnames
- (setq dirname (substitute-in-file-name (car dirnames))
- dirnames (cdr dirnames))
- (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root
- "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *?
- "\\(.*\\)") ; rest
- dirname)
- (setq root (match-string 1 dirname)
- filename (match-string 2 dirname)
- rest (match-string 3 dirname)
- pattern filename)
- ;; now replace those * and ? with .+ and .
- ;; use ^ and /> to get only whole file names
- (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern)
- pattern (verilog-string-replace-matches "[?]" "." nil nil pattern)
- pattern (concat "^" pattern "$")
- dirfiles (verilog-dir-files root))
- (while dirfiles
- (setq basefile (car dirfiles)
- dirfile (expand-file-name (concat root basefile rest))
- dirfiles (cdr dirfiles))
- (if (and (string-match pattern basefile)
- ;; Don't allow abc/*/rtl to match abc/rtl via ..
- (not (equal basefile "."))
- (not (equal basefile ".."))
- (file-directory-p dirfile))
- (setq dirlist (cons dirfile dirlist)))))
- ;; Defaults
- (t
- (if (file-directory-p dirname)
- (setq dirlist (cons dirname dirlist))))))
- dirlist))
-;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v"))
+ (save-match-data
+ (setq dirnames (reverse dirnames)) ; not nreverse
+ (let ((dirlist nil)
+ pattern dirfile dirfiles dirname root filename rest basefile)
+ (setq dirnames (mapcar 'substitute-in-file-name dirnames))
+ (while dirnames
+ (setq dirname (car dirnames)
+ dirnames (cdr dirnames))
+ (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root
+ "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *?
+ "\\(.*\\)") ; rest
+ dirname)
+ (setq root (match-string 1 dirname)
+ filename (match-string 2 dirname)
+ rest (match-string 3 dirname)
+ pattern filename)
+ ;; now replace those * and ? with .+ and .
+ ;; use ^ and /> to get only whole file names
+ (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern)
+ pattern (verilog-string-replace-matches "[?]" "." nil nil pattern)
+ pattern (concat "^" pattern "$")
+ dirfiles (verilog-dir-files root))
+ (while dirfiles
+ (setq basefile (car dirfiles)
+ dirfile (expand-file-name (concat root basefile rest))
+ dirfiles (cdr dirfiles))
+ (when (and (string-match pattern basefile)
+ ;; Don't allow abc/*/rtl to match abc/rtl via ..
+ (not (equal basefile "."))
+ (not (equal basefile "..")))
+ ;; Might have more wildcards, so process again
+ (setq dirnames (cons dirfile dirnames)))))
+ ;; Defaults
+ (t
+ (if (file-directory-p dirname)
+ (setq dirlist (cons dirname dirlist))))))
+ dirlist)))
+;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v" "../*/*"))
(defun verilog-library-filenames (filename &optional current check-ext)
"Return a search path to find the given FILENAME or module name.
@@ -12074,7 +12090,7 @@ This is currently equivalent to:
with the below at the bottom of the file
// Local Variables:
- // verilog-auto-logic-type:\"logic\"
+ // verilog-auto-wire-type:\"logic\"
// End:
In the future AUTOLOGIC may declare additional identifiers,
@@ -13223,10 +13239,12 @@ Typing \\[verilog-auto] will make this into:
Replace the /*AUTOTIEOFF*/ comment with code to wire-tie all unused output
signals to deasserted.
-/*AUTOTIEOFF*/ is used to make stub modules; modules that have the same
-input/output list as another module, but no internals. Specifically, it
-finds all outputs in the module, and if that input is not otherwise declared
-as a register or wire, creates a tieoff.
+/*AUTOTIEOFF*/ is used to make stub modules; modules that have
+the same input/output list as another module, but no internals.
+Specifically, it finds all outputs in the module, and if that
+input is not otherwise declared as a register or wire, nor comes
+from a AUTOINST submodule's output, creates a tieoff. AUTOTIEOFF
+does not examine assignments to determine what is already driven.
AUTORESET ties signals to deasserted, which is presumed to be zero.
Signals that match `verilog-active-low-regexp' will be deasserted by tying
@@ -14420,7 +14438,7 @@ Files are checked based on `verilog-library-flags'."
(with-output-to-temp-buffer "*verilog-mode help*"
(princ (format "You are using verilog-mode %s\n" verilog-mode-version))
(princ "\n")
- (princ "For new releases, see http://www.verilog.com\n")
+ (princ "For new releases, see http://www.veripool.com/verilog-mode\n")
(princ "\n")
(princ "For frequently asked questions, see http://www.veripool.org/verilog-mode-faq.html\n")
(princ "\n")
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 06ffd54d2df..3f2d7e11ec9 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -32,7 +32,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
@@ -17897,7 +17897,7 @@ references:
[3] European Space Agency.
\"VHDL Modelling Guidelines\".
- ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
+ https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf
Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
to visually support naming conventions.")
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 41513340e12..adfe7b3bf1c 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index b8ec50f14ae..db025d40aa3 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -102,7 +102,7 @@ This is typically the filename.")
;;;; Commonly needed location classes are defined here:
;; FIXME: might be useful to have an optional "hint" i.e. a string to
-;; search for in case the line number is sightly out of date.
+;; search for in case the line number is slightly out of date.
(defclass xref-file-location (xref-location)
((file :type string :initarg :file)
(line :type fixnum :initarg :line :reader xref-location-line)
@@ -254,8 +254,7 @@ find a search tool; by default, this uses \"find | grep\" in the
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
- "Find all symbols that match PATTERN.
-PATTERN is a regexp")
+ "Find all symbols that match regexp PATTERN.")
(cl-defgeneric xref-backend-identifier-at-point (_backend)
"Return the relevant identifier at point.
@@ -449,43 +448,74 @@ If SELECT is non-nil, select the target window."
(when xref-w
(set-window-dedicated-p xref-w xref-w-dedicated)))))
-(defun xref--show-pos-in-buf (pos buf select)
- (let ((xref-buf (current-buffer))
- win)
+(defvar-local xref--original-window-intent nil
+ "Original window-switching intent before xref buffer creation.")
+
+(defvar-local xref--original-window nil
+ "The original window this xref buffer was created from.")
+
+(defun xref--show-pos-in-buf (pos buf)
+ "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
+ (or (eq xref--original-window-intent 'frame)
+ pop-up-frames))
+ (action
+ (cond ((memq
+ xref--original-window-intent
+ '(window frame))
+ t)
+ ((and
+ (window-live-p xref--original-window)
+ (or (not (window-dedicated-p xref--original-window))
+ (eq (window-buffer xref--original-window) buf)))
+ `(,(lambda (buf _alist)
+ (set-window-buffer xref--original-window buf)
+ xref--original-window))))))
(with-selected-window
- (xref--with-dedicated-window
- (display-buffer buf))
+ (with-selected-window
+ ;; Just before `display-buffer', place ourselves in the
+ ;; original window to suggest preserving it. Of course, if
+ ;; user has deleted the original window, all bets are off,
+ ;; just use the selected one.
+ (or (and (window-live-p xref--original-window)
+ xref--original-window)
+ (selected-window))
+ (display-buffer buf action))
(xref--goto-char pos)
(run-hooks 'xref-after-jump-hook)
(let ((buf (current-buffer)))
- (setq win (selected-window))
(with-current-buffer xref-buf
- (setq-local other-window-scroll-buffer buf))))
- (when select
- (select-window win))))
+ (setq-local other-window-scroll-buffer buf)))
+ (selected-window))))
(defun xref--show-location (location &optional select)
+ "Help `xref-show-xref' and `xref-goto-xref' do their job.
+Go to LOCATION and if SELECT is non-nil select its window. If
+SELECT is `quit', also quit the *xref* window."
(condition-case err
(let* ((marker (xref-location-marker location))
- (buf (marker-buffer marker)))
- (xref--show-pos-in-buf marker buf select))
+ (buf (marker-buffer marker))
+ (xref-buffer (current-buffer)))
+ (cond (select
+ (if (eq select 'quit) (quit-window nil nil))
+ (with-current-buffer xref-buffer
+ (select-window (xref--show-pos-in-buf marker buf))))
+ (t
+ (save-selected-window
+ (xref--with-dedicated-window
+ (xref--show-pos-in-buf marker buf))))))
(user-error (message (error-message-string err)))))
-(defvar-local xref--window nil
- "The original window this xref buffer was created from.")
-
(defun xref-show-location-at-point ()
"Display the source of xref at point in the appropriate window, if any."
(interactive)
(let* ((xref (xref--item-at-point))
(xref--current-item xref))
(when xref
- ;; Try to avoid the window the current xref buffer was
- ;; originally created from.
- (if (window-live-p xref--window)
- (with-selected-window xref--window
- (xref--show-location (xref-item-location xref)))
- (xref--show-location (xref-item-location xref))))))
+ (xref--show-location (xref-item-location xref)))))
(defun xref-next-line ()
"Move to the next xref and display its source in the appropriate window."
@@ -504,12 +534,19 @@ If SELECT is non-nil, select the target window."
(back-to-indentation)
(get-text-property (point) 'xref-item)))
-(defun xref-goto-xref ()
- "Jump to the xref on the current line and select its window."
+(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)
(let ((xref (or (xref--item-at-point)
(user-error "No reference at point"))))
- (xref--show-location (xref-item-location xref) t)))
+ (xref--show-location (xref-item-location xref) (if quit 'quit t))))
+
+(defun xref-quit-and-goto-xref ()
+ "Quit *xref* buffer, then jump to xref on current line."
+ (interactive)
+ (xref-goto-xref t))
(defun xref-query-replace-in-results (from to)
"Perform interactive replacement of FROM with TO in all displayed xrefs.
@@ -633,6 +670,7 @@ references displayed in the current *xref* buffer."
(define-key map (kbd "p") #'xref-prev-line)
(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)
(define-key map (kbd "C-o") #'xref-show-location-at-point)
;; suggested by Johan Claesson "to further reduce finger movement":
(define-key map (kbd ".") #'xref-next-line)
@@ -727,7 +765,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(xref--xref-buffer-mode)
(pop-to-buffer (current-buffer))
(goto-char (point-min))
- (setq xref--window (assoc-default 'window alist))
+ (setq xref--original-window (assoc-default 'window alist)
+ xref--original-window-intent (assoc-default 'display-action alist))
(current-buffer)))))
@@ -754,7 +793,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
(t
(xref-push-marker-stack)
(funcall xref-show-xrefs-function xrefs
- `((window . ,(selected-window)))))))
+ `((window . ,(selected-window))
+ (display-action . ,display-action))))))
(defun xref--prompt-p (command)
(or (eq xref-prompt-for-identifier t)
@@ -917,22 +957,25 @@ IGNORES is a list of glob patterns."
(grep-compute-defaults)
(defvar grep-find-template)
(defvar grep-highlight-matches)
- (let* ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E"
- grep-find-template t t))
- (grep-highlight-matches nil)
- ;; TODO: Sanitize the regexp to remove Emacs-specific terms,
- ;; so that Grep can search for the "relaxed" version. Can we
- ;; do that reliably enough, without creating false negatives?
- (command (xref--rgrep-command (xref--regexp-to-extended regexp)
- files
- (expand-file-name dir)
- ignores))
- (buf (get-buffer-create " *xref-grep*"))
- (grep-re (caar grep-regexp-alist))
- status
- hits)
+ (pcase-let*
+ ((grep-find-template (replace-regexp-in-string "<C>" "<C> -E"
+ grep-find-template t t))
+ (grep-highlight-matches nil)
+ ;; TODO: Sanitize the regexp to remove Emacs-specific terms,
+ ;; so that Grep can search for the "relaxed" version. Can we
+ ;; do that reliably enough, without creating false negatives?
+ (command (xref--rgrep-command (xref--regexp-to-extended regexp)
+ files
+ (expand-file-name dir)
+ ignores))
+ (def default-directory)
+ (buf (get-buffer-create " *xref-grep*"))
+ (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
+ (status nil)
+ (hits nil))
(with-current-buffer buf
(erase-buffer)
+ (setq default-directory def)
(setq status
(call-process-shell-command command nil t))
(goto-char (point-min))
@@ -944,8 +987,8 @@ IGNORES is a list of glob patterns."
(not (looking-at grep-re)))
(user-error "Search failed with status %d: %s" status (buffer-string)))
(while (re-search-forward grep-re nil t)
- (push (list (string-to-number (match-string 2))
- (match-string 1)
+ (push (list (string-to-number (match-string line-group))
+ (match-string file-group)
(buffer-substring-no-properties (point) (line-end-position)))
hits)))
(xref--convert-hits (nreverse hits) regexp)))
diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el
index bdfe30af505..16bf01eeaa8 100644
--- a/lisp/progmodes/xscheme.el
+++ b/lisp/progmodes/xscheme.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -85,8 +85,7 @@ reading-type received an altmode but nothing else
reading-string reading prompt string")
(defvar-local xscheme-allow-output-p t
- "This variable, if nil, prevents output from the scheme process
-from being inserted into the process-buffer.")
+ "Non-nil stops scheme process output being inserted in the process buffer.")
(defvar-local xscheme-prompt ""
"The current scheme prompt string.")
@@ -300,7 +299,7 @@ With argument, asks for a command line."
(defun scheme-interaction-mode (&optional preserve)
"Major mode for interacting with an inferior MIT Scheme process.
-Like scheme-mode except that:
+Like `scheme-mode' except that:
\\[xscheme-send-previous-expression] sends the expression before point to the Scheme process as input
\\[xscheme-yank-pop] yanks an expression previously sent to Scheme
@@ -315,7 +314,7 @@ in the minibuffer. If an error occurs, the process buffer will
automatically pop up to show you the error message.
While the Scheme process is running, the mode lines of all buffers in
-scheme-mode are modified to show the state of the process. The
+`scheme-mode' are modified to show the state of the process. The
possible states and their meanings are:
input waiting for input
@@ -353,13 +352,13 @@ Some possible command interpreter types and their meanings are:
Starting with release 6.2 of Scheme, the latter two types of command
interpreters will change the major mode of the Scheme process buffer
-to scheme-debugger-mode , in which the evaluation commands are
+to `scheme-debugger-mode', in which the evaluation commands are
disabled, and the keys which normally self insert instead send
themselves to the Scheme process. The command character ? will list
the available commands.
-For older releases of Scheme, the major mode will be be
-scheme-interaction-mode , and the command characters must be sent as
+For older releases of Scheme, the major mode will be
+`scheme-interaction-mode', and the command characters must be sent as
if they were expressions.
Commands:
@@ -367,10 +366,8 @@ Delete converts tabs to spaces as it moves back.
Blank lines separate paragraphs. Semicolons start comments.
\\{scheme-interaction-mode-map}
-Entry to this mode calls the value of scheme-interaction-mode-hook
-with no args, if that value is non-nil.
- Likewise with the value of scheme-mode-hook.
- scheme-interaction-mode-hook is called after scheme-mode-hook."
+Entry to this mode runs `scheme-mode-hook' and then
+`scheme-interaction-mode-hook'."
;; FIXME: Use define-derived-mode.
(interactive "P")
(if (not preserve)
@@ -456,7 +453,7 @@ with no args, if that value is non-nil.
(defun scheme-debugger-mode ()
"Major mode for executing the Scheme debugger.
-Like scheme-mode except that the evaluation commands
+Like `scheme-mode' except that the evaluation commands
are disabled, and characters that would normally be self inserting are
sent to the Scheme process instead. Typing ? will show you which
characters perform useful functions.
@@ -593,7 +590,7 @@ See also the commands \\[xscheme-yank-pop] and \\[xscheme-yank-push]."
"Insert or replace a just-yanked expression with an older expression.
If the previous command was not a yank, it yanks.
Otherwise, the region contains a stretch of reinserted
-expression. yank-pop deletes that text and inserts in its
+expression. `yank-pop' deletes that text and inserts in its
place a different expression.
With no argument, the next older expression is inserted.
@@ -620,7 +617,7 @@ comes the newest one."
"Insert or replace a just-yanked expression with a more recent expression.
If the previous command was not a yank, it yanks.
Otherwise, the region contains a stretch of reinserted
-expression. yank-pop deletes that text and inserts in its
+expression. `yank-pop' deletes that text and inserts in its
place a different expression.
With no argument, the next more recent expression is inserted.
diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el
index f49cbd7c589..04e69a307f8 100644
--- a/lisp/ps-bdf.el
+++ b/lisp/ps-bdf.el
@@ -27,7 +27,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ps-def.el b/lisp/ps-def.el
index ea51c2a09b1..a23ca53a831 100644
--- a/lisp/ps-def.el
+++ b/lisp/ps-def.el
@@ -2,10 +2,10 @@
;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; Package: ps-print
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 0a590105b20..0d850f1e520 100644
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -2,10 +2,10 @@
;; Copyright (C) 1998-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript, multibyte, mule
;; Package: ps-print
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 7476ab3bb12..8571f2287ac 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -4,10 +4,10 @@
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; Version: 7.3.5
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
@@ -20,7 +20,7 @@ Emacs without changes to the version number. When reporting bugs, please also
report the version of Emacs, if any, that ps-print was distributed with.
Please send all bug fixes and enhancements to
- bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
+ bug-gnu-emacs@gnu.org and Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.")
;; This file is part of GNU Emacs.
@@ -35,7 +35,7 @@ Please send all bug fixes and enhancements to
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1216,7 +1216,7 @@ Please send all bug fixes and enhancements to
;; New since version 2.8
;; ---------------------
;;
-;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; [vinicius] Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;;
;; 2007-10-27
;; `ps-fg-validate-p', `ps-fg-list'
@@ -1274,7 +1274,7 @@ Please send all bug fixes and enhancements to
;;
;; `ps-print-region-function'
;;
-;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; [vinicius] Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;;
;; 1999-03-01
;; PostScript tumble and setpagedevice.
@@ -1287,7 +1287,7 @@ Please send all bug fixes and enhancements to
;;
;; Multi-byte buffer handling.
;;
-;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; [vinicius] Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;;
;; 1998-03-06
;; Skip invisible text.
diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el
index f86e5269388..7507eee8f64 100644
--- a/lisp/ps-samp.el
+++ b/lisp/ps-samp.el
@@ -4,10 +4,10 @@
;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
;; Jacques Duthen (was <duthen@cegelec-red.fr>)
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
-;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: wp, print, PostScript
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
;; Package: ps-print
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/recentf.el b/lisp/recentf.el
index 462ccb6db5e..d78d7ce71da 100644
--- a/lisp/recentf.el
+++ b/lisp/recentf.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/rect.el b/lisp/rect.el
index a85101fddfa..a62ed95b715 100644
--- a/lisp/rect.el
+++ b/lisp/rect.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -450,6 +450,10 @@ With a prefix (or a FILL) argument, also fill too short lines."
"Replace rectangle contents with STRING on each line.
The length of STRING need not be the same as the rectangle width.
+When called interactively and option `rectangle-preview' is
+non-nil, display the result as the user enters the string into
+the minibuffer.
+
Called from a program, takes three args; START, END and STRING."
(interactive
(progn
diff --git a/lisp/register.el b/lisp/register.el
index 7cc3ccd870c..23eefd08b88 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -164,6 +164,10 @@ display such a window regardless."
help-chars)
(unless (get-buffer-window buffer)
(register-preview buffer 'show-empty)))
+ (when (or (eq ?\C-g last-input-event)
+ (eq 'escape last-input-event)
+ (eq ?\C-\[ last-input-event))
+ (keyboard-quit))
(if (characterp last-input-event) last-input-event
(error "Non-character input-event")))
(and (timerp timer) (cancel-timer timer))
@@ -178,8 +182,11 @@ Use \\[jump-to-register] to go to that location or restore that configuration.
Argument is a character, naming the register.
Interactively, reads the register using `register-read-with-preview'."
- (interactive (list (register-read-with-preview "Point to register: ")
- current-prefix-arg))
+ (interactive (list (register-read-with-preview
+ (if current-prefix-arg
+ "Frame configuration to register: "
+ "Point to register: "))
+ current-prefix-arg))
;; Turn the marker into a file-ref if the buffer is killed.
(add-hook 'kill-buffer-hook 'register-swap-out nil t)
(set-register register
diff --git a/lisp/registry.el b/lisp/registry.el
index 27664dc09ec..17dc23d68e8 100644
--- a/lisp/registry.el
+++ b/lisp/registry.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/repeat.el b/lisp/repeat.el
index c55a50a8343..f75d9d0d66b 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/replace.el b/lisp/replace.el
index 64dfe7da22d..80e584517ce 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,6 +28,7 @@
;;; Code:
+(require 'text-mode)
(eval-when-compile (require 'cl-lib))
(defcustom case-replace t
@@ -1395,6 +1396,11 @@ invoke `occur'."
"Show all lines in the current buffer containing a match for REGEXP.
If a match spreads across multiple lines, all those lines are shown.
+Each match is extended to include complete lines. Only non-overlapping
+matches are considered. (Note that extending matches to complete
+lines could cause some of the matches to overlap; if so, they will not
+be shown as separate matches.)
+
Each line is displayed with NLINES lines before and after, or -NLINES
before if NLINES is negative.
NLINES defaults to `list-matching-lines-default-context-lines'.
@@ -1637,175 +1643,185 @@ See also `multi-occur'."
(inhibit-field-text-motion t)
(headerpt (with-current-buffer out-buf (point))))
(with-current-buffer buf
- (or coding
- ;; Set CODING only if the current buffer locally
- ;; binds buffer-file-coding-system.
- (not (local-variable-p 'buffer-file-coding-system))
- (setq coding buffer-file-coding-system))
- (save-excursion
- (goto-char (point-min)) ;; begin searching in the buffer
- (while (not (eobp))
- (setq origpt (point))
- (when (setq endpt (re-search-forward regexp nil t))
- (setq lines (1+ lines)) ;; increment matching lines count
- (setq matchbeg (match-beginning 0))
- ;; Get beginning of first match line and end of the last.
- (save-excursion
- (goto-char matchbeg)
- (setq begpt (line-beginning-position))
- (goto-char endpt)
- (setq endpt (line-end-position)))
- ;; Sum line numbers up to the first match line.
- (setq curr-line (+ curr-line (count-lines origpt begpt)))
- (setq marker (make-marker))
- (set-marker marker matchbeg)
- (setq curstring (occur-engine-line begpt endpt keep-props))
- ;; Highlight the matches
- (let ((len (length curstring))
- (start 0))
- ;; Count empty lines that don't use next loop (Bug#22062).
- (when (zerop len)
- (setq matches (1+ matches)))
- (while (and (< start len)
- (string-match regexp curstring start))
- (setq matches (1+ matches))
- (add-text-properties
- (match-beginning 0) (match-end 0)
- '(occur-match t) curstring)
- (when match-face
- ;; Add `match-face' to faces copied from the buffer.
- (add-face-text-property
+ ;; The following binding is for when case-fold-search
+ ;; has a local binding in the original buffer, in which
+ ;; case we cannot bind it globally and let that have
+ ;; effect in every buffer we search.
+ (let ((case-fold-search case-fold))
+ (or coding
+ ;; Set CODING only if the current buffer locally
+ ;; binds buffer-file-coding-system.
+ (not (local-variable-p 'buffer-file-coding-system))
+ (setq coding buffer-file-coding-system))
+ (save-excursion
+ (goto-char (point-min)) ;; begin searching in the buffer
+ (while (not (eobp))
+ (setq origpt (point))
+ (when (setq endpt (re-search-forward regexp nil t))
+ (setq lines (1+ lines)) ;; increment matching lines count
+ (setq matchbeg (match-beginning 0))
+ ;; Get beginning of first match line and end of the last.
+ (save-excursion
+ (goto-char matchbeg)
+ (setq begpt (line-beginning-position))
+ (goto-char endpt)
+ (setq endpt (line-end-position)))
+ ;; Sum line numbers up to the first match line.
+ (setq curr-line (+ curr-line (count-lines origpt begpt)))
+ (setq marker (make-marker))
+ (set-marker marker matchbeg)
+ (setq curstring (occur-engine-line begpt endpt keep-props))
+ ;; Highlight the matches
+ (let ((len (length curstring))
+ (start 0))
+ ;; Count empty lines that don't use next loop (Bug#22062).
+ (when (zerop len)
+ (setq matches (1+ matches)))
+ (while (and (< start len)
+ (string-match regexp curstring start))
+ (setq matches (1+ matches))
+ (add-text-properties
(match-beginning 0) (match-end 0)
- match-face nil curstring))
- ;; Avoid infloop (Bug#7593).
- (let ((end (match-end 0)))
- (setq start (if (= start end) (1+ start) end)))))
- ;; Generate the string to insert for this match
- (let* ((match-prefix
- ;; Using 7 digits aligns tabs properly.
- (apply #'propertize (format "%7d:" curr-line)
- (append
- (when prefix-face
- `(font-lock-face ,prefix-face))
- `(occur-prefix t mouse-face (highlight)
- ;; Allow insertion of text at
- ;; the end of the prefix (for
- ;; Occur Edit mode).
- front-sticky t rear-nonsticky t
- occur-target ,marker follow-link t
- help-echo "mouse-2: go to this occurrence"))))
- (match-str
- ;; We don't put `mouse-face' on the newline,
- ;; because that loses. And don't put it
- ;; on context lines to reduce flicker.
- (propertize curstring 'mouse-face (list 'highlight)
- 'occur-target marker
- 'follow-link t
- 'help-echo
- "mouse-2: go to this occurrence"))
- (out-line
- (concat
- match-prefix
- ;; Add non-numeric prefix to all non-first lines
- ;; of multi-line matches.
- (replace-regexp-in-string
- "\n"
- (if prefix-face
- (propertize "\n :" 'font-lock-face prefix-face)
- "\n :")
- match-str)
- ;; Add marker at eol, but no mouse props.
- (propertize "\n" 'occur-target marker)))
- (data
- (if (= nlines 0)
- ;; The simple display style
- out-line
- ;; The complex multi-line display style.
- (setq ret (occur-context-lines
- out-line nlines keep-props begpt endpt
- curr-line prev-line prev-after-lines
- prefix-face))
- ;; Set first elem of the returned list to `data',
- ;; and the second elem to `prev-after-lines'.
- (setq prev-after-lines (nth 1 ret))
- (nth 0 ret))))
- ;; Actually insert the match display data
- (with-current-buffer out-buf
- (when (and list-matching-lines-jump-to-current-line
- (not multi-occur-p)
- (not orig-line-shown-p)
- (>= curr-line orig-line))
- (insert
- (concat
- (propertize
- (format "%7d:%s" orig-line orig-line-str)
- 'face list-matching-lines-current-line-face
- 'mouse-face 'mode-line-highlight
- 'help-echo "Current line") "\n"))
- (setq orig-line-shown-p t finalpt (point)))
- (insert data)))
- (goto-char endpt))
- (if endpt
- (progn
- ;; Sum line numbers between first and last match lines.
- (setq curr-line (+ curr-line (count-lines begpt endpt)
- ;; Add 1 for empty last match line since
- ;; count-lines returns 1 line less.
- (if (and (bolp) (eolp)) 1 0)))
- ;; On to the next match...
- (forward-line 1))
- (goto-char (point-max)))
- (setq prev-line (1- curr-line)))
- ;; Insert original line if haven't done yet.
- (when (and list-matching-lines-jump-to-current-line
- (not multi-occur-p)
- (not orig-line-shown-p))
- (with-current-buffer out-buf
- (insert
- (concat
- (propertize
- (format "%7d:%s" orig-line orig-line-str)
- 'face list-matching-lines-current-line-face
- 'mouse-face 'mode-line-highlight
- 'help-echo "Current line") "\n"))))
- ;; Flush remaining context after-lines.
- (when prev-after-lines
- (with-current-buffer out-buf
- (insert (apply #'concat (occur-engine-add-prefix
- prev-after-lines prefix-face)))))))
- (when (not (zerop lines)) ;; is the count zero?
- (setq global-lines (+ global-lines lines)
- global-matches (+ global-matches matches))
- (with-current-buffer out-buf
- (goto-char headerpt)
- (let ((beg (point))
- end)
- (insert (propertize
- (format "%d match%s%s%s in buffer: %s%s\n"
- matches (if (= matches 1) "" "es")
- ;; Don't display the same number of lines
- ;; and matches in case of 1 match per line.
- (if (= lines matches)
- "" (format " in %d line%s"
- lines (if (= lines 1) "" "s")))
- ;; Don't display regexp for multi-buffer.
- (if (> (length buffers) 1)
- "" (occur-regexp-descr regexp))
- (buffer-name buf)
- (if in-region-p
- (format " within region: %d-%d"
- occur--region-start
- occur--region-end)
- ""))
- 'read-only t))
- (setq end (point))
- (add-text-properties beg end `(occur-title ,buf))
- (when title-face
- (add-face-text-property beg end title-face))
- (goto-char (if finalpt
- (setq occur--final-pos
- (cl-incf finalpt (- end beg)))
- (point-min)))))))))
+ '(occur-match t) curstring)
+ (when match-face
+ ;; Add `match-face' to faces copied from the buffer.
+ (add-face-text-property
+ (match-beginning 0) (match-end 0)
+ match-face nil curstring))
+ ;; Avoid infloop (Bug#7593).
+ (let ((end (match-end 0)))
+ (setq start (if (= start end) (1+ start) end)))))
+ ;; Generate the string to insert for this match
+ (let* ((match-prefix
+ ;; Using 7 digits aligns tabs properly.
+ (apply #'propertize (format "%7d:" curr-line)
+ (append
+ (when prefix-face
+ `(font-lock-face ,prefix-face))
+ `(occur-prefix t mouse-face (highlight)
+ ;; Allow insertion of text
+ ;; at the end of the prefix
+ ;; (for Occur Edit mode).
+ front-sticky t
+ rear-nonsticky t
+ occur-target ,marker
+ follow-link t
+ help-echo "mouse-2: go to this occurrence"))))
+ (match-str
+ ;; We don't put `mouse-face' on the newline,
+ ;; because that loses. And don't put it
+ ;; on context lines to reduce flicker.
+ (propertize curstring 'mouse-face (list 'highlight)
+ 'occur-target marker
+ 'follow-link t
+ 'help-echo
+ "mouse-2: go to this occurrence"))
+ (out-line
+ (concat
+ match-prefix
+ ;; Add non-numeric prefix to all non-first lines
+ ;; of multi-line matches.
+ (replace-regexp-in-string
+ "\n"
+ (if prefix-face
+ (propertize
+ "\n :" 'font-lock-face prefix-face)
+ "\n :")
+ match-str)
+ ;; Add marker at eol, but no mouse props.
+ (propertize "\n" 'occur-target marker)))
+ (data
+ (if (= nlines 0)
+ ;; The simple display style
+ out-line
+ ;; The complex multi-line display style.
+ (setq ret (occur-context-lines
+ out-line nlines keep-props begpt
+ endpt curr-line prev-line
+ prev-after-lines prefix-face))
+ ;; Set first elem of the returned list to `data',
+ ;; and the second elem to `prev-after-lines'.
+ (setq prev-after-lines (nth 1 ret))
+ (nth 0 ret))))
+ ;; Actually insert the match display data
+ (with-current-buffer out-buf
+ (when (and list-matching-lines-jump-to-current-line
+ (not multi-occur-p)
+ (not orig-line-shown-p)
+ (>= curr-line orig-line))
+ (insert
+ (concat
+ (propertize
+ (format "%7d:%s" orig-line orig-line-str)
+ 'face list-matching-lines-current-line-face
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Current line") "\n"))
+ (setq orig-line-shown-p t finalpt (point)))
+ (insert data)))
+ (goto-char endpt))
+ (if endpt
+ (progn
+ ;; Sum line numbers between first and last match lines.
+ (setq curr-line (+ curr-line (count-lines begpt endpt)
+ ;; Add 1 for empty last match line
+ ;; since count-lines returns one
+ ;; line less.
+ (if (and (bolp) (eolp)) 1 0)))
+ ;; On to the next match...
+ (forward-line 1))
+ (goto-char (point-max)))
+ (setq prev-line (1- curr-line)))
+ ;; Insert original line if haven't done yet.
+ (when (and list-matching-lines-jump-to-current-line
+ (not multi-occur-p)
+ (not orig-line-shown-p))
+ (with-current-buffer out-buf
+ (insert
+ (concat
+ (propertize
+ (format "%7d:%s" orig-line orig-line-str)
+ 'face list-matching-lines-current-line-face
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Current line") "\n"))))
+ ;; Flush remaining context after-lines.
+ (when prev-after-lines
+ (with-current-buffer out-buf
+ (insert (apply #'concat (occur-engine-add-prefix
+ prev-after-lines prefix-face)))))))
+ (when (not (zerop lines)) ;; is the count zero?
+ (setq global-lines (+ global-lines lines)
+ global-matches (+ global-matches matches))
+ (with-current-buffer out-buf
+ (goto-char headerpt)
+ (let ((beg (point))
+ end)
+ (insert (propertize
+ (format "%d match%s%s%s in buffer: %s%s\n"
+ matches (if (= matches 1) "" "es")
+ ;; Don't display the same number of lines
+ ;; and matches in case of 1 match per line.
+ (if (= lines matches)
+ "" (format " in %d line%s"
+ lines
+ (if (= lines 1) "" "s")))
+ ;; Don't display regexp for multi-buffer.
+ (if (> (length buffers) 1)
+ "" (occur-regexp-descr regexp))
+ (buffer-name buf)
+ (if in-region-p
+ (format " within region: %d-%d"
+ occur--region-start
+ occur--region-end)
+ ""))
+ 'read-only t))
+ (setq end (point))
+ (add-text-properties beg end `(occur-title ,buf))
+ (when title-face
+ (add-face-text-property beg end title-face))
+ (goto-char (if finalpt
+ (setq occur--final-pos
+ (cl-incf finalpt (- end beg)))
+ (point-min))))))))))
;; Display total match count and regexp for multi-buffer.
(when (and (not (zerop global-lines)) (> (length buffers) 1))
(goto-char (point-min))
@@ -2216,6 +2232,26 @@ It is called with three arguments, as if it were
;; Close overlays opened by `isearch-range-invisible' in `perform-replace'.
(isearch-clean-overlays))
+;; A macro because we push STACK, i.e. a local var in `perform-replace'.
+(defmacro replace--push-stack (replaced search-str next-replace stack)
+ (declare (indent 0) (debug (form form form gv-place)))
+ `(push (list (point) ,replaced
+;;; If the replacement has already happened, all we need is the
+;;; current match start and end. We could get this with a trivial
+;;; match like
+;;; (save-excursion (goto-char (match-beginning 0))
+;;; (search-forward (match-string 0))
+;;; (match-data t))
+;;; if we really wanted to avoid manually constructing match data.
+;;; Adding current-buffer is necessary so that match-data calls can
+;;; return markers which are appropriate for editing.
+ (if ,replaced
+ (list
+ (match-beginning 0) (match-end 0) (current-buffer))
+ (match-data t))
+ ,search-str ,next-replace)
+ ,stack))
+
(defun perform-replace (from-string replacements
query-flag regexp-flag delimited-flag
&optional repeat-count map start end backward region-noncontiguous-p)
@@ -2259,6 +2295,8 @@ It must return a string."
(next-replacement-replaced nil) ; replacement string
; (substituted regexp)
(last-was-undo)
+ (last-was-act-and-show)
+ (update-stack t)
(replace-count 0)
(skip-read-only-count 0)
(skip-filtered-count 0)
@@ -2542,7 +2580,7 @@ It must return a string."
next-replacement)
(while (and (< stack-idx stack-len)
stack
- (null replaced))
+ (or (null replaced) last-was-act-and-show))
(let* ((elt (nth stack-idx stack)))
(setq
stack-idx (1+ stack-idx)
@@ -2552,10 +2590,11 @@ It must return a string."
search-string (nth (if replaced 4 3) elt)
next-replacement (nth (if replaced 3 4) elt)
search-string-replaced search-string
- next-replacement-replaced next-replacement)
+ next-replacement-replaced next-replacement
+ last-was-act-and-show nil)
(when (and (= stack-idx stack-len)
- (null replaced)
+ (and (null replaced) (not last-was-act-and-show))
(zerop num-replacements))
(message "Nothing to undo")
(ding 'no-terminate)
@@ -2595,7 +2634,7 @@ It must return a string."
"replacements"))
(ding 'no-terminate)
(sit-for 1)))
- (setq replaced nil last-was-undo t)))
+ (setq replaced nil last-was-undo t last-was-act-and-show nil)))
((eq def 'act)
(or replaced
(setq noedit
@@ -2603,7 +2642,7 @@ It must return a string."
next-replacement nocasify literal
noedit real-match-data backward)
replace-count (1+ replace-count)))
- (setq done t replaced t))
+ (setq done t replaced t update-stack (not last-was-act-and-show)))
((eq def 'act-and-exit)
(or replaced
(setq noedit
@@ -2614,7 +2653,7 @@ It must return a string."
(setq keep-going nil)
(setq done t replaced t))
((eq def 'act-and-show)
- (if (not replaced)
+ (unless replaced
(setq noedit
(replace-match-maybe-edit
next-replacement nocasify literal
@@ -2622,7 +2661,11 @@ It must return a string."
replace-count (1+ replace-count)
real-match-data (replace-match-data
t real-match-data)
- replaced t)))
+ replaced t last-was-act-and-show t)
+ (replace--push-stack
+ replaced
+ search-string-replaced
+ next-replacement-replaced stack)))
((or (eq def 'automatic) (eq def 'automatic-all))
(or replaced
(setq noedit
@@ -2633,7 +2676,7 @@ It must return a string."
(setq done t query-flag nil replaced t)
(if (eq def 'automatic-all) (setq multi-buffer t)))
((eq def 'skip)
- (setq done t))
+ (setq done t update-stack (not last-was-act-and-show)))
((eq def 'recenter)
;; `this-command' has the value `query-replace',
;; so we need to bind it to `recenter-top-bottom'
@@ -2703,27 +2746,14 @@ It must return a string."
;; Record previous position for ^ when we move on.
;; Change markers to numbers in the match data
;; since lots of markers slow down editing.
- (push (list (point) replaced
-;;; If the replacement has already happened, all we need is the
-;;; current match start and end. We could get this with a trivial
-;;; match like
-;;; (save-excursion (goto-char (match-beginning 0))
-;;; (search-forward (match-string 0))
-;;; (match-data t))
-;;; if we really wanted to avoid manually constructing match data.
-;;; Adding current-buffer is necessary so that match-data calls can
-;;; return markers which are appropriate for editing.
- (if replaced
- (list
- (match-beginning 0)
- (match-end 0)
- (current-buffer))
- (match-data t))
- search-string-replaced
- next-replacement-replaced)
- stack)
+ (when update-stack
+ (replace--push-stack
+ replaced
+ search-string-replaced
+ next-replacement-replaced stack))
(setq next-replacement-replaced nil
- search-string-replaced nil))))))
+ search-string-replaced nil
+ last-was-act-and-show nil))))))
(replace-dehighlight))
(or unread-command-events
(message "Replaced %d occurrence%s%s"
diff --git a/lisp/reposition.el b/lisp/reposition.el
index ce24d29e5f2..833b65ac52b 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/reveal.el b/lisp/reveal.el
index 66f5bc47554..1b6cd335d77 100644
--- a/lisp/reveal.el
+++ b/lisp/reveal.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el
index f5df7f80f91..66204125d58 100644
--- a/lisp/rfn-eshadow.el
+++ b/lisp/rfn-eshadow.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/rot13.el b/lisp/rot13.el
index 20a0dbed462..886085b8265 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/rtree.el b/lisp/rtree.el
index b4c9d48b83c..9db03c474d3 100644
--- a/lisp/rtree.el
+++ b/lisp/rtree.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 7b0588dfead..cac91e421e0 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -304,7 +304,15 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
(defsubst ruler-mode-window-col (n)
"Return a column number relative to the selected window.
-N is a column number relative to selected frame."
+N is a column number relative to selected frame.
+If required, account for screen estate taken by `display-line-numbers'."
+ (if display-line-numbers
+ ;; FIXME: ruler-mode relies on N being an integer, so if the
+ ;; 'line-number' face is customized to use a font that is larger
+ ;; or smaller than that of the default face, the alignment might
+ ;; be off by up to half a column, unless the font width is an
+ ;; integral multiple or divisor of the default face's font.
+ (setq n (- n (round (line-number-display-width 'columns)))))
(- n
(or (car (window-margins)) 0)
(fringe-columns 'left)
@@ -665,7 +673,12 @@ Optional argument PROPS specifies other text properties to apply."
(let* ((w (ruler-mode-text-scaled-window-width))
(m (window-margins))
(f (window-fringes))
- (i 0)
+ (i (if display-line-numbers
+ ;; FIXME: ruler-mode relies on I being an integer, so
+ ;; the column numbers might be slightly off if the
+ ;; line-number face is customized.
+ (round (line-number-display-width 'columns))
+ 0))
(j (ruler-mode-text-scaled-window-hscroll))
;; Setup the scrollbar, fringes, and margins areas.
(lf (ruler-mode-space
@@ -696,8 +709,18 @@ Optional argument PROPS specifies other text properties to apply."
;; Create an "clean" ruler.
(ruler
(propertize
- (string-to-multibyte
- (make-string w ruler-mode-basic-graduation-char))
+ ;; Make the part of header-line corresponding to the
+ ;; line-number display be blank, not filled with
+ ;; ruler-mode-basic-graduation-char.
+ (if display-line-numbers
+ (let* ((lndw (round (line-number-display-width 'columns)))
+ ;; We need a multibyte string here so we could
+ ;; later use aset to insert multibyte characters
+ ;; into that string.
+ (s (make-string lndw ?\s t)))
+ (concat s (make-string (- w lndw)
+ ruler-mode-basic-graduation-char t)))
+ (make-string w ruler-mode-basic-graduation-char t))
'face 'ruler-mode-default
'local-map ruler-mode-map
'help-echo (cond
diff --git a/lisp/savehist.el b/lisp/savehist.el
index 9a3c5cfc4d6..c1f17f76617 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index 603ab65d717..54599c7e11f 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/sb-image.el b/lisp/sb-image.el
index b94978a8df2..6faa66d1528 100644
--- a/lisp/sb-image.el
+++ b/lisp/sb-image.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el
index 59efe8c11b4..90365fae3fb 100644
--- a/lisp/scroll-all.el
+++ b/lisp/scroll-all.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This mode allows multiple buffers to be 'locked' so that scrolling
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 58352740447..8f02f2f3e9d 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el
index 50868e7257c..837189c2129 100644
--- a/lisp/scroll-lock.el
+++ b/lisp/scroll-lock.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/select.el b/lisp/select.el
index 4849d7d515e..54acb5292e6 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -98,7 +98,7 @@ if applicable (i.e. under X11)."
'select-enable-clipboard "25.1")
(defcustom select-enable-primary nil
- "Non-nil means cutting and pasting uses the primary selection
+ "Non-nil means cutting and pasting uses the primary selection.
The existence of a primary selection depends on the underlying GUI you use.
E.g. it doesn't exist under MS-Windows."
:type 'boolean
@@ -475,6 +475,9 @@ two markers or an overlay. Otherwise, it is nil."
(t
(error "Unknown selection type: %S" type)))))
+ ;; Most programs are unable to handle NUL bytes in strings.
+ (setq str (replace-regexp-in-string "\0" "\\0" str t t))
+
(setq next-selection-coding-system nil)
(cons type str))))
diff --git a/lisp/server.el b/lisp/server.el
index 209bfaaf701..0e225f723ea 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -23,7 +23,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -525,30 +525,38 @@ Creates the directory if necessary and makes sure:
;; Check that it's safe for use.
(let* ((uid (nth 2 attrs))
(w32 (eq system-type 'windows-nt))
- (safe (cond
- ((not (eq t (car attrs))) nil) ; is a dir?
- ((and w32 (zerop uid)) ; on FAT32?
- (display-warning
- 'server
- (format-message "\
+ (unsafe (cond
+ ((not (eq t (car attrs)))
+ (if (null attrs) "its attributes can't be checked"
+ (format "it is a %s"
+ (if (stringp (car attrs))
+ "symlink" "file"))))
+ ((and w32 (zerop uid)) ; on FAT32?
+ (display-warning
+ 'server
+ (format-message "\
Using `%s' to store Emacs-server authentication files.
Directories on FAT32 filesystems are NOT secure against tampering.
See variable `server-auth-dir' for details."
- (file-name-as-directory dir))
- :warning)
- t)
- ((and (/= uid (user-uid)) ; is the dir ours?
- (or (not w32)
- ;; Files created on Windows by Administrator
- ;; (RID=500) have the Administrators (RID=544)
- ;; group recorded as the owner.
- (/= uid 544) (/= (user-uid) 500)))
- nil)
- (w32 t) ; on NTFS?
- (t ; else, check permissions
- (zerop (logand ?\077 (file-modes dir)))))))
- (unless safe
- (error "The directory `%s' is unsafe" dir)))))
+ (file-name-as-directory dir))
+ :warning)
+ nil)
+ ((and (/= uid (user-uid)) ; is the dir ours?
+ (or (not w32)
+ ;; Files created on Windows by Administrator
+ ;; (RID=500) have the Administrators (RID=544)
+ ;; group recorded as the owner.
+ (/= uid 544) (/= (user-uid) 500)))
+ (format "it is not owned by you (owner = %s (%d))"
+ (user-full-name uid) uid))
+ (w32 nil) ; on NTFS?
+ ((/= 0 (logand ?\077 (file-modes dir)))
+ (format "it is accessible by others (%03o)"
+ (file-modes dir)))
+ (t nil))))
+ (when unsafe
+ (error "`%s' is not a safe directory because %s"
+ (expand-file-name dir) unsafe)))))
(defun server-generate-key ()
"Generate and return a random authentication key.
diff --git a/lisp/ses.el b/lisp/ses.el
index fd7174d383d..4c19c70c5da 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -167,12 +167,32 @@ Each function is called with ARG=1."
["Export values" ses-export-tsv t]
["Export formulas" ses-export-tsf t]))
+(defconst ses-completion-keys '("\M-\C-i" "\C-i")
+ "List for keys that can be used for completion while editing.")
+
+(defvar ses--completion-table nil
+ "Set globally to what completion table to use depending on type
+ of completion (local printers, cells, etc.). We need to go
+ through a local variable to pass the SES buffer local variable
+ to completing function while the current buffer is the
+ minibuffer.")
+
+(defvar ses--list-orig-buffer nil
+ "Calling buffer for SES listing help. Used for listing local
+ printers or renamed cells.")
+
+
(defconst ses-mode-edit-map
(let ((keys '("\C-c\C-r" ses-insert-range
"\C-c\C-s" ses-insert-ses-range
[S-mouse-3] ses-insert-range-click
[C-S-mouse-3] ses-insert-ses-range-click
- "\M-\C-i" lisp-complete-symbol)) ; FIXME obsolete
+ "\C-h\C-p" ses-list-local-printers
+ "\C-h\C-n" ses-list-named-cells
+ "\M-\C-i" lisp-complete-symbol)) ; redefined
+ ; dynamically in
+ ; editing
+ ; functions
(newmap (make-sparse-keymap)))
(set-keymap-parent newmap minibuffer-local-map)
(while keys
@@ -437,7 +457,7 @@ is nil if SYM is not a symbol that names a cell."
(declare (debug t))
`(let ((rc (and (symbolp ,sym) (get ,sym 'ses-cell))))
(if (eq rc :ses-named)
- (gethash ,sym ses--named-cell-hashmap)
+ (and ses--named-cell-hashmap (gethash ,sym ses--named-cell-hashmap))
rc)))
(defun ses-cell-p (cell)
@@ -868,27 +888,39 @@ means Emacs will crash if FORMULA contains a circular list."
(oldref (ses-formula-references old))
(newref (ses-formula-references formula))
(inhibit-quit t)
+ not-a-cell-ref-list
x xrow xcol)
(cl-pushnew sym ses--deferred-recalc)
;;Delete old references from this cell. Skip the ones that are also
;;in the new list.
(dolist (ref oldref)
(unless (memq ref newref)
- (setq x (ses-sym-rowcol ref)
- xrow (car x)
- xcol (cdr x))
- (ses-set-cell xrow xcol 'references
- (delq sym (ses-cell-references xrow xcol)))))
+ ;; because we do not cancel edit when the user provides a
+ ;; false reference in it, then we need to check that ref
+ ;; points to a cell that is within the spreadsheet.
+ (setq x (ses-sym-rowcol ref))
+ (and x
+ (< (setq xrow (car x)) ses--numrows)
+ (< (setq xcol (cdr x)) ses--numcols)
+ (ses-set-cell xrow xcol 'references
+ (delq sym (ses-cell-references xrow xcol))))))
;;Add new ones. Skip ones left over from old list
(dolist (ref newref)
- (setq x (ses-sym-rowcol ref)
- xrow (car x)
- xcol (cdr x)
- x (ses-cell-references xrow xcol))
- (or (memq sym x)
- (ses-set-cell xrow xcol 'references (cons sym x))))
+ (setq x (ses-sym-rowcol ref))
+ ;;Do not trust the user, the reference may be outside the spreadsheet
+ (if (and
+ x
+ (< (setq xrow (car x)) ses--numrows)
+ (< (setq xcol (cdr x)) ses--numcols))
+ (progn
+ (setq x (ses-cell-references xrow xcol))
+ (or (memq sym x)
+ (ses-set-cell xrow xcol 'references (cons sym x))))
+ (cl-pushnew ref not-a-cell-ref-list)))
(ses-formula-record formula)
- (ses-set-cell row col 'formula formula))))
+ (ses-set-cell row col 'formula formula)
+ (and not-a-cell-ref-list
+ (error "Found in formula cells not in spreadsheet: %S" not-a-cell-ref-list)))))
(defun ses-repair-cell-reference-all ()
@@ -1222,8 +1254,7 @@ preceding cell has spilled over."
((< len width)
;; Fill field to length with spaces.
(setq len (make-string (- width len) ?\s)
- text (if (or (stringp value)
- (eq ses-call-printer-return t))
+ text (if (eq ses-call-printer-return t)
(concat text len)
(concat len text))))
((> len width)
@@ -1529,7 +1560,13 @@ by (ROWINCR,COLINCR)."
;;Relocate this variable, unless it is a named cell
(if (eq (get sym 'ses-cell) :ses-named)
sym
- (ses-create-cell-symbol row col))
+ ;; otherwise, we create the relocated cell symbol because
+ ;; ses-cell-symbol gives the old symbols, however since
+ ;; renamed cell are not relocated we keep the relocated
+ ;; cell old symbol in this case.
+ (if (eq (get (setq sym (ses-cell-symbol row col)) 'ses-cell) :ses-named)
+ sym
+ (ses-create-cell-symbol row col)))
;;Delete reference to a deleted cell
nil))))
@@ -1697,7 +1734,7 @@ to each symbol."
(set (make-local-variable sym) nil)
(put sym 'ses-cell (cons row col)))))) )))
;; Relocate the cell values.
- (let (oldval myrow mycol xrow xcol)
+ (let (oldval myrow mycol xrow xcol sym)
(cond
((and (<= rowincr 0) (<= colincr 0))
;; Deletion of rows and/or columns.
@@ -1707,16 +1744,16 @@ to each symbol."
(dotimes (col (- ses--numcols mincol))
(setq mycol (+ col mincol)
xrow (- myrow rowincr)
- xcol (- mycol colincr))
- (let ((sym (ses-cell-symbol myrow mycol)))
- ;; We don't need to relocate value for renamed cells, as they keep the same
- ;; symbol.
- (unless (eq (get sym 'ses-cell) :ses-named)
- (ses-set-cell myrow mycol 'value
- (if (and (< xrow ses--numrows) (< xcol ses--numcols))
- (ses-cell-value xrow xcol)
- ;; Cell is off the end of the array.
- (symbol-value (ses-create-cell-symbol xrow xcol))))))))
+ xcol (- mycol colincr)
+ sym (ses-cell-symbol myrow mycol))
+ ;; We don't need to relocate value for renamed cells, as they keep the same
+ ;; symbol.
+ (unless (eq (get sym 'ses-cell) :ses-named)
+ (ses-set-cell myrow mycol 'value
+ (if (and (< xrow ses--numrows) (< xcol ses--numcols))
+ (ses-cell-value xrow xcol)
+ ;; Cell is off the end of the array.
+ (symbol-value (ses-create-cell-symbol xrow xcol)))))))
(when ses--in-killing-named-cell-list
(message "Unbinding killed named cell symbols...")
(setq ses-start-time (float-time))
@@ -1736,13 +1773,17 @@ to each symbol."
(dotimes (col (- ses--numcols mincol))
(setq mycol (- distx col)
xrow (- myrow rowincr)
- xcol (- mycol colincr))
- (if (or (< xrow minrow) (< xcol mincol))
- ;; Newly-inserted value.
- (setq oldval nil)
- ;; Transfer old value.
- (setq oldval (ses-cell-value xrow xcol)))
- (ses-set-cell myrow mycol 'value oldval)))
+ xcol (- mycol colincr)
+ sym (ses-cell-symbol myrow mycol))
+ ;; We don't need to relocate value for renamed cells, as they keep the same
+ ;; symbol.
+ (unless (eq (get sym 'ses-cell) :ses-named)
+ (if (or (< xrow minrow) (< xcol mincol))
+ ;; Newly-inserted value.
+ (setq oldval nil)
+ ;; Transfer old value.
+ (setq oldval (ses-cell-value xrow xcol)))
+ (ses-set-cell myrow mycol 'value oldval))))
t)) ; Make testcover happy by returning non-nil here.
(t
(error "ROWINCR and COLINCR must have the same sign"))))
@@ -1862,7 +1903,7 @@ Does not execute cell formulas or print functions."
(setq ses--numlocprn 0)
(dotimes (_ numlocprn)
(let ((x (read (current-buffer))))
- (or (and (looking-at-p "\n")
+ (or (and (= (following-char) ?\n)
(eq (car-safe x) 'ses-local-printer)
(apply #'ses--local-printer (cdr x)))
(error "local printer-def error"))
@@ -1872,7 +1913,7 @@ Does not execute cell formulas or print functions."
(dotimes (col ses--numcols)
(let* ((x (read (current-buffer)))
(sym (car-safe (cdr-safe x))))
- (or (and (looking-at-p "\n")
+ (or (and (= (following-char) ?\n)
(eq (car-safe x) 'ses-cell)
(ses-create-cell-variable sym row col))
(error "Cell-def error"))
@@ -2337,7 +2378,8 @@ to are recalculated first."
"Recalculate and reprint all cells."
(interactive "*")
(let ((startcell (ses--cell-at-pos (point)))
- (ses--curcell (cons 'A1 (ses-cell-symbol (1- ses--numrows)
+ (ses--curcell (cons (ses-cell-symbol 0 0)
+ (ses-cell-symbol (1- ses--numrows)
(1- ses--numcols)))))
(ses-recalculate-cell ses--curcell)
(ses-jump-safe startcell)))
@@ -2424,6 +2466,42 @@ to are recalculated first."
;;----------------------------------------------------------------------------
;; Input of cell formulas
;;----------------------------------------------------------------------------
+(defun ses-edit-cell-complete-symbol ()
+ (interactive)
+ (let ((completion-at-point-functions (cons 'ses--edit-cell-completion-at-point-function
+ completion-at-point-functions)))
+ (completion-at-point)))
+
+(defun ses--edit-cell-completion-at-point-function ()
+ (and
+ ses--completion-table
+ (let* ((bol (save-excursion (move-beginning-of-line nil) (point)))
+ start end collection
+ (prefix
+ (save-excursion
+ (setq end (point))
+ (backward-sexp)
+ (if (< (point) bol)
+ (progn
+ (setq start bol)
+ (buffer-substring start end))
+ (setq start (point))
+ (forward-sexp)
+ (if (>= (point) end)
+ (progn
+ (setq end (point))
+ (buffer-substring start end))
+ nil))))
+ prefix-length)
+ (when (and prefix (null (string= prefix "")))
+ (setq prefix-length (length prefix))
+ (maphash (lambda (key val)
+ (let ((key-name (symbol-name key)))
+ (when (and (>= (length key-name) prefix-length)
+ (string= prefix (substring key-name 0 prefix-length)))
+ (push key-name collection))))
+ ses--completion-table)
+ (and collection (list start end collection))))))
(defun ses-edit-cell (row col newval)
"Display current cell contents in minibuffer, for editing. Returns nil if
@@ -2445,6 +2523,10 @@ cell formula was unsafe and user declined confirmation."
(if (stringp formula)
;; Position cursor inside close-quote.
(setq initial (cons initial (length initial))))
+ (dolist (key ses-completion-keys)
+ (define-key ses-mode-edit-map key 'ses-edit-cell-complete-symbol))
+ ;; make it globally visible, so that it can be visible from the minibuffer.
+ (setq ses--completion-table ses--named-cell-hashmap)
(list row col
(read-from-minibuffer (format "Cell %s: " ses--curcell)
initial
@@ -2539,6 +2621,40 @@ cells."
;;----------------------------------------------------------------------------
;; Input of cell-printer functions
;;----------------------------------------------------------------------------
+(defun ses-read-printer-complete-symbol ()
+ (interactive)
+ (let ((completion-at-point-functions (cons 'ses--read-printer-completion-at-point-function
+ completion-at-point-functions)))
+ (completion-at-point)))
+
+(defun ses--read-printer-completion-at-point-function ()
+ (let* ((bol (save-excursion (move-beginning-of-line nil) (point)))
+ start end collection
+ (prefix
+ (save-excursion
+ (setq end (point))
+ (backward-sexp)
+ (if (< (point) bol)
+ (progn
+ (setq start bol)
+ (buffer-substring start end))
+ (setq start (point))
+ (forward-sexp)
+ (if (>= (point) end)
+ (progn
+ (setq end (point))
+ (buffer-substring start end))
+ nil))))
+ prefix-length)
+ (when prefix
+ (setq prefix-length (length prefix))
+ (maphash (lambda (key val)
+ (let ((key-name (symbol-name key)))
+ (when (and (>= (length key-name) prefix-length)
+ (string= prefix (substring key-name 0 prefix-length)))
+ (push key-name collection))))
+ ses--completion-table)
+ (and collection (list start end collection)))))
(defun ses-read-printer (prompt default)
"Common code for functions `ses-read-cell-printer', `ses-read-column-printer',
@@ -2551,6 +2667,10 @@ canceled."
(setq prompt (format "%s (default %S): "
(substring prompt 0 -2)
default)))
+ (dolist (key ses-completion-keys)
+ (define-key ses-mode-edit-map key 'ses-read-printer-complete-symbol))
+ ;; make it globally visible, so that it can be visible from the minibuffer.
+ (setq ses--completion-table ses--local-printer-hashmap)
(let ((new (read-from-minibuffer prompt
nil ; Initial contents.
ses-mode-edit-map
@@ -3259,6 +3379,78 @@ is non-nil. Newlines and tabs in the export text are escaped."
(setq result (apply #'concat (nreverse result)))
(kill-new result)))
+;;----------------------------------------------------------------------------
+;; Interactive help on symbols
+;;----------------------------------------------------------------------------
+
+(defun ses-list-local-printers (&optional local-printer-hashmap)
+ "List local printers in a help buffer. Can be called either
+during editing a printer or a formula, or while in the SES
+buffer."
+ (interactive
+ (list (cond
+ ((derived-mode-p 'ses-mode) ses--local-printer-hashmap)
+ ((minibufferp) ses--completion-table)
+ ((derived-mode-p 'help-mode) nil)
+ (t (error "Not in a SES buffer")))))
+ (when local-printer-hashmap
+ (let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer))))
+ (help-setup-xref
+ (list (lambda (local-printer-hashmap buffer)
+ (let ((ses--list-orig-buffer
+ (if (buffer-live-p buffer) buffer)))
+ (ses-list-local-printers local-printer-hashmap)))
+ local-printer-hashmap ses--list-orig-buffer)
+ (called-interactively-p 'interactive))
+
+ (save-excursion
+ (with-help-window (help-buffer)
+ (if (= 0 (hash-table-count local-printer-hashmap))
+ (princ "No local printers defined.")
+ (princ "List of local printers definitions:\n")
+ (maphash (lambda (key val)
+ (princ key)
+ (princ " as ")
+ (prin1 (ses--locprn-def val))
+ (princ "\n"))
+ local-printer-hashmap))
+ (with-current-buffer standard-output
+ (buffer-string)))))))
+
+(defun ses-list-named-cells (&optional named-cell-hashmap)
+ "List named cells in a help buffer. Can be called either
+during editing a printer or a formula, or while in the SES
+buffer."
+ (interactive
+ (list (cond
+ ((derived-mode-p 'ses-mode) ses--named-cell-hashmap)
+ ((minibufferp) ses--completion-table)
+ ((derived-mode-p 'help-mode) nil)
+ (t (error "Not in a SES buffer")))))
+ (when named-cell-hashmap
+ (let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer))))
+ (help-setup-xref
+ (list (lambda (named-cell-hashmap buffer)
+ (let ((ses--list-orig-buffer
+ (if (buffer-live-p buffer) buffer)))
+ (ses-list-named-cells named-cell-hashmap)))
+ named-cell-hashmap ses--list-orig-buffer)
+ (called-interactively-p 'interactive))
+
+ (save-excursion
+ (with-help-window (help-buffer)
+ (if (= 0 (hash-table-count named-cell-hashmap))
+ (princ "No cell was renamed.")
+ (princ "List of named cells definitions:\n")
+ (maphash (lambda (key val)
+ (princ key)
+ (princ " for ")
+ (prin1 (ses-create-cell-symbol (car val) (cdr val)))
+ (princ "\n"))
+ named-cell-hashmap))
+ (with-current-buffer standard-output
+ (buffer-string)))))))
+
;;----------------------------------------------------------------------------
;; Other user commands
@@ -3441,8 +3633,12 @@ highlighted range in the spreadsheet."
(defun ses-replace-name-in-formula (formula old-name new-name)
(let ((new-formula formula))
- (unless (and (consp formula)
- (eq (car-safe formula) 'quote))
+ (cond
+ ((eq (car-safe formula) 'quote))
+ ((symbolp formula)
+ (if (eq formula old-name)
+ (setq new-formula new-name)))
+ ((consp formula)
(while formula
(let ((elt (car-safe formula)))
(cond
@@ -3451,8 +3647,8 @@ highlighted range in the spreadsheet."
((and (symbolp elt)
(eq (car-safe formula) old-name))
(setcar formula new-name))))
- (setq formula (cdr formula))))
- new-formula))
+ (setq formula (cdr formula)))))
+ new-formula))
(defun ses-rename-cell (new-name &optional cell)
"Rename current cell."
@@ -3477,9 +3673,10 @@ highlighted range in the spreadsheet."
(rowcol (ses-sym-rowcol sym))
(row (car rowcol))
(col (cdr rowcol))
- new-rowcol old-name)
+ new-rowcol old-name old-value)
(setq cell (or cell (ses-get-cell row col))
old-name (ses-cell-symbol cell)
+ old-value (symbol-value old-name)
new-rowcol (ses-decode-cell-symbol (symbol-name new-name)))
;; when ses-rename-cell is called interactively, then 'sym' is the
;; 'cursor-intangible' property of text at cursor position, while
@@ -3499,10 +3696,12 @@ highlighted range in the spreadsheet."
(put new-name 'ses-cell :ses-named)
(puthash new-name rowcol ses--named-cell-hashmap))
(push `(ses-rename-cell ,old-name ,cell) buffer-undo-list)
+ (cl-pushnew rowcol ses--deferred-write :test #'equal)
;; Replace name by new name in formula of cells refering to renamed cell.
(dolist (ref (ses-cell-references cell))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
+ (cl-pushnew x ses--deferred-write :test #'equal)
(setf (ses-cell-formula xcell)
(ses-replace-name-in-formula
(ses-cell-formula xcell)
@@ -3513,11 +3712,14 @@ highlighted range in the spreadsheet."
(dolist (ref (ses-formula-references (ses-cell-formula cell)))
(let* ((x (ses-sym-rowcol ref))
(xcell (ses-get-cell (car x) (cdr x))))
+ (cl-pushnew x ses--deferred-write :test #'equal)
(setf (ses-cell-references xcell)
(cons new-name (delq old-name
(ses-cell-references xcell))))))
(set (make-local-variable new-name) (symbol-value sym))
(setf (ses-cell--symbol cell) new-name)
+ ;; set new name to value
+ (set new-name old-value)
;; Unbind old name
(if (eq (get old-name 'ses-cell) :ses-named)
(ses--unbind-cell-name old-name)
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
index 21d0f0a40bd..53718ab082a 100644
--- a/lisp/shadowfile.el
+++ b/lisp/shadowfile.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/shell.el b/lisp/shell.el
index c5e5cbbee7e..9c837629243 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -264,7 +264,9 @@ 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."
+ "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)
:group 'shell)
diff --git a/lisp/simple.el b/lisp/simple.el
index a5565ab6e73..24ecf6929d9 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -39,11 +39,11 @@
(defcustom shell-command-dont-erase-buffer nil
"If non-nil, output buffer is not erased between shell commands.
-Also, a non-nil value set the point in the output buffer
-once the command complete.
-The value `beg-last-out' set point at the beginning of the output,
-`end-last-out' set point at the end of the buffer, `save-point'
-restore the buffer position before the command."
+Also, a non-nil value sets the point in the output buffer
+once the command completes.
+The value `beg-last-out' sets point at the beginning of the output,
+`end-last-out' sets point at the end of the buffer, `save-point'
+restores the buffer position before the command."
:type '(choice
(const :tag "Erase buffer" nil)
(const :tag "Set point to beginning of last output" beg-last-out)
@@ -53,9 +53,10 @@ restore the buffer position before the command."
:version "26.1")
(defvar shell-command-saved-pos nil
- "Point position in the output buffer after command complete.
-It is an alist (BUFFER . POS), where BUFFER is the output
-buffer, and POS is the point position in BUFFER once the command finish.
+ "Record of point positions in output buffers after command completion.
+The value is an alist whose elements are of the form (BUFFER . POS),
+where BUFFER is the output buffer, and POS is the point position
+in BUFFER once the command finishes.
This variable is used when `shell-command-dont-erase-buffer' is non-nil.")
(defcustom idle-update-delay 0.5
@@ -278,23 +279,28 @@ To control which errors are matched, customize the variable
`compilation-error-regexp-alist'."
(interactive "P")
(if (consp arg) (setq reset t arg nil))
- (when (setq next-error-last-buffer (next-error-find-buffer))
- ;; we know here that next-error-function is a valid symbol we can funcall
- (with-current-buffer next-error-last-buffer
- (funcall next-error-function (prefix-numeric-value arg) reset)
- (when next-error-recenter
- (recenter next-error-recenter))
- (run-hooks 'next-error-hook))))
+ (let ((buffer (next-error-find-buffer)))
+ (when buffer
+ ;; We know here that next-error-function is a valid symbol we can funcall
+ (with-current-buffer buffer
+ (funcall next-error-function (prefix-numeric-value arg) reset)
+ ;; Override possible change of next-error-last-buffer in next-error-function
+ (setq next-error-last-buffer buffer)
+ (when next-error-recenter
+ (recenter next-error-recenter))
+ (run-hooks 'next-error-hook)))))
(defun next-error-internal ()
"Visit the source code corresponding to the `next-error' message at point."
- (setq next-error-last-buffer (current-buffer))
- ;; we know here that next-error-function is a valid symbol we can funcall
- (with-current-buffer next-error-last-buffer
- (funcall next-error-function 0 nil)
- (when next-error-recenter
- (recenter next-error-recenter))
- (run-hooks 'next-error-hook)))
+ (let ((buffer (current-buffer)))
+ ;; We know here that next-error-function is a valid symbol we can funcall
+ (with-current-buffer buffer
+ (funcall next-error-function 0 nil)
+ ;; Override possible change of next-error-last-buffer in next-error-function
+ (setq next-error-last-buffer buffer)
+ (when next-error-recenter
+ (recenter next-error-recenter))
+ (run-hooks 'next-error-hook))))
(defalias 'goto-next-locus 'next-error)
(defalias 'next-match 'next-error)
@@ -400,9 +406,18 @@ Other major modes are defined by comparison with this one."
(defvar self-insert-uses-region-functions nil
"Special hook to tell if `self-insert-command' will use the region.
It must be called via `run-hook-with-args-until-success' with no arguments.
-Any `post-self-insert-command' which consumes the region should
-register a function on this hook so that things like `delete-selection-mode'
-can refrain from consuming the region.")
+
+If any function on this hook returns a non-nil value, `delete-selection-mode'
+will act on that value (see `delete-selection-helper'), and will
+usually delete the region. If all the functions on this hook return
+nil, it is an indiction that `self-insert-command' needs the region
+untouched by `delete-selection-mode', and will itself do whatever is
+appropriate with the region.
+Any function on `post-self-insert-hook' which act on the region should
+add a function to this hook so that `delete-selection-mode' could
+refrain from deleting the region before `post-self-insert-hook'
+functions are called.
+This hook is run by `delete-selection-uses-region-p', which see.")
(defvar hard-newline (propertize "\n" 'hard t 'rear-nonsticky '(hard))
"Propertized string representing a hard newline character.")
@@ -434,10 +449,6 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
;; Do the rest in post-self-insert-hook, because we want to do it
;; *before* other functions on that hook.
(lambda ()
- ;; We are not going to insert any newlines if arg is
- ;; non-positive.
- (or (and (numberp arg) (<= arg 0))
- (cl-assert (eq ?\n (char-before))))
;; Mark the newline(s) `hard'.
(if use-hard-newlines
(set-hard-newline-properties
@@ -456,25 +467,22 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
;; starts a page.
(or was-page-start
(move-to-left-margin nil t)))))
- (unwind-protect
- (if (not interactive)
- ;; FIXME: For non-interactive uses, many calls actually
- ;; just want (insert "\n"), so maybe we should do just
- ;; that, so as to avoid the risk of filling or running
- ;; abbrevs unexpectedly.
- (let ((post-self-insert-hook (list postproc)))
- (self-insert-command arg))
- (unwind-protect
- (progn
- (add-hook 'post-self-insert-hook postproc nil t)
- (self-insert-command arg))
- ;; We first used let-binding to protect the hook, but that
- ;; was naive since add-hook affects the symbol-default
- ;; value of the variable, whereas the let-binding might
- ;; only protect the buffer-local value.
- (remove-hook 'post-self-insert-hook postproc t)))
- (cl-assert (not (member postproc post-self-insert-hook)))
- (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
+ (if (not interactive)
+ ;; FIXME: For non-interactive uses, many calls actually
+ ;; just want (insert "\n"), so maybe we should do just
+ ;; that, so as to avoid the risk of filling or running
+ ;; abbrevs unexpectedly.
+ (let ((post-self-insert-hook (list postproc)))
+ (self-insert-command arg))
+ (unwind-protect
+ (progn
+ (add-hook 'post-self-insert-hook postproc nil t)
+ (self-insert-command arg))
+ ;; We first used let-binding to protect the hook, but that
+ ;; was naive since add-hook affects the symbol-default
+ ;; value of the variable, whereas the let-binding might
+ ;; only protect the buffer-local value.
+ (remove-hook 'post-self-insert-hook postproc t))))
nil)
(defun set-hard-newline-properties (from to)
@@ -996,23 +1004,24 @@ instead of deleted."
:version "24.1")
(defvar region-extract-function
- (lambda (delete)
+ (lambda (method)
(when (region-beginning)
(cond
- ((eq delete 'bounds)
+ ((eq method 'bounds)
(list (cons (region-beginning) (region-end))))
- ((eq delete 'delete-only)
+ ((eq method 'delete-only)
(delete-region (region-beginning) (region-end)))
(t
- (filter-buffer-substring (region-beginning) (region-end) delete)))))
+ (filter-buffer-substring (region-beginning) (region-end) method)))))
"Function to get the region's content.
-Called with one argument DELETE.
-If DELETE is `delete-only', then only delete the region and the return value
-is undefined. If DELETE is nil, just return the content as a string.
-If DELETE is `bounds', then don't delete, but just return the
-boundaries of the region as a list of (START . END) positions.
-If anything else, delete the region and return its content as a string,
-after filtering it with `filter-buffer-substring'.")
+Called with one argument METHOD.
+If METHOD is `delete-only', then delete the region; the return value
+is undefined. If METHOD is nil, then return the content as a string.
+If METHOD is `bounds', then return the boundaries of the region
+as a list of cons cells of the form (START . END).
+If METHOD is anything else, delete the region and return its content
+as a string, after filtering it with `filter-buffer-substring', which
+is called with METHOD as its 3rd argument.")
(defvar region-insert-function
(lambda (lines)
@@ -1270,18 +1279,25 @@ and the greater of them is not at the start of a line."
done)))
(- (buffer-size) (forward-line (buffer-size)))))))
-(defun line-number-at-pos (&optional pos)
- "Return (narrowed) buffer line number at position POS.
+(defun line-number-at-pos (&optional pos absolute)
+ "Return buffer line number at position POS.
If POS is nil, use current buffer location.
-Counting starts at (point-min), so the value refers
-to the contents of the accessible portion of the buffer."
- (let ((opoint (or pos (point))) start)
- (save-excursion
- (goto-char (point-min))
- (setq start (point))
- (goto-char opoint)
- (forward-line 0)
- (1+ (count-lines start (point))))))
+
+If ABSOLUTE is nil, the default, counting starts
+at (point-min), so the value refers to the contents of the
+accessible portion of the (potentially narrowed) buffer. If
+ABSOLUTE is non-nil, ignore any narrowing and return the
+absolute line number."
+ (save-restriction
+ (when absolute
+ (widen))
+ (let ((opoint (or pos (point))) start)
+ (save-excursion
+ (goto-char (point-min))
+ (setq start (point))
+ (goto-char opoint)
+ (forward-line 0)
+ (1+ (count-lines start (point)))))))
(defun what-cursor-position (&optional detail)
"Print info on cursor position (on screen and within buffer).
@@ -2563,10 +2579,10 @@ Return what remains of the list."
(setq did-apply t)))
;; Element (STRING . POS) means STRING was deleted.
(`(,(and string (pred stringp)) . ,(and pos (pred integerp)))
- (when (let ((apos (abs pos)))
- (or (< apos (point-min)) (> apos (point-max))))
- (error "Changes to be undone are outside visible portion of buffer"))
- (let (valid-marker-adjustments)
+ (let ((valid-marker-adjustments nil)
+ (apos (abs pos)))
+ (when (or (< apos (point-min)) (> apos (point-max)))
+ (error "Changes to be undone are outside visible portion of buffer"))
;; Check that marker adjustments which were recorded
;; with the (STRING . POS) record are still valid, ie
;; the markers haven't moved. We check their validity
@@ -2577,7 +2593,7 @@ Return what remains of the list."
(let* ((marker-adj (pop list))
(m (car marker-adj)))
(and (eq (marker-buffer m) (current-buffer))
- (= pos m)
+ (= apos m)
(push marker-adj valid-marker-adjustments))))
;; Insert string and adjust point
(if (< pos 0)
@@ -3271,6 +3287,17 @@ output buffer and running a new command in the default buffer,
:group 'shell
:version "24.3")
+(defcustom async-shell-command-display-buffer t
+ "Whether to display the command buffer immediately.
+If t, display the buffer immediately; if nil, wait until there
+is output."
+ :type '(choice (const :tag "Display buffer immediately"
+ t)
+ (const :tag "Display buffer on output"
+ nil))
+ :group 'shell
+ :version "26.1")
+
(defun shell-command--save-pos-or-erase ()
"Store a buffer position or erase the buffer.
See `shell-command-dont-erase-buffer'."
@@ -3380,10 +3407,10 @@ The optional second argument OUTPUT-BUFFER, if non-nil,
says to put the output in some other buffer.
If OUTPUT-BUFFER is a buffer or buffer name, erase that buffer
and insert the output there; a non-nil value of
-`shell-command-dont-erase-buffer' prevent to erase the buffer.
-If OUTPUT-BUFFER is not a buffer and not nil, insert the output
-in current buffer after point leaving mark after it.
-This cannot be done asynchronously.
+`shell-command-dont-erase-buffer' prevents the buffer from being
+erased. If OUTPUT-BUFFER is not a buffer and not nil, insert the
+output in current buffer after point leaving mark after it. This
+cannot be done asynchronously.
If the command terminates without error, but generates output,
and you did not specify \"insert it in the current buffer\",
@@ -3391,7 +3418,7 @@ the output can be displayed in the echo area or in its buffer.
If the output is short enough to display in the echo area
\(determined by the variable `max-mini-window-height' if
`resize-mini-windows' is non-nil), it is shown there.
-Otherwise,the buffer containing the output is displayed.
+Otherwise, the buffer containing the output is displayed.
If there is output and an error, and you did not specify \"insert it
in the current buffer\", a message about the error goes at the end
@@ -3474,10 +3501,11 @@ the use of a shell (with its need to quote arguments)."
(save-match-data
(if (string-match "[ \t]*&[ \t]*\\'" command)
;; Command ending with ampersand means asynchronous.
- (let ((buffer (get-buffer-create
- (or output-buffer "*Async Shell Command*")))
- (directory default-directory)
- proc)
+ (let* ((buffer (get-buffer-create
+ (or output-buffer "*Async Shell Command*")))
+ (bname (buffer-name buffer))
+ (directory default-directory)
+ proc)
;; Remove the ampersand.
(setq command (substring command 0 (match-beginning 0)))
;; Ask the user what to do with already running process.
@@ -3492,32 +3520,25 @@ the use of a shell (with its need to quote arguments)."
((eq async-shell-command-buffer 'confirm-new-buffer)
;; If will create a new buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ")
- (setq buffer (generate-new-buffer
- (or (and (bufferp output-buffer) (buffer-name output-buffer))
- output-buffer "*Async Shell Command*")))
+ (setq buffer (generate-new-buffer bname))
(error "Shell command in progress")))
((eq async-shell-command-buffer 'new-buffer)
;; It will create a new buffer.
- (setq buffer (generate-new-buffer
- (or (and (bufferp output-buffer) (buffer-name output-buffer))
- output-buffer "*Async Shell Command*"))))
+ (setq buffer (generate-new-buffer bname)))
((eq async-shell-command-buffer 'confirm-rename-buffer)
;; If will rename the buffer, query first.
(if (yes-or-no-p "A command is running in the default buffer. Rename it? ")
(progn
(with-current-buffer buffer
(rename-uniquely))
- (setq buffer (get-buffer-create
- (or output-buffer "*Async Shell Command*"))))
+ (setq buffer (get-buffer-create bname)))
(error "Shell command in progress")))
((eq async-shell-command-buffer 'rename-buffer)
;; It will rename the buffer.
(with-current-buffer buffer
(rename-uniquely))
- (setq buffer (get-buffer-create
- (or output-buffer "*Async Shell Command*"))))))
+ (setq buffer (get-buffer-create bname)))))
(with-current-buffer buffer
- (display-buffer buffer '(nil (allow-no-window . t)))
(shell-command--save-pos-or-erase)
(setq default-directory directory)
(setq proc (start-process "Shell" buffer shell-file-name
@@ -3525,10 +3546,18 @@ the use of a shell (with its need to quote arguments)."
(setq mode-line-process '(":%s"))
(require 'shell) (shell-mode)
(set-process-sentinel proc 'shell-command-sentinel)
- ;; Use the comint filter for proper handling of carriage motion
- ;; (see `comint-inhibit-carriage-motion'),.
+ ;; Use the comint filter for proper handling of
+ ;; carriage motion (see comint-inhibit-carriage-motion).
(set-process-filter proc 'comint-output-filter)
- ))
+ (if async-shell-command-display-buffer
+ (display-buffer buffer '(nil (allow-no-window . t)))
+ (add-function :before (process-filter proc)
+ (lambda (process _string)
+ (let ((buf (process-buffer process)))
+ (when (and (zerop (buffer-size buf))
+ (string= (buffer-name buf)
+ bname))
+ (display-buffer buf))))))))
;; Otherwise, command is executed synchronously.
(shell-command-on-region (point) (point) command
output-buffer nil error-buffer)))))))
@@ -3901,8 +3930,7 @@ support pty association, if PROGRAM is nil."
("Command" 0 t)])
(make-local-variable 'process-menu-query-only)
(setq tabulated-list-sort-key (cons "Process" nil))
- (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t)
- (tabulated-list-init-header))
+ (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t))
(defun process-menu-delete-process ()
"Kill process at point in a `list-processes' buffer."
@@ -3963,7 +3991,8 @@ Also, delete any process that is exited or signaled."
"")))))
(mapconcat 'identity (process-command p) " "))))
(push (list p (vector name pid status buf-label tty cmd))
- tabulated-list-entries))))))
+ tabulated-list-entries)))))
+ (tabulated-list-init-header))
(defun process-menu-visit-buffer (button)
(display-buffer (button-get button 'process-buffer)))
@@ -5453,7 +5482,8 @@ also checks the value of `use-empty-active-region'."
(progn (cl-assert (mark)) t)))
(defun region-bounds ()
- "Return the boundaries of the region as a list of (START . END) positions."
+ "Return the boundaries of the region as a pair of positions.
+Value is a list of cons cells of the form (START . END)."
(funcall region-extract-function 'bounds))
(defun region-noncontiguous-p ()
@@ -5935,11 +5965,15 @@ columns by which window is scrolled from left margin.
When the `track-eol' feature is doing its job, the value is
`most-positive-fixnum'.")
+(defvar last--line-number-width 0
+ "Last value of width used for displaying line numbers.
+Used internally by `line-move-visual'.")
+
(defcustom line-move-ignore-invisible t
"Non-nil means commands that move by lines ignore invisible newlines.
When this option is non-nil, \\[next-line], \\[previous-line], \\[move-end-of-line], and \\[move-beginning-of-line] behave
as if newlines that are invisible didn't exist, and count
-only visible newlines. Thus, moving across across 2 newlines
+only visible newlines. Thus, moving across 2 newlines
one of which is invisible will be counted as a one-line move.
Also, a non-nil value causes invisible text to be ignored when
counting columns for the purposes of keeping point in the same
@@ -6099,7 +6133,7 @@ The value is a floating-point number."
(or (null rbot) (= rbot 0)))
nil)
;; If cursor is not in the bottom scroll margin, and the
- ;; current line is is not too tall, move forward.
+ ;; current line is not too tall, move forward.
((and (or (null this-height) (<= this-height winh))
vpos
(> vpos 0)
@@ -6205,6 +6239,7 @@ not vscroll."
If NOERROR, don't signal an error if we can't move that many lines."
(let ((opoint (point))
(hscroll (window-hscroll))
+ (lnum-width (line-number-display-width t))
target-hscroll)
;; Check if the previous command was a line-motion command, or if
;; we were called from some other command.
@@ -6212,16 +6247,27 @@ If NOERROR, don't signal an error if we can't move that many lines."
(memq last-command `(next-line previous-line ,this-command)))
;; If so, there's no need to reset `temporary-goal-column',
;; but we may need to hscroll.
- (if (or (/= (cdr temporary-goal-column) hscroll)
- (> (cdr temporary-goal-column) 0))
- (setq target-hscroll (cdr temporary-goal-column)))
+ (progn
+ (if (or (/= (cdr temporary-goal-column) hscroll)
+ (> (cdr temporary-goal-column) 0))
+ (setq target-hscroll (cdr temporary-goal-column)))
+ ;; Update the COLUMN part of temporary-goal-column if the
+ ;; line-number display changed its width since the last
+ ;; time.
+ (setq temporary-goal-column
+ (cons (+ (car temporary-goal-column)
+ (/ (float (- lnum-width last--line-number-width))
+ (frame-char-width)))
+ (cdr temporary-goal-column)))
+ (setq last--line-number-width lnum-width))
;; Otherwise, we should reset `temporary-goal-column'.
(let ((posn (posn-at-point))
x-pos)
(cond
- ;; Handle the `overflow-newline-into-fringe' case:
- ((eq (nth 1 posn) 'right-fringe)
- (setq temporary-goal-column (cons (- (window-width) 1) hscroll)))
+ ;; Handle the `overflow-newline-into-fringe' case
+ ;; (left-fringe is for the R2L case):
+ ((memq (nth 1 posn) '(right-fringe left-fringe))
+ (setq temporary-goal-column (cons (window-width) hscroll)))
((car (posn-x-y posn))
(setq x-pos (car (posn-x-y posn)))
;; In R2L lines, the X pixel coordinate is measured from the
@@ -6580,6 +6626,8 @@ which are part of the text that the image rests on.)
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
+beginning of the last line.)
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(interactive "^p")
(or arg (setq arg 1))
@@ -6668,6 +6716,8 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
"Move point to beginning of current visual line.
With argument N not nil or 1, move forward N - 1 visual 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
+beginning of the last visual line.)
To ignore intangibility, bind `inhibit-point-motion-hooks' to t."
(interactive "^p")
(or n (setq n 1))
@@ -6780,10 +6830,13 @@ other purposes."
(defvar visual-line--saved-state nil)
(define-minor-mode visual-line-mode
- "Toggle visual line based editing (Visual Line mode).
-With a prefix argument ARG, enable Visual Line mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+ "Toggle visual line based editing (Visual Line mode) in the current buffer.
+Interactively, with a prefix argument, enable
+Visual Line mode if the prefix argument is positive,
+and disable it otherwise. If called from Lisp, toggle
+the mode if ARG is `toggle', disable the mode if ARG is
+a non-positive integer, and enable the mode otherwise
+\(including if ARG is omitted or nil or a positive integer).
When Visual Line mode is enabled, `word-wrap' is turned on in
this buffer, and simple editing commands are redefined to act on
@@ -7101,18 +7154,18 @@ Returns t if it really did any work."
(setq fill-prefix prefix))))
(while (and (not give-up) (> (current-column) fc))
- ;; Determine where to split the line.
- (let* (after-prefix
- (fill-point
- (save-excursion
- (beginning-of-line)
- (setq after-prefix (point))
- (and fill-prefix
- (looking-at (regexp-quote fill-prefix))
- (setq after-prefix (match-end 0)))
- (move-to-column (1+ fc))
- (fill-move-to-break-point after-prefix)
- (point))))
+ ;; Determine where to split the line.
+ (let ((fill-point
+ (save-excursion
+ (beginning-of-line)
+ ;; Don't split earlier in the line than the length of the
+ ;; fill prefix, since the resulting line would be longer.
+ (when fill-prefix
+ (move-to-column (string-width fill-prefix)))
+ (let ((after-prefix (point)))
+ (move-to-column (1+ fc))
+ (fill-move-to-break-point after-prefix)
+ (point)))))
;; See whether the place we found is any good.
(if (save-excursion
@@ -7120,9 +7173,6 @@ Returns t if it really did any work."
(or (bolp)
;; There is no use breaking at end of line.
(save-excursion (skip-chars-forward " ") (eolp))
- ;; It is futile to split at the end of the prefix
- ;; since we would just insert the prefix again.
- (and after-prefix (<= (point) after-prefix))
;; Don't split right after a comment starter
;; since we would just make another comment starter.
(and comment-start-skip
@@ -7196,6 +7246,13 @@ unless optional argument SOFT is non-nil."
;; If we're not inside a comment, just try to indent.
(t (indent-according-to-mode))))))
+(defun internal-auto-fill ()
+ "The function called by `self-insert-command' to perform auto-filling."
+ (when (or (not comment-start)
+ (not comment-auto-fill-only-comments)
+ (nth 4 (syntax-ppss)))
+ (funcall auto-fill-function)))
+
(defvar normal-auto-fill-function 'do-auto-fill
"The function to use for `auto-fill-function' if Auto Fill mode is turned on.
Some major modes set this.")
@@ -7208,9 +7265,12 @@ Some major modes set this.")
(define-minor-mode auto-fill-mode
"Toggle automatic line breaking (Auto Fill mode).
-With a prefix argument ARG, enable Auto Fill mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil.
+Interactively, with a prefix argument, enable
+Auto Fill mode if the prefix argument is positive,
+and disable it otherwise. If called from Lisp, toggle
+the mode if ARG is `toggle', disable the mode if ARG is
+a non-positive integer, and enable the mode otherwise
+\(including if ARG is omitted or nil or a positive integer).
When Auto Fill mode is enabled, inserting a space at a column
beyond `current-fill-column' automatically breaks the line at a
@@ -7804,7 +7864,7 @@ buffer buried."
(eq mail-user-agent 'message-user-agent)
(let (warn-vars)
(dolist (var '(mail-mode-hook mail-send-hook mail-setup-hook
- mail-yank-hooks mail-archive-file-name
+ mail-citation-hook mail-archive-file-name
mail-default-reply-to mail-mailing-lists
mail-self-blind))
(and (boundp var)
@@ -8465,13 +8525,16 @@ after it has been set up properly in other respects."
;; Set up other local variables.
(mapc (lambda (v)
- (condition-case () ;in case var is read-only
+ (condition-case ()
(if (symbolp v)
(makunbound v)
(set (make-local-variable (car v)) (cdr v)))
- (error nil)))
+ (setting-constant nil))) ;E.g. for enable-multibyte-characters.
lvars)
+ (setq mark-ring (mapcar (lambda (mk) (copy-marker (marker-position mk)))
+ mark-ring))
+
;; Run any hooks (typically set up by the major mode
;; for cloning to work properly).
(run-hooks 'clone-buffer-hook))
@@ -8762,7 +8825,7 @@ If it does not exist, create and it switch it to `messages-buffer-mode'."
;; rms says this should be done by specifying symbols that define
;; versions together with bad values. This is therefore not as
;; flexible as it could be. See the thread:
-;; http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00300.html
+;; https://lists.gnu.org/r/emacs-devel/2007-08/msg00300.html
(defconst bad-packages-alist
;; Not sure exactly which semantic versions have problems.
;; Definitely 2.0pre3, probably all 2.0pre's before this.
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
index dbfa87e207d..d182bdff300 100644
--- a/lisp/skeleton.el
+++ b/lisp/skeleton.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/sort.el b/lisp/sort.el
index 88a784fbb85..1dee6ef6c56 100644
--- a/lisp/sort.el
+++ b/lisp/sort.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -406,7 +406,7 @@ the sort order."
;;;###autoload
(defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
- "Sort the text in the region region lexicographically.
+ "Sort the text in the region lexicographically.
If called interactively, prompt for two regular expressions,
RECORD-REGEXP and KEY-REGEXP.
diff --git a/lisp/soundex.el b/lisp/soundex.el
index e0d83303e34..0903b80abe5 100644
--- a/lisp/soundex.el
+++ b/lisp/soundex.el
@@ -1,4 +1,4 @@
-;;; soundex.el --- implement Soundex algorithm
+;;; soundex.el --- implement Soundex algorithm -*- lexical-binding: t -*-
;; Copyright (C) 1993, 2001-2017 Free Software Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,7 +29,7 @@
;;; Code:
-(defvar soundex-alist
+(defconst soundex-alist
'((?B . "1") (?F . "1") (?P . "1") (?V . "1")
(?C . "2") (?G . "2") (?J . "2") (?K . "2") (?Q . "2") (?S . "2")
(?X . "2") (?Z . "2") (?D . "3") (?T . "3") (?L . "4") (?M . "5")
@@ -60,15 +60,6 @@ and Searching\", Addison-Wesley (1973), pp. 391-392."
(substring (concat key "000") 0 4)
key)))
-;(defvar soundex-test
-; '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz"
-; "Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous")
-; "\n Knuth's names to demonstrate the Soundex algorithm.")
-;
-;(mapcar 'soundex soundex-test)
-;("E460" "G200" "H416" "K530" "L300" "L222"
-; "E460" "G200" "H416" "K530" "L300" "L222")
-
(provide 'soundex)
;;; soundex.el ends here
diff --git a/lisp/speedbar.el b/lisp/speedbar.el
index 31134711830..c66cc89dda2 100644
--- a/lisp/speedbar.el
+++ b/lisp/speedbar.el
@@ -25,7 +25,7 @@ this version is not backward compatible to 0.14 or earlier.")
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/startup.el b/lisp/startup.el
index bc60bbd08b8..a39c8f0fe76 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -513,7 +513,7 @@ It is the default value of the variable `top-level'."
(let ((default-directory dir))
(load (expand-file-name "subdirs.el") t t t))
;; Do not scan standard directories that won't contain a leim-list.el.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2009-10/msg00502.html
+ ;; https://lists.gnu.org/r/emacs-devel/2009-10/msg00502.html
;; (Except the preloaded one in lisp/leim.)
(or (string-prefix-p lispdir dir)
(let ((default-directory dir))
@@ -1371,7 +1371,7 @@ the `--debug-init' option to view a complete error backtrace."
;; trying to load gnus could load the wrong file.
;; OK, it would not matter if .emacs.d were at the end of load-path.
;; but for the sake of simplicity, we discourage it full-stop.
- ;; Ref eg http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00056.html
+ ;; Ref eg https://lists.gnu.org/r/emacs-devel/2012-03/msg00056.html
;;
;; A bad element could come from user-emacs-file, the command line,
;; or EMACSLOADPATH, so we basically always have to check.
@@ -1432,6 +1432,7 @@ 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))))
(dolist (x settings)
(if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals)
@@ -1462,18 +1463,18 @@ If this is nil, no message will be displayed."
`((:face (variable-pitch font-lock-comment-face)
"Welcome to "
:link ("GNU Emacs"
- ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
- "Browse http://www.gnu.org/software/emacs/")
+ ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/"))
+ "Browse https://www.gnu.org/software/emacs/")
", one component of the "
:link
,(lambda ()
(if (eq system-type 'gnu/linux)
`("GNU/Linux"
- ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
- "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
+ ,(lambda (_button) (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html"))
+ "Browse https://www.gnu.org/gnu/linux-and-gnu.html")
`("GNU" ,(lambda (_button)
- (browse-url "http://www.gnu.org/gnu/thegnuproject.html"))
- "Browse http://www.gnu.org/gnu/thegnuproject.html")))
+ (browse-url "https://www.gnu.org/gnu/thegnuproject.html"))
+ "Browse https://www.gnu.org/gnu/thegnuproject.html")))
" operating system.\n\n"
:face variable-pitch
:link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial)))
@@ -1505,8 +1506,8 @@ If this is nil, no message will be displayed."
"\n"
:link ("Emacs Guided Tour"
,(lambda (_button)
- (browse-url "http://www.gnu.org/software/emacs/tour/"))
- "Browse http://www.gnu.org/software/emacs/tour/")
+ (browse-url "https://www.gnu.org/software/emacs/tour/"))
+ "Browse https://www.gnu.org/software/emacs/tour/")
"\tOverview of Emacs features at gnu.org\n"
:link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual)))
"\tView the Emacs manual using Info\n"
@@ -1528,16 +1529,16 @@ Each element in the list should be a list of strings or pairs
`((:face (variable-pitch font-lock-comment-face)
"This is "
:link ("GNU Emacs"
- ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/"))
- "Browse http://www.gnu.org/software/emacs/")
+ ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/"))
+ "Browse https://www.gnu.org/software/emacs/")
", one component of the "
:link
,(lambda ()
(if (eq system-type 'gnu/linux)
`("GNU/Linux"
,(lambda (_button)
- (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html"))
- "Browse http://www.gnu.org/gnu/linux-and-gnu.html")
+ (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html"))
+ "Browse https://www.gnu.org/gnu/linux-and-gnu.html")
`("GNU" ,(lambda (_button) (describe-gnu-project))
"Display info on the GNU project.")))
" operating system.\n"
@@ -1596,8 +1597,8 @@ Each element in the list should be a list of strings or pairs
"\n"
:link ("Emacs Guided Tour"
,(lambda (_button)
- (browse-url "http://www.gnu.org/software/emacs/tour/"))
- "Browse http://www.gnu.org/software/emacs/tour/")
+ (browse-url "https://www.gnu.org/software/emacs/tour/"))
+ "Browse https://www.gnu.org/software/emacs/tour/")
"\tSee an overview of Emacs features at gnu.org"))
"A list of texts to show in the middle part of the About screen.
Each element in the list should be a list of strings or pairs
@@ -1705,8 +1706,8 @@ a face or button specification."
;; Insert the image with a help-echo and a link.
(make-button (prog1 (point) (insert-image img)) (point)
'face 'default
- 'help-echo "mouse-2, RET: Browse http://www.gnu.org/"
- 'action (lambda (_button) (browse-url "http://www.gnu.org/"))
+ 'help-echo "mouse-2, RET: Browse https://www.gnu.org/"
+ 'action (lambda (_button) (browse-url "https://www.gnu.org/"))
'follow-link t)
(insert "\n\n")))))
diff --git a/lisp/strokes.el b/lisp/strokes.el
index a70c3f58f49..33a2ea6b244 100644
--- a/lisp/strokes.el
+++ b/lisp/strokes.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/subr.el b/lisp/subr.el
index ef00286b341..7ec727ef19c 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Beware: while this file has tag `utf-8', before it's compiled, it gets
;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap.
@@ -78,8 +78,8 @@ If FORM does return, signal an error."
(defmacro 1value (form)
"Evaluate FORM, expecting a constant return value.
-This is the global do-nothing version. There is also `testcover-1value'
-that complains if FORM ever does return differing values."
+If FORM returns differing values when running under Testcover,
+Testcover will raise an error."
(declare (debug t))
form)
@@ -110,8 +110,7 @@ BODY should be a list of Lisp expressions.
\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
(declare (doc-string 2) (indent defun)
- (debug (&define lambda-list
- [&optional stringp]
+ (debug (&define lambda-list lambda-doc
[&optional ("interactive" interactive)]
def-body)))
;; Note that this definition should not use backquotes; subr.el should not
@@ -121,6 +120,7 @@ BODY should be a list of Lisp expressions.
(defmacro setq-local (var val)
"Set variable VAR to value VAL in current buffer."
;; Can't use backquote here, it's too early in the bootstrap.
+ (declare (debug (symbolp form)))
(list 'set (list 'make-local-variable (list 'quote var)) val))
(defmacro defvar-local (var val &optional docstring)
@@ -279,6 +279,17 @@ without silencing all errors."
;;;; Basic Lisp functions.
+(defvar gensym-counter 0
+ "Number used to construct the name of the next symbol created by `gensym'.")
+
+(defun gensym (&optional prefix)
+ "Return a new uninterned symbol.
+The name is made by appending `gensym-counter' to PREFIX.
+PREFIX is a string, and defaults to \"g\"."
+ (let ((num (prog1 gensym-counter
+ (setq gensym-counter (1+ gensym-counter)))))
+ (make-symbol (format "%s%d" (or prefix "g") num))))
+
(defun ignore (&rest _ignore)
"Do nothing and return nil.
This function accepts any number of arguments, but ignores them."
@@ -566,7 +577,7 @@ one is kept."
(setq tail (cdr tail))))))
list)
-;; See http://lists.gnu.org/archive/html/emacs-devel/2013-05/msg00204.html
+;; See https://lists.gnu.org/r/emacs-devel/2013-05/msg00204.html
(defun delete-consecutive-dups (list &optional circular)
"Destructively remove `equal' consecutive duplicates from LIST.
First and last elements are considered consecutive if CIRCULAR is
@@ -724,15 +735,18 @@ Elements of ALIST that are not conses are ignored."
(setq tail tail-cdr))))
alist)
-(defun alist-get (key alist &optional default remove)
- "Return the value associated with KEY in ALIST, using `assq'.
+(defun alist-get (key alist &optional default remove testfn)
+ "Return the value associated with KEY in ALIST.
If KEY is not found in ALIST, return DEFAULT.
+Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'.
This is a generalized variable suitable for use with `setf'.
When using it to set a value, optional argument REMOVE non-nil
means to remove KEY from ALIST if the new value is `eql' to DEFAULT."
(ignore remove) ;;Silence byte-compiler.
- (let ((x (assq key alist)))
+ (let ((x (if (not testfn)
+ (assq key alist)
+ (assoc key alist testfn))))
(if x (cdr x) default)))
(defun remove (elt seq)
@@ -770,8 +784,9 @@ This is the same format used for saving keyboard macros (see
"Beep to tell the user this binding is undefined."
(interactive)
(ding)
- (message "%s is undefined" (key-description (this-single-command-keys)))
- (setq defining-kbd-macro nil)
+ (if defining-kbd-macro
+ (error "%s is undefined" (key-description (this-single-command-keys)))
+ (message "%s is undefined" (key-description (this-single-command-keys))))
(force-mode-line-update)
;; If this is a down-mouse event, don't reset prefix-arg;
;; pass it to the command run by the up event.
@@ -1255,6 +1270,11 @@ See `event-start' for a description of the value returned."
"Return the multi-click count of EVENT, a click or drag event.
The return value is a positive integer."
(if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
+
+(defsubst event-line-count (event)
+ "Return the line count of EVENT, a mousewheel event.
+The return value is a positive integer."
+ (if (and (consp event) (integerp (nth 3 event))) (nth 3 event) 1))
;;;; Extracting fields of the positions in an event.
@@ -1459,10 +1479,6 @@ be a list of the form returned by `event-start' and `event-end'."
(make-obsolete-variable 'command-debug-status
"expect it to be removed in a future version." "25.2")
-;; Lisp manual only updated in 22.1.
-(define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
- "before 19.34")
-
(define-obsolete-variable-alias 'x-lost-selection-hooks
'x-lost-selection-functions "22.1")
(define-obsolete-variable-alias 'x-sent-selection-hooks
@@ -1474,6 +1490,8 @@ be a list of the form returned by `event-start' and `event-end'."
;; but Stefan insists to mark it so.
(make-obsolete-variable 'translation-table-for-input nil "23.1")
+(make-obsolete-variable 'x-gtk-use-window-move nil "26.1")
+
(defvaralias 'messages-buffer-max-lines 'message-log-max)
;;;; Alternate names for functions - these are not being phased out.
@@ -1785,7 +1803,8 @@ Return the new history list.
If MAXELT is non-nil, it specifies the maximum length of the history.
Otherwise, the maximum history length is the value of the `history-length'
property on symbol HISTORY-VAR, if set, or the value of the `history-length'
-variable.
+variable. The possible values of maximum length have the same meaning as
+the values of `history-length'.
Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil.
If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even
if it is empty or a duplicate."
@@ -1994,6 +2013,25 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label."
;; "Return the name of the file from which AUTOLOAD will be loaded.
;; \n\(fn AUTOLOAD)")
+(defun define-symbol-prop (symbol prop val)
+ "Define the property PROP of SYMBOL to be VAL.
+This is to `put' what `defalias' is to `fset'."
+ ;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)).
+ ;; (cl-pushnew symbol (alist-get prop
+ ;; (alist-get 'define-symbol-props
+ ;; current-load-list)))
+ (let ((sps (assq 'define-symbol-props current-load-list)))
+ (unless sps
+ (setq sps (list 'define-symbol-props))
+ (push sps current-load-list))
+ (let ((ps (assq prop sps)))
+ (unless ps
+ (setq ps (list prop))
+ (setcdr sps (cons ps (cdr sps))))
+ (unless (member symbol (cdr ps))
+ (setcdr ps (cons symbol (cdr ps))))))
+ (put symbol prop val))
+
(defun symbol-file (symbol &optional type)
"Return the name of the file that defined SYMBOL.
The value is normally an absolute file name. It can also be nil,
@@ -2003,47 +2041,30 @@ file name without extension.
If TYPE is nil, then any kind of definition is acceptable. If
TYPE is `defun', `defvar', or `defface', that specifies function
-definition, variable definition, or face definition only."
+definition, variable definition, or face definition only.
+Otherwise TYPE is assumed to be a symbol property."
(if (and (or (null type) (eq type 'defun))
(symbolp symbol)
(autoloadp (symbol-function symbol)))
(nth 1 (symbol-function symbol))
- (let ((files load-history)
- file match)
- (while files
- (if (if type
- (if (eq type 'defvar)
- ;; Variables are present just as their names.
- (member symbol (cdr (car files)))
- ;; Other types are represented as (TYPE . NAME).
- (member (cons type symbol) (cdr (car files))))
- ;; We accept all types, so look for variable def
- ;; and then for any other kind.
- (or (member symbol (cdr (car files)))
- (and (setq match (rassq symbol (cdr (car files))))
- (not (eq 'require (car match))))))
- (setq file (car (car files)) files nil))
- (setq files (cdr files)))
- file)))
-
-(defun method-files (method)
- "Return a list of files where METHOD is defined by `cl-defmethod'.
-The list will have entries of the form (FILE . (METHOD ...))
-where (METHOD ...) contains the qualifiers and specializers of
-the method and is a suitable argument for
-`find-function-search-for-symbol'. Filenames are absolute."
- (let ((files load-history)
- result)
- (while files
- (let ((defs (cdr (car files))))
- (while defs
- (let ((def (car defs)))
- (if (and (eq (car-safe def) 'cl-defmethod)
- (eq (cadr def) method))
- (push (cons (car (car files)) (cdr def)) result)))
- (setq defs (cdr defs))))
- (setq files (cdr files)))
- result))
+ (catch 'found
+ (pcase-dolist (`(,file . ,elems) load-history)
+ (when (if type
+ (if (eq type 'defvar)
+ ;; Variables are present just as their names.
+ (member symbol elems)
+ ;; Many other types are represented as (TYPE . NAME).
+ (or (member (cons type symbol) elems)
+ (memq symbol (alist-get type
+ (alist-get 'define-symbol-props
+ elems)))))
+ ;; We accept all types, so look for variable def
+ ;; and then for any other kind.
+ (or (member symbol elems)
+ (let ((match (rassq symbol elems)))
+ (and match
+ (not (eq 'require (car match)))))))
+ (throw 'found file))))))
(defun locate-library (library &optional nosuffix path interactive-call)
"Show the precise file name of Emacs library LIBRARY.
@@ -2405,7 +2426,7 @@ in milliseconds; this was useful when Emacs was built without
floating point support."
(declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
;; This used to be implemented in C until the following discussion:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2006-07/msg00401.html
+ ;; https://lists.gnu.org/r/emacs-devel/2006-07/msg00401.html
;; Then it was moved here using an implementation based on an idle timer,
;; which was then replaced by the use of read-event.
(if (numberp nodisp)
@@ -2420,7 +2441,7 @@ floating point support."
nil)
((or (<= seconds 0)
;; We are going to call read-event below, which will record
- ;; the the next key as part of the macro, even if that key
+ ;; the next key as part of the macro, even if that key
;; invokes kmacro-end-macro, so if we are recording a macro,
;; the macro will recursively call itself. In addition, when
;; that key is removed from unread-command-events, it will be
@@ -2444,7 +2465,7 @@ floating point support."
(read-event nil t seconds))))
(or (null read)
(progn
- ;; https://lists.gnu.org/archive/html/emacs-devel/2006-10/msg00394.html
+ ;; https://lists.gnu.org/r/emacs-devel/2006-10/msg00394.html
;; We want `read' appear in the next command's this-command-event
;; but not in the current one.
;; By pushing (cons t read), we indicate that `read' has not
@@ -3077,7 +3098,7 @@ Do nothing if FACE is nil."
(put-text-property start end 'face face)))
;; This removes `mouse-face' properties in *Help* buffer buttons:
-;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html
+;; https://lists.gnu.org/r/emacs-devel/2002-04/msg00648.html
(defun yank-handle-category-property (category start end)
"Apply property category CATEGORY's properties between START and END."
(when category
@@ -4192,7 +4213,7 @@ Used from `delayed-warnings-hook' (which see)."
(setq delayed-warnings-list (nreverse collapsed))))
;; At present this is only used for Emacs internals.
-;; Ref http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00085.html
+;; Ref https://lists.gnu.org/r/emacs-devel/2012-02/msg00085.html
(defvar delayed-warnings-hook '(collapse-delayed-warnings
display-delayed-warnings)
"Normal hook run to process and display delayed warnings.
@@ -4513,7 +4534,8 @@ EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
(defun backtrace ()
"Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'."
- (let ((print-level (or print-level 8)))
+ (let ((print-level (or print-level 8))
+ (print-escape-control-characters t))
(mapbacktrace #'backtrace--print-frame 'backtrace)))
(defun backtrace-frames (&optional base)
@@ -4794,10 +4816,9 @@ CURRENT-VALUE and MIN-CHANGE do not have any effect if MIN-VALUE
and/or MAX-VALUE are nil.
Optional MIN-TIME specifies the minimum interval time between
-echo area updates (default is 0.2 seconds.) If the function
-`float-time' is not present, time is not tracked at all. If the
-OS is not capable of measuring fractions of seconds, this
-parameter is effectively rounded up."
+echo area updates (default is 0.2 seconds.) If the OS is not
+capable of measuring fractions of seconds, this parameter is
+effectively rounded up."
(when (string-match "[[:alnum:]]\\'" message)
(setq message (concat message "...")))
(unless min-time
@@ -4805,8 +4826,7 @@ parameter is effectively rounded up."
(let ((reporter
;; Force a call to `message' now
(cons (or min-value 0)
- (vector (if (and (fboundp 'float-time)
- (>= min-time 0.02))
+ (vector (if (>= min-time 0.02)
(float-time) nil)
min-value
max-value
@@ -5203,7 +5223,7 @@ or \"gnus-article-toto-\".")
;; The following statement ought to be in print.c, but `provide' can't
;; be used there.
-;; http://lists.gnu.org/archive/html/emacs-devel/2009-08/msg00236.html
+;; https://lists.gnu.org/r/emacs-devel/2009-08/msg00236.html
(when (hash-table-p (car (read-from-string
(prin1-to-string (make-hash-table)))))
(provide 'hashtable-print-readable))
diff --git a/lisp/svg.el b/lisp/svg.el
index fc1a6d60e1a..ae7f1c57c02 100644
--- a/lisp/svg.el
+++ b/lisp/svg.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -157,7 +157,27 @@ otherwise. IMAGE-TYPE should be a MIME image type, like
(dom-node
'text
`(,@(svg--arguments svg args))
- text)))
+ (svg--encode-text text))))
+
+(defun svg--encode-text (text)
+ ;; Apparently the SVG renderer needs to have all non-ASCII
+ ;; characters encoded, and only certain special characters.
+ (with-temp-buffer
+ (insert text)
+ (dolist (substitution '(("&" . "&amp;")
+ ("<" . "&lt;")
+ (">" . "&gt;")))
+ (goto-char (point-min))
+ (while (search-forward (car substitution) nil t)
+ (replace-match (cdr substitution) t t nil)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((char (following-char)))
+ (if (< char 128)
+ (forward-char 1)
+ (delete-char 1)
+ (insert "&#" (format "%d" char) ";"))))
+ (buffer-string)))
(defun svg--append (svg node)
(let ((old (and (dom-attr node 'id)
@@ -264,10 +284,10 @@ If the SVG is later changed, the image will also be updated."
(defun svg-remove (svg id)
"Remove the element identified by ID from SVG."
- (when-let ((node (car (dom-by-id
- svg
- (concat "\\`" (regexp-quote id)
- "\\'")))))
+ (when-let* ((node (car (dom-by-id
+ svg
+ (concat "\\`" (regexp-quote id)
+ "\\'")))))
(dom-remove-node svg node)))
(provide 'svg)
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index 2ed2fcb466e..75e88045132 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/tabify.el b/lisp/tabify.el
index 75ff61d3272..93a0fc27d15 100644
--- a/lisp/tabify.el
+++ b/lisp/tabify.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/talk.el b/lisp/talk.el
index f35f9344f8d..a471a500617 100644
--- a/lisp/talk.el
+++ b/lisp/talk.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index f25b1a45ba1..21fccc4fcce 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -469,7 +469,7 @@ checksum before doing the check."
(concat " " (substring str 4 16) (format-time-string " %Y" time))))
(defun tar-grind-file-mode (mode)
- "Construct a `-rw--r--r--' string indicating MODE.
+ "Construct a `rw-r--r--' string indicating MODE.
MODE should be an integer which is a file mode value."
(string
(if (zerop (logand 256 mode)) ?- ?r)
@@ -1118,7 +1118,7 @@ for this to be permanent."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (if (looking-at "D")
+ (if (= (following-char) ?D)
(progn (tar-expunge-internal)
(setq n (1+ n)))
(forward-line 1)))
diff --git a/lisp/tempo.el b/lisp/tempo.el
index e4c50038fdc..3470d48e244 100644
--- a/lisp/tempo.el
+++ b/lisp/tempo.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term.el b/lisp/term.el
index 063a6ea592f..2046578368c 100644
--- a/lisp/term.el
+++ b/lisp/term.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; Marck 13 2001
;; Fixes for CJK support by Yong Lu <lyongu@yahoo.com>.
@@ -427,6 +427,8 @@ by moving term-home-marker. It is set to t if there is a
(defvar term-old-mode-line-format) ; Saves old mode-line-format while paging.
(defvar term-pager-old-local-map nil "Saves old keymap while paging.")
(defvar term-pager-old-filter) ; Saved process-filter while paging.
+(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."
@@ -487,6 +489,41 @@ This variable is buffer-local, and is a good thing to set in mode hooks."
:type 'boolean
:group 'term)
+(defcustom term-char-mode-buffer-read-only t
+ "If non-nil, only the process filter may modify the buffer in char mode.
+
+A non-nil value makes the buffer read-only in `term-char-mode',
+which prevents editing commands from making the buffer state
+inconsistent with the state of the terminal understood by the
+inferior process. Only the process filter is allowed to make
+changes to the buffer.
+
+Customize this option to nil if you want the previous behaviour."
+ :version "26.1"
+ :type 'boolean
+ :group 'term)
+
+(defcustom term-char-mode-point-at-process-mark t
+ "If non-nil, keep point at the process mark in char mode.
+
+A non-nil value causes point to be moved to the current process
+mark after each command in `term-char-mode' (provided that the
+pre-command point position was also at the process mark). This
+prevents commands that move point from making the buffer state
+inconsistent with the state of the terminal understood by the
+inferior process.
+
+Mouse events are not affected, so moving point and selecting text
+is still possible in char mode via the mouse, after which other
+commands can be invoked on the mouse-selected point or region,
+until the process filter (or user) moves point to the process
+mark once again.
+
+Customize this option to nil if you want the previous behaviour."
+ :version "26.1"
+ :type 'boolean
+ :group 'term)
+
(defcustom term-scroll-to-bottom-on-output nil
"Controls whether interpreter output causes window to scroll.
If nil, then do not scroll. If t or `all', scroll all windows showing buffer.
@@ -1007,7 +1044,7 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(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) (1- (window-height)))
+ (set (make-local-variable 'term-height) (window-text-height))
(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))
@@ -1105,6 +1142,8 @@ Entry to this mode runs the hooks on `term-mode-hook'."
(term-reset-size (cdr size) (car size)))
size))
+ (add-hook 'read-only-mode-hook #'term-line-mode-buffer-read-only-update nil t)
+
(easy-menu-add term-terminal-menu)
(easy-menu-add term-signals-menu)
(or term-input-ring
@@ -1246,6 +1285,13 @@ intervention from Emacs, except for the escape character (usually C-c)."
(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.
+ (when term-char-mode-buffer-read-only
+ (setq buffer-read-only t))
+ (add-hook 'pre-command-hook #'term-set-goto-process-mark nil t)
+ (add-hook 'post-command-hook #'term-goto-process-mark-maybe nil t)
+
;; Send existing partial line to inferior (without newline).
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
(save-input-sender term-input-sender))
@@ -1265,9 +1311,20 @@ This means that Emacs editing commands work as normally, until
you type \\[term-send-input] which sends the current line to the inferior."
(interactive)
(when (term-in-char-mode)
+ (when term-char-mode-buffer-read-only
+ (setq buffer-read-only term-line-mode-buffer-read-only))
+ (remove-hook 'pre-command-hook #'term-set-goto-process-mark t)
+ (remove-hook 'post-command-hook #'term-goto-process-mark-maybe t)
(use-local-map term-old-mode-map)
(term-update-mode-line)))
+(defun term-line-mode-buffer-read-only-update ()
+ "Update the user-set state of `buffer-read-only' in `term-line-mode'.
+
+Called as a buffer-local `read-only-mode-hook' function."
+ (when (term-in-line-mode)
+ (setq term-line-mode-buffer-read-only buffer-read-only)))
+
(defun term-update-mode-line ()
(let ((term-mode
(if (term-in-char-mode)
@@ -1354,8 +1411,7 @@ commands to use in that buffer.
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
- (getenv "SHELL")
- "/bin/sh"))))
+ shell-file-name))))
(set-buffer (make-term "terminal" program))
(term-mode)
(term-char-mode)
@@ -2712,6 +2768,7 @@ See `term-prompt-regexp'."
count-bytes ; number of bytes
decoded-substring
save-point save-marker old-point temp win
+ (inhibit-read-only t)
(buffer-undo-list t)
(selected (selected-window))
last-win
@@ -3110,6 +3167,46 @@ See `term-prompt-regexp'."
(when (get-buffer-window (current-buffer))
(redisplay))))
+(defvar-local term-goto-process-mark t
+ "Whether to reset point to the current process mark after this command.
+
+Set in `pre-command-hook' in char mode by `term-set-goto-process-mark'.")
+
+(defun term-set-goto-process-mark ()
+ "Sets `term-goto-process-mark'.
+
+Always set to nil if `term-char-mode-point-at-process-mark' is nil.
+
+Called as a buffer-local `pre-command-hook' function in
+`term-char-mode' so that when point is equal to the process mark
+at the pre-command stage, we know to restore point to the process
+mark at the post-command stage.
+
+See also `term-goto-process-mark-maybe'."
+ (setq term-goto-process-mark
+ (and term-char-mode-point-at-process-mark
+ (eq (point) (marker-position (term-process-mark))))))
+
+(defun term-goto-process-mark-maybe ()
+ "Move point to the term buffer's process mark upon keyboard input.
+
+Called as a buffer-local `post-command-hook' function in
+`term-char-mode' to prevent commands from putting the buffer into
+an inconsistent state by unexpectedly moving point.
+
+Mouse events are ignored so that mouse selection is unimpeded.
+
+Only acts when the pre-command position of point was equal to the
+process mark, and the `term-char-mode-point-at-process-mark'
+option is enabled. See `term-set-goto-process-mark'."
+ (when term-goto-process-mark
+ (unless (mouse-event-p last-command-event)
+ (goto-char (term-process-mark)))))
+
+(defun term-process-mark ()
+ "The current `process-mark' for the term buffer process."
+ (process-mark (get-buffer-process (current-buffer))))
+
(defun term-handle-deferred-scroll ()
(let ((count (- (term-current-row) term-height)))
(when (>= count 0)
@@ -4149,8 +4246,7 @@ the process. Any more args are arguments to PROGRAM."
(interactive (list (read-from-minibuffer "Run program: "
(or explicit-shell-file-name
(getenv "ESHELL")
- (getenv "SHELL")
- "/bin/sh"))))
+ shell-file-name))))
;; Pick the name of the new buffer.
(setq term-ansi-buffer-name
diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el
index ac027747b77..62a6c58cafe 100644
--- a/lisp/term/AT386.el
+++ b/lisp/term/AT386.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/README b/lisp/term/README
index 9cb844b7619..25b9e5db0cd 100644
--- a/lisp/term/README
+++ b/lisp/term/README
@@ -262,4 +262,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el
index cce84588a5a..2cf1e84768e 100644
--- a/lisp/term/common-win.el
+++ b/lisp/term/common-win.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
index 00a908a4598..f16189e0587 100644
--- a/lisp/term/internal.el
+++ b/lisp/term/internal.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el
index d3ddb19c0fb..24a5642b0f2 100644
--- a/lisp/term/iris-ansi.el
+++ b/lisp/term/iris-ansi.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el
new file mode 100644
index 00000000000..45c701f33bc
--- /dev/null
+++ b/lisp/term/konsole.el
@@ -0,0 +1,12 @@
+;;; konsole.el --- terminal initialization for konsole
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+(require 'term/xterm)
+
+(defun terminal-init-konsole ()
+ "Terminal initialization function for konsole."
+ (tty-run-terminal-initialization (selected-frame) "xterm"))
+
+(provide 'term/konsole)
+
+;; konsole.el ends here
diff --git a/lisp/term/news.el b/lisp/term/news.el
index 241db338494..1c23f1cfce1 100644
--- a/lisp/term/news.el
+++ b/lisp/term/news.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 4df5f0abe21..e895d09bb4f 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -124,6 +124,8 @@ The properties returned may include `top', `left', `height', and `width'."
(define-key global-map [?\s-g] 'isearch-repeat-forward)
(define-key global-map [?\s-h] 'ns-do-hide-emacs)
(define-key global-map [?\s-H] 'ns-do-hide-others)
+(define-key global-map [?\M-\s-h] 'ns-do-hide-others)
+(define-key key-translation-map [?\M-\s-\u02D9] [?\M-\s-h])
(define-key global-map [?\s-j] 'exchange-point-and-mark)
(define-key global-map [?\s-k] 'kill-current-buffer)
(define-key global-map [?\s-l] 'goto-line)
@@ -592,7 +594,7 @@ the last file dropped is selected."
(declare-function tool-bar-mode "tool-bar" (&optional arg))
;; Based on a function by David Reitter <dreitter@inf.ed.ac.uk> ;
-;; see http://lists.gnu.org/archive/html/emacs-devel/2005-09/msg00681.html .
+;; see https://lists.gnu.org/r/emacs-devel/2005-09/msg00681.html .
(defun ns-toggle-toolbar (&optional frame)
"Switches the tool bar on and off in frame FRAME.
If FRAME is nil, the change applies to the selected frame."
@@ -734,6 +736,27 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(global-unset-key [horizontal-scroll-bar drag-mouse-1])
+;;;; macOS-like defaults for trackpad and mouse wheel scrolling on
+;;;; macOS 10.7+.
+
+;; FIXME: This doesn't look right. Is there a better way to do this
+;; that keeps customize happy?
+(when (featurep 'cocoa)
+ (let ((appkit-version
+ (progn (string-match "^appkit-\\([^\s-]*\\)" ns-version-string)
+ (string-to-number (match-string 1 ns-version-string)))))
+ ;; Appkit 1138 ~= macOS 10.7.
+ (when (>= appkit-version 1138)
+ (setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control))))
+ (put 'mouse-wheel-scroll-amount 'customized-value
+ (list (custom-quote (symbol-value 'mouse-wheel-scroll-amount))))
+
+ (setq mouse-wheel-progressive-speed nil)
+ (put 'mouse-wheel-progressive-speed 'customized-value
+ (list (custom-quote
+ (symbol-value 'mouse-wheel-progressive-speed)))))))
+
+
;;;; Color support.
;; Functions for color panel + drag
@@ -774,7 +797,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
(defun ns-suspend-error ()
;; Don't allow suspending if any of the frames are NS frames.
(if (memq 'ns (mapcar 'window-system (frame-list)))
- (error "Cannot suspend Emacs while running under NS")))
+ (error "Cannot suspend Emacs while an NS GUI frame exists")))
;; Set some options to be as Nextstep-like as possible.
@@ -855,7 +878,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;; Mac OS X Lion introduces PressAndHold, which is unsupported by this port.
;; See this thread for more details:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2011-06/msg00505.html
+ ;; https://lists.gnu.org/r/emacs-devel/2011-06/msg00505.html
(ns-set-resource nil "ApplePressAndHoldEnabled" "NO")
(x-apply-session-resources)
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
index b6f2acc2978..0355350da72 100644
--- a/lisp/term/pc-win.el
+++ b/lisp/term/pc-win.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el
index d80bb78804c..d88b12b799f 100644
--- a/lisp/term/rxvt.el
+++ b/lisp/term/rxvt.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
index 88e63d2c9ea..64c67ae8122 100644
--- a/lisp/term/sun.el
+++ b/lisp/term/sun.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el
index 9cfe30a4630..3b86aa7c9b9 100644
--- a/lisp/term/tty-colors.el
+++ b/lisp/term/tty-colors.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
index 862cd7978cb..1ce82200b38 100644
--- a/lisp/term/tvi970.el
+++ b/lisp/term/tvi970.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -36,7 +36,7 @@
;; ("\eOR" [kp-f3])
;; ("\eOS" [kp-f4])
- ;; These might bre set by terminfo.
+ ;; These might be set by terminfo.
("\e[H" [home])
("\e[Z" [backtab])
("\e[i" [print])
@@ -45,13 +45,13 @@
("\e[M" [deleteline])
("\e[U" [next]) ;; actually the `page' key
- ;; These won't be set up by either
+ ;; These won't be set up by either.
("\eOm" [kp-subtract])
("\eOl" [kp-separator])
("\eOn" [kp-decimal])
("\eOM" [kp-enter])
- ;; These won't be set up by either either
+ ;; These won't be set up by either.
("\e[K" [key_eol]) ;; Not an X keysym
("\e[J" [key_eos]) ;; Not an X keysym
("\e[2J" [key_clear]) ;; Not an X keysym
@@ -73,7 +73,7 @@
("\e5" [S-send]) ;; Not an X keysym
))
(define-key map (car key-binding) (nth 1 key-binding)))
-
+
;; The numeric keypad keys.
(dotimes (i 10)
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index bc171381cc2..44bee803aa0 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index fda93884c40..4e0e54ae179 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -275,7 +275,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
'(gnutls "libgnutls-30.dll")
'(gnutls "libgnutls-28.dll" "libgnutls-26.dll"))
'(libxml2 "libxml2-2.dll" "libxml2.dll")
- '(zlib "zlib1.dll" "libz-1.dll")))
+ '(zlib "zlib1.dll" "libz-1.dll")
+ '(lcms2 "liblcms2-2.dll")))
;;; multi-tty support
(defvar w32-initialized nil
@@ -396,7 +397,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
;;; Fix interface to (X-specific) mouse.el
(defun w32--set-selection (type value)
(if (eq type 'CLIPBOARD)
- (w32-set-clipboard-data value)
+ (w32-set-clipboard-data (replace-regexp-in-string "\0" "\\0" value t t))
(put 'x-selections (or type 'PRIMARY) value)))
(defun w32--get-selection (&optional type data-type)
diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el
index f8b8b3c1b43..b6e04669c38 100644
--- a/lisp/term/w32console.el
+++ b/lisp/term/w32console.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
index a6b2e7cc437..f6abc79c5e5 100644
--- a/lisp/term/wyse50.el
+++ b/lisp/term/wyse50.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 532d0395cf4..e7b1e08b038 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1182,7 +1182,7 @@ as returned by `x-server-vendor'."
This returns an error if any Emacs frames are X frames."
;; Don't allow suspending if any of the frames are X frames.
(if (memq 'x (mapcar #'window-system (frame-list)))
- (error "Cannot suspend Emacs while running under X")))
+ (error "Cannot suspend Emacs while an X GUI frame exists")))
(defvar x-initialized nil
"Non-nil if the X window system has been initialized.")
@@ -1287,7 +1287,7 @@ This returns an error if any Emacs frames are X frames."
;; During initialization, we defer sending size hints to the window
;; manager, because that can induce a race condition:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00033.html
+ ;; https://lists.gnu.org/r/emacs-devel/2008-10/msg00033.html
;; Send the size hints once initialization is done.
(add-hook 'after-init-hook 'x-wm-set-size-hint)
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
index e6d224dd3de..b7d0cfb4792 100644
--- a/lisp/term/xterm.el
+++ b/lisp/term/xterm.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -68,6 +68,11 @@ string bytes that can be copied is 3/4 of this value."
:version "25.1"
:type 'integer)
+(defcustom xterm-set-window-title nil
+ "Whether Emacs should set window titles to an Emacs frame in an XTerm."
+ :version "27.1"
+ :type 'boolean)
+
(defconst xterm-paste-ending-sequence "\e[201~"
"Characters send by the terminal to end a bracketed paste.")
@@ -610,7 +615,7 @@ Return the pasted text as a string."
;; Set up colors, for those versions of xterm that support it.
(defvar xterm-standard-colors
;; The names in the comments taken from XTerm-col.ad in the xterm
- ;; distribution, see ftp://dickey.his.com/xterm/. RGB values are
+ ;; distribution, see https://invisible-island.net/xterm/. RGB values are
;; from rgb.txt.
'(("black" 0 ( 0 0 0)) ; black
("red" 1 (205 0 0)) ; red3
@@ -802,6 +807,8 @@ We run the first FUNCTION whose STRING matches the input events."
(when (memq 'setSelection xterm-extra-capabilities)
(xterm--init-activate-set-selection)))
+ (when xterm-set-window-title
+ (xterm--init-frame-title))
;; Unconditionally enable bracketed paste mode: terminals that don't
;; support it just ignore the sequence.
(xterm--init-bracketed-paste-mode)
@@ -828,6 +835,34 @@ We run the first FUNCTION whose STRING matches the input events."
"Terminal initialization for `gui-set-selection'."
(set-terminal-parameter nil 'xterm--set-selection t))
+(defun xterm--init-frame-title ()
+ "Terminal initialization for XTerm frame titles."
+ (xterm-set-window-title)
+ (add-hook 'after-make-frame-functions 'xterm-set-window-title-flag)
+ (add-hook 'window-configuration-change-hook 'xterm-unset-window-title-flag)
+ (add-hook 'post-command-hook 'xterm-set-window-title)
+ (add-hook 'minibuffer-exit-hook 'xterm-set-window-title))
+
+(defvar xterm-window-title-flag nil
+ "Whether a new frame has been created, calling for a title update.")
+
+(defun xterm-set-window-title-flag (_frame)
+ "Set `xterm-window-title-flag'.
+See `xterm--init-frame-title'"
+ (setq xterm-window-title-flag t))
+
+(defun xterm-unset-window-title-flag ()
+ (when xterm-window-title-flag
+ (setq xterm-window-title-flag nil)
+ (xterm-set-window-title)))
+
+(defun xterm-set-window-title (&optional terminal)
+ "Set the window title of the Xterm TERMINAL.
+The title is constructed from `frame-title-format'."
+ (send-string-to-terminal
+ (format "\e]2;%s\a" (format-mode-line frame-title-format))
+ terminal))
+
(defun xterm--selection-char (type)
(pcase type
('PRIMARY "p")
diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el
index 596570ca4e2..10e788145a6 100644
--- a/lisp/textmodes/artist.el
+++ b/lisp/textmodes/artist.el
@@ -27,7 +27,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -4889,7 +4889,7 @@ If optional argument STATE is positive, turn borders on."
(select-window (posn-window (event-start last-input-event)))
(list last-input-event
(if (display-popup-menus-p)
- (x-popup-menu last-nonmenu-event artist-popup-menu-table)
+ (x-popup-menu t artist-popup-menu-table)
'no-popup-menus))))
(if (eq op 'no-popup-menus)
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
index 2f3c17b3b29..d6bb636a9b7 100644
--- a/lisp/textmodes/bib-mode.el
+++ b/lisp/textmodes/bib-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el
index 393bbd1c3af..bd36b9738d0 100644
--- a/lisp/textmodes/bibtex-style.el
+++ b/lisp/textmodes/bibtex-style.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 2128e50797d..b6b12e6a9c9 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -25,7 +25,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el
index 054d8dbb8b2..33dc3722aa6 100644
--- a/lisp/textmodes/conf-mode.el
+++ b/lisp/textmodes/conf-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -175,6 +175,16 @@ not align (only setting space according to `conf-assignment-space')."
table)
"Syntax table in use in Xdefaults style `conf-mode' buffers.")
+(defvar conf-toml-mode-syntax-table
+ (let ((table (make-syntax-table conf-mode-syntax-table)))
+ (modify-syntax-entry ?\" "\"" table)
+ (modify-syntax-entry ?' "\"" table)
+ (modify-syntax-entry ?\\ "\\" table)
+ (modify-syntax-entry ?# "<" table)
+ ;; override
+ (modify-syntax-entry ?\; "." table)
+ table)
+ "Syntax table in use in TOML style `conf-mode' buffers.")
(defvar conf-font-lock-keywords
'(;; [section] (do this first because it may look like a parameter)
@@ -242,6 +252,22 @@ This variable is best set in the file local variables, or through
("^[ \t]*\\([^:\n]+\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face prepend))
"Keywords to highlight in Conf Colon mode.")
+(defvar conf-toml-font-lock-keywords
+ '(;; [section] (do this first because it may look like a parameter)
+ (conf-toml-recognize-section 0 'font-lock-type-face prepend)
+ ;; var=val or var[index]=val
+ ("^\\s-*\\(.+?\\)\\(?:\\[\\(.*?\\)\\]\\)?\\s-*="
+ (1 'font-lock-variable-name-face)
+ (2 'font-lock-constant-face nil t))
+ ("\\_<false\\|true\\_>" 0 'font-lock-keyword-face))
+ "Keywords to highlight in Conf TOML mode.")
+
+(defvar conf-desktop-font-lock-keywords
+ `(,@conf-font-lock-keywords
+ ("\\_<false\\|true\\_>" 0 'font-lock-constant-face)
+ ("\\_<%[uUfFick%]\\_>" 0 'font-lock-constant-face))
+ "Keywords to highlight in Conf Desktop mode.")
+
(defvar conf-assignment-sign ?=
"Sign used for assignments (char or string).")
@@ -429,16 +455,7 @@ The optional arg FONT-LOCK is the value for FONT-LOCK-KEYWORDS."
;;;###autoload
(define-derived-mode conf-unix-mode conf-mode "Conf[Unix]"
"Conf Mode starter for Unix style Conf files.
-Comments start with `#'.
-For details see `conf-mode'. Example:
-
-# Conf mode font-locks this right on Unix and with \\[conf-unix-mode]
-
-[Desktop Entry]
- Encoding=UTF-8
- Name=The GIMP
- Name[ca]=El GIMP
- Name[cs]=GIMP"
+Comments start with `#'. For details see `conf-mode'."
(conf-mode-initialize "#"))
;;;###autoload
@@ -617,6 +634,61 @@ For details see `conf-mode'. Example:
*foreground: black"
(conf-mode-initialize "!"))
+(defun conf-toml-recognize-section (limit)
+ "Font-lock helper function for conf-toml-mode.
+Handles recognizing TOML section names, like [section],
+\[[section]], or [something.\"else\".section]."
+ (save-excursion
+ ;; Skip any number of "[" to handle things like [[section]].
+ (when (re-search-forward "^\\s-*\\[+" limit t)
+ (let ((start (point)))
+ (backward-char)
+ (let ((end (min limit
+ (condition-case nil
+ (progn
+ (forward-list)
+ (1- (point)))
+ (scan-error
+ (end-of-line)
+ (point))))))
+ ;; If there is a comma in the text, then we assume this is
+ ;; an array and not a section. (This could be refined to
+ ;; look only for unquoted commas if necessary.)
+ (save-excursion
+ (goto-char start)
+ (unless (search-forward "," end t)
+ (set-match-data (list start end))
+ t)))))))
+
+;;;###autoload
+(define-derived-mode conf-toml-mode conf-mode "Conf[TOML]"
+ "Conf Mode starter for TOML files.
+Comments start with `#' and \"assignments\" are with `='.
+For details see `conf-mode'. Example:
+
+# Conf mode font-locks this right with \\[conf-toml-mode]
+
+\[entry]
+value = \"some string\""
+ (conf-mode-initialize "#" 'conf-toml-font-lock-keywords)
+ (setq-local conf-assignment-column 0)
+ (setq-local conf-assignment-sign ?=))
+
+;;;###autoload
+(define-derived-mode conf-desktop-mode conf-unix-mode "Conf[Desktop]"
+ "Conf Mode started for freedesktop.org Desktop files.
+Comments start with `#' and \"assignments\" are with `='.
+For details see `conf-mode'.
+
+# Conf mode font-locks this correctly with \\[conf-desktop-mode]
+ [Desktop Entry]
+ Name=GNU Image Manipulation Program
+ Name[oc]=Editor d'imatge GIMP
+ Exec=gimp-2.8 %U
+ Terminal=false"
+ (conf-mode-initialize "#" 'conf-desktop-font-lock-keywords)
+ (conf-quote-normal nil))
+
(provide 'conf-mode)
;;; conf-mode.el ends here
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 4952533e834..93ca36b08aa 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -764,7 +764,6 @@ cannot be completed sensibly: `custom-ident',
"Self inserting keys which should trigger re-indentation."
:version "22.2"
:type '(repeat character)
- :options '((?\} ?\;))
:group 'css)
(defvar css-mode-syntax-table
@@ -836,7 +835,7 @@ cannot be completed sensibly: `custom-ident',
(defface css-selector '((t :inherit font-lock-function-name-face))
"Face to use for selectors."
:group 'css)
-(defface css-property '((t :inherit font-lock-variable-name-face))
+(defface css-property '((t :inherit font-lock-keyword-face))
"Face to use for properties."
:group 'css)
(defface css-proprietary-property '((t :inherit (css-property italic)))
@@ -897,7 +896,7 @@ cannot be completed sensibly: `custom-ident',
;; No face.
nil)))
;; Variables.
- (,(concat "--" css-ident-re) (0 font-lock-variable-name-face))
+ (,(concat (rx symbol-start) "--" css-ident-re) (0 font-lock-variable-name-face))
;; Properties. Again, we don't limit ourselves to css-property-ids.
(,(concat "\\(?:[{;]\\|^\\)[ \t]*\\("
"\\(?:\\(" css-proprietary-nmstart-re "\\)\\|"
@@ -1046,7 +1045,7 @@ This function simply drops any transparency."
"Check whether STR, seen at point, is CSS named color.
Returns STR if it is a valid color. Special care is taken
to exclude some SCSS constructs."
- (when-let ((color (assoc str css--color-map)))
+ (when-let* ((color (assoc str css--color-map)))
(save-excursion
(goto-char start-point)
(forward-comment (- (point)))
@@ -1150,12 +1149,12 @@ This function is intended to be good enough to help SMIE during
tokenization, but should not be regarded as a reliable function
for determining whether point is within a selector."
(save-excursion
- (re-search-forward "[{};)]" nil t)
+ (re-search-forward "[{};]" nil t)
(eq (char-before) ?\{)))
(defun css--colon-inside-funcall ()
"Return t if point is inside a function call."
- (when-let (opening-paren-pos (nth 1 (syntax-ppss)))
+ (when-let* ((opening-paren-pos (nth 1 (syntax-ppss))))
(save-excursion
(goto-char opening-paren-pos)
(eq (char-after) ?\())))
@@ -1206,9 +1205,12 @@ for determining whether point is within a selector."
(`(:before . "{")
(when (or (smie-rule-hanging-p) (smie-rule-bolp))
(smie-backward-sexp ";")
- (smie-indent-virtual)))
- (`(:before . ,(or "{" "("))
- (if (smie-rule-hanging-p) (smie-rule-parent 0)))
+ (unless (eq (char-after) ?\{)
+ (smie-indent-virtual))))
+ (`(:before . "(")
+ (cond
+ ((smie-rule-hanging-p) (smie-rule-parent 0))
+ ((not (smie-rule-bolp)) 0)))
(`(:after . ":-property")
(when (smie-rule-hanging-p)
css-indent-offset))))
@@ -1373,6 +1375,7 @@ tags, classes and IDs."
:exit-function
,(lambda (string status)
(and (eq status 'finished)
+ (eolp)
prop-table
(test-completion string prop-table)
(not (and sel-table
@@ -1576,7 +1579,7 @@ to look up will be substituted there."
(goto-char (point-min))
(let ((window (get-buffer-window (current-buffer) 'visible)))
(when window
- (when (re-search-forward "^Summary" nil 'move)
+ (when (re-search-forward "^\\(Summary\\|Syntax\\)" nil 'move)
(beginning-of-line)
(set-window-start window (point))))))
@@ -1657,14 +1660,13 @@ on what is seen near point."
(setq symbol (concat ":" symbol)))
(let ((url (format css-lookup-url-format symbol))
(buffer (get-buffer-create "*MDN CSS*")))
- (save-selected-window
- ;; Make sure to display the buffer before calling `eww', as
- ;; that calls `pop-to-buffer-same-window'.
- (switch-to-buffer-other-window buffer)
- (with-current-buffer buffer
- (eww-mode)
- (add-hook 'eww-after-render-hook #'css--mdn-after-render nil t)
- (eww url))))))
+ ;; Make sure to display the buffer before calling `eww', as that
+ ;; calls `pop-to-buffer-same-window'.
+ (switch-to-buffer-other-window buffer)
+ (with-current-buffer buffer
+ (eww-mode)
+ (add-hook 'eww-after-render-hook #'css--mdn-after-render nil t)
+ (eww url)))))
(provide 'css-mode)
;;; css-mode.el ends here
diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el
index 72eb66b571e..6b668a62674 100644
--- a/lisp/textmodes/dns-mode.el
+++ b/lisp/textmodes/dns-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -35,6 +35,7 @@
;; RFC 5155, "DNS Security (DNSSEC) Hashed Authenticated Denial of Existence"
;; RFC 6698, "The DNS-Based Authentication of Named Entities (DANE)
;; Transport Layer Security (TLS) Protocol: TLSA"
+;; RFC 6844, "DNS Certification Authority Authorization (CAA) Resource Record"
;;; Release history:
@@ -62,7 +63,7 @@
"A6" "DNAME" "SINK" "OPT" "APL" "DS" "SSHFP"
"RRSIG" "NSEC" "DNSKEY" "UINFO" "UID" "GID"
"UNSPEC" "TKEY" "TSIG" "IXFR" "AXFR" "MAILB"
- "MAILA" "TLSA" "NSEC3")
+ "MAILA" "TLSA" "NSEC3" "CAA")
"List of strings with known DNS types.")
(defface dns-mode-control-entity '((t :inherit font-lock-keyword-face))
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 7ace2a50486..be5cd6b7310 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -147,6 +147,22 @@ them and their old values to `enriched-old-bindings'."
:type 'hook
:group 'enriched)
+(defcustom enriched-allow-eval-in-display-props nil
+ "If non-nil allow to evaluate arbitrary forms in display properties.
+
+Enriched mode recognizes display properties of text stored using
+an extension command to the text/enriched format, \"x-display\".
+These properties must not, by default, include evaluation of
+Lisp forms, otherwise they are not applied. Customize this option
+to t to turn off this safety feature, and allow Enriched mode to
+apply display properties which evaluate arbitrary Lisp forms.
+Note, however, that applying unsafe display properties could
+execute malicious Lisp code, if that code came from an external source."
+ :risky t
+ :type 'boolean
+ :version "26.1"
+ :group 'enriched)
+
(defvar enriched-old-bindings nil
"Store old variable values that we change when entering mode.
The value is a list of \(VAR VALUE VAR VALUE...).")
@@ -503,6 +519,8 @@ the range of text to assign text property SYMBOL with value VALUE."
(error nil)))))
(unless prop
(message "Warning: invalid <x-display> parameter %s" param))
- (list start end 'display prop)))
+ (if enriched-allow-eval-in-display-props
+ (list start end 'display prop)
+ (list start end 'display (list 'disable-eval prop)))))
;;; enriched.el ends here
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
index b640adb7a7b..30e10d70aa8 100644
--- a/lisp/textmodes/fill.el
+++ b/lisp/textmodes/fill.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index ecf729d15b7..dc6da4aab29 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -231,7 +231,7 @@ Ispell's ultimate default dictionary."
"Non-nil means check even inside TeX math environment.
TeX math environments are discovered by `texmathp', implemented
inside AUCTeX package. That package may be found at
-URL `http://www.gnu.org/software/auctex/'"
+URL `https://www.gnu.org/software/auctex/'"
:group 'flyspell
:type 'boolean)
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 773023a34a6..6a169622f52 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1,10 +1,8 @@
-;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*-
+;;; ispell.el --- interface to spell checkers -*- lexical-binding:t -*-
;; Copyright (C) 1994-1995, 1997-2017 Free Software Foundation, Inc.
;; Author: Ken Stevens <k.stevens@ieee.org>
-;; Status : Release with 3.1.12+ and 3.2.0+ ispell.
-;; Keywords: unix wp
;; This file is part of GNU Emacs.
@@ -19,25 +17,13 @@
;; 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 <http://www.gnu.org/licenses/>.
-
-;; Note: version numbers and time stamp are not updated
-;; when this file is edited for release with GNU Emacs.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; INSTRUCTIONS
-;; This code contains a section of user-settable variables that you
-;; should inspect prior to installation. Look past the end of the history
-;; list. Set them up for your locale and the preferences of the majority
-;; of the users. Otherwise the users may need to set a number of variables
-;; themselves.
-;; You particularly may want to change the default dictionary for your
-;; country and language.
-;; Most dictionary changes should be made in this file so all users can
-;; enjoy them. Local or modified dictionaries are supported in your .emacs
-;; file. Use the variable `ispell-local-dictionary-alist' to specify
+;; Use the variable `ispell-local-dictionary-alist' to specify
;; your own dictionaries.
;; Depending on the mail system you use, you may want to include these:
@@ -112,7 +98,7 @@
;; Need a way to select between different character mappings without separate
;; dictionary entries.
;; Multi-byte characters if not defined by current dictionary may result in the
-;; evil "misalignment error" in some versions of MULE Emacs.
+;; evil "misalignment error" in some versions of Emacs.
;; On some versions of Emacs, growing the minibuffer fails.
;; see `ispell-help-in-bufferp'.
;; Recursive edits (?C-r or ?R) inside a keyboard text replacement check (?r)
@@ -121,6 +107,7 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
(defvar mail-yank-prefix)
@@ -208,6 +195,10 @@ Must be greater than 1."
:type 'integer
:group 'ispell)
+;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread.
+;; Before that, adding it is useless, as if it is found, it will just
+;; cause an error; and one of the other spelling engines below is
+;; almost certainly installed in any case, for enchant to use.
(defcustom ispell-program-name
(or (executable-find "aspell")
(executable-find "ispell")
@@ -605,6 +596,8 @@ english.aff). Aspell and Hunspell don't have this limitation.")
"Non-nil if we can use Aspell extensions.")
(defvar ispell-really-hunspell nil
"Non-nil if we can use Hunspell extensions.")
+(defvar ispell-really-enchant nil
+ "Non-nil if we can use Enchant extensions.")
(defvar ispell-encoding8-command nil
"Command line option prefix to select encoding if supported, nil otherwise.
If setting the encoding is supported by spellchecker and is selectable from
@@ -739,17 +732,26 @@ Otherwise returns the library directory name, if that is defined."
(and (search-forward-regexp
"(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)"
nil t)
+ (match-string 1)))
+ (setq ispell-really-enchant
+ (and (search-forward-regexp
+ "(but really Enchant \\([0-9]+\\.[0-9\\.-]+\\)?)"
+ nil t)
(match-string 1)))))
(let* ((aspell8-minver "0.60")
(ispell-minver "3.1.12")
(hunspell8-minver "1.1.6")
+ (enchant-minver "2.1.0")
(minver (cond
((not (version<= ispell-minver ispell-program-version))
ispell-minver)
((and ispell-really-aspell
(not (version<= aspell8-minver ispell-really-aspell)))
- aspell8-minver))))
+ aspell8-minver)
+ ((and ispell-really-enchant
+ (not (version<= enchant-minver ispell-really-enchant)))
+ enchant-minver))))
(if minver
(error "%s release %s or greater is required"
@@ -1183,6 +1185,49 @@ dictionary from that list was found."
(list dict))
ispell-hunspell-dictionary-alist :test #'equal))))
+;; Make ispell.el work better with enchant.
+
+(defvar ispell-enchant-dictionary-alist nil
+ "An alist of parsed Enchant dicts and associated parameters.
+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
+ (apply 'ispell-call-process
+ (concat ispell-program-name "-lsmod") nil t nil args))))
+
+(defun ispell--get-extra-word-characters (&optional lang)
+ "Get the extra word characters for LANG as a character class.
+If LANG is omitted, get the extra word characters for the default language."
+ (concat "[" (string-trim-right (apply 'ispell--call-enchant-lsmod
+ (append '("-word-chars") (if lang `(,lang))))) "]"))
+
+(defun ispell-find-enchant-dictionaries ()
+ "Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'."
+ (let* ((dictionaries
+ (split-string
+ (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) " ([^)]+)\n"))
+ (found
+ (mapcar #'(lambda (lang)
+ `(,lang "[[:alpha:]]" "[^[:alpha:]]"
+ ,(ispell--get-extra-word-characters) t nil nil utf-8))
+ dictionaries)))
+ ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist
+ ;; which have no element in FOUND at all.
+ (dolist (dict ispell-dictionary-base-alist)
+ (unless (assoc (car dict) found)
+ (setq found (nconc found (list dict)))))
+ (setq ispell-enchant-dictionary-alist found)
+ ;; Add a default entry
+ (let ((default-dict
+ `(nil "[[:alpha:]]" "[^[:alpha:]]"
+ ,(ispell--get-extra-word-characters)
+ t nil nil utf-8)))
+ (push default-dict ispell-enchant-dictionary-alist))))
+
;; Set params according to the selected spellchecker
(defvar ispell-last-program-name nil
@@ -1208,7 +1253,7 @@ aspell is used along with Emacs).")
(setq ispell-library-directory (ispell-check-version))
t)
(error nil))
- ispell-encoding8-command)
+ (or ispell-encoding8-command ispell-really-enchant))
;; auto-detection will only be used if spellchecker is not
;; ispell and supports a way to set communication to UTF-8.
(if ispell-really-aspell
@@ -1216,11 +1261,14 @@ aspell is used along with Emacs).")
(ispell-find-aspell-dictionaries))
(if ispell-really-hunspell
(or ispell-hunspell-dictionary-alist
- (ispell-find-hunspell-dictionaries)))))
+ (ispell-find-hunspell-dictionaries))
+ (if ispell-really-enchant
+ (or ispell-enchant-dictionary-alist
+ (ispell-find-enchant-dictionaries))))))
;; Substitute ispell-dictionary-alist with the list of
;; dictionaries corresponding to the given spellchecker.
- ;; If a recent aspell or hunspell, use the list of really
+ ;; With programs that support it, use the list of really
;; installed dictionaries and add to it elements of the original
;; list that are not present there. Allow distro info.
(let ((found-dicts-alist
@@ -1229,17 +1277,19 @@ aspell is used along with Emacs).")
ispell-aspell-dictionary-alist
(if ispell-really-hunspell
ispell-hunspell-dictionary-alist))
- nil))
+ (if ispell-really-enchant
+ ispell-enchant-dictionary-alist
+ nil)))
(ispell-dictionary-base-alist ispell-dictionary-base-alist)
ispell-base-dicts-override-alist ; Override only base-dicts-alist
all-dicts-alist)
;; While ispell and aspell (through aliases) use the traditional
- ;; dict naming originally expected by ispell.el, hunspell
- ;; uses locale based names with no alias. We need to map
+ ;; dict naming originally expected by ispell.el, hunspell & Enchant
+ ;; use locale-based names with no alias. We need to map
;; standard names to locale based names to make default dict
- ;; definitions available for hunspell.
- (if ispell-really-hunspell
+ ;; definitions available to these programs.
+ (if (or ispell-really-hunspell ispell-really-enchant)
(let (tmp-dicts-alist)
(dolist (adict ispell-dictionary-base-alist)
(let* ((dict-name (nth 0 adict))
@@ -1264,7 +1314,7 @@ aspell is used along with Emacs).")
(setq ispell-args
(nconc ispell-args (list "-d" dict-equiv)))
(message
- "ispell-set-spellchecker-params: Missing Hunspell equiv for \"%s\". Skipping."
+ "ispell-set-spellchecker-params: Missing equivalent for \"%s\". Skipping."
dict-name)
(setq skip-dict t)))
@@ -1306,7 +1356,7 @@ aspell is used along with Emacs).")
(nth 4 adict) ; many-otherchars-p
(nth 5 adict) ; ispell-args
(nth 6 adict) ; extended-character-mode
- (if ispell-encoding8-command
+ (if (or ispell-encoding8-command ispell-really-enchant)
'utf-8
(nth 7 adict)))
adict)
@@ -1435,25 +1485,17 @@ used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.")
"The name of the current personal dictionary, or nil for the default.
This is passed to the Ispell process using the `-p' switch.")
-(defun ispell-decode-string (str)
- "Decodes multibyte character strings."
- (decode-coding-string str (ispell-get-coding-system)))
-
;; Return a string decoded from Nth element of the current dictionary.
(defun ispell-get-decoded-string (n)
"Get the decoded string in slot N of the descriptor of the current dict."
(let* ((slot (or
(assoc ispell-current-dictionary ispell-local-dictionary-alist)
(assoc ispell-current-dictionary ispell-dictionary-alist)
- (error "No data for dictionary \"%s\", neither in `ispell-local-dictionary-alist' nor in `ispell-dictionary-alist'"
+ (error "No data for dictionary \"%s\" in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'"
ispell-current-dictionary)))
- (str (nth n slot)))
- (when (and (> (length str) 0)
- (not (multibyte-string-p str)))
- (setq str (ispell-decode-string str))
- (or (multibyte-string-p str)
- (setq str (string-to-multibyte str))))
- str))
+ (str (nth n slot)))
+ (if (stringp str)
+ (decode-coding-string str (ispell-get-coding-system) t))))
(defun ispell-get-casechars ()
(ispell-get-decoded-string 1))
@@ -1742,9 +1784,10 @@ and pass it the output of the last Ispell invocation."
(erase-buffer)))))))
(defun ispell-send-replacement (misspelled replacement)
- "Notify Aspell that MISSPELLED should be spelled REPLACEMENT.
-This allows improving the suggestion list based on actual misspellings."
- (and ispell-really-aspell
+ "Notify spell checker that MISSPELLED should be spelled REPLACEMENT.
+This allows improving the suggestion list based on actual misspellings.
+Only works for Aspell and Enchant."
+ (and (or ispell-really-aspell ispell-really-enchant)
(ispell-send-string (concat "$$ra " misspelled "," replacement "\n"))))
@@ -3460,17 +3503,9 @@ Returns the sum SHIFT due to changes in word replacements."
(setq ispell-filter recheck-region
recheck-region nil
replace replace-word)))))
+ (setq shift (+ shift (- (length replace) word-len)))))
- (setq shift (+ shift (- (length replace) word-len)))
-
- ;; Move line-start across word...
- ;; new shift function does this now...
- ;;(set-marker line-start (+ line-start
- ;; (- (length replace)
- ;; (length (car poss)))))
- ))
(if (not ispell-quit)
- ;; FIXME: remove redundancy with identical code above.
(let (message-log-max)
(message
"Continuing spelling check using %s with %s dictionary..."
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
new file mode 100644
index 00000000000..d31414e3a4b
--- /dev/null
+++ b/lisp/textmodes/less-css-mode.el
@@ -0,0 +1,232 @@
+;;; less-css-mode.el --- Major mode for editing Less CSS files -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
+
+;; Author: Steve Purcell <steve@sanityinc.com>
+;; Maintainer: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords: hypermedia
+
+;; 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 mode provides syntax highlighting for Less CSS files
+;; (http://lesscss.org/), plus optional support for compilation of
+;; .less files to .css files at the time they are saved: use
+;; `less-css-compile-at-save' to enable this.
+;;
+;; Command line utility "lessc" is required if setting
+;; `less-css-compile-at-save' to t. To install "lessc" using the
+;; Node.js package manager, run "npm install less".
+;;
+;; Also make sure the "lessc" executable is in Emacs' PATH, example:
+;; (push (expand-file-name "~/.gem/ruby/1.8/bin") exec-path)
+;; or customize `less-css-lessc-command' to point to your "lessc"
+;; executable.
+;;
+;; We target lessc >= 1.4.0, and thus use the `--no-color' flag by
+;; default. You may want to adjust `less-css-lessc-options' for
+;; compatibility with older versions.
+;;
+;; `less-css-mode' is derived from `css-mode', and indentation of
+;; nested blocks may not work correctly with versions of `css-mode'
+;; other than that bundled with recent Emacs.
+;;
+;; You can specify per-file values for `less-css-compile-at-save',
+;; `less-css-output-file-name' or `less-css-output-directory' using a
+;; variables header at the top of your .less file, e.g.:
+;;
+;; // -*- less-css-compile-at-save: t; less-css-output-directory: "../css" -*-
+;;
+;; Alternatively, you can use directory local variables to set the
+;; default value of `less-css-output-directory' for your project.
+;;
+;; In the case of files which are included in other .less files, you
+;; may want to trigger the compilation of a "master" .less file on
+;; save: you can accomplish this with `less-css-input-file-name',
+;; which is probably best set using directory local variables.
+;;
+;; If you don't need CSS output but would like to be warned of any
+;; syntax errors in your .less source, consider using `flymake-less':
+;; https://github.com/purcell/flymake-less.
+
+;;; Credits
+
+;; The original code for this mode was, in large part, written using
+;; Anton Johansson's scss-mode as a template -- thanks Anton!
+;; https://github.com/antonj
+
+;;; Code:
+
+(require 'compile)
+(require 'css-mode)
+(require 'derived)
+(eval-when-compile (require 'subr-x))
+
+(defgroup less-css nil
+ "Less CSS mode."
+ :prefix "less-css-"
+ :group 'css)
+
+(defcustom less-css-lessc-command "lessc"
+ "Command used to compile Less files.
+Should be \"lessc\" or the complete path to your lessc
+executable, e.g.: \"~/.gem/ruby/1.8/bin/lessc\"."
+ :type 'file)
+
+(defcustom less-css-compile-at-save nil
+ "If non-nil, Less buffers are compiled to CSS after each save."
+ :type 'boolean)
+;;;###autoload
+(put 'less-css-compile-at-save 'safe-local-variable 'booleanp)
+
+(defcustom less-css-lessc-options '("--no-color")
+ "Command line options for Less executable.
+Use \"-x\" to minify output."
+ :type '(repeat string))
+;;;###autoload
+(put 'less-css-lessc-options 'safe-local-variable t)
+
+(defcustom less-css-output-directory nil
+ "Directory in which to save CSS, or nil to use the Less file's directory.
+This path is expanded relative to the directory of the Less file
+using `expand-file-name', so both relative and absolute paths
+will work as expected."
+ :type 'directory)
+;;;###autoload
+(put 'less-css-output-directory 'safe-local-variable 'stringp)
+
+(defcustom less-css-output-file-name nil
+ "File name in which to save CSS, or nil to use <name>.css for <name>.less.
+This can be also be set to a full path, or a relative path. If
+the path is relative, it will be relative to the value of
+`less-css-output-dir', if set, or the current directory by
+default."
+ :type 'file)
+(make-variable-buffer-local 'less-css-output-file-name)
+
+(defcustom less-css-input-file-name nil
+ "File name which will be compiled to CSS.
+When the current buffer is saved `less-css-input-file-name' file
+will be compiled to CSS instead of the current file.
+
+Set this in order to trigger compilation of a \"master\" .less
+file which includes the current file. The best way to set this
+variable in most cases is likely to be via directory local
+variables.
+
+This can be also be set to a full path, or a relative path. If
+the path is relative, it will be relative to the current
+directory by default."
+ :type 'file)
+;;;###autoload
+(put 'less-css-input-file-name 'safe-local-variable 'stringp)
+(make-variable-buffer-local 'less-css-input-file-name)
+
+(defconst less-css-default-error-regex
+ "^\\(?:\e\\[31m\\)?\\([^\e\n]*\\|FileError:.*\n\\)\\(?:\e\\[39m\e\\[31m\\)? in \\(?:\e\\[39m\\)?\\([^ \r\n\t\e]+\\)\\(?:\e\\[90m\\)?\\(?::\\| on line \\)\\([0-9]+\\)\\(?::\\|, column \\)\\([0-9]+\\):?\\(?:\e\\[39m\\)?")
+
+;;; Compilation to CSS
+
+(add-to-list 'compilation-error-regexp-alist-alist
+ (list 'less-css less-css-default-error-regex 2 3 4 nil 1))
+(add-to-list 'compilation-error-regexp-alist 'less-css)
+
+(defun less-css-compile-maybe ()
+ "Run `less-css-compile' if `less-css-compile-at-save' is non-nil."
+ (when less-css-compile-at-save
+ (less-css-compile)))
+
+(defun less-css--output-path ()
+ "Return the path to use for the compiled CSS file."
+ (expand-file-name
+ (or less-css-output-file-name
+ (concat
+ (file-name-nondirectory
+ (file-name-sans-extension buffer-file-name))
+ ".css"))
+ (or less-css-output-directory default-directory)))
+
+(defun less-css-compile ()
+ "Compile the current buffer to CSS using `less-css-lessc-command'."
+ (interactive)
+ (message "Compiling Less to CSS")
+ (let ((compilation-buffer-name-function
+ (lambda (_) "*less-css-compilation*")))
+ (save-window-excursion
+ (with-current-buffer
+ (compile
+ (string-join
+ (append
+ (list less-css-lessc-command)
+ (mapcar #'shell-quote-argument less-css-lessc-options)
+ (list (shell-quote-argument
+ (or less-css-input-file-name buffer-file-name))
+ (shell-quote-argument (less-css--output-path))))
+ " "))
+ (add-hook 'compilation-finish-functions
+ (lambda (buf msg)
+ (unless (string-match-p "^finished" msg)
+ (display-buffer buf)))
+ nil
+ t)))))
+
+;;; Major mode
+
+;; TODO:
+;; - interpolation ("@{val}")
+;; - escaped values (~"...")
+;; - JS eval (~`...`)
+;; - custom faces.
+(defconst less-css-font-lock-keywords
+ '(;; Variables
+ ("@[a-z_-][a-z-_0-9]*" . font-lock-variable-name-face)
+ ("&" . font-lock-preprocessor-face)
+ ;; Mixins
+ ("\\(?:[ \t{;]\\|^\\)\\(\\.[a-z_-][a-z-_0-9]*\\)[ \t]*;" .
+ (1 font-lock-keyword-face))))
+
+(defvar less-css-mode-syntax-table
+ (let ((st (make-syntax-table css-mode-syntax-table)))
+ ;; C++-style comments.
+ (modify-syntax-entry ?/ ". 124b" st)
+ (modify-syntax-entry ?* ". 23" st)
+ (modify-syntax-entry ?\n "> b" st)
+ ;; Special chars that sometimes come at the beginning of words.
+ (modify-syntax-entry ?. "'" st)
+ st))
+
+(defvar less-css-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c\C-c" 'less-css-compile)
+ map))
+
+;;;###autoload (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode))
+;;;###autoload
+(define-derived-mode less-css-mode css-mode "Less"
+ "Major mode for editing Less files (http://lesscss.org/).
+Special commands:
+\\{less-css-mode-map}"
+ (font-lock-add-keywords nil less-css-font-lock-keywords)
+ (setq-local comment-start "//")
+ (setq-local comment-end "")
+ (setq-local comment-continue " *")
+ (setq-local comment-start-skip "/[*/]+[ \t]*")
+ (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)")
+ (add-hook 'after-save-hook 'less-css-compile-maybe nil t))
+
+(provide 'less-css-mode)
+;;; less-css-mode.el ends here
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
index 9edc759c2df..34fdb961223 100644
--- a/lisp/textmodes/makeinfo.el
+++ b/lisp/textmodes/makeinfo.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el
index 2f2257d96bd..09da155f487 100644
--- a/lisp/textmodes/mhtml-mode.el
+++ b/lisp/textmodes/mhtml-mode.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -75,11 +75,11 @@ code();
(defconst mhtml--crucial-variable-prefix
(regexp-opt '("comment-" "uncomment-" "electric-indent-"
- "smie-" "forward-sexp-function"))
+ "smie-" "forward-sexp-function" "completion-" "major-mode"))
"Regexp matching the prefix of \"crucial\" buffer-locals we want to capture.")
(defconst mhtml--variable-prefix
- (regexp-opt '("font-lock-" "indent-line-function" "major-mode"))
+ (regexp-opt '("font-lock-" "indent-line-function"))
"Regexp matching the prefix of buffer-locals we want to capture.")
(defun mhtml--construct-submode (mode &rest args)
@@ -149,7 +149,12 @@ code();
(defun mhtml--submode-lighter ()
"Mode-line lighter indicating the current submode."
- (let ((submode (get-text-property (point) 'mhtml-submode)))
+ ;; The end of the buffer has no text properties, so in this case
+ ;; back up one character, if possible.
+ (let* ((where (if (and (eobp) (not (bobp)))
+ (1- (point))
+ (point)))
+ (submode (get-text-property where 'mhtml-submode)))
(if submode
(mhtml--submode-name submode)
"")))
@@ -193,6 +198,12 @@ smallest."
(get-text-property orig-end 'mhtml-submode))
(cl-decf font-lock-end)))
+ ;; Also handle the multiline property -- but handle it here, and
+ ;; not via font-lock-extend-region-functions, to avoid the
+ ;; situation where the two extension functions disagree.
+ ;; See bug#29159.
+ (font-lock-extend-region-multiline)
+
(or (/= font-lock-beg orig-beg)
(/= font-lock-end orig-end))))
@@ -232,8 +243,8 @@ smallest."
(cons 'jit-lock-bounds (cons new-beg new-end)))))
(defvar-local mhtml--last-submode nil
- "Record the last visited submode, so the cursor-sensor function
-can function properly.")
+ "Record the last visited submode.
+This is used by `mhtml--pre-command'.")
(defvar-local mhtml--stashed-crucial-variables nil
"Alist of stashed values of the crucial variables.")
@@ -288,9 +299,7 @@ can function properly.")
(unless (bobp)
(let ((submode (get-text-property (1- (point)) 'mhtml-submode)))
(if submode
- ;; Don't search in a comment or string
- (unless (syntax-ppss-context (syntax-ppss))
- (mhtml--syntax-propertize-submode submode end))
+ (mhtml--syntax-propertize-submode submode end)
;; No submode, so do what sgml-mode does.
(sgml-syntax-propertize-inside end))))
(funcall
@@ -356,15 +365,13 @@ can function properly.")
Code inside a <script> element is indented using the rules from
`js-mode'; and code inside a <style> element is indented using
the rules from `css-mode'."
- (cursor-sensor-mode)
(setq-local indent-line-function #'mhtml-indent-line)
(setq-local parse-sexp-lookup-properties t)
(setq-local syntax-propertize-function #'mhtml-syntax-propertize)
(setq-local font-lock-fontify-region-function
#'mhtml--submode-fontify-region)
(setq-local font-lock-extend-region-functions
- '(mhtml--extend-font-lock-region
- font-lock-extend-region-multiline))
+ '(mhtml--extend-font-lock-region))
;; Attach this to both pre- and post- hooks just in case it ever
;; changes a key binding that might be accessed from the menu bar.
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
index cea0c604baf..82cb2d4dc05 100644
--- a/lisp/textmodes/nroff-mode.el
+++ b/lisp/textmodes/nroff-mode.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -195,7 +195,7 @@ Puts a full-stop before comments on a line by themselves."
9) 8)))))) ; add 9 to ensure at least two blanks
(goto-char pt))))
-;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg01869.html
+;; https://lists.gnu.org/r/emacs-devel/2007-10/msg01869.html
(defun nroff-insert-comment-function ()
"Function for `comment-insert-comment-function' in `nroff-mode'."
(indent-to (nroff-comment-indent))
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index 8542b951b3b..bf1e33bf0f6 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -1,4 +1,4 @@
-;;; page-ext.el --- extended page handling commands
+;;; page-ext.el --- extended page handling commands -*- lexical-binding:t -*-
;; Copyright (C) 1990-1991, 1993-1994, 2001-2017 Free Software
;; Foundation, Inc.
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -243,18 +243,15 @@
(defcustom pages-directory-buffer-narrowing-p t
"If non-nil, `pages-directory-goto' narrows pages buffer to entry."
- :type 'boolean
- :group 'pages)
+ :type 'boolean)
(defcustom pages-directory-for-adding-page-narrowing-p t
"If non-nil, `add-new-page' narrows page buffer to new entry."
- :type 'boolean
- :group 'pages)
+ :type 'boolean)
(defcustom pages-directory-for-adding-new-page-before-current-page-p t
"If non-nil, `add-new-page' inserts new page before current page."
- :type 'boolean
- :group 'pages)
+ :type 'boolean)
;;; Addresses related variables
@@ -262,23 +259,19 @@
(defcustom pages-addresses-file-name "~/addresses"
"Standard name for file of addresses. Entries separated by page-delimiter.
Used by `pages-directory-for-addresses' function."
- :type 'file
- :group 'pages)
+ :type 'file)
(defcustom pages-directory-for-addresses-goto-narrowing-p t
"If non-nil, `pages-directory-goto' narrows addresses buffer to entry."
- :type 'boolean
- :group 'pages)
+ :type 'boolean)
(defcustom pages-directory-for-addresses-buffer-keep-windows-p t
"If nil, `pages-directory-for-addresses' deletes other windows."
- :type 'boolean
- :group 'pages)
+ :type 'boolean)
(defcustom pages-directory-for-adding-addresses-narrowing-p t
"If non-nil, `add-new-page' narrows addresses buffer to new entry."
- :type 'boolean
- :group 'pages)
+ :type 'boolean)
;;; Key bindings for page handling functions
@@ -415,9 +408,9 @@ Point is left in the body of page."
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort)."
-;;; This sort function handles ends of pages differently than
-;;; `sort-pages' and works better with lists of addresses and similar
-;;; files.
+ ;; This sort function handles ends of pages differently than
+ ;; `sort-pages' and works better with lists of addresses and similar
+ ;; files.
(interactive "P\nr")
(save-restriction
@@ -463,25 +456,27 @@ REVERSE (non-nil means reverse order), BEG and END (region to sort)."
\(This regular expression may be used to select only those pages that
contain matches to the regexp.)")
-(defvar pages-buffer nil
+(defvar-local pages-buffer nil
"The buffer for which the pages-directory function creates the directory.")
(defvar pages-directory-prefix "*Directory for:"
"Prefix of name of temporary buffer for pages-directory.")
-(defvar pages-pos-list nil
+(defvar-local pages-pos-list nil
"List containing the positions of the pages in the pages-buffer.")
(defvar pages-target-buffer)
+(define-obsolete-variable-alias 'pages-directory-map
+ 'pages-directory-mode-map "26.1")
(defvar pages-directory-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-c\C-c" 'pages-directory-goto)
+ (define-key map "\C-m" 'pages-directory-goto)
(define-key map "\C-c\C-p\C-a" 'add-new-page)
- (define-key map [mouse-2] 'pages-directory-goto-with-mouse)
+ (define-key map [mouse-2] 'pages-directory-goto)
map)
"Keymap for the pages-directory-buffer.")
-(defvaralias 'pages-directory-map 'pages-directory-mode-map)
(defvar original-page-delimiter "^\f"
"Default page delimiter.")
@@ -512,6 +507,9 @@ resets the page-delimiter to the original value."
;;; Pages directory main definitions
+(defvar pages-buffer-original-position)
+(defvar pages-buffer-original-page)
+
(defun pages-directory
(pages-list-all-headers-p count-lines-p &optional regexp)
"Display a directory of the page headers in a temporary buffer.
@@ -573,7 +571,6 @@ directory for only the accessible portion of the buffer."
(let ((pages-target-buffer (current-buffer))
(pages-directory-buffer
(concat pages-directory-prefix " " (buffer-name)))
- (linenum 1)
(pages-buffer-original-position (point))
(pages-buffer-original-page 0))
@@ -583,6 +580,7 @@ directory for only the accessible portion of the buffer."
(with-output-to-temp-buffer pages-directory-buffer
(with-current-buffer standard-output
(pages-directory-mode)
+ (setq buffer-read-only nil)
(insert
"==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
(setq pages-buffer pages-target-buffer)
@@ -631,6 +629,7 @@ directory for only the accessible portion of the buffer."
)))))
(set-buffer standard-output)
+ (setq buffer-read-only t)
;; Put positions in increasing order to go with buffer.
(setq pages-pos-list (nreverse pages-pos-list))
(if (called-interactively-p 'interactive)
@@ -642,10 +641,6 @@ directory for only the accessible portion of the buffer."
1
pages-buffer-original-page))))
-(defvar pages-buffer-original-position)
-(defvar pages-buffer-original-page)
-(defvar pages-buffer-original-page)
-
(defun pages-copy-header-and-position (count-lines-p)
"Copy page header and its position to the Pages Directory.
Only arg non-nil, count lines in page and insert before header.
@@ -699,16 +694,13 @@ Used by `pages-directory' function."
Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
to the same line in the pages buffer."
- (make-local-variable 'pages-buffer)
- (make-local-variable 'pages-pos-list)
(make-local-variable 'pages-directory-buffer-narrowing-p))
-(defun pages-directory-goto ()
+(defun pages-directory-goto (&optional event)
"Go to the corresponding line in the pages buffer."
-
-;;; This function is mostly a copy of `occur-mode-goto-occurrence'
-
- (interactive)
+ ;; This function is mostly a copy of `occur-mode-goto-occurrence'
+ (interactive "@e")
+ (if event (mouse-set-point event))
(if (or (not pages-buffer)
(not (buffer-name pages-buffer)))
(progn
@@ -722,18 +714,13 @@ to the same line in the pages buffer."
(narrowing-p pages-directory-buffer-narrowing-p))
(pop-to-buffer pages-buffer)
(widen)
- (if end-of-directory-p
- (goto-char (point-max))
- (goto-char (marker-position pos)))
+ (goto-char (if end-of-directory-p
+ (point-max)
+ (marker-position pos)))
(if narrowing-p (narrow-to-page))))
-(defun pages-directory-goto-with-mouse (event)
- "Go to the corresponding line under the mouse pointer in the pages buffer."
- (interactive "e")
- (with-current-buffer (window-buffer (posn-window (event-end event)))
- (save-excursion
- (goto-char (posn-point (event-end event)))
- (pages-directory-goto))))
+(define-obsolete-function-alias 'pages-directory-goto-with-mouse
+ #'pages-directory-goto "26.1")
;;; The `pages-directory-for-addresses' function and ancillary code
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
index 936896c3bd8..fa2a7d1c9ad 100644
--- a/lisp/textmodes/page.el
+++ b/lisp/textmodes/page.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
index f0671f489f8..645d3ff1a2a 100644
--- a/lisp/textmodes/paragraphs.el
+++ b/lisp/textmodes/paragraphs.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 09d0a2f0a9a..60e9bbb5f5c 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -66,7 +66,7 @@
(defvar picture-desired-column 0
"Desired current column for Picture mode.
When a cursor is on a wide-column character (e.g. Chinese,
-Japanese, Korean), this may may be different from `current-column'.")
+Japanese, Korean), this may be different from `current-column'.")
(defun picture-update-desired-column (adjust-to-current)
diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el
index 822596c57c2..648eef56cf6 100644
--- a/lisp/textmodes/po.el
+++ b/lisp/textmodes/po.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
index 6b721260813..62c299b86d7 100644
--- a/lisp/textmodes/refbib.el
+++ b/lisp/textmodes/refbib.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
index 74dec30473c..ee182211486 100644
--- a/lisp/textmodes/refer.el
+++ b/lisp/textmodes/refer.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el
index f65c9ade673..e005b5806f9 100644
--- a/lisp/textmodes/refill.el
+++ b/lisp/textmodes/refill.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el
index 1e0a5640483..ac57ce735a0 100644
--- a/lisp/textmodes/reftex-auc.el
+++ b/lisp/textmodes/reftex-auc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index 7f1887cbf45..9ff2d0a1769 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el
index 16bc621f889..894f08b15d0 100644
--- a/lisp/textmodes/reftex-dcr.el
+++ b/lisp/textmodes/reftex-dcr.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el
index 91d2b485626..d07a52816e3 100644
--- a/lisp/textmodes/reftex-global.el
+++ b/lisp/textmodes/reftex-global.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 6544029ef0c..811d1477ada 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -474,7 +474,7 @@ With prefix 3, restrict index to region."
(interactive)
- ;; Ensure access to scanning info and rescan buffer if prefix are is '(4).
+ ;; Ensure access to scanning info and rescan buffer if prefix arg is '(4).
(let ((current-prefix-arg current-prefix-arg))
(reftex-ensure-index-support t)
(reftex-access-scan-info current-prefix-arg))
diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el
index af2810d72e8..67a3dd26b76 100644
--- a/lisp/textmodes/reftex-parse.el
+++ b/lisp/textmodes/reftex-parse.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el
index dd183548d0f..8d69d8feda5 100644
--- a/lisp/textmodes/reftex-ref.el
+++ b/lisp/textmodes/reftex-ref.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -134,7 +134,7 @@ This function is controlled by the settings of reftex-insert-label-flags."
(interactive)
- ;; Ensure access to scanning info and rescan buffer if prefix are is '(4).
+ ;; Ensure access to scanning info and rescan buffer if prefix arg is '(4).
(reftex-access-scan-info current-prefix-arg)
;; Find out what kind of environment this is and abort if necessary.
@@ -314,7 +314,7 @@ also applies `reftex-translate-to-ascii-function' to the string."
(save-match-data
(cond
((equal letter "f")
- (file-name-base))
+ (file-name-base (buffer-file-name)))
((equal letter "F")
(let ((masterdir (file-name-directory (reftex-TeX-master-file)))
(file (file-name-sans-extension (buffer-file-name))))
diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el
index a4533adec08..65720f4ecdb 100644
--- a/lisp/textmodes/reftex-sel.el
+++ b/lisp/textmodes/reftex-sel.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el
index 4f7c738a134..c694fafcd52 100644
--- a/lisp/textmodes/reftex-toc.el
+++ b/lisp/textmodes/reftex-toc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -216,7 +216,7 @@ When called with a raw C-u prefix, rescan the document first."
(or reftex-support-index
(setq reftex-toc-include-index-entries nil))
- ;; Ensure access to scanning info and rescan buffer if prefix are is '(4)
+ ;; Ensure access to scanning info and rescan buffer if prefix arg is '(4)
(reftex-access-scan-info current-prefix-arg)
(let* ((this-buf (current-buffer))
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index 03da584e96f..528232b5254 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -264,7 +264,7 @@ distribution. Mixed-case symbols are convenience aliases.")
"LaTeX label and citation support."
:tag "RefTeX"
:link '(url-link :tag "Home Page"
- "http://www.gnu.org/software/auctex/reftex.html")
+ "https://www.gnu.org/software/auctex/reftex.html")
:link '(emacs-commentary-link :tag "Commentary in reftex.el" "reftex.el")
:link '(custom-manual "(reftex)Top")
:prefix "reftex-"
diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el
index 9754d2b20ff..d9393ff25f7 100644
--- a/lisp/textmodes/reftex.el
+++ b/lisp/textmodes/reftex.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -36,13 +36,13 @@
;;
;; The documentation in various formats is also available at
;;
-;; http://www.gnu.org/software/auctex/manual/reftex.index.html
+;; https://www.gnu.org/software/auctex/manual/reftex.index.html
;;
;; RefTeX is bundled with Emacs and available as a plug-in package for
;; XEmacs 21.x. If you need to install it yourself, you can find a
;; distribution at
;;
-;; http://www.gnu.org/software/auctex/reftex.html
+;; https://www.gnu.org/software/auctex/reftex.html
;;
;; RefTeX was written by Carsten Dominik <dominik@science.uva.nl> with
;; contributions from Stephen Eglen. It is currently maintained by
@@ -1496,7 +1496,8 @@ When DIE is non-nil, throw an error if file not found."
(and n (setq conf-variable (nth n conf-variable)))
(or (eq conf-variable t)
(and (stringp conf-variable)
- (string-match (concat "[" conf-variable "]") typekey))))
+ (let ((case-fold-search nil))
+ (string-match (concat "[" conf-variable "]") typekey)))))
(defun reftex-check-recursive-edit ()
;; Check if we are already in a recursive edit. Abort with helpful
@@ -2368,7 +2369,7 @@ information about your RefTeX version and configuration."
what in fact did happen.
Check if the bug is reproducible with an up-to-date version of
-RefTeX available from http://www.gnu.org/software/auctex/.
+RefTeX available from https://www.gnu.org/software/auctex/.
If the bug is triggered by a specific \(La)TeX file, you should try
to produce a minimal sample file showing the problem and include it
diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el
index 388e49cfdc2..7300af06f49 100644
--- a/lisp/textmodes/remember.el
+++ b/lisp/textmodes/remember.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -349,7 +349,7 @@ In which case `remember-mailbox' should be the name of the mailbox.
Each piece of pseudo-mail created will have an `X-Todo-Priority'
field, for the purpose of appropriate splitting."
(let ((who (read-string "Who is this item related to? "))
- (moment (format "%.0f" (float-time)))
+ (moment (format-time-string "%s"))
(desc (remember-buffer-desc))
(text (buffer-string)))
(with-temp-buffer
@@ -402,11 +402,19 @@ exists) might be changed."
:type 'string
:group 'remember)
+(defcustom remember-time-format "%a %b %d %H:%M:%S %Y"
+ "The format for time stamp, passed to `format-time-string'.
+The default emulates `current-time-string' for backward compatibility."
+ :type 'string
+ :group 'remember
+ :version "27.1")
+
(defun remember-append-to-file ()
"Remember, with description DESC, the given TEXT."
(let* ((text (buffer-string))
(desc (remember-buffer-desc))
- (remember-text (concat "\n" remember-leader-text (current-time-string)
+ (remember-text (concat "\n" remember-leader-text
+ (format-time-string remember-time-format)
" (" desc ")\n\n" text
(save-excursion (goto-char (point-max))
(if (bolp) nil "\n"))))
diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el
index 490ea231096..393b679e4a1 100644
--- a/lisp/textmodes/rst.el
+++ b/lisp/textmodes/rst.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -109,46 +109,9 @@
(def-edebug-spec push
(&or [form symbolp] [form gv-place]))
-;; Correct wrong declaration. This still doesn't support dotted destructuring
-;; though.
-(def-edebug-spec cl-lambda-list
- (([&rest cl-macro-arg]
- [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
- [&optional ["&rest" arg]]
- [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
- &optional "&allow-other-keys"]]
- [&optional ["&aux" &rest
- &or (symbolp &optional def-form) symbolp]]
- )))
-
-;; Add missing declaration.
-(def-edebug-spec cl-type-spec sexp) ;; This is not exactly correct but good
- ;; enough.
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Support for `testcover'
-(when (and (boundp 'testcover-1value-functions)
- (boundp 'testcover-compose-functions))
- ;; Below `lambda' is used in a loop with varying parameters and is thus not
- ;; 1valued.
- (setq testcover-1value-functions
- (delq 'lambda testcover-1value-functions))
- (add-to-list 'testcover-compose-functions 'lambda))
-
-(defun rst-testcover-defcustom ()
- "Remove all customized variables from `testcover-module-constants'.
-This seems to be a bug in `testcover': `defcustom' variables are
-considered constants. Revert it with this function after each `defcustom'."
- (when (boundp 'testcover-module-constants)
- (setq testcover-module-constants
- (delq nil
- (mapcar
- #'(lambda (sym)
- (if (not (plist-member (symbol-plist sym) 'standard-value))
- sym))
- testcover-module-constants)))))
-
(defun rst-testcover-add-compose (fun)
"Add FUN to `testcover-compose-functions'."
(when (boundp 'testcover-compose-functions)
@@ -1360,7 +1323,6 @@ This inherits from Text mode.")
The hook for `text-mode' is run before this one."
:group 'rst
:type '(hook))
-(rst-testcover-defcustom)
;; Pull in variable definitions silencing byte-compiler.
(require 'newcomment)
@@ -1557,7 +1519,6 @@ file."
(const :tag "Underline only" simple))
(integer :tag "Indentation for overline and underline type"
:value 0))))
-(rst-testcover-defcustom)
;; FIXME: Rename this to `rst-over-and-under-default-indent' and set default to
;; 0 because the effect of 1 is probably surprising in the few cases
@@ -1574,7 +1535,6 @@ found in the buffer are to be used but the indentation for
over-and-under adornments is inconsistent across the buffer."
:group 'rst-adjust
:type '(integer))
-(rst-testcover-defcustom)
(defun rst-new-preferred-hdr (seen prev)
;; testcover: ok.
@@ -2013,7 +1973,6 @@ b. a negative numerical argument, which generally inverts the
:group 'rst-adjust
:type '(hook)
:package-version '(rst . "1.1.0"))
-(rst-testcover-defcustom)
(defcustom rst-new-adornment-down nil
"Controls level of new adornment for section headers."
@@ -2022,7 +1981,6 @@ b. a negative numerical argument, which generally inverts the
(const :tag "Same level as previous one" nil)
(const :tag "One level down relative to the previous one" t))
:package-version '(rst . "1.1.0"))
-(rst-testcover-defcustom)
(defun rst-adjust-adornment (pfxarg)
"Call `rst-adjust-section' interactively.
@@ -2445,7 +2403,6 @@ also arranged by `rst-insert-list-new-tag'."
:tag (char-to-string char) char))
rst-bullets)))
:package-version '(rst . "1.1.0"))
-(rst-testcover-defcustom)
(defun rst-insert-list-continue (ind tag tab prefer-roman)
;; testcover: ok.
@@ -2682,7 +2639,6 @@ section headers at all."
Also used for formatting insertion, when numbering is disabled."
:type 'integer
:group 'rst-toc)
-(rst-testcover-defcustom)
(defcustom rst-toc-insert-style 'fixed
"Insertion style for table-of-contents.
@@ -2697,19 +2653,16 @@ indentation style:
(const aligned)
(const listed))
:group 'rst-toc)
-(rst-testcover-defcustom)
(defcustom rst-toc-insert-number-separator " "
"Separator that goes between the TOC number and the title."
:type 'string
:group 'rst-toc)
-(rst-testcover-defcustom)
(defcustom rst-toc-insert-max-level nil
"If non-nil, maximum depth of the inserted TOC."
:type '(choice (const nil) integer)
:group 'rst-toc)
-(rst-testcover-defcustom)
(defconst rst-toc-link-keymap
(let ((map (make-sparse-keymap)))
@@ -3174,35 +3127,30 @@ These indentation widths can be customized here."
"Indentation when there is no more indentation point given."
:group 'rst-indent
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-field 3
"Indentation for first line after a field or 0 to always indent for content."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-literal-normal 3
"Default indentation for literal block after a markup on an own line."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-literal-minimized 2
"Default indentation for literal block after a minimized markup."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
(defcustom rst-indent-comment 3
"Default indentation for first line of a comment."
:group 'rst-indent
:package-version '(rst . "1.1.0")
:type '(integer))
-(rst-testcover-defcustom)
;; FIXME: Must consider other tabs:
;; * Line blocks
@@ -3486,7 +3434,7 @@ applied to each line like this
COUNT is 0 before the first paragraph and increments for every
paragraph found on level IND. IN-FIRST is non-nil if this is the
first line of such a paragraph. IN-SUB is non-nil if this line
-is part of a sub-block while IN-SUPER is non-nil of this line is
+is part of a sub-block while IN-SUPER is non-nil if this line is
part of a less indented block (super-block). IN-EMPTY is non-nil
if this line is empty where an empty line is considered being
part of the previous block. RELIND is nil for an empty line, 0
@@ -3652,7 +3600,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-block-face
"customize the face `rst-block' instead."
"24.1")
@@ -3667,7 +3614,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-external-face
"customize the face `rst-external' instead."
"24.1")
@@ -3682,7 +3628,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-definition-face
"customize the face `rst-definition' instead."
"24.1")
@@ -3699,7 +3644,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
"Directives and roles."
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-directive-face
"customize the face `rst-directive' instead."
"24.1")
@@ -3714,7 +3658,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-comment-face
"customize the face `rst-comment' instead."
"24.1")
@@ -3729,7 +3672,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis1-face
"customize the face `rst-emphasis1' instead."
"24.1")
@@ -3743,7 +3685,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
"Double emphasis."
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-emphasis2-face
"customize the face `rst-emphasis2' instead."
"24.1")
@@ -3758,7 +3699,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-literal-face
"customize the face `rst-literal' instead."
"24.1")
@@ -3773,7 +3713,6 @@ Region is from BEG to END. With WITH-EMPTY prefix empty lines too."
:version "24.1"
:group 'rst-faces
:type '(face))
-(rst-testcover-defcustom)
(make-obsolete-variable 'rst-reference-face
"customize the face `rst-reference' instead."
"24.1")
@@ -3856,7 +3795,6 @@ of your own."
(const :tag "transitions" t)
(const :tag "section title adornment" nil))
:value-type (face)))
-(rst-testcover-defcustom)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4353,7 +4291,6 @@ string)) to be used for converting the document."
(string :tag "Options"))))
:group 'rst-compile
:package-version "1.2.0")
-(rst-testcover-defcustom)
;; FIXME: Must be defcustom.
(defvar rst-compile-primary-toolset 'html
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 1f99786ae7c..7ae3036f8cf 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -2242,8 +2242,8 @@ The result is cached in `html--buffer-classes-cache'."
(classes
(seq-mapcat
(lambda (el)
- (when-let (class-list
- (cdr (assq 'class (dom-attributes el))))
+ (when-let* ((class-list
+ (cdr (assq 'class (dom-attributes el)))))
(split-string class-list)))
(dom-by-class dom ""))))
(setq-local html--buffer-classes-cache (cons tick classes))
@@ -2260,8 +2260,8 @@ The result is cached in `html--buffer-ids-cache'."
(ids
(seq-mapcat
(lambda (el)
- (when-let (id-list
- (cdr (assq 'id (dom-attributes el))))
+ (when-let* ((id-list
+ (cdr (assq 'id (dom-attributes el)))))
(split-string id-list)))
(dom-by-id dom ""))))
(setq-local html--buffer-ids-cache (cons tick ids))
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index 5e967b535c4..d408d206be4 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index ba6d696de90..5c585ea46ca 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -55,6 +55,11 @@
:prefix "tex-"
:group 'tex)
+(defgroup tex-flymake nil
+ "Flymake backend for linting TeX files."
+ :prefix "tex-"
+ :group 'tex)
+
;;;###autoload
(defcustom tex-shell-file-name nil
"If non-nil, the shell file name to run in the subshell used to run TeX."
@@ -259,6 +264,17 @@ measured relative to that of the normal text."
(float :tag "Superscript"))
:version "23.1")
+(defcustom tex-chktex-program "chktex"
+ "ChkTeX executable to use for linting TeX files."
+ :type 'string
+ :link '(url-link "man:chktex(1)")
+ :group 'tex-flymake)
+
+(defcustom tex-chktex-extra-flags nil
+ "Extra command line flags for `tex-chktex-program'."
+ :type '(repeat string)
+ :group 'tex-flymake)
+
(defvar tex-last-temp-file nil
"Latest temporary file generated by \\[tex-region] and \\[tex-buffer].
Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the
@@ -1154,6 +1170,7 @@ subshell is initiated, `tex-shell-hook' is run."
(setq-local fill-indent-according-to-mode t)
(add-hook 'completion-at-point-functions
#'latex-complete-data nil 'local)
+ (add-hook 'flymake-diagnostic-functions 'tex-chktex nil t)
(setq-local outline-regexp latex-outline-regexp)
(setq-local outline-level #'latex-outline-level)
(setq-local forward-sexp-function #'latex-forward-sexp)
@@ -1775,7 +1792,7 @@ Mark is left at original location."
;; Note this does not handle things like mismatched brackets inside
;; begin/end blocks.
;; Needs to handle escaped parens for tex-validate-*.
-;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2007-09/msg00038.html
+;; https://lists.gnu.org/r/bug-gnu-emacs/2007-09/msg00038.html
;; Does not handle escaped parens when latex-handle-escaped-parens is nil.
(defun latex-forward-sexp-1 ()
"Like (forward-sexp 1) but aware of multi-char elements and escaped parens."
@@ -3465,6 +3482,53 @@ There might be text before point."
;; Don't compose inside verbatim blocks.
(eq 2 (nth 7 (syntax-ppss))))))))
+
+;;; Flymake support
+
+(defvar-local tex-chktex--process nil)
+
+(defun tex-chktex-command ()
+ "Return a list of command arguments for invoking ChkTeX."
+ `(,tex-chktex-program ,@tex-chktex-extra-flags
+ "--quiet" "--verbosity=0" "--inputfiles"))
+
+(defun tex-chktex (report-fn &rest _args)
+ "Flymake backend for linting TeX buffers with ChkTeX."
+ (unless (executable-find tex-chktex-program)
+ (error "Cannot find a suitable TeX checker"))
+ (when (process-live-p tex-chktex--process)
+ (kill-process tex-chktex--process))
+ (let ((source (current-buffer))
+ (re "^stdin:\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\):\\(.*\\)$"))
+ (save-restriction
+ (widen)
+ (setq tex-chktex--process
+ (make-process
+ :name "tex-chktex"
+ :buffer (generate-new-buffer "*tex-chktex*")
+ :command (tex-chktex-command)
+ :noquery t :connection-type 'pipe
+ :sentinel
+ (lambda (process _event)
+ (when (eq (process-status process) 'exit)
+ (unwind-protect
+ (when (eq process
+ (with-current-buffer source tex-chktex--process))
+ (with-current-buffer (process-buffer process)
+ (goto-char (point-min))
+ (cl-loop
+ while (search-forward-regexp re nil t)
+ for msg = (match-string 4)
+ for line = (string-to-number (match-string 1))
+ for col = (string-to-number (match-string 2))
+ for (beg . end) = (flymake-diag-region source line col)
+ collect (flymake-make-diagnostic source beg end :warning msg)
+ into diags
+ finally (funcall report-fn diags))))
+ (kill-buffer (process-buffer process)))))))
+ (process-send-region tex-chktex--process (point-min) (point-max))
+ (process-send-eof tex-chktex--process))))
+
(run-hooks 'tex-mode-load-hook)
(provide 'tex-mode)
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
index 1d2a9e52ab1..51f0659bf31 100644
--- a/lisp/textmodes/texinfmt.el
+++ b/lisp/textmodes/texinfmt.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -2022,7 +2022,7 @@ commands that are defined in texinfo.tex for printed output.
(push (- end-of-template start-of-template)
texinfo-multitable-width-list)
;; Remove carriage return from within a template, if any.
- ;; This helps those those who want to use more than
+ ;; This helps those who want to use more than
;; one line's worth of words in @multitable line.
(narrow-to-region start-of-template end-of-template)
(goto-char (point-min))
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
index f962dec9f09..be8bcc55fec 100644
--- a/lisp/textmodes/texinfo.el
+++ b/lisp/textmodes/texinfo.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Todo:
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
index aa5346d01fd..46977e1411f 100644
--- a/lisp/textmodes/texnfo-upd.el
+++ b/lisp/textmodes/texnfo-upd.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
index 7d63556dcc2..1661ebe8c84 100644
--- a/lisp/textmodes/text-mode.el
+++ b/lisp/textmodes/text-mode.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el
index e4920b70c1c..0d7b15dfc6b 100644
--- a/lisp/textmodes/tildify.el
+++ b/lisp/textmodes/tildify.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
index c6203fdf9eb..293a106515a 100644
--- a/lisp/textmodes/two-column.el
+++ b/lisp/textmodes/two-column.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
index f018260b7ed..9f7a6eb47b5 100644
--- a/lisp/textmodes/underline.el
+++ b/lisp/textmodes/underline.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 7c3d73e52b7..e3a4d4d7c1e 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -42,6 +42,9 @@
;; beginning-op Function to call to skip to the beginning of a "thing".
;; end-op Function to call to skip to the end of a "thing".
;;
+;; For simple things, defined as sequences of specific kinds of characters,
+;; use macro define-thing-chars.
+;;
;; Reliance on existing operators means that many `things' can be accessed
;; without further code: eg.
;; (thing-at-point 'line)
@@ -237,21 +240,28 @@ The bounds of THING are determined by `bounds-of-thing-at-point'."
(put 'defun 'end-op 'end-of-defun)
(put 'defun 'forward-op 'end-of-defun)
+;; Things defined by sets of characters
+
+(defmacro define-thing-chars (thing chars)
+ "Define THING as a sequence of CHARS.
+E.g.:
+\(define-thing-chars twitter-screen-name \"[:alnum:]_\")"
+ `(progn
+ (put ',thing 'end-op
+ (lambda ()
+ (re-search-forward (concat "\\=[" ,chars "]*") nil t)))
+ (put ',thing 'beginning-op
+ (lambda ()
+ (if (re-search-backward (concat "[^" ,chars "]") nil t)
+ (forward-char)
+ (goto-char (point-min)))))))
+
;; Filenames
(defvar thing-at-point-file-name-chars "-~/[:alnum:]_.${}#%,:"
"Characters allowable in filenames.")
-(put 'filename 'end-op
- (lambda ()
- (re-search-forward (concat "\\=[" thing-at-point-file-name-chars "]*")
- nil t)))
-(put 'filename 'beginning-op
- (lambda ()
- (if (re-search-backward (concat "[^" thing-at-point-file-name-chars "]")
- nil t)
- (forward-char)
- (goto-char (point-min)))))
+(define-thing-chars filename thing-at-point-file-name-chars)
;; URIs
@@ -388,7 +398,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)."
;; Ensure PT is actually within BOUNDARY. Check the following
;; example with point on the beginning of the line:
;;
- ;; 3,1406710489,http://gnu.org,0,"0"
+ ;; 3,1406710489,https://gnu.org,0,"0"
(and (<= url-beg pt end) (cons url-beg end))))))
(put 'url 'thing-at-point 'thing-at-point-url-at-point)
diff --git a/lisp/thumbs.el b/lisp/thumbs.el
index 0665429246f..e8ef05242ef 100644
--- a/lisp/thumbs.el
+++ b/lisp/thumbs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -523,23 +523,16 @@ Open another window."
(interactive "FRename to file or directory: ")
(let ((files (or thumbs-marked-list (list (thumbs-current-image))))
failures)
- (if (and (not (file-directory-p newfile))
- thumbs-marked-list)
- (if (file-exists-p newfile)
- (error "Renaming marked files to file name `%s'" newfile)
- (make-directory newfile t)))
+ (when thumbs-marked-list
+ (make-directory newfile t)
+ (setq newfile (file-name-as-directory newfile)))
(if (yes-or-no-p (format "Really rename %d files? " (length files)))
(let ((thumbs-file-list (thumbs-file-alist))
(inhibit-read-only t))
(dolist (file files)
(let (failure)
(condition-case ()
- (if (file-directory-p newfile)
- (rename-file file
- (expand-file-name
- (file-name-nondirectory file)
- newfile))
- (rename-file file newfile))
+ (rename-file file newfile)
(file-error (setq failure t)
(push file failures)))
(unless failure
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
index fa7621bcd46..959f0cad64f 100644
--- a/lisp/time-stamp.el
+++ b/lisp/time-stamp.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/time.el b/lisp/time.el
index 6a46ea68eab..6cd7320e72f 100644
--- a/lisp/time.el
+++ b/lisp/time.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -160,24 +160,33 @@ LABEL is a string to display as the label of that TIMEZONE's time."
:type '(repeat (list string string))
:version "23.1")
-(defcustom display-time-world-list
- ;; Determine if zoneinfo style timezones are supported by testing that
- ;; America/New York and Europe/London return different timezones.
- (let ((nyt (format-time-string "%z" nil "America/New_York"))
- (gmt (format-time-string "%z" nil "Europe/London")))
- (if (string-equal nyt gmt)
- legacy-style-world-list
- zoneinfo-style-world-list))
+(defcustom display-time-world-list t
"Alist of time zones and places for `display-time-world' to display.
Each element has the form (TIMEZONE LABEL).
TIMEZONE should be in a format supported by your system. See the
documentation of `zoneinfo-style-world-list' and
`legacy-style-world-list' for two widely used formats. LABEL is
-a string to display as the label of that TIMEZONE's time."
+a string to display as the label of that TIMEZONE's time.
+
+If the value is t instead of an alist, use the value of
+`zoneinfo-style-world-list' if it works on this platform, and of
+`legacy-style-world-list' otherwise."
+
:group 'display-time
:type '(repeat (list string string))
:version "23.1")
+(defun time--display-world-list ()
+ (if (listp display-time-world-list)
+ display-time-world-list
+ ;; Determine if zoneinfo style timezones are supported by testing that
+ ;; America/New York and Europe/London return different timezones.
+ (let ((nyt (format-time-string "%z" nil "America/New_York"))
+ (gmt (format-time-string "%z" nil "Europe/London")))
+ (if (string-equal nyt gmt)
+ legacy-style-world-list
+ zoneinfo-style-world-list))))
+
(defcustom display-time-world-time-format "%A %d %B %R %Z"
"Format of the time displayed, see `format-time-string'."
:group 'display-time
@@ -548,7 +557,7 @@ To turn off the world time display, go to that window and type `q'."
(not (get-buffer display-time-world-buffer-name)))
(run-at-time t display-time-world-timer-second 'display-time-world-timer))
(with-current-buffer (get-buffer-create display-time-world-buffer-name)
- (display-time-world-display display-time-world-list)
+ (display-time-world-display (time--display-world-list))
(display-buffer display-time-world-buffer-name
(cons nil '((window-height . fit-window-to-buffer))))
(display-time-world-mode)))
@@ -556,7 +565,7 @@ To turn off the world time display, go to that window and type `q'."
(defun display-time-world-timer ()
(if (get-buffer display-time-world-buffer-name)
(with-current-buffer (get-buffer display-time-world-buffer-name)
- (display-time-world-display display-time-world-list))
+ (display-time-world-display (time--display-world-list)))
;; cancel timer
(let ((list timer-list))
(while list
@@ -574,7 +583,7 @@ For example, the Unix uptime command format is \"%D, %z%2h:%.2m\"."
(let ((str
(format-seconds (or format "%Y, %D, %H, %M, %z%S")
(float-time
- (time-subtract (current-time) before-init-time)))))
+ (time-subtract nil before-init-time)))))
(if (called-interactively-p 'interactive)
(message "%s" str)
str)))
diff --git a/lisp/timezone.el b/lisp/timezone.el
index 023cc68c3cc..762147b08bb 100644
--- a/lisp/timezone.el
+++ b/lisp/timezone.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/tmm.el b/lisp/tmm.el
index 8755971d7ca..ca6a37d62b2 100644
--- a/lisp/tmm.el
+++ b/lisp/tmm.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el
index 2386fe6177a..ee01a6998b8 100644
--- a/lisp/tool-bar.el
+++ b/lisp/tool-bar.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/tooltip.el b/lisp/tooltip.el
index 367114b83f5..44b6938a6fd 100644
--- a/lisp/tooltip.el
+++ b/lisp/tooltip.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -119,7 +119,8 @@ the value of `tooltip-y-offset' is ignored."
(defcustom tooltip-frame-parameters
'((name . "tooltip")
(internal-border-width . 2)
- (border-width . 1))
+ (border-width . 1)
+ (no-special-glyphs . t))
"Frame parameters used for tooltips.
If `left' or `top' parameters are included, they specify the absolute
@@ -130,7 +131,8 @@ of the `tooltip' face are used instead."
:type '(repeat (cons :format "%v"
(symbol :tag "Parameter")
(sexp :tag "Value")))
- :group 'tooltip)
+ :group 'tooltip
+ :version "26.1")
(defface tooltip
'((((class color))
@@ -153,6 +155,18 @@ This variable is obsolete; instead of setting it to t, disable
(make-obsolete-variable 'tooltip-use-echo-area
"disable Tooltip mode instead" "24.1" 'set)
+(defcustom tooltip-resize-echo-area nil
+ "If non-nil, using the echo area for tooltips will resize the echo area.
+By default, when the echo area is used for displaying tooltips,
+the tooltip text is truncated if it exceeds a single screen line.
+When this variable is non-nil, the text is not truncated; instead,
+the echo area is resized as needed to accommodate the full text
+of the tooltip.
+This variable has effect only on GUI frames."
+ :type 'boolean
+ :group 'tooltip
+ :version "27.1")
+
;;; Variables that are not customizable.
@@ -345,7 +359,8 @@ It is also called if Tooltip mode is on, for text-only displays."
(current-message))))
(setq tooltip-previous-message (current-message)))
(setq tooltip-help-message help)
- (let ((message-truncate-lines t)
+ (let ((message-truncate-lines
+ (or (not (display-graphic-p)) (not tooltip-resize-echo-area)))
(message-log-max nil))
(message "%s" help)))
((stringp tooltip-previous-message)
diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el
index 6baf4c47215..9599cc7f067 100644
--- a/lisp/tree-widget.el
+++ b/lisp/tree-widget.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -504,7 +504,7 @@ Handle mouse button 1 click on buttons.")
(define-widget 'tree-widget-end-guide 'item
"End of a vertical guide line."
- :tag " `"
+ :tag " \\=`"
;;:tag-glyph (tree-widget-find-image "end-guide")
:format "%t"
)
diff --git a/lisp/tutorial.el b/lisp/tutorial.el
index 785dbdfd189..7823f76a793 100644
--- a/lisp/tutorial.el
+++ b/lisp/tutorial.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/type-break.el b/lisp/type-break.el
index 8cb81d496ee..35b0efe65b1 100644
--- a/lisp/type-break.el
+++ b/lisp/type-break.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -376,7 +376,7 @@ problems."
(if (and type-break-time-last-break
(< (setq diff (type-break-time-difference
type-break-time-last-break
- (current-time)))
+ nil))
type-break-interval))
;; Use the file's value.
(progn
@@ -563,7 +563,7 @@ as per the function `type-break-schedule'."
(cond
(good-interval
(let ((break-secs (type-break-time-difference
- start-time (current-time))))
+ start-time nil)))
(cond
((>= break-secs good-interval)
(setq continue nil))
@@ -624,7 +624,7 @@ INTERVAL is the full length of an interval (defaults to TIME)."
type-break-time-warning-intervals))
(or time
- (setq time (type-break-time-difference (current-time)
+ (setq time (type-break-time-difference nil
type-break-time-next-break)))
(while (and type-break-current-time-warning-interval
@@ -685,7 +685,7 @@ keystroke threshold has been exceeded."
(and type-break-good-rest-interval
(progn
(and (> (type-break-time-difference
- type-break-time-last-command (current-time))
+ type-break-time-last-command nil)
type-break-good-rest-interval)
(progn
(type-break-keystroke-reset)
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index c6a50edc2c7..aa1fcd99cb4 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1
index 75be6af62a3..5d6a68e563e 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -2403,7 +2403,7 @@
(file-symlink-p): Ditto.
(url-insert-file-contents): If `visit' is non-nil then make sure
we set buffer-file-name. After these changes you can visit
- http://www.gnu.org/ directly from the minibuffer.
+ https://www.gnu.org/ directly from the minibuffer.
(url-insert-file-contents): When inserting the file contents,
use a save-excursion so that we behave just like the original.
@@ -3084,4 +3084,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el
index c98e076ffa4..f0860e570a2 100644
--- a/lisp/url/url-about.el
+++ b/lisp/url/url-about.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 2885d4e12e2..65c718ea128 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el
index a7247dfe10a..963dfd531e2 100644
--- a/lisp/url/url-cache.el
+++ b/lisp/url/url-cache.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -206,7 +206,7 @@ If `url-standalone-mode' is non-nil, cached items never expire."
(time-add
cache-time
(seconds-to-time (or expire-time url-cache-expire-time)))
- (current-time))))))
+ nil)))))
(defun url-cache-prune-cache (&optional directory)
"Remove all expired files from the cache.
diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el
index 218ec0d6544..ce160c66774 100644
--- a/lisp/url/url-cid.el
+++ b/lisp/url/url-cid.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el
index 4912db6c53b..8045050c61e 100644
--- a/lisp/url/url-cookie.el
+++ b/lisp/url/url-cookie.el
@@ -1,4 +1,4 @@
-;;; url-cookie.el --- URL cookie support
+;;; url-cookie.el --- URL cookie support -*- lexical-binding:t -*-
;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc.
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -74,6 +74,55 @@ telling Microsoft that."
;; It's completely normal for the cookies file not to exist yet.
(load (or fname url-cookie-file) t t))
+(defun url-cookie-parse-file-netscape (filename &optional long-session)
+ "Load cookies from FILENAME in Netscape/Mozilla format.
+When LONG-SESSION is non-nil, session cookies (expiring at t=0
+i.e. 1970-1-1) are loaded as expiring one year from now instead."
+ (interactive "fLoad Netscape/Mozilla cookie file: ")
+ (let ((n 0))
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (goto-char (point-min))
+ (when (not (looking-at-p "# Netscape HTTP Cookie File\n"))
+ (error (format "File %s doesn't look like a netscape cookie file" filename)))
+ (while (not (eobp))
+ (when (not (looking-at-p (rx bol (* space) "#")))
+ (let* ((line (buffer-substring (point) (save-excursion (end-of-line) (point))))
+ (fields (split-string line "\t")))
+ (cond
+ ;;((>= 1 (length line) 0)
+ ;; (message "skipping empty line"))
+ ((= (length fields) 7)
+ (let ((dom (nth 0 fields))
+ ;; (match (nth 1 fields))
+ (path (nth 2 fields))
+ (secure (string= (nth 3 fields) "TRUE"))
+ ;; session cookies (expire time = 0) are supposed
+ ;; to be removed when the browser is closed, but
+ ;; the main point of loading external cookie is to
+ ;; reuse a browser session, so to prevent the
+ ;; cookie from being detected as expired straight
+ ;; away, make it expire a year from now
+ (expires (format-time-string
+ "%d %b %Y %T [GMT]"
+ (seconds-to-time
+ (let ((s (string-to-number (nth 4 fields))))
+ (if (and (= s 0) long-session)
+ (seconds-to-time (+ (* 365 24 60 60) (float-time)))
+ s)))))
+ (key (nth 5 fields))
+ (val (nth 6 fields)))
+ (cl-incf n)
+ ;;(message "adding <%s>=<%s> exp=<%s> dom=<%s> path=<%s> sec=%S" key val expires dom path secure)
+ (url-cookie-store key val expires dom path secure)
+ ))
+ (t
+ (message "ignoring malformed cookie line <%s>" line)))))
+ (forward-line))
+ (when (< 0 n)
+ (setq url-cookies-changed-since-last-save t))
+ (message "added %d cookies from file %s" n filename))))
+
(defun url-cookie-clean-up (&optional secure)
(let ((var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
new new-cookies)
@@ -161,7 +210,7 @@ telling Microsoft that."
(let ((exp (url-cookie-expires cookie)))
(and (> (length exp) 0)
(condition-case ()
- (> (float-time) (float-time (date-to-time exp)))
+ (time-less-p (date-to-time exp) nil)
(error nil)))))
(defun url-cookie-retrieve (host &optional localpart secure)
@@ -227,25 +276,21 @@ telling Microsoft that."
:group 'url-cookie)
(defun url-cookie-host-can-set-p (host domain)
- (let ((last nil)
- (case-fold-search t))
- (cond
- ((string= host domain) ; Apparently netscape lets you do this
- t)
- ((zerop (length domain))
- nil)
- (t
- ;; Remove the dot from wildcard domains before matching.
- (when (eq ?. (aref domain 0))
- (setq domain (substring domain 1)))
- (and (url-domsuf-cookie-allowed-p domain)
- ;; Need to check and make sure the host is actually _in_ the
- ;; domain it wants to set a cookie for though.
- (string-match (concat (regexp-quote domain) "$") host))))))
+ (cond
+ ((string= host domain) ; Apparently netscape lets you do this
+ t)
+ ((zerop (length domain))
+ nil)
+ (t
+ ;; Remove the dot from wildcard domains before matching.
+ (when (eq ?. (aref domain 0))
+ (setq domain (substring domain 1)))
+ (and (url-domsuf-cookie-allowed-p domain)
+ (string-suffix-p domain host 'ignore-case)))))
(defun url-cookie-handle-set-cookie (str)
(setq url-cookies-changed-since-last-save t)
- (let* ((args (url-parse-args str t))
+ (let* ((args (nreverse (url-parse-args str t)))
(case-fold-search t)
(secure (and (assoc-string "secure" args t) t))
(domain (or (cdr-safe (assoc-string "domain" args t))
@@ -253,44 +298,16 @@ telling Microsoft that."
(current-url (url-view-url t))
(trusted url-cookie-trusted-urls)
(untrusted url-cookie-untrusted-urls)
- (expires (cdr-safe (assoc-string "expires" args t)))
+ (max-age (cdr-safe (assoc-string "max-age" args t)))
(localpart (or (cdr-safe (assoc-string "path" args t))
(file-name-directory
(url-filename url-current-object))))
- (rest nil))
- (dolist (this args)
- (or (member (downcase (car this)) '("secure" "domain" "expires" "path"))
- (setq rest (cons this rest))))
-
- ;; Sometimes we get dates that the timezone package cannot handle very
- ;; gracefully - take care of this here, instead of in url-cookie-expired-p
- ;; to speed things up.
- (and expires
- (string-match
- (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
- "\\(..:..:..\\) +\\[*\\([^]]+\\)\\]*$")
- expires)
- (setq expires (concat (match-string 1 expires) " "
- (match-string 2 expires) " "
- (match-string 3 expires) " "
- (match-string 4 expires) " ["
- (match-string 5 expires) "]")))
-
- ;; This one is for older Emacs/XEmacs variants that don't
- ;; understand this format without tenths of a second in it.
- ;; Wednesday, 30-Dec-2037 16:00:00 GMT
- ;; - vs -
- ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
- (and expires
- (string-match
- "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
- expires)
- (setq expires (concat (match-string 1 expires) "-" ; day
- (match-string 2 expires) "-" ; month
- (match-string 3 expires) " " ; year
- (match-string 4 expires) ".00 " ; hour:minutes:seconds
- (match-string 6 expires)))) ":" ; timezone
-
+ (expires nil))
+ (if (and max-age (string-match "\\`-?[0-9]+\\'" max-age))
+ (setq expires (format-time-string "%a %b %d %H:%M:%S %Y GMT"
+ (time-add nil (read max-age))
+ t))
+ (setq expires (cdr-safe (assoc-string "expires" args t))))
(while (consp trusted)
(if (string-match (car trusted) current-url)
(setq trusted (- (match-end 0) (match-beginning 0)))
@@ -314,8 +331,9 @@ telling Microsoft that."
(not trusted)
(save-window-excursion
(with-output-to-temp-buffer "*Cookie Warning*"
- (dolist (x rest)
- (princ (format "%s - %s" (car x) (cdr x)))))
+ (princ (format "%s=\"%s\"\n" (caar args) (cdar args)))
+ (dolist (x (cdr args))
+ (princ (format " %s=\"%s\"\n" (car x) (cdr x)))))
(prog1
(not (funcall url-confirmation-func
(format "Allow %s to set these cookies? "
@@ -326,8 +344,8 @@ telling Microsoft that."
nil)
((url-cookie-host-can-set-p (url-host url-current-object) domain)
;; Cookie is accepted by the user, and passes our security checks.
- (dolist (cur rest)
- (url-cookie-store (car cur) (cdr cur) expires domain localpart secure)))
+ (url-cookie-store (caar args) (cdar args)
+ expires domain localpart secure))
(t
(url-lazy-message "%s tried to set a cookie for domain %s - rejected."
(url-host url-current-object) domain)))))
@@ -380,8 +398,8 @@ instead delete all cookies that do not match REGEXP."
"Display a buffer listing the current URL cookies, if there are any.
Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies."
(interactive)
- (when (and (null url-cookie-secure-storage)
- (null url-cookie-storage))
+ (unless (or url-cookie-secure-storage
+ url-cookie-storage)
(error "No cookies are defined"))
(pop-to-buffer "*url cookies*")
@@ -442,20 +460,13 @@ Use \\<url-cookie-mode-map>\\[url-cookie-delete] to remove cookies."
(forward-line 1)
(point)))))
-(defun url-cookie-quit ()
- "Kill the current buffer."
- (interactive)
- (kill-buffer (current-buffer)))
-
(defvar url-cookie-mode-map
(let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (define-key map "q" 'url-cookie-quit)
(define-key map [delete] 'url-cookie-delete)
(define-key map [(control k)] 'url-cookie-delete)
map))
-(define-derived-mode url-cookie-mode nil "URL Cookie"
+(define-derived-mode url-cookie-mode special-mode "URL Cookie"
"Mode for listing cookies.
\\{url-cookie-mode-map}"
diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el
index 59b836ca6d1..ba20d675466 100644
--- a/lisp/url/url-dav.el
+++ b/lisp/url/url-dav.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;; DAV is in RFC 2518.
diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el
index f7ed13c45b4..53df2bf7bb4 100644
--- a/lisp/url/url-dired.el
+++ b/lisp/url/url-dired.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el
index b24f24531a6..e0ebba46fb9 100644
--- a/lisp/url/url-domsuf.el
+++ b/lisp/url/url-domsuf.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el
index 9ceaa025fb3..04f06c367ee 100644
--- a/lisp/url/url-expand.el
+++ b/lisp/url/url-expand.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -60,7 +60,7 @@
"Convert URL to a fully specified URL, and canonicalize it.
Second arg DEFAULT is a URL to start with if URL is relative.
If DEFAULT is nil or missing, the current buffer's URL is used.
-Path components that are `.' are removed, and
+Path components that are `.' are removed, and
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
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 1dda1d3325d..0252896b748 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el
index da2fbde49c9..baae0a7ec47 100644
--- a/lisp/url/url-ftp.el
+++ b/lisp/url/url-ftp.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el
index 5394eb0e5ef..abf30041027 100644
--- a/lisp/url/url-future.el
+++ b/lisp/url/url-future.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el
index 28acde64203..c1c08259e38 100644
--- a/lisp/url/url-gw.el
+++ b/lisp/url/url-gw.el
@@ -19,11 +19,12 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'url-vars)
+(require 'url-parse)
;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
@@ -245,8 +246,9 @@ overriding the value of `url-gateway-method'."
name buffer host service
:type gw-method
;; Use non-blocking socket if we can.
- :nowait (featurep 'make-network-process
- '(:nowait t))))
+ :nowait (and (featurep 'make-network-process)
+ (url-asynchronous url-current-object)
+ '(:nowait t))))
(`socks
(socks-open-network-stream name buffer host service))
(`telnet
diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el
index ba3062308ec..55a478ad034 100644
--- a/lisp/url/url-handlers.el
+++ b/lisp/url/url-handlers.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -341,7 +341,7 @@ if it had been inserted from a file named URL."
(unless buffer (signal 'file-error (list url "No Data")))
(with-current-buffer buffer
;; XXX: This is HTTP/S specific and should be moved to url-http
- ;; instead. See http://debbugs.gnu.org/17549.
+ ;; instead. See https://debbugs.gnu.org/17549.
(when (bound-and-true-p url-http-response-status)
;; Don't signal an error if VISIT is non-nil, because
;; 'insert-file-contents' doesn't. This is required to
@@ -354,7 +354,7 @@ if it had been inserted from a file named URL."
(< url-http-response-status 300)))
(let ((desc (nth 2 (assq url-http-response-status url-http-codes))))
(kill-buffer buffer)
- ;; Signal file-error per http://debbugs.gnu.org/16733.
+ ;; Signal file-error per https://debbugs.gnu.org/16733.
(signal 'file-error (list url desc))))))
(url-insert-buffer-contents buffer url visit beg end replace)))
diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el
index 1fa085400d8..fc1b4991039 100644
--- a/lisp/url/url-history.el
+++ b/lisp/url/url-history.el
@@ -1,4 +1,4 @@
-;;; url-history.el --- Global history tracking for URL package
+;;; url-history.el --- Global history tracking for URL package -*- lexical-binding:t -*-
;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc.
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -106,7 +106,7 @@ to run the `url-history-setup-save-timer' function manually."
(defun url-history-update-url (url time)
(setq url-history-changed-since-last-save t)
- (puthash (if (vectorp url) (url-recreate-url url) url) time
+ (puthash (if (url-p url) (url-recreate-url url) url) time
url-history-hash-table))
(autoload 'url-make-private-file "url-util")
@@ -157,6 +157,7 @@ user for what type to save as."
(gethash url url-history-hash-table nil))
(defun url-completion-function (string predicate function)
+ (declare (obsolete url-history-hash-table "26.1"))
;; Completion function to complete urls from the history.
;; This is obsolete since we can now pass the hash-table directly as a
;; completion table.
@@ -164,7 +165,7 @@ user for what type to save as."
(cond
((eq function nil)
(let ((list nil))
- (maphash (lambda (key val) (push key list))
+ (maphash (lambda (key _) (push key list))
url-history-hash-table)
;; Not sure why we bother reversing the list. --Stef
(try-completion string (nreverse list) predicate)))
@@ -172,7 +173,7 @@ user for what type to save as."
(let ((stub (concat "\\`" (regexp-quote string)))
(retval nil))
(maphash
- (lambda (url time)
+ (lambda (url _)
(if (string-match stub url) (push url retval)))
url-history-hash-table)
retval))
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 06d32861b2e..51f158e5c21 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1249,6 +1249,9 @@ The return value of this function is the retrieval buffer."
(nsm-noninteractive (or url-request-noninteractive
(and (boundp 'url-http-noninteractive)
url-http-noninteractive)))
+ ;; The following binding is needed in url-open-stream, which
+ ;; is called from url-http-find-free-connection.
+ (url-current-object url)
(connection (url-http-find-free-connection (url-host url)
(url-port url)
gateway-method))
diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el
index b8fe4ed5ff7..6384ba60fc3 100644
--- a/lisp/url/url-imap.el
+++ b/lisp/url/url-imap.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 1d0a46ec2c2..5a268aa3329 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index d9a18e554fa..c23a55f353d 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el
index 8c49546aef6..c83a1d65738 100644
--- a/lisp/url/url-mailto.el
+++ b/lisp/url/url-mailto.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -102,7 +102,7 @@
(goto-char (point-min))
(or (search-forward (concat "\n" mail-header-separator "\n") nil t)
(goto-char (point-max)))
- (insert (mapconcat
+ (insert (mapconcat
#'(lambda (string)
(replace-regexp-in-string "\r\n" "\n" string))
(cdar args) "\n")))
diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el
index 9f41f35cb84..00b2572421d 100644
--- a/lisp/url/url-methods.el
+++ b/lisp/url/url-methods.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el
index 3515febba20..a5422bbd604 100644
--- a/lisp/url/url-misc.el
+++ b/lisp/url/url-misc.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el
index 5130b0c93be..c6e056298f2 100644
--- a/lisp/url/url-news.el
+++ b/lisp/url/url-news.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el
index 898d304be64..d8e68fce035 100644
--- a/lisp/url/url-nfs.el
+++ b/lisp/url/url-nfs.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el
index ada716df60e..dcbdf6242bd 100644
--- a/lisp/url/url-ns.el
+++ b/lisp/url/url-ns.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 4738163f0bc..4f6ab6bd955 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -36,7 +36,8 @@
target attributes fullness))
(:copier nil))
type user password host portspec filename target attributes fullness
- silent (use-cookies t))
+ silent (use-cookies t)
+ (asynchronous t))
(defsubst url-port (urlobj)
"Return the port number for the URL specified by URLOBJ.
diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el
index 90dfb275132..ab9a6a6b35d 100644
--- a/lisp/url/url-privacy.el
+++ b/lisp/url/url-privacy.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el
index 790cb472b0b..706cb689e4b 100644
--- a/lisp/url/url-proxy.el
+++ b/lisp/url/url-proxy.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index dd1699bd082..84da6f60260 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -177,7 +177,7 @@ The variable `url-queue-timeout' sets a timeout."
(with-current-buffer
(if (and (bufferp (url-queue-buffer job))
(buffer-live-p (url-queue-buffer job)))
- ;; Use the (partially filled) process buffer it it exists.
+ ;; Use the (partially filled) process buffer if it exists.
(url-queue-buffer job)
;; If not, just create a new buffer, which will probably be
;; killed again by the caller.
diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el
index 50bfa7c499e..f4149ddb967 100644
--- a/lisp/url/url-tramp.el
+++ b/lisp/url/url-tramp.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -37,33 +37,41 @@ They must also be covered by `url-handler-regexp'."
:type '(repeat string))
(defun url-tramp-convert-url-to-tramp (url)
- "Convert URL to a Tramp file name."
- (let ((obj (url-generic-parse-url (and (stringp url) url))))
- (if (member (url-type obj) url-tramp-protocols)
- (progn
- (if (url-password obj)
- (password-cache-add
- (tramp-make-tramp-file-name
- (url-type obj) (url-user obj) (url-host obj) "")
- (url-password obj))
- (tramp-make-tramp-file-name
- (url-type obj) (url-user obj) (url-host obj) (url-filename obj))))
- url)))
+ "Convert URL to a Tramp file name.
+If URL contains a password, it will be added to the `password-data' cache.
+In case URL is not convertible, nil is returned."
+ (let* ((obj (url-generic-parse-url (and (stringp url) url)))
+ (port
+ (and (natnump (url-portspec obj))
+ (number-to-string (url-portspec obj)))))
+ (when (member (url-type obj) url-tramp-protocols)
+ (when (url-password obj)
+ (password-cache-add
+ (tramp-make-tramp-file-name
+ (url-type obj) (url-user obj) nil
+ (url-host obj) port "")
+ (url-password obj)))
+ (tramp-make-tramp-file-name
+ (url-type obj) (url-user obj) nil
+ (url-host obj) port (url-filename obj)))))
(defun url-tramp-convert-tramp-to-url (file)
- "Convert FILE, a Tramp file name, to a URL."
- (let ((obj (ignore-errors (tramp-dissect-file-name file))))
- (if (member (tramp-file-name-method obj) url-tramp-protocols)
- (url-recreate-url
- (url-parse-make-urlobj
- (tramp-file-name-method obj)
- (tramp-file-name-user obj)
- nil ; password.
- (tramp-file-name-host obj)
- nil ; port.
- (tramp-file-name-localname obj)
- nil nil t)) ; target attributes fullness.
- file)))
+ "Convert FILE, a Tramp file name, to a URL.
+In case FILE is not convertible, nil is returned."
+ (let* ((obj (ignore-errors (tramp-dissect-file-name file)))
+ (port
+ (and (stringp (tramp-file-name-port obj))
+ (string-to-number (tramp-file-name-port obj)))))
+ (when (member (tramp-file-name-method obj) url-tramp-protocols)
+ (url-recreate-url
+ (url-parse-make-urlobj
+ (tramp-file-name-method obj)
+ (tramp-file-name-user obj)
+ nil ; password.
+ (tramp-file-name-host obj)
+ port
+ (tramp-file-name-localname obj)
+ nil nil t))))) ; target attributes fullness.
;;;###autoload
(defun url-tramp-file-handler (operation &rest args)
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 9897dea9c7f..1d9e386bbc3 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -565,7 +565,7 @@ Has a preference for looking backward when not directly on a symbol."
(skip-chars-forward url-get-url-filename-chars))
(setq start (point)))
(setq url (buffer-substring-no-properties start (point))))
- (if (and url (string-match "^(.*)\\.?$" url))
+ (if (and url (string-match "^(\\(.*\\))\\.?$" url))
(setq url (match-string 1 url)))
(if (and url (string-match "^URL:" url))
(setq url (substring url 4 nil)))
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index f08779f6950..14c5652d6c3 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/lisp/url/url.el b/lisp/url/url.el
index be6377ceb3a..36cd81bd70b 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -119,6 +119,8 @@ variable in the original buffer as a forwarding pointer.")
(defvar url-retrieve-number-of-calls 0)
(autoload 'url-cache-prune-cache "url-cache")
+(defvar url-asynchronous t
+ "Bind to nil before calling `url-retrieve' to signal :nowait connections.")
;;;###autoload
(defun url-retrieve (url callback &optional cbargs silent inhibit-cookies)
@@ -190,6 +192,7 @@ URL-encoded before it's used."
(unless (url-type url)
(error "Bad url: %s" (url-recreate-url url)))
(setf (url-silent url) silent)
+ (setf (url-asynchronous url) url-asynchronous)
(setf (url-use-cookies url) (not inhibit-cookies))
;; Once in a while, remove old entries from the URL cache.
(when (zerop (% url-retrieve-number-of-calls 1000))
@@ -232,6 +235,7 @@ how long to wait for a response before giving up."
(let ((retrieval-done nil)
(start-time (current-time))
+ (url-asynchronous nil)
(asynch-buffer nil))
(setq asynch-buffer
(url-retrieve url (lambda (&rest ignored)
@@ -255,8 +259,7 @@ how long to wait for a response before giving up."
;; process output.
(while (and (not retrieval-done)
(or (not timeout)
- (< (float-time (time-subtract
- (current-time) start-time))
+ (< (float-time (time-subtract nil start-time))
timeout)))
(url-debug 'retrieval
"Spinning in url-retrieve-synchronously: %S (%S)"
diff --git a/lisp/userlock.el b/lisp/userlock.el
index a8eb24bd100..1d45b3a4add 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index 91c69202dd5..392147b14d7 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el
index 11e84ae797f..f5571c6d115 100644
--- a/lisp/vc/compare-w.el
+++ b/lisp/vc/compare-w.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el
index c170809f057..770791a3c09 100644
--- a/lisp/vc/cvs-status.el
+++ b/lisp/vc/cvs-status.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index aa8d77882ec..df9627abdf0 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -432,7 +432,7 @@ and the face `diff-added' for added lines.")
"If non-nil, empty lines are valid in unified diffs.
Some versions of diff replace all-blank context lines in unified format with
empty lines. This makes the format less robust, but is tolerated.
-See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg01990.html")
+See https://lists.gnu.org/r/emacs-devel/2007-11/msg01990.html")
(defconst diff-hunk-header-re
(concat "^\\(?:" diff-hunk-header-re-unified ".*\\|\\*\\{15\\}.*\n\\*\\*\\* .+ \\*\\*\\*\\*\\|[0-9]+\\(,[0-9]+\\)?[acd][0-9]+\\(,[0-9]+\\)?\\)$"))
@@ -875,51 +875,53 @@ PREFIX is only used internally: don't use it."
(set (make-local-variable 'diff-remembered-defdir) default-directory)
(set (make-local-variable 'diff-remembered-files-alist) nil))
(save-excursion
- (unless (looking-at diff-file-header-re)
- (or (ignore-errors (diff-beginning-of-file))
- (re-search-forward diff-file-header-re nil t)))
- (let ((fs (diff-hunk-file-names old)))
- (if prefix (setq fs (mapcar (lambda (f) (concat prefix f)) fs)))
- (or
- ;; use any previously used preference
- (cdr (assoc fs diff-remembered-files-alist))
- ;; try to be clever and use previous choices as an inspiration
- (cl-dolist (rf diff-remembered-files-alist)
- (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
- (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
- ;; look for each file in turn. If none found, try again but
- ;; ignoring the first level of directory, ...
- (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
- (file nil nil))
- ((or (null files)
- (setq file (cl-do* ((files files (cdr files))
- (file (car files) (car files)))
- ;; Use file-regular-p to avoid
- ;; /dev/null, directories, etc.
- ((or (null file) (file-regular-p file))
- file))))
- file))
- ;; <foo>.rej patches implicitly apply to <foo>
- (and (string-match "\\.rej\\'" (or buffer-file-name ""))
- (let ((file (substring buffer-file-name 0 (match-beginning 0))))
- (when (file-exists-p file) file)))
- ;; If we haven't found the file, maybe it's because we haven't paid
- ;; attention to the PCL-CVS hint.
- (and (not prefix)
- (boundp 'cvs-pcl-cvs-dirchange-re)
- (save-excursion
- (re-search-backward cvs-pcl-cvs-dirchange-re nil t))
- (diff-find-file-name old noprompt (match-string 1)))
- ;; if all else fails, ask the user
- (unless noprompt
- (let ((file (expand-file-name (or (car fs) ""))))
- (setq file
- (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))
- file))))))
+ (save-restriction
+ (widen)
+ (unless (looking-at diff-file-header-re)
+ (or (ignore-errors (diff-beginning-of-file))
+ (re-search-forward diff-file-header-re nil t)))
+ (let ((fs (diff-hunk-file-names old)))
+ (if prefix (setq fs (mapcar (lambda (f) (concat prefix f)) fs)))
+ (or
+ ;; use any previously used preference
+ (cdr (assoc fs diff-remembered-files-alist))
+ ;; try to be clever and use previous choices as an inspiration
+ (cl-dolist (rf diff-remembered-files-alist)
+ (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf))))
+ (if (and newfile (file-exists-p newfile)) (cl-return newfile))))
+ ;; look for each file in turn. If none found, try again but
+ ;; ignoring the first level of directory, ...
+ (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files)))
+ (file nil nil))
+ ((or (null files)
+ (setq file (cl-do* ((files files (cdr files))
+ (file (car files) (car files)))
+ ;; Use file-regular-p to avoid
+ ;; /dev/null, directories, etc.
+ ((or (null file) (file-regular-p file))
+ file))))
+ file))
+ ;; <foo>.rej patches implicitly apply to <foo>
+ (and (string-match "\\.rej\\'" (or buffer-file-name ""))
+ (let ((file (substring buffer-file-name 0 (match-beginning 0))))
+ (when (file-exists-p file) file)))
+ ;; If we haven't found the file, maybe it's because we haven't paid
+ ;; attention to the PCL-CVS hint.
+ (and (not prefix)
+ (boundp 'cvs-pcl-cvs-dirchange-re)
+ (save-excursion
+ (re-search-backward cvs-pcl-cvs-dirchange-re nil t))
+ (diff-find-file-name old noprompt (match-string 1)))
+ ;; if all else fails, ask the user
+ (unless noprompt
+ (let ((file (expand-file-name (or (car fs) ""))))
+ (setq file
+ (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))
+ file)))))))
(defun diff-ediff-patch ()
diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el
index 7fdd1037322..a267908cec9 100644
--- a/lisp/vc/diff.el
+++ b/lisp/vc/diff.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index b957bdce4f7..f36d0180044 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el
index 339d3a513b6..3df0dc72547 100644
--- a/lisp/vc/ediff-help.el
+++ b/lisp/vc/ediff-help.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el
index 37f8ef55a28..6a65f0d970d 100644
--- a/lisp/vc/ediff-hook.el
+++ b/lisp/vc/ediff-hook.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el
index 59d97c3cea5..21d040d1e54 100644
--- a/lisp/vc/ediff-init.el
+++ b/lisp/vc/ediff-init.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el
index d91d04467e3..39cf44d67d3 100644
--- a/lisp/vc/ediff-merg.el
+++ b/lisp/vc/ediff-merg.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el
index 5bf94a56351..4ed6661dee0 100644
--- a/lisp/vc/ediff-mult.el
+++ b/lisp/vc/ediff-mult.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 6c8e925d2b9..d80db5c04ce 100644
--- a/lisp/vc/ediff-ptch.el
+++ b/lisp/vc/ediff-ptch.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index bcf446a64ce..3430d046c0c 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index efd8e93c4b7..134b41d41c2 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el
index 31dcf3b69f9..79ccc6d32db 100644
--- a/lisp/vc/ediff-wind.el
+++ b/lisp/vc/ediff-wind.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -64,10 +64,10 @@
(defun ediff-choose-window-setup-function-automatically ()
(declare (obsolete ediff-setup-windows-default "24.3"))
(if (ediff-window-display-p)
- 'ediff-setup-windows-multiframe
- 'ediff-setup-windows-plain))
+ #'ediff-setup-windows-multiframe
+ #'ediff-setup-windows-plain))
-(defcustom ediff-window-setup-function 'ediff-setup-windows-default
+(defcustom ediff-window-setup-function #'ediff-setup-windows-default
"Function called to set up windows.
Ediff provides a choice of three functions:
(1) `ediff-setup-windows-multiframe', which sets the control panel
@@ -132,7 +132,7 @@ provided functions are written."
(Ancestor . ediff-window-Ancestor)))
-(defcustom ediff-split-window-function 'split-window-vertically
+(defcustom ediff-split-window-function #'split-window-vertically
"The function used to split the main window between buffer-A and buffer-B.
You can set it to a horizontal split instead of the default vertical split
by setting this variable to `split-window-horizontally'.
@@ -145,7 +145,7 @@ In this case, Ediff will use those frames to display these buffers."
function)
:group 'ediff-window)
-(defcustom ediff-merge-split-window-function 'split-window-horizontally
+(defcustom ediff-merge-split-window-function #'split-window-horizontally
"The function used to split the main window between buffer-A and buffer-B.
You can set it to a vertical split instead of the default horizontal split
by setting this variable to `split-window-vertically'.
@@ -181,6 +181,8 @@ In this case, Ediff will use those frames to display these buffers."
'(visibility . nil)
;; make initial frame small to avoid distraction
'(width . 1) '(height . 1)
+ ;; Fullscreen control frames don't make sense (Bug#29026).
+ '(fullscreen . nil)
;; this blocks queries from window manager as to where to put
;; ediff's control frame. we put the frame outside the display,
;; so the initial frame won't jump all over the screen
@@ -210,7 +212,7 @@ responsibility."
:type 'boolean
:group 'ediff-window)
-(defcustom ediff-control-frame-position-function 'ediff-make-frame-position
+(defcustom ediff-control-frame-position-function #'ediff-make-frame-position
"Function to call to determine the desired location for the control panel.
Expects three parameters: the control buffer, the desired width and height
of the control frame. It returns an association list
@@ -258,7 +260,7 @@ customization of the default."
display off.")
(ediff-defvar-local ediff-wide-display-frame nil
"Frame to be used for wide display.")
-(ediff-defvar-local ediff-make-wide-display-function 'ediff-make-wide-display
+(ediff-defvar-local ediff-make-wide-display-function #'ediff-make-wide-display
"The value is a function that is called to create a wide display.
The function is called without arguments. It should resize the frame in
which buffers A, B, and C are to be displayed, and it should save the old
@@ -334,11 +336,11 @@ into icons, regardless of the window manager."
;; in case user did a no-no on a tty
(or (ediff-window-display-p)
- (setq ediff-window-setup-function 'ediff-setup-windows-plain))
+ (setq ediff-window-setup-function #'ediff-setup-windows-plain))
(or (ediff-keep-window-config control-buffer)
(funcall
- (ediff-with-current-buffer control-buffer ediff-window-setup-function)
+ (with-current-buffer control-buffer ediff-window-setup-function)
buffer-A buffer-B buffer-C control-buffer))
(run-hooks 'ediff-after-setup-windows-hook))
@@ -352,7 +354,7 @@ into icons, regardless of the window manager."
;; Usually used without windowing systems
;; With windowing, we want to use dedicated frames.
(defun ediff-setup-windows-plain (buffer-A buffer-B buffer-C control-buffer)
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq ediff-multiframe nil))
(if ediff-merge-job
(ediff-setup-windows-plain-merge
@@ -366,14 +368,14 @@ into icons, regardless of the window manager."
;; skip dedicated and unsplittable frames
(ediff-destroy-control-frame control-buffer)
(let ((window-min-height 1)
- (with-Ancestor-p (ediff-with-current-buffer control-buffer
+ (with-Ancestor-p (with-current-buffer control-buffer
ediff-merge-with-ancestor-job))
split-window-function
merge-window-share merge-window-lines
- (buf-Ancestor (ediff-with-current-buffer control-buffer
+ (buf-Ancestor (with-current-buffer control-buffer
ediff-ancestor-buffer))
wind-A wind-B wind-C wind-Ancestor)
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq merge-window-share ediff-merge-window-share
;; this lets us have local versions of ediff-split-window-function
split-window-function ediff-split-window-function))
@@ -417,7 +419,7 @@ into icons, regardless of the window manager."
(switch-to-buffer buf-B)
(setq wind-B (selected-window))
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C
@@ -436,7 +438,7 @@ into icons, regardless of the window manager."
split-window-function wind-width-or-height
three-way-comparison
wind-A-start wind-B-start wind-A wind-B wind-C)
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq wind-A-start (ediff-overlay-start
(ediff-get-value-according-to-buffer-type
'A ediff-narrow-bounds))
@@ -462,7 +464,7 @@ into icons, regardless of the window manager."
(setq wind-A (selected-window))
(if three-way-comparison
(setq wind-width-or-height
- (/ (if (eq split-window-function 'split-window-vertically)
+ (/ (if (eq split-window-function #'split-window-vertically)
(window-height wind-A)
(window-width wind-A))
3)))
@@ -487,7 +489,7 @@ into icons, regardless of the window manager."
(switch-to-buffer buf-C)
(setq wind-C (selected-window))))
- (ediff-with-current-buffer control-buffer
+ (with-current-buffer control-buffer
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C))
@@ -506,23 +508,23 @@ into icons, regardless of the window manager."
;; dispatch an appropriate window setup function
(defun ediff-setup-windows-multiframe (buf-A buf-B buf-C control-buf)
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq ediff-multiframe t))
(if ediff-merge-job
(ediff-setup-windows-multiframe-merge buf-A buf-B buf-C control-buf)
(ediff-setup-windows-multiframe-compare buf-A buf-B buf-C control-buf)))
(defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf)
-;;; Algorithm:
-;;; 1. Never use frames that have dedicated windows in them---it is bad to
-;;; destroy dedicated windows.
-;;; 2. If A and B are in the same frame but C's frame is different--- use one
-;;; frame for A and B and use a separate frame for C.
-;;; 3. If C's frame is non-existent, then: if the first suitable
-;;; non-dedicated frame is different from A&B's, then use it for C.
-;;; Otherwise, put A,B, and C in one frame.
-;;; 4. If buffers A, B, C are is separate frames, use them to display these
-;;; buffers.
+ ;; Algorithm:
+ ;; 1. Never use frames that have dedicated windows in them---it is bad to
+ ;; destroy dedicated windows.
+ ;; 2. If A and B are in the same frame but C's frame is different--- use one
+ ;; frame for A and B and use a separate frame for C.
+ ;; 3. If C's frame is non-existent, then: if the first suitable
+ ;; non-dedicated frame is different from A&B's, then use it for C.
+ ;; Otherwise, put A,B, and C in one frame.
+ ;; 4. If buffers A, B, C are is separate frames, use them to display these
+ ;; buffers.
;; Skip dedicated or iconified frames.
;; Unsplittable frames are taken care of later.
@@ -532,7 +534,7 @@ into icons, regardless of the window manager."
(wind-A (ediff-get-visible-buffer-window buf-A))
(wind-B (ediff-get-visible-buffer-window buf-B))
(wind-C (ediff-get-visible-buffer-window buf-C))
- (buf-Ancestor (ediff-with-current-buffer control-buf
+ (buf-Ancestor (with-current-buffer control-buf
ediff-ancestor-buffer))
(wind-Ancestor (ediff-get-visible-buffer-window buf-Ancestor))
(frame-A (if wind-A (window-frame wind-A)))
@@ -541,10 +543,10 @@ into icons, regardless of the window manager."
(frame-Ancestor (if wind-Ancestor (window-frame wind-Ancestor)))
;; on wide display, do things in one frame
(force-one-frame
- (ediff-with-current-buffer control-buf ediff-wide-display-p))
+ (with-current-buffer control-buf ediff-wide-display-p))
;; this lets us have local versions of ediff-split-window-function
(split-window-function
- (ediff-with-current-buffer control-buf ediff-split-window-function))
+ (with-current-buffer control-buf ediff-split-window-function))
(orig-wind (selected-window))
(orig-frame (selected-frame))
(use-same-frame (or force-one-frame
@@ -566,11 +568,11 @@ into icons, regardless of the window manager."
;; use-same-frame-for-AB implies wind A and B are ok for display
(use-same-frame-for-AB (and (not use-same-frame)
(eq frame-A frame-B)))
- (merge-window-share (ediff-with-current-buffer control-buf
+ (merge-window-share (with-current-buffer control-buf
ediff-merge-window-share))
merge-window-lines
designated-minibuffer-frame ; ediff-merge-with-ancestor-job
- (with-Ancestor-p (ediff-with-current-buffer control-buf
+ (with-Ancestor-p (with-current-buffer control-buf
ediff-merge-with-ancestor-job))
(done-Ancestor (not with-Ancestor-p))
done-A done-B done-C)
@@ -724,7 +726,7 @@ into icons, regardless of the window manager."
(switch-to-buffer buf-Ancestor)
(setq wind-Ancestor (selected-window))))
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C
@@ -738,21 +740,17 @@ into icons, regardless of the window manager."
;; Window setup for all comparison jobs, including 3way comparisons
(defun ediff-setup-windows-multiframe-compare (buf-A buf-B buf-C control-buf)
-;;; Algorithm:
-;;; If a buffer is seen in a frame, use that frame for that buffer.
-;;; If it is not seen, use the current frame.
-;;; If both buffers are not seen, they share the current frame. If one
-;;; of the buffers is not seen, it is placed in the current frame (where
-;;; ediff started). If that frame is displaying the other buffer, it is
-;;; shared between the two buffers.
-;;; However, if we decide to put both buffers in one frame
-;;; and the selected frame isn't splittable, we create a new frame and
-;;; put both buffers there, event if one of this buffers is visible in
-;;; another frame.
-
- ;; Skip dedicated or iconified frames.
- ;; Unsplittable frames are taken care of later.
- (ediff-skip-unsuitable-frames 'ok-unsplittable)
+ ;; Algorithm:
+ ;; If a buffer is seen in a frame, use that frame for that buffer.
+ ;; If it is not seen, use the current frame.
+ ;; If both buffers are not seen, they share the current frame. If one
+ ;; of the buffers is not seen, it is placed in the current frame (where
+ ;; ediff started). If that frame is displaying the other buffer, it is
+ ;; shared between the two buffers.
+ ;; However, if we decide to put both buffers in one frame
+ ;; and the selected frame isn't splittable, we create a new frame and
+ ;; put both buffers there, event if one of this buffers is visible in
+ ;; another frame.
(let* ((window-min-height 1)
(wind-A (ediff-get-visible-buffer-window buf-A))
@@ -761,17 +759,16 @@ into icons, regardless of the window manager."
(frame-A (if wind-A (window-frame wind-A)))
(frame-B (if wind-B (window-frame wind-B)))
(frame-C (if wind-C (window-frame wind-C)))
- (ctl-frame-exists-p (ediff-with-current-buffer control-buf
+ (ctl-frame-exists-p (with-current-buffer control-buf
(frame-live-p ediff-control-frame)))
;; on wide display, do things in one frame
(force-one-frame
- (ediff-with-current-buffer control-buf ediff-wide-display-p))
+ (with-current-buffer control-buf ediff-wide-display-p))
;; this lets us have local versions of ediff-split-window-function
(split-window-function
- (ediff-with-current-buffer control-buf ediff-split-window-function))
+ (with-current-buffer control-buf ediff-split-window-function))
(three-way-comparison
- (ediff-with-current-buffer control-buf ediff-3way-comparison-job))
- (orig-wind (selected-window))
+ (with-current-buffer control-buf ediff-3way-comparison-job))
(use-same-frame (or force-one-frame
(eq frame-A frame-B)
(not (ediff-window-ok-for-display wind-A))
@@ -790,10 +787,9 @@ into icons, regardless of the window manager."
(or ctl-frame-exists-p
(eq frame-B (selected-frame))))))
wind-A-start wind-B-start
- designated-minibuffer-frame
- done-A done-B done-C)
+ designated-minibuffer-frame)
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq wind-A-start (ediff-overlay-start
(ediff-get-value-according-to-buffer-type
'A ediff-narrow-bounds))
@@ -801,30 +797,6 @@ into icons, regardless of the window manager."
(ediff-get-value-according-to-buffer-type
'B ediff-narrow-bounds))))
- (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own
- (progn
- ;; buffer buf-A is seen in live wind-A
- (select-window wind-A) ; must be displaying buf-A
- (delete-other-windows)
- (setq wind-A (selected-window))
- (setq done-A t)))
-
- (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own
- (progn
- ;; buffer buf-B is seen in live wind-B
- (select-window wind-B) ; must be displaying buf-B
- (delete-other-windows)
- (setq wind-B (selected-window))
- (setq done-B t)))
-
- (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own
- (progn
- ;; buffer buf-C is seen in live wind-C
- (select-window wind-C) ; must be displaying buf-C
- (delete-other-windows)
- (setq wind-C (selected-window))
- (setq done-C t)))
-
(if use-same-frame
(let (wind-width-or-height) ; this affects 3way setups only
(if (and (eq frame-A frame-B) (frame-live-p frame-A))
@@ -838,7 +810,7 @@ into icons, regardless of the window manager."
(if three-way-comparison
(setq wind-width-or-height
(/
- (if (eq split-window-function 'split-window-vertically)
+ (if (eq split-window-function #'split-window-vertically)
(window-height wind-A)
(window-width wind-A))
3)))
@@ -855,46 +827,57 @@ into icons, regardless of the window manager."
(if (memq (selected-window) (list wind-A wind-B))
(other-window 1))
(switch-to-buffer buf-C)
- (setq wind-C (selected-window))))
- (setq done-A t
- done-B t
- done-C t)
- ))
-
- (or done-A ; Buf A to be set in its own frame
- ;;; or it was set before because use-same-frame = 1
- (progn
- ;; Buf-A was not set up yet as it wasn't visible,
- ;; and use-same-frame = nil
- (select-window orig-wind)
- (delete-other-windows)
- (switch-to-buffer buf-A)
- (setq wind-A (selected-window))
- ))
- (or done-B ; Buf B to be set in its own frame
- ;;; or it was set before because use-same-frame = 1
- (progn
- ;; Buf-B was not set up yet as it wasn't visible,
- ;; and use-same-frame = nil
- (select-window orig-wind)
- (delete-other-windows)
- (switch-to-buffer buf-B)
- (setq wind-B (selected-window))
- ))
-
- (if three-way-comparison
- (or done-C ; Buf C to be set in its own frame
- ;;; or it was set before because use-same-frame = 1
+ (setq wind-C (selected-window)))))
+
+ (if (window-live-p wind-A) ; buf-A on its own
+ (progn
+ ;; buffer buf-A is seen in live wind-A
+ (select-window wind-A) ; must be displaying buf-A
+ (delete-other-windows)
+ (setq wind-A (selected-window))) ;FIXME: Why?
+ ;; Buf-A was not set up yet as it wasn't visible,
+ ;; and use-same-frame = nil
+ ;; Skip dedicated or iconified frames.
+ ;; Unsplittable frames are taken care of later.
+ (ediff-skip-unsuitable-frames 'ok-unsplittable)
+ (delete-other-windows)
+ (switch-to-buffer buf-A)
+ (setq wind-A (selected-window)))
+
+ (if (window-live-p wind-B) ; buf B on its own
+ (progn
+ ;; buffer buf-B is seen in live wind-B
+ (select-window wind-B) ; must be displaying buf-B
+ (delete-other-windows)
+ (setq wind-B (selected-window))) ;FIXME: Why?
+ ;; Buf-B was not set up yet as it wasn't visible,
+ ;; and use-same-frame = nil
+ ;; Skip dedicated or iconified frames.
+ ;; Unsplittable frames are taken care of later.
+ (ediff-skip-unsuitable-frames 'ok-unsplittable)
+ (delete-other-windows)
+ (switch-to-buffer buf-B)
+ (setq wind-B (selected-window)))
+
+ (if (window-live-p wind-C) ; buf C on its own
+ (progn
+ ;; buffer buf-C is seen in live wind-C
+ (select-window wind-C) ; must be displaying buf-C
+ (delete-other-windows)
+ (setq wind-C (selected-window))) ;FIXME: Why?
+ (if three-way-comparison
(progn
;; Buf-C was not set up yet as it wasn't visible,
;; and use-same-frame = nil
- (select-window orig-wind)
+ ;; Skip dedicated or iconified frames.
+ ;; Unsplittable frames are taken care of later.
+ (ediff-skip-unsuitable-frames 'ok-unsplittable)
(delete-other-windows)
(switch-to-buffer buf-C)
(setq wind-C (selected-window))
- )))
+ ))))
- (ediff-with-current-buffer control-buf
+ (with-current-buffer control-buf
(setq ediff-window-A wind-A
ediff-window-B wind-B
ediff-window-C wind-C)
@@ -913,9 +896,9 @@ into icons, regardless of the window manager."
(ediff-setup-control-frame control-buf designated-minibuffer-frame)
))
-;; skip unsplittable frames and frames that have dedicated windows.
-;; create a new splittable frame if none is found
(defun ediff-skip-unsuitable-frames (&optional ok-unsplittable)
+ "Skip unsplittable frames and frames that have dedicated windows.
+create a new splittable frame if none is found."
(if (ediff-window-display-p)
(let ((wind-frame (window-frame))
seen-windows)
@@ -975,14 +958,14 @@ into icons, regardless of the window manager."
;; user-grabbed-mouse
fheight fwidth adjusted-parameters)
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(if (and (featurep 'xemacs) (featurep 'menubar))
(set-buffer-menubar nil))
;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse))
(run-hooks 'ediff-before-setup-control-frame-hook))
- (setq old-ctl-frame (ediff-with-current-buffer ctl-buffer ediff-control-frame))
- (ediff-with-current-buffer ctl-buffer
+ (setq old-ctl-frame (with-current-buffer ctl-buffer ediff-control-frame))
+ (with-current-buffer ctl-buffer
(setq ctl-frame (if (frame-live-p old-ctl-frame)
old-ctl-frame
(make-frame ediff-control-frame-parameters))
@@ -1002,7 +985,7 @@ into icons, regardless of the window manager."
;; must be before ediff-setup-control-buffer
;; just a precaution--we should be in ctl-buffer already
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(make-local-variable 'frame-title-format)
(make-local-variable 'frame-icon-title-format) ; XEmacs
(make-local-variable 'icon-title-format)) ; Emacs
@@ -1101,12 +1084,12 @@ into icons, regardless of the window manager."
(not (eq ediff-grab-mouse t)))))
(when (featurep 'xemacs)
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(make-local-hook 'select-frame-hook)
(add-hook 'select-frame-hook
- 'ediff-xemacs-select-frame-hook nil 'local)))
+ #'ediff-xemacs-select-frame-hook nil 'local)))
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(run-hooks 'ediff-after-setup-control-frame-hook))))
@@ -1126,7 +1109,7 @@ into icons, regardless of the window manager."
;; finds a good place to clip control frame
(defun ediff-make-frame-position (ctl-buffer ctl-frame-width ctl-frame-height)
- (ediff-with-current-buffer ctl-buffer
+ (with-current-buffer ctl-buffer
(let* ((frame-A (window-frame ediff-window-A))
(frame-A-parameters (frame-parameters frame-A))
(frame-A-top (eval (cdr (assoc 'top frame-A-parameters))))
@@ -1380,12 +1363,4 @@ It assumes that it is called from within the control buffer."
(provide 'ediff-wind)
-
-
-;; Local Variables:
-;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;; eval: (put 'ediff-with-current-buffer 'lisp-indent-hook 1)
-;; eval: (put 'ediff-with-current-buffer 'edebug-form-spec '(form body))
-;; End:
-
;;; ediff-wind.el ends here
diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el
index 4751bb6ddcb..0adf51328e2 100644
--- a/lisp/vc/ediff.el
+++ b/lisp/vc/ediff.el
@@ -29,7 +29,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -185,7 +185,9 @@
;;;###autoload
(defun ediff-files (file-A file-B &optional startup-hooks)
- "Run Ediff on a pair of files, FILE-A and FILE-B."
+ "Run Ediff on a pair of files, FILE-A and FILE-B.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
(interactive
(let ((dir-A (if ediff-use-last-dir
ediff-last-dir-A
@@ -221,7 +223,9 @@
;;;###autoload
(defun ediff-files3 (file-A file-B file-C &optional startup-hooks)
- "Run Ediff on three files, FILE-A, FILE-B, and FILE-C."
+ "Run Ediff on three files, FILE-A, FILE-B, and FILE-C.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
(interactive
(let ((dir-A (if ediff-use-last-dir
ediff-last-dir-A
@@ -419,7 +423,14 @@ If this file is a backup, `ediff' it with its original."
;;;###autoload
(defun ediff-buffers (buffer-A buffer-B &optional startup-hooks job-name)
- "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B."
+ "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. JOB-NAME is a
+symbol describing the Ediff job type; it defaults to
+`ediff-buffers', but can also be one of
+`ediff-merge-files-with-ancestor', `ediff-last-dir-ancestor',
+`ediff-last-dir-C', `ediff-buffers3', `ediff-merge-buffers', or
+`ediff-merge-buffers-with-ancestor'."
(interactive
(let (bf)
(list (setq bf (read-buffer "Buffer A to compare: "
@@ -441,7 +452,14 @@ If this file is a backup, `ediff' it with its original."
;;;###autoload
(defun ediff-buffers3 (buffer-A buffer-B buffer-C
&optional startup-hooks job-name)
- "Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C."
+ "Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. JOB-NAME is a
+symbol describing the Ediff job type; it defaults to
+`ediff-buffers3', but can also be one of
+`ediff-merge-files-with-ancestor', `ediff-last-dir-ancestor',
+`ediff-last-dir-C', `ediff-buffers', `ediff-merge-buffers', or
+`ediff-merge-buffers-with-ancestor'."
(interactive
(let (bf bff)
(list (setq bf (read-buffer "Buffer A to compare: "
@@ -637,7 +655,8 @@ regular expression; only file names that match the regexp are considered."
(defun ediff-merge-directories (dir1 dir2 regexp &optional merge-autostore-dir)
"Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
the same name in both. The third argument, REGEXP, is nil or a regular
-expression; only file names that match the regexp are considered."
+expression; only file names that match the regexp are considered.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
(default-regexp (eval ediff-default-filtering-regexp))
@@ -674,7 +693,8 @@ expression; only file names that match the regexp are considered."
Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge
without ancestor. The fourth argument, REGEXP, is nil or a regular expression;
-only file names that match the regexp are considered."
+only file names that match the regexp are considered.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
(default-regexp (eval ediff-default-filtering-regexp))
@@ -710,7 +730,8 @@ only file names that match the regexp are considered."
&optional merge-autostore-dir)
"Run Ediff on a directory, DIR1, merging its files with their revisions.
The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account."
+names. Only the files that are under revision control are taken into account.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
(default-regexp (eval ediff-default-filtering-regexp))
@@ -740,7 +761,8 @@ names. Only the files that are under revision control are taken into account."
merge-autostore-dir)
"Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors.
The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account."
+names. Only the files that are under revision control are taken into account.
+MERGE-AUTOSTORE-DIR is the directory in which to store merged files."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
(default-regexp (eval ediff-default-filtering-regexp))
@@ -908,7 +930,9 @@ names. Only the files that are under revision control are taken into account."
With prefix argument, DUMB-MODE, or on a non-windowing display, works as
follows:
If WIND-A is nil, use selected window.
-If WIND-B is nil, use window next to WIND-A."
+If WIND-B is nil, use window next to WIND-A.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
(interactive "P")
(ediff-windows dumb-mode wind-A wind-B
startup-hooks 'ediff-windows-wordwise 'word-mode))
@@ -919,7 +943,9 @@ If WIND-B is nil, use window next to WIND-A."
With prefix argument, DUMB-MODE, or on a non-windowing display, works as
follows:
If WIND-A is nil, use selected window.
-If WIND-B is nil, use window next to WIND-A."
+If WIND-B is nil, use window next to WIND-A.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
(interactive "P")
(ediff-windows dumb-mode wind-A wind-B
startup-hooks 'ediff-windows-linewise nil))
@@ -963,9 +989,12 @@ If WIND-B is nil, use window next to WIND-A."
;;;###autoload
(defun ediff-regions-wordwise (buffer-A buffer-B &optional startup-hooks)
"Run Ediff on a pair of regions in specified buffers.
+BUFFER-A and BUFFER-B are the buffers to be compared.
Regions (i.e., point and mark) can be set in advance or marked interactively.
This function is effective only for relatively small regions, up to 200
-lines. For large regions, use `ediff-regions-linewise'."
+lines. For large regions, use `ediff-regions-linewise'.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
(interactive
(let (bf)
(list (setq bf (read-buffer "Region's A buffer: "
@@ -1003,10 +1032,13 @@ lines. For large regions, use `ediff-regions-linewise'."
;;;###autoload
(defun ediff-regions-linewise (buffer-A buffer-B &optional startup-hooks)
"Run Ediff on a pair of regions in specified buffers.
+BUFFER-A and BUFFER-B are the buffers to be compared.
Regions (i.e., point and mark) can be set in advance or marked interactively.
Each region is enlarged to contain full lines.
This function is effective for large regions, over 100-200
-lines. For small regions, use `ediff-regions-wordwise'."
+lines. For small regions, use `ediff-regions-wordwise'.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
(interactive
(let (bf)
(list (setq bf (read-buffer "Region A's buffer: "
@@ -1127,7 +1159,11 @@ lines. For small regions, use `ediff-regions-wordwise'."
;; MERGE-BUFFER-FILE is the file to be
;; associated with the merge buffer
&optional startup-hooks merge-buffer-file)
- "Merge two files without ancestor."
+ "Merge two files without ancestor.
+FILE-A and FILE-B are the names of the files to be merged.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. MERGE-BUFFER-FILE
+is the name of the file to be associated with the merge buffer.."
(interactive
(let ((dir-A (if ediff-use-last-dir
ediff-last-dir-A
@@ -1171,7 +1207,12 @@ lines. For small regions, use `ediff-regions-wordwise'."
;; to be associated with the
;; merge buffer
merge-buffer-file)
- "Merge two files with ancestor."
+ "Merge two files with ancestor.
+FILE-A and FILE-B are the names of the files to be merged, and
+FILE-ANCESTOR is the name of the ancestor file. STARTUP-HOOKS is
+a list of functions that Emacs calls without arguments after
+setting up the Ediff buffers. MERGE-BUFFER-FILE is the name of
+the file to be associated with the merge buffer."
(interactive
(let ((dir-A (if ediff-use-last-dir
ediff-last-dir-A
@@ -1229,7 +1270,16 @@ lines. For small regions, use `ediff-regions-wordwise'."
;; MERGE-BUFFER-FILE is the file to be
;; associated with the merge buffer
startup-hooks job-name merge-buffer-file)
- "Merge buffers without ancestor."
+ "Merge buffers without ancestor.
+BUFFER-A and BUFFER-B are the buffers to be merged.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers. JOB-NAME is a
+symbol describing the Ediff job type; it defaults to
+`ediff-merge-buffers', but can also be one of
+`ediff-merge-files-with-ancestor', `ediff-last-dir-ancestor',
+`ediff-last-dir-C', `ediff-buffers', `ediff-buffers3', or
+`ediff-merge-buffers-with-ancestor'. MERGE-BUFFER-FILE is the
+name of the file to be associated with the merge buffer."
(interactive
(let (bf)
(list (setq bf (read-buffer "Buffer A to merge: "
@@ -1256,7 +1306,16 @@ lines. For small regions, use `ediff-regions-wordwise'."
;; file to be associated
;; with the merge buffer
merge-buffer-file)
- "Merge buffers with ancestor."
+ "Merge buffers with ancestor.
+BUFFER-A and BUFFER-B are the buffers to be merged, and
+BUFFER-ANCESTOR is their ancestor. STARTUP-HOOKS is a list of
+functions that Emacs calls without arguments after setting up the
+Ediff buffers. JOB-NAME is a symbol describing the Ediff job
+type; it defaults to `ediff-merge-buffers-with-ancestor', but can
+also be one of `ediff-merge-files-with-ancestor',
+`ediff-last-dir-ancestor', `ediff-last-dir-C', `ediff-buffers',
+`ediff-buffers3', or `ediff-merge-buffers'. MERGE-BUFFER-FILE is
+the name of the file to be associated with the merge buffer."
(interactive
(let (bf bff)
(list (setq bf (read-buffer "Buffer A to merge: "
@@ -1287,8 +1346,11 @@ lines. For small regions, use `ediff-regions-wordwise'."
(defun ediff-merge-revisions (&optional file startup-hooks merge-buffer-file)
;; MERGE-BUFFER-FILE is the file to be associated with the merge buffer
"Run Ediff by merging two revisions of a file.
-The file is the optional FILE argument or the file visited by the current
-buffer."
+The file is the optional FILE argument or the file visited by the
+current buffer. STARTUP-HOOKS is a list of functions that Emacs
+calls without arguments after setting up the Ediff buffers.
+MERGE-BUFFER-FILE is the name of the file to be associated with
+the merge buffer."
(interactive)
(if (stringp file) (find-file file))
(let (rev1 rev2)
@@ -1319,8 +1381,11 @@ buffer."
;; buffer
merge-buffer-file)
"Run Ediff by merging two revisions of a file with a common ancestor.
-The file is the optional FILE argument or the file visited by the current
-buffer."
+The file is the optional FILE argument or the file visited by the
+current buffer. STARTUP-HOOKS is a list of functions that Emacs
+calls without arguments after setting up the Ediff buffers.
+MERGE-BUFFER-FILE is the name of the file to be associated with
+the merge buffer."
(interactive)
(if (stringp file) (find-file file))
(let (rev1 rev2 ancestor-rev)
@@ -1360,8 +1425,8 @@ buffer."
"Query for a file name, and then run Ediff by patching that file.
If optional PATCH-BUF is given, use the patch in that buffer
and don't ask the user.
-If prefix argument, then: if even argument, assume that the patch is in a
-buffer. If odd -- assume it is in a file."
+If prefix argument ARG, then: if even argument, assume that the
+patch is in a buffer. If odd -- assume it is in a file."
(interactive "P")
(let (source-dir source-file)
(require 'ediff-ptch)
@@ -1394,7 +1459,7 @@ prompts for the buffer or a file, depending on the answer.
With ARG=1, assumes the patch is in a file and prompts for the file.
With ARG=2, assumes the patch is in a buffer and prompts for the buffer.
PATCH-BUF is an optional argument, which specifies the buffer that contains the
-patch. If not given, the user is prompted according to the prefix argument."
+patch. If not given, the user is prompted according to the prefix argument."
(interactive "P")
(require 'ediff-ptch)
(setq patch-buf
@@ -1421,7 +1486,9 @@ patch. If not given, the user is prompted according to the prefix argument."
"Run Ediff by comparing versions of a file.
The file is an optional FILE argument or the file entered at the prompt.
Default: the file visited by the current buffer.
-Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
+Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'.
+STARTUP-HOOKS is a list of functions that Emacs calls without
+arguments after setting up the Ediff buffers."
;; if buffer is non-nil, use that buffer instead of the current buffer
(interactive "P")
(if (not (stringp file))
@@ -1434,7 +1501,7 @@ Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
'no-dirs)))
(find-file file)
(if (and (buffer-modified-p)
- (y-or-n-p (format "Buffer %s is modified. Save buffer? "
+ (y-or-n-p (format "Buffer %s is modified. Save buffer? "
(buffer-name))))
(save-buffer (current-buffer)))
(let (rev1 rev2)
@@ -1517,6 +1584,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-files-command ()
+ "Call `ediff-files' with the next two command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left)))
(setq command-line-args-left (nthcdr 2 command-line-args-left))
@@ -1524,6 +1592,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff3-files-command ()
+ "Call `ediff3-files' with the next three command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left))
(file-c (nth 2 command-line-args-left)))
@@ -1532,6 +1601,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-merge-command ()
+ "Call `ediff-merge-files' with the next two command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left)))
(setq command-line-args-left (nthcdr 2 command-line-args-left))
@@ -1539,6 +1609,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-merge-with-ancestor-command ()
+ "Call `ediff-merge-files-with-ancestor' with the next three command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left))
(ancestor (nth 2 command-line-args-left)))
@@ -1547,6 +1618,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-directories-command ()
+ "Call `ediff-directories' with the next three command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left))
(regexp (nth 2 command-line-args-left)))
@@ -1555,6 +1627,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-directories3-command ()
+ "Call `ediff-directories3' with the next four command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left))
(file-c (nth 2 command-line-args-left))
@@ -1564,6 +1637,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-merge-directories-command ()
+ "Call `ediff-merge-directories' with the next three command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left))
(regexp (nth 2 command-line-args-left)))
@@ -1572,6 +1646,7 @@ With optional NODE, goes to that node."
;;;###autoload
(defun ediff-merge-directories-with-ancestor-command ()
+ "Call `ediff-merge-directories-with-ancestor' with the next four command line arguments."
(let ((file-a (nth 0 command-line-args-left))
(file-b (nth 1 command-line-args-left))
(ancestor (nth 2 command-line-args-left))
diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el
index cd8ba19f6d5..30457d1e2d3 100644
--- a/lisp/vc/log-edit.el
+++ b/lisp/vc/log-edit.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -623,7 +623,7 @@ Also saves its contents in the comment history and hides
(setq buffer-read-only nil)
(erase-buffer)
(cvs-insert-strings files)
- (setq buffer-read-only t)
+ (special-mode)
(goto-char (point-min))
(save-selected-window
(cvs-pop-to-buffer-same-frame buf)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index e8efc1e6e09..d6963d0a1b9 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -608,10 +608,16 @@ considered file(s)."
(log-view-diff-common beg end t)))
(defun log-view-diff-common (beg end &optional whole-changeset)
- (let ((to (log-view-current-tag beg))
- (fr (log-view-current-tag end)))
- (when (string-equal fr to)
- ;; TO and FR are the same, look at the previous revision.
+ (let* ((to (log-view-current-tag beg))
+ (fr-entry (log-view-current-entry end))
+ (fr (cadr fr-entry)))
+ ;; When TO and FR are the same, or when point is on a line after
+ ;; the last entry, look at the previous revision.
+ (when (or (string-equal fr to)
+ (>= (point)
+ (save-excursion
+ (goto-char (car fr-entry))
+ (forward-line))))
(setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr)))
(vc-diff-internal
t (list log-view-vc-backend
diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el
index 72caafc4fb0..41dc9401c0a 100644
--- a/lisp/vc/pcvs-defs.el
+++ b/lisp/vc/pcvs-defs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -269,7 +269,7 @@ This variable is buffer local and only used in the *cvs* buffer.")
"Regexp matching the possible names of locks in the CVS repository.")
(defconst cvs-cursor-column 22
- "Column to position cursor in in `cvs-mode'.")
+ "Column to position cursor in, in `cvs-mode'.")
;;;;
;;;; Global internal variables
diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el
index 8dd513c81fa..239a2268aae 100644
--- a/lisp/vc/pcvs-info.el
+++ b/lisp/vc/pcvs-info.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el
index 2315938a32a..f0bb8943f23 100644
--- a/lisp/vc/pcvs-parse.el
+++ b/lisp/vc/pcvs-parse.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el
index de45141ddc1..9b62780a32d 100644
--- a/lisp/vc/pcvs-util.el
+++ b/lisp/vc/pcvs-util.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el
index 3ab34236685..4e74d5f6f86 100644
--- a/lisp/vc/pcvs.el
+++ b/lisp/vc/pcvs.el
@@ -27,7 +27,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 21c39c85ca8..b988463de1e 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -725,7 +725,7 @@ this keeps \"UUU\"."
(let ((i 3))
(while (or (not (match-end i))
(< (point) (match-beginning i))
- (>= (point) (match-end i)))
+ (> (point) (match-end i)))
(cl-decf i))
i))
@@ -938,15 +938,15 @@ It has the following disadvantages:
- cannot use `diff -w' because the weighting causes added spaces in a line
to be represented as added copies of some line, so `diff -w' can't do the
right thing any more.
-- may in degenerate cases take a 1KB input region and turn it into a 1MB
- file to pass to diff.")
+- Is a bit more costly (may in degenerate cases use temp files that are 10x
+ larger than the refined regions).")
(defun smerge--refine-forward (n)
(let ((case-fold-search nil)
(re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n"))
(when (and smerge-refine-ignore-whitespace
;; smerge-refine-weight-hack causes additional spaces to
- ;; appear as additional lines as well, so even if diff ignore
+ ;; appear as additional lines as well, so even if diff ignores
;; whitespace changes, it'll report added/removed lines :-(
(not smerge-refine-weight-hack))
(setq re (concat "[ \t]*\\(?:" re "\\)")))
@@ -954,6 +954,8 @@ It has the following disadvantages:
(unless (looking-at re) (error "Smerge refine internal error"))
(goto-char (match-end 0)))))
+(defvar smerge--refine-long-words)
+
(defun smerge--refine-chopup-region (beg end file &optional preproc)
"Chopup the region into small elements, one per line.
Save the result into FILE.
@@ -976,18 +978,46 @@ chars to try and eliminate some spurious differences."
(subst-char-in-region (point-min) (point-max) ?\n ?\s))
(goto-char (point-min))
(while (not (eobp))
- (funcall smerge-refine-forward-function 1)
- (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1))
- nil
- (buffer-substring (line-beginning-position) (point)))))
- ;; We add \n after each char except after \n, so we get
- ;; one line per text char, where each line contains
- ;; just one char, except for \n chars which are
- ;; represented by the empty line.
- (unless (eq (char-before) ?\n) (insert ?\n))
- ;; HACK ALERT!!
- (if smerge-refine-weight-hack
- (dotimes (_i (1- (length s))) (insert s "\n")))))
+ (cl-assert (bolp))
+ (let ((start (point)))
+ (funcall smerge-refine-forward-function 1)
+ (let ((len (- (point) start)))
+ (cl-assert (>= len 1))
+ ;; We add \n after each chunk except after \n, so we get
+ ;; one line per text chunk, where each line contains
+ ;; just one chunk, except for \n chars which are
+ ;; represented by the empty line.
+ (unless (bolp) (insert ?\n))
+ (when (and smerge-refine-weight-hack (> len 1))
+ (let ((s (buffer-substring-no-properties start (point))))
+ ;; The weight-hack inserts N copies of words of size N,
+ ;; so it naturally suffers from an O(N²) blow up.
+ ;; To circumvent this, we map each long word
+ ;; to a shorter (but still unique) replacement.
+ ;; Another option would be to change smerge--refine-forward
+ ;; so it chops up long words into smaller ones.
+ (when (> len 8)
+ (let ((short (gethash s smerge--refine-long-words)))
+ (unless short
+ ;; To avoid accidental conflicts with ≤8 words,
+ ;; we make sure the replacement is >8 chars. Overall,
+ ;; this should bound the blowup factor to ~10x,
+ ;; tho if those chars end up encoded as multiple bytes
+ ;; each, it could probably still reach ~30x in
+ ;; pathological cases.
+ (setq short
+ (concat (substring s 0 7)
+ " "
+ (string
+ (+ ?0
+ (hash-table-count
+ smerge--refine-long-words)))
+ "\n"))
+ (puthash s short smerge--refine-long-words))
+ (delete-region start (point))
+ (insert short)
+ (setq s short)))
+ (dotimes (_i (1- len)) (insert s)))))))
(unless (bolp) (error "Smerge refine internal error"))
(let ((coding-system-for-write 'emacs-internal))
(write-region (point-min) (point-max) file nil 'nomessage))))
@@ -1042,7 +1072,9 @@ used to replace chars to try and eliminate some spurious differences."
(let* ((pos (point))
deactivate-mark ; The code does not modify any visible buffer.
(file1 (make-temp-file "diff1"))
- (file2 (make-temp-file "diff2")))
+ (file2 (make-temp-file "diff2"))
+ (smerge--refine-long-words
+ (if smerge-refine-weight-hack (make-hash-table :test #'equal))))
(unless (markerp beg1) (setq beg1 (copy-marker beg1)))
(unless (markerp beg2) (setq beg2 (copy-marker beg2)))
;; Chop up regions into smaller elements and save into files.
@@ -1062,7 +1094,7 @@ used to replace chars to try and eliminate some spurious differences."
;; also and more importantly because otherwise it
;; may happen that diff doesn't behave like
;; smerge-refine-weight-hack expects it to.
- ;; See http://thread.gmane.org/gmane.emacs.devel/82685.
+ ;; See https://lists.gnu.org/r/emacs-devel/2007-11/msg00401.html
"-awd" "-ad")
file1 file2))
;; Process diff's output.
diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el
index 12df680ce03..a6c0e5a72d7 100644
--- a/lisp/vc/vc-annotate.el
+++ b/lisp/vc/vc-annotate.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index d0e9f7744b8..51b104cbcd5 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el
index bab835c84a5..36cb2e5fcbc 100644
--- a/lisp/vc/vc-cvs.el
+++ b/lisp/vc/vc-cvs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 4aa185186c4..f951c67498f 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 0363aab8407..41c44e2c24a 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Credits:
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index c71030aba17..479003e65a3 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Credits:
diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el
index 16f833cc5bc..87a2e33264c 100644
--- a/lisp/vc/vc-filewise.el
+++ b/lisp/vc/vc-filewise.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index cc3e295641c..ab8b358cf2c 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -857,13 +857,13 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(vc-git-command nil nil file "checkout" "-q" "--")))
(defvar vc-git-error-regexp-alist
- '(("^ \\(.+\\) |" 1 nil nil 0))
+ '(("^ \\(.+\\)\\> *|" 1 nil nil 0))
"Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
-(defun vc-git--pushpull (command prompt)
+(defun vc-git--pushpull (command prompt extra-args)
"Run COMMAND (a string; either push or pull) on the current Git branch.
If PROMPT is non-nil, prompt for the Git command to run."
(let* ((root (vc-git-root default-directory))
@@ -882,6 +882,7 @@ If PROMPT is non-nil, prompt for the Git command to run."
(setq git-program (car args)
command (cadr args)
args (cddr args)))
+ (setq args (nconc args extra-args))
(require 'vc-dispatcher)
(apply 'vc-do-async-command buffer root git-program command args)
(with-current-buffer buffer
@@ -889,7 +890,7 @@ If PROMPT is non-nil, prompt for the Git command to run."
(vc-compilation-mode 'git)
(setq-local compile-command
(concat git-program " " command " "
- (if args (mapconcat 'identity args " ") "")))
+ (mapconcat 'identity args " ")))
(setq-local compilation-directory root)
;; Either set `compilation-buffer-name-function' locally to nil
;; or use `compilation-arguments' to set `name-function'.
@@ -904,13 +905,13 @@ If PROMPT is non-nil, prompt for the Git command to run."
"Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
for the Git command to run."
- (vc-git--pushpull "pull" prompt))
+ (vc-git--pushpull "pull" prompt '("--stat")))
(defun vc-git-push (prompt)
"Push changes from the current Git branch.
Normally, this runs \"git push\". If PROMPT is non-nil, prompt
for the Git command to run."
- (vc-git--pushpull "push" prompt))
+ (vc-git--pushpull "push" prompt nil))
(defun vc-git-merge-branch ()
"Merge changes into the current Git branch.
@@ -951,6 +952,10 @@ This prompts for a branch to merge from."
"DU" "AA" "UU"))
(push (expand-file-name file directory) files)))))))
+;; Everywhere but here, follows vc-git-command, which uses vc-do-command
+;; from vc-dispatcher.
+(autoload 'vc-resynch-buffer "vc-dispatcher")
+
(defun vc-git-resolve-when-done ()
"Call \"git add\" if the conflict markers have been removed."
(save-excursion
@@ -964,6 +969,7 @@ This prompts for a branch to merge from."
(vc-git-root buffer-file-name)))
(vc-git-conflicted-files (vc-git-root buffer-file-name)))
(vc-git-command nil 0 nil "reset"))
+ (vc-resynch-buffer buffer-file-name t t)
;; Remove the hook so that it is not called multiple times.
(remove-hook 'after-save-hook 'vc-git-resolve-when-done t))))
@@ -973,7 +979,7 @@ This prompts for a branch to merge from."
;; FIXME
;; 1) the net result is to call git twice per file.
;; 2) v-g-c-f is documented to take a directory.
- ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01126.html
+ ;; https://lists.gnu.org/r/emacs-devel/2014-01/msg01126.html
(vc-git-conflicted-files buffer-file-name)
(save-excursion
(goto-char (point-min))
@@ -1030,6 +1036,7 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-git-log-outgoing (buffer remote-location)
(interactive)
+ (vc-setup-buffer buffer)
(vc-git-command
buffer 'async nil
"log"
@@ -1043,6 +1050,7 @@ If LIMIT is non-nil, show no more than this many entries."
(defun vc-git-log-incoming (buffer remote-location)
(interactive)
+ (vc-setup-buffer buffer)
(vc-git-command nil 0 nil "fetch")
(vc-git-command
buffer 'async nil
@@ -1400,7 +1408,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
"Run git grep, searching for REGEXP in FILES in directory DIR.
The search is limited to file names matching shell pattern FILES.
FILES may use abbreviations defined in `grep-files-aliases', e.g.
-entering `ch' is equivalent to `*.[ch]'.
+entering `ch' is equivalent to `*.[ch]'. As whitespace triggers
+completion when entering a pattern, including it requires
+quoting, e.g. `\\[quoted-insert]<space>'.
With \\[universal-argument] prefix, you can edit the constructed shell command line
before it is executed.
@@ -1421,7 +1431,9 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
nil nil 'grep-history)
nil))
(t (let* ((regexp (grep-read-regexp))
- (files (grep-read-files regexp))
+ (files
+ (mapconcat #'shell-quote-argument
+ (split-string (grep-read-files regexp)) " "))
(dir (read-directory-name "In directory: "
nil default-directory t)))
(list regexp files dir))))))
@@ -1450,10 +1462,6 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
-;; Everywhere but here, follows vc-git-command, which uses vc-do-command
-;; from vc-dispatcher.
-(autoload 'vc-resynch-buffer "vc-dispatcher")
-
(defun vc-git-stash (name)
"Create a stash."
(interactive "sStash name: ")
@@ -1554,7 +1562,7 @@ The difference to vc-do-command is that this function always invokes
(or coding-system-for-write vc-git-commits-coding-system))
(process-environment (cons "GIT_DIR" process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
- ;; http://debbugs.gnu.org/16897
+ ;; https://debbugs.gnu.org/16897
(unless (and (not (cdr-safe file-or-list))
(let ((file (or (car-safe file-or-list)
file-or-list)))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index 4be529624a4..9e597a209a7 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -687,7 +687,8 @@ PREFIX is the directory name of the directory against which these
patterns are rooted. We understand only a subset of PCRE syntax;
if we don't understand a construct, we signal
`vc-hg-unsupported-syntax'."
- (cl-assert (string-match "^/\\(.*/\\)?$" prefix))
+ (cl-assert (and (file-name-absolute-p prefix)
+ (directory-name-p prefix)))
(let ((parts nil)
(i 0)
(anchored nil)
@@ -875,7 +876,8 @@ if we don't understand a construct, we signal
(defun vc-hg--slurp-hgignore (repo)
"Read hg ignore patterns from REPO.
REPO must be the directory name of an hg repository."
- (cl-assert (string-match "^/\\(.*/\\)?$" repo))
+ (cl-assert (and (file-name-absolute-p repo)
+ (directory-name-p repo)))
(let* ((hgignore (concat repo ".hgignore"))
(vc-hg--hgignore-patterns nil)
(vc-hg--hgignore-filenames nil))
@@ -930,7 +932,8 @@ FILENAME must be the file's true absolute name."
(concat repo repo-relative-filename))))
(defun vc-hg--read-repo-requirements (repo)
- (cl-assert (string-match "^/\\(.*/\\)?$" repo))
+ (cl-assert (and (file-name-absolute-p repo)
+ (directory-name-p repo)))
(let* ((requires-filename (concat repo ".hg/requires")))
(and (file-exists-p requires-filename)
(with-temp-buffer
@@ -1001,7 +1004,8 @@ hg binary."
;; dirstate must exist
(not (progn
(setf repo (expand-file-name repo))
- (cl-assert (string-match "^/\\(.*/\\)?$" repo))
+ (cl-assert (and (file-name-absolute-p repo)
+ (directory-name-p repo)))
(setf dirstate (concat repo ".hg/dirstate"))
(setf dirstate-attr (file-attributes dirstate))))
;; Repository must be in an understood format
@@ -1292,12 +1296,8 @@ REV is the revision to check out into WORKFILE."
(vc-hg-command buffer 1 nil "outgoing" "-n" (unless (string= remote-location "")
remote-location)))
-(defvar vc-hg-error-regexp-alist nil
- ;; 'hg pull' does not list modified files, so, for now, the only
- ;; benefit of `vc-compilation-mode' is that one can get rid of
- ;; *vc-hg* buffer with 'q' or 'z'.
- ;; TODO: call 'hg incoming' before pull/merge to get the list of
- ;; modified files
+(defvar vc-hg-error-regexp-alist
+ '(("^M \\(.+\\)" 1 nil nil 0))
"Value of `compilation-error-regexp-alist' in *vc-hg* buffers.")
(autoload 'vc-do-async-command "vc-dispatcher")
@@ -1305,9 +1305,10 @@ REV is the revision to check out into WORKFILE."
(defvar compilation-directory)
(defvar compilation-arguments) ; defined in compile.el
-(defun vc-hg--pushpull (command prompt &optional obsolete)
+(defun vc-hg--pushpull (command prompt post-processing &optional obsolete)
"Run COMMAND (a string; either push or pull) on the current Hg branch.
If PROMPT is non-nil, prompt for the Hg command to run.
+POST-PROCESSING is a list of commands to execute after the command.
If OBSOLETE is non-nil, behave like the old versions of the Hg push/pull
commands, which only operated on marked files."
(let (marked-list)
@@ -1323,18 +1324,14 @@ commands, which only operated on marked files."
(let* ((root (vc-hg-root default-directory))
(buffer (format "*vc-hg : %s*" (expand-file-name root)))
(hg-program vc-hg-program)
- ;; Fixme: before updating the working copy to the latest
- ;; state, should check if it's visiting an old revision.
- (args (if (equal command "pull") '("-u"))))
+ args)
;; If necessary, prompt for the exact command.
;; TODO if pushing, prompt if no default push location - cf bzr.
(when prompt
(setq args (split-string
(read-shell-command
(format "Hg %s command: " command)
- (format "%s %s%s" hg-program command
- (if (not args) ""
- (concat " " (mapconcat 'identity args " "))))
+ (format "%s %s" hg-program command)
'vc-hg-history)
" " t))
(setq hg-program (car args)
@@ -1343,10 +1340,17 @@ commands, which only operated on marked files."
(apply 'vc-do-async-command buffer root hg-program command args)
(with-current-buffer buffer
(vc-run-delayed
+ (dolist (cmd post-processing)
+ (apply 'vc-do-command buffer nil hg-program nil cmd))
(vc-compilation-mode 'hg)
(setq-local compile-command
(concat hg-program " " command " "
- (if args (mapconcat 'identity args " ") "")))
+ (mapconcat 'identity args " ")
+ (mapconcat (lambda (args)
+ (concat " && " hg-program " "
+ (mapconcat 'identity
+ args " ")))
+ post-processing "")))
(setq-local compilation-directory root)
;; Either set `compilation-buffer-name-function' locally to nil
;; or use `compilation-arguments' to set `name-function'.
@@ -1367,7 +1371,15 @@ specific Mercurial pull command. The default is \"hg pull -u\",
which fetches changesets from the default remote repository and
then attempts to update the working directory."
(interactive "P")
- (vc-hg--pushpull "pull" prompt (called-interactively-p 'interactive)))
+ (vc-hg--pushpull "pull" prompt
+ ;; Fixme: before updating the working copy to the latest
+ ;; state, should check if it's visiting an old revision.
+ ;; post-processing: list modified files and update
+ ;; NB: this will not work with "pull = --rebase"
+ ;; or "pull = --update" in hgrc.
+ '(("--pager" "no" "status" "--rev" "." "--rev" "tip")
+ ("update"))
+ (called-interactively-p 'interactive)))
(defun vc-hg-push (prompt)
"Push changes from the current Mercurial branch.
@@ -1377,7 +1389,7 @@ for the Hg command to run.
If called interactively with a set of marked Log View buffers,
call \"hg push -r REVS\" to push the specified revisions REVS."
(interactive "P")
- (vc-hg--pushpull "push" prompt (called-interactively-p 'interactive)))
+ (vc-hg--pushpull "push" prompt nil (called-interactively-p 'interactive)))
(defun vc-hg-merge-branch ()
"Merge incoming changes into the current working directory.
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 2c2534a034e..99c8211ad5f 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -882,7 +882,7 @@ In the latter case, VC mode is deactivated for this buffer."
(define-key map "d" 'vc-dir)
(define-key map "g" 'vc-annotate)
(define-key map "G" 'vc-ignore)
- (define-key map "h" 'vc-insert-headers)
+ (define-key map "h" 'vc-region-history)
(define-key map "i" 'vc-register)
(define-key map "l" 'vc-print-log)
(define-key map "L" 'vc-print-root-log)
diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el
index ac95da08f1f..eed4bd09dfb 100644
--- a/lisp/vc/vc-mtn.el
+++ b/lisp/vc/vc-mtn.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index afeb5ef23d5..4634e76088f 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -177,6 +177,8 @@ For a description of possible values, see `vc-check-master-templates'."
(push (list frel state) result))))
(funcall update-function result)))
+(defun vc-rcs-dir-extra-headers (&rest _ignore))
+
(defun vc-rcs-working-revision (file)
"RCS-specific version of `vc-working-revision'."
(or (and vc-consult-headers
@@ -849,7 +851,7 @@ and CVS."
;; You might think that this should be distributed with RCS, but
;; apparently not. CVS sometimes provides a version of it.
-;; http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00288.html
+;; https://lists.gnu.org/r/emacs-devel/2014-05/msg00288.html
(defvar vc-rcs-rcs2log-program
(let (exe)
(cond ((file-executable-p
diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el
index fd27db381d3..f873fbfe1d4 100644
--- a/lisp/vc/vc-sccs.el
+++ b/lisp/vc/vc-sccs.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el
index 5c8b3da6f1a..0a219ff94a0 100644
--- a/lisp/vc/vc-src.el
+++ b/lisp/vc/vc-src.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -180,7 +180,7 @@ For a description of possible values, see `vc-check-master-templates'."
(defun vc-src-dir-status-files (dir files update-function)
;; FIXME: Use one src status -a call for this
- (if (not files) (setq files (vc-expand-dirs (list dir) 'RCS)))
+ (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC)))
(let ((result nil))
(dolist (file files)
(let ((state (vc-state file))
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index db16eb202de..f0987bf6671 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -184,6 +184,7 @@ switches."
(?M . edited)
(?D . removed)
(?R . removed)
+ (?! . needs-update)
(?? . unregistered)
;; This is what vc-svn-parse-status does.
(?~ . edited)))
@@ -700,8 +701,7 @@ Set file properties accordingly. If FILENAME is non-nil, return its status."
(let (multifile file status propstat)
(goto-char (point-min))
(while (re-search-forward
- ;; Ignore the files with status X.
- "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
+ "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ SX]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t)
;; If the username contains spaces, the output format is ambiguous,
;; so don't trust the output's filename unless we have to.
(setq file (or (unless multifile filename)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 9379bcf74de..211feddc55d 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Credits:
@@ -2377,6 +2377,7 @@ When called interactively with a prefix argument, prompt for LIMIT."
;;;###autoload
(defun vc-print-branch-log (branch)
+ "Show the change log for BRANCH in a window."
(interactive
(list
(vc-read-revision "Branch to log: ")))
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index 22727bc8d64..0d7a5ff885f 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/version.el b/lisp/version.el
index ea6f1b46948..1792a81f71f 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/view.el b/lisp/view.el
index fb478e17785..6a4705acd6f 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -982,7 +982,7 @@ for highlighting the match that is found."
;; This is the dumb approach, looking at each line. The original
;; version of this function looked like it might have been trying to
;; do something clever, but not succeeding:
-;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2007-09/msg00073.html
+;; https://lists.gnu.org/r/bug-gnu-emacs/2007-09/msg00073.html
(defun view-search-no-match-lines (times regexp)
"Search for the TIMESth occurrence of a line with no match for REGEXP.
If such a line is found, return non-nil and set the match-data to that line.
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
index 8755420d188..7ea68817c28 100644
--- a/lisp/vt-control.el
+++ b/lisp/vt-control.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
index c86a826ddbc..a6f43fbf6bb 100644
--- a/lisp/vt100-led.el
+++ b/lisp/vt100-led.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
index 93551de4404..1ba6403bea5 100644
--- a/lisp/w32-fns.el
+++ b/lisp/w32-fns.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index 50f62559a44..3309db34123 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/wdired.el b/lisp/wdired.el
index 179b51b711a..b8de02dd37a 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index c6d5b16caeb..32a90ba485b 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -1,9 +1,9 @@
-;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE
+;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -*- lexical-binding: t -*-
;; Copyright (C) 2000-2017 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
-;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
+;; Author: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
+;; Maintainer: Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>
;; Keywords: data, wp
;; Version: 13.2.2
;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -495,7 +495,8 @@ Used when `whitespace-style' includes the value `spaces'.")
(defvar whitespace-tab 'whitespace-tab
"Symbol face used to visualize TAB.
Used when `whitespace-style' includes the value `tabs'.")
-(make-obsolete-variable 'whitespace-tab "use the face instead." "24.4")
+(make-obsolete-variable 'whitespace-tab
+ "customize the face `whitespace-tab' instead." "24.4")
(defface whitespace-tab
'((((class color) (background dark))
diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el
index f105de244a2..d8054e348e9 100644
--- a/lisp/wid-browse.el
+++ b/lisp/wid-browse.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el
index ca402c18e53..4fa36edb9c6 100644
--- a/lisp/wid-edit.el
+++ b/lisp/wid-edit.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Wishlist items (from widget.texi):
@@ -832,7 +832,7 @@ button end points."
;; This alias exists only so that one can choose in doc-strings (e.g.
;; Custom-mode) which key-binding of widget-keymap one wants to refer to.
-;; http://lists.gnu.org/archive/html/emacs-devel/2008-11/msg00480.html
+;; https://lists.gnu.org/r/emacs-devel/2008-11/msg00480.html
(define-obsolete-function-alias 'advertised-widget-backward
'widget-backward "23.2")
@@ -3694,15 +3694,17 @@ example:
(defun widget-color--choose-action (widget &optional _event)
(list-colors-display
nil nil
- `(lambda (color)
- (when (buffer-live-p ,(current-buffer))
- (widget-value-set ',(widget-get widget :parent) color)
- (let* ((buf (get-buffer "*Colors*"))
- (win (get-buffer-window buf 0)))
- (if win
- (quit-window nil win)
- (bury-buffer buf)))
- (pop-to-buffer ,(current-buffer))))))
+ (let ((cbuf (current-buffer))
+ (wp (widget-get widget :parent)))
+ (lambda (color)
+ (when (buffer-live-p cbuf)
+ (widget-value-set wp color)
+ (let* ((buf (get-buffer "*Colors*"))
+ (win (get-buffer-window buf 0)))
+ (if win
+ (quit-window nil win)
+ (bury-buffer buf)))
+ (pop-to-buffer cbuf))))))
(defun widget-color-sample-face-get (widget)
(let* ((value (condition-case nil
diff --git a/lisp/widget.el b/lisp/widget.el
index 30d28180abb..baa9140b260 100644
--- a/lisp/widget.el
+++ b/lisp/widget.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/lisp/windmove.el b/lisp/windmove.el
index 0797ef8b9d9..f8de303fffb 100644
--- a/lisp/windmove.el
+++ b/lisp/windmove.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;; --------------------------------------------------------------------
@@ -425,7 +425,7 @@ supplied, if ARG is greater or smaller than zero, respectively."
top-left
;; Don't care whether window is horizontally scrolled -
;; `posn-at-point' handles that already. See also:
- ;; http://lists.gnu.org/archive/html/emacs-devel/2012-01/msg00638.html
+ ;; https://lists.gnu.org/r/emacs-devel/2012-01/msg00638.html
(posn-col-row
(posn-at-point (window-point window) window))))))))
diff --git a/lisp/window.el b/lisp/window.el
index 8b07ed462c9..b7736d85cd1 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -320,22 +320,34 @@ WINDOW can be any window."
(defun window-normalize-buffer (buffer-or-name)
"Return buffer specified by BUFFER-OR-NAME.
-BUFFER-OR-NAME must be either a buffer or a string naming a live
-buffer and defaults to the current buffer."
- (cond
- ((not buffer-or-name)
- (current-buffer))
- ((bufferp buffer-or-name)
- (if (buffer-live-p buffer-or-name)
- buffer-or-name
- (error "Buffer %s is not a live buffer" buffer-or-name)))
- ((get-buffer buffer-or-name))
- (t
- (error "No such buffer %s" buffer-or-name))))
+BUFFER-OR-NAME must be a live buffer, a string naming a live
+buffer or nil which means to return the current buffer.
+
+This function is commonly used to process the (usually optional)
+\"BUFFER-OR-NAME\" argument of window related functions where nil
+stands for the current buffer."
+ (let ((buffer
+ (cond
+ ((not buffer-or-name)
+ (current-buffer))
+ ((bufferp buffer-or-name)
+ buffer-or-name)
+ ((stringp buffer-or-name)
+ (get-buffer buffer-or-name))
+ (t
+ (error "No such buffer %s" buffer-or-name)))))
+ (if (buffer-live-p buffer)
+ buffer
+ (error "No such live buffer %s" buffer-or-name))))
(defun window-normalize-frame (frame)
"Return frame specified by FRAME.
-FRAME must be a live frame and defaults to the selected frame."
+FRAME must be a live frame or nil which means to return the
+selected frame.
+
+This function is commonly used to process the (usually optional)
+\"FRAME\" argument of window and frame related functions where
+nil stands for the selected frame."
(if frame
(if (frame-live-p frame)
frame
@@ -343,11 +355,15 @@ FRAME must be a live frame and defaults to the selected frame."
(selected-frame)))
(defun window-normalize-window (window &optional live-only)
- "Return the window specified by WINDOW.
+ "Return window specified by WINDOW.
If WINDOW is nil, return the selected window. Otherwise, if
WINDOW is a live or an internal window, return WINDOW; if
LIVE-ONLY is non-nil, return WINDOW for a live window only.
-Otherwise, signal an error."
+Otherwise, signal an error.
+
+This function is commonly used to process the (usually optional)
+\"WINDOW\" argument of window related functions where nil stands
+for the selected window."
(cond
((null window)
(selected-window))
@@ -999,7 +1015,7 @@ for displaying BUFFER, nil if no suitable window can be found.
This function installs the `window-side' and `window-slot'
parameters and makes them persistent. It neither modifies ALIST
nor installs any other window parameters unless they have been
-explicitly provided via a `window-parameter' entry in ALIST."
+explicitly provided via a `window-parameters' entry in ALIST."
(let* ((side (or (cdr (assq 'side alist)) 'bottom))
(slot (or (cdr (assq 'slot alist)) 0))
(left-or-right (memq side '(left right)))
@@ -2567,7 +2583,7 @@ and no others."
(defun minibuffer-window-active-p (window)
"Return t if WINDOW is the currently active minibuffer window."
- (eq window (active-minibuffer-window)))
+ (and (window-live-p window) (eq window (active-minibuffer-window))))
(defun count-windows (&optional minibuf)
"Return the number of live windows on the selected frame.
@@ -3703,7 +3719,7 @@ are one more than the actual value of these edges. Note that if
ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
(let* ((window (window-normalize-window window body))
(frame (window-frame window))
- (border-width (frame-border-width frame))
+ (border-width (frame-internal-border-width frame))
(char-width (frame-char-width frame))
(char-height (frame-char-height frame))
(left (if pixelwise
@@ -4096,17 +4112,17 @@ WINDOW must be a valid window and defaults to the selected one.
Return nil.
If the variable `ignore-window-parameters' is non-nil or the
-`delete-other-windows' parameter of WINDOW equals t, do not
-process any parameters of WINDOW. Otherwise, if the
+`delete-other-windows' parameter of WINDOW equals t, do not pay
+attention to any other parameters of WINDOW. Otherwise, if the
`delete-other-windows' parameter of WINDOW specifies a function,
call that function with WINDOW as its sole argument and return
the value returned by that function.
-Otherwise, if WINDOW is part of an atomic window, call this
-function with the root of the atomic window as its argument. If
-WINDOW is a non-side window, make WINDOW the only non-side window
-on the frame. Side windows are not deleted. If WINDOW is a side
-window signal an error."
+Else, if WINDOW is part of an atomic window, call this function
+with the root of the atomic window as its argument. Signal an
+error if that root window is the root window of WINDOW's frame.
+Also signal an error if WINDOW is a side window. Do not delete
+any window whose `no-delete-other-windows' parameter is non-nil."
(interactive)
(setq window (window-normalize-window window))
(let* ((frame (window-frame window))
@@ -4137,28 +4153,28 @@ window signal an error."
(cond
((or ignore-window-parameters
- (not (window-with-parameter 'no-delete-other-window nil frame)))
+ (not (window-with-parameter 'no-delete-other-windows nil frame)))
(setq main (frame-root-window frame)))
((catch 'tag
(walk-window-tree
(lambda (other)
(when (or (and (window-parameter other 'window-side)
(not (window-parameter
- other 'no-delete-other-window)))
+ other 'no-delete-other-windows)))
(and (not (window-parameter other 'window-side))
(window-parameter
- other 'no-delete-other-window)))
+ other 'no-delete-other-windows)))
(throw 'tag nil))))
t)
(setq main (window-main-window frame)))
(t
- ;; Delete other windows via `delete-window' because either a
- ;; side window is or a non-side-window is not deletable.
+ ;; Delete windows via `delete-window' because we found either a
+ ;; deletable side window or a non-deletable non-side-window.
(dolist (other (window-list frame))
(when (and (window-live-p other)
(not (eq other window))
(not (window-parameter
- other 'no-delete-other-window))
+ other 'no-delete-other-windows))
;; When WINDOW and the other window are part of the
;; same atomic window, don't delete the other.
(or (not atom-root)
@@ -4572,12 +4588,13 @@ The function is called with one argument - a frame.
Functions affected by this option are those that bury a buffer
shown in a separate frame like `quit-window' and `bury-buffer'."
:type '(choice (const :tag "Iconify" iconify-frame)
+ (const :tag "Make invisible" make-frame-invisible)
(const :tag "Delete" delete-frame)
(const :tag "Do nothing" ignore)
function)
:group 'windows
:group 'frames
- :version "24.1")
+ :version "26.1")
(defun window--delete (&optional window dedicated-only kill)
"Delete WINDOW if possible.
@@ -4595,7 +4612,9 @@ if WINDOW gets deleted or its frame is auto-hidden."
(cond
(kill
(delete-frame frame))
- ((functionp frame-auto-hide-function)
+ ((functionp (frame-parameter frame 'auto-hide-function))
+ (funcall (frame-parameter frame 'auto-hide-function)))
+ ((functionp frame-auto-hide-function)
(funcall frame-auto-hide-function frame))))
'frame)
(deletable
@@ -6446,8 +6465,9 @@ If this is an integer, `split-window-sensibly' may split a window
vertically only if it has at least this many lines. If this is
nil, `split-window-sensibly' is not allowed to split a window
vertically. If, however, a window is the only window on its
-frame, `split-window-sensibly' may split it vertically
-disregarding the value of this variable."
+frame, or all the other ones are dedicated,
+`split-window-sensibly' may split it vertically disregarding the
+value of this variable."
:type '(choice (const nil) (integer :tag "lines"))
:version "23.1"
:group 'windows)
@@ -6554,15 +6574,27 @@ split."
;; Split window horizontally.
(with-selected-window window
(split-window-right)))
- (and (eq window (frame-root-window (window-frame window)))
- (not (window-minibuffer-p window))
- ;; If WINDOW is the only window on its frame and is not the
- ;; minibuffer window, try to split it vertically disregarding
- ;; the value of `split-height-threshold'.
- (let ((split-height-threshold 0))
- (when (window-splittable-p window)
- (with-selected-window window
- (split-window-below))))))))
+ (and
+ ;; If WINDOW is the only usable window on its frame (it is
+ ;; the only one or, not being the only one, all the other
+ ;; ones are dedicated) and is not the minibuffer window, try
+ ;; to split it vertically disregarding the value of
+ ;; `split-height-threshold'.
+ (let ((frame (window-frame window)))
+ (or
+ (eq window (frame-root-window frame))
+ (catch 'done
+ (walk-window-tree (lambda (w)
+ (unless (or (eq w window)
+ (window-dedicated-p w))
+ (throw 'done nil)))
+ frame)
+ t)))
+ (not (window-minibuffer-p window))
+ (let ((split-height-threshold 0))
+ (when (window-splittable-p window)
+ (with-selected-window window
+ (split-window-below))))))))
(defun window--try-to-split-window (window &optional alist)
"Try to split WINDOW.
@@ -6734,15 +6766,17 @@ live."
window))
(defun window--maybe-raise-frame (frame)
- (let ((visible (frame-visible-p frame)))
- (unless (or (not visible)
- ;; Assume the selected frame is already visible enough.
- (eq frame (selected-frame))
- ;; Assume the frame from which we invoked the
- ;; minibuffer is visible.
- (and (minibuffer-window-active-p (selected-window))
- (eq frame (window-frame (minibuffer-selected-window)))))
- (raise-frame frame))))
+ (make-frame-visible frame)
+ (unless (or (frame-parameter frame 'no-focus-on-map)
+ ;; Don't raise frames that should not get focus.
+ (frame-parameter frame 'no-accept-focus)
+ ;; Assume the selected frame is already visible enough.
+ (eq frame (selected-frame))
+ ;; Assume the frame from which we invoked the
+ ;; minibuffer is visible.
+ (and (minibuffer-window-active-p (selected-window))
+ (eq frame (window-frame (minibuffer-selected-window)))))
+ (raise-frame frame)))
;; FIXME: Not implemented.
;; FIXME: By the way, there could be more levels of dedication:
@@ -6762,6 +6796,7 @@ The actual non-nil value of this variable will be copied to the
(const display-buffer-pop-up-window)
(const display-buffer-same-window)
(const display-buffer-pop-up-frame)
+ (const display-buffer-in-child-frame)
(const display-buffer-below-selected)
(const display-buffer-at-bottom)
(const display-buffer-in-previous-window)
@@ -6908,6 +6943,7 @@ Available action functions include:
`display-buffer-same-window'
`display-buffer-reuse-window'
`display-buffer-pop-up-frame'
+ `display-buffer-in-child-frame'
`display-buffer-pop-up-window'
`display-buffer-in-previous-window'
`display-buffer-use-some-window'
@@ -7185,9 +7221,9 @@ See `display-buffer' for the format of display actions."
(let ((pars (special-display-p (buffer-name buffer))))
(when pars
(list (list #'display-buffer-reuse-window
- `(lambda (buffer _alist)
- (funcall special-display-function
- buffer ',(if (listp pars) pars)))))))))
+ (lambda (buffer _alist)
+ (funcall special-display-function
+ buffer (if (listp pars) pars)))))))))
(defun display-buffer-pop-up-frame (buffer alist)
"Display BUFFER in a new frame.
@@ -7239,6 +7275,7 @@ raising the frame."
(get-largest-window frame t) alist)
(window--try-to-split-window
(get-lru-window frame t) alist))))
+
(prog1 (window--display-buffer
buffer window 'window alist display-buffer-mark-dedicated)
(unless (cdr (assq 'inhibit-switch-frame alist))
@@ -7258,6 +7295,47 @@ again with `display-buffer-pop-up-window'."
(and pop-up-windows
(display-buffer-pop-up-window buffer alist))))
+(defun display-buffer-in-child-frame (buffer alist)
+ "Display BUFFER in a child frame.
+By default, this either reuses a child frame of the selected
+frame or makes a new child frame of the selected frame. If
+successful, return the window used; otherwise return nil.
+
+If ALIST has a non-nil 'child-frame-parameters' entry, the
+corresponding value is an alist of frame parameters to give the
+new frame. A 'parent-frame' parameter specifying the selected
+frame is provided by default. If the child frame should be or
+become the child of any other frame, a corresponding entry must
+be added to ALIST."
+ (let* ((parameters
+ (append
+ (cdr (assq 'child-frame-parameters alist))
+ `((parent-frame . ,(selected-frame)))))
+ (parent (or (assq 'parent-frame parameters)
+ (selected-frame)))
+ (share (assq 'share-child-frame parameters))
+ share1 frame window)
+ (with-current-buffer buffer
+ (when (frame-live-p parent)
+ (catch 'frame
+ (dolist (frame1 (frame-list))
+ (when (eq (frame-parent frame1) parent)
+ (setq share1 (assq 'share-child-frame
+ (frame-parameters frame1)))
+ (when (eq share share1)
+ (setq frame frame1)
+ (throw 'frame t))))))
+
+ (if frame
+ (setq window (frame-selected-window frame))
+ (setq frame (make-frame parameters))
+ (setq window (frame-selected-window frame))))
+
+ (prog1 (window--display-buffer
+ buffer window 'frame alist display-buffer-mark-dedicated)
+ (unless (cdr (assq 'inhibit-switch-frame alist))
+ (window--maybe-raise-frame frame)))))
+
(defun display-buffer-below-selected (buffer alist)
"Try displaying BUFFER in a window below the selected window.
If there is a window below the selected one and that window
@@ -7272,7 +7350,8 @@ below the selected one, use that window."
(and (not (frame-parameter nil 'unsplittable))
(let ((split-height-threshold 0)
split-width-threshold)
- (setq window (window--try-to-split-window (selected-window) alist)))
+ (setq window (window--try-to-split-window
+ (selected-window) alist)))
(window--display-buffer
buffer window 'window alist display-buffer-mark-dedicated))
(and (setq window (window-in-direction 'below))
@@ -7576,10 +7655,11 @@ another window. In interactive use, if the selected window is
strongly dedicated to its buffer, the value of the option
`switch-to-buffer-in-dedicated-window' specifies how to proceed.
-If called interactively, read the buffer name using the
-minibuffer. The variable `confirm-nonexistent-file-or-buffer'
-determines whether to request confirmation before creating a new
-buffer.
+If called interactively, read the buffer name using `read-buffer'.
+The variable `confirm-nonexistent-file-or-buffer' determines
+whether to request confirmation before creating a new buffer.
+See `read-buffer' for features related to input and completion
+of buffer names.
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
If BUFFER-OR-NAME is a string that does not identify an existing
@@ -7656,10 +7736,11 @@ Return the buffer switched to."
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
nil. Return the buffer switched to.
-If called interactively, prompt for the buffer name using the
-minibuffer. The variable `confirm-nonexistent-file-or-buffer'
-determines whether to request confirmation before creating a new
-buffer.
+If called interactively, read the buffer name using `read-buffer'.
+The variable `confirm-nonexistent-file-or-buffer' determines
+whether to request confirmation before creating a new buffer.
+See `read-buffer' for features related to input and completion
+of buffer names.
If BUFFER-OR-NAME is a string and does not identify an existing
buffer, create a new buffer with that name. If BUFFER-OR-NAME is
@@ -7680,10 +7761,11 @@ documentation for additional customization information."
BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
nil. Return the buffer switched to.
-If called interactively, prompt for the buffer name using the
-minibuffer. The variable `confirm-nonexistent-file-or-buffer'
-determines whether to request confirmation before creating a new
-buffer.
+If called interactively, read the buffer name using `read-buffer'.
+The variable `confirm-nonexistent-file-or-buffer' determines
+whether to request confirmation before creating a new buffer.
+See `read-buffer' for features related to input and completion
+of buffer names.
If BUFFER-OR-NAME is a string and does not identify an existing
buffer, create a new buffer with that name. If BUFFER-OR-NAME is
@@ -7885,10 +7967,12 @@ See also `fit-frame-to-buffer-margins'."
(declare-function x-display-pixel-height "xfns.c" (&optional terminal))
(defun window--sanitize-margin (margin left right)
- "Return MARGIN if it's a number between LEFT and RIGHT."
- (when (and (numberp margin)
- (<= left (- right margin)) (<= margin right))
- margin))
+ "Return MARGIN if it's a number between LEFT and RIGHT.
+Return 0 otherwise."
+ (if (and (numberp margin)
+ (<= left (- right margin)) (<= margin right))
+ margin
+ 0))
(declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
@@ -7906,190 +7990,197 @@ horizontally only.
The new position and size of FRAME can be additionally determined
by customizing the options `fit-frame-to-buffer-sizes' and
-`fit-frame-to-buffer-margins' or the corresponding parameters of
-FRAME."
+`fit-frame-to-buffer-margins' or setting the corresponding
+parameters of FRAME."
(interactive)
- (unless (and (fboundp 'x-display-pixel-height)
- ;; We need the respective sizes now.
- (fboundp 'display-monitor-attributes-list))
+ (unless (fboundp 'display-monitor-attributes-list)
(user-error "Cannot resize frame in non-graphic Emacs"))
(setq frame (window-normalize-frame frame))
(when (window-live-p (frame-root-window frame))
- (with-selected-window (frame-root-window frame)
- (let* ((char-width (frame-char-width))
- (char-height (frame-char-height))
- (monitor-attributes (car (display-monitor-attributes-list
- (frame-parameter frame 'display))))
- (geometry (cdr (assq 'geometry monitor-attributes)))
- (display-width (- (nth 2 geometry) (nth 0 geometry)))
- (display-height (- (nth 3 geometry) (nth 1 geometry)))
- (workarea (cdr (assq 'workarea monitor-attributes)))
- ;; Handle margins.
- (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
- fit-frame-to-buffer-margins))
- (left-margin (if (nth 0 margins)
- (or (window--sanitize-margin
- (nth 0 margins) 0 display-width)
- 0)
- (nth 0 workarea)))
- (top-margin (if (nth 1 margins)
- (or (window--sanitize-margin
- (nth 1 margins) 0 display-height)
- 0)
- (nth 1 workarea)))
- (workarea-width (nth 2 workarea))
- (right-margin (if (nth 2 margins)
- (- display-width
- (or (window--sanitize-margin
- (nth 2 margins) left-margin display-width)
- 0))
- (nth 2 workarea)))
- (workarea-height (nth 3 workarea))
- (bottom-margin (if (nth 3 margins)
- (- display-height
- (or (window--sanitize-margin
- (nth 3 margins) top-margin display-height)
- 0))
- (nth 3 workarea)))
- ;; The pixel width of FRAME (which does not include the
- ;; window manager's decorations).
- (frame-width (frame-pixel-width))
- ;; The pixel width of the body of FRAME's root window.
- (window-body-width (window-body-width nil t))
- ;; The difference in pixels between total and body width of
- ;; FRAME's window.
- (window-extra-width (- (window-pixel-width) window-body-width))
- ;; The difference in pixels between the frame's pixel width
- ;; and the window's body width. This is the space we can't
- ;; use for fitting.
- (extra-width (- frame-width window-body-width))
- ;; The pixel position of FRAME's left border. We usually
- ;; try to leave this alone.
- (left
- (let ((left (frame-parameter nil 'left)))
- (if (consp left)
- (funcall (car left) (cadr left))
- left)))
- ;; The pixel height of FRAME (which does not include title
- ;; line, decorations, and sometimes neither the menu nor
- ;; the toolbar).
- (frame-height (frame-pixel-height))
- ;; The pixel height of FRAME's root window (we don't care
- ;; about the window's body height since the return value of
- ;; `window-text-pixel-size' includes header and mode line).
- (window-height (window-pixel-height))
- ;; The difference in pixels between the frame's pixel
- ;; height and the window's height.
- (extra-height (- frame-height window-height))
- ;; The pixel position of FRAME's top border.
- (top
- (let ((top (frame-parameter nil 'top)))
- (if (consp top)
- (funcall (car top) (cadr top))
- top)))
- ;; Sanitize minimum and maximum sizes.
- (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
- fit-frame-to-buffer-sizes))
- (max-height
- (cond
- ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
- ((numberp max-height) (* max-height char-height))
- (t display-height)))
- (min-height
- (cond
- ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
- ((numberp min-height) (* min-height char-height))
- (t (* window-min-height char-height))))
- (max-width
- (cond
- ((numberp (nth 2 sizes))
- (- (* (nth 2 sizes) char-width) window-extra-width))
- ((numberp max-width)
- (- (* max-width char-width) window-extra-width))
- (t display-width)))
- (min-width
- (cond
- ((numberp (nth 3 sizes))
- (- (* (nth 3 sizes) char-width) window-extra-width))
- ((numberp min-width)
- (- (* min-width char-width) window-extra-width))
- (t (* window-min-width char-width))))
- ;; Note: Currently, for a new frame the sizes of the header
- ;; and mode line may be estimated incorrectly
- (value (window-text-pixel-size
- nil t t workarea-width workarea-height t))
- (width (+ (car value) (window-right-divider-width)))
- (height
- (+ (cdr value)
- (window-bottom-divider-width)
- (window-scroll-bar-height))))
- ;; Don't change height or width when the window's size is fixed
- ;; in either direction or ONLY forbids it.
- (cond
- ((or (eq window-size-fixed 'width) (eq only 'vertically))
- (setq width nil))
- ((or (eq window-size-fixed 'height) (eq only 'horizontally))
- (setq height nil)))
- ;; Fit width to constraints.
- (when width
- (unless frame-resize-pixelwise
- ;; Round to character sizes.
- (setq width (* (/ (+ width char-width -1) char-width)
- char-width)))
- ;; Fit to maximum and minimum widths.
- (setq width (max (min width max-width) min-width))
- ;; Add extra width.
- (setq width (+ width extra-width))
- ;; Preserve margins.
- (let ((right (+ left width)))
- (cond
- ((> right right-margin)
- ;; Move frame to left (we don't know its real width).
- (setq left (max left-margin (- left (- right right-margin)))))
- ((< left left-margin)
- ;; Move frame to right.
- (setq left left-margin)))))
- ;; Fit height to constraints.
- (when height
- (unless frame-resize-pixelwise
- (setq height (* (/ (+ height char-height -1) char-height)
- char-height)))
- ;; Fit to maximum and minimum heights.
- (setq height (max (min height max-height) min-height))
- ;; Add extra height.
- (setq height (+ height extra-height))
- ;; Preserve margins.
- (let ((bottom (+ top height)))
- (cond
- ((> bottom bottom-margin)
- ;; Move frame up (we don't know its real height).
- (setq top (max top-margin (- top (- bottom bottom-margin)))))
- ((< top top-margin)
- ;; Move frame down.
- (setq top top-margin)))))
- ;; Apply changes.
- (set-frame-position frame left top)
- ;; Clumsily try to translate our calculations to what
- ;; `set-frame-size' wants.
- (when width
- (setq width (- (+ (frame-text-width) width)
- extra-width window-body-width)))
- (when height
- (setq height (- (+ (frame-text-height) height)
- extra-height window-height)))
- (set-frame-size
- frame
- (if width
- (if frame-resize-pixelwise
- width
- (/ width char-width))
- (frame-text-width))
- (if height
- (if frame-resize-pixelwise
- height
- (/ height char-height))
- (frame-text-height))
- frame-resize-pixelwise)))))
+ (let* ((char-width (frame-char-width frame))
+ (char-height (frame-char-height frame))
+ ;; WINDOW is FRAME's root window.
+ (window (frame-root-window frame))
+ (parent (frame-parent frame))
+ (monitor-attributes
+ (unless parent
+ (car (display-monitor-attributes-list
+ (frame-parameter frame 'display)))))
+ ;; FRAME'S parent or display sizes. Used in connection
+ ;; with margins.
+ (geometry
+ (unless parent
+ (cdr (assq 'geometry monitor-attributes))))
+ (parent-or-display-width
+ (if parent
+ (frame-native-width parent)
+ (- (nth 2 geometry) (nth 0 geometry))))
+ (parent-or-display-height
+ (if parent
+ (frame-native-height parent)
+ (- (nth 3 geometry) (nth 1 geometry))))
+ ;; FRAME'S parent or workarea sizes. Used when no margins
+ ;; are specified.
+ (parent-or-workarea
+ (if parent
+ `(0 0 ,parent-or-display-width ,parent-or-display-height)
+ (cdr (assq 'workarea monitor-attributes))))
+ ;; The outer size of FRAME. Needed to calculate the
+ ;; margins around the root window's body that have to
+ ;; remain untouched by fitting.
+ (outer-edges (frame-edges frame 'outer-edges))
+ (outer-width (if outer-edges
+ (- (nth 2 outer-edges) (nth 0 outer-edges))
+ ;; A poor guess.
+ (frame-pixel-width frame)))
+ (outer-height (if outer-edges
+ (- (nth 3 outer-edges) (nth 1 outer-edges))
+ ;; Another poor guess.
+ (frame-pixel-height frame)))
+ ;; The text size of FRAME. Needed to specify FRAME's
+ ;; text size after the root window's body's new sizes have
+ ;; been calculated.
+ (text-width (frame-text-width frame))
+ (text-height (frame-text-height frame))
+ ;; WINDOW's body size.
+ (body-width (window-body-width window t))
+ (body-height (window-body-height window t))
+ ;; The difference between FRAME's outer size and WINDOW's
+ ;; body size.
+ (outer-minus-body-width (- outer-width body-width))
+ (outer-minus-body-height (- outer-height body-height))
+ ;; The difference between FRAME's text size and WINDOW's
+ ;; body size (these values "should" be positive).
+ (text-minus-body-width (- text-width body-width))
+ (text-minus-body-height (- text-height body-height))
+ ;; The current position of FRAME.
+ (position (frame-position frame))
+ (left (car position))
+ (top (cdr position))
+ ;; The margins specified for FRAME. These represent pixel
+ ;; offsets from the left, top, right and bottom edge of the
+ ;; display or FRAME's parent's native rectangle and have to
+ ;; take care of the display's taskbar and other obstacles.
+ ;; If they are unspecified, constrain the resulting frame
+ ;; to its workarea or the parent frame's native rectangle.
+ (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
+ fit-frame-to-buffer-margins))
+ ;; Convert margins into pixel offsets from the left-top
+ ;; corner of FRAME's display or parent.
+ (left-margin (if (nth 0 margins)
+ (window--sanitize-margin
+ (nth 0 margins) 0 parent-or-display-width)
+ (nth 0 parent-or-workarea)))
+ (top-margin (if (nth 1 margins)
+ (window--sanitize-margin
+ (nth 1 margins) 0 parent-or-display-height)
+ (nth 1 parent-or-workarea)))
+ (right-margin (if (nth 2 margins)
+ (- parent-or-display-width
+ (window--sanitize-margin
+ (nth 2 margins) left-margin
+ parent-or-display-width))
+ (nth 2 parent-or-workarea)))
+ (bottom-margin (if (nth 3 margins)
+ (- parent-or-display-height
+ (window--sanitize-margin
+ (nth 3 margins) top-margin
+ parent-or-display-height))
+ (nth 3 parent-or-workarea)))
+ ;; Minimum and maximum sizes specified for FRAME.
+ (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
+ fit-frame-to-buffer-sizes))
+ ;; Calculate the minimum and maximum pixel sizes of FRAME
+ ;; from the values provided by the MAX-HEIGHT, MIN-HEIGHT,
+ ;; MAX-WIDTH and MIN-WIDTH arguments or, if these are nil,
+ ;; from those provided by `fit-frame-to-buffer-sizes'.
+ (max-height
+ (min
+ (cond
+ ((numberp max-height) (* max-height char-height))
+ ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
+ (t parent-or-display-height))
+ ;; The following is the maximum height that fits into the
+ ;; top and bottom margins.
+ (max (- bottom-margin top-margin outer-minus-body-height))))
+ (min-height
+ (cond
+ ((numberp min-height) (* min-height char-height))
+ ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
+ (t (window-min-size window nil nil t))))
+ (max-width
+ (min
+ (cond
+ ((numberp max-width) (* max-width char-width))
+ ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
+ (t parent-or-display-width))
+ ;; The following is the maximum width that fits into the
+ ;; left and right margins.
+ (max (- right-margin left-margin outer-minus-body-width))))
+ (min-width
+ (cond
+ ((numberp min-width) (* min-width char-width))
+ ((numberp (nth 3 sizes)) (nth 3 sizes))
+ (t (window-min-size window t nil t))))
+ ;; Note: Currently, for a new frame the sizes of the header
+ ;; and mode line may be estimated incorrectly
+ (size
+ (window-text-pixel-size window t t max-width max-height))
+ (width (max (car size) min-width))
+ (height (max (cdr size) min-height)))
+ ;; Don't change height or width when the window's size is fixed
+ ;; in either direction or ONLY forbids it.
+ (cond
+ ((or (eq window-size-fixed 'width) (eq only 'vertically))
+ (setq width nil))
+ ((or (eq window-size-fixed 'height) (eq only 'horizontally))
+ (setq height nil)))
+ ;; Fit width to constraints.
+ (when width
+ (unless frame-resize-pixelwise
+ ;; Round to character sizes.
+ (setq width (* (/ (+ width char-width -1) char-width)
+ char-width)))
+ ;; The new outer width (in pixels).
+ (setq outer-width (+ width outer-minus-body-width))
+ ;; Maybe move FRAME to preserve margins.
+ (let ((right (+ left outer-width)))
+ (cond
+ ((> right right-margin)
+ ;; Move frame to left.
+ (setq left (max left-margin (- left (- right right-margin)))))
+ ((< left left-margin)
+ ;; Move frame to right.
+ (setq left left-margin)))))
+ ;; Fit height to constraints.
+ (when height
+ (unless frame-resize-pixelwise
+ (setq height (* (/ (+ height char-height -1) char-height)
+ char-height)))
+ ;; The new outer height.
+ (setq outer-height (+ height outer-minus-body-height))
+ ;; Preserve margins.
+ (let ((bottom (+ top outer-height)))
+ (cond
+ ((> bottom bottom-margin)
+ ;; Move frame up.
+ (setq top (max top-margin (- top (- bottom bottom-margin)))))
+ ((< top top-margin)
+ ;; Move frame down.
+ (setq top top-margin)))))
+ ;; Apply our changes.
+ (setq text-width
+ (if width
+ (+ width text-minus-body-width)
+ (frame-text-width frame)))
+ (setq text-height
+ (if height
+ (+ height text-minus-body-height)
+ (frame-text-height frame)))
+ (modify-frame-parameters
+ frame `((left . ,left) (top . ,top)
+ (width . (text-pixels . ,text-width))
+ (height . (text-pixels . ,text-height)))))))
(defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size)
"Adjust size of WINDOW to display its buffer's contents exactly.
@@ -8286,6 +8377,168 @@ Return non-nil if the window was shrunk, nil otherwise."
(when (and (window-combined-p window)
(pos-visible-in-window-p (point-min) window))
(fit-window-to-buffer window (window-total-height window))))
+
+(defun window-largest-empty-rectangle--maximums-1 (quad maximums)
+ "Support function for `window-largest-empty-rectangle'."
+ (cond
+ ((null maximums)
+ (list quad))
+ ((> (car quad) (caar maximums))
+ (cons quad maximums))
+ (t
+ (cons (car maximums)
+ (window-largest-empty-rectangle--maximums-1 quad (cdr maximums))))))
+
+(defun window-largest-empty-rectangle--maximums (quad maximums count)
+ "Support function for `window-largest-empty-rectangle'."
+ (setq maximums (window-largest-empty-rectangle--maximums-1 quad maximums))
+ (if (> (length maximums) count)
+ (nbutlast maximums)
+ maximums))
+
+(defun window-largest-empty-rectangle--disjoint-maximums (maximums count)
+ "Support function for `window-largest-empty-rectangle'."
+ (setq maximums (sort maximums (lambda (x y) (> (car x) (car y)))))
+ (let ((new-length 0)
+ new-maximums)
+ (while (and maximums (< new-length count))
+ (let* ((maximum (car maximums))
+ (at (nth 2 maximum))
+ (to (nth 3 maximum)))
+ (catch 'drop
+ (dolist (new-maximum new-maximums)
+ (let ((new-at (nth 2 new-maximum))
+ (new-to (nth 3 new-maximum)))
+ (when (if (< at new-at) (> to new-at) (< at new-to))
+ ;; Intersection -> drop.
+ (throw 'drop nil))))
+ (setq new-maximums (cons maximum new-maximums))
+ (setq new-length (1+ new-length)))
+ (setq maximums (cdr maximums))))
+
+ (nreverse new-maximums)))
+
+(defun window-largest-empty-rectangle (&optional window count min-width min-height positions left)
+ "Return dimensions of largest empty rectangle in WINDOW.
+WINDOW must be a live window and defaults to the selected one.
+
+The return value is a triple of the width and the start and end
+Y-coordinates of the largest rectangle that can be inscribed into
+the empty space (the space not displaying any text) of WINDOW's
+text area. The return value is nil if the current glyph matrix
+of WINDOW is not up-to-date.
+
+Optional argument COUNT, if non-nil, specifies the maximum number
+of rectangles to return. This means that the return value is a
+list of triples specifying rectangles with the largest rectangle
+first. COUNT can be also a cons cell whose car specifies the
+number of rectangles to return and whose cdr, if non-nil, states
+that all rectangles returned must be disjoint.
+
+Note that the right edge of any rectangle returned by this
+function is the right edge of WINDOW (the left edge if its buffer
+displays RTL text).
+
+Optional arguments MIN-WIDTH and MIN-HEIGHT, if non-nil, specify
+the minimum width and height of any rectangle returned.
+
+Optional argument POSITIONS, if non-nil, is a cons cell whose car
+specifies the uppermost and whose cdr specifies the lowermost
+pixel position that must be covered by any rectangle returned.
+Note that positions are counted from the start of the text area
+of WINDOW.
+
+Optional argument LEFT, if non-nil, means to return values suitable for
+buffers displaying right to left text."
+ ;; Process lines as returned by ‘window-lines-pixel-dimensions’.
+ ;; STACK is a stack that contains rows that have to be processed yet.
+ (let* ((window (window-normalize-window window t))
+ (disjoint (and (consp count) (cdr count)))
+ (count (or (and (numberp count) count)
+ (and (consp count) (numberp (car count)) (car count))))
+ (rows (window-lines-pixel-dimensions window nil nil t t left))
+ (rows-at 0)
+ (max-size 0)
+ row stack stack-at stack-to
+ top top-width top-at top-to top-size
+ max-width max-at max-to maximums)
+ ;; ROWS-AT is the position where the first element of ROWS starts.
+ ;; STACK-AT is the position where the first element of STACK starts.
+ (while rows
+ (setq row (car rows))
+ (if (or (not stack) (>= (car row) (caar stack)))
+ (progn
+ (unless stack
+ (setq stack-at rows-at))
+ (setq stack (cons row stack))
+ ;; Set ROWS-AT to where the first element of ROWS ends
+ ;; which, after popping ROW, makes it the start position of
+ ;; the next ROW.
+ (setq rows-at (cdr row))
+ (setq rows (cdr rows)))
+ (setq top (car stack))
+ (setq stack (cdr stack))
+ (setq top-width (car top))
+ (setq top-at (if stack (cdar stack) stack-at))
+ (setq top-to (cdr top))
+ (setq top-size (* top-width (- top-to top-at)))
+ (unless (or (and min-width (< top-width min-width))
+ (and min-height (< (- top-to top-at) min-height))
+ (and positions
+ (or (> top-at (car positions))
+ (< top-to (cdr positions)))))
+ (if count
+ (if disjoint
+ (setq maximums (cons (list top-size top-width top-at top-to)
+ maximums))
+ (setq maximums (window-largest-empty-rectangle--maximums
+ (list top-size top-width top-at top-to)
+ maximums count)))
+ (when (> top-size max-size)
+ (setq max-size top-size)
+ (setq max-width top-width)
+ (setq max-at top-at)
+ (setq max-to top-to))))
+ (if (and stack (> (caar stack) (car row)))
+ ;; Have new top element of stack include old top.
+ (setq stack (cons (cons (caar stack) (cdr top)) (cdr stack)))
+ ;; Move rows-at backwards to top-at.
+ (setq rows-at top-at))))
+
+ (when stack
+ ;; STACK-TO is the position where the stack ends.
+ (setq stack-to (cdar stack))
+ (while stack
+ (setq top (car stack))
+ (setq stack (cdr stack))
+ (setq top-width (car top))
+ (setq top-at (if stack (cdar stack) stack-at))
+ (setq top-size (* top-width (- stack-to top-at)))
+ (unless (or (and min-width (< top-width min-width))
+ (and min-height (< (- stack-to top-at) min-height))
+ (and positions
+ (or (> top-at (car positions))
+ (< stack-to (cdr positions)))))
+ (if count
+ (if disjoint
+ (setq maximums (cons (list top-size top-width top-at stack-to)
+ maximums))
+ (setq maximums (window-largest-empty-rectangle--maximums
+ (list top-size top-width top-at stack-to)
+ maximums count)))
+ (when (> top-size max-size)
+ (setq max-size top-size)
+ (setq max-width top-width)
+ (setq max-at top-at)
+ (setq max-to stack-to))))))
+
+ (cond
+ (maximums
+ (if disjoint
+ (window-largest-empty-rectangle--disjoint-maximums maximums count)
+ maximums))
+ ((> max-size 0)
+ (list max-width max-at max-to)))))
(defun kill-buffer-and-window ()
"Kill the current buffer and delete the selected window."
@@ -8441,7 +8694,7 @@ result is a list containing only the selected window."
(make-variable-buffer-local 'move-to-window-group-line-function)
(put 'move-to-window-group-line-function 'permanent-local t)
(defun move-to-window-group-line (arg)
- "Position point relative to the the current group of windows.
+ "Position point relative to the current group of windows.
When a grouping mode (such as Follow Mode) is not active, this
function is identical to `move-to-window-line'.
diff --git a/lisp/winner.el b/lisp/winner.el
index 7b0483338b9..6bc27484a79 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -304,12 +304,15 @@ You may want to include buffer names such as *Help*, *Apropos*,
(push win xwins))) ; delete this window
;; Restore marks
- (save-current-buffer
- (cl-loop for buf in buffers
- for entry = (cadr (assq buf winner-point-alist))
- do (progn (set-buffer buf)
- (set-mark (car entry))
- (setf (winner-active-region) (cdr entry)))))
+ ;; `winner-undo' shouldn't update the selection (Bug#28631) when
+ ;; select-enable-primary is non-nil.
+ (unless select-enable-primary
+ (save-current-buffer
+ (cl-loop for buf in buffers
+ for entry = (cadr (assq buf winner-point-alist))
+ do (progn (set-buffer buf)
+ (set-mark (car entry))
+ (setf (winner-active-region) (cdr entry))))))
;; Delete windows, whose buffers are dead or boring.
;; Return t if this is still a possible configuration.
(or (null xwins)
diff --git a/lisp/woman.el b/lisp/woman.el
index aa856c39577..1edf6e34c35 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -22,7 +22,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1619,7 +1619,7 @@ decompress the file if appropriate. See the documentation for the
(setq woman-buffer-alist
(cons (cons file-name bufname) woman-buffer-alist)
woman-buffer-number 0)))))
- (Man-build-section-alist)
+ (Man-build-section-list)
(Man-build-references-alist)
(goto-char (point-min)))
@@ -4261,22 +4261,11 @@ Delete line from point and eol unless LEAVE-EOL is non-nil."
(if (> i 0) (setq woman-prevailing-indent i))))
woman-prevailing-indent)
-(defmacro woman-push (value stack)
- "Push VALUE onto STACK."
- `(setq ,stack (cons ,value ,stack)))
-
-(defmacro woman-pop (variable stack)
- "Pop into VARIABLE the value at the top of STACK.
-Allow for mismatched requests!"
- `(if ,stack
- (setq ,variable (car ,stack)
- ,stack (cdr ,stack))))
-
(defun woman2-RS (to)
".RS i -- Start relative indent, move left margin in distance i.
Set prevailing indent to 5 for nested indents. Format paragraphs upto TO."
- (woman-push woman-left-margin woman-RS-left-margin)
- (woman-push woman-prevailing-indent woman-RS-prevailing-indent)
+ (push woman-left-margin woman-RS-left-margin)
+ (push woman-prevailing-indent woman-RS-prevailing-indent)
(setq woman-left-margin (+ woman-left-margin
(woman2-get-prevailing-indent))
woman-prevailing-indent woman-default-indent)
@@ -4285,8 +4274,10 @@ Set prevailing indent to 5 for nested indents. Format paragraphs upto TO."
(defun woman2-RE (to)
".RE -- End of relative indent. Format paragraphs upto TO.
Set prevailing indent to amount of starting .RS."
- (woman-pop woman-left-margin woman-RS-left-margin)
- (woman-pop woman-prevailing-indent woman-RS-prevailing-indent)
+ (when woman-RS-left-margin
+ (setq woman-left-margin (pop woman-RS-left-margin)))
+ (when woman-RS-prevailing-indent
+ (setq woman-prevailing-indent (pop woman-RS-prevailing-indent)))
(woman-delete-line 1) ; ignore any arguments
(woman2-format-paragraphs to woman-left-margin))
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 80ec4101bdf..acbdcb9ee5c 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/xdg.el b/lisp/xdg.el
index 4973065f91a..9edc3d2629c 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,9 +29,14 @@
;; - XDG Base Directory Specification
;; - Thumbnail Managing Standard
;; - xdg-user-dirs configuration
+;; - Desktop Entry Specification
;;; Code:
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
+
;; XDG Base Directory Specification
;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
@@ -80,7 +85,7 @@
(defun xdg-thumb-uri (filename)
"Return the canonical URI for FILENAME.
-If FILENAME has absolute path /foo/bar.jpg, its canonical URI is
+If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is
file:///foo/bar.jpg"
(concat "file://" (expand-file-name filename)))
@@ -89,8 +94,8 @@ file:///foo/bar.jpg"
(concat (md5 (xdg-thumb-uri filename)) ".png"))
(defun xdg-thumb-mtime (filename)
- "Return modification time of FILENAME as integral seconds from the epoch."
- (floor (float-time (nth 5 (file-attributes filename)))))
+ "Return modification time of FILENAME as an Emacs timestamp."
+ (file-attribute-modification-time (file-attributes filename)))
;; XDG User Directories
@@ -128,17 +133,18 @@ This should be called at the beginning of a line."
(defun xdg--user-dirs-parse-file (filename)
"Return alist of xdg-user-dirs from FILENAME."
(let (elt res)
- (with-temp-buffer
- (insert-file-contents filename)
- (goto-char (point-min))
- (while (not (eobp))
- (setq elt (xdg--user-dirs-parse-line))
- (when (consp elt) (push elt res))
- (forward-line)))
+ (when (file-readable-p filename)
+ (with-temp-buffer
+ (insert-file-contents filename)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq elt (xdg--user-dirs-parse-line))
+ (when (consp elt) (push elt res))
+ (forward-line))))
res))
(defun xdg-user-dir (name)
- "Return the path of user directory referred to by NAME."
+ "Return the directory referred to by NAME."
(when (null xdg-user-dirs)
(setq xdg-user-dirs
(xdg--user-dirs-parse-file
@@ -146,6 +152,169 @@ This should be called at the beginning of a line."
(let ((dir (cdr (assoc name xdg-user-dirs))))
(when dir (expand-file-name dir))))
+
+;; Desktop Entry Specification
+;; https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.1.html
+
+(defconst xdg-desktop-group-regexp
+ (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]")
+ "Regexp matching desktop file group header names.")
+
+;; TODO Localized strings left out intentionally, as Emacs has no
+;; notion of l10n/i18n
+(defconst xdg-desktop-entry-regexp
+ (rx (group-n 1 (+ (in "A-Za-z0-9-")))
+ ;; (? "[" (group-n 3 (+ nonl)) "]")
+ (* blank) "=" (* blank)
+ (group-n 2 (* nonl)))
+ "Regexp matching desktop file entry key-value pairs.")
+
+(defun xdg-desktop-read-group ()
+ "Return hash table of group of desktop entries in the current buffer."
+ (let ((res (make-hash-table :test #'equal)))
+ (while (not (or (eobp) (looking-at xdg-desktop-group-regexp)))
+ (skip-chars-forward "[:blank:]")
+ (cond
+ ((eolp))
+ ((= (following-char) ?#))
+ ((looking-at xdg-desktop-entry-regexp)
+ (puthash (match-string 1) (match-string 2) res))
+ ;; Filter localized strings
+ ((looking-at (rx (group-n 1 (+ (in alnum "-"))) (* blank) "[")))
+ (t (error "Malformed line: %s"
+ (buffer-substring (point) (point-at-eol)))))
+ (forward-line))
+ res))
+
+(defun xdg-desktop-read-file (filename &optional group)
+ "Return group contents of desktop file FILENAME as a hash table.
+Optional argument GROUP defaults to the string \"Desktop Entry\"."
+ (with-temp-buffer
+ (insert-file-contents-literally filename)
+ (goto-char (point-min))
+ (while (and (skip-chars-forward "[:blank:]" (line-end-position))
+ (or (eolp) (= (following-char) ?#)))
+ (forward-line))
+ (unless (looking-at xdg-desktop-group-regexp)
+ (error "Expected group name! Instead saw: %s"
+ (buffer-substring (point) (point-at-eol))))
+ (when group
+ (while (and (re-search-forward xdg-desktop-group-regexp nil t)
+ (not (equal (match-string 1) group)))))
+ (forward-line)
+ (xdg-desktop-read-group)))
+
+(defun xdg-desktop-strings (value)
+ "Partition VALUE into elements delimited by unescaped semicolons."
+ (let (res)
+ (setq value (string-trim-left value))
+ (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) ";"))
+ (push (replace-regexp-in-string "\0" ";" x) res))
+ (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res))
+ (nreverse res)))
+
+
+;; MIME apps specification
+;; https://standards.freedesktop.org/mime-apps-spec/mime-apps-spec-1.0.1.html
+
+(defvar xdg-mime-table nil
+ "Table of MIME type to desktop file associations.
+The table is an alist with keys being MIME major types (\"application\",
+\"audio\", etc.), and values being hash tables. Each hash table has
+MIME subtypes as keys and lists of desktop file absolute filenames.")
+
+(defun xdg-mime-apps-files ()
+ "Return a list of files containing MIME/Desktop associations.
+The list is in order of descending priority: user config, then
+admin config, and finally system cached associations."
+ (let ((xdg-data-dirs (xdg-data-dirs))
+ (desktop (getenv "XDG_CURRENT_DESKTOP"))
+ res)
+ (when desktop
+ (setq desktop (format "%s-mimeapps.list" desktop)))
+ (dolist (name (cons "mimeapps.list" desktop))
+ (push (expand-file-name name (xdg-config-home)) res)
+ (push (expand-file-name (format "applications/%s" name) (xdg-data-home))
+ res)
+ (dolist (dir (xdg-config-dirs))
+ (push (expand-file-name name dir) res))
+ (dolist (dir xdg-data-dirs)
+ (push (expand-file-name (format "applications/%s" name) dir) res)))
+ (dolist (dir xdg-data-dirs)
+ (push (expand-file-name "applications/mimeinfo.cache" dir) res))
+ (nreverse res)))
+
+(defun xdg-mime-collect-associations (mime files)
+ "Return a list of desktop file names associated with MIME.
+The associations are searched in the list of file names FILES,
+which is expected to be ordered by priority as in
+`xdg-mime-apps-files'."
+ (let ((regexp (concat (regexp-quote mime) "=\\([^[:cntrl:]]*\\)$"))
+ res sec defaults added removed cached)
+ (with-temp-buffer
+ (dolist (f (reverse files))
+ (when (file-readable-p f)
+ (insert-file-contents-literally f nil nil nil t)
+ (goto-char (point-min))
+ (let (end)
+ (while (not (or (eobp) end))
+ (if (= (following-char) ?\[)
+ (progn (setq sec (char-after (1+ (point))))
+ (forward-line))
+ (if (not (looking-at regexp))
+ (forward-line)
+ (dolist (str (xdg-desktop-strings (match-string 1)))
+ (cl-pushnew str
+ (cond ((eq sec ?D) defaults)
+ ((eq sec ?A) added)
+ ((eq sec ?R) removed)
+ ((eq sec ?M) cached))
+ :test #'equal))
+ (while (and (zerop (forward-line))
+ (/= (following-char) ?\[)))))))
+ ;; Accumulate results into res
+ (dolist (f cached)
+ (when (not (member f removed)) (cl-pushnew f res :test #'equal)))
+ (dolist (f added)
+ (when (not (member f removed)) (push f res)))
+ (dolist (f removed)
+ (setq res (delete f res)))
+ (dolist (f defaults)
+ (push f res))
+ (setq defaults nil added nil removed nil cached nil))))
+ (delete-dups res)))
+
+(defun xdg-mime-apps (mime)
+ "Return list of desktop files associated with MIME, otherwise nil.
+The list is in order of descending priority, and each element is
+an absolute file name of a readable file.
+Results are cached in `xdg-mime-table'."
+ (pcase-let ((`(,type ,subtype) (split-string mime "/"))
+ (xdg-data-dirs (xdg-data-dirs))
+ (caches (xdg-mime-apps-files))
+ (files ()))
+ (let ((mtim1 (get 'xdg-mime-table 'mtime))
+ (mtim2 (cl-loop for f in caches when (file-readable-p f)
+ maximize (float-time (nth 5 (file-attributes f))))))
+ ;; If one of the MIME/Desktop cache files has been modified:
+ (when (or (null mtim1) (time-less-p mtim1 mtim2))
+ (setq xdg-mime-table nil)))
+ (when (null (assoc type xdg-mime-table))
+ (push (cons type (make-hash-table :test #'equal)) xdg-mime-table))
+ (if (let ((def (make-symbol "def"))
+ (table (cdr (assoc type xdg-mime-table))))
+ (not (eq (setq files (gethash subtype table def)) def)))
+ files
+ (and files (setq files nil))
+ (let ((dirs (mapcar (lambda (dir) (expand-file-name "applications" dir))
+ (cons (xdg-data-home) xdg-data-dirs))))
+ ;; Not being particular about desktop IDs
+ (dolist (f (nreverse (xdg-mime-collect-associations mime caches)))
+ (push (locate-file f dirs) files))
+ (when files
+ (put 'xdg-mime-table 'mtime (current-time)))
+ (puthash subtype (delq nil files) (cdr (assoc type xdg-mime-table)))))))
+
(provide 'xdg)
;;; xdg.el ends here
diff --git a/lisp/xml.el b/lisp/xml.el
index 88dc70bc413..36880886938 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index acb30187a8e..d704cfa4e8f 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -278,6 +278,8 @@ which is the \"1006\" extension implemented in Xterm >= 277."
(last-name (symbol-name last-type))
(last-time (nth 1 last-click))
(click-count (nth 2 last-click))
+ (last-x (nth 3 last-click))
+ (last-y (nth 4 last-click))
(this-time (float-time))
(name (symbol-name type)))
(cond
@@ -288,14 +290,20 @@ which is the \"1006\" extension implemented in Xterm >= 277."
(string-match "down-" last-name)
(equal name (replace-match "" t t last-name)))
(xterm-mouse--set-click-count event click-count)))
- ((not last-time) nil)
- ((and (> double-click-time (* 1000 (- this-time last-time)))
+ ((and last-time
+ double-click-time
+ (or (eq double-click-time t)
+ (> double-click-time (* 1000 (- this-time last-time))))
+ (<= (abs (- x last-x))
+ (/ double-click-fuzz 8))
+ (<= (abs (- y last-y))
+ (/ double-click-fuzz 8))
(equal last-name (replace-match "" t t name)))
(setq click-count (1+ click-count))
(xterm-mouse--set-click-count event click-count))
(t (setq click-count 1)))
(set-terminal-parameter nil 'xterm-mouse-last-click
- (list type this-time click-count)))
+ (list type this-time click-count x y)))
(set-terminal-parameter nil 'xterm-mouse-x x)
(set-terminal-parameter nil 'xterm-mouse-y y)
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index c908f1a5b0f..5e37209cc2e 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;
;; --------------------------------------------------------------------
diff --git a/lwlib/COPYING b/lwlib/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/lwlib/COPYING
+++ b/lwlib/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/lwlib/ChangeLog.1 b/lwlib/ChangeLog.1
index 56259498a90..623b798cc73 100644
--- a/lwlib/ChangeLog.1
+++ b/lwlib/ChangeLog.1
@@ -1979,4 +1979,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in
index ee7a2040e89..148002aaaee 100644
--- a/lwlib/Makefile.in
+++ b/lwlib/Makefile.in
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# This was taken from the output of Imake using Lucid's Imakefile.
diff --git a/lwlib/deps.mk b/lwlib/deps.mk
index 525c9f12306..5bdf1af7788 100644
--- a/lwlib/deps.mk
+++ b/lwlib/deps.mk
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c
index ec33e788296..ce007ae8b0b 100644
--- a/lwlib/lwlib-Xaw.c
+++ b/lwlib/lwlib-Xaw.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lwlib/lwlib-Xlw.c b/lwlib/lwlib-Xlw.c
index 10ed3267d6b..0d58a030ac0 100644
--- a/lwlib/lwlib-Xlw.c
+++ b/lwlib/lwlib-Xlw.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c
index b18429067d8..2ac543cad7c 100644
--- a/lwlib/lwlib-Xm.c
+++ b/lwlib/lwlib-Xm.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lwlib/lwlib-Xm.h b/lwlib/lwlib-Xm.h
index 043ebc7c0d8..09b19204407 100644
--- a/lwlib/lwlib-Xm.h
+++ b/lwlib/lwlib-Xm.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef LWLIB_XM_H
#define LWLIB_XM_H
diff --git a/lwlib/lwlib-int.h b/lwlib/lwlib-int.h
index 5b739971e26..ae195a39a8f 100644
--- a/lwlib/lwlib-int.h
+++ b/lwlib/lwlib-int.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef LWLIB_INTERNAL_H
diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c
index 3c7a7a6bf7b..6f33e510f71 100644
--- a/lwlib/lwlib-utils.c
+++ b/lwlib/lwlib-utils.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lwlib/lwlib-widget.h b/lwlib/lwlib-widget.h
index 6a88d2a18cd..6863b90c9ac 100644
--- a/lwlib/lwlib-widget.h
+++ b/lwlib/lwlib-widget.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* This part is separate from lwlib.h because it does not need X,
and thus can be used by non-X code in Emacs proper. */
diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c
index fffb17f7c33..30fa046cb73 100644
--- a/lwlib/lwlib.c
+++ b/lwlib/lwlib.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/lwlib/lwlib.h b/lwlib/lwlib.h
index f88536982e8..e28d0e8356f 100644
--- a/lwlib/lwlib.h
+++ b/lwlib/lwlib.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef LWLIB_H
diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c
index 1ce4aead93f..cfd20ba649e 100644
--- a/lwlib/xlwmenu.c
+++ b/lwlib/xlwmenu.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Created by devin@lucid.com */
diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h
index a6aed48633f..7c278396253 100644
--- a/lwlib/xlwmenu.h
+++ b/lwlib/xlwmenu.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _XlwMenu_h
#define _XlwMenu_h
diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h
index a89934cefe8..e7be866be79 100644
--- a/lwlib/xlwmenuP.h
+++ b/lwlib/xlwmenuP.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _XlwMenuP_h
#define _XlwMenuP_h
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 7f0604cbdac..867954a2e37 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -44,12 +44,12 @@ AC_DEFUN([gl_FUNC_ALLOCA],
AC_DEFUN([gl_PREREQ_ALLOCA], [:])
# This works around a bug in autoconf <= 2.68.
-# See <http://lists.gnu.org/archive/html/bug-gnulib/2011-06/msg00277.html>.
+# See <https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html>.
m4_version_prereq([2.69], [] ,[
# This is taken from the following Autoconf patch:
-# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497
+# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497
# _AC_LIBOBJ_ALLOCA
# -----------------
diff --git a/m4/d-type.m4 b/m4/d-type.m4
new file mode 100644
index 00000000000..c819fc02f84
--- /dev/null
+++ b/m4/d-type.m4
@@ -0,0 +1,32 @@
+# serial 12
+
+dnl From Jim Meyering.
+dnl
+dnl Check whether struct dirent has a member named d_type.
+dnl
+
+# Copyright (C) 1997, 1999-2004, 2006, 2009-2017 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.
+
+AC_DEFUN([gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE],
+ [AC_CACHE_CHECK([for d_type member in directory struct],
+ [gl_cv_struct_dirent_d_type],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM([[
+#include <sys/types.h>
+#include <dirent.h>
+ ]],
+ [[struct dirent dp; dp.d_type = 0;]])],
+ [gl_cv_struct_dirent_d_type=yes],
+ [gl_cv_struct_dirent_d_type=no])
+ ]
+ )
+ if test $gl_cv_struct_dirent_d_type = yes; then
+ AC_DEFINE([HAVE_STRUCT_DIRENT_D_TYPE], [1],
+ [Define if there is a member named d_type in the struct describing
+ directory headers.])
+ fi
+ ]
+)
diff --git a/m4/dirfd.m4 b/m4/dirfd.m4
index b4ec3d1910b..d472c38549d 100644
--- a/m4/dirfd.m4
+++ b/m4/dirfd.m4
@@ -1,4 +1,4 @@
-# serial 24 -*- Autoconf -*-
+# serial 26 -*- Autoconf -*-
dnl Find out how to get the file descriptor associated with an open DIR*.
@@ -12,6 +12,7 @@ dnl From Jim Meyering
AC_DEFUN([gl_FUNC_DIRFD],
[
AC_REQUIRE([gl_DIRENT_H_DEFAULTS])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
dnl Persuade glibc <dirent.h> to declare dirfd().
AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
@@ -25,15 +26,15 @@ AC_DEFUN([gl_FUNC_DIRFD],
fi
AC_CACHE_CHECK([whether dirfd is a macro],
- gl_cv_func_dirfd_macro,
+ [gl_cv_func_dirfd_macro],
[AC_EGREP_CPP([dirent_header_defines_dirfd], [
#include <sys/types.h>
#include <dirent.h>
#ifdef dirfd
dirent_header_defines_dirfd
#endif],
- gl_cv_func_dirfd_macro=yes,
- gl_cv_func_dirfd_macro=no)])
+ [gl_cv_func_dirfd_macro=yes],
+ [gl_cv_func_dirfd_macro=no])])
# Use the replacement if we have no function or macro with that name,
# or if OS/2 kLIBC whose dirfd() does not work.
diff --git a/m4/explicit_bzero.m4 b/m4/explicit_bzero.m4
new file mode 100644
index 00000000000..f9dc678207a
--- /dev/null
+++ b/m4/explicit_bzero.m4
@@ -0,0 +1,22 @@
+dnl Copyright 2017 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_EXPLICIT_BZERO],
+[
+ AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS])
+
+ dnl Persuade glibc <string.h> to declare explicit_bzero.
+ AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_FUNCS_ONCE([explicit_bzero])
+ if test $ac_cv_func_explicit_bzero = no; then
+ HAVE_EXPLICIT_BZERO=0
+ fi
+])
+
+AC_DEFUN([gl_PREREQ_EXPLICIT_BZERO],
+[
+ AC_CHECK_FUNCS([explicit_memset])
+])
diff --git a/m4/extensions.m4 b/m4/extensions.m4
index c60f537db17..f8543386795 100644
--- a/m4/extensions.m4
+++ b/m4/extensions.m4
@@ -1,4 +1,4 @@
-# serial 15 -*- Autoconf -*-
+# serial 17 -*- Autoconf -*-
# Enable extensions on systems that normally disable them.
# Copyright (C) 2003, 2006-2017 Free Software Foundation, Inc.
@@ -68,6 +68,14 @@ dnl configure.ac when using autoheader 2.62.
#ifndef _GNU_SOURCE
# undef _GNU_SOURCE
#endif
+/* Enable NetBSD extensions on NetBSD. */
+#ifndef _NETBSD_SOURCE
+# undef _NETBSD_SOURCE
+#endif
+/* Enable OpenBSD extensions on NetBSD. */
+#ifndef _OPENBSD_SOURCE
+# undef _OPENBSD_SOURCE
+#endif
/* Enable threading extensions on Solaris. */
#ifndef _POSIX_PTHREAD_SEMANTICS
# undef _POSIX_PTHREAD_SEMANTICS
@@ -128,6 +136,8 @@ dnl configure.ac when using autoheader 2.62.
AC_DEFINE([_ALL_SOURCE])
AC_DEFINE([_DARWIN_C_SOURCE])
AC_DEFINE([_GNU_SOURCE])
+ AC_DEFINE([_NETBSD_SOURCE])
+ AC_DEFINE([_OPENBSD_SOURCE])
AC_DEFINE([_POSIX_PTHREAD_SEMANTICS])
AC_DEFINE([__STDC_WANT_IEC_60559_ATTRIBS_EXT__])
AC_DEFINE([__STDC_WANT_IEC_60559_BFP_EXT__])
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
index 00f960968b0..207aa6a0895 100644
--- a/m4/extern-inline.m4
+++ b/m4/extern-inline.m4
@@ -11,7 +11,7 @@ AC_DEFUN([gl_EXTERN_INLINE],
[/* Please see the Gnulib manual for how to use these macros.
Suppress extern inline with HP-UX cc, as it appears to be broken; see
- <http://lists.gnu.org/archive/html/bug-texinfo/2013-02/msg00030.html>.
+ <https://lists.gnu.org/r/bug-texinfo/2013-02/msg00030.html>.
Suppress extern inline with Sun C in standards-conformance mode, as it
mishandles inline functions that call each other. E.g., for 'inline void f
@@ -28,16 +28,16 @@ AC_DEFUN([gl_EXTERN_INLINE],
from calling static functions. This bug is known to occur on:
OS X 10.8 and earlier; see:
- http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html
+ https://lists.gnu.org/r/bug-gnulib/2012-12/msg00023.html
DragonFly; see
http://muscles.dragonflybsd.org/bulk/bleeding-edge-potential/latest-per-pkg/ah-tty-0.3.12.log
FreeBSD; see:
- http://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html
+ https://lists.gnu.org/r/bug-gnulib/2014-07/msg00104.html
OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and
- for clang but remains for g++; see <http://trac.macports.org/ticket/41033>.
+ for clang but remains for g++; see <https://trac.macports.org/ticket/41033>.
Assume DragonFly and FreeBSD will be similar. */
#if (((defined __APPLE__ && defined __MACH__) \
|| defined __DragonFly__ || defined __FreeBSD__) \
diff --git a/m4/faccessat.m4 b/m4/faccessat.m4
index 837ae5407c9..c64545abd46 100644
--- a/m4/faccessat.m4
+++ b/m4/faccessat.m4
@@ -1,4 +1,4 @@
-# serial 6
+# serial 8
# See if we need to provide faccessat replacement.
dnl Copyright (C) 2009-2017 Free Software Foundation, Inc.
@@ -11,6 +11,7 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_FACCESSAT],
[
AC_REQUIRE([gl_UNISTD_H_DEFAULTS])
+ AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
dnl Persuade glibc <unistd.h> to declare faccessat().
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
@@ -18,10 +19,15 @@ AC_DEFUN([gl_FUNC_FACCESSAT],
AC_CHECK_FUNCS_ONCE([faccessat])
if test $ac_cv_func_faccessat = no; then
HAVE_FACCESSAT=0
+ else
+ case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
+ *yes) ;;
+ *) REPLACE_FACCESSAT=1 ;;
+ esac
fi
])
-# Prerequisites of lib/faccessat.m4.
+# Prerequisites of lib/faccessat.c.
AC_DEFUN([gl_PREREQ_FACCESSAT],
[
AC_CHECK_FUNCS([access])
diff --git a/m4/fstatat.m4 b/m4/fstatat.m4
index 75cf0110401..767eb83db4b 100644
--- a/m4/fstatat.m4
+++ b/m4/fstatat.m4
@@ -1,4 +1,4 @@
-# fstatat.m4 serial 3
+# fstatat.m4 serial 4
dnl Copyright (C) 2004-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -13,14 +13,14 @@ AC_DEFUN([gl_FUNC_FSTATAT],
AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
- AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
+ AC_REQUIRE([AC_CANONICAL_HOST])
AC_CHECK_FUNCS_ONCE([fstatat])
if test $ac_cv_func_fstatat = no; then
HAVE_FSTATAT=0
else
dnl Test for an AIX 7.1 bug; see
- dnl <http://lists.gnu.org/archive/html/bug-tar/2011-09/msg00015.html>.
+ dnl <https://lists.gnu.org/r/bug-tar/2011-09/msg00015.html>.
AC_CACHE_CHECK([whether fstatat (..., 0) works],
[gl_cv_func_fstatat_zero_flag],
[AC_RUN_IFELSE(
@@ -46,15 +46,20 @@ AC_DEFUN([gl_FUNC_FSTATAT],
case $gl_cv_func_fstatat_zero_flag+$gl_cv_func_lstat_dereferences_slashed_symlink in
*yes+*yes) ;;
- *) REPLACE_FSTATAT=1
- case $gl_cv_func_fstatat_zero_flag in
- *yes)
+ *) REPLACE_FSTATAT=1 ;;
+ esac
+
+ case $host_os in
+ solaris*)
+ REPLACE_FSTATAT=1 ;;
+ esac
+
+ case $REPLACE_FSTATAT,$gl_cv_func_fstatat_zero_flag in
+ 1,*yes)
AC_DEFINE([HAVE_WORKING_FSTATAT_ZERO_FLAG], [1],
[Define to 1 if fstatat (..., 0) works.
For example, it does not work in AIX 7.1.])
;;
- esac
- ;;
esac
fi
])
diff --git a/m4/fsusage.m4 b/m4/fsusage.m4
new file mode 100644
index 00000000000..1d6ad41cd3c
--- /dev/null
+++ b/m4/fsusage.m4
@@ -0,0 +1,336 @@
+# serial 32
+# Obtaining file system usage information.
+
+# Copyright (C) 1997-1998, 2000-2001, 2003-2017 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 Jim Meyering.
+
+AC_DEFUN([gl_FSUSAGE],
+[
+ AC_CHECK_HEADERS_ONCE([sys/param.h])
+ AC_CHECK_HEADERS_ONCE([sys/vfs.h sys/fs_types.h])
+ AC_CHECK_HEADERS([sys/mount.h], [], [],
+ [AC_INCLUDES_DEFAULT
+ [#if HAVE_SYS_PARAM_H
+ #include <sys/param.h>
+ #endif]])
+ gl_FILE_SYSTEM_USAGE([gl_cv_fs_space=yes], [gl_cv_fs_space=no])
+])
+
+# Try to determine how a program can obtain file system usage information.
+# If successful, define the appropriate symbol (see fsusage.c) and
+# execute ACTION-IF-FOUND. Otherwise, execute ACTION-IF-NOT-FOUND.
+#
+# gl_FILE_SYSTEM_USAGE([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]])
+
+AC_DEFUN([gl_FILE_SYSTEM_USAGE],
+[
+dnl Enable large-file support. This has the effect of changing the size
+dnl of field f_blocks in 'struct statvfs' from 32 bit to 64 bit on
+dnl glibc/Hurd, HP-UX 11, Solaris (32-bit mode). It also changes the size
+dnl of field f_blocks in 'struct statfs' from 32 bit to 64 bit on
+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
+# statvfs function. This check is more than just AC_CHECK_FUNCS([statvfs])
+# because that got a false positive on SCO OSR5. Adding the declaration
+# of a 'struct statvfs' causes this test to fail (as it should) on such
+# systems. That system is reported to work fine with STAT_STATFS4 which
+# is what it gets when this test fails.
+if test $ac_fsusage_space = no; then
+ # glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0,
+ # OpenBSD >= 4.4, AIX, HP-UX, IRIX, Solaris, Cygwin, Interix, BeOS.
+ AC_CACHE_CHECK([for statvfs function (SVR4)], [fu_cv_sys_stat_statvfs],
+ [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
+#ifdef __osf__
+"Do not use Tru64's statvfs implementation"
+#endif
+
+#include <sys/statvfs.h>
+
+struct statvfs fsd;
+
+#if defined __APPLE__ && defined __MACH__
+#include <limits.h>
+/* On Mac OS X >= 10.5, f_blocks in 'struct statvfs' is a 32-bit quantity;
+ that commonly limits file systems to 4 TiB. Whereas f_blocks in
+ 'struct statfs' is a 64-bit type, thanks to the large-file support
+ that was enabled above. In this case, don't use statvfs(); use statfs()
+ instead. */
+int check_f_blocks_size[sizeof fsd.f_blocks * CHAR_BIT <= 32 ? -1 : 1];
+#endif
+]],
+ [[statvfs (0, &fsd);]])],
+ [fu_cv_sys_stat_statvfs=yes],
+ [fu_cv_sys_stat_statvfs=no])])
+ if test $fu_cv_sys_stat_statvfs = yes; then
+ ac_fsusage_space=yes
+ # AIX >= 5.2 has statvfs64 that has a wider f_blocks field than statvfs.
+ # glibc, HP-UX, IRIX, Solaris have statvfs64 as well, but on these systems
+ # statvfs with large-file support is already equivalent to statvfs64.
+ AC_CACHE_CHECK([whether to use statvfs64],
+ [fu_cv_sys_stat_statvfs64],
+ [AC_LINK_IFELSE(
+ [AC_LANG_PROGRAM(
+ [[#include <sys/types.h>
+ #include <sys/statvfs.h>
+ struct statvfs64 fsd;
+ int check_f_blocks_larger_in_statvfs64
+ [sizeof (((struct statvfs64 *) 0)->f_blocks)
+ > sizeof (((struct statvfs *) 0)->f_blocks)
+ ? 1 : -1];
+ ]],
+ [[statvfs64 (0, &fsd);]])],
+ [fu_cv_sys_stat_statvfs64=yes],
+ [fu_cv_sys_stat_statvfs64=no])
+ ])
+ if test $fu_cv_sys_stat_statvfs64 = yes; then
+ AC_DEFINE([STAT_STATVFS64], [1],
+ [ Define if statvfs64 should be preferred over statvfs.])
+ else
+ AC_DEFINE([STAT_STATVFS], [1],
+ [ Define if there is a function named statvfs. (SVR4)])
+ fi
+ fi
+fi
+
+# Check for this unconditionally so we have a
+# good fallback on glibc/Linux > 2.6 < 2.6.36
+AC_MSG_CHECKING([for two-argument statfs with statfs.f_frsize member])
+AC_CACHE_VAL([fu_cv_sys_stat_statfs2_frsize],
+[AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#ifdef HAVE_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#ifdef HAVE_SYS_MOUNT_H
+#include <sys/mount.h>
+#endif
+#ifdef HAVE_SYS_VFS_H
+#include <sys/vfs.h>
+#endif
+ int
+ main ()
+ {
+ struct statfs fsd;
+ fsd.f_frsize = 0;
+ return statfs (".", &fsd) != 0;
+ }]])],
+ [fu_cv_sys_stat_statfs2_frsize=yes],
+ [fu_cv_sys_stat_statfs2_frsize=no],
+ [fu_cv_sys_stat_statfs2_frsize=no])])
+AC_MSG_RESULT([$fu_cv_sys_stat_statfs2_frsize])
+if test $fu_cv_sys_stat_statfs2_frsize = yes; then
+ ac_fsusage_space=yes
+ AC_DEFINE([STAT_STATFS2_FRSIZE], [1],
+[ Define if statfs takes 2 args and struct statfs has a field named f_frsize.
+ (glibc/Linux > 2.6)])
+fi
+
+if test $ac_fsusage_space = no; then
+ # DEC Alpha running OSF/1
+ AC_MSG_CHECKING([for 3-argument statfs function (DEC OSF/1)])
+ AC_CACHE_VAL([fu_cv_sys_stat_statfs3_osf1],
+ [AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/param.h>
+#include <sys/types.h>
+#include <sys/mount.h>
+ int
+ main ()
+ {
+ struct statfs fsd;
+ fsd.f_fsize = 0;
+ return statfs (".", &fsd, sizeof (struct statfs)) != 0;
+ }]])],
+ [fu_cv_sys_stat_statfs3_osf1=yes],
+ [fu_cv_sys_stat_statfs3_osf1=no],
+ [fu_cv_sys_stat_statfs3_osf1=no])])
+ AC_MSG_RESULT([$fu_cv_sys_stat_statfs3_osf1])
+ if test $fu_cv_sys_stat_statfs3_osf1 = yes; then
+ ac_fsusage_space=yes
+ AC_DEFINE([STAT_STATFS3_OSF1], [1],
+ [ Define if statfs takes 3 args. (DEC Alpha running OSF/1)])
+ fi
+fi
+
+if test $ac_fsusage_space = no; then
+ # glibc/Linux, Mac OS X, FreeBSD < 5.0, NetBSD < 3.0, OpenBSD < 4.4.
+ # (glibc/{Hurd,kFreeBSD}, FreeBSD >= 5.0, NetBSD >= 3.0,
+ # OpenBSD >= 4.4, AIX, HP-UX, OSF/1, Cygwin already handled above.)
+ # (On IRIX you need to include <sys/statfs.h>, not only <sys/mount.h> and
+ # <sys/vfs.h>.)
+ # (On Solaris, statfs has 4 arguments.)
+ AC_MSG_CHECKING([for two-argument statfs with statfs.f_bsize dnl
+member (AIX, 4.3BSD)])
+ AC_CACHE_VAL([fu_cv_sys_stat_statfs2_bsize],
+ [AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#ifdef HAVE_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#ifdef HAVE_SYS_MOUNT_H
+#include <sys/mount.h>
+#endif
+#ifdef HAVE_SYS_VFS_H
+#include <sys/vfs.h>
+#endif
+ int
+ main ()
+ {
+ struct statfs fsd;
+ fsd.f_bsize = 0;
+ return statfs (".", &fsd) != 0;
+ }]])],
+ [fu_cv_sys_stat_statfs2_bsize=yes],
+ [fu_cv_sys_stat_statfs2_bsize=no],
+ [fu_cv_sys_stat_statfs2_bsize=no])])
+ AC_MSG_RESULT([$fu_cv_sys_stat_statfs2_bsize])
+ if test $fu_cv_sys_stat_statfs2_bsize = yes; then
+ ac_fsusage_space=yes
+ AC_DEFINE([STAT_STATFS2_BSIZE], [1],
+[ Define if statfs takes 2 args and struct statfs has a field named f_bsize.
+ (4.3BSD, SunOS 4, HP-UX, AIX PS/2)])
+ fi
+fi
+
+if test $ac_fsusage_space = no; then
+ # SVR3
+ # (Solaris already handled above.)
+ AC_MSG_CHECKING([for four-argument statfs (AIX-3.2.5, SVR3)])
+ AC_CACHE_VAL([fu_cv_sys_stat_statfs4],
+ [AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/types.h>
+#include <sys/statfs.h>
+ int
+ main ()
+ {
+ struct statfs fsd;
+ return statfs (".", &fsd, sizeof fsd, 0) != 0;
+ }]])],
+ [fu_cv_sys_stat_statfs4=yes],
+ [fu_cv_sys_stat_statfs4=no],
+ [fu_cv_sys_stat_statfs4=no])])
+ AC_MSG_RESULT([$fu_cv_sys_stat_statfs4])
+ if test $fu_cv_sys_stat_statfs4 = yes; then
+ ac_fsusage_space=yes
+ AC_DEFINE([STAT_STATFS4], [1],
+ [ Define if statfs takes 4 args. (SVR3, Dynix, old Irix, old AIX, Dolphin)])
+ fi
+fi
+
+if test $ac_fsusage_space = no; then
+ # 4.4BSD and older NetBSD
+ # (OSF/1 already handled above.)
+ # (On AIX, you need to include <sys/statfs.h>, not only <sys/mount.h>.)
+ # (On Solaris, statfs has 4 arguments and 'struct statfs' is not declared in
+ # <sys/mount.h>.)
+ AC_MSG_CHECKING([for two-argument statfs with statfs.f_fsize dnl
+member (4.4BSD and NetBSD)])
+ AC_CACHE_VAL([fu_cv_sys_stat_statfs2_fsize],
+ [AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/types.h>
+#ifdef HAVE_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#ifdef HAVE_SYS_MOUNT_H
+#include <sys/mount.h>
+#endif
+ int
+ main ()
+ {
+ struct statfs fsd;
+ fsd.f_fsize = 0;
+ return statfs (".", &fsd) != 0;
+ }]])],
+ [fu_cv_sys_stat_statfs2_fsize=yes],
+ [fu_cv_sys_stat_statfs2_fsize=no],
+ [fu_cv_sys_stat_statfs2_fsize=no])])
+ AC_MSG_RESULT([$fu_cv_sys_stat_statfs2_fsize])
+ if test $fu_cv_sys_stat_statfs2_fsize = yes; then
+ ac_fsusage_space=yes
+ AC_DEFINE([STAT_STATFS2_FSIZE], [1],
+[ Define if statfs takes 2 args and struct statfs has a field named f_fsize.
+ (4.4BSD, NetBSD)])
+ fi
+fi
+
+if test $ac_fsusage_space = no; then
+ # Ultrix
+ AC_MSG_CHECKING([for two-argument statfs with struct fs_data (Ultrix)])
+ AC_CACHE_VAL([fu_cv_sys_stat_fs_data],
+ [AC_RUN_IFELSE([AC_LANG_SOURCE([[
+#include <sys/types.h>
+#ifdef HAVE_SYS_PARAM_H
+#include <sys/param.h>
+#endif
+#ifdef HAVE_SYS_MOUNT_H
+#include <sys/mount.h>
+#endif
+#ifdef HAVE_SYS_FS_TYPES_H
+#include <sys/fs_types.h>
+#endif
+ int
+ main ()
+ {
+ struct fs_data fsd;
+ /* Ultrix's statfs returns 1 for success,
+ 0 for not mounted, -1 for failure. */
+ return statfs (".", &fsd) != 1;
+ }]])],
+ [fu_cv_sys_stat_fs_data=yes],
+ [fu_cv_sys_stat_fs_data=no],
+ [fu_cv_sys_stat_fs_data=no])])
+ AC_MSG_RESULT([$fu_cv_sys_stat_fs_data])
+ if test $fu_cv_sys_stat_fs_data = yes; then
+ ac_fsusage_space=yes
+ AC_DEFINE([STAT_STATFS2_FS_DATA], [1],
+[ Define if statfs takes 2 args and the second argument has
+ type struct fs_data. (Ultrix)])
+ fi
+fi
+
+AS_IF([test $ac_fsusage_space = yes], [$1], [$2])
+
+])
+
+
+# Check for SunOS statfs brokenness wrt partitions 2GB and larger.
+# If <sys/vfs.h> exists and struct statfs has a member named f_spare,
+# enable the work-around code in fsusage.c.
+AC_DEFUN([gl_STATFS_TRUNCATES],
+[
+ AC_MSG_CHECKING([for statfs that truncates block counts])
+ AC_CACHE_VAL([fu_cv_sys_truncating_statfs],
+ [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
+#if !defined(sun) && !defined(__sun)
+choke -- this is a workaround for a Sun-specific problem
+#endif
+#include <sys/types.h>
+#include <sys/vfs.h>]],
+ [[struct statfs t; long c = *(t.f_spare);
+ if (c) return 0;]])],
+ [fu_cv_sys_truncating_statfs=yes],
+ [fu_cv_sys_truncating_statfs=no])])
+ if test $fu_cv_sys_truncating_statfs = yes; then
+ AC_DEFINE([STATFS_TRUNCATES_BLOCK_COUNTS], [1],
+ [Define if the block counts reported by statfs may be truncated to 2GB
+ and the correct values may be stored in the f_spare array.
+ (SunOS 4.1.2, 4.1.3, and 4.1.3_U1 are reported to have this problem.
+ SunOS 4.1.1 seems not to be affected.)])
+ fi
+ AC_MSG_RESULT([$fu_cv_sys_truncating_statfs])
+])
+
+
+# Prerequisites of lib/fsusage.c not done by gl_FILE_SYSTEM_USAGE.
+AC_DEFUN([gl_PREREQ_FSUSAGE_EXTRA],
+[
+ AC_CHECK_HEADERS([dustat.h sys/fs/s5param.h sys/statfs.h])
+ gl_STATFS_TRUNCATES
+])
diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4
index 1af2a2478fa..f1e4f5f699e 100644
--- a/m4/getdtablesize.m4
+++ b/m4/getdtablesize.m4
@@ -1,4 +1,4 @@
-# getdtablesize.m4 serial 6
+# getdtablesize.m4 serial 7
dnl Copyright (C) 2008-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -12,29 +12,43 @@ AC_DEFUN([gl_FUNC_GETDTABLESIZE],
AC_CHECK_DECLS_ONCE([getdtablesize])
if test $ac_cv_func_getdtablesize = yes &&
test $ac_cv_have_decl_getdtablesize = yes; then
- # Cygwin 1.7.25 automatically increases the RLIMIT_NOFILE soft limit
- # up to an unchangeable hard limit; all other platforms correctly
- # require setrlimit before getdtablesize() can report a larger value.
AC_CACHE_CHECK([whether getdtablesize works],
[gl_cv_func_getdtablesize_works],
- [AC_RUN_IFELSE([
- AC_LANG_PROGRAM([[#include <unistd.h>]],
- [int size = getdtablesize();
- if (dup2 (0, getdtablesize()) != -1)
- return 1;
- if (size != getdtablesize())
- return 2;
- ])],
- [gl_cv_func_getdtablesize_works=yes],
- [gl_cv_func_getdtablesize_works=no],
- [case "$host_os" in
- cygwin*) # on cygwin 1.5.25, getdtablesize() automatically grows
- gl_cv_func_getdtablesize_works="guessing no" ;;
- *) gl_cv_func_getdtablesize_works="guessing yes" ;;
- esac])
+ [dnl There are two concepts: the "maximum possible file descriptor value + 1"
+ dnl and the "maximum number of open file descriptors in a process".
+ dnl Per SUSv2 and POSIX, getdtablesize() should return the first one.
+ dnl On most platforms, the first and the second concept are the same.
+ dnl On OpenVMS, however, they are different and getdtablesize() returns
+ dnl the second one; thus the test below fails. But we don't care
+ dnl because there's no good way to write a replacement getdtablesize().
+ case "$host_os" in
+ vms*) gl_cv_func_getdtablesize_works="no (limitation)" ;;
+ *)
+ dnl Cygwin 1.7.25 automatically increases the RLIMIT_NOFILE soft
+ dnl limit up to an unchangeable hard limit; all other platforms
+ dnl correctly require setrlimit before getdtablesize() can report
+ dnl a larger value.
+ AC_RUN_IFELSE([
+ AC_LANG_PROGRAM([[#include <unistd.h>]],
+ [int size = getdtablesize();
+ if (dup2 (0, getdtablesize()) != -1)
+ return 1;
+ if (size != getdtablesize())
+ return 2;
+ ])],
+ [gl_cv_func_getdtablesize_works=yes],
+ [gl_cv_func_getdtablesize_works=no],
+ [case "$host_os" in
+ cygwin*) # on cygwin 1.5.25, getdtablesize() automatically grows
+ gl_cv_func_getdtablesize_works="guessing no" ;;
+ *) gl_cv_func_getdtablesize_works="guessing yes" ;;
+ esac
+ ])
+ ;;
+ esac
])
case "$gl_cv_func_getdtablesize_works" in
- *yes) ;;
+ *yes | "no (limitation)") ;;
*) REPLACE_GETDTABLESIZE=1 ;;
esac
else
diff --git a/m4/getgroups.m4 b/m4/getgroups.m4
index 02ce2353ca4..17f7409944e 100644
--- a/m4/getgroups.m4
+++ b/m4/getgroups.m4
@@ -12,7 +12,7 @@ dnl A wrapper around AC_FUNC_GETGROUPS.
m4_version_prereq([2.70], [] ,[
# This is taken from the following Autoconf patch:
-# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9
+# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9
AC_DEFUN([AC_FUNC_GETGROUPS],
[
AC_REQUIRE([AC_TYPE_GETGROUPS])dnl
diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4
index 8ee206eea24..efa114dfaff 100644
--- a/m4/gettimeofday.m4
+++ b/m4/gettimeofday.m4
@@ -1,4 +1,4 @@
-# serial 23
+# serial 24
# Copyright (C) 2001-2003, 2005, 2007, 2009-2017 Free Software Foundation, Inc.
# This file is free software; the Free Software Foundation
@@ -105,6 +105,8 @@ AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER],
case "$host_os" in
# Guess all is fine on glibc systems.
*-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
+ # Guess no on native Windows.
+ mingw*) gl_cv_func_gettimeofday_clobber="guessing no" ;;
# If we don't know, assume the worst.
*) gl_cv_func_gettimeofday_clobber="guessing yes" ;;
esac
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 36f2acc5539..bea5a650e76 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -228,13 +228,13 @@ m4_ifndef([AS_VAR_IF],
# This is like AC_PROG_CC_C99, except that
# - AC_PROG_CC_C99 did not exist in Autoconf versions < 2.60,
# - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC
-# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00367.html>,
+# <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
-# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00441.html>.
+# <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
-# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00431.html>.
+# <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],
[
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index 1ac58e871cc..61d39ebda2b 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -12,7 +12,7 @@
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this file. If not, see <http://www.gnu.org/licenses/>.
+# along with this file. If not, see <https://www.gnu.org/licenses/>.
#
# As a special exception to the GNU General Public License,
# this file may be distributed as part of a program that
@@ -53,6 +53,7 @@ AC_DEFUN([gl_EARLY],
# Code from module c-strcase:
# Code from module careadlinkat:
# Code from module clock-time:
+ # Code from module cloexec:
# Code from module close-stream:
# Code from module count-leading-zeros:
# Code from module count-one-bits:
@@ -61,6 +62,7 @@ AC_DEFUN([gl_EARLY],
# Code from module crypto/sha1:
# Code from module crypto/sha256:
# Code from module crypto/sha512:
+ # Code from module d-type:
# Code from module diffseq:
# Code from module dirent:
# Code from module dirfd:
@@ -72,6 +74,7 @@ AC_DEFUN([gl_EARLY],
# Code from module errno:
# Code from module euidaccess:
# Code from module execinfo:
+ # Code from module explicit_bzero:
# Code from module extensions:
# Code from module extern-inline:
# Code from module faccessat:
@@ -84,6 +87,7 @@ AC_DEFUN([gl_EARLY],
# Code from module flexmember:
# Code from module fpending:
# Code from module fstatat:
+ # Code from module fsusage:
# Code from module fsync:
# Code from module getdtablesize:
# Code from module getgroups:
@@ -112,6 +116,8 @@ AC_DEFUN([gl_EARLY],
# Code from module mktime-internal:
# Code from module multiarch:
# Code from module nocrash:
+ # Code from module nstrftime:
+ # Code from module open:
# Code from module openat-h:
# Code from module pipe2:
# Code from module pselect:
@@ -121,7 +127,6 @@ AC_DEFUN([gl_EARLY],
# Code from module readlink:
# Code from module readlinkat:
# Code from module root-uid:
- # Code from module secure_getenv:
# Code from module sig2str:
# Code from module signal-h:
# Code from module snippet/_Noreturn:
@@ -138,7 +143,6 @@ AC_DEFUN([gl_EARLY],
# Code from module stdio:
# Code from module stdlib:
# Code from module stpcpy:
- # Code from module strftime:
# Code from module string:
# Code from module strtoimax:
# Code from module strtoll:
@@ -158,6 +162,7 @@ AC_DEFUN([gl_EARLY],
# Code from module timespec-sub:
# Code from module u64:
# Code from module unistd:
+ # Code from module unlocked-io:
# Code from module update-copyright:
# Code from module utimens:
# Code from module vararrays:
@@ -197,6 +202,7 @@ AC_DEFUN([gl_INIT],
gl_SHA1
gl_SHA256
gl_SHA512
+ gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE
gl_DIRENT_H
AC_REQUIRE([gl_C99_STRTOLD])
gl_FUNC_DUP2
@@ -209,9 +215,15 @@ AC_DEFUN([gl_INIT],
gl_UNISTD_MODULE_INDICATOR([environ])
gl_HEADER_ERRNO_H
gl_EXECINFO_H
+ gl_FUNC_EXPLICIT_BZERO
+ if test $HAVE_EXPLICIT_BZERO = 0; then
+ AC_LIBOBJ([explicit_bzero])
+ gl_PREREQ_EXPLICIT_BZERO
+ fi
+ gl_STRING_MODULE_INDICATOR([explicit_bzero])
AC_REQUIRE([gl_EXTERN_INLINE])
gl_FUNC_FACCESSAT
- if test $HAVE_FACCESSAT = 0; then
+ if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
AC_LIBOBJ([faccessat])
gl_PREREQ_FACCESSAT
fi
@@ -245,6 +257,11 @@ AC_DEFUN([gl_INIT],
AC_LIBOBJ([fstatat])
fi
gl_SYS_STAT_MODULE_INDICATOR([fstatat])
+ gl_FSUSAGE
+ if test $gl_cv_fs_space = yes; then
+ AC_LIBOBJ([fsusage])
+ gl_PREREQ_FSUSAGE_EXTRA
+ fi
gl_FUNC_FSYNC
if test $HAVE_FSYNC = 0; then
AC_LIBOBJ([fsync])
@@ -306,6 +323,7 @@ AC_DEFUN([gl_INIT],
fi
gl_TIME_MODULE_INDICATOR([mktime])
gl_MULTIARCH
+ gl_FUNC_GNU_STRFTIME
gl_FUNC_PIPE2
gl_UNISTD_MODULE_INDICATOR([pipe2])
gl_FUNC_PSELECT
@@ -357,7 +375,6 @@ AC_DEFUN([gl_INIT],
gl_PREREQ_STPCPY
fi
gl_STRING_MODULE_INDICATOR([stpcpy])
- gl_FUNC_GNU_STRFTIME
gl_HEADER_STRING_H
gl_FUNC_STRTOIMAX
if test $HAVE_DECL_STRTOIMAX = 0 || test $REPLACE_STRTOIMAX = 1; then
@@ -378,6 +395,7 @@ AC_DEFUN([gl_INIT],
AC_PROG_MKDIR_P
gl_SYS_TYPES_H
AC_PROG_MKDIR_P
+ gl_FUNC_GEN_TEMPNAME
gl_HEADER_TIME_H
gl_TIME_R
if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then
@@ -399,9 +417,11 @@ AC_DEFUN([gl_INIT],
gl_TIMER_TIME
gl_TIMESPEC
gl_UNISTD_H
+ gl_FUNC_GLIBC_UNLOCKED_IO
gl_UTIMENS
AC_C_VARARRAYS
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false
+ gl_gnulib_enabled_cloexec=false
gl_gnulib_enabled_dirfd=false
gl_gnulib_enabled_dosname=false
gl_gnulib_enabled_euidaccess=false
@@ -411,17 +431,24 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false
gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9=false
gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false
+ gl_gnulib_enabled_open=false
gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false
gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false
- gl_gnulib_enabled_secure_getenv=false
gl_gnulib_enabled_strtoll=false
- gl_gnulib_enabled_tempname=false
gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b ()
{
if ! $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then
AC_LIBOBJ([openat-proc])
gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true
+ func_gl_gnulib_m4code_open
+ fi
+ }
+ func_gl_gnulib_m4code_cloexec ()
+ {
+ if ! $gl_gnulib_enabled_cloexec; then
+ gl_MODULE_INDICATOR_FOR_TESTS([cloexec])
+ gl_gnulib_enabled_cloexec=true
fi
}
func_gl_gnulib_m4code_dirfd ()
@@ -527,6 +554,21 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=true
fi
}
+ func_gl_gnulib_m4code_open ()
+ {
+ if ! $gl_gnulib_enabled_open; then
+ gl_FUNC_OPEN
+ if test $REPLACE_OPEN = 1; then
+ AC_LIBOBJ([open])
+ gl_PREREQ_OPEN
+ fi
+ gl_FCNTL_MODULE_INDICATOR([open])
+ gl_gnulib_enabled_open=true
+ if test $REPLACE_OPEN = 1; then
+ func_gl_gnulib_m4code_cloexec
+ fi
+ fi
+ }
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 ()
{
if ! $gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7; then
@@ -539,18 +581,6 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true
fi
}
- func_gl_gnulib_m4code_secure_getenv ()
- {
- if ! $gl_gnulib_enabled_secure_getenv; then
- gl_FUNC_SECURE_GETENV
- if test $HAVE_SECURE_GETENV = 0; then
- AC_LIBOBJ([secure_getenv])
- gl_PREREQ_SECURE_GETENV
- fi
- gl_STDLIB_MODULE_INDICATOR([secure_getenv])
- gl_gnulib_enabled_secure_getenv=true
- fi
- }
func_gl_gnulib_m4code_strtoll ()
{
if ! $gl_gnulib_enabled_strtoll; then
@@ -563,30 +593,22 @@ AC_DEFUN([gl_INIT],
gl_gnulib_enabled_strtoll=true
fi
}
- func_gl_gnulib_m4code_tempname ()
- {
- if ! $gl_gnulib_enabled_tempname; then
- gl_FUNC_GEN_TEMPNAME
- gl_gnulib_enabled_tempname=true
- func_gl_gnulib_m4code_secure_getenv
- fi
- }
func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec ()
{
if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then
gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=true
fi
}
- if test $HAVE_FACCESSAT = 0; then
+ if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
fi
- if test $HAVE_FACCESSAT = 0; then
+ if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
func_gl_gnulib_m4code_dosname
fi
- if test $HAVE_FACCESSAT = 0; then
+ if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
func_gl_gnulib_m4code_euidaccess
fi
- if test $HAVE_FACCESSAT = 0; then
+ if test $HAVE_FACCESSAT = 0 || test $REPLACE_FACCESSAT = 1; then
func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7
fi
if test $HAVE_FCNTL = 0 || test $REPLACE_FCNTL = 1; then
@@ -616,9 +638,6 @@ AC_DEFUN([gl_INIT],
if test $REPLACE_LSTAT = 1; then
func_gl_gnulib_m4code_dosname
fi
- if test $HAVE_MKOSTEMP = 0; then
- func_gl_gnulib_m4code_tempname
- fi
if test $HAVE_READLINKAT = 0; then
func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b
fi
@@ -636,6 +655,7 @@ AC_DEFUN([gl_INIT],
fi
m4_pattern_allow([^gl_GNULIB_ENABLED_])
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_dosname], [$gl_gnulib_enabled_dosname])
AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess])
@@ -645,11 +665,10 @@ AC_DEFUN([gl_INIT],
AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1])
AM_CONDITIONAL([gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9], [$gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9])
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_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_secure_getenv], [$gl_gnulib_enabled_secure_getenv])
AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll])
- AM_CONDITIONAL([gl_GNULIB_ENABLED_tempname], [$gl_gnulib_enabled_tempname])
AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec])
# End of code from modules
m4_ifval(gl_LIBSOURCES_LIST, [
@@ -816,6 +835,8 @@ AC_DEFUN([gl_FILE_LIST], [
lib/c-strncasecmp.c
lib/careadlinkat.c
lib/careadlinkat.h
+ lib/cloexec.c
+ lib/cloexec.h
lib/close-stream.c
lib/close-stream.h
lib/count-leading-zeros.c
@@ -835,6 +856,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/euidaccess.c
lib/execinfo.c
lib/execinfo.in.h
+ lib/explicit_bzero.c
lib/faccessat.c
lib/fcntl.c
lib/fcntl.in.h
@@ -848,6 +870,8 @@ AC_DEFUN([gl_FILE_LIST], [
lib/fpending.c
lib/fpending.h
lib/fstatat.c
+ lib/fsusage.c
+ lib/fsusage.h
lib/fsync.c
lib/ftoastr.c
lib/ftoastr.h
@@ -883,6 +907,8 @@ AC_DEFUN([gl_FILE_LIST], [
lib/mkostemp.c
lib/mktime-internal.h
lib/mktime.c
+ lib/nstrftime.c
+ lib/open.c
lib/openat-priv.h
lib/openat-proc.c
lib/openat.h
@@ -894,7 +920,6 @@ AC_DEFUN([gl_FILE_LIST], [
lib/readlink.c
lib/readlinkat.c
lib/root-uid.h
- lib/secure_getenv.c
lib/set-permissions.c
lib/sha1.c
lib/sha1.h
@@ -914,7 +939,6 @@ AC_DEFUN([gl_FILE_LIST], [
lib/stdio.in.h
lib/stdlib.in.h
lib/stpcpy.c
- lib/strftime.c
lib/strftime.h
lib/string.in.h
lib/strtoimax.c
@@ -940,6 +964,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/u64.h
lib/unistd.c
lib/unistd.in.h
+ lib/unlocked-io.h
lib/utimens.c
lib/utimens.h
lib/verify.h
@@ -957,6 +982,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/count-leading-zeros.m4
m4/count-one-bits.m4
m4/count-trailing-zeros.m4
+ m4/d-type.m4
m4/dirent_h.m4
m4/dirfd.m4
m4/dup2.m4
@@ -964,6 +990,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/errno_h.m4
m4/euidaccess.m4
m4/execinfo.m4
+ m4/explicit_bzero.m4
m4/extensions.m4
m4/extern-inline.m4
m4/faccessat.m4
@@ -976,6 +1003,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/flexmember.m4
m4/fpending.m4
m4/fstatat.m4
+ m4/fsusage.m4
m4/fsync.m4
m4/getdtablesize.m4
m4/getgroups.m4
@@ -993,22 +1021,26 @@ AC_DEFUN([gl_FILE_LIST], [
m4/localtime-buffer.m4
m4/longlong.m4
m4/lstat.m4
+ m4/manywarnings-c++.m4
m4/manywarnings.m4
m4/md5.m4
m4/memrchr.m4
m4/minmax.m4
m4/mkostemp.m4
m4/mktime.m4
+ m4/mode_t.m4
m4/multiarch.m4
m4/nocrash.m4
+ m4/nstrftime.m4
m4/off_t.m4
+ m4/open-cloexec.m4
+ m4/open.m4
m4/pipe2.m4
m4/pselect.m4
m4/pthread_sigmask.m4
m4/putenv.m4
m4/readlink.m4
m4/readlinkat.m4
- m4/secure_getenv.m4
m4/sha1.m4
m4/sha256.m4
m4/sha512.m4
@@ -1025,7 +1057,6 @@ AC_DEFUN([gl_FILE_LIST], [
m4/stdio_h.m4
m4/stdlib_h.m4
m4/stpcpy.m4
- m4/strftime.m4
m4/string_h.m4
m4/strtoimax.m4
m4/strtoll.m4
@@ -1044,6 +1075,7 @@ AC_DEFUN([gl_FILE_LIST], [
m4/timespec.m4
m4/tm_gmtoff.m4
m4/unistd_h.m4
+ m4/unlocked-io.m4
m4/utimens.m4
m4/utimes.m4
m4/vararrays.m4
diff --git a/m4/lstat.m4 b/m4/lstat.m4
index 953c117d801..6ba18cec574 100644
--- a/m4/lstat.m4
+++ b/m4/lstat.m4
@@ -1,4 +1,4 @@
-# serial 27
+# serial 30
# Copyright (C) 1997-2001, 2003-2017 Free Software Foundation, Inc.
#
@@ -10,14 +10,15 @@ dnl From Jim Meyering.
AC_DEFUN([gl_FUNC_LSTAT],
[
+ AC_REQUIRE([AC_CANONICAL_HOST])
AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS])
dnl If lstat does not exist, the replacement <sys/stat.h> does
dnl "#define lstat stat", and lstat.c is a no-op.
AC_CHECK_FUNCS_ONCE([lstat])
if test $ac_cv_func_lstat = yes; then
AC_REQUIRE([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK])
- case "$gl_cv_func_lstat_dereferences_slashed_symlink" in
- *no)
+ case $host_os,$gl_cv_func_lstat_dereferences_slashed_symlink in
+ solaris* | *no)
REPLACE_LSTAT=1
;;
esac
@@ -33,6 +34,7 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
[
dnl We don't use AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK any more, because it
dnl is no longer maintained in Autoconf and because it invokes AC_LIBOBJ.
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether lstat correctly handles trailing slash],
[gl_cv_func_lstat_dereferences_slashed_symlink],
[rm -f conftest.sym conftest.file
@@ -54,6 +56,9 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK],
*-gnu*)
# Guess yes on glibc systems.
gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;;
+ mingw*)
+ # Guess no on native Windows.
+ gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
*)
# If we don't know, assume the worst.
gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;;
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index 2d35eff6a2c..d10bcd08a0e 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,4 @@
-# manywarnings.m4 serial 8
+# manywarnings.m4 serial 13
dnl Copyright (C) 2008-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -33,8 +33,17 @@ AC_DEFUN([gl_MANYWARN_COMPLEMENT],
# Add all documented GCC warning parameters to variable VARIABLE.
# Note that you need to test them using gl_WARN_ADD if you want to
# make sure your gcc understands it.
+#
+# The effects of this macro depend on the current language (_AC_LANG).
AC_DEFUN([gl_MANYWARN_ALL_GCC],
+[_AC_LANG_DISPATCH([$0], _AC_LANG, $@)])
+
+# Specialization for _AC_LANG = C.
+# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
+m4_defun([gl_MANYWARN_ALL_GCC(C)],
[
+ AC_LANG_PUSH([C])
+
dnl First, check for some issues that only occur when combining multiple
dnl gcc warning categories.
AC_REQUIRE([AC_PROG_CC])
@@ -258,9 +267,25 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC],
# gcc --help=warnings outputs an unusual form for these options; list
# them here so that the above 'comm' command doesn't report a false match.
- # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal:
- ptrdiff_max_max=9223372036854775807
- gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$ptrdiff_max_max"
+ # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal.
+ # Also, AC_COMPUTE_INT requires it to fit in a long; it is 2**63 on
+ # the only platforms where it does not fit in a long, so make that
+ # a special case.
+ AC_MSG_CHECKING([max safe object size])
+ AC_COMPUTE_INT([gl_alloc_max],
+ [LONG_MAX < (PTRDIFF_MAX < (size_t) -1 ? PTRDIFF_MAX : (size_t) -1)
+ ? -1
+ : PTRDIFF_MAX < (size_t) -1 ? (long) PTRDIFF_MAX : (long) (size_t) -1],
+ [[#include <limits.h>
+ #include <stddef.h>
+ #include <stdint.h>
+ ]],
+ [gl_alloc_max=2147483647])
+ case $gl_alloc_max in
+ -1) gl_alloc_max=9223372036854775807;;
+ esac
+ AC_MSG_RESULT([$gl_alloc_max])
+ gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max"
gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2"
gl_manywarn_set="$gl_manywarn_set -Wformat-overflow=2"
gl_manywarn_set="$gl_manywarn_set -Wformat-truncation=2"
@@ -292,4 +317,13 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC],
fi
$1=$gl_manywarn_set
+
+ AC_LANG_POP([C])
+])
+
+# Specialization for _AC_LANG = C++.
+# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
+m4_defun([gl_MANYWARN_ALL_GCC(C++)],
+[
+ gl_MANYWARN_ALL_GCC_CXX_IMPL([$1])
])
diff --git a/m4/mktime.m4 b/m4/mktime.m4
index 31da65e8b2d..1461905fb93 100644
--- a/m4/mktime.m4
+++ b/m4/mktime.m4
@@ -1,4 +1,4 @@
-# serial 28
+# serial 30
dnl Copyright (C) 2002-2003, 2005-2007, 2009-2017 Free Software Foundation,
dnl Inc.
dnl This file is free software; the Free Software Foundation
@@ -25,6 +25,7 @@ dnl Test whether mktime works. Set gl_cv_func_working_mktime.
AC_DEFUN([gl_FUNC_MKTIME_WORKS],
[
AC_REQUIRE([gl_TIME_T_IS_SIGNED])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
dnl We don't use AC_FUNC_MKTIME any more, because it is no longer maintained
dnl in Autoconf and because it invokes AC_LIBOBJ.
@@ -54,6 +55,10 @@ AC_DEFUN([gl_FUNC_MKTIME_WORKS],
# include <signal.h>
#endif
+#ifndef TIME_T_IS_SIGNED
+# define TIME_T_IS_SIGNED 0
+#endif
+
/* Work around redefinition to rpl_putenv by other config tests. */
#undef putenv
@@ -239,7 +244,12 @@ main ()
}]])],
[gl_cv_func_working_mktime=yes],
[gl_cv_func_working_mktime=no],
- [gl_cv_func_working_mktime="guessing no"])
+ [case "$host_os" in
+ # Guess no on native Windows.
+ mingw*) gl_cv_func_working_mktime="guessing no" ;;
+ *) gl_cv_func_working_mktime="guessing no" ;;
+ esac
+ ])
])
])
diff --git a/m4/mode_t.m4 b/m4/mode_t.m4
new file mode 100644
index 00000000000..75d372a4a8a
--- /dev/null
+++ b/m4/mode_t.m4
@@ -0,0 +1,26 @@
+# mode_t.m4 serial 2
+dnl Copyright (C) 2009-2017 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.
+
+# For using mode_t, it's sufficient to use AC_TYPE_MODE_T and
+# include <sys/types.h>.
+
+# Define PROMOTED_MODE_T to the type that is the result of "default argument
+# promotion" (ISO C 6.5.2.2.(6)) of the type mode_t.
+AC_DEFUN([gl_PROMOTED_TYPE_MODE_T],
+[
+ AC_REQUIRE([AC_TYPE_MODE_T])
+ AC_CACHE_CHECK([for promoted mode_t type], [gl_cv_promoted_mode_t], [
+ dnl Assume mode_t promotes to 'int' if and only if it is smaller than 'int',
+ dnl and to itself otherwise. This assumption is not guaranteed by the ISO C
+ dnl standard, but we don't know of any real-world counterexamples.
+ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]],
+ [[typedef int array[2 * (sizeof (mode_t) < sizeof (int)) - 1];]])],
+ [gl_cv_promoted_mode_t='int'],
+ [gl_cv_promoted_mode_t='mode_t'])
+ ])
+ AC_DEFINE_UNQUOTED([PROMOTED_MODE_T], [$gl_cv_promoted_mode_t],
+ [Define to the type that is the result of default argument promotions of type mode_t.])
+])
diff --git a/m4/strftime.m4 b/m4/nstrftime.m4
index d2dac9e2328..d2dac9e2328 100644
--- a/m4/strftime.m4
+++ b/m4/nstrftime.m4
diff --git a/m4/open-cloexec.m4 b/m4/open-cloexec.m4
new file mode 100644
index 00000000000..897af66910f
--- /dev/null
+++ b/m4/open-cloexec.m4
@@ -0,0 +1,21 @@
+# Test whether O_CLOEXEC is defined.
+
+dnl Copyright 2017 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_PREPROC_O_CLOEXEC],
+[
+ AC_CACHE_CHECK([for O_CLOEXEC],
+ [gl_cv_macro_O_CLOEXEC],
+ [AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[#include <fcntl.h>
+ #ifndef O_CLOEXEC
+ choke me;
+ #endif
+ ]],
+ [[return O_CLOEXEC;]])],
+ [gl_cv_macro_O_CLOEXEC=yes],
+ [gl_cv_macro_O_CLOEXEC=no])])
+])
diff --git a/m4/open.m4 b/m4/open.m4
new file mode 100644
index 00000000000..68253e15ffd
--- /dev/null
+++ b/m4/open.m4
@@ -0,0 +1,95 @@
+# open.m4 serial 15
+dnl Copyright (C) 2007-2017 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_OPEN],
+[
+ AC_REQUIRE([AC_CANONICAL_HOST])
+ AC_REQUIRE([gl_PREPROC_O_CLOEXEC])
+ case "$host_os" in
+ mingw* | pw*)
+ REPLACE_OPEN=1
+ ;;
+ *)
+ dnl open("foo/") should not create a file when the file name has a
+ dnl trailing slash. FreeBSD only has the problem on symlinks.
+ AC_CHECK_FUNCS_ONCE([lstat])
+ if test "$gl_cv_macro_O_CLOEXEC" != yes; then
+ REPLACE_OPEN=1
+ fi
+ AC_CACHE_CHECK([whether open recognizes a trailing slash],
+ [gl_cv_func_open_slash],
+ [# Assume that if we have lstat, we can also check symlinks.
+ if test $ac_cv_func_lstat = yes; then
+ touch conftest.tmp
+ ln -s conftest.tmp conftest.lnk
+ fi
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <fcntl.h>
+#if HAVE_UNISTD_H
+# include <unistd.h>
+#endif
+int main ()
+{
+ int result = 0;
+#if HAVE_LSTAT
+ if (open ("conftest.lnk/", O_RDONLY) != -1)
+ result |= 1;
+#endif
+ if (open ("conftest.sl/", O_CREAT, 0600) >= 0)
+ result |= 2;
+ return result;
+}]])],
+ [gl_cv_func_open_slash=yes],
+ [gl_cv_func_open_slash=no],
+ [
+changequote(,)dnl
+ case "$host_os" in
+ freebsd* | aix* | hpux* | solaris2.[0-9] | solaris2.[0-9].*)
+ gl_cv_func_open_slash="guessing no" ;;
+ *)
+ gl_cv_func_open_slash="guessing yes" ;;
+ esac
+changequote([,])dnl
+ ])
+ rm -f conftest.sl conftest.tmp conftest.lnk
+ ])
+ case "$gl_cv_func_open_slash" in
+ *no)
+ AC_DEFINE([OPEN_TRAILING_SLASH_BUG], [1],
+ [Define to 1 if open() fails to recognize a trailing slash.])
+ REPLACE_OPEN=1
+ ;;
+ esac
+ ;;
+ esac
+ dnl Replace open() for supporting the gnulib-defined fchdir() function,
+ dnl to keep fchdir's bookkeeping up-to-date.
+ m4_ifdef([gl_FUNC_FCHDIR], [
+ if test $REPLACE_OPEN = 0; then
+ gl_TEST_FCHDIR
+ if test $HAVE_FCHDIR = 0; then
+ REPLACE_OPEN=1
+ fi
+ fi
+ ])
+ dnl Replace open() for supporting the gnulib-defined O_NONBLOCK flag.
+ m4_ifdef([gl_NONBLOCKING_IO], [
+ if test $REPLACE_OPEN = 0; then
+ gl_NONBLOCKING_IO
+ if test $gl_cv_have_open_O_NONBLOCK != yes; then
+ REPLACE_OPEN=1
+ fi
+ fi
+ ])
+])
+
+# Prerequisites of lib/open.c.
+AC_DEFUN([gl_PREREQ_OPEN],
+[
+ AC_REQUIRE([gl_PROMOTED_TYPE_MODE_T])
+ :
+])
diff --git a/m4/pselect.m4 b/m4/pselect.m4
index 3f1c43f650d..eb1ad115cc2 100644
--- a/m4/pselect.m4
+++ b/m4/pselect.m4
@@ -1,4 +1,4 @@
-# pselect.m4 serial 2
+# pselect.m4 serial 4
dnl Copyright (C) 2011-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -8,11 +8,12 @@ AC_DEFUN([gl_FUNC_PSELECT],
[
AC_REQUIRE([gl_HEADER_SYS_SELECT])
AC_REQUIRE([AC_C_RESTRICT])
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CHECK_FUNCS_ONCE([pselect])
if test $ac_cv_func_pselect = yes; then
AC_CACHE_CHECK([whether signature of pselect conforms to POSIX],
- gl_cv_sig_pselect,
+ [gl_cv_sig_pselect],
[AC_LINK_IFELSE(
[AC_LANG_PROGRAM(
[[#include <sys/select.h>
diff --git a/m4/putenv.m4 b/m4/putenv.m4
index a8e3ab33dc4..08ae41697a5 100644
--- a/m4/putenv.m4
+++ b/m4/putenv.m4
@@ -1,4 +1,4 @@
-# putenv.m4 serial 20
+# putenv.m4 serial 21
dnl Copyright (C) 2002-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -36,6 +36,8 @@ AC_DEFUN([gl_FUNC_PUTENV],
[case "$host_os" in
# Guess yes on glibc systems.
*-gnu*) gl_cv_func_svid_putenv="guessing yes" ;;
+ # Guess no on native Windows.
+ mingw*) gl_cv_func_svid_putenv="guessing no" ;;
# If we don't know, assume the worst.
*) gl_cv_func_svid_putenv="guessing no" ;;
esac
diff --git a/m4/secure_getenv.m4 b/m4/secure_getenv.m4
deleted file mode 100644
index 6bd4afd9c1a..00000000000
--- a/m4/secure_getenv.m4
+++ /dev/null
@@ -1,26 +0,0 @@
-# Look up an environment variable more securely.
-dnl Copyright 2013-2017 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_SECURE_GETENV],
-[
- dnl Persuade glibc <stdlib.h> to declare secure_getenv().
- AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])
-
- AC_REQUIRE([gl_STDLIB_H_DEFAULTS])
- AC_CHECK_FUNCS_ONCE([secure_getenv])
- if test $ac_cv_func_secure_getenv = no; then
- HAVE_SECURE_GETENV=0
- fi
-])
-
-# Prerequisites of lib/secure_getenv.c.
-AC_DEFUN([gl_PREREQ_SECURE_GETENV], [
- AC_CHECK_FUNCS([__secure_getenv])
- if test $ac_cv_func___secure_getenv = no; then
- AC_CHECK_FUNCS([issetugid])
- fi
- AC_CHECK_FUNCS_ONCE([getuid geteuid getgid getegid])
-])
diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4
index 9dae9b1ccf1..c0466beb404 100644
--- a/m4/std-gnu11.m4
+++ b/m4/std-gnu11.m4
@@ -20,7 +20,7 @@
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this program. If not, see <http://www.gnu.org/licenses/>.
+# along with this program. If not, see <https://www.gnu.org/licenses/>.
# Written by David MacKenzie, with help from
# Akim Demaille, Paul Eggert,
@@ -369,7 +369,7 @@ dnl just the module. Instead, define the (private) symbol
dnl _STDC_C99, which suppresses a bogus failure in <stdbool.h>.
dnl The resulting compiler passes the test case here, and that's
dnl good enough. For more, please see the thread starting at:
-dnl http://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html
+dnl https://lists.gnu.org/r/autoconf/2010-12/msg00059.html
dnl Tru64 -c99
dnl with extended modes being tried first.
[[-std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99]], [$1], [$2])[]dnl
@@ -458,7 +458,7 @@ dnl preferably extc11.
# --------------
# Do not use AU_ALIAS here and in AC_PROG_CC_C99 and AC_PROG_CC_STDC,
# as that'd be incompatible with how Automake redefines AC_PROG_CC. See
-# <http://lists.gnu.org/archive/html/autoconf/2012-10/msg00048.html>.
+# <https://lists.gnu.org/r/autoconf/2012-10/msg00048.html>.
AU_DEFUN([AC_PROG_CC_C89],
[AC_REQUIRE([AC_PROG_CC])],
[$0 is obsolete; use AC_PROG_CC]
diff --git a/m4/stdalign.m4 b/m4/stdalign.m4
index 0652a1e4af5..f091aa58c29 100644
--- a/m4/stdalign.m4
+++ b/m4/stdalign.m4
@@ -18,7 +18,7 @@ AC_DEFUN([gl_STDALIGN_H],
/* Test that alignof yields a result consistent with offsetof.
This catches GCC bug 52023
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52023>. */
#ifdef __cplusplus
template <class t> struct alignof_helper { char a; t b; };
# define ao(type) offsetof (alignof_helper<type>, b)
diff --git a/m4/stdint.m4 b/m4/stdint.m4
index 4ac854d5198..4bf3e474515 100644
--- a/m4/stdint.m4
+++ b/m4/stdint.m4
@@ -1,4 +1,4 @@
-# stdint.m4 serial 50
+# stdint.m4 serial 51
dnl Copyright (C) 2001-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -10,6 +10,7 @@ dnl Test whether <stdint.h> is supported or must be substituted.
AC_DEFUN_ONCE([gl_STDINT_H],
[
AC_PREREQ([2.59])dnl
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_REQUIRE([gl_LIMITS_H])
AC_REQUIRE([gt_TYPE_WINT_T])
@@ -288,8 +289,12 @@ static const char *macro_values[] =
]])],
[gl_cv_header_working_stdint_h=yes],
[],
- [dnl When cross-compiling, assume it works.
- gl_cv_header_working_stdint_h=yes
+ [case "$host_os" in
+ # Guess yes on native Windows.
+ mingw*) gl_cv_header_working_stdint_h="guessing yes" ;;
+ # In general, assume it works.
+ *) gl_cv_header_working_stdint_h="guessing yes" ;;
+ esac
])
])
])
@@ -299,15 +304,16 @@ static const char *macro_values[] =
HAVE_SYS_BITYPES_H=0
HAVE_SYS_INTTYPES_H=0
STDINT_H=stdint.h
- if test "$gl_cv_header_working_stdint_h" = yes; then
- HAVE_C99_STDINT_H=1
- dnl Now see whether the system <stdint.h> works without
- dnl __STDC_CONSTANT_MACROS/__STDC_LIMIT_MACROS defined.
- AC_CACHE_CHECK([whether stdint.h predates C++11],
- [gl_cv_header_stdint_predates_cxx11_h],
- [gl_cv_header_stdint_predates_cxx11_h=yes
- AC_COMPILE_IFELSE([
- AC_LANG_PROGRAM([[
+ case "$gl_cv_header_working_stdint_h" in
+ *yes)
+ HAVE_C99_STDINT_H=1
+ dnl Now see whether the system <stdint.h> works without
+ dnl __STDC_CONSTANT_MACROS/__STDC_LIMIT_MACROS defined.
+ AC_CACHE_CHECK([whether stdint.h predates C++11],
+ [gl_cv_header_stdint_predates_cxx11_h],
+ [gl_cv_header_stdint_predates_cxx11_h=yes
+ AC_COMPILE_IFELSE([
+ AC_LANG_PROGRAM([[
#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */
#include <stdint.h>
]
@@ -315,45 +321,47 @@ gl_STDINT_INCLUDES
[
intmax_t im = INTMAX_MAX;
int32_t i32 = INT32_C (0x7fffffff);
- ]])],
- [gl_cv_header_stdint_predates_cxx11_h=no])])
+ ]])],
+ [gl_cv_header_stdint_predates_cxx11_h=no])])
- if test "$gl_cv_header_stdint_predates_cxx11_h" = yes; then
- AC_DEFINE([__STDC_CONSTANT_MACROS], [1],
- [Define to 1 if the system <stdint.h> predates C++11.])
- AC_DEFINE([__STDC_LIMIT_MACROS], [1],
- [Define to 1 if the system <stdint.h> predates C++11.])
- fi
- AC_CACHE_CHECK([whether stdint.h has UINTMAX_WIDTH etc.],
- [gl_cv_header_stdint_width],
- [gl_cv_header_stdint_width=no
- AC_COMPILE_IFELSE(
- [AC_LANG_PROGRAM([[
- /* Work if build is not clean. */
- #define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1
- #ifndef __STDC_WANT_IEC_60559_BFP_EXT__
- #define __STDC_WANT_IEC_60559_BFP_EXT__ 1
- #endif
- #include <stdint.h>
- ]gl_STDINT_INCLUDES[
- int iw = UINTMAX_WIDTH;
- ]])],
- [gl_cv_header_stdint_width=yes])])
- if test "$gl_cv_header_stdint_width" = yes; then
- STDINT_H=
- fi
- else
- dnl Check for <sys/inttypes.h>, and for
- dnl <sys/bitypes.h> (used in Linux libc4 >= 4.6.7 and libc5).
- AC_CHECK_HEADERS([sys/inttypes.h sys/bitypes.h])
- if test $ac_cv_header_sys_inttypes_h = yes; then
- HAVE_SYS_INTTYPES_H=1
- fi
- if test $ac_cv_header_sys_bitypes_h = yes; then
- HAVE_SYS_BITYPES_H=1
- fi
- gl_STDINT_TYPE_PROPERTIES
- fi
+ if test "$gl_cv_header_stdint_predates_cxx11_h" = yes; then
+ AC_DEFINE([__STDC_CONSTANT_MACROS], [1],
+ [Define to 1 if the system <stdint.h> predates C++11.])
+ AC_DEFINE([__STDC_LIMIT_MACROS], [1],
+ [Define to 1 if the system <stdint.h> predates C++11.])
+ fi
+ AC_CACHE_CHECK([whether stdint.h has UINTMAX_WIDTH etc.],
+ [gl_cv_header_stdint_width],
+ [gl_cv_header_stdint_width=no
+ AC_COMPILE_IFELSE(
+ [AC_LANG_PROGRAM([[
+ /* Work if build is not clean. */
+ #define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1
+ #ifndef __STDC_WANT_IEC_60559_BFP_EXT__
+ #define __STDC_WANT_IEC_60559_BFP_EXT__ 1
+ #endif
+ #include <stdint.h>
+ ]gl_STDINT_INCLUDES[
+ int iw = UINTMAX_WIDTH;
+ ]])],
+ [gl_cv_header_stdint_width=yes])])
+ if test "$gl_cv_header_stdint_width" = yes; then
+ STDINT_H=
+ fi
+ ;;
+ *)
+ dnl Check for <sys/inttypes.h>, and for
+ dnl <sys/bitypes.h> (used in Linux libc4 >= 4.6.7 and libc5).
+ AC_CHECK_HEADERS([sys/inttypes.h sys/bitypes.h])
+ if test $ac_cv_header_sys_inttypes_h = yes; then
+ HAVE_SYS_INTTYPES_H=1
+ fi
+ if test $ac_cv_header_sys_bitypes_h = yes; then
+ HAVE_SYS_BITYPES_H=1
+ fi
+ gl_STDINT_TYPE_PROPERTIES
+ ;;
+ esac
dnl The substitute stdint.h needs the substitute limit.h's _GL_INTEGER_WIDTH.
LIMITS_H=limits.h
diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4
index 110fe2d1a9f..35373463682 100644
--- a/m4/stdlib_h.m4
+++ b/m4/stdlib_h.m4
@@ -1,4 +1,4 @@
-# stdlib_h.m4 serial 43
+# stdlib_h.m4 serial 44
dnl Copyright (C) 2007-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -21,9 +21,9 @@ AC_DEFUN([gl_STDLIB_H],
#endif
]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt
initstate initstate_r mkdtemp mkostemp mkostemps mkstemp mkstemps
- posix_openpt ptsname ptsname_r qsort_r random random_r realpath rpmatch
- secure_getenv setenv setstate setstate_r srandom srandom_r
- strtod strtoll strtoull unlockpt unsetenv])
+ posix_openpt ptsname ptsname_r qsort_r random random_r reallocarray
+ realpath rpmatch secure_getenv setenv setstate setstate_r srandom
+ srandom_r strtod strtoll strtoull unlockpt unsetenv])
])
AC_DEFUN([gl_STDLIB_MODULE_INDICATOR],
@@ -58,6 +58,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
GNULIB_QSORT_R=0; AC_SUBST([GNULIB_QSORT_R])
GNULIB_RANDOM=0; AC_SUBST([GNULIB_RANDOM])
GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R])
+ GNULIB_REALLOCARRAY=0; AC_SUBST([GNULIB_REALLOCARRAY])
GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX])
GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH])
GNULIB_RPMATCH=0; AC_SUBST([GNULIB_RPMATCH])
@@ -77,6 +78,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG])
HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT])
HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT])
+ HAVE_DECL_INITSTATE=1; AC_SUBST([HAVE_DECL_INITSTATE])
HAVE_MKDTEMP=1; AC_SUBST([HAVE_MKDTEMP])
HAVE_MKOSTEMP=1; AC_SUBST([HAVE_MKOSTEMP])
HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS])
@@ -89,11 +91,13 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS],
HAVE_RANDOM=1; AC_SUBST([HAVE_RANDOM])
HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H])
HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R])
+ HAVE_REALLOCARRAY=1; AC_SUBST([HAVE_REALLOCARRAY])
HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH])
HAVE_RPMATCH=1; AC_SUBST([HAVE_RPMATCH])
HAVE_SECURE_GETENV=1; AC_SUBST([HAVE_SECURE_GETENV])
HAVE_SETENV=1; AC_SUBST([HAVE_SETENV])
HAVE_DECL_SETENV=1; AC_SUBST([HAVE_DECL_SETENV])
+ HAVE_DECL_SETSTATE=1; AC_SUBST([HAVE_DECL_SETSTATE])
HAVE_STRTOD=1; AC_SUBST([HAVE_STRTOD])
HAVE_STRTOLL=1; AC_SUBST([HAVE_STRTOLL])
HAVE_STRTOULL=1; AC_SUBST([HAVE_STRTOULL])
diff --git a/m4/string_h.m4 b/m4/string_h.m4
index 3d2ad2219a5..8c42cf1b851 100644
--- a/m4/string_h.m4
+++ b/m4/string_h.m4
@@ -5,7 +5,7 @@
# gives unlimited permission to copy and/or distribute it,
# with or without modifications, as long as this notice is preserved.
-# serial 21
+# serial 22
# Written by Paul Eggert.
@@ -43,6 +43,7 @@ AC_DEFUN([gl_STRING_MODULE_INDICATOR],
AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
[
+ GNULIB_EXPLICIT_BZERO=0; AC_SUBST([GNULIB_EXPLICIT_BZERO])
GNULIB_FFSL=0; AC_SUBST([GNULIB_FFSL])
GNULIB_FFSLL=0; AC_SUBST([GNULIB_FFSLL])
GNULIB_MEMCHR=0; AC_SUBST([GNULIB_MEMCHR])
@@ -82,6 +83,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
GNULIB_STRVERSCMP=0; AC_SUBST([GNULIB_STRVERSCMP])
HAVE_MBSLEN=0; AC_SUBST([HAVE_MBSLEN])
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])
HAVE_FFSLL=1; AC_SUBST([HAVE_FFSLL])
HAVE_MEMCHR=1; AC_SUBST([HAVE_MEMCHR])
@@ -105,16 +107,16 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS],
REPLACE_MEMCHR=0; AC_SUBST([REPLACE_MEMCHR])
REPLACE_MEMMEM=0; AC_SUBST([REPLACE_MEMMEM])
REPLACE_STPNCPY=0; AC_SUBST([REPLACE_STPNCPY])
+ REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL])
REPLACE_STRDUP=0; AC_SUBST([REPLACE_STRDUP])
+ REPLACE_STRNCAT=0; AC_SUBST([REPLACE_STRNCAT])
+ REPLACE_STRNDUP=0; AC_SUBST([REPLACE_STRNDUP])
+ REPLACE_STRNLEN=0; AC_SUBST([REPLACE_STRNLEN])
REPLACE_STRSTR=0; AC_SUBST([REPLACE_STRSTR])
REPLACE_STRCASESTR=0; AC_SUBST([REPLACE_STRCASESTR])
- REPLACE_STRCHRNUL=0; AC_SUBST([REPLACE_STRCHRNUL])
+ REPLACE_STRTOK_R=0; AC_SUBST([REPLACE_STRTOK_R])
REPLACE_STRERROR=0; AC_SUBST([REPLACE_STRERROR])
REPLACE_STRERROR_R=0; AC_SUBST([REPLACE_STRERROR_R])
- REPLACE_STRNCAT=0; AC_SUBST([REPLACE_STRNCAT])
- REPLACE_STRNDUP=0; AC_SUBST([REPLACE_STRNDUP])
- REPLACE_STRNLEN=0; AC_SUBST([REPLACE_STRNLEN])
REPLACE_STRSIGNAL=0; AC_SUBST([REPLACE_STRSIGNAL])
- REPLACE_STRTOK_R=0; AC_SUBST([REPLACE_STRTOK_R])
UNDEFINE_STRTOK_R=0; AC_SUBST([UNDEFINE_STRTOK_R])
])
diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4
index f0586f1a802..61809c8b5db 100644
--- a/m4/strtoimax.m4
+++ b/m4/strtoimax.m4
@@ -1,4 +1,4 @@
-# strtoimax.m4 serial 14
+# strtoimax.m4 serial 15
dnl Copyright (C) 2002-2004, 2006, 2009-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -61,10 +61,12 @@ int main ()
[gl_cv_func_strtoimax=yes],
[gl_cv_func_strtoimax=no],
[case "$host_os" in
- # Guess no on AIX 5.
- aix5*) gl_cv_func_strtoimax="guessing no" ;;
- # Guess yes otherwise.
- *) gl_cv_func_strtoimax="guessing yes" ;;
+ # Guess no on AIX 5.
+ aix5*) gl_cv_func_strtoimax="guessing no" ;;
+ # Guess yes on native Windows.
+ mingw*) gl_cv_func_strtoimax="guessing yes" ;;
+ # Guess yes otherwise.
+ *) gl_cv_func_strtoimax="guessing yes" ;;
esac
])
])
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
index ec0860be905..75097713d98 100644
--- a/m4/sys_types_h.m4
+++ b/m4/sys_types_h.m4
@@ -1,4 +1,4 @@
-# sys_types_h.m4 serial 8
+# sys_types_h.m4 serial 9
dnl Copyright (C) 2011-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -35,12 +35,12 @@ AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS],
])
# This works around a buggy version in autoconf <= 2.69.
-# See <https://lists.gnu.org/archive/html/autoconf/2016-08/msg00014.html>
+# See <https://lists.gnu.org/r/autoconf/2016-08/msg00014.html>
m4_version_prereq([2.70], [], [
# This is taken from the following Autoconf patch:
-# http://git.sv.gnu.org/cgit/autoconf.git/commit/?id=e17a30e98
+# https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=e17a30e987d7ee695fb4294a82d987ec3dc9b974
m4_undefine([AC_HEADER_MAJOR])
AC_DEFUN([AC_HEADER_MAJOR],
diff --git a/m4/unistd_h.m4 b/m4/unistd_h.m4
index cc44677d9eb..60e7ea4d049 100644
--- a/m4/unistd_h.m4
+++ b/m4/unistd_h.m4
@@ -1,4 +1,4 @@
-# unistd_h.m4 serial 70
+# unistd_h.m4 serial 71
dnl Copyright (C) 2006-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -159,6 +159,7 @@ 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_FACCESSAT=0; AC_SUBST([REPLACE_FACCESSAT])
REPLACE_FCHOWNAT=0; AC_SUBST([REPLACE_FCHOWNAT])
REPLACE_FTRUNCATE=0; AC_SUBST([REPLACE_FTRUNCATE])
REPLACE_GETCWD=0; AC_SUBST([REPLACE_GETCWD])
diff --git a/m4/unlocked-io.m4 b/m4/unlocked-io.m4
new file mode 100644
index 00000000000..448ccac2f0e
--- /dev/null
+++ b/m4/unlocked-io.m4
@@ -0,0 +1,41 @@
+# unlocked-io.m4 serial 15
+
+# Copyright (C) 1998-2006, 2009-2017 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 From Jim Meyering.
+dnl
+dnl See if the glibc *_unlocked I/O macros or functions are available.
+dnl Use only those *_unlocked macros or functions that are declared
+dnl (because some of them were declared in Solaris 2.5.1 but were removed
+dnl in Solaris 2.6, whereas we want binaries built on Solaris 2.5.1 to run
+dnl on Solaris 2.6).
+
+AC_DEFUN([gl_FUNC_GLIBC_UNLOCKED_IO],
+[
+ AC_DEFINE([USE_UNLOCKED_IO], [1],
+ [Define to 1 if you want getc etc. to use unlocked I/O if available.
+ Unlocked I/O can improve performance in unithreaded apps,
+ but it is not safe for multithreaded apps.])
+
+ dnl Persuade glibc and Solaris <stdio.h> to declare
+ dnl fgets_unlocked(), fputs_unlocked() etc.
+ AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS])
+
+ AC_CHECK_DECLS_ONCE([clearerr_unlocked])
+ AC_CHECK_DECLS_ONCE([feof_unlocked])
+ AC_CHECK_DECLS_ONCE([ferror_unlocked])
+ AC_CHECK_DECLS_ONCE([fflush_unlocked])
+ AC_CHECK_DECLS_ONCE([fgets_unlocked])
+ AC_CHECK_DECLS_ONCE([fputc_unlocked])
+ AC_CHECK_DECLS_ONCE([fputs_unlocked])
+ AC_CHECK_DECLS_ONCE([fread_unlocked])
+ AC_CHECK_DECLS_ONCE([fwrite_unlocked])
+ AC_CHECK_DECLS_ONCE([getc_unlocked])
+ AC_CHECK_DECLS_ONCE([getchar_unlocked])
+ AC_CHECK_DECLS_ONCE([putc_unlocked])
+ AC_CHECK_DECLS_ONCE([putchar_unlocked])
+])
diff --git a/m4/utimes.m4 b/m4/utimes.m4
index 518824f218f..847b2eba78f 100644
--- a/m4/utimes.m4
+++ b/m4/utimes.m4
@@ -1,5 +1,5 @@
# Detect some bugs in glibc's implementation of utimes.
-# serial 4
+# serial 5
dnl Copyright (C) 2003-2005, 2009-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
@@ -20,10 +20,10 @@ dnl with or without modifications, as long as this notice is preserved.
AC_DEFUN([gl_FUNC_UTIMES],
[
+ AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles
AC_CACHE_CHECK([whether the utimes function works],
[gl_cv_func_working_utimes],
- [
- AC_RUN_IFELSE([AC_LANG_SOURCE([[
+ [AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
@@ -142,9 +142,17 @@ main ()
]])],
[gl_cv_func_working_utimes=yes],
[gl_cv_func_working_utimes=no],
- [gl_cv_func_working_utimes=no])])
+ [case "$host_os" in
+ # Guess no on native Windows.
+ mingw*) gl_cv_func_working_utimes="guessing no" ;;
+ *) gl_cv_func_working_utimes="guessing no" ;;
+ esac
+ ])
+ ])
- if test $gl_cv_func_working_utimes = yes; then
- AC_DEFINE([HAVE_WORKING_UTIMES], [1], [Define if utimes works properly.])
- fi
+ case "$gl_cv_func_working_utimes" in
+ *yes)
+ AC_DEFINE([HAVE_WORKING_UTIMES], [1], [Define if utimes works properly.])
+ ;;
+ esac
])
diff --git a/m4/vararrays.m4 b/m4/vararrays.m4
index 8391121ad3f..2f678e381eb 100644
--- a/m4/vararrays.m4
+++ b/m4/vararrays.m4
@@ -27,7 +27,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:
- http://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html
+ https://lists.gnu.org/r/bug-gnulib/2014-08/msg00014.html
*/
#ifdef __STDC_NO_VLA__
syntax error;
diff --git a/m4/warnings.m4 b/m4/warnings.m4
index e697174eddc..870472b624b 100644
--- a/m4/warnings.m4
+++ b/m4/warnings.m4
@@ -1,4 +1,4 @@
-# warnings.m4 serial 11
+# warnings.m4 serial 13
dnl Copyright (C) 2008-2017 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -20,10 +20,12 @@ m4_ifdef([AS_VAR_APPEND],
# -----------------------------------------------------------------
# Check if the compiler supports OPTION when compiling PROGRAM.
#
-# FIXME: gl_Warn must be used unquoted until we can assume Autoconf
-# 2.64 or newer.
+# The effects of this macro depend on the current language (_AC_LANG).
AC_DEFUN([gl_COMPILER_OPTION_IF],
-[AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl
+[
+dnl FIXME: gl_Warn must be used unquoted until we can assume Autoconf
+dnl 2.64 or newer.
+AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl
AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl
AS_LITERAL_IF([$1],
[m4_pushdef([gl_Positive], m4_bpatsubst([$1], [^-Wno-], [-W]))],
@@ -51,27 +53,52 @@ AS_VAR_POPDEF([gl_Warn])dnl
# ------------------------------
# Clang doesn't complain about unknown warning options unless one also
# specifies -Wunknown-warning-option -Werror. Detect this.
+#
+# The effects of this macro depend on the current language (_AC_LANG).
AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS],
+[_AC_LANG_DISPATCH([$0], _AC_LANG, $@)])
+
+# Specialization for _AC_LANG = C. This macro can be AC_REQUIREd.
+# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
+m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)],
+[
+ AC_LANG_PUSH([C])
+ gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL
+ AC_LANG_POP([C])
+])
+
+# Specialization for _AC_LANG = C++. This macro can be AC_REQUIREd.
+# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b.
+m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)],
+[
+ AC_LANG_PUSH([C++])
+ gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL
+ AC_LANG_POP([C++])
+])
+
+AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL],
[gl_COMPILER_OPTION_IF([-Werror -Wunknown-warning-option],
[gl_unknown_warnings_are_errors='-Wunknown-warning-option -Werror'],
[gl_unknown_warnings_are_errors=])])
-# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS],
+# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS/WARN_CXXFLAGS],
# [PROGRAM = AC_LANG_PROGRAM()])
-# ---------------------------------------------
-# Adds parameter to WARN_CFLAGS if the compiler supports it when
-# compiling PROGRAM. For example, gl_WARN_ADD([-Wparentheses]).
+# -----------------------------------------------------------
+# Adds parameter to WARN_CFLAGS/WARN_CXXFLAGS if the compiler supports it
+# when compiling PROGRAM. For example, gl_WARN_ADD([-Wparentheses]).
#
# If VARIABLE is a variable name, AC_SUBST it.
+#
+# The effects of this macro depend on the current language (_AC_LANG).
AC_DEFUN([gl_WARN_ADD],
-[AC_REQUIRE([gl_UNKNOWN_WARNINGS_ARE_ERRORS])
+[AC_REQUIRE([gl_UNKNOWN_WARNINGS_ARE_ERRORS(]_AC_LANG[)])
gl_COMPILER_OPTION_IF([$1],
- [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_CFLAGS]], [[$2]]), [" $1"])],
+ [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_]_AC_LANG_PREFIX[FLAGS]], [[$2]]), [" $1"])],
[],
[$3])
m4_ifval([$2],
[AS_LITERAL_IF([$2], [AC_SUBST([$2])])],
- [AC_SUBST([WARN_CFLAGS])])dnl
+ [AC_SUBST([WARN_]_AC_LANG_PREFIX[FLAGS])])dnl
])
# Local Variables:
diff --git a/make-dist b/make-dist
index eb81a144ebf..934f83ea088 100755
--- a/make-dist
+++ b/make-dist
@@ -17,7 +17,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
@@ -240,7 +240,7 @@ if [ $check = yes ]; then
bogosities=
while read elc; do
el=`echo $elc | sed 's/c$//'`
- [ -e $el ] || continue
+ [ -r $el ] || continue
[ $elc -nt $el ] || bogosities="$bogosities $elc"
done < /tmp/elc
@@ -278,7 +278,7 @@ if [ $check = yes ]; then
info=`sed -n 's/^@setfilename //p' $texi | sed 's|.*info/||'`
[ x"${info}" != x"" ] || continue
info=info/$info
- [ -e $info ] || continue
+ [ -r $info ] || continue
[ $info -nt $texi ] || bogosities="$bogosities $info"
done < /tmp/el
@@ -292,7 +292,7 @@ if [ $check = yes ]; then
## This exits with non-zero status if any .info files need
## rebuilding.
- if [ -e Makefile ]; then
+ if [ -r Makefile ]; then
echo "Checking to see if info files are up-to-date..."
make --question info || error=yes
fi
@@ -300,7 +300,7 @@ if [ $check = yes ]; then
## Is this a release?
case $version in
[1-9][0-9].[0-9])
- if [ -e ChangeLog ]; then
+ if [ -r ChangeLog ]; then
if ! grep -q "Version $version released" ChangeLog; then
echo "No release notice in ChangeLog"
error=yes
@@ -359,10 +359,10 @@ echo "Creating top directory: '${tempdir}'"
mkdir ${tempdir}
if [ "$changelog" = yes ]; then
- if test -e .git; then
+ if test -r .git; then
## When making a release or pretest the ChangeLog should already
## have been created and edited as needed. Don't ignore it.
- if test -e ChangeLog; then
+ if test -r ChangeLog; then
echo "Using existing top-level ChangeLog"
else
echo "Making top-level ChangeLog"
diff --git a/modules/modhelp.py b/modules/modhelp.py
index ab2ce5c8efb..78fadda4126 100755
--- a/modules/modhelp.py
+++ b/modules/modhelp.py
@@ -17,7 +17,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
import os
import string
diff --git a/msdos/COPYING b/msdos/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/msdos/COPYING
+++ b/msdos/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/msdos/ChangeLog.1 b/msdos/ChangeLog.1
index e8e6ec3af52..6fe88d119bb 100644
--- a/msdos/ChangeLog.1
+++ b/msdos/ChangeLog.1
@@ -1565,4 +1565,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/msdos/INSTALL b/msdos/INSTALL
index ca4ab85f1d1..41e36545f7e 100644
--- a/msdos/INSTALL
+++ b/msdos/INSTALL
@@ -151,4 +151,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/msdos/README b/msdos/README
index 122e8150e47..1add1c46e97 100644
--- a/msdos/README
+++ b/msdos/README
@@ -38,4 +38,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in
index 82af9550332..6e219e760ba 100644
--- a/msdos/autogen/config.in
+++ b/msdos/autogen/config.in
@@ -146,7 +146,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#if !defined _FORTIFY_SOURCE && defined __OPTIMIZE__ && __OPTIMIZE__
# define _FORTIFY_SOURCE 2
#endif
-
+
/* Define to 1 if futimesat mishandles a NULL file name. */
#undef FUTIMESAT_NULL_BUG
@@ -1659,7 +1659,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Please see the Gnulib manual for how to use these macros.
Suppress extern inline with HP-UX cc, as it appears to be broken; see
- <http://lists.gnu.org/archive/html/bug-texinfo/2013-02/msg00030.html>.
+ <https://lists.gnu.org/r/bug-texinfo/2013-02/msg00030.html>.
Suppress extern inline with Sun C in standards-conformance mode, as it
mishandles inline functions that call each other. E.g., for 'inline void f
@@ -1669,7 +1669,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
Suppress the use of extern inline on problematic Apple configurations, as
Libc at least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
- <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
+ <https://lists.gnu.org/r/bug-gnulib/2012-12/msg00023.html>.
Perhaps Apple will fix this some day. */
#if (defined __APPLE__ \
&& ((! defined _DONT_USE_CTYPE_INLINE_ \
@@ -1827,4 +1827,3 @@ Local Variables:
mode: c
End:
*/
-
diff --git a/msdos/depfiles.bat b/msdos/depfiles.bat
index b2c7bc8230a..8910b009eb3 100644
--- a/msdos/depfiles.bat
+++ b/msdos/depfiles.bat
@@ -16,10 +16,10 @@ rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
rem GNU General Public License for more details.
rem You should have received a copy of the GNU General Public License
-rem along with GNU Emacs. If not, see http://www.gnu.org/licenses/.
+rem along with GNU Emacs. If not, see https://www.gnu.org/licenses/.
rem ----------------------------------------------------------------------
-echo %1 | sed -e "s,\(.*\)\.c,@if not exist deps\\\1.Po echo # dummy > deps\\\1.Po," > tdepfile.bat
+echo %1 | sed -e "s,\(.*\)\.c,@if not exist deps\\\1.d echo # dummy > deps\\\1.d," > tdepfile.bat
call tdepfile
del tdepfile.bat
diff --git a/msdos/inttypes.h b/msdos/inttypes.h
index 7996d056583..ce7797a933e 100644
--- a/msdos/inttypes.h
+++ b/msdos/inttypes.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _REPL_INTTYPES_H
#define _REPL_INTTYPES_H
diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2
index dc2b0b6e8ac..e8391bcf918 100644
--- a/msdos/mainmake.v2
+++ b/msdos/mainmake.v2
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# make all to compile and build Emacs.
# make install to install it (installs in-place, in `bin' subdir of top dir).
diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp
index 5431d2bd6c1..cc51301cad3 100644
--- a/msdos/sed1v2.inp
+++ b/msdos/sed1v2.inp
@@ -94,6 +94,8 @@ s/ *@LIBXPM@//
/^IMAGEMAGICK_CFLAGS *=/s/@IMAGEMAGICK_CFLAGS@//
/^LIBXML2_LIBS *=/s/@LIBXML2_LIBS@//
/^LIBXML2_CFLAGS *=/s/@LIBXML2_CFLAGS@//
+/^GETADDRINFO_A_LIBS *=/s/@GETADDRINFO_A_LIBS@//
+/^LIBLCMS2 *=/s/@LIBLCMS2@//
/^WIDGET_OBJ *=/s/@WIDGET_OBJ@//
/^XWIDGETS_OBJ *=/s/@XWIDGETS_OBJ@//
/^WEBKIT_LIBS *=/s/@WEBKIT_LIBS@//
@@ -102,16 +104,19 @@ s/ *@LIBXPM@//
/^CAIRO_CFLAGS *=/s/@CAIRO_CFLAGS@//
/^XFIXES_LIBS *=/s/@XFIXES_LIBS@//
/^XFIXES_CFLAGS *=/s/@XFIXES_CFLAGS@//
+/^XDBE_LIBS *=/s/@XDBE_LIBS@//
+/^XDBE_CFLAGS *=/s/@XDBE_CFLAGS@//
/^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@//
/^WINDOW_SYSTEM_OBJ *=/s/@WINDOW_SYSTEM_OBJ@//
/^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/
/^NS_OBJ *=/s/@NS_OBJ@//
/^NS_OBJC_OBJ *=/s/@NS_OBJC_OBJ@//
/^GNU_OBJC_CFLAGS*=/s/=.*$/=/
-/^LIBRESOLV *=/s/@LIBRESOLV@//
/^LIBMODULES *=/s/@LIBMODULES@//
/^MODULES_OBJ *=/s/@MODULES_OBJ@//
/^LIBSELINUX_LIBS *=/s/@LIBSELINUX_LIBS@//
+/^LIBSYSTEMD_LIBS *=/s/@LIBSYSTEMD_LIBS@//
+/^LIBSYSTEMD_CFLAGS *=/s/@LIBSYSTEMD_CFLAGS@//
/^LIB_CLOCK_GETTIME *=/s/@[^@\n]*@//g
/^LIB_TIMER_TIME *=/s/@[^@\n]*@//g
/^LIB_EXECINFO *=/s/@[^@\n]*@//g
@@ -133,6 +138,7 @@ s/ *@LIBXPM@//
/^XRANDR_CFLAGS *=/s/@XRANDR_CFLAGS@//
/^XINERAMA_LIBS *=/s/@XINERAMA_LIBS@//
/^XINERAMA_CFLAGS *=/s/@XINERAMA_CFLAGS@//
+/^HYBRID_MALLOC *=/s/@HYBRID_MALLOC@//
/^GMALLOC_OBJ *=/s/@GMALLOC_OBJ@/gmalloc.o/
/^VMLIMIT_OBJ *=/s/@VMLIMIT_OBJ@/vm-limit.o/
/^FIRSTFILE_OBJ *=/s/@FIRSTFILE_OBJ@//
@@ -140,9 +146,8 @@ s/ *@LIBXPM@//
/^PRE_ALLOC_OBJ *=/s/@PRE_ALLOC_OBJ@/lastfile.o/
/^POST_ALLOC_OBJ *=/s/@POST_ALLOC_OBJ@/$(vmlimitobj)/
/^UNEXEC_OBJ *=/s/@UNEXEC_OBJ@/unexcoff.o/
+/^BUILD_DETAILS *=/s/@BUILD_DETAILS@//
/^CANNOT_DUMP *=/s/@CANNOT_DUMP@/no/
-/^DEPFLAGS *=/s/@DEPFLAGS@//
-/^MKDEPDIR *=/s/@MKDEPDIR@//
/^W32_OBJ *=/s/@W32_OBJ@//
/^W32_LIBS *=/s/@W32_LIBS@//
/^version *=/s/@[^@\n]*@//
@@ -172,20 +177,18 @@ lisp.mk: $(lispsource)/loadup.el\
/^ [ ]*\$(AM_V_GLOBALS)\$(libsrc)\/make-doc/s!>.*$!!
/^\$(libsrc)\/make-docfile\$(EXEEXT): /i\
cd ../src
-/^\$(leimdir)\/leim-list.el: /s/bootstrap-emacs\$(EXEEXT)/b-emacs$(EXEEXT)/
/^ if test -f/,/^ fi$/c\
command.com /c if exist .gdbinit rm -f _gdbinit
/^ *ifneq (\$(PAXCTL_notdumped),)/,/^ *endif/d
/^ *ifneq (\$(PAXCTL_dumped),)/,/^ *endif/d
/^ *ln /s/ln /cp /
-/^ *\$(SETFATTR_if_present) -n/d
/^ fi/d
/^ *\$(RUN_TEMACS) /i\
stubedit temacs.exe minstack=1024k
/^ *LC_ALL=C \$(RUN_TEMACS)/i\
stubedit temacs.exe minstack=1024k
/^ *LC_ALL=C.*\$(RUN_TEMACS)/s/LC_ALL=C/set &;/
-/-batch -l loadup/a\
+/-batch .* -l loadup/a\
stubify emacs\
stubedit emacs.exe minstack=3072k
s/ @true *$/ @rem/
@@ -193,7 +196,6 @@ s/^ [^ ]*move-if-change / update /
/^ [^ ]*echo[ ][ ]*timestamp/s/echo /djecho /
/^ .*djecho timestamp/a\
@rm -f globals.tmp
-/^ *@\$(MKDEPDIR) *$/d
/^ mv \.\/\.gdbinit/d
/^ if test -f/,/^ fi$/c\
command.com /c if exist .gdbinit rm -f _gdbinit
@@ -201,12 +203,7 @@ s/^ [^ ]*move-if-change / update /
/^ @: /d
/^ -\{0,1\} *ln /s/ln /cp /
/^[ ]touch /s/touch/djecho $@ >/
-s/@YMF_PASS_LDFLAGS@/flags/
-s/@PRE_EDIT_LDFLAGS@//
-s/@POST_EDIT_LDFLAGS@//
s/bootstrap-emacs/b-emacs/
-s/bootstrap-temacs/b-temacs/
-s/bootstrap-doc/b-doc/
/rm -f bootstrap-emacs/s/b-emacs/b-emacs b-emacs.exe/
s/echo.*buildobj.lst/dj&/
/ --load loadup bootstrap/a\
@@ -222,25 +219,20 @@ s/echo.*buildobj.lst/dj&/
}
# Remove or replace dependencies we cannot have
/^\.PRECIOUS: /s!\.\./config.status !!
-/^\.\.\/config.status: /d
+/^\.\.\/config.status: /,/^ /d
/^Makefile: /s!\.\./config.status !!
-/^\$(top_srcdir)\/aclocal\.m4 /,/^doc\.o:/c\
-\
-doc.o: buildobj.h
# Make the GCC command line fit one screen line
/^[ ][ ]*\$(GNUSTEP_CFLAGS)/d
-/^[ ][ ]*\$(GCONF_CFLAGS)/d
/^[ ][ ]*\$(LIBGNUTLS_CFLAGS)/d
-s/\$(LIBOTF_CFLAGS) \$(M17N_FLT_CFLAGS) \$(DEPFLAGS) //
+/^[ ][ ]*\$(LIBSYSTEMD_CFLAGS)/d
+/^[ ][ ]*\$(XRANDR_CFLAGS)/d
+/^[ ][ ]*\$(WEBKIT_CFLAGS)/d
+/^[ ][ ]*\$(SETTINGS_CFLAGS)/d
+s/\$(LIBOTF_CFLAGS) \$(M17N_FLT_CFLAGS) //
s/ \$(C_SWITCH_X_SITE)//
s/ \$(DBUS_CFLAGS)//
s/ \$(PNG_CFLAGS) //
-s/ \$(XINERAMA_CFLAGS)//
-s/ \$(XFIXES_CFLAGS)//
-s/ \$(FREETYPE_CFLAGS)//
-s/ \$(FONTCONFIG_CFLAGS)//
s| -I\$(srcdir)/\.\./lib||
s| -I\$(top_srcdir)/lib||
-# Add our local inttypes.h to prerequisites where needed
-/^lread\.o:/s|lread\.c|& ../msdos/inttypes.h|
+s| -I\. -I\$(srcdir)| -I.|
/^ *test "X/d
diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp
index ba1bb4eecda..595b01e4bb2 100644
--- a/msdos/sed2v2.inp
+++ b/msdos/sed2v2.inp
@@ -55,6 +55,7 @@
/^#undef HAVE_STRNCASECMP *$/s/^.*$/#define HAVE_STRNCASECMP 1/
/^#undef HAVE_STRUCT_TM_TM_ZONE *$/s/^.*$/#define HAVE_STRUCT_TM_TM_ZONE 1/
/^#undef HAVE_SYNC *$/s/^.*$/#define HAVE_SYNC 1/
+/^#undef HAVE___BUILTIN_FRAME_ADDRESS *$/s/^.*$/#define HAVE___BUILTIN_FRAME_ADDRESS 1/
/^#undef HAVE___BUILTIN_UNWIND_INIT *$/s/^.*$/#define HAVE___BUILTIN_UNWIND_INIT 1/
/^#undef HAVE_MENUS *$/s/^.*$/#define HAVE_MENUS 1/
/^#undef DATA_START/s/^.*$/#define DATA_START (\&etext + 1)/
@@ -64,9 +65,7 @@
/^#undef PACKAGE_NAME/s/^.*$/#define PACKAGE_NAME ""/
/^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/
/^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/
-/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION VERSION/
-/^#undef PENDING_OUTPUT_COUNT/s/^.*$/#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)/
-/^#undef VERSION/s/^.*$/#define VERSION "26.0.50"/
+/^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION "27.0.50"/
/^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/
/^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/
/^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/
@@ -86,6 +85,8 @@
/^#undef IS_DIRECTORY_SEP *$/s,^.*$,#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/' || (_c_) == '\\\\'),
/^#undef IS_DEVICE_SEP *$/s/^.*$/#define IS_DEVICE_SEP(_c_) ((_c_) == ':')/
/^#undef IS_ANY_SEP *$/s/^.*$/#define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_) || IS_DEVICE_SEP (_c_))/
+/^#undef NEED_MKTIME_INTERNAL *$/s/^.*$/#define NEED_MKTIME_INTERNAL 1/
+/^#undef NEED_MKTIME_WORKING *$/s/^.*$/#define NEED_MKTIME_WORKING 1/
/^#undef INTERNAL_TERMINAL *$/s,^.*$,#define INTERNAL_TERMINAL "pc|bios|IBM PC with color display::co#80:li#25:Co#16:pa#256:km:ms:cm=<CM>:cl=<CL>:ce=<CE>::se=</SO>:so=<SO>:us=<UL>:ue=</UL>:md=<BD>:mh=<DIM>:mb=<BL>:mr=<RV>:me=<NV>::AB=<BG %d>:AF=<FG %d>:op=<DefC>:",
/^#undef NULL_DEVICE *$/s/^.*$/#define NULL_DEVICE "nul"/
/^#undef SEPCHAR *$/s/^.*$/#define SEPCHAR '\;'/
@@ -102,6 +103,7 @@ s/^#undef STACK_DIRECTION *$/#define STACK_DIRECTION -1/
s/^#undef EMACS_CONFIGURATION *$/#define EMACS_CONFIGURATION "i386-pc-msdosdjgpp"/
s/^#undef EMACS_CONFIG_OPTIONS *$/#define EMACS_CONFIG_OPTIONS "msdos"/
s/^#undef EMACS_CONFIG_FEATURES *$/#define EMACS_CONFIG_FEATURES ""/
+s|^#undef FLEXIBLE_ARRAY_MEMBER *$|#define FLEXIBLE_ARRAY_MEMBER /**/|
s/^#undef PROTOTYPES *$/#define PROTOTYPES 1/
s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/
/^#undef HAVE_INTTYPES_H/c\
@@ -117,12 +119,31 @@ s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/
#undef HAVE_STDINT_H\
#endif
s/^#undef HAVE_C_VARARRAYS *$/#define HAVE_C_VARARRAYS 1/
+s/^#undef HAVE_DECL_ALIGNED_ALLOC *$/#define HAVE_DECL_ALIGNED_ALLOC 0/
+s/^#undef HAVE_DECL_CLEARERR_UNLOCKED *$/#define HAVE_DECL_CLEARERR_UNLOCKED 0/
+s/^#undef HAVE_DECL_FEOF_UNLOCKED *$/#define HAVE_DECL_FEOF_UNLOCKED 0/
+s/^#undef HAVE_DECL_FERROR_UNLOCKED *$/#define HAVE_DECL_FERROR_UNLOCKED 0/
+s/^#undef HAVE_DECL_FFLUSH_UNLOCKED *$/#define HAVE_DECL_FFLUSH_UNLOCKED 0/
+s/^#undef HAVE_DECL_FGETS_UNLOCKED *$/#define HAVE_DECL_FGETS_UNLOCKED 0/
+s/^#undef HAVE_DECL_FPUTC_UNLOCKED *$/#define HAVE_DECL_FPUTC_UNLOCKED 0/
+s/^#undef HAVE_DECL_FPUTS_UNLOCKED *$/#define HAVE_DECL_FPUTS_UNLOCKED 0/
+s/^#undef HAVE_DECL_FREAD_UNLOCKED *$/#define HAVE_DECL_FREAD_UNLOCKED 0/
+s/^#undef HAVE_DECL_FWRITE_UNLOCKED *$/#define HAVE_DECL_FWRITE_UNLOCKED 0/
+s/^#undef HAVE_DECL_GETCHAR_UNLOCKED *$/#define HAVE_DECL_GETCHAR_UNLOCKED 0/
+s/^#undef HAVE_DECL_GETC_UNLOCKED *$/#define HAVE_DECL_GETC_UNLOCKED 0/
+s/^#undef HAVE_DECL_PUTCHAR_UNLOCKED *$/#define HAVE_DECL_PUTCHAR_UNLOCKED 0/
+s/^#undef HAVE_DECL_PUTC_UNLOCKED *$/#define HAVE_DECL_PUTC_UNLOCKED 0/
s/^#undef HAVE_DECL_STRTOLL *$/#define HAVE_DECL_STRTOLL 1/
-s/^#undef HAVE_DECL_STRTOULL *$/#define HAVE_DECL_STRTOULL 1/
s/^#undef HAVE_DECL_STRTOIMAX *$/#define HAVE_DECL_STRTOIMAX 1/
-s/^#undef HAVE_DECL_STRTOUMAX *$/#define HAVE_DECL_STRTOUMAX 1/
s/^#undef HAVE_STRTOLL *$/#define HAVE_STRTOLL 1/
s/^#undef HAVE_STRTOULL *$/#define HAVE_STRTOULL 1/
+/^#undef HAVE_STRUCT_DIRENT_D_TYPE *$/c\
+#if __DJGPP__ + (__DJGPP_MINOR__ >= 5) >= 3\
+#define HAVE_STRUCT_DIRENT_D_TYPE 1/\
+#else\
+#undef HAVE_STRUCT_DIRENT_D_TYPE\
+#endif
+s/^#undef HAVE_STRUCT_ATTRIBUTE_ALIGNED *$/#define HAVE_STRUCT_ATTRIBUTE_ALIGNED 1/
s/^#undef HAVE_PUTENV *$/#define HAVE_PUTENV 1/
/^#undef HAVE_SIGSET_T *$/s/^.*$/#define HAVE_SIGSET_T 1/
/^#undef HAVE_SNPRINTF/c\
@@ -133,7 +154,9 @@ s/^#undef HAVE_PUTENV *$/#define HAVE_PUTENV 1/
#include <sys/types.h>\
extern int snprintf (char *__restrict, size_t, const char *__restrict, ...);\
#endif
-s/^#undef PENDING_OUTPUT_N_BYTES *$/#define PENDING_OUTPUT_N_BYTES fp->_ptr - fp->_base/
+/^#include <conf_post.h>/i\
+/* From libc/file.h, needed by lib/fpending.c. */\
+#define _IOERR 000200
# Comment out any remaining undef directives, because some of them
# might be defined in sys/config.h we include at the top of config.h.
diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp
index b9600e6b016..174c63aacbe 100644
--- a/msdos/sed3v2.inp
+++ b/msdos/sed3v2.inp
@@ -20,7 +20,7 @@
/^archlibdir *=/s!=.*$!=/emacs/bin!
/^bindir *=/s!=.*$!=/emacs/bin!
/^libdir *=/s!=.*$!=/emacs/bin!
-/^srcdir=/s!srcdir=@srcdir@!srcdir := $(subst \\,/,$(shell command.com /c cd))!
+/^srcdir=/s!srcdir=@srcdir@!srcdir := $(CURDIR)!
/^VPATH *=/s!=.*$!=.!
/^BLESSMAIL_TARGET *=/s!@BLESSMAIL_TARGET@!need-blessmail!
/^KRB4LIB *=/s/@[^@\n]*@//g
@@ -41,7 +41,6 @@
/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@//
/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
-/^UPDATE_MANIFEST *=/s/@UPDATE_MANIFEST@//
/^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@//
/^AM_DEFAULT_VERBOSITY *=/s/@AM_DEFAULT_VERBOSITY@/1/
/^[Aa][Mm]_/s/@AM_V@/$(V)/
@@ -58,6 +57,3 @@
/^GETOPT_H *=/s!@GETOPT_H@!getopt.h!
/^GETOPTOBJS *=/s!@GETOPTOBJS@!getopt.o getopt1.o!
/^INSTALLABLES/s/emacsclient[^ ]* *//
-/^UTILITIES *=/,/^$/{
- s/movemail[^ ]* *//
-}
diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp
index 22611351d67..27072e25a6c 100644
--- a/msdos/sedlibmk.inp
+++ b/msdos/sedlibmk.inp
@@ -18,14 +18,9 @@
#
# Checklist to add a new gnulib module:
#
-# . If the module includes source files that need to be compiled, and
-# does not appear in the am_libgnu_a_OBJECTS list, add the
-# corresponding .o file names to the list that gets assigned to the
-# gl_LIBOBJS variable.
-#
-# . If a module appears in am_libgnu_a_OBJECTS that is not required
-# for the MSDOS build, edit it out by adding an appropriate command
-# to the set that edits the am_libgnu_a_OBJECTS block.
+# . If a module appears in gnulib.mk.in that is not required for the
+# MSDOS build, disable its building by setting the corresponding
+# OMIT_GNULIB_MODULE_foo variable to true.
#
# . If the module defines functions that need to replace DJGPP
# functions, edit the appropriate REPLACE_foo variables to 1:
@@ -38,22 +33,22 @@
# as above should be placed before that catchall rule (search for
# "REPLACE_" below).
#
-# . If the module is a header or adds headers, edit the corresponding
-# variable to either an empty value or to the name of the header.
-# Examples:
+# . If the module generates a header from a .in.h file, edit the
+# corresponding variable to either an empty value or to the name of
+# the header. Examples:
#
# /^STDINT_H *=/s/@[^@\n]*@/stdint.h/ -- stdint.h is needed
# /^STDDEF_H *=/s/@[^@\n]*@// -- stddef.h is not needed
#
# . Some of the headers are generated conditionally, and the
-# corresponding recipes are guarded by @GL_GENERATE_xxxx_H_TRUE@
-# and @GL_GENERATE_xxxx_H_FALSE@. Depending on whether DJGPP uses
-# the corresponding header, these should be edited either to
-# nothing (thus exposing the recipe) or to #, which comments the
-# recipe away. Example:
+# corresponding recipes are guarded by
+# ifneq (,$(GL_GENERATE_xxxx_H))
+# Depending on whether DJGPP uses the corresponding header, these
+# should be edited either to 1 (thus exposing the recipe) or
+# to nothing, which makes Make bypass the recipe away. Example:
#
-# s/^@GL_GENERATE_STDBOOL_H_TRUE@/\#/
-# s/^@GL_GENERATE_STDBOOL_H_FALSE@//
+# s/^@GL_GENERATE_STDBOOL_H@/1/
+# s/^@GL_GENERATE_STDINT_H@//
#
# . Also edit the NEXT_foo_H and NEXT_AS_FIRST_DIRECTIVE_foo_H
# variables as appropriately: to an empty value if the gnulib
@@ -67,7 +62,7 @@
#
# . Note that some gnulib headers cannot be left unused: those for
# which there's no corresponding foo_H variable in
-# msdos/autogen/Makefile.in (example: stdio.h). For these the "not
+# lib/Makefile.in (example: stdio.h). For these the "not
# needed" path is not applicable.
#
# . If the header is needed, edit all the variables it uses as
@@ -135,8 +130,6 @@
/^@SET_MAKE@$/s/@SET_MAKE@//
/^VPATH *=/s/@[^@\n]*@/./
s/@PACKAGE@/emacs/
-/^am__cd *=/c\
-am__cd = cd
/^@BUILDING_FOR_WINDOWSNT_TRUE@/s/@[^@\n]*@/#/
/^@BUILDING_FOR_WINDOWSNT_FALSE@/s/@[^@\n]*@//
/^ALLOCA *=/s/@[^@\n]*@//
@@ -145,6 +138,7 @@ am__cd = cd
/^AR *=/s/@[^@\n]*@/ar/
/^ARFLAGS *=/s/@[^@\n]*@/cru/
/^AWK *=/s/@[^@\n]*@/gawk/
+/^AUTO_DEPEND *=/s/@AUTO_DEPEND@/yes/
/^CANNOT_DUMP *=/s/@[^@\n]*@/no/
/^CC *=/s/@[^@\n]*@/gcc -std=gnu99/
/^CPP *=/s/@[^@\n]*@/gcc -e/
@@ -159,6 +153,7 @@ am__cd = cd
/^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@//
/^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@//
/^GNULIB_WARN_CFLAGS *=/s/@GNULIB_WARN_CFLAGS@//
+/^HYBRID_MALLOC *=/s/@HYBRID_MALLOC@//
/^WARN_CFLAGS *=/s/@WARN_CFLAGS@//
/^WERROR_CFLAGS *=/s/@WERROR_CFLAGS@//
/^DEFS *=/s/@[^@\n]*@//
@@ -191,6 +186,7 @@ am__cd = cd
/^GNULIB_MKOSTEMP *=/s/@GNULIB_MKOSTEMP@/1/
/^GNULIB_MKTIME *=/s/@GNULIB_MKTIME@/1/
/^GNULIB_TIME_R *=/s/@GNULIB_TIME_R@/1/
+/^GNULIB_TIMEGM *=/s/@GNULIB_TIMEGM@/1/
/^GNULIB_TIME_RZ *=/s/@GNULIB_TIME_RZ@/1/
/^GNULIB_UNSETENV *=/s/@GNULIB_UNSETENV@/1/
/^GNULIB_[^ =]* *= *@/s/@[^@\n]*@/0/
@@ -250,6 +246,7 @@ am__cd = cd
/^HAVE_SYS_PARAM_H *=/s/@HAVE_SYS_PARAM_H@/1/
/^HAVE_SYS_TIME_H *=/s/@HAVE_SYS_TIME_H@/1/
/^HAVE_SYS_TYPES_H *=/s/@HAVE_SYS_TYPES_H@/1/
+/^HAVE_TIMEGM *=/s/@HAVE_TIMEGM@/0/
/^HAVE_TYPE_VOLATILE_SIG_ATOMIC_T *=/s/@HAVE_TYPE_VOLATILE_SIG_ATOMIC_T@/1/
/^HAVE_UNISTD_H *=/s/@HAVE_UNISTD_H@/1/
/^HAVE_UNSIGNED_LONG_LONG_INT *=/s/@HAVE_UNSIGNED_LONG_LONG_INT@/1/
@@ -273,6 +270,7 @@ am__cd = cd
/^NEXT_AS_FIRST_DIRECTIVE_ERRNO_H *=/s/@[^@\n]*@//
/^NEXT_AS_FIRST_DIRECTIVE_FCNTL_H *=/s/@[^@\n]*@/<fcntl.h>/
/^NEXT_AS_FIRST_DIRECTIVE_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/
+/^NEXT_AS_FIRST_DIRECTIVE_LIMITS_H *=/s/@[^@\n]*@/<limits.h>/
/^NEXT_AS_FIRST_DIRECTIVE_SIGNAL_H *=/s/@[^@\n]*@/<signal.h>/
/^NEXT_AS_FIRST_DIRECTIVE_STDDEF_H *=/s/@[^@\n]*@/<stddef.h>/
/^NEXT_AS_FIRST_DIRECTIVE_STDINT_H *=/s/@[^@\n]*@/<stdint.h>/
@@ -289,6 +287,7 @@ am__cd = cd
/^NEXT_ERRNO_H *=/s/@[^@\n]*@//
/^NEXT_FCNTL_H *=/s/@[^@\n]*@/<fcntl.h>/
/^NEXT_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/
+/^NEXT_LIMITS_H *=/s/@[^@\n]*@/<limits.h>/
/^NEXT_SIGNAL_H *=/s/@[^@\n]*@/<signal.h>/
/^NEXT_STDDEF_H *=/s/@[^@\n]*@/<stddef.h>/
/^NEXT_STDIO_H *=/s/@[^@\n]*@/<stdio.h>/
@@ -317,6 +316,8 @@ am__cd = cd
/^DIRENT_H *=/s/@[^@\n]*@//
/^ERRNO_H *=/s/@[^@\n]*@//
/^EXECINFO_H *=/s/@[^@\n]*@/execinfo.h/
+/^GETOPT_CDEFS_H *=/s/@[^@\n]*@/getopt-cdefs.h/
+/^LIMITS_H *=/s/@[^@\n]*@/limits.h/
/^STDALIGN_H *=/s/@[^@\n]*@/stdalign.h/
/^STDDEF_H *=/s/@[^@\n]*@/stddef.h/
/^STDINT_H *=/s/@[^@\n]*@/stdint.h/
@@ -330,6 +331,8 @@ am__cd = cd
/^WINT_T_SUFFIX *=/s/@WINT_T_SUFFIX@//
/^WINDOWS_64_BIT_OFF_T *=/s/@WINDOWS_64_BIT_OFF_T@/0/
/^WINDOWS_64_BIT_ST_SIZE *=/s/@WINDOWS_64_BIT_ST_SIZE@/0/
+/^WINDOWS_STAT_INODES *=/s/@WINDOWS_STAT_INODES@/0/
+/^WINDOWS_STAT_TIMESPEC *=/s/@WINDOWS_STAT_TIMESPEC@/0/
# Tailor lists of files to what we need
/am__append_[1-9][0-9]* *=.*gettext\.h/s/@[^@\n]*@/\#/
/am__append_2 *=.*verify\.h/s/@[^@\n]*@//
@@ -357,15 +360,18 @@ am__cd = cd
/^top_builddir *=/s/@[^@\n]*@/../
s/@PRAGMA_SYSTEM_HEADER@/\#pragma GCC system_header/
s/@PRAGMA_COLUMNS@//
+/^SYSTEM_TYPE *=/s/@SYSTEM_TYPE@/msdos/
+/^ifneq (\$(SYSTEM_TYPE),windows-nt)/,/^endif/d
+/^DEPDIR *=/a\
+AUTO_DEPEND = yes
#
# Delete the recipes we don't want to get in our way.
-/^\$(srcdir)\/Makefile\.in:/,/^[ ][ ]*\$(AUTOMAKE)/d
-/^Makefile:/,/^[ ][ ]*esac/d
-/^\$(top_srcdir)\/configure:/,/^\$(am__aclocal_m4_deps):/d
-/^\$(top_builddir)\/config.status:/,/^$/d
+/^\.\.\/config.status:/,/^Makefile:/c\
+Makefile: $(srcdir)/Makefile.in
#
# Remove the dependencies on $(top_builddir)/config.status
-s/ $(top_builddir)\/config.status//
+s/ \.\.\/config.status//
+s/ \$(top_builddir)\/config.status//
#
# Fix the include-dependency lines
s/^@AMDEP_TRUE@//
@@ -387,23 +393,53 @@ CONFIG_CLEAN_VPATH_FILES = xyzzy
s/^ -*test -z.*|| rm/ -rm/
s/@echo /@djecho /
#
-# Fix the recipes for header files
-s/^@GL_GENERATE_ALLOCA_H_TRUE@//
-s/^@GL_GENERATE_ALLOCA_H_FALSE@/\#/
-s/^@GL_GENERATE_BYTESWAP_H_TRUE@//
-s/^@GL_GENERATE_BYTESWAP_H_FALSE@/\#/
-s/^@GL_GENERATE_ERRNO_H_TRUE@/\#/
-s/^@GL_GENERATE_ERRNO_H_FALSE@//
-s/^@GL_GENERATE_EXECINFO_H_TRUE@//
-s/^@GL_GENERATE_EXECINFO_H_FALSE@/\#/
-s/^@GL_GENERATE_STDALIGN_H_TRUE@//
-s/^@GL_GENERATE_STDALIGN_H_FALSE@/\#/
-s/^@GL_GENERATE_STDDEF_H_TRUE@//
-s/^@GL_GENERATE_STDDEF_H_FALSE@/\#/
-s/^@GL_GENERATE_STDINT_H_TRUE@//
-s/^@GL_GENERATE_STDINT_H_FALSE@/\#/
-s/^@GL_GENERATE_STDALIGN_H_TRUE@//
-s/^@GL_GENERATE_STDALIGN_H_FALSE@/\#/
+# Determine which headers to generate
+s/= @GL_GENERATE_ALLOCA_H@/= 1/
+s/= @GL_GENERATE_BYTESWAP_H@/= 1/
+s/= @GL_GENERATE_EXECINFO_H@/= 1/
+s/= @GL_GENERATE_STDALIGN_H@/= 1/
+s/= @GL_GENERATE_STDDEF_H@/= 1/
+s/= @GL_GENERATE_STDINT_H@/= 1/
+s/= @GL_GENERATE_LIMITS_H@/= 1/
+s/= @GL_GENERATE_ERRNO_H@/= /
+s/= @GL_GENERATE_LIMITS_H@/= /
+#
+# Determine which modules to build and which to omit
+/^noinst_LIBRARIES /a\
+OMIT_GNULIB_MODULE_acl-permissions = true\
+OMIT_GNULIB_MODULE_allocator = true\
+OMIT_GNULIB_MODULE_at-internal = true\
+OMIT_GNULIB_MODULE_careadlinkat = true\
+OMIT_GNULIB_MODULE_cloexec = true\
+OMIT_GNULIB_MODULE_dirent = true\
+OMIT_GNULIB_MODULE_dirfd = true\
+OMIT_GNULIB_MODULE_dup2 = true\
+OMIT_GNULIB_MODULE_errno = true\
+OMIT_GNULIB_MODULE_euidaccess = true\
+OMIT_GNULIB_MODULE_faccessat = true\
+OMIT_GNULIB_MODULE_fcntl = true\
+OMIT_GNULIB_MODULE_fdopendir = true\
+OMIT_GNULIB_MODULE_fstatat = true\
+OMIT_GNULIB_MODULE_fsync = true\
+OMIT_GNULIB_MODULE_getdtablesize = true\
+OMIT_GNULIB_MODULE_getgroups = true\
+OMIT_GNULIB_MODULE_gettimeofday = true\
+OMIT_GNULIB_MODULE_group-member = true\
+OMIT_GNULIB_MODULE_inttypes-incomplete = true\
+OMIT_GNULIB_MODULE_localtime-buffer = true\
+OMIT_GNULIB_MODULE_lstat = true\
+OMIT_GNULIB_MODULE_open = true\
+OMIT_GNULIB_MODULE_pipe2 = true\
+OMIT_GNULIB_MODULE_pselect = true\
+OMIT_GNULIB_MODULE_putenv = true\
+OMIT_GNULIB_MODULE_qcopy-acl = true\
+OMIT_GNULIB_MODULE_readlink = true\
+OMIT_GNULIB_MODULE_readlinkat = true\
+OMIT_GNULIB_MODULE_strtoimax = true\
+OMIT_GNULIB_MODULE_strtoll = true\
+OMIT_GNULIB_MODULE_symlink = true\
+OMIT_GNULIB_MODULE_sys_select = true\
+OMIT_GNULIB_MODULE_sys_time = true
/^arg-nonnull\.h:/,/^[ ][ ]*mv /c\
arg-nonnull.h: $(top_srcdir)/build-aux/snippet/arg-nonnull.h\
sed -n -e '/GL_ARG_NONNULL/,$$p' < $(top_srcdir)/build-aux/snippet/arg-nonnull.h > $@
@@ -416,6 +452,7 @@ warn-on-use.h: $(top_srcdir)/build-aux/snippet/warn-on-use.h\
s/^ [ ]*{ echo \(.*\); \\/ djecho \1 > $@-t/
s/^ [ ]*{ echo \(.*\) && \\/ djecho \1 > $@-t/
s/^ [ ]*cat \(.*\); \\/ sed -e '' \1 >> $@-t/
+s/^ sed -e/ sed -e/
s/ \&\& \\ *$//
s/\.in-h\; *\\$/.in-h >> $@-t/
/^ [ ]*} /d
diff --git a/msdos/sedlisp.inp b/msdos/sedlisp.inp
index d58e247d343..15f17ce3ee2 100644
--- a/msdos/sedlisp.inp
+++ b/msdos/sedlisp.inp
@@ -25,6 +25,7 @@ export FNCASE=y
/^top_srcdir *=/s|@top_srcdir@|./..|
/^EXEEXT *=/s/@EXEEXT@/.exe/
/^XARGS_LIMIT *=/s|@XARGS_LIMIT@||
+/^FIND_DELETE *=/s/@FIND_DELETE@/-delete/
/^AM_DEFAULT_VERBOSITY *=/s/@AM_DEFAULT_VERBOSITY@/1/
/^[Aa][Mm]_/s/@AM_V@/$(V)/
/^[Aa][Mm]_/s/@AM_DEFAULT_V@/$(AM_DEFAULT_VERBOSITY)/
diff --git a/nextstep/ChangeLog.1 b/nextstep/ChangeLog.1
index f84779d9de6..0eb4a146716 100644
--- a/nextstep/ChangeLog.1
+++ b/nextstep/ChangeLog.1
@@ -327,4 +327,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html b/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html
index 9a9e2f3c695..df79ec941f7 100644
--- a/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html
+++ b/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html
@@ -1 +1 @@
-<font face="lucida grande" size="-1"><a href="http://www.gnu.org/software/emacs">http://www.gnu.org/software/emacs</a></font>
+<font face="lucida grande" size="-1"><a href="https://www.gnu.org/software/emacs">https://www.gnu.org/software/emacs</a></font>
diff --git a/nextstep/INSTALL b/nextstep/INSTALL
index 799cd4d866a..326e02a5502 100644
--- a/nextstep/INSTALL
+++ b/nextstep/INSTALL
@@ -21,15 +21,23 @@ In the top-level directory, use:
(On macOS, --with-ns is enabled by default.)
-This will compile all the files, but emacs will not be able to be run except
-in -nw (terminal) mode.
+Then run:
-In order to run Emacs.app, you must run:
+ make
+
+This will compile all the files.
+
+In order to run Emacs, you must run:
+
+ src/emacs
+
+In order to install Emacs, you must run:
make install
This will assemble the app in nextstep/Emacs.app (i.e., the --prefix
-argument has no effect in this case).
+argument has no effect in this case). You can then move the Emacs.app
+bundle to a location of your choice.
If you pass the --disable-ns-self-contained option to configure, the lisp
files will be installed under whatever 'prefix' is set to (defaults to
@@ -57,4 +65,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in
index ad1abb0bf50..5ddf484fe8f 100644
--- a/nextstep/Makefile.in
+++ b/nextstep/Makefile.in
@@ -15,7 +15,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/nextstep/README b/nextstep/README
index 94993d831f9..03d69b16b27 100644
--- a/nextstep/README
+++ b/nextstep/README
@@ -120,4 +120,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in
index b1dae4e6691..5d2eb7def3f 100644
--- a/nextstep/templates/Info.plist.in
+++ b/nextstep/templates/Info.plist.in
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-->
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
diff --git a/nt/COPYING b/nt/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/nt/COPYING
+++ b/nt/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/nt/ChangeLog.1 b/nt/ChangeLog.1
index 0117639a8f6..f2d44033d43 100644
--- a/nt/ChangeLog.1
+++ b/nt/ChangeLog.1
@@ -297,8 +297,8 @@
to avoid gnulib replacement of 'struct timeval' and the resulting
compilation of lib/gettimeofday.c with incompatible version of
gettimeofday. Related discussions on emacs-devel:
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00286.html
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00361.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00286.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00361.html
2013-08-31 Glenn Morris <rgm@gnu.org>
@@ -373,7 +373,7 @@
* inc/sys/time.h (gettimeofday): Use '__restrict' instead of
'restrict', which is a C99 extension. See
- http://lists.gnu.org/archive/html/emacs-devel/2013-05/msg00588.html
+ https://lists.gnu.org/r/emacs-devel/2013-05/msg00588.html
and the following discussion for the problem this caused in the
old nt/configure.bat build.
@@ -524,10 +524,10 @@
Fix more incompatibilities between MinGW.org and MinGW64 headers
reported by Óscar Fuentes in
- http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00733.html
- http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00699.html
+ https://lists.gnu.org/r/emacs-devel/2013-03/msg00733.html
+ https://lists.gnu.org/r/emacs-devel/2013-03/msg00699.html
and in
- http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00707.html.
+ https://lists.gnu.org/r/emacs-devel/2013-03/msg00707.html.
* inc/ms-w32.h (USE_NO_MINGW_SETJMP_TWO_ARGS) [_W64]: Define to 1.
For MinGW64, include sys/types.h and time.h.
(_WIN32_WINNT) [!_W64]: Don't define for MinGW64.
@@ -548,7 +548,7 @@
Fix incompatibilities between MinGW.org and MinGW64 headers
reported by Óscar Fuentes in
- http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00611.html.
+ https://lists.gnu.org/r/emacs-devel/2013-03/msg00611.html.
* inc/ms-w32.h (struct timespec): Don't define if
_TIMESPEC_DEFINED is already defined.
(sigset_t) [!_POSIX]: Typedef for MinGW64.
@@ -724,7 +724,7 @@
2012-11-21 Eli Zaretskii <eliz@gnu.org>
* nmake.defs: Use !if, not !ifdef. For the details, see
- http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00027.html
+ https://lists.gnu.org/r/help-emacs-windows/2012-11/msg00027.html
* inc/stdint.h (INTPTR_MIN)
(PTRDIFF_MIN) [!__GNUC__]: Define for MSVC.
@@ -1184,7 +1184,7 @@
(dist): Depend on it.
(install-shortcuts): Depend on install-addpm instead of copying
addpm.exe as part of the recipe. See
- http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00171.html
+ https://lists.gnu.org/r/emacs-devel/2012-06/msg00171.html
for the related problem and discussions.
2012-06-11 Glenn Morris <rgm@gnu.org>
@@ -3563,4 +3563,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nt/INSTALL b/nt/INSTALL
index b7f47a5d7c2..30e14293f5c 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -486,6 +486,8 @@ build will run on Windows 9X and newer systems).
Does Emacs use a gif library? yes
Does Emacs use a png library? yes
Does Emacs use -lrsvg-2? yes
+ Does Emacs use cairo? no
+ Does Emacs use -llcms2? yes
Does Emacs use imagemagick? no
Does Emacs support sound? no
Does Emacs use -lgpm? no
@@ -628,7 +630,7 @@ build will run on Windows 9X and newer systems).
To support XPM images (required for color tool-bar icons), you will
need the libXpm library. It is available from the ezwinports site,
http://sourceforge.net/projects/ezwinports/files/ and from
- http://ftp.gnu.org/gnu/emacs/windows/.
+ https://ftp.gnu.org/gnu/emacs/windows/.
For PNG images, we recommend to use versions 1.4.x and later of
libpng, because previous versions had security issues. You can find
@@ -651,7 +653,7 @@ build will run on Windows 9X and newer systems).
giflib, as it is much enhanced wrt previous versions. You can find
precompiled binaries and headers for giflib on the ezwinports site,
http://sourceforge.net/projects/ezwinports/files/ and on
- http://ftp.gnu.org/gnu/emacs/windows/.
+ https://ftp.gnu.org/gnu/emacs/windows/.
Version 5.0.0 and later of giflib are binary incompatible with
previous versions (the signatures of several functions have
@@ -692,7 +694,7 @@ build will run on Windows 9X and newer systems).
because the compiler needs to see their header files when building
Emacs.
- http://ftp.gnu.org/gnu/emacs/windows/
+ https://ftp.gnu.org/gnu/emacs/windows/
More fat ports, from the MSYS2 project.
@@ -753,7 +755,7 @@ build will run on Windows 9X and newer systems).
You can get pre-built binaries (including any required DLL and the
header files) at http://sourceforge.net/projects/ezwinports/files/
- and on http://ftp.gnu.org/gnu/emacs/windows/.
+ and on https://ftp.gnu.org/gnu/emacs/windows/.
* Optional libxml2 support
@@ -775,7 +777,7 @@ build will run on Windows 9X and newer systems).
(including any required DLL and the header files) is here:
http://sourceforge.net/projects/ezwinports/files/
- http://ftp.gnu.org/gnu/emacs/windows/
+ https://ftp.gnu.org/gnu/emacs/windows/
For runtime support of libxml2, you will also need to install the
libiconv "development" tarball, because the libiconv headers need to
@@ -797,6 +799,13 @@ build will run on Windows 9X and newer systems).
(This library is also a prerequisite for several image libraries, so
you may already have it; look for zlib1.dll or libz-1.dll.)
+* Optional support for lcms2 library
+
+ Emacs can expose some capabilities of the Little CMS color
+ management engine to Lisp programs using the lcms2 library.
+ Prebuilt binaries of lcms2 DLL (for 32-bit builds of Emacs) are
+ available from the ezwinports site and from the MSYS2 project.
+
This file is part of GNU Emacs.
@@ -811,4 +820,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index b40f2238b5e..e08b72f2ca0 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -35,27 +35,15 @@ Run this file to install MSYS2 in your preferred directory, e.g. the default
C:\msys64 -- this will install MinGW-w64 also. Note that directory names
containing spaces may cause problems.
-Then you'll need to add the following directories to your Windows PATH
-environment variable:
-
- c:\msys64\usr\bin;c:\msys64\mingw64\bin
-
-you can do this through Control Panel / System and Security / System /
-Advanced system settings / Environment Variables / Edit path.
-
-Adding these directories to your PATH tells Emacs where to find the DLLs it
-needs to run, and some optional commands like grep and find. These commands
-will also be available at the Windows console.
-
** Download and install the necessary packages
-Run msys2_shell.bat in your MSYS2 directory and you will see a BASH window
+Run c:/msys64/msys2.exe in your MSYS2 directory and you will see a BASH window
opened.
In the BASH prompt, use the following command to install the necessary
packages (you can copy and paste it into the shell with Shift + Insert):
- pacman -S base-devel \
+ pacman -S --needed base-devel \
mingw-w64-x86_64-toolchain \
mingw-w64-x86_64-xpm-nox \
mingw-w64-x86_64-libtiff \
@@ -63,6 +51,7 @@ packages (you can copy and paste it into the shell with Shift + Insert):
mingw-w64-x86_64-libpng \
mingw-w64-x86_64-libjpeg-turbo \
mingw-w64-x86_64-librsvg \
+ mingw-w64-x86_64-lcms2 \
mingw-w64-x86_64-libxml2 \
mingw-w64-x86_64-gnutls \
mingw-w64-x86_64-zlib
@@ -100,7 +89,7 @@ Savannah Emacs site, https://savannah.gnu.org/projects/emacs.
** From the FTP site
-The Emacs ftp site is located at http://ftp.gnu.org/gnu/emacs/ - download the
+The Emacs ftp site is located at https://ftp.gnu.org/gnu/emacs/ - download the
version you want to build and put the file into a location like C:\emacs\,
then uncompress it with tar. This will put the Emacs source into a folder like
C:\emacs\emacs-24.5:
@@ -111,11 +100,11 @@ C:\emacs\emacs-24.5:
** From the Git repository
To download the Git repository, do something like the following -- this will
-put the Emacs source into C:\emacs\emacs-25:
+put the Emacs source into C:\emacs\emacs-26:
mkdir /c/emacs
cd /c/emacs
- git clone git://git.sv.gnu.org/emacs.git emacs-25
+ git clone git://git.sv.gnu.org/emacs.git emacs-26
(We recommend using the command shown on Savannah Emacs project page.)
@@ -125,10 +114,10 @@ Now you're ready to build and install Emacs with autogen, configure, make,
and make install.
First we need to switch to the MinGW-w64 environment. Exit the MSYS2 BASH
-console and run mingw64_shell.bat in the C:\msys64 folder, then cd back to
+console and run mingw64.exe in the C:\msys64 folder, then cd back to
your Emacs source directory, e.g.:
- cd /c/emacs/emacs-25
+ cd /c/emacs/emacs-26
** Run autogen
@@ -145,15 +134,14 @@ that the example given here is just a simple one - for more information
on the options available please see the INSTALL file in this directory.
The '--prefix' option specifies a location for the resulting binary files,
-which 'make install' will use - in this example we set it to C:\emacs\emacs-25.
+which 'make install' will use - in this example we set it to C:\emacs\emacs-26.
If a prefix is not specified the files will be put in the standard Unix
directories located in your C:\msys64 directory, but this is not recommended.
-Note also that we need to disable Imagemagick because Emacs does not yet
-support it on Windows.
+Note also that we need to disable Imagemagick and D-Bus because Emacs
+does not yet support them on Windows.
- PKG_CONFIG_PATH=/mingw64/lib/pkgconfig \
- ./configure --prefix=/c/emacs/emacs-25 --without-imagemagick
+ ./configure --prefix=/c/emacs/emacs-26 --without-imagemagick --without-dbus
** Run make
@@ -191,6 +179,14 @@ To test it out, run
and if all went well, you will have a new 64-bit version of Emacs.
+When running Emacs from outside the mingw64 shell, you will need to
+add c:\msys64\mingw64\bin to your Windows PATH, or copy the needed
+DLLs into Emacs' bin/ directory. Otherwise features such as TLS which
+depend on those DLLs will be missing.
+
+You can do this through Control Panel / System and Security / System /
+Advanced system settings / Environment Variables / Edit path.
+
* Make a shortcut
To make a shortcut to run the new Emacs, right click on the location where you
@@ -201,6 +197,51 @@ You can set any command line options by right clicking on the resulting
shortcut, select Properties, then add any options to the Target command,
e.g. --debug-init.
+* Troubleshooting
+
+** Missing mingw64.exe launcher
+
+Older versions of Msys2 may lack the mingw64.exe launcher program. If
+you have them, running mingw64_shell.bat or "msys2_shell.cmd -mingw64"
+should work instead.
+
+Alternatively, install mingw64.exe with
+
+ pacman -S msys/msys2-launcher-git
+
+** Configure errors
+
+*** Check that mingw64 gcc is accessible
+
+Errors like
+
+ configure: error: Emacs does not support 'x86_64-pc-msys' systems.
+
+or
+
+ checking the compiler's target... configure: error: Impossible to obtain gcc compiler target.
+
+indicate you didn't use the mingw64 launcher, or you didn't install
+gcc. It's also possible you have something in ~/.bashrc or ~/.profile
+which modifies PATH or MSYSTEM to an unexpected value, preventing gcc
+from being found. At the mingw64 bash shell, running
+
+ gcc -v
+
+should give output which includes the text
+
+ Target: x86_64-w64-mingw32
+
+*** Check your $PKG_CONFIG_PATH
+
+For a typical MSYS2 install, running
+
+ echo $PKG_CONFIG_PATH
+
+at the mingw64 bash shell should give print a value starting with
+'/mingw64/lib/pkgconfig'. Incorrect values may prevent configure from
+finding installed libraries.
+
* Credits
Thanks to Chris Zheng for the original build outline as used by the
@@ -223,4 +264,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nt/Makefile.in b/nt/Makefile.in
index 7e911db7aa8..82158236308 100644
--- a/nt/Makefile.in
+++ b/nt/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Avoid trouble on systems where the `SHELL' variable might be
# inherited from the environment.
diff --git a/nt/README b/nt/README
index 09d6820d7f2..c4d5b95340c 100644
--- a/nt/README
+++ b/nt/README
@@ -9,9 +9,9 @@
subprocesses, windowing features (fonts, colors, scroll bars, multiple
frames, etc.), and networking support.
- Precompiled distributions are also available; ftp to
+ Precompiled distributions are also available; see:
- ftp://ftp.gnu.org/gnu/emacs/windows/
+ https://ftp.gnu.org/gnu/emacs/windows/
for the latest precompiled distributions.
@@ -86,18 +86,18 @@
This appendix is also available (as part of the entire manual) at
- http://www.gnu.org/software/emacs/manual/html_mono/emacs.html#Microsoft-Windows
+ https://www.gnu.org/software/emacs/manual/html_mono/emacs.html#Microsoft-Windows
In addition to the manual, there is a mailing list for discussing
issues related to the Windows port of Emacs. For information about
the list, see this Web page:
- http://mail.gnu.org/mailman/listinfo/help-emacs-windows
+ https://mail.gnu.org/mailman/listinfo/help-emacs-windows
To ask questions on the mailing list, send email to
help-emacs-windows@gnu.org. (You don't need to subscribe for that.)
To subscribe to the list or unsubscribe from it, fill the form you
- find at http://mail.gnu.org/mailman/listinfo/help-emacs-windows as
+ find at https://mail.gnu.org/mailman/listinfo/help-emacs-windows as
explained there.
Another valuable source of information and help which should not be
@@ -140,4 +140,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nt/README.W32 b/nt/README.W32
index 1141e8a1b71..e996c8e672c 100644
--- a/nt/README.W32
+++ b/nt/README.W32
@@ -1,14 +1,14 @@
Copyright (C) 2001-2017 Free Software Foundation, Inc.
See the end of the file for license conditions.
- Emacs version 25.1.50 for MS-Windows
+ Emacs version 27.0.50 for MS-Windows
This README file describes how to set up and run a precompiled
distribution of the latest version of GNU Emacs for MS-Windows. You
can find the precompiled distribution on the ftp.gnu.org server and
its mirrors:
- ftp://ftp.gnu.org/gnu/emacs/windows/
+ https://ftp.gnu.org/gnu/emacs/windows/
This server contains other distributions, including the full Emacs
source distribution, as well as older releases of Emacs for Windows.
@@ -275,12 +275,12 @@ See the end of the file for license conditions.
This appendix is also available (as part of the entire manual) at
- http://www.gnu.org/software/emacs/manual/html_mono/emacs.html#Microsoft-Windows
+ https://www.gnu.org/software/emacs/manual/html_mono/emacs.html#Microsoft-Windows
In addition to the manual, there is a mailing list for help with
Emacs here:
- http://lists.gnu.org/mailman/listinfo/help-gnu-emacs
+ https://lists.gnu.org/mailman/listinfo/help-gnu-emacs
To ask questions on this mailing list, send email to
help-gnu-emacs@gnu.org.
@@ -288,7 +288,7 @@ See the end of the file for license conditions.
A mailing list for issues specifically related to the MS-Windows port
of Emacs is here:
- http://lists.gnu.org/mailman/listinfo/help-emacs-windows
+ https://lists.gnu.org/mailman/listinfo/help-emacs-windows
To ask questions on this mailing list, send email to
help-emacs-windows@gnu.org.
@@ -325,4 +325,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/nt/addpm.c b/nt/addpm.c
index b034fffe29c..51f25106827 100644
--- a/nt/addpm.c
+++ b/nt/addpm.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/****************************************************************************
*
diff --git a/nt/cmdproxy.c b/nt/cmdproxy.c
index 93e00973925..0b4d4375894 100644
--- a/nt/cmdproxy.c
+++ b/nt/cmdproxy.c
@@ -25,7 +25,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <windows.h>
diff --git a/nt/configure.bat b/nt/configure.bat
index cd2a8f4f287..9705c66faa0 100755
--- a/nt/configure.bat
+++ b/nt/configure.bat
@@ -16,7 +16,7 @@ rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
rem GNU General Public License for more details.
rem You should have received a copy of the GNU General Public License
-rem along with GNU Emacs. If not, see http://www.gnu.org/licenses/.
+rem along with GNU Emacs. If not, see https://www.gnu.org/licenses/.
rem ----------------------------------------------------------------------
echo ****************************************************************
diff --git a/nt/ddeclient.c b/nt/ddeclient.c
index 15aeb842fc1..c370ef83ac5 100644
--- a/nt/ddeclient.c
+++ b/nt/ddeclient.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <windows.h>
#include <ddeml.h>
diff --git a/nt/epaths.nt b/nt/epaths.nt
index ebb4ccf6412..4f4f86a01a8 100644
--- a/nt/epaths.nt
+++ b/nt/epaths.nt
@@ -28,7 +28,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Together with PATH_SITELOADSEARCH, this gives the default value of
@@ -85,4 +85,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Where Emacs should look for the application default file. */
#define PATH_X_DEFAULTS ""
-
diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk
index 175329fb9e7..f62166759de 100644
--- a/nt/gnulib-cfg.mk
+++ b/nt/gnulib-cfg.mk
@@ -13,7 +13,7 @@
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
-# along with this file. If not, see <http://www.gnu.org/licenses/>.
+# along with this file. If not, see <https://www.gnu.org/licenses/>.
# Gnulib modules to be omitted from Emacs.
@@ -49,8 +49,9 @@ OMIT_GNULIB_MODULE_dirent = true
OMIT_GNULIB_MODULE_dirfd = true
OMIT_GNULIB_MODULE_fcntl = true
OMIT_GNULIB_MODULE_fcntl-h = true
+OMIT_GNULIB_MODULE_fsusage = true
OMIT_GNULIB_MODULE_inttypes-incomplete = true
-OMIT_GNULIB_MODULE_mkostemp = true
+OMIT_GNULIB_MODULE_open = true
OMIT_GNULIB_MODULE_pipe2 = true
OMIT_GNULIB_MODULE_secure_getenv = true
OMIT_GNULIB_MODULE_signal-h = true
@@ -60,5 +61,4 @@ OMIT_GNULIB_MODULE_sys_select = true
OMIT_GNULIB_MODULE_sys_stat = true
OMIT_GNULIB_MODULE_sys_time = true
OMIT_GNULIB_MODULE_sys_types = true
-OMIT_GNULIB_MODULE_tempname = true
OMIT_GNULIB_MODULE_unistd = true
diff --git a/nt/inc/grp.h b/nt/inc/grp.h
index 82a8bab227b..0c3a8ecd64b 100644
--- a/nt/inc/grp.h
+++ b/nt/inc/grp.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _GRP_H
#define _GRP_H
diff --git a/nt/inc/inttypes.h b/nt/inc/inttypes.h
index e5037b1fed5..e0905b74d7b 100644
--- a/nt/inc/inttypes.h
+++ b/nt/inc/inttypes.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _REPL_INTTYPES_H
#define _REPL_INTTYPES_H
diff --git a/nt/inc/langinfo.h b/nt/inc/langinfo.h
index a20e59bee0f..88e12b59e84 100644
--- a/nt/inc/langinfo.h
+++ b/nt/inc/langinfo.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _LANGINFO_H
#define _LANGINFO_H
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index 957d8c6bdbc..89aa94323d4 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Define symbols to identify the version of Unix this is.
Define all the symbols that apply correctly. */
@@ -237,9 +237,6 @@ extern void w32_reset_stack_overflow_guard (void);
#define fopen sys_fopen
#define link sys_link
#define localtime sys_localtime
-#define mkdir sys_mkdir
-#undef open
-#define open sys_open
#undef read
#define read sys_read
#define rename sys_rename
@@ -289,6 +286,10 @@ extern int sys_umask (int);
#endif /* emacs */
+/* Used both in Emacs, in lib-src, and in Gnulib. */
+#undef open
+#define open sys_open
+
/* Map to MSVC names. */
#define execlp _execlp
#define execvp _execvp
@@ -465,6 +466,12 @@ extern char *get_emacs_configuration_options (void);
#include <malloc.h>
#endif
+/* Needed in Emacs and in Gnulib. */
+/* This must be after including sys/stat.h, because we need mode_t. */
+#undef mkdir
+#define mkdir(d,f) sys_mkdir(d,f)
+int sys_mkdir (const char *, mode_t);
+
#ifdef emacs
typedef void * (* malloc_fn)(size_t);
@@ -518,9 +525,9 @@ extern int getpagesize (void);
extern void * memrchr (void const *, int, size_t);
+/* Declared here, since we don't use Gnulib's stdlib.h. */
extern int mkostemp (char *, int);
-
#if defined (__MINGW32__)
/* Define to 1 if the system has the type `long long int'. */
diff --git a/nt/inc/nl_types.h b/nt/inc/nl_types.h
index 8236a6dba93..6ed0994c59d 100644
--- a/nt/inc/nl_types.h
+++ b/nt/inc/nl_types.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _NL_TYPES_H
#define _NL_TYPES_H
diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h
index 1e41ddb637a..c4fb98d2f91 100644
--- a/nt/inc/stdint.h
+++ b/nt/inc/stdint.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _NT_STDINT_H_
#define _NT_STDINT_H_
diff --git a/nt/inc/sys/resource.h b/nt/inc/sys/resource.h
index 2964a643d35..de10aaee06e 100644
--- a/nt/inc/sys/resource.h
+++ b/nt/inc/sys/resource.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef INC_SYS_RESOURCE_H_
#define INC_SYS_RESOURCE_H_
diff --git a/nt/inc/sys/socket.h b/nt/inc/sys/socket.h
index 32f6a1db6f1..b7c1103f21a 100644
--- a/nt/inc/sys/socket.h
+++ b/nt/inc/sys/socket.h
@@ -13,7 +13,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Workable version of <sys/socket.h> based on winsock.h */
diff --git a/nt/inc/sys/stat.h b/nt/inc/sys/stat.h
index d686af1bc1f..2f1cf468736 100644
--- a/nt/inc/sys/stat.h
+++ b/nt/inc/sys/stat.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef INC_SYS_STAT_H_
#define INC_SYS_STAT_H_
diff --git a/nt/inc/sys/wait.h b/nt/inc/sys/wait.h
index 6be7fd32448..51eae821b54 100644
--- a/nt/inc/sys/wait.h
+++ b/nt/inc/sys/wait.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef INC_SYS_WAIT_H_
#define INC_SYS_WAIT_H_
diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site
index a1067179797..d9a824008cb 100644
--- a/nt/mingw-cfg.site
+++ b/nt/mingw-cfg.site
@@ -79,7 +79,6 @@ ac_cv_func_getaddrinfo=yes
# Implemented as an inline function in ws2tcpip.h
ac_cv_func_gai_strerror=yes
# Implemented in w32.c
-ac_cv_func_mkostemp=yes
ac_cv_func_readlink=yes
ac_cv_func_symlink=yes
# Avoid run-time tests of readlink and symlink, which will fail
diff --git a/nt/preprep.c b/nt/preprep.c
index 73660351a0e..fc91628226f 100644
--- a/nt/preprep.c
+++ b/nt/preprep.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Andrew Innes <andrewi@harlequin.co.uk> 16-Jan-1999
diff --git a/nt/runemacs.c b/nt/runemacs.c
index a98ff4be52c..d6e02b248dd 100644
--- a/nt/runemacs.c
+++ b/nt/runemacs.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index 876cb3d06ba..638a20875ae 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -16,7 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/*
* XMenu: MIT Project Athena, X Window system menu package
@@ -571,6 +571,7 @@ XMenuActivate(
event.xbutton.window
);
if (event_xmp != NULL) continue;
+ FALLTHROUGH;
default:
/*
* This is a foreign event.
diff --git a/oldXMenu/ChangeLog.1 b/oldXMenu/ChangeLog.1
index 8fa3794a36e..3c6aae26945 100644
--- a/oldXMenu/ChangeLog.1
+++ b/oldXMenu/ChangeLog.1
@@ -67,7 +67,7 @@
* XLookAssoc.c, XMenuInt.h: Include <config.h>.
This avoids a build failure when configuring on Fedora 17
--with-x-toolkit=no, reported by Dmitry Andropov in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00078.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-12/msg00078.html>.
2012-10-06 Ulrich Müller <ulm@gentoo.org>
@@ -727,4 +727,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c
index a0913685365..83e6c8e38c7 100644
--- a/oldXMenu/Create.c
+++ b/oldXMenu/Create.c
@@ -16,7 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/*
diff --git a/oldXMenu/FindSel.c b/oldXMenu/FindSel.c
index 7440b3dd9ce..37a87a819af 100644
--- a/oldXMenu/FindSel.c
+++ b/oldXMenu/FindSel.c
@@ -16,7 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>.
+along with this program. If not, see <https://www.gnu.org/licenses/>.
*/
/*
diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c
index bc4ed223299..913904474c5 100644
--- a/oldXMenu/Internal.c
+++ b/oldXMenu/Internal.c
@@ -16,7 +16,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/*
diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in
index 7a5c9985920..59a6c7465b4 100644
--- a/oldXMenu/Makefile.in
+++ b/oldXMenu/Makefile.in
@@ -28,7 +28,7 @@
## GNU General Public License for more details.
## You should have received a copy of the GNU General Public License
-## along with this program. If not, see <http://www.gnu.org/licenses/>.
+## along with this program. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/oldXMenu/deps.mk b/oldXMenu/deps.mk
index bbd98ca7c20..acb42e491ad 100644
--- a/oldXMenu/deps.mk
+++ b/oldXMenu/deps.mk
@@ -28,7 +28,7 @@
## GNU General Public License for more details.
## You should have received a copy of the GNU General Public License
-## along with this program. If not, see <http://www.gnu.org/licenses/>.
+## along with this program. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
diff --git a/oldXMenu/insque.c b/oldXMenu/insque.c
index 2906f9c0409..0c6afc6f622 100644
--- a/oldXMenu/insque.c
+++ b/oldXMenu/insque.c
@@ -12,7 +12,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* This file implements the emacs_insque and emacs_remque functions,
clones of the insque and remque functions of BSD. They and all
diff --git a/src/.gdbinit b/src/.gdbinit
index b5a974bb38d..e22d03ea476 100644
--- a/src/.gdbinit
+++ b/src/.gdbinit
@@ -13,7 +13,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Force loading of symbols, enough to give us VALBITS etc.
set $dummy = main + 8
@@ -78,7 +78,7 @@ end
# Access the name of a symbol
define xsymname
xgetsym $arg0
- set $symname = $ptr->name
+ set $symname = $ptr->u.s.name
end
# Set up something to print out s-expressions.
@@ -352,7 +352,7 @@ end
define pcursorx
set $cp = $arg0
- printf "y=%d x=%d vpos=%d hpos=%d", $cp->y, $cp->x, $cp->vpos, $cp->hpos
+ printf "y=%d x=%d vpos=%d hpos=%d", $cp.y, $cp.x, $cp.vpos, $cp.hpos
end
document pcursorx
Pretty print a window cursor.
@@ -369,28 +369,26 @@ end
define pwinx
set $w = $arg0
- if ($w->mini_p != Qnil)
+ if ($w->mini != 0)
printf "Mini "
end
- printf "Window %d ", $int
- xgetptr $w->buffer
+ printf "Window %d ", $w->sequence_number
+ xgetptr $w->contents
set $tem = (struct buffer *) $ptr
xgetptr $tem->name_
- printf "%s", ((struct Lisp_String *) $ptr)->data
+ printf "%s", ((struct Lisp_String *) $ptr)->u.s.data
printf "\n"
xgetptr $w->start
set $tem = (struct Lisp_Marker *) $ptr
printf "start=%d end:", $tem->charpos
- if ($w->window_end_valid != Qnil)
- xgetint $w->window_end_pos
- printf "pos=%d", $int
- xgetint $w->window_end_vpos
- printf " vpos=%d", $int
+ if ($w->window_end_valid != 0)
+ printf "pos=%d", $w->window_end_pos
+ printf " vpos=%d", $w->window_end_vpos
else
printf "invalid"
end
printf " vscroll=%d", $w->vscroll
- if ($w->force_start != Qnil)
+ if ($w->force_start != 0)
printf " FORCE_START"
end
if ($w->must_be_updated_p)
@@ -504,7 +502,7 @@ define pgx
xgettype ($g.object)
if ($type == Lisp_String)
xgetptr $g.object
- printf " str=0x%x[%d]", ((struct Lisp_String *)$ptr)->data, $g.charpos
+ printf " str=0x%x[%d]", ((struct Lisp_String *)$ptr)->u.s.data, $g.charpos
else
printf " pos=%d", $g.charpos
end
@@ -896,7 +894,7 @@ define xbuffer
xgetptr $
print (struct buffer *) $ptr
xgetptr $->name_
- output ((struct Lisp_String *) $ptr)->data
+ output ((struct Lisp_String *) $ptr)->u.s.data
echo \n
end
document xbuffer
@@ -935,7 +933,7 @@ end
define xcar
xgetptr $
xgettype $
- print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->car : 0)
+ print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.s.car : 0)
end
document xcar
Assume that $ is an Emacs Lisp pair and print its car.
@@ -944,7 +942,7 @@ end
define xcdr
xgetptr $
xgettype $
- print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.cdr : 0)
+ print/x ($type == Lisp_Cons ? ((struct Lisp_Cons *) $ptr)->u.s.u.cdr : 0)
end
document xcdr
Assume that $ is an Emacs Lisp pair and print its cdr.
@@ -957,9 +955,9 @@ define xlist
set $nil = $ptr
set $i = 0
while $cons != $nil && $i < 10
- p/x $cons->car
+ p/x $cons->u.s.car
xpr
- xgetptr $cons->u.cdr
+ xgetptr $cons->u.s.u.cdr
set $cons = (struct Lisp_Cons *) $ptr
set $i = $i + 1
printf "---\n"
@@ -1072,13 +1070,13 @@ Print $ as a lisp object of any type.
end
define xprintstr
- set $data = (char *) $arg0->data
- set $strsize = ($arg0->size_byte < 0) ? ($arg0->size & ~ARRAY_MARK_FLAG) : $arg0->size_byte
+ set $data = (char *) $arg0->u.s.data
+ set $strsize = ($arg0->u.s.size_byte < 0) ? ($arg0->u.s.size & ~ARRAY_MARK_FLAG) : $arg0->u.s.size_byte
# GDB doesn't like zero repetition counts
if $strsize == 0
output ""
else
- output ($arg0->size > 1000) ? 0 : ($data[0])@($strsize)
+ output ($arg0->u.s.size > 1000) ? 0 : ($data[0])@($strsize)
end
end
@@ -1255,7 +1253,7 @@ commands
xsymname globals.f_Vinitial_window_system
xgetptr $symname
set $tem = (struct Lisp_String *) $ptr
- set $tem = (char *) $tem->data
+ set $tem = (char *) $tem->u.s.data
# If we are running in synchronous mode, we want a chance to look
# around before Emacs exits. Perhaps we should put the break
# somewhere else instead...
@@ -1303,8 +1301,21 @@ if hasattr(gdb, 'printing'):
# This implementation should work regardless of C compiler, and
# it should not attempt to run any code in the inferior.
- EMACS_INT_WIDTH = int(gdb.lookup_symbol("EMACS_INT_WIDTH")[0].value())
- USE_LSB_TAG = int(gdb.lookup_symbol("USE_LSB_TAG")[0].value())
+
+ # If the macros EMACS_INT_WIDTH and USE_LSB_TAG are not in the
+ # symbol table, guess reasonable defaults.
+ sym = gdb.lookup_symbol ("EMACS_INT_WIDTH")[0]
+ if sym:
+ EMACS_INT_WIDTH = int (sym.value ())
+ else:
+ sym = gdb.lookup_symbol ("EMACS_INT")[0]
+ EMACS_INT_WIDTH = 8 * sym.type.sizeof
+ sym = gdb.lookup_symbol ("USE_LSB_TAG")[0]
+ if sym:
+ USE_LSB_TAG = int (sym.value ())
+ else:
+ USE_LSB_TAG = 1
+
GCTYPEBITS = 3
VALBITS = EMACS_INT_WIDTH - GCTYPEBITS
Lisp_Int0 = 2
diff --git a/src/COPYING b/src/COPYING
index 94a9ed024d3..f288702d2fa 100644
--- a/src/COPYING
+++ b/src/COPYING
@@ -1,7 +1,7 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found.
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>.
+ along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
@@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
+<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+<https://www.gnu.org/licenses/why-not-lgpl.html>.
diff --git a/src/ChangeLog.1 b/src/ChangeLog.1
index e51b4addc06..74a5012552c 100644
--- a/src/ChangeLog.1
+++ b/src/ChangeLog.1
@@ -3536,4 +3536,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.10 b/src/ChangeLog.10
index 65a8587bf99..f5eb88be961 100644
--- a/src/ChangeLog.10
+++ b/src/ChangeLog.10
@@ -3958,7 +3958,7 @@
2006-05-12 Chong Yidong <cyd@stupidchicken.com>
- * intervals.c (set_point_both): Fix mixup before before and after
+ * intervals.c (set_point_both): Fix mixup before and after
in variable names.
* editfns.c (Fline_beginning_position): Inhibit point-motion hooks
@@ -27927,4 +27927,4 @@ See ChangeLog.9 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.11 b/src/ChangeLog.11
index 365fc277a9a..bf730d839c7 100644
--- a/src/ChangeLog.11
+++ b/src/ChangeLog.11
@@ -26,7 +26,7 @@
current_column: Now returns EMACS_INT, fixing some iftc
that was introduced in the 2002-06-02 change "temporarily"; see
- <http://lists.gnu.org/archive/html/emacs-devel/2002-06/msg00039.html>.
+ <https://lists.gnu.org/r/emacs-devel/2002-06/msg00039.html>.
* bytecode.c (Fbyte_code): Don't cast current_column () to int.
* cmds.c (internal_self_insert): Likewise.
* indent.c (Fcurrent_column): Likewise.
@@ -91,7 +91,7 @@
* fileio.c (Fmake_symbolic_link): Treat ENOSYS specially, and
generate a special message for it. Suggested by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-02/msg00995.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-02/msg00995.html>.
(Frename_file, Fmake_symbolic_link, Ffile_symlink_p):
Simplify the code by assuming that the readlink and symlink calls
exist, even if they always fail on this host.
@@ -154,7 +154,7 @@
* dired.c (Ffile_attributes): Increase size of modes from 10 to 12
as per recent filemodestring API change. Reported by Jonas Öster in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-02/msg01069.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-02/msg01069.html>.
2011-02-23 Ben Key <bkey76@gmail.com>
@@ -7244,9 +7244,9 @@
* xdisp.c (try_scrolling): Compute the limit for searching point
in forward scroll from scroll_max, instead of an arbitrary limit
of 10 screen lines.
- See http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00766.html
+ See https://lists.gnu.org/r/emacs-devel/2010-06/msg00766.html
and
- http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00773.html
+ https://lists.gnu.org/r/emacs-devel/2010-06/msg00773.html
for details.
2010-06-16 Glenn Morris <rgm@gnu.org>
@@ -7346,7 +7346,7 @@
* window.c (Fselect_window): Move `record_buffer' up to the
beginning of this function, so the buffer gets recorded
even if the selected window does not change.
- http://lists.gnu.org/archive/html/emacs-devel/2010-06/msg00137.html
+ https://lists.gnu.org/r/emacs-devel/2010-06/msg00137.html
2010-06-07 Juanma Barranquero <lekktu@gmail.com>
@@ -7688,7 +7688,7 @@
* fileio.c (Fdelete_file): Change interactive spec to use
`read-file-name' like in `find-file-read-args' where the default
value is `default-directory' instead of `buffer-file-name'.
- http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00533.html
+ https://lists.gnu.org/r/emacs-devel/2010-05/msg00533.html
2010-05-20 Kevin Ryde <user42@zip.com.au>
@@ -7962,7 +7962,7 @@
* xdisp.c (init_iterator): Don't turn on bidi reordering in
unibyte buffers. See
- http://lists.gnu.org/archive/html/emacs-devel/2010-05/msg00263.html.
+ https://lists.gnu.org/r/emacs-devel/2010-05/msg00263.html.
2010-05-10 Glenn Morris <rgm@gnu.org>
@@ -8910,9 +8910,9 @@
* xdisp.c (display_line): Don't write beyond the last glyph row in
the desired matrix. Fixes a crash in "emacs -nw" (bug#5972), see
- http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00075.html
+ https://lists.gnu.org/r/emacs-devel/2010-04/msg00075.html
and
- http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00213.html
+ https://lists.gnu.org/r/emacs-devel/2010-04/msg00213.html
2010-04-18 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -11510,7 +11510,7 @@
* frame.c (xrdb_get_resource): Return nil for empty string resources;
some parts of Emacs code (like font selection) don't grok them.
- See http://lists.gnu.org/archive/html/emacs-devel/2009-09/msg00528.html
+ See https://lists.gnu.org/r/emacs-devel/2009-09/msg00528.html
2009-09-24 Andreas Schwab <schwab@redhat.com>
@@ -31400,4 +31400,4 @@ See ChangeLog.10 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.12 b/src/ChangeLog.12
index 367e0d61d8c..49ccd67e5b9 100644
--- a/src/ChangeLog.12
+++ b/src/ChangeLog.12
@@ -231,9 +231,9 @@
Make it a stub in this case; otherwise the build might fail,
and this code hasn't been tested on such hosts anyway.
Problem reported by Nelson H. F. Beebe in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00021.html>
+ <https://lists.gnu.org/r/emacs-devel/2013-03/msg00021.html>
and analyzed by Jérémie Courrèges-Anglas in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-03/msg00062.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-03/msg00062.html>.
2013-03-06 Dmitry Antipov <dmantipov@yandex.ru>
@@ -332,7 +332,7 @@
because the locking mechanism was never reliable in that case).
This patch fixes this and other bugs discovered by a code
inspection that was prompted by
- <http://lists.gnu.org/archive/html/emacs-devel/2013-02/msg00531.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-02/msg00531.html>.
Also, this patch switches to .#-FILE (not .#FILE) on MS-Windows,
to avoid interoperability problems between the MS-Windows and
non-MS-Windows implementations. MS-Windows and non-MS-Windows
@@ -494,9 +494,9 @@
Fix regression introduced by July 10 filelock.c patch.
* filelock.c (fill_in_lock_file_name): Fix crash caused by the
2012-07-10 patch to this file. Reported by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-02/msg00533.html>
+ <https://lists.gnu.org/r/emacs-devel/2013-02/msg00533.html>
and diagnosed by Andreas Schwab in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-02/msg00534.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-02/msg00534.html>.
2013-02-22 Paul Eggert <eggert@cs.ucla.edu>
@@ -678,7 +678,7 @@
Improve AIX port some more (Bug#13650).
With this, it should be as good as it was in 23.3, though it's
still pretty bad: the dumped emacs does not run. See Mark Fleishman in
- http://lists.gnu.org/archive/html/help-gnu-emacs/2011-04/msg00287.html
+ https://lists.gnu.org/r/help-gnu-emacs/2011-04/msg00287.html
* unexaix.c (start_of_text): Remove.
(_data, _text): Declare as char[], not int, as AIX manual suggests.
(bias, lnnoptr, text_scnptr, data_scnptr, load_scnptr)
@@ -1087,7 +1087,7 @@
2013-01-28 Dmitry Antipov <dmantipov@yandex.ru>
Remove obsolete redisplay code. See the discussion at
- http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00576.html.
+ https://lists.gnu.org/r/emacs-devel/2013-01/msg00576.html.
* dispnew.c (preemption_period, preemption_next_check): Remove.
(Vredisplay_preemption_period): Likewise.
(update_frame, update_single_window, update_window, update_frame_1):
@@ -1132,7 +1132,7 @@
Drop async_visible and async_iconified fields of struct frame.
This is possible because async input is gone; for details, see
- http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00734.html.
+ https://lists.gnu.org/r/emacs-devel/2012-12/msg00734.html.
* frame.h (struct frame): Remove async_visible and async_iconified
members, convert garbaged to unsigned bitfield. Adjust comments.
(FRAME_SAMPLE_VISIBILITY): Remove. Adjust all users.
@@ -1152,7 +1152,7 @@
2013-01-24 Dmitry Antipov <dmantipov@yandex.ru>
* insdel.c (prepare_to_modify_buffer): Revert last change as suggested
- in http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00555.html.
+ in https://lists.gnu.org/r/emacs-devel/2013-01/msg00555.html.
2013-01-23 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -1255,7 +1255,7 @@
* buffer.c (sort_overlays): Use SAFE_NALLOCA, to avoid segfault
when there are lots of overlays.
- See http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00421.html
+ See https://lists.gnu.org/r/emacs-devel/2013-01/msg00421.html
for the details and a way to reproduce.
2013-01-19 Paul Eggert <eggert@cs.ucla.edu>
@@ -1276,7 +1276,7 @@
Allow floating-point file offsets.
Problem reported by Vitalie Spinu in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00411.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-01/msg00411.html>.
* fileio.c (emacs_lseek): Remove.
(file_offset): New function.
(Finsert_file_contents, Fwrite_region): Use it.
@@ -1314,7 +1314,7 @@
2013-01-18 Dmitry Antipov <dmantipov@yandex.ru>
Fix crash when inserting data from non-regular files.
- See http://lists.gnu.org/archive/html/emacs-devel/2013-01/msg00406.html
+ See https://lists.gnu.org/r/emacs-devel/2013-01/msg00406.html
for the error description produced by valgrind.
* fileio.c (read_non_regular): Rename to read_contents.
Free Lisp_Save_Value object used to pass parameters.
@@ -1331,7 +1331,7 @@
* fileio.c (Finsert_file_contents): Use open+fstat, not stat+open.
This avoids a race if the file is renamed between stat and open.
This race is not the problem originally noted in Bug#13149;
- see <http://bugs.gnu.org/13149#73> and later messages in the thread.
+ see <https://bugs.gnu.org/13149#73> and later messages in the thread.
2013-01-17 Dmitry Antipov <dmantipov@yandex.ru>
@@ -1642,7 +1642,7 @@
* w32.c (unsetenv): Set up the string passed to _putenv
correctly.
- See http://lists.gnu.org/archive/html/emacs-devel/2012-12/msg00863.html
+ See https://lists.gnu.org/r/emacs-devel/2012-12/msg00863.html
for the bug this caused.
2012-12-30 Paul Eggert <eggert@cs.ucla.edu>
@@ -1757,7 +1757,7 @@
* window.c (window_body_cols): Subtract display margins from the
window body width on TTYs as well. See
- http://lists.gnu.org/archive/html/help-gnu-emacs/2012-12/msg00317.html
+ https://lists.gnu.org/r/help-gnu-emacs/2012-12/msg00317.html
for the original report.
2012-12-25 Dmitry Antipov <dmantipov@yandex.ru>
@@ -1954,7 +1954,7 @@
* sysdep.c (emacs_abort): Bump backtrace size to 40.
Companion to the 2012-09-30 patch. Suggested by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00796.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00796.html>.
2012-12-16 Romain Francoise <romain@orebokech.com>
@@ -2787,7 +2787,7 @@
* emacs.c (main): Set the G_SLICE environment variable for all
Cygwin builds, not just GTK builds. See
- https://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00368.html.
+ https://lists.gnu.org/r/emacs-devel/2012-11/msg00368.html.
2012-11-21 Eli Zaretskii <eliz@gnu.org>
@@ -2802,7 +2802,7 @@
dostounix_filename. Prevents crashes down the road, because
dostounix_filename assumes it gets a unibyte string.
Reported by Michel de Ruiter <michel@sentient.nl>, see
- http://lists.gnu.org/archive/html/help-emacs-windows/2012-11/msg00017.html
+ https://lists.gnu.org/r/help-emacs-windows/2012-11/msg00017.html
2012-11-20 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -2983,7 +2983,7 @@
* eval.c (mark_backtrace) [BYTE_MARK_STACK]: Remove stray '*'.
This follows up on the 2012-09-29 patch that removed indirection
for the 'function' field. Reported by Sergey Vinokurov in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00263.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-11/msg00263.html>.
2012-11-14 Eli Zaretskii <eliz@gnu.org>
@@ -3192,7 +3192,7 @@
* alloc.c (struct Lisp_Vectorlike_Free): Special type to represent
vectorlike object on the free list. This is introduced to avoid
some (but not all) pointer casting and aliasing problems, see
- http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00105.html.
+ https://lists.gnu.org/r/emacs-devel/2012-11/msg00105.html.
* .gdbinit (pvectype, pvecsize): New commands to examine vectorlike
objects.
(xvectype, xvecsize): Use them to examine Lisp_Object values.
@@ -3346,9 +3346,9 @@
Restore some duplicate definitions (Bug#12814).
This undoes part of the 2012-11-03 changes. Some people build
with plain -g rather than with -g3, and they need the duplicate
- definitions for .gdbinit to work; see <http://bugs.gnu.org/12814#26>.
+ definitions for .gdbinit to work; see <https://bugs.gnu.org/12814#26>.
* lisp.h (GCTYPEBITS, ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK):
- Define as macros, as well as as enums or as constants.
+ Define as macros, as well as enums or constants.
2012-11-06 Jan Djärv <jan.h.d@swipnet.se>
@@ -3368,7 +3368,7 @@
* window.c (Fwindow_combination_limit): Revert to the only
required argument and adjust docstring as suggested in
- http://lists.gnu.org/archive/html/emacs-diffs/2012-11/msg01082.html
+ https://lists.gnu.org/r/emacs-diffs/2012-11/msg01082.html
by Martin Rudalics <rudalics@gmx.at>.
2012-11-06 Dmitry Antipov <dmantipov@yandex.ru>
@@ -3568,7 +3568,7 @@
* window.c (decode_next_window_args): Update window arg after
calling decode_live_window and so fix crash reported at
- http://lists.gnu.org/archive/html/emacs-devel/2012-11/msg00035.html
+ https://lists.gnu.org/r/emacs-devel/2012-11/msg00035.html
by Juanma Barranquero <lekktu@gmail.com>.
(Fwindow_body_width, Fwindow_body_height): Simplify a bit.
* font.c (Ffont_at): Likewise.
@@ -3789,7 +3789,7 @@
2012-10-19 Eli Zaretskii <eliz@gnu.org>
* puresize.h (BASE_PURESIZE): Bump the base value to 1700000.
- See http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00593.html
+ See https://lists.gnu.org/r/emacs-devel/2012-10/msg00593.html
for the reasons.
* alloc.c (NSTATICS): Decrease to 0x800.
@@ -4603,7 +4603,7 @@
* xdisp.c (syms_of_xdisp): Default message-log-max to 1000, not 100.
Suggested by Juri Linkov in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00821.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00821.html>.
Prefer plain 'static' to 'static inline' (Bug#12541).
With static functions, modern compilers inline pretty well by
@@ -4884,7 +4884,7 @@
* syssignal.h (PROFILER_CPU_SUPPORT): Don't define if PROFILING.
Suggested by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00811.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00811.html>.
2012-09-30 Eli Zaretskii <eliz@gnu.org>
@@ -4929,7 +4929,7 @@
* sysdep.c (handle_fatal_signal): Bump backtrace size to 40.
Suggested by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00796.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00796.html>.
2012-09-29 Juanma Barranquero <lekktu@gmail.com>
@@ -5079,7 +5079,7 @@
* character.c (char_string, string_char): Remove calls to
MAYBE_UNIFY_CHAR. See the discussion starting at
- http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00433.html
+ https://lists.gnu.org/r/emacs-devel/2012-09/msg00433.html
for the details.
2012-09-25 Chong Yidong <cyd@gnu.org>
@@ -5140,7 +5140,7 @@
(interruptible_wait_for_termination):
Move these decls from lisp.h to syswait.h, since they use pid_t.
Needed on FreeBSD; see Herbert J. Skuhra in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00571.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00571.html>.
* callproc.c: Include syswait.h.
gnutls.c, gtkutil.c: Use bool for boolean.
@@ -5205,7 +5205,7 @@
Do not use SA_NODEFER.
Problem reported by Dani Moncayo in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00557.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00557.html>.
* alloc.c (die):
* sysdep.c (emacs_abort): Do not reset signal handler.
* emacs.c (terminate_due_to_signal): Reset signal handler here.
@@ -5385,7 +5385,7 @@
* .gdbinit: Just stop at fatal_error_backtrace.
See Stefan Monnier's request in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00549.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00549.html>.
Remove no-longer-used query of system type.
2012-09-22 Chong Yidong <cyd@gnu.org>
@@ -5517,7 +5517,7 @@
* w32inevt.c (w32_console_read_socket): Return -1 on failure, not 0.
Ignore 'expected'. See Eli Zaretskii in
- <http://bugs.gnu.org/12471#8> (last line).
+ <https://bugs.gnu.org/12471#8> (last line).
* frame.c (read_integer): Remove. All uses replaced by strtol/strtoul.
(XParseGeometry): Now static. Substitute extremal values for
@@ -5571,7 +5571,7 @@
I found that SYNC_INPUT has race conditions and would be a real
pain to fix. Since it's an undocumented and deprecated
configure-time option, now seems like a good time to remove it.
- Also see <http://bugs.gnu.org/11080#16>.
+ Also see <https://bugs.gnu.org/11080#16>.
* alloc.c (_bytes_used, __malloc_extra_blocks, _malloc_internal)
(_free_internal) [!DOUG_LEA_MALLOC]: Remove decls.
(alloc_mutex) [!SYSTEM_MALLOC && !SYNC_INPUT && HAVE_PTHREAD]:
@@ -5743,7 +5743,7 @@
Better workaround for GNOME bug when --enable-gcc-warnings.
* emacsgtkfixed.c (G_STATIC_ASSERT): Remove, undoing last change.
Instead, disable -Wunused-local-typedefs. See Dmitry Antipov in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-09/msg00335.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-09/msg00335.html>.
Simplify SIGIO usage (Bug#12408).
The code that dealt with SIGIO was crufty and confusing, e.g., it
@@ -6040,7 +6040,7 @@
More signal-handler cleanup (Bug#12327).
* emacs.c (main): Convert three 'signal' calls to 'sigaction' calls.
Problem introduced when merging patches. Noted by Eli Zaretskii in
- <http://bugs.gnu.org/12327#67>.
+ <https://bugs.gnu.org/12327#67>.
* floatfns.c: Comment fix.
* lisp.h (force_auto_save_soon): Declare regardless of SIGDANGER.
SIGDANGER might not be in scope so "#ifdef SIGDANGER" is not right,
@@ -6860,7 +6860,7 @@
It was meant to be temporary and it often doesn't work,
because when IDX has side effects the behavior of IDX==IDX
is undefined. See Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00762.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-08/msg00762.html>.
2012-08-26 Barry O'Reilly <gundaetiapo@gmail.com>
@@ -7314,7 +7314,7 @@
(set_char_table_contents): Rename from char_table_set_contents.
(set_sub_char_table_contents): Rename from sub_char_table_set_contents.
All uses changed. See the end of
- <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00549.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-08/msg00549.html>.
* lisp.h (CSET): Remove (Bug#12215).
(set_char_table_ascii, set_char_table_defalt, set_char_table_parent)
@@ -8062,7 +8062,7 @@
* lisp.h (ASET) [ENABLE_CHECKING]: Pay attention to
ARRAY_MARK_FLAG when checking subscripts, because ASET is
not supposed to be invoked from the garbage collector.
- See Andreas Schwab in <http://bugs.gnu.org/12118#25>.
+ See Andreas Schwab in <https://bugs.gnu.org/12118#25>.
(gc_aset): New function, which is like ASET but can be
used in the garbage collector.
(set_hash_key, set_hash_value, set_hash_next, set_hash_hash)
@@ -8170,7 +8170,7 @@
Use "ASET (a, i, v)" rather than "AREF (a, i) = v".
This how ASET and AREF are supposed to work, and makes
it easier to think about future improvements. See
- <http://lists.gnu.org/archive/html/emacs-devel/2012-08/msg00026.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-08/msg00026.html>.
* charset.h (set_charset_attr): New function.
All lvalue-style uses of CHARSET_DECODER etc. changed to use it.
* lisp.h (ASET): Rewrite so as not to use AREF in an lvalue style.
@@ -8573,7 +8573,7 @@
Adjust GDB to reflect pvec_type changes (Bug#12036).
* .gdbinit (xvectype, xpr, xbacktrace): Adjust to reflect the
2012-07-04 changes to pseudovector representation.
- Problem reported by Eli Zaretskii in <http://bugs.gnu.org/12036#30>.
+ Problem reported by Eli Zaretskii in <https://bugs.gnu.org/12036#30>.
2012-07-27 Michael Albinus <michael.albinus@gmx.de>
@@ -8614,7 +8614,7 @@
(xgetint): Simplify expression.
* alloc.c (gdb_make_enums_visible): New constant. This ports to
GCC 3.4.2 the export of symbols to GDB. Problem reported by Eli
- Zaretskii in <http://bugs.gnu.org/12036#13>.
+ Zaretskii in <https://bugs.gnu.org/12036#13>.
* lisp.h (PUBLISH_TO_GDB): Remove. All uses removed. No longer
needed now that we have gdb_make_enums_visible.
(enum CHECK_LISP_OBJECT_TYPE, enum Lisp_Bits, enum More_Lisp_Bits)
@@ -8664,7 +8664,7 @@
(ARRAY_MARK_FLAG, PSEUDOVECTOR_FLAG, VALMASK): Move these here from
emacs.c, as this is a more-suitable home. Had this been done earlier
the fix for 12036 would have avoided some of the problems noted in
- <http://bugs.gnu.org/12036#13> by Eli Zaretskii, as the scope problems
+ <https://bugs.gnu.org/12036#13> by Eli Zaretskii, as the scope problems
would have been more obvious.
* emacs.c: Do not include <verify.h>; no longer needed.
(gdb_CHECK_LISP_OBJECT_TYPE, gdb_DATA_SEG_BITS)
@@ -8794,7 +8794,7 @@
Swap buffer text indirection counters in Fbuffer_swap_text.
* buffer.c (Fbuffer_swap_text): Swap indirections too.
This avoids crash reported by Christoph Scholtes at
- http://lists.gnu.org/archive/html/bug-gnu-emacs/2012-07/msg00785.html.
+ https://lists.gnu.org/r/bug-gnu-emacs/2012-07/msg00785.html.
2012-07-22 Jan Djärv <jan.h.d@swipnet.se>
@@ -8830,7 +8830,7 @@
* keyboard.c (keys_of_keyboard): Bind language-change to 'ignore'
in special-event-map. See the discussion at
- http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00417.html
+ https://lists.gnu.org/r/emacs-devel/2012-06/msg00417.html
for the reasons.
* w32menu.c (add_menu_item): Cast to ULONG_PTR when assigning
@@ -8924,7 +8924,7 @@
Tweak the value returned from Fgarbage_collect again.
* alloc.c (Fgarbage_collect): New return value, as confirmed in
- http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00418.html.
+ https://lists.gnu.org/r/emacs-devel/2012-07/msg00418.html.
Adjust documentation.
(total_vector_bytes): Rename to total_vector_slots, adjust
accounting.
@@ -8962,7 +8962,7 @@
* intervals.c (merge_interval_right, merge_interval_left):
Do not zero out this interval if it is absorbed by its children,
as this interval's total length doesn't change in that case. See
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00403.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00403.html>.
2012-07-18 Paul Eggert <eggert@cs.ucla.edu>
@@ -9009,7 +9009,7 @@
Return more descriptive data from Fgarbage_collect.
Suggested by Stefan Monnier in
- http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00369.html.
+ https://lists.gnu.org/r/emacs-devel/2012-07/msg00369.html.
* alloc.c (bounded_number): New function.
(total_buffers, total_vectors): New variable.
(total_string_size): Rename to total_string_bytes, adjust users.
@@ -9034,7 +9034,7 @@
Restore old code in allocate_string_data to avoid Faset breakage.
Reported by Julien Danjou <julien@danjou.info> in
- http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00371.html.
+ https://lists.gnu.org/r/emacs-devel/2012-07/msg00371.html.
* alloc.c (allocate_string_data): Restore old code with minor
adjustments, fix comment to explain this subtle issue.
@@ -9392,7 +9392,7 @@
Fix typos that broke OS X build.
Reported by Randal L. Schwartz in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00225.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00225.html>.
* nsterm.m (ns_timeout): Add missing local decl.
(ns_get_color): snprintf -> sprintf, to fix typo.
@@ -9768,7 +9768,7 @@
2012-07-08 Paul Eggert <eggert@cs.ucla.edu>
* systime.h (EMACS_SUB_TIME): Clarify behavior with unsigned time_t.
- See <http://bugs.gnu.org/11825#29>.
+ See <https://bugs.gnu.org/11825#29>.
2012-07-08 Eli Zaretskii <eliz@gnu.org>
@@ -10115,18 +10115,18 @@
* fileio.c (time_error_value): Check the right error number.
Problem reported by Troels Nielsen in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00095.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00095.html>.
2012-07-04 Paul Eggert <eggert@cs.ucla.edu>
* window.c (set_window_hscroll): Revert the 100000 hscroll limit.
This should be fixed in a better way; see Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00088.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00088.html>.
(HSCROLL_MAX): Remove; this is now internal to set_window_hscroll.
* fileio.c (time_error_value): Rename from special_mtime.
The old name's problems were noted by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-07/msg00087.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-07/msg00087.html>.
* emacs.c (gdb_pvec_type): Change it back to enum pvec_type.
This variable's comment says Emacs needs at least one GDB-visible
@@ -10710,7 +10710,7 @@
Use it to avoid bogus compiler warnings with obsolescent GCC versions.
This improves on the previous patch, which introduced a bug
when time_t is unsigned and as wide as intmax_t.
- See <http://bugs.gnu.org/9000#51>.
+ See <https://bugs.gnu.org/9000#51>.
2012-06-23 Eli Zaretskii <eliz@gnu.org>
@@ -10995,7 +10995,7 @@
* bytecode.c (METER_CODE) [BYTE_CODE_METER]: Don't assume
!CHECK_LISP_OBJECT_TYPE && !USE_LSB_TAG. Problem with
CHECK_LISP_OBJECT_TYPE reported by Dmitry Antipov in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-06/msg00282.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-06/msg00282.html>.
(METER_1, METER_2): Simplify.
2012-06-18 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -11595,7 +11595,7 @@
* bidi.c (bidi_mirror_char): Don't possibly truncate the integer
before checking whether it's out of range. Put the check inside
eassert. See
- <http://lists.gnu.org/archive/html/emacs-devel/2012-05/msg00485.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-05/msg00485.html>.
2012-05-27 Ken Brown <kbrown@cornell.edu>
@@ -12700,7 +12700,7 @@
Untag more efficiently if USE_LSB_TAG.
This is based on a proposal by YAMAMOTO Mitsuharu in
- <http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg01876.html>.
+ <https://lists.gnu.org/r/emacs-devel/2008-01/msg01876.html>.
For an admittedly artificial (nth 8000 longlist) benchmark on
Fedora 15 x86-64, this yields a 25% CPU speedup. Also, it shrinks
Emacs's overall text size by 1%.
@@ -12726,7 +12726,7 @@
stack for each reader_thread, instead of defaulting to 8MB
determined by the linker. This avoids failures in creating
subprocesses on Windows 7, see the discussion in this thread:
- http://lists.gnu.org/archive/html/emacs-devel/2012-03/msg00119.html.
+ https://lists.gnu.org/r/emacs-devel/2012-03/msg00119.html.
2012-05-07 Jérémy Compostella <jeremy.compostella@gmail.com>
@@ -13118,13 +13118,13 @@
Remove one incorrect comment and fix another.
Fix minor ralloc.c problems found by static checking.
- See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ See https://lists.gnu.org/r/emacs-devel/2011-12/msg00720.html
* ralloc.c (ALIGNED, ROUND_TO_PAGE, HEAP_PTR_SIZE)
(r_alloc_size_in_use, r_alloc_freeze, r_alloc_thaw): Remove; unused.
(r_alloc_sbrk): Now static.
Improve ralloc.c interface checking.
- See http://lists.gnu.org/archive/html/emacs-devel/2011-12/msg00720.html
+ See https://lists.gnu.org/r/emacs-devel/2011-12/msg00720.html
* buffer.c (ralloc_reset_variable, r_alloc, r_re_alloc)
(r_alloc_free) [REL_ALLOC]: Move decls from here ...
* lisp.h (r_alloc, r_alloc_free, r_re_alloc, r_alloc_reset_variable)
@@ -13335,7 +13335,7 @@
about subtle differences between FETCH_CHAR* and STRING_CHAR*
macros related to unification of CJK characters. For the details,
see the discussion following the message here:
- http://debbugs.gnu.org/cgi/bugreport.cgi?bug=11073#14.
+ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=11073#14.
2012-04-04 Chong Yidong <cyd@gnu.org>
@@ -13539,7 +13539,7 @@
Generalize fix for crash due to non-contiguous EMACS_INT (Bug#10780).
Suggested by Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00692.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-02/msg00692.html>.
* alloc.c (widen_to_Lisp_Object): New static function.
(mark_memory): Also mark Lisp_Objects by fetching pointer words
and widening them to Lisp_Objects. This would work even if
@@ -13593,7 +13593,7 @@
It's useless in that case, and it can cause problems on hosts
that allocate halves of EMACS_INT values separately.
Reported by Dan Horák. Diagnosed by Andreas Schwab in
- <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=10780#30>.
+ <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=10780#30>.
* mem-limits.h (EXCEEDS_LISP_PTR): Define to 0 on hosts where
UINTPTR_MAX >> VALBITS == 0. This is required by the above change;
it avoids undefined behavior on hosts where shifting right by more
@@ -13619,7 +13619,7 @@
2012-02-15 Paul Eggert <eggert@cs.ucla.edu>
* image.c (MAX_IMAGE_SIZE): Increase from 6.0 to 10.0; see
- <http://lists.gnu.org/archive/html/emacs-devel/2012-02/msg00540.html>.
+ <https://lists.gnu.org/r/emacs-devel/2012-02/msg00540.html>.
2012-02-15 Chong Yidong <cyd@gnu.org>
@@ -14242,7 +14242,7 @@
Remove GCPRO-related macros that exist only to avoid shadowing locals.
* lisp.h (GCPRO1_VAR, GCPRO2_VAR, GCPRO3_VAR, GCPRO4_VAR, GCPRO5_VAR)
(GCPRO6_VAR, UNGCPRO_VAR): Remove. See
- <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ <https://lists.gnu.org/r/emacs-diffs/2011-11/msg00265.html>.
All uses changed to use GCPRO1 etc.
(GCPRO1, GCPRO2, GCPRO3, GCPRO4, GCPRO5, GCPRO6, UNGCPRO):
Revert to old implementation (i.e., before 2011-03-11).
@@ -14278,7 +14278,7 @@
2011-11-26 Paul Eggert <eggert@cs.ucla.edu>
* fileio.c (Finsert_file_contents): Undo previous change; see
- <http://lists.gnu.org/archive/html/emacs-diffs/2011-11/msg00265.html>.
+ <https://lists.gnu.org/r/emacs-diffs/2011-11/msg00265.html>.
2011-11-26 Paul Eggert <eggert@cs.ucla.edu>
@@ -14379,7 +14379,7 @@
Standardize on VIRT_ADDR_VARIES behavior (Bug#10042).
Otherwise, valgrind does not work on some platforms.
Problem reported by Andreas Schwab in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-11/msg00081.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-11/msg00081.html>.
* puresize.h (pure, PURE_P): Always behave as if VIRT_ADDR_VARIES
is set, removing the need for VIRT_ADDRESS_VARIES.
(PURE_P): Use a more-efficient implementation that needs just one
@@ -14545,7 +14545,7 @@
Avoid some portability problems by eschewing 'extern inline' functions.
The trivial performance wins aren't worth the portability hassles; see
- <http://lists.gnu.org/archive/html/emacs-devel/2011-11/msg00084.html>
+ <https://lists.gnu.org/r/emacs-devel/2011-11/msg00084.html>
et seq.
* dispextern.h (window_box, window_box_height, window_text_bottom_y)
(window_box_width, window_box_left, window_box_left_offset)
@@ -14625,7 +14625,7 @@
(window_box_right, window_box_right_offset): Declare extern.
Otherwise, these inline functions do not conform to C99 and
are miscompiled by Microsoft compilers. Reported by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-11/msg00084.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-11/msg00084.html>.
* intervals.c (adjust_intervals_for_insertion)
(adjust_intervals_for_deletion): Now extern, because otherwise the
extern inline functions 'offset_intervals' couldn't refer to it.
@@ -14959,7 +14959,7 @@
This doesn't change this function's behavior.
(current-time-zone): Rewrite to use format_time_string.
This fixes the bug reported by Michael Schierl in
- <http://lists.gnu.org/archive/html/emacs-devel/2007-06/msg00334.html>.
+ <https://lists.gnu.org/r/emacs-devel/2007-06/msg00334.html>.
Jason Rumney's 2007-06-07 change worked around this bug, but
didn't fix it.
* systime.h (tzname, timezone): Remove no-longer-used declarations.
@@ -15144,7 +15144,7 @@
* charset.c (charset_table_init): New static var.
(syms_of_charset): Use it instead of xmalloc. This removes a
dependency on glibc malloc internals. See Eli Zaretskii's comment in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-09/msg00815.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-09/msg00815.html>.
* lisp.h (XMALLOC_OVERRUN_CHECK_OVERHEAD, XMALLOC_OVERRUN_CHECK_SIZE):
Move back to alloc.c.
(XMALLOC_BASE_ALIGNMENT, COMMON_MULTIPLE, XMALLOC_HEADER_ALIGNMENT)
@@ -15433,7 +15433,7 @@
signed integers, not unsigned. This is to be consistent with
outgoing selection data, which was modified to use signed integers
in as part of the fix to Bug#9196 in response to Jan D.'s comment
- in <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9196#32> that X11
+ in <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=9196#32> that X11
expects long, not unsigned long.
2011-09-14 Eli Zaretskii <eliz@gnu.org>
@@ -15763,7 +15763,7 @@
(ccl_driver): Do not generate an out-of-range pointer.
(Fccl_execute_on_string): Remove unnecessary check for
integer overflow, noted by Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-08/msg00979.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-08/msg00979.html>.
Remove a FIXME that didn't need fixing.
Simplify the newly-introduced buffer reallocation code.
@@ -16712,11 +16712,11 @@
(bidi_dump_cached_states): Use ptrdiff_t, not int, to avoid overflow.
(bidi_cache_ensure_space): Also check that the bidi cache size
does not exceed that of the largest Lisp string or buffer. See Eli
- Zaretskii in <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9079#29>.
+ Zaretskii in <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=9079#29>.
* alloc.c (__malloc_size_t): Remove.
All uses replaced by size_t. See Andreas Schwab's note
- <http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9079#8>.
+ <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=9079#8>.
* image.c: Improve checking for integer overflow.
(check_image_size): Assume that f is nonnull, since
@@ -16749,7 +16749,7 @@
* dispnew.c (init_display): Use *_RANGE_OVERFLOW macros.
The plain *_OVERFLOW macros run afoul of GCC bug 49705
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49705>
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=49705>
and therefore cause GCC to emit a bogus diagnostic in some cases.
* image.c: Integer signedness and overflow and related fixes.
@@ -16990,7 +16990,7 @@
2011-07-19 Paul Eggert <eggert@cs.ucla.edu>
Port to OpenBSD.
- See http://lists.gnu.org/archive/html/emacs-devel/2011-07/msg00688.html
+ See https://lists.gnu.org/r/emacs-devel/2011-07/msg00688.html
and the surrounding thread.
* minibuf.c (read_minibuf_noninteractive): Rewrite to use getchar
rather than fgets, and retry after EINTR. Otherwise, 'emacs
@@ -19316,7 +19316,7 @@
2011-05-31 Paul Eggert <eggert@cs.ucla.edu>
Use 'inline', not 'INLINE'.
- <http://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00914.html>
+ <https://lists.gnu.org/r/emacs-devel/2011-05/msg00914.html>
* alloc.c, fontset.c (INLINE): Remove.
* alloc.c, bidi.c, charset.c, coding.c, dispnew.c, fns.c, image.c:
* intervals.c, keyboard.c, process.c, syntax.c, textprop.c, w32term.c:
@@ -19396,7 +19396,7 @@
without this change, (md5 "truc") would evaluate to
45723a2aff78ff4fff7fff1114760e62 rather than the expected
45723a2af3788c4ff17f8d1114760e62. Reported by Antoine Levitt in
- https://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00883.html.
+ https://lists.gnu.org/r/emacs-devel/2011-05/msg00883.html.
2011-05-27 Paul Eggert <eggert@cs.ucla.edu>
@@ -19620,7 +19620,7 @@
* systime.h (Time): Define only if emacs is defined.
This is to allow ../lib-src/profile.c to be compiled on FreeBSD,
where the include path doesn't have X11/X.h by default. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-05/msg00561.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-05/msg00561.html>.
2011-05-20 Kenichi Handa <handa@m17n.org>
@@ -19885,7 +19885,7 @@
* dbusbind.c: Do not use XPNTR on a value that may be an integer.
Reported by Stefan Monnier in
- <http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00919.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-04/msg00919.html>.
(xd_remove_watch, Fdbus_init_bus, xd_read_queued_messages):
Use SYMBOLP-guarded XSYMBOL, not XPNTR.
@@ -20276,7 +20276,7 @@
* intervals.h (struct interval): Use EMACS_INT for members
where EMACS_UINT might cause problems. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00514.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-04/msg00514.html>.
(CHECK_TOTAL_LENGTH): Remove cast to EMACS_INT; no longer needed.
* intervals.c (interval_deletion_adjustment): Now returns EMACS_INT.
All uses changed.
@@ -20741,7 +20741,7 @@
* sysdep.c (emacs_read): Remove unnecessary check vs MAX_RW_COUNT.
emacs_write: Accept and return EMACS_INT for sizes.
- See http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00514.html
+ See https://lists.gnu.org/r/emacs-devel/2011-04/msg00514.html
et seq.
* gnutls.c, gnutls.h (emacs_gnutls_read, emacs_gnutls_write):
Accept and return EMACS_INT.
@@ -20755,7 +20755,7 @@
* process.c (send_process): Adjust to the new signatures of
emacs_write and emacs_gnutls_write. Do not attempt to store
a byte offset into an 'int'; it might overflow.
- See http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00483.html
+ See https://lists.gnu.org/r/emacs-devel/2011-04/msg00483.html
* sound.c: Don't assume sizes fit in 'int'.
(struct sound_device.period_size, alsa_period_size):
@@ -21225,7 +21225,7 @@
* sysdep.c (emacs_read, emacs_write): Check for negative sizes
since callers should never pass a negative size.
Change the signature to match that of plain 'read' and 'write'; see
- <http://lists.gnu.org/archive/html/emacs-devel/2011-04/msg00397.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-04/msg00397.html>.
* lisp.h: Update prototypes of emacs_write and emacs_read.
2011-04-11 Eli Zaretskii <eliz@gnu.org>
@@ -22049,7 +22049,7 @@
This also avoids a (bogus) GCC warning with gcc -Wstrict-overflow.
* scroll.c (do_scrolling): Work around GCC bug 48228.
- See <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48228>.
+ See <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=48228>.
* frame.c (Fmodify_frame_parameters): Simplify loop counter.
This also avoids a warning with gcc -Wstrict-overflow.
@@ -22615,7 +22615,7 @@
1152921504606846976) returns the obviously-bogus value (-948597
62170) on my RHEL 5.5 x86-64 host. With the patch, it correctly
reports time overflow. See
- <http://lists.gnu.org/archive/html/emacs-devel/2011-03/msg00470.html>.
+ <https://lists.gnu.org/r/emacs-devel/2011-03/msg00470.html>.
* deps.mk (editfns.o): Depend on ../lib/intprops.h.
* editfns.c: Include limits.h and intprops.h.
(TIME_T_MIN, TIME_T_MAX): New macros.
@@ -22951,4 +22951,4 @@ See ChangeLog.11 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index 66f062d3d3f..cada2097245 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -48,7 +48,7 @@
Avoid some core dumps in X session management
Derived from a bug report by Nicolas Richard in:
- http://bugs.gnu.org/20191#20
+ https://bugs.gnu.org/20191#20
* xsmfns.c (smc_save_yourself_CB): Don't dump core if
invocation-name is not a string. Initialize user-login-name if it
is not already initialized, and don't dump core if it is not a
@@ -60,14 +60,14 @@
Port user-login-name initialization to Qnil == 0
Derived from a bug report by Nicolas Richard in:
- http://bugs.gnu.org/20191#20
+ https://bugs.gnu.org/20191#20
* editfns.c (Fuser_login_name, Fuser_real_login_name)
(syms_of_editfns): Don't rely on all-bits-zero being an Elisp integer,
as this is no longer true now that Qnil == 0.
Assume !BROKEN_NON_BLOCKING_CONNECT
From a suggestion by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00824.html
+ https://lists.gnu.org/r/emacs-devel/2015-03/msg00824.html
* process.c (NON_BLOCKING_CONNECT): Simplify by assuming that
BROKEN_NON_BLOCKING_CONNECT is not defined.
(SELECT_CAN_DO_WRITE_MASK): Remove, and assume it's now true.
@@ -77,12 +77,12 @@
* lread.c (substitute_object_recurse): For sub-char-tables, start
the recursive SUBSTITUTE loop from index of 2, to skip the
non-Lisp members of the sub-char-table. See the discussion at
- http://lists.gnu.org/archive/html/emacs-devel/2015-03/msg00520.html
+ https://lists.gnu.org/r/emacs-devel/2015-03/msg00520.html
for the details.
Support non-blocking connect on MS-Windows.
Based on ideas from Kim F. Storm <storm@cua.dk>, see
- http://lists.gnu.org/archive/html/emacs-devel/2006-12/msg00873.html.
+ https://lists.gnu.org/r/emacs-devel/2006-12/msg00873.html.
* w32proc.c (reader_thread): If the FILE_CONNECT flag is set, call
'_sys_wait_connect'. If it returns STATUS_CONNECT_FAILED, exit
@@ -1107,7 +1107,7 @@
Isolate NIL_IS_ZERO-assuming code better
Suggested by Stefan Monnier in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00588.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00588.html
* alloc.c (allocate_pseudovector):
Use memclear, not memsetnil, to remove a 'verify'.
* callint.c (Fcall_interactively):
@@ -1121,7 +1121,7 @@
Undo port to hypothetical nonzero Qnil case
This mostly undoes the previous change in this area. See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00570.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00570.html
* alloc.c (allocate_pseudovector):
* callint.c (Fcall_interactively):
* dispnew.c (realloc_glyph_pool):
@@ -1326,7 +1326,7 @@
Don't say Fnext_read_file_uses_dialog_p is const
It's const only if a windowing system is not used; don't say it's
const otherwise. See:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00310.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00310.html
* fileio.c (next_read_file_uses_dialog_p): Remove.
Move guts back to ...
(Fnext_read_file_uses_dialog_p): ... here.
@@ -1415,13 +1415,13 @@
* fileio.c (next_read_file_uses_dialog_p): New workaround ...
(Fnext_read_file_uses_dialog_p): ... called from here to avoid
ATTRIBUTE_CONST dependency from #ifdefs. For details, see
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00289.html.
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00289.html.
2015-01-12 Paul Eggert <eggert@cs.ucla.edu>
Port to 32-bit MingGW --with-wide-int
Problem reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00265.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00265.html
* lisp.h (struct Lisp_Sub_Char_Table): Check that offset matches
what we think it is, rather than checking only its alignment (and
doing so incorrectly on MinGW).
@@ -1623,12 +1623,12 @@
Port Qnil==0 XUNTAG to clang
clang has undefined behavior if the program subtracts an integer
from (char *) 0. Problem reported by YAMAMOTO Mitsuharu in:
- http://lists.gnu.org/archive/html/emacs-devel/2015-01/msg00132.html
+ https://lists.gnu.org/r/emacs-devel/2015-01/msg00132.html
* lisp.h (lisp_h_XUNTAG) [USE_LSB_TAG]:
(XUNTAG) [!USE_LSB_TAG]: Port to clang 3.5.0.
Port GFileMonitor * hack to Qnil==0 platforms
- Reported by Glenn Morris in: http://bugs.gnu.org/15880#112
+ Reported by Glenn Morris in: https://bugs.gnu.org/15880#112
* gfilenotify.c (monitor_to_lisp, lisp_to_monitor): New functions.
(dir_monitor_callback, Fgfile_add_watch, Fgfile_rm_watch): Use them.
@@ -1842,7 +1842,7 @@
Instead of using gnutls_global_set_mem_functions, check every call
to a GnuTLS function that might return an indication of memory
exhaustion. Suggested by Dmitry Antipov in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-12/msg02056.html
+ https://lists.gnu.org/r/emacs-devel/2014-12/msg02056.html
* gnutls.c (gnutls_global_set_mem_functions) [WINDOWSNT]: Remove.
(init_gnutls_functions): Do not load gnutls_global_set_mem_functions.
(fn_gnutls_global_set_mem_functions) [!WINDOWSNT]: Remove.
@@ -2369,7 +2369,7 @@
Improve clarity of USE_LSB_TAG definition.
Reported by Lee Duhem. Suggested by Andreas Schwab in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-11/msg02222.html
+ https://lists.gnu.org/r/emacs-devel/2014-11/msg02222.html
* lisp.h (USE_LSB_TAG): Define in terms of the (simpler)
VAL_MAX / 2 rather than in terms of the (more complicated)
EMACS_INT_MAX >> GCTYPEBITS, and adjust commentary to match.
@@ -3043,7 +3043,7 @@
* xterm.c (x_draw_hollow_cursor): Fix display of hollow cursor on
1-pixel R2L characters.
Reported by Dmitry Antipov <dmantipov@yandex.ru>, see
- http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00518.html.
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00518.html.
2014-10-16 Eli Zaretskii <eliz@gnu.org>
@@ -3284,7 +3284,7 @@
<https://gcc.gnu.org/bugzilla/show_bug.cgi?id=63495>,
and more generally should fix a portability problem in Emacs.
Reported by Stefan Monnier in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-10/msg00261.html
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00261.html
2014-10-08 Leo Liu <sdl.web@gmail.com>
@@ -3334,7 +3334,7 @@
* keyboard.c (Qleft, Qright): Remove duplicate definitions (Bug#9927).
These were already defined in buffer.c, and the duplicate
definitions cause problems on platforms like 'gcc -fno-common'.
- Reported by Peter Dyballa in: http://bugs.gnu.org/9927#137
+ Reported by Peter Dyballa in: https://bugs.gnu.org/9927#137
2014-10-05 Jan Djärv <jan.h.d@swipnet.se>
@@ -3475,7 +3475,7 @@
(my_create_window): Move the calculation of the coordinates of the
frame's top-left edge here. Pass them to the input thread via the
second parameter of the WM_EMACS_CREATEWINDOW message.
- See http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00892.html
+ See https://lists.gnu.org/r/emacs-devel/2014-09/msg00892.html
for the details.
2014-09-30 Eli Zaretskii <eliz@gnu.org>
@@ -3508,7 +3508,7 @@
* alloc.c: Remove now-unnecessary check.
Suggested by Dmitry Antipov in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00891.html
+ https://lists.gnu.org/r/emacs-devel/2014-09/msg00891.html
* xterm.c (x_term_init): Allocate temps on stack, not on heap.
@@ -3650,7 +3650,7 @@
Fix local_cons etc. to not exhaust the stack when in a loop.
Problem reported in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00696.html
+ https://lists.gnu.org/r/emacs-devel/2014-09/msg00696.html
* buffer.c (Fother_buffer, other_buffer_safely, init_buffer):
* charset.c (load_charset_map_from_file, Ffind_charset_region)
(Ffind_charset_string):
@@ -3800,7 +3800,7 @@
Fix SAFE_ALLOCA to not exhaust the stack when in a loop.
Reported by Dmitry Antipov in thread leading to:
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00713.html
+ https://lists.gnu.org/r/emacs-devel/2014-09/msg00713.html
This patch fixes only SAFE_ALLOCA, SAFE_NALLOCA, and SAFE_ALLOCA_LISP;
the experimental local_* macros enabled by USE_LOCAL_ALLOCATORS
remain unfixed.
@@ -4133,7 +4133,7 @@
Simplify lisp.h by removing the __COUNTER__ business.
Reported by Dmitry Antipov in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00220.html
+ https://lists.gnu.org/r/emacs-devel/2014-09/msg00220.html
* lisp.h (make_local_vector, make_local_string)
(build_local_string): Simplify by not bothering with __COUNTER__.
The __COUNTER__ business wasn't working properly, and was needed
@@ -4164,7 +4164,7 @@
These can generate a constant with the correct value but the wrong
width, which doesn't work as a printf argument. All uses removed.
Reported by Dmitry Antipov in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00213.html
+ https://lists.gnu.org/r/emacs-devel/2014-09/msg00213.html
(ENUMABLE): Remove; no longer needed.
(ARRAY_MARK_FLAG_val, PSEUDOVECTOR_FLAG_val, VALMASK_val):
Remove; no longer needed because of the above change.
@@ -4275,7 +4275,7 @@
Use SAFE_ALLOCA etc. to avoid unbounded stack allocation (Bug#18410).
This follows up on the recent thread in emacs-devel on alloca; see:
- http://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00042.html
+ https://lists.gnu.org/r/emacs-devel/2014-09/msg00042.html
This patch also cleans up alloca-related glitches noted while
examining the code looking for unbounded alloca.
* alloc.c (listn):
@@ -4492,7 +4492,7 @@
it's an unsigned data type). This can happen in R2L hscrolled
glyph rows, and caused us to draw the cursor glyph on the fringe.
For the details, see
- http://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00543.html.
+ https://lists.gnu.org/r/emacs-devel/2014-08/msg00543.html.
2014-08-31 Ken Brown <kbrown@cornell.edu>
@@ -4654,7 +4654,7 @@
immediately following the newline on the previous line.
Avoids setting the ends_at_zv_p flag on screen lines that are not at or
beyond ZV, which causes infloop in redisplay. For the details, see
- http://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00368.html.
+ https://lists.gnu.org/r/emacs-devel/2014-08/msg00368.html.
* dispnew.c (buffer_posn_from_coords): Fix mirroring of X
coordinate for hscrolled R2L screen lines. (Bug#18277)
@@ -4697,7 +4697,7 @@
(init_sigsegv): Adjust accordingly.
* keyboard.c (Vtop_level_message): Rename to
Vinternal__top_level_message, as suggested by Stefan Monnier in
- http://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00493.html
+ https://lists.gnu.org/r/emacs-devel/2014-08/msg00493.html
All related users changed.
2014-08-26 Dmitry Antipov <dmantipov@yandex.ru>
@@ -4854,7 +4854,7 @@
(Fset_window_new_total, Fset_window_new_normal)
(Fwindow_resize_apply): Fix doc-strings (see Bug#18112).
See also:
- http://lists.gnu.org/archive/html/bug-gnu-emacs/2014-08/msg00287.html
+ https://lists.gnu.org/r/bug-gnu-emacs/2014-08/msg00287.html
2014-08-11 Eli Zaretskii <eliz@gnu.org>
@@ -4943,7 +4943,7 @@
* keyboard.c (safe_run_hooks): Follow the convenient style to bind
inhibit-quit to t and pass 2 args to safe_run_hook_funcall. See
- <http://lists.gnu.org/archive/html/emacs-devel/2014-08/msg00077.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-08/msg00077.html>.
(safe_run_hook_funcall): Adjust accordingly.
2014-08-04 Martin Rudalics <rudalics@gmx.at>
@@ -5027,7 +5027,7 @@
2014-08-01 Eli Zaretskii <eliz@gnu.org>
Fix display of R2L lines when the last character fits only partially.
- See http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00476.html
+ See https://lists.gnu.org/r/emacs-devel/2014-07/msg00476.html
for the details.
* xdisp.c (extend_face_to_end_of_line): If the last glyph of an
R2L row is visible only partially, give the row a negative x
@@ -5090,7 +5090,7 @@
* xrdb.c (x_load_resources) [USE_MOTIF]: Although not strictly
necessary, put horizontal scroll bar resources as well. See
- <http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00430.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-07/msg00430.html>.
* xterm.c (x_sync_with_move): Really wait 0.5s, not 0.0005s.
2014-07-29 Dmitry Antipov <dmantipov@yandex.ru>
@@ -5148,7 +5148,7 @@
(adjust_frame_size): Always declare prototype.
Fix Gnus-related issues reported by David Kastrup <dak@gnu.org> in
- <http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00370.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-07/msg00370.html>.
* atimer.c (timerfd_callback): Always read expiration data.
Add comment.
(turn_on_atimers) [HAVE_TIMERFD]: Disarm timerfd timer.
@@ -5597,7 +5597,7 @@
2014-07-24 Dmitry Antipov <dmantipov@yandex.ru>
Fix error reported by Angelo Graziosi <angelo.graziosi@alice.it> in
- <http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00274.html>
+ <https://lists.gnu.org/r/emacs-devel/2014-07/msg00274.html>
and complete previous change.
* frame.c (adjust_frame_height): New function.
(Fset_frame_height, Fset_frame_size): Use it.
@@ -5607,7 +5607,7 @@
* frame.c (Fset_frame_height): Take frame top margin into account.
Incorrect behavior was reported by Martin Rudalics <rudalics@gmx.at> in
- <http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00258.html>
+ <https://lists.gnu.org/r/emacs-devel/2014-07/msg00258.html>
2014-07-22 Dmitry Antipov <dmantipov@yandex.ru>
@@ -6223,7 +6223,7 @@
* fns.c (validate_subarray): Add prototype.
(Fcompare_substring): Use validate_subarray to check ranges.
Adjust comment to mention that the semantics was changed. Also see
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00447.html.
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00447.html.
2014-06-24 Paul Eggert <eggert@cs.ucla.edu>
@@ -6320,7 +6320,7 @@
Omit redundant extern decls.
Most of this patch is from Dmitry Antipov, in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00263.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00263.html
* commands.h (update_mode_lines):
* frame.h (Qbackground_color, Qforeground_color)
(x_set_menu_bar_lines):
@@ -6372,7 +6372,7 @@
* Makefile.in (ns-app): Fix typo that broke build on OS X.
Reported by David Caldwell in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00251.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00251.html
2014-06-16 Dmitry Antipov <dmantipov@yandex.ru>
@@ -6654,7 +6654,7 @@
* emacs.c: Include "sysselect.h", to define its inline functions.
Reported by Glenn Morris in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00077.html
+ https://lists.gnu.org/r/emacs-devel/2014-06/msg00077.html
Do not require libXt-devel when building with gtk.
* gtkutil.h, menu.h: Include lwlib-widget.h, not lwlib-h, to avoid
@@ -7080,7 +7080,7 @@
(Fgarbage_collect): Calculate the end address of the stack portion
that needs to be examined by mark_stack, and pass that address to
garbage_collect_1, which will pass it to mark_stack.
- See http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00270.html
+ See https://lists.gnu.org/r/emacs-devel/2014-05/msg00270.html
for more details about the underlying problems. In particular,
this avoids dumping Emacs with the large hash-table whose value is
held in purify-flag for most of the time loadup.el runs.
@@ -7298,7 +7298,7 @@
* term.c (tty_menu_display): Move the cursor to the active menu item.
(tty_menu_activate): Return the cursor to the active menu item
after displaying the menu and after displaying help-echo.
- See http://lists.gnu.org/archive/html/emacs-devel/2014-04/msg00402.html
+ See https://lists.gnu.org/r/emacs-devel/2014-04/msg00402.html
for the details of why this is needed by screen readers and
Braille displays.
@@ -8628,7 +8628,7 @@
* terminal.c (initial_free_frame_resources): New function.
(init_initial_terminal): Install new hook to free face cache
on initial frame and avoid memory leak. For details, see
- <http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01974.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-01/msg01974.html>.
* xfaces.c (free_frame_faces): Adjust comment.
2014-01-26 Paul Eggert <eggert@cs.ucla.edu>
@@ -8689,7 +8689,7 @@
* xdisp.c (reseat_1, Fcurrent_bidi_paragraph_direction):
Avoid undefined behavior by initializing display property bit of a
string processed by the bidirectional iterator. For details, see
- <http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01920.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-01/msg01920.html>.
2014-01-23 Paul Eggert <eggert@cs.ucla.edu>
@@ -8732,7 +8732,7 @@
Avoid undefined behavior by initializing buffer redisplay bit.
Reported by Dmitry Antipov in
- <http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01756.html>.
+ <https://lists.gnu.org/r/emacs-devel/2014-01/msg01756.html>.
* buffer.c (Fget_buffer_create): Initialize redisplay bit.
Revert some of the CANNOT_DUMP fix (Bug#16494).
@@ -8780,7 +8780,7 @@
Fix MinGW64 porting problem with _setjmp.
Reported by Eli Zaretskii in:
- http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01297.html
+ https://lists.gnu.org/r/emacs-devel/2014-01/msg01297.html
* image.c (FAST_SETJMP, FAST_LONGJMP): New macros, replacing
the old _setjmp and _longjmp. All uses changed.
@@ -9756,7 +9756,7 @@
* xterm.c (x_make_frame_visible): Restore hack which is needed when
input polling is used. This is still meaningful for Cygwin, see
- http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00351.html.
+ https://lists.gnu.org/r/emacs-devel/2013-12/msg00351.html.
* keyboard.c (poll_for_input_1, input_polling_used):
Define unconditionally.
* dispextern.h (FACE_SUITABLE_FOR_CHAR_P): Remove unused macro.
@@ -10573,7 +10573,7 @@
Fix some dependency problems that cause unnecessary recompiles.
Reported by RMS in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00421.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-11/msg00421.html>.
* Makefile.in (OLDXMENU_TARGET, OLDXMENU, OLDXMENU_DEPS)
(really-lwlib, really-oldXMenu, stamp-oldxmenu)
(../src/$(OLDXMENU), $(OLDXMENU)): Remove.
@@ -10584,7 +10584,7 @@
Fix recently introduced bool vector overrun.
This was due to an optimization that went awry.
Reported by Glenn Morris in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00622.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-11/msg00622.html>.
* alloc.c (make_uninit_bool_vector): Don't allocate a dummy word
for empty vectors, undoing the 2013-11-18 change.
* data.c (bool_vector_binop_driver): Rely on this.
@@ -10635,7 +10635,7 @@
Always allocate at least one bits_word per bool vector.
See Daniel Colascione in:
- http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00518.html
+ https://lists.gnu.org/r/emacs-devel/2013-11/msg00518.html
* alloc.c (make_uninit_bool_vector): Always allocate at least one word.
* data.c (bool_vector_binop_driver): Rely on this. Tune.
* lisp.h (struct Lisp_Bool_vector): Document this.
@@ -10672,7 +10672,7 @@
* data.c: Work around bogus GCC diagnostic about shift count.
Reported by Eli Zaretskii in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-11/msg00489.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-11/msg00489.html>.
(pre_value): New function.
(count_trailing_zero_bits): Use it.
@@ -11049,7 +11049,7 @@
* buffer.c (init_buffer): Don't store default-directory of
*scratch* in multibyte form. The original problem which led to
that is described in
- http://lists.gnu.org/archive/html/emacs-pretest-bug/2004-11/msg00532.html,
+ https://lists.gnu.org/r/emacs-pretest-bug/2004-11/msg00532.html,
but it was solved long ago. (Bug#15260)
2013-11-04 Paul Eggert <eggert@cs.ucla.edu>
@@ -11293,7 +11293,7 @@
the same font object.
Perform font-specific cleanup when font object is swept by GC. See
- http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00740.html.
+ https://lists.gnu.org/r/emacs-devel/2013-10/msg00740.html.
* alloc.c (cleanup_vector): New function.
(sweep_vector): Call it for each reclaimed vector object.
* font.h (struct font): Adjust comment.
@@ -11347,7 +11347,7 @@
* keyboard.c (make_lispy_event): Remove GPM-specific code that
handles mouse clicks. Instead, let GPM use the same code as all
the other mice use. See the discussion starting at
- http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00521.html
+ https://lists.gnu.org/r/emacs-devel/2013-10/msg00521.html
for the details of the problem with the menu bar this fixes.
2013-10-18 Dmitry Antipov <dmantipov@yandex.ru>
@@ -11722,7 +11722,7 @@
flavors of 'eassert', one for where 'assume' is far more likely
to help or to hurt; but that can be done later.
Reported by Dmitry Antipov in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00276.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-10/msg00276.html>.
Also, don't include <verify.h>; no longer needed.
2013-10-09 Glenn Morris <rgm@gnu.org>
@@ -11891,7 +11891,7 @@
Do not allocate huge temporary memory areas and objects while encoding
for file I/O, thus reducing an enormous memory usage for large buffers.
- See http://lists.gnu.org/archive/html/emacs-devel/2013-10/msg00180.html.
+ See https://lists.gnu.org/r/emacs-devel/2013-10/msg00180.html.
* coding.h (struct coding_system): New member raw_destination.
* coding.c (setup_coding_system): Initialize it to zero.
(encode_coding_object): If raw_destination is set, do not create
@@ -12132,14 +12132,14 @@
* dispnew.c (clear_glyph_row, copy_row_except_pointers): Use enums
instead of ints, as it's the usual style for offsetof constants. See:
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00478.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00478.html
* data.c (POPCOUNT_STATIC_INLINE): New macro, as a hack for popcount.
This is ugly, but it should fix the performance problem for older
GCC versions in the short run. I'll look into integrating the
Gnulib module for popcount, as a better fix.
See the thread starting in:
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00474.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00474.html
(popcount_size_t_generic) [NEED_GENERIC_POPCOUNT]:
(popcount_size_t_msc) [USE_MSC_POPCOUNT]:
(popcount_size_t_gcc) [USE_GCC_POPCOUNT]:
@@ -12331,7 +12331,7 @@
which must have the same definition in all modules, because the
defining code might be shared across modules, depending on the
implementation. Symptoms reported by Martin Rudalics in:
- http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00414.html
+ https://lists.gnu.org/r/emacs-devel/2013-09/msg00414.html
* regex.c, syntax.c (SYNTAX_ENTRY_VIA_PROPERTY): Remove.
(SYNTAX, SYNTAX_ENTRY, SYNTAX_WITH_FLAGS): New macros,
overriding the corresponding functions in syntax.h.
@@ -14498,7 +14498,7 @@
* w32uniscribe.c (uniscribe_list, uniscribe_match)
(uniscribe_list_family): Adjust to match font API change.
MS-Windows breakage reported by Juanma Barranquero <lekktu@gmail.com>
- at http://lists.gnu.org/archive/html/emacs-devel/2013-08/msg00006.html.
+ at https://lists.gnu.org/r/emacs-devel/2013-08/msg00006.html.
2013-08-01 Dmitry Antipov <dmantipov@yandex.ru>
@@ -14691,7 +14691,7 @@
* eval.c (Fprogn): Do not check that BODY is a proper list.
This undoes the previous change. The check slows down the
interpreter, and is not needed to prevent a crash. See
- <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00693.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-07/msg00693.html>.
2013-07-23 Glenn Morris <rgm@gnu.org>
@@ -15206,7 +15206,7 @@
* deps.mk (sysdep.o): Remove dependency on ../lib/ignore-value.h.
Reported by Herbert J. Skuhra in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00455.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-07/msg00455.html>.
Don't lose top specpdl entry when memory is exhausted.
* eval.c (grow_specpdl): Increment specpdl top by 1 and check for
@@ -15642,7 +15642,7 @@
Try again to fix FreeBSD bug re multithreaded memory alloc (Bug#14569).
* emacs.c (main) [HAVE_PTHREAD && !SYSTEM_MALLOC && !DOUG_LEA_MALLOC]:
Do not clear _malloc_thread_enabled_p, undoing the previous change,
- which did not work (see <http://bugs.gnu.org/14569#307>).
+ which did not work (see <https://bugs.gnu.org/14569#307>).
(main): Do not invoke malloc_enable_thread if (! CANNOT_DUMP
&& (!noninteractive || initialized)). This attempts to thread
the needle between the Scylla of FreeBSD and the Charybdis of Cygwin.
@@ -15657,7 +15657,7 @@
Try to fix FreeBSD bug re multithreaded memory allocation (Bug#14569).
* emacs.c (main) [HAVE_PTHREAD && !SYSTEM_MALLOC && !DOUG_LEA_MALLOC]:
Clear _malloc_thread_enabled_p at startup. Reported by Ashish SHUKLA in
- <http://lists.gnu.org/archive/html/emacs-devel/2013-07/msg00088.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-07/msg00088.html>.
2013-07-02 Paul Eggert <eggert@cs.ucla.edu>
@@ -15714,7 +15714,7 @@
* emacs.c (malloc_enable_thread): Hoist extern decl to top level.
(main) [HAVE_PTHREAD && !SYSTEM_MALLOC && !DOUG_LEA_MALLOC]:
Invoke malloc_enable_thread even when not interactive.
- Reported by Ken Brown in <http://bugs.gnu.org/14569#275>.
+ Reported by Ken Brown in <https://bugs.gnu.org/14569#275>.
* process.c (init_process_emacs) [CYGWIN]: Tickle glib even
in this case, since the underlying bug has now been fixed.
@@ -16084,7 +16084,7 @@
2013-06-17 Paul Eggert <eggert@cs.ucla.edu>
Move functions from lisp.h to individual modules when possible.
- From a suggestion by Andreas Schwab in <http://bugs.gnu.org/11935#68>.
+ From a suggestion by Andreas Schwab in <https://bugs.gnu.org/11935#68>.
* alloc.c (XFLOAT_INIT, set_symbol_name):
* buffer.c (CHECK_OVERLAY):
* chartab.c (CHECK_CHAR_TABLE, set_char_table_ascii)
@@ -16344,7 +16344,7 @@
A few porting etc. fixes for the new file monitor code.
See the thread containing
- <http://lists.gnu.org/archive/html/emacs-devel/2013-06/msg00109.html>.
+ <https://lists.gnu.org/r/emacs-devel/2013-06/msg00109.html>.
* gfilenotify.c (dir_monitor_callback, Fgfile_add_watch)
(Fgfile_rm_watch): Don't assume EMACS_INT is the same width as a pointer.
(dir_monitor_callback, Fgfile_rm_watch):
@@ -16581,7 +16581,7 @@
(characterIndexForPoint:): Adjust return type depending on GNUstep
version.
(mouseDown:): delta is CGFloat.
- (updateFrameSize): Remove unised variable f.
+ (updateFrameSize): Remove unused variable f.
(initFrameFromEmacs): Move toggleButton inside NS_IMPL_COCOA.
Cast float to EmacsCGFloat.
(windowWillUseStandardFrame:defaultFrame:): Set maximized_height
@@ -16593,7 +16593,7 @@
(setPosition:portion:whole:): por is CGFloat.
(getMouseMotionPart:window:x:y:): Add F suffix to float.
(mouseDown:): Use CGFloat.
- (mouseDragged:): Remove unised variable edge.
+ (mouseDragged:): Remove unused variable edge.
(EmacsDocument): Implement for NS_IMPL_GNUSTEP.
* nsterm.h (EmacsCGFloat): Typedef for OSX and GNUstep when the size
@@ -17194,7 +17194,7 @@
more than one line when there's an overlay string with a display
property at end of line.
Reported by Karl Chen <Karl.Chen@quarl.org> in
- http://lists.gnu.org/archive/html/emacs-devel/2013-04/msg00362.html.
+ https://lists.gnu.org/r/emacs-devel/2013-04/msg00362.html.
2013-04-12 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -17920,4 +17920,4 @@ See ChangeLog.12 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.2 b/src/ChangeLog.2
index 56015d56175..42e1e8345d8 100644
--- a/src/ChangeLog.2
+++ b/src/ChangeLog.2
@@ -4786,4 +4786,4 @@ See ChangeLog.1 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.3 b/src/ChangeLog.3
index 8f9b38e25d1..17fd69c9f11 100644
--- a/src/ChangeLog.3
+++ b/src/ChangeLog.3
@@ -16518,4 +16518,4 @@ See ChangeLog.2 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.4 b/src/ChangeLog.4
index bb13c9a5f68..70865535e96 100644
--- a/src/ChangeLog.4
+++ b/src/ChangeLog.4
@@ -3381,7 +3381,7 @@
some external definitions.
(Ffile_attributes) [MSDOS]: Set execute bits from file name.
(Ffile_name_all_completions) [FILE_SYSTEM_CASE]: Convert
- case of file name as as indicated by conditional.
+ case of file name as indicated by conditional.
* emacs.c (main) [MSDOS]: Call init_environment. Set file types to
binary for all files. Call init_dosfns.
@@ -6921,4 +6921,4 @@ See ChangeLog.3 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.5 b/src/ChangeLog.5
index f0fde023ff2..99d25163a4d 100644
--- a/src/ChangeLog.5
+++ b/src/ChangeLog.5
@@ -1372,7 +1372,7 @@
1995-04-11 Richard Stallman <rms@mole.gnu.ai.mit.edu>
* keyboard.c (read_char): Rearrange code so that getcjmp is set
- only around sit_for and kbd_buffer_get_event, and
+ only around sit_for and kbd_buffer_get_event,
and polling is stopped only around the kbd_buffer_get_event call.
(Ftrack_mouse, tracking_off, read_char): Don't call prepare_menu_bars.
@@ -7163,4 +7163,4 @@ See ChangeLog.4 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.6 b/src/ChangeLog.6
index 2282916205d..f2b9e609b14 100644
--- a/src/ChangeLog.6
+++ b/src/ChangeLog.6
@@ -5373,4 +5373,4 @@ See ChangeLog.5 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.7 b/src/ChangeLog.7
index eb4833ccb0e..a1a9fb77157 100644
--- a/src/ChangeLog.7
+++ b/src/ChangeLog.7
@@ -3381,7 +3381,7 @@
1998-02-15 Richard Stallman <rms@psilocin.gnu.org>
* minibuf.c (read_minibuf): Do use DEFALT in place of empty input
- when when expflag is nonzero.
+ when expflag is nonzero.
(Fread_no_blanks_input): Arg INIT renamed to INITIAL.
1998-02-14 Richard Stallman <rms@psilocin.gnu.org>
@@ -11106,4 +11106,4 @@ See ChangeLog.6 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.8 b/src/ChangeLog.8
index ae971b52e1d..cf7c926cc2d 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -13994,4 +13994,4 @@ See ChangeLog.7 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/ChangeLog.9 b/src/ChangeLog.9
index 7b8f500b603..6de10c493f7 100644
--- a/src/ChangeLog.9
+++ b/src/ChangeLog.9
@@ -13309,4 +13309,4 @@ See ChangeLog.8 for earlier changes.
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/Makefile.in b/src/Makefile.in
index 2be24ac192a..9a8c9c85f04 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -16,7 +16,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
# Note that this file is edited by msdos/sed1v2.inp for MSDOS. That
@@ -234,6 +234,8 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@
GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@
+LIBLCMS2 = @LIBLCMS2@
+
LIBZ = @LIBZ@
## system-specific libs for dynamic modules, else empty
@@ -278,7 +280,7 @@ GNU_OBJC_CFLAGS=$(patsubst -specs=%-hardened-cc1,,@GNU_OBJC_CFLAGS@)
## w32xfns.o w32select.o image.o w32uniscribe.o if HAVE_W32, else
## empty.
W32_OBJ=@W32_OBJ@
-## -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32 lusp10 -lcomctl32
+## -lkernel32 -luser32 -lusp10 -lgdi32 -lole32 -lcomdlg32 -lcomctl32
## --lwinspool if HAVE_W32, else empty.
W32_LIBS=@W32_LIBS@
@@ -389,7 +391,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
syntax.o $(UNEXEC_OBJ) bytecode.o \
process.o gnutls.o callproc.o \
region-cache.o sound.o atimer.o \
- doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \
+ doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
$(XWIDGETS_OBJ) \
profiler.o decompress.o \
thread.o systhread.o \
@@ -490,7 +492,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \
$(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \
$(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \
$(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \
- $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) \
+ $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \
$(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS)
## FORCE it so that admin/unidata can decide whether these files
@@ -639,13 +641,13 @@ mostlyclean:
rm -f globals.h gl-stamp
rm -f *.res *.tmp
clean: mostlyclean
- rm -f emacs-*.*.*$(EXEEXT) emacs$(EXEEXT) $(DEPDIR)/*
+ rm -f emacs-*.*.*[0-9]$(EXEEXT) emacs$(EXEEXT) $(DEPDIR)/*
## bootstrap-clean is used to clean up just before a bootstrap.
## It should remove all files generated during a compilation/bootstrap,
## but not things like config.status or TAGS.
bootstrap-clean: clean
- rm -f epaths.h config.h config.stamp
+ rm -f emacs-module.h epaths.h config.h config.stamp
if test -f ./.gdbinit; then \
mv ./.gdbinit ./.gdbinit.save; \
if test -f "$(srcdir)/.gdbinit"; then rm -f ./.gdbinit.save; \
@@ -659,7 +661,7 @@ distclean: bootstrap-clean
maintainer-clean: distclean
rm -f TAGS
versionclean:
- -rm -f emacs$(EXEEXT) emacs-*.*.*$(EXEEXT) ../etc/DOC*
+ -rm -f emacs$(EXEEXT) emacs-*.*.*[0-9]$(EXEEXT) ../etc/DOC*
extraclean: distclean
-rm -f *~ \#*
diff --git a/src/README b/src/README
index fef2ff4e9e1..4790c04141b 100644
--- a/src/README
+++ b/src/README
@@ -27,4 +27,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/src/alloc.c b/src/alloc.c
index ac3de83b2b6..4f3928a4824 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -211,9 +211,9 @@ alloc_unexec_post (void)
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
-#define MARK_STRING(S) ((S)->size |= ARRAY_MARK_FLAG)
-#define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG)
-#define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0)
+#define MARK_STRING(S) ((S)->u.s.size |= ARRAY_MARK_FLAG)
+#define UNMARK_STRING(S) ((S)->u.s.size &= ~ARRAY_MARK_FLAG)
+#define STRING_MARKED_P(S) (((S)->u.s.size & ARRAY_MARK_FLAG) != 0)
#define VECTOR_MARK(V) ((V)->header.size |= ARRAY_MARK_FLAG)
#define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG)
@@ -1553,7 +1553,7 @@ make_interval (void)
/* Mark Lisp objects in interval I. */
static void
-mark_interval (register INTERVAL i, Lisp_Object dummy)
+mark_interval (INTERVAL i, void *dummy)
{
/* Intervals should never be shared. So, if extra internal checking is
enabled, GC aborts if it seems to have visited an interval twice. */
@@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy)
#define MARK_INTERVAL_TREE(i) \
do { \
if (i && !i->gcmarkbit) \
- traverse_intervals_noorder (i, mark_interval, Qnil); \
+ traverse_intervals_noorder (i, mark_interval, NULL); \
} while (0)
/***********************************************************************
@@ -1730,14 +1730,14 @@ static EMACS_INT total_string_bytes;
string_free_list, return a pointer to its successor in the
free-list. */
-#define NEXT_FREE_LISP_STRING(S) (*(struct Lisp_String **) (S))
+#define NEXT_FREE_LISP_STRING(S) ((S)->u.next)
/* Return a pointer to the sdata structure belonging to Lisp string S.
S must be live, i.e. S->data must not be null. S->data is actually
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET))
+#define SDATA_OF_STRING(S) ((sdata *) ((S)->u.s.data - SDATA_DATA_OFFSET))
#ifdef GC_CHECK_STRING_OVERRUN
@@ -1760,7 +1760,7 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
#ifdef GC_CHECK_STRING_BYTES
-#define SDATA_SIZE(NBYTES) FLEXSIZEOF (struct sdata, data, NBYTES)
+#define SDATA_SIZE(NBYTES) FLEXSIZEOF (struct sdata, data, (NBYTES) + 1)
#else /* not GC_CHECK_STRING_BYTES */
@@ -1818,9 +1818,10 @@ ptrdiff_t
string_bytes (struct Lisp_String *s)
{
ptrdiff_t nbytes =
- (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
+ (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte);
- if (!PURE_P (s) && s->data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
+ if (!PURE_P (s) && s->u.s.data
+ && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
emacs_abort ();
return nbytes;
}
@@ -1926,7 +1927,7 @@ allocate_string (void)
{
s = b->strings + i;
/* Every string on a free list should have NULL data pointer. */
- s->data = NULL;
+ s->u.s.data = NULL;
NEXT_FREE_LISP_STRING (s) = string_free_list;
string_free_list = s;
}
@@ -1965,10 +1966,10 @@ allocate_string (void)
/* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes,
- plus a NUL byte at the end. Allocate an sdata structure for S, and
- set S->data to its `u.data' member. Store a NUL byte at the end of
- S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free
- S->data if it was initially non-null. */
+ plus a NUL byte at the end. Allocate an sdata structure DATA for
+ S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the
+ end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte
+ to NBYTES. Free S->u.s.data if it was initially non-null. */
void
allocate_string_data (struct Lisp_String *s,
@@ -1984,7 +1985,7 @@ allocate_string_data (struct Lisp_String *s,
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed = SDATA_SIZE (nbytes);
- if (s->data)
+ if (s->u.s.data)
{
old_data = SDATA_OF_STRING (s);
old_nbytes = STRING_BYTES (s);
@@ -2043,13 +2044,13 @@ allocate_string_data (struct Lisp_String *s,
MALLOC_UNBLOCK_INPUT;
- s->data = SDATA_DATA (data);
+ s->u.s.data = SDATA_DATA (data);
#ifdef GC_CHECK_STRING_BYTES
SDATA_NBYTES (data) = nbytes;
#endif
- s->size = nchars;
- s->size_byte = nbytes;
- s->data[nbytes] = '\0';
+ s->u.s.size = nchars;
+ s->u.s.size_byte = nbytes;
+ s->u.s.data[nbytes] = '\0';
#ifdef GC_CHECK_STRING_OVERRUN
memcpy ((char *) data + needed, string_overrun_cookie,
GC_STRING_OVERRUN_COOKIE_SIZE);
@@ -2093,7 +2094,7 @@ sweep_strings (void)
{
struct Lisp_String *s = b->strings + i;
- if (s->data)
+ if (s->u.s.data)
{
/* String was not on free-list before. */
if (STRING_MARKED_P (s))
@@ -2102,7 +2103,7 @@ sweep_strings (void)
UNMARK_STRING (s);
/* Do not use string_(set|get)_intervals here. */
- s->intervals = balance_intervals (s->intervals);
+ s->u.s.intervals = balance_intervals (s->u.s.intervals);
++total_strings;
total_string_bytes += STRING_BYTES (s);
@@ -2125,7 +2126,7 @@ sweep_strings (void)
/* Reset the strings's `data' member so that we
know it's free. */
- s->data = NULL;
+ s->u.s.data = NULL;
/* Put the string on the free-list. */
NEXT_FREE_LISP_STRING (s) = string_free_list;
@@ -2264,7 +2265,7 @@ compact_small_strings (void)
{
eassert (tb != b || to < from);
memmove (to, from, nbytes + GC_STRING_EXTRA);
- to->string->data = SDATA_DATA (to);
+ to->string->u.s.data = SDATA_DATA (to);
}
/* Advance past the sdata we copied to. */
@@ -2298,11 +2299,13 @@ string_overflow (void)
error ("Maximum string size exceeded");
}
-DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
+DEFUN ("make-string", Fmake_string, Smake_string, 2, 3, 0,
doc: /* Return a newly created string of length LENGTH, with INIT in each element.
LENGTH must be an integer.
-INIT must be an integer that represents a character. */)
- (Lisp_Object length, Lisp_Object init)
+INIT must be an integer that represents a character.
+If optional argument MULTIBYTE is non-nil, the result will be
+a multibyte string even if INIT is an ASCII character. */)
+ (Lisp_Object length, Lisp_Object init, Lisp_Object multibyte)
{
register Lisp_Object val;
int c;
@@ -2312,7 +2315,7 @@ INIT must be an integer that represents a character. */)
CHECK_CHARACTER (init);
c = XFASTINT (init);
- if (ASCII_CHAR_P (c))
+ if (ASCII_CHAR_P (c) && NILP (multibyte))
{
nbytes = XINT (length);
val = make_uninit_string (nbytes);
@@ -2544,7 +2547,7 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
return empty_multibyte_string;
s = allocate_string ();
- s->intervals = NULL;
+ s->u.s.intervals = NULL;
allocate_string_data (s, nchars, nbytes);
XSETSTRING (string, s);
string_chars_consed += nbytes;
@@ -2729,8 +2732,8 @@ static struct Lisp_Cons *cons_free_list;
void
free_cons (struct Lisp_Cons *ptr)
{
- ptr->u.chain = cons_free_list;
- ptr->car = Vdead;
+ ptr->u.s.u.chain = cons_free_list;
+ ptr->u.s.car = Vdead;
cons_free_list = ptr;
consing_since_gc -= sizeof *ptr;
total_free_conses++;
@@ -2749,7 +2752,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
/* We use the cdr for chaining the free list
so that we won't use the same field that has the mark bit. */
XSETCONS (val, cons_free_list);
- cons_free_list = cons_free_list->u.chain;
+ cons_free_list = cons_free_list->u.s.u.chain;
}
else
{
@@ -2786,7 +2789,7 @@ check_cons_list (void)
struct Lisp_Cons *tail = cons_free_list;
while (tail)
- tail = tail->u.chain;
+ tail = tail->u.s.u.chain;
}
#endif
@@ -2921,15 +2924,16 @@ set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p)
#define VECTOR_BLOCK_SIZE 4096
-enum
- {
- /* Alignment of struct Lisp_Vector objects. */
- vector_alignment = COMMON_MULTIPLE (FLEXALIGNOF (struct Lisp_Vector),
- GCALIGNMENT),
+/* Alignment of struct Lisp_Vector objects. Because pseudovectors
+ can contain any C type, align at least as strictly as
+ max_align_t. On x86 and x86-64 this can waste up to 8 bytes
+ for typical vectors, since alignof (max_align_t) is 16 but
+ typical vectors need only an alignment of 8. However, it is
+ not worth the hassle to avoid wasting those bytes. */
+enum {vector_alignment = COMMON_MULTIPLE (alignof (max_align_t), GCALIGNMENT)};
- /* Vector size requests are a multiple of this. */
- roundup_size = COMMON_MULTIPLE (vector_alignment, word_size)
- };
+/* Vector size requests are a multiple of this. */
+enum { roundup_size = COMMON_MULTIPLE (vector_alignment, word_size) };
/* Verify assumptions described above. */
verify (VECTOR_BLOCK_SIZE % roundup_size == 0);
@@ -2961,25 +2965,23 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
/* Common shortcut to advance vector pointer over a block data. */
-#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes)))
+static struct Lisp_Vector *
+ADVANCE (struct Lisp_Vector *v, ptrdiff_t nbytes)
+{
+ void *vv = v;
+ char *cv = vv;
+ void *p = cv + nbytes;
+ return p;
+}
/* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */
-#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size)
-
-/* Common shortcut to setup vector on a free list. */
-
-#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \
- do { \
- (tmp) = ((nbytes - header_size) / word_size); \
- XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \
- eassert ((nbytes) % roundup_size == 0); \
- (tmp) = VINDEX (nbytes); \
- eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \
- set_next_vector (v, vector_free_lists[tmp]); \
- vector_free_lists[tmp] = (v); \
- total_free_vector_slots += (nbytes) / word_size; \
- } while (0)
+static ptrdiff_t
+VINDEX (ptrdiff_t nbytes)
+{
+ eassume (VBLOCK_BYTES_MIN <= nbytes);
+ return (nbytes - VBLOCK_BYTES_MIN) / roundup_size;
+}
/* This internal type is used to maintain the list of large vectors
which are allocated at their own, e.g. outside of vector blocks.
@@ -3041,6 +3043,22 @@ static EMACS_INT total_vectors;
static EMACS_INT total_vector_slots, total_free_vector_slots;
+/* Common shortcut to setup vector on a free list. */
+
+static void
+setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
+{
+ eassume (header_size <= nbytes);
+ ptrdiff_t nwords = (nbytes - header_size) / word_size;
+ XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords);
+ eassert (nbytes % roundup_size == 0);
+ ptrdiff_t vindex = VINDEX (nbytes);
+ eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX);
+ set_next_vector (v, vector_free_lists[vindex]);
+ vector_free_lists[vindex] = v;
+ total_free_vector_slots += nbytes / word_size;
+}
+
/* Get a new vector block. */
static struct vector_block *
@@ -3105,7 +3123,7 @@ allocate_vector_from_block (size_t nbytes)
which should be set on an appropriate free list. */
restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes;
eassert (restbytes % roundup_size == 0);
- SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
+ setup_on_free_list (ADVANCE (vector, nbytes), restbytes);
return vector;
}
@@ -3121,7 +3139,7 @@ allocate_vector_from_block (size_t nbytes)
if (restbytes >= VBLOCK_BYTES_MIN)
{
eassert (restbytes % roundup_size == 0);
- SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index);
+ setup_on_free_list (ADVANCE (vector, nbytes), restbytes);
}
return vector;
}
@@ -3253,10 +3271,7 @@ sweep_vectors (void)
space was coalesced into the only free vector. */
free_this_block = 1;
else
- {
- size_t tmp;
- SETUP_ON_FREE_LIST (vector, total_bytes, tmp);
- }
+ setup_on_free_list (vector, total_bytes);
}
}
@@ -3302,15 +3317,14 @@ sweep_vectors (void)
static struct Lisp_Vector *
allocate_vectorlike (ptrdiff_t len)
{
- struct Lisp_Vector *p;
-
- MALLOC_BLOCK_INPUT;
-
if (len == 0)
- p = XVECTOR (zero_vector);
+ return XVECTOR (zero_vector);
else
{
size_t nbytes = header_size + len * word_size;
+ struct Lisp_Vector *p;
+
+ MALLOC_BLOCK_INPUT;
#ifdef DOUG_LEA_MALLOC
if (!mmap_lisp_allowed_p ())
@@ -3340,11 +3354,11 @@ allocate_vectorlike (ptrdiff_t len)
consing_since_gc += nbytes;
vector_cells_consed += len;
- }
- MALLOC_UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
- return p;
+ return p;
+ }
}
@@ -3528,27 +3542,17 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
Symbol Allocation
***********************************************************************/
-/* Like struct Lisp_Symbol, but padded so that the size is a multiple
- of the required alignment. */
-
-union aligned_Lisp_Symbol
-{
- struct Lisp_Symbol s;
- unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1)
- & -GCALIGNMENT];
-};
-
/* Each symbol_block is just under 1020 bytes long, since malloc
really allocates in units of powers of two and uses 4 bytes for its
own overhead. */
#define SYMBOL_BLOCK_SIZE \
- ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol))
+ ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
struct symbol_block
{
/* Place `symbols' first, to preserve alignment. */
- union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
+ struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE];
struct symbol_block *next;
};
@@ -3572,7 +3576,7 @@ static struct Lisp_Symbol *symbol_free_list;
static void
set_symbol_name (Lisp_Object sym, Lisp_Object name)
{
- XSYMBOL (sym)->name = name;
+ XSYMBOL (sym)->u.s.name = name;
}
void
@@ -3581,15 +3585,15 @@ init_symbol (Lisp_Object val, Lisp_Object name)
struct Lisp_Symbol *p = XSYMBOL (val);
set_symbol_name (val, name);
set_symbol_plist (val, Qnil);
- p->redirect = SYMBOL_PLAINVAL;
+ p->u.s.redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (p, Qunbound);
set_symbol_function (val, Qnil);
set_symbol_next (val, NULL);
- p->gcmarkbit = false;
- p->interned = SYMBOL_UNINTERNED;
- p->trapped_write = SYMBOL_UNTRAPPED_WRITE;
- p->declared_special = false;
- p->pinned = false;
+ p->u.s.gcmarkbit = false;
+ p->u.s.interned = SYMBOL_UNINTERNED;
+ p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE;
+ p->u.s.declared_special = false;
+ p->u.s.pinned = false;
}
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
@@ -3606,7 +3610,7 @@ Its value is void, and its function definition and property list are nil. */)
if (symbol_free_list)
{
XSETSYMBOL (val, symbol_free_list);
- symbol_free_list = symbol_free_list->next;
+ symbol_free_list = symbol_free_list->u.s.next;
}
else
{
@@ -3619,7 +3623,7 @@ Its value is void, and its function definition and property list are nil. */)
symbol_block_index = 0;
total_free_symbols += SYMBOL_BLOCK_SIZE;
}
- XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s);
+ XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
symbol_block_index++;
}
@@ -3915,7 +3919,7 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
{
Lisp_Object result;
- result = Fmake_string (make_number (nargs), make_number (0));
+ result = Fmake_string (make_number (nargs), make_number (0), Qnil);
for (i = 0; i < nargs; i++)
{
SSET (result, i, XINT (args[i]));
@@ -4171,7 +4175,7 @@ refill_memory_reserve (void)
block to the red-black tree with calls to mem_insert, and function
lisp_free removes it with mem_delete. Functions live_string_p etc
call mem_find to lookup information about a given pointer in the
- tree, and use that to determine if the pointer points to a Lisp
+ tree, and use that to determine if the pointer points into a Lisp
object or not. */
/* Initialize this part of alloc.c. */
@@ -4549,82 +4553,113 @@ mem_delete_fixup (struct mem_node *x)
}
-/* Value is non-zero if P is a pointer to a live Lisp string on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer into a live Lisp string object on the heap,
+ return the object. Otherwise, return nil. M is a pointer to the
+ mem_block for P.
-static bool
-live_string_p (struct mem_node *m, void *p)
+ This and other *_holding functions look for a pointer anywhere into
+ the object, not merely for a pointer to the start of the object,
+ because some compilers sometimes optimize away the latter. See
+ Bug#28213. */
+
+static Lisp_Object
+live_string_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_STRING)
{
struct string_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->strings[0];
- /* P must point to the start of a Lisp_String structure, and it
+ /* P must point into a Lisp_String structure, and it
must not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->strings[0] == 0
- && offset < (STRING_BLOCK_SIZE * sizeof b->strings[0])
- && ((struct Lisp_String *) p)->data != NULL);
+ if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0])
+ {
+ struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0];
+ if (s->u.s.data)
+ return make_lisp_ptr (s, Lisp_String);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_string_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_string_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live Lisp cons on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer into a live Lisp cons object on the heap, return
+ the object. Otherwise, return nil. M is a pointer to the
+ mem_block for P. */
-static bool
-live_cons_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_cons_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_CONS)
{
struct cons_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->conses[0];
- /* P must point to the start of a Lisp_Cons, not be
+ /* P must point into a Lisp_Cons, not be
one of the unused cells in the current cons block,
and not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->conses[0] == 0
- && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
- && (b != cons_block
- || offset / sizeof b->conses[0] < cons_block_index)
- && !EQ (((struct Lisp_Cons *) p)->car, Vdead));
+ if (0 <= offset && offset < CONS_BLOCK_SIZE * sizeof b->conses[0]
+ && (b != cons_block
+ || offset / sizeof b->conses[0] < cons_block_index))
+ {
+ struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0];
+ if (!EQ (s->u.s.car, Vdead))
+ return make_lisp_ptr (s, Lisp_Cons);
+ }
}
- else
- return 0;
+ return Qnil;
+}
+
+static bool
+live_cons_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_cons_holding (m, p));
}
-/* Value is non-zero if P is a pointer to a live Lisp symbol on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer into a live Lisp symbol object on the heap,
+ return the object. Otherwise, return nil. M is a pointer to the
+ mem_block for P. */
-static bool
-live_symbol_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_symbol_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_SYMBOL)
{
struct symbol_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->symbols[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->symbols[0];
- /* P must point to the start of a Lisp_Symbol, not be
+ /* P must point into the Lisp_Symbol, not be
one of the unused cells in the current symbol block,
and not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->symbols[0] == 0
- && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0])
- && (b != symbol_block
- || offset / sizeof b->symbols[0] < symbol_block_index)
- && !EQ (((struct Lisp_Symbol *)p)->function, Vdead));
+ if (0 <= offset && offset < SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]
+ && (b != symbol_block
+ || offset / sizeof b->symbols[0] < symbol_block_index))
+ {
+ struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0];
+ if (!EQ (s->u.s.function, Vdead))
+ return make_lisp_symbol (s);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_symbol_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_symbol_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live Lisp float on
+
+/* Return true if P is a pointer to a live Lisp float on
the heap. M is a pointer to the mem_block for P. */
static bool
@@ -4633,7 +4668,8 @@ live_float_p (struct mem_node *m, void *p)
if (m->type == MEM_TYPE_FLOAT)
{
struct float_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->floats[0];
/* P must point to the start of a Lisp_Float and not be
one of the unused cells in the current float block. */
@@ -4648,38 +4684,48 @@ live_float_p (struct mem_node *m, void *p)
}
-/* Value is non-zero if P is a pointer to a live Lisp Misc on
- the heap. M is a pointer to the mem_block for P. */
+/* If P is a pointer to a live Lisp Misc on the heap, return the object.
+ Otherwise, return nil. M is a pointer to the mem_block for P. */
-static bool
-live_misc_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_misc_holding (struct mem_node *m, void *p)
{
if (m->type == MEM_TYPE_MISC)
{
struct marker_block *b = m->start;
- ptrdiff_t offset = (char *) p - (char *) &b->markers[0];
+ char *cp = p;
+ ptrdiff_t offset = cp - (char *) &b->markers[0];
- /* P must point to the start of a Lisp_Misc, not be
+ /* P must point into a Lisp_Misc, not be
one of the unused cells in the current misc block,
and not be on the free-list. */
- return (offset >= 0
- && offset % sizeof b->markers[0] == 0
- && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0])
- && (b != marker_block
- || offset / sizeof b->markers[0] < marker_block_index)
- && ((union Lisp_Misc *) p)->u_any.type != Lisp_Misc_Free);
+ if (0 <= offset && offset < MARKER_BLOCK_SIZE * sizeof b->markers[0]
+ && (b != marker_block
+ || offset / sizeof b->markers[0] < marker_block_index))
+ {
+ union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0];
+ if (s->u_any.type != Lisp_Misc_Free)
+ return make_lisp_ptr (s, Lisp_Misc);
+ }
}
- else
- return 0;
+ return Qnil;
}
+static bool
+live_misc_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_misc_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live vector-like object.
+/* If P is a pointer to a live vector-like object, return the object.
+ Otherwise, return nil.
M is a pointer to the mem_block for P. */
-static bool
-live_vector_p (struct mem_node *m, void *p)
+static Lisp_Object
+live_vector_holding (struct mem_node *m, void *p)
{
+ struct Lisp_Vector *vp = p;
+
if (m->type == MEM_TYPE_VECTOR_BLOCK)
{
/* This memory node corresponds to a vector block. */
@@ -4691,33 +4737,59 @@ live_vector_p (struct mem_node *m, void *p)
vector which is not on a free list. FIXME: check whether
some allocation patterns (probably a lot of short vectors)
may cause a substantial overhead of this loop. */
- while (VECTOR_IN_BLOCK (vector, block)
- && vector <= (struct Lisp_Vector *) p)
+ while (VECTOR_IN_BLOCK (vector, block) && vector <= vp)
{
- if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p)
- return true;
- else
- vector = ADVANCE (vector, vector_nbytes (vector));
+ struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
+ if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE))
+ return make_lisp_ptr (vector, Lisp_Vectorlike);
+ vector = next;
}
}
- else if (m->type == MEM_TYPE_VECTORLIKE && p == large_vector_vec (m->start))
- /* This memory node corresponds to a large vector. */
- return 1;
- return 0;
+ else if (m->type == MEM_TYPE_VECTORLIKE)
+ {
+ /* This memory node corresponds to a large vector. */
+ struct Lisp_Vector *vector = large_vector_vec (m->start);
+ struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector));
+ if (vector <= vp && vp < next)
+ return make_lisp_ptr (vector, Lisp_Vectorlike);
+ }
+ return Qnil;
}
+static bool
+live_vector_p (struct mem_node *m, void *p)
+{
+ return !NILP (live_vector_holding (m, p));
+}
-/* Value is non-zero if P is a pointer to a live buffer. M is a
- pointer to the mem_block for P. */
+/* If P is a pointer into a live buffer, return the buffer.
+ Otherwise, return nil. M is a pointer to the mem_block for P. */
+
+static Lisp_Object
+live_buffer_holding (struct mem_node *m, void *p)
+{
+ /* P must point into the block, and the buffer
+ must not have been killed. */
+ if (m->type == MEM_TYPE_BUFFER)
+ {
+ struct buffer *b = m->start;
+ char *cb = m->start;
+ char *cp = p;
+ ptrdiff_t offset = cp - cb;
+ if (0 <= offset && offset < sizeof *b && !NILP (b->name_))
+ {
+ Lisp_Object obj;
+ XSETBUFFER (obj, b);
+ return obj;
+ }
+ }
+ return Qnil;
+}
static bool
live_buffer_p (struct mem_node *m, void *p)
{
- /* P must point to the start of the block, and the buffer
- must not have been killed. */
- return (m->type == MEM_TYPE_BUFFER
- && p == m->start
- && !NILP (((struct buffer *) p)->name_));
+ return !NILP (live_buffer_holding (m, p));
}
/* Mark OBJ if we can prove it's a Lisp_Object. */
@@ -4743,34 +4815,28 @@ mark_maybe_object (Lisp_Object obj)
switch (XTYPE (obj))
{
case Lisp_String:
- mark_p = (live_string_p (m, po)
- && !STRING_MARKED_P ((struct Lisp_String *) po));
+ mark_p = EQ (obj, live_string_holding (m, po));
break;
case Lisp_Cons:
- mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
+ mark_p = EQ (obj, live_cons_holding (m, po));
break;
case Lisp_Symbol:
- mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit);
+ mark_p = EQ (obj, live_symbol_holding (m, po));
break;
case Lisp_Float:
- mark_p = (live_float_p (m, po) && !FLOAT_MARKED_P (XFLOAT (obj)));
+ mark_p = live_float_p (m, po);
break;
case Lisp_Vectorlike:
- /* Note: can't check BUFFERP before we know it's a
- buffer because checking that dereferences the pointer
- PO which might point anywhere. */
- if (live_vector_p (m, po))
- mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
- else if (live_buffer_p (m, po))
- mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
+ mark_p = (EQ (obj, live_vector_holding (m, po))
+ || EQ (obj, live_buffer_holding (m, po)));
break;
case Lisp_Misc:
- mark_p = (live_misc_p (m, po) && !XMISCANY (obj)->gcmarkbit);
+ mark_p = EQ (obj, live_misc_holding (m, po));
break;
default:
@@ -4834,45 +4900,33 @@ mark_maybe_pointer (void *p)
break;
case MEM_TYPE_BUFFER:
- if (live_buffer_p (m, p) && !VECTOR_MARKED_P ((struct buffer *)p))
- XSETVECTOR (obj, p);
+ obj = live_buffer_holding (m, p);
break;
case MEM_TYPE_CONS:
- if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
- XSETCONS (obj, p);
+ obj = live_cons_holding (m, p);
break;
case MEM_TYPE_STRING:
- if (live_string_p (m, p)
- && !STRING_MARKED_P ((struct Lisp_String *) p))
- XSETSTRING (obj, p);
+ obj = live_string_holding (m, p);
break;
case MEM_TYPE_MISC:
- if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit)
- XSETMISC (obj, p);
+ obj = live_misc_holding (m, p);
break;
case MEM_TYPE_SYMBOL:
- if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit)
- XSETSYMBOL (obj, p);
+ obj = live_symbol_holding (m, p);
break;
case MEM_TYPE_FLOAT:
- if (live_float_p (m, p) && !FLOAT_MARKED_P (p))
- XSETFLOAT (obj, p);
+ if (live_float_p (m, p))
+ obj = make_lisp_ptr (p, Lisp_Float);
break;
case MEM_TYPE_VECTORLIKE:
case MEM_TYPE_VECTOR_BLOCK:
- if (live_vector_p (m, p))
- {
- Lisp_Object tem;
- XSETVECTOR (tem, p);
- if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
- obj = tem;
- }
+ obj = live_vector_holding (m, p);
break;
default:
@@ -4919,7 +4973,7 @@ mark_memory (void *start, void *end)
Lisp_Object obj = build_string ("test");
struct Lisp_String *s = XSTRING (obj);
Fgarbage_collect ();
- fprintf (stderr, "test '%s'\n", s->data);
+ fprintf (stderr, "test '%s'\n", s->u.s.data);
return Qnil;
}
@@ -5061,22 +5115,31 @@ typedef union
# endif
#endif
+/* Yield an address close enough to the top of the stack that the
+ garbage collector need not scan above it. Callers should be
+ declared NO_INLINE. */
+#ifdef HAVE___BUILTIN_FRAME_ADDRESS
+# define NEAR_STACK_TOP(addr) ((void) (addr), __builtin_frame_address (0))
+#else
+# define NEAR_STACK_TOP(addr) (addr)
+#endif
+
/* Set *P to the address of the top of the stack. This must be a
macro, not a function, so that it is executed in the caller’s
environment. It is not inside a do-while so that its storage
- survives the macro. */
+ survives the macro. Callers should be declared NO_INLINE. */
#ifdef HAVE___BUILTIN_UNWIND_INIT
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
__builtin_unwind_init (); \
- *(p) = &sentry
+ *(p) = NEAR_STACK_TOP (&sentry)
#else
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
__builtin_unwind_init (); \
test_setjmp (); \
sys_setjmp (sentry.j); \
- *(p) = &sentry + (stack_bottom < &sentry.c)
+ *(p) = NEAR_STACK_TOP (&sentry + (stack_bottom < &sentry.c))
#endif
/* Mark live Lisp objects on the C stack.
@@ -5148,7 +5211,7 @@ mark_stack (char *bottom, char *end)
It is invalid to run any Lisp code or to allocate any GC memory
from FUNC. */
-void
+NO_INLINE void
flush_stack_call_func (void (*func) (void *arg), void *arg)
{
void *end;
@@ -5410,16 +5473,16 @@ make_pure_string (const char *data,
{
Lisp_Object string;
struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
- s->data = (unsigned char *) find_string_data_in_pure (data, nbytes);
- if (s->data == NULL)
+ s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes);
+ if (s->u.s.data == NULL)
{
- s->data = pure_alloc (nbytes + 1, -1);
- memcpy (s->data, data, nbytes);
- s->data[nbytes] = '\0';
+ s->u.s.data = pure_alloc (nbytes + 1, -1);
+ memcpy (s->u.s.data, data, nbytes);
+ s->u.s.data[nbytes] = '\0';
}
- s->size = nchars;
- s->size_byte = multibyte ? nbytes : -1;
- s->intervals = NULL;
+ s->u.s.size = nchars;
+ s->u.s.size_byte = multibyte ? nbytes : -1;
+ s->u.s.intervals = NULL;
XSETSTRING (string, s);
return string;
}
@@ -5432,10 +5495,10 @@ make_pure_c_string (const char *data, ptrdiff_t nchars)
{
Lisp_Object string;
struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
- s->size = nchars;
- s->size_byte = -1;
- s->data = (unsigned char *) data;
- s->intervals = NULL;
+ s->u.s.size = nchars;
+ s->u.s.size_byte = -1;
+ s->u.s.data = (unsigned char *) data;
+ s->u.s.intervals = NULL;
XSETSTRING (string, s);
return string;
}
@@ -5546,7 +5609,7 @@ purecopy (Lisp_Object obj)
|| SUBRP (obj))
return obj; /* Already pure. */
- if (STRINGP (obj) && XSTRING (obj)->intervals)
+ if (STRINGP (obj) && XSTRING (obj)->u.s.intervals)
message_with_string ("Dropping text-properties while making string `%s' pure",
obj, true);
@@ -5601,10 +5664,10 @@ purecopy (Lisp_Object obj)
}
else if (SYMBOLP (obj))
{
- if (!XSYMBOL (obj)->pinned && !c_symbol_p (XSYMBOL (obj)))
+ if (!XSYMBOL (obj)->u.s.pinned && !c_symbol_p (XSYMBOL (obj)))
{ /* We can't purify them, but they appear in many pure objects.
Mark them as `pinned' so we know to mark them at every GC cycle. */
- XSYMBOL (obj)->pinned = true;
+ XSYMBOL (obj)->u.s.pinned = true;
symbol_block_pinned = symbol_block;
}
/* Don't hash-cons it. */
@@ -5817,10 +5880,10 @@ mark_pinned_symbols (void)
for (sblk = symbol_block_pinned; sblk; sblk = sblk->next)
{
- union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim;
+ struct Lisp_Symbol *sym = sblk->symbols, *end = sym + lim;
for (; sym < end; ++sym)
- if (sym->s.pinned)
- mark_object (make_lisp_symbol (&sym->s));
+ if (sym->u.s.pinned)
+ mark_object (make_lisp_symbol (sym));
lim = SYMBOL_BLOCK_SIZE;
}
@@ -5832,7 +5895,7 @@ mark_pinned_symbols (void)
where mark_stack finds values that look like live Lisp objects on
portions of stack that couldn't possibly contain such live objects.
For more details of this, see the discussion at
- http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00270.html. */
+ https://lists.gnu.org/r/emacs-devel/2014-05/msg00270.html. */
static Lisp_Object
garbage_collect_1 (void *end)
{
@@ -6097,7 +6160,8 @@ where each entry has the form (NAME SIZE USED FREE), where:
to return them to the OS).
However, if there was overflow in pure space, `garbage-collect'
returns nil, because real GC can't be done.
-See Info node `(elisp)Garbage Collection'. */)
+See Info node `(elisp)Garbage Collection'. */
+ attributes: noinline)
(void)
{
void *end;
@@ -6181,7 +6245,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype)
{
Lisp_Object val = ptr->contents[i];
- if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit))
+ if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit))
continue;
if (SUB_CHAR_TABLE_P (val))
{
@@ -6424,7 +6488,7 @@ mark_object (Lisp_Object arg)
break;
CHECK_ALLOCATED_AND_LIVE (live_string_p);
MARK_STRING (ptr);
- MARK_INTERVAL_TREE (ptr->intervals);
+ MARK_INTERVAL_TREE (ptr->u.s.intervals);
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
@@ -6565,17 +6629,17 @@ mark_object (Lisp_Object arg)
case Lisp_Symbol:
{
- register struct Lisp_Symbol *ptr = XSYMBOL (obj);
+ struct Lisp_Symbol *ptr = XSYMBOL (obj);
nextsym:
- if (ptr->gcmarkbit)
+ if (ptr->u.s.gcmarkbit)
break;
CHECK_ALLOCATED_AND_LIVE_SYMBOL ();
- ptr->gcmarkbit = 1;
+ ptr->u.s.gcmarkbit = 1;
/* Attempt to catch bogus objects. */
- eassert (valid_lisp_object_p (ptr->function));
- mark_object (ptr->function);
- mark_object (ptr->plist);
- switch (ptr->redirect)
+ eassert (valid_lisp_object_p (ptr->u.s.function));
+ mark_object (ptr->u.s.function);
+ mark_object (ptr->u.s.plist);
+ switch (ptr->u.s.redirect)
{
case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break;
case SYMBOL_VARALIAS:
@@ -6596,11 +6660,11 @@ mark_object (Lisp_Object arg)
break;
default: emacs_abort ();
}
- if (!PURE_P (XSTRING (ptr->name)))
- MARK_STRING (XSTRING (ptr->name));
- MARK_INTERVAL_TREE (string_intervals (ptr->name));
+ if (!PURE_P (XSTRING (ptr->u.s.name)))
+ MARK_STRING (XSTRING (ptr->u.s.name));
+ MARK_INTERVAL_TREE (string_intervals (ptr->u.s.name));
/* Inner loop to mark next symbol in this bucket, if any. */
- po = ptr = ptr->next;
+ po = ptr = ptr->u.s.next;
if (ptr)
goto nextsym;
}
@@ -6654,14 +6718,14 @@ mark_object (Lisp_Object arg)
CHECK_ALLOCATED_AND_LIVE (live_cons_p);
CONS_MARK (ptr);
/* If the cdr is nil, avoid recursion for the car. */
- if (EQ (ptr->u.cdr, Qnil))
+ if (EQ (ptr->u.s.u.cdr, Qnil))
{
- obj = ptr->car;
+ obj = ptr->u.s.car;
cdr_count = 0;
goto loop;
}
- mark_object (ptr->car);
- obj = ptr->u.cdr;
+ mark_object (ptr->u.s.car);
+ obj = ptr->u.s.u.cdr;
cdr_count++;
if (cdr_count == mark_object_loop_halt)
emacs_abort ();
@@ -6722,7 +6786,7 @@ survives_gc_p (Lisp_Object obj)
break;
case Lisp_Symbol:
- survives_p = XSYMBOL (obj)->gcmarkbit;
+ survives_p = XSYMBOL (obj)->u.s.gcmarkbit;
break;
case Lisp_Misc:
@@ -6798,9 +6862,9 @@ sweep_conses (void)
if (!CONS_MARKED_P (&cblk->conses[pos]))
{
this_free++;
- cblk->conses[pos].u.chain = cons_free_list;
+ cblk->conses[pos].u.s.u.chain = cons_free_list;
cons_free_list = &cblk->conses[pos];
- cons_free_list->car = Vdead;
+ cons_free_list->u.s.car = Vdead;
}
else
{
@@ -6819,7 +6883,7 @@ sweep_conses (void)
{
*cprev = cblk->next;
/* Unhook from the free list. */
- cons_free_list = cblk->conses[0].u.chain;
+ cons_free_list = cblk->conses[0].u.s.u.chain;
lisp_align_free (cblk);
}
else
@@ -6943,31 +7007,39 @@ sweep_symbols (void)
symbol_free_list = NULL;
for (int i = 0; i < ARRAYELTS (lispsym); i++)
- lispsym[i].gcmarkbit = 0;
+ lispsym[i].u.s.gcmarkbit = 0;
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
- union aligned_Lisp_Symbol *sym = sblk->symbols;
- union aligned_Lisp_Symbol *end = sym + lim;
+ struct Lisp_Symbol *sym = sblk->symbols;
+ struct Lisp_Symbol *end = sym + lim;
for (; sym < end; ++sym)
{
- if (!sym->s.gcmarkbit)
+ if (!sym->u.s.gcmarkbit)
{
- if (sym->s.redirect == SYMBOL_LOCALIZED)
- xfree (SYMBOL_BLV (&sym->s));
- sym->s.next = symbol_free_list;
- symbol_free_list = &sym->s;
- symbol_free_list->function = Vdead;
+ if (sym->u.s.redirect == SYMBOL_LOCALIZED)
+ {
+ xfree (SYMBOL_BLV (sym));
+ /* At every GC we sweep all symbol_blocks and rebuild the
+ symbol_free_list, so those symbols which stayed unused
+ between the two will be re-swept.
+ So we have to make sure we don't re-free this blv next
+ time we sweep this symbol_block (bug#29066). */
+ sym->u.s.redirect = SYMBOL_PLAINVAL;
+ }
+ sym->u.s.next = symbol_free_list;
+ symbol_free_list = sym;
+ symbol_free_list->u.s.function = Vdead;
++this_free;
}
else
{
++num_used;
- sym->s.gcmarkbit = 0;
+ sym->u.s.gcmarkbit = 0;
/* Attempt to catch bogus objects. */
- eassert (valid_lisp_object_p (sym->s.function));
+ eassert (valid_lisp_object_p (sym->u.s.function));
}
}
@@ -6979,7 +7051,7 @@ sweep_symbols (void)
{
*sprev = sblk->next;
/* Unhook from the free list. */
- symbol_free_list = sblk->symbols[0].s.next;
+ symbol_free_list = sblk->symbols[0].u.s.next;
lisp_free (sblk);
}
else
@@ -7206,10 +7278,10 @@ symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj)
struct Lisp_Symbol *sym = XSYMBOL (symbol);
Lisp_Object val = find_symbol_value (symbol);
return (EQ (val, obj)
- || EQ (sym->function, obj)
- || (!NILP (sym->function)
- && COMPILEDP (sym->function)
- && EQ (AREF (sym->function, COMPILED_BYTECODE), obj))
+ || EQ (sym->u.s.function, obj)
+ || (!NILP (sym->u.s.function)
+ && COMPILEDP (sym->u.s.function)
+ && EQ (AREF (sym->u.s.function, COMPILED_BYTECODE), obj))
|| (!NILP (val)
&& COMPILEDP (val)
&& EQ (AREF (val, COMPILED_BYTECODE), obj)));
@@ -7240,15 +7312,15 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max)
for (sblk = symbol_block; sblk; sblk = sblk->next)
{
- union aligned_Lisp_Symbol *aligned_sym = sblk->symbols;
+ struct Lisp_Symbol *asym = sblk->symbols;
int bn;
- for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++)
+ for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, asym++)
{
if (sblk == symbol_block && bn >= symbol_block_index)
break;
- Lisp_Object sym = make_lisp_symbol (&aligned_sym->s);
+ Lisp_Object sym = make_lisp_symbol (asym);
if (symbol_uses_obj (sym, obj))
{
found = Fcons (sym, found);
diff --git a/src/atimer.c b/src/atimer.c
index 5feb1f6777d..f728f01fd98 100644
--- a/src/atimer.c
+++ b/src/atimer.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
@@ -419,7 +419,7 @@ timerfd_callback (int fd, void *arg)
else if (nbytes < 0)
/* For some not yet known reason, we may get weird event and no
data on timer descriptor. This can break Gnus at least, see:
- http://lists.gnu.org/archive/html/emacs-devel/2014-07/msg00503.html. */
+ https://lists.gnu.org/r/emacs-devel/2014-07/msg00503.html. */
eassert (errno == EAGAIN);
else
/* I don't know what else can happen with this descriptor. */
diff --git a/src/atimer.h b/src/atimer.h
index 30a5856ffdf..fb85193d829 100644
--- a/src/atimer.h
+++ b/src/atimer.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_ATIMER_H
#define EMACS_ATIMER_H
diff --git a/src/bidi.c b/src/bidi.c
index dce0bf695f6..fd73b548376 100644
--- a/src/bidi.c
+++ b/src/bidi.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Eli Zaretskii <eliz@gnu.org>.
@@ -565,9 +565,7 @@ bidi_copy_it (struct bidi_it *to, struct bidi_it *from)
RTL characters in the offending line of text. */
/* Do we need to allow customization of this limit? */
#define BIDI_CACHE_MAX_ELTS_PER_SLOT 50000
-#if BIDI_CACHE_CHUNK >= BIDI_CACHE_MAX_ELTS_PER_SLOT
-# error BIDI_CACHE_CHUNK must be less than BIDI_CACHE_MAX_ELTS_PER_SLOT
-#endif
+verify (BIDI_CACHE_CHUNK < BIDI_CACHE_MAX_ELTS_PER_SLOT);
static ptrdiff_t bidi_cache_max_elts = BIDI_CACHE_MAX_ELTS_PER_SLOT;
static struct bidi_it *bidi_cache;
static ptrdiff_t bidi_cache_size = 0;
@@ -1450,8 +1448,14 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos)
Lisp_Object start_re;
ptrdiff_t val;
- sep_re = paragraph_separate_re;
- start_re = paragraph_start_re;
+ if (STRINGP (BVAR (current_buffer, bidi_paragraph_separate_re)))
+ sep_re = BVAR (current_buffer, bidi_paragraph_separate_re);
+ else
+ sep_re = paragraph_separate_re;
+ if (STRINGP (BVAR (current_buffer, bidi_paragraph_start_re)))
+ start_re = BVAR (current_buffer, bidi_paragraph_start_re);
+ else
+ start_re = paragraph_start_re;
val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil);
if (val < 0)
@@ -1525,7 +1529,10 @@ bidi_paragraph_cache_on_off (void)
static ptrdiff_t
bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte)
{
- Lisp_Object re = paragraph_start_re;
+ Lisp_Object re =
+ STRINGP (BVAR (current_buffer, bidi_paragraph_start_re))
+ ? BVAR (current_buffer, bidi_paragraph_start_re)
+ : paragraph_start_re;
ptrdiff_t limit = ZV, limit_byte = ZV_BYTE;
struct region_cache *bpc = bidi_paragraph_cache_on_off ();
ptrdiff_t n = 0, oldpos = pos, next;
@@ -2468,9 +2475,11 @@ typedef struct bpa_stack_entry {
unsigned flags : 2;
} bpa_stack_entry;
-/* With MAX_ALLOCA of 16KB, this should allow at least 1K slots in the
+/* Allow for the two struct bidi_it objects too, since they can be big.
+ With MAX_ALLOCA of 16 KiB, this should allow at least 900 slots in the
BPA stack, which should be more than enough for actual bidi text. */
-#define MAX_BPA_STACK ((int)max (MAX_ALLOCA / sizeof (bpa_stack_entry), 1))
+enum { MAX_BPA_STACK = max (1, ((MAX_ALLOCA - 2 * sizeof (struct bidi_it))
+ / sizeof (bpa_stack_entry))) };
/* UAX#9 says to match opening brackets with the matching closing
brackets or their canonical equivalents. As of Unicode 8.0, there
@@ -2517,7 +2526,7 @@ typedef struct bpa_stack_entry {
#define PUSH_BPA_STACK \
do { \
int ch; \
- if (bpa_sp < MAX_BPA_STACK - 1) \
+ if (bpa_sp < MAX_BPA_STACK - 1 && bidi_cache_last_idx <= INT_MAX) \
{ \
bpa_sp++; \
ch = CANONICAL_EQU (bidi_it->ch); \
@@ -2563,7 +2572,7 @@ bidi_find_bracket_pairs (struct bidi_it *bidi_it)
ptrdiff_t pairing_pos;
int idx_at_entry = bidi_cache_idx;
- eassert (MAX_BPA_STACK >= 100);
+ verify (MAX_BPA_STACK >= 100);
bidi_copy_it (&saved_it, bidi_it);
/* bidi_cache_iterator_state refuses to cache on backward scans,
and bidi_cache_fetch_state doesn't bring scan_dir from the
@@ -3498,10 +3507,16 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it)
if (sep_len >= 0)
{
bidi_it->new_paragraph = 1;
- /* Record the buffer position of the last character of the
- paragraph separator. */
- bidi_it->separator_limit
- = bidi_it->charpos + bidi_it->nchars + sep_len;
+ /* Record the buffer position of the last character of
+ the paragraph separator. If the paragraph separator
+ is an empty string (e.g., the regex is "^"), the
+ newline that precedes the end of the paragraph is
+ that last character. */
+ if (sep_len > 0)
+ bidi_it->separator_limit
+ = bidi_it->charpos + bidi_it->nchars + sep_len;
+ else
+ bidi_it->separator_limit = bidi_it->charpos;
}
}
}
diff --git a/src/blockinput.h b/src/blockinput.h
index d57c5bae2af..1ca3b47c96b 100644
--- a/src/blockinput.h
+++ b/src/blockinput.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_BLOCKINPUT_H
#define EMACS_BLOCKINPUT_H
diff --git a/src/buffer.c b/src/buffer.c
index 80dbd3318dc..12a467daae4 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -61,7 +61,7 @@ struct buffer *all_buffers;
Setting the default value also goes through the alist of buffers
and stores into each buffer that does not say it has a local value. */
-struct buffer alignas (GCALIGNMENT) buffer_defaults;
+struct buffer buffer_defaults;
/* This structure marks which slots in a buffer have corresponding
default values in buffer_defaults.
@@ -84,7 +84,7 @@ struct buffer buffer_local_flags;
/* This structure holds the names of symbols whose values may be
buffer-local. It is indexed and accessed in the same way as the above. */
-struct buffer alignas (GCALIGNMENT) buffer_local_symbols;
+struct buffer buffer_local_symbols;
/* Return the symbol of the per-buffer variable at offset OFFSET in
the buffer structure. */
@@ -173,6 +173,16 @@ bset_bidi_display_reordering (struct buffer *b, Lisp_Object val)
b->bidi_display_reordering_ = val;
}
static void
+bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val)
+{
+ b->bidi_paragraph_start_re_ = val;
+}
+static void
+bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val)
+{
+ b->bidi_paragraph_separate_re_ = val;
+}
+static void
bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val)
{
b->buffer_file_coding_system_ = val;
@@ -1011,7 +1021,8 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
newlist = Fcons (elt, newlist);
}
newlist = Fnreverse (newlist);
- if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
+ if (XSYMBOL (local_var)->u.s.trapped_write
+ == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (local_var, newlist,
Qmakunbound, Fcurrent_buffer ());
XSETCDR (XCAR (tmp), newlist);
@@ -1024,7 +1035,7 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too)
else
XSETCDR (last, XCDR (tmp));
- if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE)
+ if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (local_var, Qnil,
Qmakunbound, Fcurrent_buffer ());
}
@@ -1067,16 +1078,20 @@ is first appended to NAME, to speed up finding a non-existent buffer. */)
CHECK_STRING (name);
- if (!NILP (Fstring_equal (name, ignore)) || NILP (Fget_buffer (name)))
+ if ((!NILP (ignore) && !NILP (Fstring_equal (name, ignore)))
+ || NILP (Fget_buffer (name)))
return name;
if (SREF (name, 0) != ' ') /* See bug#1229. */
genbase = name;
else
{
- /* Note fileio.c:make_temp_name does random differently. */
char number[sizeof "-999999"];
- int i = XFASTINT (Frandom (make_number (999999)));
+
+ /* Use XINT instead of XFASTINT to work around GCC bug 80776. */
+ int i = XINT (Frandom (make_number (1000000)));
+ eassume (0 <= i && i < 1000000);
+
AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i));
genbase = concat2 (name, lnumber);
if (NILP (Fget_buffer (genbase)))
@@ -1156,7 +1171,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
sym = XSYMBOL (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
@@ -1164,7 +1179,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
{ /* Look in local_var_alist. */
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
- result = Fassoc (variable, BVAR (buf, local_var_alist));
+ result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
if (!NILP (result))
{
if (blv->fwd)
@@ -2086,7 +2101,7 @@ void set_buffer_internal_2 (register struct buffer *b)
{
Lisp_Object var = XCAR (XCAR (tail));
struct Lisp_Symbol *sym = XSYMBOL (var);
- if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */
+ if (sym->u.s.redirect == SYMBOL_LOCALIZED /* Just to be sure. */
&& SYMBOL_BLV (sym)->fwd)
/* Just reference the variable
to cause it to become set for this buffer. */
@@ -2322,6 +2337,8 @@ results, see Info node `(elisp)Swapping Text'. */)
swapfield_ (enable_multibyte_characters, Lisp_Object);
swapfield_ (bidi_display_reordering, Lisp_Object);
swapfield_ (bidi_paragraph_direction, Lisp_Object);
+ swapfield_ (bidi_paragraph_separate_re, Lisp_Object);
+ swapfield_ (bidi_paragraph_start_re, Lisp_Object);
/* FIXME: Not sure what we should do with these *_marker fields.
Hopefully they're just nil anyway. */
swapfield_ (pt_marker, Lisp_Object);
@@ -2740,7 +2757,7 @@ swap_out_buffer_local_variables (struct buffer *b)
for (alist = oalist; CONSP (alist); alist = XCDR (alist))
{
Lisp_Object sym = XCAR (XCAR (alist));
- eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
+ eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED);
/* Need not do anything if some other buffer's binding is
now cached. */
if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
@@ -3054,6 +3071,33 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
return i < n;
}
+/* Return the value of the 'display-line-numbers-disable' property at
+ EOB, if there's an overlay at ZV with a non-nil value of that property. */
+Lisp_Object
+disable_line_numbers_overlay_at_eob (void)
+{
+ ptrdiff_t n, i, size;
+ Lisp_Object *v, tem = Qnil;
+ Lisp_Object vbuf[10];
+ USE_SAFE_ALLOCA;
+
+ size = ARRAYELTS (vbuf);
+ v = vbuf;
+ n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL);
+ if (n > size)
+ {
+ SAFE_NALLOCA (v, 1, n);
+ overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL);
+ }
+
+ for (i = 0; i < n; ++i)
+ if ((tem = Foverlay_get (v[i], Qdisplay_line_numbers_disable),
+ !NILP (tem)))
+ break;
+
+ SAFE_FREE ();
+ return tem;
+}
/* Fast function to just test if we're at an overlay boundary. */
@@ -3577,8 +3621,8 @@ void
fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
{
Lisp_Object overlay;
- struct Lisp_Overlay *before_list;
- struct Lisp_Overlay *after_list;
+ struct Lisp_Overlay *before_list UNINIT;
+ struct Lisp_Overlay *after_list UNINIT;
/* These are either nil, indicating that before_list or after_list
should be assigned, or the cons cell the cdr of which should be
assigned. */
@@ -3725,7 +3769,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
/* If parent is nil, replace overlays_before; otherwise, parent->next. */
struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
Lisp_Object tem;
- ptrdiff_t end;
+ ptrdiff_t end UNINIT;
/* After the insertion, the several overlays may be in incorrect
order. The possibility is that, in the list `overlays_before',
@@ -4140,6 +4184,12 @@ If SORTED is non-nil, then sort them by decreasing priority. */)
/* Make a list of them all. */
result = Flist (noverlays, overlay_vec);
+ /* The doc string says the list should be in decreasing order of
+ priority, so we reverse the list, because sort_overlays sorts in
+ the increasing order of priority. */
+ if (!NILP (sorted))
+ result = Fnreverse (result);
+
xfree (overlay_vec);
return result;
}
@@ -5033,6 +5083,8 @@ init_buffer_once (void)
{
int idx;
+ /* Items flagged permanent get an explicit permanent-local property
+ added in bindings.el, for clarity. */
memset (buffer_permanent_local_flags, 0, sizeof buffer_permanent_local_flags);
/* 0 means not a lisp var, -1 means always local, else mask. */
@@ -5082,7 +5134,9 @@ init_buffer_once (void)
XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx;
- XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx;
+ XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx);
+ /* Make this one a permanent local. */
+ buffer_permanent_local_flags[idx++] = 1;
XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx;
@@ -5094,6 +5148,8 @@ init_buffer_once (void)
XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx;
+ XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_separate_re), idx); ++idx;
+ XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_start_re), idx); ++idx;
XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx);
/* Make this one a permanent local. */
buffer_permanent_local_flags[idx++] = 1;
@@ -5175,6 +5231,8 @@ init_buffer_once (void)
bset_ctl_arrow (&buffer_defaults, Qt);
bset_bidi_display_reordering (&buffer_defaults, Qt);
bset_bidi_paragraph_direction (&buffer_defaults, Qnil);
+ bset_bidi_paragraph_start_re (&buffer_defaults, Qnil);
+ bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil);
bset_cursor_type (&buffer_defaults, Qt);
bset_extra_line_spacing (&buffer_defaults, Qnil);
bset_cursor_in_non_selected_windows (&buffer_defaults, Qt);
@@ -5374,8 +5432,8 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring,
bo_fwd->type = Lisp_Fwd_Buffer_Obj;
bo_fwd->offset = offset;
bo_fwd->predicate = predicate;
- sym->declared_special = 1;
- sym->redirect = SYMBOL_FORWARDED;
+ sym->u.s.declared_special = true;
+ sym->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd);
XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);
@@ -5564,6 +5622,8 @@ file I/O and the behavior of various editing commands.
This variable is buffer-local but you cannot set it directly;
use the function `set-buffer-multibyte' to change a buffer's representation.
+To prevent any attempts to set it or make it buffer-local, Emacs will
+signal an error in those cases.
See also Info node `(elisp)Text Representations'. */);
make_symbol_constant (intern_c_string ("enable-multibyte-characters"));
@@ -5589,6 +5649,49 @@ This variable is never applied to a way of decoding a file while reading it. */
&BVAR (current_buffer, bidi_display_reordering), Qnil,
doc: /* Non-nil means reorder bidirectional text for display in the visual order. */);
+ DEFVAR_PER_BUFFER ("bidi-paragraph-start-re",
+ &BVAR (current_buffer, bidi_paragraph_start_re), Qnil,
+ doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs.
+
+The value of nil means to use empty lines as lines that start and
+separate paragraphs.
+
+When Emacs displays bidirectional text, it by default computes
+the base paragraph direction separately for each paragraph.
+Setting this variable changes the places where paragraph base
+direction is recomputed.
+
+The regexp is always matched after a newline, so it is best to
+anchor it by beginning it with a "^".
+
+If you change the value of this variable, be sure to change
+the value of `bidi-paragraph-separate-re' accordingly. For
+example, to have a single newline behave as a paragraph separator,
+set both these variables to "^".
+
+See also `bidi-paragraph-direction'. */);
+
+ DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re",
+ &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil,
+ doc: /* If non-nil, a regexp matching a line that separates paragraphs.
+
+The value of nil means to use empty lines as paragraph separators.
+
+When Emacs displays bidirectional text, it by default computes
+the base paragraph direction separately for each paragraph.
+Setting this variable changes the places where paragraph base
+direction is recomputed.
+
+The regexp is always matched after a newline, so it is best to
+anchor it by beginning it with a "^".
+
+If you change the value of this variable, be sure to change
+the value of `bidi-paragraph-start-re' accordingly. For
+example, to have a single newline behave as a paragraph separator,
+set both these variables to "^".
+
+See also `bidi-paragraph-direction'. */);
+
DEFVAR_PER_BUFFER ("bidi-paragraph-direction",
&BVAR (current_buffer, bidi_paragraph_direction), Qnil,
doc: /* If non-nil, forces directionality of text paragraphs in the buffer.
@@ -5624,7 +5727,7 @@ word-wrapping, you might want to reduce the value of
in narrower windows.
Instead of setting this variable directly, most users should use
-Visual Line mode . Visual Line mode, when enabled, sets `word-wrap'
+Visual Line mode. Visual Line mode, when enabled, sets `word-wrap'
to t, and additionally redefines simple editing commands to act on
visual lines rather than logical lines. See the documentation of
`visual-line-mode'. */);
@@ -5962,7 +6065,7 @@ and is the visited file's modification time, as of that time. If the
modification time of the most recent save is different, this entry is
obsolete.
-An entry (t . 0) means means the buffer was previously unmodified but
+An entry (t . 0) means the buffer was previously unmodified but
its time stamp was unknown because it was not associated with a file.
An entry (t . -1) is similar, except that it means the buffer's visited
file did not exist.
diff --git a/src/buffer.h b/src/buffer.h
index be270fe4823..46c7c6e5ad6 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_BUFFER_H
#define EMACS_BUFFER_H
@@ -504,7 +504,7 @@ struct buffer_text
struct buffer
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The name of this buffer. */
Lisp_Object name_;
@@ -611,6 +611,12 @@ struct buffer
direction dynamically for each paragraph. */
Lisp_Object bidi_paragraph_direction_;
+ /* If non-nil, a regular expression for bidi paragraph separator. */
+ Lisp_Object bidi_paragraph_separate_re_;
+
+ /* If non-nil, a regular expression for bidi paragraph start. */
+ Lisp_Object bidi_paragraph_start_re_;
+
/* Non-nil means do selective display;
see doc string in syms_of_buffer (buffer.c) for details. */
Lisp_Object selective_display_;
diff --git a/src/bytecode.c b/src/bytecode.c
index e781a87d16f..8746568f166 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -452,14 +452,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
the table clearer. */
#define LABEL(OP) [OP] = &&insn_ ## OP
-#if GNUC_PREREQ (4, 6, 0)
-# pragma GCC diagnostic push
-# pragma GCC diagnostic ignored "-Woverride-init"
-#elif defined __clang__
-# pragma GCC diagnostic push
-# pragma GCC diagnostic ignored "-Winitializer-overrides"
-#endif
-
/* This is the dispatch table for the threaded interpreter. */
static const void *const targets[256] =
{
@@ -471,10 +463,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
#undef DEFINE
};
-#if GNUC_PREREQ (4, 6, 0) || defined __clang__
-# pragma GCC diagnostic pop
-#endif
-
#endif
@@ -501,7 +489,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
{
Lisp_Object v1 = vectorp[op], v2;
if (!SYMBOLP (v1)
- || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
+ || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL
|| (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound)))
v2 = Fsymbol_value (v1);
PUSH (v2);
@@ -570,7 +558,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Inline the most common case. */
if (SYMBOLP (sym)
&& !EQ (val, Qunbound)
- && !XSYMBOL (sym)->redirect
+ && !XSYMBOL (sym)->u.s.redirect
&& !SYMBOL_TRAPPED_WRITE_P (sym))
SET_SYMBOL_VAL (XSYMBOL (sym), val);
else
@@ -1358,10 +1346,8 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
/* CASE (Bstack_ref): */
- call3 (Qerror,
- build_string ("Invalid byte opcode: op=%s, ptr=%d"),
- make_number (op),
- make_number (pc - 1 - bytestr_data));
+ error ("Invalid byte opcode: op=%d, ptr=%"pD"d",
+ op, pc - 1 - bytestr_data);
/* Handy byte-codes for lexical binding. */
CASE (Bstack_ref1):
diff --git a/src/callint.c b/src/callint.c
index 96436116c8b..5d88082e38d 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -272,7 +272,7 @@ invoke it. If KEYS is omitted or nil, the return value of
{
/* `args' will contain the array of arguments to pass to the function.
`visargs' will contain the same list but in a nicer form, so that if we
- pass it to `Fformat_message' it will be understandable to a human. */
+ pass it to Fformat_message it will be understandable to a human. */
Lisp_Object *args, *visargs;
Lisp_Object specs;
Lisp_Object filter_specs;
@@ -502,10 +502,7 @@ invoke it. If KEYS is omitted or nil, the return value of
for (i = 2; *tem; i++)
{
visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
- if (strchr (SSDATA (visargs[1]), '%'))
- callint_message = Fformat_message (i - 1, visargs + 1);
- else
- callint_message = visargs[1];
+ callint_message = Fformat_message (i - 1, visargs + 1);
switch (*tem)
{
diff --git a/src/callproc.c b/src/callproc.c
index 4cec02be7ef..6e16ca78790 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -120,7 +120,7 @@ encode_current_directory (void)
if (NILP (dir))
dir = build_string ("~");
- dir = expand_and_dir_to_file (dir, Qnil);
+ dir = expand_and_dir_to_file (dir);
if (NILP (Ffile_accessible_directory_p (dir)))
report_file_error ("Setting current directory",
@@ -634,7 +634,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int filefd,
#ifdef DARWIN_OS
/* Work around a macOS bug, where SIGCHLD is apparently
delivered to a vforked child instead of to its parent. See:
- http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00342.html
+ https://lists.gnu.org/r/emacs-devel/2017-05/msg00342.html
*/
signal (SIGCHLD, SIG_DFL);
#endif
diff --git a/src/casefiddle.c b/src/casefiddle.c
index 443d62b6259..7b34f78a5c9 100644
--- a/src/casefiddle.c
+++ b/src/casefiddle.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -133,9 +133,9 @@ case_character_impl (struct casing_str_buf *buf,
struct Lisp_String *str = XSTRING (prop);
if (STRING_BYTES (str) <= sizeof buf->data)
{
- buf->len_chars = str->size;
+ buf->len_chars = str->u.s.size;
buf->len_bytes = STRING_BYTES (str);
- memcpy (buf->data, str->data, buf->len_bytes);
+ memcpy (buf->data, str->u.s.data, buf->len_bytes);
return 1;
}
}
diff --git a/src/casetab.c b/src/casetab.c
index 6108bb680bb..924bf9a527f 100644
--- a/src/casetab.c
+++ b/src/casetab.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/category.c b/src/category.c
index b633f65532a..eced906584e 100644
--- a/src/category.c
+++ b/src/category.c
@@ -22,7 +22,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Here we handle three objects: category, category set, and category
diff --git a/src/category.h b/src/category.h
index 247f9093d09..c4feedd358f 100644
--- a/src/category.h
+++ b/src/category.h
@@ -20,7 +20,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_CATEGORY_H
#define EMACS_CATEGORY_H
diff --git a/src/ccl.c b/src/ccl.c
index b2caf413f7a..dc7afc5ef6f 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -21,7 +21,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -730,7 +730,7 @@ while (0)
#endif
/* Use "&" rather than "&&" to suppress a bogus GCC warning; see
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43772>. */
#define ASCENDING_ORDER(lo, med, hi) (((lo) <= (med)) & ((med) <= (hi)))
#define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \
diff --git a/src/ccl.h b/src/ccl.h
index 10860f509d4..8eb9d7eb2e8 100644
--- a/src/ccl.h
+++ b/src/ccl.h
@@ -20,7 +20,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_CCL_H
diff --git a/src/character.c b/src/character.c
index cf460540725..c8ffa2b2cd5 100644
--- a/src/character.c
+++ b/src/character.c
@@ -20,7 +20,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* At first, see the document in `character.h' to understand the code
in this file. */
@@ -1050,9 +1050,26 @@ blankp (int c)
return XINT (category) == UNICODE_CATEGORY_Zs; /* separator, space */
}
+signed char HEXDIGIT_CONST hexdigit[UCHAR_MAX + 1] =
+ {
+#if HEXDIGIT_IS_CONST
+ [0 ... UCHAR_MAX] = -1,
+#endif
+ ['0'] = 0, ['1'] = 1, ['2'] = 2, ['3'] = 3, ['4'] = 4,
+ ['5'] = 5, ['6'] = 6, ['7'] = 7, ['8'] = 8, ['9'] = 9,
+ ['A'] = 10, ['B'] = 11, ['C'] = 12, ['D'] = 13, ['E'] = 14, ['F'] = 15,
+ ['a'] = 10, ['b'] = 11, ['c'] = 12, ['d'] = 13, ['e'] = 14, ['f'] = 15
+ };
+
void
syms_of_character (void)
{
+#if !HEXDIGIT_IS_CONST
+ /* Set the non-hex digit values to -1. */
+ for (int i = 0; i <= UCHAR_MAX; i++)
+ hexdigit[i] -= i != '0' && !hexdigit[i];
+#endif
+
DEFSYM (Qcharacterp, "characterp");
DEFSYM (Qauto_fill_chars, "auto-fill-chars");
diff --git a/src/character.h b/src/character.h
index 62d252e91ba..c716885d46b 100644
--- a/src/character.h
+++ b/src/character.h
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_CHARACTER_H
#define EMACS_CHARACTER_H
@@ -700,6 +700,24 @@ char_table_translate (Lisp_Object obj, int ch)
return CHARACTERP (obj) ? XINT (obj) : ch;
}
+#if defined __GNUC__ && !defined __STRICT_ANSI__
+# define HEXDIGIT_CONST const
+# define HEXDIGIT_IS_CONST true
+#else
+# define HEXDIGIT_CONST
+# define HEXDIGIT_IS_CONST false
+#endif
+extern signed char HEXDIGIT_CONST hexdigit[];
+
+/* If C is a hexadecimal digit ('0'-'9', 'a'-'f', 'A'-'F'), return its
+ value (0-15). Otherwise return -1. */
+
+INLINE int
+char_hexdigit (int c)
+{
+ return 0 <= c && c <= UCHAR_MAX ? hexdigit[c] : -1;
+}
+
INLINE_HEADER_END
#endif /* EMACS_CHARACTER_H */
diff --git a/src/charset.c b/src/charset.c
index f0b41400843..ab207eaa1b6 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -24,22 +24,21 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
-#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <limits.h>
#include <sys/types.h>
-#include <c-ctype.h>
#include "lisp.h"
#include "character.h"
#include "charset.h"
#include "coding.h"
#include "buffer.h"
+#include "sysstdio.h"
/*** GENERAL NOTES on CODED CHARACTER SETS (CHARSETS) ***
@@ -408,43 +407,49 @@ load_charset_map (struct charset *charset, struct charset_map_entries *entries,
/* Read a hexadecimal number (preceded by "0x") from the file FP while
- paying attention to comment character '#'. */
+ paying attention to comment character '#'. LOOKAHEAD is the
+ lookahead byte if it is nonnegative. Store into *TERMINATOR the
+ input byte after the number, or EOF if an end-of-file or input
+ error occurred. Set *OVERFLOW if the number overflows. */
static unsigned
-read_hex (FILE *fp, bool *eof, bool *overflow)
+read_hex (FILE *fp, int lookahead, int *terminator, bool *overflow)
{
- int c;
- unsigned n;
+ int c = lookahead < 0 ? getc_unlocked (fp) : lookahead;
- while ((c = getc (fp)) != EOF)
+ while (true)
{
if (c == '#')
- {
- while ((c = getc (fp)) != EOF && c != '\n');
- }
+ do
+ c = getc_unlocked (fp);
+ while (0 <= c && c != '\n');
else if (c == '0')
{
- if ((c = getc (fp)) == EOF || c == 'x')
+ c = getc_unlocked (fp);
+ if (c < 0 || c == 'x')
break;
}
+ if (c < 0)
+ break;
+ c = getc_unlocked (fp);
}
- if (c == EOF)
- {
- *eof = 1;
- return 0;
- }
- n = 0;
- while (c_isxdigit (c = getc (fp)))
- {
- if (INT_LEFT_SHIFT_OVERFLOW (n, 4))
- *overflow = 1;
- n = ((n << 4)
- | (c - ('0' <= c && c <= '9' ? '0'
- : 'A' <= c && c <= 'F' ? 'A' - 10
- : 'a' - 10)));
- }
- if (c != EOF)
- ungetc (c, fp);
+
+ unsigned n = 0;
+ bool v = false;
+
+ if (0 <= c)
+ while (true)
+ {
+ c = getc_unlocked (fp);
+ int digit = char_hexdigit (c);
+ if (digit < 0)
+ break;
+ v |= INT_LEFT_SHIFT_OVERFLOW (n, 4);
+ n = (n << 4) + digit;
+ }
+
+ *terminator = c;
+ *overflow |= v;
return n;
}
@@ -499,23 +504,26 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
memset (entries, 0, sizeof (struct charset_map_entries));
n_entries = 0;
- while (1)
+ int ch = -1;
+ while (true)
{
- unsigned from, to, c;
- int idx;
- bool eof = 0, overflow = 0;
-
- from = read_hex (fp, &eof, &overflow);
- if (eof)
+ bool overflow = false;
+ unsigned from = read_hex (fp, ch, &ch, &overflow), to;
+ if (ch < 0)
break;
- if (getc (fp) == '-')
- to = read_hex (fp, &eof, &overflow);
+ if (ch == '-')
+ {
+ to = read_hex (fp, -1, &ch, &overflow);
+ if (ch < 0)
+ break;
+ }
else
- to = from;
- if (eof)
- break;
- c = read_hex (fp, &eof, &overflow);
- if (eof)
+ {
+ to = from;
+ ch = -1;
+ }
+ unsigned c = read_hex (fp, ch, &ch, &overflow);
+ if (ch < 0)
break;
if (overflow)
@@ -530,7 +538,7 @@ load_charset_map_from_file (struct charset *charset, Lisp_Object mapfile,
memset (entries, 0, sizeof (struct charset_map_entries));
n_entries = 0;
}
- idx = n_entries;
+ int idx = n_entries;
entries->entry[idx].from = from;
entries->entry[idx].to = to;
entries->entry[idx].c = c;
diff --git a/src/charset.h b/src/charset.h
index a26d64343d7..2b6875ce3fc 100644
--- a/src/charset.h
+++ b/src/charset.h
@@ -22,7 +22,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_CHARSET_H
#define EMACS_CHARSET_H
diff --git a/src/chartab.c b/src/chartab.c
index 8392c0c07dc..065ae4f9f20 100644
--- a/src/chartab.c
+++ b/src/chartab.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/cm.c b/src/cm.c
index efa50b0f58d..f3f41549b27 100644
--- a/src/cm.c
+++ b/src/cm.c
@@ -15,14 +15,14 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
-#include <stdio.h>
#include "lisp.h"
#include "cm.h"
+#include "sysstdio.h"
#include "termchar.h"
#include "tparam.h"
@@ -45,8 +45,8 @@ int
cmputc (int c)
{
if (current_tty->termscript)
- putc (c & 0177, current_tty->termscript);
- putc (c & 0177, current_tty->output);
+ putc_unlocked (c & 0177, current_tty->termscript);
+ putc_unlocked (c & 0177, current_tty->output);
return c;
}
@@ -117,11 +117,11 @@ cmcheckmagic (struct tty_display_info *tty)
if (!MagicWrap (tty) || curY (tty) >= FrameRows (tty) - 1)
emacs_abort ();
if (tty->termscript)
- putc ('\r', tty->termscript);
- putc ('\r', tty->output);
+ putc_unlocked ('\r', tty->termscript);
+ putc_unlocked ('\r', tty->output);
if (tty->termscript)
- putc ('\n', tty->termscript);
- putc ('\n', tty->output);
+ putc_unlocked ('\n', tty->termscript);
+ putc_unlocked ('\n', tty->output);
curX (tty) = 0;
curY (tty)++;
}
diff --git a/src/cm.h b/src/cm.h
index 83ef512c99d..1002672db7b 100644
--- a/src/cm.h
+++ b/src/cm.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_CM_H
#define EMACS_CM_H
diff --git a/src/cmds.c b/src/cmds.c
index 51652d542a8..6a7a0fa50a1 100644
--- a/src/cmds.c
+++ b/src/cmds.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -268,9 +268,10 @@ Whichever character you type to run this command is inserted.
The numeric prefix argument N says how many times to repeat the insertion.
Before insertion, `expand-abbrev' is executed if the inserted character does
not have word syntax and the previous character in the buffer does.
-After insertion, the value of `auto-fill-function' is called if the
-`auto-fill-chars' table has a non-nil value for the inserted character.
-At the end, it runs `post-self-insert-hook'. */)
+After insertion, `internal-auto-fill' is called if
+`auto-fill-function' is non-nil and if the `auto-fill-chars' table has
+a non-nil value for the inserted character. At the end, it runs
+`post-self-insert-hook'. */)
(Lisp_Object n)
{
CHECK_NUMBER (n);
@@ -420,11 +421,11 @@ internal_self_insert (int c, EMACS_INT n)
and the hook has a non-nil `no-self-insert' property,
return right away--don't really self-insert. */
if (SYMBOLP (sym) && ! NILP (sym)
- && ! NILP (XSYMBOL (sym)->function)
- && SYMBOLP (XSYMBOL (sym)->function))
+ && ! NILP (XSYMBOL (sym)->u.s.function)
+ && SYMBOLP (XSYMBOL (sym)->u.s.function))
{
Lisp_Object prop;
- prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert"));
+ prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert"));
if (! NILP (prop))
return 1;
}
@@ -438,12 +439,13 @@ internal_self_insert (int c, EMACS_INT n)
int mc = ((NILP (BVAR (current_buffer, enable_multibyte_characters))
&& SINGLE_BYTE_CHAR_P (c))
? UNIBYTE_TO_CHAR (c) : c);
- Lisp_Object string = Fmake_string (make_number (n), make_number (mc));
+ Lisp_Object string = Fmake_string (make_number (n), make_number (mc),
+ Qnil);
if (spaces_to_insert)
{
tem = Fmake_string (make_number (spaces_to_insert),
- make_number (' '));
+ make_number (' '), Qnil);
string = concat2 (string, tem);
}
@@ -475,7 +477,7 @@ internal_self_insert (int c, EMACS_INT n)
that. Must have the newline in place already so filling and
justification, if any, know where the end is going to be. */
SET_PT_BOTH (PT - 1, PT_BYTE - 1);
- auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function));
+ auto_fill_result = call0 (Qinternal_auto_fill);
/* Test PT < ZV in case the auto-fill-function is strange. */
if (c == '\n' && PT < ZV)
SET_PT_BOTH (PT + 1, PT_BYTE + 1);
@@ -494,6 +496,8 @@ internal_self_insert (int c, EMACS_INT n)
void
syms_of_cmds (void)
{
+ DEFSYM (Qinternal_auto_fill, "internal-auto-fill");
+
DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate");
DEFSYM (Qundo_auto__this_command_amalgamating,
"undo-auto--this-command-amalgamating");
diff --git a/src/coding.c b/src/coding.c
index 5682fc015ad..1705838ffad 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -21,7 +21,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*** TABLE OF CONTENTS ***
@@ -10236,7 +10236,7 @@ usage: (define-coding-system-internal ...) */)
ASET (attrs, coding_attr_ccl_encoder, val);
val = args[coding_arg_ccl_valids];
- valids = Fmake_string (make_number (256), make_number (0));
+ valids = Fmake_string (make_number (256), make_number (0), Qnil);
for (tail = val; CONSP (tail); tail = XCDR (tail))
{
int from, to;
@@ -10539,7 +10539,7 @@ usage: (define-coding-system-internal ...) */)
ASET (this_spec, 2, this_eol_type);
Fputhash (this_name, this_spec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
- val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
+ val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist
= Fcons (Fcons (Fsymbol_name (this_name), Qnil),
@@ -10554,7 +10554,7 @@ usage: (define-coding-system-internal ...) */)
Fputhash (name, spec_vec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (name, Vcoding_system_list);
- val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
+ val = Fassoc (Fsymbol_name (name), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
Vcoding_system_alist);
@@ -10662,7 +10662,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
Fputhash (alias, spec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (alias, Vcoding_system_list);
- val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
+ val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
Vcoding_system_alist);
diff --git a/src/coding.h b/src/coding.h
index 8ed851d99ff..66d125b07e6 100644
--- a/src/coding.h
+++ b/src/coding.h
@@ -21,7 +21,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_CODING_H
#define EMACS_CODING_H
diff --git a/src/commands.h b/src/commands.h
index 03e1b73e981..5dc1100294e 100644
--- a/src/commands.h
+++ b/src/commands.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_COMMANDS_H
#define EMACS_COMMANDS_H
diff --git a/src/composite.c b/src/composite.c
index 05a296329a6..650bf8708b3 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -20,7 +20,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -686,6 +686,20 @@ composition_gstring_from_id (ptrdiff_t id)
return HASH_VALUE (h, id);
}
+DEFUN ("clear-composition-cache", Fclear_composition_cache,
+ Sclear_composition_cache, 0, 0, 0,
+ doc: /* Internal use only.
+Clear composition cache. */)
+ (void)
+{
+ Lisp_Object args[] = {QCtest, Qequal, QCsize, make_number (311)};
+ gstring_hash_table = CALLMANY (Fmake_hash_table, args);
+ /* Fixme: We call Fclear_face_cache to force complete re-building of
+ display glyphs. But, it may be better to call this function from
+ Fclear_face_cache instead. */
+ return Fclear_face_cache (Qt);
+}
+
bool
composition_gstring_p (Lisp_Object gstring)
{
@@ -1982,4 +1996,5 @@ See also the documentation of `auto-composition-mode'. */);
defsubr (&Scompose_string_internal);
defsubr (&Sfind_composition_internal);
defsubr (&Scomposition_get_gstring);
+ defsubr (&Sclear_composition_cache);
}
diff --git a/src/composite.h b/src/composite.h
index dc1e7ce3457..7f0cc1cd350 100644
--- a/src/composite.h
+++ b/src/composite.h
@@ -20,7 +20,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_COMPOSITE_H
#define EMACS_COMPOSITE_H
diff --git a/src/conf_post.h b/src/conf_post.h
index e1d6a9397d3..4c9eb32aba3 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Put the code here rather than in configure.ac using AH_BOTTOM.
This way, the code does not get processed by autoheader. For
@@ -31,7 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdbool.h>
-#if defined DOS_NT && !defined DEFER_MS_W32_H
+#if defined WINDOWSNT && !defined DEFER_MS_W32_H
# include <ms-w32.h>
#endif
@@ -255,7 +255,27 @@ extern int emacs_setenv_TZ (char const *);
#if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__
# define PRINTF_ARCHETYPE __gnu_printf__
#elif GNUC_PREREQ (4, 4, 0) && defined __MINGW32__
-# define PRINTF_ARCHETYPE __ms_printf__
+# ifdef MINGW_W64
+/* When __USE_MINGW_ANSI_STDIO is non-zero (as set by config.h),
+ MinGW64 replaces printf* with its own versions that are
+ __gnu_printf__ compatible, and emits warnings for MS native %I64d
+ format spec. */
+# if __USE_MINGW_ANSI_STDIO
+# define PRINTF_ARCHETYPE __gnu_printf__
+# else
+# define PRINTF_ARCHETYPE __ms_printf__
+# endif
+# else /* mingw.org's MinGW */
+/* Starting from runtime v5.0.0, mingw.org's MinGW with GCC 6 and
+ later turns on __USE_MINGW_ANSI_STDIO by default, replaces printf*
+ with its own __mingw_printf__ version, which still recognizes
+ %I64d. */
+# if GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5
+# define PRINTF_ARCHETYPE __mingw_printf__
+# else /* __MINGW32_MAJOR_VERSION < 5 */
+# define PRINTF_ARCHETYPE __ms_printf__
+# endif /* __MINGW32_MAJOR_VERSION < 5 */
+# endif /* MinGW */
#else
# define PRINTF_ARCHETYPE __printf__
#endif
diff --git a/src/cygw32.c b/src/cygw32.c
index 962b6a2f8b5..724363d64c4 100644
--- a/src/cygw32.c
+++ b/src/cygw32.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "cygw32.h"
diff --git a/src/cygw32.h b/src/cygw32.h
index a10b830e6b6..f006c112d8f 100644
--- a/src/cygw32.h
+++ b/src/cygw32.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef CYGW32_H
#define CYGW32_H
diff --git a/src/data.c b/src/data.c
index 559844b03fd..3c9152049b7 100644
--- a/src/data.c
+++ b/src/data.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -670,7 +670,7 @@ global value outside of any lexical scope. */)
sym = XSYMBOL (symbol);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break;
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
@@ -704,10 +704,10 @@ global value outside of any lexical scope. */)
expect `t' in particular, rather than any true value. */
DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
doc: /* Return t if SYMBOL's function definition is not void. */)
- (register Lisp_Object symbol)
+ (Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt;
+ return NILP (XSYMBOL (symbol)->u.s.function) ? Qnil : Qt;
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
@@ -736,18 +736,18 @@ Return SYMBOL. */)
DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
doc: /* Return SYMBOL's function definition, or nil if that is void. */)
- (register Lisp_Object symbol)
+ (Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return XSYMBOL (symbol)->function;
+ return XSYMBOL (symbol)->u.s.function;
}
DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
doc: /* Return SYMBOL's property list. */)
- (register Lisp_Object symbol)
+ (Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return XSYMBOL (symbol)->plist;
+ return XSYMBOL (symbol)->u.s.plist;
}
DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
@@ -771,7 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
if (NILP (symbol))
xsignal1 (Qsetting_constant, symbol);
- function = XSYMBOL (symbol)->function;
+ function = XSYMBOL (symbol)->u.s.function;
if (!NILP (Vautoload_queue) && !NILP (function))
Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
@@ -814,7 +814,7 @@ The return value is undefined. */)
{ /* Only add autoload entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
- if (AUTOLOADP (XSYMBOL (symbol)->function))
+ if (AUTOLOADP (XSYMBOL (symbol)->u.s.function))
/* Remember that the function was already an autoload. */
LOADHIST_ATTACH (Fcons (Qt, symbol));
LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
@@ -940,10 +940,10 @@ indirect_variable (struct Lisp_Symbol *symbol)
hare = tortoise = symbol;
- while (hare->redirect == SYMBOL_VARALIAS)
+ while (hare->u.s.redirect == SYMBOL_VARALIAS)
{
hare = SYMBOL_ALIAS (hare);
- if (hare->redirect != SYMBOL_VARALIAS)
+ if (hare->u.s.redirect != SYMBOL_VARALIAS)
break;
hare = SYMBOL_ALIAS (hare);
@@ -1247,7 +1247,7 @@ find_symbol_value (Lisp_Object symbol)
sym = XSYMBOL (symbol);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
@@ -1310,7 +1310,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
- switch (sym->trapped_write)
+ switch (sym->u.s.trapped_write)
{
case SYMBOL_NOWRITE:
if (NILP (Fkeywordp (symbol))
@@ -1336,7 +1336,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
}
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return;
@@ -1436,7 +1436,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
if (voide)
{ /* If storing void (making the symbol void), forward only through
buffer-local indicator, not through Lisp_Objfwd, etc. */
- sym->redirect = SYMBOL_PLAINVAL;
+ sym->u.s.redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (sym, newval);
}
else
@@ -1452,9 +1452,9 @@ static void
set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap)
{
struct Lisp_Symbol *sym = XSYMBOL (symbol);
- if (sym->trapped_write == SYMBOL_NOWRITE)
+ if (sym->u.s.trapped_write == SYMBOL_NOWRITE)
xsignal1 (Qtrapping_constant, symbol);
- sym->trapped_write = trap;
+ sym->u.s.trapped_write = trap;
}
static void
@@ -1469,7 +1469,7 @@ harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable)
if (!EQ (base_variable, alias)
&& EQ (base_variable, Findirect_variable (alias)))
set_symbol_trapped_write
- (alias, XSYMBOL (base_variable)->trapped_write);
+ (alias, XSYMBOL (base_variable)->u.s.trapped_write);
}
DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher,
@@ -1583,7 +1583,7 @@ default_value (Lisp_Object symbol)
sym = XSYMBOL (symbol);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym);
@@ -1653,7 +1653,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
CHECK_SYMBOL (symbol);
sym = XSYMBOL (symbol);
- switch (sym->trapped_write)
+ switch (sym->u.s.trapped_write)
{
case SYMBOL_NOWRITE:
if (NILP (Fkeywordp (symbol))
@@ -1665,7 +1665,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
case SYMBOL_TRAPPED_WRITE:
/* Don't notify here if we're going to call Fset anyway. */
- if (sym->redirect != SYMBOL_PLAINVAL
+ if (sym->u.s.redirect != SYMBOL_PLAINVAL
/* Setting due to thread switching doesn't count. */
&& bindflag != SET_INTERNAL_THREAD_SWITCH)
notify_variable_watchers (symbol, value, Qset_default, Qnil);
@@ -1677,7 +1677,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value,
}
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return;
@@ -1823,13 +1823,13 @@ The function `default-value' gets the default value and `set-default' sets it.
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
union Lisp_Val_Fwd valcontents;
- bool forwarded;
+ bool forwarded UNINIT;
CHECK_SYMBOL (variable);
sym = XSYMBOL (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL:
@@ -1852,12 +1852,12 @@ The function `default-value' gets the default value and `set-default' sets it.
}
if (SYMBOL_CONSTANT_P (variable))
- error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable)));
+ xsignal1 (Qsetting_constant, variable);
if (!blv)
{
blv = make_blv (sym, forwarded, valcontents);
- sym->redirect = SYMBOL_LOCALIZED;
+ sym->u.s.redirect = SYMBOL_LOCALIZED;
SET_SYMBOL_BLV (sym, blv);
}
@@ -1888,7 +1888,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
(Lisp_Object variable)
{
Lisp_Object tem;
- bool forwarded;
+ bool forwarded UNINIT;
union Lisp_Val_Fwd valcontents;
struct Lisp_Symbol *sym;
struct Lisp_Buffer_Local_Value *blv = NULL;
@@ -1897,7 +1897,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
sym = XSYMBOL (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL:
@@ -1914,9 +1914,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
default: emacs_abort ();
}
- if (sym->trapped_write == SYMBOL_NOWRITE)
- error ("Symbol %s may not be buffer-local",
- SDATA (SYMBOL_NAME (variable)));
+ if (sym->u.s.trapped_write == SYMBOL_NOWRITE)
+ xsignal1 (Qsetting_constant, variable);
if (blv ? blv->local_if_set
: (forwarded && BUFFER_OBJFWDP (valcontents.fwd)))
@@ -1930,7 +1929,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */)
if (!blv)
{
blv = make_blv (sym, forwarded, valcontents);
- sym->redirect = SYMBOL_LOCALIZED;
+ sym->u.s.redirect = SYMBOL_LOCALIZED;
SET_SYMBOL_BLV (sym, blv);
}
@@ -1987,7 +1986,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
sym = XSYMBOL (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return variable;
@@ -2014,7 +2013,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */)
default: emacs_abort ();
}
- if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
+ if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ());
/* Get rid of this buffer's alist element, if any. */
@@ -2056,7 +2055,7 @@ BUFFER defaults to the current buffer. */)
sym = XSYMBOL (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
@@ -2110,7 +2109,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see
sym = XSYMBOL (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
@@ -2145,7 +2144,7 @@ If the current binding is global (the default), the value is nil. */)
find_symbol_value (variable);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
case SYMBOL_PLAINVAL: return Qnil;
@@ -2163,7 +2162,7 @@ If the current binding is global (the default), the value is nil. */)
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (variable, Qnil)))
return Fcurrent_buffer ();
- else if (sym->redirect == SYMBOL_LOCALIZED
+ else if (sym->u.s.redirect == SYMBOL_LOCALIZED
&& blv_found (SYMBOL_BLV (sym)))
return SYMBOL_BLV (sym)->where;
else
@@ -2234,12 +2233,12 @@ indirect_function (register Lisp_Object object)
{
if (!SYMBOLP (hare) || NILP (hare))
break;
- hare = XSYMBOL (hare)->function;
+ hare = XSYMBOL (hare)->u.s.function;
if (!SYMBOLP (hare) || NILP (hare))
break;
- hare = XSYMBOL (hare)->function;
+ hare = XSYMBOL (hare)->u.s.function;
- tortoise = XSYMBOL (tortoise)->function;
+ tortoise = XSYMBOL (tortoise)->u.s.function;
if (EQ (hare, tortoise))
xsignal1 (Qcyclic_function_indirection, object);
@@ -2261,7 +2260,7 @@ function chain of symbols. */)
/* Optimize for no indirection. */
result = object;
if (SYMBOLP (result) && !NILP (result)
- && (result = XSYMBOL (result)->function, SYMBOLP (result)))
+ && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result)))
result = indirect_function (result);
if (!NILP (result))
return result;
@@ -2607,7 +2606,7 @@ uintmax_t
cons_to_unsigned (Lisp_Object c, uintmax_t max)
{
bool valid = false;
- uintmax_t val;
+ uintmax_t val UNINIT;
if (INTEGERP (c))
{
valid = XINT (c) >= 0;
@@ -2661,7 +2660,7 @@ intmax_t
cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max)
{
bool valid = false;
- intmax_t val;
+ intmax_t val UNINIT;
if (INTEGERP (c))
{
val = XINT (c);
@@ -3010,16 +3009,16 @@ static Lisp_Object
minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
enum Arith_Comparison comparison)
{
- eassume (0 < nargs);
- Lisp_Object accum;
- for (ptrdiff_t argnum = 0; argnum < nargs; argnum++)
+ Lisp_Object accum = args[0];
+ CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (accum);
+ for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
{
Lisp_Object val = args[argnum];
CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
- if (argnum == 0 || !NILP (arithcompare (val, accum, comparison)))
+ if (!NILP (arithcompare (val, accum, comparison)))
accum = val;
- else if (FLOATP (accum) && isnan (XFLOAT_DATA (accum)))
- return accum;
+ else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
+ return val;
}
return accum;
}
@@ -3069,6 +3068,22 @@ usage: (logxor &rest INTS-OR-MARKERS) */)
return arith_driver (Alogxor, nargs, args);
}
+DEFUN ("logcount", Flogcount, Slogcount, 1, 1, 0,
+ doc: /* Return population count of VALUE.
+This is the number of one bits in the two's complement representation
+of VALUE. If VALUE is negative, return the number of zero bits in the
+representation. */)
+ (Lisp_Object value)
+{
+ CHECK_NUMBER (value);
+ EMACS_INT v = XINT (value) < 0 ? -1 - XINT (value) : XINT (value);
+ return make_number (EMACS_UINT_WIDTH <= UINT_WIDTH
+ ? count_one_bits (v)
+ : EMACS_UINT_WIDTH <= ULONG_WIDTH
+ ? count_one_bits_l (v)
+ : count_one_bits_ll (v));
+}
+
static Lisp_Object
ash_lsh_impl (Lisp_Object value, Lisp_Object count, bool lsh)
{
@@ -3856,6 +3871,7 @@ syms_of_data (void)
defsubr (&Slogand);
defsubr (&Slogior);
defsubr (&Slogxor);
+ defsubr (&Slogcount);
defsubr (&Slsh);
defsubr (&Sash);
defsubr (&Sadd1);
@@ -3877,15 +3893,17 @@ syms_of_data (void)
defsubr (&Sbool_vector_count_consecutive);
defsubr (&Sbool_vector_count_population);
- set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function);
+ set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->u.s.function);
DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum,
- doc: /* The largest value that is representable in a Lisp integer. */);
+ doc: /* The largest value that is representable in a Lisp integer.
+This variable cannot be set; trying to do so will signal an error. */);
Vmost_positive_fixnum = make_number (MOST_POSITIVE_FIXNUM);
make_symbol_constant (intern_c_string ("most-positive-fixnum"));
DEFVAR_LISP ("most-negative-fixnum", Vmost_negative_fixnum,
- doc: /* The smallest value that is representable in a Lisp integer. */);
+ doc: /* The smallest value that is representable in a Lisp integer.
+This variable cannot be set; trying to do so will signal an error. */);
Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
make_symbol_constant (intern_c_string ("most-negative-fixnum"));
diff --git a/src/dbusbind.c b/src/dbusbind.c
index d2460fd886e..4a7068416fe 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -955,7 +955,7 @@ xd_get_connection_address (Lisp_Object bus)
DBusConnection *connection;
Lisp_Object val;
- val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
+ val = CDR_SAFE (Fassoc (bus, xd_registered_buses, Qnil));
if (NILP (val))
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
@@ -1057,7 +1057,7 @@ xd_close_bus (Lisp_Object bus)
Lisp_Object busobj;
/* Check whether we are connected. */
- val = Fassoc (bus, xd_registered_buses);
+ val = Fassoc (bus, xd_registered_buses, Qnil);
if (NILP (val))
return;
@@ -1127,7 +1127,7 @@ this connection to those buses. */)
xd_close_bus (bus);
/* Check, whether we are still connected. */
- val = Fassoc (bus, xd_registered_buses);
+ val = Fassoc (bus, xd_registered_buses, Qnil);
if (!NILP (val))
{
connection = xd_get_connection_address (bus);
diff --git a/src/decompress.c b/src/decompress.c
index a53a66df187..12b1f6ca094 100644
--- a/src/decompress.c
+++ b/src/decompress.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/deps.mk b/src/deps.mk
index b56d880da86..a94d198b849 100644
--- a/src/deps.mk
+++ b/src/deps.mk
@@ -16,7 +16,7 @@
## 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 <http://www.gnu.org/licenses/>.
+## along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
## Commentary:
##
diff --git a/src/dired.c b/src/dired.c
index 5ea00fb8db4..239b1acd1fb 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -51,7 +51,8 @@ extern int is_slow_fs (const char *);
#endif
static ptrdiff_t scmp (const char *, const char *, ptrdiff_t);
-static Lisp_Object file_attributes (int, char const *, Lisp_Object);
+static Lisp_Object file_attributes (int, char const *, Lisp_Object,
+ Lisp_Object, Lisp_Object);
/* Return the number of bytes in DP's name. */
static ptrdiff_t
@@ -64,6 +65,21 @@ dirent_namelen (struct dirent *dp)
#endif
}
+#ifndef HAVE_STRUCT_DIRENT_D_TYPE
+enum { DT_UNKNOWN, DT_DIR, DT_LNK };
+#endif
+
+/* Return the file type of DP. */
+static int
+dirent_type (struct dirent *dp)
+{
+#ifdef HAVE_STRUCT_DIRENT_D_TYPE
+ return dp->d_type;
+#else
+ return DT_UNKNOWN;
+#endif
+}
+
static DIR *
open_directory (Lisp_Object dirname, int *fdp)
{
@@ -146,7 +162,7 @@ read_dirent (DIR *dir, Lisp_Object dirname)
/* Function shared by Fdirectory_files and Fdirectory_files_and_attributes.
If not ATTRS, return a list of directory filenames;
if ATTRS, return a list of directory filenames and their attributes.
- In the latter case, ID_FORMAT is passed to Ffile_attributes. */
+ In the latter case, pass ID_FORMAT to file_attributes. */
Lisp_Object
directory_files_internal (Lisp_Object directory, Lisp_Object full,
@@ -210,7 +226,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
if (attrs)
{
/* Do this only once to avoid doing it (in w32.c:stat) for each
- file in the directory, when we call Ffile_attributes below. */
+ file in the directory, when we call file_attributes below. */
record_unwind_protect (directory_files_internal_w32_unwind,
Vw32_get_true_file_attributes);
w32_save = Vw32_get_true_file_attributes;
@@ -289,7 +305,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full,
if (attrs)
{
Lisp_Object fileattrs
- = file_attributes (fd, dp->d_name, id_format);
+ = file_attributes (fd, dp->d_name, directory, name, id_format);
list = Fcons (Fcons (finalname, fileattrs), list);
}
else
@@ -336,7 +352,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable.
return call5 (handler, Qdirectory_files, directory,
full, match, nosort);
- return directory_files_internal (directory, full, match, nosort, 0, Qnil);
+ return directory_files_internal (directory, full, match, nosort, false, Qnil);
}
DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes,
@@ -364,7 +380,8 @@ which see. */)
return call6 (handler, Qdirectory_files_and_attributes,
directory, full, match, nosort, id_format);
- return directory_files_internal (directory, full, match, nosort, 1, id_format);
+ return directory_files_internal (directory, full, match, nosort,
+ true, id_format);
}
@@ -434,7 +451,7 @@ is matched against file and directory names relative to DIRECTORY. */)
return file_name_completion (file, directory, 1, Qnil);
}
-static int file_name_completion_stat (int, struct dirent *, struct stat *);
+static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t);
static Lisp_Object
file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
@@ -448,7 +465,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
Lisp_Object bestmatch, tem, elt, name;
Lisp_Object encoded_file;
Lisp_Object encoded_dir;
- struct stat st;
bool directoryp;
/* If not INCLUDEALL, exclude files in completion-ignored-extensions as
well as "." and "..". Until shown otherwise, assume we can't exclude
@@ -512,10 +528,21 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
>= 0))
continue;
- if (file_name_completion_stat (fd, dp, &st) < 0)
- continue;
+ switch (dirent_type (dp))
+ {
+ case DT_DIR:
+ directoryp = true;
+ break;
+
+ case DT_LNK: case DT_UNKNOWN:
+ directoryp = file_name_completion_dirp (fd, dp, len);
+ break;
+
+ default:
+ directoryp = false;
+ break;
+ }
- directoryp = S_ISDIR (st.st_mode) != 0;
tem = Qnil;
/* If all_flag is set, always include all.
It would not actually be helpful to the user to ignore any possible
@@ -781,32 +808,18 @@ scmp (const char *s1, const char *s2, ptrdiff_t len)
return len - l;
}
-static int
-file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr)
+/* Return true if in the directory FD the directory entry DP, whose
+ string length is LEN, is that of a subdirectory that can be searched. */
+static bool
+file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len)
{
- int value;
-
-#ifdef MSDOS
- /* Some fields of struct stat are *very* expensive to compute on MS-DOS,
- but aren't required here. Avoid computing the following fields:
- st_inode, st_size and st_nlink for directories, and the execute bits
- in st_mode for non-directory files with non-standard extensions. */
-
- unsigned short save_djstat_flags = _djstat_flags;
-
- _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE;
-#endif /* MSDOS */
-
- /* We want to return success if a link points to a nonexistent file,
- but we want to return the status for what the link points to,
- in case it is a directory. */
- value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW);
- if (value == 0 && S_ISLNK (st_addr->st_mode))
- fstatat (fd, dp->d_name, st_addr, 0);
-#ifdef MSDOS
- _djstat_flags = save_djstat_flags;
-#endif /* MSDOS */
- return value;
+ USE_SAFE_ALLOCA;
+ char *subdir_name = SAFE_ALLOCA (len + 2);
+ memcpy (subdir_name, dp->d_name, len);
+ strcpy (subdir_name + len, "/");
+ bool dirp = faccessat (fd, subdir_name, F_OK, AT_EACCESS) == 0;
+ SAFE_FREE ();
+ return dirp;
}
static char *
@@ -912,14 +925,17 @@ so last access time will always be midnight of that day. */)
}
encoded = ENCODE_FILE (filename);
- return file_attributes (AT_FDCWD, SSDATA (encoded), id_format);
+ return file_attributes (AT_FDCWD, SSDATA (encoded), Qnil, filename,
+ id_format);
}
static Lisp_Object
-file_attributes (int fd, char const *name, Lisp_Object id_format)
+file_attributes (int fd, char const *name,
+ Lisp_Object dirname, Lisp_Object filename,
+ Lisp_Object id_format)
{
+ ptrdiff_t count = SPECPDL_INDEX ();
struct stat s;
- int lstat_result;
/* An array to hold the mode string generated by filemodestring,
including its terminating space and null byte. */
@@ -927,22 +943,67 @@ file_attributes (int fd, char const *name, Lisp_Object id_format)
char *uname = NULL, *gname = NULL;
-#ifdef WINDOWSNT
- /* We usually don't request accurate owner and group info, because
- it can be very expensive on Windows to get that, and most callers
- of 'lstat' don't need that. But here we do want that information
- to be accurate. */
- w32_stat_get_owner_group = 1;
-#endif
+ int err = EINVAL;
- lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW);
+#ifdef O_PATH
+ int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW);
+ if (namefd < 0)
+ err = errno;
+ else
+ {
+ record_unwind_protect_int (close_file_unwind, namefd);
+ if (fstat (namefd, &s) != 0)
+ {
+ err = errno;
+ /* The Linux kernel before version 3.6 does not support
+ fstat on O_PATH file descriptors. Handle this error like
+ missing support for O_PATH. */
+ if (err == EBADF)
+ err = EINVAL;
+ }
+ else
+ {
+ err = 0;
+ fd = namefd;
+ name = "";
+ }
+ }
+#endif
+ if (err == EINVAL)
+ {
#ifdef WINDOWSNT
- w32_stat_get_owner_group = 0;
+ /* We usually don't request accurate owner and group info,
+ because it can be expensive on Windows to get that, and most
+ callers of 'lstat' don't need that. But here we do want that
+ information to be accurate. */
+ w32_stat_get_owner_group = 1;
#endif
+ if (fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0)
+ err = 0;
+#ifdef WINDOWSNT
+ w32_stat_get_owner_group = 0;
+#endif
+ }
- if (lstat_result < 0)
- return Qnil;
+ if (err != 0)
+ return unbind_to (count, Qnil);
+
+ Lisp_Object file_type;
+ if (S_ISLNK (s.st_mode))
+ {
+ /* On systems lacking O_PATH support there is a race if the
+ symlink is replaced between the call to fstatat and the call
+ to emacs_readlinkat. Detect this race unless the replacement
+ is also a symlink. */
+ file_type = emacs_readlinkat (fd, name);
+ if (NILP (file_type))
+ return unbind_to (count, Qnil);
+ }
+ else
+ file_type = S_ISDIR (s.st_mode) ? Qt : Qnil;
+
+ unbind_to (count, Qnil);
if (!(NILP (id_format) || EQ (id_format, Qinteger)))
{
@@ -953,8 +1014,7 @@ file_attributes (int fd, char const *name, Lisp_Object id_format)
filemodestring (&s, modes);
return CALLN (Flist,
- (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name)
- : S_ISDIR (s.st_mode) ? Qt : Qnil),
+ file_type,
make_number (s.st_nlink),
(uname
? DECODE_SYSTEM (build_unibyte_string (uname))
diff --git a/src/dispextern.h b/src/dispextern.h
index d1e4715c329..430afbf09a3 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* New redisplay written by Gerd Moellmann <gerd@gnu.org>. */
@@ -384,6 +384,7 @@ struct glyph
glyph standing for newline at end of line 0
empty space after the end of the line -1
overlay arrow on a TTY -1
+ glyph displaying line number -1
glyph at EOB that ends in a newline -1
left truncation glyphs: -1
right truncation/continuation glyphs next buffer position
@@ -1106,7 +1107,7 @@ struct glyph_row *matrix_row (struct glyph_matrix *, int);
#define MATRIX_BOTTOM_TEXT_ROW(MATRIX, W) \
((MATRIX)->rows \
+ (MATRIX)->nrows \
- - (WINDOW_WANTS_MODELINE_P ((W)) ? 1 : 0))
+ - (window_wants_mode_line ((W)) ? 1 : 0))
/* Non-zero if the face of the last glyph in ROW's text area has
to be drawn to the end of the text area. */
@@ -1469,40 +1470,6 @@ struct glyph_string
#define DESIRED_HEADER_LINE_HEIGHT(W) \
MATRIX_HEADER_LINE_HEIGHT ((W)->desired_matrix)
-/* PXW: The height checks below serve to show at least one text line
- instead of a mode- and/or header line when a window gets very small.
- But (1) the check fails when the mode- or header-line is taller than
- the associated frame's line height and (2) we don't care much about
- text visibility anyway when shrinking a frame containing a toolbar.
-
- So maybe these checks should be removed and any clipping left to the
- window manager. */
-
-/* Value is true if window W wants a mode line and is large enough
- to accommodate it. */
-#define WINDOW_WANTS_MODELINE_P(W) \
- (BUFFERP ((W)->contents) \
- ? (!MINI_WINDOW_P (W) \
- && !(W)->pseudo_window_p \
- && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \
- && !NILP (BVAR (XBUFFER ((W)->contents), mode_line_format)) \
- && WINDOW_PIXEL_HEIGHT (W) > WINDOW_FRAME_LINE_HEIGHT (W)) \
- : false)
-
-/* Value is true if window W wants a header line and is large enough
- to accommodate it. */
-#define WINDOW_WANTS_HEADER_LINE_P(W) \
- (BUFFERP ((W)->contents) \
- ? (!MINI_WINDOW_P (W) \
- && !(W)->pseudo_window_p \
- && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME (W))) \
- && !NILP (BVAR (XBUFFER ((W)->contents), header_line_format)) \
- && (WINDOW_PIXEL_HEIGHT (W) \
- > (WINDOW_WANTS_MODELINE_P (W) \
- ? (2 * WINDOW_FRAME_LINE_HEIGHT (W)) \
- : WINDOW_FRAME_LINE_HEIGHT (W)))) \
- : false)
-
/* Return proper value to be used as baseline offset of font that has
ASCENT and DESCENT to draw characters by the font at the vertical
center of the line of frame F.
@@ -2571,7 +2538,12 @@ struct it
Do NOT use !BUFFERP (it.object) as a test whether we are
iterating over a string; use STRINGP (it.string) instead.
- Position is the current iterator position in object. */
+ Position is the current iterator position in object.
+
+ The 'position's CHARPOS is copied to glyph->charpos of the glyph
+ produced by PRODUCE_GLYPHS, so any artificial value documented
+ under 'struct glyph's 'charpos' member can also be found in the
+ 'position' member here. */
Lisp_Object object;
struct text_pos position;
@@ -2655,6 +2627,20 @@ struct it
coordinate is past first_visible_x. */
int hpos;
+ /* Current line number, zero-based. */
+ ptrdiff_t lnum;
+
+ /* The byte position corresponding to lnum. */
+ ptrdiff_t lnum_bytepos;
+
+ /* The width, in columns and in pixels, needed for display of the
+ line numbers, or zero if not computed. */
+ int lnum_width;
+ int lnum_pixel_width;
+
+ /* The line number of point's line, or zero if not computed yet. */
+ ptrdiff_t pt_lnum;
+
/* Left fringe bitmap number (enum fringe_bitmap_type). */
unsigned left_user_fringe_bitmap : FRINGE_ID_BITS;
@@ -3466,7 +3452,14 @@ void gamma_correct (struct frame *, COLORREF *);
void x_implicitly_set_name (struct frame *, Lisp_Object, Lisp_Object);
void x_change_tool_bar_height (struct frame *f, int);
+/* The frame used to display a tooltip.
+
+ Note: In a GTK build with non-zero x_gtk_use_system_tooltips, this
+ variable holds the frame that shows the tooltip, not the frame of
+ the tooltip itself, so checking whether a frame is a tooltip frame
+ cannot just compare the frame to what this variable holds. */
extern Lisp_Object tip_frame;
+
extern Window tip_window;
extern frame_parm_handler x_frame_parm_handlers[];
diff --git a/src/dispnew.c b/src/dispnew.c
index 27c69bde831..b0fc5c31fa1 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -66,7 +66,7 @@ struct dim
/* Function prototypes. */
-static void update_frame_line (struct frame *, int);
+static void update_frame_line (struct frame *, int, bool);
static int required_matrix_height (struct window *);
static int required_matrix_width (struct window *);
static void increment_row_positions (struct glyph_row *, ptrdiff_t, ptrdiff_t);
@@ -88,7 +88,7 @@ static void check_matrix_pointers (struct glyph_matrix *,
static void mirror_line_dance (struct window *, int, int, int *, char *);
static bool update_window_tree (struct window *, bool);
static bool update_window (struct window *, bool);
-static bool update_frame_1 (struct frame *, bool, bool, bool);
+static bool update_frame_1 (struct frame *, bool, bool, bool, bool);
static bool scrolling (struct frame *);
static void set_window_cursor_after_update (struct window *);
static void adjust_frame_glyphs_for_window_redisplay (struct frame *);
@@ -377,7 +377,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
{
window_box (w, ANY_AREA, 0, 0, &window_width, &window_height);
- header_line_p = WINDOW_WANTS_HEADER_LINE_P (w);
+ header_line_p = window_wants_header_line (w);
header_line_changed_p = header_line_p != matrix->header_line_p;
}
matrix->header_line_p = header_line_p;
@@ -386,6 +386,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
Do nothing if MATRIX' size, position, vscroll, and marginal areas
haven't changed. This optimization is important because preserving
the matrix means preventing redisplay. */
+ eassume (w != NULL || matrix->pool != NULL);
if (matrix->pool == NULL)
{
left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols);
@@ -446,7 +447,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
if (w == NULL
|| (row == matrix->rows + dim.height - 1
- && WINDOW_WANTS_MODELINE_P (w))
+ && window_wants_mode_line (w))
|| (row == matrix->rows && matrix->header_line_p))
{
row->glyphs[TEXT_AREA]
@@ -491,7 +492,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
/* The mode line, if displayed, never has marginal areas. */
if ((row == matrix->rows + dim.height - 1
- && !(w && WINDOW_WANTS_MODELINE_P (w)))
+ && !(w && window_wants_mode_line (w)))
|| (row == matrix->rows && matrix->header_line_p))
{
row->glyphs[TEXT_AREA]
@@ -570,7 +571,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y
the mode line, if any, since otherwise it will remain
disabled in the current matrix, and expose events won't
redraw it. */
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
w->update_mode_line = 1;
}
else if (matrix == w->desired_matrix)
@@ -1698,7 +1699,7 @@ required_matrix_height (struct window *w)
if (FRAME_WINDOW_P (f))
{
- /* http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html */
+ /* https://lists.gnu.org/r/emacs-devel/2015-11/msg00194.html */
int ch_height = max (FRAME_SMALLEST_FONT_HEIGHT (f), 1);
int window_pixel_height = window_box_height (w) + eabs (w->vscroll);
@@ -1725,7 +1726,7 @@ required_matrix_width (struct window *w)
struct frame *f = XFRAME (w->frame);
if (FRAME_WINDOW_P (f))
{
- /* http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html */
+ /* https://lists.gnu.org/r/emacs-devel/2015-11/msg00194.html */
int ch_width = max (FRAME_SMALLEST_CHAR_WIDTH (f), 1);
/* Compute number of glyphs needed in a glyph row. */
@@ -3120,15 +3121,15 @@ update_frame (struct frame *f, bool force_p, bool inhibit_hairy_id_p)
/* Update the display. */
update_begin (f);
- paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p, 1);
+ paused_p = update_frame_1 (f, force_p, inhibit_hairy_id_p, 1, false);
update_end (f);
if (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f))
{
if (FRAME_TTY (f)->termscript)
- fflush (FRAME_TTY (f)->termscript);
+ fflush_unlocked (FRAME_TTY (f)->termscript);
if (FRAME_TERMCAP_P (f))
- fflush (FRAME_TTY (f)->output);
+ fflush_unlocked (FRAME_TTY (f)->output);
}
/* Check window matrices for lost pointers. */
@@ -3173,7 +3174,7 @@ update_frame_with_menu (struct frame *f, int row, int col)
cursor_at_point_p = !(row >= 0 && col >= 0);
/* Force update_frame_1 not to stop due to pending input, and not
try scrolling. */
- paused_p = update_frame_1 (f, 1, 1, cursor_at_point_p);
+ paused_p = update_frame_1 (f, 1, 1, cursor_at_point_p, true);
/* ROW and COL tell us where in the menu to position the cursor, so
that screen readers know the active region on the screen. */
if (!cursor_at_point_p)
@@ -3181,8 +3182,8 @@ update_frame_with_menu (struct frame *f, int row, int col)
update_end (f);
if (FRAME_TTY (f)->termscript)
- fflush (FRAME_TTY (f)->termscript);
- fflush (FRAME_TTY (f)->output);
+ fflush_unlocked (FRAME_TTY (f)->termscript);
+ fflush_unlocked (FRAME_TTY (f)->output);
/* Check window matrices for lost pointers. */
#if GLYPH_DEBUG
#if 0
@@ -4473,7 +4474,7 @@ scrolling_window (struct window *w, bool header_line_p)
static bool
update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p,
- bool set_cursor_p)
+ bool set_cursor_p, bool updating_menu_p)
{
/* Frame matrices to work on. */
struct glyph_matrix *current_matrix = f->current_matrix;
@@ -4512,7 +4513,7 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p,
/* Update the individual lines as needed. Do bottom line first. */
if (MATRIX_ROW_ENABLED_P (desired_matrix, desired_matrix->nrows - 1))
- update_frame_line (f, desired_matrix->nrows - 1);
+ update_frame_line (f, desired_matrix->nrows - 1, updating_menu_p);
/* Now update the rest of the lines. */
for (i = 0; i < desired_matrix->nrows - 1 && (force_p || !input_pending); i++)
@@ -4531,14 +4532,14 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p,
ptrdiff_t outq = __fpending (display_output);
if (outq > 900
|| (outq > 20 && ((i - 1) % preempt_count == 0)))
- fflush (display_output);
+ fflush_unlocked (display_output);
}
}
if (!force_p && (i - 1) % preempt_count == 0)
detect_input_pending_ignore_squeezables ();
- update_frame_line (f, i);
+ update_frame_line (f, i, updating_menu_p);
}
}
@@ -4774,7 +4775,7 @@ count_match (struct glyph *str1, struct glyph *end1, struct glyph *str2, struct
/* Perform a frame-based update on line VPOS in frame FRAME. */
static void
-update_frame_line (struct frame *f, int vpos)
+update_frame_line (struct frame *f, int vpos, bool updating_menu_p)
{
struct glyph *obody, *nbody, *op1, *op2, *np1, *nend;
int tem;
@@ -4813,6 +4814,12 @@ update_frame_line (struct frame *f, int vpos)
current_row->enabled_p = true;
current_row->used[TEXT_AREA] = desired_row->used[TEXT_AREA];
+ /* For some reason, cursor is sometimes moved behind our back when a
+ frame with a TTY menu is redrawn. Homing the cursor as below
+ fixes that. */
+ if (updating_menu_p)
+ cursor_to (f, 0, 0);
+
/* If desired line is empty, just clear the line. */
if (!desired_row->enabled_p)
{
@@ -5142,6 +5149,29 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
include the hscroll. */
to_x += it.first_visible_x;
+ /* If we are hscrolling only the current line, and Y is at the line
+ containing point, augment TO_X with the hscroll amount of the
+ current line. */
+ if (it.line_wrap == TRUNCATE
+ && EQ (automatic_hscrolling, Qcurrent_line) && IT_CHARPOS (it) < PT)
+ {
+ struct it it2 = it;
+ void *it2data = bidi_shelve_cache ();
+ it2.last_visible_x = 1000000;
+ /* If the line at Y shows point, the call below to
+ move_it_in_display_line will succeed in reaching point. */
+ move_it_in_display_line (&it2, PT, -1, MOVE_TO_POS);
+ if (IT_CHARPOS (it2) >= PT)
+ {
+ to_x += (w->hscroll - w->min_hscroll) * FRAME_COLUMN_WIDTH (it.f);
+ /* We need to pretend the window is hscrolled, so that
+ move_it_in_display_line below will DTRT with TO_X. */
+ it.first_visible_x += w->hscroll * FRAME_COLUMN_WIDTH (it.f);
+ it.last_visible_x += w->hscroll * FRAME_COLUMN_WIDTH (it.f);
+ }
+ bidi_unshelve_cache (it2data, 0);
+ }
+
/* Now move horizontally in the row to the glyph under *X. Second
argument is ZV to prevent move_it_in_display_line from matching
based on buffer positions. */
@@ -5188,7 +5218,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p
start position, i.e. it excludes the header-line row, but
MATRIX_ROW includes the header-line row. Adjust for a possible
header-line row. */
- it_vpos = it.vpos + WINDOW_WANTS_HEADER_LINE_P (w);
+ it_vpos = it.vpos + window_wants_header_line (w);
if (it_vpos < w->current_matrix->nrows
&& (row = MATRIX_ROW (w->current_matrix, it_vpos),
row->enabled_p))
@@ -5615,13 +5645,13 @@ when TERMINAL is nil. */)
if (tty->termscript)
{
- fwrite (SDATA (string), 1, SBYTES (string), tty->termscript);
- fflush (tty->termscript);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->termscript);
+ fflush_unlocked (tty->termscript);
}
out = tty->output;
}
- fwrite (SDATA (string), 1, SBYTES (string), out);
- fflush (out);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string), out);
+ fflush_unlocked (out);
unblock_input ();
return Qnil;
}
@@ -5636,7 +5666,7 @@ terminate any keyboard macro currently executing. */)
if (!NILP (arg))
{
if (noninteractive)
- putchar (07);
+ putchar_unlocked (07);
else
ring_bell (XFRAME (selected_frame));
}
@@ -5650,7 +5680,7 @@ void
bitch_at_user (void)
{
if (noninteractive)
- putchar (07);
+ putchar_unlocked (07);
else if (!INTERACTIVE) /* Stop executing a keyboard macro. */
{
const char *msg
diff --git a/src/disptab.h b/src/disptab.h
index cdfb080dff7..592a1fa0180 100644
--- a/src/disptab.h
+++ b/src/disptab.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Access the slots of a display-table, according to their purpose. */
diff --git a/src/doc.c b/src/doc.c
index 345e18b9186..0cd62172c38 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -336,6 +336,8 @@ string is passed through `substitute-command-keys'. */)
}
fun = Findirect_function (function, Qnil);
+ if (NILP (fun))
+ xsignal1 (Qvoid_function, function);
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
if (SUBRP (fun))
@@ -470,7 +472,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
- Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
+ Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->u.s.function : obj;
/* The type determines where the docstring is stored. */
@@ -538,7 +540,7 @@ the same file name is found in the `doc-directory'. */)
char const *dirname;
ptrdiff_t dirlen;
/* Preloaded defcustoms using custom-initialize-delay are added to
- this list, but kept unbound. See http://debbugs.gnu.org/11565 */
+ this list, but kept unbound. See https://debbugs.gnu.org/11565 */
Lisp_Object delayed_init =
find_symbol_value (intern ("custom-delayed-init-variables"));
diff --git a/src/doprnt.c b/src/doprnt.c
index 418601acb02..d33c95f517b 100644
--- a/src/doprnt.c
+++ b/src/doprnt.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* If you think about replacing this with some similar standard C function of
the printf family (such as vsnprintf), please note that this function
@@ -503,7 +503,7 @@ esprintf (char *buf, char const *format, ...)
return nbytes;
}
-#if HAVE_MODULES || (defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT)
+#if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
/* Format to buffer *BUF of positive size *BUFSIZE, reallocating *BUF
and updating *BUFSIZE if the buffer is too small, and otherwise
diff --git a/src/dosfns.c b/src/dosfns.c
index 7bf1dee587a..86870496397 100644
--- a/src/dosfns.c
+++ b/src/dosfns.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/dosfns.h b/src/dosfns.h
index 266430d71e5..2846010c222 100644
--- a/src/dosfns.h
+++ b/src/dosfns.h
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#define DOS_COUNTRY_INFO 34 /* no of bytes returned by dos int 38h */
extern unsigned char dos_country_info[DOS_COUNTRY_INFO];
diff --git a/src/dynlib.c b/src/dynlib.c
index 47ba5e3d91b..a6d70484fc6 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Assume modules are enabled on modern systems... *Yes*, the
diff --git a/src/dynlib.h b/src/dynlib.h
index 1d53b8e5b2f..5669995624a 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef DYNLIB_H
#define DYNLIB_H
diff --git a/src/editfns.c b/src/editfns.c
index f0c4593742d..e671ba0761c 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -187,7 +187,8 @@ tzlookup (Lisp_Object zone, bool settz)
if (sec != 0)
prec += 2, numzone = 100 * numzone + sec;
}
- sprintf (tzbuf, tzbuf_format, prec, numzone,
+ sprintf (tzbuf, tzbuf_format, prec,
+ XINT (zone) < 0 ? -numzone : numzone,
&"-"[XINT (zone) < 0], hour, min, sec);
zone_string = tzbuf;
}
@@ -1256,10 +1257,10 @@ If POS is out of range, the value is nil. */)
if (NILP (pos))
{
pos_byte = PT_BYTE;
- XSETFASTINT (pos, PT);
+ if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)
+ return Qnil;
}
-
- if (MARKERP (pos))
+ else if (MARKERP (pos))
{
pos_byte = marker_byte_position (pos);
if (pos_byte < BEGV_BYTE || pos_byte >= ZV_BYTE)
@@ -2037,11 +2038,11 @@ by text that describes the specified date and time in TIME:
only blank-padded, %l is like %I blank-padded.
%p is the locale's equivalent of either AM or PM.
%q is the calendar quarter (1–4).
-%M is the minute.
-%S is the second.
-%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
-%Z is the time zone name, %z is the numeric form.
+%M is the minute (00-59).
+%S is the second (00-59; 00-60 on platforms with leap seconds)
%s is the number of seconds since 1970-01-01 00:00:00 +0000.
+%N is the nanosecond, %6N the microsecond, %3N the millisecond, etc.
+%Z is the time zone abbreviation, %z is the numeric form.
%c is the locale's date and time format.
%x is the locale's "preferred" date format.
@@ -2051,7 +2052,8 @@ by text that describes the specified date and time in TIME:
%R is like "%H:%M", %T is like "%H:%M:%S", %r is like "%I:%M:%S %p".
%X is the locale's "preferred" time format.
-Finally, %n is a newline, %t is a tab, %% is a literal %.
+Finally, %n is a newline, %t is a tab, %% is a literal %, and
+unrecognized %-sequences stand for themselves.
Certain flags and modifiers are available with some format controls.
The flags are `_', `-', `^' and `#'. For certain characters X,
@@ -3612,8 +3614,9 @@ It returns the number of characters changed. */)
cnt = 0;
for (; pos < end_pos; )
{
- register unsigned char *p = BYTE_POS_ADDR (pos_byte);
- unsigned char *str, buf[MAX_MULTIBYTE_LENGTH];
+ unsigned char *p = BYTE_POS_ADDR (pos_byte);
+ unsigned char *str UNINIT;
+ unsigned char buf[MAX_MULTIBYTE_LENGTH];
int len, str_len;
int oc;
Lisp_Object val;
@@ -3715,7 +3718,7 @@ It returns the number of characters changed. */)
}
else
{
- string = Fmake_string (make_number (1), val);
+ string = Fmake_string (make_number (1), val, Qnil);
}
replace_range (pos, pos + len, string, 1, 0, 1, 0);
pos_byte += SBYTES (string);
@@ -4115,8 +4118,8 @@ The # flag means to use an alternate display form for %o, %x, %X, %e,
%f, and %g sequences: for %o, it ensures that the result begins with
\"0\"; for %x and %X, it prefixes the result with \"0x\" or \"0X\";
for %e and %f, it causes a decimal point to be included even if the
-the precision is zero; for %g, it causes a decimal point to be
-included even if the the precision is zero, and also forces trailing
+precision is zero; for %g, it causes a decimal point to be
+included even if the precision is zero, and also forces trailing
zeros after the decimal point to be left in place.
The width specifier supplies a lower limit for the length of the
@@ -4177,8 +4180,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
multibyte character of the previous string. This flag tells if we
must consider such a situation or not. */
bool maybe_combine_byte;
+ Lisp_Object val;
bool arg_intervals = false;
USE_SAFE_ALLOCA;
+ sa_avail -= sizeof initial_buffer;
/* Information recorded for each format spec. */
struct info
@@ -4233,6 +4238,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
ptrdiff_t ispec;
ptrdiff_t nspec = 0;
+ /* True if a string needs to be allocated to hold the result. */
+ bool new_result = false;
+
/* If we start out planning a unibyte result,
then discover it has to be multibyte, we jump back to retry. */
retry:
@@ -4339,7 +4347,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
memset (&discarded[format0 - format_start], 1,
format - format0 - (conversion == '%'));
if (conversion == '%')
- goto copy_char;
+ {
+ new_result = true;
+ goto copy_char;
+ }
++n;
if (! (n < nargs))
@@ -4406,6 +4417,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (conversion == 's')
{
+ if (format == end && format - format_start == 2
+ && ! string_intervals (args[0]))
+ {
+ val = arg;
+ goto return_val;
+ }
+
/* handle case (precision[n] >= 0) */
ptrdiff_t prec = -1;
@@ -4484,6 +4502,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (string_intervals (arg))
spec->intervals = arg_intervals = true;
+ new_result = true;
continue;
}
}
@@ -4703,10 +4722,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
char src0 = src[0];
int exponent_bytes = 0;
bool signedp = src0 == '-' || src0 == '+' || src0 == ' ';
- if (zero_flag
- && ((src[signedp] >= '0' && src[signedp] <= '9')
- || (src[signedp] >= 'a' && src[signedp] <= 'f')
- || (src[signedp] >= 'A' && src[signedp] <= 'F')))
+ unsigned char after_sign = src[signedp];
+ if (zero_flag && 0 <= char_hexdigit (after_sign))
{
leading_zeros += padding;
padding = 0;
@@ -4753,6 +4770,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
spec->end = nchars;
+ new_result = true;
continue;
}
}
@@ -4771,9 +4789,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
convsrc = format_char == '`' ? uLSQM : uRSQM;
convbytes = 3;
+ new_result = true;
}
else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
- convsrc = "'";
+ {
+ convsrc = "'";
+ new_result = true;
+ }
else
{
/* Copy a single character from format to buf. */
@@ -4797,6 +4819,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
int c = BYTE8_TO_CHAR (format_char);
convbytes = CHAR_STRING (c, str);
convsrc = (char *) str;
+ new_result = true;
}
}
@@ -4843,9 +4866,15 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
if (bufsize < p - buf)
emacs_abort ();
+ if (! new_result)
+ {
+ val = args[0];
+ goto return_val;
+ }
+
if (maybe_combine_byte)
nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
- Lisp_Object val = make_specified_string (buf, nchars, p - buf, multibyte);
+ val = make_specified_string (buf, nchars, p - buf, multibyte);
/* If the format string has text properties, or any of the string
arguments has text properties, set up text properties of the
@@ -4890,7 +4919,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
else if (discarded[bytepos] == 1)
{
position++;
- if (translated == info[fieldn].start)
+ if (fieldn < nspec && translated == info[fieldn].start)
{
translated += info[fieldn].end - info[fieldn].start;
fieldn++;
@@ -4910,7 +4939,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
else if (discarded[bytepos] == 1)
{
position++;
- if (translated == info[fieldn].start)
+ if (fieldn < nspec && translated == info[fieldn].start)
{
translated += info[fieldn].end - info[fieldn].start;
fieldn++;
@@ -4943,6 +4972,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
}
}
+ return_val:
/* If we allocated BUF or INFO with malloc, free it too. */
SAFE_FREE ();
diff --git a/src/emacs-icon.h b/src/emacs-icon.h
index b5ba89e15f3..f126458e9db 100644
--- a/src/emacs-icon.h
+++ b/src/emacs-icon.h
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Note that the GTK port uses gdk to display the icon, so Emacs need
not have XPM support compiled in. */
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 2693a4529d6..b351515c3bd 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -315,20 +315,18 @@ module_free_global_ref (emacs_env *env, emacs_value ref)
MODULE_FUNCTION_BEGIN ();
struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash);
Lisp_Object obj = value_to_lisp (ref);
- EMACS_UINT hashcode;
- ptrdiff_t i = hash_lookup (h, obj, &hashcode);
+ ptrdiff_t i = hash_lookup (h, obj, NULL);
if (i >= 0)
{
- Lisp_Object value = HASH_VALUE (h, i);
- EMACS_INT refcount = XFASTINT (value) - 1;
+ EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1;
if (refcount > 0)
+ set_hash_value_slot (h, i, make_natnum (refcount));
+ else
{
- value = make_natnum (refcount);
- set_hash_value_slot (h, i, value);
+ eassert (refcount == 0);
+ hash_remove_from_table (h, obj);
}
- else
- hash_remove_from_table (h, value);
}
if (module_assertions)
@@ -575,6 +573,8 @@ module_make_string (emacs_env *env, const char *str, ptrdiff_t length)
MODULE_FUNCTION_BEGIN (module_nil);
if (! (0 <= length && length <= STRING_BYTES_BOUND))
xsignal0 (Qoverflow_error);
+ /* FIXME: AUTO_STRING_WITH_LEN requires STR to be null-terminated,
+ but we shouldn’t require that. */
AUTO_STRING_WITH_LEN (lstr, str, length);
return lisp_to_value (env,
code_convert_string_norecord (lstr, Qutf_8, false));
@@ -599,7 +599,6 @@ module_get_user_ptr (emacs_env *env, emacs_value uptr)
static void
module_set_user_ptr (emacs_env *env, emacs_value uptr, void *ptr)
{
- /* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lisp = value_to_lisp (uptr);
CHECK_USER_PTR (lisp);
@@ -619,7 +618,6 @@ static void
module_set_user_finalizer (emacs_env *env, emacs_value uptr,
emacs_finalizer_function fin)
{
- /* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lisp = value_to_lisp (uptr);
CHECK_USER_PTR (lisp);
@@ -638,7 +636,6 @@ check_vec_index (Lisp_Object lvec, ptrdiff_t i)
static void
module_vec_set (emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val)
{
- /* FIXME: This function should return bool because it can fail. */
MODULE_FUNCTION_BEGIN ();
Lisp_Object lvec = value_to_lisp (vec);
check_vec_index (lvec, i);
@@ -657,7 +654,6 @@ module_vec_get (emacs_env *env, emacs_value vec, ptrdiff_t i)
static ptrdiff_t
module_vec_size (emacs_env *env, emacs_value vec)
{
- /* FIXME: Return a sentinel value (e.g., -1) on error. */
MODULE_FUNCTION_BEGIN (0);
Lisp_Object lvec = value_to_lisp (vec);
CHECK_VECTOR (lvec);
@@ -819,9 +815,13 @@ in_current_thread (void)
static void
module_assert_thread (void)
{
- if (! module_assertions || in_current_thread ())
+ if (!module_assertions)
return;
- module_abort ("Module function called from outside the current Lisp thread");
+ if (!in_current_thread ())
+ module_abort ("Module function called from outside "
+ "the current Lisp thread");
+ if (gc_in_progress)
+ module_abort ("Module function called during garbage collection");
}
static void
@@ -983,7 +983,7 @@ value_to_lisp (emacs_value v)
return o;
}
-/* Attempt to convert O to an emacs_value. Do not do any checking or
+/* Attempt to convert O to an emacs_value. Do not do any checking
or allocate any storage; the caller should prevent or detect
any resulting bit pattern that is not a valid emacs_value. */
static emacs_value
@@ -998,10 +998,6 @@ lisp_to_value_bits (Lisp_Object o)
return (emacs_value) p;
}
-#ifndef HAVE_STRUCT_ATTRIBUTE_ALIGNED
-enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 };
-#endif
-
/* Convert O to an emacs_value. Allocate storage if needed; this can
signal if memory is exhausted. Must be an injective function. */
static emacs_value
@@ -1029,19 +1025,6 @@ lisp_to_value (emacs_env *env, Lisp_Object o)
/* Package the incompressible object pointer inside a pair
that is compressible. */
Lisp_Object pair = Fcons (o, ltv_mark);
-
- if (! HAVE_STRUCT_ATTRIBUTE_ALIGNED)
- {
- /* Keep calling Fcons until it returns a compressible pair.
- This shouldn't take long. */
- while ((intptr_t) XCONS (pair) & (GCALIGNMENT - 1))
- pair = Fcons (o, pair);
-
- /* Plant the mark. The garbage collector will eventually
- reclaim any just-allocated incompressible pairs. */
- XSETCDR (pair, ltv_mark);
- }
-
v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons);
}
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index 339234fdb51..d83cd430141 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_MODULE_H
#define EMACS_MODULE_H
@@ -80,7 +80,7 @@ enum emacs_funcall_exit
emacs_funcall_exit_signal = 1,
/* Function has exit using `throw'. */
- emacs_funcall_exit_throw = 2,
+ emacs_funcall_exit_throw = 2
};
struct emacs_env_25
@@ -97,6 +97,7 @@ struct emacs_env_26
/* Every module should define a function as follows. */
extern int emacs_module_init (struct emacs_runtime *ert)
+ EMACS_NOEXCEPT
EMACS_ATTRIBUTE_NONNULL(1);
#ifdef __cplusplus
diff --git a/src/emacs.c b/src/emacs.c
index da8df1bf1c7..808abcd9aa2 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -16,14 +16,13 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#define INLINE EXTERN_INLINE
#include <config.h>
#include <errno.h>
#include <fcntl.h>
-#include <stdio.h>
#include <stdlib.h>
#include <sys/file.h>
@@ -33,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define MAIN_PROGRAM
#include "lisp.h"
+#include "sysstdio.h"
#ifdef WINDOWSNT
#include <fcntl.h>
@@ -252,7 +252,7 @@ Initialization options:\n\
"\
Action options:\n\
\n\
-FILE visit FILE using find-file\n\
+FILE visit FILE\n\
+LINE go to line LINE in next FILE\n\
+LINE:COLUMN go to line LINE, column COLUMN, in next FILE\n\
--directory, -L DIR prepend DIR to load-path (with :DIR, append DIR)\n\
@@ -260,13 +260,13 @@ FILE visit FILE using find-file\n\
--execute EXPR evaluate Emacs Lisp expression EXPR\n\
",
"\
---file FILE visit FILE using find-file\n\
---find-file FILE visit FILE using find-file\n\
+--file FILE visit FILE\n\
+--find-file FILE visit FILE\n\
--funcall, -f FUNC call Emacs Lisp function FUNC with no arguments\n\
--insert FILE insert contents of FILE into current buffer\n\
--kill exit without asking for confirmation\n\
--load, -l FILE load Emacs Lisp FILE using the load function\n\
---visit FILE visit FILE using find-file\n\
+--visit FILE visit FILE\n\
\n\
",
"\
@@ -672,7 +672,10 @@ close_output_streams (void)
int
main (int argc, char **argv)
{
- char stack_bottom_variable;
+ /* Variable near the bottom of the stack, and aligned appropriately
+ for pointers. */
+ void *stack_bottom_variable;
+
bool do_initial_setlocale;
bool dumping;
int skip_args = 0;
@@ -688,7 +691,7 @@ main (int argc, char **argv)
char *original_pwd = 0;
/* Record (approximately) where the stack begins. */
- stack_bottom = &stack_bottom_variable;
+ stack_bottom = (char *) &stack_bottom_variable;
#ifndef CANNOT_DUMP
dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0
@@ -885,7 +888,7 @@ main (int argc, char **argv)
}
#endif /* HAVE_SETRLIMIT and RLIMIT_STACK and not CYGWIN */
- clearerr (stdin);
+ clearerr_unlocked (stdin);
emacs_backtrace (-1);
@@ -983,7 +986,7 @@ main (int argc, char **argv)
int i;
printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]);
for (i = 0; i < ARRAYELTS (usage_message); i++)
- fputs (usage_message[i], stdout);
+ fputs_unlocked (usage_message[i], stdout);
exit (0);
}
@@ -1539,8 +1542,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
#endif
#endif /* HAVE_X_WINDOWS */
-#ifdef HAVE_LIBXML2
syms_of_xml ();
+
+#ifdef HAVE_LCMS2
+ syms_of_lcms2 ();
#endif
#ifdef HAVE_ZLIB
@@ -2197,7 +2202,7 @@ You must run Emacs in batch mode in order to dump it. */)
}
#endif
- fflush (stdout);
+ fflush_unlocked (stdout);
/* Tell malloc where start of impure now is. */
/* Also arrange for warnings when nearly out of space. */
#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c
index 75cb3c1c727..4243b3ffd9d 100644
--- a/src/emacsgtkfixed.c
+++ b/src/emacsgtkfixed.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -81,7 +81,7 @@ emacs_fixed_gtk_widget_size_allocate (GtkWidget *widget,
additional case for an xwidget view.
It would be nicer if the bse class method could be called first,
- and the the xview modification only would remain here. It wasn't
+ and the xview modification only would remain here. It wasn't
possible to solve it that way yet. */
EmacsFixedClass *klass;
GtkWidgetClass *parent_class;
diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h
index 776ac453c01..8f2acd6bba3 100644
--- a/src/emacsgtkfixed.h
+++ b/src/emacsgtkfixed.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACSGTKFIXED_H
#define EMACSGTKFIXED_H
diff --git a/src/epaths.in b/src/epaths.in
index c491d3b72e7..8f77b0a14fc 100644
--- a/src/epaths.in
+++ b/src/epaths.in
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Together with PATH_SITELOADSEARCH, this gives the default value of
@@ -75,4 +75,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
/* Where Emacs should look for the application default file. */
#define PATH_X_DEFAULTS "/usr/lib/X11/%L/%T/%N%C%S:/usr/lib/X11/%l/%T/%N%C%S:/usr/lib/X11/%T/%N%C%S:/usr/lib/X11/%L/%T/%N%S:/usr/lib/X11/%l/%T/%N%S:/usr/lib/X11/%T/%N%S"
-
diff --git a/src/eval.c b/src/eval.c
index 8f293c9d300..47c4f17eabc 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -30,6 +30,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "dispextern.h"
#include "buffer.h"
+/* CACHEABLE is ordinarily nothing, except it is 'volatile' if
+ necessary to cajole GCC into not warning incorrectly that a
+ variable should be volatile. */
+#if defined GCC_LINT || defined lint
+# define CACHEABLE volatile
+#else
+# define CACHEABLE /* empty */
+#endif
+
/* Chain of condition and catch handlers currently in effect. */
/* struct handler *handlerlist; */
@@ -213,13 +222,6 @@ backtrace_next (union specbinding *pdl)
return pdl;
}
-/* Return a pointer to somewhere near the top of the C stack. */
-void *
-near_C_stack_top (void)
-{
- return backtrace_args (backtrace_top ());
-}
-
void
init_eval_once (void)
{
@@ -361,10 +363,11 @@ usage: (or CONDITIONS...) */)
while (CONSP (args))
{
- val = eval_sub (XCAR (args));
+ Lisp_Object arg = XCAR (args);
+ args = XCDR (args);
+ val = eval_sub (arg);
if (!NILP (val))
break;
- args = XCDR (args);
}
return val;
@@ -381,10 +384,11 @@ usage: (and CONDITIONS...) */)
while (CONSP (args))
{
- val = eval_sub (XCAR (args));
+ Lisp_Object arg = XCAR (args);
+ args = XCDR (args);
+ val = eval_sub (arg);
if (NILP (val))
break;
- args = XCDR (args);
}
return val;
@@ -404,7 +408,7 @@ usage: (if COND THEN ELSE...) */)
if (!NILP (cond))
return eval_sub (Fcar (XCDR (args)));
- return Fprogn (XCDR (XCDR (args)));
+ return Fprogn (Fcdr (XCDR (args)));
}
DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
@@ -446,8 +450,9 @@ usage: (progn BODY...) */)
while (CONSP (body))
{
- val = eval_sub (XCAR (body));
+ Lisp_Object form = XCAR (body);
body = XCDR (body);
+ val = eval_sub (form);
}
return val;
@@ -495,35 +500,26 @@ The return value of the `setq' form is the value of the last VAL.
usage: (setq [SYM VAL]...) */)
(Lisp_Object args)
{
- Lisp_Object val, sym, lex_binding;
+ Lisp_Object val = args, tail = args;
- val = args;
- if (CONSP (args))
+ for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2)
{
- Lisp_Object args_left = args;
- Lisp_Object numargs = Flength (args);
-
- if (XINT (numargs) & 1)
- xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs);
-
- do
- {
- val = eval_sub (Fcar (XCDR (args_left)));
- sym = XCAR (args_left);
-
- /* Like for eval_sub, we do not check declared_special here since
- it's been done when let-binding. */
- if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- && SYMBOLP (sym)
- && !NILP (lex_binding
- = Fassq (sym, Vinternal_interpreter_environment)))
- XSETCDR (lex_binding, val); /* SYM is lexically bound. */
- else
- Fset (sym, val); /* SYM is dynamically bound. */
-
- args_left = Fcdr (XCDR (args_left));
- }
- while (CONSP (args_left));
+ Lisp_Object sym = XCAR (tail), lex_binding;
+ tail = XCDR (tail);
+ if (!CONSP (tail))
+ xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1));
+ Lisp_Object arg = XCAR (tail);
+ tail = XCDR (tail);
+ val = eval_sub (arg);
+ /* Like for eval_sub, we do not check declared_special here since
+ it's been done when let-binding. */
+ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
+ && SYMBOLP (sym)
+ && !NILP (lex_binding
+ = Fassq (sym, Vinternal_interpreter_environment)))
+ XSETCDR (lex_binding, val); /* SYM is lexically bound. */
+ else
+ Fset (sym, val); /* SYM is dynamically bound. */
}
return val;
@@ -542,7 +538,7 @@ of unexpected results when a quoted object is modified.
usage: (quote ARG) */)
(Lisp_Object args)
{
- if (CONSP (XCDR (args)))
+ if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args));
return XCAR (args);
}
@@ -556,7 +552,7 @@ usage: (function ARG) */)
{
Lisp_Object quoted = XCAR (args);
- if (CONSP (XCDR (args)))
+ if (!NILP (XCDR (args)))
xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
if (!NILP (Vinternal_interpreter_environment)
@@ -607,7 +603,7 @@ The return value is BASE-VARIABLE. */)
sym = XSYMBOL (new_alias);
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_FORWARDED:
error ("Cannot make an internal variable an alias");
@@ -620,7 +616,7 @@ The return value is BASE-VARIABLE. */)
emacs_abort ();
}
- /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
+ /* https://lists.gnu.org/r/emacs-devel/2008-04/msg00834.html
If n_a is bound, but b_v is not, set the value of b_v to n_a,
so that old-code that affects n_a before the aliasing is setup
still works. */
@@ -636,14 +632,14 @@ The return value is BASE-VARIABLE. */)
error ("Don't know how to make a let-bound variable an alias");
}
- if (sym->trapped_write == SYMBOL_TRAPPED_WRITE)
+ if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE)
notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil);
- sym->declared_special = 1;
- XSYMBOL (base_variable)->declared_special = 1;
- sym->redirect = SYMBOL_VARALIAS;
+ sym->u.s.declared_special = true;
+ XSYMBOL (base_variable)->u.s.declared_special = true;
+ sym->u.s.redirect = SYMBOL_VARALIAS;
SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
- sym->trapped_write = XSYMBOL (base_variable)->trapped_write;
+ sym->u.s.trapped_write = XSYMBOL (base_variable)->u.s.trapped_write;
LOADHIST_ATTACH (new_alias);
/* Even if docstring is nil: remove old docstring. */
Fput (new_alias, Qvariable_documentation, docstring);
@@ -741,15 +737,15 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
sym = XCAR (args);
tail = XCDR (args);
- if (CONSP (tail))
+ if (!NILP (tail))
{
- if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail))))
+ if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail))))
error ("Too many arguments");
tem = Fdefault_boundp (sym);
/* Do it before evaluating the initial value, for self-references. */
- XSYMBOL (sym)->declared_special = 1;
+ XSYMBOL (sym)->u.s.declared_special = true;
if (NILP (tem))
Fset_default (sym, eval_sub (XCAR (tail)));
@@ -773,7 +769,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
LOADHIST_ATTACH (sym);
}
else if (!NILP (Vinternal_interpreter_environment)
- && !XSYMBOL (sym)->declared_special)
+ && !XSYMBOL (sym)->u.s.declared_special)
/* A simple (defvar foo) with lexical scoping does "nothing" except
declare that var to be dynamically scoped *locally* (i.e. within
the current file or let-block). */
@@ -810,20 +806,24 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */)
Lisp_Object sym, tem;
sym = XCAR (args);
- if (CONSP (Fcdr (XCDR (XCDR (args)))))
- error ("Too many arguments");
+ Lisp_Object docstring = Qnil;
+ if (!NILP (XCDR (XCDR (args))))
+ {
+ if (!NILP (XCDR (XCDR (XCDR (args)))))
+ error ("Too many arguments");
+ docstring = XCAR (XCDR (XCDR (args)));
+ }
- tem = eval_sub (Fcar (XCDR (args)));
+ tem = eval_sub (XCAR (XCDR (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
- XSYMBOL (sym)->declared_special = 1;
- tem = Fcar (XCDR (XCDR (args)));
- if (!NILP (tem))
+ XSYMBOL (sym)->u.s.declared_special = true;
+ if (!NILP (docstring))
{
if (!NILP (Vpurify_flag))
- tem = Fpurecopy (tem);
- Fput (sym, Qvariable_documentation, tem);
+ docstring = Fpurecopy (docstring);
+ Fput (sym, Qvariable_documentation, docstring);
}
Fput (sym, Qrisky_local_variable, Qt);
LOADHIST_ATTACH (sym);
@@ -837,7 +837,7 @@ DEFUN ("internal-make-var-non-special", Fmake_var_non_special,
(Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- XSYMBOL (symbol)->declared_special = 0;
+ XSYMBOL (symbol)->u.s.declared_special = false;
return Qnil;
}
@@ -851,31 +851,33 @@ Each VALUEFORM can refer to the symbols already bound by this VARLIST.
usage: (let* VARLIST BODY...) */)
(Lisp_Object args)
{
- Lisp_Object varlist, var, val, elt, lexenv;
+ Lisp_Object var, val, elt, lexenv;
ptrdiff_t count = SPECPDL_INDEX ();
lexenv = Vinternal_interpreter_environment;
- for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist))
+ Lisp_Object varlist = XCAR (args);
+ while (CONSP (varlist))
{
maybe_quit ();
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
if (SYMBOLP (elt))
{
var = elt;
val = Qnil;
}
- else if (! NILP (Fcdr (Fcdr (elt))))
- signal_error ("`let' bindings can have only one value-form", elt);
else
{
var = Fcar (elt);
- val = eval_sub (Fcar (Fcdr (elt)));
+ if (! NILP (Fcdr (XCDR (elt))))
+ signal_error ("`let' bindings can have only one value-form", elt);
+ val = eval_sub (Fcar (XCDR (elt)));
}
if (!NILP (lexenv) && SYMBOLP (var)
- && !XSYMBOL (var)->declared_special
+ && !XSYMBOL (var)->u.s.declared_special
&& NILP (Fmemq (var, Vinternal_interpreter_environment)))
/* Lexically bind VAR by adding it to the interpreter's binding
alist. */
@@ -918,36 +920,40 @@ usage: (let VARLIST BODY...) */)
CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
- elt = Flength (varlist);
- SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
+ EMACS_INT varlist_len = XFASTINT (Flength (varlist));
+ SAFE_ALLOCA_LISP (temps, varlist_len);
+ ptrdiff_t nvars = varlist_len;
/* Compute the values and store them in `temps'. */
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
+ for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
maybe_quit ();
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
if (SYMBOLP (elt))
- temps [argnum++] = Qnil;
+ temps[argnum] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
- temps [argnum++] = eval_sub (Fcar (Fcdr (elt)));
+ temps[argnum] = eval_sub (Fcar (Fcdr (elt)));
}
+ nvars = argnum;
lexenv = Vinternal_interpreter_environment;
varlist = XCAR (args);
- for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
+ for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++)
{
Lisp_Object var;
elt = XCAR (varlist);
+ varlist = XCDR (varlist);
var = SYMBOLP (elt) ? elt : Fcar (elt);
- tem = temps[argnum++];
+ tem = temps[argnum];
if (!NILP (lexenv) && SYMBOLP (var)
- && !XSYMBOL (var)->declared_special
+ && !XSYMBOL (var)->u.s.declared_special
&& NILP (Fmemq (var, Vinternal_interpreter_environment)))
/* Lexically bind VAR by adding it to the lexenv alist. */
lexenv = Fcons (Fcons (var, tem), lexenv);
@@ -1016,7 +1022,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */)
tem = Fassq (sym, environment);
if (NILP (tem))
{
- def = XSYMBOL (sym)->function;
+ def = XSYMBOL (sym)->u.s.function;
if (!NILP (def))
continue;
}
@@ -1229,7 +1235,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
Lisp_Object handlers)
{
struct handler *oldhandlerlist = handlerlist;
- ptrdiff_t clausenb = 0;
+ ptrdiff_t CACHEABLE clausenb = 0;
CHECK_SYMBOL (var);
@@ -1422,7 +1428,7 @@ push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
struct handler *
push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
{
- struct handler *c = handlerlist->nextfree;
+ struct handler *CACHEABLE c = handlerlist->nextfree;
if (!c)
{
c = malloc (sizeof *c);
@@ -1926,8 +1932,8 @@ this does nothing and returns nil. */)
CHECK_STRING (file);
/* If function is defined and not as an autoload, don't override. */
- if (!NILP (XSYMBOL (function)->function)
- && !AUTOLOADP (XSYMBOL (function)->function))
+ if (!NILP (XSYMBOL (function)->u.s.function)
+ && !AUTOLOADP (XSYMBOL (function)->u.s.function))
return Qnil;
if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
@@ -1980,12 +1986,10 @@ it defines a macro. */)
if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
return fundef;
- if (EQ (macro_only, Qmacro))
- {
- Lisp_Object kind = Fnth (make_number (4), fundef);
- if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
- return fundef;
- }
+ Lisp_Object kind = Fnth (make_number (4), fundef);
+ if (EQ (macro_only, Qmacro)
+ && !(EQ (kind, Qt) || EQ (kind, Qmacro)))
+ return fundef;
/* This is to make sure that loadup.el gives a clear picture
of what files are preloaded and when. */
@@ -2008,15 +2012,18 @@ it defines a macro. */)
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- /* If `macro_only', assume this autoload to be a "best-effort",
+ /* If `macro_only' is set and fundef isn't a macro, assume this autoload to
+ be a "best-effort" (e.g. to try and find a compiler macro),
so don't signal an error if autoloading fails. */
- Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
+ Lisp_Object ignore_errors
+ = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only;
+ Fload (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- if (NILP (funname))
+ if (NILP (funname) || !NILP (ignore_errors))
return Qnil;
else
{
@@ -2090,7 +2097,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
specpdl_ptr->bt.kind = SPECPDL_BACKTRACE;
specpdl_ptr->bt.debug_on_exit = false;
specpdl_ptr->bt.function = function;
- specpdl_ptr->bt.args = args;
+ current_thread->stack_top = specpdl_ptr->bt.args = args;
specpdl_ptr->bt.nargs = nargs;
grow_specpdl ();
@@ -2142,6 +2149,7 @@ eval_sub (Lisp_Object form)
original_fun = XCAR (form);
original_args = XCDR (form);
+ CHECK_LIST (original_args);
/* This also protects them from gc. */
count = record_in_backtrace (original_fun, &original_args, UNEVALLED);
@@ -2157,7 +2165,7 @@ eval_sub (Lisp_Object form)
fun = original_fun;
if (!SYMBOLP (fun))
fun = Ffunction (Fcons (fun, Qnil));
- else if (!NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+ else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (SUBRP (fun))
@@ -2183,15 +2191,16 @@ eval_sub (Lisp_Object form)
SAFE_ALLOCA_LISP (vals, XINT (numargs));
- while (!NILP (args_left))
+ while (CONSP (args_left) && argnum < XINT (numargs))
{
- vals[argnum++] = eval_sub (Fcar (args_left));
- args_left = Fcdr (args_left);
+ Lisp_Object arg = XCAR (args_left);
+ args_left = XCDR (args_left);
+ vals[argnum++] = eval_sub (arg);
}
- set_backtrace_args (specpdl + count, vals, XINT (numargs));
+ set_backtrace_args (specpdl + count, vals, argnum);
- val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
+ val = XSUBR (fun)->function.aMANY (argnum, vals);
check_cons_list ();
lisp_eval_depth--;
@@ -2339,7 +2348,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */
if (SYMBOLP (fun) && !NILP (fun)
- && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+ && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
{
fun = indirect_function (fun);
if (NILP (fun))
@@ -2661,8 +2670,19 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7);
}
+/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5,
+ arg6, arg7, arg8. */
+/* ARGSUSED */
+Lisp_Object
+call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7,
+ Lisp_Object arg8)
+{
+ return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
+}
+
DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
- doc: /* Non-nil if OBJECT is a function. */)
+ doc: /* Return t if OBJECT is a function. */)
(Lisp_Object object)
{
if (FUNCTIONP (object))
@@ -2740,7 +2760,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
/* Optimize for no indirection. */
fun = original_fun;
if (SYMBOLP (fun) && !NILP (fun)
- && (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
+ && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (SUBRP (fun))
@@ -3056,7 +3076,7 @@ function with `&rest' args, or `unevalled' for a special form. */)
function = original;
if (SYMBOLP (function) && !NILP (function))
{
- function = XSYMBOL (function)->function;
+ function = XSYMBOL (function)->u.s.function;
if (SYMBOLP (function))
function = indirect_function (function);
}
@@ -3195,7 +3215,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
if ((--p)->kind > SPECPDL_LET)
{
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
- eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
+ eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol
&& EQ (specpdl_where (p), buf))
return 1;
@@ -3208,10 +3228,10 @@ static void
do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
Lisp_Object value, enum Set_Internal_Bind bindflag)
{
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_PLAINVAL:
- if (!sym->trapped_write)
+ if (!sym->u.s.trapped_write)
SET_SYMBOL_VAL (sym, value);
else
set_internal (specpdl_symbol (bind), value, Qnil, bindflag);
@@ -3255,7 +3275,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
sym = XSYMBOL (symbol);
start:
- switch (sym->redirect)
+ switch (sym->u.s.redirect)
{
case SYMBOL_VARALIAS:
sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
@@ -3279,10 +3299,10 @@ specbind (Lisp_Object symbol, Lisp_Object value)
specpdl_ptr->let.where = Fcurrent_buffer ();
specpdl_ptr->let.saved_value = Qnil;
- eassert (sym->redirect != SYMBOL_LOCALIZED
+ eassert (sym->u.s.redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
- if (sym->redirect == SYMBOL_LOCALIZED)
+ if (sym->u.s.redirect == SYMBOL_LOCALIZED)
{
if (!blv_found (SYMBOL_BLV (sym)))
specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
@@ -3393,9 +3413,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
{ /* If variable has a trivial value (no forwarding), and isn't
trapped, we can just set it. */
Lisp_Object sym = specpdl_symbol (this_binding);
- if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
+ if (SYMBOLP (sym) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL)
{
- if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE)
+ if (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_UNTRAPPED_WRITE)
SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding));
else
set_internal (sym, specpdl_old_value (this_binding),
@@ -3527,7 +3547,7 @@ context where binding is lexical by default. */)
(Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
- return XSYMBOL (symbol)->declared_special ? Qt : Qnil;
+ return XSYMBOL (symbol)->u.s.declared_special ? Qt : Qnil;
}
@@ -3683,7 +3703,8 @@ backtrace_eval_unrewind (int distance)
just set it. No need to check for constant symbols here,
since that was already done by specbind. */
Lisp_Object sym = specpdl_symbol (tmp);
- if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL)
+ if (SYMBOLP (sym)
+ && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL)
{
Lisp_Object old_value = specpdl_old_value (tmp);
set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym)));
diff --git a/src/fileio.c b/src/fileio.c
index c21056ee6f2..77ff7d8b6e7 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <limits.h>
@@ -96,7 +96,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <acl.h>
#include <allocator.h>
#include <careadlinkat.h>
+#include <fsusage.h>
#include <stat-time.h>
+#include <tempname.h>
#include <binary-io.h>
@@ -123,7 +125,7 @@ static mode_t auto_save_mode_bits;
static bool auto_save_error_occurred;
/* If VALID_TIMESTAMP_FILE_SYSTEM, then TIMESTAMP_FILE_SYSTEM is the device
- number of a file system where time stamps were observed to to work. */
+ number of a file system where time stamps were observed to work. */
static bool valid_timestamp_file_system;
static dev_t timestamp_file_system;
@@ -267,9 +269,9 @@ Otherwise, return nil.
A file name is handled if one of the regular expressions in
`file-name-handler-alist' matches it.
-If OPERATION equals `inhibit-file-name-operation', then we ignore
+If OPERATION equals `inhibit-file-name-operation', then ignore
any handlers that are members of `inhibit-file-name-handlers',
-but we still do run any other handlers. This lets handlers
+but still do run any other handlers. This lets handlers
use the standard functions without calling themselves recursively. */)
(Lisp_Object filename, Lisp_Object operation)
{
@@ -565,15 +567,16 @@ is already present. */)
static ptrdiff_t
directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
{
- /* Process as Unix format: just remove any final slash.
- But leave "/" and "//" unchanged. */
- while (srclen > 1
+ /* In Unix-like systems, just remove any final slashes. However, if
+ they are all slashes, leave "/" and "//" alone, and treat "///"
+ and longer as if they were "/". */
+ if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
+ while (srclen > 1
#ifdef DOS_NT
- && !IS_ANY_SEP (src[srclen - 2])
+ && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2]))
#endif
- && IS_DIRECTORY_SEP (src[srclen - 1])
- && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0])))
- srclen--;
+ && IS_DIRECTORY_SEP (src[srclen - 1]))
+ srclen--;
memcpy (dst, src, srclen);
dst[srclen] = 0;
@@ -583,6 +586,30 @@ directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte)
return srclen;
}
+DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0,
+ doc: /* Return non-nil if NAME ends with a directory separator character. */)
+ (Lisp_Object name)
+{
+ CHECK_STRING (name);
+ ptrdiff_t namelen = SBYTES (name);
+ unsigned char c = namelen ? SREF (name, namelen - 1) : 0;
+ return IS_DIRECTORY_SEP (c) ? Qt : Qnil;
+}
+
+/* Return the expansion of NEWNAME, except that if NEWNAME is a
+ directory name then return the expansion of FILE's basename under
+ NEWNAME. This resembles how 'cp FILE NEWNAME' works, except that
+ it requires NEWNAME to be a directory name (typically, by ending in
+ "/"). */
+
+static Lisp_Object
+expand_cp_target (Lisp_Object file, Lisp_Object newname)
+{
+ return (!NILP (Fdirectory_name_p (newname))
+ ? Fexpand_file_name (Ffile_name_nondirectory (file), newname)
+ : Fexpand_file_name (newname, Qnil));
+}
+
DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name,
1, 1, 0,
doc: /* Returns the file name of the directory named DIRECTORY.
@@ -623,148 +650,80 @@ In Unix-syntax, this function just removes the final slash. */)
return val;
}
-static const char make_temp_name_tbl[64] =
-{
- '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','1','2','3',
- '4','5','6','7','8','9','-','_'
-};
-
-static unsigned make_temp_name_count, make_temp_name_count_initialized_p;
-
-/* Value is a temporary file name starting with PREFIX, a string.
-
- The Emacs process number forms part of the result, so there is
- no danger of generating a name being used by another process.
- In addition, this function makes an attempt to choose a name
- which has no existing file. To make this work, PREFIX should be
- an absolute file name.
-
- BASE64_P means add the pid as 3 characters in base64
- encoding. In this case, 6 characters will be added to PREFIX to
- form the file name. Otherwise, if Emacs is running on a system
- with long file names, add the pid as a decimal number.
-
- This function signals an error if no unique file name could be
- generated. */
-
-Lisp_Object
-make_temp_name (Lisp_Object prefix, bool base64_p)
+DEFUN ("make-temp-file-internal", Fmake_temp_file_internal,
+ Smake_temp_file_internal, 4, 4, 0,
+ doc: /* Generate a new file whose name starts with PREFIX, a string.
+Return the name of the generated file. If DIR-FLAG is zero, do not
+create the file, just its name. Otherwise, if DIR-FLAG is non-nil,
+create an empty directory. The file name should end in SUFFIX.
+Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs
+working directory. If TEXT is a string, insert it into the newly
+created file.
+
+Signal an error if the file could not be created.
+
+This function does not grok magic file names. */)
+ (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix,
+ Lisp_Object text)
{
- Lisp_Object val, encoded_prefix;
- ptrdiff_t len;
- printmax_t pid;
- char *p, *data;
- char pidbuf[INT_BUFSIZE_BOUND (printmax_t)];
- int pidlen;
-
CHECK_STRING (prefix);
-
- /* VAL is created by adding 6 characters to PREFIX. The first
- three are the PID of this process, in base 64, and the second
- three are incremented if the file already exists. This ensures
- 262144 unique file names per PID per PREFIX. */
-
- pid = getpid ();
-
- if (base64_p)
+ CHECK_STRING (suffix);
+ Lisp_Object encoded_prefix = ENCODE_FILE (prefix);
+ Lisp_Object encoded_suffix = ENCODE_FILE (suffix);
+ ptrdiff_t prefix_len = SBYTES (encoded_prefix);
+ ptrdiff_t suffix_len = SBYTES (encoded_suffix);
+ if (INT_MAX < suffix_len)
+ args_out_of_range (prefix, suffix);
+ int nX = 6;
+ Lisp_Object val = make_uninit_string (prefix_len + nX + suffix_len);
+ char *data = SSDATA (val);
+ memcpy (data, SSDATA (encoded_prefix), prefix_len);
+ memset (data + prefix_len, 'X', nX);
+ memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len);
+ int kind = (NILP (dir_flag) ? GT_FILE
+ : EQ (dir_flag, make_number (0)) ? GT_NOCREATE
+ : GT_DIR);
+ int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind);
+ bool failed = fd < 0;
+ if (!failed)
{
- pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidlen = 3;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
+ val = DECODE_FILE (val);
+ if (STRINGP (text) && SBYTES (text) != 0)
+ write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd);
+ failed = NILP (dir_flag) && emacs_close (fd) != 0;
+ /* Discard the unwind protect. */
+ specpdl_ptr = specpdl + count;
}
- else
+ if (failed)
{
-#ifdef HAVE_LONG_FILE_NAMES
- pidlen = sprintf (pidbuf, "%"pMd, pid);
-#else
- pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6;
- pidlen = 3;
-#endif
- }
-
- encoded_prefix = ENCODE_FILE (prefix);
- len = SBYTES (encoded_prefix);
- val = make_uninit_string (len + 3 + pidlen);
- data = SSDATA (val);
- memcpy (data, SSDATA (encoded_prefix), len);
- p = data + len;
-
- memcpy (p, pidbuf, pidlen);
- p += pidlen;
-
- /* Here we try to minimize useless stat'ing when this function is
- invoked many times successively with the same PREFIX. We achieve
- this by initializing count to a random value, and incrementing it
- afterwards.
-
- We don't want make-temp-name to be called while dumping,
- because then make_temp_name_count_initialized_p would get set
- and then make_temp_name_count would not be set when Emacs starts. */
-
- if (!make_temp_name_count_initialized_p)
- {
- make_temp_name_count = time (NULL);
- make_temp_name_count_initialized_p = 1;
- }
-
- while (1)
- {
- unsigned num = make_temp_name_count;
-
- p[0] = make_temp_name_tbl[num & 63], num >>= 6;
- p[1] = make_temp_name_tbl[num & 63], num >>= 6;
- p[2] = make_temp_name_tbl[num & 63], num >>= 6;
-
- /* Poor man's congruential RN generator. Replace with
- ++make_temp_name_count for debugging. */
- make_temp_name_count += 25229;
- make_temp_name_count %= 225307;
-
- if (!check_existing (data))
+ static char const kind_message[][32] =
{
- /* We want to return only if errno is ENOENT. */
- if (errno == ENOENT)
- return DECODE_FILE (val);
- else
- /* The error here is dubious, but there is little else we
- can do. The alternatives are to return nil, which is
- as bad as (and in many cases worse than) throwing the
- error, or to ignore the error, which will likely result
- in looping through 225307 stat's, which is not only
- dog-slow, but also useless since eventually nil would
- have to be returned anyway. */
- report_file_error ("Cannot create temporary name for prefix",
- prefix);
- /* not reached */
- }
+ [GT_FILE] = "Creating file with prefix",
+ [GT_DIR] = "Creating directory with prefix",
+ [GT_NOCREATE] = "Creating file name with prefix"
+ };
+ report_file_error (kind_message[kind], prefix);
}
+ return val;
}
DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0,
doc: /* Generate temporary file name (string) starting with PREFIX (a string).
-The Emacs process number forms part of the result, so there is no
-danger of generating a name being used by another Emacs process
-\(so long as only a single host can access the containing directory...).
This function tries to choose a name that has no existing file.
-For this to work, PREFIX should be an absolute file name.
+For this to work, PREFIX should be an absolute file name, and PREFIX
+and the returned string should both be non-magic.
-There is a race condition between calling `make-temp-name' and creating the
-file, which opens all kinds of security holes. For that reason, you should
-normally use `make-temp-file' instead. */)
+There is a race condition between calling `make-temp-name' and
+later creating the file, which opens all kinds of security holes.
+For that reason, you should normally use `make-temp-file' instead. */)
(Lisp_Object prefix)
{
- return make_temp_name (prefix, 0);
+ return Fmake_temp_file_internal (prefix, make_number (0),
+ empty_unibyte_string, Qnil);
}
DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0,
@@ -790,7 +749,9 @@ For technical reasons, this function can return correct but
non-intuitive results for the root directory; for instance,
\(expand-file-name ".." "/") returns "/..". For this reason, use
\(directory-file-name (file-name-directory dirname)) to traverse a
-filesystem tree, not (expand-file-name ".." dirname). */)
+filesystem tree, not (expand-file-name ".." dirname). Note: make
+sure DIRNAME in this example doesn't end in a slash, unless it's
+the root directory. */)
(Lisp_Object name, Lisp_Object default_directory)
{
/* These point to SDATA and need to be careful with string-relocation
@@ -1793,11 +1754,9 @@ those `/' is discarded. */)
(directory-file-name (expand-file-name FOO)). */
Lisp_Object
-expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir)
+expand_and_dir_to_file (Lisp_Object filename)
{
- register Lisp_Object absname;
-
- absname = Fexpand_file_name (filename, defdir);
+ Lisp_Object absname = Fexpand_file_name (filename, Qnil);
/* Remove final slash, if any (unless this is the root dir).
stat behaves differently depending! */
@@ -1867,15 +1826,17 @@ clone_file (int dest, int source)
DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6,
"fCopy file: \nGCopy %s to file: \np\nP",
doc: /* Copy FILE to NEWNAME. Both args must be strings.
-If NEWNAME names a directory, copy FILE there.
+If NEWNAME is a directory name, copy FILE to a like-named file under
+NEWNAME. For NEWNAME to be recognized as a directory name, it should
+end in a slash.
This function always sets the file modes of the output file to match
the input file.
The optional third argument OK-IF-ALREADY-EXISTS specifies what to do
-if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we
+if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil,
signal a `file-already-exists' error without overwriting. If
-OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user
+OK-IF-ALREADY-EXISTS is an integer, request confirmation from the user
about overwriting; this is what happens in interactive use with M-x.
Any other value for OK-IF-ALREADY-EXISTS means to overwrite the
existing file.
@@ -1885,8 +1846,8 @@ last-modified time as the old one. (This works on only some systems.)
A prefix arg makes KEEP-TIME non-nil.
-If PRESERVE-UID-GID is non-nil, we try to transfer the
-uid and gid of FILE to NEWNAME.
+If PRESERVE-UID-GID is non-nil, try to transfer the uid and gid of
+FILE to NEWNAME.
If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME;
this includes the file modes, along with ACL entries and SELinux
@@ -1913,16 +1874,8 @@ permissions. */)
struct stat st;
#endif
- encoded_file = encoded_newname = Qnil;
- CHECK_STRING (file);
- CHECK_STRING (newname);
-
- if (!NILP (Ffile_directory_p (newname)))
- newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
- else
- newname = Fexpand_file_name (newname, Qnil);
-
file = Fexpand_file_name (file, Qnil);
+ newname = expand_cp_target (file, newname);
/* If the input file name has special constructs in it,
call the corresponding file handler. */
@@ -2095,7 +2048,7 @@ permissions. */)
{
/* Set the modified context back to the file. */
bool fail = fsetfilecon (ofd, con) != 0;
- /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
report_file_error ("Doing fsetfilecon", newname);
@@ -2153,11 +2106,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal,
dir = SSDATA (encoded_dir);
-#ifdef WINDOWSNT
- if (mkdir (dir) != 0)
-#else
if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0)
-#endif
report_file_error ("Creating directory", directory);
return Qnil;
@@ -2216,7 +2165,7 @@ With a prefix argument, TRASH is nil. */)
encoded_file = ENCODE_FILE (filename);
- if (unlink (SSDATA (encoded_file)) < 0)
+ if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT)
report_file_error ("Removing old name", filename);
return Qnil;
}
@@ -2303,33 +2252,37 @@ DEFUN ("rename-file", Frename_file, Srename_file, 2, 3,
"fRename file: \nGRename %s to file: \np",
doc: /* Rename FILE as NEWNAME. Both args must be strings.
If file has names other than FILE, it continues to have those names.
-Signals a `file-already-exists' error if a file NEWNAME already exists
+If NEWNAME is a directory name, rename FILE to a like-named file under
+NEWNAME. For NEWNAME to be recognized as a directory name, it should
+end in a slash.
+
+Signal a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
-A number as third arg means request confirmation if NEWNAME already exists.
+An integer third arg means request confirmation if NEWNAME already exists.
This is what happens in interactive use with M-x. */)
(Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
- Lisp_Object encoded_file, encoded_newname, symlink_target;
+ Lisp_Object encoded_file, encoded_newname;
- symlink_target = encoded_file = encoded_newname = Qnil;
- CHECK_STRING (file);
- CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
- if ((!NILP (Ffile_directory_p (newname)))
- /* If the filesystem is case-insensitive and the file names are
- identical but for the case, don't attempt to move directory
- to itself. */
- && (NILP (Ffile_name_case_insensitive_p (file))
- || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))))
+ /* If the filesystem is case-insensitive and the file names are
+ identical but for case, treat it as a change-case request, and do
+ not worry whether NEWNAME exists or whether it is a directory, as
+ it is already another name for FILE. */
+ bool case_only_rename = false;
+#if defined CYGWIN || defined DOS_NT
+ if (!NILP (Ffile_name_case_insensitive_p (file)))
{
- Lisp_Object fname = (NILP (Ffile_directory_p (file))
- ? file : Fdirectory_file_name (file));
- newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname);
+ newname = Fexpand_file_name (newname, Qnil);
+ case_only_rename = !NILP (Fstring_equal (Fdowncase (file),
+ Fdowncase (newname)));
}
- else
- newname = Fexpand_file_name (newname, Qnil);
+#endif
+
+ if (!case_only_rename)
+ newname = expand_cp_target (Fdirectory_file_name (file), newname);
/* If the file name has special constructs in it,
call the corresponding file handler. */
@@ -2343,70 +2296,95 @@ This is what happens in interactive use with M-x. */)
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
- /* If the filesystem is case-insensitive and the file names are
- identical but for the case, don't ask for confirmation: they
- simply want to change the letter-case of the file name. */
- if ((!(file_name_case_insensitive_p (SSDATA (encoded_file)))
- || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))
- && ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists))))
- barf_or_query_if_file_exists (newname, false, "rename to it",
- INTEGERP (ok_if_already_exists), false);
- if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
+ bool plain_rename = (case_only_rename
+ || (!NILP (ok_if_already_exists)
+ && !INTEGERP (ok_if_already_exists)));
+ int rename_errno UNINIT;
+ if (!plain_rename)
{
- int rename_errno = errno;
- if (rename_errno == EXDEV)
+ if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file),
+ AT_FDCWD, SSDATA (encoded_newname))
+ == 0)
+ return Qnil;
+
+ rename_errno = errno;
+ switch (rename_errno)
{
- ptrdiff_t count;
- symlink_target = Ffile_symlink_p (file);
- if (! NILP (symlink_target))
- Fmake_symbolic_link (symlink_target, newname,
- NILP (ok_if_already_exists) ? Qnil : Qt);
- else if (!NILP (Ffile_directory_p (file)))
- call4 (Qcopy_directory, file, newname, Qt, Qnil);
- else
- /* We have already prompted if it was an integer, so don't
- have copy-file prompt again. */
- Fcopy_file (file, newname,
- NILP (ok_if_already_exists) ? Qnil : Qt,
- Qt, Qt, Qt);
+ case EEXIST: case EINVAL: case ENOSYS:
+#if ENOSYS != ENOTSUP
+ case ENOTSUP:
+#endif
+ barf_or_query_if_file_exists (newname, rename_errno == EEXIST,
+ "rename to it",
+ INTEGERP (ok_if_already_exists),
+ false);
+ plain_rename = true;
+ break;
+ }
+ }
- count = SPECPDL_INDEX ();
- specbind (Qdelete_by_moving_to_trash, Qnil);
+ if (plain_rename)
+ {
+ if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
+ return Qnil;
+ rename_errno = errno;
+ /* Don't prompt again. */
+ ok_if_already_exists = Qt;
+ }
+ else if (!NILP (ok_if_already_exists))
+ ok_if_already_exists = Qt;
- if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target))
- call2 (Qdelete_directory, file, Qt);
- else
- Fdelete_file (file, Qnil);
- unbind_to (count, Qnil);
- }
+ if (rename_errno != EXDEV)
+ report_file_errno ("Renaming", list2 (file, newname), rename_errno);
+
+ struct stat file_st;
+ bool dirp = !NILP (Fdirectory_name_p (file));
+ if (!dirp)
+ {
+ if (lstat (SSDATA (encoded_file), &file_st) != 0)
+ report_file_error ("Renaming", list2 (file, newname));
+ dirp = S_ISDIR (file_st.st_mode) != 0;
+ }
+ if (dirp)
+ call4 (Qcopy_directory, file, newname, Qt, Qnil);
+ else
+ {
+ Lisp_Object symlink_target
+ = (S_ISLNK (file_st.st_mode)
+ ? emacs_readlinkat (AT_FDCWD, SSDATA (encoded_file))
+ : Qnil);
+ if (!NILP (symlink_target))
+ Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists);
else
- report_file_errno ("Renaming", list2 (file, newname), rename_errno);
+ Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt);
}
- return Qnil;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ specbind (Qdelete_by_moving_to_trash, Qnil);
+ if (dirp)
+ call2 (Qdelete_directory, file, Qt);
+ else
+ Fdelete_file (file, Qnil);
+ return unbind_to (count, Qnil);
}
DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3,
"fAdd name to file: \nGName to add to %s: \np",
doc: /* Give FILE additional name NEWNAME. Both args must be strings.
-Signals a `file-already-exists' error if a file NEWNAME already exists
+If NEWNAME is a directory name, give FILE a like-named new name under
+NEWNAME.
+
+Signal a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
-A number as third arg means request confirmation if NEWNAME already exists.
+An integer third arg means request confirmation if NEWNAME already exists.
This is what happens in interactive use with M-x. */)
(Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
Lisp_Object encoded_file, encoded_newname;
- encoded_file = encoded_newname = Qnil;
- CHECK_STRING (file);
- CHECK_STRING (newname);
file = Fexpand_file_name (file, Qnil);
-
- if (!NILP (Ffile_directory_p (newname)))
- newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname);
- else
- newname = Fexpand_file_name (newname, Qnil);
+ newname = expand_cp_target (file, newname);
/* If the file name has special constructs in it,
call the corresponding file handler. */
@@ -2425,54 +2403,48 @@ This is what happens in interactive use with M-x. */)
encoded_file = ENCODE_FILE (file);
encoded_newname = ENCODE_FILE (newname);
- if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (newname, false, "make it a new name",
- INTEGERP (ok_if_already_exists), false);
+ if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
+ return Qnil;
- unlink (SSDATA (newname));
- if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0)
+ if (errno == EEXIST)
{
- int link_errno = errno;
- report_file_errno ("Adding new name", list2 (file, newname), link_errno);
+ if (NILP (ok_if_already_exists)
+ || INTEGERP (ok_if_already_exists))
+ barf_or_query_if_file_exists (newname, true, "make it a new name",
+ INTEGERP (ok_if_already_exists), false);
+ unlink (SSDATA (newname));
+ if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0)
+ return Qnil;
}
- return Qnil;
+ report_file_error ("Adding new name", list2 (file, newname));
}
DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3,
"FMake symbolic link to file: \nGMake symbolic link to file %s: \np",
- doc: /* Make a symbolic link to TARGET, named LINKNAME.
-Both args must be strings.
-Signals a `file-already-exists' error if a file LINKNAME already exists
+ doc: /* Make a symbolic link to TARGET, named NEWNAME.
+If NEWNAME is a directory name, make a like-named symbolic link under
+NEWNAME.
+
+Signal a `file-already-exists' error if a file NEWNAME already exists
unless optional third argument OK-IF-ALREADY-EXISTS is non-nil.
-A number as third arg means request confirmation if LINKNAME already exists.
+An integer third arg means request confirmation if NEWNAME already
+exists, and expand leading "~" or strip leading "/:" in TARGET.
This happens for interactive use with M-x. */)
(Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists)
{
Lisp_Object handler;
Lisp_Object encoded_target, encoded_linkname;
- encoded_target = encoded_linkname = Qnil;
CHECK_STRING (target);
- CHECK_STRING (linkname);
- /* If the link target has a ~, we must expand it to get
- a truly valid file name. Otherwise, do not expand;
- we want to permit links to relative file names. */
- if (SREF (target, 0) == '~')
- target = Fexpand_file_name (target, Qnil);
-
- if (!NILP (Ffile_directory_p (linkname)))
- linkname = Fexpand_file_name (Ffile_name_nondirectory (target), linkname);
- else
- linkname = Fexpand_file_name (linkname, Qnil);
-
- /* If the file name has special constructs in it,
- call the corresponding file handler. */
- handler = Ffind_file_name_handler (target, Qmake_symbolic_link);
- if (!NILP (handler))
- return call4 (handler, Qmake_symbolic_link, target,
- linkname, ok_if_already_exists);
+ if (INTEGERP (ok_if_already_exists))
+ {
+ if (SREF (target, 0) == '~')
+ target = Fexpand_file_name (target, Qnil);
+ else if (SREF (target, 0) == '/' && SREF (target, 1) == ':')
+ target = Fsubstring_no_properties (target, make_number (2), Qnil);
+ }
+ linkname = expand_cp_target (target, linkname);
/* If the new link name has special constructs in it,
call the corresponding file handler. */
@@ -2484,38 +2456,32 @@ This happens for interactive use with M-x. */)
encoded_target = ENCODE_FILE (target);
encoded_linkname = ENCODE_FILE (linkname);
- if (NILP (ok_if_already_exists)
- || INTEGERP (ok_if_already_exists))
- barf_or_query_if_file_exists (linkname, false, "make it a link",
- INTEGERP (ok_if_already_exists), false);
- if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) < 0)
- {
- /* If we didn't complain already, silently delete existing file. */
- int symlink_errno;
- if (errno == EEXIST)
- {
- unlink (SSDATA (encoded_linkname));
- if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname))
- >= 0)
- return Qnil;
- }
- if (errno == ENOSYS)
- xsignal1 (Qfile_error,
- build_string ("Symbolic links are not supported"));
+ if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
+ return Qnil;
- symlink_errno = errno;
- report_file_errno ("Making symbolic link", list2 (target, linkname),
- symlink_errno);
+ if (errno == ENOSYS)
+ xsignal1 (Qfile_error,
+ build_string ("Symbolic links are not supported"));
+
+ if (errno == EEXIST)
+ {
+ if (NILP (ok_if_already_exists)
+ || INTEGERP (ok_if_already_exists))
+ barf_or_query_if_file_exists (linkname, true, "make it a link",
+ INTEGERP (ok_if_already_exists), false);
+ unlink (SSDATA (encoded_linkname));
+ if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0)
+ return Qnil;
}
- return Qnil;
+ report_file_error ("Making symbolic link", list2 (target, linkname));
}
DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p,
1, 1, 0,
- doc: /* Return t if file FILENAME specifies an absolute file name.
-On Unix, this is a name starting with a `/' or a `~'. */)
+ doc: /* Return t if FILENAME is an absolute file name or starts with `~'.
+On Unix, absolute file names start with `/'. */)
(Lisp_Object filename)
{
CHECK_STRING (filename);
@@ -2677,11 +2643,6 @@ emacs_readlinkat (int fd, char const *filename)
return Qnil;
val = build_unibyte_string (buf);
- if (buf[0] == '/' && strchr (buf, ':'))
- {
- AUTO_STRING (slash_colon, "/:");
- val = concat2 (slash_colon, val);
- }
if (buf != readlink_buf)
xfree (buf);
val = DECODE_FILE (val);
@@ -2718,14 +2679,11 @@ Symbolic links to directories count as directories.
See `file-symlink-p' to distinguish symlinks. */)
(Lisp_Object filename)
{
- Lisp_Object absname;
- Lisp_Object handler;
-
- absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
+ Lisp_Object absname = expand_and_dir_to_file (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (absname, Qfile_directory_p);
+ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p);
if (!NILP (handler))
return call2 (handler, Qfile_directory_p, absname);
@@ -2849,15 +2807,12 @@ Symbolic links to regular files count as regular files.
See `file-symlink-p' to distinguish symlinks. */)
(Lisp_Object filename)
{
- register Lisp_Object absname;
struct stat st;
- Lisp_Object handler;
-
- absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
+ Lisp_Object absname = expand_and_dir_to_file (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (absname, Qfile_regular_p);
+ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_regular_p);
if (!NILP (handler))
return call2 (handler, Qfile_regular_p, absname);
@@ -2895,21 +2850,13 @@ Return (nil nil nil nil) if the file is nonexistent or inaccessible,
or if SELinux is disabled, or if Emacs lacks SELinux support. */)
(Lisp_Object filename)
{
- Lisp_Object absname;
Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil;
-
- Lisp_Object handler;
-#if HAVE_LIBSELINUX
- security_context_t con;
- int conlength;
- context_t context;
-#endif
-
- absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
+ Lisp_Object absname = expand_and_dir_to_file (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (absname, Qfile_selinux_context);
+ Lisp_Object handler = Ffind_file_name_handler (absname,
+ Qfile_selinux_context);
if (!NILP (handler))
return call2 (handler, Qfile_selinux_context, absname);
@@ -2918,10 +2865,11 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */)
#if HAVE_LIBSELINUX
if (is_selinux_enabled ())
{
- conlength = lgetfilecon (SSDATA (absname), &con);
+ security_context_t con;
+ int conlength = lgetfilecon (SSDATA (absname), &con);
if (conlength > 0)
{
- context = context_new (con);
+ context_t context = context_new (con);
if (context_user_get (context))
user = build_string (context_user_get (context));
if (context_role_get (context))
@@ -3008,7 +2956,7 @@ or if Emacs was not compiled with SELinux support. */)
fail = (lsetfilecon (SSDATA (encoded_absname),
context_str (parsed_con))
!= 0);
- /* See http://debbugs.gnu.org/11245 for ENOTSUP. */
+ /* See https://debbugs.gnu.org/11245 for ENOTSUP. */
if (fail && errno != ENOTSUP)
report_file_error ("Doing lsetfilecon", absname);
@@ -3032,35 +2980,28 @@ Return nil if file does not exist or is not accessible, or if Emacs
was unable to determine the ACL entries. */)
(Lisp_Object filename)
{
-#if USE_ACL
- Lisp_Object absname;
- Lisp_Object handler;
-# ifdef HAVE_ACL_SET_FILE
- acl_t acl;
- Lisp_Object acl_string;
- char *str;
-# ifndef HAVE_ACL_TYPE_EXTENDED
- acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
-# endif
-# endif
+ Lisp_Object acl_string = Qnil;
- absname = expand_and_dir_to_file (filename,
- BVAR (current_buffer, directory));
+#if USE_ACL
+ Lisp_Object absname = expand_and_dir_to_file (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (absname, Qfile_acl);
+ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_acl);
if (!NILP (handler))
return call2 (handler, Qfile_acl, absname);
# ifdef HAVE_ACL_SET_FILE
absname = ENCODE_FILE (absname);
- acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
+# ifndef HAVE_ACL_TYPE_EXTENDED
+ acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS;
+# endif
+ acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED);
if (acl == NULL)
return Qnil;
- str = acl_to_text (acl, NULL);
+ char *str = acl_to_text (acl, NULL);
if (str == NULL)
{
acl_free (acl);
@@ -3070,12 +3011,10 @@ was unable to determine the ACL entries. */)
acl_string = build_string (str);
acl_free (str);
acl_free (acl);
-
- return acl_string;
# endif
#endif
- return Qnil;
+ return acl_string;
}
DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl,
@@ -3113,7 +3052,8 @@ support. */)
acl = acl_from_text (SSDATA (acl_string));
if (acl == NULL)
{
- report_file_error ("Converting ACL", absname);
+ if (acl_errno_valid (errno))
+ report_file_error ("Converting ACL", absname);
return Qnil;
}
@@ -3139,15 +3079,12 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0,
Return nil, if file does not exist or is not accessible. */)
(Lisp_Object filename)
{
- Lisp_Object absname;
struct stat st;
- Lisp_Object handler;
-
- absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory));
+ Lisp_Object absname = expand_and_dir_to_file (filename);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (absname, Qfile_modes);
+ Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes);
if (!NILP (handler))
return call2 (handler, Qfile_modes, absname);
@@ -3192,7 +3129,15 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */)
DEFUN ("set-default-file-modes", Fset_default_file_modes, Sset_default_file_modes, 1, 1, 0,
doc: /* Set the file permission bits for newly created files.
The argument MODE should be an integer; only the low 9 bits are used.
-This setting is inherited by subprocesses. */)
+On Posix hosts, this setting is inherited by subprocesses.
+
+This function works by setting the Emacs's file mode creation mask.
+Each bit that is set in the mask means that the corresponding bit
+in the permissions of newly created files will be disabled.
+
+Note that when `write-region' creates a file, it resets the
+execute bit, even if the mask set by this function allows that bit
+by having the corresponding bit in the mask reset. */)
(Lisp_Object mode)
{
mode_t oldrealmask, oldumask, newumask;
@@ -3274,20 +3219,18 @@ If FILE1 does not exist, the answer is nil;
otherwise, if FILE2 does not exist, the answer is t. */)
(Lisp_Object file1, Lisp_Object file2)
{
- Lisp_Object absname1, absname2;
struct stat st1, st2;
- Lisp_Object handler;
CHECK_STRING (file1);
CHECK_STRING (file2);
- absname1 = Qnil;
- absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory));
- absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory));
+ Lisp_Object absname1 = expand_and_dir_to_file (file1);
+ Lisp_Object absname2 = expand_and_dir_to_file (file2);
/* If the file name has special constructs in it,
call the corresponding file handler. */
- handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p);
+ Lisp_Object handler = Ffind_file_name_handler (absname1,
+ Qfile_newer_than_file_p);
if (NILP (handler))
handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p);
if (!NILP (handler))
@@ -3306,11 +3249,7 @@ otherwise, if FILE2 does not exist, the answer is t. */)
? Qt : Qnil);
}
-#ifndef READ_BUF_SIZE
-#define READ_BUF_SIZE (64 << 10)
-#endif
-/* Some buffer offsets are stored in 'int' variables. */
-verify (READ_BUF_SIZE <= INT_MAX);
+enum { READ_BUF_SIZE = MAX_ALLOCA };
/* This function is called after Lisp functions to decide a coding
system are called, or when they cause an error. Before they are
@@ -4835,8 +4774,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename,
if (!NILP (handler))
{
Lisp_Object val;
- val = call6 (handler, Qwrite_region, start, end,
- filename, append, visit);
+ val = call8 (handler, Qwrite_region, start, end,
+ filename, append, visit, lockname, mustbenew);
if (visiting)
{
@@ -5560,7 +5499,7 @@ and are changed since last auto-saved.
Auto-saving writes the buffer into a file
so that your editing is not lost if the system crashes.
This file is not the file you visited; that changes only when you save.
-Normally we run the normal hook `auto-save-hook' before saving.
+Normally, run the normal hook `auto-save-hook' before saving.
A non-nil NO-MESSAGE argument means do not print any message if successful.
A non-nil CURRENT-ONLY argument means save only current buffer. */)
@@ -5647,14 +5586,12 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */)
{
block_input ();
if (!NILP (BVAR (b, filename)))
- {
- fwrite (SDATA (BVAR (b, filename)), 1,
- SBYTES (BVAR (b, filename)), stream);
- }
- putc ('\n', stream);
- fwrite (SDATA (BVAR (b, auto_save_file_name)), 1,
- SBYTES (BVAR (b, auto_save_file_name)), stream);
- putc ('\n', stream);
+ fwrite_unlocked (SDATA (BVAR (b, filename)), 1,
+ SBYTES (BVAR (b, filename)), stream);
+ putc_unlocked ('\n', stream);
+ fwrite_unlocked (SDATA (BVAR (b, auto_save_file_name)), 1,
+ SBYTES (BVAR (b, auto_save_file_name)), stream);
+ putc_unlocked ('\n', stream);
unblock_input ();
}
@@ -5845,11 +5782,57 @@ effect except for flushing STREAM's data. */)
binmode = NILP (mode) ? O_TEXT : O_BINARY;
if (fp != stdin)
- fflush (fp);
+ fflush_unlocked (fp);
return (set_binary_mode (fileno (fp), binmode) == O_BINARY) ? Qt : Qnil;
}
+#ifndef DOS_NT
+
+/* Yield a Lisp float as close as possible to BLOCKSIZE * BLOCKS, with
+ the result negated if NEGATE. */
+static Lisp_Object
+blocks_to_bytes (uintmax_t blocksize, uintmax_t blocks, bool negate)
+{
+ /* On typical platforms the following code is accurate to 53 bits,
+ which is close enough. BLOCKSIZE is invariably a power of 2, so
+ converting it to double does not lose information. */
+ double bs = blocksize;
+ return make_float (negate ? -bs * -blocks : bs * blocks);
+}
+
+DEFUN ("file-system-info", Ffile_system_info, Sfile_system_info, 1, 1, 0,
+ doc: /* Return storage information about the file system FILENAME is on.
+Value is a list of numbers (TOTAL FREE AVAIL), where TOTAL is the total
+storage of the file system, FREE is the free storage, and AVAIL is the
+storage available to a non-superuser. All 3 numbers are in bytes.
+If the underlying system call fails, value is nil. */)
+ (Lisp_Object filename)
+{
+ Lisp_Object encoded = ENCODE_FILE (Fexpand_file_name (filename, Qnil));
+
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info);
+ if (!NILP (handler))
+ {
+ Lisp_Object result = call2 (handler, Qfile_system_info, encoded);
+ if (CONSP (result) || NILP (result))
+ return result;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
+
+ struct fs_usage u;
+ if (get_fs_usage (SSDATA (encoded), NULL, &u) != 0)
+ return Qnil;
+ return list3 (blocks_to_bytes (u.fsu_blocksize, u.fsu_blocks, false),
+ blocks_to_bytes (u.fsu_blocksize, u.fsu_bfree, false),
+ blocks_to_bytes (u.fsu_blocksize, u.fsu_bavail,
+ u.fsu_bavail_top_bit_set));
+}
+
+#endif /* !DOS_NT */
+
void
init_fileio (void)
{
@@ -5920,6 +5903,7 @@ syms_of_fileio (void)
DEFSYM (Qwrite_region, "write-region");
DEFSYM (Qverify_visited_file_modtime, "verify-visited-file-modtime");
DEFSYM (Qset_visited_file_modtime, "set-visited-file-modtime");
+ DEFSYM (Qfile_system_info, "file-system-info");
/* The symbol bound to coding-system-for-read when
insert-file-contents is called for recovering a file. This is not
@@ -6096,7 +6080,7 @@ This applies only to the operation `inhibit-file-name-operation'. */);
Vinhibit_file_name_operation = Qnil;
DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name,
- doc: /* File name in which we write a list of all auto save file names.
+ doc: /* File name in which to write a list of all auto save file names.
This variable is initialized automatically from `auto-save-list-file-prefix'
shortly after Emacs reads your init file, if you have not yet given it
a non-nil value. */);
@@ -6151,7 +6135,9 @@ This includes interactive calls to `delete-file' and
defsubr (&Sfile_name_nondirectory);
defsubr (&Sunhandled_file_name_directory);
defsubr (&Sfile_name_as_directory);
+ defsubr (&Sdirectory_name_p);
defsubr (&Sdirectory_file_name);
+ defsubr (&Smake_temp_file_internal);
defsubr (&Smake_temp_name);
defsubr (&Sexpand_file_name);
defsubr (&Ssubstitute_in_file_name);
@@ -6198,6 +6184,10 @@ This includes interactive calls to `delete-file' and
defsubr (&Sset_binary_mode);
+#ifndef DOS_NT
+ defsubr (&Sfile_system_info);
+#endif
+
#ifdef HAVE_SYNC
defsubr (&Sunix_sync);
#endif
diff --git a/src/filelock.c b/src/filelock.c
index bfa1d63d833..a8bc17c37b6 100644
--- a/src/filelock.c
+++ b/src/filelock.c
@@ -19,7 +19,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -206,14 +206,11 @@ get_boot_time (void)
WTMP_FILE, counter);
if (! NILP (Ffile_exists_p (tempname)))
{
- /* The utmp functions on mescaline.gnu.org accept only
- file names up to 8 characters long. Choose a 2
- character long prefix, and call make_temp_file with
- second arg non-zero, so that it will add not more
- than 6 characters to the prefix. */
- filename = Fexpand_file_name (build_string ("wt"),
- Vtemporary_file_directory);
- filename = make_temp_name (filename, 1);
+ /* The utmp functions on older systems accept only file
+ names up to 8 bytes long. Choose a 2 byte prefix, so
+ the 6-byte suffix does not make the name too long. */
+ filename = Fmake_temp_file_internal (build_string ("wt"), Qnil,
+ empty_unibyte_string, Qnil);
CALLN (Fcall_process, build_string ("gzip"), Qnil,
list2 (QCfile, filename), Qnil,
build_string ("-cd"), tempname);
@@ -339,6 +336,9 @@ rename_lock_file (char const *old, char const *new, bool force)
{
struct stat st;
+ int r = renameat_noreplace (AT_FDCWD, old, AT_FDCWD, new);
+ if (! (r < 0 && errno == ENOSYS))
+ return r;
if (link (old, new) == 0)
return unlink (old) == 0 || errno == ENOENT ? 0 : -1;
if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK)
@@ -403,8 +403,6 @@ create_lock_file (char *lfname, char *lock_info_str, bool force)
else
{
ptrdiff_t lock_info_len;
- if (! O_CLOEXEC)
- fcntl (fd, F_SETFD, FD_CLOEXEC);
lock_info_len = strlen (lock_info_str);
err = 0;
if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len
diff --git a/src/firstfile.c b/src/firstfile.c
index c952e38aa6a..43f45f2bef5 100644
--- a/src/firstfile.c
+++ b/src/firstfile.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/floatfns.c b/src/floatfns.c
index 47553f27e82..47e94b8c862 100644
--- a/src/floatfns.c
+++ b/src/floatfns.c
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* C89 requires only the following math.h functions, and Emacs omits
diff --git a/src/fns.c b/src/fns.c
index 6610d2a6d0e..9db9bea9f78 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -35,6 +35,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "intervals.h"
#include "window.h"
#include "puresize.h"
+#include "gnutls.h"
+
+#if defined WINDOWSNT && defined HAVE_GNUTLS3
+# define gnutls_rnd w32_gnutls_rnd
+#endif
static void sort_vector_copy (Lisp_Object, ptrdiff_t,
Lisp_Object *restrict, Lisp_Object *restrict);
@@ -477,7 +482,9 @@ usage: (vconcat &rest SEQUENCES) */)
DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
doc: /* Return a copy of a list, vector, string, char-table or record.
The elements of a list, vector or record are not copied; they are
-shared with the original. */)
+shared with the original.
+If the original sequence is empty, this function may return
+the same empty object instead of its copy. */)
(Lisp_Object arg)
{
if (NILP (arg)) return arg;
@@ -1417,17 +1424,22 @@ assq_no_quit (Lisp_Object key, Lisp_Object list)
return Qnil;
}
-DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
- doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
-The value is actually the first element of LIST whose car equals KEY. */)
- (Lisp_Object key, Lisp_Object list)
+DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
+ doc: /* Return non-nil if KEY is equal to the car of an element of LIST.
+The value is actually the first element of LIST whose car equals KEY.
+
+Equality is defined by TESTFN if non-nil or by `equal' if nil. */)
+ (Lisp_Object key, Lisp_Object list, Lisp_Object testfn)
{
Lisp_Object tail = list;
FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
if (CONSP (car)
- && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
+ && (NILP (testfn)
+ ? (EQ (XCAR (car), key) || !NILP (Fequal
+ (XCAR (car), key)))
+ : !NILP (call2 (testfn, XCAR (car), key))))
return car;
}
CHECK_LIST_END (tail, list);
@@ -1977,7 +1989,11 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
(Lisp_Object symbol, Lisp_Object propname)
{
CHECK_SYMBOL (symbol);
- return Fplist_get (XSYMBOL (symbol)->plist, propname);
+ Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)),
+ propname);
+ if (!NILP (propval))
+ return propval;
+ return Fplist_get (XSYMBOL (symbol)->u.s.plist, propname);
}
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
@@ -2007,7 +2023,7 @@ The PLIST is modified by side effects. */)
if (EQ (tail, li.tortoise))
circular_list (plist);
}
- CHECK_LIST_END (tail, plist);
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
@@ -2023,7 +2039,7 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
{
CHECK_SYMBOL (symbol);
set_symbol_plist
- (symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value));
+ (symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
return value;
}
@@ -2047,7 +2063,7 @@ one of the properties on the list. */)
circular_list (plist);
}
- CHECK_LIST_END (tail, plist);
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
return Qnil;
}
@@ -2079,7 +2095,7 @@ The PLIST is modified by side effects. */)
if (EQ (tail, li.tortoise))
circular_list (plist);
}
- CHECK_LIST_END (tail, plist);
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
@@ -2844,7 +2860,7 @@ The value is actually the tail of PLIST whose car is PROP. */)
if (EQ (tail, li.tortoise))
circular_list (tail);
}
- CHECK_LIST_END (tail, plist);
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
return Qnil;
}
@@ -4735,22 +4751,42 @@ make_digest_string (Lisp_Object digest, int digest_size)
return digest;
}
-/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
+DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms,
+ Ssecure_hash_algorithms, 0, 0, 0,
+ doc: /* Return a list of all the supported `secure_hash' algorithms. */)
+ (void)
+{
+ return listn (CONSTYPE_HEAP, 6,
+ Qmd5,
+ Qsha1,
+ Qsha224,
+ Qsha256,
+ Qsha384,
+ Qsha512);
+}
-static Lisp_Object
-secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
- Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
- Lisp_Object binary)
+/* Extract data from a string or a buffer. SPEC is a list of
+(BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as
+specified with `secure-hash' and in Info node
+`(elisp)Format of GnuTLS Cryptography Inputs'. */
+char *
+extract_data_from_object (Lisp_Object spec,
+ ptrdiff_t *start_byte,
+ ptrdiff_t *end_byte)
{
- ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte;
- register EMACS_INT b, e;
- register struct buffer *bp;
- EMACS_INT temp;
- int digest_size;
- void *(*hash_func) (const char *, size_t, void *);
- Lisp_Object digest;
+ Lisp_Object object = XCAR (spec);
- CHECK_SYMBOL (algorithm);
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object start = CAR_SAFE (spec);
+
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object end = CAR_SAFE (spec);
+
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object coding_system = CAR_SAFE (spec);
+
+ if (CONSP (spec)) spec = XCDR (spec);
+ Lisp_Object noerror = CAR_SAFE (spec);
if (STRINGP (object))
{
@@ -4778,23 +4814,24 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 1);
- size = SCHARS (object);
+ ptrdiff_t size = SCHARS (object), start_char, end_char;
validate_subarray (object, start, end, size, &start_char, &end_char);
- start_byte = !start_char ? 0 : string_char_to_byte (object, start_char);
- end_byte = (end_char == size
- ? SBYTES (object)
- : string_char_to_byte (object, end_char));
+ *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char);
+ *end_byte = (end_char == size
+ ? SBYTES (object)
+ : string_char_to_byte (object, end_char));
}
- else
+ else if (BUFFERP (object))
{
struct buffer *prev = current_buffer;
+ EMACS_INT b, e;
record_unwind_current_buffer ();
CHECK_BUFFER (object);
- bp = XBUFFER (object);
+ struct buffer *bp = XBUFFER (object);
set_buffer_internal (bp);
if (NILP (start))
@@ -4814,7 +4851,11 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
}
if (b > e)
- temp = b, b = e, e = temp;
+ {
+ EMACS_INT temp = b;
+ b = e;
+ e = temp;
+ }
if (!(BEGV <= b && e <= ZV))
args_out_of_range (start, end);
@@ -4887,10 +4928,55 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
if (STRING_MULTIBYTE (object))
object = code_convert_string (object, coding_system, Qnil, 1, 0, 0);
- start_byte = 0;
- end_byte = SBYTES (object);
+ *start_byte = 0;
+ *end_byte = SBYTES (object);
+ }
+ else if (EQ (object, Qiv_auto))
+ {
+#ifdef HAVE_GNUTLS3
+ /* Format: (iv-auto REQUIRED-LENGTH). */
+
+ if (! NATNUMP (start))
+ error ("Without a length, `iv-auto' can't be used; see ELisp manual");
+ else
+ {
+ EMACS_INT start_hold = XFASTINT (start);
+ object = make_uninit_string (start_hold);
+ gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold);
+
+ *start_byte = 0;
+ *end_byte = start_hold;
+ }
+#else
+ error ("GnuTLS is not available, so `iv-auto' can't be used");
+#endif
}
+ return SSDATA (object);
+}
+
+
+/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */
+
+static Lisp_Object
+secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
+ Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror,
+ Lisp_Object binary)
+{
+ ptrdiff_t start_byte, end_byte;
+ int digest_size;
+ void *(*hash_func) (const char *, size_t, void *);
+ Lisp_Object digest;
+
+ CHECK_SYMBOL (algorithm);
+
+ Lisp_Object spec = list5 (object, start, end, coding_system, noerror);
+
+ const char *input = extract_data_from_object (spec, &start_byte, &end_byte);
+
+ if (input == NULL)
+ error ("secure_hash: failed to extract data from object, aborting!");
+
if (EQ (algorithm, Qmd5))
{
digest_size = MD5_DIGEST_SIZE;
@@ -4928,7 +5014,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start,
hexified value */
digest = make_uninit_string (digest_size * 2);
- hash_func (SSDATA (object) + start_byte,
+ hash_func (input + start_byte,
end_byte - start_byte,
SSDATA (digest));
@@ -4979,6 +5065,8 @@ The two optional arguments START and END are positions specifying for
which part of OBJECT to compute the hash. If nil or omitted, uses the
whole OBJECT.
+The full list of algorithms can be obtained with `secure-hash-algorithms'.
+
If BINARY is non-nil, returns a string in binary form. */)
(Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary)
{
@@ -5026,13 +5114,6 @@ disregarding any coding systems. If nil, use the current buffer. */ )
void
syms_of_fns (void)
{
- DEFSYM (Qmd5, "md5");
- DEFSYM (Qsha1, "sha1");
- DEFSYM (Qsha224, "sha224");
- DEFSYM (Qsha256, "sha256");
- DEFSYM (Qsha384, "sha384");
- DEFSYM (Qsha512, "sha512");
-
/* Hash table stuff. */
DEFSYM (Qhash_table_p, "hash-table-p");
DEFSYM (Qeq, "eq");
@@ -5069,6 +5150,18 @@ syms_of_fns (void)
defsubr (&Smaphash);
defsubr (&Sdefine_hash_table_test);
+ /* Crypto and hashing stuff. */
+ DEFSYM (Qiv_auto, "iv-auto");
+
+ DEFSYM (Qmd5, "md5");
+ DEFSYM (Qsha1, "sha1");
+ DEFSYM (Qsha224, "sha224");
+ DEFSYM (Qsha256, "sha256");
+ DEFSYM (Qsha384, "sha384");
+ DEFSYM (Qsha512, "sha512");
+
+ /* Miscellaneous stuff. */
+
DEFSYM (Qstring_lessp, "string-lessp");
DEFSYM (Qprovide, "provide");
DEFSYM (Qrequire, "require");
@@ -5076,6 +5169,13 @@ syms_of_fns (void)
DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area");
DEFSYM (Qwidget_type, "widget-type");
+ DEFVAR_LISP ("overriding-plist-environment", Voverriding_plist_environment,
+ doc: /* An alist that overrides the plists of the symbols which it lists.
+Used by the byte-compiler to apply `define-symbol-prop' during
+compilation. */);
+ Voverriding_plist_environment = Qnil;
+ DEFSYM (Qoverriding_plist_environment, "overriding-plist-environment");
+
staticpro (&string_char_byte_cache_string);
string_char_byte_cache_string = Qnil;
@@ -5093,6 +5193,7 @@ Used by `featurep' and `require', and altered by `provide'. */);
Fmake_var_non_special (Qfeatures);
DEFSYM (Qsubfeatures, "subfeatures");
DEFSYM (Qfuncall, "funcall");
+ DEFSYM (Qplistp, "plistp");
#ifdef HAVE_LANGINFO_CODESET
DEFSYM (Qcodeset, "codeset");
@@ -5187,6 +5288,7 @@ this variable. */);
defsubr (&Sbase64_encode_string);
defsubr (&Sbase64_decode_string);
defsubr (&Smd5);
+ defsubr (&Ssecure_hash_algorithms);
defsubr (&Ssecure_hash);
defsubr (&Sbuffer_hash);
defsubr (&Slocale_info);
diff --git a/src/font.c b/src/font.c
index 5a3f271ef85..441652b0951 100644
--- a/src/font.c
+++ b/src/font.c
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <float.h>
@@ -1893,7 +1893,7 @@ otf_tag_symbol (OTF_Tag tag)
static OTF *
otf_open (Lisp_Object file)
{
- Lisp_Object val = Fassoc (file, otf_list);
+ Lisp_Object val = Fassoc (file, otf_list, Qnil);
OTF *otf;
if (! NILP (val))
@@ -3794,19 +3794,26 @@ font_range (ptrdiff_t pos, ptrdiff_t pos_byte, ptrdiff_t *limit,
int c;
Lisp_Object font_object = Qnil;
- if (NILP (string))
+ if (!face)
{
- if (! face)
+ struct frame *f = XFRAME (w->frame);
+ int face_id;
+
+ if (NILP (string))
+ face_id = face_at_buffer_position (w, pos, &ignore, *limit,
+ false, -1);
+ else
{
- int face_id;
+ face_id =
+ NILP (Vface_remapping_alist)
+ ? DEFAULT_FACE_ID
+ : lookup_basic_face (f, DEFAULT_FACE_ID);
- face_id = face_at_buffer_position (w, pos, &ignore,
- *limit, false, -1);
- face = FACE_FROM_ID (XFRAME (w->frame), face_id);
+ face_id = face_at_string_position (w, string, pos, 0, &ignore,
+ face_id, false);
}
+ face = FACE_FROM_ID (f, face_id);
}
- else
- eassert (face);
while (pos < *limit)
{
@@ -5421,19 +5428,22 @@ gets the repertory information by an opened font and ENCODING. */);
doc: /* Vector of valid font weight values.
Each element has the form:
[NUMERIC-VALUE SYMBOLIC-NAME ALIAS-NAME ...]
-NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols. */);
+NUMERIC-VALUE is an integer, and SYMBOLIC-NAME and ALIAS-NAME are symbols.
+This variable cannot be set; trying to do so will signal an error. */);
Vfont_weight_table = BUILD_STYLE_TABLE (weight_table);
make_symbol_constant (intern_c_string ("font-weight-table"));
DEFVAR_LISP_NOPRO ("font-slant-table", Vfont_slant_table,
doc: /* Vector of font slant symbols vs the corresponding numeric values.
-See `font-weight-table' for the format of the vector. */);
+See `font-weight-table' for the format of the vector.
+This variable cannot be set; trying to do so will signal an error. */);
Vfont_slant_table = BUILD_STYLE_TABLE (slant_table);
make_symbol_constant (intern_c_string ("font-slant-table"));
DEFVAR_LISP_NOPRO ("font-width-table", Vfont_width_table,
doc: /* Alist of font width symbols vs the corresponding numeric values.
-See `font-weight-table' for the format of the vector. */);
+See `font-weight-table' for the format of the vector.
+This variable cannot be set; trying to do so will signal an error. */);
Vfont_width_table = BUILD_STYLE_TABLE (width_table);
make_symbol_constant (intern_c_string ("font-width-table"));
diff --git a/src/font.h b/src/font.h
index 53e3fc21a3d..43d6f67e3e9 100644
--- a/src/font.h
+++ b/src/font.h
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_FONT_H
#define EMACS_FONT_H
@@ -244,7 +244,7 @@ enum font_property_index
struct font_spec
{
- struct vectorlike_header header;
+ union vectorlike_header header;
Lisp_Object props[FONT_SPEC_MAX];
};
@@ -252,7 +252,7 @@ struct font_spec
struct font_entity
{
- struct vectorlike_header header;
+ union vectorlike_header header;
Lisp_Object props[FONT_ENTITY_MAX];
};
@@ -265,7 +265,7 @@ struct font_entity
struct font
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* All Lisp_Object components must come first.
That ensures they are all aligned normally. */
diff --git a/src/fontset.c b/src/fontset.c
index 850558b08a0..35586ad5c7d 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -22,7 +22,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
@@ -1186,7 +1186,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern)
{
tem = Frassoc (name, Vfontset_alias_alist);
if (NILP (tem))
- tem = Fassoc (name, Vfontset_alias_alist);
+ tem = Fassoc (name, Vfontset_alias_alist, Qnil);
if (CONSP (tem) && STRINGP (XCAR (tem)))
name = XCAR (tem);
else if (name_pattern == 0)
diff --git a/src/fontset.h b/src/fontset.h
index 8bf9f754fbd..cd6709dac2a 100644
--- a/src/fontset.h
+++ b/src/fontset.h
@@ -21,7 +21,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_FONTSET_H
#define EMACS_FONTSET_H
diff --git a/src/frame.c b/src/frame.c
index 4d17a071dc7..5bafbeddcce 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -328,8 +328,8 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
* frame_windows_min_size:
*
* Return the minimum number of lines (columns if HORIZONTAL is non-nil)
- * of FRAME. If PIXELWISE is non-nil, return the minimum height (width)
- * in pixels.
+ * of FRAME. If PIXELWISE is non-nil, return the minimum inner height
+ * (width) of FRAME in pixels.
*
* This value is calculated by the function `frame-windows-min-size' in
* window.el unless the `min-height' (`min-width' if HORIZONTAL is
@@ -341,7 +341,7 @@ DEFUN ("frame-windows-min-size", Fframe_windows_min_size,
* of `window-min-height' (`window-min-width' if HORIZONTAL is non-nil).
* With IGNORE non-nil the values of these variables are ignored.
*
- * In either case never return a value less than 1.
+ * In either case, never return a value less than 1.
*/
static int
frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
@@ -373,46 +373,173 @@ frame_windows_min_size (Lisp_Object frame, Lisp_Object horizontal,
}
-/* Make sure windows sizes of frame F are OK. new_width and new_height
- are in pixels. A value of -1 means no change is requested for that
- size (but the frame may still have to be resized to accommodate
- windows with their minimum sizes). This can either issue a request
- to resize the frame externally (via x_set_window_size), to resize the
- frame internally (via resize_frame_windows) or do nothing at all.
+#ifdef HAVE_WINDOW_SYSTEM
+/**
+ * keep_ratio:
+ *
+ * Preserve ratios of frame F which usually happens after its parent
+ * frame P got resized. OLD_WIDTH, OLD_HEIGHT specifies the old native
+ * size of F's parent, NEW_WIDTH and NEW_HEIGHT its new size.
+ *
+ * Adjust F's width if F's 'keep_ratio' parameter is non-nil and, if
+ * it is a cons, its car is not 'height-only'. Adjust F's height if F's
+ * 'keep_ratio' parameter is non-nil and, if it is a cons, its car
+ * is not 'width-only'.
+ *
+ * Adjust F's left position if F's 'keep_ratio' parameter is non-nil
+ * and, if its is a cons, its cdr is non-nil and not 'top-only'. Adjust
+ * F's top position if F's 'keep_ratio' parameter is non-nil and, if
+ * its is a cons, its cdr is non-nil and not 'left-only'.
+ *
+ * Note that when positional adjustment is requested but the size of F
+ * should remain unaltered in the corresponding direction, this routine
+ * tries to constrain F to its parent frame - something which usually
+ * happens when the parent frame shrinks. This means, however, that
+ * when the parent frame is re-enlarged later, the child's original
+ * position will not get restored to its pre-shrinking value.
+ *
+ * This routine is currently useful for child frames only. It might be
+ * eventually useful when moving non-child frames between monitors with
+ * different resolutions.
+ */
+static void
+keep_ratio (struct frame *f, struct frame *p, int old_width, int old_height,
+ int new_width, int new_height)
+{
+ Lisp_Object keep_ratio = get_frame_param (f, Qkeep_ratio);
- The argument INHIBIT can assume the following values:
- 0 means to unconditionally call x_set_window_size even if sizes
- apparently do not change. Fx_create_frame uses this to pass the
- initial size to the window manager.
+ if (!NILP (keep_ratio))
+ {
+ double width_factor = (double)new_width / (double)old_width;
+ double height_factor = (double)new_height / (double)old_height;
+ int pixel_width, pixel_height, pos_x, pos_y;
- 1 means to call x_set_window_size if the outer frame size really
- changes. Fset_frame_size, Fset_frame_height, ... use this.
+ if (!CONSP (keep_ratio) || !NILP (Fcdr (keep_ratio)))
+ {
+ if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qtop_only))
+ pos_x = f->left_pos;
+ else
+ {
+ pos_x = (int)(f->left_pos * width_factor + 0.5);
- 2 means to call x_set_window_size provided frame_inhibit_resize
- allows it. The menu and tool bar code use this ("3" won't work
- here in general because menu and tool bar are often not counted in
- the frame's text height).
+ if (CONSP (keep_ratio)
+ && (NILP (Fcar (keep_ratio))
+ || EQ (Fcar (keep_ratio), Qheight_only))
+ && p->pixel_width - f->pixel_width < pos_x)
+ {
+ int p_f_width = p->pixel_width - f->pixel_width;
- 3 means call x_set_window_size if window minimum sizes must be
- preserved or frame_inhibit_resize allows it. x_set_left_fringe,
- x_set_scroll_bar_width, x_new_font ... use (or should use) this.
+ if (p_f_width <= 0)
+ pos_x = 0;
+ else
+ pos_x = (int)(p_f_width * width_factor * 0.5 + 0.5);
+ }
- 4 means call x_set_window_size only if window minimum sizes must be
- preserved. x_set_right_divider_width, x_set_border_width and the
- code responsible for wrapping the tool bar use this.
+ f->left_pos = pos_x;
+ }
- 5 means to never call x_set_window_size. change_frame_size uses
- this.
+ if (CONSP (keep_ratio) && EQ (Fcdr (keep_ratio), Qleft_only))
+ pos_y = f->top_pos;
+ else
+ {
+ pos_y = (int)(f->top_pos * height_factor + 0.5);
+
+ if (CONSP (keep_ratio)
+ && (NILP (Fcar (keep_ratio))
+ || EQ (Fcar (keep_ratio), Qwidth_only))
+ && p->pixel_height - f->pixel_height < pos_y)
+ /* When positional adjustment was requested and the
+ width of F should remain unaltered, try to constrain
+ F to its parent. This means that when the parent
+ frame is enlarged later the child's original position
+ won't get restored. */
+ {
+ int p_f_height = p->pixel_height - f->pixel_height;
- Note that even when x_set_window_size is not called, individual
- windows may have to be resized (via `window--sanitize-window-sizes')
- in order to support minimum size constraints.
+ if (p_f_height <= 0)
+ pos_y = 0;
+ else
+ pos_y = (int)(p_f_height * height_factor * 0.5 + 0.5);
+ }
+
+ f->top_pos = pos_y;
+ }
- PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the
- symbol of the parameter changed (like `menu-bar-lines', `font', ...).
- This is passed on to frame_inhibit_resize to let the latter decide on
- a case-by-case basis whether the frame may be resized externally. */
+ x_set_offset (f, pos_x, pos_y, -1);
+ }
+
+ if (!CONSP (keep_ratio) || !NILP (Fcar (keep_ratio)))
+ {
+ if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qheight_only))
+ pixel_width = -1;
+ else
+ {
+ pixel_width = (int)(f->pixel_width * width_factor + 0.5);
+ pixel_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, pixel_width);
+ }
+
+ if (CONSP (keep_ratio) && EQ (Fcar (keep_ratio), Qwidth_only))
+ pixel_height = -1;
+ else
+ {
+ pixel_height = (int)(f->pixel_height * height_factor + 0.5);
+ pixel_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, pixel_height);
+ }
+
+ adjust_frame_size (f, pixel_width, pixel_height, 1, 0,
+ Qkeep_ratio);
+ }
+ }
+}
+#endif
+
+
+/**
+ * adjust_frame_size:
+ *
+ * Adjust size of frame F. NEW_WIDTH and NEW_HEIGHT specify the new
+ * text size of F in pixels. A value of -1 means no change is requested
+ * for that direction (but the frame may still have to be resized to
+ * accommodate windows with their minimum sizes). This can either issue
+ * a request to resize the frame externally (via x_set_window_size), to
+ * resize the frame internally (via resize_frame_windows) or do nothing
+ * at all.
+ *
+ * The argument INHIBIT can assume the following values:
+ *
+ * 0 means to unconditionally call x_set_window_size even if sizes
+ * apparently do not change. Fx_create_frame uses this to pass the
+ * initial size to the window manager.
+ *
+ * 1 means to call x_set_window_size if the native frame size really
+ * changes. Fset_frame_size, Fset_frame_height, ... use this.
+ *
+ * 2 means to call x_set_window_size provided frame_inhibit_resize
+ * allows it. The menu and tool bar code use this ("3" won't work
+ * here in general because menu and tool bar are often not counted in
+ * the frame's text height).
+ *
+ * 3 means call x_set_window_size if window minimum sizes must be
+ * preserved or frame_inhibit_resize allows it. x_set_left_fringe,
+ * x_set_scroll_bar_width, x_new_font ... use (or should use) this.
+ *
+ * 4 means call x_set_window_size only if window minimum sizes must be
+ * preserved. x_set_right_divider_width, x_set_border_width and the
+ * code responsible for wrapping the tool bar use this.
+ *
+ * 5 means to never call x_set_window_size. change_frame_size uses
+ * this.
+ *
+ * Note that even when x_set_window_size is not called, individual
+ * windows may have to be resized (via `window--sanitize-window-sizes')
+ * in order to support minimum size constraints.
+ *
+ * PRETEND is as for change_frame_size. PARAMETER, if non-nil, is the
+ * symbol of the parameter changed (like `menu-bar-lines', `font', ...).
+ * This is passed on to frame_inhibit_resize to let the latter decide on
+ * a case-by-case basis whether the frame may be resized externally.
+ */
void
adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
bool pretend, Lisp_Object parameter)
@@ -636,6 +763,18 @@ adjust_frame_size (struct frame *f, int new_width, int new_height, int inhibit,
|| new_pixel_height != old_pixel_height);
unblock_input ();
+
+#ifdef HAVE_WINDOW_SYSTEM
+ {
+ /* Adjust size of F's child frames. */
+ Lisp_Object frames, frame1;
+
+ FOR_EACH_FRAME (frames, frame1)
+ if (FRAME_PARENT_FRAME (XFRAME (frame1)) == f)
+ keep_ratio (XFRAME (frame1), f, old_pixel_width, old_pixel_height,
+ new_pixel_width, new_pixel_height);
+ }
+#endif
}
/* Allocate basically initialized frame. */
@@ -684,6 +823,7 @@ make_frame (bool mini_p)
f->horizontal_scroll_bars = false;
f->want_fullscreen = FULLSCREEN_NONE;
f->undecorated = false;
+ f->no_special_glyphs = false;
#ifndef HAVE_NTGUI
f->override_redirect = false;
#endif
@@ -694,6 +834,10 @@ make_frame (bool mini_p)
#if ! defined (USE_GTK) && ! defined (HAVE_NS)
f->last_tool_bar_item = -1;
#endif
+#ifdef NS_IMPL_COCOA
+ f->ns_appearance = ns_appearance_aqua;
+ f->ns_transparent_titlebar = false;
+#endif
#endif
root_window = make_window ();
@@ -1328,7 +1472,11 @@ DEFUN ("frame-list", Fframe_list, Sframe_list,
Lisp_Object frames;
frames = Fcopy_sequence (Vframe_list);
#ifdef HAVE_WINDOW_SYSTEM
- if (FRAMEP (tip_frame))
+ if (FRAMEP (tip_frame)
+#ifdef USE_GTK
+ && !NILP (Fframe_parameter (tip_frame, Qtooltip))
+#endif
+ )
frames = Fdelq (tip_frame, frames);
#endif
return frames;
@@ -1769,9 +1917,10 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
/* Look for another visible frame on the same terminal.
Do not call next_frame here because it may loop forever.
- See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */
+ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */
FOR_EACH_FRAME (tail, frame1)
if (!EQ (frame, frame1)
+ && NILP (Fframe_parameter (frame1, Qtooltip))
&& (FRAME_TERMINAL (XFRAME (frame))
== FRAME_TERMINAL (XFRAME (frame1)))
&& FRAME_VISIBLE_P (XFRAME (frame1)))
@@ -1782,7 +1931,9 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
{
FOR_EACH_FRAME (tail, frame1)
{
- if (! EQ (frame, frame1) && FRAME_LIVE_P (XFRAME (frame1)))
+ if (!EQ (frame, frame1)
+ && FRAME_LIVE_P (XFRAME (frame1))
+ && NILP (Fframe_parameter (frame1, Qtooltip)))
{
/* Do not change a text terminal's top-frame. */
struct frame *f1 = XFRAME (frame1);
@@ -1882,13 +2033,17 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
/* If needed, delete the terminal that this frame was on.
(This must be done after the frame is killed.) */
terminal->reference_count--;
-#ifdef USE_GTK
+#if defined (USE_X_TOOLKIT) || defined (USE_GTK)
/* FIXME: Deleting the terminal crashes emacs because of a GTK
bug.
- http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */
+ https://lists.gnu.org/r/emacs-devel/2011-10/msg00363.html */
+
+ /* Since a similar behavior was observed on the Lucid and Motif
+ builds (see Bug#5802, Bug#21509, Bug#23499, Bug#27816), we now
+ don't delete the terminal for these builds either. */
if (terminal->reference_count == 0 && terminal->type == output_x_window)
terminal->reference_count = 1;
-#endif /* USE_GTK */
+#endif /* USE_X_TOOLKIT || USE_GTK */
if (terminal->reference_count == 0)
{
Lisp_Object tmp;
@@ -2004,8 +2159,101 @@ The functions are run with one argument, the frame to be deleted. */)
{
return delete_frame (frame, !NILP (force) ? Qt : Qnil);
}
-
+#ifdef HAVE_WINDOW_SYSTEM
+/**
+ * frame_internal_border_part:
+ *
+ * Return part of internal border the coordinates X and Y relative to
+ * frame F are on. Return nil if the coordinates are not on the
+ * internal border of F.
+ *
+ * Return one of INTERNAL_BORDER_LEFT_EDGE, INTERNAL_BORDER_TOP_EDGE,
+ * INTERNAL_BORDER_RIGHT_EDGE or INTERNAL_BORDER_BOTTOM_EDGE when the
+ * mouse cursor is on the corresponding border with an offset of at
+ * least one canonical character height from that border's edges.
+ *
+ * If no border part could be found this way, return one of
+ * INTERNAL_BORDER_TOP_LEFT_CORNER, INTERNAL_BORDER_TOP_RIGHT_CORNER,
+ * INTERNAL_BORDER_BOTTOM_LEFT_CORNER or
+ * INTERNAL_BORDER_BOTTOM_RIGHT_CORNER to indicate that the mouse is in
+ * one of the corresponding corners. This means that for very small
+ * frames an `edge' return value is preferred.
+ */
+enum internal_border_part
+frame_internal_border_part (struct frame *f, int x, int y)
+{
+ int border = FRAME_INTERNAL_BORDER_WIDTH (f);
+ int offset = FRAME_LINE_HEIGHT (f);
+ int width = FRAME_PIXEL_WIDTH (f);
+ int height = FRAME_PIXEL_HEIGHT (f);
+ enum internal_border_part part = INTERNAL_BORDER_NONE;
+
+ if (offset < border)
+ /* For very wide borders make offset at least as large as
+ border. */
+ offset = border;
+
+ if (offset < x && x < width - offset)
+ /* Top or bottom border. */
+ {
+ if (0 <= y && y <= border)
+ part = INTERNAL_BORDER_TOP_EDGE;
+ else if (height - border <= y && y <= height)
+ part = INTERNAL_BORDER_BOTTOM_EDGE;
+ }
+ else if (offset < y && y < height - offset)
+ /* Left or right border. */
+ {
+ if (0 <= x && x <= border)
+ part = INTERNAL_BORDER_LEFT_EDGE;
+ else if (width - border <= x && x <= width)
+ part = INTERNAL_BORDER_RIGHT_EDGE;
+ }
+ else
+ {
+ /* An edge. */
+ int half_width = width / 2;
+ int half_height = height / 2;
+
+ if (0 <= x && x <= border)
+ {
+ /* A left edge. */
+ if (0 <= y && y <= half_height)
+ part = INTERNAL_BORDER_TOP_LEFT_CORNER;
+ else if (half_height < y && y <= height)
+ part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER;
+ }
+ else if (width - border <= x && x <= width)
+ {
+ /* A right edge. */
+ if (0 <= y && y <= half_height)
+ part = INTERNAL_BORDER_TOP_RIGHT_CORNER;
+ else if (half_height < y && y <= height)
+ part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER;
+ }
+ else if (0 <= y && y <= border)
+ {
+ /* A top edge. */
+ if (0 <= x && x <= half_width)
+ part = INTERNAL_BORDER_TOP_LEFT_CORNER;
+ else if (half_width < x && x <= width)
+ part = INTERNAL_BORDER_TOP_RIGHT_CORNER;
+ }
+ else if (height - border <= y && y <= height)
+ {
+ /* A bottom edge. */
+ if (0 <= x && x <= half_width)
+ part = INTERNAL_BORDER_BOTTOM_LEFT_CORNER;
+ else if (half_width < x && x <= width)
+ part = INTERNAL_BORDER_BOTTOM_RIGHT_CORNER;
+ }
+ }
+
+ return part;
+}
+#endif
+
/* Return mouse position in character cell units. */
DEFUN ("mouse-position", Fmouse_position, Smouse_position, 0, 0, 0,
@@ -2294,10 +2542,35 @@ displayed in the terminal. */)
DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame,
0, 1, "",
doc: /* Make the frame FRAME into an icon.
-If omitted, FRAME defaults to the currently selected frame. */)
+If omitted, FRAME defaults to the currently selected frame.
+
+If FRAME is a child frame, consult the variable `iconify-child-frame'
+for how to proceed. */)
(Lisp_Object frame)
{
struct frame *f = decode_live_frame (frame);
+#ifdef HAVE_WINDOW_SYSTEM
+ Lisp_Object parent = f->parent_frame;
+
+ if (!NILP (parent))
+ {
+ if (NILP (iconify_child_frame))
+ /* Do nothing. */
+ return Qnil;
+ else if (EQ (iconify_child_frame, Qiconify_top_level))
+ {
+ /* Iconify top level frame instead (the default). */
+ Ficonify_frame (parent);
+ return Qnil;
+ }
+ else if (EQ (iconify_child_frame, Qmake_invisible))
+ {
+ /* Make frame invisible instead. */
+ Fmake_frame_invisible (frame, Qnil);
+ return Qnil;
+ }
+ }
+#endif /* HAVE_WINDOW_SYSTEM */
/* Don't allow minibuf_window to remain on an iconified frame. */
check_minibuf_window (frame, EQ (minibuf_window, selected_window));
@@ -2962,49 +3235,47 @@ For a terminal screen, the value is always 1. */)
return make_number (1);
}
-DEFUN ("frame-pixel-height", Fframe_pixel_height,
- Sframe_pixel_height, 0, 1, 0,
- doc: /* Return a FRAME's height in pixels.
-If FRAME is omitted or nil, the selected frame is used. The exact value
-of the result depends on the window-system and toolkit in use:
-
-In the Gtk+ version of Emacs, it includes only any window (including
-the minibuffer or echo area), mode line, and header line. It does not
-include the tool bar or menu bar.
-
-With other graphical versions, it also includes the tool bar and the
-menu bar.
-
-For a text terminal, it includes the menu bar. In this case, the
-result is really in characters rather than pixels (i.e., is identical
-to `frame-height'). */)
+DEFUN ("frame-native-width", Fframe_native_width,
+ Sframe_native_width, 0, 1, 0,
+ doc: /* Return FRAME's native width in pixels.
+For a terminal frame, the result really gives the width in characters.
+If FRAME is omitted or nil, the selected frame is used. */)
(Lisp_Object frame)
{
struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
- return make_number (FRAME_PIXEL_HEIGHT (f));
+ return make_number (FRAME_PIXEL_WIDTH (f));
else
#endif
- return make_number (FRAME_TOTAL_LINES (f));
+ return make_number (FRAME_TOTAL_COLS (f));
}
-DEFUN ("frame-pixel-width", Fframe_pixel_width,
- Sframe_pixel_width, 0, 1, 0,
- doc: /* Return FRAME's width in pixels.
-For a terminal frame, the result really gives the width in characters.
-If FRAME is omitted or nil, the selected frame is used. */)
+DEFUN ("frame-native-height", Fframe_native_height,
+ Sframe_native_height, 0, 1, 0,
+ doc: /* Return FRAME's native height in pixels.
+If FRAME is omitted or nil, the selected frame is used. The exact value
+of the result depends on the window-system and toolkit in use:
+
+In the Gtk+ and NS versions, it includes only any window (including the
+minibuffer or echo area), mode line, and header line. It does not
+include the tool bar or menu bar. With other graphical versions, it may
+also include the tool bar and the menu bar.
+
+For a text terminal, it includes the menu bar. In this case, the
+result is really in characters rather than pixels (i.e., is identical
+to `frame-height'). */)
(Lisp_Object frame)
{
struct frame *f = decode_any_frame (frame);
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
- return make_number (FRAME_PIXEL_WIDTH (f));
+ return make_number (FRAME_PIXEL_HEIGHT (f));
else
#endif
- return make_number (FRAME_TOTAL_COLS (f));
+ return make_number (FRAME_TOTAL_LINES (f));
}
DEFUN ("tool-bar-pixel-width", Ftool_bar_pixel_width,
@@ -3087,8 +3358,8 @@ DEFUN ("frame-fringe-width", Ffringe_width, Sfringe_width, 0, 1, 0,
return make_number (FRAME_TOTAL_FRINGE_WIDTH (decode_any_frame (frame)));
}
-DEFUN ("frame-border-width", Fborder_width, Sborder_width, 0, 1, 0,
- doc: /* Return border width of FRAME in pixels. */)
+DEFUN ("frame-internal-border-width", Fframe_internal_border_width, Sframe_internal_border_width, 0, 1, 0,
+ doc: /* Return width of FRAME's internal border in pixels. */)
(Lisp_Object frame)
{
return make_number (FRAME_INTERNAL_BORDER_WIDTH (decode_any_frame (frame)));
@@ -3224,7 +3495,6 @@ bottom edge of FRAME's display. */)
return Qt;
}
-
/***********************************************************************
Frame Parameters
@@ -3289,10 +3559,197 @@ static const struct frame_parm_table frame_parms[] =
{"no-accept-focus", SYMBOL_INDEX (Qno_accept_focus)},
{"z-group", SYMBOL_INDEX (Qz_group)},
{"override-redirect", SYMBOL_INDEX (Qoverride_redirect)},
+ {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)},
+#ifdef NS_IMPL_COCOA
+ {"ns-appearance", SYMBOL_INDEX (Qns_appearance)},
+ {"ns-transparent-titlebar", SYMBOL_INDEX (Qns_transparent_titlebar)},
+#endif
};
#ifdef HAVE_WINDOW_SYSTEM
+/* Enumeration type for switch in frame_float. */
+enum frame_float_type
+{
+ FRAME_FLOAT_WIDTH,
+ FRAME_FLOAT_HEIGHT,
+ FRAME_FLOAT_LEFT,
+ FRAME_FLOAT_TOP
+};
+
+/**
+ * frame_float:
+ *
+ * Process the value VAL of the float type frame parameter 'width',
+ * 'height', 'left', or 'top' specified via a frame_float_type
+ * enumeration type WHAT for frame F. Such parameters relate the outer
+ * size or position of F to the size of the F's display or parent frame
+ * which have to be both available in some way.
+ *
+ * The return value is a size or position value in pixels. VAL must be
+ * in the range 0.0 to 1.0 where a width/height of 0.0 means to return 0
+ * and 1.0 means to return the full width/height of the display/parent.
+ * For positions, 0.0 means position in the left/top corner of the
+ * display/parent while 1.0 means to position at the right/bottom corner
+ * of the display/parent frame.
+ *
+ * Set PARENT_DONE and OUTER_DONE to avoid recalculation of the outer
+ * size or parent or display attributes when more float parameters are
+ * calculated in a row: -1 means not processed yet, 0 means processing
+ * failed, 1 means processing succeeded.
+ *
+ * Return DEFAULT_VALUE when processing fails for whatever reason with
+ * one exception: When calculating F's outer edges fails (probably
+ * because F has not been created yet) return the difference between F's
+ * native and text size.
+ */
+static int
+frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what,
+ int *parent_done, int *outer_done, int default_value)
+{
+ double d_val = XFLOAT_DATA (val);
+
+ if (d_val < 0.0 || d_val > 1.0)
+ /* Invalid VAL. */
+ return default_value;
+ else
+ {
+ static unsigned parent_width, parent_height;
+ static int parent_left, parent_top;
+ static unsigned outer_minus_text_width, outer_minus_text_height;
+ struct frame *p = FRAME_PARENT_FRAME (f);
+
+ if (*parent_done == 1)
+ ;
+ else if (p)
+ {
+ parent_width = FRAME_PIXEL_WIDTH (p);
+ parent_height = FRAME_PIXEL_HEIGHT (p);
+ *parent_done = 1;
+ }
+ else
+ {
+ if (*parent_done == 0)
+ /* No workarea available. */
+ return default_value;
+ else if (*parent_done == -1)
+ {
+ Lisp_Object monitor_attributes;
+ Lisp_Object workarea;
+ Lisp_Object frame;
+
+ XSETFRAME (frame, f);
+ monitor_attributes = Fcar (call1 (Qdisplay_monitor_attributes_list, frame));
+ if (NILP (monitor_attributes))
+ {
+ /* No monitor attributes available. */
+ *parent_done = 0;
+
+ return default_value;
+ }
+
+ workarea = Fcdr (Fassq (Qworkarea, monitor_attributes));
+ if (NILP (workarea))
+ {
+ /* No workarea available. */
+ *parent_done = 0;
+
+ return default_value;
+ }
+
+ /* Workarea available. */
+ parent_left = XINT (Fnth (make_number (0), workarea));
+ parent_top = XINT (Fnth (make_number (1), workarea));
+ parent_width = XINT (Fnth (make_number (2), workarea));
+ parent_height = XINT (Fnth (make_number (3), workarea));
+ *parent_done = 1;
+ }
+ }
+
+ if (*outer_done == 1)
+ ;
+ else if (FRAME_UNDECORATED (f))
+ {
+ outer_minus_text_width
+ = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f);
+ outer_minus_text_height
+ = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f);
+ *outer_done = 1;
+ }
+ else if (*outer_done == 0)
+ /* No outer size available. */
+ return default_value;
+ else if (*outer_done == -1)
+ {
+ Lisp_Object frame, outer_edges;
+
+ XSETFRAME (frame, f);
+ outer_edges = call2 (Qframe_edges, frame, Qouter_edges);
+
+ if (!NILP (outer_edges))
+ {
+ outer_minus_text_width
+ = (XINT (Fnth (make_number (2), outer_edges))
+ - XINT (Fnth (make_number (0), outer_edges))
+ - FRAME_TEXT_WIDTH (f));
+ outer_minus_text_height
+ = (XINT (Fnth (make_number (3), outer_edges))
+ - XINT (Fnth (make_number (1), outer_edges))
+ - FRAME_TEXT_HEIGHT (f));
+ }
+ else
+ {
+ /* If we can't get any outer edges, proceed as if the frame
+ were undecorated. */
+ outer_minus_text_width
+ = FRAME_PIXEL_WIDTH (f) - FRAME_TEXT_WIDTH (f);
+ outer_minus_text_height
+ = FRAME_PIXEL_HEIGHT (f) - FRAME_TEXT_HEIGHT (f);
+ }
+
+ *outer_done = 1;
+ }
+
+ switch (what)
+ {
+ case FRAME_FLOAT_WIDTH:
+ return parent_width * d_val - outer_minus_text_width;
+
+ case FRAME_FLOAT_HEIGHT:
+ return parent_height * d_val - outer_minus_text_height;
+
+ case FRAME_FLOAT_LEFT:
+ {
+ int rest_width = (parent_width
+ - FRAME_TEXT_WIDTH (f)
+ - outer_minus_text_width);
+
+ if (p)
+ return (rest_width <= 0 ? 0 : d_val * rest_width);
+ else
+ return (rest_width <= 0
+ ? parent_left
+ : parent_left + d_val * rest_width);
+ }
+ case FRAME_FLOAT_TOP:
+ {
+ int rest_height = (parent_height
+ - FRAME_TEXT_HEIGHT (f)
+ - outer_minus_text_height);
+
+ if (p)
+ return (rest_height <= 0 ? 0 : d_val * rest_height);
+ else
+ return (rest_height <= 0
+ ? parent_top
+ : parent_top + d_val * rest_height);
+ }
+ default:
+ emacs_abort ();
+ }
+ }
+}
+
/* Change the parameters of frame F as specified by ALIST.
If a parameter is not specially recognized, do nothing special;
otherwise call the `x_set_...' function for that parameter.
@@ -3302,7 +3759,8 @@ static const struct frame_parm_table frame_parms[] =
void
x_set_frame_parameters (struct frame *f, Lisp_Object alist)
{
- Lisp_Object tail;
+ Lisp_Object tail, frame;
+
/* If both of these parameters are present, it's more efficient to
set them both at once. So we wait until we've looked at the
@@ -3327,7 +3785,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
#ifdef HAVE_X_WINDOWS
bool icon_left_no_change = 0, icon_top_no_change = 0;
#endif
+ int parent_done = -1, outer_done = -1;
+ XSETFRAME (frame, f);
for (size = 0, tail = alist; CONSP (tail); tail = XCDR (tail))
size++;
CHECK_LIST_END (tail, alist);
@@ -3388,6 +3848,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
width = XFASTINT (XCDR (val));
+ else if (FLOATP (val))
+ width = frame_float (f, val, FRAME_FLOAT_WIDTH, &parent_done,
+ &outer_done, -1);
}
else if (EQ (prop, Qheight))
{
@@ -3396,6 +3859,9 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
else if (CONSP (val) && EQ (XCAR (val), Qtext_pixels)
&& RANGED_INTEGERP (0, XCDR (val), INT_MAX))
height = XFASTINT (XCDR (val));
+ else if (FLOATP (val))
+ height = frame_float (f, val, FRAME_FLOAT_HEIGHT, &parent_done,
+ &outer_done, -1);
}
else if (EQ (prop, Qtop))
top = val;
@@ -3472,105 +3938,100 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist)
Don't set these parameters unless they actually differ from the
window's current parameters; the window may not actually exist
yet. */
- {
- Lisp_Object frame;
-
- XSETFRAME (frame, f);
-
- if ((width != -1 && width != FRAME_TEXT_WIDTH (f))
- || (height != -1 && height != FRAME_TEXT_HEIGHT (f)))
- /* We could consider checking f->after_make_frame here, but I
- don't have the faintest idea why the following is needed at
- all. With the old setting it can get a Heisenbug when
- EmacsFrameResize intermittently provokes a delayed
- change_frame_size in the middle of adjust_frame_size. */
- /** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/
- adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
-
- if ((!NILP (left) || !NILP (top))
- && ! (left_no_change && top_no_change)
- && ! (NUMBERP (left) && XINT (left) == f->left_pos
- && NUMBERP (top) && XINT (top) == f->top_pos))
- {
- int leftpos = 0;
- int toppos = 0;
+ if ((width != -1 && width != FRAME_TEXT_WIDTH (f))
+ || (height != -1 && height != FRAME_TEXT_HEIGHT (f)))
+ /* We could consider checking f->after_make_frame here, but I
+ don't have the faintest idea why the following is needed at
+ all. With the old setting it can get a Heisenbug when
+ EmacsFrameResize intermittently provokes a delayed
+ change_frame_size in the middle of adjust_frame_size. */
+ /** || (f->can_x_set_window_size && (f->new_height || f->new_width))) **/
+ adjust_frame_size (f, width, height, 1, 0, Qx_set_frame_parameters);
+
+ if ((!NILP (left) || !NILP (top))
+ && ! (left_no_change && top_no_change)
+ && ! (NUMBERP (left) && XINT (left) == f->left_pos
+ && NUMBERP (top) && XINT (top) == f->top_pos))
+ {
+ int leftpos = 0;
+ int toppos = 0;
- /* Record the signs. */
- f->size_hint_flags &= ~ (XNegative | YNegative);
- if (EQ (left, Qminus))
- f->size_hint_flags |= XNegative;
- else if (TYPE_RANGED_INTEGERP (int, left))
- {
- leftpos = XINT (left);
- if (leftpos < 0)
- f->size_hint_flags |= XNegative;
- }
- else if (CONSP (left) && EQ (XCAR (left), Qminus)
- && CONSP (XCDR (left))
- && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
- {
- leftpos = - XINT (XCAR (XCDR (left)));
+ /* Record the signs. */
+ f->size_hint_flags &= ~ (XNegative | YNegative);
+ if (EQ (left, Qminus))
+ f->size_hint_flags |= XNegative;
+ else if (TYPE_RANGED_INTEGERP (int, left))
+ {
+ leftpos = XINT (left);
+ if (leftpos < 0)
f->size_hint_flags |= XNegative;
- }
- else if (CONSP (left) && EQ (XCAR (left), Qplus)
- && CONSP (XCDR (left))
- && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
- {
- leftpos = XINT (XCAR (XCDR (left)));
- }
+ }
+ else if (CONSP (left) && EQ (XCAR (left), Qminus)
+ && CONSP (XCDR (left))
+ && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (left)), INT_MAX))
+ {
+ leftpos = - XINT (XCAR (XCDR (left)));
+ f->size_hint_flags |= XNegative;
+ }
+ else if (CONSP (left) && EQ (XCAR (left), Qplus)
+ && CONSP (XCDR (left))
+ && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (left))))
+ leftpos = XINT (XCAR (XCDR (left)));
+ else if (FLOATP (left))
+ leftpos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
+ &outer_done, 0);
- if (EQ (top, Qminus))
- f->size_hint_flags |= YNegative;
- else if (TYPE_RANGED_INTEGERP (int, top))
- {
- toppos = XINT (top);
- if (toppos < 0)
- f->size_hint_flags |= YNegative;
- }
- else if (CONSP (top) && EQ (XCAR (top), Qminus)
- && CONSP (XCDR (top))
- && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
- {
- toppos = - XINT (XCAR (XCDR (top)));
+ if (EQ (top, Qminus))
+ f->size_hint_flags |= YNegative;
+ else if (TYPE_RANGED_INTEGERP (int, top))
+ {
+ toppos = XINT (top);
+ if (toppos < 0)
f->size_hint_flags |= YNegative;
- }
- else if (CONSP (top) && EQ (XCAR (top), Qplus)
- && CONSP (XCDR (top))
- && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
- {
- toppos = XINT (XCAR (XCDR (top)));
- }
-
+ }
+ else if (CONSP (top) && EQ (XCAR (top), Qminus)
+ && CONSP (XCDR (top))
+ && RANGED_INTEGERP (-INT_MAX, XCAR (XCDR (top)), INT_MAX))
+ {
+ toppos = - XINT (XCAR (XCDR (top)));
+ f->size_hint_flags |= YNegative;
+ }
+ else if (CONSP (top) && EQ (XCAR (top), Qplus)
+ && CONSP (XCDR (top))
+ && TYPE_RANGED_INTEGERP (int, XCAR (XCDR (top))))
+ toppos = XINT (XCAR (XCDR (top)));
+ else if (FLOATP (top))
+ toppos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
+ &outer_done, 0);
- /* Store the numeric value of the position. */
- f->top_pos = toppos;
- f->left_pos = leftpos;
+ /* Store the numeric value of the position. */
+ f->top_pos = toppos;
+ f->left_pos = leftpos;
- f->win_gravity = NorthWestGravity;
+ f->win_gravity = NorthWestGravity;
- /* Actually set that position, and convert to absolute. */
- x_set_offset (f, leftpos, toppos, -1);
- }
+ /* Actually set that position, and convert to absolute. */
+ x_set_offset (f, leftpos, toppos, -1);
+ }
- if (fullscreen_change)
- {
- Lisp_Object old_value = get_frame_param (f, Qfullscreen);
+ if (fullscreen_change)
+ {
+ Lisp_Object old_value = get_frame_param (f, Qfullscreen);
- frame_size_history_add
- (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen));
+ frame_size_history_add
+ (f, Qx_set_fullscreen, 0, 0, list2 (old_value, fullscreen));
- store_frame_param (f, Qfullscreen, fullscreen);
- if (!EQ (fullscreen, old_value))
- x_set_fullscreen (f, fullscreen, old_value);
- }
+ store_frame_param (f, Qfullscreen, fullscreen);
+ if (!EQ (fullscreen, old_value))
+ x_set_fullscreen (f, fullscreen, old_value);
+ }
#ifdef HAVE_X_WINDOWS
- if ((!NILP (icon_left) || !NILP (icon_top))
- && ! (icon_left_no_change && icon_top_no_change))
- x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
+ if ((!NILP (icon_left) || !NILP (icon_top))
+ && ! (icon_left_no_change && icon_top_no_change))
+ x_wm_set_icon_position (f, XINT (icon_left), XINT (icon_top));
#endif /* HAVE_X_WINDOWS */
- }
SAFE_FREE ();
}
@@ -3990,7 +4451,6 @@ x_set_right_divider_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
adjust_frame_glyphs (f);
SET_FRAME_GARBAGED (f);
}
-
}
void
@@ -4204,6 +4664,22 @@ x_set_alpha (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
return;
}
+
+/**
+ * x_set_no_special_glyphs:
+ *
+ * Set frame F's `no-special-glyphs' parameter which, if non-nil,
+ * suppresses the display of truncation and continuation glyphs
+ * outside fringes.
+ */
+void
+x_set_no_special_glyphs (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
+{
+ if (!EQ (new_value, old_value))
+ FRAME_NO_SPECIAL_GLYPHS (f) = !NILP (new_value);
+}
+
+
#ifndef HAVE_NS
/* Non-zero if mouse is grabbed on DPYINFO
@@ -4759,6 +5235,7 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
Lisp_Object height, width, user_size, top, left, user_position;
long window_prompting = 0;
Display_Info *dpyinfo = FRAME_DISPLAY_INFO (f);
+ int parent_done = -1, outer_done = -1;
/* Default values if we fall through.
Actually, if that happens we should get
@@ -4823,6 +5300,21 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
f->inhibit_horizontal_resize = true;
*x_width = XINT (XCDR (width));
}
+ else if (FLOATP (width))
+ {
+ double d_width = XFLOAT_DATA (width);
+
+ if (d_width < 0.0 || d_width > 1.0)
+ xsignal1 (Qargs_out_of_range, width);
+ else
+ {
+ int new_width = frame_float (f, width, FRAME_FLOAT_WIDTH,
+ &parent_done, &outer_done, -1);
+
+ if (new_width > -1)
+ SET_FRAME_WIDTH (f, new_width);
+ }
+ }
else
{
CHECK_NUMBER (width);
@@ -4845,6 +5337,21 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
f->inhibit_vertical_resize = true;
*x_height = XINT (XCDR (height));
}
+ else if (FLOATP (height))
+ {
+ double d_height = XFLOAT_DATA (height);
+
+ if (d_height < 0.0 || d_height > 1.0)
+ xsignal1 (Qargs_out_of_range, height);
+ else
+ {
+ int new_height = frame_float (f, height, FRAME_FLOAT_HEIGHT,
+ &parent_done, &outer_done, -1);
+
+ if (new_height > -1)
+ SET_FRAME_HEIGHT (f, new_height);
+ }
+ }
else
{
CHECK_NUMBER (height);
@@ -4885,6 +5392,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
{
f->top_pos = XINT (XCAR (XCDR (top)));
}
+ else if (FLOATP (top))
+ f->top_pos = frame_float (f, top, FRAME_FLOAT_TOP, &parent_done,
+ &outer_done, 0);
else if (EQ (top, Qunbound))
f->top_pos = 0;
else
@@ -4913,6 +5423,9 @@ x_figure_window_size (struct frame *f, Lisp_Object parms, bool toolbar_p, int *x
{
f->left_pos = XINT (XCAR (XCDR (left)));
}
+ else if (FLOATP (left))
+ f->left_pos = frame_float (f, left, FRAME_FLOAT_LEFT, &parent_done,
+ &outer_done, 0);
else if (EQ (left, Qunbound))
f->left_pos = 0;
else
@@ -5071,12 +5584,14 @@ syms_of_frame (void)
DEFSYM (Qframep, "framep");
DEFSYM (Qframe_live_p, "frame-live-p");
DEFSYM (Qframe_windows_min_size, "frame-windows-min-size");
+ DEFSYM (Qdisplay_monitor_attributes_list, "display-monitor-attributes-list");
DEFSYM (Qwindow__pixel_to_total, "window--pixel-to-total");
DEFSYM (Qexplicit_name, "explicit-name");
DEFSYM (Qheight, "height");
DEFSYM (Qicon, "icon");
DEFSYM (Qminibuffer, "minibuffer");
DEFSYM (Qundecorated, "undecorated");
+ DEFSYM (Qno_special_glyphs, "no-special-glyphs");
DEFSYM (Qparent_frame, "parent-frame");
DEFSYM (Qskip_taskbar, "skip-taskbar");
DEFSYM (Qno_focus_on_map, "no-focus-on-map");
@@ -5129,6 +5644,7 @@ syms_of_frame (void)
DEFSYM (Qframes, "frames");
DEFSYM (Qsource, "source");
+ DEFSYM (Qframe_edges, "frame-edges");
DEFSYM (Qouter_edges, "outer-edges");
DEFSYM (Qouter_position, "outer-position");
DEFSYM (Qouter_size, "outer-size");
@@ -5174,6 +5690,10 @@ syms_of_frame (void)
#ifdef HAVE_NS
DEFSYM (Qns_parse_geometry, "ns-parse-geometry");
#endif
+#ifdef NS_IMPL_COCOA
+ DEFSYM (Qns_appearance, "ns-appearance");
+ DEFSYM (Qns_transparent_titlebar, "ns-transparent-titlebar");
+#endif
DEFSYM (Qalpha, "alpha");
DEFSYM (Qauto_lower, "auto-lower");
@@ -5220,6 +5740,13 @@ syms_of_frame (void)
DEFSYM (Qmin_width, "min-width");
DEFSYM (Qmin_height, "min-height");
DEFSYM (Qmouse_wheel_frame, "mouse-wheel-frame");
+ DEFSYM (Qkeep_ratio, "keep-ratio");
+ DEFSYM (Qwidth_only, "width-only");
+ DEFSYM (Qheight_only, "height-only");
+ DEFSYM (Qleft_only, "left-only");
+ DEFSYM (Qtop_only, "top-only");
+ DEFSYM (Qiconify_top_level, "iconify-top-level");
+ DEFSYM (Qmake_invisible, "make-invisible");
{
int i;
@@ -5375,16 +5902,11 @@ or call the function `tool-bar-mode'. */);
#endif
DEFVAR_KBOARD ("default-minibuffer-frame", Vdefault_minibuffer_frame,
- doc: /* Minibufferless frames use this frame's minibuffer.
-Emacs cannot create minibufferless frames unless this is set to an
-appropriate surrogate.
-
-Emacs consults this variable only when creating minibufferless
-frames; once the frame is created, it sticks with its assigned
-minibuffer, no matter what this variable is set to. This means that
-this variable doesn't necessarily say anything meaningful about the
-current set of frames, or where the minibuffer is currently being
-displayed.
+ doc: /* Minibuffer-less frames by default use this frame's minibuffer.
+Emacs consults this variable only when creating a minibuffer-less frame
+and no explicit minibuffer window has been specified for that frame via
+the `minibuffer' frame parameter. Once such a frame has been created,
+setting this variable does not change that frame's previous association.
This variable is local to the current terminal and cannot be buffer-local. */);
@@ -5523,6 +6045,21 @@ This variable is effective only with the X toolkit (and there only when
Gtk+ tooltips are not used) and on Windows. */);
tooltip_reuse_hidden_frame = false;
+ DEFVAR_LISP ("iconify-child-frame", iconify_child_frame,
+ doc: /* How to handle iconification of child frames.
+This variable tells Emacs how to proceed when it is asked to iconify a
+child frame. If it is nil, `iconify-frame' will do nothing when invoked
+on a child frame. If it is `iconify-top-level', Emacs will try to
+iconify the top level frame associated with this child frame instead.
+If it is `make-invisible', Emacs will try to make this child frame
+invisible instead.
+
+Any other value means to try iconifying the child frame. Since such an
+attempt is not honored by all window managers and may even lead to
+making the child frame unresponsive to user actions, the default is to
+iconify the top level frame instead. */);
+ iconify_child_frame = Qiconify_top_level;
+
staticpro (&Vframe_list);
defsubr (&Sframep);
@@ -5564,8 +6101,8 @@ Gtk+ tooltips are not used) and on Windows. */);
defsubr (&Smodify_frame_parameters);
defsubr (&Sframe_char_height);
defsubr (&Sframe_char_width);
- defsubr (&Sframe_pixel_height);
- defsubr (&Sframe_pixel_width);
+ defsubr (&Sframe_native_height);
+ defsubr (&Sframe_native_width);
defsubr (&Sframe_text_cols);
defsubr (&Sframe_text_lines);
defsubr (&Sframe_total_cols);
@@ -5575,7 +6112,7 @@ Gtk+ tooltips are not used) and on Windows. */);
defsubr (&Sscroll_bar_width);
defsubr (&Sscroll_bar_height);
defsubr (&Sfringe_width);
- defsubr (&Sborder_width);
+ defsubr (&Sframe_internal_border_width);
defsubr (&Sright_divider_width);
defsubr (&Sbottom_divider_width);
defsubr (&Stool_bar_pixel_width);
diff --git a/src/frame.h b/src/frame.h
index 4aa7c34a29a..a3b77636435 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_FRAME_H
#define EMACS_FRAME_H
@@ -52,13 +52,34 @@ enum z_group
z_group_below,
z_group_above_suspended,
};
+
+enum internal_border_part
+ {
+ INTERNAL_BORDER_NONE,
+ INTERNAL_BORDER_LEFT_EDGE,
+ INTERNAL_BORDER_TOP_LEFT_CORNER,
+ INTERNAL_BORDER_TOP_EDGE,
+ INTERNAL_BORDER_TOP_RIGHT_CORNER,
+ INTERNAL_BORDER_RIGHT_EDGE,
+ INTERNAL_BORDER_BOTTOM_RIGHT_CORNER,
+ INTERNAL_BORDER_BOTTOM_EDGE,
+ INTERNAL_BORDER_BOTTOM_LEFT_CORNER,
+ };
+
+#ifdef NS_IMPL_COCOA
+enum ns_appearance_type
+ {
+ ns_appearance_aqua,
+ ns_appearance_vibrant_dark
+ };
+#endif
#endif /* HAVE_WINDOW_SYSTEM */
/* The structure representing a frame. */
struct frame
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* All Lisp_Object components must come first.
That ensures they are all aligned normally. */
@@ -354,7 +375,11 @@ struct frame
/* The z-group this frame's window belongs to. */
ENUM_BF (z_group) z_group : 2;
-#endif /* HAVE_WINDOW_SYSTEM and not HAVE_NS */
+
+ /* Non-zero if display of truncation and continuation glyphs outside
+ the fringes is suppressed. */
+ bool_bf no_special_glyphs : 1;
+#endif /* HAVE_WINDOW_SYSTEM */
/* Whether new_height and new_width shall be interpreted
in pixels. */
@@ -422,7 +447,7 @@ struct frame
/* New text height and width for pending size change. 0 if no change
pending. These values represent pixels or canonical character units
- according to the value of new_pixelwise and correlate to the the
+ according to the value of new_pixelwise and correlate to the
text width/height of the frame. */
int new_width, new_height;
@@ -546,6 +571,12 @@ struct frame
/* All display backends seem to need these two pixel values. */
unsigned long background_pixel;
unsigned long foreground_pixel;
+
+#ifdef NS_IMPL_COCOA
+ /* NSAppearance theme used on this frame. */
+ enum ns_appearance_type ns_appearance;
+ bool_bf ns_transparent_titlebar;
+#endif
};
/* Most code should use these functions to set Lisp fields in struct frame. */
@@ -824,7 +855,7 @@ default_pixels_per_inch_y (void)
#ifdef USE_GTK
#define FRAME_TOOL_BAR_POSITION(f) (f)->tool_bar_position
#else
-#define FRAME_TOOL_BAR_POSITION(f) ((void) f, Qtop)
+#define FRAME_TOOL_BAR_POSITION(f) ((void) (f), Qtop)
#endif
/* Number of lines of frame F used for the tool-bar. */
@@ -908,16 +939,17 @@ default_pixels_per_inch_y (void)
((f)->vertical_scroll_bar_type == vertical_scroll_bar_right)
#else /* not HAVE_WINDOW_SYSTEM */
/* If there is no window system, there are no scroll bars. */
-#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) ((void) f, vertical_scroll_bar_none)
-#define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) f, 0)
-#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) f, 0)
-#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) f, 0)
+#define FRAME_VERTICAL_SCROLL_BAR_TYPE(f) \
+ ((void) (f), vertical_scroll_bar_none)
+#define FRAME_HAS_VERTICAL_SCROLL_BARS(f) ((void) (f), 0)
+#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_LEFT(f) ((void) (f), 0)
+#define FRAME_HAS_VERTICAL_SCROLL_BARS_ON_RIGHT(f) ((void) (f), 0)
#endif /* HAVE_WINDOW_SYSTEM */
#if defined (HAVE_WINDOW_SYSTEM)
#define FRAME_UNDECORATED(f) ((f)->undecorated)
#ifdef HAVE_NTGUI
-#define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0)
+#define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0)
#else
#define FRAME_OVERRIDE_REDIRECT(f) ((f)->override_redirect)
#endif
@@ -928,23 +960,29 @@ default_pixels_per_inch_y (void)
#define FRAME_SKIP_TASKBAR(f) ((f)->skip_taskbar)
#define FRAME_NO_FOCUS_ON_MAP(f) ((f)->no_focus_on_map)
#define FRAME_NO_ACCEPT_FOCUS(f) ((f)->no_accept_focus)
+#define FRAME_NO_SPECIAL_GLYPHS(f) ((f)->no_special_glyphs)
#define FRAME_Z_GROUP(f) ((f)->z_group)
#define FRAME_Z_GROUP_NONE(f) ((f)->z_group == z_group_none)
#define FRAME_Z_GROUP_ABOVE(f) ((f)->z_group == z_group_above)
#define FRAME_Z_GROUP_ABOVE_SUSPENDED(f) \
((f)->z_group == z_group_above_suspended)
#define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below)
+#ifdef NS_IMPL_COCOA
+#define FRAME_NS_APPEARANCE(f) ((f)->ns_appearance)
+#define FRAME_NS_TRANSPARENT_TITLEBAR(f) ((f)->ns_transparent_titlebar)
+#endif
#else /* not HAVE_WINDOW_SYSTEM */
-#define FRAME_UNDECORATED(f) ((void) f, 0)
-#define FRAME_OVERRIDE_REDIRECT(f) ((void) f, 0)
-#define FRAME_PARENT_FRAME(f) ((void) f, NULL)
-#define FRAME_SKIP_TASKBAR(f) ((void) f, 0)
-#define FRAME_NO_FOCUS_ON_MAP(f) ((void) f, 0)
-#define FRAME_NO_ACCEPT_FOCUS(f) ((void) f, 0)
-#define FRAME_Z_GROUP(f) ((void) f, z_group_none)
-#define FRAME_Z_GROUP_NONE(f) ((void) f, true)
-#define FRAME_Z_GROUP_ABOVE(f) ((void) f, false)
-#define FRAME_Z_GROUP_BELOW(f) ((void) f, false)
+#define FRAME_UNDECORATED(f) ((void) (f), 0)
+#define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0)
+#define FRAME_PARENT_FRAME(f) ((void) (f), NULL)
+#define FRAME_SKIP_TASKBAR(f) ((void) (f), 0)
+#define FRAME_NO_FOCUS_ON_MAP(f) ((void) (f), 0)
+#define FRAME_NO_ACCEPT_FOCUS(f) ((void) (f), 0)
+#define FRAME_NO_SPECIAL_GLYPHS(f) ((void) (f), 0)
+#define FRAME_Z_GROUP(f) ((void) (f), z_group_none)
+#define FRAME_Z_GROUP_NONE(f) ((void) (f), true)
+#define FRAME_Z_GROUP_ABOVE(f) ((void) (f), false)
+#define FRAME_Z_GROUP_BELOW(f) ((void) (f), false)
#endif /* HAVE_WINDOW_SYSTEM */
/* Whether horizontal scroll bars are currently enabled for frame F. */
@@ -952,7 +990,7 @@ default_pixels_per_inch_y (void)
#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) \
((f)->horizontal_scroll_bars)
#else
-#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) f, 0)
+#define FRAME_HAS_HORIZONTAL_SCROLL_BARS(f) ((void) (f), 0)
#endif
/* Width that a scroll bar in frame F should have, if there is one.
@@ -1288,19 +1326,20 @@ FRAME_TOTAL_FRINGE_WIDTH (struct frame *f)
return FRAME_LEFT_FRINGE_WIDTH (f) + FRAME_RIGHT_FRINGE_WIDTH (f);
}
-/* Pixel-width of internal border lines */
+/* Pixel-width of internal border lines. */
INLINE int
FRAME_INTERNAL_BORDER_WIDTH (struct frame *f)
{
return frame_dimension (f->internal_border_width);
}
-/* Pixel-size of window divider lines */
+/* Pixel-size of window divider lines. */
INLINE int
FRAME_RIGHT_DIVIDER_WIDTH (struct frame *f)
{
return frame_dimension (f->right_divider_width);
}
+
INLINE int
FRAME_BOTTOM_DIVIDER_WIDTH (struct frame *f)
{
@@ -1498,6 +1537,7 @@ extern void x_set_scroll_bar_height (struct frame *, Lisp_Object, Lisp_Object);
extern long x_figure_window_size (struct frame *, Lisp_Object, bool, int *, int *);
extern void x_set_alpha (struct frame *, Lisp_Object, Lisp_Object);
+extern void x_set_no_special_glyphs (struct frame *, Lisp_Object, Lisp_Object);
extern void validate_x_resource_name (void);
@@ -1521,6 +1561,7 @@ extern void x_real_positions (struct frame *, int *, int *);
extern void free_frame_menubar (struct frame *);
extern void x_free_frame_resources (struct frame *);
extern bool frame_ancestor_p (struct frame *af, struct frame *df);
+extern enum internal_border_part frame_internal_border_part (struct frame *f, int x, int y);
#if defined HAVE_X_WINDOWS
extern void x_wm_set_icon_position (struct frame *, int, int);
diff --git a/src/fringe.c b/src/fringe.c
index 5d3108a6c70..087ef33434d 100644
--- a/src/fringe.c
+++ b/src/fringe.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index d72005771ec..ad68ce8cebb 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -81,9 +81,9 @@ ftcrfont_glyph_extents (struct font *font,
ftcrfont_info->metrics =
xrealloc (ftcrfont_info->metrics,
sizeof (struct font_metrics *) * (row + 1));
- bzero (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows,
- (sizeof (struct font_metrics *)
- * (row + 1 - ftcrfont_info->metrics_nrows)));
+ memset (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, 0,
+ (sizeof (struct font_metrics *)
+ * (row + 1 - ftcrfont_info->metrics_nrows)));
ftcrfont_info->metrics_nrows = row + 1;
}
if (ftcrfont_info->metrics[row] == NULL)
diff --git a/src/ftfont.c b/src/ftfont.c
index 5600bde646d..35f59233761 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
diff --git a/src/ftfont.h b/src/ftfont.h
index 90abb452950..4201b2c2d67 100644
--- a/src/ftfont.h
+++ b/src/ftfont.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_FTFONT_H
diff --git a/src/ftxfont.c b/src/ftxfont.c
index 8c829bb8f9c..3b27da67435 100644
--- a/src/ftxfont.c
+++ b/src/ftxfont.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
diff --git a/src/getpagesize.h b/src/getpagesize.h
index 75b25b88987..951973033da 100644
--- a/src/getpagesize.h
+++ b/src/getpagesize.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef HAVE_GETPAGESIZE
diff --git a/src/gfilenotify.c b/src/gfilenotify.c
index 285a253733d..13a3eae772a 100644
--- a/src/gfilenotify.c
+++ b/src/gfilenotify.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -266,7 +266,7 @@ reason. Removing the watch by calling `gfile-rm-watch' also makes it
invalid. */)
(Lisp_Object watch_descriptor)
{
- Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
+ Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (NILP (watch_object))
return Qnil;
else
diff --git a/src/gmalloc.c b/src/gmalloc.c
index 49f1fafccc0..a17d39c1eeb 100644
--- a/src/gmalloc.c
+++ b/src/gmalloc.c
@@ -14,7 +14,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -77,11 +77,6 @@ extern void *(*__morecore) (ptrdiff_t);
#ifdef HYBRID_MALLOC
# include "sheap.h"
# define DUMPED bss_sbrk_did_unexec
-static bool
-ALLOCATED_BEFORE_DUMPING (char *p)
-{
- return bss_sbrk_buffer <= p && p < bss_sbrk_buffer + STATIC_HEAP_SIZE;
-}
#endif
#ifdef __cplusplus
@@ -133,8 +128,13 @@ typedef union
/* Heap information for a busy block. */
struct
{
- /* Zero for a large (multiblock) object, or positive giving the
- logarithm to the base two of the fragment size. */
+ /* Zero for a block that is not one of ours (typically,
+ allocated by system malloc), positive for the log base 2 of
+ the fragment size of a fragmented block, -1 for the first
+ block of a multiblock object, and unspecified for later
+ blocks of that object. Type-0 blocks can be present
+ because the system malloc can be invoked by library
+ functions in an undumped Emacs. */
int type;
union
{
@@ -144,8 +144,7 @@ typedef union
size_t first; /* First free fragment of the block. */
} frag;
/* For a large object, in its first block, this has the number
- of blocks in the object. In the other blocks, this has a
- negative number which says how far back the first block is. */
+ of blocks in the object. */
ptrdiff_t size;
} info;
} busy;
@@ -166,7 +165,7 @@ extern char *_heapbase;
extern malloc_info *_heapinfo;
/* Address to block number and vice versa. */
-#define BLOCK(A) (((char *) (A) - _heapbase) / BLOCKSIZE + 1)
+#define BLOCK(A) ((size_t) ((char *) (A) - _heapbase) / BLOCKSIZE + 1)
#define ADDRESS(B) ((void *) (((B) - 1) * BLOCKSIZE + _heapbase))
/* Current search index for the heap table. */
@@ -309,7 +308,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -491,11 +490,8 @@ register_heapinfo (void)
++_chunks_used;
/* Describe the heapinfo block itself in the heapinfo. */
- _heapinfo[block].busy.type = 0;
+ _heapinfo[block].busy.type = -1;
_heapinfo[block].busy.info.size = blocks;
- /* Leave back-pointers for malloc_find_address. */
- while (--blocks > 0)
- _heapinfo[block + blocks].busy.info.size = -blocks;
}
#ifdef USE_PTHREAD
@@ -608,7 +604,7 @@ morecore_nolock (size_t size)
PROTECT_MALLOC_STATE (0);
/* Check if we need to grow the info table. */
- if ((size_t) BLOCK ((char *) result + size) > heapsize)
+ if (heapsize < BLOCK ((char *) result + size))
{
/* Calculate the new _heapinfo table size. We do not account for the
added blocks in the table itself, as we hope to place them in
@@ -617,7 +613,7 @@ morecore_nolock (size_t size)
newsize = heapsize;
do
newsize *= 2;
- while ((size_t) BLOCK ((char *) result + size) > newsize);
+ while (newsize < BLOCK ((char *) result + size));
/* We must not reuse existing core for the new info table when called
from realloc in the case of growing a large block, because the
@@ -665,8 +661,7 @@ morecore_nolock (size_t size)
/* Is it big enough to record status for its own space?
If so, we win. */
- if ((size_t) BLOCK ((char *) newinfo
- + newsize * sizeof (malloc_info))
+ if (BLOCK ((char *) newinfo + newsize * sizeof (malloc_info))
< newsize)
break;
@@ -883,17 +878,11 @@ _malloc_internal_nolock (size_t size)
--_chunks_free;
}
- _heapinfo[block].busy.type = 0;
+ _heapinfo[block].busy.type = -1;
_heapinfo[block].busy.info.size = blocks;
++_chunks_used;
_bytes_used += blocks * BLOCKSIZE;
_bytes_free -= blocks * BLOCKSIZE;
-
- /* Mark all the blocks of the object just allocated except for the
- first with a negative number so you can find the first block by
- adding that adjustment. */
- while (--blocks > 0)
- _heapinfo[block + blocks].busy.info.size = -blocks;
}
PROTECT_MALLOC_STATE (1);
@@ -976,7 +965,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1026,7 +1015,7 @@ _free_internal_nolock (void *ptr)
type = _heapinfo[block].busy.type;
switch (type)
{
- case 0:
+ case -1:
/* Get as many statistics as early as we can. */
--_chunks_used;
_bytes_used -= _heapinfo[block].busy.info.size * BLOCKSIZE;
@@ -1187,7 +1176,7 @@ _free_internal_nolock (void *ptr)
prev->prev->next = next;
if (next != NULL)
next->prev = prev->prev;
- _heapinfo[block].busy.type = 0;
+ _heapinfo[block].busy.type = -1;
_heapinfo[block].busy.info.size = 1;
/* Keep the statistics accurate. */
@@ -1286,7 +1275,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1326,7 +1315,7 @@ _realloc_internal_nolock (void *ptr, size_t size)
type = _heapinfo[block].busy.type;
switch (type)
{
- case 0:
+ case -1:
/* Maybe reallocate a large block to a small fragment. */
if (size <= BLOCKSIZE / 2)
{
@@ -1346,7 +1335,7 @@ _realloc_internal_nolock (void *ptr, size_t size)
{
/* The new size is smaller; return
excess memory to the free list. */
- _heapinfo[block + blocks].busy.type = 0;
+ _heapinfo[block + blocks].busy.type = -1;
_heapinfo[block + blocks].busy.info.size
= _heapinfo[block].busy.info.size - blocks;
_heapinfo[block].busy.info.size = blocks;
@@ -1456,7 +1445,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1494,7 +1483,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with the GNU C Library. If not, see <https://www.gnu.org/licenses/>. */
/* uClibc defines __GNU_LIBRARY__, but it is not completely
compatible. */
@@ -1513,17 +1502,18 @@ extern void *__sbrk (ptrdiff_t increment);
static void *
gdefault_morecore (ptrdiff_t increment)
{
- void *result;
#ifdef HYBRID_MALLOC
if (!DUMPED)
{
return bss_sbrk (increment);
}
#endif
- result = (void *) __sbrk (increment);
- if (result == (void *) -1)
- return NULL;
- return result;
+#ifdef HAVE_SBRK
+ void *result = (void *) __sbrk (increment);
+ if (result != (void *) -1)
+ return result;
+#endif
+ return NULL;
}
void *(*__morecore) (ptrdiff_t) = gdefault_morecore;
@@ -1541,7 +1531,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>. */
+License along with this library. If not, see <https://www.gnu.org/licenses/>. */
void *
aligned_alloc (size_t alignment, size_t size)
@@ -1673,7 +1663,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1721,6 +1711,20 @@ extern void *aligned_alloc (size_t alignment, size_t size);
extern int posix_memalign (void **memptr, size_t alignment, size_t size);
#endif
+/* Assuming PTR was allocated via the hybrid malloc, return true if
+ PTR was allocated via gmalloc, not the system malloc. Also, return
+ true if _heaplimit is zero; this can happen temporarily when
+ gmalloc calls itself for internal use, and in that case PTR is
+ already known to be allocated via gmalloc. */
+
+static bool
+allocated_via_gmalloc (void *ptr)
+{
+ size_t block = BLOCK (ptr);
+ size_t blockmax = _heaplimit - 1;
+ return block <= blockmax && _heapinfo[block].busy.type != 0;
+}
+
/* See the comments near the beginning of this file for explanations
of the following functions. */
@@ -1743,13 +1747,10 @@ hybrid_calloc (size_t nmemb, size_t size)
void
hybrid_free (void *ptr)
{
- if (!DUMPED)
+ if (allocated_via_gmalloc (ptr))
gfree (ptr);
- else if (!ALLOCATED_BEFORE_DUMPING (ptr))
+ else
free (ptr);
- /* Otherwise the dumped emacs is trying to free something allocated
- before dumping; do nothing. */
- return;
}
#if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
@@ -1775,19 +1776,20 @@ hybrid_realloc (void *ptr, size_t size)
int type;
size_t block, oldsize;
+ if (!ptr)
+ return hybrid_malloc (size);
+ if (!allocated_via_gmalloc (ptr))
+ return realloc (ptr, size);
if (!DUMPED)
return grealloc (ptr, size);
- if (!ALLOCATED_BEFORE_DUMPING (ptr))
- return realloc (ptr, size);
/* The dumped emacs is trying to realloc storage allocated before
- dumping. We just malloc new space and copy the data. */
- if (size == 0 || ptr == NULL)
- return malloc (size);
- block = ((char *) ptr - _heapbase) / BLOCKSIZE + 1;
+ dumping via gmalloc. Allocate new space and copy the data. Do
+ not bother with gfree (ptr), as that would just waste time. */
+ block = BLOCK (ptr);
type = _heapinfo[block].busy.type;
oldsize =
- type == 0 ? _heapinfo[block].busy.info.size * BLOCKSIZE
+ type < 0 ? _heapinfo[block].busy.info.size * BLOCKSIZE
: (size_t) 1 << type;
result = malloc (size);
if (result)
@@ -1846,7 +1848,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
diff --git a/src/gnutls.c b/src/gnutls.c
index 2078ad88f28..4622011bc10 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
@@ -24,23 +24,44 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "process.h"
#include "gnutls.h"
#include "coding.h"
+#include "buffer.h"
-#ifdef HAVE_GNUTLS
+#if GNUTLS_VERSION_NUMBER >= 0x030014
+# define HAVE_GNUTLS_X509_SYSTEM_TRUST
+#endif
-#ifdef WINDOWSNT
-#include <windows.h>
-#include "w32.h"
+/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14,
+ it was broken through at least GnuTLS 3.4.10; see:
+ https://lists.gnu.org/r/emacs-devel/2017-07/msg00992.html
+ The relevant fix seems to have been made in GnuTLS 3.5.1; see:
+ https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d
+ So, require 3.5.1. */
+#if GNUTLS_VERSION_NUMBER >= 0x030501
+# define HAVE_GNUTLS_AEAD
#endif
+/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
+ exported only since 3.3.0. */
+#if GNUTLS_VERSION_NUMBER >= 0x030300
+# define HAVE_GNUTLS_MAC_GET_NONCE_SIZE
+#endif
+
+#ifdef HAVE_GNUTLS
+
+# ifdef WINDOWSNT
+# include <windows.h>
+# include "w32.h"
+# endif
+
static bool emacs_gnutls_handle_error (gnutls_session_t, int);
static bool gnutls_global_initialized;
static void gnutls_log_function (int, const char *);
static void gnutls_log_function2 (int, const char *, const char *);
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
static void gnutls_audit_log_function (gnutls_session_t, const char *);
-#endif
+# endif
enum extra_peer_verification
{
@@ -48,7 +69,7 @@ enum extra_peer_verification
};
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get,
(gnutls_session_t));
@@ -73,12 +94,10 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file,
DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file,
(gnutls_certificate_credentials_t, const char *, const char *,
gnutls_x509_crt_fmt_t));
-# if ((GNUTLS_VERSION_MAJOR \
- + (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \
- > 3)
+# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust,
(gnutls_certificate_credentials_t));
-# endif
+# endif
DEF_DLL_FN (int, gnutls_certificate_set_x509_trust_file,
(gnutls_certificate_credentials_t, const char *,
gnutls_x509_crt_fmt_t));
@@ -95,9 +114,9 @@ DEF_DLL_FN (int, gnutls_dh_get_prime_bits, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_error_is_fatal, (int));
DEF_DLL_FN (int, gnutls_global_init, (void));
DEF_DLL_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
-# ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
-# endif
+# endif
DEF_DLL_FN (void, gnutls_global_set_log_level, (int));
DEF_DLL_FN (int, gnutls_handshake, (gnutls_session_t));
DEF_DLL_FN (int, gnutls_init, (gnutls_session_t *, unsigned int));
@@ -171,6 +190,55 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
+# ifdef HAVE_GNUTLS3
+DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
+DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void));
+# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
+DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t));
+# endif
+DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t));
+DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void));
+DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t));
+DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void));
+DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t));
+DEF_DLL_FN (int, gnutls_cipher_init,
+ (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t,
+ const gnutls_datum_t *, const gnutls_datum_t *));
+DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t));
+DEF_DLL_FN (int, gnutls_cipher_encrypt2,
+ (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
+DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t));
+DEF_DLL_FN (int, gnutls_cipher_decrypt2,
+ (gnutls_cipher_hd_t, const void *, size_t, void *, size_t));
+# ifdef HAVE_GNUTLS_AEAD
+DEF_DLL_FN (int, gnutls_aead_cipher_init,
+ (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t,
+ const gnutls_datum_t *));
+DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t));
+DEF_DLL_FN (int, gnutls_aead_cipher_encrypt,
+ (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
+ size_t, size_t, const void *, size_t, void *, size_t *));
+DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
+ (gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
+ size_t, size_t, const void *, size_t, void *, size_t *));
+# endif
+DEF_DLL_FN (int, gnutls_hmac_init,
+ (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
+DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
+DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t));
+DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *));
+DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *));
+ DEF_DLL_FN (int, gnutls_hash_init,
+ (gnutls_hash_hd_t *, gnutls_digest_algorithm_t));
+DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t));
+DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t));
+DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *));
+DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *));
+# endif /* HAVE_GNUTLS3 */
+
static bool
init_gnutls_functions (void)
@@ -195,11 +263,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file);
LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file);
-# if ((GNUTLS_VERSION_MAJOR \
- + (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \
- > 3)
+# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust);
-# endif
+# endif
LOAD_DLL_FN (library, gnutls_certificate_set_x509_trust_file);
LOAD_DLL_FN (library, gnutls_certificate_type_get);
LOAD_DLL_FN (library, gnutls_certificate_verify_peers2);
@@ -210,9 +276,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_error_is_fatal);
LOAD_DLL_FN (library, gnutls_global_init);
LOAD_DLL_FN (library, gnutls_global_set_log_function);
-# ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_global_set_audit_log_function);
-# endif
+# endif
LOAD_DLL_FN (library, gnutls_global_set_log_level);
LOAD_DLL_FN (library, gnutls_handshake);
LOAD_DLL_FN (library, gnutls_init);
@@ -255,6 +321,42 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_get_name);
LOAD_DLL_FN (library, gnutls_mac_get);
LOAD_DLL_FN (library, gnutls_mac_get_name);
+# ifdef HAVE_GNUTLS3
+ LOAD_DLL_FN (library, gnutls_rnd);
+ LOAD_DLL_FN (library, gnutls_mac_list);
+# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
+ LOAD_DLL_FN (library, gnutls_mac_get_nonce_size);
+# endif
+ LOAD_DLL_FN (library, gnutls_mac_get_key_size);
+ LOAD_DLL_FN (library, gnutls_digest_list);
+ LOAD_DLL_FN (library, gnutls_digest_get_name);
+ LOAD_DLL_FN (library, gnutls_cipher_list);
+ LOAD_DLL_FN (library, gnutls_cipher_get_iv_size);
+ LOAD_DLL_FN (library, gnutls_cipher_get_key_size);
+ LOAD_DLL_FN (library, gnutls_cipher_get_block_size);
+ LOAD_DLL_FN (library, gnutls_cipher_get_tag_size);
+ LOAD_DLL_FN (library, gnutls_cipher_init);
+ LOAD_DLL_FN (library, gnutls_cipher_set_iv);
+ LOAD_DLL_FN (library, gnutls_cipher_encrypt2);
+ LOAD_DLL_FN (library, gnutls_cipher_deinit);
+ LOAD_DLL_FN (library, gnutls_cipher_decrypt2);
+# ifdef HAVE_GNUTLS_AEAD
+ LOAD_DLL_FN (library, gnutls_aead_cipher_init);
+ LOAD_DLL_FN (library, gnutls_aead_cipher_deinit);
+ LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
+ LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
+# endif
+ LOAD_DLL_FN (library, gnutls_hmac_init);
+ LOAD_DLL_FN (library, gnutls_hmac_get_len);
+ LOAD_DLL_FN (library, gnutls_hmac);
+ LOAD_DLL_FN (library, gnutls_hmac_deinit);
+ LOAD_DLL_FN (library, gnutls_hmac_output);
+ LOAD_DLL_FN (library, gnutls_hash_init);
+ LOAD_DLL_FN (library, gnutls_hash_get_len);
+ LOAD_DLL_FN (library, gnutls_hash);
+ LOAD_DLL_FN (library, gnutls_hash_deinit);
+ LOAD_DLL_FN (library, gnutls_hash_output);
+# endif /* HAVE_GNUTLS3 */
max_log_level = global_gnutls_log_level;
@@ -267,73 +369,117 @@ init_gnutls_functions (void)
return 1;
}
-# define gnutls_alert_get fn_gnutls_alert_get
-# define gnutls_alert_get_name fn_gnutls_alert_get_name
-# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
-# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
-# define gnutls_bye fn_gnutls_bye
-# define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials
-# define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials
-# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
-# define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags
-# define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file
-# define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file
-# define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust
-# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
-# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
-# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
-# define gnutls_cipher_get fn_gnutls_cipher_get
-# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
-# define gnutls_credentials_set fn_gnutls_credentials_set
-# define gnutls_deinit fn_gnutls_deinit
-# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
-# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
-# define gnutls_error_is_fatal fn_gnutls_error_is_fatal
-# define gnutls_global_init fn_gnutls_global_init
-# define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function
-# define gnutls_global_set_log_function fn_gnutls_global_set_log_function
-# define gnutls_global_set_log_level fn_gnutls_global_set_log_level
-# define gnutls_handshake fn_gnutls_handshake
-# define gnutls_init fn_gnutls_init
-# define gnutls_kx_get fn_gnutls_kx_get
-# define gnutls_kx_get_name fn_gnutls_kx_get_name
-# define gnutls_mac_get fn_gnutls_mac_get
-# define gnutls_mac_get_name fn_gnutls_mac_get_name
-# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
-# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
-# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
-# define gnutls_protocol_get_name fn_gnutls_protocol_get_name
-# define gnutls_protocol_get_version fn_gnutls_protocol_get_version
-# define gnutls_record_check_pending fn_gnutls_record_check_pending
-# define gnutls_record_recv fn_gnutls_record_recv
-# define gnutls_record_send fn_gnutls_record_send
-# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
-# define gnutls_server_name_set fn_gnutls_server_name_set
-# define gnutls_sign_get_name fn_gnutls_sign_get_name
-# define gnutls_strerror fn_gnutls_strerror
-# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
-# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
-# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
-# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
-# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
-# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
-# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
-# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
-# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
-# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
-# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
-# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
-# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
-# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
-# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
-# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
-# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
-# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
-# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
-# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
-# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
+# define gnutls_alert_get fn_gnutls_alert_get
+# define gnutls_alert_get_name fn_gnutls_alert_get_name
+# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials
+# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials
+# define gnutls_bye fn_gnutls_bye
+# define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials
+# define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials
+# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers
+# define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags
+# define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file
+# define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file
+# define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust
+# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file
+# define gnutls_certificate_type_get fn_gnutls_certificate_type_get
+# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2
+# define gnutls_cipher_get fn_gnutls_cipher_get
+# define gnutls_cipher_get_name fn_gnutls_cipher_get_name
+# define gnutls_credentials_set fn_gnutls_credentials_set
+# define gnutls_deinit fn_gnutls_deinit
+# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits
+# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits
+# define gnutls_error_is_fatal fn_gnutls_error_is_fatal
+# define gnutls_global_init fn_gnutls_global_init
+# define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function
+# define gnutls_global_set_log_function fn_gnutls_global_set_log_function
+# define gnutls_global_set_log_level fn_gnutls_global_set_log_level
+# define gnutls_handshake fn_gnutls_handshake
+# define gnutls_init fn_gnutls_init
+# define gnutls_kx_get fn_gnutls_kx_get
+# define gnutls_kx_get_name fn_gnutls_kx_get_name
+# define gnutls_mac_get fn_gnutls_mac_get
+# define gnutls_mac_get_name fn_gnutls_mac_get_name
+# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
+# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
+# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
+# define gnutls_protocol_get_name fn_gnutls_protocol_get_name
+# define gnutls_protocol_get_version fn_gnutls_protocol_get_version
+# define gnutls_record_check_pending fn_gnutls_record_check_pending
+# define gnutls_record_recv fn_gnutls_record_recv
+# define gnutls_record_send fn_gnutls_record_send
+# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name
+# define gnutls_server_name_set fn_gnutls_server_name_set
+# define gnutls_sign_get_name fn_gnutls_sign_get_name
+# define gnutls_strerror fn_gnutls_strerror
+# define gnutls_transport_set_errno fn_gnutls_transport_set_errno
+# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2
+# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
+# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
+# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
+# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
+# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
+# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
+# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
+# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time
+# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint
+# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn
+# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id
+# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id
+# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm
+# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial
+# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm
+# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id
+# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version
+# define gnutls_x509_crt_import fn_gnutls_x509_crt_import
+# define gnutls_x509_crt_init fn_gnutls_x509_crt_init
+# ifdef HAVE_GNUTLS3
+# define gnutls_rnd fn_gnutls_rnd
+# define gnutls_mac_list fn_gnutls_mac_list
+# ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
+# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size
+# endif
+# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size
+# define gnutls_digest_list fn_gnutls_digest_list
+# define gnutls_digest_get_name fn_gnutls_digest_get_name
+# define gnutls_cipher_list fn_gnutls_cipher_list
+# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size
+# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size
+# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size
+# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size
+# define gnutls_cipher_init fn_gnutls_cipher_init
+# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv
+# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2
+# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2
+# define gnutls_cipher_deinit fn_gnutls_cipher_deinit
+# ifdef HAVE_GNUTLS_AEAD
+# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt
+# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt
+# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
+# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
+# endif
+# define gnutls_hmac_init fn_gnutls_hmac_init
+# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
+# define gnutls_hmac fn_gnutls_hmac
+# define gnutls_hmac_deinit fn_gnutls_hmac_deinit
+# define gnutls_hmac_output fn_gnutls_hmac_output
+# define gnutls_hash_init fn_gnutls_hash_init
+# define gnutls_hash_get_len fn_gnutls_hash_get_len
+# define gnutls_hash fn_gnutls_hash
+# define gnutls_hash_deinit fn_gnutls_hash_deinit
+# define gnutls_hash_output fn_gnutls_hash_output
+# endif /* HAVE_GNUTLS3 */
+
+/* This wrapper is called from fns.c, which doesn't know about the
+ LOAD_DLL_FN stuff above. */
+int
+w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len)
+{
+ return gnutls_rnd (level, data, len);
+}
-#endif
+# endif /* WINDOWSNT */
/* Report memory exhaustion if ERR is an out-of-memory indication. */
@@ -347,7 +493,7 @@ check_memory_full (int err)
memory_full (0);
}
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
/* Log a simple audit message. */
static void
gnutls_audit_log_function (gnutls_session_t session, const char *string)
@@ -357,7 +503,7 @@ gnutls_audit_log_function (gnutls_session_t session, const char *string)
message ("gnutls.c: [audit] %s", string);
}
}
-#endif
+# endif
/* Log a simple message. */
static void
@@ -410,7 +556,7 @@ gnutls_try_handshake (struct Lisp_Process *proc)
return ret;
}
-#ifndef WINDOWSNT
+# ifndef WINDOWSNT
static int
emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
{
@@ -418,13 +564,13 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
switch (err)
{
-# ifdef _AIX
+# ifdef _AIX
/* This is taken from the GnuTLS system_errno function circa 2016;
- see <http://savannah.gnu.org/support/?107464>. */
+ see <https://savannah.gnu.org/support/?107464>. */
case 0:
errno = EAGAIN;
/* Fall through. */
-# endif
+# endif
case EINPROGRESS:
case ENOTCONN:
return EAGAIN;
@@ -433,7 +579,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr)
return err;
}
}
-#endif
+# endif /* !WINDOWSNT */
static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
@@ -445,7 +591,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
{
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
/* On W32 we cannot transfer socket handles between different runtime
libraries, so we tell GnuTLS to use our special push/pull
functions. */
@@ -454,7 +600,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
(gnutls_transport_ptr_t) proc);
gnutls_transport_set_push_function (state, &emacs_gnutls_push);
gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
-#else
+# else
/* This is how GnuTLS takes sockets: as file descriptors passed
in. For an Emacs process socket, infd and outfd are the
same but we use this two-argument version for clarity. */
@@ -464,7 +610,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
if (proc->is_non_blocking_client)
gnutls_transport_set_errno_function (state,
emacs_gnutls_nonblock_errno);
-#endif
+# endif
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
}
@@ -478,13 +624,13 @@ emacs_gnutls_record_check_pending (gnutls_session_t state)
return gnutls_record_check_pending (state);
}
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
gnutls_transport_set_errno (state, err);
}
-#endif
+# endif
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
@@ -556,6 +702,13 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
}
}
+static char const *
+emacs_gnutls_strerror (int err)
+{
+ char const *str = gnutls_strerror (err);
+ return str ? str : "unknown";
+}
+
/* Report a GnuTLS error to the user.
Return true if the error code was successfully handled. */
static bool
@@ -564,7 +717,6 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
int max_log_level = 0;
bool ret;
- const char *str;
/* TODO: use a Lisp_Object generated by gnutls_make_error? */
if (err >= 0)
@@ -576,9 +728,7 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
/* TODO: use gnutls-error-fatalp and gnutls-error-string. */
- str = gnutls_strerror (err);
- if (!str)
- str = "unknown";
+ char const *str = emacs_gnutls_strerror (err);
if (gnutls_error_is_fatal (err))
{
@@ -586,17 +736,17 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
/* Mostly ignore "The TLS connection was non-properly
terminated" message which just means that the peer closed the
connection. */
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
if (err == GNUTLS_E_PREMATURE_TERMINATION)
level = 3;
-#endif
+# endif
GNUTLS_LOG2 (level, max_log_level, "fatal error:", str);
- ret = 0;
+ ret = false;
}
else
{
- ret = 1;
+ ret = true;
switch (err)
{
@@ -784,7 +934,7 @@ usage: (gnutls-error-string ERROR) */)
if (! TYPE_RANGED_INTEGERP (int, err))
return build_string ("Not an error symbol or code");
- return build_string (gnutls_strerror (XINT (err)));
+ return build_string (emacs_gnutls_strerror (XINT (err)));
}
DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
@@ -1154,7 +1304,7 @@ gnutls_ip_address_p (char *string)
return true;
}
-#if 0
+# if 0
/* Deinitialize global GnuTLS state.
See also `gnutls-global-init'. */
static Lisp_Object
@@ -1167,7 +1317,7 @@ emacs_gnutls_global_deinit (void)
return gnutls_make_error (GNUTLS_E_SUCCESS);
}
-#endif
+# endif
static void ATTRIBUTE_FORMAT_PRINTF (2, 3)
boot_error (struct Lisp_Process *p, const char *m, ...)
@@ -1217,7 +1367,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
c_hostname = SSDATA (hostname);
/* Now verify the peer, following
- http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+ https://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
The peer should present at least one certificate in the chain; do a
check of the certificate's hostname with
gnutls_x509_crt_check_hostname against :hostname. */
@@ -1439,9 +1589,9 @@ one trustfile (usually a CA bundle). */)
if (TYPE_RANGED_INTEGERP (int, loglevel))
{
gnutls_global_set_log_function (gnutls_log_function);
-#ifdef HAVE_GNUTLS3
+# ifdef HAVE_GNUTLS3
gnutls_global_set_audit_log_function (gnutls_audit_log_function);
-#endif
+# endif
gnutls_global_set_log_level (XINT (loglevel));
max_log_level = XINT (loglevel);
XPROCESS (proc)->gnutls_log_level = max_log_level;
@@ -1476,9 +1626,9 @@ one trustfile (usually a CA bundle). */)
XPROCESS (proc)->gnutls_x509_cred = x509_cred;
verify_flags = Fplist_get (proplist, QCverify_flags);
- if (NUMBERP (verify_flags))
+ if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags))
{
- gnutls_verify_flags = XINT (verify_flags);
+ gnutls_verify_flags = XFASTINT (verify_flags);
GNUTLS_LOG (2, max_log_level, "setting verification flags");
}
else if (NILP (verify_flags))
@@ -1503,8 +1653,7 @@ one trustfile (usually a CA bundle). */)
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
-#if GNUTLS_VERSION_MAJOR + \
- (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20) > 3
+# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST
ret = gnutls_certificate_set_x509_system_trust (x509_cred);
if (ret < GNUTLS_E_SUCCESS)
{
@@ -1512,7 +1661,7 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2i (4, max_log_level,
"setting system trust failed with code ", ret);
}
-#endif
+# endif
for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
@@ -1522,12 +1671,12 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
SSDATA (trustfile));
trustfile = ENCODE_FILE (trustfile);
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
/* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
file names on Windows, we need to re-encode the file
name using the current ANSI codepage. */
trustfile = ansi_encode_filename (trustfile);
-#endif
+# endif
ret = gnutls_certificate_set_x509_trust_file
(x509_cred,
SSDATA (trustfile),
@@ -1552,9 +1701,9 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
SSDATA (crlfile));
crlfile = ENCODE_FILE (crlfile);
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
crlfile = ansi_encode_filename (crlfile);
-#endif
+# endif
ret = gnutls_certificate_set_x509_crl_file
(x509_cred, SSDATA (crlfile), file_format);
@@ -1581,10 +1730,10 @@ one trustfile (usually a CA bundle). */)
SSDATA (certfile));
keyfile = ENCODE_FILE (keyfile);
certfile = ENCODE_FILE (certfile);
-#ifdef WINDOWSNT
+# ifdef WINDOWSNT
keyfile = ansi_encode_filename (keyfile);
certfile = ansi_encode_filename (certfile);
-#endif
+# endif
ret = gnutls_certificate_set_x509_key_file
(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
@@ -1609,10 +1758,10 @@ one trustfile (usually a CA bundle). */)
GNUTLS_LOG (1, max_log_level, "gnutls_init");
int gnutls_flags = GNUTLS_CLIENT;
-#ifdef GNUTLS_NONBLOCK
+# ifdef GNUTLS_NONBLOCK
if (XPROCESS (proc)->is_non_blocking_client)
gnutls_flags |= GNUTLS_NONBLOCK;
-#endif
+# endif
ret = gnutls_init (&state, gnutls_flags);
XPROCESS (proc)->gnutls_state = state;
if (ret < GNUTLS_E_SUCCESS)
@@ -1697,11 +1846,596 @@ This function may also return `gnutls-e-again', or
#endif /* HAVE_GNUTLS */
+#ifdef HAVE_GNUTLS3
+
+DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0,
+ doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists.
+The alist key is the cipher name. */)
+ (void)
+{
+ Lisp_Object ciphers = Qnil;
+
+ const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list ();
+ for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++)
+ {
+ gnutls_cipher_algorithm_t gca = gciphers[pos];
+ if (gca == GNUTLS_CIPHER_NULL)
+ continue;
+ char const *cipher_name = gnutls_cipher_get_name (gca);
+ if (!cipher_name)
+ continue;
+
+ /* A symbol representing the GnuTLS cipher. */
+ Lisp_Object cipher_symbol = intern (cipher_name);
+
+ ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
+
+ Lisp_Object cp
+ = listn (CONSTYPE_HEAP, 15, cipher_symbol,
+ QCcipher_id, make_number (gca),
+ QCtype, Qgnutls_type_cipher,
+ QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt,
+ QCcipher_tagsize, make_number (cipher_tag_size),
+
+ QCcipher_blocksize,
+ make_number (gnutls_cipher_get_block_size (gca)),
+
+ QCcipher_keysize,
+ make_number (gnutls_cipher_get_key_size (gca)),
+
+ QCcipher_ivsize,
+ make_number (gnutls_cipher_get_iv_size (gca)));
+
+ ciphers = Fcons (cp, ciphers);
+ }
+
+ return ciphers;
+}
+
+static Lisp_Object
+gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca,
+ Lisp_Object cipher,
+ const char *kdata, ptrdiff_t ksize,
+ const char *vdata, ptrdiff_t vsize,
+ const char *idata, ptrdiff_t isize,
+ Lisp_Object aead_auth)
+{
+# ifdef HAVE_GNUTLS_AEAD
+
+ const char *desc = encrypting ? "encrypt" : "decrypt";
+ Lisp_Object actual_iv = make_unibyte_string (vdata, vsize);
+
+ gnutls_aead_cipher_hd_t acipher;
+ gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize };
+ int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS AEAD cipher %s/%s initialization failed: %s",
+ gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
+
+ ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca);
+ ptrdiff_t tagged_size;
+ if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size)
+ || SIZE_MAX < tagged_size)
+ memory_full (SIZE_MAX);
+ size_t storage_length = tagged_size;
+ USE_SAFE_ALLOCA;
+ char *storage = SAFE_ALLOCA (storage_length);
+
+ const char *aead_auth_data = NULL;
+ ptrdiff_t aead_auth_size = 0;
+
+ if (!NILP (aead_auth))
+ {
+ if (BUFFERP (aead_auth) || STRINGP (aead_auth))
+ aead_auth = list1 (aead_auth);
+
+ CHECK_CONS (aead_auth);
+
+ ptrdiff_t astart_byte, aend_byte;
+ const char *adata
+ = extract_data_from_object (aead_auth, &astart_byte, &aend_byte);
+ if (adata == NULL)
+ error ("GnuTLS AEAD cipher auth extraction failed");
+
+ aead_auth_data = adata;
+ aead_auth_size = aend_byte - astart_byte;
+ }
+
+ ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size;
+ ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
+
+ if (isize < expected_remainder
+ || (isize - expected_remainder) % cipher_block_size != 0)
+ error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d "
+ "is not %"pD"d greater than a multiple of the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ isize, expected_remainder, cipher_block_size);
+
+ ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt)
+ (acipher, vdata, vsize, aead_auth_data, aead_auth_size,
+ cipher_tag_size, idata, isize, storage, &storage_length));
+
+ Lisp_Object output;
+ if (GNUTLS_E_SUCCESS <= ret)
+ output = make_unibyte_string (storage, storage_length);
+ explicit_bzero (storage, storage_length);
+ gnutls_aead_cipher_deinit (acipher);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ((encrypting
+ ? "GnuTLS AEAD cipher %s encryption failed: %s"
+ : "GnuTLS AEAD cipher %s decryption failed: %s"),
+ gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
+
+ SAFE_FREE ();
+ return list2 (output, actual_iv);
+# else
+ printmax_t print_gca = gca;
+ error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca);
+# endif
+}
+
+static Lisp_Object
+gnutls_symmetric (bool encrypting, Lisp_Object cipher,
+ Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ if (BUFFERP (key) || STRINGP (key))
+ key = list1 (key);
+
+ CHECK_CONS (key);
+
+ if (BUFFERP (input) || STRINGP (input))
+ input = list1 (input);
+
+ CHECK_CONS (input);
+
+ if (BUFFERP (iv) || STRINGP (iv))
+ iv = list1 (iv);
+
+ CHECK_CONS (iv);
+
+
+ const char *desc = encrypting ? "encrypt" : "decrypt";
+
+ gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (cipher))
+ cipher = intern (SSDATA (cipher));
+
+ if (SYMBOLP (cipher))
+ info = XCDR (Fassq (cipher, Fgnutls_ciphers ()));
+ else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher))
+ gca = XINT (cipher);
+ else
+ info = cipher;
+
+ if (!NILP (info) && CONSP (info))
+ {
+ Lisp_Object v = Fplist_get (info, QCcipher_id);
+ if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v))
+ gca = XINT (v);
+ }
+
+ ptrdiff_t key_size = gnutls_cipher_get_key_size (gca);
+ if (key_size == 0)
+ error ("GnuTLS cipher is invalid or not found");
+
+ ptrdiff_t kstart_byte, kend_byte;
+ const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
+
+ if (kdata == NULL)
+ error ("GnuTLS cipher key extraction failed");
+
+ if (kend_byte - kstart_byte != key_size)
+ error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to "
+ "the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ kend_byte - kstart_byte, key_size);
+
+ ptrdiff_t vstart_byte, vend_byte;
+ char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte);
+
+ if (vdata == NULL)
+ error ("GnuTLS cipher IV extraction failed");
+
+ ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca);
+ if (vend_byte - vstart_byte != iv_size)
+ error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to "
+ "the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ vend_byte - vstart_byte, iv_size);
+
+ Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte);
+
+ ptrdiff_t istart_byte, iend_byte;
+ const char *idata
+ = extract_data_from_object (input, &istart_byte, &iend_byte);
+
+ if (idata == NULL)
+ error ("GnuTLS cipher input extraction failed");
+
+ /* Is this an AEAD cipher? */
+ if (gnutls_cipher_get_tag_size (gca) > 0)
+ {
+ Lisp_Object aead_output =
+ gnutls_symmetric_aead (encrypting, gca, cipher,
+ kdata, kend_byte - kstart_byte,
+ vdata, vend_byte - vstart_byte,
+ idata, iend_byte - istart_byte,
+ aead_auth);
+ if (STRINGP (XCAR (key)))
+ Fclear_string (XCAR (key));
+ return aead_output;
+ }
+
+ ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca);
+ if ((iend_byte - istart_byte) % cipher_block_size != 0)
+ error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple "
+ "of the required %"pD"d"),
+ gnutls_cipher_get_name (gca), desc,
+ iend_byte - istart_byte, cipher_block_size);
+
+ gnutls_cipher_hd_t hcipher;
+ gnutls_datum_t key_datum
+ = { (unsigned char *) kdata, kend_byte - kstart_byte };
+
+ int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS cipher %s/%s initialization failed: %s",
+ gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret));
+
+ /* Note that this will not support streaming block mode. */
+ gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte);
+
+ /* GnuTLS docs: "For the supported ciphers the encrypted data length
+ will equal the plaintext size." */
+ ptrdiff_t storage_length = iend_byte - istart_byte;
+ Lisp_Object storage = make_uninit_string (storage_length);
+
+ ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2)
+ (hcipher, idata, iend_byte - istart_byte,
+ SSDATA (storage), storage_length));
+
+ if (STRINGP (XCAR (key)))
+ Fclear_string (XCAR (key));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_cipher_deinit (hcipher);
+ if (encrypting)
+ error ("GnuTLS cipher %s encryption failed: %s",
+ gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
+ else
+ error ("GnuTLS cipher %s decryption failed: %s",
+ gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret));
+ }
+
+ gnutls_cipher_deinit (hcipher);
+
+ return list2 (storage, actual_iv);
+}
+
+DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt,
+ Sgnutls_symmetric_encrypt, 4, 5, 0,
+ doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
+
+Return nil on error.
+
+The KEY can be specified as a buffer or string or in other ways (see
+Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
+will be wiped after use if it's a string.
+
+The IV and INPUT and the optional AEAD_AUTH can be specified as a
+buffer or string or in other ways (see Info node `(elisp)Format of
+GnuTLS Cryptography Inputs').
+
+The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
+The CIPHER may be a string or symbol matching a key in that alist, or
+a plist with the :cipher-id numeric property, or the number itself.
+
+AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
+:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
+these AEAD ciphers, but it may still be omitted (nil) as well. */)
+ (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ return gnutls_symmetric (true, cipher, key, iv, input, aead_auth);
+}
+
+DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt,
+ Sgnutls_symmetric_decrypt, 4, 5, 0,
+ doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string.
+
+Return nil on error.
+
+The KEY can be specified as a buffer or string or in other ways (see
+Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
+will be wiped after use if it's a string.
+
+The IV and INPUT and the optional AEAD_AUTH can be specified as a
+buffer or string or in other ways (see Info node `(elisp)Format of
+GnuTLS Cryptography Inputs').
+
+The alist of symmetric ciphers can be obtained with `gnutls-ciphers`.
+The CIPHER may be a string or symbol matching a key in that alist, or
+a plist with the `:cipher-id' numeric property, or the number itself.
+
+AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with
+:cipher-aead-capable set to t. AEAD_AUTH can be supplied for
+these AEAD ciphers, but it may still be omitted (nil) as well. */)
+ (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv,
+ Lisp_Object input, Lisp_Object aead_auth)
+{
+ return gnutls_symmetric (false, cipher, key, iv, input, aead_auth);
+}
+
+DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0,
+ doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists.
+
+Use the value of the alist (extract it with `alist-get' for instance)
+with `gnutls-hash-mac'. The alist key is the mac-algorithm method
+name. */)
+ (void)
+{
+ Lisp_Object mac_algorithms = Qnil;
+ const gnutls_mac_algorithm_t *macs = gnutls_mac_list ();
+ for (ptrdiff_t pos = 0; macs[pos] != 0; pos++)
+ {
+ const gnutls_mac_algorithm_t gma = macs[pos];
+
+ /* A symbol representing the GnuTLS MAC algorithm. */
+ Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma));
+
+ size_t nonce_size = 0;
+#ifdef HAVE_GNUTLS_MAC_GET_NONCE_SIZE
+ nonce_size = gnutls_mac_get_nonce_size (gma);
+#endif
+ Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol,
+ QCmac_algorithm_id, make_number (gma),
+ QCtype, Qgnutls_type_mac_algorithm,
+
+ QCmac_algorithm_length,
+ make_number (gnutls_hmac_get_len (gma)),
+
+ QCmac_algorithm_keysize,
+ make_number (gnutls_mac_get_key_size (gma)),
+
+ QCmac_algorithm_noncesize,
+ make_number (nonce_size));
+ mac_algorithms = Fcons (mp, mac_algorithms);
+ }
+
+ return mac_algorithms;
+}
+
+DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0,
+ doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists.
+
+Use the value of the alist (extract it with `alist-get' for instance)
+with `gnutls-hash-digest'. The alist key is the digest-algorithm
+method name. */)
+ (void)
+{
+ Lisp_Object digest_algorithms = Qnil;
+ const gnutls_digest_algorithm_t *digests = gnutls_digest_list ();
+ for (ptrdiff_t pos = 0; digests[pos] != 0; pos++)
+ {
+ const gnutls_digest_algorithm_t gda = digests[pos];
+
+ /* A symbol representing the GnuTLS digest algorithm. */
+ Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda));
+
+ Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol,
+ QCdigest_algorithm_id, make_number (gda),
+ QCtype, Qgnutls_type_digest_algorithm,
+
+ QCdigest_algorithm_length,
+ make_number (gnutls_hash_get_len (gda)));
+
+ digest_algorithms = Fcons (mp, digest_algorithms);
+ }
+
+ return digest_algorithms;
+}
+
+DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0,
+ doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string.
+
+Return nil on error.
+
+The KEY can be specified as a buffer or string or in other ways (see
+Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY
+will be wiped after use if it's a string.
+
+The INPUT can be specified as a buffer or string or in other
+ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
+
+The alist of MAC algorithms can be obtained with `gnutls-macs`. The
+HASH-METHOD may be a string or symbol matching a key in that alist, or
+a plist with the `:mac-algorithm-id' numeric property, or the number
+itself. */)
+ (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input)
+{
+ if (BUFFERP (input) || STRINGP (input))
+ input = list1 (input);
+
+ CHECK_CONS (input);
+
+ if (BUFFERP (key) || STRINGP (key))
+ key = list1 (key);
+
+ CHECK_CONS (key);
+
+ gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (hash_method))
+ hash_method = intern (SSDATA (hash_method));
+
+ if (SYMBOLP (hash_method))
+ info = XCDR (Fassq (hash_method, Fgnutls_macs ()));
+ else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method))
+ gma = XINT (hash_method);
+ else
+ info = hash_method;
+
+ if (!NILP (info) && CONSP (info))
+ {
+ Lisp_Object v = Fplist_get (info, QCmac_algorithm_id);
+ if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v))
+ gma = XINT (v);
+ }
+
+ ptrdiff_t digest_length = gnutls_hmac_get_len (gma);
+ if (digest_length == 0)
+ error ("GnuTLS MAC-method is invalid or not found");
+
+ ptrdiff_t kstart_byte, kend_byte;
+ const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte);
+ if (kdata == NULL)
+ error ("GnuTLS MAC key extraction failed");
+
+ gnutls_hmac_hd_t hmac;
+ int ret = gnutls_hmac_init (&hmac, gma,
+ kdata + kstart_byte, kend_byte - kstart_byte);
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS MAC %s initialization failed: %s",
+ gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
+
+ ptrdiff_t istart_byte, iend_byte;
+ const char *idata
+ = extract_data_from_object (input, &istart_byte, &iend_byte);
+ if (idata == NULL)
+ error ("GnuTLS MAC input extraction failed");
+
+ Lisp_Object digest = make_uninit_string (digest_length);
+
+ ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte);
+
+ if (STRINGP (XCAR (key)))
+ Fclear_string (XCAR (key));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_hmac_deinit (hmac, NULL);
+ error ("GnuTLS MAC %s application failed: %s",
+ gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret));
+ }
+
+ gnutls_hmac_output (hmac, SSDATA (digest));
+ gnutls_hmac_deinit (hmac, NULL);
+
+ return digest;
+}
+
+DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0,
+ doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string.
+
+Return nil on error.
+
+The INPUT can be specified as a buffer or string or in other
+ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs').
+
+The alist of digest algorithms can be obtained with `gnutls-digests`.
+The DIGEST-METHOD may be a string or symbol matching a key in that
+alist, or a plist with the `:digest-algorithm-id' numeric property, or
+the number itself. */)
+ (Lisp_Object digest_method, Lisp_Object input)
+{
+ if (BUFFERP (input) || STRINGP (input))
+ input = list1 (input);
+
+ CHECK_CONS (input);
+
+ gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN;
+
+ Lisp_Object info = Qnil;
+ if (STRINGP (digest_method))
+ digest_method = intern (SSDATA (digest_method));
+
+ if (SYMBOLP (digest_method))
+ info = XCDR (Fassq (digest_method, Fgnutls_digests ()));
+ else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method))
+ gda = XINT (digest_method);
+ else
+ info = digest_method;
+
+ if (!NILP (info) && CONSP (info))
+ {
+ Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id);
+ if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v))
+ gda = XINT (v);
+ }
+
+ ptrdiff_t digest_length = gnutls_hash_get_len (gda);
+ if (digest_length == 0)
+ error ("GnuTLS digest-method is invalid or not found");
+
+ gnutls_hash_hd_t hash;
+ int ret = gnutls_hash_init (&hash, gda);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ error ("GnuTLS digest initialization failed: %s",
+ emacs_gnutls_strerror (ret));
+
+ Lisp_Object digest = make_uninit_string (digest_length);
+
+ ptrdiff_t istart_byte, iend_byte;
+ const char *idata
+ = extract_data_from_object (input, &istart_byte, &iend_byte);
+ if (idata == NULL)
+ error ("GnuTLS digest input extraction failed");
+
+ ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_hash_deinit (hash, NULL);
+ error ("GnuTLS digest application failed: %s",
+ emacs_gnutls_strerror (ret));
+ }
+
+ gnutls_hash_output (hash, SSDATA (digest));
+ gnutls_hash_deinit (hash, NULL);
+
+ return digest;
+}
+
+#endif /* HAVE_GNUTLS3 */
+
DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
- doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
- (void)
+ doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs.
+
+...if supported : then...
+GnuTLS 3 or higher : the list will contain `gnutls3'.
+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'. */)
+ (void)
{
+ Lisp_Object capabilities = Qnil;
+
#ifdef HAVE_GNUTLS
+
+ capabilities = Fcons (intern("gnutls"), capabilities);
+
+# ifdef HAVE_GNUTLS3
+ capabilities = Fcons (intern("gnutls3"), capabilities);
+ capabilities = Fcons (intern("digests"), capabilities);
+ capabilities = Fcons (intern("ciphers"), capabilities);
+
+# ifdef HAVE_GNUTLS_AEAD
+ capabilities = Fcons (intern("AEAD-ciphers"), capabilities);
+# endif
+
+ capabilities = Fcons (intern("macs"), capabilities);
+# endif /* HAVE_GNUTLS3 */
+
# ifdef WINDOWSNT
Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
if (CONSP (found))
@@ -1709,16 +2443,14 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
else
{
Lisp_Object status;
- status = init_gnutls_functions () ? Qt : Qnil;
+ status = init_gnutls_functions () ? capabilities : Qnil;
Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache);
return status;
}
-# else /* !WINDOWSNT */
- return Qt;
-# endif /* !WINDOWSNT */
-#else /* !HAVE_GNUTLS */
- return Qnil;
-#endif /* !HAVE_GNUTLS */
+# endif /* WINDOWSNT */
+#endif /* HAVE_GNUTLS */
+
+ return capabilities;
}
void
@@ -1753,6 +2485,26 @@ syms_of_gnutls (void)
DEFSYM (QCverify_flags, ":verify-flags");
DEFSYM (QCverify_error, ":verify-error");
+ DEFSYM (QCcipher_id, ":cipher-id");
+ DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable");
+ DEFSYM (QCcipher_blocksize, ":cipher-blocksize");
+ DEFSYM (QCcipher_keysize, ":cipher-keysize");
+ DEFSYM (QCcipher_tagsize, ":cipher-tagsize");
+ DEFSYM (QCcipher_ivsize, ":cipher-ivsize");
+
+ DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id");
+ DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize");
+ DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize");
+ DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length");
+
+ DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id");
+ DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length");
+
+ DEFSYM (QCtype, ":type");
+ DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher");
+ DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm");
+ DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm");
+
DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
Fput (Qgnutls_e_interrupted, Qgnutls_code,
make_number (GNUTLS_E_INTERRUPTED));
@@ -1780,6 +2532,16 @@ syms_of_gnutls (void)
defsubr (&Sgnutls_peer_status);
defsubr (&Sgnutls_peer_status_warning_describe);
+#ifdef HAVE_GNUTLS3
+ defsubr (&Sgnutls_ciphers);
+ defsubr (&Sgnutls_macs);
+ defsubr (&Sgnutls_digests);
+ defsubr (&Sgnutls_hash_mac);
+ defsubr (&Sgnutls_hash_digest);
+ defsubr (&Sgnutls_symmetric_encrypt);
+ defsubr (&Sgnutls_symmetric_decrypt);
+#endif
+
DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
doc: /* Logging level used by the GnuTLS functions.
Set this larger than 0 to get debug output in the *Messages* buffer.
diff --git a/src/gnutls.h b/src/gnutls.h
index 3c84023cd4e..00fa55b6c04 100644
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_GNUTLS_DEFINED
#define EMACS_GNUTLS_DEFINED
@@ -23,6 +23,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <gnutls/gnutls.h>
#include <gnutls/x509.h>
+#if 0x030000 <= GNUTLS_VERSION_NUMBER
+# define HAVE_GNUTLS3
+# include <gnutls/crypto.h>
+#endif
+
#include "lisp.h"
/* This limits the attempts to handshake per process (connection). It
@@ -82,6 +87,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte);
extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state);
#ifdef WINDOWSNT
extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err);
+extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t);
#endif
extern Lisp_Object emacs_gnutls_deinit (Lisp_Object);
extern Lisp_Object emacs_gnutls_global_init (void);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 16eb284d7c7..c279f1d2bcd 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -204,6 +204,31 @@ xg_display_open (char *display_name, Display **dpy)
*dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL;
}
+/* Scaling/HiDPI functions. */
+static int
+xg_get_gdk_scale (void)
+{
+ const char *sscale = getenv ("GDK_SCALE");
+
+ if (sscale)
+ {
+ long scale = atol (sscale);
+ if (0 < scale)
+ return min (scale, INT_MAX);
+ }
+
+ return 1;
+}
+
+int
+xg_get_scale (struct frame *f)
+{
+#if GTK_CHECK_VERSION (3, 10, 0)
+ if (FRAME_GTK_WIDGET (f))
+ return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f));
+#endif
+ return xg_get_gdk_scale ();
+}
/* Close display DPY. */
@@ -552,7 +577,18 @@ xg_check_special_colors (struct frame *f,
if (get_fg)
gtk_style_context_get_color (gsty, state, &col);
else
- gtk_style_context_get_background_color (gsty, state, &col);
+ {
+ GdkRGBA *c;
+ /* FIXME: Retrieving the background color is deprecated in
+ GTK+ 3.16. New versions of GTK+ don’t use the concept of a
+ single background color any more, so we shouldn’t query for
+ it. */
+ gtk_style_context_get (gsty, state,
+ GTK_STYLE_PROPERTY_BACKGROUND_COLOR, &c,
+ NULL);
+ col = *c;
+ gdk_rgba_free (c);
+ }
unsigned short
r = col.red * 65535,
@@ -724,7 +760,8 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y)
if (x->ttip_window)
{
block_input ();
- gtk_window_move (x->ttip_window, root_x, root_y);
+ gtk_window_move (x->ttip_window, root_x / xg_get_scale (f),
+ root_y / xg_get_scale (f));
gtk_widget_show_all (GTK_WIDGET (x->ttip_window));
unblock_input ();
}
@@ -766,6 +803,7 @@ xg_hide_tooltip (struct frame *f)
General functions for creating widgets, resizing, events, e.t.c.
***********************************************************************/
+#if ! GTK_CHECK_VERSION (3, 22, 0)
static void
my_log_handler (const gchar *log_domain, GLogLevelFlags log_level,
const gchar *msg, gpointer user_data)
@@ -773,6 +811,7 @@ my_log_handler (const gchar *log_domain, GLogLevelFlags log_level,
if (!strstr (msg, "visible children"))
fprintf (stderr, "XX %s-WARNING **: %s\n", log_domain, msg);
}
+#endif
/* Make a geometry string and pass that to GTK. It seems this is the
only way to get geometry position right if the user explicitly
@@ -784,8 +823,10 @@ xg_set_geometry (struct frame *f)
{
if (f->size_hint_flags & (USPosition | PPosition))
{
+#if ! GTK_CHECK_VERSION (3, 22, 0)
if (x_gtk_use_window_move)
{
+#endif
/* Handle negative positions without consulting
gtk_window_parse_geometry (Bug#25851). The position will
be off by scrollbar width + window manager decorations. */
@@ -802,6 +843,7 @@ xg_set_geometry (struct frame *f)
/* Reset size hint flags. */
f->size_hint_flags &= ~ (XNegative | YNegative);
+# if ! GTK_CHECK_VERSION (3, 22, 0)
}
else
{
@@ -833,24 +875,10 @@ xg_set_geometry (struct frame *f)
g_log_remove_handler ("Gtk", id);
}
+#endif
}
}
-static int
-xg_get_gdk_scale (void)
-{
- const char *sscale = getenv ("GDK_SCALE");
-
- if (sscale)
- {
- long scale = atol (sscale);
- if (0 < scale)
- return min (scale, INT_MAX);
- }
-
- return 1;
-}
-
/* Function to handle resize of our frame. As we have a Gtk+ tool bar
and a Gtk+ menu bar, we get resize events for the edit part of the
frame only. We let Gtk+ deal with the Gtk+ parts.
@@ -912,12 +940,8 @@ xg_frame_set_char_size (struct frame *f, int width, int height)
/* Do this before resize, as we don't know yet if we will be resized. */
x_clear_under_internal_border (f);
- if (FRAME_VISIBLE_P (f))
- {
- int scale = xg_get_gdk_scale ();
- totalheight /= scale;
- totalwidth /= scale;
- }
+ totalheight /= xg_get_scale (f);
+ totalwidth /= xg_get_scale (f);
x_wm_set_size_hint (f, 0, 0);
@@ -1037,16 +1061,23 @@ static void
xg_set_widget_bg (struct frame *f, GtkWidget *w, unsigned long pixel)
{
#ifdef HAVE_GTK3
- GdkRGBA bg;
XColor xbg;
xbg.pixel = pixel;
if (XQueryColor (FRAME_X_DISPLAY (f), FRAME_X_COLORMAP (f), &xbg))
{
- bg.red = (double)xbg.red/65535.0;
- bg.green = (double)xbg.green/65535.0;
- bg.blue = (double)xbg.blue/65535.0;
- bg.alpha = 1.0;
- gtk_widget_override_background_color (w, GTK_STATE_FLAG_NORMAL, &bg);
+ const char format[] = "* { background-color: #%02x%02x%02x; }";
+ /* The format is always longer than the resulting string. */
+ char buffer[sizeof format];
+ int n = snprintf(buffer, sizeof buffer, format,
+ xbg.red >> 8, xbg.green >> 8, xbg.blue >> 8);
+ eassert (n > 0);
+ eassert (n < sizeof buffer);
+ GtkCssProvider *provider = gtk_css_provider_new ();
+ gtk_css_provider_load_from_data (provider, buffer, -1, NULL);
+ gtk_style_context_add_provider (gtk_widget_get_style_context(w),
+ GTK_STYLE_PROVIDER (provider),
+ GTK_STYLE_PROVIDER_PRIORITY_APPLICATION);
+ g_clear_object (&provider);
}
#else
GdkColor bg;
@@ -1204,12 +1235,17 @@ xg_create_frame_widgets (struct frame *f)
with regular X drawing primitives, so from a GTK/GDK point of
view, the widget is totally blank. When an expose comes, this
will make the widget blank, and then Emacs redraws it. This flickers
- a lot, so we turn off double buffering. */
+ a lot, so we turn off double buffering.
+ FIXME: gtk_widget_set_double_buffered is deprecated and might stop
+ working in the future. We need to migrate away from combining
+ X and GTK+ drawing to a pure GTK+ build. */
gtk_widget_set_double_buffered (wfixed, FALSE);
+#if ! GTK_CHECK_VERSION (3, 22, 0)
gtk_window_set_wmclass (GTK_WINDOW (wtop),
SSDATA (Vx_resource_name),
SSDATA (Vx_resource_class));
+#endif
/* Add callback to do nothing on WM_DELETE_WINDOW. The default in
GTK is to destroy the widget. We want Emacs to do that instead. */
@@ -1343,11 +1379,11 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position)
int min_rows = 0, min_cols = 0;
int win_gravity = f->win_gravity;
Lisp_Object fs_state, frame;
- int scale = xg_get_gdk_scale ();
+ int scale = xg_get_scale (f);
/* Don't set size hints during initialization; that apparently leads
to a race condition. See the thread at
- http://lists.gnu.org/archive/html/emacs-devel/2008-10/msg00033.html */
+ https://lists.gnu.org/r/emacs-devel/2008-10/msg00033.html */
if (NILP (Vafter_init_time)
|| !FRAME_GTK_OUTER_WIDGET (f)
|| FRAME_PARENT_FRAME (f))
@@ -1503,6 +1539,7 @@ xg_set_undecorated (struct frame *f, Lisp_Object undecorated)
void
xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
{
+#if GTK_CHECK_VERSION (2, 18, 0)
block_input ();
if (FRAME_GTK_OUTER_WIDGET (f1) && FRAME_GTK_OUTER_WIDGET (f2))
{
@@ -1517,6 +1554,7 @@ xg_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
x_sync (f1);
}
unblock_input ();
+#endif
}
@@ -3657,16 +3695,16 @@ update_theme_scrollbar_height (void)
}
int
-xg_get_default_scrollbar_width (void)
+xg_get_default_scrollbar_width (struct frame *f)
{
- return scroll_bar_width_for_theme * xg_get_gdk_scale ();
+ return scroll_bar_width_for_theme * xg_get_scale (f);
}
int
-xg_get_default_scrollbar_height (void)
+xg_get_default_scrollbar_height (struct frame *f)
{
/* Apparently there's no default height for themes. */
- return scroll_bar_width_for_theme * xg_get_gdk_scale ();
+ return scroll_bar_width_for_theme * xg_get_scale (f);
}
/* Return the scrollbar id for X Window WID on display DPY.
@@ -3856,7 +3894,7 @@ xg_update_scrollbar_pos (struct frame *f,
GtkWidget *wfixed = f->output_data.x->edit_widget;
GtkWidget *wparent = gtk_widget_get_parent (wscroll);
gint msl;
- int scale = xg_get_gdk_scale ();
+ int scale = xg_get_scale (f);
top /= scale;
left /= scale;
@@ -4070,8 +4108,10 @@ xg_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar,
if (int_gtk_range_get_value (GTK_RANGE (wscroll)) != value)
gtk_range_set_value (GTK_RANGE (wscroll), (gdouble)value);
+#if ! GTK_CHECK_VERSION (3, 18, 0)
else if (changed)
gtk_adjustment_changed (adj);
+#endif
xg_ignore_gtk_scrollbar = 0;
@@ -4108,7 +4148,9 @@ xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar,
gtk_adjustment_configure (adj, (gdouble) value, (gdouble) lower,
(gdouble) upper, (gdouble) step_increment,
(gdouble) page_increment, (gdouble) pagesize);
+#if ! GTK_CHECK_VERSION (3, 18, 0)
gtk_adjustment_changed (adj);
+#endif
unblock_input ();
}
}
@@ -4129,8 +4171,13 @@ xg_event_is_for_scrollbar (struct frame *f, const XEvent *event)
GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f));
GdkWindow *gwin;
#ifdef HAVE_GTK3
+#if GTK_CHECK_VERSION (3, 20, 0)
+ GdkDevice *gdev
+ = gdk_seat_get_pointer (gdk_display_get_default_seat (gdpy));
+#else
GdkDevice *gdev = gdk_device_manager_get_client_pointer
(gdk_display_get_device_manager (gdpy));
+#endif
gwin = gdk_device_get_window_at_position (gdev, NULL, NULL);
#else
gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL);
@@ -4603,7 +4650,11 @@ xg_make_tool_item (struct frame *f,
if (wimage && text_image)
gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0);
+#if GTK_CHECK_VERSION (3, 20, 0)
+ gtk_widget_set_focus_on_click (wb, FALSE);
+#else
gtk_button_set_focus_on_click (GTK_BUTTON (wb), FALSE);
+#endif
gtk_button_set_relief (GTK_BUTTON (wb), GTK_RELIEF_NONE);
gtk_container_add (GTK_CONTAINER (wb), vb);
gtk_container_add (GTK_CONTAINER (weventbox), wb);
@@ -5220,6 +5271,7 @@ xg_initialize (void)
settings = gtk_settings_get_for_screen (gdk_display_get_default_screen
(gdk_display_get_default ()));
+#if ! GTK_CHECK_VERSION (3, 10, 0)
/* Remove F10 as a menu accelerator, it does not mix well with Emacs key
bindings. It doesn't seem to be any way to remove properties,
so we set it to "" which in means "no key". */
@@ -5227,13 +5279,18 @@ xg_initialize (void)
"gtk-menu-bar-accel",
"",
EMACS_CLASS);
+#endif
/* Make GTK text input widgets use Emacs style keybindings. This is
Emacs after all. */
+#if GTK_CHECK_VERSION (3, 16, 0)
+ g_object_set (settings, "gtk-key-theme-name", "Emacs", NULL);
+#else
gtk_settings_set_string_property (settings,
"gtk-key-theme-name",
"Emacs",
EMACS_CLASS);
+#endif
/* Make dialogs close on C-g. Since file dialog inherits from
dialog, this works for them also. */
diff --git a/src/gtkutil.h b/src/gtkutil.h
index 0abcb06bc71..f71f4bb0eda 100644
--- a/src/gtkutil.h
+++ b/src/gtkutil.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef GTKUTIL_H
#define GTKUTIL_H
@@ -143,8 +143,8 @@ extern void xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar,
int position,
int whole);
extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *);
-extern int xg_get_default_scrollbar_width (void);
-extern int xg_get_default_scrollbar_height (void);
+extern int xg_get_default_scrollbar_width (struct frame *f);
+extern int xg_get_default_scrollbar_height (struct frame *f);
extern void update_frame_tool_bar (struct frame *f);
extern void free_frame_tool_bar (struct frame *f);
@@ -156,6 +156,7 @@ extern void xg_frame_resized (struct frame *f,
extern void xg_frame_set_char_size (struct frame *f, int width, int height);
extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc);
+extern int xg_get_scale (struct frame *f);
extern void xg_display_open (char *display_name, Display **dpy);
extern void xg_display_close (Display *dpy);
extern GdkCursor * xg_create_default_cursor (Display *dpy);
diff --git a/src/image.c b/src/image.c
index aedec7954ee..c1c1671899b 100644
--- a/src/image.c
+++ b/src/image.c
@@ -15,12 +15,11 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <fcntl.h>
-#include <stdio.h>
#include <unistd.h>
/* Include this before including <setjmp.h> to work around bugs with
@@ -41,6 +40,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "buffer.h"
#include "dispextern.h"
#include "blockinput.h"
+#include "sysstdio.h"
#include "systime.h"
#include <epaths.h>
#include "coding.h"
@@ -2361,7 +2361,7 @@ slurp_file (int fd, ptrdiff_t *size)
This can happen if the file grows as we read it. */
ptrdiff_t buflen = st.st_size;
buf = xmalloc (buflen + 1);
- if (fread (buf, 1, buflen + 1, fp) == buflen)
+ if (fread_unlocked (buf, 1, buflen + 1, fp) == buflen)
*size = buflen;
else
{
@@ -2444,7 +2444,8 @@ static struct image_type xbm_type =
enum xbm_token
{
XBM_TK_IDENT = 256,
- XBM_TK_NUMBER
+ XBM_TK_NUMBER,
+ XBM_TK_OVERFLOW
};
@@ -2573,7 +2574,7 @@ xbm_image_p (Lisp_Object object)
static int
xbm_scan (char **s, char *end, char *sval, int *ival)
{
- unsigned char c;
+ unsigned char c UNINIT;
loop:
@@ -2586,6 +2587,7 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
else if (c_isdigit (c))
{
int value = 0, digit;
+ bool overflow = false;
if (c == '0' && *s < end)
{
@@ -2595,23 +2597,22 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
while (*s < end)
{
c = *(*s)++;
- if (c_isdigit (c))
- digit = c - '0';
- else if (c >= 'a' && c <= 'f')
- digit = c - 'a' + 10;
- else if (c >= 'A' && c <= 'F')
- digit = c - 'A' + 10;
- else
+ digit = char_hexdigit (c);
+ if (digit < 0)
break;
- value = 16 * value + digit;
+ overflow |= INT_MULTIPLY_WRAPV (value, 16, &value);
+ value += digit;
}
}
- else if (c_isdigit (c))
+ else if ('0' <= c && c <= '7')
{
value = c - '0';
while (*s < end
- && (c = *(*s)++, c_isdigit (c)))
- value = 8 * value + c - '0';
+ && (c = *(*s)++, '0' <= c && c <= '7'))
+ {
+ overflow |= INT_MULTIPLY_WRAPV (value, 8, &value);
+ value += c - '0';
+ }
}
}
else
@@ -2619,13 +2620,16 @@ xbm_scan (char **s, char *end, char *sval, int *ival)
value = c - '0';
while (*s < end
&& (c = *(*s)++, c_isdigit (c)))
- value = 10 * value + c - '0';
+ {
+ overflow |= INT_MULTIPLY_WRAPV (value, 10, &value);
+ overflow |= INT_ADD_WRAPV (value, c - '0', &value);
+ }
}
if (*s < end)
*s = *s - 1;
*ival = value;
- return XBM_TK_NUMBER;
+ return overflow ? XBM_TK_OVERFLOW : XBM_TK_NUMBER;
}
else if (c_isalpha (c) || c == '_')
{
@@ -4227,7 +4231,7 @@ xpm_load_image (struct frame *f,
color_val = Qnil;
if (!NILP (color_symbols) && !NILP (symbol_color))
{
- Lisp_Object specified_color = Fassoc (symbol_color, color_symbols);
+ Lisp_Object specified_color = Fassoc (symbol_color, color_symbols, Qnil);
if (CONSP (specified_color) && STRINGP (XCDR (specified_color)))
{
@@ -5273,6 +5277,25 @@ pbm_scan_number (char **s, char *end)
return val;
}
+/* Scan an index from *S and return it. It is a one-byte unsigned
+ index if !TWO_BYTE, and a two-byte big-endian unsigned index if
+ TWO_BYTE. */
+
+static int
+pbm_scan_index (char **s, bool two_byte)
+{
+ char *p = *s;
+ unsigned char c0 = *p++;
+ int n = c0;
+ if (two_byte)
+ {
+ unsigned char c1 = *p++;
+ n = (n << 8) + c1;
+ }
+ *s = p;
+ return n;
+}
+
/* Load PBM image IMG for use on frame F. */
@@ -5495,7 +5518,8 @@ pbm_load (struct frame *f, struct image *img)
else
{
int expected_size = height * width;
- if (max_color_idx > 255)
+ bool two_byte = 255 < max_color_idx;
+ if (two_byte)
expected_size *= 2;
if (type == PBM_COLOR)
expected_size *= 3;
@@ -5518,24 +5542,14 @@ pbm_load (struct frame *f, struct image *img)
int r, g, b;
if (type == PBM_GRAY && raw_p)
- {
- r = g = b = *p++;
- if (max_color_idx > 255)
- r = g = b = r * 256 + *p++;
- }
+ r = g = b = pbm_scan_index (&p, two_byte);
else if (type == PBM_GRAY)
r = g = b = pbm_scan_number (&p, end);
else if (raw_p)
{
- r = *p++;
- if (max_color_idx > 255)
- r = r * 256 + *p++;
- g = *p++;
- if (max_color_idx > 255)
- g = g * 256 + *p++;
- b = *p++;
- if (max_color_idx > 255)
- b = b * 256 + *p++;
+ r = pbm_scan_index (&p, two_byte);
+ g = pbm_scan_index (&p, two_byte);
+ b = pbm_scan_index (&p, two_byte);
}
else
{
@@ -5890,7 +5904,7 @@ png_read_from_file (png_structp png_ptr, png_bytep data, png_size_t length)
{
FILE *fp = png_get_io_ptr (png_ptr);
- if (fread (data, 1, length, fp) < length)
+ if (fread_unlocked (data, 1, length, fp) < length)
png_error (png_ptr, "Read error");
}
@@ -5959,7 +5973,7 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c)
}
/* Check PNG signature. */
- if (fread (sig, 1, sizeof sig, fp) != sizeof sig
+ if (fread_unlocked (sig, 1, sizeof sig, fp) != sizeof sig
|| png_sig_cmp (sig, 0, sizeof sig))
{
fclose (fp);
@@ -6598,7 +6612,8 @@ our_stdio_fill_input_buffer (j_decompress_ptr cinfo)
{
ptrdiff_t bytes;
- bytes = fread (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE, src->file);
+ bytes = fread_unlocked (src->buffer, 1, JPEG_STDIO_BUFFER_SIZE,
+ src->file);
if (bytes > 0)
src->mgr.bytes_in_buffer = bytes;
else
@@ -7143,7 +7158,7 @@ tiff_size_of_memory (thandle_t data)
/* GCC 3.x on x86 Windows targets has a bug that triggers an internal
compiler error compiling tiff_handler, see Bugzilla bug #17406
- (http://gcc.gnu.org/bugzilla/show_bug.cgi?id=17406). Declaring
+ (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=17406). Declaring
this function as external works around that problem. */
# if defined (__MINGW32__) && __GNUC__ == 3
# define MINGW_STATIC
@@ -7834,7 +7849,7 @@ gif_load (struct frame *f, struct image *img)
init_color_table ();
#ifndef USE_CAIRO
- unsigned long bgcolor;
+ unsigned long bgcolor UNINIT;
if (STRINGP (specified_bg))
bgcolor = x_alloc_image_color (f, img, specified_bg,
FRAME_BACKGROUND_PIXEL (f));
@@ -8081,83 +8096,76 @@ compute_image_size (size_t width, size_t height,
int *d_width, int *d_height)
{
Lisp_Object value;
- int desired_width, desired_height;
+ int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1;
double scale = 1;
value = image_spec_value (spec, QCscale, NULL);
if (NUMBERP (value))
scale = XFLOATINT (value);
+ value = image_spec_value (spec, QCmax_width, NULL);
+ if (NATNUMP (value))
+ max_width = min (XFASTINT (value), INT_MAX);
+
+ value = image_spec_value (spec, QCmax_height, NULL);
+ if (NATNUMP (value))
+ max_height = min (XFASTINT (value), INT_MAX);
+
/* If width and/or height is set in the display spec assume we want
to scale to those values. If either h or w is unspecified, the
unspecified should be calculated from the specified to preserve
aspect ratio. */
value = image_spec_value (spec, QCwidth, NULL);
- desired_width = NATNUMP (value) ?
- min (XFASTINT (value) * scale, INT_MAX) : -1;
+ if (NATNUMP (value))
+ {
+ desired_width = min (XFASTINT (value) * scale, INT_MAX);
+ /* :width overrides :max-width. */
+ max_width = -1;
+ }
+
value = image_spec_value (spec, QCheight, NULL);
- desired_height = NATNUMP (value) ?
- min (XFASTINT (value) * scale, INT_MAX) : -1;
+ if (NATNUMP (value))
+ {
+ desired_height = min (XFASTINT (value) * scale, INT_MAX);
+ /* :height overrides :max-height. */
+ max_height = -1;
+ }
+
+ /* If we have both width/height set explicitly, we skip past all the
+ aspect ratio-preserving computations below. */
+ if (desired_width != -1 && desired_height != -1)
+ goto out;
width = width * scale;
height = height * scale;
- if (desired_width == -1)
+ if (desired_width != -1)
+ /* Width known, calculate height. */
+ desired_height = scale_image_size (desired_width, width, height);
+ else if (desired_height != -1)
+ /* Height known, calculate width. */
+ desired_width = scale_image_size (desired_height, height, width);
+ else
{
- value = image_spec_value (spec, QCmax_width, NULL);
- if (NATNUMP (value))
- {
- int max_width = min (XFASTINT (value), INT_MAX);
- if (max_width < width)
- {
- /* The image is wider than :max-width. */
- desired_width = max_width;
- if (desired_height == -1)
- {
- desired_height = scale_image_size (desired_width,
- width, height);
- value = image_spec_value (spec, QCmax_height, NULL);
- if (NATNUMP (value))
- {
- int max_height = min (XFASTINT (value), INT_MAX);
- if (max_height < desired_height)
- {
- desired_height = max_height;
- desired_width = scale_image_size (desired_height,
- height, width);
- }
- }
- }
- }
- }
+ desired_width = width;
+ desired_height = height;
}
- if (desired_height == -1)
+ if (max_width != -1 && desired_width > max_width)
{
- value = image_spec_value (spec, QCmax_height, NULL);
- if (NATNUMP (value))
- {
- int max_height = min (XFASTINT (value), INT_MAX);
- if (max_height < height)
- desired_height = max_height;
- }
+ /* The image is wider than :max-width. */
+ desired_width = max_width;
+ desired_height = scale_image_size (desired_width, width, height);
}
- if (desired_width != -1 && desired_height == -1)
- /* w known, calculate h. */
- desired_height = scale_image_size (desired_width, width, height);
-
- if (desired_width == -1 && desired_height != -1)
- /* h known, calculate w. */
- desired_width = scale_image_size (desired_height, height, width);
-
- /* We have no width/height settings, so just apply the scale. */
- if (desired_width == -1 && desired_height == -1)
+ if (max_height != -1 && desired_height > max_height)
{
- desired_width = width;
- desired_height = height;
+ /* The image is higher than :max-height. */
+ desired_height = max_height;
+ desired_width = scale_image_size (desired_height, height, width);
}
+ out:
*d_width = desired_width;
*d_height = desired_height;
}
@@ -8544,13 +8552,19 @@ imagemagick_load_image (struct frame *f, struct image *img,
char hint_buffer[MaxTextExtent];
char *filename_hint = NULL;
+ /* Initialize the ImageMagick environment. */
+ static bool imagemagick_initialized;
+ if (!imagemagick_initialized)
+ {
+ imagemagick_initialized = true;
+ MagickWandGenesis ();
+ }
+
/* Handle image index for image types who can contain more than one image.
Interface :index is same as for GIF. First we "ping" the image to see how
many sub-images it contains. Pinging is faster than loading the image to
find out things about it. */
- /* Initialize the imagemagick environment. */
- MagickWandGenesis ();
image = image_spec_value (img->spec, QCindex, NULL);
ino = INTEGERP (image) ? XFASTINT (image) : 0;
image_wand = NewMagickWand ();
@@ -8851,8 +8865,10 @@ imagemagick_load_image (struct frame *f, struct image *img,
DestroyMagickWand (image_wand);
if (bg_wand) DestroyPixelWand (bg_wand);
- /* `MagickWandTerminus' terminates the imagemagick environment. */
- MagickWandTerminus ();
+ /* Do not call MagickWandTerminus, to work around ImageMagick bug 825. See:
+ https://github.com/ImageMagick/ImageMagick/issues/825
+ Although this bug was introduced in ImageMagick 6.9.9-14 and
+ fixed in 6.9.9-18, it's simpler to work around it in all versions. */
return 1;
@@ -8860,7 +8876,6 @@ imagemagick_load_image (struct frame *f, struct image *img,
DestroyMagickWand (image_wand);
if (bg_wand) DestroyPixelWand (bg_wand);
- MagickWandTerminus ();
/* TODO more cleanup. */
image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec);
return 0;
@@ -8920,7 +8935,7 @@ their descriptions (http://www.imagemagick.org/script/formats.php).
You can also try the shell command: `identify -list format'.
Note that ImageMagick recognizes many file-types that Emacs does not
-recognize as images, such as C. See `imagemagick-types-enable'
+recognize as images, such as C. See `imagemagick-enabled-types'
and `imagemagick-types-inhibit'. */)
(void)
{
diff --git a/src/indent.c b/src/indent.c
index adecc3622a8..5f931a511e4 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
@@ -1947,6 +1947,79 @@ vmotion (register ptrdiff_t from, register ptrdiff_t from_byte,
-1, hscroll, 0, w);
}
+/* Return the width taken by line-number display in window W. */
+static void
+line_number_display_width (struct window *w, int *width, int *pixel_width)
+{
+ if (NILP (Vdisplay_line_numbers))
+ {
+ *width = 0;
+ *pixel_width = 0;
+ }
+ else
+ {
+ struct it it;
+ struct text_pos startpos;
+ bool saved_restriction = false;
+ ptrdiff_t count = SPECPDL_INDEX ();
+ SET_TEXT_POS_FROM_MARKER (startpos, w->start);
+ void *itdata = bidi_shelve_cache ();
+ /* We want to start from window's start point, but it could be
+ outside the accessible region, in which case we widen the
+ buffer temporarily. It could even be beyond the buffer's end
+ (Org mode's display of source code snippets is known to cause
+ that), in which case we just punt and start from point instead. */
+ if (startpos.charpos > Z)
+ SET_TEXT_POS (startpos, PT, PT_BYTE);
+ if (startpos.charpos < BEGV || startpos.charpos > ZV)
+ {
+ record_unwind_protect (save_restriction_restore,
+ save_restriction_save ());
+ Fwiden ();
+ saved_restriction = true;
+ }
+ start_display (&it, w, startpos);
+ /* The call to move_it_by_lines below will not generate a line
+ number if the first line shown in the window is hscrolled
+ such that all of its display elements are out of view. So we
+ pretend the hscroll doesn't exist. */
+ it.first_visible_x = 0;
+ move_it_by_lines (&it, 1);
+ *width = it.lnum_width;
+ *pixel_width = it.lnum_pixel_width;
+ if (saved_restriction)
+ unbind_to (count, Qnil);
+ bidi_unshelve_cache (itdata, 0);
+ }
+}
+
+DEFUN ("line-number-display-width", Fline_number_display_width,
+ Sline_number_display_width, 0, 1, 0,
+ doc: /* Return the width used for displaying line numbers in the selected window.
+If optional argument PIXELWISE is the symbol `columns', return the width
+in units of the frame's canonical character width. In this case, the
+value is a float.
+If optional argument PIXELWISE is t or any other non-nil value, return
+the width as an integer number of pixels.
+Otherwise return the value as an integer number of columns of the face
+used to display line numbers, `line-number'. Note that in the latter
+case, the value doesn't include the 2 columns used for padding the
+numbers on display. */)
+ (Lisp_Object pixelwise)
+{
+ int width, pixel_width;
+ struct window *w = XWINDOW (selected_window);
+ line_number_display_width (XWINDOW (selected_window), &width, &pixel_width);
+ if (EQ (pixelwise, Qcolumns))
+ {
+ struct frame *f = XFRAME (w->frame);
+ return make_float ((double) pixel_width / FRAME_COLUMN_WIDTH (f));
+ }
+ else if (!NILP (pixelwise))
+ return make_number (pixel_width);
+ return make_number (width);
+}
+
/* In window W (derived from WINDOW), return x coordinate for column
COL (derived from COLUMN). */
static int
@@ -2068,9 +2141,19 @@ whether or not it is currently displayed in some window. */)
start_x = window_column_x (w, window, start_col, cur_col);
}
- itdata = bidi_shelve_cache ();
+ /* When displaying line numbers, we need to prime IT's
+ lnum_width with the value calculated at window's start, since
+ that's what normal window redisplay does. Otherwise C-n/C-p
+ will sometimes err by one column. */
+ int lnum_width = 0;
+ int lnum_pixel_width = 0;
+ if (!NILP (Vdisplay_line_numbers)
+ && !EQ (Vdisplay_line_numbers, Qvisual))
+ line_number_display_width (w, &lnum_width, &lnum_pixel_width);
SET_TEXT_POS (pt, PT, PT_BYTE);
+ itdata = bidi_shelve_cache ();
start_display (&it, w, pt);
+ it.lnum_width = lnum_width;
first_x = it.first_visible_x;
it_start = IT_CHARPOS (it);
@@ -2168,10 +2251,10 @@ whether or not it is currently displayed in some window. */)
screen lines we need to backtrack. */
it_overshoot_count = it.vpos;
}
- /* We will overshoot if lines are truncated and point lies
+ /* We might overshoot if lines are truncated and point lies
beyond the right margin of the window. */
if (it.line_wrap == TRUNCATE && it.current_x >= it.last_visible_x
- && it_overshoot_count == 0)
+ && it_overshoot_count == 0 && it.vpos > 0)
it_overshoot_count = 1;
if (it_overshoot_count > 0)
move_it_by_lines (&it, -it_overshoot_count);
@@ -2247,6 +2330,12 @@ whether or not it is currently displayed in some window. */)
an addition to the hscroll amount. */
if (lcols_given)
{
+ /* If we are displaying line numbers, we could cross the
+ line where the width of the line-number display changes,
+ in which case we need to fix up the pixel coordinate
+ accordingly. */
+ if (lnum_pixel_width > 0)
+ to_x += it.lnum_pixel_width - lnum_pixel_width;
move_it_in_display_line (&it, ZV, first_x + to_x, MOVE_TO_X);
/* If we find ourselves in the middle of an overlay string
which includes a newline after current string position,
@@ -2288,10 +2377,13 @@ syms_of_indent (void)
doc: /* Indentation can insert tabs if this is non-nil. */);
indent_tabs_mode = 1;
+ DEFSYM (Qcolumns, "columns");
+
defsubr (&Scurrent_indentation);
defsubr (&Sindent_to);
defsubr (&Scurrent_column);
defsubr (&Smove_to_column);
+ defsubr (&Sline_number_display_width);
defsubr (&Svertical_motion);
defsubr (&Scompute_motion);
}
diff --git a/src/indent.h b/src/indent.h
index 42ae1260bc3..27a3c583882 100644
--- a/src/indent.h
+++ b/src/indent.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_INDENT_H
#define EMACS_INDENT_H
diff --git a/src/inotify.c b/src/inotify.c
index 3d5d3d2621f..c0fc1db1570 100644
--- a/src/inotify.c
+++ b/src/inotify.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/insdel.c b/src/insdel.c
index 0a2e07a343f..5dfc62843a7 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/intervals.c b/src/intervals.c
index d17d80ac865..e711212d744 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* NOTES:
@@ -224,7 +224,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1)
Pass FUNCTION two args: an interval, and ARG. */
void
-traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg)
+traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *),
+ void *arg)
{
/* Minimize stack usage. */
while (tree)
@@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position,
}
}
-#if 0
-
-static int icount;
-static int idepth;
-static int zero_length;
-
-/* These functions are temporary, for debugging purposes only. */
-
-INTERVAL search_interval, found_interval;
-
-void
-check_for_interval (INTERVAL i)
-{
- if (i == search_interval)
- {
- found_interval = i;
- icount++;
- }
-}
-
-INTERVAL
-search_for_interval (INTERVAL i, INTERVAL tree)
-{
- icount = 0;
- search_interval = i;
- found_interval = NULL;
- traverse_intervals_noorder (tree, &check_for_interval, Qnil);
- return found_interval;
-}
-
-static void
-inc_interval_count (INTERVAL i)
-{
- icount++;
- if (LENGTH (i) == 0)
- zero_length++;
- if (depth > idepth)
- idepth = depth;
-}
-
-int
-count_intervals (INTERVAL i)
-{
- icount = 0;
- idepth = 0;
- zero_length = 0;
- traverse_intervals_noorder (i, &inc_interval_count, Qnil);
-
- return icount;
-}
-
-static INTERVAL
-root_interval (INTERVAL interval)
-{
- register INTERVAL i = interval;
-
- while (! ROOT_INTERVAL_P (i))
- i = INTERVAL_PARENT (i);
-
- return i;
-}
-#endif
-
/* Assuming that a left child exists, perform the following operation:
A B
@@ -2215,6 +2153,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type)
{
Lisp_Object prop, lispy_position, lispy_buffer;
ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte;
+ ptrdiff_t count = SPECPDL_INDEX ();
position = clip_to_bounds (BUF_BEGV (buffer), position, BUF_ZV (buffer));
@@ -2225,6 +2164,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type)
old_begv_byte = BUF_BEGV_BYTE (buffer);
old_zv_byte = BUF_ZV_BYTE (buffer);
+ specbind (Qinhibit_quit, Qt);
SET_BUF_BEGV_BOTH (buffer, BUF_BEG (buffer), BUF_BEG_BYTE (buffer));
SET_BUF_ZV_BOTH (buffer, BUF_Z (buffer), BUF_Z_BYTE (buffer));
@@ -2242,6 +2182,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type)
SET_BUF_BEGV_BOTH (buffer, old_begv, old_begv_byte);
SET_BUF_ZV_BOTH (buffer, old_zv, old_zv_byte);
+ unbind_to (count, Qnil);
/* Use the local map only if it is valid. */
prop = get_keymap (prop, 0, 0);
diff --git a/src/intervals.h b/src/intervals.h
index db91b3f21a0..7dec6e5c765 100644
--- a/src/intervals.h
+++ b/src/intervals.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_INTERVALS_H
#define EMACS_INTERVALS_H
@@ -85,10 +85,10 @@ struct interval
#define LEAF_INTERVAL_P(i) ((i)->left == NULL && (i)->right == NULL)
/* True if this interval has no parent and is therefore the root. */
-#define ROOT_INTERVAL_P(i) (NULL_PARENT (i))
+#define ROOT_INTERVAL_P(i) NULL_PARENT (i)
/* True if this interval is the only interval in the interval tree. */
-#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P ((i)) && LEAF_INTERVAL_P ((i)))
+#define ONLY_INTERVAL_P(i) (ROOT_INTERVAL_P (i) && LEAF_INTERVAL_P (i))
/* True if this interval has both left and right children. */
#define BOTH_KIDS_P(i) ((i)->left != NULL && (i)->right != NULL)
@@ -98,13 +98,13 @@ struct interval
#define TOTAL_LENGTH(i) ((i) == NULL ? 0 : (i)->total_length)
/* The size of text represented by this interval alone. */
-#define LENGTH(i) ((i) == NULL ? 0 : (TOTAL_LENGTH ((i)) \
- - TOTAL_LENGTH ((i)->right) \
- - TOTAL_LENGTH ((i)->left)))
+#define LENGTH(i) ((i)->total_length \
+ - TOTAL_LENGTH ((i)->right) \
+ - TOTAL_LENGTH ((i)->left))
/* The position of the character just past the end of I. Note that
the position cache i->position must be valid for this to work. */
-#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH ((i)))
+#define INTERVAL_LAST_POS(i) ((i)->position + LENGTH (i))
/* The total size of the left subtree of this interval. */
#define LEFT_TOTAL_LENGTH(i) ((i)->left ? (i)->left->total_length : 0)
@@ -242,8 +242,7 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t,
void (*) (INTERVAL, Lisp_Object),
Lisp_Object);
extern void traverse_intervals_noorder (INTERVAL,
- void (*) (INTERVAL, Lisp_Object),
- Lisp_Object);
+ void (*) (INTERVAL, void *), void *);
extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t);
extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t);
extern INTERVAL find_interval (INTERVAL, ptrdiff_t);
diff --git a/src/keyboard.c b/src/keyboard.c
index 55486c6d9ab..375aa4f6067 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -39,9 +39,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "intervals.h"
#include "keymap.h"
#include "blockinput.h"
+#include "sysstdio.h"
#include "systime.h"
#include "atimer.h"
#include "process.h"
+#include "menu.h"
#include <errno.h>
#ifdef HAVE_PTHREAD
@@ -144,10 +146,6 @@ static Lisp_Object recover_top_level_message;
/* Message normally displayed by Vtop_level. */
static Lisp_Object regular_top_level_message;
-/* For longjmp to where kbd input is being done. */
-
-static sys_jmp_buf getcjmp;
-
/* True while displaying for echoing. Delays C-g throwing. */
static bool echoing;
@@ -1368,6 +1366,7 @@ command_loop_1 (void)
Vthis_command_keys_shift_translated = Qnil;
/* Read next key sequence; i gets its length. */
+ raw_keybuf_count = 0;
i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
Qnil, 0, 1, 1, 0);
@@ -2569,9 +2568,6 @@ read_char (int commandflag, Lisp_Object map,
so restore it now. */
restore_getcjmp (save_jump);
pthread_sigmask (SIG_SETMASK, &empty_mask, 0);
-#if THREADS_ENABLED
- maybe_reacquire_global_lock ();
-#endif
unbind_to (jmpcount, Qnil);
XSETINT (c, quit_char);
internal_last_event_frame = selected_frame;
@@ -2815,6 +2811,9 @@ read_char (int commandflag, Lisp_Object map,
if (EQ (c, make_number (-2)))
return c;
+
+ if (CONSP (c) && EQ (XCAR (c), Qt))
+ c = XCDR (c);
}
non_reread:
@@ -3290,7 +3289,7 @@ record_char (Lisp_Object c)
if (INTEGERP (c))
{
if (XUINT (c) < 0x100)
- putc (XUINT (c), dribble);
+ putc_unlocked (XUINT (c), dribble);
else
fprintf (dribble, " 0x%"pI"x", XUINT (c));
}
@@ -3303,15 +3302,15 @@ record_char (Lisp_Object c)
if (SYMBOLP (dribblee))
{
- putc ('<', dribble);
- fwrite (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
- SBYTES (SYMBOL_NAME (dribblee)),
- dribble);
- putc ('>', dribble);
+ putc_unlocked ('<', dribble);
+ fwrite_unlocked (SDATA (SYMBOL_NAME (dribblee)), sizeof (char),
+ SBYTES (SYMBOL_NAME (dribblee)),
+ dribble);
+ putc_unlocked ('>', dribble);
}
}
- fflush (dribble);
+ fflush_unlocked (dribble);
unblock_input ();
}
}
@@ -3769,7 +3768,7 @@ kbd_buffer_get_event (KBOARD **kbp,
detaching from the terminal. */
|| (IS_DAEMON && DAEMON_RUNNING))
{
- int c = getchar ();
+ int c = getchar_unlocked ();
XSETINT (obj, c);
*kbp = current_kboard;
return obj;
@@ -5126,6 +5125,19 @@ static short const scroll_bar_parts[] = {
SYMBOL_INDEX (Qrightmost), SYMBOL_INDEX (Qend_scroll), SYMBOL_INDEX (Qratio)
};
+#ifdef HAVE_WINDOW_SYSTEM
+/* An array of symbol indexes of internal border parts, indexed by an enum
+ internal_border_part value. Note that Qnil corresponds to
+ internal_border_part_none and should not appear in Lisp events. */
+static short const internal_border_parts[] = {
+ SYMBOL_INDEX (Qnil), SYMBOL_INDEX (Qleft_edge),
+ SYMBOL_INDEX (Qtop_left_corner), SYMBOL_INDEX (Qtop_edge),
+ SYMBOL_INDEX (Qtop_right_corner), SYMBOL_INDEX (Qright_edge),
+ SYMBOL_INDEX (Qbottom_right_corner), SYMBOL_INDEX (Qbottom_edge),
+ SYMBOL_INDEX (Qbottom_left_corner)
+};
+#endif
+
/* A vector, indexed by button number, giving the down-going location
of currently depressed buttons, both scroll bar and non-scroll bar.
@@ -5163,15 +5175,15 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
Lisp_Object extra_info = Qnil;
/* Coordinate pixel positions to return. */
int xret = 0, yret = 0;
- /* The window under frame pixel coordinates (x,y) */
- Lisp_Object window = f
+ /* The window or frame under frame pixel coordinates (x,y) */
+ Lisp_Object window_or_frame = f
? window_from_coordinates (f, XINT (x), XINT (y), &part, 0)
: Qnil;
- if (WINDOWP (window))
+ if (WINDOWP (window_or_frame))
{
/* It's a click in window WINDOW at frame coordinates (X,Y) */
- struct window *w = XWINDOW (window);
+ struct window *w = XWINDOW (window_or_frame);
Lisp_Object string_info = Qnil;
ptrdiff_t textpos = 0;
int col = -1, row = -1;
@@ -5360,17 +5372,31 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
make_number (row)),
extra_info)));
}
- else if (f != 0)
+
+#ifdef HAVE_WINDOW_SYSTEM
+ else if (f)
{
/* Return mouse pixel coordinates here. */
- XSETFRAME (window, f);
+ XSETFRAME (window_or_frame, f);
xret = XINT (x);
yret = XINT (y);
+
+ if (FRAME_LIVE_P (f)
+ && FRAME_INTERNAL_BORDER_WIDTH (f) > 0
+ && !NILP (get_frame_param (f, Qdrag_internal_border)))
+ {
+ enum internal_border_part part
+ = frame_internal_border_part (f, xret, yret);
+
+ posn = builtin_lisp_symbol (internal_border_parts[part]);
+ }
}
+#endif
+
else
- window = Qnil;
+ window_or_frame = Qnil;
- return Fcons (window,
+ return Fcons (window_or_frame,
Fcons (posn,
Fcons (Fcons (make_number (xret),
make_number (yret)),
@@ -5897,7 +5923,10 @@ make_lispy_event (struct input_event *event)
ASIZE (wheel_syms));
}
- if (event->modifiers & (double_modifier | triple_modifier))
+ if (NUMBERP (event->arg))
+ return list4 (head, position, make_number (double_click_count),
+ event->arg);
+ else if (event->modifiers & (double_modifier | triple_modifier))
return list3 (head, position, make_number (double_click_count));
else
return list2 (head, position);
@@ -7877,7 +7906,7 @@ parse_menu_item (Lisp_Object item, int inmenubar)
(such as lmenu.el set it up), check if the
original command matches the cached command. */
&& !(SYMBOLP (def)
- && EQ (tem, XSYMBOL (def)->function))))
+ && EQ (tem, XSYMBOL (def)->u.s.function))))
keys = Qnil;
}
@@ -8426,7 +8455,7 @@ read_char_x_menu_prompt (Lisp_Object map,
/* Display the menu and get the selection. */
Lisp_Object value;
- value = Fx_popup_menu (prev_event, get_keymap (map, 0, 1));
+ value = x_popup_menu_1 (prev_event, get_keymap (map, 0, 1));
if (CONSP (value))
{
Lisp_Object tem;
@@ -8737,9 +8766,9 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt,
/* Handle a symbol whose function definition is a keymap
or an array. */
if (SYMBOLP (next) && !NILP (Ffboundp (next))
- && (ARRAYP (XSYMBOL (next)->function)
- || KEYMAPP (XSYMBOL (next)->function)))
- next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil);
+ && (ARRAYP (XSYMBOL (next)->u.s.function)
+ || KEYMAPP (XSYMBOL (next)->u.s.function)))
+ next = Fautoload_do_load (XSYMBOL (next)->u.s.function, next, Qnil);
/* If the keymap gives a function, not an
array, then call the function with one arg and use
@@ -8836,6 +8865,11 @@ test_undefined (Lisp_Object binding)
&& EQ (Fcommand_remapping (binding, Qnil, Qnil), Qundefined)));
}
+void init_raw_keybuf_count (void)
+{
+ raw_keybuf_count = 0;
+}
+
/* Read a sequence of keys that ends with a non prefix character,
storing it in KEYBUF, a buffer of size BUFSIZE.
Prompt with PROMPT.
@@ -8892,7 +8926,6 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
ptrdiff_t keys_start;
Lisp_Object current_binding = Qnil;
- Lisp_Object first_event = Qnil;
/* Index of the first key that has no binding.
It is useless to try fkey.start larger than that. */
@@ -8947,7 +8980,11 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
/* List of events for which a fake prefix key has been generated. */
Lisp_Object fake_prefixed_keys = Qnil;
- raw_keybuf_count = 0;
+ /* raw_keybuf_count is now initialized in (most of) the callers of
+ read_key_sequence. This is so that in a recursive call (for
+ mouse menus) a spurious initialization doesn't erase the contents
+ of raw_keybuf created by the outer call. */
+ /* raw_keybuf_count = 0; */
last_nonmenu_event = Qnil;
@@ -9002,6 +9039,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
starting_buffer = current_buffer;
first_unbound = bufsize + 1;
+ Lisp_Object first_event = mock_input > 0 ? keybuf[0] : Qnil;
/* Build our list of keymaps.
If we recognize a function key and replace its escape sequence in
@@ -9319,6 +9357,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt,
&& BUFFERP (XWINDOW (window)->contents)
&& XBUFFER (XWINDOW (window)->contents) != current_buffer)
{
+ GROW_RAW_KEYBUF;
ASET (raw_keybuf, raw_keybuf_count, key);
raw_keybuf_count++;
keybuf[t] = key;
@@ -9813,6 +9852,7 @@ read_key_sequence_vs (Lisp_Object prompt, Lisp_Object continue_echo,
cancel_hourglass ();
#endif
+ raw_keybuf_count = 0;
i = read_key_sequence (keybuf, ARRAYELTS (keybuf),
prompt, ! NILP (dont_downcase_last),
! NILP (can_return_switch_frame), 0, 0);
@@ -10031,7 +10071,12 @@ Internal use only. */)
this_command_key_count = 0;
this_single_command_key_start = 0;
- int key0 = SREF (keys, 0);
+
+ int charidx = 0, byteidx = 0;
+ int key0;
+ FETCH_STRING_CHAR_ADVANCE (key0, keys, charidx, byteidx);
+ if (CHAR_BYTE8_P (key0))
+ key0 = CHAR_TO_BYTE8 (key0);
/* Kludge alert: this makes M-x be in the form expected by
novice.el. (248 is \370, a.k.a. "Meta-x".) Any better ideas? */
@@ -10040,7 +10085,13 @@ Internal use only. */)
else
add_command_key (make_number (key0));
for (ptrdiff_t i = 1; i < SCHARS (keys); i++)
- add_command_key (make_number (SREF (keys, i)));
+ {
+ int key_i;
+ FETCH_STRING_CHAR_ADVANCE (key_i, keys, charidx, byteidx);
+ if (CHAR_BYTE8_P (key_i))
+ key_i = CHAR_TO_BYTE8 (key_i);
+ add_command_key (make_number (key_i));
+ }
return Qnil;
}
@@ -10140,7 +10191,8 @@ This may include sensitive information such as passwords. */)
file = Fexpand_file_name (file, Qnil);
encfile = ENCODE_FILE (file);
fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
- if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0)
+ if (fd < 0 && errno == EEXIST
+ && (unlink (SSDATA (encfile)) == 0 || errno == ENOENT))
fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600);
dribble = fd < 0 ? 0 : fdopen (fd, "w");
if (dribble == 0)
@@ -10377,7 +10429,7 @@ handle_interrupt (bool in_signal_handler)
sigemptyset (&blocked);
sigaddset (&blocked, SIGINT);
pthread_sigmask (SIG_BLOCK, &blocked, 0);
- fflush (stdout);
+ fflush_unlocked (stdout);
}
reset_all_sys_modes ();
@@ -10476,6 +10528,13 @@ handle_interrupt (bool in_signal_handler)
outside of polling since we don't get SIGIO like X and we don't have a
separate event loop thread like W32. */
#ifndef HAVE_NS
+#ifdef THREADS_ENABLED
+ /* If we were called from a signal handler, we must be in the main
+ thread, see deliver_process_signal. So we must make sure the
+ main thread holds the global lock. */
+ if (in_signal_handler)
+ maybe_reacquire_global_lock ();
+#endif
if (waiting_for_input && !echoing)
quit_throw_to_read_char (in_signal_handler);
#endif
@@ -11158,6 +11217,17 @@ syms_of_keyboard (void)
Fset (Qinput_method_exit_on_first_char, Qnil);
Fset (Qinput_method_use_echo_area, Qnil);
+ /* Symbols for dragging internal borders. */
+ DEFSYM (Qdrag_internal_border, "drag-internal-border");
+ DEFSYM (Qleft_edge, "left-edge");
+ DEFSYM (Qtop_left_corner, "top-left-corner");
+ DEFSYM (Qtop_edge, "top-edge");
+ DEFSYM (Qtop_right_corner, "top-right-corner");
+ DEFSYM (Qright_edge, "right-edge");
+ DEFSYM (Qbottom_right_corner, "bottom-right-corner");
+ DEFSYM (Qbottom_edge, "bottom-edge");
+ DEFSYM (Qbottom_left_corner, "bottom-left-corner");
+
/* Symbols to head events. */
DEFSYM (Qmouse_movement, "mouse-movement");
DEFSYM (Qscroll_bar_movement, "scroll-bar-movement");
@@ -11456,7 +11526,7 @@ for that character after that prefix key. */);
doc: /* Form to evaluate when Emacs starts up.
Useful to set before you dump a modified Emacs. */);
Vtop_level = Qnil;
- XSYMBOL (Qtop_level)->declared_special = false;
+ XSYMBOL (Qtop_level)->u.s.declared_special = false;
DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table,
doc: /* Translate table for local keyboard input, or nil.
diff --git a/src/keyboard.h b/src/keyboard.h
index 2219c011352..c232e778e21 100644
--- a/src/keyboard.h
+++ b/src/keyboard.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_KEYBOARD_H
#define EMACS_KEYBOARD_H
@@ -65,7 +65,7 @@ INLINE_HEADER_BEGIN
as soon as a complete key arrives from some KBOARD or other,
Emacs starts executing that key's binding. It switches to the
single-kboard state for the execution of that command,
- so that that command can get input only from its own KBOARD.
+ so that the command can get input only from its own KBOARD.
While in the single-kboard state, read_char can consider input only
from the current KBOARD. If events come from other KBOARDs, they
@@ -438,6 +438,7 @@ extern unsigned int timers_run;
extern bool menu_separator_name_p (const char *);
extern bool parse_menu_item (Lisp_Object, int);
+extern void init_raw_keybuf_count (void);
extern KBOARD *allocate_kboard (Lisp_Object);
extern void delete_kboard (KBOARD *);
extern void not_single_kboard_state (KBOARD *);
diff --git a/src/keymap.c b/src/keymap.c
index b568f47cba7..ccf8ce79175 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Old BUGS:
- [M-C-a] != [?\M-\C-a]
@@ -1292,7 +1292,7 @@ silly_event_symbol_error (Lisp_Object c)
base = XCAR (parsed);
name = Fsymbol_name (base);
/* This alist includes elements such as ("RET" . "\\r"). */
- assoc = Fassoc (name, exclude_keys);
+ assoc = Fassoc (name, exclude_keys, Qnil);
if (! NILP (assoc))
{
diff --git a/src/keymap.h b/src/keymap.h
index af0affbc849..2a1945a80a8 100644
--- a/src/keymap.h
+++ b/src/keymap.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef KEYMAP_H
#define KEYMAP_H
diff --git a/src/kqueue.c b/src/kqueue.c
index a8eb4cb797c..221b0032d82 100644
--- a/src/kqueue.c
+++ b/src/kqueue.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -130,7 +130,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object)
return;
}
new_directory_files =
- directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil);
+ directory_files_internal (dir, Qnil, Qnil, Qnil, true, Qnil);
new_dl = kqueue_directory_listing (new_directory_files);
/* Parse through the old list. */
@@ -453,7 +453,7 @@ 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, 1, Qnil);
+ dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, 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 f146602b3a0..13022792f25 100644
--- a/src/lastfile.c
+++ b/src/lastfile.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* How this works:
@@ -49,9 +49,6 @@ char my_edata[] = "End of Emacs initialized data";
isn't always a separate section in NT executables). */
char my_endbss[1];
-/* The Alpha MSVC linker globally segregates all static and public bss
- data, so we must take both into account to determine the true extent
- of the bss area used by Emacs. */
static char _my_endbss[1];
char * my_endbss_static = _my_endbss;
diff --git a/src/lcms.c b/src/lcms.c
new file mode 100644
index 00000000000..c7da57658a9
--- /dev/null
+++ b/src/lcms.c
@@ -0,0 +1,604 @@
+/* Interface to Little CMS
+ Copyright (C) 2017 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/>. */
+
+#include <config.h>
+
+#ifdef HAVE_LCMS2
+
+#include <lcms2.h>
+#include <math.h>
+
+#include "lisp.h"
+
+typedef struct
+{
+ double J;
+ double a;
+ double b;
+} lcmsJab_t;
+
+#ifdef WINDOWSNT
+# include <windows.h>
+# include "w32.h"
+
+DEF_DLL_FN (cmsFloat64Number, cmsCIE2000DeltaE,
+ (const cmsCIELab* Lab1, const cmsCIELab* Lab2, cmsFloat64Number Kl,
+ cmsFloat64Number Kc, cmsFloat64Number Kh));
+DEF_DLL_FN (cmsHANDLE, cmsCIECAM02Init,
+ (cmsContext ContextID, const cmsViewingConditions* pVC));
+DEF_DLL_FN (void, cmsCIECAM02Forward,
+ (cmsHANDLE hModel, const cmsCIEXYZ* pIn, cmsJCh* pOut));
+DEF_DLL_FN (void, cmsCIECAM02Reverse,
+ (cmsHANDLE hModel, const cmsJCh* pIn, cmsCIEXYZ* pOut));
+DEF_DLL_FN (void, cmsCIECAM02Done, (cmsHANDLE hModel));
+DEF_DLL_FN (cmsBool, cmsWhitePointFromTemp,
+ (cmsCIExyY* WhitePoint, cmsFloat64Number TempK));
+DEF_DLL_FN (void, cmsxyY2XYZ, (cmsCIEXYZ* Dest, const cmsCIExyY* Source));
+
+static bool lcms_initialized;
+
+static bool
+init_lcms_functions (void)
+{
+ HMODULE library = w32_delayed_load (Qlcms2);
+
+ if (!library)
+ return false;
+
+ LOAD_DLL_FN (library, cmsCIE2000DeltaE);
+ LOAD_DLL_FN (library, cmsCIECAM02Init);
+ LOAD_DLL_FN (library, cmsCIECAM02Forward);
+ LOAD_DLL_FN (library, cmsCIECAM02Reverse);
+ LOAD_DLL_FN (library, cmsCIECAM02Done);
+ LOAD_DLL_FN (library, cmsWhitePointFromTemp);
+ LOAD_DLL_FN (library, cmsxyY2XYZ);
+ return true;
+}
+
+# undef cmsCIE2000DeltaE
+# undef cmsCIECAM02Init
+# undef cmsCIECAM02Forward
+# undef cmsCIECAM02Reverse
+# undef cmsCIECAM02Done
+# undef cmsWhitePointFromTemp
+# undef cmsxyY2XYZ
+
+# define cmsCIE2000DeltaE fn_cmsCIE2000DeltaE
+# define cmsCIECAM02Init fn_cmsCIECAM02Init
+# define cmsCIECAM02Forward fn_cmsCIECAM02Forward
+# define cmsCIECAM02Reverse fn_cmsCIECAM02Reverse
+# define cmsCIECAM02Done fn_cmsCIECAM02Done
+# define cmsWhitePointFromTemp fn_cmsWhitePointFromTemp
+# define cmsxyY2XYZ fn_cmsxyY2XYZ
+
+#endif /* WINDOWSNT */
+
+static bool
+parse_lab_list (Lisp_Object lab_list, cmsCIELab *color)
+{
+#define PARSE_LAB_LIST_FIELD(field) \
+ if (CONSP (lab_list) && NUMBERP (XCAR (lab_list))) \
+ { \
+ color->field = XFLOATINT (XCAR (lab_list)); \
+ lab_list = XCDR (lab_list); \
+ } \
+ else \
+ return false;
+
+ PARSE_LAB_LIST_FIELD (L);
+ PARSE_LAB_LIST_FIELD (a);
+ PARSE_LAB_LIST_FIELD (b);
+
+ return true;
+}
+
+/* http://www.ece.rochester.edu/~gsharma/ciede2000/ciede2000noteCRNA.pdf> */
+
+DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 5, 0,
+ doc: /* Compute CIEDE2000 metric distance between COLOR1 and COLOR2.
+Each color is a list of L*a*b* coordinates, where the L* channel ranges from
+0 to 100, and the a* and b* channels range from -128 to 128.
+Optional arguments KL, KC, KH are weighting parameters for lightness,
+chroma, and hue, respectively. The parameters each default to 1. */)
+ (Lisp_Object color1, Lisp_Object color2,
+ Lisp_Object kL, Lisp_Object kC, Lisp_Object kH)
+{
+ cmsCIELab Lab1, Lab2;
+ cmsFloat64Number Kl, Kc, Kh;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color1) && parse_lab_list (color1, &Lab1)))
+ signal_error ("Invalid color", color1);
+ if (!(CONSP (color2) && parse_lab_list (color2, &Lab2)))
+ signal_error ("Invalid color", color1);
+ if (NILP (kL))
+ Kl = 1.0f;
+ else if (!(NUMBERP (kL) && (Kl = XFLOATINT(kL))))
+ wrong_type_argument(Qnumberp, kL);
+ if (NILP (kC))
+ Kc = 1.0f;
+ else if (!(NUMBERP (kC) && (Kc = XFLOATINT(kC))))
+ wrong_type_argument(Qnumberp, kC);
+ if (NILP (kL))
+ Kh = 1.0f;
+ else if (!(NUMBERP (kH) && (Kh = XFLOATINT(kH))))
+ wrong_type_argument(Qnumberp, kH);
+
+ return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh));
+}
+
+static double
+deg2rad (double degrees)
+{
+ return M_PI * degrees / 180.0;
+}
+
+static double
+rad2deg (double radians)
+{
+ return 180.0 * radians / M_PI;
+}
+
+static cmsCIEXYZ illuminant_d65 = { .X = 95.0455, .Y = 100.0, .Z = 108.8753 };
+
+static void
+default_viewing_conditions (const cmsCIEXYZ *wp, cmsViewingConditions *vc)
+{
+ vc->whitePoint.X = wp->X;
+ vc->whitePoint.Y = wp->Y;
+ vc->whitePoint.Z = wp->Z;
+ vc->Yb = 20;
+ vc->La = 100;
+ vc->surround = AVG_SURROUND;
+ vc->D_value = 1.0;
+}
+
+/* FIXME: code duplication */
+
+static bool
+parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
+{
+#define PARSE_XYZ_LIST_FIELD(field) \
+ if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list))) \
+ { \
+ color->field = 100.0 * XFLOATINT (XCAR (xyz_list)); \
+ xyz_list = XCDR (xyz_list); \
+ } \
+ else \
+ return false;
+
+ PARSE_XYZ_LIST_FIELD (X);
+ PARSE_XYZ_LIST_FIELD (Y);
+ PARSE_XYZ_LIST_FIELD (Z);
+
+ return true;
+}
+
+static bool
+parse_jch_list (Lisp_Object jch_list, cmsJCh *color)
+{
+#define PARSE_JCH_LIST_FIELD(field) \
+ if (CONSP (jch_list) && NUMBERP (XCAR (jch_list))) \
+ { \
+ color->field = XFLOATINT (XCAR (jch_list)); \
+ jch_list = XCDR (jch_list); \
+ } \
+ else \
+ return false;
+
+ PARSE_JCH_LIST_FIELD (J);
+ PARSE_JCH_LIST_FIELD (C);
+ PARSE_JCH_LIST_FIELD (h);
+
+ if (! NILP (jch_list))
+ return false;
+ return true;
+}
+
+static bool
+parse_jab_list (Lisp_Object jab_list, lcmsJab_t *color)
+{
+#define PARSE_JAB_LIST_FIELD(field) \
+ if (CONSP (jab_list) && NUMBERP (XCAR (jab_list))) \
+ { \
+ color->field = XFLOATINT (XCAR (jab_list)); \
+ jab_list = XCDR (jab_list); \
+ } \
+ else \
+ return false;
+
+ PARSE_JAB_LIST_FIELD (J);
+ PARSE_JAB_LIST_FIELD (a);
+ PARSE_JAB_LIST_FIELD (b);
+
+ return true;
+}
+
+static bool
+parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp,
+ cmsViewingConditions *vc)
+{
+#define PARSE_VIEW_CONDITION_FLOAT(field) \
+ if (CONSP (view) && NUMBERP (XCAR (view))) \
+ { \
+ vc->field = XFLOATINT (XCAR (view)); \
+ view = XCDR (view); \
+ } \
+ else \
+ return false;
+#define PARSE_VIEW_CONDITION_INT(field) \
+ if (CONSP (view) && NATNUMP (XCAR (view))) \
+ { \
+ CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \
+ vc->field = XINT (XCAR (view)); \
+ view = XCDR (view); \
+ } \
+ else \
+ return false;
+
+ PARSE_VIEW_CONDITION_FLOAT (Yb);
+ PARSE_VIEW_CONDITION_FLOAT (La);
+ PARSE_VIEW_CONDITION_INT (surround);
+ PARSE_VIEW_CONDITION_FLOAT (D_value);
+
+ if (! NILP (view))
+ return false;
+
+ vc->whitePoint.X = wp->X;
+ vc->whitePoint.Y = wp->Y;
+ vc->whitePoint.Z = wp->Z;
+ return true;
+}
+
+static void
+xyz_to_jch (const cmsCIEXYZ *xyz, cmsJCh *jch, const cmsViewingConditions *vc)
+{
+ cmsHANDLE h;
+
+ h = cmsCIECAM02Init (0, vc);
+ cmsCIECAM02Forward (h, xyz, jch);
+ cmsCIECAM02Done (h);
+}
+
+static void
+jch_to_xyz (const cmsJCh *jch, cmsCIEXYZ *xyz, const cmsViewingConditions *vc)
+{
+ cmsHANDLE h;
+
+ h = cmsCIECAM02Init (0, vc);
+ cmsCIECAM02Reverse (h, jch, xyz);
+ cmsCIECAM02Done (h);
+}
+
+static void
+jch_to_jab (const cmsJCh *jch, lcmsJab_t *jab, double FL, double c1, double c2)
+{
+ double Mp = 43.86 * log (1.0 + c2 * (jch->C * sqrt (sqrt (FL))));
+ jab->J = 1.7 * jch->J / (1.0 + (c1 * jch->J));
+ jab->a = Mp * cos (deg2rad (jch->h));
+ jab->b = Mp * sin (deg2rad (jch->h));
+}
+
+static void
+jab_to_jch (const lcmsJab_t *jab, cmsJCh *jch, double FL, double c1, double c2)
+{
+ jch->J = jab->J / (1.0 + c1 * (100.0 - jab->J));
+ jch->h = atan2 (jab->b, jab->a);
+ double Mp = hypot (jab->a, jab->b);
+ jch->h = rad2deg (jch->h);
+ if (jch->h < 0.0)
+ jch->h += 360.0;
+ jch->C = (exp (c2 * Mp) - 1.0) / (c2 * sqrt (sqrt (FL)));
+}
+
+DEFUN ("lcms-xyz->jch", Flcms_xyz_to_jch, Slcms_xyz_to_jch, 1, 3, 0,
+ doc: /* Convert CIE CAM02 JCh to CIE XYZ.
+COLOR is a list (X Y Z), with Y scaled about unity.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch;
+ cmsCIEXYZ xyz, xyzw;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_xyz_list (color, &xyz)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ xyz_to_jch(&xyz, &jch, &vc);
+ return list3 (make_float (jch.J), make_float (jch.C), make_float (jch.h));
+}
+
+DEFUN ("lcms-jch->xyz", Flcms_jch_to_xyz, Slcms_jch_to_xyz, 1, 3, 0,
+ doc: /* Convert CIE XYZ to CIE CAM02 JCh.
+COLOR is a list (J C h), where lightness of white is equal to 100, and hue
+is given in degrees.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch;
+ cmsCIEXYZ xyz, xyzw;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_jch_list (color, &jch)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ jch_to_xyz(&jch, &xyz, &vc);
+ return list3 (make_float (xyz.X / 100.0),
+ make_float (xyz.Y / 100.0),
+ make_float (xyz.Z / 100.0));
+}
+
+DEFUN ("lcms-jch->jab", Flcms_jch_to_jab, Slcms_jch_to_jab, 1, 3, 0,
+ doc: /* Convert CIE CAM02 JCh to CAM02-UCS J'a'b'.
+COLOR is a list (J C h) as described in `lcms-jch->xyz', which see.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ lcmsJab_t jab;
+ cmsJCh jch;
+ cmsCIEXYZ xyzw;
+ double FL, k, k4;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_jch_list (color, &jch)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ k = 1.0 / (1.0 + (5.0 * vc.La));
+ k4 = k * k * k * k;
+ FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La);
+ jch_to_jab (&jch, &jab, FL, 0.007, 0.0228);
+ return list3 (make_float (jab.J), make_float (jab.a), make_float (jab.b));
+}
+
+DEFUN ("lcms-jab->jch", Flcms_jab_to_jch, Slcms_jab_to_jch, 1, 3, 0,
+ doc: /* Convert CAM02-UCS J'a'b' to CIE CAM02 JCh.
+COLOR is a list (J' a' b'), where white corresponds to lightness J equal to 100.
+Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs',
+which see. */)
+ (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch;
+ lcmsJab_t jab;
+ cmsCIEXYZ xyzw;
+ double FL, k, k4;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color) && parse_jab_list (color, &jab)))
+ signal_error ("Invalid color", color);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid viewing conditions", view);
+
+ k = 1.0 / (1.0 + (5.0 * vc.La));
+ k4 = k * k * k * k;
+ FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La);
+ jab_to_jch (&jab, &jch, FL, 0.007, 0.0228);
+ return list3 (make_float (jch.J), make_float (jch.C), make_float (jch.h));
+}
+
+/* References:
+ Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research
+ and application, 37 No.3, 2012.
+ Luo et al. "Uniform colour spaces based on CIECAM02 colour appearance
+ model." COLOR research and application, 31 No.4, 2006. */
+
+DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 4, 0,
+ doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2.
+Each color is a list of XYZ tristimulus values, with Y scaled about unity.
+Optional argument WHITEPOINT is the XYZ white point, which defaults to
+illuminant D65.
+Optional argument VIEW is a list containing the viewing conditions, and
+is of the form (YB LA SURROUND DVALUE) where SURROUND corresponds to
+ 1 AVG_SURROUND
+ 2 DIM_SURROUND
+ 3 DARK_SURROUND
+ 4 CUTSHEET_SURROUND
+The default viewing conditions are (20 100 1 1). */)
+ (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint,
+ Lisp_Object view)
+{
+ cmsViewingConditions vc;
+ cmsJCh jch1, jch2;
+ cmsCIEXYZ xyz1, xyz2, xyzw;
+ lcmsJab_t jab1, jab2;
+ double FL, k, k4;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1)))
+ signal_error ("Invalid color", color1);
+ if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2)))
+ signal_error ("Invalid color", color2);
+ if (NILP (whitepoint))
+ xyzw = illuminant_d65;
+ else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
+ signal_error ("Invalid white point", whitepoint);
+ if (NILP (view))
+ default_viewing_conditions (&xyzw, &vc);
+ else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
+ signal_error ("Invalid view conditions", view);
+
+ xyz_to_jch (&xyz1, &jch1, &vc);
+ xyz_to_jch (&xyz2, &jch2, &vc);
+
+ k = 1.0 / (1.0 + (5.0 * vc.La));
+ k4 = k * k * k * k;
+ FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La);
+ jch_to_jab (&jch1, &jab1, FL, 0.007, 0.0228);
+ jch_to_jab (&jch2, &jab2, FL, 0.007, 0.0228);
+
+ return make_float (hypot (jab2.J - jab1.J,
+ hypot (jab2.a - jab1.a, jab2.b - jab1.b)));
+}
+
+DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0,
+ doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K.
+Valid range of TEMPERATURE is from 4000K to 25000K. */)
+ (Lisp_Object temperature)
+{
+ cmsFloat64Number tempK;
+ cmsCIExyY whitepoint;
+ cmsCIEXYZ wp;
+
+#ifdef WINDOWSNT
+ if (!lcms_initialized)
+ lcms_initialized = init_lcms_functions ();
+ if (!lcms_initialized)
+ {
+ message1 ("lcms2 library not found");
+ return Qnil;
+ }
+#endif
+
+ CHECK_NUMBER_OR_FLOAT (temperature);
+
+ tempK = XFLOATINT (temperature);
+ if (!(cmsWhitePointFromTemp (&whitepoint, tempK)))
+ signal_error("Invalid temperature", temperature);
+ cmsxyY2XYZ (&wp, &whitepoint);
+ return list3 (make_float (wp.X), make_float (wp.Y), make_float (wp.Z));
+}
+
+DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0,
+ doc: /* Return t if lcms2 color calculations are available in this instance of Emacs. */)
+ (void)
+{
+#ifdef WINDOWSNT
+ Lisp_Object found = Fassq (Qlcms2, Vlibrary_cache);
+ if (CONSP (found))
+ return XCDR (found);
+ else
+ {
+ Lisp_Object status;
+ lcms_initialized = init_lcms_functions ();
+ status = lcms_initialized ? Qt : Qnil;
+ Vlibrary_cache = Fcons (Fcons (Qlcms2, status), Vlibrary_cache);
+ return status;
+ }
+#else /* !WINDOWSNT */
+ return Qt;
+#endif
+}
+
+
+/* Initialization */
+void
+syms_of_lcms2 (void)
+{
+ defsubr (&Slcms_cie_de2000);
+ defsubr (&Slcms_xyz_to_jch);
+ defsubr (&Slcms_jch_to_xyz);
+ defsubr (&Slcms_jch_to_jab);
+ defsubr (&Slcms_jab_to_jch);
+ defsubr (&Slcms_cam02_ucs);
+ defsubr (&Slcms2_available_p);
+ defsubr (&Slcms_temp_to_white_point);
+
+ Fprovide (intern_c_string ("lcms2"), Qnil);
+}
+
+#endif /* HAVE_LCMS2 */
diff --git a/src/lisp.h b/src/lisp.h
index ff8dde2b825..68824d6b393 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_LISP_H
#define EMACS_LISP_H
@@ -94,9 +94,17 @@ typedef long long int EMACS_INT;
typedef unsigned long long int EMACS_UINT;
enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH };
# define EMACS_INT_MAX LLONG_MAX
-# ifdef __MINGW32__
+/* MinGW supports %lld only if __USE_MINGW_ANSI_STDIO is non-zero,
+ which is arranged by config.h, and (for mingw.org) if GCC is 6.0 or
+ later and the runtime version is 5.0.0 or later. Otherwise,
+ printf-like functions are declared with __ms_printf__ attribute,
+ which will cause a warning for %lld etc. */
+# if defined __MINGW32__ \
+ && (!defined __USE_MINGW_ANSI_STDIO \
+ || (!defined MINGW_W64 \
+ && !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5)))
# define pI "I64"
-# else
+# else /* ! MinGW */
# define pI "ll"
# endif
# else
@@ -220,13 +228,13 @@ extern bool suppress_checking EXTERNALLY_VISIBLE;
USE_LSB_TAG not only requires the least 3 bits of pointers returned by
malloc to be 0 but also needs to be able to impose a mult-of-8 alignment
- on the few static Lisp_Objects used: lispsym, all the defsubr, and
- the two special buffers buffer_defaults and buffer_local_symbols. */
+ on the few static Lisp_Objects used, all of which are aligned via
+ 'char alignas (GCALIGNMENT) gcaligned;' inside a union. */
enum Lisp_Bits
{
/* 2**GCTYPEBITS. This must be a macro that expands to a literal
- integer constant, for MSVC. */
+ integer constant, for older versions of GCC (through at least 4.9). */
#define GCALIGNMENT 8
/* Number of bits in a Lisp_Object value, not counting the tag. */
@@ -269,12 +277,6 @@ DEFINE_GDB_SYMBOL_END (VALMASK)
error !;
#endif
-#ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED
-# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT)))
-#else
-# define GCALIGNED /* empty */
-#endif
-
/* Some operations are so commonly executed that they are implemented
as macros, not functions, because otherwise runtime performance would
suffer too much when compiling with GCC without optimization.
@@ -322,15 +324,17 @@ error !;
#define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc)
#define lisp_h_NILP(x) EQ (x, Qnil)
#define lisp_h_SET_SYMBOL_VAL(sym, v) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE)
-#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write)
+ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \
+ (sym)->u.s.val.value = (v))
+#define lisp_h_SYMBOL_CONSTANT_P(sym) \
+ (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE)
+#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write)
#define lisp_h_SYMBOL_VAL(sym) \
- (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
+ (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value)
#define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
#define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike)
-#define lisp_h_XCAR(c) XCONS (c)->car
-#define lisp_h_XCDR(c) XCONS (c)->u.cdr
+#define lisp_h_XCAR(c) XCONS (c)->u.s.car
+#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr
#define lisp_h_XCONS(a) \
(eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons))
#define lisp_h_XHASH(a) XUINT (a)
@@ -412,9 +416,8 @@ error !;
#define case_Lisp_Int case Lisp_Int0: case Lisp_Int1
/* Idea stolen from GDB. Pedantic GCC complains about enum bitfields,
- MSVC doesn't support them, and xlc and Oracle Studio c99 complain
- vociferously about them. */
-#if (defined __STRICT_ANSI__ || defined _MSC_VER || defined __IBMC__ \
+ and xlc and Oracle Studio c99 complain vociferously about them. */
+#if (defined __STRICT_ANSI__ || defined __IBMC__ \
|| (defined __SUNPRO_C && __STDC__))
#define ENUM_BF(TYPE) unsigned int
#else
@@ -484,7 +487,7 @@ enum Lisp_Fwd_Type
/* If you want to define a new Lisp data type, here are some
instructions. See the thread at
- http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00561.html
+ https://lists.gnu.org/r/emacs-devel/2012-10/msg00561.html
for more info.
First, there are already a couple of Lisp types that can be used if
@@ -661,52 +664,60 @@ enum symbol_trapped_write
struct Lisp_Symbol
{
- bool_bf gcmarkbit : 1;
-
- /* Indicates where the value can be found:
- 0 : it's a plain var, the value is in the `value' field.
- 1 : it's a varalias, the value is really in the `alias' symbol.
- 2 : it's a localized var, the value is in the `blv' object.
- 3 : it's a forwarding variable, the value is in `forward'. */
- ENUM_BF (symbol_redirect) redirect : 3;
-
- /* 0 : normal case, just set the value
- 1 : constant, cannot set, e.g. nil, t, :keywords.
- 2 : trap the write, call watcher functions. */
- ENUM_BF (symbol_trapped_write) trapped_write : 2;
-
- /* Interned state of the symbol. This is an enumerator from
- enum symbol_interned. */
- unsigned interned : 2;
-
- /* True means that this variable has been explicitly declared
- special (with `defvar' etc), and shouldn't be lexically bound. */
- bool_bf declared_special : 1;
-
- /* True if pointed to from purespace and hence can't be GC'd. */
- bool_bf pinned : 1;
-
- /* The symbol's name, as a Lisp string. */
- Lisp_Object name;
-
- /* Value of the symbol or Qunbound if unbound. Which alternative of the
- union is used depends on the `redirect' field above. */
- union {
- Lisp_Object value;
- struct Lisp_Symbol *alias;
- struct Lisp_Buffer_Local_Value *blv;
- union Lisp_Fwd *fwd;
- } val;
-
- /* Function value of the symbol or Qnil if not fboundp. */
- Lisp_Object function;
+ union
+ {
+ struct
+ {
+ bool_bf gcmarkbit : 1;
+
+ /* Indicates where the value can be found:
+ 0 : it's a plain var, the value is in the `value' field.
+ 1 : it's a varalias, the value is really in the `alias' symbol.
+ 2 : it's a localized var, the value is in the `blv' object.
+ 3 : it's a forwarding variable, the value is in `forward'. */
+ ENUM_BF (symbol_redirect) redirect : 3;
+
+ /* 0 : normal case, just set the value
+ 1 : constant, cannot set, e.g. nil, t, :keywords.
+ 2 : trap the write, call watcher functions. */
+ ENUM_BF (symbol_trapped_write) trapped_write : 2;
+
+ /* Interned state of the symbol. This is an enumerator from
+ enum symbol_interned. */
+ unsigned interned : 2;
+
+ /* True means that this variable has been explicitly declared
+ special (with `defvar' etc), and shouldn't be lexically bound. */
+ bool_bf declared_special : 1;
+
+ /* True if pointed to from purespace and hence can't be GC'd. */
+ bool_bf pinned : 1;
+
+ /* The symbol's name, as a Lisp string. */
+ Lisp_Object name;
+
+ /* Value of the symbol or Qunbound if unbound. Which alternative of the
+ union is used depends on the `redirect' field above. */
+ union {
+ Lisp_Object value;
+ struct Lisp_Symbol *alias;
+ struct Lisp_Buffer_Local_Value *blv;
+ union Lisp_Fwd *fwd;
+ } val;
+
+ /* Function value of the symbol or Qnil if not fboundp. */
+ Lisp_Object function;
- /* The symbol's property list. */
- Lisp_Object plist;
+ /* The symbol's property list. */
+ Lisp_Object plist;
- /* Next symbol in obarray bucket, if the symbol is interned. */
- struct Lisp_Symbol *next;
+ /* Next symbol in obarray bucket, if the symbol is interned. */
+ struct Lisp_Symbol *next;
+ } s;
+ char alignas (GCALIGNMENT) gcaligned;
+ } u;
};
+verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0);
/* Declare a Lisp-callable function. The MAXARGS parameter has the same
meaning as in the DEFUN macro, and is used to construct a prototype. */
@@ -780,13 +791,13 @@ struct Lisp_Symbol
/* Header of vector-like objects. This documents the layout constraints on
vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents
compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR
- and PSEUDOVECTORP cast their pointers to struct vectorlike_header *,
+ and PSEUDOVECTORP cast their pointers to union vectorlike_header *,
because when two such pointers potentially alias, a compiler won't
incorrectly reorder loads and stores to their size fields. See
Bug#8546. */
-struct vectorlike_header
+union vectorlike_header
{
- /* The only field contains various pieces of information:
+ /* The main member contains various pieces of information:
- The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
- The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
vector (0) or a pseudovector (1).
@@ -806,7 +817,9 @@ struct vectorlike_header
Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */
ptrdiff_t size;
+ char alignas (GCALIGNMENT) gcaligned;
};
+verify (alignof (union vectorlike_header) % GCALIGNMENT == 0);
INLINE bool
(SYMBOLP) (Lisp_Object x)
@@ -838,13 +851,13 @@ make_lisp_symbol (struct Lisp_Symbol *sym)
INLINE Lisp_Object
builtin_lisp_symbol (int index)
{
- return make_lisp_symbol (lispsym + index);
+ return make_lisp_symbol (&lispsym[index]);
}
INLINE void
(CHECK_SYMBOL) (Lisp_Object x)
{
- lisp_h_CHECK_SYMBOL (x);
+ lisp_h_CHECK_SYMBOL (x);
}
/* In the size word of a vector, this bit means the vector has been marked. */
@@ -1078,10 +1091,10 @@ INLINE bool
| ((restsize) << PSEUDOVECTOR_SIZE_BITS) \
| (lispsize)))
-/* The cast to struct vectorlike_header * avoids aliasing issues. */
+/* The cast to union vectorlike_header * avoids aliasing issues. */
#define XSETPSEUDOVECTOR(a, b, code) \
XSETTYPED_PSEUDOVECTOR (a, b, \
- (((struct vectorlike_header *) \
+ (((union vectorlike_header *) \
XUNTAG (a, Lisp_Vectorlike)) \
->size), \
code)
@@ -1128,20 +1141,28 @@ make_pointer_integer (void *p)
typedef struct interval *INTERVAL;
-struct GCALIGNED Lisp_Cons
+struct Lisp_Cons
+{
+ union
{
- /* Car of this cons cell. */
- Lisp_Object car;
-
- union
+ struct
{
- /* Cdr of this cons cell. */
- Lisp_Object cdr;
-
- /* Used to chain conses on a free list. */
- struct Lisp_Cons *chain;
- } u;
- };
+ /* Car of this cons cell. */
+ Lisp_Object car;
+
+ union
+ {
+ /* Cdr of this cons cell. */
+ Lisp_Object cdr;
+
+ /* Used to chain conses on a free list. */
+ struct Lisp_Cons *chain;
+ } u;
+ } s;
+ char alignas (GCALIGNMENT) gcaligned;
+ } u;
+};
+verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0);
INLINE bool
(NILP) (Lisp_Object x)
@@ -1177,12 +1198,12 @@ INLINE struct Lisp_Cons *
INLINE Lisp_Object *
xcar_addr (Lisp_Object c)
{
- return &XCONS (c)->car;
+ return &XCONS (c)->u.s.car;
}
INLINE Lisp_Object *
xcdr_addr (Lisp_Object c)
{
- return &XCONS (c)->u.cdr;
+ return &XCONS (c)->u.s.u.cdr;
}
/* Use these from normal code. */
@@ -1246,15 +1267,24 @@ CDR_SAFE (Lisp_Object c)
return CONSP (c) ? XCDR (c) : Qnil;
}
-/* In a string or vector, the sign bit of the `size' is the gc mark bit. */
+/* In a string or vector, the sign bit of u.s.size is the gc mark bit. */
-struct GCALIGNED Lisp_String
+struct Lisp_String
+{
+ union
{
- ptrdiff_t size;
- ptrdiff_t size_byte;
- INTERVAL intervals; /* Text properties in this string. */
- unsigned char *data;
- };
+ struct
+ {
+ ptrdiff_t size;
+ ptrdiff_t size_byte;
+ INTERVAL intervals; /* Text properties in this string. */
+ unsigned char *data;
+ } s;
+ struct Lisp_String *next;
+ char alignas (GCALIGNMENT) gcaligned;
+ } u;
+};
+verify (alignof (struct Lisp_String) % GCALIGNMENT == 0);
INLINE bool
STRINGP (Lisp_Object x)
@@ -1279,7 +1309,7 @@ XSTRING (Lisp_Object a)
INLINE bool
STRING_MULTIBYTE (Lisp_Object str)
{
- return 0 <= XSTRING (str)->size_byte;
+ return 0 <= XSTRING (str)->u.s.size_byte;
}
/* An upper bound on the number of bytes in a Lisp string, not
@@ -1301,20 +1331,20 @@ STRING_MULTIBYTE (Lisp_Object str)
/* Mark STR as a unibyte string. */
#define STRING_SET_UNIBYTE(STR) \
do { \
- if (XSTRING (STR)->size == 0) \
+ if (XSTRING (STR)->u.s.size == 0) \
(STR) = empty_unibyte_string; \
else \
- XSTRING (STR)->size_byte = -1; \
+ XSTRING (STR)->u.s.size_byte = -1; \
} while (false)
/* Mark STR as a multibyte string. Assure that STR contains only
ASCII characters in advance. */
#define STRING_SET_MULTIBYTE(STR) \
do { \
- if (XSTRING (STR)->size == 0) \
+ if (XSTRING (STR)->u.s.size == 0) \
(STR) = empty_multibyte_string; \
else \
- XSTRING (STR)->size_byte = XSTRING (STR)->size; \
+ XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \
} while (false)
/* Convenience functions for dealing with Lisp strings. */
@@ -1322,7 +1352,7 @@ STRING_MULTIBYTE (Lisp_Object str)
INLINE unsigned char *
SDATA (Lisp_Object string)
{
- return XSTRING (string)->data;
+ return XSTRING (string)->u.s.data;
}
INLINE char *
SSDATA (Lisp_Object string)
@@ -1343,7 +1373,7 @@ SSET (Lisp_Object string, ptrdiff_t index, unsigned char new)
INLINE ptrdiff_t
SCHARS (Lisp_Object string)
{
- ptrdiff_t nchars = XSTRING (string)->size;
+ ptrdiff_t nchars = XSTRING (string)->u.s.size;
eassume (0 <= nchars);
return nchars;
}
@@ -1357,7 +1387,7 @@ STRING_BYTES (struct Lisp_String *s)
#ifdef GC_CHECK_STRING_BYTES
ptrdiff_t nbytes = string_bytes (s);
#else
- ptrdiff_t nbytes = s->size_byte < 0 ? s->size : s->size_byte;
+ ptrdiff_t nbytes = s->u.s.size_byte < 0 ? s->u.s.size : s->u.s.size_byte;
#endif
eassume (0 <= nbytes);
return nbytes;
@@ -1376,14 +1406,14 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
eassert (STRING_MULTIBYTE (string)
? 0 <= newsize && newsize <= SBYTES (string)
: newsize == SCHARS (string));
- XSTRING (string)->size = newsize;
+ XSTRING (string)->u.s.size = newsize;
}
/* A regular vector is just a header plus an array of Lisp_Objects. */
struct Lisp_Vector
{
- struct vectorlike_header header;
+ union vectorlike_header header;
Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER];
};
@@ -1440,7 +1470,7 @@ PSEUDOVECTOR_TYPE (struct Lisp_Vector *v)
/* Can't be used with PVEC_NORMAL_VECTOR. */
INLINE bool
-PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, enum pvec_type code)
+PSEUDOVECTOR_TYPEP (union vectorlike_header *a, enum pvec_type code)
{
/* We don't use PSEUDOVECTOR_TYPE here so as to avoid a shift
* operation when `code' is known. */
@@ -1456,8 +1486,8 @@ PSEUDOVECTORP (Lisp_Object a, int code)
return false;
else
{
- /* Converting to struct vectorlike_header * avoids aliasing issues. */
- struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike);
+ /* Converting to union vectorlike_header * avoids aliasing issues. */
+ union vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike);
return PSEUDOVECTOR_TYPEP (h, code);
}
}
@@ -1468,7 +1498,7 @@ struct Lisp_Bool_Vector
{
/* HEADER.SIZE is the vector's size field. It doesn't have the real size,
just the subtype information. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* This is the size in bits. */
EMACS_INT size;
/* The actual bits, packed into bytes.
@@ -1681,7 +1711,7 @@ struct Lisp_Char_Table
pseudovector type information. It holds the size, too.
The size counts the defalt, parent, purpose, ascii,
contents, and extras slots. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* This holds a default value,
which is used whenever the value for a specific character is nil. */
@@ -1723,7 +1753,7 @@ struct Lisp_Sub_Char_Table
{
/* HEADER.SIZE is the vector's size field, which also holds the
pseudovector type information. It holds the size, too. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* Depth of this sub char-table. It should be 1, 2, or 3. A sub
char-table of depth 1 contains 16 elements, and each element
@@ -1798,7 +1828,7 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
struct Lisp_Subr
{
- struct vectorlike_header header;
+ union vectorlike_header header;
union {
Lisp_Object (*a0) (void);
Lisp_Object (*a1) (Lisp_Object);
@@ -1857,6 +1887,26 @@ verify (offsetof (struct Lisp_Sub_Char_Table, contents)
== (offsetof (struct Lisp_Vector, contents)
+ SUB_CHAR_TABLE_OFFSET * sizeof (Lisp_Object)));
+
+/* Save and restore the instruction and environment pointers,
+ without affecting the signal mask. */
+
+#ifdef HAVE__SETJMP
+typedef jmp_buf sys_jmp_buf;
+# define sys_setjmp(j) _setjmp (j)
+# define sys_longjmp(j, v) _longjmp (j, v)
+#elif defined HAVE_SIGSETJMP
+typedef sigjmp_buf sys_jmp_buf;
+# define sys_setjmp(j) sigsetjmp (j, 0)
+# define sys_longjmp(j, v) siglongjmp (j, v)
+#else
+/* A platform that uses neither _longjmp nor siglongjmp; assume
+ longjmp does not affect the sigmask. */
+typedef jmp_buf sys_jmp_buf;
+# define sys_setjmp(j) setjmp (j)
+# define sys_longjmp(j, v) longjmp (j, v)
+#endif
+
#include "thread.h"
/***********************************************************************
@@ -1874,20 +1924,20 @@ INLINE Lisp_Object
INLINE struct Lisp_Symbol *
SYMBOL_ALIAS (struct Lisp_Symbol *sym)
{
- eassume (sym->redirect == SYMBOL_VARALIAS && sym->val.alias);
- return sym->val.alias;
+ eassume (sym->u.s.redirect == SYMBOL_VARALIAS && sym->u.s.val.alias);
+ return sym->u.s.val.alias;
}
INLINE struct Lisp_Buffer_Local_Value *
SYMBOL_BLV (struct Lisp_Symbol *sym)
{
- eassume (sym->redirect == SYMBOL_LOCALIZED && sym->val.blv);
- return sym->val.blv;
+ eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && sym->u.s.val.blv);
+ return sym->u.s.val.blv;
}
INLINE union Lisp_Fwd *
SYMBOL_FWD (struct Lisp_Symbol *sym)
{
- eassume (sym->redirect == SYMBOL_FORWARDED && sym->val.fwd);
- return sym->val.fwd;
+ eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd);
+ return sym->u.s.val.fwd;
}
INLINE void
@@ -1899,26 +1949,26 @@ INLINE void
INLINE void
SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
{
- eassume (sym->redirect == SYMBOL_VARALIAS && v);
- sym->val.alias = v;
+ eassume (sym->u.s.redirect == SYMBOL_VARALIAS && v);
+ sym->u.s.val.alias = v;
}
INLINE void
SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
{
- eassume (sym->redirect == SYMBOL_LOCALIZED && v);
- sym->val.blv = v;
+ eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && v);
+ sym->u.s.val.blv = v;
}
INLINE void
SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
{
- eassume (sym->redirect == SYMBOL_FORWARDED && v);
- sym->val.fwd = v;
+ eassume (sym->u.s.redirect == SYMBOL_FORWARDED && v);
+ sym->u.s.val.fwd = v;
}
INLINE Lisp_Object
SYMBOL_NAME (Lisp_Object sym)
{
- return XSYMBOL (sym)->name;
+ return XSYMBOL (sym)->u.s.name;
}
/* Value is true if SYM is an interned symbol. */
@@ -1926,7 +1976,7 @@ SYMBOL_NAME (Lisp_Object sym)
INLINE bool
SYMBOL_INTERNED_P (Lisp_Object sym)
{
- return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED;
+ return XSYMBOL (sym)->u.s.interned != SYMBOL_UNINTERNED;
}
/* Value is true if SYM is interned in initial_obarray. */
@@ -1934,7 +1984,7 @@ SYMBOL_INTERNED_P (Lisp_Object sym)
INLINE bool
SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
{
- return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
+ return XSYMBOL (sym)->u.s.interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
}
/* Value is non-zero if symbol cannot be changed through a simple set,
@@ -1990,7 +2040,7 @@ struct hash_table_test
struct Lisp_Hash_Table
{
/* This is for Lisp; the hash table code does not refer to it. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* Nil if table is non-weak. Otherwise a symbol describing the
weakness of the table. */
@@ -2909,23 +2959,12 @@ CHECK_NUMBER_CDR (Lisp_Object x)
/* This version of DEFUN declares a function prototype with the right
arguments, so we can catch errors with maxargs at compile-time. */
-#ifdef _MSC_VER
#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
- Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
- static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
- { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \
- | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \
- { (Lisp_Object (__cdecl *)(void))fnname }, \
- minargs, maxargs, lname, intspec, 0}; \
- Lisp_Object fnname
-#else /* not _MSC_VER */
-#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \
- static struct Lisp_Subr alignas (GCALIGNMENT) sname = \
+ static struct Lisp_Subr sname = \
{ { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
{ .a ## maxargs = fnname }, \
minargs, maxargs, lname, intspec, 0}; \
Lisp_Object fnname
-#endif
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
@@ -2995,25 +3034,6 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int);
static struct Lisp_Kboard_Objfwd ko_fwd; \
defvar_kboard (&ko_fwd, lname, offsetof (KBOARD, vname ## _)); \
} while (false)
-
-/* Save and restore the instruction and environment pointers,
- without affecting the signal mask. */
-
-#ifdef HAVE__SETJMP
-typedef jmp_buf sys_jmp_buf;
-# define sys_setjmp(j) _setjmp (j)
-# define sys_longjmp(j, v) _longjmp (j, v)
-#elif defined HAVE_SIGSETJMP
-typedef sigjmp_buf sys_jmp_buf;
-# define sys_setjmp(j) sigsetjmp (j, 0)
-# define sys_longjmp(j, v) siglongjmp (j, v)
-#else
-/* A platform that uses neither _longjmp nor siglongjmp; assume
- longjmp does not affect the sigmask. */
-typedef jmp_buf sys_jmp_buf;
-# define sys_setjmp(j) setjmp (j)
-# define sys_longjmp(j, v) longjmp (j, v)
-#endif
/* Elisp uses several stacks:
@@ -3207,25 +3227,25 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
INLINE void
set_symbol_function (Lisp_Object sym, Lisp_Object function)
{
- XSYMBOL (sym)->function = function;
+ XSYMBOL (sym)->u.s.function = function;
}
INLINE void
set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
{
- XSYMBOL (sym)->plist = plist;
+ XSYMBOL (sym)->u.s.plist = plist;
}
INLINE void
set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
{
- XSYMBOL (sym)->next = next;
+ XSYMBOL (sym)->u.s.next = next;
}
INLINE void
make_symbol_constant (Lisp_Object sym)
{
- XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE;
+ XSYMBOL (sym)->u.s.trapped_write = SYMBOL_NOWRITE;
}
/* Buffer-local variable access functions. */
@@ -3250,7 +3270,7 @@ set_overlay_plist (Lisp_Object overlay, Lisp_Object plist)
INLINE INTERVAL
string_intervals (Lisp_Object s)
{
- return XSTRING (s)->intervals;
+ return XSTRING (s)->u.s.intervals;
}
/* Set text properties of S to I. */
@@ -3258,7 +3278,7 @@ string_intervals (Lisp_Object s)
INLINE void
set_string_intervals (Lisp_Object s, INTERVAL i)
{
- XSTRING (s)->intervals = i;
+ XSTRING (s)->u.s.intervals = i;
}
/* Set a Lisp slot in TABLE to VAL. Most code should use this instead
@@ -3386,6 +3406,7 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 };
extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST;
extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t);
extern void sweep_weak_hash_tables (void);
+extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
@@ -3845,6 +3866,7 @@ extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Li
extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
+extern Lisp_Object call8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object);
extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object);
extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object));
@@ -3874,7 +3896,6 @@ extern Lisp_Object vformat_string (const char *, va_list)
ATTRIBUTE_FORMAT_PRINTF (1, 0);
extern void un_autoload (Lisp_Object);
extern Lisp_Object call_debugger (Lisp_Object arg);
-extern void *near_C_stack_top (void);
extern void init_eval_once (void);
extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
@@ -3911,7 +3932,7 @@ typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t,
struct Lisp_Module_Function
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* Fields traced by GC; these must come first. */
Lisp_Object documentation;
@@ -3965,6 +3986,7 @@ extern void syms_of_editfns (void);
/* Defined in buffer.c. */
extern bool mouse_face_overlay_overlaps (Lisp_Object);
+extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
extern _Noreturn void nsberror (Lisp_Object);
extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
@@ -3996,7 +4018,7 @@ extern void syms_of_marker (void);
/* Defined in fileio.c. */
-extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object);
+extern Lisp_Object expand_and_dir_to_file (Lisp_Object);
extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object, Lisp_Object,
Lisp_Object, int);
@@ -4012,7 +4034,6 @@ extern bool file_directory_p (const char *);
extern bool file_accessible_directory_p (Lisp_Object);
extern void init_fileio (void);
extern void syms_of_fileio (void);
-extern Lisp_Object make_temp_name (Lisp_Object, bool);
/* Defined in search.c. */
extern void shrink_regexp_cache (void);
@@ -4297,13 +4318,15 @@ extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t);
extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t);
extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t);
extern void emacs_perror (char const *);
+extern int renameat_noreplace (int, char const *, int, char const *);
+extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-extern void unlock_all_files (void);
+/* Defined in filelock.c. */
extern void lock_file (Lisp_Object);
extern void unlock_file (Lisp_Object);
+extern void unlock_all_files (void);
extern void unlock_buffer (struct buffer *);
extern void syms_of_filelock (void);
-extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
/* Defined in sound.c. */
extern void syms_of_sound (void);
@@ -4387,12 +4410,17 @@ extern void syms_of_xterm (void);
extern char *x_get_keysym_name (int);
#endif /* HAVE_WINDOW_SYSTEM */
-#ifdef HAVE_LIBXML2
/* Defined in xml.c. */
extern void syms_of_xml (void);
+#ifdef HAVE_LIBXML2
extern void xml_cleanup_parser (void);
#endif
+#ifdef HAVE_LCMS2
+/* Defined in lcms.c. */
+extern void syms_of_lcms2 (void);
+#endif
+
#ifdef HAVE_ZLIB
/* Defined in decompress.c. */
extern void syms_of_decompress (void);
@@ -4575,20 +4603,6 @@ enum { defined_GC_CHECK_STRING_BYTES = true };
enum { defined_GC_CHECK_STRING_BYTES = false };
#endif
-/* Struct inside unions that are typically no larger and aligned enough. */
-
-union Aligned_Cons
-{
- struct Lisp_Cons s;
- double d; intmax_t i; void *p;
-};
-
-union Aligned_String
-{
- struct Lisp_String s;
- double d; intmax_t i; void *p;
-};
-
/* True for stack-based cons and string implementations, respectively.
Use stack-based strings only if stack-based cons also works.
Otherwise, STACK_CONS would create heap-based cons cells that
@@ -4596,18 +4610,16 @@ union Aligned_String
enum
{
- USE_STACK_CONS = (USE_STACK_LISP_OBJECTS
- && alignof (union Aligned_Cons) % GCALIGNMENT == 0),
+ USE_STACK_CONS = USE_STACK_LISP_OBJECTS,
USE_STACK_STRING = (USE_STACK_CONS
- && !defined_GC_CHECK_STRING_BYTES
- && alignof (union Aligned_String) % GCALIGNMENT == 0)
+ && !defined_GC_CHECK_STRING_BYTES)
};
/* Auxiliary macros used for auto allocation of Lisp objects. Please
use these only in macros like AUTO_CONS that declare a local
variable whose lifetime will be clear to the programmer. */
#define STACK_CONS(a, b) \
- make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons)
+ make_lisp_ptr (&((struct Lisp_Cons) {{{a, {b}}}}), Lisp_Cons)
#define AUTO_CONS_EXPR(a, b) \
(USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b))
@@ -4653,7 +4665,7 @@ enum
Lisp_Object name = \
(USE_STACK_STRING \
? (make_lisp_ptr \
- ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \
+ ((&(struct Lisp_String) {{{len, -1, 0, (unsigned char *) (str)}}}), \
Lisp_String)) \
: make_unibyte_string (str, len))
diff --git a/src/lread.c b/src/lread.c
index f8493982c67..a8080876031 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Tell globals.h to define tables needed by init_obarray. */
#define DEFINE_SYMBOLS
@@ -72,14 +72,51 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define file_tell ftell
#endif
-/* The association list of objects read with the #n=object form.
- Each member of the list has the form (n . object), and is used to
- look up the object for the corresponding #n# construct.
- It must be set to nil before all top-level calls to read0. */
-static Lisp_Object read_objects;
+/* The objects or placeholders read with the #n=object form.
-/* File for get_file_char to read from. Use by load. */
-static FILE *instream;
+ A hash table maps a number to either a placeholder (while the
+ object is still being parsed, in case it's referenced within its
+ own definition) or to the completed object. With small integers
+ for keys, it's effectively little more than a vector, but it'll
+ manage any needed resizing for us.
+
+ The variable must be reset to an empty hash table before all
+ top-level calls to read0. In between calls, it may be an empty
+ hash table left unused from the previous call (to reduce
+ allocations), or nil. */
+static Lisp_Object read_objects_map;
+
+/* The recursive objects read with the #n=object form.
+
+ Objects that might have circular references are stored here, so
+ that recursive substitution knows not to keep processing them
+ multiple times.
+
+ Only objects that are completely processed, including substituting
+ references to themselves (but not necessarily replacing
+ placeholders for other objects still being read), are stored.
+
+ A hash table is used for efficient lookups of keys. We don't care
+ what the value slots hold. The variable must be set to an empty
+ hash table before all top-level calls to read0. In between calls,
+ it may be an empty hash table left unused from the previous call
+ (to reduce allocations), or nil. */
+static Lisp_Object read_objects_completed;
+
+/* File and lookahead for get-file-char and get-emacs-mule-file-char
+ to read from. Used by Fload. */
+static struct infile
+{
+ /* The input stream. */
+ FILE *stream;
+
+ /* Lookahead byte count. */
+ signed char lookahead;
+
+ /* Lookahead bytes, in reverse order. Keep these here because it is
+ not portable to ungetc more than one byte at a time. */
+ unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
+} *infile;
/* For use within read-from-string (this reader is non-reentrant!!) */
static ptrdiff_t read_from_string_index;
@@ -124,7 +161,7 @@ static Lisp_Object Vloads_in_progress;
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
Lisp_Object);
-static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
+static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
@@ -315,14 +352,13 @@ readchar (Lisp_Object readcharfun, bool *multibyte)
len = BYTES_BY_CHAR_HEAD (c);
while (i < len)
{
- c = (*readbyte) (-1, readcharfun);
+ buf[i++] = c = (*readbyte) (-1, readcharfun);
if (c < 0 || ! TRAILING_CODE_P (c))
{
- while (--i > 1)
+ for (i -= c < 0; 0 < --i; )
(*readbyte) (buf[i], readcharfun);
return BYTE8_TO_CHAR (buf[0]);
}
- buf[i++] = c;
}
return STRING_CHAR (buf);
}
@@ -337,8 +373,9 @@ skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
if (FROM_FILE_P (readcharfun))
{
block_input (); /* FIXME: Not sure if it's needed. */
- fseek (instream, n, SEEK_CUR);
+ fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
unblock_input ();
+ infile->lookahead = 0;
}
else
{ /* We're not reading directly from a file. In that case, it's difficult
@@ -360,8 +397,9 @@ skip_dyn_eof (Lisp_Object readcharfun)
if (FROM_FILE_P (readcharfun))
{
block_input (); /* FIXME: Not sure if it's needed. */
- fseek (instream, 0, SEEK_END);
+ fseek (infile->stream, 0, SEEK_END);
unblock_input ();
+ infile->lookahead = 0;
}
else
while (READCHAR >= 0);
@@ -434,27 +472,24 @@ readbyte_for_lambda (int c, Lisp_Object readcharfun)
static int
-readbyte_from_file (int c, Lisp_Object readcharfun)
+readbyte_from_stdio (void)
{
- if (c >= 0)
- {
- block_input ();
- ungetc (c, instream);
- unblock_input ();
- return 0;
- }
+ if (infile->lookahead)
+ return infile->buf[--infile->lookahead];
+
+ int c;
+ FILE *instream = infile->stream;
block_input ();
- c = getc (instream);
/* Interrupted reads have been observed while reading over the network. */
- while (c == EOF && ferror (instream) && errno == EINTR)
+ while ((c = getc_unlocked (instream)) == EOF && errno == EINTR
+ && ferror_unlocked (instream))
{
unblock_input ();
maybe_quit ();
block_input ();
- clearerr (instream);
- c = getc (instream);
+ clearerr_unlocked (instream);
}
unblock_input ();
@@ -463,6 +498,19 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
}
static int
+readbyte_from_file (int c, Lisp_Object readcharfun)
+{
+ if (c >= 0)
+ {
+ eassert (infile->lookahead < sizeof infile->buf);
+ infile->buf[infile->lookahead++] = c;
+ return 0;
+ }
+
+ return readbyte_from_stdio ();
+}
+
+static int
readbyte_from_string (int c, Lisp_Object readcharfun)
{
Lisp_Object string = XCAR (readcharfun);
@@ -484,7 +532,7 @@ readbyte_from_string (int c, Lisp_Object readcharfun)
}
-/* Read one non-ASCII character from INSTREAM. The character is
+/* Read one non-ASCII character from INFILE. The character is
encoded in `emacs-mule' and the first byte is already read in
C. */
@@ -506,14 +554,13 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
buf[i++] = c;
while (i < len)
{
- c = (*readbyte) (-1, readcharfun);
+ buf[i++] = c = (*readbyte) (-1, readcharfun);
if (c < 0xA0)
{
- while (--i > 1)
+ for (i -= c < 0; 0 < --i; )
(*readbyte) (buf[i], readcharfun);
return BYTE8_TO_CHAR (buf[0]);
}
- buf[i++] = c;
}
if (len == 2)
@@ -548,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
}
+/* An in-progress substitution of OBJECT for PLACEHOLDER. */
+struct subst
+{
+ Lisp_Object object;
+ Lisp_Object placeholder;
+
+ /* Hash table of subobjects of OBJECT that might be circular. If
+ Qt, all such objects might be circular. */
+ Lisp_Object completed;
+
+ /* List of subobjects of OBJECT that have already been visited. */
+ Lisp_Object seen;
+};
+
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
@@ -556,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool);
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
-static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
- Lisp_Object);
-static void substitute_in_interval (INTERVAL, Lisp_Object);
+static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
+static void substitute_in_interval (INTERVAL, void *);
/* Get a character from the tty. */
@@ -755,11 +815,9 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
doc: /* Don't use this yourself. */)
(void)
{
- register Lisp_Object val;
- block_input ();
- XSETINT (val, getc (instream));
- unblock_input ();
- return val;
+ if (!infile)
+ error ("get-file-char misused");
+ return make_number (readbyte_from_stdio ());
}
@@ -1004,6 +1062,15 @@ suffix_p (Lisp_Object string, const char *suffix)
return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
}
+static void
+close_infile_unwind (void *arg)
+{
+ FILE *stream = arg;
+ eassert (infile == NULL || infile->stream == stream);
+ infile = NULL;
+ fclose (stream);
+}
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
First try FILE with `.elc' appended, then try with `.el', then try
@@ -1323,7 +1390,7 @@ Return t if the file exists and loads successfully. */)
}
if (! stream)
report_file_error ("Opening stdio stream", file);
- set_unwind_protect_ptr (fd_index, fclose_unwind, stream);
+ set_unwind_protect_ptr (fd_index, close_infile_unwind, stream);
if (! NILP (Vpurify_flag))
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
@@ -1346,19 +1413,23 @@ Return t if the file exists and loads successfully. */)
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
- instream = stream;
+ struct infile input;
+ input.stream = stream;
+ input.lookahead = 0;
+ infile = &input;
+
if (lisp_file_lexically_bound_p (Qget_file_char))
Fset (Qlexical_binding, Qt);
if (! version || version >= 22)
- readevalloop (Qget_file_char, stream, hist_file_name,
+ readevalloop (Qget_file_char, &input, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
else
{
/* We can't handle a file which was compiled with
byte-compile-dynamic by older version of Emacs. */
specbind (Qload_force_doc_strings, Qt);
- readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name,
+ readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
0, Qnil, Qnil, Qnil, Qnil);
}
unbind_to (count, Qnil);
@@ -1789,7 +1860,7 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
static void
readevalloop (Lisp_Object readcharfun,
- FILE *stream,
+ struct infile *infile0,
Lisp_Object sourcename,
bool printflag,
Lisp_Object unibyte, Lisp_Object readfun,
@@ -1889,7 +1960,7 @@ readevalloop (Lisp_Object readcharfun,
if (b && first_sexp)
whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
- instream = stream;
+ infile = infile0;
read_next:
c = READCHAR;
if (c == ';')
@@ -1908,6 +1979,18 @@ readevalloop (Lisp_Object readcharfun,
|| c == NO_BREAK_SPACE)
goto read_next;
+ if (! HASH_TABLE_P (read_objects_map)
+ || XHASH_TABLE (read_objects_map)->count)
+ read_objects_map
+ = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
+ DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
+ Qnil, false);
+ if (! HASH_TABLE_P (read_objects_completed)
+ || XHASH_TABLE (read_objects_completed)->count)
+ read_objects_completed
+ = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
+ DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
+ Qnil, false);
if (!NILP (Vpurify_flag) && c == '(')
{
val = read_list (0, readcharfun);
@@ -1915,7 +1998,6 @@ readevalloop (Lisp_Object readcharfun,
else
{
UNREAD (c);
- read_objects = Qnil;
if (!NILP (readfun))
{
val = call1 (readfun, readcharfun);
@@ -1935,6 +2017,13 @@ readevalloop (Lisp_Object readcharfun,
else
val = read_internal_start (readcharfun, Qnil, Qnil);
}
+ /* Empty hashes can be reused; otherwise, reset on next call. */
+ if (HASH_TABLE_P (read_objects_map)
+ && XHASH_TABLE (read_objects_map)->count > 0)
+ read_objects_map = Qnil;
+ if (HASH_TABLE_P (read_objects_completed)
+ && XHASH_TABLE (read_objects_completed)->count > 0)
+ read_objects_completed = Qnil;
if (!NILP (start) && continue_reading_p)
start = Fpoint_marker ();
@@ -1961,7 +2050,7 @@ readevalloop (Lisp_Object readcharfun,
}
build_load_history (sourcename,
- stream || whole_buffer);
+ infile0 || whole_buffer);
unbind_to (count, Qnil);
}
@@ -2106,7 +2195,18 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
readchar_count = 0;
new_backquote_flag = 0;
- read_objects = Qnil;
+ /* We can get called from readevalloop which may have set these
+ already. */
+ if (! HASH_TABLE_P (read_objects_map)
+ || XHASH_TABLE (read_objects_map)->count)
+ read_objects_map
+ = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ if (! HASH_TABLE_P (read_objects_completed)
+ || XHASH_TABLE (read_objects_completed)->count)
+ read_objects_completed
+ = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false);
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, stream))
Vread_symbol_positions_list = Qnil;
@@ -2134,6 +2234,13 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, stream))
Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
+ /* Empty hashes can be reused; otherwise, reset on next call. */
+ if (HASH_TABLE_P (read_objects_map)
+ && XHASH_TABLE (read_objects_map)->count > 0)
+ read_objects_map = Qnil;
+ if (HASH_TABLE_P (read_objects_completed)
+ && XHASH_TABLE (read_objects_completed)->count > 0)
+ read_objects_completed = Qnil;
return retval;
}
@@ -2162,7 +2269,7 @@ read0 (Lisp_Object readcharfun)
return val;
xsignal1 (Qinvalid_read_syntax,
- Fmake_string (make_number (1), make_number (c)));
+ Fmake_string (make_number (1), make_number (c), Qnil));
}
/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
@@ -2366,25 +2473,13 @@ read_escape (Lisp_Object readcharfun, bool stringp)
while (1)
{
c = READCHAR;
- if (c >= '0' && c <= '9')
- {
- i *= 16;
- i += c - '0';
- }
- else if ((c >= 'a' && c <= 'f')
- || (c >= 'A' && c <= 'F'))
- {
- i *= 16;
- if (c >= 'a' && c <= 'f')
- i += c - 'a' + 10;
- else
- i += c - 'A' + 10;
- }
- else
+ int digit = char_hexdigit (c);
+ if (digit < 0)
{
UNREAD (c);
break;
}
+ i = (i << 4) + digit;
/* Allow hex escapes as large as ?\xfffffff, because some
packages use them to denote characters with modifiers. */
if ((CHAR_META | (CHAR_META - 1)) < i)
@@ -2414,11 +2509,10 @@ read_escape (Lisp_Object readcharfun, bool stringp)
c = READCHAR;
/* `isdigit' and `isalpha' may be locale-specific, which we don't
want. */
- if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
- else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
- else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
- else
+ int digit = char_hexdigit (c);
+ if (digit < 0)
error ("Non-hex digit used for Unicode escape");
+ i = (i << 4) + digit;
}
if (i > 0x10FFFF)
error ("Non-Unicode character: 0x%x", i);
@@ -2582,6 +2676,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
bool uninterned_symbol = false;
bool multibyte;
char stackbuf[MAX_ALLOCA];
+ current_thread->stack_top = stackbuf;
*pch = 0;
@@ -2896,12 +2991,18 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
saved_doc_string_size = nskip + extra;
}
- saved_doc_string_position = file_tell (instream);
+ FILE *instream = infile->stream;
+ saved_doc_string_position = (file_tell (instream)
+ - infile->lookahead);
- /* Copy that many characters into saved_doc_string. */
+ /* Copy that many bytes into saved_doc_string. */
+ i = 0;
+ for (int n = min (nskip, infile->lookahead); 0 < n; n--)
+ saved_doc_string[i++]
+ = c = infile->buf[--infile->lookahead];
block_input ();
- for (i = 0; i < nskip && c >= 0; i++)
- saved_doc_string[i] = c = getc (instream);
+ for (; i < nskip && 0 <= c; i++)
+ saved_doc_string[i] = c = getc_unlocked (instream);
unblock_input ();
saved_doc_string_length = i;
@@ -2974,7 +3075,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
/* Note: We used to use AUTO_CONS to allocate
placeholder, but that is a bad idea, since it
will place a stack-allocated cons cell into
- the list in read_objects, which is a
+ the list in read_objects_map, which is a
staticpro'd global variable, and thus each of
its elements is marked during each GC. A
stack-allocated object will become garbled
@@ -2983,27 +3084,63 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
different purposes, which will cause crashes
in GC. */
Lisp_Object placeholder = Fcons (Qnil, Qnil);
- Lisp_Object cell = Fcons (make_number (n), placeholder);
- read_objects = Fcons (cell, read_objects);
+ struct Lisp_Hash_Table *h
+ = XHASH_TABLE (read_objects_map);
+ EMACS_UINT hash;
+ Lisp_Object number = make_number (n);
+
+ ptrdiff_t i = hash_lookup (h, number, &hash);
+ if (i >= 0)
+ /* Not normal, but input could be malformed. */
+ set_hash_value_slot (h, i, placeholder);
+ else
+ hash_put (h, number, placeholder, hash);
/* Read the object itself. */
tem = read0 (readcharfun);
+ /* If it can be recursive, remember it for
+ future substitutions. */
+ if (! SYMBOLP (tem)
+ && ! NUMBERP (tem)
+ && ! (STRINGP (tem) && !string_intervals (tem)))
+ {
+ struct Lisp_Hash_Table *h2
+ = XHASH_TABLE (read_objects_completed);
+ i = hash_lookup (h2, tem, &hash);
+ eassert (i < 0);
+ hash_put (h2, tem, Qnil, hash);
+ }
+
/* Now put it everywhere the placeholder was... */
- Fsubstitute_object_in_subtree (tem, placeholder);
+ if (CONSP (tem))
+ {
+ Fsetcar (placeholder, XCAR (tem));
+ Fsetcdr (placeholder, XCDR (tem));
+ return placeholder;
+ }
+ else
+ {
+ Flread__substitute_object_in_subtree
+ (tem, placeholder, read_objects_completed);
- /* ...and #n# will use the real value from now on. */
- Fsetcdr (cell, tem);
+ /* ...and #n# will use the real value from now on. */
+ i = hash_lookup (h, number, &hash);
+ eassert (i >= 0);
+ set_hash_value_slot (h, i, tem);
- return tem;
+ return tem;
+ }
}
/* #n# returns a previously read object. */
if (c == '#')
{
- tem = Fassq (make_number (n), read_objects);
- if (CONSP (tem))
- return XCDR (tem);
+ struct Lisp_Hash_Table *h
+ = XHASH_TABLE (read_objects_map);
+ ptrdiff_t i = hash_lookup (h, make_number (n), NULL);
+ if (i >= 0)
+ return HASH_VALUE (h, i);
}
}
}
@@ -3342,49 +3479,83 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list)
if (! NILP (result))
return unbind_to (count, result);
}
+ if (!quoted && multibyte)
+ {
+ int ch = STRING_CHAR ((unsigned char *) read_buffer);
+ switch (ch)
+ {
+ case 0x2018: /* LEFT SINGLE QUOTATION MARK */
+ case 0x2019: /* RIGHT SINGLE QUOTATION MARK */
+ case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */
+ case 0x201C: /* LEFT DOUBLE QUOTATION MARK */
+ case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */
+ case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */
+ case 0x301E: /* DOUBLE PRIME QUOTATION MARK */
+ case 0xFF02: /* FULLWIDTH QUOTATION MARK */
+ case 0xFF07: /* FULLWIDTH APOSTROPHE */
+ xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"),
+ CALLN (Fstring, make_number (ch)));
+ }
+ }
+ {
+ Lisp_Object result;
+ ptrdiff_t nbytes = p - read_buffer;
+ ptrdiff_t nchars
+ = (multibyte
+ ? multibyte_chars_in_text ((unsigned char *) read_buffer,
+ nbytes)
+ : nbytes);
+
+ if (uninterned_symbol)
+ {
+ Lisp_Object name
+ = ((! NILP (Vpurify_flag)
+ ? make_pure_string : make_specified_string)
+ (read_buffer, nchars, nbytes, multibyte));
+ result = Fmake_symbol (name);
+ }
+ else
+ {
+ /* Don't create the string object for the name unless
+ we're going to retain it in a new symbol.
- ptrdiff_t nbytes = p - read_buffer;
- ptrdiff_t nchars
- = (multibyte
- ? multibyte_chars_in_text ((unsigned char *) read_buffer,
- nbytes)
- : nbytes);
- Lisp_Object name = ((uninterned_symbol && ! NILP (Vpurify_flag)
- ? make_pure_string : make_specified_string)
- (read_buffer, nchars, nbytes, multibyte));
- Lisp_Object result = (uninterned_symbol ? Fmake_symbol (name)
- : Fintern (name, Qnil));
-
- if (EQ (Vread_with_symbol_positions, Qt)
- || EQ (Vread_with_symbol_positions, readcharfun))
- Vread_symbol_positions_list
- = Fcons (Fcons (result, make_number (start_position)),
- Vread_symbol_positions_list);
- return unbind_to (count, result);
+ Like intern_1 but supports multibyte names. */
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, read_buffer,
+ nchars, nbytes);
+
+ if (SYMBOLP (tem))
+ result = tem;
+ else
+ {
+ Lisp_Object name
+ = make_specified_string (read_buffer, nchars, nbytes,
+ multibyte);
+ result = intern_driver (name, obarray, tem);
+ }
+ }
+
+ if (EQ (Vread_with_symbol_positions, Qt)
+ || EQ (Vread_with_symbol_positions, readcharfun))
+ Vread_symbol_positions_list
+ = Fcons (Fcons (result, make_number (start_position)),
+ Vread_symbol_positions_list);
+ return unbind_to (count, result);
+ }
}
}
}
-
-/* List of nodes we've seen during substitute_object_in_subtree. */
-static Lisp_Object seen_list;
-
-DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
- Ssubstitute_object_in_subtree, 2, 2, 0,
- doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */)
- (Lisp_Object object, Lisp_Object placeholder)
+DEFUN ("lread--substitute-object-in-subtree",
+ Flread__substitute_object_in_subtree,
+ Slread__substitute_object_in_subtree, 3, 3, 0,
+ doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
+COMPLETED is a hash table of objects that might be circular, or is t
+if any object might be circular. */)
+ (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed)
{
- Lisp_Object check_object;
-
- /* We haven't seen any objects when we start. */
- seen_list = Qnil;
-
- /* Make all the substitutions. */
- check_object
- = substitute_object_recurse (object, placeholder, object);
-
- /* Clear seen_list because we're done with it. */
- seen_list = Qnil;
+ struct subst subst = { object, placeholder, completed, Qnil };
+ Lisp_Object check_object = substitute_object_recurse (&subst, object);
/* The returned object here is expected to always eq the
original. */
@@ -3393,37 +3564,31 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree,
return Qnil;
}
-/* Feval doesn't get called from here, so no gc protection is needed. */
-#define SUBSTITUTE(get_val, set_val) \
- do { \
- Lisp_Object old_value = get_val; \
- Lisp_Object true_value \
- = substitute_object_recurse (object, placeholder, \
- old_value); \
- \
- if (!EQ (old_value, true_value)) \
- { \
- set_val; \
- } \
- } while (0)
-
static Lisp_Object
-substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
+substitute_object_recurse (struct subst *subst, Lisp_Object subtree)
{
/* If we find the placeholder, return the target object. */
- if (EQ (placeholder, subtree))
- return object;
+ if (EQ (subst->placeholder, subtree))
+ return subst->object;
+
+ /* For common object types that can't contain other objects, don't
+ bother looking them up; we're done. */
+ if (SYMBOLP (subtree)
+ || (STRINGP (subtree) && !string_intervals (subtree))
+ || NUMBERP (subtree))
+ return subtree;
/* If we've been to this node before, don't explore it again. */
- if (!EQ (Qnil, Fmemq (subtree, seen_list)))
+ if (!EQ (Qnil, Fmemq (subtree, subst->seen)))
return subtree;
/* If this node can be the entry point to a cycle, remember that
we've seen it. It can only be such an entry point if it was made
by #n=, which means that we can find it as a value in
- read_objects. */
- if (!EQ (Qnil, Frassq (subtree, read_objects)))
- seen_list = Fcons (subtree, seen_list);
+ COMPLETED. */
+ if (EQ (subst->completed, Qt)
+ || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
+ subst->seen = Fcons (subtree, subst->seen);
/* Recurse according to subtree's type.
Every branch must return a Lisp_Object. */
@@ -3450,19 +3615,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
if (SUB_CHAR_TABLE_P (subtree))
i = 2;
for ( ; i < length; i++)
- SUBSTITUTE (AREF (subtree, i),
- ASET (subtree, i, true_value));
+ ASET (subtree, i,
+ substitute_object_recurse (subst, AREF (subtree, i)));
return subtree;
}
case Lisp_Cons:
- {
- SUBSTITUTE (XCAR (subtree),
- XSETCAR (subtree, true_value));
- SUBSTITUTE (XCDR (subtree),
- XSETCDR (subtree, true_value));
- return subtree;
- }
+ XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree)));
+ XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree)));
+ return subtree;
case Lisp_String:
{
@@ -3470,11 +3631,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
substitute_in_interval contains part of the logic. */
INTERVAL root_interval = string_intervals (subtree);
- AUTO_CONS (arg, object, placeholder);
-
traverse_intervals_noorder (root_interval,
- &substitute_in_interval, arg);
-
+ substitute_in_interval, subst);
return subtree;
}
@@ -3486,12 +3644,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
/* Helper function for substitute_object_recurse. */
static void
-substitute_in_interval (INTERVAL interval, Lisp_Object arg)
+substitute_in_interval (INTERVAL interval, void *arg)
{
- Lisp_Object object = Fcar (arg);
- Lisp_Object placeholder = Fcdr (arg);
-
- SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
+ set_interval_plist (interval,
+ substitute_object_recurse (arg, interval->plist));
}
@@ -3887,14 +4043,14 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
{
Lisp_Object *ptr;
- XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray)
- ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
- : SYMBOL_INTERNED);
+ XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray)
+ ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
+ : SYMBOL_INTERNED);
if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
{
make_symbol_constant (sym);
- XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
+ XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
@@ -4047,16 +4203,16 @@ usage: (unintern NAME OBARRAY) */)
/* if (EQ (tem, Qnil) || EQ (tem, Qt))
error ("Attempt to unintern t or nil"); */
- XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
+ XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED;
hash = oblookup_last_bucket_number;
if (EQ (AREF (obarray, hash), tem))
{
- if (XSYMBOL (tem)->next)
+ if (XSYMBOL (tem)->u.s.next)
{
Lisp_Object sym;
- XSETSYMBOL (sym, XSYMBOL (tem)->next);
+ XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next);
ASET (obarray, hash, sym);
}
else
@@ -4067,13 +4223,13 @@ usage: (unintern NAME OBARRAY) */)
Lisp_Object tail, following;
for (tail = AREF (obarray, hash);
- XSYMBOL (tail)->next;
+ XSYMBOL (tail)->u.s.next;
tail = following)
{
- XSETSYMBOL (following, XSYMBOL (tail)->next);
+ XSETSYMBOL (following, XSYMBOL (tail)->u.s.next);
if (EQ (following, tem))
{
- set_symbol_next (tail, XSYMBOL (following)->next);
+ set_symbol_next (tail, XSYMBOL (following)->u.s.next);
break;
}
}
@@ -4108,13 +4264,13 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
else if (!SYMBOLP (bucket))
error ("Bad data in guts of obarray"); /* Like CADR error message. */
else
- for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
+ for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
{
if (SBYTES (SYMBOL_NAME (tail)) == size_byte
&& SCHARS (SYMBOL_NAME (tail)) == size
&& !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
return tail;
- else if (XSYMBOL (tail)->next == 0)
+ else if (XSYMBOL (tail)->u.s.next == 0)
break;
}
XSETINT (tem, hash);
@@ -4134,9 +4290,9 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob
while (1)
{
(*fn) (tail, arg);
- if (XSYMBOL (tail)->next == 0)
+ if (XSYMBOL (tail)->u.s.next == 0)
break;
- XSETSYMBOL (tail, XSYMBOL (tail)->next);
+ XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
}
}
}
@@ -4176,12 +4332,12 @@ init_obarray (void)
DEFSYM (Qnil, "nil");
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
make_symbol_constant (Qnil);
- XSYMBOL (Qnil)->declared_special = true;
+ XSYMBOL (Qnil)->u.s.declared_special = true;
DEFSYM (Qt, "t");
SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
make_symbol_constant (Qt);
- XSYMBOL (Qt)->declared_special = true;
+ XSYMBOL (Qt)->u.s.declared_special = true;
/* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
Vpurify_flag = Qt;
@@ -4205,7 +4361,7 @@ defalias (struct Lisp_Subr *sname, char *string)
{
Lisp_Object sym;
sym = intern (string);
- XSETSUBR (XSYMBOL (sym)->function, sname);
+ XSETSUBR (XSYMBOL (sym)->u.s.function, sname);
}
#endif /* NOTDEF */
@@ -4220,8 +4376,8 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
sym = intern_c_string (namestring);
i_fwd->type = Lisp_Fwd_Int;
i_fwd->intvar = address;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ XSYMBOL (sym)->u.s.declared_special = true;
+ XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
}
@@ -4235,8 +4391,8 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd,
sym = intern_c_string (namestring);
b_fwd->type = Lisp_Fwd_Bool;
b_fwd->boolvar = address;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ XSYMBOL (sym)->u.s.declared_special = true;
+ XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
}
@@ -4254,8 +4410,8 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
sym = intern_c_string (namestring);
o_fwd->type = Lisp_Fwd_Obj;
o_fwd->objvar = address;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ XSYMBOL (sym)->u.s.declared_special = true;
+ XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
}
@@ -4278,8 +4434,8 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
sym = intern_c_string (namestring);
ko_fwd->type = Lisp_Fwd_Kboard_Obj;
ko_fwd->offset = offset;
- XSYMBOL (sym)->declared_special = 1;
- XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
+ XSYMBOL (sym)->u.s.declared_special = true;
+ XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
@@ -4589,7 +4745,7 @@ syms_of_lread (void)
{
defsubr (&Sread);
defsubr (&Sread_from_string);
- defsubr (&Ssubstitute_object_in_subtree);
+ defsubr (&Slread__substitute_object_in_subtree);
defsubr (&Sintern);
defsubr (&Sintern_soft);
defsubr (&Sunintern);
@@ -4613,7 +4769,7 @@ to find all the symbols in an obarray, use `mapatoms'. */);
DEFVAR_LISP ("values", Vvalues,
doc: /* List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological. */);
- XSYMBOL (intern ("values"))->declared_special = 0;
+ XSYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
@@ -4678,7 +4834,7 @@ to the specified file name if a suffix is allowed or required. */);
build_pure_c_string (".el"));
#endif
DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
- doc: /* Suffix of loadable module file, or nil of modules are not supported. */);
+ doc: /* Suffix of loadable module file, or nil if modules are not supported. */);
#ifdef HAVE_MODULES
Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
#else
@@ -4730,11 +4886,12 @@ The remaining ENTRIES in the alist element describe the functions and
variables defined in that file, the features provided, and the
features required. Each entry has the form `(provide . FEATURE)',
`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
-`(defface . SYMBOL)', or `(t . SYMBOL)'. Entries like `(t . SYMBOL)'
-may precede a `(defun . FUNCTION)' entry, and means that SYMBOL was an
-autoload before this file redefined it as a function. In addition,
-entries may also be single symbols, which means that SYMBOL was
-defined by `defvar' or `defconst'.
+`(defface . SYMBOL)', `(define-type . SYMBOL)',
+`(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
+Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
+and means that SYMBOL was an autoload before this file redefined it
+as a function. In addition, entries may also be single symbols,
+which means that symbol was defined by `defvar' or `defconst'.
During preloading, the file name recorded is relative to the main Lisp
directory. These file names are converted to absolute at startup. */);
@@ -4897,10 +5054,10 @@ that are loaded before your customizations are read! */);
DEFSYM (Qdir_ok, "dir-ok");
DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
- staticpro (&read_objects);
- read_objects = Qnil;
- staticpro (&seen_list);
- seen_list = Qnil;
+ staticpro (&read_objects_map);
+ read_objects_map = Qnil;
+ staticpro (&read_objects_completed);
+ read_objects_completed = Qnil;
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
diff --git a/src/macfont.h b/src/macfont.h
index 32899908be9..5ac604b0be6 100644
--- a/src/macfont.h
+++ b/src/macfont.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Original author: YAMAMOTO Mitsuharu
*/
@@ -82,3 +82,7 @@ typedef const struct _EmacsScreenFont *ScreenFontRef; /* opaque */
extern void mac_register_font_driver (struct frame *f);
extern void *macfont_get_nsctfont (struct font *font);
extern void macfont_update_antialias_threshold (void);
+
+/* This is an undocumented function. */
+extern void CGContextSetFontSmoothingStyle(CGContextRef, int)
+ __attribute__((weak_import));
diff --git a/src/macfont.m b/src/macfont.m
index 4d310e47aec..97879506ba4 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Original author: YAMAMOTO Mitsuharu
*/
@@ -2869,17 +2869,31 @@ macfont_draw (struct glyph_string *s, int from, int to, int x, int y,
and synthetic bold looks thinner on such environments.
Apple says there are no plans to address this issue
(rdar://11644870) currently. So we add a workaround. */
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
- CGContextSetLineWidth (context, synthetic_bold_factor * font_size
- * [[FRAME_NS_VIEW(f) window] backingScaleFactor]);
-#else
- CGContextSetLineWidth (context, synthetic_bold_factor * font_size);
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([[FRAME_NS_VIEW(f) window] respondsToSelector:
+ @selector(backingScaleFactor)])
+#endif
+ CGContextSetLineWidth (context, synthetic_bold_factor * font_size
+ * [[FRAME_NS_VIEW(f) window] backingScaleFactor]);
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ else
+#endif
+#endif
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ CGContextSetLineWidth (context, synthetic_bold_factor * font_size);
#endif
CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND (context, face, f);
}
if (no_antialias_p)
CGContextSetShouldAntialias (context, false);
+ if (!NILP (ns_use_thin_smoothing))
+ {
+ CGContextSetShouldSmoothFonts(context, YES);
+ CGContextSetFontSmoothingStyle(context, 16);
+ }
+
CGContextSetTextMatrix (context, atfm);
CGContextSetTextPosition (context, text_position.x, text_position.y);
diff --git a/src/macros.c b/src/macros.c
index f0ffda3f441..b32d73068a9 100644
--- a/src/macros.c
+++ b/src/macros.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/macros.h b/src/macros.h
index 31aece434de..dde3eb0c3f9 100644
--- a/src/macros.h
+++ b/src/macros.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_MACROS_H
#define EMACS_MACROS_H
diff --git a/src/marker.c b/src/marker.c
index f0c357fec00..2f7e649e9a6 100644
--- a/src/marker.c
+++ b/src/marker.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/menu.c b/src/menu.c
index 99a2ce8f7ef..b40c2c04ce7 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
@@ -1112,51 +1112,8 @@ into menu items. */)
return Qnil;
}
-
-DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
- doc: /* Pop up a deck-of-cards menu and return user's selection.
-POSITION is a position specification. This is either a mouse button event
-or a list ((XOFFSET YOFFSET) WINDOW)
-where XOFFSET and YOFFSET are positions in pixels from the top left
-corner of WINDOW. (WINDOW may be a window or a frame object.)
-This controls the position of the top left of the menu as a whole.
-If POSITION is t, it means to use the current mouse position.
-
-MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
-The menu items come from key bindings that have a menu string as well as
-a definition; actually, the "definition" in such a key binding looks like
-\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
-the keymap as a top-level element.
-
-If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
-Otherwise, REAL-DEFINITION should be a valid key binding definition.
-
-You can also use a list of keymaps as MENU.
- Then each keymap makes a separate pane.
-
-When MENU is a keymap or a list of keymaps, the return value is the
-list of events corresponding to the user's choice. Note that
-`x-popup-menu' does not actually execute the command bound to that
-sequence of events.
-
-Alternatively, you can specify a menu of multiple panes
- with a list of the form (TITLE PANE1 PANE2...),
-where each pane is a list of form (TITLE ITEM1 ITEM2...).
-Each ITEM is normally a cons cell (STRING . VALUE);
-but a string can appear as an item--that makes a nonselectable line
-in the menu.
-With this form of menu, the return value is VALUE from the chosen item.
-
-If POSITION is nil, don't display the menu at all, just precalculate the
-cached information about equivalent key sequences.
-
-If the user gets rid of the menu without making a valid choice, for
-instance by clicking the mouse away from a valid choice or by typing
-keyboard input, then this normally results in a quit and
-`x-popup-menu' does not return. But if POSITION is a mouse button
-event (indicating that the user invoked the menu with the mouse) then
-no quit occurs and `x-popup-menu' returns nil. */)
- (Lisp_Object position, Lisp_Object menu)
+Lisp_Object
+x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
{
Lisp_Object keymap, tem, tem2;
int xpos = 0, ypos = 0;
@@ -1443,6 +1400,55 @@ no quit occurs and `x-popup-menu' returns nil. */)
return selection;
}
+DEFUN ("x-popup-menu", Fx_popup_menu, Sx_popup_menu, 2, 2, 0,
+ doc: /* Pop up a deck-of-cards menu and return user's selection.
+POSITION is a position specification. This is either a mouse button event
+or a list ((XOFFSET YOFFSET) WINDOW)
+where XOFFSET and YOFFSET are positions in pixels from the top left
+corner of WINDOW. (WINDOW may be a window or a frame object.)
+This controls the position of the top left of the menu as a whole.
+If POSITION is t, it means to use the current mouse position.
+
+MENU is a specifier for a menu. For the simplest case, MENU is a keymap.
+The menu items come from key bindings that have a menu string as well as
+a definition; actually, the "definition" in such a key binding looks like
+\(STRING . REAL-DEFINITION). To give the menu a title, put a string into
+the keymap as a top-level element.
+
+If REAL-DEFINITION is nil, that puts a nonselectable string in the menu.
+Otherwise, REAL-DEFINITION should be a valid key binding definition.
+
+You can also use a list of keymaps as MENU.
+ Then each keymap makes a separate pane.
+
+When MENU is a keymap or a list of keymaps, the return value is the
+list of events corresponding to the user's choice. Note that
+`x-popup-menu' does not actually execute the command bound to that
+sequence of events.
+
+Alternatively, you can specify a menu of multiple panes
+ with a list of the form (TITLE PANE1 PANE2...),
+where each pane is a list of form (TITLE ITEM1 ITEM2...).
+Each ITEM is normally a cons cell (STRING . VALUE);
+but a string can appear as an item--that makes a nonselectable line
+in the menu.
+With this form of menu, the return value is VALUE from the chosen item.
+
+If POSITION is nil, don't display the menu at all, just precalculate the
+cached information about equivalent key sequences.
+
+If the user gets rid of the menu without making a valid choice, for
+instance by clicking the mouse away from a valid choice or by typing
+keyboard input, then this normally results in a quit and
+`x-popup-menu' does not return. But if POSITION is a mouse button
+event (indicating that the user invoked the menu with the mouse) then
+no quit occurs and `x-popup-menu' returns nil. */)
+ (Lisp_Object position, Lisp_Object menu)
+{
+ init_raw_keybuf_count ();
+ return x_popup_menu_1 (position, menu);
+}
+
/* If F's terminal is not capable of displaying a popup dialog,
emulate it with a menu. */
diff --git a/src/menu.h b/src/menu.h
index 2bb79ee82ce..3335616338d 100644
--- a/src/menu.h
+++ b/src/menu.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef MENU_H
#define MENU_H
@@ -60,4 +60,5 @@ extern Lisp_Object ns_menu_show (struct frame *, int, int, int,
extern Lisp_Object tty_menu_show (struct frame *, int, int, int,
Lisp_Object, const char **);
extern ptrdiff_t menu_item_width (const unsigned char *);
+extern Lisp_Object x_popup_menu_1 (Lisp_Object position, Lisp_Object menu);
#endif /* MENU_H */
diff --git a/src/minibuf.c b/src/minibuf.c
index 1bbe276776e..913c93001ef 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -15,12 +15,11 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
-#include <stdio.h>
#include <binary-io.h>
@@ -31,6 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "frame.h"
#include "window.h"
#include "keymap.h"
+#include "sysstdio.h"
#include "systty.h"
/* List of buffers for use as minibuffers.
@@ -209,15 +209,15 @@ read_minibuf_noninteractive (Lisp_Object map, Lisp_Object initial,
suppress_echo_on_tty (STDIN_FILENO);
}
- fwrite (SDATA (prompt), 1, SBYTES (prompt), stdout);
- fflush (stdout);
+ fwrite_unlocked (SDATA (prompt), 1, SBYTES (prompt), stdout);
+ fflush_unlocked (stdout);
val = Qnil;
size = 100;
len = 0;
line = xmalloc (size);
- while ((c = getchar ()) != '\n' && c != '\r')
+ while ((c = getchar_unlocked ()) != '\n' && c != '\r')
{
if (c == EOF)
{
@@ -497,6 +497,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt,
Fcons (Vminibuffer_history_position,
Fcons (Vminibuffer_history_variable,
minibuf_save_list))))));
+ minibuf_save_list
+ = Fcons (Fthis_command_keys_vector (), minibuf_save_list);
record_unwind_protect_void (read_minibuf_unwind);
minibuf_level++;
@@ -836,6 +838,11 @@ read_minibuf_unwind (void)
Fset_buffer (XWINDOW (window)->contents);
/* Restore prompt, etc, from outer minibuffer level. */
+ Lisp_Object key_vec = Fcar (minibuf_save_list);
+ eassert (VECTORP (key_vec));
+ this_command_key_count = XFASTINT (Flength (key_vec));
+ this_command_keys = key_vec;
+ minibuf_save_list = Fcdr (minibuf_save_list);
minibuf_prompt = Fcar (minibuf_save_list);
minibuf_save_list = Fcdr (minibuf_save_list);
minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list));
@@ -874,6 +881,30 @@ read_minibuf_unwind (void)
if (minibuf_level == 0)
resize_mini_window (XWINDOW (window), 0);
+ /* Deal with frames that should be removed when exiting the
+ minibuffer. */
+ {
+ Lisp_Object frames, frame1, val;
+ struct frame *f1;
+
+ FOR_EACH_FRAME (frames, frame1)
+ {
+ f1 = XFRAME (frame1);
+
+ if ((FRAME_PARENT_FRAME (f1)
+ || !NILP (get_frame_param (f1, Qdelete_before)))
+ && !NILP (val = (get_frame_param (f1, Qminibuffer_exit))))
+ {
+ if (EQ (val, Qiconify_frame))
+ Ficonify_frame (frame1);
+ else if (EQ (val, Qdelete_frame))
+ Fdelete_frame (frame1, Qnil);
+ else
+ Fmake_frame_invisible (frame1, Qnil);
+ }
+ }
+ }
+
/* In case the previous minibuffer displayed in this miniwindow is
dead, we may keep displaying this buffer (tho it's inactive), so reset it,
to make sure we don't leave around bindings and stuff which only
@@ -1249,8 +1280,8 @@ is used to further constrain the set of candidates. */)
error ("Bad data in guts of obarray");
elt = bucket;
eltstring = elt;
- if (XSYMBOL (bucket)->next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
+ if (XSYMBOL (bucket)->u.s.next)
+ XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
else
XSETFASTINT (bucket, 0);
}
@@ -1502,8 +1533,8 @@ with a space are ignored unless STRING itself starts with a space. */)
error ("Bad data in guts of obarray");
elt = bucket;
eltstring = elt;
- if (XSYMBOL (bucket)->next)
- XSETSYMBOL (bucket, XSYMBOL (bucket)->next);
+ if (XSYMBOL (bucket)->u.s.next)
+ XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next);
else
XSETFASTINT (bucket, 0);
}
@@ -1723,9 +1754,9 @@ the values STRING, PREDICATE and `lambda'. */)
tem = tail;
break;
}
- if (XSYMBOL (tail)->next == 0)
+ if (XSYMBOL (tail)->u.s.next == 0)
break;
- XSETSYMBOL (tail, XSYMBOL (tail)->next);
+ XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
}
}
}
@@ -1930,6 +1961,8 @@ syms_of_minibuf (void)
DEFSYM (Qactivate_input_method, "activate-input-method");
DEFSYM (Qcase_fold_search, "case-fold-search");
DEFSYM (Qmetadata, "metadata");
+ /* A frame parameter. */
+ DEFSYM (Qminibuffer_exit, "minibuffer-exit");
DEFVAR_LISP ("read-expression-history", Vread_expression_history,
doc: /* A history list for arguments that are Lisp expressions to evaluate.
diff --git a/src/module-env-25.h b/src/module-env-25.h
index 17e67004b24..675010b995b 100644
--- a/src/module-env-25.h
+++ b/src/module-env-25.h
@@ -92,7 +92,7 @@
SIZE must point to the total size of the buffer. If BUFFER is
NULL or if SIZE is not big enough, write the required buffer size
- to SIZE and return false.
+ to SIZE and return true.
Note that SIZE must include the last null byte (e.g. "abc" needs
a buffer of size 4).
diff --git a/src/msdos.c b/src/msdos.c
index 87b6f84148c..f7c99f63fff 100644
--- a/src/msdos.c
+++ b/src/msdos.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Contributed by Morten Welinder */
/* New display, keyboard, and mouse control by Kim F. Storm */
@@ -1791,7 +1791,7 @@ internal_terminal_init (void)
}
Vinitial_window_system = Qpc;
- Vwindow_system_version = make_number (26); /* RE Emacs version */
+ Vwindow_system_version = make_number (27); /* RE Emacs version */
tty->terminal->type = output_msdos_raw;
/* If Emacs was dumped on DOS/V machine, forget the stale VRAM
@@ -3943,6 +3943,8 @@ careadlinkat (int fd, char const *filename,
int
faccessat (int dirfd, const char * path, int mode, int flags)
{
+ char fullname[MAXPATHLEN];
+
/* We silently ignore FLAGS. */
flags = flags;
@@ -3950,10 +3952,23 @@ faccessat (int dirfd, const char * path, int mode, int flags)
&& !(IS_DIRECTORY_SEP (path[0])
|| IS_DEVICE_SEP (path[1])))
{
- errno = EBADF;
- return -1;
+ char lastc = dir_pathname[strlen (dir_pathname) - 1];
+
+ if (strlen (dir_pathname) + strlen (path) + IS_DIRECTORY_SEP (lastc)
+ >= MAXPATHLEN)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+
+ sprintf (fullname, "%s%s%s",
+ dir_pathname, IS_DIRECTORY_SEP (lastc) ? "" : "/", path);
+ path = fullname;
}
+ if ((mode & F_OK) != 0 && IS_DIRECTORY_SEP (path[strlen (path) - 1]))
+ mode |= D_OK;
+
return access (path, mode);
}
diff --git a/src/msdos.h b/src/msdos.h
index f4312c5c86d..e4f633e9df4 100644
--- a/src/msdos.h
+++ b/src/msdos.h
@@ -14,13 +14,15 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_MSDOS_H
#define EMACS_MSDOS_H
#include <dpmi.h>
+#include "termhooks.h" /* struct terminal */
+
int dos_ttraw (struct tty_display_info *);
int dos_ttcooked (void);
int dos_get_saved_screen (char **, int *, int *);
@@ -67,6 +69,7 @@ void syms_of_win16select (void);
/* Constants. */
#define EINPROGRESS 112
+#define ENOTSUP ENOSYS
/* Gnulib sets O_CLOEXEC to O_NOINHERIT, which gets in the way when we
need to redirect standard handles for subprocesses using temporary
files created by mkostemp, see callproc.c. */
diff --git a/src/nsfns.m b/src/nsfns.m
index dbce279da63..81722681674 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Originally by Carl Edman
@@ -984,6 +984,11 @@ frame_parm_handler ns_frame_parm_handlers[] =
x_set_no_accept_focus,
x_set_z_group, /* x_set_z_group */
0, /* x_set_override_redirect */
+ x_set_no_special_glyphs,
+#ifdef NS_IMPL_COCOA
+ ns_set_appearance,
+ ns_set_transparent_titlebar,
+#endif
};
@@ -1229,6 +1234,10 @@ This function is an internal primitive--use `make-frame' instead. */)
x_default_parameter (f, parms, Qinternal_border_width, make_number (2),
"internalBorderWidth", "InternalBorderWidth",
RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qright_divider_width, make_number (0),
+ NULL, NULL, RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qbottom_divider_width, make_number (0),
+ NULL, NULL, RES_TYPE_NUMBER);
/* default vertical scrollbars on right on Mac */
{
@@ -1256,6 +1265,8 @@ This function is an internal primitive--use `make-frame' instead. */)
"leftFringe", "LeftFringe", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qright_fringe, Qnil,
"rightFringe", "RightFringe", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
init_frame_faces (f);
@@ -1274,6 +1285,18 @@ This function is an internal primitive--use `make-frame' instead. */)
FRAME_UNDECORATED (f) = !NILP (tem) && !EQ (tem, Qunbound);
store_frame_param (f, Qundecorated, FRAME_UNDECORATED (f) ? Qt : Qnil);
+#ifdef NS_IMPL_COCOA
+ tem = x_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL, RES_TYPE_SYMBOL);
+ FRAME_NS_APPEARANCE (f) = EQ (tem, Qdark)
+ ? ns_appearance_vibrant_dark : ns_appearance_aqua;
+ store_frame_param (f, Qns_appearance, tem);
+
+ tem = x_get_arg (dpyinfo, parms, Qns_transparent_titlebar,
+ NULL, NULL, RES_TYPE_BOOLEAN);
+ FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound);
+ store_frame_param (f, Qns_transparent_titlebar, tem);
+#endif
+
parent_frame = x_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL,
RES_TYPE_SYMBOL);
/* Accept parent-frame iff parent-id was not specified. */
@@ -1325,6 +1348,15 @@ This function is an internal primitive--use `make-frame' instead. */)
f->output_data.ns->hourglass_cursor = [NSCursor disappearingItemCursor];
f->output_data.ns->horizontal_drag_cursor = [NSCursor resizeLeftRightCursor];
f->output_data.ns->vertical_drag_cursor = [NSCursor resizeUpDownCursor];
+ f->output_data.ns->left_edge_cursor = [NSCursor resizeLeftRightCursor];
+ f->output_data.ns->top_left_corner_cursor = [NSCursor arrowCursor];
+ f->output_data.ns->top_edge_cursor = [NSCursor resizeUpDownCursor];
+ f->output_data.ns->top_right_corner_cursor = [NSCursor arrowCursor];
+ f->output_data.ns->right_edge_cursor = [NSCursor resizeLeftRightCursor];
+ f->output_data.ns->bottom_right_corner_cursor = [NSCursor arrowCursor];
+ f->output_data.ns->bottom_edge_cursor = [NSCursor resizeUpDownCursor];
+ f->output_data.ns->bottom_left_corner_cursor = [NSCursor arrowCursor];
+
FRAME_DISPLAY_INFO (f)->vertical_scroll_bar_cursor
= [NSCursor arrowCursor];
FRAME_DISPLAY_INFO (f)->horizontal_scroll_bar_cursor
@@ -1448,13 +1480,8 @@ ns_window_is_ancestor (NSWindow *win, NSWindow *candidate)
DEFUN ("ns-frame-list-z-order", Fns_frame_list_z_order,
Sns_frame_list_z_order, 0, 1, 0,
doc: /* Return list of Emacs' frames, in Z (stacking) order.
-The optional argument TERMINAL specifies which display to ask about.
-TERMINAL should be either a frame or a display name (a string). If
-omitted or nil, that stands for the selected frame's display. Return
-nil if TERMINAL contains no Emacs frame.
-
-As a special case, if TERMINAL is non-nil and specifies a live frame,
-return the child frames of that frame in Z (stacking) order.
+If TERMINAL is non-nil and specifies a live frame, return the child
+frames of that frame in Z (stacking) order.
Frames are listed from topmost (first) to bottommost (last). */)
(Lisp_Object terminal)
@@ -1464,8 +1491,6 @@ Frames are listed from topmost (first) to bottommost (last). */)
if (FRAMEP (terminal) && FRAME_LIVE_P (XFRAME (terminal)))
parent = [FRAME_NS_VIEW (XFRAME (terminal)) window];
- else if (!NILP (terminal))
- return Qnil;
for (NSWindow *win in [[NSApp orderedWindows] reverseObjectEnumerator])
{
@@ -1580,7 +1605,7 @@ ns_run_file_dialog (void)
}
#ifdef NS_IMPL_COCOA
-#if MAC_OS_X_VERSION_MAX_ALLOWED > MAC_OS_X_VERSION_10_9
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
#define MODAL_OK_RESPONSE NSModalResponseOK
#endif
#endif
@@ -2500,52 +2525,61 @@ ns_screen_name (CGDirectDisplayID did)
{
char *name = NULL;
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
- mach_port_t masterPort;
- io_iterator_t it;
- io_object_t obj;
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
+ if (CGDisplayIOServicePort == NULL)
+#endif
+ {
+ mach_port_t masterPort;
+ io_iterator_t it;
+ io_object_t obj;
- // CGDisplayIOServicePort is deprecated. Do it another (harder) way.
+ /* CGDisplayIOServicePort is deprecated. Do it another (harder) way.
- if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
- || IOServiceGetMatchingServices (masterPort,
- IOServiceMatching ("IONDRVDevice"),
- &it) != kIOReturnSuccess)
- return name;
+ Is this code OK for macOS < 10.9, and GNUstep? I suspect it is,
+ in which case is it worth keeping the other method in here? */
- /* Must loop until we find a name. Many devices can have the same unit
- number (represents different GPU parts), but only one has a name. */
- while (! name && (obj = IOIteratorNext (it)))
- {
- CFMutableDictionaryRef props;
- const void *val;
-
- if (IORegistryEntryCreateCFProperties (obj,
- &props,
- kCFAllocatorDefault,
- kNilOptions) == kIOReturnSuccess
- && props != nil
- && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
+ if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess
+ || IOServiceGetMatchingServices (masterPort,
+ IOServiceMatching ("IONDRVDevice"),
+ &it) != kIOReturnSuccess)
+ return name;
+
+ /* Must loop until we find a name. Many devices can have the same unit
+ number (represents different GPU parts), but only one has a name. */
+ while (! name && (obj = IOIteratorNext (it)))
{
- unsigned nr = [(NSNumber *)val unsignedIntegerValue];
- if (nr == CGDisplayUnitNumber (did))
- name = ns_get_name_from_ioreg (obj);
+ CFMutableDictionaryRef props;
+ const void *val;
+
+ if (IORegistryEntryCreateCFProperties (obj,
+ &props,
+ kCFAllocatorDefault,
+ kNilOptions) == kIOReturnSuccess
+ && props != nil
+ && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex")))
+ {
+ unsigned nr = [(NSNumber *)val unsignedIntegerValue];
+ if (nr == CGDisplayUnitNumber (did))
+ name = ns_get_name_from_ioreg (obj);
+ }
+
+ CFRelease (props);
+ IOObjectRelease (obj);
}
- CFRelease (props);
- IOObjectRelease (obj);
+ IOObjectRelease (it);
}
-
- IOObjectRelease (it);
-
-#else
-
- name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
-
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
+ else
+#endif
+#endif /* #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
+ name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did));
#endif
return name;
}
-#endif
+#endif /* NS_IMPL_COCOA */
static Lisp_Object
ns_make_monitor_attribute_list (struct MonitorInfo *monitors,
@@ -3068,6 +3102,25 @@ The coordinates X and Y are interpreted in pixels relative to a position
return Qnil;
}
+DEFUN ("ns-mouse-absolute-pixel-position",
+ Fns_mouse_absolute_pixel_position,
+ Sns_mouse_absolute_pixel_position, 0, 0, 0,
+ doc: /* Return absolute position of mouse cursor in pixels.
+The position is returned as a cons cell (X . Y) of the
+coordinates of the mouse cursor position in pixels relative to a
+position (0, 0) of the selected frame's terminal. */)
+ (void)
+{
+ struct frame *f = SELECTED_FRAME ();
+ EmacsView *view = FRAME_NS_VIEW (f);
+ NSScreen *screen = [[view window] screen];
+ NSPoint pt = [NSEvent mouseLocation];
+
+ return Fcons(make_number(pt.x - screen.frame.origin.x),
+ make_number(screen.frame.size.height -
+ (pt.y - screen.frame.origin.y)));
+}
+
/* ==========================================================================
Class implementations
@@ -3208,6 +3261,7 @@ syms_of_nsfns (void)
DEFSYM (Qfontsize, "fontsize");
DEFSYM (Qframe_title_format, "frame-title-format");
DEFSYM (Qicon_title_format, "icon-title-format");
+ DEFSYM (Qdark, "dark");
DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist,
doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames.
@@ -3257,6 +3311,7 @@ be used as the image of the icon representing the frame. */);
defsubr (&Sns_frame_list_z_order);
defsubr (&Sns_frame_restack);
defsubr (&Sns_set_mouse_absolute_pixel_position);
+ defsubr (&Sns_mouse_absolute_pixel_position);
defsubr (&Sx_display_mm_width);
defsubr (&Sx_display_mm_height);
defsubr (&Sx_display_screens);
diff --git a/src/nsfont.m b/src/nsfont.m
index 1bfc3df1469..bcddd724c0d 100644
--- a/src/nsfont.m
+++ b/src/nsfont.m
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Author: Adrian Robert (arobert@cogsci.ucsd.edu)
*/
@@ -301,7 +301,7 @@ ns_charset_covers(NSCharacterSet *set1, NSCharacterSet *set2, float pct)
int i, off = 0, tot = 0;
/* Work around what appears to be a GNUstep bug.
- See <http://bugs.gnu.org/11853>. */
+ See <https://bugs.gnu.org/11853>. */
if (! (bytes1 && bytes2))
return NO;
diff --git a/src/nsgui.h b/src/nsgui.h
index a06eecf688f..e20f3e35e16 100644
--- a/src/nsgui.h
+++ b/src/nsgui.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef __NSGUI_H__
#define __NSGUI_H__
diff --git a/src/nsimage.m b/src/nsimage.m
index fb2322afc30..52e3bae05f1 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Originally by Carl Edman
@@ -76,9 +76,20 @@ ns_load_image (struct frame *f, struct image *img,
{
EmacsImage *eImg = nil;
NSSize size;
+ Lisp_Object lisp_index, lisp_rotation;
+ unsigned int index;
+ double rotation;
NSTRACE ("ns_load_image");
+ eassert (valid_image_p (img->spec));
+
+ lisp_index = Fplist_get (XCDR (img->spec), QCindex);
+ index = INTEGERP (lisp_index) ? XFASTINT (lisp_index) : 0;
+
+ lisp_rotation = Fplist_get (XCDR (img->spec), QCrotation);
+ rotation = NUMBERP (lisp_rotation) ? XFLOATINT (lisp_rotation) : 0;
+
if (STRINGP (spec_file))
{
eImg = [EmacsImage allocInitFromFile: spec_file];
@@ -99,12 +110,31 @@ ns_load_image (struct frame *f, struct image *img,
return 0;
}
+ if (![eImg setFrame: index])
+ {
+ add_to_log ("Unable to set index %d for image %s",
+ make_number (index), img->spec);
+ return 0;
+ }
+
+ img->lisp_data = [eImg getMetadata];
+
+ if (rotation != 0)
+ {
+ EmacsImage *temp = [eImg rotate:rotation];
+ [eImg release];
+ eImg = temp;
+ }
+
+ [eImg setSizeFromSpec:XCDR (img->spec)];
+
size = [eImg size];
img->width = size.width;
img->height = size.height;
/* 4) set img->pixmap = emacsimage */
img->pixmap = eImg;
+
return 1;
}
@@ -435,4 +465,161 @@ ns_set_alpha (void *img, int x, int y, unsigned char a)
return stippleMask;
}
+/* Find the first NSBitmapImageRep which has multiple frames. */
+- (NSBitmapImageRep *)getAnimatedBitmapImageRep
+{
+ for (NSImageRep * r in [self representations])
+ {
+ if ([r isKindOfClass:[NSBitmapImageRep class]])
+ {
+ NSBitmapImageRep * bm = (NSBitmapImageRep *)r;
+ if ([[bm valueForProperty:NSImageFrameCount] intValue] > 0)
+ return bm;
+ }
+ }
+ return nil;
+}
+
+/* If the image has multiple frames, get a count of them and the
+ animation delay, if available. */
+- (Lisp_Object)getMetadata
+{
+ Lisp_Object metadata = Qnil;
+
+ NSBitmapImageRep * bm = [self getAnimatedBitmapImageRep];
+
+ if (bm != nil)
+ {
+ int frames = [[bm valueForProperty:NSImageFrameCount] intValue];
+ float delay = [[bm valueForProperty:NSImageCurrentFrameDuration]
+ floatValue];
+
+ if (frames > 1)
+ metadata = Fcons (Qcount, Fcons (make_number (frames), metadata));
+ if (delay > 0)
+ metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata));
+ }
+ return metadata;
+}
+
+/* Attempt to set the animation frame to be displayed. */
+- (BOOL)setFrame: (unsigned int) index
+{
+ NSBitmapImageRep * bm = [self getAnimatedBitmapImageRep];
+
+ if (bm != nil)
+ {
+ int frames = [[bm valueForProperty:NSImageFrameCount] intValue];
+
+ /* If index is invalid, give up. */
+ if (index < 0 || index > frames)
+ return NO;
+
+ [bm setProperty: NSImageCurrentFrame
+ withValue: [NSNumber numberWithUnsignedInt:index]];
+ }
+
+ /* Setting the frame has succeeded, or the image doesn't have
+ multiple frames. */
+ return YES;
+}
+
+- (void)setSizeFromSpec: (Lisp_Object) spec
+{
+ NSSize size = [self size];
+ Lisp_Object value;
+ double scale = 1, aspect = size.width / size.height;
+ double width = -1, height = -1, max_width = -1, max_height = -1;
+
+ value = Fplist_get (spec, QCscale);
+ if (NUMBERP (value))
+ scale = XFLOATINT (value) ;
+
+ value = Fplist_get (spec, QCmax_width);
+ if (NUMBERP (value))
+ max_width = XFLOATINT (value);
+
+ value = Fplist_get (spec, QCmax_height);
+ if (NUMBERP (value))
+ max_height = XFLOATINT (value);
+
+ value = Fplist_get (spec, QCwidth);
+ if (NUMBERP (value))
+ {
+ width = XFLOATINT (value) * scale;
+ /* :width overrides :max-width. */
+ max_width = -1;
+ }
+
+ value = Fplist_get (spec, QCheight);
+ if (NUMBERP (value))
+ {
+ height = XFLOATINT (value) * scale;
+ /* :height overrides :max-height. */
+ max_height = -1;
+ }
+
+ if (width <= 0 && height <= 0)
+ {
+ width = size.width * scale;
+ height = size.height * scale;
+ }
+ else if (width > 0 && height <= 0)
+ height = width / aspect;
+ else if (height > 0 && width <= 0)
+ width = height * aspect;
+
+ if (max_width > 0 && width > max_width)
+ {
+ width = max_width;
+ height = max_width / aspect;
+ }
+
+ if (max_height > 0 && height > max_height)
+ {
+ height = max_height;
+ width = max_height * aspect;
+ }
+
+ [self setSize:NSMakeSize(width, height)];
+}
+
+- (instancetype)rotate: (double)rotation
+{
+ EmacsImage *new_image;
+ NSPoint new_origin;
+ NSSize new_size, size = [self size];
+ NSRect rect = { NSZeroPoint, [self size] };
+
+ /* Create a bezier path of the outline of the image and do the
+ * rotation on it. */
+ NSBezierPath *bounds_path = [NSBezierPath bezierPathWithRect:rect];
+ NSAffineTransform *transform = [NSAffineTransform transform];
+ [transform rotateByDegrees: rotation * -1];
+ [bounds_path transformUsingAffineTransform:transform];
+
+ /* Now we can find out how large the rotated image needs to be. */
+ new_size = [bounds_path bounds].size;
+ new_image = [[EmacsImage alloc] initWithSize:new_size];
+
+ new_origin = NSMakePoint((new_size.width - size.width)/2,
+ (new_size.height - size.height)/2);
+
+ [new_image lockFocus];
+
+ /* Create the final transform. */
+ transform = [NSAffineTransform transform];
+ [transform translateXBy:new_size.width/2 yBy:new_size.height/2];
+ [transform rotateByDegrees: rotation * -1];
+ [transform translateXBy:-new_size.width/2 yBy:-new_size.height/2];
+
+ [transform concat];
+ [self drawAtPoint:new_origin fromRect:NSZeroRect
+ operation:NSCompositingOperationCopy fraction:1];
+
+ [new_image unlockFocus];
+
+ return new_image;
+}
+
@end
diff --git a/src/nsmenu.m b/src/nsmenu.m
index 37a1a62d6d3..6ef7b60dc24 100644
--- a/src/nsmenu.m
+++ b/src/nsmenu.m
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
By Adrian Robert, based on code from original nsmenu.m (Carl Edman,
@@ -532,9 +532,14 @@ x_activate_menubar (struct frame *f)
{
++trackingMenu;
-#if MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
// On 10.6 we get repeated calls, only the one for NSSystemDefined is "real".
- if ([[NSApp currentEvent] type] != NSSystemDefined) return;
+ 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,
diff --git a/src/nsselect.m b/src/nsselect.m
index 8b38daeb6cb..067c7788e8b 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Originally by Carl Edman
diff --git a/src/nsterm.h b/src/nsterm.h
index bed0b92c796..c81bf5fb63d 100644
--- a/src/nsterm.h
+++ b/src/nsterm.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "dispextern.h"
@@ -25,30 +25,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "sysselect.h"
#ifdef HAVE_NS
-
-#ifdef NS_IMPL_COCOA
-#ifndef MAC_OS_X_VERSION_10_6
-#define MAC_OS_X_VERSION_10_6 1060
-#endif
-#ifndef MAC_OS_X_VERSION_10_7
-#define MAC_OS_X_VERSION_10_7 1070
-#endif
-#ifndef MAC_OS_X_VERSION_10_8
-#define MAC_OS_X_VERSION_10_8 1080
-#endif
-#ifndef MAC_OS_X_VERSION_10_9
-#define MAC_OS_X_VERSION_10_9 1090
-#endif
-#ifndef MAC_OS_X_VERSION_10_12
-#define MAC_OS_X_VERSION_10_12 101200
-#endif
-
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
-#define HAVE_NATIVE_FS
-#endif
-
-#endif /* NS_IMPL_COCOA */
-
#ifdef __OBJC__
/* CGFloat on GNUstep may be 4 or 8 byte, but functions expect float* for some
@@ -471,7 +447,7 @@ typedef id instancetype;
- (void) toggleFullScreen: (id) sender;
- (BOOL) fsIsNative;
- (BOOL) isFullscreen;
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- (void) updateCollectionBehavior;
#endif
@@ -668,6 +644,10 @@ typedef id instancetype;
alpha:(unsigned char)a;
- (void)setAlphaAtX: (int)x Y: (int)y to: (unsigned char)a;
- (NSColor *)stippleMask;
+- (Lisp_Object)getMetadata;
+- (BOOL)setFrame: (unsigned int) index;
+- (void)setSizeFromSpec: (Lisp_Object) spec;
+- (instancetype)rotate: (double)rotation;
@end
@@ -957,6 +937,14 @@ struct ns_output
Cursor hourglass_cursor;
Cursor horizontal_drag_cursor;
Cursor vertical_drag_cursor;
+ Cursor left_edge_cursor;
+ Cursor top_left_corner_cursor;
+ Cursor top_edge_cursor;
+ Cursor top_right_corner_cursor;
+ Cursor right_edge_cursor;
+ Cursor bottom_right_corner_cursor;
+ Cursor bottom_edge_cursor;
+ Cursor bottom_left_corner_cursor;
/* NS-specific */
Cursor current_pointer;
@@ -1224,9 +1212,19 @@ extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value,
Lisp_Object old_value);
extern void x_set_z_group (struct frame *f, Lisp_Object new_value,
Lisp_Object old_value);
+#ifdef NS_IMPL_COCOA
+extern void ns_set_appearance (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value);
+extern void ns_set_transparent_titlebar (struct frame *f,
+ Lisp_Object new_value,
+ Lisp_Object old_value);
+#endif
extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timespec const *timeout,
- sigset_t const *sigmask);
+ fd_set *exceptfds, struct timespec *timeout,
+ sigset_t *sigmask);
+#ifdef HAVE_PTHREAD
+extern void ns_run_loop_break (void);
+#endif
extern unsigned long ns_get_rgb_color (struct frame *f,
float r, float g, float b, float a);
@@ -1264,9 +1262,17 @@ extern char gnustep_base_version[]; /* version tracking */
? (min) : (((x)>(max)) ? (max) : (x)))
#define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX))
+/* macOS 10.7 introduces some new constants. */
+#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_7)
+#define NSFullScreenWindowMask (1 << 14)
+#define NSWindowCollectionBehaviorFullScreenPrimary (1 << 7)
+#define NSApplicationPresentationFullScreen (1 << 10)
+#define NSApplicationPresentationAutoHideToolbar (1 << 11)
+#define NSAppKitVersionNumber10_7 1138
+#endif /* !defined (MAC_OS_X_VERSION_10_7) */
+
/* macOS 10.12 deprecates a bunch of constants. */
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_12
+#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_12)
#define NSEventModifierFlagCommand NSCommandKeyMask
#define NSEventModifierFlagControl NSControlKeyMask
#define NSEventModifierFlagHelp NSHelpKeyMask
@@ -1292,6 +1298,7 @@ extern char gnustep_base_version[]; /* version tracking */
#define NSEventTypeKeyUp NSKeyUp
#define NSEventTypeFlagsChanged NSFlagsChanged
#define NSEventMaskAny NSAnyEventMask
+#define NSEventTypeSystemDefined NSSystemDefined
#define NSWindowStyleMaskBorderless NSBorderlessWindowMask
#define NSWindowStyleMaskClosable NSClosableWindowMask
#define NSWindowStyleMaskFullScreen NSFullScreenWindowMask
@@ -1301,11 +1308,19 @@ extern char gnustep_base_version[]; /* version tracking */
#define NSWindowStyleMaskUtilityWindow NSUtilityWindowMask
#define NSAlertStyleCritical NSCriticalAlertStyle
#define NSControlSizeRegular NSRegularControlSize
+#define NSCompositingOperationCopy NSCompositeCopy
/* And adds NSWindowStyleMask. */
#ifdef __OBJC__
typedef NSUInteger NSWindowStyleMask;
#endif
-#endif
+/* Window tabbing mode enums are new too. */
+enum NSWindowTabbingMode
+ {
+ NSWindowTabbingModeAutomatic,
+ NSWindowTabbingModePreferred,
+ NSWindowTabbingModeDisallowed
+ };
+#endif
#endif /* HAVE_NS */
diff --git a/src/nsterm.m b/src/nsterm.m
index e05dbf45fbc..50e06c94d45 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Originally by Carl Edman
@@ -136,14 +136,18 @@ char const * nstrace_fullscreen_type_name (int fs_type)
+ (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green
blue:(CGFloat)blue alpha:(CGFloat)alpha
{
-#ifdef NS_IMPL_COCOA
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
- if (ns_use_srgb_colorspace)
- return [NSColor colorWithSRGBRed: red
- green: green
- blue: blue
- alpha: alpha];
+#if defined (NS_IMPL_COCOA) \
+ && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ if (ns_use_srgb_colorspace
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ && [NSColor respondsToSelector:
+ @selector(colorWithSRGBRed:green:blue:alpha:)]
#endif
+ )
+ return [NSColor colorWithSRGBRed: red
+ green: green
+ blue: blue
+ alpha: alpha];
#endif
return [NSColor colorWithCalibratedRed: red
green: green
@@ -153,11 +157,18 @@ char const * nstrace_fullscreen_type_name (int fs_type)
- (NSColor *)colorUsingDefaultColorSpace
{
-#ifdef NS_IMPL_COCOA
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
- if (ns_use_srgb_colorspace)
- return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]];
+ /* FIXMES: We're checking for colorWithSRGBRed here so this will
+ only work in the same place as in the method above. It should
+ really be a check whether we're on macOS 10.7 or above. */
+#if defined (NS_IMPL_COCOA) \
+ && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+ if (ns_use_srgb_colorspace
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ && [NSColor respondsToSelector:
+ @selector(colorWithSRGBRed:green:blue:alpha:)]
#endif
+ )
+ return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]];
#endif
return [self colorUsingColorSpaceName: NSCalibratedRGBColorSpace];
}
@@ -412,20 +423,12 @@ static CGPoint menu_mouse_point;
}
-/* GNUstep always shows decorations if the window is resizable,
- miniaturizable or closable, but Cocoa does strange things in native
- fullscreen mode if you don't have at least resizable enabled.
-
- These flags will be OR'd or XOR'd with the NSWindow's styleMask
+/* These flags will be OR'd or XOR'd with the NSWindow's styleMask
property depending on what we're doing. */
-#ifdef NS_IMPL_COCOA
-#define FRAME_DECORATED_FLAGS NSWindowStyleMaskTitled
-#else
#define FRAME_DECORATED_FLAGS (NSWindowStyleMaskTitled \
| NSWindowStyleMaskResizable \
| NSWindowStyleMaskMiniaturizable \
| NSWindowStyleMaskClosable)
-#endif
#define FRAME_UNDECORATED_FLAGS NSWindowStyleMaskBorderless
/* TODO: get rid of need for these forward declarations */
@@ -1570,6 +1573,7 @@ x_make_frame_visible (struct frame *f)
if (!FRAME_VISIBLE_P (f))
{
EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *window = [view window];
SET_FRAME_VISIBLE (f, 1);
ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f));
@@ -1586,6 +1590,23 @@ x_make_frame_visible (struct frame *f)
[view handleFS];
unblock_input ();
}
+
+ /* Making a frame invisible seems to break the parent->child
+ relationship, so reinstate it. */
+ if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL)
+ {
+ NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window];
+
+ block_input ();
+ [parent addChildWindow: window
+ ordered: NSWindowAbove];
+ unblock_input ();
+
+ /* If the parent frame moved while the child frame was
+ invisible, the child frame's position won't have been
+ updated. Make sure it's in the right place now. */
+ x_set_offset(f, f->left_pos, f->top_pos, 0);
+ }
}
}
@@ -2007,6 +2028,58 @@ x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
error ("Invalid z-group specification");
}
+#ifdef NS_IMPL_COCOA
+void
+ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value)
+{
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *window = [view window];
+
+ NSTRACE ("ns_set_appearance");
+
+#ifndef NSAppKitVersionNumber10_10
+#define NSAppKitVersionNumber10_10 1343
+#endif
+
+ if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10)
+ return;
+
+ if (EQ (new_value, Qdark))
+ {
+ window.appearance = [NSAppearance
+ appearanceNamed: NSAppearanceNameVibrantDark];
+ FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark;
+ }
+ else
+ {
+ window.appearance = [NSAppearance
+ appearanceNamed: NSAppearanceNameAqua];
+ FRAME_NS_APPEARANCE (f) = ns_appearance_aqua;
+ }
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */
+}
+
+void
+ns_set_transparent_titlebar (struct frame *f, Lisp_Object new_value,
+ Lisp_Object old_value)
+{
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f);
+ NSWindow *window = [view window];
+
+ NSTRACE ("ns_set_transparent_titlebar");
+
+ if ([window respondsToSelector: @selector(titlebarAppearsTransparent)]
+ && !EQ (new_value, old_value))
+ {
+ window.titlebarAppearsTransparent = !NILP (new_value);
+ FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (new_value);
+ }
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */
+}
+#endif /* NS_IMPL_COCOA */
+
static void
ns_fullscreen_hook (struct frame *f)
{
@@ -3101,18 +3174,54 @@ ns_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
-------------------------------------------------------------------------- */
{
struct frame *f = XFRAME (WINDOW_FRAME (w));
- struct face *face;
- NSRect r = NSMakeRect (x0, y0, x1-x0, y1-y0);
+ struct face *face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID);
+ struct face *face_first
+ = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID);
+ struct face *face_last
+ = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_LAST_PIXEL_FACE_ID);
+ unsigned long color = face ? face->foreground : FRAME_FOREGROUND_PIXEL (f);
+ unsigned long color_first = (face_first
+ ? face_first->foreground
+ : FRAME_FOREGROUND_PIXEL (f));
+ unsigned long color_last = (face_last
+ ? face_last->foreground
+ : FRAME_FOREGROUND_PIXEL (f));
+ NSRect divider = NSMakeRect (x0, y0, x1-x0, y1-y0);
NSTRACE ("ns_draw_window_divider");
- face = FACE_FROM_ID_OR_NULL (f, WINDOW_DIVIDER_FACE_ID);
+ ns_focus (f, &divider, 1);
- ns_focus (f, &r, 1);
- if (face)
- [ns_lookup_indexed_color(face->foreground, f) set];
+ if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
+ /* A vertical divider, at least three pixels wide: Draw first and
+ last pixels differently. */
+ {
+ [ns_lookup_indexed_color(color_first, f) set];
+ NSRectFill(NSMakeRect (x0, y0, 1, y1 - y0));
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(NSMakeRect (x0 + 1, y0, x1 - x0 - 2, y1 - y0));
+ [ns_lookup_indexed_color(color_last, f) set];
+ NSRectFill(NSMakeRect (x1 - 1, y0, 1, y1 - y0));
+ }
+ else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
+ /* A horizontal divider, at least three pixels high: Draw first and
+ last pixels differently. */
+ {
+ [ns_lookup_indexed_color(color_first, f) set];
+ NSRectFill(NSMakeRect (x0, y0, x1 - x0, 1));
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(NSMakeRect (x0, y0 + 1, x1 - x0, y1 - y0 - 2));
+ [ns_lookup_indexed_color(color_last, f) set];
+ NSRectFill(NSMakeRect (x0, y1 - 1, x1 - x0, 1));
+ }
+ else
+ {
+ /* In any other case do not draw the first and last pixels
+ differently. */
+ [ns_lookup_indexed_color(color, f) set];
+ NSRectFill(divider);
+ }
- NSRectFill(r);
ns_unfocus (f);
}
@@ -3634,7 +3743,7 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r)
/* Currently on NS img->mask is always 0. Since
get_window_cursor_type specifies a hollow box cursor when on
a non-masked image we never reach this clause. But we put it
- in in anticipation of better support for image masks on
+ in, in anticipation of better support for image masks on
NS. */
tdCol = ns_lookup_indexed_color (NS_FACE_FOREGROUND (face), s->f);
}
@@ -4068,7 +4177,7 @@ ns_send_appdefined (int value)
app->nextappdefined = value;
[app performSelectorOnMainThread:@selector (sendFromMainThread:)
withObject:nil
- waitUntilDone:YES];
+ waitUntilDone:NO];
return;
}
@@ -4122,7 +4231,7 @@ ns_send_appdefined (int value)
}
}
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
static void
check_native_fs ()
{
@@ -4224,7 +4333,7 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_read_socket");
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
check_native_fs ();
#endif
@@ -4293,8 +4402,8 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit)
int
ns_select (int nfds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timespec const *timeout,
- sigset_t const *sigmask)
+ fd_set *exceptfds, struct timespec *timeout,
+ sigset_t *sigmask)
/* --------------------------------------------------------------------------
Replacement for select, checking for events
-------------------------------------------------------------------------- */
@@ -4306,7 +4415,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_select");
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
check_native_fs ();
#endif
@@ -4327,7 +4436,13 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
if (NSApp == nil
|| ![NSThread isMainThread]
|| (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0))
- return pselect (nfds, readfds, writefds, exceptfds, timeout, sigmask);
+ return thread_select(pselect, nfds, readfds, writefds,
+ exceptfds, timeout, sigmask);
+ else
+ {
+ struct timespec t = {0, 0};
+ thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask);
+ }
[outerpool release];
outerpool = [[NSAutoreleasePool alloc] init];
@@ -4430,6 +4545,18 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds,
return result;
}
+#ifdef HAVE_PTHREAD
+void
+ns_run_loop_break ()
+/* Break out of the NS run loop in ns_select or ns_read_socket. */
+{
+ NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_run_loop_break");
+
+ /* If we don't have a GUI, don't send the event. */
+ if (NSApp != NULL)
+ ns_send_appdefined(-1);
+}
+#endif
/* ==========================================================================
@@ -5461,6 +5588,19 @@ ns_term_shutdown (int sig)
object:nil];
#endif
+#ifdef NS_IMPL_COCOA
+ if ([NSApp activationPolicy] == NSApplicationActivationPolicyProhibited) {
+ /* Set the app's activation policy to regular when we run outside
+ of a bundle. This is already done for us by Info.plist when we
+ run inside a bundle. */
+ [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular];
+ [NSApp setApplicationIconImage:
+ [EmacsImage
+ allocInitFromFile:
+ build_string("icons/hicolor/128x128/apps/emacs.png")]];
+ }
+#endif
+
ns_send_appdefined (-2);
}
@@ -5514,8 +5654,7 @@ runAlertPanel(NSString *title,
NSString *defaultButton,
NSString *alternateButton)
{
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9
+#ifdef NS_IMPL_GNUSTEP
return NSRunAlertPanel(title, msgFormat, defaultButton, alternateButton, nil)
== NSAlertDefaultReturn;
#else
@@ -5965,7 +6104,7 @@ not_in_argv (NSString *arg)
/* GNUstep uses incompatible keycodes, even for those that are
supposed to be hardware independent. Just check for delete.
Keypad delete does not have keysym 0xFFFF.
- See http://savannah.gnu.org/bugs/?25395
+ See https://savannah.gnu.org/bugs/?25395
*/
|| (fnKeysym == 0xFFFF && code == 127)
#endif
@@ -6276,14 +6415,27 @@ not_in_argv (NSString *arg)
+FRAME_LINE_HEIGHT (emacsframe));
pt = [self convertPoint: pt toView: nil];
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
- pt = [[self window] convertBaseToScreen: pt];
- rect.origin = pt;
-#else
- rect.origin = pt;
- rect = [[self window] convertRectToScreen: rect];
+
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([[self window] respondsToSelector: @selector(convertRectToScreen:)])
+ {
#endif
+ rect.origin = pt;
+ rect = [(EmacsWindow *) [self window] convertRectToScreen: rect];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ }
+ else
+#endif
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 \
+ || defined (NS_IMPL_GNUSTEP)
+ {
+ pt = [[self window] convertBaseToScreen: pt];
+ rect.origin = pt;
+ }
+#endif
+
return rect;
}
@@ -6374,24 +6526,139 @@ not_in_argv (NSString *arg)
if ([theEvent type] == NSEventTypeScrollWheel)
{
- CGFloat delta = [theEvent deltaY];
- /* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */
- if (delta == 0)
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([theEvent respondsToSelector:@selector(hasPreciseScrollingDeltas)])
{
- delta = [theEvent deltaX];
- if (delta == 0)
+#endif
+ /* If the input device is a touchpad or similar, use precise
+ * scrolling deltas. These are measured in pixels, so we
+ * have to add them up until they exceed one line height,
+ * then we can send a scroll wheel event.
+ *
+ * If the device only has coarse scrolling deltas, like a
+ * real mousewheel, the deltas represent a ratio of whole
+ * lines, so round up the number of lines. This means we
+ * always send one scroll event per click, but can still
+ * scroll more than one line if the OS tells us to.
+ */
+ bool horizontal;
+ int lines = 0;
+ int scrollUp = NO;
+
+ /* FIXME: At the top or bottom of the buffer we should
+ * ignore momentum-phase events. */
+ if (! ns_use_mwheel_momentum
+ && [theEvent momentumPhase] != NSEventPhaseNone)
+ return;
+
+ if ([theEvent hasPreciseScrollingDeltas])
{
- NSTRACE_MSG ("deltaIsZero");
- return;
+ static int totalDeltaX, totalDeltaY;
+ int lineHeight;
+
+ if (NUMBERP (ns_mwheel_line_height))
+ lineHeight = XINT (ns_mwheel_line_height);
+ else
+ {
+ /* FIXME: Use actual line height instead of the default. */
+ lineHeight = default_line_pixel_height
+ (XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)));
+ }
+
+ if ([theEvent phase] == NSEventPhaseBegan)
+ {
+ totalDeltaX = 0;
+ totalDeltaY = 0;
+ }
+
+ totalDeltaX += [theEvent scrollingDeltaX];
+ totalDeltaY += [theEvent scrollingDeltaY];
+
+ /* Calculate the number of lines, if any, to scroll, and
+ * reset the total delta for the direction we're NOT
+ * scrolling so that small movements don't add up. */
+ if (abs (totalDeltaX) > abs (totalDeltaY)
+ && abs (totalDeltaX) > lineHeight)
+ {
+ horizontal = YES;
+ scrollUp = totalDeltaX > 0;
+
+ lines = abs (totalDeltaX / lineHeight);
+ totalDeltaX = totalDeltaX % lineHeight;
+ totalDeltaY = 0;
+ }
+ else if (abs (totalDeltaY) >= abs (totalDeltaX)
+ && abs (totalDeltaY) > lineHeight)
+ {
+ horizontal = NO;
+ scrollUp = totalDeltaY > 0;
+
+ lines = abs (totalDeltaY / lineHeight);
+ totalDeltaY = totalDeltaY % lineHeight;
+ totalDeltaX = 0;
+ }
+
+ if (lines > 1 && ! ns_use_mwheel_acceleration)
+ lines = 1;
+ }
+ else
+ {
+ CGFloat delta;
+
+ if ([theEvent scrollingDeltaY] == 0)
+ {
+ horizontal = YES;
+ delta = [theEvent scrollingDeltaX];
+ }
+ else
+ {
+ horizontal = NO;
+ delta = [theEvent scrollingDeltaY];
+ }
+
+ lines = (ns_use_mwheel_acceleration)
+ ? ceil (fabs (delta)) : 1;
+
+ scrollUp = delta > 0;
}
- emacs_event->kind = HORIZ_WHEEL_EVENT;
+
+ if (lines == 0)
+ return;
+
+ emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT;
+ emacs_event->arg = (make_number (lines));
+
+ emacs_event->code = 0;
+ emacs_event->modifiers = EV_MODIFIERS (theEvent) |
+ (scrollUp ? up_modifier : down_modifier);
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
}
else
- emacs_event->kind = WHEEL_EVENT;
+#endif
+#endif /* defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */
+#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ {
+ CGFloat delta = [theEvent deltaY];
+ /* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */
+ if (delta == 0)
+ {
+ delta = [theEvent deltaX];
+ if (delta == 0)
+ {
+ NSTRACE_MSG ("deltaIsZero");
+ return;
+ }
+ emacs_event->kind = HORIZ_WHEEL_EVENT;
+ }
+ else
+ emacs_event->kind = WHEEL_EVENT;
- emacs_event->code = 0;
- emacs_event->modifiers = EV_MODIFIERS (theEvent) |
- ((delta > 0) ? up_modifier : down_modifier);
+ emacs_event->code = 0;
+ emacs_event->modifiers = EV_MODIFIERS (theEvent) |
+ ((delta > 0) ? up_modifier : down_modifier);
+ }
+#endif
}
else
{
@@ -6400,9 +6667,11 @@ not_in_argv (NSString *arg)
emacs_event->modifiers = EV_MODIFIERS (theEvent)
| EV_UDMODIFIERS (theEvent);
}
+
XSETINT (emacs_event->x, lrint (p.x));
XSETINT (emacs_event->y, lrint (p.y));
EV_TRAILER (theEvent);
+ return;
}
@@ -6571,21 +6840,27 @@ not_in_argv (NSString *arg)
if (! [self isFullscreen])
{
+ int toolbar_height;
#ifdef NS_IMPL_GNUSTEP
// GNUstep does not always update the tool bar height. Force it.
if (toolbar && [toolbar isVisible])
update_frame_tool_bar (emacsframe);
#endif
+ toolbar_height = FRAME_TOOLBAR_HEIGHT (emacsframe);
+ if (toolbar_height < 0)
+ toolbar_height = 35;
+
extra = FRAME_NS_TITLEBAR_HEIGHT (emacsframe)
- + FRAME_TOOLBAR_HEIGHT (emacsframe);
+ + toolbar_height;
}
if (wait_for_tool_bar)
{
- /* The toolbar height is always 0 in fullscreen, so don't wait
- for it to become available. */
+ /* The toolbar height is always 0 in fullscreen and undecorated
+ frames, so don't wait for it to become available. */
if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0
+ && FRAME_UNDECORATED (emacsframe) == false
&& ! [self isFullscreen])
{
NSTRACE_MSG ("Waiting for toolbar");
@@ -6624,11 +6899,12 @@ not_in_argv (NSString *arg)
SET_FRAME_GARBAGED (emacsframe);
cancel_mouse_face (emacsframe);
- /* The next two lines appear to be setting the frame to the same
- size as it already is. Why are they there? */
- // wr = NSMakeRect (0, 0, neww, newh);
-
- // [view setFrame: wr];
+ /* The next two lines set the frame to the same size as we've
+ already set above. We need to do this when we switch back
+ from non-native fullscreen, in other circumstances it appears
+ to be a noop. (bug#28872) */
+ wr = NSMakeRect (0, 0, neww, newh);
+ [view setFrame: wr];
// to do: consider using [NSNotificationCenter postNotificationName:].
[self windowDidMove: // Update top/left.
@@ -6651,6 +6927,9 @@ not_in_argv (NSString *arg)
NSTRACE_RECT ("[sender frame]", [sender frame]);
NSTRACE_FSTYPE ("fs_state", fs_state);
+ if (!FRAME_LIVE_P (emacsframe))
+ return frameSize;
+
if (fs_state == FULLSCREEN_MAXIMIZED
&& (maximized_width != (int)frameSize.width
|| maximized_height != (int)frameSize.height))
@@ -6939,11 +7218,15 @@ not_in_argv (NSString *arg)
scrollbarsNeedingUpdate = 0;
fs_state = FULLSCREEN_NONE;
fs_before_fs = next_maximized = -1;
-#ifdef HAVE_NATIVE_FS
- fs_is_native = ns_use_native_fullscreen;
-#else
+
fs_is_native = NO;
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
+#endif
+ fs_is_native = ns_use_native_fullscreen;
#endif
+
maximized_width = maximized_height = -1;
nonfs_window = nil;
@@ -6964,17 +7247,14 @@ not_in_argv (NSString *arg)
initWithContentRect: r
styleMask: (FRAME_UNDECORATED (f)
? FRAME_UNDECORATED_FLAGS
- : FRAME_DECORATED_FLAGS
-#ifdef NS_IMPL_COCOA
- | NSWindowStyleMaskResizable
- | NSWindowStyleMaskMiniaturizable
- | NSWindowStyleMaskClosable
-#endif
- )
+ : FRAME_DECORATED_FLAGS)
backing: NSBackingStoreBuffered
defer: YES];
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
+#endif
[win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary];
#endif
@@ -6983,9 +7263,11 @@ not_in_argv (NSString *arg)
[win setAcceptsMouseMovedEvents: YES];
[win setDelegate: self];
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9
- [win useOptimizedDrawing: YES];
+#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
+ if ([win respondsToSelector: @selector(useOptimizedDrawing:)])
+#endif
+ [win useOptimizedDrawing: YES];
#endif
[[win contentView] addSubview: self];
@@ -7002,6 +7284,22 @@ not_in_argv (NSString *arg)
if (! FRAME_UNDECORATED (f))
[self createToolbar: f];
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+#ifndef NSAppKitVersionNumber10_10
+#define NSAppKitVersionNumber10_10 1343
+#endif
+
+ if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_10
+ && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua)
+ win.appearance = [NSAppearance
+ appearanceNamed: NSAppearanceNameVibrantDark];
+#endif
+
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000
+ if ([win respondsToSelector: @selector(titlebarAppearsTransparent)])
+ win.titlebarAppearsTransparent = FRAME_NS_TRANSPARENT_TITLEBAR (f);
+#endif
+
tem = f->icon_name;
if (!NILP (tem))
[win setMiniwindowTitle:
@@ -7045,9 +7343,12 @@ not_in_argv (NSString *arg)
if ([col alphaComponent] != (EmacsCGFloat) 1.0)
[win setOpaque: NO];
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9
- [self allocateGState];
+#if !defined (NS_IMPL_COCOA) \
+ || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
+ if ([self respondsToSelector: @selector(allocateGState)])
+#endif
+ [self allocateGState];
#endif
[NSApp registerServicesMenuSendTypes: ns_send_types
returnTypes: [NSArray array]];
@@ -7055,9 +7356,12 @@ not_in_argv (NSString *arg)
/* macOS Sierra automatically enables tabbed windows. We can't
allow this to be enabled until it's available on a Free system.
Currently it only happens by accident and is buggy anyway. */
-#if defined (NS_IMPL_COCOA) && \
- MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_12
- [win setTabbingMode: NSWindowTabbingModeDisallowed];
+#if defined (NS_IMPL_COCOA) \
+ && MAC_OS_X_VERSION_MAX_ALLOWED >= 101200
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 101200
+ if ([win respondsToSelector: @selector(setTabbingMode:)])
+#endif
+ [win setTabbingMode: NSWindowTabbingModeDisallowed];
#endif
ns_window_num++;
@@ -7274,7 +7578,7 @@ not_in_argv (NSString *arg)
}
}
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- (NSApplicationPresentationOptions)window:(NSWindow *)window
willUseFullScreenPresentationOptions:
(NSApplicationPresentationOptions)proposedOptions
@@ -7312,8 +7616,8 @@ not_in_argv (NSString *arg)
else
{
BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (emacsframe) ? YES : NO;
-#ifdef NS_IMPL_COCOA
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 \
+ && MAC_OS_X_VERSION_MIN_REQUIRED <= 1070
unsigned val = (unsigned)[NSApp presentationOptions];
// Mac OS X 10.7 bug fix, the menu won't appear without this.
@@ -7329,7 +7633,6 @@ not_in_argv (NSString *arg)
[NSApp setPresentationOptions: options];
}
#endif
-#endif
[toolbar setVisible:tbar_visible];
}
}
@@ -7368,7 +7671,7 @@ not_in_argv (NSString *arg)
}
[self setFSValue: fs_before_fs];
fs_before_fs = -1;
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
[self updateCollectionBehavior];
#endif
if (FRAME_EXTERNAL_TOOL_BAR (emacsframe))
@@ -7400,7 +7703,7 @@ not_in_argv (NSString *arg)
}
else
{
-#ifdef HAVE_NATIVE_FS
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
res = (([[self window] styleMask] & NSWindowStyleMaskFullScreen) != 0);
#else
res = NO;
@@ -7413,7 +7716,7 @@ not_in_argv (NSString *arg)
return res;
}
-#ifdef HAVE_NATIVE_FS
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
- (void)updateCollectionBehavior
{
NSTRACE ("[EmacsView updateCollectionBehavior]");
@@ -7428,7 +7731,10 @@ not_in_argv (NSString *arg)
b &= ~NSWindowCollectionBehaviorFullScreenPrimary;
[win setCollectionBehavior: b];
- fs_is_native = ns_use_native_fullscreen;
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7)
+#endif
+ fs_is_native = ns_use_native_fullscreen;
}
}
#endif
@@ -7445,8 +7751,11 @@ not_in_argv (NSString *arg)
if (fs_is_native)
{
-#ifdef HAVE_NATIVE_FS
- [[self window] toggleFullScreen:sender];
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([[self window] respondsToSelector: @selector(toggleFullScreen:)])
+#endif
+ [[self window] toggleFullScreen:sender];
#endif
return;
}
@@ -7463,10 +7772,13 @@ not_in_argv (NSString *arg)
{
NSScreen *screen = [w screen];
-#if defined (NS_IMPL_COCOA) && \
- MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
+#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1090
/* Hide ghost menu bar on secondary monitor? */
- if (! onFirstScreen)
+ if (! onFirstScreen
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
+ && [NSScreen respondsToSelector: @selector(screensHaveSeparateSpaces)]
+#endif
+ )
onFirstScreen = [NSScreen screensHaveSeparateSpaces];
#endif
/* Hide dock and menubar if we are on the primary screen. */
@@ -7494,9 +7806,12 @@ not_in_argv (NSString *arg)
[fw setTitle:[w title]];
[fw setDelegate:self];
[fw setAcceptsMouseMovedEvents: YES];
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9
- [fw useOptimizedDrawing: YES];
+#if !defined (NS_IMPL_COCOA) \
+ || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090
+#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090
+ if ([fw respondsToSelector: @selector(useOptimizedDrawing:)])
+#endif
+ [fw useOptimizedDrawing: YES];
#endif
[fw setBackgroundColor: col];
if ([col alphaComponent] != (EmacsCGFloat) 1.0)
@@ -7814,8 +8129,6 @@ not_in_argv (NSString *arg)
emacs_event->kind = DRAG_N_DROP_EVENT;
XSETINT (emacs_event->x, x);
XSETINT (emacs_event->y, y);
- ns_input_file = append2 (ns_input_file,
- build_string ([file UTF8String]));
emacs_event->modifiers = modifiers;
emacs_event->arg = list2 (Qfile, build_string ([file UTF8String]));
EV_TRAILER (theEvent);
@@ -8057,10 +8370,14 @@ not_in_argv (NSString *arg)
NSTRACE_ARG_RECT (frameRect));
#ifdef NS_IMPL_COCOA
-#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9
+#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090
// If separate spaces is on, it is like each screen is independent. There is
// no spanning of frames across screens.
- if ([NSScreen screensHaveSeparateSpaces])
+ if (
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090
+ [NSScreen respondsToSelector: @selector(screensHaveSeparateSpaces)] &&
+#endif
+ [NSScreen screensHaveSeparateSpaces])
{
NSTRACE_MSG ("Screens have separate spaces");
frameRect = [super constrainFrameRect:frameRect toScreen:screen];
@@ -8068,7 +8385,8 @@ not_in_argv (NSString *arg)
return frameRect;
}
else
-#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9 */
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */
+
// Check that the proposed frameRect is visible in at least one
// screen. If it is not, ask the system to reposition it (only
// for non-child windows).
@@ -8274,12 +8592,21 @@ not_in_argv (NSString *arg)
/* TODO: if we want to allow variable widths, this is the place to do it,
however neither GNUstep nor Cocoa support it very well */
CGFloat r;
-#if !defined (NS_IMPL_COCOA) || \
- MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7
- r = [NSScroller scrollerWidth];
-#else
- r = [NSScroller scrollerWidthForControlSize: NSControlSizeRegular
- scrollerStyle: NSScrollerStyleLegacy];
+#if defined (NS_IMPL_COCOA) \
+ && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ if ([NSScroller respondsToSelector:
+ @selector(scrollerWidthForControlSize:scrollerStyle:)])
+#endif
+ r = [NSScroller scrollerWidthForControlSize: NSControlSizeRegular
+ scrollerStyle: NSScrollerStyleLegacy];
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
+ else
+#endif
+#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */
+#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 \
+ || defined (NS_IMPL_GNUSTEP)
+ r = [NSScroller scrollerWidth];
#endif
return r;
}
@@ -8619,10 +8946,20 @@ not_in_argv (NSString *arg)
}
last_mouse_offset = kloc;
- if (part != NSScrollerKnob)
- /* this is a slot click on GNUstep: go straight there */
+ /* if knob, tell emacs a location offset by knob pos
+ (to indicate top of handle) */
+ if (part == NSScrollerKnob)
+ pos = (loc - last_mouse_offset);
+ else
+ /* else this is a slot click on GNUstep: go straight there */
pos = loc;
+ /* If there are buttons in the scroller area, we need to
+ recalculate pos as emacs expects the scroller slot to take up
+ the entire available length. */
+ if (length != pixel_length)
+ pos = pos * pixel_length / length;
+
/* send a fake mouse-up to super to preempt modal -trackKnob: mode */
fake_event = [NSEvent mouseEventWithType: NSEventTypeLeftMouseUp
location: [e locationInWindow]
@@ -8687,6 +9024,13 @@ not_in_argv (NSString *arg)
}
pos = (loc - last_mouse_offset);
+
+ /* If there are buttons in the scroller area, we need to
+ recalculate pos as emacs expects the scroller slot to take up
+ the entire available length. */
+ if (length != pixel_length)
+ pos = pos * pixel_length / length;
+
[self sendScrollEventAtLoc: pos fromEvent: e];
}
@@ -8808,9 +9152,9 @@ ns_xlfd_to_fontname (const char *xlfd)
const char *ret;
if (!strncmp (xlfd, "--", 2))
- sscanf (xlfd, "--%*[^-]-%[^-]179-", name);
+ sscanf (xlfd, "--%*[^-]-%179[^-]-", name);
else
- sscanf (xlfd, "-%*[^-]-%[^-]179-", name);
+ sscanf (xlfd, "-%*[^-]-%179[^-]-", name);
/* stopgap for malformed XLFD input */
if (strlen (name) == 0)
@@ -8953,6 +9297,10 @@ allowing it to be used at a lower level for accented character entry.");
"Non-nil (the default) means to render text antialiased.");
ns_antialias_text = Qt;
+ DEFVAR_LISP ("ns-use-thin-smoothing", ns_use_thin_smoothing,
+ "Non-nil turns on a font smoothing method that produces thinner strokes.");
+ ns_use_thin_smoothing = Qnil;
+
DEFVAR_LISP ("ns-confirm-quit", ns_confirm_quit,
"Whether to confirm application quit using dialog.");
ns_confirm_quit = Qnil;
@@ -8966,12 +9314,8 @@ Only works on Mac OS X 10.6 or later. */);
doc: /*Non-nil means to use native fullscreen on Mac OS X 10.7 and later.
Nil means use fullscreen the old (< 10.7) way. The old way works better with
multiple monitors, but lacks tool bar. This variable is ignored on
-Mac OS X < 10.7. Default is t for 10.7 and later, nil otherwise. */);
-#ifdef HAVE_NATIVE_FS
+Mac OS X < 10.7. Default is t. */);
ns_use_native_fullscreen = YES;
-#else
- ns_use_native_fullscreen = NO;
-#endif
ns_last_use_native_fullscreen = ns_use_native_fullscreen;
DEFVAR_BOOL ("ns-use-fullscreen-animation", ns_use_fullscreen_animation,
@@ -8986,6 +9330,23 @@ Note that this does not apply to images.
This variable is ignored on Mac OS X < 10.7 and GNUstep. */);
ns_use_srgb_colorspace = YES;
+ DEFVAR_BOOL ("ns-use-mwheel-acceleration",
+ ns_use_mwheel_acceleration,
+ doc: /*Non-nil means use macOS's standard mouse wheel acceleration.
+This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */);
+ ns_use_mwheel_acceleration = YES;
+
+ DEFVAR_LISP ("ns-mwheel-line-height", ns_mwheel_line_height,
+ doc: /*The number of pixels touchpad scrolling considers one line.
+Nil or a non-number means use the default frame line height.
+This variable is ignored on macOS < 10.7 and GNUstep. Default is nil. */);
+ ns_mwheel_line_height = Qnil;
+
+ DEFVAR_BOOL ("ns-use-mwheel-momentum", ns_use_mwheel_momentum,
+ doc: /*Non-nil means mouse wheel scrolling uses momentum.
+This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */);
+ ns_use_mwheel_momentum = YES;
+
/* TODO: move to common code */
DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars,
doc: /* Which toolkit scroll bars Emacs uses, if any.
diff --git a/src/print.c b/src/print.c
index aaec5b04956..f280616af8a 100644
--- a/src/print.c
+++ b/src/print.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -228,7 +228,7 @@ printchar_to_stream (unsigned int ch, FILE *stream)
{
if (ASCII_CHAR_P (ch))
{
- putc (ch, stream);
+ putc_unlocked (ch, stream);
#ifdef WINDOWSNT
/* Send the output to a debugger (nothing happens if there
isn't one). */
@@ -246,7 +246,7 @@ printchar_to_stream (unsigned int ch, FILE *stream)
if (encode_p)
encoded_ch = code_convert_string_norecord (encoded_ch,
coding_system, true);
- fwrite (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
+ fwrite_unlocked (SSDATA (encoded_ch), 1, SBYTES (encoded_ch), stream);
#ifdef WINDOWSNT
if (print_output_debug_flag && stream == stderr)
OutputDebugString (SSDATA (encoded_ch));
@@ -298,7 +298,7 @@ printchar (unsigned int ch, Lisp_Object fun)
if (DISP_TABLE_P (Vstandard_display_table))
printchar_to_stream (ch, stdout);
else
- fwrite (str, 1, len, stdout);
+ fwrite_unlocked (str, 1, len, stdout);
noninteractive_need_newline = 1;
}
else
@@ -350,7 +350,7 @@ strout (const char *ptr, ptrdiff_t size, ptrdiff_t size_byte,
}
}
else
- fwrite (ptr, 1, size_byte, stdout);
+ fwrite_unlocked (ptr, 1, size_byte, stdout);
noninteractive_need_newline = 1;
}
@@ -566,7 +566,7 @@ temp_output_buffer_setup (const char *bufname)
static void print (Lisp_Object, Lisp_Object, bool);
static void print_preprocess (Lisp_Object);
-static void print_preprocess_string (INTERVAL, Lisp_Object);
+static void print_preprocess_string (INTERVAL, void *);
static void print_object (Lisp_Object, Lisp_Object, bool);
DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0,
@@ -801,7 +801,7 @@ append to existing target file. */)
report_file_error ("Cannot open debugging output stream", file);
}
- fflush (stderr);
+ fflush_unlocked (stderr);
if (dup2 (fd, STDERR_FILENO) < 0)
report_file_error ("dup2", file);
if (fd != stderr_dup)
@@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj)
case Lisp_String:
/* A string may have text properties, which can be circular. */
traverse_intervals_noorder (string_intervals (obj),
- print_preprocess_string, Qnil);
+ print_preprocess_string, NULL);
break;
case Lisp_Cons:
@@ -1263,7 +1263,7 @@ Fills `print-number-table'. */)
}
static void
-print_preprocess_string (INTERVAL interval, Lisp_Object arg)
+print_preprocess_string (INTERVAL interval, void *arg)
{
print_preprocess (interval->plist);
}
@@ -1748,7 +1748,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT),
max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t),
40))];
-
+ current_thread->stack_top = buf;
maybe_quit ();
/* Detect circularities and truncate them. */
@@ -1870,21 +1870,36 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
}
else
{
+ bool still_need_nonhex = false;
/* If we just had a hex escape, and this character
could be taken as part of it,
output `\ ' to prevent that. */
- if (need_nonhex && c_isxdigit (c))
- print_c_string ("\\ ", printcharfun);
-
- if (c == '\n' && print_escape_newlines
- ? (c = 'n', true)
- : c == '\f' && print_escape_newlines
- ? (c = 'f', true)
- : c == '\"' || c == '\\')
- printchar ('\\', printcharfun);
-
- printchar (c, printcharfun);
- need_nonhex = false;
+ if (c_isxdigit (c))
+ {
+ if (need_nonhex)
+ print_c_string ("\\ ", printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (c == '\n' && print_escape_newlines
+ ? (c = 'n', true)
+ : c == '\f' && print_escape_newlines
+ ? (c = 'f', true)
+ : c == '\0' && print_escape_control_characters
+ ? (c = '0', still_need_nonhex = true)
+ : c == '\"' || c == '\\')
+ {
+ printchar ('\\', printcharfun);
+ printchar (c, printcharfun);
+ }
+ else if (print_escape_control_characters && c_iscntrl (c))
+ {
+ char outbuf[1 + 3 + 1];
+ int len = sprintf (outbuf, "\\%03o", c + 0u);
+ strout (outbuf, len, len, printcharfun);
+ }
+ else
+ printchar (c, printcharfun);
+ need_nonhex = still_need_nonhex;
}
}
printchar ('\"', printcharfun);
@@ -2329,6 +2344,11 @@ A value of nil means no limit. See also `eval-expression-print-level'. */);
Also print formfeeds as `\\f'. */);
print_escape_newlines = 0;
+ DEFVAR_BOOL ("print-escape-control-characters", print_escape_control_characters,
+ doc: /* Non-nil means print control characters in strings as `\\OOO'.
+\(OOO is the octal representation of the character code.)*/);
+ print_escape_control_characters = 0;
+
DEFVAR_BOOL ("print-escape-nonascii", print_escape_nonascii,
doc: /* Non-nil means print unibyte non-ASCII chars in strings as \\OOO.
\(OOO is the octal representation of the character code.)
@@ -2418,6 +2438,7 @@ priorities. */);
DEFSYM (Qprint_escape_newlines, "print-escape-newlines");
DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
+ DEFSYM (Qprint_escape_control_characters, "print-escape-control-characters");
print_prune_charset_plist = Qnil;
staticpro (&print_prune_charset_plist);
diff --git a/src/process.c b/src/process.c
index 2a1c2eecde3..3a8bcfb3fcf 100644
--- a/src/process.c
+++ b/src/process.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -40,6 +40,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <netinet/in.h>
#include <arpa/inet.h>
+#endif /* subprocesses */
+
#ifdef HAVE_SETRLIMIT
# include <sys/resource.h>
@@ -49,6 +51,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
static struct rlimit nofile_limit;
#endif
+#ifdef subprocesses
+
/* Are local (unix) sockets supported? */
#if defined (HAVE_SYS_UN_H)
#if !defined (AF_LOCAL) && defined (AF_UNIX)
@@ -142,7 +146,7 @@ extern int sys_select (int, fd_set *, fd_set *, fd_set *,
#endif
/* Work around GCC 4.3.0 bug with strict overflow checking; see
- <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
+ <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
This bug appears to be fixed in GCC 5.1, so don't work around it there. */
#if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
# pragma GCC diagnostic ignored "-Wstrict-overflow"
@@ -951,7 +955,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
if (PROCESSP (name))
return name;
CHECK_STRING (name);
- return Fcdr (Fassoc (name, Vprocess_alist));
+ return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
}
/* This is how commands for the user decode process arguments. It
@@ -3830,8 +3834,7 @@ usage: (make-network-process &rest ARGS) */)
Lisp_Object proc;
Lisp_Object contact;
struct Lisp_Process *p;
- const char *portstring;
- ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
+ const char *portstring UNINIT;
char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
#ifdef HAVE_LOCAL_SOCKETS
struct sockaddr_un address_un;
@@ -3978,6 +3981,8 @@ usage: (make-network-process &rest ARGS) */)
if (!NILP (host))
{
+ ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
+
/* SERVICE can either be a string or int.
Convert to a C string for later use by getaddrinfo. */
if (EQ (service, Qt))
@@ -3996,37 +4001,38 @@ usage: (make-network-process &rest ARGS) */)
portstring = SSDATA (service);
portstringlen = SBYTES (service);
}
- }
#ifdef HAVE_GETADDRINFO_A
- if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
- {
- ptrdiff_t hostlen = SBYTES (host);
- struct req
- {
- struct gaicb gaicb;
- struct addrinfo hints;
- char str[FLEXIBLE_ARRAY_MEMBER];
- } *req = xmalloc (FLEXSIZEOF (struct req, str,
- hostlen + 1 + portstringlen + 1));
- dns_request = &req->gaicb;
- dns_request->ar_name = req->str;
- dns_request->ar_service = req->str + hostlen + 1;
- dns_request->ar_request = &req->hints;
- dns_request->ar_result = NULL;
- memset (&req->hints, 0, sizeof req->hints);
- req->hints.ai_family = family;
- req->hints.ai_socktype = socktype;
- strcpy (req->str, SSDATA (host));
- strcpy (req->str + hostlen + 1, portstring);
-
- int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
- if (ret)
- error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
-
- goto open_socket;
- }
+ if (!NILP (Fplist_get (contact, QCnowait)))
+ {
+ ptrdiff_t hostlen = SBYTES (host);
+ struct req
+ {
+ struct gaicb gaicb;
+ struct addrinfo hints;
+ char str[FLEXIBLE_ARRAY_MEMBER];
+ } *req = xmalloc (FLEXSIZEOF (struct req, str,
+ hostlen + 1 + portstringlen + 1));
+ dns_request = &req->gaicb;
+ dns_request->ar_name = req->str;
+ dns_request->ar_service = req->str + hostlen + 1;
+ dns_request->ar_request = &req->hints;
+ dns_request->ar_result = NULL;
+ memset (&req->hints, 0, sizeof req->hints);
+ req->hints.ai_family = family;
+ req->hints.ai_socktype = socktype;
+ strcpy (req->str, SSDATA (host));
+ strcpy (req->str + hostlen + 1, portstring);
+
+ int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
+ if (ret)
+ error ("%s/%s getaddrinfo_a error %d",
+ SSDATA (host), portstring, ret);
+
+ goto open_socket;
+ }
#endif /* HAVE_GETADDRINFO_A */
+ }
/* If we have a host, use getaddrinfo to resolve both host and service.
Otherwise, use getservbyname to lookup the service. */
@@ -5371,14 +5377,13 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
nfds = xg_select (max_desc + 1,
&Available, (check_write ? &Writeok : 0),
NULL, &timeout, NULL);
+#elif defined HAVE_NS
+ /* And NS builds call thread_select in ns_select. */
+ nfds = ns_select (max_desc + 1,
+ &Available, (check_write ? &Writeok : 0),
+ NULL, &timeout, NULL);
#else /* !HAVE_GLIB */
- nfds = thread_select (
-# ifdef HAVE_NS
- ns_select
-# else
- pselect
-# endif
- , max_desc + 1,
+ nfds = thread_select (pselect, max_desc + 1,
&Available,
(check_write ? &Writeok : 0),
NULL, &timeout, NULL);
@@ -5622,16 +5627,6 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
}
else if (nread == -1 && would_block (errno))
;
-#ifdef WINDOWSNT
- /* FIXME: Is this special case still needed? */
- /* Note that we cannot distinguish between no input
- available now and a closed pipe.
- With luck, a closed pipe will be accompanied by
- subprocess termination and SIGCHLD. */
- else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
- && !PIPECONN_P (proc))
- ;
-#endif
#ifdef HAVE_PTYS
/* On some OSs with ptys, when the process on one end of
a pty exits, the other end gets an error reading with
@@ -6678,6 +6673,18 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
unblock_child_signal (&oldset);
}
+DEFUN ("internal-default-interrupt-process",
+ Finternal_default_interrupt_process,
+ Sinternal_default_interrupt_process, 0, 2, 0,
+ doc: /* Default function to interrupt process PROCESS.
+It shall be the last element in list `interrupt-process-functions'.
+See function `interrupt-process' for more details on usage. */)
+ (Lisp_Object process, Lisp_Object current_group)
+{
+ process_send_signal (process, SIGINT, current_group, 0);
+ return process;
+}
+
DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
doc: /* Interrupt process PROCESS.
PROCESS may be a process, a buffer, or the name of a process or buffer.
@@ -6689,11 +6696,14 @@ If the process is a shell, this means interrupt current subjob
rather than the shell.
If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
-don't send the signal. */)
+don't send the signal.
+
+This function calls the functions of `interrupt-process-functions' in
+the order of the list, until one of them returns non-`nil'. */)
(Lisp_Object process, Lisp_Object current_group)
{
- process_send_signal (process, SIGINT, current_group, 0);
- return process;
+ return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
+ process, current_group);
}
DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
@@ -7088,6 +7098,10 @@ deliver_child_signal (int sig)
static Lisp_Object
exec_sentinel_error_handler (Lisp_Object error_val)
{
+ /* Make sure error_val is a cons cell, as all the rest of error
+ handling expects that, and will barf otherwise. */
+ if (!CONSP (error_val))
+ error_val = Fcons (Qerror, error_val);
cmd_error_internal (error_val, "error in process sentinel: ");
Vinhibit_quit = Qt;
update_echo_area ();
@@ -7437,6 +7451,13 @@ keyboard_bit_set (fd_set *mask)
#else /* not subprocesses */
+/* This is referenced in thread.c:run_thread (which is never actually
+ called, since threads are not enabled for this configuration. */
+void
+update_processes_for_thread_death (Lisp_Object dying_thread)
+{
+}
+
/* Defined in msdos.c. */
extern int sys_select (int, fd_set *, fd_set *, fd_set *,
struct timespec *, void *);
@@ -7678,7 +7699,7 @@ Lisp_Object
remove_slash_colon (Lisp_Object name)
{
return
- ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':')
+ (SREF (name, 0) == '/' && SREF (name, 1) == ':'
? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
SBYTES (name) - 2, STRING_MULTIBYTE (name))
: name);
@@ -8079,7 +8100,6 @@ syms_of_process (void)
DEFSYM (Qreal, "real");
DEFSYM (Qnetwork, "network");
DEFSYM (Qserial, "serial");
- DEFSYM (Qpipe, "pipe");
DEFSYM (QCbuffer, ":buffer");
DEFSYM (QChost, ":host");
DEFSYM (QCservice, ":service");
@@ -8177,6 +8197,17 @@ non-nil value means that the delay is not reset on write.
The variable takes effect when `start-process' is called. */);
Vprocess_adaptive_read_buffering = Qt;
+ DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
+ doc: /* List of functions to be called for `interrupt-process'.
+The arguments of the functions are the same as for `interrupt-process'.
+These functions are called in the order of the list, until one of them
+returns non-`nil'. */);
+ Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
+
+ DEFSYM (Qinternal_default_interrupt_process,
+ "internal-default-interrupt-process");
+ DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
+
defsubr (&Sprocessp);
defsubr (&Sget_process);
defsubr (&Sdelete_process);
@@ -8219,6 +8250,7 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Saccept_process_output);
defsubr (&Sprocess_send_region);
defsubr (&Sprocess_send_string);
+ defsubr (&Sinternal_default_interrupt_process);
defsubr (&Sinterrupt_process);
defsubr (&Skill_process);
defsubr (&Squit_process);
diff --git a/src/process.h b/src/process.h
index 2c174cc3ea8..5670f447365 100644
--- a/src/process.h
+++ b/src/process.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_PROCESS_H
#define EMACS_PROCESS_H
@@ -41,7 +41,7 @@ enum { PROCESS_OPEN_FDS = 6 };
struct Lisp_Process
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* Name of subprocess terminal. */
Lisp_Object tty_name;
diff --git a/src/profiler.c b/src/profiler.c
index 6dc0d8ce72d..d9d7d0b1c7f 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include "lisp.h"
diff --git a/src/puresize.h b/src/puresize.h
index b90b6970421..0824437bdfd 100644
--- a/src/puresize.h
+++ b/src/puresize.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_PURESIZE_H
#define EMACS_PURESIZE_H
diff --git a/src/ralloc.c b/src/ralloc.c
index 8a3d2b797f3..59a15e08ad8 100644
--- a/src/ralloc.c
+++ b/src/ralloc.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* NOTES:
diff --git a/src/regex.c b/src/regex.c
index 240a91f2ba8..d3d910daaa3 100644
--- a/src/regex.c
+++ b/src/regex.c
@@ -15,7 +15,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* TODO:
- structure the opcode space into opcode+flag.
@@ -306,9 +306,7 @@ enum syntaxcode { Swhitespace = 0, Sword = 1, Ssymbol = 2 };
/* In Emacs, these are only used for single-byte characters. */
# define ISDIGIT(c) ((c) >= '0' && (c) <= '9')
# define ISCNTRL(c) ((c) < ' ')
-# define ISXDIGIT(c) (((c) >= '0' && (c) <= '9') \
- || ((c) >= 'a' && (c) <= 'f') \
- || ((c) >= 'A' && (c) <= 'F'))
+# define ISXDIGIT(c) (0 <= char_hexdigit (c))
/* The rest must handle multibyte characters. */
@@ -521,13 +519,7 @@ ptrdiff_t emacs_re_safe_alloca = MAX_ALLOCA;
#endif
/* Type of source-pattern and string chars. */
-#ifdef _MSC_VER
-typedef unsigned char re_char;
-typedef const re_char const_re_char;
-#else
typedef const unsigned char re_char;
-typedef re_char const_re_char;
-#endif
typedef char boolean;
@@ -1944,7 +1936,7 @@ struct range_table_work_area
returned. If name is not a valid character class name zero, or RECC_ERROR,
is returned.
- Otherwise, if *strp doesn’t begin with "[:name:]", -1 is returned.
+ Otherwise, if *strp doesn't begin with "[:name:]", -1 is returned.
The function can be used on ASCII and multibyte (UTF-8-encoded) strings.
*/
@@ -1956,8 +1948,8 @@ re_wctype_parse (const unsigned char **strp, unsigned limit)
if (limit < 4 || beg[0] != '[' || beg[1] != ':')
return -1;
- beg += 2; /* skip opening ‘[:’ */
- limit -= 3; /* opening ‘[:’ and half of closing ‘:]’; --limit handles rest */
+ beg += 2; /* skip opening "[:" */
+ limit -= 3; /* opening "[:" and half of closing ":]"; --limit handles rest */
for (it = beg; it[0] != ':' || it[1] != ']'; ++it)
if (!--limit)
return -1;
@@ -1987,7 +1979,7 @@ re_wctype_parse (const unsigned char **strp, unsigned limit)
2 [:cntrl:]
1 [:ff:]
- If you update this list, consider also updating chain of or’ed conditions
+ If you update this list, consider also updating chain of or'ed conditions
in execute_charset function.
*/
@@ -2405,7 +2397,7 @@ do { \
} while (0)
static reg_errcode_t
-regex_compile (const_re_char *pattern, size_t size,
+regex_compile (re_char *pattern, size_t size,
#ifdef emacs
# define syntax RE_SYNTAX_EMACS
bool posix_backtracking,
@@ -3730,7 +3722,7 @@ insert_op2 (re_opcode_t op, unsigned char *loc, int arg1, int arg2, unsigned cha
least one character before the ^. */
static boolean
-at_begline_loc_p (const_re_char *pattern, const_re_char *p, reg_syntax_t syntax)
+at_begline_loc_p (re_char *pattern, re_char *p, reg_syntax_t syntax)
{
re_char *prev = p - 2;
boolean odd_backslashes;
@@ -3771,7 +3763,7 @@ at_begline_loc_p (const_re_char *pattern, const_re_char *p, reg_syntax_t syntax)
at least one character after the $, i.e., `P < PEND'. */
static boolean
-at_endline_loc_p (const_re_char *p, const_re_char *pend, reg_syntax_t syntax)
+at_endline_loc_p (re_char *p, re_char *pend, reg_syntax_t syntax)
{
re_char *next = p;
boolean next_backslash = *next == '\\';
@@ -3815,7 +3807,7 @@ group_in_compile_stack (compile_stack_type compile_stack, regnum_t regnum)
Return -1 if fastmap was not updated accurately. */
static int
-analyze_first (const_re_char *p, const_re_char *pend, char *fastmap,
+analyze_first (re_char *p, re_char *pend, char *fastmap,
const int multibyte)
{
int j, k;
@@ -4557,7 +4549,7 @@ static int bcmp_translate (re_char *s1, re_char *s2,
/* If the operation is a match against one or more chars,
return a pointer to the next operation, else return NULL. */
static re_char *
-skip_one_char (const_re_char *p)
+skip_one_char (re_char *p)
{
switch (*p++)
{
@@ -4599,7 +4591,7 @@ skip_one_char (const_re_char *p)
/* Jump over non-matching operations. */
static re_char *
-skip_noops (const_re_char *p, const_re_char *pend)
+skip_noops (re_char *p, re_char *pend)
{
int mcnt;
while (p < pend)
@@ -4630,7 +4622,7 @@ skip_noops (const_re_char *p, const_re_char *pend)
character (i.e. without any translations). UNIBYTE denotes whether c is
unibyte or multibyte character. */
static bool
-execute_charset (const_re_char **pp, unsigned c, unsigned corig, bool unibyte)
+execute_charset (re_char **pp, unsigned c, unsigned corig, bool unibyte)
{
re_char *p = *pp, *rtp = NULL;
bool not = (re_opcode_t) *p == charset_not;
@@ -4694,8 +4686,8 @@ execute_charset (const_re_char **pp, unsigned c, unsigned corig, bool unibyte)
/* Non-zero if "p1 matches something" implies "p2 fails". */
static int
-mutually_exclusive_p (struct re_pattern_buffer *bufp, const_re_char *p1,
- const_re_char *p2)
+mutually_exclusive_p (struct re_pattern_buffer *bufp, re_char *p1,
+ re_char *p2)
{
re_opcode_t op2;
const boolean multibyte = RE_MULTIBYTE_P (bufp);
@@ -4933,8 +4925,8 @@ WEAK_ALIAS (__re_match_2, re_match_2)
/* This is a separate function so that we can force an alloca cleanup
afterwards. */
static regoff_t
-re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
- size_t size1, const_re_char *string2, size_t size2,
+re_match_2_internal (struct re_pattern_buffer *bufp, re_char *string1,
+ size_t size1, re_char *string2, size_t size2,
ssize_t pos, struct re_registers *regs, ssize_t stop)
{
/* General temporaries. */
@@ -6224,10 +6216,10 @@ re_match_2_internal (struct re_pattern_buffer *bufp, const_re_char *string1,
bytes; nonzero otherwise. */
static int
-bcmp_translate (const_re_char *s1, const_re_char *s2, register ssize_t len,
+bcmp_translate (re_char *s1, re_char *s2, ssize_t len,
RE_TRANSLATE_TYPE translate, const int target_multibyte)
{
- register re_char *p1 = s1, *p2 = s2;
+ re_char *p1 = s1, *p2 = s2;
re_char *p1_end = s1 + len;
re_char *p2_end = s2 + len;
diff --git a/src/regex.h b/src/regex.h
index 1d439de259c..9fa83560116 100644
--- a/src/regex.h
+++ b/src/regex.h
@@ -15,13 +15,13 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _REGEX_H
#define _REGEX_H 1
#if defined emacs && (defined _REGEX_RE_COMP || defined _LIBC)
-/* We’re not defining re_set_syntax and using a different prototype of
+/* We're not defining re_set_syntax and using a different prototype of
re_compile_pattern when building Emacs so fail compilation early with
a (somewhat helpful) error message when conflict is detected. */
# error "_REGEX_RE_COMP nor _LIBC can be defined if emacs is defined."
diff --git a/src/region-cache.c b/src/region-cache.c
index 36c8759366c..a00b28ea22f 100644
--- a/src/region-cache.c
+++ b/src/region-cache.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/region-cache.h b/src/region-cache.h
index 6327e2dc081..483ee36831f 100644
--- a/src/region-cache.h
+++ b/src/region-cache.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_REGION_CACHE_H
#define EMACS_REGION_CACHE_H
diff --git a/src/scroll.c b/src/scroll.c
index 482a0261923..c6e0cfd7e21 100644
--- a/src/scroll.c
+++ b/src/scroll.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -457,7 +457,7 @@ calculate_direct_scrolling (struct frame *frame,
if (baud_rate <= 0)
extra_cost = 1;
- /* Overhead of setting the scroll window, plus the extra cost
+ /* Overhead of setting the scroll window, plus the extra
cost of scrolling by a distance of one. The extra cost is
added once for consistency with the cost vectors */
scroll_overhead
diff --git a/src/search.c b/src/search.c
index 19e789dfa87..0cb1ec41f59 100644
--- a/src/search.c
+++ b/src/search.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/sheap.c b/src/sheap.c
index f7028b0cf76..09c1342bac1 100644
--- a/src/sheap.c
+++ b/src/sheap.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/sheap.h b/src/sheap.h
index 023db8c0fc3..f18eb2f1ce9 100644
--- a/src/sheap.h
+++ b/src/sheap.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <stddef.h>
#include "lisp.h"
diff --git a/src/sound.c b/src/sound.c
index 4714ac1796b..7a7f03d303a 100644
--- a/src/sound.c
+++ b/src/sound.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Gerd Moellmann <gerd@gnu.org>. Tested with Luigi's
driver on FreeBSD 2.2.7 with a SoundBlaster 16. */
@@ -293,6 +293,7 @@ static int do_play_sound (const char *, unsigned long);
/* BEGIN: Common functions */
+#ifndef WINDOWSNT
/* Like perror, but signals an error. */
static _Noreturn void
@@ -315,8 +316,6 @@ sound_perror (const char *msg)
error ("%s", msg);
}
-
-#ifndef WINDOWSNT
/* Display a warning message. */
static void
diff --git a/src/syntax.c b/src/syntax.c
index dcaca22f0e2..80603b4f8b3 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/syntax.h b/src/syntax.h
index f0bb9569cc7..2a7ba54e608 100644
--- a/src/syntax.h
+++ b/src/syntax.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYNTAX_H
#define EMACS_SYNTAX_H
diff --git a/src/sysdep.c b/src/sysdep.c
index 70f4a9dd7ea..e223a67787d 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -37,6 +37,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "sysselect.h"
#include "blockinput.h"
+#ifdef HAVE_LINUX_FS_H
+# include <linux/fs.h>
+# include <sys/syscall.h>
+#endif
+
+#ifdef CYGWIN
+# include <cygwin/fs.h>
+#endif
+
#if defined DARWIN_OS || defined __FreeBSD__
# include <sys/sysctl.h>
#endif
@@ -212,10 +221,29 @@ init_standard_fds (void)
}
/* Return the current working directory. The result should be freed
- with 'free'. Return NULL on errors. */
-char *
-emacs_get_current_dir_name (void)
+ with 'free'. Return NULL (setting errno) on errors. If the
+ current directory is unreachable, return either NULL or a string
+ beginning with '('. */
+
+static char *
+get_current_dir_name_or_unreachable (void)
{
+ /* Use malloc, not xmalloc, since this function can be called before
+ the xmalloc exception machinery is available. */
+
+ char *pwd;
+
+ /* The maximum size of a directory name, including the terminating null.
+ Leave room so that the caller can append a trailing slash. */
+ ptrdiff_t dirsize_max = min (PTRDIFF_MAX, SIZE_MAX) - 1;
+
+ /* The maximum size of a buffer for a file name, including the
+ terminating null. This is bounded by MAXPATHLEN, if available. */
+ ptrdiff_t bufsize_max = dirsize_max;
+#ifdef MAXPATHLEN
+ bufsize_max = min (bufsize_max, MAXPATHLEN);
+#endif
+
# if HAVE_GET_CURRENT_DIR_NAME && !BROKEN_GET_CURRENT_DIR_NAME
# ifdef HYBRID_MALLOC
bool use_libc = bss_sbrk_did_unexec;
@@ -223,55 +251,81 @@ emacs_get_current_dir_name (void)
bool use_libc = true;
# endif
if (use_libc)
- return get_current_dir_name ();
+ {
+ /* For an unreachable directory, this returns a string that starts
+ with "(unreachable)"; see Bug#27871. */
+ pwd = get_current_dir_name ();
+ if (pwd)
+ {
+ if (strlen (pwd) < dirsize_max)
+ return pwd;
+ free (pwd);
+ errno = ERANGE;
+ }
+ return NULL;
+ }
# endif
- char *buf;
- char *pwd = getenv ("PWD");
+ size_t pwdlen;
struct stat dotstat, pwdstat;
+ pwd = getenv ("PWD");
+
/* If PWD is accurate, use it instead of calling getcwd. PWD is
sometimes a nicer name, and using it may avoid a fatal error if a
parent directory is searchable but not readable. */
if (pwd
- && (IS_DIRECTORY_SEP (*pwd) || (*pwd && IS_DEVICE_SEP (pwd[1])))
+ && (pwdlen = strlen (pwd)) < bufsize_max
+ && IS_DIRECTORY_SEP (pwd[pwdlen && IS_DEVICE_SEP (pwd[1]) ? 2 : 0])
&& stat (pwd, &pwdstat) == 0
&& stat (".", &dotstat) == 0
&& dotstat.st_ino == pwdstat.st_ino
- && dotstat.st_dev == pwdstat.st_dev
-#ifdef MAXPATHLEN
- && strlen (pwd) < MAXPATHLEN
-#endif
- )
+ && dotstat.st_dev == pwdstat.st_dev)
{
- buf = malloc (strlen (pwd) + 1);
+ char *buf = malloc (pwdlen + 1);
if (!buf)
return NULL;
- strcpy (buf, pwd);
+ return memcpy (buf, pwd, pwdlen + 1);
}
else
{
- size_t buf_size = 1024;
- buf = malloc (buf_size);
+ ptrdiff_t buf_size = min (bufsize_max, 1024);
+ char *buf = malloc (buf_size);
if (!buf)
return NULL;
for (;;)
{
if (getcwd (buf, buf_size) == buf)
- break;
- if (errno != ERANGE)
+ return buf;
+ int getcwd_errno = errno;
+ if (getcwd_errno != ERANGE || buf_size == bufsize_max)
{
- int tmp_errno = errno;
free (buf);
- errno = tmp_errno;
+ errno = getcwd_errno;
return NULL;
}
- buf_size *= 2;
+ buf_size = buf_size <= bufsize_max / 2 ? 2 * buf_size : bufsize_max;
buf = realloc (buf, buf_size);
if (!buf)
return NULL;
}
}
- return buf;
+}
+
+/* Return the current working directory. The result should be freed
+ with 'free'. Return NULL (setting errno) on errors; an unreachable
+ directory (e.g., its name starts with '(') counts as an error. */
+
+char *
+emacs_get_current_dir_name (void)
+{
+ char *dir = get_current_dir_name_or_unreachable ();
+ if (dir && *dir == '(')
+ {
+ free (dir);
+ errno = ENOENT;
+ return NULL;
+ }
+ return dir;
}
@@ -454,7 +508,7 @@ child_setup_tty (int out)
s.main.c_oflag |= OPOST; /* Enable output postprocessing */
s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */
#ifdef NLDLY
- /* http://lists.gnu.org/archive/html/emacs-devel/2008-05/msg00406.html
+ /* https://lists.gnu.org/r/emacs-devel/2008-05/msg00406.html
Some versions of GNU Hurd do not have FFDLY? */
#ifdef FFDLY
s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY);
@@ -777,6 +831,8 @@ unblock_child_signal (sigset_t const *oldset)
pthread_sigmask (SIG_SETMASK, oldset, 0);
}
+#endif /* !MSDOS */
+
/* Block SIGINT. */
void
block_interrupt_signal (sigset_t *oldset)
@@ -794,7 +850,6 @@ restore_signal_mask (sigset_t const *oldset)
pthread_sigmask (SIG_SETMASK, oldset, 0);
}
-#endif /* !MSDOS */
/* Saving and restoring the process group of Emacs's terminal. */
@@ -1408,7 +1463,7 @@ reset_sys_modes (struct tty_display_info *tty_out)
{
if (noninteractive)
{
- fflush (stdout);
+ fflush_unlocked (stdout);
return;
}
if (!tty_out->term_initted)
@@ -1428,17 +1483,14 @@ reset_sys_modes (struct tty_display_info *tty_out)
}
else
{ /* have to do it the hard way */
- int i;
tty_turn_off_insert (tty_out);
- for (i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++)
- {
- fputc (' ', tty_out->output);
- }
+ for (int i = cursorX (tty_out); i < FrameCols (tty_out) - 1; i++)
+ fputc_unlocked (' ', tty_out->output);
}
cmgoto (tty_out, FrameRows (tty_out) - 1, 0);
- fflush (tty_out->output);
+ fflush_unlocked (tty_out->output);
if (tty_out->terminal->reset_terminal_modes_hook)
tty_out->terminal->reset_terminal_modes_hook (tty_out->terminal);
@@ -1775,7 +1827,7 @@ stack_overflow (siginfo_t *siginfo)
/* The known top and bottom of the stack. The actual stack may
extend a bit beyond these boundaries. */
char *bot = stack_bottom;
- char *top = near_C_stack_top ();
+ char *top = current_thread->stack_top;
/* Log base 2 of the stack heuristic ratio. This ratio is the size
of the known stack divided by the size of the guard area past the
@@ -2050,7 +2102,7 @@ init_signals (bool dumping)
thread_fatal_action.sa_flags = process_fatal_action.sa_flags;
/* SIGINT may need special treatment on MS-Windows. See
- http://lists.gnu.org/archive/html/emacs-devel/2010-09/msg01062.html
+ https://lists.gnu.org/r/emacs-devel/2010-09/msg01062.html
Please update the doc of kill-emacs, kill-emacs-hook, and
NEWS if you change this. */
@@ -2391,8 +2443,6 @@ emacs_open (const char *file, int oflags, int mode)
oflags |= O_CLOEXEC;
while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR)
maybe_quit ();
- if (! O_CLOEXEC && 0 <= fd)
- fcntl (fd, F_SETFD, FD_CLOEXEC);
return fd;
}
@@ -2434,13 +2484,7 @@ emacs_pipe (int fd[2])
#ifdef MSDOS
return pipe (fd);
#else /* !MSDOS */
- int result = pipe2 (fd, O_BINARY | O_CLOEXEC);
- if (! O_CLOEXEC && result == 0)
- {
- fcntl (fd[0], F_SETFD, FD_CLOEXEC);
- fcntl (fd[1], F_SETFD, FD_CLOEXEC);
- }
- return result;
+ return pipe2 (fd, O_BINARY | O_CLOEXEC);
#endif /* !MSDOS */
}
@@ -2681,6 +2725,29 @@ set_file_times (int fd, const char *filename,
timespec[1] = mtime;
return fdutimens (fd, filename, timespec);
}
+
+/* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST.
+ This is like renameat except that it fails if DST already exists,
+ or if this operation is not supported atomically. Return 0 if
+ successful, -1 (setting errno) otherwise. */
+int
+renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst)
+{
+#if defined SYS_renameat2 && defined RENAME_NOREPLACE
+ return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE);
+#elif defined CYGWIN && defined RENAME_NOREPLACE
+ return renameat2 (srcfd, src, dstfd, dst, RENAME_NOREPLACE);
+#elif defined RENAME_EXCL
+ return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL);
+#else
+# ifdef WINDOWSNT
+ if (srcfd == AT_FDCWD && dstfd == AT_FDCWD)
+ return sys_rename_replace (src, dst, 0);
+# endif
+ errno = ENOSYS;
+ return -1;
+#endif
+}
/* Like strsignal, except async-signal-safe, and this function typically
returns a string in the C locale rather than the current locale. */
@@ -2915,7 +2982,7 @@ list_system_processes (void)
process. */
procdir = build_string ("/proc");
match = build_string ("[0-9]+");
- proclist = directory_files_internal (procdir, Qnil, match, Qt, 0, Qnil);
+ proclist = directory_files_internal (procdir, Qnil, match, Qt, false, Qnil);
/* `proclist' gives process IDs as strings. Destructively convert
each string into a number. */
@@ -3079,7 +3146,7 @@ procfs_ttyname (int rdev)
char minor[25]; /* 2 32-bit numbers + dash */
char *endp;
- for (; !feof (fdev) && !ferror (fdev); name[0] = 0)
+ for (; !feof_unlocked (fdev) && !ferror_unlocked (fdev); name[0] = 0)
{
if (fscanf (fdev, "%*s %s %u %s %*s\n", name, &major, minor) >= 3
&& major == MAJOR (rdev))
@@ -3129,7 +3196,7 @@ procfs_get_total_memory (void)
break;
case 0:
- while ((c = getc (fmem)) != EOF && c != '\n')
+ while ((c = getc_unlocked (fmem)) != EOF && c != '\n')
continue;
done = c == EOF;
break;
diff --git a/src/sysselect.h b/src/sysselect.h
index 2ddea665b30..4d8a4d0a3a9 100644
--- a/src/sysselect.h
+++ b/src/sysselect.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef SYSSELECT_H
#define SYSSELECT_H 1
@@ -50,6 +50,11 @@ typedef int fd_set;
#endif
#ifdef MSDOS
+/* The above #define for 'select' gets in the way because sysselect.h
+ is included in thread.h, which is included everywhere, and 'select'
+ declared in DJGPP system headers has a signature incompatible with
+ 'pselect', which we emulate in msdos.c. */
+#undef select
#define pselect sys_select
#endif
diff --git a/src/syssignal.h b/src/syssignal.h
index 8b815a29a35..61e1c5f60e8 100644
--- a/src/syssignal.h
+++ b/src/syssignal.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSSIGNAL_H
#define EMACS_SYSSIGNAL_H
diff --git a/src/sysstdio.h b/src/sysstdio.h
index 45ee33f5580..87d62afc3d7 100644
--- a/src/sysstdio.h
+++ b/src/sysstdio.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSSTDIO_H
#define EMACS_SYSSTDIO_H
@@ -33,4 +33,45 @@ extern FILE *emacs_fopen (char const *, char const *);
# define FOPEN_TEXT ""
#endif
+/* These are compatible with unlocked-io.h, if both files are included. */
+#if !HAVE_DECL_CLEARERR_UNLOCKED
+# define clearerr_unlocked(x) clearerr (x)
+#endif
+#if !HAVE_DECL_FEOF_UNLOCKED
+# define feof_unlocked(x) feof (x)
+#endif
+#if !HAVE_DECL_FERROR_UNLOCKED
+# define ferror_unlocked(x) ferror (x)
+#endif
+#if !HAVE_DECL_FFLUSH_UNLOCKED
+# define fflush_unlocked(x) fflush (x)
+#endif
+#if !HAVE_DECL_FGETS_UNLOCKED
+# define fgets_unlocked(x,y,z) fgets (x,y,z)
+#endif
+#if !HAVE_DECL_FPUTC_UNLOCKED
+# define fputc_unlocked(x,y) fputc (x,y)
+#endif
+#if !HAVE_DECL_FPUTS_UNLOCKED
+# define fputs_unlocked(x,y) fputs (x,y)
+#endif
+#if !HAVE_DECL_FREAD_UNLOCKED
+# define fread_unlocked(w,x,y,z) fread (w,x,y,z)
+#endif
+#if !HAVE_DECL_FWRITE_UNLOCKED
+# define fwrite_unlocked(w,x,y,z) fwrite (w,x,y,z)
+#endif
+#if !HAVE_DECL_GETC_UNLOCKED
+# define getc_unlocked(x) getc (x)
+#endif
+#if !HAVE_DECL_GETCHAR_UNLOCKED
+# define getchar_unlocked() getchar ()
+#endif
+#if !HAVE_DECL_PUTC_UNLOCKED
+# define putc_unlocked(x,y) putc (x,y)
+#endif
+#if !HAVE_DECL_PUTCHAR_UNLOCKED
+# define putchar_unlocked(x) putchar (x)
+#endif
+
#endif /* EMACS_SYSSTDIO_H */
diff --git a/src/systhread.c b/src/systhread.c
index a84060c18f0..6f9baabaf2e 100644
--- a/src/systhread.c
+++ b/src/systhread.c
@@ -14,12 +14,16 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <setjmp.h>
#include "lisp.h"
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#ifndef THREADS_ENABLED
void
@@ -130,6 +134,13 @@ void
sys_cond_broadcast (sys_cond_t *cond)
{
pthread_cond_broadcast (cond);
+#ifdef HAVE_NS
+ /* Send an app defined event to break out of the NS run loop.
+ It seems that if ns_select is running the NS run loop, this
+ broadcast has no effect until the loop is done, breaking a couple
+ of tests in thread-tests.el. */
+ ns_run_loop_break ();
+#endif
}
void
@@ -176,7 +187,7 @@ sys_thread_yield (void)
#elif defined (WINDOWSNT)
-#include <windows.h>
+#include <w32term.h>
/* Cannot include <process.h> because of the local header by the same
name, sigh. */
@@ -315,8 +326,9 @@ sys_thread_self (void)
static thread_creation_function *thread_start_address;
/* _beginthread wants a void function, while we are passed a function
- that returns a pointer. So we use a wrapper. */
-static void
+ that returns a pointer. So we use a wrapper. See the command in
+ w32term.h about the need for ALIGN_STACK attribute. */
+static void ALIGN_STACK
w32_beginthread_wrapper (void *arg)
{
(void)thread_start_address (arg);
diff --git a/src/systhread.h b/src/systhread.h
index c7999c0651d..443dc55c6a4 100644
--- a/src/systhread.h
+++ b/src/systhread.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef SYSTHREAD_H
#define SYSTHREAD_H
diff --git a/src/systime.h b/src/systime.h
index d79eb213960..f9f1db35eb8 100644
--- a/src/systime.h
+++ b/src/systime.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSTIME_H
#define EMACS_SYSTIME_H
diff --git a/src/systty.h b/src/systty.h
index 9f2c61e0d69..a5ffc7b1d71 100644
--- a/src/systty.h
+++ b/src/systty.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_SYSTTY_H
#define EMACS_SYSTTY_H
diff --git a/src/syswait.h b/src/syswait.h
index 055562ae48b..939c16f4fb6 100644
--- a/src/syswait.h
+++ b/src/syswait.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Define the structure that the wait system call stores.
On many systems, there is a structure defined for this.
diff --git a/src/term.c b/src/term.c
index 8770aff8a92..7d6998d6a4e 100644
--- a/src/term.c
+++ b/src/term.c
@@ -15,14 +15,13 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* New redisplay, TTY faces by Gerd Moellmann <gerd@gnu.org>. */
#include <config.h>
#include <errno.h>
#include <fcntl.h>
-#include <stdio.h>
#include <stdlib.h>
#include <sys/file.h>
#include <sys/time.h>
@@ -45,6 +44,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "blockinput.h"
#include "syssignal.h"
+#include "sysstdio.h"
#ifdef MSDOS
#include "msdos.h"
static int been_here = -1;
@@ -146,7 +146,7 @@ tty_ring_bell (struct frame *f)
OUTPUT (tty, (tty->TS_visible_bell && visible_bell
? tty->TS_visible_bell
: tty->TS_bell));
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
}
@@ -155,21 +155,26 @@ tty_ring_bell (struct frame *f)
static void
tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym)
{
- Lisp_Object lisp_terminal;
- Lisp_Object extra_codes;
+ /* Use only accessors like CDR_SAFE and assq_no_quit to avoid any
+ form of quitting or signaling an error, since this function can
+ run as part of the "emergency escape" procedure invoked in the
+ middle of GC, where quitting means crashing (Bug#17406). */
+ if (! terminal->name)
+ return;
struct tty_display_info *tty = terminal->display_info.tty;
- XSETTERMINAL (lisp_terminal, terminal);
- for (extra_codes = Fterminal_parameter (lisp_terminal, sym);
+ for (Lisp_Object extra_codes
+ = CDR_SAFE (assq_no_quit (sym, terminal->param_alist));
CONSP (extra_codes);
extra_codes = XCDR (extra_codes))
{
Lisp_Object string = XCAR (extra_codes);
if (STRINGP (string))
{
- fwrite (SDATA (string), 1, SBYTES (string), tty->output);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string), tty->output);
if (tty->termscript)
- fwrite (SDATA (string), 1, SBYTES (string), tty->termscript);
+ fwrite_unlocked (SDATA (string), 1, SBYTES (string),
+ tty->termscript);
}
}
}
@@ -197,7 +202,7 @@ tty_set_terminal_modes (struct terminal *terminal)
OUTPUT_IF (tty, tty->TS_keypad_mode);
losecursor (tty);
tty_send_additional_strings (terminal, Qtty_mode_set_strings);
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
}
@@ -220,7 +225,7 @@ tty_reset_terminal_modes (struct terminal *terminal)
/* Output raw CR so kernel can track the cursor hpos. */
current_tty = tty;
cmputc ('\r');
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
}
@@ -235,7 +240,7 @@ tty_update_end (struct frame *f)
tty_show_cursor (tty);
tty_turn_off_insert (tty);
tty_background_highlight (tty);
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
/* The implementation of set_terminal_window for termcap frames. */
@@ -497,8 +502,8 @@ tty_clear_end_of_line (struct frame *f, int first_unused_hpos)
for (i = curX (tty); i < first_unused_hpos; i++)
{
if (tty->termscript)
- fputc (' ', tty->termscript);
- fputc (' ', tty->output);
+ fputc_unlocked (' ', tty->termscript);
+ fputc_unlocked (' ', tty->output);
}
cmplus (tty, first_unused_hpos - curX (tty));
}
@@ -771,11 +776,11 @@ tty_write_glyphs (struct frame *f, struct glyph *string, int len)
if (coding->produced > 0)
{
block_input ();
- fwrite (conversion_buffer, 1, coding->produced, tty->output);
- if (ferror (tty->output))
- clearerr (tty->output);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
+ clearerr_unlocked (tty->output);
if (tty->termscript)
- fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced,
+ tty->termscript);
unblock_input ();
}
string += n;
@@ -832,11 +837,11 @@ tty_write_glyphs_with_face (register struct frame *f, register struct glyph *str
if (coding->produced > 0)
{
block_input ();
- fwrite (conversion_buffer, 1, coding->produced, tty->output);
- if (ferror (tty->output))
- clearerr (tty->output);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
+ clearerr_unlocked (tty->output);
if (tty->termscript)
- fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced,
+ tty->termscript);
unblock_input ();
}
@@ -918,11 +923,11 @@ tty_insert_glyphs (struct frame *f, struct glyph *start, int len)
if (coding->produced > 0)
{
block_input ();
- fwrite (conversion_buffer, 1, coding->produced, tty->output);
- if (ferror (tty->output))
- clearerr (tty->output);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced, tty->output);
+ clearerr_unlocked (tty->output);
if (tty->termscript)
- fwrite (conversion_buffer, 1, coding->produced, tty->termscript);
+ fwrite_unlocked (conversion_buffer, 1, coding->produced,
+ tty->termscript);
unblock_input ();
}
@@ -1209,6 +1214,7 @@ struct fkey_table {
const char *cap, *name;
};
+#ifndef DOS_NT
/* Termcap capability names that correspond directly to X keysyms.
Some of these (marked "terminfo") aren't supplied by old-style
(Berkeley) termcap entries. They're listed in X keysym order;
@@ -1312,7 +1318,6 @@ static const struct fkey_table keys[] =
{"!3", "S-undo"} /*shifted undo key*/
};
-#ifndef DOS_NT
static char **term_get_fkeys_address;
static KBOARD *term_get_fkeys_kboard;
static Lisp_Object term_get_fkeys_1 (void);
@@ -1584,10 +1589,16 @@ produce_glyphs (struct it *it)
{
int absolute_x = (it->current_x
+ it->continuation_lines_width);
+ int x0 = absolute_x;
+ /* Adjust for line numbers. */
+ if (!NILP (Vdisplay_line_numbers))
+ absolute_x -= it->lnum_pixel_width;
int next_tab_x
= (((1 + absolute_x + it->tab_width - 1)
/ it->tab_width)
* it->tab_width);
+ if (!NILP (Vdisplay_line_numbers))
+ next_tab_x += it->lnum_pixel_width;
int nspaces;
/* If part of the TAB has been displayed on the previous line
@@ -1595,7 +1606,7 @@ produce_glyphs (struct it *it)
been incremented already by the part that fitted on the
continued line. So, we will get the right number of spaces
here. */
- nspaces = next_tab_x - absolute_x;
+ nspaces = next_tab_x - x0;
if (it->glyph_row)
{
@@ -2046,7 +2057,7 @@ TERMINAL does not refer to a text terminal. */)
/* Declare here rather than in the function, as in the rest of Emacs,
to work around an HPUX compiler bug (?). See
- http://lists.gnu.org/archive/html/emacs-devel/2007-08/msg00410.html */
+ https://lists.gnu.org/r/emacs-devel/2007-08/msg00410.html */
static int default_max_colors;
static int default_no_color_video;
static char *default_orig_pair;
@@ -3327,7 +3338,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
which calls tty_show_cursor. Re-hide it, so it doesn't show
through the menus. */
tty_hide_cursor (tty);
- fflush (tty->output);
+ fflush_unlocked (tty->output);
}
sf->mouse_moved = 0;
@@ -3335,7 +3346,7 @@ tty_menu_activate (tty_menu *menu, int *pane, int *selidx,
while (statecount--)
free_saved_screen (state[statecount].screen_behind);
tty_show_cursor (tty); /* Turn cursor back on. */
- fflush (tty->output);
+ fflush_unlocked (tty->output);
/* Clean up any mouse events that are waiting inside Emacs event queue.
These events are likely to be generated before the menu was even
diff --git a/src/termcap.c b/src/termcap.c
index a0e558d9cac..6942c33daec 100644
--- a/src/termcap.c
+++ b/src/termcap.c
@@ -13,7 +13,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Emacs config.h may rename various library functions such as malloc. */
#include <config.h>
diff --git a/src/termchar.h b/src/termchar.h
index cf061a97806..3e1695d075e 100644
--- a/src/termchar.h
+++ b/src/termchar.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_TERMCHAR_H
#define EMACS_TERMCHAR_H
diff --git a/src/termhooks.h b/src/termhooks.h
index 14ec397346a..fe4e993c968 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_TERMHOOKS_H
#define EMACS_TERMHOOKS_H
@@ -116,7 +116,9 @@ enum event_kind
.frame_or_window gives the frame
the wheel event occurred in.
.timestamp gives a timestamp (in
- milliseconds) for the event. */
+ milliseconds) for the event.
+ .arg may contain the number of
+ lines to scroll. */
HORIZ_WHEEL_EVENT, /* A wheel event generated by a second
horizontal wheel that is present on some
mice. See WHEEL_EVENT. */
@@ -371,7 +373,7 @@ extern struct tty_display_info *gpm_tty;
struct terminal
{
/* This is for Lisp; the terminal code does not refer to it. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* Parameter alist of this terminal. */
Lisp_Object param_alist;
@@ -623,7 +625,7 @@ struct terminal
TERMINAL indicates which terminal device to read from. Input
events should be read into HOLD_QUIT.
- A positive return value indicates that that many input events
+ A positive return value N indicates that N input events
were read into BUF.
Zero means no events were immediately available.
A value of -1 means a transient read error, while -2 indicates
diff --git a/src/terminal.c b/src/terminal.c
index 367f2ac7192..0edaad65c7f 100644
--- a/src/terminal.c
+++ b/src/terminal.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/terminfo.c b/src/terminfo.c
index 1a0c0133dd8..046d00acee9 100644
--- a/src/terminfo.c
+++ b/src/terminfo.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include "tparam.h"
diff --git a/src/termopts.h b/src/termopts.h
index a78c5f03afe..e1c5f2b7b3c 100644
--- a/src/termopts.h
+++ b/src/termopts.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_TERMOPTS_H
#define EMACS_TERMOPTS_H
diff --git a/src/textprop.c b/src/textprop.c
index 225ff28e57e..513780c3009 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/thread.c b/src/thread.c
index e3787971a53..dd466818ef9 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -101,14 +101,20 @@ acquire_global_lock (struct thread_state *self)
post_acquire_global_lock (self);
}
-/* This is called from keyboard.c when it detects that SIGINT
- interrupted thread_select before the current thread could acquire
- the lock. We must acquire the lock to prevent a thread from
- running without holding the global lock, and to avoid repeated
- calls to sys_mutex_unlock, which invokes undefined behavior. */
+/* This is called from keyboard.c when it detects that SIGINT was
+ delivered to the main thread and interrupted thread_select before
+ the main thread could acquire the lock. We must acquire the lock
+ to prevent a thread from running without holding the global lock,
+ and to avoid repeated calls to sys_mutex_unlock, which invokes
+ undefined behavior. */
void
maybe_reacquire_global_lock (void)
{
+ /* SIGINT handler is always run on the main thread, see
+ deliver_process_signal, so reflect that in our thread-tracking
+ variables. */
+ current_thread = &main_thread;
+
if (current_thread->not_holding_lock)
{
struct thread_state *self = current_thread;
@@ -567,8 +573,15 @@ really_call_select (void *arg)
sa->timeout, sa->sigmask);
block_interrupt_signal (&oldset);
- acquire_global_lock (self);
- self->not_holding_lock = 0;
+ /* If we were interrupted by C-g while inside sa->func above, the
+ signal handler could have called maybe_reacquire_global_lock, in
+ which case we are already holding the lock and shouldn't try
+ taking it again, or else we will hang forever. */
+ if (self->not_holding_lock)
+ {
+ acquire_global_lock (self);
+ self->not_holding_lock = 0;
+ }
restore_signal_mask (&oldset);
}
@@ -595,14 +608,15 @@ thread_select (select_func *func, int max_fds, fd_set *rfds,
static void
mark_one_thread (struct thread_state *thread)
{
- struct handler *handler;
- Lisp_Object tem;
+ /* Get the stack top now, in case mark_specpdl changes it. */
+ void *stack_top = thread->stack_top;
mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr);
- mark_stack (thread->m_stack_bottom, thread->stack_top);
+ mark_stack (thread->m_stack_bottom, stack_top);
- for (handler = thread->m_handlerlist; handler; handler = handler->next)
+ for (struct handler *handler = thread->m_handlerlist;
+ handler; handler = handler->next)
{
mark_object (handler->tag_or_ch);
mark_object (handler->val);
@@ -610,6 +624,7 @@ mark_one_thread (struct thread_state *thread)
if (thread->m_current_buffer)
{
+ Lisp_Object tem;
XSETBUFFER (tem, thread->m_current_buffer);
mark_object (tem);
}
@@ -798,7 +813,11 @@ If NAME is given, it must be a string; it names the new thread. */)
{
/* Restore the previous situation. */
all_threads = all_threads->next_thread;
+#ifdef THREADS_ENABLED
error ("Could not start a new thread");
+#else
+ error ("Concurrency is not supported in this configuration");
+#endif
}
/* FIXME: race here where new thread might not be filled in? */
diff --git a/src/thread.h b/src/thread.h
index 9e94de5c175..1845974bc28 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef THREAD_H
#define THREAD_H
@@ -25,13 +25,17 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <sys/socket.h>
#endif
+#ifdef MSDOS
+#include <signal.h> /* sigset_t */
+#endif
+
#include "sysselect.h" /* FIXME */
#include "systime.h" /* FIXME */
#include "systhread.h"
struct thread_state
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The buffer in which the last search was performed, or
Qt if the last search was done in a string;
@@ -62,8 +66,14 @@ struct thread_state
char *m_stack_bottom;
#define stack_bottom (current_thread->m_stack_bottom)
- /* An address near the top of the stack. */
- char *stack_top;
+ /* The address of an object near the C stack top, used to determine
+ which words need to be scanned by the garbage collector. This is
+ also used to detect heuristically whether segmentation violation
+ address indicates stack overflow, as opposed to some internal
+ error in Emacs. If the C function F calls G which calls H which
+ calls ... F, then at least one of the functions in the chain
+ should set this to the address of a local variable. */
+ void *stack_top;
struct catchtag *m_catchlist;
#define catchlist (current_thread->m_catchlist)
@@ -152,6 +162,13 @@ struct thread_state
bool m_waiting_for_input;
#define waiting_for_input (current_thread->m_waiting_for_input)
+ /* For longjmp to where kbd input is being done. This is per-thread
+ so that if more than one thread calls read_char, they don't
+ clobber each other's getcjmp, which will cause
+ quit_throw_to_read_char crash due to using a wrong stack. */
+ sys_jmp_buf m_getcjmp;
+#define getcjmp (current_thread->m_getcjmp)
+
/* The OS identifier for this thread. */
sys_thread_t thread_id;
@@ -213,7 +230,7 @@ typedef struct
/* A mutex as a lisp object. */
struct Lisp_Mutex
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The name of the mutex, or nil. */
Lisp_Object name;
@@ -244,7 +261,7 @@ XMUTEX (Lisp_Object a)
/* A condition variable as a lisp object. */
struct Lisp_CondVar
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The associated mutex. */
Lisp_Object mutex;
diff --git a/src/tparam.c b/src/tparam.c
index 7a4adc2dc94..ff145729cd0 100644
--- a/src/tparam.c
+++ b/src/tparam.c
@@ -13,7 +13,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* Emacs config.h may rename various library functions such as malloc. */
#include <config.h>
@@ -125,6 +125,7 @@ tparam1 (const char *string, char *outstring, int len,
goto onedigit;
if (tem < 100)
goto twodigit;
+ FALLTHROUGH;
case '3': /* %3 means output in decimal, 3 digits. */
if (tem > 999)
{
@@ -132,6 +133,7 @@ tparam1 (const char *string, char *outstring, int len,
tem %= 1000;
}
*op++ = tem / 100 + '0';
+ FALLTHROUGH;
case '2': /* %2 means output in decimal, 2 digits. */
twodigit:
tem %= 100;
@@ -140,10 +142,12 @@ tparam1 (const char *string, char *outstring, int len,
*op++ = tem % 10 + '0';
argp++;
break;
+
case 'p': /* %pN means use param N for next subst. */
tem = fixed_argp[(*p++) - '1'];
explicit_param_p = true;
break;
+
case 'C':
/* For c-100: print quotient of value by 96, if nonzero,
then do like %+. */
@@ -152,8 +156,10 @@ tparam1 (const char *string, char *outstring, int len,
*op++ = tem / 96;
tem %= 96;
}
+ FALLTHROUGH;
case '+': /* %+x means add character code of char x. */
tem += *p++;
+ FALLTHROUGH;
case '.': /* %. means output as character. */
if (left)
{
@@ -173,6 +179,7 @@ tparam1 (const char *string, char *outstring, int len,
}
}
*op++ = tem ? tem : 0200;
+ FALLTHROUGH;
case 'f': /* %f means discard next arg. */
argp++;
break;
diff --git a/src/tparam.h b/src/tparam.h
index 02136b6ca58..7ae2a10c2f5 100644
--- a/src/tparam.h
+++ b/src/tparam.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_TPARAM_H
#define EMACS_TPARAM_H
diff --git a/src/undo.c b/src/undo.c
index a4ae40cbc49..d9a56872dca 100644
--- a/src/undo.c
+++ b/src/undo.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/unexaix.c b/src/unexaix.c
index 75a79c66d0a..7698af0f01a 100644
--- a/src/unexaix.c
+++ b/src/unexaix.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
In other words, you are welcome to use, share and improve this program.
diff --git a/src/unexcoff.c b/src/unexcoff.c
index 9852c14553a..1a42c84a9b7 100644
--- a/src/unexcoff.c
+++ b/src/unexcoff.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
diff --git a/src/unexcw.c b/src/unexcw.c
index 8e5d7e89f19..55206ccffae 100644
--- a/src/unexcw.c
+++ b/src/unexcw.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include "unexec.h"
diff --git a/src/unexelf.c b/src/unexelf.c
index 7fad64fab17..756de5835ce 100644
--- a/src/unexelf.c
+++ b/src/unexelf.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
In other words, you are welcome to use, share and improve this program.
@@ -58,9 +58,11 @@ what you give them. Help stamp out software-hoarding! */
#include <sys/types.h>
#include <unistd.h>
-#if !defined (__NetBSD__) && !defined (__OpenBSD__)
-#include <elf.h>
-#endif /* not __NetBSD__ and not __OpenBSD__ */
+#ifdef __QNX__
+# include <sys/elf.h>
+#elif !defined __NetBSD__ && !defined __OpenBSD__
+# include <elf.h>
+#endif
#include <sys/mman.h>
#if defined (_SYSTYPE_SYSV)
#include <sys/elf_mips.h>
@@ -222,7 +224,6 @@ unexec (const char *new_name, const char *old_name)
{
int new_file, old_file;
off_t new_file_size;
- void *new_break;
/* Pointers to the base of the image of the two files. */
caddr_t old_base, new_base;
@@ -326,11 +327,13 @@ unexec (const char *new_name, const char *old_name)
if (old_bss_index == -1)
fatal ("no bss section found");
+ void *no_break = (void *) (intptr_t) -1;
+ void *new_break = no_break;
#ifdef HAVE_SBRK
new_break = sbrk (0);
-#else
- new_break = (byte *) old_bss_addr + old_bss_size;
#endif
+ if (new_break == no_break)
+ new_break = (byte *) old_bss_addr + old_bss_size;
new_bss_addr = (ElfW (Addr)) new_break;
bss_size_growth = new_bss_addr - old_bss_addr;
new_data2_size = bss_size_growth;
@@ -576,7 +579,17 @@ unexec (const char *new_name, const char *old_name)
}
/* This loop seeks out relocation sections for the data section, so
- that it can undo relocations performed by the runtime loader. */
+ that it can undo relocations performed by the runtime loader.
+
+ The following approach does not work on x86 platforms that use
+ the GNU Gold linker, which can generate .rel.dyn relocation
+ sections containing R_386_32 entries that the following code does
+ not grok. Emacs works around this problem by avoiding C
+ constructs that generate such entries, which is horrible hack.
+
+ FIXME: Presumably more problems like this will crop up as linkers
+ get fancier. We really need to stop assuming that Emacs can grok
+ arbitrary linker output. See Bug#27248. */
for (n = new_file_h->e_shnum; 0 < --n; )
{
ElfW (Shdr) *rel_shdr = &NEW_SECTION_H (n);
diff --git a/src/unexmacosx.c b/src/unexmacosx.c
index 3b1efa3ca30..7fb5750cef2 100644
--- a/src/unexmacosx.c
+++ b/src/unexmacosx.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Contributed by Andrew Choi (akochoi@mac.com). */
diff --git a/src/unexw32.c b/src/unexw32.c
index 904447c3ec9..e97a52ba07a 100644
--- a/src/unexw32.c
+++ b/src/unexw32.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Geoff Voelker (voelker@cs.washington.edu) 8-12-94
@@ -357,7 +357,7 @@ get_section_info (file_data *p_infile)
/* Check the NT header signature ... */
if (nt_header->Signature != IMAGE_NT_SIGNATURE)
{
- printf ("Invalid IMAGE_NT_SIGNATURE 0x%x in %s...bailing.\n",
+ printf ("Invalid IMAGE_NT_SIGNATURE 0x%lx in %s...bailing.\n",
nt_header->Signature, p_infile->name);
exit (1);
}
@@ -470,6 +470,12 @@ get_section_info (file_data *p_infile)
}
}
+/* Format to print a DWORD_PTR value. */
+#if defined MINGW_W64 && defined _WIN64
+# define pDWP "16llx"
+#else
+# define pDWP "08lx"
+#endif
/* The dump routines. */
@@ -490,13 +496,13 @@ copy_executable_and_dump_data (file_data *p_infile,
#define COPY_CHUNK(message, src, size, verbose) \
do { \
unsigned char *s = (void *)(src); \
- unsigned long count = (size); \
+ DWORD_PTR count = (size); \
if (verbose) \
{ \
printf ("%s\n", (message)); \
- printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \
- printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \
- printf ("\t0x%08x Size in bytes.\n", count); \
+ printf ("\t0x%"pDWP" Offset in input file.\n", (DWORD_PTR)(s - p_infile->file_base)); \
+ printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \
+ printf ("\t0x%"pDWP" Size in bytes.\n", count); \
} \
memcpy (dst, s, count); \
dst += count; \
@@ -505,15 +511,15 @@ copy_executable_and_dump_data (file_data *p_infile,
#define COPY_PROC_CHUNK(message, src, size, verbose) \
do { \
unsigned char *s = (void *)(src); \
- unsigned long count = (size); \
+ DWORD_PTR count = (size); \
if (verbose) \
{ \
printf ("%s\n", (message)); \
printf ("\t0x%p Address in process.\n", s); \
printf ("\t0x%p Base output file.\n", p_outfile->file_base); \
- printf ("\t0x%p Offset in output file.\n", dst - p_outfile->file_base); \
+ printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \
printf ("\t0x%p Address in output file.\n", dst); \
- printf ("\t0x%p Size in bytes.\n", count); \
+ printf ("\t0x%"pDWP" Size in bytes.\n", count); \
} \
memcpy (dst, s, count); \
dst += count; \
@@ -739,7 +745,7 @@ unexec (const char *new_name, const char *old_name)
/* Open the undumped executable file. */
if (!open_input_file (&in_file, in_filename))
{
- printf ("Failed to open %s (%d)...bailing.\n",
+ printf ("Failed to open %s (%lu)...bailing.\n",
in_filename, GetLastError ());
exit (1);
}
@@ -754,7 +760,7 @@ unexec (const char *new_name, const char *old_name)
extra_bss_size_static;
if (!open_output_file (&out_file, out_filename, size))
{
- printf ("Failed to open %s (%d)...bailing.\n",
+ printf ("Failed to open %s (%lu)...bailing.\n",
out_filename, GetLastError ());
exit (1);
}
diff --git a/src/vm-limit.c b/src/vm-limit.c
index bb38b445b10..703238bf6ce 100644
--- a/src/vm-limit.c
+++ b/src/vm-limit.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <unistd.h> /* for 'environ', on AIX */
diff --git a/src/w16select.c b/src/w16select.c
index 70037f3ca7d..0ecd39b7afa 100644
--- a/src/w16select.c
+++ b/src/w16select.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* These functions work by using WinOldAp interface. WinOldAp
(WINOLDAP.MOD) is a Microsoft Windows extension supporting
diff --git a/src/w32.c b/src/w32.c
index fa3cbe183fb..fb13bd7d070 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Geoff Voelker (voelker@cs.washington.edu) 7-29-94
@@ -74,7 +74,6 @@ char *sys_ctime (const time_t *);
int sys_chdir (const char *);
int sys_creat (const char *, int);
FILE *sys_fopen (const char *, const char *);
-int sys_mkdir (const char *);
int sys_open (const char *, int, int);
int sys_rename (char const *, char const *);
int sys_rmdir (const char *);
@@ -83,6 +82,10 @@ int sys_dup2 (int, int);
int sys_read (int, char *, unsigned int);
int sys_write (int, const void *, unsigned int);
struct tm *sys_localtime (const time_t *);
+/* MinGW64 system headers include string.h too early, causing the
+ compiler to emit a warning about sys_strerror having no
+ prototype. */
+char *sys_strerror (int);
#ifdef HAVE_MODULES
extern void dynlib_reset_last_error (void);
@@ -1499,7 +1502,7 @@ w32_valid_pointer_p (void *p, int size)
. Turning on w32-unicode-filename on Windows 9X (if it at all
works) requires UNICOWS.DLL, which is thus a requirement even in
- non-GUI sessions, something the we previously avoided. */
+ non-GUI sessions, something that we previously avoided. */
@@ -3380,6 +3383,7 @@ map_w32_filename (const char * name, const char ** pPath)
if ( ! left )
str[-1] = c; /* replace last character of part */
/* FALLTHRU */
+ FALLTHROUGH;
default:
if ( left && 'A' <= c && c <= 'Z' )
{
@@ -3888,15 +3892,32 @@ int
faccessat (int dirfd, const char * path, int mode, int flags)
{
DWORD attributes;
+ char fullname[MAX_UTF8_PATH];
+ /* Rely on a hack: an open directory is modeled as file descriptor 0,
+ and its actual file name is stored in dir_pathname by opendir.
+ This is good enough for the current usage in Emacs, but is fragile. */
if (dirfd != AT_FDCWD
&& !(IS_DIRECTORY_SEP (path[0])
|| IS_DEVICE_SEP (path[1])))
{
- errno = EBADF;
- return -1;
+ char lastc = dir_pathname[strlen (dir_pathname) - 1];
+
+ if (_snprintf (fullname, sizeof fullname, "%s%s%s",
+ dir_pathname, IS_DIRECTORY_SEP (lastc) ? "" : "/", path)
+ < 0)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+ path = fullname;
}
+ /* When dired.c calls us with F_OK and a trailing slash, it actually
+ wants to know whether PATH is a directory. */
+ if (IS_DIRECTORY_SEP (path[strlen (path) - 1]) && mode == F_OK)
+ mode |= D_OK;
+
/* MSVCRT implementation of 'access' doesn't recognize D_OK, and its
newer versions blow up when passed D_OK. */
path = map_w32_filename (path, NULL);
@@ -3942,6 +3963,7 @@ faccessat (int dirfd, const char * path, int mode, int flags)
goto check_attrs;
}
/* FALLTHROUGH */
+ FALLTHROUGH;
case ERROR_FILE_NOT_FOUND:
case ERROR_BAD_NETPATH:
errno = ENOENT;
@@ -4344,7 +4366,7 @@ sys_link (const char * old, const char * new)
}
int
-sys_mkdir (const char * path)
+sys_mkdir (const char * path, mode_t mode)
{
path = map_w32_filename (path, NULL);
@@ -4397,61 +4419,6 @@ sys_open (const char * path, int oflag, int mode)
return res;
}
-/* Implementation of mkostemp for MS-Windows, to avoid race conditions
- when using mktemp.
-
- Standard algorithm for generating a temporary file name seems to be
- use pid or tid with a letter on the front (in place of the 6 X's)
- and cycle through the letters to find a unique name. We extend
- that to allow any reasonable character as the first of the 6 X's,
- so that the number of simultaneously used temporary files will be
- greater. */
-
-int
-mkostemp (char * template, int flags)
-{
- char * p;
- int i, fd = -1;
- unsigned uid = GetCurrentThreadId ();
- int save_errno = errno;
- static char first_char[] = "abcdefghijklmnopqrstuvwyz0123456789!%-_@#";
-
- errno = EINVAL;
- if (template == NULL)
- return -1;
-
- p = template + strlen (template);
- i = 5;
- /* replace up to the last 5 X's with uid in decimal */
- while (--p >= template && p[0] == 'X' && --i >= 0)
- {
- p[0] = '0' + uid % 10;
- uid /= 10;
- }
-
- if (i < 0 && p[0] == 'X')
- {
- i = 0;
- do
- {
- p[0] = first_char[i];
- if ((fd = sys_open (template,
- flags | _O_CREAT | _O_EXCL | _O_RDWR,
- S_IRUSR | S_IWUSR)) >= 0
- || errno != EEXIST)
- {
- if (fd >= 0)
- errno = save_errno;
- return fd;
- }
- }
- while (++i < sizeof (first_char));
- }
-
- /* Template is badly formed or else we can't generate a unique name. */
- return -1;
-}
-
int
fchmod (int fd, mode_t mode)
{
@@ -4543,29 +4510,48 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force)
filename_to_utf16 (temp, temp_w);
filename_to_utf16 (newname, newname_w);
result = _wrename (temp_w, newname_w);
- if (result < 0 && force)
+ if (result < 0)
{
DWORD w32err = GetLastError ();
if (errno == EACCES
&& newname_dev != oldname_dev)
{
+ DWORD attributes;
/* The implementation of `rename' on Windows does not return
errno = EXDEV when you are moving a directory to a
different storage device (ex. logical disk). It returns
EACCES instead. So here we handle such situations and
return EXDEV. */
- DWORD attributes;
-
if ((attributes = GetFileAttributesW (temp_w)) != -1
&& (attributes & FILE_ATTRIBUTE_DIRECTORY))
errno = EXDEV;
}
- else if (errno == EEXIST)
+ else if (errno == EEXIST && force)
{
+ DWORD attributes_old;
+ DWORD attributes_new;
+
if (_wchmod (newname_w, 0666) != 0)
return result;
- if (_wunlink (newname_w) != 0)
+ attributes_old = GetFileAttributesW (temp_w);
+ attributes_new = GetFileAttributesW (newname_w);
+ if (attributes_old != -1 && attributes_new != -1
+ && ((attributes_old & FILE_ATTRIBUTE_DIRECTORY)
+ != (attributes_new & FILE_ATTRIBUTE_DIRECTORY)))
+ {
+ if ((attributes_old & FILE_ATTRIBUTE_DIRECTORY) != 0)
+ errno = ENOTDIR;
+ else
+ errno = EISDIR;
+ return -1;
+ }
+ if ((attributes_new & FILE_ATTRIBUTE_DIRECTORY) != 0)
+ {
+ if (_wrmdir (newname_w) != 0)
+ return result;
+ }
+ else if (_wunlink (newname_w) != 0)
return result;
result = _wrename (temp_w, newname_w);
}
@@ -4587,7 +4573,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force)
filename_to_ansi (temp, temp_a);
filename_to_ansi (newname, newname_a);
result = rename (temp_a, newname_a);
- if (result < 0 && force)
+ if (result < 0)
{
DWORD w32err = GetLastError ();
@@ -4595,16 +4581,35 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force)
&& newname_dev != oldname_dev)
{
DWORD attributes;
-
if ((attributes = GetFileAttributesA (temp_a)) != -1
&& (attributes & FILE_ATTRIBUTE_DIRECTORY))
errno = EXDEV;
}
- else if (errno == EEXIST)
+ else if (errno == EEXIST && force)
{
+ DWORD attributes_old;
+ DWORD attributes_new;
+
if (_chmod (newname_a, 0666) != 0)
return result;
- if (_unlink (newname_a) != 0)
+ attributes_old = GetFileAttributesA (temp_a);
+ attributes_new = GetFileAttributesA (newname_a);
+ if (attributes_old != -1 && attributes_new != -1
+ && ((attributes_old & FILE_ATTRIBUTE_DIRECTORY)
+ != (attributes_new & FILE_ATTRIBUTE_DIRECTORY)))
+ {
+ if ((attributes_old & FILE_ATTRIBUTE_DIRECTORY) != 0)
+ errno = ENOTDIR;
+ else
+ errno = EISDIR;
+ return -1;
+ }
+ if ((attributes_new & FILE_ATTRIBUTE_DIRECTORY) != 0)
+ {
+ if (_rmdir (newname_a) != 0)
+ return result;
+ }
+ else if (_unlink (newname_a) != 0)
return result;
result = rename (temp_a, newname_a);
}
diff --git a/src/w32.h b/src/w32.h
index 1727f8bc629..cd782883c6d 100644
--- a/src/w32.h
+++ b/src/w32.h
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifdef CYGWIN
#error "w32.h is not compatible with Cygwin"
diff --git a/src/w32common.h b/src/w32common.h
index 30718e0074b..6de4ab4bfd8 100644
--- a/src/w32common.h
+++ b/src/w32common.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
diff --git a/src/w32console.c b/src/w32console.c
index 8df6379d407..15d11d56ad7 100644
--- a/src/w32console.c
+++ b/src/w32console.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Tim Fleehart (apollo@online.com) 1-17-92
@@ -333,7 +333,7 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string,
coding->produced, cursor_coords,
&r))
{
- printf ("Failed writing console attributes: %d\n",
+ printf ("Failed writing console attributes: %lu\n",
GetLastError ());
fflush (stdout);
}
@@ -343,7 +343,7 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string,
coding->produced, cursor_coords,
&r))
{
- printf ("Failed writing console characters: %d\n",
+ printf ("Failed writing console characters: %lu\n",
GetLastError ());
fflush (stdout);
}
diff --git a/src/w32fns.c b/src/w32fns.c
index e490588d01b..d2d4b2c7355 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Added by Kevin Gallo */
@@ -467,7 +467,7 @@ if the entry is new. */)
block_input ();
/* replace existing entry in w32-color-map or add new entry. */
- entry = Fassoc (name, Vw32_color_map);
+ entry = Fassoc (name, Vw32_color_map, Qnil);
if (NILP (entry))
{
entry = Fcons (name, rgb);
@@ -4413,8 +4413,8 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
TranslateMessage (&windows_msg);
goto dflt;
}
-
/* Fall through */
+ FALLTHROUGH;
case WM_SYSCHAR:
case WM_CHAR:
@@ -4677,6 +4677,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
if (w32_pass_extra_mouse_buttons_to_system)
goto dflt;
/* else fall through and process them. */
+ FALLTHROUGH;
case WM_MBUTTONDOWN:
case WM_MBUTTONUP:
handle_plain_button:
@@ -4782,6 +4783,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
track_mouse_event_fn (&tme);
track_mouse_window = hwnd;
}
+ FALLTHROUGH;
case WM_HSCROLL:
case WM_VSCROLL:
if (w32_mouse_move_interval <= 0
@@ -4823,6 +4825,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
if (w32_pass_multimedia_buttons_to_system)
goto dflt;
/* Otherwise, pass to lisp, the same way we do with mousehwheel. */
+ FALLTHROUGH;
/* FIXME!!! This is never reached so what's the purpose? If the
non-zero return remark below is right we're doing it wrong all
@@ -5085,6 +5088,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
case WM_MOUSELEAVE:
/* No longer tracking mouse. */
track_mouse_window = NULL;
+ FALLTHROUGH;
case WM_ACTIVATEAPP:
case WM_ACTIVATE:
@@ -5125,6 +5129,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
menu_free_timer = 0;
}
}
+ FALLTHROUGH;
case WM_MOVE:
case WM_SIZE:
command:
@@ -5163,6 +5168,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)
fails (see bug#25875). But if it fails, we want to find out
about it, so let's leave 1000 for now. */
sleep (1000);
+ FALLTHROUGH;
case WM_WINDOWPOSCHANGING:
/* Don't restrict the sizing of any kind of frames. If the window
@@ -5841,7 +5847,8 @@ This function is an internal primitive--use `make-frame' instead. */)
that are needed to determine window geometry. */
x_default_font_parameter (f, parameters);
- x_default_parameter (f, parameters, Qborder_width, make_number (2),
+ /* Default BorderWidth to 0 to match other platforms. */
+ x_default_parameter (f, parameters, Qborder_width, make_number (0),
"borderWidth", "BorderWidth", RES_TYPE_NUMBER);
/* We recognize either internalBorderWidth or internalBorder
@@ -5856,7 +5863,7 @@ This function is an internal primitive--use `make-frame' instead. */)
parameters = Fcons (Fcons (Qinternal_border_width, value),
parameters);
}
- /* Default internalBorderWidth to 0 on Windows to match other programs. */
+
x_default_parameter (f, parameters, Qinternal_border_width, make_number (0),
"internalBorderWidth", "InternalBorder", RES_TYPE_NUMBER);
x_default_parameter (f, parameters, Qright_divider_width, make_number (0),
@@ -5889,6 +5896,8 @@ This function is an internal primitive--use `make-frame' instead. */)
NULL, NULL, RES_TYPE_BOOLEAN);
x_default_parameter (f, parameters, Qno_accept_focus, Qnil,
NULL, NULL, RES_TYPE_BOOLEAN);
+ x_default_parameter (f, parameters, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
/* Process alpha here (Bug#16619). On XP this fails with child
frames. For `no-focus-on-map' frames delay processing of alpha
@@ -5957,6 +5966,14 @@ This function is an internal primitive--use `make-frame' instead. */)
f->output_data.w32->hourglass_cursor = w32_load_cursor (IDC_WAIT);
f->output_data.w32->horizontal_drag_cursor = w32_load_cursor (IDC_SIZEWE);
f->output_data.w32->vertical_drag_cursor = w32_load_cursor (IDC_SIZENS);
+ f->output_data.w32->left_edge_cursor = w32_load_cursor (IDC_SIZEWE);
+ f->output_data.w32->top_left_corner_cursor = w32_load_cursor (IDC_SIZENWSE);
+ f->output_data.w32->top_edge_cursor = w32_load_cursor (IDC_SIZENS);
+ f->output_data.w32->top_right_corner_cursor = w32_load_cursor (IDC_SIZENESW);
+ f->output_data.w32->right_edge_cursor = w32_load_cursor (IDC_SIZEWE);
+ f->output_data.w32->bottom_right_corner_cursor = w32_load_cursor (IDC_SIZENWSE);
+ f->output_data.w32->bottom_edge_cursor = w32_load_cursor (IDC_SIZENS);
+ f->output_data.w32->bottom_left_corner_cursor = w32_load_cursor (IDC_SIZENESW);
f->output_data.w32->current_cursor = f->output_data.w32->nontext_cursor;
@@ -7049,6 +7066,8 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms)
"cursorColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qt,
+ NULL, NULL, RES_TYPE_BOOLEAN);
/* Init faces before x_default_parameter is called for the
scroll-bar-width parameter because otherwise we end up in
@@ -7159,7 +7178,7 @@ compute_tip_xy (struct frame *f,
int width, int height, int *root_x, int *root_y)
{
Lisp_Object left, top, right, bottom;
- int min_x = 0, min_y, max_x = 0, max_y;
+ int min_x = 0, min_y = 0, max_x = 0, max_y = 0;
/* User-specified position? */
left = Fcdr (Fassq (Qleft, parms));
@@ -8950,33 +8969,47 @@ menu bar or tool bar of FRAME. */)
if (EQ (type, Qouter_edges))
{
RECT rectangle;
+ BOOL success = false;
block_input ();
/* Outer frame rectangle, including outer borders and title bar. */
- GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
+ success = GetWindowRect (FRAME_W32_WINDOW (f), &rectangle);
unblock_input ();
- return list4 (make_number (rectangle.left),
- make_number (rectangle.top),
- make_number (rectangle.right),
- make_number (rectangle.bottom));
+ if (success)
+ return list4 (make_number (rectangle.left),
+ make_number (rectangle.top),
+ make_number (rectangle.right),
+ make_number (rectangle.bottom));
+ else
+ return Qnil;
}
else
{
RECT rectangle;
POINT pt;
int left, top, right, bottom;
+ BOOL success;
block_input ();
/* Inner frame rectangle, excluding borders and title bar. */
- GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
+ success = GetClientRect (FRAME_W32_WINDOW (f), &rectangle);
/* Get top-left corner of native rectangle in screen
coordinates. */
+ if (!success)
+ {
+ unblock_input ();
+ return Qnil;
+ }
+
pt.x = 0;
pt.y = 0;
- ClientToScreen (FRAME_W32_WINDOW (f), &pt);
+ success = ClientToScreen (FRAME_W32_WINDOW (f), &pt);
unblock_input ();
+ if (!success)
+ return Qnil;
+
left = pt.x;
top = pt.y;
right = left + rectangle.right;
@@ -9304,6 +9337,17 @@ If the underlying system call fails, value is nil. */)
filename = Fexpand_file_name (filename, Qnil);
encoded = ENCODE_FILE (filename);
+ /* If the file name has special constructs in it,
+ call the corresponding file handler. */
+ Lisp_Object handler = Ffind_file_name_handler (encoded, Qfile_system_info);
+ if (!NILP (handler))
+ {
+ value = call2 (handler, Qfile_system_info, encoded);
+ if (CONSP (value) || NILP (value))
+ return value;
+ error ("Invalid handler in `file-name-handler-alist'");
+ }
+
value = Qnil;
/* Determining the required information on Windows turns out, sadly,
@@ -10330,6 +10374,7 @@ frame_parm_handler w32_frame_parm_handlers[] =
x_set_no_accept_focus,
x_set_z_group,
0, /* x_set_override_redirect */
+ x_set_no_special_glyphs,
};
void
@@ -10372,6 +10417,7 @@ syms_of_w32fns (void)
DEFSYM (Qlibxml2, "libxml2");
DEFSYM (Qserif, "serif");
DEFSYM (Qzlib, "zlib");
+ DEFSYM (Qlcms2, "lcms2");
Fput (Qundefined_color, Qerror_conditions,
listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror));
@@ -10681,6 +10727,11 @@ default value t means to add the width of one canonical character of the
tip frame. */);
Vw32_tooltip_extra_pixels = Qt;
+ DEFVAR_BOOL ("w32-disable-abort-dialog",
+ w32_disable_abort_dialog,
+ doc: /* Non-nil means don't display the abort dialog when aborting. */);
+ w32_disable_abort_dialog = 0;
+
#if 0 /* TODO: Port to W32 */
defsubr (&Sx_change_window_property);
defsubr (&Sx_delete_window_property);
@@ -10875,6 +10926,9 @@ w32_backtrace (void **buffer, int limit)
void
emacs_abort (void)
{
+ if (w32_disable_abort_dialog)
+ abort ();
+
int button;
button = MessageBox (NULL,
"A fatal error has occurred!\n\n"
diff --git a/src/w32font.c b/src/w32font.c
index 67d2f6d666d..d6bd7d6a2b3 100644
--- a/src/w32font.c
+++ b/src/w32font.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <windows.h>
@@ -544,6 +544,7 @@ w32font_text_extents (struct font *font, unsigned *code,
information. */
/* Make array big enough to hold surrogates. */
+ eassume (0 <= nglyphs); /* pacify GCC warning on next line */
wcode = alloca (nglyphs * sizeof (WORD) * 2);
for (i = 0; i < nglyphs; i++)
{
@@ -1627,7 +1628,7 @@ x_to_w32_charset (char * lpcs)
Format of each entry is
(CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
*/
- this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
+ this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil);
if (NILP (this_entry))
{
@@ -2188,7 +2189,7 @@ font_supported_scripts (FONTSIGNATURE * sig)
/* Match a single subrange. SYM is set if bit N is set in subranges. */
#define SUBRANGE(n,sym) \
- if (subranges[(n) / 32] & (1 << ((n) % 32))) \
+ if (subranges[(n) / 32] & (1U << ((n) % 32))) \
supported = Fcons ((sym), supported)
/* Match multiple subranges. SYM is set if any MASK bit is set in
diff --git a/src/w32font.h b/src/w32font.h
index 42b425f35fd..2d84950f0dc 100644
--- a/src/w32font.h
+++ b/src/w32font.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_W32FONT_H
#define EMACS_W32FONT_H
diff --git a/src/w32gui.h b/src/w32gui.h
index 4f142b09cc3..00d5d1f57c7 100644
--- a/src/w32gui.h
+++ b/src/w32gui.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_W32GUI_H
#define EMACS_W32GUI_H
diff --git a/src/w32heap.c b/src/w32heap.c
index 54de9617494..4115049d71f 100644
--- a/src/w32heap.c
+++ b/src/w32heap.c
@@ -14,7 +14,7 @@
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 <http://www.gnu.org/licenses/>. */
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Geoff Voelker (voelker@cs.washington.edu) 7-29-94
@@ -116,9 +116,9 @@ typedef struct _RTL_HEAP_PARAMETERS {
to build only the first bootstrap-emacs.exe with the large size,
and reset that to a lower value afterwards. */
#if defined _WIN64 || defined WIDE_EMACS_INT
-# define DUMPED_HEAP_SIZE (21*1024*1024)
+# define DUMPED_HEAP_SIZE (22*1024*1024)
#else
-# define DUMPED_HEAP_SIZE (12*1024*1024)
+# define DUMPED_HEAP_SIZE (13*1024*1024)
#endif
static unsigned char dumped_data[DUMPED_HEAP_SIZE];
@@ -228,7 +228,9 @@ init_heap (void)
{
if (using_dynamic_heap)
{
+#ifndef MINGW_W64
unsigned long enable_lfh = 2;
+#endif
/* After dumping, use a new private heap. We explicitly enable
the low fragmentation heap (LFH) here, for the sake of pre
diff --git a/src/w32heap.h b/src/w32heap.h
index 0b3e9dd888d..1cabbd84dff 100644
--- a/src/w32heap.h
+++ b/src/w32heap.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
Geoff Voelker (voelker@cs.washington.edu) 7-29-94
*/
diff --git a/src/w32inevt.c b/src/w32inevt.c
index ed1f1d2e9ae..9d79bd46fb3 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Drew Bliss 01-Oct-93
@@ -526,7 +526,7 @@ do_mouse_event (MOUSE_EVENT_RECORD *event,
help_echo_window, help_echo_object,
help_echo_pos);
}
- /* We already called kbd_buffer_store_event, so indicate the
+ /* We already called kbd_buffer_store_event, so indicate to
the caller it shouldn't. */
return 0;
}
diff --git a/src/w32inevt.h b/src/w32inevt.h
index 87442cd5f3e..b761d952eb4 100644
--- a/src/w32inevt.h
+++ b/src/w32inevt.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_W32INEVT_H
#define EMACS_W32INEVT_H
diff --git a/src/w32menu.c b/src/w32menu.c
index de5c4b46b54..d3946285212 100644
--- a/src/w32menu.c
+++ b/src/w32menu.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/w32notify.c b/src/w32notify.c
index 25205816bae..4e0e5804a55 100644
--- a/src/w32notify.c
+++ b/src/w32notify.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Eli Zaretskii <eliz@gnu.org>.
@@ -423,7 +423,7 @@ remove_watch (struct notification *dirwatch)
{
int i;
BOOL status;
- DWORD exit_code = 0, err;
+ DWORD exit_code = 0, err = 0;
/* Only the thread that issued the outstanding I/O call can call
CancelIo on it. (CancelIoEx is available only since Vista.)
@@ -642,7 +642,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */)
/* Remove the watch object from watch list. Do this before freeing
the object, do that even if we fail to free it, watch_list is
kept free of junk. */
- watch_object = Fassoc (watch_descriptor, watch_list);
+ watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (!NILP (watch_object))
{
watch_list = Fdelete (watch_object, watch_list);
@@ -679,7 +679,7 @@ the watcher thread exits abnormally for any other reason. Removing the
watch by calling `w32notify-rm-watch' also makes it invalid. */)
(Lisp_Object watch_descriptor)
{
- Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
+ Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (!NILP (watch_object))
{
diff --git a/src/w32proc.c b/src/w32proc.c
index 0aa248a6f7b..0046c9e85dc 100644
--- a/src/w32proc.c
+++ b/src/w32proc.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/*
Drew Bliss Oct 14, 1993
@@ -485,7 +485,7 @@ stop_timer_thread (int which)
struct itimer_data *itimer =
(which == ITIMER_REAL) ? &real_itimer : &prof_itimer;
int i;
- DWORD err, exit_code = 255;
+ DWORD err = 0, exit_code = 255;
BOOL status;
/* Signal the thread that it should terminate. */
@@ -838,7 +838,7 @@ alarm (int seconds)
updates the status of the read accordingly, and signals the 2nd
event object, char_avail, on whose handle sys_select is
waiting. This tells sys_select that the file descriptor
- allocated for the subprocess or the the stream is ready to be
+ allocated for the subprocess or the stream is ready to be
read from.
When the subprocess exits or the network/serial stream is closed,
@@ -1449,7 +1449,11 @@ waitpid (pid_t pid, int *status, int options)
do
{
- maybe_quit ();
+ /* When child_status_changed calls us with WNOHANG in OPTIONS,
+ we are supposed to be non-interruptible, so don't allow
+ quitting in that case. */
+ if (!dont_wait)
+ maybe_quit ();
active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms);
} while (active == WAIT_TIMEOUT && !dont_wait);
@@ -1488,12 +1492,17 @@ waitpid (pid_t pid, int *status, int options)
}
if (retval == STILL_ACTIVE)
{
- /* Should never happen. */
+ /* Should never happen. But it does, with invoking git-gui.exe
+ asynchronously. So we punt, and just report this process as
+ exited with exit code 259, when we are called with WNOHANG
+ from child_status_changed, because in that case we already
+ _know_ the process has died. */
DebPrint (("Wait.WaitForMultipleObjects returned an active process\n"));
- if (pid > 0 && dont_wait)
- return 0;
- errno = EINVAL;
- return -1;
+ if (!(pid > 0 && dont_wait))
+ {
+ errno = EINVAL;
+ return -1;
+ }
}
/* Massage the exit code from the process to match the format expected
@@ -1622,38 +1631,43 @@ w32_executable_type (char * filename,
/* Look for Cygwin DLL in the DLL import list. */
IMAGE_DATA_DIRECTORY import_dir =
data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT];
- IMAGE_IMPORT_DESCRIPTOR * imports =
- RVA_TO_PTR (import_dir.VirtualAddress,
- rva_to_section (import_dir.VirtualAddress,
- nt_header),
- executable);
- for ( ; imports->Name; imports++)
- {
- IMAGE_SECTION_HEADER * section =
- rva_to_section (imports->Name, nt_header);
- char * dllname = RVA_TO_PTR (imports->Name, section,
- executable);
-
- /* The exact name of the Cygwin DLL has changed with
- various releases, but hopefully this will be
- reasonably future-proof. */
- if (strncmp (dllname, "cygwin", 6) == 0)
- {
- *is_cygnus_app = TRUE;
- break;
- }
- else if (strncmp (dllname, "msys-", 5) == 0)
+ /* Import directory can be missing in .NET DLLs. */
+ if (import_dir.VirtualAddress != 0)
+ {
+ IMAGE_IMPORT_DESCRIPTOR * imports =
+ RVA_TO_PTR (import_dir.VirtualAddress,
+ rva_to_section (import_dir.VirtualAddress,
+ nt_header),
+ executable);
+
+ for ( ; imports->Name; imports++)
{
- /* This catches both MSYS 1.x and MSYS2
- executables (the DLL name is msys-1.0.dll and
- msys-2.0.dll, respectively). There doesn't
- seem to be a reason to distinguish between
- the two, for now. */
- *is_msys_app = TRUE;
- break;
+ IMAGE_SECTION_HEADER * section =
+ rva_to_section (imports->Name, nt_header);
+ char * dllname = RVA_TO_PTR (imports->Name, section,
+ executable);
+
+ /* The exact name of the Cygwin DLL has changed with
+ various releases, but hopefully this will be
+ reasonably future-proof. */
+ if (strncmp (dllname, "cygwin", 6) == 0)
+ {
+ *is_cygnus_app = TRUE;
+ break;
+ }
+ else if (strncmp (dllname, "msys-", 5) == 0)
+ {
+ /* This catches both MSYS 1.x and MSYS2
+ executables (the DLL name is msys-1.0.dll and
+ msys-2.0.dll, respectively). There doesn't
+ seem to be a reason to distinguish between
+ the two, for now. */
+ *is_msys_app = TRUE;
+ break;
+ }
}
- }
+ }
}
}
}
@@ -2624,6 +2638,12 @@ sys_kill (pid_t pid, int sig)
/* Set the foreground window to the child. */
if (SetForegroundWindow (cp->hwnd))
{
+ /* Record the state of the Ctrl key: the user could
+ have it depressed while we are simulating Ctrl-C,
+ in which case we will have to leave the state of
+ Ctrl depressed when we are done. */
+ short ctrl_state = GetKeyState (VK_CONTROL) & 0x8000;
+
/* Generate keystrokes as if user had typed Ctrl-Break or
Ctrl-C. */
keybd_event (VK_CONTROL, control_scan_code, 0, 0);
@@ -2640,6 +2660,9 @@ sys_kill (pid_t pid, int sig)
Sleep (100);
SetForegroundWindow (foreground_window);
+ /* If needed, restore the state of Ctrl. */
+ if (ctrl_state != 0)
+ keybd_event (VK_CONTROL, control_scan_code, 0, 0);
}
/* Detach from the foreground and child threads now that
the foreground switching is over. */
diff --git a/src/w32reg.c b/src/w32reg.c
index de19ae14858..040857e87b3 100644
--- a/src/w32reg.c
+++ b/src/w32reg.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Kevin Gallo */
diff --git a/src/w32select.c b/src/w32select.c
index 03bcc1c21da..003bef2ddad 100644
--- a/src/w32select.c
+++ b/src/w32select.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Written by Kevin Gallo, Benjamin Riefenstahl */
diff --git a/src/w32select.h b/src/w32select.h
index 5cf2d6f6381..da2057a0e8d 100644
--- a/src/w32select.h
+++ b/src/w32select.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef W32SELECT_H
#define W32SELECT_H
diff --git a/src/w32term.c b/src/w32term.c
index 712bdae5fc3..7c2d86b5f31 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
@@ -32,6 +32,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <fcntl.h> /* for O_RDWR */
#endif
#include <imm.h>
+#include <math.h>
#include "coding.h"
#include "frame.h"
@@ -162,10 +163,6 @@ int last_scroll_bar_drag_pos;
/* Keyboard code page - may be changed by language-change events. */
int w32_keyboard_codepage;
-/* Incremented by w32_read_socket whenever it really tries to read
- events. */
-static int volatile input_signal_count;
-
#ifdef CYGWIN
int w32_message_fd = -1;
#endif /* CYGWIN */
@@ -308,6 +305,22 @@ w32_restore_glyph_string_clip (struct glyph_string *s)
}
}
+static void
+x_get_scale_factor(struct w32_display_info *dpyinfo, int *scale_x, int *scale_y)
+{
+ const int base_res = 96;
+
+ *scale_x = *scale_y = 1;
+
+ if (dpyinfo)
+ {
+ if (dpyinfo->resx > base_res)
+ *scale_x = floor (dpyinfo->resx / base_res);
+ if (dpyinfo->resy > base_res)
+ *scale_y = floor (dpyinfo->resy / base_res);
+ }
+}
+
/*
Draw a wavy line under S. The wave fills wave_height pixels from y0.
@@ -322,7 +335,12 @@ w32_restore_glyph_string_clip (struct glyph_string *s)
static void
w32_draw_underwave (struct glyph_string *s, COLORREF color)
{
- int wave_height = 3, wave_length = 2;
+ struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f);
+
+ int scale_x, scale_y;
+ x_get_scale_factor (dpyinfo, &scale_x, &scale_y);
+
+ int wave_height = 3 * scale_y, wave_length = 2 * scale_x, thickness = scale_y;
int dx, dy, x0, y0, width, x1, y1, x2, y2, odd, xmax;
XRectangle wave_clip, string_clip, final_clip;
RECT w32_final_clip, w32_string_clip;
@@ -331,7 +349,7 @@ w32_draw_underwave (struct glyph_string *s, COLORREF color)
dx = wave_length;
dy = wave_height - 1;
x0 = s->x;
- y0 = s->ybase - wave_height + 3;
+ y0 = s->ybase + wave_height / 2 - scale_y;
width = s->width;
xmax = x0 + width;
@@ -348,7 +366,7 @@ w32_draw_underwave (struct glyph_string *s, COLORREF color)
if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip))
return;
- hp = CreatePen (PS_SOLID, 0, color);
+ hp = CreatePen (PS_SOLID, thickness, color);
oldhp = SelectObject (s->hdc, hp);
CONVERT_FROM_XRECT (final_clip, w32_final_clip);
w32_set_clip_rectangle (s->hdc, &w32_final_clip);
@@ -399,7 +417,7 @@ w32_draw_rectangle (HDC hdc, XGCValues *gc, int x, int y,
is 1 pixel wider and higher than its arguments WIDTH and HEIGHT.
This allows us to keep the code that calls this function similar
to the corresponding code in xterm.c. For the details, see
- http://lists.gnu.org/archives/html/emacs-devel/2014-10/msg00546.html. */
+ https://lists.gnu.org/r/emacs-devel/2014-10/msg00546.html. */
Rectangle (hdc, x, y, x + width + 1, y + height + 1);
SelectObject (hdc, oldhb);
@@ -642,21 +660,25 @@ w32_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
? face_last->foreground
: FRAME_FOREGROUND_PIXEL (f));
- if (y1 - y0 > x1 - x0 && x1 - x0 > 2)
- /* Vertical. */
+ if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
+ /* A vertical divider, at least three pixels wide: Draw first and
+ last pixels differently. */
{
w32_fill_area_abs (f, hdc, color_first, x0, y0, x0 + 1, y1);
w32_fill_area_abs (f, hdc, color, x0 + 1, y0, x1 - 1, y1);
w32_fill_area_abs (f, hdc, color_last, x1 - 1, y0, x1, y1);
}
- else if (x1 - x0 > y1 - y0 && y1 - y0 > 3)
- /* Horizontal. */
+ else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
+ /* A horizontal divider, at least three pixels high: Draw first and
+ last pixels differently. */
{
w32_fill_area_abs (f, hdc, color_first, x0, y0, x1, y0 + 1);
w32_fill_area_abs (f, hdc, color, x0, y0 + 1, x1, y1 - 1);
w32_fill_area_abs (f, hdc, color_last, x0, y1 - 1, x1, y1);
}
else
+ /* In any other case do not draw the first and last pixels
+ differently. */
w32_fill_area_abs (f, hdc, color, x0, y0, x1, y1);
release_frame_dc (f, hdc);
@@ -1623,6 +1645,7 @@ w32_setup_relief_color (struct frame *f, struct relief *relief, double factor,
if (w32_alloc_lighter_color (f, &pixel, factor, delta))
xgcv.foreground = relief->pixel = pixel;
+ xgcv.font = NULL; /* avoid compiler warnings */
if (relief->gc == 0)
{
#if 0 /* TODO: stipple */
@@ -3065,8 +3088,8 @@ parse_button (int message, int xbutton, int * pbutton, int * pup)
static Lisp_Object
construct_mouse_click (struct input_event *result, W32Msg *msg, struct frame *f)
{
- int button;
- int up;
+ int button = 0;
+ int up = 0;
parse_button (msg->msg.message, HIWORD (msg->msg.wParam),
&button, &up);
@@ -4324,6 +4347,7 @@ w32_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg,
SetScrollInfo (SCROLL_BAR_W32_WINDOW (bar), SB_CTL, &si, TRUE);
}
/* fall through */
+ FALLTHROUGH;
default:
emacs_event->kind = NO_EVENT;
return FALSE;
@@ -4438,6 +4462,7 @@ w32_horizontal_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg,
SetScrollInfo (SCROLL_BAR_W32_WINDOW (bar), SB_CTL, &si, TRUE);
}
/* fall through */
+ FALLTHROUGH;
default:
emacs_event->kind = NO_EVENT;
return FALSE;
@@ -4633,9 +4658,6 @@ w32_read_socket (struct terminal *terminal,
block_input ();
- /* So people can tell when we have read the available input. */
- input_signal_count++;
-
/* Process any incoming thread messages. */
drain_message_queue ();
@@ -4952,8 +4974,8 @@ w32_read_socket (struct terminal *terminal,
/* If we decide we want to generate an event to be seen
by the rest of Emacs, we put it here. */
bool tool_bar_p = 0;
- int button;
- int up;
+ int button = 0;
+ int up = 0;
f = (x_mouse_grabbed (dpyinfo) ? dpyinfo->last_mouse_frame
: x_window_to_frame (dpyinfo, msg.msg.hwnd));
@@ -5086,6 +5108,51 @@ w32_read_socket (struct terminal *terminal,
}
case WM_WINDOWPOSCHANGED:
+ f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
+
+ if (f)
+ {
+ RECT rect;
+ int /* rows, columns, */ width, height, text_width, text_height;
+
+ if (GetClientRect (msg.msg.hwnd, &rect)
+ /* GetClientRect evidently returns (0, 0, 0, 0) if
+ called on a minimized frame. Such "dimensions"
+ aren't useful anyway. */
+ && !(rect.bottom == 0
+ && rect.top == 0
+ && rect.left == 0
+ && rect.right == 0))
+ {
+ height = rect.bottom - rect.top;
+ width = rect.right - rect.left;
+ text_width = FRAME_PIXEL_TO_TEXT_WIDTH (f, width);
+ text_height = FRAME_PIXEL_TO_TEXT_HEIGHT (f, height);
+ /* rows = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, height); */
+ /* columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, width); */
+
+ /* TODO: Clip size to the screen dimensions. */
+
+ /* Even if the number of character rows and columns
+ has not changed, the font size may have changed,
+ so we need to check the pixel dimensions as well. */
+
+ if (width != FRAME_PIXEL_WIDTH (f)
+ || height != FRAME_PIXEL_HEIGHT (f)
+ || text_width != FRAME_TEXT_WIDTH (f)
+ || text_height != FRAME_TEXT_HEIGHT (f))
+ {
+ change_frame_size (f, text_width, text_height, 0, 1, 0, 1);
+ SET_FRAME_GARBAGED (f);
+ cancel_mouse_face (f);
+ f->win_gravity = NorthWestGravity;
+ }
+ }
+ }
+
+ check_visibility = 1;
+ break;
+
case WM_ACTIVATE:
case WM_ACTIVATEAPP:
f = x_window_to_frame (dpyinfo, msg.msg.hwnd);
@@ -6052,7 +6119,7 @@ x_calc_absolute_position (struct frame *f)
int display_top = 0;
struct frame *p = FRAME_PARENT_FRAME (f);
- if (flags & (XNegative | YNegative))
+ if (!p && flags & (XNegative | YNegative))
{
Lisp_Object list;
@@ -6065,7 +6132,7 @@ x_calc_absolute_position (struct frame *f)
list = CDR(list);
- geometry = Fassoc (Qgeometry, attributes);
+ geometry = Fassoc (Qgeometry, attributes, Qnil);
if (!NILP (geometry))
{
monitor_left = Fnth (make_number (1), geometry);
@@ -6078,20 +6145,26 @@ x_calc_absolute_position (struct frame *f)
}
/* Treat negative positions as relative to the rightmost bottommost
- position that fits on the screen. */
+ position that fits on the screen or parent frame.
+
+ I see no need for subtracting 1 from the border widths - is there
+ any on the remaining platforms? Here these subtractions did put
+ the last pixel line/column of a frame off-display when, for
+ example, a (set-frame-parameter nil 'left '(- 0)) specification was
+ used - martin 20017-05-05. */
if (flags & XNegative)
{
if (p)
f->left_pos = (FRAME_PIXEL_WIDTH (p)
- FRAME_PIXEL_WIDTH (f)
+ f->left_pos
- - (left_right_borders_width - 1));
+ - left_right_borders_width);
else
f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f))
+ display_left
- FRAME_PIXEL_WIDTH (f)
+ f->left_pos
- - (left_right_borders_width - 1));
+ - left_right_borders_width);
}
if (flags & YNegative)
@@ -6100,13 +6173,13 @@ x_calc_absolute_position (struct frame *f)
f->top_pos = (FRAME_PIXEL_HEIGHT (p)
- FRAME_PIXEL_HEIGHT (f)
+ f->top_pos
- - (top_bottom_borders_height - 1));
+ - top_bottom_borders_height);
else
f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f))
+ display_top
- FRAME_PIXEL_HEIGHT (f)
+ f->top_pos
- - (top_bottom_borders_height - 1));
+ - top_bottom_borders_height);
}
/* The left_pos and top_pos are now relative to the top and left
@@ -6176,7 +6249,8 @@ w32fullscreen_hook (struct frame *f)
if (FRAME_PREV_FSMODE (f) == FULLSCREEN_BOTH)
{
- SetWindowLong (hwnd, GWL_STYLE, dwStyle | WS_OVERLAPPEDWINDOW);
+ if (!FRAME_UNDECORATED (f))
+ SetWindowLong (hwnd, GWL_STYLE, dwStyle | WS_OVERLAPPEDWINDOW);
SetWindowPlacement (hwnd, &FRAME_NORMAL_PLACEMENT (f));
}
else if (FRAME_PREV_FSMODE (f) == FULLSCREEN_HEIGHT
@@ -6202,7 +6276,8 @@ w32fullscreen_hook (struct frame *f)
w32_fullscreen_rect (hwnd, f->want_fullscreen,
FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
- SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW);
+ if (!FRAME_UNDECORATED (f))
+ SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW);
SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top,
rect.right - rect.left, rect.bottom - rect.top,
SWP_NOOWNERZORDER | SWP_FRAMECHANGED);
@@ -6536,7 +6611,8 @@ w32_frame_raise_lower (struct frame *f, bool raise_flag)
/* Change of visibility. */
-/* This tries to wait until the frame is really visible.
+/* This tries to wait until the frame is really visible, depending on
+ the value of Vx_visible_frame_timeout.
However, if the window manager asks the user where to position
the frame, this will return before the user finishes doing that.
The frame will not actually be visible at that time,
@@ -6595,12 +6671,16 @@ x_make_frame_visible (struct frame *f)
: SW_SHOWNORMAL);
}
+ if (!FLOATP (Vx_wait_for_event_timeout))
+ return;
+
/* Synchronize to ensure Emacs knows the frame is visible
before we do anything else. We do this loop with input not blocked
so that incoming events are handled. */
{
Lisp_Object frame;
- int count;
+ double timeout = XFLOAT_DATA (Vx_wait_for_event_timeout);
+ double start_time = XFLOAT_DATA (Ffloat_time (Qnil));
/* This must come after we set COUNT. */
unblock_input ();
@@ -6610,8 +6690,8 @@ x_make_frame_visible (struct frame *f)
/* Wait until the frame is visible. Process X events until a
MapNotify event has been seen, or until we think we won't get a
MapNotify at all.. */
- for (count = input_signal_count + 10;
- input_signal_count < count && !FRAME_VISIBLE_P (f);)
+ while (timeout > (XFLOAT_DATA (Ffloat_time (Qnil)) - start_time) &&
+ !FRAME_VISIBLE_P (f))
{
/* Force processing of queued events. */
/* TODO: x_sync equivalent? */
@@ -7243,6 +7323,17 @@ syms_of_w32term (void)
DEFSYM (Qrenamed_from, "renamed-from");
DEFSYM (Qrenamed_to, "renamed-to");
+ DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout,
+ doc: /* How long to wait for X events.
+
+Emacs will wait up to this many seconds to receive X events after
+making changes which affect the state of the graphical interface.
+Under some window managers this can take an indefinite amount of time,
+so it is important to limit the wait.
+
+If set to a non-float value, there will be no wait at all. */);
+ Vx_wait_for_event_timeout = make_float (0.1);
+
DEFVAR_INT ("w32-num-mouse-buttons",
w32_num_mouse_buttons,
doc: /* Number of physical mouse buttons. */);
diff --git a/src/w32term.h b/src/w32term.h
index 371cf9005bc..de234cb57db 100644
--- a/src/w32term.h
+++ b/src/w32term.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Added by Kevin Gallo */
@@ -22,13 +22,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "frame.h"
#include "atimer.h"
-/* Stack alignment stuff. Every CALLBACK function should have the
- ALIGN_STACK attribute if it manipulates Lisp objects, because
- Windows x86 32-bit ABI only guarantees 4-byte stack alignment, and
- that is what we will get when a Windows function calls us. The
- ALIGN_STACK attribute forces GCC to emit a preamble code to
- re-align the stack at function entry. Further details about this
- can be found in http://www.peterstock.co.uk/games/mingw_sse/. */
+/* Stack alignment stuff. Every CALLBACK and thread function should
+ have the ALIGN_STACK attribute if it manipulates Lisp objects,
+ because Windows x86 32-bit ABI only guarantees 4-byte stack
+ alignment, and that is what we will get when a Windows function
+ calls us. The ALIGN_STACK attribute forces GCC to emit a preamble
+ code to re-align the stack at function entry. Further details
+ about this can be found in
+ http://www.peterstock.co.uk/games/mingw_sse/. */
#ifdef __GNUC__
# if USE_STACK_LISP_OBJECTS && !defined _WIN64 && !defined __x86_64__ \
&& __GNUC__ + (__GNUC_MINOR__ > 1) >= 5
@@ -345,6 +346,14 @@ struct w32_output
Cursor hourglass_cursor;
Cursor horizontal_drag_cursor;
Cursor vertical_drag_cursor;
+ Cursor left_edge_cursor;
+ Cursor top_left_corner_cursor;
+ Cursor top_edge_cursor;
+ Cursor top_right_corner_cursor;
+ Cursor right_edge_cursor;
+ Cursor bottom_right_corner_cursor;
+ Cursor bottom_edge_cursor;
+ Cursor bottom_left_corner_cursor;
/* Non-zero means hourglass cursor is currently displayed. */
unsigned hourglass_p : 1;
@@ -422,7 +431,7 @@ extern struct w32_output w32term_display;
struct scroll_bar {
/* This field is shared by all vectors. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The window we're a scroll bar for. */
Lisp_Object window;
diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c
index e4055638cc4..ca030ad5ae6 100644
--- a/src/w32uniscribe.c
+++ b/src/w32uniscribe.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/w32xfns.c b/src/w32xfns.c
index 587a24125bb..39a69d14db9 100644
--- a/src/w32xfns.c
+++ b/src/w32xfns.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <signal.h>
diff --git a/src/widget.c b/src/widget.c
index d7ec7028517..d5f720e7a54 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Emacs 19 face widget ported by Fred Pierresteguy */
@@ -108,7 +108,7 @@ emacsFrameTranslations [] = "\
static EmacsFrameClassRec emacsFrameClassRec = {
{ /* core fields */
- /* superclass */ &widgetClassRec,
+ /* superclass */ 0, /* filled in by emacsFrameClass */
/* class_name */ (char *) "EmacsFrame",
/* widget_size */ sizeof (EmacsFrameRec),
/* class_initialize */ 0,
@@ -146,7 +146,16 @@ static EmacsFrameClassRec emacsFrameClassRec = {
}
};
-WidgetClass emacsFrameClass = (WidgetClass) &emacsFrameClassRec;
+WidgetClass
+emacsFrameClass (void)
+{
+ /* Set the superclass here rather than relying on static
+ initialization, to work around an unexelf.c bug on x86 platforms
+ that use the GNU Gold linker (Bug#27248). */
+ emacsFrameClassRec.core_class.superclass = &widgetClassRec;
+
+ return (WidgetClass) &emacsFrameClassRec;
+}
static void
get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height)
diff --git a/src/widget.h b/src/widget.h
index 2c5fb61df2f..07cc665b355 100644
--- a/src/widget.h
+++ b/src/widget.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Emacs 19 face widget ported by Fred Pierresteguy */
@@ -90,7 +90,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
typedef struct _EmacsFrameRec *EmacsFrame;
typedef struct _EmacsFrameClassRec *EmacsFrameClass;
-extern WidgetClass emacsFrameClass;
+extern WidgetClass emacsFrameClass (void);
extern struct _DisplayContext *display_context;
diff --git a/src/widgetprv.h b/src/widgetprv.h
index 309aed779da..ac49e8c8027 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Emacs 19 face widget ported by Fred Pierresteguy */
diff --git a/src/window.c b/src/window.c
index bf89f0e488b..504dcd38357 100644
--- a/src/window.c
+++ b/src/window.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -1208,13 +1208,13 @@ coordinates_in_window (register struct window *w, int x, int y)
- WINDOW_BOTTOM_DIVIDER_WIDTH (w))))
return ON_HORIZONTAL_SCROLL_BAR;
/* On the mode or header line? */
- else if ((WINDOW_WANTS_MODELINE_P (w)
+ else if ((window_wants_mode_line (w)
&& y >= (bottom_y
- CURRENT_MODE_LINE_HEIGHT (w)
- WINDOW_BOTTOM_DIVIDER_WIDTH (w))
&& y <= bottom_y - WINDOW_BOTTOM_DIVIDER_WIDTH (w)
&& (part = ON_MODE_LINE))
- || (WINDOW_WANTS_HEADER_LINE_P (w)
+ || (window_wants_header_line (w)
&& y < top_y + CURRENT_HEADER_LINE_HEIGHT (w)
&& (part = ON_HEADER_LINE)))
{
@@ -1851,7 +1851,7 @@ Return nil if window display is not up-to-date. In that case, use
if (EQ (line, Qheader_line))
{
- if (!WINDOW_WANTS_HEADER_LINE_P (w))
+ if (!window_wants_header_line (w))
return Qnil;
row = MATRIX_HEADER_LINE_ROW (w->current_matrix);
return row->enabled_p ? list4i (row->height, 0, 0, 0) : Qnil;
@@ -1898,6 +1898,129 @@ Return nil if window display is not up-to-date. In that case, use
return list4i (row->height + min (0, row->y) - crop, i, row->y, crop);
}
+DEFUN ("window-lines-pixel-dimensions", Fwindow_lines_pixel_dimensions, Swindow_lines_pixel_dimensions, 0, 6, 0,
+ doc: /* Return pixel dimensions of WINDOW's lines.
+The return value is a list of the x- and y-coordinates of the lower
+right corner of the last character of each line. Return nil if the
+current glyph matrix of WINDOW is not up-to-date.
+
+Optional argument WINDOW specifies the window whose lines' dimensions
+shall be returned. Nil or omitted means to return the dimensions for
+the selected window.
+
+FIRST, if non-nil, specifies the index of the first line whose
+dimensions shall be returned. If FIRST is nil and BODY is non-nil,
+start with the first text line of WINDOW. Otherwise, start with the
+first line of WINDOW.
+
+LAST, if non-nil, specifies the last line whose dimensions shall be
+returned. If LAST is nil and BODY is non-nil, the last line is the last
+line of the body (text area) of WINDOW. Otherwise, last is the last
+line of WINDOW.
+
+INVERSE, if nil, means that the y-pixel value returned for a specific
+line specifies the distance in pixels from the left edge (body edge if
+BODY is non-nil) of WINDOW to the right edge of the last glyph of that
+line. INVERSE non-nil means that the y-pixel value returned for a
+specific line specifies the distance in pixels from the right edge of
+the last glyph of that line to the right edge (body edge if BODY is
+non-nil) of WINDOW.
+
+LEFT non-nil means to return the x- and y-coordinates of the lower left
+corner of the leftmost character on each line. This is the value that
+should be used for buffers that mostly display text from right to left.
+
+If LEFT is non-nil and INVERSE is nil, this means that the y-pixel value
+returned for a specific line specifies the distance in pixels from the
+left edge of the last (leftmost) glyph of that line to the right edge
+(body edge if BODY is non-nil) of WINDOW. If LEFT and INVERSE are both
+non-nil, the y-pixel value returned for a specific line specifies the
+distance in pixels from the left edge (body edge if BODY is non-nil) of
+WINDOW to the left edge of the last (leftmost) glyph of that line.
+
+Normally, the value of this function is not available while Emacs is
+busy, for example, when processing a command. It should be retrievable
+though when run from an idle timer with a delay of zero seconds. */)
+ (Lisp_Object window, Lisp_Object first, Lisp_Object last, Lisp_Object body, Lisp_Object inverse, Lisp_Object left)
+{
+ struct window *w = decode_live_window (window);
+ struct buffer *b;
+ struct glyph_row *row, *end_row;
+ int max_y = NILP (body) ? WINDOW_PIXEL_HEIGHT (w) : window_text_bottom_y (w);
+ Lisp_Object rows = Qnil;
+ int window_width = NILP (body) ? w->pixel_width : window_body_width (w, true);
+ int header_line_height = WINDOW_HEADER_LINE_HEIGHT (w);
+ int subtract = NILP (body) ? 0 : header_line_height;
+ bool invert = !NILP (inverse);
+ bool left_flag = !NILP (left);
+
+ if (noninteractive || w->pseudo_window_p)
+ return Qnil;
+
+ CHECK_BUFFER (w->contents);
+ b = XBUFFER (w->contents);
+
+ /* Fail if current matrix is not up-to-date. */
+ if (!w->window_end_valid
+ || windows_or_buffers_changed
+ || b->clip_changed
+ || b->prevent_redisplay_optimizations_p
+ || window_outdated (w))
+ return Qnil;
+
+ if (NILP (first))
+ row = (NILP (body)
+ ? MATRIX_ROW (w->current_matrix, 0)
+ : MATRIX_FIRST_TEXT_ROW (w->current_matrix));
+ else if (NUMBERP (first))
+ {
+ CHECK_RANGED_INTEGER (first, 0, w->current_matrix->nrows);
+ row = MATRIX_ROW (w->current_matrix, XINT (first));
+ }
+ else
+ error ("Invalid specification of first line");
+
+ if (NILP (last))
+
+ end_row = (NILP (body)
+ ? MATRIX_ROW (w->current_matrix, w->current_matrix->nrows)
+ : MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w));
+ else if (NUMBERP (last))
+ {
+ CHECK_RANGED_INTEGER (last, 0, w->current_matrix->nrows);
+ end_row = MATRIX_ROW (w->current_matrix, XINT (last));
+ }
+ else
+ error ("Invalid specification of last line");
+
+ while (row <= end_row && row->enabled_p
+ && row->y + row->height < max_y)
+ {
+
+ if (left_flag)
+ {
+ struct glyph *glyph = row->glyphs[TEXT_AREA];
+
+ rows = Fcons (Fcons (make_number
+ (invert
+ ? glyph->pixel_width
+ : window_width - glyph->pixel_width),
+ make_number (row->y + row->height - subtract)),
+ rows);
+ }
+ else
+ rows = Fcons (Fcons (make_number
+ (invert
+ ? window_width - row->pixel_width
+ : row->pixel_width),
+ make_number (row->y + row->height - subtract)),
+ rows);
+ row++;
+ }
+
+ return Fnreverse (rows);
+}
+
DEFUN ("window-dedicated-p", Fwindow_dedicated_p, Swindow_dedicated_p,
0, 1, 0,
doc: /* Return non-nil when WINDOW is dedicated to its buffer.
@@ -2003,16 +2126,24 @@ return value is a list of elements of the form (PARAMETER . VALUE). */)
return Fcopy_alist (decode_valid_window (window)->window_parameters);
}
+Lisp_Object
+window_parameter (struct window *w, Lisp_Object parameter)
+{
+ Lisp_Object result = Fassq (parameter, w->window_parameters);
+
+ return CDR_SAFE (result);
+}
+
+
DEFUN ("window-parameter", Fwindow_parameter, Swindow_parameter,
2, 2, 0,
doc: /* Return WINDOW's value for PARAMETER.
WINDOW can be any window and defaults to the selected one. */)
(Lisp_Object window, Lisp_Object parameter)
{
- Lisp_Object result;
+ struct window *w = decode_any_window (window);
- result = Fassq (parameter, decode_any_window (window)->window_parameters);
- return CDR_SAFE (result);
+ return window_parameter (w, parameter);
}
DEFUN ("set-window-parameter", Fset_window_parameter,
@@ -3602,8 +3733,8 @@ make_parent_window (Lisp_Object window, bool horflag)
o = XWINDOW (window);
p = allocate_window ();
- memcpy ((char *) p + sizeof (struct vectorlike_header),
- (char *) o + sizeof (struct vectorlike_header),
+ memcpy ((char *) p + sizeof (union vectorlike_header),
+ (char *) o + sizeof (union vectorlike_header),
word_size * VECSIZE (struct window));
/* P's buffer slot may change from nil to a buffer... */
adjust_window_count (p, 1);
@@ -4740,6 +4871,69 @@ mark_window_cursors_off (struct window *w)
}
+/**
+ * window_wants_mode_line:
+ *
+ * Return 1 if window W wants a mode line and is high enough to
+ * accommodate it, 0 otherwise.
+ *
+ * W wants a mode line if it's a leaf window and neither a minibuffer
+ * nor a pseudo window. Moreover, its 'window-mode-line-format'
+ * parameter must not be 'none' and either that parameter or W's
+ * buffer's 'mode-line-format' value must be non-nil. Finally, W must
+ * be higher than its frame's canonical character height.
+ */
+bool
+window_wants_mode_line (struct window *w)
+{
+ Lisp_Object window_mode_line_format =
+ window_parameter (w, Qmode_line_format);
+
+ return ((WINDOW_LEAF_P (w)
+ && !MINI_WINDOW_P (w)
+ && !WINDOW_PSEUDO_P (w)
+ && !EQ (window_mode_line_format, Qnone)
+ && (!NILP (window_mode_line_format)
+ || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), mode_line_format)))
+ && WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w))
+ ? 1
+ : 0);
+}
+
+
+/**
+ * window_wants_header_line:
+ *
+ * Return 1 if window W wants a header line and is high enough to
+ * accommodate it, 0 otherwise.
+ *
+ * W wants a header line if it's a leaf window and neither a minibuffer
+ * nor a pseudo window. Moreover, its 'window-mode-line-format'
+ * parameter must not be 'none' and either that parameter or W's
+ * buffer's 'mode-line-format' value must be non-nil. Finally, W must
+ * be higher than its frame's canonical character height and be able to
+ * accommodate a mode line too if necessary (the mode line prevails).
+ */
+bool
+window_wants_header_line (struct window *w)
+{
+ Lisp_Object window_header_line_format =
+ window_parameter (w, Qheader_line_format);
+
+ return ((WINDOW_LEAF_P (w)
+ && !MINI_WINDOW_P (w)
+ && !WINDOW_PSEUDO_P (w)
+ && !EQ (window_header_line_format, Qnone)
+ && (!NILP (window_header_line_format)
+ || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format)))
+ && (WINDOW_PIXEL_HEIGHT (w)
+ > (window_wants_mode_line (w)
+ ? 2 * WINDOW_FRAME_LINE_HEIGHT (w)
+ : WINDOW_FRAME_LINE_HEIGHT (w))))
+ ? 1
+ : 0);
+}
+
/* Return number of lines of text (not counting mode lines) in W. */
int
@@ -4753,10 +4947,10 @@ window_internal_height (struct window *w)
|| WINDOWP (w->contents)
|| !NILP (w->next)
|| !NILP (w->prev)
- || WINDOW_WANTS_MODELINE_P (w))
+ || window_wants_mode_line (w))
--ht;
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
--ht;
}
@@ -5141,6 +5335,11 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
break;
}
SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it));
+ /* Fix up the Y position to preserve, if it is inside the
+ scroll margin at the window top. */
+ if (window_scroll_pixel_based_preserve_y >= 0
+ && window_scroll_pixel_based_preserve_y < this_scroll_margin)
+ window_scroll_pixel_based_preserve_y = this_scroll_margin;
}
}
else if (n < 0)
@@ -5156,6 +5355,9 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
/* We moved the window start towards BEGV, so PT may be now
in the scroll margin at the bottom. */
move_it_to (&it, PT, -1,
+ /* We subtract WINDOW_HEADER_LINE_HEIGHT because
+ it.y is relative to the bottom of the header
+ line, see above. */
(it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w)
- partial_line_height (&it) - this_scroll_margin - 1),
-1,
@@ -5193,11 +5395,14 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
/* See if point is on a partially visible line at the end. */
if (it.what == IT_EOB)
- partial_p = it.current_y + it.ascent + it.descent > it.last_visible_y;
+ partial_p =
+ it.current_y + it.ascent + it.descent
+ > it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w);
else
{
move_it_by_lines (&it, 1);
- partial_p = it.current_y > it.last_visible_y;
+ partial_p =
+ it.current_y > it.last_visible_y - WINDOW_HEADER_LINE_HEIGHT (w);
}
if (charpos == PT && !partial_p
@@ -5216,7 +5421,7 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror)
goal_y = this_scroll_margin;
SET_TEXT_POS_FROM_MARKER (start, w->start);
start_display (&it, w, start);
- /* It would be wrong to subtract CURRENT_HEADER_LINE_HEIGHT
+ /* It would be wrong to subtract WINDOW_HEADER_LINE_HEIGHT
here because we called start_display again and did not
alter it.current_y this time. */
move_it_to (&it, -1, window_scroll_pixel_based_preserve_x,
@@ -5633,8 +5838,8 @@ by this function. This happens in an interactive call. */)
}
DEFUN ("minibuffer-selected-window", Fminibuffer_selected_window, Sminibuffer_selected_window, 0, 0, 0,
- doc: /* Return the window which was selected when entering the minibuffer.
-Returns nil, if selected window is not a minibuffer window. */)
+ doc: /* Return window selected just before minibuffer window was selected.
+Return nil if the selected window is not a minibuffer window. */)
(void)
{
if (minibuf_level > 0
@@ -6033,7 +6238,7 @@ from the top of the window. */)
struct save_window_data
{
- struct vectorlike_header header;
+ union vectorlike_header header;
Lisp_Object selected_frame;
Lisp_Object current_window;
Lisp_Object f_current_buffer;
@@ -6061,7 +6266,7 @@ struct save_window_data
/* This is saved as a Lisp_Vector. */
struct saved_window
{
- struct vectorlike_header header;
+ union vectorlike_header header;
Lisp_Object window, buffer, start, pointm, old_pointm;
Lisp_Object pixel_left, pixel_top, pixel_height, pixel_width;
@@ -6462,7 +6667,7 @@ the return value is nil. Otherwise the value is t. */)
We have to do this in order to capture the following
scenario: Suppose our frame contains two live windows W1 and
- W2 and ‘set-window-configuration’ replaces them by two
+ W2 and 'set-window-configuration' replaces them by two
windows W3 and W4 that were dead the last time
run_window_size_change_functions was run. If W3 and W4 have
the same values for their old and new pixel sizes but these
@@ -7354,6 +7559,8 @@ syms_of_window (void)
DEFSYM (Qfloor, "floor");
DEFSYM (Qceiling, "ceiling");
DEFSYM (Qmark_for_redisplay, "mark-for-redisplay");
+ DEFSYM (Qmode_line_format, "mode-line-format");
+ DEFSYM (Qheader_line_format, "header-line-format");
staticpro (&Vwindow_list);
@@ -7416,8 +7623,8 @@ on their symbols to be controlled by this variable. */);
DEFVAR_LISP ("window-configuration-change-hook",
Vwindow_configuration_change_hook,
doc: /* Functions to call when window configuration changes.
-The buffer-local part is run once per window, with the relevant window
-selected; while the global part is run only once for the modified frame,
+The buffer-local value is run once per window, with the relevant window
+selected; while the global value is run only once for the modified frame,
with the relevant frame selected. */);
Vwindow_configuration_change_hook = Qnil;
@@ -7603,6 +7810,7 @@ displayed after a scrolling operation to be somewhat inaccurate. */);
defsubr (&Sset_window_point);
defsubr (&Sset_window_start);
defsubr (&Swindow_dedicated_p);
+ defsubr (&Swindow_lines_pixel_dimensions);
defsubr (&Sset_window_dedicated_p);
defsubr (&Swindow_display_table);
defsubr (&Sset_window_display_table);
diff --git a/src/window.h b/src/window.h
index acb8a5cabfa..25c9686a9f0 100644
--- a/src/window.h
+++ b/src/window.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef WINDOW_H_INCLUDED
#define WINDOW_H_INCLUDED
@@ -88,7 +88,7 @@ struct cursor_pos
struct window
{
/* This is for Lisp; the terminal code does not refer to it. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The frame this window is on. */
Lisp_Object frame;
@@ -328,8 +328,9 @@ struct window
/* True if this window is a minibuffer window. */
bool_bf mini : 1;
- /* Meaningful only if contents is a window, true if this
- internal window is used in horizontal combination. */
+ /* Meaningful for internal windows only: true if this window is a
+ horizontal combination, false if it is a vertical
+ combination. */
bool_bf horizontal : 1;
/* True means must regenerate mode line of this window. */
@@ -481,15 +482,14 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* True if W is a minibuffer window. */
#define MINI_WINDOW_P(W) ((W)->mini)
-/* 1 if W is a non-only minibuffer window. */
-/* The first check is redundant and the second overly complicated. */
-#define MINI_NON_ONLY_WINDOW_P(W) \
- (MINI_WINDOW_P (W) \
- && (EQ (W->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))
+/* True if W is a minibuffer window on a frame that contains at least
+ one other window. */
+#define MINI_NON_ONLY_WINDOW_P(W) \
+ (MINI_WINDOW_P (W) && !NILP ((W)->prev))
-/* 1 if W is a minibuffer-only window. */
-#define MINI_ONLY_WINDOW_P(W) \
- (MINI_WINDOW_P (W) && NILP (W->prev))
+/* True if W is a minibuffer window that is alone on its frame. */
+#define MINI_ONLY_WINDOW_P(W) \
+ (MINI_WINDOW_P (W) && NILP ((W)->prev))
/* General window layout:
@@ -518,29 +518,34 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* A handy macro. */
-/* Non-nil if W is leaf (carry the buffer). */
-
+/* Non-nil if window W is leaf window (has a buffer). */
#define WINDOW_LEAF_P(W) \
(BUFFERP ((W)->contents))
-/* Non-nil if W is internal. */
+/* Non-nil if window W is internal (is a parent window). */
#define WINDOW_INTERNAL_P(W) \
(WINDOWP ((W)->contents))
-/* True if W is a member of horizontal combination. */
+/* True if window W is a horizontal combination of windows. */
#define WINDOW_HORIZONTAL_COMBINATION_P(W) \
(WINDOW_INTERNAL_P (W) && (W)->horizontal)
-/* True if W is a member of vertical combination. */
+/* True if window W is a vertical combination of windows. */
#define WINDOW_VERTICAL_COMBINATION_P(W) \
(WINDOW_INTERNAL_P (W) && !(W)->horizontal)
-/* WINDOW's XFRAME. */
+/* Window W's XFRAME. */
#define WINDOW_XFRAME(W) (XFRAME (WINDOW_FRAME ((W))))
-/* Whether WINDOW is a pseudo window. */
+/* Whether window W is a pseudo window. */
#define WINDOW_PSEUDO_P(W) ((W)->pseudo_window_p)
+/* Window W's buffer. */
+#define WINDOW_BUFFER(W) \
+ (WINDOW_LEAF_P(W) \
+ ? (W)->contents \
+ : Qnil) \
+
/* Return the canonical column width of the frame of window W. */
#define WINDOW_FRAME_COLUMN_WIDTH(W) \
(FRAME_COLUMN_WIDTH (WINDOW_XFRAME ((W))))
@@ -549,24 +554,24 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define WINDOW_FRAME_LINE_HEIGHT(W) \
(FRAME_LINE_HEIGHT (WINDOW_XFRAME ((W))))
-/* Return the pixel width of window W.
- This includes scroll bars and fringes. */
+/* Return the pixel width of window W. This includes dividers, scroll
+ bars, fringes and margins, if any. */
#define WINDOW_PIXEL_WIDTH(W) (W)->pixel_width
-/* Return the pixel height of window W.
- This includes header and mode lines, if any. */
+/* Return the pixel height of window W. This includes dividers, scroll
+ bars, header and mode lines, if any. */
#define WINDOW_PIXEL_HEIGHT(W) (W)->pixel_height
-/* Return the width of window W in canonical column units.
- This includes scroll bars and fringes.
- This value is adjusted such that the sum of the widths of all child
+/* Return the width of window W in canonical column units. This
+ includes dividers, scroll bars, fringes and margins, if any. The
+ value is adjusted such that the sum of the widths of all child
windows equals the width of their parent window. */
#define WINDOW_TOTAL_COLS(W) (W)->total_cols
-/* Return the height of window W in canonical line units.
- This includes header and mode lines, if any.
- This value is adjusted such that the sum of the heights of all child
- windows equals the height of their parent window. */
+/* Return the height of window W in canonical line units. This includes
+ dividers, scroll bars, header and mode lines, if any. The value is
+ adjusted such that the sum of the heights of all child windows equals
+ the height of their parent window. */
#define WINDOW_TOTAL_LINES(W) (W)->total_lines
/* The smallest acceptable dimensions for a window. Anything smaller
@@ -581,31 +586,63 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define MIN_SAFE_WINDOW_PIXEL_HEIGHT(W) \
(WINDOW_FRAME_LINE_HEIGHT (W))
+/* True if window W has no other windows to its left on its frame. */
+#define WINDOW_LEFTMOST_P(W) \
+ (WINDOW_LEFT_PIXEL_EDGE (W) == 0)
+
+/* True if window W has no other windows above it on its frame. */
+#define WINDOW_TOPMOST_P(W) \
+ (WINDOW_TOP_PIXEL_EDGE (W) == 0)
+
+/* True if window W has no other windows to its right on its frame. */
+#define WINDOW_RIGHTMOST_P(W) \
+ (WINDOW_RIGHT_PIXEL_EDGE (W) \
+ == (WINDOW_RIGHT_PIXEL_EDGE \
+ (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
+
+/* True if window W has no other windows below it on its frame (the
+ minibuffer window is not counted in this respect unless W itself is a
+ minibuffer window). */
+#define WINDOW_BOTTOMMOST_P(W) \
+ (WINDOW_BOTTOM_PIXEL_EDGE (W) \
+ == (WINDOW_BOTTOM_PIXEL_EDGE \
+ (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
+
+/* True if window W takes up the full width of its frame. */
+#define WINDOW_FULL_WIDTH_P(W) \
+ (WINDOW_PIXEL_WIDTH (W) \
+ == (WINDOW_PIXEL_WIDTH \
+ (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
+
/* Width of right divider of window W. */
#define WINDOW_RIGHT_DIVIDER_WIDTH(W) \
- ((WINDOW_RIGHTMOST_P (W) || MINI_WINDOW_P (W)) \
- ? 0 \
- : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
+ (WINDOW_RIGHTMOST_P (W) \
+ ? 0 : FRAME_RIGHT_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
+
+/* Width of bottom divider of window W. */
+#define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \
+ (((WINDOW_BOTTOMMOST_P (W) \
+ && NILP ((XWINDOW (FRAME_ROOT_WINDOW \
+ (WINDOW_XFRAME (W))))->next)) \
+ || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \
+ || (W)->pseudo_window_p) \
+ ? 0 : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
/* Return the canonical frame column at which window W starts.
This includes a left-hand scroll bar, if any. */
-
#define WINDOW_LEFT_EDGE_COL(W) (W)->left_col
/* Return the canonical frame column before which window W ends.
This includes a right-hand scroll bar, if any. */
-
#define WINDOW_RIGHT_EDGE_COL(W) \
(WINDOW_LEFT_EDGE_COL (W) + WINDOW_TOTAL_COLS (W))
/* Return the canonical frame line at which window W starts.
This includes a header line, if any. */
-
#define WINDOW_TOP_EDGE_LINE(W) (W)->top_line
/* Return the canonical frame line before which window W ends.
This includes a mode line, if any. */
-
#define WINDOW_BOTTOM_EDGE_LINE(W) \
(WINDOW_TOP_EDGE_LINE (W) + WINDOW_TOTAL_LINES (W))
@@ -629,20 +666,17 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Return the frame x-position at which window W starts.
This includes a left-hand scroll bar, if any. */
-
#define WINDOW_LEFT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_LEFT_PIXEL_EDGE (W))
/* Return the frame x- position before which window W ends.
This includes a right-hand scroll bar, if any. */
-
#define WINDOW_RIGHT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_RIGHT_PIXEL_EDGE (W))
/* True if W is a menu bar window. */
-
#if defined (HAVE_X_WINDOWS) && ! defined (USE_X_TOOLKIT) && ! defined (USE_GTK)
#define WINDOW_MENU_BAR_P(W) \
(WINDOWP (WINDOW_XFRAME (W)->menu_bar_window) \
@@ -661,72 +695,24 @@ wset_next_buffers (struct window *w, Lisp_Object val)
#define WINDOW_TOOL_BAR_P(W) false
#endif
-/* Return the frame y-position at which window W starts.
- This includes a header line, if any.
-
- PXW: With a menu or tool bar this is not symmetric to the _X values
- since it _does_ include the internal border width. */
+/* Return the frame y-position at which window W starts. */
#define WINDOW_TOP_EDGE_Y(W) \
(((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \
? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \
+ WINDOW_TOP_PIXEL_EDGE (W))
-/* Return the frame y-position before which window W ends.
- This includes a mode line, if any. */
+/* Return the frame y-position before which window W ends. */
#define WINDOW_BOTTOM_EDGE_Y(W) \
(((WINDOW_MENU_BAR_P (W) || WINDOW_TOOL_BAR_P (W)) \
? 0 : FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W))) \
+ WINDOW_BOTTOM_PIXEL_EDGE (W))
-/* True if window W takes up the full width of its frame. */
-#define WINDOW_FULL_WIDTH_P(W) \
- (WINDOW_PIXEL_WIDTH (W) \
- == (WINDOW_PIXEL_WIDTH \
- (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
-
-/* True if window W's has no other windows to its left in its frame. */
-
-#define WINDOW_LEFTMOST_P(W) \
- (WINDOW_LEFT_PIXEL_EDGE (W) == 0)
-
-/* True if window W's has no other windows above in its frame. */
-#define WINDOW_TOPMOST_P(W) \
- (WINDOW_TOP_PIXEL_EDGE (W) == 0)
-
-/* True if window W's has no other windows to its right in its frame. */
-#define WINDOW_RIGHTMOST_P(W) \
- (WINDOW_RIGHT_PIXEL_EDGE (W) \
- == (WINDOW_RIGHT_PIXEL_EDGE \
- (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
-
-/* True if window W's has no other windows below it in its frame
- (the minibuffer window is not counted in this respect). */
-#define WINDOW_BOTTOMMOST_P(W) \
- (WINDOW_BOTTOM_PIXEL_EDGE (W) \
- == (WINDOW_BOTTOM_PIXEL_EDGE \
- (XWINDOW (FRAME_ROOT_WINDOW (WINDOW_XFRAME (W)))))) \
-
-/* Return the frame column at which the text (or left fringe) in
- window W starts. This is different from the `LEFT_EDGE' because it
- does not include a left-hand scroll bar if any. */
-#define WINDOW_BOX_LEFT_EDGE_COL(W) \
- (WINDOW_LEFT_EDGE_COL (W) \
- + WINDOW_LEFT_SCROLL_BAR_COLS (W))
-
-/* Return the pixel value where the text (or left fringe) in
- window W starts. This is different from the `LEFT_EDGE' because it
- does not include a left-hand scroll bar if any. */
+/* Return the pixel value where the text (or left fringe) in window W
+ starts. */
#define WINDOW_BOX_LEFT_PIXEL_EDGE(W) \
(WINDOW_LEFT_PIXEL_EDGE (W) \
+ WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (W))
-/* Return the window column before which the text in window W ends.
- This is different from WINDOW_RIGHT_EDGE_COL because it does not
- include a scroll bar or window-separating line on the right edge. */
-#define WINDOW_BOX_RIGHT_EDGE_COL(W) \
- (WINDOW_RIGHT_EDGE_COL (W) \
- - WINDOW_RIGHT_SCROLL_BAR_COLS (W))
-
/* Return the pixel value before which the text in window W ends. This
is different from the `RIGHT_EDGE' because it does not include a
right-hand scroll bar or window-separating line on the right
@@ -736,16 +722,16 @@ wset_next_buffers (struct window *w, Lisp_Object val)
- WINDOW_RIGHT_DIVIDER_WIDTH (W) \
- WINDOW_RIGHT_SCROLL_BAR_AREA_WIDTH (W))
-/* Return the frame position at which the text (or left fringe) in
- window W starts. This is different from the `LEFT_EDGE' because it
- does not include a left-hand scroll bar if any. */
+/* Return the frame x-position at which the text (or left fringe) in
+ window W starts. This does not include a left-hand scroll bar if
+ any. */
#define WINDOW_BOX_LEFT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_BOX_LEFT_PIXEL_EDGE (W))
-/* Return the window column before which the text in window W ends.
- This is different from WINDOW_RIGHT_EDGE_COL because it does not
- include a scroll bar or window-separating line on the right edge. */
+/* Return the frame x-position before which the text in window W ends.
+ This does not include a scroll bar, divider or window-separating line
+ on the right edge. */
#define WINDOW_BOX_RIGHT_EDGE_X(W) \
(FRAME_INTERNAL_BORDER_WIDTH (WINDOW_XFRAME (W)) \
+ WINDOW_BOX_RIGHT_PIXEL_EDGE (W))
@@ -899,16 +885,6 @@ wset_next_buffers (struct window *w, Lisp_Object val)
? WINDOW_BOX_RIGHT_EDGE_X (W) \
: WINDOW_LEFT_EDGE_X (W))
-/* Width of bottom divider of window W. */
-#define WINDOW_BOTTOM_DIVIDER_WIDTH(W) \
- (((WINDOW_BOTTOMMOST_P (W) \
- && NILP ((XWINDOW (FRAME_ROOT_WINDOW \
- (WINDOW_XFRAME (W))))->next)) \
- || EQ ((W)->prev, FRAME_ROOT_WINDOW (WINDOW_XFRAME (W))) \
- || (W)->pseudo_window_p) \
- ? 0 \
- : FRAME_BOTTOM_DIVIDER_WIDTH (WINDOW_XFRAME (W)))
-
/* Height that a scroll bar in window W should have, if there is one.
Measured in pixels. If scroll bars are turned off, this is still
nonzero. */
@@ -942,22 +918,22 @@ wset_next_buffers (struct window *w, Lisp_Object val)
/* Height in pixels of the mode line.
May be zero if W doesn't have a mode line. */
#define WINDOW_MODE_LINE_HEIGHT(W) \
- (WINDOW_WANTS_MODELINE_P ((W)) \
+ (window_wants_mode_line ((W)) \
? CURRENT_MODE_LINE_HEIGHT (W) \
: 0)
#define WINDOW_MODE_LINE_LINES(W) \
- WINDOW_WANTS_MODELINE_P (W)
+ window_wants_mode_line (W)
/* Height in pixels of the header line.
Zero if W doesn't have a header line. */
#define WINDOW_HEADER_LINE_HEIGHT(W) \
- (WINDOW_WANTS_HEADER_LINE_P (W) \
+ (window_wants_header_line (W) \
? CURRENT_HEADER_LINE_HEIGHT (W) \
: 0)
#define WINDOW_HEADER_LINE_LINES(W) \
- WINDOW_WANTS_HEADER_LINE_P (W)
+ window_wants_header_line (W)
/* Pixel height of window W without mode line, bottom scroll bar and
bottom divider. */
@@ -1114,10 +1090,13 @@ struct glyph *get_phys_cursor_glyph (struct window *w);
extern Lisp_Object Vwindow_list;
extern Lisp_Object window_list (void);
+extern Lisp_Object window_parameter (struct window *, Lisp_Object parameter);
extern struct window *decode_live_window (Lisp_Object);
extern struct window *decode_any_window (Lisp_Object);
extern bool compare_window_configurations (Lisp_Object, Lisp_Object, bool);
extern void mark_window_cursors_off (struct window *);
+extern bool window_wants_mode_line (struct window *);
+extern bool window_wants_header_line (struct window *);
extern int window_internal_height (struct window *);
extern int window_body_width (struct window *w, bool);
enum margin_unit { MARGIN_IN_LINES, MARGIN_IN_PIXELS };
@@ -1133,7 +1112,6 @@ 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 34ee877e6be..7e47c06c2d7 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* New redisplay written by Gerd Moellmann <gerd@gnu.org>.
@@ -290,6 +290,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <stdio.h>
#include <stdlib.h>
#include <limits.h>
+#include <math.h>
#include "lisp.h"
#include "atimer.h"
@@ -324,7 +325,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#define FRAME_X_OUTPUT(f) ((f)->output_data.x)
#endif
-#define INFINITY 10000000
+#define DISP_INFINITY 10000000
/* Holds the list (error). */
static Lisp_Object list_of_error;
@@ -832,6 +833,8 @@ static bool cursor_row_fully_visible_p (struct window *, bool, bool);
static bool update_menu_bar (struct frame *, bool, bool);
static bool try_window_reusing_current_matrix (struct window *);
static int try_window_id (struct window *);
+static void maybe_produce_line_number (struct it *);
+static bool should_produce_line_number (struct it *);
static bool display_line (struct it *, int);
static int display_mode_lines (struct window *);
static int display_mode_line (struct window *, enum face_id, Lisp_Object);
@@ -843,6 +846,8 @@ static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
static void display_menu_bar (struct window *);
static ptrdiff_t display_count_lines (ptrdiff_t, 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);
static void compute_line_metrics (struct it *);
@@ -871,9 +876,9 @@ static int face_before_or_after_it_pos (struct it *, bool);
static ptrdiff_t next_overlay_change (ptrdiff_t);
static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object,
Lisp_Object, struct text_pos *, ptrdiff_t, bool);
-static int handle_single_display_spec (struct it *, Lisp_Object,
- Lisp_Object, Lisp_Object,
- struct text_pos *, ptrdiff_t, int, bool);
+static int handle_single_display_spec (struct it *, Lisp_Object, Lisp_Object,
+ Lisp_Object, struct text_pos *,
+ ptrdiff_t, int, bool, bool);
static int underlying_face_id (struct it *);
#define face_before_it_pos(IT) face_before_or_after_it_pos (IT, true)
@@ -921,7 +926,7 @@ window_text_bottom_y (struct window *w)
height -= WINDOW_BOTTOM_DIVIDER_WIDTH (w);
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
height -= CURRENT_MODE_LINE_HEIGHT (w);
height -= WINDOW_SCROLL_BAR_AREA_HEIGHT (w);
@@ -978,7 +983,7 @@ window_box_height (struct window *w)
the appropriate glyph row has its `mode_line_p' flag set,
and if it doesn't, uses estimate_mode_line_height instead. */
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
{
struct glyph_row *ml_row
= (w->current_matrix && w->current_matrix->rows
@@ -990,7 +995,7 @@ window_box_height (struct window *w)
height -= estimate_mode_line_height (f, CURRENT_MODE_LINE_FACE_ID (w));
}
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
{
struct glyph_row *hl_row
= (w->current_matrix && w->current_matrix->rows
@@ -1102,7 +1107,7 @@ window_box (struct window *w, enum glyph_row_area area, int *box_x,
if (box_y)
{
*box_y = WINDOW_TOP_EDGE_Y (w);
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
*box_y += CURRENT_HEADER_LINE_HEIGHT (w);
}
}
@@ -1190,6 +1195,10 @@ Value is the height in pixels of the line at point. */)
}
SET_TEXT_POS (pt, PT, PT_BYTE);
start_display (&it, w, pt);
+ /* Start from the beginning of the screen line, to make sure we
+ traverse all of its display elements, and thus capture the
+ correct metrics. */
+ move_it_by_lines (&it, 0);
it.vpos = it.current_y = 0;
last_height = 0;
result = make_number (line_bottom_y (&it));
@@ -1321,16 +1330,39 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
if (charpos >= 0 && CHARPOS (top) > charpos)
return visible_p;
+ /* Some Lisp hook could call us in the middle of redisplaying this
+ very window. If, by some bad luck, we are retrying redisplay
+ because we found that the mode-line height and/or header-line
+ height needs to be updated, the assignment of mode_line_height
+ and header_line_height below could disrupt that, due to the
+ selected/nonselected window dance during mode-line display, and
+ we could infloop. Avoid that. */
+ int prev_mode_line_height = w->mode_line_height;
+ int prev_header_line_height = w->header_line_height;
/* Compute exact mode line heights. */
- if (WINDOW_WANTS_MODELINE_P (w))
- w->mode_line_height
- = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w),
- BVAR (current_buffer, mode_line_format));
+ if (window_wants_mode_line (w))
+ {
+ Lisp_Object window_mode_line_format
+ = window_parameter (w, Qmode_line_format);
+
+ w->mode_line_height
+ = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w),
+ NILP (window_mode_line_format)
+ ? BVAR (current_buffer, mode_line_format)
+ : window_mode_line_format);
+ }
+
+ if (window_wants_header_line (w))
+ {
+ Lisp_Object window_header_line_format
+ = window_parameter (w, Qheader_line_format);
- if (WINDOW_WANTS_HEADER_LINE_P (w))
- w->header_line_height
- = display_mode_line (w, HEADER_LINE_FACE_ID,
- BVAR (current_buffer, header_line_format));
+ w->header_line_height
+ = display_mode_line (w, HEADER_LINE_FACE_ID,
+ NILP (window_header_line_format)
+ ? BVAR (current_buffer, header_line_format)
+ : window_header_line_format);
+ }
start_display (&it, w, top);
move_it_to (&it, charpos, -1, it.last_visible_y - 1, -1,
@@ -1653,6 +1685,10 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y,
fprintf (stderr, "-pv pt=%d vs=%d\n", charpos, w->vscroll);
#endif
+ /* Restore potentially overwritten values. */
+ w->mode_line_height = prev_mode_line_height;
+ w->header_line_height = prev_header_line_height;
+
return visible_p;
}
@@ -2842,13 +2878,12 @@ init_iterator (struct it *it, struct window *w,
/* Get dimensions of truncation and continuation glyphs. These are
displayed as fringe bitmaps under X, but we need them for such
- frames when the fringes are turned off. But leave the dimensions
- zero for tooltip frames, as these glyphs look ugly there and also
- sabotage calculations of tooltip dimensions in x-show-tip. */
+ frames when the fringes are turned off. The no_special_glyphs slot
+ of the iterator's frame, when set, suppresses their display - by
+ default for tooltip frames and when set via the 'no-special-glyphs'
+ frame parameter. */
#ifdef HAVE_WINDOW_SYSTEM
- if (!(FRAME_WINDOW_P (it->f)
- && FRAMEP (tip_frame)
- && it->f == XFRAME (tip_frame)))
+ if (!(FRAME_WINDOW_P (it->f) && it->f->no_special_glyphs))
#endif
{
if (it->line_wrap == TRUNCATE)
@@ -2920,7 +2955,7 @@ init_iterator (struct it *it, struct window *w,
it->last_visible_x -= it->continuation_pixel_width;
}
- it->header_line_p = WINDOW_WANTS_HEADER_LINE_P (w);
+ it->header_line_p = window_wants_header_line (w);
it->current_y = WINDOW_HEADER_LINE_HEIGHT (w) + w->vscroll;
}
@@ -3019,7 +3054,7 @@ void
start_display (struct it *it, struct window *w, struct text_pos pos)
{
struct glyph_row *row;
- bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w);
+ bool first_vpos = window_wants_header_line (w);
row = w->desired_matrix->rows + first_vpos;
init_iterator (it, w, CHARPOS (pos), BYTEPOS (pos), row, DEFAULT_FACE_ID);
@@ -4713,6 +4748,14 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
ptrdiff_t bufpos, bool frame_window_p)
{
int replacing = 0;
+ bool enable_eval = true;
+
+ /* Support (disable-eval PROP) which is used by enriched.el. */
+ if (CONSP (spec) && EQ (XCAR (spec), Qdisable_eval))
+ {
+ enable_eval = false;
+ spec = XCAR (XCDR (spec));
+ }
if (CONSP (spec)
/* Simple specifications. */
@@ -4736,7 +4779,8 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
{
int rv = handle_single_display_spec (it, XCAR (spec), object,
overlay, position, bufpos,
- replacing, frame_window_p);
+ replacing, frame_window_p,
+ enable_eval);
if (rv != 0)
{
replacing = rv;
@@ -4754,7 +4798,8 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
{
int rv = handle_single_display_spec (it, AREF (spec, i), object,
overlay, position, bufpos,
- replacing, frame_window_p);
+ replacing, frame_window_p,
+ enable_eval);
if (rv != 0)
{
replacing = rv;
@@ -4767,7 +4812,8 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
}
else
replacing = handle_single_display_spec (it, spec, object, overlay, position,
- bufpos, 0, frame_window_p);
+ bufpos, 0, frame_window_p,
+ enable_eval);
return replacing;
}
@@ -4812,6 +4858,8 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos)
don't set up IT. In that case, FRAME_WINDOW_P means SPEC
is intended to be displayed in a window on a GUI frame.
+ Enable evaluation of Lisp forms only if ENABLE_EVAL_P is true.
+
Value is non-zero if something was found which replaces the display
of buffer or string text. */
@@ -4819,7 +4867,7 @@ static int
handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
Lisp_Object overlay, struct text_pos *position,
ptrdiff_t bufpos, int display_replaced,
- bool frame_window_p)
+ bool frame_window_p, bool enable_eval_p)
{
Lisp_Object form;
Lisp_Object location, value;
@@ -4837,6 +4885,8 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
spec = XCDR (spec);
}
+ if (!NILP (form) && !EQ (form, Qt) && !enable_eval_p)
+ form = Qnil;
if (!NILP (form) && !EQ (form, Qt))
{
ptrdiff_t count = SPECPDL_INDEX ();
@@ -4885,7 +4935,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
steps = - steps;
it->face_id = smaller_face (it->f, it->face_id, steps);
}
- else if (FUNCTIONP (it->font_height))
+ else if (FUNCTIONP (it->font_height) && enable_eval_p)
{
/* Call function with current height as argument.
Value is the new height. */
@@ -4906,7 +4956,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
new_height = (XFLOATINT (it->font_height)
* XINT (f->lface[LFACE_HEIGHT_INDEX]));
}
- else
+ else if (enable_eval_p)
{
/* Evaluate IT->font_height with `height' bound to the
current specified height to get the new height. */
@@ -5217,6 +5267,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object,
it->prev_stop = 0;
it->base_level_stop = 0;
it->string_from_display_prop_p = true;
+ it->cmp_it.id = -1;
/* Say that we haven't consumed the characters with
`display' property yet. The call to pop_it in
set_iterator_to_next will clean this up. */
@@ -5935,6 +5986,7 @@ get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, bool compute_stop_p)
it->multibyte_p = STRING_MULTIBYTE (it->string);
it->method = GET_FROM_STRING;
it->from_disp_prop_p = 0;
+ it->cmp_it.id = -1;
/* Force paragraph direction to be that of the parent
buffer. */
@@ -6751,7 +6803,7 @@ reseat_to_string (struct it *it, const char *s, Lisp_Object string,
FIELD_WIDTH < 0 means infinite field width. This is useful for
padding with `-' at the end of a mode line. */
if (field_width < 0)
- field_width = INFINITY;
+ field_width = DISP_INFINITY;
/* Implementation note: We deliberately don't enlarge
it->bidi_it.string.schars here to fit it->end_charpos, because
the bidi iterator cannot produce characters out of thin air. */
@@ -7755,9 +7807,8 @@ next_element_from_display_vector (struct it *it)
/* KFS: This code used to check ip->dpvec[0] instead of the current element.
That seemed totally bogus - so I changed it... */
- gc = it->dpvec[it->current.dpvec_index];
-
- if (GLYPH_CODE_P (gc))
+ if (it->dpend - it->dpvec > 0 /* empty dpvec[] is invalid */
+ && (gc = it->dpvec[it->current.dpvec_index], GLYPH_CODE_P (gc)))
{
struct face *this_face, *prev_face, *next_face;
@@ -8601,6 +8652,7 @@ move_it_in_display_line_to (struct it *it,
ptrdiff_t closest_pos UNINIT;
ptrdiff_t prev_pos = IT_CHARPOS (*it);
bool saw_smaller_pos = prev_pos < to_charpos;
+ bool line_number_pending = false;
/* Don't produce glyphs in produce_glyphs. */
saved_glyph_row = it->glyph_row;
@@ -8649,9 +8701,20 @@ move_it_in_display_line_to (struct it *it,
|| (it->method == GET_FROM_DISPLAY_VECTOR \
&& it->dpvec + it->current.dpvec_index + 1 >= it->dpend)))
- /* If there's a line-/wrap-prefix, handle it. */
- if (it->hpos == 0 && it->method == GET_FROM_BUFFER)
- handle_line_prefix (it);
+ if (it->hpos == 0)
+ {
+ /* If line numbers are being displayed, produce a line number. */
+ if (should_produce_line_number (it))
+ {
+ if (it->current_x == it->first_visible_x)
+ maybe_produce_line_number (it);
+ else
+ line_number_pending = true;
+ }
+ /* If there's a line-/wrap-prefix, handle it. */
+ if (it->method == GET_FROM_BUFFER)
+ handle_line_prefix (it);
+ }
if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos))
SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it));
@@ -9018,6 +9081,15 @@ move_it_in_display_line_to (struct it *it,
if (new_x > it->first_visible_x)
{
+ /* If we have reached the visible portion of the
+ screen line, produce the line number if needed. */
+ if (line_number_pending)
+ {
+ line_number_pending = false;
+ it->current_x = it->first_visible_x;
+ maybe_produce_line_number (it);
+ it->current_x += new_x - it->first_visible_x;
+ }
/* Glyph is visible. Increment number of glyphs that
would be displayed. */
++it->hpos;
@@ -11438,6 +11510,9 @@ echo_area_display (bool update_frame_p)
struct frame *sf = SELECTED_FRAME ();
mini_window = FRAME_MINIBUF_WINDOW (sf);
+ if (NILP (mini_window))
+ return;
+
w = XWINDOW (mini_window);
f = XFRAME (WINDOW_FRAME (w));
@@ -12248,7 +12323,7 @@ build_desired_tool_bar_string (struct frame *f)
/* Reuse f->desired_tool_bar_string, if possible. */
if (size < size_needed || NILP (f->desired_tool_bar_string))
fset_desired_tool_bar_string
- (f, Fmake_string (make_number (size_needed), make_number (' ')));
+ (f, Fmake_string (make_number (size_needed), make_number (' '), Qnil));
else
{
AUTO_LIST4 (props, Qdisplay, Qnil, Qmenu_item, Qnil);
@@ -13057,6 +13132,43 @@ hscroll_window_tree (Lisp_Object window)
}
bool row_r2l_p = cursor_row->reversed_p;
bool hscl = hscrolling_current_line_p (w);
+ int x_offset = 0;
+ /* When line numbers are displayed, we need to account for
+ the horizontal space they consume. */
+ if (!NILP (Vdisplay_line_numbers))
+ {
+ struct glyph *g;
+ if (!row_r2l_p)
+ {
+ for (g = cursor_row->glyphs[TEXT_AREA];
+ g < cursor_row->glyphs[TEXT_AREA]
+ + cursor_row->used[TEXT_AREA];
+ g++)
+ {
+ if (!(NILP (g->object) && g->charpos < 0))
+ break;
+ x_offset += g->pixel_width;
+ }
+ }
+ else
+ {
+ for (g = cursor_row->glyphs[TEXT_AREA]
+ + cursor_row->used[TEXT_AREA];
+ g > cursor_row->glyphs[TEXT_AREA];
+ g--)
+ {
+ if (!(NILP ((g - 1)->object) && (g - 1)->charpos < 0))
+ break;
+ x_offset += (g - 1)->pixel_width;
+ }
+ }
+ }
+ if (cursor_row->truncated_on_left_p)
+ {
+ /* On TTY frames, don't count the left truncation glyph. */
+ struct frame *f = XFRAME (WINDOW_FRAME (w));
+ x_offset -= (FRAME_TERMCAP_P (f) || FRAME_MSDOS_P (f));
+ }
text_area_width = window_box_width (w, TEXT_AREA);
@@ -13065,8 +13177,20 @@ hscroll_window_tree (Lisp_Object window)
/* If the position of this window's point has explicitly
changed, no more suspend auto hscrolling. */
- if (NILP (Fequal (Fwindow_point (window), Fwindow_old_point (window))))
- w->suspend_auto_hscroll = false;
+ if (w->suspend_auto_hscroll
+ && NILP (Fequal (Fwindow_point (window),
+ Fwindow_old_point (window))))
+ {
+ w->suspend_auto_hscroll = false;
+ /* When hscrolling just the current line, and the rest
+ of lines were temporarily hscrolled, but no longer
+ are, force thorough redisplay of this window, to show
+ the effect of disabling hscroll suspension immediately. */
+ if (w->min_hscroll == 0 && w->hscroll > 0
+ && EQ (Fbuffer_local_value (Qauto_hscroll_mode, w->contents),
+ Qcurrent_line))
+ SET_FRAME_GARBAGED (XFRAME (w->frame));
+ }
/* Remember window point. */
Fset_marker (w->old_pointm,
@@ -13089,7 +13213,7 @@ hscroll_window_tree (Lisp_Object window)
inside the left margin and the window is already
hscrolled. */
&& ((!row_r2l_p
- && ((w->hscroll && w->cursor.x <= h_margin)
+ && ((w->hscroll && w->cursor.x <= h_margin + x_offset)
|| (cursor_row->enabled_p
&& cursor_row->truncated_on_right_p
&& (w->cursor.x >= text_area_width - h_margin))))
@@ -13107,7 +13231,8 @@ hscroll_window_tree (Lisp_Object window)
&& cursor_row->truncated_on_right_p
&& w->cursor.x <= h_margin)
|| (w->hscroll
- && (w->cursor.x >= text_area_width - h_margin))))
+ && (w->cursor.x >= (text_area_width - h_margin
+ - x_offset)))))
/* This last condition is needed when moving
vertically from an hscrolled line to a short line
that doesn't need to be hscrolled. If we omit
@@ -13138,7 +13263,7 @@ hscroll_window_tree (Lisp_Object window)
if (hscl)
it.first_visible_x = window_hscroll_limited (w, it.f)
* FRAME_COLUMN_WIDTH (it.f);
- it.last_visible_x = INFINITY;
+ it.last_visible_x = DISP_INFINITY;
move_it_in_display_line_to (&it, pt, -1, MOVE_TO_POS);
/* If the line ends in an overlay string with a newline,
we might infloop, because displaying the window will
@@ -14784,15 +14909,12 @@ set_cursor_from_row (struct window *w, struct glyph_row *row,
while (glyph > end + 1
&& NILP (glyph->object)
&& glyph->charpos < 0)
- {
- --glyph;
- x -= glyph->pixel_width;
- }
+ --glyph;
if (NILP (glyph->object) && glyph->charpos < 0)
--glyph;
/* By default, in reversed rows we put the cursor on the
rightmost (first in the reading order) glyph. */
- for (g = end + 1; g < glyph; g++)
+ for (x = 0, g = end + 1; g < glyph; g++)
x += g->pixel_width;
while (end < glyph
&& NILP ((end + 1)->object)
@@ -15799,7 +15921,7 @@ compute_window_start_on_continuation_line (struct window *w)
/* Find the start of the continued line. This should be fast
because find_newline is fast (newline cache). */
- row = w->desired_matrix->rows + WINDOW_WANTS_HEADER_LINE_P (w);
+ row = w->desired_matrix->rows + window_wants_header_line (w);
init_iterator (&it, w, CHARPOS (start_pos), BYTEPOS (start_pos),
row, DEFAULT_FACE_ID);
reseat_at_previous_visible_line_start (&it);
@@ -15823,7 +15945,7 @@ compute_window_start_on_continuation_line (struct window *w)
So, we're looking for the display line start with the
minimum distance from the old window start. */
pos_before_pt = pos = it.current.pos;
- min_distance = INFINITY;
+ min_distance = DISP_INFINITY;
while ((distance = eabs (CHARPOS (start_pos) - IT_CHARPOS (it))),
distance < min_distance)
{
@@ -15929,6 +16051,17 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
&& !windows_or_buffers_changed
&& !f->cursor_type_changed
&& NILP (Vshow_trailing_whitespace)
+ /* When display-line-numbers is in relative mode, moving point
+ requires to redraw the entire window. */
+ && !EQ (Vdisplay_line_numbers, Qrelative)
+ && !EQ (Vdisplay_line_numbers, Qvisual)
+ /* When the current line number should be displayed in a
+ distinct face, moving point cannot be handled in optimized
+ way as below. */
+ && !(!NILP (Vdisplay_line_numbers)
+ && NILP (Finternal_lisp_face_equal_p (Qline_number,
+ Qline_number_current_line,
+ w->frame)))
/* This code is not used for mini-buffer for the sake of the case
of redisplaying to replace an echo area message; since in
that case the mini-buffer contents per se are usually
@@ -15936,8 +16069,10 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
since the handling of this_line_start_pos, etc., in redisplay
handles the same cases. */
&& !EQ (window, minibuf_window)
- && (FRAME_WINDOW_P (f)
- || !overlay_arrow_in_current_buffer_p ()))
+ /* When overlay arrow is shown in current buffer, point movement
+ is no longer "simple", as it typically causes the overlay
+ arrow to move as well. */
+ && !overlay_arrow_in_current_buffer_p ())
{
int this_scroll_margin, top_scroll_margin;
struct glyph_row *row = NULL;
@@ -15949,7 +16084,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp,
this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS);
top_scroll_margin = this_scroll_margin;
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
top_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w);
/* Start with the row the cursor was displayed during the last
@@ -16419,9 +16554,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
eassert (XMARKER (w->start)->buffer == buffer);
eassert (XMARKER (w->pointm)->buffer == buffer);
- /* We come here again if we need to run window-text-change-functions
- below. */
- restart:
reconsider_clip_changes (w);
frame_line_height = default_line_pixel_height (w);
margin = window_scroll_margin (w, MARGIN_IN_LINES);
@@ -16488,16 +16620,6 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
&& !window_outdated (w)
&& !hscrolling_current_line_p (w));
- /* Run the window-text-change-functions
- if it is possible that the text on the screen has changed
- (either due to modification of the text, or any other reason). */
- if (!current_matrix_up_to_date_p
- && !NILP (Vwindow_text_change_functions))
- {
- safe_run_hooks (Qwindow_text_change_functions);
- goto restart;
- }
-
beg_unchanged = BEG_UNCHANGED;
end_unchanged = END_UNCHANGED;
@@ -16732,7 +16854,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
margin, even though this part handles windows that didn't
scroll at all. */
int pixel_margin = margin * frame_line_height;
- bool header_line = WINDOW_WANTS_HEADER_LINE_P (w);
+ bool header_line = window_wants_header_line (w);
/* Note: We add an extra FRAME_LINE_HEIGHT, because the loop
below, which finds the row to move point to, advances by
@@ -16789,10 +16911,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
XBUFFER (w->contents)->text->redisplay = false;
safe__call1 (true, Vpre_redisplay_function, Fcons (window, Qnil));
- if (w->redisplay || XBUFFER (w->contents)->text->redisplay)
+ if (w->redisplay || XBUFFER (w->contents)->text->redisplay
+ || ((EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual))
+ && row != MATRIX_FIRST_TEXT_ROW (w->desired_matrix)))
{
- /* pre-redisplay-function made changes (e.g. move the region)
- that require another round of redisplay. */
+ /* Either pre-redisplay-function made changes (e.g. move
+ the region), or we moved point in a window that is
+ under display-line-numbers = relative mode. We need
+ another round of redisplay. */
clear_glyph_matrix (w->desired_matrix);
if (!try_window (window, startp, 0))
goto need_larger_matrices;
@@ -16926,6 +17053,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
= try_window_reusing_current_matrix (w)))
{
IF_DEBUG (debug_method_add (w, "1"));
+ clear_glyph_matrix (w->desired_matrix);
if (try_window (window, startp, TRY_WINDOW_CHECK_MARGINS) < 0)
/* -1 means we need to scroll.
0 means we need new matrices, but fonts_changed
@@ -17299,15 +17427,15 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
|| (w->column_number_displayed != -1
&& (w->column_number_displayed != current_column ())))
/* This means that the window has a mode line. */
- && (WINDOW_WANTS_MODELINE_P (w)
- || WINDOW_WANTS_HEADER_LINE_P (w)))
+ && (window_wants_mode_line (w)
+ || window_wants_header_line (w)))
{
display_mode_lines (w);
/* If mode line height has changed, arrange for a thorough
immediate redisplay using the correct mode line height. */
- if (WINDOW_WANTS_MODELINE_P (w)
+ if (window_wants_mode_line (w)
&& CURRENT_MODE_LINE_HEIGHT (w) != DESIRED_MODE_LINE_HEIGHT (w))
{
f->fonts_changed = true;
@@ -17318,7 +17446,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p)
/* If header line height has changed, arrange for a thorough
immediate redisplay using the correct header line height. */
- if (WINDOW_WANTS_HEADER_LINE_P (w)
+ if (window_wants_header_line (w)
&& CURRENT_HEADER_LINE_HEIGHT (w) != DESIRED_HEADER_LINE_HEIGHT (w))
{
f->fonts_changed = true;
@@ -17575,7 +17703,11 @@ try_window_reusing_current_matrix (struct window *w)
/* Don't try to reuse the display if windows have been split
or such. */
|| windows_or_buffers_changed
- || f->cursor_type_changed)
+ || f->cursor_type_changed
+ /* This function cannot handle buffers where the overlay arrow
+ is shown on the fringes, because if the arrow position
+ changes, we cannot just reuse the current matrix. */
+ || overlay_arrow_in_current_buffer_p ())
return false;
/* Can't do this if showing trailing whitespace. */
@@ -17583,7 +17715,7 @@ try_window_reusing_current_matrix (struct window *w)
return false;
/* If top-line visibility has changed, give up. */
- if (WINDOW_WANTS_HEADER_LINE_P (w)
+ if (window_wants_header_line (w)
!= MATRIX_HEADER_LINE_ROW (w->current_matrix)->mode_line_p)
return false;
@@ -17593,15 +17725,21 @@ try_window_reusing_current_matrix (struct window *w)
if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row))
return false;
+ /* Clear the desired matrix for the display below. */
+ clear_glyph_matrix (w->desired_matrix);
+
+ /* Give up if line numbers are being displayed, because reusing the
+ current matrix might use the wrong width for line-number
+ display. */
+ if (!NILP (Vdisplay_line_numbers))
+ return false;
+
/* The variable new_start now holds the new window start. The old
start `start' can be determined from the current matrix. */
SET_TEXT_POS_FROM_MARKER (new_start, w->start);
start = start_row->minpos;
start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix);
- /* Clear the desired matrix for the display below. */
- clear_glyph_matrix (w->desired_matrix);
-
if (CHARPOS (new_start) <= CHARPOS (start))
{
/* Don't use this method if the display starts with an ellipsis
@@ -18424,6 +18562,16 @@ try_window_id (struct window *w)
if (!NILP (BVAR (XBUFFER (w->contents), extra_line_spacing)))
GIVE_UP (23);
+ /* Give up if display-line-numbers is in relative mode, or when the
+ current line's number needs to be displayed in a distinct face. */
+ if (EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual)
+ || (!NILP (Vdisplay_line_numbers)
+ && NILP (Finternal_lisp_face_equal_p (Qline_number,
+ Qline_number_current_line,
+ w->frame))))
+ GIVE_UP (24);
+
/* Make sure beg_unchanged and end_unchanged are up to date. Do it
only if buffer has really changed. The reason is that the gap is
initially at Z for freshly visited files. The code below would
@@ -18818,7 +18966,7 @@ try_window_id (struct window *w)
= MATRIX_ROW_VPOS (first_unchanged_at_end_row, w->current_matrix);
int from = WINDOW_TOP_EDGE_LINE (w) + from_vpos;
int end = (WINDOW_TOP_EDGE_LINE (w)
- + WINDOW_WANTS_HEADER_LINE_P (w)
+ + window_wants_header_line (w)
+ window_internal_height (w));
#if defined (HAVE_GPM) || defined (MSDOS)
@@ -18996,7 +19144,7 @@ try_window_id (struct window *w)
{
/* Displayed to end of window, but no line containing text was
displayed. Lines were deleted at the end of the window. */
- bool first_vpos = WINDOW_WANTS_HEADER_LINE_P (w);
+ bool first_vpos = window_wants_header_line (w);
int vpos = w->window_end_vpos;
struct glyph_row *current_row = current_matrix->rows + vpos;
struct glyph_row *desired_row = desired_matrix->rows + vpos;
@@ -19071,7 +19219,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
|| glyph->type == GLYPHLESS_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
(glyph->type == CHAR_GLYPH
? 'C'
@@ -19096,7 +19244,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
else if (glyph->type == STRETCH_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'S',
glyph->charpos,
@@ -19117,7 +19265,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
else if (glyph->type == IMAGE_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x %c %4d %1.1d%1.1d\n",
glyph - row->glyphs[TEXT_AREA],
'I',
glyph->charpos,
@@ -19138,7 +19286,7 @@ dump_glyph (struct glyph_row *row, struct glyph *glyph, int area)
else if (glyph->type == COMPOSITE_GLYPH)
{
fprintf (stderr,
- " %5"pD"d %c %9"pI"d %c %3d 0x%06x",
+ " %5"pD"d %c %9"pD"d %c %3d 0x%06x",
glyph - row->glyphs[TEXT_AREA],
'+',
glyph->charpos,
@@ -19199,7 +19347,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
fprintf (stderr, "Row Start End Used oE><\\CTZFesm X Y W H V A P\n");
fprintf (stderr, "==============================================================================\n");
- fprintf (stderr, "%3d %9"pI"d %9"pI"d %4d %1.1d%1.1d%1.1d%1.1d\
+ fprintf (stderr, "%3d %9"pD"d %9"pD"d %4d %1.1d%1.1d%1.1d%1.1d\
%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d%1.1d %4d %4d %4d %4d %4d %4d %4d\n",
vpos,
MATRIX_ROW_START_CHARPOS (row),
@@ -19228,7 +19376,7 @@ dump_glyph_row (struct glyph_row *row, int vpos, int glyphs)
fprintf (stderr, " %9"pD"d %9"pD"d\t%5d\n", row->start.overlay_string_index,
row->end.overlay_string_index,
row->continuation_lines_width);
- fprintf (stderr, " %9"pI"d %9"pI"d\n",
+ fprintf (stderr, " %9"pD"d %9"pD"d\n",
CHARPOS (row->start.string_pos),
CHARPOS (row->end.string_pos));
fprintf (stderr, " %9d %9d\n", row->start.dpvec_index,
@@ -19305,7 +19453,7 @@ with numeric argument, its value is passed as the GLYPHS flag. */)
struct window *w = XWINDOW (selected_window);
struct buffer *buffer = XBUFFER (w->contents);
- fprintf (stderr, "PT = %"pI"d, BEGV = %"pI"d. ZV = %"pI"d\n",
+ fprintf (stderr, "PT = %"pD"d, BEGV = %"pD"d. ZV = %"pD"d\n",
BUF_PT (buffer), BUF_BEGV (buffer), BUF_ZV (buffer));
fprintf (stderr, "Cursor x = %d, y = %d, hpos = %d, vpos = %d\n",
w->cursor.x, w->cursor.y, w->cursor.hpos, w->cursor.vpos);
@@ -20401,6 +20549,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop)
it->stop_charpos = 0;
it->prev_stop = 0;
it->base_level_stop = 0;
+ it->cmp_it.id = -1;
/* Force paragraph direction to be that of the parent
buffer/string. */
@@ -20670,6 +20819,374 @@ find_row_edges (struct it *it, struct glyph_row *row,
row->maxpos = it->current.pos;
}
+/* Like display_count_lines, but capable of counting outside of the
+ current narrowed region. */
+static ptrdiff_t
+display_count_lines_logically (ptrdiff_t start_byte, ptrdiff_t limit_byte,
+ ptrdiff_t count, ptrdiff_t *byte_pos_ptr)
+{
+ if (!display_line_numbers_widen || (BEGV == BEG && ZV == Z))
+ return display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
+
+ ptrdiff_t val;
+ ptrdiff_t pdl_count = SPECPDL_INDEX ();
+ record_unwind_protect (save_restriction_restore, save_restriction_save ());
+ Fwiden ();
+ val = display_count_lines (start_byte, limit_byte, count, byte_pos_ptr);
+ unbind_to (pdl_count, Qnil);
+ return val;
+}
+
+/* Count the number of screen lines in window IT->w between character
+ position IT_CHARPOS(*IT) and the line showing that window's point. */
+static ptrdiff_t
+display_count_lines_visually (struct it *it)
+{
+ struct it tem_it;
+ ptrdiff_t to;
+ struct text_pos from;
+
+ /* If we already calculated a relative line number, use that. This
+ trick relies on the fact that visual lines (a.k.a. "glyph rows")
+ are laid out sequentially, one by one, for each sequence of calls
+ to display_line or other similar function that follows a call to
+ init_iterator. */
+ if (it->lnum_bytepos > 0)
+ return it->lnum + 1;
+ else
+ {
+ ptrdiff_t count = SPECPDL_INDEX ();
+
+ if (IT_CHARPOS (*it) <= PT)
+ {
+ from = it->current.pos;
+ to = PT;
+ }
+ else
+ {
+ SET_TEXT_POS (from, PT, PT_BYTE);
+ to = IT_CHARPOS (*it);
+ }
+ start_display (&tem_it, it->w, from);
+ /* Need to disable visual mode temporarily, since otherwise the
+ call to move_it_to will cause infinite recursion. */
+ specbind (Qdisplay_line_numbers, Qrelative);
+ /* Some redisplay optimizations could invoke us very far from
+ PT, which will make the caller painfully slow. There should
+ be no need to go too far beyond the window's bottom, as any
+ such optimization will fail to show point anyway. */
+ move_it_to (&tem_it, to, -1,
+ tem_it.last_visible_y
+ + (SCROLL_LIMIT + 10) * FRAME_LINE_HEIGHT (tem_it.f),
+ -1, MOVE_TO_POS | MOVE_TO_Y);
+ unbind_to (count, Qnil);
+ return IT_CHARPOS (*it) <= PT ? -tem_it.vpos : tem_it.vpos;
+ }
+}
+
+/* Produce the line-number glyphs for the current glyph_row. If
+ IT->glyph_row is non-NULL, populate the row with the produced
+ glyphs. */
+static void
+maybe_produce_line_number (struct it *it)
+{
+ ptrdiff_t last_line = it->lnum;
+ ptrdiff_t start_from, bytepos;
+ ptrdiff_t this_line;
+ bool first_time = false;
+ ptrdiff_t beg_byte = display_line_numbers_widen ? BEG_BYTE : BEGV_BYTE;
+ ptrdiff_t z_byte = display_line_numbers_widen ? Z_BYTE : ZV_BYTE;
+ void *itdata = bidi_shelve_cache ();
+
+ if (EQ (Vdisplay_line_numbers, Qvisual))
+ this_line = display_count_lines_visually (it);
+ else
+ {
+ if (!last_line)
+ {
+ /* If possible, reuse data cached by line-number-mode. */
+ if (it->w->base_line_number > 0
+ && it->w->base_line_pos > 0
+ && it->w->base_line_pos <= IT_CHARPOS (*it)
+ /* line-number-mode always displays narrowed line
+ numbers, so we cannot use its data if the user wants
+ line numbers that disregard narrowing, or if the
+ buffer's narrowing has just changed. */
+ && !(display_line_numbers_widen
+ && (BEG_BYTE != BEGV_BYTE || Z_BYTE != ZV_BYTE))
+ && !current_buffer->clip_changed)
+ {
+ start_from = CHAR_TO_BYTE (it->w->base_line_pos);
+ last_line = it->w->base_line_number - 1;
+ }
+ else
+ start_from = beg_byte;
+ if (!it->lnum_bytepos)
+ first_time = true;
+ }
+ else
+ start_from = it->lnum_bytepos;
+
+ /* Paranoia: what if someone changes the narrowing since the
+ last time display_line was called? Shouldn't really happen,
+ but who knows what some crazy Lisp invoked by :eval could do? */
+ if (!(beg_byte <= start_from && start_from <= z_byte))
+ {
+ last_line = 0;
+ start_from = beg_byte;
+ }
+
+ this_line =
+ last_line + display_count_lines_logically (start_from,
+ IT_BYTEPOS (*it),
+ IT_CHARPOS (*it), &bytepos);
+ eassert (this_line > 0 || (this_line == 0 && start_from == beg_byte));
+ eassert (bytepos == IT_BYTEPOS (*it));
+ }
+
+ /* Record the line number information. */
+ if (this_line != last_line || !it->lnum_bytepos)
+ {
+ it->lnum = this_line;
+ it->lnum_bytepos = IT_BYTEPOS (*it);
+ }
+
+ /* Produce the glyphs for the line number. */
+ struct it tem_it;
+ char lnum_buf[INT_STRLEN_BOUND (ptrdiff_t) + 1];
+ bool beyond_zv = IT_BYTEPOS (*it) >= ZV_BYTE ? true : false;
+ ptrdiff_t lnum_offset = -1; /* to produce 1-based line numbers */
+ int lnum_face_id = merge_faces (it->f, Qline_number, 0, DEFAULT_FACE_ID);
+ int current_lnum_face_id
+ = merge_faces (it->f, Qline_number_current_line, 0, DEFAULT_FACE_ID);
+ /* Compute point's line number if needed. */
+ if ((EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual)
+ || lnum_face_id != current_lnum_face_id)
+ && !it->pt_lnum)
+ {
+ ptrdiff_t ignored;
+ if (PT_BYTE > it->lnum_bytepos && !EQ (Vdisplay_line_numbers, Qvisual))
+ it->pt_lnum =
+ this_line + display_count_lines_logically (it->lnum_bytepos, PT_BYTE,
+ PT, &ignored);
+ else
+ it->pt_lnum = display_count_lines_logically (beg_byte, PT_BYTE, PT,
+ &ignored);
+ }
+ /* Compute the required width if needed. */
+ if (!it->lnum_width)
+ {
+ if (NATNUMP (Vdisplay_line_numbers_width))
+ it->lnum_width = XFASTINT (Vdisplay_line_numbers_width);
+
+ /* Max line number to be displayed cannot be more than the one
+ corresponding to the last row of the desired matrix. */
+ ptrdiff_t max_lnum;
+
+ if (NILP (Vdisplay_line_numbers_current_absolute)
+ && (EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual)))
+ /* We subtract one more because the current line is always
+ zero in this mode. */
+ max_lnum = it->w->desired_matrix->nrows - 2;
+ else if (EQ (Vdisplay_line_numbers, Qvisual))
+ max_lnum = it->pt_lnum + it->w->desired_matrix->nrows - 1;
+ else
+ max_lnum = this_line + it->w->desired_matrix->nrows - 1 - it->vpos;
+ max_lnum = max (1, max_lnum);
+ it->lnum_width = max (it->lnum_width, log10 (max_lnum) + 1);
+ eassert (it->lnum_width > 0);
+ }
+ if (EQ (Vdisplay_line_numbers, Qrelative))
+ lnum_offset = it->pt_lnum;
+ else if (EQ (Vdisplay_line_numbers, Qvisual))
+ lnum_offset = 0;
+
+ /* Under 'relative', display the absolute line number for the
+ current line, unless the user requests otherwise. */
+ ptrdiff_t lnum_to_display = eabs (this_line - lnum_offset);
+ if ((EQ (Vdisplay_line_numbers, Qrelative)
+ || EQ (Vdisplay_line_numbers, Qvisual))
+ && lnum_to_display == 0
+ && !NILP (Vdisplay_line_numbers_current_absolute))
+ lnum_to_display = it->pt_lnum + 1;
+ /* In L2R rows we need to append the blank separator, in R2L
+ rows we need to prepend it. But this function is usually
+ called when no display elements were produced from the
+ following line, so the paragraph direction might be unknown.
+ Therefore we cheat and add 2 blanks, one on either side. */
+ pint2str (lnum_buf, it->lnum_width + 1, lnum_to_display);
+ strcat (lnum_buf, " ");
+
+ /* Setup for producing the glyphs. */
+ init_iterator (&tem_it, it->w, -1, -1, &scratch_glyph_row,
+ /* FIXME: Use specialized face. */
+ DEFAULT_FACE_ID);
+ scratch_glyph_row.reversed_p = false;
+ scratch_glyph_row.used[TEXT_AREA] = 0;
+ SET_TEXT_POS (tem_it.position, 0, 0);
+ tem_it.avoid_cursor_p = true;
+ tem_it.bidi_p = true;
+ tem_it.bidi_it.type = WEAK_EN;
+ /* According to UAX#9, EN goes up 2 levels in L2R paragraph and
+ 1 level in R2L paragraphs. Emulate that, assuming we are in
+ an L2R paragraph. */
+ tem_it.bidi_it.resolved_level = 2;
+
+ /* Produce glyphs for the line number in a scratch glyph_row. */
+ int n_glyphs_before;
+ for (const char *p = lnum_buf; *p; p++)
+ {
+ /* For continuation lines and lines after ZV, instead of a line
+ number, produce a blank prefix of the same width. Use the
+ default face for the blank field beyond ZV. */
+ if (beyond_zv)
+ tem_it.face_id = it->base_face_id;
+ else if (lnum_face_id != current_lnum_face_id
+ && (EQ (Vdisplay_line_numbers, Qvisual)
+ ? this_line == 0
+ : this_line == it->pt_lnum))
+ tem_it.face_id = current_lnum_face_id;
+ else
+ tem_it.face_id = lnum_face_id;
+ if (beyond_zv
+ /* Don't display the same line number more than once. */
+ || (!EQ (Vdisplay_line_numbers, Qvisual)
+ && (it->continuation_lines_width > 0
+ || (this_line == last_line && !first_time))))
+ tem_it.c = tem_it.char_to_display = ' ';
+ else
+ tem_it.c = tem_it.char_to_display = *p;
+ tem_it.len = 1;
+ n_glyphs_before = scratch_glyph_row.used[TEXT_AREA];
+ /* Make sure these glyphs will have a "position" of -1. */
+ SET_TEXT_POS (tem_it.position, -1, -1);
+ PRODUCE_GLYPHS (&tem_it);
+
+ /* Stop producing glyphs if we don't have enough space on
+ this line. FIXME: should we refrain from producing the
+ line number at all in that case? */
+ if (tem_it.current_x > tem_it.last_visible_x)
+ {
+ scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before;
+ break;
+ }
+ }
+
+ /* Record the width in pixels we need for the line number display. */
+ it->lnum_pixel_width = tem_it.current_x;
+ /* Copy the produced glyphs into IT's glyph_row. */
+ struct glyph *g = scratch_glyph_row.glyphs[TEXT_AREA];
+ struct glyph *e = g + scratch_glyph_row.used[TEXT_AREA];
+ struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL;
+ short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL;
+
+ eassert (it->glyph_row == NULL || it->glyph_row->used[TEXT_AREA] == 0);
+
+ for ( ; g < e; g++)
+ {
+ it->current_x += g->pixel_width;
+ /* The following is important when this function is called
+ from move_it_in_display_line_to: HPOS is incremented only
+ when we are in the visible portion of the glyph row. */
+ if (it->current_x > it->first_visible_x)
+ it->hpos++;
+ if (p)
+ {
+ *p++ = *g;
+ (*u)++;
+ }
+ }
+
+ /* Update IT's metrics due to glyphs produced for line numbers. */
+ if (it->glyph_row)
+ {
+ struct glyph_row *row = it->glyph_row;
+
+ it->max_ascent = max (row->ascent, tem_it.max_ascent);
+ it->max_descent = max (row->height - row->ascent, tem_it.max_descent);
+ it->max_phys_ascent = max (row->phys_ascent, tem_it.max_phys_ascent);
+ it->max_phys_descent = max (row->phys_height - row->phys_ascent,
+ tem_it.max_phys_descent);
+ }
+ else
+ {
+ it->max_ascent = max (it->max_ascent, tem_it.max_ascent);
+ it->max_descent = max (it->max_descent, tem_it.max_descent);
+ it->max_phys_ascent = max (it->max_phys_ascent, tem_it.max_phys_ascent);
+ it->max_phys_descent = max (it->max_phys_descent, tem_it.max_phys_descent);
+ }
+
+ bidi_unshelve_cache (itdata, false);
+}
+
+/* Return true if this glyph row needs a line number to be produced
+ for it. */
+static bool
+should_produce_line_number (struct it *it)
+{
+ if (NILP (Vdisplay_line_numbers))
+ return false;
+
+ /* Don't display line numbers in minibuffer windows. */
+ if (MINI_WINDOW_P (it->w))
+ return false;
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Don't display line number in tooltip frames. */
+ if (FRAMEP (tip_frame) && EQ (WINDOW_FRAME (it->w), tip_frame)
+#ifdef USE_GTK
+ /* GTK builds store in tip_frame the frame that shows the tip,
+ so we need an additional test. */
+ && !NILP (Fframe_parameter (tip_frame, Qtooltip))
+#endif
+ )
+ return false;
+#endif
+
+ /* If the character at current position has a non-nil special
+ property, disable line numbers for this row. This is for
+ packages such as company-mode, which need this for their tricky
+ layout, where line numbers get in the way. */
+ Lisp_Object val = Fget_char_property (make_number (IT_CHARPOS (*it)),
+ Qdisplay_line_numbers_disable,
+ it->window);
+ /* For ZV, we need to also look in empty overlays at that point,
+ because get-char-property always returns nil for ZV, except if
+ the property is in 'default-text-properties'. */
+ if (NILP (val) && IT_CHARPOS (*it) >= ZV)
+ val = disable_line_numbers_overlay_at_eob ();
+ return NILP (val) ? true : false;
+}
+
+/* Return true if ROW has no glyphs except those inserted by the
+ display engine. This is needed for indicate-empty-lines and
+ similar features when the glyph row starts with glyphs which didn't
+ come from buffer or string. */
+static bool
+row_text_area_empty (struct glyph_row *row)
+{
+ if (!row->reversed_p)
+ {
+ for (struct glyph *g = row->glyphs[TEXT_AREA];
+ g < row->glyphs[TEXT_AREA] + row->used[TEXT_AREA];
+ g++)
+ if (!NILP (g->object) || g->charpos > 0)
+ return false;
+ }
+ else
+ {
+ for (struct glyph *g = row->glyphs[TEXT_AREA] + row->used[TEXT_AREA] - 1;
+ g > row->glyphs[TEXT_AREA];
+ g--)
+ if (!NILP ((g - 1)->object) || (g - 1)->charpos > 0)
+ return false;
+ }
+
+ return true;
+}
+
/* Construct the glyph row IT->glyph_row in the desired matrix of
IT->w from text at the current position of IT. See dispextern.h
for an overview of struct it. Value is true if
@@ -20696,7 +21213,7 @@ display_line (struct it *it, int cursor_vpos)
ptrdiff_t min_pos = ZV + 1, max_pos = 0;
ptrdiff_t min_bpos UNINIT, max_bpos UNINIT;
bool pending_handle_line_prefix = false;
- int header_line = WINDOW_WANTS_HEADER_LINE_P (it->w);
+ int header_line = window_wants_header_line (it->w);
bool hscroll_this_line = (cursor_vpos >= 0
&& it->vpos == cursor_vpos - header_line
&& hscrolling_current_line_p (it->w));
@@ -20740,6 +21257,8 @@ display_line (struct it *it, int cursor_vpos)
(window_hscroll_limited (it->w, it->f) - it->w->min_hscroll)
* FRAME_COLUMN_WIDTH (it->f);
+ bool line_number_needed = should_produce_line_number (it);
+
/* Move over display elements that are not visible because we are
hscrolled. This may stop at an x-position < first_visible_x
if the first glyph is partially visible or if we hit a line end. */
@@ -20775,9 +21294,17 @@ display_line (struct it *it, int cursor_vpos)
are hscrolled to the left of the left edge of the window. */
min_pos = CHARPOS (this_line_min_pos);
min_bpos = BYTEPOS (this_line_min_pos);
+
+ /* Produce line number, if needed. */
+ if (line_number_needed)
+ maybe_produce_line_number (it);
}
else if (it->area == TEXT_AREA)
{
+ /* Line numbers should precede the line-prefix or wrap-prefix. */
+ if (line_number_needed)
+ maybe_produce_line_number (it);
+
/* We only do this when not calling move_it_in_display_line_to
above, because that function calls itself handle_line_prefix. */
handle_line_prefix (it);
@@ -20839,6 +21366,7 @@ display_line (struct it *it, int cursor_vpos)
buffer reached. */
if (!get_next_display_element (it))
{
+ bool row_has_glyphs = false;
/* Maybe add a space at the end of this line that is used to
display the cursor there under X. Set the charpos of the
first glyph of blank lines not corresponding to any text
@@ -20847,14 +21375,17 @@ display_line (struct it *it, int cursor_vpos)
row->exact_window_width_line_p = true;
else if ((append_space_for_newline (it, true)
&& row->used[TEXT_AREA] == 1)
- || row->used[TEXT_AREA] == 0)
+ || row->used[TEXT_AREA] == 0
+ || (row_has_glyphs = row_text_area_empty (row)))
{
row->glyphs[TEXT_AREA]->charpos = -1;
- row->displays_text_p = false;
+ /* Don't reset the displays_text_p flag if we are
+ displaying line numbers or line-prefix. */
+ if (!row_has_glyphs)
+ row->displays_text_p = false;
if (!NILP (BVAR (XBUFFER (it->w->contents), indicate_empty_lines))
- && (!MINI_WINDOW_P (it->w)
- || (minibuf_level && EQ (it->window, minibuf_window))))
+ && (!MINI_WINDOW_P (it->w)))
row->indicate_empty_line_p = true;
}
@@ -20936,6 +21467,10 @@ display_line (struct it *it, int cursor_vpos)
process the prefix now. */
if (it->area == TEXT_AREA && pending_handle_line_prefix)
{
+ /* Line numbers should precede the line-prefix or wrap-prefix. */
+ if (line_number_needed)
+ maybe_produce_line_number (it);
+
pending_handle_line_prefix = false;
handle_line_prefix (it);
}
@@ -21890,8 +22425,8 @@ Value is the new character position of point. */)
row += dir;
else
row -= dir;
- if (row < MATRIX_FIRST_TEXT_ROW (w->current_matrix)
- || row > MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w))
+ if (!(MATRIX_FIRST_TEXT_ROW (w->current_matrix) <= row
+ && row < MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)))
goto simulate_display;
if (dir > 0)
@@ -22007,7 +22542,7 @@ Value is the new character position of point. */)
reach point, in order to start from its X coordinate. So we
need to disregard the window's horizontal extent in that case. */
if (it.line_wrap == TRUNCATE)
- it.last_visible_x = INFINITY;
+ it.last_visible_x = DISP_INFINITY;
if (it.cmp_it.id < 0
&& it.method == GET_FROM_STRING
@@ -22100,7 +22635,7 @@ Value is the new character position of point. */)
{
start_display (&it, w, pt);
if (it.line_wrap == TRUNCATE)
- it.last_visible_x = INFINITY;
+ it.last_visible_x = DISP_INFINITY;
reseat_at_previous_visible_line_start (&it);
it.current_x = it.current_y = it.hpos = 0;
if (pt_vpos != 0)
@@ -22649,20 +23184,30 @@ display_mode_lines (struct window *w)
line_number_displayed = false;
w->column_number_displayed = -1;
- if (WINDOW_WANTS_MODELINE_P (w))
+ if (window_wants_mode_line (w))
{
+ Lisp_Object window_mode_line_format
+ = window_parameter (w, Qmode_line_format);
+
struct window *sel_w = XWINDOW (old_selected_window);
/* Select mode line face based on the real selected window. */
display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w),
- BVAR (current_buffer, mode_line_format));
+ NILP (window_mode_line_format)
+ ? BVAR (current_buffer, mode_line_format)
+ : window_mode_line_format);
++n;
}
- if (WINDOW_WANTS_HEADER_LINE_P (w))
+ if (window_wants_header_line (w))
{
+ Lisp_Object window_header_line_format
+ = window_parameter (w, Qheader_line_format);
+
display_mode_line (w, HEADER_LINE_FACE_ID,
- BVAR (current_buffer, header_line_format));
+ NILP (window_header_line_format)
+ ? BVAR (current_buffer, header_line_format)
+ : window_header_line_format);
++n;
}
@@ -22850,7 +23395,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
props = oprops;
}
- aelt = Fassoc (elt, mode_line_proptrans_alist);
+ aelt = Fassoc (elt, mode_line_proptrans_alist, Qnil);
if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt))))
{
/* AELT is what we want. Move it to the front
@@ -23319,7 +23864,8 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string,
if (field_width > len)
{
field_width -= len;
- lisp_string = Fmake_string (make_number (field_width), make_number (' '));
+ lisp_string = Fmake_string (make_number (field_width), make_number (' '),
+ Qnil);
if (!NILP (props))
Fadd_text_properties (make_number (0), make_number (field_width),
props, lisp_string);
@@ -24605,7 +25151,20 @@ else if the text is replaced by an ellipsis. */)
'(space :width (+ left-fringe left-margin (- (1))))
'(space :width (+ left-fringe left-margin (-1)))
-*/
+ If ALIGN_TO is NULL, returns the result in *RES. If ALIGN_TO is
+ non-NULL, the value of *ALIGN_TO is a window-relative pixel
+ coordinate, and *RES is the additional pixel width from that point
+ till the end of the stretch glyph.
+
+ WIDTH_P non-zero means take the width dimension or X coordinate of
+ the object specified by PROP, WIDTH_P zero means take the height
+ dimension or the Y coordinate. (Therefore, if ALIGN_TO is
+ non-NULL, WIDTH_P should be non-zero.)
+
+ FONT is the font of the face of the surrounding text.
+
+ The return value is non-zero if width or height were successfully
+ calculated, i.e. if PROP is a valid spec. */
static bool
calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
@@ -24627,6 +25186,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
{
char *unit = SSDATA (SYMBOL_NAME (prop));
+ /* The UNIT expression, e.g. as part of (NUM . UNIT). */
if (unit[0] == 'i' && unit[1] == 'n')
pixels = 1.0;
else if (unit[0] == 'm' && unit[1] == 'm')
@@ -24647,10 +25207,12 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
}
#ifdef HAVE_WINDOW_SYSTEM
+ /* 'height': the height of FONT. */
if (EQ (prop, Qheight))
return OK_PIXELS (font
? normal_char_height (font, -1)
: FRAME_LINE_HEIGHT (it->f));
+ /* 'width': the width of FONT. */
if (EQ (prop, Qwidth))
return OK_PIXELS (font
? FONT_WIDTH (font)
@@ -24660,33 +25222,48 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
return OK_PIXELS (1);
#endif
+ /* 'text': the width or height of the text area. */
if (EQ (prop, Qtext))
return OK_PIXELS (width_p
- ? window_box_width (it->w, TEXT_AREA)
+ ? (window_box_width (it->w, TEXT_AREA)
+ - it->lnum_pixel_width)
: WINDOW_BOX_HEIGHT_NO_MODE_LINE (it->w));
+ /* ':align_to'. First time we compute the value, window
+ elements are interpreted as the position of the element's
+ left edge. */
if (align_to && *align_to < 0)
{
*res = 0;
+ /* 'left': left edge of the text area. */
if (EQ (prop, Qleft))
- return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA));
+ return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA)
+ + it->lnum_pixel_width);
+ /* 'right': right edge of the text area. */
if (EQ (prop, Qright))
return OK_ALIGN_TO (window_box_right_offset (it->w, TEXT_AREA));
+ /* 'center': the center of the text area. */
if (EQ (prop, Qcenter))
return OK_ALIGN_TO (window_box_left_offset (it->w, TEXT_AREA)
+ + it->lnum_pixel_width
+ window_box_width (it->w, TEXT_AREA) / 2);
+ /* 'left-fringe': left edge of the left fringe. */
if (EQ (prop, Qleft_fringe))
return OK_ALIGN_TO (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w)
? WINDOW_LEFT_SCROLL_BAR_AREA_WIDTH (it->w)
: window_box_right_offset (it->w, LEFT_MARGIN_AREA));
+ /* 'right-fringe': left edge of the right fringe. */
if (EQ (prop, Qright_fringe))
return OK_ALIGN_TO (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (it->w)
? window_box_right_offset (it->w, RIGHT_MARGIN_AREA)
: window_box_right_offset (it->w, TEXT_AREA));
+ /* 'left-margin': left edge of the left display margin. */
if (EQ (prop, Qleft_margin))
return OK_ALIGN_TO (window_box_left_offset (it->w, LEFT_MARGIN_AREA));
+ /* 'right-margin': left edge of the right display margin. */
if (EQ (prop, Qright_margin))
return OK_ALIGN_TO (window_box_left_offset (it->w, RIGHT_MARGIN_AREA));
+ /* 'scroll-bar': left edge of the vertical scroll bar. */
if (EQ (prop, Qscroll_bar))
return OK_ALIGN_TO (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (it->w)
? 0
@@ -24697,6 +25274,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
}
else
{
+ /* Otherwise, the elements stand for their width. */
if (EQ (prop, Qleft_fringe))
return OK_PIXELS (WINDOW_LEFT_FRINGE_WIDTH (it->w));
if (EQ (prop, Qright_fringe))
@@ -24719,6 +25297,8 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
int base_unit = (width_p
? FRAME_COLUMN_WIDTH (it->f)
: FRAME_LINE_HEIGHT (it->f));
+ if (width_p && align_to && *align_to < 0)
+ return OK_PIXELS (XFLOATINT (prop) * base_unit + it->lnum_pixel_width);
return OK_PIXELS (XFLOATINT (prop) * base_unit);
}
@@ -24730,6 +25310,7 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
if (SYMBOLP (car))
{
#ifdef HAVE_WINDOW_SYSTEM
+ /* '(image PROPS...)': width or height of the specified image. */
if (FRAME_WINDOW_P (it->f)
&& valid_image_p (prop))
{
@@ -24738,12 +25319,15 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
return OK_PIXELS (width_p ? img->width : img->height);
}
+ /* '(xwidget PROPS...)': dimensions of the specified xwidget. */
if (FRAME_WINDOW_P (it->f) && valid_xwidget_spec_p (prop))
{
/* TODO: Don't return dummy size. */
return OK_PIXELS (100);
}
#endif
+ /* '(+ EXPR...)' or '(- EXPR...)' add or subtract
+ recursively calculated values. */
if (EQ (car, Qplus) || EQ (car, Qminus))
{
bool first = true;
@@ -24771,15 +25355,18 @@ calc_pixel_width_or_height (double *res, struct it *it, Lisp_Object prop,
car = Qnil;
}
+ /* '(NUM)': absolute number of pixels. */
if (NUMBERP (car))
{
double fact;
+ int offset =
+ width_p && align_to && *align_to < 0 ? it->lnum_pixel_width : 0;
pixels = XFLOATINT (car);
if (NILP (cdr))
- return OK_PIXELS (pixels);
+ return OK_PIXELS (pixels + offset);
if (calc_pixel_width_or_height (&fact, it, cdr,
font, width_p, align_to))
- return OK_PIXELS (pixels * fact);
+ return OK_PIXELS (pixels * fact + offset);
return false;
}
@@ -27607,6 +28194,10 @@ x_produce_glyphs (struct it *it)
{
int tab_width = it->tab_width * font->space_width;
int x = it->current_x + it->continuation_lines_width;
+ int x0 = x;
+ /* Adjust for line numbers, if needed. */
+ if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width)
+ x -= it->lnum_pixel_width;
int next_tab_x = ((1 + x + tab_width - 1) / tab_width) * tab_width;
/* If the distance from the current position to the next tab
@@ -27614,8 +28205,12 @@ x_produce_glyphs (struct it *it)
tab stop after that. */
if (next_tab_x - x < font->space_width)
next_tab_x += tab_width;
+ if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width)
+ next_tab_x += (it->lnum_pixel_width
+ - ((it->w->hscroll * font->space_width)
+ % tab_width));
- it->pixel_width = next_tab_x - x;
+ it->pixel_width = next_tab_x - x0;
it->nglyphs = 1;
if (FONT_TOO_HIGH (font))
{
@@ -28316,7 +28911,7 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg)
/* By default, set up the blink-off state depending on the on-state. */
- tem = Fassoc (arg, Vblink_cursor_alist);
+ tem = Fassoc (arg, Vblink_cursor_alist, Qnil);
if (!NILP (tem))
{
FRAME_BLINK_OFF_CURSOR (f)
@@ -28454,7 +29049,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
/* Cursor is blinked off, so determine how to "toggle" it. */
/* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */
- if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor)))
+ if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist, Qnil), !NILP (alt_cursor)))
return get_specified_cursor_type (XCDR (alt_cursor), width);
/* Then see if frame has specified a specific blink off cursor type. */
@@ -30442,13 +31037,67 @@ note_mouse_highlight (struct frame *f, int x, int y)
&& part != ON_HEADER_LINE))
clear_mouse_face (hlinfo);
+ /* Reset help_echo_string. It will get recomputed below. */
+ help_echo_string = Qnil;
+
+#ifdef HAVE_WINDOW_SYSTEM
+ /* If the cursor is on the internal border of FRAME and FRAME's
+ internal border is draggable, provide some visual feedback. */
+ if (FRAME_INTERNAL_BORDER_WIDTH (f) > 0
+ && !NILP (get_frame_param (f, Qdrag_internal_border)))
+ {
+ enum internal_border_part part = frame_internal_border_part (f, x, y);
+
+ switch (part)
+ {
+ case INTERNAL_BORDER_NONE:
+ if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
+ /* Reset cursor. */
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+ break;
+ case INTERNAL_BORDER_LEFT_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->left_edge_cursor;
+ break;
+ case INTERNAL_BORDER_TOP_LEFT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->top_left_corner_cursor;
+ break;
+ case INTERNAL_BORDER_TOP_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->top_edge_cursor;
+ break;
+ case INTERNAL_BORDER_TOP_RIGHT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->top_right_corner_cursor;
+ break;
+ case INTERNAL_BORDER_RIGHT_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->right_edge_cursor;
+ break;
+ case INTERNAL_BORDER_BOTTOM_RIGHT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->bottom_right_corner_cursor;
+ break;
+ case INTERNAL_BORDER_BOTTOM_EDGE:
+ cursor = FRAME_X_OUTPUT (f)->bottom_edge_cursor;
+ break;
+ case INTERNAL_BORDER_BOTTOM_LEFT_CORNER:
+ cursor = FRAME_X_OUTPUT (f)->bottom_left_corner_cursor;
+ break;
+ default:
+ /* This should not happen. */
+ if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
+ cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
+ }
+
+ if (cursor != FRAME_X_OUTPUT (f)->nontext_cursor)
+ {
+ /* Do we really want a help echo here? */
+ help_echo_string = build_string ("drag-mouse-1: resize frame");
+ goto set_cursor;
+ }
+ }
+#endif /* HAVE_WINDOW_SYSTEM */
+
/* Not on a window -> return. */
if (!WINDOWP (window))
return;
- /* Reset help_echo_string. It will get recomputed below. */
- help_echo_string = Qnil;
-
/* Convert to window-relative pixel coordinates. */
w = XWINDOW (window);
frame_to_window_pixel_xy (w, &x, &y);
@@ -30486,11 +31135,13 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
help_echo_string = build_string ("drag-mouse-1: resize");
+ goto set_cursor;
}
else if (part == ON_RIGHT_DIVIDER)
{
cursor = FRAME_X_OUTPUT (f)->horizontal_drag_cursor;
help_echo_string = build_string ("drag-mouse-1: resize");
+ goto set_cursor;
}
else if (part == ON_BOTTOM_DIVIDER)
if (! WINDOW_BOTTOMMOST_P (w)
@@ -30499,6 +31150,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
{
cursor = FRAME_X_OUTPUT (f)->vertical_drag_cursor;
help_echo_string = build_string ("drag-mouse-1: resize");
+ goto set_cursor;
}
else
cursor = FRAME_X_OUTPUT (f)->nontext_cursor;
@@ -31193,8 +31845,15 @@ x_draw_right_divider (struct window *w)
int x0 = WINDOW_RIGHT_EDGE_X (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w);
int x1 = WINDOW_RIGHT_EDGE_X (w);
int y0 = WINDOW_TOP_EDGE_Y (w);
- /* The bottom divider prevails. */
- int y1 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w);
+ int y1 = WINDOW_BOTTOM_EDGE_Y (w);
+
+ /* If W is horizontally combined and has a right sibling, don't
+ draw over any bottom divider. */
+ if (WINDOW_BOTTOM_DIVIDER_WIDTH (w)
+ && !NILP (w->parent)
+ && WINDOW_HORIZONTAL_COMBINATION_P (XWINDOW (w->parent))
+ && !NILP (w->next))
+ y1 -= WINDOW_BOTTOM_DIVIDER_WIDTH (w);
FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
}
@@ -31213,8 +31872,22 @@ x_draw_bottom_divider (struct window *w)
int x1 = WINDOW_RIGHT_EDGE_X (w);
int y0 = WINDOW_BOTTOM_EDGE_Y (w) - WINDOW_BOTTOM_DIVIDER_WIDTH (w);
int y1 = WINDOW_BOTTOM_EDGE_Y (w);
+ struct window *p = !NILP (w->parent) ? XWINDOW (w->parent) : NULL;
- FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
+ /* If W is vertically combined and has a sibling below, don't draw
+ over any right divider. */
+ if (WINDOW_RIGHT_DIVIDER_WIDTH (w)
+ && p
+ && ((WINDOW_VERTICAL_COMBINATION_P (p)
+ && !NILP (w->next))
+ || (WINDOW_HORIZONTAL_COMBINATION_P (p)
+ && NILP (w->next)
+ && !NILP (p->parent)
+ && WINDOW_VERTICAL_COMBINATION_P (XWINDOW (p->parent))
+ && !NILP (XWINDOW (p->parent)->next))))
+ x1 -= WINDOW_RIGHT_DIVIDER_WIDTH (w);
+
+ FRAME_RIF (f)->draw_window_divider (w, x0, x1, y0, y1);
}
}
@@ -31329,7 +32002,7 @@ expose_window (struct window *w, XRectangle *fr)
}
/* Display the mode line if there is one. */
- if (WINDOW_WANTS_MODELINE_P (w)
+ if (window_wants_mode_line (w)
&& (row = MATRIX_MODE_LINE_ROW (w->current_matrix),
row->enabled_p)
&& row->y < r_bottom)
@@ -31592,7 +32265,6 @@ They are still logged to the *Messages* buffer. */);
DEFSYM (Qoverriding_terminal_local_map, "overriding-terminal-local-map");
DEFSYM (Qoverriding_local_map, "overriding-local-map");
DEFSYM (Qwindow_scroll_functions, "window-scroll-functions");
- DEFSYM (Qwindow_text_change_functions, "window-text-change-functions");
DEFSYM (Qredisplay_end_trigger_functions, "redisplay-end-trigger-functions");
DEFSYM (Qinhibit_point_motion_hooks, "inhibit-point-motion-hooks");
DEFSYM (Qeval, "eval");
@@ -31619,9 +32291,19 @@ They are still logged to the *Messages* buffer. */);
DEFSYM (Qfontified, "fontified");
DEFSYM (Qfontification_functions, "fontification-functions");
+ /* Name of the symbol which disables Lisp evaluation in 'display'
+ properties. This is used by enriched.el. */
+ DEFSYM (Qdisable_eval, "disable-eval");
+
/* Name of the face used to highlight trailing whitespace. */
DEFSYM (Qtrailing_whitespace, "trailing-whitespace");
+ /* Names of the faces used to display line numbers. */
+ DEFSYM (Qline_number, "line-number");
+ DEFSYM (Qline_number_current_line, "line-number-current-line");
+ /* Name of a text property which disables line-number display. */
+ DEFSYM (Qdisplay_line_numbers_disable, "display-line-numbers-disable");
+
/* Name and number of the face used to highlight escape glyphs. */
DEFSYM (Qescape_glyph, "escape-glyph");
@@ -31908,6 +32590,9 @@ display-start position.
These functions are called whenever the `window-start' marker is modified,
either to point into another buffer (e.g. via `set-window-buffer') or another
place in the same buffer.
+When each function is called, the `window-start' marker of its window
+argument has been already set to the new value, and the buffer which that
+window will display is set to be the current buffer.
Note that the value of `window-end' is not valid when these functions are
called.
@@ -31916,11 +32601,6 @@ is scrolled. It is not designed for that, and such use probably won't
work. */);
Vwindow_scroll_functions = Qnil;
- DEFVAR_LISP ("window-text-change-functions",
- Vwindow_text_change_functions,
- doc: /* Functions to call in redisplay when text in the window might change. */);
- Vwindow_text_change_functions = Qnil;
-
DEFVAR_LISP ("redisplay-end-trigger-functions", Vredisplay_end_trigger_functions,
doc: /* Functions called when redisplay of a window reaches the end trigger.
Each function is called with two arguments, the window and the end trigger value.
@@ -32134,6 +32814,54 @@ To add a prefix to continuation lines, use `wrap-prefix'. */);
DEFSYM (Qline_prefix, "line-prefix");
Fmake_variable_buffer_local (Qline_prefix);
+ DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers,
+ doc: /* Non-nil means display line numbers.
+If the value is t, display the absolute number of each line of a buffer
+shown in a window. Absolute line numbers count from the beginning of
+the current narrowing, or from buffer beginning. If the value is
+`relative', display for each line not containing the window's point its
+relative number instead, i.e. the number of the line relative to the
+line showing the window's point.
+
+In either case, line numbers are displayed at the beginning of each
+non-continuation line that displays buffer text, i.e. after each newline
+character that comes from the buffer. The value `visual' is like
+`relative' but counts screen lines instead of buffer lines. In practice
+this means that continuation lines count as well when calculating the
+relative number of a line.
+
+Lisp programs can disable display of a line number of a particular
+buffer line by putting the `display-line-numbers-disable' text property
+or overlay property on the first visible character of that line. */);
+ Vdisplay_line_numbers = Qnil;
+ DEFSYM (Qdisplay_line_numbers, "display-line-numbers");
+ Fmake_variable_buffer_local (Qdisplay_line_numbers);
+ DEFSYM (Qrelative, "relative");
+ DEFSYM (Qvisual, "visual");
+
+ DEFVAR_LISP ("display-line-numbers-width", Vdisplay_line_numbers_width,
+ doc: /* Minimum width of space reserved for line number display.
+A positive number means reserve that many columns for line numbers,
+even if the actual number needs less space.
+The default value of nil means compute the space dynamically.
+Any other value is treated as nil. */);
+ Vdisplay_line_numbers_width = Qnil;
+ DEFSYM (Qdisplay_line_numbers_width, "display-line-numbers-width");
+ Fmake_variable_buffer_local (Qdisplay_line_numbers_width);
+
+ DEFVAR_LISP ("display-line-numbers-current-absolute",
+ Vdisplay_line_numbers_current_absolute,
+ doc: /* Non-nil means display absolute number of current line.
+This variable has effect only when `display-line-numbers' is
+either `relative' or `visual'. */);
+ Vdisplay_line_numbers_current_absolute = Qt;
+
+ DEFVAR_BOOL ("display-line-numbers-widen", display_line_numbers_widen,
+ doc: /* Non-nil means display line numbers disregarding any narrowing. */);
+ display_line_numbers_widen = false;
+ DEFSYM (Qdisplay_line_numbers_widen, "display-line-numbers-widen");
+ Fmake_variable_buffer_local (Qdisplay_line_numbers_widen);
+
DEFVAR_BOOL ("inhibit-eval-during-redisplay", inhibit_eval_during_redisplay,
doc: /* Non-nil means don't eval Lisp during redisplay. */);
inhibit_eval_during_redisplay = false;
diff --git a/src/xfaces.c b/src/xfaces.c
index 4714b7b3cb8..b594e576f50 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
@@ -4088,12 +4088,15 @@ color_distance (XColor *x, XColor *y)
}
-DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0,
+DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 4, 0,
doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
COLOR1 and COLOR2 may be either strings containing the color name,
-or lists of the form (RED GREEN BLUE).
-If FRAME is unspecified or nil, the current frame is used. */)
- (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame)
+or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive.
+If FRAME is unspecified or nil, the current frame is used.
+If METRIC is specified, it should be a function that accepts
+two lists of the form (RED GREEN BLUE) aforementioned. */)
+ (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame,
+ Lisp_Object metric)
{
struct frame *f = decode_live_frame (frame);
XColor cdef1, cdef2;
@@ -4107,7 +4110,16 @@ If FRAME is unspecified or nil, the current frame is used. */)
&& defined_color (f, SSDATA (color2), &cdef2, false)))
signal_error ("Invalid color", color2);
- return make_number (color_distance (&cdef1, &cdef2));
+ if (NILP (metric))
+ return make_number (color_distance (&cdef1, &cdef2));
+ else
+ return call2 (metric,
+ list3 (make_number (cdef1.red),
+ make_number (cdef1.green),
+ make_number (cdef1.blue)),
+ list3 (make_number (cdef2.red),
+ make_number (cdef2.green),
+ make_number (cdef2.blue)));
}
@@ -4475,6 +4487,7 @@ lookup_basic_face (struct frame *f, int face_id)
case MOUSE_FACE_ID: name = Qmouse; break;
case MENU_FACE_ID: name = Qmenu; break;
case WINDOW_DIVIDER_FACE_ID: name = Qwindow_divider; break;
+ case VERTICAL_BORDER_FACE_ID: name = Qvertical_border; break;
case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID: name = Qwindow_divider_first_pixel; break;
case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID: name = Qwindow_divider_last_pixel; break;
case INTERNAL_BORDER_FACE_ID: name = Qinternal_border; break;
@@ -6232,7 +6245,7 @@ where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
int red, green, blue;
int num;
- while (fgets (buf, sizeof (buf), fp) != NULL) {
+ while (fgets_unlocked (buf, sizeof (buf), fp) != NULL) {
if (sscanf (buf, "%d %d %d %n", &red, &green, &blue, &num) == 3)
{
#ifdef HAVE_NTGUI
diff --git a/src/xfns.c b/src/xfns.c
index e463391c74a..f1c7fd6f3e4 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
@@ -215,8 +215,9 @@ x_real_pos_and_offsets (struct frame *f,
int win_x = 0, win_y = 0, outer_x = 0, outer_y = 0;
int real_x = 0, real_y = 0;
bool had_errors = false;
- Window win = (FRAME_PARENT_FRAME (f)
- ? FRAME_X_WINDOW (FRAME_PARENT_FRAME (f))
+ struct frame *parent_frame = FRAME_PARENT_FRAME (f);
+ Window win = (parent_frame
+ ? FRAME_X_WINDOW (parent_frame)
: f->output_data.x->parent_desc);
struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
long max_len = 400;
@@ -355,8 +356,8 @@ x_real_pos_and_offsets (struct frame *f,
outer_geom_cookie = xcb_get_geometry (xcb_conn,
FRAME_OUTER_WINDOW (f));
- if ((dpyinfo->root_window == f->output_data.x->parent_desc)
- && !FRAME_PARENT_FRAME (f))
+ if (!parent_frame
+ && dpyinfo->root_window == f->output_data.x->parent_desc)
/* Try _NET_FRAME_EXTENTS if our parent is the root window. */
prop_cookie = xcb_get_property (xcb_conn, 0, win,
dpyinfo->Xatom_net_frame_extents,
@@ -470,8 +471,7 @@ x_real_pos_and_offsets (struct frame *f,
#endif
}
- if ((dpyinfo->root_window == f->output_data.x->parent_desc)
- && !FRAME_PARENT_FRAME (f))
+ if (!parent_frame && dpyinfo->root_window == f->output_data.x->parent_desc)
{
/* Try _NET_FRAME_EXTENTS if our parent is the root window. */
#ifdef USE_XCB
@@ -1120,6 +1120,14 @@ enum mouse_cursor {
mouse_cursor_hand,
mouse_cursor_horizontal_drag,
mouse_cursor_vertical_drag,
+ mouse_cursor_left_edge,
+ mouse_cursor_top_left_corner,
+ mouse_cursor_top_edge,
+ mouse_cursor_top_right_corner,
+ mouse_cursor_right_edge,
+ mouse_cursor_bottom_right_corner,
+ mouse_cursor_bottom_edge,
+ mouse_cursor_bottom_left_corner,
mouse_cursor_max
};
@@ -1139,13 +1147,21 @@ struct mouse_cursor_types {
/* This array must stay in sync with enum mouse_cursor above! */
static const struct mouse_cursor_types mouse_cursor_types[] = {
- { "text", &Vx_pointer_shape, XC_xterm },
- { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr },
- { "hourglass", &Vx_hourglass_pointer_shape, XC_watch },
- { "modeline", &Vx_mode_pointer_shape, XC_xterm },
- { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 },
- { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow },
- { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow },
+ { "text", &Vx_pointer_shape, XC_xterm },
+ { "nontext", &Vx_nontext_pointer_shape, XC_left_ptr },
+ { "hourglass", &Vx_hourglass_pointer_shape, XC_watch },
+ { "modeline", &Vx_mode_pointer_shape, XC_xterm },
+ { NULL, &Vx_sensitive_text_pointer_shape, XC_hand2 },
+ { NULL, &Vx_window_horizontal_drag_shape, XC_sb_h_double_arrow },
+ { NULL, &Vx_window_vertical_drag_shape, XC_sb_v_double_arrow },
+ { NULL, &Vx_window_left_edge_shape, XC_left_side },
+ { NULL, &Vx_window_top_left_corner_shape, XC_top_left_corner },
+ { NULL, &Vx_window_top_edge_shape, XC_top_side },
+ { NULL, &Vx_window_top_right_corner_shape, XC_top_right_corner },
+ { NULL, &Vx_window_right_edge_shape, XC_right_side },
+ { NULL, &Vx_window_bottom_right_corner_shape, XC_bottom_right_corner },
+ { NULL, &Vx_window_bottom_edge_shape, XC_bottom_side },
+ { NULL, &Vx_window_bottom_left_corner_shape, XC_bottom_left_corner },
};
struct mouse_cursor_data {
@@ -1296,6 +1312,14 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval)
INSTALL_CURSOR (hand_cursor, hand);
INSTALL_CURSOR (horizontal_drag_cursor, horizontal_drag);
INSTALL_CURSOR (vertical_drag_cursor, vertical_drag);
+ INSTALL_CURSOR (left_edge_cursor, left_edge);
+ INSTALL_CURSOR (top_left_corner_cursor, top_left_corner);
+ INSTALL_CURSOR (top_edge_cursor, top_edge);
+ INSTALL_CURSOR (top_right_corner_cursor, top_right_corner);
+ INSTALL_CURSOR (right_edge_cursor, right_edge);
+ INSTALL_CURSOR (bottom_right_corner_cursor, bottom_right_corner);
+ INSTALL_CURSOR (bottom_edge_cursor, bottom_edge);
+ INSTALL_CURSOR (bottom_left_corner_cursor, bottom_left_corner);
#undef INSTALL_CURSOR
@@ -2038,7 +2062,7 @@ x_set_scroll_bar_default_width (struct frame *f)
int unit = FRAME_COLUMN_WIDTH (f);
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_GTK
- int minw = xg_get_default_scrollbar_width ();
+ int minw = xg_get_default_scrollbar_width (f);
#else
int minw = 16;
#endif
@@ -2059,7 +2083,7 @@ x_set_scroll_bar_default_height (struct frame *f)
int height = FRAME_LINE_HEIGHT (f);
#ifdef USE_TOOLKIT_SCROLL_BARS
#ifdef USE_GTK
- int min_height = xg_get_default_scrollbar_height ();
+ int min_height = xg_get_default_scrollbar_height (f);
#else
int min_height = 16;
#endif
@@ -2875,7 +2899,7 @@ x_window (struct frame *f, long window_prompting)
XtSetArg (al[ac], XtNdepth, FRAME_DISPLAY_INFO (f)->n_planes); ac++;
XtSetArg (al[ac], XtNcolormap, FRAME_X_COLORMAP (f)); ac++;
XtSetArg (al[ac], XtNborderWidth, 0); ac++;
- frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass, pane_widget,
+ frame_widget = XtCreateWidget (f->namebuf, emacsFrameClass (), pane_widget,
al, ac);
f->output_data.x->edit_widget = frame_widget;
@@ -3814,6 +3838,8 @@ This function is an internal primitive--use `make-frame' instead. */)
"leftFringe", "LeftFringe", RES_TYPE_NUMBER);
x_default_parameter (f, parms, Qright_fringe, Qnil,
"rightFringe", "RightFringe", RES_TYPE_NUMBER);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
x_default_scroll_bar_color_parameter (f, parms, Qscroll_bar_foreground,
"scrollBarForeground",
@@ -4858,7 +4884,9 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
#ifdef USE_GTK
double mm_width_per_pixel, mm_height_per_pixel;
GdkDisplay *gdpy;
+#if ! GTK_CHECK_VERSION (3, 22, 0)
GdkScreen *gscreen;
+#endif
gint primary_monitor = 0, n_monitors, i;
Lisp_Object monitor_frames, rest, frame;
static const char *source = "Gdk";
@@ -4870,11 +4898,15 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
mm_height_per_pixel = ((double) HeightMMOfScreen (dpyinfo->screen)
/ x_display_pixel_height (dpyinfo));
gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display);
+#if GTK_CHECK_VERSION (3, 22, 0)
+ n_monitors = gdk_display_get_n_monitors (gdpy);
+#else
gscreen = gdk_display_get_default_screen (gdpy);
#if GTK_CHECK_VERSION (2, 20, 0)
primary_monitor = gdk_screen_get_primary_monitor (gscreen);
#endif
n_monitors = gdk_screen_get_n_monitors (gscreen);
+#endif
monitor_frames = Fmake_vector (make_number (n_monitors), Qnil);
monitors = xzalloc (n_monitors * sizeof *monitors);
@@ -4883,11 +4915,22 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
struct frame *f = XFRAME (frame);
if (FRAME_X_P (f) && FRAME_DISPLAY_INFO (f) == dpyinfo
- && !EQ (frame, tip_frame))
+ && !(EQ (frame, tip_frame)
+#ifdef USE_GTK
+ && !NILP (Fframe_parameter (tip_frame, Qtooltip))
+#endif
+ ))
{
GdkWindow *gwin = gtk_widget_get_window (FRAME_GTK_WIDGET (f));
+#if GTK_CHECK_VERSION (3, 22, 0)
+ for (i = 0; i < n_monitors; i++)
+ if (gdk_display_get_monitor_at_window (gdpy, gwin)
+ == gdk_display_get_monitor (gdpy, i))
+ break;
+#else
i = gdk_screen_get_monitor_at_window (gscreen, gwin);
+#endif
ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i)));
}
}
@@ -4898,9 +4941,19 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
GdkRectangle rec, work;
struct MonitorInfo *mi = &monitors[i];
+#if GTK_CHECK_VERSION (3, 22, 0)
+ GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i);
+ if (gdk_monitor_is_primary (monitor))
+ primary_monitor = i;
+ gdk_monitor_get_geometry (monitor, &rec);
+#else
gdk_screen_get_monitor_geometry (gscreen, i, &rec);
+#endif
-#if GTK_CHECK_VERSION (2, 14, 0)
+#if GTK_CHECK_VERSION (3, 22, 0)
+ width_mm = gdk_monitor_get_width_mm (monitor);
+ height_mm = gdk_monitor_get_height_mm (monitor);
+#elif GTK_CHECK_VERSION (2, 14, 0)
width_mm = gdk_screen_get_monitor_width_mm (gscreen, i);
height_mm = gdk_screen_get_monitor_height_mm (gscreen, i);
#endif
@@ -4909,7 +4962,9 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
if (height_mm < 0)
height_mm = rec.height * mm_height_per_pixel + 0.5;
-#if GTK_CHECK_VERSION (3, 4, 0)
+#if GTK_CHECK_VERSION (3, 22, 0)
+ gdk_monitor_get_workarea (monitor, &work);
+#elif GTK_CHECK_VERSION (3, 4, 0)
gdk_screen_get_monitor_workarea (gscreen, i, &work);
#else
/* Emulate the behavior of GTK+ 3.4. */
@@ -4942,7 +4997,9 @@ Internal use only, use `display-monitor-attributes-list' instead. */)
mi->mm_width = width_mm;
mi->mm_height = height_mm;
-#if GTK_CHECK_VERSION (2, 14, 0)
+#if GTK_CHECK_VERSION (3, 22, 0)
+ mi->name = g_strdup (gdk_monitor_get_model (monitor));
+#elif GTK_CHECK_VERSION (2, 14, 0)
mi->name = gdk_screen_get_monitor_plug_name (gscreen, i);
#endif
}
@@ -5286,7 +5343,7 @@ Frames are listed from topmost (first) to bottommost (last). */)
static void
x_frame_restack (struct frame *f1, struct frame *f2, bool above_flag)
{
-#ifdef USE_GTK
+#if defined (USE_GTK) && GTK_CHECK_VERSION (2, 18, 0)
block_input ();
xg_frame_restack (f1, f2, above_flag);
unblock_input ();
@@ -6196,6 +6253,8 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
"cursorColor", "Foreground", RES_TYPE_STRING);
x_default_parameter (f, parms, Qborder_color, build_string ("black"),
"borderColor", "BorderColor", RES_TYPE_STRING);
+ x_default_parameter (f, parms, Qno_special_glyphs, Qnil,
+ NULL, NULL, RES_TYPE_BOOLEAN);
/* Init faces before x_default_parameter is called for the
scroll-bar-width parameter because otherwise we end up in
@@ -6273,7 +6332,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Lisp_Object parms)
}
/* FIXME - can this be done in a similar way to normal frames?
- http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00641.html */
+ https://lists.gnu.org/r/emacs-devel/2007-10/msg00641.html */
/* Set the `display-type' frame parameter before setting up faces. */
{
@@ -7486,6 +7545,7 @@ frame_parm_handler x_frame_parm_handlers[] =
x_set_no_accept_focus,
x_set_z_group,
x_set_override_redirect,
+ x_set_no_special_glyphs,
};
void
@@ -7564,6 +7624,62 @@ This variable takes effect when you create a new frame
or when you set the mouse color. */);
Vx_window_vertical_drag_shape = Qnil;
+ DEFVAR_LISP ("x-window-left-edge-cursor",
+ Vx_window_left_edge_shape,
+ doc: /* Pointer shape indicating a left x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_left_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-top-left-corner-cursor",
+ Vx_window_top_left_corner_shape,
+ doc: /* Pointer shape indicating a top left x-window corner can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_top_left_corner_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-top-edge-cursor",
+ Vx_window_top_edge_shape,
+ doc: /* Pointer shape indicating a top x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_top_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-top-right-corner-cursor",
+ Vx_window_top_right_corner_shape,
+ doc: /* Pointer shape indicating a top right x-window corner can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_top_right_corner_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-right-edge-cursor",
+ Vx_window_right_edge_shape,
+ doc: /* Pointer shape indicating a right x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_right_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-bottom-right-corner-cursor",
+ Vx_window_bottom_right_corner_shape,
+ doc: /* Pointer shape indicating a bottom right x-window corner can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_bottom_right_corner_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-bottom-edge-cursor",
+ Vx_window_bottom_edge_shape,
+ doc: /* Pointer shape indicating a bottom x-window edge can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_bottom_edge_shape = Qnil;
+
+ DEFVAR_LISP ("x-window-bottom-left-corner-cursor",
+ Vx_window_bottom_left_corner_shape,
+ doc: /* Pointer shape indicating a bottom left x-window corner can be dragged.
+This variable takes effect when you create a new frame
+or when you set the mouse color. */);
+ Vx_window_bottom_left_corner_shape = Qnil;
+
DEFVAR_LISP ("x-cursor-fore-pixel", Vx_cursor_fore_pixel,
doc: /* A string indicating the foreground color of the cursor box. */);
Vx_cursor_fore_pixel = Qnil;
diff --git a/src/xfont.c b/src/xfont.c
index b73596ce7ce..3891c8b7b92 100644
--- a/src/xfont.c
+++ b/src/xfont.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
@@ -505,7 +505,8 @@ xfont_list (struct frame *f, Lisp_Object spec)
Lisp_Object alter;
if ((alter = Fassoc (SYMBOL_NAME (registry),
- Vface_alternative_font_registry_alist),
+ Vface_alternative_font_registry_alist,
+ Qnil),
CONSP (alter)))
{
/* Pointer to REGISTRY-ENCODING field. */
@@ -876,7 +877,7 @@ xfont_close (struct font *font)
the logically different X connection after the previous display
connection was closed. That's why we also check whether font's
ID matches the one recorded in x_display_info for this display.
- See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16069. */
+ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16069. */
if (xfi->xfont
&& ((xdi = x_display_info_for_display (xfi->display))
&& xfi->x_display_id == xdi->x_id))
diff --git a/src/xftfont.c b/src/xftfont.c
index 137d5baf14b..ff8a59f3bf2 100644
--- a/src/xftfont.c
+++ b/src/xftfont.c
@@ -17,7 +17,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
diff --git a/src/xgselect.c b/src/xgselect.c
index 26a2d27e84b..885563cc90d 100644
--- a/src/xgselect.c
+++ b/src/xgselect.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/src/xgselect.h b/src/xgselect.h
index 5baf8a8f03c..a4280cc0215 100644
--- a/src/xgselect.h
+++ b/src/xgselect.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef XGSELECT_H
#define XGSELECT_H
diff --git a/src/xmenu.c b/src/xmenu.c
index 6c8a0c506cc..3935307519f 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* X pop-up deck-of-cards menu facility for GNU Emacs.
*
@@ -1271,6 +1271,11 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv,
/* Child of win. */
&dummy_window);
+#ifdef HAVE_GTK3
+ /* Use window scaling factor to adjust position for hidpi screens. */
+ x /= xg_get_scale (f);
+ y /= xg_get_scale (f);
+#endif
unblock_input ();
popup_x_y.x = x;
popup_x_y.y = y;
diff --git a/src/xml.c b/src/xml.c
index 7953491cc22..7afaa63c421 100644
--- a/src/xml.c
+++ b/src/xml.c
@@ -14,19 +14,19 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+
#ifdef HAVE_LIBXML2
#include <libxml/tree.h>
#include <libxml/parser.h>
#include <libxml/HTMLparser.h>
-#include "lisp.h"
-#include "buffer.h"
-
#ifdef WINDOWSNT
@@ -291,16 +291,43 @@ If DISCARD-COMMENTS is non-nil, all HTML comments are discarded. */)
return parse_region (start, end, base_url, discard_comments, false);
return Qnil;
}
+#endif /* HAVE_LIBXML2 */
+
+DEFUN ("libxml-available-p", Flibxml_available_p, Slibxml_available_p, 0, 0, 0,
+ doc: /* Return t if libxml2 support is available in this instance of Emacs.*/)
+ (void)
+{
+#ifdef HAVE_LIBXML2
+# ifdef WINDOWSNT
+ Lisp_Object found = Fassq (Qlibxml2, Vlibrary_cache);
+ if (CONSP (found))
+ return XCDR (found);
+ else
+ {
+ Lisp_Object status;
+ status = init_libxml2_functions () ? Qt : Qnil;
+ Vlibrary_cache = Fcons (Fcons (Qlibxml2, status), Vlibrary_cache);
+ return status;
+ }
+# else
+ return Qt;
+# endif /* WINDOWSNT */
+#else
+ return Qnil;
+#endif /* HAVE_LIBXML2 */
+}
+
/***********************************************************************
Initialization
***********************************************************************/
void
syms_of_xml (void)
{
+#ifdef HAVE_LIBXML2
defsubr (&Slibxml_parse_html_region);
defsubr (&Slibxml_parse_xml_region);
+#endif
+ defsubr (&Slibxml_available_p);
}
-
-#endif /* HAVE_LIBXML2 */
diff --git a/src/xrdb.c b/src/xrdb.c
index 5611a33b283..3c1bad1c735 100644
--- a/src/xrdb.c
+++ b/src/xrdb.c
@@ -18,7 +18,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -345,6 +345,7 @@ get_user_db (Display *display)
db = XrmGetStringDatabase (xdefs);
else
{
+ /* Use ~/.Xdefaults. */
char *home = gethomedir ();
ptrdiff_t homelen = strlen (home);
char *filename = xrealloc (home, homelen + sizeof xdefaults);
@@ -375,13 +376,15 @@ get_environ_db (void)
if (!p)
{
+ /* Use ~/.Xdefaults-HOSTNAME. */
char *home = gethomedir ();
ptrdiff_t homelen = strlen (home);
Lisp_Object system_name = Fsystem_name ();
ptrdiff_t filenamesize = (homelen + sizeof xdefaults
- + SBYTES (system_name));
+ + 1 + SBYTES (system_name));
p = filename = xrealloc (home, filenamesize);
- lispstpcpy (stpcpy (filename + homelen, xdefaults), system_name);
+ lispstpcpy (stpcpy (stpcpy (filename + homelen, xdefaults), "-"),
+ system_name);
}
db = XrmGetFileDatabase (p);
diff --git a/src/xselect.c b/src/xselect.c
index 2249828fb4e..7fbb23339d9 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -14,7 +14,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* Rewritten by jwz */
diff --git a/src/xsettings.c b/src/xsettings.c
index 4d56ad10dda..fe90152f6f0 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -675,8 +675,8 @@ apply_xft_settings (struct x_display_info *dpyinfo,
of unrelated settings that override users' font customizations,
among others. Compare:
- http://lists.gnu.org/archive/html/emacs-devel/2016-05/msg00557.html
- http://lists.gnu.org/archive/html/bug-gnu-emacs/2016-12/msg00820.html
+ https://lists.gnu.org/r/emacs-devel/2016-05/msg00557.html
+ https://lists.gnu.org/r/bug-gnu-emacs/2016-12/msg00820.html
As soon as the dynamic-settings code has been tested and
verified, this Emacs 25.2 workaround should be removed. */
diff --git a/src/xsettings.h b/src/xsettings.h
index ba2a31082be..27717aae6ee 100644
--- a/src/xsettings.h
+++ b/src/xsettings.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef XSETTINGS_H
#define XSETTINGS_H
diff --git a/src/xsmfns.c b/src/xsmfns.c
index d3b4d4d66a3..fb0d01bb66c 100644
--- a/src/xsmfns.c
+++ b/src/xsmfns.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -401,12 +401,14 @@ x_session_initialize (struct x_display_info *dpyinfo)
ptrdiff_t name_len = 0;
/* libSM seems to crash if pwd is missing - see bug#18851. */
- if (! emacs_get_current_dir_name ())
+ char *pwd = emacs_get_current_dir_name ();
+ if (!pwd)
{
fprintf (stderr, "Disabling session management due to pwd error: %s\n",
emacs_strerror (errno));
return;
}
+ xfree (pwd);
ice_fd = -1;
doing_interact = false;
diff --git a/src/xterm.c b/src/xterm.c
index c8836b7ca78..1b45cf1b0b7 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
/* New display code by Gerd Moellmann <gerd@gnu.org>. */
/* Xt features made by Fred Pierresteguy. */
@@ -23,9 +23,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <stdio.h>
#include <stdlib.h>
-#ifdef USE_CAIRO
#include <math.h>
-#endif
#include "lisp.h"
#include "blockinput.h"
@@ -233,7 +231,7 @@ static void x_sync_with_move (struct frame *, int, int, bool);
static int handle_one_xevent (struct x_display_info *,
const XEvent *, int *,
struct input_event *);
-#if ! (defined USE_X_TOOLKIT || defined USE_MOTIF)
+#if ! (defined USE_X_TOOLKIT || defined USE_MOTIF) && defined USE_GTK
static int x_dispatch_event (XEvent *, Display *);
#endif
static void x_wm_set_window_state (struct frame *, int);
@@ -999,7 +997,11 @@ x_update_begin (struct frame *f)
{
#ifdef USE_CAIRO
if (! NILP (tip_frame) && XFRAME (tip_frame) == f
- && ! FRAME_VISIBLE_P (f))
+ && ! FRAME_VISIBLE_P (f)
+#ifdef USE_GTK
+ && !NILP (Fframe_parameter (tip_frame, Qtooltip))
+#endif
+ )
return;
if (! FRAME_CR_SURFACE (f))
@@ -1102,8 +1104,9 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
: FRAME_FOREGROUND_PIXEL (f));
Display *display = FRAME_X_DISPLAY (f);
- if (y1 - y0 > x1 - x0 && x1 - x0 > 2)
- /* Vertical. */
+ if ((y1 - y0 > x1 - x0) && (x1 - x0 >= 3))
+ /* A vertical divider, at least three pixels wide: Draw first and
+ last pixels differently. */
{
XSetForeground (display, f->output_data.x->normal_gc, color_first);
x_fill_rectangle (f, f->output_data.x->normal_gc,
@@ -1115,8 +1118,9 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
x_fill_rectangle (f, f->output_data.x->normal_gc,
x1 - 1, y0, 1, y1 - y0);
}
- else if (x1 - x0 > y1 - y0 && y1 - y0 > 3)
- /* Horizontal. */
+ else if ((x1 - x0 > y1 - y0) && (y1 - y0 >= 3))
+ /* A horizontal divider, at least three pixels high: Draw first and
+ last pixels differently. */
{
XSetForeground (display, f->output_data.x->normal_gc, color_first);
x_fill_rectangle (f, f->output_data.x->normal_gc,
@@ -1130,6 +1134,8 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1)
}
else
{
+ /* In any other case do not draw the first and last pixels
+ differently. */
XSetForeground (display, f->output_data.x->normal_gc, color);
x_fill_rectangle (f, f->output_data.x->normal_gc,
x0, y0, x1 - x0, y1 - y0);
@@ -1384,12 +1390,13 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row)
{
unsigned long color = face->background;
Display *display = FRAME_X_DISPLAY (f);
+ GC gc = f->output_data.x->normal_gc;
- XSetForeground (display, f->output_data.x->normal_gc, color);
- x_fill_rectangle (f, f->output_data.x->normal_gc,
- 0, y, width, height);
- x_fill_rectangle (f, f->output_data.x->normal_gc,
- FRAME_PIXEL_WIDTH (f) - width, y, width, height);
+ XSetForeground (display, gc, color);
+ x_fill_rectangle (f, gc, 0, y, width, height);
+ x_fill_rectangle (f, gc, FRAME_PIXEL_WIDTH (f) - width, y,
+ width, height);
+ XSetForeground (display, gc, FRAME_FOREGROUND_PIXEL (f));
}
else
{
@@ -3475,6 +3482,23 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
s->background_filled_p = true;
}
+static void
+x_get_scale_factor(Display *disp, int *scale_x, int *scale_y)
+{
+ const int base_res = 96;
+ struct x_display_info * dpyinfo = x_display_info_for_display (disp);
+
+ *scale_x = *scale_y = 1;
+
+ if (dpyinfo)
+ {
+ if (dpyinfo->resx > base_res)
+ *scale_x = floor (dpyinfo->resx / base_res);
+ if (dpyinfo->resy > base_res)
+ *scale_y = floor (dpyinfo->resy / base_res);
+ }
+}
+
/*
Draw a wavy line under S. The wave fills wave_height pixels from y0.
@@ -3485,11 +3509,16 @@ x_draw_stretch_glyph_string (struct glyph_string *s)
wave_height = 3 | * * * *
*/
-
static void
x_draw_underwave (struct glyph_string *s)
{
- int wave_height = 3, wave_length = 2;
+ /* Adjust for scale/HiDPI. */
+ int scale_x, scale_y;
+
+ x_get_scale_factor (s->display, &scale_x, &scale_y);
+
+ int wave_height = 3 * scale_y, wave_length = 2 * scale_x, thickness = scale_y;
+
#ifdef USE_CAIRO
x_draw_horizontal_wave (s->f, s->gc, s->x, s->ybase - wave_height + 3,
s->width, wave_height, wave_length);
@@ -3501,7 +3530,7 @@ x_draw_underwave (struct glyph_string *s)
dx = wave_length;
dy = wave_height - 1;
x0 = s->x;
- y0 = s->ybase - wave_height + 3;
+ y0 = s->ybase + wave_height / 2 - scale_y;
width = s->width;
xmax = x0 + width;
@@ -3535,6 +3564,8 @@ x_draw_underwave (struct glyph_string *s)
while (x1 <= xmax)
{
+ XSetLineAttributes (s->display, s->gc, thickness, LineSolid, CapButt,
+ JoinRound);
XDrawLine (s->display, FRAME_X_DRAWABLE (s->f), s->gc, x1, y1, x2, y2);
x1 = x2, y1 = y2;
x2 += dx, y2 = y0 + odd*dy;
@@ -3847,7 +3878,7 @@ static void
x_shift_glyphs_for_insert (struct frame *f, int x, int y, int width, int height, int shift_by)
{
/* Never called on a GUI frame, see
- http://lists.gnu.org/archive/html/emacs-devel/2015-05/msg00456.html
+ https://lists.gnu.org/r/emacs-devel/2015-05/msg00456.html
*/
XCopyArea (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), FRAME_X_DRAWABLE (f),
f->output_data.x->normal_gc,
@@ -3996,7 +4027,13 @@ XTflash (struct frame *f)
when the scroll bars and the edit widget share the same X window. */
GdkWindow *window = gtk_widget_get_window (FRAME_GTK_WIDGET (f));
#ifdef HAVE_GTK3
+#if GTK_CHECK_VERSION (3, 22, 0)
+ cairo_region_t *region = gdk_window_get_visible_region (window);
+ GdkDrawingContext *context = gdk_window_begin_draw_frame (window, region);
+ cairo_t *cr = gdk_drawing_context_get_cairo_context (context);
+#else
cairo_t *cr = gdk_cairo_create (window);
+#endif
cairo_set_source_rgb (cr, 1, 1, 1);
cairo_set_operator (cr, CAIRO_OPERATOR_DIFFERENCE);
#define XFillRectangle(d, win, gc, x, y, w, h) \
@@ -4110,7 +4147,12 @@ XTflash (struct frame *f)
#ifdef USE_GTK
#ifdef HAVE_GTK3
+#if GTK_CHECK_VERSION (3, 22, 0)
+ gdk_window_end_draw_frame (window, context);
+ cairo_region_destroy (region);
+#else
cairo_destroy (cr);
+#endif
#else
g_object_unref (G_OBJECT (gc));
#endif
@@ -5697,7 +5739,6 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data)
enum scroll_bar_part part;
bool horizontal = bar->horizontal;
-
if (horizontal)
{
/* Get the size of the thumb, a value between 0 and 1. */
@@ -7972,7 +8013,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
#ifdef USE_GTK
/* This seems to be needed for GTK 2.6 and later, see
- http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */
+ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */
x_clear_area (f,
event->xexpose.x, event->xexpose.y,
event->xexpose.width, event->xexpose.height);
@@ -8683,9 +8724,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
if (f)
{
- /* Don't call x_net_wm_state for the scroll bar window.
- (Bug#24963, Bug#25887) */
+#ifdef USE_GTK
+ /* For GTK+ don't call x_net_wm_state for the scroll bar
+ window. (Bug#24963, Bug#25887) */
if (configureEvent.xconfigure.window == FRAME_X_WINDOW (f))
+#endif
x_net_wm_state (f, configureEvent.xconfigure.window);
#ifdef USE_X_TOOLKIT
@@ -9008,6 +9051,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
return count;
}
+#if defined USE_X_TOOLKIT || defined USE_MOTIF || defined USE_GTK
+
/* Handles the XEvent EVENT on display DISPLAY.
This is used for event loops outside the normal event handling,
i.e. looping while a popup menu or a dialog is posted.
@@ -9026,6 +9071,7 @@ x_dispatch_event (XEvent *event, Display *display)
return finish;
}
+#endif
/* Read events coming from the X server.
Return as soon as there are no more events to be read.
@@ -9925,7 +9971,11 @@ x_new_font (struct frame *f, Lisp_Object font_object, int fontset)
/* Don't change the size of a tip frame; there's no point in
doing it because it's done in Fx_show_tip, and it leads to
problems because the tip frame has no widget. */
- if (NILP (tip_frame) || XFRAME (tip_frame) != f)
+ if (NILP (tip_frame) || XFRAME (tip_frame) != f
+#ifdef USE_GTK
+ || NILP (Fframe_parameter (tip_frame, Qtooltip))
+#endif
+ )
{
adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f),
FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 3,
@@ -10994,17 +11044,22 @@ x_sync_with_move (struct frame *f, int left, int top, bool fuzzy)
void
x_wait_for_event (struct frame *f, int eventtype)
{
- int level = interrupt_input_blocked;
+ if (!FLOATP (Vx_wait_for_event_timeout))
+ return;
+ int level = interrupt_input_blocked;
fd_set fds;
struct timespec tmo, tmo_at, time_now;
int fd = ConnectionNumber (FRAME_X_DISPLAY (f));
f->wait_event_type = eventtype;
- /* Set timeout to 0.1 second. Hopefully not noticeable.
- Maybe it should be configurable. */
- tmo = make_timespec (0, 100 * 1000 * 1000);
+ /* Default timeout is 0.1 second. Hopefully not noticeable. */
+ double timeout = XFLOAT_DATA (Vx_wait_for_event_timeout);
+ time_t timeout_seconds = (time_t) timeout;
+ tmo = make_timespec
+ (timeout_seconds, (long int) ((timeout - timeout_seconds)
+ * 1000 * 1000 * 1000));
tmo_at = timespec_add (current_timespec (), tmo);
while (f->wait_event_type)
@@ -11330,8 +11385,13 @@ xembed_send_message (struct frame *f, Time t, enum xembed_message msg,
/* Change of visibility. */
-/* This function sends the request to make the frame visible, but may
- return before it the frame's visibility is changed. */
+/* This tries to wait until the frame is really visible, depending on
+ the value of Vx_wait_for_event_timeout.
+ However, if the window manager asks the user where to position
+ the frame, this will return before the user finishes doing that.
+ The frame will not actually be visible at that time,
+ but it will become visible later when the window manager
+ finishes with it. */
void
x_make_frame_visible (struct frame *f)
@@ -11402,11 +11462,14 @@ x_make_frame_visible (struct frame *f)
before we do anything else. We do this loop with input not blocked
so that incoming events are handled. */
{
+ Lisp_Object frame;
/* This must be before UNBLOCK_INPUT
since events that arrive in response to the actions above
will set it when they are handled. */
bool previously_visible = f->output_data.x->has_been_visible;
+ XSETFRAME (frame, f);
+
int original_left = f->left_pos;
int original_top = f->top_pos;
@@ -11453,6 +11516,26 @@ x_make_frame_visible (struct frame *f)
unblock_input ();
}
+
+ /* Try to wait for a MapNotify event (that is what tells us when a
+ frame becomes visible). */
+
+#ifdef CYGWIN
+ /* On Cygwin, which uses input polling, we need to force input to
+ be read. See
+ https://lists.gnu.org/r/emacs-devel/2013-12/msg00351.html
+ and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24091#131.
+ Fake an alarm signal to let the handler know that there's
+ something to be read.
+
+ It could be confusing if a real alarm arrives while processing
+ the fake one. Turn it off and let the handler reset it. */
+ int old_poll_suppress_count = poll_suppress_count;
+ poll_suppress_count = 1;
+ poll_for_input_1 ();
+ poll_suppress_count = old_poll_suppress_count;
+#endif
+ x_wait_for_event (f, MapNotify);
}
}
@@ -11757,6 +11840,22 @@ x_free_frame_resources (struct frame *f)
XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->horizontal_drag_cursor);
if (f->output_data.x->vertical_drag_cursor != 0)
XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->vertical_drag_cursor);
+ if (f->output_data.x->left_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->left_edge_cursor);
+ if (f->output_data.x->top_left_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_left_corner_cursor);
+ if (f->output_data.x->top_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_edge_cursor);
+ if (f->output_data.x->top_right_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->top_right_corner_cursor);
+ if (f->output_data.x->right_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->right_edge_cursor);
+ if (f->output_data.x->bottom_right_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_right_corner_cursor);
+ if (f->output_data.x->bottom_edge_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_edge_cursor);
+ if (f->output_data.x->bottom_left_corner_cursor != 0)
+ XFreeCursor (FRAME_X_DISPLAY (f), f->output_data.x->bottom_left_corner_cursor);
XFlush (FRAME_X_DISPLAY (f));
}
@@ -12217,7 +12316,7 @@ static void
x_setup_pointer_blanking (struct x_display_info *dpyinfo)
{
/* FIXME: the brave tester should set EMACS_XFIXES because we're suspecting
- X server bug, see http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17609. */
+ X server bug, see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17609. */
if (egetenv ("EMACS_XFIXES") && x_probe_xfixes_extension (dpyinfo->display))
dpyinfo->toggle_visible_pointer = xfixes_toggle_visible_pointer;
else
@@ -12420,7 +12519,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
{
terminal->kboard = allocate_kboard (Qx);
- if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound))
+ if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->u.s.function, Qunbound))
{
char *vendor = ServerVendor (dpy);
@@ -12456,7 +12555,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
dpyinfo->xcb_connection = xcb_conn;
#endif
- /* http://lists.gnu.org/archive/html/emacs-devel/2015-11/msg00194.html */
+ /* https://lists.gnu.org/r/emacs-devel/2015-11/msg00194.html */
dpyinfo->smallest_font_height = 1;
dpyinfo->smallest_char_width = 1;
@@ -13232,6 +13331,17 @@ This should be one of the symbols `ctrl', `alt', `hyper', `meta',
keysyms. The default is nil, which is the same as `super'. */);
Vx_super_keysym = Qnil;
+ DEFVAR_LISP ("x-wait-for-event-timeout", Vx_wait_for_event_timeout,
+ doc: /* How long to wait for X events.
+
+Emacs will wait up to this many seconds to receive X events after
+making changes which affect the state of the graphical interface.
+Under some window managers this can take an indefinite amount of time,
+so it is important to limit the wait.
+
+If set to a non-float value, there will be no wait at all. */);
+ Vx_wait_for_event_timeout = make_float (0.1);
+
DEFVAR_LISP ("x-keysym-table", Vx_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
Vx_keysym_table = make_hash_table (hashtest_eql, 900,
@@ -13256,6 +13366,7 @@ transition between the various maximization states. */);
doc: /* Non-nil means rely on gtk_window_move to set frame positions.
If this variable is t (the default), the GTK build uses the function
gtk_window_move to set or store frame positions and disables some time
-consuming frame position adjustments. */);
+consuming frame position adjustments. In newer versions of GTK, Emacs
+always uses gtk_window_move and ignores the value of this variable. */);
x_gtk_use_window_move = true;
}
diff --git a/src/xterm.h b/src/xterm.h
index a75257006fd..7ab20ba06c6 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef XTERM_H
#define XTERM_H
@@ -48,12 +48,6 @@ typedef Widget xt_or_gtk_widget;
#ifdef USE_GTK
#include <gtk/gtk.h>
#include <gdk/gdkx.h>
-
-/* Some definitions to reduce conditionals. */
-typedef GtkWidget *xt_or_gtk_widget;
-#undef XSync
-#define XSync(d, b) do { gdk_window_process_all_updates (); \
- XSync (d, b); } while (false)
#endif /* USE_GTK */
/* True iff GTK's version is at least I.J.K. */
@@ -69,6 +63,19 @@ typedef GtkWidget *xt_or_gtk_widget;
# endif
#endif
+#ifdef USE_GTK
+/* Some definitions to reduce conditionals. */
+typedef GtkWidget *xt_or_gtk_widget;
+#undef XSync
+/* gdk_window_process_all_updates is deprecated in GDK 3.22. */
+#if GTK_CHECK_VERSION (3, 22, 0)
+#define XSync(d, b) do { XSync ((d), (b)); } while (false)
+#else
+#define XSync(d, b) do { gdk_window_process_all_updates (); \
+ XSync (d, b); } while (false)
+#endif
+#endif /* USE_GTK */
+
/* The GtkTooltip API came in 2.12, but gtk-enable-tooltips in 2.14. */
#if GTK_CHECK_VERSION (2, 14, 0)
#define USE_GTK_TOOLTIP
@@ -637,6 +644,14 @@ struct x_output
Cursor horizontal_drag_cursor;
Cursor vertical_drag_cursor;
Cursor current_cursor;
+ Cursor left_edge_cursor;
+ Cursor top_left_corner_cursor;
+ Cursor top_edge_cursor;
+ Cursor top_right_corner_cursor;
+ Cursor right_edge_cursor;
+ Cursor bottom_right_corner_cursor;
+ Cursor bottom_edge_cursor;
+ Cursor bottom_left_corner_cursor;
/* Window whose cursor is hourglass_cursor. This window is temporarily
mapped to display an hourglass cursor. */
@@ -872,7 +887,7 @@ extern void x_mark_frame_dirty (struct frame *f);
struct scroll_bar
{
/* These fields are shared by all vectors. */
- struct vectorlike_header header;
+ union vectorlike_header header;
/* The window we're a scroll bar for. */
Lisp_Object window;
diff --git a/src/xwidget.c b/src/xwidget.c
index e6de5da8e69..a67dc0ecf4d 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
@@ -585,22 +585,20 @@ x_draw_xwidget_glyph_string (struct glyph_string *s)
xwidget on screen. Moving and clipping is done here. Also view
initialization. */
struct xwidget *xww = s->xwidget;
- struct xwidget_view *xv;
+ struct xwidget_view *xv = xwidget_view_lookup (xww, s->w);
int clip_right;
int clip_bottom;
int clip_top;
int clip_left;
- /* FIXME: The result of this call is discarded.
- What if the lookup fails? */
- xwidget_view_lookup (xww, s->w);
-
int x = s->x;
int y = s->y + (s->height / 2) - (xww->height / 2);
/* Do initialization here in the display loop because there is no
- other time to know things like window placement etc. */
- xv = xwidget_init_view (xww, s, x, y);
+ other time to know things like window placement etc. Do not
+ create a new view if we have found one that is usable. */
+ if (!xv)
+ xv = xwidget_init_view (xww, s, x, y);
int text_area_x, text_area_y, text_area_width, text_area_height;
diff --git a/src/xwidget.h b/src/xwidget.h
index d43b4017965..02a0453dabb 100644
--- a/src/xwidget.h
+++ b/src/xwidget.h
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef XWIDGET_H_INCLUDED
#define XWIDGET_H_INCLUDED
@@ -33,7 +33,7 @@ struct window;
struct xwidget
{
- struct vectorlike_header header;
+ union vectorlike_header header;
/* Auxiliary data. */
Lisp_Object plist;
@@ -62,7 +62,7 @@ struct xwidget
struct xwidget_view
{
- struct vectorlike_header header;
+ union vectorlike_header header;
Lisp_Object model;
Lisp_Object w;
diff --git a/test/ChangeLog.1 b/test/ChangeLog.1
index 4491eb82d67..7b228abd1d9 100644
--- a/test/ChangeLog.1
+++ b/test/ChangeLog.1
@@ -1307,7 +1307,7 @@
* automated/undo-tests.el (undo-test-in-region-not-most-recent):
Add new test of undo in region.
(undo-test-in-region-eob): Add test case described at
- http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411
+ https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411
2014-02-28 Michael Albinus <michael.albinus@gmx.de>
@@ -2967,4 +2967,4 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/test/Makefile.in b/test/Makefile.in
index 67bb7ac2eea..ffbb065ec69 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -15,7 +15,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
### Commentary:
@@ -97,6 +97,16 @@ TEST_LOCALE = C
# this by default since it gives nicer stacktraces.
TEST_LOAD_EL ?= yes
+# Maximum length of lines in ert backtraces; nil for no limit.
+# (if empty, use the default ert-batch-backtrace-right-margin).
+TEST_BACKTRACE_LINE_LENGTH =
+
+ifeq (${TEST_BACKTRACE_LINE_LENGTH},)
+ert_opts =
+else
+ert_opts = --eval '(setq ert-batch-backtrace-right-margin ${TEST_BACKTRACE_LINE_LENGTH})'
+endif
+
ifeq (@HAVE_MODULES@, yes)
MODULES_EMACSOPT := --module-assertions
else
@@ -137,6 +147,13 @@ endif
## Save logs, and show logs for failed tests.
WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; }
+ifdef EMACS_HYDRA_CI
+## On Hydra, always show logs for certain problematic tests.
+lisp/emacs-lisp/eieio-tests/eieio-tests.log \
+lisp/net/tramp-tests.log \
+lisp/url/url-tramp-test.log \
+: WRITE_LOG = 2>&1 | tee $@
+endif
ifeq ($(TEST_LOAD_EL), yes)
testloadfile = $*.el
@@ -144,10 +161,10 @@ else
testloadfile = $*
endif
-## Ignore any test errors so we can continue to test other files.
%.log: %.elc
$(AM_V_at)${MKDIR_P} $(dir $@)
- -$(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \
+ $(AM_V_GEN)HOME=/nonexistent $(emacs) \
+ -l ert ${ert_opts} -l $(testloadfile) \
--eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG}
ifeq (@HAVE_MODULES@, yes)
@@ -156,11 +173,11 @@ else
maybe_exclude_module_tests := -name emacs-module-tests.el -prune -o
endif
-ELFILES := $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \
+ELFILES := $(sort $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \
-path "${srcdir}/data" -prune -o \
-name "*resources" -prune -o \
${maybe_exclude_module_tests} \
- -name "*.el" ! -name ".*" -print)
+ -name "*.el" ! -name ".*" -print))
## .log files may be in a different directory for out of source builds
LOGFILES := $(patsubst %.el,%.log, \
$(patsubst $(srcdir)/%,%,$(ELFILES)))
@@ -178,12 +195,12 @@ TESTS := $(LOGFILES:.log=)
define test_template
## A test FOO-tests depends on the source file with the similar
## name, unless FOO itself contains the string '-tests/'.
- ## The similar name is FOO.c if FOO begins with 'src/', FOO.el
+ ## The similar name is FOO.c if FOO begins with '{lib-,}src/', FOO.el
## otherwise. Although this heuristic does not identify all the
## dependencies, it is better than nothing.
ifeq (,$(patsubst %-tests,,$(1))$(findstring -tests/,$(1)))
$(1).log: $(patsubst %-tests,$(srcdir)/../%,$(1))$(if \
- $(patsubst src/%,,$(1)),.el,.c)
+ $(patsubst src/%,,$(patsubst lib-src/%,,$(1))),.el,.c)
endif
## Short aliases that always re-run the tests, with no logging.
@@ -220,7 +237,7 @@ endif
## the tests were arranged differently.
.PHONY: check-no-automated-subdir
check-no-automated-subdir:
- test ! -d $(srcdir)/automated
+ ${AM_V_at}test ! -d $(srcdir)/automated
## Rerun all default tests.
check: mostlyclean check-no-automated-subdir
@@ -240,8 +257,11 @@ check-maybe: check-no-automated-subdir
## Run the tests.
.PHONY: check-doit
-check-doit: ${LOGFILES}
- @$(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^
+## We can't put LOGFILES as prerequisites, because that would stop the
+## summarizing step from running when there is an error.
+check-doit:
+ -@${MAKE} -k ${LOGFILES}
+ @$(emacs) -l ert -f ert-summarize-tests-batch-and-exit ${LOGFILES}
.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean
diff --git a/test/README b/test/README
index fca20166821..aced1a4414e 100644
--- a/test/README
+++ b/test/README
@@ -61,4 +61,4 @@ 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 <http://www.gnu.org/licenses/>.
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index eee9466c5d6..4193f21b300 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -15,7 +15,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <assert.h>
#include <stdio.h>
@@ -235,6 +235,27 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
return invalid_stored_value;
}
+/* An invalid finalizer: Finalizers are run during garbage collection,
+ where Lisp code can’t be executed. -module-assertions tests for
+ this case. */
+
+static emacs_env *current_env;
+
+static void
+invalid_finalizer (void *ptr)
+{
+ current_env->intern (current_env, "nil");
+}
+
+static emacs_value
+Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ current_env = env;
+ env->make_user_ptr (env, invalid_finalizer, NULL);
+ return env->funcall (env, env->intern (env, "garbage-collect"), 0, NULL);
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
@@ -300,6 +321,8 @@ emacs_module_init (struct emacs_runtime *ert)
DEFUN ("mod-test-vector-eq", Fmod_test_vector_eq, 2, 2, NULL, NULL);
DEFUN ("mod-test-invalid-store", Fmod_test_invalid_store, 0, 0, NULL, NULL);
DEFUN ("mod-test-invalid-load", Fmod_test_invalid_load, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-invalid-finalizer", Fmod_test_invalid_finalizer, 0, 0,
+ NULL, NULL);
#undef DEFUN
diff --git a/test/data/mailcap/mime.types b/test/data/mailcap/mime.types
new file mode 100644
index 00000000000..4bedfaf9702
--- /dev/null
+++ b/test/data/mailcap/mime.types
@@ -0,0 +1,5 @@
+# this is a comment
+
+audio/ogg opus
+audio/flac flac
+audio/x-wav wav
diff --git a/test/data/xdg/l10n.desktop b/test/data/xdg/l10n.desktop
new file mode 100644
index 00000000000..42da83910da
--- /dev/null
+++ b/test/data/xdg/l10n.desktop
@@ -0,0 +1,5 @@
+# localized strings
+[Desktop Entry]
+Comment=Cheers
+Comment[en_US@piglatin]=Eerschay
+Comment[sv]=Skål
diff --git a/test/data/xdg/malformed.desktop b/test/data/xdg/malformed.desktop
new file mode 100644
index 00000000000..144a3f719d5
--- /dev/null
+++ b/test/data/xdg/malformed.desktop
@@ -0,0 +1,4 @@
+# unacceptable key=value format
+[Desktop Entry]
+Key=value
+aowef faoweif of
diff --git a/test/data/xdg/mimeapps.list b/test/data/xdg/mimeapps.list
new file mode 100644
index 00000000000..27fbd94b16b
--- /dev/null
+++ b/test/data/xdg/mimeapps.list
@@ -0,0 +1,9 @@
+[Default Applications]
+x-test/foo=a.desktop
+
+[Added Associations]
+x-test/foo=b.desktop
+x-test/baz=a.desktop
+
+[Removed Associations]
+x-test/foo=c.desktop;d.desktop
diff --git a/test/data/xdg/mimeinfo.cache b/test/data/xdg/mimeinfo.cache
new file mode 100644
index 00000000000..6e54f604fa0
--- /dev/null
+++ b/test/data/xdg/mimeinfo.cache
@@ -0,0 +1,4 @@
+[MIME Cache]
+x-test/foo=c.desktop;d.desktop
+x-test/bar=a.desktop;c.desktop
+x-test/baz=b.desktop;d.desktop
diff --git a/test/data/xdg/test.desktop b/test/data/xdg/test.desktop
new file mode 100644
index 00000000000..b848cef5b0f
--- /dev/null
+++ b/test/data/xdg/test.desktop
@@ -0,0 +1,5 @@
+# this is a comment
+[Desktop Entry]
+Name=Test
+[Another Section]
+Exec=frobnicate
diff --git a/test/data/xdg/wrong.desktop b/test/data/xdg/wrong.desktop
new file mode 100644
index 00000000000..e0b4c221cf9
--- /dev/null
+++ b/test/data/xdg/wrong.desktop
@@ -0,0 +1,2 @@
+# the first section must be "Desktop Entry"
+[Why]
diff --git a/test/file-organization.org b/test/file-organization.org
index 4d76c0068e3..6c93c28c8e1 100644
--- a/test/file-organization.org
+++ b/test/file-organization.org
@@ -30,7 +30,7 @@ the directory structure of the source tree; so tests for files in the
Tests should normally reside in a file with ~-tests.el~ added to the
base-name of the tested source file; hence ~ert.el~ is tested in
-~ert-tests.el~, and ~pcase.el~ is tested in ~pcase-tests.el~. As n
+~ert-tests.el~, and ~pcase.el~ is tested in ~pcase-tests.el~. As an
exception, tests for a single feature may be placed into multiple
files of any name which are themselves placed in a directory named
after the feature with ~-tests~ appended, such as
diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el
new file mode 100644
index 00000000000..f455da718e1
--- /dev/null
+++ b/test/lib-src/emacsclient-tests.el
@@ -0,0 +1,59 @@
+;;; emacsclient-tests.el --- Test emacsclient
+
+;; Copyright (C) 2016-2017 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)
+
+(defconst emacsclient-test-emacs
+ (if installation-directory
+ (expand-file-name "lib-src/emacsclient" installation-directory)
+ "emacsclient")
+ "The emacsclient binary to test.")
+
+(defmacro emacsclient-test-call-emacsclient (editor)
+ "Run emacsclient with ALTERNATE_EDITOR set to EDITOR."
+ `(let* ((process-environment
+ (cons (concat "ALTERNATE_EDITOR=" ,editor) process-environment))
+ (stat (call-process emacsclient-test-emacs nil nil nil
+ "--server-file"
+ (expand-file-name "non-existent-file"
+ invocation-directory)
+ "foo")))
+ ;; Skip if emacsclient was compiled with -pg (bug#28319).
+ ;; Use ert--skip-unless rather than skip-unless to silence compiler.
+ (ert--skip-unless (not (and (stringp stat)
+ (string-match-p "Profiling" stat))))
+ (should (eq 0 stat))))
+
+(ert-deftest emacsclient-test-alternate-editor-allows-arguments ()
+ (emacsclient-test-call-emacsclient
+ (concat (expand-file-name invocation-name invocation-directory) " --batch")))
+
+(ert-deftest emacsclient-test-alternate-editor-allows-quotes ()
+ (emacsclient-test-call-emacsclient
+ (concat "\"" (expand-file-name invocation-name invocation-directory)
+ "\"" " --batch")))
+
+(provide 'emacsclient-tests)
+;;; emacsclient-tests.el ends here
diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el
index 1ffcd6ac0d0..1f1a7fb6bb6 100644
--- a/test/lisp/abbrev-tests.el
+++ b/test/lisp/abbrev-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
new file mode 100644
index 00000000000..63e5579b39b
--- /dev/null
+++ b/test/lisp/arc-mode-tests.el
@@ -0,0 +1,37 @@
+;;; arc-mode-tests.el --- Test suite for arc-mode. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 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 'arc-mode)
+
+
+(ert-deftest arc-mode-test-archive-int-to-mode ()
+ (let ((alist (list (cons 448 "-rwx------")
+ (cons 420 "-rw-r--r--")
+ (cons 292 "-r--r--r--")
+ (cons 512 "----------")
+ (cons 1024 "------S---") ; Bug#28092
+ (cons 2048 "---S------"))))
+ (dolist (x alist)
+ (should (equal (cdr x) (archive-int-to-mode (car x)))))))
+
+(provide 'arc-mode-tests)
+
+;; arc-mode-tests.el ends here
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index 689fed3f3f5..84423b7d06d 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -128,6 +128,11 @@ This function is intended to be set to `auth-source-debug`."
(should (equal (auth-source-pass--find-match "foo.bar.com" nil)
nil))))
+(ert-deftest auth-source-pass-find-match-matching-extracting-user-from-host ()
+ (auth-source-pass--with-store '(("foo.com/bar"))
+ (should (equal (auth-source-pass--find-match "https://bar@foo.com" nil)
+ "foo.com/bar"))))
+
(ert-deftest auth-source-pass-search-with-user-first ()
(auth-source-pass--with-store '(("foo") ("user@foo"))
(should (equal (auth-source-pass--find-match "foo" "user")
diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el
index 2634777c7db..07effa7fbc6 100644
--- a/test/lisp/auth-source-tests.el
+++ b/test/lisp/auth-source-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -27,6 +27,7 @@
;;; Code:
(require 'ert)
+(require 'cl-lib)
(require 'auth-source)
(defvar secrets-enabled t
@@ -215,7 +216,7 @@
(ert-deftest auth-source-test-remembrances-of-things-past ()
(let ((password-cache t)
- (password-data (make-vector 7 0)))
+ (password-data (copy-hash-table password-data)))
(auth-source-remember '(:host "wedd") '(4 5 6))
(should (auth-source-remembered-p '(:host "wedd")))
(should-not (auth-source-remembered-p '(:host "xedd")))
@@ -228,5 +229,65 @@
(should-not (auth-source-remembered-p '(:host "xedd")))
(should-not (auth-source-remembered-p '(:host t)))))
+(ert-deftest auth-source-test-searches ()
+ "Test auth-source searches with various parameters"
+ :tags '(auth-source auth-source/netrc)
+ (let* ((entries '("machine a1 port a2 user a3 password a4"
+ "machine b1 port b2 user b3 password b4"
+ "machine c1 port c2 user c3 password c4"))
+ ;; First element: test description.
+ ;; Second element: expected return data, serialized to a string.
+ ;; Rest of elements: the parameters for `auth-source-search'.
+ (tests '(("any host, max 1"
+ "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
+ :max 1 :host t)
+ ("any host, default max is 1"
+ "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
+ :host t)
+ ("any host, boolean return"
+ "t"
+ :host t :max 0)
+ ("no parameters, default max is 1"
+ "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))"
+ )
+ ("host c1, default max is 1"
+ "((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
+ :host "c1")
+ ("host list of (c1), default max is 1"
+ "((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
+ :host ("c1"))
+ ("any host, max 4"
+ "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\") (:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\") (:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))"
+ :host t :max 4)
+ ("host b1, default max is 1"
+ "((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
+ :host "b1")
+ ("host b1, port b2, user b3, default max is 1"
+ "((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))"
+ :host "b1" :port "b2" :user "b3")
+ ))
+
+ (netrc-file (make-temp-file "auth-source-test" nil nil
+ (mapconcat 'identity entries "\n")))
+ (auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ found found-as-string)
+
+ (dolist (test tests)
+ (cl-destructuring-bind (testname needed &rest parameters) test
+ (setq found (apply #'auth-source-search parameters))
+ (when (listp found)
+ (dolist (f found)
+ (setf f (plist-put f :secret
+ (let ((secret (plist-get f :secret)))
+ (if (functionp secret)
+ (funcall secret)
+ secret))))))
+
+ (setq found-as-string (format "%s: %S" testname found))
+ ;; (message "With parameters %S found: [%s] needed: [%s]" parameters found-as-string needed)
+ (should (equal found-as-string (concat testname ": " needed)))))
+ (delete-file netrc-file)))
+
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index c6f103321c6..55dbb341aa0 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el
index 21ffb2ebf36..82b34d35d64 100644
--- a/test/lisp/buff-menu-tests.el
+++ b/test/lisp/buff-menu-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -26,7 +26,7 @@
(require 'ert)
(ert-deftest buff-menu-24962 ()
- "Test for http://debbugs.gnu.org/24962 ."
+ "Test for https://debbugs.gnu.org/24962 ."
(let* ((file (make-temp-file "foo"))
(buf (find-file file)))
(unwind-protect
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index e4b43357a01..727ab049a52 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -87,7 +87,7 @@ An existing calc stack is reused, otherwise a new one is created."
'(* -100 (var cm var-cm)))))
(ert-deftest test-calc-23889 ()
- "Test for http://debbugs.gnu.org/23889 and 25652."
+ "Test for https://debbugs.gnu.org/23889 and 25652."
(skip-unless (>= math-bignum-digit-length 9))
(dolist (mode '(deg rad))
(let ((calc-angle-mode mode))
@@ -135,5 +135,5 @@ An existing calc stack is reused, otherwise a new one is created."
;;; calc-tests.el ends here
;; Local Variables:
-;; bug-reference-url-format: "http://debbugs.gnu.org/%s"
+;; bug-reference-url-format: "https://debbugs.gnu.org/%s"
;; End:
diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el
index 3e090029808..80a79db75cf 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el
index 26b4e9e44db..0ad0b36438f 100644
--- a/test/lisp/calendar/parse-time-tests.el
+++ b/test/lisp/calendar/parse-time-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/calendar/todo-mode-resources/todo-test-1.toda b/test/lisp/calendar/todo-mode-resources/todo-test-1.toda
index 8ca4e1908da..82262bddb68 100644
--- a/test/lisp/calendar/todo-mode-resources/todo-test-1.toda
+++ b/test/lisp/calendar/todo-mode-resources/todo-test-1.toda
@@ -1,4 +1,4 @@
-(("testcat1" . [0 0 1 0]) ("testcat2" . [0 0 1 0]) ("testcat3" . [0 0 1 0]))
+(("testcat1" . [0 0 1 0]) ("testcat2" . [0 0 1 0]) ("testcat33" . [0 0 1 0]))
--==-- testcat1
==--== DONE
@@ -7,7 +7,7 @@
==--== DONE
[DONE May 28, 2017] [May 28, 2017] testcat2 item1
---==-- testcat3
+--==-- testcat33
==--== DONE
-[DONE May 28, 2017] [May 28, 2017] testcat3 item1
+[DONE May 28, 2017] [May 28, 2017] testcat33 item1
diff --git a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo
index 8e845df6b69..598d487cad9 100644
--- a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo
+++ b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo
@@ -1,12 +1,20 @@
-(("testcat1" . [2 0 0 1]) ("testcat2" . [1 0 0 1]))
+(("testcat1" . [2 0 2 1]) ("testcat2" . [3 0 1 1]) ("testcat3" . [0 0 0 0]))
--==-- testcat1
[May 29, 2017] testcat1 item3
has more than one line
to test item highlighting
-[May 26, 2017] testcat1 item2
+[Jul 3, 2017] testcat1 item4
==--== DONE
+[DONE Jul 3, 2017] [Jun 30, 2017] testcat1 item5
+[DONE Jul 3, 2017] [May 30, 2017] testcat1 item2
--==-- testcat2
-[May 28, 2017] testcat2 item2
+[Jul 3, 2017] testcat2 item3
+[Jul 3, 2017] testcat2 item4
+[Jul 3, 2017] testcat2 item5
+
+==--== DONE
+[DONE Jul 3, 2017] [May 28, 2017] testcat2 item2
+--==-- testcat3
==--== DONE
diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el
index 08dfe541929..43187d4ab95 100644
--- a/test/lisp/calendar/todo-mode-tests.el
+++ b/test/lisp/calendar/todo-mode-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -44,7 +44,11 @@
(defmacro with-todo-test (&rest body)
"Set up an isolated todo-mode test environment."
+ (declare (debug (body)))
`(let* ((todo-test-home (make-temp-file "todo-test-home-" t))
+ ;; Since we change HOME, clear this to avoid a conflict
+ ;; e.g. if Emacs runs within the user's home directory.
+ (abbreviated-home-dir nil)
(process-environment (cons (format "HOME=%s" todo-test-home)
process-environment))
(todo-directory todo-test-data-dir)
@@ -52,27 +56,35 @@
(car (funcall todo-files-function)))))
(unwind-protect
(progn ,@body)
+ ;; Restore pre-test-run state of test files.
+ (dolist (f (directory-files todo-directory))
+ (let ((buf (get-file-buffer f)))
+ (when buf
+ (with-current-buffer buf
+ (restore-buffer-modified-p nil)
+ (kill-buffer)))))
(delete-directory todo-test-home t))))
-;; (defun todo-test-show (num &optional archive)
-;; "Display category NUM of test todo file.
-;; With non-nil ARCHIVE argument, display test archive file category."
-;; (let* ((file (if archive todo-test-archive-1 todo-test-file-1))
-;; (buf (find-file-noselect file)))
-;; (set-buffer buf)
-;; (if archive (todo-archive-mode) (todo-mode))
+(defun todo-test--show (num &optional archive)
+ "Display category NUM of test todo file.
+With non-nil ARCHIVE argument, display test archive file category."
+ (let* ((file (if archive todo-test-archive-1 todo-test-file-1))
+ (buf (find-file-noselect file)))
+ (set-buffer buf)
+ (if archive (todo-archive-mode) (todo-mode))
+ (setq todo-category-number num)
+ (todo-category-select)
+ (goto-char (point-min))))
+
+;; (defun todo-test-get-archive (num)
+;; "Display category NUM of todo archive test file."
+;; (let ((archive-buf (find-file-noselect todo-test-archive-1)))
+;; (set-buffer archive-buf)
+;; (todo-archive-mode)
;; (setq todo-category-number num)
;; (todo-category-select)))
-(defun todo-test-get-archive (num)
- "Display category NUM of todo archive test file."
- (let ((archive-buf (find-file-noselect todo-test-archive-1)))
- (set-buffer archive-buf)
- (todo-archive-mode)
- (setq todo-category-number num)
- (todo-category-select)))
-
-(defun todo-test-is-current-buffer (filename)
+(defun todo-test--is-current-buffer (filename)
"Return non-nil if FILENAME's buffer is current."
(let ((bufname (buffer-file-name (current-buffer))))
(and bufname (equal (file-truename bufname) filename))))
@@ -85,24 +97,24 @@ the current todo-mode category. Quitting todo-mode without an
intermediate buffer switch should not make the archive buffer
current again."
(with-todo-test
- (todo-test-get-archive 2)
+ (todo-test--show 2 'archive)
(let ((cat-name (todo-current-category)))
(todo-quit)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(should (equal (todo-current-category) cat-name))
- (todo-test-get-archive 1)
+ (todo-test--show 1 'archive)
(setq cat-name (todo-current-category))
(todo-quit)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(should (equal todo-category-number 1))
(todo-forward-category) ; Category 2 in todo file now current.
- (todo-test-get-archive 3) ; No corresponding category in todo file.
+ (todo-test--show 3 'archive) ; No corresponding category in todo file.
(setq cat-name (todo-current-category))
(todo-quit)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(should (equal todo-category-number 2))
(todo-quit)
- (should-not (todo-test-is-current-buffer todo-test-archive-1)))))
+ (should-not (todo-test--is-current-buffer todo-test-archive-1)))))
(ert-deftest todo-test-todo-quit02 () ; bug#27121
"Test the behavior of todo-quit with todo and non-todo buffers.
@@ -111,20 +123,19 @@ buffer is buried by quit-window, the todo-mode buffer should not
become current."
(with-todo-test
(todo-show)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(let ((dir (dired default-directory)))
(todo-show)
(todo-quit)
(should (equal (current-buffer) dir))
(quit-window)
- (should-not (todo-test-is-current-buffer todo-test-file-1)))))
+ (should-not (todo-test--is-current-buffer todo-test-file-1)))))
(ert-deftest todo-test-item-highlighting () ; bug#27133
"Test whether `todo-toggle-item-highlighting' highlights whole item.
In particular, all lines of a multiline item should be highlighted."
(with-todo-test
- (todo-show)
- (todo-jump-to-category nil "testcat1") ; For test rerun.
+ (todo-test--show 1)
(todo-toggle-item-highlighting)
(let ((end (1- (todo-item-end)))
(beg (todo-item-start)))
@@ -134,5 +145,442 @@ In particular, all lines of a multiline item should be highlighted."
(should (eq (next-single-char-property-change beg 'face) (1+ end))))
(todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun).
+(ert-deftest todo-test-revert-buffer01 () ; bug#27609
+ "Test whether todo-mode buffer remains read-only after reverting."
+ (with-todo-test
+ (todo-show)
+ (let ((opoint (point)))
+ (should (equal buffer-read-only t))
+ (todo-revert-buffer nil t)
+ (should (equal buffer-read-only t))
+ (should (eq (point) opoint)))))
+
+(ert-deftest todo-test-revert-buffer02 () ; bug#27609
+ "Test whether todo-archive-mode buffer remains read-only after reverting."
+ (with-todo-test
+ (todo-test--show 1 'archive)
+ (let ((opoint (point)))
+ (should (equal buffer-read-only t))
+ (todo-revert-buffer nil t)
+ (should (equal buffer-read-only t))
+ (should (eq (point) opoint)))))
+
+(ert-deftest todo-test-raise-lower-priority ()
+ "Test the behavior of todo-{raise,lower}-item-priority."
+ (with-todo-test
+ ;; (todo-show)
+ (todo-test--show 1)
+ (goto-char (point-min))
+ (let ((p1 (point))
+ (s1 (todo-item-string))
+ p2 s2 p3 p4)
+ ;; First item in category.
+ (should (equal p1 (todo-item-start)))
+ (todo-next-item)
+ (setq p2 (point))
+ ;; Second item in category.
+ (setq s2 (todo-item-string))
+ ;; Second item is lower.
+ (should (> p2 p1))
+ ;; Case 1: lowering priority.
+ (todo-previous-item)
+ (todo-lower-item-priority)
+ ;; Now what was the first item is the second and vice versa.
+ (setq p1 (point))
+ (should (equal s1 (todo-item-string)))
+ (todo-previous-item)
+ (setq p2 (point))
+ (should (equal s2 (todo-item-string)))
+ (should (> p1 p2))
+ ;; Case 2: raising priority.
+ (todo-next-item)
+ (todo-raise-item-priority)
+ ;; Now what had become the second item is again the first and
+ ;; vice versa.
+ (setq p1 (point))
+ (should (equal s1 (todo-item-string)))
+ (todo-next-item)
+ (setq p2 (point))
+ (should (equal s2 (todo-item-string)))
+ (should (> p2 p1))
+ ;; Case 3: empty line (bug#27609).
+ (goto-char (point-max))
+ ;; The last line in the category is always empty.
+ (should-not (todo-item-string))
+ (todo-raise-item-priority)
+ ;; Raising item priority on the empty string is a noop.
+ (should (equal (point) (point-max)))
+ (todo-lower-item-priority)
+ ;; Lowering item priority on the empty string is a noop.
+ (should (equal (point) (point-max)))
+ ;; Case 4: done item (bug#27609).
+ ;; todo-toggle-view-done-items recenters the window if point is
+ ;; not visible, so we have to make sure the todo-mode buffer is
+ ;; in a live window in the test run to avoid failing with (error
+ ;; "`recenter'ing a window that does not display ;; current-buffer.").
+ ;; (But this is not necessary in todo-test-toggle-item-header01
+ ;; below -- why not, or why is it here? Note that without
+ ;; setting window buffer, the test only fails on the first run --
+ ;; on rerunning it passes.)
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (todo-next-item)
+ ;; Now the current item is the first done item.
+ (should (todo-done-item-p))
+ (setq p3 (point))
+ (todo-raise-item-priority)
+ ;; Raising item priority on a done item is a noop.
+ (should (eq (point) p3))
+ (todo-lower-item-priority)
+ ;; Lowering item priority on a done item is a noop.
+ (should (eq (point) p3))
+ ;; Case 5: raising first item and lowering last item.
+ (goto-char (point-min)) ; Now on first item.
+ ;; Changing item priority moves point to todo-item-start, so move
+ ;; it away from there for the test.
+ (end-of-line)
+ (setq p4 (point))
+ (todo-raise-item-priority)
+ ;; Raising priority of first item is a noop.
+ (should (equal (point) p4))
+ (goto-char (point-max))
+ (todo-previous-item) ; Now on last item.
+ (end-of-line)
+ (setq p4 (point))
+ (todo-lower-item-priority)
+ (should (equal (point) p4)))))
+
+(ert-deftest todo-test-todo-mark-unmark-category () ; bug#27609
+ "Test behavior of todo-mark-category and todo-unmark-category."
+ (with-todo-test
+ (todo-show)
+ (let ((cat (todo-current-category)))
+ (todo-mark-category)
+ (should (equal (todo-get-count 'todo cat)
+ (cdr (assoc cat todo-categories-with-marks))))
+ (todo-unmark-category)
+ (should-not (assoc cat todo-categories-with-marks)))))
+
+(defun todo-test--move-item (cat &optional priority file)
+ "Move item(s) to category CAT with priority PRIORITY (for todo item).
+This provides a noninteractive API for todo-move-item for use in
+automatic testing."
+ (let ((cat0 (car (nth (1- cat) todo-categories)))
+ (file0 (or file todo-current-todo-file)))
+ (cl-letf (((symbol-function 'todo-read-category)
+ (lambda (_prompt &optional _match-type _file) (cons cat0 file0)))
+ ((symbol-function 'read-number) ; For todo-set-item-priority
+ (lambda (_prompt &optional _default) (or priority 1))))
+ (todo-move-item))))
+
+(ert-deftest todo-test-move-item01 ()
+ "Test moving a todo item to another category with a given priority."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (item (todo-item-string)))
+ (todo-test--move-item 2 3)
+ (should (equal (todo-current-category) cat2))
+ (should (equal (todo-item-string) item))
+ (should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string)
+ "3 "))
+ (todo-backward-category) ; Go to first category again.
+ (should-error (search-forward item))
+ (should (= (todo-get-count 'todo cat1) (1- cat1-todo)))
+ (should (= (todo-get-count 'todo cat2) (1+ cat2-todo))))))
+
+(ert-deftest todo-test-move-item02 () ; bug#27609
+ "Test moving a marked todo item to previous category."
+ (with-todo-test
+ (todo-test--show 2)
+ (let* ((cat2 (todo-current-category))
+ (cat1 (car (nth 0 todo-categories)))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (item (todo-item-string)))
+ ;; If todo-toggle-mark-item is not called interactively, its
+ ;; optional prefix argument evaluates to nil and this raises a
+ ;; wrong-type-argument error.
+ (call-interactively 'todo-toggle-mark-item)
+ (todo-test--move-item 1)
+ (should (equal (todo-current-category) cat1))
+ (should (equal (todo-item-string) item))
+ (should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string)
+ "1 "))
+ (todo-forward-category) ; Go to second category again.
+ (should-error (search-forward item))
+ (should (= (todo-get-count 'todo cat1) (1+ cat1-todo)))
+ (should (= (todo-get-count 'todo cat2) (1- cat2-todo))))))
+
+(ert-deftest todo-test-move-item03 () ; bug#27609
+ "Test moving a done item to another category.
+In the new category it should be the first done item."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-done (todo-get-count 'done cat1))
+ (cat2-done (todo-get-count 'done cat2)))
+ (goto-char (point-max))
+ (set-window-buffer nil (current-buffer)) ; Why is this necessary?
+ (todo-toggle-view-done-items)
+ (todo-next-item)
+ (let ((item (todo-item-string)))
+ (todo-test--move-item 2)
+ (should (equal (todo-current-category) cat2))
+ (should (equal (todo-item-string) item))
+ (should (todo-done-item-p))
+ (forward-line -1)
+ (should (looking-at todo-category-done))
+ (todo-backward-category)
+ (should-error (search-forward item))
+ (should (= (todo-get-count 'done cat1) (1- cat1-done)))
+ (should (= (todo-get-count 'done cat2) (1+ cat2-done)))))))
+
+(ert-deftest todo-test-move-item04 () ; bug#27609
+ "Test moving both a todo and a done item to another category.
+In the new category the todo item should have the provided
+priority and the done item should be the first done item."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (cat1-done (todo-get-count 'done cat1))
+ (cat2-done (todo-get-count 'done cat2))
+ (todo-item (todo-item-string)))
+ (call-interactively 'todo-toggle-mark-item)
+ (goto-char (point-max))
+ ;; Why is this necessary here but not below?
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (todo-next-item)
+ (let ((done-item (todo-item-string)))
+ (call-interactively 'todo-toggle-mark-item)
+ (todo-test--move-item 2 3)
+ (should (equal (todo-current-category) cat2))
+ ;; Point should be on the moved todo item.
+ (should (equal (todo-item-string) todo-item))
+ ;; Done items section should be visible and the move done item
+ ;; should be at the top of it.
+ (should (search-forward done-item))
+ (should (todo-done-item-p))
+ (forward-line -1)
+ (should (looking-at todo-category-done))
+ ;; Make sure marked items are no longer in first category.
+ (todo-backward-category)
+ (should-error (search-forward todo-item))
+ (todo-toggle-view-done-items)
+ (should-error (search-forward done-item))
+ (should (= (todo-get-count 'todo cat1) (1- cat1-todo)))
+ (should (= (todo-get-count 'todo cat2) (1+ cat2-todo)))
+ (should (= (todo-get-count 'done cat1) (1- cat1-done)))
+ (should (= (todo-get-count 'done cat2) (1+ cat2-done)))))))
+
+(ert-deftest todo-test-move-item05 () ; bug#27609
+ "Test moving multiple todo and done items to another category.
+Both types of item should be moved en bloc to the new category,
+and the top todo item should have the provided priority and
+the top done item should be the first done item."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (cat1-done (todo-get-count 'done cat1))
+ (cat2-done (todo-get-count 'done cat2))
+ (todo-items (buffer-string))
+ (done-items (prog2 (todo-toggle-view-done-only)
+ (buffer-string)
+ (todo-toggle-view-done-only))))
+ ;; Why is this necessary here but not below?
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (todo-mark-category)
+ (todo-test--move-item 2 3)
+ (should (equal (todo-current-category) cat2))
+ ;; Point should be at the start of the first moved todo item.
+ (should (looking-at (regexp-quote todo-items)))
+ ;; Done items section should be visible and the move done item
+ ;; should be at the top of it.
+ (should (search-forward done-items))
+ (goto-char (match-beginning 0))
+ (should (todo-done-item-p))
+ (forward-line -1)
+ (should (looking-at todo-category-done))
+ ;; Make sure marked items are no longer in first category.
+ (todo-backward-category)
+ (should (eq (point-min) (point-max))) ; All todo items were moved.
+ ;; This passes when run interactively but fails in a batch run:
+ ;; the message is displayed but (current-message) evaluates to
+ ;; nil.
+ ;; (todo-toggle-view-done-items) ; All done items were moved.
+ ;; (let ((msg (current-message)))
+ ;; (should (equal msg "There are no done items in this category.")))
+ (todo-toggle-view-done-only)
+ (should (eq (point-min) (point-max))) ; All done items were moved.
+ (should (= (todo-get-count 'todo cat1) 0))
+ (should (= (todo-get-count 'todo cat2) (+ cat1-todo cat2-todo)))
+ (should (= (todo-get-count 'done cat1) 0))
+ (should (= (todo-get-count 'done cat2) (+ cat1-done cat2-done))))))
+
+(ert-deftest todo-test-toggle-item-header01 () ; bug#27609
+ "Test toggling item header from an empty category."
+ (with-todo-test
+ (todo-test--show 3)
+ (should (eq (point-min) (point-max))) ; Category is empty.
+ (todo-toggle-item-header)
+ (todo-backward-category)
+ ;; Header is hidden.
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-forward-category)
+ (todo-toggle-item-header)
+ (todo-backward-category)
+ ;; Header is shown.
+ (should-not (todo-get-overlay 'header))))
+
+;; FIXME: This test doesn't show the effect of the display overlay on
+;; calling todo-next-item in todo-mode: When using Todo mode, the
+;; display engine moves point out of the overlay, but here point does
+;; not get moved, even when display-graphic-p.
+(ert-deftest todo-test-toggle-item-header02 () ; bug#27609
+ "Test navigating between items with hidden header."
+ ;; This makes no difference for testing todo-next-item.
+ ;; (skip-unless (display-graphic-p))
+ (with-todo-test
+ (todo-test--show 2)
+ (let* ((start0 (point))
+ (find-start (lambda ()
+ (re-search-forward
+ (concat todo-date-string-start
+ todo-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "?")
+ (line-end-position) t)
+ (forward-char)
+ (point)))
+ (start1 (save-excursion (funcall find-start)))
+ (start2 (save-excursion (todo-next-item) (funcall find-start))))
+ (should (looking-at todo-item-start))
+ (todo-toggle-item-header)
+ ;; Point hasn't changed...
+ (should (eq (point) start0))
+ (should (looking-at todo-item-start))
+ (todo-next-item)
+ ;; FIXME: This should (and when using todo-mode does) put point
+ ;; at the start of the item's test, not at todo-item-start, like
+ ;; todo-previous-item below. But the following tests fail; why?
+ ;; (N.B.: todo-backward-item, called by todo-previous-item,
+ ;; explicitly moves point forward to where it needs to be because
+ ;; otherwise the display engine moves it backward.)
+ ;; (should (eq (point) start2))
+ ;; (should-not (looking-at todo-item-start))
+ ;; And these pass, though they shouldn't:
+ (should-not (eq (point) start2))
+ (should (looking-at todo-item-start))
+ (todo-previous-item)
+ ;; ...but now it has.
+ (should (eq (point) start1))
+ (should-not (looking-at todo-item-start))
+ ;; This fails just like the above.
+ ;; (todo-next-item)
+ ;; (should (eq (point) start2))
+ ;; (should-not (looking-at todo-item-start))
+ ;; This is the status quo but is it desirable?
+ (todo-toggle-item-header)
+ (should (eq (point) start1))
+ (should-not (looking-at todo-item-start)))))
+
+(ert-deftest todo-test-toggle-item-header03 () ; bug#27609
+ "Test display of hidden item header when changing item's priority."
+ (with-todo-test
+ (todo-test--show 2)
+ (todo-toggle-item-header)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-lower-item-priority)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-raise-item-priority)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ ;; Set priority noninteractively.
+ (cl-letf (((symbol-function 'read-number)
+ (lambda (_prompt &optional _default) 3)))
+ (todo-item-undone))
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))
+
+(ert-deftest todo-test-toggle-item-header04 () ; bug#27609
+ "Test display of hidden item header under todo-item-(un)done."
+ (with-todo-test
+ (todo-test--show 1)
+ (let ((item (todo-item-string)))
+ (todo-toggle-item-header)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-item-done)
+ ;; Without set-window-buffer here this test passes when run
+ ;; interactively but fails in a batch run.
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (should (search-forward item))
+ (todo-item-start)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ ;; Set priority for todo-item-undone noninteractively.
+ (cl-letf (((symbol-function 'read-number)
+ (lambda (_prompt &optional _default) 1)))
+ (todo-item-undone))
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
+
+(ert-deftest todo-test-toggle-item-header05 () ; bug#27609
+ "Test display of hidden item header under todo-move-item."
+ (with-todo-test
+ (todo-test--show 1)
+ (todo-toggle-item-header)
+ (todo-test--move-item 2 3)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))
+
+(ert-deftest todo-test-toggle-item-header06 () ; bug#27609
+ "Test display of hidden item header under (un)archiving.
+The relocated item's header should take on the display status of
+headers in the goal file, even when the display status in the
+source file is different."
+ (with-todo-test
+ (todo-test--show 1)
+ (todo-toggle-item-header)
+ (todo-toggle-view-done-only) ; Go to first (i.e. top) done item.
+ (let ((item (todo-item-string)))
+ (todo-archive-done-item)
+ (todo-toggle-view-done-only) ; To display all items on unarchiving.
+ (todo-find-archive)
+ (should (equal (todo-item-string) item)) ; The just archived item.
+ ;; The archive file headers are displayed by default.
+ (should-not (todo-get-overlay 'header))
+ (todo-unarchive-items)
+ ;; Headers in the todo file are still hidden.
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
+
+(defun todo-test--insert-item (item &optional priority)
+ "Insert string ITEM into current category with priority PRIORITY.
+Use defaults for all other item insertion parameters. This
+provides a noninteractive API for todo-insert-item for use in
+automatic testing."
+ (cl-letf (((symbol-function 'read-from-minibuffer)
+ (lambda (_prompt) item))
+ ((symbol-function 'read-number) ; For todo-set-item-priority
+ (lambda (_prompt &optional _default) (or priority 1))))
+ (todo-insert-item--basic)))
+
+(ert-deftest todo-test-toggle-item-header07 () ; bug#27609
+ "Test display of hidden item header under todo-insert-item."
+ (with-todo-test
+ (todo-test--show 1)
+ (todo-toggle-item-header)
+ (let ((item "Test display of hidden item header under todo-insert-item."))
+ (todo-test--insert-item item 1)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
+
+
(provide 'todo-mode-tests)
;;; todo-mode-tests.el ends here
diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el
index 00bc3c83d05..8be22973913 100644
--- a/test/lisp/char-fold-tests.el
+++ b/test/lisp/char-fold-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -102,7 +102,7 @@
(char-fold--test-match-exactly "a1" "xx44" "99")
(char-fold--test-match-exactly "a12" "77" "xx442" "992")
;; Support for this case is disabled. See function definition or:
- ;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg02562.html
+ ;; https://lists.gnu.org/r/emacs-devel/2015-11/msg02562.html
;; (char-fold--test-match-exactly "a12" "xxyy")
))
@@ -117,16 +117,14 @@
(char-fold-to-regexp string)))
(with-temp-buffer
(save-excursion (insert string))
- (let ((time (time-to-seconds (current-time))))
+ (let ((time (time-to-seconds)))
;; Our initial implementation of case-folding in char-folding
;; created a lot of redundant paths in the regexp. Because of
;; that, if a really long string "almost" matches, the regexp
;; engine took a long time to realize that it doesn't match.
(should-not (char-fold-search-forward (concat string "c") nil 'noerror))
;; Ensure it took less than a second.
- (should (< (- (time-to-seconds (current-time))
- time)
- 1))))))
+ (should (< (- (time-to-seconds) time) 1))))))
(provide 'char-fold-tests)
;;; char-fold-tests.el ends here
diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el
new file mode 100644
index 00000000000..bc942c3b598
--- /dev/null
+++ b/test/lisp/color-tests.el
@@ -0,0 +1,251 @@
+;;; color-tests.el --- Tests for color.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (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 'cl-lib)
+(require 'color)
+(require 'ert)
+(require 'seq)
+
+(defun color-tests--approx-equal (color1 color2)
+ "Return t if COLOR1 and COLOR2 are approximately equal."
+ (seq-every-p
+ (lambda (x) (< (abs x) 0.00001))
+ (cl-mapcar #'- color1 color2)))
+
+(ert-deftest color-tests-name-to-rgb ()
+ (should (equal (color-name-to-rgb "black") '(0.0 0.0 0.0)))
+ (should (equal (color-name-to-rgb "white") '(1.0 1.0 1.0)))
+ (should (equal (color-name-to-rgb "red") '(1.0 0.0 0.0)))
+ (should (equal (color-name-to-rgb "green") '(0.0 1.0 0.0)))
+ (should (equal (color-name-to-rgb "blue") '(0.0 0.0 1.0)))
+ (should (equal (color-name-to-rgb "#000000000000") '(0.0 0.0 0.0)))
+ (should (equal (color-name-to-rgb "#ffffffffffff") '(1.0 1.0 1.0)))
+ (should (equal (color-name-to-rgb "#ffff00000000") '(1.0 0.0 0.0)))
+ (should (equal (color-name-to-rgb "#0000ffff0000") '(0.0 1.0 0.0)))
+ (should (equal (color-name-to-rgb "#00000000ffff") '(0.0 0.0 1.0))))
+
+(ert-deftest color-tests-rgb-to-hex ()
+ (should (equal (color-rgb-to-hex 0 0 0) "#000000000000"))
+ (should (equal (color-rgb-to-hex 0 0 0 2) "#000000"))
+ (should (equal (color-rgb-to-hex 1 0 0) "#ffff00000000"))
+ (should (equal (color-rgb-to-hex 1 0 0 2) "#ff0000"))
+ (should (equal (color-rgb-to-hex 0.1 0.2 0.3) "#199933334ccc"))
+ (should (equal (color-rgb-to-hex 0.1 0.2 0.3 2) "#19334c")))
+
+(ert-deftest color-tests-complement ()
+ (should (equal (color-complement "white") '(0.0 0.0 0.0)))
+ (should (equal (color-complement "#ffffffffffff") '(0.0 0.0 0.0)))
+ (should (equal (color-complement "red") '(0.0 1.0 1.0))))
+
+(ert-deftest color-tests-gradient ()
+ (should-not (color-gradient '(0 0 0) '(255 255 255) 0))
+ (should
+ (equal (color-gradient '(0 0 0) '(255 255 255) 1)
+ '((127.5 127.5 127.5))))
+ (should
+ (equal (color-gradient '(0 0 0) '(255 255 255) 2)
+ '((85.0 85.0 85.0) (170.0 170.0 170.0))))
+ (should
+ (equal
+ (color-gradient '(255 192 203) '(250 128 114) 3)
+ '((253.75 176.0 180.75) (252.5 160.0 158.5) (251.25 144.0 136.25)))))
+
+(ert-deftest color-tests-hsl-to-rgb ()
+ (should (equal (color-hsl-to-rgb 0 0 0) '(0 0 0)))
+ (should (equal (color-hsl-to-rgb 360 0.5 0.5) '(0.75 0.25 0.25)))
+ (should (equal (color-hsl-to-rgb 123 0.2 0.9) '(0.92 0.88 0.88))))
+
+(ert-deftest color-tests-complement-hex ()
+ (should
+ (equal (color-complement-hex "#000000000000") "#ffffffffffff"))
+ (should
+ (equal (color-complement-hex "#ffff00000000") "#0000ffffffff")))
+
+(ert-deftest color-tests-rgb-to-hsv ()
+ (should (equal (color-rgb-to-hsv 0 0 0) '(0.0 0.0 0.0)))
+ (should (equal (color-rgb-to-hsv 1 1 1) '(0.0 0.0 1.0)))
+ (should (equal (color-rgb-to-hsv 1 0 0) '(0.0 1.0 1.0)))
+ (should (equal (color-rgb-to-hsv 0.5 0.3 0.3) '(0.0 0.4 0.5))))
+
+(ert-deftest color-tests-rgb-to-hsl ()
+ (should (equal (color-rgb-to-hsl 0 0 0) '(0.0 0.0 0.0)))
+ (should (equal (color-rgb-to-hsl 1 1 1) '(0.0 0.0 1.0)))
+ (should (equal (color-rgb-to-hsl 1 0 0) '(0.0 1 0.5)))
+ (should (equal (color-rgb-to-hsl 0.5 0.3 0.3) '(0.0 0.25 0.4))))
+
+(ert-deftest color-tests-srgb-to-xyz ()
+ (should (equal (color-srgb-to-xyz 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (equal (color-srgb-to-xyz 0 0 1) '(0.1804375 0.072175 0.9503041)))
+ (should
+ (color-tests--approx-equal
+ (color-srgb-to-xyz 0.1 0.2 0.3) '(0.0291865 0.031092 0.073738))))
+
+(ert-deftest color-tests-xyz-to-srgb ()
+ (should (equal (color-xyz-to-srgb 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal
+ (color-xyz-to-srgb 0.1804375 0.072175 0.9503041) '(0 0 1)))
+ (should
+ (color-tests--approx-equal
+ (color-xyz-to-srgb 0.0291865 0.031092 0.073738) '(0.1 0.2 0.3))))
+
+(ert-deftest color-tests-xyz-to-lab ()
+ (should (equal (color-xyz-to-lab 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal
+ (color-xyz-to-lab 0.1804375 0.072175 0.9503041)
+ '(32.2970109 79.1890315 -107.8646674)))
+ (should
+ (color-tests--approx-equal
+ (color-xyz-to-lab 0.1804375 0.072175 0.9503041 '(1 1 1))
+ '(32.2970109 74.3625763 -113.3597823)))
+ (should
+ (color-tests--approx-equal
+ (color-xyz-to-lab 0.0291865 0.031092 0.073738)
+ '(20.4760281 -0.6500752 -18.6340169))))
+
+(ert-deftest color-tests-lab-to-xyz ()
+ (should (equal (color-lab-to-xyz 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal
+ (color-lab-to-xyz 32.2970109 79.1890315 -107.8646674)
+ '(0.1804375 0.072175 0.9503041)))
+ (should
+ (color-tests--approx-equal
+ (color-lab-to-xyz 32.2970109 74.3625763 -113.3597823 '(1 1 1))
+ '(0.1804375 0.072175 0.9503041)))
+ (should
+ (color-tests--approx-equal
+ (color-lab-to-xyz 20.4760281 -0.6500752 -18.6340169)
+ '(0.0291865 0.031092 0.073738))))
+
+(ert-deftest color-tests-srgb-to-lab ()
+ (should (equal (color-srgb-to-lab 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal
+ (color-srgb-to-lab 0 1 0) '(87.7347223 -86.1808176 83.1770651)))
+ (should
+ (color-tests--approx-equal
+ (color-srgb-to-lab 0.1 0.2 0.3)
+ '(20.4762218 -0.6508996 -18.6340085))))
+
+(ert-deftest color-tests-lab-to-srgb ()
+ (should (equal (color-lab-to-srgb 0 0 0) '(0.0 0.0 0.0)))
+ (should
+ (color-tests--approx-equal
+ (color-lab-to-srgb 87.7347223 -86.1808176 83.1770651) '(0 1 0)))
+ (should
+ (color-tests--approx-equal
+ (color-lab-to-srgb 20.4762218 -0.6508996 -18.6340085)
+ '(0.1 0.2 0.3))))
+
+(ert-deftest color-tests-cie-de2000 ()
+ (should (= (color-cie-de2000 '(0 0 0) '(0 0 0)) 0.0))
+ (should
+ (color-tests--approx-equal
+ (list
+ (color-cie-de2000
+ (color-srgb-to-lab 1 0 0) (color-srgb-to-lab 0 0 1)))
+ '(52.8803934)))
+ (should
+ (color-tests--approx-equal
+ (list
+ (color-cie-de2000
+ (color-srgb-to-lab 0.8 0 0) (color-srgb-to-lab 0.9 0 0)))
+ '(5.3844503))))
+
+(ert-deftest color-tests-clamp ()
+ (should (= (color-clamp 0) 0.0))
+ (should (= (color-clamp -1) 0.0))
+ (should (= (color-clamp 0.5) 0.5))
+ (should (= (color-clamp 1) 1.0))
+ (should (= (color-clamp 1.1) 1.0)))
+
+(ert-deftest color-tests-saturate-hsl ()
+ (should (equal (color-saturate-hsl 360 0.5 0.5 0) '(360 0.5 0.5)))
+ (should (equal (color-saturate-hsl 360 0.5 0.5 -10) '(360 0.4 0.5)))
+ (should
+ (equal (color-saturate-hsl 360 0.5 0.5 -500) '(360 0.0 0.5)))
+ (should (equal (color-saturate-hsl 120 0.5 0.8 5) '(120 0.55 0.8)))
+ (should
+ (equal (color-saturate-hsl 120 0.5 0.8 500) '(120 1.0 0.8))))
+
+(ert-deftest color-tests-saturate-name ()
+ (should (equal (color-saturate-name "black" 100) "#000000000000"))
+ (should (equal (color-saturate-name "white" 100) "#ffffffffffff"))
+ (should (equal (color-saturate-name "red" 0) "#ffff00000000"))
+ (should (equal (color-saturate-name "red" 50) "#ffff00000000")))
+
+(ert-deftest color-tests-desaturate-hsl ()
+ (should (equal (color-desaturate-hsl 360 0.5 0.5 0) '(360 0.5 0.5)))
+ (should
+ (equal (color-desaturate-hsl 360 0.5 0.5 -10) '(360 0.6 0.5)))
+ (should
+ (equal (color-desaturate-hsl 360 0.5 0.5 -500) '(360 1.0 0.5)))
+ (should
+ (equal (color-desaturate-hsl 120 0.5 0.8 5) '(120 0.45 0.8)))
+ (should
+ (equal (color-desaturate-hsl 120 0.5 0.8 500) '(120 0.0 0.8))))
+
+(ert-deftest color-tests-desaturate-name ()
+ (should (equal (color-desaturate-name "black" 100) "#000000000000"))
+ (should (equal (color-desaturate-name "white" 100) "#ffffffffffff"))
+ (should (equal (color-desaturate-name "red" 0) "#ffff00000000")))
+
+(ert-deftest color-tests-lighten-hsl ()
+ (should (equal (color-lighten-hsl 360 0.5 0.5 0) '(360 0.5 0.5)))
+ (should (equal (color-lighten-hsl 360 0.5 0.5 -10) '(360 0.5 0.4)))
+ (should (equal (color-lighten-hsl 360 0.5 0.5 -500) '(360 0.5 0.0)))
+ (should
+ (color-tests--approx-equal
+ (color-lighten-hsl 120 0.5 0.8 5) '(120 0.5 0.85)))
+ (should
+ (equal (color-lighten-hsl 120 0.5 0.8 500) '(120 0.5 1.0))))
+
+(ert-deftest color-tests-lighten-name ()
+ (should (equal (color-lighten-name "black" 100) "#ffffffffffff"))
+ (should (equal (color-lighten-name "white" 100) "#ffffffffffff"))
+ (should (equal (color-lighten-name "red" 0) "#ffff00000000"))
+ (should (equal (color-lighten-name "red" 10) "#ffff33323332")))
+
+(ert-deftest color-tests-darken-hsl ()
+ (should (equal (color-darken-hsl 360 0.5 0.5 0) '(360 0.5 0.5)))
+ (should (equal (color-darken-hsl 360 0.5 0.5 -10) '(360 0.5 0.6)))
+ (should (equal (color-darken-hsl 360 0.5 0.5 -500) '(360 0.5 1.0)))
+ (should (equal (color-darken-hsl 120 0.5 0.8 5) '(120 0.5 0.75)))
+ (should (equal (color-darken-hsl 120 0.5 0.8 500) '(120 0.5 0.0))))
+
+(ert-deftest color-tests-darken-name ()
+ (should (equal (color-darken-name "black" 100) "#000000000000"))
+ (should (equal (color-darken-name "white" 100) "#000000000000"))
+ (should (equal (color-darken-name "red" 0) "#ffff00000000"))
+ (should (equal (color-darken-name "red" 10) "#cccc00000000")))
+
+(provide 'color-tests)
+;;; color-tests.el ends here
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 3205c9e4cd3..06a39ebc393 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el
index 5baa31558e7..ca1d00ab352 100644
--- a/test/lisp/dabbrev-tests.el
+++ b/test/lisp/dabbrev-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/descr-text-tests.el b/test/lisp/descr-text-tests.el
index df0f8453161..538464aad7d 100644
--- a/test/lisp/descr-text-tests.el
+++ b/test/lisp/descr-text-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
new file mode 100644
index 00000000000..c385b40bb2c
--- /dev/null
+++ b/test/lisp/dired-aux-tests.el
@@ -0,0 +1,98 @@
+;;; dired-aux-tests.el --- Test suite for dired-aux. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 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 'dired-aux)
+(eval-when-compile (require 'cl-lib))
+
+(ert-deftest dired-test-bug27496 ()
+ "Test for https://debbugs.gnu.org/27496 ."
+ (skip-unless (executable-find shell-file-name))
+ (let* ((foo (make-temp-file "foo"))
+ (files (list foo)))
+ (unwind-protect
+ (cl-letf (((symbol-function 'y-or-n-p) 'error))
+ (dired temporary-file-directory)
+ (dired-goto-file foo)
+ ;; `dired-do-shell-command' returns nil on success.
+ (should-error (dired-do-shell-command "ls ? ./?" nil files))
+ (should-error (dired-do-shell-command "ls ./? ?" nil files))
+ (should-not (dired-do-shell-command "ls ? ?" nil files))
+ (should-error (dired-do-shell-command "ls * ./*" nil files))
+ (should-not (dired-do-shell-command "ls * *" nil files))
+ (should-not (dired-do-shell-command "ls ? ./`?`" nil files)))
+ (delete-file foo))))
+
+;; Auxiliar macro for `dired-test-bug28834': it binds
+;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY.
+;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to
+;; to avoid the prompt.
+(defmacro with-dired-bug28834-test (create-dirs yes-or-no &rest body)
+ (declare (debug (form symbolp body)))
+ (let ((foo (make-symbol "foo")))
+ `(let* ((,foo (make-temp-file "foo" 'dir))
+ (dired-create-destination-dirs ,create-dirs))
+ (setq from (make-temp-file "from"))
+ (setq to-cp
+ (expand-file-name
+ "foo-cp" (file-name-as-directory (expand-file-name "bar" ,foo))))
+ (setq to-mv
+ (expand-file-name
+ "foo-mv" (file-name-as-directory (expand-file-name "qux" ,foo))))
+ (unwind-protect
+ (if ,yes-or-no
+ (cl-letf (((symbol-function 'yes-or-no-p)
+ (lambda (prompt) (eq ,yes-or-no 'yes))))
+ ,@body)
+ ,@body)
+ ;; clean up
+ (delete-directory ,foo 'recursive)
+ (delete-file from)))))
+
+(ert-deftest dired-test-bug28834 ()
+ "test for https://debbugs.gnu.org/28834 ."
+ (let (from to-cp to-mv)
+ ;; `dired-create-destination-dirs' set to 'always.
+ (with-dired-bug28834-test
+ 'always nil
+ (dired-copy-file-recursive from to-cp nil)
+ (should (file-exists-p to-cp))
+ (dired-rename-file from to-mv nil)
+ (should (file-exists-p to-mv)))
+ ;; `dired-create-destination-dirs' set to nil.
+ (with-dired-bug28834-test
+ nil nil
+ (should-error (dired-copy-file-recursive from to-cp nil))
+ (should-error (dired-rename-file from to-mv nil)))
+ ;; `dired-create-destination-dirs' set to 'ask.
+ (with-dired-bug28834-test
+ 'ask 'yes ; Answer `yes'
+ (dired-copy-file-recursive from to-cp nil)
+ (should (file-exists-p to-cp))
+ (dired-rename-file from to-mv nil)
+ (should (file-exists-p to-mv)))
+ (with-dired-bug28834-test
+ 'ask 'no ; Answer `no'
+ (should-error (dired-copy-file-recursive from to-cp nil))
+ (should-error (dired-rename-file from to-mv nil)))))
+
+
+(provide 'dired-aux-tests)
+;; dired-aux-tests.el ends here
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 1b814baac58..99006eca3e3 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -15,14 +15,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'dired)
(require 'nadvice)
-
(ert-deftest dired-autoload ()
"Tests to see whether dired-x has been autoloaded"
(should
@@ -33,56 +32,416 @@
'dired-jump))))
(ert-deftest dired-test-bug22694 ()
- "Test for http://debbugs.gnu.org/22694 ."
+ "Test for https://debbugs.gnu.org/22694 ."
(let* ((dir (expand-file-name "bug22694" default-directory))
(file "test")
(full-name (expand-file-name file dir))
(regexp "bar")
- (dired-always-read-filesystem t))
+ (dired-always-read-filesystem t) buffers)
(if (file-exists-p dir)
(delete-directory dir 'recursive))
(make-directory dir)
(with-temp-file full-name (insert "foo"))
- (find-file-noselect full-name)
- (dired dir)
+ (push (find-file-noselect full-name) buffers)
+ (push (dired dir) buffers)
(with-temp-file full-name (insert "bar"))
(dired-mark-files-containing-regexp regexp)
(unwind-protect
(should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark)
`(t ,full-name)))
;; Clean up
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory dir 'recursive))))
+(defvar dired-dwim-target)
(ert-deftest dired-test-bug25609 ()
- "Test for http://debbugs.gnu.org/25609 ."
+ "Test for https://debbugs.gnu.org/25609 ."
(let* ((from (make-temp-file "foo" 'dir))
+ ;; Make sure we have long file-names in 'from' and 'to', not
+ ;; their 8+3 short aliases, because the latter will confuse
+ ;; Dired commands invoked below.
+ (from (if (memq system-type '(ms-dos windows-nt))
+ (file-truename from)
+ from))
(to (make-temp-file "bar" 'dir))
+ (to (if (memq system-type '(ms-dos windows-nt))
+ (file-truename to)
+ to))
(target (expand-file-name (file-name-nondirectory from) to))
(nested (expand-file-name (file-name-nondirectory from) target))
(dired-dwim-target t)
- (dired-recursive-copies 'always)) ; Don't prompt me.
+ (dired-recursive-copies 'always) ; Don't prompt me.
+ buffers)
(advice-add 'dired-query ; Don't ask confirmation to overwrite a file.
:override
(lambda (_sym _prompt &rest _args) (setq dired-query t))
'((name . "advice-dired-query")))
- (advice-add 'completing-read ; Just return init.
+ (advice-add 'completing-read ; Don't prompt me: just return init.
:override
(lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap)
init)
'((name . "advice-completing-read")))
- (dired to)
- (dired-other-window temporary-file-directory)
- (dired-goto-file from)
- (dired-do-copy)
- (dired-do-copy); Again.
+ (delete-other-windows) ; We don't want to display any other dired buffers.
+ (push (dired to) buffers)
+ (push (dired-other-window temporary-file-directory) buffers)
(unwind-protect
- (progn
- (should (file-exists-p target))
- (should-not (file-exists-p nested)))
+ (let ((ok-fn
+ (lambda ()
+ (let ((win-buffers (mapcar #'window-buffer (window-list))))
+ (and (memq (car buffers) win-buffers)
+ (memq (cadr buffers) win-buffers))))))
+ (dired-goto-file from)
+ ;; Right before `dired-do-copy' call, to reproduce the bug conditions,
+ ;; ensure we have windows displaying the two dired buffers.
+ (and (funcall ok-fn) (dired-do-copy))
+ ;; Call `dired-do-copy' again: this must overwrite `target'; if the bug
+ ;; still exists, then it creates `nested' instead.
+ (when (funcall ok-fn)
+ (dired-do-copy)
+ (should (file-exists-p target))
+ (should-not (file-exists-p nested))))
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))
(delete-directory from 'recursive)
(delete-directory to 'recursive)
(advice-remove 'dired-query "advice-dired-query")
(advice-remove 'completing-read "advice-completing-read"))))
+;; (ert-deftest dired-test-bug27243 ()
+;; "Test for https://debbugs.gnu.org/27243 ."
+;; (let ((test-dir (make-temp-file "test-dir-" t))
+;; (dired-auto-revert-buffer t) buffers)
+;; (with-current-buffer (find-file-noselect test-dir)
+;; (make-directory "test-subdir"))
+;; (push (dired test-dir) buffers)
+;; (unwind-protect
+;; (let ((buf (current-buffer))
+;; (pt1 (point))
+;; (test-file (concat (file-name-as-directory "test-subdir")
+;; "test-file")))
+;; (write-region "Test" nil test-file nil 'silent nil 'excl)
+;; ;; Sanity check: point should now be on the subdirectory.
+;; (should (equal (dired-file-name-at-point)
+;; (concat (file-name-as-directory test-dir)
+;; (file-name-as-directory "test-subdir"))))
+;; (push (dired-find-file) buffers)
+;; (let ((pt2 (point))) ; Point is on test-file.
+;; (switch-to-buffer buf)
+;; ;; Sanity check: point should now be back on the subdirectory.
+;; (should (eq (point) pt1))
+;; ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5
+;; (push (dired-find-file) buffers)
+;; (should (eq (point) pt2))
+;; ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28
+;; (push (dired test-dir) buffers)
+;; (should (eq (point) pt1))))
+;; (dolist (buf buffers)
+;; (when (buffer-live-p buf) (kill-buffer buf)))
+;; (delete-directory test-dir t))))
+
+(ert-deftest dired-test-bug27243-01 ()
+ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ."
+ (let* ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t)))
+ (save-pos (lambda ()
+ (with-current-buffer (car (dired-buffers-for-dir test-dir))
+ (dired-save-positions))))
+ (dired-auto-revert-buffer t) buffers)
+ ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
+ ;; corresponding long file names exist, otherwise such names trip
+ ;; dired-buffers-for-dir.
+ (if (eq system-type 'windows-nt)
+ (setq test-dir (file-truename test-dir)))
+ (should-not (dired-buffers-for-dir test-dir))
+ (with-current-buffer (find-file-noselect test-dir)
+ (make-directory "test-subdir"))
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Point must be at end-of-buffer.
+ (with-current-buffer (car (dired-buffers-for-dir test-dir))
+ (should (eobp)))
+ (push (dired test-dir) buffers)
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Previous dired call shouldn't create a new buffer: must visit the one
+ ;; created by `find-file-noselect' above.
+ (should (eq 1 (length (dired-buffers-for-dir test-dir))))
+ (unwind-protect
+ (let ((buf (current-buffer))
+ (pt1 (point))
+ (test-file (concat (file-name-as-directory "test-subdir")
+ "test-file")))
+ (message "Saved pos: %S" (funcall save-pos))
+ (write-region "Test" nil test-file nil 'silent nil 'excl)
+ (message "Saved pos: %S" (funcall save-pos))
+ ;; Sanity check: point should now be on the subdirectory.
+ (should (equal (dired-file-name-at-point)
+ (concat test-dir (file-name-as-directory "test-subdir"))))
+ (message "Saved pos: %S" (funcall save-pos))
+ (push (dired-find-file) buffers)
+ (let ((pt2 (point))) ; Point is on test-file.
+ (pop-to-buffer-same-window buf)
+ ;; Sanity check: point should now be back on the subdirectory.
+ (should (eq (point) pt1))
+ (push (dired-find-file) buffers)
+ (should (eq (point) pt2))))
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))
+ (delete-directory test-dir t))))
+
+(ert-deftest dired-test-bug27243-02 ()
+ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ."
+ (let ((test-dir (make-temp-file "test-dir-" t))
+ (dired-auto-revert-buffer t) buffers)
+ ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the
+ ;; corresponding long file names exist, otherwise such names trip
+ ;; string comparisons below.
+ (if (eq system-type 'windows-nt)
+ (setq test-dir (file-truename test-dir)))
+ (with-current-buffer (find-file-noselect test-dir)
+ (make-directory "test-subdir"))
+ (push (dired test-dir) buffers)
+ (unwind-protect
+ (let ((buf (current-buffer))
+ (pt1 (point))
+ (test-file (concat (file-name-as-directory "test-subdir")
+ "test-file")))
+ (write-region "Test" nil test-file nil 'silent nil 'excl)
+ ;; Sanity check: point should now be on the subdirectory.
+ (should (equal (dired-file-name-at-point)
+ (concat (file-name-as-directory test-dir)
+ (file-name-as-directory "test-subdir"))))
+ (push (dired-find-file) buffers)
+ (let ((pt2 (point))) ; Point is on test-file.
+ (switch-to-buffer buf)
+ ;; Sanity check: point should now be back on the subdirectory.
+ (should (eq (point) pt1))
+ (push (dired test-dir) buffers)
+ (should (eq (point) pt1))))
+ (dolist (buf buffers)
+ (when (buffer-live-p buf) (kill-buffer buf)))
+ (delete-directory test-dir t))))
+
+(ert-deftest dired-test-bug27243-03 ()
+ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ."
+ (let ((test-dir (make-temp-file "test-dir-" t))
+ (dired-auto-revert-buffer t)
+ test-subdir1 test-subdir2 allbufs)
+ (unwind-protect
+ (progn
+ (with-current-buffer (find-file-noselect test-dir)
+ (push (current-buffer) allbufs)
+ (make-directory "test-subdir1")
+ (make-directory "test-subdir2")
+ (let ((test-file1 "test-file1")
+ (test-file2 "test-file2"))
+ (with-current-buffer (find-file-noselect "test-subdir1")
+ (push (current-buffer) allbufs)
+ (write-region "Test1" nil test-file1 nil 'silent nil 'excl))
+ (with-current-buffer (find-file-noselect "test-subdir2")
+ (push (current-buffer) allbufs)
+ (write-region "Test2" nil test-file2 nil 'silent nil 'excl))))
+ ;; Call find-file with a wild card and test point in each file.
+ (let ((buffers (find-file (concat (file-name-as-directory test-dir)
+ "*")
+ t)))
+ (dolist (buf buffers)
+ (let ((pt (with-current-buffer buf (point))))
+ (switch-to-buffer (find-file-noselect test-dir))
+ (find-file (buffer-name buf))
+ (should (equal (point) pt))))
+ (append buffers allbufs)))
+ (dolist (buf allbufs)
+ (when (buffer-live-p buf) (kill-buffer buf)))
+ (delete-directory test-dir t))))
+
+(ert-deftest dired-test-bug7131 ()
+ "Test for https://debbugs.gnu.org/7131 ."
+ (let* ((dir (expand-file-name "lisp" source-directory))
+ (buf (dired dir)))
+ (unwind-protect
+ (progn
+ (setq buf (dired (list dir "simple.el")))
+ (dired-toggle-marks)
+ (should-not (cdr (dired-get-marked-files)))
+ (kill-buffer buf)
+ (setq buf (dired (list dir "simple.el"))
+ buf (dired dir))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest dired-test-bug27631 ()
+ "Test for https://debbugs.gnu.org/27631 ."
+ ;; For dired using 'ls' emulation we test for this bug in
+ ;; ls-lisp-tests.el and em-ls-tests.el.
+ (skip-unless (and (not (featurep 'ls-lisp))
+ (not (featurep 'eshell))))
+ (let* ((dir (make-temp-file "bug27631" 'dir))
+ (dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ buf)
+ (unwind-protect
+ (progn
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (delete-directory dir 'recursive)
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest dired-test-bug27899 ()
+ "Test for https://debbugs.gnu.org/27899 ."
+ (let* ((dir (expand-file-name "src" source-directory))
+ (buf (dired (list dir "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c")))
+ (orig dired-hide-details-mode))
+ (dired-goto-file (expand-file-name "cygw32.c"))
+ (forward-line 0)
+ (unwind-protect
+ (progn
+ (let ((inhibit-read-only t))
+ (dired-align-file (point) (point-max)))
+ (dired-hide-details-mode t)
+ (dired-move-to-filename)
+ (should (eq 2 (current-column))))
+ (dired-hide-details-mode orig))))
+
+(ert-deftest dired-test-bug27968 ()
+ "Test for https://debbugs.gnu.org/27968 ."
+ (let* ((top-dir (make-temp-file "top-dir" t))
+ (subdir (expand-file-name "subdir" top-dir))
+ (header-len-fn (lambda ()
+ (save-excursion
+ (goto-char 1)
+ (forward-line 1)
+ (- (point-at-eol) (point)))))
+ orig-len len diff pos line-nb)
+ (make-directory subdir 'parents)
+ (unwind-protect
+ (with-current-buffer (dired-noselect subdir)
+ (setq orig-len (funcall header-len-fn)
+ pos (point)
+ line-nb (line-number-at-pos))
+ ;; Bug arises when the header line changes its length; this may
+ ;; happen if the used space has changed: for instance, with the
+ ;; creation of additional files.
+ (make-directory "subdir" t)
+ (dired-revert)
+ ;; Change the header line.
+ (save-excursion
+ (goto-char 1)
+ (forward-line 1)
+ (let ((inhibit-read-only t)
+ (new-header " test-bug27968"))
+ (delete-region (point) (point-at-eol))
+ (when (= orig-len (length new-header))
+ ;; Wow lucky guy! I must buy lottery today.
+ (setq new-header (concat new-header " :-)")))
+ (insert new-header)))
+ (setq len (funcall header-len-fn)
+ diff (- len orig-len))
+ (should-not (zerop diff)) ; Header length has changed.
+ ;; If diff > 0, then the point moves back.
+ ;; If diff < 0, then the point moves forward.
+ ;; If diff = 0, then the point doesn't move.
+ ;; Sometimes this point movement causes
+ ;; line-nb != (line-number-at-pos pos), so that we get
+ ;; an unexpected file at point if we store buffer points.
+ ;; Note that the line number before/after revert
+ ;; doesn't change.
+ (should (= line-nb
+ (line-number-at-pos)
+ (line-number-at-pos (+ pos diff))))
+ ;; After revert, the point must be in 'subdir' line.
+ (should (equal "subdir" (dired-get-filename 'local t))))
+ (delete-directory top-dir t))))
+
+
+(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body)
+ "Helper macro for Bug#27940 test."
+ (declare (indent 1) (debug body))
+ (let ((dir (make-symbol "dir"))
+ (ignore-funcs (make-symbol "ignore-funcs")))
+ `(let* ((,dir (make-temp-file "bug27940" t))
+ (dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts.
+ (inhibit-message t)
+ (default-directory ,dir))
+ (dotimes (i 5) (make-directory (format "empty-dir-%d" i)))
+ (unless ,just-empty-dirs
+ (dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents)))
+ (make-directory "zeta-empty-dir")
+ (unwind-protect
+ (progn
+ ,@body)
+ (delete-directory ,dir t)
+ (kill-buffer (current-buffer))))))
+
+(ert-deftest dired-test-bug27940 ()
+ "Test for https://debbugs.gnu.org/27940 ."
+ ;; If just empty dirs we shouldn't be prompted.
+ (dired-test-with-temp-dirs
+ 'just-empty-dirs
+ (let (asked)
+ (advice-add 'dired--yes-no-all-quit-help
+ :override
+ (lambda (_) (setq asked t) "")
+ '((name . dired-test-bug27940-advice)))
+ (dired default-directory)
+ (dired-toggle-marks)
+ (dired-do-delete nil)
+ (unwind-protect
+ (progn
+ (should-not asked)
+ (should-not (dired-get-marked-files))) ; All dirs deleted.
+ (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))))
+ ;; Answer yes
+ (dired-test-with-temp-dirs
+ nil
+ (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes")
+ '((name . dired-test-bug27940-advice)))
+ (dired default-directory)
+ (dired-toggle-marks)
+ (dired-do-delete nil)
+ (unwind-protect
+ (should-not (dired-get-marked-files)) ; All dirs deleted.
+ (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+ ;; Answer no
+ (dired-test-with-temp-dirs
+ nil
+ (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no")
+ '((name . dired-test-bug27940-advice)))
+ (dired default-directory)
+ (dired-toggle-marks)
+ (dired-do-delete nil)
+ (unwind-protect
+ (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted.
+ (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+ ;; Answer all
+ (dired-test-with-temp-dirs
+ nil
+ (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all")
+ '((name . dired-test-bug27940-advice)))
+ (dired default-directory)
+ (dired-toggle-marks)
+ (dired-do-delete nil)
+ (unwind-protect
+ (should-not (dired-get-marked-files)) ; All dirs deleted.
+ (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+ ;; Answer quit
+ (dired-test-with-temp-dirs
+ nil
+ (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit")
+ '((name . dired-test-bug27940-advice)))
+ (dired default-directory)
+ (dired-toggle-marks)
+ (let ((inhibit-message t))
+ (dired-do-delete nil))
+ (unwind-protect
+ (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted.
+ (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))))
+
+
(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 e8352a4ecaf..a64cff1e272 100644
--- a/test/lisp/dired-x-tests.el
+++ b/test/lisp/dired-x-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
@@ -23,7 +23,7 @@
(ert-deftest dired-test-bug25942 ()
- "Test for http://debbugs.gnu.org/25942 ."
+ "Test for https://debbugs.gnu.org/25942 ."
(let* ((dirs (list "Public" "Music"))
(files (list ".bashrc" "bar.c" "foo.c" "c" ".c"))
(all-but-c
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index 32d231a47e5..f44fe3bdab6 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -26,7 +26,10 @@
(require 'dom)
(require 'ert)
-(eval-when-compile (require 'subr-x))
+
+;; `defsubst's are not inlined inside `ert-deftest' (see Bug#24402),
+;; therefore we can't use `eval-when-compile' here.
+(require 'subr-x)
(defun dom-tests--tree ()
"Return a DOM tree for testing."
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 78a37650619..7df2449b9eb 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -593,5 +593,173 @@ baz\"\""
:bindings '((electric-quote-string . t))
:test-in-comments nil :test-in-strings nil)
+(define-electric-pair-test electric-quote-opening-single
+ "" "`" :expected-string "‘" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-closing-single
+ "" "'" :expected-string "’" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-opening-double
+ "‘" "-`" :expected-string "“" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-closing-double
+ "’" "-'" :expected-string "”" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-replace-double-disabled
+ "" "\"" :expected-string "\"" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-backtick
+ "" "`" :expected-string "`" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bob-single
+ "" "'" :expected-string "‘" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bob-double
+ "‘" "-'" :expected-string "“" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-replace-double-bob
+ "" "\"" :expected-string "“" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-replace-double . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bol-single
+ "a\n" "--'" :expected-string "a\n‘" :expected-point 4
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-bol-double
+ "a\n‘" "---'" :expected-string "a\n“" :expected-point 4
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-replace-double-bol
+ "a\n" "--\"" :expected-string "a\n“" :expected-point 4
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-replace-double . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-space-single
+ " " "-'" :expected-string " ‘" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-space-double
+ " ‘" "--'" :expected-string " “" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-replace-double-after-space
+ " " "-\"" :expected-string " “" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-replace-double . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-letter-single
+ "a" "-'" :expected-string "a’" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-letter-double
+ "a’" "--'" :expected-string "a”" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-replace-double-after-letter
+ "a" "-\"" :expected-string "a”" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-replace-double . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-paren-single
+ "(" "-'" :expected-string "(‘" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-context-sensitive-after-paren-double
+ "(‘" "--'" :expected-string "(“" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-context-sensitive . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-replace-double-after-paren
+ "(" "-\"" :expected-string "(“" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn #'electric-quote-local-mode
+ :bindings '((electric-quote-replace-double . t))
+ :test-in-comments nil :test-in-strings nil)
+
+;; Simulate ‘markdown-mode’: it sets both ‘comment-start’ and
+;; ‘comment-use-syntax’, but derives from ‘text-mode’.
+(define-electric-pair-test electric-quote-markdown-in-text
+ "" "'" :expected-string "’" :expected-point 2
+ :modes '(text-mode)
+ :fixture-fn (lambda ()
+ (electric-quote-local-mode)
+ (add-hook 'electric-quote-inhibit-functions
+ (lambda ()
+ (save-excursion (search-backward "`" nil t)))
+ nil :local))
+ :bindings '((comment-start . "<!--") (comment-use-syntax . t))
+ :test-in-comments nil :test-in-strings nil)
+
+(define-electric-pair-test electric-quote-markdown-in-code
+ "`a`" "-'" :expected-string "`'a`" :expected-point 3
+ :modes '(text-mode)
+ :fixture-fn (lambda ()
+ (electric-quote-local-mode)
+ (add-hook 'electric-quote-inhibit-functions
+ (lambda ()
+ (save-excursion (search-backward "`" nil t)))
+ nil :local))
+ :bindings '((comment-start . "<!--") (comment-use-syntax . t))
+ :test-in-comments nil :test-in-strings nil)
+
(provide 'electric-tests)
;;; electric-tests.el ends here
diff --git a/test/lisp/emacs-lisp/benchmark-tests.el b/test/lisp/emacs-lisp/benchmark-tests.el
index 14426aeec41..e1b67f1ed17 100644
--- a/test/lisp/emacs-lisp/benchmark-tests.el
+++ b/test/lisp/emacs-lisp/benchmark-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index d15bd8b6e65..f508c365427 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -21,7 +21,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -512,7 +512,9 @@ bytecompiled code, and their results compared.")
`(let ((,file-name-var (make-temp-file "emacs")))
(unwind-protect
(progn ,@body)
- (delete-file ,file-name-var))))
+ (delete-file ,file-name-var)
+ (let ((elc (concat ,file-name-var ".elc")))
+ (if (file-exists-p elc) (delete-file elc))))))
(ert-deftest bytecomp-tests--unescaped-char-literals ()
"Check that byte compiling warns about unescaped character
@@ -545,6 +547,34 @@ literals (Bug#20852)."
This functionality has been obsolete for more than 10 years already
and will be removed soon. See (elisp)Backquote in the manual.")))))))
+
+(ert-deftest bytecomp-tests-function-put ()
+ "Check `function-put' operates during compilation."
+ (should (boundp 'lread--old-style-backquotes))
+ (bytecomp-tests--with-temp-file source
+ (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1)
+ (function-put 'bytecomp-tests--foo 'bar 2)
+ (defmacro bytecomp-tests--foobar ()
+ `(cons ,(function-get 'bytecomp-tests--foo 'foo)
+ ,(function-get 'bytecomp-tests--foo 'bar)))
+ (defvar bytecomp-tests--foobar 1)
+ (setq bytecomp-tests--foobar (bytecomp-tests--foobar))))
+ (print form (current-buffer)))
+ (write-region (point-min) (point-max) source nil 'silent)
+ (byte-compile-file source t)
+ (should (equal bytecomp-tests--foobar (cons 1 2)))))
+
+(ert-deftest bytecomp-tests--test-no-warnings-with-advice ()
+ (defun f ())
+ (define-advice f (:around (oldfun &rest args) test)
+ (apply oldfun args))
+ (with-current-buffer (get-buffer-create "*Compile-Log*")
+ (let ((inhibit-read-only t)) (erase-buffer)))
+ (test-byte-comp-compile-and-load t '(defun f ()))
+ (with-current-buffer (get-buffer-create "*Compile-Log*")
+ (goto-char (point-min))
+ (should-not (search-forward "Warning" nil t))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el
index 69985506f78..d832a862280 100644
--- a/test/lisp/emacs-lisp/checkdoc-tests.el
+++ b/test/lisp/emacs-lisp/checkdoc-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index 5b2371e7b95..c37caa1aab7 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Code:
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el
index 0768e31f7e6..9b2b04bcca4 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -219,5 +219,29 @@
(should (equal (cl--generic-1 '(5) nil) '("cinq" (5))))
(should (equal (cl--generic-1 '(6) nil) '("six" a))))
+(cl-defgeneric cl-generic-tests--generic (x))
+(cl-defmethod cl-generic-tests--generic ((x string))
+ (message "%s is a string" x))
+(cl-defmethod cl-generic-tests--generic ((x integer))
+ (message "%s is a number" x))
+(cl-defgeneric cl-generic-tests--generic-without-methods (x y))
+(defvar cl-generic-tests--this-file
+ (file-truename (or load-file-name buffer-file-name)))
+
+(ert-deftest cl-generic-tests--method-files--finds-methods ()
+ "`method-files' returns a list of files and methods for a generic function."
+ (let ((retval (cl--generic-method-files 'cl-generic-tests--generic)))
+ (should (equal (length retval) 2))
+ (mapc (lambda (x)
+ (should (equal (car x) cl-generic-tests--this-file))
+ (should (equal (cadr x) 'cl-generic-tests--generic)))
+ retval)
+ (should-not (equal (nth 0 retval) (nth 1 retval)))))
+
+(ert-deftest cl-generic-tests--method-files--nonexistent-methods ()
+ "`method-files' returns nil if asked to find a method which doesn't exist."
+ (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic))
+ (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods)))
+
(provide 'cl-generic-tests)
;;; cl-generic-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index 65bd97f3b2d..692dd0f72cf 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -1,4 +1,4 @@
-;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*-
+;;; cl-lib-tests.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -195,15 +195,16 @@
(should (eql (cl-mismatch "Aa" "aA") 0))
(should (eql (cl-mismatch '(a b c) '(a b d)) 2)))
-(ert-deftest cl-lib-test-loop ()
- (should (eql (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
-
(ert-deftest cl-lib-keyword-names-versus-values ()
(should (equal
(funcall (cl-function (lambda (&key a b) (list a b)))
:b :a :a 42)
'(42 :a))))
+(ert-deftest cl-lib-empty-keyargs ()
+ (should-error (funcall (cl-function (lambda (&key) 1))
+ :b 1)))
+
(cl-defstruct (mystruct
(:constructor cl-lib--con-1 (&aux (abc 1)))
(:constructor cl-lib--con-2 (&optional def) "Constructor docstring."))
@@ -480,9 +481,6 @@
(should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2)))
(should (= -123 (cl-parse-integer " -123 "))))
-(ert-deftest cl-loop-destructuring-with ()
- (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
-
(ert-deftest cl-flet-test ()
(should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5)))
@@ -518,7 +516,25 @@
(ert-deftest cl-lib-symbol-macrolet-2 ()
(should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
+
+(ert-deftest cl-lib-symbol-macrolet-hide ()
+ ;; bug#26325
+ (should (equal (let ((y 5))
+ (cl-symbol-macrolet ((x y))
+ (list x
+ (let ((x 6)) (list x y))
+ (cl-letf ((x 6)) (list x y)))))
+ '(5 (6 5) (6 6)))))
+
+(defun cl-lib-tests--dummy-function ()
+ ;; Dummy function to see if the file is compiled.
+ t)
+
(ert-deftest cl-lib-defstruct-record ()
+ ;; This test fails when compiled, see Bug#24402/27718.
+ :expected-result (if (byte-code-function-p
+ (symbol-function 'cl-lib-tests--dummy-function))
+ :failed :passed)
(cl-defstruct foo x)
(let ((x (make-foo :x 42)))
(should (recordp x))
@@ -548,4 +564,4 @@
(should cl-old-struct-compat-mode)
(cl-old-struct-compat-mode (if saved 1 -1))))
-;;; cl-lib.el ends here
+;;; cl-lib-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
new file mode 100644
index 00000000000..575f170af6c
--- /dev/null
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -0,0 +1,500 @@
+;;; cl-macs-tests.el --- tests for emacs-lisp/cl-macs.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; 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:
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'cl-macs)
+(require 'ert)
+
+
+;;;; cl-loop tests -- many adapted from Steele's CLtL2
+
+;;; ANSI 6.1.1.7 Destructuring
+(ert-deftest cl-macs-loop-and-assignment ()
+ ;; Bug#6583
+ :expected-result :failed
+ (should (equal (cl-loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+ for a = (cl-first numlist)
+ and b = (cl-second numlist)
+ and c = (cl-third numlist)
+ collect (list c b a))
+ '((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
+
+(ert-deftest cl-macs-loop-destructure ()
+ (should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
+ collect (list c b a))
+ '((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
+
+(ert-deftest cl-macs-loop-destructure-nil ()
+ (should (equal (cl-loop for (a nil b) = '(1 2 3)
+ do (cl-return (list a b)))
+ '(1 3))))
+
+(ert-deftest cl-macs-loop-destructure-cons ()
+ (should (equal (cl-loop for ((a . b) (c . d)) in
+ '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6)))
+ collect (list a b c d))
+ '((1.2 2.4 3 4) (3.4 4.6 5 6)))))
+
+(ert-deftest cl-loop-destructuring-with ()
+ (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6)))
+
+;;; 6.1.2.1.1 The for-as-arithmetic subclause
+(ert-deftest cl-macs-loop-for-as-arith ()
+ "Test various for-as-arithmetic subclauses."
+ :expected-result :failed
+ (should (equal (cl-loop for i to 10 by 3 collect i)
+ '(0 3 6 9)))
+ (should (equal (cl-loop for i upto 3 collect i)
+ '(0 1 2 3)))
+ (should (equal (cl-loop for i below 3 collect i)
+ '(0 1 2)))
+ (should (equal (cl-loop for i below 10 by 2 collect i)
+ '(0 2 4 6 8)))
+ (should (equal (cl-loop for i downfrom 10 above 4 by 2 collect i)
+ '(10 8 6)))
+ (should (equal (cl-loop for i from 10 downto 1 by 3 collect i)
+ '(10 7 4 1)))
+ (should (equal (cl-loop for i above 0 by 2 downfrom 10 collect i)
+ '(10 8 6 4 2)))
+ (should (equal (cl-loop for i downto 10 from 15 collect i)
+ '(15 14 13 12 11 10))))
+
+(ert-deftest cl-macs-loop-for-as-arith-order-side-effects ()
+ "Test side effects generated by different arithmetic phrase order."
+ :expected-result :failed
+ (should
+ (equal (let ((x 1)) (cl-loop for i from x to 10 by (cl-incf x) collect i))
+ '(1 3 5 7 9)))
+ (should
+ (equal (let ((x 1)) (cl-loop for i from x by (cl-incf x) to 10 collect i))
+ '(1 3 5 7 9)))
+ (should
+ (equal (let ((x 1)) (cl-loop for i to 10 from x by (cl-incf x) collect i))
+ '(1 3 5 7 9)))
+ (should
+ (equal (let ((x 1)) (cl-loop for i to 10 by (cl-incf x) from x collect i))
+ '(2 4 6 8 10)))
+ (should
+ (equal (let ((x 1)) (cl-loop for i by (cl-incf x) from x to 10 collect i))
+ '(2 4 6 8 10)))
+ (should
+ (equal (let ((x 1)) (cl-loop for i by (cl-incf x) to 10 from x collect i))
+ '(2 4 6 8 10))))
+
+(ert-deftest cl-macs-loop-for-as-arith-invalid ()
+ "Test for invalid phrase combinations."
+ :expected-result :failed
+ ;; Mixing arithmetic-up and arithmetic-down* subclauses
+ (should-error (cl-loop for i downfrom 10 below 20 collect i))
+ (should-error (cl-loop for i upfrom 20 above 10 collect i))
+ (should-error (cl-loop for i upto 10 by 2 downfrom 5))
+ ;; Repeated phrases
+ (should-error (cl-loop for i from 10 to 20 above 10))
+ (should-error (cl-loop for i from 10 to 20 upfrom 0))
+ (should-error (cl-loop for i by 2 to 10 by 5))
+ ;; negative step
+ (should-error (cl-loop for i by -1))
+ ;; no step given for a downward loop
+ (should-error (cl-loop for i downto -5 collect i)))
+
+
+;;; 6.1.2.1.2 The for-as-in-list subclause
+(ert-deftest cl-macs-loop-for-as-in-list ()
+ (should (equal (cl-loop for x in '(1 2 3 4 5 6) collect (* x x))
+ '(1 4 9 16 25 36)))
+ (should (equal (cl-loop for x in '(1 2 3 4 5 6) by #'cddr collect (* x x))
+ '(1 9 25))))
+
+;;; 6.1.2.1.3 The for-as-on-list subclause
+(ert-deftest cl-macs-loop-for-as-on-list ()
+ (should (equal (cl-loop for x on '(1 2 3 4) collect x)
+ '((1 2 3 4) (2 3 4) (3 4) (4))))
+ (should (equal (cl-loop as (item) on '(1 2 3 4) by #'cddr collect item)
+ '(1 3))))
+
+;;; 6.1.2.1.4 The for-as-equals-then subclause
+(ert-deftest cl-macs-loop-for-as-equals-then ()
+ (should (equal (cl-loop for item = 1 then (+ item 10)
+ repeat 5
+ collect item)
+ '(1 11 21 31 41)))
+ (should (equal (cl-loop for x below 5 for y = nil then x collect (list x y))
+ '((0 nil) (1 1) (2 2) (3 3) (4 4))))
+ (should (equal (cl-loop for x below 5 and y = nil then x collect (list x y))
+ '((0 nil) (1 0) (2 1) (3 2) (4 3))))
+ (should (equal (cl-loop for x below 3 for y = (+ 10 x) nconc (list x y))
+ '(0 10 1 11 2 12)))
+ (should (equal (cl-loop with start = 5
+ for x = start then (cl-incf start)
+ repeat 5
+ collect x)
+ '(5 6 7 8 9))))
+
+;;; 6.1.2.1.5 The for-as-across subclause
+(ert-deftest cl-macs-loop-for-as-across ()
+ (should (string= (cl-loop for x across "aeiou"
+ concat (char-to-string x))
+ "aeiou"))
+ (should (equal (cl-loop for v across (vector 1 2 3) vconcat (vector v (+ 10 v)))
+ [1 11 2 12 3 13])))
+
+;;; 6.1.2.1.6 The for-as-hash subclause
+(ert-deftest cl-macs-loop-for-as-hash ()
+ ;; example in Emacs manual 4.7.3
+ (should (equal (let ((hash (make-hash-table)))
+ (setf (gethash 1 hash) 10)
+ (setf (gethash "test" hash) "string")
+ (setf (gethash 'test hash) 'value)
+ (cl-loop for k being the hash-keys of hash
+ using (hash-values v)
+ collect (list k v)))
+ '((1 10) ("test" "string") (test value)))))
+
+;;; 6.1.2.2 Local Variable Initializations
+(ert-deftest cl-macs-loop-with ()
+ (should (equal (cl-loop with a = 1
+ with b = (+ a 2)
+ with c = (+ b 3)
+ return (list a b c))
+ '(1 3 6)))
+ (should (equal (let ((a 5)
+ (b 10))
+ (cl-loop with a = 1
+ and b = (+ a 2)
+ and c = (+ b 3)
+ return (list a b c)))
+ '(1 7 13)))
+ (should (and (equal (cl-loop for i below 3 with loop-with
+ do (push (* i i) loop-with)
+ finally (cl-return loop-with))
+ '(4 1 0))
+ (not (boundp 'loop-with)))))
+
+;;; 6.1.3 Value Accumulation Clauses
+(ert-deftest cl-macs-loop-accum ()
+ (should (equal (cl-loop for name in '(fred sue alice joe june)
+ for kids in '((bob ken) () () (kris sunshine) ())
+ collect name
+ append kids)
+ '(fred bob ken sue alice joe kris sunshine june))))
+
+(ert-deftest cl-macs-loop-collect ()
+ (should (equal (cl-loop for i in '(bird 3 4 turtle (1 . 4) horse cat)
+ when (symbolp i) collect i)
+ '(bird turtle horse cat)))
+ (should (equal (cl-loop for i from 1 to 10
+ if (cl-oddp i) collect i)
+ '(1 3 5 7 9)))
+ (should (equal (cl-loop for i in '(a b c d e f g) by #'cddr
+ collect i into my-list
+ finally return (nbutlast my-list))
+ '(a c e))))
+
+(ert-deftest cl-macs-loop-append/nconc ()
+ (should (equal (cl-loop for x in '((a) (b) ((c)))
+ append x)
+ '(a b (c))))
+ (should (equal (cl-loop for i upfrom 0
+ as x in '(a b (c))
+ nconc (if (cl-evenp i) (list x) nil))
+ '(a (c)))))
+
+(ert-deftest cl-macs-loop-count ()
+ (should (eql (cl-loop for i in '(a b nil c nil d e)
+ count i)
+ 5)))
+
+(ert-deftest cl-macs-loop-max/min ()
+ (should (eql (cl-loop for i in '(2 1 5 3 4)
+ maximize i)
+ 5))
+ (should (eql (cl-loop for i in '(2 1 5 3 4)
+ minimize i)
+ 1))
+ (should (equal (cl-loop with series = '(4.3 1.2 5.7)
+ for v in series
+ minimize (round v) into min-result
+ maximize (round v) into max-result
+ collect (list min-result max-result))
+ '((4 4) (1 4) (1 6)))))
+
+(ert-deftest cl-macs-loop-sum ()
+ (should (eql (cl-loop for i in '(1 2 3 4 5)
+ sum i)
+ 15))
+ (should (eql (cl-loop with series = '(1.2 4.3 5.7)
+ for v in series
+ sum (* 2.0 v))
+ 22.4)))
+
+;;; 6.1.4 Termination Test Clauses
+(ert-deftest cl-macs-loop-repeat ()
+ (should (equal (cl-loop with n = 4
+ repeat (1+ n)
+ collect n)
+ '(4 4 4 4 4)))
+ (should (equal (cl-loop for i upto 5
+ repeat 3
+ collect i)
+ '(0 1 2))))
+
+(ert-deftest cl-macs-loop-always ()
+ (should (cl-loop for i from 0 to 10
+ always (< i 11)))
+ (should-not (cl-loop for i from 0 to 10
+ always (< i 9)
+ finally (cl-return "you won't see this"))))
+
+(ert-deftest cl-macs-loop-never ()
+ (should (cl-loop for i from 0 to 10
+ never (> i 11)))
+ (should-not (cl-loop never t
+ finally (cl-return "you won't see this"))))
+
+(ert-deftest cl-macs-loop-thereis ()
+ (should (eql (cl-loop for i from 0
+ thereis (when (> i 10) i))
+ 11))
+ (should (string= (cl-loop thereis "Here is my value"
+ finally (cl-return "you won't see this"))
+ "Here is my value"))
+ (should (cl-loop for i to 10
+ thereis (> i 11)
+ finally (cl-return i))))
+
+(ert-deftest cl-macs-loop-anon-collection-conditional ()
+ "Always/never/thereis should error when used with an anonymous
+collection clause."
+ :expected-result :failed
+ (should-error (cl-loop always nil collect t))
+ (should-error (cl-loop never t nconc t))
+ (should-error (cl-loop thereis t append t)))
+
+(ert-deftest cl-macs-loop-while ()
+ (should (equal (let ((stack '(a b c d e f)))
+ (cl-loop while stack
+ for item = (length stack) then (pop stack)
+ collect item))
+ '(6 a b c d e f))))
+
+(ert-deftest cl-macs-loop-until ()
+ (should (equal (cl-loop for i to 100
+ collect 10
+ until (= i 3)
+ collect i)
+ '(10 0 10 1 10 2 10))))
+
+;;; 6.1.5 Unconditional Execution Clauses
+(ert-deftest cl-macs-loop-do ()
+ (should (equal (cl-loop with list
+ for i from 1 to 3
+ do
+ (push 10 list)
+ (push i list)
+ finally (cl-return list))
+ '(3 10 2 10 1 10)))
+ (should (equal (cl-loop with res = 0
+ for i from 1 to 10
+ doing (cl-incf res i)
+ finally (cl-return res))
+ 55))
+ (should (equal (cl-loop for i from 10
+ do (when (= i 15)
+ (cl-return i))
+ finally (cl-return 0))
+ 15)))
+
+;;; 6.1.6 Conditional Execution Clauses
+(ert-deftest cl-macs-loop-when ()
+ (should (equal (cl-loop for i in '(1 2 3 4 5 6)
+ when (and (> i 3) i)
+ collect it)
+ '(4 5 6)))
+ (should (eql (cl-loop for i in '(1 2 3 4 5 6)
+ when (and (> i 3) i)
+ return it)
+ 4))
+
+ (should (equal (cl-loop for elt in '(1 a 2 "a" (3 4) 5 6)
+ when (numberp elt)
+ when (cl-evenp elt) collect elt into even
+ else collect elt into odd
+ else
+ when (symbolp elt) collect elt into syms
+ else collect elt into other
+ finally return (list even odd syms other))
+ '((2 6) (1 5) (a) ("a" (3 4))))))
+
+(ert-deftest cl-macs-loop-if ()
+ (should (equal (cl-loop for i to 5
+ if (cl-evenp i)
+ collect i
+ and when (and (= i 2) 'two)
+ collect it
+ and if (< i 3)
+ collect "low")
+ '(0 2 two "low" 4)))
+ (should (equal (cl-loop for i to 5
+ if (cl-evenp i)
+ collect i
+ and when (and (= i 2) 'two)
+ collect it
+ end
+ and if (< i 3)
+ collect "low")
+ '(0 "low" 2 two "low" 4)))
+ (should (equal (cl-loop with funny-numbers = '(6 13 -1)
+ for x below 10
+ if (cl-evenp x)
+ collect x into evens
+ else
+ collect x into odds
+ and if (memq x funny-numbers) return (cdr it)
+ finally return (vector odds evens))
+ [(1 3 5 7 9) (0 2 4 6 8)])))
+
+(ert-deftest cl-macs-loop-unless ()
+ (should (equal (cl-loop for i to 5
+ unless (= i 3)
+ collect i
+ else
+ collect 'three)
+ '(0 1 2 three 4 5))))
+
+
+;;; 6.1.7.1 Control Transfer Clauses
+(ert-deftest cl-macs-loop-named ()
+ (should (eql (cl-loop named finished
+ for i to 10
+ when (> (* i i) 30)
+ do (cl-return-from finished i))
+ 6)))
+
+;;; 6.1.7.2 Initial and Final Execution
+(ert-deftest cl-macs-loop-initially ()
+ (should (equal (let ((var (list 1 2 3 4 5)))
+ (cl-loop for i in var
+ collect i
+ initially
+ (setf (car var) 10)
+ (setf (cadr var) 20)))
+ '(10 20 3 4 5))))
+
+(ert-deftest cl-macs-loop-finally ()
+ (should (eql (cl-loop for i from 10
+ finally
+ (cl-incf i 10)
+ (cl-return i)
+ while (< i 20))
+ 30)))
+
+;;; Emacs extensions to loop
+(ert-deftest cl-macs-loop-in-ref ()
+ (should (equal (cl-loop with my-list = (list 1 2 3 4 5)
+ for x in-ref my-list
+ do (cl-incf x)
+ finally return my-list)
+ '(2 3 4 5 6))))
+
+(ert-deftest cl-macs-loop-across-ref ()
+ (should (equal (cl-loop with my-vec = ["one" "two" "three"]
+ for x across-ref my-vec
+ do (setf (aref x 0) (upcase (aref x 0)))
+ finally return my-vec)
+ ["One" "Two" "Three"])))
+
+(ert-deftest cl-macs-loop-being-elements ()
+ (should (equal (let ((var "StRiNG"))
+ (cl-loop for x being the elements of var
+ collect (downcase x)))
+ (string-to-list "string"))))
+
+(ert-deftest cl-macs-loop-being-elements-of-ref ()
+ (should (equal (let ((var (list 1 2 3 4 5)))
+ (cl-loop for x being the elements of-ref var
+ do (cl-incf x)
+ finally return var))
+ '(2 3 4 5 6))))
+
+(ert-deftest cl-macs-loop-being-symbols ()
+ (should (eq (cl-loop for sym being the symbols
+ when (eq sym 'cl-loop)
+ return 'cl-loop)
+ 'cl-loop)))
+
+(ert-deftest cl-macs-loop-being-keymap ()
+ (should (equal (let ((map (make-sparse-keymap))
+ (parent (make-sparse-keymap))
+ res)
+ (define-key map "f" #'forward-char)
+ (define-key map "b" #'backward-char)
+ (define-key parent "n" #'next-line)
+ (define-key parent "p" #'previous-line)
+ (set-keymap-parent map parent)
+ (cl-loop for b being the key-bindings of map
+ using (key-codes c)
+ do (push (list c b) res))
+ (cl-loop for s being the key-seqs of map
+ using (key-bindings b)
+ do (push (list (cl-copy-seq s) b) res))
+ res)
+ '(([?n] next-line) ([?p] previous-line)
+ ([?f] forward-char) ([?b] backward-char)
+ (?n next-line) (?p previous-line)
+ (?f forward-char) (?b backward-char)))))
+
+(ert-deftest cl-macs-loop-being-overlays ()
+ (should (equal (let ((ov (make-overlay (point) (point))))
+ (overlay-put ov 'prop "test")
+ (cl-loop for o being the overlays
+ when (eq o ov)
+ return (overlay-get o 'prop)))
+ "test")))
+
+(ert-deftest cl-macs-loop-being-frames ()
+ (should (eq (cl-loop with selected = (selected-frame)
+ for frame being the frames
+ when (eq frame selected)
+ return frame)
+ (selected-frame))))
+
+(ert-deftest cl-macs-loop-being-windows ()
+ (should (eq (cl-loop with selected = (selected-window)
+ for window being the windows
+ when (eq window selected)
+ return window)
+ (selected-window))))
+
+(ert-deftest cl-macs-loop-being-buffers ()
+ (should (eq (cl-loop with current = (current-buffer)
+ for buffer being the buffers
+ when (eq buffer current)
+ return buffer)
+ (current-buffer))))
+
+(ert-deftest cl-macs-loop-vconcat ()
+ (should (equal (cl-loop for x in (list 1 2 3 4 5)
+ vconcat (vector (1+ x)))
+ [2 3 4 5 6])))
+
+;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index dfbe18d7844..a5dd5abf46b 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -34,7 +34,7 @@
(let ((print-circle t))
(should (equal (cl-prin1-to-string `((x . ,x) (y . ,x)))
"((x . #1=#s(cl-print--test :a 1 :b 2)) (y . #1#))")))
- (should (string-match "\\`#f(compiled-function (x) .*\n\n.*)\\'"
+ (should (string-match "\\`#f(compiled-function (x) \"[^\"]+\" [^\)]*)\\'"
(cl-prin1-to-string (symbol-function #'caar))))))
(ert-deftest cl-print-tests-2 ()
diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el
index 61e3d720331..8c0d55663ca 100644
--- a/test/lisp/emacs-lisp/cl-seq-tests.el
+++ b/test/lisp/emacs-lisp/cl-seq-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -27,7 +27,7 @@
(require 'cl-seq)
(ert-deftest cl-union-test-00 ()
- "Test for http://debbugs.gnu.org/22729 ."
+ "Test for https://debbugs.gnu.org/22729 ."
(let ((str1 "foo")
(str2 (make-string 3 ?o)))
;; Emacs may make two string literals eql when reading.
@@ -293,7 +293,7 @@ Body are forms defining the test."
(should (= 3 (cl-search (nthcdr 2 list) list2)))))
(ert-deftest cl-seq-test-bug24264 ()
- "Test for http://debbugs.gnu.org/24264 ."
+ "Test for https://debbugs.gnu.org/24264 ."
(let ((list (append (make-list 8000005 1) '(8)))
(list2 (make-list 8000005 2)))
(should (cl-position 8 list))
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
new file mode 100644
index 00000000000..ca49dcd213d
--- /dev/null
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -0,0 +1,134 @@
+;;; edebug-test-code.el --- Sample code for the Edebug test suite
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell
+
+;; 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:
+
+;; This file contains sample code used by edebug-tests.el.
+;; Before evaluation, it will be preprocessed by
+;; `edebug-tests-setup-code-file' which will remove all tags
+;; between !'s and save their positions for use by the tests.
+
+;;; Code:
+
+(defun edebug-test-code-fac (n)
+ !start!(if !step!(< 0 n)
+ (* n (edebug-test-code-fac (1- n)))!mult!
+ 1))
+
+(defun edebug-test-code-concat (a b flag)
+ !start!(if flag!flag!
+ !then-start!(concat a!then-a! b!then-b!)!then-concat!
+ !else-start!(concat b!else-b! a!else-a!)!else-concat!)!if!)
+
+(defun edebug-test-code-range (num)
+ !start!(let ((index 0)
+ (result nil))
+ (while (< index num)!test!
+ (push index result)!loop!
+ (cl-incf index))!end-loop!
+ (nreverse result)))
+
+(defun edebug-test-code-choices (input)
+ !start!(cond
+ ((eq input 0) "zero")
+ ((eq input 7) 42)
+ (t !edebug!(edebug))))
+
+(defvar edebug-test-code-total nil)
+
+(defun edebug-test-code-multiply (times value)
+ !start!(setq edebug-test-code-total 0)
+ (cl-dotimes (index times)
+ (setq edebug-test-code-total (+ edebug-test-code-total value))!setq!)
+ edebug-test-code-total)
+
+(defun edebug-test-code-format-vector-node (node)
+ !start!(concat "["
+ (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ "]"))
+
+(defun edebug-test-code-format-list-node (node)
+ !start!(concat "{"
+ (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
+ "}"))
+
+(defun edebug-test-code-format-node (node)
+ !start!(cond
+ (!vectorp!(vectorp node!vnode!)!vtest! !vbefore!(edebug-test-code-format-vector-node node))
+ ((listp node) (edebug-test-code-format-list-node node))
+ (t (format "%s" node))))
+
+(defvar edebug-test-code-flavor "strawberry")
+
+(defmacro edebug-test-code-with-flavor (new-flavor &rest body)
+ (declare (debug (form body))
+ (indent 1))
+ `(let ((edebug-test-code-flavor ,new-flavor))
+ ,@body))
+
+(defun edebug-test-code-try-flavors ()
+ (let* (tried)
+ (push edebug-test-code-flavor tried)
+ !macro!(edebug-test-code-with-flavor "chocolate"
+ (push edebug-test-code-flavor tried))
+ tried)!end!)
+
+(unless (featurep 'edebug-tests-nutty)!nutty!
+ !setq!(setq edebug-test-code-flavor (car (edebug-test-code-try-flavors)))!end-setq!)!end-unless!
+
+(cl-defgeneric edebug-test-code-emphasize (x))
+(cl-defmethod edebug-test-code-emphasize ((x integer))
+ !start!(format "The number is not %s or %s, but %s!"
+ (1+ x) (1- x) x))
+(cl-defmethod edebug-test-code-emphasize ((x string))
+ !start!(format "***%s***" x))
+
+(defun edebug-test-code-use-methods ()
+ (list
+ !number!(edebug-test-code-emphasize 100)
+ !string!(edebug-test-code-emphasize "yes")))
+
+(defun edebug-test-code-make-lambda (n)
+ (lambda (x) (+ x!x! n)))
+
+(defun edebug-test-code-use-lambda ()
+ !start!(mapcar (edebug-test-code-make-lambda 10) '(1 2 3)))
+
+(defun edebug-test-code-circular-read-syntax ()
+ '(#1=a . #1#))
+
+(defun edebug-test-code-hash-read-syntax ()
+ !start!(list #("abcd" 1 3 (face italic))
+ #x01ff))
+
+(defun edebug-test-code-empty-string-list ()
+ !start!(list "")!step!)
+
+(defun edebug-test-code-current-buffer ()
+ !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*")
+ !body!(format "current-buffer: %s" (current-buffer))))
+
+(defun edebug-test-code-use-destructuring-bind ()
+ (let ((two 2) (three 3))
+ (cl-destructuring-bind (x . y) (cons two three) (+ x!x! y!y!))))
+
+(provide 'edebug-test-code)
+;;; edebug-test-code.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
new file mode 100644
index 00000000000..f6c016cdf80
--- /dev/null
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -0,0 +1,917 @@
+;;; edebug-tests.el --- Edebug test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell
+
+;; 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:
+
+;; These tests focus on Edebug's user interface for setting
+;; breakpoints, stepping through and tracing code, and evaluating
+;; values used by the code. In addition there are some tests of
+;; Edebug's reader. There are large parts of Edebug's functionality
+;; not covered by these tests, including coverage testing, macro
+;; specifications, and the eval list buffer.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+(require 'ert-x)
+(require 'edebug)
+(require 'kmacro)
+
+;; Use `eval-and-compile' because this is used by the macro
+;; `edebug-tests-deftest'.
+(eval-and-compile
+ (defvar edebug-tests-sample-code-file
+ (expand-file-name
+ "edebug-resources/edebug-test-code.el"
+ (file-name-directory (or (bound-and-true-p byte-compile-current-file)
+ load-file-name
+ buffer-file-name)))
+ "Name of file containing code samples for Edebug tests."))
+
+(defvar edebug-tests-temp-file nil
+ "Name of temp file containing sample code stripped of stop point symbols.")
+(defvar edebug-tests-stop-points nil
+ "An alist of alists mapping function symbol -> stop point name -> marker.
+Used by the tests to refer to locations in `edebug-tests-temp-file'.")
+(defvar edebug-tests-messages nil
+ "Messages collected during execution of the current test.")
+
+(defvar edebug-tests-@-result 'no-result
+ "Return value of `edebug-tests-func', or no-result if there isn't one yet.")
+
+(defvar edebug-tests-failure-in-post-command nil
+ "An error trapped in `edebug-tests-post-command'.
+Since `should' failures which happen inside `post-command-hook' will
+be trapped by the command loop, this preserves them until we get
+back to the top level.")
+
+(defvar edebug-tests-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "@" 'edebug-tests-call-instrumented-func)
+ (define-key map "C-u" 'universal-argument)
+ (define-key map "C-p" 'previous-line)
+ (define-key map "C-n" 'next-line)
+ (define-key map "C-b" 'backward-char)
+ (define-key map "C-a" 'move-beginning-of-line)
+ (define-key map "C-e" 'move-end-of-line)
+ (define-key map "C-k" 'kill-line)
+ (define-key map "M-x" 'execute-extended-command)
+ (define-key map "C-M-x" 'eval-defun)
+ (define-key map "C-x X b" 'edebug-set-breakpoint)
+ (define-key map "C-x X w" 'edebug-where)
+ map)
+ "Keys used by the keyboard macros in Edebug's tests.")
+
+;;; Macros for defining tests:
+
+(defmacro edebug-tests-with-default-config (&rest body)
+ "Create a consistent environment for an Edebug test BODY to run in."
+ (declare (debug (body)))
+ `(cl-letf* (
+ ;; These defcustoms are set to their original value.
+ (edebug-setup-hook nil)
+ (edebug-all-defs nil)
+ (edebug-all-forms nil)
+ (edebug-eval-macro-args nil)
+ (edebug-save-windows t)
+ (edebug-save-displayed-buffer-points nil)
+ (edebug-initial-mode 'step)
+ (edebug-trace nil)
+ (edebug-test-coverage nil)
+ (edebug-print-length 50)
+ (edebug-print-level 50)
+ (edebug-print-circle t)
+ (edebug-unwrap-results nil)
+ (edebug-on-error t)
+ (edebug-on-quit t)
+ (edebug-global-break-condition nil)
+ (edebug-sit-for-seconds 1)
+
+ ;; sit-on interferes with keyboard macros.
+ (edebug-sit-on-break nil)
+ (edebug-continue-kbd-macro t))
+ ,@body))
+
+(defmacro edebug-tests-with-normal-env (&rest body)
+ "Set up the environment for an Edebug test BODY, run it, and clean up."
+ (declare (debug (body)))
+ `(edebug-tests-with-default-config
+ (let ((edebug-tests-failure-in-post-command nil)
+ (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el")))
+ (edebug-tests-setup-code-file edebug-tests-temp-file)
+ (ert-with-message-capture
+ edebug-tests-messages
+ (unwind-protect
+ (with-current-buffer (find-file edebug-tests-temp-file)
+ (read-only-mode)
+ (setq lexical-binding t)
+ (eval-buffer)
+ ,@body
+ (when edebug-tests-failure-in-post-command
+ (signal (car edebug-tests-failure-in-post-command)
+ (cdr edebug-tests-failure-in-post-command))))
+ (unload-feature 'edebug-test-code)
+ (with-current-buffer (find-file-noselect edebug-tests-temp-file)
+ (set-buffer-modified-p nil))
+ (ignore-errors (kill-buffer (find-file-noselect
+ edebug-tests-temp-file)))
+ (ignore-errors (delete-file edebug-tests-temp-file)))))))
+
+;; The following macro and its support functions implement an extension
+;; to keyboard macros to allow interleaving of keyboard macro
+;; events with evaluation of Lisp expressions. The Lisp expressions
+;; are called from within `post-command-hook', which is a strategy
+;; inspired by `kmacro-step-edit-macro'.
+
+;; Some of the details necessary to get this to work with Edebug are:
+;; -- ERT's `should' macros raise errors, and errors within
+;; `post-command-hook' are trapped by the command loop. The
+;; workaround is to trap and save an error inside the hook
+;; function and reraise it after the macro exits.
+;; -- `edebug-continue-kbd-macro' must be non-nil.
+;; -- Edebug calls `exit-recursive-edit' which turns off keyboard
+;; macro execution. Solved with an advice wrapper for
+;; `exit-recursive-edit' which preserves the keyboard macro state.
+
+(defmacro edebug-tests-run-kbd-macro (&rest macro)
+ "Run a MACRO consisting of both keystrokes and test assertions.
+MACRO should be a list, where each item is either a keyboard
+macro segment (in string or vector form) or a Lisp expression.
+Convert the macro segments into keyboard macros and execute them.
+After the execution of the last event of each segment, evaluate
+the Lisp expressions following the segment."
+ (let ((prepared (edebug-tests-prepare-macro macro)))
+ `(edebug-tests-run-macro ,@prepared)))
+
+;; Make support functions for edebug-tests-run-kbd-macro
+;; available at compile time.
+(eval-and-compile
+ (defun edebug-tests-prepare-macro (macro)
+ "Prepare a MACRO for execution.
+MACRO should be a list containing strings, vectors, and Lisp
+forms. Convert the strings and vectors to keyboard macros in
+vector representation and concatenate them to make a single
+keyboard macro. Also build a list of the same length as the
+number of events in the keyboard macro. Each item in that list
+will contain the code to evaluate after the corresponding event
+in the keyboard macro, either nil or a thunk built from the forms
+in the original list. Return a list containing the keyboard
+macro as the first item, followed by the list of thunks and/or
+nils."
+ (cl-loop
+ for item = (pop macro)
+ while item
+ for segment = (read-kbd-macro item)
+ for thunk = (edebug-tests-wrap-thunk
+ (cl-loop
+ for form in macro
+ until (or (stringp form) (vectorp form))
+ collect form
+ do (pop macro)))
+ vconcat segment into segments
+ append (edebug-tests-pad-thunk-list (length segment) thunk)
+ into thunk-list
+
+ finally return (cons segments thunk-list)))
+
+ (defun edebug-tests-wrap-thunk (body)
+ "If BODY is non-nil, wrap it with a lambda form."
+ (when body
+ `(lambda () ,@body)))
+
+ (defun edebug-tests-pad-thunk-list (length thunk)
+ "Return a list with LENGTH elements with THUNK in the last position.
+All other elements will be nil."
+ (let ((thunk-seg (make-list length nil)))
+ (setf (car (last thunk-seg)) thunk)
+ thunk-seg)))
+
+;;; Support for test execution:
+
+(defvar edebug-tests-thunks nil
+ "List containing thunks to run after each command in a keyboard macro.")
+(defvar edebug-tests-kbd-macro-index nil
+ "Index into `edebug-tests-run-unpacked-kbd-macro's current keyboard macro.")
+
+(defun edebug-tests-run-macro (kbdmac &rest thunks)
+ "Run a keyboard macro and execute a thunk after each command in it.
+KBDMAC should be a vector of events and THUNKS a list of the
+same length containing thunks and/or nils. Run the macro, and
+after the execution of every command in the macro (which may not
+be the same as every keystroke) execute the thunk at the same
+index."
+ (let* ((edebug-tests-thunks thunks)
+ (edebug-tests-kbd-macro-index 0)
+ saved-local-map)
+ (with-current-buffer (find-file-noselect edebug-tests-temp-file)
+ (setq saved-local-map overriding-local-map)
+ (setq overriding-local-map edebug-tests-keymap)
+ (add-hook 'post-command-hook 'edebug-tests-post-command))
+ (advice-add 'exit-recursive-edit
+ :around 'edebug-tests-preserve-keyboard-macro-state)
+ (unwind-protect
+ (kmacro-call-macro nil nil nil kbdmac)
+ (advice-remove 'exit-recursive-edit
+ 'edebug-tests-preserve-keyboard-macro-state)
+ (with-current-buffer (find-file-noselect edebug-tests-temp-file)
+ (setq overriding-local-map saved-local-map)
+ (remove-hook 'post-command-hook 'edebug-tests-post-command)))))
+
+(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args)
+ "Call ORIG with ARGS preserving the value of `executing-kbd-macro'.
+Useful to prevent `exit-recursive-edit' from stopping the current
+keyboard macro."
+ (let ((executing-kbd-macro executing-kbd-macro))
+ (apply orig args)))
+
+(defun edebug-tests-post-command ()
+ "Run the thunk from `edebug-tests-thunks' matching the keyboard macro index."
+ (when (and edebug-tests-kbd-macro-index
+ (> executing-kbd-macro-index edebug-tests-kbd-macro-index))
+ (let ((thunk (nth (1- executing-kbd-macro-index) edebug-tests-thunks)))
+ (when thunk
+ (condition-case err
+ (funcall thunk)
+ (error
+ (setq edebug-tests-failure-in-post-command err)
+ (signal (car err) (cdr err)))))
+ (setq edebug-tests-kbd-macro-index executing-kbd-macro-index))))
+
+(defvar edebug-tests-func nil
+ "Instrumented function used to launch Edebug.")
+(defvar edebug-tests-args nil
+ "Arguments for `edebug-tests-func'.")
+
+(defun edebug-tests-setup-@ (def-name args edebug-it)
+ "Set up the binding for @ in `edebug-tests-keymap'.
+Find a definition for DEF-NAME in the current buffer and evaluate it.
+Set globals so that `edebug-tests-call-instrumented-func' which
+is bound to @ for edebug-tests' keyboard macros will call it with
+ARGS. EDEBUG-IT is passed through to `eval-defun'."
+ (edebug-tests-locate-def def-name)
+ (eval-defun edebug-it)
+ (let* ((full-name (concat "edebug-test-code-" def-name))
+ (sym (intern-soft full-name)))
+ (should (and sym (fboundp sym)))
+ (setq edebug-tests-func sym
+ edebug-tests-args args)
+ (setq edebug-tests-@-result 'no-result)))
+
+(defun edebug-tests-call-instrumented-func ()
+ "Call `edebug-tests-func' with `edebug-tests-args' and save the results."
+ (interactive)
+ (let ((result (apply edebug-tests-func edebug-tests-args)))
+ (should (eq edebug-tests-@-result 'no-result))
+ (setq edebug-tests-@-result result)))
+
+(defun edebug-tests-should-be-at (def-name point-name)
+ "Require that point be at the location in DEF-NAME named POINT-NAME.
+DEF-NAME should be the suffix of a definition in the code samples
+file (the part after \"edebug-tests\")."
+ (let ((stop-point (edebug-tests-get-stop-point def-name point-name)))
+ (should (eq (current-buffer) (find-file-noselect edebug-tests-temp-file)))
+ (should (eql (point) stop-point))))
+
+(defun edebug-tests-get-stop-point (def-name point-name)
+ "Return the position in DEF-NAME of the stop point named POINT-NAME.
+DEF-NAME should be the suffix of a definition in the code samples
+file (the part after \"edebug-tests\")."
+ (let* ((full-name (concat "edebug-test-code-" def-name))(stop-point
+ (cdr (assoc point-name
+ (cdr (assoc full-name edebug-tests-stop-points))))))
+ (unless stop-point
+ (ert-fail (format "%s not found in %s" point-name full-name)))
+ stop-point))
+
+(defun edebug-tests-should-match-result-in-messages (value)
+ "Require that VALUE (a string) match an Edebug result in *Messages*.
+Then clear edebug-tests' saved messages."
+ (should (string-match-p (concat "Result: " (regexp-quote value) "$")
+ edebug-tests-messages))
+ (setq edebug-tests-messages ""))
+
+(defun edebug-tests-locate-def (def-name)
+ "Search for a definition of DEF-NAME from the start of the current buffer.
+Place point at the end of DEF-NAME in the buffer."
+ (goto-char (point-min))
+ (re-search-forward (concat "def\\S-+ edebug-test-code-" def-name)))
+
+(defconst edebug-tests-start-of-next-def-regexp "^(\\S-*def\\S-+ \\(\\S-+\\)"
+ "Regexp used to match the start of a definition.")
+(defconst edebug-tests-stop-point-regexp "!\\(\\S-+?\\)!"
+ "Regexp used to match a stop point annotation in the sample code.")
+
+;;; Set up buffer containing code samples:
+
+(defmacro edebug-tests-deduplicate (name names-and-numbers)
+ "Return a unique variation on NAME.
+NAME should be a string and NAMES-AND-NUMBERS an alist which can
+be used by this macro to retain state. If NAME for example is
+\"symbol\" then the first and subsequent uses of this macro will
+evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc."
+ (let ((g-name (gensym))
+ (g-duplicate (gensym)))
+ `(let* ((,g-name ,name)
+ (,g-duplicate (assoc ,g-name ,names-and-numbers)))
+ (if (null ,g-duplicate)
+ (progn
+ (push (cons ,g-name 0) ,names-and-numbers)
+ ,g-name)
+ (cl-incf (cdr ,g-duplicate))
+ (format "%s-%s" ,g-name (cdr ,g-duplicate))))))
+
+(defun edebug-tests-setup-code-file (tmpfile)
+ "Extract stop points and loadable code from the sample code file.
+Write the loadable code to a buffer for TMPFILE, and set
+`edebug-tests-stop-points' to a map from defined symbols to stop
+point names to positions in the file."
+ (with-current-buffer (find-file-noselect edebug-tests-sample-code-file)
+ (let ((marked-up-code (buffer-string)))
+ (with-temp-file tmpfile
+ (insert marked-up-code))))
+
+ (with-current-buffer (find-file-noselect tmpfile)
+ (let ((stop-points
+ ;; Delete all the !name! annotations from the code, but remember
+ ;; their names and where they were in an alist.
+ (cl-loop
+ initially (goto-char (point-min))
+ while (re-search-forward edebug-tests-stop-point-regexp nil t)
+ for name = (match-string-no-properties 1)
+ do (replace-match "")
+ collect (cons name (point))))
+ names-and-numbers)
+
+ ;; Now build an alist mapping definition names to annotation
+ ;; names and positions.
+ ;; If duplicate symbols exist in the file, enter them in the
+ ;; alist as symbol, symbol-1, symbol-2 etc.
+ (setq edebug-tests-stop-points
+ (cl-loop
+ initially (goto-char (point-min))
+ while (re-search-forward edebug-tests-start-of-next-def-regexp
+ nil t)
+ for name =
+ (edebug-tests-deduplicate (match-string-no-properties 1)
+ names-and-numbers)
+ for end-of-def =
+ (save-match-data
+ (save-excursion
+ (re-search-forward edebug-tests-start-of-next-def-regexp
+ nil 0)
+ (point)))
+ collect (cons name
+ (cl-loop
+ while (and stop-points
+ (< (cdar stop-points) end-of-def))
+ collect (pop stop-points))))))))
+
+;;; Tests
+
+(ert-deftest edebug-tests-check-keymap ()
+ "Verify that `edebug-mode-map' is compatible with these tests.
+If this test fails, one of two things is true. Either your
+customizations modify `edebug-mode-map', in which case starting
+Emacs with the -Q flag should fix the problem, or
+`edebug-mode-map' has changed in edebug.el, in which case this
+test and possibly others should be updated."
+ ;; The reason verify-keybinding is a macro instead of a function is
+ ;; that in the event of a failure, it makes the keybinding that
+ ;; failed show up in ERT's output.
+ (cl-macrolet ((verify-keybinding (key binding)
+ `(should (eq (lookup-key edebug-mode-map ,key)
+ ,binding))))
+ (verify-keybinding " " 'edebug-step-mode)
+ (verify-keybinding "n" 'edebug-next-mode)
+ (verify-keybinding "g" 'edebug-go-mode)
+ (verify-keybinding "G" 'edebug-Go-nonstop-mode)
+ (verify-keybinding "t" 'edebug-trace-mode)
+ (verify-keybinding "T" 'edebug-Trace-fast-mode)
+ (verify-keybinding "c" 'edebug-continue-mode)
+ (verify-keybinding "C" 'edebug-Continue-fast-mode)
+ (verify-keybinding "f" 'edebug-forward-sexp)
+ (verify-keybinding "h" 'edebug-goto-here)
+ (verify-keybinding "I" 'edebug-instrument-callee)
+ (verify-keybinding "i" 'edebug-step-in)
+ (verify-keybinding "o" 'edebug-step-out)
+ (verify-keybinding "q" 'top-level)
+ (verify-keybinding "Q" 'edebug-top-level-nonstop)
+ (verify-keybinding "a" 'abort-recursive-edit)
+ (verify-keybinding "S" 'edebug-stop)
+ (verify-keybinding "b" 'edebug-set-breakpoint)
+ (verify-keybinding "u" 'edebug-unset-breakpoint)
+ (verify-keybinding "B" 'edebug-next-breakpoint)
+ (verify-keybinding "x" 'edebug-set-conditional-breakpoint)
+ (verify-keybinding "X" 'edebug-set-global-break-condition)
+ (verify-keybinding "r" 'edebug-previous-result)
+ (verify-keybinding "e" 'edebug-eval-expression)
+ (verify-keybinding "\C-x\C-e" 'edebug-eval-last-sexp)
+ (verify-keybinding "E" 'edebug-visit-eval-list)
+ (verify-keybinding "w" 'edebug-where)
+ (verify-keybinding "v" 'edebug-view-outside) ;; maybe obsolete??
+ (verify-keybinding "p" 'edebug-bounce-point)
+ (verify-keybinding "P" 'edebug-view-outside) ;; same as v
+ (verify-keybinding "W" 'edebug-toggle-save-windows)
+ (verify-keybinding "?" 'edebug-help)
+ (verify-keybinding "d" 'edebug-backtrace)
+ (verify-keybinding "-" 'negative-argument)
+ (verify-keybinding "=" 'edebug-temp-display-freq-count)))
+
+(ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function ()
+ "Edebug stops at the beginning of an instrumented function."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "fac" '(0) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "start")
+ "SPC" (edebug-tests-should-be-at "fac" "step")
+ "g" (should (equal edebug-tests-@-result 1)))))
+
+(ert-deftest edebug-tests-step-showing-evaluation-results ()
+ "Edebug prints expression evaluation results to the echo area."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "concat" '("x" "y" nil) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "concat" "start")
+ "SPC" (edebug-tests-should-be-at "concat" "flag")
+ (edebug-tests-should-match-result-in-messages "nil")
+ "SPC" (edebug-tests-should-be-at "concat" "else-start")
+ "SPC" (edebug-tests-should-be-at "concat" "else-b")
+ (edebug-tests-should-match-result-in-messages "\"y\"")
+ "SPC" (edebug-tests-should-be-at "concat" "else-a")
+ (edebug-tests-should-match-result-in-messages "\"x\"")
+ "SPC" (edebug-tests-should-be-at "concat" "else-concat")
+ (edebug-tests-should-match-result-in-messages "\"yx\"")
+ "SPC" (edebug-tests-should-be-at "concat" "if")
+ (edebug-tests-should-match-result-in-messages "\"yx\"")
+ "SPC" (should (equal edebug-tests-@-result "yx")))))
+
+(ert-deftest edebug-tests-set-breakpoint-at-point ()
+ "Edebug can set a breakpoint at point."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "concat" '("x" "y" t) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "concat" "start")
+ "C-n C-e b C-n" ; Move down, set a breakpoint and move away.
+ "g" (edebug-tests-should-be-at "concat" "then-concat")
+ (edebug-tests-should-match-result-in-messages "\"xy\"")
+ "g" (should (equal edebug-tests-@-result "xy")))))
+
+(ert-deftest edebug-tests-set-temporary-breakpoint-at-point ()
+ "Edebug can set a temporary breakpoint at point."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "range" '(3) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "range" "start")
+ "C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop.
+ "C-u b" ; Set a temporary breakpoint.
+ "C-n" ; Move away.
+ "g" (edebug-tests-should-be-at "range" "loop")
+ (edebug-tests-should-match-result-in-messages "(0)")
+ "g" (should (equal edebug-tests-@-result '(0 1 2))))))
+
+(ert-deftest edebug-tests-clear-breakpoint ()
+ "Edebug can clear a breakpoint."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "range" '(3) t)
+ (edebug-tests-run-kbd-macro
+ "@"
+ (message "after @")
+ (edebug-tests-should-be-at "range" "start")
+ "C-n C-n C-n C-e b C-n" ; Move down, set a breakpoint and move away.
+ "g" (edebug-tests-should-be-at "range" "loop")
+ (edebug-tests-should-match-result-in-messages "(0)")
+ "g" (edebug-tests-should-be-at "range" "loop")
+ (edebug-tests-should-match-result-in-messages "(1 0)")
+ "u" ; Unset the breakpoint.
+ "g" (should (equal edebug-tests-@-result '(0 1 2))))))
+
+(ert-deftest edebug-tests-move-point-to-next-breakpoint ()
+ "Edebug can move point to the next breakpoint."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "concat" '("a" "b" nil) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "concat" "start")
+ "C-n C-e b" ; Move down, set a breakpoint.
+ "C-n b" ; Set another breakpoint on the next line.
+ "C-p C-p C-p" ; Move back up.
+ "B" (edebug-tests-should-be-at "concat" "then-concat")
+ "B" (edebug-tests-should-be-at "concat" "else-concat")
+ "G" (should (equal edebug-tests-@-result "ba")))))
+
+(ert-deftest edebug-tests-move-point-back-to-stop-point ()
+ "Edebug can move point back to a stop point."
+ (edebug-tests-with-normal-env
+ (let ((test-buffer (get-buffer-create "edebug-tests-temp")))
+ (edebug-tests-setup-@ "fac" '(4) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "start")
+ "C-n w" (edebug-tests-should-be-at "fac" "start")
+ (pop-to-buffer test-buffer)
+ "C-x X w" (edebug-tests-should-be-at "fac" "start")
+ "g" (should (equal edebug-tests-@-result 24)))
+ (ignore-errors (kill-buffer test-buffer)))))
+
+(ert-deftest edebug-tests-jump-to-point ()
+ "Edebug can stop at a temporary breakpoint at point."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "range" '(3) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "range" "start")
+ "C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop.
+ "h" (edebug-tests-should-be-at "range" "loop")
+ (edebug-tests-should-match-result-in-messages "(0)")
+ "g" (should (equal edebug-tests-@-result '(0 1 2))))))
+
+(ert-deftest edebug-tests-jump-forward-one-sexp ()
+ "Edebug can run the program for one expression."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "range" '(3) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "range" "start")
+ "SPC SPC f" (edebug-tests-should-be-at "range" "test")
+ "g" (should (equal edebug-tests-@-result '(0 1 2))))))
+
+(ert-deftest edebug-tests-run-out-of-containing-sexp ()
+ "Edebug can run the program until the end of the containing sexp."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "range" '(3) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "range" "start")
+ "SPC SPC f" (edebug-tests-should-be-at "range" "test")
+ "o" (edebug-tests-should-be-at "range" "end-loop")
+ (edebug-tests-should-match-result-in-messages "nil")
+ "g" (should (equal edebug-tests-@-result '(0 1 2))))))
+
+(ert-deftest edebug-tests-observe-breakpoint-in-source ()
+ "Edebug will stop at a breakpoint embedded in source code."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "choices" '(8) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "choices" "start")
+ "g" (edebug-tests-should-be-at "choices" "edebug")
+ "g" (should (equal edebug-tests-@-result nil)))))
+
+(ert-deftest edebug-tests-set-conditional-breakpoint ()
+ "Edebug can set and observe a conditional breakpoint."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "fac" '(5) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "start")
+ ;; Set conditional breakpoint at end of next line.
+ "C-n C-e x (eql SPC n SPC 3) RET"
+ "g" (edebug-tests-should-be-at "fac" "mult")
+ (edebug-tests-should-match-result-in-messages "6 (#o6, #x6, ?\\C-f)")
+ "g" (should (equal edebug-tests-@-result 120)))))
+
+(ert-deftest edebug-tests-error-trying-to-set-breakpoint-in-uninstrumented-code
+ ()
+ "Edebug refuses to set a breakpoint in uninstrumented code."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "fac" '(5) t)
+ (let* ((debug-on-error nil)
+ (edebug-on-error nil)
+ error-message
+ (command-error-function (lambda (&rest args)
+ (setq error-message (cadar args)))))
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "start")
+ "C-u 10 C-n" ; Move down and out of instrumented function.
+ "b" (should (string-match-p "Not inside instrumented form"
+ error-message))
+ ;; The error stopped the keyboard macro. Start it again.
+ (should-not executing-kbd-macro)
+ (setq executing-kbd-macro t)
+ "g"))))
+
+(ert-deftest edebug-tests-set-and-break-on-global-condition ()
+ "Edebug can break when a global condition becomes true."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "multiply" '(5 3) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "multiply" "start")
+ "X (> SPC edebug-test-code-total SPC 10) RET"
+ (should edebug-global-break-condition)
+ "g" (edebug-tests-should-be-at "multiply" "setq")
+ (should (eql (symbol-value 'edebug-test-code-total) 12))
+ "X C-a C-k nil RET" ; Remove suggestion before entering nil.
+ "g" (should (equal edebug-tests-@-result 15)))))
+
+(ert-deftest edebug-tests-trace-showing-results-at-stop-points ()
+ "Edebug can trace execution, showing results at stop points."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "concat" '("x" "y" nil) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "concat" "start")
+ "T" (should (string-match-p
+ (concat "Result: nil\n.*?"
+ "Result: \"y\"\n.*?"
+ "Result: \"x\"\n.*?"
+ "Result: \"yx\"\n.*?"
+ "Result: \"yx\"\n")
+ edebug-tests-messages))
+ (should (equal edebug-tests-@-result "yx")))))
+
+(ert-deftest edebug-tests-trace-showing-results-at-breakpoints ()
+ "Edebug can trace execution, showing results at breakpoints."
+ (edebug-tests-with-normal-env
+ (edebug-tests-locate-def "format-vector-node")
+ (edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b")
+ (edebug-tests-locate-def "format-list-node")
+ (edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b")
+ (edebug-tests-setup-@ "format-node" '(([a b] [c d])) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "format-node" "start")
+ "C" (should (string-match-p
+ (concat "Result: \"ab\"\n.*?"
+ "Result: \"cd\"\n.*?"
+ "Result: \"\\[ab]\\[cd]\"\n")
+ edebug-tests-messages))
+ (should (equal edebug-tests-@-result "{[ab][cd]}")))))
+
+(ert-deftest edebug-tests-trace-function-call-and-return ()
+ "Edebug can create a trace of function calls and returns."
+ (edebug-tests-with-normal-env
+ (edebug-tests-locate-def "format-vector-node")
+ (eval-defun t)
+ (edebug-tests-locate-def "format-list-node")
+ (eval-defun t)
+ (edebug-tests-setup-@ "format-node" '((a [b])) t)
+ (let ((edebug-trace t)
+ (trace-start (with-current-buffer
+ (get-buffer-create edebug-trace-buffer) (point-max))))
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "format-node" "start")
+ "g" (should (equal edebug-tests-@-result "{a[b]}")))
+ (with-current-buffer edebug-trace-buffer
+ (should (string=
+ "{ edebug-test-code-format-node args: ((a [b]))
+:{ edebug-test-code-format-list-node args: ((a [b]))
+::{ edebug-test-code-format-node args: (a)
+::} edebug-test-code-format-node result: a
+::{ edebug-test-code-format-node args: ([b])
+:::{ edebug-test-code-format-vector-node args: ([b])
+::::{ edebug-test-code-format-node args: (b)
+::::} edebug-test-code-format-node result: b
+:::} edebug-test-code-format-vector-node result: [b]
+::} edebug-test-code-format-node result: [b]
+:} edebug-test-code-format-list-node result: {a[b]}
+} edebug-test-code-format-node result: {a[b]}
+" (buffer-substring trace-start (point-max))))))))
+
+(ert-deftest edebug-tests-evaluate-expressions ()
+ "Edebug can evaluate an expression in the context outside of itself."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "range" '(2) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "range" "start")
+ "SPC SPC f" (edebug-tests-should-be-at "range" "test")
+ (edebug-tests-should-match-result-in-messages "t")
+ "e (- SPC num SPC index) RET"
+ ;; Edebug just prints the result without "Result:"
+ (should (string-match-p
+ (regexp-quote "2 (#o2, #x2, ?\\C-b)")
+ edebug-tests-messages))
+ "g" (should (equal edebug-tests-@-result '(0 1))))
+
+ ;; Do it again with lexical-binding turned off.
+ (setq lexical-binding nil)
+ (eval-buffer)
+ (should-not lexical-binding)
+ (edebug-tests-setup-@ "range" '(2) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "range" "start")
+ "SPC SPC f" (edebug-tests-should-be-at "range" "test")
+ (edebug-tests-should-match-result-in-messages "t")
+ "e (- SPC num SPC index) RET"
+ ;; Edebug just prints the result without "Result:"
+ (should (string-match-p
+ (regexp-quote "2 (#o2, #x2, ?\\C-b)")
+ edebug-tests-messages))
+ "g" (should (equal edebug-tests-@-result '(0 1))))))
+
+(ert-deftest edebug-tests-step-into-function ()
+ "Edebug can step into a function."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "format-node" '([b]) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "format-node" "start")
+ "SPC SPC SPC SPC"
+ (edebug-tests-should-be-at "format-node" "vbefore")
+ "i" (edebug-tests-should-be-at "format-vector-node" "start")
+ "g" (should (equal edebug-tests-@-result "[b]")))))
+
+(ert-deftest edebug-tests-error-stepping-into-subr ()
+ "Edebug refuses to step into a C function."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "format-node" '([b]) t)
+ (let* ((debug-on-error nil)
+ (edebug-on-error nil)
+ error-message
+ (command-error-function (lambda (&rest args)
+ (setq error-message (cl-cadar args)))))
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "format-node" "start")
+ "SPC" (edebug-tests-should-be-at "format-node" "vectorp")
+ "i" (should (string-match-p "vectorp is a built-in function"
+ error-message))
+ ;; The error stopped the keyboard macro. Start it again.
+ (should-not executing-kbd-macro)
+ (setq executing-kbd-macro t)
+ "g" (should (equal edebug-tests-@-result "[b]"))))))
+
+(ert-deftest edebug-tests-step-into-macro-error ()
+ "Edebug gives an error on trying to step into a macro (Bug#26847)."
+ :expected-result :failed
+ (ert-fail "Forcing failure because letting this test run aborts the others.")
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "try-flavors" nil t)
+ (let* ((debug-on-error nil)
+ (edebug-on-error nil)
+ (error-message "")
+ (command-error-function (lambda (&rest args)
+ (setq error-message (cl-cadar args)))))
+ (edebug-tests-run-kbd-macro
+ "@ SPC SPC SPC SPC SPC"
+ (edebug-tests-should-be-at "try-flavors" "macro")
+ "i" (should (string-match-p "edebug-test-code-try-flavors is a macro"
+ error-message))
+ ;; The error stopped the keyboard macro. Start it again.
+ (should-not executing-kbd-macro)
+ (setq executing-kbd-macro t)
+ "g" (should (equal edebug-tests-@-result
+ '("chocolate" "strawberry")))))))
+
+(ert-deftest edebug-tests-step-into-generic-method ()
+ "Edebug can step into a generic method (Bug#22294)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "use-methods" nil t)
+ (edebug-tests-run-kbd-macro
+ "@ SPC" (edebug-tests-should-be-at "use-methods" "number")
+ "i" (edebug-tests-should-be-at "emphasize-1" "start")
+ "gg" (should (equal edebug-tests-@-result
+ '("The number is not 101 or 99, but 100!"
+ "***yes***"))))))
+
+(ert-deftest edebug-tests-break-in-lambda-out-of-defining-context ()
+ "Edebug observes a breakpoint in a lambda executed out of defining context."
+ (edebug-tests-with-normal-env
+ (edebug-tests-locate-def "make-lambda")
+ (eval-defun t)
+ (goto-char (edebug-tests-get-stop-point "make-lambda" "x"))
+ (edebug-set-breakpoint t)
+ (edebug-tests-setup-@ "use-lambda" nil t)
+ (edebug-tests-run-kbd-macro
+ "@g" (edebug-tests-should-be-at "make-lambda" "x")
+ (edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)")
+ "g" (should (equal edebug-tests-@-result '(11 12 13))))))
+
+(ert-deftest edebug-tests-respects-initial-mode ()
+ "Edebug can stop first at breakpoint instead of first instrumented function."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "fac" '(4) t)
+ (goto-char (edebug-tests-get-stop-point "fac" "mult"))
+ (edebug-set-breakpoint t)
+ (setq edebug-initial-mode 'go)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "mult")
+ (edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)")
+ "G" (should (equal edebug-tests-@-result 24)))))
+
+(ert-deftest edebug-tests-step-through-non-definition ()
+ "Edebug can step through a non-defining form."
+ (edebug-tests-with-normal-env
+ (goto-char (edebug-tests-get-stop-point "try-flavors" "end-unless"))
+ (edebug-tests-run-kbd-macro
+ "C-u C-M-x"
+ "SPC SPC" (edebug-tests-should-be-at "try-flavors" "nutty")
+ (edebug-tests-should-match-result-in-messages "nil")
+ "SPC" (edebug-tests-should-be-at "try-flavors" "setq")
+ "f" (edebug-tests-should-be-at "try-flavors" "end-setq")
+ (edebug-tests-should-match-result-in-messages "\"chocolate\"")
+ "g")))
+
+(ert-deftest edebug-tests-conditional-breakpoints-can-use-lexical-variables ()
+ "Edebug can set a conditional breakpoint using a lexical variable. Bug#12685"
+ (edebug-tests-with-normal-env
+ (should lexical-binding)
+ (edebug-tests-setup-@ "fac" '(5) t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at "fac" "start")
+ ;; Set conditional breakpoint at end of next line.
+ "C-n C-e x (eql SPC n SPC 3) RET"
+ "g" (edebug-tests-should-be-at "fac" "mult")
+ (edebug-tests-should-match-result-in-messages
+ "6 (#o6, #x6, ?\\C-f)"))))
+
+(ert-deftest edebug-tests-writable-buffer-state-is-preserved ()
+ "On Edebug exit writable buffers are still writable (Bug#14144)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "choices" '(0) t)
+ (read-only-mode -1)
+ (edebug-tests-run-kbd-macro
+ "@g" (should (equal edebug-tests-@-result "zero")))
+ (barf-if-buffer-read-only)))
+
+(ert-deftest edebug-tests-list-containing-empty-string-result-printing ()
+ "Edebug correctly prints a list containing only an empty string (Bug#17934)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "empty-string-list" nil t)
+ (edebug-tests-run-kbd-macro
+ "@ SPC" (edebug-tests-should-be-at
+ "empty-string-list" "step")
+ (edebug-tests-should-match-result-in-messages "(\"\")")
+ "g")))
+
+(ert-deftest edebug-tests-evaluation-of-current-buffer-bug-19611 ()
+ "Edebug can evaluate `current-buffer' in correct context. (Bug#19611)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "current-buffer" nil t)
+ (edebug-tests-run-kbd-macro
+ "@" (edebug-tests-should-be-at
+ "current-buffer" "start")
+ "SPC SPC SPC" (edebug-tests-should-be-at
+ "current-buffer" "body")
+ "e (current-buffer) RET"
+ ;; Edebug just prints the result without "Result:"
+ (should (string-match-p
+ (regexp-quote "*edebug-test-code-buffer*")
+ edebug-tests-messages))
+ "g" (should (equal edebug-tests-@-result
+ "current-buffer: *edebug-test-code-buffer*")))))
+
+(ert-deftest edebug-tests-trivial-backquote ()
+ "Edebug can instrument a trivial backquote expression (Bug#23651)."
+ (edebug-tests-with-normal-env
+ (read-only-mode -1)
+ (delete-region (point-min) (point-max))
+ (insert "`1")
+ (read-only-mode)
+ (edebug-eval-defun nil)
+ (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)")
+ edebug-tests-messages))
+ (setq edebug-tests-messages "")
+
+ (setq edebug-initial-mode 'go)
+ ;; In Bug#23651 Edebug would hang reading `1.
+ (edebug-eval-defun t)))
+
+(ert-deftest edebug-tests-trivial-comma ()
+ "Edebug can read a trivial comma expression (Bug#23651)."
+ (edebug-tests-with-normal-env
+ (read-only-mode -1)
+ (delete-region (point-min) (point-max))
+ (insert ",1")
+ (read-only-mode)
+ (should-error (edebug-eval-defun t))))
+
+(ert-deftest edebug-tests-circular-read-syntax ()
+ "Edebug can instrument code using circular read object syntax (Bug#23660)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "circular-read-syntax" nil t)
+ (edebug-tests-run-kbd-macro
+ "@" (should (eql (car edebug-tests-@-result)
+ (cdr edebug-tests-@-result))))))
+
+(ert-deftest edebug-tests-hash-read-syntax ()
+ "Edebug can instrument code which uses # read syntax (Bug#25068)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "hash-read-syntax" nil t)
+ (edebug-tests-run-kbd-macro
+ "@g" (should (equal edebug-tests-@-result
+ '(#("abcd" 1 3 (face italic)) 511))))))
+
+(ert-deftest edebug-tests-dotted-forms ()
+ "Edebug can instrument code matching the tail of a dotted spec (Bug#6415)."
+ (edebug-tests-with-normal-env
+ (edebug-tests-setup-@ "use-destructuring-bind" nil t)
+ (edebug-tests-run-kbd-macro
+ "@ SPC SPC SPC SPC SPC SPC"
+ (edebug-tests-should-be-at "use-destructuring-bind" "x")
+ (edebug-tests-should-match-result-in-messages "2 (#o2, #x2, ?\\C-b)")
+ "SPC"
+ (edebug-tests-should-be-at "use-destructuring-bind" "y")
+ (edebug-tests-should-match-result-in-messages "3 (#o3, #x3, ?\\C-c)")
+ "g"
+ (should (equal edebug-tests-@-result 5)))))
+
+(provide 'edebug-tests)
+;;; edebug-tests.el ends here
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 241ca65122d..818b3e76a1e 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -192,7 +192,7 @@
(ert-deftest eieio-test-method-order-list-6 ()
;; FIXME repeated intermittent failures on hydra (bug#24503)
;; ((:STATIC C) (:STATIC C-base1) (:STATIC C-base2)) != ((:STATIC C))")
- (skip-unless (not (getenv "NIX_STORE")))
+ (skip-unless (not (getenv "EMACS_HYDRA_CI")))
(let ((eieio-test-method-order-list nil)
(ans '(
(:STATIC C)
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 da4cc5f51f3..738711c9c84 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -104,7 +104,7 @@ This is usually a symbol that starts with `:'."
;;; Slot Writers
;;
-;; Replica of the test in eieio-tests.el -
+;; Replica of the test in eieio-tests.el -
(defclass persist-:printer (eieio-persistent)
((slot1 :initarg :slot1
@@ -164,7 +164,7 @@ persistent class.")
"persist wos 1"
:pnp (persist-not-persistent "pnp 1" :slot1 3)
:file (concat default-directory "test-ps3.pt"))))
-
+
(persist-test-save-and-compare persist-wos)
(delete-file (oref persist-wos file))))
@@ -187,14 +187,36 @@ persistent class.")
(ert-deftest eieio-test-non-persistent-as-slot-child ()
(let ((persist-woss
- (persistent-with-objs-slot-subs
+ (persistent-with-objs-slot-subs
"persist woss 1"
:pnp (persist-not-persistent-subclass "pnps 1" :slot1 3)
:file (concat default-directory "test-ps4.pt"))))
-
+
(persist-test-save-and-compare persist-woss)
(delete-file (oref persist-woss file))))
+;; A slot that can contain one of two different classes, to exercise
+;; the `or' slot type.
+
+(defclass persistent-random-class ()
+ ())
+
+(defclass persistent-multiclass-slot (eieio-persistent)
+ ((slot1 :initarg :slot1
+ :type (or persistent-random-class null persist-not-persistent))
+ (slot2 :initarg :slot2
+ :type (or persist-not-persistent persist-random-class null))))
+
+(ert-deftest eieio-test-multiple-class-slot ()
+ (let ((persist
+ (persistent-multiclass-slot "random string"
+ :slot1 (persistent-random-class)
+ :slot2 (persist-not-persistent)
+ :file (concat default-directory "test-ps5.pt"))))
+ (unwind-protect
+ (persist-test-save-and-compare persist)
+ (ignore-errors (delete-file (oref persist file))))))
+
;;; Slot with a list of Objects
;;
;; A slot that contains another object that isn't persistent
@@ -206,13 +228,13 @@ persistent class.")
(ert-deftest eieio-test-slot-with-list-of-objects ()
(let ((persist-wols
- (persistent-with-objs-list-slot
+ (persistent-with-objs-list-slot
"persist wols 1"
:pnp (list (persist-not-persistent "pnp 1" :slot1 3)
(persist-not-persistent "pnp 2" :slot1 4)
(persist-not-persistent "pnp 3" :slot1 5))
:file (concat default-directory "test-ps5.pt"))))
-
+
(persist-test-save-and-compare persist-wols)
(delete-file (oref persist-wols file))))
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
index c34560ab585..454f2aaca0e 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -887,15 +887,33 @@ Subclasses to override slot attributes.")
(should (= (length (eieio-build-class-alist 'opt-test1 nil)) 2))
(should (= (length (eieio-build-class-alist 'opt-test1 t)) 1)))
+(mapatoms (lambda (a)
+ (when (and (fboundp a)
+ (string-match "\\`cl--?generic"
+ (symbol-name a)))
+ (trace-function-background a))))
+
(defclass eieio--testing () ())
(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
(list newname 2))
+(defun eieio-test-dump-trace ()
+ (message "%s" (with-current-buffer "*trace-output*"
+ (goto-char (point-min))
+ (while (re-search-forward "[\0-\010\013-\037]" nil t)
+ (insert (prog1 (format "\\%03o" (char-before))
+ (delete-char -1))))
+ (buffer-string))))
+(eieio-test-dump-trace)
+
(ert-deftest eieio-test-37-obsolete-name-in-constructor ()
;; FIXME repeated intermittent failures on hydra (bug#24503)
- (skip-unless (not (getenv "NIX_STORE")))
- (should (equal (eieio--testing "toto") '("toto" 2))))
+ (with-current-buffer "*trace-output*"
+ (erase-buffer))
+ (unwind-protect
+ (should (equal (eieio--testing "toto") '("toto" 2)))
+ (eieio-test-dump-trace)))
(ert-deftest eieio-autoload ()
"Tests to see whether reftex-auc has been autoloaded"
diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el
index fc5790c3659..b620a662846 100644
--- a/test/lisp/emacs-lisp/ert-tests.el
+++ b/test/lisp/emacs-lisp/ert-tests.el
@@ -17,7 +17,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -294,6 +294,15 @@ failed or if there was a problem."
"the error signaled was a subtype of the expected type")))))
))
+(ert-deftest ert-test-should-error-argument ()
+ "Errors due to evaluating arguments should not break tests."
+ (should-error (identity (/ 1 0))))
+
+(ert-deftest ert-test-should-error-macroexpansion ()
+ "Errors due to expanding macros should not break tests."
+ (cl-macrolet ((test () (error "Foo")))
+ (should-error (test))))
+
(ert-deftest ert-test-skip-unless ()
;; Don't skip.
(let ((test (make-ert-test :body (lambda () (skip-unless t)))))
@@ -352,7 +361,7 @@ This macro is used to test if macroexpansion in `should' works."
(let ((abc (ert-get-test 'ert-test-abc)))
(should (equal (ert-test-tags abc) '(bar)))
(should (equal (ert-test-documentation abc) "foo")))
- (should (equal (symbol-file 'ert-test-deftest 'ert-deftest)
+ (should (equal (symbol-file 'ert-test-deftest 'ert--test)
(symbol-file 'ert-test--which-file 'defun)))
(ert-deftest ert-test-def () :expected-result ':passed)
@@ -367,12 +376,8 @@ This macro is used to test if macroexpansion in `should' works."
(test (make-ert-test :body test-body))
(result (ert-run-test test)))
(should (ert-test-failed-p result))
- (with-temp-buffer
- (ert--print-backtrace (ert-test-failed-backtrace result))
- (goto-char (point-min))
- (end-of-line)
- (let ((first-line (buffer-substring-no-properties (point-min) (point))))
- (should (equal first-line (format " %S()" test-body)))))))
+ (should (eq (nth 1 (car (ert-test-failed-backtrace result)))
+ 'signal))))
(ert-deftest ert-test-messages ()
:tags '(:causes-redisplay)
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el
index 4615d08e303..0cc89ac9977 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -18,7 +18,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
new file mode 100644
index 00000000000..ec2cf272368
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -0,0 +1,76 @@
+;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'.
+
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
+
+;; Author: Anders Lindgren
+;; Keywords: languages, faces
+
+;; 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:
+
+;; Dummy major-mode for testing `faceup', a regression test system for
+;; font-lock keywords (syntax highlighting rules for Emacs).
+;;
+;; This mode use `syntax-propertize' to set the `syntax-table'
+;; property on "<" and ">" in "<TEXT>" to make them act like
+;; parentheses.
+;;
+;; This mode also sets the `help-echo' property on the text WARNING,
+;; the effect is that Emacs displays a tooltip when you move your
+;; mouse on to the text.
+
+;;; Code:
+
+(defvar faceup-test-mode-syntax-table
+ (make-syntax-table)
+ "Syntax table for `faceup-test-mode'.")
+
+(defvar faceup-test-font-lock-keywords
+ '(("\\_<WARNING\\_>"
+ (0 (progn
+ (add-text-properties (match-beginning 0)
+ (match-end 0)
+ '(help-echo "Baloon tip: Fly smoothly!"))
+ font-lock-warning-face))))
+ "Highlight rules for `faceup-test-mode'.")
+
+(defun faceup-test-syntax-propertize (start end)
+ (goto-char start)
+ (funcall
+ (syntax-propertize-rules
+ ("\\(<\\)\\([^<>\n]*\\)\\(>\\)"
+ (1 "() ")
+ (3 ")( ")))
+ start end))
+
+(defmacro faceup-test-define-prog-mode (mode name &rest args)
+ "Define a major mode for a programming language.
+If `prog-mode' is defined, inherit from it."
+ (declare (indent defun))
+ `(define-derived-mode
+ ,mode ,(and (fboundp 'prog-mode) 'prog-mode)
+ ,name ,@args))
+
+(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 font-lock-defaults '(faceup-test-font-lock-keywords nil)))
+
+(provide 'faceup-test-mode)
+
+;;; faceup-test-mode.el ends here
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
new file mode 100644
index 00000000000..e9d8b7074c2
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
@@ -0,0 +1,32 @@
+;;; faceup-test-this-file-directory.el --- Support file for faceup tests
+
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
+
+;; Author: Anders Lindgren
+;; Keywords: languages, faces
+
+;; 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:
+
+;; Support file for `faceup-test-basics.el'. This file is used to test
+;; `faceup-this-file-directory' in various contexts.
+
+;;; Code:
+
+(defvar faceup-test-this-file-directory (faceup-this-file-directory))
+
+;;; faceup-test-this-file-directory.el ends here
diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt
new file mode 100644
index 00000000000..d971f364c2d
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt
@@ -0,0 +1,15 @@
+This is a test of `faceup', a regression test system for font-lock
+keywords. It should use major mode `faceup-test-mode'.
+
+WARNING: The first word on this line should use
+`font-lock-warning-face', and a tooltip should be displayed if the
+mouse pointer is moved over it.
+
+In this mode "<" and ">" are parentheses, but only when on the same
+line without any other "<" and ">" characters between them.
+<OK> <NOT <OK> >
+<
+NOT OK
+>
+
+test1.txt ends here.
diff --git a/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
new file mode 100644
index 00000000000..7d4938adf17
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-resources/files/test1.txt.faceup
@@ -0,0 +1,15 @@
+This is a test of `faceup', a regression test system for font-lock
+keywords. It should use major mode `faceup-test-mode'.
+
+«(help-echo):"Baloon tip: Fly smoothly!":«w:WARNING»»: The first word on this line should use
+`font-lock-warning-face', and a tooltip should be displayed if the
+mouse pointer is moved over it.
+
+In this mode «s:"«(syntax-table):(4 . 41):<»"» and «s:"«(syntax-table):(5 . 40):>»"» are parentheses, but only when on the same
+line without any other «s:"«(syntax-table):(4 . 41):<»"» and «s:"«(syntax-table):(5 . 40):>»"» characters between them.
+«(syntax-table):(4 . 41):<»OK«(syntax-table):(5 . 40):>» <NOT «(syntax-table):(4 . 41):<»OK«(syntax-table):(5 . 40):>» >
+<
+NOT OK
+>
+
+test1.txt ends here.
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
new file mode 100644
index 00000000000..fd58c1bbca6
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
@@ -0,0 +1,269 @@
+;;; faceup-test-basics.el --- Tests for the `faceup' package.
+
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
+
+;; Author: Anders Lindgren
+;; Keywords: languages, faces
+
+;; 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:
+
+;; Basic tests for the `faceup' package.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'faceup)
+
+(ert-deftest faceup-functions ()
+ "Test primitive functions."
+ (should (equal (faceup-normalize-face-property '()) '()))
+ (should (equal (faceup-normalize-face-property 'a) '(a)))
+ (should (equal (faceup-normalize-face-property '(a)) '(a)))
+ (should (equal (faceup-normalize-face-property '(:x t)) '((:x t))))
+ (should (equal (faceup-normalize-face-property '(:x t a)) '((:x t))))
+ (should (equal (faceup-normalize-face-property '(:x t a b)) '((:x t))))
+ (should (equal (faceup-normalize-face-property '(a :x t)) '(a (:x t))))
+ (should (equal (faceup-normalize-face-property '(a b :x t))
+ '(a b (:x t))))
+
+ (should (equal (faceup-normalize-face-property '(:x t :y nil))
+ '((:y nil) (:x t))))
+ (should (equal (faceup-normalize-face-property '(:x t :y nil a))
+ '((:y nil) (:x t))))
+ (should (equal (faceup-normalize-face-property '(:x t :y nil a b))
+ '((:y nil) (:x t))))
+ (should (equal (faceup-normalize-face-property '(a :x t :y nil))
+ '(a (:y nil) (:x t))))
+ (should (equal (faceup-normalize-face-property '(a b :x t :y nil))
+ '(a b (:y nil) (:x t)))))
+
+
+(ert-deftest faceup-markup-basics ()
+ (should (equal (faceup-markup-string "") ""))
+ (should (equal (faceup-markup-string "test") "test")))
+
+(ert-deftest faceup-markup-escaping ()
+ (should (equal (faceup-markup-string "«") "««"))
+ (should (equal (faceup-markup-string "«A«B«C«") "««A««B««C««"))
+ (should (equal (faceup-markup-string "»") "«»"))
+ (should (equal (faceup-markup-string "»A»B»C»") "«»A«»B«»C«»")))
+
+(ert-deftest faceup-markup-plain ()
+ ;; UU
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face underline)))
+ "AB«U:CD»EF")))
+
+(ert-deftest faceup-markup-plain-full-text ()
+ ;; UUUUUU
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 0 6 (face underline)))
+ "«U:ABCDEF»")))
+
+(ert-deftest faceup-markup-anonymous-face ()
+ ;; AA
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face (:underline t))))
+ "AB«:(:underline t):CD»EF")))
+
+(ert-deftest faceup-markup-anonymous-face-2keys ()
+ ;; AA
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face (:foo t :bar nil))))
+ "AB«:(:foo t):«:(:bar nil):CD»»EF"))
+ ;; Plist in list.
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face ((:foo t :bar nil)))))
+ "AB«:(:foo t):«:(:bar nil):CD»»EF"))
+ ;; Two plists.
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face ((:foo t) (:bar nil)))))
+ "AB«:(:bar nil):«:(:foo t):CD»»EF")))
+
+(ert-deftest faceup-markup-anonymous-nested ()
+ ;; AA
+ ;; IIII
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF"
+ 1 2 (face ((:foo t)))
+ 2 4 (face ((:bar t) (:foo t)))
+ 4 5 (face ((:foo t)))))
+ "A«:(:foo t):B«:(:bar t):CD»E»F")))
+
+(ert-deftest faceup-markup-nested ()
+ ;; UU
+ ;; IIII
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF"
+ 1 2 (face italic)
+ 2 4 (face (underline italic))
+ 4 5 (face italic)))
+ "A«I:B«U:CD»E»F")))
+
+(ert-deftest faceup-markup-overlapping ()
+ ;; UUU
+ ;; III
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF"
+ 1 2 (face italic)
+ 2 4 (face (underline italic))
+ 4 5 (face underline)))
+ "A«I:B«U:CD»»«U:E»F"))
+ ;; III
+ ;; UUU
+ ;; ABCDEF
+ (should (equal (faceup-markup-string
+ #("ABCDEF"
+ 1 2 (face italic)
+ 2 4 (face (italic underline))
+ 4 5 (face underline)))
+ "A«I:B»«U:«I:CD»E»F")))
+
+(ert-deftest faceup-markup-multi-face ()
+ ;; More than one face at the same location.
+ ;;
+ ;; The property to the front takes precedence, it is rendered as the
+ ;; innermost parenthesis pair.
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face (underline italic))))
+ "AB«I:«U:CD»»EF"))
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (face (italic underline))))
+ "AB«U:«I:CD»»EF"))
+ ;; Equal ranges, full text.
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 0 6 (face (underline italic))))
+ "«I:«U:ABCDEF»»"))
+ ;; Ditto, with stray markup characters.
+ (should (equal (faceup-markup-string
+ #("AB«CD»EF" 0 8 (face (underline italic))))
+ "«I:«U:AB««CD«»EF»»")))
+
+(ert-deftest faceup-markup-multi-property ()
+ (let ((faceup-properties '(alpha beta gamma)))
+ ;; One property.
+ (should (equal (faceup-markup-string
+ #("ABCDEF" 2 4 (alpha (a l p h a))))
+ "AB«(alpha):(a l p h a):CD»EF"))
+
+ ;; Two properties, inner enclosed.
+ (should (equal (faceup-markup-string
+ (let ((s (copy-sequence "ABCDEFGHIJ")))
+ (set-text-properties 2 8 '(alpha (a l p h a)) s)
+ (font-lock-append-text-property 4 6 'beta '(b e t a) s)
+ s))
+ "AB«(alpha):(a l p h a):CD«(beta):(b e t a):EF»GH»IJ"))
+
+ ;; Two properties, same end
+ (should (equal (faceup-markup-string
+ (let ((s (copy-sequence "ABCDEFGH")))
+ (set-text-properties 2 6 '(alpha (a)) s)
+ (add-text-properties 4 6 '(beta (b)) s)
+ s))
+ "AB«(alpha):(a):CD«(beta):(b):EF»»GH"))
+
+ ;; Two properties, overlap.
+ (should (equal (faceup-markup-string
+ (let ((s (copy-sequence "ABCDEFGHIJ")))
+ (set-text-properties 2 6 '(alpha (a)) s)
+ (add-text-properties 4 8 '(beta (b)) s)
+ s))
+ "AB«(alpha):(a):CD«(beta):(b):EF»»«(beta):(b):GH»IJ"))))
+
+
+(ert-deftest faceup-clean ()
+ "Test the clean features of `faceup'."
+ (should (equal (faceup-clean-string "") ""))
+ (should (equal (faceup-clean-string "test") "test"))
+ (should (equal (faceup-clean-string "AB«U:CD»EF") "ABCDEF"))
+ (should (equal (faceup-clean-string "«U:ABCDEF»") "ABCDEF"))
+ (should (equal (faceup-clean-string "A«I:B«U:CD»E»F") "ABCDEF"))
+ (should (equal (faceup-clean-string "A«I:B«U:CD»»«U:E»F") "ABCDEF"))
+ (should (equal (faceup-clean-string "AB«I:«U:CD»»EF") "ABCDEF"))
+ (should (equal (faceup-clean-string "«I:«U:ABCDEF»»") "ABCDEF"))
+ (should (equal (faceup-clean-string "«(foo)I:ABC»DEF") "ABCDEF"))
+ (should (equal (faceup-clean-string "«:(:foo t):ABC»DEF") "ABCDEF"))
+ ;; Escaped markup characters.
+ (should (equal (faceup-clean-string "««") "«"))
+ (should (equal (faceup-clean-string "«»") "»"))
+ (should (equal (faceup-clean-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF")))
+
+
+(ert-deftest faceup-render ()
+ "Test the render features of `faceup'."
+ (should (equal (faceup-render-string "") ""))
+ (should (equal (faceup-render-string "««") "«"))
+ (should (equal (faceup-render-string "«»") "»"))
+ (should (equal (faceup-render-string "A«I:B«U:CD»«»»«U:E»F") "ABCD»EF")))
+
+
+(defvar faceup-test-resources-directory
+ (concat (file-name-directory
+ (substring (faceup-this-file-directory) 0 -1))
+ "faceup-resources/")
+ "The `faceup-resources' directory.")
+
+
+(defvar faceup-test-this-file-directory nil
+ "The result of `faceup-this-file-directory' in various contexts.
+
+This is set by the file test support file
+`faceup-test-this-file-directory.el'.")
+
+
+(ert-deftest faceup-directory ()
+ "Test `faceup-this-file-directory'."
+ (let ((file (concat faceup-test-resources-directory
+ "faceup-test-this-file-directory.el"))
+ (load-file-name nil))
+ ;; Test normal load.
+ (makunbound 'faceup-test-this-file-directory)
+ (load file nil :nomessage)
+ (should (equal faceup-test-this-file-directory
+ faceup-test-resources-directory))
+ ;; Test `eval-buffer'.
+ (makunbound 'faceup-test-this-file-directory)
+ (save-excursion
+ (find-file file)
+ (eval-buffer))
+ (should (equal faceup-test-this-file-directory
+ faceup-test-resources-directory))
+ ;; Test `eval-defun'.
+ (makunbound 'faceup-test-this-file-directory)
+ (save-excursion
+ (find-file file)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; Note: In batch mode, this prints the result of the
+ ;; evaluation. Unfortunately, this is hard to fix.
+ (eval-defun nil)
+ (forward-sexp))))
+ (should (equal faceup-test-this-file-directory
+ faceup-test-resources-directory))))
+
+(provide 'faceup-test-basics)
+
+;;; faceup-test-basics.el ends here
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
new file mode 100644
index 00000000000..0f136862094
--- /dev/null
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
@@ -0,0 +1,63 @@
+;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode.
+
+;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
+
+;; Author: Anders Lindgren
+;; Keywords: languages, faces
+
+;; 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:
+
+;; Self test of `faceup' with a major mode that sets both the
+;; `syntax-table' and the `echo-help' property.
+;;
+;; This file can also be seen as a blueprint of test cases for real
+;; major modes.
+
+;;; Code:
+
+(require 'faceup)
+
+;; Note: The byte compiler needs the value to load `faceup-test-mode',
+;; hence the `eval-and-compile'.
+(eval-and-compile
+ (defvar faceup-test-files-dir (faceup-this-file-directory)
+ "The directory of this file."))
+
+(require 'faceup-test-mode
+ (concat faceup-test-files-dir
+ "../faceup-resources/"
+ "faceup-test-mode.el"))
+
+(defun faceup-test-files-check-one (file)
+ "Test that FILE is fontified as the .faceup file describes.
+
+FILE is interpreted as relative to this source directory."
+ (let ((faceup-properties '(face syntax-table help-echo)))
+ (faceup-test-font-lock-file 'faceup-test-mode
+ (concat
+ faceup-test-files-dir
+ "../faceup-resources/"
+ file))))
+(faceup-defexplainer faceup-test-files-check-one)
+
+(ert-deftest faceup-files ()
+ (should (faceup-test-files-check-one "files/test1.txt")))
+
+(provide 'faceup-test-files)
+
+;;; faceup-test-files.el ends here
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el
index 1a567ac70fc..cbb136ae919 100644
--- a/test/lisp/emacs-lisp/generator-tests.el
+++ b/test/lisp/emacs-lisp/generator-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -282,3 +282,13 @@ identical output.
(ert-deftest cps-test-declarations-preserved ()
(should (equal (documentation 'generator-with-docstring) "Documentation!"))
(should (equal (get 'generator-with-docstring 'lisp-indent-function) 5)))
+
+(ert-deftest cps-iter-lambda-with-dynamic-binding ()
+ "`iter-lambda' with dynamic binding produces correct result (bug#25965)."
+ (should (= 1
+ (iter-next
+ (funcall (iter-lambda ()
+ (let* ((fill-column 10) ;;any special variable will do
+ (i 0)
+ (j (setq i (1+ i))))
+ (iter-yield i))))))))
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
new file mode 100644
index 00000000000..93f70827133
--- /dev/null
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -0,0 +1,147 @@
+;;; gv-tests.el --- tests for gv.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 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)
+(eval-when-compile (require 'cl-lib))
+
+(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar)
+ (&rest filebody)
+ &rest body)
+ (declare (indent 2))
+ `(let ((default-directory (make-temp-file "gv-test" t)))
+ (unwind-protect
+ (let ((,elvar "gv-test-deffoo.el")
+ (,elcvar "gv-test-deffoo.elc"))
+ (with-temp-file ,elvar
+ (insert ";; -*- lexical-binding: t; -*-\n")
+ (dolist (form ',filebody)
+ (pp form (current-buffer))))
+ ,@body)
+ (delete-directory default-directory t))))
+
+(ert-deftest gv-define-expander-in-file ()
+ (gv-tests--in-temp-dir (el elc)
+ ((gv-define-setter gv-test-foo (newval cons)
+ `(setcar ,cons ,newval))
+ (defvar gv-test-pair (cons 1 2))
+ (setf (gv-test-foo gv-test-pair) 99)
+ (message "%d" (car gv-test-pair)))
+ (with-temp-buffer
+ (call-process (concat invocation-directory invocation-name)
+ nil '(t t) nil
+ "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+ "-l" elc)
+ (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-define-expander-in-file-twice ()
+ (gv-tests--in-temp-dir (el elc)
+ ((gv-define-setter gv-test-foo (newval cons)
+ `(setcar ,cons ,newval))
+ (defvar gv-test-pair (cons 1 2))
+ (setf (gv-test-foo gv-test-pair) 99)
+ (gv-define-setter gv-test-foo (newval cons)
+ `(setcdr ,cons ,newval))
+ (setf (gv-test-foo gv-test-pair) 42)
+ (message "%S" gv-test-pair))
+ (with-temp-buffer
+ (call-process (concat invocation-directory invocation-name)
+ nil '(t t) nil
+ "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+ "-l" elc)
+ (should (equal (buffer-string) "(99 . 42)\n")))))
+
+(ert-deftest gv-dont-define-expander-in-file ()
+ ;; The expander is defined while we are compiling the file, even
+ ;; though it's inside (when nil ...) because the compiler won't
+ ;; analyze the conditional.
+ :expected-result :failed
+ (gv-tests--in-temp-dir (el elc)
+ ((when nil (gv-define-setter gv-test-foo (newval cons)
+ `(setcar ,cons ,newval)))
+ (defvar gv-test-pair (cons 1 2))
+ (setf (gv-test-foo gv-test-pair) 99)
+ (message "%d" (car gv-test-pair)))
+ (with-temp-buffer
+ (call-process (concat invocation-directory invocation-name)
+ nil '(t t) nil
+ "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+ "-l" elc)
+ (should (equal (buffer-string)
+ "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+(ert-deftest gv-define-expander-in-function ()
+ ;; The expander is not defined while we are compiling the file, the
+ ;; compiler won't handle gv definitions not at top-level.
+ :expected-result :failed
+ (gv-tests--in-temp-dir (el elc)
+ ((defun foo ()
+ (gv-define-setter gv-test-foo (newval cons)
+ `(setcar ,cons ,newval))
+ t)
+ (defvar gv-test-pair (cons 1 2))
+ (setf (gv-test-foo gv-test-pair) 99)
+ (message "%d" (car gv-test-pair)))
+ (with-temp-buffer
+ (call-process (concat invocation-directory invocation-name)
+ nil '(t t) nil
+ "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el))
+ "-l" elc)
+ (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-define-expander-out-of-file ()
+ (gv-tests--in-temp-dir (el elc)
+ ((gv-define-setter gv-test-foo (newval cons)
+ `(setcar ,cons ,newval))
+ (defvar gv-test-pair (cons 1 2)))
+ (with-temp-buffer
+ (call-process (concat invocation-directory invocation-name)
+ nil '(t t) nil
+ "-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)))))
+ (should (equal (buffer-string) "99\n")))))
+
+(ert-deftest gv-dont-define-expander-other-file ()
+ (gv-tests--in-temp-dir (el elc)
+ ((if nil (gv-define-setter gv-test-foo (newval cons)
+ `(setcar ,cons ,newval)))
+ (defvar gv-test-pair (cons 1 2)))
+ (with-temp-buffer
+ (call-process (concat invocation-directory invocation-name)
+ nil '(t t) nil
+ "-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)))))
+ (should (equal (buffer-string)
+ "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n")))))
+
+;; `ert-deftest' messes up macroexpansion when the test file itself is
+;; compiled (see Bug #24402).
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; gv-tests.el ends here
diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el
index d04645709e4..edcfe8a5291 100644
--- a/test/lisp/emacs-lisp/let-alist-tests.el
+++ b/test/lisp/emacs-lisp/let-alist-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el
index 582041cfc2d..6bc916f6c35 100644
--- a/test/lisp/emacs-lisp/lisp-mode-tests.el
+++ b/test/lisp/emacs-lisp/lisp-mode-tests.el
@@ -13,7 +13,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -198,6 +198,32 @@ Expected initialization file: `%s'\"
(indent-region (point-min) (point-max))
(should (equal (buffer-string) correct)))))
+(ert-deftest lisp-comment-indent-1 ()
+ (with-temp-buffer
+ (insert "\
+\(let ( ;sf
+ (x 3))
+ 4)")
+ (let ((indent-tabs-mode nil)
+ (correct (buffer-string)))
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (comment-indent)
+ (should (equal (buffer-string) correct)))))
+
+(ert-deftest lisp-comment-indent-2 ()
+ (with-temp-buffer
+ (insert "\
+\(let (;;sf
+ (x 3))
+ 4)")
+ (let ((indent-tabs-mode nil)
+ (correct (buffer-string)))
+ (emacs-lisp-mode)
+ (goto-char (point-min))
+ (comment-indent)
+ (should (equal (buffer-string) correct)))))
+
(provide 'lisp-mode-tests)
;;; lisp-mode-tests.el ends here
diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el
index ddbf378683b..654d949d388 100644
--- a/test/lisp/emacs-lisp/lisp-tests.el
+++ b/test/lisp/emacs-lisp/lisp-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -589,5 +589,36 @@ region."
(should (= (point) before))
(should (= (mark) after))))
+(ert-deftest lisp-fill-paragraph-colon ()
+ "Keywords below Emacs Lisp docstrings should not be filled (Bug#24622).
+Keywords inside docstrings should be filled (Bug#7751)."
+ (elisp-tests-with-temp-buffer
+ "
+\(defcustom custom value
+ \"First\n
+Second\n
+=!inside=Third line\"
+ =!keywords=:type 'sexp
+ :version \"26.1\"
+ :group 'lisp-tests)"
+ (goto-char inside)
+ (fill-paragraph)
+ (goto-char keywords)
+ (beginning-of-line)
+ (should (looking-at " :type 'sexp\n :version \"26.1\"\n :")))
+ (elisp-tests-with-temp-buffer
+ "
+\(defun foo ()
+ \"Summary.
+=!inside=Testing keywords: :one :two :three\"
+ (body))" ; FIXME: Remove parens around body to test Bug#28937 once it's fixed
+ (goto-char inside)
+ (let ((emacs-lisp-docstring-fill-column 30))
+ (fill-paragraph))
+ (forward-line)
+ (should (looking-at ":three"))
+ (end-of-line)
+ (should-not (eq (preceding-char) ?\)))))
+
(provide 'lisp-tests)
;;; lisp-tests.el ends here
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el
index 07e85cc5391..a434c9bd066 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -36,7 +36,7 @@ Each map is built from the following alist data:
Evaluate BODY for each created map.
\(fn (var map) body)"
- (declare (indent 1) (debug t))
+ (declare (indent 1) (debug (symbolp body)))
(let ((alist (make-symbol "alist"))
(vec (make-symbol "vec"))
(ht (make-symbol "ht")))
@@ -63,6 +63,13 @@ Evaluate BODY for each created map.
(with-maps-do map
(should (= 5 (map-elt map 7 5)))))
+(ert-deftest test-map-elt-testfn ()
+ (let ((map (list (cons "a" 1) (cons "b" 2)))
+ ;; Make sure to use a non-eq "a", even when compiled.
+ (noneq-key (string ?a)))
+ (should-not (map-elt map noneq-key))
+ (should (map-elt map noneq-key nil 'equal))))
+
(ert-deftest test-map-elt-with-nil-value ()
(should (null (map-elt '((a . 1)
(b))
@@ -94,6 +101,15 @@ Evaluate BODY for each created map.
(should (eq (map-elt alist 2)
'b))))
+(ert-deftest test-map-put-testfn-alist ()
+ (let ((alist (list (cons "a" 1) (cons "b" 2)))
+ ;; Make sure to use a non-eq "a", even when compiled.
+ (noneq-key (string ?a)))
+ (map-put alist noneq-key 3 'equal)
+ (should-not (cddr alist))
+ (map-put alist noneq-key 9)
+ (should (cddr alist))))
+
(ert-deftest test-map-put-return-value ()
(let ((ht (make-hash-table)))
(should (eq (map-put ht 'a 'hello) 'hello))))
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el
index b228da6cdb8..5cee61ee67d 100644
--- a/test/lisp/emacs-lisp/nadvice-tests.el
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el
index 62fdc751fb5..33209d3d990 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index ef0b2f6b246..3bd14ed4b42 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el
index b9ed79c7749..aed2d3770fb 100644
--- a/test/lisp/emacs-lisp/pp-tests.el
+++ b/test/lisp/emacs-lisp/pp-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/emacs-lisp/regexp-opt-tests.el b/test/lisp/emacs-lisp/regexp-opt-tests.el
index 92626317052..4beb7bfa1ca 100644
--- a/test/lisp/emacs-lisp/regexp-opt-tests.el
+++ b/test/lisp/emacs-lisp/regexp-opt-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el
index c869f9dc875..00bcf8401c4 100644
--- a/test/lisp/emacs-lisp/ring-tests.el
+++ b/test/lisp/emacs-lisp/ring-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/rmc-tests.el b/test/lisp/emacs-lisp/rmc-tests.el
new file mode 100644
index 00000000000..7ab79fda774
--- /dev/null
+++ b/test/lisp/emacs-lisp/rmc-tests.el
@@ -0,0 +1,41 @@
+;;; rmc-tests.el --- Test suite for rmc.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <tino.calancha@gmail.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'rmc)
+(eval-when-compile (require 'cl-lib))
+
+
+(ert-deftest test-read-multiple-choice ()
+ (dolist (char '(?y ?n))
+ (cl-letf* (((symbol-function #'read-char) (lambda () char))
+ (str (if (eq char ?y) "yes" "no")))
+ (should (equal (list char str)
+ (read-multiple-choice "Do it? " '((?y "yes") (?n "no"))))))))
+
+
+(provide 'rmc-tests)
+;;; rmc-tests.el ends here
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el
index 8b7945c9d27..d9ebb769613 100644
--- a/test/lisp/emacs-lisp/rx-tests.el
+++ b/test/lisp/emacs-lisp/rx-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -33,5 +33,15 @@
(number-sequence ?< ?\])
(number-sequence ?- ?:))))))
+(ert-deftest rx-pcase ()
+ (should (equal (pcase "a 1 2 3 1 1 b"
+ ((rx (let u (+ digit)) space
+ (let v (+ digit)) space
+ (let v (+ digit)) space
+ (backref u) space
+ (backref 1))
+ (list u v)))
+ '("1" "3"))))
+
(provide 'rx-tests)
;; rx-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el
index 495cf1e543c..5aa794a43b0 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 2b2a5cd0d71..0187f39d15d 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,13 +28,13 @@
(require 'subr-x)
-;; if-let tests
+;; `if-let*' tests
-(ert-deftest subr-x-test-if-let-single-binding-expansion ()
+(ert-deftest subr-x-test-if-let*-single-binding-expansion ()
"Test single bindings are expanded properly."
(should (equal
(macroexpand
- '(if-let (a 1)
+ '(if-let* ((a 1))
(- a)
"no"))
'(let* ((a (and t 1)))
@@ -43,53 +43,53 @@
"no"))))
(should (equal
(macroexpand
- '(if-let (a)
+ '(if-let* (a)
(- a)
"no"))
- '(let* ((a (and t nil)))
+ '(let* ((a (and t a)))
(if a
(- a)
"no")))))
-(ert-deftest subr-x-test-if-let-single-symbol-expansion ()
+(ert-deftest subr-x-test-if-let*-single-symbol-expansion ()
"Test single symbol bindings are expanded properly."
(should (equal
(macroexpand
- '(if-let (a)
+ '(if-let* (a)
(- a)
"no"))
- '(let* ((a (and t nil)))
+ '(let* ((a (and t a)))
(if a
(- a)
"no"))))
(should (equal
(macroexpand
- '(if-let (a b c)
+ '(if-let* (a b c)
(- a)
"no"))
- '(let* ((a (and t nil))
- (b (and a nil))
- (c (and b nil)))
+ '(let* ((a (and t a))
+ (b (and a b))
+ (c (and b c)))
(if c
(- a)
"no"))))
(should (equal
(macroexpand
- '(if-let (a (b 2) c)
+ '(if-let* (a (b 2) c)
(- a)
"no"))
- '(let* ((a (and t nil))
+ '(let* ((a (and t a))
(b (and a 2))
- (c (and b nil)))
+ (c (and b c)))
(if c
(- a)
"no")))))
-(ert-deftest subr-x-test-if-let-nil-related-expansion ()
+(ert-deftest subr-x-test-if-let*-nil-related-expansion ()
"Test nil is processed properly."
(should (equal
(macroexpand
- '(if-let (nil)
+ '(if-let* (nil)
(- a)
"no"))
'(let* ((nil (and t nil)))
@@ -98,27 +98,7 @@
"no"))))
(should (equal
(macroexpand
- '(if-let ((nil))
- (- a)
- "no"))
- '(let* ((nil (and t nil)))
- (if nil
- (- a)
- "no"))))
- (should (equal
- (macroexpand
- '(if-let ((a 1) (nil) (b 2))
- (- a)
- "no"))
- '(let* ((a (and t 1))
- (nil (and a nil))
- (b (and nil 2)))
- (if b
- (- a)
- "no"))))
- (should (equal
- (macroexpand
- '(if-let ((a 1) nil (b 2))
+ '(if-let* ((a 1) nil (b 2))
(- a)
"no"))
'(let* ((a (and t 1))
@@ -128,104 +108,106 @@
(- a)
"no")))))
-(ert-deftest subr-x-test-if-let-malformed-binding ()
+(ert-deftest subr-x-test-if-let*-malformed-binding ()
"Test malformed bindings trigger errors."
(should-error (macroexpand
- '(if-let (_ (a 1 1) (b 2) (c 3) d)
+ '(if-let* (_ (a 1 1) (b 2) (c 3) d)
(- a)
"no"))
:type 'error)
(should-error (macroexpand
- '(if-let (_ (a 1) (b 2 2) (c 3) d)
+ '(if-let* (_ (a 1) (b 2 2) (c 3) d)
(- a)
"no"))
:type 'error)
(should-error (macroexpand
- '(if-let (_ (a 1) (b 2) (c 3 3) d)
+ '(if-let* (_ (a 1) (b 2) (c 3 3) d)
(- a)
"no"))
:type 'error)
(should-error (macroexpand
- '(if-let ((a 1 1))
+ '(if-let* ((a 1 1))
(- a)
"no"))
:type 'error))
-(ert-deftest subr-x-test-if-let-true ()
+(ert-deftest subr-x-test-if-let*-true ()
"Test `if-let' with truthy bindings."
(should (equal
- (if-let (a 1)
+ (if-let* ((a 1))
a
"no")
1))
(should (equal
- (if-let ((a 1) (b 2) (c 3))
+ (if-let* ((a 1) (b 2) (c 3))
(list a b c)
"no")
(list 1 2 3))))
-(ert-deftest subr-x-test-if-let-false ()
+(ert-deftest subr-x-test-if-let*-false ()
"Test `if-let' with falsie bindings."
(should (equal
- (if-let (a nil)
+ (if-let* ((a nil))
(list a b c)
"no")
"no"))
(should (equal
- (if-let ((a nil) (b 2) (c 3))
+ (if-let* ((a nil) (b 2) (c 3))
(list a b c)
"no")
"no"))
(should (equal
- (if-let ((a 1) (b nil) (c 3))
+ (if-let* ((a 1) (b nil) (c 3))
(list a b c)
"no")
"no"))
(should (equal
- (if-let ((a 1) (b 2) (c nil))
+ (if-let* ((a 1) (b 2) (c nil))
(list a b c)
"no")
"no"))
(should (equal
- (if-let (z (a 1) (b 2) (c 3))
- (list a b c)
- "no")
+ (let (z)
+ (if-let* (z (a 1) (b 2) (c 3))
+ (list a b c)
+ "no"))
"no"))
(should (equal
- (if-let ((a 1) (b 2) (c 3) d)
- (list a b c)
- "no")
+ (let (d)
+ (if-let* ((a 1) (b 2) (c 3) d)
+ (list a b c)
+ "no"))
"no")))
-(ert-deftest subr-x-test-if-let-bound-references ()
+(ert-deftest subr-x-test-if-let*-bound-references ()
"Test `if-let' bindings can refer to already bound symbols."
(should (equal
- (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
+ (if-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
(list a b c)
"no")
(list 1 2 3))))
-(ert-deftest subr-x-test-if-let-and-laziness-is-preserved ()
+(ert-deftest subr-x-test-if-let*-and-laziness-is-preserved ()
"Test `if-let' respects `and' laziness."
(let (a-called b-called c-called)
(should (equal
- (if-let ((a nil)
- (b (setq b-called t))
- (c (setq c-called t)))
+ (if-let* ((a nil)
+ (b (setq b-called t))
+ (c (setq c-called t)))
"yes"
(list a-called b-called c-called))
(list nil nil nil))))
(let (a-called b-called c-called)
(should (equal
- (if-let ((a (setq a-called t))
- (b nil)
- (c (setq c-called t)))
+ (if-let* ((a (setq a-called t))
+ (b nil)
+ (c (setq c-called t)))
"yes"
(list a-called b-called c-called))
(list t nil nil))))
(let (a-called b-called c-called)
(should (equal
- (if-let ((a (setq a-called t))
+ (if-let* ((a (setq a-called t))
(b (setq b-called t))
(c nil)
(d (setq c-called t)))
@@ -234,13 +216,13 @@
(list t t nil)))))
-;; when-let tests
+;; `when-let*' tests
-(ert-deftest subr-x-test-when-let-body-expansion ()
+(ert-deftest subr-x-test-when-let*-body-expansion ()
"Test body allows for multiple sexps wrapping with progn."
(should (equal
(macroexpand
- '(when-let (a 1)
+ '(when-let* ((a 1))
(message "opposite")
(- a)))
'(let* ((a (and t 1)))
@@ -249,79 +231,46 @@
(message "opposite")
(- a)))))))
-(ert-deftest subr-x-test-when-let-single-binding-expansion ()
- "Test single bindings are expanded properly."
- (should (equal
- (macroexpand
- '(when-let (a 1)
- (- a)))
- '(let* ((a (and t 1)))
- (if a
- (- a)))))
- (should (equal
- (macroexpand
- '(when-let (a)
- (- a)))
- '(let* ((a (and t nil)))
- (if a
- (- a))))))
-
-(ert-deftest subr-x-test-when-let-single-symbol-expansion ()
+(ert-deftest subr-x-test-when-let*-single-symbol-expansion ()
"Test single symbol bindings are expanded properly."
(should (equal
(macroexpand
- '(when-let (a)
+ '(when-let* (a)
(- a)))
- '(let* ((a (and t nil)))
+ '(let* ((a (and t a)))
(if a
(- a)))))
(should (equal
(macroexpand
- '(when-let (a b c)
+ '(when-let* (a b c)
(- a)))
- '(let* ((a (and t nil))
- (b (and a nil))
- (c (and b nil)))
+ '(let* ((a (and t a))
+ (b (and a b))
+ (c (and b c)))
(if c
(- a)))))
(should (equal
(macroexpand
- '(when-let (a (b 2) c)
+ '(when-let* (a (b 2) c)
(- a)))
- '(let* ((a (and t nil))
+ '(let* ((a (and t a))
(b (and a 2))
- (c (and b nil)))
+ (c (and b c)))
(if c
(- a))))))
-(ert-deftest subr-x-test-when-let-nil-related-expansion ()
+(ert-deftest subr-x-test-when-let*-nil-related-expansion ()
"Test nil is processed properly."
(should (equal
(macroexpand
- '(when-let (nil)
- (- a)))
- '(let* ((nil (and t nil)))
- (if nil
- (- a)))))
- (should (equal
- (macroexpand
- '(when-let ((nil))
+ '(when-let* (nil)
(- a)))
'(let* ((nil (and t nil)))
(if nil
(- a)))))
(should (equal
(macroexpand
- '(when-let ((a 1) (nil) (b 2))
- (- a)))
- '(let* ((a (and t 1))
- (nil (and a nil))
- (b (and nil 2)))
- (if b
- (- a)))))
- (should (equal
- (macroexpand
- '(when-let ((a 1) nil (b 2))
+ '(when-let* ((a 1) nil (b 2))
(- a)))
'(let* ((a (and t 1))
(nil (and a nil))
@@ -329,108 +278,176 @@
(if b
(- a))))))
-(ert-deftest subr-x-test-when-let-malformed-binding ()
+(ert-deftest subr-x-test-when-let*-malformed-binding ()
"Test malformed bindings trigger errors."
(should-error (macroexpand
- '(when-let (_ (a 1 1) (b 2) (c 3) d)
+ '(when-let* (_ (a 1 1) (b 2) (c 3) d)
(- a)))
:type 'error)
(should-error (macroexpand
- '(when-let (_ (a 1) (b 2 2) (c 3) d)
+ '(when-let* (_ (a 1) (b 2 2) (c 3) d)
(- a)))
:type 'error)
(should-error (macroexpand
- '(when-let (_ (a 1) (b 2) (c 3 3) d)
+ '(when-let* (_ (a 1) (b 2) (c 3 3) d)
(- a)))
:type 'error)
(should-error (macroexpand
- '(when-let ((a 1 1))
+ '(when-let* ((a 1 1))
(- a)))
:type 'error))
-(ert-deftest subr-x-test-when-let-true ()
+(ert-deftest subr-x-test-when-let*-true ()
"Test `when-let' with truthy bindings."
(should (equal
- (when-let (a 1)
+ (when-let* ((a 1))
a)
1))
(should (equal
- (when-let ((a 1) (b 2) (c 3))
+ (when-let* ((a 1) (b 2) (c 3))
(list a b c))
(list 1 2 3))))
-(ert-deftest subr-x-test-when-let-false ()
+(ert-deftest subr-x-test-when-let*-false ()
"Test `when-let' with falsie bindings."
(should (equal
- (when-let (a nil)
+ (when-let* ((a nil))
(list a b c)
"no")
nil))
(should (equal
- (when-let ((a nil) (b 2) (c 3))
+ (when-let* ((a nil) (b 2) (c 3))
(list a b c)
"no")
nil))
(should (equal
- (when-let ((a 1) (b nil) (c 3))
+ (when-let* ((a 1) (b nil) (c 3))
(list a b c)
"no")
nil))
(should (equal
- (when-let ((a 1) (b 2) (c nil))
+ (when-let* ((a 1) (b 2) (c nil))
(list a b c)
"no")
nil))
(should (equal
- (when-let (z (a 1) (b 2) (c 3))
- (list a b c)
- "no")
+ (let (z)
+ (when-let* (z (a 1) (b 2) (c 3))
+ (list a b c)
+ "no"))
nil))
(should (equal
- (when-let ((a 1) (b 2) (c 3) d)
- (list a b c)
- "no")
+ (let (d)
+ (when-let* ((a 1) (b 2) (c 3) d)
+ (list a b c)
+ "no"))
nil)))
-(ert-deftest subr-x-test-when-let-bound-references ()
+(ert-deftest subr-x-test-when-let*-bound-references ()
"Test `when-let' bindings can refer to already bound symbols."
(should (equal
- (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
+ (when-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b)))
(list a b c))
(list 1 2 3))))
-(ert-deftest subr-x-test-when-let-and-laziness-is-preserved ()
+(ert-deftest subr-x-test-when-let*-and-laziness-is-preserved ()
"Test `when-let' respects `and' laziness."
(let (a-called b-called c-called)
(should (equal
(progn
- (when-let ((a nil)
- (b (setq b-called t))
- (c (setq c-called t)))
+ (when-let* ((a nil)
+ (b (setq b-called t))
+ (c (setq c-called t)))
"yes")
(list a-called b-called c-called))
(list nil nil nil))))
(let (a-called b-called c-called)
(should (equal
(progn
- (when-let ((a (setq a-called t))
- (b nil)
- (c (setq c-called t)))
+ (when-let* ((a (setq a-called t))
+ (b nil)
+ (c (setq c-called t)))
"yes")
(list a-called b-called c-called))
(list t nil nil))))
(let (a-called b-called c-called)
(should (equal
(progn
- (when-let ((a (setq a-called t))
- (b (setq b-called t))
- (c nil)
- (d (setq c-called t)))
+ (when-let* ((a (setq a-called t))
+ (b (setq b-called t))
+ (c nil)
+ (d (setq c-called t)))
"yes")
(list a-called b-called c-called))
(list t t nil)))))
+;; `and-let*' tests
+
+;; Adapted from the Guile tests
+;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test
+
+(ert-deftest subr-x-and-let*-test-empty-varlist ()
+ (should (equal 1 (and-let* () 1)))
+ (should (equal 2 (and-let* () 1 2)))
+ (should (equal t (and-let* ()))))
+
+(ert-deftest subr-x-and-let*-test-group-1 ()
+ (should (equal nil (let ((x nil)) (and-let* (x)))))
+ (should (equal 1 (let ((x 1)) (and-let* (x)))))
+ (should (equal nil (and-let* ((x nil)))))
+ (should (equal 1 (and-let* ((x 1)))))
+ ;; The error doesn't trigger when compiled: the compiler will give
+ ;; a warning and then drop the erroneous code. Therefore, use
+ ;; `eval' to avoid compilation.
+ (should-error (eval '(and-let* (nil (x 1))) lexical-binding)
+ :type 'setting-constant)
+ (should (equal nil (and-let* ((nil) (x 1)))))
+ (should-error (eval '(and-let* (2 (x 1))) lexical-binding)
+ :type 'wrong-type-argument)
+ (should (equal 1 (and-let* ((2) (x 1)))))
+ (should (equal 2 (and-let* ((x 1) (2)))))
+ (should (equal nil (let ((x nil)) (and-let* (x) x))))
+ (should (equal "" (let ((x "")) (and-let* (x) x))))
+ (should (equal "" (let ((x "")) (and-let* (x)))))
+ (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1)))))
+ (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1)))))
+ (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1)))))
+ (should (equal t (let ((x 1)) (and-let* (((> x 0)))))))
+ (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1)))))
+ (should (equal 3
+ (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1))))))
+
+(ert-deftest subr-x-and-let*-test-rebind ()
+ (should
+ (equal 4
+ (let ((x 1))
+ (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1))))))
+
+(ert-deftest subr-x-and-let*-test-group-2 ()
+ (should
+ (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1)))))
+ (should
+ (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))
+ (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1)))))
+ (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1)))))
+ (should
+ (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))))
+
+(ert-deftest subr-x-and-let*-test-group-3 ()
+ (should
+ (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
+ (should
+ (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
+ (should
+ (equal nil
+ (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))
+ (should
+ (equal (/ 3.0 2)
+ (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))))
+
+
+
;; Thread first tests
(ert-deftest subr-x-test-thread-first-no-forms ()
diff --git a/test/lisp/emacs-lisp/tabulated-list-test.el b/test/lisp/emacs-lisp/tabulated-list-test.el
index b3a09ee375c..30a4f8f61b4 100644
--- a/test/lisp/emacs-lisp/tabulated-list-test.el
+++ b/test/lisp/emacs-lisp/tabulated-list-test.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el
index 1eb791a993c..6a9612db05a 100644
--- a/test/lisp/emacs-lisp/testcover-resources/testcases.el
+++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el
@@ -17,7 +17,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -53,7 +53,6 @@
;; ==== constants-bug-25316 ====
"Testcover doesn't splotch constants."
-:expected-result :failed
;; ====
(defconst testcover-testcase-const "apples")
(defun testcover-testcase-zero () 0)
@@ -76,7 +75,6 @@
;; ==== customize-defcustom-bug-25326 ====
"Testcover doesn't prevent testing of defcustom values."
-:expected-result :failed
;; ====
(defgroup testcover-testcase nil
"Test case for testcover"
@@ -135,7 +133,6 @@
;; ==== 1-value-symbol-bug-25316 ====
"Wrapping a form with 1value prevents splotching."
-:expected-result :failed
;; ====
(defun testcover-testcase-always-zero (num)
(- num%%% num%%%)%%%)
@@ -230,7 +227,6 @@
;; ==== quotes-within-backquotes-bug-25316 ====
"Forms to instrument are found within quotes within backquotes."
-:expected-result :failed
;; ====
(defun testcover-testcase-make-list ()
(list 'defun 'defvar))
@@ -296,7 +292,6 @@
;; ==== backquote-1value-bug-24509 ====
"Commas within backquotes are recognized as non-1value."
-:expected-result :failed
;; ====
(defmacro testcover-testcase-lambda (&rest body)
`(lambda () ,@body))
@@ -320,7 +315,6 @@
;; ==== pcase-bug-24688 ====
"Testcover copes with condition-case within backquoted list."
-:expected-result :failed
;; ====
(defun testcover-testcase-pcase (form)
(pcase form%%%
@@ -335,7 +329,6 @@
;; ==== defun-in-backquote-bug-11307-and-24743 ====
"Testcover handles defun forms within backquoted list."
-:expected-result :failed
;; ====
(defmacro testcover-testcase-defun (name &rest body)
(declare (debug (symbolp def-body)))
@@ -348,7 +341,6 @@
;; ==== closure-1value-bug ====
"Testcover does not mark closures as 1value."
-:expected-result :failed
;; ====
;; -*- lexical-binding:t -*-
(setq testcover-testcase-foo nil)
@@ -365,7 +357,6 @@
;; ==== by-value-vs-by-reference-bug-25351 ====
"An object created by a 1value expression may be modified by other code."
-:expected-result :failed
;; ====
(defun testcover-testcase-ab ()
(list 'a 'b))
@@ -396,9 +387,16 @@
(should (equal '(a b c) (testcover-testcase-dotted-bq nil '(d e))))
(should (equal '(a b c d e) (testcover-testcase-dotted-bq t '(d e))))
+;; ==== quoted-backquote ====
+"Testcover correctly instruments the quoted backquote symbol."
+;; ====
+(defun testcover-testcase-special-symbols ()
+ (list '\` '\, '\,@))
+
+(should (equal '(\` \, \,@) (testcover-testcase-special-symbols)))
+
;; ==== backquoted-vector-bug-25316 ====
"Testcover reinstruments within backquoted vectors."
-:expected-result :failed
;; ====
(defun testcover-testcase-vec (a b c)
`[,a%%% ,(list b%%% c%%%)%%%]%%%)
@@ -415,7 +413,6 @@
;; ==== vector-in-macro-spec-bug-25316 ====
"Testcover reinstruments within vectors."
-:expected-result :failed
;; ====
(defmacro testcover-testcase-nth-case (arg vec)
(declare (indent 1)
@@ -435,7 +432,6 @@
;; ==== mapcar-is-not-compose ====
"Mapcar with 1value arguments is not 1value."
-:expected-result :failed
;; ====
(defvar testcover-testcase-num 0)
(defun testcover-testcase-add-num (n)
@@ -450,10 +446,10 @@
;; ==== function-with-edebug-spec-bug-25316 ====
"Functions can have edebug specs too.
-See c-make-font-lock-search-function for an example in the Emacs
-sources. The other issue is that it's ok to use quote in an
-edebug spec, so testcover needs to cope with that."
-:expected-result :failed
+See `c-make-font-lock-search-function' for an example in the
+Emacs sources. `c-make-font-lock-search-function''s Edebug spec
+also contains a quote. See comment in `testcover-analyze-coverage'
+regarding the odd-looking coverage result for the quoted form."
;; ====
(defun testcover-testcase-make-function (forms)
`(lambda (flag) (if flag 0 ,@forms%%%))%%%)
@@ -462,7 +458,7 @@ edebug spec, so testcover needs to cope with that."
(("quote" (&rest def-form))))
(defun testcover-testcase-thing ()
- (testcover-testcase-make-function '((+ 1 (+ 2 (+ 3 (+ 4 5))))))%%%)
+ (testcover-testcase-make-function '(!!!(+ 1 !!!(+ 2 !!!(+ 3 !!!(+ 4 5)%%%)%%%)%%%)%%%))%%%)
(defun testcover-testcase-use-thing ()
(funcall (testcover-testcase-thing)%%% nil)%%%)
@@ -490,4 +486,22 @@ edebug spec, so testcover needs to cope with that."
(should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown))
+;; ==== circular-lists-bug-24402 ====
+"Testcover captures and ignores circular list errors."
+;; ====
+(defun testcover-testcase-cyc1 (a)
+ (let ((ls (make-list 10 a%%%)%%%))
+ (nconc ls%%% ls%%%)
+ ls)) ; The lack of a mark here is due to an ignored circular list error.
+(testcover-testcase-cyc1 1)
+(testcover-testcase-cyc1 1)
+(defun testcover-testcase-cyc2 (a b)
+ (let ((ls1 (make-list 10 a%%%)%%%)
+ (ls2 (make-list 10 b)))
+ (nconc ls2 ls2)
+ (nconc ls1%%% ls2)
+ ls1))
+(testcover-testcase-cyc2 1 2)
+(testcover-testcase-cyc2 1 4)
+
;; testcases.el ends here.
diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el
index d31379c3aa2..2e03488b306 100644
--- a/test/lisp/emacs-lisp/testcover-tests.el
+++ b/test/lisp/emacs-lisp/testcover-tests.el
@@ -17,7 +17,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -124,14 +124,12 @@ arguments for `testcover-start'."
(save-current-buffer
(set-buffer (find-file-noselect tempfile))
;; Fail the test if the debugger tries to become active,
- ;; which will happen if Testcover's reinstrumentation
- ;; leaves an edebug-enter in the code. This will also
- ;; prevent debugging these tests using Edebug.
- (cl-letf (((symbol-function #'edebug-enter)
+ ;; which can happen if Testcover fails to attach itself
+ ;; correctly. Note that this will prevent debugging
+ ;; these tests using Edebug.
+ (cl-letf (((symbol-function #'edebug-default-enter)
(lambda (&rest _args)
- (ert-fail
- (concat "Debugger invoked during test run "
- "(possible edebug-enter not replaced)")))))
+ (ert-fail "Debugger invoked during test run"))))
(dolist (byte-compile '(t nil))
(testcover-tests-unmarkup-region (point-min) (point-max))
(unwind-protect
diff --git a/test/lisp/emacs-lisp/thunk-tests.el b/test/lisp/emacs-lisp/thunk-tests.el
index 89bf1f50113..a63ce289e8a 100644
--- a/test/lisp/emacs-lisp/thunk-tests.el
+++ b/test/lisp/emacs-lisp/thunk-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -51,5 +51,55 @@
(thunk-force thunk)
(should (= x 1))))
+
+
+;; thunk-let tests
+
+(ert-deftest thunk-let-basic-test ()
+ "Test whether bindings are established."
+ (should (equal (thunk-let ((x 1) (y 2)) (+ x y)) 3)))
+
+(ert-deftest thunk-let*-basic-test ()
+ "Test whether bindings are established."
+ (should (equal (thunk-let* ((x 1) (y (+ 1 x))) (+ x y)) 3)))
+
+(ert-deftest thunk-let-bound-vars-cant-be-set-test ()
+ "Test whether setting a `thunk-let' bound variable fails."
+ (should-error
+ (eval '(thunk-let ((x 1)) (let ((y 7)) (setq x (+ x y)) (* 10 x))) t)))
+
+(ert-deftest thunk-let-laziness-test ()
+ "Test laziness of `thunk-let'."
+ (should
+ (equal (let ((x-evalled nil)
+ (y-evalled nil))
+ (thunk-let ((x (progn (setq x-evalled t) (+ 1 2)))
+ (y (progn (setq y-evalled t) (+ 3 4))))
+ (let ((evalled-y y))
+ (list x-evalled y-evalled evalled-y))))
+ (list nil t 7))))
+
+(ert-deftest thunk-let*-laziness-test ()
+ "Test laziness of `thunk-let*'."
+ (should
+ (equal (let ((x-evalled nil)
+ (y-evalled nil)
+ (z-evalled nil)
+ (a-evalled nil))
+ (thunk-let* ((x (progn (setq x-evalled t) (+ 1 1)))
+ (y (progn (setq y-evalled t) (+ x 1)))
+ (z (progn (setq z-evalled t) (+ y 1)))
+ (a (progn (setq a-evalled t) (+ z 1))))
+ (let ((evalled-z z))
+ (list x-evalled y-evalled z-evalled a-evalled evalled-z))))
+ (list t t t nil 4))))
+
+(ert-deftest thunk-let-bad-binding-test ()
+ "Test whether a bad binding causes an error when expanding."
+ (should-error (macroexpand '(thunk-let ((x 1 1)) x)))
+ (should-error (macroexpand '(thunk-let (27) x)))
+ (should-error (macroexpand '(thunk-let x x))))
+
+
(provide 'thunk-tests)
;;; thunk-tests.el ends here
diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el
index b12a365ff3b..916625cac3a 100644
--- a/test/lisp/emacs-lisp/timer-tests.el
+++ b/test/lisp/emacs-lisp/timer-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/emulation/viper-tests.el b/test/lisp/emulation/viper-tests.el
index 67ce5b6fbb0..938d5ed6ec5 100644
--- a/test/lisp/emulation/viper-tests.el
+++ b/test/lisp/emulation/viper-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el
index 9dd093e7927..cdb5f366acd 100644
--- a/test/lisp/epg-tests.el
+++ b/test/lisp/epg-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -30,17 +30,8 @@
(expand-file-name "data/epg" (getenv "EMACS_TEST_DIRECTORY"))
"Directory containing epg test data.")
-(defconst epg-tests-program-alist-for-passphrase-callback
- '((OpenPGP
- nil
- ("gpg" . "1.4.3"))))
-
-(defun epg-tests-find-usable-gpg-configuration (&optional require-passphrase)
- (epg-find-configuration
- 'OpenPGP
- 'no-cache
- (if require-passphrase
- epg-tests-program-alist-for-passphrase-callback)))
+(defun epg-tests-find-usable-gpg-configuration (&optional _require-passphrase)
+ (epg-find-configuration 'OpenPGP 'no-cache))
(defun epg-tests-passphrase-callback (_c _k _d)
;; Need to create a copy here, since the string will be wiped out
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index da119ed4b13..6e36ed4071b 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/eshell/em-hist-tests.el b/test/lisp/eshell/em-hist-tests.el
new file mode 100644
index 00000000000..7e0d6142812
--- /dev/null
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -0,0 +1,39 @@
+;;; tests/em-hist-tests.el --- em-hist test suite
+
+;; Copyright (C) 2017 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 'em-hist)
+
+(ert-deftest eshell-write-readonly-history ()
+ "Test that having read-only strings in history is okay."
+ (let ((histfile (make-temp-file "eshell-history"))
+ (eshell-history-ring (make-ring 2)))
+ (ring-insert eshell-history-ring
+ (propertize "echo foo" 'read-only t))
+ (ring-insert eshell-history-ring
+ (propertize "echo bar" 'read-only t))
+ (unwind-protect
+ (eshell-write-history histfile)
+ (delete-file histfile))))
+
+(provide 'em-hist-test)
+
+;;; em-hist-tests.el ends here
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
new file mode 100644
index 00000000000..35d6171400f
--- /dev/null
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -0,0 +1,98 @@
+;;; tests/em-ls-tests.el --- em-ls test suite
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <tino.calancha@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+
+(require 'ert)
+(require 'em-ls)
+
+(ert-deftest em-ls-test-bug27631 ()
+ "Test for https://debbugs.gnu.org/27631 ."
+ (let* ((dir (make-temp-file "bug27631" 'dir))
+ (dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ (orig eshell-ls-use-in-dired)
+ buf)
+ (unwind-protect
+ (progn
+ (customize-set-value 'eshell-ls-use-in-dired t)
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (delete-directory dir 'recursive)
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest em-ls-test-bug27817 ()
+ "Test for https://debbugs.gnu.org/27817 ."
+ (let ((orig eshell-ls-use-in-dired)
+ (dired-use-ls-dired 'unspecified)
+ buf insert-directory-program)
+ (unwind-protect
+ (progn
+ (customize-set-variable 'eshell-ls-use-in-dired t)
+ (should (setq buf (dired source-directory))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (and (buffer-live-p buf) (kill-buffer)))))
+
+(ert-deftest em-ls-test-bug27843 ()
+ "Test for https://debbugs.gnu.org/27843 ."
+ (let ((orig eshell-ls-use-in-dired)
+ (dired-use-ls-dired 'unspecified)
+ buf insert-directory-program)
+ (unwind-protect
+ (progn
+ (customize-set-variable 'eshell-ls-use-in-dired t)
+ (setq buf (dired (list source-directory "lisp")))
+ (dired-toggle-marks)
+ (should-not (cdr (dired-get-marked-files))))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (and (buffer-live-p buf) (kill-buffer)))))
+
+(ert-deftest em-ls-test-bug27844 ()
+ "Test for https://debbugs.gnu.org/27844 ."
+ (let ((orig eshell-ls-use-in-dired)
+ (dired-use-ls-dired 'unspecified)
+ buf insert-directory-program)
+ (unwind-protect
+ (progn
+ (customize-set-variable 'eshell-ls-use-in-dired t)
+ (setq buf (dired (expand-file-name "lisp/*.el" source-directory)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files)))
+ (kill-buffer buf)
+ (setq buf (dired (expand-file-name "lisp/subr.el" source-directory)))
+ (should (looking-at "subr\\.el")))
+ (customize-set-variable 'eshell-ls-use-in-dired orig)
+ (and (buffer-live-p buf) (kill-buffer)))))
+
+
+(provide 'em-ls-test)
+
+;;; em-ls-tests.el ends here
diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el
index 363ef525e1b..58b8aa58bf1 100644
--- a/test/lisp/eshell/eshell-tests.el
+++ b/test/lisp/eshell/eshell-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -247,6 +247,6 @@ chars"
(goto-char eshell-last-input-start)
(string= (eshell-get-old-input) "echo alpha")))
-(provide 'esh-test)
+(provide 'eshell-tests)
;;; tests/eshell-tests.el ends here
diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el
index 2b3456d47f6..056af68af91 100644
--- a/test/lisp/faces-tests.el
+++ b/test/lisp/faces-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el
index 1862c6c3277..0b90d640364 100644
--- a/test/lisp/ffap-tests.el
+++ b/test/lisp/ffap-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -28,7 +28,7 @@
(require 'ffap)
(ert-deftest ffap-tests-25243 ()
- "Test for http://debbugs.gnu.org/25243 ."
+ "Test for https://debbugs.gnu.org/25243 ."
(let ((file (make-temp-file "test-Bug#25243")))
(unwind-protect
(with-temp-file file
@@ -72,12 +72,12 @@ Host = example.com\n")
left alone when opening a URL in an external browser."
(cl-letf* ((old (current-window-configuration))
((symbol-function 'ffap-prompter)
- (lambda () "http://www.gnu.org"))
+ (lambda () "https://www.gnu.org"))
(urls nil)
(ffap-url-fetcher (lambda (url) (push url urls) nil)))
(should-not (ffap-other-window))
(should (equal (current-window-configuration) old))
- (should (equal urls '("http://www.gnu.org")))))
+ (should (equal urls '("https://www.gnu.org")))))
(provide 'ffap-tests)
diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el
index 8a31c2cd8b5..17840e8724b 100644
--- a/test/lisp/filenotify-tests.el
+++ b/test/lisp/filenotify-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -53,6 +53,13 @@
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
+ (add-to-list
+ 'tramp-default-host-alist
+ `("\\`mock\\'" nil ,(system-name)))
+ ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
+ ;; batch mode only, therefore.
+ (unless (and (null noninteractive) (file-directory-p "~/"))
+ (setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
@@ -166,8 +173,8 @@ Return nil when any other file notification watch is still active."
tramp-verbose 0
tramp-message-show-message nil)
-;; This shall happen on hydra only.
-(when (getenv "NIX_STORE")
+;; This should happen on hydra only.
+(when (getenv "EMACS_HYDRA_CI")
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))
;; We do not want to try and fail `file-notify-add-watch'.
@@ -1313,8 +1320,8 @@ the file watch."
;; Cleanup.
(file-notify--test-cleanup)))
-(file-notify--deftest-remote file-notify-test09-watched-file-in-watched-dir
- "Check `file-notify-test09-watched-file-in-watched-dir' for remote files.")
+;(file-notify--deftest-remote file-notify-test09-watched-file-in-watched-dir
+; "Check `file-notify-test09-watched-file-in-watched-dir' for remote files.")
(ert-deftest file-notify-test10-sufficient-resources ()
"Check that file notification does not use too many resources."
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 4583b1af3c3..732b3c02379 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -129,8 +129,7 @@ form.")
(let ((enable-local-variables (nth 0 test-settings))
(enable-local-eval (nth 1 test-settings))
;; Prevent any dir-locals file interfering with the tests.
- (enable-dir-local-variables nil)
- (files-test-queried nil))
+ (enable-dir-local-variables nil))
(hack-local-variables)
(eval (nth 2 test-settings)))))
@@ -154,7 +153,7 @@ form.")
"Test file for bug#18141.")
(ert-deftest files-test-bug-18141 ()
- "Test for http://debbugs.gnu.org/18141 ."
+ "Test for https://debbugs.gnu.org/18141 ."
(skip-unless (executable-find "gzip"))
(let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz")))
(unwind-protect
@@ -166,12 +165,26 @@ form.")
(should (eq buffer-file-coding-system 'iso-2022-7bit-unix))))
(delete-file tempfile))))
+(ert-deftest files-test-make-temp-file-empty-prefix ()
+ "Test make-temp-file with an empty prefix."
+ (let ((tempfile (make-temp-file ""))
+ (tempdir (make-temp-file "" t))
+ (tempfile-. (make-temp-file "."))
+ (tempdir-. (make-temp-file "." t))
+ (tempfile-.. (make-temp-file ".."))
+ (tempdir-.. (make-temp-file ".." t)))
+ (dolist (file (list tempfile tempfile-. tempfile-..))
+ (should file)
+ (delete-file file))
+ (dolist (dir (list tempdir tempdir-. tempdir-..))
+ (should dir)
+ (delete-directory dir))))
;; Stop the above "Local Var..." confusing Emacs.
(ert-deftest files-test-bug-21454 ()
- "Test for http://debbugs.gnu.org/21454 ."
+ "Test for https://debbugs.gnu.org/21454 ."
:expected-result :failed
(let ((input-result
'(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/"))
@@ -247,10 +260,11 @@ be $HOME."
(ert-deftest files-tests--file-name-non-special--subprocess ()
"Check that Bug#25949 is fixed."
(skip-unless (executable-find "true"))
- (should (eq (let ((default-directory "/:/")) (process-file "true")) 0))
- (should (processp (let ((default-directory "/:/"))
- (start-file-process "foo" nil "true"))))
- (should (eq (let ((default-directory "/:/")) (shell-command "true")) 0)))
+ (let ((defdir (if (memq system-type '(ms-dos windows-nt)) "/:c:/" "/:/")))
+ (should (eq (let ((default-directory defdir)) (process-file "true")) 0))
+ (should (processp (let ((default-directory defdir))
+ (start-file-process "foo" nil "true"))))
+ (should (eq (let ((default-directory defdir)) (shell-command "true")) 0))))
(defmacro files-tests--with-advice (symbol where function &rest body)
(declare (indent 3))
@@ -313,5 +327,103 @@ be invoked with the right arguments."
`((verify-visited-file-modtime ,buffer-visiting-file)
(verify-visited-file-modtime nil))))))))
+(ert-deftest files-tests--insert-directory-wildcard-in-dir-p ()
+ (let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt"))
+ (cons "/home/user/.txt" nil)
+ (cons "/home/*/.txt" (cons "/home/" "*/.txt"))
+ (cons "/home/*/" (cons "/home/" "*/"))
+ (cons "/*/.txt" (cons "/" "*/.txt"))
+ ;;
+ (cons "c:/tmp/*/*.txt" (cons "c:/tmp/" "*/*.txt"))
+ (cons "c:/tmp/*.txt" nil)
+ (cons "c:/tmp/*/" (cons "c:/tmp/" "*/"))
+ (cons "c:/*/*.txt" (cons "c:/" "*/*.txt")))))
+ (dolist (path-res alist)
+ (should
+ (equal
+ (cdr path-res)
+ (insert-directory-wildcard-in-dir-p (car path-res)))))))
+
+(ert-deftest files-tests--make-directory ()
+ (let* ((dir (make-temp-file "files-mkdir-test" t))
+ (dirname (file-name-as-directory dir))
+ (file (concat dirname "file"))
+ (subdir1 (concat dirname "subdir1"))
+ (subdir2 (concat dirname "subdir2"))
+ (a/b (concat dirname "a/b")))
+ (write-region "" nil file)
+ (should-error (make-directory "/"))
+ (should-not (make-directory "/" t))
+ (should-error (make-directory dir))
+ (should-not (make-directory dir t))
+ (should-error (make-directory dirname))
+ (should-not (make-directory dirname t))
+ (should-error (make-directory file))
+ (should-error (make-directory file t))
+ (should-not (make-directory subdir1))
+ (should-not (make-directory subdir2 t))
+ (should-error (make-directory a/b))
+ (should-not (make-directory a/b t))
+ (delete-directory dir 'recursive)))
+
+(ert-deftest files-test-no-file-write-contents ()
+ "Test that `write-contents-functions' permits saving a file.
+Usually `basic-save-buffer' will prompt for a file name if the
+current buffer has none. It should first call the functions in
+`write-contents-functions', and if one of them returns non-nil,
+consider the buffer saved, without prompting for a file
+name (Bug#28412)."
+ (let ((read-file-name-function
+ (lambda (&rest _ignore)
+ (error "Prompting for file name"))))
+ ;; With contents function, and no file.
+ (with-temp-buffer
+ (setq write-contents-functions (lambda () t))
+ (set-buffer-modified-p t)
+ (should (null (save-buffer))))
+ ;; With no contents function and no file. This should reach the
+ ;; `read-file-name' prompt.
+ (with-temp-buffer
+ (set-buffer-modified-p t)
+ (should-error (save-buffer) :type 'error))
+ ;; Then a buffer visiting a file: should save normally.
+ (files-tests--with-temp-file temp-file-name
+ (with-current-buffer (find-file-noselect temp-file-name)
+ (setq write-contents-functions nil)
+ (insert "p")
+ (should (null (save-buffer)))
+ (should (eq (buffer-size) 1))))))
+
+(ert-deftest files-tests--copy-directory ()
+ (let* ((dir (make-temp-file "files-mkdir-test" t))
+ (dirname (file-name-as-directory dir))
+ (source (concat dirname "source"))
+ (dest (concat dirname "dest/new/directory/"))
+ (file (concat (file-name-as-directory source) "file"))
+ (source2 (concat dirname "source2"))
+ (dest2 (concat dirname "dest/new2")))
+ (make-directory source)
+ (write-region "" nil file)
+ (copy-directory source dest t t t)
+ (should (file-exists-p (concat dest "file")))
+ (make-directory (concat (file-name-as-directory source2) "a") t)
+ (copy-directory source2 dest2)
+ (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
+ (delete-directory dir 'recursive)))
+
+(ert-deftest files-test-abbreviated-home-dir ()
+ "Test that changing HOME does not confuse `abbreviate-file-name'.
+See <https://debbugs.gnu.org/19657#20>."
+ (let* ((homedir temporary-file-directory)
+ (process-environment (cons (format "HOME=%s" homedir)
+ process-environment))
+ (abbreviated-home-dir nil)
+ (testfile (expand-file-name "foo" homedir))
+ (old (file-truename (abbreviate-file-name testfile)))
+ (process-environment (cons (format "HOME=%s"
+ (expand-file-name "bar" homedir))
+ process-environment)))
+ (should (equal old (file-truename (abbreviate-file-name testfile))))))
+
(provide 'files-tests)
;;; files-tests.el ends here
diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el
index 21d0087ebcf..21cb01c350c 100644
--- a/test/lisp/files-x-tests.el
+++ b/test/lisp/files-x-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el
index 47c49b38c42..c2a41d717cf 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/gnus/gnus-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el
index 40367251420..f905ba3e263 100644
--- a/test/lisp/gnus/message-tests.el
+++ b/test/lisp/gnus/message-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el
index 0ab6c3cae76..6dc5299ef3c 100644
--- a/test/lisp/help-fns-tests.el
+++ b/test/lisp/help-fns-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -40,7 +40,7 @@ Return first line of the output of (describe-function-1 FUNC)."
(match-string-no-properties 1 string)))
(ert-deftest help-fns-test-bug17410 ()
- "Test for http://debbugs.gnu.org/17410 ."
+ "Test for https://debbugs.gnu.org/17410 ."
(let ((regexp "autoloaded Lisp macro")
(result (help-fns-tests--describe-function 'help-fns-test--macro)))
(should (string-match regexp result))))
@@ -76,11 +76,16 @@ Return first line of the output of (describe-function-1 FUNC)."
(should (string-match regexp result))))
(ert-deftest help-fns-test-bug23887 ()
- "Test for http://debbugs.gnu.org/23887 ."
+ "Test for https://debbugs.gnu.org/23887 ."
(let ((regexp "an alias for .re-search-forward. in .subr\.el")
(result (help-fns-tests--describe-function 'search-forward-regexp)))
(should (string-match regexp result))))
+(ert-deftest help-fns-test-dangling-alias ()
+ "Make sure we don't burp on bogus aliases."
+ (let ((f (make-symbol "bogus-alias")))
+ (define-obsolete-function-alias f 'help-fns-test--undefined-function "past")
+ (describe-symbol f)))
;;; Test describe-function over functions with funny names
(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x)
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index 2cb662cfaca..dfe583453ef 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -24,7 +24,7 @@
(require 'hi-lock)
(ert-deftest hi-lock-bug26666 ()
- "Test for http://debbugs.gnu.org/26666 ."
+ "Test for https://debbugs.gnu.org/26666 ."
(let ((faces hi-lock-face-defaults))
(with-temp-buffer
(insert "a A b B\n")
@@ -36,5 +36,17 @@
(hi-lock-set-pattern "a" face))))
(should (equal hi-lock--unused-faces (cdr faces))))))
+(ert-deftest hi-lock-test-set-pattern ()
+ (let ((faces hi-lock-face-defaults))
+ (with-temp-buffer
+ (insert "foo bar")
+ (cl-letf (((symbol-function 'completing-read)
+ (lambda (prompt coll x y z hist defaults)
+ (car defaults))))
+ (hi-lock-set-pattern "9999" (hi-lock-read-face-name)) ; No match
+ (hi-lock-set-pattern "foo" (hi-lock-read-face-name)))
+ ;; Only one match, then we have used just 1 face
+ (should (equal hi-lock--unused-faces (cdr faces))))))
+
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here
diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el
index 4a1d566e96c..0ad775d74a0 100644
--- a/test/lisp/htmlfontify-tests.el
+++ b/test/lisp/htmlfontify-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index b9f7fe7cde8..35605ca28dc 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
@@ -32,7 +32,7 @@
(declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier))
(declare-function ibuffer-unary-operand "ibuf-ext" (filter))
-(ert-deftest ibuffer-autoload ()
+(ert-deftest ibuffer-0autoload () ; sort first
"Tests to see whether ibuffer has been autoloaded"
(skip-unless (not (featurep 'ibuf-ext)))
(should
@@ -43,7 +43,7 @@
'ibuffer-mark-unsaved-buffers))))
(ert-deftest ibuffer-test-Bug24997 ()
- "Test for http://debbugs.gnu.org/24997 ."
+ "Test for https://debbugs.gnu.org/24997 ."
(ibuffer)
(let ((orig ibuffer-filtering-qualifiers))
(unwind-protect
@@ -58,7 +58,7 @@
(ibuffer-update nil t))))
(ert-deftest ibuffer-test-Bug25000 ()
- "Test for http://debbugs.gnu.org/25000 ."
+ "Test for https://debbugs.gnu.org/25000 ."
(let ((case-fold-search t)
(buf1 (generate-new-buffer "ibuffer-test-Bug25000-buf1"))
(buf2 (generate-new-buffer "ibuffer-test-Bug25000-buf2")))
@@ -76,7 +76,7 @@
(ert-deftest ibuffer-save-filters ()
"Tests that `ibuffer-save-filters' saves in the proper format."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(let ((ibuffer-save-with-custom nil)
(ibuffer-saved-filters nil)
(test1 '((mode . org-mode)
@@ -104,7 +104,7 @@
(should (equal (cdr (assoc "test3" ibuffer-saved-filters)) test3))))
(ert-deftest ibuffer-test-Bug25058 ()
- "Test for http://debbugs.gnu.org/25058 ."
+ "Test for https://debbugs.gnu.org/25058 ."
(ibuffer)
(let ((orig-filters ibuffer-saved-filter-groups)
(tmp-filters '(("saved-filters"
@@ -137,7 +137,7 @@
(ert-deftest ibuffer-test-Bug25042 ()
- "Test for http://debbugs.gnu.org/25042 ."
+ "Test for https://debbugs.gnu.org/25042 ."
(ibuffer)
(let ((filters ibuffer-filtering-qualifiers))
(unwind-protect
@@ -150,6 +150,7 @@
;; Test Filter Inclusion
(let* (test-buffer-list ; accumulated buffers to clean up
+ test-file-list
;; Utility functions without polluting the environment
(set-buffer-mode
(lambda (buffer mode)
@@ -192,6 +193,7 @@
(file (make-temp-file prefix nil suffix))
(buf (find-file-noselect file t)))
(push buf test-buffer-list) ; record for cleanup
+ (push file test-file-list)
(funcall set-buffer-mode buf mode)
(funcall set-buffer-contents buf size include)
buf)))
@@ -213,6 +215,8 @@
(clean-up
(lambda ()
"Restore all emacs state modified during the tests"
+ (dolist (f test-file-list)
+ (and f (file-exists-p f) (delete-file f)))
(while test-buffer-list ; created temporary buffers
(let ((buf (pop test-buffer-list)))
(with-current-buffer buf (bury-buffer)) ; ensure not selected
@@ -220,7 +224,7 @@
;; Tests
(ert-deftest ibuffer-filter-inclusion-1 ()
"Tests inclusion using basic filter combinators with a single buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((buf
(funcall create-file-buffer "ibuf-test-1" :size 100
@@ -263,7 +267,7 @@
(ert-deftest ibuffer-filter-inclusion-2 ()
"Tests inclusion of basic filters in combination on a single buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((buf
(funcall create-file-buffer "ibuf-test-2" :size 200
@@ -298,7 +302,7 @@
(ert-deftest ibuffer-filter-inclusion-3 ()
"Tests inclusion with filename filters on specified buffers."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let* ((bufA
(funcall create-file-buffer "ibuf-test-3.a" :size 50
@@ -332,7 +336,7 @@
(ert-deftest ibuffer-filter-inclusion-4 ()
"Tests inclusion with various filters on a single buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((buf
(funcall create-file-buffer "ibuf-test-4"
@@ -366,7 +370,7 @@
(ert-deftest ibuffer-filter-inclusion-5 ()
"Tests inclusion with various filters on a single buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((buf
(funcall create-non-file-buffer "ibuf-test-5.el"
@@ -392,7 +396,7 @@
(ert-deftest ibuffer-filter-inclusion-6 ()
"Tests inclusion using saved filters and DeMorgan's laws."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((buf
(funcall create-non-file-buffer "*ibuf-test-6*" :size 65
@@ -425,7 +429,7 @@
(ert-deftest ibuffer-filter-inclusion-7 ()
"Tests inclusion with various filters on a single buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((buf
(funcall create-non-file-buffer "ibuf-test-7"
@@ -446,17 +450,20 @@
(ert-deftest ibuffer-filter-inclusion-8 ()
"Tests inclusion with various filters."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((bufA
(funcall create-non-file-buffer "ibuf-test-8a"
:mode #'artist-mode))
(bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32))
- (bufC (funcall create-file-buffer "ibuf-test8c" :suffix "*"
- :size 64))
- (bufD (funcall create-file-buffer "*ibuf-test8d" :size 128))
- (bufE (funcall create-file-buffer "*ibuf-test8e" :suffix "*<2>"
- :size 16))
+ (bufC (or (memq system-type '(ms-dos windows-nt))
+ (funcall create-file-buffer "ibuf-test8c" :suffix "*"
+ :size 64)))
+ (bufD (or (memq system-type '(ms-dos windows-nt))
+ (funcall create-file-buffer "*ibuf-test8d" :size 128)))
+ (bufE (or (memq system-type '(ms-dos windows-nt))
+ (funcall create-file-buffer "*ibuf-test8e"
+ :suffix "*<2>" :size 16)))
(bufF (and (funcall create-non-file-buffer "*ibuf-test8f*")
(funcall create-non-file-buffer "*ibuf-test8f*"
:size 8))))
@@ -475,22 +482,28 @@
(name . "test.*8b")
(size-gt . 31)
(not visiting-file)))))
- (should (ibuffer-included-in-filters-p
- bufC '((and (not (starred-name))
- (visiting-file)
- (name . "8c[^*]*\\*")
- (size-lt . 65)))))
- (should (ibuffer-included-in-filters-p
- bufD '((and (not (starred-name))
- (visiting-file)
- (name . "\\`\\*.*test8d")
- (size-lt . 129)
- (size-gt . 127)))))
- (should (ibuffer-included-in-filters-p
- bufE '((and (starred-name)
- (visiting-file)
- (name . "8e.*?\\*<[[:digit:]]+>")
- (size-gt . 10)))))
+ ;; MS-DOS and MS-Windows don't allow "*" in file names.
+ (or (memq system-type '(ms-dos windows-nt))
+ (should (ibuffer-included-in-filters-p
+ bufC '((and (not (starred-name))
+ (visiting-file)
+ (name . "8c[^*]*\\*")
+ (size-lt . 65))))))
+ ;; MS-DOS and MS-Windows don't allow "*" in file names.
+ (or (memq system-type '(ms-dos windows-nt))
+ (should (ibuffer-included-in-filters-p
+ bufD '((and (not (starred-name))
+ (visiting-file)
+ (name . "\\`\\*.*test8d")
+ (size-lt . 129)
+ (size-gt . 127))))))
+ ;; MS-DOS and MS-Windows don't allow "*" in file names.
+ (or (memq system-type '(ms-dos windows-nt))
+ (should (ibuffer-included-in-filters-p
+ bufE '((and (starred-name)
+ (visiting-file)
+ (name . "8e.*?\\*<[[:digit:]]+>")
+ (size-gt . 10))))))
(should (ibuffer-included-in-filters-p
bufF '((and (starred-name)
(not (visiting-file))
@@ -534,7 +547,7 @@
;; Tests
(ert-deftest ibuffer-decompose-filter ()
"Tests `ibuffer-decompose-filter' for and, or, not, and saved."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((ibuf (funcall get-test-ibuffer)))
(with-current-buffer ibuf
@@ -583,7 +596,7 @@
(ert-deftest ibuffer-and-filter ()
"Tests `ibuffer-and-filter' in an Ibuffer buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((ibuf (funcall get-test-ibuffer)))
(with-current-buffer ibuf
@@ -660,7 +673,7 @@
(ert-deftest ibuffer-or-filter ()
"Tests `ibuffer-or-filter' in an Ibuffer buffer."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(unwind-protect
(let ((ibuf (funcall get-test-ibuffer)))
(with-current-buffer ibuf
@@ -737,7 +750,7 @@
(ert-deftest ibuffer-format-qualifier ()
"Tests string recommendation of filter from `ibuffer-format-qualifier'."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(let ((test1 '(mode . org-mode))
(test2 '(size-lt . 100))
(test3 '(derived-mode . prog-mode))
@@ -802,7 +815,7 @@
(ert-deftest ibuffer-unary-operand ()
"Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell."
- (skip-unless (featurep 'ibuf-ext))
+ (require 'ibuf-ext)
(should (equal (ibuffer-unary-operand '(not . (mode "foo")))
'(mode "foo")))
(should (equal (ibuffer-unary-operand '(not (mode "foo")))
diff --git a/test/lisp/ido-tests.el b/test/lisp/ido-tests.el
index df110969312..a325f49c58e 100644
--- a/test/lisp/ido-tests.el
+++ b/test/lisp/ido-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/imenu-tests.el b/test/lisp/imenu-tests.el
index 93090947139..aedc90e84b4 100644
--- a/test/lisp/imenu-tests.el
+++ b/test/lisp/imenu-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 9ae07c33fd9..0a2038a644e 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el
index d7453332437..4265cec14af 100644
--- a/test/lisp/international/mule-tests.el
+++ b/test/lisp/international/mule-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el
index 356ee33232f..01f40a227ca 100644
--- a/test/lisp/international/mule-util-tests.el
+++ b/test/lisp/international/mule-util-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el
index d85efe2d7bf..94bf77633e1 100644
--- a/test/lisp/international/ucs-normalize-tests.el
+++ b/test/lisp/international/ucs-normalize-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -26,15 +26,13 @@
;; If there are lines marked as failing (see
;; `ucs-normalize-tests--failing-lines-part1' and
;; `ucs-normalize-tests--failing-lines-part2'), they may need to be
-;; adjusted when NormalizationTest.txt is updated. To get a list of
-;; currently failing lines, set those 2 variables to nil, run the
-;; tests, and inspect the values of
-;; `ucs-normalize-tests--part1-rule1-failed-lines' and
-;; `ucs-normalize-tests--part1-rule2-failed-chars', respectively.
+;; adjusted when NormalizationTest.txt is updated. Run the function
+;; `ucs-normalize-check-failing-lines' to see what changes are needed.
;;; Code:
(eval-when-compile (require 'cl-lib))
+(require 'seq)
(require 'ert)
(require 'ucs-normalize)
@@ -44,83 +42,98 @@
(defun ucs-normalize-tests--parse-column ()
(let ((chars nil)
(term nil))
- (while (and (not (equal term ";"))
+ (while (and (not (eq term ?\;))
(looking-at "\\([[:xdigit:]]\\{4,6\\}\\)\\([; ]\\)"))
- (let ((code-point (match-string 1)))
- (setq term (match-string 2))
+ (let ((code-point (match-string-no-properties 1)))
+ (setq term (char-after (match-beginning 2)))
(goto-char (match-end 0))
(push (string-to-number code-point 16) chars)))
- (nreverse chars)))
+ (apply #'string (nreverse chars))))
-(defmacro ucs-normalize-tests--normalize (norm str)
+(defconst ucs-normalize-tests--norm-buf (generate-new-buffer " *ucs-normalizing-buffer*"))
+
+(defmacro ucs-normalize-tests--normalization-equal-p (norm str equal-to)
"Like `ucs-normalize-string' but reuse current buffer for efficiency.
And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity."
(let ((norm-alist '((NFC . ucs-normalize-NFC-region)
(NFD . ucs-normalize-NFD-region)
(NFKC . ucs-normalize-NFKC-region)
(NFKD . ucs-normalize-NFKD-region))))
- `(save-restriction
- (narrow-to-region (point) (point))
+ `(with-current-buffer ucs-normalize-tests--norm-buf
+ (erase-buffer)
(insert ,str)
- (funcall #',(cdr (assq norm norm-alist)) (point-min) (point-max))
- (delete-and-extract-region (point-min) (point-max)))))
+ (,(cdr (assq norm norm-alist)) (point-min) (point-max))
+ (goto-char (point-min))
+ (insert ,equal-to)
+ (eq (compare-buffer-substrings nil nil (point) nil (point) nil) 0))))
+
+(defmacro ucs-normalize-tests--normalization-chareq-p (norm char char-eq-to)
+ "Like `ucs-normalize-string' but reuse current buffer for efficiency.
+And NORM is one of the symbols `NFC', `NFD', `NFKC', `NFKD' for brevity."
+ (let ((norm-alist '((NFC . ucs-normalize-NFC-region)
+ (NFD . ucs-normalize-NFD-region)
+ (NFKC . ucs-normalize-NFKC-region)
+ (NFKD . ucs-normalize-NFKD-region))))
+ `(with-current-buffer ucs-normalize-tests--norm-buf
+ (erase-buffer)
+ (insert ,char)
+ (,(cdr (assq norm norm-alist)) (point-min) (point-max))
+ (and (eq (buffer-size) 1)
+ (eq (char-after (point-min)) ,char-eq-to)))))
(defvar ucs-normalize-tests--chars-part1 nil)
-(defun ucs-normalize-tests--invariants-hold-p (&rest columns)
+(defsubst ucs-normalize-tests--rule1-holds-p (source nfc nfd nfkc nfkd)
"Check 1st conformance rule.
The following invariants must be true for all conformant implementations..."
(when ucs-normalize-tests--chars-part1
- ;; See `ucs-normalize-tests--invariants-rule2-hold-p'.
+ ;; See `ucs-normalize-tests--rule2-holds-p'.
(aset ucs-normalize-tests--chars-part1
- (caar columns) 1))
- (cl-destructuring-bind (source nfc nfd nfkc nfkd)
- (mapcar (lambda (c) (apply #'string c)) columns)
- (and
- ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
- (equal nfc (ucs-normalize-tests--normalize NFC source))
- (equal nfc (ucs-normalize-tests--normalize NFC nfc))
- (equal nfc (ucs-normalize-tests--normalize NFC nfd))
- ;; c4 == toNFC(c4) == toNFC(c5)
- (equal nfkc (ucs-normalize-tests--normalize NFC nfkc))
- (equal nfkc (ucs-normalize-tests--normalize NFC nfkd))
-
- ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
- (equal nfd (ucs-normalize-tests--normalize NFD source))
- (equal nfd (ucs-normalize-tests--normalize NFD nfc))
- (equal nfd (ucs-normalize-tests--normalize NFD nfd))
- ;; c5 == toNFD(c4) == toNFD(c5)
- (equal nfkd (ucs-normalize-tests--normalize NFD nfkc))
- (equal nfkd (ucs-normalize-tests--normalize NFD nfkd))
-
- ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5)
- (equal nfkc (ucs-normalize-tests--normalize NFKC source))
- (equal nfkc (ucs-normalize-tests--normalize NFKC nfc))
- (equal nfkc (ucs-normalize-tests--normalize NFKC nfd))
- (equal nfkc (ucs-normalize-tests--normalize NFKC nfkc))
- (equal nfkc (ucs-normalize-tests--normalize NFKC nfkd))
-
- ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5)
- (equal nfkd (ucs-normalize-tests--normalize NFKD source))
- (equal nfkd (ucs-normalize-tests--normalize NFKD nfc))
- (equal nfkd (ucs-normalize-tests--normalize NFKD nfd))
- (equal nfkd (ucs-normalize-tests--normalize NFKD nfkc))
- (equal nfkd (ucs-normalize-tests--normalize NFKD nfkd)))))
-
-(defun ucs-normalize-tests--invariants-rule2-hold-p (char)
+ (aref source 0) 1))
+ (and
+ ;; c2 == toNFC(c1) == toNFC(c2) == toNFC(c3)
+ (ucs-normalize-tests--normalization-equal-p NFC source nfc)
+ (ucs-normalize-tests--normalization-equal-p NFC nfc nfc)
+ (ucs-normalize-tests--normalization-equal-p NFC nfd nfc)
+ ;; c4 == toNFC(c4) == toNFC(c5)
+ (ucs-normalize-tests--normalization-equal-p NFC nfkc nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFC nfkd nfkc)
+
+ ;; c3 == toNFD(c1) == toNFD(c2) == toNFD(c3)
+ (ucs-normalize-tests--normalization-equal-p NFD source nfd)
+ (ucs-normalize-tests--normalization-equal-p NFD nfc nfd)
+ (ucs-normalize-tests--normalization-equal-p NFD nfd nfd)
+ ;; c5 == toNFD(c4) == toNFD(c5)
+ (ucs-normalize-tests--normalization-equal-p NFD nfkc nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFD nfkd nfkd)
+
+ ;; c4 == toNFKC(c1) == toNFKC(c2) == toNFKC(c3) == toNFKC(c4) == toNFKC(c5)
+ (ucs-normalize-tests--normalization-equal-p NFKC source nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfc nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfd nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfkc nfkc)
+ (ucs-normalize-tests--normalization-equal-p NFKC nfkd nfkc)
+
+ ;; c5 == toNFKD(c1) == toNFKD(c2) == toNFKD(c3) == toNFKD(c4) == toNFKD(c5)
+ (ucs-normalize-tests--normalization-equal-p NFKD source nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfc nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfd nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfkc nfkd)
+ (ucs-normalize-tests--normalization-equal-p NFKD nfkd nfkd)))
+
+(defsubst ucs-normalize-tests--rule2-holds-p (X)
"Check 2nd conformance rule.
For every code point X assigned in this version of Unicode that is not specifically
listed in Part 1, the following invariants must be true for all conformant
implementations:
X == toNFC(X) == toNFD(X) == toNFKC(X) == toNFKD(X)"
- (let ((X (string char)))
- (and (equal X (ucs-normalize-tests--normalize NFC X))
- (equal X (ucs-normalize-tests--normalize NFD X))
- (equal X (ucs-normalize-tests--normalize NFKC X))
- (equal X (ucs-normalize-tests--normalize NFKD X)))))
+ (and (ucs-normalize-tests--normalization-chareq-p NFC X X)
+ (ucs-normalize-tests--normalization-chareq-p NFD X X)
+ (ucs-normalize-tests--normalization-chareq-p NFKC X X)
+ (ucs-normalize-tests--normalization-chareq-p NFKD X X)))
-(cl-defun ucs-normalize-tests--invariants-failing-for-part (part &optional skip-lines &key progress-str)
+(cl-defun ucs-normalize-tests--rule1-failing-for-partX (part &optional skip-lines &key progress-str)
"Returns a list of failed line numbers."
(with-temp-buffer
(insert-file-contents ucs-normalize-test-data-file)
@@ -136,8 +149,8 @@ implementations:
progress-str beg-line end-line
0 nil 0.5))
for line from beg-line to (1- end-line)
- unless (or (= (following-char) ?#)
- (ucs-normalize-tests--invariants-hold-p
+ unless (or (eq (following-char) ?#)
+ (ucs-normalize-tests--rule1-holds-p
(ucs-normalize-tests--parse-column)
(ucs-normalize-tests--parse-column)
(ucs-normalize-tests--parse-column)
@@ -148,7 +161,7 @@ implementations:
do (forward-line)
if reporter do (progress-reporter-update reporter line)))))
-(defun ucs-normalize-tests--invariants-failing-for-lines (lines)
+(defun ucs-normalize-tests--rule1-failing-for-lines (lines)
"Returns a list of failed line numbers."
(with-temp-buffer
(insert-file-contents ucs-normalize-test-data-file)
@@ -156,7 +169,7 @@ implementations:
(cl-loop for prev-line = 1 then line
for line in lines
do (forward-line (- line prev-line))
- unless (ucs-normalize-tests--invariants-hold-p
+ unless (ucs-normalize-tests--rule1-holds-p
(ucs-normalize-tests--parse-column)
(ucs-normalize-tests--parse-column)
(ucs-normalize-tests--parse-column)
@@ -165,7 +178,7 @@ implementations:
collect line)))
(ert-deftest ucs-normalize-part0 ()
- (should-not (ucs-normalize-tests--invariants-failing-for-part 0)))
+ (should-not (ucs-normalize-tests--rule1-failing-for-partX 0)))
(defconst ucs-normalize-tests--failing-lines-part1
(list 15131 15132 15133 15134 15135 15136 15137 15138
@@ -195,6 +208,8 @@ implementations:
"A list of line numbers.")
(defvar ucs-normalize-tests--part1-rule2-failed-chars nil
"A list of code points.")
+(defvar ucs-normalize-tests--part2-rule1-failed-lines nil
+ "A list of line numbers.")
(defun ucs-normalize-tests--part1-rule2 (chars-part1)
(let ((reporter (make-progress-reporter "UCS Normalize Test Part1, rule 2"
@@ -204,11 +219,11 @@ implementations:
(lambda (char-range listed-in-part)
(unless (eq listed-in-part 1)
(if (characterp char-range)
- (progn (unless (ucs-normalize-tests--invariants-rule2-hold-p char-range)
+ (progn (unless (ucs-normalize-tests--rule2-holds-p char-range)
(push char-range failed-chars))
(progress-reporter-update reporter char-range))
(cl-loop for char from (car char-range) to (cdr char-range)
- unless (ucs-normalize-tests--invariants-rule2-hold-p char)
+ unless (ucs-normalize-tests--rule2-holds-p char)
do (push char failed-chars)
do (progress-reporter-update reporter char)))))
chars-part1)
@@ -219,59 +234,103 @@ implementations:
:tags '(:expensive-test)
;; This takes a long time, so make sure we're compiled.
(dolist (fun '(ucs-normalize-tests--part1-rule2
- ucs-normalize-tests--invariants-failing-for-part
- ucs-normalize-tests--invariants-hold-p
- ucs-normalize-tests--invariants-rule2-hold-p))
+ ucs-normalize-tests--rule1-failing-for-partX
+ ucs-normalize-tests--rule1-holds-p
+ ucs-normalize-tests--rule2-holds-p))
(or (byte-code-function-p (symbol-function fun))
(byte-compile fun)))
(let ((ucs-normalize-tests--chars-part1 (make-char-table 'ucs-normalize-tests t)))
- (should-not
- (setq ucs-normalize-tests--part1-rule1-failed-lines
- (ucs-normalize-tests--invariants-failing-for-part
- 1 ucs-normalize-tests--failing-lines-part1
- :progress-str "UCS Normalize Test Part1, rule 1")))
- (should-not (setq ucs-normalize-tests--part1-rule2-failed-chars
- (ucs-normalize-tests--part1-rule2
- ucs-normalize-tests--chars-part1)))))
+ (setq ucs-normalize-tests--part1-rule1-failed-lines
+ (ucs-normalize-tests--rule1-failing-for-partX
+ 1 ucs-normalize-tests--failing-lines-part1
+ :progress-str "UCS Normalize Test Part1, rule 1"))
+ (setq ucs-normalize-tests--part1-rule2-failed-chars
+ (ucs-normalize-tests--part1-rule2
+ ucs-normalize-tests--chars-part1))
+ (should-not ucs-normalize-tests--part1-rule1-failed-lines)
+ (should-not ucs-normalize-tests--part1-rule2-failed-chars)))
(ert-deftest ucs-normalize-part1-failing ()
:expected-result :failed
(skip-unless ucs-normalize-tests--failing-lines-part1)
(should-not
- (ucs-normalize-tests--invariants-failing-for-lines
+ (ucs-normalize-tests--rule1-failing-for-lines
ucs-normalize-tests--failing-lines-part1)))
(defconst ucs-normalize-tests--failing-lines-part2
- (list 18328 18330 18332 18334 18336 18338 18340 18342
- 18344 18346 18348 18350 18352 18354 18356 18358
- 18360 18362 18364 18366 18368 18370 18372 18374
- 18376 18378 18380 18382 18384 18386 18388 18390
- 18392 18394 18396 18398 18400 18402 18404 18406
- 18408 18410 18412 18414 18416 18418 18420 18422
- 18424 18426 18494 18496 18498 18500 18502 18504
- 18506 18508 18510 18512 18514 18516 18518 18520
- 18522 18524 18526 18528 18530 18532 18534 18536
- 18538 18540 18542 18544 18546 18548 18550 18552
- 18554 18556 18558 18560 18562 18564 18566 18568
- 18570 18572 18574 18576 18578 18580 18582 18584
- 18586 18588 18590 18592 18594 18596))
+ (list 17656 17658 18006 18007 18008 18009 18010 18011
+ 18012 18340 18342 18344 18346 18348 18350 18352
+ 18354 18356 18358 18360 18362 18364 18366 18368
+ 18370 18372 18374 18376 18378 18380 18382 18384
+ 18386 18388 18390 18392 18394 18396 18398 18400
+ 18402 18404 18406 18408 18410 18412 18414 18416
+ 18418 18420 18422 18424 18426 18428 18430 18432
+ 18434 18436 18438 18440 18442 18444 18446 18448
+ 18450 18518 18520 18522 18524 18526 18528 18530
+ 18532 18534 18536 18538 18540 18542 18544 18546
+ 18548 18550 18552 18554 18556 18558 18560 18562
+ 18564 18566 18568 18570 18572 18574 18576 18578
+ 18580 18582 18584 18586 18588 18590 18592 18594
+ 18596 18598 18600 18602 18604 18606 18608 18610
+ 18612 18614 18616 18618 18620))
(ert-deftest ucs-normalize-part2 ()
:tags '(:expensive-test)
(should-not
- (ucs-normalize-tests--invariants-failing-for-part
- 2 ucs-normalize-tests--failing-lines-part2
- :progress-str "UCS Normalize Test Part2")))
+ (setq ucs-normalize-tests--part2-rule1-failed-lines
+ (ucs-normalize-tests--rule1-failing-for-partX
+ 2 ucs-normalize-tests--failing-lines-part2
+ :progress-str "UCS Normalize Test Part2"))))
(ert-deftest ucs-normalize-part2-failing ()
:expected-result :failed
(skip-unless ucs-normalize-tests--failing-lines-part2)
(should-not
- (ucs-normalize-tests--invariants-failing-for-lines
+ (ucs-normalize-tests--rule1-failing-for-lines
ucs-normalize-tests--failing-lines-part2)))
(ert-deftest ucs-normalize-part3 ()
(should-not
- (ucs-normalize-tests--invariants-failing-for-part 3)))
+ (ucs-normalize-tests--rule1-failing-for-partX 3)))
+
+(defun ucs-normalize-tests--insert-failing-lines (var newval)
+ (insert (format "`%s' should be updated to:\n
+\(defconst %s
+ (list " var var))
+ (dolist (linos (seq-partition newval 8))
+ (insert (mapconcat #'number-to-string linos " ") "\n"))
+ (insert ")\)"))
+
+(defun ucs-normalize-check-failing-lines ()
+ (interactive)
+ (let ((ucs-normalize-tests--failing-lines-part1 nil)
+ (ucs-normalize-tests--failing-lines-part2 nil))
+ (setq ucs-normalize-tests--part1-rule1-failed-lines nil)
+ (setq ucs-normalize-tests--part1-rule2-failed-chars nil)
+ (setq ucs-normalize-tests--part2-rule1-failed-lines nil)
+ (ert "\\`ucs-normalize"))
+
+ (with-current-buffer (get-buffer-create "*ucs normalize change bad lines*")
+ (erase-buffer)
+ (unless (equal ucs-normalize-tests--part1-rule1-failed-lines
+ ucs-normalize-tests--failing-lines-part1)
+ (ucs-normalize-tests--insert-failing-lines
+ 'ucs-normalize-tests--failing-lines-part1
+ ucs-normalize-tests--part1-rule1-failed-lines))
+
+ (when ucs-normalize-tests--part1-rule2-failed-chars
+ (insert (format "Some characters failed rule 2!\n\n%S"
+ `(list ,@ucs-normalize-tests--part1-rule2-failed-chars))))
+
+ (unless (equal ucs-normalize-tests--part2-rule1-failed-lines
+ ucs-normalize-tests--failing-lines-part2)
+ (ucs-normalize-tests--insert-failing-lines
+ 'ucs-normalize-tests--failing-lines-part2
+ ucs-normalize-tests--part2-rule1-failed-lines))
+ (if (> (buffer-size) 0)
+ (if noninteractive
+ (princ (buffer-string) standard-output)
+ (display-buffer (current-buffer)))
+ (message "No changes to failing lines needed"))))
;;; ucs-normalize-tests.el ends here
diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el
index e5cae8237e1..b2981c0cc08 100644
--- a/test/lisp/isearch-tests.el
+++ b/test/lisp/isearch-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el
index 22d1e015db4..5847eac6998 100644
--- a/test/lisp/jit-lock-tests.el
+++ b/test/lisp/jit-lock-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index c6bd295d667..fe5f466bd76 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -75,7 +75,7 @@ Point is moved to beginning of the buffer."
(ert-deftest test-json-peek ()
(json-tests--with-temp-buffer ""
- (should (eq (json-peek) :json-eof)))
+ (should (zerop (json-peek))))
(json-tests--with-temp-buffer "{ \"a\": 1 }"
(should (equal (json-peek) ?{))))
@@ -164,6 +164,8 @@ Point is moved to beginning of the buffer."
(should (equal (json-read-escaped-char) ?\"))))
(ert-deftest test-json-read-string ()
+ (json-tests--with-temp-buffer "\"formfeed\f\""
+ (should-error (json-read-string) :type 'json-string-format))
(json-tests--with-temp-buffer "\"foo \\\"bar\\\"\""
(should (equal (json-read-string) "foo \"bar\"")))
(json-tests--with-temp-buffer "\"abcαβγ\""
diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el
index 04a4271734c..690d5029231 100644
--- a/test/lisp/kmacro-tests.el
+++ b/test/lisp/kmacro-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -248,7 +248,7 @@ cause the current test to fail."
(kmacro-tests-simulate-command '(kmacro-set-counter 1))
(kmacro-tests-should-insert "1"
(kmacro-tests-simulate-command '(kmacro-insert-counter nil)))
- ;; Using universal arg to to set counter should reset to starting value.
+ ;; Using universal arg to set counter should reset to starting value.
(kmacro-tests-simulate-command '(kmacro-set-counter (4)) '(4))
(kmacro-tests-should-insert "5"
(kmacro-tests-simulate-command '(kmacro-insert-counter nil))))
@@ -818,7 +818,6 @@ This is a regression for item 7 in Bug#24991."
(kmacro-tests-deftest kmacro-tests-step-edit-cleans-up-hook ()
"Step-editing properly cleans up `post-command-hook.' (Bug #18708)"
- (:expected-result :failed)
(let (post-command-hook)
(setq-local post-command-hook '(t))
(kmacro-tests-run-step-edit "x"
diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el
new file mode 100644
index 00000000000..8e419d59bf4
--- /dev/null
+++ b/test/lisp/ls-lisp-tests.el
@@ -0,0 +1,94 @@
+;;; ls-lisp-tests.el --- tests for ls-lisp.el -*- lexical-binding: t-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <tino.calancha@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (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 'ls-lisp)
+
+(ert-deftest ls-lisp-unload ()
+ "Test for https://debbugs.gnu.org/xxxxx ."
+ (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory))
+ (unload-feature 'ls-lisp 'force)
+ (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))
+ (require 'ls-lisp))
+
+(ert-deftest ls-lisp-test-bug27762 ()
+ "Test for https://debbugs.gnu.org/27762 ."
+ (let* ((dir source-directory)
+ (default-directory dir)
+ (files (mapcar (lambda (f) (concat "src/" f))
+ (directory-files
+ (expand-file-name "src") nil "\\.*\\.c\\'")))
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (let ((file1 "src/cygw32.c")
+ (file2 "src/atimer.c"))
+ (setq buf (dired (nconc (list dir) files)))
+ (dired-goto-file (expand-file-name file2 default-directory))
+ (should-not (looking-at "^ -")) ; Must be 2 spaces not 3.
+ (setq files (cons file1 (delete file1 files)))
+ (kill-buffer buf)
+ (setq buf (dired (nconc (list dir) files)))
+ (should (looking-at "src"))
+ (next-line) ; File names must be aligned.
+ (should (looking-at "src")))
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest ls-lisp-test-bug27631 ()
+ "Test for https://debbugs.gnu.org/27631 ."
+ (let* ((dir (make-temp-file "bug27631" 'dir))
+ (dir1 (expand-file-name "dir1" dir))
+ (dir2 (expand-file-name "dir2" dir))
+ (default-directory dir)
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (progn
+ (make-directory dir1)
+ (make-directory dir2)
+ (with-temp-file (expand-file-name "a.txt" dir1))
+ (with-temp-file (expand-file-name "b.txt" dir2))
+ (setq buf (dired (expand-file-name "dir*/*.txt" dir)))
+ (dired-toggle-marks)
+ (should (cdr (dired-get-marked-files))))
+ (delete-directory dir 'recursive)
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(ert-deftest ls-lisp-test-bug27693 ()
+ "Test for https://debbugs.gnu.org/27693 ."
+ (let ((dir (expand-file-name "lisp" source-directory))
+ (size "")
+ ls-lisp-use-insert-directory-program buf)
+ (unwind-protect
+ (progn
+ (setq buf (dired (list dir "simple.el" "subr.el"))
+ size (number-to-string
+ (file-attribute-size
+ (file-attributes (dired-get-filename)))))
+ (search-backward-regexp size nil t)
+ (should (looking-back "[[:space:]]" (1- (point)))))
+ (when (buffer-live-p buf) (kill-buffer buf)))))
+
+(provide 'ls-lisp-tests)
+;;; ls-lisp-tests.el ends here
diff --git a/test/lisp/mail/rmail-tests.el b/test/lisp/mail/rmail-tests.el
index 6cf9053bc0d..b0b86764226 100644
--- a/test/lisp/mail/rmail-tests.el
+++ b/test/lisp/mail/rmail-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el
index b9f47f50c20..9294994892d 100644
--- a/test/lisp/man-tests.el
+++ b/test/lisp/man-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/md4-tests.el b/test/lisp/md4-tests.el
index 169ed83448f..42b13c9d2a1 100644
--- a/test/lisp/md4-tests.el
+++ b/test/lisp/md4-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 7c5fcb4838f..2d2ac85e3ff 100644
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -42,5 +42,37 @@
(should (equal (buffer-string)
"test: "))))))
+(ert-deftest completion-table-with-predicate-test ()
+ (let ((full-collection
+ '("apple" ; Has A.
+ "beet" ; Has B.
+ "banana" ; Has A & B.
+ "cherry" ; Has neither.
+ ))
+ (no-A (lambda (x) (not (string-match-p "a" x))))
+ (no-B (lambda (x) (not (string-match-p "b" x)))))
+ (should
+ (member "cherry"
+ (completion-table-with-predicate
+ full-collection no-A t "" no-B t)))
+ (should-not
+ (member "banana"
+ (completion-table-with-predicate
+ full-collection no-A t "" no-B t)))
+ ;; "apple" should still match when strict is nil.
+ (should (eq t (try-completion
+ "apple"
+ (apply-partially
+ 'completion-table-with-predicate
+ full-collection no-A nil)
+ no-B)))
+ ;; "apple" should still match when strict is nil and pred2 is nil
+ ;; (Bug#27841).
+ (should (eq t (try-completion
+ "apple"
+ (apply-partially
+ 'completion-table-with-predicate
+ full-collection no-A nil))))))
+
(provide 'completion-tests)
;;; completion-tests.el ends here
diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el
index a8eca28365e..f8c91004ecc 100644
--- a/test/lisp/mouse-tests.el
+++ b/test/lisp/mouse-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 0a59e3b42d1..cdae9cce456 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Code:
diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el
new file mode 100644
index 00000000000..fd0b5decb8c
--- /dev/null
+++ b/test/lisp/net/gnutls-tests.el
@@ -0,0 +1,295 @@
+;;; gnutls-tests.el --- Test suite for gnutls.el
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Ted Zlatanov <tzz@lifelogs.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Run this with `GNUTLS_TEST_VERBOSE=1' to get verbose debugging.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl)
+(require 'gnutls)
+(require 'hex-util)
+
+(defvar gnutls-tests-message-prefix "")
+
+(defsubst gnutls-tests-message (format-string &rest args)
+ (when (getenv "GNUTLS_TEST_VERBOSE")
+ (apply #'message (concat "gnutls-tests: " gnutls-tests-message-prefix format-string) args)))
+
+;; Minor convenience to see strings more easily (without binary data).
+(defsubst gnutls-tests-hexstring-equal (a b)
+ (and (stringp a) (stringp b) (string-equal (encode-hex-string a) (encode-hex-string b))))
+
+(defvar gnutls-tests-internal-macs-upcased
+ (mapcar (lambda (sym) (cons sym (intern (upcase (symbol-name sym)))))
+ (secure-hash-algorithms)))
+
+(defvar gnutls-tests-tested-macs
+ (when (gnutls-available-p)
+ (remove-duplicates
+ (append (mapcar 'cdr gnutls-tests-internal-macs-upcased)
+ (mapcar 'car (gnutls-macs))))))
+
+(defvar gnutls-tests-tested-digests
+ (when (gnutls-available-p)
+ (remove-duplicates
+ (append (mapcar 'cdr gnutls-tests-internal-macs-upcased)
+ (mapcar 'car (gnutls-digests))))))
+
+(defvar gnutls-tests-tested-ciphers
+ (when (gnutls-available-p)
+ (remove-duplicates
+ ; these cause FPEs or SEGVs
+ (remove-if (lambda (e) (memq e '(ARCFOUR-128)))
+ (mapcar 'car (gnutls-ciphers))))))
+
+(defvar gnutls-tests-mondo-strings
+ (list
+ ""
+ "some data"
+ "lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data "
+ "data and more data to go over the block limit!"
+ "data and more data to go over the block limit"
+ (format "some random data %d%d" (random) (random))))
+
+(ert-deftest test-gnutls-000-availability ()
+ "Test the GnuTLS hashes and ciphers availability."
+ (skip-unless (memq 'gnutls3 (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "availability: ")
+ (should (> (length gnutls-tests-internal-macs-upcased) 5))
+ (let ((macs (gnutls-macs))
+ (digests (gnutls-digests))
+ (ciphers (gnutls-ciphers)))
+ (dolist (mac gnutls-tests-tested-macs)
+ (let ((plist (cdr (assq mac macs))))
+ (gnutls-tests-message "MAC %s %S" mac plist)
+ (dolist (prop '(:mac-algorithm-id :mac-algorithm-length :mac-algorithm-keysize :mac-algorithm-noncesize))
+ (should (plist-get plist prop)))
+ (should (eq 'gnutls-mac-algorithm (plist-get plist :type)))))
+ (dolist (digest gnutls-tests-tested-digests)
+ (let ((plist (cdr (assq digest digests))))
+ (gnutls-tests-message "digest %s %S" digest plist)
+ (dolist (prop '(:digest-algorithm-id :digest-algorithm-length))
+ (should (plist-get plist prop)))
+ (should (eq 'gnutls-digest-algorithm (plist-get plist :type)))))
+ (dolist (cipher gnutls-tests-tested-ciphers)
+ (let ((plist (cdr (assq cipher ciphers))))
+ (gnutls-tests-message "cipher %s %S" cipher plist)
+ (dolist (prop '(:cipher-id :cipher-blocksize :cipher-keysize :cipher-ivsize))
+ (should (plist-get plist prop)))
+ (should (eq 'gnutls-symmetric-cipher (plist-get plist :type)))))))
+
+(ert-deftest test-gnutls-000-data-extractions ()
+ "Test the GnuTLS data extractions against the built-in `secure-hash'."
+ (skip-unless (memq 'digests (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "data extraction: ")
+ (dolist (input gnutls-tests-mondo-strings)
+ ;; Test buffer extraction
+ (with-temp-buffer
+ (insert input)
+ (insert "not ASCII: не e английски")
+ (dolist (step '(0 1 2 3 4 5))
+ (let ((spec (list (current-buffer) ; a buffer spec
+ (point-min)
+ (max (point-min) (- step (point-max)))))
+ (spec2 (list (buffer-string) ; a string spec
+ (point-min)
+ (max (point-min) (- step (point-max))))))
+ (should (gnutls-tests-hexstring-equal
+ (gnutls-hash-digest 'MD5 spec)
+ (apply 'secure-hash 'md5 (append spec '(t)))))
+ (should (gnutls-tests-hexstring-equal
+ (gnutls-hash-digest 'MD5 spec2)
+ (apply 'secure-hash 'md5 (append spec2 '(t))))))))))
+
+(ert-deftest test-gnutls-001-hashes-internal-digests ()
+ "Test the GnuTLS hash digests against the built-in `secure-hash'."
+ (skip-unless (memq 'digests (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "digest internal verification: ")
+ (let ((macs (gnutls-macs)))
+ (dolist (mcell gnutls-tests-internal-macs-upcased)
+ (let ((plist (cdr (assq (cdr mcell) macs))))
+ (gnutls-tests-message "Checking digest MAC %S %S" mcell plist)
+ (dolist (input gnutls-tests-mondo-strings)
+ ;; Test buffer extraction
+ (with-temp-buffer
+ (insert input)
+ (should (gnutls-tests-hexstring-equal
+ (gnutls-hash-digest (cdr mcell) (current-buffer))
+ (secure-hash (car mcell) (current-buffer) nil nil t))))
+ (should (gnutls-tests-hexstring-equal
+ (gnutls-hash-digest (cdr mcell) input)
+ (secure-hash (car mcell) input nil nil t))))))))
+
+(ert-deftest test-gnutls-002-hashes-digests ()
+ "Test some GnuTLS hash digests against pre-defined outputs."
+ (skip-unless (memq 'digests (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "digest external verification: ")
+ (let ((macs (gnutls-macs)))
+ (dolist (test '(("57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" MD5)
+ ("d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" MD5)
+ ("c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz" MD5)
+ ("f96b697d7cb7938d525a2f31aaf161d0" "message digest" MD5)
+ ("900150983cd24fb0d6963f7d28e17f72" "abc" MD5)
+ ("0cc175b9c0f1b6a831c399e269772661" "a" MD5)
+ ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" SHA1)
+ ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" "SHA1"))) ; check string ID for digest
+ (destructuring-bind (hash input mac) test
+ (let ((plist (cdr (assq mac macs)))
+ result resultb)
+ (gnutls-tests-message "%s %S" mac plist)
+ (setq result (encode-hex-string (gnutls-hash-digest mac input)))
+ (gnutls-tests-message "%S => result %S" test result)
+ (should (string-equal result hash))
+ ;; Test buffer extraction
+ (with-temp-buffer
+ (insert input)
+ (setq resultb (encode-hex-string (gnutls-hash-digest mac (current-buffer))))
+ (gnutls-tests-message "%S => result from buffer %S" test resultb)
+ (should (string-equal resultb hash))))))))
+
+(ert-deftest test-gnutls-003-hashes-hmacs ()
+ "Test some predefined GnuTLS HMAC outputs for SHA256."
+ (skip-unless (memq 'macs (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "HMAC verification: ")
+ (let ((macs (gnutls-macs)))
+ (dolist (test '(("f5c5021e60d9686fef3bb0414275fe4163bece61d9a95fec7a273746a437b986" "hello\n" "test" SHA256)
+ ("46b75292b81002fd873e89c532a1b8545d6efc9822ee938feba6de2723161a67" "more and more data goes into a file to exceed the buffer size" "test" SHA256)
+ ("81568ba71fa2c5f33cc84bf362466988f98eba3735479100b4e8908acad87ac4" "more and more data goes into a file to exceed the buffer size" "very long key goes here to exceed the key size" SHA256)
+ ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" "SHA256") ; check string ID for HMAC
+ ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" SHA256)))
+ (destructuring-bind (hash input key mac) test
+ (let ((plist (cdr (assq mac macs)))
+ result)
+ (gnutls-tests-message "%s %S" mac plist)
+ (setq result (encode-hex-string (gnutls-hash-mac mac (copy-sequence key) input)))
+ (gnutls-tests-message "%S => result %S" test result)
+ (should (string-equal result hash)))))))
+
+
+(defun gnutls-tests-pad-or-trim (s exact)
+ "Pad or trim string S to EXACT numeric size."
+ (if (and (consp s) (eq 'iv-auto (nth 0 s)))
+ s
+ (let ((e (number-to-string exact)))
+ (format (concat "%" e "." e "s") s))))
+
+(defun gnutls-tests-pad-to-multiple (s blocksize)
+ "Pad string S to BLOCKSIZE numeric size."
+ (let* ((e (if (string= s "")
+ blocksize
+ (* blocksize (ceiling (length s) blocksize))))
+ (out (concat s (make-string (- e (length s)) ? ))))
+ ;; (gnutls-tests-message "padding %S to length %d for blocksize %d: => %S" s e blocksize out)
+ out))
+
+;; ;;; Testing from the command line:
+;; ;;; echo e36a9d13c15a6df23a59a6337d6132b8f7cd5283cb4784b81141b52343a18e5f5e5ee8f5553c23167409dd222478bc30 | perl -lne 'print pack "H*", $_' | openssl enc -aes-128-ctr -d -nosalt -K 6d796b657932 -iv 696e697432 | od -x
+(ert-deftest test-gnutls-004-symmetric-ciphers ()
+ "Test the GnuTLS symmetric ciphers"
+ (skip-unless (memq 'ciphers (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "symmetric cipher verification: ")
+ ;; we expect at least 10 ciphers
+ (should (> (length (gnutls-ciphers)) 10))
+ (let ((keys '("mykey" "mykey2"))
+ (inputs gnutls-tests-mondo-strings)
+ (ivs '("" "-abc123-" "init" "ini2"))
+ (ciphers (remove-if
+ (lambda (c) (plist-get (cdr (assq c (gnutls-ciphers)))
+ :cipher-aead-capable))
+ gnutls-tests-tested-ciphers)))
+
+ (dolist (cipher ciphers)
+ (dolist (iv ivs)
+ (dolist (input inputs)
+ (dolist (key keys)
+ (gnutls-tests-message "%S, starting key %S IV %S input %S" (assq cipher (gnutls-ciphers)) key iv input)
+ (let* ((cplist (cdr (assq cipher (gnutls-ciphers))))
+ (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize)))
+ (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize)))
+ (iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize)))
+ (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input))
+ (data (nth 0 output))
+ (actual-iv (nth 1 output))
+ (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data))
+ (reverse (nth 0 reverse-output)))
+ (gnutls-tests-message "%s %S" cipher cplist)
+ (gnutls-tests-message "key %S IV %S input %S => hexdata %S and reverse %S" key iv input (encode-hex-string data) reverse)
+ (should-not (gnutls-tests-hexstring-equal input data))
+ (should-not (gnutls-tests-hexstring-equal data reverse))
+ (should (gnutls-tests-hexstring-equal input reverse)))))))))
+
+(ert-deftest test-gnutls-005-aead-ciphers ()
+ "Test the GnuTLS AEAD ciphers"
+ (skip-unless (memq 'AEAD-ciphers (gnutls-available-p)))
+ (setq gnutls-tests-message-prefix "AEAD verification: ")
+ (let ((keys '("mykey" "mykey2"))
+ (inputs gnutls-tests-mondo-strings)
+ (ivs '("" "-abc123-" "init" "ini2"))
+ (auths '(nil
+ ""
+ "auth data"
+ "auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data "
+ "AUTH data and more data to go over the block limit!"
+ "AUTH data and more data to go over the block limit"))
+ (ciphers (remove-if
+ (lambda (c) (or (null (plist-get (cdr (assq c (gnutls-ciphers)))
+ :cipher-aead-capable))))
+ gnutls-tests-tested-ciphers))
+ actual-ivlist)
+
+ (dolist (cipher ciphers)
+ (dolist (input inputs)
+ (dolist (auth auths)
+ (dolist (key keys)
+ (let* ((cplist (cdr (assq cipher (gnutls-ciphers))))
+ (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize)))
+ (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize)))
+ (ivsize (plist-get cplist :cipher-ivsize)))
+ (should (>= ivsize 12)) ; as per the RFC
+ (dolist (iv (append ivs (list (list 'iv-auto ivsize))))
+
+ (gnutls-tests-message "%S, starting key %S IV %S input %S auth %S" (assq cipher (gnutls-ciphers)) key iv input auth)
+ (let* ((iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize)))
+ (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input (copy-sequence auth)))
+ (data (nth 0 output))
+ (actual-iv (nth 1 output))
+ (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data auth))
+ (reverse (nth 0 reverse-output)))
+ ;; GNUTLS_RND_NONCE should be good enough to ensure this.
+ (should-not (member (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist))
+ (cond
+ ((stringp iv)
+ (should (equal iv actual-iv)))
+ ((consp iv)
+ (push (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist)
+ (gnutls-tests-message "IV list length: %d" (length actual-ivlist))))
+
+ (gnutls-tests-message "%s %S" cipher cplist)
+ (gnutls-tests-message "key %S IV %S input %S auth %S => hexdata %S and reverse %S" key iv input auth (encode-hex-string data) reverse)
+ (should-not (gnutls-tests-hexstring-equal input data))
+ (should-not (gnutls-tests-hexstring-equal data reverse))
+ (should (gnutls-tests-hexstring-equal input reverse)))))))))))
+
+(provide 'gnutls-tests)
+;;; gnutls-tests.el ends here
diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
new file mode 100644
index 00000000000..cbeb61acfeb
--- /dev/null
+++ b/test/lisp/net/mailcap-tests.el
@@ -0,0 +1,69 @@
+;;; mailcap-tests.el --- tests for mailcap.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Mark Oteiza <mvoteiza@udel.edu>
+
+;; 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 'mailcap)
+
+(defconst mailcap-tests-data-dir
+ (expand-file-name "test/data/mailcap" source-directory))
+
+(defconst mailcap-tests-path
+ (expand-file-name "mime.types" mailcap-tests-data-dir)
+ "String used as PATH argument of `mailcap-parse-mimetypes'.")
+
+(defconst mailcap-tests-mime-extensions (copy-alist mailcap-mime-extensions))
+
+(defconst mailcap-tests-path-extensions
+ '((".wav" . "audio/x-wav")
+ (".flac" . "audio/flac")
+ (".opus" . "audio/ogg"))
+ "Alist of MIME associations in `mailcap-tests-path'.")
+
+(ert-deftest mailcap-mimetypes-parsed-p ()
+ (should (null mailcap-mimetypes-parsed-p)))
+
+(ert-deftest mailcap-parse-empty-path ()
+ "If PATH is empty, this should be a noop."
+ (mailcap-parse-mimetypes "file/that/should/not/exist" t)
+ (should mailcap-mimetypes-parsed-p)
+ (should (equal mailcap-mime-extensions mailcap-tests-mime-extensions)))
+
+(ert-deftest mailcap-parse-path ()
+ (let ((mimetypes (getenv "MIMETYPES")))
+ (unwind-protect
+ (progn
+ (setenv "MIMETYPES" mailcap-tests-path)
+ (mailcap-parse-mimetypes nil t))
+ (setenv "MIMETYPES" mimetypes)))
+ (should (equal mailcap-mime-extensions
+ (append mailcap-tests-path-extensions
+ mailcap-tests-mime-extensions)))
+ ;; Already parsed this, should be a noop
+ (mailcap-parse-mimetypes mailcap-tests-path)
+ (should (equal mailcap-mime-extensions
+ (append mailcap-tests-path-extensions
+ mailcap-tests-mime-extensions))))
+
+;;; mailcap-tests.el ends here
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index e7bb3e8ccf9..e0ecfca4a89 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -280,8 +280,11 @@
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
- (while (eq (process-status proc) 'connect)
- (sit-for 0.1)))
+ (setq times 0)
+ (while (and (eq (process-status proc) 'connect)
+ (< (setq times (1+ times)) 10))
+ (sit-for 0.1))
+ (skip-unless (not (eq (process-status proc) 'connect))))
(if (process-live-p server) (delete-process server)))
(setq status (gnutls-peer-status proc))
(should (consp status))
diff --git a/test/lisp/net/newsticker-tests.el b/test/lisp/net/newsticker-tests.el
index 56064f781de..def7c2aebce 100644
--- a/test/lisp/net/newsticker-tests.el
+++ b/test/lisp/net/newsticker-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el
index b06364e3b37..3f69b60a3b3 100644
--- a/test/lisp/net/puny-tests.el
+++ b/test/lisp/net/puny-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el
index 96cec77c56d..4fb6f6cfefd 100644
--- a/test/lisp/net/sasl-scram-rfc-tests.el
+++ b/test/lisp/net/sasl-scram-rfc-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el
index c82338af73e..3a30141668f 100644
--- a/test/lisp/net/shr-tests.el
+++ b/test/lisp/net/shr-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index a90e3fff355..5699ab4b237 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -53,6 +53,8 @@
(defvar tramp-copy-size-limit)
(defvar tramp-persistency-file-name)
(defvar tramp-remote-process-environment)
+;; Suppress nasty messages.
+(fset 'shell-command-sentinel 'ignore)
;; There is no default value on w32 systems, which could work out of the box.
(defconst tramp-test-temporary-file-directory
@@ -70,6 +72,10 @@
(add-to-list
'tramp-default-host-alist
`("\\`mock\\'" nil ,(system-name)))
+ ;; Emacs' Makefile sets $HOME to a nonexistent value. Needed in
+ ;; batch mode only, therefore.
+ (unless (and (null noninteractive) (file-directory-p "~/"))
+ (setenv "HOME" temporary-file-directory))
(format "/mock::%s" temporary-file-directory)))
"Temporary directory for Tramp tests.")
@@ -80,8 +86,8 @@
tramp-message-show-message nil
tramp-persistency-file-name nil)
-;; This shall happen on hydra only.
-(when (getenv "NIX_STORE")
+;; This should happen on hydra only.
+(when (getenv "EMACS_HYDRA_CI")
(add-to-list 'tramp-remote-path 'tramp-own-remote-path))
(defvar tramp--test-expensive-test
@@ -117,38 +123,62 @@ being the result.")
(cdr tramp--test-enabled-checked))
(defun tramp--test-make-temp-name (&optional local quoted)
- "Create a temporary file name for test.
-If LOCAL is non-nil, a local file is created.
-If QUOTED is non-nil, the local part of the file is quoted."
+ "Return a temporary file name for test.
+If LOCAL is non-nil, a local file name is returned.
+If QUOTED is non-nil, the local part of the file name is quoted.
+The temporary file is not created."
(funcall
(if quoted 'tramp-compat-file-name-quote 'identity)
(expand-file-name
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory))))
-(defmacro tramp--instrument-test-case (verbose &rest body)
+;; Don't print messages in nested `tramp--test-instrument-test-case' calls.
+(defvar tramp--test-instrument-test-case-p nil
+ "Whether `tramp--test-instrument-test-case' run.
+This shall used dynamically bound only.")
+
+(defmacro tramp--test-instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
-Print the the content of the Tramp debug buffer, if BODY does not
+Print the content of the Tramp debug buffer, if BODY does not
eval properly in `should' or `should-not'. `should-error' is not
handled properly. BODY shall not contain a timeout."
(declare (indent 1) (debug (natnump body)))
- `(let ((tramp-verbose ,verbose)
+ `(let ((tramp-verbose (max (or ,verbose 0) (or tramp-verbose 0)))
+ (tramp-message-show-message t)
(tramp-debug-on-error t)
(debug-ignored-errors
- (cons "^make-symbolic-link not supported$" debug-ignored-errors)))
+ (cons "^make-symbolic-link not supported$" debug-ignored-errors))
+ inhibit-message)
(unwind-protect
- (progn ,@body)
- (when (> tramp-verbose 3)
+ (let ((tramp--test-instrument-test-case-p t)) ,@body)
+ ;; Unwind forms.
+ (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3))
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
(with-current-buffer (tramp-get-debug-buffer v)
(message "%s" (buffer-string))))))))
+(defsubst tramp--test-message (fmt-string &rest arguments)
+ "Emit a message into ERT *Messages*."
+ (tramp--test-instrument-test-case 0
+ (apply
+ 'tramp-message
+ (tramp-dissect-file-name tramp-test-temporary-file-directory) 0
+ fmt-string arguments)))
+
+(defsubst tramp--test-backtrace ()
+ "Dump a backtrace into ERT *Messages*."
+ (tramp--test-instrument-test-case 10
+ (tramp-backtrace
+ (tramp-dissect-file-name tramp-test-temporary-file-directory))))
+
(ert-deftest tramp-test00-availability ()
"Test availability of Tramp functions."
:expected-result (if (tramp--test-enabled) :passed :failed)
- (message "Remote directory: `%s'" tramp-test-temporary-file-directory)
+ (tramp--test-message
+ "Remote directory: `%s'" tramp-test-temporary-file-directory)
(should (ignore-errors
(and
(file-remote-p tramp-test-temporary-file-directory)
@@ -1655,6 +1685,10 @@ This checks also `file-name-as-directory', `file-name-directory',
"/method:host:/path/to/file"))
(should
(string-equal
+ (directory-file-name "/method:host:/path/to/file//")
+ "/method:host:/path/to/file"))
+ (should
+ (string-equal
(file-name-as-directory "/method:host:/path/to/file")
"/method:host:/path/to/file/"))
(should
@@ -1731,7 +1765,13 @@ This checks also `file-name-as-directory', `file-name-directory',
(tramp-copy-size-limit 4)
(tramp-inline-compress-start-size 2))
(delete-file tmp-name2)
- (should (setq tmp-name2 (file-local-copy tmp-name1)))))
+ (should (setq tmp-name2 (file-local-copy tmp-name1))))
+ ;; Error case.
+ (delete-file tmp-name1)
+ (delete-file tmp-name2)
+ (should-error
+ (setq tmp-name2 (file-local-copy tmp-name1))
+ :type tramp-file-missing))
;; Cleanup.
(ignore-errors
@@ -1745,19 +1785,23 @@ This checks also `file-name-as-directory', `file-name-directory',
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted)))
(unwind-protect
- (progn
+ (with-temp-buffer
(write-region "foo" nil tmp-name)
- (with-temp-buffer
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foo"))
- (insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "foofoo"))
- ;; Insert partly.
- (insert-file-contents tmp-name nil 1 3)
- (should (string-equal (buffer-string) "oofoofoo"))
- ;; Replace.
- (insert-file-contents tmp-name nil nil nil 'replace)
- (should (string-equal (buffer-string) "foo"))))
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "foo"))
+ (insert-file-contents tmp-name)
+ (should (string-equal (buffer-string) "foofoo"))
+ ;; Insert partly.
+ (insert-file-contents tmp-name nil 1 3)
+ (should (string-equal (buffer-string) "oofoofoo"))
+ ;; Replace.
+ (insert-file-contents tmp-name nil nil nil 'replace)
+ (should (string-equal (buffer-string) "foo"))
+ ;; Error case.
+ (delete-file tmp-name)
+ (should-error
+ (insert-file-contents tmp-name)
+ :type tramp-file-missing))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
@@ -1816,7 +1860,20 @@ This checks also `file-name-as-directory', `file-name-directory',
(write-region 3 5 tmp-name))
(with-temp-buffer
(insert-file-contents tmp-name)
- (should (string-equal (buffer-string) "34"))))
+ (should (string-equal (buffer-string) "34")))
+
+ ;; Do not overwrite if excluded.
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t)))
+ (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
+ ;; `mustbenew' is passed to Tramp since Emacs 26.1.
+ (when (tramp--test-emacs26-p)
+ (should-error
+ (cl-letf (((symbol-function 'y-or-n-p) 'ignore))
+ (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
+ :type 'file-already-exists)
+ (should-error
+ (write-region "foo" nil tmp-name nil nil nil 'excl)
+ :type 'file-already-exists)))
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
@@ -1825,80 +1882,103 @@ This checks also `file-name-as-directory', `file-name-directory',
"Check `copy-file'."
(skip-unless (tramp--test-enabled))
- ;; TODO: The quoted case does not work.
+ ;; TODO: The quoted case does not work. Copy local file to remote.
;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
(let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
- (tmp-name3 (tramp--test-make-temp-name nil quoted))
- (tmp-name4 (tramp--test-make-temp-name 'local quoted))
- (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
-
- ;; Copy on remote side.
- (unwind-protect
- (progn
- (write-region "foo" nil tmp-name1)
- (copy-file tmp-name1 tmp-name2)
- (should (file-exists-p tmp-name2))
- (with-temp-buffer
- (insert-file-contents tmp-name2)
- (should (string-equal (buffer-string) "foo")))
- (should-error (copy-file tmp-name1 tmp-name2))
- (copy-file tmp-name1 tmp-name2 'ok)
- (make-directory tmp-name3)
- (copy-file tmp-name1 tmp-name3)
- (should
- (file-exists-p
- (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
-
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-file tmp-name2))
- (ignore-errors (delete-directory tmp-name3 'recursive)))
-
- ;; Copy from remote side to local side.
- (unwind-protect
- (progn
- (write-region "foo" nil tmp-name1)
- (copy-file tmp-name1 tmp-name4)
- (should (file-exists-p tmp-name4))
- (with-temp-buffer
- (insert-file-contents tmp-name4)
- (should (string-equal (buffer-string) "foo")))
- (should-error (copy-file tmp-name1 tmp-name4))
- (copy-file tmp-name1 tmp-name4 'ok)
- (make-directory tmp-name5)
- (copy-file tmp-name1 tmp-name5)
- (should
- (file-exists-p
- (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
-
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-file tmp-name4))
- (ignore-errors (delete-directory tmp-name5 'recursive)))
-
- ;; Copy from local side to remote side.
- (unwind-protect
- (progn
- (write-region "foo" nil tmp-name4 nil 'nomessage)
- (copy-file tmp-name4 tmp-name1)
- (should (file-exists-p tmp-name1))
- (with-temp-buffer
- (insert-file-contents tmp-name1)
- (should (string-equal (buffer-string) "foo")))
- (should-error (copy-file tmp-name4 tmp-name1))
- (copy-file tmp-name4 tmp-name1 'ok)
- (make-directory tmp-name3)
- (copy-file tmp-name4 tmp-name3)
- (should
- (file-exists-p
- (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
+ (dolist (source-target
+ `(;; Copy on remote side.
+ (,tmp-name1 . ,tmp-name2)
+ ;; Copy from remote side to local side.
+ (,tmp-name1 . ,tmp-name3)
+ ;; Copy from local side to remote side.
+ (,tmp-name3 . ,tmp-name1)))
+ (let ((source (car source-target))
+ (target (cdr source-target)))
+
+ ;; Copy simple file.
+ (unwind-protect
+ (progn
+ (write-region "foo" nil source)
+ (should (file-exists-p source))
+ (copy-file source target)
+ (should (file-exists-p target))
+ (with-temp-buffer
+ (insert-file-contents target)
+ (should (string-equal (buffer-string) "foo")))
+ (should-error
+ (copy-file source target)
+ :type 'file-already-exists)
+ (copy-file source target 'ok))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file source))
+ (ignore-errors (delete-file target)))
+
+ ;; Copy file to directory.
+ (unwind-protect
+ (progn
+ (write-region "foo" nil source)
+ (should (file-exists-p source))
+ (make-directory target)
+ (should (file-directory-p target))
+ ;; This has been changed in Emacs 26.1.
+ (when (tramp--test-emacs26-p)
+ (should-error
+ (copy-file source target)
+ :type 'file-already-exists))
+ (copy-file source (file-name-as-directory target))
+ (should
+ (file-exists-p
+ (expand-file-name (file-name-nondirectory source) target))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file source))
+ (ignore-errors (delete-directory target 'recursive)))
+
+ ;; Copy directory to existing directory.
+ (unwind-protect
+ (progn
+ (make-directory source)
+ (should (file-directory-p source))
+ (write-region "foo" nil (expand-file-name "foo" source))
+ (should (file-exists-p (expand-file-name "foo" source)))
+ (make-directory target)
+ (should (file-directory-p target))
+ ;; Directory `target' exists already, so we must use
+ ;; `file-name-as-directory'.
+ (copy-file source (file-name-as-directory target))
+ (should
+ (file-exists-p
+ (expand-file-name
+ (concat (file-name-nondirectory source) "/foo") target))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory source 'recursive))
+ (ignore-errors (delete-directory target 'recursive)))
+
+ ;; Copy directory/file to non-existing directory.
+ (unwind-protect
+ (progn
+ (make-directory source)
+ (should (file-directory-p source))
+ (write-region "foo" nil (expand-file-name "foo" source))
+ (should (file-exists-p (expand-file-name "foo" source)))
+ (make-directory target)
+ (should (file-directory-p target))
+ (copy-file
+ source
+ (expand-file-name (file-name-nondirectory source) target))
+ (should
+ (file-exists-p
+ (expand-file-name
+ (concat (file-name-nondirectory source) "/foo") target))))
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-file tmp-name4))
- (ignore-errors (delete-directory tmp-name3 'recursive))))))
+ ;; Cleanup.
+ (ignore-errors (delete-directory source 'recursive))
+ (ignore-errors (delete-directory target 'recursive))))))))
(ert-deftest tramp-test12-rename-file ()
"Check `rename-file'."
@@ -1909,90 +1989,105 @@ This checks also `file-name-as-directory', `file-name-directory',
(let (quoted)
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
- (tmp-name3 (tramp--test-make-temp-name nil quoted))
- (tmp-name4 (tramp--test-make-temp-name 'local quoted))
- (tmp-name5 (tramp--test-make-temp-name 'local quoted)))
-
- ;; Rename on remote side.
- (unwind-protect
- (progn
- (write-region "foo" nil tmp-name1)
- (rename-file tmp-name1 tmp-name2)
- (should-not (file-exists-p tmp-name1))
- (should (file-exists-p tmp-name2))
- (with-temp-buffer
- (insert-file-contents tmp-name2)
- (should (string-equal (buffer-string) "foo")))
- (write-region "foo" nil tmp-name1)
- (should-error (rename-file tmp-name1 tmp-name2))
- (rename-file tmp-name1 tmp-name2 'ok)
- (should-not (file-exists-p tmp-name1))
- (write-region "foo" nil tmp-name1)
- (make-directory tmp-name3)
- (rename-file tmp-name1 tmp-name3)
- (should-not (file-exists-p tmp-name1))
- (should
- (file-exists-p
- (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
-
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-file tmp-name2))
- (ignore-errors (delete-directory tmp-name3 'recursive)))
-
- ;; Rename from remote side to local side.
- (unwind-protect
- (progn
- (write-region "foo" nil tmp-name1)
- (rename-file tmp-name1 tmp-name4)
- (should-not (file-exists-p tmp-name1))
- (should (file-exists-p tmp-name4))
- (with-temp-buffer
- (insert-file-contents tmp-name4)
- (should (string-equal (buffer-string) "foo")))
- (write-region "foo" nil tmp-name1)
- (should-error (rename-file tmp-name1 tmp-name4))
- (rename-file tmp-name1 tmp-name4 'ok)
- (should-not (file-exists-p tmp-name1))
- (write-region "foo" nil tmp-name1)
- (make-directory tmp-name5)
- (rename-file tmp-name1 tmp-name5)
- (should-not (file-exists-p tmp-name1))
- (should
- (file-exists-p
- (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
-
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-file tmp-name4))
- (ignore-errors (delete-directory tmp-name5 'recursive)))
-
- ;; Rename from local side to remote side.
- (unwind-protect
- (progn
- (write-region "foo" nil tmp-name4 nil 'nomessage)
- (rename-file tmp-name4 tmp-name1)
- (should-not (file-exists-p tmp-name4))
- (should (file-exists-p tmp-name1))
- (with-temp-buffer
- (insert-file-contents tmp-name1)
- (should (string-equal (buffer-string) "foo")))
- (write-region "foo" nil tmp-name4 nil 'nomessage)
- (should-error (rename-file tmp-name4 tmp-name1))
- (rename-file tmp-name4 tmp-name1 'ok)
- (should-not (file-exists-p tmp-name4))
- (write-region "foo" nil tmp-name4 nil 'nomessage)
- (make-directory tmp-name3)
- (rename-file tmp-name4 tmp-name3)
- (should-not (file-exists-p tmp-name4))
- (should
- (file-exists-p
- (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
+ (dolist (source-target
+ `(;; Rename on remote side.
+ (,tmp-name1 . ,tmp-name2)
+ ;; Rename from remote side to local side.
+ (,tmp-name1 . ,tmp-name3)
+ ;; Rename from local side to remote side.
+ (,tmp-name3 . ,tmp-name1)))
+ (let ((source (car source-target))
+ (target (cdr source-target)))
+
+ ;; Rename simple file.
+ (unwind-protect
+ (progn
+ (write-region "foo" nil source)
+ (should (file-exists-p source))
+ (rename-file source target)
+ (should-not (file-exists-p source))
+ (should (file-exists-p target))
+ (with-temp-buffer
+ (insert-file-contents target)
+ (should (string-equal (buffer-string) "foo")))
+ (write-region "foo" nil source)
+ (should (file-exists-p source))
+ (should-error
+ (rename-file source target)
+ :type 'file-already-exists)
+ (rename-file source target 'ok)
+ (should-not (file-exists-p source)))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file source))
+ (ignore-errors (delete-file target)))
+
+ ;; Rename file to directory.
+ (unwind-protect
+ (progn
+ (write-region "foo" nil source)
+ (should (file-exists-p source))
+ (make-directory target)
+ (should (file-directory-p target))
+ ;; This has been changed in Emacs 26.1.
+ (when (tramp--test-emacs26-p)
+ (should-error
+ (rename-file source target)
+ :type 'file-already-exists))
+ (rename-file source (file-name-as-directory target))
+ (should-not (file-exists-p source))
+ (should
+ (file-exists-p
+ (expand-file-name (file-name-nondirectory source) target))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file source))
+ (ignore-errors (delete-directory target 'recursive)))
+
+ ;; Rename directory to existing directory.
+ (unwind-protect
+ (progn
+ (make-directory source)
+ (should (file-directory-p source))
+ (write-region "foo" nil (expand-file-name "foo" source))
+ (should (file-exists-p (expand-file-name "foo" source)))
+ (make-directory target)
+ (should (file-directory-p target))
+ ;; Directory `target' exists already, so we must use
+ ;; `file-name-as-directory'.
+ (rename-file source (file-name-as-directory target))
+ (should-not (file-exists-p source))
+ (should
+ (file-exists-p
+ (expand-file-name
+ (concat (file-name-nondirectory source) "/foo") target))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory source 'recursive))
+ (ignore-errors (delete-directory target 'recursive)))
+
+ ;; Rename directory/file to non-existing directory.
+ (unwind-protect
+ (progn
+ (make-directory source)
+ (should (file-directory-p source))
+ (write-region "foo" nil (expand-file-name "foo" source))
+ (should (file-exists-p (expand-file-name "foo" source)))
+ (make-directory target)
+ (should (file-directory-p target))
+ (rename-file
+ source
+ (expand-file-name (file-name-nondirectory source) target))
+ (should-not (file-exists-p source))
+ (should
+ (file-exists-p
+ (expand-file-name
+ (concat (file-name-nondirectory source) "/foo") target))))
- ;; Cleanup.
- (ignore-errors (delete-file tmp-name1))
- (ignore-errors (delete-file tmp-name4))
- (ignore-errors (delete-directory tmp-name3 'recursive))))))
+ ;; Cleanup.
+ (ignore-errors (delete-directory source 'recursive))
+ (ignore-errors (delete-directory target 'recursive))))))))
(ert-deftest tramp-test13-make-directory ()
"Check `make-directory'.
@@ -2007,10 +2102,13 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(make-directory tmp-name1)
(should (file-directory-p tmp-name1))
(should (file-accessible-directory-p tmp-name1))
- (should-error (make-directory tmp-name2))
+ (should-error (make-directory tmp-name2) :type 'file-error)
(make-directory tmp-name2 'parents)
(should (file-directory-p tmp-name2))
- (should (file-accessible-directory-p tmp-name2)))
+ (should (file-accessible-directory-p tmp-name2))
+ ;; If PARENTS is non-nil, `make-directory' shall not
+ ;; signal an error when DIR exists already.
+ (make-directory tmp-name2 'parents))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
@@ -2031,7 +2129,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(should (file-directory-p tmp-name))
(write-region "foo" nil (expand-file-name "bla" tmp-name))
(should (file-exists-p (expand-file-name "bla" tmp-name)))
- (should-error (delete-directory tmp-name))
+ (should-error (delete-directory tmp-name) :type 'file-error)
(delete-directory tmp-name 'recursive)
(should-not (file-directory-p tmp-name)))))
@@ -2060,7 +2158,12 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
;; Target directory does exist already.
- (copy-directory tmp-name1 tmp-name2)
+ ;; This has been changed in Emacs 26.1.
+ (when (tramp--test-emacs26-p)
+ (should-error
+ (copy-directory tmp-name1 tmp-name2)
+ :type 'file-error))
+ (copy-directory tmp-name1 (file-name-as-directory tmp-name2))
(should (file-directory-p tmp-name3))
(should (file-exists-p tmp-name6)))
@@ -2083,7 +2186,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; Target directory does exist already.
(delete-file tmp-name5)
(should-not (file-exists-p tmp-name5))
- (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents)
+ (copy-directory
+ tmp-name1 (file-name-as-directory tmp-name2)
+ nil 'parents 'contents)
(should (file-directory-p tmp-name2))
(should (file-exists-p tmp-name5))
(should-not (file-directory-p tmp-name3))
@@ -2099,8 +2204,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(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)))
+ (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "bla" tmp-name1))
(tmp-name3 (expand-file-name "foo" tmp-name1)))
(unwind-protect
@@ -2126,6 +2230,72 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
+;; This is not a file name handler test. But Tramp needed to apply an
+;; advice for older Emacs versions, so we check that this has been fixed.
+(ert-deftest tramp-test16-file-expand-wildcards ()
+ "Check `file-expand-wildcards'."
+ (skip-unless (tramp--test-enabled))
+
+ (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (expand-file-name "foo" tmp-name1))
+ (tmp-name3 (expand-file-name "bar" tmp-name1))
+ (tmp-name4 (expand-file-name "baz" tmp-name1))
+ (default-directory tmp-name1))
+ (unwind-protect
+ (progn
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name2)
+ (write-region "bar" nil tmp-name3)
+ (write-region "baz" nil tmp-name4)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name2))
+ (should (file-exists-p tmp-name3))
+ (should (file-exists-p tmp-name4))
+
+ ;; `sort' works destructive.
+ (should
+ (equal (file-expand-wildcards "*")
+ (sort (copy-sequence '("foo" "bar" "baz")) 'string<)))
+ (should
+ (equal (file-expand-wildcards "ba?")
+ (sort (copy-sequence '("bar" "baz")) 'string<)))
+ (should
+ (equal (file-expand-wildcards "ba[rz]")
+ (sort (copy-sequence '("bar" "baz")) 'string<)))
+
+ (should
+ (equal
+ (file-expand-wildcards "*" 'full)
+ (sort
+ (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<)))
+ (should
+ (equal
+ (file-expand-wildcards "ba?" 'full)
+ (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
+ (should
+ (equal
+ (file-expand-wildcards "ba[rz]" 'full)
+ (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
+
+ (should
+ (equal
+ (file-expand-wildcards (concat tmp-name1 "/" "*"))
+ (sort
+ (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<)))
+ (should
+ (equal
+ (file-expand-wildcards (concat tmp-name1 "/" "ba?"))
+ (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))
+ (should
+ (equal
+ (file-expand-wildcards (concat tmp-name1 "/" "ba[rz]"))
+ (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))))
+
+ ;; Cleanup.
+ (ignore-errors
+ (delete-directory tmp-name1 'recursive))))))
+
(ert-deftest tramp-test17-insert-directory ()
"Check `insert-directory'."
(skip-unless (tramp--test-enabled))
@@ -2147,6 +2317,14 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
(insert-directory tmp-name1 nil)
(goto-char (point-min))
(should (looking-at-p (regexp-quote tmp-name1))))
+ ;; This has been fixed in Emacs 26.1. See Bug#29423.
+ (when (tramp--test-emacs26-p)
+ (with-temp-buffer
+ (insert-directory (file-name-as-directory tmp-name1) nil)
+ (goto-char (point-min))
+ (should
+ (looking-at-p
+ (regexp-quote (file-name-as-directory tmp-name1))))))
(with-temp-buffer
(insert-directory tmp-name1 "-al")
(goto-char (point-min))
@@ -2167,11 +2345,133 @@ This tests also `file-directory-p' and `file-accessible-directory-p'."
;; There might be a summary line.
"\\(total.+[[:digit:]]+\n\\)?"
;; We don't know in which order ".", ".." and "foo" appear.
- "\\(.+ \\(\\.?\\.\\|foo\\)\n\\)\\{3\\}")))))
+ (format
+ "\\(.+ %s\\( ->.+\\)?\n\\)\\{%d\\}"
+ (regexp-opt (directory-files tmp-name1))
+ (length (directory-files tmp-name1))))))))
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
+(ert-deftest tramp-test17-dired-with-wildcards ()
+ "Check `dired' with wildcards."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ (skip-unless (not (tramp--test-rsync-p)))
+ ;; Since Emacs 26.1.
+ (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p))
+
+ (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 (tramp--test-make-temp-name nil quoted)))
+ (tmp-name3 (expand-file-name "foo" tmp-name1))
+ (tmp-name4 (expand-file-name "bar" tmp-name2))
+ (tramp-test-temporary-file-directory
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ tramp-test-temporary-file-directory))
+ buffer)
+ (unwind-protect
+ (progn
+ (make-directory tmp-name1)
+ (write-region "foo" nil tmp-name3)
+ (should (file-directory-p tmp-name1))
+ (should (file-exists-p tmp-name3))
+ (make-directory tmp-name2)
+ (write-region "foo" nil tmp-name4)
+ (should (file-directory-p tmp-name2))
+ (should (file-exists-p tmp-name4))
+
+ ;; Check for expanded directory names.
+ (with-current-buffer
+ (setq buffer
+ (dired-noselect
+ (expand-file-name
+ "tramp-test*" tramp-test-temporary-file-directory)))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name1 tramp-test-temporary-file-directory))))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name2 tramp-test-temporary-file-directory)))))
+ (kill-buffer buffer)
+
+ ;; Check for expanded directory and file names.
+ (with-current-buffer
+ (setq buffer
+ (dired-noselect
+ (expand-file-name
+ "tramp-test*/*" tramp-test-temporary-file-directory)))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name3 tramp-test-temporary-file-directory))))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name4
+ tramp-test-temporary-file-directory)))))
+ (kill-buffer buffer)
+
+ ;; Check for special characters.
+ (setq tmp-name3 (expand-file-name "*?" tmp-name1))
+ (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2))
+ (write-region "foo" nil tmp-name3)
+ (should (file-exists-p tmp-name3))
+ (write-region "foo" nil tmp-name4)
+ (should (file-exists-p tmp-name4))
+
+ (with-current-buffer
+ (setq buffer
+ (dired-noselect
+ (expand-file-name
+ "tramp-test*/*" tramp-test-temporary-file-directory)))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name3 tramp-test-temporary-file-directory))))
+ (goto-char (point-min))
+ (should
+ (re-search-forward
+ (regexp-quote
+ (file-relative-name
+ tmp-name4
+ tramp-test-temporary-file-directory)))))
+ (kill-buffer buffer))
+
+ ;; Cleanup.
+ (ignore-errors (kill-buffer buffer))
+ (ignore-errors (delete-directory tmp-name1 'recursive))
+ (ignore-errors (delete-directory tmp-name2 'recursive))))))
+
+;; Method "smb" supports `make-symbolic-link' only if the remote host
+;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not
+;; support symbolic links at all.
+(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body)
+ "Run BODY, ignoring \"make-symbolic-link not supported\" file error."
+ (declare (indent defun) (debug t))
+ `(condition-case err
+ (progn ,@body)
+ ((error quit debug)
+ (unless (and (eq (car err) 'file-error)
+ (string-equal (error-message-string err)
+ "make-symbolic-link not supported"))
+ (signal (car err) (cdr err))))))
+
(ert-deftest tramp-test18-file-attributes ()
"Check `file-attributes'.
This tests also `file-readable-p', `file-regular-p' and
@@ -2227,26 +2527,22 @@ This tests also `file-readable-p', `file-regular-p' and
(should (stringp (nth 2 attr))) ;; Uid.
(should (stringp (nth 3 attr))) ;; Gid.
- (condition-case err
- (progn
- (when (tramp--test-sh-p)
- (should (file-ownership-preserved-p tmp-name2 'group)))
- (make-symbolic-link tmp-name1 tmp-name2)
- (should (file-exists-p tmp-name2))
- (should (file-symlink-p tmp-name2))
- (when (tramp--test-sh-p)
- (should (file-ownership-preserved-p tmp-name2 'group)))
- (setq attr (file-attributes tmp-name2))
- (should
- (string-equal
- (funcall
- (if quoted 'tramp-compat-file-name-quote 'identity)
- (car attr))
- (file-remote-p (file-truename tmp-name1) 'localname)))
- (delete-file tmp-name2))
- (file-error
- (should (string-equal (error-message-string err)
- "make-symbolic-link not supported"))))
+ (tramp--test-ignore-make-symbolic-link-error
+ (when (tramp--test-sh-p)
+ (should (file-ownership-preserved-p tmp-name2 'group)))
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-exists-p tmp-name2))
+ (should (file-symlink-p tmp-name2))
+ (when (tramp--test-sh-p)
+ (should (file-ownership-preserved-p tmp-name2 'group)))
+ (setq attr (file-attributes tmp-name2))
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (car attr))
+ (file-remote-p (file-truename tmp-name1) 'localname)))
+ (delete-file tmp-name2))
;; Check, that "//" in symlinks are handled properly.
(with-temp-buffer
@@ -2359,6 +2655,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
"Check `file-symlink-p'.
This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(skip-unless (tramp--test-enabled))
+ ;; The semantics has changed heavily in Emacs 26.1. We cannot test
+ ;; older Emacsen, therefore.
+ (skip-unless (tramp--test-emacs26-p))
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
;; We must use `file-truename' for the temporary directory,
@@ -2368,33 +2667,83 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(file-truename tramp-test-temporary-file-directory))
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
- (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
-
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted))
+ (tmp-name4 (tramp--test-make-temp-name nil quoted))
+ (tmp-name5
+ (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)))
;; Check `make-symbolic-link'.
(unwind-protect
- (progn
+ (tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
- ;; Method "smb" supports `make-symbolic-link' only if the
- ;; remote host has CIFS capabilities. tramp-adb.el and
- ;; tramp-gvfs.el do not support symbolic links at all.
- (condition-case err
- (make-symbolic-link tmp-name1 tmp-name2)
- (file-error
- (skip-unless
- (not (string-equal (error-message-string err)
- "make-symbolic-link not supported")))))
- (should (file-symlink-p tmp-name2))
- (should-error (make-symbolic-link tmp-name1 tmp-name2))
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-unquote 'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name2)))
+ (should-error
+ (make-symbolic-link tmp-name1 tmp-name2)
+ :type 'file-already-exists)
+ ;; A number means interactive case.
+ (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
+ (should-error
+ (make-symbolic-link tmp-name1 tmp-name2 0)
+ :type 'file-already-exists))
+ (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
+ (make-symbolic-link tmp-name1 tmp-name2 0)
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-unquote 'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name2))))
(make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists)
- (should (file-symlink-p tmp-name2))
- ;; `tmp-name3' is a local file name.
- (should-error (make-symbolic-link tmp-name1 tmp-name3)))
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-unquote 'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name2)))
+ ;; If we use the local part of `tmp-name1', it shall still work.
+ (make-symbolic-link
+ (file-remote-p tmp-name1 'localname)
+ tmp-name2 'ok-if-already-exists)
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-unquote 'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name2)))
+ ;; `tmp-name3' is a local file name. Therefore, the link
+ ;; target remains unchanged, even if quoted.
+ (make-symbolic-link tmp-name1 tmp-name3)
+ (should
+ (string-equal tmp-name1 (file-symlink-p tmp-name3)))
+ ;; Check directory as newname.
+ (make-directory tmp-name4)
+ (should-error
+ (make-symbolic-link tmp-name1 tmp-name4)
+ :type 'file-already-exists)
+ (make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4))
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-unquote 'identity)
+ (file-remote-p tmp-name1 'localname))
+ (file-symlink-p tmp-name5)))
+ ;; `smbclient' does not show symlinks in directories, so
+ ;; we cannot delete a non-empty directory. We delete the
+ ;; file explicitly.
+ (delete-file tmp-name5))
;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
- (delete-file tmp-name2)))
+ (delete-file tmp-name2)
+ (delete-file tmp-name3)
+ (delete-directory tmp-name4 'recursive)))
;; Check `add-name-to-file'.
(unwind-protect
@@ -2402,29 +2751,133 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
(add-name-to-file tmp-name1 tmp-name2)
- (should-not (file-symlink-p tmp-name2))
- (should-error (add-name-to-file tmp-name1 tmp-name2))
+ (should (file-regular-p tmp-name2))
+ (should-error
+ (add-name-to-file tmp-name1 tmp-name2)
+ :type 'file-already-exists)
+ ;; A number means interactive case.
+ (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
+ (should-error
+ (add-name-to-file tmp-name1 tmp-name2 0)
+ :type 'file-already-exists))
+ (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
+ (add-name-to-file tmp-name1 tmp-name2 0)
+ (should (file-regular-p tmp-name2)))
(add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
(should-not (file-symlink-p tmp-name2))
+ (should (file-regular-p tmp-name2))
;; `tmp-name3' is a local file name.
- (should-error (add-name-to-file tmp-name1 tmp-name3)))
+ (should-error
+ (add-name-to-file tmp-name1 tmp-name3)
+ :type 'file-error)
+ ;; Check directory as newname.
+ (make-directory tmp-name4)
+ (should-error
+ (add-name-to-file tmp-name1 tmp-name4)
+ :type 'file-already-exists)
+ (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4))
+ (should
+ (file-regular-p
+ (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4))))
;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
- (delete-file tmp-name2)))
+ (delete-file tmp-name2)
+ (delete-directory tmp-name4 'recursive)))
;; Check `file-truename'.
(unwind-protect
- (progn
+ (tramp--test-ignore-make-symbolic-link-error
(write-region "foo" nil tmp-name1)
(should (file-exists-p tmp-name1))
+ (should (string-equal tmp-name1 (file-truename tmp-name1)))
(make-symbolic-link tmp-name1 tmp-name2)
(should (file-symlink-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
- (should (file-equal-p tmp-name1 tmp-name2)))
+ (should (file-equal-p tmp-name1 tmp-name2))
+ ;; Check relative symlink file name.
+ (delete-file tmp-name2)
+ (let ((default-directory tramp-test-temporary-file-directory))
+ (make-symbolic-link (file-name-nondirectory tmp-name1) tmp-name2))
+ (should (file-symlink-p tmp-name2))
+ (should-not (string-equal tmp-name2 (file-truename tmp-name2)))
+ (should
+ (string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
+ (should (file-equal-p tmp-name1 tmp-name2))
+ ;; Symbolic links could look like a remote file name.
+ ;; They must be quoted then.
+ (delete-file tmp-name2)
+ (make-symbolic-link "/penguin:motd:" tmp-name2)
+ (should (file-symlink-p tmp-name2))
+ (should
+ (string-equal
+ (file-truename tmp-name2)
+ (tramp-compat-file-name-quote
+ (concat (file-remote-p tmp-name2) "/penguin:motd:"))))
+ ;; `tmp-name3' is a local file name.
+ (make-symbolic-link tmp-name1 tmp-name3)
+ (should (file-symlink-p tmp-name3))
+ (should-not (string-equal tmp-name3 (file-truename tmp-name3)))
+ ;; `file-truename' returns a quoted file name for `tmp-name3'.
+ ;; We must unquote it.
+ (should
+ (string-equal
+ (file-truename tmp-name1)
+ (tramp-compat-file-name-unquote (file-truename tmp-name3)))))
+
+ ;; Cleanup.
+ (ignore-errors
+ (delete-file tmp-name1)
+ (delete-file tmp-name2)
+ (delete-file tmp-name3)))
+
+ ;; Symbolic links could be nested.
+ (unwind-protect
+ (tramp--test-ignore-make-symbolic-link-error
+ (make-directory tmp-name1)
+ (should (file-directory-p tmp-name1))
+ (let* ((tramp-test-temporary-file-directory
+ (file-truename tmp-name1))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ (tmp-name3 tmp-name2)
+ (number-nesting 15))
+ (dotimes (_ number-nesting)
+ (make-symbolic-link
+ tmp-name3
+ (setq tmp-name3 (tramp--test-make-temp-name nil quoted))))
+ (should
+ (string-equal
+ (file-truename tmp-name2)
+ (file-truename tmp-name3)))
+ (should-error
+ (with-temp-buffer (insert-file-contents tmp-name2))
+ :type tramp-file-missing)
+ (should-error
+ (with-temp-buffer (insert-file-contents tmp-name3))
+ :type tramp-file-missing)
+ ;; `directory-files' does not show symlinks to
+ ;; non-existing targets in the "smb" case. So we remove
+ ;; the symlinks manually.
+ (while (stringp (setq tmp-name2 (file-symlink-p tmp-name3)))
+ (delete-file tmp-name3)
+ (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2)))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name1 'recursive)))
+
+ ;; Detect cyclic symbolic links.
+ (unwind-protect
+ (tramp--test-ignore-make-symbolic-link-error
+ (make-symbolic-link tmp-name2 tmp-name1)
+ (should (file-symlink-p tmp-name1))
+ (make-symbolic-link tmp-name1 tmp-name2)
+ (should (file-symlink-p tmp-name2))
+ (should-error (file-truename tmp-name1) :type 'file-error))
+
+ ;; Cleanup.
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
@@ -2492,7 +2945,223 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
-(ert-deftest tramp-test24-file-name-completion ()
+;; This test is inspired by Bug#29149.
+(ert-deftest tramp-test24-file-acl ()
+ "Check that `file-acl' and `set-file-acl' work proper."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (file-acl tramp-test-temporary-file-directory))
+
+ ;; TODO: The quoted case does not work. Copy local file to remote.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
+ (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
+ ;; Both files are remote.
+ (unwind-protect
+ (progn
+ ;; Two files with same ACLs.
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-acl tmp-name1))
+ (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions)
+ (should (file-acl tmp-name2))
+ (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
+ ;; Different permissions mean different ACLs.
+ (set-file-modes tmp-name1 #o777)
+ (set-file-modes tmp-name2 #o444)
+ (should-not
+ (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
+ ;; Copy ACL.
+ (should (set-file-acl tmp-name2 (file-acl tmp-name1)))
+ (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2)))
+ ;; An invalid ACL does not harm.
+ (should-not (set-file-acl tmp-name2 "foo")))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name2)))
+
+ ;; Remote and local file.
+ (unwind-protect
+ (when (and (file-acl temporary-file-directory)
+ (not (tramp--test-windows-nt-or-smb-p)))
+ ;; Two files with same ACLs.
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-acl tmp-name1))
+ (copy-file tmp-name1 tmp-name3 nil nil nil 'preserve-permissions)
+ (should (file-acl tmp-name3))
+ (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
+ ;; Different permissions mean different ACLs.
+ (set-file-modes tmp-name1 #o777)
+ (set-file-modes tmp-name3 #o444)
+ (should-not
+ (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
+ ;; Copy ACL. Since we don't know whether Emacs is built
+ ;; with local ACL support, we must check it.
+ (when (set-file-acl tmp-name3 (file-acl tmp-name1))
+ (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))))
+
+ ;; Two files with same ACLs.
+ (delete-file tmp-name1)
+ (copy-file tmp-name3 tmp-name1 nil nil nil 'preserve-permissions)
+ (should (file-acl tmp-name1))
+ (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
+ ;; Different permissions mean different ACLs.
+ (set-file-modes tmp-name1 #o777)
+ (set-file-modes tmp-name3 #o444)
+ (should-not
+ (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))
+ ;; Copy ACL.
+ (set-file-acl tmp-name1 (file-acl tmp-name3))
+ (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name3))))))
+
+(ert-deftest tramp-test25-file-selinux ()
+ "Check `file-selinux-context' and `set-file-selinux-context'."
+ (skip-unless (tramp--test-enabled))
+ (skip-unless
+ (not (equal (file-selinux-context tramp-test-temporary-file-directory)
+ '(nil nil nil nil))))
+
+ ;; TODO: The quoted case does not work. Copy local file to remote.
+ ;;(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let (quoted)
+ (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
+ ;; Both files are remote.
+ (unwind-protect
+ (progn
+ ;; Two files with same SELinux context.
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-selinux-context tmp-name1))
+ (copy-file tmp-name1 tmp-name2)
+ (should (file-selinux-context tmp-name2))
+ (should
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name2)))
+ ;; Check different SELinux context. We cannot support
+ ;; different ranges in this test; let's assume the most
+ ;; likely one.
+ (let ((context (file-selinux-context tmp-name1)))
+ (when (and (string-equal (nth 3 context) "s0")
+ (setcar (nthcdr 3 context) "s0:c0")
+ (set-file-selinux-context tmp-name1 context))
+ (should-not
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name2)))))
+ ;; Copy SELinux context.
+ (should
+ (set-file-selinux-context
+ tmp-name2 (file-selinux-context tmp-name1)))
+ (should
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name2)))
+ ;; An invalid SELinux context does not harm.
+ (should-not (set-file-selinux-context tmp-name2 "foo")))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name2)))
+
+ ;; Remote and local file.
+ (unwind-protect
+ (when (and (not
+ (or (equal (file-selinux-context temporary-file-directory)
+ '(nil nil nil nil))
+ (tramp--test-windows-nt-or-smb-p)))
+ ;; Both users shall use the same SELinux context.
+ (string-equal
+ (let ((default-directory temporary-file-directory))
+ (shell-command-to-string "id -Z"))
+ (let ((default-directory
+ tramp-test-temporary-file-directory))
+ (shell-command-to-string "id -Z"))))
+
+ ;; Two files with same SELinux context.
+ (write-region "foo" nil tmp-name1)
+ (should (file-exists-p tmp-name1))
+ (should (file-selinux-context tmp-name1))
+ (copy-file tmp-name1 tmp-name3)
+ (should (file-selinux-context tmp-name3))
+ ;; We cannot expect that copying over file system
+ ;; boundaries keeps SELinux context. So we copy it
+ ;; explicitly.
+ (should
+ (set-file-selinux-context
+ tmp-name3 (file-selinux-context tmp-name1)))
+ (should
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name3)))
+ ;; Check different SELinux context. We cannot support
+ ;; different ranges in this test; let's assume the most
+ ;; likely one.
+ (let ((context (file-selinux-context tmp-name1)))
+ (when (and (string-equal (nth 3 context) "s0")
+ (setcar (nthcdr 3 context) "s0:c0")
+ (set-file-selinux-context tmp-name1 context))
+ (should-not
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name3)))))
+ ;; Copy SELinux context.
+ (should
+ (set-file-selinux-context
+ tmp-name3 (file-selinux-context tmp-name1)))
+ (should
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name3)))
+
+ ;; Two files with same SELinux context.
+ (delete-file tmp-name1)
+ (copy-file tmp-name3 tmp-name1)
+ (should (file-selinux-context tmp-name1))
+ ;; We cannot expect that copying over file system
+ ;; boundaries keeps SELinux context. So we copy it
+ ;; explicitly.
+ (should
+ (set-file-selinux-context
+ tmp-name1 (file-selinux-context tmp-name3)))
+ (should
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name3)))
+ ;; Check different SELinux context. We cannot support
+ ;; different ranges in this test; let's assume the most
+ ;; likely one.
+ (let ((context (file-selinux-context tmp-name3)))
+ (when (and (string-equal (nth 3 context) "s0")
+ (setcar (nthcdr 3 context) "s0:c0")
+ (set-file-selinux-context tmp-name3 context))
+ (should-not
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name3)))))
+ ;; Copy SELinux context.
+ (should
+ (set-file-selinux-context
+ tmp-name1 (file-selinux-context tmp-name3)))
+ (should
+ (equal
+ (file-selinux-context tmp-name1)
+ (file-selinux-context tmp-name3))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file tmp-name1))
+ (ignore-errors (delete-file tmp-name3))))))
+
+(ert-deftest tramp-test26-file-name-completion ()
"Check `file-name-completion' and `file-name-all-completions'."
(skip-unless (tramp--test-enabled))
@@ -2513,16 +3182,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-change-syntax syntax)
(let ;; This is needed for the `simplified' syntax.
((method-marker
- (if (zerop (length (tramp-method-regexp)))
+ (if (zerop (length tramp-method-regexp))
"" tramp-default-method-marker))
;; This is needed for the `separate' syntax.
- (prefix-format (substring (tramp-prefix-format) 1)))
+ (prefix-format (substring tramp-prefix-format 1)))
;; Complete method name.
(unless (or (zerop (length method))
- (zerop (length (tramp-method-regexp))))
+ (zerop (length tramp-method-regexp)))
(should
(member
- (concat prefix-format method (tramp-postfix-method-format))
+ (concat prefix-format method tramp-postfix-method-format)
(file-name-all-completions
(concat prefix-format (substring method 0 1)) "/"))))
;; Complete host name for default method. With gvfs
@@ -2534,25 +3203,25 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should
(member
(concat
- prefix-format method-marker (tramp-postfix-method-format)
- host (tramp-postfix-host-format))
+ prefix-format method-marker tramp-postfix-method-format
+ host tramp-postfix-host-format)
(file-name-all-completions
(concat
- prefix-format method-marker (tramp-postfix-method-format)
+ prefix-format method-marker tramp-postfix-method-format
(substring host 0 1))
"/")))))
;; Complete host name.
(unless (or (zerop (length method))
- (zerop (length (tramp-method-regexp)))
+ (zerop (length tramp-method-regexp))
(zerop (length host))
(tramp--test-gvfs-p method))
(should
(member
(concat
- prefix-format method (tramp-postfix-method-format)
- host (tramp-postfix-host-format))
+ prefix-format method tramp-postfix-method-format
+ host tramp-postfix-host-format)
(file-name-all-completions
- (concat prefix-format method (tramp-postfix-method-format))
+ (concat prefix-format method tramp-postfix-method-format)
"/"))))))
;; Cleanup.
@@ -2617,7 +3286,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-directory tmp-name 'recursive)))))))
-(ert-deftest tramp-test25-load ()
+(ert-deftest tramp-test27-load ()
"Check `load'."
(skip-unless (tramp--test-enabled))
@@ -2630,7 +3299,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(write-region "(provide 'tramp-test-load)" nil tmp-name)
;; `load' in lread.c does not pass `must-suffix'. Why?
;;(should-error
- ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix))
+ ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
+ ;; :type 'file-error)
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
@@ -2639,7 +3309,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(and (featurep 'tramp-test-load) (unload-feature 'tramp-test-load))
(delete-file tmp-name))))))
-(ert-deftest tramp-test26-process-file ()
+(ert-deftest tramp-test28-process-file ()
"Check `process-file'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
@@ -2685,7 +3355,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-file tmp-name))))))
-(ert-deftest tramp-test27-start-file-process ()
+(ert-deftest tramp-test29-start-file-process ()
"Check `start-file-process'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
@@ -2750,7 +3420,34 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-process proc))))))
-(ert-deftest tramp-test28-shell-command ()
+(ert-deftest tramp-test30-interrupt-process ()
+ "Check `interrupt-process'."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-enabled))
+ (skip-unless (tramp--test-sh-p))
+ ;; Since Emacs 26.1.
+ (skip-unless (boundp 'interrupt-process-functions))
+
+ (let ((default-directory tramp-test-temporary-file-directory)
+ kill-buffer-query-functions proc)
+ (unwind-protect
+ (with-temp-buffer
+ (setq proc (start-file-process "test" (current-buffer) "sleep" "10"))
+ (should (processp proc))
+ (should (process-live-p proc))
+ (should (equal (process-status proc) 'run))
+ (should (numberp (process-get proc 'remote-pid)))
+ (should (interrupt-process proc))
+ ;; Let the process accept the interrupt.
+ (accept-process-output proc 1 nil 0)
+ (should-not (process-live-p proc))
+ ;; An interrupted process cannot be interrupted, again.
+ (should-error (interrupt-process proc) :type 'error))
+
+ ;; Cleanup.
+ (ignore-errors (delete-process proc)))))
+
+(ert-deftest tramp-test31-shell-command ()
"Check `shell-command'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
@@ -2759,6 +3456,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
(let ((tmp-name (tramp--test-make-temp-name nil quoted))
(default-directory tramp-test-temporary-file-directory)
+ ;; Suppress nasty messages.
+ (inhibit-message t)
kill-buffer-query-functions)
(unwind-protect
(with-temp-buffer
@@ -2787,7 +3486,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(async-shell-command
(format "ls %s" (file-name-nondirectory tmp-name))
(current-buffer))
- (set-process-sentinel (get-buffer-process (current-buffer)) nil)
;; Read output.
(with-timeout (10 (ert-fail "`async-shell-command' timed out"))
(while (< (- (point-max) (point-min))
@@ -2816,7 +3514,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
(async-shell-command "read line; ls $line" (current-buffer))
- (set-process-sentinel (get-buffer-process (current-buffer)) nil)
(process-send-string
(get-buffer-process (current-buffer))
(format "%s\n" (file-name-nondirectory tmp-name)))
@@ -2847,8 +3544,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
"Like `shell-command-to-string', but for asynchronous processes."
(with-temp-buffer
(async-shell-command command (current-buffer))
- ;; Suppress nasty messages.
- (set-process-sentinel (get-buffer-process (current-buffer)) nil)
(with-timeout (10)
(while (get-buffer-process (current-buffer))
(accept-process-output (get-buffer-process (current-buffer)) 0.1)))
@@ -2856,7 +3551,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(buffer-substring-no-properties (point-min) (point-max))))
;; This test is inspired by Bug#23952.
-(ert-deftest tramp-test29-environment-variables ()
+(ert-deftest tramp-test32-environment-variables ()
"Check that remote processes set / unset environment variables properly."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
@@ -2934,16 +3629,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(funcall this-shell-command-to-string "set")))))))))
;; This test is inspired by Bug#27009.
-(ert-deftest tramp-test29-environment-variables-and-port-numbers ()
+(ert-deftest tramp-test32-environment-variables-and-port-numbers ()
"Check that two connections with separate ports are different."
(skip-unless (tramp--test-enabled))
;; We test it only for the mock-up connection; otherwise there might
;; be problems with the used ports.
- (skip-unless
- (and
- (eq tramp-syntax 'default)
- (string-equal
- "mock" (file-remote-p tramp-test-temporary-file-directory 'method))))
+ (skip-unless (and (eq tramp-syntax 'default)
+ (tramp--test-mock-p)))
;; We force a reconnect, in order to have a clean environment.
(dolist (dir `(,tramp-test-temporary-file-directory
@@ -2973,16 +3665,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(tramp-cleanup-connection (tramp-dissect-file-name dir)))))
;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-test30-explicit-shell-file-name ()
+(ert-deftest tramp-test33-explicit-shell-file-name ()
"Check that connection-local `explicit-shell-file-name' is set."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
+ ;; Since Emacs 26.1.
(skip-unless (and (fboundp 'connection-local-set-profile-variables)
(fboundp 'connection-local-set-profiles)))
;; `connection-local-set-profile-variables' and
- ;; `connection-local-set-profiles' exists since Emacs 26. We don't
+ ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't
;; want to see compiler warnings for older Emacsen.
(let ((default-directory tramp-test-temporary-file-directory)
explicit-shell-file-name kill-buffer-query-functions)
@@ -3016,13 +3709,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(put 'explicit-shell-file-name 'permanent-local nil)
(kill-buffer "*shell*"))))
-(ert-deftest tramp-test31-vc-registered ()
+(ert-deftest tramp-test34-vc-registered ()
"Check `vc-registered'."
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- ;; TODO: This test fails.
(dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
(let* ((default-directory tramp-test-temporary-file-directory)
(tmp-name1 (tramp--test-make-temp-name nil quoted))
@@ -3046,11 +3738,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; We must force a reconnect, in order to activate $BZR_HOME.
(tramp-cleanup-connection
(tramp-dissect-file-name tramp-test-temporary-file-directory)
- nil 'keep-password)
+ 'keep-debug 'keep-password)
'(Bzr))
- (t nil)))))
+ (t nil))))
+ ;; Suppress nasty messages.
+ (inhibit-message t))
(skip-unless vc-handled-backends)
- (message "%s" vc-handled-backends)
+ (unless quoted (tramp--test-message "%s" vc-handled-backends))
(unwind-protect
(progn
@@ -3087,7 +3781,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
;; Cleanup.
(ignore-errors (delete-directory tmp-name1 'recursive))))))
-(ert-deftest tramp-test32-make-auto-save-file-name ()
+(ert-deftest tramp-test35-make-auto-save-file-name ()
"Check `make-auto-save-file-name'."
(skip-unless (tramp--test-enabled))
@@ -3181,16 +3875,112 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-directory tmp-name2 'recursive))))))
+(ert-deftest tramp-test36-find-backup-file-name ()
+ "Check `find-backup-file-name'."
+ (skip-unless (tramp--test-enabled))
+
+ (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
+ (let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
+ (tmp-name2 (tramp--test-make-temp-name nil quoted))
+ ;; These settings are not used by Tramp, so we ignore them.
+ version-control delete-old-versions
+ (kept-old-versions (default-toplevel-value 'kept-old-versions))
+ (kept-new-versions (default-toplevel-value 'kept-new-versions)))
+
+ (unwind-protect
+ ;; Use default `backup-directory-alist' mechanism.
+ (let (backup-directory-alist tramp-backup-directory-alist)
+ (should
+ (equal
+ (find-backup-file-name tmp-name1)
+ (list
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (expand-file-name
+ (format "%s~" (file-name-nondirectory tmp-name1))
+ tramp-test-temporary-file-directory)))))))
+
+ (unwind-protect
+ ;; Map `backup-directory-alist'.
+ (let ((backup-directory-alist `(("." . ,tmp-name2)))
+ tramp-backup-directory-alist)
+ (should
+ (equal
+ (find-backup-file-name tmp-name1)
+ (list
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (expand-file-name
+ (format
+ "%s~"
+ ;; This is taken from `make-backup-file-name-1'.
+ (subst-char-in-string
+ ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+ tmp-name2)))))
+ ;; The backup directory is created.
+ (should (file-directory-p tmp-name2)))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name2 'recursive)))
+
+ (unwind-protect
+ ;; Map `tramp-backup-directory-alist'.
+ (let ((tramp-backup-directory-alist `(("." . ,tmp-name2)))
+ backup-directory-alist)
+ (should
+ (equal
+ (find-backup-file-name tmp-name1)
+ (list
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (expand-file-name
+ (format
+ "%s~"
+ ;; This is taken from `make-backup-file-name-1'.
+ (subst-char-in-string
+ ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+ tmp-name2)))))
+ ;; The backup directory is created.
+ (should (file-directory-p tmp-name2)))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name2 'recursive)))
+
+ (unwind-protect
+ ;; Map `tramp-backup-directory-alist' with local file name.
+ (let ((tramp-backup-directory-alist
+ `(("." . ,(file-remote-p tmp-name2 'localname))))
+ backup-directory-alist)
+ (should
+ (equal
+ (find-backup-file-name tmp-name1)
+ (list
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (expand-file-name
+ (format
+ "%s~"
+ ;; This is taken from `make-backup-file-name-1'.
+ (subst-char-in-string
+ ?/ ?! (replace-regexp-in-string "!" "!!" tmp-name1)))
+ tmp-name2)))))
+ ;; The backup directory is created.
+ (should (file-directory-p tmp-name2)))
+
+ ;; Cleanup.
+ (ignore-errors (delete-directory tmp-name2 'recursive))))))
+
;; The functions were introduced in Emacs 26.1.
-(ert-deftest tramp-test33-make-nearby-temp-file ()
+(ert-deftest tramp-test37-make-nearby-temp-file ()
"Check `make-nearby-temp-file' and `temporary-file-directory'."
(skip-unless (tramp--test-enabled))
+ ;; Since Emacs 26.1.
(skip-unless
(and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory)))
;; `make-nearby-temp-file' and `temporary-file-directory' exists
- ;; since Emacs 26. We don't want to see compiler warnings for older
- ;; Emacsen.
+ ;; since Emacs 26.1. We don't want to see compiler warnings for
+ ;; older Emacsen.
(let ((default-directory tramp-test-temporary-file-directory)
tmp-file)
;; The remote host shall know a temporary file directory.
@@ -3217,6 +4007,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(delete-directory tmp-file)
(should-not (file-exists-p tmp-file))))
+(defun tramp--test-emacs26-p ()
+ "Check for Emacs version >= 26.1.
+Some semantics has been changed for there, w/o new functions or
+variables, so we check the Emacs version directly."
+ (>= emacs-major-version 26))
+
(defun tramp--test-adb-p ()
"Check, whether the remote host runs Android.
This requires restrictions of file name syntax."
@@ -3249,6 +4045,12 @@ Several special characters do not work properly there."
(file-truename tramp-test-temporary-file-directory) nil
(string-match "^HP-UX" (tramp-get-connection-property v "uname" ""))))
+(defun tramp--test-mock-p ()
+ "Check, whether the mock method is used.
+This does not support external Emacs calls."
+ (string-equal
+ "mock" (file-remote-p tramp-test-temporary-file-directory 'method)))
+
(defun tramp--test-rsync-p ()
"Check, whether the rsync method is used.
This does not support special file names."
@@ -3312,38 +4114,30 @@ This requires restrictions of file name syntax."
(should (string-equal (buffer-string) elt)))
;; Copy file both directions.
- (copy-file file1 tmp-name2)
+ (copy-file file1 (file-name-as-directory tmp-name2))
(should (file-exists-p file2))
(delete-file file1)
(should-not (file-exists-p file1))
- (copy-file file2 tmp-name1)
+ (copy-file file2 (file-name-as-directory tmp-name1))
(should (file-exists-p file1))
- ;; Method "smb" supports `make-symbolic-link' only if the
- ;; remote host has CIFS capabilities. tramp-adb.el and
- ;; tramp-gvfs.el do not support symbolic links at all.
- (condition-case err
- (progn
- (make-symbolic-link file1 file3)
- (should (file-symlink-p file3))
- (should
- (string-equal
- (expand-file-name file1) (file-truename file3)))
- (should
- (string-equal
- (funcall
- (if quoted 'tramp-compat-file-name-quote 'identity)
- (car (file-attributes file3)))
- (file-remote-p (file-truename file1) 'localname)))
- ;; Check file contents.
- (with-temp-buffer
- (insert-file-contents file3)
- (should (string-equal (buffer-string) elt)))
- (delete-file file3))
- (file-error
- (should
- (string-equal (error-message-string err)
- "make-symbolic-link not supported"))))))
+ (tramp--test-ignore-make-symbolic-link-error
+ (make-symbolic-link file1 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (expand-file-name file1) (file-truename file3)))
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (car (file-attributes file3)))
+ (file-remote-p (file-truename file1) 'localname)))
+ ;; Check file contents.
+ (with-temp-buffer
+ (insert-file-contents file3)
+ (should (string-equal (buffer-string) elt)))
+ (delete-file file3))))
;; Check file names.
(should (equal (directory-files
@@ -3396,27 +4190,27 @@ This requires restrictions of file name syntax."
elt))
;; Check symlink in `directory-files-and-attributes'.
- (condition-case err
- (progn
- (make-symbolic-link file2 file3)
- (should (file-symlink-p file3))
- (should
- (string-equal
- (caar (directory-files-and-attributes
- file1 nil (regexp-quote elt1)))
- elt1))
- (should
- (string-equal
- (funcall
- (if quoted 'tramp-compat-file-name-quote 'identity)
- (cadr (car (directory-files-and-attributes
- file1 nil (regexp-quote elt1)))))
- (file-remote-p (file-truename file2) 'localname)))
- (delete-file file3)
- (should-not (file-exists-p file3)))
- (file-error
- (should (string-equal (error-message-string err)
- "make-symbolic-link not supported"))))
+ ;; It does not work in the "smb" case, only relative
+ ;; symlinks to existing files are shown there.
+ (tramp--test-ignore-make-symbolic-link-error
+ (unless
+ (tramp-smb-file-name-p tramp-test-temporary-file-directory)
+ (make-symbolic-link file2 file3)
+ (should (file-symlink-p file3))
+ (should
+ (string-equal
+ (caar (directory-files-and-attributes
+ file1 nil (regexp-quote elt1)))
+ elt1))
+ (should
+ (string-equal
+ (funcall
+ (if quoted 'tramp-compat-file-name-quote 'identity)
+ (cadr (car (directory-files-and-attributes
+ file1 nil (regexp-quote elt1)))))
+ (file-remote-p (file-truename file2) 'localname)))
+ (delete-file file3)
+ (should-not (file-exists-p file3))))
(delete-file file2)
(should-not (file-exists-p file2))
@@ -3448,7 +4242,7 @@ This requires restrictions of file name syntax."
(ignore-errors (delete-directory tmp-name2 'recursive))))))
(defun tramp--test-special-characters ()
- "Perform the test in `tramp-test34-special-characters*'."
+ "Perform the test in `tramp-test38-special-characters*'."
;; Newlines, slashes and backslashes in file names are not
;; supported. So we don't test. And we don't test the tab
;; character on Windows or Cygwin, because the backslash is
@@ -3491,7 +4285,7 @@ This requires restrictions of file name syntax."
"{foo}bar{baz}"))
;; These tests are inspired by Bug#17238.
-(ert-deftest tramp-test34-special-characters ()
+(ert-deftest tramp-test38-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-rsync-p)))
@@ -3499,7 +4293,7 @@ This requires restrictions of file name syntax."
(tramp--test-special-characters))
-(ert-deftest tramp-test34-special-characters-with-stat ()
+(ert-deftest tramp-test38-special-characters-with-stat ()
"Check special characters in file names.
Use the `stat' command."
:tags '(:expensive-test)
@@ -3517,7 +4311,7 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test34-special-characters-with-perl ()
+(ert-deftest tramp-test38-special-characters-with-perl ()
"Check special characters in file names.
Use the `perl' command."
:tags '(:expensive-test)
@@ -3538,7 +4332,7 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-special-characters)))
-(ert-deftest tramp-test34-special-characters-with-ls ()
+(ert-deftest tramp-test38-special-characters-with-ls ()
"Check special characters in file names.
Use the `ls' command."
:tags '(:expensive-test)
@@ -3561,13 +4355,14 @@ Use the `ls' command."
(tramp--test-special-characters)))
(defun tramp--test-utf8 ()
- "Perform the test in `tramp-test35-utf8*'."
+ "Perform the test in `tramp-test39-utf8*'."
(let* ((utf8 (if (and (eq system-type 'darwin)
(memq 'utf-8-hfs (coding-system-list)))
'utf-8-hfs 'utf-8))
(coding-system-for-read utf8)
(coding-system-for-write utf8)
- (file-name-coding-system utf8))
+ (file-name-coding-system
+ (coding-system-change-eol-conversion utf8 'unix)))
(tramp--test-check-files
(unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ")
(unless (tramp--test-hpux-p)
@@ -3575,7 +4370,7 @@ Use the `ls' command."
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
-(ert-deftest tramp-test35-utf8 ()
+(ert-deftest tramp-test39-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(skip-unless (not (tramp--test-docker-p)))
@@ -3585,7 +4380,7 @@ Use the `ls' command."
(tramp--test-utf8))
-(ert-deftest tramp-test35-utf8-with-stat ()
+(ert-deftest tramp-test39-utf8-with-stat ()
"Check UTF8 encoding in file names and file contents.
Use the `stat' command."
:tags '(:expensive-test)
@@ -3605,7 +4400,7 @@ Use the `stat' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test35-utf8-with-perl ()
+(ert-deftest tramp-test39-utf8-with-perl ()
"Check UTF8 encoding in file names and file contents.
Use the `perl' command."
:tags '(:expensive-test)
@@ -3628,7 +4423,7 @@ Use the `perl' command."
tramp-connection-properties)))
(tramp--test-utf8)))
-(ert-deftest tramp-test35-utf8-with-ls ()
+(ert-deftest tramp-test39-utf8-with-ls ()
"Check UTF8 encoding in file names and file contents.
Use the `ls' command."
:tags '(:expensive-test)
@@ -3651,110 +4446,195 @@ Use the `ls' command."
tramp-connection-properties)))
(tramp--test-utf8)))
+(ert-deftest tramp-test40-file-system-info ()
+ "Check that `file-system-info' returns proper values."
+ (skip-unless (tramp--test-enabled))
+ ;; Since Emacs 27.1.
+ (skip-unless (fboundp 'file-system-info))
+
+ ;; `file-system-info' exists since Emacs 27. We don't want to see
+ ;; compiler warnings for older Emacsen.
+ (let ((fsi (with-no-warnings
+ (file-system-info tramp-test-temporary-file-directory))))
+ (skip-unless fsi)
+ (should (and (consp fsi)
+ (= (length fsi) 3)
+ (numberp (nth 0 fsi))
+ (numberp (nth 1 fsi))
+ (numberp (nth 2 fsi))))))
+
+(defun tramp--test-timeout-handler ()
+ (interactive)
+ (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
+
;; This test is inspired by Bug#16928.
-(ert-deftest tramp-test36-asynchronous-requests ()
+(ert-deftest tramp-test41-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
- ;; Mark as failed until bug has been fixed.
- :expected-result :failed
:tags '(:expensive-test)
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
- ;; Keep instrumentation verbosity 0 until Tramp bug is fixed.
- ;; This has the side effect, that this test fails instead to
- ;; abort. Good for hydra.
- (tramp--instrument-test-case 0
- (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
- (default-directory tmp-name)
- (remote-file-name-inhibit-cache t)
- timer buffers kill-buffer-query-functions)
+ ;; This test could be blocked on hydra. So we set a timeout of 300
+ ;; seconds, and we send a SIGUSR1 signal after 300 seconds.
+ (with-timeout (300 (tramp--test-timeout-handler))
+ (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler)
+ (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0)
+ (let* (;; For the watchdog.
+ (default-directory (expand-file-name temporary-file-directory))
+ (watchdog
+ (start-process
+ "*watchdog*" nil shell-file-name shell-command-switch
+ (format "sleep 300; kill -USR1 %d" (emacs-pid))))
+ (tmp-name (tramp--test-make-temp-name))
+ (default-directory tmp-name)
+ ;; Do not cache Tramp properties.
+ (remote-file-name-inhibit-cache t)
+ (process-file-side-effects t)
+ ;; Suppress nasty messages.
+ (inhibit-message t)
+ ;; Do not run delayed timers.
+ (timer-max-repeats 0)
+ ;; Number of asynchronous processes for test.
+ (number-proc 10)
+ ;; On hydra, timings are bad.
+ (timer-repeat
+ (cond
+ ((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 buffers kill-buffer-query-functions)
(unwind-protect
- (progn
- (make-directory tmp-name)
-
- ;; Setup a timer in order to raise an ordinary command
- ;; again and again. `vc-registered' is well suited,
- ;; because there are many checks.
- (setq
- timer
- (run-at-time
- 0 1
- (lambda ()
- (when buffers
- (vc-registered
- (buffer-name (nth (random (length buffers)) buffers)))))))
-
- ;; Create temporary buffers. The number of buffers
- ;; corresponds to the number of processes; it could be
- ;; increased in order to make pressure on Tramp.
- (dotimes (_i 5)
- (add-to-list 'buffers (generate-new-buffer "*temp*")))
-
- ;; Open asynchronous processes. Set process sentinel.
- (dolist (buf buffers)
- (async-shell-command "read line; touch $line; echo $line" buf)
- (set-process-sentinel
- (get-buffer-process buf)
- (lambda (proc _state)
- (delete-file (buffer-name (process-buffer proc))))))
-
- ;; Send a string. Use a random order of the buffers. Mix
- ;; with regular operation.
- (let ((buffers (copy-sequence buffers))
- buf)
- (while buffers
- (setq buf (nth (random (length buffers)) buffers))
- (process-send-string
- (get-buffer-process buf) (format "'%s'\n" buf))
- (file-attributes (buffer-name buf))
- (setq buffers (delq buf buffers))))
-
- ;; Wait until the whole output has been read.
- (with-timeout ((* 10 (length buffers))
- (ert-fail "`async-shell-command' timed out"))
- (let ((buffers (copy-sequence buffers))
- buf)
- (while buffers
- (setq buf (nth (random (length buffers)) buffers))
- (if (ignore-errors
- (memq (process-status (get-buffer-process buf))
- '(run open)))
- (accept-process-output (get-buffer-process buf) 0.1)
- (setq buffers (delq buf buffers))))))
-
- ;; Check.
- (dolist (buf buffers)
- (with-current-buffer buf
- (should
- (string-equal (format "'%s'\n" buf) (buffer-string)))))
- (should-not
- (directory-files
- tmp-name nil directory-files-no-dot-files-regexp)))
-
- ;; Cleanup.
- (ignore-errors (cancel-timer timer))
- (ignore-errors (delete-directory tmp-name 'recursive))
- (dolist (buf buffers)
- (ignore-errors (kill-buffer buf))))))))
-
-(ert-deftest tramp-test37-recursive-load ()
- "Check that Tramp does not fail due to recursive load."
- (skip-unless (tramp--test-enabled))
-
- (dolist (code
- (list
- (format "(expand-file-name %S)" tramp-test-temporary-file-directory)
- (format
- "(let ((default-directory %S)) (expand-file-name %S))"
- tramp-test-temporary-file-directory
- temporary-file-directory)))
- (should-not
+ (progn
+ (make-directory tmp-name)
+
+ ;; Setup a timer in order to raise an ordinary command
+ ;; again and again. `vc-registered' is well suited,
+ ;; because there are many checks.
+ (setq
+ timer
+ (run-at-time
+ 0 timer-repeat
+ (lambda ()
+ (when buffers
+ (let ((time (float-time))
+ (default-directory tmp-name)
+ (file
+ (buffer-name (nth (random (length buffers)) buffers))))
+ (tramp--test-message
+ "Start timer %s %s" file (current-time-string))
+ (funcall timer-operation file)
+ ;; Adjust timer if it takes too much time.
+ (when (> (- (float-time) time) timer-repeat)
+ (setq timer-repeat (* 1.5 timer-repeat))
+ (setf (timer--repeat-delay timer) timer-repeat)
+ (tramp--test-message "Increase timer %s" timer-repeat))
+ (tramp--test-message
+ "Stop timer %s %s" file (current-time-string)))))))
+
+ ;; Create temporary buffers. The number of buffers
+ ;; corresponds to the number of processes; it could be
+ ;; increased in order to make pressure on Tramp.
+ (dotimes (_ number-proc)
+ (setq buffers (cons (generate-new-buffer "foo") buffers)))
+
+ ;; Open asynchronous processes. Set process filter and sentinel.
+ (dolist (buf buffers)
+ ;; Activate timer.
+ (sit-for 0.01 'nodisp)
+ (let ((proc
+ (start-file-process-shell-command
+ (buffer-name buf) buf
+ (concat
+ "(read line && echo $line >$line);"
+ "(read line && cat $line);"
+ "(read line && rm $line)")))
+ (file (expand-file-name (buffer-name buf))))
+ ;; Remember the file name. Add counter.
+ (process-put proc 'foo file)
+ (process-put proc 'bar 0)
+ ;; Add process filter.
+ (set-process-filter
+ proc
+ (lambda (proc string)
+ (with-current-buffer (process-buffer proc)
+ (insert string))
+ (unless (zerop (length string))
+ (should (file-attributes (process-get proc 'foo))))))
+ ;; Add process sentinel.
+ (set-process-sentinel
+ proc
+ (lambda (proc _state)
+ (should-not (file-attributes (process-get proc 'foo)))))))
+
+ ;; Send a string. Use a random order of the buffers. Mix
+ ;; with regular operation.
+ (let ((buffers (copy-sequence buffers)))
+ (while buffers
+ ;; Activate timer.
+ (sit-for 0.01 'nodisp)
+ (let* ((buf (nth (random (length buffers)) buffers))
+ (proc (get-buffer-process buf))
+ (file (process-get proc 'foo))
+ (count (process-get proc 'bar)))
+ (tramp--test-message
+ "Start action %d %s %s" count buf (current-time-string))
+ ;; Regular operation prior process action.
+ (if (= count 0)
+ (should-not (file-attributes file))
+ (should (file-attributes file)))
+ ;; Send string to process.
+ (process-send-string proc (format "%s\n" (buffer-name buf)))
+ (accept-process-output proc 0.1 nil 0)
+ ;; Give the watchdog a chance.
+ (read-event nil nil 0.01)
+ ;; Regular operation post process action.
+ (if (= count 2)
+ (should-not (file-attributes file))
+ (should (file-attributes file)))
+ (tramp--test-message
+ "Stop action %d %s %s" count buf (current-time-string))
+ (process-put proc 'bar (1+ count))
+ (unless (process-live-p proc)
+ (setq buffers (delq buf buffers))))))
+
+ ;; Checks. All process output shall exists in the
+ ;; respective buffers. All created files shall be
+ ;; deleted.
+ (tramp--test-message "Check %s" (current-time-string))
+ (dolist (buf buffers)
+ (with-current-buffer buf
+ (should (string-equal (format "%s\n" buf) (buffer-string)))))
+ (should-not
+ (directory-files
+ tmp-name nil directory-files-no-dot-files-regexp)))
+
+ ;; Cleanup.
+ (define-key special-event-map [sigusr1] 'ignore)
+ (ignore-errors (quit-process watchdog))
+ (dolist (buf buffers)
+ (ignore-errors (delete-process (get-buffer-process buf)))
+ (ignore-errors (kill-buffer buf)))
+ (ignore-errors (cancel-timer timer))
+ (ignore-errors (delete-directory tmp-name 'recursive)))))))
+
+;; This test is inspired by Bug#29163.
+(ert-deftest tramp-test42-auto-load ()
+ "Check that Tramp autoloads properly."
+ (let ((default-directory (expand-file-name temporary-file-directory))
+ (code
+ (format
+ "(message \"Tramp loaded: %%s\" (and (file-remote-p %S) t))"
+ tramp-test-temporary-file-directory)))
+ (should
(string-match
- "Recursive load"
+ "Tramp loaded: t[\n\r]+"
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
@@ -3762,14 +4642,66 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test38-remote-load-path ()
+(ert-deftest tramp-test42-delay-load ()
+ "Check that Tramp is loaded lazily, only when needed."
+ ;; Tramp is neither loaded at Emacs startup, nor when completing a
+ ;; non-Tramp file name like "/foo". Completing a Tramp-alike file
+ ;; name like "/foo:" autoloads Tramp, when `tramp-mode' is t.
+ (let ((default-directory (expand-file-name temporary-file-directory))
+ (code
+ "(progn \
+ (setq tramp-mode %s) \
+ (message \"Tramp loaded: %%s\" (featurep 'tramp)) \
+ (file-name-all-completions \"/foo\" \"/\") \
+ (message \"Tramp loaded: %%s\" (featurep 'tramp)) \
+ (file-name-all-completions \"/foo:\" \"/\") \
+ (message \"Tramp loaded: %%s\" (featurep 'tramp)))"))
+ ;; Tramp doesn't load when `tramp-mode' is nil since Emacs 26.1.
+ (dolist (tm (if (tramp--test-emacs26-p) '(t nil) '(nil)))
+ (should
+ (string-match
+ (format
+ "Tramp loaded: nil[\n\r]+Tramp loaded: nil[\n\r]+Tramp loaded: %s[\n\r]+"
+ tm)
+ (shell-command-to-string
+ (format
+ "%s -batch -Q -L %s --eval %s"
+ (expand-file-name invocation-name invocation-directory)
+ (mapconcat 'shell-quote-argument load-path " -L ")
+ (shell-quote-argument (format code tm)))))))))
+
+(ert-deftest tramp-test42-recursive-load ()
+ "Check that Tramp does not fail due to recursive load."
+ (skip-unless (tramp--test-enabled))
+
+ (let ((default-directory (expand-file-name temporary-file-directory)))
+ (dolist (code
+ (list
+ (format
+ "(expand-file-name %S)" tramp-test-temporary-file-directory)
+ (format
+ "(let ((default-directory %S)) (expand-file-name %S))"
+ tramp-test-temporary-file-directory
+ temporary-file-directory)))
+ (should-not
+ (string-match
+ "Recursive load"
+ (shell-command-to-string
+ (format
+ "%s -batch -Q -L %s --eval %s"
+ (expand-file-name invocation-name invocation-directory)
+ (mapconcat 'shell-quote-argument load-path " -L ")
+ (shell-quote-argument code))))))))
+
+(ert-deftest tramp-test42-remote-load-path ()
"Check that Tramp autoloads its packages with remote `load-path'."
;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el.
;; It shall still work, when a remote file name is in the
;; `load-path'.
- (let ((code
- "(let ((force-load-messages t)\
- (load-path (cons \"/foo:bar:\" load-path)))\
+ (let ((default-directory (expand-file-name temporary-file-directory))
+ (code
+ "(let ((force-load-messages t) \
+ (load-path (cons \"/foo:bar:\" load-path))) \
(tramp-cleanup-all-connections))"))
(should
(string-match
@@ -3784,13 +4716,14 @@ process sentinels. They shall not disturb each other."
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
-(ert-deftest tramp-test39-unload ()
+(ert-deftest tramp-test43-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
- ;; Mark as failed until all symbols are unbound.
- :expected-result (if (featurep 'tramp) :failed :passed)
:tags '(:expensive-test)
(skip-unless noninteractive)
+ ;; The autoloaded Tramp objects are different since Emacs 26.1. We
+ ;; cannot test older Emacsen, therefore.
+ (skip-unless (tramp--test-emacs26-p))
(when (featurep 'tramp)
(unload-feature 'tramp 'force)
@@ -3799,52 +4732,54 @@ Since it unloads Tramp, it shall be the last test to run."
(should-not (all-completions "tramp" (delq 'tramp-tests features)))
;; `file-name-handler-alist' must be clean.
(should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
- ;; There shouldn't be left a bound symbol. We do not regard our
- ;; test symbols, and the Tramp unload hooks.
+ ;; There shouldn't be left a bound symbol, except buffer-local
+ ;; variables, and autoload functions. We do not regard our test
+ ;; symbols, and the Tramp unload hooks.
(mapatoms
(lambda (x)
- (and (or (boundp x) (functionp 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))
(not (string-match "^tramp--?test" (symbol-name x)))
(not (string-match "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.
+ (should-not (cl--find-class 'tramp-file-name))
+ (mapatoms
+ (lambda (x)
+ (and (functionp x)
+ (string-match "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 "-hooks?$" (symbol-name x))
+ (string-match "-\\(hook\\|function\\)s?$" (symbol-name x))
(not (string-match "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)))))))
+(defun tramp-test-all (&optional interactive)
+ "Run all tests for \\[tramp]."
+ (interactive "p")
+ (funcall
+ (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
+
;; TODO:
;; * dired-compress-file
;; * dired-uncache
-;; * file-acl
;; * file-name-case-insensitive-p
-;; * file-selinux-context
-;; * find-backup-file-name
-;; * set-file-acl
-;; * set-file-selinux-context
;; * Work on skipped tests. Make a comment, when it is impossible.
;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'.
;; * Fix `tramp-test06-directory-file-name' for `ftp'.
-;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
-;; * Fix Bug#27009. Set expected error of
-;; `tramp-test29-environment-variables-and-port-numbers'.
-;; * Fix Bug#16928. Set expected error of `tramp-test36-asynchronous-requests'.
-;; * Fix `tramp-test38-unload' (Not all symbols are unbound). Set
-;; expected error.
-
-(defun tramp-test-all (&optional interactive)
- "Run all tests for \\[tramp]."
- (interactive "p")
- (funcall
- (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^tramp"))
+;; * Fix `tramp-test29-start-file-process' on MS Windows (`process-send-eof'?).
+;; * Fix `tramp-test30-interrupt-process', timeout doesn't work reliably.
+;; * Fix Bug#16928 in `tramp-test41-asynchronous-requests'.
(provide 'tramp-tests)
;;; tramp-tests.el ends here
diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el
index 4908b883240..dca7c856783 100644
--- a/test/lisp/obarray-tests.el
+++ b/test/lisp/obarray-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/progmodes/bat-mode-tests.el b/test/lisp/progmodes/bat-mode-tests.el
index 565718eea41..71660ca437a 100644
--- a/test/lisp/progmodes/bat-mode-tests.el
+++ b/test/lisp/progmodes/bat-mode-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/progmodes/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el
index 10f424f5282..402bf47dfab 100644
--- a/test/lisp/progmodes/cc-mode-tests.el
+++ b/test/lisp/progmodes/cc-mode-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el
index 5c8c9c2a81f..2de52daeea2 100644
--- a/test/lisp/progmodes/compile-tests.el
+++ b/test/lisp/progmodes/compile-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el
index ee0837f2c4c..a6c64edeb7f 100644
--- a/test/lisp/progmodes/elisp-mode-tests.el
+++ b/test/lisp/progmodes/elisp-mode-tests.el
@@ -18,12 +18,13 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'xref)
+(eval-when-compile (require 'cl-lib))
;;; Completion
@@ -180,6 +181,61 @@
(call-interactively #'eval-last-sexp)
(should (equal (current-message) "66 (#o102, #x42, ?B)"))))))
+;;; eldoc
+
+(defun elisp-mode-tests--face-propertized-string (string)
+ "Return substring of STRING with a non-nil `face' property."
+ (let* ((start (next-single-property-change 0 'face string))
+ (end (and start (next-single-property-change start 'face string))))
+ (and end
+ (substring string start end))))
+
+(ert-deftest elisp--highlight-function-argument-indexed ()
+ (dotimes (i 3)
+ (should
+ (equal (elisp-mode-tests--face-propertized-string
+ (elisp--highlight-function-argument 'foo "(A B C)" (1+ i) "foo: "))
+ (propertize (nth i '("A" "B" "C"))
+ 'face 'eldoc-highlight-function-argument)))))
+
+(ert-deftest elisp--highlight-function-argument-keyed-1 ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(foo prompt bar :b 2)")
+ (goto-char (1+ (point-min)))
+ (cl-flet ((bold-arg (i)
+ (elisp-mode-tests--face-propertized-string
+ (elisp--highlight-function-argument
+ 'foo "(PROMPT LST &key A B C)" i "foo: "))))
+ (should-not (bold-arg 0))
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 1) "PROMPT"))
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 2) "LST"))
+ ;; Both `:b' and `2' should highlight the `B' arg.
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 3) "B"))
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 4) "B")))))
+
+(ert-deftest elisp--highlight-function-argument-keyed-2 ()
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(foo :b :a 1)")
+ (goto-char (1+ (point-min)))
+ (cl-flet ((bold-arg (i)
+ (elisp-mode-tests--face-propertized-string
+ (elisp--highlight-function-argument
+ 'foo "(X &key A B C)" i "foo: "))))
+ (should-not (bold-arg 0))
+ ;; The `:b' specifies positional arg `X'.
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 1) "X"))
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 2) "A"))
+ (progn (forward-sexp) (forward-char))
+ (should (equal (bold-arg 3) "A")))))
+
;;; xref
(defun xref-elisp-test-descr-to-target (xref)
diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el
index eec8a02f1b1..f8393317611 100644
--- a/test/lisp/progmodes/etags-tests.el
+++ b/test/lisp/progmodes/etags-tests.el
@@ -17,15 +17,21 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(require 'etags)
+(eval-when-compile (require 'cl-lib))
(defvar his-masters-voice t)
+(defconst etags-tests--test-dir
+ (or (getenv "EMACS_TEST_DIRECTORY")
+ (expand-file-name "../../.."
+ (or load-file-name buffer-file-name))))
+
(defun y-or-n-p (_prompt)
"Replacement for `y-or-n-p' that returns what we tell it to."
his-masters-voice)
@@ -38,8 +44,7 @@
(set-buffer buf-with-global-tags)
(setq default-directory (expand-file-name "."))
(visit-tags-table
- (expand-file-name "manual/etags/ETAGS.good_1"
- (getenv "EMACS_TEST_DIRECTORY")))
+ (expand-file-name "manual/etags/ETAGS.good_1" etags-tests--test-dir))
;; Check that tags in ETAGS.good_1 are recognized.
(setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t"))
(should (bufferp xref-buf))
@@ -55,8 +60,7 @@
(setq default-directory (expand-file-name "."))
(let (his-masters-voice)
(visit-tags-table
- (expand-file-name "manual/etags/ETAGS.good_3"
- (getenv "EMACS_TEST_DIRECTORY"))
+ (expand-file-name "manual/etags/ETAGS.good_3" etags-tests--test-dir)
t))
;; Check that tags in ETAGS.good_1 are recognized.
(setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t"))
@@ -84,8 +88,26 @@
(set-buffer (get-buffer-create "*foobar*"))
(fundamental-mode)
(visit-tags-table
- (expand-file-name "manual/etags/ETAGS.good_3"
- (getenv "EMACS_TEST_DIRECTORY"))
+ (expand-file-name "manual/etags/ETAGS.good_3" etags-tests--test-dir)
t)
(should (equal (should-error (xref-find-definitions "foobar123"))
'(user-error "No definitions found for: foobar123"))))
+
+(ert-deftest etags-buffer-local-tags-table-list ()
+ "Test that a buffer-local value of `tags-table-list' is used."
+ (let ((file (make-temp-file "etag-test-tmpfile")))
+ (unwind-protect
+ (progn
+ (set-buffer (find-file-noselect file))
+ (fundamental-mode)
+ (setq-local tags-table-list
+ (list (expand-file-name "manual/etags/ETAGS.good_3"
+ etags-tests--test-dir)))
+ (cl-letf ((tag-tables tags-table-list)
+ (tags-file-name nil)
+ ((symbol-function 'read-file-name)
+ (lambda (&rest _)
+ (error "We should not prompt the user"))))
+ (should (visit-tags-table-buffer))
+ (should (equal tags-file-name (car tag-tables)))))
+ (delete-file file))))
diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el
index 533a67149e7..2a9100adff6 100644
--- a/test/lisp/progmodes/f90-tests.el
+++ b/test/lisp/progmodes/f90-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -71,7 +71,7 @@ end program progname
(should (string-equal (buffer-string) f90-test-indent))))
(ert-deftest f90-test-bug3729 ()
- "Test for http://debbugs.gnu.org/3729 ."
+ "Test for https://debbugs.gnu.org/3729 ."
:expected-result :failed
(with-temp-buffer
(f90-mode)
@@ -90,7 +90,7 @@ end subroutine test")
(should (= 0 (current-indentation)))))
(ert-deftest f90-test-bug3730 ()
- "Test for http://debbugs.gnu.org/3730 ."
+ "Test for https://debbugs.gnu.org/3730 ."
(with-temp-buffer
(f90-mode)
(insert "a" )
@@ -104,7 +104,7 @@ end subroutine test")
;; TODO bug#5593
(ert-deftest f90-test-bug8691 ()
- "Test for http://debbugs.gnu.org/8691 ."
+ "Test for https://debbugs.gnu.org/8691 ."
(with-temp-buffer
(f90-mode)
(insert "module modname
@@ -119,13 +119,13 @@ end module modname")
;; TODO bug#8812
(ert-deftest f90-test-bug8820 ()
- "Test for http://debbugs.gnu.org/8820 ."
+ "Test for https://debbugs.gnu.org/8820 ."
(with-temp-buffer
(f90-mode)
(should (eq (char-syntax ?%) (string-to-char ".")))))
(ert-deftest f90-test-bug9553a ()
- "Test for http://debbugs.gnu.org/9553 ."
+ "Test for https://debbugs.gnu.org/9553 ."
(with-temp-buffer
(f90-mode)
(insert "!!!")
@@ -136,7 +136,7 @@ end module modname")
(should (equal "!!! a" (buffer-substring (point) (+ 5 (point)))))))
(ert-deftest f90-test-bug9553b ()
- "Test for http://debbugs.gnu.org/9553 ."
+ "Test for https://debbugs.gnu.org/9553 ."
(with-temp-buffer
(f90-mode)
(insert "!!!")
@@ -147,7 +147,7 @@ end module modname")
(should (equal "!!! a" (buffer-substring (point) (+ 5 (point)))))))
(ert-deftest f90-test-bug9690 ()
- "Test for http://debbugs.gnu.org/9690 ."
+ "Test for https://debbugs.gnu.org/9690 ."
(with-temp-buffer
(f90-mode)
(insert "#include \"foo.h\"")
@@ -155,7 +155,7 @@ end module modname")
(should (= 0 (current-indentation)))))
(ert-deftest f90-test-bug13138 ()
- "Test for http://debbugs.gnu.org/13138 ."
+ "Test for https://debbugs.gnu.org/13138 ."
(with-temp-buffer
(f90-mode)
(insert "program prog
@@ -174,7 +174,7 @@ end program prog")
(should (= 0 (current-indentation)))))
(ert-deftest f90-test-bug-19809 ()
- "Test for http://debbugs.gnu.org/19809 ."
+ "Test for https://debbugs.gnu.org/19809 ."
(with-temp-buffer
(f90-mode)
;; The Fortran standard says that continued strings should have
@@ -189,7 +189,7 @@ end program prog")
(should (= (point) (point-max)))))
(ert-deftest f90-test-bug20680 ()
- "Test for http://debbugs.gnu.org/20680 ."
+ "Test for https://debbugs.gnu.org/20680 ."
(with-temp-buffer
(f90-mode)
(insert "module modname
@@ -202,7 +202,7 @@ end module modname")
(should (= 2 (current-indentation)))))
(ert-deftest f90-test-bug20680b ()
- "Test for http://debbugs.gnu.org/20680 ."
+ "Test for https://debbugs.gnu.org/20680 ."
(with-temp-buffer
(f90-mode)
(insert "module modname
@@ -215,7 +215,7 @@ end module modname")
(should (= 2 (current-indentation)))))
(ert-deftest f90-test-bug20969 ()
- "Test for http://debbugs.gnu.org/20969 ."
+ "Test for https://debbugs.gnu.org/20969 ."
(with-temp-buffer
(f90-mode)
(insert "module modname
@@ -228,7 +228,7 @@ end module modname")
(should (= 2 (current-indentation)))))
(ert-deftest f90-test-bug20969b ()
- "Test for http://debbugs.gnu.org/20969 ."
+ "Test for https://debbugs.gnu.org/20969 ."
(with-temp-buffer
(f90-mode)
(insert "module modname
@@ -241,7 +241,7 @@ end module modname")
(should (= 2 (current-indentation)))))
(ert-deftest f90-test-bug21794 ()
- "Test for http://debbugs.gnu.org/21794 ."
+ "Test for https://debbugs.gnu.org/21794 ."
(with-temp-buffer
(f90-mode)
(insert "program prog
@@ -256,21 +256,25 @@ end program prog")
(should (= 5 (current-indentation)))))
(ert-deftest f90-test-bug25039 ()
- "Test for http://debbugs.gnu.org/25039 ."
+ "Test for https://debbugs.gnu.org/25039 and 28786."
(with-temp-buffer
(f90-mode)
(insert "program prog
select type (a)
-class is (c1)
-x = 1
type is (t1)
x = 2
+class is (c1)
+x = 1
+class default
+x=3
end select
end program prog")
(f90-indent-subprogram)
(forward-line -3)
- (should (= 2 (current-indentation))) ; type is
+ (should (= 2 (current-indentation))) ; class default
+ (forward-line -2)
+ (should (= 2 (current-indentation))) ; class is
(forward-line -2)
- (should (= 2 (current-indentation))))) ; class is
+ (should (= 2 (current-indentation))))) ; type is
;;; f90-tests.el ends here
diff --git a/test/lisp/progmodes/flymake-resources/Makefile b/test/lisp/progmodes/flymake-resources/Makefile
index 0f3f39791c8..494407567f2 100644
--- a/test/lisp/progmodes/flymake-resources/Makefile
+++ b/test/lisp/progmodes/flymake-resources/Makefile
@@ -1,6 +1,6 @@
# Makefile for flymake tests
-CC_OPTS = -Wall
+CC_OPTS = -Wall -Wextra
## Recent gcc (e.g. 4.8.2 on RHEL7) can automatically colorize their output,
## which can confuse flymake. Set GCC_COLORS to disable that.
@@ -8,6 +8,6 @@ CC_OPTS = -Wall
## normally use flymake, so it seems like just avoiding the issue
## in this test is fine. Set flymake-log-level to 3 to investigate.
check-syntax:
- GCC_COLORS= $(CC) $(CC_OPTS) ${CHK_SOURCES}
+ GCC_COLORS= $(CC) $(CC_OPTS) ${CHK_SOURCES} || true
# eof
diff --git a/test/lisp/progmodes/flymake-resources/errors-and-warnings.c b/test/lisp/progmodes/flymake-resources/errors-and-warnings.c
new file mode 100644
index 00000000000..1d38bd6bd27
--- /dev/null
+++ b/test/lisp/progmodes/flymake-resources/errors-and-warnings.c
@@ -0,0 +1,13 @@
+/* Flymake should notice an error on the next line, since
+ that file has at least one warning.*/
+#include "some-problems.h"
+/* But not this one */
+#include "no-problems.h"
+
+int main()
+{
+ char c = 1000; /* a note and a warning */
+ int bla;
+ char c; if (bla == (void*)3); /* an error, and two warnings */
+ return c;
+}
diff --git a/test/lisp/progmodes/flymake-resources/no-problems.h b/test/lisp/progmodes/flymake-resources/no-problems.h
new file mode 100644
index 00000000000..19ddc615b32
--- /dev/null
+++ b/test/lisp/progmodes/flymake-resources/no-problems.h
@@ -0,0 +1 @@
+typedef int no_problems;
diff --git a/test/lisp/progmodes/flymake-resources/some-problems.h b/test/lisp/progmodes/flymake-resources/some-problems.h
new file mode 100644
index 00000000000..165d8dd525e
--- /dev/null
+++ b/test/lisp/progmodes/flymake-resources/some-problems.h
@@ -0,0 +1,5 @@
+#include <stdio.h>
+
+strange;
+
+sint main();
diff --git a/test/lisp/progmodes/flymake-resources/test.pl b/test/lisp/progmodes/flymake-resources/test.pl
index d5abcb47e7f..6f4f1ccef50 100644
--- a/test/lisp/progmodes/flymake-resources/test.pl
+++ b/test/lisp/progmodes/flymake-resources/test.pl
@@ -1,2 +1,4 @@
@arr = [1,2,3,4];
+unknown;
my $b = @arr[1];
+[
diff --git a/test/lisp/progmodes/flymake-resources/test.rb b/test/lisp/progmodes/flymake-resources/test.rb
new file mode 100644
index 00000000000..1419eaf3ad2
--- /dev/null
+++ b/test/lisp/progmodes/flymake-resources/test.rb
@@ -0,0 +1,5 @@
+def bla
+ return 2
+ print "not reached"
+ something
+ oops
diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el
index 9bf6e7aa178..8eb180a5130 100644
--- a/test/lisp/progmodes/flymake-tests.el
+++ b/test/lisp/progmodes/flymake-tests.el
@@ -1,4 +1,4 @@
-;;; flymake-tests.el --- Test suite for flymake
+;;; flymake-tests.el --- Test suite for flymake -*- lexical-binding: t -*-
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
@@ -17,63 +17,356 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'ert)
(require 'flymake)
+(eval-when-compile (require 'subr-x)) ; string-trim
(defvar flymake-tests-data-directory
- (expand-file-name "lisp/progmodes/flymake-resources" (getenv "EMACS_TEST_DIRECTORY"))
+ (expand-file-name "lisp/progmodes/flymake-resources"
+ (or (getenv "EMACS_TEST_DIRECTORY")
+ (expand-file-name "../../.."
+ (or load-file-name
+ buffer-file-name))))
"Directory containing flymake test data.")
-;; Warning predicate
-(defun flymake-tests--current-face (file predicate)
- (let ((buffer (find-file-noselect
- (expand-file-name file flymake-tests-data-directory)))
- (process-environment (cons "LC_ALL=C" process-environment))
- (i 0))
+;;
+;;
+(defun flymake-tests--wait-for-backends ()
+ ;; Weirdness here... https://debbugs.gnu.org/17647#25
+ ;; ... meaning `sleep-for', and even
+ ;; `accept-process-output', won't suffice as ways to get
+ ;; process filters and sentinels to run, though they do work
+ ;; fine in a non-interactive batch session. The only thing
+ ;; that will indeed unblock pending process output is
+ ;; reading an input event, so, as a workaround, use a dummy
+ ;; `read-event' with a very short timeout.
+ (unless noninteractive (read-event "" nil 0.1))
+ (cl-loop repeat 5
+ for notdone = (cl-set-difference (flymake-running-backends)
+ (flymake-reporting-backends))
+ while notdone
+ unless noninteractive do (read-event "" nil 0.1)
+ do (sleep-for (+ 0.5 flymake-no-changes-timeout))
+ finally (when notdone (ert-fail
+ (format "Some backends not reporting yet %s"
+ notdone)))))
+
+(cl-defun flymake-tests--call-with-fixture (fn file
+ &key (severity-predicate
+ nil sev-pred-supplied-p))
+ "Call FN after flymake setup in FILE, using `flymake-proc`.
+SEVERITY-PREDICATE is used to setup
+`flymake-proc-diagnostic-type-pred'"
+ (let* ((file (expand-file-name file flymake-tests-data-directory))
+ (visiting (find-buffer-visiting file))
+ (buffer (or visiting (find-file-noselect file)))
+ (process-environment (cons "LC_ALL=C" process-environment))
+ (warning-minimum-log-level :error))
(unwind-protect
(with-current-buffer buffer
- (setq-local flymake-warning-predicate predicate)
- (goto-char (point-min))
- (flymake-mode 1)
- ;; Weirdness here... http://debbugs.gnu.org/17647#25
- (while (and flymake-is-running (< (setq i (1+ i)) 10))
- (sleep-for (+ 0.5 flymake-no-changes-timeout)))
- (flymake-goto-next-error)
- (face-at-point))
- (and buffer (let (kill-buffer-query-functions) (kill-buffer buffer))))))
+ (save-excursion
+ (when sev-pred-supplied-p
+ (setq-local flymake-proc-diagnostic-type-pred severity-predicate))
+ (goto-char (point-min))
+ (let ((flymake-start-on-flymake-mode nil))
+ (unless flymake-mode (flymake-mode 1)))
+ (flymake-start)
+ (flymake-tests--wait-for-backends)
+ (funcall fn)))
+ (and buffer
+ (not visiting)
+ (let (kill-buffer-query-functions) (kill-buffer buffer))))))
+
+(cl-defmacro flymake-tests--with-flymake ((file &rest args)
+ &body body)
+ (declare (indent 1)
+ (debug (sexp &rest form)))
+ `(flymake-tests--call-with-fixture (lambda () ,@body) ,file ,@args))
(ert-deftest warning-predicate-rx-gcc ()
"Test GCC warning via regexp predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
- (should (eq 'flymake-warnline
- (flymake-tests--current-face "test.c" "^[Ww]arning"))))
+ (flymake-tests--with-flymake
+ ("test.c" :severity-predicate "^[Ww]arning")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning
+ (face-at-point)))))
(ert-deftest warning-predicate-function-gcc ()
"Test GCC warning via function predicate."
(skip-unless (and (executable-find "gcc") (executable-find "make")))
- (should (eq 'flymake-warnline
- (flymake-tests--current-face "test.c"
- (lambda (msg) (string-match "^[Ww]arning" msg))))))
+ (flymake-tests--with-flymake
+ ("test.c" :severity-predicate
+ (lambda (msg) (string-match "^[Ww]arning" msg)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning
+ (face-at-point)))))
-(ert-deftest warning-predicate-rx-perl ()
- "Test perl warning via regular expression predicate."
+(ert-deftest perl-backend ()
+ "Test the perl backend"
(skip-unless (executable-find "perl"))
- (should (eq 'flymake-warnline
- (flymake-tests--current-face "test.pl" "^Scalar value"))))
+ (flymake-tests--with-flymake ("test.pl")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (goto-char (point-max))
+ (flymake-goto-prev-error)
+ (should (eq 'flymake-error (face-at-point)))))
+
+(ert-deftest ruby-backend ()
+ "Test the ruby backend"
+ (skip-unless (executable-find "ruby"))
+ ;; Some versions of ruby fail if HOME doesn't exist (bug#29187).
+ (let* ((tempdir (make-temp-file "flymake-tests-ruby" t))
+ (process-environment (cons (format "HOME=%s" tempdir)
+ process-environment))
+ ;; And see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19657#20
+ ;; for this particular yuckiness
+ (abbreviated-home-dir nil))
+ (unwind-protect
+ (flymake-tests--with-flymake ("test.rb")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point))))
+ (delete-directory tempdir t))))
+
+(ert-deftest different-diagnostic-types ()
+ "Test GCC warning via function predicate."
+ (skip-unless (and (executable-find "gcc")
+ (version<=
+ "5" (string-trim
+ (shell-command-to-string "gcc -dumpversion")))
+ (executable-find "make")))
+ (let ((flymake-wrap-around nil))
+ (flymake-tests--with-flymake
+ ("errors-and-warnings.c")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-note (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (should-error (flymake-goto-next-error nil nil t)))))
+
+(ert-deftest included-c-header-files ()
+ "Test inclusion of .h header files."
+ (skip-unless (and (executable-find "gcc") (executable-find "make")))
+ (let ((flymake-wrap-around nil))
+ (flymake-tests--with-flymake
+ ("some-problems.h")
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point)))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point)))
+ (should-error (flymake-goto-next-error nil nil t)))
+ (flymake-tests--with-flymake
+ ("no-problems.h")
+ (should-error (flymake-goto-next-error nil nil t)))))
+
+(defmacro flymake-tests--assert-set (set
+ should
+ should-not)
+ (declare (indent 1))
+ `(progn
+ ,@(cl-loop
+ for s in should
+ collect `(should (memq (quote ,s) ,set)))
+ ,@(cl-loop
+ for s in should-not
+ collect `(should-not (memq (quote ,s) ,set)))))
+
+(defun flymake-tests--diagnose-words
+ (report-fn type words)
+ "Helper. Call REPORT-FN with diagnostics for WORDS in buffer."
+ (funcall report-fn
+ (cl-loop
+ for word in words
+ append
+ (save-excursion
+ (goto-char (point-min))
+ (cl-loop while (word-search-forward word nil t)
+ collect (flymake-make-diagnostic
+ (current-buffer)
+ (match-beginning 0)
+ (match-end 0)
+ type
+ (concat word " is wrong")))))))
+
+(ert-deftest dummy-backends ()
+ "Test many different kinds of backends."
+ (with-temp-buffer
+ (cl-letf
+ (((symbol-function 'error-backend)
+ (lambda (report-fn)
+ (run-with-timer
+ 0.5 nil
+ #'flymake-tests--diagnose-words report-fn :error '("manha" "prognata"))))
+ ((symbol-function 'warning-backend)
+ (lambda (report-fn)
+ (run-with-timer
+ 0.5 nil
+ #'flymake-tests--diagnose-words report-fn :warning '("ut" "dolor"))))
+ ((symbol-function 'sync-backend)
+ (lambda (report-fn)
+ (flymake-tests--diagnose-words report-fn :note '("quis" "commodo"))))
+ ((symbol-function 'panicking-backend)
+ (lambda (report-fn)
+ (run-with-timer
+ 0.5 nil
+ report-fn :panic :explanation "The spanish inquisition!")))
+ ((symbol-function 'crashing-backend)
+ (lambda (_report-fn)
+ ;; HACK: Shoosh log during tests
+ (setq-local warning-minimum-log-level :emergency)
+ (error "crashed"))))
+ (insert "Lorem ipsum dolor sit amet, consectetur adipiscing
+ elit, sed do eiusmod tempor incididunt ut labore et dolore
+ manha aliqua. Ut enim ad minim veniam, quis nostrud
+ exercitation ullamco laboris nisi ut aliquip ex ea commodo
+ consequat. Duis aute irure dolor in reprehenderit in
+ voluptate velit esse cillum dolore eu fugiat nulla
+ pariatur. Excepteur sint occaecat cupidatat non prognata
+ sunt in culpa qui officia deserunt mollit anim id est
+ laborum.")
+ (let ((flymake-diagnostic-functions
+ (list 'error-backend 'warning-backend 'sync-backend
+ 'panicking-backend
+ 'crashing-backend
+ ))
+ (flymake-wrap-around nil))
+ (let ((flymake-start-on-flymake-mode nil))
+ (flymake-mode))
+ (flymake-start)
+
+ (flymake-tests--assert-set (flymake-running-backends)
+ (error-backend warning-backend panicking-backend)
+ (crashing-backend))
+
+ (flymake-tests--assert-set (flymake-disabled-backends)
+ (crashing-backend)
+ (error-backend warning-backend sync-backend
+ panicking-backend))
+
+ (flymake-tests--wait-for-backends)
+
+ (flymake-tests--assert-set (flymake-disabled-backends)
+ (crashing-backend panicking-backend)
+ (error-backend warning-backend sync-backend))
+
+ (goto-char (point-min))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point))) ; dolor
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point))) ; ut
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point))) ; manha
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point))) ; Ut
+ (flymake-goto-next-error)
+ (should (eq 'flymake-note (face-at-point))) ; quis
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point))) ; ut
+ (flymake-goto-next-error)
+ (should (eq 'flymake-note (face-at-point))) ; commodo
+ (flymake-goto-next-error)
+ (should (eq 'flymake-warning (face-at-point))) ; dolor
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point))) ; prognata
+ (should-error (flymake-goto-next-error nil nil t))))))
+
+(ert-deftest recurrent-backend ()
+ "Test a backend that calls REPORT-FN multiple times"
+ (with-temp-buffer
+ (let (tick)
+ (cl-letf
+ (((symbol-function 'eager-backend)
+ (lambda (report-fn)
+ (funcall report-fn nil :explanation "very eager but no diagnostics")
+ (display-buffer (current-buffer))
+ (run-with-timer
+ 0.5 nil
+ (lambda ()
+ (flymake-tests--diagnose-words report-fn :warning '("consectetur"))
+ (setq tick t)
+ (run-with-timer
+ 0.5 nil
+ (lambda ()
+ (flymake-tests--diagnose-words report-fn :error '("fugiat"))
+ (setq tick t))))))))
+ (insert "Lorem ipsum dolor sit amet, consectetur adipiscing
+ elit, sed do eiusmod tempor incididunt ut labore et dolore
+ manha aliqua. Ut enim ad minim veniam, quis nostrud
+ exercitation ullamco laboris nisi ut aliquip ex ea commodo
+ consequat. Duis aute irure dolor in reprehenderit in
+ voluptate velit esse cillum dolore eu fugiat nulla
+ pariatur. Excepteur sint occaecat cupidatat non prognata
+ sunt in culpa qui officia deserunt mollit anim id est
+ laborum.")
+ (let ((flymake-diagnostic-functions
+ (list 'eager-backend))
+ (flymake-wrap-around nil))
+ (let ((flymake-start-on-flymake-mode nil))
+ (flymake-mode))
+ (flymake-start)
+ (flymake-tests--assert-set (flymake-running-backends)
+ (eager-backend) ())
+ (cl-loop until tick repeat 4 do (sleep-for 0.2))
+ (setq tick nil)
+ (goto-char (point-max))
+ (flymake-goto-prev-error)
+ (should (eq 'flymake-warning (face-at-point))) ; consectetur
+ (should-error (flymake-goto-prev-error nil nil t))
+ (cl-loop until tick repeat 4 do (sleep-for 0.2))
+ (flymake-goto-next-error)
+ (should (eq 'flymake-error (face-at-point))) ; fugiat
+ (flymake-goto-prev-error)
+ (should (eq 'flymake-warning (face-at-point))) ; back at consectetur
+ (should-error (flymake-goto-prev-error nil nil t))
+ )))))
+
+(ert-deftest eob-region-and-trailing-newline ()
+ "`flymake-diag-region' at eob with varying trailing newlines."
+ (cl-flet ((diag-region-substring
+ (line col)
+ (pcase-let
+ ((`(,a . ,b) (flymake-diag-region (current-buffer) line col)))
+ (buffer-substring a b))))
+ (with-temp-buffer
+ (insert "beg\nmmm\nend")
+ (should (equal
+ (diag-region-substring 3 3)
+ "d"))
+ (should (equal
+ (diag-region-substring 3 nil)
+ "end"))
+ (insert "\n")
+ (should (equal
+ (diag-region-substring 4 1)
+ "end"))
+ (should (equal
+ (diag-region-substring 4 nil)
+ "end"))
+ (insert "\n")
+ (should (equal
+ (diag-region-substring 5 1)
+ "\n"))
+ (should (equal
+ (diag-region-substring 5 nil)
+ "\n")))))
+
-(ert-deftest warning-predicate-function-perl ()
- "Test perl warning via function predicate."
- (skip-unless (executable-find "perl"))
- (should (eq 'flymake-warnline
- (flymake-tests--current-face
- "test.pl"
- (lambda (msg) (string-match "^Scalar value" msg))))))
(provide 'flymake-tests)
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index 8e1bac10cd1..35143b1ec79 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -60,6 +60,25 @@
* Load the inspector's shared head.js for use by tests that need to
* open the something or other"))))
+(ert-deftest js-mode-fill-comment-bug ()
+ (with-temp-buffer
+ (insert "/**
+ * javadoc stuff here
+ *
+ * what
+ */
+function f( ) {
+ // comment-auto-fill-only-comments is a variable defined in ‘newcomment.el’. comment comment")
+ (js-mode)
+ (setq-local comment-auto-fill-only-comments t)
+ (setq-local fill-column 75)
+ (auto-fill-mode 1)
+ (funcall auto-fill-function)
+ (beginning-of-line)
+ ;; Filling should have inserted the correct comment start.
+ (should (equal (buffer-substring (point) (+ 7 (point)))
+ " // "))))
+
(ert-deftest js-mode-regexp-syntax ()
(with-temp-buffer
;; Normally indentation tests are done in manual/indent, but in
diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el
index f76ecbbd3d4..010eb67160c 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -1109,6 +1109,37 @@ def fn(a, b, c=True):
(should (eq (car (python-indent-context)) :inside-string))
(should (= (python-indent-calculate-indentation) 4))))
+(ert-deftest python-indent-electric-comma-inside-multiline-string ()
+ "Test indentation ...."
+ (python-tests-with-temp-buffer
+ "
+a = (
+ '''\
+- foo,
+- bar
+'''
+"
+ (python-tests-look-at "- bar")
+ (should (eq (car (python-indent-context)) :inside-string))
+ (goto-char (line-end-position))
+ (python-tests-self-insert ",")
+ (should (= (current-indentation) 0))))
+
+(ert-deftest python-indent-electric-comma-after-multiline-string ()
+ "Test indentation ...."
+ (python-tests-with-temp-buffer
+ "
+a = (
+ '''\
+- foo,
+- bar'''
+"
+ (python-tests-look-at "- bar'''")
+ (should (eq (car (python-indent-context)) :inside-string))
+ (goto-char (line-end-position))
+ (python-tests-self-insert ",")
+ (should (= (current-indentation) 0))))
+
(ert-deftest python-indent-electric-colon-1 ()
"Test indentation case from Bug#18228."
(python-tests-with-temp-buffer
@@ -2522,20 +2553,6 @@ if x:
(should (string= (python-shell-internal-get-process-name)
(format "%s[%s]" python-shell-internal-buffer-name (buffer-name))))))
-(ert-deftest python-shell-calculate-command-1 ()
- "Check the command to execute is calculated correctly.
-Using `python-shell-interpreter' and
-`python-shell-interpreter-args'."
- (skip-unless (executable-find python-tests-shell-interpreter))
- (let ((python-shell-interpreter (executable-find
- python-tests-shell-interpreter))
- (python-shell-interpreter-args "-B"))
- (should (string=
- (format "%s %s"
- (shell-quote-argument python-shell-interpreter)
- python-shell-interpreter-args)
- (python-shell-calculate-command)))))
-
(ert-deftest python-shell-calculate-pythonpath-1 ()
"Test PYTHONPATH calculation."
(let ((process-environment '("PYTHONPATH=/path0"))
@@ -2575,7 +2592,7 @@ Using `python-shell-interpreter' and
"Test `python-shell-virtualenv-root' modification."
(let* ((python-shell-virtualenv-root "/env")
(process-environment
- (let (process-environment process-environment)
+ (let ((process-environment process-environment))
(setenv "PYTHONHOME" "/home")
(setenv "VIRTUAL_ENV")
(python-shell-calculate-process-environment))))
diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el
index f04483f6d7c..aa177e31b46 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el
index 27a72aa2c23..15f59529b2a 100644
--- a/test/lisp/progmodes/sql-tests.el
+++ b/test/lisp/progmodes/sql-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -43,5 +43,15 @@
(should (equal (sql-postgres-list-databases)
'("db-name-1" "db_name_2")))))
+(ert-deftest sql-tests-postgres-list-databases-error ()
+ "Test that nil is returned when `psql -ltX' fails."
+ (cl-letf
+ (((symbol-function 'executable-find)
+ (lambda (_command) t))
+ ((symbol-function 'process-lines)
+ (lambda (_program &rest _args)
+ (error "some error"))))
+ (should-not (sql-postgres-list-databases))))
+
(provide 'sql-tests)
;;; sql-tests.el ends here
diff --git a/test/lisp/progmodes/subword-tests.el b/test/lisp/progmodes/subword-tests.el
index 39512efdbe1..66fe1472e4c 100644
--- a/test/lisp/progmodes/subword-tests.el
+++ b/test/lisp/progmodes/subword-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -58,12 +58,12 @@
(insert line)
;; Test forward motion.
-
+
(goto-char (point-min))
(let ((stops (make-string (length fwrd) ?\ )))
(while (progn
(aset stops (1- (point)) ?\*)
- (not (eobp)))
+ (not (eobp)))
(forward-word))
(should (equal stops fwrd)))
@@ -73,7 +73,7 @@
(let ((stops (make-string (length bkwd) ?\ )))
(while (progn
(aset stops (1- (point)) ?\*)
- (not (bobp)))
+ (not (bobp)))
(backward-word))
(should (equal stops bkwd))))))
diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el
index b7f0f0526c6..465aab51128 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/ps-print-tests.el b/test/lisp/ps-print-tests.el
index e1df37b645d..0eb65aab61c 100644
--- a/test/lisp/ps-print-tests.el
+++ b/test/lisp/ps-print-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el
new file mode 100644
index 00000000000..fd6d1edea25
--- /dev/null
+++ b/test/lisp/register-tests.el
@@ -0,0 +1,43 @@
+;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Tino Calancha <tino.calancha@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (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 'cl-lib)
+
+(ert-deftest register-test-bug27634 ()
+ "Test for https://debbugs.gnu.org/27634 ."
+ (dolist (event (list ?\C-g 'escape ?\C-\[))
+ (cl-letf (((symbol-function 'read-key) #'ignore)
+ (last-input-event event)
+ (register-alist nil))
+ (should (equal 'quit
+ (condition-case err
+ (call-interactively 'point-to-register)
+ (quit (car err)))))
+ (should-not register-alist))))
+
+(provide 'register-tests)
+;;; register-tests.el ends here
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index adef5a3f3dc..e9564e555ee 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -54,7 +54,7 @@ fx
6:fx
")
;; * Test multi-line matches, this is the first test from
- ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
+ ;; https://lists.gnu.org/r/emacs-devel/2005-06/msg01008.html
;; where numbers are replaced with letters.
("a\na" 0 "\
a
@@ -70,7 +70,7 @@ a
:a
")
;; * Test multi-line matches, this is the second test from
- ;; http://lists.gnu.org/archive/html/emacs-devel/2005-06/msg01008.html
+ ;; https://lists.gnu.org/r/emacs-devel/2005-06/msg01008.html
;; where numbers are replaced with letters.
("a\nb" 0 "\
a
@@ -358,4 +358,26 @@ Each element has the format:
(dotimes (i (length replace-occur-tests))
(replace-occur-test-create i))
+(defun replace-tests--query-replace-undo (&optional comma)
+ (with-temp-buffer
+ (insert "111")
+ (goto-char 1)
+ (let ((count 0))
+ ;; Don't wait for user input.
+ (cl-letf (((symbol-function 'read-event)
+ (lambda (&rest args)
+ (cl-incf count)
+ (let ((val (pcase count
+ ('2 (if comma ?, ?\s)) ; replace and: ',' no move; '\s' go next
+ ('3 ?u) ; undo
+ ('4 ?q) ; exit
+ (_ ?\s)))) ; replace current and go next
+ val))))
+ (perform-replace "1" "2" t nil nil)))
+ (buffer-string)))
+
+(ert-deftest query-replace--undo ()
+ (should (string= "211" (replace-tests--query-replace-undo)))
+ (should (string= "211" (replace-tests--query-replace-undo 'comma))))
+
;;; replace-tests.el ends here
diff --git a/test/lisp/rot13-tests.el b/test/lisp/rot13-tests.el
index 70fe34510dd..1eae3976ef5 100644
--- a/test/lisp/rot13-tests.el
+++ b/test/lisp/rot13-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el
new file mode 100644
index 00000000000..3194b261565
--- /dev/null
+++ b/test/lisp/ses-tests.el
@@ -0,0 +1,175 @@
+;;; ses-tests.el --- Tests for ses.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
+
+;; Author: Vincent Belaïche <vincentb1@users.sourceforge.net>
+
+;; 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 'ses)
+
+
+;; PLAIN FORMULA TESTS
+;; ======================================================================
+
+(ert-deftest ses-tests-lowlevel-plain-formula ()
+ "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value
+equal to 2. This is done with low level functions calls, not like
+interactively."
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 (1+ A1))))
+ (apply 'ses-cell-set-formula c)
+ (apply 'ses-calculate-cell (list (car c) (cadr c) nil)))
+ (should (eq A2 2)))))
+
+(ert-deftest ses-tests-plain-formula ()
+ "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value
+equal to 2. This is done using interactive calls."
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 (1+ A1))))
+ (apply 'funcall-interactively 'ses-edit-cell c))
+ (ses-command-hook)
+ (should (eq A2 2)))))
+
+;; PLAIN CELL RENAMING TESTS
+;; ======================================================================
+
+(ert-deftest ses-tests-lowlevel-renamed-cell ()
+ "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 to (1+ foo), makes A2 value equal to 2.
+This is done using low level functions, `ses-rename-cell' is not
+called but instead we use text replacement in the buffer
+previously passed in text mode."
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 (1+ A1))))
+ (apply 'ses-cell-set-formula c)
+ (apply 'ses-calculate-cell (list (car c) (cadr c) nil)))
+ (ses-write-cells)
+ (text-mode)
+ (goto-char (point-min))
+ (while (re-search-forward "\\<A1\\>" nil t)
+ (replace-match "foo" t t))
+ (ses-mode)
+ (should-not (local-variable-p 'A1))
+ (should (eq foo 1))
+ (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ foo))))
+ (should (eq A2 2)))))
+
+(ert-deftest ses-tests-renamed-cell ()
+ "Check that renaming A1 to `foo' and setting `foo' to 1 and A2
+to (1+ foo), makes A2 value equal to 2."
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (ses-rename-cell 'foo (ses-get-cell 0 0))
+ (dolist (c '((0 0 1) (1 0 (1+ foo))))
+ (apply 'funcall-interactively 'ses-edit-cell c))
+ (ses-command-hook)
+ (should-not (local-variable-p 'A1))
+ (should (eq foo 1))
+ (should (equal (ses-cell-formula 1 0) '(1+ foo)))
+ (should (eq A2 2)))))
+
+(ert-deftest ses-tests-renamed-cell-after-setting ()
+ "Check that setting A1 to 1 and A2 to (1+ A1), and then
+renaming A1 to `foo' makes `foo' value equal to 2."
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 (1+ A1))))
+ (apply 'funcall-interactively 'ses-edit-cell c))
+ (ses-command-hook); deferred recalc
+ (ses-rename-cell 'foo (ses-get-cell 0 0))
+ (should-not (local-variable-p 'A1))
+ (should (eq foo 1))
+ (should (equal (ses-cell-formula 1 0) '(1+ foo)))
+ (should (eq A2 2)))))
+
+(ert-deftest ses-tests-renaming-cell-with-one-symbol-formula ()
+ "Check that setting A1 to 1 and A2 to A1, and then renaming A1
+to `foo' makes `foo' value equal to 1. Then set A1 to 2 and check
+that `foo' becomes 2."
+ (let ((ses-initial-size '(3 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 A1)))
+ (apply 'funcall-interactively 'ses-edit-cell c))
+ (ses-command-hook); deferred recalc
+ (ses-rename-cell 'foo (ses-get-cell 0 0))
+ (ses-command-hook); deferred recalc
+ (should-not (local-variable-p 'A1))
+ (should (eq foo 1))
+ (should (equal (ses-cell-formula 1 0) 'foo))
+ (should (eq A2 1))
+ (funcall-interactively 'ses-edit-cell 0 0 2)
+ (ses-command-hook); deferred recalc
+ (should (eq A2 2))
+ (should (eq foo 2)))))
+
+
+;; ROW INSERTION TESTS
+;; ======================================================================
+
+(ert-deftest ses-tests-plain-row-insertion ()
+ "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping
+to A2 and inserting a row, makes A2 value empty, and A3 equal to
+2."
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 (1+ A1))))
+ (apply 'funcall-interactively 'ses-edit-cell c))
+ (ses-command-hook)
+ (ses-jump 'A2)
+ (ses-insert-row 1)
+ (ses-command-hook)
+ (should-not A2)
+ (should (eq A3 2)))))
+
+; (defvar ses-tests-trigger nil)
+
+(ert-deftest ses-tests-renamed-cells-row-insertion ()
+ "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `foo' and A2 to `bar' jumping
+to `bar' and inserting a row, makes A2 value empty, and `bar' equal to
+2."
+ (setq ses-tests-trigger nil)
+ (let ((ses-initial-size '(2 . 1)))
+ (with-temp-buffer
+ (ses-mode)
+ (dolist (c '((0 0 1) (1 0 (1+ A1))))
+ (apply 'funcall-interactively 'ses-edit-cell c))
+ (ses-command-hook)
+ (ses-rename-cell 'foo (ses-get-cell 0 0))
+ (ses-command-hook)
+ (ses-rename-cell 'bar (ses-get-cell 1 0))
+ (ses-command-hook)
+ (should (eq bar 2))
+ (ses-jump 'bar)
+ (ses-insert-row 1)
+ (ses-command-hook)
+ (should-not A2)
+ (should (eq bar 2)))))
+
+
+(provide 'ses-tests)
diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el
index 6eb9cdcdd18..c51150069a6 100644
--- a/test/lisp/shell-tests.el
+++ b/test/lisp/shell-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 180dcc0a209..521365bbb94 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -188,7 +188,7 @@
;; From 24 Oct - 21 Nov 2015, `open-line' took a second argument
;; INTERACTIVE and ran `post-self-insert-hook' if the argument was
;; true. This test tested that. Currently, however, `open-line'
-;; does not run run `post-self-insert-hook' at all, so for now
+;; does not run `post-self-insert-hook' at all, so for now
;; this test just makes sure that it doesn't.
(ert-deftest open-line-hook ()
(let* ((x 0)
@@ -280,7 +280,7 @@
(undo-auto--boundaries 'test))))
;; Test for a regression introduced by undo-auto--boundaries changes.
-;; https://lists.gnu.org/archive/html/emacs-devel/2015-11/msg01652.html
+;; https://lists.gnu.org/r/emacs-devel/2015-11/msg01652.html
(defun undo-test-kill-c-a-then-undo ()
(with-temp-buffer
(switch-to-buffer (current-buffer))
@@ -448,5 +448,68 @@ See Bug#21722."
(call-interactively #'eval-expression)
(should (equal (current-message) "66 (#o102, #x42, ?B)"))))))
+(ert-deftest line-number-at-pos-in-widen-buffer ()
+ (let ((target-line 3))
+ (with-temp-buffer
+ (insert "a\nb\nc\nd\n")
+ (goto-char (point-min))
+ (forward-line (1- target-line))
+ (should (equal (line-number-at-pos) target-line))
+ (should (equal (line-number-at-pos nil t) target-line)))))
+
+(ert-deftest line-number-at-pos-in-narrow-buffer ()
+ (let ((target-line 3))
+ (with-temp-buffer
+ (insert "a\nb\nc\nd\n")
+ (goto-char (point-min))
+ (forward-line (1- target-line))
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (should (equal (line-number-at-pos) 1))
+ (should (equal (line-number-at-pos nil t) target-line)))))
+
+(ert-deftest line-number-at-pos-keeps-restriction ()
+ (with-temp-buffer
+ (insert "a\nb\nc\nd\n")
+ (goto-char (point-min))
+ (forward-line 2)
+ (narrow-to-region (line-beginning-position) (line-end-position))
+ (should (equal (line-number-at-pos) 1))
+ (line-number-at-pos nil t)
+ (should (equal (line-number-at-pos) 1))))
+
+(ert-deftest line-number-at-pos-keeps-point ()
+ (let (pos)
+ (with-temp-buffer
+ (insert "a\nb\nc\nd\n")
+ (goto-char (point-min))
+ (forward-line 2)
+ (setq pos (point))
+ (line-number-at-pos)
+ (line-number-at-pos nil t)
+ (should (equal pos (point))))))
+
+(ert-deftest line-number-at-pos-when-passing-point ()
+ (let (pos)
+ (with-temp-buffer
+ (insert "a\nb\nc\nd\n")
+ (should (equal (line-number-at-pos 1) 1))
+ (should (equal (line-number-at-pos 3) 2))
+ (should (equal (line-number-at-pos 5) 3))
+ (should (equal (line-number-at-pos 7) 4)))))
+
+
+;;; Auto fill.
+
+(ert-deftest auto-fill-mode-no-break-before-length-of-fill-prefix ()
+ (with-temp-buffer
+ (setq-local fill-prefix " ")
+ (set-fill-column 5)
+ ;; Shouldn't break after 'foo' (3 characters) when the next
+ ;; line is indented >= to that, that wouldn't result in shorter
+ ;; lines.
+ (insert "foo bar")
+ (do-auto-fill)
+ (should (string-equal (buffer-string) "foo bar"))))
+
(provide 'simple-test)
;;; simple-test.el ends here
diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el
index f6cbe90d5bf..a53b8e5380b 100644
--- a/test/lisp/sort-tests.el
+++ b/test/lisp/sort-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/soundex-tests.el b/test/lisp/soundex-tests.el
new file mode 100644
index 00000000000..59bdfa4e01e
--- /dev/null
+++ b/test/lisp/soundex-tests.el
@@ -0,0 +1,43 @@
+;;; soundex-tests.el --- tests for soundex.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Test `soundex-test-names' originally adapted from code in
+;; soundex.el by Christian Plaunt <chris@bliss.berkeley.edu>
+
+;;; Code:
+
+(require 'ert)
+(require 'soundex)
+
+(defconst soundex-test-name-list
+ '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz"
+ "Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous")
+ "Knuth's names to demonstrate the Soundex algorithm.")
+
+(ert-deftest soundex-test-names ()
+ (should
+ (equal (mapcar #'soundex soundex-test-name-list)
+ '("E460" "G200" "H416" "K530" "L300" "L222"
+ "E460" "G200" "H416" "K530" "L300" "L222"))))
+
+;;; soundex-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 54f4ab5d1b2..a68688eba7a 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -258,9 +258,9 @@ This exercises `backtrace-frame', and indirectly `mapbacktrace'."
(should (equal (mapbacktrace #'error unbound) nil)))
;; First frame is backtrace-related function
(should (equal (backtrace-frame 0) '(t backtrace-frame 0)))
- (should (equal (catch 'ret
- (mapbacktrace (lambda (&rest args) (throw 'ret args))))
- '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil)))
+ (let ((throw-args (lambda (&rest args) (throw 'ret args))))
+ (should (equal (catch 'ret (mapbacktrace throw-args))
+ `(t mapbacktrace (,throw-args) nil))))
;; Past-end NFRAMES is silently ignored
(should (equal (backtrace-frame most-positive-fixnum) nil)))
@@ -292,39 +292,20 @@ cf. Bug#25477."
(should-error (eval '(dolist "foo") t)
:type 'wrong-type-argument))
-(require 'cl-generic)
-(cl-defgeneric subr-tests--generic (x))
-(cl-defmethod subr-tests--generic ((x string))
- (message "%s is a string" x))
-(cl-defmethod subr-tests--generic ((x integer))
- (message "%s is a number" x))
-(cl-defgeneric subr-tests--generic-without-methods (x y))
-(defvar subr-tests--this-file
- (file-truename (or load-file-name buffer-file-name)))
-
-(ert-deftest subr-tests--method-files--finds-methods ()
- "`method-files' returns a list of files and methods for a generic function."
- (let ((retval (method-files 'subr-tests--generic)))
- (should (equal (length retval) 2))
- (mapc (lambda (x)
- (should (equal (car x) subr-tests--this-file))
- (should (equal (cadr x) 'subr-tests--generic)))
- retval)
- (should-not (equal (nth 0 retval) (nth 1 retval)))))
-
-(ert-deftest subr-tests--method-files--nonexistent-methods ()
- "`method-files' returns nil if asked to find a method which doesn't exist."
- (should-not (method-files 'subr-tests--undefined-generic))
- (should-not (method-files 'subr-tests--generic-without-methods)))
-
(ert-deftest subr-tests-bug22027 ()
- "Test for http://debbugs.gnu.org/22027 ."
+ "Test for https://debbugs.gnu.org/22027 ."
(let ((default "foo") res)
(cl-letf (((symbol-function 'read-string)
(lambda (_prompt _init _hist def) def)))
(setq res (read-passwd "pass: " 'confirm (mapconcat #'string default "")))
(should (string= default res)))))
+(ert-deftest subr-tests--gensym ()
+ "Test `gensym' behavior."
+ (should (equal (symbol-name (let ((gensym-counter 0)) (gensym)))
+ "g0"))
+ (should (eq (string-to-char (symbol-name (gensym))) ?g))
+ (should (eq (string-to-char (symbol-name (gensym "X"))) ?X)))
(provide 'subr-tests)
;;; subr-tests.el ends here
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
new file mode 100644
index 00000000000..e005c2d8cc0
--- /dev/null
+++ b/test/lisp/tar-mode-tests.el
@@ -0,0 +1,36 @@
+;;; tar-mode-tests.el --- Test suite for tar-mode. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 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 'tar-mode)
+
+
+(ert-deftest tar-mode-test-tar-grind-file-mode ()
+ (let ((alist (list (cons 448 "rwx------")
+ (cons 420 "rw-r--r--")
+ (cons 292 "r--r--r--")
+ (cons 512 "--------T")
+ (cons 1024 "-----S---"))))
+ (dolist (x alist)
+ (should (equal (cdr x) (tar-grind-file-mode (car x)))))))
+
+(provide 'tar-mode-tests)
+
+;; tar-mode-tests.el ends here
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index 68946a01c06..47cf5f9244b 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -18,7 +18,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -80,6 +80,27 @@
(equal (seq-sort #'string-lessp (css--value-class-lookup 'position))
'("bottom" "calc()" "center" "left" "right" "top"))))
+(ert-deftest css-test-current-defun-name ()
+ (with-temp-buffer
+ (insert "body { top: 0; }")
+ (goto-char 7)
+ (should (equal (css-current-defun-name) "body"))
+ (goto-char 18)
+ (should (equal (css-current-defun-name) "body"))))
+
+(ert-deftest css-test-current-defun-name-nested ()
+ (with-temp-buffer
+ (insert "body > .main a { top: 0; }")
+ (goto-char 20)
+ (should (equal (css-current-defun-name) "body > .main a"))))
+
+(ert-deftest css-test-current-defun-name-complex ()
+ (with-temp-buffer
+ (insert "input[type=submit]:hover { color: red; }")
+ (goto-char 30)
+ (should (equal (css-current-defun-name)
+ "input[type=submit]:hover"))))
+
;;; Completion
(defun css-mode-tests--completions ()
diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el
index 34e86201d82..f71f9040df7 100644
--- a/test/lisp/textmodes/dns-mode-tests.el
+++ b/test/lisp/textmodes/dns-mode-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/textmodes/mhtml-mode-tests.el b/test/lisp/textmodes/mhtml-mode-tests.el
index 020ad03c18f..df49f6780fa 100644
--- a/test/lisp/textmodes/mhtml-mode-tests.el
+++ b/test/lisp/textmodes/mhtml-mode-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el
index 55db66c58dc..0b67b2eb5b9 100644
--- a/test/lisp/textmodes/reftex-tests.el
+++ b/test/lisp/textmodes/reftex-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el
index e1aa3e8857e..4281ab8558f 100644
--- a/test/lisp/textmodes/sgml-mode-tests.el
+++ b/test/lisp/textmodes/sgml-mode-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el
index f958fbc547a..30038296a21 100644
--- a/test/lisp/textmodes/tildify-tests.el
+++ b/test/lisp/textmodes/tildify-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index 128534264e5..aeee3b52de9 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -15,23 +15,23 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
(require 'ert)
(defvar thing-at-point-test-data
- '(("http://1.gnu.org" 1 url "http://1.gnu.org")
- ("http://2.gnu.org" 6 url "http://2.gnu.org")
- ("http://3.gnu.org" 19 url "http://3.gnu.org")
+ '(("https://1.gnu.org" 1 url "https://1.gnu.org")
+ ("https://2.gnu.org" 6 url "https://2.gnu.org")
+ ("https://3.gnu.org" 19 url "https://3.gnu.org")
("https://4.gnu.org" 1 url "https://4.gnu.org")
("A geo URI (geo:3.14159,-2.71828)." 12 url "geo:3.14159,-2.71828")
- ("Visit http://5.gnu.org now." 5 url nil)
- ("Visit http://6.gnu.org now." 7 url "http://6.gnu.org")
- ("Visit http://7.gnu.org now." 22 url "http://7.gnu.org")
- ("Visit http://8.gnu.org now." 22 url "http://8.gnu.org")
- ("Visit http://9.gnu.org now." 24 url nil)
+ ("Visit https://5.gnu.org now." 5 url nil)
+ ("Visit https://6.gnu.org now." 7 url "https://6.gnu.org")
+ ("Visit https://7.gnu.org now." 22 url "https://7.gnu.org")
+ ("Visit https://8.gnu.org now." 22 url "https://8.gnu.org")
+ ("Visit https://9.gnu.org now." 25 url nil)
;; Invalid URIs
("<<<<" 2 url nil)
("<>" 1 url nil)
@@ -48,13 +48,13 @@
("Url: <url:foo://2.example.com>..." 30 url "foo://2.example.com")
("Url: <url:foo://www.gnu.org/a bc>..." 20 url "foo://www.gnu.org/a bc")
;; Hack used by thing-at-point: drop punctuation at end of URI.
- ("Go to http://www.gnu.org, for details" 7 url "http://www.gnu.org")
- ("Go to http://www.gnu.org." 24 url "http://www.gnu.org")
+ ("Go to https://www.gnu.org, for details" 7 url "https://www.gnu.org")
+ ("Go to https://www.gnu.org." 24 url "https://www.gnu.org")
;; Standard URI delimiters
- ("Go to \"http://10.gnu.org\"." 8 url "http://10.gnu.org")
- ("Go to \"http://11.gnu.org/\"." 26 url "http://11.gnu.org/")
- ("Go to <http://12.gnu.org> now." 8 url "http://12.gnu.org")
- ("Go to <http://13.gnu.org> now." 24 url "http://13.gnu.org")
+ ("Go to \"https://10.gnu.org\"." 8 url "https://10.gnu.org")
+ ("Go to \"https://11.gnu.org/\"." 26 url "https://11.gnu.org/")
+ ("Go to <https://12.gnu.org> now." 8 url "https://12.gnu.org")
+ ("Go to <https://13.gnu.org> now." 24 url "https://13.gnu.org")
;; Parenthesis handling (non-standard)
("http://example.com/a(b)c" 21 url "http://example.com/a(b)c")
("http://example.com/a(b)" 21 url "http://example.com/a(b)")
@@ -87,7 +87,7 @@ position to retrieve THING.")
;; These tests reflect the actual behavior of
;; `thing-at-point-bounds-of-list-at-point'.
(ert-deftest thing-at-point-bug24627 ()
- "Test for http://debbugs.gnu.org/24627 ."
+ "Test for https://debbugs.gnu.org/24627 ."
(let ((string-result '(("(a \"b\" c)" . (a "b" c))
(";(a \"b\" c)")
("(a \"b\" c\n)" . (a "b" c))
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 30636db083c..e7aeb6e6164 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el
index 2debbdeb753..d147bddb3d3 100644
--- a/test/lisp/url/url-expand-tests.el
+++ b/test/lisp/url/url-expand-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el
index 64d045219ba..e7bcbd696a4 100644
--- a/test/lisp/url/url-future-tests.el
+++ b/test/lisp/url/url-future-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el
index fd8abb0a5e5..56be313b776 100644
--- a/test/lisp/url/url-parse-tests.el
+++ b/test/lisp/url/url-parse-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/url/url-tramp-tests.el b/test/lisp/url/url-tramp-tests.el
new file mode 100644
index 00000000000..1154d4cb118
--- /dev/null
+++ b/test/lisp/url/url-tramp-tests.el
@@ -0,0 +1,83 @@
+;;; url-tramp-tests.el --- Test suite for Tramp / URL conversion.
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Michael Albinus <michael.albinus@gmx.de>
+
+;; 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 'url-tramp)
+(require 'ert)
+
+(ert-deftest url-tramp-test-convert-url-to-tramp ()
+ "Test that URLs are converted into proper Tramp file names."
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "ftp://ftp.is.co.za/rfc/rfc1808.txt")
+ "/ftp:ftp.is.co.za:/rfc/rfc1808.txt"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "ssh://user@localhost")
+ "/ssh:user@localhost:"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "telnet://remotehost:42")
+ "/telnet:remotehost#42:"))
+
+ ;; The password will be added to the cache. The password cache key
+ ;; is the remote file name identification of the Tramp file.
+ (should
+ (string-equal
+ (url-tramp-convert-url-to-tramp "scp://user:geheim@somewhere/localfile")
+ "/scp:user@somewhere:/localfile"))
+ (let ((key
+ (file-remote-p
+ (url-tramp-convert-url-to-tramp "scp://user@somewhere/localfile"))))
+ (should (password-in-cache-p key))
+ (should (string-equal (password-read-from-cache key) "geheim"))
+ (password-cache-remove key)
+ (should-not (password-in-cache-p key)))
+
+ ;; "http" does not belong to `url-tramp-protocols'.
+ (should-not (url-tramp-convert-url-to-tramp "http://www.gnu.org")))
+
+(ert-deftest url-tramp-test-convert-tramp-to-url ()
+ "Test that Tramp file names are converted into proper URLs."
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/ftp:ftp.is.co.za:/rfc/rfc1808.txt")
+ "ftp://ftp.is.co.za/rfc/rfc1808.txt"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/ssh:user@localhost:")
+ "ssh://user@localhost"))
+
+ (should
+ (string-equal
+ (url-tramp-convert-tramp-to-url "/telnet:user@remotehost#42:")
+ "telnet://user@remotehost:42"))
+
+ ;; "sftp" does not belong to `url-tramp-protocols'.
+ (should-not (url-tramp-convert-tramp-to-url "/sftp:user@localhost:")))
+
+(provide 'url-tramp-tests)
+
+;;; url-tramp-tests.el ends here
diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el
index c3375890c01..0d9ad9074d2 100644
--- a/test/lisp/url/url-util-tests.el
+++ b/test/lisp/url/url-util-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/vc/add-log-tests.el b/test/lisp/vc/add-log-tests.el
index 3e7bc7fdf0d..746c21644a3 100644
--- a/test/lisp/vc/add-log-tests.el
+++ b/test/lisp/vc/add-log-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 807a411fa5d..d27ea668131 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -16,7 +16,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -89,7 +89,7 @@ index 8858f0d..86e8ea5 100644
wrongheadedness
-xylophonists
youthfulness
---
+--
2.11.0
")
@@ -186,7 +186,7 @@ youthfulness
(diff-apply-hunk)
(diff-apply-hunk)
(diff-apply-hunk))
-
+
(should (equal (with-current-buffer buf (buffer-string))
fil_after))
(should (equal (with-current-buffer buf2 (buffer-string))
diff --git a/test/lisp/vc/ediff-diff-tests.el b/test/lisp/vc/ediff-diff-tests.el
index 566f592f84e..09aa106027e 100644
--- a/test/lisp/vc/ediff-diff-tests.el
+++ b/test/lisp/vc/ediff-diff-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 387786ced06..368d00ae4cb 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Code:
@@ -23,7 +23,7 @@
(require 'ediff-ptch)
(ert-deftest ediff-ptch-test-bug25010 ()
- "Test for http://debbugs.gnu.org/25010 ."
+ "Test for https://debbugs.gnu.org/25010 ."
(with-temp-buffer
(insert "diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el
index 6a07f80..6e8e947 100644
@@ -40,7 +40,7 @@ index 6a07f80..6e8e947 100644
(ert-deftest ediff-ptch-test-bug26084 ()
- "Test for http://debbugs.gnu.org/26084 ."
+ "Test for https://debbugs.gnu.org/26084 ."
(skip-unless (executable-find "git"))
(skip-unless (executable-find ediff-patch-program))
(let* ((tmpdir (make-temp-file "ediff-ptch-test" t))
@@ -66,41 +66,55 @@ index 6a07f80..6e8e947 100644
(write-region nil nil bar nil 'silent))
(call-process git-program nil `(:file ,patch) nil "diff")
(call-process git-program nil nil nil "reset" "--hard" "HEAD")
+ ;; Visit the diff file i.e., patch; extract from it the parts
+ ;; affecting just each of the files: store in patch-bar the part
+ ;; affecting 'bar', and in patch-qux the part affecting 'qux'.
(find-file patch)
(unwind-protect
(let* ((info
(progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map))
- (patch1
+ (patch-bar
(buffer-substring-no-properties
(car (nth 3 (car info)))
(car (nth 4 (car info)))))
- (patch2
+ (patch-qux
(buffer-substring-no-properties
(car (nth 3 (cadr info)))
(car (nth 4 (cadr info))))))
;; Apply both patches.
- (dolist (x (list (cons patch1 bar) (cons patch2 qux)))
+ (dolist (x (list (cons patch-bar bar) (cons patch-qux qux)))
(with-temp-buffer
- (insert (car x))
- (call-process-region (point-min)
- (point-max)
- ediff-patch-program
- nil nil nil
- "-b" (cdr x))))
- ;; Check backup files were saved correctly.
+ ;; Some windows variants require the option '--binary'
+ ;; in order to 'patch' create backup files.
+ (let ((opts (format "--backup%s"
+ (if (memq system-type '(windows-nt ms-dos))
+ " --binary" ""))))
+ (insert (car x))
+ (call-process-region (point-min)
+ (point-max)
+ ediff-patch-program
+ nil nil nil
+ opts (cdr x)))))
+ ;; Check backup files were saved correctly; in Bug#26084 some
+ ;; of the backup files are overwritten with the actual content
+ ;; of the updated file. To ensure that the bug is fixed we just
+ ;; need to check that every backup file produced has different
+ ;; content that the current updated file.
(dolist (x (list qux bar))
(let ((backup
(car
(directory-files
tmpdir 'full
(concat (file-name-nondirectory x) ".")))))
- (should-not
- (string= (with-temp-buffer
- (insert-file-contents x)
- (buffer-string))
- (with-temp-buffer
- (insert-file-contents backup)
- (buffer-string))))))
+ ;; Compare files only if the backup has being created.
+ (when backup
+ (should-not
+ (string= (with-temp-buffer
+ (insert-file-contents x)
+ (buffer-string))
+ (with-temp-buffer
+ (insert-file-contents backup)
+ (buffer-string)))))))
(delete-directory tmpdir 'recursive)
(delete-file patch)))))
diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el
new file mode 100644
index 00000000000..10d090632da
--- /dev/null
+++ b/test/lisp/vc/smerge-mode-tests.el
@@ -0,0 +1,34 @@
+;; Copyright (C) 2017 Free Software Foundation, Inc
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'smerge-mode)
+
+(ert-deftest smerge-mode-test-empty-hunk ()
+ "Regression test for bug #25555"
+ (with-temp-buffer
+ (insert "<<<<<<< one\n")
+ (save-excursion
+ (insert "=======\nLLL\n>>>>>>> end\n"))
+ (smerge-mode)
+ (smerge-keep-current)
+ (should (equal (buffer-substring (point-min) (point-max)) ""))))
+
+(provide 'smerge-mode-tests)
diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el
index fc7d8f8283f..24bfd4266e6 100644
--- a/test/lisp/vc/vc-bzr-tests.el
+++ b/test/lisp/vc/vc-bzr-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -29,7 +29,7 @@
(require 'vc-dir)
(ert-deftest vc-bzr-test-bug9726 ()
- "Test for http://debbugs.gnu.org/9726 ."
+ "Test for https://debbugs.gnu.org/9726 ."
(skip-unless (executable-find vc-bzr-program))
;; Bzr wants to access HOME, e.g. to write ~/.bzr.log.
;; This is a problem on hydra, where HOME is non-existent.
@@ -71,7 +71,7 @@
;; Not specific to bzr.
(ert-deftest vc-bzr-test-bug9781 ()
- "Test for http://debbugs.gnu.org/9781 ."
+ "Test for https://debbugs.gnu.org/9781 ."
(skip-unless (executable-find vc-bzr-program))
(let* ((homedir (make-temp-file "vc-bzr-test" t))
(bzrdir (expand-file-name "bzr" homedir))
@@ -106,7 +106,7 @@
(should (get-buffer "*vc-log*")))
(delete-directory homedir t))))
-;; http://lists.gnu.org/archive/html/help-gnu-emacs/2012-04/msg00145.html
+;; https://lists.gnu.org/r/help-gnu-emacs/2012-04/msg00145.html
(ert-deftest vc-bzr-test-faulty-bzr-autoloads ()
"Test we can generate autoloads in a bzr directory when bzr is faulty."
(skip-unless (executable-find vc-bzr-program))
diff --git a/test/lisp/vc/vc-hg-tests.el b/test/lisp/vc/vc-hg-tests.el
index 284e06a2052..96fc41e9971 100644
--- a/test/lisp/vc/vc-hg-tests.el
+++ b/test/lisp/vc/vc-hg-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 1104085a2e1..b970be8909c 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el
index 1e455352f2e..ba99ddcdec4 100644
--- a/test/lisp/whitespace-tests.el
+++ b/test/lisp/whitespace-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el
new file mode 100644
index 00000000000..eaf03ab9a03
--- /dev/null
+++ b/test/lisp/xdg-tests.el
@@ -0,0 +1,80 @@
+;;; xdg-tests.el --- tests for xdg.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+;; Author: Mark Oteiza <mvoteiza@udel.edu>
+
+;; 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 'xdg)
+
+(defconst xdg-tests-data-dir
+ (expand-file-name "test/data/xdg" source-directory))
+
+(ert-deftest xdg-desktop-parsing ()
+ "Test `xdg-desktop-read-file' parsing of .desktop files."
+ (let ((tab1 (xdg-desktop-read-file
+ (expand-file-name "test.desktop" xdg-tests-data-dir)))
+ (tab2 (xdg-desktop-read-file
+ (expand-file-name "test.desktop" xdg-tests-data-dir)
+ "Another Section")))
+ (should (equal (gethash "Name" tab1) "Test"))
+ (should (eq 'default (gethash "Exec" tab1 'default)))
+ (should (equal "frobnicate" (gethash "Exec" tab2))))
+ (should-error
+ (xdg-desktop-read-file
+ (expand-file-name "malformed.desktop" xdg-tests-data-dir)))
+ (let ((tab (xdg-desktop-read-file
+ (expand-file-name "l10n.desktop" xdg-tests-data-dir)))
+ (env (getenv "LC_MESSAGES")))
+ (unwind-protect
+ (progn
+ (setenv "LC_MESSAGES" nil)
+ (should (equal (gethash "Comment" tab) "Cheers"))
+ ;; l10n omitted
+ (setenv "LC_MESSAGES" "sv_SE.UTF-8")
+ (should-not (equal (gethash "Comment" tab) "Skål")))
+ (setenv "LC_MESSAGES" env))))
+
+(ert-deftest xdg-desktop-strings-type ()
+ "Test desktop \"string(s)\" type: strings delimited by \";\"."
+ (should (equal (xdg-desktop-strings " a") '("a")))
+ (should (equal (xdg-desktop-strings "a;b") '("a" "b")))
+ (should (equal (xdg-desktop-strings "a;b;") '("a" "b")))
+ (should (equal (xdg-desktop-strings "\\;") '(";")))
+ (should (equal (xdg-desktop-strings ";") '("")))
+ (should (equal (xdg-desktop-strings " ") nil))
+ (should (equal (xdg-desktop-strings "a; ;") '("a" " "))))
+
+(ert-deftest xdg-mime-associations ()
+ "Test reading MIME associations from files."
+ (let* ((apps (expand-file-name "mimeapps.list" xdg-tests-data-dir))
+ (cache (expand-file-name "mimeinfo.cache" xdg-tests-data-dir))
+ (fs (list apps cache)))
+ (should (equal (xdg-mime-collect-associations "x-test/foo" fs)
+ '("a.desktop" "b.desktop")))
+ (should (equal (xdg-mime-collect-associations "x-test/bar" fs)
+ '("a.desktop" "c.desktop")))
+ (should (equal (xdg-mime-collect-associations "x-test/baz" fs)
+ '("a.desktop" "b.desktop" "d.desktop")))))
+
+;;; xdg-tests.el ends here
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 16945b0f92d..ba693490e24 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el
index c0e97f57479..53844a6e991 100644
--- a/test/lisp/xt-mouse-tests.el
+++ b/test/lisp/xt-mouse-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/manual/BidiCharacterTest.txt b/test/manual/BidiCharacterTest.txt
index 7e04d6cb3c0..a3d2b46cc40 100644
--- a/test/manual/BidiCharacterTest.txt
+++ b/test/manual/BidiCharacterTest.txt
@@ -1,6 +1,6 @@
-# BidiCharacterTest-9.0.0.txt
-# Date: 2016-01-15, 22:30:00 GMT [LI]
-# © 2016 Unicode®, Inc.
+# BidiCharacterTest-10.0.0.txt
+# Date: 2017-03-09, 00:30:00 GMT [LI]
+# © 2017 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
# Unicode Character Database
diff --git a/test/manual/biditest.el b/test/manual/biditest.el
index c315749e187..667e537d991 100644
--- a/test/manual/biditest.el
+++ b/test/manual/biditest.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el
index b8396b822b9..19a144f2abb 100644
--- a/test/manual/cedet/cedet-utests.el
+++ b/test/manual/cedet/cedet-utests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el
index fdad01c1ff1..e24bdf7f9f0 100644
--- a/test/manual/cedet/ede-tests.el
+++ b/test/manual/cedet/ede-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/manual/cedet/semantic-ia-utest.el b/test/manual/cedet/semantic-ia-utest.el
index cf89daf1490..53cff05adc4 100644
--- a/test/manual/cedet/semantic-ia-utest.el
+++ b/test/manual/cedet/semantic-ia-utest.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
@@ -434,7 +434,7 @@ tag that contains point, and return that."
(when (interactive-p)
(message "Found %d occurrences of %s in %.2f seconds"
Lcount (semantic-tag-name target)
- (semantic-elapsed-time start (current-time))))
+ (semantic-elapsed-time start nil)))
Lcount)))
(defun semantic-src-utest-buffer-refs ()
diff --git a/test/manual/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el
index bfcba7e6772..0495170058a 100644
--- a/test/manual/cedet/semantic-tests.el
+++ b/test/manual/cedet/semantic-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -178,9 +178,8 @@ Optional argument ARG specifies not to use color."
"Test `semantic-idle-scheduler-work-parse-neighboring-files' and time it."
(interactive)
(let ((start (current-time))
- (junk (semantic-idle-scheduler-work-parse-neighboring-files))
- (end (current-time)))
- (message "Work took %.2f seconds." (semantic-elapsed-time start end))))
+ (junk (semantic-idle-scheduler-work-parse-neighboring-files)))
+ (message "Work took %.2f seconds." (semantic-elapsed-time start nil))))
;;; From semantic-lex:
@@ -195,10 +194,9 @@ If universal argument ARG, then try the whole buffer."
(result (semantic-lex
(if arg (point-min) (point))
(point-max)
- 100))
- (end (current-time)))
+ 100)))
(message "Elapsed Time: %.2f seconds."
- (semantic-elapsed-time start end))
+ (semantic-elapsed-time start nil))
(pop-to-buffer "*Lexer Output*")
(require 'pp)
(erase-buffer)
@@ -278,7 +276,7 @@ tag that contains point, and return that."
(when (interactive-p)
(message "Found %d occurrences of %s in %.2f seconds"
Lcount (semantic-tag-name target)
- (semantic-elapsed-time start (current-time))))
+ (semantic-elapsed-time start nil)))
Lcount)))
;;; From bovine-gcc:
diff --git a/test/manual/cedet/semantic-utest-c.el b/test/manual/cedet/semantic-utest-c.el
index 26ce4009277..6adfb1f2144 100644
--- a/test/manual/cedet/semantic-utest-c.el
+++ b/test/manual/cedet/semantic-utest-c.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/test/manual/cedet/semantic-utest.el b/test/manual/cedet/semantic-utest.el
index f735e552413..6d499eeba44 100644
--- a/test/manual/cedet/semantic-utest.el
+++ b/test/manual/cedet/semantic-utest.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
diff --git a/test/manual/cedet/srecode-tests.el b/test/manual/cedet/srecode-tests.el
index 36256a70597..5d387a2d0c7 100644
--- a/test/manual/cedet/srecode-tests.el
+++ b/test/manual/cedet/srecode-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/manual/cedet/tests/test.c b/test/manual/cedet/tests/test.c
index a46486927a7..c5958c4cbac 100644
--- a/test/manual/cedet/tests/test.c
+++ b/test/manual/cedet/tests/test.c
@@ -17,7 +17,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
/* Attempt to include as many aspects of the C language as possible.
@@ -54,7 +54,7 @@ struct {
int slot31;
char slot32;
float slot33;
-} var_of_anonymous_struct;
+} var_of_anonymous_struct;
typedef struct mystruct1 typedef_of_mystruct1;
typedef struct mystruct1 *typedef_of_pointer_mystruct1;
@@ -80,7 +80,7 @@ struct {
int slot61;
char slot72;
float slot83;
-} var_of_anonymous_union;
+} var_of_anonymous_union;
typedef union myunion1 typedef_of_myunion1;
typedef union myunion1 *typedef_of_pointer_myunion1;
@@ -235,8 +235,7 @@ int funk3(arg_51, arg_53)
int funk4_fixme(arg_61, arg_62)
int arg_61, arg_62;
{
-
+
}
/* End of C tests */
-
diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el
index a0efd40acce..299bea0bd5d 100644
--- a/test/manual/cedet/tests/test.el
+++ b/test/manual/cedet/tests/test.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Require
;;
diff --git a/test/manual/cedet/tests/test.make b/test/manual/cedet/tests/test.make
index 46421da54d6..ff169576f7c 100644
--- a/test/manual/cedet/tests/test.make
+++ b/test/manual/cedet/tests/test.make
@@ -17,7 +17,7 @@
# 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 <http://www.gnu.org/licenses/>.
+# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
top=
ede_FILES=Project.ede Makefile
@@ -42,7 +42,7 @@ all: example semantic Languages tools senator semantic.info
test ${B}: foo bar
@echo ${A}
-example:
+example:
@
init: $(init_LISP)
diff --git a/test/manual/cedet/tests/testdoublens.cpp b/test/manual/cedet/tests/testdoublens.cpp
index e9a6ba52673..c9a2f99f545 100644
--- a/test/manual/cedet/tests/testdoublens.cpp
+++ b/test/manual/cedet/tests/testdoublens.cpp
@@ -17,7 +17,7 @@
// 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 <http://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
#include "testdoublens.hpp"
@@ -163,4 +163,3 @@ namespace d {
} // namespace f
} // namespace d
-
diff --git a/test/manual/cedet/tests/testdoublens.hpp b/test/manual/cedet/tests/testdoublens.hpp
index 556f068d586..59eec741667 100644
--- a/test/manual/cedet/tests/testdoublens.hpp
+++ b/test/manual/cedet/tests/testdoublens.hpp
@@ -17,7 +17,7 @@
// 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 <http://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
namespace Name1 {
namespace Name2 {
@@ -34,7 +34,7 @@ namespace Name1 {
void publishStuff(int a, int b);
void sendStuff(int a, int b);
-
+
Mumble* pMumble;
};
@@ -67,4 +67,3 @@ namespace a {
} // namespace b
} // namespace a
-
diff --git a/test/manual/cedet/tests/testjavacomp.java b/test/manual/cedet/tests/testjavacomp.java
index c32a17ca248..743aaca8547 100644
--- a/test/manual/cedet/tests/testjavacomp.java
+++ b/test/manual/cedet/tests/testjavacomp.java
@@ -17,7 +17,7 @@
// 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 <http://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
package tests.testjavacomp;
diff --git a/test/manual/cedet/tests/testpolymorph.cpp b/test/manual/cedet/tests/testpolymorph.cpp
index 27aa08b155b..86bc75c6f27 100644
--- a/test/manual/cedet/tests/testpolymorph.cpp
+++ b/test/manual/cedet/tests/testpolymorph.cpp
@@ -17,7 +17,7 @@
* 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 <http://www.gnu.org/licenses/>.
+ * along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
#include <cmath>
diff --git a/test/manual/cedet/tests/testspp.c b/test/manual/cedet/tests/testspp.c
index 02eab53afb6..dc8f4a54bae 100644
--- a/test/manual/cedet/tests/testspp.c
+++ b/test/manual/cedet/tests/testspp.c
@@ -17,7 +17,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
int some_fcn (){}
@@ -99,4 +99,3 @@ int no_show_moose_elif_2() {}
#else
int show_moose_elif_else() {}
#endif
-
diff --git a/test/manual/cedet/tests/testsppreplace.c b/test/manual/cedet/tests/testsppreplace.c
index 56ef320f752..5c63a09a368 100644
--- a/test/manual/cedet/tests/testsppreplace.c
+++ b/test/manual/cedet/tests/testsppreplace.c
@@ -16,7 +16,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
/* TEST: The EMU keyword doesn't screw up the function defn. */
@@ -151,4 +151,3 @@ int STARTMACRO () {
/* END */
-
diff --git a/test/manual/cedet/tests/testsppreplaced.c b/test/manual/cedet/tests/testsppreplaced.c
index 3ba90aa4ddb..f60be8bcfb2 100644
--- a/test/manual/cedet/tests/testsppreplaced.c
+++ b/test/manual/cedet/tests/testsppreplaced.c
@@ -16,7 +16,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
/* What the SPP replace file would looklike with MACROS replaced: */
diff --git a/test/manual/cedet/tests/testsubclass.cpp b/test/manual/cedet/tests/testsubclass.cpp
index e74ca43124a..df8399e8d11 100644
--- a/test/manual/cedet/tests/testsubclass.cpp
+++ b/test/manual/cedet/tests/testsubclass.cpp
@@ -17,7 +17,7 @@
// 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 <http://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
//#include <iostream>
#include "testsubclass.hh"
@@ -246,4 +246,3 @@ bool sneaky::bugalope::testAccess() //^9^
// #14# ( "fBugPrivate" "fBugProtected" "fBugPublic" "fQuadPublic" "testAccess" )
;
}
-
diff --git a/test/manual/cedet/tests/testsubclass.hh b/test/manual/cedet/tests/testsubclass.hh
index 6f199c20bd3..fe07b6fcb05 100644
--- a/test/manual/cedet/tests/testsubclass.hh
+++ b/test/manual/cedet/tests/testsubclass.hh
@@ -17,7 +17,7 @@
// 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 <http://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
//#include <cmath>
// #include <stdio.h>
@@ -40,7 +40,7 @@ namespace animal {
enum moose_enum {
NAME1, NAME2, NAME3 };
-
+
protected:
@@ -50,7 +50,7 @@ namespace animal {
private:
int fFeet; // Usually 2 or 4.
bool fIsPrivateBool;
-
+
}; // moose
int two_prototypes();
@@ -188,4 +188,3 @@ namespace sneaky {
};
#endif
-
diff --git a/test/manual/cedet/tests/testtypedefs.cpp b/test/manual/cedet/tests/testtypedefs.cpp
index e6c91f736bf..5bc79fc8856 100644
--- a/test/manual/cedet/tests/testtypedefs.cpp
+++ b/test/manual/cedet/tests/testtypedefs.cpp
@@ -17,7 +17,7 @@
// 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 <http://www.gnu.org/licenses/>.
+// along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
// Thanks Ming-Wei Chang for these examples.
@@ -78,4 +78,3 @@ int main()
// #4# ("otherFunc")
return 0;
}
-
diff --git a/test/manual/cedet/tests/testvarnames.c b/test/manual/cedet/tests/testvarnames.c
index dbc4afb46ba..a328f97a741 100644
--- a/test/manual/cedet/tests/testvarnames.c
+++ b/test/manual/cedet/tests/testvarnames.c
@@ -18,7 +18,7 @@
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 <http://www.gnu.org/licenses/>.
+ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
*/
struct independent {
diff --git a/test/manual/etags/CTAGS.good b/test/manual/etags/CTAGS.good
index 13bb37c2e6a..519315c6fdd 100644
--- a/test/manual/etags/CTAGS.good
+++ b/test/manual/etags/CTAGS.good
@@ -202,6 +202,7 @@ ${CHECKOBJS} make-src/Makefile /^${CHECKOBJS}: CFLAGS=-g3 -DNULLFREECHECK=0$/
=\relax tex-src/texinfo.tex /^\\let\\subsubsection=\\relax$/
=\relax tex-src/texinfo.tex /^\\let\\appendix=\\relax$/
=\smartitalic tex-src/texinfo.tex /^\\let\\cite=\\smartitalic$/
+=starts-with-equals! scm-src/test.scm /^(define =starts-with-equals! #t)$/
> tex-src/texinfo.tex /^\\def>{{\\tt \\gtr}}$/
>field1 forth-src/test-forth.fth /^ 9 field >field1$/
>field2 forth-src/test-forth.fth /^ 5 field >field2$/
@@ -2750,6 +2751,7 @@ current-idle-time c-src/emacs/src/keyboard.c /^DEFUN ("current-idle-time", Fcurr
current-input-mode c-src/emacs/src/keyboard.c /^DEFUN ("current-input-mode", Fcurrent_input_mode, /
current_kboard c-src/emacs/src/keyboard.c 85
current_lb_is_new c-src/etags.c 2926
+curry-test scm-src/test.scm /^(define (((((curry-test a) b) c) d) e)$/
cursor_position cp-src/screen.cpp /^void cursor_position(void)$/
cursor_x cp-src/screen.cpp 15
cursor_y cp-src/screen.cpp 15
@@ -3037,6 +3039,7 @@ foo ruby-src/test1.ru /^ attr_reader :foo$/
foo! ruby-src/test1.ru /^ def foo!$/
foo1 ruby-src/test1.ru /^ attr_reader(:foo1, :bar1, # comment$/
foo2 ruby-src/test1.ru /^ alias_method ( :foo2, #cmmt$/
+foo==bar el-src/TAGTEST.EL /^(defun foo==bar () (message "hi")) ; Bug#5624$/
foobar c-src/c.c /^int foobar() {;}$/
foobar c.c /^extern void foobar (void) __attribute__ ((section /
foobar2 c-src/h.h 20
@@ -3161,6 +3164,9 @@ header c-src/emacs/src/lisp.h 1672
header c-src/emacs/src/lisp.h 1826
header_size c-src/emacs/src/lisp.h 1471
heapsize c-src/emacs/src/gmalloc.c 361
+hello scm-src/test.scm /^(define hello "Hello, Emacs!")$/
+hello scm-src/test.scm /^(set! hello "Hello, world!")$/
+hello-world scm-src/test.scm /^(define (hello-world)$/
help c-src/etags.c 193
helpPanel objcpp-src/SimpleCalc.M /^- helpPanel:sender$/
help_char_p c-src/emacs/src/keyboard.c /^help_char_p (Lisp_Object c)$/
@@ -4317,10 +4323,12 @@ test erl-src/gs_dialog.erl /^test() ->$/
test go-src/test1.go /^func test(p plus) {$/
test make-src/Makefile /^test:$/
test php-src/ptest.php /^test $/
+test-begin scm-src/test.scm /^(define-syntax test-begin$/
test.me22b lua-src/test.lua /^ local function test.me22b (one)$/
test.me_22a lua-src/test.lua /^ function test.me_22a(one, two)$/
test_undefined c-src/emacs/src/keyboard.c /^test_undefined (Lisp_Object binding)$/
texttreelist prol-src/natded.prolog /^texttreelist([]).$/
+there-is-a-=-in-the-middle! scm-src/test.scm /^(define (there-is-a-=-in-the-middle!) #t)$/
this c-src/a/b/b.c 1
this-command-keys c-src/emacs/src/keyboard.c /^DEFUN ("this-command-keys", Fthis_command_keys, St/
this-command-keys-vector c-src/emacs/src/keyboard.c /^DEFUN ("this-command-keys-vector", Fthis_command_k/
diff --git a/test/manual/etags/ETAGS.good_1 b/test/manual/etags/ETAGS.good_1
index 6c4a02ae1c1..cd9cd4a8450 100644
--- a/test/manual/etags/ETAGS.good_1
+++ b/test/manual/etags/ETAGS.good_1
@@ -2143,10 +2143,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
(foo::defmumble bletch 1,0
-(defalias 'pending-delete-mode pending-delete-mode5,102
-(defalias (quote explicitly-quoted-pending-delete-mode)8,175
+(defun foo==bar foo==bar2,33
+(defalias 'pending-delete-mode pending-delete-mode6,149
+(defalias (quote explicitly-quoted-pending-delete-mode)9,222
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1034
@@ -3135,6 +3136,15 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+scm-src/test.scm,260
+(define hello 1,0
+(set! hello 3,32
+(define (hello-world)5,62
+(define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128
+(define =starts-with-equals! =starts-with-equals!12,171
+(define (((((curry-test 14,205
+(define-syntax test-begin17,265
+
tex-src/testenv.tex,52
\newcommand{\nm}\nm4,77
\section{blah}blah8,139
@@ -3145,11 +3155,11 @@ tex-src/gzip.texi,303
@node Overview,83,2705
@node Sample,166,7272
@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13495
-@node Environment,420,15207
-@node Tapes,437,15768
-@node Problems,460,16767
-@node Concept Index,Concept Index473,17287
+@node Advanced usage,Advanced usage357,13496
+@node Environment,420,15208
+@node Tapes,437,15769
+@node Problems,460,16768
+@node Concept Index,Concept Index473,17288
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1032
diff --git a/test/manual/etags/ETAGS.good_2 b/test/manual/etags/ETAGS.good_2
index fa784d2e7b5..54fd00e95da 100644
--- a/test/manual/etags/ETAGS.good_2
+++ b/test/manual/etags/ETAGS.good_2
@@ -2712,10 +2712,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
(foo::defmumble bletch 1,0
-(defalias 'pending-delete-mode pending-delete-mode5,102
-(defalias (quote explicitly-quoted-pending-delete-mode)8,175
+(defun foo==bar foo==bar2,33
+(defalias 'pending-delete-mode pending-delete-mode6,149
+(defalias (quote explicitly-quoted-pending-delete-mode)9,222
el-src/emacs/lisp/progmodes/etags.el,5188
(defvar tags-file-name 34,1034
@@ -3708,6 +3709,15 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+scm-src/test.scm,260
+(define hello 1,0
+(set! hello 3,32
+(define (hello-world)5,62
+(define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128
+(define =starts-with-equals! =starts-with-equals!12,171
+(define (((((curry-test 14,205
+(define-syntax test-begin17,265
+
tex-src/testenv.tex,52
\newcommand{\nm}\nm4,77
\section{blah}blah8,139
@@ -3718,11 +3728,11 @@ tex-src/gzip.texi,303
@node Overview,83,2705
@node Sample,166,7272
@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13495
-@node Environment,420,15207
-@node Tapes,437,15768
-@node Problems,460,16767
-@node Concept Index,Concept Index473,17287
+@node Advanced usage,Advanced usage357,13496
+@node Environment,420,15208
+@node Tapes,437,15769
+@node Problems,460,16768
+@node Concept Index,Concept Index473,17288
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1032
diff --git a/test/manual/etags/ETAGS.good_3 b/test/manual/etags/ETAGS.good_3
index 547dee2d43c..508427c501c 100644
--- a/test/manual/etags/ETAGS.good_3
+++ b/test/manual/etags/ETAGS.good_3
@@ -2520,10 +2520,11 @@ main(37,571
D(43,659
int x;44,694
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
(foo::defmumble bletch 1,0
-(defalias 'pending-delete-mode pending-delete-mode5,102
-(defalias (quote explicitly-quoted-pending-delete-mode)8,175
+(defun foo==bar foo==bar2,33
+(defalias 'pending-delete-mode pending-delete-mode6,149
+(defalias (quote explicitly-quoted-pending-delete-mode)9,222
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1034
@@ -3542,6 +3543,15 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+scm-src/test.scm,260
+(define hello 1,0
+(set! hello 3,32
+(define (hello-world)5,62
+(define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128
+(define =starts-with-equals! =starts-with-equals!12,171
+(define (((((curry-test 14,205
+(define-syntax test-begin17,265
+
tex-src/testenv.tex,52
\newcommand{\nm}\nm4,77
\section{blah}blah8,139
@@ -3552,11 +3562,11 @@ tex-src/gzip.texi,303
@node Overview,83,2705
@node Sample,166,7272
@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13495
-@node Environment,420,15207
-@node Tapes,437,15768
-@node Problems,460,16767
-@node Concept Index,Concept Index473,17287
+@node Advanced usage,Advanced usage357,13496
+@node Environment,420,15208
+@node Tapes,437,15769
+@node Problems,460,16768
+@node Concept Index,Concept Index473,17288
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1032
diff --git a/test/manual/etags/ETAGS.good_4 b/test/manual/etags/ETAGS.good_4
index 2c50ec1a742..460e31b5d96 100644
--- a/test/manual/etags/ETAGS.good_4
+++ b/test/manual/etags/ETAGS.good_4
@@ -2307,10 +2307,11 @@ main(37,571
class D 41,622
D(43,659
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
(foo::defmumble bletch 1,0
-(defalias 'pending-delete-mode pending-delete-mode5,102
-(defalias (quote explicitly-quoted-pending-delete-mode)8,175
+(defun foo==bar foo==bar2,33
+(defalias 'pending-delete-mode pending-delete-mode6,149
+(defalias (quote explicitly-quoted-pending-delete-mode)9,222
el-src/emacs/lisp/progmodes/etags.el,5069
(defvar tags-file-name 34,1034
@@ -3299,6 +3300,15 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+scm-src/test.scm,260
+(define hello 1,0
+(set! hello 3,32
+(define (hello-world)5,62
+(define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128
+(define =starts-with-equals! =starts-with-equals!12,171
+(define (((((curry-test 14,205
+(define-syntax test-begin17,265
+
tex-src/testenv.tex,52
\newcommand{\nm}\nm4,77
\section{blah}blah8,139
@@ -3309,11 +3319,11 @@ tex-src/gzip.texi,303
@node Overview,83,2705
@node Sample,166,7272
@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13495
-@node Environment,420,15207
-@node Tapes,437,15768
-@node Problems,460,16767
-@node Concept Index,Concept Index473,17287
+@node Advanced usage,Advanced usage357,13496
+@node Environment,420,15208
+@node Tapes,437,15769
+@node Problems,460,16768
+@node Concept Index,Concept Index473,17288
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1032
diff --git a/test/manual/etags/ETAGS.good_5 b/test/manual/etags/ETAGS.good_5
index 2b431034f44..b7a31602f51 100644
--- a/test/manual/etags/ETAGS.good_5
+++ b/test/manual/etags/ETAGS.good_5
@@ -3253,10 +3253,11 @@ main(37,571
D(43,659
int x;44,694
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
(foo::defmumble bletch 1,0
-(defalias 'pending-delete-mode pending-delete-mode5,102
-(defalias (quote explicitly-quoted-pending-delete-mode)8,175
+(defun foo==bar foo==bar2,33
+(defalias 'pending-delete-mode pending-delete-mode6,149
+(defalias (quote explicitly-quoted-pending-delete-mode)9,222
el-src/emacs/lisp/progmodes/etags.el,5188
(defvar tags-file-name 34,1034
@@ -4279,6 +4280,15 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+scm-src/test.scm,260
+(define hello 1,0
+(set! hello 3,32
+(define (hello-world)5,62
+(define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128
+(define =starts-with-equals! =starts-with-equals!12,171
+(define (((((curry-test 14,205
+(define-syntax test-begin17,265
+
tex-src/testenv.tex,52
\newcommand{\nm}\nm4,77
\section{blah}blah8,139
@@ -4289,11 +4299,11 @@ tex-src/gzip.texi,303
@node Overview,83,2705
@node Sample,166,7272
@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13495
-@node Environment,420,15207
-@node Tapes,437,15768
-@node Problems,460,16767
-@node Concept Index,Concept Index473,17287
+@node Advanced usage,Advanced usage357,13496
+@node Environment,420,15208
+@node Tapes,437,15769
+@node Problems,460,16768
+@node Concept Index,Concept Index473,17288
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1032
diff --git a/test/manual/etags/ETAGS.good_6 b/test/manual/etags/ETAGS.good_6
index 2cb0d05e72a..a75fd806968 100644
--- a/test/manual/etags/ETAGS.good_6
+++ b/test/manual/etags/ETAGS.good_6
@@ -3253,10 +3253,11 @@ main(37,571
D(D::D43,659
int x;D::x44,694
-el-src/TAGTEST.EL,148
+el-src/TAGTEST.EL,179
(foo::defmumble bletch 1,0
-(defalias 'pending-delete-mode pending-delete-mode5,102
-(defalias (quote explicitly-quoted-pending-delete-mode)8,175
+(defun foo==bar foo==bar2,33
+(defalias 'pending-delete-mode pending-delete-mode6,149
+(defalias (quote explicitly-quoted-pending-delete-mode)9,222
el-src/emacs/lisp/progmodes/etags.el,5188
(defvar tags-file-name 34,1034
@@ -4279,6 +4280,15 @@ module A9,57
alias_method ( :foo2,foo237,586
A::Constant Constant42,655
+scm-src/test.scm,260
+(define hello 1,0
+(set! hello 3,32
+(define (hello-world)5,62
+(define (there-is-a-=-in-the-middle!)there-is-a-=-in-the-middle!10,128
+(define =starts-with-equals! =starts-with-equals!12,171
+(define (((((curry-test 14,205
+(define-syntax test-begin17,265
+
tex-src/testenv.tex,52
\newcommand{\nm}\nm4,77
\section{blah}blah8,139
@@ -4289,11 +4299,11 @@ tex-src/gzip.texi,303
@node Overview,83,2705
@node Sample,166,7272
@node Invoking gzip,Invoking gzip210,8828
-@node Advanced usage,Advanced usage357,13495
-@node Environment,420,15207
-@node Tapes,437,15768
-@node Problems,460,16767
-@node Concept Index,Concept Index473,17287
+@node Advanced usage,Advanced usage357,13496
+@node Environment,420,15208
+@node Tapes,437,15769
+@node Problems,460,16768
+@node Concept Index,Concept Index473,17288
tex-src/texinfo.tex,30627
\def\texinfoversion{\texinfoversion26,1032
diff --git a/test/manual/etags/Makefile b/test/manual/etags/Makefile
index 07ad0f46416..c1df703905e 100644
--- a/test/manual/etags/Makefile
+++ b/test/manual/etags/Makefile
@@ -25,12 +25,13 @@ PSSRC=$(addprefix ./ps-src/,rfc1245.ps)
PROLSRC=$(addprefix ./prol-src/,ordsets.prolog natded.prolog)
PYTSRC=$(addprefix ./pyt-src/,server.py)
RBSRC=$(addprefix ./ruby-src/,test.rb test1.ru)
+SCMSRC=$(addprefix ./scm-src/,test.scm)
TEXSRC=$(addprefix ./tex-src/,testenv.tex gzip.texi texinfo.tex nonewline.tex)
YSRC=$(addprefix ./y-src/,parse.y parse.c atest.y cccp.c cccp.y)
SRCS=${ADASRC} ${ASRC} ${CSRC} ${CPSRC} ${ELSRC} ${ERLSRC} ${FSRC}\
${FORTHSRC} ${GOSRC} ${HTMLSRC} ${JAVASRC} ${LUASRC} ${MAKESRC}\
${OBJCSRC} ${OBJCPPSRC} ${PASSRC} ${PHPSRC} ${PERLSRC} ${PSSRC}\
- ${PROLSRC} ${PYTSRC} ${RBSRC} ${TEXSRC} ${YSRC}
+ ${PROLSRC} ${PYTSRC} ${RBSRC} ${SCMSRC} ${TEXSRC} ${YSRC}
NONSRCS=./f-src/entry.strange ./erl-src/lists.erl ./cp-src/clheir.hpp.gz
ETAGS_PROG=../../../lib-src/etags
diff --git a/test/manual/etags/c-src/emacs/src/gmalloc.c b/test/manual/etags/c-src/emacs/src/gmalloc.c
index 79b2040e321..3f8cad83ae5 100644
--- a/test/manual/etags/c-src/emacs/src/gmalloc.c
+++ b/test/manual/etags/c-src/emacs/src/gmalloc.c
@@ -14,7 +14,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -339,7 +339,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -991,7 +991,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1297,7 +1297,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1467,7 +1467,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1505,7 +1505,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with the GNU C Library. If not, see <https://www.gnu.org/licenses/>. */
/* uClibc defines __GNU_LIBRARY__, but it is not completely
compatible. */
@@ -1549,7 +1549,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>. */
+License along with this library. If not, see <https://www.gnu.org/licenses/>. */
void *(*__memalign_hook) (size_t size, size_t alignment);
@@ -1686,7 +1686,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
@@ -1775,7 +1775,7 @@ hybrid_aligned_alloc (size_t alignment, size_t size)
#endif
}
#endif
-
+
void *
hybrid_realloc (void *ptr, size_t size)
{
@@ -1835,7 +1835,7 @@ 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 library. If not, see <http://www.gnu.org/licenses/>.
+License along with this library. If not, see <https://www.gnu.org/licenses/>.
The author may be reached (Email) at the address mike@ai.mit.edu,
or (US mail) as Mike Haertel c/o Free Software Foundation. */
diff --git a/test/manual/etags/c-src/emacs/src/keyboard.c b/test/manual/etags/c-src/emacs/src/keyboard.c
index 5a651497d73..960e5c71322 100644
--- a/test/manual/etags/c-src/emacs/src/keyboard.c
+++ b/test/manual/etags/c-src/emacs/src/keyboard.c
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
diff --git a/test/manual/etags/c-src/emacs/src/lisp.h b/test/manual/etags/c-src/emacs/src/lisp.h
index 688589624fe..c87fb63db85 100644
--- a/test/manual/etags/c-src/emacs/src/lisp.h
+++ b/test/manual/etags/c-src/emacs/src/lisp.h
@@ -16,7 +16,7 @@ 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 <http://www.gnu.org/licenses/>. */
+along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#ifndef EMACS_LISP_H
#define EMACS_LISP_H
@@ -510,7 +510,7 @@ enum Lisp_Fwd_Type
/* If you want to define a new Lisp data type, here are some
instructions. See the thread at
- http://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00561.html
+ https://lists.gnu.org/r/emacs-devel/2012-10/msg00561.html
for more info.
First, there are already a couple of Lisp types that can be used if
diff --git a/test/manual/etags/c-src/emacs/src/regex.h b/test/manual/etags/c-src/emacs/src/regex.h
index 2ed6238730f..595b9bb0923 100644
--- a/test/manual/etags/c-src/emacs/src/regex.h
+++ b/test/manual/etags/c-src/emacs/src/regex.h
@@ -15,7 +15,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program. If not, see <http://www.gnu.org/licenses/>. */
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
#ifndef _REGEX_H
#define _REGEX_H 1
diff --git a/test/manual/etags/c-src/etags.c b/test/manual/etags/c-src/etags.c
index e8321f05ff4..b412ef5e64f 100644
--- a/test/manual/etags/c-src/etags.c
+++ b/test/manual/etags/c-src/etags.c
@@ -44,7 +44,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>. */
+along with this program. If not, see <https://www.gnu.org/licenses/>. */
/* NB To comply with the above BSD license, copyright information is
diff --git a/test/manual/etags/el-src/TAGTEST.EL b/test/manual/etags/el-src/TAGTEST.EL
index acf0baf82f0..89a67913771 100644
--- a/test/manual/etags/el-src/TAGTEST.EL
+++ b/test/manual/etags/el-src/TAGTEST.EL
@@ -1,4 +1,5 @@
(foo::defmumble bletch beuarghh)
+(defun foo==bar () (message "hi")) ; Bug#5624
;;; Ctags test file for lisp mode.
;; from emacs/lisp/delsel.el:76:
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 955859803df..090645c789c 100644
--- a/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el
+++ b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el
@@ -20,7 +20,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/manual/etags/html-src/software.html b/test/manual/etags/html-src/software.html
index f1abba7cb49..9c4f0dde8ea 100644
--- a/test/manual/etags/html-src/software.html
+++ b/test/manual/etags/html-src/software.html
@@ -75,7 +75,7 @@
protocol studies:
<UL>
<LI> <A HREF="/curriculum/pot-abstracts.html#R03:FODAIBEAvsDistributed-IJSC96">
- <i>Comparison between distributed and centralised demand
+ <i>Comparison between distributed and centralized demand
assignment TDMA satellite access schemes</i></A>
<LI><A HREF="/curriculum/pot-abstracts.html#R07:FODAIBEAvsCFRA-IJSC97">
@@ -122,7 +122,7 @@ Matlab) and so I adapted it and <A
HREF="ftp://fly.cnuce.cnr.it/pub/software/octave/leasqr/">published</A> it.
Since then, the original authors Richard I. Shrager, A.Jutan, Ray Muzic, and
Sean Brennan agreed to put it under the <A
-HREF="http://www.gnu.org/licenses/gpl.html">GPL</A>. Matthias Jueschke tested
+HREF="https://www.gnu.org/licenses/gpl.html">GPL</A>. Matthias Jueschke tested
the program using a non-linear optimization <A
HREF="http://www.itl.nist.gov/div898/strd/nls/nls_main.shtml">test suite</A>,
and was satisfied with the results.
@@ -148,7 +148,7 @@ if that happens so I can update this page.
Etags
</H5>
-<P> On behalf of the <A HREF="http://www.gnu.org/fsf/fsf.html">Free
+<P> On behalf of the <A HREF="https://www.gnu.org/fsf/fsf.html">Free
Software Foundation (FSF)</A> I currently volunteer to maintain
<CITE>etags</CITE>, a program that can be compiled either as a replacement
of the classic <CITE>ctags</CITE> Unix program or as <CITE>etags</CITE>,
@@ -225,7 +225,7 @@ if that happens so I can update this page.
decoding. I keep a <A HREF="codes.html">mirror</A> of this page.
<DT>Forward error correcting codes by Phil Karn
- <DD>Phil Karn's optimised really <A HREF="http://www.ka9q.net/code/fec/">free
+ <DD>Phil Karn's optimized really <A HREF="http://www.ka9q.net/code/fec/">free
codes</A>.
</DL>
diff --git a/test/manual/etags/html-src/softwarelibero.html b/test/manual/etags/html-src/softwarelibero.html
index b374273c969..6d75a1f0924 100644
--- a/test/manual/etags/html-src/softwarelibero.html
+++ b/test/manual/etags/html-src/softwarelibero.html
@@ -27,7 +27,7 @@
Fu Richard M. Stallman, nei primi anni Ottanta, a formalizzare per la
prima volta il concetto di software libero. La <A TITLE="definizione
di software libero secondo FSF"
- href="http://www.it.gnu.org/philosophy/free-sw.it.html">definizione</A>
+ href="https://www.it.gnu.org/philosophy/free-sw.it.html">definizione</A>
di Stallman, che da subito assurse al ruolo di definizione per
eccellenza di software libero, assume la forma di quattro principi di
libertà:
@@ -55,7 +55,7 @@
detto <Q><EM>software libero</EM></Q> (in inglese <Q><EM>free
software</EM></Q>). Nel 1984 Richard M. Stallman <A TITLE="storia
del progetto GNU"
- HREF="http://www.it.gnu.org/gnu/thegnuproject.it.html">diede vita al
+ HREF="https://www.it.gnu.org/gnu/thegnuproject.it.html">diede vita al
progetto GNU</A>, con lo scopo di tradurre in pratica il concetto di
software libero, e creò la <Q>Free Software Foundation</Q> per
dare supporto logistico, legale ed economico al progetto GNU.
@@ -97,7 +97,7 @@
Con un gioco di parole, il nome dato a questo tipo di protezione
è <EM>permesso d'autore</EM> (in inglese <A TITLE="definizione di
copyleft (inglese)" LANG="en"
- HREF="http://www.it.gnu.org/copyleft/copyleft.html"><EM>copyleft</EM></A>):
+ HREF="https://www.it.gnu.org/copyleft/copyleft.html"><EM>copyleft</EM></A>):
è il criterio che prevede che le modifiche ad un programma possano
essere distribuite solo con la stessa licenza del programma originale.
Le licenze proprietarie usano le norme sul diritto d'autore (copyright
@@ -108,7 +108,7 @@
<P>
La GNU GPL non è unica nel suo genere. Diverse <A TITLE="lista di
licenze libere e non"
- HREF="http://www.it.gnu.org/licenses/license-list.it.html">altre
+ HREF="https://www.it.gnu.org/licenses/license-list.it.html">altre
licenze</A> garantiscono le quattro libertà e si possono pertanto
qualificare come licenze per il software libero. Fra queste, merita
una speciale menzione per la sua diffusione la <A TITLE="la licenza
@@ -234,7 +234,7 @@
<P>
La <A TITLE="usi commerciali del software libero, di Alessandro
Rubini"
- HREF="http://www.it.gnu.org/philosophy/software-libre-commercial-viability.it.html">rilevanza
+ HREF="https://www.it.gnu.org/philosophy/software-libre-commercial-viability.it.html">rilevanza
economica</A> del software libero è ancora molto ridotta, ma è in
fortissima crescita ormai da alcuni anni, e tutto consente di supporre
che tale crescita <A TITLE="prospettive del software libero, gruppo di
diff --git a/test/manual/etags/scm-src/test.scm b/test/manual/etags/scm-src/test.scm
new file mode 100644
index 00000000000..e3921e718fc
--- /dev/null
+++ b/test/manual/etags/scm-src/test.scm
@@ -0,0 +1,20 @@
+(define hello "Hello, Emacs!")
+
+(set! hello "Hello, world!")
+
+(define (hello-world)
+ (display hello)
+ (newline))
+
+;; Bug 5624
+(define (there-is-a-=-in-the-middle!) #t)
+
+(define =starts-with-equals! #t)
+
+(define (((((curry-test a) b) c) d) e)
+ (list a b c d e))
+
+(define-syntax test-begin
+ (syntax-rules ()
+ ((test-begin exp ...)
+ ((lambda () exp ...)))))
diff --git a/test/manual/etags/tex-src/gzip.texi b/test/manual/etags/tex-src/gzip.texi
index 07be37187d7..ea5f7f5879e 100644
--- a/test/manual/etags/tex-src/gzip.texi
+++ b/test/manual/etags/tex-src/gzip.texi
@@ -240,7 +240,7 @@ Force compression or decompression even if the file has multiple links
or the corresponding file already exists, or if the compressed data
is read from or written to a terminal. If the input data is not in
a format recognized by @code{gzip}, and if the option --stdout is also
-given, copy the input data without change to the standard ouput: let
+given, copy the input data without change to the standard output: let
@code{zcat} behave as @code{cat}. If @samp{-f} is not given, and
when not running in the background, @code{gzip} prompts to verify
whether an existing file should be overwritten.
diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el
index 577c7658791..509623b8176 100644
--- a/test/manual/image-size-tests.el
+++ b/test/manual/image-size-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;; To test: Load the file and eval (image-size-tests).
;; A non-erroring result is a success.
@@ -25,8 +25,8 @@
(defmacro im-should (image width height &rest props)
`(let ((im (im-image ,image ,@props)))
(unless (im-compare im ,width ,height)
- (error "%s didn't succeed; size is %s"
- ',props (image-size im t)))))
+ (error "%s %s didn't succeed; size is %s"
+ ',image ',props (image-size im t)))))
(defun im-image (type &rest props)
(let ((image-scaling-factor 1))
@@ -67,6 +67,9 @@
;; Both max-width/height.
(im-should :w 100 50 :max-width 100 :max-height 75)
(im-should :w 50 25 :max-width 100 :max-height 25)
+ ;; :width and :max-height (max-height wins).
+ (im-should :w 400 200 :width 400 :max-height 200)
+ (im-should :w 400 200 :width 500 :max-height 200)
;; Test the image that's taller than it is wide.
(im-should :h 100 200)
@@ -87,6 +90,9 @@
;; Both max-width/height.
(im-should :h 50 100 :max-width 75 :max-height 100)
(im-should :h 25 50 :max-width 25 :max-height 100)
+ ;; :height and :max-width (max-width wins).
+ (im-should :h 200 400 :height 400 :max-width 200)
+ (im-should :h 200 400 :height 500 :max-width 200)
)
;;; image-size-tests.el ends here
diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css
index bf612b53a14..640418b022d 100644
--- a/test/manual/indent/css-mode.css
+++ b/test/manual/indent/css-mode.css
@@ -66,6 +66,16 @@ div::before {
);
}
+/* Multi-line selector including both a pseudo-class and
+ parenthesis. */
+.form-group:not(.required) label,
+.birth-date .row > * {
+ &::after {
+ display: inline;
+ font-weight: normal;
+ }
+}
+
@font-face {
src: url("Sans-Regular.eot") format("eot"),
url("Sans-Regular.woff") format("woff"),
diff --git a/test/manual/indent/js-indent-align-list-continuation-nil.js b/test/manual/indent/js-indent-align-list-continuation-nil.js
new file mode 100644
index 00000000000..383b2539a26
--- /dev/null
+++ b/test/manual/indent/js-indent-align-list-continuation-nil.js
@@ -0,0 +1,20 @@
+const funcAssignment = function (arg1,
+ arg2,
+ arg3) {
+ return { test: this,
+ which: "would",
+ align: "as well with the default setting"
+ };
+}
+
+function funcDeclaration(arg1,
+ arg2
+) {
+ return [arg1,
+ arg2];
+}
+
+// Local Variables:
+// indent-tabs-mode: nil
+// js-indent-align-list-continuation: nil
+// End:
diff --git a/test/manual/indent/js.js b/test/manual/indent/js.js
index 1ad76a83e18..b0d8bcabd20 100644
--- a/test/manual/indent/js.js
+++ b/test/manual/indent/js.js
@@ -7,6 +7,9 @@ let c = 1,
var e = 100500,
+ 1;
+// Don't misinterpret "const"
+/const/
+
function test ()
{
return /[/]/.test ('/') // (bug#19397)
@@ -135,6 +138,12 @@ if (1) {
: 4
}
+// Regexp is not a continuation
+bar(
+ "string arg1",
+ /abc/
+)
+
// Local Variables:
// indent-tabs-mode: nil
// js-indent-level: 2
diff --git a/test/manual/indent/less-css-mode.less b/test/manual/indent/less-css-mode.less
new file mode 100644
index 00000000000..36c037450cc
--- /dev/null
+++ b/test/manual/indent/less-css-mode.less
@@ -0,0 +1,29 @@
+.desktop-and-old-ie(@rules) {
+ @media screen and (min-width: 1200) { @rules(); }
+ html.lt-ie9 & { @rules(); }
+}
+
+header {
+ background-color: blue;
+
+ .desktop-and-old-ie({
+ background-color: red;
+ });
+}
+
+.e(@name, @rules) {
+ &__@{name} { @rules(); }
+}
+
+.m(@name, @rules) {
+ &--@{name} { @rules(); }
+}
+
+.btn {
+ .e(span, { // .btn__span
+ display: inline-block;
+ });
+ .m(primary, { // .btn--primary
+ background: blue;
+ });
+}
diff --git a/test/manual/indent/octave.m b/test/manual/indent/octave.m
index 4758f9933cb..3052a6d3687 100644
--- a/test/manual/indent/octave.m
+++ b/test/manual/indent/octave.m
@@ -81,7 +81,7 @@ endfunction
##
## You should have received a copy of the GNU General Public License
## along with Octave; see the file COPYING. If not, see
-## <http://www.gnu.org/licenses/>.
+## <https://www.gnu.org/licenses/>.
## -*- texinfo -*-
## @deftypefn {Command} pkg @var{command} @var{pkg_name}
diff --git a/test/manual/indent/pascal.pas b/test/manual/indent/pascal.pas
index fd225fd35d1..35e919f00b9 100644
--- a/test/manual/indent/pascal.pas
+++ b/test/manual/indent/pascal.pas
@@ -14,7 +14,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
-along with this program. If not, see <http://www.gnu.org/licenses/>.
+along with this program. If not, see <https://www.gnu.org/licenses/>.
As a special exception, if you incorporate even large parts of the
code of this demo program into another program with substantially
diff --git a/test/manual/indent/perl.perl b/test/manual/indent/perl.perl
index f86a09b2733..06f32e7f090 100755
--- a/test/manual/indent/perl.perl
+++ b/test/manual/indent/perl.perl
@@ -53,6 +53,14 @@ EOF1
bar
EOF2
+print <<~"EOF1" . <<\EOF2 . s/he"llo/th'ere/;
+foo
+EOF2
+ bar
+ EOF1
+bar
+EOF2
+
print $'; # This should not start a string!
print "hello" for /./;
diff --git a/test/manual/redisplay-testsuite.el b/test/manual/redisplay-testsuite.el
index defc3fee328..ea178c33bcc 100644
--- a/test/manual/redisplay-testsuite.el
+++ b/test/manual/redisplay-testsuite.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -350,4 +350,3 @@ static unsigned char x_bits[] = {0xff, 0x81, 0xbd, 0xa5, 0xa5, 0xbd, 0x81, 0xff
(test-redisplay-4)
(test-redisplay-5)
(goto-char (point-min))))
-
diff --git a/test/manual/rmailmm.el b/test/manual/rmailmm.el
index fc570fa42b4..8ec10d83e51 100644
--- a/test/manual/rmailmm.el
+++ b/test/manual/rmailmm.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/manual/scroll-tests.el b/test/manual/scroll-tests.el
index 95647ce0c40..e7f55e136de 100644
--- a/test/manual/scroll-tests.el
+++ b/test/manual/scroll-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el
index 1cf1fc3be5c..aff480c6b66 100644
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 793dddd8bd4..834acaf66f5 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -45,4 +45,9 @@ with parameters from the *Messages* buffer modification."
(should (eq buf (current-buffer))))
(when msg-ov (delete-overlay msg-ov))))))
+(ert-deftest test-generate-new-buffer-name-bug27966 ()
+ (should-not (string-equal "nil"
+ (progn (get-buffer-create "nil")
+ (generate-new-buffer-name "nil")))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el
index 853d56e827d..fcba6914a5d 100644
--- a/test/src/callproc-tests.el
+++ b/test/src/callproc-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
index 234d233c71a..0a9b6c20ec9 100644
--- a/test/src/casefiddle-tests.el
+++ b/test/src/casefiddle-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el
index 515a4eafe14..c3f09ec1a0a 100644
--- a/test/src/charset-tests.el
+++ b/test/src/charset-tests.el
@@ -13,7 +13,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el
index 54fcdcffbae..2c57f27ff8b 100644
--- a/test/src/chartab-tests.el
+++ b/test/src/chartab-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/cmds-tests.el b/test/src/cmds-tests.el
index 207ae75a21d..a545d0e08b5 100644
--- a/test/src/cmds-tests.el
+++ b/test/src/cmds-tests.el
@@ -16,7 +16,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index cfcd080281f..e0cefa94356 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 00a30559e32..374d1689b9e 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -101,7 +101,26 @@
(should (= 3 (apply #'min '(3 8 3))))
(should-error (min 9 8 'foo))
(should-error (min (make-marker)))
- (should (eql 1 (min (point-min-marker) 1))))
+ (should (eql 1 (min (point-min-marker) 1)))
+ (should (isnan (min 0.0e+NaN)))
+ (should (isnan (min 0.0e+NaN 1 2)))
+ (should (isnan (min 1.0 0.0e+NaN)))
+ (should (isnan (min 1.0 0.0e+NaN 1.1))))
+
+(defun data-tests-popcnt (byte)
+ "Calculate the Hamming weight of BYTE."
+ (if (< byte 0)
+ (setq byte (lognot byte)))
+ (setq byte (- byte (logand (lsh byte -1) #x55555555)))
+ (setq byte (+ (logand byte #x33333333) (logand (lsh byte -2) #x33333333)))
+ (lsh (* (logand (+ byte (lsh byte -4)) #x0f0f0f0f) #x01010101) -24))
+
+(ert-deftest data-tests-logcount ()
+ (should (cl-loop for n in (number-sequence -255 255)
+ always (= (logcount n) (data-tests-popcnt n))))
+ ;; https://oeis.org/A000120
+ (should (= 11 (logcount 9727)))
+ (should (= 8 (logcount 9999))))
;; Bool vector tests. Compactly represent bool vectors as hex
;; strings.
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index eaec0d01a7b..8a6f4d1fb95 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el
index 8e5446e2a4b..d8e4320bc6f 100644
--- a/test/src/doc-tests.el
+++ b/test/src/doc-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index a3ea8ab60b5..70dc9372fad 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
@@ -166,6 +166,14 @@
(should (string-equal
(format-time-string format look '(-28800 "PST"))
"1972-06-30 15:59:59.999 -0800 (PST)"))
+ ;; Negative UTC offset, as a Lisp integer.
+ (should (string-equal
+ (format-time-string format look -28800)
+ ;; MS-Windows build replaces unrecognizable TZ values,
+ ;; such as "-08", with "ZZZ".
+ (if (eq system-type 'windows-nt)
+ "1972-06-30 15:59:59.999 -0800 (ZZZ)"
+ "1972-06-30 15:59:59.999 -0800 (-08)")))
;; Positive UTC offset that is not an hour multiple, as a string.
(should (string-equal
(format-time-string format look "IST-5:30")
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index a4994b6223b..4b41fc21c20 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>. */
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
(require 'ert)
@@ -182,37 +182,74 @@ changes."
(should (equal (help-function-arglist #'mod-test-sum)
'(arg1 arg2))))
-(ert-deftest module--test-assertions ()
- "Check that -module-assertions work."
+(defmacro module--with-temp-directory (name &rest body)
+ "Bind NAME to the name of a temporary directory and evaluate BODY.
+NAME must be a symbol. Delete the temporary directory after BODY
+exits normally or non-locally. NAME will be bound to the
+directory name (not the directory file name) of the temporary
+directory."
+ (declare (indent 1))
+ (cl-check-type name symbol)
+ `(let ((,name (file-name-as-directory
+ (make-temp-file "emacs-module-test" :directory))))
+ (unwind-protect
+ (progn ,@body)
+ (delete-directory ,name :recursive))))
+
+(defmacro module--test-assertion (pattern &rest body)
+ "Test that PATTERN matches the assertion triggered by BODY.
+Run Emacs as a subprocess, load the test module `mod-test-file',
+and evaluate BODY. Verify that Emacs aborts and prints a module
+assertion message that matches PATTERN. PATTERN is evaluated and
+must evaluate to a regular expression string."
+ (declare (indent 1))
+ ;; To contain any core dumps.
+ `(module--with-temp-directory tempdir
+ (with-temp-buffer
+ (let* ((default-directory tempdir)
+ (status (call-process mod-test-emacs nil t nil
+ "-batch" "-Q" "-module-assertions"
+ "-eval" "(setq w32-disable-abort-dialog t)"
+ "-eval"
+ ,(prin1-to-string
+ `(progn
+ (require 'mod-test ,mod-test-file)
+ ,@body)))))
+ ;; Aborting doesn't raise a signal on MS-DOS/Windows, but
+ ;; rather exits with a non-zero status: 2 on MS-DOS (see
+ ;; msdos.c:msdos_abort), 3 on Windows, per MSDN documentation
+ ;; of 'abort'.
+ (if (memq system-type '(ms-dos windows-nt))
+ (should (>= status 2))
+ (should (stringp status))
+ ;; eg "Aborted" or "Abort trap: 6"
+ (should (string-prefix-p "Abort" status)))
+ (search-backward "Emacs module assertion: ")
+ (goto-char (match-end 0))
+ (should (string-match-p ,pattern
+ (buffer-substring-no-properties
+ (point) (point-max))))))))
+
+(ert-deftest module--test-assertions--load-non-live-object ()
+ "Check that -module-assertions verify that non-live objects
+aren’t accessed."
(skip-unless (file-executable-p mod-test-emacs))
;; This doesn’t yet cause undefined behavior.
(should (eq (mod-test-invalid-store) 123))
- ;; To contain any core dumps.
- (let ((tempdir (make-temp-file "emacs-module-test" t)))
- (unwind-protect
- (with-temp-buffer
- (should (string-match-p
- "Abort" ; eg "Aborted" or "Abort trap: 6"
- (let ((default-directory tempdir))
- (call-process mod-test-emacs nil t nil
- "-batch" "-Q" "-module-assertions" "-eval"
- (prin1-to-string
- `(progn
- (require 'mod-test ,mod-test-file)
- ;; Storing and reloading a local
- ;; value causes undefined behavior,
- ;; which should be detected by the
- ;; module assertions.
- (mod-test-invalid-store)
- (mod-test-invalid-load)))))))
- (search-backward "Emacs module assertion:")
- (should (string-match-p (rx bos "Emacs module assertion: "
- "Emacs value not found in "
- (+ digit) " values of "
- (+ digit) " environments" eos)
- (buffer-substring-no-properties
- (line-beginning-position)
- (line-end-position)))))
- (delete-directory tempdir t))))
+ (module--test-assertion (rx "Emacs value not found in "
+ (+ digit) " values of "
+ (+ digit) " environments\n")
+ ;; Storing and reloading a local value causes undefined behavior,
+ ;; which should be detected by the module assertions.
+ (mod-test-invalid-store)
+ (mod-test-invalid-load)))
+
+(ert-deftest module--test-assertions--call-emacs-from-gc ()
+ "Check that -module-assertions prevents calling Emacs functions
+during garbage collection."
+ (skip-unless (file-executable-p mod-test-emacs))
+ (module--test-assertion
+ (rx "Module function called during garbage collection\n")
+ (mod-test-invalid-finalizer)))
;;; emacs-module-tests.el ends here
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 03f408716b1..7ff60dd01c4 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -59,4 +59,24 @@ Bug#24912 and Bug#24913."
(should-error (,form ,arg) :type 'wrong-type-argument))
t)))
+(ert-deftest eval-tests--if-dot-string ()
+ "Check that Emacs rejects (if . \"string\")."
+ (should-error (eval '(if . "abc")) :type 'wrong-type-argument)
+ (let ((if-tail (list '(setcdr if-tail "abc") t)))
+ (should-error (eval (cons 'if if-tail))))
+ (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t)))
+ (should-error (eval (cons 'if if-tail)))))
+
+(ert-deftest eval-tests--let-with-circular-defs ()
+ "Check that Emacs reports an error for (let VARS ...) when VARS is circular."
+ (let ((vars (list 'v)))
+ (setcdr vars vars)
+ (dolist (let-sym '(let let*))
+ (should-error (eval (list let-sym vars))))))
+
+(ert-deftest eval-tests--mutating-cond ()
+ "Check that Emacs doesn't crash on a cond clause that mutates during eval."
+ (let ((clauses (list '((progn (setcdr clauses "ouch") nil)))))
+ (should-error (eval (cons 'cond clauses)))))
+
;;; eval-tests.el ends here
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
new file mode 100644
index 00000000000..01c280d2752
--- /dev/null
+++ b/test/src/fileio-tests.el
@@ -0,0 +1,97 @@
+;;; unit tests for src/fileio.c -*- lexical-binding: t; -*-
+
+;; Copyright 2017 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)
+
+(defun try-link (target link)
+ (make-symbolic-link target link)
+ (let* ((read-link (file-symlink-p link))
+ (failure (unless (string-equal target read-link)
+ (list 'string-equal target read-link))))
+ (delete-file link)
+ failure))
+
+(defun fileio-tests--symlink-failure ()
+ (let* ((dir (make-temp-file "fileio" t))
+ (link (expand-file-name "link" dir)))
+ (unwind-protect
+ (let (failure
+ (char 0))
+ (while (and (not failure) (< char 127))
+ (setq char (1+ char))
+ (when (and (eq system-type 'cygwin) (eq char 92))
+ (setq char (1+ char)))
+ (setq failure (try-link (string char) link)))
+ (or failure
+ (try-link "/:" link)))
+ (delete-directory dir t))))
+
+(ert-deftest fileio-tests--odd-symlink-chars ()
+ "Check that any non-NULL ASCII character can appear in a symlink.
+Also check that an encoding error can appear in a symlink."
+ ;; Some Windows versions don't support symlinks, and those which do
+ ;; will pop up UAC elevation prompts, so we disable this test on
+ ;; MS-Windows.
+ (skip-unless (not (eq system-type 'windows-nt)))
+ (should (equal nil (fileio-tests--symlink-failure))))
+
+(ert-deftest fileio-tests--directory-file-name ()
+ (should (equal (directory-file-name "/") "/"))
+ (should (equal (directory-file-name "//") "//"))
+ (should (equal (directory-file-name "///") "/"))
+ (should (equal (directory-file-name "////") "/"))
+ (should (equal (directory-file-name "/abc") "/abc"))
+ (should (equal (directory-file-name "/abc/") "/abc"))
+ (should (equal (directory-file-name "/abc//") "/abc")))
+
+(ert-deftest fileio-tests--directory-file-name-dos-nt ()
+ "Like fileio-tests--directory-file-name, but for DOS_NT systems."
+ (skip-unless (memq system-type '(ms-dos windows-nt)))
+ (should (equal (directory-file-name "d:/") "d:/"))
+ (should (equal (directory-file-name "d://") "d:/"))
+ (should (equal (directory-file-name "d:///") "d:/"))
+ (should (equal (directory-file-name "d:////") "d:/"))
+ (should (equal (directory-file-name "d:/abc") "d:/abc"))
+ (should (equal (directory-file-name "d:/abc/") "d:/abc"))
+ (should (equal (directory-file-name "d:/abc//") "d:/abc")))
+
+(ert-deftest fileio-tests--file-name-as-directory ()
+ (should (equal (file-name-as-directory "") "./"))
+ (should (equal (file-name-as-directory "/") "/"))
+ (should (equal (file-name-as-directory "//") "//"))
+ (should (equal (file-name-as-directory "///") "///"))
+ (should (equal (file-name-as-directory "////") "////"))
+ (should (equal (file-name-as-directory "/abc") "/abc/"))
+ (should (equal (file-name-as-directory "/abc/") "/abc/"))
+ (should (equal (file-name-as-directory "/abc//") "/abc//")))
+
+(ert-deftest fileio-tests--file-name-as-directory-dos-nt ()
+ "Like fileio-tests--file-name-as-directory, but for DOS_NT systems."
+ (skip-unless (memq system-type '(ms-dos windows-nt)))
+ (should (equal (file-name-as-directory "d:/") "d:/"))
+ (should (equal (file-name-as-directory "d:\\") "d:/"))
+ (should (equal (file-name-as-directory "d://") "d://"))
+ (should (equal (file-name-as-directory "d:///") "d:///"))
+ (should (equal (file-name-as-directory "d:////") "d:////"))
+ (should (equal (file-name-as-directory "d:\\\\\\\\") "d:////"))
+ (should (equal (file-name-as-directory "d:/abc") "d:/abc/"))
+ (should (equal (file-name-as-directory "D:\\abc") "d:/abc/"))
+ (should (equal (file-name-as-directory "d:/abc/") "d:/abc/"))
+ (should (equal (file-name-as-directory "D:\\abc/") "d:/abc/"))
+ (should (equal (file-name-as-directory "D:/abc//") "d:/abc//")))
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index de3e44314f9..aa4e55e4897 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
(require 'ert)
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 2e463455f0c..705d02fdff6 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -154,7 +154,7 @@
(9 . "aaa") (9 . "zzz") (9 . "ppp") (9 . "fff")])))
(ert-deftest fns-tests-collate-sort ()
- ;; See https://lists.gnu.org/archive/html/emacs-devel/2015-10/msg02505.html.
+ ;; See https://lists.gnu.org/r/emacs-devel/2015-10/msg02505.html.
:expected-result (if (eq system-type 'cygwin) :failed :passed)
(skip-unless (fns-tests--collate-enabled-p))
@@ -373,6 +373,12 @@
(should-error (assoc 3 d1) :type 'wrong-type-argument)
(should-error (assoc 3 d2) :type 'wrong-type-argument)))
+(ert-deftest test-assoc-testfn ()
+ (let ((alist '(("a" . 1) ("b" . 2))))
+ (should-not (assoc "a" alist #'ignore))
+ (should (eq (assoc "b" alist #'string-equal) (cadr alist)))
+ (should-not (assoc "b" alist #'eq))))
+
(ert-deftest test-cycle-rassq ()
(let ((c1 (cyc1 '(0 . 1)))
(c2 (cyc2 '(0 . 1) '(0 . 2)))
@@ -541,4 +547,32 @@
(should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
(should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
+(ert-deftest plist-get/odd-number-of-elements ()
+ "Test that ‘plist-get’ doesn’t signal an error on degenerate plists."
+ (should-not (plist-get '(:foo 1 :bar) :bar)))
+
+(ert-deftest lax-plist-get/odd-number-of-elements ()
+ "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
+ (should (equal (should-error (lax-plist-get '(:foo 1 :bar) :bar)
+ :type 'wrong-type-argument)
+ '(wrong-type-argument plistp (:foo 1 :bar)))))
+
+(ert-deftest plist-put/odd-number-of-elements ()
+ "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
+ (should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
+ :type 'wrong-type-argument)
+ '(wrong-type-argument plistp (:foo 1 :bar)))))
+
+(ert-deftest lax-plist-put/odd-number-of-elements ()
+ "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
+ (should (equal (should-error (lax-plist-put '(:foo 1 :bar) :zot 2)
+ :type 'wrong-type-argument)
+ '(wrong-type-argument plistp (:foo 1 :bar)))))
+
+(ert-deftest plist-member/improper-list ()
+ "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
+ (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
+ :type 'wrong-type-argument)
+ '(wrong-type-argument plistp (:foo 1 . :bar)))))
+
(provide 'fns-tests)
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index dc48577025c..d86139b0f19 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el
index 987e1fc0777..9f8abb0ffdb 100644
--- a/test/src/inotify-tests.el
+++ b/test/src/inotify-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
new file mode 100644
index 00000000000..301cef0092c
--- /dev/null
+++ b/test/src/keyboard-tests.el
@@ -0,0 +1,36 @@
+;;; keyboard-tests.el --- Tests for keyboard.c -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 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)
+
+(ert-deftest keyboard-unread-command-events ()
+ "Test `unread-command-events'."
+ (should (equal (progn (push ?\C-a unread-command-events)
+ (read-event nil nil 1))
+ ?\C-a))
+ (should (equal (progn (run-with-timer
+ 1 nil
+ (lambda () (push '(t . ?\C-b) unread-command-events)))
+ (read-event nil nil 2))
+ ?\C-b)))
+
+(provide 'keyboard-tests)
+;;; keyboard-tests.el ends here
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index c5b9d0cc71c..bc2b424a639 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -17,7 +17,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
new file mode 100644
index 00000000000..cc324af68ba
--- /dev/null
+++ b/test/src/lcms-tests.el
@@ -0,0 +1,161 @@
+;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Maintainer: emacs-devel@gnu.org
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Some reference values computed using the colorspacious python
+;; library, assimilated from its test suite, or adopted from its
+;; aggregation of gold values.
+;; See https://colorspacious.readthedocs.io/en/v1.1.0/ and
+;; https://github.com/njsmith/colorspacious
+
+;; Other references:
+;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
+
+;;; Code:
+
+(require 'ert)
+(require 'color)
+
+(defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883)
+ "D65 white point from colorspacious.")
+
+(defun lcms-approx-p (a b &optional delta)
+ "Check if A and B are within relative error DELTA of one another.
+B is considered the exact value."
+ (> (or delta 0.001) (abs (1- (/ a b)))))
+
+(defun lcms-triple-approx-p (a b &optional delta)
+ "Like `lcms-approx-p' except for color triples."
+ (pcase-let ((`(,a1 ,a2 ,a3) a)
+ (`(,b1 ,b2 ,b3) b))
+ (and (lcms-approx-p a1 b1 delta)
+ (lcms-approx-p a2 b2 delta)
+ (lcms-approx-p a3 b3 delta))))
+
+(defun lcms-rgb255->xyz (rgb)
+ "Return XYZ tristimulus values corresponding to RGB."
+ (let ((rgb1 (mapcar (lambda (x) (/ x 255.0)) rgb)))
+ (apply #'color-srgb-to-xyz rgb1)))
+
+(ert-deftest lcms-cri-cam02-ucs ()
+ "Test use of `lcms-cam02-ucs'."
+ (skip-unless (featurep 'lcms2))
+ (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error"))
+ (should-error (lcms-cam02-ucs '(0 0 0) 'error))
+ (should-not
+ (lcms-approx-p
+ (let ((wp '(0.44757 1.0 0.40745)))
+ (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0) wp))
+ (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))))
+ (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5))))
+ (should
+ (lcms-approx-p (lcms-cam02-ucs lcms-colorspacious-d65
+ '(0 0 0)
+ lcms-colorspacious-d65)
+ 100.0)))
+
+(ert-deftest lcms-whitepoint ()
+ "Test use of `lcms-temp->white-point'."
+ (skip-unless (featurep 'lcms2))
+ (should-error (lcms-temp->white-point 3999))
+ (should-error (lcms-temp->white-point 25001))
+ ;; D55
+ (should
+ (lcms-triple-approx-p
+ (apply #'color-xyz-to-xyy (lcms-temp->white-point 5503))
+ '(0.33242 0.34743 1.0)))
+ ;; D65
+ (should
+ (lcms-triple-approx-p
+ (apply #'color-xyz-to-xyy (lcms-temp->white-point 6504))
+ '(0.31271 0.32902 1.0)))
+ ;; D75
+ (should
+ (lcms-triple-approx-p
+ (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504))
+ '(0.29902 0.31485 1.0))))
+
+(ert-deftest lcms-roundtrip ()
+ "Test accuracy of converting to and from different color spaces"
+ (skip-unless (featurep 'lcms2))
+ (should
+ (let ((color '(.5 .3 .7)))
+ (lcms-triple-approx-p (lcms-jch->xyz (lcms-xyz->jch color))
+ color
+ 0.0001)))
+ (should
+ (let ((color '(.8 -.2 .2)))
+ (lcms-triple-approx-p (lcms-jch->jab (lcms-jab->jch color))
+ color
+ 0.0001))))
+
+(ert-deftest lcms-ciecam02-gold ()
+ "Test CIE CAM02 JCh gold values"
+ (skip-unless (featurep 'lcms2))
+ (should
+ (lcms-triple-approx-p
+ (lcms-xyz->jch '(0.1931 0.2393 0.1014)
+ '(0.9888 0.900 0.3203)
+ '(18 200 1 1.0))
+ '(48.0314 38.7789 191.0452)
+ 0.02))
+ (should
+ (lcms-triple-approx-p
+ (lcms-xyz->jch '(0.1931 0.2393 0.1014)
+ '(0.9888 0.90 0.3203)
+ '(18 20 1 1.0))
+ '(47.6856 36.0527 185.3445)
+ 0.09)))
+
+(ert-deftest lcms-dE-cam02-ucs-silver ()
+ "Test CRI-CAM02-UCS deltaE metric values from colorspacious."
+ (skip-unless (featurep 'lcms2))
+ (should
+ (lcms-approx-p
+ (lcms-cam02-ucs (lcms-rgb255->xyz '(173 52 52))
+ (lcms-rgb255->xyz '(59 120 51))
+ lcms-colorspacious-d65
+ (list 20 (/ 64 float-pi 5) 1 1))
+ 44.698469808449964
+ 0.03))
+ (should
+ (lcms-approx-p
+ (lcms-cam02-ucs (lcms-rgb255->xyz '(69 100 52))
+ (lcms-rgb255->xyz '(59 120 51))
+ lcms-colorspacious-d65
+ (list 20 (/ 64 float-pi 5) 1 1))
+ 8.503323264883667
+ 0.04)))
+
+(ert-deftest lcms-jmh->cam02-ucs-silver ()
+ "Compare JCh conversion to CAM02-UCS to values from colorspacious."
+ (skip-unless (featurep 'lcms2))
+ (should
+ (lcms-triple-approx-p (lcms-jch->jab '(50 20 10))
+ '(62.96296296 16.22742674 2.86133316)
+ 0.05))
+ (should
+ (lcms-triple-approx-p (lcms-jch->jab '(10 60 100))
+ '(15.88785047 -6.56546789 37.23461867)
+ 0.04)))
+
+;;; lcms-tests.el ends here
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 98cbb6a301d..ac730b4f005 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -17,7 +17,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
@@ -142,8 +142,25 @@ literals (Bug#20852)."
"unescaped character literals "
"`?\"', `?(', `?)', `?;', `?[', `?]' detected!")))))
+(ert-deftest lread-tests--funny-quote-symbols ()
+ "Check that 'smart quotes' or similar trigger errors in symbol names."
+ (dolist (quote-char
+ '(#x2018 ;; LEFT SINGLE QUOTATION MARK
+ #x2019 ;; RIGHT SINGLE QUOTATION MARK
+ #x201B ;; SINGLE HIGH-REVERSED-9 QUOTATION MARK
+ #x201C ;; LEFT DOUBLE QUOTATION MARK
+ #x201D ;; RIGHT DOUBLE QUOTATION MARK
+ #x201F ;; DOUBLE HIGH-REVERSED-9 QUOTATION MARK
+ #x301E ;; DOUBLE PRIME QUOTATION MARK
+ #xFF02 ;; FULLWIDTH QUOTATION MARK
+ #xFF07 ;; FULLWIDTH APOSTROPHE
+ ))
+ (let ((str (format "%cfoo" quote-char)))
+ (should-error (read str) :type 'invalid-read-syntax)
+ (should (eq (read (concat "\\" str)) (intern str))))))
+
(ert-deftest lread-test-bug26837 ()
- "Test for http://debbugs.gnu.org/26837 ."
+ "Test for https://debbugs.gnu.org/26837 ."
(let ((load-path (cons
(file-name-as-directory
(expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY")))
@@ -164,4 +181,10 @@ literals (Bug#20852)."
(concat (format-message "Loading `%s': " file-name)
"old-style backquotes detected!")))))
+(ert-deftest lread-lread--substitute-object-in-subtree ()
+ (let ((x (cons 0 1)))
+ (setcar x x)
+ (lread--substitute-object-in-subtree x 1 t)
+ (should (eq x (cdr x)))))
+
;;; lread-tests.el ends here
diff --git a/test/src/marker-tests.el b/test/src/marker-tests.el
index 20ce8f4cc04..2540f157e76 100644
--- a/test/src/marker-tests.el
+++ b/test/src/marker-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el
index cb14819d349..aba5ca51707 100644
--- a/test/src/minibuf-tests.el
+++ b/test/src/minibuf-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index b3ffc23e120..b8f6c797dab 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -15,7 +15,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 04dc903f3a9..b26f9391909 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -13,7 +13,7 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
diff --git a/test/src/regex-tests.el b/test/src/regex-tests.el
index 1364bf6848a..b1f1ea71cef 100644
--- a/test/src/regex-tests.el
+++ b/test/src/regex-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el
index 6edde0b137b..67e7ec32517 100644
--- a/test/src/syntax-tests.el
+++ b/test/src/syntax-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el
index d4c8925b5db..1dcfa8ea29d 100644
--- a/test/src/textprop-tests.el
+++ b/test/src/textprop-tests.el
@@ -18,7 +18,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 849b2e3dd1b..10b2f0761df 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -15,7 +15,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Code:
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 0cf7fc9f59c..3ff75ae68d5 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -15,7 +15,7 @@
;; General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+;; along with this program. If not, see `https://www.gnu.org/licenses/'.
;;; Commentary:
@@ -200,7 +200,7 @@
'(error "Unrecognized entry in undo list \"bogus\""))))
(buffer-string))))))
-;; http://debbugs.gnu.org/14824
+;; https://debbugs.gnu.org/14824
(ert-deftest undo-test-buffer-modified ()
"Test undoing marks buffer unmodified."
(with-temp-buffer
@@ -326,7 +326,7 @@ undo-make-selective-list."
(insert "This sentence corrupted?")
(undo-boundary)
;; Same as recipe at
- ;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411
+ ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411
(insert "aaa")
(undo-boundary)
(undo)
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 1550887f77d..557e6da4524 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -19,7 +19,7 @@
;; 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 <http://www.gnu.org/licenses/>.
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary: